REM >HADFS3 v5.40
REM v5.27 Internal/External drives and cleaner floppy access
REM       Need to expand SECT and hold addr in zeropage for (addr),Y use
REM v5.29 GoMMC driver on drive 'M'
REM v5.30 IDE driver on drive 4,5
REM       This section now includes DiskMainLoop and Tube code
REM       SetContext checks drives for default mounting
REM v5.33 IDE uses 24-bit access
REM v5.40 16-bit/24-bit IDE configurable on assembly
:
IDEcount=&FC42:IDEsector=&FC43:IDEcylinder=&FC44:IDEhead=&FC46
IDEstatus=&FC47:IDEcommand=&FC47:IDEerror=&FC41:IDEdata=&FC40
:
PRINT"Assembling S.HADFS3"
REM P%=hadfs3
O%=P%-Block%+mcode%
[OPT0
.NotOsw90:LDA #8:RTS
.Osword90
LDY #11:LDA (&F0),Y:BPL NotOsw90     :\ cmd<&80, ignore
CMP #&82:BCS NotOsw90                :\ cmd>&81, ignore
LDY #0:LDA (&F0),Y:BNE NotOsw90      :\ First byte must be &00
INY:LDA (&F0),Y:CMP #6:BNE NotOsw90  :\ Second byte must be &06
\LDY #11:\LDA (&F0),Y:\BPL NotOsw90
\CMP #&82:\BCS NotOsw90
LDA &F0:PHA:LDA &F1:PHA:\LDY #2      :\ Save OSWORD pointer
.DoOsw90lp1
INY:LDA (&F0),Y:STA addr-2,Y         :\ Copy supplied addr
CPY #5:BNE DoOsw90lp1
\INY:\CPY #6:\BNE DoOsw90lp1
.DoOsw90lp2
INY:LDA (&F0),Y:STA start-6,Y        :\ Copy supplied sect
CPY #8:BNE DoOsw90lp2:INY
\INY:\CPY #9:\BNE DoOsw90lp2
LDA (&F0),Y:STA drive:INY
LDA (&F0),Y:STA len+1:INY
LDA #0:STA len+2:TAX                 :\ Transfer &00xx00 bytes
LDA (&F0),Y:CMP #&80:BEQ P%+3:DEX    :\ &80/&81 -> &00/&FF
\LDX #&FF:\LDA (&F0),Y:\CMP #&81
\BEQ DoOsw90_Go:\INX
\.DoOsw90_Go
STX action:JSR CheckAddr
SEC:JSR DiskMainOsw:TAX
PLA:STA &F1:PLA:STA &F0:LDY #2       :\ Restore OSWORD pointer
.DoOsw90lp3:\.DoOsw90lp2
LDA addr-2,Y:STA (&F0),Y
INY:CPY #6:BNE DoOsw90lp3:\BNE DoOsw90lp2
::\INY:\CPY #10:\BNE DoOsw90lp3
LDA len+1:LDY #10:STA (&F0),Y
TXA:INY:STA (&F0),Y
LDA #0:RTS
:
.ClearFSM:.Clear26
LDA CHN26:AND #&FE:STA CHN26:RTS :\ Clear Ch26 buffer
:
.ClearDIR
LDA #0:STA CURR+0:STA CURR+1:STA CURR+2:STA CURR+d
RTS
:
.AddrToDaddr
LDY #10:.AddrToLp:LDA addr-1,Y:STA Daddr-1,Y:DEY:BNE AddrToLp:RTS
.DaddrToAddr
LDY #8:.DaddrToLp:LDA Daddr-1,Y:STA addr-1,Y:DEY:BNE DaddrToLp:RTS
:
\ GetDir, PutDir, LoadFSM, SaveFSM should preserve addr
.GetDirX                             :\ Fetch directory from CSD,X
JSR DIRtoSect
.GetDir                              :\ Fetch directory in sect/drive
LDA sect+0:CMP CURR+0:BNE Get3Sectors
LDA sect+1:CMP CURR+1:BNE Get3Sectors
LDA sect+2:CMP CURR+2:BNE Get3Sectors
LDA drive:CMP CURR+d:BEQ Got3Sectors :\ Directory already in memory
.Get3Sectors
JSR ClearDIR:STA action:LDA #3:STA num
TYA:PHA:LDY #7                       :\ Save Y
.GetDirLp1
LDA addr,Y:PHA:DEY:BPL GetDirLp1     :\ Save addr, sect
JSR DiskAccDIR:LDY #0                :\ Load to directory buffer
.GetDirLp2
PLA:STA addr,Y:INY:CPY #4:BNE GetDirLp2   :\ Restore addr
.GetDirLp3
PLA:STA CURR-4,Y:INY:CPY #8:BNE GetDirLp3 :\ Restore sect to CURR
::\STA CURR+d:PLA:TAY                :\ Store drive in CURR+d
.Got3Sectors
RTS
:
.GetToFSM:\.Get1Chunk
JSR ClearFSM:LDA #&F                 :\ Point to FSM buffer
.GetOneAddr
STA addr+1                           :\ Set address to &xxxxAAxx
.GetOneSector:.GetOnePage
LDA #0:STA action                    :\ Read one sector
.DiskOneSector
LDA #1:STA num:BNE DiskAccIO         :\ Access one sector
:
.DiskAccDIR                         :\ Load/Save to directory buffer
LDA #&11:STA addr+1                 :\ Point to directory buffer
.DiskAccIO:.DiskAccDIR2
LDA #0:STA addr+0:STA shadow        :\ No shadow access
LDA #&FF:STA addr+3:STA addr+2      :\ Set address to &FFFFxx00
:
\ Save addr,sect
\ JSR DiskAccess
\ Restore addr,sect
\ RTS
:
:
.DiskAccess
\ DiskAccess - X,Y preserved, disk errors generate an error
\ DiskAcc    - X,Y corrupted, A holds result, EQ=ok
:
\ addr  = address, updated after call
\ sect  = sector, updated after call
\ drive = drive number
\ num   = number of sectors to transfer
\ action= 0=read, FF=write
\ shadow= shadow flags
\ Daddr-6 to Daddr+10 corrupted, plus anything OSWORD &7F corrupts
:
TXA:PHA:TYA:PHA:JSR DiskAcc
\PHA:\JSR PrHex:\PLA
BEQ P%+5:JMP DiskErrors
PLA:TAY:PLA:TAX
.DskZero
RTS
:
.DiskAcc
LDA num:BEQ DskZero:\LDY #10         :\ Nothing to transfer
\.DskInit
\LDA addr-1,Y:\STA Daddr-1,Y:\DEY      :\ Copy block to Daddr block
\BNE DskInit:\STY Daddr-2
JSR AddrToDaddr:STY Daddr-2         :\ Copy block to Daddr block
:
LDA DRVINT:EOR &28F                 :\ Get keyboard link
AND #&BF:EOR &28F:EOR #64:STA DRVINT:\ Copy to *Opt7,1 flag
LDX drive:CPX #8:BCS AccDrvExt      :\ High numbered drives all external
LDA BitTable,X                      :\ Index into external flags
AND DRVEXT:BEQ P%+5:JMP AccDrvInt   :\ Ignore external, try internal
:
.AccDrvExt                          :\ Try accessing external drive
LDA #progID:STA Daddr-1
LDA action:CLC:ADC #2:STA Daddr+9   :\ Fill rest of control block
LDA #90:LDX #(Daddr-2)AND255        :\ Point to control block
JSR OswordY:JSR DaddrToAddr         :\ Try external drivers with OSWORD 90
LDA Daddr+9:BEQ AccDrvExtOk
CMP #8:BCS AccDrvExtOk
LDX drive:CPX #8:BCS AccDrvExtNone
LDA BitTable,X:ORA DRVEXT:STA DRVEXT     :\ Flag no external drive
LDA BitTable,X:AND DRVINT:BEQ AccDrvInt2 :\ Ok to try internal drive
.AccDrvExtNone:LDA #&FE                  :\ Return 'no drive'
.z%
CPX #12:BCS P%+9:CPX #8:BCC P%+5:JMP DiskIDE
:]:IF _NoIDEDrv%:z%=P%-z%:P%=P%-z%:O%=O%-z%
.z%
CPX #ASC"M"-&37:BNE P%+5:JMP DiskMMC
:]:IF _NoMMCDrv%:z%=P%-z%:P%=P%-z%:O%=O%-z%
.AccDrvExtOk  :RTS
:
\ Look at merging both bits of DRVINT code
.AccDrvInt                          :\ Try to access internal drive
LDA BitTable,X                      :\ Index into internal flags
AND DRVINT:BEQ P%+5:JMP AccDrvExt   :\ Force to use external drive
.AccDrvInt2
.z%
CPX #8:BCS P%+9:CPX #4:BCC P%+5:JMP DiskIDE
:]:IF _NoIDEDrv%:z%=P%-z%:P%=P%-z%:O%=O%-z%
CPX #2:BCS AccDrvExtNone            :\ Only drive 0 and 1 at the moment
:
\.DskFloppy
LDA sect+2:BNE FlopTooBig          :\ Sector>&00FFFF
LDA sect+1:CMP #7:BCS FlopTooBig   :\ Sector>&0006FF
\LDA drive:\STA Ddrv:LDY #&FF:SEC
.DskDiv10                          :\ Convert Sector to sector&track
INY:LDA Daddr+4:SBC #10:STA Daddr+4
LDA Daddr+5:SBC #0:STA Daddr+5
BCS DskDiv10:LDA Daddr+4:ADC #10   :\ Y=sect DIV 10, A=sect MOD 10
STA Dsec:STY Dtrk:STX Ddrv         :\ Initial sector, track, drive
:
\ Daddr, Ddrv, Dtrk, Dsec, num set
:
.FlopLp                            :\ Loop for each track
LDA num:PHA:CLC:ADC Dsec:CMP #11   :\ Wrap past end of track?
PLA:BCC FlopNum                    :\ Single track, no stepping needed
LDA #10:SBC Dsec                   :\ Number to the end of this track
.FlopNum
ORA #&20:STA Dnum                  :\ Set number of sectors to transfer
LDA Dtrk:CMP #80:BCC FlopTrk       :\ Is track past end of one side?
SBC #80:STA Dtrk                   :\ Reduce to physical track number
\INC Ddrv:\INC Ddrv:\LDA Dtrk      :\ Step drive to size 2
\CMP #4:\BCC FlopTrk               :\ Not wrapped past end of disk
LDX Ddrv:INX:INX:STX Ddrv          :\ Set drive to side 2
CPX #4:BCC FlopTrk                 :\ Not wrapped past end of disk
.FlopTooBig
LDA #&18:RTS                       :\ Return Sector not found
:
\ Daddr, Ddrv, Dtrk, Dsec, Dnum all set
:
.FlopTrk                           :\ Do a single track
LDA #&53:BIT action:BPL P%+4:LDA #&4B :\ Read or Write command
STA Dcmd:\\LDA #3:\STA Dcmd-1:LDY #5     :\ Set command, five retries
:
.FlopRetry
TYA:PHA                             :\ Save retries
:
.z%
LDA Ddrv:LDY #4                     :\ Prepare to save drive
.FlopSave1
PHA:LDA Ddrv+5,Y:DEY:BPL FlopSave1  :\ Save control block
LDY #16
.FlopSave2
LDA &C0-1,Y:PHA:LDA &B0-1,Y:PHA     :\ Save workspace
DEY:BNE FlopSave2
:]:IFWS<>&1000:z%=P%-z%:P%=P%-z%:O%=O%-z%
:
.z%
LDA Ddrv:LDY #4                     :\ Prepare to save drive
.FlopSave1
STA Ddrv+27,Y:LDA Ddrv+5,Y          :\ Save control block
DEY:BPL FlopSave1:LDY #16
.FlopSave2
LDA &C0-1,Y:PHA:LDA &B0-1,Y         :\ Save workspace
STA Daddr+9,Y:DEY:BNE FlopSave2
:]:IFWS=&1000:z%=P%-z%:P%=P%-z%:O%=O%-z%
:
\\.FlopSave
\\LDA &C0-1,Y:\PHA:\LDA &B0-1,Y:\PHA     :\ Save workspace
\\.z%
\\LDA Ddrv-1,Y:\PHA                      :\ Save control block
\\:\]:\IFWS<>&1000:\z%=P%-z%:\P%=P%-z%:\O%=O%-z%
\\.z%
\\LDA Ddrv-6,Y:\STA Ddrv+10,Y            :\ Save control block
\\:\]:\IFWS=&1000:\z%=P%-z%:\P%=P%-z%:\O%=O%-z%
\\DEY:\BNE FlopSave
:
LDA &256:PHA:STY &256               :\ Save and disable Spool and Exec
LDA &257:PHA:STY &257
.z%
LDA &10D3:PHA:LDA &10D5:PHA:LDA &10D6:PHA :\ Osword7F corrupts these
:]:IFWS<>&1000:z%=P%-z%:P%=P%-z%:O%=O%-z%
LDA OPTFLG:PHA
BPL P%+5:JSR CheckForDFS            :\ If MOS 3.50, select DFS
:
LDA #3:STA Dcmd-1
JSR Osword7F                        :\ Call floppy access
CPX #&FF:BEQ FlopNoSeek             :\ No floppy code available
LDX Dres:BEQ FlopNoSeek             :\ Result OK, don't reseek
CPX #&10:BEQ FlopNoSeek             :\ Drive not ready, don't reseek
CPX #&12:BEQ FlopNoSeek             :\ Drive read only, don't reseek
TXA:PHA                             :\ Save result
LDX drive:STX Ddrv:LDX #&69:STX Dcmd:\ Set up 'Seek track 0'
LDX #&01:STX Dcmd-1:DEX:STX Dtrk
JSR Osword7F:PLA:TAX                :\ Seek zero, restore result
.FlopNoSeek
:
PLA:STA OPTFLG:BPL FlopSelect
TXA:PHA:JSR fx143go:PLA:TAX         :\ If MOS 3.50 reselect HADFS
.FlopSelect
.z%
PLA:STA &10D6:PLA:STA &10D5:PLA:STA &10D3 :\ Osword7F corrupts these
:]:IFWS<>&1000:z%=P%-z%:P%=P%-z%:O%=O%-z%
PLA:STA &257:PLA:STA &256:LDY #0    :\ Restore Spool and Exec
:
.z%
.FlopRest1
PLA:STA &B0,Y:STA Daddr,Y           :\ Restore workspace and Daddr
PLA:STA &C0,Y:INY:CPY #16:BNE FlopRest1
.FlopRest2
PLA:STA Dcmd-16,Y:INY:CPY #20:BNE FlopRest2
PLA:STA Ddrv
:]:IFWS<>&1000:z%=P%-z%:P%=P%-z%:O%=O%-z%
:
.z%
.FlopRest1
LDA Daddr+10,Y:STA &B0,Y:STA Daddr,Y :\ Restore workspace and Daddr
PLA:STA &C0,Y:INY:CPY #16:BNE FlopRest1
.FlopRest2
LDA Ddrv+11,Y:STA Dcmd-16,Y:INY:CPY #21 :\ Restore control block
BNE FlopRest2:STA Ddrv
:]:IFWS=&1000:z%=P%-z%:P%=P%-z%:O%=O%-z%
:
\\.FlopRest
\\.z%
\\PLA:\STA Ddrv,Y                      :\ Restore control block
\\:\]:\IFWS<>&1000:\z%=P%-z%:\P%=P%-z%:\O%=O%-z%
\\.z%
\\LDA Ddrv+11,Y:\STA Ddrv-5,Y          :\ Restore control block
\\:\]:\IFWS=&1000:\z%=P%-z%:\P%=P%-z%:\O%=O%-z%
\\PLA:\STA &B0,Y:\PLA:\STA &C0,Y       :\ Restore workspace
\\INY:\CPY #16:\BNE FlopRest
:
PLA:TAY:TXA:BEQ FlopNext            :\ Restore retries, get result
CMP #&10:BEQ FlopRetryJmp           :\ DriveNotReady - always ignore
CMP #&12:BEQ FlopExit               :\ DiskProtected - exit
DEY:BEQ FlopExit                    :\ Exit if retries=0
.FlopRetryJmp
JMP FlopRetry                       :\ Retry this disk access
.FlopExit
CMP #0:RTS                          :\ Set EQ flag
:
.FlopNext
STA Dsec:INC Dtrk                   :\ Step to next track, sector 0
LDA Dnum:AND #31:PHA:JSR UpdateDAddr:\ Update three addresses
PLA:EOR #&FF:SEC:ADC num:STA num    :\ Decrease NUM by amount transfered
BEQ FlopExit:JMP FlopLp             :\ Loop for all tracks
:
.Osword7F
LDA #&7F:LDX #Ddrv AND 255
.OswordY
LDY #Ddrv DIV 256:JMP OSWORD
:
.z%
\ ------------------
\ IDE DRIVE ROUTINES
\ ------------------
.IDEAbsent
LDA #254:RTS                               :\ No IDE present
:
.DiskIDE
\CPX #6:\BCS IDEAbsent                     :\ Just 4 and 5 at the moment
LDX #4:.IDETest
DEX:BEQ IDEAbsent                          :\ Test up to four times
LDA IDEstatus:AND #&FE:CMP #&FE:BEQ IDETest:\ See if IDE present
LDA IDEstatus:BMI P%-3                     :\ Wait until IDE not busy
LDA #64:STA IDEcount:STA IDEsector         :\ 64 sectors per track
LDA drive:ROL A                            :\ 16-bit device number
.z%
ROL A:ROL A:ROL A                          :\ 24-bit device number
:]:IF _IDEdrv16%:z%=P%-z%:P%=P%-z%:O%=O%-z%
AND #&10:ORA #3:STA IDEhead                :\ 4 heads
LDA #&91:STA IDEcommand                    :\ Set geometry
:
.IDELoop
LDX #2:.IDETwice
LDA addr+3:CMP #&FF:BEQ IDEStart           :\ I/O memory
LDA #&FF:BIT &27A:BPL IDEStart             :\ No Tube
TXA:PHA
LDA action:AND #1:EOR #1:JSR TubeClaimDo   :\ Claim Tube for transfer
PLA:TAX:LDA #0
.IDEStart
\ A=&FF - I/O memory
\ A=&FF - No Tube, use I/O
\ A=&00 - Tube
PHA                                      :\ Save Tube flag
:
LDA IDEstatus:BMI P%-3                   :\ Wait until IDE not busy
CLC:LDA #1:STA IDEcount                  :\ One sector at a time
LDA sect+0:AND #63:ADC #1:STA IDEsector  :\ Pass 3-byte sector to IDE
LDA drive:ROR A                          :\ 24-bit access, drive 4/5
.z%
ROR A:ROR A:ROR A                        :\ 16-bit access, drive 4/8
:]:IF NOT_IDEdrv16%:z%=P%-z%:P%=P%-z%:O%=O%-z%
PHP:LDA sect+0:ROR A:ROR A:PLP:ROR A     :\ Join drive to head
ROR A:ROR A:ROR A:AND #&13:STA IDEhead   :\ Set device and head
LDA sect+1:STA IDEcylinder+0             :\ Set cylinder
.z%
LDA sect+2:STA IDEcylinder+1             :\ 24-bit disk access
:]:IF _IDEdrv16%:z%=P%-z%:P%=P%-z%:O%=O%-z%
.z%
LDA drive:AND #3:STA IDEcylinder+1       :\ 16-bit disk access
:]:IF NOT_IDEdrv16%:z%=P%-z%:P%=P%-z%:O%=O%-z%
:
:
LDA action:ROR A                         :\ CC=read, CS=write
AND #&10:ORA #&20:STA IDEcommand         :\ Create IDE command byte
.IDEW
LDA IDEstatus:BMI IDEW                   :\ Wait for not busy
AND #&40:BNE P%+5:JMP IDENotPresent      :\ No drive
LDA IDEstatus:AND #&21:BNE IDEError      :\ Check if not found
LDA IDEstatus:AND #8:BEQ IDEW:LDY #0
PLA:PHA:BPL IDETube:BCC IDEIORead        :\ Get Tube flag
:
.IDEIOWrite                              :\ Write 256 byte from I/O
LDA (addr),Y:STA IDEdata:INY:BNE IDEIOWrite:BEQ IDENext
.IDEIORead                               :\ Read 256 to I/O
LDA IDEdata:STA (addr),Y:INY:BNE IDEIORead:BEQ IDENext
:
.IDETube
JSR TubeWait:BCC IDETubeRead
.IDETubeWrite                            :\ Write 256 bytes from Tube
LDA &FEE5:STA IDEdata:INY:BNE IDETube:BEQ IDENext
.IDETubeRead                             :\ Read 256 bytes from Tube
LDA IDEdata:STA &FEE5:INY:BNE IDETube:BEQ IDENext
:
.IDENext
LDA IDEstatus:AND #&21:BNE IDEError      :\ Error occured
PLA:DEX:BEQ P%+5:JMP IDETwice            :\ Do each action twice
TAY:LDA #1:JSR UpdateScAd                :\ Update sect and addr
DEC num:BEQ P%+5:JMP IDELoop
:
.IDEDone
TYA:BMI P%+5:JSR TubeRelease
TXA:RTS                                  :\ A=&00, X=&00, ok, claim
:
\.IDEEscape
\LDA #&24:\BNE IDEError                  :\ Fake 'Abort' error
.IDENotPresent
LDA #&FE                                 :\ Becomes 'IDE not present'
.IDEError
ORA IDEerror:LDX #8:.IDEErrLp
ASL A:DEX:BCC IDEErrLp:LDA IDEErrs,X:TAX :\ Convert IDE error
PLA:TAY:JMP IDEDone                      :\ Return IDE result
.IDEErrs
EQUD &282422FE:EQUD &FE0E2018            :\ Translated IDE errors
:
:]:IF _NoIDEDrv%:z%=P%-z%:P%=P%-z%:O%=O%-z%
:
.z%
.DiskMMC                                 :\ GoMMC driver
LDY #5                                   :\ Move sect up a bit
.MMClp
LDA Daddr+3,Y:STA Daddr+4,Y:DEY:BNE MMClp
STY Daddr+11:STY Daddr+10:STY Daddr+8    :\ Length=&0000nn00
STY Daddr+4:INY:STY Daddr-1              :\ MMCaddr=&xxxxxx00
LDA action:AND #1:STA Daddr-3            :\ Command 0/1 for read/write
LDA #&03:STA Daddr-4
LDA #&12:STA Daddr-5:STA Daddr-6         :\ Fill rest of control block
LDX #(Daddr-6)AND255:LDA #&B0:JSR OswordY:\ Call MMC driver
LDA Daddr-1:CMP #&01:BEQ MMCabsent       :\ Not found
LDA num:JSR UpdateScAd:LDA #0:RTS        :\ Return OK
.MMCabsent
LDA #&FE:RTS                             :\ Return DriveAbsent
:]:IF _NoMMCDrv%:z%=P%-z%:P%=P%-z%:O%=O%-z%
:
:
.UpdateDAddr                        :\ Update Daddr, sect, addr
\PHA:\CLC
\ADC Daddr+1:\STA Daddr+1
\LDA Daddr+2:\ADC #0:\STA Daddr+2
\LDA Daddr+3:\ADC #0:\STA Daddr+3:\PLA
.UpdateScAd                         :\ Update sect, addr
PHA:CLC
ADC sect+0:STA sect+0
LDA sect+1:ADC #0:STA sect+1
LDA sect+2:ADC #0:STA sect+2:PLA
.UpdateAddr                         :\ Update addr
CLC
.UpdateAddrCy                       :\ Update addr with carry
ADC addr+1:STA addr+1        :STA Daddr+1
LDA addr+2:ADC #0:STA addr+2 :STA Daddr+2
LDA addr+3:ADC #0:STA addr+3 :STA Daddr+3
RTS
:
.DiskErrors
PHA:JSR ScreenOff:PLA:PHA
LDX #201:STX &101:\ Prepare DRO error
CMP #&FE:BCC P%+4:ADC #7
CMP #&19:BCC P%+4:LDA #&10
LSR A:TAX:LDA DskErrNums-3,X:TAX
LDY #0
.DskErrLp1
INX:INY:LDA Err00-1,X:STA &101,Y
BNE DskErrLp1
PLA:CMP #&12:BEQ DskErrJmp:\ R-O
LDA &108:BPL DskErr4
STA &101:JSR GetDrvChr:STA &108:\ Drive x not present
BNE DskErrJmp
.DskErr4
LDX &10D:CPX #ASC"0":BNE DskErr5:\ Disk error XX
TAX:JSR HexTopDigit:STA &10D
TXA:JSR HexDigit:STA &10E:\ Num
.DskErr5:LDX #&FF
.DskErrLp2
INX:INY:LDA DskErrAt,X:STA &100,Y:\ ' at '
BNE DskErrLp2
JSR GetDrvChr:STA &100,Y
LDA #ASC":":STA &101,Y:LDX #2
.DskErrLp3
LDA sect,X:JSR HexTopDigit:STA &102,Y:INY
LDA sect,X:JSR HexDigit:STA &102,Y:INY
DEX:BPL DskErrLp3
.DskErrJmp
JSR ClearDIR:STA &100:STA &102,Y
JMP &100
:
.DskErrNums
EQUB ErrFE-Err00:EQUB Err08-Err00
EQUB Err0A-Err00:EQUB Err0C-Err00
EQUB Err0E-Err00:EQUB ErrXX-Err00
EQUB Err12-Err00:EQUB Err14-Err00
EQUB Err16-Err00:EQUB Err18-Err00
:
.DskErrAt
EQUS " at ":BRK
.Err00
.Err08:EQUS "Clock error":BRK
.Err0A:EQUS "Late DMA":BRK
.Err0C:EQUS "ID CRC error":BRK
.Err0E:EQUS "Data CRC error":BRK
.Err12:EQUS "Disk read only":BRK
.Err14:EQUS "Track 0 not found":BRK
.Err16:EQUS "Write fault":BRK
.Err18:EQUS "Sector not found":BRK
.ErrXX:EQUS "Disk error 00":BRK
.ErrFE:EQUS "Drive "+CHR$210+" not present":BRK
:
\ Tube access routines
\ ====================
.TubeClaimLoad
LDA #1
.TubeClaimDo
PHA:JSR TubeClaim:PLA
.TubeAction
LDX #addr:LDY #0:JMP &406
.TubeClaim
LDA #&C0+progID+16
JSR &406:BCC TubeClaim:RTS
:
.TubeRelease
LDA #&80+progID+16:JMP &406
:
.TubeWait
TXA:PHA:LDX #10:.TubeWaitLp
DEX:BNE TubeWaitLp:PLA:TAX:RTS
:
\ CheckAddr - Check transfer addr for screen selection
\ ====================================================
\ On exit, shadow=1+OSver or 0 for non-screen
\          addr modified
\          P, X preserved
\          A, Y corrupted






