A2osX/BIN/X.CPMVRM.S.txt

PR#3
PREFIX /A2OSX.BUILD
NEW
INC 1
AUTO 6
				.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		Code Length To Relocate
				.DA DS.END-DS.START		Data Segment to Allocate
				.DA 0
				.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			>SYSCALL GetArgC
				sta ArgCount
				cmp #1
				beq .99

				stz ArgIndex
				
.1				dec ArgCount
				beq .7
				
				inc ArgIndex
				lda ArgIndex
				>SYSCALL GetArg.A
				>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.YA
				lda #SYSMGR.ERRSYN
				sec
				rts
				
.3				ldy OptionVars-1,x
				lda #$80
				sta (pData),y
				bra .1
				
.4				tax						Save len

				ldy #index
				lda (pData),y

				.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				ldy #hDstBasePath				
				lda (pData),y
				bne .99					we already have a second arg....error!
				
				>LDYA ZPPtr1
				jsr InitDstDirYA
				bcc .1					success, scan for any other args
				rts
				.FIN

.7				ldy #index				processed all args
				lda (pData),y
				beq .99					, no src ? ERROR

				.DO X.COPY.TO.DEST=1
				ldy #hDstBasePath				
				lda (pData),y
				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
				ldy #hSrcFullPath
				sta (pData),y
				
				.DO X.COPY.TO.DEST=1
				>LDYAI 256
				>SYSCALL GetMem.YA
				bcs .9
				txa
				ldy #hDstFullPath
				sta (pData),y
				.FIN
				
*				lda (pPs)
*				ora #S.PS.F.EVENT		Now accept events
*				sta (pPs)
				
				clc
				rts
*--------------------------------------
CS.RUN			>SYSCALL GetC
				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 PStrMatch
				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

				ldy #bRecurse
				lda (pData),y
				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.ERR.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.YA
				
.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				>SYSCALL Sleep
				>SYSCALL GetC
				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				>SYSCALL Sleep
				>SYSCALL GetC
				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 PStrMatch
				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.YA
				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.YA
				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.ERR.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.YA
				rts
				
.1				ldy #RC
				sta (pData),y
				pha

				ldy #bContinue
				lda (pData),y
				bpl .2
				
				pla
				>PUSHA
				>LDYA L.MSG.ERR
				
				>SYSCALL PrintF.YA
				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 PStrCpy

				>PUSHW ZPFileName
				>PUSHW ZPPtr1
				>SYSCALL PStrCat
				
				.DO X.COPY.TO.DEST=1
				ldy #hDstBasePath
				jsr CS.RUN.GetPathY
				>PUSHYA
				
				ldy #hDstFullPath
				jsr CS.RUN.GetPathY
				>STYA ZPPtr1

				>PUSHYA
				>SYSCALL PStrCpy

				ldy #hDstFileName
				lda (pData),y
				beq .1
				
				>SYSCALL GetMemPtr.A			
				>PUSHYA
				bra .2
				
.1				>PUSHW ZPFileName

.2				>PUSHW ZPPtr1
				>SYSCALL PStrCat
				.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
LOAD /A2OSX.SRC/BIN/CP.S
ASM