Columbia Kermit

home *** CD-ROM | disk | FTP | other *** search

/ Columbia Kermit / kermit.zip / iclvme2900 / kmt_sp_module < prev next >

Wrap

Text File | 2020-01-01 | 27KB | 735 lines

MODULE KMT_SP_MODULE; @******************************************************************************@ @* *@ @* Mode definitions *@ @* *@ @******************************************************************************@ MODE KMT_DH_DEVICE_DETAILS_S IS STRUCT ( BOOL FILE_OPEN, WORD MAX_INPUT_LENGTH, MAX_OUTPUT_LENGTH, INPUT_PARITY, OUTPUT_PARITY, PAUSE); 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_PP_CONFG_PARAMS_S IS STRUCT ( BYTE MARK, MAXL, TIME, NPAD, PADC, EOL, QCTL, QBIN, CHKT, REPT, 4-BYTE CAPAS); MODE KMT_PP_PACKET_STATISTICS_S IS STRUCT ( INT INPUT_TOTAL, OUTPUT_TOTAL); MODE KMT_TRACE_FLAGS_S IS WORD STRUCT ( BIT PH_TRACING, PP_TRACING, FH_TRACING, DH_TRACING, 28-BIT SPARE); 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); MODE KMT_BUFFER IS (96) BYTE; MODE KMT_STRING IS REF () BYTE; MODE KMT_WORD IS REF () BYTE; ***PAGE @******************************************************************************@ @* *@ @* External procedure references *@ @* *@ @******************************************************************************@ EXT (<PREFIX "ICLCTM">) PROC (RESPONSE @ RESPONSE @ ) CTM_JS_BEGIN; EXT (<PREFIX "ICLCTM">) PROC (RESPONSE @ RESPONSE @ ) CTM_JS_END; EXT (<PREFIX "ICLCTM">) PROC (REF () BYTE, @ PROMPT @ REF () BYTE, @ MESSAGE @ REF LONG INT, @ LENGTH_MESSAGE @ RESPONSE @ RESPONSE @ ) ASK_MESSAGE; EXT (<PREFIX "ICLCTM">) PROC (WORD, @ TYPE @ WORD, @ DESTINATION @ REF () BYTE, @ MESSAGE @ RESPONSE @ RESPONSE @ ) CTM_LOG; EXT (<PREFIX "ICLMACROS">) PROC (REF () REF () BYTE, @ NAMES @ REF () BYTE, @ JOURNAL_LIST @ RESPONSE @ RESPONSE @ ) SET_OPTIONS; EXT PROC (INT, @ TEXT_NUMBER @ REF () KMT_MTM_VALUES @ PARAMS @ ) INT KMT_SP_MTM; ***PAGE @******************************************************************************@ @* *@ @* External data references *@ @* *@ @******************************************************************************@ @ Constants: @ @ ********** @ EXT INT UNSET; EXT INT VME_TERM, @ 0 @ @forms of name standardisation @ VME_STD, @ 1 @ KMT_STD; @ 2 @ ***LINES(4) @ Variables: @ @ ********** @ EXT (<CASCADE>) REF BOOL TRANSLATE_FILENAME; EXT REF INT EXIT_STATE, FILE_OPTION, MAXTRY, RETRY_COUNT, RETRY_TOTAL, TIMEOUT_TOTAL; EXT REF WORD DELAY; EXT REF BOOL ASG_ROUTE, DELAY_TIMER, SAVE_INCOMPLETE_FILE; EXT (<CASCADE>) REF KMT_DH_DEVICE_DETAILS_S KMT_DH_DEVICE_DETAILS; EXT (<CASCADE>) REF KMT_FH_RECORD_DETAILS_S KMT_FH_RECORD_DETAILS; EXT (<CASCADE>) REF KMT_FH_FILE_STATISTICS_S KMT_FH_FILE_STATISTICS; EXT (<CASCADE>) REF KMT_PP_CONFG_PARAMS_S KMT_PP_LOCAL_CONFG_PARAMS; EXT (<CASCADE>) REF KMT_PP_CONFG_PARAMS_S KMT_PP_REMOTE_CONFG_PARAMS; EXT (<CASCADE>) REF KMT_PP_PACKET_STATISTICS_S KMT_PP_PACKET_STATISTICS; EXT (<CASCADE>) REF KMT_TRACE_FLAGS_S KMT_TRACE_FLAGS; ***LINES(4) @ Results: @ @ ******** @ ***PAGE @******************************************************************************@ @* *@ @* Procedure declarations *@ @* *@ @******************************************************************************@ GLOBAL STATIC (<STATUS 5>) PROC KMT_SP_SET_DEFAULTS IS (): @******************************************************************************@ @* *@ @* This procedure is used to set default values for certain global variables. *@ @* *@ @******************************************************************************@ BEGIN EXIT_STATE := UNSET; FILE_OPTION := 1; @ create mode @ DELAY := 30; DELAY_TIMER := FALSE; SAVE_INCOMPLETE_FILE := FALSE; TRANSLATE_FILENAME := TRUE; MAXTRY := 5; RETRY_COUNT := 0; RETRY_TOTAL := 0; TIMEOUT_TOTAL := 0; KMT_TRACE_FLAGS := 0; @ No tracing @ KMT_DH_DEVICE_DETAILS.FILE_OPEN := FALSE; @ No file open initially @ KMT_DH_DEVICE_DETAILS.INPUT_PARITY := 4; @ No parity @ KMT_DH_DEVICE_DETAILS.OUTPUT_PARITY := 4; @ NO parity @ KMT_DH_DEVICE_DETAILS.PAUSE := 0; @ NO pause @ KMT_FH_RECORD_DETAILS.FILE_OPEN := FALSE; @ No file open initially @ KMT_FH_RECORD_DETAILS.TEXT_TYPE := 0; @ EBCDIC text @ KMT_FH_FILE_STATISTICS := (0,0); @ Zero record transfers @ KMT_PP_LOCAL_CONFG_PARAMS := (X"1E", @ MARK - Record Seperator @ 80, @ MAXL @ 0, @ TIME - No timeout @ 0, @ NPAD - No padding @ X"00", @ PADC - Null @ X"0D", @ EOL - Carriage Return @ X"23", @ QCTL - Hash # @ X"26", @ QBIN - Ampersand & @ X"31", @ CHKT - Single check sum @ X"00", @ REPT - Not supported @ X'00'); @ CAPAS - Not supported @ KMT_PP_REMOTE_CONFG_PARAMS := (X"1E", @ MARK - Record Seperator @ 80, @ MAXL @ 0, @ TIME - No timeout @ 0, @ NPAD - No padding @ X"00", @ PADC - Null @ X"0D", @ EOL - Carriage Return @ X"23", @ QCTL - Hash # @ X"26", @ QBIN - Ampersand & @ X"31", @ CHKT - Single check sum @ X"00", @ REPT - Not supported @ X'00'); @ CAPAS - Not supported @ KMT_PP_PACKET_STATISTICS := (0,0); @ Zero packet transfers @ END; @ KMT_SP_SET_DEFAULTS @ ***PAGE GLOBAL STATIC (<STATUS 5>) PROC KMT_SP_CHAR_TO_HEX IS ( REF () BYTE HEX_DIGITS, REF () BYTE HEX_STRING, REF INT HEX_STRING_LENGTH, RESPONSE RESULT): @******************************************************************************@ @* *@ @* This procedure is used to convert a string representing hexadecimal digits *@ @* from character to the hexadecimal notation. *@ @* The area referenced by HEX_DIGITS contains the string representing the *@ @* hexadecimal digits and HEX_STRING references an area to contain the *@ @* hexadecimal string. *@ @* The number of hexadecimal characters returned in HEX_STRING is returned *@ @* in the area referenced by HEX_STRING_LENGTH. *@ @* If a non hexadecimal digit is detected then HEX_STRING_LENGTH is returned *@ @* zero and resultcode KMT_SP_NOT_HEX is returned. *@ @* If the area referenced by HEX_STRING is not large enough to contain the *@ @* hexadecimal string then HEX_STRING_LENGTH is returned containing the size *@ @* required and resultcode KMT_SP_STRING_TOO_BIG is returned *@ @* *@ @******************************************************************************@ BEGIN ***PAGE SIM PROC KMT_SP_HEX IS ( 2-BYTE HEX_DIGITS) BYTE: @******************************************************************************@ @* *@ @* This procedure is used to return a hexadecimal string from the two byte *@ @* hexadecimal representation supplied in HEX_STRING. *@ @* *@ @******************************************************************************@ BEGIN (2) BYTE HEX_DIGITS_COPY := HEX_DIGITS; FOR I TO 1 DO REF BYTE HEX_DIGIT IS HEX_DIGITS_COPY (I); IF (HEX_DIGIT GE "A") AND (HEX_DIGIT LE "F") THEN @ In range "A" to "F" @ HEX_DIGIT := HEX_DIGIT + X"09" FI; HEX_DIGIT := HEX_DIGIT & X"0F"; @ In range X"00" to X"0F" @ REPEAT; (W'PACKS (0, HEX_DIGITS_COPY, 0, NIL)) SCALE -4 END; @ KMT_SP_HEX @ ***PAGE INT KMT_SP_NOT_HEX IS 80050, KMT_SP_STRING_TOO_BIG IS 80051; INT HEX_DIGITS_LENGTH IS LENGTH HEX_DIGITS; RESULT := UNLESS ( () BYTE NON_HEX_BIT_MAP IS (X"FFFFFFFF FFFFFFFF" X"FFFFFFFF FFFFFFFF" X"81FFFFFF FFFFFFFF" X"81FFFFFF FFFF003F"); @ Allow lower and upper case @ CHECK (NON_HEX_BIT_MAP, HEX_DIGITS, 0, NIL) ) THEN @ Non hex digit in string @ HEX_STRING_LENGTH := 0; KMT_SP_NOT_HEX ELSF ( HEX_STRING_LENGTH := (HEX_DIGITS_LENGTH + 1) / 2; HEX_STRING_LENGTH GT LENGTH HEX_STRING ) THEN @ Return string too small @ KMT_SP_STRING_TOO_BIG ELSE @ Convert to hex @ INT HEX_DIGITS_INDEX := IF ((WORD:HEX_DIGITS_LENGTH) & 1) EQ 1 THEN @ Odd number of hex digits @ HEX_STRING(0) := KMT_SP_HEX ( HEX_DIGITS(0)); 1 ELSE 0 FI; FOR I FROM HEX_DIGITS_INDEX UNTIL HEX_DIGITS_INDEX GE HEX_DIGITS_LENGTH DO HEX_STRING (I) := KMT_SP_HEX (HEX_DIGITS(HEX_DIGITS_INDEX SIZE 2)); HEX_DIGITS_INDEX := HEX_DIGITS_INDEX + 2 REPEAT; 0 FI END; @ KMT_SP_CHAR_TO_HEX @ ***PAGE GLOBAL STATIC (<STATUS 5>) PROC KMT_SP_CONVERT_TO_BINARY IS (REF KMT_WORD W) WORD: @ Converts Kermit word or string to a binary number @ IF W REF NIL THEN @ not given @ -1 ELSF (() BYTE BIT_MAP IS X"FFFFFFFF FFFFFFFF" X"FFFFFFFF FFFFFFFF" X"FFFFFFFF FFFFFFFF" X"FFFFFFFF FFFF003F"; CHECK(BIT_MAP,W,0,NIL) ) THEN @ numeric @ I'PACKS(0,W,0,NIL) ELSF LENGTH W < 2 OR W(0) NE "X" THEN @ not hex - invalid @ -1 ELSE (4) BYTE HEX; INT HEX_LEN,RESULT; KMT_SP_CHAR_TO_HEX(W(1::),HEX,HEX_LEN,RESULT); IF RESULT NE 0 OR HEX_LEN < 1 THEN @ invalid hex digits @ -1 ELSE @ VALID HEX NUMBER @ HEX(SIZE HEX_LEN) FI FI ; @ KMT_SP_CONVERT_TO_BINARY @ ***PAGE GLOBAL STATIC (<STATUS 5>) PROC KMT_SP_CONVERT_TO_UPPER_CASE IS ( REF () BYTE BUFFER): @******************************************************************************@ @* *@ @* This procedure is used to convert lowercase EBCDIC alphabetic characters *@ @* to uppercase EBCDIC. *@ @* The characters to be case converted are read from and the case converted *@ @* characters are written to the area referenced by BUFFER. *@ @* *@ @******************************************************************************@ UNLESS (BUFFER IS NIL) OR (LENGTH BUFFER EQ 0) DO (256) BYTE UPPER_CASE_TT IS X"00010203 04050607 08090A0B 0C0D0E0F" X"10111213 14151617 18191A1B 1C1D1E1F" X"20212223 24252627 28292A2B 2C2D2E2F" X"30313233 34353637 38393A3B 3C3D3E3F" X"40414243 44454647 48494A4B 4C4D4E4F" X"50515253 54555657 58595A5B 5C5D5E5F" X"60616263 64656667 68696A6B 6C6D6E6F" X"70717273 74757677 78797A7B 7C7D7E7F" X"80C1C2C3 C4C5C6C7 C8C98A8B 8C8D8E8F" X"90D1D2D3 D4D5D6D7 D8D99A9B 9C9D9E9F" X"A0A1E2E3 E4E5E6E7 E8E9AAAB ACADAEAF" X"B0B1B2B3 B4B5B6B7 B8B9BABB BCBDBEBF" X"C0C1C2C3 C4C5C6C7 C8C9CACB CCCDCECF" X"D0D1D2D3 D4D5D6D7 D8D9DADB DCDDDEDF" X"E0E1E2E3 E4E5E6E7 E8E9EAEB ECEDEEEF" X"F0F1F2F3 F4F5F6F7 F8F9FAFB FCFDFEFF"; TRANSLATE (UPPER_CASE_TT,BUFFER,0,NIL); FI ; @ KMT_SP_CONVERT_TO_UPPERCASE @ ***PAGE GLOBAL STATIC (<STATUS 5>) PROC KMT_SP_ASK_MESSAGE IS ( REF () BYTE PROMPT, REF () BYTE MESSAGE, REF LONG INT LENGTH_MESSAGE, BOOL LOG_PROMPT, RESPONSE RESULT): @******************************************************************************@ @* *@ @* This procedure is used to output a prompt to the users terminal and read a *@ @* reply to the prompt. Logging of the prompt and reply to the journal is *@ @* turned off. *@ @* *@ @******************************************************************************@ BEGIN INT RC_DISCARDED; CTM_JS_BEGIN (RESULT); IF RESULT LE 0 THEN @ Resource block created @ UNLESS LOG_PROMPT DO () BYTE NAME := "NOLASKS"; () REF () BYTE NAMES := DISPLAY(NAME); (0) BYTE ZLR; SET_OPTIONS (NAMES,ZLR,RC_DISCARDED) FI; ASK_MESSAGE (PROMPT,MESSAGE,LENGTH_MESSAGE,RESULT); CTM_JS_END (RC_DISCARDED) @ End resource block @ FI END; @ KMT_SP_ASK_MESSAGE @ ***PAGE GLOBAL STATIC (<STATUS 5>) PROC KMT_SP_LOG_TRACE_MESSAGE IS ( INT TYPE, REF () KMT_MTM_VALUES PARAMS): @******************************************************************************@ @* *@ @* This procedure is used to log a trace message (printed in hex) to the job *@ @* journal. *@ @* TYPE specifies the type of trace message and PARAMS references a list of *@ @* parameters to be used in the expansion of the message. *@ @* *@ @******************************************************************************@ BEGIN INT PARAMS_LENGTH IS IF PARAMS IS NIL THEN 0 ELSE LENGTH PARAMS FI; INT MTM_AREA_LENGTH IS 4 + PARAMS_LENGTH; (MTM_AREA_LENGTH) KMT_MTM_VALUES MTM_AREA; INT MTM_TEXT_NUMBER := TYPE, MTM_REPLY, MTM_MESSAGE_LENGTH; (100) BYTE MTM_MESSAGE; (2) REF () BYTE MTM_RECALL_DATA; MTM_AREA(SIZE 4) := (MTM_MESSAGE AS KMT_MTM_VALUES.RVB_VALUE, MTM_MESSAGE_LENGTH AS KMT_MTM_VALUES.RI_VALUE, MTM_RECALL_DATA AS KMT_MTM_VALUES.RVRVB_VALUE, (L'PARAMS_LENGTH) AS KMT_MTM_VALUES.LI_VALUE); IF PARAMS_LENGTH GT 0 THEN MTM_AREA(4::) := PARAMS FI; WHILE ( INT RC_DISCARDED; MTM_REPLY := KMT_SP_MTM (MTM_TEXT_NUMBER,MTM_AREA); IF MTM_REPLY NE -2 THEN @ Expanded message returned @ REF () BYTE MESSAGE IS IF MTM_REPLY EQ -3 THEN @ Returned in recall data @ MTM_TEXT_NUMBER := 0; MTM_RECALL_DATA(0) ELSE @ Returned in message buffer @ MTM_TEXT_NUMBER := MTM_REPLY; MTM_MESSAGE(SIZE MTM_MESSAGE_LENGTH) FI; CTM_LOG (3, 2, @ Log to journal only @ MESSAGE, RC_DISCARDED) ELSE @ No message data @ MTM_TEXT_NUMBER := 0 FI; MTM_TEXT_NUMBER NE 0 ) DO SKIP REPEAT END; @ KMT_SP_LOG_TRACE_MESSAGE @ ***PAGE GLOBAL STATIC (<STATUS 5>) PROC KMT_SP_STANDARDISE_FILENAME IS (REF KMT_WORD FILENAME, INT STD_FORM): @ standardises filenames (if reqd) according to STD_FORM: @ @ @ @ VME_TERM - terminal name of filename, i.e. part after rightmost dot @ @ VME_STD - remove suffix from filename which should be in Kermit @ @ normal form as sent in packet by remote Kermit @ @ KMT_STD - convert filename to Kermit normal form, i.e. name.type @ @ @ @ in each case any file generation number will be removed and all lower @ @ case alphabetic characters converted to upper case. any non-alphanumeric @ @ characters (except fullstop) will be converted to X @ BEGIN IF TRANSLATE_FILENAME THEN @ filename translation required @ REF () BYTE NAME,REM; NAME := FILENAME; REM := FILENAME; UNTIL SCANUNQ(".",REM,0,REM) @ locate fullstop @ DO INT NAME_LEN IS LENGTH NAME, REM_LEN IS LENGTH REM; REM := IF REM_LEN > 1 THEN REM(1::) @ strip off fullstop @ ELSE REM(SIZE 0) @ "." last character @ FI; NAME := IF NOT SCANUNQ(".",REM,0,NIL) @ if more fullstops @ THEN REM @ continue @ ELSF STD_FORM = VME_TERM THEN REM @ bit after fullstop @ ELSF STD_FORM = VME_STD THEN NAME(SIZE(NAME_LEN-REM_LEN)) @ bit before fullstop@ ELSE NAME @ KMT_STD @ @ i.e. name.type @ FI REPEAT; SCANUNQ("(",NAME,0,REM); @ locate generation number (if present) @ FILENAME := NAME(SIZE (LENGTH NAME - LENGTH REM)); @ remove gen no @ IF LENGTH FILENAME > 0 THEN @ standardise characters @ (256) BYTE STD_CHAR_TT IS X"E7E7E7E7 E7E7E7E7 E7E7E7E7 E7E7E7E7" X"E7E7E7E7 E7E7E7E7 E7E7E7E7 E7E7E7E7" X"E7E7E7E7 E7E7E7E7 E7E7E7E7 E7E7E7E7" X"E7E7E7E7 E7E7E7E7 E7E7E7E7 E7E7E7E7" X"E7E7E7E7 E7E7E7E7 E7E7E74B E7E7E7E7" X"E7E7E7E7 E7E7E7E7 E7E7E7E7 E7E7E7E7" X"E7E7E7E7 E7E7E7E7 E7E7E7E7 E7E7E7E7" X"E7E7E7E7 E7E7E7E7 E7E7E7E7 E7E7E7E7" X"E7C1C2C3 C4C5C6C7 C8C9E7E7 E7E7E7E7" X"E7D1D2D3 D4D5D6D7 D8D9E7E7 E7E7E7E7" X"E7E7E2E3 E4E5E6E7 E8E9E7E7 E7E7E7E7" X"E7E7E7E7 E7E7E7E7 E7E7E7E7 E7E7E7E7" X"E7C1C2C3 C4C5C6C7 C8C9E7E7 E7E7E7E7" X"E7D1D2D3 D4D5D6D7 D8D9E7E7 E7E7E7E7" X"E7E7E2E3 E4E5E6E7 E8E9E7E7 E7E7E7E7" X"F0F1F2F3 F4F5F6F7 F8F9E7E7 E7E7E7E7"; TRANSLATE(STD_CHAR_TT,FILENAME,0,NIL) ELSE @ invalid name @ FILENAME := NIL FI FI END ; @ KMT_SP_STANDARDISE_FILENAME @ ***PAGE GLOBAL STATIC (<STATUS 5>) PROC KMT_SP_GET_WORD IS (REF KMT_STRING S) KMT_WORD: @ extract word (delimited by spaces) from string, advance pointer over word @ BEGIN KMT_STRING S1,S2; IF SCANEQ(" ",S,0,S1) @ skip leading spaces @ THEN NIL @ end of line, return null word @ ELSE SCANUNQ(" ",S1,0,S2); @ find next space (end of word) @ S := S2; @ advance pointer @ S1(SIZE LENGTH S1 - LENGTH S2) @ return word @ FI END ; @ KMT_SP_GET_WORD @ ***PAGE GLOBAL STATIC (<STATUS 5>) PROC KMT_SP_CHECK_VME_CHAR IS (WORD CHAR,WORD IO_FLAG,RESPONSE RESULT): @ check that CHAR is acceptable for VME I/O @ BEGIN IF CHAR = 127 @ ASCII DEL @ THEN RESULT := 0 ELSE ()BYTE X := DISPLAY (CHAR); REF () BYTE B := X; () BYTE CHECK_BITS IS IF ASG_ROUTE AND IO_FLAG = 0 THEN X"FFFF0FFF" @ in via ASG @ ELSF ASG_ROUTE THEN X"A7DFFFFF" @ out via ASG @ ELSF IO_FLAG = 0 THEN X"0183087F" @ in via CSC or NIC @ ELSE X"A7DFFFFF" @ out via CSC or NIC @ FI; RESULT := IF CHECK(CHECK_BITS,B,1,NIL) THEN 85936 ELSE 0 FI FI END ; @ KMT_SP_CHECK_VME_CHAR @ ENDMODULE @ KMT_SP_MODULE @