10
20
30
40
50
60
70
80
90
100
110
120
130
140
150
160
170
180
190
200
210
220
230
240 :
250 IDEdata =&FC40:IDEerror=&FC41:IDEcount =&FC42:IDEsector=&FC43
260 IDEcylinder=&FC44:IDEhead =&FC46:IDEcommand=&FC47:IDEstatus=&FC47
270 :
280 PRINT"Assembling S.HADFS9"
290 O%=P%-Block%+mcode%
300 [OPT0
310 \ ============================
320 \ OSWORD 90 - User Disk Access
330 \ ============================
340 .NotOsw90:LDA #8:RTS
350 .Osword90
360 LDY #01:LDA (&F0),Y:CMP #6:BNE NotOsw90 :\ Second byte must be &06
370 LDY #11:LDA (&F0),Y:BPL NotOsw90 :\ cmd<&80, ignore
380 CMP #&82:BCS NotOsw90 :\ cmd>&81, ignore
390 :
400 \ We may not own HADFS's workspace, so we need to claim it
410 \ --------------------------------------------------------
420 \ NB, don't need the filing system, just need the workspace.
430 \ Calls GrabAbs, then doesn't need to release, just allows any previous
440 \ owner to reclaim it. Needs to restore DFS24x workspace flag, as DFS may be
450 \ the owner when calling.
460 \ However, may still need to select HADFS so that DFS gets initialised.
470 \
480 \\PHA:LDA &F1:PHA:LDA &F0:PHA :\ Save byte for oldFS and OSWORD pointer
490 JSR GrabAbs :\ Ensure access to HADFS's workspace
500 \\JSR EnsureHADFS:\TSX:\STA &103,X :\ Select HADFS, saving oldFS
510 TSX:LDA &102,X:STA &F1 :\ Get OSWORD pointer back from stack
520 LDA &101,X:STA &F0:LDY #1
530 .DoOsw90lp1
540 INY:LDA (&F0),Y:STA addr-2,Y :\ Copy supplied addr
550 CPY #5:BNE DoOsw90lp1
560 .DoOsw90lp2
570 INY:LDA (&F0),Y:STA start-6,Y :\ Copy supplied sect
580 CPY #8:BNE DoOsw90lp2:INY
590 LDA (&F0),Y:STA drive:INY
600 LDA (&F0),Y:STA len+1:INY
610 LDA #0:STA len+2:TAX :\ Transfer &00xx00 bytes
620 LDA (&F0),Y:CMP #&80:BEQ P%+3:DEX :\ &80/&81 -> &00/&FF
630 STX action:JSR CheckAddr :\ Allowed to corrupt A,X,Y,P
640 SEC:JSR DiskMainOsw:TAX :\ Call main disk transfer code, allowed to corrupt A,X,Y,P
650 PLA:STA &F0:PLA:STA &F1:LDY #2 :\ Restore OSWORD pointer
660 .DoOsw90lp3
670 LDA addr-2,Y:STA (&F0),Y :\ Copy updated addr/sect to control block
680 INY:CPY #6:BNE DoOsw90lp3
690 LDA len+1:LDY #10:STA (&F0),Y
700 TXA:INY:STA (&F0),Y
710 \\PLA:\JSR RestoreFS :\ Restore previous fs
720 LDA #0:RTS :\ Claim the OSWORD call
730 :
740 :
750 \ ============================================
760 \ DiskMain - main disk sector transfer routine
770 \ ============================================
780 \ Read/Write number of sectors
790 \ On entry,
800 \ action =0 - read, action=&FF - write
810 \ sect =sector start
820 \ addr =data address (any memory)
830 \ len+1/2=number of sectors
840 \ SEC at DiskMainOsw to return error in A
850 \
860 \ On exit,
870 \ sect =sector after end
880 \ addr =data address after end
890 \ len+1/2=sectors not transfered
900 \ A=error number when called with SEC
910 \ EQ=no error occured
920 \ X=corrupted
930 \ Y=corrupted
940 :
950 .DiskMain
960 JSR CheckAddr :\ Allowed to corrupt A,X,Y,P
970 .DiskMainGBPB :\ OSGBPB has already called CheckAddr
980 CLC :\ CLC=report errors
990 .DiskMainOsw
1000 PHP:JSR ScreenOn :\ Allowed to corrupt A,X,Y,P
1010 JSR StartToSect :\ Copy start to sect
1020 .DiskMainLp1
1030 LDA len+2:ORA len+1:BEQ DiskMainEnd:\ Nothing left
1040 LDY #64:LDA len+2:BNE DiskMainBlock:\ >=&10000, transfer 64 sectors
1050 CPY len+1:BCC DiskMainBlock :\ >=&4000, transfer 64 sectors
1060 LDY len+1 :\ Transfer remaining sectors
1070 .DiskMainBlock
1080 STY num :\ Transfer block of sectors
1090 LDA len+1:SEC:SBC num:STA len+1 :\ Decrease sector count
1100 LDA len+2:SBC #0:STA len+2 :\ Should do this *after* transfer
1110 JSR DiskAcc:BEQ DiskMainLp1 :\ addr and sect updated by DiskAcc
1120 PLP:BCS P%+5:JMP DiskErrors:PHP :\ CC=generate error, CS=return error
1130 .DiskMainEnd
1140 PLP:PHA:JSR ScreenOff:PLA:RTS :\ X,Y corrupted, A=result, flags set
1150 :
1160 :
1170 \ CheckAddr - Check transfer addr for screen selection
1180 \ ====================================================
1190 \ On exit, shadow=0 for non-screen or <>0 for screen
1200 \ addr modified
1210 \ all registers corrupted
1220 .CheckAddr
1230 LDA #0:STA shadow :\ Set 'no shadow selected'
1240 LDX &27A:BPL AddrIO :\ No Tube, always use IO memory
1250 LDX addr+3:INX:BNE AddrTube :\ Tube present, addr<>&FFxxxxxx
1260 :
1270 .AddrIO
1280 LDX addr+2
1290 INX:BEQ AddrIOGo :\ &FFFFxxxx - current IO memory
1300 INX:BEQ AddrDisplay :\ &FFFExxxx - current display
1310 INX:BNE AddrIOGo :\ &FFFDxxxx - shadow memory
1320 .z%
1330 JSR WhatMOS:BCC AddrShadow :\ Master, don't need to check display
1340 :]:IF VALbase$>=5.79:z%=P%-z%:P%=P%-z%:O%=O%-z%
1350 .z%
1360 BIT WHATOS:BMI AddrShadow :\ Master, don't need to check display
1370 :]:IF VALbase$<5.79:z%=P%-z%:P%=P%-z%:O%=O%-z%
1380 INC shadow:INC shadow :\ BBC, b1=always page memory
1390 .AddrDisplay
1400 LDA #&84:JSR OSBYTE :\ Get top of I/O memory
1410 CPY #&70:BEQ AddrShadow :\ 16K Aries screen
1420 TYA:BPL AddrIOGo :\ <&8000 - non-shadow screen
1430 .AddrShadow
1440 INC shadow :\ b0=screen bank
1450 :
1460 .AddrIOGo
1470 LDA #&FF:STA addr+2:STA addr+3 :\ Ensure addr is in IO memory
1480 .AddrTube
1490 RTS
1500 :
1510 \ Screen selection routines
1520 \ -------------------------
1530 \ On entry, shadow=0 for non-screen or <>0 for screen
1540 \ On exit, all registers corrupted
1550 .ScreenOn
1560 SEC:BCS P%+3
1570 .ScreenOff
1580 CLC:LDA shadow:BEQ vramDone :\ No paging required
1590 BCS P%+4:EOR #1 :\ Toggle bit 0 if screen off
1600 AND #1:LDY #108:JSR vramSel:BVC vramDone :\ Attempt to select Master/Integra video RAM
1610 EOR #1:LDY #34:JSR vramSel:BVC vramDone :\ Attempt to select old Watford RAM
1620 LDY #111 :\ Attempt to select Aries/new Watford RAM
1630 .vramSel
1640 PHA:TAX:TYA:JSR OSBYTE:PLA
1650 .vramDone
1660 RTS
1670 :
1680 \ Tube access routines
1690 \ --------------------
1700 .TubeClaimLoad
1710 LDA #1
1720 .TubeClaimDo
1730 PHA:JSR TubeClaim:PLA
1740 .TubeAction
1750 LDX #addr:LDY #0:JMP &406
1760 .TubeClaim
1770 LDA #&C0+progID+16
1780 JSR &406:BCC TubeClaim:RTS
1790 :
1800 .TubeRelease
1810 LDA #&80+progID+16:JMP &406
1820 :
1830 \ 48cycle, 24us delay
1840 \ -------------------
1850 .TubeWait:JSR TubeW1
1860 .TubeW1:JSR TubeW2
1870 .TubeW2:RTS
1880 \\TXA:\PHA:\LDX #10:\.TubeWaitLp
1890 \\DEX:\BNE TubeWaitLp:\PLA:\TAX:\RTS
1900 :
1910 :
1920 \ Load FSM, Check HADFS disk, etc.
1930 \ --------------------------------
1940 .CheckHadfsDiskX
1950 JSR ReadFSM:BNE NotHADFSError0 :\ Check disk without copying disk name
1960 .ChkHadfsChng
1970 LDA HDR+&10:CMP &F18:BNE DskChgErr
1980 LDA HDR+&11:CMP &F19:BNE DskChgErr
1990 RTS
2000 :
2010 \ Load a directory and check it is same disk
2020 \ ------------------------------------------
2030 .get_chk_dir
2040 LDA HDR+&10:PHA:LDA HDR+&11:PHA
2050 LDA CURR:ORA CURR+1:ORA CURR+2:PHA
2060 LDA CURR+d:PHA
2070 JSR GetDir
2080 PLA:CMP CURR+d:BNE GetChkDirOk1
2090 PLA:BEQ GetChkDirOk2
2100 PLA:CMP HDR+&11:BNE DskChgErr
2110 PLA:CMP HDR+&10:BEQ GetChkDirOk4
2120 .DskChgErr
2130 JMP DiskChanged
2140 .GetChkDirOk1:PLA
2150 .GetChkDirOk2:PLA:PLA
2160 .GetChkDirOk4
2170 RTS
2180 :
2190 \ Load FSM and error if not an HADFS disk
2200 \ ---------------------------------------
2210 .CheckHADFSDisk
2220 JSR ReadFSM:BNE NotHADFSError0
2230 LDX #&F:.ChkNameLp
2240 LDA &F00,X:STA DSKNAME,X:DEX:BPL ChkNameLp
2250 LDA VFLG:ORA #128:AND #&E0:ORA drive:STA VFLG
2260 LDA #0:RTS:\ Does A need to be zero?
2270 :
2280 .NotHADFSError0
2290 BCS CheckDskErr:\ Drive not present
2300 LDA #0:STA VFLG
2310 .NotHADFSDisk
2320 JSR errors:EQUB 200:EQUS "Not an HADFS disk":BRK
2330 :
2340 .SectRootAbs
2350 JSR SetAbs
2360 .SectRoot
2370 LDA #71:BNE P%+4
2380 .SectFSM
2390 LDA #70:STA sect+0
2400 LDA #0:STA sect+1:STA sect+2:RTS
2410 :
2420 .SetAddrFSM
2430 LDA #&0F:STA addr+1
2440 .SetAddrIO
2450 LDA #&FF:STA addr+3:STA addr+2
2460 LDA #&00:STA addr+0:STA shadow
2470 RTS
2480 :
2490 \ Load FSM and check if it is an HADFS disk
2500 \ -----------------------------------------
2510 \ On exit, EQ -- HADFS
2520 \ NE CC Not HADFS disk
2530 \ NE CS Drive ? not present
2540 \ addr, sect, Y preserved
2550 \ A, X corrupted
2560 .ReadFSM
2570 TYA:PHA:LDY #6 :\ Save Y as called by SearchPath and SetContext
2580 .RdFSMlp1
2590 LDA addr,Y:PHA:DEY:BPL RdFSMlp1 :\ Save addr, sect
2600 JSR SectFSM:STA action :\ sect=FSM, action=read
2610 JSR SetAddrFSM:LDA #1:STA num :\ addr=&FFFF0F00, num=1
2620 \\LDA #&00:\STA addr+0
2630 \\LDA #&0F:\STA addr+1
2640 \\LDA #&FF:\STA addr+2:\STA addr+3
2650 JSR ClearFSM:JSR DiskAcc:TAX:LDY #0 :\ Read FSM from drive
2660 .RdFSMlp2
2670 PLA:STA addr,Y:INY:CPY #7:BNE RdFSMlp2 :\ Restore addr, sect
2680 PLA:TAY:TXA:BEQ ChkJGH :\ Disk read ok, check if HADFS
2690 CMP #&18:BCS ChkJGH1 :\ CS=Drive not present
2700 .CheckDskErr
2710 JMP DiskErrors :\ Bad read, generate error
2720 :
2730 .ChkJGH:LDX #7
2740 .ChkJGHlp
2750 LDA &F10,X:CMP JGHName,X:CLC:BNE ChkJGH2 :\ NE+CC=Not HADFS
2760 DEX:BPL ChkJGHlp:INX:CLC :\ EQ+CC=HADFS
2770 .ChkJGH1:TXA :\ Set EQ/NE from X
2780 .ChkJGH2:RTS
2790 :
2800 \ Claim the buffer at &0F00
2810 \ -------------------------
2820 \ If this is a Master, this is not a channel buffer
2830 .ClearFSM
2840 .z%
2850 JSR WhatMOS:BCC ClearFSMok :\ Master, not using &0F00
2860 :]:IF VALbase$>=5.79:z%=P%-z%:P%=P%-z%:O%=O%-z%
2870 .z%
2880 BIT WHATOS:BMI ClearFSMok :\ Master, not using &0F00
2890 :]:IF VALbase$<5.79:z%=P%-z%:P%=P%-z%:O%=O%-z%
2900 LDA CHN25:AND #&FE:STA CHN25 :\ Clear Ch25 buffer
2910 .ClearFSMok
2920 RTS
2930 :
2940 \ Clear the directory buffer
2950 \ --------------------------
2960 .ClearDIR
2970 LDA #0:STA CURR+0:STA CURR+1:STA CURR+2:STA CURR+d
2980 RTS
2990 :
3000 \ Load a directory
3010 \ ----------------
3020 \ GetDir, PutDir, ReadFSM, SaveFSM should preserve addr
3030 \ Need to save Y as called by SearchPath
3040 .GetDirX :\ Fetch directory from CSD,X
3050 JSR DIRtoSect
3060 .GetDir :\ Fetch directory in sect/drive
3070 LDA sect+0:CMP CURR+0:BNE Get3Sectors
3080 LDA sect+1:CMP CURR+1:BNE Get3Sectors
3090 LDA sect+2:CMP CURR+2:BNE Get3Sectors
3100 LDA drive:CMP CURR+d:BEQ Got3Sectors:\ Directory already in memory
3110 .Get3Sectors
3120 JSR ClearDIR:STA action:\LDA #3:\STA num
3130 TYA:PHA:LDY #7 :\ Save Y
3140 .GetDirLp1
3150 LDA addr,Y:PHA:DEY:BPL GetDirLp1 :\ Save addr, sect
3160 JSR DiskAccDir3 :\ Load to directory buffer
3170 JSR DirToAddr2:LDY #32 :\ addr=>DIR, Y=max header size
3180 .GetDirLp2
3190 DEY:LDA (addr),Y:STA HDR,Y :\ Copy header to workspace
3200 CPY #10:BNE GetDirLp2:LDY #0
3210 .GetDirLp3
3220 PLA:STA addr,Y:INY:CPY #4:BNE GetDirLp3 :\ Restore addr
3230 .GetDirLp4
3240 PLA:STA CURR-4,Y:INY:CPY #8:BNE GetDirLp4 :\ Restore sect to CURR
3250 \STA CURR+d:PLA:TAY :\ Store drive in CURR+d
3260 .Got3Sectors
3270 RTS
3280 :
3290 .DirToAddr
3300 JSR dirSize:TAY :\ Y=header size from HDR
3310 .DirToAddr2
3320 JSR dirAddr:STA addr+1 :\ addr=>DIR
3330 LDA #0:STA addr+0:RTS :\ Y=HDR size, addr=>DIR, A=0
3340 :
3350 \ Save FSM
3360 \ --------
3370 .SaveFSM
3380 JSR SectFSM :\ sect=FSM
3390 :
3400 \ Save FSM buffer
3410 \ ---------------
3420 .SavePageF
3430 LDA #&0F:STA addr+1 :\ addr=&xxxx0Fxx
3440 LDA #&FF:BNE DiskOneSector :\ Jump to write one sector
3450 :
3460 \ Load to FSM buffer
3470 \ ------------------
3480 .GetToFSM
3490 JSR ClearFSM:LDA #&0F :\ Point to FSM buffer
3500 .GetOneAddr
3510 STA addr+1 :\ Set address to &xxxxAAxx
3520 .GetOneSector
3530 LDA #0 :\ Read one sector to &FFFFxx00
3540 .DiskOneSector
3550 STA action :\ Set Read/Write
3560 LDA #1:STA num:BNE DiskAccIO :\ Access one sector
3570 :
3580 \ Save current directory
3590 \ ----------------------
3600 .SaveThisDir
3610 JSR CURRtoSect:INC HDR+&0D :\ sect=CURR, increment cycle no
3620 .PutDir
3630 JSR DirToAddr :\ addr=>DIR, Y=HDR header size
3640 .PutDirLp
3650 DEY:LDA HDR,Y:STA (addr),Y :\ Copy header back to DIR buffer
3660 CPY #10:BNE PutDirLp
3670 .PutDirNoHdr
3680 LDA #&FF:STA action :\ Write 3 sectors from directory buffer
3690 :
3700 .DiskAccDir3
3710 LDA #3:STA num :\ Transfer 3 sectors
3720 .DiskAccDIR :\ Load/Save to directory buffer
3730 JSR dirAddr:STA addr+1 :\ Point to directory buffer
3740 .DiskAccIO
3750 JSR SetAddrIO :\ addr=&FFFFxx00
3760 \\LDA #&00:\STA addr+0:\STA shadow :\ No shadow access
3770 \\LDA #&FF:\STA addr+2:\STA addr+3 :\ Set address to &FFFFxx00
3780 :
3790 :
3800 \ =================================================================
3810 \ DiskAccess - X,Y preserved, disk errors generate an error
3820 \ DiskAcc - X,Y corrupted, A holds result, EQ=ok
3830 \ =================================================================
3840 \ addr = address, updated after call
3850 \ sect = sector, updated after call
3860 \ drive = drive number
3870 \ num = number of sectors to transfer
3880 \ action= 0=read, FF=write
3890 \ shadow= shadow flags
3900 \ Daddr-6 to Daddr+10 corrupted, plus anything OSWORD &7F corrupts
3910 \ =================================================================
3920 :
3930 .DiskAccess:\ Does this have to preserve registers?
3940 TXA:PHA:TYA:PHA:JSR DiskAcc
3950 BNE DiskErrors
3960 PLA:TAY:PLA:TAX:RTS
3970 :
3980 \ =====================
3990 \ Generate a Disk Error
4000 \ =====================
4010 .DiskErrors
4020 PHA:JSR ScreenOff:PLA :\ Allowed to corrupt A,X,Y,P
4030 .DiskErrorNN
4040 LDX #201:STX &101 :\ Prepare 'Disk Read Only' error
4050 PHA:AND #&1E:LSR A:TAX
4060 LDA DskErrNums-1,X:TAX:LDY #0
4070 .DskErrLp1
4080 INX:INY:LDA Err00-1,X:STA &101,Y
4090 BNE DskErrLp1
4100 PLA:CMP #&12:BEQ DskErrJmp :\ Disk Read Only
4110 LDX &108:BPL DskErr4
4120 STX &101:JSR GetDrvChr:STA &108 :\ Drive x not present
4130 BNE DskErrJmp
4140 .DskErr4
4150 LDX &10D:BPL DskErr5 :\ Not 'Disk error XX'
4160 TAX:JSR HexTopDigit:STA &10D
4170 TXA:JSR HexDigit:STA &10E :\ Store disk error number
4180 .DskErr5:LDX #&FF
4190 .DskErrLp2
4200 INX:INY:LDA DskErrAt,X:STA &100,Y :\ ' at '
4210 BNE DskErrLp2
4220 JSR GetDrvChr:STA &100,Y
4230 LDA #ASC":":STA &101,Y:LDX #2
4240 .DskErrLp3
4250 LDA sect,X:JSR HexTopDigit:STA &102,Y:INY
4260 LDA sect,X:JSR HexDigit:STA &102,Y:INY
4270 DEX:BPL DskErrLp3
4280 .DskErrJmp
4290 JSR ClearDIR:STA &100:STA &102,Y
4300 JMP &100
4310 :
4320 EQUB ErrXX-Err00:\ Disk Error &20
4330 .DskErrNums
4340 EQUB ErrXX-Err00
4350 EQUB ErrXX-Err00:EQUB ErrXX-Err00
4360 EQUB ErrXX-Err00:\EQUB Err08-Err00
4370 EQUB ErrXX-Err00:\EQUB Err0A-Err00
4380 EQUB Err0C-Err00:EQUB Err0E-Err00
4390 EQUB ErrXX-Err00:EQUB Err12-Err00
4400 EQUB Err14-Err00:EQUB Err16-Err00
4410 EQUB Err18-Err00:EQUB ErrXX-Err00
4420 EQUB ErrXX-Err00:EQUB Err1E-Err00
4430 :
4440 .DskErrAt
4450 EQUS " at ":BRK
4460 .Err00
4470 .ErrXX:EQUS "Disk error "+CHR$255+CHR$255:BRK
4480 \.Err08:\EQUS "Clock error/Bad block":\BRK
4490 \.Err0A:\EQUS "Late DMA/Abort":\BRK
4500 .Err0C:EQUS "ID CRC error":BRK
4510 .Err0E:EQUS "Data CRC error":BRK
4520 \EQUS "CRC error":\BRK
4530 .Err12:EQUS "Disk read only":BRK
4540 .Err14:EQUS "Track 0 not found":BRK
4550 .Err16:EQUS "Write fault":BRK
4560 .Err18:EQUS "Sector not found":BRK
4570 .Err1E:EQUS "Drive "+CHR$210+" not present":BRK
4580 :
4590 :
4600 \ ===========================
4610 \ Low level disk access
4620 \ Returns A=disk error, EQ=Ok
4630 \ ===========================
4640 .DiskAcc
4650 .z%:JSR DebugAddress
4660 :]:IF _Debug%=0:z%=P%-z%:P%=P%-z%:O%=O%-z%
4670 LDA num:BEQ AccDrvOk :\ Nothing to transfer
4680 JSR AddrToDaddr :\ Copy addr/sect/num to Daddr block
4690 :
4700 \ Try accessing external driver
4710 \ -----------------------------
4720 LDX drive:CPX #8:BCS AccDrvExt :\ High numbered drives, no INT/EXT flags
4730 LDA BitTable,X :\ Index into external flags
4740 AND DRVEXT:BEQ P%+5:JMP AccDrvInt :\ Ignore external, try internal
4750 :
4760 .AccDrvExt :\ Try accessing external drive
4770 STY Daddr-2:LDA #progID:STA Daddr-1
4780 LDA action:CLC:ADC #2:STA Daddr+9 :\ Fill rest of control block
4790 LDA #90:LDX #(Daddr-2)AND255 :\ Point to control block
4800 JSR OswordY:JSR DaddrToAddr :\ Try external drivers with OSWORD 90
4810 LDA Daddr+9:BEQ AccDrvOk :\ =&00 - Ok
4820 CMP #6:BCS AccDrvOk :\ >=&06 - error
4830 :
4840 LDX drive:CPX #8:BCS AccDrvInt2 :\ High numbered drives, no INT/EXT flags
4850 LDA BitTable,X:ORA DRVEXT:STA DRVEXT:\ No external support, flag it for this drive
4860 :
4870 \ Try accessing internal driver
4880 \ -----------------------------
4890 .AccDrvInt
4900 LDA BitTable,X
4910 AND DRVINT:BNE AccDrvNone :\ Ignore internal driver, exit with 'no drive'
4920 .AccDrvInt2
4930 .z%:CPX #2:BCS P%+5:JMP DrvFloppy :\ Drive 0-1 - floppy
4940 .z%:CPX #4:BCC P%+9:CPX #12:BCS P%+5:JMP DrvIDE :\ Drive 4-B - IDE
4950 :]:IF _NoIDEDrv%:z%=P%-z%:P%=P%-z%:O%=O%-z%
4960 .z%:CPX #ASC"M"-&37:BNE P%+5:JMP DrvMMC :\ Drive M - MMC
4970 :]:IF _NoMMCDrv%:z%=P%-z%:P%=P%-z%:O%=O%-z%
4980 .AccDrvNone
4990 LDA #&FE :\ Return 'Drive not present'
5000 .AccDrvOk
5010 TAX:RTS :\ Set EQ from A and return
5020 :
5030 \ -----------------------
5040 \ Copy transfer addresses
5050 \ -----------------------
5060 .AddrToDaddr
5070 LDY #10:.AddrToLp:LDA addr-1,Y:STA Daddr-1,Y:DEY:BNE AddrToLp:RTS
5080 .DaddrToAddr
5090 LDY #8:.DaddrToLp:LDA Daddr-1,Y:STA addr-1,Y:DEY:BNE DaddrToLp:RTS
5100 :
5110 \ -------------------------
5120 \ Update transfer addresses
5130 \ -------------------------
5140 .UpdateScAd :\ Update sect, addr
5150 PHA:CLC
5160 ADC sect+0:STA sect+0
5170 LDA sect+1:ADC #0:STA sect+1
5180 LDA sect+2:ADC #0:STA sect+2:PLA
5190 .UpdateAddr :\ Update addr
5200 CLC
5210 .UpdateAddrCy :\ Update addr with carry
5220 ADC addr+1:STA addr+1:STA Daddr+1
5230 LDA addr+2:ADC #0:STA addr+2:STA Daddr+2
5240 LDA addr+3:ADC #0:STA addr+3:STA Daddr+3
5250 RTS
5260 :
5270 :
5280 \ =====================
5290 \ FLOPPY DRIVE ROUTINES
5300 \ =====================
5310 .DrvFloppy
5320 LDA sect+2:BNE FlopTooBig :\ Sector>&00FFFF
5330 LDA sect+1:CMP #7:BCS FlopTooBig :\ Sector>&0006FF
5340 LDY #&FF:SEC :\ Prepare to divide by 10
5350 .DskDiv10 :\ Convert Sector to sector&track
5360 INY:LDA Daddr+4:SBC #10:STA Daddr+4
5370 LDA Daddr+5:SBC #0:STA Daddr+5
5380 BCS DskDiv10:LDA Daddr+4:ADC #10 :\ Y=sect DIV 10, A=sect MOD 10
5390 STA Dsec:STY Dtrk:STX Ddrv :\ Initial sector, track, drive
5400 :
5410 \ Daddr, Ddrv, Dtrk, Dsec, num set
5420 \ --------------------------------
5430 .FlopLp :\ Loop for each track
5440 LDA num:PHA:CLC:ADC Dsec:CMP #11 :\ Wrap past end of track?
5450 PLA:BCC FlopNum :\ Single track, no stepping needed
5460 LDA #10:SBC Dsec :\ Number to the end of this track
5470 .FlopNum
5480 ORA #&20:STA Dnum :\ Set number of sectors to transfer
5490 LDA Dtrk:CMP #80:BCC FlopTrk :\ Is track past end of one side?
5500 SBC #80:STA Dtrk :\ Reduce to physical track number
5510 LDX Ddrv:INX:INX:STX Ddrv :\ Set drive to side 2
5520 CPX #4:BCC FlopTrk :\ Not wrapped past end of disk
5530 .FlopTooBig
5540 LDA #&18:RTS :\ Return Sector not found
5550 :
5560 \ Daddr, Ddrv, Dtrk, Dsec, Dnum all set
5570 \ -------------------------------------
5580 .FlopTrk :\ Do a single track
5590 LDA #&53:BIT action:BPL P%+4:LDA #&4B :\ Read or Write command
5600 STA Dcmd:LDY #5 :\ Set command, prepare for five retries
5610 :
5620 .FlopRetry
5630 TYA:PHA :\ Save retries
5640 LDA Ddrv:LDY #4 :\ Prepare to save drive
5650 .FlopSave1
5660 STA Ddrv+27,Y:LDA Ddrv+5,Y :\ Save control block
5670 DEY:BPL FlopSave1:LDY #15
5680 .FlopSave2
5690 LDA &C0,Y:PHA:LDA &B0,Y :\ Save workspace
5700 STA Daddr+10,Y:DEY:BPL FlopSave2
5710 :
5720 \\LDA &256:\PHA:\STY &256 :\ Save and disable Spool and Exec
5730 \\LDA &257:\PHA:\STY &257 :\ Don't need to do this if not selecting DFS
5740 LDA OPTFLG:PHA
5750 JSR EnableDFS:PHA :\ If DFS 2.45, enable OSWORD &7F with Y=&FF
5760 :
5770 LDA #&03:STA Dcmd-1 :\ Three parameters
5780 LDA #&FE:STA Dres :\ Preload with 'not present'
5790 JSR Osword7F:LDX Dres :\ Call floppy access, get result
5800 BEQ FlopNoSeek:BPL FlopCallOk :\ Result changed, call actioned
5810 \\PLA:\ORA #16:\PHA:\BNE FlopNoSeek :\ No DFS, set NoDFS flag in stacked OPTFLG
5820 LDA #16:JSR IntoOPTFLG:BNE FlopNoSeek :\ No DFS, set NoDFS flag in OPTFLG
5830 .FlopCallOk
5840 CPX #&10:BEQ FlopNoSeek :\ Drive not ready, don't reseek
5850 CPX #&12:BEQ FlopNoSeek :\ Drive read only, don't reseek
5860 TXA:PHA :\ Save result
5870 LDX drive:STX Ddrv:LDX #&69:STX Dcmd:\ Set up 'Seek track 0'
5880 LDX #&01:STX Dcmd-1:DEX:STX Dtrk
5890 JSR Osword7F:PLA:TAX :\ Seek zero, restore result
5900 :
5910 .FlopNoSeek
5920 PLA:TAY:PLA:JSR EnableDFS :\ If DFS 2.45, restore OSWORD &7F
5930 \\STA OPTFLG
5940 \\PLA:\STA &257:\PLA:\STA &256 :\ Restore Spool and Exec
5950 :
5960 LDY #0
5970 .FlopRest1
5980 LDA Daddr+10,Y:STA &B0,Y:STA Daddr,Y :\ Restore workspace and Daddr
5990 PLA:STA &C0,Y:INY:CPY #16:BNE FlopRest1
6000 .FlopRest2
6010 LDA Ddrv+11,Y:STA Dcmd-16,Y:INY:CPY #21 :\ Restore control block
6020 BNE FlopRest2:STA Ddrv
6030 :
6040 PLA:TAY:TXA:BEQ FlopNext :\ Restore retries, get result
6050 CMP #&10:BEQ FlopRetryJmp :\ DriveNotReady - always ignore
6060 CMP #&12:BEQ FlopExit :\ DiskProtected - exit
6070 DEY:BEQ FlopExit :\ Exit if retries=0
6080 .FlopRetryJmp
6090 JMP FlopRetry :\ Retry this disk access
6100 .FlopExit
6110 TAX:RTS :\ Set EQ flag from result
6120 :
6130 .FlopNext
6140 STA Dsec:INC Dtrk :\ Step to next track, sector 0
6150 LDA Dnum:AND #31:PHA:JSR UpdateScAd:\ Update three addresses
6160 PLA:EOR #&FF:SEC:ADC num:STA num :\ Decrease NUM by amount transfered
6170 BEQ FlopExit:JMP FlopLp :\ Loop for all tracks
6180 :
6190 .Osword7F
6200 LDA #&7F:LDX #Ddrv AND 255
6210 .OswordY
6220 LDY #Ddrv DIV 256:JMP OSWORD
6230 :
6240 \ EnableDFS - Enable OSWORD &7F on Master MOS 3.50
6250 \ ------------------------------------------------
6260 \ Running on a Master, so able to use 65C02 opcodes
6270 .EnableDFS
6280 BPL EnableDFSok :\ b7=0, patch not needed
6290 AND #15:CMP &F4:BEQ EnableDFSok :\ ROM=HADFS, not DFS patch
6300 EQUB &DA:TAX:LDA &DF0,X:STA addr+1 :\ PHX, Find DFS workspace
6310 LDA #&D4:STA addr+0 :\ Point to 'OSWORD enable' flag
6320 EQUB &B2:EQUB addr:TAX:TYA :\ LDA (addr) - get old flag
6330 EQUB &92:EQUB addr:TXA:EQUB &FA :\ STA (addr) - set new flag, PLX
6340 .EnableDFSok
6350 RTS
6360 :
6370 :
6380 \ ==================
6390 \ IDE DRIVE ROUTINES
6400 \ ==================
6410 .IDEAbsent
6420 LDA #254:RTS :\ No IDE present
6430 :
6440 .DrvIDE
6450 LDX #4:.IDETest
6460 DEX:BMI IDEAbsent :\ Test up to four times
6470 LDA IDEstatus:AND #&FC:CMP #&FC:BEQ IDETest:\ See if IDE present
6480 LDA IDEstatus:BMI P%-3 :\ Wait until IDE not busy
6490 LDA #64:STA IDEcount:STA IDEsector :\ 64 sectors per track
6500 LDA #15:JSR IDESetHead :\ 16 heads
6510 LDA #&91:STA IDEcommand :\ Set geometry
6520 LDA IDEstatus:BMI P%-3 :\ Wait until IDE not busy
6530 CMP #&50:BNE IDETest :\ Loop until Ready+Done
6540 :
6550 .IDELoop
6560 LDX #2:.IDETwice
6570 LDA addr+3:CMP #&FF:BEQ IDEStart :\ I/O memory
6580 LDA #&FF:BIT &27A:BPL IDEStart :\ No Tube
6590 TXA:PHA
6600 LDA action:AND #1:EOR #7:\\EOR #1 :\ 6/7=256-byte transfer
6610 JSR TubeClaimDo:PLA:TAX:LDA #0 :\ Claim Tube for transfer
6620 .IDEStart
6630 \ A=&FF - I/O memory
6640 \ A=&FF - No Tube, use I/O
6650 \ A=&00 - Tube
6660 PHA :\ Save Tube flag
6670 :
6680 LDA IDEstatus:BMI P%-3 :\ Wait until IDE not busy
6690 LDA num:PHA:LDY #2 :\ Use num as workspace
6700 .IDElp
6710 LDA sect+2-2,Y:LSR A:LSR A:STA num :\ sect.b18-b23, sect.b10-b15
6720 LDA sect+3-2,Y:ROR A:ROR A:ROR A :\ drive.b1-b2, sect.b16-b17
6730 :
6740 \\DEY:\BEQ P%+5:\ROR A:\EOR #&80 :\ Invert drive.b2
6750 \\AND #&C0:\ORA num:\STA IDEcylinder+1-1,Y:\ Set cylinder
6760 \\TYA:\BNE IDElp
6770 :
6780 AND #&C0:ORA num:STA IDEcylinder-1,Y :\ Set cylinder
6790 DEY:BNE IDElp
6800 LDA sect+0:ROL A:ROL A:ROL A:AND #&03:STA num :\ sect.b6-b7
6810 LDA sect+1:ASL A:ASL A:AND #&0C:ORA num :\ sect.b8-b9
6820 JSR IDESetHead:CLC
6830 LDA sect+0:AND #63:ADC #1:STA IDEsector :\ sect.b0-b5
6840 LDA #1:STA IDEcount :\ One sector at a time
6850 PLA:STA num :\ Restore num
6860 :
6870 LDA action:ROR A :\ CC=read, CS=write
6880 AND #&10:ORA #&20:STA IDEcommand :\ Create IDE command byte
6890 .IDEWait
6900 LDA IDEstatus:BMI P%-3:BEQ IDENotPresent :\ Wait until IDE not busy, if Status=&00 Drive absent
6910 TAY:AND #&21:BNE IDEError :\ Error occured
6920 :
6930 \\LDY IDEstatus:\INY:\BEQ IDENotPresent :\ Status=&FF - Interface absent
6940 \\DEY:\BMI IDEWait:\BEQ IDENotPresent :\ Wait until BSY=0, if Status=&00 - Drive absent
6950 \\\\LDA IDEstatus:\BMI IDEWait :\ Wait for not busy
6960 \\\\AND #&40:\BNE P%+5:\JMP IDENotPresent:\ No drive
6970 \\TYA:\AND #&21:\BNE IDEError :\ Check if not found
6980 :
6990 TYA:AND #8:BEQ IDEWait:LDY #0 :\ Wait for DRQ
7000 PLA:PHA:BPL IDETube:BCC IDEIORead :\ Get Tube flag
7010 :
7020 .IDEIOWrite :\ Write 256 byte from I/O
7030 LDA (addr),Y:STA IDEdata:INY:BNE IDEIOWrite:BEQ IDENext
7040 .IDEIORead :\ Read 256 to I/O
7050 LDA IDEdata:STA (addr),Y:INY:BNE IDEIORead:BEQ IDENext
7060 :
7070 .IDETube
7080 JSR TubeW2:BCS IDETubeWrite :\ Requires >20cycles/byte
7090 .IDETubeRead :\ Read 256 bytes from Tube, 23cycles/byte
7100 LDA IDEdata:STA &FEE5:INY:BNE IDETube:BEQ IDENext
7110 .IDETubeWrite :\ Write 256 bytes from Tube, 24cycles/byte
7120 LDA &FEE5:STA IDEdata:INY:BNE IDETube:\BEQ IDENext
7130 :
7140 .IDENext
7150 LDA IDEstatus:AND #&21:BNE IDEError :\ Error occured
7160 PLA:DEX:BEQ P%+5:JMP IDETwice :\ Do each action twice
7170 TAY:LDA #1:JSR UpdateScAd :\ Update sect and addr
7180 DEC num:BEQ P%+5:JMP IDELoop :\ Loop for each sector, X=0 when done
7190 .IDEDone
7200 TYA:BMI P%+5:JSR TubeRelease
7210 TXA:RTS :\ A=result, EQ=Ok
7220 :
7230 .IDESetHead
7240 \\PHA:\LDA drive:\LSR A:\PLA :\ Move odd drives to Cy
7250 PHA:LDA drive:CMP #8:PLA :\ Move drive 8-B to Cy
7260 BCC P%+4:ORA #&10 :\ drive.b0
7270 STA IDEhead:RTS
7280 :
7290 .IDENotPresent
7300 LDX #&FE:BNE IDEError2 :\ Becomes 'IDE not present'
7310 .IDEError
7320 LDX #&16:AND #&20:BNE IDEError2 :\ Status &20 becomes &16 'Write error'
7330 LDA IDEerror:CMP #&10:BNE IDEError1 :\ Not 'sector not found'
7340 LDX sect+2:BNE IDEError1 :\ Not low numbered sector
7350 LDX sect+1:BEQ IDENotPresent :\ Convert to 'not present'
7360 .IDEError1
7370 LDX #8
7380 .IDEErrLp
7390 ASL A:DEX:BCC IDEErrLp:LDA IDEErrs,X:TAX :\ Convert IDE error
7400 .IDEError2
7410 PLA:TAY:JMP IDEDone :\ Return IDE result
7420 .IDEErrs
7430 EQUD &1C0A140C:EQUD &080E1A18 :\ Translated IDE errors
7440 \ IDE errors Disk errors
7450 \ &20xx Write error -> &16 Write error
7460 \ &80 Bad block -> &08 Disk error 08
7470 \ &40 Uncorrectable error -> &0E Data CRC error
7480 \ &20 Media changed -> &1A Disk error 1A
7490 \ &10 Sector not found -> &18 Sector not found
7500 \ &08 Media Change Request -> &1C Disk error 1C
7510 \ &04 Abort -> &0A Disk error 0A
7520 \ &02 Track 0 not found -> &14 Track 0 not found
7530 \ &01 Address mark not found -> &0C ID CRC error
7540 \
7550 :]:IF _NoIDEDrv%:z%=P%-IDEAbsent:P%=P%-z%:O%=O%-z%
7560 :
7570 :
7580 \ =================
7590 \ MMC DRIVE ROUTINE
7600 \ =================
7610 .DrvMMC :\ GoMMC driver
7620 LDA OPTFLG:BPL DrvMMCa :\ Not disabled
7630 AND #15:CMP &F4:BEQ MMCabsent :\ Avoid DFS090 OSWORD bug
7640 .DrvMMCa
7650 LDY #5 :\ Move sect up a bit
7660 .MMClp
7670 LDA Daddr+3,Y:STA Daddr+4,Y:DEY:BNE MMClp
7680 STY Daddr+11:STY Daddr+10:STY Daddr+8 :\ Length=&0000nn00
7690 STY Daddr+4:INY:STY Daddr-1 :\ MMCaddr=&xxxxxx00
7700 LDA action:AND #1:STA Daddr-3 :\ Command 0/1 for read/write
7710 LDA #&03:STA Daddr-4
7720 LDA #&12:STA Daddr-5:STA Daddr-6 :\ Fill rest of control block
7730 LDX #(Daddr-6)AND255:LDA #&B0:JSR OswordY:\ Call MMC driver
7740 LDA Daddr-1:CMP #&01:BEQ MMCabsent :\ Not found
7750 LDA num:JSR UpdateScAd:LDA #0:RTS :\ Return OK
7760 .MMCabsent
7770 LDA #&FE:RTS :\ Return DriveAbsent
7780 :]:IF _NoMMCDrv%:z%=P%-DrvMMC:P%=P%-z%:O%=O%-z%
7790 :
7800 :
7810 .z%
7820 .DebugAddress
7830 LDA action:AND #5
7840 EOR #ASC"r":JSR OSWRCH
7850 LDA addr+3:JSR PrHex
7860 LDA addr+2:JSR PrHex
7870 LDA addr+1:JSR PrHex
7880 LDA addr+0:JSR PrHex
7890 LDA #ASC"+":JSR OSWRCH
7900 LDA num:JSR PrHex
7910 LDA #ASC":":JSR OSWRCH
7920 :
7930 .DebugSector
7940 LDA sect+3:JSR PrHex
7950 LDA sect+2:JSR PrHex
7960 LDA sect+1:JSR PrHex
7970 LDA sect+0:JSR PrHex
7980 JMP OSNEWL
7990 :
8000 .DebugStart
8010 LDA start+2:JSR PrHex
8020 LDA start+1:JSR PrHex
8030 LDA start+0:JSR PrHex
8040 JMP OSNEWL
8050 :
8060 .DebugCURR
8070 LDA CURR+3:JSR PrHex
8080 LDA CURR+2:JSR PrHex
8090 LDA CURR+1:JSR PrHex
8100 LDA CURR+0:JSR PrHex
8110 JMP OSNEWL
8120 :
8130 :]:IF _Debug%=0:z%=P%-z%:P%=P%-z%:O%=O%-z%
8140 :
8150 .DriveDispatch
8160 \EQUB ASC"0"-&30:\EQUB ASC"1"-&30:\EQUW DrvFloppy
8170 \EQUB ASC"4"-&30:\EQUB ASC"B"-&37:\EQUW DrvIDE
8180 \EQUB ASC"M"-&37:\EQUB ASC"M"-&37:\EQUW DrvMMC
8190 EQUB &FF
8200 :
8210 EQUB 13
8220 EQUS base$:EQUB 13
8230 .y%:EQUS "0:1:Floppy":EQUB 13
8240 .z%:EQUS "4:B:IDE24":EQUB 13:]:IF _NoIDEDrv%:z%=P%-z%:P%=P%-z%:O%=O%-z%
8250 .z%:EQUS "M:M:GoMMC":EQUB 13:]:IF _NoMMCDrv%:z%=P%-z%:P%=P%-z%:O%=O%-z%
8260 :]:IF P%>&C000:y%=P%-y%:P%=P%-y%:O%=O%-y%
8270 :]:IF P%<&C000:PRINT"EQUS STRING$(";&C000-P%;",CHR$&FF)":FOR z%=0TO&C000-P%:?O%=&FF:O%=O%+1:NEXT
8280 :
8290 ]
8300 PRINT CHR$11;STRING$(20,CHR$9);(O%-mcode%)DIV1024":";(O%-mcode%)MOD1024" Kbytes"
8310 PRINT"PAGE=&";~PAGE;" TOP=&";~TOP;" LOMEM=&";~LOMEM
8320 PRINT"VARTOP=&";~!2 AND&FFFF;" STKEND=&";~!4 AND&FFFF;" HIMEM=&";~HIMEM
8330 PRINT"Variable length: ";(!2-LOMEM)AND&FFFF;" bytes"
8340 PRINT"Free memory: ";(!4-!2)AND&FFFF;" bytes"
8350 OSCLI"SAVE ROMc "+STR$~(mcode%)+" "+STR$~(O%)+" 3000 "+STR$~(Block%-&5000)
8360 VDU7:A%=TIME-T%:IF O%>L%:L%=O%
8370 PRINT"Assembly done in ";(A%DIV6000);"m";RIGHT$("0"+STR$((A%DIV100)MOD60),2)"s"
8380 PRINT"Now do:"'"*LOAD ROMa"'"*LOAD ROMb"'"*LOAD ROMc"'"*SAVE ROM 3000+";~P%-&8000;" FFFF0000 FFFBBC00"