REM >HADFS8
REM v5.28 len does not have to be addr+4
:
REM Check - is returned PTR wrong?
:
_X%=TRUE:REM Remove tests?
able%=able%OR64:REM Fast GBPB
PRINT "Assembling S.HADFS8"
REM P%=hadfs8
O%=P%-Block%+mcode%
[OPT0
.gbpb0
RTS
:
.gbpb
CMP #0:BEQ gbpb0
CMP #12:BCS gbpb0
JSR GrabAbs
STX blk+0:STY blk+1:STA argnum
LDY #9
.gbpbSetPtr
LDA (blk),Y:STA ptrstore-9,Y
INY:CPY #13:BNE gbpbSetPtr
LDA argnum:CMP #5:BCC P%+5:JMP gbpbInfo
JSR GetChn:\ A=chan
LDX argnum:CPX #3:BCS gbpbIn
\ 1,2; Output
JSR CheckOutput:BNE gbpbNext
\ A=chan -> X=chan ptr
.gbpbIn
JSR CheckInput:\JSR InputUpdate
.gbpbNext
\ X=info
LDA argnum:ROR A:BCC gbpbNoPtr:\ Odds change PTR
LDY #ptrstore:JSR argsY_01a:\ Set PTR
.gbpbNoPtr
LDY #5:CLC
LDA (blk),Y:ADC WS+&05,X:STA ptrstore+0:INY
LDA (blk),Y:ADC WS+&06,X:STA ptrstore+1:INY
LDA (blk),Y:ADC WS+&07,X:STA ptrstore+2:INY
LDA (blk),Y:ADC WS+&08,X:STA ptrstore+3:\ !ptrstore=PTR+num
BCS gbpbTooMany:\ >=&100000000
LDA (blk),Y:BNE gbpbTooMany
LDY #ptrstore:JSR cmp_EXT:DEX:DEX:DEX:DEX
BCC gbpbTooMany
LDY #5:.gbpbSetTrans
LDA (blk),Y:STA ptrstore-5,Y
INY:CPY #8:BNE gbpbSetTrans
\ !ptrstore=number
CLC:BCC gbpbInfo:\ CLC=not EOF
.gbpbTooMany
SEC
LDA WS+&09,X:SBC WS+&05,X:STA ptrstore+0
LDA WS+&0A,X:SBC WS+&06,X:STA ptrstore+1
LDA WS+&0B,X:SBC WS+&07,X:STA ptrstore+2
LDA WS+&0C,X:SBC WS+&08,X:STA ptrstore+3
\ !ptrstore=end-PTR, num to do
SEC:\ SEC=EOF
.gbpbInfo
PHP:\ EOF flag
LDY #5:LDA (blk),Y:STA len+0  :\ len+0 set for gbpb5+
DEY:.gbpbAddrLp
LDA (blk),Y:STA addr-1,Y      :\ Copy address to addr
DEY:BNE gbpbAddrLp
JSR CheckAddr
\ !addr=addr (forced to I/O if no Tube or screen)
\ ?len =length byte 0 for gbpb5+
\ !ptrstore=number to do (1..4)
\ X=>info (1..4)
LDA argnum:ASL A:TAY
LDA gbpbTable-2,Y:STA argtmp+0
LDA gbpbTable-1,Y:STA argtmp+1
LDA argnum:PLP:JSR JumpAT
LDY #4:.AddrToCtrlLp
LDA addr-1,Y:STA (blk),Y
DEY:BNE AddrToCtrlLp
\ addr now in ctrl block
\ other info done by routines
LDA #0:LDX blk+0:LDY blk+1:RTS
\ A should be zero when ok - argnum ignored on return
.JumpAT:JMP (argtmp)
:
.gbpbTable
EQUW gbpb1:EQUW gbpb2:EQUW gbpb3
EQUW gbpb4:EQUW gbpb5:EQUW gbpb6
EQUW gbpb7:EQUW gbpb8:EQUW gbpb9
EQUW gbpb10:EQUW gbpb11
:
.PrBCo
JSR PrBC:JMP PrSlash
.PrBC
LDA sect+3:JSR PrHex:LDA sect+2:JSR PrHex
LDA sect+1:JSR PrHex:LDA sect+0:JMP PrHex
:]:IF _X%:z%=P%-PrBCo:P%=P%-z%:O%=O%-z%
:
.gbpb1:.gbpb2:.gbpb3:.gbpb4
\ Out/Out/In/In
\ argnum=A=Action, !ptrstore=number
\ P=EOF,        !C4=addr
\ X=>info,      C0=>ctrl
:
PHP:\ EOF flag
LDA ptrstore+0:PHA:LDA ptrstore+1:PHA:LDA ptrstore+2
PHA:LDA ptrstore+3:PHA:\ Save number
LDA WS+&05,X:BEQ RWZero:\ Sect bdy
LDA #0:\STA len+1:\STA len+2
SEC:SBC WS+&05,X:STA len+0:\ number
LDA ptrstore+1:ORA ptrstore+2:ORA ptrstore+3:BNE RWok:\ more than one sect
LDA ptrstore+0:CMP len+0:BCS RWok:\ number > remainder here
STA len+0:\ use this instead
.RWok
JSR RWBytes:\ DECs BC, INCs C4
\ Now at sect boundary
BEQ RWFinished:\ no more
.RWZero
\ Should ensure file
JSR FindSector:\ C2=sector
LDA ptrstore+3:STA len+3
LDA ptrstore+2:STA len+2
LDA ptrstore+1:STA len+1
\LDA ptrstore+0:\STA len+0
LDY argnum:CPY #3:LDA #0:ADC #&FF
\ Convert Y=1/2, 3/4 -> A=FF/00
STA action:CLC:JSR DiskMainGBPB
CLC
LDA ptrstore+1:ADC WS+&06,X:STA WS+&06,X
LDA ptrstore+2:ADC WS+&07,X:STA WS+&07,X
LDA ptrstore+3:ADC WS+&08,X:STA WS+&08,X
\ !C4=new addr
\ ?C8=remainder
\ !ptrstore=length-first, ie ?ptrstore=remainder
LDA ptrstore:JSR RWBytesA:\ DECs BC, INCs C4; also checks if zero
.RWFinished
PLA:STA ptrstore+3:PLA:STA ptrstore+2
PLA:STA ptrstore+1:PLA:STA ptrstore+0
LDY #5:SEC:PHP
.RWSub
PLP:LDA (blk),Y:SBC ptrstore-5,Y
STA (blk),Y:PHP:INY:CPY #9
BNE RWSub:\ (num)=(num)-count
PLP:LDA argnum:CMP #3:BCS RWEnd
PLP:BCC RWEnd1:\ Not at EOF
\ Write remaining bytes
.RWLast
DEY:LDA (blk),Y:STA ptrstore-5,Y
CPY #4:BNE RWLast
.RWLastLp
LDY #255:LDA ptrstore+1:ORA ptrstore+2:ORA ptrstore+3:BNE RWLast3
LDY ptrstore+0:.RWLast3
TYA:JSR RWBytesA
BNE RWLastLp
LDY #5:.RWAddr
STA (blk),Y:INY:CPY #9:BNE RWAddr
CLC
.RWEnd1
PHP
.RWEnd
LDY #9
.RWEndLp
LDA WS+&05,X:STA (blk),Y:INY:INX
CPY #13:BNE RWEndLp
PLP:\ EOF flag
RTS
:
.RWBytesA:\ A=number to do
STA len+0
.RWBytes:\ ?len=number to do
LDA ptrstore+3:PHA:LDA ptrstore+2:PHA:LDA ptrstore+1:PHA
LDA ptrstore+0:PHA:LDA len+0:PHA:BEQ RWBytesZero
TXA:PHA:\ Info ptr
LDA addr+3:CMP #&FF:BEQ RWBytesIO
BIT &27A:BPL RWBytesIO
:
LDA argnum:CMP #3:LDA #0:ADC #0:PHA
JSR TubeClaimDo
JSR GetChn:TAY
PLA:BNE RWTubeLoad
.RWTubeSave
LDA &FEE5:SEC:JSR putget1:\ bput without GrabAbs
JSR UpdateCounters:BNE RWTubeSave
BEQ RWTubeDone
:
.RWTubeLoad
CLC:JSR putget1:STA &FEE5:\ bget without GrabAbs
JSR UpdateCounters:BNE RWTubeLoad
.RWTubeDone
JSR TubeRelease
.RWBytesDone
PLA:TAX:\ Info ptr
.RWBytesZero
PLA:STA len+0:SEC:\ Number
PLA:SBC len+0:STA ptrstore+0
PLA:SBC #0:STA ptrstore+1
PLA:SBC #0:STA ptrstore+2
PLA:SBC #0:STA ptrstore+3
ORA ptrstore+2:ORA ptrstore+1:ORA ptrstore+0
RTS
:
.RWBytesIO
JSR ScreenOn:JSR GetChn:TAY
LDX #addr:LDA argnum
CMP #3:BCS RWLoadLp
.RWSaveLp
LDA (0,X):SEC:JSR putget1:\ bput without GrabAbs
JSR UpdateCounters:BNE RWSaveLp
BEQ RWBytesEnd
:
.RWLoadLp
CLC:JSR putget1:STA (0,X):\ bget without GrabAbs
JSR UpdateCounters:BNE RWLoadLp
.RWBytesEnd
JSR ScreenOff
JMP RWBytesDone
:
\ gbpb5/6/7 should check context
.gbpb5:\ Read disk name
\LDA CSD+d:\STA drive:\JSR CheckNames2
\ CheckNames may change CSD+2 when checking context
JSR CheckNames:JSR GetOptNumber:PHA
LDX #0:LDY #0:LDA #16
JSR CopyInfo:PLA:JSR PutInInfo
LDA CSD+d:JSR PutInInfo:BNE gbpbLoader
:
.gbpb6:.gbpb7:\ Read dir/lib name
CMP #7:PHP:LDA VFLG:BCC gbpb6a
ASL A:.gbpb6a
AND #64:BNE gbpb6b
JSR CheckNames:.gbpb6b
LDA #1:STA &F00:LDA CSD+d
PLP:PHP:BCC gbpb6c
LDA LIB+d:.gbpb6c
JSR DrvChr:STA &F01
LDX #&10:PLP:PHP:BCC gbpb6d
LDX #&1A:.gbpb6d
LDY #2:JSR CopyInfo10
LDA OPTFLG:LDX #0:PLP:BCC gbpb6e
ASL A:.gbpb6e
ASL A:ASL A:BCC gbpb6f:\ Owner
LDA PRIV:AND #8:BNE gbpb6f:\ Syst
DEX:.gbpb6f
TXA:JSR PutInInfo:\ Then send...
:
.gbpbLoader:\ Send data from &F00
\ Y=length, C4-7=addr
JSR Clear26
STY len+0:TYA:PHA:JSR LoadGbPb:PLA
.gbpbUpd
CLC:ADC addr+0:STA addr+0
LDA #0:JMP UpdateAddrCy
:
.UpdateCounters
LDA #1:JSR gbpbUpd:DEC len+0:RTS :\ addr=addr+1, len=len-1
:
.CopyInfo10
LDA #10
.CopyInfo
STA len+0:STA &F00,Y:TYA:PHA:INY
.CopyInfoLp
LDA DSKNAME,X:CMP #ASC"!"
BCC CopyInfoEnd
JSR PutInInfo:INX
DEC len+0:BNE CopyInfoLp
.CopyInfoEnd
PLA:TAX:LDA &F00,X
SEC:SBC len+0:STA &F00,X
RTS
:
.gbpb9a
\LDA argnum:\CMP #9:\BNE gbpb9null
LDA IAMFLG:BEQ gbpb9null
LDY #0:STY IAMFLG:INY
.gbpb9lp
LDA &77F,Y:JSR PutInInfo
BMI gbpb9end
CMP #13:BNE gbpb9lp
.gbpb9end
TYA:SBC #2:STA &F00:JMP gbpbLoader
.gbpb9null
LDA #0:STA argnum:RTS :\ argnum ignored on return
:
.gbpb9:.gbpb10:.gbpb11
CMP #10:BCS gbpb9null
:]:IF NOT_NoGBAddr%:z%=P%-gbpb9:P%=P%-z%:O%=O%-z%
JSR GetChn:BNE gbpb9b:\\BEQ gbpb9a
LDA argnum:CMP #9:BEQ gbpb9a:BNE gbpb8
.gbpb9b
JSR CheckChannel:\ A=WS+&00,X
AND #&10:BNE gbpb8a
JMP Not_A_Dir
:
.gbpb8
LDX #CSD-(WS+1)
\\LDA WS+&01+d,X:\\JMP gbpb8X   :\ CSD drive is at +3+1
.gbpb8a
\\LDA WS+&01+D,X              :\ CHN drive is at +2+1
.gbpb8X
\\JSR SetDrives
\ X=>dir addr
\ !C4=addr
\ ?C8=num
\ ptrstore?0 = ?ret=index returned
\ ptrstore?1 = ?index=index counted
\ ptrstore?2 = ?fcnt=num. done
LDA WS+&01,X:STA sect+0:LDA WS+&02,X:STA sect+1
LDA WS+&03,X:STA sect+2::LDA WS+&04,X::JSR SetDrives
LDA ret:STA index:LDA #0:STA fcnt
\.gbpb8dir:\ Start a dir
JSR GetDir
.gbpb8dir:\ Start a dir
JSR start24:BEQ gbpb8MT
LDA &110D:STA (blk),Y:\ Cycle
.gbpb8lp
LDA (fptr),Y:BEQ gbpb8next
DEC files:JSR DoIOwn:BPL gbpb8own
LDY #7:LDA (fptr),Y:BMI gbpb8next
.gbpb8own
DEC index:BMI gbpb8found
.gbpb8next
JSR add24:LDA files:BNE gbpb8lp
.gbpb8MT
JSR NextChunk:BNE gbpb8dir
\ No more
JSR gbpb8counter:SEC:RTS
:
.gbpb8found:\ Next LDX needed
LDX #0:LDA argnum:AND #2:BEQ gbpb8name
LDA blk+0:PHA:LDA blk+1:PHA:LDA #&E:STA blk+1:LDA #&FE:STA blk+0
JSR ConvertBlk0:PLA:STA blk+1:PLA:STA blk+0
LDY #0:TYA
.gbpbXlp
STA &F11,Y:INY:CPY #12:BNE gbpbXlp
LDY #8:LDA (fptr),Y
ROL A:LDA #0:ADC #1:STA &F10:\ Object
LDX #&14:LDA argnum:ROR A:BCC gbpb8name
LDY #22:LDA (fptr),Y:STA &F14
INY:LDA (fptr),Y:STA &F15
LDA #0:STA &F16
LDA drive:STA &F17:\ SECTOR
\ Could also set time
\LDX #&14:\.gbpb8time
\LDA &EF0,X:\STA &F00,X:\INX
\CPX #&1D:\BNE gbpb8time
\LDA &F00:\STA &F1C:\...ldx not needed
LDX #&1D
:]:IF _NoGBAddr%:z%=P%-gbpb8found-2:P%=P%-z%:O%=O%-z%
.gbpb8name
LDY #0:LDA argnum:CMP #9:PHP:BCS gbpb8lp2:INX
.gbpb8lp2
LDA (fptr),Y:AND #127:CMP #ASC"!":BCC gbpb8send
STA &F00,X:INX:INY:CPY #10:BNE gbpb8lp2
.gbpb8send
PLP:BCS gbpb8send2
STY &F00:INY:BNE gbpb8send3
.gbpb8send2
LDA #0:STA &F00,X:INX
.z%
LDA argnum:AND #2:BEQ gbpb8send3
TXA:ADC #2:AND #&FC:TAX:\ Align
:]:IF _NoGBAddr%:z%=P%-z%:P%=P%-z%:O%=O%-z%
.gbpb8send3
TXA:TAY:\ Length
LDA len+0:PHA:JSR gbpbLoader
PLA:STA len+0
INC ret:\ Index to next
INC fcnt:\ Number done
INC index:\ Returns to zero to flag next
DEC len+0:\ Number to do
LDY #9:LDA ret:STA (blk),Y:\ Index
JSR gbpb8counter
CLC:LDA len+0:BEQ gbpb8end
JMP gbpb8next
:
.gbpb8counter
LDY #5:LDX len+0:LDA argnum:AND #3:BEQ gbpb8send4
LDX fcnt:\ 9,10,11 give num. returned, not num. not returned
.gbpb8send4
TXA:STA (blk),Y:.gbpb8end:RTS
:
\ PutInInfo and GetChn in next part
:
]
PRINTCHR$11;STRING$(20,CHR$9);(O%-mcode%)DIV1024":";(O%-mcode%)MOD1024" Kbytes"
> "S.HADFS9"