A2osX/BIN/X.CPMVRM.S.txt
2018-06-21 17:12:10 +02:00

820 lines
14 KiB
Plaintext
Raw Blame History

This file contains invisible Unicode characters

This file contains invisible Unicode characters that are indistinguishable to humans but may be processed differently by a computer. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

NEW
PREFIX /A2OSX.BUILD
AUTO 4,1
.LIST OFF
*--------------------------------------
X.COPY.BUF.SIZE .EQ 4096
*--------------------------------------
ZPPtr1 .EQ ZPBIN
ZPPtr2 .EQ ZPBIN+2
ZPFileName .EQ ZPBIN+4
ZPFileStat .EQ ZPBIN+6
*--------------------------------------
* File Header (16 Bytes)
*--------------------------------------
CS.START cld
jmp (.1,x)
.DA #$61 6502,Level 1 (65c02)
.DA #1 BIN Layout Version 1
.DA 0
.DA CS.END-CS.START CS
.DA DS.END-DS.START DS
.DA #16 SS
.DA #8 ZP
.DA 0
*--------------------------------------
* Relocation Table
*--------------------------------------
.1 .DA CS.INIT
.DA CS.RUN
.DA CS.DOEVENT
.DA CS.QUIT
L.MSG.USAGE .DA MSG.USAGE
L.MSG.DIR .DA MSG.DIR
L.MSG.FILE .DA MSG.FILE
.DO X.COPY.TO.DEST=1
L.MSG.OVERWRITE .DA MSG.OVERWRITE
.FIN
L.MSG.OK .DA MSG.OK
L.MSG.ERR .DA MSG.ERR
L.MSG.DONE .DA MSG.DONE
L.STAT .DA STAT
.DA 0
*--------------------------------------
CS.INIT
.1 >INC.G ArgCount
>SYSCALL GetArg.A
bcs .7
>STYA ZPPtr1
lda (ZPPtr1)
cmp #2
bne .4
ldy #1
lda (ZPPtr1),y
cmp #'-'
bne .4
iny
lda (ZPPtr1),y
ldx OptionList
.2 cmp OptionList,x
beq .3
dex
bne .2
.99 >LDYA L.MSG.USAGE
>SYSCALL printf
lda #K.E.SYN
sec
rts
.3 ldy OptionVars-1,x
lda #$80
sta (pData),y
bra .1
.4 tax Save len
>LDA.G index
.DO X.COPY.TO.DEST=1
bne .5 Already have a Src dir...
.ELSE
bne .99
.FIN
>LDYA ZPPtr1
jsr InitSrcDirYA
bcc .1 success, scan for any other args
.9 rts
.DO X.COPY.TO.DEST=1
.5 >LDA.G hDstBasePath
bne .99 we already have a second arg....error!
>LDYA ZPPtr1
jsr InitDstDirYA
bcc .1 success, scan for any other args
rts
.FIN
.7 >LDA.G index processed all args
beq .99 , no src ? ERROR
.DO X.COPY.TO.DEST=1
>LDA.G hDstBasePath
bne .8 we also have a Dst folder
ldy #S.PS.hPREFIX no dst folder, use actual prefix
lda (pPs),y
>SYSCALL GetMemPtr.A
jsr InitDstDirYA
bcs .99
.FIN
.8 >LDYAI 256
>SYSCALL GetMem.YA
bcs .9
txa
>STA.G hSrcFullPath
sta (pData),y
.DO X.COPY.TO.DEST=1
>LDYAI 256
>SYSCALL GetMem.YA
bcs .9
txa
>STA.G hDstFullPath
.FIN
* lda (pPs)
* ora #S.PS.F.EVENT Now accept events
* sta (pPs)
clc
rts
*--------------------------------------
CS.RUN >SYSCALL GetChar
bcs .11 no char
cmp #$03 Ctrl-C
bne .10
sec
rts Abort....
.10 cmp #$13 Ctrl-S
bne .11
ldy #bPause
lda (pData),y
eor #$ff
sta (pData),y
.11 ldy #bPause
lda (pData),y
bpl .1
.8 clc
rts
*--------------------------------------
.1 .DO X.COPY.TO.DEST=1
ldy #bCopy
lda (pData),y
beq .2
jsr CS.RUN.Copy
ldy #bCopy Copy completed ?
lda (pData),y
bne .8 no.....exit
clc
ldy #CopyRC
lda (pData),y
.DO X.DELETE.SOURCE=0
beq .20 no copy error
sec
jsr CS.RUN.CheckErr we have an error....
bcs .9
jmp CS.RUN.NEXT
.20 jsr CS.RUN.CheckErr Success!!
jsr CS.RUN.IncCount
jmp CS.RUN.NEXT
.ELSE
beq .2
sec
jsr CS.RUN.CheckErr we have an error....
bcc .21
rts
.21 ldy #hToDelete
lda #0
sta (pData),y Cancel delete if any
jmp CS.RUN.NEXT
.FIN
.FIN
.2 .DO X.DELETE.SOURCE=1
ldy #hToDelete
lda (pData),y
beq .3
lda #0
sta (pData),y
ldy #hSrcFullPath
jsr CS.RUN.GetPathY
>SYSCALL Remove.YA
bcs .22
jsr CS.RUN.CheckErr Success!!!
jsr CS.RUN.IncCount
jmp CS.RUN.NEXT
.22 jsr CS.RUN.CheckErr
bcs .9
jmp CS.RUN.NEXT
.FIN
*--------------------------------------
.3 jsr GetEntry
bcs CS.RUN.LEAVE
ldy #hFilter
lda (pData),y
beq .4 No filter....
>SYSCALL GetMemPtr.A
>PUSHYA
>PUSHW ZPFileName
>SYSCALL StrMatch
bcs CS.RUN.NEXT no match, skip....
.4 ldy #S.STAT.P.DRIVE
lda (ZPFileStat),y ProDOS Device ?
bne .6
ldy #S.STAT.P.TYPE
lda (ZPFileStat),y
cmp #$0F Directory ?
bne .5
>LDA.G bRecurse
bpl CS.RUN.NEXT
ldy #1
lda (ZPFileName),y
cmp #'.'
beq CS.RUN.NEXT Skip "." & ".."
jsr CS.RUN.BuildFilePath
jmp CS.RUN.DIR
.5 jsr CS.RUN.BuildFilePath
jmp CS.RUN.FILE
.6 lda #MLI.E.UNSUPST
sec
.9 rts
*--------------------------------------
CS.RUN.CR.NEXT jsr CS.RUN.CR
CS.RUN.NEXT jsr GetNextEntry
bcs CS.RUN.LEAVE
rts
*--------------------------------------
CS.RUN.LEAVE jsr LeaveSubDir exit this sub dir....
bcs .99 base, we are done, exit
jsr BasePath..
.DO X.DELETE.SOURCE=1
.DO X.COPY.TO.DEST=0
jsr GetEntry
bcs *
jsr CS.RUN.BuildFilePath
ldy #hSrcFullPath
jsr CS.RUN.GetPathY
>STYA ZPPtr1
>PUSHYA
jsr CS.RUN.DIR.MSG
bcs CS.RUN.LEAVE.RTS
>LDYA ZPPtr1
>SYSCALL Remove.YA
jsr CS.RUN.CheckErr
bcs .99
.FIN
.FIN
jmp CS.RUN.NEXT
.99 ldy #bQuiet
lda (pData),y
bmi .91
ldy #Count+1
>PUSHB (pData),y
dey
>PUSHB (pData),y
>LDYA L.MSG.DONE
>SYSCALL printf
.91 ldy #RC
lda (pData),y get global RC in case of bContinue
sec
CS.RUN.LEAVE.RTS
rts
*--------------------------------------
CS.RUN.DIR jsr CS.RUN.DIR.MSG
bcs CS.RUN.LEAVE.RTS
.DO X.COPY.TO.DEST=1
>PUSHW L.STAT
ldy #hDstFullPath
jsr CS.RUN.GetPathY
>PUSHYA
>SYSCALL Stat
bcs .3 File Not exists...go create
ldy #bNoConfirm
lda (pData),y
bmi .21 no prompt, nothing to create, enter subdir
jsr CS.RUN.OVERWRITE.MSG
bcs CS.RUN.DIR.RTS
.1 >SLEEP
>SYSCALL GetChar
bcs .1
cmp #3
beq .99 abort
cmp #'N'
bne .2
jmp CS.RUN.CR.NEXT no overwrite, nothing to do, no recurse
.2 cmp #'Y'
beq .21 no create, but recurse
cmp #'A'
bne .1
ldy #bNoConfirm
lda #$ff
sta (pData),y
.21 clc
lda #0
bra .4
.3 ldy #hDstFullPath
jsr CS.RUN.GetPathY
>SYSCALL MKDir.YA
.4 jsr CS.RUN.CheckErr
bcs CS.RUN.DIR.RTS
.FIN
.7 >LDYA ZPFileName
jmp EnterSubDirYA
.99 ldy #RC
lda (pData),y get global RC in case of bContinue
sec
CS.RUN.DIR.RTS rts
*--------------------------------------
CS.RUN.FILE jsr CS.RUN.FILE.MSG
bcs CS.RUN.DIR.RTS
.DO X.COPY.TO.DEST=1
>PUSHW L.STAT
ldy #hDstFullPath
jsr CS.RUN.GetPathY
>PUSHYA
>SYSCALL Stat
bcs .2 File Not exists...go create
ldy #bNoConfirm
lda (pData),y
bmi .2 no prompt, ovverwrite
jsr CS.RUN.OVERWRITE.MSG
bcs .9
.1 >SLEEP
>SYSCALL GetChar
bcs .1
cmp #3
beq .99 abort
cmp #'N'
bne .11
jmp CS.RUN.CR.NEXT no overwrite exit
.90 rts
.11 cmp #'Y'
beq .12 copy
cmp #'A'
bne .1
ldy #bNoConfirm
lda #$ff
sta (pData),y
.12 jsr GetEntry get back current entry corrupted by SLEEP
.2 .DO X.DELETE.SOURCE=1 mv file, check if srcbase=dstbase
ldy #hSrcBasePath
jsr CS.RUN.GetPathY
>PUSHYA
ldy #hDstBasePath
jsr CS.RUN.GetPathY
>PUSHYA
>SYSCALL StrMatch
bcs .3 not same dir, go copy/delete
jsr CS.RUN.Rename
jsr CS.RUN.CheckErr
bcs .9
jmp CS.RUN.NEXT
.FIN
.3 jsr CS.RUN.CopyStart
bcc .4
jsr CS.RUN.CheckErr
jmp CS.RUN.NEXT
.FIN
.4 .DO X.DELETE.SOURCE=1
ldy #hSrcFullPath
lda (pData),y
ldy #hToDelete
sta (pData),y
.FIN
clc
.9 rts
.99 ldy #RC
lda (pData),y get global RC in case of bContinue
sec
rts
*--------------------------------------
CS.RUN.DIR.MSG sec
.HS 90 bcc opcode
CS.RUN.FILE.MSG clc
ldy #bQuiet
lda (pData),y
bmi .8
php
.DO X.COPY.TO.DEST=1
ldy #hDstFullPath
jsr CS.RUN.GetPathY
>PUSHYA
.FIN
ldy #hSrcFullPath
jsr CS.RUN.GetPathY
>PUSHYA
plp
bcc .1
>LDYA L.MSG.DIR
bcs .2
.1 >LDYA L.MSG.FILE
.2 >SYSCALL printf
rts
.8 clc
rts
*--------------------------------------
.DO X.COPY.TO.DEST=1
CS.RUN.OVERWRITE.MSG
ldy #bQuiet
lda (pData),y
bmi .1
jsr CS.RUN.CR
.1 ldy #hDstFullPath
jsr CS.RUN.GetPathY
>PUSHYA
>LDYA L.MSG.OVERWRITE
>SYSCALL printf
rts
CS.RUN.OVERWRITE.KEY
rts
.FIN
*--------------------------------------
CS.RUN.CR lda #13
>SYSCALL PutChar.A
bcs .9
lda #10
>SYSCALL PutChar.A
.9 rts
*--------------------------------------
.DO X.COPY.TO.DEST=1
.DO X.DELETE.SOURCE=1
CS.RUN.Rename ldy #hDstFullPath
jsr CS.RUN.GetPathY
>PUSHYA
ldy #hSrcFullPath
jsr CS.RUN.GetPathY
>PUSHYA
>SYSCALL Rename
rts
.FIN
.FIN
*--------------------------------------
.DO X.COPY.TO.DEST=1
CS.RUN.CopyStart
ldy #hSrcFullPath
lda #SYS.FOpen.R
jsr CS.RUN.Open
bcs .99
ldy #hSrcFile
sta (pData),y
ldy #hDstFullPath
lda #SYS.FOpen.W+SYS.FOpen.X
jsr CS.RUN.Open
bcs .9
ldy #hDstFile
sta (pData),y
ldy #bCopy
lda #$ff
sta (pData),y
inc
ldy #CopyRC Reset RC
sta (pData),y
clc
rts
.9 pha
ldy #hSrcFile
lda (pData),y
>SYSCALL FClose.A
pla
ldy #CopyRC
sta (pData),y
sec
.99 rts
*--------------------------------------
CS.RUN.Open phy Save Filename
pha Save open mode
ldy #S.STAT.P.AUXTYPE+1
>PUSHB (ZPFileStat),y
dey
>PUSHB (ZPFileStat),y
ldy #S.STAT.P.TYPE
>PUSHB (ZPFileStat),y
pla
>PUSHA
ply
jsr CS.RUN.GetPathY
>PUSHYA
>SYSCALL FOpen
rts
*--------------------------------------
CS.RUN.Copy stz .90+1
>LDYAI X.COPY.BUF.SIZE
>SYSCALL GetMem.YA
bcs .9
>STYA ZPPtr1
stx .90+1
>PUSHW ZPPtr1 Dst Ptr
>PUSHWI X.COPY.BUF.SIZE Bytes To Read
ldy #hSrcFile
>PUSHB (pData),y
>SYSCALL FRead
bcc .1
cmp #MLI.E.EOF
bne .9
lda #0
bra .9
.1 >STYA ZPPtr2
>PUSHW ZPPtr1 Src Ptr
>PUSHW ZPPtr2 Bytes To Write
ldy #hDstFile
>PUSHB (pData),y
>SYSCALL FWrite
bcs .9
lda .90+1
>SYSCALL FreeMem.A
ldy #bQuiet
lda (pData),y
bmi .8
lda #'.'
>SYSCALL PutChar.A
rts
.8 clc
rts
.9 ldy #CopyRC
sta (pData),y
.90 lda #$00
beq CS.RUN.CopyEnd
>SYSCALL FreeMem.A
*--------------------------------------
CS.RUN.CopyEnd ldy #hSrcFile
lda (pData),y
>SYSCALL FClose.A
ldy #hDstFile
lda (pData),y
>SYSCALL FClose.A
ldy #bCopy
lda #$0
sta (pData),y
clc
rts
.FIN
*--------------------------------------
CS.RUN.CheckErr bcs .1
ldy #bQuiet
lda (pData),y
bmi .8
>LDYA L.MSG.OK
>SYSCALL printf
rts
.1 ldy #RC
sta (pData),y
pha
ldy #bContinue
lda (pData),y
bpl .2
pla
>PUSHA
>LDYA L.MSG.ERR
>SYSCALL printf
bcs .9
rts
.2 jsr CS.RUN.CR
pla
sec
.9 rts
.8 clc
rts
*--------------------------------------
CS.RUN.BuildFilePath
ldy #hSrcBasePath
jsr CS.RUN.GetPathY
>PUSHYA
ldy #hSrcFullPath
jsr CS.RUN.GetPathY
>STYA ZPPtr1
>PUSHYA
>SYSCALL StrCpy
>PUSHW ZPFileName
>PUSHW ZPPtr1
>SYSCALL StrCat
.DO X.COPY.TO.DEST=1
ldy #hDstBasePath
jsr CS.RUN.GetPathY
>PUSHYA
ldy #hDstFullPath
jsr CS.RUN.GetPathY
>STYA ZPPtr1
>PUSHYA
>SYSCALL StrCpy
ldy #hDstFileName
lda (pData),y
beq .1
>SYSCALL GetMemPtr.A
>PUSHYA
bra .2
.1 >PUSHW ZPFileName
.2 >PUSHW ZPPtr1
>SYSCALL StrCat
.FIN
rts
*--------------------------------------
CS.RUN.GetPathY lda (pData),y
>SYSCALL GetMemPtr.A
rts
*--------------------------------------
CS.RUN.IncCount ldy #Count
lda (pData),y
inc
sta (pData),y
bne .9
iny
lda (pData),y
inc
sta (pData),y
.9 rts
*--------------------------------------
CS.DOEVENT sec
rts
*--------------------------------------
CS.QUIT jsr LeaveSubDir
bcc CS.QUIT
.DO X.COPY.TO.DEST=1
ldy #bCopy
lda (pData),y
bpl .1
ldy #hSrcFile
lda (pData),y
>SYSCALL FClose.A
ldy #hDstFile
lda (pData),y
>SYSCALL FClose.A
.1 ldy #hDstFullPath
jsr CS.QUIT.FREE
ldy #hDstFilename
jsr CS.QUIT.FREE
.FIN
ldy #hSrcFullPath
jsr CS.QUIT.FREE
clc
rts
*--------------------------------------
CS.QUIT.FREE lda (pData),y
beq .9
>SYSCALL FreeMem.A
.9 rts
*--------------------------------------
MAN
SAVE /A2OSX.SRC/BIN/X.CPMVRM.S