Columbia Kermit

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

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

Wrap

Text File | 2020-01-01 | 47KB | 1,375 lines

MODULE KMT_DH_MODULE; @******************************************************************************@ @* *@ @* Mode definitions *@ @* *@ @******************************************************************************@ MODE PFI_REPORTS IS LONG WORD STRUCT ( 4-BIT ALWAYS_ZERO, 12-BIT USER_FILE_IDENT, TRANSFER_IDENTIFIER, 4-BIT REASON, BYTE QUALIFIER_1, QUALIFIER_2, 2-BYTE CHARACTER_OUTPUT); MODE PFI_FLAGS_1S IS BYTE STRUCT ( BIT MEDIUM_LOW, DATA_LOST, FORMAT_DISTURBED, PERMANENTLY_UNAVAILABLE, TEMPORARILY_UNAVAILABLE, NOT_IMPLEMENTED, GENERAL_FILE_FREEZE, CHARACTER_OUTPUT_VALID); MODE PFI_FLAGS_2S IS BYTE STRUCT ( BIT PROPERTIES_LOST, LONG_LINE, ILLEGAL_DATA, FILE_TIMEOUT, 4-BIT SPARE); MODE PFI_INPUT_FLAGS IS 2-BYTE STRUCT ( BIT QUALIFIED, 15-BIT SPARE); MODE PFI_INPUT_RETURNS IS WORD STRUCT ( PFI_INPUT_FLAGS INPUT_FLAGS, 2-BYTE DATA_LENGTH); MODE PFI_QUEUE_CONTROLS IS WORD STRUCT ( BIT BREAK_IN, DATA_LOST, FORMAT_DISTURBED, BREAK_IN_ACK, GENERAL_FILE_FREEZE, RESET, 26-BIT RESERVED); MODE PFI_OUTPUT_CONTROLS IS WORD STRUCT ( BIT EXPIDITED_DATA, REPORT_NORMAL_TERMINATION, PROMPT, CANCEL_OUTSTANDING_PROMPT, OVERRIDE_MY_READ_INTEREST, SPARE_2, QUALIFIED, SEQUENCE, BYTE COMMAND, 2-BYTE SPARE5); MODE PFI_FILE_FLAGS IS WORD STRUCT ( BIT FORMAT_SENSITIVE, ACTION_KEY_IS_DATA, AUTOPAGING, AUTOMATIC_NEW_LINE, BADGE_REQUIRED, PAUSING_REQUIRED, INHIBIT_SPACE_TRUNCATION, INHIBIT_SPACE_COMPRESSION, FE_AT_START_OF_RECORD, REJECT_ILLEGAL_DATA, ALLOW_COMPRESSION, 21-BIT RESERVED); MODE PFI_PARAMETER_VALUES IS ANY ( INT INT_VALUE, PFI_FILE_FLAGS FILE_FLAGS, REF REF () BYTE RRRB_VALUE, REF () BYTE STRING_VALUE); MODE PFI_PARAMETER_PAIRS IS STRUCT ( WORD TYPE, PFI_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_DH_DEVICE_DETAILS_S IS STRUCT ( BOOL FILE_OPEN, WORD MAX_INPUT_LENGTH, MAX_OUTPUT_LENGTH, INPUT_PARITY, OUTPUT_PARITY, PAUSE); MODE KMT_DH_FILE_DETAILS_S IS STRUCT ( LONG INT FILE_CURRENCY, WORD PFM_CURRENCY, CONNECTION_CURRENCY, TIMER_CHANNEL, BOOL READ_INTEREST, (2) WORD EVENT_LIST, BOOL LONG_SUSPEND); MODE KMT_PP_CONFG_PARAMS_S IS STRUCT ( BYTE MARK, MAXL, TIME, NPAD, PADC, EOL, QCTL, QBIN, CHKT, REPT, 4-BYTE CAPAS); 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 (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 (WORD, @ TIME_INTERVAL @ RESPONSE @ RESPONSE @ ) CTM_WAIT_TIME; EXT (<PREFIX "ICLCTM">) PROC (REF () BYTE, @ NAME @ REF LONG INT, @ LNAME @ REF () BYTE, @ ACCESS @ REF () BYTE, @ LEVEL @ REF () BYTE, @ LOCK @ REF () BYTE, @ REUSE @ LONG INT, @ STARTSECT @ LONG INT, @ ENDSECT @ LONG INT, @ LOAD @ REF () REF () BYTE, @ DNAMES @ RESPONSE @ RESPONSE @ ) ASSIGN_FILE; EXT (<PREFIX "ICLCTM">) PROC (INT, @ EVENT_NODE_CURRENCY @ BYTE, @ ACCESS @ BYTE, @ SHARABILITY @ REF WORD, @ EVENT_CURRENCY @ LONG WORD, @ INTERRUPT_PROC @ WORD, @ SPARE @ RESPONSE @ RESPONSE @ ) CONNECT_EVENT; EXT (<PREFIX "ICLCTM">) PROC (WORD, @ EVENT_CURRENCY @ LONG WORD, @ MESSAGE @ INT, @ REPLY @ RESPONSE @ RESPONSE @ ) READ_EVENT; EXT (<PREFIX "ICLCTM">) PROC (LONG WORD, @ FILE_CURRENCY @ REF WORD, @ PFM_CURRENCY @ REF WORD, @ CONNECTION_CURRENCY @ REF () BYTE, @ DETAILS_SUPPLIED @ REF () BYTE, @ DETAILS_REQUIRED @ REF () BYTE, @ DETAILS_RETURNED @ RESPONSE @ RESPONSE @ ) BI_CONNECT_FILE; EXT (<PREFIX "ICLCTM">) PROC (WORD, @ CONNECTION_CURRENCY @ REF () BYTE, @ DETAILS_SUPPLIED @ REF () BYTE, @ DETAILS_REQUIRED @ REF () BYTE, @ DETAILS_RETURNED @ RESPONSE @ RESPONSE @ ) BI_MODIFY_CONNECTION; EXT (<PREFIX "ICLCTM">) PROC (REF () WORD, @ EVENT_LIST @ REF WORD, @ EVENT_CURRENCY @ REF LONG WORD, @ MESSAGE @ BOOL, @ LONG_SUSPEND @ RESPONSE @ RESPONSE @ ) WAIT_FOR_EVENTS; EXT (<PREFIX "ICLCTM">) PROC (WORD, @ EVENT_CURRENCY @ REF WORD, @ TIMER_CHANNEL @ RESPONSE @ RESPONSE @ ) CREATE_TIMER_CHANNEL; EXT (<PREFIX "ICLCTM">) PROC (WORD, @ TIMER_CHANNEL @ LONG WORD, @ MESSAGE @ LONG INT, @ TIME @ BOOL, @ REAL_TIME @ BOOL, @ PERIODIC @ RESPONSE) @ RESPONSE @ ESTABLISH_TIMER_NOTIFICATION; EXT (<PREFIX "ICLCTM">) PROC (WORD, @ TIMER_CHANNEL @ RESPONSE @ RESPONSE @ ) CANCEL_TIMER_NOTIFICATION; EXT (<PREFIX "ICLCTM">) PROC (WORD, @ PFM_CURRENCY @ WORD, @ START_OF_INPUT @ REF () BYTE, @ BUFFER @ REF PFI_INPUT_RETURNS, @ INPUT_RETURN @ RESPONSE @ RESPONSE @ ) DH_INPUT; EXT (<PREFIX "ICLCTM">) PROC (WORD, @ PFM_CURRENCY @ WORD, @ TRANSFER_IDENTIFIER @ REF () BYTE, @ OUTPUT_DATA @ PFI_OUTPUT_CONTROLS, @ CONTROL @ RESPONSE @ RESPONSE @ ) DH_OUTPUT; EXT (<PREFIX "ICLCTM">) PROC (WORD, @ PFM_CURRENCY @ REF () PFI_PARAMETER_PAIRS, @ PARAMS @ RESPONSE @ RESPONSE @ ) DH_DEFINE_FILE_PROPERTIES; EXT (<PREFIX "ICLCTM">) PROC (WORD, @ PFM_CURRENCY @ WORD, @ QUEUE_ACTION @ PFI_QUEUE_CONTROLS, @ CONTROL @ REF () BYTE, @ ADDITIONAL_DATA @ RESPONSE @ RESPONSE @ ) DH_DO_QUEUE_ACTION; EXT (<PREFIX "ICLCTM">) PROC (WORD, @ PFM_CURRENCY @ REF () BYTE, @ DETAILS_REQUIRED @ REF () BYTE, @ DETAILS_AREA @ REF WORD, @ DETAILS_LENGTH_AREA @ RESPONSE @ RESPONSE @ ) DH_GIVE_FILE_DETAILS; 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_DH_DEVICE_DETAILS_S KMT_DH_DEVICE_DETAILS; EXT (<CASCADE>) REF KMT_PP_CONFG_PARAMS_S KMT_PP_REMOTE_CONFG_PARAMS; EXT (<CASCADE>) REF BOOL DELAY_TIMER; EXT (<CASCADE>) REF WORD DELAY; ***LINES(4) @ Results: @ @ ******** @ ***LINES(4) ***PAGE @******************************************************************************@ @* *@ @* Static data declarations *@ @* *@ @******************************************************************************@ @ Constants: @ @ ********** @ ***LINES(4) @ Variables: @ @ ********** @ STATIC KMT_DH_FILE_DETAILS_S KMT_DH_FILE_DETAILS; ***PAGE @******************************************************************************@ @* *@ @* Procedure declarations *@ @* *@ @******************************************************************************@ STATIC PROC KMT_DH_PROCESS_RESPONSE IS ( INT RESULTCODE, BOOL PROMPT, REF BOOL RETRY, RESPONSE RESULT): @******************************************************************************@ @* *@ @* This procedure is used to process resultcodes returned from COSMAN and to *@ @* handle CDH events. *@ @* RETRY is set TRUE if a recoverable I/O error occurs indicating that the *@ @* I/O operation should be repeated. *@ @* PROMPT should be set TRUE if this is an output request and read interest *@ @* is required. *@ @* *@ @******************************************************************************@ BEGIN INT PFI_REQUEST_ACCEPTED IS -31008, PFI_FILE_FROZEN IS -38982, PFI_DELAYED_TRANSFER IS -38983, PFI_FILE_UNAVAILABLE IS 30978, PFI_OVERLOAD IS 37560, PFI_TEMPORARILY_UNAVAILABLE IS 37561, PFI_TIMED_OUT IS 39854; INT KMT_DH_EVENT_MSG IS 152, KMT_DH_UNEXPECTED_BREAKIN IS 80150, KMT_DH_UNEXPECTED_EVENT IS 80151, KMT_DH_INPUT_AVAILABLE IS -80152, KMT_DH_QUEUE_EMPTY IS -80153; REF BOOL READ_INTEREST IS KMT_DH_FILE_DETAILS.READ_INTEREST; BOOL TRACING IS KMT_TRACE_FLAGS.DH_TRACING; UNLESS READ_INTEREST OR RESULTCODE EQ PFI_REQUEST_ACCEPTED OR RESULTCODE EQ PFI_FILE_FROZEN OR RESULTCODE EQ PFI_DELAYED_TRANSFER OR RESULTCODE EQ PFI_OVERLOAD OR RESULTCODE EQ PFI_TEMPORARILY_UNAVAILABLE THEN @ Unrecoverable I/O error or @ @ REPORT NORMAL TERMINATION @ @ not set @ READ_INTEREST := FALSE; RESULT := RESULTCODE ELSE REF () WORD EVENT_LIST IS KMT_DH_FILE_DETAILS.EVENT_LIST; BOOL LONG_SUSPEND IS KMT_DH_FILE_DETAILS.LONG_SUSPEND; PFI_REPORTS EVENT_MESSAGE; REF PFI_FLAGS_1S QUALIFIER_1 IS EVENT_MESSAGE.QUALIFIER_1; REF PFI_FLAGS_2S QUALIFIER_2 IS EVENT_MESSAGE.QUALIFIER_2; REF WORD PFM_CURRENCY IS KMT_DH_FILE_DETAILS.PFM_CURRENCY; READ_INTEREST := FALSE; RESULT := 0; WHILE @ Process CDH event @ ( INT RC_DISCARDED; WORD EVENT_CURRENCY; BOOL SUSPEND := FALSE; RETRY := FALSE; WAIT_FOR_EVENTS (EVENT_LIST(SIZE 1), EVENT_CURRENCY, EVENT_MESSAGE, LONG_SUSPEND, RC_DISCARDED); IF TRACING THEN (<RARELY>) ( () KMT_MTM_VALUES PARAMS := DISPLAY(EVENT_MESSAGE AS KMT_MTM_VALUES.RLW_VALUE); KMT_SP_LOG_TRACE_MESSAGE (KMT_DH_EVENT_MSG, PARAMS) ) FI; IF QUALIFIER_1.DATA_LOST THEN DH_DO_QUEUE_ACTION (PFM_CURRENCY, 0, @ Unfreeze @ X'40000000', NIL, RC_DISCARDED); RETRY := TRUE FI; IF QUALIFIER_1.FORMAT_DISTURBED THEN DH_DO_QUEUE_ACTION (PFM_CURRENCY, 0, @ Unfreeze @ X'20000000', NIL, RC_DISCARDED); RETRY := TRUE FI; IF QUALIFIER_1.PERMANENTLY_UNAVAILABLE THEN RESULT := PFI_FILE_UNAVAILABLE FI; IF QUALIFIER_1.TEMPORARILY_UNAVAILABLE THEN SUSPEND := TRUE FI; IF QUALIFIER_1.GENERAL_FILE_FREEZE THEN DH_DO_QUEUE_ACTION (PFM_CURRENCY, 0, @ Unfreeze @ X'08000000', NIL, RC_DISCARDED); RETRY := TRUE FI; IF QUALIFIER_2.FILE_TIMEOUT THEN RESULT := PFI_TIMED_OUT FI; UNLESS RETRY OR RESULT NE 0 THEN CASE EVENT_MESSAGE.REASON THEN @ 0 - PFI_NORMAL_TERM @ READ_INTEREST := PROMPT ELSE @ 1 - PFI_ABNORMAL_TERM @ RETRY := TRUE ELSE @ 2 - PFI_ATTENTION @ SUSPEND := TRUE ELSE @ 3 - PFI_FILE_AVAILABLE @ RETRY := (RESULTCODE NE PFI_DELAYED_TRANSFER); SUSPEND := NOT(RETRY) ELSE @ 4 - PFI_INPUT_AVAILABLE @ RESULT := KMT_DH_INPUT_AVAILABLE ELSE (<RARELY>) @ 5 - PFI_ACTION_KEY @ ( RESULT := KMT_DH_UNEXPECTED_BREAKIN; KMT_EH_LOG_ERROR (RESULT, 2, NIL, 0, TRUE, @ Produce UCG dump @ FALSE) @ Recoverable @ ) ELSE @ 6 - PFI_PROMPT_CANCELLED @ RETRY := TRUE ELSE @ 7 - PFI_QUEUE_EMPTY @ RETRY := FALSE; RESULT := KMT_DH_QUEUE_EMPTY DEFAULT (<RARELY>) @ Unexpected event from CDH @ ( RESULT := KMT_DH_UNEXPECTED_EVENT; KMT_EH_LOG_ERROR (RESULT, 2, NIL, 0, TRUE, @ Produce UCG dump @ FALSE) @ Recoverable @ ) ESAC FI; SUSPEND AND RESULT EQ 0 ) DO SKIP REPEAT FI END; @ KMT_DH_PROCESS_RESPONSE @ ***PAGE GLOBAL STATIC (<STATUS 5>) PROC KMT_DH_OPEN_FILE IS ( RESPONSE RESULT): @******************************************************************************@ @* *@ @* This procedure is used to assign, connect and open an interactive file *@ @* with read and write capability. *@ @* The interactive file is assigned to the slow file description :STD.STDMAC *@ @* and uses code set 255 (transparent 7-bit ISO). *@ @* The file will be used for the exchange of KERMIT packets. *@ @* *@ @******************************************************************************@ BEGIN INT KMT_EH_SOFTWARE_ERROR IS 80101; REF LONG INT FILE_CURRENCY IS KMT_DH_FILE_DETAILS.FILE_CURRENCY; REF WORD PFM_CURRENCY IS KMT_DH_FILE_DETAILS.PFM_CURRENCY; REF () WORD EVENT_LIST IS KMT_DH_FILE_DETAILS.EVENT_LIST; IF ( () BYTE NAME := ":STD.STDMAC", ACCESS := "W", LEVEL := "R", LOCK := "", REUSE := "NO", DNAME := "ICL9NINTDEVICE"; () REF () BYTE DNAMES := DISPLAY (DNAME); ASSIGN_FILE (NAME, FILE_CURRENCY, ACCESS, LEVEL, LOCK, REUSE, -5, -5, 0, DNAMES, RESULT); RESULT LE 0 ) AND ( CONNECT_EVENT (0, X"C0", X"C0", EVENT_LIST(0), 0, 0, RESULT); RESULT LE 0 ) AND ( () BYTE DETAILS_SUPPLIED := X"CE080000000000000000"; EVENT_LIST(1) := EVENT_LIST(0); DETAILS_SUPPLIED(2 SIZE 4) := 4-BYTE: EVENT_LIST(0); DETAILS_SUPPLIED(6 SIZE 4) := 4-BYTE: EVENT_LIST(1); BI_CONNECT_FILE (FILE_CURRENCY, PFM_CURRENCY, KMT_DH_FILE_DETAILS.CONNECTION_CURRENCY, DETAILS_SUPPLIED, NIL, NIL, RESULT); RESULT LE 0 ) AND ( INT FILE_CLASS IS 11, @ PFI_INTERACTIVE @ CODE_SET IS 255, @ Transparent 7-bit ISO @ TIME_OUT IS 0; @ No TIMEOUT ie indefinite @ @ wait @ PFI_FILE_FLAGS FILE_FLAGS IS X'03000000'; @ Inhibit space truncation @ @ Inhibit space compression @ () PFI_PARAMETER_PAIRS PARAMS := ((X'00', FILE_CLASS AS PFI_PARAMETER_VALUES.INT_VALUE), (X'01', CODE_SET AS PFI_PARAMETER_VALUES.INT_VALUE), (X'02', FILE_FLAGS AS PFI_PARAMETER_VALUES.FILE_FLAGS), (X'18', TIME_OUT AS PFI_PARAMETER_VALUES.INT_VALUE) ); KMT_DH_FILE_DETAILS.READ_INTEREST := FALSE; WHILE ( BOOL RETRY; DH_DEFINE_FILE_PROPERTIES (PFM_CURRENCY, PARAMS, RESULT); KMT_DH_PROCESS_RESPONSE (RESULT, FALSE, RETRY, RESULT); RETRY ) DO SKIP REPEAT; RESULT LE 0 ) AND @ Timeout intervals may be @ @ set in multiples of 2 @ @ minutes using the PFI. @ @ We need to be able to set @ @ timeout intervals in the @ @ order of 5 to 30 seconds. @ @ Therefore we must set up @ @ our own timer channel. @ ( CREATE_TIMER_CHANNEL (EVENT_LIST(0), KMT_DH_FILE_DETAILS.TIMER_CHANNEL, RESULT); RESULT LE 0 ) THEN @ File opened successfully @ () WORD PROPERTIES := (104, @ Maximum record size @ 0, 0); () BYTE DETAILS_REQUIRED := X"49" @ Line length @ X"51"; @ Suspension advice @ (6) BYTE DETAILS_AREA; KMT_DH_DEVICE_DETAILS.MAX_INPUT_LENGTH := IF ( CTM_READ_DESC (FILE_CURRENCY, NIL, NIL, PROPERTIES, RESULT); RESULT EQ 0 ) THEN PROPERTIES(1) ELSE 80 FI; DH_GIVE_FILE_DETAILS (PFM_CURRENCY, DETAILS_REQUIRED, DETAILS_AREA, NIL, RESULT); IF RESULT EQ 0 THEN KMT_DH_DEVICE_DETAILS.MAX_OUTPUT_LENGTH := DETAILS_AREA(2); KMT_DH_FILE_DETAILS.LONG_SUSPEND := BIT:DETAILS_AREA(5) ELSE KMT_DH_DEVICE_DETAILS.MAX_OUTPUT_LENGTH := 80; KMT_DH_FILE_DETAILS.LONG_SUSPEND := TRUE FI FI; IF RESULT GT 0 THEN (<RARELY>) @ Open error @ ( () BYTE PROC_NAME := "KMT_DH_OPEN_FILE"; () KMT_MTM_VALUES PARAMS := DISPLAY(PROC_NAME AS KMT_MTM_VALUES.RVB_VALUE); KMT_DH_DEVICE_DETAILS.FILE_OPEN := FALSE; KMT_EH_LOG_ERROR (RESULT, 2, PARAMS, 0, FALSE, FALSE); RESULT := KMT_EH_SOFTWARE_ERROR ) ELSE @ Ignore warnings @ KMT_DH_DEVICE_DETAILS.FILE_OPEN := TRUE; RESULT := 0 FI END; @ KMT_DH_OPEN_FILE @ ***PAGE GLOBAL STATIC (<STATUS 5>) PROC KMT_DH_CLOSE_FILE IS ( RESPONSE RESULT): @******************************************************************************@ @* *@ @* This procedure is used to close the file previously opened by the *@ @* procedure KMT_DH_OPEN_FILE. *@ @* *@ @******************************************************************************@ BEGIN INT KMT_EH_SOFTWARE_ERROR IS 80101; REF BOOL FILE_OPEN IS KMT_DH_DEVICE_DETAILS.FILE_OPEN; RESULT := 0; IF FILE_OPEN THEN @ File open, close it @ INT RC_DISCARDED; IF ( () BYTE DETAILS_SUPPLIED := DISPLAY (181,@ FC_TI_ACTION_TYPE @ 1, @ Length @ 40);@ FC_DI_DISCONNECT @ BI_MODIFY_CONNECTION (KMT_DH_FILE_DETAILS.CONNECTION_CURRENCY, DETAILS_SUPPLIED, NIL, NIL, RESULT); RESULT GT 0 ) THEN (<RARELY>) @ Close error @ ( () BYTE PROC_NAME := "KMT_DH_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 @ Ignore warnings @ RESULT := 0 FI; FILE_OPEN := FALSE; FI END; @ KMT_DH_CLOSE_FILE @ ***PAGE GLOBAL STATIC (<STATUS 5>) PROC KMT_DH_OUTPUT IS ( REF () BYTE OUTPUT_PACKET, BOOL PROMPT, RESPONSE RESULT): @******************************************************************************@ @* *@ @* This procedure is used to send a KERMIT packet to the remote end. The *@ @* end of line terminating character and any padding characters are added and *@ @* the required parity is set. *@ @* OUTPUT_PACKET references an area containing the packet to be output. *@ @* If the length of the output packet is zero then a single 'PAD' character *@ @* is output. If PROMPT is set true then the procedure will set read *@ @* interest on the file for the next call to KMT_DH_INPUT. *@ @* *@ @******************************************************************************@ BEGIN ***PAGE SIM PROC KMT_DH_SET_PARITY IS ( REF () BYTE BUFFER): @******************************************************************************@ @* *@ @* This procedure is used to set the required parity for each byte contained *@ @* in BUFFER. *@ @* *@ @******************************************************************************@ BEGIN WORD PARITY IS KMT_DH_DEVICE_DETAILS.OUTPUT_PARITY; IF PARITY LE 1 THEN @ Even or odd parity required @ BYTE INITIAL_PARITY_MASK IS IF PARITY EQ 0 THEN @ Even parity @ X"80" ELSE @ Odd parity @ X"00" FI; FOR I TO BOUND BUFFER DO BYTE PARITY_MASK := INITIAL_PARITY_MASK; WORD THIS_BYTE := BUFFER(I) & X"7F"; WHILE ( INT NUM_BITS_SHIFTED; THIS_BYTE := SHWZ (THIS_BYTE, NUM_BITS_SHIFTED); THIS_BYTE NE 0 ) DO PARITY_MASK := PARITY_MASK NEQ X"80"; THIS_BYTE := THIS_BYTE & X'7F000000' REPEAT; BUFFER(I) := BUFFER(I) ! PARITY_MASK REPEAT ELSF PARITY EQ 2 THEN @ Mark parity @ ORBYTE (X"80", BUFFER, 0, NIL) ELSF PARITY EQ 3 THEN @ Space parity @ ANDBYTE (X"7F", BUFFER, 0, NIL) FI END; @ KMT_DH_SET_PARITY @ ***PAGE INT PFI_REQUEST_ACCEPTED IS -31008, PFI_TIMED_OUT IS 39854; INT KMT_DH_DATA_OUT_MSG IS 151, KMT_DH_INPUT_AVAILABLE IS -80152, KMT_DH_QUEUE_EMPTY IS -80153; INT KMT_EH_SOFTWARE_ERROR IS 80101; INT NPAD IS KMT_PP_REMOTE_CONFG_PARAMS.NPAD; INT OUTPUT_PACKET_LENGTH IS IF OUTPUT_PACKET IS NIL THEN 0 ELSE LENGTH OUTPUT_PACKET FI; INT OUTPUT_BUFFER_LENGTH IS IF OUTPUT_PACKET_LENGTH EQ 0 THEN 1 ELSE OUTPUT_PACKET_LENGTH + NPAD + 1 FI; PFI_OUTPUT_CONTROLS CONTROL IS IF PROMPT THEN @ Report normal termination @ @ Prompt @ X'60000000' ELSE @ Report normal termination @ X'40000000' FI; WORD PFM_CURRENCY IS KMT_DH_FILE_DETAILS.PFM_CURRENCY; (OUTPUT_BUFFER_LENGTH) BYTE OUTPUT_BUFFER; BOOL TRACING IS KMT_TRACE_FLAGS.DH_TRACING; INT RC_DISCARDED; IF OUTPUT_PACKET_LENGTH EQ 0 THEN @ No packet supplied, @ @ output single PAD character @ OUTPUT_BUFFER := KMT_PP_REMOTE_CONFG_PARAMS.PADC; ELSE @ Build output data buffer @ @ consisting of the required @ @ number of PAD characters, @ @ the packet and the @ @ end of line terminating @ @ character @ INT EOL IS IF KMT_PP_REMOTE_CONFG_PARAMS.EOL = X"0D" @ ASG converts CR @ THEN X"0A" @ to NULL, LF to CRLF - fix also works via NIC @ ELSE KMT_PP_REMOTE_CONFG_PARAMS.EOL FI; MOVEBYTE (KMT_PP_REMOTE_CONFG_PARAMS.PADC, OUTPUT_BUFFER(SIZE NPAD), 0, NIL); OUTPUT_BUFFER(NPAD SIZE OUTPUT_PACKET_LENGTH) := OUTPUT_PACKET; OUTPUT_BUFFER(OUTPUT_BUFFER_LENGTH - 1) := EOL FI; KMT_DH_SET_PARITY (OUTPUT_BUFFER); CTM_WAIT_TIME (KMT_DH_DEVICE_DETAILS.PAUSE, @ Wait before sending packet @ RC_DISCARDED); WHILE ( BOOL RETRY; @ Ensure no I/O requests are @ @ outstanding @ DH_DO_QUEUE_ACTION (PFM_CURRENCY, 5, @ PFI_ABORT_QUEUE @ 0, NIL, RESULT); WHILE ( KMT_DH_PROCESS_RESPONSE (RESULT, FALSE, RETRY, RESULT); RETRY OR (RESULT EQ KMT_DH_INPUT_AVAILABLE) OR (RESULT EQ PFI_TIMED_OUT) ) DO RESULT := PFI_REQUEST_ACCEPTED REPEAT; IF RESULT EQ KMT_DH_QUEUE_EMPTY THEN @ File queue empty @ RESULT := 0 FI; IF RESULT LE 0 THEN @ File queue emptied @ @ successfilly @ IF TRACING THEN (<RARELY>) ( () KMT_MTM_VALUES PARAMS := DISPLAY(OUTPUT_BUFFER AS KMT_MTM_VALUES.RVB_VALUE); KMT_SP_LOG_TRACE_MESSAGE (KMT_DH_DATA_OUT_MSG, PARAMS) ) FI; DH_OUTPUT (PFM_CURRENCY, @ Send output data @ 0, OUTPUT_BUFFER, CONTROL, RESULT); KMT_DH_PROCESS_RESPONSE (RESULT, @ Check if successful @ PROMPT, RETRY, RESULT); FI; RETRY ) DO SKIP REPEAT; IF RESULT GT 0 THEN (<RARELY>) @ I/O error @ ( () BYTE PROC_NAME := "KMT_DH_OUTPUT"; () 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_DH_OUTPUT @ ***PAGE GLOBAL STATIC (<STATUS 5>) PROC KMT_DH_INPUT IS ( REF () BYTE INPUT_BUFFER, REF INT INPUT_BUFFER_LENGTH, RESPONSE RESULT): @******************************************************************************@ @* *@ @* This procedure is used to receive an input buffer from the remote end. *@ @* The input buffer may or may not contain a valid KERMIT packet. *@ @* The input buffer and length are returned in the areas referenced by *@ @* INPUT_BUFFER and INPUT_BUFFER_LENGTH respectively. *@ @* *@ @******************************************************************************@ BEGIN ***PAGE SIM PROC KMT_DH_REMOVE_PARITY IS ( REF () BYTE BUFFER): @******************************************************************************@ @* *@ @* This procedure is used to remove the parity bit (if present) for each byte *@ @* in BUFFER. *@ @* *@ @******************************************************************************@ BEGIN @ Clear parity bit @ ANDBYTE (X"7F", @ 7 bit IA5 @ BUFFER, 0, NIL) END; @ KMT_DH_REMOVE_PARITY @ ***PAGE INT TIM_NO_NOTIFICATIONS IS -32156, PFI_MESSAGE_CANCELLED IS 38575, PFI_TIMED_OUT IS 39854; INT KMT_DH_DATA_IN_MSG IS 150, KMT_EH_SOFTWARE_ERROR IS 80101, KMT_DH_INPUT_AVAILABLE IS -80152; PFI_INPUT_RETURNS INPUT_RETURN; BOOL TRACING IS KMT_TRACE_FLAGS.DH_TRACING; WORD TIMER_CHANNEL IS KMT_DH_FILE_DETAILS.TIMER_CHANNEL; WORD TIME IS IF DELAY_TIMER THEN DELAY ELSE KMT_PP_REMOTE_CONFG_PARAMS.TIME FI; IF ( RESULT := 0; UNLESS KMT_DH_FILE_DETAILS.READ_INTEREST THEN @ Read interest not set. @ @ Set read interest @ KMT_DH_OUTPUT (NIL, TRUE, RESULT) FI; RESULT LE 0 ) AND ( IF TIME NE 0 THEN @ Timeout intervals may be @ @ set in multiples of 2 @ @ minutes using the PFI. @ @ We need to be able to set @ @ timeout intervals in the @ @ order of 5 to 30 seconds. @ @ Therefore we must set up @ @ our own timer channel. @ LONG INT TIME_IN_MSECS IS (L'I'TIME) * 1000000; ESTABLISH_TIMER_NOTIFICATION (TIMER_CHANNEL, X'00000000 00100000', @ File timeout @ @ Make it look like a PFI @ @ timeout @ TIME_IN_MSECS + I'CLOCKTIME (), TRUE, FALSE, RESULT) FI; RESULT LE 0 ) AND ( INT RC_DISCARDED; BOOL RETRY; KMT_DH_PROCESS_RESPONSE (RESULT, @ Wait for PFI event @ FALSE, RETRY, RESULT); IF (TIME NE 0) AND (RESULT NE PFI_TIMED_OUT) AND @ Timeout set but timeout @ ( @ event did not occur. @ @ Turn off timer. @ CANCEL_TIMER_NOTIFICATION (TIMER_CHANNEL, RC_DISCARDED); RC_DISCARDED EQ TIM_NO_NOTIFICATIONS ) THEN @ Timeout event occurred @ @ after PFI event but before @ @ the timer could be @ @ cancelled. @ @ Read the timeout event and @ @ discarded it. @ LONG WORD EVENT_MESSAGE; INT REPLY; READ_EVENT (KMT_DH_FILE_DETAILS.EVENT_LIST(0), EVENT_MESSAGE, REPLY, RC_DISCARDED) FI; RESULT EQ KMT_DH_INPUT_AVAILABLE ) AND ( WORD PFM_CURRENCY IS KMT_DH_FILE_DETAILS.PFM_CURRENCY; DH_INPUT (PFM_CURRENCY, @ Get input data @ 0, INPUT_BUFFER, INPUT_RETURN, RESULT); RESULT LE 0 ) THEN @ Input data read @ INPUT_BUFFER_LENGTH := INPUT_RETURN.DATA_LENGTH; IF (INPUT_BUFFER(INPUT_BUFFER_LENGTH - 1) & X"7F") EQ X"1E" THEN @ Via a PAD and using @ @ code set 255 RS (X1E) is @ @ appended to the end of the @ @ record by VME. Ignore it. @ INPUT_BUFFER_LENGTH := INPUT_BUFFER_LENGTH - 1 FI; IF TRACING THEN (<RARELY>) ( () KMT_MTM_VALUES PARAMS := DISPLAY(INPUT_BUFFER(SIZE INPUT_BUFFER_LENGTH) AS KMT_MTM_VALUES.RVB_VALUE); KMT_SP_LOG_TRACE_MESSAGE (KMT_DH_DATA_IN_MSG, PARAMS) ) FI; KMT_DH_REMOVE_PARITY (INPUT_BUFFER(SIZE INPUT_BUFFER_LENGTH)); ELSE INPUT_BUFFER_LENGTH := 0 FI; IF RESULT EQ PFI_MESSAGE_CANCELLED THEN @ 'CANCEL' key, ignore RC @ RESULT := 0 FI; IF (RESULT GT 0) AND (RESULT NE PFI_TIMED_OUT) THEN (<RARELY>) @ I/O error @ ( () BYTE PROC_NAME := "KMT_DH_INPUT"; () 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 RESULT LE 0 THEN @ Ignore warnings @ RESULT := 0 FI END; @ KMT_DH_INPUT @ ENDMODULE @ KMT_DH_MODULE @