10 REM >HADFS5 v5.78
   20 REM OSARGS, OSFIND, OSBGET, OSBPUT - File open/close/get/put
   30 REM ========================================================
   40 REM 01/01/1992, 9:45pm
   50 REM BootOpt moved to H2
   60 REM FindSect sets sect and &C2/3
   70 REM Can openin($)
   80 REM v5.30 Accesses context variables in new location
   90 REM v5.51 OSARGS &FD moved to &FD/&FE
  100 REM v5.53 Updating for 24-bit disks, CheckOpen starts at CHNINFO not &90
  110 REM Also need to ensure all OSARGS calls return A correctly
  120 REM v5.63 Channel buffers can be in Hazel
  130 REM v5.66 Removed code for NotHazel, WS=&1000
  140 REM v5.78 fptr stored in channel information, extends zero-length files
  150 :
  160 D=3:REM Offset to drive number in channel info
  170 :
  180 PRINT "Assembling S.HADFS5"
  190 O%=P%-Block%+mcode%
  200 [OPT0
  210 :
  220 .args
  230 JSR GrabAbs
  240 STA argnum:CLC:ADC #3
  250 CMP #10:BCS args_exit
  260 STA ws                     :\ Save function
  270 TXA:PHA:TYA:TAX:PLA:TAY    :\ Swap X & Y
  280 PHA:TXA:PHA                :\ Save X & Y
  290 BEQ args2                  :\ Y=0, no handle supplied
  300 LDA ws:CLC:ADC #10:PHA     :\ Add offset to argsY functions
  310 CMP #12:BCC args1          :\ Not a channel function
  320 JSR CheckChannelX          :\ This corrupts argtmp/buf
  330 JSR clearEOF
  340 .args1
  350 PLA:STA ws                 :\ Get function offset back
  360 .args2
  370 STY ws+1:LDA ws:ASL A:TAY
  380 LDA argsTable,Y:STA ws
  390 LDA argsTable+1,Y:LDY ws+1:STA ws+1
  400 LDA argnum:JSR JumpWS      :\ Enter with A=function, X=handle, Y=>data
  410 STA argnum
  420 PLA:TAY:PLA:TAX            :\ Restore X & Y
  430 .args_exit
  440 LDA argnum:RTS
  450 :
  460 .argsTable
  470 EQUW args0_FD:EQUW args0_FE
  480 EQUW args0_FF:EQUW args0_00
  490 EQUW args0_01:EQUW args0_02
  500 EQUW args0_03:EQUW args0_04
  510 EQUW args0_05:EQUW args0_06
  520 \
  530 EQUW argsY_FD:EQUW argsY_FE
  540 EQUW argsY_FF:EQUW argsY_00
  550 EQUW argsY_01:EQUW argsY_02
  560 EQUW argsY_03:EQUW argsY_04
  570 EQUW argsY_05:EQUW argsY_06
  580 :
  590 \ --------------------------------------------------
  600 \ OSARGS &FD,0 - Read version number and information
  610 \ --------------------------------------------------
  620 \ On exit, A=xx from version x.xz, eg 54 for v5.42
  630 \          zp=&yzxxaabb from version x.yz and capability aabb
  640 \          eg &4205aabb for version 5.42
  650 \ --------------------------------------------------
  660 .args0_FD
  670 LDA #able% AND &FF:STA 0,Y
  680 LDA #able% DIV 256:STA 1,Y
  690 LDA #EVAL("&"+ver$):STA 2,Y
  700 LDA #EVAL("&"+MID$(ver$,3,2)):STA 3,Y
  710 LDA #INT VAL ver$*10+VAL MID$(ver$,1+INSTR(ver$,"."))/10:RTS
  720 :
  730 \ -----------------------------------------
  740 \ OSARGS &FD/&FE,Y - Read/Write system info
  750 \ -----------------------------------------
  760 \ OSARGS &FD - Write system information
  770 \ OSARGS &FE - Read system information
  780 \ Y=25-29 - CSD/LIB/URD/USER/CURR
  790 \ -----------------------------------------
  800 .argsY_FD:.argsY_FE
  810 \         25   26   27   28            29
  820 \         CSD  LIB  URD  USR/OPT/PRV  CURR  FLG/INT/EXT
  830 \         &70  &74  &78  &7C           &80     &84
  840 \
  850 PHA:TXA:JSR ChannelRange   :\ Check handle
  860 PLA:BCC args_exit          :\ Out of range, exit cleanly
  870 LSR A:PHP                  :\ Cy=Read/Write flag
  880 TXA:ASL A:ASL A            :\ Convert channel to offset to context
  890 ADC #(CSD-25*4-5) AND &FF  :\ Offset from CSD
  900 TAX:PLP:BCC argsY_00       :\ CC - jump to read setting
  910 JSR argsY_01c              :\ Write context
  920 LDA #0:STA VFLG:RTS        :\ Clear validity flags
  930 :
  940 \ ---------------------
  950 \ OSARGS 0,Y - Read PTR
  960 \ OSARGS 2,Y - Read EXT
  970 \ ---------------------
  980 .argsY_02
  990 INX:INX:INX:INX            :\ Point to EXT
 1000 .argsY_00
 1010 LDA WS+&05,X:STA 0,Y
 1020 LDA WS+&06,X:STA 1,Y
 1030 LDA WS+&07,X:STA 2,Y
 1040 LDA WS+&08,X:STA 3,Y
 1050 LDA #0:RTS
 1060 :
 1070 \ ---------------------------------------
 1080 \ OSARGS &FE,0 - Read last drive accessed
 1090 \ ---------------------------------------
 1100 \ On exit, zp holds drive number
 1110 \          A holds a copy of drive number
 1120 \          Consequently, A<&80 is test for valid return
 1130 \ ---------------------------------------
 1140 .args0_FE
 1150 LDA drive:STA 0,Y:RTS
 1160 :
 1170 \ --------------------------------------------
 1180 \ OSARGS 0,0 - Read filing system number
 1190 \ OSARGS 3,0 - Read libfs filing system number
 1200 \ --------------------------------------------
 1210 .args0_00:.args0_03
 1220 JSR FindWS:LDY #myfs:LDA (ws),Y :\ Get configured FS number
 1230 CMP #5:BCC args0_03a            :\ Can't be DFS or lower
 1240 CMP #20:BCC args0_03b           :\ Only 4-bit range
 1250 .args0_03a
 1260 LDA #HADFSnum:STA (ws),Y        :\ Reset to default HADFS fsnum
 1270 .args0_03b
 1280 RTS
 1290 :
 1300 \ --------------------------------------
 1310 \ OSARGS 1,0 - Read command line address
 1320 \ --------------------------------------
 1330 .args0_01
 1340 LDA cptr+0:STA 0,Y:LDA cptr+1:STA 1,Y
 1350 LDA #&FF:STA 2,Y:STA 3,Y
 1360 :
 1370 \ --------------------------------
 1380 \ OSARGS 2,0 - Return version flag
 1390 \ --------------------------------
 1400 .args0_02
 1410 LDA #0:RTS
 1420 :
 1430 \ ---------------------------------
 1440 \ OSARGS 4,0 - Read disk used space
 1450 \ OSARGS 5,0 - Read disk free space
 1460 \ ---------------------------------
 1470 .args0_04:.args0_05
 1480 LSR A:PHP:DEX:STX catex           :\ CC=used, CS=free, &FF=no display
 1490 LDA CSD+d:STA drive:JSR AddUpFree :\ Add up free space on CSD drive
 1500 PLP:BCS P%+5:JSR AddUpUsed:LDX #3 :\ If ARGS 5, convert to used
 1510 .args0_04lp
 1520 LDA numstore,X:STA 3,Y            :\ Copy to returned data
 1530 DEY:DEX:BNE args0_04lp
 1540 TXA:STA 3,Y                       :\ Clear bottom byte
 1550 :
 1560 \ -------------------
 1570 \ OSARGS 6,0 - Unused
 1580 \ -------------------
 1590 .args0_06
 1600 RTS
 1610 :
 1620 \ ------------------------
 1630 \ OSARGS 4,Y - Read Alloc
 1640 \ OSARGS 6,Y - Write Alloc
 1650 \ ------------------------
 1660 .argsY_06
 1670 JSR argsY_06a              :\ Write file allocation
 1680 .argsY_04
 1690 LDA WS+&14,X:STA 3,Y
 1700 LDA WS+&13,X:STA 2,Y
 1710 LDA WS+&12,X:STA 1,Y
 1720 LDA #0:BEQ argsY_05a       :\ Write &00 as bottom byte
 1730 :
 1740 \ ---------------------
 1750 \ OSARGS 5,Y - Read EOF
 1760 \ ---------------------
 1770 .argsY_05
 1780 JSR CheckEOF               :\ Read EOF on channel
 1790 STA 3,Y:STA 2,Y:STA 1,Y    :\ Write &00 or &FF to data
 1800 .argsY_05a
 1810 STA 0,Y
 1820 .ChkEOFne
 1830 LDA #0:RTS                 :\ EOF false, EQ=1
 1840 :
 1850 \ -----------------------------
 1860 \ FSC 1 (OSBYTE &7F) - Read EOF
 1870 \ -----------------------------
 1880 .eof
 1890 \TXA:JSR CheckChannelX
 1900 JSR CheckEOF:TAX:RTS       :\ Return EOF in X
 1910 :
 1920 \ -------------------------------
 1930 \ CheckEOF - Compare PTR with EXT
 1940 \ -------------------------------
 1950 .CheckEOF
 1960 LDA WS+&08,X:CMP WS+&0C,X:BCC ChkEOFne
 1970 LDA WS+&07,X:CMP WS+&0B,X:BCC ChkEOFne
 1980 LDA WS+&06,X:CMP WS+&0A,X:BCC ChkEOFne
 1990 LDA WS+&05,X:CMP WS+&09,X:BCC ChkEOFne
 2000 LDA #&FF:RTS               :\ EOF true, EQ=0
 2010 :
 2020 .cmp_alloc
 2030 \ lo byte must be zeroed
 2040 INX:INX:INX:INX:INX:INX:INX:INX
 2050 .cmp_EXT
 2060 INX:INX:INX:INX
 2070 .cmp_PTR
 2080 LDA WS+&08,X:CMP 3,Y:BCC cmp_xt:BNE cmp_xt
 2090 LDA WS+&07,X:CMP 2,Y:BCC cmp_xt:BNE cmp_xt
 2100 LDA WS+&06,X:CMP 1,Y:BCC cmp_xt:BNE cmp_xt
 2110 LDA WS+&05,X:CMP 0,Y
 2120 .cmp_xt
 2130 RTS
 2140 \ CC= M>PTR, M>EXT
 2150 \ CS= M<=PTR, M<=EXT
 2160 :
 2170 .cmp_PTRhi
 2180 LDA 3,Y:CMP WS+&08,X:BNE cmp_PTRlo
 2190 LDA 2,Y:CMP WS+&07,X:BNE cmp_PTRlo
 2200 LDA 1,Y:CMP WS+&06,X
 2210 .cmp_PTRlo
 2220 RTS
 2230 \ EQ= PTRhi=Mhi
 2240 :
 2250 .IncPTR
 2260 SEC
 2270 LDA WS+&05,X:ADC #0:STA ptrstore+0
 2280 LDA WS+&06,X:ADC #0:STA ptrstore+1
 2290 LDA WS+&07,X:ADC #0:STA ptrstore+2
 2300 LDA WS+&08,X:ADC #0:STA ptrstore+3
 2310 LDY #ptrstore:BNE argsY_01a
 2320 :
 2330 \ --------------------
 2340 \ OSARGS 1,Y - Set PTR
 2350 \ --------------------
 2360 .argsY_01
 2370 JSR CheckDir2
 2380 .argsY_01a
 2390 JSR cmp_PTRhi:BEQ argsY_01b
 2400 JSR argsY_FF       :\ Flush buffer to disk
 2410 .argsY_01b
 2420 LDA #&FF:PHA
 2430 JSR cmp_EXT:DEX:DEX:DEX:DEX
 2440 BCS argsY_01d      :\ PTR is moving backwards
 2450 JSR CheckPTRset    :\ Can I move PTR past EXT?
 2460 PLA:JSR argsY_03a  :\ PTR moving past EXT, do EXT=
 2470 DEX:DEX:DEX:DEX
 2480 .argsY_01c
 2490 PHA
 2500 .argsY_01d
 2510 LDA 0,Y:STA WS+&05,X
 2520 LDA 1,Y:STA WS+&06,X
 2530 LDA 2,Y:STA WS+&07,X
 2540 LDA 3,Y:STA WS+&08,X
 2550 PLA
 2560 .argsY_01e
 2570 RTS
 2580 :
 2590 \ --------------------
 2600 \ OSARGS 3,Y - Set EXT
 2610 \ --------------------
 2620 .argsY_03
 2630 JSR CheckDir2
 2640 .argsY_03a
 2650 JSR CheckOut2
 2660 LDA #&FF:PHA                :\ Prepare to return A=&FF, file not extended
 2670 JSR cmp_PTR:BCC argsY_03b   :\ new EXT >= PTR, leave PTR unchanged
 2680 JSR argsY_01a:BMI argsY_03c :\ new EXT < PTR, push PTR lower
 2690 .argsY_03b
 2700 JSR cmp_EXT:DEX:DEX:DEX:DEX :\ Compare new EXT with existing EXT
 2710 BCS argsY_03c               :\ new EXT < EXT, file shrinking, Alloc unchanged
 2720 PLA:JSR argsY_06b           :\ new EXT > EXT, ensure Alloc is big enough
 2730 \ Should pad with zeros
 2740 LDA #0:PHA                  :\ Prepare to return A=0, file extended
 2750 .argsY_03c
 2760 INX:INX:INX:INX:BNE argsY_01d
 2770 :
 2780 \ ---------
 2790 \ Set alloc
 2800 \ ---------
 2810 \ On entry, X=>channel, Y=>data
 2820 \ On exit,  A=0, X,Y preserved for caller
 2830 \ ---------------------------------------
 2840 .argsY_06a
 2850 JSR CheckDir2:JSR CheckOut2
 2860 .argsY_06b
 2870 JSR cmpAllocs                  :\ Compare requested Alloc with current Alloc
 2880 BCS argsY_01e:TYA:PHA          :\ Requested Alloc <= Existing Alloc, nothing to be done
 2890 LDA CURR+0:PHA:LDA CURR+1:PHA  :\ Save to protect SPOOLing of *CAT, etc
 2900 LDA CURR+2:PHA:LDA CURR+3:PHA  :\ Can't use loop as need both X and Y
 2910 LDA fptr+1:PHA:LDA fptr+0:PHA  :\ Save file pointer to protect SPOOLing *CAT, etc.
 2920 JSR CheckDskChg0               :\ Read FSM, load directory, check disk not changed, X Y preserved
 2930 LDA HDR+&0C:BMI argsY_06c      :\ BigDir, up to 4G length
 2940 LDA 3,Y:BNE errCantExtend      :\ SmallDir, 16M maximum
 2950 LDA 2,Y:CMP #8:BCS errCantExtend
 2960 :
 2970 .argsY_06c
 2980 .z%
 2990   TYA:PHA:TXA:PHA              :\ Save data pointer and info pointer
 3000   LDA WS+&14,X:ORA WS+&13,X
 3010   ORA WS+&12,X:BNE argsY_06d   :\ File not zero length, use it
 3020   JSR C8to16K:JSR FindFreeSpace:\ Look for 16K space, AXY corrupted
 3030   PLA:PHA:TAX                  :\ Get channel offset back
 3040   LDA start+0:STA WS+&01,X     :\ Set start sector
 3050   LDA start+1:STA WS+&02,X
 3060   LDA start+2:STA WS+&03,X
 3070   JMP argsY_06h
 3080 :]:IF VALbase$<5.78:z%=P%-z%:P%=P%-z%:O%=O%-z%
 3090 :
 3100 .argsY_06d
 3110 CLC
 3120 LDA WS+&01,X:ADC WS+&12,X:STA start+0  :\ start=sector after end of existing file
 3130 LDA WS+&02,X:ADC WS+&13,X:STA start+1
 3140 LDA WS+&03,X:ADC WS+&14,X:STA start+2
 3150 .z%
 3160   TYA:PHA:TXA:PHA                      :\ Save data pointer and info pointer
 3170 :]:IF VALbase$>=5.78:z%=P%-z%:P%=P%-z%:O%=O%-z%
 3180 JSR FindFSMEntry:BEQ argsY_06e         :\ Returns X=>FSM entry, Y=BigDisk
 3190 .errCantExtend
 3200 LDA #119:JSR OSBYTE                    :\ Close Spool/Exec
 3210 JSR errors:EQUB 191:EQUS "Can't extend":BRK
 3220 :
 3230 .argsY_06e
 3240 JSR C8to16K                           :\ Prepare to ask for 16K
 3250 \LDA #0:\STA len+2:\LDA #&40:\STA len+1:\ Prepare to ask for 16K
 3260 TYA:BPL argsY_06f                      :\ 16-bit FSM
 3270 INX:LDA &F24,X:BNE argsY_06g           :\ >16M available, use 16K
 3280 .argsY_06f
 3290 LDA &F23,X:BNE argsY_06g               :\ >64K available, use 16K
 3300 LDA &F22,X:CMP #&40:BCS argsY_06g      :\ >16K available, use 16K
 3310 STA len+1                              :\ Less than 16K, use it instead
 3320 .argsY_06g
 3330 JSR FindFreeSub                        :\ Claim space from FSM
 3340 .argsY_06h
 3350 JSR SaveFSM                            :\ Save updated FSM
 3360 PLA:TAX:PLA:TAY:CLC                    :\ Get info pointer and data pointer back
 3370 LDA WS+&12,X:ADC len+1:STA WS+&12,X    :\ Update channel's Alloc
 3380 LDA WS+&13,X:ADC len+2:STA WS+&13,X
 3390 LDA WS+&14,X:ADC #0:STA WS+&14,X
 3400 CLC:JSR UpdateFromAlloc                :\ Look for my directory entry and update length
 3410 JSR cmpAllocs:BCS P%+5:JMP argsY_06c   :\ 16K wasn't enough, claim another 16K
 3420 :
 3430 PLA:STA fptr+0:PLA:STA fptr+1:LDY #3   :\ Restore fptr for SPOOLed *CAT, etc.
 3440 .argsY_06lp2
 3450 PLA:STA sect,Y:DEY:BPL argsY_06lp2     :\ Restore CURR
 3460 ORA sect+1:ORA sect+2                  :\ Was CURR valid?
 3470 BEQ P%+5:JSR GetDir                    :\ Refetch if valid so SPOOLed *CAT, etc, can continue
 3480 PLA:TAY:LDA #0:RTS                     :\ Return claimed
 3490 :
 3500 .cmpAllocs
 3510 LDA WS+&11,X:PHA               :\ Save part of ID
 3520 LDA #0:STA WS+&11,X            :\ Temp'y use as low byte of Alloc
 3530 JSR cmp_alloc                  :\ Returns X=X+12
 3540 PHP:TXA:SEC:SBC #12:TAX:PLP    :\ Restore X
 3550 PLA:STA WS+&11,X:RTS           :\ Restore ID part
 3560 :
 3570 \ ------------------------------------
 3580 \ OSARGS &FF,Y - Ensure buffer to disk
 3590 \ ------------------------------------
 3600 .argsY_FF
 3610 CLC                            :\ CLC=Not closing
 3620 .argsY_FFa
 3630 PHP:LDA WS+&00,X:AND #&82
 3640 CMP #&82:BNE UpdateDone        :\ Not output or not modified
 3650 PLP:PHP:BCC argsY_FFd          :\ Not closing
 3660 LDA WS+&00,X:PHA:JSR zero_flag :\ If close fails, already zeroed
 3670 JSR CheckDskChg0               :\ Check drive contains my disk
 3680 PLA:STA WS+&00,X               :\ Restore flag, it's still needed
 3690 .argsY_FFd
 3700 LDA #&FF:JSR AccessBuffer      :\ Write to disk
 3710 .UpdateDone
 3720 LDA #&DC:JSR clear_flag        :\ Clear 'buffer modified' flag
 3730 PLP:BCS P%+4:LDA #0:RTS        :\ Ensure returns 0, close returns channel flag
 3740 :
 3750 \ ---------------------------------
 3760 \ OSARGS &FF,0 - Ensure all buffers
 3770 \ ---------------------------------
 3780 .args0_FF
 3790 LDY #25
 3800 .args0_FFlp
 3810 \TYA:JSR ChannelAddrY:JSR argsY_FF :\ Loop through channels 25 to 29
 3820 INY:CPY #30:BNE args0_FFlp
 3830 LDA #0:RTS
 3840 :
 3850 .AccessBuffer
 3860 \ A= R/W flag
 3870 STA action
 3880 LDA #1:STA num:\ one page
 3890 JSR FindSector
 3900 LDA buf+1:STA addr+1
 3910 JMP DiskAccIO:\DIR2
 3920 :
 3930 .FindSector
 3940 CLC
 3950 LDA WS+&01,X:ADC WS+&06,X:STA sect+0:STA start+0
 3960 LDA WS+&02,X:ADC WS+&07,X:STA sect+1:STA start+1
 3970 LDA WS+&03,X:ADC WS+&08,X:STA sect+2:STA start+2
 3980 .FindDriveNumber
 3990 LDA WS+&01+D,X:STA drive:RTS
 4000 :
 4010 .errEOF
 4020 JSR errors:EQUB 223:EQUS "EOF":BRK  :\ Was "End of file"
 4030 :
 4040 .bget
 4050 CLC:EQUB &A9                   :\ CLC=BGET, skip following SEC
 4060 .bput
 4070 SEC                            :\ SEC=BPUT
 4080 JSR GrabAbs
 4090 :
 4100 \ Enter here when AbsWs already owned
 4110 \ OSGBPB needs len+0 preserved
 4120 .putget1
 4130 STA buf:TXA:PHA:LDA shadow:PHA:LDX #0       :\ Save X, shadow
 4140 .putgetlp1
 4150 LDA addr,X:PHA:INX:TXA:EOR #4:BNE putgetlp1 :\ Save addr, preserving Cy
 4160 TYA:PHA:BCS bput1              :\ Save Y
 4170 JSR CheckInput                 :\ X=info, (buf)=>buffer
 4180 LDA WS+&00,X:AND #&20:BNE errEOF
 4190 JSR CheckEOF:BEQ bget2         :\ Not at EOF
 4200 LDA #&20:JSR set_flag          :\ Set EOF flag
 4210 LDA #254:SEC:BCS putget_end    :\ Return Cy=1
 4220 .bget2
 4230 JSR InputUpdate                :\ Read from disk if needed
 4240 LDA WS+&05,X:TAY:LDA (buf),Y   :\ Get byte from buffer
 4250 PHA:JSR IncPTR:PLA:CLC         :\ Increment PTR
 4260 BCC putget_end                 :\ Return Cy=0, A=byte
 4270 :
 4280 .bput1
 4290 LDA buf:PHA:TYA:JSR CheckOutput:\ X=info, (buf)=>buffer
 4300 LDA WS+&05,X:PHA               :\ Get buffer offset
 4310 BNE P%+5:JSR IncPTR            :\ Flush buffer if offset=0
 4320 PLA:STA WS+&05,X               :\ Restore buffer offset
 4330 JSR InputUpdate                :\ Read from disk if needed
 4340 LDA WS+&05,X:TAY:PLA:STA (buf),Y:\ Store byte in buffer
 4350 PHA:LDA #2:JSR set_flag        :\ Buffer modified
 4360 JSR IncPTR:JSR clearEOF:PLA:CLC:\ Increment PTR
 4370 :
 4380 .putget_end
 4390 STA buf:PLA:TAY:LDX #3         :\ Restore Y
 4400 .putget_lp2
 4410 PLA:STA addr,X:DEX:BPL putget_lp2  :\ Restore addr, preserving Cy
 4420 PLA:STA shadow:PLA:TAX:LDA buf:RTS :\ Restore shadow, X
 4430 :
 4440 .InputUpdate
 4450 \LDA WS+&00,X:\AND #1:\BNE InputUpOk
 4460 LDA WS+&00,X:AND #&41          :\ Test if b6=open for input and b1=buffer loaded
 4470 CMP #&40:BNE InputUpOk         :\ If not (open for input and buffer empty), skip
 4480 LDA #0:JSR AccessBuffer:LDA #1 :\ Open for input, and buffer empty, need to load buffer
 4490 .set_flag
 4500 ORA WS+&00,X:STA WS+&00,X      :\ Update channel flag
 4510 .InputUpOk
 4520 RTS
 4530 :
 4540 .zero_flag
 4550 LDA #0:BEQ clr_flag2
 4560 .clearEOF
 4570 LDA #&DF
 4580 .clear_flag
 4590 AND WS+&00,X
 4600 .clr_flag2
 4610 STA WS+&00,X
 4620 .CheckIsOk
 4630 RTS
 4640 :
 4650 .CheckDir:JSR CheckChannel
 4660 .CheckDir2
 4670 LDA WS+&00,X:AND #&10:BEQ CheckIsOk
 4680 .ChIsADir
 4690 JSR zero_flag:\ Close channel
 4700 JSR errors:EQUB 181:EQUS "Is a directory":BRK
 4710 :
 4720 .CheckInput
 4730 JSR CheckDir
 4740 LDA WS+&00,X:AND #&7F:CMP #64
 4750 BCC NOFRead:AND #4:BNE CheckIsOk
 4760 .NOFRead
 4770 JSR errors:EQUB 189:EQUS "Not open for reading":BRK
 4780 :
 4790 .CheckOutput
 4800 JSR CheckDir:.CheckOut2
 4810 LDA WS+&00,X:BPL errNotUpdate
 4820 .CheckWrite
 4830 AND #8:BNE CheckIsOk
 4840 .errNotUpdate
 4850 JSR errors:EQUB 193:EQUS "Not open for update":BRK
 4860 :
 4870 .CheckPTRset
 4880 LDA WS+&00,X:BMI CheckWrite
 4890 JSR errors:EQUB 183:EQUS "Outside file":BRK
 4900 :
 4910 .UpdateLength
 4920 SEC
 4930 \.UpdateWithAlloc:\   Enter with CC
 4940 .UpdateFromAlloc:\   Enter with CC
 4950 TXA:PHA:TYA:PHA:PHP
 4960 \\LDA WS+&01+D,X:\STA drive
 4970 .z%
 4980   JSR CheckDskChg0            :\ Check disk, load FSM, get directory
 4990 :]:IF VALbase$>=5.78:z%=P%-z%:P%=P%-z%:O%=O%-z%
 5000 \ Alloc  -> disk has already been checked
 5010 \ Length -> disk has already been checked
 5020 LDA WS+&03,X:STA start+2
 5030 LDA WS+&02,X:STA start+1
 5040 LDA WS+&01,X:STA start+0
 5050 .z%
 5060   JSR LookForEntry            :\ fptr=>directory entry
 5070 :]:IF VALbase$>=5.78:z%=P%-z%:P%=P%-z%:O%=O%-z%
 5080 .z%
 5090   LDA WS+&16,X:STA fptr+1     :\ fptr=>file entry
 5100   LDA WS+&15,X:STA fptr+0
 5110   JSR CreatePutSector         :\ Set start sector in file info
 5120 :]:IF VALbase$<5.78:z%=P%-z%:P%=P%-z%:O%=O%-z%
 5130 LDY #&12:LDA WS+&09,X
 5140 PLP:BCS UpdateLengthLow       :\ CS=make length=EXT
 5150 TXA:ADC #8:TAX:LDA #0         :\ CC=make length=Alloc, low byte is zero
 5160 .UpdateLengthLow
 5170 STA (fptr),Y:INY              :\ byte 0
 5180 LDA WS+&0A,X:STA (fptr),Y:INY :\ byte 1
 5190 LDA HDR+&0C:BPL UpdateLen1
 5200 INY:LDA WS+&0C,X:STA (fptr),Y :\ byte 3
 5210 DEY:LDA #0:BEQ UpdateLen2
 5220 .UpdateLen1
 5230 LDA (fptr),Y:AND #&F8
 5240 .UpdateLen2
 5250 ORA WS+&0B,X:STA (fptr),Y     :\ byte 2
 5260 JSR SaveThisDir
 5270 PLA:TAY:PLA:TAX
 5280 .UpdateOk
 5290 RTS
 5300 :
 5310 .CheckDskChg0
 5320 JSR FindDriveNumber
 5330 TXA:PHA:JSR CheckHADFSDisk:PLA:TAX
 5340 .CheckDskChg
 5350 \ drive already set
 5360 LDA WS+&0D,X:STA sect+0
 5370 LDA WS+&0E,X:STA sect+1
 5380 LDA WS+&0F,X:STA sect+2
 5390 JSR GetDir
 5400 LDA WS+&10,X:CMP HDR+&10:BNE DiskChanged
 5410 LDA WS+&11,X:CMP HDR+&11:BEQ UpdateOk
 5420 .DiskChanged
 5430 \JSR ClearDIR:\STA VFLG
 5440 LDA #0:STA VFLG
 5450 JSR errorDIR:EQUB 200:EQUS "Disk changed":BRK
 5460 :
 5470 .FindZero
 5480 LDA #0:RTS
 5490 .find
 5500 JSR GrabAbs:STX blk+0:STY blk+1
 5510 CMP #0:BEQ close
 5520 CMP #&40:BCC FindZero:JMP open
 5530 :
 5540 .close
 5550 TYA:BNE CloseOne
 5560 \ Close all
 5570 LDA #119:JSR OSBYTE:\ Ask MOS to close SPOOL/EXEC files
 5580 LDY #25
 5590 .CloseAllLp
 5600 \TYA:JSR ChannelAddrY
 5610 BEQ Closed
 5620 JSR CloseChn:.Closed
 5630 INY:CPY #30:BNE CloseAllLp
 5640 LDY #0:BEQ Closed_Ok
 5650 .CloseOne
 5660 JSR CheckChannel
 5670 .CloseChn
 5680 SEC:JSR argsY_FFa:BPL CloseInput:\ Update buffer, flagged as closing
 5690 :
 5700 TYA:PHA
 5710 .z%
 5720   JSR CheckDskChg0 :\ check disk, load FSM
 5730 :]:IF VALbase$<5.78:z%=P%-z%:P%=P%-z%:O%=O%-z%
 5740 JSR UpdateLength   :\ load directory, update file length, save directory
 5750 LDA WS+&09,X:PHA   :\ save bottom byte of EXT
 5760 CMP #1             :\ C=1, extra sector needed
 5770 LDA WS+&01,X:ADC WS+&0A,X:STA start+0
 5780 LDA WS+&02,X:ADC WS+&0B,X:STA start+1
 5790 LDA WS+&03,X:ADC WS+&0C,X:STA start+2
 5800 PLA:EOR #255:CMP #255
 5810 LDA WS+&12,X:SBC WS+&0A,X:STA len+1
 5820 LDA WS+&13,X:SBC WS+&0B,X:STA len+2
 5830 LDA WS+&14,X:SBC WS+&0C,X:BEQ P%+5:JMP errTooLong:\ Can't return len>16M to FSM in one go
 5840 \TYA:\PHA
 5850 TXA:PHA
 5860 JSR AddToFSM:JSR SaveFSM
 5870 PLA:TAX:PLA:TAY
 5880 :
 5890 .CloseInput
 5900 JSR zero_flag:CPY &256
 5910 BNE CloseNotExec
 5920 STA &256:BEQ Closed_Ok:\ EXEC
 5930 .CloseNotExec
 5940 CPY &257:BNE Closed_Ok
 5950 STA &257:\ SPOOL
 5960 .Closed_Ok
 5970 LDX blk+0:RTS:\ A=0, Y=chn
 5980 :
 5990 .open
 6000 STA buf+0:JSR XYtoF2
 6010 JSR SearchPathBad:JSR CheckPath
 6020 JSR CheckDirInfo:\ A=0/1/2/&82
 6030 AND #&7F:\ Root is just a dir.
 6040 .OpenInX:\ RUN-EXEC
 6050 :
 6060 \ Find a channel
 6070 \ --------------
 6080 \ Search for an unused channel
 6090 \ On exit,  Y=channel, X=>channel, A=corrupted
 6100 \ --------------------------------------------
 6110 PHA:LDY #25                         :\ Start with channel 25
 6120 .FindChanLp
 6130 LDX ChnInfo-25,Y                    :\ X=>channel info
 6140 LDA WS,X:BEQ FindChkChn1            :\ Channel already open
 6150 .FindChanNxt
 6160 INY:CPY #30:BCC FindChanLp
 6170 JSR errors:EQUB 192:EQUS "Too many open":BRK
 6180 .FindChkChn1
 6190 JSR WhatMOS:BCC FindChanOk          :\ CC=Master, CS=BBC
 6200 LDA OPTFLG:AND #&40                 :\ Check if &10xx usable
 6210 CPX #CHN26 AND 255:BCC FindChanOk   :\ Chn>26, use it
 6220 BEQ FindChkChn2                     :\ Chn26, check OPTFLG
 6230 LDA buf+0:AND #&80:EOR #&80         :\ Chn25, can only use for input
 6240 .FindChkChn2
 6250 AND #&FF:BEQ FindChanNxt            :\ Chn25 or Chn26 unusable, try another one
 6260 .FindChanOk
 6270 :
 6280 STY argchn:PLA
 6290 BNE open_file_found
 6300 BIT buf+0:BVC open_create_file
 6310 \ IN or UP
 6320 LDA buf+0:AND #8:BEQ OpenExit
 6330 JMP errNotFound
 6340 .OpenExit
 6350 LDX blk+0:LDY blk+1:RTS
 6360 .open_create_file
 6370 \ OUT & no file, A=0
 6380 JSR C8to16K
 6390 \STA len+0:\STA len+2
 6400 \LDA #&40:\STA len+1
 6410 TXA:PHA
 6420 LDA #&FF:CLC:JSR CreateEntry:\ Create 16K file
 6430 PLA:TAX
 6440 LDA #&C:STA WS+&00,X:\ WR bits
 6450 BNE open_acc_ok
 6460 .open_file_found
 6470 CMP #2:BNE OpenNotDir
 6480 BIT buf+0:BMI IsADirError
 6490 \ IN(dir)
 6500 LDA buf+0:AND #4:BEQ OpenNotDir
 6510 .IsADirError
 6520 JMP errNotFile
 6530 .OpenNotDir
 6540 TXA:PHA                             :\ OpenIn multiple times, OpenOut once only
 6550 LDA buf+0:LSR A:ORA #&80:AND #&C0   :\ Work out open flag to check for
 6560 JSR CheckNotOpen                    :\ Check if I can open this way
 6570 JSR YDoIOwn:INY:INY:PLA:TAX         :\ Y->my 'E' bit
 6580 LDA (fptr),Y:ROL A:ROL attrs
 6590 DEY:LDA (fptr),Y:ROL A:ROL attrs
 6600 DEY:LDA (fptr),Y:ROL A:ROL attrs
 6610 LDA attrs:AND #3:EOR #3:PHA   :\ A=000000WR
 6620 :
 6630 LDY #8:LDA (fptr),Y:BPL open_noD
 6640 PLA:ORA #5:PHA                :\ A=00000DWR
 6650 .open_noD
 6660 PLA:ASL A:ASL A:STA WS+&00,X
 6670 LDA buf+0:CMP #&C0:BCS open_acc_ok
 6680 LSR A:LSR A:LSR A:LSR A
 6690 AND WS+&00,X:AND #&0C
 6700 BNE open_acc_ok
 6710 STA WS+&00,X:JMP errNoAccess
 6720 :
 6730 \ Set up channel buffer
 6740 \ ---------------------
 6750 .open_acc_ok
 6760 :
 6770 LDY #2
 6780 .openlp1
 6790 LDA CURR,Y   :STA WS+&0D+2,X  :\ Directory
 6800 LDA HDR+&10,Y:STA WS+&10+2,X  :\ Disk ID
 6810 LDA fptr,Y   :STA WS+&15+2,X  :\ Directory entry
 6820 DEX:DEY:BPL openlp1           :\ X is now X-3
 6830 :
 6840 LDY #&12:\ Y=>length
 6850 LDA (fptr),Y:STA WS+&09+3,X:CMP #1:INY            :\ CS=round alloc up
 6860 LDA (fptr),Y:STA WS+&0A+3,X:ADC #0:STA WS+&12+3,X :\ EXT=length, Alloc=(length+255)DIV256
 6870 INY:LDA HDR+&0C:PHP
 6880 LDA (fptr),Y:PLP:BMI P%+4:AND #7
 6890 STA WS+&0B+3,X:ADC #0:STA WS+&13+3,X:INY
 6900 LDA HDR+&0C:AND #&80:BPL P%+4:LDA (fptr),Y
 6910 STA WS+&0C+3,X:ADC #0:STA WS+&14+3,X
 6920 :
 6930 INY:LDA (fptr),Y:STA WS+&01+3,X             :\ Set start sector
 6940 INY:LDA (fptr),Y:STA WS+&02+3,X:INY
 6950 LDA HDR+&0C:AND #&80:BPL P%+4:LDA (fptr),Y
 6960 STA WS+&03+3,X:LDA drive:STA WS+&04+3,X
 6970 :
 6980 \LDY #2
 6990 \.openlp1
 7000 \LDA CURR,Y:\STA WS+&0F,X                   :\ Directory
 7010 \DEX:\DEY:\BPL openlp1                      :\ X is now X-3
 7020 \LDA HDR+&10:\STA WS+&10+3,X                :\ Disk ID
 7030 \LDA HDR+&11:\STA WS+&11+3,X
 7040 :
 7050 LDA buf+0:AND #&C0:ORA WS+&00+3,X
 7060 STA WS+&00+3,X:ASL A:ASL A                :\ Set OUT/IN, Cy=not OUT
 7070 LDA #0:LDY #8:BCC P%+4:LDY #4             :\ OUT, EXT=0/PTR=0; IN/UP, PTR=0
 7080 .openlp2
 7090 STA WS+&05+3,X:INX:DEY:BNE openlp2        :\ PTR=0, EXT=0
 7100 LDA argchn:JMP OpenExit
 7110 :
 7120 .ChannelRange
 7130 CMP #25:BCC ChnRangeOk
 7140 EOR #&FF:CMP #&E2:EOR #&FF
 7150 .ChnRangeOk
 7160 RTS:\ Returns CS=25..29, CC=outside channel range
 7170 :
 7180 \ Offsets to channel information
 7190 .ChnInfo
 7200 EQUB CHN25 AND 255
 7210 EQUB CHN26 AND 255
 7220 EQUB CHN26-(CHN25-CHN26) AND 255
 7230 EQUB CHN26-2*(CHN25-CHN26) AND 255
 7240 EQUB CHNINFO AND 255
 7250 :
 7260 \ Addresses of channel buffers
 7270 EQUB &0F:EQUB &10:EQUB &14:EQUB &15:EQUB &16
 7280 :
 7290 .ChannelAddrY
 7300 TYA
 7310 .ChannelAddr
 7320 \ On entry, A=channel
 7330 \ On exit,  WS,X=channel info, (buf),Y points to buffer
 7340 JSR ChannelRange:BCC errChannel
 7350 TAX:JSR WhatMOS                      :\ CC=Master, CS=BBC
 7360 LDA ChnInfo+5-25,X
 7370 BCS P%+4:ADC #&B1:STA buf+1          :\ buf=>channel buffer
 7380 LDA ChnInfo+0-25,X:TAX               :\ WS,X=>channel info
 7390 LDA #0:STA buf+0
 7400 LDA WS+&00,X                         :\ Get channel flag
 7410 .CheckChnOk
 7420 RTS
 7430 :
 7440 .CheckChannelX
 7450 TXA
 7460 .CheckChannel
 7470 JSR ChannelAddr:BNE CheckChnOk       :\ Exit if channel valid and open
 7480 .Channel_Not_Open
 7490 \JSR errors:\EQUB 222:\EQUS "Channel not open":\BRK
 7500 :
 7510 .errChannel
 7520 JSR errors:EQUB 222:EQUS "Channel":BRK
 7530 :
 7540 .CheckNotOpenFF
 7550 LDA #&FF
 7560 .CheckNotOpen
 7570 PHA:LDY #4
 7580 .CheckNotOpLp
 7590 LDX ChnInfo,Y
 7600 PLA:PHA:AND WS+&00,X:BEQ F_NotOpen
 7610 LDA WS+&01,X:CMP sect+0:BNE F_NotOpen
 7620 LDA WS+&02,X:CMP sect+1:BNE F_NotOpen
 7630 LDA WS+&03,X:CMP sect+2:BNE F_NotOpen
 7640 LDA WS+&01+D,X:CMP drive:BNE F_NotOpen
 7650 JSR errors:EQUB 194:EQUS "File open":BRK
 7660 .F_NotOpen
 7670 DEY:BPL CheckNotOpLp:PLA
 7680 .gbpb0
 7690 RTS
 7700 :
 7710 ]
 7720 PRINT CHR$11;STRING$(20,CHR$9);O%-mcode%;" bytes"
 7730 OSCLI"SAVE ROMb "+STR$~mcode%+" "+STR$~O%+" 3000 "+STR$~(Block%-&5000):Block%=P%
 7740 IF O%>&7BFF:PRINT"Writing over screen.":IF O%>L%:L%=O%
 7750 IF O%>M%:PRINT"Overwriting screen output":VDU7:CLOSE#0
 7760 >"S.HADFS6"