~VMS-TAR-11.32256ޫVMS-TAR-11.32256MBACKUP *.*./EXCL=(*.DIR;,[.*]) [.EDITED]VMS-TAR-11.32256/BLOCK=32256/SAVE/LOG TIHOR uA5.1 _ACF1::  _$1$DUA19: V5.0 ~ *[TAR]AAAREADME.1ST;1+,. / 4O d-Ws0123KPWO 56 Mo7o8jip9GHJVMS TAR version 1.1FSubmitted by: Tim Cook, Computer Services, Victoria College, Melbourne Australia.(Operating System: VAX/VMS V5.0 or higher!Source Language: Pascal, MACRO-32Memory Required: Not a lot."Keywords: TAR, tape, archive, UNIX Abstract:C VMS TAR is a utility that emulates the UNIX tar, or Tape ARchiveK utility, which is used to store a set of files in a single file, usually. on an offline medium, such as 9-track tape.J VMS TAR automatically performs conversion of files to and from the UNIXF file format, and converts between UNIX and VMS file protections and modification times./ A help source file is included with VMS TAR.--------------------- Installation:ITo compile VMS TAR, either run the MMS script to build the target TAR.EXEL($ MMS/DESC=TAR.MMS TAR.EXE), or execute BUILD_TAR.COM, which was created byMMS.To install VMS TAR:F 1. Move TAR.EXE to where you want to store it (or leave it with the sources).N 2. Define either SYS$TIME_ZONE or TAR_TIMEZONE to an appropriate value (see& the Caveats section in TAR.HLP).L 3. Edit TAR.CLD so that it points DCL to where you have put TAR.EXE, thenL add the TAR verb to your command table. You can either add it to your@ process command table (lost when you log out) by entering: $ SET COMMAND TAR.CLDF or you can add it to the system default table with the following6 commands (you have to be privileged to do this):= $ SET COMMAND TAR.CLD /TABLE=SYS$LIBRARY:DCLTABLES -2 /OUTPUT=SYS$COMMON:[SYSLIB]DCLTABLES0 $ INSTALL REPLACE SYS$LIBRARY:DCLTABLES--------------- Copyright:NVMS TAR is (c) Copyright 1989, 1990, Victoria College Computer Services, as itNwas written on their time, but as I don't see them making a quid on it, I havedecided on the following rules:KWhat you CAN NOT do with VMS TAR (in source or executable form, in whole or%part, or as part of another program): 1. Sell it to someone.9 2. Give it away free as part of a commercial package.! 3. Make any income out of it. 4. Pretend you wrote it. 5. Smoke it. 6. Re-write it in C.What you CAN do with VMS TAR: 1. Use it. 2. Recommend it.% 3. Re-distribute it at no charge.D 4. Re-distribute it with a charge for distribution, if you are a/ non-profit organisation (such as DECUS).K 5. Re-use it in part in any non-commercial software that has (at least)/ the same restrictions as VMS TAR itself.MIf you do re-distribute or re-use VMS TAR, you must include all its copyrightGnotices, and all files containing a copyright notice must point to thiscopyright information. ---------------------Miscellaneous:MI originally wrote VMS TAR out of need in early 1988. Since then I have seenOat least three versions of TAR for VMS (all released to the world before mine).LI thought my version was still worth the effort of maintaining and enhancingNbecause it has functionality and proper meshing with VMS and DCL. None of the,TARs I have seen have both these properties.LMost of the features of VMS TAR were added later though, so there has been aElot of opportunity for bugs to creep in. If you get any bugs you are*unsatisfied with, send details of them to: Tim Cook Computer Services Victoria College Burwood 3125 Australia or preferably timcc@viccol.edu.auA (UUCP heads can try {backbone}!uunet!viccol.edu.au!timcc)KI can't guarantee that they will be looked at promptly, but I am willing tofix the fixable.*[TAR]BUILD_TAR.COM;1+,./ 4-Ws0123KPWO56`io7@o8@kp9GHJ5$ IF F$SEARCH ("VAXCRTL.OPT") .NES. "" THEN GOTO C_ok$ CREATE VAXCRTL.OPTSYS$SHARE:VAXCRTL/SHARE$C_ok:-$ PASCAL /NOLIST/OBJECT=VCDEFS.OBJ VCDEFS.PAS'$ PASCAL /NOLIST/OBJECT=TAR.OBJ TAR.PAS'$ PASCAL /NOLIST/OBJECT=DSS.OBJ DSS.PAS3$ PASCAL /NOLIST/OBJECT=TAR_WRITE.OBJ TAR_WRITE.PAS7$ PASCAL /NOLIST/OBJECT=TAR_EXTRACT.OBJ TAR_EXTRACT.PAS1$ PASCAL /NOLIST/OBJECT=TAR_LIST.OBJ TAR_LIST.PAS.$ MESSAGE /NOLIST/OBJECT=TARMSG.OBJ TARMSG.MSG0$ MACRO /NOLIST/OBJECT=LIBIFERR.OBJ LIBIFERR.MAR2$ MACRO /NOLIST/OBJECT=LIBITMLST.OBJ LIBITMLST.MAR0$ MACRO /NOLIST/OBJECT=LIBPARSE.OBJ LIBPARSE.MAR$ LINK /TRACE/NOMAP/EXEC=TAR.EXE/NOTRACE tar.obj, tar_write.obj, tar_extract.obj, tar_list.obj, tarmsg.obj, vcdefs.obj, dss.obj, libiferr.obj, libitmlst.obj, libparse.obj, vaxcrtl.opt/OPT*[TAR]DSS.OBJ;1+,ϔ./ 4B-Ws0123KPWO56qnt7`ut8` u9GHJ ADYNAMIC_STRING_STORAGE01 5-Jul-1990 11:43 5-Jul-1990 11:43VAX Pascal V3.9-289 DYNAMIC_STRING_STORAGEPPݏPAS$NEW2PPԠP` мPՠмRݏPAS$NEW2PмRТRԢмRммRТ ^}ݏPAS$NEW2PPԠP` ЭP<`PP\\ MTH$JMAX0P\RS1PQ@QR\aЭPBaRTdݏPAS$NEW2PdTФTԤTTФR\SSS1_ ^м GET_ALLOCATED_BLOCKSDYNAMIC_STRING_STORAGEDYNAMIC_STRING_STORAGE 5-Jul-1990 11:43:05PAS$ENVIRONMENT_TIME  INITIALISE_STORAGEPAS$NEW2  X NEW_BLOCK PUT_STRING_IN_STORAGE MTH$JMAX0  RESET_STORAGE MTH$JMIN0 PAS$DISPOSE2 `REWIND_STORAGE END_OF_STORAGE <GET_STRING_FROM_STORAGE   WRITE_PTR   FREE_POINT  READ_PTR   READ_POINT\\\\ MTH$JMIN0P\RP`S PAS$DISPOSE2SRR\RRRbR PP`P Pՠ PPP<^}^\\P^\Qա QQQ\^P\QЭQa(naPЭQ\@ P QС  Q\A\P PQbP/QJGQuQQ QUQ 3QMQQ QQ!Q4Q Q8Q Q("Q Q QQQ%Q Q Q QQ Q dQ 6QW  BLOCKS_ALLOCATED  MAX_STRING_SIZE}$CODE$LOCAL B $CODE}$LOCALGET_ALLOCATED_BLOCKS  INITIALISE_STORAGELX NEW_BLOCKDPUT_STRING_IN_STORAGE0 RESET_STORAGE`REWIND_STORAGE0END_OF_STORAGE0GET_STRING_FROM_STORAGE*[TAR]DSS.PAS;1+,Ù./ 4O -Ws0123KPWO56o7 w*o8 wmp9GHJ[ENVIRONMENT ('DSS'),G CHECK(NONE)] { Any necessary checks are done explicitly }MODULE dynamic_string_storage ; { ABSTRACT:=! The routines contained herein implement a system of dynamic! sequential string storage.!#! GLOBAL routines contained herein:! ! put_string_in_storage (string)E! Appends a string to the end of storage, automatically allocating&! a new storage block if necessary.!"! get_string_from_storage (string)B! Reads the next string in storage. If there are no strings in?! storage, or the read point is past the end of storage, theI! end_of_storage routine will return TRUE. If get_string_from_storageI! is called before rewind_storage, the read pointer will be set to the! beginnning of storage.!! status = end_of_storageB! Returns a boolean indicating if last string has been read (or! no strings to read.!! number = get_allocated_blocks4! Returns the number of storage blocks allocated.! ! reset_storage (blocks_to_free)G! Resets the write point to the beginning of the storage, optionally:! deallocating a specified number of storage blocks. IfC! blocks_to_free is not specified, or is specified as a negative)! integer, all storage is deallocated.!! rewind_storage7! Resets the read point to the beginning of storage.L!___________________________________________________________________________ ! AUTHOR:! Tim Cook, 19-MAY-1989L!___________________________________________________________________________} CONSTC pointer_size = 4 ; { A fairly safe assumption }O string_delimiter = chr (0) ; { designed for use with UNIX filespecs }0 block_size = 512 * 64 - 2 * pointer_size ;I { Sized so that, if the heap is page-aligned, all storage blocks will be too } TYPE! storage_block_type = RECORD% back : ^storage_block_type ;( forward : ^storage_block_type ;: data : PACKED ARRAY [1..block_size] OF char END ;3 storage_block_pointer = ^storage_block_type ; VAR0 write_ptr : storage_block_pointer := nil ;E free_point : integer := 0 ; { First free character in block }/ read_ptr : storage_block_pointer := nil ; read_point : integer ;' blocks_allocated : integer := 0 ;& max_string_size : integer := 0 ;5 [GLOBAL] FUNCTION get_allocated_blocks : integer ; BEGIN7 get_allocated_blocks := blocks_allocated END ;! PROCEDURE initialise_storage ; BEGIN new (write_ptr) ;$ write_ptr^.forward := nil ;! write_ptr^.back := nil ; read_ptr := write_ptr ; blocks_allocated := 1 ; free_point := 1 ; read_point := 1 END ;A PROCEDURE new_block ( { Find or allocate a new storage block }. VAR block_ptr : storage_block_pointer) ; BEGIN/ IF block_ptr^.forward = nil THEN BEGIN& new (block_ptr^.forward) ;0 block_ptr^.forward^.forward := nil ;3 block_ptr^.forward^.back := block_ptr ;: blocks_allocated := blocks_allocated + 1 END ;. block_ptr := block_ptr^.forward END ;- [GLOBAL] PROCEDURE put_string_in_storage () VAR string : VARYING [n] OF char) ; VAR more : boolean ;0 string_length, string_index : integer ; BEGIN% IF blocks_allocated = 0 THEN initialise_storage ;+ string_length := length (string) ;B max_string_size := max (max_string_size, string_length) ;- string_length := string_length + 1 ; string_index := 1 ; more := true ; WHILE more DO BEGIN0 IF string_index = string_length THEN> write_ptr^.data[free_point] := string_delimiter ELSED write_ptr^.data[free_point] := string[string_index] ;* free_point := free_point + 1 ;. string_index := string_index + 1 ;1 IF free_point > block_size THEN BEGIN& new_block (write_ptr) ;$ free_point := 1 END ;7 more := string_index <= string_length END ; END ;% [GLOBAL] PROCEDURE reset_storage (' blocks_to_free : integer := -1) ; VAR! blocks_freed : integer ;+ temp_ptr : storage_block_pointer ; BEGIN# IF blocks_to_free < 0 THEN. blocks_to_free := blocks_allocated ELSEF blocks_to_free := min (blocks_to_free, blocks_allocated) ; blocks_freed := 0 ;5 WHILE blocks_freed < blocks_to_free DO BEGINK { I could check to see if write_ptr^.back is nil, but I won't because it shouldn't be }) temp_ptr := write_ptr^.back ;! dispose (write_ptr) ;# write_ptr := temp_ptr ;2 blocks_freed := blocks_freed + 1 END ;> blocks_allocated := blocks_allocated - blocks_freed ;! IF write_ptr <> nil THEN+ WHILE write_ptr^.back <> nil DO- write_ptr := write_ptr^.back ; read_ptr := nil ; read_point := 0 ; free_point := 0 ; END ;& [GLOBAL] PROCEDURE rewind_storage ; BEGIN read_ptr := write_ptr ;& IF read_ptr <> nil THEN BEGIN* WHILE read_ptr^.back <> nil DO+ read_ptr := read_ptr^.back ;! read_point := 1 END ; END ;N [GLOBAL] FUNCTION end_of_storage { Indicates if last string has been read } : boolean ; BEGIN IF read_ptr <> nil THEN; end_of_storage := (read_ptr^.forward = nil) AND) (read_point >= free_point) ELSE( end_of_storage := true END ;/ [GLOBAL] PROCEDURE get_string_from_storage () VAR string : VARYING [n] OF char) ; VAR! string_index : integer ; BEGIN, IF end_of_storage THEN string := '' ELSE BEGIN string_index := 1 ;2 string.length := max_string_size + 1 ;I WHILE read_ptr^.data[read_point] <> string_delimiter DO BEGINC string[string_index] := read_ptr^.data[read_point] ;- read_point := read_point + 1 ;1 string_index := string_index + 1 ;4 IF read_point > block_size THEN BEGINB { Could check if read_ptr^.forward is nil here, but it( shouldn't be, so I won't }1 read_ptr := read_ptr^.forward ;' read_point := 1 END ; END ;/ string.length := string_index - 1 ;* read_point := read_point + 1 ; END ; END ; END.*[TAR]DSS.PEN;1+,9./ 4-Ws0123KPWO56`tt7`-ut8`u9GHJ v8 KbH 5-Jul-1990 11:43:0501DYNAMIC_STRING_STORAGEVAX Pascal V3.9-289 POINTER_SIZE STRING_DELIMITER! BLOCK_SIZE "STORAGE_BLOCK_TYPE * STORAGE_BLOCK_POINTER*  WRITE_PTR  FREE_POINT*  READ_PTR  READ_POINT  BLOCKS_ALLOCATED  MAX_STRING_SIZE +GET_ALLOCATED_BLOCKSINITIALISE_STORAGE, NEW_BLOCK- PUT_STRING_IN_STORAGE2  RESET_STORAGE REWIND_STORAGE 4END_OF_STORAGE5 GET_STRING_FROM_STORAGE  $#$$ "%BACK  "$& "'FORWARD  "$(@"DATA )   "  GET_ALLOCATED_BLOCKS $*  BLOCK_PTR $.% STRING/0 $1  $ 3BLOCKS_TO_FREE  END_OF_STORAGE $6% STRING/7$8  D` &Fj:X~<h>l N \ *[TAR]EDITED.DIR;1+,./ 4-Ws0123 KPWO56@As7fis8fNt9GHJITAR.CLDlDVMS-TAR-11.32256,!W+52&ޓ}*[TAR]LIBIFERR.MAR;6+,ș./ 4D-Ws0123KPWO56`o7o8یop9GHJ .TITLE lib_iferr1 .IDENT /1-001/ ; File : SRC$UMLIB:LIBIFERR.MAR ; Edit : DGM1001;++#; FACILITY: General Utility Library; ; ABSTRACT:;;; This module contains routines for signalling or unwinding.; If a provided condition code is not success.;6; ENVIRONMENT: Runs at any access mode, AST reentrant;:; AUTHOR: Douglas G. Miller, CREATION DATE: 03-Jun-1984;; MODIFIED BY:;%; 1-001 - Original. DGM 03-Jun-1984>; 1-002 - Add provision for extra messages. DGM 27-Sep-1984=; 1-003 - Add function return of parameter. DGM 1-Oct-1984;--;D .PSECT _LIB_CODE PIC, USR, CON, REL, LCL, SHR, EXE, RD, NOWRT, LONGdepth: .LONG 2;* .ENTRY lib_retiferr ^M# MOVAL LIB___RETIFERR_HANDLER, (FP) BRB lib_sigiferr+2;* .ENTRY lib_sigiferr ^M+ MOVQ (AP), R6 ; R6 is number of arguments BLBS R7, RET ; R7 is status MULL3 #4, R6, R1 SUBL2 #4, R1 PUSHL R7 SUBL2 R1, SP MOVC3 R1, 8(AP), (SP) CALLS R6, G^LIB$SIGNALRET: MOVL R7, R0 RET;"lib___retiferr_handler: .WORD ^M<> MOVL 8(AP), R1 ; MECHARGS MOVL R7, 12(R1) $UNWIND_S depth, RET; .END*[TAR]LIBIFERR.OBJ;2+,Zy./ 4T-Ws0123KPWO56~t7һt8c_u9GHJ7 LIB_IFERR1-001 5-JUL-1990 11:45 VAX MACRO V5.0-8/MACRO/NOLIST/OBJECT=LIBIFERR.OBJ LIBIFERR.MAR  LIB_IFERR LIB$SIGNAL SYS$UNWIND . ABS .PJ _LIB_CODE P  LIB_RETIFERR&3m3  LIB_SIGIFERR&M}lVWVQQWQ^(QnV LIB$SIGNALWPЬQW ߯ SYS$UNWINDT LIB_RETIFERR LIB_SIGIFERR3LIB___RETIFERR_HANDLER _LIB_CODEJ*[TAR]LIBITMLST.MAR;20+,ʙ./ 4]-Ws0123KPWO56([o7o8rp9GHJ  .TITLE lib_item_list;; Doug Miller, April 1984;E; Turn the argument list into an item list for $GETDVI, $GETJPI, etc.; $DSCDEF $SFDEF $SSDEF;ITEM_W_BUFFER_LEN = 0ITEM_W_CODE = 2ITEM_A_BUFFER = 4ITEM_A_RETLENGTH = 8ITEM_B_BUFFER = 12PARAM_W_ITEMCODE = 8PARAM_A_BUFFER_DX = 12PARAM_A_RETLENGTH = 16;. .PSECT ITEM_LIST, CON, NOEXE, NOSHR, PIC, RELITEMLIST: .BLKL 256ITEM : .BLKL 3;. .PSECT LIB_ITEM_LIST, CON, EXE, SHR, PIC, REL+ .ENTRY lib_item_list ^M;0 ADDL3 #4, AP, R5 ; Create argument list pointer/ MOVAL @(R5)+, R6 ; Create current item address SUBL3 #1, (AP), R2;2LOOP: MOVL (R5)+, R0 ; move current argument to R05 MOVL (R0)+, (R6)+ ; move buffer_length and item_code= MOVQ (R0), (R6)+ ; move buffer_address and retlength_address' SOBGTR R2, LOOP ; Count down the items;! CLRL (R6) ; Terminate item list RET;) .ENTRY lib_in_item ^M;1 MOVAL @4(AP), R6 ; Create current item addressA CLRQ ITEM_A_BUFFER(R6) ; clear buffer and retlength addresses! MOVAL @PARAM_A_BUFFER_DX(AP), R7 BEQL ITEMEND+ MOVAL ITEM_B_BUFFER(R6), ITEM_A_BUFFER(R6)& CMPB DSC$B_CLASS(R7), #DSC$K_CLASS_VS BEQL IN_DVS3IN_DX: MOVW DSC$W_LENGTH(R7), ITEM_W_BUFFER_LEN(R6)P MOVC5 ITEM_W_BUFFER_LEN(R6), @DSC$A_POINTER(R7), #^A' ', #80, ITEM_B_BUFFER(R6) BRB ITEMEND]IN_DVS: MOVW @DSC$A_POINTER(R7), ITEM_W_BUFFER_LEN(R6) ; use current length of varying string ADDL3 #2, DSC$A_POINTER(R7), R1B MOVC5 ITEM_W_BUFFER_LEN(R6), (R1), #^A' ', #80, ITEM_B_BUFFER(R6) BRB ITEMEND;* .ENTRY lib_out_item ^M1 MOVAL @4(AP), R6 ; Create current item address! MOVAL @PARAM_A_BUFFER_DX(AP), R7& CMPB DSC$B_CLASS(R7), #DSC$K_CLASS_VS BEQL OUT_DVS2OUT_DX: MOVL DSC$A_POINTER(R7), ITEM_A_BUFFER(R6) - MOVW DSC$W_LENGTH(R7), ITEM_W_BUFFER_LEN(R6)3 MOVAL @PARAM_A_RETLENGTH(AP), ITEM_A_RETLENGTH(R6) BRB ITEMEND7OUT_DVS:ADDL3 #2, DSC$A_POINTER(R7), ITEM_A_BUFFER(R6) - MOVW DSC$W_LENGTH(R7), ITEM_W_BUFFER_LEN(R6)/ MOVAW @DSC$A_POINTER(R7), ITEM_A_RETLENGTH(R6);ITEMEND:+ MOVW PARAM_W_ITEMCODE(AP), ITEM_W_CODE(R6) RET; .END*[TAR]LIBITMLST.OBJ;2+,_|./ 4J-Ws0123KPWO567Vt7.t8cu9GHJ7 LIB_ITEM_LIST0 5-JUL-1990 11:45 VAX MACRO V5.0-81MACRO/NOLIST/OBJECT=LIBITMLST.OBJ LIBITMLST.MAR  LIB_ITEM_LIST . ABS .P$ABS$ PPP  ITEM_LISTPQQ  LIB_ITEM_LISTP  LIB_ITEM_LIST&\UޕVlRЅPЀ}`Rf  LIB_IN_ITEM&?޼V|޼ W[ަ  gf,f P AfQ,fa P - Y LIB_OUT_ITEM&3޼V޼ W Чgf޼gf>J LIB_IN_ITEM LIB_ITEM_LISTY LIB_OUT_ITEM4 ITEM_LIST  LIB_ITEM_LIST*[TAR]LIBPARSE.MAR;43+,ܙ. / 4J -Ws0123KPWO56o7o8tp9GHJ..TITLE lib_parse - file-spec parsing routine&.IDENT /1-001/ ; File : LIBTEMPLA.MARJ;*************************************************************************(; FACILITY: LIB, General Utility Library;?; ABSTRACT: Returns RMS expanded file-spec (or portions therof)"; by using $PARSE system service.;6; ENVIRONMENT: Runs at any access mode, AST reentrant.;; AUTHOR: Douglas Miller; CREATED: 18-MAR-1985J;......................................................................... ; MODIFIED;J;*************************************************************************;F .PSECT _LIB_DATA PIC, USR, CON, REL, LCL, NOSHR, NOEXE, RD, WRT, LONG; $NAMDEF; nam__node = 0 ; nam__dev = 1 ; nam__dir = 2 ; nam__name = 3 ; nam__type = 4 ; nam__ver = 5 ;; min_params = 2; _filespec= 1 _expanded = 2 _default = 3 _related = 4 _expanded_length = 5 _fields = 6;es: .BLKB NAM$C_MAXRSS .ALIGN LONGfab: $FAB FOP=NAM, NAM=nam .ALIGN LONGGnam: $NAM ESA=es, ESS=NAM$C_MAXRSS, NOP=SYNCHK ; parse for syntax only .ALIGN LONGrlfnam: $NAM NOP=SYNCHK;; .PSECT _LIB_CODE PIC,USR,CON,REL,LCL,SHR,EXE,RD,NOWRT,LONG;1 .ENTRY lib_parse ^M; CMPL (AP), #_expanded BGEQ 99$ BRW invarg99$:; filespec: MOVL 4*_filespec(AP), R0 JSB G^LIB$ANALYZE_SDESC_R2 BLBS R0, 10$ BRW error10$: MOVB R1, FAB+FAB$B_FNS MOVL R2, FAB+FAB$L_FNA;default: CMPL (AP), #_default BLSS 99$ MOVL 4*_default(AP), R0 BEQL 99$ JSB G^LIB$ANALYZE_SDESC_R2 BLBS R0, 10$ BRW error10$: MOVB R1, FAB+FAB$B_DNS MOVL R2, FAB+FAB$L_DNA99$:;related: CMPL (AP), #_related BLSS 99$ MOVL 4*_related(AP), R0 BEQL 99$ JSB G^LIB$ANALYZE_SDESC_R2 BLBS R0, 10$ BRW error10$: MOVB R1, RLFNAM+NAM$B_RSS MOVL R2, RLFNAM+NAM$L_RSA MOVAL rlfnam, nam+NAM$L_RLF99$:;parse: $PARSE FAB=fab BLBS R0, 10$ BRW error10$: MOVL R0, R10;;fields:7 MOVL #_fields, R6 ; longword offset to next field code MOVAB es, R3; CMPL R6, (AP) BGTR 10$ MOVL (AP)[R6], R0 BNEQ loop?10$: BRW full_expanded ; no fields specified, so get everything;'loop: CASEB (R0), #nam__node, #nam__ver;1$: .WORD node-1$, dev-1$, dir-1$, name-1$, type-1$, ver-1$ BRW invarg;node: MOVZBW nam+NAM$B_NODE, R0 MOVC3 R0, @nam+NAM$L_NODE, (R3) BRB nextdev: MOVZBW nam+NAM$B_DEV, R0 MOVC3 R0, @nam+NAM$L_DEV, (R3) BRB nextdir: MOVZBW nam+NAM$B_DIR, R0 MOVC3 R0, @nam+NAM$L_DIR, (R3) BRB nextname: MOVZBW nam+NAM$B_NAME, R0 MOVC3 R0, @nam+NAM$L_NAME, (R3) BRB nexttype: MOVZBW nam+NAM$B_TYPE, R0 MOVC3 R0, @nam+NAM$L_TYPE, (R3) BRB nextver: MOVZBW nam+NAM$B_VER, R0 MOVC3 R0, @nam+NAM$L_VER, (R3) BRB next;next: AOBLEQ (AP), R6, 10$ BRB 99$10$: MOVL (AP)[R6], R0 BRW loop99$:;; expanded:1 SUBL3 #es, R3, R9 ; length of expanded filespec- BRB move_to_expanded ; some fields filled infull_expanded: MOVZBW nam+NAM$B_ESL, R9 MOVC3 R9, @nam+NAM$L_ESA, esmove_to_expanded: MOVL 4*_expanded(AP), R0 BEQL invarg MOVW R9, R1 MOVAB es, R2 JSB G^STR$COPY_R_R8;expanded_length: CMPL (AP), #_expanded_length BLSS ret MOVL 4*_expanded_length(AP), R0 BEQL ret MOVZBW nam+NAM$B_ESL, (R0);ret: MOVL R10, R0 RET;invarg: MOVL #LIB$_INVARG, R0 error: RET; .END*[TAR]LIBPARSE.OBJ;2+,R./ 4V-Ws0123KPWO56 ^t7G`t8Ggu9GHJ<~9~VMS-TAR-11.32256RWs[TAR]LIBPARSE.OBJ;27 LIB_PARSE1-001 5-JUL-1990 11:45 VAX MACRO V5.0-8/MACRO/NOLIST/OBJECT=LIBPARSE.OBJ LIBPARSE.MAR- file-spec parsing routine LIB_PARSEJLIB$ANALYZE_SDESC_R2 LIB$_INVARG STR$COPY_R_R8 SYS$PARSE . ABS .P _LIB_DATAP$ABS$PQQPPQNQQPQQ`Q^QQQQQQL`Q^QQQQQQL _LIB_CODEP  LIB_PARSE&l1pЬPLIB$ANALYZE_SDESC_R2P1gQ43R,3l Ь PLIB$ANALYZE_SDESC_R2P1BQ53R03l+ЬP%LIB$ANALYZE_SDESC_R2P1Q3R3P3 SYS$PARSEP1PZVSVlFlP1`4&4&4&4&4&4&1P83P(PP@3cUP93P(PPD3cDP:3P(PPH3c3P;3P(PPL3c"P<3P(PPP3cP=3P(PPT3clVFlP1zSYP 3Y(YP 3ЬP&YQR STR$COPY_R_R8l ЬPP 3`ZP LIB$_INVARGP LIB_PARSE0 _LIB_DATA _LIB_CODE*[TAR]NEW-FEATURES-TAR-1.1;1+,ݙ./ 4HZ-Ws0123KPWO56`yo70o80:wp9GHJ @Description of new features and bug fixes in VMS TAR version 1.11. File specification lists< The second parameter to TAR, the file-spec, may now be a comma-separated list.:2. Handling of Bourne shell wildcards on EXTRACT and LISTC When EXTRACTing or LISTing files, TAR will interpret the Bourne= shell wildcards * and ?, and ranges enclosed in []. ThisF interpretation can be turned off by use of the positional /LITERAL qualifier.7 This was implemented using the undocumented routineE SHELL$MATCH_WILD, found in SYS$LIBRARY:VAXCRTL, and known to be aG part of DEC/Shell, which is advertised as a "Version 7 Bourne shellG for VMS". Some extra checking was added inside TAR so that * and ?H would not match the directory separator /. All Bourne shells I haveF seen act this way, not the way dictated by SHELL$MATCH_WILD. Note8 that there are a few other incompatibilities between, SHELL$MATCH_WILD and real Bourne shells.%3. Automatic creation of directories@ TAR now automatically creates any necessary directories whenH EXTRACTing. Previously, if the directory was not in the archive, it was not created.H TAR now also adds necessary directories into an archive when WRITing or APPENDing.-4. The /OUTPUT qualifier has become rationalG The /OUTPUT qualifier is now available only with the LIST keyword. F It was never properly implemented on the other keywords, so it has been disallowed with them.=5. Modify time-handling to allow TAR to compile under VMS V4E TAR's time-conversion routines now do a G_FLOAT divide instead ofG calling LIB$CVT_FROM_INTERNAL_TIME, a routine found only in VMS V5.= This means that TAR should now work under VMS V4 as well.36. Add capability to /APPEND to an archive on tapeB Another item that was not tested in v1.0. TAR will now APPEND7 correctly to an archive on a tape MOUNTed /FOREIGN.<7. Correct behaviour when Ctrl-Z typed at a /CONFIRM promptH TAR used to just abort when given a Ctrl-Z at a /CONFIRM prompt, now- it cleans up and reports before aborting. 8. Bug fixesA Two or three bugs remaining in version 1.0-1 have been fixed,D including a bug when TAR attempts to WRITE an archive containing. more that 100 files with /MAP_MODE=PREFIX.*[TAR]NEWTAR.DIR;1+,Xs./ 4-Ws0123 KPWO569$768Lȸ9hҐGHJIVMS-TAR-11.PATCH-1R`*[TAR]OLDTAR.DIR;1+,./ 4-Ws0123 KPWO56oo7oo8@p9GHJI*[TAR]TAR.CLD;1+,./ 4K^-Ws0123KPWO56 o7` 2o8` zp9GHJ "! TAR.CLD - Definition of TAR verb!E! Copyright: Copyright 1989,1990, Victoria College Computer Services.7! All rights reserved except those granted in the file6! AAAREADME.1ST, which is distributed with this file.!(! Author: Tim Cook (timcc@viccol.edu.au)DEFINE TYPE map_mode_keyword KEYWORD prefix, DEFAULT KEYWORD absolute KEYWORD rootDEFINE SYNTAX tar_extract/ PARAMETER p1, LABEL=option, VALUE (REQUIRED)? PARAMETER p2, LABEL=filespec, PROMPT="File(s)", VALUE (LIST)* QUALIFIER literal, PLACEMENT=POSITIONAL QUALIFIER confirm@ QUALIFIER archive, NONNEGATABLE, VALUE (TYPE=$FILE, REQUIRED)DEFINE SYNTAX tar_write/ PARAMETER p1, LABEL=option, VALUE (REQUIRED)K PARAMETER p2, LABEL=filespec, PROMPT="File(s)", VALUE (LIST, TYPE=$FILE, DEFAULT="*.*") QUALIFIER confirm QUALIFIER scan QUALIFIER version= QUALIFIER map_mode, DEFAULT, VALUE (TYPE=map_mode_keyword, DEFAULT="PREFIX")@ QUALIFIER archive, NONNEGATABLE, VALUE (TYPE=$FILE, REQUIRED)DEFINE SYNTAX tar_append/ PARAMETER p1, LABEL=option, VALUE (REQUIRED)K PARAMETER p2, LABEL=filespec, PROMPT="File(s)", VALUE (LIST, TYPE=$FILE, DEFAULT="*.*") QUALIFIER confirm QUALIFIER scan QUALIFIER version= QUALIFIER map_mode, DEFAULT, VALUE (TYPE=map_mode_keyword, DEFAULT="PREFIX")@ QUALIFIER archive, NONNEGATABLE, VALUE (TYPE=$FILE, REQUIRED)DEFINE SYNTAX tar_list/ PARAMETER p1, LABEL=option, VALUE (REQUIRED)? PARAMETER p2, LABEL=filespec, PROMPT="File(s)", VALUE (LIST)* QUALIFIER literal, PLACEMENT=POSITIONAL QUALIFIER fullK QUALIFIER output, NONNEGATABLE, VALUE (TYPE=$FILE, DEFAULT="SYS$OUTPUT")@ QUALIFIER archive, NONNEGATABLE, VALUE (TYPE=$FILE, REQUIRED)DEFINE TYPE tar_options& KEYWORD extract, SYNTAX=tar_extract# KEYWORD write, SYNTAX=tar_write% KEYWORD append, SYNTAX=tar_append! KEYWORD list, SYNTAX=tar_listDEFINE VERB tar3 IMAGE "CS_SYSTEM:TAR" ! This should be modified/ PARAMETER p1, LABEL=option, PROMPT="Option",( VALUE (REQUIRED, TYPE=tar_options)*[TAR]TAR.EXE;1+,͛p.E/ 4EE-Ws0123 KPWOF56/t7A t8Aqu9GHJX0DX0205(t~TART1.1-2 t05-02  * /.]>^?b C ? ! VAXCRTL_001B!d FORRTL_001! LIBRTL_001! MTHRTL_001!f SMGSHR_001+g PASRTL_001\ \ 644 0 0 0 4241462038 0 @Kg|JanFebMarAprMayJunJulAugSepOctNovDecPZ`Y`bARCHIVEb ARCHIVE_TEMPTAR_TIMEZONELNM$FILE_DEVSYS$TIME_ZONE!2SL !AS !SL !2ZL:!2ZL? (Y/N) [Y]: ./[][.:[000000.000000.TARSYS$SCRATCH:HEADER.TARdddFILESPECLITERALMAP_MODEARCHIVETAR_ARCHIVEOPTIONCONFIRMVERSIONSCANOUTPUTTAR.LISFULL|^ԭem}м VЭP` `(`PYYP1YBЬP<`QQZZ^^[(ZnZ[잟i==ت(nҪ1WX1W﹪[Ы Y<ﭪPPZZ^^V(ZnZܰVܭ잟if=+P1(PPʂ11|X1KWP$^^REP>1D9;uDCCX,R﯄J,XăPVV(P1 ￃ΃ TP}܃D Z DŽPVՄЄPP1z彩o T< iЬP<`QQWWR^^X(WnWܰXܭ잟i; D 9VP^\ <PPP P P P P\P@PP PΘ^ԭ`;mЬP` `͜(`͞мVW}XмY Z$^[( Z蟭X䟭-P蟭 :(୮Ь P , dV䟭 : VVV[^^X( n( cV2 V(VhЬ P  , |

