!
CONST BYTE INTEGER ARRAY I TO E TAB(0 : 127) = C
X'40',X'40',X'40',X'40',X'40',X'40',X'40',X'40',
X'40',X'40',X'15',X'40',X'0C',X'40',X'40',X'40',
X'40',X'40',X'40',X'40',X'40',X'40',X'40',X'40',
X'40',X'40',X'40',X'40',X'40',X'40',X'40',X'40',
X'40',X'4F',X'7F',X'7B',X'5B',X'6C',X'50',X'7D',
X'4D',X'5D',X'5C',X'4E',X'6B',X'60',X'4B',X'61',
X'F0',X'F1',X'F2',X'F3',X'F4',X'F5',X'F6',X'F7',
X'F8',X'F9',X'7A',X'5E',X'4C',X'7E',X'6E',X'6F',
X'7C',X'C1',X'C2',X'C3',X'C4',X'C5',X'C6',X'C7',
X'C8',X'C9',X'D1',X'D2',X'D3',X'D4',X'D5',X'D6',
X'D7',X'D8',X'D9',X'E2',X'E3',X'E4',X'E5',X'E6',
X'E7',X'E8',X'E9',X'4A',X'5F',X'5A',X'6A',X'6D',
X'7C',X'81',X'82',X'83',X'84',X'85',X'86',X'87',
X'88',X'89',X'91',X'92',X'93',X'94',X'95',X'96',
X'97',X'98',X'99',X'A2',X'A3',X'A4',X'A5',X'A6',
X'A7',X'A8',X'A9',X'C0',X'40',X'D0',X'40',X'40'
CONSTBYTEINTEGERARRAY ONE CASE(0 : 127) = C
0, 1, 2, 3, 4, 5, 6, 7, 8, 9,10,11,12,13,14,15,
16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31,
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,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,123,124,125,126,127;
CONSTINTEGER MAXLEVELS=31,COMMALT=2,DECALT=8,ENDALT=9,SNPT=X'1006'
CONSTINTEGER MAXIBITS=32; ! BITS IN LARGEST INTEGER
SYSTEMINTEGERMAPSPEC COMREG(INTEGER I)
CONSTBYTEINTEGERARRAY TRTAB(0:255)=0(48),1(10),
0(7),2(26),0(6),2(26),0(*);
INCLUDE "ERCC07.TRIMP_TFORM1S"
EXTRINSICRECORD (PARMF)PARM
EXTRINSICRECORD (WORKAF)WORKA
EXTERNALROUTINESPEC POP(INTEGERNAME A,B,C,D)
EXTERNALROUTINESPEC PUSH(INTEGERNAME A,INTEGER B,C,D)
EXTERNALROUTINESPEC FAULT(INTEGER A,B,C)
EXTERNALINTEGERFN PASSONE
IF HOST=PERQ THEN START
EXTERNALROUTINESPEC MOVE BEE
FINISH
ROUTINESPEC NEW SOURCE(INTEGER NEW FIL AD)
ROUTINESPEC OLD SOURCE
ROUTINESPEC READ LINE(INTEGER MODE,CHAR)
INTEGERFNSPEC COMPARE(INTEGER P)
ROUTINESPEC PNAME(INTEGER MODE)
ROUTINESPEC CONST(INTEGER MODE)
ROUTINESPEC TEXTTEXT(INTEGER EBCDIC)
EXTERNALROUTINESPEC MOVE BYTES(INTEGER LENGTH,FBASE,FOFF,TOBASE,TOOFF)
CONSTINTEGERARRAY PRECONSTS(0:3)=10,0,{NL}X'413243F6',X'A8885A31'{PI};
INTEGER I,J,K,LLENGTH,LEVEL,QMAX,Q,R,S,SNUM,NNAMES,DSIZE,NEXT,JJ,CPTR,
STARSTART,ARSIZE,HIT,CTYPE,LASTAT,LASTNAME,LASTEND,STRLINK,IHEAD,
IDEPTH,FILEADDR,FILEPTR,FILEEND
BYTEINTEGERARRAYFORMAT SRCEF(0:1024*1024)
RECORD (EMASFHDRF)NAME HDR
LONGREAL IMAX
STRING (9)NEM
INTEGERNAME LINE
BYTEINTEGERARRAYNAME CC,SOURCE,A
INTEGERARRAYNAME WORD,TAGS
LINE==WORKA_LINE
CC==WORKA_CC
A==WORKA_A
TAGS==WORKA_TAGS
WORD==WORKA_WORD
NNAMES=WORKA_NNAMES
DSIZE=7*NNAMES
ARSIZE=1024*WORKA_WKFILEK-(WORKA_CCSIZE+256);!256 BYTE MARGIN LEFT AT MAP TIME
IMAX=(-1)>>1
INTEGERARRAY SFS(0:MAXLEVELS)
BYTEINTEGERARRAYFORMAT LETTF(0:DSIZE+20)
BYTEINTEGERARRAYNAME LETT
BYTEINTEGERARRAY TLINE(-60:161)
CONSTBYTEINTEGERARRAY ILETT(0: 526)= 11,
'S','E','L','E','C','T','I','N','P','U','T', 12,'S','E','L','E',
'C','T','O','U','T','P','U','T', 7,'N','E','W','L','I','N','E',
5,'S','P','A','C','E', 10,'S','K','I','P','S','Y','M','B','O',
'L', 10,'R','E','A','D','S','T','R','I','N','G', 8,'N','E','W',
'L','I','N','E','S', 6,'S','P','A','C','E','S', 10,'N','E','X',
'T','S','Y','M','B','O','L', 11,'P','R','I','N','T','S','Y','M',
'B','O','L', 10,'R','E','A','D','S','Y','M','B','O','L', 4,'R',
'E','A','D', 5,'W','R','I','T','E', 7,'N','E','W','P','A','G',
'E', 4,'A','D','D','R', 6,'A','R','C','S','I','N', 3,'I','N',
'T', 5,'I','N','T','P','T', 6,'F','R','A','C','P','T', 5,'P',
'R','I','N','T', 7,'P','R','I','N','T','F','L', 4,'R','E','A',
'L', 7,'I','N','T','E','G','E','R', 3,'M','O','D', 6,'A','R',
'C','C','O','S', 4,'S','Q','R','T', 3,'L','O','G', 3,'S','I',
'N', 3,'C','O','S', 3,'T','A','N', 3,'E','X','P', 11,'C','L',
'O','S','E','S','T','R','E','A','M', 11,'B','Y','T','E','I','N',
'T','E','G','E','R', 8,'E','V','E','N','T','I','N','F',
6,'R','A','D','I','U','S', 6,'A','R','C','T','A','N',
6,'L','E','N','G','T','H', 11,'P','R','I','N','T','S','T','R',
'I','N','G', 2,'N','L', 8,'L','O','N','G','R','E','A','L', 7,
'P','R','I','N','T','C','H', 6,'R','E','A','D','C','H', 6,'S',
'T','R','I','N','G', 8,'R','E','A','D','I','T','E','M', 8,'N',
'E','X','T','I','T','E','M', 6,'C','H','A','R','N','O', 8,'T',
'O','S','T','R','I','N','G', 9,'S','U','B','S','T','R','I',
'N','G', 6,'R','E','C','O','R','D', 5,'A','R','R','A','Y', 6,
'S','I','Z','E','O','F',4,'I','M','O','D',2,'P',
'I',9,'E','V','E','N','T','L','I','N','E',11,'L','O','N','G',
'I','N','T','E','G','E','R',12,'L','O','N','G','L','O','N','G',
'R','E','A','L',9,'L','E','N','G','T','H','E','N','I',
9,'L','E','N','G','T','H','E','N','R',
8,'S','H','O','R','T','E','N','I',
8,'S','H','O','R','T','E','N','R',
6,'N','E','X','T','C','H',
11,'H','A','L','F','I','N','T','E','G','E','R',
8,'P','P','R','O','F','I','L','E',
5,'F','L','O','A','T',
4,'L','I','N','T',
6,'L','I','N','T','P','T',
12,'S','H','O','R','T','I','N','T','E','G','E','R',255;
LETT==ARRAY(ADDR(A(ARSIZE-DSIZE-20)),LETTF)
ARSIZE=ARSIZE-DSIZE-300
LETT(0)=0
LEVEL=0
WORKA_LETT==LETT
! WORKA_LETT==ARRAY(ADDR(LETT(0)),A)
CYCLE I=0,1,MAXLEVELS
SFS(I)=0
REPEAT
CYCLE I=0,1,NNAMES
WORD(I)=0; TAGS(I)=0;
REPEAT
FILEADDR=WORKA_FILEADDR
IDEPTH=0; IHEAD=0
IF FILEADDR#0 THEN START
HDR==RECORD(FILEADDR)
SOURCE==ARRAY(FILEADDR,SRCEF)
FILEPTR=HDR_STARTRA
FILEEND=HDR_ENDRA
FINISH
PARM_OPT=1; PARM_ARR=1
PARM_LINE=1; PARM_TRACE=1; PARM_DIAG=1
PARM_CHK=1
I=PARM_BITS1
IF I&4=4 THEN PARM_DIAG=0
IF I&X'800000'#0 THEN PARM_LINE=0
IF I&16=16 THEN PARM_CHK=0
PARM_MAP=I>>17&1; ! MAP CONTROLS FUNNY LISTING OF INCLUDES
PARM_LIST=(I>>1&1)!!1
PARM_FREE=I>>19&1
IF I&32=32 THEN PARM_ARR=0
PARM_PROF=(I>>15&1)!(I>>7&1); ! USE MAP OR PROFILE BIT PRO TEM
PARM_DYNAMIC=I>>20&1
PARM_LET=I>>13&1
PARM_DCOMP=I>>14&1; ! PARM CODE OR D
PARM_DBUG=I>>18&1
IF I&64=64 THEN PARM_TRACE=0 AND PARM_DIAG=0
PARM_X=I>>28&1; ! DONT REFORMAT REALS FOR SIMULATOR
PARM_Y=I>>27&1
PARM_Z=I>>26&1; ! USE PARMZ BIT FOR DUMPING WKFILE
PARM_STACK=I>>3&1
PARM_TTOPUT=COMREG(40)
IF I&(1<<16)#0 THEN START
PARM_ARR=0; PARM_OPT=0
PARM_LINE=0; PARM_CHK=0; PARM_DIAG=0
FINISH
PARM_TRACE=PARM_TRACE!PARM_OPT; ! ALLOW NOTRACE ONLY WITH OPT
NEWLINES(3); SPACES(14)
PRINTSTRING("ERCC. Portable Imp80")
PRINTSTRING(" Compiler Release")
WRITE(WORKA_RELEASE,1)
PRINTSTRING(" Version ".WORKA_LADATE)
NEWLINES(3)
WRITE(NNAMES,5); WRITE(WORKA_ASL MAX,5)
NEWLINE
!
! NOW DECLARE THE SPECIAL NAMES WHICH ARE IN ARRAY ILETT.
!
BEGIN
RECORD (TAGF) SNTAG
CPTR=0; SNUM=0; STRLINK=0
K=0
IF HOST//10=1 THEN NEXT=1 ELSE NEXT=2; !START AT 2 FOR WORD ADDRESSES HOSTS
I=ILETT(0)
WHILE I<255 CYCLE
CYCLE J=I,-1,1
CC(J)=ILETT(K+J)
REPEAT
CC(I+1)=';'
R=2; Q=1; PNAME(1)
SNTAG=0; SNTAG_UIOJ<-X'8000'; ! SET USED BIT
JJ=TSNAME(SNUM)
IF JJ&X'C000'#X'4000' START ; ! NOT A CONST VARAIBLE
SNTAG_PTYPE=SNPT
SNTAG_ACC=JJ; ! TRUE PTYPE HERE
SNTAG_SLINK=SNUM
FINISHELSESTART
SNTAG_PTYPE=JJ
SNTAG_S2=PRECONSTS(CPTR)
SNTAG_S3=PRECONSTS(CPTR+1)
CPTR=CPTR+2
FINISH
PUSH(TAGS(LASTNAME),SNTAG_S1,SNTAG_S2,SNTAG_S3)
SNUM=SNUM+1
K=K+I+1; I=ILETT(K)
REPEAT
END
!
COMREG(24)=16; ! RETURN CODE
LINE=0; LLENGTH=0; Q=1
R=1; LEVEL=1
CYCLE
IF Q>=LLENGTH THEN QMAX=1 AND READ LINE(0,0)
STARSTART=R
R=R+3
A(R)=LINE>>8
A(R+1)=LINE&255
R=R+2
IF COMPARE(SS)=0 THEN START
FAULT(100,Q,QMAX<<16!LLENGTH)
R=STARSTART
Q=Q+1 WHILE CC(Q)#';' AND Q<LLENGTH
Q=Q+1
FINISH ELSE START
FAULT(102, WORKA_WKFILEK, 0) IF R>ARSIZE
IF A(STARSTART+5)=COMMALT THEN R=STARSTART ELSE START
I=R-STARSTART
A(STARSTART)=I>>16
A(STARSTART+1)=I>>8&255
A(STARSTART+2)=I&255
!*DELSTART
IF PARM_Z#0 THEN START
NEWLINE; WRITE(LINE, 5)
WRITE(STARSTART,5); NEWLINE; J=0
CYCLE I=STARSTART, 1, R-1
WRITE(A(I), 5)
J=J+1
IF J>=20 THEN NEWLINE AND J=0
REPEAT
NEWLINE
FINISH
!*DELEND
IF A(STARSTART+5)=ENDALT AND C
1<=A(STARSTART+6)<=2 START ;! ENDOF PROG OR FILE
IF IHEAD=0 THEN EXIT
OLD SOURCE
R=STARSTART; ! IGNORE ENDOFFILE LIKE IMP77
LLENGTH=1
CONTINUE
FINISH
IF LEVEL=0 THEN START
FAULT(14, 0, 0)
R=STARSTART; ! IGNORE IT
LEVEL=1
FINISH
FINISH
FINISH
REPEAT
A(I)=0 FOR I=R,1,R+7; R=R+8
R=(R+7)&(-8)
WORKA_DICTBASE=R
CYCLE I=0,1,NEXT
A(R+I)=LETT(I)
REPEAT
WORKA_LETT==ARRAY(ADDR(A(R)),A)
R=R+NEXT+1
IF LEVEL>1 THEN FAULT(15,LEVEL-1,0)
R=(R+7)&(-8)
NEWLINE
IF PARM_FAULTY=0 THEN START
WRITE(LINE, 5)
PRINT STRING(" LINES ANALYSED SIZE=")
WRITE(R, 5)
IF (HOST=EMAS OR HOST=IBM OR HOST=IBMXA) AND C
LINE>90 AND PARM_LIST#0 THEN NEWPAGE ELSE NEWLINE
FINISH ELSE START
PRINTSTRING("CODE GENERATION NOT ATTEMPTED
")
COMREG(24)=8
COMREG(47)=PARM_FAULTY
STOP
FINISH
RESULT =R
ROUTINE NEWSOURCE(INTEGER NEWFILEADDR)
!***********************************************************************
!* SETS UP COMPILER TO USE AN INCLUDED SOURCE FILES *
!***********************************************************************
PUSH(IHEAD,FILEADDR,FILEPTR,LINE)
FILEADDR=NEWFILEADDR
HDR==RECORD(FILEADDR)
SOURCE==ARRAY(FILEADDR,SRCEF)
FILEPTR=HDR_STARTRA
FILEEND=HDR_ENDRA
IDEPTH=IDEPTH+1
IF PARM_MAP#0 THEN LINE=10000
END
ROUTINE OLDSOURCE
!***********************************************************************
!* UNDOES THE ABOVE
!***********************************************************************
INTEGER ALT LINE
IF IHEAD#0 THEN START
POP(IHEAD,FILEADDR,FILEPTR,ALTLINE)
HDR==RECORD(FILEADDR)
FILEEND=HDR_ENDRA
IF PARM_MAP#0 THEN LINE=ALT LINE
SOURCE==ARRAY(FILEADDR,SRCEF)
IDEPTH=IDEPTH-1
FINISH ELSE FAULT(110,0,0)
END
ROUTINE READ LINE(INTEGER MODE,CHAR)
ROUTINESPEC GET LINE
INTEGER DEL, LL, LP, PREV, LASTC
LL=0; LP=0; Q=1
LLENGTH=0; DEL=0; LASTC=-1; ! NO CONTINUATIONS AS YET
NEXT:
LP=LP+1
IF LP>LL THEN GET LINE AND LP=1
I=TLINE(LP)
IF MODE=0 THEN START
WHILE I='{' CYCLE
CYCLE
PREV=I
LP=LP+1
I=TLINE(LP)
REPEAT UNTIL PREV='}' OR I=NL
REPEAT
IF I='%' THEN DEL=128 AND ->NEXT
I=ONE CASE(I)
IF 'A'<=I<='Z' THEN I=I!DEL ELSE START
DEL=0
->NEXT IF I=' '
FINISH
LLENGTH=LLENGTH+1
CC(LLENGTH)=I
IF I='''' OR I=34 THEN MODE=1 AND CHAR=I
FINISH ELSE START
LLENGTH=LLENGTH+1
CC(LLENGTH)=I
IF I=CHAR THEN MODE=0
FINISH
->NEXT UNLESS I=NL
IF LLENGTH-1=LASTC THEN LLENGTH=LASTC AND ->NEXT
I=CC(LLENGTH-1)
IF I='C'+128 THEN LLENGTH=LLENGTH-2 AND LASTC=LLENGTH AND ->NEXT
IF MODE=0 AND I=',' THEN LLENGTH=LLENGTH-1 AND LASTC=LLENGTH AND ->NEXT
FAULT(101,0,0) IF LLENGTH>WORKA_CCSIZE
! ON PERQ IMP SEEMS DEAD
! THEREFORE MOVE THE BEE
IF HOST=PERQ AND LINE&15=0 THEN MOVE BEE
RETURN
ROUTINE GET LINE
SYSTEMROUTINESPEC IOCP(INTEGER A,B)
CONSTBYTEINTEGERARRAY ITOI(0:255)=C
32(10),10,32(14),25,26,32(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,32,
26(5),10,26(10),
26(16),
26(14),92,38,
26(11),35,26(4),
26(16),
26(9),35,26(5),94,
26(32);
INTEGER K
LL=0
IF FILE ADDR=0 THEN START ; ! SOURCE NOT A 'CLEAN' FILE
UNTIL K=NL CYCLE
READ SYMBOL(K)
TLINE(LL+1)=ITOI(K)
LL=LL+1
REPEAT
FINISH ELSE START
IF FILEPTR>=FILE END START
OLD SOURCE; ! RESET SOURCE FILES
GETLINE
RETURN
FINISH
UNTIL K=NL OR K=0 CYCLE
K=SOURCE(FILEPTR); ! NEXT CHAR FROM SORCE FILE
FILE PTR=FILE PTR+1
TLINE(LL+1)=ITOI(K)
LL=LL+1
REPEAT
FINISH
LINE=LINE+1; ! COUNT ALL LINES
IF PARM_LIST#0 THEN START
IF MODE=0 AND LLENGTH>0 THEN C
PRINTSTRING(" C") ELSE WRITE(LINE, 5)
! SPACES(8)
CYCLE K=-7,1,0
TLINE(K)=' '
REPEAT
IF MODE#0 THEN TLINE(-7)=M'"'
TLINE(-8)=LL+8
IF HOST=PERQ OR HOST=ACCENT THEN START
PRINT SYMBOL(TLINE(K)) FOR K=-7,1,LL
FINISH ELSE IOCP(15,ADDR(TLINE(-8)))
FINISH
IF PARM_FREE=0 AND LL>73 THEN TLINE(73)=10 AND LL=73
END
END
INTEGERFN COMPARE(INTEGER P)
INTEGER I, J, ITEM, RA, RL, RP, RQ, RR, RS, MARKER, SSL, ALT, PP
OWNINTEGER SAVECOMP; ! FOR CHECKING DSIDED CONDS
SWITCH BIP(999:1043)
RP=SYMBOL(P)
RL=LEVEL
P=P+1
PP=P; ! ROUTINE REALLY STARTS HERE
COMM:
RQ=Q; ! RESET VALUES OF LINE&AR PTRS
RR=R
SSL=STRLINK; ! SAVE STRING LINK
ALT=1; ! FIRST ALTERNATIVE TO BE TRIED
RA=SYMBOL(P); ! RA TO NEXT PHRASE ALTERNATIVE
RS=P
UPR: R=R+1
SUCC: ! SUCCESS ON TO NEXT ITEM
RS=RS+1; ! RS=NEXT ALTERNATIVE MEANS THAT
! THIS ALT HAS BEEN COMPLETED SO
! EXIT WITH HIT=1
IF RS=RA THEN ->FINI
ITEM=SYMBOL(RS); ! NEXT BRICK IN THE CURRENT ALT
IF ITEM<999 THEN ->LIT
IF ITEM<1300 THEN ->BIP(ITEM)
! BRICK IS A PHRASE TYPE
IF COMPARE(ITEM)=0 THEN ->FAIL
->SUCC
LIT: ! BRICK IS LITERAL
I=CC(Q); ! OBTAIN CURRENT CHARACTER
->FAIL UNLESS I=CLETT(ITEM+1)
Q=Q+1
K=CLETT(ITEM)+ITEM
ITEM=ITEM+2
WHILE ITEM<=K CYCLE
->FAIL UNLESS CC(Q)=CLETT(ITEM)
Q=Q+1
ITEM=ITEM+1
REPEAT ; ! CHECK IT WITH LITERAL DICT ENTRY
->SUCC; ! MATCHED SUCCESSFULLY
FAIL: ! FAILURE - NOTE POSITION REACHD
IF RA=RP THEN ->TFAIL; ! TOTAL FAILURE NO ALT TO TRY
QMAX=Q IF Q>QMAX
Q=RQ; ! RESET LINE AND A.R. POINTERS
R=RR+1; ! AVOID GOING VIA UPR:
STRLINK=SSL
ALT=ALT+1; ! MOVE TO NEXT ALT OF PHRASE
RS=RA
RA=SYMBOL(RA)
->SUCC
TFAIL:
LEVEL=RL
RESULT =0
BIP(999): ! REPEATED PHRASE
A(RR)=ALT; P=PP
->COMM
BIP(1000):FINI: ! NULL ALWAYS LAST & OK
A(RR)=ALT
RESULT =1
BIP(1001): ! PHRASE NAME
I=CC(Q); ! OBTAIN CURRENT CHARACTER
->FAIL UNLESS TRTAB(I)=2
PNAME(ITEM-1004)
->SUCC IF HIT=1; ->FAIL
BIP(1002): ! PHRASE INTEGER CONSTANT
BIP(1003): ! PHRASE CONST
CONST(ITEM-1003)
->FAIL IF HIT=0
->SUCC
BIP(1004): ! PHRASE DUMMYSTART
A(R)=1; ! THERE IS AN '%ELSESTART'
R=R+1
->SUCC
BIP(1005): ! PHRASE N
I=CC(Q); ! OBTAIN CURRENT CHARACTER
->FAIL UNLESS '0'<=I<='9'
S=0
WHILE '0'<=I<='9' CYCLE
S=10*S+I&15
Q=Q+1; I=CC(Q)
REPEAT
A(R)<-S>>8; A(R+1)=S&255
R=R+2; ->SUCC
BIP(1006): ! PHRASE S=SEPARATOR
I=CC(Q); ! OBTAIN CURRENT CHARACTER
->SUCC IF I=NL
->FAIL UNLESS I=';'
Q=Q+1; ->SUCC
BIP(1007):
! PHRASE COMMENT TEXT
I=CC(Q); ! OBTAIN CURRENT CHARACTER
IF I='!' THEN Q=Q+1 AND ->COMFOUND
->FAIL UNLESS I='C'+128 AND CC(Q+1)=C
'O'+128 AND CC(Q+2)=CC(Q+3)='M'+128 AND CC(Q+4)='E'+128
->FAIL UNLESS CC(Q+5)='N'+128 AND CC(Q+6)='T'+128
Q=Q+7
COMFOUND:
J=CC(Q)
CYCLE
EXIT IF J=NL
Q=Q+1; J=CC(Q)
REPEAT
->SUCC
BIP(1008): ! PHRASE BIGHOLE
! NOT CURRENTLY USED IN TRIMP
! A(I)=0 %FOR I=R,1,R+3
! R=R+4
->SUCC
BIP(1009): ! PHRASE N255
I=CC(Q); ! OBTAIN CURRENT CHARACTER
->FAIL UNLESS '0'<=I<='9'
S=0
WHILE '0'<=I<='9' CYCLE
S=10*S+I&15
Q=Q+1; I=CC(Q)
REPEAT
->FAIL UNLESS 0<=S<=255
A(R)=S; ->UPR
BIP(1010): ! PHRASE HOLE
MARKER=R; R=R+2; ->SUCC
BIP(1011): ! PHRASE MARK
I=R-MARKER
A(MARKER+1)<-I
A(MARKER)<-I>>8
->SUCC
BIP(1012): ! PHRASE READLINE?
I=CC(Q); ! OBTAIN CURRENT CHARACTER
WHILE I=NL CYCLE
READLINE(0,0)
RQ=1
I=CC(Q)
REPEAT
FAULT(102, WORKA_WKFILEK,0) IF R>ARSIZE
->SUCC
BIP(1013): ! PHRASE CHECKIMPS
TEXTTEXT(0)
->FAIL IF HIT=0
->SUCC
BIP(1014): ! PHRASE DUMMY APP
A(R)=2; A(R+1)=2
R=R+2; ->SUCC
BIP(1015): ! PHRASE DOWN=NEW TEXT LEVEL
LEVEL=LEVEL+1
SFS(LEVEL)=0
->SUCC
BIP(1016): ! PHRASE UP 1 TEXTUAL LEVEL
WHILE SFS(LEVEL)#0 CYCLE
POP(SFS(LEVEL),I,J,K)
IF I=1 THEN FAULT(53,K,0); ! FINISH MISSING
IF I=2 THEN FAULT(13,K,0); ! %REPEAT MISSING
REPEAT
LEVEL=LEVEL-1
->SUCC
BIP(1017): ! PHRASE LISTON
PARM_LIST=1; ->SUCC
BIP(1018): ! PHRASE LISTOFF
PARM_LIST=0; ->SUCC
BIP(1019): ! PHRASE COLON FOR LABEL
->FAIL UNLESS CC(Q-1)=':'
->SUCC
BIP(1020): ! PHRASE NOTE CONST
->SUCC
BIP(1021): ! TRACE FOR ON CONDITIONS
PARM_TRACE=1; ->SUCC
BIP(1022): ! SET MNEMONIC
I=CC(Q); ! OBTAIN CURRENT CHARACTER
J=0
NEM="123456789"
WHILE 'A'<=I<='Z' OR '0'<=I<='9' CYCLE
J=J+1
CHARNO(NEM,J)=I
Q=Q+1; I=CC(Q)
REPEAT
->FAIL UNLESS J>0
LENGTH(NEM)=J
IF I='_' THEN Q=Q+1
->SUCC
BIP(1023): ! UCNOP MNEMONIC SANS OPERANDS
->FAIL IF (TARGET=PNX OR TARGET=PERQ OR TARGET=ACCENT) AND CC(Q-1)='_'
! EFFICIENCY FROG FOR ASSBLERS
! WITH NO PARAMETER OPCODES
CYCLE I=0,1,FIRSTUCUB-1
->PFND IF NEM=QCODES(I)
REPEAT
->FAIL
PFND:
J=OPC(I)
A(R)<-J>>8; A(R+1)<-J
R=R+2; ->SUCC; ! ALLOW MORE THAN 255 OPCODES
BIP(1024): ! UCUB MNEMONIC WITH UNSIGNED BYTE OPERAND
CYCLE I=FIRST UCUB,1,FIRST UCSB-1
->PFND IF NEM=QCODES(I)
REPEAT
->FAIL
BIP(1025): ! UCUB SIGNED BYTE OPERANDS
CYCLE I=FIRST UCSB,1,FIRST UCW-1
->PFND IF NEM=QCODES(I)
REPEAT ; ->FAIL
BIP(1026): ! P(OP)=+,-,&,****,**,*,!!,!,
! //,/,>>,<<,.,¬¬,¬
I=CC(Q); ! OBTAIN CURRENT CHARACTER
->FAIL UNLESS 32<I<127 AND C
X'80000000'>>((I-32)&31)&X'4237000A'#0
Q=Q+1
IF I='+' THEN A(R)=1 AND ->UPR
IF I='-' THEN A(R)=2 AND ->UPR
IF I='&' THEN A(R)=3 AND ->UPR
J=CC(Q)
IF I='*' THEN START
IF J#I THEN A(R)=6 AND ->UPR
IF CC(Q+1)=I=CC(Q+2) THEN A(R)=4 AND Q=Q+3 AND ->UPR
A(R)=5; Q=Q+1; ->UPR
FINISH
IF I='/' THEN START
IF J#I THEN A(R)=10 AND ->UPR
A(R)=9; Q=Q+1; ->UPR
FINISH
IF I='!' THEN START
IF J#I THEN A(R)=8 AND ->UPR
A(R)=7; Q=Q+1; ->UPR
FINISH
IF I='.' THEN A(R)=13 AND ->UPR
IF I=J='<' THEN A(R)=12 AND Q=Q+1 AND ->UPR
IF I=J='>' THEN A(R)=11 AND Q=Q+1 AND ->UPR
IF I='¬' THEN START
IF J#I THEN A(R)=15 AND ->UPR
Q=Q+1; A(R)=14; ->UPR
FINISH
->FAIL
BIP(1027): ! PHRASE CHECK UI
I=CC(Q); ! OBTAIN CURRENT CHARACTER
->SUCC IF TRTAB(I)=2 OR I='-'
->SUCC IF X'80000000'>>(I&31)&X'14043000'#0
->FAIL
BIP(1028): ! P(+')=+,-,¬,0
I=CC(Q); ! OBTAIN CURRENT CHARACTER
IF I='¬' OR I=X'7E' THEN A(R)=3 AND Q=Q+1 AND ->UPR
IF I='-' THEN A(R)=2 AND Q=Q+1 AND ->UPR
IF I='+' THEN A(R)=1 AND Q=Q+1 AND ->UPR
A(R)=4; ->UPR
BIP(1029): ! PHRASE NOTE CYCLE
A(R)=0; A(R+1)=0
A(R+2)=0; A(R+3)=0
PUSH(SFS(LEVEL),2,R,LINE)
R=R+4
->SUCC
BIP(1030): ! P(,')=',',0
!
! THIS IS VERY AWKWARD AS IT MEANS IT IS VERY TO HARD TO FIND
! THE END OF A PARAMETER LIST WITHOUT CHURNING. BY MAKING THIS A BIP
! WE CAN PEEP AHEAD FOR ')' AND FAIL HERE.
!
I=CC(Q); ! OBTAIN CURRENT CHARACTER
IF I=')' THEN ->FAIL
IF I=',' THEN Q=Q+1
->SUCC
BIP(1031): ! PHRASE CHECKTYPE IE ENSURE
! FIRST LETTER IS(B,H,I,L,R,S) &
! 3RD LETTER IS (A,L,N,O,R,T)
I=CC(Q); ! OBTAIN CURRENT CHARACTER
->FAIL UNLESS I>128 AND X'80000000'>>(I&31)&X'20C83000'#0C
AND X'80000000'>>(CC(Q+2)&31)&X'500B2800'#0
->SUCC
BIP(1032): ! PHRASE COMP1
BIP(1037): ! PHRASE COMP2(IS 2ND HALF OF DSIDED)
I=CC(Q); ! OBTAIN CURRENT CHARACTER
->FAIL UNLESS 32<I<=92 AND C
X'80000000'>>(I&31)&X'1004000E'#0
! '='=1,'>='=2,'>'=3
! '#' OR '¬=' OR '<>'=4
! '<='=5,'<'=6
! 7UNUSED,'->'=8,'=='=9
! '##' OR '¬==' =10
IF I='=' THEN START
IF CC(Q+1)=I THEN J=9 AND ->JOIN1
J=1; ->JOIN
FINISH
IF I='#' THEN START
IF CC(Q+1)=I THEN J=10 AND ->JOIN1
J=4; ->JOIN
FINISH
IF I='¬' AND CC(Q+1)='=' THEN START
Q=Q+1
IF CC(Q+1)='=' THEN J=10 AND ->JOIN1
J=4; ->JOIN
FINISH
IF I='>' THEN START
IF CC(Q+1)='=' THEN J=2 AND ->JOIN1
J=3; ->JOIN
FINISH
IF I='<' THEN START
IF CC(Q+1)='>' THEN J=4 AND ->JOIN1
IF CC(Q+1)='=' THEN J=5 AND ->JOIN1
J=6; ->JOIN
FINISH
IF I='-' AND CC(Q+1)='>' THEN J=8 AND ->JOIN1
->FAIL
JOIN1:Q=Q+1
JOIN: Q=Q+1
A(R)=J
IF ITEM=1032 THEN SAVECOMP=J AND ->UPR
! SAVE J TO CHECK DSIDED
IF SAVECOMP>6 OR J>6 THEN Q=Q-1 AND ->FAIL;! ILLEGAL DSIDED
->UPR; ! NB OWNS WONT WORK IF
! COND EXPRS ALLOWED AS THE
! CAN BE NESTED!
BIP(1033): ! P(ASSOP)- ==,=,<-,->
I=CC(Q); ! OBTAIN CURRENT CHARACTER
IF I='=' THEN START
IF CC(Q+1)='=' THEN A(R)=1 AND Q=Q+2 AND ->UPR
A(R)=2; Q=Q+1; ->UPR
FINISH
IF I='<' AND CC(Q+1)='-' THEN A(R)=3 AND Q=Q+2 AND ->UPR
IF I='-' AND CC(Q+1)='>' THEN A(R)=4 AND Q=Q+2 AND ->UPR
->FAIL
BIP(1034): ! NOTE START
A(R)=0; A(R+1)=0
A(R+2)=0; A(R+3)=0; ! HOLE FOR FORWARD PTR
PUSH(SFS(LEVEL),1,R,LINE)
R=R+4
->SUCC
BIP(1035): ! NOTE FINISH
IF SFS(LEVEL)=0 THEN FAULT(51,0,0) AND ->SUCC
POP(SFS(LEVEL),I,J,K)
IF I=2 THEN FAULT(59,K,0)
MOVEBYTES(4,ADDR(STARSTART),0,ADDR(A(0)),J)
->SUCC
BIP(1036): ! NOTE REPEAT
IF SFS(LEVEL)=0 THEN FAULT(1,0,0) AND ->SUCC
POP(SFS(LEVEL),I,J,K)
IF I=1 THEN FAULT(52,K,0); ! START INSTEAD OF CYCLE
MOVEBYTES(4,ADDR(STARSTART),0,ADDR(A(0)),J)
->SUCC
BIP(1038): ! INCLUDE "FILE"
->FAIL IF IDEPTH>10
I=CC(Q)
->FAIL UNLESS I=NL OR I=';'
Q=Q+1 IF I=';'
->FAIL UNLESS CTYPE=5 AND A(S)<=31
IF HOST=EMAS THEN START
BEGIN
SYSTEMROUTINESPEC CONSOURCE(STRING (31)FILENAME,INTEGERNAME FILEADDR)
CONSOURCE(STRING(ADDR(A(S))),J)
NEWSOURCE(J)
END
->SUCC
FINISH
IF HOST=PNX THEN START
BEGIN
STRING (255) FNAME
SYSTEMROUTINESPEC CONSOURCE(STRING (255)FILENAME,INTEGERNAME FILEADDR)
LENGTH(FNAME)=A(S)
CHARNO(FNAME,I)=A(S+I) FOR I=1,1,A(S)
CONSOURCE(FNAME,J)
NEWSOURCE(J)
END
->SUCC
FINISH
->FAIL
BIP(1039): ! UCW = USERCODE WORD OFFSET INSTRS
CYCLE I=FIRST UCW,1,FIRST UCUBUB-1
->PFND IF NEM=QCODES(I)
REPEAT
->FAIL
BIP(1040): ! UCUBUB TWO UNSIGNED BYTE OPERANDS
CYCLE I=FIRST UCUBUB,1,FIRST UCUBW-1
->PFND IF NEM=QCODES(I)
REPEAT ; ->FAIL
BIP(1041): ! UCUCUBW - BYTE&WORD OPERANDS
CYCLE I=FIRST UCUBW,1,FIRST UCJUMP-1
->PFND IF NEM=QCODES(I)
REPEAT ; ->FAIL
BIP(1042): ! UCJUMP = JUMP MNEMONICS
CYCLE I=FIRST UCJUMP,1,LASTUC
->PFND IF NEM=QCODES(I)
REPEAT ; ->FAIL
BIP(1043): ! UCWRONG ERRORS AND OTHER M-CS
I=CC(Q)
CYCLE
Q=Q+1
EXIT IF I=NL OR I=';'
I=CC(Q)
REPEAT
->SUCC
END ; !OF ROUTINE 'COMPARE'
ROUTINE PNAME(INTEGER MODE)
!***********************************************************************
!* MODE=0 FOR OLD NAME(ALREADY IN DICT), MODE=1 FOR NEW NAME *
!***********************************************************************
CONSTINTEGERARRAY HASH(0:7)=71,47,97,79,29,37,53,59;
INTEGER JJ, KK, LL, FQ, FS, T, S, I
HIT=0; FQ=Q; FS=CC(Q)
RETURN UNLESS TRTAB(FS)=2 AND M'"'#CC(Q+1)#M''''
! 1ST CHAR MUST BE LETTER
T=1
LETT(NEXT+1)=FS!32; JJ=71*FS
CYCLE
Q=Q+1
I=CC(Q)
EXIT IF TRTAB(I)=0
JJ=JJ+HASH(T)*I IF T<=7
T=T+1
LETT(NEXT+T)=I!32
REPEAT
LETT(NEXT)=T; ! INSERT LENGTH
S=T+1
FAULT(103,0,0) IF NEXT+S>DSIZE; !DICTIONARY OVERFLOW
JJ=(JJ+113*T)&NNAMES
CYCLE KK=JJ, 1, NNAMES
LL=WORD(KK)
->HOLE IF LL=0; ! NAME NOT KNOWN
->FND IF STRING(ADDR(LETT(NEXT)))=STRING(ADDR(LETT(LL)))
REPEAT
CYCLE KK=0,1,JJ
LL=WORD(KK)
->HOLE IF LL=0; ! NAME NOT KNOWN
->FND IF STRING(ADDR(LETT(NEXT)))=STRING(ADDR(LETT(LL)))
REPEAT
FAULT(104, 0, 0); ! TOO MANY NAMES
HOLE: IF MODE=0 THEN Q=FQ AND RETURN
WORD(KK)=NEXT
IF HOST//10=1 THEN NEXT=NEXT+S ELSE NEXT=(NEXT+S+1)&(-2)
FND: LASTAT=FQ; HIT=1; LASTNAME=KK
A(R+1)<-LASTNAME
A(R)=LASTNAME>>8; R=R+2
LASTEND=Q
END
ROUTINE CONST(INTEGER MODE)
!***********************************************************************
!* SYNTAX CHECK AND EVALUATE ALL THE FORMS OF IMP CONSTANT *
!* MODE=0 FOR INTEGER CONSTANTS #0 FOR ANY SORT OF CONSTANT *
!***********************************************************************
CONSTBYTEINTEGERARRAY RSHIFT(0:32)=0,0,1,0,2,0(3),3,0(7),4,0(15),5;
INTEGER Z, DOTSEEN, EBCDIC, FS, CPREC, RR, S, SS, T, RS
IF 1<<HOST&LLREALAVAIL#0 START
LONGLONGREAL X,CVALUE,DUMMY
CONSTLONGLONGREAL TEN=10
FINISH ELSE START
LONGREAL X,CVALUE,DUMMY
CONSTLONGREAL TEN=10
FINISH
IF 1<<HOST&LINTAVAIL#0 START
LONGINTEGER RADIXV
FINISH ELSE START
INTEGER RADIXV
FINISH
ON EVENT 1,2 START
HIT=0
RETURN
FINISH
CPREC=5; RR=R; R=R+1
DOTSEEN=0; HIT=0
CVALUE=0; DUMMY=0; X=0; FS=CC(Q)
S=0; ->N IF M'0'<=FS<=M'9'
->DOT IF FS='.' AND MODE=0 AND '0'<=CC(Q+1)<='9'
! 1 DIDT MIN
CTYPE=1; EBCDIC=0
->QUOTE IF FS=M''''
->STR2 IF FS=34
->NOTQUOTE UNLESS CC(Q+1)=M''''; Q=Q+2
->HEX IF FS='X'
->MULT IF FS='M'
->BIN IF FS=M'B'
->RHEX IF FS='R' AND MODE=0
->OCT IF FS='K'
IF FS='C' THEN EBCDIC=1 AND ->MULT
IF 1<<HOST&LLREALAVAIL#0 AND 1<<HOST&LINTAVAIL#0 AND C
FS='D' AND MODE=0 THEN START
CPREC=7
IF M'0'<=CC(Q)<=M'9' THEN ->N
IF CC(Q)='.' THEN ->DOT
FINISH
Q=Q-2; RETURN
QUOTE: ! SINGLE CH BETWEEN QUOTES
S=CC(Q+1); Q=Q+2
IF S=NL THEN READLINE(1,'''') AND Q=1
IF CC(Q)=M'''' THEN START
Q=Q+1
IF S#M'''' THEN ->IEND
IF CC(Q)=M'''' THEN Q=Q+1 AND ->IEND
FINISH
RETURN ; ! NOT VALID
NOTQUOTE: ! CHECK FOR E"...."
RETURN UNLESS FS='E' AND CC(Q+1)=M'"'
EBCDIC=1; Q=Q+1
STR2: ! DOUBLE QUOTED STRING
A(RR)=X'35'; TEXTTEXT(EBCDIC)
CTYPE=5; RETURN
HEX: T=0; ! HEX CONSTANTS
CYCLE
I=CC(Q); Q=Q+1
EXIT IF I=M''''
T=T+1
RETURN UNLESS C
('0'<=I<='9' OR 'A'<=I<='F' OR 'a'<=I<='f') AND C
(T<9 OR (1<<TARGET&LINTAVAIL#0 AND T<17))
IF T=9 THEN SS=S AND S=0
S=S<<4+I&15+9*I>>6
REPEAT
IF T>8 START
Z=4*(T-8)
S=S!(SS<<Z)
SS=SS>>(32-Z)
CPREC=6
FINISH
IEND:
IF CPREC=6 THEN MOVEBYTES(4,ADDR(SS),0,ADDR(A(0)),R) AND R=R+4
IF CPREC=5 AND 0<=S<=X'7FFF' START
CPREC=4; A(R)<-S>>8; A(R+1)=S&255; R=R+2
FINISH ELSE START
MOVEBYTES(4,ADDR(S),0,ADDR(A(0)),R)
R=R+4
FINISH
HIT=1 UNLESS MODE#0 AND CPREC=6
A(RR)=CPREC<<4!CTYPE
RETURN
RHEX: ! REAL HEX CONSTANTS
T=0
CYCLE
I=CC(Q); Q=Q+1
IF T&7=0 AND T#0 START
MOVEBYTES(4,ADDR(S),0,ADDR(A(0)),R); R=R+4; S=0
FINISH
EXIT IF I=M''''; T=T+1
RETURN UNLESS '0'<=I<='9' OR 'A'<=I<='F' OR 'a'<=I<='f'
S=S<<4+I&15+9*I>>6
REPEAT
RETURN UNLESS T=8 OR T=16 OR (1<<TARGET&LLREALAVAIL#0 AND T=32)
IF T=32 THEN CPREC=7 ELSE CPREC=4+T//8
A(RR)=CPREC<<4!2
HIT=1; RETURN
OCT: ! OCTAL CONSTANTS
T=0
CYCLE
I=CC(Q); Q=Q+1; T=T+1
EXIT IF I=M''''
RETURN UNLESS '0'<=I<='7' AND T<12
S=S<<3!(I&7)
REPEAT
->IEND
MULT: T=0; ! MULTIPLE CONSTANTS
CYCLE
I=CC(Q); Q=Q+1; T=T+1
IF I=M'''' THEN START
IF CC(Q)#M'''' THEN EXIT ELSE Q=Q+1
FINISH
RETURN IF T>=5
IF EBCDIC#0 THEN I=ITOETAB(I)
S=S<<8!I
REPEAT
->IEND
BIN: T=0; ! BINARY CONST
CYCLE
I=CC(Q); Q=Q+1; T=T+1
EXIT IF I=M''''
RETURN UNLESS '0'<=I<='1' AND T<33
S=S<<1!I&1
REPEAT
->IEND
RADIX: ! BASE_VALUE CONSTANTS
T=0; RADIXV=0
RS=RSHIFT(S)
Q=Q+1
CYCLE
I=CC(Q)
EXIT UNLESS '0'<=I<='9' OR 'A'<=I<='Z'
IF I<='9' THEN I=I-'0' ELSE I=I-('A'-10)
EXIT IF I>=S; ! MUST BE LESS THAN BASE
Q=Q+1
IF RS#0 THEN RADIXV=RADIXV<<RS+I AND T=T+RS C
ELSE RADIXV=RADIXV*S+I AND T=T+1
REPEAT
RETURN IF T=0 OR (1<<TARGET&LINTAVAIL=0 AND RS>0 AND T>MAXIBITS);! NO VALID DIGITS
IF 1<<HOST&LINTAVAIL#0 THEN SS<-RADIXV>>32 ELSE SS=0
S<-RADIXV
CTYPE=1
IF SS#0 THEN CPREC=6
->IEND
N: ! CONSTANT STARTS WITH DIGIT
I=CC(Q)
UNTIL I<M'0' OR I>M'9' CYCLE
CVALUE=TEN*CVALUE+(I&15)
Q=Q+1; I=CC(Q); ! ONTO NEXT CHAR
REPEAT
IF I='_' AND 2<=CVALUE<33 THEN S=INT(CVALUE) AND ->RADIX
->ALPHA UNLESS MODE=0 AND I='.'
DOT: Q=Q+1; X=TEN; I=CC(Q)
DOTSEEN=1; ! CONSTANT HAS DECIMAL POINT
WHILE M'0'<=I<=M'9' CYCLE
CVALUE=CVALUE+(I&15)/X
X=TEN*X; Q=Q+1; I=CC(Q)
REPEAT
ALPHA: ! TEST FOR EXPONENT
IF MODE=0 AND CC(Q)='@' THEN START
Q=Q+1; X=CVALUE
Z=1; I=CC(Q)
IF I='-' THEN Z=-1
IF I='+' OR I='-' THEN Q=Q+1
CONST(2)
IF HIT=0 THEN RETURN
HIT=0
DOTSEEN=1; ! @ IMPLIES REAL IN IMP80
R=RR+1
IF A(R)>>4#4 THEN RETURN ; ! EXPONENT MUST BE HALFINTEGER
S=(A(R+1)<<8!A(R+2))*Z
IF S=-99 THEN CVALUE=0 ELSE START
WHILE S>0 CYCLE
S=S-1
CVALUE=CVALUE*TEN
REPEAT
WHILE S<0 AND CVALUE#0 CYCLE
S=S+1
CVALUE=CVALUE/TEN
REPEAT
FINISH
FINISH
! SEE IF IT IS INTEGER
IF FS='D' THEN START
I=CC(Q)
IF I='''' THEN Q=Q+1 ELSE RETURN
DOTSEEN=1; ! ENSURE NOT TAKEN AS INTEGER
FINISH
IF DOTSEEN=1 OR CVALUE>IMAX THEN CTYPE=2 C
ELSE CTYPE=1 AND S=INT(CVALUE)
IF CTYPE=1 THEN ->IEND
IF CPREC=5 THEN CPREC=6; ! ONLY 64 BIT REAL CONSTS
IF CPREC=6 THEN START
MOVEBYTES(8,ADDR(CVALUE),0,ADDR(A(0)),R); R=R+8
FINISH ELSE START ; ! PREC = 7 CONTSTANTS
MOVEBYTES(16,ADDR(CVALUE),0,ADDR(A(0)),R)
R=R+16
FINISH
A(RR)=CPREC<<4+CTYPE
HIT=1
END
ROUTINE TEXTTEXT(INTEGER EBCDIC)
!***********************************************************************
!* PROCESSES TEXT BETWEEN DOUBLE QUOTES AND STORES IN ISO OR EBCDIC *
!***********************************************************************
INTEGER J, II
CONSTINTEGER QU='"'
I=CC(Q)
S=R; R=R+1; HIT=0
RETURN UNLESS I=QU; ! FAIL UNLESS INITIAL QUOTE
Q=Q+1
CYCLE
I=CC(Q)
IF EBCDIC#0 THEN II=ITOETAB(I) ELSE II=I
A(R)=II; R=R+1
IF I=QU THEN START
Q=Q+1
IF CC(Q)#QU THEN EXIT
FINISH
IF I=10 THEN READLINE(1,QU) ELSE Q=Q+1
FAULT(106,0,0) IF R-S>256
REPEAT
R=R-1; J=R-S-1
A(S)=J; HIT=1
END
END ; ! OF ROUTINE PASS ONE
ENDOFFILE