MODULE KERFIL (IDENT = '2.0.006' ) = BEGIN ! !++ ! FACILITY: ! KERMIT-32 Microcomputer to mainframe file transfer utility. ! ! ABSTRACT: ! KERFIL contains all of the file processing for KERMIT-32. This ! module contains the routines to input/output characters to files ! and to open and close the files. ! ! ENVIRONMENT: ! VAX/VMS user mode. ! ! AUTHOR: Robert C. McQueen, CREATION DATE: 28-March-1983 ! !-- %SBTTL 'Table of Contents' %SBTTL 'Revision History' !++ ! ! 1.0.000 By: Robert C. McQueen On: 28-March-1983 ! Create this module. ! 1.0.001 By: Robert C. McQueen On: 4-April-1983 ! Remove checks for in the input data stream. ! ! 1.0.002 By: Robert C. McQueen On: 31-May-1983 ! Fix a bad check in wildcard processing. ! ! 1.0.003 By: Nick Bush On: 13-June-1983 ! Add default file spec of .;0 so that wild-carded ! file types don't cause all version of a file to ! be transferred. ! ! 1.0.004 By: Robert C. McQueen On: 20-July-1983 ! Strip off the parity bit on the compares for incoming ASCII ! files. ! ! 1.2.005 By: Robert C. McQueen On: 15-August-1983 ! Attempt to improve the GET%FILE and make it smaller. ! Also start the implementation of the BLOCK file processing. ! ! 2.0.006 Release VAX/VMS Kermit-32 version 2.0 !-- %SBTTL 'Forward definitions' FORWARD ROUTINE FILE_DUMP, ! Dump the contents of the record DUMP_BUFFER, ! Worker routine for FILE_DUMP. GET_BUFFER, ! Routine to do $GET GET_ASCII, ! Get an ASCII character GET_BLOCK, ! Get a block character FILE_ERROR : NOVALUE; ! Error processing routine %SBTTL 'Require/Library files' ! ! INCLUDE FILES: ! LIBRARY 'SYS$LIBRARY:STARLET'; REQUIRE 'KERCOM.REQ'; REQUIRE 'KERERR.REQ'; %SBTTL 'Macro definitions' ! ! MACROS: ! %SBTTL 'Literal symbol definitions' ! ! EQUATED SYMBOLS: ! ! ! Various states for reading the data from the file ! LITERAL F_STATE_PRE = 0, ! Prefix state F_STATE_PRE1 = 1, ! Other prefix state F_STATE_DATA = 2, ! Data processing state F_STATE_POST = 3, ! Postfix processing state F_STATE_POST1 = 4, ! Secondary postfix processing state F_STATE_MIN = 0, ! Min state number F_STATE_MAX = 4; ! Max state number %SBTTL 'Local storage' ! ! OWN STORAGE: ! OWN EOF_FLAG, ! End of file reached. STATUS, ! Status returned by RMS calls ! used in the FIL_ERROR routine FILE_FAB : $FAB_DECL, ! FAB for file processing FILE_NAM : $NAM_DECL, ! NAM for file processing FILE_RAB : $RAB_DECL, ! RAB for file processing FILE_XABFHC : $XABFHC_DECL, ! XAB for file processing FILE_MODE, ! Mode of file (reading/writing) FILE_REC_POINTER, ! Pointer to the record information FILE_REC_COUNT, ! Count of the number of bytes REC_SIZE : LONG, ! Record size REC_ADDRESS : LONG, ! Record address EXP_STR : VECTOR [CH$ALLOCATION (NAM$C_MAXRSS)], RES_STR : VECTOR [CH$ALLOCATION (NAM$C_MAXRSS)], RES_STR_D : BLOCK [8, BYTE]; ! Descriptor for the string %SBTTL 'Global storage' ! ! Global storage: ! GLOBAL FILE_TYPE, ! Type of file being xfered FILE_DESC : BLOCK [8, BYTE]; ! File name descriptor %SBTTL 'External routines and storage' ! ! EXTERNAL REFERENCES: ! ! ! Storage in KERMSG ! EXTERNAL FILE_SIZE, ! Number of characters in FILE_NAME FILE_NAME : VECTOR [CH$ALLOCATION (MAX_FILE_NAME)]; ! ! System libraries ! EXTERNAL ROUTINE LIB$GET_VM : ADDRESSING_MODE (GENERAL), LIB$FREE_VM : ADDRESSING_MODE (GENERAL), LIB$SIGNAL : ADDRESSING_MODE (GENERAL) NOVALUE; %SBTTL 'File processing -- FILE_INIT - Initialization' GLOBAL ROUTINE FILE_INIT : NOVALUE = !++ ! FUNCTIONAL DESCRIPTION: ! ! This routine will initialize some of the storage in the file processing ! module. ! ! CALLING SEQUENCE: ! ! FILE_INIT(); ! ! INPUT PARAMETERS: ! ! None. ! ! IMPLICIT INPUTS: ! ! None. ! ! OUTPUT PARAMETERS: ! ! None. ! ! IMPLICIT OUTPUTS: ! ! None. ! ! COMPLETION CODES: ! ! None. ! ! SIDE EFFECTS: ! ! None. ! !-- BEGIN FILE_TYPE = FILE_ASC; ! Now set up the file specification descriptor FILE_DESC [DSC$B_CLASS] = DSC$K_CLASS_S; FILE_DESC [DSC$B_DTYPE] = DSC$K_DTYPE_T; FILE_DESC [DSC$A_POINTER] = FILE_NAME; FILE_DESC [DSC$W_LENGTH] = 0; EOF_FLAG = FALSE; END; ! End of FILE_INIT %SBTTL 'GET_FILE' GLOBAL ROUTINE GET_FILE (CHARACTER) = !++ ! FUNCTIONAL DESCRIPTION: ! ! This routine will return a character from the input file. ! The character will be stored into the location specified by ! CHARACTER. ! ! CALLING SEQUENCE: ! ! GET_FILE (LOCATION_TO_STORE_CHAR); ! ! INPUT PARAMETERS: ! ! LOCATION_TO_STORE_CHAR - This is the address to store the character ! into. ! ! IMPLICIT INPUTS: ! ! None. ! ! OUTPUT PARAMETERS: ! ! Character stored into the location specified. ! ! IMPLICIT OUTPUTS: ! ! None. ! ! COMPLETION CODES: ! ! True - Character stored into the location specified. ! False - End of file reached. ! ! SIDE EFFECTS: ! ! None. ! !-- BEGIN IF .EOF_FLAG THEN RETURN KER_EOF; SELECTONE .FILE_TYPE OF SET [FILE_ASC, FILE_BIN] : STATUS = GET_ASCII (.CHARACTER); [FILE_BLK] : STATUS = GET_BLOCK (.CHARACTER); TES; RETURN .STATUS; END; ! End of GET_FILE %SBTTL 'GET_ASCII - Get a character from an ASCII file' ROUTINE GET_ASCII (CHARACTER) = !++ ! FUNCTIONAL DESCRIPTION: ! ! CALLING SEQUENCE: ! ! INPUT PARAMETERS: ! ! None. ! ! IMPLICIT INPUTS: ! ! None. ! ! OUPTUT PARAMETERS: ! ! None. ! ! IMPLICIT OUTPUTS: ! ! None. ! ! COMPLETION CODES: ! ! None. ! ! SIDE EFFECTS: ! ! None. ! !-- BEGIN OWN CC_COUNT, ! Count of the number of CC things to output CC_TYPE; ! Type of carriage control being processed. LOCAL RAT; RAT = .FILE_FAB [FAB$B_RAT] AND ( NOT FAB$M_BLK); RETURN WHILE TRUE DO BEGIN SELECTONE .RAT OF SET [FAB$M_PRN, FAB$M_FTN, FAB$M_CR] : CASE .FILE_FAB [FAB$L_CTX] FROM F_STATE_MIN TO F_STATE_MAX OF SET [F_STATE_PRE] : BEGIN STATUS = GET_BUFFER (); IF NOT .STATUS OR .STATUS EQL KER_EOF THEN EXITLOOP .STATUS; SELECTONE .RAT OF SET [FAB$M_CR] : BEGIN .CHARACTER = CHR_LFD; FILE_FAB [FAB$L_CTX] = F_STATE_DATA; EXITLOOP KER_NORMAL; END; [FAB$M_PRN] : BEGIN CC_COUNT = CH$RCHAR_A (FILE_REC_POINTER); CC_TYPE = CH$RCHAR_A (FILE_REC_POINTER); FILE_REC_COUNT = .FILE_REC_COUNT - 2; IF .CC_COUNT<6, 1> EQL 0 THEN BEGIN IF .CC_COUNT<0, 6> NEQ 0 THEN BEGIN .CHARACTER = CHR_LFD; FILE_FAB [FAB$L_CTX] = F_STATE_PRE1; EXITLOOP KER_NORMAL; END ELSE FILE_FAB [FAB$L_CTX] = F_STATE_DATA; END ELSE BEGIN SELECTONE .CC_COUNT<4, 2> OF SET [%B'00'] : BEGIN .CHARACTER = .CC_COUNT<0, 4>; FILE_FAB [FAB$L_CTX] = F_STATE_DATA; EXITLOOP KER_NORMAL; END; [%B'10'] : BEGIN .CHARACTER = .CC_COUNT<0, 4> + 128; FILE_FAB [FAB$L_CTX] = F_STATE_DATA; EXITLOOP KER_NORMAL; END; [OTHERWISE, %B'11'] : EXITLOOP KER_ILLFILTYP; TES; END; END; [FAB$M_FTN] : BEGIN CC_TYPE = CH$RCHAR_A (FILE_REC_POINTER); FILE_REC_COUNT = .FILE_REC_COUNT - 1; SELECTONE .CC_TYPE OF SET [CHR_NUL] : BEGIN .CHARACTER = CH$RCHAR_A (FILE_REC_POINTER); FILE_REC_COUNT = .FILE_REC_COUNT - 1; END; [%C'$', %C' ', OTHERWISE] : BEGIN .CHARACTER = CHR_LFD; FILE_FAB [FAB$L_CTX] = F_STATE_DATA; END; [%C'0'] : BEGIN .CHARACTER = CHR_LFD; FILE_FAB [FAB$L_CTX] = F_STATE_PRE1; CC_COUNT = 1; END; [%C'1'] : BEGIN .CHARACTER = CHR_FFD; EXITLOOP KER_NORMAL; END; [%C'+'] : BEGIN .CHARACTER = CH$RCHAR_A (FILE_REC_POINTER); FILE_REC_COUNT = .FILE_REC_COUNT - 1; FILE_FAB [FAB$L_CTX] = F_STATE_DATA; END; TES; EXITLOOP KER_NORMAL; END; TES; END; [F_STATE_PRE1] : IF .RAT EQL FAB$M_FTN OR .RAT EQL FAB$M_PRN THEN BEGIN .CHARACTER = CHR_LFD; CC_COUNT = .CC_COUNT - 1; IF .CC_COUNT EQL 0 AND .RAT EQL FAB$M_FTN THEN FILE_FAB [FAB$L_CTX] = F_STATE_DATA; EXITLOOP KER_NORMAL; END ELSE EXITLOOP KER_ILLFILTYP; [F_STATE_DATA] : BEGIN IF .FILE_REC_COUNT EQL 0 THEN FILE_FAB [FAB$L_CTX] = F_STATE_POST ELSE BEGIN .CHARACTER = CH$RCHAR_A (FILE_REC_POINTER); FILE_REC_COUNT = .FILE_REC_COUNT - 1; EXITLOOP KER_NORMAL; END; END; [F_STATE_POST] : BEGIN SELECTONE .RAT OF SET [FAB$M_CR] : BEGIN .CHARACTER = CHR_CRT; FILE_FAB [FAB$L_CTX] = F_STATE_PRE; EXITLOOP KER_NORMAL; END; [FAB$M_FTN] : BEGIN FILE_FAB [FAB$L_CTX] = F_STATE_PRE; IF .CC_TYPE NEQ CHR_NUL AND .CC_TYPE NEQ %C'$' THEN BEGIN .CHARACTER = CHR_CRT; EXITLOOP KER_NORMAL; END; END; [FAB$M_PRN] : BEGIN IF .CC_TYPE<6, 1> EQL 0 THEN BEGIN IF .CC_COUNT<0, 6> NEQ 0 THEN BEGIN .CHARACTER = CHR_LFD; FILE_FAB [FAB$L_CTX] = F_STATE_POST1; EXITLOOP KER_NORMAL; END ELSE FILE_FAB [FAB$L_CTX] = F_STATE_DATA; END ELSE BEGIN SELECTONE .CC_TYPE<4, 2> OF SET [%B'00'] : BEGIN .CHARACTER = .CC_TYPE<0, 4>; FILE_FAB [FAB$L_CTX] = F_STATE_PRE; EXITLOOP KER_NORMAL; END; [%B'10'] : BEGIN .CHARACTER = .CC_TYPE<0, 4> + 128; FILE_FAB [FAB$L_CTX] = F_STATE_PRE; EXITLOOP KER_NORMAL; END; [OTHERWISE, %B'11'] : EXITLOOP KER_ILLFILTYP; TES; END; END; TES; ! End SELECTONE .RAT END; [F_STATE_POST1] : IF .RAT EQL FAB$M_PRN THEN BEGIN .CHARACTER = CHR_LFD; CC_COUNT = .CC_COUNT - 1; IF .CC_COUNT EQL 0 AND .RAT EQL FAB$M_FTN THEN FILE_FAB [FAB$L_CTX] = F_STATE_DATA; IF .CC_COUNT EQL -1 AND .RAT EQL FAB$M_PRN THEN BEGIN .CHARACTER = CHR_CRT; FILE_FAB [FAB$L_CTX] = F_STATE_DATA; END; EXITLOOP KER_NORMAL; END ELSE EXITLOOP KER_ILLFILTYP; TES; ! End of CASE .STATE [OTHERWISE] : BEGIN WHILE .FILE_REC_COUNT LEQ 0 DO BEGIN STATUS = GET_BUFFER (); IF NOT .STATUS OR .STATUS EQL KER_EOF THEN EXITLOOP .STATUS; END; FILE_REC_COUNT = .FILE_REC_COUNT - 1; .CHARACTER = CH$RCHAR_A (FILE_REC_POINTER); EXITLOOP KER_NORMAL; END; TES; ! End of SELECTONE .RAT END; ! End WHILE TRUE DO loop END; ! End of GET_ASCII %SBTTL 'GET_BLOCK - Get a character from a BLOCKed file' ROUTINE GET_BLOCK (CHARACTER) = !++ ! FUNCTIONAL DESCRIPTION: ! ! This routine will return the next byte from a blocked file. This ! routine will use the $READ RMS call to get the next byte from the ! file. This way all RMS header information can be passed to the ! other file system. ! ! CALLING SEQUENCE: ! ! STATUS = GET_BLOCK(CHARACTER); ! ! INPUT PARAMETERS: ! ! CHARACTER - Address to store the character in. ! ! IMPLICIT INPUTS: ! ! REC_POINTER - Pointer into the record. ! REC_ADDRESS - Address of the record. ! REC_COUNT - Count of the number of bytes left in the record. ! ! OUPTUT PARAMETERS: ! ! None. ! ! IMPLICIT OUTPUTS: ! ! None. ! ! COMPLETION CODES: ! ! KER_NORMAL - Got a byte ! KER_EOF - End of file gotten. ! ! SIDE EFFECTS: ! ! None. ! !-- BEGIN WHILE .FILE_REC_COUNT LEQ 0 DO BEGIN STATUS = $READ (RAB = FILE_RAB); IF NOT .STATUS THEN IF .STATUS EQL RMS$_EOF THEN BEGIN EOF_FLAG = TRUE; RETURN KER_EOF; END ELSE BEGIN FILE_ERROR (); EOF_FLAG = TRUE; RETURN KER_RMS32; END; FILE_REC_POINTER = CH$PTR (.REC_ADDRESS); FILE_REC_COUNT = .FILE_RAB [RAB$W_RSZ]; END; FILE_REC_COUNT = .FILE_REC_COUNT - 1; .CHARACTER = CH$RCHAR_A (FILE_REC_POINTER); RETURN KER_NORMAL; END; ! End of GET_BLOCK %SBTTL 'GET_BUFFER - Routine to read a buffer.' ROUTINE GET_BUFFER = !++ ! FUNCTIONAL DESCRIPTION: ! ! This routine will read a buffer from the disk file. It will ! return various status depending if there was an error reading ! the disk file or if the end of file is reached. ! ! CALLING SEQUENCE: ! ! STATUS = GET_BUFFER (); ! ! INPUT PARAMETERS: ! ! None. ! ! IMPLICIT INPUTS: ! ! None. ! ! OUTPUT PARAMETERS: ! ! None. ! ! IMPLICIT OUTPUTS: ! ! FILE_REC_POINTER - Pointer into the record. ! FILE_REC_COUNT - Count of the number of bytes in the record. ! ! COMPLETION CODES: ! ! KER_NORMAL - Got a buffer ! KER_EOF - End of file reached. ! KER_RMS32 - RMS error ! ! SIDE EFFECTS: ! ! None. ! !-- BEGIN STATUS = $GET (RAB = FILE_RAB); IF NOT .STATUS THEN IF .STATUS EQL RMS$_EOF THEN BEGIN EOF_FLAG = TRUE; RETURN KER_EOF; END ELSE BEGIN FILE_ERROR (); EOF_FLAG = TRUE; RETURN KER_RMS32; END; FILE_REC_POINTER = CH$PTR (.REC_ADDRESS); FILE_REC_COUNT = .FILE_RAB [RAB$W_RSZ]; RETURN KER_NORMAL; END; %SBTTL 'PUT_FILE' GLOBAL ROUTINE PUT_FILE (CHARACTER) = !++ ! FUNCTIONAL DESCRIPTION: ! ! This routine will store a character into the record buffer ! that we are building. It will output the buffer to disk ! when the end of line characters are found. ! ! CALLING SEQUENCE: ! ! STATUS = PUT_FILE(Character); ! ! INPUT PARAMETERS: ! ! Character - Address of the character to output in the file. ! ! IMPLICIT INPUTS: ! ! None. ! ! OUTPUT PARAMETERS: ! ! Status - True if no problems writing the character ! False if there were problems writing the character. ! ! IMPLICIT OUTPUTS: ! ! None. ! ! COMPLETION CODES: ! ! None. ! ! SIDE EFFECTS: ! ! None. ! !-- BEGIN SELECTONE .FILE_TYPE OF SET [FILE_ASC] : BEGIN IF ((.CHARACTER AND %O'177') EQL CHR_LFD) OR ((.CHARACTER AND %O'177') EQL CHR_NUL) THEN RETURN KER_NORMAL; IF (.CHARACTER AND %O'177') EQL CHR_CRT THEN RETURN DUMP_BUFFER (); IF .FILE_REC_COUNT EQL .REC_SIZE THEN BEGIN LIB$SIGNAL (KER_REC_TOO_BIG); RETURN KER_REC_TOO_BIG; END; FILE_REC_COUNT = .FILE_REC_COUNT + 1; CH$WCHAR_A (.CHARACTER, FILE_REC_POINTER); END; [FILE_BIN] : BEGIN IF .FILE_REC_COUNT EQL .REC_SIZE THEN BEGIN LIB$SIGNAL (KER_REC_TOO_BIG); RETURN KER_REC_TOO_BIG; END; FILE_REC_COUNT = .FILE_REC_COUNT + 1; CH$WCHAR_A (.CHARACTER, FILE_REC_POINTER); END; [FILE_BLK] : BEGIN IF .FILE_REC_COUNT EQL .REC_SIZE THEN BEGIN FILE_RAB [RAB$W_RSZ] = .FILE_REC_COUNT; STATUS = $WRITE (RAB = FILE_RAB); FILE_REC_COUNT = 0; FILE_REC_POINTER = CH$PTR (.REC_ADDRESS); END; FILE_REC_COUNT = .FILE_REC_COUNT + 1; CH$WCHAR_A (.CHARACTER, FILE_REC_POINTER); END; TES; RETURN KER_NORMAL; END; ! End of PUT_FILE %SBTTL 'FILE_DUMP - Output a record to the disk.' GLOBAL ROUTINE FILE_DUMP = !++ ! FUNCTIONAL DESCRIPTION: ! ! This routine will dump the contents of the current record into the ! user's file. It will return the status of the operation. ! ! CALLING SEQUENCE: ! ! FILE_DUMP (); ! ! INPUT PARAMETERS: ! ! None. ! ! IMPLICIT INPUTS: ! ! FILE_REC_COUNT - Count of the number of characters in the record ! .REC_ADDRESS - Address of the record to output. ! None. ! ! OUTPUT PARAMETERS: ! ! None. ! ! IMPLICIT OUTPUTS: ! ! None. ! ! COMPLETION CODES: ! ! KER_NORMAL - Did ok. ! KER_RMS32 - RMS-32 error. ! ! SIDE EFFECTS: ! ! None. ! !-- BEGIN SELECTONE .FILE_TYPE OF SET [FILE_BIN] : RETURN DUMP_BUFFER (); TES; RETURN KER_NORMAL; END; ! End of FILE_DUMP %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: ! ! KER_NORMAL - Output went ok. ! KER_RMS32 - RMS-32 error. ! ! SIDE EFFECTS: ! ! None. ! !-- BEGIN ! ! First update the record length ! FILE_RAB [RAB$W_RSZ] = .FILE_REC_COUNT; ! ! Now output the record to the file ! STATUS = $PUT (RAB = FILE_RAB); ! ! Update the pointers first ! FILE_REC_COUNT = 0; FILE_REC_POINTER = CH$PTR (.REC_ADDRESS); ! ! Now determine if we failed attempting to write the record ! IF NOT .STATUS THEN BEGIN FILE_ERROR (); RETURN KER_RMS32 END; RETURN KER_NORMAL END; ! End of DUMP_BUFFER %SBTTL 'OPEN_READING' ROUTINE OPEN_READING = !++ ! FUNCTIONAL DESCRIPTION: ! ! This routine will open a file for reading. It will return either ! true or false to the called depending on the success of the ! operation. ! ! CALLING SEQUENCE: ! ! status = OPEN_READING(); ! ! INPUT PARAMETERS: ! ! None. ! ! IMPLICIT INPUTS: ! ! None. ! ! OUTPUT PARAMETERS: ! ! None. ! ! IMPLICIT OUTPUTS: ! ! None. ! ! COMPLETION CODES: ! ! None. ! ! SIDE EFFECTS: ! ! None. ! !-- BEGIN ! ! We now have an expanded file specification that we can use to process ! the file. ! IF .FILE_TYPE NEQ FILE_BLK THEN BEGIN $FAB_INIT (FAB = FILE_FAB, FAC = GET, FOP = NAM, RFM = STM, NAM = FILE_NAM, XAB = FILE_XABFHC); END ELSE BEGIN $FAB_INIT (FAB = FILE_FAB, FAC = (GET, BIO), FOP = NAM, RFM = STM, NAM = FILE_NAM, XAB = FILE_XABFHC); END; $XABFHC_INIT (XAB = FILE_XABFHC); STATUS = $OPEN (FAB = FILE_FAB); IF (.STATUS NEQ RMS$_NORMAL AND .STATUS NEQ RMS$_KFF) THEN BEGIN FILE_ERROR (); RETURN KER_RMS32; END; ! ! Now allocate a buffer for the records ! REC_SIZE = (IF .FILE_TYPE EQL FILE_BLK THEN 512 ELSE .FILE_XABFHC [XAB$W_LRL]); STATUS = LIB$GET_VM (REC_SIZE, REC_ADDRESS); ! ! Initialize the RAB for the $CONNECT RMS call ! $RAB_INIT (RAB = FILE_RAB, FAB = FILE_FAB, RAC = SEQ, ROP = NLK, UBF = .REC_ADDRESS, USZ = .REC_SIZE); STATUS = $CONNECT (RAB = FILE_RAB); IF NOT .STATUS THEN BEGIN FILE_ERROR (); RETURN KER_RMS32; END; FILE_REC_COUNT = -1; FILE_FAB [FAB$L_CTX] = F_STATE_PRE; RETURN KER_NORMAL; END; ! End of OPEN_READING %SBTTL 'FILE_OPEN' GLOBAL ROUTINE FILE_OPEN (FUNCTION) = !++ ! FUNCTIONAL DESCRIPTION: ! ! This routine will open a file for reading or writing depending on ! the function that is passed this routine. It will handle wildcards ! on the read function. ! ! CALLING SEQUENCE: ! ! status = FILE_OPEN(FUNCTION); ! ! INPUT PARAMETERS: ! ! FUNCTION - Function to do. Either FNC_READ or FNC_WRITE. ! ! IMPLICIT INPUTS: ! ! FILE_NAME and FILE_SIZE set up with the file name and the length ! of the name. ! ! OUTPUT PARAMETERS: ! ! None. ! ! IMPLICIT OUTPUTS: ! ! FILE_NAME and FILE_SIZE set up with the file name and the length ! of the name. ! ! COMPLETION CODES: ! ! KER_NORMAL - File opened correctly. ! KER_RMS32 - Problem processing the file. ! ! SIDE EFFECTS: ! ! None. ! !-- BEGIN LOCAL SIZE : WORD, ! Length returned by $FAO TEMP1_DESC : BLOCK [8, BYTE], ! I/O descriptor TEMP2_DESC : BLOCK [8, BYTE]; ! I/O descriptor ! ! Now do the function dependent processing ! FILE_MODE = .FUNCTION; ! ! Select the correct routine depending on if we are reading or writing. ! SELECTONE .FUNCTION OF SET [FNC_READ] : BEGIN ! ! Now set up the FAB with the information it needs. ! $FAB_INIT (FAB = FILE_FAB, FOP = NAM, FNA = FILE_NAME, FNS = .FILE_SIZE, NAM = FILE_NAM, DNA = UPLIT (%ASCII'.;0'), DNS = 3); ! ! Now initialize the NAM block ! $NAM_INIT (NAM = FILE_NAM, RSA = RES_STR, RSS = NAM$C_MAXRSS, ESA = EXP_STR, ESS = NAM$C_MAXRSS); ! ! First parse the file specification. ! STATUS = $PARSE (FAB = FILE_FAB); IF NOT .STATUS THEN BEGIN FILE_ERROR (); RETURN KER_RMS32; END; STATUS = $SEARCH (FAB = FILE_FAB); IF NOT .STATUS THEN BEGIN FILE_ERROR (); RETURN KER_RMS32; END; ! ! We now have an expanded file specification that we can use to process ! the file. ! IF .FILE_TYPE NEQ FILE_BLK THEN BEGIN $FAB_INIT (FAB = FILE_FAB, FAC = GET, FOP = NAM, RFM = STM, NAM = FILE_NAM, XAB = FILE_XABFHC); END ELSE BEGIN $FAB_INIT (FAB = FILE_FAB, FAC = (GET, BIO), FOP = NAM, RFM = STM, NAM = FILE_NAM, XAB = FILE_XABFHC); END; $XABFHC_INIT (XAB = FILE_XABFHC); STATUS = $OPEN (FAB = FILE_FAB); IF (.STATUS NEQ RMS$_NORMAL AND .STATUS NEQ RMS$_KFF) THEN BEGIN FILE_ERROR (); RETURN KER_RMS32; END; ! ! Now allocate a buffer for the records ! REC_SIZE = (IF .FILE_TYPE EQL FILE_BLK THEN 512 ELSE .FILE_XABFHC [XAB$W_LRL]) ; STATUS = LIB$GET_VM (REC_SIZE, REC_ADDRESS); ! ! Initialize the RAB for the $CONNECT RMS call ! $RAB_INIT (RAB = FILE_RAB, FAB = FILE_FAB, RAC = SEQ, ROP = NLK, UBF = .REC_ADDRESS, USZ = .REC_SIZE); STATUS = $CONNECT (RAB = FILE_RAB); IF NOT .STATUS THEN BEGIN FILE_ERROR (); RETURN KER_RMS32; END; FILE_REC_COUNT = -1; END; ! End of [FNC_READ] [FNC_WRITE] : BEGIN SELECTONE .FILE_TYPE OF SET [FILE_ASC] : BEGIN $FAB_INIT (FAB = FILE_FAB, FAC = PUT, FNA = FILE_NAME, FNS = .FILE_SIZE, FOP = (MXV, CBT, SQO, TEF), NAM = FILE_NAM, ORG = SEQ, RFM = VAR, RAT = CR); END; [FILE_BIN] : BEGIN $FAB_INIT (FAB = FILE_FAB, FAC = PUT, FNA = FILE_NAME, FNS = .FILE_SIZE, FOP = (MXV, CBT, SQO, TEF), NAM = FILE_NAM, ORG = SEQ, RFM = VAR); END; [FILE_BLK] : BEGIN $FAB_INIT (FAB = FILE_FAB, FAC = (PUT, BIO), FNA = FILE_NAME, FNS = .FILE_SIZE, FOP = (MXV, CBT, SQO, TEF), NAM = FILE_NAM); END; TES; $NAM_INIT (NAM = FILE_NAM, ESA = EXP_STR, ESS = NAM$C_MAXRSS, RSA = RES_STR, RSS = NAM$C_MAXRSS); ! ! Now allocate a buffer for the records ! REC_SIZE = (IF .FILE_TYPE EQL FILE_BLK THEN 512 ELSE MAX_REC_LENGTH); STATUS = LIB$GET_VM (REC_SIZE, REC_ADDRESS); ! ! Now create the file ! STATUS = $CREATE (FAB = FILE_FAB); IF NOT .STATUS THEN BEGIN FILE_ERROR (); RETURN KER_RMS32; END; $RAB_INIT (RAB = FILE_RAB, FAB = FILE_FAB, RAC = SEQ, RBF = .REC_ADDRESS, ROP = ); STATUS = $CONNECT (RAB = FILE_RAB); IF NOT .STATUS THEN BEGIN FILE_ERROR (); RETURN KER_RMS32; END; FILE_REC_COUNT = 0; FILE_REC_POINTER = CH$PTR (.REC_ADDRESS); END; [OTHERWISE] : RETURN KER_INTERNALERR; TES; ! ! Initialize the output descriptors. ! TEMP1_DESC [DSC$B_CLASS] = DSC$K_CLASS_S; TEMP1_DESC [DSC$B_DTYPE] = DSC$K_DTYPE_T; TEMP1_DESC [DSC$A_POINTER] = .FILE_NAM [NAM$L_NAME]; TEMP1_DESC [DSC$W_LENGTH] = .FILE_NAM [NAM$B_NAME]; TEMP2_DESC [DSC$B_CLASS] = DSC$K_CLASS_S; TEMP2_DESC [DSC$B_DTYPE] = DSC$K_DTYPE_T; TEMP2_DESC [DSC$A_POINTER] = .FILE_NAM [NAM$L_TYPE]; TEMP2_DESC [DSC$W_LENGTH] = .FILE_NAM [NAM$B_TYPE]; FILE_DESC [DSC$W_LENGTH] = MAX_FILE_NAME; CH$FILL (CHR_NUL, MAX_FILE_NAME, CH$PTR(FILE_NAME)); STATUS = $FAO (%ASCID'!AS!AS', SIZE, FILE_DESC, TEMP1_DESC, TEMP2_DESC); IF NOT .STATUS THEN BEGIN LIB$SIGNAL (.STATUS); RETURN .STATUS; END; FILE_SIZE = .SIZE; RETURN KER_NORMAL; END; ! End of FILE_OPEN %SBTTL 'FILE_CLOSE' GLOBAL ROUTINE FILE_CLOSE (ABORT_FLAG) = !++ ! FUNCTIONAL DESCRIPTION: ! ! This routine will close a file that was opened by FILE_OPEN. ! It assumes any data associated with the file is stored in this ! module, since this routine is called by KERMSG. ! ! CALLING SEQUENCE: ! ! FILE_CLOSE(); ! ! INPUT PARAMETERS: ! ! ABORT_FLAG - True if file should not be saved. ! ! IMPLICIT INPUTS: ! ! None. ! ! OUTPUT PARAMETERS: ! ! None. ! ! IMPLICIT OUTPUTS: ! ! None. ! ! COMPLETION CODES: ! ! None. ! ! SIDE EFFECTS: ! ! None. ! !-- BEGIN IF .FILE_MODE EQL FNC_WRITE AND .FILE_REC_COUNT NEQ 0 THEN BEGIN SELECTONE .FILE_TYPE OF SET [FILE_ASC,FILE_BIN]: STATUS = DUMP_BUFFER (); [FILE_BLK] : BEGIN FILE_RAB [RAB$W_RSZ] = .FILE_REC_COUNT; STATUS = $WRITE (RAB = FILE_RAB); IF NOT .STATUS THEN BEGIN FILE_ERROR (); STATUS = KER_RMS32; END ELSE STATUS = KER_NORMAL; END; TES; IF NOT .STATUS THEN RETURN .STATUS; END; STATUS = LIB$FREE_VM (REC_SIZE, REC_ADDRESS); IF .ABORT_FLAG THEN FILE_FAB [FAB$V_DLT] = TRUE; STATUS = $CLOSE (FAB = FILE_FAB); EOF_FLAG = FALSE; IF NOT .STATUS THEN BEGIN FILE_ERROR (); RETURN KER_RMS32; END ELSE RETURN KER_NORMAL; END; ! End of FILE_CLOSE %SBTTL 'NEXT_FILE' GLOBAL ROUTINE NEXT_FILE = !++ ! FUNCTIONAL DESCRIPTION: ! ! This routine will cause the next file to be opened. It will ! call the RMS-32 routine $SEARCH and $OPEN for the file. ! ! CALLING SEQUENCE: ! ! STATUS = NEXT_FILE; ! ! INPUT PARAMETERS: ! ! None. ! ! IMPLICIT INPUTS: ! ! FAB/NAM blocks set up from previous processing. ! ! OUTPUT PARAMETERS: ! ! None. ! ! IMPLICIT OUTPUTS: ! ! FAB/NAM blocks set up for the next file. ! ! COMPLETION CODES: ! ! TRUE - There is a next file. ! KER_RMS32 - No next file. ! ! SIDE EFFECTS: ! ! None. ! !-- BEGIN LOCAL TEMP1_DESC : BLOCK [8, BYTE], ! I/O descriptor TEMP2_DESC : BLOCK [8, BYTE], ! I/O descriptor SIZE : WORD; ! Size of the $FAO string ! ! Now search for the next file that we want to process. ! STATUS = $SEARCH (FAB = FILE_FAB); IF .STATUS EQL RMS$_NMF THEN RETURN KER_NOMORFILES; IF NOT .STATUS THEN BEGIN FILE_ERROR (); RETURN KER_RMS32; END; ! ! Now we have the new file name. All that we have to do is open the file ! for reading now. ! STATUS = OPEN_READING (); IF NOT .STATUS THEN RETURN .STATUS; ! ! Initialize the output descriptors. ! TEMP1_DESC [DSC$B_CLASS] = DSC$K_CLASS_S; TEMP1_DESC [DSC$B_DTYPE] = DSC$K_DTYPE_T; TEMP1_DESC [DSC$A_POINTER] = .FILE_NAM [NAM$L_NAME]; TEMP1_DESC [DSC$W_LENGTH] = .FILE_NAM [NAM$B_NAME]; TEMP2_DESC [DSC$B_CLASS] = DSC$K_CLASS_S; TEMP2_DESC [DSC$B_DTYPE] = DSC$K_DTYPE_T; TEMP2_DESC [DSC$A_POINTER] = .FILE_NAM [NAM$L_TYPE]; TEMP2_DESC [DSC$W_LENGTH] = .FILE_NAM [NAM$B_TYPE]; FILE_DESC [DSC$W_LENGTH] = MAX_FILE_NAME; CH$FILL(CHR_NUL, MAX_FILE_NAME, CH$PTR (FILE_NAME)); STATUS = $FAO (%ASCID'!AS!AS', SIZE, FILE_DESC, TEMP1_DESC, TEMP2_DESC); IF NOT .STATUS THEN BEGIN LIB$SIGNAL (.STATUS); RETURN .STATUS; END; FILE_SIZE = .SIZE; RETURN KER_NORMAL; END; ! End of NEXT_FILE %SBTTL 'FILE_ERROR - Error processing for all RMS errors' ROUTINE FILE_ERROR : NOVALUE = !++ ! FUNCTIONAL DESCRIPTION: ! ! This routine will process all of the RMS-32 error returns. It will ! get the text for the error and then it will issue a KER_ERROR for ! the RMS failure. ! ! CALLING SEQUENCE: ! ! FILE_ERROR(); ! ! INPUT PARAMETERS: ! ! None. ! ! IMPLICIT INPUTS: ! ! STATUS - RMS error status. ! FILE_NAME - File name and extension. ! FILE_SIZE - Size of the thing in FILE_NAME. ! ! OUTPUT PARAMETERS: ! ! None. ! ! IMPLICIT OUTPUTS: ! ! None. ! ! COMPLETION CODES: ! ! None. ! ! SIDE EFFECTS: ! ! None. ! !-- BEGIN LOCAL ERR_LENGTH : WORD, ! Length of the text ERR_DESC : BLOCK [8, BYTE], ERR_BUFFER : VECTOR [CH$ALLOCATION (MAX_MSG)]; ERR_DESC [DSC$A_POINTER] = ERR_BUFFER; ERR_DESC [DSC$W_LENGTH] = MAX_MSG; ERR_DESC [DSC$B_CLASS] = DSC$K_CLASS_S; ERR_DESC [DSC$B_DTYPE] = DSC$K_DTYPE_T; $GETMSG (MSGID = .STATUS, MSGLEN = ERR_LENGTH, BUFADR = ERR_DESC, FLAGS = 0); ERR_DESC [DSC$W_LENGTH] = .ERR_LENGTH; LIB$SIGNAL (KER_RMS32, ERR_DESC, FILE_DESC); END; ! End of FILE_ERROR %SBTTL 'End of KERFIL' END ! End of module ELUDOM