10
20
30
40
50
60
70
80
90
100
110
120
130
140
150
160
170
180
190
200
210
220
230 :
240 PRINT "Assembling S.HADFS4"
250 O%=P%-Block%+mcode%
260 [OPT0
270 :
280 .file
290 JSR GrabAbs:PHA:CLC:ADC #4
300 CMP #13:BCC file1:PLA:RTS
310 .file1
320 PHA:STX blk+0:STY blk+1:LDY #0
330 LDA (blk),Y:STA &F2:INY
340 LDA (blk),Y:STA &F3:DEY
350 JSR SearchPathBad :\ Search for non-null filename
360 TAY:PLA:ASL A:TAX :\ Y=file type 0/1/2
370 LDA fileTable+0,X:STA ws+0 :\ Index into dispatch table
380 LDA fileTable+1,X:STA ws+1
390 PLA:JSR JumpWS :\ Call function with A=action, Y=filetype
400 TXA:LDX blk+0:LDY blk+1:RTS :\ Copy returned filetype in X to A and return
410 :
420 .fileTable
430 EQUW fileFC
440 EQUW fileFD:EQUW fileFE
450 EQUW load :EQUW save
460 EQUW file01:EQUW file02
470 EQUW file03:EQUW file04
480 EQUW file05:EQUW delete
490 EQUW create:EQUW cdir
500 :
510 \ On entry to OSFILE routines,
520 \ A=function code
530 \ Y=file type 0/1/2
540 \ sect=sector start
550 \ On exit,
560 \ X=returned file type
570 :
580 :
590 .RdInf0
600 PLA:LDA #0
610 .fileFE
620 TAX:RTS
630 :
640 \ =================================
650 \ Read and write object information
660 \ =================================
670 .file05
680 ORA #&80 :\ Set b7=read info
690 .fileFC:.fileFD:.file01:.file02:.file03:.file04
700 PHA:TYA :\ Save A=action, Y=filetype
710 JSR CheckDirInfo:BEQ RdInf0 :\ Object not found
720 BPL P%+5:JMP RdInf1 :\ b7=1, read info on '$'
730 :
740 PLA:BPL P%+5:JMP RdInf2 :\ Read file info
750 JSR CanISave:JSR AddB4 :\ Align blk and fptr pointers
760 :
770 CMP #3:BCS SetExec :\ Skip setting load address
780 PHA:LDY #5 :\ Point to load high byte
790 BIT HDR+&0C:BMI SetLoadLp :\ Large dir, set all four bytes
800 LDA (blk),Y:AND #&3F:STA (blk),Y :\ Lose top two bits
810 LDA (fptr),Y:AND #&C0:ORA (blk),Y:\ Merge with existing year bits
820 STA (fptr),Y:DEY :\ Store as load high byte
830 .SetLoadLp
840 LDA (blk),Y:STA (fptr),Y :\ Copy to load address
850 DEY:CPY #1:BNE SetLoadLp:PLA
860 :
870 .SetExec
880 LDY #9:PHA:AND #1:BEQ SetAttr :\ Skip setting exec address
890 .SetExecLp
900 LDA (blk),Y:STA (fptr),Y :\ Copy to exec address
910 DEY:CPY #5:BNE SetExecLp
920 :
930 .SetAttr
940 JSR SubB4 :\ Restore blk pointer
950 PLA:PHA:CMP #1:BEQ SetAttrs :\ Jump to set attributes
960 CMP #4:BNE SetDone :\ Skip setting attributes
970 :
980 .SetAttrs
990 LDY #&0E:LDA (blk),Y:JSR AccessByte:\ Set access from control block
1000 LDY #&0F:JSR SetObjDate :\ Set modification date from control block
1010 :
1020 .SetDone
1030 JSR SaveThisDir
1040 :
1050 .RdInf1
1060 PLA:ORA #&01 :\ Ensure fileFC('$') becomes fileFD('$')
1070 .RdInf2
1080 CMP #&FC:BNE RdInf2a :\ Not write extended info
1090 JSR CanISave:LDY #6 :\ CanISave changes A,Y
1100 LDA HDR+&0C:BPL WrInf2 :\ SmallDir, no mtime,cdate, jump to set accounts
1110 \\LDY HDR+&0C:\\BPL ConvertBlk :\ SmallDir, no mtime,cdate, jump to set accounts
1120 \\JSR CanISave:\\LDY #6:\ CanISave changes A,Y
1130 .WrInfLp
1140 LDA (blk),Y:STA Ctrl-2,Y :\ Copy mtime to workspace
1150 INY:CPY #9:BNE WrInfLp
1160 JSR SetObjDate:JSR SetModTime :\ Set cdate and mtime
1170 JSR SaveThisDir
1180 .WrInf2
1190 LDX #1
1200 .WrInf3
1210 DEY:LDA (blk),Y:STA numstore,X :\ Copy from from control block to numstore
1220 DEX:BPL P%+4:LDX #3
1230 CPY #2:BNE WrInf3
1240 JSR RdInfType2 :\ Get object type
1250 JMP SetAccounts :\ Jump to set account numbers
1260 \\LDA #&FC:\SEC
1270 :
1280 .RdInf2a
1290 BCS ConvertBlk :\ A=&Fx, read/write extended info
1300 .ConvertBlk0
1310 AND #127 :\ b7=0, read standard info
1320 .ConvertBlk
1330 PHA:JSR AddB4:LDY #2 :\ Align blk and fptr pointers
1340 .RdInfLp1
1350 LDA (fptr),Y:STA (blk),Y:INY :\ Copy standard info to control block
1360 CPY #17:BNE RdInfLp1
1370 LDA drive:STA (blk),Y:DEY :\ Store drive number
1380 LDA HDR+&0C:AND #&80:ASL A:PHP :\ Move BigDir flag into Carry
1390 BCS RdInf3:STA (blk),Y :\ SmallDir sector is &00xxxx
1400 LDY #&0D:STA (blk),Y:DEY :\ SmallDir length is &000xxxxx
1410 LDA (blk),Y:AND #7:STA (blk),Y
1420 LDY #5:LDA (blk),Y
1430 JSR LoadHighByte:STA (blk),Y :\ Extend load high byte
1440 .RdInf3
1450 JSR SubB4 :\ Realign fptr
1460 :
1470 PLP:PLA:BMI P%+5:JMP RdInfStd :\ Cy=BigDir, b7=standard/extended
1480 :
1490 \ Read extended info
1500 \ ------------------
1510 PHP:LDY #10:LDA (blk),Y:PHA :\ Save length.low for later
1520 LDY #cd+1:JSR ReadInfoDate :\ Read BigDir cdate or SmallDir mdate
1530 LDY #9:JSR StoreAX :\ Store as creation date
1540 PLA:CMP #1:LDX #3
1550 .RdInfLp2
1560 INY:LDA (blk),Y:ADC #0:STA (blk),Y :\ Length=NumOfSectors with b31=1
1570 DEX:BNE RdInfLp2:ORA #&80:STA (blk),Y
1580 :
1590 PLP:PHP:BCC RdInfAcc :\ SmallDir, no mtime, read accounts
1600 LDY #mt:LDA (fptr),Y:PHA:STA tmp :\ minute+second
1610 INY:LDA (fptr),Y:LSR A:ROR tmp :\ hour+minute
1620 LSR A:ROR tmp:LSR A:ROR tmp :\ A=hour, tmp=minute
1630 LDY #6:STA (blk),Y:INY :\ Store hours
1640 LDA tmp:LSR A:LSR A:STA (blk),Y :\ Store minutes
1650 PLA:AND #31:ASL A:INY:STA (blk),Y:\ Store seconds
1660 :
1670 .RdInfAcc
1680 PLP:LDY #8:LDA (fptr),Y:PHP :\ Stack CS=BigDir, MI=directory
1690 BPL RdInfFile
1700 JSR GetSectAddr:JSR GetDir :\ If a directory, fetch it
1710 .RdInfFile
1720 LDY #&12:LDA #0 :\ Prepare EQ for first pass
1730 .RdInfAccLp
1740 PHP :\ Save EQ/NE=pass
1750 LDA HDR+&00,Y:LSR A:LSR A:LSR A :\ Account number b8-b11
1760 LSR A:TAX:INY:LDA HDR+&00,Y :\ Account number b0-b7
1770 LDY #2:PLP:BEQ P%+4:INY:INY :\ Y=2 or 4 for acc or aux
1780 JSR StoreAX :\ Store account number
1790 CPY #5:BEQ RdInfDir :\ Both numbers stored, jump to finish
1800 PLP:PHP:LDY #&16:BCC RdInfAccLp :\ SmallDir auxilary account, jump back with NE
1810 LDY #&0E:BNE RdInfAccLp :\ BigDir auxilary account, jump back with NE
1820 .RdInfDir
1830 LDX #2:PLP:BMI RdInfDone :\ Get Dir flag back, return X=2 if dir
1840 BPL RdInfType3 :\ File, jump to check run-only flag
1850 :
1860 \ Read standard info
1870 \ ------------------
1880 .RdInfStd
1890 PHP:LDY #7
1900 .ReadAccess
1910 LDA (fptr),Y:ROL A:ROL attrs :\ Read access from filename
1920 DEY:BPL ReadAccess
1930 LDA attrs:EOR #&33
1940 LDY #&0E:STA (blk),Y :\ Store in control block
1950 :
1960 LDY #md+1:PLP:JSR ReadInfoDate :\ Read modification date
1970 LDY #&0F:JSR StoreAX :\ Store year+day, year+month
1980 INY:LDA #0:STA (blk),Y :\ Store final zero
1990 ::\PHP
2000 :
2010 \.RdInfType
2020 ::\PLP
2030 .RdInfType2
2040 LDY #8:LDA (fptr),Y:ASL A :\ Get Directory bit
2050 LDX #2:BCS RdInfDone :\ Directory
2060 .RdInfType3
2070 DEX:JSR YDoIOwn :\ Point to my Read bit
2080 LDA (fptr),Y:BPL RdInfDone :\ X=1, readable file
2090 INY:LDA (fptr),Y:BPL RdInfDone :\ X=1, not run-only file
2100 LDX #&FF :\ X=&FF, run-only file
2110 .RdInfDone
2120 RTS :\ X=object type
2130 :
2140 .StoreAX
2150 STA (blk),Y:TXA:INY:STA (blk),Y:RTS
2160 .FetchAX
2170 LDA (fptr),Y:TAX:DEY:LDA (fptr),Y:RTS
2180 :
2190 \ -------------------------------
2200 \ Read object's modification date
2210 \ -------------------------------
2220 \ On entry, (fptr),Y->top byte of date
2230 \ CC = SmallDir
2240 \ CS = BigDir or FSM
2250 \ On exit, A=year+day
2260 \ X=year+month
2270 \ -----------------------------------
2280 .ReadInfoDate
2290 BCC ReadDateSmall
2300 .ReadDateBig
2310 JSR FetchAX:JMP Rotate5 :\ X=year+month, A=day+year, rotate to A=year+day
2320 :
2330 .ReadDateSmall
2340 LDY #&15:JSR FetchAX :\ X=year+month, A=day+length
2350 LSR A:LSR A:LSR A:STA attrs :\ Store day
2360 LDY #&09:LDA (fptr),Y:AND #&80 :\ Get b4 of year from filename
2370 LSR A:LSR A:ORA attrs:STA attrs :\ Add to day
2380 LDY #&0D:LDA (fptr),Y:AND #&C0 :\ b6-b5 of year from b7-b6 of load
2390 ORA attrs:RTS :\ A=year+day
2400 :
2410 .AddB4
2420 PHA:LDA #8:CLC:ADC fptr+0:STA fptr+0
2430 LDA #0:ADC fptr+1:STA fptr+1
2440 PLA:RTS
2450 .SubB4
2460 PHA:LDA fptr+0:SEC:SBC #8:STA fptr+0
2470 LDA fptr+1:SBC #0:STA fptr+1:PLA:RTS
2480 :
2490 \ ---------------------------------------------------------------------
2500 \ CheckDirInfo - Resolve unresolved directory or create fake root entry
2510 \ Called by OSFILE to read info, and by OPEN to allow OPENIN"$"
2520 \ ---------------------------------------------------------------------
2530 \ On entry, A= file type 0/1/2
2540 \ sect= sector
2550 \ fptr=>file info or
2560 \ &FFxx if unresolved dir.
2570 \ On exit, A=file type 0/1/2/&82, flags set
2580 \ If A=&82, root info created
2590 \ ------------------------------------------
2600 .CheckDirInfo
2610 JSR CheckForDir:BPL CheckDirEnd :\ Resolve unresolved directory
2620 JSR ReadFSM:BEQ CheckDirRoot :\ Drive exists, create entry
2630 LDA #0 :\ Drive not present/not HADFS
2640 .CheckDirEnd
2650 RTS
2660 :
2670 \ Create a fake 32-byte directory entry for "$" with disk infomation in metadata
2680 \ ------------------------------------------------------------------------------
2690 .CheckDirRoot
2700 JSR ClearDIR :\ Use the directory buffer
2710 JSR dirFirst:TYA:TAX:LDY #31 :\ A=0, X=0
2720 .CheckDirLp1
2730 CPY #9:BNE P%+4:LDA #32 :\ Fill filename with spaces
2740 STA (fptr),Y :\ Fill metadata with zeros
2750 DEY:BNE CheckDirLp1
2760 LDA #&47:LDY #&16:STA (fptr),Y :\ Sector='$'
2770 LDA #&03:LDY #&13:STA (fptr),Y :\ Length=&300
2780 LDA #&A0:LDY #&08:STA (fptr),Y :\ Directory
2790 LDY #&03:STA (fptr),Y :\ Locked
2800 LDA #ASC"$":LDY #0:STA (fptr),Y :\ Filename="$" - this is so *INFO $ works
2810 LDA #&80:STA HDR+&0C :\ BigDir
2820 :\ Step through FSM bytes &18+0 to &18+7
2830 .CheckDirLp2
2840 LDY CheckDirOff,X :\ Offset to info block for this FSM byte
2850 LDA FSM+&18,X:STA (fptr),Y :\ Copy byte to info block
2860 INX:CPX #8:BNE CheckDirLp2 :\ A now holds DiskFlags from &18+7
2870 ASL A:BCC CheckDirSmall
2880 LDY #&10:LDA (fptr),Y :\ Adjust LargeDisk disk size
2890 LDY #&0D:STA (fptr),Y
2900 .CheckDirSmall
2910 LDY #cd+0:LDA (fptr),Y
2920 PHA:INY:LDA (fptr),Y :\ Get creation date
2930 LDY #md+1:STA (fptr),Y
2940 PLA:DEY:STA (fptr),Y :\ Copy to modification date
2950 JSR GetSectAddr :\ Get sector from entry
2960 LDA #&82 :\ b7=1 for '$'
2970 .DeleteNone
2980 RTS
2990 .CheckDirOff
3000 EQUB &0E:EQUB &0F:EQUB cd:EQUB cd+1
3010 EQUB &0B:EQUB &0C:EQUB &10:EQUB &11
3020 :
3030 .CheckLocked
3040 JSR CanISave:LDY #3 :\ Check I own this directory
3050 LDA (fptr),Y:BMI errLocked :\ Can't delete if locked
3060 JMP CheckNotOpenFF :\ Can't delete if open
3070 .errLocked
3080 JSR errors:EQUB 195:EQUS "Entry locked":BRK
3090 :
3100 \ =============
3110 \ Delete object
3120 \ =============
3130 \ On entry, A=&FF
3140 \ Y=0/1/2
3150 \ sect=>start sector
3160 \ -------------------------
3170 .delete
3180 TYA:JSR CheckForDir:BMI errLocked:\ Can't delete '$'
3190 TAX:BEQ DeleteNone :\ A=0, nothing to delete
3200 JSR CheckNoWildcards :\ Can't delete with wildcards
3210 JSR CheckLocked
3220 JSR ConvertBlk0 :\ Read object information
3230 TXA:CMP #2:BNE DeleteFile :\ Jump to delete a file
3240 :
3250 \ ----------------------------
3260 \ Check if directory deletable
3270 \ ----------------------------
3280 PHA:JSR CheckCLU:LDX #&FD :\ Can't delete @, %, &
3290 .DeleteLp1
3300 LDA CURR-&FD,X:PHA:INX:BNE DeleteLp1:\ Save CURR
3310 JSR GetDir:LDA HDR+&0C :\ Fetch the directory itself
3320 AND #31:BNE errNotEmpty :\ Can't delete non-empty dir.
3330 JSR GetLINK:BEQ DirEmpty :\ Dir is linked, can't be empty
3340 .errNotEmpty
3350 JSR errors:EQUB 180:EQUS "Dir. not empty":BRK
3360 .DirEmpty
3370 LDX #2
3380 .DeleteLp2
3390 PLA:STA sect,X:DEX:BPL DeleteLp2:\ Get CURR back to sect
3400 JSR GetDir:PLA :\ And reload directory
3410 :
3420 \ ----------------
3430 \ Delete an object
3440 \ ----------------
3450 .DeleteFile
3460 JSR DeleteThisEntry:CLC :\ Delete this entry from FSM
3470 :
3480 \ --------------------------------
3490 \ Remove this entry from directory
3500 \ --------------------------------
3510 \ CLC = save FSM, SEC = don't save FSM
3520 \ ------------------------------------
3530 .RemoveEntry
3540 PHA:PHP:LDY #0:TYA:STA (fptr),Y :\ Clear directory entry
3550 DEC HDR+&0C:LDA HDR+&0C :\ Decrement number of entries
3560 AND #31:BNE DeleteNoLink :\ If still entries in this dir, jump past
3570 :
3580 \ ---------------------------------------------
3590 \ See if we can remove an empty directory chunk
3600 \ ---------------------------------------------
3610 JSR GetFIRST:BEQ DeleteNoLink :\ No extra chunks
3620 :
3630 LDX #2:LDY #&18 :\ Offset to BigDir LINK
3640 BIT HDR+&0C:BMI DeleteLp3 :\ Jump to push LINK if BigDir
3650 LDY #&0E :\ Offset to SmallDir LINK
3660 .DeleteLp3
3670 LDA HDR+&00,Y:PHA :\ Push LINK
3680 LDA CURR,X:STA start,X :\ Copy CURR to start
3690 INY:DEX:BPL DeleteLp3 :\ SmallDir will have a dummy byte pushed
3700 :
3710 .DeleteLp4
3720 JSR GetDir:JSR GetLINK :\ Get next chunk and it's LINK
3730 LDA sect+2:CMP start+2:BNE DeleteLp4
3740 LDA sect+1:CMP start+1:BNE DeleteLp4
3750 LDA sect+0:CMP start+0:BNE DeleteLp4 :\ Follow LINKs
3760 :
3770 \ This chunk points to the one to be deleted
3780 \ ------------------------------------------
3790 LDX #3:LDY #&1A :\ Point to top of BigDir LINK
3800 BIT HDR+&0C:BMI DeleteLp5 :\ Jump to pop LINK if BigDir
3810 PLA:DEX:LDY #&0F :\ Pop a SmallDir 2-byte LINK
3820 .DeleteLp5
3830 PLA:STA HDR+&00,Y :\ Pop LINK to previous chunk's LINK
3840 DEY:DEX:BNE DeleteLp5
3850 :
3860 JSR C8to300:PLP:BCC DeleteFSM :\ CLC=FSM already in memory
3870 JSR CheckHadfsDiskX :\ Trashes addr,sect
3880 .DeleteFSM
3890 JSR AddToFSM:CLC:PHP :\ Return this chunk to FSM
3900 :
3910 \ Any empty directory chunks have been removed
3920 \ --------------------------------------------
3930 .DeleteNoLink
3940 PLP:BCS DeleteNoFSM:JSR SaveFSM :\ Save FSM if called from Delete
3950 .DeleteNoFSM
3960 JSR SaveThisDir:PLA:TAX:RTS :\ Save this directory and exit, A=X=filetype
3970 :
3980 :
3990 \ ---------------------------------------
4000 \ Check if current directory is @, % or &
4010 \ ---------------------------------------
4020 .CheckCLU
4030 LDX #0:LDY #0
4040 .ChkCLULp
4050 LDA CSD+0,X:CMP sect+0:BNE ChkCLUOk
4060 LDA CSD+1,X:CMP sect+1:BNE ChkCLUOk
4070 LDA CSD+2,X:CMP sect+2:BNE ChkCLUOk
4080 LDA CSD+d,X:CMP drive:BEQ ChkCLUErr
4090 .ChkCLUOk
4100 INX:INX:INX:INX:INY:CPX #12:BNE ChkCLULp
4110 RTS
4120 .ChkCLUErr
4130 LDA CSDinfo,Y:STA &101:LDY #4
4140 .ChkCLULp2
4150 LDA CSDtxt,X:STA &10D,Y
4160 INX:DEY:BNE ChkCLULp2:LDY #12
4170 .ChkCLULp3
4180 LDA CantDelete-1,Y:STA &101,Y
4190 DEY:BNE ChkCLULp3
4200 STY &112:STY &100:JMP &100
4210 .CSDinfo
4220 EQUB 150:EQUB 151:EQUB 162
4230 .CSDtxt
4240 EQUS "DSC BIL DRU "
4250 .CantDelete
4260 EQUS "Can't delete"
4270 :
4280 :
4290 \ -----------------------------------------
4300 \ Delete this entry from the Free Space Map
4310 \ -----------------------------------------
4320 \ On exit, FSM loaded and updated, fptr points to entry
4330 \
4340 .DeleteThisEntry
4350 PHA
4360 .z%:LDY #3:]:IF1:z%=P%-z%:P%=P%-z%:O%=O%-z% :
4370 .z%:LDY #2:]:IF0:z%=P%-z%:P%=P%-z%:O%=O%-z% :
4380 .DeleteThisLp1
4390 LDA len,Y:PHA:DEY:BPL DeleteThisLp1 :\ Save length
4400 SEC:JSR GetLength :\ Get object length
4410 JSR GetSectAddr:JSR SectToStart :\ Get object start sector
4420 JSR CheckHadfsDiskX :\ Trashes addr,sect
4430 JSR AddToFSM:LDY #0 :\ Return this start/len to FSM
4440 .DeleteThisLp2
4450 PLA:STA len,Y:INY :\ Restore length
4460 .z%:CPY #4:]:IF1:z%=P%-z%:P%=P%-z%:O%=O%-z% :
4470 .z%:CPY #3:]:IF0:z%=P%-z%:P%=P%-z%:O%=O%-z% :
4480 BNE DeleteThisLp2
4490 .CanISaveOk
4500 PLA
4510 .GetLenOk3
4520 RTS
4530 :
4540 :
4550 \ -----------------------------------------
4560 \ Get object length to len in whole sectors
4570 \ -----------------------------------------
4580 \ CLC=Absolute length, SEC=Rounded length
4590 \
4600 .GetLength
4610 PHP:LDY #&12
4620 .GetLenLp
4630 LDA (fptr),Y:STA len-&12,Y:INY :\ Copy length to len
4640 .z%:CPY #&16:]:IF1:z%=P%-z%:P%=P%-z%:O%=O%-z% :
4650 .z%:CPY #&15:]:IF0:z%=P%-z%:P%=P%-z%:O%=O%-z% :
4660 BNE GetLenLp
4670 PLP:BIT HDR+&0C:PHP:BMI GetLenOk1 :\ Continue with BigDir
4680 LDA len+2:AND #7:STA len+2 :\ SmallDir, reduce length
4690 .z%:LDA #0:STA len+3:]:IF1:z%=P%-z%:P%=P%-z%:O%=O%-z% :
4700 .GetLenOk1
4710 BCC P%+5:JSR GetLenRound :\ Don't round to whole sectors
4720 PLP:BPL GetLenOk3 :\ SmallDir, exit
4730 LDA (fptr),Y:BEQ GetLenOk3 :\ Length<16M, exit
4740 JMP errTooLong :\ Can't directly deal with >16M files
4750 :
4760 .GetLenRound
4770 LDA len+0:BEQ GetLenOk2 :\ Round up to whole number of sectors
4780 INC len+1:BNE GetLenOk2 :\ Note, don't need to worry about
4790 INC len+2 :\ overflow from top byte, as impossible
4800 :\ to have a &1000000-length file, as
4810 :\ '$' is at &47-&4A
4820 .z%:BNE GetLenOk2:INC len+3:]:IF1:z%=P%-z%:P%=P%-z%:O%=O%-z% :
4830 .GetLenOk2
4840 RTS
4850 :
4860 .CanISave
4870 PHA:JSR DoIOwn:BEQ CanISaveOk :\ If don't own dir, drop into error
4880 :
4890 .errNoAccess
4900 JSR errors:EQUB 189:EQUS "Insufficient access":BRK
4910 .errNotFile
4920 JSR file_errors:EQUB 181:EQUS "is not a file":BRK
4930 .errRunOnly
4940 JSR errors:EQUB 189:EQUS "File execute only":BRK
4950 :
4960 :
4970 \ ======================
4980 \ Load and Save routines
4990 \ ======================
5000 :
5010 \ -----------
5020 \ Load a file
5030 \ -----------
5040 \ On entry, A=&FF
5050 \ Y=0/1/2
5060 \ sect=>start sector
5070 \ -------------------------
5080 .load
5090 CPY #1:BEQ LoadFile:BCS errNotFile
5100 JMP errNotFound
5110 .LoadFile
5120 LDA #&80:JSR CheckNotOpen :\ Ensure not open for writing
5130 JSR YDoIOwn :\ Point to my 'R' bit
5140 LDA (fptr),Y:BPL LoadFile1 :\ 'R' bit present, can load
5150 INY:INY:LDA (fptr),Y :\ Point to my 'E' bit
5160 BMI errRunOnly:BPL errNoAccess :\ No 'R' bit, either RunOnly or NoRead
5170 :
5180 .LoadFile1
5190 LDY #2
5200 .LoadFileLp1
5210 LDA (blk),Y:STA addr-2,Y :\ Copy load address from control block
5220 INY:CPY #6:BNE LoadFileLp1
5230 LDA (blk),Y:BEQ LoadStart :\ load "file",addr
5240 \
5250 \ load "file" - use file's own address
5260 \ Enter here from *RUN
5270 \ ------------------------------------
5280 .UseFileAddr
5290 LDY #10
5300 .LoadFileLp2
5310 LDA (fptr),Y:STA addr-10,Y :\ Copy file's load address
5320 INY:CPY #14:BNE LoadFileLp2
5330 JSR LoadHighByte:STA addr+3 :\ Expand SmallDir load address
5340 .LoadStart
5350 CLC:JSR GetLength:JSR SectToStart :\ Get file length, start sector
5360 LDX blk+1:INX:BEQ P%+5:JSR ConvertBlk0 :\ Fill control block for load
5370 LDA #0:STA action:JSR DiskMain :\ Load data from disk, allowed to corrupt A,X,Y,P
5380 \
5390 \ DiskMain Calls CheckAddr, ScreenOn, ScreenOff, updates addr, sect
5400 \
5410 LDA len+0:BEQ LoadFinish :\ No final sector to load
5420 LDA shadow:LDX #4 :\ Get shadow flag to save
5430 .LoadFileLp3
5440 PHA:LDA addr-1,X:DEX:BPL LoadFileLp3 :\ Save shadow and current address
5450 JSR GetToFSM:LDX #&FC :\ Load final sector to FSM
5460 .LoadFileLp4
5470 PLA:STA addr+4,X:INX:BNE LoadFileLp4 :\ Restore address
5480 PLA:STA shadow :\ Restore shadow flag
5490 :
5500 \ Enter here for OSGBPB 5..12 and loading last sector
5510 \ ---------------------------------------------------
5520 .LoadGbPb
5530 .LoadCont
5540 BIT &27A:BMI LoadToTube :\ Tube present, is is Tube load?
5550 .LoadToHost
5560 JSR ScreenOn:LDY #0 :\ Select screen if needed, A,X,X,P may be corrupted
5570 .LoadHostLp
5580 LDA FSM,Y:STA (addr),Y :\ Copy data to memory
5590 INY:CPY len+0:BNE LoadHostLp
5600 JSR ScreenOff :\ Deselect screen if needed, A,X,X,P may be corrupted
5610 .LoadFinish
5620 LDX #1:RTS :\ Return object=&01 - file
5630 .LoadToTube
5640 LDY addr+3:INY:BEQ LoadToHost :\ Addr is &FFxxxxxx, load to I/O
5650 JSR TubeClaimLoad:LDY #0
5660 .LoadTubeLp
5670 LDA FSM,Y:STA &FEE5:INY :\ Copy data to Tube
5680 JSR TubeWait :\ 24us delay, total 30us/byte
5690 CPY len+0:BNE LoadTubeLp
5700 JSR TubeRelease:LDX #1:RTS :\ Return object=&01 - file
5710 :
5720 :
5730 .errExists
5740 JSR errors:EQUB 196:EQUS "File exists":BRK
5750 :
5760 \ -----------
5770 \ Save a file
5780 \ -----------
5790 \ On entry, A=&FF
5800 \ Y=0/1/2
5810 \ sect=>start sector if existing file
5820 \ ------------------------------------------
5830 .save
5840 JSR create :\ Create the entry
5850 LDA #&FF:STA action:JSR DiskMain:\ Save the data, also check addr, allowed to corrupt A,X,Y,P
5860 LDX #1:RTS :\ Return object=&01 - file
5870 :
5880 :
5890 \ -------------
5900 \ Create a file
5910 \ -------------
5920 \ On entry, A=&FF
5930 \ Y=0/1/2
5940 \ sect=>start sector if existing file
5950 \ ------------------------------------------
5960 .create
5970 TYA:TAX:LDY #10 :\ X=object type
5980 .MakeLp1
5990 LDA (blk),Y:STA addr-10,Y:PHA :\ Copy start address to addr and stack it
6000 INY:CPY #&E:BNE MakeLp1
6010 SEC:LDA (blk),Y:SBC addr+0:STA len+0:\ len=end-start
6020 INY:LDA (blk),Y:SBC addr+1:STA len+1
6030 INY:LDA (blk),Y:SBC addr+2:STA len+2
6040 INY:LDA (blk),Y:SBC addr+3
6050 BNE errTooLong :\ Length>=16M - too long
6060 BIT HDR+&0C:BMI CreateLenOk :\ BigDir, length>512M ok
6070 LDA len+2:CMP #8:BCC CreateLenOk:\ SmallDir, length<512 ok
6080 :
6090 \ --------------------------------------------------------------
6100 \ errTooLong
6110 \ trying to store 24-bit length in 19-bit SmallDir length field
6120 \ trying to store 24-bit sector in 16-bit SmallDir sector field
6130 \ --------------------------------------------------------------
6140 .errTooLong
6150 JSR errorDIR:EQUB 198:EQUS "Length too long":BRK
6160 :
6170 .CreateLenOk
6180 JSR CheckPath:JSR CheckNoWildcards:\ Check no missing leafs, no wildcards
6190 TXA:CMP #2:BEQ errExists :\ Error if saving on top of a directory
6200 TAY:BEQ CreateEntry2 :\ No existing file, create a new one, CC/PL/EQ=save new file
6210 JSR CheckLocked
6220 JSR DeleteThisEntry :\ Loads FSM & remove entry at sect/len
6230 CLC:LDA #1:BNE CreateGo :\ Jump to create file, CC/PL/NE=save over existing file
6240 \
6250 \ Create an entry
6260 \ ---------------
6270 \ Called by CDIR, SAVE & OPENOUT
6280 \ On entry, CC/PL/EQ=save new file
6290 \ CC/MI =openout new file
6300 \ CS =directory
6310 \ ------------------------------------
6320 .CreateEntry
6330 PHA:PHA:PHA:PHA :\ Push dummy addr to balance stack
6340 .CreateEntry2
6350 PHP:JSR CanISave :\ Check I can save in this directory
6360 JSR FindBlankEntry:LDY #17:LDA #0:\ Find space in directory, trashes addr
6370 .CreateLp2
6380 STA (fptr),Y:DEY:BPL CreateLp2 :\ Blank out name & addresses
6390 INC HDR+&0C :\ Increment number of entries
6400 JSR CheckHadfsDiskX:PLP :\ Load Free Space Map (trashes sect, addr)
6410 \
6420 \ Continue here when overwriting existing entry or new entry
6430 \ ----------------------------------------------------------
6440 \ On entry, (fptr) => entry
6450 \ (blk) => OSFILE control block
6460 \ len = length
6470 \ CC/PL/NE = save over existing file
6480 \ CC/PL/EQ = save new file
6490 \ CC/MI = openout file
6500 \ CS = directory
6510 \ ---------------------------------------------
6520 .CreateGo
6530 PHP:JSR PutInName:LDY #18 :\ Put new name into directory entry
6540 .CreateLenLp
6550 LDA len-18,Y:STA (fptr),Y :\ Copy length to entry
6560 INY:CPY #21:BNE CreateLenLp
6570 LDA #0:STA (fptr),Y :\ Clear top byte of length
6580 JSR GetLenRound :\ Round length to whole sectors
6590 JSR FindFreeSpace :\ Find space in FSM
6600 .z%
6610 LDY #24:BIT HDR+&0C:BMI CreateLp1 :\ BigDir can fit 24-bit sector
6620 DEY:LDA start+2:BEQ CreateLp1 :\ SmallDir can only fit 16-bit sector
6630 \JSR ClearDIR:JMP errTooLong :\ Invalidate DIR, can't fit 24-bit sector in SmallDir
6640 .CreateLp1
6650 LDA start-22,Y:STA (fptr),Y :\ Copy sector to directory entry
6660 DEY:CPY #21:BNE CreateLp1
6670 :]:IF VALbase$>=5.78:z%=P%-z%:P%=P%-z%:O%=O%-z%
6680 .z%
6690 JSR CreatePutSector
6700 :]:IF VALbase$<5.78:z%=P%-z%:P%=P%-z%:O%=O%-z%
6710 LDY #9
6720 LDA #&FF:PLP:PHP:BCC CreateFile :\ CC=set address for file
6730 DEY:JSR SetB7:LDY #3:JSR SetB7 :\ Set 'D' and 'L'
6740 BMI CreateDate
6750 .CreateFile
6760 BPL CreateNotOpen
6770 .CreateOpen
6780 INY:STA (fptr),Y :\ Set load & exec to &FFFFFFFF
6790 CPY #17:BNE CreateOpen:BEQ CreateDate
6800 .CreateNotOpen
6810 JSR AddB4 :\ Align fptr and blk
6820 .CreateLp2
6830 LDA (blk),Y:STA (fptr),Y :\ Copy addresses from control block to entry
6840 DEY:CPY #1:BNE CreateLp2:JSR SubB4:\ Restore fptr
6850 .CreateDate
6860 JSR SetCrDate:BCC CreatePutEntry:\ Set entry's modification date
6870 :
6880 JSR SetModTime :\ Set mtime
6890 PLP:PHP:BNE CreatePutEntry :\ Skip past if saving over existing file
6900 LDY #md-1:LDA #0:STA (fptr),Y :\ Set spare byte to zero
6910 INY:LDA (fptr),Y:PHA :\ New file, copy mdate to cdate
6920 INY:LDA (fptr),Y
6930 LDY #cd+1:STA (fptr),Y
6940 PLA:DEY:STA (fptr),Y
6950 :
6960 .CreatePutEntry
6970 PLP:JSR SaveFSM:JSR SaveThisDir :\ Balance stack, save FSM and directory
6980 LDX #3
6990 .CreateLp4
7000 PLA:STA addr,X:DEX :\ Restore addr
7010 BPL CreateLp4:LDX #1:RTS :\ Return object=&01 - file
7020 :
7030 .z%
7040 .CreatePutSector
7050 LDY #24:BIT HDR+&0C:BMI CrPutSecLp :\ BigDir can fit 24-bit sector
7060 DEY:LDA start+2:BEQ CrPutSecLp :\ SmallDir can only fit 16-bit sector
7070 JMP errTooLong :\ Invalidate DIR, can't fit 24-bit sector in SmallDir
7080 .CrPutSecLp
7090 LDA start-22,Y:STA (fptr),Y :\ Copy sector to directory entry
7100 DEY:CPY #21:BNE CrPutSecLp:RTS
7110 :]:IF VALbase$<5.78:z%=P%-z%:P%=P%-z%:O%=O%-z%
7120 :
7130 .C8to16K
7140 LDA #&40:STA len+1 :\ Set len=&0040xx
7150 LDA #0:BEQ C8to00
7160 .C8to300
7170 LDA #3:STA len+1 :\ Set len=&000300
7180 \.C8to000
7190 LDA #0:STA len+0 :\ Set len=&00xx00
7200 .C8to00
7210 STA len+2:RTS :\ Set len=&00xxxx
7220 :
7230 .ZeroNumber
7240 LDA HDR+&0C
7250 .ZeroNumA
7260 AND #&E0:STA HDR+&0C:RTS
7270 :
7280 :
7290 \ ------------------
7300 \ Create a directory
7310 \ ------------------
7320 .cdir
7330 CPY #2:BEQ CDirExit :\ Directory already exists, exit
7340 TYA:BEQ P%+5:JMP errExists :\ File exists - error, nothing exists - create a directory
7350 JSR C8to300:SEC:JSR CreateEntry :\ CS=dir, create &300-byte entry, start=>sector to save
7360 JSR GetFIRSTorCURR :\ If FIRST<>0, sect=FIRST else sect=CURR
7370 JSR dirInit:JSR PutInName :\ fptr=>DIR, put in directory name
7380 JSR ZeroNumber:ASL A :\ Clear number of entries, Cy=BigDir flag
7390 LDX #1:LDY #&0B:BCC CDirLp1 :\ SmallDir - X=2 byte sector, Y=>2-byte Parent
7400 INX:LDY #&1E :\ BigDir - X=3 byte sector, Y=>3-byte Parent
7410 .CDirLp1
7420 LDA sect,X:STA HDR+&00,Y :\ Parent=previous FIRST or CURR
7430 DEY:DEX:BPL CDirLp1
7440 LDA #0:STA HDR+&1F :\ Clear BigDir PARENT+3
7450 LDX #2:LDY #&0F:BCC CDirLp2 :\ SmallDir - X=2 bytes to clear, Y=>LINK+1
7460 LDX #8:LDY #&1B :\ BigDir - X=8 bytes to clear, Y=>LINK+3
7470 .CDirLp2
7480 STA HDR,Y :\ Clear a byte of header
7490 BCS P%+5:STA HDR+6,Y :\ SmallDir - also clear FIRST
7500 DEY:DEX:BPL CDirLp2
7510 STA HDR+&0D :\ Clear Cycle
7520 LDA HDR+&12:AND #&FC:STA HDR+&12:\ Set boot option to zero
7530 JSR StartToSect:JSR PutDir :\ Save this new directory
7540 JSR ClearDIR
7550 .CDirExit
7560 LDX #2:RTS :\ Clear buffer, return object=&02 - directory
7570 :
7580 .SetB7
7590 LDA (fptr),Y:ORA #128:STA (fptr),Y
7600 RTS
7610 :
7620 .PutInName
7630 LDY #9:.PutNameLp
7640 LDA (fptr),Y:ASL A:PHP
7650 LDA OBJECT,Y:ASL A:PLP
7660 ROR A:STA (fptr),Y
7670 DEY:BPL PutNameLp
7680 RTS
7690 :
7700 :
7710 \ ---------------------
7720 \ Set Modification date
7730 \ ---------------------
7740 \ On entry, fptr=>file entry or FSM
7750 \ If FSM, needs CLC = small directory or FSM
7760 \ SEC = big directory or FSM
7770 \ On exit, CLC = small directory or FSM
7780 \ SEC = big directory or FSM
7790 \ addr/tmp can be trashed
7800 \ ----------------------------------------------------
7810 .SetCrDate
7820 LDA HDR+&0C:ASL A :\ Get BigDir flag to Carry
7830 .SetCrDateFSM
7840 :
7850 \ Bug in MOS 5.xx - If MOS5 + NetFS + FSTime - forces NetFS,
7860 \ corrupts &C0-&CB, &C1xx, maybe some others
7870 PHP :\ Save Small/Big flag
7880 :
7890 .z%
7900 LDA #0:STA Ctrl+2:STA Ctrl+1 :\ Clear control block
7910 LDX #1:JSR OSBYTE:CPX #5 :\ CC=NotCompact
7920 LDX #Ctrl AND 255:LDY #Ctrl DIV 256
7930 LDA #1:BCC SetCrDateOsw :\ Not Compact, call MOS
7940 STX &F0:STY &F1:JSR Osw14RTC :\ Compact, avoid NetFS bug
7950 BEQ SetCrDate2:BEQ SetCrDateNone
7960 .SetCrDateOsw
7970 STA Ctrl:LDA #14:JSR OSWORD :\ Read BCD Time&Date
7980 :]:IF1:z%=P%-z%:P%=P%-z%:O%=O%-z%:
7990 :
8000 .z%
8010 LDX #0:STX Ctrl+2:STX Ctrl+1 :\ Clear control block
8020 INX:STX Ctrl
8030 LDX &DD7:LDA &2A1,X:PHA
8040 LDY &225:INY:BNE SetCrDate01 :\ NETV not extended
8050 LDA &FFB3:ORA &224:BMI SetCrDate01 :\ Not Elk or not extended
8060 TYA:STA &2A1,X :\ Disable ANFS
8070 .SetCrDate01
8080 LDX #Ctrl AND 255:LDY #Ctrl DIV 256
8090 LDA #14:JSR OSWORD :\ Read BCD Time&Date
8100 PLA:LDX &DD7:STA &2A1,X :\ Restore ANFS
8110 :]:IF0:z%=P%-z%:P%=P%-z%:O%=O%-z%:
8120 :
8130 .SetCrDate2
8140 LDA Ctrl:SEC:SBC #&A0:BCC P%+5:STA Ctrl:\ Wrap &A0+ to &00+
8150 LDY #6
8160 .SetCrDate2Lp
8170 LDA Ctrl,Y:JSR BCDtoBIN:STA Ctrl,Y :\ Convert to binary
8180 DEY:BPL SetCrDate2Lp
8190 LDA Ctrl+2:ORA Ctrl+1:BNE SetCrDate4:\ Check for no RTC
8200 .SetCrDateNone
8210 LDA #237:STA Ctrl+0 :\ No date, set to 00/00/1981
8220 :
8230 .SetCrDate4
8240 LDA Ctrl+2:PHA:AND #31:STA Ctrl+2 :\ Ensure 5-bit day
8250 PLA:AND #&E0:LSR A:ADC Ctrl+0 :\ Add YearHi to get correct year
8260 ADC #19 :\ Always year 20xx now
8270 ASL A:PHA:AND #&E0:ORA Ctrl+2:TAX :\ X=year+day
8280 PLA:ASL A:ASL A:ASL A:ORA Ctrl+1 :\ A=year+month
8290 PLP :\ Get BigDir flag back to Carry
8300 LDY #&0F:BNE SetModDate :\ Jump to set modification date
8310 :
8320 \ Set mdate or cdate from control block
8330 \ ----------------------------------------
8340 \ On entry, Y=control block offset to date
8350 \
8360 .SetObjDate
8370 LDA HDR+&0C:ASL A :\ Get BigDir flag to Carry
8380 LDA (blk),Y:TAX :\ X=year+day
8390 INY:LDA (blk),Y :\ A=year+month
8400 :
8410 \ ------------------------------------------------
8420 \ SetModDate - Set object or FSM modification date
8430 \ ------------------------------------------------
8440 \ On entry, CLC = small directory
8450 \ SEC = big directory or FSM
8460 \ fptr=>file entry or adjusted for FSM entry
8470 \ A = year+month, to be stored
8480 \ X = year+day, to be rotated or split across bytes
8490 \ -------------------------------------------------------------
8500 .SetModDate
8510 BCC SetModDateSmall :\ Set date in small directory
8520 CPY #&0F:LDY #cd+1:BCC P%+4
8530 LDY #md+1:STA (fptr),Y:TXA :\ Store year+month
8540 JSR Rotate3:DEY:STA (fptr),Y:SEC:RTS:\ Rotate year+day to day+year and store
8550 .SetModDateSmall
8560 LDY #&15:STA (fptr),Y :\ Store year+month
8570 :\ This can be optimised
8580 LDY #&0D:LDA #&3F:AND (fptr),Y:STA (fptr),Y:\ Drop top year bits from load address
8590 TXA:AND #&C0:ORA (fptr),Y:STA (fptr),Y :\ Put new top year bits in load address
8600 TXA:ASL A:ASL A:ASL A:PHA:PHP :\ Move year bit 5 into Carry
8610 LDY #&09:LDA (fptr),Y:ASL A:PLP:ROR A :\ Move year bit 5 into name bit 7
8620 STA (fptr),Y
8630 LDY #&14:LDA #7:AND (fptr),Y:STA (fptr),Y :\ Drop top 5 bits from length
8640 PLA:ORA (fptr),Y:STA (fptr),Y:CLC:RTS :\ Put day into length top bits
8650 :
8660 \.SetCrDate0
8670 \LDA #0:\STA Ctrl+2:\STA Ctrl+1:\RTS
8680 :
8690 .Rotate5:CMP #&80:ROL A
8700 .Rotate4:CMP #&80:ROL A
8710 .Rotate3:CMP #&80:ROL A
8720 .Rotate2:CMP #&80:ROL A:CMP #&80:ROL A
8730 RTS
8740 :
8750 \ -----------------------------------------
8760 \ SetModTime - Set object modification time
8770 \ -----------------------------------------
8780 \ On entry, fptr =>file entry
8790 \ Ctrl+4 = hours
8800 \ Ctrl+5 = minutes
8810 \ Ctrl+6 = seconds
8820 \ -----------------------------------------
8830 .SetModTime
8840 LDA Ctrl+5:ASL A:ASL A:STA tmp
8850 LDA Ctrl+4:ASL tmp:ROL A
8860 ASL tmp:ROL A:ASL tmp:ROL A
8870 LDY #mt+1:STA (fptr),Y
8880 LDA Ctrl+6:LSR A:ORA tmp
8890 DEY:STA (fptr),Y:RTS
8900 :
8910 :
8920 \ -------------------------------------------
8930 \ Look for a blank entry in current directory
8940 \ -------------------------------------------
8950 \ On exit, NE = directory full
8960 \ EQ = entry found
8970 \ fptr=>directory entry
8980 \ ------------------------------
8990 .FindBlankLook
9000 JSR dirInit :\ Y=0, A=files
9010 CMP #31:BEQ FindBlankFull :\ SmallDir full
9020 BIT HDR+&0C:BPL FindBlankLp
9030 CMP #23:BCS FindBlankFull :\ BigDir full
9040 .FindBlankLp
9050 JSR dirNext:BEQ FindBlankOk :\ This entry empty, exit with fptr=>entry, A=0, EQ
9060 LDA files:BEQ FindBlankOk :\ End of directory, exit with fptr=>entry, A=0, EQ
9070 DEC files:BPL FindBlankLp :\ Loop through all entries
9080 .FindBlankFull
9090 LDA #&FF
9100 .FindBlankOk
9110 RTS
9120 :
9130 \ ------------------------------
9140 \ Create a blank directory entry
9150 \ Extend directory if neccessary
9160 \ ------------------------------
9170 \ On exit, fptr=>directory entry
9180 \ A,X,Y,P corrupted
9190 \ ------------------------------
9200 .FindBlankEntry
9210 JSR FindBlankLook:BEQ FindBlankOk :\ Found in current chunk
9220 JSR GetFIRST:BEQ FindExtend :\ No multiple chunks, extend directory
9230 .FindBlankLp2
9240 JSR GetDir :\ Get current chunk
9250 JSR FindBlankLook:BEQ FindBlankOk :\ Look in current chunk
9260 JSR GetLINK:BNE FindBlankLp2 :\ No empty entries, check next chunk
9270 :
9280 \ Try to extend directory
9290 \ -----------------------
9300 .FindExtend
9310 LDX #2
9320 .FindExt1
9330 LDA len,X:PHA:DEX:BPL FindExt1 :\ Save len
9340 JSR CheckHadfsDiskX:JSR C8to300 :\ Load FSM, set len=&300
9350 JSR FindFreeSpace :\ start=space for directory chunk
9360 LDA sect+2:BEQ FindExt2 :\ sect<16M, continue
9370 LDA HDR+&0C:BMI FindExt2 :\ BigDir, continue
9380 JMP errTooLong :\ sect>16M won't fit in SmallDir
9390 .FindExt2
9400 JSR SaveFSM:JSR GetFIRST:PHA :\ Save FSM, stack 0 if FIRST=0
9410 JSR GetFIRSTorCURR :\ sect=FIRST or CURR
9420 LDA HDR+&0C:ASL A:PHP :\ Get BigDir flag to Carry
9430 LDX #2:BCC FindExt4 :\ BigDir X=2, SmallDir X=1
9440 .FindExt3
9450 LDA sect,X:STA HDR+&14,X :\ FIRST=FIRST for all chunks
9460 .FindExt4:DEX:BPL FindExt3
9470 LDA HDR+&0C:PHA:JSR ZeroNumber :\ Zero number in new chunk
9480 JSR StartToSect:JSR PutDir :\ Save this new chunk
9490 PLA:STA HDR+&0C :\ Restore number of entries in CURR
9500 PLP:PLA:PHP:BNE FindExt9 :\ Skip if previous FIRST<>0
9510 LDX #3:BCC FindExt8 :\ BigDir X=3, SmallDir X=1
9520 .FindExt7
9530 STA HDR+&14,X
9540 .FindExt8:DEX:BPL FindExt7 :\ Clear FIRST in first chunk
9550 .FindExt9
9560 JSR StartToSect:LDX #2:LDY #&1A :\ Get sect of new chunk from start, Y=BigDir LINK+2
9570 PLP:BCS FindExt10
9580 DEX:LDY #&0F:LDA #0:PHA :\ X=size of sect, Y=>SmallDir LINK+1
9590 .FindExt10
9600 LDA sect,X:STA HDR+&00,Y:PHA :\ Set LINK and save it
9610 DEY:DEX:BPL FindExt10
9620 JSR SaveThisDir:LDX #0 :\ Save CURR
9630 .FindExt11
9640 PLA:STA sect,X :\ Restore sect of new chunk
9650 INX:CPX #3:BNE FindExt11
9660 JSR GetDir:LDX #0 :\ Get new chunk
9670 .FindExt12
9680 PLA:STA len,X
9690 INX:CPX #3:BNE FindExt12 :\ Restore length
9700 .dirFirst
9710 JSR dirInit:JMP dirNext :\ fptr=>first entry
9720 :
9730 \ --------------------------
9740 \ Check OBJECT for wildcards
9750 \ --------------------------
9760 \ On exit, X preserved
9770 \ --------------------
9780 .CheckNoWildcards
9790 LDY #9:.ChckWldLp
9800 LDA OBJECT,Y:CMP #ASC"*":BEQ errWild
9810 CMP #ASC"#":BEQ errWild
9820 DEY:BPL ChckWldLp:RTS
9830 .errWild
9840 JSR errors:EQUB &FD:EQUS "Wildcards":BRK
9850 :
9860 ]
9870 PRINT CHR$11;STRING$(20,CHR$9);O%-mcode%;" bytes"
9880 >"S.HADFS5"