10 REM >HADFS4 v5.77
   20 REM OSFILE - File/directory load/save/delete/create/information
   30 REM ===========================================================
   40 REM This file is now too big to edit on a standard BBC or Master
   50 REM
   60 REM 07/06/1992, 4:30pm
   70 REM 20/11/1994: RunExec now in #2
   80 REM Solved find_blank problem
   90 REM 26/08/1996: Rewritten OSFILE
  100 REM 28/07/1998: Bugfix for =TIME$ on MOS 5.xx
  110 REM DiskMainLoop now with disk access code, path scanning now in here
  120 REM v5.52 Adding BigDir/BigDisk support
  130 REM v5.53 Continuing with BigDir/BigDisk support
  140 REM Note: Cannot delete a file larger than 16M as ReturnToFSM can only deal with <16M lengths
  150 REM       To delete a 16M+ file, need to OPENUP it and reduce EXT in sub-16M steps
  160 REM v5.61 Fixed delete (notfound), delete extended dirs, merge BigDisk FSM entries
  170 REM v5.62 Sets mtime on save, OSFILE &FC writes extended info
  180 REM v5.66 ReadInfo($) uses offset to DIR, CDIR uses offset directory
  190 REM v5.69 OSFILE &FC writes account info
  200 REM v5.72 Save/restore shadow when loading final bytes
  210 REM v5.75 Workaround for MOS5+NetFS RTC bug - drops out with an error
  220 REM v5.77 MOS5+NetFS RTC bug bypassed by reading SoftRTC if on MOS5
  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% :REM 32-bit file length
 4370 .z%:LDY #2:]:IF0:z%=P%-z%:P%=P%-z%:O%=O%-z% :REM 24-bit file length
 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% :REM 32-bit file length
 4470 .z%:CPY #3:]:IF0:z%=P%-z%:P%=P%-z%:O%=O%-z% :REM 24-bit file length
 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% :REM 32-bit file length
 4650 .z%:CPY #&15:]:IF0:z%=P%-z%:P%=P%-z%:O%=O%-z% :REM 24-bit file length
 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% :REM 32-bit file length top byte
 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% :REM 32-bit file length top byte
 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%:REM 34 bytes
 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%:REM 51 bytes
 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"