;*************************** AMUS Program Label ******************************
; Filename: ARCHIV.M68                                      Date: 03/23/89
; Category: UTIL         Hash Code: 452-351-555-761      Version: 1.0(100)
; Initials: ULTR/AM      Name: DAVID PALLMANN
; Company: ULTRASOFT                               Telephone #: 5163984848
; Related Files: WLDSCN.OBJ,ARCRES.M68,ARCDIR.M68
; Min. Op. Sys.:                               Expertise Level: BEG
; Special: Must lnklit with wldscn.obj to create lit file.
; Description: ARCHIV creates an archive image of a file set described using
; wildcards. eg. .ARCHIV BASIC=*.BAS will archive all files in a ppn with the
; .BAS extension and name the archive file BASIC.
;*****************************************************************************
;***************************************************************************;
;									    ;
;				   ARCHIV				    ;
;	     create an archive image file of a wildcard file set	    ;
;									    ;
;			  Author: David F. Pallmann			    ;
;	     Copyright (C) 1984 by LMS Technical Services, Inc.		    ;
;									    ;
;***************************************************************************;
;
; File uses universal (.UNV) files other
; than SYS, SYSSYM, and TRM.
; These are on the AMUS network
;
; File makes external references to WLDSCN.OBJ[P,PN].  After
; assembly, enter this command:  .LNKLIT file,WLDSCN[P,PN]



OBJNAM	ARCHIV.LIT

VMAJOR=1

;edit history
VEDIT=100.	;06-Jan-84 DFP creation.

;universals
SEARCH	SYS
SEARCH	SYSSYM
SEARCH	WLDSCN

;registers
IMP=A5					;impure index

;special DDB definitions
D.BLK=D.WRK				;block size returned by LOOKUP
D.ACT=D.WRK+6				;active count returned by LOOKUP

;impure area
.OFINI
.OFDEF	FILE,D.DDB			;DDB for reading AMOS files
.OFDEF	ARCDIR,D.DDB			;DDB for writing archive directory
.OFDEF	ARCDAT,D.DDB			;DDB for writing archive data
.OFSIZ	IMPSIZ

START:	PHDR	-1,0,PH$REE!PH$REU	;program header
	GETIMP	IMPSIZ,IMP		;allocate impure area
	WINIT				;initialize WLDSCN

;get archive specification

GETARC:	BYP
	LIN
	JEQ	HELP
	MOV	A2,A3
	FSPEC	ARCDIR(IMP),XXX
	MOVW	#[MAP],ARCDIR+D.EXT(IMP)
	INIT	ARCDIR(IMP)
	MOV	A3,A2
	FSPEC	ARCDAT(IMP),XXX
	MOVW	#[ARC],ARCDAT+D.EXT(IMP)
	INIT	ARCDAT(IMP)

;bypass '='

SKIP:	BYP
	CMMB	(A2)+,#'=
	JNE	HELP

;get wildcard file specification

GETSPC:	BYP
	WSPEC				;process wildcard file spec
	JNE	EXIT			;exit if invalid spec

;create archive file

MAKARC:	OPENO	ARCDIR(IMP)
	OPENO	ARCDAT(IMP)

;get next matching file

GETFIL:	CTRLC	ABORT
	WSCAN				;get a file
	JNE	DONE			;no more files
	MOVW	D.DEV(A4),FILE+D.DEV(IMP)
	MOVW	D.DRV(A4),FILE+D.DRV(IMP)
	MOV	D.FIL(A4),FILE+D.FIL(IMP)
	MOVW	D.EXT(A4),FILE+D.EXT(IMP)
	MOVW	D.PPN(A4),FILE+D.PPN(IMP)
	INIT	FILE(IMP)
	LOOKUP	FILE(IMP)
	TSTW	FILE+D.ACT(IMP)
	BPL	DOFILE
	TYPESP	%Bypassing
	PFILE	FILE(IMP)
	CRLF
	JMP	GETFIL

DOFILE:	TYPESP	Processing file
	PFILE	FILE(IMP)
	CRLF

;copy file

CPYFIL:	OPENI	FILE(IMP)
	CLR	D0
10$:	FILINB	FILE(IMP)
	TST	FILE+D.SIZ(IMP)
	BEQ	ENDFIL
	INC	D0
	FILOTB	ARCDAT(IMP)
	BR	10$

ENDFIL:	CLOSE	FILE(IMP)

;write file directory header

WRTHDR:	MOV	FILE+D.FIL(IMP),D1
	FILOTL	ARCDIR(IMP)		;output filename to header
	CLR	D1
	MOVW	FILE+D.EXT(IMP),D1
	FILOTW	ARCDIR(IMP)		;output extension to header
	MOVW	FILE+D.PPN(IMP),D1
	FILOTW	ARCDIR(IMP)		;output PPN to header
	MOV	D0,D1
	FILOTL	ARCDIR(IMP)		;output file size to header
	JMP	GETFIL

HELP:	TYPECR	<usage is .ARCHIV archive=files>
	TYPECR	<example: .ARCHIV TEST=DSK2:[100,*]>
	BR	EXIT

ABORT:	TYPECR	?aborted

DONE:	CLOSE	ARCDIR(IMP)
	CLOSE	ARCDAT(IMP)

EXIT:	CRLF
	EXIT

	END

.