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