REM >HADFS7
REM Block 7 of HADFS source
REM New open routines
REM *ASSEM this after part 6
REM 01/01/1992, 9:45pm
REM BootOpt moved to H2
REM FindSect sets sect and &C2/3
REM Can openin($)
REM v5.30 - Accesses context variables in new location
:
D=3:REM Offset to drive number in channel info
:
PRINT "Assembling S.HADFS7"
REM P%=hadfs7
O%=P%-Block%+mcode%
[OPT0
:
.args
JSR GrabAbs
STA argnum:CLC:ADC #3
CMP #10:BCS args_exit
STA ws
TXA:PHA:TYA:TAX:PLA:TAY        :\ Swap X & Y
TYA:PHA:TXA:PHA                :\ Save X & Y
BEQ args2                      :\ Y=0, no handle supplied
LDA ws:CLC:ADC #10:PHA         :\ Add offset to argsY functions
CMP #12:BCC args1              :\ Not a channel function
TXA:JSR CheckChannel           :\ This corrupts argtmp/buf
JSR clearEOF
.args1
PLA:STA ws                     :\ Get function offset back
.args2
STY ws+1:LDA ws:ASL A:TAY
LDA argsTable,Y:STA ws
LDA argsTable+1,Y:LDY ws+1:STA ws+1
LDA argnum:JSR JumpWS
STA argnum
PLA:TAY:PLA:TAX                :\ Restore X & Y
.args_exit
LDA argnum:RTS
:
.argsTable
EQUW args0_FD:EQUW args0_FE
EQUW args0_FF:EQUW args0_00
EQUW args0_01:EQUW args0_02
EQUW args0_03:EQUW args0_04
EQUW args0_05:EQUW args0_06
\
EQUW argsY_FD:EQUW argsY_FE
EQUW argsY_FF:EQUW argsY_00
EQUW argsY_01:EQUW argsY_02
EQUW argsY_03:EQUW argsY_04
EQUW argsY_05:EQUW argsY_06
:
.args0_FD:\ Read version number
LDA #able% AND &FF:STA 0,Y
LDA #able% DIV 256:STA 1,Y
LDA #EVAL("&"+ver$):STA 2,Y
LDA #EVAL("&"+MID$(ver$,3,2)):STA 3,Y
LDA #INTVALver$*10+VALMID$(ver$,1+INSTR(ver$,"."))/10:RTS
:
\  &04  &05  &06  &07  &08  &09  &0A  &0B  &0C  &0D
\     USRPRV CURR      CSD  LIB  URD  OPT DRVI/E
\  ---  &C0  &C4  ---  &24  &28  &2C
\ Validity only guarrenteed for CURR/CSD/LIB/URD
.argsY_FD                         :\ Read/Write info
TXA:ASL A:PHP:ASL A               :\ Save b7, multiply by four
\  &10  &14  &18  &1C  &20  &24  &28  &2C  &30  &34
CMP #&40:BCS argsY_FDcX           :\ Ignore if out of range
CMP #&20:BCS P%+4:ADC #&A8
\  &B8  &BC  &C0  &C4  &20  &24  &28  &2C  &30  &34
TAX:DEX                           :\ Find offset to context variable
\  &BC  &C0  &C4  &C8  &24  &28  &2C  &30  &34  &38
PLP:BCS argsY_FDb                 :\ &80+ -> write setting
JSR argsY_00:BCC argsY_FDc        :\ Read context
.argsY_FDb
JSR argsY_01c:LDA #0:STA VFLG     :\ Write context & clear validity flags
.argsY_FDc
PHP
.argsY_FDcX
PLP:LDA #0:RTS                    :\ Unpreserve A
:
.args0_FE                      :\ Read last drive num
LDA drive:STA 0,Y
.argsY_FE                      :\ Unused
RTS
:
.args0_00:\ Return FS num.
.args0_03:\ Return LIBFS num.
JSR FindWS:LDY #myfs:LDA (ws),Y
CMP #5:BCC args0_03a
CMP #20:BCC args0_03b
.args0_03a:\.get_new_fs_no
LDA #HADFSnum:STA (ws),Y
.args0_03b:\.get_fs_no_new
RTS
:
.args0_01:\ Get cl_addr
LDA cptr+0:STA 0,Y:LDA cptr+1:STA 1,Y
LDA #&FF:STA 2,Y:STA 3,Y
.args0_02:\ Return version num.
LDA #0:RTS
:
.args0_04:\ Read used space
LDA #&FF:BNE args0_05a
.args0_05:\ Read free space
TXA:.args0_05a
PHA:LDA #&FF:STA catex
LDA CSD+d:JSR AddUpFree
PLA:BEQ args0_05b
JSR AddUpUsed:.args0_05b
LDA numstore+1:STA 1,Y
LDA numstore+2:STA 2,Y
LDA #0:STA 0,Y:STA 3,Y
.args0_06:\ Read something
RTS
:
.argsY_02:\ Read EXT
INX:INX:INX:INX
.argsY_00:\ Read PTR
LDA WS+&05,X:STA 0,Y
LDA WS+&06,X:STA 1,Y
LDA WS+&07,X:STA 2,Y
LDA WS+&08,X:STA 3,Y
RTS
:
.argsY_06:\ Write alloc
JSR argsY_06a
.argsY_04:\ Read alloc
LDA WS+&14,X:STA 3,Y
LDA WS+&13,X:STA 2,Y
LDA WS+&12,X:STA 1,Y
LDA #0:BEQ argsY_05a
:
.argsY_05:\ Read EOF
JSR check_EOF
STA 1,Y:STA 2,Y:STA 3,Y
.argsY_05a
STA 0,Y:\STA 3,Y
.chk_EOF_ok
LDA #0:\ EOF false, EQ=1
RTS
.eof:.do_eof:\ osbyte7F
TXA:JSR CheckChannel
JSR check_EOF:TAX:RTS
:
.CheckEOF:.check_EOF
LDA WS+&08,X:CMP WS+&0C,X:BCC chk_EOF_ok
LDA WS+&07,X:CMP WS+&0B,X:BCC chk_EOF_ok
LDA WS+&06,X:CMP WS+&0A,X:BCC chk_EOF_ok
LDA WS+&05,X:CMP WS+&09,X:BCC chk_EOF_ok
LDA #&FF:\ EOF true, EQ=0
RTS
:
.cmp_alloc
\ lo byte must be zeroed
INX:INX:INX:INX:INX:INX:INX:INX
.cmp_EXT
INX:INX:INX:INX
.cmp_PTR
LDA WS+&08,X:CMP 3,Y:BCC cmp_xt:BNE cmp_xt
LDA WS+&07,X:CMP 2,Y:BCC cmp_xt:BNE cmp_xt
LDA WS+&06,X:CMP 1,Y:BCC cmp_xt:BNE cmp_xt
LDA WS+&05,X:CMP 0,Y
.cmp_xt
RTS
\ CC= M>PTR, M>EXT
\ CS= M<=PTR, M<=EXT
:
.cmp_PTRhi
LDA 3,Y:CMP WS+&08,X:BNE cmp_PTRlo
LDA 2,Y:CMP WS+&07,X:BNE cmp_PTRlo
LDA 1,Y:CMP WS+&06,X
.cmp_PTRlo
RTS
\ EQ= PTRhi=Mhi
:
.IncPTR
SEC
LDA WS+&05,X:ADC #0:STA ptrstore+0
LDA WS+&06,X:ADC #0:STA ptrstore+1
LDA WS+&07,X:ADC #0:STA ptrstore+2
LDA WS+&08,X:ADC #0:STA ptrstore+3
LDY #ptrstore:BNE argsY_01a
:
.argsY_01:\ Set PTR
JSR CheckDir2
.argsY_01a
JSR cmp_PTRhi:BEQ argsY_01b
JSR argsY_FF:\ Update buffer
.argsY_01b
LDA #&FF:PHA
JSR cmp_EXT:DEX:DEX:DEX:DEX
BCS argsY_01d:\ PTR moving back
JSR CheckPTRset:\ can I move PTR?
PLA:JSR argsY_03a:\ do EXT=
DEX:DEX:DEX:DEX
.argsY_01c
PHA
.argsY_01d
LDA 0,Y:STA WS+&05,X
LDA 1,Y:STA WS+&06,X
LDA 2,Y:STA WS+&07,X
LDA 3,Y:STA WS+&08,X
PLA
.argsY_01e
RTS
:
.argsY_03:\ Set EXT
JSR CheckDir2
.argsY_03a
JSR CheckOut2
LDA #&FF:PHA
JSR cmp_PTR:BCC argsY_03b
\ Push PTR lower
JSR argsY_01a:\ set PTR
BMI argsY_03c
.argsY_03b
\LDA #&FF:\PHA
JSR cmp_EXT:DEX:DEX:DEX:DEX
BCS argsY_03c:\ file shrinking
PLA:JSR argsY_06b:\ set alloc
\ Need to pad with zeros
LDA #0:PHA
.argsY_03c
INX:INX:INX:INX:BNE argsY_01d
:
.argsY_06a:\ Set alloc
JSR CheckDir2:JSR CheckOut2
.argsY_06b
\ Check for max file length
\\\\ **** CHECK THIS ****
LDA 3,Y:BNE CantExtend
LDA 2,Y:CMP #8:BCS CantExtend
LDA WS+&11,X:PHA:\    Save part of ID
LDA #0:STA WS+&11,X:\ Temp'y use as low byte of Alloc
JSR cmp_alloc
PHP:TXA:SEC:SBC #12:TAX:PLP
PLA:STA WS+&11,X:\    Restore ID part
BCS argsY_01e:\      <=Alloc, nothing needed to be done
TYA:PHA
\ Save these to protect SPOOLing of *CAT, etc
LDA CURR+0:PHA:LDA CURR+1:PHA
LDA CURR+2:PHA:LDA CURR+d:PHA
LDA fptr+0:PHA:LDA fptr+1:PHA
JSR CheckDskChg0:CLC:\   ...and reads FSM
LDA WS+&01,X:ADC WS+&12,X:STA start+0
LDA WS+&02,X:ADC WS+&13,X:STA start+1
LDA WS+&03,X:ADC WS+&14,X:STA start+2
JSR FindFSMEntry:BEQ argsY_06e
.CantExtend
LDA #119:JSR OSBYTE:\ Close SpEx
JSR errors:EQUB 191:EQUS "Can't extend":BRK
.argsY_06e
LDA #0:STA len+2:LDA #&40:STA len+1
LDA &F23,Y:BNE argsY_06f
LDA &F22,Y:CMP #&40
BCS argsY_06f:\ Use 16K
STA len+1:\LDA &F23,Y:\STA len+2:\ len+2 already set to zero
.argsY_06f
TXA:PHA:TYA:TAX:JSR FindFreeSub
JSR SaveFSM:PLA:TAX:CLC
LDA WS+&12,X:ADC len+1:STA WS+&12,X
LDA WS+&13,X:ADC len+2:STA WS+&13,X
LDA WS+&14,X:ADC len+3:STA WS+&14,X
CLC:JSR UpdateWithAlloc:\ Look for my entry and update length
PLA:STA fptr+1:PLA:STA fptr+0
PLA:STA drive:PLA:STA sect+2
PLA:STA sect+1:PLA:STA sect+0:ORA sect+1:ORA sect+2
BEQ P%+5:JSR GetDir
\.argsY_06g
PLA:TAY:RTS
:
.argsY_FF:\ Update buffer
CLC
.argsY_FFa
PHP:LDA WS+&00,X:AND #&82:CMP #&82:BNE UpdateDone
PLP:PHP:BCC argsY_FFd           :\ Not closing
LDA WS+&00,X:PHA:JSR zero_flag   :\ If close fails, already zeroed
JSR CheckDskChg0                :\ Check drive contains my disk
PLA:STA WS+&00,X                 :\ Restore flag, it's still needed
.argsY_FFd
LDA #&FF:JSR AccessBuffer
.UpdateDone
PLP:LDA #&DC:JMP clear_flag
:
.args0_FF:\ Update all buffers
LDY #25
.args0_FFlp
TYA:JSR ChannelAddr
JSR argsY_FF
INY:CPY #30
BNE args0_FFlp
LDA #0:RTS
:
.AccessBuffer
\ A= R/W flag
STA action
LDA #1:STA num:\ one page
JSR FindSector
LDA buf+1:STA addr+1
JMP DiskAccDIR2
:
.FindSector
CLC
LDA WS+&01,X:ADC WS+&06,X:STA sect+0:STA start+0
LDA WS+&02,X:ADC WS+&07,X:STA sect+1:STA start+1
LDA WS+&03,X:ADC WS+&08,X:STA sect+2:STA start+2
.FindDriveNumber
LDA WS+&01+D,X:STA drive:RTS
:
.At_EOF_Error
JSR errors:EQUB 223:EQUS "EOF":BRK  :\ Was "End of file"
:
.bget
CLC:EQUB &A9                   :\ CLC=BGET, skip following SEC
.bput
SEC                            :\ SEC=BPUT
JSR GrabAbs
.putget1                       :\ Enter here when AbsWs already owned
STA buf:TXA:PHA:LDA shadow:PHA:LDX #0       :\ Save X, shadow
.putgetlp1
LDA addr,X:PHA:INX:TXA:EOR #4:BNE putgetlp1 :\ Save addr, preserving Cy
TYA:PHA:BCS bput1              :\ Save Y
JSR CheckInput                 :\ X=info, (buf)=>buffer
LDA WS+&00,X:AND #&20:BNE At_EOF_Error
JSR CheckEOF:BEQ bget2         :\ Not at EOF
LDA #&20:JSR set_flag          :\ Set EOF flag
LDA #254:SEC:BCS putget_end    :\ Return Cy=1
.bget2
JSR InputUpdate                :\ Read from disk if needed
LDA WS+&05,X:TAY:LDA (buf),Y    :\ Get byte from buffer
PHA:JSR IncPTR:PLA:CLC         :\ Increment PTR
BCC putget_end                 :\ Return Cy=0, A=byte
:
.bput1
LDA buf:PHA:TYA:JSR CheckOutput:\ X=info, (buf)=>buffer
LDA WS+&05,X:PHA                :\ Get buffer offset
BNE P%+5:JSR IncPTR            :\ Flush buffer if offset=0
PLA:STA WS+&05,X                :\ Restore buffer offset
JSR InputUpdate                :\ Read from disk if needed
LDA WS+&05,X:TAY:PLA:STA (buf),Y:\ Store byte in buffer
PHA:LDA #2:JSR set_flag        :\ Buffer modified
JSR IncPTR:JSR clearEOF:PLA:CLC:\ Increment PTR
:
.putget_end
STA buf:PLA:TAY:LDX #3         :\ Restore Y
.putget_lp2
PLA:STA addr,X:DEX:BPL putget_lp2         :\ Restore addr, preserving Cy
PLA:STA shadow:PLA:TAX:LDA buf:RTS        :\ Restore shadow, X
:
.InputUpdate
LDA WS+&00,X:AND #1:BNE InputUpOk
LDA #0:JSR AccessBuffer
LDA #1
.set_flag
ORA WS+&00,X:STA WS+&00,X
.InputUpOk
RTS
:
.zero_flag
LDA #0:BEQ clr_flag2
.clearEOF
LDA #&DF
.clear_flag
AND WS+&00,X
.clr_flag2
STA WS+&00,X
.CheckIsOk
RTS
:
.CheckDir:JSR CheckChannel
.CheckDir2
LDA WS+&00,X:AND #&10:BEQ CheckIsOk
.ChIsADir
JSR zero_flag:\ Close channel
JSR errors:EQUB 181:EQUS "Is a directory":BRK
:
.CheckInput
JSR CheckDir
LDA WS+&00,X:AND #&7F:CMP #64
BCC NOFRead:AND #4:BNE CheckIsOk
.NOFRead
JSR errors:EQUB &FF:EQUS "Not open for reading":BRK
:
.CheckOutput
JSR CheckDir:.CheckOut2
LDA WS+&00,X:BPL Not_Open_Update
.CheckWrite
AND #8:BNE CheckIsOk
.Not_Open_Update
JSR errors:EQUB 193:EQUS "Not open for update":BRK
:
.CheckPTRset
LDA WS+&00,X:BMI CheckWrite
JSR errors:EQUB 183:EQUS "Outside file":BRK
:
.UpdateLength
SEC
.UpdateWithAlloc:\   Enter with CC
TXA:PHA:TYA:PHA:PHP
LDA WS+&01+D,X:STA drive:JSR CheckDskChg0
LDA WS+&03,X:STA start+2
LDA WS+&02,X:STA start+1
LDA WS+&01,X:STA start+0
JSR LookForEntry
LDY #&12:LDA WS+&09,X:PLP:BCS UpdateLengthLow
TXA:ADC #8:TAX:LDA #0:\ Point to Alloc, low byte is zero
.UpdateLengthLow
STA (fptr),Y:INY
LDA WS+&0A,X:STA (fptr),Y:INY
LDA (fptr),Y:AND #&F8
ORA WS+&0B,X:STA (fptr),Y
JSR SaveThisDir
PLA:TAY:PLA:TAX
.UpdateOk
RTS
:
.CheckDskChg0
JSR FindDriveNumber
TXA:PHA:JSR CheckHADFSDisk:PLA:TAX
.CheckDskChg
\ drive already set
LDA WS+&0D,X:STA sect+0
LDA WS+&0E,X:STA sect+1
LDA WS+&0F,X:STA sect+2
JSR GetDir
LDA WS+&10,X:CMP &1110:BNE DiskChanged
LDA WS+&11,X:CMP &1111:BEQ UpdateOk
.DiskChanged
JSR ClearDIR:STA VFLG
JSR errors:EQUB 200:EQUS "Disk changed":BRK
:
.FindZero
LDA #0:RTS
.find
JSR GrabAbs:STX blk+0:STY blk+1
CMP #0:BEQ close
CMP #&40:BCC FindZero:JMP open
:
.close
TYA:BNE CloseOne
\ Close all
LDA #119:JSR OSBYTE:\ Ask MOS to close SPOOL/EXEC files
LDY #25
.CloseAllLp
TYA:JSR ChannelAddr
BEQ Closed
JSR CloseChn:.Closed
INY:CPY #30:BNE CloseAllLp
LDY #0:BEQ Closed_Ok
.CloseOne
JSR CheckChannel
.CloseChn
SEC:JSR argsY_FFa:BPL CloseInput:\ Update buffer, flagged as closing
\JSR CloseOutput
:
\.CloseOutput
JSR UpdateLength:\ also gets FSM, now reclaim unused bit
LDA WS+&09,X:PHA
CMP #1:\ C=1, extra page
LDA WS+&01,X:ADC WS+&0A,X:STA start+0
LDA WS+&02,X:ADC WS+&0B,X:STA start+1
LDA WS+&03,X:ADC WS+&0C,X:STA start+2
PLA:EOR #255:CMP #255
LDA WS+&12,X:SBC WS+&0A,X:STA len+1
LDA WS+&13,X:SBC WS+&0B,X:STA len+2
LDA WS+&14,X:SBC WS+&0C,X:STA len+3
TXA:PHA:JSR RemFrmFSM
CMP #0:BEQ CloseOutOk:JMP CompactError
.CloseOutOk
PLA:TAX:JSR SaveFSM
:
.CloseInput
JSR zero_flag:CPY &256
BNE CloseNotExec
STA &256:BEQ Closed_Ok:\ EXEC
.CloseNotExec
CPY &257:BNE Closed_Ok
STA &257:\ SPOOL
.Closed_Ok
LDX blk+0:RTS:\ A=0, Y=chn
:
.open
STA buf+0:JSR XYtoF2
JSR SearchPathBad:JSR CheckPath
JSR CheckDirInfo:\ A=0/1/2/&82
AND #&7F:\ Root is just a dir.
.OpenInX:\ RUN-EXEC
PHA:JSR find_a_channel
STY argchn:PLA
BNE open_file_found
BIT buf+0:BVC open_create_file
\ IN or UP
LDA buf+0:AND #8:BEQ open_exit
JMP FileNotFound
.open_exit
LDX blk+0:LDY blk+1:RTS
.open_create_file
\ OUT & no file, A=0
STA len+0:STA len+2
LDA #&40:STA len+1
TXA:PHA
LDA #&FF:CLC:JSR CreateEntry:\ Create 16K file
PLA:TAX
LDA #&C:STA WS+&00,X:\ WR bits
BNE open_acc_ok
.open_file_found
CMP #2:BNE open_not_dir
BIT buf+0:BMI IsADirError
\ IN(dir)
LDA buf+0:AND #4
BEQ open_not_dir
.IsADirError
JMP NotAFile
.open_not_dir
TXA:PHA
LDA buf+0:LSR A:ORA #&80:AND #&C0
JSR CheckNotOpen:\PLA:\TAX
\JSR GetAttrY:\ A=00000EWR
:
\.GetAttrY
JSR YDoIOwn:PLA:TAX
LDA (fptr),Y:ROL A:ROL attrs
DEY:LDA (fptr),Y:ROL A:ROL attrs
DEY:LDA (fptr),Y:ROL A:ROL attrs
LDA attrs:\AND #7:AND #3:EOR #3:\RTS
:
\CMP #4:\BCC open_noE
\LDA #0:\.open_noE
PHA
LDY #8:LDA (fptr),Y
BPL open_noD
PLA:ORA #5:PHA
.open_noD
PLA:ASL A:ASL A:STA WS+&00,X
LDA buf+0:CMP #&C0:BCS open_acc_ok
LSR A:LSR A:LSR A:LSR A
AND WS+&00,X:AND #&0C
BNE open_acc_ok
STA WS+&00,X
JMP InsufficientAccess
.open_acc_ok
TYA:PHA:LDY #8:LDA #0
.open_zero_lp
STA WS+&0C,X:DEX:DEY:\ Clear PTR and EXT
BNE open_zero_lp
TXA:CLC:ADC #8:TAX
PLA:TAY
BIT buf+0:BVC open_set_info
LDY #&12:LDA (fptr),Y:STA WS+&09,X
INY:LDA (fptr),Y:STA WS+&0A,X
INY:LDA (fptr),Y:AND #7:STA WS+&0B,X
:\ EXT=length
.open_set_info
LDA drive:STA WS+&01+D,X
LDY #&16:LDA (fptr),Y:STA WS+&01,X
INY:LDA (fptr),Y:STA WS+&02,X
LDA #0:STA WS+&03,X
\ Set start sector
LDA CURR+0:STA WS+&0D,X
LDA CURR+1:STA WS+&0E,X
LDA CURR+2:STA WS+&0F,X:\ dir
LDA &1110:STA WS+&10,X
LDA &1111:STA WS+&11,X:\ ID
LDY #&12:LDA (fptr),Y
INY:CMP #1
LDA (fptr),Y:ADC #0:STA WS+&12,X
INY:LDA (fptr),Y:AND #7:ADC #0
STA WS+&13,X:LDA #0:ADC #0:STA WS+&14,X:\ alloc
LDA buf+0:AND #&C0:ORA WS+&00,X
STA WS+&00,X:LDA argchn:JMP open_exit
\
\
.find_a_channel
\ First check channel 26
LDX #CHN26 AND &FF:LDY #26
LDA CHN26:BNE FindChn2
BIT buf+0:BPL FindChnOk
.FindChn2
.z%
\ Check channel 25
LDX #CHN25 AND &FF:DEY
LDA CHN25:BEQ FindChnOk
:]:IFWS=&E00:z%=P%-z%:P%=P%-z%:O%=O%-z%
:
JSR NumChns:BEQ Too_Many_Open
TAY:LDX #&AB:\ Offset to first channel block
.FindChnLp
LDA WS+&00,X:BEQ FoundChn
.FindChnBump
TXA:SEC:SBC #32:TAX
CPX #&6B:BEQ FindChnBump
DEY:BNE FindChnLp
.Too_Many_Open
JSR errors:EQUB 192:EQUS "Too many open":BRK
.FoundChn:\ &AB,&8B,&4B -> 27,28,29
TXA:LSR A:LSR A:LSR A:LSR A:LSR A:\ A=5,4,2
CMP #3:EOR #7:ADC #24:TAY:\ Y=24+2+1=27  24+3+1=28  24+5+0=29
.FindChnOk
RTS
:
.NumChns
LDX &F4:LDA &DF0,X:LSR A:LSR A
LSR A:LSR A:AND #3:RTS
:
.ChannelRange
CMP #25:BCC ChnRangeOk
EOR #&FF:CMP #&E2:EOR #&FF
.ChnRangeOk
RTS:\ Returns CS=25..29, CC=outside channel range
:
.ChannelAddr
JSR ChannelRange:BCC channel_error
SBC #23:PHA:CMP #6:ADC #0            :\ A=2,  3,  4,  5,  7
EOR #7:ASL A:ASL A:ASL A:ASL A:ASL A :\ A=&A0,&80,&60,&40,&00
CLC:ADC #&4B:TAX                     :\ X=&EB,&CB,&AB,&8B,&4B
PLA:CMP #4:BCC P%+4:ADC #3           :\ A=2,  3,  8,  9,  10
ADC #&C:STA buf+1:LDA #0:STA buf+0   :\ A=&0E,&0F,&14,&15,&16
LDA WS+&00,X                          :\ Get channel flag
.CheckChnOk
RTS
\ WS,X=channel info, (buf),Y points to buffer
:
.channel_error
JSR errors:EQUB 222:EQUS "Channel":BRK
:
.CheckChannel
JSR ChannelAddr:BNE CheckChnOk
.Channel_Not_Open
JSR errors:EQUB 222:EQUS "Channel not open":BRK
:
.CheckNotOpenFF
LDA #&FF
.CheckNotOpen
PHA:LDX #&90
.CheckNotOpLp
CPX #&6B:BEQ F_NotOpen:\ Skip &6x/&7x
PLA:PHA:AND WS+&00,X:BEQ F_NotOpen
LDA WS+&01,X:CMP sect+0:BNE F_NotOpen
LDA WS+&02,X:CMP sect+1:BNE F_NotOpen
LDA WS+&03,X:CMP sect+2:BNE F_NotOpen
LDA WS+&01+D,X:CMP drive:BNE F_NotOpen
JSR errors:EQUB 194:EQUS "File open":BRK
.F_NotOpen
TXA:CLC:ADC #32:TAX
BCC CheckNotOpLp
PLA:RTS
:
\.hadfs8
]
PRINTCHR$11;STRING$(20,CHR$9);(O%-mcode%)DIV1024":";(O%-mcode%)MOD1024" Kbytes"
>"S.HADFS8"