home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Columbia Kermit
/
kermit.zip
/
iclvme2900
/
kmt_fh_module
< prev
next >
Wrap
Text File
|
2020-01-01
|
30KB
|
858 lines
MODULE KMT_FH_MODULE;
@******************************************************************************@
@* *@
@* Mode definitions *@
@* *@
@******************************************************************************@
MODE
CTM_ACCESS_1 IS GPROC (
REF () CTM_PARAMETER_PAIRS,
RESPONSE);
MODE
CTM_ACCESS_2 IS GPROC (
RESPONSE);
MODE
CTM_PARAMETER_VALUES IS ANY (
INT INT_VALUE,
LONG WORD LONG_WORD_VALUE,
REF INT REF_INT_VALUE,
REF () BYTE STRING_VALUE,
REF CTM_ACCESS_1 REF_ACCESS_1_VALUE,
REF CTM_ACCESS_2 REF_ACCESS_2_VALUE);
MODE
CTM_PARAMETER_PAIRS IS WSTRUCT (
INT TYPE,
CTM_PARAMETER_VALUES VALUE);
MODE
KMT_TRACE_FLAGS_S IS WORD STRUCT (
BIT PH_TRACING,
PP_TRACING,
FH_TRACING,
DH_TRACING,
28-BIT SPARE);
MODE
KMT_FH_FILE_OPTIONS_S IS BYTE STRUCT (
BIT APPEND_CREATE,
APPEND,
REPLACE_CREATE,
REPLACE,
CREATE_APPEND,
CREATE_REPLACE,
CREATE,
READ);
MODE
KMT_FH_RECORD_DETAILS_S IS STRUCT (
BOOL FILE_OPEN,
NEW_RECORD,
END_OF_FILE,
WORD TEXT_TYPE, @ 0 = EBCDIC @
@ 1 = IA5 @
@ 2 = BINARY @
INT MAX_RECORD_LENGTH,
RECORD_LENGTH,
(4098) BYTE RECORD); @ Maximum record size of 4096 @
@ plus 2 bytes for CRLF pair @
@ when constructing output @
@ records @
MODE
KMT_FH_FILE_STATISTICS_S IS STRUCT (
INT INPUT_TOTAL,
INT OUTPUT_TOTAL);
MODE
KMT_FH_FILE_DETAILS_S IS STRUCT (
LONG WORD FILE_CURRENCY,
BOOL NEW_FILE,
KMT_FH_FILE_OPTIONS_S FILE_OPTION,
CTM_ACCESS_1 ACCESS_1,
CTM_ACCESS_2 ACCESS_2);
MODE
KMT_MTM_VALUES IS ANY (
LONG WORD LW_VALUE,
LONG INT LI_VALUE,
REF WORD RW_VALUE,
REF INT RI_VALUE,
REF LONG WORD RLW_VALUE,
REF LONG INT RLI_VALUE,
REF () BYTE RVB_VALUE,
REF () REF () BYTE RVRVB_VALUE);
***PAGE
@******************************************************************************@
@* *@
@* External procedure references *@
@* *@
@******************************************************************************@
EXT (<PREFIX "ICLCTM">)
PROC
(REF LONG WORD, @ FILE_CURRENCY @
REF () BYTE, @ FILE_LOCAL_NAME @
REF () BYTE, @ FULL_FILE_NAME @
RESPONSE @ RESPONSE @
) CTM_ASSIGN_FILE;
EXT (<PREFIX "ICLCTM">)
PROC
(REF LONG WORD, @ NEW_FILE_CURRENCY @
REF () BYTE, @ NEW_FILE_LOCAL_NAME @
LONG WORD, @ FILE_CURRENCY, @
REF () BYTE, @ FILE_LOCAL_NAME @
REF () BYTE, @ FULL_FILE_NAME @
LONG WORD, @ DESCRIPTION_CURRENCY @
REF () BYTE, @ DESCRIPTION_LOCAL_NAME @
REF () BYTE, @ FULL_DESCRIPTION_NAME @
INT, @ INITIAL_SIZE @
INT, @ MAXIMUM_SIZE @
INT, @ OPTION @
RESPONSE @ RESPONSE @
) CTM_GET_FILE;
EXT (<PREFIX "ICLCTM">)
PROC
(LONG WORD, @ FILE_CURRENCY @
REF () BYTE, @ FILE_LOCAL_NAME @
RESPONSE @ RESPONSE @
) CTM_SAVE_FILE;
EXT (<PREFIX "ICLCTM">)
PROC
(LONG WORD, @ FILE_CURRENCY @
REF () BYTE, @ FILE_LOCAL_NAME @
REF () BYTE, @ FULL_FILE_NAME @
REF () WORD, @ PROPERTIES @
RESPONSE @ RESPONSE @
) CTM_READ_DESC;
EXT (<PREFIX "ICLCTM">)
PROC
(RESPONSE @ RESPONSE @
) CTM_SCHEDULE;
EXT (<PREFIX "ICLCTM">)
PROC
(LONG WORD, @ FILE_CURRENCY @
REF () BYTE, @ FILE_LOCAL_NAME @
REF () CTM_PARAMETER_PAIRS, @ PARAMETER_PAIRS @
RESPONSE @ RESPONSE @
) CTM_SELECT_RAM;
EXT (<PREFIX "ICLCTM">)
PROC
(LONG WORD, @ FILE_CURRENCY @
REF () BYTE, @ FILE_LOCAL_CURRENCY @
REF () BYTE, @ FULL_FILE_NAME @
REF INT, @ NAME_LENGTH @
RESPONSE @ RESPONSE @
) CTM_GIVE_NAME;
EXT
PROC
(INT, @ TYPE @
REF () KMT_MTM_VALUES @ PARAMS @
) KMT_SP_LOG_TRACE_MESSAGE;
EXT
PROC
(INT, @ RESULT_CODE @
WORD, @ DESTINATION @
REF () KMT_MTM_VALUES, @ PARAMS @
LONG WORD, @ PE_CONTINGENCY_MESSAGE @
BOOL, @ DUMP @
BOOL @ UNRECOVERABLE @
) KMT_EH_LOG_ERROR;
***PAGE
@******************************************************************************@
@* *@
@* External data references *@
@* *@
@******************************************************************************@
@ Constants: @
@ ********** @
***LINES(4)
@ Variables: @
@ ********** @
EXT (<CASCADE>)
REF KMT_TRACE_FLAGS_S KMT_TRACE_FLAGS;
EXT (<CASCADE>)
REF KMT_FH_RECORD_DETAILS_S KMT_FH_RECORD_DETAILS;
EXT (<CASCADE>)
REF KMT_FH_FILE_STATISTICS_S KMT_FH_FILE_STATISTICS;
***LINES(4)
@ Results: @
@ ******** @
***LINES(4)
***PAGE
@******************************************************************************@
@* *@
@* Static data declarations *@
@* *@
@******************************************************************************@
@ Constants: @
@ ********** @
***LINES(4)
@ Variables: @
@ ********** @
STATIC
KMT_FH_FILE_DETAILS_S KMT_FH_FILE_DETAILS;
***LINES(4)
@ Results: @
@ ******** @
***LINES(4)
***PAGE
@******************************************************************************@
@* *@
@* Procedure declarations *@
@* *@
@******************************************************************************@
GLOBAL
STATIC (<STATUS 5>)
PROC
KMT_FH_OPEN_FILE IS (
REF () BYTE FILE_NAME,
WORD OPTION,
RESPONSE RESULT):
@******************************************************************************@
@* *@
@* This procedure is used to create (if required), assign and open the data *@
@* file specified by FILE_NAME for read or write access depending upon the *@
@* value of OPTION. *@
@* *@
@******************************************************************************@
BEGIN
INT FC_CTM_FILE_ALREADY_EXISTS IS 9113,
FC_CTM_FILE_DOES_NOT_EXIST IS 9114,
FC_CTM_NEW_FILE_WARNING IS -44900;
INT KMT_EH_SOFTWARE_ERROR IS 80101;
REF LONG WORD FILE_CURRENCY IS KMT_FH_FILE_DETAILS.FILE_CURRENCY;
REF KMT_FH_FILE_OPTIONS_S FILE_OPTION IS KMT_FH_FILE_DETAILS.FILE_OPTION;
FILE_OPTION := (WORD: X'01') SCALE OPTION;
IF
(
IF
FILE_OPTION.READ
THEN @ Read @
CTM_ASSIGN_FILE (FILE_CURRENCY,
NIL,
FILE_NAME,
RESULT)
ELSE @ Write @
CTM_GET_FILE (FILE_CURRENCY,
NIL,
0,
NIL,
FILE_NAME,
0,
NIL,
NIL,
-1,
-1,
(IF
(FILE_OPTION & X"0E") NE 0
THEN @ Create, create_replace or @
@ create_append @
0
ELSE @ Replace, replace_create, @
@ append or append_create @
2
FI),
RESULT);
IF
(RESULT EQ 0) AND FILE_OPTION.CREATE
THEN @ Create but file already @
@ exists @
RESULT := FC_CTM_FILE_ALREADY_EXISTS
ELSF
(RESULT EQ FC_CTM_NEW_FILE_WARNING) AND (FILE_OPTION & X"50" NE 0)
THEN @ Replace or append but file @
@ does not exist @
RESULT := FC_CTM_FILE_DOES_NOT_EXIST
FI
FI;
KMT_FH_FILE_DETAILS.NEW_FILE := (RESULT EQ FC_CTM_NEW_FILE_WARNING);
RESULT LE 0
)
AND
(
CTM_SCHEDULE (RESULT);
RESULT LE 0
)
AND
(
() CTM_PARAMETER_PAIRS PARAMETER_PAIRS :=
((7, KMT_FH_RECORD_DETAILS.RECORD
AS CTM_PARAMETER_VALUES.STRING_VALUE),
(9, KMT_FH_RECORD_DETAILS.RECORD_LENGTH
AS CTM_PARAMETER_VALUES.REF_INT_VALUE),
(12, (IF
FILE_OPTION.READ
THEN @ Read @
1 @ Select and read @
ELSE @ Write @
2 @ Select and new write @
FI)
AS CTM_PARAMETER_VALUES.INT_VALUE),
(19, KMT_FH_FILE_DETAILS.ACCESS_2
AS CTM_PARAMETER_VALUES.REF_ACCESS_2_VALUE),
(24, KMT_FH_FILE_DETAILS.ACCESS_1
AS CTM_PARAMETER_VALUES.REF_ACCESS_1_VALUE),
(29, (IF
(FILE_OPTION & X"C8") NE 0
THEN @ Append @
3 @ End of file @
ELSE @ Read, create or replace @
2 @ Beginning of file @
FI)
AS CTM_PARAMETER_VALUES.INT_VALUE)
);
CTM_SELECT_RAM (FILE_CURRENCY,
NIL,
PARAMETER_PAIRS,
RESULT);
RESULT LE 0
)
AND
(
IF
(FILE_OPTION & X"34") NE 0
THEN @ Replacing file, @
@ destroy file contents @
() CTM_PARAMETER_PAIRS PARAMETER_PAIRS :=
DISPLAY((0, 11 @ Extended destroy @
AS CTM_PARAMETER_VALUES.INT_VALUE)
);
KMT_FH_FILE_DETAILS.ACCESS_1 (PARAMETER_PAIRS,
RESULT)
FI;
RESULT LE 0
)
THEN
WORD R_LEN IS LENGTH KMT_FH_RECORD_DETAILS.RECORD - 2;
@ Allows for CRLF end of @
@ record terminator @
() WORD PROPERTIES := (104, @ Maximum record size @
0,
0);
KMT_FH_RECORD_DETAILS.MAX_RECORD_LENGTH := IF
(
CTM_READ_DESC (
FILE_CURRENCY,
NIL,
NIL,
PROPERTIES,
RESULT);
RESULT EQ 0
)
AND
PROPERTIES(1) LT R_LEN
THEN
PROPERTIES(1)
ELSE
R_LEN
FI
FI;
IF
RESULT LE 0
THEN @ File opened successfully @
KMT_FH_RECORD_DETAILS.FILE_OPEN := TRUE;
KMT_FH_RECORD_DETAILS.NEW_RECORD := TRUE;
KMT_FH_RECORD_DETAILS.END_OF_FILE := FALSE;
KMT_FH_FILE_STATISTICS := (0,0);
RESULT := 0 @ Ignore warnings @
ELSE (<RARELY>) @ Open error @
(
() BYTE PROC_NAME := "KMT_FH_OPEN_FILE";
() KMT_MTM_VALUES PARAMS := DISPLAY(PROC_NAME
AS KMT_MTM_VALUES.RVB_VALUE);
KMT_FH_RECORD_DETAILS.FILE_OPEN := FALSE;
KMT_EH_LOG_ERROR (RESULT,
2,
PARAMS,
0,
FALSE,
FALSE);
RESULT := KMT_EH_SOFTWARE_ERROR
)
FI
END; @ KMT_FH_OPEN_FILE @
***PAGE
GLOBAL
STATIC (<STATUS 5>)
PROC
KMT_FH_CLOSE_FILE IS (
RESPONSE RESULT):
@******************************************************************************@
@* *@
@* This procedure is used to close the file previously opened by the *@
@* KMT_FH_OPEN_FILE. *@
@* *@
@******************************************************************************@
BEGIN
INT KMT_EH_SOFTWARE_ERROR IS 80101;
REF BOOL FILE_OPEN IS KMT_FH_RECORD_DETAILS.FILE_OPEN;
RESULT := 0;
IF
FILE_OPEN
THEN @ File open, close it @
INT RC;
() CTM_PARAMETER_PAIRS PARAMETER_PAIRS :=
DISPLAY((0, 12 @ Deselect RAM @
AS CTM_PARAMETER_VALUES.INT_VALUE)
);
@ When receiving a binary @
@ file, must output last @
@ record to file @
IF
KMT_FH_FILE_DETAILS.FILE_OPTION.READ
OR
KMT_FH_RECORD_DETAILS.TEXT_TYPE NE 2
OR
KMT_FH_RECORD_DETAILS.NEW_RECORD
THEN @ File open for reading, not @
@ a binary file or @
RC := 0 @ no record to output @
ELSE @ Flush remaining buffer @
KMT_FH_WRITE (RC)
FI;
IF
(
KMT_FH_FILE_DETAILS.ACCESS_1 (PARAMETER_PAIRS,
RESULT);
RESULT GT 0
)
THEN (<RARELY>) @ Close error @
(
() BYTE PROC_NAME := "KMT_FH_CLOSE_FILE";
() KMT_MTM_VALUES PARAMS := DISPLAY(PROC_NAME
AS KMT_MTM_VALUES.RVB_VALUE);
KMT_EH_LOG_ERROR (RESULT,
2,
PARAMS,
0,
FALSE,
FALSE);
RESULT := KMT_EH_SOFTWARE_ERROR
)
ELSE
RESULT := RC
FI;
FILE_OPEN := FALSE
FI
END; @ KMT_FH_CLOSE_FILE @
***PAGE
GLOBAL
STATIC (<STATUS 5>)
PROC
KMT_FH_READ IS (
RESPONSE RESULT):
@******************************************************************************@
@* *@
@* This procedure is used to read a record from the file previously opened *@
@* (for read access) by the procedure KMT_FH_OPEN_FILE. *@
@* The record and length are returned in the areas *@
@* KMT_FH_RECORD_DETAILS.RECORD and KMT_FH_RECORD.DETAILS.RECORD_LENGTH *@
@* respectively. *@
@* *@
@******************************************************************************@
BEGIN
INT DML_READ_PSEUDO_NODE IS 9034;
INT KMT_FH_RECORD_IN_MSG IS 200,
KMT_EH_SOFTWARE_ERROR IS 80101,
KMT_FH_RECORD_TOO_BIG IS 80200;
REF INT RECORD_LENGTH IS KMT_FH_RECORD_DETAILS.RECORD_LENGTH;
REF () BYTE RECORD IS KMT_FH_RECORD_DETAILS.RECORD;
IF
(
KMT_FH_FILE_DETAILS.ACCESS_2 (RESULT);
RESULT LE 0
)
THEN @ Read successful @
REF INT MAX_RECORD_LENGTH IS KMT_FH_RECORD_DETAILS.MAX_RECORD_LENGTH;
BOOL TRACING IS KMT_TRACE_FLAGS.FH_TRACING;
REF INT STATISTICS IS KMT_FH_FILE_STATISTICS.INPUT_TOTAL;
STATISTICS := STATISTICS + 1;
IF
RECORD_LENGTH GT MAX_RECORD_LENGTH
THEN (<RARELY>) @ Record exceeds buffer size @
(
() KMT_MTM_VALUES PARAMS := (RECORD_LENGTH
AS KMT_MTM_VALUES.RI_VALUE,
MAX_RECORD_LENGTH
AS KMT_MTM_VALUES.RI_VALUE);
RESULT := KMT_FH_RECORD_TOO_BIG;
KMT_EH_LOG_ERROR (RESULT,
2,
PARAMS,
0,
FALSE,
FALSE);
RECORD_LENGTH := MAX_RECORD_LENGTH
)
ELSE @ Ignore warnings @
RESULT := 0
FI;
IF
TRACING
THEN (<RARELY>)
(
() KMT_MTM_VALUES PARAMS := DISPLAY(RECORD(SIZE RECORD_LENGTH)
AS KMT_MTM_VALUES.RVB_VALUE);
KMT_SP_LOG_TRACE_MESSAGE (KMT_FH_RECORD_IN_MSG,
PARAMS)
)
FI
ELSF
(
RECORD_LENGTH := 0;
RESULT EQ DML_READ_PSEUDO_NODE
)
THEN @ End of file reached @
SKIP
ELSE (<RARELY>) @ Read error @
(
() BYTE PROC_NAME := "KMT_FH_READ";
() BYTE ERROR_TEXT := " WHILST READING FROM FILE";
() KMT_MTM_VALUES PARAMS := (PROC_NAME
AS KMT_MTM_VALUES.RVB_VALUE,
ERROR_TEXT
AS KMT_MTM_VALUES.RVB_VALUE);
KMT_EH_LOG_ERROR (RESULT,
2,
PARAMS,
0,
FALSE,
FALSE);
RESULT := KMT_EH_SOFTWARE_ERROR
)
FI
END; @ KMT_FH_READ @
***PAGE
GLOBAL
STATIC (<STATUS 5>)
PROC
KMT_FH_WRITE IS (
RESPONSE RESULT):
@******************************************************************************@
@* *@
@* This procedure is used to write a record to the file previously opened *@
@* (for write access) by the procedure KMT_FH_OPEN_FILE. *@
@* The record to be output and length are contained in the areas *@
@* KMT_FH_RECORD_DETAILS.RECORD and KMT_FH_RECORD_DETAILS.RECORD_LENGTH *@
@* respectively. *@
@* *@
@******************************************************************************@
BEGIN
INT KMT_FH_RECORD_OUT_MSG IS 201,
KMT_EH_SOFTWARE_ERROR IS 80101;
IF
(
KMT_FH_FILE_DETAILS.ACCESS_2 (RESULT);
RESULT LE 0
)
THEN @ Write successful @
BOOL TRACING IS KMT_TRACE_FLAGS.FH_TRACING;
REF INT STATISTICS IS KMT_FH_FILE_STATISTICS.OUTPUT_TOTAL;
STATISTICS := STATISTICS + 1;
IF
TRACING
THEN (<RARELY>)
(
() KMT_MTM_VALUES PARAMS := DISPLAY(
KMT_FH_RECORD_DETAILS.RECORD(SIZE
KMT_FH_RECORD_DETAILS.RECORD_LENGTH)
AS KMT_MTM_VALUES.RVB_VALUE);
KMT_SP_LOG_TRACE_MESSAGE (KMT_FH_RECORD_OUT_MSG,
PARAMS)
)
FI;
RESULT := 0 @ Ignore warnings @
ELSE (<RARELY>) @ Write error @
(
() BYTE PROC_NAME := "KMT_FH_WRITE";
() BYTE ERROR_TEXT := " WHILST WRITING TO FILE";
() KMT_MTM_VALUES PARAMS := (PROC_NAME
AS KMT_MTM_VALUES.RVB_VALUE,
ERROR_TEXT
AS KMT_MTM_VALUES.RVB_VALUE);
KMT_EH_LOG_ERROR (RESULT,
2,
PARAMS,
0,
FALSE,
FALSE);
RESULT := KMT_EH_SOFTWARE_ERROR
)
FI
END; @ KMT_FH_WRITE @
***PAGE
GLOBAL
STATIC (<STATUS 5>)
PROC
KMT_FH_SAVE_FILE IS (
RESPONSE RESULT):
@******************************************************************************@
@* *@
@* This procedure is used to save the file previously opened by the procedure *@
@* KMT_FH_OPEN_FILE. *@
@* *@
@******************************************************************************@
BEGIN
INT KMT_EH_SOFTWARE_ERROR IS 80101;
IF
KMT_FH_FILE_DETAILS.NEW_FILE
AND
(
CTM_SAVE_FILE (KMT_FH_FILE_DETAILS.FILE_CURRENCY,
NIL,
RESULT);
RESULT GT 0
)
THEN (<RARELY>) @ Save error @
(
() BYTE PROC_NAME := "KMT_FH_SAVE_FILE";
() KMT_MTM_VALUES PARAMS := DISPLAY(PROC_NAME
AS KMT_MTM_VALUES.RVB_VALUE);
KMT_EH_LOG_ERROR (RESULT,
2,
PARAMS,
0,
FALSE,
FALSE);
RESULT := KMT_EH_SOFTWARE_ERROR
)
ELSE @ Ignore warnings @
RESULT := 0
FI
END; @ KMT_FH_SAVE_FILE @
***PAGE
GLOBAL
STATIC (<STATUS 5>)
PROC
KMT_FH_GIVE_NAME IS (
REF () BYTE NAME,
REF INT NAME_LENGTH,
BOOL FULL_NAME,
RESPONSE RESULT):
@******************************************************************************@
@* *@
@* This procedure is used to obtain either the full file name or the terminal *@
@* file name of the file previously opened by KMT_FH_OPEN_FILE. *@
@* The name of the file and length are returned in the areas referenced by *@
@* NAME and NAME_LENGTH respectively. *@
@* If FULL_NAME is set TRUE then the full file name will be returned, *@
@* otherwise the terminal file name will be returned. *@
@* If the area referenced by NAME is too small to contain the file name then *@
@* the file name will be truncated and resultcode FC_CTM_BUFFER_TOO_SHORT *@
@* returned. *@
@* *@
@******************************************************************************@
BEGIN
INT KMT_EH_SOFTWARE_ERROR IS 80101;
IF
(
CTM_GIVE_NAME (KMT_FH_FILE_DETAILS.FILE_CURRENCY,
NIL,
NAME,
NAME_LENGTH,
RESULT);
RESULT GT 0
)
THEN (<RARELY>) @ Error @
(
() BYTE PROC_NAME := "KMT_FH_GIVE_NAME";
() KMT_MTM_VALUES PARAMS := DISPLAY(PROC_NAME
AS KMT_MTM_VALUES.RVB_VALUE);
KMT_EH_LOG_ERROR (RESULT,
2,
PARAMS,
0,
FALSE,
FALSE);
RESULT := KMT_EH_SOFTWARE_ERROR
)
ELSF
FULL_NAME
THEN @ Full file name required @
@ Exit @
SKIP
ELSF
NAME_LENGTH EQ 0
THEN @ No file name returned, exit @
SKIP
ELSE @ Terminal file name required @
() BYTE NAME_COPY := NAME(SIZE NAME_LENGTH);
REF () BYTE TERMINAL_NAME,
REM;
TERMINAL_NAME := NAME_COPY;
REM := TERMINAL_NAME;
UNTIL @ Search for part of name @
SCANUNQ (".", @ after last dot @
REM,
0,
REM)
DO
REM := REM(1::);
TERMINAL_NAME := REM
REPEAT;
SCANUNQ ("(", @ Remove generation number @
TERMINAL_NAME,
0,
REM);
NAME_LENGTH := LENGTH TERMINAL_NAME - LENGTH REM;
NAME(SIZE NAME_LENGTH) := TERMINAL_NAME(SIZE NAME_LENGTH);
RESULT := 0
FI;
END; @ KMT_FH_GIVE_NAME @
ENDMODULE @ KMT_FH_MODULE @