<͜Z9Z͞ RRRZRRZZ͜<͜Z<͜P͝W ZPWW /gW<͜PWP2WWZ ZdYЬ [<͜X͝V ZXVV fIWPЬ P(hЬ P Ь P ݬ P 928Ь P , Ь \̚|^ԭ8mPP#  < P P PЬQ @R< SRS]RT{ݬf8{{ {PмQ- .!\쟭]]Qύ\U"Pf]P`U1R]F]  B1*]PPPP1T\1i~]^ԭmQVQЬP` `(`м мWм\^Xխ1\P1J11֦м\\\\P<(^( ­^Э\ЭQ^S\(ac\(\ací^\\^^\\R^\ЭܰذڟPP\^R\м\\\\\PPݏaPʣģPԠﺣP`ﱣﴣﵣмPՠ/мRݏPмRТRԢмRмjмRТ ^}PGݏP*$PԠP`ЭP<`PP\\P\RS1¢P﷢Q@QR\a ЭPBaRUTd3ݏPdhTФTԤZTS[ETФ<9R\SSS1_ ^м\\ \\8P\R!P`SܡaSΡRR\RСﺡ Rﭡ李RbR PysP`Pj\"TPՠL?PPP<^}^\\P^\%Qա Q QQ\^P\Q ЭQa(nadPޠ6ЭQ\@P﹠蘒QСQ\A\P|<`^,n䐏PWKݬ5^|VX^,n䐏Q ݬf^PRݬl$լ ݬf  RP|VD^,nȐSȞ؞ܕlլݬfЬ̑lլ  lլ,n䞭l լ Ь l լЬlլ ݬf^<`^,n䐏T l լЬ^<`^,n䐏U ݬ~ ^'m}lVWVQQWQ^(QnVa WPЬQW ߯pl1pЬP P1gQ[RLl Ь P P1BQ7R+l+ЬP% P1QR+Ţ0P1PZVﬡSVlFlP1` 1BSd1 P(P cUP(PcDP(Pc3ܢP(Pc"̢P(PآcＢP(PˢclVFlP1zÏYSYbY(Y[ЬP&YQR l ЬP.`ZPЏ4P\UޕVlRЅPЀ}`Rf޼V|޼ W[ަ  gf,f P AfQ,fa P -޼V޼ W Чgf޼gf>e<(4{ii.iXi i(i0i8iH@ixiii&iliii*iZiii i&(iH0in8i@iHi.CREATEDcreated !AS (!SL record!%S)* CREATEDIRcreated directory !AS,WRITTENwritten !AS (!SL byte!%S)(WRITDIRwritten directory !AS.APPENDEDappended !AS (!SL byte!%S)*APPENDIRappended directory !ASDTOTCREAT1total of !SL file!%S created, !SL file!%S scanned0TOTWRITEtotal of !SL file!%S written2 TOTAPPENDtotal of !SL file!%S appended6EMPTY&file !AS empty, no output file createdFHARDLINK2file !AS empty (hard link), no output file createdFSOFTLINK2file !AS empty (soft link), no output file created,NOFILESno files selected from !ASPWRAPPED=records in file !AS longer than !UL byte!%S have been wrappedB RECTOOLONG-record size of !UL too large for input buffer0 ERRCREDIRerror creating directory !ASL BADHEADER8bad header record, dumped in file SYS$SCRATCH:HEADER.TAR2 BADARCHIVE!AS is not a TAR archive file"PARSEerror parsing !AS,OPENINerror opening !AS for input"CLOSEerror closing !AS&CREATERRerror creating !AS(ERRREADerror reading !+!+!AS$ERRWRITEerror writing !AS0 INVTIMZONinvalid timezone value "!AS"J INTERNERR6internal error, code !8XL, notify System AdministratoriTAR@@ $`HP(   x 8`X@x  @VAXCRTLFORRTLLIBRTLMTHRTLSMGSHRPASRTL*[TAR]TAR.HLP;1+,4.!/ 4L!-Ws0123KPWO 563o7so8sNp9GHJ>*! TAR.HLP - Description of the TAR command!E! Copyright: Copyright 1989,1990, Victoria College Computer Services.7! All rights reserved except those granted in the file6! AAAREADME.1ST, which is distributed with this file.!(! Author: Tim Cook (timcc@viccol.edu.au)!1 TARIVMS TAR is a utility that emulates the UNIX tar, or Tape ARchive utility,Ewhich is used to store a set of files in a single file, usually on an%offline medium, such as 9-track tape.GVMS TAR automatically performs conversion of files to and from the UNIXCfile format, and converts between UNIX and VMS file protections andmodification times.Format:! TAR keyword [file-spec[,...]]! 2 ParameterskeywordI One of the keywords APPEND, EXTRACT, LIST or WRITE. Each keyword has a5 different function. See the help for each keyword. file-specG The specification of any file(s) to be APPENDed, EXTRACTed, LISTed or WRITten.A On an APPEND or WRITE operation, this is a wildcarded VMS file- specification.I On an EXTRACT or LIST operation, the file-spec parameter is interpretedH as a UNIX Bourne shell would interpret it, as per the following rules:= * Matches any any string (including a null string) that does not contain '/'., ? Matches any single character, except '/'.+ [ab0-9] Matches any one of 'ab0123456789'.A If you want TAR to interpret the characters *, ? or [ as normalD characters, use the /LITERAL qualifier on the particular file-spec parameter.K If you do not specify a file-spec parameter, TAR will WRITE or APPEND allI files in the current directory, or it will EXTRACT or LIST all files in the nominated archive.! 2 ExamplesGFor all TAR operations direct to or from tape, the tape must be MOUNTed$as in the following EXTRACT example: $ ALLOCATE MF,MS,MT tar_archive" %DCL-I-ALLOC, _$1$MSA0: allocated@ $ MOUNT /FOREIGN /RECORD_SIZE=512 /BLOCK_SIZE=10240 tar_archive( %MOUNT-I-MOUNTED, mounted on _$1$MSA0:$ $ TAR EXTRACT "*.c", "*.h" /CONFIRM Extract alloc.c ? (Y/N) [Y]: n% Extract main.c ? (Y/N) [Y]: ; %TAR-S-CREATED, created DISK:[USER]MAIN.C;1 (2573 records)% Extract misc.c ? (Y/N) [Y]: : %TAR-S-CREATED, created DISK:[USER]MISC.C;1 (523 records) Extract misc.h ? (Y/N) [Y]: Yes9 %TAR-S-CREATED, created DISK:[USER]MISC.H;1 (28 records)8 %TAR-S-TOTAL, total of 3 files created, 4 files scanned $ DISMOUNT tar_archive $ DEALLOCATE tar_archiveHIf you wanted to create an archive that would later be copied to a tape,1the following sequence of commands might be used:( $ TAR WRITE *.pas /ARCHIVE=PASCAL.TAR and later: $ ALLOCATE MSA0:" %DCL-I-ALLOC, _$1$MSA0: allocated: $ MOUNT /FOREIGN /RECORD_SIZE=512 /BLOCK_SIZE=10240 MSA0:. %MOUNT-I-MOUNTED, BLANK1 mounted on _$1$MSA0: $ COPY/LOG PASCAL.TAR MSA0:> %COPY-S-COPIED, CS:[STAFF.FRED]PASCAL.TAR copied to _$1$MSA0: (315 records). $ (dismount and deallocate)KThe /BLOCK_SIZE qualifier is important for mounting TAR tapes. UNIX uses aHdefault blocking factor of 20, which makes the block size 10240. A UNIXEtar archive might have been created with a different blocking factor,Hthough. This may be discovered by mounting such an archive tape withoutIa /BLOCK_SIZE qualifier and DUMPing the tape drive (DUMP will demonstratethe block size).KIf you are going to use a tape that has previously been used for an unusualCformat (like VMS BACKUP), you should initialize the tape, using theINITIALIZE command: $ ALLOCATE MF,MS,MT TAR_ARCHIVE$ %DCL-I-ALLOC, _$1$MSA0: allocated $ INIT TAR_ARCHIVE FREDDO!2 Supported_FilesFiles readable by TAR include:7 Record format Carriage control7 ------------- ----------------6 variable-length carriage-return2 stream-lf1 variable-fixed-control (VFC) print-file+ fixed-length noneBVariable-length VMS files are written to an archive with linefeedsG('newline's or '\n' to UNIX) as record terminators, which is consistentGwith the UNIX text file format, whereas fixed-length VMS files are not.GExtraction of files that used to be fixed-length is extremely difficultH(see Caveats), as they are indistinguishable from text files when storedFin tar format. A feature may be added to VMS TAR in future to counterthis.COther file types may be supported, but a file with FORTRAN carriageGcontrol for example, may be transmitted in a useless format. Note thatHany file EXTRACTed by tar will always be recreated with the VMS standardJtext file attributes; variable-length records and carriage-return carriagecontrol.! 2 Caveats TAR_TIMEZONEH To assist in the conversion of file modification times, TAR uses timeI zone information. TAR gets the local time zone from the logical namesI SYS$TIME_ZONE or TAR_TIMEZONE (the latter is used if the former is notH defined). The format of these logicals is "[s][[h]mm]", where s is aF sign (+ or -), h is the number of hours (1-18) and mm the number ofL minutes (00-59) to be added to GMT to give the local time. An example isK "+1000" for Australian Eastern Standard Time, which is 10 hours ahead of GMT.L I'm not sure about the history of SYS$TIME_ZONE. I saw it somewhere, but= I can't remember where. It is not defined on our systems.The /SCAN qualifier.H When writing a file with variable-length records to an archive, TAR'sK normal behaviour is first to copy the file into a temporary file, in theK TAR format. When this is done, TAR knows the size of the file in bytes,H so it can then write a header record to the real archive, and quickly< load the contents of the temporary file into the archive.J The presence of the /SCAN qualifier makes TAR read through the whole ofJ the input file to get its size in bytes, then load it into the archive.D The first method should save on processing, but the second methodF should save on I/O, and could help in a situation of stretched diskI quota. I thought both were useful, so I coded both and made the /SCAN qualifier.H Incidentally, if the input file has fixed-length records, its size isJ computed using the record size and the size in blocks of the file. ThisF may not be a completely safe algorithm, as it presumes there are no2 record delimiters in fixed-length record files.,!'Directory not found' when EXTRACTing files!H! If you try to make TAR EXTRACT a file into a directory that does notD! exist (it may not have been put in the archive), it will say so,I! then extract it into the file '[]OUT_FILE.DAT'. This wasn't actuallyC! explicitly coded into TAR by me (a side effect), but it seems aE! sensible thing to do until I implement a qualifier to tell TAR to?! create the directories it needs (like UNIX tar and BACKUP).!?! [ TAR now automatically creates any necessary directories ]!Internal errorsI If TAR tells you it has encountered an internal error, it means it hasJ caught a Pascal run-time error that it doesn't have a way of handling. H Generally, this means you have done something strange with TAR that IF haven't done myself in testing. The code supplied in the INTERNERRJ message corresponds to a VAX Pascal status code, and I would like it ifH you notify me of how you caused the error and the value of that code.Output file record wrappingF VMS TAR has no way of knowing if a file originally had fixed-lengthH records, so it always assumes a file in an archive is to be EXTRACTedA with variable-length records, and interprets any LF's it findsJ accordingly. But, if a record is longer than a certain number of bytesK (currently 8192), the superfluous bytes are used to make a new record inH the file (they are wrapped). The user is told of this if and when itL happens during the extraction of a file. Note however that the user will; only be notified the first time it happens to each file.Exceeding disk quotaD When a sequential file is written to by VAX RMS, it automaticallyF extends, or allocates more blocks to the file as necessary. I haveE seen RMS be overly generous in doing this; to the point where I amF fairly sure there are a few bugs deep down in RMS. This generosityE could cause a user's disk quota to be exceeded when creating a TARH archive or extracting files from an archive. To combat this, you can4 enter the following DCL command before using TAR: $ SET RMS_DEFAULT/EXTEND=nG Where n is a fairly low number, like 1 or 2. The RMS default is 32,F but I have seen files with more than 31 allocated but unused blocks attached to them.I These superflous extents only exist when the file is being written to,, they are removed when the file is closed.!2 APPENDDThis function is the same as WRITE, except that files written to the!archive are appended (see WRITE).! 3 Qualifiers!/ARCHIVEJ Specifies the archive to which files are to be APPENDed. The default isG 'TAR_ARCHIVE', which might be a logical name pointing to a tape-driveI (see Examples). The archive file specified must be a valid TAR archive file./CONFIRMG If the /CONFIRM qualifier is given on the APPEND keyword, the user isG prompted each time TAR is about to append a file to the archive. The; user may then confirm or abort the archiving of the file. /MAP_MODE /MAP_MODE=PREFIX (Default)F The MAP_MODE keyword tells TAR how to map VMS file specifications toG UNIX pathnames when writing files to an archive. The available modes and their behaviours follows:F PREFIX File names in the archive are relative, any directoriesE in the pathname of a file that are common to all files; to be written (a common prefix) are removed.B ABSOLUTE The VMS device, directory, name and type fields areF mapped to an absolute UNIX pathname (one beginning withE '/'). A file called 'DISK:[USER.SUB]FOO.BAR' would be2 mapped to '/disk/user/sub/foo.bar'.H ROOT The (logical or physical) device specification is omittedG from the UNIX pathname, but the directory, name and type> are used to form a relative pathname. The file: 'DISK:[USER.SUB]FOO.BAR' would be mapped to" 'user/sub/foo.bar'./SCANF Instructs TAR not to use a temporary archive file for the purpose ofE writing a file with variable-length records to an archive. See TAR Caveats./VERSIONE Instructs TAR to include the version number at the end of each fileG name (excluding directories) and to write all versions of a file whenF writing to an archive. Version numbers are usually excluded becauseF Unix does not have a file version mechanism, and the semi-colon (;),E used by VMS to denote a following version number, is interpreted by% Unix shells as a command separator.! 2 EXTRACTHThis function reads files from an archive, and creates VMS files in yourCcurrent directory with names, protections and modification dates asFsimilar as possible to their UNIX names. As each file is created, itssize in records is logged.! 3 Qualifiers!/ARCHIVEJ Specifies the archive from which files are to be EXTRACTed. The defaultJ is 'TAR_ARCHIVE', which might be a logical name pointing to a tape-drive (see Examples)./CONFIRMH If the /CONFIRM qualifier is given on the EXTRACT keyword, the user isG prompted each time TAR is about to extract a file. The user may then, confirm or abort the creation of the file./LITERALK Instructs TAR to interpret any file-specification literally, i.e., not toL interpret any embedded wildcards. This qualifier is positional, so can be) used on particular file-specifications.!2 LISTH This function lists all files, and their sizes in bytes, in an archiveK that match file-spec. If file-spec is not supplied, LIST lists all files in the archive.! 3 Qualifiers!/ARCHIVEC Specifies the archive TAR is to search for files. The default isG 'TAR_ARCHIVE', which might be a logical name pointing to a tape-drive (see Examples)./FULLJ If the /FULL qualifier is specified on a LIST operation, a more detailed@ listing of the archive contents is returned; specifically, theJ protection, owner id-number, group id-number, size and name of the file./LITERALK Instructs TAR to interpret any file-specification literally, i.e., not toI interpret any embedded wildcards. This qualifier is positional, so can, be used on particular file-specifications./OUTPUTJ Instructs TAR to direct the output of the LISTing to a file (the default# file type for this file is .LIS).!2 WRITEBThis function writes files to an archive, copying the modificationHdate/time and the read and write permission bits (the execute permissionHis present in most places where the read permission is under VMS, and isDtherefore almost meaningless). The user and group id's are set to 0C(root). As each file is written, its size in bytes (under UNIX) islogged.! 3 Qualifiers!/ARCHIVEI Specifies the archive to which files are to be WRITten. The default isG 'TAR_ARCHIVE', which might be a logical name pointing to a tape-drive (see Examples)./CONFIRMF If the /CONFIRM qualifier is given on the WRITE keyword, the user isF prompted each time TAR is about to write a file to the archive. The; user may then confirm or abort the archiving of the file. /MAP_MODE /MAP_MODE=PREFIX (Default)F The MAP_MODE keyword tells TAR how to map VMS file specifications toG UNIX pathnames when writing files to an archive. The available modes and their behaviours follows:F PREFIX File names in the archive are relative, any directoriesE in the pathname of a file that are common to all files; to be written (a common prefix) are removed.B ABSOLUTE The VMS device, directory, name and type fields areF mapped to an absolute UNIX pathname (one beginning withE '/'). A file called 'DISK:[USER.SUB]FOO.BAR' would be2 mapped to '/disk/user/sub/foo.bar'.H ROOT The (logical or physical) device specification is omittedG from the UNIX pathname, but the directory, name and type> are used to form a relative pathname. The file: 'DISK:[USER.SUB]FOO.BAR' would be mapped to" 'user/sub/foo.bar'./SCANF Instructs TAR not to use a temporary archive file for the purpose ofE writing a file with variable-length records to an archive. See TAR Caveats./VERSIONE Instructs TAR to include the version number at the end of each fileG name (excluding directories) and to write all versions of a file whenF writing to an archive. Version numbers are usually excluded becauseF Unix does not have a file version mechanism, and the semi-colon (;),E used by VMS to denote a following version number, is interpreted by% Unix shells as a command separator.*[TAR]TAR.MMS;1+,険./ 4O-Ws0123KPWO56P[o7o8p9GHJ+! MMS script for TAR, Tim Cook, 20-JUN-1989 .OBJ.EXE :( $(LINK) $(LINKFLAGS) $(MMS$SOURCE_LIST) LINKFLAGS = $(LINKFLAGS)/NOTRACEOTAR_OBJECTS = tar.obj, tar_write.obj, tar_extract.obj, tar_list.obj, tarmsg.objMMISC_OBJECTS = vcdefs.obj, dss.obj, libiferr.obj, libitmlst.obj, libparse.objDENVIRONMENTS = SYS$LIBRARY:STARLET.PEN, tar.pen, dss.pen, vcdefs.pen%STARLET_MLB = SYS$LIBRARY:STARLET.MLBL! VAXCRTL.OPT should be a one-line file containing "SYS$SHARE:VAXCRTL/SHARE"6tar.exe : $(TAR_OBJECTS), $(MISC_OBJECTS), vaxcrtl.optF $(LINK) $(LINKFLAGS) $(TAR_OBJECTS), $(MISC_OBJECTS), vaxcrtl.opt/OPT.tar_write.obj : tar_write.pas, $(ENVIRONMENTS)2tar_extract.obj : tar_extract.pas, $(ENVIRONMENTS),tar_list.obj : tar_list.pas, $(ENVIRONMENTS)?tar.obj, tar.pen : tar.pas, SYS$LIBRARY:STARLET.PEN, vcdefs.pen" $(PASCAL) $(PFLAGS) $(MMS$SOURCE)dss.obj, dss.pen : dss.pas" $(PASCAL) $(PFLAGS) $(MMS$SOURCE)<vcdefs.obj, vcdefs.pen : vcdefs.pas, SYS$LIBRARY:STARLET.PEN" $(PASCAL) $(PFLAGS) $(MMS$SOURCE)tarmsg.obj : tarmsg.msg+libiferr.obj : libiferr.mar, $(STARLET_MLB)-libitmlst.obj : libitmlst.mar, $(STARLET_MLB)+libparse.obj : libparse.mar, $(STARLET_MLB)*[TAR]TAR.OBJ;1+,.'/ 4'&p-Ws0123KPWO(565Jt7mt80u9GHJ2TART1.1-2 5-Jul-1990 11:42 5-Jul-1990 11:42VAX Pascal V3.9-289  TARPbARCHIVEb ARCHIVE_TEMPQTAR_TIMEZONELNM$FILE_DEVSYS$TIME_ZONEQ!2SL !AS !SL !2ZL:!2ZLQ? (Y/N) [Y]: Q./[][.:[000000.Q000000Q.TARSYS$SCRATCH:HEADER.TARQdddFILESPECLITERALQMAP_MODEARCHIVEQTAR_ARCHIVEQOPTIONQCONFIRMQVERSIONQSCANOUTPUTQTAR.LISQFULL|^ԭ PAS$HANDLERm}м VЭP` `(`QWQ QQQQ##Q Q1Q $Q Q QQ QQQ$Q QQQ+QQQ Q0QQQ QQQQ QQlQ Q[Q:QQQQQ 7QQQQQ WQ6QQtQ_QGQ/QQ'QQA#Q Q1Q $Q Q QQQ|QQ5Q"QQQ%Q Q Q:QNQiQ'QQK0QQQ&Q!QQ Q8Q:QfQQ7QQ(&Q QQQQQ%6QQQ QQQ QQQQQQQQQQ Q QQ%GQ.QQQQQ̒QQ QSQQ =QQQQ=QQQ;QQQ}Q =QQQ;QQQQQQQ=QQQ;QQQgQ@QQQ'QQQ?QQQQQQ{Q NAM$C_MAXRSS, but aligned }; fixed_filespec_type = PACKED ARRAY [1..256] OF char ;- large_string = VARYING [4100] OF char ;= map_mode_type = (prefix_mode, absolute_mode, root_mode, single_dir_mode) ; match_node_type = RECORD" next : ^match_node_type ; literal : boolean ;+ string : fixed_filespec_type END ;- match_node_pointer = ^match_node_type ; VAR archive : tar_file_type ;$ archive_temp : tar_file_type ;9 output_filespec, archive_filespec : filespec_type ;G i, j : integer ; { miscellaneous counters }M last_char : integer ; { points to last char buffered }? eof_mark_found : boolean ; { by write_temp }# archive_temp_open : boolean ; confirm : boolean ;' match_node : match_node_pointer ; match_all : boolean ; option : small_string ;2 opening_archive_input : [VOLATILE] boolean ;4 creating_archive_output : [VOLATILE] boolean ;. inspecting_header : [VOLATILE] boolean ;4 full_archive_spec : [VOLATILE] filespec_type ;( default_header : tar_record_type ;' UNIX_epoch_time : lib_date_type ;D delta_seconds : integer ; { Delta time from GMT } VALUE default_header := (0,, (100 OF null), { name }, (' 644', space, null), { mode }+ (' 0', space, null), { uid }+ (' 0', space, null), { gid }+ ' 0 ', { siz }E ' 4241462038 ', { mtime - 10-MAY-1988 12:00 EST }N (' 0', null, space), { chksum - nul/spc back to front, I know }0 null, { linkflag }0 (100 OF null), { linkname }. (175 OF null)) ; { filler }6 UNIX_epoch_time := (0, %x4BEB4000, %x007C9567) ;0 { which equals 1-JAN-1970 00:00:00.00 }" inspecting_header := false ;& opening_archive_input := false ;" archive_temp_open := false ; match_all := false ;F [ASYNCHRONOUS] FUNCTION tar_handler ( { TAR condition handler }& VAR sigargs : lib_sigargs_type ;3 VAR mechargs: lib_mechargs_type) : sts_type ; VAR i, j : integer ; condition : STS$TYPE ; convert : boolean ; PROCEDURE bad_archive ; VAR/ descriptor : [STATIC] PACKED RECORD' maxlen : lib_word_type ;- dtype, class : lib_byte_type ;& pointer : integer END ; BEGIN& sigargs.param_count := 4 ;2 sigargs.condition := tar__badarchive ;' sigargs.parameter[1] := 1 ;= descriptor.maxlen := length (full_archive_spec) ;0 descriptor.class := DSC$K_CLASS_VS ;0 descriptor.dtype := DSC$K_DTYPE_VT ;@ descriptor.pointer := iaddress (full_archive_spec) ;? sigargs.parameter[2] := iaddress (descriptor) END ; BEGIN { tar_handler }& tar_handler := SS$_RESIGNAL ; convert := false ;" CASE sigargs.condition OFB PAS$_ERRDUROPE, PAS$_FILNOTFOU, PAS$_ERRDURREW : BEGIN, IF opening_archive_input THEN2 sigargs.condition := tar__openin3 ELSE IF creating_archive_output THEN4 sigargs.condition := tar__createrr ELSE# convert := true ;( IF NOT convert THEN BEGIN- sigargs.parameter[1] := 1 ;6 j := int (sigargs.param_count) - 3 ;$ FOR i := 2 TO j DOE sigargs.parameter[i] := sigargs.parameter[i+2] ;J sigargs.param_count := sigargs.param_count - 2 END END ;? PAS$_ACCMETINC, { Access method inconsistent }? PAS$_RECLENINC, { Record length inconsistent }= PAS$_RECTYPINC : { Record type inconsistent }, IF opening_archive_input THEN bad_archive ELSE# convert := true ;5 PAS$_ERRDURGET : { Error during GET }2 sigargs.condition := tar__errread ;L PAS$_INVSYNOCT : { Invalid syntax in octal value - SomethingO might have blown up while reading a header }( IF inspecting_header THEN bad_archive ELSE# convert := true ; OTHERWISE$ convert := true END ; IF convert THEN BEGIN8 condition := (sigargs.condition)::STS$TYPE ;B IF (condition.STS$V_FAC_NO = PAS$_FACILITY) THEN BEGIN= { Report condition encountered as "internal error" }@ LIB$STOP (tar__internerr, 1, sigargs.condition) ; END END ;! END ; { tar_handler } FUNCTION lowercase (8 VAR inp_string : [READONLY] VARYING [n1] OF char ;1 start_pos : integer := 1) : medium_string ; VAR i : integer ;! result : medium_string ; BEGIN result := inp_string ;3 FOR i := start_pos TO inp_string.length DO/ IF inp_string[i] IN ['A'..'Z'] THEN< result[i] := chr (ord (inp_string[i]) + 32) ; lowercase := result ; END ;P FUNCTION uppercase ( { Wrote my own cos it looks neater with "lowercase" }I VAR inp_string : [READONLY] VARYING [n1] OF char) : medium_string ; VAR! result : medium_string ; i : integer ; BEGIN result := inp_string ;+ FOR i := 1 TO inp_string.length DO/ IF inp_string[i] IN ['a'..'z'] THEN< result[i] := chr (ord (inp_string[i]) - 32) ; uppercase := result ; END ;O PROCEDURE convert_zstr ( { Convert a null-terminated string to VARYING }G VAR z_string : [READONLY] PACKED ARRAY [l1..u1:integer] OF char ;- VAR vs_string : VARYING [n1] OF char) ; BEGINH vs_string := substr (z_string, 1, index (z_string, null) - 1) ; END ;L FUNCTION checksum ( { Calculate the checksum of a TAR header record }4 VAR check_record : [READONLY] tar_record_type) : integer ; VAR result, i : integer ; BEGIN result := 0 ;) FOR i := 1 TO tar_record_size DO; result := result + ord (check_record.data[i]) ;! checksum := result END ;6 FUNCTION february_days (year : integer) : integer ; BEGIN IF year REM 4 = 0 THEN$ IF year REM 100 = 0 THEN' IF year REM 400 = 0 THEN% february_days := 29 ELSE% february_days := 28 ELSE" february_days := 29 ELSE% february_days := 28 END ;$ FUNCTION get_timezone : integer ; VAR. return, hours, minutes, i : integer ;& timezone_str : small_string ; BEGIN return := 1 ;A IF failure ($TRNLNM (, lnm$file_dev_kt, 'TAR_TIMEZONE',,M lib_item_list (lib_out_item (LNM$_STRING, %DESCR timezone_str)))) THENE IF failure ($TRNLNM (, lnm$file_dev_kt, 'SYS$TIME_ZONE',,; lib_item_list (lib_out_item (LNM$_STRING,. %DESCR timezone_str)))) THEN return := 0 ;" IF return <> 0 THEN BEGIN> IF failure (OTS$CVT_TI_L ((timezone_str), i)) THENF LIB$STOP (tar__invtimzon, 1, %STDESCR (timezone_str)) ; hours := i DIV 100 ;( minutes := i - hours * 100 ;> IF (abs (hours) > 18) OR (abs (minutes) > 59) THEN return := 0 ELSE: return := minutes * 60 + hours * 3600 END ;! get_timezone := return ; END ;> FUNCTION add_timezone ( { converts from GMT to local time }+ VAR UNIX_time : unsigned) : boolean ; BEGIN add_timezone := true ;" IF delta_seconds < 0 THEN: IF (-1 * delta_seconds) > UNIX_time THEN BEGIN UNIX_time := 0 ;E add_timezone := false END { indicates over/underflow } ELSE5 UNIX_time := UNIX_time + delta_seconds ELSED IF uint (lO~VMS-TAR-11.32256Ws[TAR]TAR.PAS;1OBJ;2PN hib_k_maxlong) - delta_seconds > UNIX_time THEN5 UNIX_time := UNIX_time + delta_seconds ELSE BEGIN+ UNIX_time := lib_k_maxlong ;. add_timezone := false END END ;! PROCEDURE break_up_UNIX_time ( UNIX_time : unsigned ;$ VAR time : broken_time_type) ; CONST mar = 31 ; apr = 30 + mar ; may = 31 + apr ; jun = 30 + may ; jul = 31 + jun ; aug = 31 + jul ; sep = 30 + aug ; oct = 31 + sep ; nov = 30 + oct ; dec = 31 + nov ; jan = 31 + dec ;" seconds_per_day = 86400 ;" seconds_per_hour = 3600 ;" seconds_per_minute = 60 ; weekday_epoch = 4 ;@ days_to_eoy = 306 ; { Days from 1/3 to 1/1 next year } VAR! UNIX_time_l : unsigned ;' days, m_day, temp : unsigned ;" BEGIN { break_up_UNIX_time }# UNIX_time_l := UNIX_time ;8 days := int (UNIX_time_l DIV seconds_per_day) ;> UNIX_time_l := UNIX_time_l - days * seconds_per_day ;> time.hour := int (UNIX_time_l DIV seconds_per_hour) ;D UNIX_time_l := UNIX_time_l - time.hour * seconds_per_hour ;B time.minute := int (UNIX_time_l DIV seconds_per_minute) ;N time.second := int (UNIX_time_l - time.minute * seconds_per_minute) ;< days := days + 2133 ; { Now relative to 1/3/1964 }) { Find remainder of days / 365.25 }$ temp := days * 4 DIV 1461 ;, m_day := days - temp * 1461 DIV 4 ;G { m_day now contains the day of the year, relative to 1st March }B time.year := -6 ; { Year will then be relative to 1970 }C IF m_day = 0 THEN BEGIN { It's actually the 29th of Feb! } time.month := 2 ; time.day := 29 END4 ELSE { Right, figure out month and day } IF m_day > aug THEN" IF m_day > nov THEN+ IF m_day > dec THEN BEGIN< IF m_day > jan THEN BEGIN { February }) time.month := 2 ;9 time.day := int (m_day - jan) END. ELSE BEGIN { January }) time.month := 1 ;; time.day := int (m_day - dec) END ;( time.year := -5 END ELSE BEGIN' time.month := 12 ;6 time.day := int (m_day - nov) END ELSE% IF m_day > sep THEN< IF m_day > oct THEN BEGIN { November }* time.month := 11 ;9 time.day := int (m_day - oct) END. ELSE BEGIN { October }* time.month := 10 ;9 time.day := int (m_day - sep) END- ELSE BEGIN { September }& time.month := 9 ;6 time.day := int (m_day - aug) END ELSE" IF m_day > may THEN% IF m_day > jun THEN: IF m_day > jul THEN BEGIN { August }) time.month := 8 ;9 time.day := int (m_day - jul) END+ ELSE BEGIN { July }) time.month := 7 ;9 time.day := int (m_day - jun) END( ELSE BEGIN { June }& time.month := 6 ;6 time.day := int (m_day - may) END ELSE % IF m_day > mar THEN 7 IF m_day > apr THEN BEGIN { May }o) time.month := 5 ;d9 time.day := int (m_day - apr) END , ELSE BEGIN { April }) time.month := 4 ;A9 time.day := int (m_day - mar) ENDo) ELSE BEGIN { March }e& time.month := 3 ;2 time.day := int (m_day) END ;' { Last of all, what year is it? }.; time.year := int (time.year + days * 4 DIV 1461) ;( END ; FUNCTION UNIX_time_to_str ( UNIX_time : unsigned ;5 delta_seconds : integer := 0) : medium_string ;i VAR" time : broken_time_type ;% UNIX_time_local : unsigned ; J months : [STATIC] ARRAY [1..12] OF PACKED ARRAY [1..3] OF char :=6 ('Jan', 'Feb', 'Mar', 'Apr', 'May', 'Jun',8 'Jul', 'Aug', 'Sep', 'Oct', 'Nov', 'Dec') ;/ return_string : VARYING [17] OF char ; BEGIN# add_timezone (UNIX_time) ; ' UNIX_time_local := UNIX_time ;5 break_up_UNIX_time (UNIX_time_local, time) ;aM lib_sigiferr (LIB$SYS_FAO ('!2SL !AS !SL !2ZL:!2ZL',, return_string,MF time.day, %STDESCR (months[time.month]), time.year + 1970,& time.hour, time.minute)) ;, UNIX_time_to_str := return_string ; END ; FUNCTION UNIX_to_VMS_time ( VAR UNIX_time : unsigned ;5 delta_seconds : integer := 0) : lib_date_type ;T VAR  h_time : quadruple ; & return_time : lib_date_type ; BEGIN0$ h_time := UNIX_time * 1q7 ;- h_time := h_time + UNIX_epoch_quad ;M" { Convert to local time }1 h_time := h_time + delta_seconds * 1q7 ;a; return_time.hi := trunc (h_time / power_32_quad) ; < h_time := h_time - return_time.hi * power_32_quad ;, return_time.lo := utrunc (h_time) ;* UNIX_to_VMS_time := return_time ; END ;  FUNCTION VMS_to_UNIX_time (F VAR VMS_time : lib_date_type ; { Should be READONLY }0 delta_seconds : integer := 0) : unsigned ; VAR{- VMS_rel_UNIX_epoch : lib_date_type ;,= { delta VMS time relative to 1-JAN-1970 0:0:0.0 }rJ h_time : quadruple ; { quadruple precision, or H_FLOAT }! result_time : unsigned ;r BEGIN: VMS_to_UNIX_time := 0 ; IF success (LIB$SUBX (EC VMS_time, UNIX_epoch_time, VMS_rel_UNIX_epoch)) THEN_3 IF VMS_rel_UNIX_epoch.hi > 0 THEN BEGIN_ h_time :=9 VMS_rel_UNIX_epoch.hi * power_32_quad ;P@ h_time := h_time + quad (VMS_rel_UNIX_epoch.lo) ;A h_time := h_time / 1q7 ; { convert to seconds }AD h_time := h_time - delta_seconds ; { convert to GMT }! IF h_time < 0 THEN ' VMS_to_UNIX_time := 0  ELSEu6 IF h_time > (power_32_quad - 1) THENA VMS_to_UNIX_time := %xFFFFFFFF { 2^32 - 1 }R ELSEB VMS_to_UNIX_time := uround (h_time) END END ;! FUNCTION get_prompted_string (g% prompt : VARYING [n1] OF char ;:) VAR string : VARYING [n2] OF char ; + default : VARYING [n3] OF char := '')_ : sts_type ; VARp status : sts_type ; BEGINc3 status := LIB$GET_INPUT (string, prompt) ;r! IF success (status) THEN3 IF string = '' THEN string := default ; , get_prompted_string := status END ; PROCEDURE set_this_false (o( VAR bool_to_set_false : boolean) ; BEGINr) bool_to_set_false := false END ;e FUNCTION confirm_operation (O; VAR op_to_confirm : [READONLY] VARYING [n1] OF char ; 4 VAR conf_filespec : [READONLY] filespec_type ;$ confirmed : boolean := false ;0 PROCEDURE eof_routine (VAR p1 : boolean) ;/ VAR eof_routine_p1 : boolean) : boolean ;g VARR" decision : small_string ; status : sts_type ; BEGINo4 IF confirmed THEN confirm_operation := true ELSE BEGIN + status := get_prompted_string (:E lowercase (op_to_confirm, 2) + space + conf_filespec +o0 '? (Y/N) [Y]: ', decision, 'Y') ;$ IF success (status) THENB confirm_operation := decision[1] IN ['Y', 'y', ' '] ELSE. IF status = RMS$_EOF THEN BEGIN0 eof_routine (eof_routine_p1) ;0 confirm_operation := false END ELSEk/ LIB$SIGNAL (status) END END ; FUNCTION VMS_filespec (4 VAR UNIX_filespec : [READONLY] filespec_type ;/ VAR absolute : boolean) : medium_string ; VARi" UNIX_dir : small_string ; temp_ch : char ;b i, j : integer ;c* UNIX_filespec_l : filespec_type ;2 device, directory, name : medium_string ;= dot_found, device_name, start_name, more : boolean ;r BEGINy absolute := false ;$ i := UNIX_filespec.length ; IF i = 0 THEN BEGIN name := '' ; UNIX_dir := '' END ELSE BEGINF. UNIX_filespec_l := UNIX_filespec ; IF i > 1 THENI IF substr (UNIX_filespec, 1, 2) = './' { redundant noise }l THEN BEGIN @ UNIX_filespec_l := substr (UNIX_filespec_l, 3,2 UNIX_filespec_l.length - 2) ;" i := i - 2 END ; more := true ; WHILE more DO  IF i > 0 THEN5 IF UNIX_filespec_l[i] <> slash THEN  i := i - 1l ELSE" more := false ELSEe! more := false ;  name :==L substr (UNIX_filespec_l, i + 1, UNIX_filespec_l.length - i) ; IF i > 1 THENf= UNIX_dir := substr (UNIX_filespec_l, 1, i - 1)c ELSE UNIX_dir := '' ;_ j := length (name) ; dot_found := false ;" FOR i := j DOWNTO 1 DO CASE name[i] OF '.' :e& IF dot_found THEN& name[i] := '-' ELSE + dot_found := true ;  'a'..'z' :: name[i] := chr (ord (name[i]) - 32) ;7 'A'..'Z', '0'..'9', '$', '_', '-' : ; < ',', '+', '~', '#', '*' : name[i] := '_' ;, OTHERWISE name[i] := '$' ; END END ;_ device := '' ;c directory := '' ;, IF length (UNIX_dir) > 0 THEN BEGIN$ j := length (UNIX_dir) ; start_name := true ;" device_name := false ; i := 0 ; WHILE i < j DO BEGIN i := i + 1 ;l" CASE UNIX_dir[i] OF slash :S. IF device_name THEN BEGIN, start_name := true ;0 device_name := false END- ELSE IF i = 1 THEN BEGIN * absolute := true ;/ device_name := true ENDr ELSE BEGIN, start_name := true ;: directory := directory + '.' END ;6 'A'..'Z', '0'..'9', '$', '_' : BEGIN( IF device_name THEN6 device := device + UNIX_dir[i] ELSE2> directory := directory + UNIX_dir[i] ;. start_name := false END ;" 'a'..'z' : BEGIN( IF device_name THENG device := device + chr (ord (UNIX_dir[i]) - 32)c ELSE O directory := directory + chr (ord (UNIX_dir[i]) - 32) ;S. start_name := false END ; '-' : BEGINr6 IF start_name OR device_name THEN& temp_ch := '_' ELSEo( temp_ch := '-' ;( IF device_name THEN2 device := device + temp_ch ELSE > directory := directory + temp_ch END ; '.' :T( IF device_name THEN. device := device + '_' ELSEoG IF (j > i) AND (UNIX_dir[i+1] = '.') THEN BEGINI9 directory := directory + '-' ;") i := i + 1 END  ELSE9 directory := directory + '_' ;a! OTHERWISE BEGINc( IF device_name THEN. device := device + '$' ELSE6 directory := directory + '$' ;. start_name := false END ;# END ; { CASE } ! END ; { WHILE } END ; { IF } IF device = '' THEN" IF directory = '' THEN* VMS_filespec := '[]' + name ELSE< VMS_filespec := '[.' + directory + ']' + name ELSEeB VMS_filespec := device + ':[' + directory + ']' + name END ; FUNCTION UNIX_filespec ( L VAR VMS_filespec : [READONLY] filespec_type ; {ALL fields expected } map_mode : map_mode_type ;$ prefix_length : integer := 0 ;: retain_version : boolean := false) : medium_string ; VARd6 device, name, type_, version : small_string ;% d, n, t, v, e, i : integer ;e1 directory, temp_result : medium_string ; BEGIN % e := length (VMS_filespec) ;Y v := e ;F( WHILE VMS_filespec[v] <> ';' DO v := v - 1 ; t := v ;t( WHILE VMS_filespec[t] <> '.' DO t := t - 1 ; n := t ;T( WHILE VMS_filespec[n] <> ']' DO n := n - 1 ; d := 1 ;e( WHILE VMS_filespec[d] <> ':' DO d := d + 1 ;4 device := substr (VMS_filespec, 1, d - 1) ;? directory := substr (VMS_filespec, d + 2, n - d - 2) ;B { Take out a leading 000000 directory if present (irrelevant) }% IF directory.length > 8 THENO8 IF substr (directory, 1, 8) = '000000.' THENI directory := substr (directory, 8, length (directory) - 7)  ELSE ELSET( IF directory = '000000' THEN directory := '' ;: name := substr (VMS_filespec, n + 1, t - n - 1) ;3 type_ := substr (VMS_filespec, t, v - t) ;e IF type_ = '.' THEN type_ := '' ;i9 version := substr (VMS_filespec, v, e - v + 1) ;i temp_result := '' ;9 IF map_mode IN [absolute_mode, prefix_mode] THEN 3 temp_result := slash + device + slash ;I2 IF map_mode <> single_dir_mode THEN BEGIN% d := length (directory) ; IF d > 0 THEN BEGINi! FOR i := 1 TO d DOS, IF directory[i] = '.' THEN, directory[i] := slash ;G temp_result := temp_result + directory + slash END END ; 4 temp_result := temp_result + name + type_ ; IF retain_version THENH2 temp_result := temp_result + version ;' IF map_mode = prefix_mode THEN B temp_result := substr (temp_result, prefix_length + 1,6 length (temp_result) - prefix_length) ;3 UNIX_filespec := lowercase (temp_result) ;  END ; FUNCTION find_file_spec (5 VAR file_buf : [UNSAFE] text) : medium_string ;M { This routine returns the full file specification of the file opened withmM the passed file-variable. This routine does assume that a NAM block hasJ been used by Pascal (which is usually the case), and that the file is open. } VAR  fab : fab_pointer ; nam : nam_pointer ;! nam_rsa : nam_rsa_type ; BEGINL$ fab := PAS$FAB (file_buf) ;/ nam := (fab^.FAB$L_NAM)::nam_pointer ; 4 nam_rsa := (nam^.NAM$L_RSA)::nam_rsa_type ;A find_file_spec := substr (nam_rsa^, 1, nam^.NAM$B_RSL) ;  END ;E PROCEDURE open_archive_input ( { Opens an archive file for input }=/ VAR filespec : [READONLY] filespec_type ;t! share : boolean := false) ;; BEGINe( opening_archive_input := true ; IF share THENI open (archive, filespec, history := OLD, sharing := READONLY, % default := dot_tar_kt) ELSE M open (archive, filespec, history := OLD, default := dot_tar_kt) ;  reset (archive) ;) opening_archive_input := false ;  END ;# FUNCTION eof_archive : boolean ; @ BEGIN eof_archive := eof (archive) OR eof_mark_found END ; PROCEDURE bad_header ( 0 VAR header : [READONLY] tar_record_type) ; BEGINU close (archive) ;5 open (archive, 'HEADER.TAR', history := NEW, ( default := sys$scratch_kt) ; rewrite (archive) ;" write (archive, header) ; close (archive) ;$ LIB$STOP (tar__badheader) ; END ; FUNCTION is_valid_header (DA VAR header_record : [READONLY] tar_record_type) : boolean ;e CONST_I { A TAR checksum is computed with the checksum field temporarily) filled with spaces. }D constant_part = size (header_record.chksum) * ord (space) ; VAR;$ sum, header_sum : integer ; upto : integer ;/ BEGIN N IF header_record.chksum.fill_null = space THEN BEGIN { simple check }" sum := constant_part ;? upto := byte_offset (tar_record_type, chksum) - 1 ;6! FOR i := 1 TO upto DO 9 sum := sum + ord (header_record.data[i]) ;t< FOR i := byte_offset (tar_record_type, linkflag)! TO tar_record_size DO 9 sum := sum + ord (header_record.data[i]) ;y@ readv (header_record.chksum.value, header_sum:oct) ;3 is_valid_header := sum = header_sum END ELSEN* is_valid_header := false END ;J FUNCTION inspect_header ( { Computes and checks the header checksum }6 VAR header_record : [READONLY] tar_record_type ;, VAR file_spec : VARYING [n1] OF char ; VAR file_size : integer ;m! VAR file_mtime : unsigned ; & VAR file_mode : file_mode_type ;* VAR directory : boolean) : boolean ; VAR' tar_filespec : medium_string ;a' header_tmp : tar_record_type ; $ header_checksum : integer ; i : integer ; response : char ; BEGIN 6 IF is_valid_header (header_record) THEN BEGIN$ inspect_header := true ;: convert_zstr (header_record.name, file_spec) ;' inspecting_header := true ; 6 readv (header_record.siz, file_size:oct) ;9 readv (header_record.mtime, file_mtime:oct) ; C readv (header_record.mode.value, file_mode.value:oct) ;u( inspecting_header := false ; directory := false ;& IF file_mode.mask[10] THEN$ IF file_size = 0 THEN# directory := truem ELSE , bad_header (header_record) ELSE7 IF (file_spec[file_spec.length] = slash) ' AND (file_size = 0) THEN ' directory := true END  ELSE BEGING% inspect_header := false ;mJ IF checksum (header_record) = 0 THEN { TAR's EOF marker }+ eof_mark_found := true END ;> END ;! FUNCTION scan_to_next_header (N, file_size : integer := -1) : boolean ; VAR " skip_count, i : integer ;! more_to_scan : boolean ; BEGIN & scan_to_next_header := true ;> { Assume archive^ contains header prior to next header } IF file_size = -1 THENB1 readv (archive^.siz, file_size:oct) ;  IF file_size = 0 THEN skip_count := 1 ELSE E skip_count := ((file_size - 1) DIV tar_record_size) + 2 ;  i := 0 ;  more_to_scan := true ;X WHILE more_to_scan DO8 IF i = skip_count THEN more_to_scan := false ELSE* IF eof (archive) THEN BEGIN) more_to_scan := false ; 2 scan_to_next_header := false END ELSE BEGIN ! get (archive) ;a" i := i + 1 END ; END ; PROCEDURE collect_matches (- VAR match_chain : match_node_pointer) ; VARt4 current_ptr, tmp_ptr : match_node_pointer ;# filespec : filespec_type ;m first_time : boolean ;  i : integer ; BEGINA first_time := true ;gG WHILE success (CLI$GET_VALUE (filespec_kt, filespec)) DO BEGIN,D { Don't look for any corresponding "dispose" calls ... } new (current_ptr) ;$ IF first_time THEN BEGIN+ match_chain := current_ptr ;e& first_time := false END ELSE- tmp_ptr^.next := current_ptr ;i i := 1 ;/ WHILE i <= filespec.length DO BEGIN;6 current_ptr^.string[i] := filespec[i] ; i := i + 1 END ; , current_ptr^.string[i] := null ;> current_ptr^.literal := cli_present (literal_kt) ;( tmp_ptr := current_ptr END ;' current_ptr^.next := nil END ;  FUNCTION match_filespec (! cand_spec : filespec_type ; 3 match_chain : match_node_pointer) : boolean ;i VARA+ current_ptr : match_node_pointer ;u match : boolean ; i : integer ;0 cand_slashes, match_slashes : integer ; BEGINa IF match_all THEN" match_filespec := true ELSE BEGINh+ cand_spec := cand_spec + null ;i( current_ptr := match_chain ; match := false ;= WHILE NOT match AND (current_ptr <> nil) DO BEGIN + IF current_ptr^.literal THEN L IF current_ptr^.string[cand_spec.length] = null THEN BEGIN i := 1 ; $ match := true ;D WHILE match AND (i < cand_spec.length) DO BEGINH match := current_ptr^.string[i] = cand_spec[i] ;* i := i + 1 END END ELSE ELSE BEGINI< match := SHELL$MATCH_WILD (cand_spec.body,+ current_ptr^.string) ;t% IF match THEN BEGIN ( cand_slashes := 0 ; i := 1 ; 8 WHILE cand_spec[i] <> null DO BEGIN4 IF cand_spec[i] = slash THEN= cand_slashes := cand_slashes + 1 ;:( i := i + 1 END ;) match_slashes := 0 ;y i := 1 ;aB WHILE current_ptr^.string[i] <> null DO BEGIN> IF current_ptr^.string[i] = slash THEN? match_slashes := match_slashes + 1 ;e( i := i + 1 END ;D match := cand_slashes = match_slashes END END ; IF NOT match THEN8 current_ptr := current_ptr^.next END ;- match_filespec := match END END ; " [EXTERNAL] PROCEDURE tar_list (7 VAR archive_filespec : [READONLY] filespec_type ;l" full : boolean) ; external ;% [EXTERNAL] PROCEDURE tar_extract (_7 VAR archive_filespec : [READONLY] filespec_type ;o% confirm : boolean) ; external ;t# [EXTERNAL] PROCEDURE tar_write (o7 VAR archive_filespec : [READONLY] filespec_type ;I confirm : boolean ;e scan : boolean ; map_mode : map_mode_type ;$ appending : boolean := false ;5 retain_version : boolean := false) ; external ; $ [EXTERNAL] PROCEDURE tar_append (7 VAR archive_filespec : [READONLY] filespec_type ; confirm : boolean ;  scan : boolean ; map_mode : map_mode_type ;5 retain_version : boolean := false) ; external ;_* FUNCTION get_map_mode : map_mode_type ; VAR " mode_str : small_string ; BEGINO? lib_sigiferr (CLI$GET_VALUE (map_mode_kt, mode_str)) ;y CASE mode_str[1] OF/ 'P' : get_map_mode := prefix_mode ;U1 'A' : get_map_mode := absolute_mode ;b5 'R' : get_map_mode := root_mode END END ;: BEGIN { tar }  establish (tar_handler) ;_D delta_seconds := get_timezone ; { Read logical TAR_TIMEZONE } { Get archive name }& IF cli_present (archive_kt) THENK lib_sigiferr (CLI$GET_VALUE (%DESCR archive_kt, archive_filespec)) ELSE, archive_filespec := 'TAR_ARCHIVE' ;8 lib_sigiferr (CLI$GET_VALUE (option_kt, option)) ;D CASE option[1] OF { case selector must be an ordinal type } 'E' :F tar_extract (archive_filespec, cli_present (confirm_kt)) ; 'W' :B tar_write (archive_filespec, cli_present (confirm_kt),P cli_present (scan_kt), get_map_mode,, cli_present (version_kt)) ; 'A' :C tar_append (archive_filespec, cli_present (confirm_kt), O cli_present (scan_kt), get_map_mode, cli_present (version_kt)) ;  'L' : BEGIN1 IF cli_present (output_kt) THEN BEGIN J lib_sigiferr (CLI$GET_VALUE (output_kt, output_filespec)) ;= open (output, output_filespec, history := NEW,I) default := 'TAR.LIS') ;c% rewrite (output) END ;_H tar_list (archive_filespec, cli_present (full_kt)) END END ; END. FOR i := j DOWNTO 1 DO CASE name[i] OF '.' :e& IF dot_found THEN& name[i*[TAR]TAR.PEN;1+,.$/ 4$%-Ws0123KPWO%56 kt78lt8u9GHJgB OSH 5-Jul-1990 11:42:04T1.1-2TARVAX Pascal V3.9-289 J UNDEFINED a PREFIX_MODE INPUT PAS$FV_INPUT OUTPUT PAS$FV_OUTPUT RECORD_SIZETAR_RECORD_SIZEVMS_BLOCK_SIZETAR_MULTI_BLOCK_COUNTSPACENULLLFCRLFCOLONDOTDOLLAR UNDERSCORESLASH DOT_SLASHTAR_ARCHIVE_KT DOT_TAR_KT DOT_DIR_1_KTLNM$FILE_DEV_KTSYS$SCRATCH_KT ARCHIVE_KT CONFIRM_KT FILESPEC_KTFULL_KT LITERAL_KT MAP_MODE_KT OPTION_KT OUTPUT_KT VERSION_KTSCAN_KT POWER_32_QUADUNIX_EPOCH_QUAD TAR__CREATED TAR__CREATEDIR TAR__WRITTEN TAR__WRITDIR TAR__APPENDED TAR__APPENDIR TAR__TOTCREAT TAR__TOTWRITE TAR__TOTAPPEND TAR__EMPTY TAR__HARDLINK TAR__SOFTLINK TAR__NOFILES TAR__WRAPPED TAR__RECTOOLONG TAR__ERRCREDIR TAR__PARSE TAR__OPENIN TAR__CLOSE TAR__CREATERR TAR__BADHEADER TAR__BADARCHIVE TAR__ERRREAD TAR__ERRWRITE TAR__INVTIMZON TAR__INTERNERR @ FAB_RFM_TYPEK UNDEFINEDL FIXED_LENGTHMVARIABLE_LENGTHNVARIABLE_FIXED_CONTROLOSTREAMP STREAM_LF STREAM_CR @OAT_8 TAR_RECORD_TYPE  FILE_MODE_TYPE TAR_RECORD_PTR  TAR_FILE_TYPE @TAR_BLOCK_TYPE pBROKEN_TIME_TYPE CLASS_PROTECTION_TYPE FILE_PROTECTION_TYPE  FIXED_STRING_100  SMALL_STRING  MEDIUM_STRING  FILESPEC_TYPE FIXED_FILESPEC_TYPE "0 LARGE_STRING & MAP_MODE_TYPE&b' PREFIX_MODE&c( ABSOLUTE_MODE&d) ROOT_MODE&*SINGLE_DIR_MODE +(MATCH_NODE_TYPE 0 MATCH_NODE_POINTER" ARCHIVE"  ARCHIVE_TEMP" OUTPUT_FILESPEC" ARCHIVE_FILESPEC  I  J  LAST_CHAR  EOF_MARK_FOUND  ARCHIVE_TEMP_OPEN  CONFIRM0  MATCH_NODE   MATCH_ALL" OPTION  OPENING_ARCHIVE_INPUT  CREATING_ARCHIVE_OUTPUT  INSPECTING_HEADER " FULL_ARCHIVE_SPEC" DEFAULT_HEADER1"J@UNIX_EPOCH_TIME  DELTA_SECONDS>= TAR_HANDLERML LOWERCASEUT UPPERCASEY CONVERT_ZSTR`_CHECKSUMba FEBRUARY_DAYSc GET_TIMEZONEed ADD_TIMEZO@~VMS-TAR-11.32256Ws[TAR]TAR.PEN;1$:6 NEfBREAK_UP_UNIX_TIMEihUNIX_TIME_TO_STRmlUNIX_TO_VMS_TIMEqpVMS_TO_UNIX_TIMEutzyGET_PROMPTED_STRINGSET_THIS_FALSECONFIRM_OPERATION VMS_FILESPEC UNIX_FILESPECFIND_FILE_SPECOPEN_ARCHIVE_INPUT EOF_ARCHIVE BAD_HEADERIS_VALID_HEADERINSPECT_HEADERSCAN_TO_NEXT_HEADERCOLLECT_MATCHESMATCH_FILESPEC TAR_LIST  TAR_EXTRACT  TAR_WRITE  TAR_APPEND GET_MAP_MODE          :.$_/ ./ XTAR_ARCHIVE X    .TAR    0.DIR;1 0  `LNM$FILE_DEV `    `SYS$SCRATCH: 8ARCHIVE 8  8CONFIRM @FILESPEC @  FULL 8LITERAL @MAP_MODE 0OPTION 0OUTPUT 8VERSION SCAN!@7@U/  $@$0VALUE 0$0 FILL_SPACE $8 FILL_NULL$ $ (  $ NAME(   d$@ MODE$DATA d$@`UID $@GID  $`SIZ ` $`@MTIME  $@CHKSUM$LINKFLAG$ LINKNAME  d$xFILLER d x $  $ (  $ VALUE(  $ MASK  @     @( $p$@YEAR $@MONTH$@ DAY$@0 HOUR$@@ MINUTE$@P SECOND$@` HUNDREDTH$ $@ NOREAD$@ NOWRITE$@  NOEXECUTE$@ NODELETE$$ SYSTEM$ OWNER$ GROUP$  WORLD  d d4 2 2 2    !  0#$   %  & $(,$- +.NEXT  +($ +/LITERAL$ (+STRING  +($@32 354$ 16( 86@778$ 149LO( 5:@4$ 14:HI$;@@17VALUE@< ?  { TAR_HANDLER $?@SIGARGS $AMECHARGS$XB$C$ @D PARAM_COUNT$ AE PARAM_COUNT$ @F CONDITION$ AGSTACK_FRAME_ADDRESS$H@@ PARAMETER$ @AISTACK_FRAME_DEPTH P J$ `AKR0 $ AR1"| LOWERCASE $NO$% INP_STRING $ P START_POSQR  $S "} UPPERCASE $V$% INP_STRINGQW$X  $Z[$Z_STRING $\% VS_STRING$Q]$^   CHECKSUM $$ CHECK_RECORD  FEBRUARY_DAYS $ YEAR  GET_TIMEZONE  ADD_TIMEZONE $  UNIX_TIME $g  UNIX_TIME $pTIME"UNIX_TIME_TO_STR $j  UNIX_TIME $ k DELTA_SECONDS 1"A@UNIX_TO_VMS_TIME $n  UNIX_TIME $ o DELTA_SECONDS   VMS_TO_UNIX_TIME $r1@VMS_TIME $ s DELTA_SECONDS  vw   x    GET_PROMPTED_STRING ${|% PROMPT $}~% STRINGQ $"% DEFAULTQ$Q$ $   $BOOL_TO_SET_FALSE CONFIRM_OPERATION $$% OP_TO_CONFIRM $$ CONF_FILESPECQ $ CONFIRMED$ $   EOF_ROUTINE  $EOF_ROUTINE_P1  EOF_ROUTINE $P1" VMS_FILESPEC $$ UNIX_FILESPEC $ABSOLUTE" UNIX_FILESPEC $$ VMS_FILESPEC $&MAP_MODE $  PREFIX_LENGTH $RETAIN_VERSION "FIND_FILE_SPEC $@FILE_BUF $$FILESPEC $SHARE  EOF_ARCHIVE $$HEADER IS_VALID_HEADER $$ HEADER_RECORD INSPECT_HEADER $$ HEADER_RECORD $% FILE_SPEC $  FILE_SIZEQ $  FILE_MTIME$ $  FILE_MODE  $ DIRECTORY SCAN_TO_NEXT_HEADER $  FILE_SIZE  $0  MATCH_CHAIN MATCH_FILESPEC $ CAND_SPEC $0  MATCH_CHAIN $$ARCHIVE_FILESPEC $FULL $$ARCHIVE_FILESPEC $CONFIRM $$ARCHIVE_FILESPEC $CONFIRM $SCAN $&MAP_MODE $ APPENDING $RETAIN_VERSION $$ARCHIVE_FILESPEC $CONFIRM $SCAN $&MAP_MODE $RETAIN_VERSION&  GET_MAP_MODE XTAR_ARCHIVE 8TAR.LIS,Px4H`z <\~0Nj"Ff * J l  2 P n  : ^  , J f * \ 6j4fH~,Hj,X|$Dd(Nv Bd 2\~2DXdp|&2@Z| @Xx4Tt0PZfr~Fh,Hr.Px(Tt $ R t !H!d!!!!! "@"`"""""#0#\####$4$X$$$$%8%f%%%%&(&@&`&&&&&&'8'X'p''''''(((D(n(((( )0)P)v))))*,*V*****+.+T+x+++,@,p,,,,->-\-----.$.D.d....."/P/t/////"0D0n00001>1f11111(2\2h222223 3@3`333344H4`444445$5D5|555 6$6T6x6666 7&7N7r7777&8V888888*9Z99999:8:^::::;:;`;;;;<8<D<t<<<<.=Z====$>N>~>>>>>2?`?????@6@*[TAR]TARMSG.MSG;1+,w./ 4J8-Ws0123KPWO56@Do7o8Rp9GHJ &! TARMSG.MSG - TAR message definitions!E! Copyright: Copyright 1989,1990, Victoria College Computer Services.7! All rights reserved except those granted in the file6! AAAREADME.1ST, which is distributed with this file.!(! Author: Tim Cook (timcc@viccol.edu.au)F! The 105 in the following .FACILITY directive can be changed, but the! /PREFIX must be TAR__. .FACILITY TAR, 105 /PREFIX=TAR__ .BASE 256/.SEVERITY SUCCESS ! 256 messages in this group-CREATED /FAO=2(CREATEDIR /FAO=1+WRITTEN /FAO=2'WRITDIR /FAO=1,APPENDED /FAO=2(APPENDIR /FAO=1CTOTCREAT /FAO=2.TOTWRITE /FAO=10TOTAPPEND /FAO=1 .BASE 5124.SEVERITY INFORMATIONAL ! 256 messages in this group6EMPTY /FAO=1DHARDLINK /FAO=1DSOFTLINK /FAO=1 .BASE 768/.SEVERITY WARNING ! 256 messages in this group,NOFILES /FAO=1JWRAPPED - /FAO=1ARECTOOLONG /FAO=1 .BASE 1024-.SEVERITY ERROR ! 256 messages in this group/ERRCREDIR /FAO=1 .BASE 1280.SEVERITY FATALDBADHEADER 1BADARCHIVE /FAO=1!PARSE /FAO=1,OPENIN /FAO=1!CLOSE /FAO=1$CREATERR /FAO=1! Converted from PAS$_ERRDURGET'ERRREAD /FAO=3#ERRWRITE /FAO=1/INVTIMZON /FAO=1IINTERNERR /FAO=1*[TAR]TARMSG.OBJ;2+,./ 4v-Ws0123KPWO56+t7at8\u9GHJ 0TARMSG0 5-JUL-1990 11:45 5-JUL-1990 11:45VAX-11 Message V04-00k$ABS$< MSG$SECTIONMSG$AAAAAAAAAAAMSG$AAAAAAAAAABMSG$AAAAAAAAAACgLiTAR__INTERNERRDiTAR__INVTIMZONQ.QQQ"Q QQQQQ QgQ$Q JQQAQAQ;oQ</Q$3QQ Q5zQ QOgQ Q QPSQWQ Q5PQT Q)Q,PQZP OPEN_ARCHIVE_INPUT ARCHIVE FIND_FILE_SPEC %FULL_ARCHIVE_SPEC SYS$SETDFPROT INSPECT_HEADER MATCH_FILESPEC SET_THIS_FALSE %OPTION CONFIRM_OPERATION  EOF_ARCHIVE  BAD_HEADERPAS$GET SCAN_TO_NEXT_HEADER TAR__TOTCREAT PAS$CLOSE2 TAR__HARDLINK TAR__SOFTLINKSYS$PUT TAR__ERRWRITE TAR__WRAPPED. $CODE"$LOCAL6 :  ՜E  H  3$CODE. $LOCAL"8OPEN_OUTPUT_FILEPCLOSE_OUTPUT_FILE TAR_EXTRACT@ EXTRACT_FILE  WRITE_BLOCKTMAKE_DIRECTORY*[TAR]TAR_EXTRACT.PAS;1+,./ 4O-Ws0123KPWO56`o7` o8`p9GHJ3{ TAR_EXTRACT.PAS - Routines to support TAR/EXTRACT!E! Copyright: Copyright 1989,1990, Victoria College Computer Services.7! All rights reserved except those granted in the file6! AAAREADME.1ST, which is distributed with this file.!(! Author: Tim Cook (timcc@viccol.edu.au)}2[INHERIT ('SYS$LIBRARY:STARLET', 'VCDEFS', 'TAR'), %INCLUDE 'TAR_VERSION.PAS']MODULE extract ; CONSTG { When TAR extracts a record of length >= out_buffer_size, a wrapI occurs after out_buffer_size bytes. This means records of lengthE out_buffer_size - 1 will be unaffected, and records of lengthH out_buffer_size will be immediately followed by an empty record.F This behaviour is necessary in order to reconstruct files that" have been wrapped by TAR } out_buffer_size = 8192 ; TYPE1 UNIX_protection_type = [LONG] PACKED RECORD- others, group, owner : PACKED RECORD: execute, write, read : [BIT] boolean END END ;C out_buffer_type = PACKED ARRAY [1..out_buffer_size] OF char ; VAR out_fab : FAB$TYPE ; out_nam : NAM$TYPE ; out_xabrdt : XAB$TYPE ; out_xabpro : XAB$TYPE ; out_rab : RAB$TYPE ;B default_protection : lib_word_type ; { from SYS$SETDFPROT }' output_buffer : out_buffer_type ;C output_result_spec : PACKED ARRAY [1..NAM$C_MAXRSS] OF char ; VALUE out_fab := zero ; out_nam := zero ; out_xabrdt := zero ; out_xabpro := zero ; out_rab := zero ; PROCEDURE open_output_file (% VAR file_name : filespec_type ; file_size : integer) ; VAR dir : medium_string ;: status, secondary_status, dir_status : sts_type ; BEGIN) out_fab.FAB$B_BID := FAB$C_BID ;) out_fab.FAB$B_BLN := FAB$C_BLN ;D out_fab.FAB$B_RFM := FAB$C_VAR ; { Varying-length records }; out_fab.FAB$V_CR := true ; { Carriage-return RAT }3 out_fab.FAB$V_PUT := true ; { PUT access }; out_fab.FAB$V_TEF := true ; { Truncate on $CLOSE }9 out_fab.FAB$L_FNA := iaddress (file_name.body) ;A out_fab.FAB$B_FNS := (file_name.length)::lib_byte_type ; IF file_size > 0 THENI out_fab.FAB$L_ALQ := (file_size - 1) DIV VMS_block_size + 1 ;2 out_fab.FAB$L_NAM := iaddress (out_nam) ;) out_nam.NAM$B_BID := NAM$C_BID ;) out_nam.NAM$B_BLN := NAM$C_BLN ;= out_nam.NAM$L_RSA := iaddress (output_result_spec) ;, out_nam.NAM$B_RSS := NAM$C_MAXRSS ;& status := $CREATE (out_fab) ;@ IF status = RMS$_DNF THEN BEGIN { Directory not found }4 dir := '' ; { %PASCAL-W if not done }? lib_parse (file_name, dir,,,, NAM__DEV, NAM__DIR) ;0 dir_status := LIB$CREATE_DIR (dir) ;. IF success (dir_status) THEN BEGIN? LIB$SIGNAL (tar__createdir, 1, %STDESCR (dir)) ;. status := $CREATE (out_fab) END ELSEM LIB$STOP (tar__errcredir, 1, %STDESCR (dir), dir_status) END ;' IF success (status) THEN BEGIN, out_rab.RAB$B_BID := RAB$C_BID ;, out_rab.RAB$B_BLN := RAB$C_BLN ;8 out_rab.RAB$B_MBC := tar_multi_block_count ;M { Multi-block count; specifies how many blocks of a sequential7 file are transferred per disk access }5 out_rab.RAB$L_FAB := iaddress (out_fab) ;L file_name := substr (output_result_spec, 1, out_nam.NAM$B_RSL) ;* status := $CONNECT (out_rab) ;* IF success (status) THEN BEGIN/ out_rab.RAB$B_RAC := RAB$C_SEQ ;@ out_rab.RAB$L_RBF := iaddress (output_buffer) END ELSED secondary_status := (out_rab.RAB$L_STV)::sts_type END ELSE? secondary_status := (out_fab.FAB$L_STV)::sts_type ;' IF failure (status) THEN BEGIN. lib_parse (file_name, file_name) ;E LIB$STOP (tar__createrr, 1, %STDESCR (file_name), status,& secondary_status) END ; END ; PROCEDURE close_output_file ( no_records : integer ; file_mtime : unsigned ;2 file_mode : [UNSAFE] UNIX_protection_type) ; VAR+ created_filespec : medium_string ;0 VMS_protection : file_protection_type ; BEGIN created_filespec :=? substr (output_result_spec, 1, out_nam.NAM$B_RSL~VMS-TAR-11.32256Ws[TAR]TAR_EXTRACT.PAS;1O^* ) ;5 out_fab.FAB$L_XAB := iaddress (out_xabrdt) ;, out_xabrdt.XAB$B_COD := XAB$C_RDT ;/ out_xabrdt.XAB$B_BLN := XAB$C_RDTLEN ;8 out_xabrdt.XAB$L_NXT := iaddress (out_xabpro) ;O out_xabrdt.XAB$Q_RDT := UNIX_to_VMS_time (file_mtime, delta_seconds) ;, out_xabpro.XAB$B_COD := XAB$C_PRO ;/ out_xabpro.XAB$B_BLN := XAB$C_PROLEN ;G lib_sigiferr (LIB$GETJPI (JPI$_UIC,,, out_xabpro.XAB$L_UIC)) ;G VMS_protection := (default_protection)::file_protection_type ;2 { Here is where the file protection is copied }C VMS_protection.world.noread := NOT file_mode.others.read ;F VMS_protection.world.noexecute := NOT file_mode.others.read ;E VMS_protection.world.nowrite := NOT file_mode.others.write ;B VMS_protection.group.noread := NOT file_mode.group.read ;E VMS_protection.group.noexecute := NOT file_mode.group.read ;D VMS_protection.group.nowrite := NOT file_mode.group.write ;B VMS_protection.owner.noread := NOT file_mode.owner.read ;E VMS_protection.owner.noexecute := NOT file_mode.owner.read ;D VMS_protection.owner.nowrite := NOT file_mode.owner.write ;E VMS_protection.owner.nodelete := NOT file_mode.owner.write ;B out_xabpro.XAB$W_PRO := (VMS_protection)::lib_word_type ;+ IF failure ($CLOSE (out_fab)) THENA LIB$STOP (tar__close, 1, %STDESCR (created_filespec),4 out_fab.FAB$L_STS, out_fab.FAB$L_STV) ELSEE LIB$SIGNAL (tar__created, 2, %STDESCR (created_filespec), no_records) ; END ;# [GLOBAL] PROCEDURE tar_extract (7 VAR archive_filespec : [READONLY] filespec_type ; confirm : boolean) ; VARO header : boolean ; { true if current tar_record is one }M no_records : integer ; { no of tar records for curr file }$ file_spec : filespec_type ; file_size : integer ; file_mtime : unsigned ;% file_mode : file_mode_type ;L bytes_written : integer ; { bytes written to curr out_file }1 files_created, files_scanned : integer ;4 tar_filespec, upcase_spec : filespec_type ;" more, verbose : boolean ;1 file_scanned, warned_of_wrap : boolean ; absolute : boolean ; directory : boolean ;C protection : unsigned ; { UNIX style protection } PROCEDURE extract_file (. VAR header_record : tar_record_type ;$ file_spec : filespec_type ; file_size : integer ; file_mtime : unsigned ;& file_mode : file_mode_type) ; VAR more : boolean ;& VMS_spec : filespec_type ; absolute : boolean ;: output_file_open : [STATIC] boolean := false ;. [CHECK(NONE)] PROCEDURE write_block (4 VAR block : [READONLY] tar_record_type ;) VAR bytes_written : integer ;' VAR no_records : integer) ; VAR$ i, status : integer ;: out_pointer : [STATIC] lib_word_type := 0 ; more : boolean ; BEGIN i := 0 ; more := true ;" WHILE more DO BEGIN i := i + 1 ;7 IF i > record_size THEN more := false ELSE BEGIN9 bytes_written := bytes_written + 1 ;G IF bytes_written = file_size THEN BEGIN { eof }' more := false ;9 IF block.data[i] <> lf THEN BEGIN; out_pointer := out_pointer + 1 ;L output_buffer[out_pointer] := block.data[i] END ;: out_rab.RAB$W_RSZ := out_pointer ;* out_pointer := 0 ;2 status := $PUT (out_rab) ;0 IF failure (status) THENK LIB$STOP (tar__errwrite, 1, %STDESCR (VMS_spec),E out_rab.RAB$L_STS, out_rab.RAB$L_STV) ;8 no_records := no_records + 1 ENDJ ELSE IF block.data[i] = lf THEN BEGIN { eoln }= out_rab.RAB$W_RSZ := out_pointer ;- out_pointer := 0 ;5 status := $PUT (out_rab) ;3 IF failure (status) THENN LIB$STOP (tar__errwrite, 1, %STDESCR (VMS_spec),H out_rab.RAB$L_STS, out_rab.RAB$L_STV) ;; no_records := no_records + 1 END" ELSE BEGIN; out_pointer := out_pointer + 1 ;H output_buffer[out_pointer] := block.data[i] ;O IF out_pointer = out_buffer_size THEN BEGIN { wrap }@ out_rab.RAB$W_RSZ := out_pointer ;> IF failure ($PUT (out_rab)) THEN< LIB$STOP (tar__errwrite, 1,K %STDESCR (VMS_spec), out_rab.RAB$L_STS,8 out_rab.RAB$L_STV) ;< no_records := no_records + 1 ;> IF NOT warned_of_wrap THEN BEGIN= LIB$SIGNAL (tar__wrapped, 2,K %STDESCR (VMS_spec), out_buffer_size) ;= warned_of_wrap := true END ;8 out_pointer := 0 END END ; END ;' END ; { WHILE more }% END ; { write_block }" BEGIN { extract_file }' IF file_size = 0 THEN BEGIN( CASE archive^.linkflag OF '1' :2 LIB$SIGNAL (tar__hardlink, 1,/ %STDESCR (file_spec)) ; '2' :2 LIB$SIGNAL (tar__softlink, 1,/ %STDESCR (file_spec)) ;! OTHERWISE BEGINE VMS_spec := VMS_filespec (file_spec, absolute) ;= open_output_file (VMS_spec, file_size) ;/ output_file_open := true ;* no_records := 0 END ; END END: ELSE BEGIN { this is done after each header }? VMS_spec := VMS_filespec (file_spec, absolute) ; no_records := 0 ;# bytes_written := 0 ;7 open_output_file (VMS_spec, file_size) ; more := true ;" WHILE more DO BEGIN! get (archive) ;E write_block (archive^, bytes_written, no_records) ;3 IF bytes_written = file_size THEN, more := false END END ;* IF output_file_open THEN BEGINF close_output_file (no_records, file_mtime, file_mode) ;. output_file_open := false END ; END ; PROCEDURE make_directory ($ file_spec : filespec_type ;& file_mode : file_mode_type) ; VAR' temp_spec : medium_string ; absolute : boolean ; status : sts_type ; BEGINN temp_spec := VMS_filespec (file_spec + 'place.holder', absolute) ;E lib_parse (temp_spec, temp_spec,,,, NAM__DEV, NAM__DIR) ;2 status := LIB$CREATE_DIR (temp_spec) ;$ IF success (status) THENC LIB$SIGNAL (tar__createdir, 1, %STDESCR (temp_spec)) ELSEO LIB$STOP (tar__errcredir, 1, %STDESCR (temp_spec), status) END ; BEGIN { extract }* IF cli_present (filespec_kt) THEN( collect_matches (match_node) ELSE BEGIN match_all := true ;# match_node := nil END ;0 open_archive_input (archive_filespec) ;8 full_archive_spec := find_file_spec (archive) ;> lib_sigiferr (SYS$SETDFPROT (, default_protection)) ; files_created := 0 ; files_scanned := 0 ; header := true ; more := true ; WHILE more DO BEGIN% warned_of_wrap := false ;# file_scanned := false ;J IF inspect_header (archive^, file_spec, file_size, file_mtime,2 file_mode, directory) THEN BEGIN3 files_scanned := files_scanned + 1 ;= IF match_filespec (file_spec, match_node) THEN: IF confirm_operation (option, file_spec,I (NOT confirm) OR directory, set_this_false, more) THEN BEGIN& IF directory THENN IF NOT confirm AND (file_spec <> dot_slash) THEN BEGINB make_directory (file_spec, file_mode) ;A files_created := files_created + 1 END ELSE) { do nothing } ELSE BEGINE extract_file (archive^, file_spec, file_size,3 file_mtime, file_mode) ;@ files_created := files_created + 1 END ;- file_scanned := true END END, ELSE { inspect_header = false }" IF eof_archive THEN more := false ELSE@ bad_header (archive^) ; { stops execution } IF file_scanned THEN$ IF eof (archive) THEN more := false ELSE get (archive) ELSE0 scan_to_next_header (file_size) ;4 more := more AND NOT eof (archive) END ;F LIB$SIGNAL (tar__totcreat, 2, files_created, files_scanned) ; close (archive) ; END ; { extract } END.*[TAR]TAR_LIST.OBJ;1+,<. / 4 -Ws0123KPWO 56bt7&t8೷[u9GHJ3LISTT1.1-2 5-Jul-1990 11:44 5-Jul-1990 11:44VAX Pascal V3.9-289 LISTPFILESPEC.TAR QListing of archive QTotal of Q files listed, Q files in archive.Q-rwxrwxrwxQ!AS !4UL/!3UL!10UL !AS !AS<^ԭ PAS$HANDLERmЬP` `(`ЏЬ ݏN LIB_OUT_ITEMЏЬݏL LIB_OUT_ITEM؟ LIB_ITEM_LIST谏쟭 SYS$GETDVIWP LIB_SIGIFERR^ԭ PAS$HANDLERmV^W( mԞPPP䟭 CLI_PRESENTP MATCH_NODECOLLECT_MATCHES MATCH_ALL MATCH_NODE찏AЏ% FULL_ARCHIVE_SPEC蟭ЬP`ܰޞ LIB_PARSEFULL_ARCHIVE_SPEC FULL_ARCHIVE_SPEC(FULL_ARCHIVE_SPECFULL_ARCHIVE_SPEC3Џ잭ݏN LIB_OUT_ITEMЏ잭ݏL LIB_OUT_ITEM̟ LIB_ITEM_LISTܰޞ SYS$GETDVIWP LIB_SIGIFERR蟭ݬOPEN_ARCHIVE_INPUTARCHIVEFIND_FILE_SPECFULL_ARCHIVE_SPECP`(`ԭ\蟭ԟЏ% ؞ܟARCHIVEP`INSPECT_HEADERPPPX<FULL_ARCHIVE_SPECT<FULL_ARCHIVE_SPECU9:UFULL_ARCHIVE_SPEC3RRRURRUPP UPPTFULL_ARCHIVE_SPEC3TTTFULL_ARCHIVE_SPECPU`(d`X<FULL_ARCHIVE_SPECPPYYW^^W(YFULL_ARCHIVE_SPEC3nYذWܞح̞TAR__BADARCHIVEȚLIB$STOPR PAS$FV_OUTPUTPAS$WRITE_STRINGA PAS$FV_OUTPUTPAS$WRITE_STRINGFULL_ARCHIVE_SPEC3FULL_ARCHIVE_SPEC PAS$FV_OUTPUTPAS$WRITE_STRING PAS$FV_OUTPUTPAS$WRITE_STRING PAS$FV_OUTPUT PAS$WRITELN21\ MATCH_NODEMATCH_FILESPECP蟭ԟVܟARCHIVE]QSCAN_TO_NEXT_HEADER1ARCHIVEX蟭ԟЏ% ؞ܟARCHIVEP`INSPECT_HEADER PAS$HANDLER LIB_OUT_ITEM LIB_ITEM_LIST SYS$GETDVIW LIB_SIGIFERR tTAR_LIST CLI_PRESENTTARTAR 5-Jul-1990 11:42:04PAS$ENVIRONMENT_TIME  MATCH_NODE COLLECT_MATCHES  MATCH_ALL %FULL_ARCHIVE_SPEC LIB_PARSE OPEN_ARCHIVE_INPUT ARCHIVE FIND_FILE_SPEC INSPECT_HEADERTAR__BADARCHIVELIB$STOP PAS$FV_OUTPUTPAS$WRITE_STRING PAS$WRITELN2 MATCH_FILESPEC SCAN_TO_NEXT_HEADERPPPXX1qխ PAS$FV_OUTPUT PAS$WRITELN2a PAS$FV_OUTPUTPAS$WRITE_STRINGݭ PAS$FV_OUTPUTPAS$WRITE_INTEGERF PAS$FV_OUTPUTPAS$WRITE_STRING\ PAS$FV_OUTPUTPAS$WRITE_INTEGER0 PAS$FV_OUTPUTPAS$WRITE_STRING PAS$FV_OUTPUT PAS$WRITELN2ARCHIVE PAS$CLOSE2Ό^ԭ PAS$HANDLERmQVPммXмYQ^ZЬ[P1( l[PP ܟ PAS$READV_OCTЭWt[[ ԟ PAS$READV_OCTЭ[PPI IQQYI QR Q RR-bP YdЬYɜYYYGl͐(n͒Ь P<`YYZ^^Z(YnYܰZܭ؟ DELTA_SECONDSX͌UNIX_TIME_TO_STR͎͌Э[WЏ ( 螭譨Џ% ͐ԭ LIB$SYS_FAOP LIB_SIGIFERR͒͐ PAS$FV_OUTPUTPAS$WRITE_STRING PAS$FV_OUTPUT PAS$WRITELN2 ݭ PAS$FV_OUTPUTPAS$WRITE_INTEGER PAS$FV_OUTPUTPAS$WRITE_CHARЬ \l PAS$FV_OUTPUTPAS$WRITE_STRING PAS$FV_OUTPUT PAS$WRITELN2֦Q]QQQeQPQQQ'DQQ%Q#QQ8QB QQgQQ Q QQFPAS$WRITE_INTEGER PAS$CLOSE2 PAS$READV_OCT I  DELTA_SECONDS UNIX_TIME_TO_STR LIB$SYS_FAOPAS$WRITE_CHARz$CODEf > <ܺ$CODEzFIND_DEVICE_STRUCTUREtTAR_LIST\ LIST_FILE*[TAR]TAR_LIST.PAS;1+,. / 4O -Ws0123KPWO 56 o7o8p9GHJ-{ TAR_LIST.PAS - Routines to support TAR/LIST!E! Copyright: Copyright 1989,1990, Victoria College Computer Services.7! All rights reserved except those granted in the file6! AAAREADME.1ST, which is distributed with this file.!(! Author: Tim Cook (timcc@viccol.edu.au)}2[INHERIT ('SYS$LIBRARY:STARLET', 'VCDEFS', 'TAR'), %INCLUDE 'TAR_VERSION.PAS'] MODULE list ;$ PROCEDURE find_device_structure (# device_name : filespec_type ;N VAR dir : [UNSAFE] integer ; { Device is directory-structured }O VAR sdi : [UNSAFE] integer) ; { Device is single-dir structured } BEGIN@ lib_sigiferr ($GETDVIW (,, device_name, lib_item_list (0 lib_out_item (DVI$_DIR, %DESCR dir),8 lib_out_item (DVI$_SDI, %DESCR sdi)))) END ; [GLOBAL] PROCEDURE tar_list (7 VAR archive_filespec : [READONLY] filespec_type ; full : boolean) ; TYPE7 fixed_string = PACKED ARRAY [1..255] OF char ;2 fixed_string_ptr = RECORD CASE integer OF!0:( address : unsigned) ;*1:( pointer : ^fixed_string) END ; VAR$ file_spec : medium_string ; file_size : integer ; file_mtime : unsigned ;% file_mode : file_mode_type ; directory : boolean ;3 files_listed, files_in_archive : integer ;) directory_structured : integer ;0 single_directory_structured : integer ;$ more_in_archive : boolean ; PROCEDURE list_file (. VAR header_record : tar_record_type ; full : boolean ;3 VAR file_spec : [READONLY] filespec_type ; file_size : integer ; file_mtime : unsigned ;% file_mode : file_mode_type ;( directory : boolean := false) ; VAR6 prot_list : PACKED ARRAY [1..10] OF char ;& out_line : medium_string ;( uid_int, gid_int : integer ; BEGIN' WITH header_record DO BEGIN! IF full THEN BEGIN- prot_list := '-rwxrwxrwx' ;2 readv (uid.value, uid_int:oct) ;2 readv (gid.value, gid_int:oct) ;$ FOR i := 0 TO 8 DOK IF NOT file_mode.mask[i] THEN prot_list[10-i] := '-' ; IF file_mode.mask[10] THEN8 prot_list[1] := 'd' { Directory }C ELSE IF header_record.linkflag IN ['1', '2'] THEN4 prot_list[1] := 'l' ; { Link }" out_line := '' ;M lib_sigiferr (LIB$SYS_FAO ('!AS !4UL/!3UL!10UL !AS !AS',,F out_line, %STDESCR (prot_list), uid_int, gid_int, file_size,M %STDESCR (UNIX_time_to_str (file_mtime, delta_seconds)),- %STDESCR (file_spec))) ;( writeln (out_line) END ELSE< writeln (file_size:10, space, file_spec) ;9 files_listed := files_listed + 1 END END ; BEGIN { tar_list }* IF cli_present (filespec_kt) THEN( collect_matches (match_node) ELSE BEGIN match_all := true ;# match_node := nil END ;B lib_parse (archive_filespec, full_archive_spec, '.TAR') ;J find_device_structure ((full_archive_spec), directory_structured,* single_directory_structured) ;. open_archive_input (archive_filespec,B share := NOT (single_directory_structured)::boolean) ;8 full_archive_spec := find_file_spec (archive) ; files_listed := 0 ; files_in_archive := 0 ;K more_in_archive := inspect_header (archive^, file_spec, file_size,/ file_mtime, file_mode, directory) ;4 IF NOT (directory_structured)::boolean THEN> full_archive_spec := substr (full_archive_spec, 1,2 index (full_archive_spec, colon)) ;$ IF NOT more_in_archive THENI LIB$STOP (tar__badarchive, 1, %STDESCR (full_archive_spec)) ;I writeln (crlf, 'Listing of archive ', full_archive_spec, crlf) ;' WHILE more_in_archive DO BEGIN6 files_in_archive := files_in_archive + 1 ;: IF match_filespec (file_spec, match_node) THENK list_file (archive^, full, file_spec, file_size, file_mtime,) file_mode, directory) ;- scan_to_next_header (file_size) ;! IF eof (archive) THEN' more_in_archive := false ELSEF more_in_archive := inspect_header (archive^, file_spec,D file_size, file_mtime, file_mode, directory) END ;+ IF files_listed > 0 THEN writeln ;A writeln ('Total of ', files_listed:1, ' files listed, ',7 files_in_archive:1, ' files in archive.') ; close (archive) ; END ; END.*[TAR]TAR_VERSION.PAS;1+,./ 4EL-Ws0123KPWO56 ^o7@~o8@p9GHJE{ TAR_VERSION.PAS - Provides an IDENT attribute to denote TAR version!E! Copyright: Copyright 1989,1990, Victoria College Computer Services.7! All rights reserved except those granted in the file6! AAAREADME.1ST, which is distributed with this file.!(! Author: Tim Cook (timcc@viccol.edu.au)}IDENT ('T1.1-2')*[TAR]TAR_WRITE.OBJ;1+,C./ 4-Ws0123KPWO56`#vt7t80u9GHJ&4WRITET1.1-2 5-Jul-1990 11:43 5-Jul-1990 11:43VAX Pascal V3.9-289 WRITEPFILESPEC.dir Q.DIR;1Q.TAR*.*;*Q*.*;SYS$SCRATCH:$^^%Џ% ЬGET_STRING_FROM_STORAGEЬP-` nW1W1X1-%% nЏ% %찏- CLI$GET_VALUEPFAILUREP1XW1!!%Џ% Ь%䰏%蟭 LIB$FIND_FILEPYYP1YЬP<`QQZZ^^[(ZnZ[ TAR__NOFILES LIB$SIGNAL%LIB$FIND_FILE_END%(n%1WX1W%[Ы Y<%PPZZ^^V(Z%nZܰVܭ TAR__PARSELIB$STOPP1(PPʂ11|X1KWP$^^RP19P$,4P,QT,XSYS$OPENPVVSUCCESSP16 }\ |D} | SYS$CONNECTPV㚼PP1 < TAR__RECTOOLONGЭЬP<`QQWWR^^X(WnWܰXܭ TAR__OPENINLIB$STOP  VP^\<PPP P P P P\P@PP PΘ^ԭ PAS$HANDLERmЬP` `͜(`͞мVW}XмY Z$^[(DEFAULT_HEADERټ Z蟭X䟭-P蟭 PAS$OCT(խ୮Ь P , dV䟭 PAS$OCT VVV[^^X( n( cV2 V(VhЬ P  , | DELTA_SECONDSVMS_TO_UNIX_TIMEP PAS$OCT XXX[^^[( n( cX2 X(XkЬ P  , YW͘͜ UNIX_FILESPEC͘͜(͚͘͞Z<͜Z9Z͞RRRZRRZZ͜<͜Z<͜P͝W ZPWW /gW<͜PWPWWZ ZdYЬ [<͜X͝V ZXVV fIWPЬ P(hЬ P Ь P ݬ GET_STRING_FROM_STORAGE CLI$GET_VALUEFAILURE LIB$FIND_FILE TAR__NOFILES LIB$SIGNALLIB$FIND_FILE_END TAR__PARSELIB$STOPSYS$OPENSUCCESS SYS$CONNECTTAR__RECTOOLONG TAR__OPENIN PAS$HANDLERTARTAR 5-Jul-1990 11:42:04PAS$ENVIRONMENT_TIME DEFAULT_HEADERPAS$OCT  DELTA_SECONDS VMS_TO_UNIX_TIME  UNIX_FILESPEC CHECKSUMPAS$WRITEV_STRING  LAST_CHARPAS$PUTCHECKSUMP PAS$OCT2PAS$WRITEV_STRINGЬ P , Ь \̚|^ԭ PAS$HANDLERmPP  < P P PЬQ @R< SRSRT LAST_CHARݬPAS$PUT LAST_CHAR LAST_CHAR  LAST_CHARPмQQ Q8Q2QQ-#QQ&]QQQ!Q@Q QQQ"0QLqQ /QQ%QQQQ#uQ-?QQ4Q+QQ.,QQ!QQQCQQ;QQ.QQQQQQFQBQQ?QQNQ8@Q$QQQQQ ,QQQ LQQ8UQ=QQ Q Q3Q QQQ QiQ Q QdMQf*QQQbQOQQ,{QxBQu'QQgQeQQQmUQY Q9&Q<UQRQhQ"Q0cQQQmRQV Q-"QEQ"Q0bQQQjUQY QX8TAR__TOTAPPEND TAR__TOTWRITE I ARCHIVE_TEMP_OPEN  ARCHIVE_TEMP PAS$CLOSE2SYS$GET TAR__ERRREAD SYS$REWIND PAS$RESET2PAS$GET_UNLOCK!$CODE&$LOCAL A A$CODE!$LOCAL&X ANOTHER_FILECOLLECT_FILESPECS\OPEN_INPUT_FILEOPEN_DIRECTORYVMS_TO_UNIX_PROTECTIONh BUILD_HEADER WRITE_ARCHIVEh IS_DIRECTORYh  TAR_WRITE@h LOAD_DIRECT$LOAD_AFTER_SCANLOAD_FROM_TEMP94LOAD_DIRECTORY4x  TAR_APPEND*[TAR]TAR_WRITE.PAS;1+, .0/ 4O0/-Ws0123KPWO056o7io8imp9GHJ^>{ TAR_WRITE.PAS - Routines to support TAR/WRITE and TAR/APPEND!E! Copyright: Copyright 1989,1990, Victoria College Computer Services.7! All rights reserved except those granted in the file6! AAAREADME.1ST, which is distributed with this file.!(! Author: Tim Cook (timcc@viccol.edu.au)}9[INHERIT ('SYS$LIBRARY:STARLET', 'VCDEFS', 'TAR', 'DSS'), %INCLUDE 'TAR_VERSION.PAS']MODULE write ; CONST in_buffer_size = 8192 ; TYPEA in_buffer_type = PACKED ARRAY [1..in_buffer_size] OF char ; VAR in_fab : FAB$TYPE ;2 in_xabdat, in_xabfhc, in_xabpro : XAB$TYPE ; in_rab : RAB$TYPE ;" in_buffer : in_buffer_type ;. input_filespec_default : filespec_type ;M file_spec, default_spec, result_spec : VARYING [NAM$C_MAXRSS] OF char ;% record_format : lib_byte_type ;8 max_record_size, first_free_byte : lib_word_type ; eof_block : unsigned ;& filespecs_in_storage : boolean ; VALUE in_fab := zero ; in_xabdat := zero ; in_xabfhc := zero ; in_xabpro := zero ; in_rab := zero ;% filespecs_in_storage := false ; FUNCTION another_file (0 VAR next_file : filespec_type) : boolean ; VAR4 context : [STATIC] lib_fab_pointer := nil ;2 filespec : [STATIC] filespec_type := '' ; status : sts_type ; more : boolean ; BEGIN+ IF filespecs_in_storage THEN BEGIN1 get_string_from_storage (next_file) ;/ another_file := next_file <> '' END ELSE BEGIN more := true ; WHILE more DO BEGIN$ IF filespec = '' THENO IF failure (CLI$GET_VALUE (filespec_kt, filespec)) THEN BEGIN$ more := false ;. another_file := false END ELSE ELSE BEGINH status := LIB$FIND_FILE (filespec, next_file, context,. input_filespec_default) ; CASE status OF/ RMS$_NMF, RMS$_FNF : BEGIN1 IF status = RMS$_FNF THENO LIB$SIGNAL (tar__nofiles, 1, %STDESCR (next_file)) ;5 LIB$FIND_FILE_END (context) ;, filespec := '' END ;( RMS$_NORMAL : BEGIN. another_file := true ;+ more := false END ;$ OTHERWISE BEGIN/ another_file := false ;M LIB$STOP (tar__parse, 1, %STDESCR (filespec), status,H context^.FAB$L_STV) END END END END END END ; PROCEDURE collect_filespecs (" VAR prefix : filespec_type ;* retain_version : boolean := false) ; VAR$ selection : filespec_type ; i, j : integer ;+ first_time, more, done : boolean ; status : sts_type ; BEGIN first_time := true ; more := true ;0 WHILE another_file (selection) DO BEGIN/ put_string_in_storage (selection) ;B selection := UNIX_filespec (selection, absolute_mode,, retain_version) ;$ IF first_time THEN BEGINM { Find a first prefix, but ensure the base file name is'nt part of it }( i := length (selection) ; done := false ;& WHILE NOT done DO BEGIN IF i = 0 THEN! done := true1 ELSE IF selection[i] = '/' THEN! done := true ELSE% i := i - 1 END ;3 prefix := substr (selection, 1, i) ;& first_time := false ENDC ELSE BEGIN { find a common prefix to the filenames }? j := min (length (selection), length (prefix)) ; i := 1 ; done := false ;& WHILE NOT done DO BEGIN! IF (i > j) THEN! done := true: ELSE IF (selection[i] <> prefix[i]) THEN! done := true ELSE% i := i + 1 END ;/ prefix.length := i - 1 END END ; rewind_storage ;? { Back up enough to ensure that the prefix ends with a '/' } i := length (prefix) ; done := false ; WHILE NOT done DO BEGIN IF i = 0 THEN done := true( ELSE IF prefix[i] = '/' THEN done := true ELSE i := i - 1 END ;! prefix.length := i END ; FUNCTION open_input_file (% VAR file_spec : filespec_type ;2 VAR record_format : [UNSAFE] lib_byte_type ;0 VAR record_size : [UNSAFE] lib_word_type ;) VAR eof_block : [UNSAFE] unsigned ;4 VAR first_free_byte : [UNSAFE] lib_word_type ;6 VAR modification_date : [UNSAFE] lib_date_type ;; VAR protection : [UNSAFE] lib_word_type) : sts_type ; VAR status : sts_type ; BEGIN( in_fab.FAB$B_BID := FAB$C_BID ;( in_fab.FAB$B_BLN := FAB$C_BLN ;# in_fab.FAB$V_GET := true ;& in_fab.FAB$V_SHRGET := true ;3 in_fab.FAB$L_XAB := iaddress (in_xabdat) ;8 in_fab.FAB$L_FNA := iaddress (file_spec.body) ;@ in_fab.FAB$B_FNS := (file_spec.length)::lib_byte_type ;+ in_xabdat.XAB$B_COD := XAB$C_DAT ;. in_xabdat.XAB$B_BLN := XAB$C_DATLEN ;6 in_xabdat.XAB$L_NXT := iaddress (in_xabfhc) ;+ in_xabfhc.XAB$B_COD := XAB$C_FHC ;. in_xabfhc.XAB$B_BLN := XAB$C_FHCLEN ;6 in_xabfhc.XAB$L_NXT := iaddress (in_xabpro) ;+ in_xabpro.XAB$B_COD := XAB$C_PRO ;. in_xabpro.XAB$B_BLN := XAB$C_PROLEN ;# status := $OPEN (in_fab) ;' IF success (status) THEN BEGIN/ record_format := in_fab.FAB$B_RFM ;- record_size := in_fab.FAB$W_MRS ;. eof_block := in_xabfhc.XAB$L_EBK ;4 first_free_byte := in_xabfhc.XAB$W_FFB ;G modification_date := (in_xabdat.XAB$Q_RDT)::lib_date_type ;/ protection := in_xabpro.XAB$W_PRO ;+ in_rab.RAB$B_BID := RAB$C_BID ;+ in_rab.RAB$B_BLN := RAB$C_BLN ;7 in_rab.RAB$B_MBC := tar_multi_block_count ;M { Multi-block count; specifies how many blocks of a sequential0 file are read per disk access }3 in_rab.RAB$L_FAB := iaddress (in_fab) ;) status := $CONNECT (in_rab) ;+ in_rab.RAB$B_RAC := RAB$C_SEQ ;6 in_rab.RAB$L_UBF := iaddress (in_buffer) ;! CASE record_format OF: FAB$C_UDF : { undefined, or stream binary }7 in_rab.RAB$W_USZ := tar_record_size ; FAB$C_FIX :6 IF record_size > in_buffer_size THEND LIB$STOP (tar__openin, 1, %STDESCR (file_spec),D tar__rectoolong, 1, (record_size)::unsigned) ELSE6 in_rab.RAB$W_USZ := record_size ;J FAB$C_VAR, FAB$C_VFC, FAB$C_STM, FAB$C_STMLF, FAB$C_STMCR :8 in_rab.RAB$W_USZ := size (in_buffer) ; END END ;( open_input_file := status END ; FUNCTION open_directory (% VAR file_spec : filespec_type ;6 VAR modification_date : [UNSAFE] lib_date_type ;; VAR protection : [UNSAFE] lib_word_type) : sts_type ; VAR status : sts_type ; BEGIN( in_fab.FAB$B_BID := FAB$C_BID ;( in_fab.FAB$B_BLN := FAB$C_BLN ;# in_fab.FAB$V_GET := true ;& in_fab.FAB$V_SHRGET := true ;3 in_fab.FAB$L_XAB := iaddress (in_xabdat) ;8 in_fab.FAB$L_FNA := iaddress (file_spec.body) ;@ in_fab.FAB$B_FNS := (file_spec.length)::lib_byte_type ;+ in_xabdat.XAB$B_COD := XAB$C_DAT ;. in_xabdat.XAB$B_BLN := XAB$C_DATLEN ;6 in_xabdat.XAB$L_NXT := iaddress (in_xabpro) ;+ in_xabpro.XAB$B_COD := XAB$C_PRO ;. in_xabpro.XAB$B_BLN := XAB$C_PROLEN ;# status := $OPEN (in_fab) ;' IF success (status) THEN BEGING modification_date := (in_xabdat.XAB$Q_RDT)::lib_date_type ;/ protection := in_xabpro.XAB$W_PRO ;! $CLOSE (in_fab) END ;' open_directory := status END ;$ FUNCTION VMS_to_UNIX_protection (- VMS_protection : file_protection_type ;0 directory : boolean := false) : unsigned ; VAR return : unsigned ; BEGIND { Note that, because most files that have READ set in VMS also, have EXECUTE set, I ignore EXECUTE }% WITH VMS_protection DO BEGINI IF NOT owner.noread THEN return := 256 { u+r } ELSE return := 0 ;I IF NOT owner.nowrite THEN return := return + 128 ; { u+w }I IF NOT group.noread THEN return := return + 32 ; { g+r }I IF NOT group.nowrite THEN return := return + 16 ; { g+w }I IF NOT world.noread THEN return := return + 4 ; { o+r }I IF NOT world.nowrite THEN return := return + 2 ; { o+w }# IF directory THEN BEGIN> return := return + 1024 ; { set the 'd' bit }F { Note that the EXECUTE privilege on a directory in VMS is7 not equivalent to it's namesake in UNIX }I IF NOT owner.noread THEN return := return + 64 ; { u+x }I IF NOT group.noread THEN return := return + 8 ; { g+x }I IF NOT world.noread THEN return := return + 1 END ;{ o+x } END ;/ VMS_to_UNIX_protection := return END ; PROCEDURE build_header (% head_filespec : filespec_type ; filesiz : integer ;( VAR out_header : tar_record_type ; map_mode : map_mode_type ;) modification_date : lib_date_type ;) protection : file_protection_type ;$ prefix_length : integer := 0 ;$ directory : boolean := false ;* retain_version : boolean := false) ; VAR i : integer ;( temp_filespec : medium_string ;% temp_string : small_string ; BEGIN' out_header := default_header ; temp_string := oct (C VMS_to_UNIX_protection (protection, directory), 6, 3) ;/ out_header.mode.value := temp_string ;6 temp_string := oct (filesiz, 11, 1) + space ;( out_header.siz := temp_string ; temp_string :=N oct (VMS_to_UNIX_time (modification_date, delta_seconds), 11, 1) + space ;* out_header.mtime := temp_string ;A temp_filespec := UNIX_filespec (head_filespec, map_mode,, prefix_length, retain_version) ;< IF directory THEN BEGIN { Change ".dir" to "/" }C temp_filespec.length := index (temp_filespec, '.dir') ;> temp_filespec[temp_filespec.length] := slash END ;0 FOR i := 1 to length (temp_filespec) DO4 out_header.name[i] := temp_filespec[i] ;F { I had to do that, to prevent Pascal from blank-padding it }. out_header.chksum.value := ' ' ;/ out_header.chksum.fill_null := space ;0 out_header.chksum.fill_space := space ;B writev (temp_string, oct (checksum (out_header), 6, 1)) ;1 out_header.chksum.value := temp_string ;O out_header.chksum.fill_space := null ; { That's how DYNIX tar does it} END ; PROCEDURE write_archive ($ VAR file_buf : tar_file_type ;' VAR out_record : in_buffer_type ;2 VAR record_length : [UNSAFE] lib_word_type ;! add_lf : boolean := true) ; VAR i : lib_word_type ; BEGIN IF add_lf THEN8 IF record_length < in_buffer_size THEN BEGIN3 record_length := record_length + 1 ;4 out_record[record_length] := lf END ;- FOR i := 1 TO record_length DO BEGIN5 IF last_char = tar_record_size THEN BEGIN put (file_buf) ;! last_char := 1 END ELSE+ last_char := last_char + 1 ;< file_buf^.data[last_char] := out_record[i] END ; END ; FUNCTION is_directory (+ filespec : filespec_type) : boolean ; BEGINJ { A simple test, but I don't feel like looking at file-headers (thisK is unsupported). If someone plays around with the use of '.DIR;1', it's their fault. } is_directory :=J substr (filespec, filespec.length - 5, 6) = dot_dir_1_kt END ;! [GLOBAL] PROCEDURE tar_write (7 VAR archive_filespec : [READONLY] filespec_type ; confirm : boolean ; scan : boolean ; map_mode : map_mode_type ;$ appending : boolean := false ;* retain_version : boolean := false) ; VAR more : boolean ;' tar_record : tar_record_type ;' current_file : filespec_type ; file_size : integer ; no_records : integer ;" files_written : integer ;6 write_message, write_dir_message : sts_type ;N record_format : lib_byte_type ; { These all correspond to the }> record_length : lib_word_type ; { input file } eof_block : integer ;* first_free_byte : lib_word_type ;, modification_date : lib_date_type ;, protection : file_protection_type ; status : sts_type ;4 prefix, pending_directory : filespec_type ;J PROCEDURE load_direct ; { Directly loads a fixed record length }; BEGIN { or stream binary file }B file_size := (eof_block - 1) * 512 + first_free_byte ;I { The test below is for cases where the first_free_byte value does notO point to the first byte in a logical record (I have seen this in .EXE's) }- IF record_format = FAB$C_FIX THEN6 IF file_size REM record_length > 0 THENB file_size := (file_size DIV record_length + 1) *$ record_length ;F build_header (current_file, file_size, archive^, map_mode,? modification_date, protection, length (prefix),, retain_version) ;2 put (archive) ; { writes header }% status := $GET (in_rab) ;+ WHILE success (status) DO BEGINL write_archive (archive, in_buffer, in_rab.RAB$W_RSZ, false) ;- no_records := no_records + 1 ;, status := $GET (in_rab) END ;& IF status <> RMS$_EOF THENH LIB$STOP (tar__errread, 3, 0, 0, %STDESCR (current_file),- status, in_rab.RAB$L_STV) ;E IF file_size > 0 THEN { If non-empty file }@ put (archive) ; { like a flush } END ;O PROCEDURE load_after_scan ; { Scans a var-len file for size then loads } BEGIN% status := $GET (in_rab) ;+ WHILE success (status) DO BEGIN> file_size := file_size + in_rab.RAB$W_RSZ + 1 ;, status := $GET (in_rab) END ;& IF status <> RMS$_EOF THENH LIB$STOP (tar__errread, 3, 0, 0, %STDESCR (current_file),- status, in_rab.RAB$L_STV) ;F build_header (current_file, file_size, archive^, map_mode,? modification_date, protection, length (prefix),, retain_version) ;2 put (archive) ; { writes header }( status := $REWIND (in_rab) ;$ IF failure (status) THENH LIB$STOP (tar__errread, 3, 0, 0, %STDESCR (current_file),- status, in_rab.RAB$L_STV) ;% status := $GET (in_rab) ;+ WHILE success (status) DO BEGINE write_archive (archive, in_buffer, in_rab.RAB$W_RSZ) ; - no_records := no_records + 1 ;r, status := $GET (in_rab) END ;& IF status <> RMS$_EOF THENH LIB$STOP (tar__errread, 3, 0, 0, %STDESCR (current_file),- status, in_rab.RAB$L_STV) ;uE IF file_size > 0 THEN { If non-empty file } put (archive) ; END ; PROCEDURE load_from_temp ; BEGIN/ IF NOT archive_temp_open THEN BEGINiI open (archive_temp, history := NEW, disposition := DELETE,a. default := sys$scratch_kt) ;. archive_temp_open := true END ;$ rewrite (archive_temp) ;% status := $GET (in_rab) ;,+ WHILE success (status) DO BEGIN > file_size := file_size + in_rab.RAB$W_RSZ + 1 ;J write_archive (archive_temp, in_buffer, in_rab.RAB$W_RSZ) ;, status := $GET (in_rab) END ;& IF status <> RMS$_EOF THENH LIB$STOP (tar__errread, 3, 0, 0, %STDESCR (current_file),- status, in_rab.RAB$L_STV) ; E IF file_size > 0 THEN { If non-empty file }c# put (archive_temp) ; " reset (archive_temp) ;F build_header (current_file, file_size, archive^, map_mode,? modification_date, protection, length (prefix),, retain_version) ;2 put (archive) ; { writes header }1 WHILE NOT eof (archive_temp) DO BEGIN>0 read (archive_temp, tar_record) ;0 write (archive, tar_record) END ; END ;c PROCEDURE load_directory (. VAR directory_name : filespec_type) ; VAR) temp_string : medium_string ;  BEGIN: temp_string := directory_name + dot_dir_1_kt ; IF success (N open_directory (temp_string, modification_date, protection)) THEN BEGIN@ build_header (temp_string, 0, archive^, map_mode,? modification_date, protection, prefix.length,E& directory := true) ; put (archive) ;L LIB$SIGNAL (write_dir_message, 1, %STDESCR (temp_string)) END ELSEF LIB$STOP (tar__openin, 1, %STDESCR (temp_string)) END ; BEGIN { tar_write }$ IF NOT appending THEN BEGIN- creating_archive_output := true ;N< open (archive, archive_filespec, history := NEW,' default := dot_tar_kt) ;T rewrite (archive) ; . creating_archive_output := false ;+ write_message := tar__written ;f1 write_dir_message := tar__writdir END  ELSE BEGINo truncate (archive) ;, write_message := tar__appended ;4 write_dir_message := tar__appendir END ; files_written := 0 ;_" pending_directory := '' ; prefix := '' ; ' IF map_mode = prefix_mode THENr> IF CLI$PRESENT (filespec_kt) = CLI$_DEFAULTED THEN* map_mode := single_dir_mode ELSE BEGIN; collect_filespecs (prefix, retain_version) ;F1 filespecs_in_storage := true END ;, IF retain_version THEN'- input_filespec_default := '*.*;*'e ELSE . input_filespec_default := '*.*;' ; more := true ; 6 WHILE another_file (current_file) AND more DO5 IF is_directory (current_file) THEN BEGINE? current_file.length := current_file.length - 6 ;  IF confirm THEN3 pending_directory := current_filei ELSEf3 load_directory (current_file) ENDi ELSEG IF confirm_operation (option, current_file, NOT confirm, 5 set_this_false, more) THEN BEGINd6 IF pending_directory.length > 0 THEND IF pending_directory = substr (current_file, 1,9 pending_directory.length) THENN< load_directory (pending_directory) ;N open_input_file (current_file, record_format, record_length,C eof_block, first_free_byte, modification_date,r" protection) ;" last_char := 0 ;# no_records := 0 ;W" file_size := 0 ;A IF record_format IN [FAB$C_FIX, FAB$C_UDF] THENr load_direct ELSE! IF scan THEN ' load_after_scan ELSEt( load_from_temp ;6 files_written := files_written + 1 ;H LIB$SIGNAL (write_message, 2, %STDESCR (current_file),! file_size) ;i, { file built and written }- status := $CLOSE (in_fab) ;e* IF failure (status) THENF LIB$STOP (tar__close, 1, %STDESCR (current_file),3 status, in_fab.FAB$L_STV) ; & END ; { IF confirmed }" IF files_written > 0 THEN IF appending THEN < LIB$SIGNAL (tar__totappend, 1, files_written) ELSE= LIB$SIGNAL (tar__totwrite, 1, files_written) ;N% FOR i := 1 TO record_size DO;& archive^.data[i] := null ;K put (archive) ; put (archive) ; { emulate tar's personal eof }X( IF archive_temp_open THEN BEGIN9 close (archive_temp, disposition := DELETE) ;c, archive_temp_open := false END ; close (archive) ; END ; { tar_write }X" [GLOBAL] PROCEDURE tar_append (7 VAR archive_filespec : [READONLY] filespec_type ;P confirm : boolean ;I scan : boolean ; map_mode : map_mode_type ;* retain_version : boolean := false) ; VAR." archive_size : unsigned ; more, doit : boolean ;  fab : fab_pointer ; BEGIN { tar_append }i0 open_archive_input (archive_filespec) ;# fab := PAS$FAB (archive) ;bL IF (fab^.FAB$B_RFM <> FAB$C_FIX) OR (fab^.FAB$W_MRS <> record_size) THENN( LIB$STOP (tar__badarchive) ; more := true ;n WHILE more DO! IF eof (archive) THENy more := false ELSE1 IF is_valid_header (archive^) THENL- more := scan_to_next_headert ELSEb! more := false ;C doit := false ; IF eof (archive) THEN doit := true ELSEm+ IF checksum (archive^) = 0 THENd doit := true ;  IF doit THENZI tar_write ('', confirm, scan, map_mode, true, retain_version)c ELSEu( LIB$STOP (tar__badarchive) ; END ; { tar_append } END. tar__rectoolong, 1, (record_size)::unsigned) ELSE6 in_rab.RAB$W_USZ := record_size ;J FAB$C_VAR, FAB$C_VFC, FAB$C_STM, FAB$C_STMLF, FAB$C_STMCR :8 in_rab.RAB$W_USZ := size (in_buffer) ; END END ;( open_input_file := status END ; FUNCTION open_directory (% VAR file_spec : filespec_type ;6 VAR modification_date : [UNSAFE] lib_date_type ;; *[TAR]VAXCRTL.OPT;1+,./ 4-Ws0123KPWO56z3p7`x3p8`x8p9GHJSYS$SHARE:VAXCRTL/SHARE*[TAR]VCDEFS.OBJ;2+,./ 4-Ws0123KPWO569t7Ht84t9GHJ0VCLIB01 5-Jul-1990 11:41 5-Jul-1990 11:41VAX Pascal V3.9-289 VCLIBPм\\\\P<(^( ­^Э\ЭQ^S\(ac\(\ací^\\^^\\R^\Эܰذڟ CLI$PRESENTPP\^R\м\\\\\PQ\ SUCCESS < CLI_PRESENT CLI$PRESENT FAILURE$CODE H /, $CODE CLI_PRESENTxFAILURESUCCESS*[TAR]VCDEFS.PAS;1+, .$/ 4N$#-Ws0123KPWO$56 p7` 5p8` Ʀp9GHJ{.! VCDEFS.PAS - VCLIB definitions needed by TAR!D! This file contains all definitions needed by TAR when packaged forF! external distribution. When TAR is built locally, these definitionsD! come from SRC_VCLIB:VCLIB.PEN, but for the distribution package, IE! have extracted the needed definitions from the appropriate files inE! SRC_VCLIB: Any routines defined in here but not coded in here will/! be in appropriately named MACRO source files.!I! This file can be used to build an evironment and object file to be usedD! when building TAR, or it can be %INCLUDEd by TAR.PAS, or it can be ! /INSERTed into a help library.!! Tim Cook, 24-FEB-1989?!-------------------------------------------------------------->!} [INHERIT ('SYS$LIBRARY:STARLET'), ENVIRONMENT ('VCDEFS')] {!} MODULE vclib ; {!! From SRC_VCLIB:LIBDEF.PAS! 1 LIBDEFPAS2 CONST!} CONST lib_k_maxbyte = %xFF ; lib_k_maxword = %xFFFF ;# lib_k_maxlong = %xFFFFFFFF ;{2 TYPE!} TYPE sts_type = integer ; lib_lo_hi = (low, high) ;/ lib_byte_type = [BYTE] 0..lib_k_maxbyte ;/ lib_word_type = [WORD] 0..lib_k_maxword ;5 lib_signed_word_type = [WORD] -%x8000..%x7FFF ;' lib_long_type = [LONG] unsigned ;. lib_3byte_type = [BYTE(3)] 0..%xFFFFFF ;< lib_quad_type = [QUAD] ARRAY [low..high] OF unsigned ;: lib_signed_quad_type = [QUAD] RECORD CASE integer OF0:( lo : unsigned ; hi : integer) ;21:( value : [QUAD] PACKED SET OF 0..63) END ;, lib_date_type = lib_signed_quad_type ;- prv_type = [QUAD] PACKED SET OF 0..63 ;/ lib_long_set_type = [LONG] SET OF 0..31 ; lib_sigargs_type = RECORD! param_count : unsigned ; condition : sts_type ;4 parameter : ARRAY [1..20] OF unsigned END ; lib_mechargs_type = RECORD! param_count : unsigned ;) stack_frame_address : unsigned ;' stack_frame_depth : unsigned ; r0, r1 : unsigned END ;# lib_fab_pointer = ^FAB$TYPE ; lib_numtim_type = RECORD year, month, day,@ hour, minute, second, hundredth : lib_word_type ; END ; lib_item_type = RECORD( buffer_length : lib_word_type ;$ item_code : lib_word_type ;) buffer_address : lib_long_type ;/ retlength_adress : lib_long_type END ;% lib_extended_item_type = RECORD item : lib_item_type ;4 buffer : PACKED ARRAY [1..80] OF char END ;; lib_item_list_type = ARRAY [1..85] OF lib_item_type ; fab_pointer = ^FAB$TYPE ; rab_pointer = ^RAB$TYPE ; nam_pointer = ^NAM$TYPE ;< nam_rs_type = PACKED ARRAY [1..NAM$C_MAXRSS] OF char ;# nam_rsa_type = ^nam_rs_type ; xab_pointer = ^XAB$TYPE ;{2 DEC_Routines!}4 [ASYNCHRONOUS,EXTERNAL] FUNCTION lib$create_dir (H directory_spec : [CLASS_S] PACKED ARRAY [l1..u1:integer] OF char ;? %REF owner_UIC : [TRUNCATE,UNSAFE] unsigned := %IMMED 0 ;C %REF protection_enable : [UNSAFE] lib_word_type := %IMMED 0 ;B %REF protection_value : [UNSAFE] lib_word_type := %IMMED 0 ;9 %REF maximum_versions : lib_word_type := %IMMED 0 ;> %REF relative_volume_number : lib_word_type := %IMMED 0)! : sts_type ; external ;{/! Now I convert to a H_FLOAT and divide instead@! [ASYNCHRONOUS,EXTERNAL] FUNCTION lib$cvt_from_internal_time (!! %REF operation : unsigned ;%! VAR resultant_time : unsigned ;;! %REF input_time : [UNSAFE] lib $~VMS-TAR-11.32256 Ws[TAR]VCDEFS.PAS;1N$8_date_type := %IMMED 0) ! : sts_type ; external ;!! Convert to H_FLOAT and multiply4! [ASYNCHRONOUS,EXTERNAL] FUNCTION lib$cvt_vectim (2! %REF input_time : [UNSAFE] lib_numtim_type ;L! VAR resultant_time : [UNSAFE] lib_date_type) : sts_type ; external ; }3 [ASYNCHRONOUS,EXTERNAL] FUNCTION lib$find_file (B filespec : [CLASS_S] PACKED ARRAY [l1..u1:integer] OF char ;C %DESCR resultant_filespec : [VOLATILE] VARYING [n1] OF char ;0 VAR context : [VOLATILE] lib_fab_pointer ; default_filespec :F [CLASS_S] PACKED ARRAY [l3..u3:integer] OF char := %IMMED 0 ; related_filespec :F [CLASS_S] PACKED ARRAY [l4..u4:integer] OF char := %IMMED 0 ;: VAR status_value : [VOLATILE] unsigned := %IMMED 0 ;; flags : unsigned := %IMMED 0) : sts_type ; external ;7 [ASYNCHRONOUS,EXTERNAL] FUNCTION lib$find_file_end (< VAR context : lib_fab_pointer) : sts_type ; external ;3 [ASYNCHRONOUS,EXTERNAL] FUNCTION lib$get_input (- %DESCR get_str : VARYING [n1] OF char ;L prompt : [CLASS_S] PACKED ARRAY [l1..u1:integer] OF char := %IMMED 0 ;F VAR out_len : lib_word_type := %IMMED 0) : sts_type ; external ;0 [ASYNCHRONOUS,EXTERNAL] FUNCTION lib$getjpi (& %REF item_code : lib_word_type ;- VAR process_id : unsigned := %IMMED 0 ; process_name :F [CLASS_S] PACKED ARRAY [l1..u1:integer] OF char := %IMMED 0 ;; VAR resultant_value : [UNSAFE] unsigned := %IMMED 0 ;B %DESCR resultant_string : VARYING [n1] OF char := %IMMED 0 ;7 VAR resultant_length : lib_word_type := %IMMED 0)! : sts_type ; external ;{! I now use lib$subx instead3! [ASYNCHRONOUS,EXTERNAL] FUNCTION lib$sub_times (4! %REF time_1, time_2 : [UNSAFE] lib_date_type ;K! VAR resultant_time : [UNSAFE] lib_date_type) : sts_type ; external ;}. [ASYNCHRONOUS,EXTERNAL] FUNCTION lib$subx (H %REF minuend_array : [UNSAFE] ARRAY [l1..u1:integer] OF unsigned ;K %REF subtrahend_array : [UNSAFE] ARRAY [l2..u2:integer] OF unsigned ; %REF difference_array :? [UNSAFE,VOLATILE] ARRAY [l3..u3:integer] OF unsigned ;F %REF array_length : integer := %IMMED 0) : sts_type ; external ;1 [ASYNCHRONOUS,EXTERNAL] FUNCTION lib$sys_fao (A ctr_str : [CLASS_S] PACKED ARRAY [l1..u1:integer] OF char ;0 %REF out_len : lib_word_type := %IMMED 0 ;- %DESCR out_buf : VARYING [n1] OF char ;9 %IMMED p : [LIST] unsigned) : sts_type ; external ;1 [ASYNCHRONOUS,EXTERNAL] PROCEDURE lib$signal (, %IMMED condition : [UNSAFE] sts_type ;> %IMMED parameters : [UNSAFE,LIST] unsigned) ; external ;/ [ASYNCHRONOUS,EXTERNAL] PROCEDURE lib$stop (, %IMMED condition : [UNSAFE] sts_type ;? %IMMED parameters : [UNSAFE,LIST] unsigned) ; external ;{!! From nowhere in particular! 1 SYSDEFPAS2 DEC_Routines!}3 [ASYNCHRONOUS,EXTERNAL] FUNCTION SYS$SETDFPROT (5 %REF new_def_prot : lib_word_type := %IMMED 0 ;L VAR cur_def_prot : lib_word_type := %IMMED 0) : sts_type ; external ;{!! Again from nowhere! 1 SHELLDEFPAS2 DEC_RoutinesLSHELL$MATCH_WILD is an entry point contained in SYS$LIBRARY:VAXCRTL.EXE (andKpresumably .OLB). I understand that it is part of DEC/Shell, a DEC versionKof the System 7 Bourne shell for VMS. I haven't found any documentation onDit, but have discovered how to use it through a few guesses and someexperimentation.!}6 [EXTERNAL,ASYNCHRONOUS] FUNCTION SHELL$MATCH_WILD (> %REF cand_spec : PACKED ARRAY [l1..u1:integer] OF char ;> %REF match_spec : PACKED ARRAY [l2..u2:integer] OF char) : boolean ; external ;{!! From SRC_VCLIB:CLIDEF.PAS! 1 CLIDEFPAS2 CONST!} CONST CLI$_DEFAULTED = 261409 ;{2 DEC_Routines!}1 [ASYNCHRONOUS,EXTERNAL] FUNCTION cli$present (> name : [CLASS_S] PACKED ARRAY [l1..u1:integer] OF char ) : sts_type ; external ;3 [ASYNCHRONOUS,EXTERNAL] FUNCTION cli$get_value (@ name : [CLASS_S] PACKED ARRAY [l1..u1 : integer] OF char ;D %DESCR retbuf : VARYING [n2] OF char) : sts_type ; external ;{!6! From SRC_VCLIB:OTSDEF.PAS (which does not yet exist)! 1 OTSDEFPAS2 DEC_Routines!}2 [ASYNCHRONOUS,EXTERNAL] FUNCTION ots$cvt_ti_l (F input_string : [CLASS_S] PACKED ARRAY [l1..u1:integer] OF char ;+ VAR output_value : [UNSAFE] integer ;3 output_value_size : [TRUNCATE] integer := 4 ;; flags_value : unsigned := 0) : sts_type ; external ;{!! From SRC_VCLIB:STRDEF.PAS! 1 STRDEFPAS2 DEC_Routines!}4 [ASYNCHRONOUS,EXTERNAL] FUNCTION str$match_wild (B cand_str : [CLASS_S] PACKED ARRAY [l1..u1:integer] OF char ;D pattern_str : [CLASS_S] PACKED ARRAY [l2..u2:integer] OF char)! : sts_type ; external ;{!! From SRC_VCLIB:PASMSG.PAS!1 PASMSG!}CONST$ %INCLUDE 'SYS$LIBRARY:PASDEF.PAS'VAR3 PAS$_FACILITY : [EXTERNAL,VALUE] sts_type ;{!! From SRC_VCLIB:LIBITMLST.DEC!1 LIB_ITEM_LIST FUNCTIONAL DESCRIPTION:C Builds an item list in its own static storage, and returns theE address of the item list. This routine is designed to be calledG directly from the parameter list of system services such as $MOUNTK $GETDVI, $GETJPI, and $GETSYI (see PASCAL DECLARATION for an example).A CALLING SEQUENCE: item_list_address.rr.r = (item.rr.r[,...]) IMPLICIT INPUTS: None. IMPLICIT OUTPUTS: None. SIDE EFFECTS: None. 2 ParametersL item -- items for inclusion in the item list. The best way to to generate5 these is with LIB_IN_ITEM and LIB_OUT_ITEM.2 Completion_Status, none -- does not return any status values.2 PASCAL_Definition!}K [EXTERNAL] FUNCTION lib_item_list (item : [UNSAFE,LIST] lib_item_type) :& lib_item_list_type ; external ;{3 Calling_Example@[INHERIT ('STARLET_PEN','VCLIB_PEN')] PROGRAM dvitest (output) ; VARB logvolnam, disk_label, device : VARYING [20] OF char := '' ;> free_blocks, disk_size, disk_owner_pid : unsigned := 0 ; BEGIN9 lib_sigiferr ($GETDVI (,, 'DISK$0', lib_item_list (: lib_out_item (dvi$_maxblock, %DESCR disk_size),< lib_out_item (dvi$_freeblocks, %DESCR free_blocks),: lib_out_item (dvi$_logvolnam, %DESCR logvolnam),; lib_out_item (dvi$_volnam, %DESCR disk_label),7 lib_out_item (dvi$_devnam, %DESCR device),C lib_out_item (dvi$_pid, %DESCR disk_owner_pid)))) ;? writeln (logvolnam, ', ', device, ', ', disk_label, ', ',& ', free =', free_blocks:1, ',0 used =', (disk_size - free_blocks):1) ; END.1 LIB_OUT_ITEM FUNCTIONAL DESCRIPTION:E Builds an item specifing data to be written, for inclusion in anD item_list. This routine is designed to be called from within a call to LIB_ITEM_LIST.$ CALLING SEQUENCE: item.rr.r = (L item_code.rlu.v, data.wx.dx [, data_length.wwu.r]) IMPLICIT INPUTS: None. IMPLICIT OUTPUTS: None. SIDE EFFECTS: None. 2 Parameters= item_code -- Symbolic code for the item of data required.F data -- Variable into which the item is to be returned. If itK is of type varying string, the length is returned as well.J data_length -- Variable in which the length of the data is to be return-J ed. This is not done if data was of type varying string.2 Completion_Status, none -- does not return any status values.2 PASCAL_Definition!}% [EXTERNAL] FUNCTION lib_out_item (( %IMMED item_code : lib_long_type ;, %DESCR data : [UNSAFE] lib_long_type ;2 VAR data_length : lib_word_type := %IMMED 0)& : lib_item_type ; external ;{ 1 LIB_IN_ITEM FUNCTIONAL DESCRIPTION:E Builds an item specifing data to be written, for inclusion in anD item_list. This routine is designed to be called from within a call to LIB_ITEM_LIST.C CALLING SEQUENCE: item.rr.r = (item_code.rlu.v [, data.rx.dx]) IMPLICIT INPUTS: None. IMPLICIT OUTPUTS: None. SIDE EFFECTS: None.5 RESTRICTIONS: The maximum data length is 80. 2 Parameters7 item_code -- Symbolic code for operation required..5 data -- Variable containing data to be read.2 Completion_Status, none -- does not return any status values.2 PASCAL_Definition!}$ [EXTERNAL] FUNCTION lib_in_item (( %IMMED item_code : lib_long_type ;E %STDESCR data : [UNSAFE,READONLY] PACKED ARRAY [l1..u1:integer]C OF char := %IMMED 0) : lib_extended_item_type ; external ;{! From SRC_VCLIB:LIBIFERR.DEC!1 LIB_RETIFERR FUNCTIONAL DESCRIPTION:6 Return from a routine if condition is not success.A The condition is put in the return value of the routine (R0).E CALLING SEQUENCE: ret_status.wlc.r = lib_retiferr (status.rlc.v) IMPLICIT INPUTS: None. IMPLICIT OUTPUTS: None. SIDE EFFECTS: None. 2 Parameters# status = longword condition code2 Completion_Status, ret_status = status (i.e. the parameter)2 PASCAL_Definition!}% [EXTERNAL] FUNCTION lib_retiferr (8 %IMMED status : sts_type) : sts_type ; external ;{1 LIB_SIGIFERR FUNCTIONAL DESCRIPTION:I Signal a condition if it is not success, optionally prefixing it with> other messages (with the normal passing of FAO arguments).8 CALLING SEQUENCE: ret_status.wlc.r = lib_sigiferr (= status.rlc.v [, signal_arg, ... ]) IMPLICIT INPUTS: None. IMPLICIT OUTPUTS: None. SIDE EFFECTS: None. 2 Parameters( status = longword condition codeN signal_arg = a list of condition codes (and FA0 arguments) to be signalled% ahead of the status.2 Completion_Status+ ret_status = status (i.e. the parameter)2 PASCAL_Definition!}% [EXTERNAL] FUNCTION lib_sigiferr ( %IMMED status : sts_type ;I %IMMED signal_arg : [LIST,UNSAFE] sts_type) : sts_type ; external ;{! From SRC_VCLIB:LIBPARSE.DEC! 1 LIB_PARSEFUNCTIONAL DESCRIPTION? Return an expanded file spec (or portions of it) (a run-time version of F$PARSE).0CALLING SEQUENCE: ret_status.wlc.v = lib_parse (? file_spec.rt.dx, expanded_spec.wt.dxH [, default_spec.rt.dx] [, related_spec.rt.dx]J [, expanded_length.ww.r,] [, field.rl.r, ... ])6IMPLICIT INPUTS: Process default device and directory.IMPLICIT OUTPUTS: None.SIDE EFFECTS: NoneRESTRICTIONS: None 2 Parameters(expanded_spec = The expanded file_spec.-expanded_length= length of expanded file_spec'file_spec = The file_spec to parse default_spec = See RMS manual. related_spec = See RMS manual.Hfield,.. = the fields to select. Select from the symbols NAM__NODED NAM__DEV, NAM__DIR, NAM__NAME, NAM__TYPE, NAM__VER.J If no fields are specified, the entire expanded file_specJ is returned. Otherwise the requested fields are appended+ in order in expanded_spec.2 Completion_Status,Any status returned by RMS or LIB$SCOPY_R_DX2 PASCAL_DEFINITION!}" [EXTERNAL] FUNCTION lib_parse (C file_spec : [CLASS_S] PACKED ARRAY [l1..u1:integer] OF char ;3 %DESCR expanded_spec : VARYING [n1] OF char ;D default_spec : [CLASS_S] PACKED ARRAY [l2..u2:integer] OF char := %IMMED 0 ;D related_spec : [CLASS_S] PACKED ARRAY [l3..u3:integer] OF char := %IMMED 0 ;7 VAR expanded_length : lib_word_type := %IMMED 0 ;C field : [LIST] sts_type := %IMMED 0) : sts_type ; external ;{!! From SRC_VCLIB:NAMDEF.PAS! 1 NAMDEFPAS> Declarations necessary for the use of the routine lib_parse.2 CONST!} CONST nam__node = 0 ; nam__dev = 1 ; nam__dir = 2 ; nam__name = 3 ; nam__type = 4 ; nam__ver = 5 ;{!! From SRC_VCLIB:PASLIBDEF.PAS! 1 PASLIBDEFN|****************************************************************************|N| Non-modular utility routines for use in PASCAL |N| |N| AUTHOR: Doug Miller |N| CREATED: 26-Sep-1984 |N| MODIFIED: Tim Cook, added addtim, subtim, difftim and bintim |N| 12-Sep-1985 |N|****************************************************************************| 2 CLI_PRESENTl,!} [GLOBAL,ASYNCHRONOUS] FUNCTION success ({8!} status : [UNSAFE] STS$TYPE) : boolean ; forward ;{!}/ [GLOBAL,ASYNCHRONOUS] FUNCTION cli_present (eB keyword : PACKED ARRAY [l1..u1:integer] OF char) : boolean ; BEGINi> cli_present := success (CLI$PRESENT (keyword)) END ;{ 2 FAILUREeG A simple routine to test the STS$V_SUCCESS bit of a STS$TYPE status.i$ (used to control program flow)!}+ [GLOBAL,ASYNCHRONOUS] FUNCTION failure (I- status : [UNSAFE] STS$TYPE) : boolean ;4 BEGIN-3 failure := NOT status.STS$V_SUCCESS END ;{- 2 PAS$FAB}!}E [EXTERNAL,ASYNCHRONOUS] FUNCTION pas$fab (VAR f : [UNSAFE] text) :i fab_pointer ; external ;{E 2 PAS$RAB!}E [EXTERNAL,ASYNCHRONOUS] FUNCTION pas$rab (VAR f : [UNSAFE] text) :_ rab_pointer ; external ;{a 2 SUCCESSFG A simple routine to test the STS$V_SUCCESS bit of a STS$TYPE status. $ (used to control program flow)- [GLOBAL,ASYNCHRONOUS]} FUNCTION success {( / status : [UNSAFE] STS$TYPE) : boolean } ;r BEGIND/ success := status.STS$V_SUCCESS END ;{]!s!} END. { of MODULE vclib }e [BYTE(3)] 0..%xFFFFFF ;< lib_quad_type = [QUAD] ARRAY [low..high] OF unsigned ;: lib_signed_quad_type = [QUAD] RECORD CASE integer OF0:( lo : unsigned ; hi : integer) ;21:( value : [QUAD] PACKED SET*[TAR]VCDEFS.PEN;1+,n./ 4-Ws0123KPWO56@*"Ft7@SHt8@t9GHJBe KQH 5-Jul-1990 11:41:3601VCLIBVAX Pascal V3.9-289 LOW LIB_K_MAXBYTE LIB_K_MAXWORD LIB_K_MAXLONG  STS_TYPE  LIB_LO_HILOWHIGH @ LIB_BYTE_TYPE @ LIB_WORD_TYPE @LIB_SIGNED_WORD_TYPE @ LIB_LONG_TYPE @LIB_3BYTE_TYPE @@ LIB_QUAD_TYPE @@LIB_SIGNED_QUAD_TYPE @@ LIB_DATE_TYPE @@PRV_TYPE @ LIB_LONG_SET_TYPE LIB_SIGARGS_TYPE LIB_MECHARGS_TYPE LIB_FAB_POINTER npLIB_NUMTIM_TYPE v` LIB_ITEM_TYPE {LIB_EXTENDED_ITEM_TYPE LIB_ITEM_LIST_TYPE  FAB_POINTER  RAB_POINTER  NAM_POINTER  NAM_RS_TYPE  NAM_RSA_TYPE  XAB_POINTER LIB$CREATE_DIR  LIB$FIND_FILE LIB$FIND_FILE_END  LIB$GET_INPUT  LIB$GETJPI LIB$SUBX  LIB$SYS_FAO  LIB$SIGNAL LIB$STOP  SYS$SETDFPROT SHELL$MATCH_WILDCLI$_DEFAULTED  CLI$PRESENT!   CLI$GET_VALUE( ' OTS$CVT_TI_L0 /STR$MATCH_WILD4PAS$_FILALROPE5PAS$_ERRDUROPE6PAS$_FILNOTFOU7PAS$_INVFILSYN8PAS$_ACCMETINC9PAS$_RECLENINC:PAS$_RECTYPINC;PAS$_ORGSPEINC<PAS$_INVKEYDEF=PAS$_KEYDEFINC>PAS$_KEYNOTDEF?PAS$_INVRECLEN@PAS$_TEXREQSEQAPAS$_FILNAMREQBPAS$_FILALRCLOCPAS$_ERRDURCLODPAS$_AMBVALENUEPAS$_INVSYNENUFPAS$_INVSYNINTGPAS$_INVSYNREAHPAS$_INVSYNUNSIPAS$_NOTVALTYPJPAS$_ERRDURPROKPAS$_INVSYNBINLPAS$_INVSYNHEXMPAS$_INVSYNOCTNPAS$_ERRDURWRIOPAS$_INVFIESPEPPAS$_LINTOOLONQPAS$_NEGWIDDIGRPAS$_WRIINVENUSPAS$_KEYVALINCTPAS$_KEYDUPNOTUPAS$_KEYCHANOTVPAS$_CURCOMUNDWPAS$_FAIGETLOCXPAS$_DELNOTALLYPAS$_ERRDURDELZPAS$_ERRDURFIN[PAS$_ERRDURGET\PAS$_ERRDURPUT]PAS$_ERRDURRES^PAS$_ERRDURREW_PAS$_ERRDURTRU`PAS$_ERRDURUNLaPAS$_ERRDURUPDbPAS$_FILNOTDIRcPAS$_FILNOTGENdPAS$_FILNOTINSePAS$_FILNOTKEYfPAS$_FILNOTOPEgPAS$_FILNOTSEQhPAS$_FILNOTTEXiPAS$_GENNOTALLjPAS$_GETAFTEOFkPAS$_INSNOTALLlPAS$_INSVIRMEMmPAS$_INVARGPASnPAS$_LINVALEXCoPAS$_REWNOTALLpPAS$_RESNOTALLqPAS$_TRUNOTALLrPAS$_UPDNOTALLsPAS$_ERRDUREXTtPAS$_EXTNOTALLuPAS$_INVFILVARvPAS$_FILALRACTwPAS$_ERRDURNEWxPAS$_ERRDURDISyPAS$_ERRDURMARzPAS$_ERRDURREL{ PAS$_HALT| PAS$_BUGCHECK}PAS$_NEGDIGARG~PAS$_BADBITARGPAS$_CANCNTERRPAS$_ARRINDVALPAS$_ARRNOTCOMPAS$_ARRNOTSTRPAS$_CASSELVALPAS$_CONCATLENPAS$_PADLENERRPAS$_PTRREFNILPAS$_SETASGVALPAS$_SETCONVALPAS$_STRASGLENPAS$_STRCOMLENPAS$_SUBASGVALPAS$_SUBSTRSELPAS$_VARINDVALPAS$_ORDVALOUT PAS$_NOACTUALPAS$_MODNEGNUM PAS$_FACILITY  LIB_ITEM_LIST  LIB_OUT_ITEM  LIB_IN_ITEM  LIB_RETIFERR  LIB_SIGIFERR  LIB_PARSE NAM__NODENAM__DEVNAM__DIR NAM__NAME NAM__TYPENAM__VER SUCCESS  CLI_PRESENT FAILURE PAS$FAB PAS$RAB          @  $@ $ ( @$ LO( @$ HI$@@VALUE@ ?@ ?  $X$ PARAM_COUNT$ CONDITION$@ PARAMETER P  $$ PARAM_COUNT$ STACK_FRAME_ADDRESS$ @STACK_FRAME_DEPTH$ `R0$ R1  $P $ ( #$@ FAB$B_BID(  `( B[ $@ FAB$B_BLN(  `$ FAB$W_IFI$@ FAB$V_PPF_RAT$@FAB$R_IFI_OVERLAY$FAB$R_IFI_BITS $ FAB$L_FOP $@ FAB$V_PPF_IND$$@ FAB$R_FOP_OVERLAY$$ FAB$R_FOP_BITS$ FAB$B_FAC$@ FAB$V_ASY$$ @ FAB$L_STS$$FAB$R_FAC_BITS$ FAB$B_SHR$@! FAB$V_MXV$ ` FAB$L_STV$$FAB$R_SHR_BITS$ FAB$B_ORG$@" FAB$V_SUP$ FAB$L_ALQ$$FAB$R_ORG_BITS$ FAB$B_RAT$@# FAB$V_TMP$@ FAB$W_DEQ$$FAB$R_RAT_BITS$ FAB$B_JOURNAL$@$ FAB$V_TMD$ @ FAB$R_FAC_OVERLAY$$  FAB$R_JOURNAL_BITS$P  FAB$B_ACMODES$@% FAB$V_DFW$$@FAB$R_SHR_OVERLAY$$PFAB$R_ACMODES_BITS$X FAB$B_RCF$@& FAB$V_SQO$$  FAB$L_CTX$$XFAB$R_RCF_BITS$@' FAB$V_RWO$@ FAB$B_RTV$$@( FAB$V_POS $@FAB$R_ORG_OVERLAY$@) FAB$V_WCK$$@FAB$R_RAT_OVERLAY$@* FAB$V_NEF$$@  FAB$B_RFM$@+! FAB$V_RWC$"@#FAB$R_JOURNAL_OVERLAY$@,$ FAB$V_DMO$$@%FAB$B_RU_FACILITY$@-& FAB$V_SPL$'@(FABDEF$$_FILL_7$@.) FAB$V_SCF $ * FAB$L_XAB$@/+ FAB$V_DLT$ @, FAB$L_NAM$@0- FAB$V_NFS$ `. FAB$L_FNA$@1/ FAB$V_UFO$ 0 FAB$L_DNA$@21 FAB$V_PPF$@2 FAB$B_FNS$@33 FAB$V_INP$@4 FAB$B_DNS$@45 FAB$V_CTG$@6 FAB$W_MRS$@57 FAB$V_CBT$ 8 FAB$L_MRN$@69 FAB$V_SYNCSTS$@: FAB$W_BLS$@7; FAB$V_RCK$@< FAB$B_BKS$@8= FAB$V_NAM$@> FAB$B_FSZ$@9? FAB$V_CIF$ @ FAB$L_DEV$@;A FAB$V_ESC$ B FAB$L_SDC$@<C FAB$V_TEF$@@D FAB$W_GBC$@=E FAB$V_OFP$F@PGFAB$R_ACMODES_OVERLAY$@>H FAB$V_KFO$$I@XJFAB$R_RCF_OVERLAY$@K FAB$V_PUT$$ `FABDEF$$_FILL_9$@L FAB$V_GET$@M FAB$V_DEL$@N FAB$V_UPD$@O FAB$V_TRN$@P FAB$V_BIO$@Q FAB$V_BRO$@R FAB$V_EXE$@S FAB$V_SHRPUT$@T FAB$V_SHRGET$@U FAB$V_SHRDEL$@V FAB$V_SHRUPD$@W FAB$V_MSE$@X FAB$V_NIL$@Y FAB$V_UPI$Z@[ FAB$V_ORG $@\ FAB$V_FTN$@]FAB$V_CR$@^ FAB$V_PRN$@_ FAB$V_BLK$@` FAB$V_ONLY_RU$@aFAB$V_RU$@bFAB$V_BI$@cFAB$V_AI$@dFAB$V_AT$@eFAB$V_NEVER_RU$@fFAB$V_JOURNAL_FILE$g@PhFAB$V_LNM_MODE $g@RiFAB$V_CHAN_MODE$g@TjFAB$V_FILE_MODE$g@VkFAB$V_CALLERS_MODE$@Xl FAB$V_RCF_RU$@Ym FAB$V_RCF_AI$@Z FAB$V_RCF_BI$po$@npYEAR$@nqMONTH$@ nrDAY$@0nsHOUR$@@ntMINUTE$@PnuSECOND$@`n HUNDREDTH$` w$@vx BUFFER_LENGTH$@vy ITEM_CODE$@ vzBUFFER_ADDRESS$@ @vRETLENGTH_ADRESS$\|$v`{}ITEM$~`{BUFFER P P v` U     $ D $ (  $@ RAB$B_BID( ( @$@ RAB$B_BLN( $ RAB$W_ISI$( RAB$B_ROP1( @$@RAB$R_ISI_OVERLAY( &$RAB$R_ISI_BITS$  RAB$L_ROP$0 RAB$B_ROP2$ RAB$R_ROP_FIELDS( 7$$@ RAB$R_ROP_OVERLAY( 8$@ RAB$V_PPF_RAT$$ RAB$R_ROP_BITS0$ ` RAB$L_STV$8 Cib~~VMS-TAR-11.32256nWs[TAR]VCDEFS.PEN;1PAS;1|" RAB$B_ROP3$$@5 RAB$V_EQNXT$$ @ RAB$L_STS$ RAB$R_ROP_BITS1$@ RAB$V_PPF_IND$$ `RAB$R_STV_FIELDS$0 RAB$W_RFA$@6 RAB$V_NXT$@ `RAB$R_STV_OVERLAY$$@  RAB$V_ASY$$0RAB$R_RFA_FIELDS 0@$  RAB$L_KBF$$@0RAB$R_RFA_OVERLAY$@! RAB$V_TPT$$  RAB$L_PBF $ RAB$B_KSZ$$'@RABDEF$$_FILL_4$@" RAB$V_REA$ RAB$B_PSZ$  RAB$L_BKT$  RAB$L_CTX$@# RAB$V_RRL$  RAB$L_DCT$'@RABDEF$$_FILL_5$@$ RAB$V_UIF$@ RAB$B_RAC$@% RAB$V_MAS$@ RAB$B_TMO$@& RAB$V_FDL$@ RAB$W_USZ$@' RAB$V_HSH$@ RAB$W_RSZ$@( RAB$V_EOF$  RAB$L_UBF$@) RAB$V_RAH$ @ RAB$L_RBF$@* RAB$V_WBH$ ` RAB$L_RHB$@+ RAB$V_BIO$@ RAB$R_KBF_OVERLAY$@, RAB$V_CDK$$@RAB$R_KSZ_OVERLAY$@- RAB$V_LOA$$@ RAB$B_KRF$@. RAB$V_LIM$@ RAB$B_MBF$@/ RAB$V_SYNCSTS$@ RAB$B_MBC$@0 RAB$V_LOC$@ RAB$R_BKT_OVERLAY$@1 RAB$V_WAT$$  RAB$L_FAB$@2 RAB$V_ULK$  RAB$L_XAB$@3 RAB$V_RLK$@4 RAB$V_NLK$@5 RAB$V_KGE$@6 RAB$V_KGT$@7 RAB$V_NXR$@8 RAB$V_RNE$@9 RAB$V_TMO$@: RAB$V_CVT$@; RAB$V_RNF$@< RAB$V_ETO$@= RAB$V_PTA$@> RAB$V_PMT$@? RAB$V_CCO$` RAB$W_STV0$p RAB$W_STV2$  RAB$L_RFA0$ RAB$W_RFA4  $` $ ( $@ NAM$B_BID( (    $@  NAM$B_BLN(  $@ NAM$B_NOP$@NAM$V_WILD_GRP( $@ NAM$B_RSS( $$@NAM$R_NOP_BITS$0  NAM$W_FID$@NAM$V_WILD_MBR$@  NAM$B_FID_RVN(    $@ NAM$B_RSL(  $@@ ! NAM$V_PWD $$"0 #NAM$R_FID_FIELDS 0@$$%0P& NAM$W_DID$H ' NAM$B_FID_NMX$(@)NAM$R_FID_RVN_FIELDS$ * NAM$L_RSA$@+ NAM$W_FID_RVN$@A , NAM$V_FILL_1$$-0P.NAM$R_DID_FIELDS  0@/$ 0 NAM$L_WCC$p 1 NAM$B_DID_RVN$$2p3NAM$R_DID_RVN_FIELDS$4@@5NAM$R_NOP_OVERLAY$p6 NAM$W_DID_RVN$@B 7 NAM$V_FILL_2$$8 9NAM$R_WCC_BITS $  NAM$L_FNB$x : NAM$B_DID_NMX$$@;NAM$V_WILD_UFD$$@H< NAM$B_RFS$= NAM$R_FNB_BITS1$@C > NAM$V_SYNCHK$$?NAM$R_FNB_BITS0$@   NAM$R_FNB_BITS2$@ANAM$V_WILD_SFD1$@PB NAM$B_ESS$$@D CNAM$V_NOCONCEAL$$$@DNAM$V_WILD_SFD2$@XE NAM$B_ESL$@E F NAM$V_SLPARSE$@GNAM$V_WILD_SFD3$ `H NAM$L_ESA$@F INAM$V_SRCHXABS$@JNAM$V_WILD_SFD4$ K NAM$L_RLF$  L NAM$W_FID_NUM$@MNAM$V_WILD_SFD5$NO NAM$T_DVI$0 P NAM$W_FID_SEQ$@QNAM$V_WILD_SFD6 R$S@0 TNAM$R_FID_OVERLAY$U@ VNAM$R_FID_RVN_OVERLAY$@NAM$V_WILD_SFD7 $$W@0PXNAM$R_DID_OVERLAY$$P Y NAM$W_DID_NUM$$Z@ [NAM$R_WCC_OVERLAY$` \ NAM$W_DID_SEQ$$]@ ^NAM$R_FNB_OVERLAY$_p `NAM$R_DID_RVN_OVERLAY$$@a NAM$B_NODE$$@ b NAM$V_IFI$@c NAM$B_DEV$@ d NAM$V_SRCHNMF$@e NAM$B_DIR$@ f NAM$V_SVCTX$@g NAM$B_NAME$@ h NAM$V_EXP_VER$@i NAM$B_TYPE$@ jNAM$V_EXP_TYPE$@k NAM$B_VER$@ lNAM$V_EXP_NAME$mnNAMDEF$$_FILL_6$@ oNAM$V_WILD_VER @p$ q NAM$L_NODE$@ rNAM$V_WILD_TYPE $ s NAM$L_DEV$@ tNAM$V_WILD_NAME$ @u NAM$L_DIR$@ v NAM$V_EXP_DIR$ `w NAM$L_NAME$@ x NAM$V_EXP_DEV$ y NAM$L_TYPE$@ zNAM$V_WILDCARD$ { NAM$L_VER$@ |NAM$V_SEARCH_LIST$}@NAMDEF$$_FILL_7$@ ~NAM$V_CNCL_DEV @ $@ NAM$V_ROOT_DIR $@  NAM$V_LOWVER$@  NAM$V_HIGHVER$@  NAM$V_PPF$@  NAM$V_NODE$@  NAM$V_QUOTED$@  NAM$V_GRP_MBR$@ NAM$V_WILD_DIR$@  NAM$V_DIR_LVLS        $ d =$ ( ==$@ XAB$B_COD( ( A<<$@ XAB$B_BLN( $@@` XAB$Q_RDT$@@ XAB$V_NOJOIN( H;;$'@XABDEF$$_FILL_1( $@`XAB$R_RDT_FIELDS$@$@XAB$R_RU_FLAGS_BITS( P::$  XAB$L_NXT( $ ` XAB$L_RDT0$$ L0$$@XAB$W_RU_FLAGS( 99$@@ XAB$W_RVN( `$ XAB$B_BKZ$  XAB$L_RDT4$ L1$@XABRUDEF$$_FILL_1( 88$'@PXABDEF$$_FILL_2( `$@`XAB$R_XABFHCDEF$@XABRUDEF$$_FILL_2$@XAB$R_XABRUDEF( 77$@@`XAB$R_RDT_OVERLAY( $@XABFHCDEF$$_FILL_1$$'@XABRUDEF$$_FILL_3$$@XABITMDEF$$_FILL_1( 66$( $H XAB$B_ATR$@XABFHCDEF$$_FILL_2$ XABRUDEF$$_FILL_4$@XABITMDEF$$_FILL_2$@XAB$R_XABITMDEF( R55( $ `XAB$R_HBK_FIELDS  $ ` XAB$L_HBK$'@XABFHCDEF$$_FILL_3$@@XAB$R_RU_FLAGS_OVERLAY$'@XABITMDEF$$_FILL_3$$@PXAB$V_JOURNAL_DISABLED( X44( $@H XAB$V_FTN  $$ XAB$R_EBK_FIELDS$  XAB$L_EBK$ XABFHCDEF$$_FILL_4$$'@PXABRUDEF$$_FILL_5$ XABITMDEF$$_FILL_4$@QXAB$V_BACKUP_DONE$PXAB$R_JNL_FLAGS_BITS( `33( $@XAB$R_XABALLDEF  $@IXAB$V_CR$$@@ XAB$B_RFO$ `XAB$L_RU_HANDLE$ @XAB$L_ITEMLIST$$PXAB$W_JNL_FLAGS( 22( $@XABALLDEF$$_FILL_1  $$@J  XAB$V_PRN$ @H  XAB$R_FILL_9$  XAB$L_RU_HANDLE_JOINED$@`  XAB$B_MODE$@XABJNLDEF$$_FILL_1( 11( $@ XAB$B_AOP  $@XABALLDEF$$_FILL_2$@K XAB$V_BLK$$@P XAB$W_LRL$ XABRUDEF$$_FILL_7$hXAB$B_ITM_FILL1$@XABJNLDEF$$_FILL_2$@XAB$R_XABJNLDEF( 0 0( #"!$$@%XAB$R_AOP_BITS$&0 XAB$W_RFI$'@'XABALLDEF$$_FILL_3$`( XAB$W_HBK0$)@ `*XAB$R_HBK_OVERLAY$ +XABRUDEF$$_FILL_8 @,$-XAB$L_ITM_FILL2$'@.XABJNLDEF$$_FILL_3$$@/ XAB$V_CXRRST( 0/12/( 54`3$@@6 XAB$V_HRD$$70"XAB$R_RFI_FIELDS 0@8$ 9XABALLDEF$$_FILL_4$p: XAB$W_HBK2$$;@ <XAB$R_EBK_OVERLAY$ =XABRUDEF$$_FILL_9   >$ ?XABJNLDEF$$_FILL_4$Z@ XAB$V_CXRBVER$@ XAB$R_CXRCOP_BITS(  A.BC.( F E`D$G@`!EXAB$R_XABDATDEF!#$@AH XAB$V_ONC$ $I@@JXAB$R_AOP_OVERLAY$K XAB$W_EBK0$$@L XAB$W_FFB$ MXABRUDEF$$_FILL_10 $@@NXAB$B_XABJNL_TYPE$$ 10 XAB$L_CXRCOP( 2 O1-PQ-( TS`R$@3UXABDATDEF$$_FILL_135$$@EV XAB$V_CBT$$@HW XAB$B_ALN$ XAB$W_EBK2$@XXABFHCDEF$$_FILL_5$ YXABRUDEF$$_FILL_11$@HZXABJNLDEF$$_FILL_5$@B[XABCXRDEF$$_FILL_1( C\B,]^,( a``_$@@Db XAB$Q_CDTDF$@3cXABDATDEF$$_FILL_2$@Gd XAB$V_CTG$@Pe XAB$W_VOL$@f XAB$B_HSZ$ @gXABRUDEF$$_FILL_12$h@PiXAB$R_JNL_FLAGS_OVERLAY$@BjXABCXRDEF$$_FILL_2$k@POXAB$R_XABCXRDEF( QlP+mn+( qp`o$r@RsXAB$R_CDT_FIELDSRT$@@Dt XAB$Q_EDT$'@3uXABDATDEF$$_FILL_3$v XAB$W_RFI0$ `w XAB$L_LOC$@x XAB$W_MRZ$ `XABRUDEF$$_FILL_13$$ `y XAB$L_JNL_FAB$'@BzXABCXRDEF$$_FILL_3$$@]\ XAB$V_CXFRST( ^{]*|}*( ~$ _ XAB$L_CDT0_a$$@RXAB$R_EDT_FIELDS$@@ D` XAB$Q_BDT$ 3XABDATDEF$$_FILL_4$ XAB$W_RFI2$  XAB$L_ALQ$@ XAB$W_DXQ$ XAB$L_VOLNAM_BUF$ BXABCXRDEF$$_FILL_4$mlXAB$R_CXFCOP_BITS( nm))( $@oXAB$R_XABRDTDEFoq$ _ XAB$L_CDT4$$@ RpXAB$R_BDT_FIELDS$'@@3XABDATDEF$$_FILL_5$4 XAB$W_RFI4$@ XAB$W_DEQ$@ XAB$W_GBC$@XAB$W_VOLNAM_SIZ$ @B XAB$L_CXRSTS$$ |{ XAB$L_CXFCOP( }|((( $@~XAB$R_XABPRODEF_BITS~$$ _ XAB$L_EDT0$$'@P3XABDATDEF$$_FILL_6$@XABALLDEF$$_FILL_7$@XABFHCDEF$$_FILL_6$@XAB$W_VOLNAM_LEN$ `B XAB$L_CXRSTV$@XABCXFDEF$$_FILL_1( ''( $@ XAB$V_NOREAD$$ _ XAB$L_EDT4$@@@`3XABDATDEF$$_FILL_7$@ XAB$B_AID @@$@0XAB$W_VERLIMIT$@@@XAB$Q_JNL_VERIFY_CDATE$@ BXAB$R_CXRCOP_OVERLAY$@XABCXFDEF$$_FILL_2$@XAB$R_XABCXFDEF( &&( $@XAB$R_XABPRODEF$@ XAB$V_NOWRITE$ _ XAB$L_BDT0$@@3XAB$R_CDT_OVERLAY$@0XAB$R_RFI_OVERLAY $ @ XAB$L_SBN$@$  XAB$L_JNLIDX$$ B XAB$L_CXRBKP$'@XABCXFDEF$$_FILL_3$$@XAB$V_DAT_NCMPR( %%( $@XABPRODEF$$_FILL_1$$@ XAB$V_NOEXE$ @_ XAB$L_BDT4$$@@3XAB$R_EDT_OVERLAY$$'@XABALLDEF$$_FILL_8$ L0$ XAB$L_BACKUP_SEQNO$@B XAB$W_CXRISI$ XABCXFDEF$$_FILL_4$XAB$R_FLG_BITS1( @$$( $@ XAB$W_PRO$@XABPRODEF$$_FILL_2$@ XAB$V_NODEL$$@@ 3SXAB$R_BDT_OVERLAY$ L1$@@@@XAB$Q_JNL_MOD_TIME$@B XAB$B_CXRVER$ @ XAB$L_CXFSTS$$@ XAB$V_DUP( @##( $@XAB$R_PRO_BITS$XXAB$B_PROT_OPT$'@XABPRODEF$$_FILL_3$$ XABJNLDEF$$_FILL_7$@BXABCXRDEF$$_FILL_6$ ` XAB$L_CXFSTV$@ XAB$V_CHG$XAB$R_FLG_BITS0( @""(  $Z@@ XAB$V_SYS$$XXAB$R_PROT_OPT_FIELDS$ ` XAB$L_UIC$ XABPRODEF$$_FILL_4$ XABJNLDEF$$_FILL_8$ BXABCXRDEF$$_FILL_7$@ XAB$R_CXFCOP_OVERLAY$@ XAB$V_NUL$$XAB$R_POS_FIELDS$  XAB$B_FLG( #  !  !(    $@ XAB$R_XABTRMDEF$Z@D XAB$V_OWN$$ `XAB$R_UIC_FIELDS$@@XAB$Q_PROT_MODE$@@XAB$R_PRO_OVERLAY$ XABJNLDEF$$_FILL_9$@B XAB$B_CXRMBF$$  XAB$L_CXFBKP$@XAB$V_IDX_NCMPR$$@pXAB$R_SIZ_FIELDS$ XAB$W_POS$@XABKEYDEF$$_FILL_1(   ! ( !"` $@#XABTRMDEF$$_FILL_1$$Z@H$ XAB$V_GRP$$%XAB$R_PROT_MODE_FIELDS$$@P& XAB$B_MTACC$ 'XABJNLDEF$$_FILL_10$@B( XAB$B_CXRMBC$@) XAB$W_CXFIFI$@*XAB$V_KEY_NCMPR$$+@XAB$R_TYP_FIELDS @,$-@p. XAB$B_SIZ$@/XABKEYDEF$$_FILL_2$0@   XAB$R_XABKEYDEF(  1`  $2@` 1XAB$R_XABSUMDEF$@3XABTRMDEF$$_FILL_2$Z@L4 XAB$V_WLD$$5@X6XAB$R_PROT_OPT_OVERLAY$ 7XABJNLDEF$$_FILL_11$@B8 XAB$W_CXRBFZ$@9 XAB$B_CXFVER$: XAB$W_POS0$  @@;$<@ XAB$B_TYP$'@=XABKEYDEF$$_FILL_3$$@ >XABSUMDEF$$_FILL_1$$'@?XABTRMDEF$$_FILL_3$@X@XAB$V_PROPAGATE$$A@ `BXAB$R_UIC_OVERLAY$ CXABJNLDEF$$_FILL_12$ BD XAB$L_CXRVBN$@EXABCXFDEF$$_FILL_5$F XAB$W_POS1  @@G$ HXABKEYDEF$$_FILL_4$@ IXABSUMDEF$$_FILL_2$ JXABTRMDEF$$_FILL_4$`K XAB$W_MBM$$L@@MXAB$R_PROT_MODE_OVERLAY$ @NXABJNLDEF$$_FILL_13$@@BO XAB$W_CXROFF$ PXABCXFDEF$$_FILL_6$Q XAB$W_POS2 $@@R XAB$B_IAN$'@ SXABSUMDEF$$_FILL_3$ @T XAB$L_ITMLST$pU XAB$W_GRP$$ V XAB$L_ACLBUF$ `XABJNLDEF$$_FILL_14$@PBW XAB$W_FILL_8$@X XAB$W_CXFDEQ$ Y XAB$W_POS3$@HZ XAB$B_LAN$  [XABSUMDEF$$_FILL_4$@`\XAB$W_ITMLST_LEN$XAB$B_PROT_MODE$@] XAB$W_ACLSIZ$ `B^ XAB$L_CXRPOS0$@_ XAB$B_CXFFAC$0` XAB$W_POS4$@Pa XAB$B_DAN$@@ b XAB$B_NOA$'@pcXABTRMDEF$$_FILL_5$@d XAB$W_ACLLEN$@ f8Ws[TAR]LIBPYF\C.plJ;1WF ]k:EGeXI;vxt'Jg%^@p^*)E wZr ZLa(FzȖzq *T9F M cZ&ؕX駗7ut0=eN|B\ Q ]h/e[Ktx@1EнnS%þŐ4lڏ$L"=%|8L0rυac jG4 oS縄򁊤2/2zHvJ1„v1PY S($b)ؠ ZD?z@WƵ!og|kCy(}GV%BFnZ$elcT(ZWy~-DO%gk*n),xi<;ʕy8K)S.;C.+Xl{L+s':hC"~T:Vl{w+uE9k:RDj 1exSӱA&]Ç`23;ԧO(xÿ;aG}'!L ֏i^X{(iNdՙy.sO bW:w>cRkfDa*sG+cZpKc+6qrL_ Ŋ H 쪿Ucaag+7NF5MXHқEH>dF([ zHG wIMT0l_LAZϤ#1fU ŦbRA}r-_5x)'IShV&Na,P>D R"+b>Tyz##qlP&'Afj_+:L"i $h'[/+NM,S.Og|*M Nj-ܵ#Pйj @{@XR>  M֠ G棽+6QAg*mX:׺u.GQ_UeMCoA=2LӘdcHC3W][ޕ倞7zQU귬^a̘dd6GmlEM`Fpf`W$qIЁ޳eAK=)7ՁnնN}y,˵ N3de |a*],nMγD] EʡՈѯ([<#ܽAvD}Z$p0A䫘ѿ7ol72u ?B1 E(³!ev,R.Ud>/|Oիdb.Ai\*ٺ3W!ͪN7JTg:T߂G彟ޖՊR\"R0$|խg״(³!e^ ?mi So2D`D}gH8|wwy;w:!K"p ҫ?By ~*`c~w`9tmVG-b/'NPjwfW?ESHMʥ-P<ё0E3l~(gtjw*}3o :sމu ]i ۅk0 ^)HriCIq6%yz=dtuRMlib}^2$2#"x 0Oo (=ƥsp#i ̊;08f^|4Xdy9KӭIm(t6ӂןЄz}h:FṲYZ.xEñՃ ޓ QcjƎիPݳ6UCEj!"p<Ԧ 1(}aRQgPU`{43\fw._}:|3dBBM4rVg'r(J㽉 :#-ߦp!$چ3/"̗>4 ݙFwЪ`C&ځ*õԦ>o97OcJ {*;CTG0jTeì% l1i -(-QĶ I =~G)JWD {~f[ u*ďyt#Zqೀ>D9+}9\gH<:lnDubakS*$ Ywb%)d@1Sw2F}M45cv_$$L|A,̧fzI:4i;֟'TSpMJh+3dзM?I)n,Z]4S{ OipJϛQ3(DDkVGay̴|Nݱ_aj_  յf< 6.fp`r]}C:ѴOz΃Ɩ va{ );Y:~wb=ၶUZKz$xJ$@^zC.-)$iڴ#y9Yf}WzKa` ,-d!N@ m?V޾Ykm_TEK]xU|TYg4"٪D7DKx;rr^Fr`=n[sR2咦c8 VVsT|S \j׸3ƀN|C6E;~ D 0@ɍ5{bejC r&%JC f@%M\*2Mԉm,^rѧw_sbk+ݴo A#҆USjj*):lc!%2 @9Q_# ϚSlo˞KqvYeZ&̷*ϩ ;7yVL$I;F{n"saiyUՖ4xE˕ olN4Ӟ<5֯ giη`,550|Ai?y" @?fQ|d"(@tjzӒ1 15M4>emƦ$G`76'Y˜lHڼ; x Πδ&LaҨʏb73AmhߛV7紱h,&>cNl&chҫ~~8ɯ}?UfȚum/v',[B.x&YJxP~_'$^~e^R+q>y2aھG2xA9U qMmoR}M#G6:0:U"~*f%8+#|g;3I\ XO|$][@9 ] .5NRxRZ u{N?Gl@o>8惦[c7e`ͽB;}Ƕ'U;Ca5kbPG3v2H E)Uxw:z;lnlDLU!6-ɰ_ۤ?j2ܼzMw)aD\&<%{؟lnwF>ՌλWֹf΅DH||xvR;7Pɠ<[ sN|81&]cR\׷\SUN5.+QohīFoequ-yĊ:0Ynrm׏+N,Pvu \E,iY~q灏 f/YD g`QLz =./~` (gݑVcp'܈pH3אv4"sTCaܯO"lx RoI/IL@f VXB~A&fܺ5j0y`e{[˲xjjힿc^a2̘9ӧSQ^ɮaΌcZ7X4aBZ8ofjVpVO&DfUVd;jF?]s 3Rʌrp fZXFsWxY{B֒:{w[ZIP~Ix/¢6XAjCKyAr̼eeGf BX5g^5-ٹx:dU~tw-mc Ȳss}%I+,I&i9d,?jd挢ЧP,wǀ' 3\J8ɪf> x$>}gΉ ${5z,VQz$᳝. gHly~I![jH.B=g k +/Tx jsTj"i7'S)YezQ4H=a@&eG<*EJy ѨEŀ[}T푆_8@y(Ep:K@(ǥ?c)9tY ),?s=ꬦߋ+ xf֋{uWDgD,#US<@zF6i뗺P\B\" g@u*PilcpVdh`{%vƿ(ry/S"hdi/Өc P)ijoZf Y Nm]Ճܖi%%}qިCq<_g)-/V1oh ]p'ܙ>OVӖ6*گf!Y{J+S#6 E };&+ǭ RBAP ]5N>0gf6̤igE++KJ%ˢs7_5I'A%4#F_Ye6<; Xc{"Q5wR^cGuFsz<(19:! X{@nTgL6nևd|gJk ^ғi`*@QK-:5n#Y[`aV\_#~#^]am/?=3,mN~Aهi'Lt;ؔ_VnhP% UQ8 ߒ"-R.D%,cj:e%/]❦+k3I(ǹ5 \b鈂bO+0xqؼ(ɠx뤇ҏIKJZyWp횄Faqj ~PsԊp9E>vOG>`znZ`Mu\Ťebts?r 3 Hի8Ox RZ tob4#KP aHP+ ߌHW⌲~Ccs % 'vQϋ\p7[NE65ԌƏnYwkSDvźAx^h /j\D!Pt 3fS S)]S`LPyƲZWc\tK*)O>P$kXko^YaDo{V,r¥dGU:J2c2MQZe2)KᖩTiIgZUQ?yY]h񄚭Etp˴gz+ 8Enyx̿)q \9Q=Y"ɤ/ݞ1m `ĕ_I;2!v]u/}#1(:>W_t_ ~mf?\ˢ5BztMammK$]!gdPaPjT+Ln!fŘ2.`q+ \[6vZvLu A Fe¶3bC3O-|ʻS߃;c2rbp䧞JNmhHWyqexw]6'Y@M^(ap9s=3g6|LPN:))4C.7X B YshNf{ZLϢAMSmܘ"=wU^e#>:+O gĨSPo-!G0:s:o':^۱EӕG+~?xk+ ,oՔnD90\,CYs%ȯUꎼxω<ܕL? Cl1f[.JL+p|( 6ɺEBoqiŽS/BURo''i?bEQycڪٓr e\9 #Y @*;CTpY#t g}m1?%tlQz-,Lx.@љZw]eWrZO"h2;rLT@2Tqz?:A-x//F@P IjD=Lc-sd[P43Y9S<SaI8qGFR<ʏ{"3'Y Sx'+%OYǁӛHOvUI:8JRqbXjQa 0 R9;w΀˸SY68u>hgPhS8f_݅žrj^tWԼsS]Ҩ*l``S2C` /mNU<^vr wBvnb3ks,u ?4[ /ID,*Ml"(YMX#tB%tuADu3 2v  bW uH@)582~)H'à=蔰}캱\'iE60=dkfTp~b֩,t =˕ȋ͙ ܗq߉TLK fTaV I% KyG&/bgh 8Ufyp>5o6*F&~oOErv3KWt6Pi\'5QkC2 ( NЯs,|~=P%#[n_)~]fsgvF3Fۧ1F[SY M1n F0E ǑސUnM,FΓ @ϓZ,eE|p0u{l9#` J쿗zG2?Jp]=D6"VczEﮕag(}/w@&ppBl=YQA ||4&/0뼁֝ߡgؚ߉`_rYjPI&nRYS1&ϯBFD 8l̆w7?FZN}d3UzI><o\he()|$ >q 7A#I ȹ ۰|[?CE߀l)f@{:1g~|igh*=l9 *5i EܨAnk7Ͼ_{J-󝡷j@XܱY^MMeP2H׹?95t@XbR渶ݟ#2sfWxȕOd*@WUۭ^aYbHZWVYW !jd]Dy8!\.Cv$?yMw|tݰi&Ny#T)a-z\SRMXܺvkS'و/N^6lܱG|Yʖ'%+jÊdh}ʮ4[5eS9Ẕ[{B!M*6̠ wa!}o Dm)>?0̌{L]1J[fx0]ya\U vK.OGަcLeK"iB? :֭=kdߣno. 64)v cڪ Ī՘ÒI\ zL;H1\`9~2_ +P]ahmDڶnRz7fT/eVP`;|,MJ x;m0 N}ofVs,Zձj,[@V\,B)xZPARG!Y(T8 ^ H7b*˸ڐ w"oLhmز%l-9O0PA6̒xp4/k4[sAaPDC1geVS].zAb(SE3X3F!(Sct -k.VNy\v\$J:{S?AuuSB\EQ:Y3>݇xpA915x6v^L Uf!bQ&=`||pp"b5+,apFF-^-u1G{MmSކ2 6=3*cr!"iqa|qPlatBh-733y >zkQ U \ uEz3,")Cz3jpu-Wrղeڻ34Mihz} @)l:c]=CS[F ~ ?=q3O.V?ZcPe⌽\@?qKDSC]m}O@?3l5S܆9Ok(G6گ9r'DMɣk)N }9vX=/4/|| m6'\>9!vImM2"cLi4t-to*I`^clV:baU1RN !^YAFLe_m&c/> 7}H bJ%^l%z>5~}e} 3[A6kO \[6NJ=!d` ,D]d,՜E-q/+Kq.>wFM[5N$ؑDv=G ]&5~dV!2 q2|i;uus^(1 R ,p&zjWw@+_:Echb89n :oNl"!wii=Ckc5z?{:8MIR:g"o~[<?"L}Ψs1So >/WbsF$X~Fl|uNXRW; !Zx/2Viw%o}CPKs`S,QaXkf67 jpK=#5C\M"f0lfխs@C DC23HG5w33EFFґЛ6D|6/W[%R l4]~z:)G/r\ \xp"@s/Sߔ~f R.MF8A1nZboKfroD*jJ5>wy=~T^twe8tMg8aG:w^P4yi[Zat)51Ӯn8@$lYt+3s-#{q.tz1[旕8-:Ԍ8Y2Щ)"XM gҐ]ncm'ꁫ*WfEx+a`5W?d3WS;Vi@'.ipDMI#CIOIeMJz&Q:>B4j;d ]k{#8erp;h0.(Bo/qo{:e}}fk)D"zv<*p fݓL4 نQ4ֽZxc3nXc6Yn%_bc!O:/Z8RM;-:RO [2El e9g#[A{v#@rl/:1N(pHO.b.Yb5(WjtBg0]Q;Q sYl} cf5 GcP] JTyoxmqRU ,"Fo&7Ԫ9boH/=zW03 A_kEOFY_7+Qn$)h,CnKD=Rfnj=?p/I QH?KC^Nh/Ll/5 =da^hL$P8,id! SK:JC_ <0%Adm?)v~J^-WO\b DSfL  v,JO|z~HQ>258!"'yaS9![%;r;7'l`=ASm ~NO[Vu{R{L_-YH~D`Yh8$?hI}UV$Rl5326v0s\uUzF^([w,'/r8>S7= 8slQU֡yyyn ԉvpih936%x4)qVn'!?x>>B~`l$ڇ)IKTr mhV ,9Gv(9`m}hQ Oc&g;A6cFQe`?\4E/Asn9 Dijl@gr~V?U(N7 mN#Apjxuo6!#:5^9fV5@W\ ;C;9pnN8?lV{,[2,Y`} ,XM 絙fXJ8dd Gbd6o5_,1SJT3/}]`YYD_H r\22LjPX"Qr¹Al (El[oIe&a$G!M!s&Mr1B=PE r>ln1PEVfhQ9T6JT{+_CSMo 9|1_[h~Y Zv)Bj&3FcoEEuFW7gO>'@S@!FR AURz\*>U/ަGKeI,R3nko IZR)4Q,#<3hqTCbit<7SyM= "w0 KXc>>4cc|%0Iz/gNeI< AT]mi8*?53)q1 !` )e3:j%T±)m_E]Y6*74mh*G@ z':'P-SGq "GLQ N|$59N`xrV+2gU+kIl/INRHT#F0p"Q{Gk /,9sb fs|r `MhMm:Ns`sfD3 ~o!LT YkP=@wy3 {4+~Tt\Yd/}v/B_b{i 7+N RUGv^|wmvB"l3:YF.VRf$T(>+)d?]P*NojdWOJg%V- GA]?އvOOl@QFE AI=tJqW Pd\6.cXxo*6s`4Kqc*n]6=3=":"]Pr7G4%jr]a`t)H@W -GkE Z0 0š%,4S7y󺢣pz+H[8,s}V:I;pVzo?8YR tNFM[)۷uddbt/2+@4%)-|0B= W: WYk߂(Nw][orM/1ݬ#v?@jzZЦ>3>+l/dYn.jH:~㟧L 7N' tGڥ W.6N~#CYe]*+ .>sl2(&14 AIT`a}=BBXTj d`ʤ@ J 0 r[i qrVo3Lm5 p|y\T`]&u9h+h_^  O R7$ȨP3|]9Mȇ`&M27WxR07V<9:agjF0U&FVqs0 akOʅAB$F 0AX$9Ĉ 㦝vԷmg\=%㕔 r韰S񩜮)=aOWDrab!;="0q9zJ7'wi i1G#_@dƲBVH "ϧ& ڦ*Go&ʶ>r ?o@~;wrKʾ;?9OUKC!agdWT. K4w@.fu@l7mNlz̉klτJngjUb۰Oz8iVF?yXEҵfslN@ѯ,ƖXB/Yvs-q[a "_*=nu+6'lst< ՈTJ9wԺyPW CdoAj3ltŽ/j=yr#9':.KaBT~rx$!d{FK oB2pֵ>{9TqU K`U }G@2$'?`JI7PuR[\ݦ)D?$Zg)xa0rYXJ˧LQ86T@Cgy<-if=ckR(}R^6 jO8y}NUhDk!B>{* (sPO$ )}_B|Q@ʭ]X! ډ crD^MjFduCAHȫMgE_hbP{!SZ[@h G`'@*rD|=fѕ J<<fۅJʫ,EQ㶭8 ZS cBx{#۩륹ߨ󰻣" TbϛFdҷӨÜæ;2V S?tYdp삑;Y~˱h ߫qH,I㑥i{km7B!8AB}ܣI\!tEdSUnSUn!nHCu4%|]d"|8ib#P _9>NYٶ t,B#L< %S.v6CDRZp?_lB-bѻ`N2f,Gj5FDo(|hC{o[#1ҟPkFrQ z#W7e#ךdẅȔ2D2Lo俌ŸJ0xv&⛒W%ZF$EP7SM*VSny0%p6.`㟃}Z/)Ј_`6\@}">UjuVk?ri<|_}A>>2<PȈGP-r*{(𬞅,&<.׸ \'h$(*Ok^8YKXorAvc!>qjmRSh.:V\% R 1O=TUN޹?8# snXZ n`^_9Em&Nvi5vql5Yf[:qooIl Jd⚁);-',[lr^H7(G4mekfʅɮvTXj B@/Ԋ@WA7G|)G٬[VE‰2W[?!K={oJpG(^]Pd+"rH׏I5#Gyi*:ʘEZQWr HR0mlD2)nB㕑 _nڛw~w,`Kfy͞phM:'7gsv8ٽWUW~ؼw~_1e-^ >N^%g؟[lIcSPc16&+![d~iD`Lf We{WY!.="w4O?)EDGޞ=R[15'htCo)/}QBi1tcujhZJ| #瑓_7ƨMÔbn#2PU p0Z? R"[ibhN4`xO ٰj^*YiUhYrf4-Ճd86/{TgC=מ~ڟN\zCAMbvS4Lk+}Y+vUF{+ d[֙&.mYɉp1(uws6~ՈqcV?ьKbn:iO\';kC1,/:57h hGman6 MhjC½߉!y߲9c1[8mk 2 q Ų/d_Ɠ f}>  VYrKjAȀyw)(Y&edqθњ}~ Z+p^"m ްM]{"Ӊ8jt%_E9օ<"9u@x4<T¶BѰ%CA&<<{: _WZ]ʥ7Vs5[ѪBWi,O$r&+öL,~ {39JTLH*L=DJ}cZ1u KcFQƮ~?qZ'l=QG:68AwXڡS"Wq0rjlxKEЧ"5LҔ[ ?_|춄}So]@6Y?@`<~>YV|#`U`q5S Z08?FOjk=ݰ^84/A^)oާRcD*4Lx"CҔEj}d/ӄtwT#m7/ fY F qE%#TO@w(IZbNFbєu3y5zh ?+A4\70xN &sk0?mQvIm}6+lqskhTDu\ke=bs8P@ B{([tJ,`fB[]pM.Q]_*w1?Z{<ͺ?2i'P9\~O+;H{=!hjߺKJr-;-mH_2;(|.8T[IĖ_%b ȯW\JRqzFrDzUz&sQ=Ϯ q \~bS`#լW=+DlZ,L2[/QuJ["2Oc@Xwu;naz) Q ỳr;;8m)} %h87Bݺ֮uG2~@ }]EdAkzMn-)f fcNk[s=SWn&\d0;BJ{xZvPZOWm&lH@PF߳kDtWhX5|%XDZ@ob eǫ^qF. .q P,m*_;nC5 Ę$U/DC%I<}(Zgm߉Ŏ,f 󭚐L50 3Ă4xCiPawE<%K5!ATӼswn[w_ށhbė7sy$Woh$G ޝ"K\Vx[M>Ƣ=jf)1~[|>&NWӆXsKYhh~"X:zB ~2gM3j9Zơwҷ!|sAMqpg^oC-:əN=>Â, {"| uڴM8mFfܞW֏7FpAkvu6y1w )Hտ\GF>Vsb ySՠq{+5?N%fiLtYvۑW6k.P,D0sjlM2aQ  I$r_.3P"1,QNO  ݄:a5p:9Y|YRf8w/6!Y7 ZC&vɭҁ.V $oGgv8ĴK\iVoK[h7f!NA PInF ӶA?_կK -5sx@8f7jYN[Mb`hPaY>H-^$l+[,<ǯdV'wf(5y$Y6j$3Cb)MbwZqBACfݟTqƓx @ɻEȋ k@ 'U mbrQ^"0[ksaSH/O`"CrASp6+r-u`\ѓroV>?+-ކT&N ~Rk7fCA48׏歧WLg&KV-R0f^w\y@E2aJ=eQ 䔷>tgTeKu'(o1 s-}}o6E%n&OԜ Efbc̅ڙތK% \2&"d'_uLsLdy;EpSd|꧞ĹL(i៉#H]nxǠ7KOX5 uAiTѤM%=ʓhDlMôl}$/vu;\KvH# )nE4Ex,db5u4,,lR!ǴL}5n 0yW% >&e\ԣ}ƀ:r/n{_?Fl]dW-}V.P{"RF~Oypc]7Ӯ͕RNN̈iPkXO?-U$]8m9S#kMcTWlGߌ[FP o˞]u%Dh8.*ūRL VxķQϣ9(%lnAa*/(k+tE"] B?2tyxMJNZ]U{ |*f:>H1kj`v?<3 _nVfDI\zd /zYM6!1e!0QEf$++E/ow1O8#p9DE/Mrԗ7Xka] ac0!`h xnfkL>bp:RpTYlLv/RŽE[2kM-E~zS`4'm\_lQJظ -.AzfG@)09Ly& 2v] Xj4y¨qkw3M(+-<s'BZsԒGUy$ѧ iGM50<.牺"muH8_}8͚KO9 ! əêZ2T_Rj61 K\%3_fG +i(0Mq[l% lK փ D+n qC g}#F!gƅlԧsΓRcct^ԴY⠇q:oI ;V/l*!,shUZZ3+sbt?bܸŭ&d8jzo:Y>2~̯ՉFh;jҋ56Y%;͇/L%QjrfXj5Ka"ʗaAXY}q4Ykݩ+\Tj+#Wcrw?2)/x x?˺B$*1SS|–(u SgLx ފYאޮq +gkh+Ns|GcR˙;;%EL`" NFa'/P}B;#)[AGQBSO"5D~Cbq,)$g-x%;v> /PvwCHv؄4f?Q? Ε=,<hz9X-xXfχ<Sgf#R7{4@lJ] >$FBIP.458B{->*zg~nԩOxZJ;Y+ g"z_a@t)R/(:Y뎯AykhRݕپAx?x5ja ŐZlпdۏsl2b[zC\싰#{`yǣ 30`eׁ[ARbg+T5b6RőHyo` v:<8%dA4H ZpebQoh)u4]% T[U:<·ɧ@7?^㊅@䷄ViU,òxM޿-5za<Ɛr\DĶR,ifD6A9IK-\ſ!MHt62$8GWX`s('&.$1x-(F;swRqtcFHymf嬙Gb[!b>F ~WsR%L+J!]d_Oph( 63^jea/C!M:"\#5lx^vt$iEiz肖tD/`0_d-`OE ^@W" 'XAWJo0wNߧS 1" -0N<Gܦdr4s cf? n{ӏL#=,Bxies`EWPqr3k(Fߝ{@MQkNh<[Z$;~+ 3b #霁f2 )Rrz0.o=?WOPEUKtjQQ ; x6iP9TBx@EEo7w pmgW*?´ڱ(\Z_\f[Jt9aw&ʖ{ QK/BEOQ[9i=)jAiоȽ\2.3.'r0@pC hi0XLrӝͅ"KN>o=jA)ڑ'o0!e( F41FMuUJJ[o\В߸݇q;jo o]zo"Z^]!nٍ4=)~wr?/&¸ op$Z"o~Y3vq=Y1(3/1D$7̄OOzšRQYƒ|lYJ޻{?'K5vxz-,m Igo:7o ž_<6sՇ*-HVGy>SɂkCYp~>6͟ۉmS+Iu(5]D?36z΅׎oR,eqIK1c;E$28g4Hi8'Em?(꼞T` I[As1*Up9r3X$߮BMnĆ7[&ML%5c+\W^Tg4mq{*板y͍:\sRu *'S`6i,?$,OW*C U_wS{ G0c7e* M.`EE`&}͐K6Jĸ4ƹzJE 鸱VܧaP5Ē-CfzR;{I@Qwp֛32~`[fRɏ?+}07YyHľ94w>Ė%llH@…UQ8ꡭ:Q3uݼ"Zv IXVFV~:`6y+u"k;9(t_+(#]Yeq#+U'oh!DH GfrSbAv 鱢 կP̖X8f,".y2a/Y[X-qR h_4}2u0Q\hd] 7"'}sN0q7Wa*[{c6~w'Zk?SC͓֡qDÈ!m ֧Us7Y"DFΦwʯhk "|XOBJefLo"F;+@2Ѧ=RbI 谊qFw5Skb親"_wiC B{6nvLm":~K 3aI($p h?}=XZ&bT$ E#;(xHh=c4MwBzf!T dEg M?, lYkZGg:TŻkfF>]gvvrS 18s>ʩ@=J@vƫ-U$EFdRshf£B` X%06%]'(ƷuD*_я;MLL$=Ōhu<ä5QŌSKӯ}"qn_-V"ԥWqS8).zk .e)Q @LT!OA(m>„W_ضQ$@M(L~0t^3ݥE3~wg7fiVX k S) P86@H%`dG2'oRo#X8JtɻkEn xzzi9DzCzKU?y/dGyXG`mG1FnK@%N2afq,CΨUȬHYӁ Pp)WF^&"S4íI*V&?UT=p6&d9ađ(w3ײ6/7W̵D[׷0xd q25w%>R{Di^:FUnU$⡏uVIe~,uOm_aC]ؾhǞ/c^/Wq](z(\OPAGke$:#b E,x*>OןKN,pz/DQl5n F|9`;rCtm'>Y.vUT͔񦂧\6vM}34^nyMؒsMVS<%7[Fwv7ܒntMBB_S[! ydjժ|S]Gݼ Z~Ԥhӄ+$K( 䍹©G\g^[{w8՞@p1c<-;4z5P\d?|wx}`M.ZCd7%㬲1rOliWcSPfG` f#/\NB LT-#/Sˑfg*bmxSͨO#/ּЕ;c =9rH25uUPԲJLL9aIT$ʸw% u%Gؠ_ó_Zŭ`7eGq#s6l[S$4ݹ/Q"%⃿P!ь0"HũP/YlsNhR %Տ'CNǐ=?xTߠ8Sg*Q+A9[4UO^ckx&֠"\9%LVzVMiڏE1-UHTE/'ObQy+ PΪѵu>ɋ1(h+Ay`"hTE)zA(3T,L5aKe (&lUN`} - B 9ޛEVX B=@.!@5mx +ƙZ,OasMMZ#G@\ğo=%ΆS9b/R^ΝD犋u4+Dt>Ҧi06uh#8[A1.G~.r&0I 噲`ǞlɣӰseadоZʥNm~ŤCYw3bφdyAng묱󟋊 7@ &.f]>:IJr-pg)XE4$3<:G9NECdFUDDL1EAH- pq_L_NrW>^\&OpT|SP>9 Yg OTJk0`dNw>:.QQQQQ  J6~VMS-TAR-11.32256nWs[TAR]VCDEFS.PEN;1J;1N`Be XAB$W_CXRPOS4$@f XAB$B_CXFSHR$@g XAB$W_POS5$@Xh XAB$B_LVL$@H i XAB$B_NOK$ jXABTRMDEF$$_FILL_6$ k XAB$L_ACLCTX$'@BlXABCXRDEF$$_FILL_9$@ m XAB$W_CXFRTE$Pn XAB$W_POS6$@`o XAB$B_IBS$@P  XAB$W_PVN$ pXABTRMDEF$$_FILL_7$ q XAB$L_ACLSTS$ Br XAB$L_CXRCUR0$@0sXABCXFDEF$$_FILL_7$`t XAB$W_POS7$@hu XAB$B_DBS$ vXABTRMDEF$$_FILL_8$ @wXABPRODEF$$_FILL_10$@Bx XAB$W_CXRCUR4$@8y XAB$B_CXFORG$pz XAB$B_SIZ0$ p{ XAB$L_RVB$ |XABTRMDEF$$_FILL_9$ `}XABPRODEF$$_FILL_11$'@B~XABCXRDEF$$_FILL_10$@@ XAB$W_CXFGBC$x XAB$B_SIZ1$@XAB$R_FLG_OVERLAY$ "XABTRMDEF$$_FILL_10$ XABPRODEF$$_FILL_12$ B XAB$L_CXRSID0$@P XAB$B_CXFRTV$ XAB$B_SIZ2$$@ XAB$B_DTP$ XABPRODEF$$_FILL_13$@B XAB$W_CXRSID4$@XXABCXFDEF$$_FILL_8$ XAB$B_SIZ3$@ XAB$B_NSG$ XABPRODEF$$_FILL_14$'@BXABCXRDEF$$_FILL_11$`XABCXFDEF$$_FILL_9$ XAB$B_SIZ4$@ XAB$B_NUL$ XABPRODEF$$_FILL_15$@ B XAB$W_CXRCNT  $ XAB$B_SIZ5$@ XAB$B_TKS$ XABPRODEF$$_FILL_16$@0B XAB$B_CXRKREF $ XAB$B_SIZ6$@ XAB$B_REF$ XABPRODEF$$_FILL_17$@8B XAB$B_CXRKLEN$ XAB$B_SIZ7$@ XAB$W_MRL$ @XABPRODEF$$_FILL_18$ @B XAB$L_CXRBUF$ XAB$B_TYP0$@ XAB$W_IFL$ `XABPRODEF$$_FILL_19$@`BAXABCXRDEF$$_FILL_12$ XAB$B_TYP1$@ XAB$W_DFL$ XABPRODEF$$_FILL_20 @ $ XAB$B_TYP2$@XAB$R_POS_OVERLAY$ XABPRODEF$$_FILL_21 $ XAB$B_TYP3$$@@pXAB$R_SIZ_OVERLAY$  XAB$B_TYP4$$'@XABKEYDEF$$_FILL_11$( XAB$B_TYP5$  XAB$L_KNM$0 XAB$B_TYP6$  XAB$L_DVB$8 XAB$B_TYP7$@@XAB$R_TYP_OVERLAY$$@@ XAB$B_PROLOG$@HXABKEYDEF$$_FILL_12$'@PXABKEYDEF$$_FILL_13$ ` XAB$L_COLTBL$  XAB$L_COLSIZ$  XAB$L_COLNAM$ XABKEYDEF$$_FILL_14$ XABKEYDEF$$_FILL_15$ XABKEYDEF$$_FILL_16  +LIB$CREATE_DIR $DIRECTORY_SPEC $  OWNER_UIC$ $@PROTECTION_ENABLE  $@PROTECTION_VALUE  $@MAXIMUM_VERSIONS  $@RELATIVE_VOLUME_NUMBER    , LIB$FIND_FILE $FILESPEC $ % RESULTANT_FILESPEC$ $ CONTEXT $DEFAULT_FILESPEC $ $RELATED_FILESPEC$   $  STATUS_VALUE$  $ FLAGS    -LIB$FIND_FILE_END $ CONTEXT  . LIB$GET_INPUT $% GET_STR $PROMPT $@OUT_LEN$ $    / LIB$GETJPI $@ ITEM_CODE $  PROCESS_ID $ PROCESS_NAME  $@ RESULTANT_VALUE$  $% RESULTANT_STRING  $@RESULTANT_LENGTH  $   0LIB$SUBX $@ MINUEND_ARRAY $@SUBTRAHEND_ARRAY$   $IDIFFERENCE_ARRAY$   $  ARRAY_LENGTH$     1 LIB$SYS_FAO $CTR_STR $@ OUT_LEN$ $  % OUT_BUF  $ P $   $@  CONDITION $@  PARAMETERS $@  CONDITION $@  PARAMETERS  4 SYS$SETDFPROT $@ NEW_DEF_PROT $@ CUR_DEF_PROT   5SHELL$MATCH_WILD $ CAND_SPEC $ MATCH_SPEC$$ !  7 CLI$PRESENT $NAME$  8 CLI$GET_VALUE $"#NAME $$% RETBUF$%$&   9 OTS$CVT_TI_L $)* INPUT_STRING $+@  OUTPUT_VALUE$ $, -OUTPUT_VALUE_SIZE $ . FLAGS_VALUE    :STR$MATCH_WILD $12CAND_STR $3 PATTERN_STR$$ L! T! \! d! l! t! |! ! ! ! ! ! ! ! ! Ć! 4! (>H>h>>>>>?H?p????@(@X@t@@@@$ALAAAAB:BdBBBBC8CTCxCCCD4DdDDDD EDEzEEEF4FdFFFFG4GlGGGGH@HdHHHH(IXIIIIJLJ|JJJ Krdrrrrs8shsssstz,T؟ @xȠDvԡ0Lt̢ Rxԣ6nڤ8T|ȥ4X&ZاRpި>vة 4PxĪ$Tƫ:h¬4\ܭ6lޮ8jį(bа (L|ޱ4lҲ,b$Lhִ(fҵ6\|̶,fƷ X¸*Ll޹DhܺFvȻ6d&Z*`ľ&T$VRL&V,^0h8p,\2` :h&T@x Dv Dv.dL~<n(Z2f6j6Dz2j ,P 0<ht$Rl:h4@v0N8j8dp$V >LX~(4T~D\*P&X| $0<HT`lx ,8DP\ht(4@LXdp| $0<HT`lx Jn$T~"N~$Vp,P\|$Rx>h"Lh<v4T$Hz@`<X*[TAR]NEWTAR.DIR;1+,#./ 4-\!.0123 KPWO56748`߾9`c8GHJI AAAREADME.1ST1e BUILD_TAR.COM28DSS.OBJ4DSS.PAS2)DSS.PEN4% LIBIFERR.MAR2' LIBIFERR.OBJ>4  LIBITMLST.MARX2C LIBITMLST.OBJB4  LIBPARSE.MAR+2. LIBPARSE.OBJE4 NEW-FEATURES-TAR-1.12 TAR.CLD2TAR.EXEl4 TAR.HLP3'TAR.MMS 3TAR.OBJ3JTAR.PAS3YTAR.PEN/ TARMSG.MSG83x TARMSG.OBJ=4TAR_EXTRACT.OBJ&4 TAR_EXTRACT.PASL3 TAR_LIST.OBJ1| TAR_LIST.PAS\3 TAR_WRITE.OBJ"4 TAR_WRITE.PASq3 VAXCRTL.OPT; VCDEFS.OBJ( VCDEFS.PASo3  VCDEFS.PEN3% VMSTAR.COM1.*[TAR]OLDTAR.DIR;1+,D./ 4-\!.0123 KPWO56 ro7 ro8 ;p9GHJI AAAREADME.1ST1 AAAREADME.DIF0] BUILD_TAR.COM12 LIBFILATT.MAR;' LIBIFERR.MAR='N LIBITMLST.MAR@'D LIBPARSE.MARA'TAR-1_0-PATCH1.COM(TAR.DIF<0TAR.HLPX'TAR.MMS\'TAR.OBJ'TAR.PAS1)TAR.PEN'L TARMSG.DIFb0H TARMSG.MSGZ1TAR_EXTRACT.DIF0TAR_EXTRACT.PAS31^ TAR_LIST.DIF0, TAR_LIST.PAST1d TAR_WRITE.DIF0 TAR_WRITE.PAS71i VCDEFS.OBJ' VCDEFS.PAS (y VCDEFS.PEN'VMS-TAR.PATCH-0(VMS-TAR.PATCH-1)0 VMS-TAR.SHARE&'" YM~VMS-TAR-11.32256nWs[TAR]VCDEFS.PEN;1J;1/N`Be XAB$W_CXRPOS4$@f XAB$B_CXFSHR$@g XAB$W_POS5$@Xh XAB$B_LVL$@H i XAB$B_NOK$ jXABTRMDEF$$_FILL_6$ k XAB$L_ACLCTX$'@BlXABCXRDEF$$_FILL_9$@ m XAB$W_CXFRTE$Pn XAB$W_POS6$@`o XAB$B_IBS$@P  XAB$W_PVN$ pXABTRMDEF$$_FILL_7$ q XAB$L_ACLSTS$ Br XAB$L_CXRCUR0$@0sXABCXFDEF$$_FILL_7$`t XAB$W_POS7$@hu XAB$B_DBS$ vXABTRMDEF$$_FILL_8$ @wXABPRODEF$$_FILL_10$@Bx XAB$W_CXRCUR4$@8y XAB$B_CXFORG$pz XAB$B_SIZ0$ p{ XAB$L_RVB$ |XABTRMDEF$$_FILL_9$ `}XABPRODEF$$_FILL_11$'@B~XABCXRDEF$$_FILL_10$@@ XAB$W_CXFGBC$x XAB$B_SIZ1$@XAB$R_FLG_OVERLAY$ "XABTRMDEF$$_FILL_10$ XABPRODEF$$_FILL_12$ B XAB$L_CXRSID0$@P XAB$B_CXFRTV$ XAB$B_SIZ2$$@ XAB$B_DTP$ XABPRODEF$$_FILL_13$@B XAB$W_CXRSID4$@XXABCXFDEF$$_FILL_8$ XAB$B_SIZ3$@ XAB$B_NSG$ XABPRODEF$$_FILL_14$'@BXABCXRDEF$$_FILL_11$`XABCXFDEF$$_FILL_9$ XAB$B_SIZ4$@ XAB$B_NUL$ XABPRODEF$$_FILL_15$@ B XAB$W_CXRCNT  $ XAB$B_SIZ5$@ XAB$B_TKS$ XABPRODEF$$_FILL_16$@0B XAB$B_CXRKREF $ XAB$B_SIZ6$@ XAB$B_REF$ XABPRODEF$$_FILL_17$@8B XAB$B_CXRKLEN$ XAB$B_SIZ7$@ XAB$W_MRL$ @XABPRODEF$$_FILL_18$ @B XAB$L_CXRBUF$ XAB$B_TYP0$@ XAB$W_IFL$ `XABPRODEF$$_FILL_19$@`BAXABCXRDEF$$_FILL_12$ XAB$B_TYP1$@ XAB$W_DFL$ XABPRODEF$$_FILL_20 @ $ XAB$B_TYP2$@XAB$R_POS_OVERLAY$ XABPRODEF$$_FILL_21 $ XAB$B_TYP3$$@@pXAB$R_SIZ_OVERLAY$  XAB$B_TYP4$$'@XABKEYDEF$$_FILL_11$( XAB$B_TYP5$  XAB$L_KNM$0 XAB$B_TYP6$  XAB$L_DVB$8 XAB$B_TYP7$@@XAB$R_TYP_OVERLAY$$@@ XAB$B_PROLOG$@HXABKEYDEF$$_FILL_12$'@PXABKEYDEF$$_FILL_13$ ` XAB$L_COLTBL$  XAB$L_COLSIZ$  XAB$L_COLNAM$ XABKEYDEF$$_FILL_14$ XABKEYDEF$$_FILL_15$ XABKEYDEF$$_FILL_16  +LIB$CREATE_DIR $DIRECTORY_SPEC $  OWNER_UIC$ $@PROTECTION_ENABLE  $@PROTECTION_VALUE  $@MAXIMUM_VERSIONS  $@RELATIVE_VOLUME_NUMBER    , LIB$FIND_FILE $FILESPEC $ % RESULTANT_FILESPEC$ $ CONTEXT $DEFAULT_FILESPEC $ $RELATED_FILESPEC$   $  STATUS_VALUE$  $ FLAGS    -LIB$FIND_FILE_END $ CONTEXT  . LIB$GET_INPUT $% GET_STR $PROMPT $@OUT_LEN$ $    / LIB$GETJPI $@ ITEM_CODE $  PROCESS_ID $ PROCESS_NAME  $@ RESULTANT_VALUE$  $% RESULTANT_STRING  $@RESULTANT_LENGTH  $   0LIB$SUBX $@ MINUEND_ARRAY $@SUBTRAHEND_ARRAY$   $IDIFFERENCE_ARRAY$   $  ARRAY_LENGTH$     1 LIB$SYS_FAO $CTR_STR $@ OUT_LEN$ $  % OUT_BUF  $ P $   $@  CONDITION $@  PARAMETERS $@  CONDITION $@  PARAMETERS  4 SYS$SETDFPROT $@ NEW_DEF_PROT $@ CUR_DEF_PROT   5SHELL$MATCH_WILD $ CAND_SPEC $ MATCH_SPEC$$ !  7 CLI$PRESENT $NAME$  8 CLI$GET_VALUE $"#NAME $$% RETBUF$%$&   9 OTS$CVT_TI_L $)* INPUT_STRING $+@  OUTPUT_VALUE$ $, -OUTPUT_VALUE_SIZE $ . FLAGS_VALUE    :STR$MATCH_WILD $12CAND_STR $3 PATTERN_STR$$ L! T! \! d! l! t! |! ! ! ! ! ! ! ! ! Ć! 4! (>H>h>>>>>?H?p????@(@X@t@@@@$ALAAAAB:BdBBBBC8CTCxCCCD4DdDDDD EDEzEEEF4FdFFFFG4GlGGGGH@HdHHHH(IXIIIIJLJ|JJJ Krdrrrrs8shsssstz,T؟ @xȠDvԡ0Lt̢ Rxԣ6nڤ8T|ȥ4X&ZاRpި>vة 4PxĪ$Tƫ:h¬4\ܭ6lޮ8jį(bа (L|ޱ4lҲ,b$Lhִ(fҵ6\|̶,fƷ X¸*Ll޹DhܺFvȻ6d&Z*`ľ&T$VRL&V,^0h8p,\2` :h&T@x Dv Dv.dL~<n(Z2f6j6Dz2j ,P 0<ht$Rl:h4@v0N8j8dp$V >LX~(4T~D\*P&X| $0<HT`lx ,8DP\ht(4@LXdp| $0<HT`lx Jn$T~"N~$Vp,P\|$Rx>h"Lh<v4T$Hz@`<X*[TAR]NEWTAR.DIR;1+,#./ 4-\!.0123 KPWO56748`߾9`c8GHJI AAAREADME.1ST1e BUILD_TAR.COM28DSS.OBJ4DSS.PAS2)DSS.PEN4% LIBIFERR.MAR2' LIBIFERR.OBJ>4  LIBITMLST.MARX2C LIBITMLST.OBJB4  LIBPARSE.MAR+2. LIBPARSE.OBJE4 NEW-FEATURES-TAR-1.12 TAR.CLD2TAR.EXEl4 TAR.HLP3'TAR.MMS 3TAR.OBJ3JTAR.PAS3YTAR.PEN/ TARMSG.MSG83x TARMSG.OBJ=4TAR_EXTRACT.OBJ&4 TAR_EXTRACT.PASL3 TAR_LIST.OBJ1| TAR_LIST.PAS\3 TAR_WRITE.OBJ"4 TAR_WRITE.PASq3 VAXCRTL.OPT; VCDEFS.OBJ( VCDEFS.PASo3  VCDEFS.PEN3% VMSTAR.COM1.*[TAR]OLDTAR.DIR;1+,D./ 4-\!.0123 KPWO56 ro7 ro8 ;p9GHJI AAAREADME.1ST1 AAAREADME.DIF0] BUILD_TAR.COM12 LIBFILATT.MAR;' LIBIFERR.MAR='N LIBITMLST.MAR@'D LIBPARSE.MARA'TAR-1_0-PATCH1.COM(TAR.DIF<0TAR.HLPX'TAR.MMS\'TAR.OBJ'TAR.PAS1)TAR.PEN'L TARMSG.DIFb0H TARMSG.MSGZ1TAR_EXTRACT.DIF0TAR_EXTRACT.PAS31^ TAR_LIST.DIF0, TAR_LIST.PAST1d TAR_WRITE.DIF0 TAR_WRITE.PAS71i VCDEFS.OBJ' VCDEFS.PAS (y VCDEFS.PEN'VMS-TAR.PATCH-0(VMS-TAR.PATCH-1)0 VMS-TAR.SHARE&'"