%TITLE 'DUMPER_FILE - DUMPER-32 File processing' MODULE DUMPER_FILE (IDENT = '1.0.003', LANGUAGE (BLISS32) ) = BEGIN ! !++ ! FACILITY: ! ! DUMPER-32 ! ! ABSTRACT: ! ! This module implements the file I/O processing used in the restoring ! of DUMPER and BACKUP tapes. ! ! AUTHORS: ! ! Robert C. McQueen ! ! CREATION DATE: 15-April-1985 ! ! MODIFICATION HISTORY: !-- %SBTTL 'Table of Contents' ! ! TABLE OF CONTENTS: ! %SBTTL 'Revision History' !++ ! Start of Version 1. ! ! 1.0.000 By: Robert C. McQueen On: 15-Apr-1985 ! Create this Module. ! ! 1.0.001 By: Antonino N.J. Mione On: 8-Jan-1986 ! Fix code which moves filename to scan for and replace ! bad characters (i.e. !@#%^&*~`, ctrl chars, etc.) with ! an underscore. ! ! 1.0.002 By: Robert C. McQueen On: 16-June-1986 ! Fix problem when output specification is "*.*". ! ! 1.0.003 By: Robert C. McQueen On: 16-June-1986 ! Fix a problem with 1.0.001 and allow "-" in a file specification ! since VMS 4.4 allows it. ! ! [IU-1] By: James A. Harvey, IUPUI On: 23-Nov-1987 ! Fix some LIB$SIGNAL calls. Pass the length of the filespec ! by VALUE, not it's address. Also, for AD FAO directives, ! pass the length and then the address, not the other way around. ! ! [IU-2] By: James A. Harvey, IUPUI On: 23-Nov-1987 ! Add check for maximum RMS record size. ! ! [IU-7] By: James A. Harvey, IUPUI On: 15-Dec-1987 ! Add /REMOVE_LSNS qualifier. /REMOVE_LSNS is the default. ! ! [IU-18] By: James A. Harvey, IUPUI On: 05-Jan-1988 ! In FILE_CLOSE, don't strip trailing nulls out of the last ! buffer unless the file is a text file (.FILE_TYPE EQL ! FILE_TYPE_7BIT_CHARACTERS). ! ! [IU-19] By: James A. Havrey, IUPUI On: 08-JAN-1988 ! The stuff added by edits IU-2 (keep DUMPER from blowing up when ! restoring binary files as text files) and IU-7 (remove EDIT/SOS ! lines sequence numbers by default when restoring text files) ! causes confusion sometimes. For example, the stuff added by ! IU-7 will claim that LSNs are being removed from an EXE file. ! Redo these edits to simply remember what was done and output a ! single error message when the file is closed. ! ! [IU-29] By: James A. Harvey, IUPUI On: 20-JAN-1988 ! Directory creations aren't be logged. Add some code to do this ! if the user specified either /LOG=ALL or /LOG=DIRECTORIES. !-- %SBTTL 'Declarations -- Libraries/Required files' ! ! INCLUDE FILES: ! LIBRARY 'SYS$LIBRARY:STARLET'; REQUIRE 'CHARACTER_DEFINITIONS'; REQUIRE 'DUMPER_SYMBOLS'; %SBTTL 'Declarations -- Forward routines' ! ! The following are the forward referenced routines ! FORWARD ROUTINE LINK_XAB_BLOCK_IN : NOVALUE, ! Place an XAB on the XAB list INITIALIZE_XAB_LIST : NOVALUE; ! Initialize the XAB list %SBTTL 'Declarations -- Literals/Binds' ! ! EQUATED SYMBOLS: ! LITERAL FILE_STATE_DATA = 0, ! Processing data characters FILE_STATE_POST = 1; ! Post processing record LITERAL BINARY_RECORDSIZE = 510, ! 8BIT and 36BIT file record size INITIAL_ASCII_RECORDSIZE = 256, ! Initial record size for ASCII files ASCII_RECORDSIZE_INCREMENT = 256, ! Number of additional space to allocate ! for characters in the ASCII records MAX_FILE_NAME = NAM$C_MAXRSS; ! Maximum length of a file spec LITERAL MAX_RECORDSIZE = 32765; ![IU-2] Maximum RMS record size (var). %SBTTL 'Storage -- OWN' ! ! OWN STORAGE: ! ! ! Local file name/device/directory information ! OWN FILE_TYPE, ! Type of file we are writing FILE_LENGTH, ! Length of the file name FILE_NAME : VECTOR [CH$ALLOCATION (MAX_FILE_NAME)], ! File name FILE_VERSION, ! Version number of the file to create FILE_NAME_DESCRIPTOR : REF BLOCK [, BYTE], ! Descriptor of the file name FILE_RECORD_SIZE, ! Record size the file claims FILE_BLOCK_SIZE, ! Block size of the file FILE_BYTE_SIZE, ! Data byte size FILE_FRAME_SIZE, ! Size of the physical frames FILE_FIRST_FREE_BYTE; ! Byte address of the first free byte OWN ![IU-2] FILE_RECORD_TRUNCATED, ![IU-2] TRUE if record hacked. FILE_REMOVE_LSNS, ![IU-7] TRUE to remove LSNs. FILE_LSNS_REMOVED, ![IU-7] TRUE if we removed any. FILE_IS_BINARY; ![IU-19] TRUE if we saw bit 35 on in a word. ! ! Record information ! OWN RECORD_COUNT, ! Count of the number of bytes RECORD_SIZE, ! Size of the record buffer RECORD_ADDRESS, ! Address of the record buffer RECORD_POINTER; ! Character pointer into the record buffer ! ! RMS data blocks ! OWN FILE_FAB : $FAB_DECL, ! Declare output FAB block FILE_NAM : $NAM_DECL, ! Declare output NAM block XAB_DATE_TIME : $XABDAT_DECL, ! Declare Date/time XAB block XAB_REVISION_DATE_TIME : $XABRDT_DECL, ! Declare the revision date/time XAB XAB_PROTECTION : $XABPRO_DECL, ! Delcare protection XAB XAB_BLOCK_LIST, ! List of the XABs we have stored ! data into FILE_RAB : $RAB_DECL; ! Declare output RAB block %SBTTL 'FILE_INITIALIZE - Initialize the File processing module' GLOBAL ROUTINE FILE_INITIALIZE = !++ ! FUNCTIONAL DESCRIPTION: ! ! This routine will initialize the file processing module for DUMPER-32. ! ! FORMAL PARAMETERS: ! ! None. ! ! IMPLICIT INPUTS: ! ! None ! ! IMPLICIT OUTPUTS: ! ! None ! ! COMPLETION_CODES: ! ! SS$_NORMAL - Module ininitialized. ! OTHERS - Problem initializing the module. ! ! SIDE EFFECTS: ! ! Module initilized. !-- BEGIN RETURN SS$_NORMAL END; %SBTTL 'FILE_CREATE_DIRECTORY - Create a directory' GLOBAL ROUTINE FILE_CREATE_DIRECTORY ( ! Create directory DIRECTORY_DESCRIPTOR : REF $DESCRIPTOR_DECL ! Directory to create ) = !++ ! FUNCTIONAL DESCRIPTION: ! ! This routine will create the directories that are required inorder to ! restore the file we are currently processing. ! ! FORMAL PARAMETERS: ! ! DIRECTORY_DESCRIPTOR - Descriptor that gives the device and directory ! namd to create. ! ! IMPLICIT INPUTS: ! ! None ! ! IMPLICIT OUTPUTS: ! ! None ! ! COMPLETION_CODES: ! ! System service completion code ! ! SIDE EFFECTS: ! ! None !-- BEGIN ! ! Declare the routine that will do all of the work for us ! EXTERNAL ROUTINE LIB$CREATE_DIR : ADDRESSING_MODE (GENERAL); ! ! Call the routine to create the directory and return the final status ! to the caller ! RETURN LIB$CREATE_DIR (.DIRECTORY_DESCRIPTOR) END; %SBTTL 'FILE_INITIALIZE_OUTPUT - Per file initialization' GLOBAL ROUTINE FILE_INITIALIZE_OUTPUT : NOVALUE = !++ ! FUNCTIONAL DESCRIPTION: ! ! This routine will initialize the per file output. It will reset the ! various RMS blocks in the low segment and will reset any and all variables ! used for File output. ! ! FORMAL PARAMETERS: ! ! None ! ! IMPLICIT INPUTS: ! ! RMS blocks in local OWN storage. ! ! IMPLICIT OUTPUTS: ! ! RMS blocks initilized. ! ! COMPLETION_CODES: ! ! None ! ! SIDE EFFECTS: ! ! None !-- BEGIN ![IU-7]++ ! External stuff. EXTERNAL GQ_QUAL_VALUE_CNTS : VECTOR [, LONG, SIGNED]; EXTERNAL LITERAL GQ$K_REMOVE_LSNS_QUAL_INDEX; ![IU-7]-- ! ! Reset various OWN variables ! FILE_BLOCK_SIZE = 0; ! No block size yet FILE_RECORD_SIZE = 0; ! No record size yet FILE_BYTE_SIZE = 0; ! File byte size FILE_FRAME_SIZE = 0; ! Size of the data frames FILE_FIRST_FREE_BYTE = 0; ! First free byte FILE_RECORD_TRUNCATED = FALSE; ![IU-2] No records whacked yet. FILE_REMOVE_LSNS = .GQ_QUAL_VALUE_CNTS [GQ$K_REMOVE_LSNS_QUAL_INDEX] GEQ 0; ![IU-7] FILE_LSNS_REMOVED = FALSE; ![IU-7] None removed yet. FILE_IS_BINARY = FALSE; ![IU-19] No words with bit 35 on seen yet. ! ! Reset the RMS data base ! $FAB_INIT (FAB = FILE_FAB, NAM = FILE_NAM, CTX = FILE_STATE_DATA, FOP = (MXV, CBT, SQO, TEF), ORG = SEQ, RFM = VAR); $RAB_INIT (RAB = FILE_RAB, FAB = FILE_FAB, RAC = SEQ, ROP = ); $NAM_INIT (NAM = FILE_NAM); $XABDAT_INIT (XAB = XAB_DATE_TIME); $XABRDT_INIT (XAB = XAB_REVISION_DATE_TIME); $XABPRO_INIT (XAB = XAB_PROTECTION); ! ! Call any other per file initialization routines ! INITIALIZE_XAB_LIST (); ! Initalize the XAB list END; %SBTTL 'FILE_ATTRIB_BLOCK_SIZE - Set the logical block size' GLOBAL ROUTINE FILE_ATTRIB_BLOCK_SIZE ( ! Set logical block size BLOCK_SIZE ! Logical block size to set ) : NOVALUE = !++ ! FUNCTIONAL DESCRIPTION: ! ! This routine will set the logical block size for the file that we ! are about to restore to the user's disk area. ! ! FORMAL PARAMETERS: ! ! BLOCK_SIZE - Logical block size ! ! IMPLICIT INPUTS: ! ! RMS blocks in OWN data ! ! IMPLICIT OUTPUTS: ! ! Updated RMS blocks in OWN data ! ! COMPLETION_CODES: ! ! None ! ! SIDE EFFECTS: ! ! None !-- BEGIN FILE_BLOCK_SIZE = .BLOCK_SIZE ! Set the size for _CREATE END; %SBTTL 'FILE_ATTRIB_BYTE_SIZE - Set files logical byte size' GLOBAL ROUTINE FILE_ATTRIB_BYTE_SIZE ( ! Set the data byte size for a file BYTE_SIZE ! Byte size for file data ) : NOVALUE = !++ ! FUNCTIONAL DESCRIPTION: ! ! This routine is called to set the byte size for the next file. The ! byte size is the actual number of data bits used in each frame in the ! file. It must be less than or equal to the frame size. ! ! FORMAL PARAMETERS: ! ! BYTE_SIZE Size of logical bytes in bits ! ! IMPLICIT INPUTS: ! ! None ! ! IMPLICIT OUTPUTS: ! ! FILE_BYTE_SIZE Saved size ! ! COMPLETION_CODES: ! ! None ! ! SIDE EFFECTS: ! ! None !-- BEGIN FILE_BYTE_SIZE = .BYTE_SIZE ! Set the file byte size END; %SBTTL 'FILE_ATTRIB_FRAME_SIZE - Set physical frame size' GLOBAL ROUTINE FILE_ATTRIB_FRAME_SIZE ( ! Set file's data frame size FRAME_SIZE ! Frame size in bits ) : NOVALUE = !++ ! FUNCTIONAL DESCRIPTION: ! ! This routine is called to set the size (in bits) of the frames in ! which data bytes are stored. ! ! FORMAL PARAMETERS: ! ! FRAME_SIZE Size of physical data frames ! ! IMPLICIT INPUTS: ! ! None ! ! IMPLICIT OUTPUTS: ! ! FILE_FRAME_SIZE - Saved frame size ! ! COMPLETION_CODES: ! ! None ! ! SIDE EFFECTS: ! ! None !-- BEGIN FILE_FRAME_SIZE = .FRAME_SIZE ! Save the frame size END; %SBTTL 'FILE_ATTRIB_DATA_TYPE - Data type of the file' GLOBAL ROUTINE FILE_ATTRIB_DATA_TYPE (DATA_TYPE) : NOVALUE = !++ ! FUNCTIONAL DESCRIPTION: ! ! [~tbs~] ! ! FORMAL PARAMETERS: ! ! [~description_or_none~] ! ! IMPLICIT INPUTS: ! ! [~description_or_none~] ! ! IMPLICIT OUTPUTS: ! ! [~description_or_none~] ! ! COMPLETION_CODES: ! ! [~description_or_none~] ! ! SIDE EFFECTS: ! ! [~description_or_none~] !-- BEGIN ! [~declaration~]... ! {~expression~}... return ss$_normal END; %SBTTL 'FILE_ATTRIB_FIRST_FREE_BYTE - Set the first free byte in the file' GLOBAL ROUTINE FILE_ATTRIB_FIRST_FREE_BYTE ( ! Routine to set first free byte FIRST_FREE_BYTE ! Byte number ) : NOVALUE = !++ ! FUNCTIONAL DESCRIPTION: ! ! This routine will set the first free byte available in the file. It ! will store the information that was found in the BACKUP tape file ! information. ! ! FORMAL PARAMETERS: ! ! FIRST_FREE_BYTE - Byte number of the first free byte. ! ! IMPLICIT INPUTS: ! ! RMS blocks. ! ! IMPLICIT OUTPUTS: ! ! Updated RMS blocks. ! ! COMPLETION_CODES: ! ! None ! ! SIDE EFFECTS: ! ! None !-- BEGIN FILE_FIRST_FREE_BYTE = .FIRST_FREE_BYTE ! Save the first free byte END; %SBTTL 'FILE_ATTRIB_FIXED_HEADER_SIZE - Set fixed header size' GLOBAL ROUTINE FILE_ATTRIB_FIXED_HEADER_SIZE ( ! Set size of the fixed header FIXED_HEADER_SIZE ! Number of bytes in the header ) : NOVALUE = !++ ! FUNCTIONAL DESCRIPTION: ! ! This routine will set the size of the fixed header. The size is the ! number of bytes in the header. ! ! FORMAL PARAMETERS: ! ! FIXED_HEADER_SIZE - Size of the fixed header information in bytes. ! ! IMPLICIT INPUTS: ! ! RMS blocks in local OWN. ! ! IMPLICIT OUTPUTS: ! ! Updated RMS blocks in local OWN. ! ! COMPLETION_CODES: ! ! None ! ! SIDE EFFECTS: ! ! None !-- BEGIN ! ! Just store the information into the file FAB ! FILE_FAB [FAB$B_FSZ] = .FIXED_HEADER_SIZE; END; %SBTTL 'FILE_ATTRIB_RECORD_ATTRIB - Set the record attributes' GLOBAL ROUTINE FILE_ATTRIB_RECORD_ATTRIB ( ! Set the record attributes RECORD_ATTRIBUTES ! Record attributes to set ) : NOVALUE = !++ ! FUNCTIONAL DESCRIPTION: ! ! This routine will set the record attributes in the RMS block. It will ! overwrite the default value that is stored in the block. ! ! FORMAL PARAMETERS: ! ! RECORD_ATTRIBUTES - Attributes to be stored directly into the RMS block. ! ! IMPLICIT INPUTS: ! ! RMS blocks in local OWN storage. ! ! IMPLICIT OUTPUTS: ! ! Updated RMS blocks in local OWN storage. ! ! COMPLETION_CODES: ! ! None ! ! SIDE EFFECTS: ! ! None !-- BEGIN FILE_FAB [FAB$B_RAT] = .RECORD_ATTRIBUTES ! Save the record attrs END; %SBTTL 'FILE_ATTRIB_RECORD_FORMAT - Set the record format' GLOBAL ROUTINE FILE_ATTRIB_RECORD_FORMAT ( ! Set the RMS record format RECORD_FORMAT ! RMS record format ) : NOVALUE = !++ ! FUNCTIONAL DESCRIPTION: ! ! This routine will set the RMS record format to use writing the data ! into the file. ! ! FORMAL PARAMETERS: ! ! RECORD_FORMAT - RMS record format to use. ! ! IMPLICIT INPUTS: ! ! RMS blocks in local OWN storage. ! ! IMPLICIT OUTPUTS: ! ! Updated RMS blocks in local OWN storage. ! ! COMPLETION_CODES: ! ! None ! ! SIDE EFFECTS: ! ! None !-- BEGIN FILE_FAB [FAB$B_RFM] = .RECORD_FORMAT ! Save the correct record fmt END; %SBTTL 'FILE_ATTRIB_RECORD_SIZE - Size of the records' GLOBAL ROUTINE FILE_ATTRIB_RECORD_SIZE ( ! Set the record size RECORD_SIZE ! Size claimed by the file ) : NOVALUE = !++ ! FUNCTIONAL DESCRIPTION: ! ! This routine will set the record size into the RMS blocks from the ! information supplied on the BACKUP tape. ! ! FORMAL PARAMETERS: ! ! RECORD_SIZE - Size of the record in bytes. ! ! IMPLICIT INPUTS: ! ! RMS blocks in local OWN storage. ! ! IMPLICIT OUTPUTS: ! ! Updated RMS blocks in local OWN storage. ! ! COMPLETION_CODES: ! ! None ! ! SIDE EFFECTS: ! ! None !-- BEGIN FILE_RECORD_SIZE = .RECORD_SIZE ! Set the file record size END; %SBTTL 'FILE_ATTRIB_FILE_TYPE - Set type of file to write' GLOBAL ROUTINE FILE_ATTRIB_FILE_TYPE (FILE_TYPE_TO_WRITE) : NOVALUE = !++ ! FUNCTIONAL DESCRIPTION: ! ! This routine will set the type of file to create. It will be called ! with the FILE_TYPE_xxxx symbols as the argument. See DUMPER_SYMBOLS ! for the various file types. ! ! FORMAL PARAMETERS: ! ! FILE_TYPE_TO_WRITE - FILE_TYPE_xxxx symbol. ! ! IMPLICIT INPUTS: ! ! RMS data blocks in local OWN storage. ! ! IMPLICIT OUTPUTS: ! ! Updated RMS data blocks in local OWN storage. ! ! COMPLETION_CODES: ! ! SS$_NORMAL or DMPR_xxx error code. ! ! SIDE EFFECTS: ! ! None !-- BEGIN ! ! Store the file data type ! FILE_TYPE = .FILE_TYPE_TO_WRITE; ! ! Determine if we must fudge it ! IF .FILE_TYPE EQL FILE_TYPE_NON_STANDARD ! If not easy THEN ! see if we can BEGIN ! fudge it to be IF (.FILE_FRAME_SIZE EQL 8) AND (.FILE_BYTE_SIZE EQL 8) ! 8bit data? THEN FILE_TYPE = FILE_TYPE_8BIT_DATA ! Yes, use this now ELSE IF (.FILE_FRAME_SIZE EQL 7) AND (.FILE_BYTE_SIZE EQL 7) ! 7bit data? THEN FILE_TYPE = FILE_TYPE_7BIT_CHARACTERS ! Yes, use this now END END; %SBTTL 'FILE_ATTRIB_CREATION_DTM - Set creation date/time' GLOBAL ROUTINE FILE_ATTRIB_CREATION_DTM ( ! Set the files creation dtm CREATION_DATE_TIME : VECTOR [2, LONG] ! 64bit VAX DATE/TIME ) : NOVALUE = !++ ! FUNCTIONAL DESCRIPTION: ! ! This routine will set the creation date/time attribute for the file ! that is being created. ! ! FORMAL PARAMETERS: ! ! CREATATION_DATE_TIME - Date/time in VAX format. ! ! IMPLICIT INPUTS: ! ! None ! ! IMPLICIT OUTPUTS: ! ! RMS block contains the date/time. ! ! COMPLETION_CODES: ! ! None ! ! SIDE EFFECTS: ! ! None !-- BEGIN ! ! Move the 64 bit creation date/time into the XAB ! XAB_DATE_TIME [XAB$L_CDT0] = .CREATION_DATE_TIME [0]; XAB_DATE_TIME [XAB$L_CDT4] = .CREATION_DATE_TIME [1]; LINK_XAB_BLOCK_IN (XAB_DATE_TIME) END; %SBTTL 'FILE_ATTRIB_ACCESS_DTM - Set last access date/time' GLOBAL ROUTINE FILE_ATTRIB_ACCESS_DTM ( ! Set file last access date/time ACCESS_DATE_TIME : VECTOR [2, LONG] ! 64bit VAX Date/time ) : NOVALUE = !++ ! FUNCTIONAL DESCRIPTION: ! ! This routine will store the last access date/time in the RMS block ! for the $CREATE call. ! ! FORMAL PARAMETERS: ! ! ACCESS_DATE_TIME - Date/time of the last file access in VAX format. ! ! IMPLICIT INPUTS: ! ! RMS blocks in local OWN storage. ! ! IMPLICIT OUTPUTS: ! ! RMS block updated to contain the access date/time ! ! COMPLETION_CODES: ! ! None ! ! SIDE EFFECTS: ! ! None !-- BEGIN ! ! Move the 64 bit revision date/time into the XAB ! XAB_REVISION_DATE_TIME [XAB$L_RDT0] = .ACCESS_DATE_TIME [0]; XAB_REVISION_DATE_TIME [XAB$L_RDT4] = .ACCESS_DATE_TIME [1]; LINK_XAB_BLOCK_IN (XAB_REVISION_DATE_TIME) END; %SBTTL 'FILE_ATTRIB_GENERATION' GLOBAL ROUTINE FILE_ATTRIB_GENERATION (FILE_GENERATION) : NOVALUE = !++ ! FUNCTIONAL DESCRIPTION: ! ! This routine will set the file generation for the file about to be ! created. ! ! FORMAL PARAMETERS: ! ! FILE_GENERATION - Generation number of the file we are to create. ! ! IMPLICIT INPUTS: ! ! RMS blocks in local OWN storage. ! ! IMPLICIT OUTPUTS: ! ! File generation information stored in the RMS block. ! ! Competion Code: ! ! SS$_NORMAL - Generation stored correctly. ! DUMPER$_XXXX - Problem storing generation number. ! ! SIDE EFFECTS: ! ! None !-- BEGIN FILE_VERSION = .FILE_GENERATION; END; %SBTTL 'FILE_ATTRIB_PROTECTION - Set the file protection' GLOBAL ROUTINE FILE_ATTRIB_PROTECTION (OWNER_PROTECTION, GROUP_PROTECTION, SYSTEM_PROTECTION, WORLD_PROTECTION) : NOVALUE = !++ ! FUNCTIONAL DESCRIPTION: ! ! This routine will set the output file protection. ! ! FORMAL PARAMETERS: ! ! OWNER_PROTECTION - Owner protection field. ! GROUP_PROTECTION - Group protection field. ! SYSTEM_PROTECTION - System protection field. ! WORLD_PROTECTION - World protection field. ! ! IMPLICIT INPUTS: ! ! RMS blocks in OWN storage. ! ! IMPLICIT OUTPUTS: ! ! Protection stored in the OWN storage. ! ! COMPLETION_CODES: ! ! None ! ! SIDE EFFECTS: ! ! None !-- BEGIN XAB_PROTECTION [XAB$V_SYS] = .SYSTEM_PROTECTION; XAB_PROTECTION [XAB$V_OWN] = .OWNER_PROTECTION; XAB_PROTECTION [XAB$V_GRP] = .GROUP_PROTECTION; XAB_PROTECTION [XAB$V_WLD] = .WORLD_PROTECTION; LINK_XAB_BLOCK_IN (XAB_PROTECTION) END; %SBTTL 'FILE_ATTRIB_UIC - Set owner UIC for the file' GLOBAL ROUTINE FILE_ATTRIB_UIC (UIC) : NOVALUE = !++ ! FUNCTIONAL DESCRIPTION: ! ! This routine will set the owner UIC for the file that is being created. ! ! FORMAL PARAMETERS: ! ! UIC - UIC to use when creating the file. ! ! IMPLICIT INPUTS: ! ! XAB_PROTECTION - RMS block in the local OWN storage. ! ! IMPLICIT OUTPUTS: ! ! Updated RMS blocks. ! ! COMPLETION_CODES: ! ! None ! ! SIDE EFFECTS: ! ! None !-- BEGIN XAB_PROTECTION [XAB$L_UIC] = .UIC; LINK_XAB_BLOCK_IN (XAB_PROTECTION) END; %SBTTL 'FILE_ATTRIB_NAME' GLOBAL ROUTINE FILE_ATTRIB_NAME (FILE_DESCRIPTOR) : NOVALUE = !++ ! FUNCTIONAL DESCRIPTION: ! ! This routine will set the file name to use for the creation of the file. ! ! FORMAL PARAMETERS: ! ! FILE_NAME_DESCRIPTOR - String descriptor for the file name ! ! IMPLICIT INPUTS: ! ! FAB and FILE_NAM - RMS blocks in local OWN. ! ! IMPLICIT OUTPUTS: ! ! FAB and FILE_NAM blocks set up ! ! COMPLETION_CODES: ! ! None ! ! SIDE EFFECTS: ! ! None ! !-- BEGIN FILE_NAME_DESCRIPTOR = .FILE_DESCRIPTOR END; %SBTTL 'FILE_CREATE - Create the output file' GLOBAL ROUTINE FILE_CREATE = !++ ! FUNCTIONAL DESCRIPTION: ! ! This routine will create the output file. This routine assumes that the ! FILE_ATTRIB_xxx routines have already been called. ! ! FORMAL PARAMETERS: ! ! None ! ! IMPLICIT INPUTS: ! ! File attributes from FILE_ATTRIB_xxx routine calls. ! ! IMPLICIT OUTPUTS: ! ! None ! ! COMPLETION_CODES: ! ! STATUS - Status of the attempted opening of the file. ! ! SIDE EFFECTS: ! ! File opened. !-- BEGIN ! ! Various DUMPER status information items that can be returned. ! EXTERNAL LITERAL DMPR_CREATEDFILE, ! Created the file. DMPR_FILEOPEN, ! Open failure error msg DMPR_ILLFILENAM; ! Illegal file name error ! ! External routines called by this routine ! EXTERNAL ROUTINE LIB$SIGNAL : ADDRESSING_MODE (GENERAL) NOVALUE, LIB$GET_VM : ADDRESSING_MODE (GENERAL); ! ! External variables ! EXTERNAL QUAL_LOG; ! /LOG qualifier ! ! Local variables ! LOCAL STATUS; ! Status returned by various items %SBTTL 'ALLOCATE_RECORD_BUFFER' ROUTINE ALLOCATE_RECORD_BUFFER = !++ ! FUNCTIONAL DESCRIPTION: ! ! This routine will allocate the buffer for the user's record. It will ! use the value from the tape (if there is one) or it will make a guess. ! ! FORMAL PARAMETERS: ! ! None ! ! IMPLICIT INPUTS: ! ! FILE_RECORD_SIZE - Size we were told to use for the record size ! ! IMPLICIT OUTPUTS: ! ! RECORD_ADDRESS - Address fo the record buffer ! ! COMPLETION_CODES: ! ! System service completion code ! ! SIDE EFFECTS: ! ! None !-- BEGIN ! ! Local variables used in this routine ! LOCAL STATUS; ! Status returned by System Service calls ! ! External routines ! EXTERNAL ROUTINE LIB$GET_VM : ADDRESSING_MODE (GENERAL); ! Allocate memory ! ! First determine if we have a record size given by the caller ! IF .FILE_RECORD_SIZE EQL 0 ! Nothing stored means we guess THEN BEGIN IF .FILE_TYPE EQL FILE_TYPE_7BIT_CHARACTERS ! ASCII vs. Binary THEN FILE_RECORD_SIZE = INITIAL_ASCII_RECORDSIZE ! ASCII - Use this ELSE FILE_RECORD_SIZE = BINARY_RECORDSIZE; ! Binary - Other guess END; ! ! Here with something stored as the file record size ! RECORD_SIZE = .FILE_RECORD_SIZE + .FILE_FAB [FAB$B_FSZ]; ! Total size STATUS = LIB$GET_VM (RECORD_SIZE, RECORD_ADDRESS); IF NOT .STATUS ! If memory allocation failed, then THEN ! Clean up BEGIN ! the variables RECORD_SIZE = 0; ! . . . . RETURN .STATUS ! and return the failing status END; ! ! Here with the address of the buffer stored, see if we have a header ! that must be accounted for ! IF .FILE_FAB [FAB$B_FSZ] NEQ 0 THEN FILE_RAB [RAB$L_RHB] = .RECORD_ADDRESS; ! ! Here when everything is finished, just return the last status we got ! RETURN .STATUS END; %SBTTL 'SET_UP_FILE_NAME' ROUTINE SET_UP_FILE_NAME = !++ ! FUNCTIONAL DESCRIPTION: ! ! This routine will set up for the file creation. It will create any ! directories that need creating, beat the file specification into something ! that VMS will approvie of, etc. ! ! FORMAL PARAMETERS: ! ! None ! ! IMPLICIT INPUTS: ! ! FILE_NAME - File specification in OWN ! ! IMPLICIT OUTPUTS: ! ! Updated file specification ! ! COMPLETION_CODES: ! ! System service completion information ! ! SIDE EFFECTS: ! ! None !-- BEGIN ! ! Local variables to this routine ! LOCAL FILE_SPECIFICATION_FIELDS : ! Block vector containing the BLOCKVECTOR [FLD$K_LENGTH, DSC$K_S_BLN, BYTE] ! pointer to the fields PRESET ([FLD$K_DEVICE, DSC$B_CLASS ] = DSC$K_CLASS_S, ! String class [FLD$K_DEVICE, DSC$B_DTYPE ] = DSC$K_DTYPE_T, ! Type text [FLD$K_DIRECT, DSC$B_CLASS ] = DSC$K_CLASS_S, ! String class [FLD$K_DIRECT, DSC$B_DTYPE ] = DSC$K_DTYPE_T, ! Type text [FLD$K_NAME, DSC$B_CLASS ] = DSC$K_CLASS_S, ! String class [FLD$K_NAME, DSC$B_DTYPE ] = DSC$K_DTYPE_T, ! Type text [FLD$K_EXT, DSC$B_CLASS ] = DSC$K_CLASS_S, ! String class [FLD$K_EXT, DSC$B_DTYPE ] = DSC$K_DTYPE_T, ! Type text [FLD$K_VERSION, DSC$B_CLASS ] = DSC$K_CLASS_S, ! String class [FLD$K_VERSION, DSC$B_DTYPE ] = DSC$K_DTYPE_T), ! Type text OUTPUT_SPECIFICATION_FIELDS : ! Block vector containing the BLOCKVECTOR [FLD$K_LENGTH, DSC$K_S_BLN, BYTE] ! pointer to the fields PRESET ([FLD$K_DEVICE, DSC$B_CLASS ] = DSC$K_CLASS_S, ! String class [FLD$K_DEVICE, DSC$B_DTYPE ] = DSC$K_DTYPE_T, ! Type text [FLD$K_DIRECT, DSC$B_CLASS ] = DSC$K_CLASS_S, ! String class [FLD$K_DIRECT, DSC$B_DTYPE ] = DSC$K_DTYPE_T, ! Type text [FLD$K_NAME, DSC$B_CLASS ] = DSC$K_CLASS_S, ! String class [FLD$K_NAME, DSC$B_DTYPE ] = DSC$K_DTYPE_T, ! Type text [FLD$K_EXT, DSC$B_CLASS ] = DSC$K_CLASS_S, ! String class [FLD$K_EXT, DSC$B_DTYPE ] = DSC$K_DTYPE_T, ! Type text [FLD$K_VERSION, DSC$B_CLASS ] = DSC$K_CLASS_S, ! String class [FLD$K_VERSION, DSC$B_DTYPE ] = DSC$K_DTYPE_T), ! Type text NEW_SPECIFICATION_POINTER, ! Character pointer to the new spec START_OF_FIELD, ! Temp byte ptr for invalid char scanner CURR_CHAR, ! Current Character being scanned STATUS : INITIAL(SS$_NORMAL); ! Status return by system service calls; ! ! Output file specification ! EXTERNAL OUTPUT_FILE_DESC : $DESCRIPTOR_DECL; ! Output file description ! ! Command scanner interface ( /CREATE_DIRECTORIES qualifier) ! EXTERNAL GQ_QUAL_VALUE_CNTS : VECTOR [, LONG, SIGNED]; EXTERNAL LITERAL GQ$K_CREATEDIRECTORY_QUAL_INDEX; ! ! Routine that will determine the various fields that are found in a file ! specification. It will store the resulting information into the ! FILE_SPECIFICATION_FIELDS argument ! EXTERNAL ROUTINE EXTRACT_FIELDS : NOVALUE; ! ! Macro to fill in the various fields of the output file specification ! MACRO FILL_IN_FIELDS (FIELD_OFFSET) = START_OF_FIELD = .NEW_SPECIFICATION_POINTER; IF .OUTPUT_SPECIFICATION_FIELDS[FIELD_OFFSET, DSC$W_LENGTH] NEQ 0 THEN BEGIN NEW_SPECIFICATION_POINTER = CH$MOVE(.OUTPUT_SPECIFICATION_FIELDS[FIELD_OFFSET, DSC$W_LENGTH], CH$PTR(.OUTPUT_SPECIFICATION_FIELDS[FIELD_OFFSET, DSC$A_POINTER]), .NEW_SPECIFICATION_POINTER); FILE_LENGTH = .FILE_LENGTH + .OUTPUT_SPECIFICATION_FIELDS[FIELD_OFFSET,DSC$W_LENGTH] END ELSE BEGIN NEW_SPECIFICATION_POINTER = CH$MOVE(.FILE_SPECIFICATION_FIELDS[FIELD_OFFSET, DSC$W_LENGTH], CH$PTR(.FILE_SPECIFICATION_FIELDS[FIELD_OFFSET, DSC$A_POINTER]), .NEW_SPECIFICATION_POINTER); FILE_LENGTH = .FILE_LENGTH + .FILE_SPECIFICATION_FIELDS[FIELD_OFFSET,DSC$W_LENGTH] END; INCR CHAR_INDEX FROM .START_OF_FIELD TO .NEW_SPECIFICATION_POINTER - 1 DO BEGIN CURR_CHAR = CH$RCHAR( .CHAR_INDEX ); IF (.CURR_CHAR LSS %C'A' OR .CURR_CHAR GTR %C'Z') AND (.CURR_CHAR LSS %C'a' OR .CURR_CHAR GTR %C'z') AND (.CURR_CHAR LSS %C'0' OR .CURR_CHAR GTR %C'9') AND (.CURR_CHAR NEQ %C'-') AND (.CURR_CHAR NEQ %C'.') AND (.CURR_CHAR NEQ %C'$') AND (.CURR_CHAR NEQ %C'_') THEN CH$WCHAR(%C'_', .CHAR_INDEX) END; %; ! ! Clear the file specification first ! CH$FILL(CHR_NUL, MAX_FILE_NAME, CH$PTR(FILE_NAME)); ! ! First pull the file specification apart ! EXTRACT_FIELDS (.FILE_NAME_DESCRIPTOR, FILE_SPECIFICATION_FIELDS); ! ! Now pull the output file specification apart. ! EXTRACT_FIELDS (OUTPUT_FILE_DESC, OUTPUT_SPECIFICATION_FIELDS); ! ! Fudge up the output specification if it is *.* ! IF (.OUTPUT_SPECIFICATION_FIELDS[FLD$K_NAME, DSC$W_LENGTH] EQL 1) AND (CH$RCHAR( CH$PTR(.OUTPUT_SPECIFICATION_FIELDS[FLD$K_NAME, DSC$A_POINTER])) EQL %C'*') THEN OUTPUT_SPECIFICATION_FIELDS[FLD$K_NAME, DSC$W_LENGTH] = 0; IF (.OUTPUT_SPECIFICATION_FIELDS[FLD$K_EXT, DSC$W_LENGTH] EQL 1) AND (CH$RCHAR( CH$PTR(.OUTPUT_SPECIFICATION_FIELDS[FLD$K_EXT, DSC$A_POINTER])) EQL %C'*') THEN OUTPUT_SPECIFICATION_FIELDS[FLD$K_EXT, DSC$W_LENGTH] = 0; ! ! Now start matching and filling in the various fields ! FILE_LENGTH = 0; NEW_SPECIFICATION_POINTER = CH$PTR (FILE_NAME); ! ! First copy the device name over ! FILL_IN_FIELDS (FLD$K_DEVICE) ! Move the device fields FILE_LENGTH = .FILE_LENGTH + 1; ! Update the length CH$WCHAR_A (%C':', NEW_SPECIFICATION_POINTER); ! Store the terminator ! ! Now for the directory ! FILE_LENGTH = .FILE_LENGTH + 2; ! Update the length CH$WCHAR_A (%C'[', NEW_SPECIFICATION_POINTER); ! Start of the directory FILL_IN_FIELDS (FLD$K_DIRECT) ! Move the directory CH$WCHAR_A(%C']', NEW_SPECIFICATION_POINTER); ! End of the directory ! ! Now for the file name ! FILL_IN_FIELDS (FLD$K_NAME) ! Move the name over FILE_LENGTH = .FILE_LENGTH + 1; ! Update the length CH$WCHAR_A (%C'.', NEW_SPECIFICATION_POINTER); ! Write the period ! ! Now move the extension over ! FILL_IN_FIELDS (FLD$K_EXT) ! Move the extension over ! ! Determine if either of these items has a file generation ! IF ((.OUTPUT_SPECIFICATION_FIELDS [FLD$K_VERSION, DSC$W_LENGTH] NEQ 0) OR (.FILE_SPECIFICATION_FIELDS [FLD$K_VERSION, DSC$W_LENGTH] NEQ 0)) THEN BEGIN CH$WCHAR_A (%C';', NEW_SPECIFICATION_POINTER); FILE_LENGTH = .FILE_LENGTH + 1; FILL_IN_FIELDS (FLD$K_VERSION) END; ! ! Now we have the file specificiation parts, see if we need to create the ! directory. ! IF (.GQ_QUAL_VALUE_CNTS [GQ$K_CREATEDIRECTORY_QUAL_INDEX] GEQ 0) AND ( .OUTPUT_SPECIFICATION_FIELDS [FLD$K_DIRECT, DSC$W_LENGTH] EQL 0) THEN BEGIN EXTERNAL LITERAL ![IU-29] DMPR_CREATED_DIR, ![IU-29] Message for create. SS$_CREATED; ![IU-29] Return code for create. LOCAL POINTER_TO_BRACKET, ! Pointer to ] FILE_DIRECTORY_DESCRIPTOR : $DESCRIPTOR_DECL ! Descriptor for PRESET ! directory name ([DSC$A_POINTER ] = FILE_NAME, [DSC$B_CLASS ] = DSC$K_CLASS_S, ! String class [DSC$B_DTYPE ] = DSC$K_DTYPE_T); ! Type text POINTER_TO_BRACKET = CH$FIND_CH (.FILE_LENGTH, CH$PTR (FILE_NAME), %C']'); IF NOT CH$FAIL (POINTER_TO_BRACKET) THEN BEGIN FILE_DIRECTORY_DESCRIPTOR [DSC$W_LENGTH] = CH$DIFF ( .POINTER_TO_BRACKET, CH$PTR (FILE_NAME)) + 1; STATUS = FILE_CREATE_DIRECTORY (FILE_DIRECTORY_DESCRIPTOR); IF .STATUS EQL SS$_CREATED ![IU-29] Did we?? AND (.QUAL_LOG EQL LOG$K_ALL ![IU-29] and want log? OR .QUAL_LOG EQL LOG$K_DIRECTORIES) ![IU-29] ... THEN ![IU-29] Yes. LIB$SIGNAL(DMPR_CREATED_DIR, 1, FILE_DIRECTORY_DESCRIPTOR); ![IU-29] END END; RETURN .STATUS END; %SBTTL 'FILE_CREATE - Main logic' ! ! First build the file name ! STATUS = SET_UP_FILE_NAME (); IF .FILE_LENGTH EQL 0 THEN LIB$SIGNAL (DMPR_ILLFILENAM); ! ! If we really have a file specification then see if the create of the ! directory failed. ! IF NOT .STATUS THEN BEGIN ![IU-1] LIB$SIGNAL (DMPR_FILEOPEN, 2, FILE_LENGTH, FILE_NAME, .STATUS); LIB$SIGNAL (DMPR_FILEOPEN, 2, .FILE_LENGTH, FILE_NAME, .STATUS); ![IU-1] RETURN .STATUS END; ! ! Store the file name into the FAB ! FILE_FAB [FAB$B_FNS] = .FILE_LENGTH; FILE_FAB [FAB$L_FNA] = FILE_NAME; ! ! Here with the name completed and the count in FILE_LENGTH ! FILE_FAB [FAB$L_XAB] = .XAB_BLOCK_LIST; ! Point to the first of the XABs STATUS = $CREATE (FAB = FILE_FAB); IF NOT .STATUS THEN BEGIN ![IU-1] LIB$SIGNAL (DMPR_FILEOPEN, 2, FILE_LENGTH, FILE_NAME, .STATUS); LIB$SIGNAL (DMPR_FILEOPEN, 2, .FILE_LENGTH, FILE_NAME, .STATUS); ![IU-1] RETURN .STATUS END; ! ! Now connect the RAB/FAB ! STATUS = $CONNECT (RAB = FILE_RAB); IF NOT .STATUS THEN BEGIN ![IU-1] LIB$SIGNAL (DMPR_FILEOPEN, 2, FILE_NAME, FILE_LENGTH, .STATUS); LIB$SIGNAL (DMPR_FILEOPEN, 2, .FILE_LENGTH, FILE_NAME, .STATUS); ![IU-1] RETURN .STATUS END; ! ! Initialize the record pointer/counter ! STATUS = ALLOCATE_RECORD_BUFFER (); ! Get the buffer IF NOT .STATUS THEN BEGIN $CLOSE (FAB = FILE_FAB); ![IU-1] LIB$SIGNAL (DMPR_FILEOPEN, 2, FILE_LENGTH, FILE_NAME, .STATUS); LIB$SIGNAL (DMPR_FILEOPEN, 2, .FILE_LENGTH, FILE_NAME, .STATUS); ![IU-1] RETURN .STATUS END; ! ! Here if we have allocated the buffers ! RECORD_COUNT = 0; RECORD_POINTER = CH$PTR (.RECORD_ADDRESS); ! ! Now do any of the /LOG processing that the user requested ! IF (.QUAL_LOG EQL LOG$K_ALL) OR (.QUAL_LOG EQL LOG$K_FILES) THEN ![IU-1] LIB$SIGNAL(DMPR_CREATEDFILE, 2, FILE_LENGTH, FILE_NAME); LIB$SIGNAL(DMPR_CREATEDFILE, 2, .FILE_LENGTH, FILE_NAME); ![IU-1] RETURN SS$_NORMAL; ! Good return to the caller END; %SBTTL 'DUMP_BUFFER - Dump the current record to disk' ROUTINE DUMP_BUFFER = !++ ! FUNCTIONAL DESCRIPTION: ! ! This routine will dump the current record to disk. It doesn't ! care what type of file you are writing, unlike FILE_DUMP. ! ! CALLING SEQUENCE: ! ! STATUS = DUMP_BUFFER(); ! ! INPUT PARAMETERS: ! ! None. ! ! IMPLICIT INPUTS: ! ! None. ! ! OUTPUT PARAMETERS: ! ! None. ! ! IMPLICIT OUTPUTS: ! ! None. ! ! COMPLETION CODES: ! ! SS$_NORMAL or RMS error codes. ! ! SIDE EFFECTS: ! ! None. ! !-- BEGIN LOCAL STATUS; ! Random status values ! ! First update the record length ! FILE_RAB [RAB$W_RSZ] = .RECORD_COUNT; FILE_RAB [RAB$L_RBF] = .RECORD_ADDRESS + .FILE_FAB [FAB$B_FSZ]; ! ! Now output the record to the file ! STATUS = $PUT (RAB = FILE_RAB); ! ! Update the pointers first ! RECORD_COUNT = 0; RECORD_POINTER = CH$PTR (.RECORD_ADDRESS); ! ! Now determine if we failed attempting to write the record ! IF NOT .STATUS THEN BEGIN EXTERNAL ROUTINE LIB$SIGNAL : ADDRESSING_MODE (GENERAL) NOVALUE; EXTERNAL LITERAL DMPR_OUTPUTFAIL; ![IU-1] LIB$SIGNAL (DMPR_OUTPUTFAIL, 2, FILE_NAME, FILE_LENGTH, .STATUS); LIB$SIGNAL (DMPR_OUTPUTFAIL, 2, .FILE_LENGTH, FILE_NAME, .STATUS); ![IU-1] RETURN .STATUS; END; RETURN SS$_NORMAL END; ! End of DUMP_BUFFER %SBTTL 'FILE_WRITE_CHARACTER - Write a character to the output file' GLOBAL ROUTINE FILE_WRITE_CHARACTER (CHARACTER) = !++ ! FUNCTIONAL DESCRIPTION: ! ! This routine will store a character into the buffer to be written to ! the output file. ! ! FORMAL PARAMETERS: ! ! CHARACTER - Character that is to be stored into the output file. ! ! IMPLICIT INPUTS: ! ! RMS blocks in local OWN storage. ! RECORD_POINTER - pointer into the line block ! RECORD_COUNT - Count of the number of characters left in the line block. ! ! IMPLICIT OUTPUTS: ! ! Updated: ! RECORD_POINTER ! RECORD_COUNT ! ! COMPLETION_CODES: ! ! SS$_NORMAL - Character stored ! Failure codes from RMS-32 ! ! SIDE EFFECTS: ! ! Line may be written to the output file. !-- BEGIN LOCAL STATUS; ! Random status values %SBTTL 'EXPAND_BUFFER - Expand the ASCII buffer' ROUTINE EXPAND_BUFFER = !++ ! FUNCTIONAL DESCRIPTION: ! ! This routine will expand the ASCII character buffer. It will move the ! characters from the current buffer to the next buffer. ! ! FORMAL PARAMETERS: ! ! None ! ! IMPLICIT INPUTS: ! ! RECORD_SIZE - Size of the current record ! RECORD_ADDRESS - Address of the current record ! ! IMPLICIT OUTPUTS: ! ! Updated RECORD_SIZE and RECORD_ADDRESS and RECORD_POINTER ! ! COMPLETION_CODES: ! ! SS$_NORMAL - Buffer copied and updated correctly ! Others - Problem allocating the buffer to move the information into ! ! SIDE EFFECTS: ! ! None !-- BEGIN EXTERNAL ROUTINE LIB$GET_VM : ADDRESSING_MODE (GENERAL), LIB$FREE_VM : ADDRESSING_MODE (GENERAL); LOCAL STATUS, NEW_RECORD_ADDRESS, NEW_RECORD_SIZE; ! ! First determine the new RECORD size ! NEW_RECORD_SIZE = .RECORD_SIZE + ASCII_RECORDSIZE_INCREMENT; ! ! Attempt to allocate the RECORD ! STATUS = LIB$GET_VM (NEW_RECORD_SIZE, NEW_RECORD_ADDRESS); IF NOT .STATUS THEN BEGIN EXTERNAL ROUTINE LIB$SIGNAL : ADDRESSING_MODE (GENERAL) NOVALUE; LIB$SIGNAL (.STATUS); RETURN .STATUS END; ! ! Now move the characters and update the pointer to them ! CH$MOVE (.RECORD_SIZE, CH$PTR (.RECORD_ADDRESS), CH$PTR (.NEW_RECORD_ADDRESS)); RECORD_POINTER = CH$PTR (.NEW_RECORD_ADDRESS, .RECORD_SIZE); ! ! Now return the old record and store the new addresses ! STATUS = LIB$FREE_VM (RECORD_SIZE, RECORD_ADDRESS); RECORD_SIZE = .NEW_RECORD_SIZE; ! Update the new size RECORD_ADDRESS = .NEW_RECORD_ADDRESS; ! And the new buffer address RETURN .STATUS ! Return the final status END; %SBTTL 'FILE_WRITE_CHARACTER - Main logic' SELECTONE .FILE_TYPE OF SET [FILE_TYPE_7BIT_CHARACTERS] : BEGIN ![IU-2]++ ! As of version 1.0.002, 36-bit files are written as 7-bit files. This ! is fine, but if the file is really a binary file and we increase ! RECORD_COUNT beyond RMS's limit, DUMP_BUFFER will blow up on an illegal ! record size error. So, here, check the record size and truncate the ! record if it is too big. Only output the message once though, it is ! a bore to sit through hundreds of them. Note that we don't have any ! special code here for the end-of-record state, because whatever file ! we are writing is peanut butter anyway. The intent of the code is simply ! to allow the user to get to the next file on the tape (i.e., to keep ! DUMPER-32 from blowing up). Note: As of edit IU-8, if a user really ! wants to just get the bits off the tape, they may /SELECT the file and ! restore it using the /BINARY qualifier. This way, a user can restore ! *any* kind of binary file. Of course, what they do with it after they ! get it restored to disk on the VAX is their problem, but all the bits ! will be there... ! IF .RECORD_COUNT GEQ MAX_RECORDSIZE THEN BEGIN RECORD_COUNT = MAX_RECORDSIZE; STATUS = DUMP_BUFFER(); FILE_RECORD_TRUNCATED = TRUE; IF NOT .STATUS THEN RETURN .STATUS; END; ![IU-2]-- ![IU-19]++ ! Test for bit 35 on in a word. This is the least significant bit in the ! 36-bit word, and indicates that the file is either a 36-bit binary file, ! a file with line sequence numbers, or a text file written by a sloppy ! program that didn't clear it's buffers before writing the 5 7-bit characters ! per word into the words. Here we just flag this so we can give a message ! when the file is closed. The bit will appear as the most significant bit ! in the eight-bit byte, and only if the /REMOVE_LSNS qualifier was given. ! FILE_IS_BINARY = .FILE_IS_BINARY OR (.CHARACTER AND %O'200') NEQ 0; ![IU-19]-- ! ! If the last character was a carriage return and this is a line feed, ! we will just dump the record. Otherwise, if the last character was ! a carriage return, output both it and the current one. ! IF .FILE_FAB [FAB$L_CTX] NEQ FILE_STATE_DATA THEN BEGIN IF (.CHARACTER AND %O'177') EQL CHR_LFD THEN BEGIN FILE_FAB [FAB$L_CTX] = FILE_STATE_DATA; RETURN DUMP_BUFFER (); END ELSE BEGIN IF .RECORD_COUNT GEQ .RECORD_SIZE THEN BEGIN STATUS = EXPAND_BUFFER (); IF NOT .STATUS THEN RETURN .STATUS; END; CH$WCHAR_A (CHR_CRT, RECORD_POINTER); ! Store the carriage return we deferred RECORD_COUNT = .RECORD_COUNT + 1; FILE_FAB [FAB$L_CTX] = FILE_STATE_DATA; ! Back to normal data END; END; ! ! Here when last character was written to the file normally. Check if ! this character might be the end of a record (or at least the start of ! end). ! IF (.CHARACTER AND %O'177') EQL CHR_CRT THEN BEGIN FILE_FAB [FAB$L_CTX] = FILE_STATE_POST; ! Remember we saw this RETURN SS$_NORMAL; ! And delay until next character END; ![IU-7]++ ! Rest of LSN-removal processing is done here. First, discard any nulls at ! the beginning of the record. Next, if we have exactly 5 characters in the ! record buffer, check for an LSN and remove it if so. ! IF .FILE_REMOVE_LSNS ![IU-7] Skip this if not removing LSNs. THEN IF (.RECORD_COUNT EQL 0) AND (.CHARACTER EQL CHR_NUL) THEN RETURN SS$_NORMAL ![IU-7] Remove leading nulls from record. ELSE IF (.RECORD_COUNT EQL 5) AND ((CH$RCHAR(CH$PTR(.RECORD_ADDRESS, 4)) AND %O'200') NEQ 0) THEN BEGIN ![IU-19] May have an LSN or page mark. ![IU-19]++ LOCAL BLANK_COUNT, ![IU-19] To determine if page mark. DIGIT_COUNT, ![IU-19] To determine if LSN. C; ![IU-19] Current character. BLANK_COUNT = DIGIT_COUNT = 0; INCR I FROM 0 TO 4 DO ![IU-19] See if EDIT/SOS did it. BEGIN C = CH$RCHAR(CH$PTR(.RECORD_ADDRESS,.I)) AND %O'177'; IF .C EQL CHR_SP THEN BLANK_COUNT = .BLANK_COUNT + 1 ELSE IF .C GEQ %C'0' AND .C LEQ %C'9' THEN DIGIT_COUNT = .DIGIT_COUNT + 1 END; ![IU-19] Only erase the funny thing we found if it is *really* an EDIT or ![IU-19] SOS page mark or line sequence number. IF .BLANK_COUNT EQL 5 OR .DIGIT_COUNT EQL 5 THEN BEGIN RECORD_COUNT = 0; RECORD_POINTER = CH$PTR (.RECORD_ADDRESS); FILE_LSNS_REMOVED = TRUE; ![IU-19] If it was a line sequence number, also discard the tab that follows. ![IU-19] If it was a page mark, the current character should be a form-feed, ![IU-19] which we might as well keep. IF .CHARACTER EQL CHR_TAB ![IU-19] Discard tab that follow THEN RETURN SS$_NORMAL; END; END; ![IU-19]-- ![IU-7]-- IF .RECORD_COUNT GEQ .RECORD_SIZE THEN BEGIN STATUS = EXPAND_BUFFER (); IF NOT .STATUS THEN RETURN .STATUS; END; RECORD_COUNT = .RECORD_COUNT + 1; CH$WCHAR_A (.CHARACTER, RECORD_POINTER); END; [FILE_TYPE_8BIT_DATA, FILE_TYPE_36BIT_DATA, FILE_TYPE_NON_STANDARD] : BEGIN IF .RECORD_COUNT GEQ .RECORD_SIZE THEN BEGIN STATUS = DUMP_BUFFER (); IF NOT .STATUS THEN BEGIN EXTERNAL ROUTINE LIB$SIGNAL : ADDRESSING_MODE (GENERAL) NOVALUE; LIB$SIGNAL (.STATUS); RETURN .STATUS; END; END; RECORD_COUNT = .RECORD_COUNT + 1; CH$WCHAR_A (.CHARACTER, RECORD_POINTER); END; TES; RETURN SS$_NORMAL END; %SBTTL 'FILE_DATA_FILL - Write fill data to the output file' GLOBAL ROUTINE FILE_DATA_FILL (NUMBER_OF_FILL_CHARACTERS) = !++ ! FUNCTIONAL DESCRIPTION: ! ! This routine will write fill characters to the output file. It will be ! called with the number of characters to write into the file. ! ! FORMAL PARAMETERS: ! ! NUMBER_OF_FILL_CHARACTERS - Number of fill characters to write into the ! output file. ! ! IMPLICIT INPUTS: ! ! Record data in local OWN storage ! ! IMPLICIT OUTPUTS: ! ! Data written to the file ! ! COMPLETION_CODES: ! ! System service/RMS status ! ! SIDE EFFECTS: ! ! None !-- BEGIN ! ! Local variables found in the routine ! LOCAL STATUS; ! Returned status ! ! Here to loop for all of the fill characters. This will just write ! nulls into the file. ! INCR I FROM 1 TO .NUMBER_OF_FILL_CHARACTERS DO BEGIN STATUS = FILE_WRITE_CHARACTER (CHR_NUL); IF NOT .STATUS THEN EXITLOOP END; RETURN .STATUS END; %SBTTL 'CVT_FILE_DATA - Convert file data to VAX format' GLOBAL ROUTINE CVT_FILE_DATA ( ! Convert 36bit data to 8bit WORD_36BITS : REF DEC_36_BIT_RECORD, ! Data record to convert DATA_COUNT, ! Number of words/bytes BYTE_FLAG ! Flag to denote if DATA_COUNT is ) = ! bytes !++ ! FUNCTIONAL DESCRIPTION: ! ! This routine will take the data from the tape buffer and write it into ! the file. This routine will do the three different file data conversions. ! ! FORMAL PARAMETERS: ! ! WORD_36BITS - Starting address of the first word of data to ! convert. The data is considered to be in a VECTOR of DEC_36BIT_WORDS. ! ! DATA_COUNT - Count of the number of items to output. This count could be ! either words or bytes. ! ! BYTE_FLAG - Flag that says the DATA_COUNT is either a count of the ! bytes to output or words. If the flag is true then the count is in ! bytes. ! ! IMPLICIT INPUTS: ! ! FILE_TYPE - Own variable that contains the type of file we are writing. ! ! IMPLICIT OUTPUTS: ! ! None ! ! COMPLETION_CODES: ! ! SS$_NORMAL or RMS error attempting to output a byte. ! ! SIDE EFFECTS: ! ! None !-- BEGIN ! ! Declare the error signalling routine ! EXTERNAL ROUTINE LIB$SIGNAL : ADDRESSING_MODE (GENERAL) NOVALUE; ! ! Declare the error conditionals that are returned ! EXTERNAL LITERAL DMPR_ILLFILETYPE; ! ! External routines to do conversions ! EXTERNAL ROUTINE CVT_FETCH_7BIT_CHARACTER; ! ! Local storage to process the information ! LOCAL CHARACTER, ! Character we are processing TOTAL_DATA_BYTES, ! Total number of data bytes STATUS; ! Status returned by low level ! ! Handle the different type of files. Issue an error if we don't know ! how to handle a file type ! CASE .FILE_TYPE FROM FILE_TYPE_MINIMUM TO FILE_TYPE_MAXIMUM OF SET [FILE_TYPE_7BIT_CHARACTERS] : BEGIN TOTAL_DATA_BYTES = .DATA_COUNT*(IF .BYTE_FLAG THEN 1 ELSE 5); INCR I FROM 0 TO .TOTAL_DATA_BYTES - 1 DO BEGIN ![IU-7] Preserve 36th bit here if stripping EDIT/SOS line numbers. FILE_- ![IU-7] WRITE_CHARACTER handles the rest of this (q.v.). CHARACTER = CVT_FETCH_7BIT_CHARACTER (WORD_36BITS [0, FRAME_ALL] ![IU-7] , .I, FALSE); , .I, .FILE_REMOVE_LSNS); STATUS = FILE_WRITE_CHARACTER (.CHARACTER); IF NOT .STATUS THEN RETURN .STATUS; END; END; [FILE_TYPE_8BIT_DATA] : BEGIN TOTAL_DATA_BYTES = .DATA_COUNT*(IF .BYTE_FLAG THEN 1 ELSE 4); INCR I FROM 0 TO .TOTAL_DATA_BYTES - 1 DO BEGIN LOCAL WORD_OFFSET; WORD_OFFSET = .I/4; CASE (.I MOD 4) FROM 0 TO 3 OF SET [0] : CHARACTER = .WORD_36BITS [.WORD_OFFSET, FRAME_0]; [1] : CHARACTER = .WORD_36BITS [.WORD_OFFSET, FRAME_1]; [2] : CHARACTER = .WORD_36BITS [.WORD_OFFSET, FRAME_2]; [3] : CHARACTER = .WORD_36BITS [.WORD_OFFSET, FRAME_3]; TES; STATUS = FILE_WRITE_CHARACTER (.CHARACTER); IF NOT .STATUS THEN RETURN .STATUS; END END; [FILE_TYPE_36BIT_DATA] : BEGIN TOTAL_DATA_BYTES = .DATA_COUNT*(IF .BYTE_FLAG THEN 1 ELSE 5); INCR I FROM 0 TO .TOTAL_DATA_BYTES -1 DO BEGIN CHARACTER = CVT_FETCH_7BIT_CHARACTER (WORD_36BITS [0, FRAME_ALL] , .I, TRUE); STATUS = FILE_WRITE_CHARACTER (.CHARACTER); IF NOT .STATUS THEN RETURN .STATUS; END; END; ! ! Here for a file that doesn't have nice 8 or 7 bit bytes stuffed into ! a word. We must extract each byte from the word. ! [FILE_TYPE_NON_STANDARD] : BEGIN EXTERNAL ROUTINE CVT_FIELD : ADDRESSING_MODE (GENERAL); LOCAL BYTES_PER_WORD; BYTES_PER_WORD = 36/.FILE_FRAME_SIZE; TOTAL_DATA_BYTES = .DATA_COUNT*(IF .BYTE_FLAG THEN 1 ELSE .BYTES_PER_WORD); INCR I FROM 1 TO .TOTAL_DATA_BYTES DO BEGIN LOCAL WORD_OFFSET; STATUS = CVT_FIELD (WORD_36BITS [.I/.BYTES_PER_WORD, FRAME_ALL], .FILE_FRAME_SIZE, (.FILE_FRAME_SIZE*(.I/.BYTES_PER_WORD)), CHARACTER, 4, .WORD_36BITS); IF NOT .STATUS THEN RETURN .STATUS; STATUS = FILE_WRITE_CHARACTER ((.CHARACTER MOD .FILE_BYTE_SIZE) MOD 8); IF NOT .STATUS THEN RETURN .STATUS; IF .FILE_BYTE_SIZE GTR 8 THEN BEGIN STATUS = FILE_WRITE_CHARACTER ((.CHARACTER/8) MOD 8); IF NOT .STATUS THEN RETURN .STATUS END; IF .FILE_BYTE_SIZE GTR 16 THEN BEGIN STATUS = FILE_WRITE_CHARACTER ((.CHARACTER/16) MOD 8); IF NOT .STATUS THEN RETURN .STATUS; STATUS = FILE_WRITE_CHARACTER ((.CHARACTER/24) MOD 8); IF NOT .STATUS THEN RETURN .STATUS END END; END; [INRANGE, OUTRANGE] : RETURN DMPR_ILLFILETYPE; TES; RETURN SS$_NORMAL END; %SBTTL 'FILE_CLOSE - Close the file' GLOBAL ROUTINE FILE_CLOSE = !++ ! FUNCTIONAL DESCRIPTION: ! ! This routine will close the file that we have created. ! ! FORMAL PARAMETERS: ! ! None ! ! IMPLICIT INPUTS: ! ! RMS blocks in the OWN storage in this module. ! ! IMPLICIT OUTPUTS: ! ! None ! ! COMPLETION_CODES: ! ! SS$_NORMAL - File closed properly ! RMS error codes. ! ! SIDE EFFECTS: ! ! None !-- BEGIN ! ! External storage ! EXTERNAL QUAL_LOG; ! /LOG qualifier storage ! ! Define the various types of failure possible ! EXTERNAL LITERAL DMPR_RESTOREDFILE, ! Was was restored DMPR_FILECLOSE, ! Problem restoring file DMPR_BINARYFILE, ![IU-19] File was binary, restored as a text file. DMPR_RECORDTRUNC, ![IU-19] Records were truncated. DMPR_REMOVEDLSNS; ![IU-19] LSNs were removed. ! ! Define the external routines ! EXTERNAL ROUTINE LIB$SIGNAL : ADDRESSING_MODE (GENERAL) NOVALUE, LIB$FREE_VM : ADDRESSING_MODE (GENERAL); ! ! Local variables ! LOCAL STATUS, ! Status returned by various routines CHARACTER, ! Character we are checking NEW_POINTER; ! Pointer to back up ![IU-19]++ ! Give any messages about binary file restored as a text file, records ! truncated, or EDIT/SOS line sequence numbers removed. ! IF .FILE_IS_BINARY AND NOT .FILE_LSNS_REMOVED THEN LIB$SIGNAL (DMPR_BINARYFILE, 1, .FILE_NAME_DESCRIPTOR); IF .FILE_LSNS_REMOVED THEN LIB$SIGNAL (DMPR_REMOVEDLSNS, 2, .FILE_LENGTH, FILE_NAME); IF .FILE_RECORD_TRUNCATED THEN LIB$SIGNAL (DMPR_RECORDTRUNC, 2, .FILE_LENGTH, FILE_NAME); ![IU-19]-- ! ! Eat any nulls at the end of the buffer, they may be left over from the ! file having 0 to 4 nulls at the last word of the file. ! NEW_POINTER = .RECORD_POINTER; ! Point at the end of the record ! ! Loop looking for nulls ! IF .RECORD_COUNT GTR 0 AND .FILE_TYPE NEQ FILE_TYPE_7BIT_CHARACTERS ![IU-18] Please don't do this to binary files... Please? THEN INCR I FROM 1 TO (IF .RECORD_COUNT LSS 5 THEN .RECORD_COUNT ELSE 4) DO BEGIN NEW_POINTER = CH$PLUS (.NEW_POINTER, -1);! Back the pointer up one CHARACTER = CH$RCHAR (.NEW_POINTER); ! Read the character IF .CHARACTER NEQ CHR_NUL THEN EXITLOOP; ! If this is a null get out RECORD_COUNT = .RECORD_COUNT - 1 ! Null, one less character END; ! ! First determine if there is anything that we must dump into the output ! file that is left in the buffer ! IF .RECORD_COUNT NEQ 0 THEN BEGIN STATUS = DUMP_BUFFER (); IF NOT .STATUS THEN ![IU-1] LIB$SIGNAL (DMPR_FILECLOSE, 2, FILE_LENGTH, ![IU-1] FILE_NAME, .STATUS) LIB$SIGNAL (DMPR_FILECLOSE, 2, .FILE_LENGTH, ![IU-1] FILE_NAME, .STATUS) ![IU-1] END; ! ! Disconnect the RAB/FAB first ! STATUS = $DISCONNECT (RAB = FILE_RAB); IF NOT .STATUS THEN BEGIN ![IU-1] LIB$SIGNAL (DMPR_FILECLOSE, 2, FILE_LENGTH, FILE_NAME, .STATUS); LIB$SIGNAL (DMPR_FILECLOSE, 2, .FILE_LENGTH, FILE_NAME, .STATUS); ![IU-1] RETURN .STATUS END; ! ! Return the record block ! STATUS = LIB$FREE_VM (RECORD_SIZE, RECORD_ADDRESS); ! ! Now clear the address and size ! RECORD_ADDRESS = 0; RECORD_SIZE = 0; ! ! Now close the file and return the status ! STATUS = $CLOSE (FAB = FILE_FAB); ! ! Log the fact that the file is now closed ! IF (.QUAL_LOG EQL LOG$K_ALL) OR (.QUAL_LOG EQL LOG$K_FILES) THEN ![IU-1] LIB$SIGNAL (DMPR_RESTOREDFILE, 3, .FILE_NAME_DESCRIPTOR, FILE_LENGTH, ![IU-1] FILE_NAME); LIB$SIGNAL (DMPR_RESTOREDFILE, 3, .FILE_NAME_DESCRIPTOR, .FILE_LENGTH, ![IU-1] FILE_NAME); ![IU-1] RETURN .STATUS; END; %SBTTL 'INITAILIZE_XAB_LIST - This will reset the XAB list' ROUTINE INITIALIZE_XAB_LIST : NOVALUE = !++ ! FUNCTIONAL DESCRIPTION: ! ! This routine is called to initialize the XAB list. It will clear the ! pointers in the XAB blocks. ! ! FORMAL PARAMETERS: ! ! None ! ! IMPLICIT INPUTS: ! ! XAB blocks in OWN storage. ! ! IMPLICIT OUTPUTS: ! ! Next fields in the XAB blocks cleared. ! ! COMPLETION_CODES: ! ! None ! ! SIDE EFFECTS: ! ! None !-- BEGIN XAB_DATE_TIME [XAB$L_NXT] = 0; ! No next XAB in the date/time XAB XAB_REVISION_DATE_TIME [XAB$L_NXT] = 0; ! No next XAB in the revision ! date/time XAB XAB_PROTECTION [XAB$L_NXT] = 0; ! No next XAB in the protection XAB XAB_BLOCK_LIST = 0; ! Nothing in the XAB list yet END; %SBTTL 'LINK_XAB_BLOCK_IN - Link an XAB block into the chain' ROUTINE LINK_XAB_BLOCK_IN ( ! Routine to link XAB blocks together XAB_TO_LINK_IN : REF BLOCK ! XAB block to link in ) : NOVALUE = !++ ! FUNCTIONAL DESCRIPTION: ! ! This routine will link in a new XAB block into the XAB chain. The ! new block to link in will be the XAB_TO_LINK_IN argument. ! ! FORMAL PARAMETERS: ! ! XAB_TO_LINK_IN - Block to place in the XAB chain. ! ! IMPLICIT INPUTS: ! ! XAB_BLOCK_LIST - List of XAB blocks. ! ! IMPLICIT OUTPUTS: ! ! Updated XAB_BLOCK_LIST ! ! COMPLETION_CODES: ! ! None ! ! SIDE EFFECTS: ! ! None !-- BEGIN ! ! Local variables ! LOCAL CURRENT_XAB : REF BLOCK; ! Current XAB, when searching the list ! ! First determine that the block is not already on the list ! NOTE: This is done because the protection XAB is used to set the owner and ! and the protection for the file. It could cause this routine to be ! called twice, so be protective here. ! CURRENT_XAB = .XAB_BLOCK_LIST; ! Start with the first block WHILE .CURRENT_XAB NEQ 0 DO ! Loop for all XABs in the list BEGIN IF .CURRENT_XAB EQL .XAB_TO_LINK_IN THEN RETURN SS$_NORMAL; ! Already done (PROTECTION block?) CURRENT_XAB = .CURRENT_XAB [XAB$L_NXT] ! Advance to the next XAB END; ! ! At this point we know that the block is not on the XAB list, so link it in ! XAB_TO_LINK_IN [XAB$L_NXT] = .XAB_BLOCK_LIST; ! Make the new block point ! at the list XAB_BLOCK_LIST = .XAB_TO_LINK_IN ! Put this at the beginning END; END ! End of module ELUDOM