!********************************
!* EMAS-2900 FEP ITP SERVER *
!* FILE: ITPS7/ITPS7Y *
!* DATE: 30.APR.80 16.10 *
!********************************
!MODIFIED FOR RING USING BYTE STREAM PROTOCOL INSTEAD OF NSI
!
!! STACK SIZE = 500
%SYSTEMROUTINESPEC MAP HWR(%INTEGER SEG)
%RECORDFORMAT DMF(%INTEGER I)
%CONSTRECORD (DMF) %NAME NULL = 0
%CONTROL K'100001'
%BEGIN
%CONSTSTRING (7)VSN = 'VSNK07O'
%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 = 46
!START WITH 64
!BUFF MAN TAKES 4
!BSP TAKES 8
!ITP TAKES 4
!FOR LUCK 2
!LEAVES 46
%CONSTINTEGER BIG BLOCK MAX = 127; ! < 256 !
%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, %RECORD (ITPF) ITP)
%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, %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
%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'
%CONSTINTEGERNAME 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 = 1; ! 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
%CONSTINTEGER TCP LIMIT = 15; ! INCREASE CON STATEA AS WELL !!!!!!!
%OWNRECORD (TCPF) %ARRAY TCPA(0:TCP LIMIT)
%OWNRECORD (TCPF) %NAME TCP
%OWNINTEGER TCPN
%CONSTBYTEINTEGERARRAY MAX CONS(1:TCP LIMIT) = 80, 49(0)
!! MAX NO OF CONSOLES (LOOK AT "FIXED TCP")
%OWNRECORD (CONS STATEF) %ARRAY CON STATEA(0:767)
%OWNRECORD (CONS STATEF) %NAME CON STATE
%OWNRECORD (CON DESF) %NAME D
%CONSTINTEGER CON LIM = 63; ! NUMBER OF ACTIVE TERMINALS
%OWNRECORD (CON DESF) %ARRAY CON DESA(0:CON LIM)
%OWNRECORD (QF) 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 LIMIT = 1; ! 'FUNNY TCP' LIMIT
%CONSTBYTEINTEGERARRAY FIXED TCP(1:FIXED LIMIT) = 44
! TERM NO OF BUILT IN TCP
%OWNRECORD (QF) %NAME BUFFER POOL
%OWNINTEGER NO OF BUFF = 0
%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
%INTEGER I, N
!**********************************************
!* INITIALISATION *
!**********************************************
CHANGE OUT ZERO = T3 SER
R2 == R1; P2 == P
%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 CONS(I)
%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 'M' <= INT <= 'P' %START
MON = INT-'O'; INT = 0
%FINISH
%IF INT = '?' %START; ! $$ MON
INT = 0
WRITE(NO OF BUFF, 4); NEWLINE
%CYCLE I = 1, 1, TCP LIMIT
TCP == TCPA(I)
%IF TCP_STATE = CONNECTED %START
WRITE(TCP_TERM, 3); WRITE(TCP_MAX, 2)
NEWLINE
TCP_MAX = 0
%FINISH
%REPEAT
%FINISH
%IF 'X'<=INT<='Y' %THEN LOSE OP=INT-'Y' %AND INT = 0
%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
%IF TCP_STATE # CONNECTED %START; ! THROW AWAY
FREE BUFFER(MES); %RETURN
%FINISH
%IF TCP_OSTATE # IDLE %START
PUSH(TCP_OUTQ, MES)
TCP_SIZE = TCP_SIZE+1
TCP_MAX = TCP_SIZE %IF TCP_SIZE>TCP_MAX
%RETURN
%FINISH
TCP_OSTATE = BUSY
%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 %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
%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 TCPN <= FIXED LIMIT %START
%IF FIXED TCP(TCPN) = P_LEN %START
TCP == TARG; %EXIT
%FINISH
%ELSE
%IF TARG_STATE = NOT ALLOCATED %THEN TCP == TARG
%FINISH
%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
PRINTSTRING(' ITP: T')
WRITE(P_LEN, 1); PRINTSTRING(' CONNECTED
')
TCP_MAX = 0; ! FOR MONITORING
%FINISH
TO GATE(CALL REPLY, NULL, FLAG)
%RETURN
FNS(INPUT RECD):
MES == P_MES; ! HOLD FOR POSSIBLE FREEING
TO GATE(ENABLE INPUT, NULL, 0)
%IF P_LEN=0 %START
FREEBUFFER(MES)
%RETURN
%FINISH
%IF MON # 0 %START
SELECT OUTPUT(1)
PRINTSTRING("II "); MON MES(MES)
%FINISH
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_OSTATE = IDLE
%UNLESS TCP_OUTQ_E == NULL %START
TCP_SIZE = TCP_SIZE-1
TO GATE(PUT OUTPUT, POP(TCP_OUTQ), 0)
%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
PRINTSTRING(' T'); WRITE(TCP_TERM, 1)
PRINTSTRING(" CONNECTION ")
%IF TYPE = ABORT CALL %THEN PRINTSTRING("ABORTED") %ELSE %C
PRINTSTRING("CLOSED")
WRITE(TCP_MAX, 1); NEWLINE
LOSE CONSOLES(-1)
TCP_STATE = NOT ALLOCATED
TO GATE(TYPE, NULL, 0)
%WHILE %NOT TCP_OUTQ_E == NULL %CYCLE
FREE BUFFER(POP(TCP_OUTQ))
%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 CONS(TCP_TCPN)-1 %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
!! CNSL > LIMIT ???????????
%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 %THEN %C
GET O BLOCK
%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)>4 %THEN LENGTH(ITP_S) = 4
!! SHOULD BE > 7
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; !CHARS TRANSFERRED FROM THIS BUF
%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
%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 STREAM = P2_STR
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
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
%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 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 %THEN GET BUFFER(SEND TEXT MARKER)
!! AN 'ABORTING' HAS BEEN DONE
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
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
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 IT BSP NOW
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)
%ELSE
L REPLY = M2900_P3B
FREE BUFFER(M2900)
%IF D_STATE # LOGGING ON %START
PRINTSTRING('BAD LOGIN REPLY, STATE =')
WRITE(D_STATE, 1); NEWLINE
%FINISH
GET BUFFER(SEND LOGIN REPLY+L REPLY)
%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_OPOS<D_OLIM %AND %NOT D_OPOS<D_OTRIG<=D_OLIM) %C
%OR %C
(D_OPOS>D_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
GET BUFFER(LOW LEVEL OP TRANSFER)
%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, 24, 29, 35, 36, 40, 62, 62,
113, 135, 156, 182, 203(3), 80, 99, 103, 107
!! PT TO ITP MESS
%CONSTBYTEINTEGERARRAY ITP MESSAGE(1:223) =
8, 2, K'146', 5, 'U', 'S', 'E', 'R', ':',; ! NAME PROMPT
8, 0, K'246', 5, 'P', 'A', 'S', 'S', ':',; ! PASS PROMPT
4, 1, 2, 1, 1,; ! ECHO ON
4, 3, 2, 1, 0,; ! ECHO OFF+GO AHEAD
5, 0, 2, 2, 13, NL,; ! NL
0,; ! NOT USED
3, 5, 0, 0,; ! DISCONNECT
21, 0, 2, 18, 'L', 'O', 'G', 'O', 'N',; ! LOGON SUCCESSFUL
' ', 'S', 'U', 'C', 'C', 'E', 'S', 'S', 'F',
'U', 'L', 13, NL,
17, 0, 2, 14, 'I', 'N', 'V', 'A', 'L', 'I',
'D', ' ', 'N', 'A', 'M', 'E', 13, NL,; ! INVALID NAME
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
21, 0, 2, 18, 'I', 'N', 'V', 'A', 'L', 'I',
'D', ' ', 'P', 'A', 'S', 'S', 'W', 'O',
'R', 'D', 13, NL,; ! INVALID PASSWORD
20, 0, 2, 17, 'P', 'R', 'O', 'C', 'E', 'S',
'S', ' ', 'R', 'U', 'N', 'N', 'I', 'N',
'G', 13, NL,; ! PROCESS RUNNING
26, 0, 2, 23, 'C', 'A', 'N', 'N', 'O', 'T',
' ', 'S', 'T', 'A', 'R', 'T', ' ', 'P',
'R', 'O', 'C', 'E', 'S', 'S', 13, NL,; ! CANNOT START PROCESS
20, 0, 2, 17, 'F', 'I', 'L', 'E', ' ', 'I',
'N', 'D', 'E', 'X', ' ', 'F', 'U', 'L',
'L', 13, NL,; ! FILE INDEX FULL
20, 0, 2, 17, 'N', 'O', ' ', 'U', 'S', 'E',
'R', ' ', 'S', 'E', 'R', 'V', 'I', 'C',
'E', 13, NL; ! NO USER SERVICE
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
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 CONS(TCP_TCPN)-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 NOT CATERED FOR
GET BUFFER(SEND THE CHOP)
%ELSE
%UNLESS D_STATE >= LOGGING ON %THEN %C
RETRIEVE(D); ! MAY RE-CLAIM IMMEDIATELY
%FINISH
%FINISH
%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; 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!!!
!! ASSUMES THAT _SUFL IS INITIALLY ZERO (SEE BSP SPEC)
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
%UNTIL CHAR # CR %CYCLE
CHAR = IT_A(N)
N = N+1
%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