10
20
30
40
50
60
70
80
90
100
110
120
130
140
150
160
170
180
190 :
200 PRINT "Assembling S.HADFS1"
210 O%=P%-Block%+mcode%
220 [OPT0
230 \ =======================
240 \ Filing system selection
250 \ =======================
260 .HadfsOn
270 LDY #2
280 .HadfsOn1
290 LDA &DF00,Y:PHA:DEY:BPL HadfsOn1 :\ Save current FS context
300 LDY #4:JSR fx143fs :\ Initialise DFS
310 LDY #&FD :\ X=&FF if no response from DFS
320 .HadfsOn2
330 PLA:STA &DF00-&FD,Y:INY:BMI HadfsOn2 :\ Restore FS context
340 :
350 LDA &28F:ASL A:AND #&80:ORA &F4 :\ Check keyboard link 2, always 0 on Master
360 INX:BEQ HadfsOn5 :\ No response from DFS, OPTFLG=&80+HADFS ROM
370 :
380 .z%
390 JSR WhatMOS:LDA #0:BCS HadfsOn5 :\ Not Master, OPTFLG=0
400 :]:IF VALbase$>=5.79:z%=P%-z%:P%=P%-z%:O%=O%-z%
410 .z%
420 LDA #0:BIT WHATOS:BPL HadfsOn5 :\ Not Master, OPTFLG=0
430 :]:IF VALbase$<5.79:z%=P%-z%:P%=P%-z%:O%=O%-z%
440 LDA #&08:STA &F6:LDA #&80:STA &F7 :\ (&F6)=&8008, binary version number
450 LDY XFILEV+2:JSR OSRDRM :\ Read DFS's version number
460 CMP #&95:LDA #0:BCC HadfsOn5 :\ Earlier than v2.45, no workaround needed
470 TYA:ORA #&80 :\ DFS 2.45, OPTFLG=&80+DFS ROM
480 :
490 \\LDA #0:\JSR ChkMOS350:\BNE HadfsOn5:\ Not MOS 3.50, OPTFLG=0
500 \\LDA XFILEV+2:\ORA #&80 :\ DFS 2.45, OPTFLG=&80+DFS ROM
510 :
520 .HadfsOn5
530 PHA
540 :
550 LDA #6:JSR FSC :\ Warn vectors about to change
560 LDY #0:LDX #27
570 .TrapFSlp
580 LDA vectors+0,Y:STA &D9F,X :\ Set extended address
590 LDA vectors+1,Y:STA &DA0,X
600 LDA &F4:STA &DA1,X :\ Set extended ROM number
610 TXA:STA FILEV,Y :\ Set extended vector
620 LDA #255:STA FILEV+1,Y
630 INY:INY:INX:INX:INX :\ Step to next vector
640 CPX #48:BNE TrapFSlp
650 LDX #15:JSR fx143 :\ Vectors changed
660 JSR GrabAbs :\ Claim and restore workspace
670 :
680 PLA:STA OPTFLG:LDA #0:RTS :\ Set MOS350+DFSROM, clear OwnDir,OwnLib,NoDFS
690 :
700 .vectors
710 EQUW file:EQUW args:EQUW bget
720 EQUW bput:EQUW gbpb:EQUW find
730 EQUW fsc
740 :
750 \ ==============================
760 \ Arithmetic and number routines
770 \ ==============================
780 .BINtoBCD:\ Corrupts tmp
790 PHA:LDA #10:STA tmp:PLA
800 .BINtoBCDlp
810 CMP tmp:BCC BCDdone
820 ADC #5:PHA
830 LDA tmp:ADC #16:STA tmp
840 PLA:BCC BINtoBCDlp
850 .BCDdone
860 RTS
870 :
880 .BCDtoBIN:\ Corrupts X
890 TAX:LDA tmp:PHA:TXA
900 AND #&F0:LSR A:STA tmp:\ 8s
910 LSR A:LSR A:CLC:ADC tmp:STA tmp
920 TXA:AND #15:CLC:ADC tmp:TAX
930 PLA:STA tmp:TXA:RTS
940 :
950 .HexTopDigit
960 LSR A:LSR A:LSR A:LSR A
970 .HexDigit
980 AND #15:BPL DrvChr
990 .GetDrvChr
1000 LDA drive
1010 .DrvChr
1020 CMP #10:BCC P%+4:ADC #6
1030 ADC #48:RTS
1040 :
1050 .PrDec:\ Print decimal number
1060 JSR BINtoBCD
1070 :
1080 .PrHex:\ Print hex number
1090 PHA:JSR HexTopDigit:JSR OSWRCH:PLA
1100 .PrNyb:\ Print hex digit
1110 JSR HexDigit:JMP OSWRCH
1120 :
1130 \.PrZero
1140 \LDA #0:\BEQ PrHex
1150 :
1160 :
1170 \ -------------------------------------
1180 \ PrDec32 - Print 32-bit decimal number
1190 \ -------------------------------------
1200 \ On entry, numstore=number
1210 \ numflg=0 or pad character (eg '0' or ' ')
1220 \ On exit, A,X,Y,numstore,numflg corrupted
1230 \ ---------------------------------------------------
1240 .PrDec32
1250 LDY #9 :\ 9+1 digits
1260 .PrDec32lp
1270 TYA:PHA:JSR PrComma :\ Save Y=power of ten
1280 LDX #3:LDA #0
1290 .Power10lp1
1300 STA numsub,X:DEX:BPL Power10lp1:\ numsub=0
1310 INC numsub:LDX #numsub :\ numsub=1
1320 .Power10lp2
1330 JSR Times10X:DEY:BNE Power10lp2:\ numsub=10^Y
1340 JSR DivideNum:JSR PrDigit :\ Divide, print digit or pad character
1350 PLA:TAY:DEY:BNE PrDec32lp :\ Loop through digits
1360 LDA numstore:BPL PrDig1 :\ Print last digit
1370 :
1380 .PrDigit
1390 BNE PrDig1 :\ Non-zero, print digit
1400 LDA numflg:BEQ PrDig2 :\ No pad character, return
1410 JMP OSWRCH :\ Pad character, print it
1420 .PrDig1
1430 ORA #ASC"0":JSR OSWRCH :\ Print digit
1440 LDA #ASC"0":STA numflg :\ Print zeros from now on
1450 .PrDig2
1460 RTS
1470 :
1480 .PrComma
1490 CPY #2:BEQ PrComma1
1500 CPY #5:BEQ PrComma1
1510 CPY #8:BEQ PrComma1
1520 .PrComma0
1530 RTS
1540 .PrComma1
1550 LDX numflg:LDA #ASC"," :\ Prepare a comma if zeros being printed
1560 CPX #ASC"0":BEQ P%+3:TXA :\ Otherwise, print the pad character
1570 TAX:BEQ PrComma0:JMP OSWRCH :\ Print if not null pad character
1580 :
1590 \ -------------------------------------
1600 \ DivideNum - Divide numstore by numsub
1610 \ -------------------------------------
1620 \ On entry, numstore=32-bit number
1630 \ numsub=32-bit divisor
1640 \ On exit, A=numstore DIV numsub, Z=(A=0)
1650 \ numstore=numstore MOD numsub
1660 \ Y preserved, X corrupted
1670 \ ----------------------------------------
1680 .DivideNum
1690 LDX #255:SEC
1700 .DivLp
1710 INX
1720 LDA numstore+0:SBC numsub+0:STA numstore+0
1730 LDA numstore+1:SBC numsub+1:STA numstore+1
1740 LDA numstore+2:SBC numsub+2:STA numstore+2
1750 LDA numstore+3:SBC numsub+3:STA numstore+3
1760 BCS DivLp
1770 LDA numstore+0:ADC numsub+0:STA numstore+0
1780 LDA numstore+1:ADC numsub+1:STA numstore+1
1790 LDA numstore+2:ADC numsub+2:STA numstore+2
1800 LDA numstore+3:ADC numsub+3:STA numstore+3
1810 TXA:RTS
1820 :
1830 \ --------------------------------
1840 \ GetNumber, GetHex - Fetch number
1850 \ --------------------------------
1860 \ On entry, (&F2),Y=>number
1870 \ X=>zero page numstore
1880 \ CS=hex, CC=decimal
1890 \ On exit, (&F2),Y=>next item, skipping spaces
1900 \ A=next character
1910 \ X=>numstore with result
1920 \ ---------------------------------
1930 .Get1Hex
1940 JSR GetHexNum:LDA numstore:RTS :\ Fetch hex and return bottom byte
1950 .GetHexNum
1960 SEC
1970 .GetNumber
1980 LDX #numstore :\ Collect number in numstore
1990 PHP:JSR GetDigit:BCS errBadNumber :\ Fetch first digit
2000 STA 0,X :\ Store first digit
2010 LDA #0:STA 1,X:STA 2,X:STA 3,X
2020 .GetNumLp
2030 PLP:PHP:JSR GetDigit:BCS GotNumOk :\ End of string of digits
2040 PLP:PHP:PHA:JSR Times10or16 :\ Move current to next unit
2050 PLA:CLC:ADC 0,X:STA 0,X :\ num=num+digit
2060 LDA 1,X:ADC #0:STA 1,X
2070 LDA 2,X:ADC #0:STA 2,X
2080 LDA 3,X:ADC #0:STA 3,X
2090 BCC GetNumLp
2100 .errBadNumber
2110 JSR errors:EQUB 252:EQUS "Bad number":BRK
2120 .GotNumOk
2130 PLP:JMP SkipSpc
2140 :
2150 \ -----------------------------------------
2160 \ Times10or16 - Multiply number by 10 or 16
2170 \ -----------------------------------------
2180 \ On entry, X=>zero page numstore
2190 \ CC=times 10, CS=times 16
2200 \ On exit, X,Y preserved, A,F corrupted
2210 \ -------------------------------------
2220 .Times10
2230 LDX #numstore :\ Use numstore
2240 .Times10X
2250 CLC :\ CC for *10
2260 .Times10or16
2270 JSR TimesTwo :\ n*2
2280 LDA 3,X:PHA:LDA 2,X:PHA :\ save n*2
2290 LDA 1,X:PHA:LDA 0,X:PHA
2300 JSR TimesTwo:JSR TimesTwo :\ n*8
2310 BCC TimesTen
2320 PLA:PLA:PLA:PLA :\ Drop n*2
2330 .TimesTwo
2340 PHP:ASL 0,X:ROL 1,X :\ n=n*2
2350 ROL 2,X:ROL 3,X
2360 BCS errBadNumber:PLP:RTS
2370 .TimesTen
2380 PLA:ADC 0,X:STA 0,X :\ n*8+n*2 = n*10
2390 PLA:ADC 1,X:STA 1,X
2400 PLA:ADC 2,X:STA 2,X
2410 PLA:ADC 3,X:STA 3,X
2420 BCS errBadNumber:RTS
2430 :
2440 \ --------------------------
2450 \ GetDigit - Fetch one digit
2460 \ --------------------------
2470 \ On entry, (&F2),Y=>current character
2480 \ CC = decimal
2490 \ CS = hex
2500 \ On exit, A = digit 0-F
2510 \ CC = valid digit
2520 \ CS = invalid digit
2530 \ (&F2),Y=>next character
2540 \ ----------------------------------
2550 .GetDigit
2560 PHP:JSR GetChar:BEQ Not1Num
2570 CMP #ASC"0":BCC Not1Num
2580 CMP #ASC"9"+1:BCC Got1Num
2590 PLP:BCC NotNumber
2600 AND #&DF
2610 CMP #ASC"A":BCC NotNumber
2620 CMP #ASC"F"+1:BCS NotNumber
2630 SBC #6:PHP
2640 .Got1Num
2650 AND #15:PLP:INY:CLC:RTS:\ Valid digit
2660 .Not1Num
2670 PLP
2680 .NotNumber
2690 SEC:RTS :\ Invalid digit
2700 :
2710 :
2720 :
2730 \ ======================
2740 \ Text printout routines
2750 \ ======================
2760 \ Corrupts tmp at &B2 and tptr at &B0/1
2770 \ -----------------------------------------------
2780 .PrText
2790 STA tmp:PLA:STA tptr:PLA:STA tptr+1
2800 TYA:PHA:LDY #1:BNE PrTextInc
2810 .PrTextLp
2820 LDY #0:LDA (tptr),Y:BEQ P%+5:JSR OSASCI
2830 .PrTextInc
2840 PHP:INC tptr:BNE P%+4:INC tptr+1
2850 PLP:BNE PrTextLp
2860 PLA:TAY:LDA tmp:JMP (tptr)
2870 :
2880 \ ================
2890 \ Error generation
2900 \ ================
2910 .file_errors :\ generates 'OBJECT errormessage'
2920 LDA #32:STA OBJECT+10:LDX #0 :\ Ensure OBJECT terminated
2930 .fileErLp
2940 LDA OBJECT,X:STA &102,X:INX :\ Copy OBJECT to error buffer
2950 CMP #32:BNE fileErLp
2960 STA &102,X:INX:BNE errors2
2970 :
2980 .errorDIR
2990 JSR ClearDIR :\ Clear directory buffer
3000 .errors :\ Generates 'errormessage'
3010 LDX #1:.errors2
3020 PLA:STA &FD:PLA:STA &FE:LDY #1
3030 LDA (&FD),Y:STA &101
3040 .errorlp:INX:INY:LDA (&FD),Y
3050 STA &100,X:BNE errorlp
3060 STA &100:JMP &100
3070 :
3080 \ ==================
3090 \ Workspace routines
3100 \ ===============================
3110 \ FindWS - Find private workspace
3120 \ -------------------------------
3130 \ Returns ws=>private workspace
3140 \ All registers and flags preserved
3150 \ -----------------------------------------
3160 .FindWS
3170 PHP:PHA:TXA:PHA:LDX &F4:LDA &DF0,X
3180 AND #&DF:CLC:BMI P%+4:ADC #&0E
3190 STA ws+1:LDA #0:STA ws:PLA:TAX:PLA:PLP:RTS
3200 :
3210 \ =============================================
3220 \ GrabAbs - Claim and update absolute workspace
3230 \ =============================================
3240 \ Returns all registers preserved
3250 \ -------------------------------
3260 .GrabAbs
3270 PHA:TXA:PHA:TYA:PHA:LDA ws:PHA:LDA ws+1:PHA :\ Save everything
3280 JSR TimeSave:JSR GetOwnWS:BNE GrabAbsOk :\ Exit if I already own ws
3290 LDX #10:JSR fx143:JSR SetOwnWS :\ Claim ws and set flag
3300 JSR FindWS:LDY #CSD AND 255
3310 .GrabAbsLp2
3320 LDA (ws),Y:STA WS,Y:INY:BNE GrabAbsLp2 :\ Copy info to workspace
3330 LDY #4
3340 .GrabAbsLp3
3350 LDX ChnInfo,Y:LDA WS,X:AND #&FC:STA WS,X :\ Clear channel flags
3360 DEY:BPL GrabAbsLp3
3370 JSR ClearDIR:STA VFLG :\ No directory in memory
3380 .GrabAbsOk
3390 PLA:STA ws+1:PLA:STA ws:PLA:TAY:PLA:TAX:PLA :\ Restore everything
3400 RTS
3410 :
3420 \ ============
3430 \ Line parsing
3440 \ ============
3450 .SkipSpc1
3460 INY
3470 .SkipSpc
3480 LDA(&F2),Y:CMP#ASC" ":BEQ SkipSpc1
3490 .GetChar
3500 LDA (&F2),Y:CMP #13
3510 RTS
3520 :
3530 .XYtoF2
3540 STX &F2:STY &F3:LDY #0:RTS
3550 :
3560 .F2toXY
3570 PHA:TYA:CLC:ADC &F2:TAX
3580 LDA &F3:ADC #0:TAY:PLA:RTS
3590 :
3600 \ ==================
3610 \ Null Keyboard code
3620 \ ==================
3630 .KeyboardChk :\ Insert NullKBD if no keyboard found
3640 PHP:SEI:LDA &28F:BNE Serv1bKbd
3650 LDA &229:BPL Serv1bKbd :\ Already claimed
3660 LDX #7:.Serv1KbdLp
3670 LDA NewK,X:STA &3D0,X:DEX:BPL Serv1KbdLp :\ Copy new KEYV code
3680 LDA &228:STA &3D8:LDA &229:STA &3D9 :\ Copy old KEYV
3690 LDA #&D0:STA &228:LDA #3:STA &229 :\ Point KEYV to new code
3700 .Serv1bKbd
3710 PLP:JMP Serv1Exit
3720 :
3730 .NewK
3740 BVS OldKeyJmp:BCS OldKeyJmp:LDA #0:RTS:.OldKeyJmp:EQUB &4C
3750 :]:IF _NoNullKB%:z%=P%-KeyboardChk:P%=P%-z%:O%=O%-z%
3760 :
3770 \ ======================
3780 \ Time and date routines
3790 \ ==============================================
3800 \ TimeSave - Save current TIME, called regularly
3810 \ ----------------------------------------------
3820 .TimeSave
3830 PHA:TXA:PHA:LDX #2:.SvTimeLp
3840 LDA &294,X:STA &3DA,X:DEX
3850 BPL SvTimeLp:PLA:TAX:PLA:RTS
3860 :
3870 \ ===========================================
3880 \ *SETDATE - Set current date and day of week
3890 \ ===========================================
3900 .SetDate
3910 JSR GetChar:BEQ setdate1 :\ No parameters, disable
3920 JSR Get1Hex:INY :\ Get date
3930 ORA #&C0:STA &3DD :\ Set date+flags in b6-b7
3940 JSR Get1Hex:STA &3DE:INY :\ Get and set month
3950 JSR Get1Hex:STA &3DF :\ Get and set year
3960 LDX #0:JSR GetChar:BEQ setdate3:\ Exit if no day set
3970 JSR Get1Hex:ASL A:ASL A:ASL A :\ Get day, move into b5-b7
3980 ASL A:ASL A:ORA &3DE:::BNE setdate2 :\ Store and exit
3990 ::\\STA &3DE::\\.setdate3::\\RTS
4000 .setdate1
4010 STA &3DD:STA &3DF :\ All same=No date
4020 .setdate2
4030 STA &3DE:::.setdate3:RTS
4040 :
4050 \ ==================================
4060 \ *TIME - Display current RTC string
4070 \ ==================================
4080 \ Returns A=length of RTC string
4090 \ EQ=no RTC available
4100 \ ----------------------------------
4110 .Time
4120 LDY #0:STY &108:LDA #14:LDX #8 :\ Use 25 bytes at &108
4130 INY:JSR OSWORD:LDA &108:BEQ NoTime
4140 LDX #0
4150 .z%
4160 \LDA &114:\CMP #ASC"9":\BNE TimeLp:\ Not 19xx, use unmodified
4170 LDA &115:CMP #ASC"8":BCS TimeLp :\ 1980+, use unmodified
4180 LDA #ASC"2":STA &113
4190 LDA #ASC"0":STA &114 :\ Change to 20xx
4200 :]:IF0:z%=P%-z%:P%=P%-z%:O%=O%-z%
4210 .TimeLp :\ Could do BCD->RTC
4220 LDA &108,X:JSR OSASCI:INX :\ Print RTC string
4230 CPX #25:BNE TimeLp:TXA :\ Set flags
4240 .NoTime
4250 RTS :\ A=length of RTC string
4260 :
4270 \ ======================
4280 \ Check if RTC available
4290 \ ======================
4300 \ Returns EQ=RTC available
4310 \ NE=No RTC available
4320 \ ---------------------------
4330 .CheckClock1
4340 \ A,X,Y can be corrupted
4350 \ ------------------------------
4360 LDA #0:LDX #255:JSR OSBYTE
4370 CPX #3:BCC CheckClock :\ BBC - check SoftRTC
4380 CPX #5:BNE CheckClockOk :\ Not Compact - hardware RTC present
4390 \\JSR WhatOS:\BCC CheckClock :\ BBC - check SoftRTC
4400 \\CPX #5:\BNE CheckClockOk :\ Not Compact - hardware RTC present
4410 :
4420 .CheckClock
4430 \ X must be preserved
4440 \ ---------------------------
4450 LDA &3DD:JSR CheckClock2 :\ Date
4460 LDA &3DE:JSR CheckClock2 :\ Month
4470 LDA &3DF:JSR CheckClock2b :\ Year
4480 .CheckClockOk
4490 LDA #0:RTS
4500 .CheckClock2
4510 BEQ CheckClockNo
4520 .CheckClock2b
4530 AND #15:CMP #10:BCC CheckClockOk
4540 .CheckClockNo
4550 PLA :\ Drop return address
4560 .Osw14Quit1
4570 PLA
4580 .Osw14Quit
4590 LDA #8:RTS :\ A=8 used later
4600 :
4610 \ ================================
4620 \ OSWORD 14 - Read Real Time Clock
4630 \ ================================
4640 .Osword14
4650 LDY #0:LDA (&F0),Y:LDY #7 :\ Get action byte
4660 CMP #2:BCC Osw14RTC:BNE Osw14Quit:\ Check action byte
4670 .Osw14_2 :\ Convert BCD to text
4680 LDA (&F0),Y:DEY:STA &100,Y :\ Copy to workspace
4690 BNE Osw14_2
4700 .ConvertDate :\ Convert &100-&106 to text
4710 LDY #6:.ConvDate1
4720 LDA &100,Y:JSR BCDtoBIN:STA &100,Y :\ Convert to binary
4730 DEY:BPL ConvDate1:INY:LDA &103
4740 \AND #7:\ADC #12:JSR PutDay :\ BCDtoBIN returns Cy=0
4750 LDA #ASC",":JSR PutChar
4760 LDA &102:AND #31:JSR PutBCD:JSR PutSpace
4770 LDA &101:AND #15:JSR PutDayMonth:JSR PutSpace
4780 \LDA &100:\EOR #&FF:\CMP #&B0 :\ Ignore 19xx now
4790 \LDA #19:\ADC #0:\JSR PutBCD
4800 LDA #&20:JSR PutHex :\ Year 20xx
4810 LDA &102:AND #&E0:LSR A:CLC:ADC &100 :\ Get year
4820 CMP #100:BCC P%+4:SBC #100:JSR PutBCD :\ Reduce to 0-99
4830 LDA #ASC".":JSR PutChar:LDX #&FD :\ Now put hh;mm;ss
4840 .ConvDate2
4850 EQUB &BD:EQUW &104-&FD,X:\ LDA &104-&FD,X forcing abs addressing
4860 JSR PutHour:INX:BNE ConvDate2:DEY:LDA #13:JSR PutChar
4870 .Osw14Claim
4880 LDA #0:RTS
4890 :
4900 .Osw14RTC
4910 PHA:JSR CheckClock:BNE Osw14Quit1:\ No time available
4920 LDA &3DE:AND #&1F:STA &101 :\ Get month
4930 LDA &3DF:STA &100 :\ Get year
4940 LDA &3DD:AND #&3F:STA &102 :\ Get date
4950 LDA &3DE:LSR A:LSR A:LSR A:LSR A
4960 LSR A:STA &103 :\ Get day of week
4970 LDA &F0:PHA:LDA &F1:PHA :\ Save action and pointer
4980 LDX #8:.Osw14Save:LDA numsub,X:PHA:DEX:BPL Osw14Save
4990 LDA #1:JSR OsTIME :\ Read TIME
5000 LDA #&83:LDY #&D6:LDX #&00:JSR Osw14Div :\ Calculate days
5010 BEQ osw14noflow :\ Not past midnight
5020 LDA #2:JSR OsTIME :\ Set TIME
5030 :
5040 .osw14noflow
5050 LDA #&05:LDY #&7E:LDX #&40:JSR Osw14Div:STA &104 :\ Calculate hours
5060 LDA #&00:LDY #&17:LDX #&70:JSR Osw14Div:STA &105 :\ Calculate minutes
5070 LDA #&00:TAY:LDX #&64:JSR Osw14Div:STA &106 :\ Calculate seconds
5080 :\ Centisecs ignored
5090 LDX #0:.Osw14Rest:PLA:STA numsub,X:INX:CPX #9:BNE Osw14Rest
5100 PLA:STA &F1:PLA:STA &F0 :\ Restore pointer
5110 PLA:BNE P%+5:JMP ConvertDate :\ A=0, return as string
5120 LDY #6:.NoDateLp
5130 LDA &100,Y:STA (&F0),Y:DEY :\ Copy back to control block
5140 BPL NoDateLp:JMP Osw14Claim
5150 :
5160 .Osw14Div:\ AYX=divisor
5170 STX numsub+0:STY numsub+1:STA numsub+2:LDA #0:STA numsub+3
5180 JSR DivideNum:JMP BINtoBCD
5190 :
5200 .OsTIME
5210 LDX #numstore AND 255:LDY #numstore DIV 256:JMP OSWORD
5220 :
5230 .PutSpace :\ Store a space
5240 LDA #ASC" ":BNE PutChar
5250 .PutHour :\ Store hour/minute/colon
5260 JSR PutBCD:LDA #ASC":":BNE PutChar
5270 .PutBCD
5280 JSR BINtoBCD
5290 .PutHex :\ Store hex
5300 PHA:JSR HexTopDigit:JSR PutChar
5310 PLA:JSR HexDigit
5320 .PutChar :\ Store a character
5330 STA (&F0),Y:INY:RTS
5340 .PutDay
5350 AND #7:ADC #12
5360 .PutDayMonth :\ Look up and store day/month
5370 STA tmp:ASL A:ADC tmp:TAX
5380 LDA MonthText-3,X:.PutDayLp
5390 STA (&F0),Y:INX:INY
5400 LDA MonthText-3,X:CMP #ASC"`"
5410 BCS PutDayLp:RTS
5420 :
5430 .MonthText
5440 EQUS "JanFebMarAprMayJunJulAugSepOctNovDec"
5450 EQUS "SunMonTueWedThuFriSat"
5460 EQUB &00 :\ Byte<'`' table terminator
5470 :
5480 \\.WhatOS
5490 \\\ On exit, X=MOS type
5500 \\\ CS=Master
5510 \\\ CC=BBC
5520 \\PHA:\TYA:\PHA:\LDA #0:\LDX #255:\JSR OSBYTE
5530 \\PLA:\TAY:\PLA:\CPX #3:\RTS
5540 :
5550 .z%
5560 .WhatMOS
5570 \ On exit, CS=BBC (no FileSwitch)
5580 \ CC=Master (FileSwitch exists)
5590 \ Z=corrupted
5600 LDA OSFILE:CMP #&6C:RTS
5610 :]:IF VALbase$>=5.79:z%=P%-z%:P%=P%-z%:O%=O%-z%
5620 :
5630 :
5640 \ ==============================
5650 \ Save and restore filing system
5660 \ ==============================
5670 .EnsureHADFS
5680 LDA #HADFSnum:LDY XFILEV+2 :\ Check if I'm the filing system
5690 CPY &F4:BEQ EnsHADFSok :\ If I am, just return with A=me
5700 LDA #0:TAY:JSR OSARGS:PHA :\ Find current filing system
5710 JSR Hadfs:PLA :\ Select HADFS
5720 .EnsHADFSok
5730 RTS :\ Return with A=previous filing system
5740 .RestoreFS
5750 TAY:CPY #HADFSnum:BNE fx143fs :\ If not HADFS, select it
5760 RTS
5770 :
5780 \ ====================================
5790 \ Translate *commands to further calls
5800 \ ====================================
5810 .Close :LDA #0:TAY:JMP OSFIND :\ Close all files
5820 .Status:LDX #&29:BNE fx143 :\ Send *STATUS service call
5830 .Config:LDX #&28:BNE fx143 :\ Send *CONFIGURE service call
5840 :]:IF _NoStatus%:z%=P%-Status:P%=P%-z%:O%=O%-z%
5850 .Shut :LDX #&26:BNE fx143 :\ Send *SHUT service call
5860 :
5870 .Hadfs :\ Select HADFS with *fx143
5880 .fx143go:LDY #HADFSnum :\ Select HADFS as filing system
5890 .fx143fs:LDX #&12 :\ Select filing system in Y
5900 .fx143 :LDA #143:JMP OSBYTE :\ Issue a service call
5910 :
5920 .Ex :LDA #9 :BNE FSC_F2 :\ Pass *EX to FSCV
5930 .Info :LDA #10:BNE FSC_F2 :\ Pass *INFO to FSCV
5940 .Rename :LDA #12 :\ Pass *RENAME to FSCV
5950 .FSC_F2 :JSR F2toXY :\ Convert (&F2),Y pointer to XY
5960 .FSC :JMP (FSCV)
5970 :
5980 .Delete :\ Pass *DELETE to OSFILE
5990 LDA #6:JSR OSFile:CMP #0:BNE EnsHADFSok
6000 JMP errNotFound
6010 .CDir :LDA #8 :\ Pass *CDIR to OSFILE
6020 .OSFile :JSR F2toXY :\ Convert (&F2),Y pointer to XY
6030 .OSFileXY
6040 STX Ctrl+0:STY Ctrl+1 :\ Store X and Y in control block
6050 LDX #Ctrl AND 255:LDY #Ctrl DIV 256 :\ Point to control block
6060 JMP OSFILE :\ Jump to do OSFILE action
6070 :
6080 :
6090 \ =================================
6100 \ Directory/disk selection commands
6110 \ =================================
6120 .I_AmXY
6130 JSR XYtoF2
6140 .I_Am
6150 TYA:PHA:JSR Bye:PLA:TAY :\ Close all and clear workspace
6160 JSR SetContext :\ Look for drives
6170 LDA URD+d:JSR LookFromRoot :\ Search from '$' on URD drive
6180 BNE I_Am2 :\ Not found, use '$'
6190 LDX #CSD-CSD:JSR SectToDIR :\ Set CSD=Sect of found directory
6200 .I_Am2
6210 LDX #URD-CSD:JSR CSDtoDIR :\ Set URD=CSD, ='$' or dir
6220 LDA LIB+d:PHA :\ LIB=<lib>000000, save LIB drive
6230 LDA CSD+d:STA LIB+d :\ Try looking on CSD drive
6240 JSR FindLib:BNE I_Am4 :\ '$.Library' found, use it
6250 PLA:CMP LIB+d:BEQ I_Am3 :\ Get LIB drive back
6260 STA LIB+d :\ Try original drive if not <00>
6270 JSR FindLib:BNE I_Am5 :\ '$.Library' found, use it
6280 .I_Am3
6290 LDA #71:STA LIB:BNE I_Am5 :\ Set LIB to '$' on lib drive
6300 .I_Am4
6310 PLA
6320 .I_Am5
6330 LDX #URD-CSD:JSR GetDirX :\ Get URD directory
6340 LDA HDR+&13:STA USERNUM :\ Get user b0-b7
6350 LDA HDR+&12:ORA #4:STA OPTNUM :\ Get user b8-b11 and boot option
6360 AND #3:BEQ I_AmEnd :\ Option 0 -> do nothing
6370 TAX:LDA BootTable-1,X:TAX :\ Index to Boot command
6380 LDY #Boot1 DIV 256:JMP oscli :\ Execute the command
6390 :
6400 .BootTable
6410 EQUB Boot1:EQUB Boot2:EQUB Boot3 :\ Low bytes of Boot commands
6420 EQUS STRING$(((P%AND255)>247)AND(256-(P%AND255)),"*")
6430 .Boot1:EQUS "L." :\ Option 1 - *Load !Boot
6440 .Boot2:EQUS "!BOOT":EQUB 13 :\ Option 2 - *Run !Boot
6450 .Boot3:EQUS "E.!BOOT":EQUB 13 :\ Option 3 - *Exec !Boot
6460 :]:IF(Boot1 AND &FF00)<>(Boot3 AND &FF00):PRINT"WARNING: BootTable overlaps page end"'
6470 :
6480 .Bye
6490 JSR Close :\ Should also do Osw90,5
6500 :\ Fall through into MountClear
6510 .MountClear
6520 LDA DRVINT:PHA:LDA DRVEXT:PHA :\ Save Internal/External flags
6530 LDA OPTFLG:PHA:LDA #0:TAX
6540 .MntClr
6550 STA WS,X:INX:BNE MntClr :\ Clear entire workspace
6560 PLA:AND #&9F:STA OPTFLG :\ Restore OPTFLG without DirOwn and LibOwn
6570 PLA:STA DRVEXT:PLA:STA DRVINT :\ Restore Internal/External flags
6580 .I_AmEnd
6590 RTS
6600 :
6610 .Mount
6620 JSR GetDriveEQ:PHP:PHA :\ Get any drive parameter
6630 JSR MountClear :\ Clear workspace, returns X=0
6640 \\LDX #0 :\ Forget Spool/Exec if HADFS channels
6650 LDA &256:JSR ChannelRange:BCC P%+5:STX &256
6660 LDA &257:JSR ChannelRange:BCC P%+5:STX &257
6670 PLA:PLP:BEQ MountOk :\ No drive specified
6680 STA CSD+d:STA LIB+d:STA URD+d :\ Mount specified drive
6690 LDA #71:STA CSD+0 :\ Set CSD='$'
6700 \\LDA #0:\STA CSD+1:\STA CSD+2 :\ Superfluous, already set to zero by MountClear
6710 .MountOk
6720 RTS
6730 :
6740 .Enable
6750 JSR GetChar:BEQ Enable2 :\ No parameters, set enable flag
6760 PLA:PLA:LDA #4:RTS :\ Pop return address and return 'not done'
6770 .Enable2
6780 LDA #&FF:STA ENABLE
6790 .TryADirOk
6800 RTS
6810 :
6820 .TryADir
6830 JSR SearchPathname:BMI TryADirOk
6840 CMP #2:BEQ TryADirOk
6850 CMP #0:BNE errNotDir
6860 JMP errNotFound
6870 .errNotDir
6880 JSR file_errors:EQUB 190:EQUS "is not a directory":BRK
6890 :
6900 .Dir
6910 JSR TryADir:BPL Dir2 :\ Directory found
6920 LDX #URD-CSD:JSR DIRtoSect :\ Null path, set Sect=URD
6930 .Dir2
6940 LDX #CSD-CSD:LDA #&3F:BNE SectToDIRa :\ Jump to set CSD
6950 :
6960 .Lib
6970 JSR TryADir:LDX #LIB-CSD:LDA #&DF :\ Continue to set LIB
6980 .SectToDIRa
6990 AND VFLG:STA VFLG :\ Clear name flags
7000 :\ Continue into SectToDIR
7010 :
7020 :
7030 \ -------------------------------------------------
7040 \ SectToDIR - Set context variable at CSD,X to Sect
7050 \ -------------------------------------------------
7060 .SectToDIR
7070 LDA sect+0:STA CSD+0,X
7080 LDA sect+1:STA CSD+1,X
7090 LDA sect+2:STA CSD+2,X
7100 LDA drive :STA CSD+d,X
7110 RTS
7120 :
7130 \ --------------------------------
7140 \ SectToStart - Copy Sect to Start
7150 \ --------------------------------
7160 .SectToStart
7170 LDX #2
7180 .SectToStLp
7190 LDA sect,X:STA start,X
7200 DEX:BPL SectToStLp:RTS
7210 :
7220 \ --------------------------------
7230 \ StartToSect - Copy Start to Sect
7240 \ --------------------------------
7250 .StartToSect
7260 LDX #2
7270 .StartToScLp
7280 LDA start,X:STA sect,X
7290 DEX:BPL StartToScLp:RTS
7300 :
7310 \ ---------------------------
7320 \ CSDtoSect - Set Sect to CSD
7330 \ ---------------------------
7340 .CSDtoSect
7350 LDX #CSD-CSD
7360 :
7370 \ -------------------------------------------------
7380 \ DIRtoSect - Set Sect to context variable at CSD,X
7390 \ -------------------------------------------------
7400 .DIRtoSect
7410 LDA CSD+0,X:STA sect+0
7420 LDA CSD+1,X:STA sect+1
7430 LDA CSD+2,X:STA sect+2
7440 LDA CSD+d,X:STA drive
7450 RTS
7460 :
7470 \ -----------------------------------------------
7480 \ CSDtoDIR - Set context variable at CSD,X to CSD
7490 \ -----------------------------------------------
7500 .CSDtoDIR
7510 LDA CSD+0:STA CSD+0,X
7520 LDA CSD+1:STA CSD+1,X
7530 LDA CSD+2:STA CSD+2,X
7540 LDA CSD+3:STA CSD+3,X
7550 RTS
7560 :
7570 \ ------------------------------------
7580 \ GetFIRST - Get first directory chunk
7590 \ ------------------------------------
7600 .GetFIRST
7610 LDX #&14:TXA:BNE GetDirLink
7620 :
7630 \ ----------------------------------
7640 \ GetLINK - Get next directory chunk
7650 \ ----------------------------------
7660 .GetLINK
7670 LDX #&18:LDA #&0E:BNE GetDirLink
7680 :
7690 \ ------------------------
7700 \ GetUp - parent directory
7710 \ ------------------------
7720 .GetUp
7730 LDX #&1C:LDA #&0A:\BNE GetDirLink
7740 :
7750 .GetDirLink
7760 BIT HDR+&0C:BMI GetDirLink24 :\ Get 24-bit link from X
7770 TAX:LDA #0:BEQ GetDirLink16 :\ Get 16-bit link from A
7780 .GetDirLink24
7790 LDA HDR+&02,X :\ Get link b16-23
7800 .GetDirLink16
7810 STA sect+2
7820 LDA HDR+&01,X:STA sect+1 :\ Get directory link b0-15
7830 LDA HDR+&00,X:STA sect+0
7840 JMP ChkSectZero :\ Return EQ if no link
7850 :
7860 \ -----------------
7870 \ Get FIRST or CURR
7880 \ -----------------
7890 .GetFIRSTorCURR
7900 JSR GetFIRST:BNE CURRtoSectOk :\ Return if FIRST exists
7910 :\ Otherwise, get CURR
7920 :
7930 \ -----------------------------
7940 \ CURRtoSect - Get CURR to sect
7950 \ -----------------------------
7960 .CURRtoSect:.GetCURR
7970 LDX #3
7980 .GetCURRlp
7990 LDA CURR,X:STA sect,X
8000 DEX:BPL GetCURRlp
8010 .ChkSectZero
8020 ORA sect+1:ORA sect+2
8030 .CURRtoSectOk
8040 RTS
8050 :
8060 ]
8070 PRINT CHR$11;STRING$(20,CHR$9);O%-mcode%;" bytes"
8080 >"S.HADFS2"