A2osX/BIN/PAK.S.txt

NEW
  AUTO 3,1
				.LIST OFF
				.OP	65C02
				.OR	$2000
				.TF BIN/PAK
*--------------------------------------
				.INB INC/MACROS.I
				.INB INC/A2OSX.I
				.INB INC/KERNEL.I
				.INB INC/MLI.I
				.INB INC/MLI.E.I
*--------------------------------------
CHNK.T			.EQ 0
CHNK.T.DATA			.EQ 0
CHNK.T.DIR			.EQ 1
CHNK.T.FILE			.EQ 2
*
CHNK.TYPE		.EQ 1
CHNK.AUXTYPE	.EQ 2
CHNK.FNLEN		.EQ 4
*
CHNK.COMPALG	.EQ 1
CHNK.ULEN		.EQ 2
CHNK.CLEN		.EQ 4
*--------------------------------------
X.ENTER.SUBDIR	.EQ 0
X.COPY.TO.DEST	.EQ 0
X.DELETE.SOURCE	.EQ 0
*--------------------------------------
				.DUMMY
				.OR ZPBIN
ZS.START
ZPPtr1			.BS 2
ZPPtr2			.BS 2
ZPFileName		.BS 2
ZPFileStat		.BS 2

ZPFullPath		.BS 2
ZPRelPath		.BS 2

bAppend			.BS 1
bRecurse		.BS 1
bPause			.BS 1

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		Code Size (without Constants)
				.DA DS.END-DS.START		Data SegmentSize
				.DA #64					Stack Size
				.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.FILE		.DA MSG.FILE
L.MSG.OK		.DA MSG.OK
L.MSG.ERR		.DA MSG.ERR
L.ARC.Header	.DA ARC.Header
				.DA 0
*--------------------------------------
CS.INIT			clc
				rts
*--------------------------------------
CS.RUN			>INC.G ArgIndex
				>SYSCALL ArgV
				bcs .8
				>STYA ZPPtr1
				
				lda (ZPPtr1)
				cmp #'-'
				bne .4
				
				jsr CS.RUN.CheckOpt
				bcc CS.RUN
				
.9				>PUSHBI 0
				>LDYA L.MSG.USAGE
				>SYSCALL printf
				lda #E.SYN
				sec
.99				rts
*--------------------------------------
.4				>LDA.G ArcName
				bne .5

				>LDA.G ArgIndex
				>STA.G ArcName
				bra CS.RUN
				
.5				>LDA.G hSrcBasePath
				bne .9
				
				>LDYA ZPPtr1
				jsr InitSrcDirYA
				bcc CS.RUN
				rts
				
.8				>LDA.G ArcName
				beq .9
				
				>LDA.G hSrcBasePath
				beq .9
				
				>LDYAI 256
				>SYSCALL getmem
				bcs .99
				>STYA ZPFullPath
				txa
				>STA.G hSrcFullPath
				
				>LDA.G hSrcBasePath
				>SYSCALL GetMemPtr
				>STYA ZPPtr1
				
				ldy #$ff
				
.80				iny
				lda (ZPPtr1),y
				bne .80
				
				tya
				clc
				adc ZPFullPath
				sta ZPRelPath
				lda ZPFullPath+1
				adc #0
				sta ZPRelPath+1
				
				jsr CS.RUN.OpenArc
				bcs .99
				
				>LDYAI 4096
				>SYSCALL getmem
				bcs .99
				txa
				>STA.G hMem
*--------------------------------------
CS.RUN.LOOP		ldy #S.PS.hStdIn
				lda (pPS),y
				>SYSCALL feof
				bcs .99
				
				tay
				bne .1
				
				>SYSCALL GetChar
				bcs .99
				
				cmp #$03				Ctrl-C
				beq .99					Abort....
				
				cmp #$13				Ctrl-S
				bne .1

				lda bPause
				eor	#$ff
				sta bPause
				bne CS.RUN.LOOP
				
.1				lda bPause
				bne CS.RUN.LOOP			Pause...

				jsr GetEntry
				bcs .9
				
				ldy #S.STAT.P.DRIVE
				lda (ZPFileStat),y		ProDOS Device ?
				beq .5
				
				jsr CS.RUN.DEV
				bcc CS.RUN.LOOP
				rts
				
.5				ldy #S.STAT.P.TYPE
				lda (ZPFileStat),y
				cmp #$0F				Directory ?
				bne .6

				jsr CS.RUN.DIR
				bcs .99
				bra .8
				
.6				jsr CS.RUN.FILE
				bcs .99
				bra .8

.9				jsr LeaveSubDir
				bcs .90

				jsr BasePath..
				
.8				jsr GetNextEntry
				jmp CS.RUN.LOOP
				
.90				lda #0
				sec
.99				rts
*--------------------------------------
CS.RUN.DEV		lda #E.BADPATH
				sec				
				rts
*--------------------------------------
CS.RUN.DIR		lda bRecurse
				bpl .8
				
				lda (ZPFileName)
				cmp #'.'
				beq .8
				
				jsr CS.RUN.GetFilePath
				
				>PUSHW ZPRelPath
				
				>PUSHBI 2
				>LDYA L.MSG.DIR
				>SYSCALL printf
				bcs .9
				
				lda #CHNK.T.DIR
				jsr CS.RUN.WriteHeader
				bcs .9
				
				>LDYA ZPFileName
				jsr EnterSubDirYA
				
