REM >HADFS6 v5.27
REM v5.26 New install routine
REM v5.27 Fixed install data flag, DiskID
:
PRINT "Assembling S.HADFS6"
REM P%=hadfs6
O%=P%-Block%+mcode%
[OPT0
:
.Copy
JSR WhatOS:BCS CopyMaster           :\ Use *MOVE if on Master
.CopyLp                             :\ Step back to point to start of 'COPY' string
DEY:LDA (&F2),Y:AND #&DF:CMP #ASC"C":BNE CopyLp
JSR F2toXY:JMP slash                :\ Try to do *COPY from disk
:
.CopyMaster
LDX #0:.CopyLp
LDA CopyText,X:STA &DC00,X          :\ Copy *MOVE command to string buffer
INX:CMP #ASC" ":BNE CopyLp          :\ NB, reusing label
.CopyLp
LDA (&F2),Y:STA &DC00,X:INY:INX     :\ Copy parameters to string buffer
CMP #13:BNE CopyLp                  :\ NB, reusing label
LDX #&05:EQUB &DA                   :\ &DA=PHX - we're running on a Master
LDY #&DC:EQUB &5A                   :\ &5A=PHY - we're running on a Master
TXA:JSR OSFileXY                    :\ Read info on source file
\ Should do 'Create' for dest, as *MOVE tries to OPENOUT 16k
LDX #0:LDY #&DC:JSR &FFF7           :\ Do *MOVE command
EQUB &7A:EQUB &FA                   :\ &7A=PLY, &FA=PLX
JSR XYtoF2                          :\ Convert XY pointer into (&F2),Y
.CopyLp
LDA (&F2),Y:INY:CMP #ASC" "         :\ Find destination filename
BNE CopyLp                          :\ NB, reusing label
LDA #4:JMP OSFile                   :\ Write attributes
:\ This is annoying as only one nybble needs doing
.CopyText
EQUS "MOVE "
:]:IF _OmitCopy%:z%=P%-Copy:P%=P%-z%:O%=O%-z%
:
.Account
JSR SearchPathname
CMP #2:BNE AccountOk
JSR GetDir:JSR CanISave
JSR GetHexNum
.AccountLp
LDA numstore+1
ASL A:ASL A:ASL A:ASL A:PHA
LDA &1112:AND #&0F:STA &1112
PLA:ORA &1112:STA &1112
LDA numstore:STA &1113
JSR SaveThisDir
JSR NextChunk:BNE AccountLp
.AccountOk
RTS
:
.BadRename
JSR errors:EQUB 176
EQUS "Bad rename":BRK
.RenAccDisks
JSR errors:EQUB 176
EQUS "Rename across disks":BRK
:
.rename
JSR TryFilename:JSR CheckForDir
BMI BadRename:\ *Rename $ ...
PHA:TYA:PHA:JSR CanISave
LDA #&C0:JSR CheckNotOpen
LDY #3:LDA (fptr),Y
BPL P%+5:JMP EntryLocked
BIT &110C:BMI BadRename ::\\ Large directory
LDA CURR+2:BNE BadRename ::\\ Large disk
JSR Clear26:LDY #23
.RenameLp1
LDA (fptr),Y:STA &F00,Y
LDA &1100,Y:STA &F20,Y
DEY:BPL RenameLp1
LDA fptr+0:STA &F18
LDA fptr+1:STA &F19
LDA CURR:STA &F1A
LDA CURR+1:STA &F1B
PLA:TAY:LDA CURR+d:PHA
JSR SearchPathBad:JSR CheckPath
\ Should check for *Rename ... $
TAY:JSR CheckNoWildcards
PLA:CMP CURR+d:BNE RenAccDisks
LDA CURR:STA &F1C
LDA CURR+1:STA &F1D
LDX #11
.RenameLp2
LDA &1100,X:CMP &F20,X
BNE RenameMove
DEX:BPL RenameLp2
\ Same dir, just renaming
TYA:BEQ RenameSame
LDA &F1B:CMP CURR+1:BNE RenExists
LDA &F1A:CMP CURR+0:BNE RenExists
LDA &F19:CMP fptr+1:BNE RenExists
LDA &F18:CMP fptr+0:BNE RenExists
\ Pointing to same entry
.RenameSame
JSR GetDirF1A:\ Ensure correct chunk in buffer
LDA &F19:STA fptr+1
LDA &F18:STA fptr+0:PLA:\ src type
.RenameObj
PHA:JSR PutInName:JSR SaveThisDir
PLA:CMP #2:BNE RenObjOk
JSR GetFIRSTorCURR
LDA sect+0:STA &F1E:LDA sect+1:STA &F1F
\ Need to change dir headers
LDA #0:STA fptr+0:LDA #&11:STA fptr+1
LDA &F16:STA sect+0
LDA &F17:STA sect+1:\ sec start
::LDA #0:STA sect+2::
.RenameDir
JSR GetDir:JSR PutInName
LDA &F1E:STA &110A
LDA &F1F:STA &110B:\ Up
JSR SaveThisDir
JSR GetLink:BNE RenameDir
.RenObjOk
RTS
:
.RenExists
JMP FileExists
:
.RenameMove
TYA:BNE RenExists
\ Dest must not exist
PLA:PHA:CMP #2:BNE RenameFile
LDA CURR:PHA:LDA CURR+1:PHA:LDA CURR+2:PHA
CMP &F17:BNE RenameCirc2
LDA CURR:CMP &F16:BNE RenameCirc2
BEQ CircularRename
.RenameCircle
JSR GetDir:.RenameCirc2
LDA &110A:CMP &F16:BNE RenameUp
LDA &110B:CMP &F17:BNE RenameUp
.CircularRename
JSR errors:EQUB 176
EQUS "Circular rename":BRK
.RenameUp
LDA &110A:STA sect+0
LDA &110B:STA sect+1:BNE RenameCircle
LDA sect+0:CMP #71:BNE RenameCircle
PLA:STA sect+2:PLA:STA sect+1:PLA:STA sect+0
JSR GetDir
.RenameFile
JSR CanISave
\ Need to move info as FindBlank
\ and Remove may load FSM to Fxx
LDA VFLG:AND #31:STA VFLG      :\ Using name store as workspace
LDY #29
.RenFileLp
LDA &F00,Y:STA DSKNAME,Y
DEY:BPL RenFileLp
JSR FindBlankEntry:LDY #23
.RenFileLp2
LDA DSKNAME,Y:STA (fptr),Y
LDA DSKNAME+8,Y:STA &F08,Y
DEY:BPL RenFileLp2
INC &110C:\ Number
PLA:JSR RenameObj:\ Saves dir
JSR GetDirF1A:\ Get src dir
LDA &F19:STA fptr+1:LDA &F18:STA fptr+0
SEC:JMP RemoveEntry
:
.GetDirF1A
LDA &F1A:STA sect+0:LDA &F1B:STA sect+1::LDA #0:STA sect+2
JMP GetDir
:
\.hadfs7
]
PRINTCHR$11;STRING$(20,CHR$9);(O%-mcode%)DIV1024":";(O%-mcode%)MOD1024" Kbytes"
> "S.HADFS7"