! FILE 'FEPD_ITPE8S' !******************************** !* EMAS-2900 FEP ITP SERVER * !* FILE: ITPE8S/ITPEY * !* DATE: 13.MAY.81 16.10 * !******************************** !! STACK SIZE = 500 %SYSTEMROUTINESPEC MAP HWR(%INTEGER SEG) %PERMROUTINESPEC SVC(%INTEGER EP, R0, R1) %RECORDFORMAT DMF(%INTEGER I) %CONSTRECORD (DMF) %NAME NULL = 0 %CONTROL K'100001' %BEGIN %CONSTSTRING (7)VSN = 'VSNEA8F' %RECORDFORMAT AM1F(%INTEGER RXS, RXD, TXS, TXD) %OWNRECORD (AM1F) %NAME L = 1; ! ADDR PASSED BY EAM1 !! NO OF DATA BYTES IN A SHORT BLOCK %CONSTINTEGER SMALL BLOCK MAX = 44 !START WITH 64 !BUFF MAN TAKES 4 !BSP TAKES 10 !ITP TAKES 4 !FOR LUCK 2 !LEAVES 44 %CONSTINTEGER BIG BLOCK MAX = 127; ! < 256 ! %CONSTINTEGERNAME NO OF SMALL = K'100114' %OWNINTEGER CRITICAL = 15; ! SWITCH OFF O/P LEVEL %RECORDFORMAT ITPF(%BYTEINTEGER CNSL, HDB1, HDB2, %STRING (241) S) %RECORDFORMAT ITP2F(%BYTEINTEGERARRAY A(0:241)) %RECORDFORMAT ITP3F(%BYTEINTEGER CNSL, HDB1, HDB2, %C %BYTEINTEGERARRAY A(0:32)) %RECORDFORMAT BSPF(%INTEGER ST,SS,RC,TC,UFL, %RECORD (ITPF) ITP); !$E %RECORDFORMAT BSP3F(%BYTEINTEGERARRAY A(0:100)) %RECORDFORMAT MEF(%RECORD (MEF) %NAME LINK, %C %BYTEINTEGER LEN, TYPE, %RECORD (BSPF)BSP) ! THINK ABOUT THE POSITION OF 'LEN' %RECORDFORMAT M2900F(%RECORD (MEF) %NAME L, %BYTEINTEGER LEN, TYPE, %C %INTEGER STREAM, SUB IDENT, %C P2A, P2B, P3A, P3B, P4A, P4B, P5A, P5B, P6A, P6B) %RECORDFORMAT M2900BF(%RECORD (MEF) %NAME L, %BYTEINTEGER LEN, TYPE, %C %INTEGER STREAM, SUB IDENT, %C %BYTEINTEGERARRAY B(0:19)) %RECORDFORMAT M2900IF(%RECORD (MEF) %NAME L, %BYTEINTEGER LEN, TYPE, %C %INTEGER STREAM, SUB IDENT, P2A, P2B, %STRING (15) INT) %RECORDFORMAT M2900CF(%RECORD (MEF) %NAME L, %BYTEINTEGER LEN, TYPE, %C %INTEGER STREAM, SUB IDENT, %INTEGERARRAY PA(0:9)) %RECORDFORMAT PE(%BYTEINTEGER SER, REPLY, %C FN, PORT, %RECORD (MEF) %NAME MES, %BYTEINTEGER LEN, S1) %RECORDFORMAT P2F(%BYTEINTEGER SER, REPLY, %C FN, PORT, %RECORD (MEF) %NAME MES, %INTEGER STR) %RECORDFORMAT QF(%RECORD (MEF) %NAME E) %RECORDFORMAT R1F(%INTEGER X) %RECORDFORMAT R2F(%RECORD (MEF) %NAME MES) !******************************************************** !* FORMATS OF TABLES, IE STREAM DESCRIPTORS, TCPS ETC * !******************************************************** %RECORDFORMAT CON DESF(%RECORD (MEF) %NAME HOLD, %C %INTEGER STATE, O STATE, %BYTEINTEGER STREAM, OUT GO, %C IN CNT, TCP, CNSL, SEQ BITS, PMT N, MODE, HOLD F, ABORTF, %C %INTEGER TRIG, I POS, OPOS, O LIM, O TRIG, P LIM, %C IN LIM, OUT LIM, O POSX, %RECORD (MEF) %NAME IN MES) %RECORDFORMAT CONS STATEF(%RECORD (CON DESF) %NAME CON DES) %RECORDFORMAT TCPF(%INTEGER STATE, CON STATE IND, %C HELD, H IND, H NO, %BYTEINTEGER PORT, OSTATE, TCPN, TERM, %C SIZE, MAX, %RECORD (QF) OUTQ) !*********************************************************** !* RECORD FORMATS FOR 2900 INPUT MESSAGES !*********************************************************** %RECORDFORMAT LOGON REQUESTF(%INTEGER LINK, %C %BYTEINTEGER LEN, MODE, %INTEGER ICS, SUB IDENT, S1, STR, %C %STRING (7) USER ID, PASSWORD) !************************************************************ !* UPPER LEVEL (ITP&RJE) HANDLER MESSAGES TO GATE !************************************************************ %CONSTINTEGER ENABLE FACILITY = 1; ! ENABLE THE FACILITY %CONSTINTEGER DISABLE FACILITY = 2; ! THE REVERSE %CONSTINTEGER CALL REPLY = 3; ! REPLY TO A 'CALL CONNECT' %CONSTINTEGER ENABLE INPUT = 4; ! ALLOW A BLOCK TO BE READ %CONSTINTEGER PUT OUTPUT = 5; ! SEND A BLOCK OF OUTPUT %CONSTINTEGER CLOSE CALL = 6; ! TERMINATE A CALL %CONSTINTEGER ABORT CALL = 7; ! ABORT THE CALL %CONSTINTEGER REJECT = 0; ! QUALIFIER ON ABOVE !********************************************************** !* MESSAGES FROM GATE TO UPPER LEVEL PROTOCOLS !********************************************************** %CONSTINTEGER INCOMING CALL = 2 %CONSTINTEGER INPUT RECD = 3; ! BLOCK ARRIVED FROM NODE %CONSTINTEGER OUTPUT TRANSMITTED = 4; ! PREPARED TO ACCEPT MORE %CONSTINTEGER CALL CLOSED = 5; ! EITHER END HAS CLOSED DOWN %CONSTINTEGER CALL ABORTED = 6; ! OTHER END HAS ABORTED !************************************************************** !* BUFFER MANAGER CALLS (FROM AND TO) * !************************************************************** %CONSTINTEGER BUFFER HERE = 0 !********** TO BUFFER MANAGER *********** %CONSTINTEGER REQUEST BUFFER = 0 %CONSTINTEGER RELEASE BUFFER = 1 !************************************************************** !* CALLS TO 2900 LINK HANDLER * !************************************************************** %CONSTINTEGER SEND DATA = 0 %CONSTINTEGER LOW LEVEL CONTROL = 1 %CONSTINTEGER HERE I AM = 2 %CONSTINTEGER RETURN CONTROL = 3 !************************************************************** !* REPLIES FROM 2900 LINK HANDLER * !**************************************************************** %CONSTINTEGER INTERF ADDR = 0 %CONSTINTEGER DO INPUT = 1 %CONSTINTEGER DO OUTPUT = 2 %CONSTINTEGER MESSAGE = 3 %CONSTINTEGER MAINFRAME UP = 4 %CONSTINTEGER MAINFRAME DOWN = 5 !**************************************************************** !********** VARIOUS SERVICE NUMBERS ************* %CONSTBYTEINTEGERNAME OWN ID = K'160030' %CONSTBYTEINTEGERNAME INT = K'160060' %CONSTINTEGER GATE SER = 16 %CONSTINTEGER BUFFER MANAGER = 17 %CONSTINTEGER LINK HANDLER = 18 %CONSTBYTEINTEGERNAME CHANGE OUT ZERO = K'160310' %CONSTINTEGER T3 SER = 21 %CONSTINTEGER COMM BIT = K'1' %CONSTINTEGER ACCEPT CHAR = K'002' %CONSTINTEGER ACFY = K'010'; ! PETER CALLS IT RXFY %CONSTINTEGER XOPL = K'020'; ! X OPERABLE - LATCHED %CONSTINTEGER XOP = K'040'; ! X OPERABLE %CONSTINTEGER READY = K'200' !************************************************************ !* TCP STATES * !************************************************************ ! %CONSTINTEGER NOT ALLOCATED = 0 %CONSTINTEGER CONNECTED = 1 %CONSTINTEGER TCP DISCONNECTING = 2 !****** TCP_OSTATE STATES (PERMISSION TO SEND) ***** %CONSTINTEGER IDLE = 0 %CONSTINTEGER BUSY = 1 !*********************************************************** !* 2900 STATES * !*********************************************************** %OWN %INTEGER HOST STATE = 0; ! HOLDS 2900 STATE %CONSTINTEGER DOWN = 0 %CONSTINTEGER UP = 1 !****************** COMMS CONTROL STATES ******************** %CONSTINTEGER UNUSED = 0 %CONSTINTEGER DISCONNECTING = 1 %CONSTINTEGER CONNECTING = 2 %CONSTINTEGER SUSPENDING = 4 %CONSTINTEGER ABORTING = 5 %CONSTINTEGER ENABLING = 7 %CONSTINTEGER ENABLED = 8 %CONSTINTEGER FIXED = 10; ! 1ST AVAILABLE STREAM !************************************************************** !* CONSOLE STATES * !************************************************************** %CONSTINTEGER NOT ALLOCATED = 0 %CONSTINTEGER NAME SENT = 1; ! HELLO HAS BEEN RECEIVED %CONSTINTEGER PASS SENT = 2; ! 'NAME' HAS BEEN RECEIVED %CONSTINTEGER LOGGING ON = 3 %CONSTINTEGER LOGGED ON = 4; ! 2970 HAS ACCEPTED IT %CONSTINTEGER INPUT ENABLED = 5 %CONSTINTEGER LOGGING OFF = 6; ! 2970 IS GETTING RID OF IT %CONSTINTEGER LOGGING OFF 2 = 7; ! WAITING TO SEND IT !! OSTATE STATES !! %CONSTINTEGER IDLE = 0 %CONSTINTEGER ENABLD = 1 %CONSTINTEGER OUT P = 2; ! OUTPUT REQ PENDING %CONSTINTEGER PMT P = 4; ! PROMPT REQUEST PENDING !********************************************************** !* ITP HEADER BYTES DEFINITIONS * !********************************************************** %CONSTINTEGER TEXT = 0; ! IN ITP_HDB1 %CONSTINTEGER BIN B = 1 %CONSTINTEGER CONTROL = 1 %CONSTINTEGER GO AHEAD = 2; ! IN ITP_HDB1 %CONSTINTEGER HELLO = 8 %CONSTINTEGER DISCONNECT = 4 %CONSTINTEGER TERMINATED = 2; ! IN ITP_HDB2 %CONSTINTEGER PROMPT = 4 %CONSTINTEGER TEXT MARKER = 8 %CONSTINTEGER SEQ NO VALID = 32 %CONSTINTEGER SEQ NO BITS = X'C0' %CONSTINTEGER SEQ INC = X'40' %CONSTINTEGER INTM = 1; ! HDB2 - CONTROL MESSAGE %CONSTINTEGER SET MODE = 2 %CONSTINTEGER KILL TRANSMIT = 8 %CONSTINTEGER KILL RECEIVE = 4 !****************************************** !* REASONS FOR WAITING FOR A BUFFER * !****************************************** %CONSTINTEGER SEND NAME PROMPT = 1 %CONSTINTEGER SEND PASS PROMPT = 2 %CONSTINTEGER PUT ECHO ON =3, PUT ECHO OFF = 4, SEND NL = 5 %CONSTINTEGER STORE USER NAME = 6 %CONSTINTEGER SEND DISCONNECT = 7 %CONSTINTEGER SEND LOGIN REPLY = 8; ! LOGON SUCCESSFUL %CONSTINTEGER SEND LOGIN FAILS 1 = 9; ! 9-17 %CONSTINTEGER SEND EMAS DOWN = 18 %CONSTINTEGER SEND GO AHEAD = 19 %CONSTINTEGER SEND KILL TRANSMIT = 20 %CONSTINTEGER SEND TEXT MARKER = 21 %CONSTINTEGER LAST ITP REASON = 21 %CONSTINTEGER LOW LEVEL IP TRANSFER = 22 %CONSTINTEGER LOW LEVEL OP TRANSFER = 23 %CONSTINTEGER GET OP BLOCK = 24 %CONSTINTEGER SEND TRIG REPLY = 25; ! MUST BE ODD (OUTPUT TRIGGER) %CONSTINTEGER SEND THE CHOP = 26; ! SEND AN "INT Y" TO 2900 %CONSTINTEGER GET BIG OP BLOCK = 27 !************************************************************** %ROUTINESPEC TO GATE(%INTEGER FN, %RECORD (MEF) %NAME MES, %C %INTEGER FLAG) %ROUTINESPEC TO 2900(%INTEGER FN, %RECORD (M2900F) %NAME M2900) %ROUTINESPEC GET BUFFER(%INTEGER REASON) %ROUTINESPEC FREE BUFFER(%RECORD (MEF) %NAME MES) %ROUTINESPEC FROM GATE %ROUTINESPEC FROM 2900 %ROUTINESPEC FROM BUFFER MANAGER(%RECORD (PE) %NAME P) %INTEGERFNSPEC ANALYSE ITP MESSAGE(%RECORD (MEF) %NAME MES) %ROUTINESPEC RETRIEVE(%RECORD (CON DESF) %NAME D) %ROUTINESPEC LOSE CONSOLES(%INTEGER X) %ROUTINESPEC READ FROM AM1 %ROUTINESPEC WRITE TO AM1 %ROUTINESPEC MON MES(%RECORD (MEF) %NAME MES) !! %PERMROUTINESPEC PUSH(%RECORD (QF) %NAME Q, %RECORD (MEF) %NAME E) !! %PERMRECORD (MEF) %MAPSPEC POP(%RECORD (QF) %NAME Q) !****************************************************** %RECORD (PE) P %RECORD (P2F) %NAME P2 %OWNRECORD (TCPF) %NAME TCP %OWNINTEGER TCPN %OWNRECORD (CON DESF) %NAME D %OWNRECORD (QF) FREE DES; ! PTS TO LIST OF FREE CON DESA %OWNRECORD (CON DESF) %NAME FIRST D; ! FOR DUMPING ONLY %OWNRECORD (QF) %NAME BUFFER POOL %OWNINTEGER NO OF BUFF = 0 %CONSTINTEGER TCP LIMIT = 15; ! INCREASE CON STATEA AS WELL !!!!!!! %OWNRECORD (TCPF) %ARRAY TCPA(0:TCP LIMIT) %OWNRECORD (CONS STATEF) %ARRAY CON STATEA(0:785) %OWNRECORD (CONS STATEF) %NAME CON STATE %CONSTINTEGER CON LIM = 118; ! NUMBER OF ACTIVE TERMINALS %OWNRECORD (CON DESF) %ARRAY CON DESA(0:CON LIM) %RECORD (QF) %NAME Q FRIG %CONSTINTEGER MAX PORTS = 50 %OWNBYTEINTEGERARRAY PORTA(0:MAX PORTS) ! CROSS INDEX FROM PORT TO TCP %CONSTINTEGER MAX TTS = 49; ! IE 0 TO 48 %RECORD (R1F) R1; %RECORD (R2F) %NAME R2 %OWNINTEGER MON = 0; ! MONITORING FLAG %OWNINTEGER LOSE OP = 0; ! DISCARD OUTPUT FOR ERTE %CONSTINTEGERNAME USERS = K'100014'; ! NO OF USERS IN BUFFER SEG %OWNINTEGER MESSFLAG=0; !W.S.C. 9/4/81 TCP CONNECTIONS %INTEGER I, N !********************************************** !* INITIALISATION * !********************************************** CHANGE OUT ZERO = T3 SER R2 == R1; P2 == P FIRST D == CON DESA(0) %CYCLE I = CON LIM, -1, 0 PUSH(FREE DES, CON DESA(I)) %REPEAT N = 0 %CYCLE I = 1, 1, TCP LIMIT TCP == TCPA(I) TCP_TCPN = I TCP_CON STATE IND = N; N = N+MAX TTS %REPEAT MAP HWR(3); ! MAP AM1 TO SEGMENT 3 MAP VIRT(BUFFER MANAGER, 5, 4); ! MAP BUFF MAN STACK TO SEG 4 MAP VIRT(BUFFER MANAGER, 6, 5); ! AND SECOND SEG USERS = 0 CON DESA(I)_STREAM = I %FOR I = 0, 1, CON LIM P2_STR = 2; ! PARAM FOR 'HERE I AM' TO 2900(HERE I AM, NULL) TCP == TCPA(0); ! DUMMY FOR BELOW TO GATE(ENABLE FACILITY, NULL, 18) !********************************************** !* MAIN LOOP * !********************************************** %CYCLE P_SER = 0; POFF(P) %IF INT # 0 %START %IF 'M' <= INT <= 'P' %START MON = INT-'O' %FINISH %IF INT='A' %THEN MESSFLAG=1; !TURN MESSAGES ON %IF INT='B' %THEN MESSFLAG=0; !TURN OFF %IF INT = '?' %START; ! $$ MON WRITE(NO OF BUFF, 4); NEWLINE PRINTSTRING("TERM QU MQ HELD NO HELD ") %CYCLE I = 1, 1, TCP LIMIT TCP == TCPA(I) %IF TCP_STATE = CONNECTED %START WRITE(TCP_TERM, 3) WRITE(TCP_SIZE, 3); WRITE(TCP_MAX, 2) WRITE(TCP_HELD, 3); WRITE(TCP_H NO, 2) NEWLINE TCP_MAX = 0 %FINISH %REPEAT %FINISH INT = 0 %FINISH %IF P_REPLY = LINK HANDLER %START FROM 2900 %ELSE %IF P_REPLY = GATE SER %START FROM GATE %ELSE %IF P_REPLY = BUFFER MANAGER %THEN FROM BUFFER MANAGER(P) %REPEAT !************************************************* !* ROUTINES TO DO THE WORK * !************************************************* %ROUTINE TO GATE(%INTEGER FN, %RECORD (MEF) %NAME MES, %C %INTEGER FLAG) %IF FN = PUT OUTPUT %START; ! QUEUE THESE AS NECESSARY MES_LEN = MES_LEN+2; !$E (UFLAG BYTES) %IF TCP_STATE # CONNECTED %START; ! THROW AWAY FREE BUFFER(MES); %RETURN %FINISH R2_MES == MES %IF R1_X&K'140000' = K'140000' %START PRINTSTRING("ITPS: BAD BUFFER *** DUMP IT ***** ") %CYCLE; %REPEAT %FINISH TCP_SIZE=TCP_SIZE+1 TCP_MAX=TCP_SIZE %IF TCP_SIZE>TCP_MAX ! %IF MON # 0 %START ! SELECT OUTPUT(1) ! PRINTSTRING("IO ");! MON MES(MES) ! %FINISH %FINISH P_SER = GATE SER; P_REPLY = OWN ID P_FN = FN; P_PORT = TCP_PORT; P_MES == MES; P_S1 = FLAG PON(P) %END %ROUTINE TO 2900(%INTEGER FN, %RECORD (M2900F) %NAME M2900) P_SER = LINK HANDLER; P_REPLY = OWN ID P_FN = FN; P_MES == M2900 PON(P) %END %ROUTINE GET BUFFER(%INTEGER REASON) %RECORD (PE) P %INTEGER TYPE !******************************************************* !* HOLD A POOL, SO CAN CALL BUFFER HERE IMMEDIALTELY* !* OTHERWISE HOLD THE ACTIVITY UNTIL IT ARRIVES* !******************************************************* %IF REASON = GET BIG OP BLOCK %THEN TYPE=0 %ELSE TYPE=1 P_S1 = REASON; P_PORT = D_STREAM %IF BUFFER POOL == NULL %OR TYPE=0 %START; ! HAVE TO ASK FOR IT P_SER = BUFFER MANAGER; P_REPLY = OWN ID P_FN = REQUEST BUFFER P_LEN = TYPE; ! EITHER SIZE PON(P) %ELSE P_MES == BUFFER POOL; BUFFER POOL == P_MES_LINK P_MES_LINK == NULL NO OF BUFF = NOOF BUFF-1; FROM BUFFER MANAGER(P) %FINISH %END %ROUTINE FREE BUFFER(%RECORD (MEF) %NAME MES) %RECORD (PE) P R2_MES == MES %IF R1_X&K'140000' = K'140000' %START PRINTSTRING("ITPS: BAD BUFFER ****** DUMP IT **** ") %CYCLE; %REPEAT %FINISH %IF MES_TYPE=0 %OR NO OF BUFF>10 %OR NO OF SMALL < 15 %START P_SER = BUFFER MANAGER; P_REPLY = OWN ID !! QUEUE IT IF IT IS A SHORT BUFFER P_FN = RELEASE BUFFER; P_MES == MES PON(P) %ELSE !! SHORT BUFFER, SO QUEUE IT MES_LINK == BUFFER POOL; BUFFER POOL == MES NO OF BUFF = NO OF BUFF+1 %FINISH %END %ROUTINE GET O BLOCK !! THIS ROUTINE DETERMINES WHETHER IT IS WORTH ASKING FOR !! A BIG BUFFER TO PUT ITP OUTPUT IN, OTHERWISE GETS SMALL !! NB: 1ST TRANSFER IS ALWAYS A SMALL BUFFER (NOT DONE HERE) %INTEGER X X = D_O LIM-D_O POS %IF X<0 %THEN X=X+D_OUT LIM %IF X>SMALL BLOCK MAX %THEN %C GET BUFFER(GET BIG OP BLOCK) %ELSE %C GET BUFFER(GET OP BLOCK) %END %ROUTINE FROM GATE %RECORD (MEF) %NAME MES %RECORD (TCPF) %NAME TARG %INTEGER FN, FLAG, TYPE, X %SWITCH FNS(INCOMING CALL:CALL ABORTED) FN = P_FN TCPN = PORTA(P_PORT) TCP == TCPA(TCPN) ->FNS(FN) FNS(INCOMING CALL): TCP == NULL %CYCLE TCPN = TCP LIMIT, -1, 1 TARG == TCPA(TCPN) %IF TARG_STATE = NOT ALLOCATED %THEN TCP == TARG %REPEAT %IF TCP == NULL %START ! 2900 DOWN OR FULL UP TCP == TCPA(0) TCP_PORT = P_PORT; ! FOR 'TO GATE' CALL ONLY FLAG = REJECT %ELSE TCP_TERM = P_LEN; TCP_STATE = CONNECTED; TCP_OSTATE = IDLE PORTA(P_PORT) = TCP_TCPN; ! FILL IN PORT NO - TCP NO INDEX TCP_PORT = P_PORT FLAG = 1; !CONNECT OK %IF MESSFLAG=1 %START PRINTSTRING(' ITP: T') WRITE(P_LEN, 1); PRINTSTRING(' Connected ') %FINISH TCP_MAX = 0; ! FOR MONITORING TCP_SIZE = 0; TCP_HELD = 0; TCP_H NO = 0 %FINISH TO GATE(CALL REPLY, NULL, FLAG) %RETURN FNS(INPUT RECD): MES == P_MES; ! HOLD FOR POSSIBLE FREEING MES_LEN = MES_LEN-2; !$E (UFLAG BYTES) ********** TO GATE(ENABLE INPUT, NULL, 0) ! %IF MON # 0 %START ! SELECT OUTPUT(1) ! PRINTSTRING("II ");! MON MES(MES) ! %FINISH %IF MES_LEN < 3 %START; !BUFFER EMPTY FREEBUFFER(MES); !THROW IT AWAY %RETURN %FINISH MES_BSP_RC = 0; ! MISSING GAH COUNT MES_BSP_RC = 0; ! MISSING GAH COUNT FLAG = ANALYSE ITP MESSAGE(MES) %IF FLAG < 0 %THEN FREE BUFFER(MES) ! FLAG > 0 - GOING TO 2900 ! FLAG = 0 - USED INTERNALLY ! FLAG < 0 - MAY BE FREED %RETURN FNS(OUTPUT TRANSMITTED): TCP_SIZE=TCP_SIZE-1 %IF TCP_HELD # 0 %AND TCP_SIZE<5 %START !! CONSOLES ARE HELD & Q IS NOW REDDUCED X = TCP_H IND %UNTIL X = TCP_H IND %CYCLE X = X+1 %IF X > MAX TTS %THEN X = 0 D == CON STATEA(X+TCP_CON STATE IND)_CON DES %UNLESS D == NULL %START; ! CONSOLE ACTIVE %IF D_HOLD F # 0 %START; ! AND HELD D_HOLD F = 0; TCP_HELD = TCP_HELD-1 GET O BLOCK %IF TCP_SIZE > 0 %THEN %C TCP_H IND = X %AND ->GOT IT !! IF Q IS STILL NON-ZERO, RELEASE ONLY 1 %FINISH %FINISH %REPEAT TCP_HELD = 0; ! DIDN'T FIND ANY! GOT IT: %FINISH %RETURN FNS(CALL CLOSED): TYPE=CLOSE CALL -> KILL IT FNS(CALL ABORTED): ! EITHER WAY, ALL IS LOST TYPE = ABORT CALL KILL IT: %WHILE %NOT TCP_OUTQ_E == NULL %CYCLE FREE BUFFER(POP(TCP_OUTQ)) %REPEAT %IF MESSFLAG=1 %START PRINTSTRING(' T'); WRITE(TCP_TERM, 1) PRINTSTRING(" Connection ") %IF TYPE = ABORT CALL %THEN PRINTSTRING("ABORTED") %ELSE %C PRINTSTRING("Closed") WRITE(TCP_MAX, 1); NEWLINE %FINISH LOSE CONSOLES(-1) TCP_STATE = NOT ALLOCATED TO GATE(TYPE, NULL, 0) X = 0 %WHILE %NOT TCP_OUTQ_E == NULL %CYCLE FREE BUFFER(POP(TCP_OUTQ)) X = X+1 %IF X&7 = 7 %THEN SVC(18, 1, 0) !! FORCE A RESCHEDULE, TO AVOID OVERLOAD %REPEAT; ! FLUSH ANY QUEUED ITEMS %RETURN %END %INTEGERFN ANALYSE ITP MESSAGE(%RECORD (MEF) %NAME MES) %RECORDFORMAT INP MESS1F(%STRINGNAME S) %RECORDFORMAT INP MESSF(%RECORD (M2900F) %NAME R) %RECORD (ITPF) %NAME ITP, ITP2 %RECORD (LOGON REQUESTF) %NAME LOG REQ %RECORD (INP MESS1F) INP MESS1; %RECORD (INP MESSF) %NAME INP MESS %INTEGER I, CNSL, STATE, INDEX, STREAM, LEN %RECORD (QF) %NAME Q %RECORD (M2900IF) %NAME M %STRING (15) INT MES %SWITCH CONSOLE STATE(IDLE:LOGGING OFF 2) ITP == MES_BSP_ITP CNSL = ITP_CNSL %IF CNSL >= MAX TTS %START PRINTSTRING("ITPS: CNSL NO TOO HIGH, TCP,CNSL:") WRITE(TCP_TERM, 1); WRITE(CNSL, 1) NEWLINE -> GET RID OF IT %FINISH INDEX = CNSL+TCP_CON STATE IND D == CON STATEA(INDEX)_CON DES %UNLESS D == NULL %START %IF CNSL#D_CNSL %OR D_TCP#TCP_TCPN %START PRINTSTRING("ITPS: CONSOLE MISMATCH (WARNING) ") -> GET RID OF IT %FINISH %IF ITP_HDB1&DISCONNECT # 0 %START !! CONSOLE CTRL+D LOSE CONSOLES(CNSL) -> GET RID OF IT %FINISH %IF ITP_HDB1&GO AHEAD# 0 %START; ! 'SIMPLE' GOAHEAD D_OUT GO = D_OUT GO+1 %IF D_OUT GO > 4 %THEN D_OUT GO = 4 %IF D_OUT GO = 1 %AND D_OSTATE &OUT P # 0 %START %IF TCP_SIZE >= 4 %OR NO OF SMALL < CRITICAL %START D_HOLD F = 1; TCP_HELD = TCP_HELD+1; TCP_H NO=TCP_H NO+1 %ELSE GET O BLOCK %FINISH %FINISH ->CONSOLE STATE(D_STATE) %FINISH CONSOLE STATE(NOT ALLOCATED): ! EG NO DESCRIPTOR %IF ITP_HDB1&HELLO # 0 %START; ! SENT HELLO D == POP(FREE DES) CON STATEA(INDEX)_CON DES == D %IF D == NULL %THEN -> GET RID OF IT STREAM = D_STREAM; ! HOLD THE STREAM D = 0; ! ZERO THE RECORD D_STREAM = STREAM D_TCP = TCPN; D_CNSL = CNSL %IF HOST STATE = DOWN %START GET BUFFER(SEND EMAS DOWN) D_STATE = LOGGING OFF %ELSE D_STATE = NAME SENT GET BUFFER(SEND NAME PROMPT) USERS = USERS+1 %FINISH %FINISH %RESULT = -1; ! NO FURTHER CONSOLE STATE(NAME SENT): ! USER NAME ARRIVED ? %IF ITP_HDB1&CONTROL = 0 %START; ! IS A TEXT MESSAGE D_HOLD == MES; ! HOLD THE NAME D_STATE = PASS SENT GET BUFFER(PUT ECHO OFF); ! SWITCH ECHO OFF GET BUFFER(SEND PASS PROMPT); ! SEND PASS: GET BUFFER(STORE USER NAME); ! SHIFT NAME TO SHORT BUFFER %RESULT = 0; ! DONT DEALLOCATE BLOCK %FINISH %RESULT = -1; ! DE-ALLOCTAE BLOCK CONSOLE STATE(PASS SENT): ! PASSWORD ARRIVED ?? %IF ITP_HDB1&CONTROL = 0 %START; ! IA A TEXT MESSAGE D_OUT GO = D_OUT GO-1 GET BUFFER(SEND NL); ! SEND OUT A NEWLINE GET BUFFER(PUT ECHO ON); ! PUT ECHO BACK ON LOG REQ == D_HOLD !! CHECK THAT IT HAS SWITCHED BUFFERS?? ! SET UP LOG REQ !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! %IF LENGTH(ITP_S) > 2 %START LENGTH(ITP_S) = LENGTH(ITP_S)-2; ! DELETE THE CR/LF %IF LENGTH(ITP_S)>7 %THEN LENGTH(ITP_S) = 7 %FINISH LOG REQ_PASSWORD = ITP_S LOG REQ_ICS = 2; LOG REQ_SUB IDENT = 0 LOG REQ_S1 = 0 INDEX = D_STREAM<<1+FIXED LOG REQ_STR = SWAB(INDEX) TO 2900(SEND DATA, LOG REQ) D_STATE = LOGGING ON D_HOLD == NULL D_SEQ BITS = X'C0' P2_STR = INDEX; ! PARAM FOR 'HERE I AM' TO 2900(HERE I AM, NULL) P2_STR = INDEX+1; ! PARAM FOR 'HERE I AM' TO 2900(HERE I AM, NULL) %FINISH %RESULT = -1 CONSOLE STATE(LOGGING ON): ! GO AHEAD ONLY? CONSOLE STATE(LOGGED ON): ! STILL NO INPUT %RESULT = -1 CONSOLE STATE(INPUT ENABLED): ! INPUT MESSAGES AND INTS !! CHECK FOR A TEXT MESSAGE %IF ITP_HDB1&CONTROL = 0 %START; ! TEXT %IF %NOT D_IN MES == NULL %START D_SEQ BITS = D_SEQ BITS+SEQ INC ITP2 == D_IN MES_BSP_ITP D_IN MES_BSP_RC = D_IN MES_BSP_RC+1; ! MISSING GAH COUNT %UNLESS LENGTH(ITP_S)+LENGTH(ITP2_S)>240 %THEN %C ITP2_S = ITP2_S.ITP_S %RESULT = -1; ! CHUCK THE BUFFER %FINISH GET BUFFER(LOW LEVEL IP TRANSFER); ! SIGNAL TO 2900 INPUT HERE D_IN MES == MES MES_BSP_TC = 0; ! MISSING GAH = 1 %RESULT = 2 %FINISH !! CHECK FOR AN "INT" MESSGAE %IF ITP_HDB2&INTM # 0 %START; ! INT MESSAGE INT MES = ITP_S; ! COPY IT OUT OF THE WAY LEN = LENGTH(INT MES); ! CHECK FOR CR, NL & NL %IF CHARNO(INT MES, LEN-1) = 13 %THEN LEN = LEN-2 %IF CHARNO(INT MES, LEN) = NL %THEN LEN = LEN-1 LEN = 15 %IF LEN > 15 %RESULT = -1 %IF LEN <= 0; ! INVALID INT LENGTH(INT MES) = LEN M == MES; ! RE-USE 'MES' M_STREAM = (D_STREAM<<1)+FIXED; M_SUB IDENT = 0 M_P2A = -1; M_P2B = -1; ! SET UP PARAMS M_INT = INT MES; ! COPY STRING ACCROSS TO 2900(SEND DATA, M); ! SEND TO EAM1 %RESULT = 2; ! DON'T DEALLOCATE BUFFER %FINISH %RESULT = -1 CONSOLE STATE(LOGGING OFF): ! MESSAGE IS OUT, JUST DISCONNECT D_STATE = LOGGING OFF 2 GET BUFFER(SEND DISCONNECT) %RESULT = -1 GET RID OF IT: CONSOLE STATE(LOGGING OFF 2): ! IGNORE %RESULT = -1 %END %ROUTINE FREE TRANSIENT %IF %NOT D_IN MES == NULL %THEN FREE BUFFER(D_IN MES) %AND %C D_IN MES == NULL %IF %NOT D_HOLD == NULL %START FREE BUFFER(D_HOLD); D_HOLD == NULL %FINISH %END !! R O U T I N E FROM 2900 !! ALL MESSAGES FROM THE 2900 COME TO THIS ROUTINE %ROUTINE FROM 2900 %RECORD (M2900F) %NAME M2900 %RECORD (M2900BF) %NAME M2900B %RECORD (M2900CF) %NAME M2900C %RECORD (MEF) %NAME MES %RECORD (ITP3F) %NAME IT %RECORD (M2900IF) %NAME NLOG %STRING (31) S %INTEGER STREAM, SUB IDENT, STATE, TRIG, L REPLY, MODE, I %INTEGER TYPE %SWITCH LINK FNS(INTERF ADDR:MAINFRAME DOWN) M2900 == P_MES; M2900B == M2900 %IF P_FN = MESSAGE %START STREAM = M2900_STREAM; ! GET FIRST STREAM NO %ELSE %IF P_FN > MESSAGE %THEN -> LINK FNS(P_FN) STREAM = P2_STR %FINISH D == CON DESA((STREAM-FIXED)>>1) TCP == TCPA(D_TCP) -> LINK FNS(P_FN) LINK FNS(INTERF ADDR): ! INTERFACE ADDR FROM EAM5 L == P_MES; ! FILL IN ADDR OF L %RETURN LINK FNS(DO OUTPUT): ! -> 11/34 READ FROM AM1 ! ->D MON %RETURN LINK FNS(DO INPUT): ! -> 2900 WRITE TO AM1 !D MON: %IF MON #0 %START ! SELECT OUTPUT(1);! PRINTSYMBOL('T') ! WRITE(P_FN, 1);! WRITE(STREAM, 1);! NEWLINE;! SELECT OUTPUT(0) ! %FINISH %RETURN LINK FNS(MAINFRAME UP): PRINTSTRING('EMAS-2900 UP ') -> TIDY LINK FNS(MAINFRAME DOWN): PRINTSTRING('EMAS DOWN ') TIDY: %CYCLE I = 0, 1, CON LIM D == CON DESA(I) %IF NOT ALLOCATED < D_STATE < LOGGING OFF %START %IF D_CNSL=255 %THEN RETRIEVE(D) %ELSE %START FREE TRANSIENT GET BUFFER(SEND EMAS DOWN) D_STATE = LOGGING OFF %FINISH %FINISH %IF I&3 = 3 %THEN SVC(18, 1, 0); ! FORCE RE-SCHEDULE %REPEAT HOST STATE = DOWN USERS = -1 %RETURN LINK FNS(MESSAGE): TYPE = 0 SUB IDENT = M2900_SUB IDENT STATE = M2900B_B(1); MODE = M2900B_B(0) %IF MON < 0 %START SELECT OUTPUT(1) PRINTSTRING('MESS:') WRITE(STREAM, 1); WRITE(SUB IDENT, 1); WRITE(STATE, 1) WRITE(M2900_P2B, 1); WRITE(M2900_P3B, 1) NEWLINE SELECT OUTPUT(0) %FINISH %IF SUB IDENT # 0 %START; ! LOW LEVEL %IF STREAM = 2 %START %IF STATE = CONNECTING %START !! INITIAL LOGON STREAM CONNECTED HOST STATE = UP PRINTSTRING('LOGON STREAM CONNECTED ') USERS = 0 %ELSE %IF STATE = DISCONNECTING %START HOST STATE = DOWN PRINTSTRING("LOGON STREAM DISCONNECTED ") %FINISH %FINISH %ELSE %IF D_STATE = NOT ALLOCATED %START %IF STREAM&1 = 0 %START; ! MONITOR INPUT STR ONLY PRINTSTRING("ITPS: NOT ALLOCATED PROBLEM") WRITE(STATE, 1); NEWLINE %FINISH -> SEND REPLY %FINISH %IF STATE = ENABLING %START; ! 1ST INTERSTING CONDITION %IF STREAM&1 = 0 %START D_STATE = INPUT ENABLED %IF D_CNSL = 255 %START; ! GONE AWAY TYPE = 1 %ELSE D_IN LIM = M2900_P2B D_I POS = M2900_P3B GET BUFFER(SEND GO AHEAD); GET BUFFER(SEND GO AHEAD) GET BUFFER(SEND GO AHEAD) %FINISH %ELSE %IF D_OUT LIM # 0 %START %IF D_ABORTF = ABORTING %START !! AN 'ABORTING' HAS BEEN DONE GET BUFFER(SEND TEXT MARKER) D_OUT GO = D_OUT GO-1 %FINISH %FINISH D_OUT LIM = M2900_P2B; D_O STATE = ENABLD D_O POS = M2900_P3B; D_O LIM = 0; D_P LIM = 0 D_MODE = MODE>>4; ! 0-ISO,X'20'-BIN,X'30'-CONT %FINISH %ELSE %IF STATE = DISCONNECTING %START %IF STREAM&1 = 0 %START D_STATE = LOGGING OFF GET BUFFER(SEND DISCONNECT) %ELSE D_O STATE = IDLE %FINISH %ELSE %IF STATE = ABORTING %OR STATE = SUSPENDING %START %IF STREAM&1 # 0 %START; ! OUTPUT SIDE D_O STATE = IDLE; ! STOP TRANSFERS D_ABORTF = STATE; ! REMEMBER TYPE GET BUFFER(SEND KILL TRANSMIT) %IF STATE = ABORTING %IF %NOT D_HOLD == NULL %THEN %C FREE BUFFER(D_HOLD) %AND D_HOLD == NULL %FINISH %FINISH %FINISH M2900_P2A = 0; M2900_P2B = 0 SEND REPLY: TO 2900(LOW LEVEL CONTROL, M2900) %IF TYPE # 0 %THEN GET BUFFER(SEND THE CHOP) %RETURN %FINISH !********************************* !* HIGH LEVEL MESSAGE !******************************** %IF STREAM&1 = 0 %AND STREAM > 2 %START; ! INPUT HIGH LEVEL TRIG = M2900_P3B %IF D_I POS = TRIG %START D_P LIM = M2900_P2B I = D_O STATE D_O STATE = I!PMT P D_PMT N = D_SEQ BITS!TERMINATED!PROMPT!SEQ NO VALID ! HOLD FOR USE LATER %IF I = ENABLD %START D_HOLD == M2900; ! RETAIN BUFFER GET BUFFER(LOW LEVEL OP TRANSFER) %RETURN %FINISH %FINISH FREE BUFFER(M2900); ! PAST THAT POSITION ALREADY %ELSE !************************ !* OUTPUT STREAM * !************************ %IF STREAM = 2 %START !! LOGON REPLY D == CON DESA((M2900B_B(2)-FIXED)>>1) %IF M2900B_B(5)#0 %START; ! NEW TYPE M2900C == M2900B %CYCLE I = 2,1 , 19 M2900C_PA(I) = SWAB(M2900C_PA(I)) %REPEAT NLOG == M2900 L REPLY = LENGTH(NLOG_INT)&128 LENGTH(NLOG_INT) = LENGTH(NLOG_INT)&127 S = NLOG_INT; ! COPY OUT OF WAY MES == M2900; ! MAKE ITBSPNOW MES_LEN = LENGTH(S)+4 MES_BSP_ITP_CNSL = D_CNSL MES_BSP_ITP_HDB1 = 0 MES_BSP_ITP_HDB2 = 2 MES_BSP_ITP_S = S TCP == TCPA(D_TCP) TO GATE(PUT OUTPUT, MES, 0) %FINISH D_OUT GO = D_OUT GO-1 %IF L REPLY = 0 %START D_STATE = LOGGED ON %ELSE D_STATE = LOGGING OFF %FINISH %ELSE !! REQUEST OUTPUT MESSAGE ! %INTEGER OUTPUT POS, TRIG POS D_O LIM = M2900_P2B D_O TRIG = M2900_P3B !! CHECK WHETHER IMMEDIATE TRIG REPLY IS NEEDED %IF D_O TRIG >= 0 %START; ! MAYBE GET BUFFER(SEND TRIG REPLY) %IF D_OPOS = D_OLIM %OR %C (D_OPOSD_OLIM %AND D_OLIM<=D_OTRIG<=D_OPOS) %FINISH D_O STATE = D_O STATE&(\PMT P); ! DISCARD PROMPT %IF D_O STATE&OUT P = 0 %AND D_OPOS # D_OLIM %START D_OSTATE = D_OSTATE!OUTP %IF D_OUT GO > 0 %START; ! ALLOWED TO SEND %IF %NOT D_HOLD == NULL %START FREE BUFFER(M2900) %ELSE D_HOLD == M2900 %FINISH %IF TCP_SIZE >= 5 %OR NO OF SMALL < CRITICAL %START D_HOLD F = 1; TCP_HELD = TCP_HELD+1 TCP_H NO = TCP_H NO+1 FREE BUFFER(D_HOLD); D_HOLD == NULL %ELSE GET BUFFER(LOW LEVEL OP TRANSFER) %FINISH %RETURN %FINISH %FINISH FREE BUFFER(M2900) %FINISH %FINISH %END %ROUTINE FILL(%RECORD (MEF) %NAME MES, %INTEGER NO) %RECORD (ITP2F) %NAME ITP2 %INTEGER N, PT, MAX %CONSTBYTEINTEGERARRAY PTS(1:LAST ITP REASON) = 1, 10, 19, 25, 31, 37, 38, 42, 42, 42(8), 42, 61, 65, 69 !! PT TO ITP MESS %CONSTBYTEINTEGERARRAY ITP MESSAGE(1:74) = 8, 2, K'146', 5, 'U', 's', 'e', 'r', ':',; ! NAME PROMPT 8, 0, K'246', 5, 'P', 'a', 's', 's', ':',; ! PASS PROMPT 5, 1, 2, 2, 1, 1,; ! ECHO ON 5, 3, 2, 2, 1, 0,; ! ECHO OFF+GO AHEAD 5, 0, 2, 2, 13, NL,; ! NL 0,; ! NOT USED 3, 5, 0, 0,; ! DISCONNECT 18, 0, 2, 15, 13, NL, '*', '*', '2', '9', '0', '0', ' ', 'D', 'o', 'w', 'n', 13, NL,; ! EMAS DOWN 3, 3, 0, 0,; ! GO AHEAD 3, 1, 8, 0,; ! KILL TRANSMIT 5, 0, 10, 2, 13, NL; ! NL+TEXT MARKER ITP2 == MES_BSP_ITP PT = PTS(NO); MAX = ITP MESSAGE(PT) %CYCLE N = 1, 1, MAX ITP2_A(N) = ITP MESSAGE(PT+N) %REPEAT MES_LEN = MAX+1; ! CNSL NO %END !! R O U T I N E MOVE USER NAME (FROM BIG TO SMALL BUFFER) %ROUTINE MOVE USER NAME(%RECORD (LOGON REQUESTF) %NAME LOGR) %RECORD (MEF) %NAME MES %IF D_STATE # PASS SENT %START PRINTSTRING("ITP:MUN FAILS") WRITE(D_STATE, 1); NEWLINE FREE BUFFER(LOGR); %RETURN %FINISH MES == D_HOLD %IF LENGTH(MES_BSP_ITP_S) > 6 %THEN LENGTH(MES_BSP_ITP_S) = 6 LOGR_USER ID = MES_BSP_ITP_S FREE BUFFER(MES) D_HOLD == LOGR %END !! R O U T I N E FROM BUFFER MANAGER !! ALL REQUESTS FOR BUFFERS COME BACK THROUGH HERE %ROUTINE FROM BUFFER MANAGER(%RECORD (PE) %NAME P) %INTEGER REASON, N, TYPE %RECORD (M2900F) %NAME M2900 %RECORD (MEF) %NAME MES %RECORD (M2900IF) %NAME MI %RECORD (ITP3F) %NAME IT %RECORD (QF) %NAME Q %CONSTSTRING (1) THE CHOP = 'Y' REASON = P_S1; ! GET REASON FOR CALLING P_MES_BSP_RC = REASON; ! MONITORING D == CON DESA(P_PORT); ! GET CONSOLE DESXCRIPTOR %IF D_STATE = NOT ALLOCATED %THEN -> FREE %IF REASON = STORE USER NAME %THEN MOVE USER NAME(P_MES) %ANDC %RETURN %IF REASON <= LAST ITP REASON %START %IF D_CNSL # 255 %START; ! CNSL = 255 - DISCONNECTED FILL(P_MES, REASON); ! INSERT THE MESSAGE P_MES_BSP_ITP_CNSL = D_CNSL TCP == TCPA(D_TCP) TO GATE(PUT OUTPUT, P_MES, 0) %ELSE FREE: FREE BUFFER(P_MES) %FINISH %IF REASON = SEND DISCONNECT %START RETRIEVE(D) %FINISH %ELSE %IF REASON=GET OP BLOCK %OR REASON=GET BIG OP BLOCK %START %IF D_O STATE = IDLE %THEN -> FREE; ! KILL O/P DONE %UNLESS D_HOLD==NULL %THEN FREE BUFFER(D_HOLD) D_HOLD == P_MES GET BUFFER(LOW LEVEL OP TRANSFER) %RETURN %FINISH !! MESSAGE TO 2900 REASON M2900 == P_MES M2900_STREAM = D_STREAM<<1+FIXED+REASON&1 M2900_SUB IDENT = 10 %IF REASON = LOW LEVEL OP TRANSFER %START MES == D_HOLD %IF MES == NULL %THEN -> FREE ! KILL OP DONE, SO IGNORE TRAN REQUEST LENGTH(MES_BSP_ITP_S) = 1 M2900_P2A = K'400'; ! = SWAB(1) M2900_P2B = SWAB(D_O POS) %ELSE M2900_P2B = 0; M2900_P2A = 0 %FINISH TYPE = LOW LEVEL CONTROL %IF REASON = SEND TRIG REPLY %START M2900_SUB IDENT = 0 M2900_P5A = 0; M2900_P5B = SWAB(D_OPOS) TYPE = SEND DATA D_O TRIG = -1 %FINISH %IF REASON = SEND THE CHOP %START MI == M2900; MI_SUB IDENT = 0; TYPE = SEND DATA MI_P2A = -1; MI_P2B = -1 MI_INT = THE CHOP %FINISH %IF MON < 0 %START SELECT OUTPUT(1) PRINTSTRING("TRF:") WRITE(M2900_STREAM, 1); WRITE(M2900_SUB IDENT, 1) WRITE(SWAB(M2900_P2A), 1); WRITE(SWAB(M2900_P2B), 1) WRITE(D_O LIM, 4); WRITE(D_P LIM, 1) NEWLINE; SELECT OUTPUT(0) %FINISH TO 2900(TYPE, M2900) %FINISH %END %ROUTINE RETRIEVE(%RECORD (CON DESF) %NAME D) %RECORD (TCPF) %NAME TCP %RECORD (R1F) %NAME R1 %RETURN %IF D_STATE = NOT ALLOCATED %IF D_CNSL # 255 %START; ! CNSL = 255 - DISCONNECTED TCP == TCPA(D_TCP) CON STATEA(D_CNSL+TCP_CON STATE IND)_CON DES == NULL %FINISH D_STATE = NOT ALLOCATED FREE TRANSIENT USERS = USERS-1 %UNLESS USERS <= 0 PUSH(FREE DES, D) %END !! R O U T I N E LOSE CONSOLES(ALL OR A SPECIFIC ONE) %ROUTINE LOSE CONSOLES(%INTEGER X) !! THROW AWAY CONNECTED CONSOLES %INTEGER INDEX, I, T INDEX = TCP_CON STATE IND %IF X < 0 %THEN T = MAX TTS-1 %AND X = 0 %C %ELSE T = X %CYCLE I = X, 1, T D == CON STATEA(I+INDEX)_CON DES CON STATEA(I+INDEX)_CON DES == NULL R2_MES == D %IF R1_X#0 %AND R1_X&K'140000'#K'140000' %START PRINTSTRING("ITPS: BAD RELEASE") WRITE(R1_X, 1); NEWLINE %CONTINUE %FINISH %UNLESS D == NULL %START D_CNSL = 255; ! NO MESSAGES TO THE TCP NOW FREE TRANSIENT %UNLESS D_STATE >= LOGGING OFF %START %IF D_STATE = INPUT ENABLED %START !! LOG OFF 2900 !! NB: THE CASE OF "LOGGED ON" IS CATERED FOR WHEN ENABLED GET BUFFER(SEND THE CHOP) %ELSE %UNLESS D_STATE >= LOGGING ON %THEN %C RETRIEVE(D); ! MAY RE-CLAIM IMMEDIATELY %FINISH !NEXT LINE ADDED BY W.S.C. 8/4/81 %FINISHELSEIF D_STATE=LOGGING OFF %THEN RETRIEVE(D) %FINISH %REPEAT %END %ROUTINE READ FROM AM1 !! ITP SERVER HAS CONTROL OF THE LINK %RECORD (MEF) %NAME MES %RECORD (ITP3F) %NAME IT %INTEGER I, N, FLAG, SYM, LIM, TYPE, T, STAT, LEN MES == D_HOLD %IF MES == NULL %START PRINTSTRING("ITP:SEQUENCE? ") P_LEN = 0!128; TO 2900(RETURN CONTROL, NULL) %RETURN %FINISH D_HOLD == NULL %IF MES_TYPE=0 %THEN LEN=BIGBLOCKMAX-2 %ELSE %C LEN = SMALL BLOCK MAX-2 IT == MES_BSP_ITP N = IT_A(0) FLAG = 0 %IF D_OSTATE&OUT P # 0 %START LIM = D_O LIM; TYPE = OUT P %ELSE LIM = D_P LIM; TYPE = PMT P D_O POSX = D_O POS %IF N = 1 !! HOLD BEGINNING OF PROMPT (TEMPORARILY) IN OPOSX !! IN CASE IT SPANS THE END OF BUFFER %FINISH %CYCLE %CYCLE STAT = L_RXS %EXIT %IF STAT&(READY!XOPL) # 0 %REPEAT %IF STAT&XOPL # 0 %START; ! XOP GONE DOWN T = 64; -> SKIP; ! SEND UNSUCCESSFULL %FINISH SYM = L_RXD; ! READ THE CHAR %IF L_RXS&ACFY # 0 %START; ! FAILED TO READ SYM = L_RXD; ! READ IT AGAIN %IF L_RXS&ACFY # 0 %START; ! HARD FAILURE - PARITY T = 3; -> SKIP %FINISH %FINISH %IF STAT&COMM BIT # 0 %START T = 2!128 SKIP: P_LEN = T; ! LONG BLOCK+ACCEPT LAST TO 2900(RETURN CONTROL, NULL) D_HOLD == MES; IT_A(0) = N %RETURN %FINISH %IF SYM = NL %AND D_MODE = 0 %START IT_A(N) = 13; N = N+1; ! PLANT CR %FINISH %IF D_O POS = D_OUT LIM %THEN D_OPOS = -1 D_O POS = D_O POS+1 IT_A(N) = SYM %IF D_O POS = D_O TRIG %START; ! SEND TRIGGER MESSAGE GET BUFFER(SEND TRIG REPLY) %FINISH %IF D_O POS = LIM %START IT_HDB2 = TERMINATED D_OSTATE = D_OSTATE&(\OUT P) REPLY: P_LEN = 0!128; ! EAM1 TO REJECT LAST CHAR %IF TYPE = PMT P %START !! THIS IS ACTUALLY A PROMPT - NOT OUTPUT IT_HDB2 = D_PMT N; ! AT TIME OF REQUEST D_O POS = D_O POSX; ! SEE COMMENT ABOVE AT TYPE = PMT P D_OSTATE = ENABLD %ELSE D_OUT GO = D_OUT GO-1 %UNLESS LOSE OP # 0 %OR D_MODE = 3 %FINISH TO 2900(RETURN CONTROL, NULL) IT_CNSL = D_CNSL; IT_HDB1 = TEXT %IF D_MODE = 2 %START; ! BINARY IT_HDB2 = IT_HDB2!BIN B %ELSE %IF D_MODE = 3 %START; ! SET MODE IT_HDB1 = CONTROL; IT_HDB2 = SET MODE %FINISH %FINISH IT_A(0) = N; ! ITP LENGTH MES_LEN = N+1+3; ! CNSL+ITP+NO OF CHARS %IF D_CNSL = 255 %START; ! GONE AWAY FREE BUFFER(MES) %ELSE %IF TYPE # OUT P %OR LOSE OP = 0 %THEN %C TO GATE(PUT OUTPUT, MES, 0) %ELSE %C FREE BUFFER(MES) %FINISH %IF (D_OSTATE > ENABLD %AND D_OUT GO > 0 ) %OR %C D_OSTATE = PMT P!ENABLD %THEN GET O BLOCK %RETURN %FINISH %IF N >= LEN %START !! LEAVE ROOM FOR A CR/LF SEQUENCE IT_HDB2 = 0 -> REPLY %FINISH N = N+1 L_RXS = L_RXS!ACCEPT CHAR; ! ACCEPT THE LAST CHAR %REPEAT %END %ROUTINE WRITE TO AM1 %RECORD (MEF) %NAME MES %RECORD (ITP3F) %NAME IT %INTEGER N, MAX, CHAR, STAT, GAH %CONSTINTEGER CR = 13 MES == D_IN MES %IF D_STATE # INPUT ENABLED %OR MES == NULL %START P_LEN = 0; ! TERMINATE ->AM1 REP; ! REPLY TO AM1 HANMDLER %FINISH IT == MES_BSP_ITP N = MES_BSP_TC+1; ! NB: USED WHEN BUFFER SPLIT!!! MAX = IT_A(0) %CYCLE %CYCLE STAT = L_RXS %IF STAT&XOPL # 0 %THEN P_LEN = 64 %AND ->AM1 REP %IF STAT&READY # 0 %START !! L I M I T SENT P_LEN = 2; ! LONG BLOCK MES_BSP_TC = N-1; ! STORE FOR RETURN AM1 REP: TO 2900(RETURN CONTROL, NULL) %RETURN %FINISH %IF L_TXS&READY # 0 %THEN %EXIT %REPEAT %IF N > MAX %START P_LEN = 4; ! CONDITION Y TO 2900(RETURN CONTROL, NULL) GAH = MES_BSP_RC; ! MISSING GAH COUNT %IF GAH > 3 %START; ! REMOVE IN DUE COURSE PRINTSTRING("ITPS: GAH COUNT =") WRITE(GAH, 1); NEWLINE GAH = 1 %FINISH FREE BUFFER(D_IN MES); D_IN MES == NULL D_SEQ BITS = D_SEQ BITS+SEQ INC GET BUFFER(SEND GO AHEAD) %AND GAH = GAH-1 %C %WHILE GAH >= 0 %RETURN %FINISH %CYCLE CHAR = IT_A(N) N = N+1 %EXIT %IF CHAR # CR %OR IT_HDB2&BIN B # 0 %REPEAT L_TXD = CHAR %IF D_I POS = D_IN LIM %THEN D_I POS = -1 D_I POS = D_I POS+1 %REPEAT %END %ROUTINE MON MES(%RECORD (MEF) %NAME MES) %INTEGER I, J, K, N %RECORD (ITP2F) %NAME ITP2 K = MES_LEN; ITP2 == MES_BSP_ITP WRITE(K, 1); SPACE; SPACE J = 0 %CYCLE I = 0, 1, K-1 %IF MON > 0 %AND I > 3 %START; ! 'P' AND NOT HEADER N = ITP2_A(I) PRINTSYMBOL(N) %UNLESS N = 0 %OR N = 4 %ELSE WRITE(ITP2_A(I), 1) J = J+1; %IF J = 25 %THEN J = 0 %AND NEWLINE %FINISH %REPEAT NEWLINE; SELECT OUTPUT(0) %END %ENDOFPROGRAM %REPEAT WRITE(ITP2_A(I), 1) 5, 1, 2, 2, 1, 1,; ! ECHO ON