10
20
30
40
50
60
70
80
90 :
100 PRINT "Assembling S.HADFS7"
110 O%=P%-Block%+mcode%
120 [OPT0
130 :
140 \ ===========================
150 \ *Access - set object access
160 \ ===========================
170 .Access
180 JSR F2toXY:JSR SearchPathXY
190 JSR CheckForDir:BMI AccessRt
200 TYA:PHA:JSR CanISave :\ Check I own
210 JSR CheckHadfsDiskX
220 JSR CheckNotOpenFF
230 PLA:TAY:JSR SkipSpc
240 LDA #0:STA attrc:STA attrs
250 .AccessLp
260 LDA (&F2),Y:INY
270 CMP #ASC"!":BCC AccessEnd
280 CMP #ASC"/":BNE AccessChar
290 LDA #4:STA attrc:BNE AccessLp
300 .AccessChar
310 AND #&DF:LDX #7
320 .AccessLook
330 CMP PrAccChars,X:BEQ AccessIn
340 DEX:BPL AccessLook
350 JSR errors:EQUB 207:EQUS "Bad attribute":BRK
360 .AccessIn
370 TXA:ORA attrc:EOR #7:TAX
380 LDA BitTable,X:EOR attrs:STA attrs
390 BCS AccessLp
400 .AccessEnd
410 LDA attrs:JSR AccessByte :\ Store access byte
420 JMP SaveThisDir
430 :
440 .BitTable:EQUB 128:EQUB 64:EQUB 32:EQUB 16:EQUB 8:EQUB 4:EQUB 2:EQUB 1
450 :
460 .AccessByte
470 EOR #&33:STA attrs:LDY #7
480 .AccessByteLp
490 LDA (fptr),Y:ROL A:ROL attrs:ROR A :\ Copy bit into filename top bit
500 STA (fptr),Y:DEY:BPL AccessByteLp
510 .AccessRt
520 RTS
530 :
540 :
550 \ ===================
560 \ *Copy - copy a file
570 \ ===================
580 .Copy
590 .z%
600 JSR WhatMOS:BCC CopyMaster :\ Use *MOVE if on Master
610 :]:IF VALbase$>=5.79:z%=P%-z%:P%=P%-z%:O%=O%-z%
620 .z%
630 BIT WHATOS:BMI CopyMaster :\ Use *MOVE if on Master
640 :]:IF VALbase$<5.79:z%=P%-z%:P%=P%-z%:O%=O%-z%
650 PLA:PLA:LDA #4:RTS :\ Pop return address and return 'not done'
660 \\.CopyLp :\ Step back to point to start of 'COPY' string
670 \\DEY:\LDA (&F2),Y:\AND #&DF:\CMP #ASC"C":\BNE CopyLp
680 \\JSR F2toXY:\JMP slash :\ Try to do *COPY from disk
690 :
700 .CopyMaster
710 LDX #0:.CopyLp1
720 LDA CopyText,X:STA &DC00,X :\ Copy *MOVE command to string buffer
730 INX:CMP #ASC" ":BNE CopyLp1
740 .CopyLp2
750 LDA (&F2),Y:STA &DC00,X:INY:INX :\ Copy parameters to string buffer
760 CMP #13:BNE CopyLp2 :\ NB, reusing label
770 LDX #&05:EQUB &DA :\ &DA=PHX - we're running on a Master
780 LDY #&DC:EQUB &5A :\ &5A=PHY - we're running on a Master
790 TXA:JSR OSFileXY :\ Read info on source file
800 \ Should do 'Create' for dest, as *MOVE tries to OPENOUT 16K
810 LDX #0:LDY #&DC:JSR &FFF7 :\ Do *MOVE command
820 EQUB &7A:EQUB &FA :\ &7A=PLY, &FA=PLX
830 JSR XYtoF2 :\ Convert XY pointer into (&F2),Y
840 .CopyLp3
850 LDA (&F2),Y:INY:CMP #ASC" " :\ Find destination filename
860 BNE CopyLp3
870 LDA #4:JMP OSFile :\ Write attributes
880 :\ This is annoying as only one nybble needs doing
890 .CopyText
900 EQUS "MOVE "
910 :]:IF _OmitCopy%:z%=P%-Copy:P%=P%-z%:O%=O%-z%
920 :
930 :
940 \ ========================================
950 \ *Account - Set directory account numbers
960 \ ========================================
970 .Account
980 JSR SearchPathname
990 CMP #2:BNE AccountOk :\ Not a directory, exit
1000 LDA #&FF:PHA:PHA :\ Stack &FFFF for 'no main account'
1010 LDA (&F2),Y:CMP #ASC"(":BEQ AccAux :\ Only Aux Account given
1020 PLA:PLA :\ Drop 'no main account'
1030 JSR GetHexNum :\ Get main account number
1040 LDA numstore+1:PHA
1050 LDA numstore+0:PHA
1060 LDA #&FF:STA numstore+1 :\ Prepare 'no aux account'
1070 LDA (&F2),Y:CMP #ASC"(":BNE AccSet :\ No aux account, set accounts
1080 .AccAux
1090 INY:JSR GetHexNum :\ Get aux account number to numstore+0/1
1100 .AccSet
1110 PLA:STA numstore+2 :\ Get main account back to numstore+2/3
1120 PLA:STA numstore+3
1130 LDX #2
1140 :
1150 \ Set account numbers
1160 \ -------------------
1170 \ numstore+2/3 = main account, b15=1 if none
1180 \ numstore+0/1 = aux account, b15=1 if none
1190 \
1200 .SetAccounts
1210 CPX #2:BNE AccountOk :\ Not a directory, exit
1220 JSR GetSectAddr:JSR get_chk_dir :\ Fetch directory, checking on same disk
1230 \JSR GetDir
1240 JSR CanISave
1250 :
1260 .AccountLp
1270 LDX #2:LDY #&12 :\ X=>num.main, Y=>hdr.main
1280 .AccountLp2
1290 LDA numstore+1,X:BMI AccountNext :\ No account number, try next number
1300 ASL A:ASL A:ASL A:ASL A
1310 EOR HDR+0,Y:AND #&FC :\ Drop PRIV bits, keep BOOT bits
1320 EOR HDR+0,Y:STA HDR+0,Y :\ Store b8-b11
1330 LDA numstore+0,X:STA HDR+1,Y :\ Store b0-b7
1340 .AccountNext
1350 JSR AccountAux :\ Y=>hdr.aux
1360 DEX:DEX:BPL AccountLp2 :\ X=>num.aux, loop to set
1370 JSR SaveThisDir
1380 JSR NextChunk:BNE AccountLp
1390 .AccountOk
1400 RTS
1410 .AccountAux
1420 LDY #&16:LDA HDR+&0C:BPL P%+4:LDY #&0E :\ Y=>hdr.aux
1430 RTS
1440 :
1450 :
1460 \ ==========================
1470 \ *Rename - Rename an object
1480 \ ==========================
1490 \ Uses FSM buffer as workspace
1500 \ FSM+&00 - copy of directory header
1510 \ FSM+&20 - copy of entry information
1520 \ FSM+&40-1 - fptr of source
1530 \ FSM+&42-4 - CURR of source
1540 \ FSM+&45-7 - CURR of dest
1550 \ FSM+&48-9 - fptr of dest
1560 \ FSM+&4A-C - sect of object if a directory
1570 \
1580 .rename
1590 JSR SearchPathXY:JSR CheckForDir :\ Search for source
1600 BMI errBadRename :\ Can't Rename $
1610 PHA:TYA:PHA :\ Save type and pointer to dest name
1620 JSR CheckLocked :\ Check I can save, not locked, not open
1630 JSR ClearFSM:LDY #31 :\ Claim the FSM buffer
1640 .RenameLp1
1650 LDA (fptr),Y:STA FSM+&20,Y :\ Copy object info to FSM buffer
1660 DEY:BPL RenameLp1 :\ This will be saved later if destdir extended
1670 LDA HDR+&0C
1680 AND #&80:BNE P%+5:STA FSM+&20+&18 :\ If SmallDir, ensure sector=&00xxxx
1690 LDX #2
1700 .RenameLp2
1710 LDA fptr,X:STA FSM+&40,X :\ FSM+&40-1 = fptr of source name
1720 LDA CURR,X:STA FSM+&42,X :\ FSM+&42-4 = CURR of source name
1730 DEX:BPL RenameLp2
1740 JSR dirInit:LDY #31 :\ Point to directory header
1750 .RenameLp3
1760 LDA (fptr),Y:STA FSM+&00,Y :\ Copy header info to FSM buffer
1770 DEY:BPL RenameLp3
1780 PLA:TAY:LDA HDR+&0C:PHA :\ Get pointer to dest name, save DirSize flag
1790 LDA CURR+d:PHA :\ Save drive of source
1800 JSR SearchPathBad:JSR CheckPath :\ Search for dest
1810 \ Don't need to check for *Rename oldname $ as gets caught by check for dest=dir
1820 :
1830 TAX:JSR CheckNoWildcards :\ X=type of dest
1840 PLA:CMP CURR+d:BEQ RenDisksOk :\ Can't rename to a different drive
1850 .errRenAccDisks
1860 JSR errors:EQUB 176:EQUS "Rename across disks":BRK
1870 .errBadRename
1880 JSR errors:EQUB 176:EQUS "Bad rename":BRK
1890 .errRenExists
1900 JMP errExists
1910 :
1920 .RenDisksOk
1930 PLA:EOR HDR+&0C:AND #&80 :\ Check DirSize flags
1940 BNE errRenAccDisks :\ Can't rename between different DirSizes
1950 LDY #2 :\ X currently holds object type
1960 .RenameLp4
1970 LDA CURR,Y:STA FSM+&45,Y :\ FSM+&45-7 = CURR of dest name
1980 LDA fptr,Y:STA FSM+&48,Y :\ FSM+&48-9 = fptr of dest name
1990 DEY:BPL RenameLp4
2000 :
2010 JSR dirInit:JSR dirSize:TAY:DEY :\ fptr=>dir header, Y=>end of header
2020 .RenameLp5
2030 LDA (fptr),Y:CMP FSM+&00,Y :\ Compare header of source and dest
2040 BEQ P%+5:JMP RenameMove :\ Different, renaming to a different directory
2050 CPY #&1C:BNE P%+4:LDY #&18 :\ Skip BigDir LINK
2060 CPY #&10:BNE P%+4:LDY #&0E :\ Skip SmallDir LINK
2070 DEY:BPL RenameLp5 :\ If headers match, same directory, just renaming
2080 TXA:BEQ RenameSameDir :\ Dest name doesn't exist, just change the name
2090 :
2100 \ Dest exists in same directory, is it actually same entry?
2110 \ ---------------------------------------------------------
2120 LDX #2:BNE RenameLp5b
2130 .RenameLp5a
2140 LDA FSM+&40,X:CMP FSM+&48,X:BNE errRenExists:\ Not same entry, so trying to rename on top
2150 .RenameLp5b :\ of an existing object
2160 LDA FSM+&45,X:CMP CURR,X:BNE errRenExists
2170 DEX:BPL RenameLp5a
2180 :
2190 \ Pointing to same entry, just overwrite it
2200 \ -----------------------------------------
2210 .RenameSameDir
2220 JSR GetSectAndDir :\ fptr=>source entry, load source dir
2230 PLA :\ Get source object type
2240 .RenameObj
2250 PHA:JSR PutInName:JSR SaveThisDir :\ Put newname in and save directory
2260 PLA:CMP #2:BNE RenObjOk :\ Not a directory, so all finished
2270 :
2280 \ Renamed a directory, need to change its directory headers
2290 \ ---------------------------------------------------------
2300 JSR GetFIRSTorCURR:LDX #2 :\ Get current directory head in case
2310 .RenameLp6
2320 LDA sect,X:STA FSM+&4A,X :\ Get directory's FIRST as parent of object being moved
2330 LDA FSM+&20+&16,X:STA sect,X :\ Get object's start sector
2340 DEX:BPL RenameLp6
2350 JSR dirInit :\ Point fptr to directory header
2360 .RenameDir
2370 JSR GetDir:JSR PutInName :\ Get directory header and put name in
2380 LDA HDR+&0C:AND #&80:TAX:BEQ RenDirSm
2390 LDX #&12:LDA FSM+&4C:STA HDR+&0C,X :\ Set BigDir PARENT
2400 .RenDirSm
2410 LDA FSM+&4B:STA HDR+&0B,X :\ Set BigDir or SmallDir PARENT
2420 LDA FSM+&4A:STA HDR+&0A,X
2430 JSR SaveThisDir
2440 JSR GetLINK:BNE RenameDir :\ Do all directory chunks
2450 .RenObjOk
2460 RTS
2470 :
2480 \ Renaming to a different directory, so moving object to new location
2490 \ -------------------------------------------------------------------
2500 .RenameMove
2510 TXA:BEQ P%+5:JMP errRenExists :\ Dest name must not exist
2520 PLA:PHA:CMP #2:BNE RenameFile :\ Not a directory, move file
2530 LDX #2
2540 .RenameLp7
2550 LDA CURR,X:CMP FSM+&20+&16,X:BNE RenameCirc2
2560 DEX:BPL RenameLp7:BMI errCircular
2570 :
2580 .RenameCircle
2590 JSR GetDir
2600 .RenameCirc2
2610 JSR GetUp :\ sect=UP
2620 LDX #2
2630 .RenameLp8
2640 LDA sect,X:CMP FSM+&20+&16,X:BNE RenameUp :\ Not in same parent, check for '$'
2650 DEX:BPL RenameLp8
2660 .errCircular
2670 JSR errors:EQUB 176:EQUS "Circular rename":BRK
2680 .RenameUp
2690 LDA sect+2:ORA sect+1:BNE RenameCircle :\ Not '$', go up
2700 LDA sect+0:CMP #71:BNE RenameCircle :\ Not '$', go up
2710 :
2720 \ We've gone up to '$' without being in the same directory
2730 \ So, it's not a circular rename
2740 \ --------------------------------------------------------
2750 LDX #2
2760 .RenameLp9
2770 LDA FSM+&45,X:STA sect,X :\ Get dest directory back
2780 DEX:BPL RenameLp9:JSR GetDir :\ Fetch dest directory
2790 :
2800 \ We have dest dir in memory, ready for entry to be copied into it
2810 \ Need to move info as FindBlank and Remove may load FSM to &Fxx
2820 \ Need to move object info at &F20-&F3F and data at &F40-&F47
2830 \ --------------------------------------------------------------
2840 .RenameFile
2850 JSR CanISave
2860 LDA VFLG:AND #31:STA VFLG:LDX #31 :\ Using name store as workspace
2870 .RenFileLp1
2880 LDA FSM+&20,X:STA DSKNAME,X :\ Copy info to name store
2890 DEX:BPL RenFileLp1:LDX #7
2900 .RenFileSv
2910 LDA FSM+&40,X:PHA:DEX:BPL RenFileSv :\ Save data at F40-F47
2920 JSR FindBlankEntry:LDX #0 :\ Find/create a blank entry
2930 .RenFileLd
2940 PLA:STA FSM+&40,X:INX:CPX #8:BNE RenFileLd :\ Restore data at F40-F47
2950 JSR dirSize:TAY:DEY :\ Y=size of entry-1
2960 :
2970 \ NB, if srcdir and dstdir are different sizes, will create broken entry
2980 \ This has been tested for at RenDisksOk
2990 \ ----------------------------------------------------------------------
3000 .RenFileLp2
3010 LDA DSKNAME,Y:STA (fptr),Y :\ Copy old entry to new location
3020 STA FSM+&20,Y :\ Copy old entry back to &F00
3030 DEY:BPL RenFileLp2
3040 INC HDR+&0C:PLA:JSR RenameObj :\ Copy in new name and save directory
3050 JSR GetSectAndDir :\ Point to source object entry, get source dir back
3060 SEC:JMP RemoveEntry :\ Remove source object entry
3070 :
3080 .GetSectAndDir
3090 LDX #2:BNE GetSectLp2
3100 .GetSectLp1
3110 LDA FSM+&40,X:STA fptr,X :\ fptr=>source entry
3120 .GetSectLp2
3130 LDA FSM+&42,X:STA sect,X :\ sect=source directory
3140 DEX:BPL GetSectLp1
3150 JMP GetDir :\ Fetch source directory
3160 :
3170 ]
3180 PRINT CHR$11;STRING$(20,CHR$9);O%-mcode%;" bytes"
3190 >"S.HADFS8"