10
20
30
40
50
60
70
80
90
100
110
120
130
140 :
150 PRINT "Assembling S.HADFS2"
160 O%=P%-Block%+mcode%
170 [OPT0
180 :
190 .fsc
200 CMP #13:BCC P%+3:RTS
210 CMP #6:BEQ P%+5:JSR GrabAbs :\ Don't grab w/s if FS starting up
220 STA &B0:TXA:PHA
230 LDA &B0:ASL A:TAX
240 LDA fscTable,X:STA &B0
250 LDA fscTable+1,X:STA &B1
260 PLA:TAX:JMP (&B0)
270 :
280 .fscTable
290 EQUW opt:EQUW eof:EQUW slash
300 EQUW fscCmd:EQUW run:EQUW cat
310 EQUW NewFSStart:EQUW QueryHandles
320 EQUW StarComm:EQUW ex:EQUW info
330 EQUW lib_run:EQUW rename
340 :
350 .fscCmd
360 JSR XYtoF2:LDX #FileTable-CommTable
370 LDA (&F2),Y:CMP #ASC"\":BNE fscCmd2
380 JSR SkipSpc1
390 .fscCmd2
400 JSR Serv4Try:TAX:BNE P%+5:JMP RunFinish:\ All done
410 TYA:BNE Bad_Command :\ was *\name, so don't check disk
420 JSR F2toXY:JMP slash
430 .lib_run
440 .Bad_Command
450 JSR errors:EQUB 254:EQUS "Bad command":BRK
460 :
470 \.lib_run
480 \\ LibRun should do
490 \\ Same as */filename
500 \\ If nothing found, jump to Bad Command
510 \\
520 \\ */filename should do
530 \\ Try to run command
540 \\ If nothing, jump to FSC to do LibRun
550 \\
560 \TXA:\PHA:\TYA:\PHA:\JSR WhatFS:\PHA
570 \LDA #3:\JSR OSARGS:\STA tmp
580 \PLA:\CMP tmp:\BEQ Bad_Command
590 \PLA:\TAY:\PLA:\TAX :\ libfs<>currfs, try running from me
600 :
610 .slash
620 JSR CheckContextXY:\JSR CheckContext:\JSR XYtoF2
630 LDX #CSD-CSD:JSR TryRun2
640 CLC:BNE RunDone
650 BIT pathflg:BVS NotRun :\ Path used absolute specifier
660 \ Should also try &.Library
670 LDX #LIB-CSD:JSR TryRun
680 CLC:BNE RunDone
690 .NotRun
700 SEC
710 .RunDone
720 BCC RunFinish
730 LDY #0:JSR F2toXY:LDA #11:JMP (&21E) :\ Pass to LibFS to try
740 \ NB ANFS seems not to implement RunLib
750 :
760 .run
770 JSR CheckContextXY
780 LDX #CSD-CSD:JSR TryRun2:BNE RunFinish
790 JMP errNotFound
800 :
810 .TryRun
820 LDA CSD+0,X:CMP CSD+0:BNE TryRun2
830 LDA CSD+1,X:CMP CSD+1:BNE TryRun2
840 LDA CSD+2,X:CMP CSD+2:BNE TryRun2
850 LDA CSD+d,X:CMP CSD+d:BNE TryRun2
860 .RunFinish
870 RTS
880 :
890 .TryRun2
900 LDA &F2:PHA:LDA &F3:PHA
910 JSR DIRtoSect:JSR SetDrives
920 LDY #0:JSR SearchPathEntry
930 BPL P%+5:JMP errBadFilename
940 TAX:BEQ TryRunNone
950 CMP #1:BEQ P%+5:JMP errNotFile
960 TYA:CLC:ADC &F2:STA cptr+0
970 LDA #0:ADC &F3:STA cptr+1 :\ Command line pointer
980 JSR YDoIOwn:LDA (fptr),Y:BPL TryRunOk :\ 'R', can run file
990 INY:INY:LDA (fptr),Y:BMI TryRunOk :\ 'E', can run file
1000 JMP errNoAccess
1010 :
1020 .TryRunNone
1030 PLA:STA &F3:PLA:STA &F2
1040 LDA #0:RTS:\ No run
1050 .TryRunOk
1060 LDY #17:LDA (fptr),Y:DEY:AND (fptr),Y:DEY
1070 AND (fptr),Y:DEY:AND (fptr),Y :\ Check exec address
1080 CMP #&FF:BEQ TryRunExec :\ exec=&FFFFFFFF, *Exec file
1090 JSR GetLoadHigh:DEY:AND (fptr),Y :\ Is load=&FFFFxxxx?
1100 CMP #&FF:BNE TryRunLoad :\ load<>&FFFFxxxx, load file
1110 DEY:LDA (fptr),Y:CMP #&FE :\ Is load=&FFFFFExx or FFxx?
1120 BCC TryRunLoad :\ load<>&FFFFFExx/FFxx, load file
1130 :
1140 .TryRunExec
1150 LDA #0:LDY &256:BEQ P%+5:JSR OSFIND :\ Close Exec if open
1160 .TryRunExec2
1170 LDA #&40:STA buf+0:LDA #1
1180 JSR OpenInX:STA &256
1190 .TryRunExit
1200 PLA:STA &F3:PLA:STA &F2
1210 LDA #&FF:RTS:\ Run ok
1220 :
1230 .TryRunLoad
1240 LDA #&FF:STA blk+1 :\ Stop Load from returning ctrl block
1250 LDX #3:JSR GetLoadHigh:PHA :\ Get load address memory area
1260 LDY #17:CMP (fptr),Y:BNE CantRun :\ Exec in different memory, can't run
1270 LDY #16:CMP #&FF:BNE TryRunLoad2 :\ Not I/O memory, use this address
1280 CMP (fptr),Y:BNE CantRun :\ I/O not &FFFFxxxx, can't run
1290 .TryRunLoad2
1300 LDA (fptr),Y:PHA:DEY :\ Save exec address
1310 DEX:BNE TryRunLoad2 :\ Now pointing to load addr
1320 :
1330 LDX #3:JSR UseFileAddr:LDX #0 :\ Load file to it's load address
1340 .TryRunLoad3
1350 PLA:STA addr+0,X:INX :\ Recover exec address
1360 CPX #4:BNE TryRunLoad3
1370 BIT &27A:BPL TryRunIO :\ No Tube, run in I/O memory
1380 CMP #&FF:BEQ TryRunIO :\ Exec=FFxxxxxx, run in I/O memory
1390 LDA #4:JSR TubeClaimDo :\ Run in language memory
1400 JMP TryRunExit
1410 .TryRunIO
1420 LDA #1:JSR CallC4:JMP TryRunExit :\ Run in I/O memory
1430 .CallC4
1440 JMP (addr)
1450 :
1460 .CantRun
1470 JSR errors:EQUB &93:EQUS "Cannot run this code":BRK
1480 :
1490 .StarComm
1500 LSR ENABLE:RTS :\ Update Enable flag
1510 :
1520 .QueryHandles:LDX #25:LDY #29:RTS
1530 :
1540 \ On Master workspace is in high memory and owned by filing system owner.
1550 \ So, have to relinquish it when new filing system taken over.
1560 \ On BBC, workspace in low memory and owned by workspace owner.
1570 \ So, have to relinquish it when workspace taken over.
1580 .NewFSStart
1590 .z%
1600 JSR WhatMOS:BCS opt40 :\ Not Master, don't relinquish workspace
1610 :]:IF VALbase$>=5.79:z%=P%-z%:P%=P%-z%:O%=O%-z%
1620 .z%
1630 BIT WHATOS:BPL opt40 :\ Not Master, don't relinquish workspace
1640 :]:IF VALbase$<5.79:z%=P%-z%:P%=P%-z%:O%=O%-z%
1650 LDA ws:PHA:LDA ws+1:PHA
1660 LDA #&77:JSR OSBYTE:JSR ServA :\ Close Spool/Exec, save workspace
1670 PLA:STA ws+1:PLA:STA ws
1680 .opt40
1690 .opt80
1700 RTS
1710 :
1720 .opt
1730 CPX #40:BEQ opt40 :\ Set double-stepping
1740 CPX #80:BEQ opt80 :\ Set single-stepping
1750 CPX #8:BCS OptError
1760 TXA:PHA:ASL A:TAX
1770 LDA OptTable+0,X:STA ws+0
1780 LDA OptTable+1,X:STA ws+1
1790 PLA:JMP (ws) :\ Enter with A=opt.X, X=(opt.X)*2, Y=opt.Y
1800 :
1810 .OptTable
1820 EQUW opt0:EQUW opt1:EQUW opt2:EQUW opt3
1830 EQUW opt4:EQUW opt5:EQUW opt6:EQUW opt7
1840 :
1850 \ ----------------------------
1860 \ *OPT 0 - SET DEFAULT ACTIONS
1870 \ ----------------------------
1880 .opt0 :\ Reset 1,2,3,drive flags
1890 STA DRVINT:STA DRVEXT :\ Clear drive flags
1900 INY:BNE P%+5:JSR WriteCMOS :\ *opt 0,255 - also clear CMOS
1910 LDY #myfs+1:JSR Opt3b:DEY:JSR Opt3c :\ Set myfs and auxfs to HADFSnum
1920 DEY:LDA #0:BEQ Opt3c
1930 :
1940 \ -----------------------------------------------------------
1950 \ *OPT 1 - SET MESSAGE OPTIONS - Never actually read anywhere
1960 \ ----------------------------------------------------------
1970 .opt1
1980 :
1990 \ ----------------------------------------------------
2000 \ *OPT 2, *OPT 3 - SET PRIMARY AND SECONDARY FS NUMBER
2010 \ ----------------------------------------------------
2020 .opt2 :\ Set primary fs number
2030 .opt3 :\ Set secondary fs number
2040 TAX:TYA:PHA:TXA:TAY:PLA :\ Y=2/3 - myfs/auxfs offset
2050 .Opt3a
2060 CMP #4:BNE P%+4:.Opt3b:LDA #HADFSnum :\ Force to HADFSnum if =DFSnum
2070 JSR FindWS:.Opt3c:STA (ws),Y
2080 :
2090 \ --------------------------------------------------
2100 \ *OPT 5 - Set number of channels - now does nothing
2110 \ --------------------------------------------------
2120 .opt5
2130 .optIgnore
2140 RTS
2150 :
2160 .OptError
2170 JSR errors:EQUB 203:EQUS "Bad option":BRK
2180 :
2190 \ ------------------------
2200 \ *OPT 4 - SET BOOT OPTION
2210 \ ------------------------
2220 .opt4
2230 CPY #16:BCS OptError
2240 JSR CheckContext:JSR CheckHADFSDisk
2250 LDX #URD-CSD:JSR GetDirX :\ Fetch URD directory
2260 JSR ChkHadfsChng :\ Check to see if disk changed
2270 TYA:EOR HDR+&12:AND #15
2280 EOR HDR+&12:STA HDR+&12 :\ Set option
2290 ORA #4:STA OPTNUM:JMP SaveThisDir
2300 :
2310 \ ----------------------------------------------------------------
2320 \ *OPT 6, *OPT 7 - FORCE DRIVE TO USE INTERNAL OR EXTERNAL DRIVERS
2330 \ ----------------------------------------------------------------
2340 \ On entry, X=12 - use internal, X=14 - use external
2350 \ Y=drive
2360 \ --------------------------------------------------
2370 .opt6
2380 .opt7
2390 CPY #8:BCS optIgnore :\ Ignore out of range values
2400 LDA BitTable,Y:EOR #&FF:AND DRVEXT :\ Mask out bit for drive
2410 CPX #12:BNE P%+5:ORA BitTable,Y:STA DRVEXT
2420 LDA BitTable,Y:EOR #&FF:AND DRVINT :\ Mask out bit for drive
2430 CPX #14:BNE P%+5:ORA BitTable,Y:STA DRVINT
2440 .WriteCMOS
2450 TAY:LDA #162 :\ Write my CMOS byte
2460 .CallCMOS
2470 PHA:LDA &F4:CLC:ADC #30:TAX:PLA:JMP OSBYTE :\ Access CMOS byte ROM+30
2480 .ReadCMOS
2490 LDA #161:BNE CallCMOS :\ Jump to read my CMOS byte
2500 :
2510 :
2520 \ =======================================
2530 \ Directory and file information commands
2540 \ =======================================
2550 :
2560 \ =====================================================
2570 \ *EX and *CAT - list directory objects and information
2580 \ =====================================================
2590 .ex
2600 LDA #255:EQUB &2C :\ Next instruction hidden by BIT &A900
2610 .cat
2620 LDA #0:STA catex :\ catex=&00/&FF for CAT/EX
2630 :
2640 \ Display catalogue header
2650 \ ------------------------
2660 JSR XYtoF2:JSR SearchPathNF :\ Sect0/1/2/3=dir start
2670 CMP #1:BNE P%+5:JMP errNotDir
2680 JSR CheckNames2 :\ Check names without checking context
2690 .CatHead3
2700 JSR get_chk_dir:JSR dirInit :\ Point to start of directory, Y=0
2710 .CatHeadLp
2720 LDA (fptr),Y:JSR OSWRCH:INY :\ Print directory name
2730 CPY #10:BNE CatHeadLp
2740 JSR PrText:EQUS " (":BRK
2750 LDA HDR+&0D:JSR PrHex
2760 JSR PrText:EQUS ") ":BRK
2770 JSR GetOptNum:PHA :\ Need to call GetOptNum here to fetch user number
2780 JSR DoIOwn:BEQ CatHeadOwn
2790 JSR PrText:EQUS "Public":BRK
2800 BNE CatHead4
2810 .CatHeadOwn
2820 JSR PrText:EQUS "Owner ":BRK
2830 LDA HDR+&12:JSR HexTopDigit
2840 JSR OSWRCH:LDA HDR+&13:JSR PrHex
2850 .CatHead4
2860 JSR OSNEWL:LDX #0:LDY #16:JSR PrName
2870 JSR PrText:EQUS " Option ":BRK
2880 PLA:TAX:ORA #48
2890 JSR OSWRCH:JSR PrText:EQUS " (":BRK
2900 TXA:ASL A:ASL A:TAX:LDY #4
2910 .CatOptLp
2920 LDA OptText,X:JSR OSWRCH
2930 INX:DEY:BNE CatOptLp
2940 EOR #&09:CMP #ASC" ":BEQ P%+4:LDA #ASC")"
2950 JSR OSWRCH
2960 JSR PrText:EQUS " Dir. ":BRK
2970 LDX #&10:JSR PrName10
2980 JSR PrText:EQUS " Lib. ":BRK
2990 LDX #&1A:JSR PrName10:JSR Pr2Newl
3000 :
3010 LDX #0 :\ Start in column zero
3020 .CatStart
3030 BIT &FF:BMI CatEnd :\ Escape occured
3040 JSR dirInit:BEQ CatChunk :\ No entries in this chunk
3050 .CatLoop
3060 JSR dirNext:BEQ CatNext :\ This entry empty
3070 JSR DoIOwn:BPL CatOwn :\ Jump if own all files
3080 LDY #7:LDA (fptr),Y:BMI CatStep :\ Private file, step to next entry
3090 .CatOwn
3100 LDA catex:BEQ CatDisp :\ Jump to list entries
3110 JSR DisplayInfo:JMP CatStep :\ List full info
3120 .CatDisp
3130 JSR PrFilename:JSR PrAccess:INX :\ Print filename...access, inc column
3140 LDY #13:TXA:AND #3:BEQ P%+4 :\ Print spaces or <nl> to next column
3150 LDY #32:TYA:JSR OSASCI :\ Col=4x, print <nl>, else <spc>
3160 .CatStep
3170 DEC files
3180 .CatNext
3190 LDA files:BNE CatLoop :\ Still more to do
3200 .CatChunk
3210 TXA:PHA:JSR NextChunk :\ Save column counter and get next chunk
3220 ASL A:PLA:TAX:BCS CatStart :\ Loop to do another chunk
3230 .CatEnd
3240 LDA #134:JSR OSBYTE:TXA :\ Print NL if not in column 0
3250 BEQ CatDone:JMP OSNEWL
3260 :
3270 .OptText
3280 EQUS"Off)LoadRun)Exec"
3290 :
3300 :
3310 \ ======================
3320 \ Check object ownership
3330 \ ======================
3340 \ DoIOwn - Check if directory is owned, corrupts Y, fetches USERNUM
3350 \ DoIOwnFSM - Check directory in FSM buffer
3360 \ Assumes USERNUM is valid, GetOptNum has already been called
3370 \
3380 \ DoIOwn:
3390 \ On exit, A=&00 EQ - Owner
3400 \ A=&FF NE - Public
3410 \ Y corrupted
3420 \ X preserved
3430 \ YDoIOwn:
3440 \ On exit, Y=>my 'R' bit
3450 \ X preserved
3460 \ A=&00 - Owner
3470 \ A=&FF - Public
3480 \ -----------------------------------------------------
3490 .YDoIOwn
3500 JSR DoIOwn:TAY:BEQ P%+4:LDY #4
3510 .CatDone
3520 RTS
3530 :
3540 .DoIOwnFSM
3550 SEC:BCS DoIOwn2 :\ CS=Check in FSM buffer
3560 :
3570 .DoIOwn
3580 JSR GetOptNum:CLC :\ Update USERNUM, CC=Check in directory header
3590 :
3600 .DoIOwn2
3610 JSR AccountAux :\ Y=>AuxAcc
3620 .DoIOwnLp
3630 LDA HDR+0,Y:BCC P%+5:LDA FSM+0,Y :\ A=Account Number high
3640 EOR USERNUM+1:AND #&F0:BNE DoIOwnNo
3650 LDA HDR+1,Y:BCC P%+5:LDA FSM+1,Y :\ A=Account Number low
3660 EOR USERNUM+0:BEQ DoIOwnYes
3670 .DoIOwnNo
3680 TYA:LDY #&12:EOR #&12:BNE DoIOwnLp
3690 LDA USERNUM+1:AND #8:EOR #8:BEQ DoIOwnYes :\ Syst flag set
3700 LDA #&FF :\ &FF=Public
3710 .DoIOwnYes
3720 RTS
3730 :
3740 \ Get address of directory buffer
3750 \ -------------------------------
3760 .dirAddr
3770 .z%
3780 JSR WhatMOS:LDA #&11 :\ BBC directory buffer at &1100
3790 BCS P%+4:LDA #&11-&B2*(DIR=0):RTS :\ Master directory buffer at &C300
3800 :]:IF VALbase$>=5.79:z%=P%-z%:P%=P%-z%:O%=O%-z%
3810 .z%
3820 LDA #&11:BIT WHATOS :\ BBC directory buffer at &1100
3830 BPL P%+4:LDA #&11-&B2*(DIR=0):RTS :\ Master directory buffer at &C300
3840 :]:IF VALbase$<5.79:z%=P%-z%:P%=P%-z%:O%=O%-z%
3850 :
3860 \ Initialise fptr to point to start of directory
3870 \ ----------------------------------------------
3880 \ On exit, fptr=>DIR (ie, one entry before start of entries)
3890 \ Y=0
3900 \ A=number of files, EQ=no files
3910 \ X=preserved
3920 .dirInit
3930 LDY #0:STY fptr+0 :\ Point to start of directory
3940 JSR dirAddr:STA fptr+1
3950 LDA HDR+&0C:AND #31:STA files :\ Fetch number of objects
3960 RTS
3970 :
3980 \ Step fptr to next directory entry
3990 \ ---------------------------------
4000 \ On exit, fptr=>next entry
4010 \ Y=0
4020 \ A=(fptr),Y, EQ=entry empty
4030 \ X=preserved
4040 .dirNext
4050 JSR dirSize:LDY #0
4060 CLC:ADC fptr+0:STA fptr+0 :\ Point to next entry
4070 TYA:ADC fptr+1:STA fptr+1
4080 LDA (fptr),Y:RTS :\ EQ if this entry empty
4090 :
4100 \ Get size of directory entries
4110 \ -----------------------------
4120 .dirSize
4130 LDA #24:BIT HDR+&0C
4140 BPL P%+4:LDA #32:RTS :\ A=size of entries
4150 :
4160 \ Load next directory chunk
4170 \ -------------------------
4180 \ Returns A=&00/EQ if no link, A=&FF/NE if link
4190 .NextChunk
4200 JSR GetLINK:BEQ NextChunkNo
4210 JSR GetDir:LDA #&FF
4220 .NextChunkNo
4230 RTS
4240 :
4250 \ Get load address high byte
4260 \ --------------------------
4270 .GetLoadHigh
4280 LDY #13:LDA (fptr),Y :\ Get load address high byte
4290 .LoadHighByte
4300 BIT HDR+&0C:BMI LoadHighOk :\ Return unchanged if large dir
4310 ROL A:ROL A:ROL A:PHP :\ Move b5 into Cy
4320 ROR A:PLP:PHP:ROR A:PLP:ROR A :\ Copy b5 into b6 and b7
4330 .LoadHighOk
4340 RTS
4350 :
4360 :
4370 \ -------------------------------------
4380 \ *Info - Display information on object
4390 \ -------------------------------------
4400 .info
4410 JSR SearchPathXY
4420 JSR CheckDirInfo:BNE DisplayInfo :\ Resolve directory and $
4430 LDA #&FE:JMP DiskErrorNN :\ Drive X not present
4440 :
4450 \ --------------------------------------------
4460 \ Display object information for *INFO and *EX
4470 \ --------------------------------------------
4480 \ On entry, (fptr) -> directory entry
4490 \ --------------------------------------------
4500 .DisplayInfo
4510 TXA:PHA:JSR PrFilename :\ Display filename
4520 JSR GetLoadHigh :\ Get load address high byte
4530 LDX #4:JSR Pr4HexA:JSR Pr4Hex :\ Print load, exec address
4540 LDA HDR+&0C:ASL A:PHP :\ Get BigDir flag to Carry
4550 LDX #4:LDA (fptr),Y :\ Get 32-bit length high byte
4560 BCS DisplayLen24 :\ Jump to display 32-bit length
4570 JSR Pr2Space
4580 DEX:DEY:LDA (fptr),Y:AND #7 :\ Get 24-bit length high byte
4590 .DisplayLen24
4600 JSR Pr4HexA:JSR Pr2Space :\ Display 24-bit or 16-bit length
4610 JSR PrAccess:JSR PrSpace :\ Print access string
4620 PLP:PHP:LDY #md+1:JSR PrDate2 :\ Print modification date
4630 :
4640 \\ Print cdate and mdate
4650 \\PLP:\PHP:\LDY #cd+1:\JSR PrDate2 :\ Print first date
4660 \\PLP:\PHP:\BCC P%+7 :\ Print date, skip if SmallDir
4670 \\LDY #md+1:\JSR PrDate :\ Print BigDir modification date
4680 :
4690 \\LDY #&12:\JSR PrUser :\ Account
4700 \\JSR PrSpace:\LDA #ASC"(":\JSR OSWRCH
4710 \\LDY #&12:\JSR PrUser :\ Aux.
4720 \\LDA #ASC")":\JSR OSWRCH
4730 :
4740 PLP:JSR GetSectorHigh2 :\ Get sector byte three
4750 LDX #3:JSR Pr4HexA :\ Print three-byte sector
4760 PLA:TAX:JMP OSNEWL :\ Finished
4770 :
4780 .GetSectorHigh
4790 LDA HDR+&0C:ASL A :\ Get BigDir flag to Carry
4800 .GetSectorHigh2
4810 LDY #&18:LDA (fptr),Y :\ Get sector byte three
4820 BCS P%+4:LDA #0:RTS :\ Zero third byte if small dir
4830 :
4840 .GetSectAddr
4850 JSR GetSectorHigh:STA sect+2 :\ Get object sector start
4860 DEY:LDA (fptr),Y:STA sect+1
4870 DEY:LDA (fptr),Y:STA sect+0
4880 RTS
4890 :
4900 :
4910 \ Print hex addresses
4920 \ -------------------
4930 .Pr4Hex
4940 LDX #4
4950 .PrHexLp
4960 LDA (fptr),Y
4970 .Pr4HexA
4980 JSR PrHex:DEY:DEX:BNE PrHexLp :\ Print hex, loop for next
4990 TYA:CLC:ADC #8:TAY:BNE PrSpace :\ Point to next address
5000 :
5010 .Pr3SpaceNL
5020 LDA &30A:SBC &318
5030 SBC #16:BCC Pr1Newl
5040 .Pr3Space:JSR PrSpace
5050 .Pr2Space:JSR PrSpace
5060 .PrSpace :LDA #32:JMP OSWRCH
5070 .Pr2Newl :JSR OSNEWL
5080 .Pr1Newl :JMP OSNEWL
5090 :
5100 .PrName10
5110 LDY #10
5120 .PrName
5130 LDA WS,X:JSR OSWRCH:INX:DEY
5140 BNE PrName:RTS
5150 .InfoF00
5160 LDA &F00,X:JMP PrHex
5170 .PrDrvChr
5180 JSR GetDrvChr:JMP OSWRCH
5190 :
5200 \ Print object filename
5210 \ ---------------------
5220 .PrFilename
5230 LDY #0:.PrNameLp
5240 LDA (fptr),Y:AND #127:JSR OSWRCH
5250 INY:CPY #10:BNE PrNameLp
5260 BEQ PrSpace
5270 :
5280 \ Print object access string PDLWRE/wre
5290 \ -------------------------------------
5300 .PrAccess
5310 TXA:PHA:LDX #0 :\ 0 characters printed
5320 .z%
5330 TXA :\ Clear A for tests
5340 :]:IF VALbase$<5.76:z%=P%-z%:P%=P%-z%:O%=O%-z%
5350 LDY #7:JSR TryAccChar :\ 'P'
5360 INY:JSR TryAccChar:PHP :\ 'D'
5370 LDY #3:JSR TryAccChar :\ 'L'
5380 PLP:BCS PrAccSlash:DEY
5390 .PrAccPublic
5400 DEY:JSR TryAccCharX :\ 'W'
5410 DEY:JSR TryAccCharX :\ 'R'
5420 BCS PrAccSlash
5430 INY:INY:JSR TryAccChar:DEY:DEY :\ 'E'
5440 .PrAccSlash
5450 CPY #4:BCS PrAccEnd:JSR PrSlash
5460 CPY #3:LDY #6:BCC PrAccPublic
5470 .PrAccEnd
5480 LDA #32
5490 .PrAccSpcs
5500 JSR OSWRCH:INX:CPX #7
5510 BNE PrAccSpcs
5520 PLA:TAX:RTS
5530 :
5540 .TryAccCharX
5550 LDA #&FF
5560 .TryAccChar
5570 CLC:EOR (fptr),Y:BPL TryAccNo
5580 LDA PrAccChars,Y:JSR OSWRCH
5590 INX:SEC
5600 .TryAccNo
5610 RTS
5620 .PrAccChars:EQUS "RWELrwePD"
5630 :
5640 .PrDecS
5650 JSR PrDec
5660 .PrSlash
5670 LDA #ASC"/":JMP OSWRCH
5680 :
5690 :
5700 \ --------------------------
5710 \ DISPLAY DATE IN FILE ENTRY
5720 \ -----------------------------------------------------------
5730 \ On entry, (fptr),Y -> top byte of two-byte date entry
5740 \ CC -> date split over locations (small DIR)
5750 \ CS -> year compacted (FSM or large DIR)
5760 \ -----------------------------------------------------------
5770 \.PrDate :\ Enter here to print compacted date
5780 \SEC
5790 .PrDate2
5800 JSR ReadInfoDate
5810 PHA:AND #31:JSR PrDecS :\ Day
5820 TXA:AND #15:JSR PrDecS :\ Month
5830 TXA:LSR A:LSR A:LSR A:LSR A :\ Year b0-b3
5840 STA tmp:PLA:AND #&E0:LSR A :\ Year b4-b6
5850 ORA tmp:ADC #81:LDY #19 :\ A = 81..208, prepare for 19xx
5860 .PrDateLp
5870 CMP #100:BCC PrDateCC :\ Year<100, use this century
5880 SBC #100:INY:BNE PrDateLp :\ Reduce year, increase century
5890 .PrDateCC
5900 PHA:TYA:JSR PrDec :\ Print the century number
5910 PLA:JSR PrDec:JMP PrSpace :\ ...and the year number
5920 :
5930 \.PrUser
5940 \LDA HDR+&00,Y:\JSR HexTopDigit:\JSR OSWRCH
5950 \LDA HDR+&01,Y:\JMP PrHex
5960 :
5970 :
5980 \ =======================================
5990 \ FREE SPACE MAP DISPLAY AND MANIPULATION
6000 \ =======================================
6010 :
6020 \ --------------
6030 \ *FREE and *MAP
6040 \ --------------
6050 .Free
6060 LDX #&FF:EQUB &2C :\ X=&FF - *FREE
6070 .Map
6080 LDX #0 :\ X=&00 - *MAP
6090 JSR CheckContext:TXA:STA catex:PHA :\ Ensure mounted, set map/free
6100 JSR GetDrive:JSR AddUpFree :\ Get FSM and add up free space
6110 LDA numstore+1:PHA:LDA numstore+2:PHA :\ Save total free space
6120 LDA numstore+3:PHA
6130 LDA catex:AND #ASC" ":STA numflg :\ Prepare '0' or ''
6140 BEQ P%+5:JSR PrSect :\ If *free, print hex sectors
6150 JSR PrFreeNum :\ Print '<nnnn> bytes '
6160 JSR PrText:EQUS "free":EQUB 13:BRK
6170 PLA:STA numstore+3
6180 PLA:STA numstore+2:PLA:STA numstore+1 :\ Restore total free space
6190 PLA:BPL MapDone :\ *map, so finish
6200 JSR AddUpUsed:JSR PrSect :\ Calculate and print used
6210 JSR PrFreeNum :\ Print '<nnnn> bytes '
6220 JSR PrText:EQUS "used":EQUB 13:BRK
6230 .MapDone
6240 RTS :\ Restore numflg/drive
6250 :
6260 .AddUpUsed
6270 SEC
6280 LDA &F1C:SBC numstore+1:STA numstore+1
6290 LDA &F1D:SBC numstore+2:STA numstore+2
6300 LDA &F1E:SBC numstore+3:STA numstore+3
6310 LDA FSM+31
6320 AND #&80:BNE P%+4:STA numstore+3:RTS :\ If SmallDisk, set used=&00xxxx
6330 \\LDA &F1E:\BIT &F1F:\BMI P%+4:\LDA #0
6340 \\SBC numstore+3:\STA numstore+3:\RTS
6350 :
6360 \ ---------------------
6370 \ Print '<nnnn> bytes '
6380 \ Corrupts numsub/catex
6390 \ ---------------------
6400 .PrFreeNum
6410 LDA #0:STA numstore:JSR PrDec32 :\ Print number of bytes
6420 JSR PrText:EQUS " bytes ":BRK
6430 RTS
6440 :
6450 .PrSect
6460 LDA numstore+3:JSR PrHex
6470 LDA numstore+2:JSR PrHex
6480 LDA numstore+1:JSR PrHex
6490 JSR PrText:EQUS " Sectors ":BRK
6500 LDA #32:STA numflg
6510 RTS
6520 :
6530 .AddUpFree
6540 JSR CheckHADFSDisk :\ Load free space map
6550 BIT catex:BMI Map3 :\ Jump to add up without printout
6560 \JSR PrText:\EQUS "Free Space Map, drive ":\BRK
6570 \JSR PrDrvChr:\JSR Pr2Newl
6580 JSR PrText:EQUS "Free Space Map":EQUB 58:EQUB 13:BRK
6590 .Map3
6600 LDA #0:STA numstore+1:STA numstore+2 :\ Clear numstore
6610 STA numstore+3:LDX #&20
6620 :
6630 .MapLp
6640 BIT catex:BMI Map4
6650 JSR MapBytes:LDA #ASC"+":JSR OSWRCH :\ Print FSM entry start
6660 .Map4
6670 JSR MapNextEntry:CLC :\ Point to entry length
6680 LDA &F00,X:ADC numstore+1:STA numstore+1 :\ Add to current count
6690 LDA &F01,X:ADC numstore+2:STA numstore+2
6700 JSR MapTopByte:PHA
6710 ADC numstore+3:STA numstore+3
6720 PLA:ORA &F01,X:ORA &F00,X:PHA :\ Check for end of FSM
6730 BIT catex:BMI Map5
6740 JSR MapBytes:JSR Pr3SpaceNL :\ Print FSM entry length
6750 .Map5
6760 JSR MapNextEntry:PLA:BNE MapLp :\ Loop for all FSM entries
6770 :
6780 BIT catex:BMI MapTopByteOk:JMP OSNEWL
6790 :
6800 .MapBytes
6810 JSR MapTopByte:JSR PrHex :\ Top byte or zero
6820 LDA &F01,X:JSR PrHex:JMP InfoF00 :\ Bottom two bytes
6830 :
6840 .MapTopByte
6850 LDA &F02,X:BIT &F1F:BMI P%+4:LDA #0
6860 .MapTopByteOk
6870 RTS
6880 :
6890 .MapNextEntry2
6900 INX:INX
6910 .MapNextEntry
6920 INX:INX:BIT &F1F:BPL P%+3:INX:RTS
6930 :
6940 :
6950 \ =============
6960 \ FindFreeSpace
6970 \ =============
6980 \ On entry, FSM in memory
6990 \ len=length required, rounded to whole sectors
7000 \ On exit, FSM adjusted
7010 \ start=start sector of space found
7020 \ A,X,Y corrupted
7030 \ -------------------------------------------------------
7040 \ Multiple JSR FindFreeCheck/bcc/inx/lda f22 could be optimised
7050 .FindFreeSpace
7060 .z%
7070 \ First look for exact match
7080 \ --------------------------
7090 LDX #0:LDY FSM+31 :\ X=start, Y=BigDisk flag
7100 .FindFreeLp0
7110 JSR FindFreeChk:BEQ FindFree1 :\ End of FSM, look for big enough
7120 BCC P%+3:INX :\ Cy=BigDisk flag, point to size
7130 LDA &F22,X:CMP len+1:BNE FindFreeNext
7140 LDA &F23,X:CMP len+2:BNE FindFreeNext
7150 TYA:BPL FindFreeSub :\ Found matching 16-bit entry
7160 LDA &F24,X:BEQ FindFreeSub :\ Found matching 24-bit entry
7170 .FindFreeNext
7180 JSR MapNextEntry2
7190 JMP FindFreeLp0
7200 :]:IF VALbase$<5.76:z%=P%-z%:P%=P%-z%:O%=O%-z%
7210 :
7220 \ Then look for a big enough match
7230 \ --------------------------------
7240 .FindFree1
7250 LDX #0:LDY FSM+31 :\ Get BigDisk flag
7260 .FindFreeLp1
7270 JSR FindFreeChk:BEQ errDiskFull :\ Check for end of FSM
7280 BCC P%+3:INX :\ Cy=BigDisk flag, point to size
7290 :
7300 \ Enter here from OSARGS 6,Y - Set Alloc
7310 \ --------------------------------------
7320 \ Y=BigDisk flag, X=>FSM entry, len=length required
7330 .FindFreeSub
7340 SEC
7350 LDA &F22,X:SBC len+1:PHA :\ Push size-len
7360 LDA &F23,X:SBC len+2:PHA
7370 TYA:BPL FindFree2 :\ SmallDisk, just 16-bit size
7380 LDA &F24,X:SBC #0:PHA :\ BigDisk, subtract top byte
7390 .FindFree2
7400 BCS FindFreeFound :\ size>=len, use this entry
7410 PLA:PLA :\ Drop size-len
7420 TYA:BPL P%+3:PLA :\ If BigDisk, drop third byte
7430 JSR MapNextEntry2 :\ Step to next entry
7440 CPX #&D8:BCC FindFreeLp1 :\ Step through whole FSM
7450 .errCompact
7460 \JSR ClearDIR
7470 JSR errorDIR:EQUB 152:EQUS "Compaction required":BRK
7480 .errDiskFull
7490 \JSR ClearDIR
7500 JSR errorDIR:EQUB 198:EQUS "Disk full":BRK
7510 :
7520 \ Found a FSM entry big enough for len
7530 \ ------------------------------------
7540 .FindFreeFound
7550 TYA:BPL FindFree3
7560 PLA:STA &F24,X :\ BigDisk, top byte of newsize
7570 .FindFree3
7580 PLA:STA &F23,X:PLA:STA &F22,X :\ newsize=oldsize-len
7590 CLC:TYA:BPL P%+3:DEX :\ Adjust X if BigDisk
7600 LDA &F20,X:STA start+0 :\ start=space
7610 ADC len+1:STA &F20,X :\ newspace=oldspace+len
7620 LDA &F21,X:STA start+1 :\ start=space
7630 ADC len+2:STA &F21,X :\ newspace=oldspace+len
7640 LDA #0:STA start+2 :\ If SmallDisk, start=&00yyzz
7650 TYA:BPL FindFree4 :\ Skip past if SmallDisk
7660 LDA &F22,X:STA start+2 :\ BigDisk, start=&xxyyzz
7670 ADC #0:STA &F22,X :\ newspace top byte
7680 INX:LDA &F24,X :\ newsize top byte
7690 .FindFree4
7700 ORA &F23,X:ORA &F22,X :\ Check if newsize=0
7710 BNE FindFreeOk :\ newsize<>0, return
7720 TYA:ASL A:TXA:TAY :\ newsize=0, merge entry with next
7730 BCC FindFreeLp2:INY:DEX :\ BigDisk, point X and Y to 24-bit entries
7740 .FindFreeLp2
7750 LDA &F24,Y:STA &F20,X:INY :\ Copy FSM entries down
7760 INX:CPX #&D8:BCC FindFreeLp2 :\ Loop to end of FSM
7770 .FindFreeOk
7780 RTS
7790 :
7800 .AddFSMinit
7810 LDX #0:LDY FSM+31:BMI AddFSMinitok
7820 LDA start+2:BEQ AddFSMinitok
7830 JMP errTooLong :\ Adding/Looking for 24-bit sector in 16-bit FSM
7840 :
7850 .FindFreeChk
7860 TYA:ASL A :\ Move BigDisk flag to Carry
7870 LDA #0:BCC P%+5:LDA &F22,X :\ SmallDisk, size=&00xxxx, BigDisk, size=&xxxxxx
7880 ORA &F21,X:ORA &F20,X :\ Check for end of FSM
7890 .AddFSMinitok
7900 RTS :\ Return EQ=end of FSM, Cy=BigDisk flag
7910 :
7920 \ =================================================================
7930 \ AddToFSM - Remove an object, adding it back to the Free Space Map
7940 \ =================================================================
7950 \ Used when deleting files or saving over existing file
7960 \ On entry, FSM already in memory
7970 \ start/start+1/start+2 =start sector
7980 \ drive =drive
7990 \ len+1/len+2 =number of sectors
8000 \ On exit, FSM updated in memory
8010 \ A,X,Y,len+0 corrupted
8020 \ ------------------------------------------------------
8030 \ This can probably be optimised
8040 \ ------------------------------
8050 .AddToFSM
8060 LDA len+1:ORA len+2:BEQ FindFreeOk :\ Nothing to add to FSM
8070 JSR AddFSMinit
8080 .AddFSMlp
8090 JSR FindFreeChk :\ Check for end of FSM
8100 BEQ AddFSMend:SEC :\ End of FSM, add released space here
8110 LDA start+0:SBC &F20,X
8120 LDA start+1:SBC &F21,X
8130 TYA:BPL AddFSMa
8140 LDA start+2:SBC &F22,X
8150 .AddFSMa
8160 BCC AddFSMhere :\ This entry just after released space
8170 JSR AddFSMnext:BCC AddFSMlp :\ Step through whole FSM
8180 JMP errCompact
8190 :
8200 .AddFSMnext
8210 TYA:BPL P%+4:INX:INX :\ Step to next entry
8220 INX:INX:INX:INX
8230 CPX #&D8:RTS
8240 :
8250 .AddFSMend
8260 JSR AddFSMins :\ Write new FSM entry at end of FSM
8270 STA &F24,X:STA &F25,X:STA &F26,X :\ Write terminating zero
8280 BEQ AddFSMjoin :\ Try and merge with previous entry
8290 :
8300 .AddFSMprevJmp:JMP AddFSMprev
8310 .AddFSMhere
8320 \ X=>FSM entry just after start/len space to be released
8330 LDA start+0:ADC len+1:EOR &F20,X:BNE AddFSMprevJmp:\ Can't merge with this entry, try to
8340 LDA start+1:ADC len+2:EOR &F21,X:BNE AddFSMprevJmp:\ merge with previous entry
8350 TYA:BPL AddFSMb
8360 LDA start+2:ADC #0:EOR &F22,X:BNE AddFSMprevJmp
8370 :
8380 \ start+len joins onto this FSM entry
8390 .AddFSMb
8400 SEC
8410 LDA &F20,X:SBC len+1:STA &F20,X :\ Move this FSM entry's start backwards
8420 LDA &F21,X:SBC len+2:STA &F21,X
8430 TYA:BPL AddFSMc
8440 LDA &F22,X:SBC #0:STA &F22,X:INX
8450 .AddFSMc
8460 CLC
8470 LDA &F22,X:ADC len+1:STA &F22,X :\ Extend this FSM's length backwards
8480 LDA &F23,X:ADC len+2:STA &F23,X
8490 TYA:BPL AddFSMjoin
8500 LDA &F24,X:ADC #0:STA &F24,X:DEX
8510 :
8520 \ Space has been returned by extending this FSM entry backwards
8530 \ Can we now merge this with previous FSM entry?
8540 .AddFSMjoin
8550 TXA:BEQ AddFSMdone :\ No previous entry, finished
8560 CLC:TYA:BPL AddFSM16
8570 LDA &F1A,X:ADC &F1D,X:EOR &F20,X:BNE AddFSMdone :\ laststart+lastlen<>thisstart, finished
8580 LDA &F1B,X:ADC &F1E,X:EOR &F21,X:BNE AddFSMdone
8590 LDA &F1C,X:ADC &F1F,X:EOR &F22,X:BNE AddFSMdone
8600 :
8610 \ laststart+lastlen=thisstart, merge last entry with this entry
8620 .AddFSMmerge24
8630 CLC
8640 LDA &F1D,X:ADC &F23,X:STA &F1D,X
8650 LDA &F1E,X:ADC &F24,X:STA &F1E,X
8660 LDA &F1F,X:ADC &F25,X:STA &F1F,X
8670 TXA:TAY:INY:INY:JMP FindFreeLp2 :\ Move entries downwards
8680 :
8690 .AddFSM16
8700 LDA &F1C,X:ADC &F1E,X:EOR &F20,X:BNE AddFSMdone :\ laststart+lastlen<>thisstart, finished
8710 LDA &F1D,X:ADC &F1F,X:EOR &F21,X:BNE AddFSMdone
8720 :
8730 \ laststart+lastlen=thisstart, merge last entry with this entry
8740 .AddFSMmerge16
8750 CLC
8760 LDA &F1E,X:ADC &F22,X:STA &F1E,X
8770 LDA &F1F,X:ADC &F23,X:STA &F1F,X
8780 TXA:TAY:JMP FindFreeLp2 :\ Move entries downwards
8790 .AddFSMdone
8800 RTS
8810 :
8820 \ See if we can merge released space with previous FSM entry
8830 .AddFSMprev
8840 TXA:BEQ AddFSMnew :\ Start of FSM, need to add a new entry
8850 CLC:TYA:BMI AddFSM24
8860 LDA &F1C,X:ADC &F1E,X:EOR start+0:BNE AddFSMnew
8870 LDA &F1D,X:ADC &F1F,X:EOR start+1:BNE AddFSMnew
8880 BEQ AddFSM24b :\ Point to previous entry and lengthen it
8890 :
8900 .AddFSM24
8910 LDA &F1A,X:ADC &F1D,X:EOR start+0:BNE AddFSMnew
8920 LDA &F1B,X:ADC &F1E,X:EOR start+1:BNE AddFSMnew
8930 LDA &F1C,X:ADC &F1F,X:EOR start+2:BNE AddFSMnew
8940 DEX
8950 .AddFSM24b
8960 DEX:DEX:DEX:DEX:JMP AddFSMc :\ Point to previous entry and lengthen it
8970 :
8980 \ Couldn't merge released space with previous or next,
8990 \ so need to create a new FSM entry
9000 .AddFSMnew
9010 STX len:TYA:PHA :\ Save current FSM entry in len, save BigDisk flag
9020 .AddFSMlp2
9030 INX:INX:INX:INX :\ Step to next 16-bit entry
9040 TYA:ASL A :\ Move BigDisk flag to Carry
9050 LDA &F1D,X:BCC AddFSMe
9060 INX:INX:LDA &F1A,X:ORA &F1B,X :\ Get next 24-bit entry
9070 .AddFSMe
9080 ORA &F1C,X:BEQ AddFSMf :\ Found zero entry at end of FSM
9090 CPX #&D8:BCC AddFSMlp2 :\ Loop to end of FSM
9100 JMP errCompact
9110 :
9120 .AddFSMf
9130 TXA:TAY:BCC P%+4:INY:INY :\ Y=next entry
9140 .AddFSMlp3
9150 LDA &F1F,X:STA &F23,Y:DEY :\ Move entries upwards
9160 DEX:CPX len+0:BNE AddFSMlp3
9170 PLA:TAY :\ Get BigDisk flag back to Y
9180 .AddFSMins
9190 LDA start+0:STA &F20,X :\ Store new FSM entry start
9200 LDA start+1:STA &F21,X
9210 TYA:ASL A:BCC AddFSMg :\ Cy=BigDisk flag
9220 LDA start+2:STA &F22,X:INX
9230 .AddFSMg
9240 LDA len+1:STA &F22,X :\ Store new FSM entry length
9250 LDA len+2:STA &F23,X
9260 LDA #0:BCC AddFSMok
9270 STA &F24,X:INX
9280 .AddFSMok
9290 RTS :\ A=0, &F24,X=>next entry
9300 :
9310 :
9320 \ ==============================================
9330 \ FindFSMEntry - Find a FSM entry to extend into
9340 \ ==============================================
9350 \ On entry, FSM in memory
9360 \ start=FSM start sector to find
9370 \ On exit, A,Y corrupted
9380 \ NE = FSM not found
9390 \ EQ = FSM entry found
9400 \ X=>FSM entry
9410 \ Y=BigDisk flag
9420 \ -----------------------------------------
9430 \ Called from HADFS6
9440 .FindFSMEntry
9450 JSR AddFSMinit
9460 .FindFSMlp
9470 JSR FindFreeChk:BEQ FindFSMend :\ Check for end of FSM, Cy=BigDisk flag
9480 LDA &F20,X:EOR start+0:BNE FindFSMnext
9490 LDA &F21,X:EOR start+1:BNE FindFSMnext
9500 BCC FindFSMok
9510 LDA &F22,X:EOR start+2:BEQ FindFSMok
9520 .FindFSMnext
9530 JSR AddFSMnext:BCC FindFSMlp
9540 .FindFSMend
9550 LDA #&FF :\ NE=Not found
9560 .FindFSMok
9570 RTS :\ X=>FSM entry
9580 :
9590 ]
9600 PRINT CHR$11;STRING$(20,CHR$9);O%-mcode%;" bytes"
9610 OSCLI"SAVE ROMa "+STR$~mcode%+" "+STR$~O%+" 3000 3000":Block%=P%
9620 IF O%>&7BFF:PRINT"Writing over screen":VDU7:IF O%>L%:L%=O%
9630 IF O%>M%:PRINT"Overwriting screen output":VDU7:CLOSE#0
9640 >"S.HADFS3"