A2osX/BIN/X.CPMVRM.S.txt
2019-02-28 09:55:51 +00:00

779 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
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 #64 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 ArgV
bcs .7
>STYA ZPPtr1
lda (ZPPtr1)
cmp #'-'
bne .4
ldy #1
lda (ZPPtr1),y
ldx OptionList
.2 cmp OptionList,x
beq .3
dex
bne .2
.99 >PUSHBI 0
>LDYA L.MSG.USAGE
>SYSCALL printf
lda #E.SYN
sec
rts
.3 ldy OptionVars-1,x
lda #$80
sta (pData),y
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.hPREFIX 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
sta (pData),y
.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
beq .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
ldy #bPause
lda (pData),y
eor #$ff
sta (pData),y
.15 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 >STZ.G hToDelete 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
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
>LDA.G hFilter
beq .4 No filter....
pha
ldy #S.STAT.FSID
lda (ZPFileStat),y
bne .11 not prodos...
pla
>SYSCALL GetMemPtr
>SYSCALL strupr
bra .12
.11 pla
>SYSCALL GetMemPtr
.12 jsr 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
lda (ZPFileName)
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
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 ldy #bQuiet
lda (pData),y
bmi .91
ldy #Count+1
>PUSHB (pData),y
dey
>PUSHB (pData),y
>PUSHBI 2
>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 .DO X.COPY.TO.DEST=1
jsr CS.RUN.DIR.MSG
bcs CS.RUN.LEAVE.RTS
>PUSHW L.STAT
ldy #hDstFullPath
jsr CS.RUN.GetPathY
>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
.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
>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
>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 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
>LDA.G bQuiet
bmi .8
php
.DO X.COPY.TO.DEST=1
ldy #hDstFullPath
jsr CS.RUN.GetPathY
>PUSHYA
.FIN
ldy #hSrcFullPath
jsr CS.RUN.GetPathY
>PUSHYA
.DO X.COPY.TO.DEST=1
>PUSHBI 4
.ELSE
>PUSHBI 2
.FIN
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
>LDA.G bQuiet
bmi .1
jsr CS.RUN.CR
.1 ldy #hDstFullPath
jsr CS.RUN.GetPathY
>PUSHYA
>PUSHBI 2
>LDYA L.MSG.OVERWRITE
>SYSCALL printf
rts
CS.RUN.OVERWRITE.KEY
rts
.FIN
*--------------------------------------
CS.RUN.CR lda #13
>SYSCALL PutChar
bcs .9
lda #10
>SYSCALL PutChar
.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
>SYSCALL Rename
bcs .9
jsr CS.RUN.IncCount
.9 rts
.FIN
.FIN
*--------------------------------------
.DO X.COPY.TO.DEST=1
CS.RUN.CopyStart
ldy #hSrcFullPath
lda #O.RDONLY
jsr CS.RUN.Open
bcs .99
>STA.G hSrcFile
ldy #hDstFullPath
lda #O.WRONLY+O.CREATE
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
>LDA.G hSrcFile
>SYSCALL fclose
pla
.99 ldy #CopyRC
sta (pData),y
sec
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
>SYSCALL FOpen
rts
*--------------------------------------
CS.RUN.Copy >STZ.G hCopyBuf
>LDYAI X.COPY.BUF.SIZE
>SYSCALL getmem
bcs .9
>STYA ZPPtr1
txa
>STA.G hCopyBuf
>PUSHWI X.COPY.BUF.SIZE Bytes To Read
>PUSHW ZPPtr1 Dst Ptr
>LDA.G hSrcFile
>SYSCALL FRead
bcc .1
cmp #MLI.E.EOF
bne .9
lda #0
bra .9
.1 >PUSHYA Bytes To Write
>PUSHW ZPPtr1 Src Ptr
>LDA.G hDstFile
>SYSCALL FWrite
bcs .9
>LDA.G hCopyBuf
>SYSCALL FreeMem
ldy #bQuiet
lda (pData),y
bmi .8
lda #'.'
>SYSCALL PutChar
rts
.8 clc
rts
.9 ldy #CopyRC
sta (pData),y
>LDA.G hCopyBuf
beq CS.RUN.CopyEnd
>SYSCALL FreeMem
*--------------------------------------
CS.RUN.CopyEnd >LDA.G hSrcFile
>SYSCALL fclose
>LDA.G hDstFile
>SYSCALL fclose
>STZ.G bCopy
clc
rts
.FIN
*--------------------------------------
CS.RUN.CheckErr bcs .1
>LDA.G bQuiet
bmi .8
>LDYA L.MSG.OK
>SYSCALL puts
.8 rts
.1 pha
>PUSHA
>PUSHBI 1
>LDYA L.MSG.ERR
>SYSCALL printf
>LDA.G bContinue
eor #$80
asl
pla
rts
*--------------------------------------
CS.RUN.BuildFilePath
ldy #hSrcBasePath
jsr CS.RUN.GetPathY
>PUSHYA
ldy #hSrcFullPath
jsr CS.RUN.GetPathY
>STYA ZPPtr1
>SYSCALL StrCpy
>PUSHW ZPFileName
>LDYA ZPPtr1
>SYSCALL StrCat
.DO X.COPY.TO.DEST=1
ldy #hDstBasePath
jsr CS.RUN.GetPathY
>PUSHYA
ldy #hDstFullPath
jsr CS.RUN.GetPathY
>STYA ZPPtr1
>SYSCALL StrCpy
ldy #hDstFileName
lda (pData),y
beq .1
>SYSCALL GetMemPtr
>PUSHYA
bra .2
.1 >PUSHW ZPFileName
.2 >LDYA ZPPtr1
>SYSCALL StrCat
.FIN
rts
*--------------------------------------
CS.RUN.GetPathY lda (pData),y
>SYSCALL GetMemPtr
rts
*--------------------------------------
CS.RUN.IncCount >INCW.G Count
rts
*--------------------------------------
CS.DOEVENT sec
rts
*--------------------------------------
CS.QUIT jsr LeaveSubDir
bcc CS.QUIT
.DO X.COPY.TO.DEST=1
>LDA.G bCopy
bpl .1
>LDA.G hSrcFile
>SYSCALL fclose
>LDA.G hDstFile
>SYSCALL fclose
.1 ldy #hDstFullPath
jsr CS.QUIT.FREE
ldy #hDstFilename
jsr CS.QUIT.FREE
.FIN
ldy #hSrcFullPath
jsr CS.QUIT.FREE
ldy #hFilter
jsr CS.QUIT.FREE
clc
rts
*--------------------------------------
CS.QUIT.FREE lda (pData),y
beq .9
>SYSCALL FreeMem
.9 rts
*--------------------------------------
MAN
SAVE USR/SRC/BIN/X.CPMVRM.S
LOAD USR/SRC/BIN/RM.S
ASM