A2osX/SHARED/X.CPMVRM.S.txt

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
				beq .99

.20				ldx #OptionVars-OptionList-1

.2				cmp OptionList,x
				beq .3

				dex
				bpl .2

.99				>LDYA L.MSG.USAGE
				>SYSCALL PutS
				lda #E.SYN
				sec
				rts

.3				lda OptionVars,x
				tax
*				sec
				ror $0,x
				
				iny
				lda (ZPPtr1),y
				bne .20
				
				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