REM >HADFS2
REM v5.26 *Info $ copes with new-style disks
REM v5.27 *Opt6/*Opt7 select internal/external drivers
REM v5.30 BitTable reversed to use in DRVINT/EXT
:
PRINT "Assembling S.HADFS2"
O%=P%-Block%+mcode%
[OPT0
:
.fsc
CMP #13:BCC P%+3:RTS
CMP #6:BEQ P%+5:JSR GrabAbs       :\ Don't grab w/s if FS starting up
STA &B0:TXA:PHA
LDA &B0:ASL A:TAX
LDA fscTable,X:STA &B0
LDA fscTable+1,X:STA &B1
PLA:TAX:JMP (&B0)
:
.fscTable
EQUW opt:EQUW eof:EQUW slash
EQUW fscCmd:EQUW run:EQUW cat
EQUW NewFSStart:EQUW QueryHandles
EQUW StarComm:EQUW ex:EQUW info
EQUW lib_run:EQUW rename
:
.fscCmd
JSR XYtoF2:LDX #FileTable-CommTable
LDA (&F2),Y:CMP #ASC"\":BNE fscCmd2
JSR SkipSpc1
.fscCmd2
JSR Serv4Try:TAX:BNE P%+5:JMP RunFinish:\ All done
TYA:BNE Bad_Command               :\ was *\name, don't check disk
JSR F2toXY:JMP slash
.Bad_Command
JSR errors:EQUB 254:EQUS "Bad command":BRK
:
.lib_run
TXA:PHA:TYA:PHA:JSR WhatFS:PHA
LDA #3:JSR OSARGS:STA tmp
PLA:CMP tmp:BEQ Bad_Command
PLA:TAY:PLA:TAX                   :\ libfs<>currfs, try running from me
:
.slash
JSR CheckContextXY:\JSR CheckContext:\JSR XYtoF2
LDX #CSD-CSD:JSR TryRun2
CLC:BNE RunDone
BIT pathflg:BVS NotRun  :\ Path used absolute specifier
\ Should try &.Library
LDX #LIB-CSD:JSR TryRun
CLC:BNE RunDone
.NotRun
SEC
.RunDone
BCC RunFinish
\TXA:\PHA:\JSR WhatOS:\BCC Bad_Command
\PLA:\TAX
LDY #0:JSR F2toXY:LDA #11:JMP (&21E) :\ Pass to LibFS to try
\ NB ANFS seems not to implement RunLib
:
.run
JSR CheckContextXY:\JSR CheckContext:\JSR XYtoF2
LDX #CSD-CSD:JSR TryRun2
BNE RunFinish
JMP FileNotFound
:
.TryRun
LDA CSD+0,X:CMP CSD+0:BNE TryRun2
LDA CSD+1,X:CMP CSD+1:BNE TryRun2
LDA CSD+2,X:CMP CSD+2:BNE TryRun2
LDA CSD+d,X:CMP CSD+d:BNE TryRun2
.RunFinish
RTS
:
.TryRun2
LDA &F2:PHA:LDA &F3:PHA
JSR DIRtoSect:JSR SetDrives
LDY #0:JSR SearchPathEntry
BPL P%+5:JMP Bad_Filename
TAX:BEQ TryRunNone
CMP #1:BEQ P%+5:JMP NotAFile
TYA:CLC:ADC &F2:STA cptr+0
LDA #0:ADC &F3:STA cptr+1:\ Command line pointer
JSR YDoIOwn:LDA (fptr),Y:BMI TryRunOk :\ 'E', can run file
DEY:DEY:LDA (fptr),Y:BPL TryRunOk     :\ 'R', can run file
:
\JSR YDoIOwn:\DEY:\DEY
\LDA (fptr),Y:\BPL TryRunOk
\INY:\INY:\LDA (fptr),Y:\BMI TryRunOk
:
JMP InsufficientAccess
.TryRunNone
PLA:STA &F3:PLA:STA &F2
LDA #0:RTS:\ No run
.TryRunOk
LDY #17:LDA (fptr),Y:DEY:AND (fptr),Y:DEY
AND (fptr),Y:DEY:AND (fptr),Y     :\ Check exec address
CMP #&FF:BEQ TryRunExec           :\ exec=&FFFFFFFF, *Exec file
JSR GetLoadHigh:DEY:AND (fptr),Y  :\ Is load=&FFFFxxxx?
\DEY:\LDA (fptr),Y:\DEY:\AND (fptr),Y
CMP #&FF:BNE TryRunLoad           :\ load<>&FFFFxxxx, load file
DEY:LDA (fptr),Y:CMP #&FE         :\ Is load=&FFFFFExx or FFxx?
.z%
BCC TryRunLoad                    :\ load<>&FFFFFExx/FFxx, load file
:]:IF _BasChain%:z%=P%-z%:P%=P%-z%:O%=O%-z%
.z%
BCS TryRunExec                    :\ load=&FFFFFExx/FFxx, *Exec file
CMP #&FB:BNE TryRunLoad           :\ load<>&FFFFFBxx, load file
:
\ Bootstrap BASIC (remove later in favour of *MCODE)
STA OBJECT+0:LDA drive:STA OBJECT+1
LDA fptr:STA OBJECT+2:LDA fptr+1:STA OBJECT+3
LDY #0:.RunBasLine
LDA (cptr),Y:STA &780,Y
INY:BPL RunBasLine
STY cptr+0:STY IAMFLG:LDA #7:STA cptr+1
LDX #5:.RunBasLp
LDA BasicTxt,X:TAY
TXA:PHA:LDA #138:LDX #0
JSR OSBYTE:PLA:TAX
LDA BasCom,X:STA OBJECT+4,X
DEX:BPL RunBasLp
LDX #(OBJECT+4)AND255:LDY #OBJECT DIV 256:JMP &FFF7
:]:IF NOT_BasChain%:z%=P%-z%:P%=P%-z%:O%=O%-z%
:
.TryRunExec
LDA #0:LDY &256:BEQ P%+5:JSR OSFIND :\ Close Exec if open
.TryRunExec2
LDA #&40:STA buf+0:LDA #1
JSR OpenInX:STA &256
.TryRunExit
PLA:STA &F3:PLA:STA &F2
LDA #&FF:RTS:\ Run ok
:
.TryRunLoad
LDA #&FF:STA blk+1                :\ Stop Load from returning ctrl block
LDX #3:JSR GetLoadHigh:PHA        :\ Get load address memory area
LDY #17:CMP (fptr),Y:BNE CantRun  :\ Exec in different memory, can't run
LDY #16:CMP #&FF:BNE TryRunLoad2  :\ Not I/O memory, use this address
CMP (fptr),Y:BNE CantRun          :\ I/O not &FFFFxxxx, can't run
.TryRunLoad2
LDA (fptr),Y:PHA:DEY              :\ Save exec address
DEX:BNE TryRunLoad2               :\ Now pointing to load addr
:
LDX #3:JSR UseFileAddr:LDX #0     :\ Load file to it's load address
.TryRunLoad3
PLA:STA addr+0,X:INX              :\ Recover exec address
CPX #4:BNE TryRunLoad3
BIT &27A:BPL TryRunIO             :\ No Tube, run in I/O memory
CMP #&FF:BEQ TryRunIO             :\ Exec=FFxxxxxx, run in I/O memory
LDA #4:JSR TubeClaimDo            :\ Run in language memory
JMP TryRunExit
.TryRunIO
JSR CallC4:JMP TryRunExit         :\ Run in I/O memory
.CallC4
JMP (addr)
:
.CantRun
JSR errors:EQUB &93:EQUS "Cannot run this code":BRK
.BasCom
EQUS "BASIC":EQUB 13
.BasicTxt
EQUB 13:EQUS """"".HC"
:]:IF NOT_BasChain%:z%=P%-BasCom:P%=P%-z%:O%=O%-z%
:
.StarComm
LSR ENABLE:RTS:\ Enable flag
:
.QueryHandles:LDX #25:LDY #29:RTS
:
.NewFSStart
LDA ws:PHA:LDA ws+1:PHA
LDA #&77:JSR OSBYTE:JSR ServA     :\ Save ws, close Spool/Exec
PLA:STA ws+1:PLA:STA ws
.opt40
.opt80
RTS
:
.opt
CPX #40:BEQ opt40                 :\ Set double-stepping
CPX #80:BEQ opt80                 :\ Set single-stepping
CPX #8:BCS OptError
TXA:ASL A:TAX
LDA OptTable+0,X:STA ws+0
LDA OptTable+1,X:STA ws+1
TYA:JMP (ws)
:
.OptTable
EQUW opt0:EQUW opt1:EQUW opt2:EQUW opt3
EQUW opt4:EQUW opt5:EQUW opt6:EQUW opt7
:
.opt0                             :\ Reset 1,2,3,drive flags
STX DRVINT:STX DRVEXT             :\ Clear drive flags
LDA OPTFLG:AND #&F0:STA OPTFLG    :\ Keep MOS350, DirOwn, LibOwn, IAM
LDY #myfs:JSR Opt3b:INY:BNE Opt3c :\ Set myfs and auxfs to HADFSnum
:
.opt1                             :\ File message information
LSR OPTFLG:CPY #1:ROL OPTFLG:RTS
:
.opt2                             :\ Set primary fs number
.opt3                             :\ Set secondary fs number
PHA:TXA:TAY:PLA                   :\ Y=2/3 - myfs/auxfs offset
.Opt3a
CMP #4:BNE P%+4:.Opt3b:LDA #HADFSnum :\ Force to HADFSnum if =DFSnum
JSR FindWS:.Opt3c:STA (ws),Y:RTS
:
.OptError
JSR errors:EQUB 203:EQUS "Bad option":BRK
:
.opt4                             :\ Set boot option
CPY #4:BCS OptError
JSR CheckContext:JSR CheckHADFSDisk
LDX #URD-CSD:JSR GetDirX          :\ Fetch URD directory
JSR ChkHadfsChng                  :\ Check to see if disk changed
TYA:EOR &1112:AND #3:EOR &1112:STA &1112
\LDA &1112:\AND #&FC:\STA &1112
\TYA:\ORA &1112:\STA &1112           :\ Set option
ORA #4:STA OPTNUM:JMP SaveThisDir
:
.opt5                             :\ Set number of channels
CPY #6:BCS OptError               :\ If >5, out of range
.z%
LDA #2:CPY #2                     :\ Minimum 2 channels
:]:IFWS=&E00:z%=P%-z%:P%=P%-z%:O%=O%-z%
.z%
LDA #3:CPY #3                     :\ Minimum 3 channels
:]:IF WS<>&E00:z%=P%-z%:P%=P%-z%:O%=O%-z%
BCC Opt5a:TYA:.Opt5a              :\ If <minimum, set to minimum
SEC:SBC #2:ASL A:ASL A:ASL A:ASL A:\ Move into b4-b5
LDY #&CF:JSR MaskIntoDFx:AND #&30 :\ Store in &DF0,X
:
.SetCMOS                          :\ Y=mask, A=data
PHA:TYA:PHA:JSR WhatOS
BCC SetCMOSNone:JSR ReadCMOS      :\ Read current data
STA tmp:PLA:AND tmp:STA tmp:PLA:EOR tmp
EOR #&F0:TAY:LDA #162:JMP OSBYTE  :\ Write new data
.SetCMOSNone
PLA:PLA:RTS
:
.ReadCMOS
CLC:LDA &F4:ADC #30:TAX:PHA:LDA #161
JSR OSBYTE:PLA:TAX:TYA:EOR #&F0:TAY
.opt67NoSave
.optIgnore
RTS
:
\ -----------------------------------------------
\ FORCE DRIVE TO USE INTERNAL OR EXTERNAL DRIVERS
\ -----------------------------------------------
\ On entry, X=12 - use internal, X=14 - use external
\           Y=drive
\ -----------------------------------------------
.opt6
.opt7
CPY #8:BCS optIgnore              :\ Ignore out of range values
LDA BitTable,Y:EOR #&FF:AND DRVINT:\ Mask out bit for drive
CPX #14:BNE P%+5:ORA BitTable,Y:STA DRVINT
LDA BitTable,Y:EOR #&FF:AND DRVEXT:\ Mask out bit for drive
CPX #12:BNE P%+5:ORA BitTable,Y:STA DRVEXT
CPY #1:BNE opt67NoSave            :\ Need to save drive 1 to CMOS
TXA:ROR A:ROR A:ROR A:ROR A       :\ Pass Opt6/Opt7 flag into b6
EOR #64:JSR MaskIntoKBD           :\ Save in KBD links
AND #64:LDY #&BF:BNE SetCMOS      :\ Save to CMOS
:
\\ Move these
.WhatOS
PHA:TYA:PHA:LDA #0:LDX #255:JSR OSBYTE
PLA:TAY:PLA:CPX #3:RTS
:
.WhatFS
LDA #0:TAY:JMP OSARGS
:
.PrDrvChr
JSR GetDrvChr:JMP OSWRCH
:
\ =======================================
\ Directory and file information commands
\ =======================================
\ *Info - Display information on object
\ -------------------------------------
.info
JSR TryFilename:JSR CheckForDir
BMI infoRoot:JMP DisplayInfo
.infoRoot:\ Info on $
JSR CheckHADFSDisk
JSR PrText:EQUS "Drive ":BRK
JSR PrDrvChr
JSR PrText:EQUS ": ":BRK
LDX #0:.DoInfoLp
LDA &F00,X:JSR OSWRCH:INX:CPX #16:BNE DoInfoLp
JSR PrSpace
LDA #&1A:STA fptr:LDA #FSM DIV 256:STA fptr+1
LDY #0:SEC:JSR PrDate2
JSR PrText:EQUS "    Size: ":BRK
LDA &F1F:BMI DoInfoSizeBig              :\ Large FSM
LDA &F1E:AND #2:BEQ DoInfoSize          :\ Not split disk
LDA &F1D:LSR A
LDA &F1C:ROR A:LSR A:LSR A:LSR A
CLC:ADC #29:JSR PrDec:\ 33..48
JSR PrText:EQUS "*2":BRK:JMP DoInfoID
:
.DoInfoSizeBig                          :\ Display disk size
LDA &F1E:CMP #6:BCS InfoSizeHex         :\ >98000K
.DoInfoSize
STA numstore+2:LDA &F1D:STA numstore+1
LDA &F1C:STA numstore+0
AND #3:BNE InfoSizeHex                  :\ Not whole K
LDA #0:BIT &F1F:BMI P%+2:STA numstore+2 :\ Clear small disk byte 2
LSR numstore+2:ROR numstore+1:ROR numstore+0
LSR numstore+2:ROR numstore+1:ROR numstore+0
LDA numflg:PHA:LDA #ASC" ":STA numflg   :\ numflg overlaps catex
JSR PrDec16:PLA:STA numflg              :\ Print size as 5-digit decimal
LDA #ASC"K":JSR OSWRCH:JMP DoInfoID
:
.InfoSizeHex
LDX #&1E:JSR InfoF0x3             :\ Print disk size as 6-digit hex
.DoInfoID
JSR PrText:EQUS " ID: ":BRK
LDX #&19:JSR InfoF0x2
JSR PrSpace
LDA &F1F:BMI DoInfoNewStyle
LDA &F1E:AND #1:BEQ DoInfoHadVer
.DoInfoNewStyle
JSR PrText:EQUS "Data":BRK
BNE DoInfo6:.DoInfoHadVer
LDA #6:STA sect+0:LDA #0:STA sect+1:STA sect+2
JSR GetToFSM:\\ Get1Chunk:\ Read ROM header
LDA &F03:CMP #&4C:BNE DoInfo6
LDX &F07:LDA &F00,X:BNE DoInfo6
TAX:TAY:.DoInfoLp2
LDA &F09,X:BNE DoInfo5
INY:LDA #32:BNE DoInfo5a
.DoInfo5
CMP #ASC".":BCC DoInfo6
.DoInfo5a
JSR OSWRCH:INX
CPY #2:BNE DoInfoLp2
.DoInfo6
JMP OSNEWL
:
.InfoF0x3
JSR InfoF00:DEX
.InfoF0x2
JSR InfoF00:DEX
.InfoF00
LDA &F00,X:JMP PrHex
:
.PrName10
LDY #10
.PrName
LDA WS,X:JSR OSWRCH:INX:DEY
BNE PrName:RTS
:
.OptText
EQUS"Off)LoadRun)Exec"
:
\ ------------------------
\ Display catalogue header
\ ------------------------
.CatHeader
JSR XYtoF2
JSR SearchPathNF:CMP #1
BNE CatHead1:JMP Not_A_Dir
.CatHead1                         :\ Sect0/1/2/3=dir start
JSR CheckNames2                   :\ Check names without checking context
.CatHead3
JSR get_chk_dir:LDX #0
.CatHeadLp
LDA &1100,X:JSR OSWRCH:INX
CPX #10:BNE CatHeadLp
JSR PrText:EQUS " (":BRK
LDA &110D:JSR PrHex
JSR PrText:EQUS ")     ":BRK
JSR DoIOwn:BPL CatHeadOwn
JSR PrText:EQUS "Public":BRK
BMI CatHead4
.CatHeadOwn
JSR PrText:EQUS "Owner ":BRK
LDA &1112:JSR HexTopDigit
JSR OSWRCH:LDA &1113:JSR PrHex
.CatHead4
JSR OSNEWL:LDX #0:LDY #16:JSR PrName
JSR PrText:EQUS "    Option ":BRK
JSR GetOptNumber:TAX:ORA #48
JSR OSWRCH:JSR PrText:EQUS " (":BRK
TXA:ASL A:ASL A:TAX:LDY #4
.CatOptLp
LDA OptText,X:JSR OSWRCH
INX:DEY:BNE CatOptLp
EOR #&09:CMP #ASC" ":BEQ P%+4:LDA #ASC")"
JSR OSWRCH
JSR PrText:EQUS "     Dir. ":BRK
LDX #&10:JSR PrName10
JSR PrText:EQUS "     Lib. ":BRK
LDX #&1A:JSR PrName10:.CatHeadDone:JMP OSNEWL
:
\ -----------------------------------------------------
\ *EX and *CAT - list directory objects and information
\ -----------------------------------------------------
.ex
LDA #255:EQUB &2C:\ next inst. hidden by BIT &A900
.cat
LDA #0
STA catex:JSR CatHeader:JSR OSNEWL:LDX #0
.DispStart
BIT &FF:BMI DispEnd               :\ Escape occured
JSR start24X:BEQ DispChunk
.DispFiles
LDA (fptr),Y:BEQ DispNext         :\ This entry empty
DEC files:JSR DoIOwn:BPL DispOwn  :\ Dec filecount, jump if own all files
LDY #7:LDA (fptr),Y:BMI DispNext  :\ Private file, skip it
.DispOwn
LDA catex:BEQ DispCat
JSR DisplayInfo:JMP DispNext
.DispCat
JSR PrFilename:JSR PrAccess:INX   :\ Print filename...access, inc column
LDY #13:TXA:AND #3:BEQ P%+4       :\ Inc column
LDY #32:TYA:JSR OSASCI            :\ Col=4x, print <cr>, else <spc>
.DispNext
JSR add24:LDA files:BNE DispFiles :\ Still more to do
.DispChunk
JSR NextChunk:BNE DispStart       :\ Do another chunk
.DispEnd
LDA #134:JSR OSBYTE:TXA           :\ Print NL if not in column 0
\BEQ P%+5:\JMP OSNEWL:\RTS
BNE CatHeadDone:RTS
:
.DoIOwn                           :\ Check if I own this directory
TYA:PHA:TXA:PHA                   :\ Save registers
LDX &1112:LDY &1113               :\ Get user from directory
.DoIOwnXY
LDA USERNUM+1:AND #8:BNE DoIOwnOk :\ Is System bit set?
TXA:EOR USERNUM+1:AND #&F0        :\ Check user b8-b11
CLC:BNE DoIOwnPublic
TYA:EOR USERNUM:BNE DoIOwnPublic  :\ Check user b0-b7
.DoIOwnOk:SEC                     :\ Flag 'Owner'
.DoIOwnPublic
PLA:TAX:PLA:TAY:LDA #&00          :\ &00=Owner
BCS P%+4:LDA #&FF:RTS             :\ &FF=Public
:
.start24
LDX #0
.start24X
LDY #0
.start24Y
.z%
LDA &110C:BPL start24Z
JSR errors:EQUB 206:EQUS "Unsupported directory":BRK
.start24Z
:]:IF NOT_SmallDIR%:z%=P%-z%:P%=P%-z%:O%=O%-z%
LDA #24:BIT &110C:BPL P%+4:LDA #33
STA fptr:LDA #&11:STA fptr+1   :\ Point to first entry
LDA &110C:AND #31:STA files    :\ Fetch number of objects
RTS
.add24
LDY #0
LDA #24:BIT &110C:BPL P%+4:LDA #35
CLC:ADC fptr:STA fptr
LDA fptr+1:ADC #0:STA fptr+1   :\ Point to next entry
\\ NB, X is number of /displayed/ files
\\ Need to be consistant with calling add24
CPX files:RTS                  :\ EQ if no more objects
:
.GetUp
LDA &110C:BPL GetUp16
LDA &111C:STA sect+2:LDA &111B:STA sect+1
LDA &111A:STA sect+0:RTS
:]:IF _SmallDIR%:z%=P%-GetUp:P%=P%-z%:O%=O%-z%
.GetUp16
LDA #0:STA sect+2:LDA &110B:STA sect+1
LDA &110A:STA sect+0:RTS
:
.GetLink
BIT &110C:BPL GetLink1
LDA &1117:STA sect+0:LDA &1118:STA sect+1
LDA &1119:JMP GetLink2
:]:IF _SmallDIR%:z%=P%-GetLink:P%=P%-z%:O%=O%-z%
.GetLink1
LDA &110E:STA sect+0:LDA &110F:STA sect+1
LDA #0:.GetLink2
STA sect+2:ORA sect+1:ORA sect+0:RTS
:
.NextChunk
JSR GetLink:BEQ NextChunkNo
JSR GetDir:LDA #&FF
.NextChunkNo
RTS
:
.PrAccess
TXA:PHA:LDX #0
LDY #7:JSR TryAccChar  :\ 'P'
INY:JSR TryAccChar:PHP :\ 'D'
LDY #3:JSR TryAccChar  :\ 'L'
PLP:BCS PrAccSlash:DEY
.PrAccPublic
\JSR TryAccChar         :\ 'E'
\BCS PrAccSlash
DEY:JSR TryAccCharX    :\ 'W'
DEY:JSR TryAccCharX    :\ 'R'
:BCS PrAccSlash
:INY:INY:JSR TryAccChar:DEY:DEY
.PrAccSlash
CPY #4:BCS PrAccEnd:JSR PrSlash
CPY #3:LDY #6:BCC PrAccPublic
.PrAccEnd
LDA #32
.PrAccSpcs
JSR OSWRCH:INX:CPX #7
BNE PrAccSpcs
PLA:TAX:RTS
:
.TryAccCharX
LDA #&FF
.TryAccChar
CLC:EOR (fptr),Y:BPL TryAccNo
LDA PrAccChars,Y:JSR OSWRCH
INX:SEC
.TryAccNo
RTS
.PrAccChars:EQUS "RWELrwePD"
:
.DispInf2
JSR PrFilename
:
JSR GetLoadHigh
\INY:\INY:\INY:\LDA (fptr),Y     :\ Get load high byte
\JSR LoadHighByte             :\ Remove year bits if present
JSR PrHex                    :\ Print load high byte
DEY:LDX #3:JSR pr4hexLp      :\ Print rest of load address
JSR Pr4Hex                   :\ Print exec address
:
JSR PrText:EQUS "  ":BRK
INY:INY
LDA (fptr),Y:AND #7
JSR PrHex:DEY:JMP Pr2Hex
:
.GetLoadHigh
LDY #13:LDA (fptr),Y         :\ Get load address high byte
.LoadHighByte
BIT &110C:BMI LoadHighOk     :\ Return unchanged if large dir
ROL A:ROL A:ROL A:PHP        :\ Move b5 into Cy
ROR A:PLP:PHP:ROR A:PLP:ROR A:\ Copy b5 into b6 and b7
.LoadHighOk
RTS
:
.DisplayInfo
TXA:PHA
JSR DispInf2
JSR PrText:EQUS "  ":BRK
JSR PrAccess:JSR PrSpace:LDY #&14
.z%
BIT &110C:PHP:BPL P%+4:LDY #&1B:PLP  :\ Point to first date
JSR PrDate:JSR PrSpace               :\ Print date
LDY #&19:BIT &110C:BPL P%+8          :\ Point to second date
:]:IF _SmallDIR%:z%=P%-z%:P%=P%-z%:O%=O%-z%
JSR PrDate:JSR PrSpace               :\ Print mod. date
\LDY #&12:\JSR PrUser                :\ Account
\JSR PrSpace:\LDA #ASC"(":\JSR OSWRCH
\LDY #&12:\JSR PrUser                :\ Aux.
\LDA #ASC")":\JSR OSWRCH
LDY #&18:LDA (fptr),Y:DEY            :\ Get sector byte three
BIT &110C:BMI P%+4:LDA #0            :\ Zero third byte if small dir
JSR PrHex:JSR Pr2Hex                 :\ Print three-byte sector
PLA:TAX:JMP OSNEWL
:
.PrDecS
JSR PrDec
.PrSlash
LDA #ASC"/":JMP OSWRCH
:
:
.PrDate
CLC
.PrDate2
\ --------------------------
\ DISPLAY DATE IN FILE ENTRY
\ -----------------------------------------------------------
\ On entry, (fptr),Y -> two-byte date entry
\           CC       -> date split over locations (small DIR)
\           CS       -> year compacted (FSM or large DIR)
\ -----------------------------------------------------------
:
PHP:LDA (fptr),Y             :\ Get day or month
LSR A:LSR A:LSR A:JSR PrDecS :\ Print it, print slash
INY:LDA (fptr),Y:AND #15     :\ Get month
JSR PrDecS                   :\ Print month, print slash
LDA (fptr),Y:\BEQ PrZeroZero :\ Get year b0-b3
PLP:BCC PrDateFar            :\ Year split amongst locations
DEY:ROL A                    :\ Point at year b4-b6, move year into Cy
AND #&F0:EOR (fptr),Y
AND #&F0:EOR (fptr),Y        :\ Copy in year b4-b6
ROL A:ROL A:ROL A:ROL A      :\ Rotate into b0-b6
AND #127:BPL PrDateAdd
:
.PrDateFar
LDY #9                                 :\ Point to year b4
PHA:LDA (fptr),Y:ROL A:PLA:ROR A       :\ Move b7 into year b4
LDY #&0D:PHA:LDA (fptr),Y              :\ Get year b5-b6
.z%
CMP #&C0:BCC PrDateFix                 :\ b7-6<>11, use year bits
PLA:LSR A:LSR A:LSR A:BPL PrDateAdd    :\ Force a short year
:]:IF _NoYearFix%:z%=P%-z%:P%=P%-z%:O%=O%-z%
.PrDateFix
ROL A:ROL A:PLA:ROR A                  :\ Move b6 into year b5
PHA:LDA (fptr),Y:ROL A:PLA:ROR A       :\ Move b7 into year b6
ROR A:AND #127
:
.PrDateAdd
CLC:ADC #81:LDY #19          :\ A = 81..208, prepare for 19xx
.PrDateLp
CMP #100:BCC PrDateCC        :\ Year<100, use this century
SBC #100:INY:BNE PrDateLp    :\ Reduce year, increase century
.PrDateCC
PHA:TYA:JSR PrDec            :\ Print the century number
PLA                          :\ ...and the year number
:
\\ Move to HADFS1
.PrDec:\ Print decimal number
JSR BINtoBCD
:
.PrHex:\ Print hex number
PHA:JSR HexTopDigit:JSR OSWRCH:PLA
.PrNyb:\ Print hex digit
JSR HexDigit:JMP OSWRCH
:
\\.PrZeroZero
\\PLP:\JSR PrHex
.PrZero
LDA #0:BEQ PrHex
:
.AccessRt
RTS
:
\.PrUser
\LDA &1100,Y:\JSR HexTopDigit:\JSR OSWRCH
\LDA &1101,Y:\JMP PrHex
:
.Pr2Hex
LDX #2:BNE pr4hexLp
.Pr4Hex
LDX #4:INY:INY:INY
.pr4hexLp
LDA (fptr),Y:JSR PrHex
DEY:DEX:BNE pr4hexLp
INY:INY:INY:INY:INY:BNE PrSpace
.Pr2Space
JSR PrSpace
.PrSpace
LDA #32:JMP OSWRCH
:
.PrFilename
LDY #0:.PrNameLp
LDA (fptr),Y:AND #127:JSR OSWRCH
INY:CPY #10:BNE PrNameLp
BEQ PrSpace
:
\ ---------------------------
\ *Access - set object access
\ ---------------------------
.Access
JSR F2toXY:JSR TryFilename
JSR CheckForDir:BMI AccessRt
JSR CanISave:\ Check I own
JSR CheckHadfsDiskX
JSR CheckNotOpenFF
JSR SkipSpc
LDA #0:STA attrc:LDA #&33:STA attrs
.AccessLp
LDA (&F2),Y:INY
CMP #ASC"!":BCC AccessEnd
CMP #ASC"/":BNE AccessChar
LDA #4:STA attrc:BNE AccessLp
.AccessChar
AND #&DF:LDX #7
.AccessLook
CMP PrAccChars,X:BEQ AccessIn
DEX:BPL AccessLook
JSR errors:EQUB 207:EQUS "Bad attribute":BRK
.AccessIn
TXA:CLC:ADC attrc:AND #7:EOR #7:TAX
LDA BitTable,X:EOR attrs:STA attrs
BCC AccessLp
.AccessEnd
LDY #7
.AccessByte
LDA (fptr),Y:ROL A:ROL attrs:ROR A
STA (fptr),Y:DEY:BPL AccessByte
JMP SaveThisDir
:
.BitTable:EQUB 128:EQUB 64:EQUB 32:EQUB 16:EQUB 8:EQUB 4:EQUB 2:EQUB 1
:
\ --------------
\ *FREE and *MAP
\ --------------
.Free
LDX #&FF:EQUB &2C                        :\ X=&FF - *FREE
.Map                                     :\ numflg overlaps drive
LDX #0                                   :\ X=&00 - *MAP
JSR CheckContext:TXA:STA catex:PHA       :\ Ensure mounted, set map/free
\LDA numflg:\PHA:\TXA:\STA catex:\PHA    :\ Set map/free flag
JSR GetDrive:JSR AddUpFree               :\ Get FSM and add up free space
LDA numstore+1:PHA:LDA numstore+2:PHA    :\ Save total free space
LDA numstore+3:PHA
LDA catex:AND #ASC" ":STA numflg         :\ Prepare '0' or ''
BEQ P%+5:JSR PrSect                      :\ If *free, print hex sectors
JSR PrFreeNum                            :\ Print '<nnnn> bytes '
JSR PrText:EQUS "free":EQUB 13:BRK
PLA:STA numstore+3
PLA:STA numstore+2:PLA:STA numstore+1    :\ Restore total free space
PLA:BPL MapDone                          :\ *map, so finish
JSR AddUpUsed:JSR PrSect                 :\ Calculate and print used
JSR PrFreeNum                            :\ Print '<nnnn> bytes '
JSR PrText:EQUS "used":EQUB 13:BRK
.MapDone
\PLA:\STA numflg:RTS                     :\ Restore numflg/drive
:
.AddUpUsed
SEC
LDA &F1C:SBC numstore+1:STA numstore+1
LDA &F1D:SBC numstore+2:STA numstore+2
RTS
:
\ ---------------------
\ Print '<nnnn> bytes '
\ Corrupts numsub/catex
\ ---------------------
.PrFreeNum
.z%
LDA #0:STA numstore
:]:IF _FreeKilo%:z%=P%-z%:P%=P%-z%:O%=O%-z%
.z%
LDA numstore+1:STA numstore+0
LDA numstore+2:STA numstore+1
LDA #0:STA numstore+2
CLC:ROR numstore+1:ROR numstore+0
CLC:ROR numstore+1:ROR numstore+0
:]:IF NOT_FreeKilo%:z%=P%-z%:P%=P%-z%:O%=O%-z%
JSR PrDec32:JSR PrText                   :\ Print number and string
EQUS LEFT$("K ",_FreeKilo%)+LEFT$(" bytes ",NOT_FreeKilo%):EQUB 0
RTS
:
.PrSect
LDA numstore+3:JSR PrHex
LDA numstore+2:JSR PrHex
LDA numstore+1:JSR PrHex
JSR PrText:EQUS " Sectors =  ":BRK
LDA #32:STA numflg
RTS
.AddUpFree
JSR CheckHADFSDisk:\ Also loads sector 70
BIT catex:BMI Map3
JSR PrText:EQUS "Free Space Map, drive ":BRK
JSR PrDrvChr:JSR OSNEWL:JSR OSNEWL
.Map3
LDA #0:STA numstore+1:STA numstore+2:STA numstore+3
LDX #&20:.MapLp
BIT catex:BMI Map4
JSR PrZero:LDA &F01,X:JSR PrHex:LDA &F00,X:JSR PrHex
LDA #ASC"+":JSR OSWRCH
JSR PrZero:LDA &F03,X:JSR PrHex:LDA &F02,X:JSR PrHex
JSR Pr2Space:JSR PrSpace
.Map4
LDA numstore+1:CLC:ADC &F02,X:STA numstore+1
LDA numstore+2:ADC &F03,X:STA numstore+2
INX:INX:INX:INX
LDA &F00,X:ORA &F01,X:BNE MapLp
BIT catex:BMI P%+5:JSR OSNEWL
RTS
:
]
PRINT CHR$11;STRING$(20,CHR$9);(O%-mcode%)DIV1024":";(O%-mcode%)MOD1024" Kbytes"
OSCLI"SAVE ROMa "+STR$~mcode%+" "+STR$~O%+" 3000 3000":O%=mcode%:Block%=P%
IF O%>&7BFF PRINT'"Overrunning screen"'':VDU7
>"S.HADFS3"