$! ------------------ CUT HERE -----------------------
$ v='f$verify(f$trnlnm("SHARE_VERIFY"))'
$!
$! This archive created by VMS_SHARE Version 7.2-007  22-FEB-1990
$!   On 12-JUL-1990 12:32:39.46   By Tim Cook <timcc@viccol.edu.au>
$!
$! This VMS_SHARE Written by:
$!    Andy Harper, Kings College London UK
$!
$!+ This package distributed in 6 parts, to keep each part
$!  below 53 blocks
$!
$! TO UNPACK THIS SHARE FILE, CONCATENATE ALL PARTS IN ORDER
$! AND EXECUTE AS A COMMAND PROCEDURE  (  @name  )
$!
$! The following file(s) will be created after unpacking:
$!       1. AAAREADME.1ST;1
$!       2. BUILD_TAR.COM;1
$!       3. DSS.PAS;1
$!       4. LIBIFERR.MAR;6
$!       5. LIBITMLST.MAR;20
$!       6. LIBPARSE.MAR;43
$!       7. NEW-FEATURES-TAR-1.1;1
$!       8. NEW-FEATURES-TAR-1.2;1
$!       9. TAR.CLD;1
$!      10. TAR.HLP;1
$!      11. TAR.MAKE;1
$!      12. TAR.MMS;1
$!      13. TAR.PAS;1
$!      14. TARMSG.MSG;1
$!      15. TAR_EXTRACT.PAS;1
$!      16. TAR_LIST.PAS;1
$!      17. TAR_VERSION.PAS;1
$!      18. TAR_WRITE.PAS;1
$!      19. VCDEFS.PAS;1
$!
$set="set"
$set symbol/scope=(nolocal,noglobal)
$f=f$parse("SHARE_TEMP","SYS$SCRATCH:.TMP_"+f$getjpi("","PID"))
$e="write sys$error  ""%UNPACK"", "
$w="write sys$output ""%UNPACK"", "
$ if f$trnlnm("SHARE_LOG") then $ w = "!"
$ ve=f$getsyi("version")
$ if ve-f$extract(0,1,ve) .ges. "4.4" then $ goto START
$ e "-E-OLDVER, Must run at least VMS 4.4"
$ v=f$verify(v)
$ exit 44
$UNPACK: SUBROUTINE ! P1=filename, P2=checksum
$ if f$search(P1) .eqs. "" then $ goto file_absent
$ e "-W-EXISTS, File ''P1' exists. Skipped."
$ delete 'f'*
$ exit
$file_absent:
$ if f$parse(P1) .nes. "" then $ goto dirok
$ dn=f$parse(P1,,,"DIRECTORY")
$ w "-I-CREDIR, Creating directory ''dn'."
$ create/dir 'dn'
$ if $status then $ goto dirok
$ e "-E-CREDIRFAIL, Unable to create ''dn'. File skipped."
$ delete 'f'*
$ exit
$dirok:
$ w "-I-PROCESS, Processing file ''P1'."
$ if .not. f$verify() then $ define/user sys$output nl:
$ EDIT/TPU/NOSEC/NODIS/COM=SYS$INPUT 'f'/OUT='P1'
PROCEDURE Unpacker ON_ERROR ENDON_ERROR;SET(FACILITY_NAME,"UNPACK");SET(
SUCCESS,OFF);SET(INFORMATIONAL,OFF);f:=GET_INFO(COMMAND_LINE,"file_name");b:=
CREATE_BUFFER(f,f);p:=SPAN(" ")@r&LINE_END;POSITION(BEGINNING_OF(b));
LOOP EXITIF SEARCH(p,FORWARD)=0;POSITION(r);ERASE(r);ENDLOOP;POSITION(
BEGINNING_OF(b));g:=0;LOOP EXITIF MARK(NONE)=END_OF(b);x:=ERASE_CHARACTER(1);
IF g=0 THEN IF x="X" THEN MOVE_VERTICAL(1);ENDIF;IF x="V" THEN APPEND_LINE;
MOVE_HORIZONTAL(-CURRENT_OFFSET);MOVE_VERTICAL(1);ENDIF;IF x="+" THEN g:=1;
ERASE_LINE;ENDIF;ELSE IF x="-" THEN IF INDEX(CURRENT_LINE,"+-+-+-+-+-+-+-+")=
1 THEN g:=0;ENDIF;ENDIF;ERASE_LINE;ENDIF;ENDLOOP;t:="0123456789ABCDEF";
POSITION(BEGINNING_OF(b));LOOP r:=SEARCH("`",FORWARD);EXITIF r=0;POSITION(r);
ERASE(r);x1:=INDEX(t,ERASE_CHARACTER(1))-1;x2:=INDEX(t,ERASE_CHARACTER(1))-1;
COPY_TEXT(ASCII(16*x1+x2));ENDLOOP;WRITE_FILE(b,GET_INFO(COMMAND_LINE,
"output_file"));ENDPROCEDURE;Unpacker;QUIT;
$ delete/nolog 'f'*
$ CHECKSUM 'P1'
$ IF CHECKSUM$CHECKSUM .eqs. P2 THEN $ EXIT
$ e "-E-CHKSMFAIL, Checksum of ''P1' failed."
$ ENDSUBROUTINE
$START:
$ create 'f'
XVMS TAR version 1.2
X
XSubmitted by: Tim Cook, Computer Services, Victoria College, Melbourne
X   Australia.
X
XOperating System: VAX/VMS V5.0 or higher
XSource Language: Pascal, MACRO-32
XMemory Required: Not a lot.
XKeywords: TAR, tape, archive, UNIX
X
XAbstract:
X   VMS TAR is a utility that emulates the UNIX tar, or Tape ARchive
X   utility, which is used to store a set of files in a single file, usually
X   on an offline medium, such as 9-track tape.
X
X   VMS TAR automatically performs conversion of files to and from the UNIX
X   file format, and converts between UNIX and VMS file protections and
X   modification times.
X
X   A help source file is included with VMS TAR.
X
X---------------------
XInstallation:
X
XTo compile VMS TAR, either run the MMS script to build the target TAR.EXE
X($ MMS/DESC=TAR.MMS TAR.EXE), or execute BUILD_TAR.COM, which was created by
XMMS.
X
XTo install VMS TAR:
X
X   1. Move TAR.EXE to where you want to store it (or leave it with the
X      sources).
X
X   2. Define either SYS$TIME_ZONE or TAR_TIMEZONE to an appropriate value (s
Vee
X      the Caveats section in TAR.HLP).
X
X   3. Edit TAR.CLD so that it points DCL to where you have put TAR.EXE, then
X      add the TAR verb to your command table.  You can either add it to your
X      process command table (lost when you log out) by entering:
X
X         $ SET COMMAND TAR.CLD
X
X      or you can add it to the system default table with the following
X      commands (you have to be privileged to do this):
X
X         $ SET COMMAND TAR.CLD /TABLE=SYS$LIBRARY:DCLTABLES -
X              /OUTPUT=SYS$COMMON:`5BSYSLIB`5DDCLTABLES
X         $ INSTALL REPLACE SYS$LIBRARY:DCLTABLES
X
X---------------
XCopyright:
X
XVMS TAR is (c) Copyright 1989, 1990, Victoria College Computer Services, as
V it
Xwas written on their time, but as I don't see them making a quid on it, I ha
Vve
Xdecided on the following rules:
X
XWhat you CAN NOT do with VMS TAR (in source or executable form, in whole or
Xpart, or as part of another program):
X
X   1.  Sell it to someone.
X   2.  Give it away free as part of a commercial package.
X   3.  Make any income out of it.
X   4.  Pretend you wrote it.
X   5.  Smoke it.
X   6.  Re-write it in C.
X
XWhat you CAN do with VMS TAR:
X
X   1.  Use it.
X   2.  Recommend it.
X   3.  Re-distribute it at no charge.
X   4.  Re-distribute it with a charge for distribution, if you are a
X       non-profit organisation (such as DECUS).
X   5.  Re-use it in part in any non-commercial software that has (at least)
X       the same restrictions as VMS TAR itself.
X
XIf you do re-distribute or re-use VMS TAR, you must include all its copyrigh
Vt
Xnotices, and all files containing a copyright notice must point to this
Xcopyright information.
X `20
X---------------------
XMiscellaneous:
X
XI originally wrote VMS TAR out of need in early 1988.  Since then I have see
Vn
Xat least three versions of TAR for VMS (all released to the world before min
Ve).
XI thought my version was still worth the effort of maintaining and enhancing
Xbecause it has functionality and proper meshing with VMS and DCL.  None of t
Vhe
XTARs I have seen have both these properties.
X
XMost of the features of VMS TAR were added later though, so there has been a
Xlot of opportunity for bugs to creep in.  If you get any bugs you are
Xunsatisfied with, send details of them to:
X
X`09Tim Cook
X`09Computer Services
X`09Victoria College
X`09Burwood`093125
X`09Australia
X
X   or preferably
X
X`09timcc@viccol.edu.au
X
X        (UUCP heads can try `7Bbackbone`7D!uunet!viccol.edu.au!timcc)
X
XI can't guarantee that they will be looked at promptly, but I am willing to
Xfix the fixable.
$ CALL UNPACK AAAREADME.1ST;1 2067168418
$ create 'f'
X$ IF F$SEARCH ("VAXCRTL.OPT") .NES. "" THEN GOTO C_ok
X$ CREATE VAXCRTL.OPT
XSYS$SHARE:VAXCRTL/SHARE
X$C_ok:
X$ PASCAL /NOLIST/OBJECT=VCDEFS.OBJ VCDEFS.PAS
X$ PASCAL /NOLIST/OBJECT=TAR.OBJ TAR.PAS
X$ PASCAL /NOLIST/OBJECT=DSS.OBJ DSS.PAS
X$ PASCAL /NOLIST/OBJECT=TAR_WRITE.OBJ TAR_WRITE.PAS
X$ PASCAL /NOLIST/OBJECT=TAR_EXTRACT.OBJ TAR_EXTRACT.PAS
X$ PASCAL /NOLIST/OBJECT=TAR_LIST.OBJ TAR_LIST.PAS
X$ MESSAGE /NOLIST/OBJECT=TARMSG.OBJ TARMSG.MSG
X$ MACRO /NOLIST/OBJECT=LIBIFERR.OBJ LIBIFERR.MAR
X$ MACRO /NOLIST/OBJECT=LIBITMLST.OBJ LIBITMLST.MAR
X$ MACRO /NOLIST/OBJECT=LIBPARSE.OBJ LIBPARSE.MAR
X$ LINK /TRACE/NOMAP/EXEC=TAR.EXE/NOTRACE tar.obj, tar_write.obj, tar_extract
V.obj, tar_list.obj, tarmsg.obj, vcdefs.obj, dss.obj, libiferr.obj, libitmlst
V.obj, libparse.obj, vaxcrtl.opt/OPT
$ CALL UNPACK BUILD_TAR.COM;1 1544964971
$ create 'f'
X`5BENVIRONMENT ('DSS'),
X   CHECK(NONE)`5D            `7B Any necessary checks are done explicitly `7
VD
X
XMODULE dynamic_string_storage ;
X
X`7B ABSTRACT:
X!`09The routines contained herein implement a system of dynamic
X!`09sequential string storage.
X!
X! GLOBAL routines contained herein:
X!
X!`09put_string_in_storage (string)
X!`09   Appends a string to the end of storage, automatically allocating
X!`09   a new storage block if necessary.
X!
X!`09get_string_from_storage (string)
X!`09   Reads the next string in storage.  If there are no strings in
X!`09   storage, or the read point is past the end of storage, the
X!`09   end_of_storage routine will return TRUE.  If get_string_from_storage
X!`09   is called before rewind_storage, the read pointer will be set to the
X!`09   beginnning of storage.
X!
X!`09status = end_of_storage
X!`09   Returns a boolean indicating if last string has been read (or
X!`09   no strings to read.
X!
X!`09number = get_allocated_blocks
X!`09   Returns the number of storage blocks allocated.
X!
X!`09reset_storage (blocks_to_free)
X!`09   Resets the write point to the beginning of the storage, optionally
X!`09   deallocating a specified number of storage blocks. If
X!`09   blocks_to_free is not specified, or is specified as a negative
X!`09   integer, all storage is deallocated.
X!
X!`09rewind_storage
X!`09   Resets the read point to the beginning of storage.
X!___________________________________________________________________________
X! AUTHOR:
X!`09Tim Cook, 19-MAY-1989
X!___________________________________________________________________________
X`7D
X
X   CONST
X      pointer_size = 4 ;               `7B A fairly safe assumption `7D
X      string_delimiter = chr (0) ;     `7B designed for use with UNIX filesp
Vecs `7D
X      block_size = 512 * 64 - 2 * pointer_size ;
X         `7B Sized so that, if the heap is page-aligned, all storage blocks
X           will be too `7D
X
X   TYPE
X      storage_block_type = RECORD
X         back : `5Estorage_block_type ;
X         forward : `5Estorage_block_type ;
X         data : PACKED ARRAY `5B1..block_size`5D OF char END ;
X      storage_block_pointer = `5Estorage_block_type ;
X
X   VAR
X      write_ptr : storage_block_pointer := nil ;
X      free_point : integer := 0 ;   `7B First free character in block `7D
X      read_ptr : storage_block_pointer := nil ;
X      read_point : integer ;
X      blocks_allocated : integer := 0 ;
X      max_string_size : integer := 0 ;
X
X
X   `5BGLOBAL`5D FUNCTION get_allocated_blocks : integer ;
X      BEGIN
X         get_allocated_blocks := blocks_allocated END ;
X
X
X   PROCEDURE initialise_storage ;
X      BEGIN
X         new (write_ptr) ;
X         write_ptr`5E.forward := nil ;
X         write_ptr`5E.back := nil ;
X         read_ptr := write_ptr ;
X         blocks_allocated := 1 ;
X         free_point := 1 ;
X         read_point := 1 END ;
X
X
X   PROCEDURE new_block (`09`7B Find or allocate a new storage block `7D
X      VAR block_ptr : storage_block_pointer) ;
X
X      BEGIN
X         IF block_ptr`5E.forward = nil THEN BEGIN
X            new (block_ptr`5E.forward) ;
X            block_ptr`5E.forward`5E.forward := nil ;
X            block_ptr`5E.forward`5E.back := block_ptr ;
X            blocks_allocated := blocks_allocated + 1 END ;
X         block_ptr := block_ptr`5E.forward END ;
X
X
X   `5BGLOBAL`5D PROCEDURE put_string_in_storage (
X      VAR string : VARYING `5Bn`5D OF char) ;
X
X      VAR
X         more : boolean ;
X         string_length, string_index : integer ;
X
X      BEGIN
X         IF blocks_allocated = 0 THEN
X            initialise_storage ;
X         string_length := length (string) ;
X         max_string_size := max (max_string_size, string_length) ;
X         string_length := string_length + 1 ;
X         string_index := 1 ;
X         more := true ;
X         WHILE more DO BEGIN
X            IF string_index = string_length THEN
X               write_ptr`5E.data`5Bfree_point`5D := string_delimiter
X            ELSE
X               write_ptr`5E.data`5Bfree_point`5D := string`5Bstring_index`5D
V ;
X            free_point := free_point + 1 ;
X            string_index := string_index + 1 ;
X            IF free_point > block_size THEN BEGIN
X               new_block (write_ptr) ;
X               free_point := 1 END ;
X            more := string_index <= string_length END ;
X         END ;
X
X
X   `5BGLOBAL`5D PROCEDURE reset_storage (
X      blocks_to_free : integer := -1) ;
X
X      VAR
X         blocks_freed : integer ;
X         temp_ptr : storage_block_pointer ;
X
X      BEGIN
X         IF blocks_to_free < 0 THEN
X            blocks_to_free := blocks_allocated
X         ELSE
X            blocks_to_free := min (blocks_to_free, blocks_allocated) ;
X         blocks_freed := 0 ;
X         WHILE blocks_freed < blocks_to_free DO BEGIN
X
X      `7B I could check to see if write_ptr`5E.back is nil, but I won't beca
Vuse
X        it shouldn't be `7D
X
X            temp_ptr := write_ptr`5E.back ;
X            dispose (write_ptr) ;
X            write_ptr := temp_ptr ;
X            blocks_freed := blocks_freed + 1 END ;
X         blocks_allocated := blocks_allocated - blocks_freed ;
X         IF write_ptr <> nil THEN
X            WHILE write_ptr`5E.back <> nil DO
X               write_ptr := write_ptr`5E.back ;
X         read_ptr := nil ;
X         read_point := 0 ;
X         free_point := 0 ;
X         END ;
X
X
X   `5BGLOBAL`5D PROCEDURE rewind_storage ;
X      BEGIN
X         read_ptr := write_ptr ;
X         IF read_ptr <> nil THEN BEGIN
X            WHILE read_ptr`5E.back <> nil DO
X               read_ptr := read_ptr`5E.back ;
X            read_point := 1 END ;
X         END ;
X
X
X   `5BGLOBAL`5D FUNCTION end_of_storage `7B Indicates if last string has bee
Vn read `7D
X      : boolean ;
X
X      BEGIN
X         IF read_ptr <> nil THEN
X            end_of_storage := (read_ptr`5E.forward = nil) AND
X               (read_point >= free_point)
X         ELSE
X            end_of_storage := true END ;
X
X
X   `5BGLOBAL`5D PROCEDURE get_string_from_storage (
X      VAR string : VARYING `5Bn`5D OF char) ;
X
X      VAR
X         string_index : integer ;
X
X      BEGIN
X         IF end_of_storage THEN string := ''
X         ELSE BEGIN
X            string_index := 1 ;
X            string.length := max_string_size + 1 ;
X            WHILE read_ptr`5E.data`5Bread_point`5D <> string_delimiter DO BE
VGIN
X               string`5Bstring_index`5D := read_ptr`5E.data`5Bread_point`5D
V ;
X               read_point := read_point + 1 ;
X               string_index := string_index + 1 ;
X
X               IF read_point > block_size THEN BEGIN
X
X            `7B Could check if read_ptr`5E.forward is nil here, but it
X              shouldn't be, so I won't `7D
X
X                  read_ptr := read_ptr`5E.forward ;
X                  read_point := 1 END ;
X
X               END ;
X            string.length := string_index - 1 ;
X            read_point := read_point + 1 ;
X            END ;
X         END ;
X
X   END.
$ CALL UNPACK DSS.PAS;1 271314003
$ create 'f'
X`09.TITLE`09lib_iferr
X`09.IDENT`09/1-001/`09`09; File :  SRC$UMLIB:LIBIFERR.MAR
X`09`09`09`09; Edit :  DGM1001
X;++
X; FACILITY: General Utility Library
X;
X; ABSTRACT:
X;
X;`09This module contains routines for signalling or unwinding
X;`09If a provided condition code is not success.
X;
X; ENVIRONMENT:  Runs at any access mode, AST reentrant
X;
X; AUTHOR:  Douglas G. Miller,  CREATION DATE:  03-Jun-1984
X;
X; MODIFIED BY:
X;
X; 1-001  -  Original. DGM 03-Jun-1984
X; 1-002  -  Add provision for extra messages.  DGM 27-Sep-1984
X; 1-003  -  Add function return of parameter.  DGM 1-Oct-1984
X;--
X;
X`09.PSECT`09_LIB_CODE PIC, USR, CON, REL, LCL, SHR, EXE, RD, NOWRT, LONG
Xdepth:`09.LONG  2
X;
X`09.ENTRY lib_retiferr `5EM<R2,R3,R4,R5,R6,R7>
X`09MOVAL`09LIB___RETIFERR_HANDLER,`09(FP)
X`09BRB`09lib_sigiferr+2
X;
X`09.ENTRY lib_sigiferr `5EM<R2,R3,R4,R5,R6,R7>
X`09MOVQ`09(AP),`09R6`09`09; R6 is number of arguments
X`09BLBS`09R7,`09RET`09`09; R7 is status
X`09MULL3`09#4,`09R6,`09R1
X`09SUBL2`09#4,`09R1
X`09PUSHL`09R7
X`09SUBL2`09R1,`09SP
X        MOVC3`09R1,`098(AP),`09(SP)
X`09CALLS`09R6,`09G`5ELIB$SIGNAL
XRET:`09MOVL`09R7,`09R0
X`09RET
X;
Xlib___retiferr_handler:`09.WORD `5EM<>
X`09MOVL`098(AP),`09R1`09`09; MECHARGS
X`09MOVL`09R7,`0912(R1)
X`09$UNWIND_S  depth,
X`09RET
X;
X`09.END
$ CALL UNPACK LIBIFERR.MAR;6 1731350920
$ create 'f'
X`09.TITLE lib_item_list
X;
X;`09Doug Miller, April 1984
X;
X;`09Turn the argument list into an item list for $GETDVI, $GETJPI, etc.
X;
X`09$DSCDEF
X`09$SFDEF
X`09$SSDEF
X;
XITEM_W_BUFFER_LEN = 0
XITEM_W_CODE = 2
XITEM_A_BUFFER = 4
XITEM_A_RETLENGTH = 8
XITEM_B_BUFFER = 12
XPARAM_W_ITEMCODE = 8
XPARAM_A_BUFFER_DX = 12
XPARAM_A_RETLENGTH = 16
X;
X`09.PSECT`09ITEM_LIST, CON, NOEXE, NOSHR, PIC, REL
XITEMLIST:`09.BLKL`09256
XITEM`09:`09.BLKL`093
X;
X`09.PSECT`09LIB_ITEM_LIST, CON, EXE, SHR, PIC, REL
X`09.ENTRY lib_item_list `5EM<R2,R3,R4,R5,R6,R7>
X;
X`09ADDL3`09#4, AP,`09R5`09; Create argument list pointer
X`09MOVAL`09@(R5)+,`09R6`09; Create current item address
X`09SUBL3`09#1, (AP), R2
X;
XLOOP:`09MOVL`09(R5)+,`09R0`09; move current argument to R0
X`09MOVL`09(R0)+,`09(R6)+`09; move buffer_length and item_code
X`09MOVQ`09(R0),`09(R6)+`09; move buffer_address and retlength_address
X`09SOBGTR`09R2,`09LOOP`09; Count down the items
X;
X`09CLRL`09(R6)`09`09; Terminate item list
X`09RET
X;
X`09.ENTRY`09lib_in_item `5EM<R2,R3,R4,R5,R6,R7>
X;
X`09MOVAL`09@4(AP),`09`09`09R6`09; Create current item address
X`09CLRQ`09`09`09`09ITEM_A_BUFFER(R6) ; clear buffer and retlength addresses
X`09MOVAL`09@PARAM_A_BUFFER_DX(AP),`09R7
X`09BEQL`09ITEMEND
X`09MOVAL`09ITEM_B_BUFFER(R6),`09ITEM_A_BUFFER(R6)
X`09CMPB`09DSC$B_CLASS(R7), #DSC$K_CLASS_VS
X`09BEQL`09IN_DVS
XIN_DX:`09MOVW`09DSC$W_LENGTH(R7),`09ITEM_W_BUFFER_LEN(R6)
X`09MOVC5`09ITEM_W_BUFFER_LEN(R6), @DSC$A_POINTER(R7), #`5EA' ', #80, ITEM_B_
VBUFFER(R6)
X`09BRB`09ITEMEND
XIN_DVS:`09MOVW`09@DSC$A_POINTER(R7),`09ITEM_W_BUFFER_LEN(R6) ; use current l
Vength of varying string
X`09ADDL3`09#2, DSC$A_POINTER(R7),`09R1
X`09MOVC5`09ITEM_W_BUFFER_LEN(R6), (R1), #`5EA' ', #80, ITEM_B_BUFFER(R6)
X`09BRB`09ITEMEND
X;
X`09.ENTRY lib_out_item `5EM<R2,R3,R4,R5,R6,R7>
X
X`09MOVAL`09@4(AP),`09`09`09R6`09; Create current item address
X`09MOVAL`09@PARAM_A_BUFFER_DX(AP),`09R7
X`09CMPB`09DSC$B_CLASS(R7), #DSC$K_CLASS_VS
X`09BEQL`09OUT_DVS
XOUT_DX:`09MOVL`09DSC$A_POINTER(R7),`09ITEM_A_BUFFER(R6)`09
X`09MOVW`09DSC$W_LENGTH(R7),`09ITEM_W_BUFFER_LEN(R6)
X`09MOVAL`09@PARAM_A_RETLENGTH(AP),`09ITEM_A_RETLENGTH(R6)
X`09BRB`09ITEMEND
XOUT_DVS:ADDL3`09#2, DSC$A_POINTER(R7),`09ITEM_A_BUFFER(R6)`09
X`09MOVW`09DSC$W_LENGTH(R7),`09ITEM_W_BUFFER_LEN(R6)
X`09MOVAW`09@DSC$A_POINTER(R7),`09ITEM_A_RETLENGTH(R6)
X;
XITEMEND:
X`09MOVW`09PARAM_W_ITEMCODE(AP),`09ITEM_W_CODE(R6)
X`09RET
X;
X`09.END
$ CALL UNPACK LIBITMLST.MAR;20 1595222306
$ create 'f'
X.TITLE lib_parse  -  file-spec parsing routine
X.IDENT /1-001/  ; File : LIBTEMPLA.MAR
X;*************************************************************************
X; FACILITY:`09LIB, General Utility Library
X;
X; ABSTRACT:`09Returns RMS expanded file-spec (or portions therof)
X;`09`09by using $PARSE system service.
X;
X; ENVIRONMENT:`09Runs at any access mode, AST reentrant.
X;
X; AUTHOR:`09Douglas Miller
X; CREATED:`0918-MAR-1985
X;.........................................................................
X; MODIFIED
X;
X;*************************************************************************
X;
X`09.PSECT _LIB_DATA PIC, USR, CON, REL, LCL, NOSHR, NOEXE, RD, WRT, LONG
X;
X $NAMDEF
X;
X      nam__node = 0 ;
X      nam__dev  = 1 ;
X      nam__dir  = 2 ;
X      nam__name = 3 ;
X      nam__type = 4 ;
X      nam__ver  = 5 ;
X;
X min_params = 2
X;
X _filespec= 1
X _expanded = 2
X _default = 3
X _related = 4
X _expanded_length = 5
X _fields = 6
X;
Xes:`09.BLKB NAM$C_MAXRSS
X.ALIGN LONG
Xfab:`09$FAB  FOP=NAM, NAM=nam
X.ALIGN LONG
Xnam:`09$NAM  ESA=es, ESS=NAM$C_MAXRSS, NOP=SYNCHK ; parse for syntax only
X.ALIGN LONG
Xrlfnam:`09$NAM  NOP=SYNCHK
X;
X .PSECT _LIB_CODE PIC,USR,CON,REL,LCL,SHR,EXE,RD,NOWRT,LONG
X;
X .ENTRY lib_parse `5EM<R2,R3,R4,R5,R6,R7,R8,R9,R10>
X;
X`09CMPL`09(AP), #_expanded
X`09BGEQ`0999$
X`09BRW`09invarg
X99$:
X;
Xfilespec:
X`09MOVL`094*_filespec(AP), R0
X `09JSB`09G`5ELIB$ANALYZE_SDESC_R2
X`09BLBS`09R0, 10$
X`09BRW`09error
X10$:`09MOVB`09R1, FAB+FAB$B_FNS
X`09MOVL`09R2, FAB+FAB$L_FNA
X;
Xdefault:
X`09CMPL`09(AP), #_default
X`09BLSS`0999$
X`09MOVL`094*_default(AP), R0
X`09BEQL`0999$
X`09JSB`09G`5ELIB$ANALYZE_SDESC_R2
X`09BLBS`09R0, 10$
X`09BRW`09error
X10$:`09MOVB`09R1, FAB+FAB$B_DNS
X`09MOVL`09R2, FAB+FAB$L_DNA
X99$:
X;
Xrelated:
X`09CMPL`09(AP), #_related
X`09BLSS`0999$
X`09MOVL`094*_related(AP), R0
X`09BEQL`0999$
X`09JSB`09G`5ELIB$ANALYZE_SDESC_R2
X`09BLBS`09R0, 10$
X`09BRW`09error
X10$:`09MOVB`09R1, RLFNAM+NAM$B_RSS
X`09MOVL`09R2, RLFNAM+NAM$L_RSA
X`09MOVAL`09rlfnam, nam+NAM$L_RLF
X99$:
X;
Xparse:
X`09$PARSE`09FAB=fab
X`09BLBS`09R0, 10$
X`09BRW`09error
X10$:`09MOVL`09R0, R10
X;
X;
Xfields:
X`09MOVL`09#_fields, R6`09; longword offset to next field code
X`09MOVAB`09es, R3
X;
X`09CMPL`09R6, (AP)
X`09BGTR`0910$
X`09MOVL`09(AP)`5BR6`5D, R0
X`09BNEQ`09loop
X10$:`09BRW`09full_expanded`09; no fields specified, so get everything
X;
Xloop:`09CASEB`09(R0), #nam__node, #nam__ver
X1$:`09.WORD`09node-1$, dev-1$, dir-1$, name-1$, type-1$, ver-1$
X`09BRW`09invarg
X;
Xnode:`09MOVZBW`09nam+NAM$B_NODE, R0
X`09MOVC3`09R0, @nam+NAM$L_NODE, (R3)
X`09BRB next
Xdev:`09MOVZBW`09nam+NAM$B_DEV, R0
X`09MOVC3`09R0, @nam+NAM$L_DEV, (R3)
X`09BRB next
Xdir:`09MOVZBW`09nam+NAM$B_DIR, R0
X`09MOVC3`09R0, @nam+NAM$L_DIR, (R3)
X`09BRB next
Xname:`09MOVZBW`09nam+NAM$B_NAME, R0
X`09MOVC3`09R0, @nam+NAM$L_NAME, (R3)
X`09BRB next
Xtype:`09MOVZBW`09nam+NAM$B_TYPE, R0
X`09MOVC3`09R0, @nam+NAM$L_TYPE, (R3)
X`09BRB next
Xver:`09MOVZBW`09nam+NAM$B_VER, R0
X`09MOVC3`09R0, @nam+NAM$L_VER, (R3)
X`09BRB next
X;
Xnext:`09AOBLEQ`09(AP), R6, 10$
X`09BRB`0999$
X10$:`09MOVL`09(AP)`5BR6`5D, R0
X`09BRW`09loop
X99$:
X;
X;
Xexpanded:
X`09SUBL3`09#es, R3, R9`09 ; length of expanded filespec
X`09BRB`09move_to_expanded ; some fields filled in
Xfull_expanded:
X`09MOVZBW`09nam+NAM$B_ESL, R9
X`09MOVC3`09R9, @nam+NAM$L_ESA, es
Xmove_to_expanded:
X`09MOVL`094*_expanded(AP), R0
X`09BEQL`09invarg
X`09MOVW`09R9, R1
X`09MOVAB`09es, R2
X`09JSB`09G`5ESTR$COPY_R_R8
X;
Xexpanded_length:
X`09CMPL`09(AP), #_expanded_length
X`09BLSS`09ret
X`09MOVL`094*_expanded_length(AP), R0
X`09BEQL`09ret
X`09MOVZBW`09nam+NAM$B_ESL, (R0)
X;
Xret:`09MOVL`09R10, R0
X`09RET
X;
Xinvarg:`09MOVL`09#LIB$_INVARG, R0
Xerror:`09RET
X;
X`09.END
$ CALL UNPACK LIBPARSE.MAR;43 167919095
$ create 'f'
XDescription of new features and bug fixes in VMS TAR version 1.1
X
X1.  File specification lists
X
X    The second parameter to TAR, the file-spec, may now be a
X    comma-separated list.
X
X2.  Handling of Bourne shell wildcards on EXTRACT and LIST
X
X    When EXTRACTing or LISTing files, TAR will interpret the Bourne
X    shell wildcards * and ?, and ranges enclosed in `5B`5D.  This
X    interpretation can be turned off by use of the positional /LITERAL
X    qualifier.
X
X    This was implemented using the undocumented routine
X    SHELL$MATCH_WILD, found in SYS$LIBRARY:VAXCRTL, and known to be a
X    part of DEC/Shell, which is advertised as a "Version 7 Bourne shell
X    for VMS".  Some extra checking was added inside TAR so that * and ?
X    would not match the directory separator /.  All Bourne shells I have
X    seen act this way, not the way dictated by SHELL$MATCH_WILD.  Note
X    that there are a few other incompatibilities between
X    SHELL$MATCH_WILD and real Bourne shells.
X
X3.  Automatic creation of directories
X
X    TAR now automatically creates any necessary directories when
X    EXTRACTing.  Previously, if the directory was not in the archive, it
X    was not created.
X
X    TAR now also adds necessary directories into an archive when WRITing
X    or APPENDing.
X
X4.  The /OUTPUT qualifier has become rational
X
X    The /OUTPUT qualifier is now available only with the LIST keyword.`20
X    It was never properly implemented on the other keywords, so it has
X    been disallowed with them.
X
X5.  Modify time-handling to allow TAR to compile under VMS V4
X
X    TAR's time-conversion routines now do a G_FLOAT divide instead of
X    calling LIB$CVT_FROM_INTERNAL_TIME, a routine found only in VMS V5.
X    This means that TAR should now work under VMS V4 as well.
X
X6.  Add capability to /APPEND to an archive on tape
X
X    Another item that was not tested in v1.0.  TAR will now APPEND
X    correctly to an archive on a tape MOUNTed /FOREIGN.
X
X7.  Correct behaviour when Ctrl-Z typed at a /CONFIRM prompt
X
X    TAR used to just abort when given a Ctrl-Z at a /CONFIRM prompt, now
X    it cleans up and reports before aborting.
X
X8.  Bug fixes
X
X    Two or three bugs remaining in version 1.0-1 have been fixed,
X    including a bug when TAR attempts to WRITE an archive containing
X    more that 100 files with /MAP_MODE=PREFIX.
$ CALL UNPACK NEW-FEATURES-TAR-1.1;1 371152978
$ create 'f'
XDescription of new features and bug fixes in VMS TAR version 1.2:
X
X1.  Fixed bug introduced in version 1.1-2 where no more than 1 normal
X    file can be extracted.
X
X2.  Fixed bug where TAR EXTRACT dies after a link is found (this was the
X    bug that was supposed to be fixed by version 1.1-2).
X
X3.  Improved displaying of links by TAR LIST (it now tells you what the
X    entry is linked to).  See TAR.HLP for more details.
+-+-+-+-+-+-+-+-  END  OF PART 1 +-+-+-+-+-+-+-+-