REM >HADFS4
REM Block 4 of HADFS source
REM 07/06/1992, 4:30pm
REM 20/11/1994, RunExec now in #2
REM Solved find_blank problem
REM 26/08/1996: Rewritten OsFile
REM 28/07/1998: Bugfix for =TIME$ on MOS 5.xx
REM DiskMainLoop now with disk access code, path scanning now in here
:
PRINT "Assembling S.HADFS4"
REM P%=hadfs4
O%=P%-Block%+mcode%
[OPT0
:
.GetOptNumber
LDA OPTNUM:AND #4:BNE GetOptNumOk
LDX #7:.GetOptLp1:LDA addr,X:PHA:DEX:BPL GetOptLp1
LDX #URD-CSD:JSR DIRtoSect:JSR GetToFSM
LDA &F12:ORA #4:STA OPTNUM    :\ Also updates user b8-b11
LDX #0:.GetOptLp2:PLA:STA addr,X:INX:CPX #8:BNE GetOptLp2
.GetOptNumOk
LDA OPTNUM:AND #3:RTS
:
\ Checking names may result in a disk access
\ This will corrupt addr/sect/drive
\ -------------------------------------------------------------
\ CheckNames - Checks context and names, disk name on CSD drive
\ CheckNames2 - Checks names, disk name on drive
\ Corrupts A,X,Y
\ -------------------------------------------------------------
.CheckNames
CLC:EQUB &A9                  :\ LDA #nn to skip following byte
.CheckNames2
SEC
LDX #7:.ChkNamSv:LDA addr,X:PHA:DEX:BPL ChkNamSv
BCS ChkName1                  :\ CS=Check names only
JSR CheckContext:JSR SetDriveCSD
:
.ChkName1
LDA VFLG:BPL ChkDisk          :\ Disk name not valid, fetch it
AND #31:CMP drive:BEQ ChkCSD  :\ Valid name for this drive, jump past
\LDA VFLG:\AND #31:\CMP drive:\BNE ChkDisk
\BIT VFLG:\BMI ChkCSD
.ChkDisk
JSR CheckHADFSDisk
.ChkCSD
BIT VFLG:BVS ChkLIB
JSR CSDtoSect:\ Do I need to STA DRVTMP ?
\JSR GetCSD:JSR GetToFSM:LDX #9
.ChkCSDlp
LDA &F00,X:STA DIRNAME,X:DEX
BPL ChkCSDlp:JSR CheckOwner
AND #64:LDY #&BF:JSR MaskIntoOPTFLG :\ Set DirOwned
\PHA:\LDA #&BF:\JSR MaskOPTFLG:\ MaskOwner
\PLA:\AND #64:\JSR IntoOPTFLG:\ SetOwner
LDA VFLG:ORA #64:STA VFLG
.ChkLIB
LDA VFLG:AND #32:BNE ChkNmEnd
LDX #LIB-CSD:JSR DIRtoSect
JSR GetToFSM:LDX #9
.ChkLIBlp
LDA &F00,X:STA LIBNAME,X:DEX
BPL ChkLIBlp:JSR CheckOwner
AND #32:LDY #&DF:JSR MaskIntoOPTFLG :\ Set LibOwned
\PHA:\LDA #&DF:\JSR MaskOPTFLG:\ MaskOwner
\PLA:\AND #32:\JSR IntoOPTFLG:\ SetOwner
LDA VFLG:ORA #32:STA VFLG
.ChkNmEnd
LDX #0:.ChkNamRes:PLA:STA addr,X:INX:CPX #8:BNE ChkNamRes
RTS
:
.CheckOwner
TYA:PHA:TXA:PHA:LDX &F12:LDY &F13:JMP DoIOwnXY
:
.CheckContextXY
JSR XYtoF2
.CheckContext
TYA:PHA:TXA:PHA
LDA CSD:ORA CSD+1:BNE ChkCtxOk
JSR SetContext                       :\ Look for drives
.ChkCtxOk
LDA URD:ORA URD+1:BNE ChkCtxLib
STA VFLG:LDX #URD-CSD:JSR CSDtoDIR :\ SetFromCSD - Set URD to CSD
.ChkCtxLib
LDA LIB:ORA LIB+1:BNE ChkCtxEnd
STA VFLG:JSR FindLib:BNE ChkCtxEnd
LDX #LIB-CSD:JSR CSDtoDIR :\ SetFromCSD -  :\ Set LIB to CSD
.ChkCtxEnd
PLA:TAX:PLA:TAY:RTS
:
:
.SetContext
TYA:PHA:LDY #31                    :\ Test drives from 31 downwards
.SetCtxLp1
STY drive:JSR ReadFSM:BNE SetCtxNxt:\ Not HADFS disk, ignore
LDA &F1F:ROL A                     :\ Get disk flags
ROL A:BPL P%+5:STY URD+d           :\ Set URD if b13 set
ROL A:BPL P%+5:STY LIB+d           :\ Set URD if b12 set
ROL A:BPL P%+5:STY CSD+d           :\ Set CSD if b11 set
.SetCtxNxt
DEY:CPY #2:BNE SetCtxLp1           :\ Don't check floppies
LDY #8+d                           :\ 4 bytes per CSD/LIB/URD
.SetCtxLp2
TYA:PHA:LSR A:LSR A:CLC:ADC #64    :\ Convert offset into Osbyte value
TAY:JSR Osbyte90_6:PLA:TAY         :\ See if any ROMs want to override
TXA:BMI P%+5:STA CSD,Y             :\ Set drive if ROM responds
DEY:DEY:DEY:DEY:BPL SetCtxLp2      :\ Loop through URD, LIB, CSD
LDA #0:STA VFLG:STA CSD+2          :\ Clear validity flags
STA CSD+1:LDA #71:STA CSD+0        :\ Set CSD to '$'
PLA:TAY:RTS
:
.FindLib
TXA:PHA:TYA:PHA
LDA &F2:PHA:LDA &F3:PHA
LDA LIB+d:STA drive
JSR ReadFSM:BNE NoLibDrv
LDA #LibName AND 255:STA &F2
LDA #LibName DIV 256:STA &F3
LDY #0:JSR LookFromRoot2
BNE NoLibDrv
LDX #LIB-CSD:JSR SectToDIR:\SetFromB0
.NoLibDrv
PLA:STA &F3:PLA:STA &F2
PLA:TAY:PLA:TAX
LDA LIB:ORA LIB+1:RTS
:
.LibName
EQUS "Library":EQUB 13
:
\.RootSector
\ JSR SectFSM:\ INC sect:\ RTS
\LDA #71:\STA sect+0:\LDA #0:\STA sect+1:\STA sect+2:\RTS
:
.LookFromRoot:\ A=drive
STA drive
.LookFromRoot2
JSR SectRoot:JSR SearchPathEntry
CMP #2:RTS
:
.TryFilename
JSR XYtoF2
.SearchPathBadNF
JSR SearchPathname
BMI Bad_Filename
BEQ FileNotFound
.SearchPathOk
RTS
.SearchPathNF
JSR SearchPathname
BNE SearchPathOk
.FileNotFound
JSR file_errors:EQUB 214
EQUS "not found":BRK
.SearchPathBad
JSR SearchPathname
BPL SearchPathOk
.Bad_Filename
JSR errors:EQUB 204
EQUS "Bad filename":BRK
.CheckPath
BIT pathflg:BPL FileNotFound
RTS
:
.get_p_char
CLC:JSR GSREAD:BCS GetPcharX
.check_valid_char
AND #127:\ Lose bit 7
CMP #ASC"!":BCC Bad_Filename
CMP #127:BCS Bad_Filename
RTS
:
.SetAbs
LDA #&40:BNE SearchFlag
.GetPcharX
LDA #128
.SearchFlag
ORA pathflg:STA pathflg
RTS
:
.check_specials
JSR SetAbs
.check_specials2
LDA OBJECT+1:CMP #32
BNE Bad_Filename
RTS
:
.SearchPathname
JSR CheckContext
.SearchPath2
\JSR GetCSD
JSR CSDtoSect:STA DRVTMP
.SearchPathEntry
\ (&F2),Y=pathname
LDA #0:STA pathflg:\ not end, not abs
CLC:JSR GSINIT:BEQ GetPcharX
.SearchPathLp
LDX #0:.SearchPathLp2
JSR get_p_char:BCS SearchDot
CMP #ASC".":BEQ SearchDot
STA OBJECT,X:INX:CPX #11
BCC SearchPathLp2
.Bad_Fname2
JMP Bad_Filename
\ object name too long
.SearchDot
LDA #32
.SearchDotLp
STA OBJECT,X:INX:CPX #11
BCC SearchDotLp
LDA OBJECT+0
CMP #32:BEQ Bad_Fname2
CMP #ASC"^":BEQ SearchUp
CMP #ASC"@":BEQ SearchCSD
CMP #ASC":":BEQ SearchSpecial
CMP #ASC"'":BCS SearchNotRoot
CMP #ASC"$":BCS SearchSpecial
.SearchNotRoot
LDA DRVTMP:CMP drive
BEQ SearchDot2
LDA sect+0:PHA:LDA sect+1:PHA:LDA sect+2:PHA
JSR CheckHADFSDisk  :\\ This now saves sect
PLA:STA sect+2:PLA:STA sect+1:PLA:STA sect+0
.SearchDot2
JSR look_in_this_dir
BEQ SearchExit:\ A=0, NF
BIT pathflg:BPL SearchNotEnd
TAX:\ Set Z flag
.SearchExit
RTS:\ A=0,1,2; (fptr)=entry;
\ (sect)=sector
:
.SearchNotEnd
CMP #2:BNE P%+5:JMP SearchPathLp
JMP Not_A_Dir
:
.SearchUp:\ ^
JSR check_specials2
JSR get_chk_dir:JSR GetUp
JMP SpecialCheckEnd
:
.SearchCSD
LDX #CSD-CSD:BEQ SearchSpecialEtc
.SearchSpecial
BEQ SearchRoot
LDX #URD-CSD:\ prepare for '&'
.SearchSpecialEtc
PHA:JSR check_specials:PLA
CMP #ASC"%":BEQ SearchLib
.SearchSpecialX
JSR DIRtoSect
.SpecialCheckEnd
BIT pathflg:BMI SearchSpecialEnd
JMP SearchPathLp
.SearchSpecialEnd
LDA #&FF:STA fptr+1:\ abs pointer
LDA #2:RTS:\ dir, (sect)=sector
:
.SearchLib
LDX #LIB-CSD:BNE SearchSpecialX
:
.SearchRoot
JSR SectRoot
LDA OBJECT+2:CMP #32:BNE Bad_Drive
LDA OBJECT+1:CMP #32
BEQ SrchRt2:\BEQ SpecialCheckEnd
JSR CheckDrive:STA drive:\JSR SetDrives
.SrchRt2
JSR SetAbs:BNE SpecialCheckEnd
:
.GetDriveEQ
JSR GetChar:BEQ GetDrvOk
.GetDrive
LDA CSD+d:STA drive
JSR GetChar:BEQ GetDrv2
JSR CheckDrive:INY:STA drive
.GetDrv2
LDA drive:CMP #&FF
.GetDrvOk
RTS
:
.CheckDrive
CMP #ASC"0":BCC Bad_Drive
CMP #ASC":":BCC GoodDrive
CMP #ASC"A":BCC Bad_Drive
AND #&5F:SBC #8
.GoodDrive
SBC #47:AND #31:RTS
:
.Bad_Drive
JSR errors:EQUB 205
EQUS "Bad drive":BRK
:
.SetDriveCSD                  :\ Set drives from CSD drive
LDA CSD+d
.SetDrives                    :\ Set drives from A
AND #31:STA drive:STA DRVTMP
RTS
:
.look_in_this_dir
TYA:PHA
.LookDirStart
JSR get_chk_dir
JSR start24:BEQ look_none_here
.LookDirLp
LDY #0:LDA (fptr),Y:BEQ look_miss_entry
\ X contains entry number (?)
INX:JSR DoIOwn:BPL LookDirLp2
LDY #7:LDA (fptr),Y:BMI look_miss_entry
LDY #0:.LookDirLp2
LDA OBJECT,Y:CMP #ASC"#":BEQ look_char_match
CMP #ASC"*":BEQ look_file_match
LDA (fptr),Y:AND #127
CMP OBJECT,Y:BEQ look_char_match
EOR #32:CMP OBJECT,Y
BNE look_miss_entry
.look_char_match
INY
CPY #10:BNE LookDirLp2
.look_file_match
JSR GetSectAddr
LDY #8:LDA (fptr),Y:ROL A
PLA:TAY
LDA #0:ADC #1:RTS
:\ 1=file
:\ 2=dir
:\ sect holds sector start
:\ fptr points to entry
:\
.look_miss_entry
JSR add24:BNE LookDirLp
.look_none_here
::JSR GetLink::BEQ look_no_match
\\LDA &110E:\\ORA &110F:\\BEQ look_no_match
\\LDA &110E:\\STA sect+0:\\LDA &110F:\\STA sect+1
BIT &FF:BMI look_Esc
JMP LookDirStart
.look_no_match
PLA:TAY
LDA #0:RTS
.look_Esc
JSR errors:EQUB 17:EQUS "Escape":BRK
:
\.check_for_dir
.CheckForDir
CMP #2:BNE ChkForDirOk
LDA fptr+1:CMP #&FF:BEQ CheckForDir1
LDA #2:.ChkForDirOk
ORA #0:RTS
.CheckForDir1
LDA sect+2:BNE CheckForDir4
LDA sect+1:BNE CheckForDir4
LDA sect:CMP #2:BCC CheckForDir3
CMP #70:BCC CheckForDir4
CMP #74:BCS CheckForDir4
.CheckForDir3
LDA #71:STA sect+0:LDA #&80:RTS
\ Pointing to '$'
.CheckForDir4
LDA sect+0:STA start+0:LDA sect+1:STA start+1:\\ Make subroutine
JSR GetDir:JSR GetUp
JSR get_chk_dir
\ fall through to...
:
.LookForEntry
TYA:PHA:TXA:PHA:JSR start24
.LookForLp1
JSR start24:BEQ LookForNxt
.LookForLp2
LDA (fptr),Y:BEQ LookForSkp
INX:LDY #&17:LDA (fptr),Y:CMP start+1:BNE LookForSkp
DEY:LDA (fptr),Y:CMP start+0:BNE LookForSkp
DEY:DEY:LDA (fptr),Y:AND #7:DEY:ORA (fptr),Y
DEY:ORA (fptr),Y:BNE LookForOk:\ Must be non-zero length
.LookForSkp
JSR add24:BNE LookForLp2
.LookForNxt
JSR NextChunk:BNE LookForLp1
.Broken_Dir:\ Couldn't find object
JSR errors:EQUB 168
EQUS "Broken directory":BRK
.LookForOk
JSR GetSectAddr
PLA:TAX:PLA:TAY:LDA #2:RTS
:
.GetSectAddr
LDY #&16:LDA (fptr),Y:STA sect+0
INY:LDA (fptr),Y:STA sect+1:INY
LDA #0:BIT &110C:BPL P%+4:LDA (fptr),Y
STA sect+2:RTS
:
:
\.hadfs5
]
PRINT CHR$11;STRING$(20,CHR$9);(O%-mcode%)DIV1024":";(O%-mcode%)MOD1024" Kbytes"
:
REM PRINT CHR$11;STRING$(20,CHR$9);(O%-mcode%)DIV1024":";(O%-mcode%)MOD1024" Kbytes"
REM OSCLI"SAVE ROMa "+STR$~mcode%+" "+STR$~O%+" 3000 3000":O%=mcode%:Block%=P%
REM IF O%>&7BFF PRINT'"Overrunning screen"'':VDU7
>"S.HADFS5"