.9				jmp CS.RUN.CheckErr
								
.8				clc
				rts
*--------------------------------------
CS.RUN.FILE		jsr FilterMatch
				bcs .8					no match, skip....
				
				>PUSHW ZPFullPath
				
				>LDA.G hArcFile
				tay
				lda OF.Table.hPath-1,x
				>SYSCALL getmemptr
				>SYSCALL strcmp
				bcc .8

				jsr CS.RUN.GetFilePath
				
				>PUSHW ZPRelPath
				
				>PUSHBI 2
				>LDYA L.MSG.FILE
				>SYSCALL printf
				bcs .9
				
				lda #CHNK.T.FILE
				jsr CS.RUN.WriteHeader
				bcs .9

				jsr CS.RUN.OpenFile
				bcs .9
				
				jsr CS.RUN.CloseFile

.9				jmp CS.RUN.CheckErr
				
.8				clc
				rts
*--------------------------------------
CS.RUN.CheckErr	bcs .1
				>LDYA L.MSG.OK
				>SYSCALL puts
				rts
				
.1				pha
				>PUSHA
				>PUSHBI 1
				>LDYA L.MSG.ERR
				
				>SYSCALL printf

				pla
				sec
				rts
*--------------------------------------
CS.RUN.GetFilePath
				>LDA.G hSrcBasePath
				>SYSCALL GetMemPtr
				>PUSHYA
				
				>LDYA ZPFullPath
				
				>SYSCALL StrCpy
				
				>PUSHW ZPFileName
				>LDYA ZPFullPath
				>SYSCALL StrCat
				rts
*--------------------------------------
CS.RUN.OpenArc	>PUSHWZ					Aux type
				>PUSHBI $CF				PAK
				>PUSHBI	O.CREATE+O.WRONLY
				>LDA.G ArcName
				>SYSCALL Argv

				>SYSCALL FOpen
				bcs .9
				
				>STA.G hArcFile
				
				>PUSHW L.ARC.Header
				>LDA.G hArcFile
				>SYSCALL fputs
.9				rts
*--------------------------------------
CS.RUN.WriteHeader
				>PUSHA
				jsr .8
				bcs .9
				
				ldy #S.STAT.P.TYPE
				jsr .6
				bcs .9
				
				ldy #S.STAT.P.AUXTYPE
				jsr .6
				bcs .9

				ldy #S.STAT.P.AUXTYPE+1
				jsr .6
				bcs .9

				ldy #$ff
				
.1				iny
				lda (ZPRelPath),y
				bne .1
				
				tya
				jsr .7
				bcs .9
				
				>PUSHW ZPRelPath
				>LDA.G hArcFile
				>SYSCALL fputs				
				rts
				
.6				lda (ZPFileStat),y
.7				>PUSHA		
.8				>LDA.G hArcFile
				>SYSCALL fputc
.9				rts
*--------------------------------------
CS.RUN.OpenFile	>PUSHWZ					Aux type
				>PUSHBI 0				Type
				>PUSHBI	O.RDONLY
				>LDYA ZPFullPath

				>SYSCALL FOpen
				bcs .9
				
				>STA.G hFile

.9				rts
*--------------------------------------
CS.RUN.CloseFile
				>LDA.G hFile
				>SYSCALL fclose
				bcs .9
				
				>STZ.G hFile
.9				rts
*--------------------------------------
CS.DOEVENT		sec
				rts
*--------------------------------------
CS.QUIT			jsr LeaveSubDir
				bcc CS.QUIT
				
				>LDA.G hFilter
				beq .1
				>SYSCALL FreeMem
				
.1				>LDA.G hSrcFullPath
				beq .2
				>SYSCALL FreeMem
				
.2				>LDA.G hArcFile
				beq .3
				
				>SYSCALL fclose
				
.3				>LDA.G hMem
				beq .8
				>SYSCALL FreeMem
								
				
.8				clc
				rts
*--------------------------------------
CS.RUN.CheckOpt	ldy #1 
				lda (ZPPtr1),y

				ldx #OptionVars-OptionList-1

.2				cmp OptionList,x
				beq .3
				dex
				bpl .2

				sec
				rts
				
.3				ldy OptionVars,x
				lda #$ff
				sta 0,y
				clc
				rts
*--------------------------------------
				.INB USR/SRC/BIN/X.FILEENUM.S
*--------------------------------------
CS.END
*--------------------------------------
OptionList		.AS "AaRr"
OptionVars		.DA #bAppend,#bAppend,#bRecurse,#bRecurse
*--------------------------------------
MSG.USAGE		.AS "Usage : PAK Archive [File *,? wildcards allowed]\r\n"
				.AS "   -A : Append to archive\r\n"
				.AZ "   -R : Recurse subdirectories\r\n"
MSG.OK			.AZ "[OK]"
MSG.ERR			.AZ "[%h]\r\n"
MSG.DIR			.AZ "Reading Dir:%s..."
MSG.FILE		.AZ "Adding File:%s..."
ARC.Header		.AZ "PAK"
*--------------------------------------
				.DUMMY
				.OR 0
DS.START
ArgIndex		.BS 1
ArcName			.BS 1
hSrcFullPath	.BS 1
hArcFile		.BS 1
hFile			.BS 1
hMem			.BS 1

				.INB USR/SRC/BIN/X.FILEENUM.G
DS.END
				.ED
*--------------------------------------
MAN
SAVE USR/SRC/BIN/PAK.S
ASM