A2osX/SHARED/X.CPMVRM.S.txt
2021-07-10 21:09:43 +02:00

760 lines
13 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
AUTO 3,1
.LIST OFF
*--------------------------------------
X.COPY.BUF.SIZE .EQ 4096
*--------------------------------------
.DUMMY
.OR ZPBIN
ZS.START
ZPPtr1 .BS 2
ZPPtr2 .BS 2
ZPFileName .BS 2
ZPFileStat .BS 2
bContinue .BS 1
bRecurse .BS 1
bQuiet .BS 1
.DO X.COPY.TO.DEST=1
bNoConfirm .BS 1
.FIN
ZS.END .ED
*--------------------------------------
* 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 #64 SS
.DA #ZS.END-ZS.START Zero Page Size
.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.REG .DA MSG.REG
.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.CRLF .DA MSG.CRLF
L.MSG.DONE .DA MSG.DONE
.DA 0
*--------------------------------------
CS.INIT
.1 >INC.G ArgCount
>SYSCALL ArgV
bcs .7
>STYA ZPPtr1
lda (ZPPtr1)
cmp #'-'
bne .4
ldy #1
lda (ZPPtr1),y
ldy #OptionVars-OptionList-1
.2 cmp OptionList,y
beq .3
dey
bpl .2
.99 >PUSHW L.MSG.USAGE
>PUSHBI 0
>SYSCALL PrintF
lda #E.SYN
sec
rts
.3 ldx OptionVars,y
* sec
ror $0,x
bra .1
.4 >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.hCWD no dst folder, use actual prefix
lda (pPS),y
>SYSCALL GetMemPtr
jsr InitDstDirYA
bcs .99
.FIN
.8 >LDYAI 256
>SYSCALL GetMem
bcs .9
txa
>STA.G hSrcFullPath
.DO X.COPY.TO.DEST=1
>LDYAI 256
>SYSCALL GetMem
bcs .9
txa
>STA.G hDstFullPath
.FIN
clc
CS.INIT.RTS rts
*--------------------------------------
CS.RUN ldy #S.PS.hStdIn
lda (pPS),y
>SYSCALL FEOF
bcs CS.INIT.RTS I/O error
tay
bne .15
>SYSCALL GetChar
bcs CS.INIT.RTS I/O error
cmp #$03 Ctrl-C
bne .10
sec
rts Abort....
.10 cmp #$13 Ctrl-S
bne .15
>LDA.G bPause
eor #$ff
sta (pData),y
.15 >LDA.G bPause
bpl .1
.8 clc
rts
*--------------------------------------
.1 .DO X.COPY.TO.DEST=1
>LDA.G bCopy
beq .2
jsr CS.RUN.Copy
>LDA.G bCopy Copy completed ?
bne .8 no.....exit
clc
>LDA.G CopyRC
.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 >STZ.G hToDelete Cancel delete if any
jmp CS.RUN.NEXT
.FIN
.FIN
.2 .DO X.DELETE.SOURCE=1
>LDA.G hToDelete
beq .3
lda #0
sta (pData),y
ldy #hSrcFullPath
jsr CS.RUN.GetPathY
>SYSCALL Remove
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
jsr FilterMatch
bcs CS.RUN.NEXT no match, skip....
.4 ldy #S.STAT.MODE+1
lda (ZPFileStat),y
and #$70
bne .5 REG file ?
jsr CS.RUN.BuildFilePath
jmp CS.RUN.REG
.5 cmp /S.STAT.MODE.DIR DIR ?
bne .7
bit bRecurse
bpl CS.RUN.NEXT
lda (ZPFileName)
cmp #'.'
beq CS.RUN.NEXT Skip "." & ".."
jsr CS.RUN.BuildFilePath
jmp CS.RUN.DIR
.7 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
jsr CS.RUN.BuildFilePath
jsr CS.RUN.DIR.MSG
bcs CS.RUN.LEAVE.RTS
ldy #hSrcFullPath
jsr CS.RUN.GetPathY
>SYSCALL Remove
jsr CS.RUN.CheckErr
bcs .99
* .FIN
.FIN
jmp CS.RUN.NEXT
.99 bit bQuiet
bmi .91
>PUSHW L.MSG.DONE
ldy #Count+1
>PUSHB (pData),y
dey
>PUSHB (pData),y
>PUSHBI 2
>SYSCALL PrintF
.91 ldy #RC
lda (pData),y get global RC in case of bContinue
sec
CS.RUN.LEAVE.RTS
rts
*--------------------------------------
CS.RUN.DIR .DO X.COPY.TO.DEST=1
jsr CS.RUN.DIR.MSG
bcs CS.RUN.LEAVE.RTS
jsr CS.RUN.StatDst
bcs .3 File Not exists...go create
bit bNoConfirm
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
jsr CS.RUN.ToUpper
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
* sec
ror bNoConfirm
.21 clc
lda #0
bra .4
.3 ldy #hDstFullPath
jsr CS.RUN.PushPathY
ldy #S.STAT.MODE+1
lda (ZPFileStat),y
>PUSHA
dey
lda (ZPFileStat),y
>PUSHA
>SYSCALL MKDir
.4 jsr CS.RUN.CheckErr
bcs CS.RUN.DIR.RTS
jsr CS.RUN.IncCount
.FIN
>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.REG ldx #2
jsr CS.RUN.REG.MSG
bcs CS.RUN.DIR.RTS
.DO X.COPY.TO.DEST=1
jsr CS.RUN.StatDst
bcs .2 File Not exists...go create
bit bNoConfirm
bmi .2 no prompt, overwrite
jsr CS.RUN.OVERWRITE.MSG
bcs .9
.1 >SLEEP
>SYSCALL GetChar
bcs .1
cmp #3
beq .99 abort
jsr CS.RUN.ToUpper
cmp #'N'
bne .11
jmp CS.RUN.CR.NEXT no overwrite exit
.90 rts
.11 cmp #'Y'
beq .12 copy
cmp #'A'
bne .1
* sec
ror bNoConfirm
.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.PushPathY
ldy #hDstBasePath
jsr CS.RUN.PushPathY
>SYSCALL StrCaseCmp
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
bcs .9
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 >LDA.G RC get global RC in case of bContinue
sec
rts
*--------------------------------------
CS.RUN.DIR.MSG ldx #0
CS.RUN.REG.MSG bit bQuiet
bmi .8
>PUSHW L.MSG.DIR,x
ldy #hSrcFullPath
jsr CS.RUN.PushPathY
.DO X.COPY.TO.DEST=1
ldy #hDstFullPath
jsr CS.RUN.PushPathY
>PUSHBI 4
.ELSE
>PUSHBI 2
.FIN
>SYSCALL PrintF
rts
.8 clc
rts
*--------------------------------------
.DO X.COPY.TO.DEST=1
CS.RUN.OVERWRITE.MSG
bit bQuiet
bmi .1
jsr CS.RUN.CR
.1 >PUSHW L.MSG.OVERWRITE
ldy #hDstFullPath
jsr CS.RUN.PushPathY
>PUSHBI 2
>SYSCALL PrintF
rts
.FIN
*--------------------------------------
CS.RUN.CR >PUSHW L.MSG.CRLF
>PUSHBI 0
>SYSCALL PrintF
rts
*--------------------------------------
.DO X.COPY.TO.DEST=1
.DO X.DELETE.SOURCE=1
CS.RUN.Rename ldy #hSrcFullPath
jsr CS.RUN.PushPathY
ldy #hDstFullPath
jsr CS.RUN.PushPathY
>SYSCALL Rename
bcs .9
jsr CS.RUN.IncCount
.9 rts
.FIN
.FIN
*--------------------------------------
.DO X.COPY.TO.DEST=1
CS.RUN.CopyStart
>STZ.G hSrcFile
>STA.G hDstFile
>STA.G hCopyBuf
>STA.G CopyRC Reset RC
>LDYAI X.COPY.BUF.SIZE
>SYSCALL GetMem
bcs .99
>STYA ZPPtr1
txa
>STA.G hCopyBuf
ldy #hSrcFullPath
lda #O.RDONLY
jsr CS.RUN.Open
bcs CS.RUN.CopyEnd
>STA.G hSrcFile
ldy #hDstFullPath
lda #O.WRONLY+O.CREATE
jsr CS.RUN.Open
bcs CS.RUN.CopyEnd
>STA.G hDstFile
lda #$ff
>STA.G bCopy
* clc
.99 rts
*--------------------------------------
CS.RUN.Copy >PUSHB.G hSrcFile
>PUSHW ZPPtr1 Dst Ptr
>PUSHWI X.COPY.BUF.SIZE Bytes To Read
>SYSCALL FRead
bcc .1
cmp #MLI.E.EOF
bne .9
lda #0
clc
bra CS.RUN.CopyEnd
.1 phy
pha
>PUSHB.G hDstFile
>PUSHW ZPPtr1 Src Ptr
pla
ply
>PUSHYA Bytes To Write
>SYSCALL FWrite
bcs CS.RUN.CopyEnd
bit bQuiet
bmi .8
lda #'.'
>SYSCALL PutChar
.8 rts
.9 sec
*--------------------------------------
CS.RUN.CopyEnd >STA.G CopyRC
php
pha
>LDA.G hDstFile
beq .1
>SYSCALL FClose
.1 >LDA.G hSrcFile
beq .2
>SYSCALL FClose
.2 >LDA.G hCopyBuf
beq .3
>SYSCALL FreeMem
.3 >STZ.G bCopy
pla
plp
rts
.FIN
*--------------------------------------
CS.RUN.Open pha Save open mode
jsr CS.RUN.PushPathY
pla
>PUSHA
ldy #S.STAT.P.TYPE
>PUSHB (ZPFileStat),y
ldy #S.STAT.P.AUXTYPE+1
>PUSHB (ZPFileStat),y
dey
>PUSHB (ZPFileStat),y
>SYSCALL FOpen
rts
*--------------------------------------
CS.RUN.CheckErr bcs .1
bit bQuiet
bmi .8
>LDYA L.MSG.OK
>SYSCALL PutS
.8 rts
.1 pha
>PUSHW L.MSG.ERR
pla
pha
>PUSHA
>PUSHBI 1
>SYSCALL PrintF
lda bContinue
eor #$80
asl
pla
rts
*--------------------------------------
CS.RUN.BuildFilePath
ldy #hSrcFullPath
jsr CS.RUN.PushPathY
ldy #hSrcBasePath
jsr CS.RUN.PushPathY
>SYSCALL StrCpy
ldy #hSrcFullPath
jsr CS.RUN.PushPathY
>PUSHW ZPFileName
>SYSCALL StrCat
.DO X.COPY.TO.DEST=1
ldy #hDstFullPath
jsr CS.RUN.PushPathY
ldy #hDstBasePath
jsr CS.RUN.PushPathY
>SYSCALL StrCpy
ldy #hDstFullPath
jsr CS.RUN.PushPathY
>LDA.G hDstFileName
beq .1
>SYSCALL GetMemPtr
>PUSHYA
bra .2
.1 >PUSHW ZPFileName
.2 >SYSCALL StrCat
.FIN
rts
*--------------------------------------
.DO X.COPY.TO.DEST=1
CS.RUN.StatDst ldy #hDstFullPath
jsr CS.RUN.PushPathY
>PUSHEA.G STATBUF
>SYSCALL Stat
rts
.FIN
*--------------------------------------
CS.RUN.GetPathY sec
.HS 90 BCC
CS.RUN.PushPathY
clc
php
lda (pData),y
>SYSCALL GetMemPtr
plp
bcs .8
>PUSHYA
.8 rts
*--------------------------------------
CS.RUN.IncCount >INCW.G Count
rts
*--------------------------------------
CS.RUN.ToUpper cmp #'a'
bcc .8
cmp #'z'+1
bcs .8
eor #$20
.8 rts
*--------------------------------------
CS.DOEVENT sec
rts
*--------------------------------------
CS.QUIT jsr LeaveSubDir
bcc CS.QUIT
.DO X.COPY.TO.DEST=1
>LDA.G bCopy
bpl .1
jsr CS.RUN.CopyEnd
.1 ldy #hDstFullPath
jsr .7
ldy #hDstFileName
jsr .7
.FIN
ldy #hSrcFullPath
jsr .7
ldy #hFilter
jsr .7
ldy #hExclude
.7 lda (pData),y
beq .9
>SYSCALL FreeMem
.9 clc
rts
*--------------------------------------
MAN
SAVE usr/src/shared/x.cpmvrm.s
LOAD usr/src/bin/cp.s
ASM