-+-+-+-+-+-+-+-+ START OF PART 5 -+-+-+-+-+-+-+-+
X            IF inspect_header (archive`5E, file_spec, file_size, file_mtime,
X                  file_mode, directory, link, link_spec) THEN BEGIN
X               files_scanned := files_scanned + 1 ;
X               IF match_filespec (file_spec, match_node) THEN
X                  IF confirm_operation (option, file_spec,
X                        (NOT confirm) OR directory, set_this_false, more)
X                  THEN BEGIN
X                     IF directory THEN
X                        IF NOT confirm AND (file_spec <> dot_slash) THEN BEG
VIN
X                           make_directory (file_spec, file_mode) ;
X                           files_created := files_created + 1 END
X                        ELSE
X                           `7B do nothing `7D
X                     ELSE BEGIN
X                        extract_file (archive`5E, file_spec, file_size,
X                           file_mtime, file_mode, link, link_spec) ;
X                        files_created := files_created + 1 END ;
X                     file_scanned := true END
X               END
X            ELSE  `7B inspect_header = false `7D
X               IF eof_archive THEN
X                  more := false
X               ELSE
X                  bad_header (archive`5E) ;    `7B stops execution `7D
X            IF file_scanned THEN
X               IF eof (archive) THEN
X                  more := false
X               ELSE
X                  get (archive)
X            ELSE
X               scan_to_next_header (file_size) ;
X            more := more AND NOT eof (archive) END ;
X
X         LIB$SIGNAL (tar__totcreat, 2, files_created, files_scanned) ;
X         close (archive) ;
X         END ;    `7B extract `7D
X
X
X   END.
$ CALL UNPACK TAR_EXTRACT.PAS;1 1886082001
$ create 'f'
X`7B TAR_LIST.PAS -`09Routines to support TAR/LIST
X!
X! Copyright:`09Copyright 1989,1990, Victoria College Computer Services.
X!`09`09All rights reserved except those granted in the file
X!`09`09AAAREADME.1ST, which is distributed with this file.
X!
X! Author:`09Tim Cook (timcc@viccol.edu.au)
X`7D
X
X`5BINHERIT ('SYS$LIBRARY:STARLET', 'VCDEFS', 'TAR'),
X   %INCLUDE 'TAR_VERSION.PAS'`5D
X
XMODULE list ;
X
X
X   PROCEDURE find_device_structure (
X      device_name : filespec_type ;
X      VAR dir : `5BUNSAFE`5D integer ;          `7B Device is directory-stru
Vctured `7D
X      VAR sdi : `5BUNSAFE`5D integer) ;         `7B Device is single-dir str
Vuctured `7D
X
X      BEGIN
X         lib_sigiferr ($GETDVIW (,, device_name, lib_item_list (
X            lib_out_item (DVI$_DIR, %DESCR dir),
X            lib_out_item (DVI$_SDI, %DESCR sdi)))) END ;
X
X
X   `5BGLOBAL`5D PROCEDURE tar_list (
X      VAR archive_filespec : `5BREADONLY`5D filespec_type ;
X      full : boolean) ;
X
X      TYPE
X         fixed_string = PACKED ARRAY `5B1..255`5D OF char ;
X
X         fixed_string_ptr = RECORD CASE integer OF
X0:(         address : unsigned) ;
X1:(         pointer : `5Efixed_string) END ;
X
X      VAR
X         file_spec : medium_string ;
X         file_size : integer ;
X         file_mtime : unsigned ;
X         file_mode : file_mode_type ;
X         directory : boolean ;
X         link : boolean ;
X         link_spec : filespec_type ;
X
X         files_listed, files_in_archive : integer ;
X         directory_structured : integer ;
X         single_directory_structured : integer ;
X         more_in_archive : boolean ;
X
X
X      PROCEDURE list_file (
X         full : boolean ;
X         VAR header_record : tar_record_type ;
X         VAR file_spec : `5BREADONLY`5D filespec_type ;
X         file_size : integer ;
X         file_mtime : unsigned ;
X         file_mode : file_mode_type ;
X         directory : boolean := false ;
X         link : boolean := false ;
X         VAR link_spec : `5BREADONLY`5D filespec_type) ;
X
X         VAR
X            prot_list : PACKED ARRAY `5B1..10`5D OF char ;
X            out_line : medium_string ;
X            uid_int, gid_int : integer ;
X
X         BEGIN
X            WITH header_record DO BEGIN
X               IF full THEN BEGIN
X                  prot_list := '-rwxrwxrwx' ;
X                  readv (uid.value, uid_int:oct) ;
X                  readv (gid.value, gid_int:oct) ;
X                  FOR i := 0 TO 8 DO
X                     IF NOT file_mode.mask`5Bi`5D THEN prot_list`5B10-i`5D :
V= '-' ;
X`09`09  IF file_mode.mask`5B10`5D THEN
X                     prot_list`5B1`5D := 'd'   `7B Directory `7D
X                  ELSE IF link THEN
X                     prot_list`5B1`5D := 'l' ;  `7B Link `7D
X                  out_line := '' ;
X                  lib_sigiferr (LIB$SYS_FAO ('!AS !4UL/!3UL!10UL  !AS  !AS',
V,
X                     out_line, %STDESCR (prot_list), uid_int, gid_int,
X                     file_size,
X                     %STDESCR (UNIX_time_to_str (file_mtime, delta_seconds))
V,
X                     %STDESCR (file_spec))) ;
X                  write (out_line) END
X               ELSE
X                  write (file_size:10, space, file_spec) ;
X               IF link THEN
X                  writeln (' -> ', link_spec)
X               ELSE
X                  writeln ;
X               files_listed := files_listed + 1 END END ;
X
X
X      BEGIN    `7B tar_list `7D
X         IF cli_present (filespec_kt) THEN
X            collect_matches (match_node)
X         ELSE BEGIN
X            match_all := true ;
X            match_node := nil END ;
X         lib_parse (archive_filespec, full_archive_spec, '.TAR') ;
X         find_device_structure ((full_archive_spec), directory_structured,
X            single_directory_structured) ;
X         open_archive_input (archive_filespec,
X            share := NOT (single_directory_structured)::boolean) ;
X         full_archive_spec := find_file_spec (archive) ;
X         files_listed := 0 ;
X         files_in_archive := 0 ;
X         more_in_archive := inspect_header (archive`5E, file_spec, file_size
V,
X            file_mtime, file_mode, directory, link, link_spec) ;
X
X         IF NOT (directory_structured)::boolean THEN
X            full_archive_spec := substr (full_archive_spec, 1,
X               index (full_archive_spec, colon)) ;
X
X         IF NOT more_in_archive THEN
X            LIB$STOP (tar__badarchive, 1, %STDESCR (full_archive_spec)) ;
X         writeln (crlf, 'Listing of archive ', full_archive_spec, crlf) ;
X         WHILE more_in_archive DO BEGIN
X            files_in_archive := files_in_archive + 1 ;
X            IF match_filespec (file_spec, match_node) THEN
X               list_file (full, archive`5E, file_spec, file_size, file_mtime
V,
X                  file_mode, directory, link, link_spec) ;
X            IF directory OR link THEN
X               scan_to_next_header (0)
X            ELSE
X               scan_to_next_header (file_size) ;
X            IF eof (archive) THEN
X               more_in_archive := false
X            ELSE
X               more_in_archive := inspect_header (archive`5E, file_spec,
X                  file_size, file_mtime, file_mode, directory, link,
X                  link_spec) END ;
X         IF files_listed > 0 THEN writeln ;
X         writeln ('Total of ', files_listed:1, ' files listed, ',
X            files_in_archive:1, ' files in archive.') ;
X         close (archive) ;
X         END ;
X
X
X   END.
$ CALL UNPACK TAR_LIST.PAS;1 326925498
$ create 'f'
X`7B TAR_VERSION.PAS -`09Provides an IDENT attribute to denote TAR version
X!
X! Copyright:`09Copyright 1989,1990, Victoria College Computer Services.
X!`09`09All rights reserved except those granted in the file
X!`09`09AAAREADME.1ST, which is distributed with this file.
X!
X! Author:`09Tim Cook (timcc@viccol.edu.au)
X`7D
X
XIDENT ('T1.2')
$ CALL UNPACK TAR_VERSION.PAS;1 1195448671
$ create 'f'
X`7B TAR_WRITE.PAS -`09Routines to support TAR/WRITE and TAR/APPEND
X!
X! Copyright:`09Copyright 1989,1990, Victoria College Computer Services.
X!`09`09All rights reserved except those granted in the file
X!`09`09AAAREADME.1ST, which is distributed with this file.
X!
X! Author:`09Tim Cook (timcc@viccol.edu.au)
X`7D
X
X`5BINHERIT ('SYS$LIBRARY:STARLET', 'VCDEFS', 'TAR', 'DSS'),
X   %INCLUDE 'TAR_VERSION.PAS'`5D
X
XMODULE write ;
X
X   CONST
X      in_buffer_size = 8192 ;
X
X   TYPE
X      in_buffer_type = PACKED ARRAY `5B1..in_buffer_size`5D OF char ;
X
X   VAR
X      in_fab : FAB$TYPE ;
X      in_xabdat, in_xabfhc, in_xabpro : XAB$TYPE ;
X      in_rab : RAB$TYPE ;
X
X      in_buffer : in_buffer_type ;
X
X      input_filespec_default : filespec_type ;
X      file_spec, default_spec, result_spec : filespec_type ;
X      record_format : lib_byte_type ;
X      max_record_size, first_free_byte : lib_word_type ;
X      eof_block : unsigned ;
X      filespecs_in_storage : boolean ;
X
X
X   VALUE
X      in_fab := zero ;
X      in_xabdat := zero ;
X      in_xabfhc := zero ;
X      in_xabpro := zero ;
X      in_rab := zero ;
X      filespecs_in_storage := false ;
X
X
X   FUNCTION another_file (
X      VAR next_file : filespec_type) : boolean ;
X
X      VAR
X         context : `5BSTATIC`5D lib_fab_pointer := nil ;
X         filespec : `5BSTATIC`5D filespec_type := '' ;
X         status : sts_type ;
X         more : boolean ;
X
X      BEGIN
X         IF filespecs_in_storage THEN BEGIN
X            get_string_from_storage (next_file) ;
X            another_file := next_file <> '' END
X         ELSE BEGIN
X            more := true ;
X            WHILE more DO BEGIN
X               IF filespec = '' THEN
X                  IF failure (CLI$GET_VALUE (filespec_kt, filespec)) THEN BE
VGIN
X                     more := false ;
X                     another_file := false END
X                  ELSE
X               ELSE BEGIN
X                  status := LIB$FIND_FILE (filespec, next_file, context,
X                     input_filespec_default) ;
X                  CASE status OF
X                     RMS$_NMF, RMS$_FNF : BEGIN
X                        IF status = RMS$_FNF THEN
X                           LIB$SIGNAL (tar__nofiles, 1, %STDESCR (next_file)
V) ;
X                        LIB$FIND_FILE_END (context) ;
X                        filespec := '' END ;
X                     RMS$_NORMAL : BEGIN
X                        another_file := true ;
X                        more := false END ;
X                     OTHERWISE BEGIN
X                        another_file := false ;
X                        LIB$STOP (tar__parse, 1, %STDESCR (filespec), status
V,
X                           context`5E.FAB$L_STV) END END END END END END ;
X
X
X   PROCEDURE collect_filespecs (
X      VAR prefix : filespec_type ;
X      retain_version : boolean := false) ;
X
X      VAR
X         selection : filespec_type ;
X         i, j : integer ;
X         first_time, more, done : boolean ;
X         status : sts_type ;
X
X      BEGIN
X         first_time := true ;
X         more := true ;
X         WHILE another_file (selection) DO BEGIN
X            put_string_in_storage (selection) ;
X            selection := UNIX_filespec (selection, absolute_mode,,
X               retain_version) ;
X            IF first_time THEN BEGIN
X      `7B Find a first prefix, but ensure the base file name is'nt part of i
Vt `7D
X               i := length (selection) ;
X               done := false ;
X               WHILE NOT done DO BEGIN
X                  IF i = 0 THEN
X                     done := true
X                  ELSE IF selection`5Bi`5D = '/' THEN
X                     done := true
X                  ELSE
X                     i := i - 1 END ;
X               prefix := substr (selection, 1, i) ;
X               first_time := false END
X            ELSE BEGIN    `7B find a common prefix to the filenames `7D
X               j := min (length (selection), length (prefix)) ;
X               i := 1 ;
X               done := false ;
X               WHILE NOT done DO BEGIN
X                  IF (i > j) THEN
X                     done := true
X                  ELSE IF (selection`5Bi`5D <> prefix`5Bi`5D) THEN
X                     done := true
X                  ELSE
X                     i := i + 1 END ;
X               prefix.length := i - 1 END END ;
X
X         rewind_storage ;
X
X   `7B Back up enough to ensure that the prefix ends with a '/' `7D
X
X         i := length (prefix) ;
X         done := false ;
X         WHILE NOT done DO BEGIN
X            IF i = 0 THEN
X               done := true
X            ELSE IF prefix`5Bi`5D = '/' THEN
X               done := true
X            ELSE
X               i := i - 1 END ;
X         prefix.length := i END ;
X
X
X   FUNCTION open_input_file (
X      VAR file_spec : filespec_type ;
X      VAR record_format : `5BUNSAFE`5D lib_byte_type ;
X      VAR record_size : `5BUNSAFE`5D lib_word_type ;
X      VAR eof_block : `5BUNSAFE`5D unsigned ;
X      VAR first_free_byte : `5BUNSAFE`5D lib_word_type ;
X      VAR modification_date : `5BUNSAFE`5D lib_date_type ;
X      VAR protection : `5BUNSAFE`5D lib_word_type) : sts_type ;
X
X      VAR
X         status : sts_type ;
X
X      BEGIN
X         in_fab.FAB$B_BID := FAB$C_BID ;
X         in_fab.FAB$B_BLN := FAB$C_BLN ;
X         in_fab.FAB$V_GET := true ;
X         in_fab.FAB$V_SHRGET := true ;
X         in_fab.FAB$L_XAB := iaddress (in_xabdat) ;
X         in_fab.FAB$L_FNA := iaddress (file_spec.body) ;
X         in_fab.FAB$B_FNS := (file_spec.length)::lib_byte_type ;
X
X         in_xabdat.XAB$B_COD := XAB$C_DAT ;
X         in_xabdat.XAB$B_BLN := XAB$C_DATLEN ;
X         in_xabdat.XAB$L_NXT := iaddress (in_xabfhc) ;
X
X         in_xabfhc.XAB$B_COD := XAB$C_FHC ;
X         in_xabfhc.XAB$B_BLN := XAB$C_FHCLEN ;
X         in_xabfhc.XAB$L_NXT := iaddress (in_xabpro) ;
X
X         in_xabpro.XAB$B_COD := XAB$C_PRO ;
X         in_xabpro.XAB$B_BLN := XAB$C_PROLEN ;
X
X         status := $OPEN (in_fab) ;
X
X         IF success (status) THEN BEGIN
X            record_format := in_fab.FAB$B_RFM ;
X            record_size := in_fab.FAB$W_MRS ;
X            eof_block := in_xabfhc.XAB$L_EBK ;
X            first_free_byte := in_xabfhc.XAB$W_FFB ;
X            modification_date := (in_xabdat.XAB$Q_RDT)::lib_date_type ;
X            protection := in_xabpro.XAB$W_PRO ;
X
X            in_rab.RAB$B_BID := RAB$C_BID ;
X            in_rab.RAB$B_BLN := RAB$C_BLN ;
X            in_rab.RAB$B_MBC := tar_multi_block_count ;
X               `7B Multi-block count; specifies how many blocks of a sequent
Vial
X                 file are read per disk access `7D
X            in_rab.RAB$L_FAB := iaddress (in_fab) ;
X
X            status := $CONNECT (in_rab) ;
X
X            in_rab.RAB$B_RAC := RAB$C_SEQ ;
X            in_rab.RAB$L_UBF := iaddress (in_buffer) ;
X            CASE record_format OF
X               FAB$C_UDF : `7B undefined, or stream binary `7D
X                  in_rab.RAB$W_USZ := tar_record_size ;
X               FAB$C_FIX :
X                  IF record_size > in_buffer_size THEN
X                     LIB$STOP (tar__openin, 1, %STDESCR (file_spec),
X                        tar__rectoolong, 1, (record_size)::unsigned)
X                  ELSE
X                     in_rab.RAB$W_USZ := record_size ;
X               FAB$C_VAR, FAB$C_VFC, FAB$C_STM, FAB$C_STMLF, FAB$C_STMCR :
X                  in_rab.RAB$W_USZ := size (in_buffer) ;
X               END END ;
X
X         open_input_file := status END ;
X
X
X   FUNCTION open_directory (
X      VAR file_spec : filespec_type ;
X      VAR modification_date : `5BUNSAFE`5D lib_date_type ;
X      VAR protection : `5BUNSAFE`5D lib_word_type) : sts_type ;
X
X      VAR
X         status : sts_type ;
X
X      BEGIN
X         in_fab.FAB$B_BID := FAB$C_BID ;
X         in_fab.FAB$B_BLN := FAB$C_BLN ;
X         in_fab.FAB$V_GET := true ;
X         in_fab.FAB$V_SHRGET := true ;
X         in_fab.FAB$L_XAB := iaddress (in_xabdat) ;
X         in_fab.FAB$L_FNA := iaddress (file_spec.body) ;
X         in_fab.FAB$B_FNS := (file_spec.length)::lib_byte_type ;
X
X         in_xabdat.XAB$B_COD := XAB$C_DAT ;
X         in_xabdat.XAB$B_BLN := XAB$C_DATLEN ;
X         in_xabdat.XAB$L_NXT := iaddress (in_xabpro) ;
X
X         in_xabpro.XAB$B_COD := XAB$C_PRO ;
X         in_xabpro.XAB$B_BLN := XAB$C_PROLEN ;
X
X         status := $OPEN (in_fab) ;
X
X         IF success (status) THEN BEGIN
X            modification_date := (in_xabdat.XAB$Q_RDT)::lib_date_type ;
X            protection := in_xabpro.XAB$W_PRO ;
X            $CLOSE (in_fab) END ;
X
X         open_directory := status END ;
X
X
X   FUNCTION VMS_to_UNIX_protection (
X      VMS_protection : file_protection_type ;
X      directory : boolean := false) : unsigned ;
X
X      VAR
X         return : unsigned ;
X
X      BEGIN
X      `7B Note that, because most files that have READ set in VMS also
X        have EXECUTE set, I ignore EXECUTE `7D
X
X         WITH VMS_protection DO BEGIN
X            IF NOT owner.noread THEN return := 256                `7B u+r `7
VD
X            ELSE return := 0 ;
X            IF NOT owner.nowrite THEN return := return + 128 ;    `7B u+w `7
VD
X            IF NOT group.noread THEN return := return + 32 ;      `7B g+r `7
VD
X            IF NOT group.nowrite THEN return := return + 16 ;     `7B g+w `7
VD
X            IF NOT world.noread THEN return := return + 4 ;       `7B o+r `7
VD
X            IF NOT world.nowrite THEN return := return + 2 ;      `7B o+w `7
VD
X            IF directory THEN BEGIN
X               return := return + 1024 ;   `7B set the 'd' bit `7D
X
X            `7B Note that the EXECUTE privilege on a directory in VMS is
X              not equivalent to it's namesake in UNIX `7D
X
X               IF NOT owner.noread THEN return := return + 64 ;   `7B u+x `7
VD
X               IF NOT group.noread THEN return := return + 8 ;    `7B g+x `7
VD
X               IF NOT world.noread THEN return := return + 1 END ;`7B o+x `7
VD
X            END ;
X         VMS_to_UNIX_protection := return END ;
X
X
X   PROCEDURE build_header (
X      head_filespec : filespec_type ;
X      filesiz : integer ;
X      VAR out_header : tar_record_type ;
X      map_mode : map_mode_type ;
X      modification_date : lib_date_type ;
X      protection : file_protection_type ;
X      prefix_length : integer := 0 ;
X      directory : boolean := false ;
X      retain_version : boolean := false) ;
X
X      VAR
X         i : integer ;
X         temp_filespec : medium_string ;
X         temp_string : small_string ;
X         checksum : integer ;
X
X      BEGIN
X         out_header := default_header ;
X         temp_string := oct (
X            VMS_to_UNIX_protection (protection, directory), 6, 3) ;
X         out_header.mode.value := temp_string ;
X         temp_string := oct (filesiz, 11, 1) + space ;
X         out_header.siz := temp_string ;
X         temp_string :=
X            oct (VMS_to_UNIX_time (modification_date, delta_seconds), 11, 1)
V +
X            space ;
X         out_header.mtime := temp_string ;
X         temp_filespec := UNIX_filespec (head_filespec, map_mode,
X            prefix_length, retain_version) ;
X         IF directory THEN BEGIN    `7B Change ".dir" to "/" `7D
X            temp_filespec.length := index (temp_filespec, '.dir') ;
X            temp_filespec`5Btemp_filespec.length`5D := slash END ;
X         FOR i := 1 to length (temp_filespec) DO
X            out_header.name`5Bi`5D := temp_filespec`5Bi`5D ;
X         `7B I had to do that, to prevent Pascal from blank-padding it `7D
X         out_header.chksum.value := '      ' ;
X         out_header.chksum.fill_null := space ;
X         out_header.chksum.fill_space := space ;
X         checksum := 0 ;
X         FOR i := 1 TO tar_record_size DO
X            checksum := checksum + ord (out_header.data`5Bi`5D) ;
X         writev (temp_string, oct (checksum, 6, 1)) ;
X         out_header.chksum.value := temp_string ;
X         out_header.chksum.fill_space := null ; `7B That's how DYNIX tar doe
Vs it`7D
X         END ;
X
X
X   PROCEDURE write_archive (
X      VAR file_buf : tar_file_type ;
X      VAR out_record : in_buffer_type ;
X      VAR record_length : `5BUNSAFE`5D lib_word_type ;
X      add_lf : boolean := true) ;
X
X      VAR
X         i : lib_word_type ;
X
X      BEGIN
X         IF add_lf THEN
X            IF record_length < in_buffer_size THEN BEGIN
X               record_length := record_length + 1 ;
X               out_record`5Brecord_length`5D := lf END ;
X         FOR i := 1 TO record_length DO BEGIN
X            IF last_char = tar_record_size THEN BEGIN
X               put (file_buf) ;
X               last_char := 1 END
X            ELSE
X               last_char := last_char + 1 ;
X            file_buf`5E.data`5Blast_char`5D := out_record`5Bi`5D END ;
X         END ;
X
X
X   FUNCTION is_directory (
X      filespec : filespec_type) : boolean ;
X
X      BEGIN
X      `7B A simple test, but I don't feel like looking at file-headers (this
X        is unsupported).  If someone plays around with the use of '.DIR;1',
X        it's their fault. `7D
X         is_directory :=
X            substr (filespec, filespec.length - 5, 6) = dot_dir_1_kt END ;
X
X
X   `5BGLOBAL`5D PROCEDURE tar_write (
X      VAR archive_filespec : `5BREADONLY`5D filespec_type ;
X      confirm : boolean ;
X      scan : boolean ;
X      map_mode : map_mode_type ;
X      appending : boolean := false ;
X      retain_version : boolean := false) ;
X
X      VAR
X         more : boolean ;
X         tar_record : tar_record_type ;
X         current_file : filespec_type ;
X         file_size : integer ;
X         no_records : integer ;
X         files_written : integer ;
X         write_message, write_dir_message : sts_type ;
X
X         record_format : lib_byte_type ;       `7B These all correspond to t
Vhe `7D
X         record_length : lib_word_type ;       `7B  input file `7D
X         eof_block : integer ;
X         first_free_byte : lib_word_type ;
X         modification_date : lib_date_type ;
X         protection : file_protection_type ;
X
X         status : sts_type ;
X         prefix, pending_directory : filespec_type ;
X
X
X      PROCEDURE load_direct ;     `7B Directly loads a fixed record length `
V7D
X         BEGIN                    `7B or stream binary file `7D
X            file_size := (eof_block - 1) * 512 + first_free_byte ;
X
X   `7B The test below is for cases where the first_free_byte value does not
X     point to the first byte in a logical record (I have seen this in .EXE's
V) `7D
X
X            IF record_format = FAB$C_FIX THEN
X               IF file_size REM record_length > 0 THEN
X                  file_size := (file_size DIV record_length + 1) *
X                     record_length ;
X
X            build_header (current_file, file_size, archive`5E, map_mode,
X               modification_date, protection, length (prefix),,
X               retain_version) ;
X            put (archive) ;      `7B writes header `7D
X            status := $GET (in_rab) ;
X            WHILE success (status) DO BEGIN
X               write_archive (archive, in_buffer, in_rab.RAB$W_RSZ, false) ;
X               no_records := no_records + 1 ;
X               status := $GET (in_rab) END ;
X            IF status <> RMS$_EOF THEN
X               LIB$STOP (tar__errread, 3, 0, 0, %STDESCR (current_file),
X                  status, in_rab.RAB$L_STV) ;
X            IF file_size > 0 THEN               `7B If non-empty file `7D
X               put (archive) ;                  `7B like a flush `7D
X            END ;
X
X
X      PROCEDURE load_after_scan ;  `7B Scans a var-len file for size then lo
Vads `7D
X         BEGIN
X            status := $GET (in_rab) ;
X            WHILE success (status) DO BEGIN
X               file_size := file_size + in_rab.RAB$W_RSZ + 1 ;
X               status := $GET (in_rab) END ;
X            IF status <> RMS$_EOF THEN
X               LIB$STOP (tar__errread, 3, 0, 0, %STDESCR (current_file),
X                  status, in_rab.RAB$L_STV) ;
X
X            build_header (current_file, file_size, archive`5E, map_mode,
X               modification_date, protection, length (prefix),,
X               retain_version) ;
X            put (archive) ;      `7B writes header `7D
X
X            status := $REWIND (in_rab) ;
X            IF failure (status) THEN
X               LIB$STOP (tar__errread, 3, 0, 0, %STDESCR (current_file),
X                  status, in_rab.RAB$L_STV) ;
X
X            status := $GET (in_rab) ;
X            WHILE success (status) DO BEGIN
X               write_archive (archive, in_buffer, in_rab.RAB$W_RSZ) ;
X               no_records := no_records + 1 ;
X               status := $GET (in_rab) END ;
X            IF status <> RMS$_EOF THEN
X               LIB$STOP (tar__errread, 3, 0, 0, %STDESCR (current_file),
X                  status, in_rab.RAB$L_STV) ;
X            IF file_size > 0 THEN               `7B If non-empty file `7D
X               put (archive) ;
X
X            END ;
X
X
X      PROCEDURE load_from_temp ;
X         BEGIN
X            IF NOT archive_temp_open THEN BEGIN
X               open (archive_temp, history := NEW, disposition := DELETE,
X                  default := sys$scratch_kt) ;
X               archive_temp_open := true END ;
X            rewrite (archive_temp) ;
X
X            status := $GET (in_rab) ;
X            WHILE success (status) DO BEGIN
X               file_size := file_size + in_rab.RAB$W_RSZ + 1 ;
X               write_archive (archive_temp, in_buffer, in_rab.RAB$W_RSZ) ;
X               status := $GET (in_rab) END ;
X            IF status <> RMS$_EOF THEN
X               LIB$STOP (tar__errread, 3, 0, 0, %STDESCR (current_file),
X                  status, in_rab.RAB$L_STV) ;
+-+-+-+-+-+-+-+-  END  OF PART 5 +-+-+-+-+-+-+-+-