%CONSTSTRING (7) VSN = "VSNKB8S"
!********************************
!* EMAS-2900 FEP RJE SERVER *
!* FILE: RJES8/RJES8Y *
!* DATE: 18.SEP.80 *
!* 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, %C
%BYTEINTEGERARRAY A(0:239))
%RECORDFORMAT BSPF(%INTEGER ST,DS,RC,TC, %C
%BYTEINTEGER UFLAG, %BYTEINTEGERARRAY A(0:242))
%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 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 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 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' %START
WHO AND STATE; NEWLINE
PRINTSTRING("***RJE FAILS-PLEASE DUMP
")
%CYCLE; %REPEAT
%FINISH
%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' %START
WHO AND STATE; NEWLINE
PRINTSTRING("***RJES:FAILED - PLEASE DUMP
")
%CYCLE; %REPEAT
%FINISH
%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
%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
%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
TRM = P_LEN;
SSMESSAGE == P_MES_BSP; FAC = P_S1
%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 = 0; 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
D_O STATE = IDLE
%IF HOST STATE = DOWN %THEN RETRIEVE(D)
%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_O STATE = ABORTED
%FINISH
%RETURN
%FINISH
%IF FLAG # 0 %START
%IF D_NC = 0 %START
%IF MON # 0 %START
TELL; PRINTSTRING("CONNECT FAILED"); WRITE(FLAG, 1)
NEWLINE
%FINISH
%FINISH
%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(5) = USERS
BSP4_A(6) = HOST STATE
BSP4_A(7) = CPU; BSP4_A(8) = PKTS; BSP4_A(9) = SBR
BSP4_A(10) = BYT; BSP4_A(11) = RJEO
BSP4_A(12) = RJEI
P_MES_LEN=16
-> 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
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
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 = 5; ! SET ISO MODE
%IF D_ISO # 0 %THEN BLOCK TYPE = 1
LEN = D_N+1
%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
PRINTSTRING("***RJE: BAD TIDY - DUMP IT
")
%CYCLE; %REPEAT
%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) = 0; M_A(6) = SSMESSAGE_ST
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
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+9; ! 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 = 5 %ELSE BSP_UFLAG = 1
!! ISO = 0, FLAG=5 => ISO, ISO # 0 => BINARY
MES_LEN = N+1
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-1
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:4)
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; -> 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:
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 %START
PRINTSTRING("***RJES: MESSAGE OVERRUN -")
PRINTSTRING(" ALL RJE MESSAGES LOST
")
-> REPLY
%FINISH
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
%IF D_CPOS > 256-18 %START
PRINTSTRING("***RJES: MESSAGE TOO LONG -")
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
-> 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 = IDLE; ! WAIT FOR CONNECT RESPONSE
%ELSE
%IF D_OSTATE = CONNECT 1 %START
P_PORT = D_PORT
DO REPM(0); ! REJECT THE CONNECT
%FINISH
RETRIEVE(D)
%FINISH
M_A(10) = 0; M_A(11) = 0; ! SET FLAG = OK
-> MOVE IT; ! SHIFT DOWN RECORD AND REPLY
%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