REM >HADFS5
REM Block 5 of HADFS source
REM 07/06/1992, 4:30pm
REM 20/11/1994, RunExec now in #2
REM Solved find_blank problem
REM 26/08/1996: Rewritten OsFile
REM 28/07/1998: Bugfix for =TIME$ on MOS 5.xx
REM DiskMainLoop now with disk access code, path scanning now in here
:
PRINT "Assembling S.HADFS5"
REM P%=hadfs5
O%=P%-Block%+mcode%
[OPT0
:
.file
JSR GrabAbs:PHA:CLC:ADC #3
CMP #12:BCC file1:PLA:RTS
.file1
PHA:STX blk+0:STY blk+1:LDY #0
LDA (blk),Y:STA &F2:INY
LDA (blk),Y:STA &F3:DEY
JSR SearchPathname      :\ A=&FF, null pathname
.z%
BMI BadFilename
:]:IF_BasChain%:z%=P%-z%:P%=P%-z%:O%=O%-z%
.z%
BPL file2
PLA:PHA:CMP #2:BNE BadFilename
LDA OBJECT+0:BPL BadFilename
LDA OBJECT+1:STA drive
LDA OBJECT+2:STA fptr+0:LDA OBJECT+3:STA fptr+1
JSR GetSectAddr
LDA #1:STA OBJECT+0
.file2
:]:IFNOT_BasChain%:z%=P%-z%:P%=P%-z%:O%=O%-z%
TAY                                  :\ Y=file type 0/1/2
PLA:ASL A:TAX                        :\ index into dispatch table
LDA fileTable+0,X:STA ws+0
LDA fileTable+1,X:STA ws+1
PLA:JSR JumpWS
TXA:LDX blk+0:LDY blk+1:RTS
.BadFilename:JMP Bad_Filename
.fileTable
EQUW fileFD:EQUW fileFE
EQUW load  :EQUW save
EQUW file01:EQUW file02
EQUW file03:EQUW file04
EQUW file05:EQUW delete
EQUW create:EQUW cdir
\ On entry to osfile routines:
\  A=function code
\  Y=file type 0/1/2
\ On exit:
\  X=returned file type
:
.AddB4
PHA:LDA fptr+0:CLC:ADC #8:STA fptr+0
LDA fptr+1:ADC #0:STA fptr+1:PLA:RTS
.SubB4
PHA:LDA fptr+0:SEC:SBC #8:STA fptr+0
LDA fptr+1:SBC #0:STA fptr+1:PLA:RTS
:
.CheckDirInfo
\ Entry; A=file type 0/1/2
\     B0/1=>sector
\     B4/5=>file info or
\          FFxx if unresolved dir.
\ Exit;  A=file type 0/1/2/&82
\        Flags set
\     If A=&82, root info created
JSR CheckForDir:BPL CheckDirEnd
JSR ReadFSM:BEQ CheckDirRoot
LDA #0:\ Drive not present/not HADFS
.CheckDirEnd
RTS
.CheckDirRoot
LDX #8:.CheckDirLp
LDA #&20:STA &F21,X:STA fptr+0
LDA RootOff,X:TAY
LDA &F17,X:STA &F2A,Y
DEX:BPL CheckDirLp
\ A=0
STA &F2D:STA &F32:STA &F37
LDA #3:STA &F33:\  len=&0300
LDA #71:STA &F36:\ sec=&0047
LDA #&F:STA fptr+1:\ (fptr)=>info
LDA &F34:PHA:AND #&F8:STA &F34
PLA:ROR A:LDA #64:ROR A
STA &F29:\ Year b4
LDA #ASC"$":STA &F20
LDA #&A0:STA &F28:STA &F23:\ DL
JSR GetSectAddr:\ B0/1=71, '$'
LDA #&82:\ dir, b7=root
RTS
.RootOff
EQUB 0
EQUB 4:EQUB 5:EQUB 10:EQUB 11
EQUB 1:EQUB 2:EQUB 6:EQUB 7
:
.ReadInfo0
PLA:LDA #0
.fileFE
TAX:RTS
:
.file05
LDA #&F5:\ b7=read
.fileFD:.file01:.file02
.file03:.file04
\ A=action, Y=filetype
PHA:TYA:JSR CheckDirInfo
BEQ ReadInfo0
BPL P%+5:JMP ReadInfo1
PLA:BPL P%+5:JMP ReadInfo2:\ Reading
JSR CanISave:JSR AddB4               :\ Align blk and fptr pointers
:
CMP #3:BCS SetExec                   :\ Skip setting load address
PHA:LDY #5                           :\ Point to load high byte
.z%
BIT &110C:BMI SetLoadLp              :\ Large dir, set all four bytes
:]:IF_SmallDIR%:z%=P%-z%:P%=P%-z%:O%=O%-z%
LDA (blk),Y:AND #&3F:STA (blk),Y     :\ Lose top two bits
LDA (fptr),Y:AND #&C0:ORA (blk),Y    :\ Merge with existing year bits
STA (fptr),Y:DEY                     :\ Store as load high byte
.SetLoadLp
LDA (blk),Y:STA (fptr),Y             :\ Copy to load address
DEY:CPY #1:BNE SetLoadLp:PLA
:
.SetExec
LDY #9:PHA:AND #1:BEQ SetAttr        :\ Skip setting exec address
.SetExecLp
LDA (blk),Y:STA (fptr),Y             :\ Copy to exec address
DEY:CPY #5:BNE SetExecLp
:
.SetAttr
JSR SubB4                            :\ Restore blk pointer
PLA:PHA:CMP #1:BEQ SetAttrs          :\ Jump to set attributes
CMP #4:BNE SetDone                   :\ Skip setting attributes
:
.SetAttrs
LDY #&E:LDA (blk),Y                  :\ Get access from control block
EOR #&33:STA attrs:LDY #7            :\ Convert to internal format
.SetAttrLp
LDA (fptr),Y:AND #127:ROL A          :\ Copy access into filename b7
ROL attrs:ROR A:STA (fptr),Y
DEY:BPL SetAttrLp
:
\\ Needs changing for LargeDIRs
LDY #&F:LDA (blk),Y                  :\ Get day from control block
ASL A:ASL A:ASL A:STA attrs:PHP      :\ Move up into b3-b7, save year b4
LDY #&14:LDA (fptr),Y:AND #7         :\ Get length b16-b18
ORA attrs:STA (fptr),Y               :\ Merge with day and store back
LDY #&10:LDA (blk),Y                 :\ Get month/year from control block
LDY #&15:STA (fptr),Y                :\ Store in directory
LDY #9:LDA (fptr),Y:ASL A            :\ Get filename byte 9
PLP:ROR A:STA (fptr),Y               :\ Copy year b4 into it
:
LDY #&F:LDA (blk),Y                  :\ Get day/year from control block
AND #&C0:STA attrs                   :\ Keep year b5-b6
LDY #&0D:LDA (fptr),Y:AND #&3F       :\ Get load high byte
ORA attrs:STA (fptr),Y               :\ Merge with year and store back
:
.SetDone
JSR SaveThisDir
.ReadInfo1
PLA
.ReadInfo2
CMP #&FD:BEQ ConvertBlk
.ConvertBlk0
AND #127:\ b7=0, read attrs
.ConvertBlk
PHA:JSR AddB4:LDY #2
.ConvBlkLp
LDA (fptr),Y:STA (blk),Y
INY:CPY #17:BNE ConvBlkLp
LDA drive:STA (blk),Y:DEY
LDA #0:STA (blk),Y
LDY #13:STA (blk),Y
DEY:LDA (blk),Y:AND #7:STA (blk),Y
JSR SubB4
:
LDY #5:LDA (blk),Y:JSR LoadHighByte:STA (blk),Y
:
LDY #8:LDA (fptr),Y:ROL A:\ Dir?
BCS ConvBlkDir:JSR YDoIOwn
LDA (fptr),Y:CLC:BPL ConvBlkDir
LDA #&FE:EQUB &2C:\ BIT
.ConvBlkDir
LDA #0:\ Skipped by BIT
ADC #1:TAX:\ Type
PLA:BMI ConvBlkUser
\ Read attrs & date
LDY #7:.ConvBlkLp2
LDA (fptr),Y:ROL A:ROL attrs
DEY:BPL ConvBlkLp2
LDA attrs:EOR #&33
LDY #&E:STA (blk),Y:\ Attrs
:
\\ Needs changing for LargeDIRs
:
LDY #&15:LDA (fptr),Y
LDY #&10:STA (blk),Y:\ Month+Year
LDY #&14:LDA (fptr),Y:PHA
LDY #9:LDA (fptr),Y:ROL A:PLA:ROR A
LSR A:LSR A:STA attrs
LDY #&D:LDA (fptr),Y
.z%
CMP #&C0:BCC P%+4:LDA #0            :\ Force short year if b7-6=11
:]:IF_NoYearFix%:z%=P%-z%:P%=P%-z%:O%=O%-z%
AND #&C0:ORA attrs:LDY #&F:STA (blk),Y
:
\ X=type
RTS
:
.ConvBlkUser
LDY #8:LDA (fptr),Y:BPL ConvUser2
JSR GetDir:\ to get user
.ConvUser2
LDY #2:LDA &1113:STA (blk),Y:INY
LDA &1112:LSR A:LSR A:LSR A:LSR A
STA (blk),Y:INY:LDA #0
STA (blk),Y:INY:STA (blk),Y
\ acc=User, aux=000
\ X=type
.ConvBlkRTS
RTS
:
.EntryLocked
JSR errors:EQUB 195:EQUS "Entry locked":BRK
:
.delete
JSR CheckNoWildcards:TYA
JSR CheckForDir:BMI EntryLocked
TAX:BEQ ConvBlkRTS:\ A=0
JSR CanISave:LDY #3
LDA (fptr),Y:BMI EntryLocked
JSR CheckNotOpenFF
JSR ConvertBlk0
TXA:CMP #2:BNE DeleteFile
PHA:JSR CheckCLU
LDA CURR:PHA:LDA CURR+1:PHA:LDA CURR+2:PHA
JSR GetDir
LDA &110C:AND #31:BNE DirNotEmpty
::JSR GetLink::BEQ DirEmpty
\\LDA &110E:\\ORA &110F:\\BEQ DirEmpty
\ Dir is linked, can't be empty
.DirNotEmpty
JSR errors:EQUB 180:EQUS "Dir. not empty":BRK
.DirEmpty
PLA:STA sect+2:PLA:STA sect+1:PLA:STA sect+0
JSR GetDir:PLA
\ Drop through to...
:
.DeleteFile
JSR DeleteThisEntry:CLC
.RemoveEntry
PHA:PHP:LDY #0:TYA:STA (fptr),Y
DEC &110C:\ Dec number
LDA &110C:AND #31:BNE DeleteNoLink
LDA CURR+0:STA start+0:LDA CURR+1:STA start+1:LDA CURR+2:STA start+2
JSR GetFIRST:BEQ DeleteNoLink
\\ Push LINK
LDA &110E:PHA:LDA &110F:PHA
.DeleteLp
JSR GetDir:JSR GetLink
LDA sect+2:CMP start+2:BNE DeleteLp
LDA sect+1:CMP start+1:BNE DeleteLp
LDA sect+0:CMP start+0:BNE DeleteLp
\ This chunk points to the one to
\ be deleted
\\ Pop LINK
PLA:STA &110F:PLA:STA &110E
JSR C8to300:PLP:BCC DeleteFSM
JSR CheckHadfsDiskX:\ trashes addr,sect
.DeleteFSM
JSR RemoveFromFSM:CLC:PHP:\ Remove a chunk
.DeleteNoLink
PLP:BCS DeleteNoFSM:JSR SaveFSM
.DeleteNoFSM
JSR SaveThisDir:PLA:TAX:\ 1/2/FF
RTS
:
.CheckCLU
LDX #0:LDY #0
.ChkCLULp
LDA CSD+0,X:CMP sect+0:BNE ChkCLUOk
LDA CSD+1,X:CMP sect+1:BNE ChkCLUOk
LDA CSD+2,X:CMP sect+2:BNE ChkCLUOk
LDA CSD+d,X:CMP drive:BEQ ChkCLUErr
.ChkCLUOk
INX:INX:INX:INY:CPX #9:BNE ChkCLULp
RTS
.ChkCLUErr
LDA CSDinfo,Y:STA &101:LDY #3
.ChkCLULp2
LDA CSDtxt,X:STA &10E,Y
INX:DEY:BNE ChkCLULp2:LDY #13
.ChkCLULp3
LDA CantDelete-1,Y:STA &101,Y
DEY:BNE ChkCLULp3
STY &112:STY &100:JMP &100
.CSDinfo
EQUB 150:EQUB 151:EQUB 162
.CSDtxt
EQUS "DSCBILDRU"
.CantDelete
EQUS "Can't delete "
:
.DeleteThisEntry
PHA:LDA len+2:PHA
LDA len+1:PHA:LDA len+0:PHA
\ preserve length
LDY #20:LDA (fptr),Y:AND #7:STA len+2
DEY:LDA (fptr),Y:STA len+1
DEY:LDA (fptr),Y:BEQ DelThis2
INC len+1:BNE DelThis2
INC len+2:.DelThis2
LDY #22:LDA (fptr),Y:STA start+0
INY:LDA (fptr),Y:STA start+1
JSR CheckHadfsDiskX:\ trashes addr,sect
JSR RemoveFromFSM
PLA:STA len+0:PLA:STA len+1:PLA:STA len+2
PLA:RTS:\ FSM loaded and updated
\ fptr points to entry
:
:
.YDoIOwn
\JSR DoIOwn:\BEQ IOwnOk:\LDY #6:\RTS
\.IOwnOk:\LDY #2:\RTS
:
LDY #2:JSR DoIOwn:BEQ IOwnOk
LDY #6:.IOwnOk:RTS
:
.CanISave
PHA:JSR DoIOwn
BMI InsufficientAccess:PLA:RTS
:
.NotAFile
JSR file_errors:EQUB 181:EQUS "is not a file":BRK
.ExecuteOnly
JSR errors:EQUB 189:EQUS "File execute only":BRK
.InsufficientAccess
JSR errors:EQUB 189:EQUS "Insufficient access":BRK
:
:
\ Load and Save routines:
:
.load
\ Should check OPT1 setting
\ A=&FF, Y=0/1/2
CPY #1:BEQ LoadFile:BCS NotAFile
JMP FileNotFound
.LoadFile
LDA #&80:JSR CheckNotOpen
JSR YDoIOwn
DEY:DEY:LDA (fptr),Y:BPL LoadFile1
INY:INY:LDA (fptr),Y
BMI ExecuteOnly:BPL InsufficientAccess
.LoadFile1
:
\LDA (fptr),Y:\BMI ExecuteOnly
\DEY:\DEY:\LDA (fptr),Y
\BMI InsufficientAccess
LDX #3:LDY #6
LDA (blk),Y:BEQ LoadAddr
LDY #13
\ Enter here from *RUN:
.UseFileAddr
LDA (fptr),Y:STA addr,X
DEY:DEX:BPL UseFileAddr
LDA addr+3:JSR LoadHighByte          :\ Remove year bits if present
STA addr+3:JMP LoadStart
.LoadAddr
DEY:LDA (blk),Y:STA addr,X
DEX:BPL LoadAddr
.LoadStart
LDY #&12:LDA (fptr),Y:STA len+0
INY:LDA (fptr),Y:STA len+1
INY:LDA (fptr),Y:AND #7:STA len+2
LDA sect+0:STA start+0:LDA sect+1:STA start+1:\\ Make subroutine
LDA #0:STA start+2:\ 16-bit disk
.LoadData
LDA blk+1:CMP #&FF:BEQ LoadNoConv
JSR ConvertBlk0:.LoadNoConv
LDA #0:STA action:JSR DiskMain       :\ Load data from disk
:
\ Calls CheckAddr, ScreenOn, ScreenOff, updated addr, sect
:
LDA len+0:BEQ LoadFinish             :\ No final sector to load
LDA addr+2:PHA:LDA addr+3:PHA:TAX
LDA addr+0:PHA:LDA addr+1:PHA        :\ Save address of final sector
.z%
INX:BNE LoadFromF                    :\ Load to Tube, use FSM buffer
CMP #FSM DIV 256:BNE LoadFromF       :\ Load to main memory, use FSM buf
JSR ClearDIR
LDA #DIR DIV 256:BNE LoadLast        :\ Loading to FSM buf, use DIR buf
:]:IFWS=&0E00:z%=P%-z%:P%=P%-z%:O%=O%-z%
.LoadFromF
JSR ClearFSM:LDA #FSM DIV 256        :\ Claim FSM buffer and load to it
.LoadLast
JSR GetOneAddr:LDX addr+1            :\ Get final sector
PLA:STA addr+1:PLA:STA addr+0
PLA:STA addr+3:PLA:STA addr+2        :\ Restore final address
.z%
CPX #(DIR DIV 256)+1:BNE LoadCont    :\ Do final sector if not &0F00
.LoadFrom11
LDA DIR,Y:STA (addr),Y               :\ Copy final part to &0Fxx
INY:CPY len+0:BNE LoadFrom11
LDX #1:RTS                           :\ Return object=&01 - file
:]:IFWS=&0E00:z%=P%-z%:P%=P%-z%:O%=O%-z%
:
\ Enter here for GbPb 5..12 and loading last sector
.LoadGbPb
.LoadCont
BIT &27A:BMI LoadToTube              :\ Tube present, is is Tube load?
.LoadToHost
JSR ScreenOn:LDY #0                  :\ Select screen if needed
.LoadHostLp
LDA FSM,Y:STA (addr),Y               :\ Copy data to memory
INY:CPY len+0:BNE LoadHostLp
JSR ScreenOff                        :\ Deselect screen if needed
.LoadFinish
LDX #1:RTS                           :\ Return object=&01 - file
.LoadToTube
LDY addr+3:INY:BEQ LoadToHost        :\ Addr is &FFxxxxxx, load to I/O
JSR TubeClaimLoad:LDY #0
.LoadTubeLp
LDA FSM,Y:STA &FEE5:INY              :\ Copy data to Tube
JSR TubeWait
CPY len+0:BNE LoadTubeLp
JSR TubeRelease:LDX #1:RTS           :\ Return object=&01 - file
:
.save
\ Should check *OPT1 setting
JSR create:\ make the entry
LDA #&FF:STA action
JSR DiskMain:\ Save the data, also check addr
LDX #1:RTS
:
.create
TYA:PHA:LDY #10
.MakeLp1
LDA (blk),Y:STA addr-10,Y:\ Put start in &C4-&C7
INY:CPY #&E:BNE MakeLp1
SEC:LDA (blk),Y:SBC addr+0:STA len+0
INY:LDA (blk),Y:SBC addr+1:STA len+1
INY:LDA (blk),Y:SBC addr+2:STA len+2
INY:LDA (blk),Y:SBC addr+3
BNE LengthTooLong
LDA len+2:CMP #8:BCC CreateLenOk
.LengthTooLong
JSR errors:EQUB 198:EQUS "Length too long":BRK
.CreateLenOk
PLA:TAY:JSR CheckPath
CPY #2:BEQ FileExists
CLC:TYA:BEQ CreateEntry:\ CC=file, PL=normal
\ file already there
LDY #3:LDA (fptr),Y:BPL P%+5:JMP EntryLocked
JSR CanISave
JSR DeleteThisEntry:\ loads FSM & removes entry
CLC:LDA #0:BEQ CreateGo
.FileExists
JSR errors:EQUB 196:EQUS "File exists":BRK
:
\ Called by CDir, Save & OpenOut:
\ C=File/Dir, N=normal/opened
.CreateEntry
PHP:JSR FindBlankEntry
LDY #17:LDA #0
.CreateLp2
STA (fptr),Y:DEY
BPL CreateLp2:\ blank out name & addresses
JSR CanISave:INC &110C:\ num
JSR CheckHadfsDiskX:PLP:\ trashes addr,sect
\ Enters here when overwriting existing entry
\ Will date be zeroed correctly?
.CreateGo
PHP:JSR CheckNoWildcards
\ (fptr)=> entry
\ &C4-7 = data address
\ &C8-A = length
JSR PutInName
LDY #&14:.create_length_lp
LDA len-18,Y:STA (fptr),Y:\ copy from &C8/9/A to (fptr)+18/19/20
DEY:CPY #&11
BNE create_length_lp
CMP #0:BEQ create_whole_number
LDA len+1:CLC:ADC #1:STA len+1
LDA len+2:ADC #0:STA len+2
.create_whole_number
\ &C9/A = number of sectors
JSR find_free_space
LDY #&17
LDA start+1:STA (fptr),Y:DEY
LDA start+0:STA (fptr),Y
PLP:BCC create_file1
LDY #3:JSR set_b7:\ L
LDY #8:JSR set_b7:\ D
BMI create_continue
.create_file1
BPL create_file2
LDY #17:LDA #&FF
.CreateOutLp
STA (fptr),Y:DEY
CPY #9:BNE CreateOutLp
\ set load & exec to &FFFFFFFF
BEQ create_continue
.create_file2
LDA fptr+1:PHA:LDA fptr+0:PHA
ADC #8:STA fptr+0
LDA fptr+1:ADC #0:STA fptr+1
LDY #2:.CreateAddrLp
LDA (blk),Y:STA (fptr),Y
INY:CPY #10
BNE CreateAddrLp
\ copy load & exec addrs
PLA:STA fptr+0:PLA:STA fptr+1
.create_continue
JSR SetCrDate
\ entry made, FSM modified
.SavePutEntry
\ save modified FSM and directory
LDA addr+3:PHA:LDA addr+2:PHA:LDA addr+1:PHA:LDA addr+0:PHA
JSR SaveFSM
JSR SaveThisDir
PLA:STA addr+0:PLA:STA addr+1:PLA:STA addr+2:PLA:STA addr+3
LDX #1
.cdir_exit
RTS
:
.C8to300
LDA #0:STA len+0:STA len+2
LDA #3:STA len+1:\ Len=&300
RTS
:
.ZeroNumber
LDA &110C:AND #&E0:STA &110C:RTS
:
.cdir
CPY #0:BEQ cdir_ok
CPY #2:BEQ cdir_exit
JMP FileExists
.cdir_ok
JSR C8to300:\ Set length
SEC:JSR CreateEntry:\ CS=dir
LDA &1114:STA &110A
LDA &1115:STA &110B:\ Try FIRST
ORA &1114:BNE DoCDirUp
LDA CURR:STA &110A
LDA CURR+1:STA &110B:\ Use CURR
.DoCDirUp
JSR ZeroNumber
\ DiskID already set
LDA &1112:AND #&FC:STA &1112
\ Set boot option to zero
LDY #10
.DoCDirLp
\ Copy name and clear FIRST...
LDA OBJECT-1,Y:STA &1100-1,Y
LDA #0:STA &1113,Y
DEY:BNE DoCDirLp
STY &110D:\ Cycle
STY &110E:STY &110F:\ Link
JSR StartToSect:JSR PutDir
JSR ClearDIR:LDX #2:RTS
:
.GetFIRSTorCURR
JSR GetFIRST:BNE CURRtoSectOk
.CURRtoSect:\.CURRtoB0
LDA CURR+0:STA sect+0
LDA CURR+1:STA sect+1
LDA CURR+2:STA sect+2
ORA sect+1:ORA sect+0
.CURRtoSectOk
RTS
:
.SaveThisDir
JSR CURRtoSect
LDA CURR+d:STA drive
INC &110D:\ cycle no
.PutDir
LDA #3:STA num:\ number
LDA #&FF:STA action:\ write
JMP DiskAccDIR
:
.set_b7
LDA (fptr),Y:ORA #128:STA (fptr),Y
RTS
:
.PutInName
LDY #9:.PutNameLp
LDA (fptr),Y:ASL A:PHP
LDA OBJECT,Y:ASL A:PLP
ROR A:STA (fptr),Y
DEY:BPL PutNameLp
RTS
:
.SetCrDate0
LDA #0:STA Ctrl+2:STA Ctrl+1:RTS
.SetCrDate:CLC
.SetCrDateFSM
:
\ Bug in MOS 5.xx - =TIME$ creates Save problems
\ If MOS5 + NetFS + FSTime - Need to save Cx, Select DFS, then HADFS
\ Also, check year top bits
\ Also, SoftRTC corrupts &Bx,&Cx memory
:
PHP:LDX #&B:.SCD_lp0               :\ 13/10/99 Was &A, now &B
LDA &C0,X:PHA:DEX:BPL SCD_lp0      :\ Save some HADFS workspace
:
LDX #Ctrl AND 255:LDY #Ctrl DIV 256
LDA #1:STA Ctrl:JSR SetCrDate0
LDA #14:JSR OSWORD
:
LDX #0:LDY #0:.SCD_lp1
PLA:CMP &C0,X:BEQ SCD_lp1a
INY:.SCD_lp1a                      :\ Restore workspace, checking changes
STA &C0,X:INX:CPX #&C:BNE SCD_lp1  :\ 13/10/99 Was &B, now &C
TYA:BEQ SCD_NoChange
LDA CURR:PHA:LDA CURR+1:PHA:LDA CURR+2:PHA
LDA CURR+d:PHA:LDA fptr+0:PHA:LDA fptr+1:PHA
LDY #4:JSR fx143fs:JSR fx143go
PLA:STA fptr+1:PLA:STA fptr+0:PLA:STA CURR+d
PLA:STA CURR+2:PLA:STA CURR+1:PLA:STA CURR
.SCD_NoChange
:
LDA Ctrl:ORA Ctrl+2:BNE SetCrDate2
STA Ctrl+0:.SetCrDate2
LDX #6:LDA #0:CLC
.SetCrDateLp
ADC Ctrl,X:DEX:BPL SetCrDateLp
CMP #&B8:BNE SetCrDate3:\ &B8=31/12/99,23-59-59 - 'unset' value
JSR SetCrDate0:STA Ctrl+0
:
\\ Needs changing for LargeDIRs, set correct FSM locations
\ Stacked Cy, CC=SmallDIR, CS=FSM (or LargeDIR)
\ Possibly needs to pass Y offset
.SetCrDate3
LDA Ctrl+2:JSR BCDtoBIN              :\ Get day
PHA:LDY #&14:AND #31                 :\ Ensure 5-bit range
ASL A:ASL A:ASL A:JSR SCD_PutIn      :\ Store day
PLA:LSR A:AND #&F0:INY:STA (fptr),Y  :\ Save yearHi from NetFS here
LDA Ctrl:JSR BCDtoBIN                :\ Get year
CLC:ADC (fptr),Y                     :\ Add to YearHi to get correct year
SEC:SBC #81                          :\ Reduce to offset from 1981
BCS SetCrDate4:SBC #&9B:.SetCrDate4  :\ Adjust if wrapped past 1999
AND #127:PLP:PHA                     :\ Ensure only 7 bits
BCC SetCrDate5                       :\ CC=Split year, CS=compact year
LSR A:LSR A:LSR A:LSR A              :\ Move year b4-b6 to b0-b2
DEY:JSR SCD_PutIn                    :\ Store year b4-b6
INY:BNE SetCrDate6                   :\ Jump to set year/month
:
.SetCrDate5
LDY #&0D
LDA (fptr),Y:AND #&3F:STA (fptr),Y   :\ Clear to bits from load addr
PLA:PHA:ASL A:AND #&C0:JSR SCD_PutIn :\ Store year b5-b6 in load addr
PLA:PHA:LSR A:LSR A:LSR A:LSR A:PHP  :\ Move year b4 into Cy
LDY #9:LDA (fptr),Y                  :\ Get filename character
ASL A:PLP:ROR A:STA (fptr),Y:LDY #&15:\ Copy year b4 into filename
:
.SetCrDate6
PLA:ASL A:ASL A:ASL A:ASL A          :\ Move YearLo to b4-7
STA (fptr),Y                         :\ Store YearLo
LDA Ctrl+1:JSR BCDtoBIN              :\ Get month
AND #15                              :\ Store it with year
:
.SCD_PutIn
ORA (fptr),Y:STA (fptr),Y:RTS
\
\
.find_free_space
LDX #0:.find_free_loop
LDA &F20,X:ORA &F21,X:BNE FindFreeSub
.find_free_full
JSR ClearDIR:JSR errors:EQUB 198:EQUS "Disk full":BRK
.FindFreeSub
SEC:LDA &F22,X:SBC len+1:TAY
LDA &F23,X:SBC len+2
BCS find_free_found
INX:INX:INX:INX
CPX #&D0:BCC find_free_loop
.CompactError
JSR ClearDIR:JSR errors:EQUB 152:EQUS "Compaction required":BRK
.find_free_found
STA &F23,X:TYA:STA &F22,X
LDA &F20,X:STA start+0
CLC:ADC len+1:STA &F20,X
LDA &F21,X:STA start+1
ADC len+2:STA &F21,X
TYA:ORA &F23,X
BNE find_free_Ok
.find_free_compact
LDA &F24,X:STA &F20,X
INX:CPX #&D0:BCC find_free_compact
.find_free_Ok
LDA #0:STA start+2:\ 16-bit FSM
RTS
:
.SaveFSM
JSR SectFSM
.SavePageF
LDA #0:STA addr+0:LDA #&F:STA addr+1:LDA #&FF:STA action:JMP DiskOneSector
:
.GetFIRST ::\\ Move this
LDA &1114:STA sect+0:LDA &1115:STA sect+1
LDA &1116:BIT &110C:BMI P%+4:LDA #0
STA sect+2:ORA sect+1:ORA sect+0:RTS
:
.FindBlankLook
JSR start24:BEQ FindBlankOk
CMP #31:BEQ FindBlankFull
BIT &110C:BPL FindBlankLp
CMP #21:BCS FindBlankFull
.FindBlankLp
LDA (fptr),Y:BEQ FindBlankOk
INX:JSR add24:BNE FindBlankLp
.FindBlankOk
RTS
.FindBlankFull
LDA #&FF:RTS
:
.FindBlankEntry
\ Could do JSR GetFIRST\\JSR GetDir
\ Try CURR first, last chunk will be in memory
JSR FindBlankLook:BEQ FindBlankOk
JSR GetFIRST:BEQ FindExtend
.FindBlankLp2
JSR GetDir
JSR FindBlankLook:BEQ FindBlankOk
JSR GetLink:BNE FindBlankLp2
.FindExtend
\ Try to extend
LDA len+0:PHA:LDA len+1:PHA
LDA len+2:PHA:\ Save length
JSR CheckHadfsDiskX:JSR C8to300::\ trashes addr,sect
JSR find_free_space:JSR SaveFSM::\ trashes addr,sect
JSR GetFIRST:PHA               ::\ sect=FIRST
JSR GetFIRSTorCURR             ::\ sect=FIRST or CURR
LDA sect+0:STA &1114
LDA sect+1:STA &1115
LDA CURR+0:PHA:LDA CURR+1:PHA:LDA CURR+2:PHA
LDA &110C:PHA                  :\ Keep flags, set entries to 0
JSR ZeroNumber:JSR StartToSect ::\ sect=start (from FindFreeSpace)
JSR PutDir
PLA:STA &110C                  :\ Restore number of entries
PLA:STA CURR+2:PLA:STA CURR+1:PLA:STA CURR+0
PLA:BNE FindFirstOk:STA &1114:STA &1115
.FindFirstOk
JSR StartToSect:\ Get sect of new chunk from start
LDA sect+0:PHA:.z%:BIT &110C:BPL FndFst16
STA &1117:LDA sect+1:PHA:STA &1118:\ Set LINK
LDA sect+2:PHA:STA &1119:JMP FndFst24
:]:IF_SmallDIR%:z%=P%-z%:P%=P%-z%:O%=O%-z%
.FndFst16
STA &110E:LDA sect+1:PHA:STA &110F
LDA #0:PHA:.FndFst24
JSR SaveThisDir                ::\ trashes addr,sect
PLA:STA sect+2:PLA:STA sect+1:PLA:STA sect+0
JSR GetDir                     ::\ trashes addr,sect
JSR start24Y
\LDA #&18:\STA fptr+0
\LDA #&11:\STA fptr+1
PLA:STA len+2:PLA:STA len+1
PLA:STA len+0:\ Restore length
RTS
:
.CheckNoWildcards
LDX #9:.ChckWldLp
LDA OBJECT,X:CMP #ASC"*":BEQ Wild_Error
CMP #ASC"#":BEQ Wild_Error
DEX:BPL ChckWldLp
RTS
.Wild_Error
JSR errors:EQUB &FD:EQUS "Wildcards":BRK
:
:
\ Used when deleting files:
\ &C2/3=start sectors
\ &C9/A=number of sectors
.RemoveFromFSM
JSR RemFrmFSM:BEQ RemoveNone
JMP CompactError
\ Exit; EQ ok, NE not ok
.RemFrmFSM
LDA len+1:ORA len+2:BEQ RemoveNone
LDX #0:.remFSMlp:\.remove_FSM_loop
LDA &F20,X:ORA &F21,X:BEQ remFSMempty:\remove_FSM_empty
LDA start+0:SEC:SBC &F20,X
LDA start+1:SBC &F21,X
BCC remFSMentry:\remove_FSM_entry
INX:INX:INX:INX:CPX #&D0:BCC remFSMlp:\remove_FSM_loop
LDA #255:\Compact_Needed
.RemoveNone
RTS
.remFSMempty:\.remove_FSM_empty     :\ Add entry to end of FSM
JSR remFSMput_in    :\ Put start,len entry at end
STA &F24,X:STA &F25,X :\ Put new &00,&00 terminator after
BEQ remFSMjoin        :\ Try joining to previous entry
.remFSMentry:\.remove_FSM_entry
LDA start+0:CLC:ADC len+1:PHP
CMP &F20,X:BNE remFSMmiddle1
PLP:LDA start+1:ADC len+2:CMP &F21,X
BNE remFSMmiddle
LDA &F20,X:SEC:SBC len+1:STA &F20,X
LDA &F21,X:SBC len+2:STA &F21,X
.remFSMentry2
LDA &F22,X:CLC:ADC len+1:STA &F22,X
LDA &F23,X:ADC len+2:STA &F23,X
.remFSMjoin
CPX #0:BEQ remFSMend:\ At start of FSM, no preceeding entry
LDA &F1C,X:CLC:ADC &F1E,X:PHP
CMP &F20,X:BNE remFSMend1
PLP:LDA &F1D,X:ADC &F1F,X
CMP &F21,X:BNE remFSMend
LDA &F1E,X:CLC:ADC &F22,X:STA &F1E,X
LDA &F1F,X:ADC &F23,X:STA &F1F,X
.remFSMlp2
LDA &F24,X:STA &F20,X:INX
CPX #&D0:BNE remFSMlp2
LDA #0:RTS
.remFSMend1:PLP
.remFSMend:LDA #0:RTS
.remFSMmiddle1:PLP
.remFSMmiddle
CPX #0:BEQ remFSMfirst
LDA &F1C,X:CLC:ADC &F1E,X:PHP
CMP start+0:BNE remFSMfirst1
PLP:LDA &F1D,X:ADC &F1F,X
CMP start+1:BNE remFSMfirst
DEX:DEX:DEX:DEX
JMP remFSMentry2
.remFSMfirst1:PLP
.remFSMfirst
STX len+0:\LDX #&DC
\ This needs examining
:
.remFSMup1
INX:INX:INX:INX
LDA &F1C,X:ORA &F1D,X:BEQ remFSMup2
CPX #&D0:BCC remFSMup1
JMP CompactError:.remFSMup2
:
.remFSMfirst_lp
LDA &F1F,X:STA &F23,X:DEX
CPX len+0:BNE remFSMfirst_lp
.remFSMput_in
LDA start+0:STA &F20,X
LDA start+1:STA &F21,X
LDA len+1:STA &F22,X
LDA len+2:STA &F23,X
LDA #0:RTS
:
.FindFSMEntry
LDY #0:.FindFSMEnLp
LDA &F20,Y:ORA &F21,Y
BEQ FindFSMEnX
LDA &F20,Y:CMP start+0
BNE FindFSMEnNxt
LDA &F21,Y:CMP start+1
BEQ FoundFSMEn
.FindFSMEnNxt
INY:INY:INY:INY
CPY #&E0:BNE FindFSMEnLp
.FindFSMEnX
LDA #&FF
.FoundFSMEn
RTS
:
\.hadfs6
]
REM PRINT CHR$11;STRING$(20,CHR$9);(O%-mcode%)DIV1024":";(O%-mcode%)MOD1024" Kbytes"
:
PRINT CHR$11;STRING$(20,CHR$9);(O%-mcode%)DIV1024":";(O%-mcode%)MOD1024" Kbytes"
OSCLI"SAVE ROMb "+STR$~mcode%+" "+STR$~O%+" 3000 "+STR$~(Block%-&5000):Block%=P%
IF O%>&7BFF PRINT'"Overrunning screen"'':VDU7
>"S.HADFS6"