! FILE 'FEPD_RJEE8S' %CONSTSTRING (7) VSN = "VSNEB8Y" !******************************** !* EMAS-2900 FEP RJE SERVER * !* FILE: RJEE8/RJEE8Y * !* DATE: 13.MAY.81 * !* MODIFIED FOR RING 27.OCT.80 !******************************** !! STACK SIZE = 300 %SYSTEMROUTINESPEC MAP HWR(%INTEGER SEG) %SYSTEMROUTINESPEC ALARM(%INTEGER TICKS) %RECORDFORMAT DMF(%INTEGER I) %CONSTRECORD (DMF) %NAME NULL = 0 %CONTROL K'100001' %BEGIN %RECORDFORMAT AM1F(%INTEGER RXS, RXD, TXS, TXD) %OWNRECORD (AM1F) %NAME L = 1; ! SUPPLIED BY AM1 HANDLER %RECORDFORMAT SSMESSAGEF(%INTEGER ST,PRT,C,PRT R,DS,TERM,NODE, %C %BYTEINTEGERARRAY A(0:239)); !$E %RECORDFORMAT BSPF(%INTEGER ST,DS,RC,TC,UFLAG, %C %BYTEINTEGERARRAY A(0:242)); !$E %RECORDFORMAT BSP3F(%BYTEINTEGERARRAY A(0:100)) %RECORDFORMAT BSP4F(%INTEGERARRAY A(0:100)) %RECORDFORMAT MEF(%RECORD (MEF) %NAME LINK, %C %BYTEINTEGER LEN, TYPE, %RECORD (BSPF)BSP) %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 MAF(%RECORD (MEF) %NAME L, %BYTEINTEGER MLEN, %C MTYPE, %BYTEINTEGERARRAY SPACER(0:11), %BYTEINTEGERARRAY A(0:240)) %RECORDFORMAT LOGF(%RECORD (MEF) %NAME L, %BYTEINTEGER MLEN, %C MTYPE, %INTEGER LEN, TYPE, %C %BYTEINTEGERARRAY M(0:242)) %RECORDFORMAT MAOF(%RECORD (MEF) %NAME L, %BYTEINTEGER MLEN, %C MTYPE, %BYTEINTEGERARRAY A(0:240)) %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) !******************************************************** !* FORMATS OF TABLES, IE STREAM DESCRIPTORS, TCPS ETC * !******************************************************** %RECORDFORMAT CON DESF(%RECORD (MEF) %NAME HOLD, %C %INTEGER INDEX, STREAM, PERMIT, NODE, TERM, FACILITY, %C O STATE, PORT, ISO, KILL, %C N, CPOS, COUNT, NC, %RECORD (QF) INP Q) !************************************************************ !* 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 OPEN CALL = 8; ! OPEN UP A CALL %CONSTINTEGER OPEN MESSAGE = 9; ! SEND A MESSAGE %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 %CONSTINTEGER OPEN CALL A = 7 %CONSTINTEGER OPEN CALL B = 8; ! REPLY FROM REMOTE %CONSTINTEGER MESSAGE R = 9; ! MESSAGE REC'D %CONSTINTEGER MESSAGE REPLY = 10; ! MESSAGE REPLY FROM GATE !************************************************************** !* 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' %CONSTINTEGER CR = 13 %CONSTINTEGER FF = 14 !*********************************************************** !* 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; ! END OF SECTION OR FILE %CONSTINTEGER ABORTING = 5 %CONSTINTEGER ENABLING = 7 %CONSTINTEGER ENABLED = 8 !* S T A T E S %CONSTINTEGER NOT ALLOC = -1 %CONSTINTEGER IDLE = 0 %CONSTINTEGER OP READY = 1; ! APPLIES TO THE CONNECTION %CONSTINTEGER INPUT READY = 1; ! INPUT STREAMS ONLY %CONSTINTEGER TRYING = 2; ! AWAITING NETWORK REPLY %CONSTINTEGER TIMING = 3; ! CONNECTION REFUSED, WAITING FOR CLOCK %CONSTINTEGER ABORTED = 4; ! 2900 HAS GONE DOWN %CONSTINTEGER CONNECT 1 = 5; ! BSP CONNECTED, WAITING FOR ! 2900 CONNECT&ENABLE %CONSTINTEGER CONNECTED = 6; ! IN FILE %CONSTINTEGER ENABLD = 7; ! 2900 HAS STARTED FILE %CONSTINTEGER CLOSING = 8; ! CLOSE HAS BEEN SENT TO NETWORK !****************************************** !* REASONS FOR WAITING FOR A BUFFER * !****************************************** %CONSTINTEGER LAST RJE REASON = 21 %CONSTINTEGER LOW LEVEL IP TRANSFER = 22 %CONSTINTEGER LOW LEVEL OP TRANSFER = 23 %CONSTINTEGER GET OP BLOCK = 24 %CONSTINTEGER SEND ABORT = 25; ! ASK EMAS TO ABORT STREAM %CONSTINTEGER DO INPUT CONNECT = 27 %CONSTINTEGER TRANSFER MESSAGE = 28 %CONSTINTEGER CONNECTING REPLY = 29 %CONSTINTEGER CONNECTING REPLY FAILED = 30 !************************************************************** %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 WHO AND STATE %ROUTINESPEC TELL %ROUTINESPEC FROM GATE %ROUTINESPEC FROM 2900 %ROUTINESPEC DO CONNECT(%INTEGER TPYE) %RECORD (CON DESF) %MAPSPEC GET FREE DES %ROUTINESPEC FLUSH FILE %ROUTINESPEC FROM BUFFER MANAGER(%RECORD (PE) %NAME P) %INTEGERFNSPEC ALLOCATE STREAM(%RECORD (CON DESF) %NAME D, %C %INTEGER TYPE) %ROUTINESPEC TIDY BUFFERS %ROUTINESPEC RETRIEVE(%RECORD (CON DESF) %NAME D) %ROUTINESPEC DO TRANSFER MESSAGE(%RECORD (MEF) %NAME MES) %ROUTINESPEC REFORM MESSAGE(%RECORD (MAF) %NAME M) %ROUTINESPEC DO REPM(%INTEGER FLAG) %ROUTINESPEC CLEAR ALL STREAMS %ROUTINESPEC READ FROM AM1 %ROUTINESPEC WRITE TO AM1 %ROUTINESPEC READ MESSAGE FROM AM1 %ROUTINESPEC WRITE MESSAGE 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 (QF) MES Q; ! Used to hold messages for 2900 %OWNINTEGER CON SUB ID REPLY = 1; ! PICKS UP FROM ACTUAL MESS %OWNRECORD (CON DESF) %NAME D %OWNRECORD (CON DESF) %NAME D4, D5 %CONSTINTEGER CON LIM = 40; ! NUMBER OF ACTIVE TERMINALS (SEE FIXED TOP) %OWNRECORD (CON DESF) %ARRAY CON DESA(0:CON LIM) %OWNRECORD (QF) %NAME FREE DES; ! PTS TO LIST OF FREE CON DESA %RECORD (QF) %NAME Q FRIG %CONSTINTEGER MAX PORTS = 50 %OWNBYTEINTEGERARRAY PORTA(0:MAX PORTS) ! CROSS INDEX FROM PORT TO TCP %CONSTINTEGER FIXED = 258; ! 1ST AVAILABLE STREAM %CONSTINTEGER FIXED TOP = 350; ! NUMBER OF 2900 STREAMS IN EAM5 ! WAS 281 ! %OWNBYTEINTEGERARRAY AM1A(FIXED:FIXED TOP) = K'377'(0) %OWNBYTEINTEGERARRAY ALLOC(FIXED:FIXED TOP) !* * * * * * * * * * * * * * * * * * !MAPPING FROM SPOOLR INTERNAL DEVICE CODES TO FACILITY NUMBERS %CONSTBYTEINTEGERARRAY FACIL(0:14) = 0, 6, 0, 7, 0, 20, 4, 8, 0, 9, 13, 0, 0, 0, 9 !DEVICE NUMBER/FACILITY CODES ! SPOOLR NO. FACILITY CODE DOCUMENT TYPE ! 0 0 ! 1 6 PP NO ! 2 0 PR YES ! 3 7 CP NO ! 4 0 CR YES ! 5 20 MT NO ! 6 4 LP NO ! 7 8 GP NO ! 8 0 OP NO ! 9 9 MP NO ! 10 13 DO YES ! 11 0 NO ! 12 0 CT NO ! 13 0 SU NO ! 14 9 FE YES ! 15 0 NO %OWNRECORD (QF) %NAME BUFFER POOL; ! =K'142472' %OWNINTEGER NO OF BUFF = 0 %OWNINTEGER MON = 0; ! MONITORING FLAG %OWNINTEGER FEP WEIGHT = 80; ! DISCOURAGE RJE TRAFFIC WT %OWNINTEGER PORT = 0; ! CURRENT PORT NO ? %CONSTINTEGERNAME USERS = K'100014'; ! NO OF USERS IN BUFFER SEG %CONSTINTEGERNAME CPU = K'100012'; ! IDLE CPU COUNT %CONSTINTEGERNAME PKTS = K'100010'; ! PACKET COUNT %CONSTINTEGERNAME SBR = K'100006'; ! NO OF SBRS %CONSTINTEGERNAME BYT = K'100004'; ! NO OF BYTES %OWNINTEGER RJEI = 0; ! NO OF RJE PACKETS %OWNINTEGER RJEO = 0 ! L O G G I N G O N %OWNINTEGER M1, M2, M3, M4, M5; ! $$ BUFFER MONITORING %INTEGER I %CONSTSTRING (3) %ARRAY SFACIL(0:20) = '??', 'DI', '??'(2), 'LP', '??', 'PP', '??', 'GP', 'MP', '??'(2), 'CR', 'DO', '??'(6), 'MT' %CONSTSTRING (7) %ARRAY OSTATES(-1:8) = 'NOT ALL', 'WAITING', 'READY', 'ASKING', 'TIMING', 'ABORTNG', 'CHCKING', 'CONNING', 'GOING', 'CLOSE' %CONSTBYTEINTEGERARRAY EF(1:8) = 1, 2, 10, 11, 12, 13, 21, 4 ! GATE FACILITY NOS %RECORDFORMAT R1F(%INTEGER X) %RECORDFORMAT R2F(%RECORD (MEF) %NAME M) %RECORD (R1F) R1; %RECORD (R2F) %NAME R2 !********************************************** !* INITIALISATION * !********************************************** CHANGE OUT ZERO = T3 SER P2 == P %CYCLE I = CON LIM, -1, 2 CON DESA(I)_INDEX = I; CON DESA(I)_O STATE = NOT ALLOC QFRIG == CON DESA(I) QFRIG_E == FREE DES FREE DES == QFRIG %REPEAT CON DESA(1)_INDEX = 1 CONDESA(0)_STREAM = 4 CON DESA(1)_STREAM = 5 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) D == CON DESA(0) D4 == D D5 == CON DESA(1) P2_STR = 4; ! PARAM FOR 'HERE I AM' TO 2900(HERE I AM, NULL) P2_STR = 5 TO 2900(HERE I AM, NULL) TO GATE(ENABLE FACILITY, NULL, EF(I)) %FOR I = 1, 1, 8 ALARM(500); ! SET CLOCK FOR 10 SECS R2 == R1 !********************************************** !* MAIN LOOP * !********************************************** %CYCLE P_SER = 0; POFF(P) %IF 'M' <= INT <= 'P' %START MON = INT-'O'; INT = 0 %FINISH %IF INT = '?' %START %CYCLE I = 2, 1, CON LIM D == CON DESA(I) %IF D_O STATE # NOT ALLOC %START PRINTSTRING("RJE:") WHO AND STATE PRINTSTRING("P ="); WRITE(D_PORT, 1) PRINTSTRING(", C ="); WRITE(D_NC, 1) NEWLINE %FINISH %REPEAT INT = 0 NEWLINE %FINISH %IF '0' <= INT <='9' %START; ! CHANGE WEIGHT INT FEP WEIGHT = (INT-'0')*10; 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 %START FROM BUFFER MANAGER(P) %ELSE %IF P_REPLY = 0 %START; ! CLOCK TICK %CYCLE I = CON LIM, -1, 0 D == CON DESA(I) %IF D_O STATE = TIMING %THEN DO CONNECT(OPEN CALL) %REPEAT ALARM(500) %FINISH %REPEAT !************************************************* !* ROUTINES TO DO THE WORK * !************************************************* %ROUTINE CRUNCH WHO AND STATE; NEWLINE PRINTSTRING("**** RJES FAILED - DUMP IT *** ") *K'104001' %END %ROUTINE TO GATE(%INTEGER FN, %RECORD (MEF) %NAME MES, %C %INTEGER FLAG) %IF FN = PUT OUTPUT %START; ! QUEUE THESE AS NECESSARY ! %IF MON = -1 %START SELECT OUTPUT(1) ! PRINTSTRING("IO ");! MON MES(MES) ! %FINISH RJEO = RJEO+1 R2_M == MES %IF R1_X&K'140000' = K'140000' %THEN CRUNCH %FINISH P_SER = GATE SER; P_REPLY = OWN ID P_FN = FN; P_PORT = D_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 !******************************************************* !* HOLD A POOL, SO CAN CALL BUFFER HERE IMMEDIALTELY* !* OTHERWISE HOLD THE ACTIVITY UNTIL IT ARRIVES* !******************************************************* %IF REASON = GET OP BLOCK %THEN P_LEN = 0 %ELSE P_LEN = 1 ! ****** WATCH THE ABOVE LINE ******** P_S1 = REASON; P_PORT = D_INDEX %IF BUFFER POOL == NULL %OR P_LEN # 0 %START; ! HAVE TO ASK FOR IT P_SER = BUFFER MANAGER; P_REPLY = OWN ID P_FN = REQUEST BUFFER 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) M5 = M5+1; ! $$ BUFFER MON %FINISH %END %ROUTINE FREE BUFFER(%RECORD (MEF) %NAME MES) %RECORD (PE) P R2_M == MES %IF R1_X&K'140000' = K'140000' %THEN CRUNCH %IF MES_TYPE # 0 %OR NO OF BUFF > 3 %START P_SER = BUFFER MANAGER; P_REPLY = OWN ID !! QUEUE IT IF IT IS A LONG BUFFER P_FN = RELEASE BUFFER; P_MES == MES PON(P) %ELSE !! LONG BUFFER, SO QUEUE IT MES_LINK == BUFFER POOL; BUFFER POOL == MES NO OF BUFF = NO OF BUFF+1 %FINISH %END !! %ROUTINE TELL !! MONITORING ROUTINE %INTEGER N N = D_FACILITY %IF D_STREAM&1 = 0 %AND N=13 %THEN N = 1; ! INPUT PRINTSTRING(SFACIL(N)) WRITE(D_TERM, 1) SPACE %END %ROUTINE WHO AND STATE TELL PRINTSYMBOL('(') PRINTSTRING(OSTATES(D_O STATE)) PRINTSTRING(") ") %END %ROUTINE PLANT FAIL(%INTEGER TYPE, %RECORD (MEF) %NAME MES) %RECORD (SSMESSAGEF) %NAME SSMESSAGE SSMESSAGE == MES_BSP SSMESSAGE_A(0) = 1; SSMESSAGE_A(1) = TYPE MES_LEN = 2+2-1; !$E %END %ROUTINE FROM GATE %RECORD (MEF) %NAME MES %RECORD (SSMESSAGEF) %NAME SSMESSAGE %RECORD (BSP4F) %NAME BSP4 %RECORD (CON DES F) %NAME D2 %RECORDFORMAT P3F(%BYTEINTEGER SER,REPLY,FN,PORT,A,B,C,D) %RECORD (P3F) %NAME P3 %INTEGER FN, FLAG, STRM, MAX, I, IND, CHAR, TRM, FAC, FL %INTEGER NODE %SWITCH FNS(INCOMING CALL:MESSAGE REPLY) FN = P_FN STRM = P_PORT D == CON DESA(PORTA(STRM)) ->FNS(FN) FNS(INCOMING CALL): FLAG = 0; ! REJECT IF ALL ELSE FAILS !! There are two possible conditions, !! 1) The specific device has already send in a file. !! 2) the 2900 has to be asked to validate the device %IF HOST STATE = DOWN %START PLANT FAIL('D', P_MES) -> REPLY %FINISH SSMESSAGE == P_MES_BSP; FAC = P_S1 NODE = SSMESSAGE_NODE; TRM = SSMESSAGE_TERM %IF NODE = 0 %THEN TRM = P_LEN; ! _LEN IF FROM RING %CYCLE I = 2, 1, CON LIM D == CON DESA(I) %IF D_STREAM&1 = 0 %AND %C D_TERM = TRM %AND FAC=D_FACILITY %START; ! Already known to FEP %IF D_O STATE # INPUT READY %THEN PLANT FAIL('B', P_MES) %AND -> REPLY GET BUFFER(CONNECTING REPLY); ! CONNECT REPLY D_O STATE = CONNECTED FLAG = 1; ! ACCEPT THE CALL -> CONNECT PORT %FINISH %REPEAT D == GET FREE DES %IF D == NULL %THEN PLANT FAIL('F', P_MES) %AND -> REPLY ! No free descriptors !! CONSTRUCT A MESSAGE TO THE 2900 ******* I = ALLOCATE STREAM(D, 0); ! EVEN STREAM ONLY D_FACILITY = FAC; ! FIXED AT CR FOR NOW D_NODE = NODE; D_TERM = TRM D_O STATE = CONNECT 1; ! WAIT FOR CONFIRMATION D_NC = 0 %IF MON # 0 %START TELL; PRINTSTRING("ASKING ") %FINISH GET BUFFER(DO INPUT CONNECT) CONNECT PORT: D_PORT = P_PORT; ! REMEMBER GATE PORT NO PORTA(P_PORT) = D_INDEX; ! BACKWARD MAPPING %RETURN %IF FLAG = 0; ! Asking the 2900, so wait REPLY: P_MES_LEN=0 DO REPM(FLAG) %RETURN FNS(INPUT RECD): RJEI = RJEI+1 MES == P_MES %IF D_INP Q_E == NULL %AND D_HOLD == NULL %AND %C D_O STATE = ENABLD %START !! STREAM IS WAITING FOR A NETWORK BUFFER GET BUFFER(LOW LEVEL IP TRANSFER) D_N = 0; ! INTO BUFFER POINTER, AND KICK 2900 %FINISH PUSH(D_INP Q, MES); ! Q BUFFER ANYWAY D_NC = D_NC+1; ! COUNT IT %RETURN FNS(OUTPUT TRANSMITTED): D_PERMIT = D_PERMIT+1 %IF D_PERMIT = 1 %AND D_O STATE = ENABLD %THEN %C GET BUFFER(GET OP BLOCK) %RETURN FNS(CALL CLOSED): %RETURN %IF D_STREAM&1 = 0 %AND D_O STATE # CLOSING !! EOF ON INPUT IS HANDLED BY "WRITE TO AM1" !! ON OUTPUT IS HANDLED INSIDE "CALL ABORTED" FNS(CALL ABORTED): ! ALL IS LOST %IF D_O STATE = CLOSING %START %IF MON>0 %START TELL; PRINTSTRING("CLOSE ACK ") %FINISH %IF HOST STATE = DOWN %THEN RETRIEVE(D) %AND %RETURN TO 2900(LOW LEVEL CONTROL, D_HOLD) D_O STATE = IDLE; D_HOLD == NULL %ELSE WHO AND STATE PRINTSTRING("NETWORK ABORT ") %IF D_O STATE = NOT ALLOC %THEN %RETURN; ! VERY NASTY *************** %IF D_O STATE >= CONNECTED %OR D_O STATE = INPUT READY %C %START GET BUFFER(SEND ABORT); ! GET 2900 TO ABORT STREAM TO GATE(ABORT CALL, NULL, 0); ! REPLY TO GATE TO CLEAR PORT %FINISH %IF D_O STATE = ABORTED %OR HOST STATE = DOWN %THEN %C RETRIEVE(D) %ELSE D_O STATE = IDLE %FINISH %RETURN FNS(OPEN CALL A): ! ALLOCATED PORT NO D == CON DESA(P_PORT) !! P_PORT < 0 (IE FAILED!) P3==P D_PORT = P3_A %IF D_PORT = 0 %THEN P_S1 = 125 %ELSE %START PORTA(P3_A) = P_PORT %RETURN %FINISH !* P3_A = 0 => NO GATE PORTS, SO TREAT AS A OPEN CALL B !* WITH ERROR FLAG = 125 FNS(OPEN CALL B): ! REPLY FROM REMOTE DEVICE FLAG = P_S1; ! SUCCESS/FAIL FLAG %IF D_O STATE = ABORTED %START !! CONNECTION ESTABLISHED ! %IF FLAG#0 %THEN RETRIEVE(D) %ELSE %START TO GATE(ABORT CALL, NULL, 0) D_NC = 98 %FINISH %RETURN %FINISH %IF FLAG # 0 %START %IF FLAG=18 %START; !DEVICE U/S GET BUFFER(CONNECTING REPLY); !PRETEND IT'S OK GET BUFFER(SEND ABORT); !THEN KILL IT D_OSTATE=IDLE %IF HOST STATE=DOWN %THEN RETRIEVE(D) %ELSE D_NC = D_NC+1; D_PORT = FLAG; ! REMEMBER REASON D_O STATE = TIMING %FINISH %ELSE %IF MON # 0 %START TELL; PRINTSTRING("CONNECTED ") %FINISH GET BUFFER(CONNECTING REPLY); ! GET BUFFER TO REPLY TO SPOOLR D_PERMIT = 1; D_ISO = 0; ! SET ISO MODE D_O STATE = CONNECTED D_NC = 0 %FINISH %RETURN FNS(MESSAGE R): ! INCOMING LOGIN OR ENQUIRY FLAG = 128; ! REPLY OK, UNLESS ... SSMESSAGE == P_MES_BSP %IF P_S1 = 21 %START; ! POLL FROM INFO BSP4 == SSMESSAGE BSP4_A(9) = USERS; !$E - ALL OF SECTION $E BSP4_A(10) = HOST STATE BSP4_A(11) = CPU; BSP4_A(12) = PKTS; BSP4_A(13) = SBR BSP4_A(14) = BYT; BSP4_A(15) = RJEO BSP4_A(16) = RJEI P_MES_LEN=24+2-1; !$E - AND ABOVE SECTION -> REPM %FINISH %IF P_S1 >= 10 %START -> REPM %IF P_S1 = 10 !! LOGON OR OPER MESSAGE AND 2900 IS ACTUALLY UP %IF HOST STATE = DOWN %START FLAG = 0; PLANT FAIL('D', P_MES) -> REPM %FINISH PUSH(MES Q, P_MES); ! RETAIN THE MESSAGE SSMESSAGE_C = P_PORT; ! REMEMBER THE GATE PORT %IF SSMESSAGE_NODE = 0 %THEN SSMESSAGE_TERM = P_LEN; !$E GET BUFFER(TRANSFER MESSAGE) %RETURN; ! Wait for the buffer %FINISH I=0 PRINTSTRING(" T"); WRITE(P_LEN, 1) PRINTSYMBOL(':') %CYCLE MAX = SSMESSAGE_A(I) %IF MAX = X'80' %THEN MAX = SSMESSAGE_A(I+1) %AND I = I+1 I = I+1 %WHILE MAX > 0 %CYCLE CHAR = SSMESSAGE_A(I) PRINTSYMBOL(CHAR); I = I+1; MAX = MAX-1 %REPEAT NEWLINE %UNLESS CHAR = NL %EXIT %IF I >= P_MES_LEN SPACES(12) %REPEAT REPM: DO REPM(FLAG) %RETURN FNS(MESSAGE REPLY): ! REPLY TO SENDMESSAGE FREE BUFFER(P_MES) %UNLESS P_MES==NULL ! IGNORE, BUT FREE BUFFER %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 (MEF) %NAME MES %INTEGER STREAM, SUB IDENT, STATE, MODE, AM1C %INTEGER P2A, P2B, IOFLAG %SWITCH LINK FNS(INTERF ADDR:MAINFRAME DOWN) %SWITCH COM STATE(DISCONNECTING:ENABLED) %SWITCH COM STATE B(DISCONNECTING:ENABLED) M2900 == P_MES; M2900B == M2900 %IF P_FN = MESSAGE %START STREAM = M2900_STREAM; ! GET FIRST STREAM NO %ELSE STREAM = P2_STR AM1C = AM1A(STREAM) %IF AM1C = K'377' %THEN D == NULL %ELSE %C D == CON DESA(AM1C) -> LINK FNS(P_FN) LINK FNS(INTERF ADDR): ! INTERFACE ADDR FROM EAM5 L == P_MES %RETURN LINK FNS(DO OUTPUT): ! -> 11/34 %IF STREAM = 5 %THEN READ MESSAGE FROM AM1 %ELSE %C READ FROM AM1 %RETURN LINK FNS(DO INPUT): ! -> 2900 %IF STREAM = 4 %THEN WRITE MESSAGE TO AM1 %ELSE %C WRITE TO AM1 %RETURN LINK FNS(MAINFRAME DOWN): LINK FNS(MAINFRAME UP): HOST STATE = DOWN CLEAR ALL STREAMS %RETURN LINK FNS(MESSAGE): SUB IDENT = M2900_SUB IDENT STATE = M2900B_B(1); MODE = M2900B_B(0)&X'F0' ! MODE = 0 - SEQ, 1 - CIRC, 2 - SEQ CONT ! = X'10' - ISO, X'20' - EBC, X'30' - BIN P2A = M2900_P2A; P2B = M2900_P2B M2900_P2A = 0; M2900_P2B = 0 %IF SUB IDENT # 0 %START; ! LOW LEVEL !****************************************** !* L O W L E V E L CONTROL MESSAGE !****************************************** IOFLAG = STREAM&1; ! IOFLAG = 1 => 2900 O/P %IF STREAM <= 5 %START %IF STREAM = 4 %THEN D ==D4 %ELSE D == D5 ->COM STATE B(STATE) %FINISH -> CONTROL REPLY %IF D == NULL -> COM STATE(STATE) COM STATE(ENABLING): -> CONTROL REPLY %IF D_O STATE = IDLE D_O STATE = ENABLD %IF MON # 0 %START TELL; PRINTSTRING(" ENABLING ") %FINISH %IF IOFLAG # 0 %START %IF MODE # D_ISO %THEN FLUSH FILE; ! MODE CHANGE D_ISO = MODE %IF D_PERMIT > 0 %START %IF D_HOLD == NULL %START GET BUFFER(GET OP BLOCK) %ELSE DO TRANS AND REPLY: TO 2900(LOW LEVEL CONTROL, M2900) GET BUFFER(LOW LEVEL OP TRANSFER) %RETURN %FINISH %FINISH %ELSE %UNLESS D_HOLD == NULL %AND D_INP Q_E == NULL %C %THEN -> DO TRANS AND REPLY %FINISH -> CONTROL REPLY COM STATE(CONNECTING): CON SUB ID REPLY = M2900_SUB IDENT; ! RETAIN FOR REPLY %IF MON#0 %THEN %C TELL %AND PRINTSTRING("CONN ") %IF IOFLAG # 0 %START; ! OUTPUT DO CONNECT(OPEN CALL); D_NC = 0 %ELSE; ! INPUT %IF D_O STATE = CONNECT 1 %START P_PORT = D_PORT; ! FOR REPM DO REPM(1); !OK D_O STATE = CONNECTED ->CONTROL REPLY %FINISH ! ITS READY AND WAITING D_O STATE = INPUT READY %FINISH FREE BUFFER(M2900); ! REPLY IS MADE UP LATER %RETURN COM STATE(DISCONNECTING): %IF MON # 0 %START TELL; PRINTSTRING("DISC ") %FINISH %IF D_O STATE # IDLE %START D_O STATE = CLOSING %IF IOFLAG # 0 %AND D_KILL = SUSPENDING %START FLUSH FILE MODE = CLOSE CALL; ! FOR "TO GATE" CALL %ELSE MODE = ABORT CALL; TIDY BUFFERS %FINISH D_HOLD == M2900 TO GATE(MODE, NULL, 0); ! REPLY TO GATE %RETURN; ! HOLD REPLY TILL LATER %FINISH -> CONTROL REPLY COM STATE(ABORTING): %IF MON # 0 %START TELL; PRINTSTRING("ABORTING ") %FINISH ->SUSPD COM STATE(SUSPENDING): %IF MON # 0 %START TELL; PRINTSTRING("SUSP ") %FINISH SUSPD: D_O STATE = CONNECTED %UNLESS D_O STATE = IDLE D_KILL = STATE; ! REMEMBER TYPE OF CALL ! STOP TRANSFERS UNLESS ITS IDLE ANYWAY CONTROL REPLY: TO 2900(LOW LEVEL CONTROL, M2900) %RETURN !! *********************************************** !! THE FOLLOWING ARE ALL STREAM 4 & 5 MANIPULATIONS !! ************************************************ COM STATE B(ENABLING): D_O STATE = ENABLING D_ISO = P2B; ! Buffer size HOST STATE = UP -> JUNK M COM STATE B(CONNECTING): D_O STATE = CONNECTED D_N = 0; D_NC = 0; D_COUNT = 0; D_ISO = 0; D_CPOS = 0 PRINTSTRING("RJE: LOGON STREAM"); WRITE(STREAM, 1) PRINTSTRING(" CONNECTED ") -> JUNK M COM STATEB(ABORTING): COM STATEB(SUSPENDING): COM STATEB(DISCONNECTING): D_O STATE = IDLE HOST STATE = DOWN JUNK M: TIDY BUFFERS -> CONTROL REPLY %FINISH !! HIGH LEVEL CONTROL MESSAGE D == D5 FREE BUFFER(M2900) GET BUFFER(GET OP BLOCK) %IF D_NC = D_COUNT; ! DONT DO TWICE D_NC = P2B; ! UPDATE POINTER %END %ROUTINE DO CONNECT(%INTEGER TYPE) %RECORDFORMAT P3F(%BYTEINTEGER SER, REPLY, %C FN, PORT, NODE, FLAG, TERM, FACILITY); !NODE,FLAG NOT USED %RECORD (P3F) %NAME P3 P3 == P P3_SER = GATE SER; P3_REPLY = OWN ID P3_FN = TYPE; P3_PORT = D_INDEX P3_TERM = D_TERM %IF TYPE = OPEN CALL %START P3_FACILITY = D_FACILITY P3_NODE = D_NODE; !$E D_O STATE = TRYING %FINISH PON(P) %END %RECORD (CON DES F) %MAP GET FREE DES QFRIG == FREE DES %IF QFRIG == NULL %START PRINTSTRING("RJES: OUT OF DESCRIPTORS! **** ") %RESULT == NULL %FINISH FREE DES == QFRIG_E QFRIG_E == NULL %RESULT == QFRIG %END %ROUTINE FLUSH FILE %INTEGER BLOCK TYPE, LEN %RECORD (MEF) %NAME MES MES == D_HOLD %UNLESS MES == NULL %START D_HOLD == NULL %IF D_N <= 2 %THEN FREE BUFFER(MES) %ELSE %START BLOCK TYPE = X'0500'; ! SET ISO MODE %IF D_ISO # 0 %THEN BLOCK TYPE = X'0100'; ! 2ND BYTE LEN = D_N+2; !$E %IF D_N = D_CPOS+2 %THEN LEN = LEN-2 ! 2 DUMMY LENGTH BYTES PRESENT MES_BSP_UFLAG = BLOCK TYPE; MES_LEN = LEN; D_N = 0 D_PERMIT = D_PERMIT-1; ! FOR MODE CHANGING TO GATE(PUT OUTPUT, MES, 0) %FINISH %FINISH %END !! R O U T I N E FROM BUFFER MANAGER !! ALL REQUESTS FOR BUFFERS COME BACK THROUGH HERE %ROUTINE FORM 2900 MESSAGE(%RECORD (LOGF) %NAME LOG) !! THIS ROUTINE INSERTS THE STREAM NO, SUB IDENT !! NETWORK ADDRESS INTO A MESSAGE FOR STREAM 4 LOG_M LEN = 12 LOG_TYPE = X'0300'; ! = SWAB(3) LOG_LEN = X'0C00'; ! = SWAB(12) LOG_M(0) = 2; LOG_M(1) = D_NODE; LOG_M(2) = D_TERM LOG_M(5) = 0; LOG_M(6) = 1; LOG_M(7) = D_STREAM LOG_M(8) = 0; LOG_M(9) = 0 %END %ROUTINE KICK 2900 MESSAGE(%RECORD (LOGF) %NAME LOG) !! THIS ROUTINE SENDS 'LOG' TO THE 2900 BY INSERTING !! IT IN THE INPUT Q FOR STREAM 4, AND KICKING IT IF !! NECESSARY D == D4 %IF D_HOLD == NULL %AND D_INP Q_E == NULL %THEN %C GET BUFFER(DO OUTPUT) GET BUFFER(DO OUTPUT) %IF D_CPOS > 5; ! NB COMPILER FAULT ABOVE PUSH(D_INP Q, LOG) D_CPOS = D_CPOS+1 %END %ROUTINE FROM BUFFER MANAGER(%RECORD (PE) %NAME P) %INTEGER REASON, N, TYPE, DEVTYPE, DEVNO %RECORD (M2900F) %NAME M2900 %RECORD (MEF) %NAME MES %RECORD (LOGF) %NAME LOG REASON = P_S1; ! GET REASON FOR CALLING D == CON DESA(P_PORT); ! GET CONSOLE DESXCRIPTOR %IF REASON = GET OP BLOCK %START D_HOLD == P_MES; D_N = 0 GET BUFFER(LOW LEVEL OP TRANSFER) %RETURN %FINISH %IF REASON = TRANSFER MESSAGE %START DO TRANSFER MESSAGE(P_MES) %RETURN %FINISH %IF REASON = DO INPUT CONNECT %START LOG == P_MES FORM 2900 MESSAGE(LOG) DEVTYPE=D_FACILITY & 31 DEVNO=D_FACILITY >> 5 %IF DEVTYPE = 12 %THEN I = 4 %ELSESTART %IF DEVTYPE = 4 %THEN I = 6 %ELSE %C I = 2; ! CR (12) = 4, PR(13) = 2 %FINISH LOG_M(4) = I LOG_M(5)=DEVNO KICK 2900 MESSAGE(LOG) %RETURN %FINISH !! MESSAGE TO 2900 REASON !! NOTE: STREAMS 4&5 ALSO USE THIS MECHANISM M2900 == P_MES M2900_STREAM = D_STREAM M2900_SUB IDENT = 10; M2900_P2A = 0; M2900_P2B = 0 TYPE = LOW LEVEL CONTROL %IF REASON = SEND ABORT %START M2900_SUB IDENT = 0 M2900_P3A = 0 M2900_P3B = 1 TYPE = SEND DATA %FINISH %IF REASON = CONNECTING REPLY %THEN %C M2900_SUB IDENT = CON SUB ID REPLY %IF REASON = CONNECTING REPLY FAILED %START M2900_SUB IDENT = CON SUB ID REPLY M2900_P2B = X'0A00'; ! = SWAB(10) %FINISH TO 2900(TYPE, M2900) !! %FINISH %END %INTEGERFN ALLOCATE STREAM(%RECORD (CON DESF) %NAME D, %INTEGER TYPE) !! NB: TYPE = 0, ALLOCATE EVEN STREAM FOR INPUT !! TYPE = 1, ALLOCATE ODD STREAM FOR OUTPUT(LP ETC) %INTEGER I %CYCLE I = FIXED+TYPE, 2, FIXED TOP-2+TYPE %IF ALLOC(I) = 0 %START ALLOC(I) = D_INDEX D_STREAM = I P2_STR = I; ! CLAIM THE STREAM TO 2900(HERE I AM, NULL) AM1A(I) = D_INDEX %RESULT = I %FINISH %REPEAT %RESULT = 0 %END %ROUTINE TIDY BUFFERS FREE BUFFER(POP(D_INP Q)) %WHILE %NOT D_INP Q_E == NULL FREE BUFFER(D_HOLD) %UNLESS D_HOLD == NULL D_HOLD == NULL %END %ROUTINE RETRIEVE(%RECORD (CON DESF) %NAME D) !! SEVER LINK BETWEEN 2900 AND DESCRIPTOR AND !! FREE THE DESCRIPTOR %IF D_STREAM <= 5 %START; ! ILLEGAE CRUNCH %FINISH AM1A(D_STREAM) = K'377'; ! MARK UNUSED TIDY BUFFERS D_O STATE = NOT ALLOC; D_TERM = -1 ALLOC(D_STREAM) = 0 QFRIG == D QFRIG_E == FREE DES FREE DES == QFRIG %END %ROUTINE DO TRANSFER MESSAGE(%RECORD (MAOF) %NAME M) !! SEND OPERATOR MESSAGE TO THE 2900 %RECORD (MEF) %NAME MES %RECORD (SSMESSAGEF) %NAME SSMESSAGE %INTEGER I, N, X MES == POP(MES Q); ! GET STORED MESSAGE SSMESSAGE == MES_BSP FORM 2900 MESSAGE(M) N = 0 %IF SSMESSAGE_A(0)>=128 %THEN N = N+1; ! 2 byte length X = SSMESSAGE_A(N) %IF X > 50 %THEN X = 50; ! GIVE IT A BIG BUFFER???? SSMESSAGE_A(N) = X; ! SHORTEN LENGTH IN BUFFER %CYCLE I = 0, 1, X M_A(I+8) = SSMESSAGE_A(N+I) %REPEAT I = (I+9+1)&X'FFFE'; ! Allow for header and make even M_A(1) = I; ! LENGTH OF MESSAGE M_A(3) = 1; ! TYPE = 1 M_A(5) = SSMESSAGE_NODE; M_A(6) = SSMESSAGE_TERM; !$E M_M LEN = I; ! LENGTH AGAIN KICK 2900 MESSAGE(M) P_MES == MES P_PORT = SSMESSAGE_C; ! RESTORE GATE PORT NUMBER MES_LEN = 0; ! DELETE THE TEXT DO REPM(128); ! REPLY TO GATE %END %ROUTINE REFORM MESSAGE(%RECORD (MAF) %NAME M) !! SEND 2900 MESSAGE TO RJE OPERATOR %RECORD (MEF) %NAME MES %RECORD (SSMESSAGEF) %NAME SSMESSAGE %INTEGER I, LEN, X, PT, NPT, MAX MES == M SSMESSAGE == MES_BSP SSMESSAGE_A(0) = 0; ! PROTECT AGAINST ZERO DATA MAX = M_A(8)+8; ! PICK UP LENGTH (STRINGS LATER?) X = 0; LEN = 0; PT = 9; NPT = 1 %CYCLE I = M_A(PT) SSMESSAGE_A(NPT) = I %IF I = NL %START SSMESSAGE_A(X) = NPT-X NPT = NPT+1; X = NPT %FINISH PT = PT+1; NPT = NPT+1 %EXIT %IF PT > MAX %REPEAT SSMESSAGE_NODE = D_NODE; !$E MES_LEN = NPT-2+1 P_S1=2; !FACILITY 2 P_MES == MES; ! SET FOR DO CONNECT DO CONNECT(OPEN MESSAGE) %END %ROUTINE DO REPM(%INTEGER FLAG) !! SENDS A 'CALL REPLY' TO GATE, NB: ASSUMES P_PORT = PORT NUMBER P_SER = GATE SER; P_REPLY = OWN ID P_FN = CALL REPLY; P_S1 = FLAG PON(P) %END %ROUTINE CLEAR ALL STREAMS !! USED WHEN EMAS GOES DOWN %INTEGER I %SWITCH STS(NOT ALLOC:CLOSING) %CYCLE I = 2, 1, CON LIM D == CON DESA(I) ->STS(D_O STATE) STS(CONNECT 1): P_PORT = D_PORT DO REPM(0); ! REPLY 'REJECT' TO CONNECT STS(IDLE): STS(OP READY): STS(TIMING): RETRIEVE(D) %CONTINUE STS(CONNECTED): STS(ENABLD): TO GATE(ABORT CALL, NULL, 0) D_O STATE = ABORTED %CONTINUE STS(TRYING): D_O STATE = ABORTED %CONTINUE STS(ABORTED): STS(CLOSING): ! MUST WAIT FOR NETWORK STS(NOT ALLOC): %REPEAT HOST STATE = DOWN %END %ROUTINE READ FROM AM1 %RECORD (AM1F) %NAME L2 %INTEGER MAX AD, ADR, ADR2 %RECORD (MEF) %NAME MES %RECORD (BSPF) %NAME BSP %INTEGER N, SYM, CPOS, T, STAT %IF D == NULL %THEN MES == NULL %ELSE %C MES == D_HOLD %IF MES == NULL %START PRINTSTRING("RJE: SEQ1! ") T = 0!128; -> SKIP2 %FINISH BSP == MES_BSP !! (CATER FOR PARTIAL BLOCK REC'D) %IF D_N # 0 %START N = D_N; CPOS = D_CPOS %ELSE N = 2; !! ALLOW FOR 2 BYTE COUNT CPOS = 0 %FINISH !! NEXT SECTION IS IN ASSEMBLER IN A FILE 'ERCC14.RJEASSM' ! ACFY =10 ! XOPL =20 L2 == L R2_M == BSP ADR2 = R1_X+10; !$E BSP_A(0) MAX AD = ADR2+239 REP CYCLE: ADR = ADR2+N; ! BSP_A(N) ! *K'016501';*K'177770'; ! MOV -10(R5),R1 ! R1 == BSP_A(N) *K'016503';*K'177774'; ! MOV -4(R5),R3 ! L2 = -4(R5) *K'011302' ; ! CYCLE: MOV (R3),R2 ! STAT=R2 *K'032702';*K'000220'; ! BIT #200+XOPL,R2 *K'001774' ; ! BEQ CYCLE ! NOTHING SET, SO WAIT *K'032702';*K'000020'; ! BIT #XOPL,R2 ! XOPL SET? *K'001051' ; ! BNE XOPDWN ! YES, SO FAIL IT ! *K'016300';*K'000002'; ! MOV 2(R3),R0 ! SYM=R0 *K'032713';*K'000010'; ! BIT #ACFY,@R3 ! FAILED TO READ? *K'001405' ; ! BEQ Y1 ! NO, SO CARRY ON *K'016300';*K'000002'; ! MOV 2(R3),R0 ! READ IT AGAIN *K'032713';*K'000010'; ! BIT #ACFY,@R3 ! FAILED AGAIN? *K'001031' ; ! BNE PARITY ! YES, SO FAILS ! Y1: *K'006202' ; ! ASR R2 ! GET COMM BIT *K'103432' ; ! BCS COMMBT ! COMM BIT SEEN *K'110021' ; ! MOVB R0,(R1)+ ! BSP_A(N) = SYM! N=N+1 *K'020027';*K'000040'; ! CMP R0,#40 ! SPACE? *K'002012' ; ! BGE Y3 ! GREATER THAN, SO OK *K'020027';*K'000012'; ! CMP R0,#10. ! NEWLINE *K'001415' ; ! BEQ EXIT ! IS LF *K'002406' ; ! BLT Y3 ! NOT IN SPECIAL CHAR RANGE *K'020027';*K'000015'; ! CMP R0,#13. *K'001411' ; ! BEQ EXIT *K'020027';*K'000014'; ! CMP R0,#12. *K'001406' ; ! BEQ EXIT ! FORM FEED *K'020165';*K'177772'; ! Y3: CMP R1,-6(R5) ! 239 CHARS? *K'103003' ; ! BHIS EXIT ! YES, SO EXIT *K'052713';*K'000002'; ! BIS #2,(R3) ! ACCEPT CHAR *K'000731' ; ! BR CYCLE ! ! EXIT: ! ETC *K'010165';*K'177770'; ! MOV R1,-10(R5) ! RESTORE 'ADR' -> EXIT ! PARITY: *K'010165';*K'177770'; ! MOV R1,-10(R5) L1: ->PARITY ! COMMBT: *K'010165';*K'177770'; ! MOV R1,-10(R5) L3: ->COMM BIT ! XOPDWN: XOPDWN: T = 64; -> SKIP; ! SEND UNSUCCESSFULL PARITY: T = 3; -> SKIP COMM BIT: T = 2!128 SKIP: N = ADR-ADR2; ! RECOMPUT N D_N = N; D_CPOS = CPOS BSP_A(CPOS) = X'80'; BSP_A(CPOS+1) = N-CPOS-2 SKIP2: P_LEN = T; ! LONG BLOCK+ACCEPT LAST TO 2900(RETURN CONTROL, NULL) %RETURN EXIT: N = ADR-ADR2; ! RECOMPUTE N BSP_A(CPOS) = X'80' BSP_A(CPOS+1) = N-CPOS-2 %IF N < 239-132 %START CPOS = N; N = N+2 L_RXS = L_RXS!ACCEPT CHAR; ! ACCEPT THE LAST CHAR -> REP CYCLE %FINISH D_HOLD == NULL P_LEN = 0!128; ! DONE+ACCEPT LAST TO 2900(RETURN CONTROL, NULL) D_N = 0 %IF D_ISO = 0 %THEN BSP_UFLAG = X'0500' %ELSE BSP_UFLAG = X'0100' !! SETS 2ND BYTE OF WORD !! ISO = 0, FLAG=5 => ISO, ISO # 0 => BINARY MES_LEN = N+2; !$E TO GATE(PUT OUTPUT, MES, 0) D_NC = D_NC+1 D_PERMIT = D_PERMIT-1 %IF D_PERMIT > 0 %THEN GET BUFFER(GET OP BLOCK) %END %ROUTINE WRITE TO AM1 %RECORD (MEF) %NAME MES %RECORD (BSPF) %NAME BSP %INTEGER N, MAX, CHAR, END, GATE REPLY, AM1 REPLY, STAT, F AM1 REPLY = 0; ! "NORMAL" REPLY %WHILE D_O STATE = ENABLD %CYCLE MES == D_HOLD %IF MES == NULL %THEN MES == POP(D_INP Q) %IF MES == NULL %THEN %EXIT !! TERMINATE WITH "NORMAL" (SHOULDNT HAPPEN) BSP == MES_BSP END = MES_LEN-2; !$E GATE REPLY = ENABLE INPUT; ! ALLOW NEXT TO GATE MAX = 0; F = 1; N = D_N; ! START OF BLOCK - D_N = 0 %IF N # 0 %THEN MAX = D_COUNT %AND F = 0; ! IN BLOCK ALREADY %CYCLE %CYCLE STAT = L_RXS %IF STAT&XOPL#0 %START AM1 REPLY = 64 D_HOLD == MES; ! RETAIN FOR RETRY -> AM1 REP %FINISH %IF STAT&READY # 0 %START !! L I M I T SENT AM1 REPLY = 2; ! LONG BLOCK D_N = N; D_COUNT = MAX D_HOLD == MES; ! RETAIN FOR LATER -> AM1 REP %FINISH %IF L_TXS&READY # 0 %THEN %EXIT %REPEAT %IF MAX = 0 %START %IF F = 0 %AND D_FACILITY = 12 %START F = 1 L_TXD = NL %CONTINUE %FINISH MAX = BSP_A(N) %IF MAX>127 %START; ! 2 BYTE LENGTH MAX = BSP_A(N+1) N = N+1 %FINISH N = N+1; ! IN BLOCK F = 0 %UNLESS MAX = 0; ! NASTY ZERO LENGTH %FINISH %IF N > END %START %IF BSP_TC & 4 # 0 %START AM1 REPLY = 4; ! CONDITION Y ! ON THE END OF FILE GATE REPLY = CLOSE CALL %IF MON#0 %THEN PRINTSTRING("CLOSE RECEIVED ") D_O STATE = IDLE %FINISH !! SEND GO AHEAD TO GATE(GATE REPLY, NULL, 0); ! ENABLE INPUT OR CLOSE CALL FREE BUFFER(MES) D_HOLD == NULL; D_N = 0 %IF D_INP Q_E == NULL %THEN ->AM1 REP %EXIT %FINISH %IF MAX # 0 %START L_TXD = BSP_A(N); N=N+1; MAX = MAX-1 %ELSE L_TXD = NL %REPEAT %REPEAT AM1 REP: P_LEN = AM1 REPLY TO 2900(RETURN CONTROL, NULL) %END !! R E A D M E S S A G E F R O M A M 1 %ROUTINE READ MESSAGE FROM AM1 %RECORDFORMAT MF(%INTEGERARRAY X(0:7)) %RECORDFORMAT MT1(%INTEGER A, B, %BYTEINTEGERARRAY C(0:11), %C %RECORD (MF) M) %RECORDFORMAT MT2(%INTEGER A, B, %RECORD (MF) M) %RECORD (MEF) %NAME MES %RECORD (BSPF) %NAME BSP %RECORD (LOGF) %NAME LOG %RECORD (MAF) %NAME M %INTEGER N, FLAG, SYM, CPOS, COUNT, T, STAT %INTEGER NODE, TERM, TYPE, STRM %RECORD (MT1) %NAME M1; %RECORD (MT2) %NAME M2 %RECORD (M2900F) %NAME M2900 %SWITCH HLM(1:5) D == D5; ! MESSAGES ON STREAM 5 M == D_HOLD %IF M == NULL %START PRINTSTRING("RJE: SEQ2! ") T = 0!128; -> REPLY %FINISH !! (CATER FOR PARTIAL BLOCK REC'D) N = D_N %IF N = 0 %THEN D_CPOS = 0 %CYCLE %CYCLE STAT = L_RXS %EXIT %IF STAT&(READY!XOPL) # 0 %REPEAT %IF STAT&XOPL # 0 %START; ! XOP GONE DOWN T = 64; ! SEND UNSUCCESSFULL PRINTSTRING("RJES: XOP D ") -> SKIP %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 PRINTSTRING("RJES: PARITY ") -> SKIP %FINISH %FINISH %IF STAT&COMM BIT # 0 %START T = 2!128 SKIP: D_N = N REPLY: P_LEN = T; ! LONG BLOCK+ACCEPT LAST TO 2900(RETURN CONTROL, NULL) %RETURN %FINISH %IF D_COUNT = D_ISO %THEN D_COUNT = -1 %IF D_COUNT = D_NC %THEN -> BADM D_COUNT = D_COUNT+1 M_A(N) = SYM; N = N+1 %IF N = 2 %START; ! Got the total length D_CPOS = M_A(1); ! MAX = 256 %UNLESS 5 < D_CPOS <= 256-18 %START BADM: PRINTSTRING("***RJES: MESSAGE FAILS -") WRITE(D_CPOS, 1); WRITE(D_COUNT, 1); WRITE(D_ISO, 1) WRITE(D_NC, 1); WRITE(TYPE, 1) PRINTSTRING(" ALL RJE MESSAGES LOST ") -> REPLY %FINISH %ELSE %IF N = D_CPOS %THEN -> EXIT3; ! Got the whole message %FINISH L_RXS = L_RXS!ACCEPT CHAR; ! ACCEPT THE LAST CHAR %REPEAT EXIT3: D_HOLD == NULL T = 0!128; ! NORMAL+ACCEPT LAST %IF D_COUNT # D_NC %START; ! Another message waiting GET BUFFER(GET OP BLOCK) %FINISH TYPE = M_A(3); ! MAX = 256 D_NODE = M_A(5); ! BSP Dependant D_TERM = M_A(6) ! POINTER = 8; ! FOR FUTURE USE M_M LEN = N %UNLESS 1 <= TYPE <= 5 %THEN ->BADM -> HLM(TYPE) HLM(1): ! Operator message REFORM MESSAGE(M) -> REPLY HLM(2): ! Request O/P Device Allocation D == GET FREE DES %IF D == NULL %START; ! FAILED M_A(10) = 0; M_A(11) = 0 %ELSE I = ALLOCATE STREAM(D, 1); ! ODD STREAM FOR PRINTER ETC D_O STATE = IDLE D_FACILITY = FACIL(M_A(8)) D_NODE = D5_NODE; D_TERM = D5_TERM M_A(10) = 1; M_A(11) = D_STREAM; ! Stream in two bytes MOVE IT: M_A(12) = 0 %FINISH M_A(1) = 12 M_M LEN = 12 M1 == M; M2 == M1 M2_M = M1_M; ! Move the 2900 message down buffer KICK 2900 MESSAGE(M) -> REPLY HLM(3): ! SPOOLR Reply to INPUT Device Request STRM = M_A(11)!(M_A(10)<<8) D == CON DESA(ALLOC(STRM)) %IF M_A(13) # 0 %START; ! Rejected P_PORT = D_PORT; ! SET UP P_PORT FOR DO REPM DO REPM(0); ! REJECT FLAG RETRIEVE(D) %FINISH !! A 'YES' WILL BE DEALT WITH WHEN THE 2900 DOES A !! 'CONNECT' TO THE PARTICULAR STREAM FREE BUFFER(M) -> REPLY HLM(4): ! SPOOLR REQUESTS DEALLOCATION STRM = M_A(9)!(M_A(8)<<8) D == CON DESA(ALLOC(STRM)) -> MOVE IT %IF D == D4; ! IE WAS ZERO! %IF MON # 0 %START WHO AND STATE PRINTSTRING(" DEALLOCATED ") %FINISH %IF D_O STATE = INPUT READY %OR D_O STATE = TIMING %C %OR D_O STATE = TRYING %START GET BUFFER(CONNECTING REPLY FAILED) %FINISH %IF D_O STATE = TRYING %START D_O STATE = ABORTED; ! WAIT FOR CONNECT RESPONSE D_NC = 99 %ELSE %IF D_OSTATE = CONNECT 1 %START P_PORT = D_PORT DO REPM(0); ! REJECT THE CONNECT %FINISH %IF D_O STATE > CONNECT 1 %START M_A(10) = 1; M_A(11) = 0; ! SEND FAILED (X OVER) -> MOVE IT %FINISH RETRIEVE(D) %FINISH M_A(10) = 0; M_A(11) = 0; ! SET FLAG = OK -> MOVE IT; ! SHIFT DOWN RECORD AND REPLY HLM(5): ! SPOOLR REQUESTS ROUTE 'GOODNESS' M_A(8) = 140-USERS-FEP WEIGHT -> MOVE IT %END !! W R I T E M E S S A G E T O A M 1 %ROUTINE WRITE MESSAGE TO AM1 %RECORD (MAOF) %NAME M %INTEGER N, MAX, END, AM1 REPLY, STAT D == D4; ! MESSAGES ON STREAM 4 AM1 REPLY = 4; ! "CONDITION Y" %CYCLE M == D_HOLD %IF M == NULL %THEN M == POP(D_INP Q) %AND D_CPOS = D_CPOS-1 %IF M == NULL %THEN %EXIT !! TERMINATE WITH "NORMAL" (SHOULDNT HAPPEN) N = D_N; ! START OF BLOCK - D_N = 0 %CYCLE %CYCLE STAT = L_RXS %IF STAT&XOPL#0 %START D_HOLD == M; ! RETAIN BUFFER FOR RETRY AM1 REPLY = 64; D_KILL = N; ->AM1 REP %FINISH %IF STAT&READY # 0 %START !! L I M I T SENT AM1 REPLY = 2; ! LONG BLOCK D_N = N; D_COUNT = MAX D_HOLD == M; ! RETAIN FOR LATER -> AM1 REP %FINISH %IF L_TXS&READY # 0 %THEN %EXIT %REPEAT %IF N >= M_M LEN %START FREE BUFFER(M) D_HOLD == NULL; D_N = 0; D_KILL = 0 %IF D_INP Q_E == NULL %THEN ->AM1 REP %EXIT %FINISH L_TXD = M_A(N); N=N+1 %REPEAT %REPEAT AM1 REP: P_LEN = AM1 REPLY TO 2900(RETURN CONTROL, NULL) %END ! %ROUTINE MON MES(%RECORD (MEF) %NAME MES) ! %INTEGER I, J, K, N ! %RECORD (BSP3F) %NAME BSP3 ! ! K = MES_LEN+8;! BSP3 == MES_BSP ! WRITE(K, 1);! SPACE;! SPACE ! J = 0 ! %CYCLE I = 0, 1, K-1 ! WRITE(BSP3_A(I), 1) ! J = J+1;! %IF J = 20 %THEN J = 0 %AND NEWLINE ! %REPEAT ! NEWLINE;! SELECT OUTPUT(0) ! %END %ENDOFPROGRAM