.CheckAddr
PHP:TXA:PHA:LDA #0:STA shadow   :\ Set 'no shadow selected'
LDA addr+3:CMP #&FF:BEQ AddrIO  :\ &FFxxxxxx, check I/O address
BIT &27A:BMI AddrOk:BPL AddrEnd :\ <>&FFxxxxxx, use Tube or I/O
.AddrIO
LDA addr+2:CMP #&FF:BEQ AddrOk  :\ &FFFFxxxx, screen not specified
JSR WhatOS:CPX #2:BEQ AddrEnd   :\ Can't do B+
LDA addr+2
CMP #&FD:BEQ AddrVideo          :\ &FFFDxxxx, select shadow memory
CMP #&FE:BNE AddrEnd            :\ &FFFExxxx, select displayed memory
CPX #2:BCC AddrVideo            :\ Always select shadow memory on B
TXA:PHA:LDA #&75:JSR OSBYTE     :\ Get VDU status byte
TXA:TAY:PLA:TAX:TYA             :\ Could just do LDA &D0
AND #&10:BEQ AddrEnd            :\ Not shadow screen
.AddrVideo
INX:STX shadow                  :\ Set 'shadow selected'
.AddrEnd
LDA #&FF:STA addr+2:STA addr+3  :\ Force to I/O address &FFFFxxxx
.AddrOk:PLA:TAX
\.AddrDone:PLP
.ScreenDone:RTS
:
.ScreenOn
\ Could also eventually do ROMs
LDA #&81:EQUB &2C              :\ BIT xxxx
.ScreenOff
LDA #&C0                       :\ Skipped by BIT
LDX shadow:BEQ ScreenDone      :\ No screen selected, exit
CPX #4:BCS ScrnMaster
AND #&F0:PHA:TAX               :\ C0->C0, 81->80
LDA #34:JSR OSBYTE:PLA         :\ Early Watford board
BVC ScreenDone                 :\ Call acted on, exit
TAX:LDA #111:JMP OSBYTE        :\ Aries, later Watford board
.ScrnMaster
AND #1:TAX:LDA #108:JMP OSBYTE :\ Master
:
:
\ DiskMain and DiskMainLoop
\ Read/Write number of sectors
\ action=0 - read, action=&FF - write
\ &C2/3=sector start
\ &C4-7=data address (any memory)
\ &C9/A=number of sectors
\ Call DiskMainOsw with SEC for no errors
\ Returns:
\ &C2/3=sector after end
\ &C4-7=data address after end
\ &C9/A=sectors not transfered (0 in DiskMainLoop)
\     A=error number when SEC
\     X=preserved
\     Y=corrupted
:
\.DiskMain    :\CLC
\.DiskMainOsw :\JSR CheckAddr
\.DiskMainGBPB
:
.DiskMain
JSR CheckAddr
.DiskMainGBPB:CLC
.DiskMainOsw
TXA:PHA:PHP:JSR ScreenOn
JSR StartToSect                     :\ Copy start to sect
.DiskMainLp1
LDA len+2:ORA len+1:BEQ DiskMainEnd :\ Nothing left
LDY #64:LDA len+2:BNE DiskMainBlock :\ >=&10000, transfer 64 sectors
CPY len+1:BCC DiskMainBlock         :\ >=&4000, transfer 64 sectors
LDY len+1                           :\ Transfer remaining sectors
.DiskMainBlock
STY num                             :\ Transfer block of sectors
LDA len+1:SEC:SBC num:STA len+1     :\ Decrease sector count
LDA len+2:SBC #0:STA len+2          :\ Should do this *after* transfer
:
PLP:PHP:BCS DiskMainSoft
JSR DiskAccess
.DiskMainNext        :\ addr and sect will have been updated
\ Should update count here
JMP DiskMainLp1
.DiskMainSoft
JSR DiskAcc         :\ X,Y corrupted, A=result
BEQ DiskMainNext
.DiskMainEnd
PHA:JSR ScreenOff:PLA:TAY
PLP:PLA:TAX:TYA
RTS
:
.StartToSect:\.C2toB0
LDA start+0:STA sect+0:LDA start+1:STA sect+1:LDA start+2:STA sect+2
\ORA sect+0:RTS
:
\.addC5zero  \\ Something calls this
\CLC
\LDA #1:\ADC addr+0:\STA addr+0
\.addC5one   \\ Something calls this
\LDA #0
\.addC5
\ADC addr+1:\STA addr+1
\LDA addr+2:\ADC #0:\STA addr+2
\LDA addr+3:\ADC #0:\STA addr+3:\RTS
:
.CheckHadfsDiskX
JSR CheckHADFSDisk
.ChkHadfsChng
LDA &1110:CMP &F18:BNE DskChgErr
LDA &1111:CMP &F19:BNE DskChgErr
RTS
:
.get_chk_dir
LDA &1110:PHA:LDA &1111:PHA
LDA CURR:ORA CURR+1:ORA CURR+2:PHA
LDA CURR+d:PHA
JSR GetDir
PLA:CMP CURR+d:BNE GetChkDirOk1
PLA:BEQ GetChkDirOk2
PLA:CMP &1111:BNE DskChgErr
PLA:CMP &1110:BEQ GetChkDirOk3
.DskChgErr
JMP DiskChanged
.GetChkDirOk1:PLA
.GetChkDirOk2:PLA:PLA
.GetChkDirOk3
RTS
:
.CheckHADFSDisk
JSR ReadFSM:BNE NotHADFSError0
LDX #&F:.ChkNameLp
LDA &F00,X:STA DSKNAME,X:DEX:BPL ChkNameLp
LDA VFLG:ORA #128:AND #&E0:ORA drive:STA VFLG
LDA #0:RTS:\ Does A need to be zero?
:
.NotHADFSError0
BCS CheckDskErr:\ Drive not present
LDA #0:STA VFLG
.NotHADFSDisk
JSR errors:EQUB 200:EQUS "Not an HADFS disk":BRK
:
.SectRoot
LDA #71:BNE P%+4
.SectFSM
LDA #70:STA sect+0:LDA #0:STA sect+1:STA sect+2:RTS
:
.ReadFSM:\ Exit; EQ -- HADFS
\                NE CC Not HADFS disk
\                NE CS Drive ? not present
\                addr, sect, Y preserved, A, X corrupted
TYA:PHA:LDY #6                         :\ Save Y as called by SearchPath
.RdFSMlp1
LDA addr,Y:PHA:DEY:BPL RdFSMlp1        :\ Save addr, sect
JSR SectFSM:STA action:STA addr
LDA #&FF:STA addr+2:STA addr+3:LDA #1:STA num
LDA #&F:STA addr+1
JSR ClearFSM:JSR DiskAcc:TAX:LDY #0    :\ Read FSM from drive
.RdFSMlp2
PLA:STA addr,Y:INY:CPY #7:BNE RdFSMlp2 :\ Restore addr, sect
PLA:TAY:TXA:BEQ ChkJGH                 :\ Disk read ok, check if HADFS
CMP #&FE:BEQ ChkJGH1                   :\ CS=Drive not present
.CheckDskErr
JMP DiskErrors                         :\ Bad read, generate error
:
.ChkJGH:LDX #7
.ChkJGHlp
LDA &F10,X:CMP JGHName,X:CLC:BNE ChkJGH2 :\ NE+CC=Not HADFS
DEX:BPL ChkJGHlp:INX:CLC                 :\ EQ+CC=HADFS
.ChkJGH1:TXA                             :\ Set EQ/NE from X
.ChkJGH2:RTS
:
\.hadfs4
]
PRINT CHR$11;STRING$(20,CHR$9);(O%-mcode%)DIV1024":";(O%-mcode%)MOD1024" Kbytes"
:
REM PRINT CHR$11;STRING$(20,CHR$9);(O%-mcode%)DIV1024":";(O%-mcode%)MOD1024" Kbytes"
REM OSCLI"SAVE ROMa "+STR$~mcode%+" "+STR$~O%+" 3000 3000":O%=mcode%:Block%=P%
REM IF O%>&7BFF PRINT'"Overrunning screen"'':VDU7
>"S.HADFS4"