10
20
30
40
50
60
70
80
90
100
110
120
130
140
150 :
160 D=3:
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 .z%
6200 JSR WhatMOS:BCC FindChanOk :\ CC=Master, CS=BBC
6210 :]:IF VALbase$>=5.79:z%=P%-z%:P%=P%-z%:O%=O%-z%
6220 .z%
6230 BIT WHATOS:BMI FindChanOk :\ MI=Master, PL=BBC
6240 :]:IF VALbase$<5.79:z%=P%-z%:P%=P%-z%:O%=O%-z%
6250 LDA OPTFLG:AND #&40 :\ Check if &10xx usable
6260 CPX #CHN26 AND 255:BCC FindChanOk :\ Chn>26, use it
6270 BEQ FindChkChn2 :\ Chn26, check OPTFLG
6280 LDA buf+0:AND #&80:EOR #&80 :\ Chn25, can only use for input
6290 .FindChkChn2
6300 AND #&FF:BEQ FindChanNxt :\ Chn25 or Chn26 unusable, try another one
6310 .FindChanOk
6320 :
6330 STY argchn:PLA
6340 BNE open_file_found
6350 BIT buf+0:BVC open_create_file
6360 \ IN or UP
6370 LDA buf+0:AND #8:BEQ OpenExit
6380 JMP errNotFound
6390 .OpenExit
6400 LDX blk+0:LDY blk+1:RTS
6410 .open_create_file
6420 \ OUT & no file, A=0
6430 JSR C8to16K
6440 \STA len+0:\STA len+2
6450 \LDA #&40:\STA len+1
6460 TXA:PHA
6470 LDA #&FF:CLC:JSR CreateEntry:\ Create 16K file
6480 PLA:TAX
6490 LDA #&C:STA WS+&00,X:\ WR bits
6500 BNE open_acc_ok
6510 .open_file_found
6520 CMP #2:BNE OpenNotDir
6530 BIT buf+0:BMI IsADirError
6540 \ IN(dir)
6550 LDA buf+0:AND #4:BEQ OpenNotDir
6560 .IsADirError
6570 JMP errNotFile
6580 .OpenNotDir
6590 TXA:PHA :\ OpenIn multiple times, OpenOut once only
6600 LDA buf+0:LSR A:ORA #&80:AND #&C0 :\ Work out open flag to check for
6610 JSR CheckNotOpen :\ Check if I can open this way
6620 JSR YDoIOwn:INY:INY:PLA:TAX :\ Y->my 'E' bit
6630 LDA (fptr),Y:ROL A:ROL attrs
6640 DEY:LDA (fptr),Y:ROL A:ROL attrs
6650 DEY:LDA (fptr),Y:ROL A:ROL attrs
6660 LDA attrs:AND #3:EOR #3:PHA :\ A=000000WR
6670 :
6680 LDY #8:LDA (fptr),Y:BPL open_noD
6690 PLA:ORA #5:PHA :\ A=00000DWR
6700 .open_noD
6710 PLA:ASL A:ASL A:STA WS+&00,X
6720 LDA buf+0:CMP #&C0:BCS open_acc_ok
6730 LSR A:LSR A:LSR A:LSR A
6740 AND WS+&00,X:AND #&0C
6750 BNE open_acc_ok
6760 STA WS+&00,X:JMP errNoAccess
6770 :
6780 \ Set up channel buffer
6790 \ ---------------------
6800 .open_acc_ok
6810 :
6820 LDY #2
6830 .openlp1
6840 LDA CURR,Y :STA WS+&0D+2,X :\ Directory
6850 LDA HDR+&10,Y:STA WS+&10+2,X :\ Disk ID
6860 LDA fptr,Y :STA WS+&15+2,X :\ Directory entry
6870 DEX:DEY:BPL openlp1 :\ X is now X-3
6880 :
6890 LDY #&12:\ Y=>length
6900 LDA (fptr),Y:STA WS+&09+3,X:CMP #1:INY :\ CS=round alloc up
6910 LDA (fptr),Y:STA WS+&0A+3,X:ADC #0:STA WS+&12+3,X :\ EXT=length, Alloc=(length+255)DIV256
6920 INY:LDA HDR+&0C:PHP
6930 LDA (fptr),Y:PLP:BMI P%+4:AND #7
6940 STA WS+&0B+3,X:ADC #0:STA WS+&13+3,X:INY
6950 LDA HDR+&0C:AND #&80:BPL P%+4:LDA (fptr),Y
6960 STA WS+&0C+3,X:ADC #0:STA WS+&14+3,X
6970 :
6980 INY:LDA (fptr),Y:STA WS+&01+3,X :\ Set start sector
6990 INY:LDA (fptr),Y:STA WS+&02+3,X:INY
7000 LDA HDR+&0C:AND #&80:BPL P%+4:LDA (fptr),Y
7010 STA WS+&03+3,X:LDA drive:STA WS+&04+3,X
7020 :
7030 \LDY #2
7040 \.openlp1
7050 \LDA CURR,Y:\STA WS+&0F,X :\ Directory
7060 \DEX:\DEY:\BPL openlp1 :\ X is now X-3
7070 \LDA HDR+&10:\STA WS+&10+3,X :\ Disk ID
7080 \LDA HDR+&11:\STA WS+&11+3,X
7090 :
7100 LDA buf+0:AND #&C0:ORA WS+&00+3,X
7110 STA WS+&00+3,X:ASL A:ASL A :\ Set OUT/IN, Cy=not OUT
7120 LDA #0:LDY #8:BCC P%+4:LDY #4 :\ OUT, EXT=0/PTR=0; IN/UP, PTR=0
7130 .openlp2
7140 STA WS+&05+3,X:INX:DEY:BNE openlp2 :\ PTR=0, EXT=0
7150 LDA argchn:JMP OpenExit
7160 :
7170 .ChannelRange
7180 CMP #25:BCC ChnRangeOk
7190 EOR #&FF:CMP #&E2:EOR #&FF
7200 .ChnRangeOk
7210 RTS:\ Returns CS=25..29, CC=outside channel range
7220 :
7230 \ Offsets to channel information
7240 .ChnInfo
7250 EQUB CHN25 AND 255
7260 EQUB CHN26 AND 255
7270 EQUB CHN26-(CHN25-CHN26) AND 255
7280 EQUB CHN26-2*(CHN25-CHN26) AND 255
7290 EQUB CHNINFO AND 255
7300 :
7310 \ Addresses of channel buffers
7320 EQUB &0F:EQUB &10:EQUB &14:EQUB &15:EQUB &16
7330 :
7340 .ChannelAddrY
7350 TYA
7360 .ChannelAddr
7370 \ On entry, A=channel
7380 \ On exit, WS,X=channel info, (buf),Y points to buffer
7390 JSR ChannelRange:BCC errChannel
7400 .z%
7410 TAX:JSR WhatMOS :\ CC=Master, CS=BBC
7420 LDA ChnInfo+5-25,X :\ A=high byte of channel buffer
7430 BCS P%+4:ADC #&B1:STA buf+1 :\ buf=>channel buffer
7440 :]:IF VALbase$>=5.79:z%=P%-z%:P%=P%-z%:O%=O%-z%
7450 .z%
7460 TAX:LDA ChnInfo+5-25,X:BIT WHATOS :\ MI=Master, PL=BBC
7470 BPL P%+4:ADC #&B0:STA buf+1 :\ buf=>channel buffer
7480 :]:IF VALbase$<5.79:z%=P%-z%:P%=P%-z%:O%=O%-z%
7490 LDA ChnInfo+0-25,X:TAX :\ WS,X=>channel info
7500 LDA #0:STA buf+0
7510 LDA WS+&00,X :\ Get channel flag
7520 .CheckChnOk
7530 RTS
7540 :
7550 .CheckChannelX
7560 TXA
7570 .CheckChannel
7580 JSR ChannelAddr:BNE CheckChnOk :\ Exit if channel valid and open
7590 .Channel_Not_Open
7600 \JSR errors:\EQUB 222:\EQUS "Channel not open":\BRK
7610 :
7620 .errChannel
7630 JSR errors:EQUB 222:EQUS "Channel":BRK
7640 :
7650 .CheckNotOpenFF
7660 LDA #&FF
7670 .CheckNotOpen
7680 PHA:LDY #4
7690 .CheckNotOpLp
7700 LDX ChnInfo,Y
7710 PLA:PHA:AND WS+&00,X:BEQ F_NotOpen
7720 LDA WS+&01,X:CMP sect+0:BNE F_NotOpen
7730 LDA WS+&02,X:CMP sect+1:BNE F_NotOpen
7740 LDA WS+&03,X:CMP sect+2:BNE F_NotOpen
7750 LDA WS+&01+D,X:CMP drive:BNE F_NotOpen
7760 JSR errors:EQUB 194:EQUS "File open":BRK
7770 .F_NotOpen
7780 DEY:BPL CheckNotOpLp:PLA
7790 .gbpb0
7800 RTS
7810 :
7820 ]
7830 PRINT CHR$11;STRING$(20,CHR$9);O%-mcode%;" bytes"
7840 OSCLI"SAVE ROMb "+STR$~mcode%+" "+STR$~O%+" 3000 "+STR$~(Block%-&5000):Block%=P%
7850 IF O%>&7BFF:PRINT"Writing over screen.":IF O%>L%:L%=O%
7860 IF O%>M%:PRINT"Overwriting screen output":VDU7:CLOSE#0
7870 >"S.HADFS6"