!* MODIFIED 07/06/79
!*
!*
%EXTERNALINTEGER ICL9CEFAC=4
!*
!*
%INTEGERFNSPEC IOCP(%INTEGER I,J)
%ROUTINESPEC SIGNAL(%INTEGER EP,P1,P2,%INTEGERNAME F)
!*
%EXTERNALROUTINESPEC ICL9CENVINIT(%INTEGER I,J,%ROUTINE TIDY PROC)
%EXTERNALROUTINESPEC ICL9CEDIAGOUT(%INTEGER AD,LEN)
%SYSTEMROUTINESPEC SGNL(%INTEGER EP,P1,P2,%INTEGERNAME F)
%SYSTEMINTEGERFNSPEC STRMIO(%INTEGER EP,STREAM,%INTEGERNAME AFD)
%SYSTEMINTEGERMAPSPEC COMREG(%INTEGER N)
%SYSTEMROUTINESPEC SSERR(%INTEGER I)
!*
%OWNINTEGER INFD
%OWNINTEGER INREQFD
%OWNINTEGER OUTFD
%OWNINTEGER OUTREQFD
!*
!*
%RECORDFORMAT NRFDFMT(%INTEGER LINK,DSNUM, %C
%BYTEINTEGER STATUS, ACCESS ROUTE, VALID ACTION, CUR STATE, %C
%BYTEINTEGER MODEOFUSE, MODE, FILE ORG, DEV CLASS, %C
%BYTEINTEGER REC TYPE, FLAGS, LM, RM, %C
%INTEGER ASVAR, AREC, RECSIZE, MINREC, MAXREC, MAXSIZE,ROUTECCY, %C
%LONGINTEGER ACCESS1,ACCESS2, %C
%INTEGER TRANSFERS,DARECNUM, %C
%LONGINTEGER REC CCY,FILE CCY,SPARE, %C
%STRING(31) IDEN)
!*
!*
%CONSTBYTEINTEGERARRAY ITOETAB(0 : 255) = %C
0,
1, 2, 3, 55, 45,
46, 47, 22, 5, 21,
11, 12, 13, 14, 15,
16, 17, 18, 19, 60,
61, 50, 38, 24, 25,
63, 39, 28, 29, 30,
31, 64, 79, 127, 123,
91, 108, 80, 125, 77,
93, 92, 78, 107, 96,
75, 97, 240, 241, 242,
243, 244, 245, 246, 247,
248, 249, 122, 94, 76,
126, 110, 111, 124, 193,
194, 195, 196, 197, 198,
199, 200, 201, 209, 210,
211, 212, 213, 214, 215,
216, 217, 226, 227, 228,
229, 230, 231, 232, 233,
74, 224, 90, 95, 109,
121, 129, 130, 131, 132,
133, 134, 135, 136, 137,
145, 146, 147, 148, 149,
150, 151, 152, 153, 162,
163, 164, 165, 166, 167,
168, 169, 192, 106, 208,
161, 7, 32, 33, 34,
35, 36, 37, 6, 23,
40, 41, 42, 43, 44,
9, 10, 27, 48, 49,
26, 51, 52, 53, 54,
8, 56, 57, 58, 59,
4, 20, 62, 225, 65,
66, 67, 68, 69, 70,
71, 72, 73, 81, 82,
83, 84, 85, 86, 87,
88, 89, 98, 99, 100,
101, 102, 103, 104, 105,
112, 113, 114, 115, 116,
117, 118, 119, 120, 128,
138, 139, 140, 141, 142,
143, 144, 154, 155, 156,
157, 158, 159, 160, 170,
171, 172, 173, 174, 175,
176, 177, 178, 179, 180,
181, 182, 183, 184, 185,
186, 187, 188, 189, 190,
191, 202, 203, 204, 205,
206, 207, 218, 219, 220,
221, 222, 223, 234, 235,
236, 237, 238, 239, 250,
251, 252, 253, 254, 255
%CONSTBYTEINTEGERARRAY ETOITAB(0 : 255) = %C
0,
1, 2, 3, 156, 9,
134, 127, 151, 141, 142,
11, 12, 13, 14, 15,
16, 17, 18, 19, 157,
10, 8, 135, 24, 25,
146, 143, 28, 29, 30,
31, 128, 129, 130, 131,
132, 133, 23, 27, 136,
137, 138, 139, 140, 5,
6, 7, 144, 145, 22,
147, 148, 149, 150, 4,
152, 153, 154, 155, 20,
21, 158, 26, 32, 160,
161, 162, 163, 164, 165,
166, 167, 168, 91, 46,
60, 40, 43, 33, 38,
169, 170, 171, 172, 173,
174, 175, 176, 177, 93,
36, 42, 41, 59, 94,
45, 47, 178, 179, 180,
181, 182, 183, 184, 185,
124, 44, 37, 95, 62,
63, 186, 187, 188, 189,
190, 191, 192, 193, 194,
96, 58, 35, 64, 39,
61, 34, 195, 97, 98,
99, 100, 101, 102, 103,
104, 105, 196, 197, 198,
199, 200, 201, 202, 106,
107, 108, 109, 110, 111,
112, 113, 114, 203, 204,
205, 206, 207, 208, 209,
126, 115, 116, 117, 118,
119, 120, 121, 122, 210,
211, 212, 213, 214, 215,
216, 217, 218, 219, 220,
221, 222, 223, 224, 225,
226, 227, 228, 229, 230,
231, 123, 65, 66, 67,
68, 69, 70, 71, 72,
73, 232, 233, 234, 235,
236, 237, 125, 74, 75,
76, 77, 78, 79, 80,
81, 82, 238, 239, 240,
241, 242, 243, 92, 159,
83, 84, 85, 86, 87,
88, 89, 90, 244, 245,
246, 247, 248, 249, 48,
49, 50, 51, 52, 53,
54, 55, 56, 57, 250,
251, 252, 253, 254, 255
!*
!*
!*
%SYSTEMROUTINE ASUPPORT(%INTEGER N)
%INTEGER I
I=IOCP(11,0);! FORCE OUT ANY RECORD IN BUFFER
%END;! ASUPPORT
!*
%EXTERNALROUTINE ICL9CEAJINIT
%INTEGER I
INFD=0
OUTFD=-1
ICL9CENVINIT(1,0,ASUPPORT)
I=IOCP(11,-1);! INITIALISE IOCP
%END;! ICL9CEAJINIT
!*
!*
!*
!*
%SYSTEMROUTINE SIM2(%INTEGER EP, R1, R2, %INTEGERNAME R3)
%INTEGERFNSPEC SELECTIO(%INTEGER MODE, STREAM, %INTEGERNAME MARGINS)
%OWNINTEGER EMNL = X'190A0000'
%INTEGER I,J,K,L
%INTEGER AFD
%LONGINTEGER DR
%RECORDNAME F(NRFDFMT)
%SWITCH ENTRY(0 : 17)
-> ENTRY(EP)
!***************************************************************
ENTRY(0): ! READ A RECORD FROM CURR SELECTED I/P STREAM
! R1 = ADDR(BUFFER) (@ 160 BYTE BUFFER)
! R2 (REDUNDANT)
! ON EXIT R3=LENGTH
%IF INFD=0 %THEN SELECT INPUT(108)
AFD=INFD
F==RECORD(AFD)
EP0A: DR=F_REC CCY
*PRCL_4
*LSS_AFD
*SLSS_1
*ST_%TOS
*LD_DR
*RALN_7
*CALL_(%DR)
*ST_I
%IF I>0 %THENSTART;! REPORT EOF
BYTEINTEGER(R1)=25
BYTEINTEGER(R1+1)=10
R3=2
%RETURN
%FINISH
I=F_RECSIZE
%IF I>160 %THEN I=160
J=F_AREC
%IF I>0 %THENSTART;! COPY AND TRANSLATE
K=X'18000000'!I
*LSS_J
*LUH_K
*LDTB_K
*LDA_R1
*MV_%L=%DR;! MOVE(I,J,R1)
J=X'18000100'
L=ADDR(ETOITAB(0))
*LSS_L
*LUH_J
*LDTB_K
*LDA_R1
*TTR_%L=%DR;! ETOI(R1,I)
%FINISH
BYTEINTEGER(R1+I)=NL
R3=I+1
%RETURN
!*
!*
!***************************************************************
ENTRY(1): ! WRITE A RECORD
! R1 = ADDR(BUFFER)
! R2 = LENGTH
! FIRST CHAR IS CONTROL CR,NL,NP
%IF OUTFD=-1 %THENSTART;! FIRST CALL ON DEFAULT OUTPUT
OUTFD=0
SIM2(15,1,109,I)
%FINISH
AFD=OUTFD
F==RECORD(AFD)
EP1A: R1=R1+1
R2=R2-1;! IGNORE CONTROL CHAR BY DEFAULT
%IF R2<=0 %THENSTART
BYTEINTEGER(R1)=' '
R2=1
%FINISH
%IF OUTFD=0 %THENSTART
ICL9CEDIAGOUT(R1,R2)
%FINISHELSESTART
DR=F_REC CCY
*PRCL_4
*LSS_AFD
*SLSS_R1
*SLSS_R2
*ST_%TOS
*LD_DR
*RALN_8
*CALL_(%DR)
*ST_I
%IF I#0 %THEN SSERR(I)
%FINISH
%RETURN
!*
!*
!**************************************************************
ENTRY(2): ! READ A RECORD FROM STREAM R3
I=SELECTIO(0,R3,J)
%IF I>0 %THEN SSERR(I)
F==RECORD(J)
->EP0A
!*
!**********************************************************************
ENTRY(3): ! WRITE A RECORD ON STREAM R3
%IF OUTFD=-1 %THENSTART
OUTFD=0
SIM2(15,1,109,I)
%FINISH
I=SELECTIO(1,R3,J)
%IF I>0 %THEN SSERR(I)
! %IF J=X'184' %THEN ->LOGOUT
F==RECORD(J)
->EP1A
!*
!*************************************************************
ENTRY(15): ! SELECT INPUT-OUTPUT STREAM
%IF R2=100 %OR R2=107 %THENSTART
OUTFD=0
COMREG(23)=0
R3=X'184'
%RETURN
%FINISH
I=SELECTIO(R1,R2,R3)
%IF I>0 %THENSTART
! %UNLESS R2=109 %AND I=152 %AND INITMODE#0 %THEN SSERR(I)
SSERR(I)
%FINISH
%RETURN
!*****************************************************************
ENTRY(16): ! SET MARGINS
%IF R1 = 0 %THEN F == RECORD(INREQFD) %C
%ELSE F == RECORD(OUTREQFD)
F_LM = (R2>>8)&X'FF'
F_RM = R2&X'FF'
%RETURN
!*****************************************************************
ENTRY(17): ! CLOSE STREAM
! R1 = STREAM
%IF R1 = COMREG(22) %OR R1 = COMREG(23) %THEN SSERR(29)
! STREAM IN USE
I=STRMIO(2,R1,AFD)
%IF I>0 %THEN SSERR(I)
R3 = 0
%RETURN
!***** *****
%INTEGERFN SELECTIO(%INTEGER MODE, STREAM, %INTEGERNAME MARGINS)
!**** ***
! STREAM=STREAM NUMBER TO BE SELECTED
! MODE=0 FOR READ,1 FOR WRITE
!**** ***
%RECORDNAME F(NRFDFMT)
%INTEGER I, AFD, AMODE
%INTEGER REQST, REQFD
AMODE=MODE
MODE=MODE&1
%UNLESS 0<STREAM<=109 %THEN %RESULT=24
REQST = STREAM
REQFD = 0
START:
%IF (MODE=0 %AND INFD<=0) %OR %C
(MODE=1 %AND OUTFD<=0) %THEN ->LOOK
%IF STREAM = COMREG(22+MODE) %THENSTART
%IF REQFD = 0 %THENSTART
%IF MODE = 0 %THEN REQFD = INFD %C
%ELSE REQFD = OUTFD
%FINISH
%IF 2<=EP<=3 %THEN MARGINS=REQFD %AND %RESULT=0
-> M1AND132
%FINISH
LOOK: I=STRMIO(MODE,STREAM,AFD)
%IF I>0 %THENSTART
%UNLESS I=24 %THEN %RESULT=I
%IF STREAM=104 %AND MODE=0 %THEN INFD=0 %AND ->M1AND132
%IF AMODE>=2 %AND STREAM+AMODE=4 %THEN %C
STREAM=110-STREAM %AND -> LOOK
%IF 98<=STREAM<=99 %THEN STREAM=STREAM+10 %AND ->LOOK
%IF 2<=EP<=3 %THENSTART;! ALGOL(J) DEFAULTS
! %IF STREAM=40 %THEN STREAM=108 %AND ->LOOK
! %IF STREAM=30 %THEN STREAM=99 %AND ->LOOK
%FINISH
%RESULT=24;! STREAM NOT DEFINED
%FINISH
F == RECORD(AFD)
%IF REQFD = 0 %THEN REQFD = AFD
%IF F_ACCESS ROUTE = 6 %THENSTART
STREAM = F_ASVAR
-> START
%FINISH
%IF F_FLAGS&3+MODE=2 %THEN %RESULT=29;! STREAM IN ALTERNATE USE
F_FLAGS = F_FLAGS!(1<<MODE)
%IF 2<=EP<=3 %THEN MARGINS=AFD %AND %RESULT=0 ;! FOR ALGOL(J)
MARGINS:
%IF MODE = 0 %THENSTART
INREQFD = REQFD
INFD=AFD
%FINISHELSESTART
OUTREQFD=REQFD
OUTFD=AFD
%FINISH
COMREG(22+MODE) = REQST
M1AND132:MARGINS=X'184'
%RESULT=0
%END; ! SELECTIO
%END; ! SIM2
!*
!* MODIFIED 10/08/77 08.00
!*
%OWNINTEGER INMARG1=1, INMARG2=72, OUTMARG1=1, OUTMARG2=120
%OWNINTEGER CONTROL=1;! 0 INCLUDE CONTROL CHARS IN LENGTH,1 EXCLUDE
%OWNBYTEINTEGERARRAY INPUTBUFF(0:160)
%OWNBYTEINTEGERARRAY RCHBUFF(0:160)
%OWNINTEGER PTR=1
%CONSTBYTEINTEGERARRAY OTRTAB(0:127)=%C
26(10),10,26(14),25,26,26(5),
32,33,34,35,36,37,38,39,40,41,42,43,44,45,46,47,
48,49,50,51,52,53,54,55,56,57,58,59,60,61,62,63,
64,65,66,67,68,69,70,71,72,73,74,75,76,77,78,79,
80,81,82,83,84,85,86,87,88,89,90,91,92,93,94,95,
96,97,98,99,100,101,102,103,104,105,106,107,108,109,
110,111,112,113,114,115,116,117,118,119,
120,121,122,123,124,125,126,26;
%CONSTBYTEINTEGERARRAY ITRTAB(0:255)=%C
X'80'(10),10,X'80'(14),25,26,X'80'(5),
32,33,34,35,36,37,38,39,40,41,42,43,44,45,46,47,
48,49,50,51,52,53,54,55,56,57,58,59,60,61,62,63,
64,65,66,67,68,69,70,71,72,73,74,75,76,77,78,79,
80,81,82,83,84,85,86,87,88,89,90,91,92,93,94,95,
96,97,98,99,100,101,102,103,104,105,106,107,108,109,
110,111,112,113,114,115,116,117,118,119,
120,121,122,123,124,125,126,X'80'(129);
%OWNBYTEINTEGERARRAY OUTPUTBUFF(0:133)=10,0(133)
%OWNINTEGER OUTPTR=1
%OWNINTEGER NLFLAG=1
%OWNINTEGER SUBCHAR=0
%OWNINTEGER EMFLAG=0
%ROUTINESPEC OUTPUTRECORD
%SYSTEMINTEGERFN IOCP(%INTEGER EP, N)
%INTEGER FLAGS, FLAG, I, LENGTH, X, Q, L, CH, F
%SWITCH SW(1:22)
%UNLESS 1<=EP<=22 %THEN SIGNAL(2,148,0,FLAG) %AND %STOP
->SW(EP)
SW(1): ! READ SYMBOL(X)
%IF NLFLAG=1 %THEN X=IOCP(6,0) %AND NLFLAG=0
%UNTIL X#X'80' %CYCLE
X=INPUTBUFF(PTR)
PTR=PTR+1
%REPEAT
%IF X=NL %THEN NLFLAG=1
%RESULT=X
SW(2): ! X=NEXT SYMBOL
%IF NLFLAG=1 %THEN X=IOCP(6,0) %AND NLFLAG=0
%WHILE INPUTBUFF(PTR)=X'80' %THEN PTR=PTR+1
%RESULT=INPUTBUFF(PTR)
SW(3): ! PRINT SYMBOL(N)
%IF N=10 %THEN ->OUTPUT
OUTPUTBUFF(OUTPTR)=OTRTAB(N&X'7F')
OUTPTR=OUTPTR+1
%IF OUTPTR>OUTMARG2 %THENSTART
OUTPUTBUFF(OUTPTR)=10
OUTPUTRECORD
%FINISH
END1: %RESULT=0
SW(4): ! READ CH(X)
SW(18): ! NEXT CH (FOR ALGOLE
%IF NLFLAG=1 %THEN X=IOCP(6,0) %AND NLFLAG=0
X=RCHBUFF(PTR)
%IF EP=18 %THEN %RESULT=X
%IF X=NL %THEN NLFLAG=1
PTR=PTR+1
%RESULT=X
SW(5): ! PRINT CH(N)
%IF N=12 %THEN X=IOCP(5,10)
%IF (N=10 %OR N=13) %THEN %START
OUTPUT: OUTPUTBUFF(OUTPTR)=N
%IF CONTROL=0 %THEN OUTPTR=OUTPTR+1
OUTPUTRECORD; OUTPUTBUFF(0)=N
->END2
%FINISH
OUTPUTBUFF(OUTPTR)=N
OUTPTR=OUTPTR+1
%IF OUTPTR>OUTMARG2 %THEN %START
OUTPUTBUFF(OUTPTR)=10
OUTPUTRECORD; OUTPUTBUFF(0)=10
%FINISH
END2: %RESULT=0
SW(6): ! LINE RECONSTRUCTION
PTR=1
%IF EMFLAG=1 %THEN %START
SIGNAL(2,140,0,FLAG); %STOP
%FINISH
!******READ A RECORD INTO RCHBUFF******
SIM2(0,ADDR(RCHBUFF(1)),0,L)
!******SET FIRST BYTES OF BUFFERS TO LENGTH OF RECORD******
%IF L=0 %THEN L=160
RCHBUFF(0)=L
INPUTBUFF(0)=L
!******TEST FOR EM IN INPUT RECORD******
%IF RCHBUFF(PTR)=25 %THEN %START
INPUTBUFF(0)=2; EMFLAG=1
INPUTBUFF(2)=10
INPUTBUFF(1)=25; ->JUMP
%FINISH
!******THE FOLLOWING MARKS CHARACTERS NOT CONTAINED IN IMP CHAR SET****
!******WHILST COPYING RECORD FROM RCHBUFF INTO INPUTBUFF******
! %CYCLE I=1,1,INPUTBUFF(0)
! X=RCHBUFF(I)
! %IF X=X'1A' %THEN SUBCHAR=1
! INPUTBUFF(I)=ITRTAB(X)
! %REPEAT
X=X'18000100'
*LD_INPUTBUFF; *INCA_=1
*LSD_RCHBUFF; *IAD_=1
*LDB_L; *STD_%TOS
*MV_%L=%DR; ! COPY RCHBUFF TO INPUTBUFF
*LD_%TOS; *LSS_ITRTAB+4; *LUH_X
*STD_%TOS; *SWNE_%L=%DR,128,26; ! CHECK FOR SUB
*JCC_8,<NOSUB>
*LB_=1; *STB_SUBCHAR
NOSUB: *LD_%TOS; *TTR_%L=%DR
%IF (SUBCHAR=1 %OR L=0) %THEN ->JUMP
!******FOLLOWING MARKS TO LEFT & RIGHT OF INMARG1 & INMARG2******
%UNLESS INMARG1=1 %THEN %START
%CYCLE I=1,1,INMARG1-1
INPUTBUFF(I)=X'80'
%REPEAT
%FINISH
%IF INMARG2<L-1 %THEN %START
%CYCLE I=INMARG2+1,1,L-1
INPUTBUFF(I)=X'80'
%REPEAT
L=INMARG2
%FINISH
!!******THE FOLLOWING CARRIES OUT THE DELETION RULES******
->SKIPIMP
%CYCLE I=1,1,L
Q=I
%IF INPUTBUFF(Q)=34 %THEN %START
INPUTBUFF(Q)=X'80'
BACK: %IF (Q-1)<1 %THEN ->NEXT2
%IF INPUTBUFF(Q-1)=X'80' %THEN Q=Q-1 %AND ->BACK
INPUTBUFF(Q-1)=X'80'
%FINISH
NEXT2: %REPEAT
!******THE FOLLOWING MARKS TRAILING SPACES BEFORE NEWLINE******
%CYCLE I=L-1,-1,1
%IF INPUTBUFF(I)=32 %THEN INPUTBUFF(I)=X'80'
%EXIT %UNLESS INPUTBUFF(I)=X'80'
%REPEAT
->JUMP
SKIPIMP:
*LD_INPUTBUFF; *LB_L; *SBB_=1
DTRS: *LSS_(%DR+%B); *ICP_=32
*JCC_7,<NOTSP>
*LSS_=128; *ST_(%DR+%B); *DEBJ_<DTRS>
->JUMP
NOTSP: *ICP_=128; *JCC_7,<JUMP>; *DEBJ_<DTRS>
!******RECONSTRUCTION NOW COMPLETE******
!******TEST FOR SUB CHAR IN INPUT******
JUMP: I=ADDR(INPUTBUFF(0))
%IF SUBCHAR=1 %THEN %START
SUBCHAR=0; SIGNAL(2,144,0,FLAG)
%STOP
%FINISH
%RESULT=I
SW(15): ! RESTRICTED PRINTSTRING
! STRING MUST HAVE NO UNPRINTABLES
! OR CONTROLS (XCEPT LAST CHAR)
! AND MAY NOT EXCEED MARGINS
X=X'180000FF'
L=BYTE INTEGER(N)
*LD_OUTPUTBUFF; *MODD_OUTPTR; ! TO RECEIVE STRING
*LDB_L
*STD_%TOS; *STD_%TOS
*LDA_N; *INCA_=1; *CYD_=0
*LD_%TOS; *MV_%L=%DR
*LD_%TOS; *LSS_OTRTAB+4
*LUH_X; *TTR_%L=%DR
*INCA_=-1
*LSS_(%DR); *ST_X
OUTPTR=OUTPTR+L
OUTPTR=OUTPTR-1 %AND OUTPUT RECORD %IF X=10
%RESULT=0
!
! CAN DELETE M-C CODE AND ALLOX SW(15) TO DROP THRO TO SW(7)
! IF REQUIRED FOR ALL IMP VERSION
!
SW(7): ! PRINT STRING(N) WHERE
! N IS ADDRESS OF STRING
L=BYTEINTEGER(N)
%IF L=0 %THEN %RESULT=0
%CYCLE I=1,1,L
CH=BYTEINTEGER(I+N)&X'7F'
%IF CH=10 %THEN OUTPUT RECORD %ELSE %START
OUTPUTBUFF(OUTPTR)=OTRTAB(CH)
OUTPTR=OUTPTR+1
%IF OUTPTR>OUTMARG2 %THEN OUTPUT RECORD
%FINISH
%REPEAT
%RESULT=0
SW(8): ! SELECT INPUT(N)
SW(21): INPUTBUFF(0)=0;!SELECT INPUT(ALGOL)
%IF EP=8 %THEN I=0 %ELSE I=2
EMFLAG=0; NLFLAG=1
SIM2(15,I,N,FLAGS)
%IF FLAGS<0 %THEN %START
SIGNAL(2,152,0,FLAG)
%STOP
%FINISH
INMARG1=(FLAGS>>8)&X'FF'
INMARG2=FLAGS&X'FF'
%RESULT=0
SW(9): ! SELECT OUTPUT(N)
SW(22):;!SELECTOUTPUT(ALGOL)
%IF EP=9 %THEN I=1 %ELSE I=3
OUTPUTRECORD %UNLESS (OUTPUTBUFF(0)=10 %AND OUTPTR=1)
SIM2(15,I,N,FLAGS)
%IF FLAGS<0 %THEN %START
SIGNAL(2,152,0,FLAG)
%STOP
%FINISH
OUTMARG1=(FLAGS>>8)&X'FF'
OUTMARG2=FLAGS&X'FF'
%IF OUTMARG2=0 %THENSTART
OUTMARG2=132
CONTROL=0
%FINISHELSE CONTROL=1
%RESULT=0
SW(10): ! ISOCARD(N) WHERE N IS THE
! ADDRESS OF BUFFER CARD READ INTO
SIM2(0,ADDR(INPUTBUFF(0)),0,LENGTH)
%IF INPUTBUFF(0)=25 %THEN %START
SIGNAL(2,140,0,FLAG); %STOP
%FINISH
%CYCLE I=0,1,LENGTH-2
BYTEINTEGER(N+I)=INPUTBUFF(I)
%REPEAT
INPUTBUFF(0)=0
%RESULT=0
SW(11): ! OUTPUT THE CURRENT RECORD
%UNLESS N=-2 %THENSTART;! EXCEPT SPECIAL OUTPUT INT CALL
OUTPUTBUFF(OUTPTR)=10
%IF CONTROL=0 %THEN OUTPTR=OUTPTR+1
%IF N>=0 %AND OUTPTR>1 %THEN %C
SIM2(1,ADDR(OUTPUTBUFF(0)),OUTPTR,F)
EMFLAG=0; NLFLAG=1
INMARG1=1; INMARG2=72
%FINISHELSE CONTROL=1;! TERMINATING CONTROL CHAR NOT IN LENGTH
OUTMARG1=1; OUTMARG2=132
OUTPTR=1
OUTPUTBUFF(0)=10
%RESULT=0
SW(12): ! SET INPUT MARGINS
FLAGS=0
INMARG1=(N>>16)&X'FF'
INMARG2=N&X'FF'
SIM2(16,0,(INMARG1<<8)!INMARG2,FLAGS)
%RESULT=0
SW(13): ! SET OUTPUT MARGINS
FLAGS=0
OUTMARG1=(N>>16)&X'FF'
X=IOCP(5,10); ! OUTPUT NEWLINE
OUTMARG2=N&X'FF'
SIM2(16,1,(OUTMARG1<<8)!OUTMARG2,FLAGS)
%IF OUTMARG2=0 %THENSTART
OUTMARG2=132
CONTROL=0
%FINISHELSE CONTROL=1
%RESULT=0
SW(14): ! ADDRESS OF RECORD AS READ IN
%RESULT=ADDR(RCHBUFF(0))
SW(16): ! CLOSE STREAM(N)
SIM2(17,N,0,FLAGS)
%RESULT=0
SW(17): ! REPEATED PRINT SYMBOL
%RESULT=0 %IF N<0 %OR N>>8=0
%CYCLE I=1,1,N>>8
X=IOCP(3,N&127)
%REPEAT
%RESULT=0
SW(19): ! GET CURRENT MARGINS
%RESULT=((INMARG1<<8!INMARG2)<<8!OUTMARG1)<<8!OUTMARG2
SW(20): ! GET POSITION OF INPUT OR OUTPUT POINTER
%IF N=0 %THEN %RESULT=PTR;! INPUT POINTER
%RESULT=OUTPTR;! OUTPUT POINTER
%END
%SYSTEMROUTINE OUTPUTRECORD
%INTEGER F, I
I=OUTPTR;OUTPTR=OUTMARG1
SIM2(1,ADDR(OUTPUTBUFF(0)),I,F)
OUTPUTBUFF(0)=10
I=1
%WHILE I<OUTMARG1 %THEN OUTPUTBUFF(I)=' ' %AND I=I+1
%END
!*
%SYSTEMROUTINE SIGNAL(%INTEGER EP, P1, P2, %INTEGERNAME F)
!***********************************************************************
!* EP = 0 STACK RECOVERY INFO *
!* P1 = PC *
!* P2 = LNB
!* 1 UNSTACK RECOVERY INFORMATION *
!* P1 = 0 ONE LEVEL *
!* 1 ALL LEVELS *
!* 2 SIGNAL ERROR OF CLASS P1 AND SUBCLASS P2 AT CURRENT LEVEL *
!* 3 DITTO AT OUTER LEVEL *
!* 4 REPEAT LATEST CONTINGENCY AT CURRENT LEVEL *
!* 5 RETURN TO USER MODE WITH NOMINATED ENVIRONMENT *
!* 6 SET INTEGER AT P1 TO CURRENT NUMBER OF LEVELS *
!***********************************************************************
%INTEGER I
%IF EP=0 %OR EP=9 %THENSTART
INFD=0
OUTFD=-1
I=IOCP(11,-1)
%IF EP=0 %THENSTART;! SOLO MODE
I=1
ICL9CEFAC=4
%FINISHELSESTART;! JOBBER
I=-1
ICL9CEFAC=0
%FINISH
ICL9CENVINIT(I,P2,ASUPPORT)
%FINISH
SGNL(EP,P1,P2,F)
%END; ! SIGNAL
!*
%ENDOFFILE