perm filename FILPAC.MIC[SIM,SYS] blob sn#460055 filedate 1979-07-20 generic text, type T, neo UTF8
! FILPAC
! ------
;
.IF ($A.[1]#$A.[99]) .GOTO START
HELP::
.REVIVE
;
; The FILPAC MICRO (MIC macro) has several functions - the selected
; operation will be triggered by the first argument which may be
; U(npack), P(ack), X(packing files using "wild" construct),
; L(ist directory), C(reate pack table) or H(elp - this text).
;
; *** PACKING FILES USING CMD FILE ***
;
; ./FILPAC P,A,B
;
; This MICRO uses the FILPAC program and packs
; files saving lots of disk (or tape) space.
; Arguments:
; A: Name of resulting pack file will be A.PAC
;    There must exist a file A.CMD with the file names
;    in conventional command format, i.e. comma between file names and
;    no <CRLF>s.
; B: If D or d then the individual files will be deleted after packing.
;
; Example: ./FILPAC P,Q,D
;           will pack all files listed in Q.CMD and delete
;           the individual files.
;           ./FILPAC P,Q,S
;           will just pack them.
;
; ./FILPAC P,Q(A),S		will pack using packtable A.PKT.
; For creation of packtables (optional feature) see below.
;
; Files with extensions: .REL .SAV .TMP .HGH .LOW .ATR .PAC .BAC .SHR
; may not be packed.
;
; NOTE! Line numbered files may be packed, but the line number
; bit flag will be lost. The program NUMSET[106,346] may be used
; to insert the 35th bit again.
;
;
; *** PACKING FILES USING "WILD" CONSTRUCT ***
;
; ./FILPAC X,A,B,C
;
; Arguments:
; A: Name of resulting pack file will be A.PAC
; B: If D or d then the individual files will be deleted after packing.
; C: File specification for files to be packed.
;    Format is the same as for the DIRECT command.
; Example: ./FILPAC X,Q,D,*.SIM,*.MIC
;           will pack all files *.sim,*.mic and delete the individual
;           files.
;           ./FILPAC X,Q,S,A?????
;           will pack all files A?????.*
;
; ./FILPAC X,Q(A),S,files		will pack using packtable A.PKT
; For creation of packtables (optional feature) see below.
;
; NOTE! Line numbered files may be packed, but the line number
; bit flag will be lost. The program NUMSET[106,346] may be used
; to insert the 35th bit again.
;
; Files with extensions: .REL .SAV .TMP .HGH .LOW .ATR .PAC .BAC .SHR
; will not be packed.
;
;
; *** UNPACKING FILES ***
;
; ./FILPAC U,Q,A.EXT,B.EXT,...
;
; This MICRO will unpack the individual files A.EXT,B.EXT in Q.PAC.
; The files will be written onto structure DSKD.
;
; ./FILPAC U,Q			will unpack all the files in Q.PAC.
;
;
; *** CREATING PACK TABLES ***
;
; ./FILPAC C,A
;
; The MAKETB program will assume the existence of
; the file A containing your frequent text strings surrounded
; by / or ".
;
; Note that it is often useful to include BLANKS, <TAB>s and <CRLF>s
; in your strings. The order of strings with common start must
; be carefully arranged. Thus /END=/ before /END/ and /      / before
; /   /.

;
; I.e. 	./FILPAC C,A.TAB
;
; will use your file A.TAB creating a file A.PKT to be used at packing.
; NOTE! The file A.PKT will NOT be packed and must be saved in order to
; be able to unpack your files!
; A frequency count file A.FRE will be created when unpacking.
;
; *** LISTING DIRECTORY FOR PAC FILE ***
;
; ./FILPAC L,A
;
; will list the contents of A.CMD packed in A.PAC on your TTY.
;
;
; Author: Mats Ohlin , FOA   75-09-12
; Author of FILPAC: Kalle M{kil{ , SCB
.GOTO EXIT
START::
.IF ($V+$W+$X+$Y+$Z#"") .GOTO ILLPRM
.IF ($A.[1]="U") .GOTO UNPAC
.IF ($A.[1]="u") .GOTO UNPAC
.IF ($A.[1]="L") .GOTO LIST
.IF ($A.[1]="l") .GOTO LIST
.IF ($A.[1]="C") .GOTO CRETAB
.IF ($A.[1]="c") .GOTO CRETAB
.LET W=$B.["(",999],W=$W.[1,")"]
.LET B=$B.[1,"("]
.IF ($A.[1]="P") .GOTO PAC
.IF ($A.[1]="p") .GOTO PAC
.IF ($A.[1]="X") .GOTO XPAC
.IF ($A.[1]="x") .GOTO XPAC
.IF ($A.[1]="H") .BACKTO HELP
.IF ($A.[1]="h") .BACKTO HELP
.GOTO ILL1PM
PAC::
.IF ($D#"") .GOTO ILL4PM
.ERROR %
.DIR/F/sum @'B.CMD
.IF (ERROR) .GOTO MISFIL
.ERROR
.GOTO WARN
XPAC::
.LET Z=0,X=$D
MORE::
.LET Z=Z+1,Y="''"+"EFGHIJKLMNOPQRSTU".[Z]
.IF ("'Y"="") .GOTO DIR
.LET X=$X+","+"'Y"
.BACKTO MORE
DIR::
.IF ($X="") .GOTO NOARG
.ERROR %
.DIR 'B.CMD/F='X
.IF (ERROR) .GOTO MISFIL
WARN::
.IF ($C="S") .GOTO OK
.IF ($C="s") .GOTO OK
.IF ($C="D") .GOTO OK
.IF ($C="d") .GOTO OK
.GOTO ILL3PM
OK::
.IF ($A.[1]="P") .GOTO RUN
.IF ($A.[1]="p") .GOTO RUN
.IF ($C="S") .GOTO TECO
.IF ($C="s") .GOTO TECO
! Files will be deleted after packing
! -----------------------------------
.LET C="Y"
TECO::
.ERROR
.TECO 'B.CMD
<a≠(-↑↑N-1);>≠ k<s	≠;rki
≠>  zj-3k≠
j<s.rel≠;0kk>≠
j<s.sav≠;0kk>≠
j<s.atr≠;0kk>≠
j<s.bac≠;0kk>≠
j<s.pac≠;0kk>≠
j<s.tmp≠;0kk>≠
j<s.shr≠;0kk>≠
j<s.hgh≠;0kk>≠
j<s.low≠;0kk>≠
j<fs
≠,≠;>≠
*s,≠≠
zj-di
≠
ex≠≠
.IF (ERROR) .GOTO ERRTEC
.DEL 'B.BAK
RUN::
.ERROR
.DEL 'B.BAC
.IF ($W#"") .LET V=$W+".FRE"
.IF ($W#"") .LET W=$W + ".PKT,"
.ERROR %
.IF (ERROR) .GOTO PROERR
.REVIVE .RENAME 'B.BAC='B.PAC
.R FILPAC
*'B.PAC≠
*'V≠
*'W'B.CMD,@'B.CMD≠'C

.PRESERVE 'B.PAC
.GOTO EXIT
UNPAC::
.LET Z=0,X=$B
LOOP::
.LET Z=Z+1,Y="''"+"CDEFGHIJKLMNOPQRSTU".[Z]
.IF ("'Y"="") .GOTO END
.LET X=$X+","+"'Y"
.BACKTO LOOP
END::
.IF ($X="") .GOTO ILLU2
.REVIVE .R FILPAC
*≠
*'X≠
.GOTO EXIT
MISFIL::
! Missing file(s) -
.REVIVE .DIR/F @'B.CMD
.GOTO EXIT
ERRTEC::
! ? Illegal CMD file created - check 'B.CMD
.GO TO EXIT
ILLPRM::
! Illegal parameter(s).
.BACKTO HELP
PROERR::
! ? Cannot rename 'B.PAC because of protection
.GOTO EXIT
CRETAB::
.LET Z=$B.[1,"."]
.REVIVE .R MAKETB
*'Z
*@'B≠
.PRESERVE 'Z.PKT
.GOTO EXIT
ILLU2::
! ? Missing second parameter for ./FILPAC U
.BACKTO HELP
ILL3PM::
! ? Illegal 3rd parameter: 'C      Use S or D
.GOTO EXIT
NOARG::
! ? Missing parameters to /FILPAC X
.BACKTO HELP
ILL4PM::
! ? Superfluous 4th parameter: 'D
.GOTO EXIT
ILL1PM::
! ? Illegal 1st parameter: 'A    Use X,U,C,L,H or P.
.GOTO EXIT
LIST::
.R FILPAC
*≠
*'B.PAC,'B.CMD≠
.TECO DSKD:'B.CMD
*i - Contents of 'B.PAC -
*
*≠AAA<5s,≠;-d13i≠10i≠>j<S,≠;9I≠>ex≠≠
.REVIVE .TYPE DSKD: 'B.CMD
.SILENCE
.DEL DSKD:'B.CMD,'B.BAK
EXIT::
! READY
.