From:	CRDGW2::CRDGW2::MRGATE::"SMTP::CRVAX.SRI.COM::RELAY-INFO-VAX" 14-SEP-1989 06:45
To:	MRGATE::"ARISIA::EVERHART"
Subj:	VMS TAR v1.1   part 1 of 6

Received: From UCBVAX.BERKELEY.EDU by GIZMO.SRI.COM with TCP; Thu, 14 SEP 89 01:52:23 PDT
Received: by ucbvax.Berkeley.EDU (5.61/1.37)
	id AA09211; Thu, 14 Sep 89 01:39:58 -0700
Received: from USENET by ucbvax.Berkeley.EDU with netnews
	for info-vax@kl.sri.com (info-vax@kl.sri.com)
	(contact usenet@ucbvax.Berkeley.EDU if you have questions)
Date: 14 Sep 89 20:02:19 GMT
From: uhccux!munnari.oz.au!murtoa.cs.mu.oz.au!viccol!timcc@ames.arc.nasa.gov  (Tim Cook)
Organization: Computer Services, Victoria College, Melbourne
Subject: VMS TAR v1.1   part 1 of 6
Message-Id: <1938@csv.viccol.edu.au>
Sender: info-vax-request@kl.sri.com
To: info-vax@kl.sri.com

$! ------------------ CUT HERE -----------------------
$ v='f$verify(f$trnlnm("SHARE_VERIFY"))'
$!
$! This archive created by VMS_SHARE Version 7.1-004  3-AUG-1989
$!   On 14-SEP-1989 14:11:01.00   By user timcc@viccol.edu.au (Tim Cook)
$!
$! This VMS_SHARE Written by Andy Harper, Kings College London UK
$!
$!+ THIS PACKAGE DISTRIBUTED IN 6 PARTS, TO KEEP EACH PART
$!  BELOW 51 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;2
$!       3. DSS.PAS;1
$!       4. LIBIFERR.MAR;6
$!       5. LIBITMLST.MAR;19
$!       6. LIBPARSE.MAR;43
$!       7. NEW-FEATURES-TAR-1.1;1
$!       8. TAR.CLD;1
$!       9. TAR.HLP;1
$!      10. TAR.MMS;1
$!      11. TAR.PAS;1
$!      12. TARMSG.MSG;1
$!      13. TAR_EXTRACT.PAS;1
$!      14. TAR_LIST.PAS;1
$!      15. TAR_WRITE.PAS;1
$!      16. 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 = "!"
$ if f$getsyi("version") .ges. "V4.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/nolog '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/nolog 'f'*
$ exit
$dirok:
$ w "-I-PROCESS, Processing file ''P1'."
$ 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");
buff:=CREATE_BUFFER(f,f);p:=SPAN(" ")@r&LINE_END;POSITION(BEGINNING_OF(buff))
;LOOP EXITIF SEARCH(p,FORWARD)=0;POSITION(r);ERASE(r);ENDLOOP;POSITION(
BEGINNING_OF(buff));g:=0;LOOP EXITIF MARK(NONE)=END_OF(buff);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 g:=0;ENDIF;ERASE_LINE;
ENDIF;ENDLOOP;p:="`";POSITION(BEGINNING_OF(buff));LOOP r:=SEARCH(p,FORWARD);
EXITIF r=0;POSITION(r);ERASE(r);COPY_TEXT(ASCII(INT(ERASE_CHARACTER(3))));
ENDLOOP;o:=GET_INFO(COMMAND_LINE,"output_file");WRITE_FILE(buff,o);
ENDPROCEDURE;Unpacker;EXIT;
$ delete/nolog 'f'*
$ CHECKSUM 'P1'
$ IF CHECKSUM$CHECKSUM .eqs. P2 THEN $ EXIT
$ e "-E-CHKSMFAIL, Checksum of ''P1' failed."
$ ENDSUBROUTINE
$START:
$ create/nolog 'f'
XVMS TAR version 1.1
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:`091SYSLIB`093DCLTABLES
X         $ INSTALL REPLACE SYS$LIBRARY:DCLTABLES
X
X---------------
XCopyright:
X
XVMS TAR is (c) Copyright 1989 Victoria College Computer Services, as it was
Xwritten on their time, but as I don't see them making a quid on it, I have
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  `032
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`009Tim Cook
X`009Computer Services
X`009Victoria College
X`009Burwood`0093125
X`009Australia
X
X   or preferably
X
X`009timcc@viccol.edu.au
X
X        (UUCP heads can try `123backbone`125!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 2054751891
$ create/nolog '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;2 1544964971
$ create/nolog 'f'
X`091ENVIRONMENT ('DSS'),
X   CHECK(NONE)`093            `123 Any necessary checks are done explicitly
V `125
X
XMODULE dynamic_string_storage ;
X
X`123 ABSTRACT:
X!`009The routines contained herein implement a system of dynamic
X!`009sequential string storage.
X!
X! GLOBAL routines contained herein:
X!
X!`009put_string_in_storage (string)
X!`009   Appends a string to the end of storage, automatically allocating
X!`009   a new storage block if necessary.
X!
X!`009get_string_from_storage (string)
X!`009   Reads the next string in storage.  If there are no strings in
X!`009   storage, or the read point is past the end of storage, the
X!`009   end_of_storage routine will return TRUE.  If get_string_from_storage
X!`009   is called before rewind_storage, the read pointer will be set to the
X!`009   beginnning of storage.
X!
X!`009status = end_of_storage
X!`009   Returns a boolean indicating if last string has been read (or
X!`009   no strings to read.
X!
X!`009number = get_allocated_blocks
X!`009   Returns the number of storage blocks allocated.
X!
X!`009reset_storage (blocks_to_free)
X!`009   Resets the write point to the beginning of the storage, optionally
X!`009   deallocating a specified number of storage blocks. If
X!`009   blocks_to_free is not specified, or is specified as a negative
X!`009   integer, all storage is deallocated.
X!
X!`009rewind_storage
X!`009   Resets the read point to the beginning of storage.
X!___________________________________________________________________________
X! AUTHOR:
X!`009Tim Cook, 19-MAY-1989
X!___________________________________________________________________________
X`125
X
X   CONST
X      pointer_size = 4 ;               `123 A fairly safe assumption `125
X      string_delimiter = chr (0) ;     `123 designed for use with UNIX files
Vpecs `125
X      block_size = 512 * 64 - 2 * pointer_size ;
X         `123 Sized so that, if the heap is page-aligned, all storage blocks
X           will be too `125
X
X   TYPE
X      storage_block_type = RECORD
X         back : `094storage_block_type ;
X         forward : `094storage_block_type ;
X         data : PACKED ARRAY `0911..block_size`093 OF char END ;
X      storage_block_pointer = `094storage_block_type ;
X
X   VAR
X      write_ptr : storage_block_pointer := nil ;
X      free_point : integer := 0 ;   `123 First free character in block `125
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   `091GLOBAL`093 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`094.forward := nil ;
X         write_ptr`094.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 (`009`123 Find or allocate a new storage block `125
X      VAR block_ptr : storage_block_pointer) ;
X
X      BEGIN
X         IF block_ptr`094.forward = nil THEN BEGIN
X            new (block_ptr`094.forward) ;
X            block_ptr`094.forward`094.forward := nil ;
X            block_ptr`094.forward`094.back := block_ptr ;
X            blocks_allocated := blocks_allocated + 1 END ;
X         block_ptr := block_ptr`094.forward END ;
X
X
X   `091GLOBAL`093 PROCEDURE put_string_in_storage (
X      VAR string : VARYING `091n`093 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`094.data`091free_point`093 := string_delimiter
X            ELSE
X               write_ptr`094.data`091free_point`093 := string`091string_inde
Vx`093 ;
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   `091GLOBAL`093 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      `123 I could check to see if write_ptr`094.back is nil, but I won't be
Vcause
X        it shouldn't be `125
X
X            temp_ptr := write_ptr`094.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`094.back <> nil DO
X               write_ptr := write_ptr`094.back ;
X         read_ptr := nil ;
X         read_point := 0 ;
X         free_point := 0 ;
X         END ;
X
X
X   `091GLOBAL`093 PROCEDURE rewind_storage ;
X      BEGIN
X         read_ptr := write_ptr ;
X         IF read_ptr <> nil THEN BEGIN
X            WHILE read_ptr`094.back <> nil DO
X               read_ptr := read_ptr`094.back ;
X            read_point := 1 END ;
X         END ;
X
X
X   `091GLOBAL`093 FUNCTION end_of_storage `123 Indicates if last string has
V been read `125
X      : boolean ;
X
X      BEGIN
X         IF read_ptr <> nil THEN
X            end_of_storage := (read_ptr`094.forward = nil) AND
X               (read_point >= free_point)
X         ELSE
X            end_of_storage := true END ;
X
X
X   `091GLOBAL`093 PROCEDURE get_string_from_storage (
X      VAR string : VARYING `091n`093 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`094.data`091read_point`093 <> string_delimiter DO
V BEGIN
X               string`091string_index`093 := read_ptr`094.data`091read_point
V`093 ;
X               read_point := read_point + 1 ;
X               string_index := string_index + 1 ;
X
X               IF read_point > block_size THEN BEGIN
X
X            `123 Could check if read_ptr`094.forward is nil here, but it
X              shouldn't be, so I won't `125
X
X                  read_ptr := read_ptr`094.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/nolog 'f'
X`009.TITLE`009lib_iferr
X`009.IDENT`009/1-001/`009`009; File :  SRC$UMLIB:LIBIFERR.MAR
X`009`009`009`009; Edit :  DGM1001
X;++
X; FACILITY: General Utility Library
X;
X; ABSTRACT:
X;
X;`009This module contains routines for signalling or unwinding
X;`009If 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`009.PSECT`009_LIB_CODE PIC, USR, CON, REL, LCL, SHR, EXE, RD, NOWRT, LONG
Xdepth:`009.LONG  2
X;
X`009.ENTRY lib_retiferr `094M<R2,R3,R4,R5,R6,R7>
X`009MOVAL`009LIB___RETIFERR_HANDLER,`009(FP)
X`009BRB`009lib_sigiferr+2
X;
X`009.ENTRY lib_sigiferr `094M<R2,R3,R4,R5,R6,R7>
X`009MOVQ`009(AP),`009R6`009`009; R6 is number of arguments
X`009BLBS`009R7,`009RET`009`009; R7 is status
X`009MULL3`009#4,`009R6,`009R1
X`009SUBL2`009#4,`009R1
X`009PUSHL`009R7
X`009SUBL2`009R1,`009SP
X        MOVC3`009R1,`0098(AP),`009(SP)
X`009CALLS`009R6,`009G`094LIB$SIGNAL
XRET:`009MOVL`009R7,`009R0
X`009RET
X;
Xlib___retiferr_handler:`009.WORD `094M<>
X`009MOVL`0098(AP),`009R1`009`009; MECHARGS
X`009MOVL`009R7,`00912(R1)
X`009$UNWIND_S  depth,
X`009RET
X;
X`009.END
$ CALL UNPACK LIBIFERR.MAR;6 1731350920
$ create/nolog 'f'
X`009.TITLE lib_item_list      `032
X;
X;`009Doug Miller, April 1984
X;
X;`009Turn the argument list into an item list for $GETDVI, $GETJPI, etc.
X;
X`009$DSCDEF
X`009$SFDEF
X`009$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`009.PSECT`009ITEM_LIST, CON, NOEXE, NOSHR, PIC, REL
XITEMLIST:`009.BLKL`009256
XITEM`009:`009.BLKL`0093
X;
X`009.PSECT`009LIB_ITEM_LIST, CON, EXE, SHR, PIC, REL
X`009.ENTRY lib_item_list `094M<R2,R3,R4,R5,R6,R7>
X;               `032
X`009ADDL3`009#4, AP,`009R5`009; Create argument list pointer
X`009MOVAL`009@(R5)+,`009R6`009; Create current item address
X`009SUBL3`009#1, (AP), R2
X;
XLOOP:`009MOVL`009(R5)+,`009R0`009; move current argument to R0
X`009MOVL`009(R0)+,`009(R6)+`009; move buffer_length and item_code
X`009MOVQ`009(R0),`009(R6)+`009; move buffer_address and retlength_address
X`009SOBGTR`009R2,`009LOOP`009; Count down the items
X;
X`009CLRL`009(R6)`009`009; Terminate item list
X`009RET
X;   `032
X`009.ENTRY lib_in_item `094M<R2,R3,R4,R5,R6,R7>
X;
X`009MOVAL`009@4(AP),`009`009`009R6`009; Create current item address
X`009CLRQ`009`009`009`009ITEM_A_BUFFER(R6) ; clear buffer and retlength addre
Vsses
X`009MOVAL`009@PARAM_A_BUFFER_DX(AP),`009R7
X`009BEQL`009ITEMEND
X`009MOVAL`009ITEM_B_BUFFER(R6),`009ITEM_A_BUFFER(R6)
X`009CMPB`009DSC$B_CLASS(R7), #DSC$K_CLASS_VS
X`009BEQL`009IN_DVS
XIN_DX:`009MOVW`009DSC$W_LENGTH(R7),`009ITEM_W_BUFFER_LEN(R6)
X`009MOVC5`009ITEM_W_BUFFER_LEN(R6), @DSC$A_POINTER(R7), #`094A' ', #80, ITEM
V_B_BUFFER(R6)
X`009BRB`009ITEMEND                       `032
XIN_DVS:`009MOVW`009@DSC$A_POINTER(R7),`009ITEM_W_BUFFER_LEN(R6) ; use curren
Vt length of varying string
X`009ADDL3`009#2, DSC$A_POINTER(R7),`009R1
X`009MOVC5`009ITEM_W_BUFFER_LEN(R6), (R1), #`094A' ', #80, ITEM_B_BUFFER(R6)
X`009BRB`009ITEMEND                       `032
X;
X`009.ENTRY lib_out_item `094M<R2,R3,R4,R5,R6,R7>
X
X`009MOVAL`009@4(AP),`009`009`009R6`009; Create current item address
X`009MOVAL`009@PARAM_A_BUFFER_DX(AP),`009R7
X`009CMPB`009DSC$B_CLASS(R7), #DSC$K_CLASS_VS
X`009BEQL`009OUT_DVS
XOUT_DX:`009MOVL`009DSC$A_POINTER(R7),`009ITEM_A_BUFFER(R6)`009
X`009MOVW`009DSC$W_LENGTH(R7),`009ITEM_W_BUFFER_LEN(R6)
X`009MOVAL`009@PARAM_A_RETLENGTH(AP),`009ITEM_A_RETLENGTH(R6)
X`009BRB`009ITEMEND
XOUT_DVS:ADDL3`009#2, DSC$A_POINTER(R7),`009ITEM_A_BUFFER(R6)`009
X`009MOVW`009DSC$W_LENGTH(R7),`009ITEM_W_BUFFER_LEN(R6)
X`009MOVAW`009@DSC$A_POINTER(R7),`009ITEM_A_RETLENGTH(R6)
X;
XITEMEND:
X`009MOVW`009PARAM_W_ITEMCODE(AP),`009ITEM_W_CODE(R6)
X`009RET
X;
X`009.END
$ CALL UNPACK LIBITMLST.MAR;19 1446319600
$ create/nolog 'f'
X.TITLE lib_parse  -  file-spec parsing routine
X.IDENT /1-001/  ; File : LIBTEMPLA.MAR
X;*************************************************************************
X; FACILITY:`009LIB, General Utility Library
X;
X; ABSTRACT:`009Returns RMS expanded file-spec (or portions therof)
X;`009`009by using $PARSE system service.
X;
X; ENVIRONMENT:`009Runs at any access mode, AST reentrant.
X;
X; AUTHOR:`009Douglas Miller
X; CREATED:`00918-MAR-1985
X;.........................................................................
X; MODIFIED
X;
X;*************************************************************************
X;
X`009.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:`009.BLKB NAM$C_MAXRSS
X.ALIGN LONG
Xfab:`009$FAB  FOP=NAM, NAM=nam
X.ALIGN LONG
Xnam:`009$NAM  ESA=es, ESS=NAM$C_MAXRSS, NOP=SYNCHK ; parse for syntax only
X.ALIGN LONG
Xrlfnam:`009$NAM  NOP=SYNCHK
X;
X .PSECT _LIB_CODE PIC,USR,CON,REL,LCL,SHR,EXE,RD,NOWRT,LONG
X;
X .ENTRY lib_parse `094M<R2,R3,R4,R5,R6,R7,R8,R9,R10>
X;
X`009CMPL`009(AP), #_expanded
X`009BGEQ`00999$
X`009BRW`009invarg
X99$:
X;
Xfilespec:
X`009MOVL`0094*_filespec(AP), R0
X `009JSB`009G`094LIB$ANALYZE_SDESC_R2
X`009BLBS`009R0, 10$
X`009BRW`009error
X10$:`009MOVB`009R1, FAB+FAB$B_FNS
X`009MOVL`009R2, FAB+FAB$L_FNA
X;
Xdefault:
X`009CMPL`009(AP), #_default
X`009BLSS`00999$
X`009MOVL`0094*_default(AP), R0
X`009BEQL`00999$
X`009JSB`009G`094LIB$ANALYZE_SDESC_R2
X`009BLBS`009R0, 10$
X`009BRW`009error
X10$:`009MOVB`009R1, FAB+FAB$B_DNS
X`009MOVL`009R2, FAB+FAB$L_DNA
X99$:
X;
Xrelated:
X`009CMPL`009(AP), #_related
X`009BLSS`00999$
X`009MOVL`0094*_related(AP), R0
X`009BEQL`00999$
X`009JSB`009G`094LIB$ANALYZE_SDESC_R2
X`009BLBS`009R0, 10$
X`009BRW`009error
X10$:`009MOVB`009R1, RLFNAM+NAM$B_RSS
X`009MOVL`009R2, RLFNAM+NAM$L_RSA
X`009MOVAL`009rlfnam, nam+NAM$L_RLF
X99$:
X;
Xparse:
X`009$PARSE`009FAB=fab
X`009BLBS`009R0, 10$
X`009BRW`009error
X10$:`009MOVL`009R0, R10
X;
X;
Xfields:
X`009MOVL`009#_fields, R6`009; longword offset to next field code
X`009MOVAB`009es, R3
X;
X`009CMPL`009R6, (AP)
X`009BGTR`00910$
X`009MOVL`009(AP)`091R6`093, R0
X`009BNEQ`009loop
X10$:`009BRW`009full_expanded`009; no fields specified, so get everything
X;
Xloop:`009CASEB`009(R0), #nam__node, #nam__ver
X1$:`009.WORD`009node-1$, dev-1$, dir-1$, name-1$, type-1$, ver-1$
X`009BRW`009invarg
X;
Xnode:`009MOVZBW`009nam+NAM$B_NODE, R0
X`009MOVC3`009R0, @nam+NAM$L_NODE, (R3)
X`009BRB next
Xdev:`009MOVZBW`009nam+NAM$B_DEV, R0
X`009MOVC3`009R0, @nam+NAM$L_DEV, (R3)
X`009BRB next
Xdir:`009MOVZBW`009nam+NAM$B_DIR, R0
X`009MOVC3`009R0, @nam+NAM$L_DIR, (R3)
X`009BRB next
Xname:`009MOVZBW`009nam+NAM$B_NAME, R0
X`009MOVC3`009R0, @nam+NAM$L_NAME, (R3)
X`009BRB next
Xtype:`009MOVZBW`009nam+NAM$B_TYPE, R0
X`009MOVC3`009R0, @nam+NAM$L_TYPE, (R3)
X`009BRB next
Xver:`009MOVZBW`009nam+NAM$B_VER, R0
X`009MOVC3`009R0, @nam+NAM$L_VER, (R3)
X`009BRB next
X;
Xnext:`009AOBLEQ`009(AP), R6, 10$
X`009BRB`00999$
X10$:`009MOVL`009(AP)`091R6`093, R0
X`009BRW`009loop
X99$:
X;
X;
Xexpanded:
X`009SUBL3`009#es, R3, R9`009 ; length of expanded filespec
X`009BRB`009move_to_expanded ; some fields filled in
Xfull_expanded:
X`009MOVZBW`009nam+NAM$B_ESL, R9
X`009MOVC3`009R9, @nam+NAM$L_ESA, es
Xmove_to_expanded:
X`009MOVL`0094*_expanded(AP), R0
X`009BEQL`009invarg
X`009MOVW`009R9, R1
X`009MOVAB`009es, R2
X`009JSB`009G`094STR$COPY_R_R8
X;
Xexpanded_length:
X`009CMPL`009(AP), #_expanded_length
X`009BLSS`009ret
X`009MOVL`0094*_expanded_length(AP), R0
X`009BEQL`009ret
X`009MOVZBW`009nam+NAM$B_ESL, (R0)
X;
Xret:`009MOVL`009R10, R0
X`009RET
X;
Xinvarg:`009MOVL`009#LIB$_INVARG, R0
Xerror:`009RET
X;
X`009.END
$ CALL UNPACK LIBPARSE.MAR;43 167919095
$ create/nolog '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 `091`093.  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.`032
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
+-+-+-+-+-+-+-+-  END  OF PART 1 +-+-+-+-+-+-+-+-

