! FILE 'IBM2S' !********************* !* IBM1S/IBM1Y * !* DATE: 10.OCT.80 * !!!!!!!!!!!!!!!!!!!!!! !STACK = 140 %RECORDFORMAT XXF(%INTEGER DUMMY) %CONSTRECORD (XXF) %NAME NULL = 0 %CONTROL X'100001'; ! TRUSTED PROGRAM AND QUICK ! ROUTINE ENTRY AND EIS %CONSTSTRING (7) VSN = 'VSN001K' %BEGIN %PERMROUTINESPEC SVC(%INTEGER EP, R0, R1) %SYSTEMROUTINESPEC ALARM(%INTEGER TICKS) %SYSTEMROUTINESPEC LINKIN(%INTEGER SER) %RECORDFORMAT PARF(%INTEGER TYPE, %RECORD (XXF) %NAME B, %C %INTEGER LEN, FLAG) %EXTERNALROUTINESPEC DU11E(%RECORD (PARF) %NAME L) %EXTERNALROUTINESPEC DUP11E(%RECORD (PARF) %NAME B) %CONSTBYTEINTEGERNAME ID = K'160030' %CONSTINTEGER CU 3270 SER = 11 %RECORDFORMAT LINEF(%INTEGER LINE NO, STATE, ACTIVE, LINE TYPE, %C RX INT, TX INT, CRC FAIL, DM, BAD FR, %C RACK, TACK, O LEN, I RE TR, I TR, I RX, POLL RD, TERM CH, %C CU POLL, CURR DEV, SS0, SS1, SEL ADDR, %C MISSED POLL, TEXT EOT, MISSED RESP, PT, SCRIPT ID, OP ADDR, %C %RECORD (XXF) %NAME ADDRESS, %BYTEINTEGERARRAY B(0:10), %C %RECORD (PARF) M) %RECORDFORMAT LINE2F(%INTEGERARRAY A(0:30)) %RECORDFORMAT IBMF(%BYTEINTEGER F1, F2, F3, F4, F5, F6, F7) %RECORDFORMAT IBM2F(%BYTEINTEGERARRAY A(0:100)) %RECORDFORMAT PE(%BYTEINTEGER SER, REPLY, %INTEGER A, B, C) %RECORDFORMAT P2F(%BYTEINTEGER SER, REPLY, %C A1, A2, B1, B2, C1, C2) %RECORDFORMAT P3F(%BYTEINTEGER SER, REPLY, LINE, LINE TYPE, %C %RECORD (XXF) %NAME AD, %BYTEINTEGER RXINT, TXINT) %RECORDFORMAT BUFFF(%RECORD (BUFFF) %NAME B, %BYTEINTEGERARRAY %C A(0:1999)) %OWNRECORD (PARF) PAR %OWNRECORD (PE)P %OWNRECORD (P2F) %NAME P2 %OWNRECORD (P3F) %NAME P3 %INTEGER I, J %OWNINTEGER MON = 0; ! MONITOR PRINTING FLAG !! P R O T T O C U 3 2 7 0 %CONSTINTEGER HELLO = 1 %CONSTINTEGER SPECIFIC POLL = 3 %CONSTINTEGER GEN POLL = 4 %CONSTINTEGER PRE SELECT = 5 %CONSTINTEGER READ C = 7 %CONSTINTEGER WRITE C = 8 %CONSTINTEGER STOP POLL = 9 %CONSTINTEGER CONTINUE POLL = 10 ! C U 3 2 7 0 T O P R O T %CONSTINTEGER HELLO RESP = 2 %CONSTINTEGER SELECT RESP = 6 %CONSTINTEGER TEXT OUT = 11 %CONSTINTEGER STATUS OUT = 12 %CONSTINTEGER FINISHED POLL = 13 %CONSTINTEGER NULL READ = 14 %CONSTINTEGER FREE BUFF = 15 %CONSTINTEGER CLOSEDOWN = 16 !! C H A R V A L U E S %CONSTINTEGER DLE = X'10' %CONSTINTEGER EOT = X'37' %CONSTINTEGER STX = X'02' %CONSTINTEGER SOH = X'01' %CONSTINTEGER ETX = X'03' %CONSTINTEGER ETB = X'26' %CONSTINTEGER PERC = X'6C' %CONSTINTEGER RR = X'D9' %CONSTINTEGER READ MOD = X'F6' %CONSTINTEGER READ COMMAND = X'F2'; ! ILLEGAL %CONSTINTEGER COPY COMMAND = X'F7'; ! ILLEGAL !! T Y P E S FOR ROUTINE S E N D %CONSTINTEGER EOT M = 0, NAK M = 1, ACK0 M = 2, ACK1 M = 3 %CONSTINTEGER RVI M = 4 !! REPLIES FROM LINE HANDLER %CONSTINTEGER CUR = 0; ! CU ADDR OR CU POLL BLOCK %CONSTINTEGER NAK R = 1; ! NAK FROM LINE %CONSTINTEGER EOT R = 2 %CONSTINTEGER ACK0 R = 3 %CONSTINTEGER ACK1 R = 4 %CONSTINTEGER RVI R = 5 %CONSTINTEGER TTD R = 6 %CONSTINTEGER INITIALISE = 0; ! CALLS & REPLIES TO LINE HANDLER ROUTINES %CONSTINTEGER LINE INPUT = 1 %CONSTINTEGER LINE OUTPUT = 2 %CONSTINTEGER INPUT HERE = 3 %CONSTINTEGER OUTPUT DONE = 4 %OWNINTEGER INPUT EXP = 0 %OWNINTEGER COMM, ADD, SEG, CLOCK0 %RECORDFORMAT WDSE(%RECORD (IBMF) %NAME M, %INTEGER LEN) %RECORDFORMAT BPF(%RECORD (IBMF) %NAME M) %OWNRECORD (LINEF) L %OWNRECORD (LINE2F) %NAME L2 %OWNRECORD (IBM2F) IBM2 %OWNRECORD (IBMF) %NAME IBM %OWNRECORD (WDSE) ICURR %OWNRECORD (WDSE) %NAME IPOOL, IP2 %OWNRECORD (IBMF) OM %OWNRECORD (BPF) %NAME IM %OWNBYTEINTEGERARRAYNAME PBUFF %RECORDFORMAT R1F(%INTEGER X) %RECORDFORMAT R2F(%RECORD (IBMF) %NAME R) %RECORDFORMAT R3F(%BYTEINTEGERNAME B) %RECORDFORMAT R4F(%BYTEINTEGERARRAYNAME AN) %RECORD (R1F) R1; %RECORD (R2F) %NAME R2; %RECORD (R3F) %NAME R3 %RECORD (R4F) %NAME R4 %CONSTBYTEINTEGERNAME CHANGE OUT ZERO = K'160310' %CONSTINTEGER T3 SER = 21 %CONSTBYTEINTEGERNAME INT = K'160060' %RECORDFORMAT M1F(%INTEGER A, B, C, D, E, F) %RECORD (M1F) M1 %OWNRECORD (BUFFF) %ARRAY BUFF(0:1) %ROUTINE START INPUT PAR_TYPE = LINE INPUT; PAR_B == ICURR_M; PAR_LEN = ICURR_LEN %IF L_LINE TYPE = 0 %START DU11E(PAR) %ELSE %IF L_LINE TYPE = 1 %START DUP11E(PAR) %FINISH %END %ROUTINE WREPLY(%INTEGER COMM, FLAG) P_SER = CU 3270 SER; P_REPLY = ID P2_A1 = COMM; P2_A2 = L_LINE NO !! MONITOR(P) PON(P) %END %ROUTINE TELL PRINTSTRING("LNE"); PRINTSYMBOL(L_LINE NO+'0'); PRINTSYMBOL(':') %END %ROUTINE DUMP TELL; PRINTSTRING("BAD FR, DM, CRC, T EOT, M RESP") WRITE(L_BAD FR, 1); WRITE(L_DM, 1); WRITE(L_CRC FAIL, 1) WRITE(L_TEXT EOT, 1); WRITE(L_MISSED RESP, 1); NEWLINE TELL; PRINTSTRING("POLLS, I TR, IRX") WRITE(L_POLL RD, 1); WRITE(L_I TR, 1); WRITE(L_I RX, 1) NEWLINE %END %ROUTINE DISASTER(%INTEGER REASON, I, J) TELL; PRINTSTRING(" ******* DISASTER ********* ") WRITE(REASON, 1); WRITE(I, 5); WRITE(J, 5); NEWLINE L_STATE = 0 %END %ROUTINE FAULT(%INTEGER REASON, I, J) TELL; PRINTSTRING(" Protocol violation "); WRITE(REASON, 1) PRINTSTRING(", other info:"); WRITE(I,1); WRITE(J, 1) NEWLINE %IF MON # 0 %START SELECT OUTPUT(1) PRINTSTRING("FAULT "); WRITE(REASON, 1) WRITE(I, 1); WRITE(J, 1); NEWLINE SELECT OUTPUT(0) %FINISH L_STATE = 0 %END %ROUTINE HANDLE OUTPUT(%INTEGER TYPE, LEN) CLOCK0 = 0 %IF TYPE = 1 %START; ! MESSAGE IN L_B R3_B == L_B(0) PAR_B == R2_R %ELSE !! BLOCK IN IBM PAR_B == IBM L_I TR = L_I TR+1 %IF MON # 0 %START SELECT OUTPUT(1) TELL; PRINTSTRING("OUT:"); WRITE(L_STATE, 1) WRITE(LEN, 5); NEWLINE SELECT OUTPUT(0) %FINISH %FINISH L_ACTIVE = TYPE PAR_TYPE = LINE OUTPUT PAR_LEN = LEN PAR_FLAG = L_LINE NO %IF L_LINE TYPE = 0 %START DU11E(PAR) %ELSE %IF L_LINE TYPE = 1 %START DUP11E(PAR) %FINISH %END !! %ROUTINE SEND(%INTEGER TYPE) %CONSTBYTEINTEGERARRAY D(0:4) = X'37',X'3D',X'70',X'61',X'7C' %INTEGER LEN %IF TYPE < 2 %START L_B(0) = D(TYPE); LEN = 1 %ELSE L_B(0) = DLE; L_B(1) = D(TYPE); LEN = 2 %FINISH HANDLE OUTPUT(1, LEN) %IF MON # 0 %START %UNLESS L_STATE = 6 %AND TYPE = 0 %START SELECT OUTPUT(1) TELL; PRINTSTRING("SMA"); WRITE(L_STATE, 1); WRITE(TYPE, 1) NEWLINE SELECT OUTPUT(0) %FINISH %FINISH %END %ROUTINE SEND STATUS L_B(0) = SOH; L_B(1) = PERC; L_B(2) = RR; L_B(3) = STX L_B(4) = L_CU POLL; L_B(5) = L_CURR DEV L_B(6) = L_SS0; L_B(7) = L_SS1; L_B(8) = ETX HANDLE OUTPUT(1, 9) %END %ROUTINE SEND TEXT BLOCK !! REPEAT TRANSMISSION R3_B == PBUFF(L_PT); ! PBUFF SHOULD STAY MAPPED IBM == R2_R HANDLE OUTPUT(2, L_OLEN+2) L_I RE TR = L_I RE TR+1 %END %ROUTINE SEND NEXT TEXT BLOCK !! SETS TERM CH = ETX ON LAST BLOCK %INTEGER NPT, NLEN, ENDQ, I NPT = L_PT+L_OLEN+2; ! POSITION OF NEW LENGTH NLEN = PBUFF(NPT); ! PBUFF MAPPED BY "MAP BUFFER AND PREPARE" PBUFF(NPT) = STX ENDQ = PBUFF(NPT+NLEN+2) %IF ENDQ = 255 %THEN L_TERM CH=ETX %ELSE L_TERM CH=ETB PBUFF(NPT+NLEN+1) = L_TERM CH L_PT = NPT L_OLEN = NLEN R3_B == PBUFF(NPT) IBM == R2_R HANDLE OUTPUT(2, L_OLEN+2) L_I TR = L_I TR+1 %END %ROUTINE MAP BUFFER AND PREPARE %INTEGER X X = L_OP ADDR>>13 MAP VIRT(L_SCRIPT ID, X, 4) R1_X = K'100000'!L_OP ADDR&K'17777' PBUFF == R4_AN; ! THIS MAPS PBUFF TO TEXT ARRAY %END %ROUTINE FROM CU 3270 %SWITCH SW(HELLO RESP:CLOSEDOWN) %IF MON # 0 %START %UNLESS L_STATE = 6 %AND P2_A1=13 %START; ! NO POLL RESP SELECT OUTPUT(1) TELL; PRINTSTRING("CU:"); WRITE(L_STATE, 1); WRITE(P2_A1, 1) WRITE(L_CURR DEV, 1); WRITE(P2_B1, 1); NEWLINE SELECT OUTPUT(0) %FINISH %FINISH -> SW(P2_A1) SW(HELLO RESP): L_CU POLL = P2_B1; L_SEL ADDR = P2_C1 L_STATE = 0; ! ALLOW INPUT NOW SVC(18, 2, 0); ! SET TASK PRIORITY TO 2 %RETURN SW(TEXT OUT): L_CURR DEV = P2_B1; L_SCRIPT ID = P2_B2 %IF L_STATE = 4 %THEN L_STATE = 1;! NB: 'STATUS' NOT ALLOWED ON !! 'READ MODIFIED' %IF 1 # L_STATE # 6 %START FAULT(11, L_STATE, L_CURR DEV); %RETURN %FINISH L_OP ADDR = P_C L_PT = 0; L_O LEN = -2 L_STATE = L_STATE+2 MAP BUFFER AND PREPARE SEND NEXT TEXT BLOCK %RETURN SW(STATUS OUT): L_CURR DEV = P2_B1 %IF 1 # L_STATE # 6 %START FAULT(8, L_STATE, L_CURR DEV); %RETURN %FINISH L_STATE = L_STATE+1 L_SS0 = P2_C1; L_SS1 = P2_C2 SEND STATUS %RETURN SW(FINISHED POLL): %IF 1 # L_STATE # 6 %START FAULT(9, L_STATE, L_CURR DEV) %FINISH SEND(EOT M); L_STATE = 0 %RETURN SW(SELECT RESP): ! DEVICE ??? %IF L_STATE # 10 %START FAULT(10, L_STATE, L_CURR DEV) %RETURN %FINISH %IF P_B < 0 %START; ! STATUS PENDING SEND (RVI M); L_STATE = 0; %RETURN !! EXPECT AN 'EOT' RESPONSE, IT MAY BE NECESSARY TO USE !! STATE = 11 %FINISH SEND(ACK0 M) L_STATE = 9 %RETURN SW(NULL READ): ! IN RESPONSE TO A 'READ' WITH NO TEXT AVAILABLE L_B(0) = STX; L_B(1) = L_CURR DEV L_B(2) = X'E8'; L_B(3) = 0; L_B(4) = 0; L_B(5) = ETX L_TERM CH = ETX; ! GETS ACKED LIKE A TEXT BLOCK HANDLE OUTPUT(1, 6) L_STATE = 3 %RETURN SW(FREE BUFF): %IF L_STATE # 4 %START FAULT(13, L_STATE, L_CURR DEV); %RETURN %FINISH R1_X = P_C IP2 == R2_R IP2_M == IPOOL; IPOOL == IP2 INPUT EXP = INPUT EXP+1 L_STATE = 5 SEND(ACK0 M+L_TACK) L_TACK = L_TACK!!1 %RETURN SW(CLOSEDOWN): P_SER = ID; P_REPLY = 0; POFF(P) ALARM(5*50); ! ANOTHER 5 SECS P_SER = ID; P_REPLY = 0; POFF(P) !! WAIT FOR CLOCK DUMP %STOP %END %ROUTINE HANDLE INPUT %RECORD (IBMF) %NAME IBM %INTEGER FIRST, RESP, TYPE %SWITCH SW(0:12); ! STATE SWITCH %SWITCH STATUS RESPONSE(0:6) %SWITCH TEXT RESPONSE(0:6) IBM == PAR_B ! PAR_FLAG<0 BUFFER TOO SMALL %IF PAR_FLAG < 0 %START %IF PAR_FLAG = -3 %START L_CRC FAIL = L_CRC FAIL+1 SEND(NAK M) %ELSE %IF PAR_FLAG = -1 %START L_DM = L_DM+1 %ELSE %IF PAR_FLAG = -2 %START L_BAD FR = L_BAD FR+1 %FINISH %FINISH -> READ AGN %FINISH RESP = PAR_FLAG %IF MON # 0 %START %UNLESS L_STATE=0 %AND (RESP=0 %OR RESP=2) %START SELECT OUTPUT(1) TELL; PRINTSTRING("INP:"); WRITE(L_STATE, 1); WRITE(PAR_FLAG, 1) WRITE(L_CURR DEV, 1); NEWLINE SELECT OUTPUT(0) %FINISH %FINISH -> SW(L_STATE) SW(0): ! IDLE STATE %IF RESP = EOT R %THEN -> READ AGN %IF RESP = NAK R %THEN L_MISSED POLL = L_MISSED POLL+1 %AND ->READ AGN %IF RESP # CUR %START FAULT(1, L_STATE, RESP) -> READ AGN %FINISH L_STATE = 1; ! CU POLL RECD L_RACK = 1; L_TACK = 1; ! ACK 1 IS SENT ON 1ST,3RD ETC BLOCKS L_POLL RD = L_POLL RD+1 %IF IBM_F1 # IBM_F2 %THEN FAULT(2, IBM_F1, IBM_F2) %AND ->READ AGN %IF IBM_F3 # IBM_F4 %THEN FAULT(3, IBM_F3, IBM_F4) %AND -> READ AGN %IF IBM_F1 = L_SEL ADDR %START TYPE = PRE SELECT; L_STATE = 10 L_CURR DEV = IBM_F3 %ELSE %IF IBM_F1 # L_CU POLL %THEN %C FAULT(16, IBM_F1, IBM_F2) %AND -> READ AGN %IF IBM_F3 = X'7F' %START TYPE = GEN POLL; L_STATE = 6 %ELSE TYPE = SPECIFIC POLL %FINISH P2_B1 = IBM_F3 WREPLY(TYPE, 0) -> READ AGN SW(1): SW(6): SW(4): SW(10): %IF RESP = EOT R %THEN L_MISSED RESP=L_MISSED RESP+1 %ELSE %C FAULT(5, L_STATE, RESP); ! NB: FAULT FORCES STATE TO 0 -> READ AGN SW(2): ! SEND STATUS SW(7): ! .. .. IN RESPONSE TO GENERAL POLL -> STATUS RESPONSE(RESP) COMMAND SEQ: STATUS RESPONSE(0): TEXT RESPONSE(0): %IF IBM_F1 # STX %THEN %C FAULT(14, IBM_F1, L_CURR DEV) %AND -> READ AGN COMM = IBM_F3 L_STATE = 4; ! ALLWAYS TERMINATES GEN POLL %IF COMM = READ MOD %START WREPLY(READ C, 0) %ELSE R2_R == IBM P_C = R1_X; P_B = PAR_LEN WREPLY(WRITEC, 0) L_I RX = L_I RX+1 %FINISH -> READ AGN STATUS RESPONSE(NAK R): SEND STATUS; -> READ AGN STATUS RESPONSE(EOT R): DISASTER(1, L_STATE, RESP); -> READ AGN STATUS RESPONSE(ACK0 R): STATUS RESPONSE(ACK1 R): %IF L_RACK # RESP-ACK0 R %START TELL; PRINTSTRING("WRONG ACK") PRINTSYMBOL(RESP-ACK0 R+'0'); NEWLINE %FINISH LAST BLOCK: %IF 2 <= L_STATE <= 3 %START SEND(EOT M); L_STATE = 0 WREPLY(STOP POLL, 0) %ELSE WREPLY(CONTINUE POLL, 0) L_STATE = 6 %FINISH ->READ AGN TEXT RESPONSE(EOT R): ! NOT IN PROTOCOL !!! L_TEXT EOT = L_TEXT EOT+1 -> STOP THE POLL STATUS RESPONSE(RVI R): TEXT RESPONSE(RVI R): %IF L_STATE = 3 %OR L_STATE = 8 %START; ! IN TEXT MODE PBUFF(L_PT) = L_O LEN; ! RESTORE THE LENGTH %FINISH SEND (EOT M) STOP THE POLL: WREPLY(STOP POLL, 0); L_STATE = 0 -> READ AGN SW(3): ! SEND TEXT SW(8): ! .. .. IN RESPONSE TO GENERAL POLL -> TEXT RESPONSE(RESP) TEXT RESPONSE(NAK R): SEND TEXT BLOCK; -> READ AGN TEXT RESPONSE(ACK0 R): TEXT RESPONSE(ACK1 R): %IF L_RACK # RESP-ACK0 R %START TELL; PRINTSTRING("WRONG (T) ACK") PRINTSYMBOL(RESP-ACK0 R+'0'); NEWLINE %FINISH PBUFF(L_PT) = L_O LEN; ! PUT ORIGINAL LENGTH BACK %IF L_TERM CH = ETX %THEN -> LAST BLOCK SEND NEXT TEXT BLOCK; -> READ AGN SW(5): ! SENT ACK 0/1 IN RESPONSE TO COMMAND SEQ %IF RESP = 0 %THEN -> COMMAND SEQ %IF RESP = EOT R %THEN L_STATE = 0 %AND -> READ AGN %IF RESP = TTD R %THEN SEND(NAK M) %AND -> READ AGN FAULT(7, L_STATE, RESP) -> READ AGN SW(9): ! PRE SELECT, RRSPONDED ACK 0 %IF RESP = 0 %THEN -> COMMAND SEQ FAULT(15, L_STATE, RESP); -> READ AGN SW(12): ! WAITING FOR INITIAL RESPONSE FROM CU32 %IF RESP # EOT R %THEN SEND(EOT M) READ AGN: %IF %NOT IBM == NULL %AND %NOT IBM == L_M %START !! USE THE SAME ONE AGAIN %ELSE %IF INPUT EXP > 0 %START ICURR_M == IPOOL IPOOL == IPOOL_M; INPUT EXP = INPUT EXP-1 ICURR_LEN = 2000 %ELSE ICURR_M == L_M; ICURR_LEN = 6 %FINISH %FINISH START INPUT %END %ROUTINE CLOCK INT ALARM(25); !RESTART CLOCK CLOCK0 = CLOCK0+1 %END !! R2 == R1; R3 == R2; R4 == R3 IM == M1 L2 == L CHANGE OUT ZERO = T3 SER P2 == P; P3 == P2 P2_SER = 0; POFF(P2); ! WAIT FOR INSTRUCTIONS L_LINE NO = P3_LINE; L_LINE TYPE = P3_LINE TYPE L_ADDRESS == P3_AD L_RXINT = P3_RXINT!X'FF00'; L_TXINT = P3_TX INT!X'FF00' LINKIN(L_RXINT); LINKIN(L_TXINT) PAR_TYPE = INITIALISE PAR_B == L_ADDRESS PAR_FLAG = L_LINE NO %IF L_LINE TYPE = 0 %START DU11E(PAR) %ELSE %IF L_LINE TYPE = 1 %START DUP11E(PAR) %FINISH WREPLY(HELLO, 0) IPOOL == BUFF(0) BUFF(0)_B == BUFF(1) BUFF(1)_B == NULL INPUT EXP = 2 ALARM(25) ICURR_M == IPOOL; ! GET A BUFFER IPOOL == IPOOL_M; ! RELINK FREE LIST INPUT EXP = INPUT EXP-1 ICURR_LEN = 2000 START INPUT L_STATE = 12; ! IGNORE I/P UNTIL CU32 REPLIES %CYCLE P_SER = 0 POFF(P) %IF P_SER&X'80' # 0 %START; ! INTERRUPT %IF P_SER = L_TX INT&X'FF' %THEN I = OUTPUT DONE %ELSE %C I = INPUT HERE PAR_TYPE = I %IF L_LINE TYPE = 0 %START DU11E(PAR) %ELSE %IF L_LINE TYPE = 1 %START DUP11E(PAR) %FINISH %IF PAR_TYPE = LINE OUTPUT %START L_ACTIVE = 0 %ELSE HANDLE INPUT %FINISH CLOCK0 = 0 %CONTINUE %FINISH %IF P_REPLY = 0 %START CLOCK INT; ! CLOCK INTERRUPT %IF INT = '?' %START INT = 0 WRITE(INPUT EXP, 4); WRITE(CLOCK0,4) NEWLINE DUMP %FINISH %IF INT = 'T' %START INT = 0 TELL %CYCLE I = 0, 1, 29 WRITE(L2_A(I), 4) %IF I&7 = 0 %THEN NEWLINE %AND TELL %REPEAT NEWLINE %FINISH %IF 'M'<=INT<='O' %THEN MON=INT-'0' %AND INT = 0 %IF INT = 'T' %START INT = 0 PROMPT("DATA?") %CYCLE I = 0, 1, 100 READ(J) %EXIT %IF J < 0 IBM2_A(I) = J %REPEAT P_B = I; IBM == IBM2 HANDLE OUTPUT(2, I) %FINISH %CONTINUE %FINISH !! USER REQUEST !! MONITOR(P) FROM CU 3270 %REPEAT %ENDOFPROGRAM %REPEAT