10
20
30
40
50
60
70
80
90
100
110
120
130 :
140 PRINT "Assembling S.HADFS3"
150 O%=P%-Block%+mcode%
160 [OPT0
170 :
180 .GetOptNum
190 TXA:PHA:LDA OPTNUM:AND #4:BNE GetOptNumOk:LDX #7
200 .GetOptLp1:LDA addr,X:PHA:DEX:BPL GetOptLp1
210 LDX #URD-CSD:JSR DIRtoSect:JSR GetToFSM
220 LDA FSM+&12:ORA #4:STA OPTNUM :\ Also updates user b8-b11 and PRIV flag
230 LDA FSM+&13:STA USERNUM :\ User number b0-b7
240 LDX #0:.GetOptLp2:PLA:STA addr,X:INX:CPX #8:BNE GetOptLp2
250 .GetOptNumOk
260 PLA:TAX
270 .GetOptNum2
280 LDA OPTNUM:AND #3:RTS
290 :
300 \ Checking names may result in a disk access
310 \ This will corrupt addr/sect/drive
320 \ -------------------------------------------------------------
330 \ CheckNames - Checks context and names, disk name on CSD drive
340 \ CheckNames2 - Checks names, disk name on drive
350 \ Corrupts A,X,Y
360 \ -------------------------------------------------------------
370 .CheckNames
380 CLC:EQUB &A9 :\ LDA #nn to skip following byte
390 .CheckNames2
400 SEC
410 LDX #7:.ChkNamSv:LDA addr,X:PHA:DEX:BPL ChkNamSv
420 BCS ChkName1 :\ CS=Check names only
430 JSR CheckContext:JSR SetDriveCSD
440 :
450 .ChkName1
460 LDA VFLG:BPL ChkDisk :\ Disk name not valid, fetch it
470 AND #31:CMP drive:BEQ ChkCSD :\ Valid name for this drive, jump past
480 .ChkDisk
490 JSR CheckHADFSDisk
500 .ChkCSD
510 BIT VFLG:BVS ChkLIB
520 JSR CSDtoSect:JSR GetToFSM:LDX #9
530 .ChkCSDlp
540 LDA &F00,X:STA DIRNAME,X:DEX
550 BPL ChkCSDlp:JSR DoIOwnFSM
560 AND #64:LDY #&BF:JSR MaskIntoOPTFLG :\ Set DirOwned
570 LDA VFLG:ORA #64:STA VFLG
580 .ChkLIB
590 LDA VFLG:AND #32:BNE ChkNmEnd
600 LDX #LIB-CSD:JSR DIRtoSect
610 JSR GetToFSM:LDX #9
620 .ChkLIBlp
630 LDA &F00,X:STA LIBNAME,X:DEX
640 BPL ChkLIBlp:JSR DoIOwnFSM
650 AND #32:LDY #&DF:JSR MaskIntoOPTFLG :\ Set LibOwned
660 LDA VFLG:ORA #32:STA VFLG
670 .ChkNmEnd
680 LDX #0:.ChkNamRes:PLA:STA addr,X:INX:CPX #8:BNE ChkNamRes
690 RTS
700 :
710 .CheckContextXY
720 JSR XYtoF2
730 .CheckContext
740 TYA:PHA:TXA:PHA
750 LDA CSD:ORA CSD+1:ORA CSD+2:BNE ChkCtxOk
760 JSR SetContext :\ Look for drives
770 .ChkCtxOk
780 LDA URD:ORA URD+1:ORA URD+2:BNE ChkCtxLib
790 STA VFLG:LDX #URD-CSD:JSR CSDtoDIR :\ Set URD to CSD
800 .ChkCtxLib
810 LDA LIB:ORA LIB+1:ORA LIB+2:BNE ChkCtxEnd
820 STA VFLG:JSR FindLib:BNE ChkCtxEnd
830 LDX #LIB-CSD:JSR CSDtoDIR :\ Set LIB to CSD
840 .ChkCtxEnd
850 PLA:TAX:PLA:TAY:RTS
860 :
870 :
880 \ ------------------------------------------------------------
890 \ Set context by scanning drives looking for defaults to mount
900 \ ------------------------------------------------------------
910 .SetContext
920 TYA:PHA:LDY #31 :\ Test drives from 31 downwards
930 .SetCtxLp1
940 STY drive:JSR ReadFSM:BNE SetCtxNxt:\ Not HADFS disk, ignore
950 LDA &F1F:ROL A :\ Get disk flags
960 ROL A:BPL P%+5:STY URD+d :\ Set URD if b13 set
970 ROL A:BPL P%+5:STY LIB+d :\ Set URD if b12 set
980 ROL A:BPL P%+5:STY CSD+d :\ Set CSD if b11 set
990 .SetCtxNxt
1000 DEY:CPY #2:BCS SetCtxLp1 :\ Don't check floppies
1010 LDY #8+d :\ 4 bytes per CSD/LIB/URD
1020 .SetCtxLp2
1030 TYA:PHA:LSR A:LSR A:CLC:ADC #64 :\ Convert offset into Osbyte value
1040 TAY:JSR Osbyte90_6:PLA:TAY :\ See if any ROMs want to override
1050 TXA:BMI P%+5:STA CSD,Y :\ Set drive if ROM responds
1060 DEY:DEY:DEY:DEY:BPL SetCtxLp2 :\ Loop through URD, LIB, CSD
1070 LDA #0:STA VFLG:STA CSD+2 :\ Clear validity flags
1080 STA CSD+1:LDA #71:STA CSD+0 :\ Set CSD to '$'
1090 PLA:TAY:RTS
1100 :
1110 \ ------------------------------
1120 \ Look for a $.Library directory
1130 \ ------------------------------
1140 .FindLib
1150 TXA:PHA:TYA:PHA
1160 LDA &F2:PHA:LDA &F3:PHA
1170 LDA LIB+d:STA drive
1180 JSR ReadFSM:BNE NoLibDrv
1190 LDA #LibName AND 255:STA &F2
1200 LDA #LibName DIV 256:STA &F3
1210 LDY #0:JSR LookFromRoot2:BNE NoLibDrv
1220 LDX #LIB-CSD:JSR SectToDIR
1230 .NoLibDrv
1240 PLA:STA &F3:PLA:STA &F2
1250 PLA:TAY:PLA:TAX
1260 LDA LIB+0:ORA LIB+1:ORA LIB+2:RTS
1270 :
1280 .LibName
1290 EQUS "Library":EQUB 13
1300 :
1310 .LookFromRoot:\ A=drive
1320 STA drive
1330 .LookFromRoot2
1340 JSR SectRoot:JSR SearchPathEntry
1350 CMP #2:RTS
1360 :
1370 .SearchPathXY
1380 JSR XYtoF2
1390 .SearchPathBadNF
1400 JSR SearchPathname
1410 BMI errBadFilename
1420 BEQ errNotFound
1430 .SearchPathOk
1440 RTS
1450 .SearchPathNF
1460 JSR SearchPathname
1470 BNE SearchPathOk
1480 .errNotFound
1490 JSR file_errors:EQUB 214:EQUS "not found":BRK
1500 .SearchPathBad
1510 JSR SearchPathname
1520 BPL SearchPathOk
1530 .errBadFilename
1540 JSR errors:EQUB 204:EQUS "Bad filename":BRK
1550 .CheckPath
1560 BIT pathflg:BPL errNotFound
1570 RTS
1580 :
1590 .PathChar
1600 CLC:JSR GSREAD:BCS PathEnd
1610 \.check_valid_char
1620 AND #127:CMP #ASC"!":BCC errBadFilename
1630 CMP #127:BCS errBadFilename:RTS
1640 :
1650 .SetAbs
1660 LDA #&40:BNE SearchFlag
1670 .PathEnd
1680 LDA #128
1690 .SearchFlag
1700 ORA pathflg:STA pathflg:RTS
1710 :
1720 .CheckSpecial
1730 JSR SetAbs
1740 .CheckSpecial2
1750 LDA OBJECT+1:CMP #32
1760 BNE errBadFilename:RTS
1770 :
1780 .SearchPathname
1790 JSR CheckContext
1800 .SearchPath2
1810 JSR CSDtoSect:STA DRVTMP
1820 .SearchPathEntry
1830 \ (&F2),Y=>pathname
1840 LDA #0:STA pathflg:\ not end, not abs
1850 CLC:JSR GSINIT:BEQ PathEnd
1860 :
1870 .SearchPathLp
1880 LDX #0:.SearchPathLp2
1890 JSR PathChar:BCS SearchDot
1900 CMP #ASC".":BEQ SearchDot
1910 STA OBJECT,X:INX:CPX #11
1920 BCC SearchPathLp2
1930 .Bad_Fname2
1940 JMP errBadFilename:\ object name too long
1950 .SearchDot
1960 LDA #32
1970 .SearchDotLp
1980 STA OBJECT,X:INX:CPX #11
1990 BCC SearchDotLp
2000 .SearchDot1
2010 LDA OBJECT+0
2020 CMP #32:BEQ Bad_Fname2
2030 CMP #ASC"^":BEQ SearchUp
2040 CMP #ASC"@":BEQ SearchCSD
2050 CMP #ASC":":BEQ SearchSpecial
2060 CMP #ASC"'":BCS SearchNotRoot
2070 CMP #ASC"$":BCS SearchSpecial
2080 .SearchNotRoot
2090 LDA DRVTMP:CMP drive
2100 BEQ SearchDot2
2110 JSR CheckHADFSDisk :\ This now saves sect
2120 .SearchDot2
2130 JSR look_in_this_dir
2140 BEQ SearchExit:\ A=0, NF
2150 BIT pathflg:BPL SearchNotEnd
2160 TAX:\ Set Z flag
2170 .SearchExit
2180 RTS:\ A=0,1,2
2190 \ (sect)=sector
2200 :
2210 .SearchNotEnd
2220 CMP #2:BNE P%+5:JMP SearchPathLp
2230 JMP errNotDir
2240 :
2250 .SearchUp:\ ^
2260 JSR CheckSpecial2
2270 JSR get_chk_dir:JSR GetUp
2280 JMP SpecialCheckEnd
2290 :
2300 .SearchCSD
2310 LDX #CSD-CSD:BEQ SearchDIR
2320 :
2330 .SearchSpecial :\ A='$','%','&'
2340 BEQ SearchRoot :\ A='$'
2350 LDX #URD-CSD :\ X=URD, prepare for '&'
2360 CMP #ASC"&":BEQ SearchDIR
2370 LDA OBJECT+1:CMP #ASC" "
2380 BNE SearchNotRoot :\ Allow %name
2390 LDX #LIB-CSD :\ X=>LIB, for '%'
2400 .SearchDIR
2410 JSR CheckSpecial
2420 JSR DIRtoSect
2430 .SpecialCheckEnd
2440 BIT pathflg:BMI SearchSpecialEnd
2450 JMP SearchPathLp
2460 .SearchSpecialEnd
2470 LDA #&FF:STA fptr+1:\ abs pointer
2480 LDA #2:RTS:\ dir, (sect)=sector
2490 :
2500 .SearchRoot
2510 LDA OBJECT+2:CMP #ASC" ":BNE SrchRt0 :\ $xy
2520 LDA OBJECT+1:CMP #ASC" ":BEQ SrchRt2 :\ $
2530 \BNE SrchRt1 :\ $x
2540 :
2550 .SrchRt1
2560 JSR CheckDrive:STA drive
2570 .SrchRt2
2580 JSR SectRootAbs:BEQ SpecialCheckEnd
2590 :
2600 .SrchRt0
2610 LDX #&F6
2620 .SrchRtLp
2630 LDA OBJECT-&F6+1,X:STA OBJECT-&F6+0,X :\ Change $abcdef
2640 INX:BNE SrchRtLp :\ to $.abcdef
2650 JSR SectRootAbs:JMP SearchDot1 :\2
2660 :
2670 .GetDriveEQ
2680 JSR GetChar:BEQ GetDrvOk
2690 .GetDrive
2700 LDA CSD+d:STA drive
2710 JSR GetChar:BEQ GetDrv2
2720 JSR CheckDrive:INY:STA drive
2730 .GetDrv2
2740 LDA drive:CMP #&FF
2750 .GetDrvOk
2760 RTS
2770 :
2780 .CheckDrive
2790 CMP #ASC"0":BCC errBadDrive
2800 CMP #ASC":":BCC GoodDrive
2810 CMP #ASC"A":BCC errBadDrive
2820 AND #&5F:SBC #8
2830 .GoodDrive
2840 SBC #47:AND #31:RTS
2850 :
2860 .errBadDrive
2870 JSR errors:EQUB 205:EQUS "Bad drive":BRK
2880 :
2890 .SetDriveCSD :\ Set drives from CSD drive
2900 LDA CSD+d
2910 .SetDrives :\ Set drives from A
2920 AND #31:STA drive:STA DRVTMP
2930 RTS
2940 :
2950 .look_in_this_dir
2960 TYA:PHA:\ JSR GetOptNum:\ Ensure account number fetched
2970 .LookDirStart
2980 JSR get_chk_dir
2990 JSR dirInit:BEQ look_none_here
3000 .LookDirLp
3010 JSR dirNext:BEQ look_step_entry
3020 JSR DoIOwn:BPL LookDirLp1
3030 LDY #7:LDA (fptr),Y:BMI look_next_entry
3040 .LookDirLp1
3050 LDY #0
3060 .LookDirLp2
3070 LDA OBJECT,Y:CMP #ASC"#":BEQ look_char_match
3080 CMP #ASC"*":BEQ look_file_match
3090 LDA (fptr),Y:AND #127
3100 CMP OBJECT,Y:BEQ look_char_match
3110 EOR #32:CMP OBJECT,Y
3120 BNE look_next_entry
3130 .look_char_match
3140 INY
3150 CPY #10:BNE LookDirLp2
3160 .look_file_match
3170 JSR GetSectAddr
3180 LDY #8:LDA (fptr),Y:ROL A
3190 PLA:TAY
3200 LDA #0:ADC #1:RTS
3210 :\ 1=file
3220 :\ 2=dir
3230 :\ sect holds sector start
3240 :\ fptr points to entry
3250 :\
3260 .look_next_entry
3270 DEC files
3280 .look_step_entry
3290 LDA files:BNE LookDirLp
3300 .look_none_here
3310 JSR GetLINK:BEQ look_no_match
3320 BIT &FF:BMI errEscape
3330 JMP LookDirStart
3340 .look_no_match
3350 PLA:TAY:LDA #0:RTS
3360 .errEscape
3370 JSR errors:EQUB 17:EQUS "Escape":BRK
3380 :
3390 :
3400 .CheckForDir
3410 CMP #2:BNE ChkForDirOk
3420 LDA fptr+1:CMP #&FF:BEQ CheckForDir1
3430 LDA #2:.ChkForDirOk
3440 ORA #0:RTS
3450 .CheckForDir1
3460 LDA sect+2:BNE CheckForDir4 :\ Valid directory
3470 LDA sect+1:BNE CheckForDir4 :\ Valid directory
3480 LDA sect+0:CMP #2:BCC CheckForDir3 :\ Invalid, use '$'
3490 CMP #70:BCC CheckForDir4 :\ Valid directory
3500 CMP #74:BCS CheckForDir4 :\ Valid directory
3510 .CheckForDir3
3520 LDA #71:STA sect+0:LDA #&80:RTS :\ Set sect to '$'
3530 .CheckForDir4
3540 JSR SectToStart
3550 JSR GetDir:JSR GetUp
3560 JSR get_chk_dir
3570 \ fall through to find this directory in parent directory
3580 :
3590 \ ---------------------------------------------------------------------
3600 \ Look for a non-zero length directory entry based on it's sector start
3610 \ ---------------------------------------------------------------------
3620 .LookForEntry
3630 TYA:PHA:TXA:PHA :\ Don't need to stack X
3640 .LookForLp1
3650 JSR dirInit:BEQ LookForNxt
3660 .LookForLp2
3670 JSR dirNext:BEQ LookForSkip
3680 JSR GetSectorHigh:CMP start+2:BNE LookForStep
3690 DEY:LDA (fptr),Y:CMP start+1:BNE LookForStep
3700 DEY:LDA (fptr),Y:CMP start+0:BNE LookForStep
3710 DEY:LDA HDR+&0C:BMI LookForBig
3720 DEY:LDA (fptr),Y:AND #7:BPL LookForChk
3730 .LookForBig
3740 LDA (fptr),Y:DEY:ORA (fptr),Y
3750 .LookForChk
3760 DEY:ORA (fptr),Y
3770 DEY:ORA (fptr),Y:BNE LookForOk :\ Must be non-zero length
3780 .LookForStep
3790 DEC files
3800 .LookForSkip
3810 LDA files:BNE LookForLp2
3820 .LookForNxt
3830 JSR NextChunk:BNE LookForLp1
3840 \.errBrokenDir :\ Couldn't find object
3850 JSR errors:EQUB 168:EQUS "Broken directory":BRK
3860 .LookForOk
3870 JSR GetSectAddr
3880 PLA:TAX:PLA:TAY:LDA #2:RTS
3890 :
3900 ]
3910 PRINT CHR$11;STRING$(20,CHR$9);(O%-mcode%);" bytes"
3920 >"S.HADFS4"