-+-+-+-+-+-+-+-+ START OF PART 6 -+-+-+-+-+-+-+-+ X IF file_size > 0 THEN `7B If non-empty file `7D X put (archive_temp) ; X X reset (archive_temp) ; 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 WHILE NOT eof (archive_temp) DO BEGIN X read (archive_temp, tar_record) ; X write (archive, tar_record) END ; X END ; X X X PROCEDURE load_directory ( X VAR directory_name : filespec_type) ; X X VAR X temp_string : medium_string ; X X BEGIN X temp_string := directory_name + dot_dir_1_kt ; X IF success ( X open_directory (temp_string, modification_date, protection V)) X THEN BEGIN X build_header (temp_string, 0, archive`5E, map_mode, X modification_date, protection, prefix.length, X directory := true) ; X put (archive) ; X LIB$SIGNAL (write_dir_message, 1, %STDESCR (temp_string)) END X ELSE X LIB$STOP (tar__openin, 1, %STDESCR (temp_string)) END ; X X X BEGIN `7B tar_write `7D X IF NOT appending THEN BEGIN X creating_archive_output := true ; X open (archive, archive_filespec, history := NEW, X default := dot_tar_kt) ; X rewrite (archive) ; X creating_archive_output := false ; X write_message := tar__written ; X write_dir_message := tar__writdir END X ELSE BEGIN X truncate (archive) ; X write_message := tar__appended ; X write_dir_message := tar__appendir END ; X files_written := 0 ; X pending_directory := '' ; X prefix := '' ; X IF map_mode = prefix_mode THEN X IF CLI$PRESENT (filespec_kt) = CLI$_DEFAULTED THEN X map_mode := single_dir_mode X ELSE BEGIN X collect_filespecs (prefix, retain_version) ; X filespecs_in_storage := true END ; X IF retain_version THEN X input_filespec_default := '*.*;*' X ELSE X input_filespec_default := '*.*;' ; X more := true ; X WHILE another_file (current_file) AND more DO X IF is_directory (current_file) THEN BEGIN X current_file.length := current_file.length - 6 ; X IF confirm THEN X pending_directory := current_file X ELSE X load_directory (current_file) END X ELSE X IF confirm_operation (option, current_file, NOT confirm, X set_this_false, more) THEN BEGIN X IF pending_directory.length > 0 THEN X IF pending_directory = substr (current_file, 1, X pending_directory.length) THEN X load_directory (pending_directory) ; X open_input_file (current_file, record_format, record_lengt Vh, X eof_block, first_free_byte, modification_date, X protection) ; X last_char := 0 ; X no_records := 0 ; X file_size := 0 ; X IF record_format IN `5BFAB$C_FIX, FAB$C_UDF`5D THEN X load_direct X ELSE X IF scan THEN X load_after_scan X ELSE X load_from_temp ; X files_written := files_written + 1 ; X LIB$SIGNAL (write_message, 2, %STDESCR (current_file), X file_size) ; X `7B file built and written `7D X status := $CLOSE (in_fab) ; X IF failure (status) THEN X LIB$STOP (tar__close, 1, %STDESCR (current_file), X status, in_fab.FAB$L_STV) ; X END ; `7B IF confirmed `7D X X IF files_written > 0 THEN X IF appending THEN X LIB$SIGNAL (tar__totappend, 1, files_written) X ELSE X LIB$SIGNAL (tar__totwrite, 1, files_written) ; X FOR i := 1 TO record_size DO X archive`5E.data`5Bi`5D := null ; X put (archive) ; put (archive) ; `7B emulate tar's personal eof V `7D X IF archive_temp_open THEN BEGIN X close (archive_temp, disposition := DELETE) ; X archive_temp_open := false END ; X close (archive) ; X END ; `7B tar_write `7D X X X `5BGLOBAL`5D PROCEDURE tar_append ( X VAR archive_filespec : `5BREADONLY`5D filespec_type ; X confirm : boolean ; X scan : boolean ; X map_mode : map_mode_type ; X retain_version : boolean := false) ; X X VAR X archive_size : unsigned ; X more, doit : boolean ; X fab : fab_pointer ; X X BEGIN `7B tar_append `7D X open_archive_input (archive_filespec) ; X result_spec := find_file_spec (archive) ; X fab := PAS$FAB (archive) ; X IF (fab`5E.FAB$B_RFM <> FAB$C_FIX) OR (fab`5E.FAB$W_MRS <> record_s Vize) X THEN X LIB$STOP (tar__badarchive, 1, %STDESCR (result_spec)) ; X X more := true ; X WHILE more DO X IF eof (archive) THEN X more := false X ELSE X IF checksum (archive`5E) > 0 THEN X more := scan_to_next_header X ELSE X more := false ; X X doit := false ; X IF eof (archive) THEN X doit := true X ELSE X IF checksum (archive`5E) = 0 THEN X doit := true ; X IF doit THEN X tar_write ('', confirm, scan, map_mode, true, retain_version) X ELSE X LIB$STOP (tar__badarchive, 1, %STDESCR (result_spec)) ; X END ; `7B tar_append `7D X X X END. $ CALL UNPACK TAR_WRITE.PAS;1 88483268 $ create 'f' X`7B X! VCDEFS.PAS -`09VCLIB definitions needed by TAR X! X! This file contains all definitions needed by TAR when packaged for X! external distribution. When TAR is built locally, these definitions X! come from SRC_VCLIB:VCLIB.PEN, but for the distribution package, I X! have extracted the needed definitions from the appropriate files in X! SRC_VCLIB: Any routines defined in here but not coded in here will X! be in appropriately named MACRO source files. X! X! This file can be used to build an evironment and object file to be used X! when building TAR, or it can be %INCLUDEd by TAR.PAS, or it can be X! /INSERTed into a help library. X! X! Tim Cook, 24-FEB-1989 X!-------------------------------------------------------------- X!`7D `5BINHERIT ('SYS$LIBRARY:STARLET'), ENVIRONMENT ('VCDEFS')`5D `7B X!`7D MODULE vclib ; `7B X! X! From SRC_VCLIB:LIBDEF.PAS X! X1 LIBDEFPAS X2 CONST X!`7D CONST X lib_k_maxbyte = %xFF ; X lib_k_maxword = %xFFFF ; X lib_k_maxlong = %xFFFFFFFF ;`7B X2 TYPE X!`7D TYPE X sts_type = integer ; X lib_lo_hi = (low, high) ; X lib_byte_type = `5BBYTE`5D 0..lib_k_maxbyte ; X lib_word_type = `5BWORD`5D 0..lib_k_maxword ; X lib_signed_word_type = `5BWORD`5D -%x8000..%x7FFF ; X lib_long_type = `5BLONG`5D unsigned ; X lib_3byte_type = `5BBYTE(3)`5D 0..%xFFFFFF ; X lib_quad_type = `5BQUAD`5D ARRAY `5Blow..high`5D OF unsigned ; X lib_signed_quad_type = `5BQUAD`5D RECORD CASE integer OF X0:( lo : unsigned ; X hi : integer) ; X1:( value : `5BQUAD`5D PACKED SET OF 0..63) END ; X lib_date_type = lib_signed_quad_type ; X prv_type = `5BQUAD`5D PACKED SET OF 0..63 ; X lib_long_set_type = `5BLONG`5D SET OF 0..31 ; X lib_sigargs_type = RECORD X param_count : unsigned ; X condition : sts_type ; X parameter : ARRAY `5B1..20`5D OF unsigned END ; X lib_mechargs_type = RECORD X param_count : unsigned ; X stack_frame_address : unsigned ; X stack_frame_depth : unsigned ; X r0, r1 : unsigned END ; X lib_fab_pointer = `5EFAB$TYPE ; X lib_numtim_type = RECORD X year, month, day, X hour, minute, second, hundredth : lib_word_type ; END ; X lib_item_type = RECORD X buffer_length : lib_word_type ; X item_code : lib_word_type ; X buffer_address : lib_long_type ; X retlength_adress : lib_long_type END ; X lib_extended_item_type = RECORD X item : lib_item_type ; X buffer : PACKED ARRAY `5B1..80`5D OF char END ; X lib_item_list_type = ARRAY `5B1..85`5D OF lib_item_type ; X X fab_pointer = `5EFAB$TYPE ; X rab_pointer = `5ERAB$TYPE ; X nam_pointer = `5ENAM$TYPE ; X nam_rs_type = PACKED ARRAY `5B1..NAM$C_MAXRSS`5D OF char ; X nam_rsa_type = `5Enam_rs_type ; X xab_pointer = `5EXAB$TYPE ;`7B X2 DEC_Routines X!`7D X `5BASYNCHRONOUS,EXTERNAL`5D FUNCTION lib$create_dir ( X directory_spec : `5BCLASS_S`5D PACKED ARRAY `5Bl1..u1:integer`5D OF ch Var ; X %REF owner_UIC : `5BTRUNCATE,UNSAFE`5D unsigned := %IMMED 0 ; X %REF protection_enable : `5BUNSAFE`5D lib_word_type := %IMMED 0 ; X %REF protection_value : `5BUNSAFE`5D lib_word_type := %IMMED 0 ; X %REF maximum_versions : lib_word_type := %IMMED 0 ; X %REF relative_volume_number : lib_word_type := %IMMED 0) X : sts_type ; external ;`7B X! Now I convert to a H_FLOAT and divide instead X! `5BASYNCHRONOUS,EXTERNAL`5D FUNCTION lib$cvt_from_internal_time ( X! %REF operation : unsigned ; X! VAR resultant_time : unsigned ; X! %REF input_time : `5BUNSAFE`5D lib_date_type := %IMMED 0) X! : sts_type ; external ; X! Convert to H_FLOAT and multiply X! `5BASYNCHRONOUS,EXTERNAL`5D FUNCTION lib$cvt_vectim ( X! %REF input_time : `5BUNSAFE`5D lib_numtim_type ; X! VAR resultant_time : `5BUNSAFE`5D lib_date_type) : sts_type ; external V ; `7D X X `5BASYNCHRONOUS,EXTERNAL`5D FUNCTION lib$find_file ( X filespec : `5BCLASS_S`5D PACKED ARRAY `5Bl1..u1:integer`5D OF char ; X %DESCR resultant_filespec : `5BVOLATILE`5D VARYING `5Bn1`5D OF char ; X VAR context : `5BVOLATILE`5D lib_fab_pointer ; X default_filespec : X `5BCLASS_S`5D PACKED ARRAY `5Bl3..u3:integer`5D OF char := %IMMED 0 V ; X related_filespec : X `5BCLASS_S`5D PACKED ARRAY `5Bl4..u4:integer`5D OF char := %IMMED 0 V ; X VAR status_value : `5BVOLATILE`5D unsigned := %IMMED 0 ; X flags : unsigned := %IMMED 0) : sts_type ; external ; X X `5BASYNCHRONOUS,EXTERNAL`5D FUNCTION lib$find_file_end ( X VAR context : lib_fab_pointer) : sts_type ; external ; X X `5BASYNCHRONOUS,EXTERNAL`5D FUNCTION lib$get_input ( X %DESCR get_str : VARYING `5Bn1`5D OF char ; X prompt : `5BCLASS_S`5D PACKED ARRAY `5Bl1..u1:integer`5D OF char := %I VMMED 0 ; X VAR out_len : lib_word_type := %IMMED 0) : sts_type ; external ; X X `5BASYNCHRONOUS,EXTERNAL`5D FUNCTION lib$getjpi ( X %REF item_code : lib_word_type ; X VAR process_id : unsigned := %IMMED 0 ; X process_name : X `5BCLASS_S`5D PACKED ARRAY `5Bl1..u1:integer`5D OF char := %IMMED 0 V ; X VAR resultant_value : `5BUNSAFE`5D unsigned := %IMMED 0 ; X %DESCR resultant_string : VARYING `5Bn1`5D OF char := %IMMED 0 ; X VAR resultant_length : lib_word_type := %IMMED 0) X : sts_type ; external ;`7B X! I now use lib$subx instead X! `5BASYNCHRONOUS,EXTERNAL`5D FUNCTION lib$sub_times ( X! %REF time_1, time_2 : `5BUNSAFE`5D lib_date_type ; X! VAR resultant_time : `5BUNSAFE`5D lib_date_type) : sts_type ; external V ;`7D X X `5BASYNCHRONOUS,EXTERNAL`5D FUNCTION lib$subx ( X %REF minuend_array : `5BUNSAFE`5D ARRAY `5Bl1..u1:integer`5D OF unsign Ved ; X %REF subtrahend_array : `5BUNSAFE`5D ARRAY `5Bl2..u2:integer`5D OF uns Vigned ; X %REF difference_array : X `5BUNSAFE,VOLATILE`5D ARRAY `5Bl3..u3:integer`5D OF unsigned ; X %REF array_length : integer := %IMMED 0) : sts_type ; external ; X X `5BASYNCHRONOUS,EXTERNAL`5D FUNCTION lib$sys_fao ( X ctr_str : `5BCLASS_S`5D PACKED ARRAY `5Bl1..u1:integer`5D OF char ; X %REF out_len : lib_word_type := %IMMED 0 ; X %DESCR out_buf : VARYING `5Bn1`5D OF char ; X %IMMED p : `5BLIST`5D unsigned) : sts_type ; external ; X X `5BASYNCHRONOUS,EXTERNAL`5D PROCEDURE lib$signal ( X %IMMED condition : `5BUNSAFE`5D sts_type ; X %IMMED parameters : `5BUNSAFE,LIST`5D unsigned) ; external ; X X `5BASYNCHRONOUS,EXTERNAL`5D PROCEDURE lib$stop ( X %IMMED condition : `5BUNSAFE`5D sts_type ; X %IMMED parameters : `5BUNSAFE,LIST`5D unsigned) ; external ;`7B X! X! From nowhere in particular X! X1 SYSDEFPAS X2 DEC_Routines X!`7D X `5BASYNCHRONOUS,EXTERNAL`5D FUNCTION SYS$SETDFPROT ( X %REF new_def_prot : lib_word_type := %IMMED 0 ; X VAR cur_def_prot : lib_word_type := %IMMED 0) : sts_type ; external ;` V7B X! X! Again from nowhere X! X1 SHELLDEFPAS X2 DEC_Routines XSHELL$MATCH_WILD is an entry point contained in SYS$LIBRARY:VAXCRTL.EXE (and Xpresumably .OLB). I understand that it is part of DEC/Shell, a DEC version Xof the System 7 Bourne shell for VMS. I haven't found any documentation on Xit, but have discovered how to use it through a few guesses and some Xexperimentation. X!`7D X X `5BEXTERNAL,ASYNCHRONOUS`5D FUNCTION SHELL$MATCH_WILD ( X %REF cand_spec : PACKED ARRAY `5Bl1..u1:integer`5D OF char ; X %REF match_spec : PACKED ARRAY `5Bl2..u2:integer`5D OF char) X : boolean ; external ;`7B X! X! From SRC_VCLIB:CLIDEF.PAS X! X1 CLIDEFPAS X2 CONST X!`7D CONST X CLI$_DEFAULTED = 261409 ;`7B X2 DEC_Routines X!`7D X `5BASYNCHRONOUS,EXTERNAL`5D FUNCTION cli$present ( X name : `5BCLASS_S`5D PACKED ARRAY `5Bl1..u1:integer`5D OF char ) X : sts_type ; external ; X X `5BASYNCHRONOUS,EXTERNAL`5D FUNCTION cli$get_value ( X name : `5BCLASS_S`5D PACKED ARRAY `5Bl1..u1 : integer`5D OF char ; X %DESCR retbuf : VARYING `5Bn2`5D OF char) : sts_type ; external ;`7B X! X! From SRC_VCLIB:OTSDEF.PAS (which does not yet exist) X! X1 OTSDEFPAS X2 DEC_Routines X!`7D X `5BASYNCHRONOUS,EXTERNAL`5D FUNCTION ots$cvt_ti_l ( X input_string : `5BCLASS_S`5D PACKED ARRAY `5Bl1..u1:integer`5D OF char V ; X VAR output_value : `5BUNSAFE`5D integer ; X output_value_size : `5BTRUNCATE`5D integer := 4 ; X flags_value : unsigned := 0) : sts_type ; external ;`7B X! X! From SRC_VCLIB:STRDEF.PAS X! X1 STRDEFPAS X2 DEC_Routines X!`7D X `5BASYNCHRONOUS,EXTERNAL`5D FUNCTION str$match_wild ( X cand_str : `5BCLASS_S`5D PACKED ARRAY `5Bl1..u1:integer`5D OF char ; X pattern_str : `5BCLASS_S`5D PACKED ARRAY `5Bl2..u2:integer`5D OF char) X : sts_type ; external ;`7B X! X! From SRC_VCLIB:PASMSG.PAS X! X1 PASMSG X!`7D XCONST X %INCLUDE 'SYS$LIBRARY:PASDEF.PAS' X XVAR X PAS$_FACILITY : `5BEXTERNAL,VALUE`5D sts_type ;`7B X! X! From SRC_VCLIB:LIBITMLST.DEC X! X1 LIB_ITEM_LIST X FUNCTIONAL DESCRIPTION: X Builds an item list in its own static storage, and returns the X address of the item list. This routine is designed to be called X directly from the parameter list of system services such as $MOUNT X $GETDVI, $GETJPI, and $GETSYI (see PASCAL DECLARATION for an example). X X CALLING SEQUENCE: item_list_address.rr.r = (item.rr.r`5B,...`5D) X X IMPLICIT INPUTS: None. X X IMPLICIT OUTPUTS: None. X X SIDE EFFECTS: None. X2 Parameters X item -- items for inclusion in the item list. The best way to to generate X these is with LIB_IN_ITEM and LIB_OUT_ITEM. X2 Completion_Status X none -- does not return any status values. X2 PASCAL_Definition X!`7D X `5BEXTERNAL`5D FUNCTION lib_item_list (item : `5BUNSAFE,LIST`5D lib_item_ Vtype) : X lib_item_list_type ; external ;`7B X3 Calling_Example X`5BINHERIT ('STARLET_PEN','VCLIB_PEN')`5D PROGRAM dvitest (output) ; X VAR X logvolnam, disk_label, device : VARYING `5B20`5D OF char := '' ; X free_blocks, disk_size, disk_owner_pid : unsigned := 0 ; X BEGIN X lib_sigiferr ($GETDVI (,, 'DISK$0', lib_item_list ( X lib_out_item (dvi$_maxblock, %DESCR disk_size), X lib_out_item (dvi$_freeblocks, %DESCR free_blocks), X lib_out_item (dvi$_logvolnam, %DESCR logvolnam), X lib_out_item (dvi$_volnam, %DESCR disk_label), X lib_out_item (dvi$_devnam, %DESCR device), X lib_out_item (dvi$_pid, %DESCR disk_owner_pid)))) ; X writeln (logvolnam, ', ', device, ', ', disk_label, ', ', X ', free =', free_blocks:1, ', X used =', (disk_size - free_blocks):1) ; X END. X1 LIB_OUT_ITEM X FUNCTIONAL DESCRIPTION: X Builds an item specifing data to be written, for inclusion in an X item_list. This routine is designed to be called from within a X call to LIB_ITEM_LIST. X X CALLING SEQUENCE: item.rr.r = ( X item_code.rlu.v, data.wx.dx `5B, data_length.wwu.r V`5D) X X IMPLICIT INPUTS: None. X X IMPLICIT OUTPUTS: None. X X SIDE EFFECTS: None. X2 Parameters X item_code -- Symbolic code for the item of data required. X data -- Variable into which the item is to be returned. If it X is of type varying string, the length is returned as well. X data_length -- Variable in which the length of the data is to be return- X ed. This is not done if data was of type varying string. X2 Completion_Status X none -- does not return any status values. X2 PASCAL_Definition X!`7D X `5BEXTERNAL`5D FUNCTION lib_out_item ( X %IMMED item_code : lib_long_type ; X %DESCR data : `5BUNSAFE`5D lib_long_type ; X VAR data_length : lib_word_type := %IMMED 0) X : lib_item_type ; external ;`7B X1 LIB_IN_ITEM X FUNCTIONAL DESCRIPTION: X Builds an item specifing data to be written, for inclusion in an X item_list. This routine is designed to be called from within a X call to LIB_ITEM_LIST. X X CALLING SEQUENCE: item.rr.r = (item_code.rlu.v `5B, data.rx.dx`5D) X X IMPLICIT INPUTS: None. X X IMPLICIT OUTPUTS: None. X X SIDE EFFECTS: None. X X RESTRICTIONS: The maximum data length is 80. X2 Parameters X item_code -- Symbolic code for operation required.. X data -- Variable containing data to be read. X2 Completion_Status X none -- does not return any status values. X2 PASCAL_Definition X!`7D X `5BEXTERNAL`5D FUNCTION lib_in_item ( X %IMMED item_code : lib_long_type ; X %STDESCR data : `5BUNSAFE,READONLY`5D PACKED ARRAY `5Bl1..u1:integer`5 VD X OF char := %IMMED 0) : lib_extended_item_type ; external ; X`7B X! From SRC_VCLIB:LIBIFERR.DEC X! X1 LIB_RETIFERR X FUNCTIONAL DESCRIPTION: X Return from a routine if condition is not success. X The condition is put in the return value of the routine (R0). X X CALLING SEQUENCE: ret_status.wlc.r = lib_retiferr (status.rlc.v) X X IMPLICIT INPUTS: None. X X IMPLICIT OUTPUTS: None. X X SIDE EFFECTS: None. X2 Parameters X status = longword condition code X2 Completion_Status X ret_status = status (i.e. the parameter) X2 PASCAL_Definition X!`7D X `5BEXTERNAL`5D FUNCTION lib_retiferr ( X %IMMED status : sts_type) : sts_type ; external ;`7B X1 LIB_SIGIFERR X FUNCTIONAL DESCRIPTION: X Signal a condition if it is not success, optionally prefixing it with X other messages (with the normal passing of FAO arguments). X X CALLING SEQUENCE: ret_status.wlc.r = lib_sigiferr ( X status.rlc.v `5B, signal_arg, ... `5D) X X IMPLICIT INPUTS: None. X X IMPLICIT OUTPUTS: None. X X SIDE EFFECTS: None. X2 Parameters X status = longword condition code X signal_arg = a list of condition codes (and FA0 arguments) to be signall Ved X ahead of the status. X2 Completion_Status X ret_status = status (i.e. the parameter) X2 PASCAL_Definition X!`7D X `5BEXTERNAL`5D FUNCTION lib_sigiferr ( X %IMMED status : sts_type ; X %IMMED signal_arg : `5BLIST,UNSAFE`5D sts_type) : sts_type ; external V ; X`7B X! From SRC_VCLIB:LIBPARSE.DEC X! X1 LIB_PARSE XFUNCTIONAL DESCRIPTION X Return an expanded file spec (or portions of it) (a run-time X version of F$PARSE). X XCALLING SEQUENCE:`09ret_status.wlc.v = lib_parse ( X file_spec.rt.dx, expanded_spec.wt.dx X `5B, default_spec.rt.dx`5D `5B, related_spec.rt.d Vx`5D X `5B, expanded_length.ww.r,`5D `5B, field.rl.r, .. V. `5D) X XIMPLICIT INPUTS:`09Process default device and directory. X XIMPLICIT OUTPUTS:`09None. X XSIDE EFFECTS:`09`09None X XRESTRICTIONS:`09`09None X X2 Parameters Xexpanded_spec = The expanded file_spec. Xexpanded_length= length of expanded file_spec Xfile_spec = The file_spec to parse Xdefault_spec = See RMS manual. Xrelated_spec = See RMS manual. Xfield,.. = the fields to select. Select from the symbols NAM__NODE X NAM__DEV, NAM__DIR, NAM__NAME, NAM__TYPE, NAM__VER. X If no fields are specified, the entire expanded file_spec X is returned. Otherwise the requested fields are appended X in order in expanded_spec. X2 Completion_Status XAny status returned by RMS or LIB$SCOPY_R_DX X2 PASCAL_DEFINITION X!`7D X `5BEXTERNAL`5D FUNCTION lib_parse ( X file_spec : `5BCLASS_S`5D PACKED ARRAY `5Bl1..u1:integer`5D OF char ; X %DESCR expanded_spec : VARYING `5Bn1`5D OF char ; X default_spec : `5BCLASS_S`5D PACKED ARRAY `5Bl2..u2:integer`5D OF char X := %IMMED 0 ; X related_spec : `5BCLASS_S`5D PACKED ARRAY `5Bl3..u3:integer`5D OF char X := %IMMED 0 ; X VAR expanded_length : lib_word_type := %IMMED 0 ; X field : `5BLIST`5D sts_type := %IMMED 0) : sts_type ; external ;`7B X! X! From SRC_VCLIB:NAMDEF.PAS X! X1 NAMDEFPAS X Declarations necessary for the use of the routine lib_parse. X2 CONST X!`7D CONST X nam__node = 0 ; X nam__dev = 1 ; X nam__dir = 2 ; X nam__name = 3 ; X nam__type = 4 ; X nam__ver = 5 ;`7B X! X! From SRC_VCLIB:PASLIBDEF.PAS X! X1 PASLIBDEF X`7C************************************************************************* V***`7C X`7C Non-modular utility routines for use in PASCAL V `7C X`7C V `20 V `7C X`7C AUTHOR: Doug Miller V `7C X`7C CREATED: 26-Sep-1984 V `7C X`7C MODIFIED: Tim Cook, added addtim, subtim, difftim and bintim V `7C X`7C 12-Sep-1985 V `7C X`7C************************************************************************* V***`7C X2 CLI_PRESENT X!`7D `5BGLOBAL,ASYNCHRONOUS`5D FUNCTION success (`7B X!`7D status : `5BUNSAFE`5D STS$TYPE) : boolean ; forward ;`7B X!`7D X `5BGLOBAL,ASYNCHRONOUS`5D FUNCTION cli_present ( X keyword : PACKED ARRAY `5Bl1..u1:integer`5D OF char) : boolean ; X BEGIN X cli_present := success (CLI$PRESENT (keyword)) END ;`7B X2 FAILURE X A simple routine to test the STS$V_SUCCESS bit of a STS$TYPE status. X (used to control program flow) X X!`7D X `5BGLOBAL,ASYNCHRONOUS`5D FUNCTION failure ( X status : `5BUNSAFE`5D STS$TYPE) : boolean ; X BEGIN X failure := NOT status.STS$V_SUCCESS END ;`7B X2 PAS$FAB X!`7D X `5BEXTERNAL,ASYNCHRONOUS`5D FUNCTION pas$fab (VAR f : `5BUNSAFE`5D text) V : X fab_pointer ; external ;`7B X2 PAS$RAB X!`7D X `5BEXTERNAL,ASYNCHRONOUS`5D FUNCTION pas$rab (VAR f : `5BUNSAFE`5D text) V : X rab_pointer ; external ;`7B X2 SUCCESS X A simple routine to test the STS$V_SUCCESS bit of a STS$TYPE status. X (used to control program flow) X X `5BGLOBAL,ASYNCHRONOUS`5D`7D FUNCTION success `7B( X status : `5BUNSAFE`5D STS$TYPE) : boolean `7D ; X BEGIN X success := status.STS$V_SUCCESS END ;`7B X! X!`7D END. `7B of MODULE vclib `7D $ CALL UNPACK VCDEFS.PAS;1 542939600 $ v=f$verify(v) $ EXIT