         Edinburgh IMP77 Compiler - Version 8.4

    1  !IMP syntax checker - based on M68000 IMP compiler
    2  !                              (qv for fuller annotation)
    3  !  Hamish Dewar  Computer Science   Edinburgh University  1983
    4  !
    5  %constinteger MAXNAME=127
    6  %recordformat EDFILE(%integer start1,lim1, {part 1}
    7+                               start2,lim2, {part2}
    8+                               lim, {VMLIM}
    9+                               lbeg,fp,change,flag,
   10+                               line  {line number of current pos},
   11+                               diff  {diff between LINE and ROW},
   12+                               shift {right shift of window on file},
   13+                 %byteinteger  top  {top row of sub_window},
   14+                               win  {floating top},
   15+                               bot  {bottom row +1 of sub_window},
   16+                               min  {minimum window size},
   17+                               row  {last row position},
   18+                               col  {last col position},
   19+              %string(maxname) name)
   20  !
   21  %external%routine%spec EDI(%record(edfile)%name main,sec,
   22+                          %string(255) message)
   23  %external%routine%spec CONNECT EDFILE(%record(edfile)%name f)
   24  %external%routine%spec DISCONNECT EDFILE(%record(edfile)%name f)
   25  !
   26  !$IF VAX
   27  %conststring(13) permfile="ECCE_PERM"
   28  !$IF AMDAHL
   29  {%conststring(18) permfile="ERCLIB:VECCE.IPERM"
   30  !$FINISH
   31  
   32  !!  control
   33  %constinteger logbit=   16_00040000 {print log},
   34+               warnbit=  16_00020000 {print warnings},
   35+               nonsbit=  16_00010000 {print nonstandard reports},
   36+               DICTLIST= 16_00001000 {list dict entries},
   37+               EXPLIST=  16_00000800 {list EXP entries}
   38  %owninteger control=warnbit+nonsbit
   39  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
   40  %externalroutine ECCECI(%record(edfile)%name main)
   41  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
   42  %ownstring(maxname) extraname
   43  %ownrecord(edfile) extra=0,null=0
   44  %integer curstart,curlim
   45  %integer nonstop
   46  %owninteger change=0
   47  !!  Fault numbers
   48  %constinteger FORMERR=0, ATOMERR=1, NAMERR=2, CATERR=3, SIZERR=4,
   49+               ASSERR=5, TYPERR=6, DUPERR=7,
   50+               NOSTART=8, NOCYCLE=9,
   51+               ORDERERR=10, MATCHERR=11, RANGERR=12, NONLITERAL=13,
   52+               BOUNDSERR=14, ACCESSERR=15, NOTINLOOP=16,
   53+               NOTINROUT=17, NOTINFUN=18, NOTINPRED=19,
   54+               PLEXERR=20, NOIF=21, NONSTAND=22, NOTIN=23,
   55+               INDEXERR=24,
   56+               MOPERR=27, NOTERM=28, NONSTARTER=29,
   57+               NONVAR=30, NONREF=31, TOOMANY=32, TOOFEW=33,
   58+               UNWANTED=34, NOPARM=35, UNENDING=37,
   59+               SELFREF=38
   60  %constinteger NOEND=40, NOBEGIN=41,
   61+               IDMISSING=42, NOFINISH=43, NOREPEAT=44,
   62+               COUNTERR=45, NORESULT=46
   63  %constinteger ERRMAX=46
   64  %constinteger POINT=64,WARN=128
   65  %owninteger FAULTNUM=0
   66  %owninteger FAULTS=0;          !fault count
   67  !
   68  %constinteger MAXINT=16_7FFFFFFF, MININT=\MAXINT,
   69+               MAX10=maxint//10, MAXDIG=maxint-max10*10
   70  %constinteger FALSE=0, TRUE=1
   71  %integer I
   72  !
   73  !!  Program statistics
   74  %owninteger STATEMENTS=0;           !statement count
   75  !%owninteger ATOMS=0;                !atom count
   76  !%owninteger IDENTATOMS=0;           !identifier count
   77  !%owninteger NUMATOMS=0;             !numeric atom count
   78  !%owninteger MISSES=0;               !ident mismatches
   79  !%owninteger ZAPS=0
   80  !
   81  !!!!!!!!!!!!!!!!   Operand Representation  !!!!!!!!!!!!!!!!!!!
   82  
   83  %constinteger SMALLMIN=-1000, SMALLMAX=1000,
   84+               LITMIN=smallmax+1, LITMAX=smallmax+1000,
   85+               D0=litmax+1, D1=d0+1, D2=d0+2, D6=d0+6, D7=d0+7,
   86+               A0=d0+8, A1=a0+1, A6=a0+6, A7=a0+7,
   87+               INDA0=a0+8,
   88+               POSTA0=inda0+8, POSTA7=posta0+7,
   89+               PREA0=posta0+8, PREA7=prea0+7,
   90+               DICTMIN=prea0+8, DICTMAX=prea0+1200,
   91+               LABMIN=dictmax+1, LAB1=labmin+1, LABMAX=labmin+20,
   92+               EXPMIN=labmax+1, EXPMAX=labmax+300,
   93+               UNDEF=expmax+1, AD=16_4000
   94  %constinteger MAXDREG=d0+4, MAXAREG=a0+3
   95  %constinteger D0B=1, D1B=2, D2B=4,
   96+               A0B=16_100, A1B=16_200, A2B=16_400
   97  %constinteger ALLREGS=2_0000111100011111;  !a3:a0 & d4:d0
   98  %owninteger FREE=allregs
   99  %constinteger NULLTYPE=dictmin,
  100+               RECY=nulltype+1, ARRY=recy+1, STRINGY=arry+1,
  101+               REALY=stringy+1, INTY=realy+1,
  102+               CHARTYPE=inty+1, BOOLTYPE=chartype+1,
  103+               FALSECONST=booltype+1, TRUECONST=booltype+2,
  104+               INTTYPE=trueconst+1, SHORTTYPE=inttype+1,
  105+               HALFTYPE=shorttype+1, BYTETYPE=halftype+1,
  106+               MITETYPE=bytetype+1, BITTYPE=MITETYPE+1,
  107+               LONGINTTYPE=bittype+1,
  108+               REALTYPE=longinttype+1, LONGREALTYPE=realtype+1
  109  %constinteger PURETYPE=8191, DIRECT=8192, INDIRECT=16384
  110  %constinteger ANYINT=inty+direct, ANYINTVAR=inty+indirect,
  111+               ANYSTRING=stringy+direct, ANYSTRINGVAR=stringy+indirect
  112  %constinteger ANYNAME=nulltype+indirect
  113  
  114  !
  115  %owninteger dictshown=dictmin
  116  
  117  !!!!!!!!!!!!!!!!!!!!!!!   Big Literals  !!!!!!!!!!!!!!!!!!!!!!!
  118  %owninteger LITPOS=litmin, SLITPOS=litmax
  119  %integerarray LITSTORE(litmin:litmax)
  120  !
  121  !!!!!!!!!!!!!!!!!!!!!!!!!!  MODE VALUES  !!!!!!!!!!!!!!!!!!!!!!!!!
  122  !Size codes:
  123  %constinteger bytesize=1, wordsize=2, longsize=3
  124  %constinteger sizemask=16_C0, sizeshift=6
  125  !Address modes:
  126  %constinteger dmode=0, amode=2_001000,
  127+               indmode=2_010000, postmode=2_011000, premode=2_100000,
  128+               dispmode=2_101000, indexmode=2_110000, absmode=2_111000,
  129+               pcmode=2_111010, litmode=2_111100
  130  %constinteger ownmode=dispmode+6;  !d(A6)
  131  !
  132  !!!!!!!!!!!!!!!!!!!!!!!!  Identifiers  !!!!!!!!!!!!!!!!!!!!!!!!
  133  !
  134  %recordformat OBJINFO %C
  135+   (%integer flags,type,
  136+     (%integer extra, %byteinteger spare,mode %or %integer low),
  137+    %integer val)
  138  %recordformat IDENTINFO %C
  139+   ((%integer flags,type,
  140+     (%integer extra, %byteinteger spare,mode %or %integer low),
  141+    %integer val %or %record(objinfo) details),
  142+    %integer text,link)
  143  !
  144  ! Significance of FLAGS:
  145  %constinteger VAR=16_0001, LAB=16_0002, PROC=16_0004, STATIC=16_0008,
  146+               SPEC=16_0010, EXT=16_0020, PARM=16_0040, MORE=16_0080,
  147+               TYPEID=16_0100, OKFLAG=16_0200, ALT=16_0800,
  148+               RFLAG=16_1000,WFLAG=16_2000
  149  !
  150  ! Significance of VAL:
  151  !  for literal               : the actual value
  152  !  for variable              : machine address (displacement)
  153  !  for undefined label       : reference chain
  154  !  for undefined procedure   :       "
  155  !  for base type             : (index to) range
  156  !  for record type           : size of record in bytes
  157  !
  158  !  Identifier dictionary:
  159  %record(identinfo)%array DICT(d0:labmax)
  160  !  indexing DICT:
  161  %owninteger DLIM=trueconst+1;         !dict limit (up)
  162  %owninteger DLIM0
  163  %owninteger PERMLIM=dictmin
  164  %owninteger DMIN=dictmax-1;       !dict upper limit (down)
  165  
  166  !  Text of identifiers (indexed by _TEXT):
  167  %constinteger CHARBOUND=6000
  168  %byteintegerarray CHAR(0:charbound)
  169  %integer CHARBASE,CHARLIM,CHARMIN;  !pointers
  170  %integer NEWLEN
  171  
  172  !  Hash index to DICT:
  173  %integerarray HASHINDEX(0:255)
  174  %integername HEAD;                  !head of ident search list
  175  !
  176  !!!!!!!!!!!!!!!!!!!!!  Complex operands  !!!!!!!!!!!!!!!!!!!!!!!
  177  !%recordformat EXPINFO(%integer act,x,y)
  178  !%record(expinfo)%array EXP(expmin:expmax)
  179  %owninteger EXPLO=expmax+1, OLDEXPLO=expmax+1
  180  %constinteger NP0=expmin
  181  %owninteger NP,CONDNP,INSTNP
  182  
  183  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  184  !!!!!!!!!!!!!!!!!!  Keywords and operators  !!!!!!!!!!!!!!!!!!!!
  185  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  186  !*!!!!!!!  Keyword codes -- used by KEYGEN to produce tables  !!
  187  %constinteger END=1 {end},
  188+   REPEAT=2       {repeat},
  189+   FINISH=3       {finish},
  190+   ELSE=4         {else},
  191+   BEGIN=5        {begin},
  192+   EXIT=6         {exit_1,continue_0},
  193+   RETURN=7       {return},
  194+   TF=8           {true_1,false_0},
  195+   RESULT=9       {result},
  196+   STOP=10        {stop},
  197+   GOTO=11        {goto},
  198+   SIGNAL=12      {signal},
  199+   MONITOR=13     {monitor},
  200+   ON=15          {on},
  201+   IU=16          {if_0,unless_1},
  202+   WHILE=17       {while},
  203+   UNTIL=18       {until_1},
  204+   FOR=19         {for},
  205+   THEN=20        {then},
  206+   START=21       {start},
  207+   CYCLE=22       {cycle},
  208+   KEYLABEL=23    {label},
  209+   PREFIX=24 {const_9,constant_9,own_8,external_40,system_40,dynamic_40},
  210+   KRANGE=25      {short_1,half_2,byte_3,mite_4,bit_5},
  211+   KEYLONG=26     {long},
  212+   KEYINTEGER=27  {integer},
  213+   KEYREAL=28     {real},
  214+   KEYSTRING=29   {string},
  215+   KEYRECORD=30   {record},
  216+   KEYFORMAT=31   {format},
  217+   FNMAP=32       {fn_0,function_0,map_1},
  218+   RPRED=33       {routine_0,predicate_1},
  219+   KEYSPEC=34     {spec},
  220+   KEYARRAY=35    {array},
  221+   KEYNAME=36     {name},
  222+   KEYSWITCH=37   {switch},
  223+   OF=38          {of},
  224+   KEYFILE=39     {file},
  225+   PROGRAM=40     {program},
  226+   KEYLIST=41     {list},
  227+   KEYCONTROL=42  {control},
  228+   COMMENT=43     {comment},
  229+   KEYEVENT=44    {event},
  230+   INCLUDE=45     {include},
  231+   ALIAS=46       {alias},
  232+   KEYNOT=47      {not},
  233+   KEYAND=64      {and},
  234+   KEYOR=65       {or}
  235  %CONSTintegerARRAY SYMINIT(97:122) =  %C
  236+   2, 15, 27, 57, 64, 87,118,122,126,  1,  1,141,154,168,175,184,
  237+   1,199,230,270,278,  1,288,  1,  1,  1
  238  
  239  %CONSTBYTEINTEGERARRAY SYMBOL(1:292) =  %C
  240+ 128,114,114, 97,121,163,108,105, 97,115,174,110,100,192,101,103,
  241+ 105,110,133,121,116,101,153,105,116,153,111,110,116,105,110,117,
  242+ 101,134,121, 99,108,101,150,109,109,101,110,116,171,115,116, 97,
  243+ 110,116,152,152,114,111,108,170,121,110, 97,109,105, 99,152,110,
  244+ 100,129,108,115,101,132,120,105,116,134,118,101,110,116,172,116,
  245+ 101,114,110, 97,108,152,105,110,105,115,104,131, 97,108,115,101,
  246+ 136,111,114,109, 97,116,159,110,160,117,110, 99,116,105,111,110,
  247+ 160,147,108,101,167,111,116,111,139, 97,108,102,153,102,144,110,
  248+ 116,101,103,101,114,155, 99,108,117,100,101,173, 97, 98,101,108,
  249+ 151,111,110,103,154,105,115,116,169,111,110,105,116,111,114,141,
  250+ 105,116,101,153, 97,112,160, 97,109,101,164,111,116,175,110,143,
  251+ 119,110,152,102,166,114,193,114,101,100,105, 99, 97,116,101,161,
  252+ 111,103,114, 97,109,168,101,112,101, 97,116,130,111,117,116,105,
  253+ 110,101,161,116,117,114,110,135,115,117,108,116,137, 97,108,156,
  254+  99,111,114,100,158,116,111,112,138,105,103,110, 97,108,140,121,
  255+ 115,116,101,109,152,104,111,114,116,153,112,101, 99,162,119,105,
  256+ 116, 99,104,165, 97,114,116,149,114,105,110,103,157,114,117,101,
  257+ 136,104,101,110,148,110,108,101,115,115,144,116,105,108,146,104,
  258+ 105,108,101,145
  259  
  260  %CONSTBYTEINTEGERARRAY ALTDISP(1:292) =  %C
  261+   0,  5,  0,  0,  0,  0,  5,  0,  0,  0,  0,  0,  0,  0,  5,  0,
  262+   0,  0,  0,  4,  0,  0,  3,  0,  0,  5,  8, 12, 17, 23,  0,  0,
  263+   0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  4,
  264+   0,  0,  9,  9,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0, 40,  3,
  265+   0,  0,  4,  0,  0,  0,  4,  8,  0,  1,  0,  0,  0,  0,  0,  0,
  266+   0,  0,  0,  0,  0, 40,  6, 27,  0,  0,  0,  0,  5,  0,  0,  0,
  267+   0,  6,  0, 14,  0,  0,  0,  2,  0,  0,  0,  0,  0,  0,  0,  0,
  268+   0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  2,  2,  0,  0,
  269+   6,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  5,  0,  0,  0,
  270+   0,  4,  0,  0,  0,  0,  0,  0,  0,  7,  0,  0,  0,  0,  0,  0,
  271+   4,  0,  0,  4,  0,  0,  1,  4,  0,  0,  0,  0,  0,  0,  2,  0,
  272+   3,  0,  8,  2,  0,  0,  0,  0,  8,  0,  0,  0,  0,  0,  0,  1,
  273+   0,  0,  0,  0,  0,  0,  6, 12,  0,  0,  0,  0,  0,  0,  0,  0,
  274+   0,  0,  0,  5,  0,  0,  0,  0,  5,  0,  0,  0,  0,  3,  0,  0,
  275+   0,  0,  0,  0,  0,  4, 30,  0,  0,  6,  0,  0,  0,  0,  0,  6,
  276+   0,  0,  0,  0, 40,  5,  0,  0,  0,  1,  4,  0,  0,  0,  0,  0,
  277+   0,  0,  0,  0,  4,  0,  0,  0,  0,  0,  0,  0,  0,  4,  0,  0,
  278+   1,  0,  0,  0,  0,  0,  5,  0,  0,  0,  1,  0,  0,  0,  1,  0,
  279+   0,  0,  0,  0
  280  
  281  
  282  !*!!!!!!   end of generated tables    !!!!!!!!!!!!!!!!!!!!!!!!!!!
  283  !
  284  %constinteger TERMINATOR=52, CONST=53, IDENT=54,
  285+               AREF=55, RECREF=56,
  286+               MODSIGN=57,
  287+               COLON=58, COMMA=59, RIGHT=60, RIGHTBRACKET=61,
  288+               DUD=63
  289  
  290  !Operators (in banks of 8 acc to rank)
  291  %constinteger BOOLAND=64, BOOLOR=65, BOOLNOT=66,
  292+               FLOAT=67, IMOD=68, FMOD=69
  293  %constinteger EQUALS=70, NOTEQ=71, LESSEQ=72,
  294+               LESS=73, GREATEQ=74, GREATER=75,
  295+               EQEQ=76, NOTEQEQ=77, RESOLVE=79
  296  %constinteger PLUS=80, MINUS=81, LOGOR=82,
  297+               LOGXOR=83, CONCAT=84
  298  %constinteger MULT=88, FDIV=89, IDIV=90,
  299+               LOGAND=91
  300  %constinteger FPOWER=96, IPOWER=97,
  301+               LSHIFT=100, RSHIFT=101, LOGNOT=102
  302  %constinteger FCALL=106, MCALL=107
  303  %constinteger ATOMMAX=107
  304  
  305  ! Instruction actions:
  306  %constinteger swgoto=35, rcall=mcall+2,
  307+               assign=41, jamassign=42, plusass=43,
  308+               compare=44, jump=45, label=46, adecl=47
  309  %constinteger actmax=49
  310  !
  311  !Branch cases ( = machine condition-code)
  312  %constinteger EQ=2_0111, NE=2_0110,
  313+               GT=2_1110, LE=2_1111,
  314+               LT=2_1101, GE=2_1100,
  315+               CC=2_0100, CS=2_0101
  316  %constinteger DOUBLE=16
  317  
  318  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  319  ! Perm procedure identifiers which are recognised explicitly and
  320  !  either implemented in-line or mapped to system entry-point
  321  %constinteger DSHORT=dictmin+6, DLENGTH=dshort+1, DCHARNO=dlength+1,
  322+               DADDR=dcharno+1, DTOSTR=daddr+1,
  323+               DREM=dtostr+1,
  324+               DNEXTSYM=drem+1, DREADSYM=dnextsym+1,
  325+               DPRINTSTR=dreadsym+3,
  326+               DREAD=dictmin+27,
  327+               DNEWLINE=dictmin+41
  328  !System entry-points used explicitly
  329  %constinteger SIGENTRY=16_1114, SCOMPENTRY=16_1128,
  330+               BOUNDENTRY=16_1134, AGETENTRY=16_1138,
  331+               INDEXENTRY=16_113C, IREADENTRY=16_1118
  332  
  333  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  334  
  335  %owninteger STARTS=0, CYCLES=0
  336  %owninteger LOOPLAB=0
  337  %owninteger CURLAB=lab1
  338  !
  339  %recordformat BLOCKINF(%integer sp, delta, fortemps, flags, type,
  340+                   localdpos, parlim, localtext, localpc,
  341+                   localspc, pidpos, access, forward, events,
  342+                   eventpc, faults, return, shorts)
  343  !Flag bits (VAR=1 from D_FLAGS)
  344  %constinteger WRONGCC=2, NONLOCALREF=4, DYNARRAY=8
  345  %constinteger HADON=16_10, HADINST=16_20
  346  
  347  %constinteger OUTERLEVEL=0, MAXLEVEL=16
  348  %owninteger LEVEL=outerlevel;        !current block level
  349  %record(blockinf) C;                !info for current block
  350  %record(blockinf)%array HOLD(0:maxlevel-1); !info for global blocks
  351  
  352  ! Final core image
  353  %constinteger PUREBOUND=0, OWNBASE=purebound+1,
  354+               FINALBOUND=ownbase+8191
  355  %byteintegerarray FINAL(0:finalbound);  !for switch info only
  356  %owninteger FINALAD=2, OWNAD=ownbase
  357  !%owninteger FIRSTENTRY=finalbound, FIRSTDPOS=dictmax
  358  !%ownintegername CONSTAD;  !== ownad or finalad
  359  !%owninteger CONSTBOUND=purebound;   !for const/code
  360  !                     =finalbound;  !for own
  361  %owninteger PC=0, SPC=finalbound;  !for switch info
  362  
  363  !Recognition:-
  364  %constinteger CASEMASK=95, CASEBIT=32; !for case conversion
  365  
  366  !Memo variables for current statement:-
  367  %owninteger ITEM=0;          !current operand
  368  %record(objinfo) T;          !full typeinfo for ITEM
  369  %record(identinfo)%name DITEM
  370  %owninteger ELEMENTS; !range details
  371  %owninteger HASH
  372  %owninteger SPECCING=0, MCODING=0
  373  %owninteger DECLMODE, DSIZE
  374  %ownrecord(identinfo) D;            !declaration details
  375  
  376  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  377  
  378  !!  Source file input and listing
  379  %owninteger ATOM=0;                 !current lexical atom
  380  %owninteger MATCHED=1;              !indic that atom has been matched
  381  %owninteger SYM=nl;                 !current input symbol
  382  %owninteger LINE=0;                 !current line number
  383  %owninteger MAINLINE=0
  384  %owninteger DIAGLINE=-9999
  385  %owninteger PROLINE=0
  386  %owninteger MODESYM='&';            !space or '+' or '&' or '"'
  387  !%owninteger OUTCOL=0;               !output line position
  388  !   Pointers to source file:
  389  %owninteger LINESTART=0
  390  %owninteger FP=0;                   !(file pointer) current position
  391  %owninteger CHARS=0
  392  %owninteger ATOMP=0;                !start of current atom
  393  %owninteger FAULTP=0;               !fault position
  394  %owninteger MAINFP
  395  %owninteger STRINGP,EXPP
  396  %owninteger listout=0
  397  !
  398  !! Listing, diagnostic and report routines
  399  !
  400  %ownstring(255) rep=""
  401  !
  402  %routine NEWLINE
  403    print string(rep);  print symbol(nl)
  404    rep = ""
  405  %end
  406  !
  407  %routine PUT SYM(%integer k)
  408    rep = rep.tostring(k) %if length(rep) < 132
  409  %end
  410  !
  411  %routine PRINT STRING(%string(255) s)
  412    rep = rep.s %if length(rep) < 132
  413  %end
  414  !
  415  %routine SPACES(%integer n)
  416    %while n > 0 %cycle
  417      rep = rep." ";  n = n-1
  418    %repeat
  419  %end
  420  !
  421  %routine WRITE(%integer val,p)
  422  %routine PD(%integer v)
  423    p = p-1
  424    pd(v//10) %and v = v-v//10*10 %if v <= -10
  425    spaces(p) %and p = 0 %if p > 0
  426    put sym('0'-v)
  427  %end
  428    %if val < 0 %start
  429      put sym('-');  pd(val)
  430    %finish %else pd(-val)
  431  %end
  432  
  433  !%routine put ident(%integer t)
  434  !  rep = rep.string(charbase+t)
  435  !!%integer l
  436  !  t = t+charbase
  437  !  l = byteinteger(t);  l = 11 %if l > 11
  438  !  %while l > 0 %cycle
  439  !    l = l-1;  t = t+1
  440  !    put sym(byteinteger(t))
  441  !  %repeat
  442  !%end
  443  !
  444  !%routine mark at(%integer col)
  445  !  put sym(' ') %while outcol < col;  put sym('|')
  446  !%end
  447  !
  448  !%routine show dict(%integer from)
  449  !%integer f,i
  450  !%record(identinfo) d
  451  !%constbyteintegerarray flagsym(0:7) =
  452  !  'V','L','P','O','S','E', 'A', 'M'
  453  !%constbyteintegerarray dsym(0:3) =
  454  !  ' ','D','I','!'
  455  !%conststring(6)%array typetext(0:7) =
  456  !  "NULL  ", "RECORD", "ARRAY ", "STRING",
  457  !  "REALY ", "INTY  ", "CHAR  ", "BOOL  "
  458  !  %return %if from >= dlim
  459  !  newline %and outcol = 0 %if outcol # 0
  460  !  print string("          __identifier___flags___type___extra___value___")
  461  !  newline;  outcol = 0
  462  !  %cycle
  463  !    spaces(5);  outcol = 5
  464  !    pdec(from);  mark at(10)
  465  !    d = dict(from)
  466  !    put sym(' ')
  467  !    put ident(d_text)
  468  !    mark at(23)
  469  !    %for i = 7,-1,0 %cycle
  470  !      %if d_flags>>i&1 = 0 %then put sym(' ') %c
  471  !      %else put sym(flagsym(i))
  472  !    %repeat
  473  !    put sym('|')
  474  !    i = d_type-nulltype
  475  !    %if 0 <= i <= 7 %then printstring(typetext(i)) %c
  476  !    %else putsym(dsym(d_type>>13)) %and pdec(d_type&puretype)
  477  !    mark at(39)
  478  !    put sym(' ');  pdec(d_extra);  mark at(47)
  479  !    put sym(' ');  pdec(d_val);  mark at(56)
  480  !    newline;  outcol = 0
  481  !    from = from+1
  482  !  %repeat %until from = dlim
  483  !  print string("          +----------------------------------------------+")
  484  !  newline;  outcol = 0
  485  !%end
  486  !
  487  !%routine show exp(%integer from,to)
  488  !![out of date]
  489  !%conststring(7)%array acttext(0:63) =
  490  !  "?0", "?1", "ADD", "SUB",
  491  !  "?4", "LOGAND", "LOGOR", "LOGXOR",
  492  !  "NEGATE", "LOGNOT", "LSHIFT", "RSHIFT",
  493  !  "IABS", "FABS", "?14", "?15",
  494  !  "MULT", "IDIV", "IPOWER", "FPLUS",
  495  !  "FMINUS", "FMULT", "FDIV", "FPOWER",
  496  !  "FNEGATE", "FLOAT", "CONCAT", "BOOLNOT",
  497  !  "BOOLAND", "BOOLOR", "MEMBER", "MODULO",
  498  !  "RECREF", "AREF", "INDRECT", "SWJUMP",
  499  !  "FCALL", "MCALL", "?38", "RCALL",
  500  !  "?40", "ASSIGN", "JAMASS", "PLUSASS",
  501  !  "COMPARE", "JUMP", "LABEL", "ADECL",
  502  !  "?48", "?49", "?50", "?51",
  503  !  "?52", "?53", "?54", "?55",
  504  !  "?56", "?57", "?58", "?59",
  505  !  "?60", "?61", "?62", "?63"
  506  !%routine put operand(%integer i)
  507  !  %if dictmin <= i <= dictmax %then put ident(dict(i)_text) %else pdec(i)
  508  !%end
  509  !  %return %if from >= np
  510  !  newline %and outcol = 0 %if outcol # 0
  511  !  print string("          __action_____first_______second____")
  512  !  newline;  outcol = 0
  513  !  %cycle
  514  !    spaces(5);  outcol = 5
  515  !    pdec(from);  mark at(10)
  516  !    put sym(' ');  printstring(acttext(exp(from)_act&63))
  517  !    mark at(20);  put sym(' ')
  518  !    put operand(exp(from)_x)
  519  !    mark at(32);  put sym(' ')
  520  !    put operand(exp(from)_y)
  521  !    mark at(44)
  522  !    newline;  outcol = 0
  523  !    from = from+1
  524  !    %if from = to %start
  525  !      from = explo
  526  !      %exit %if from >= oldexplo
  527  !      printstring("          |---------------------------------|")
  528  !      newline;  outcol = 0
  529  !    %finish
  530  !  %repeat %until from >= oldexplo
  531  !  oldexplo = explo
  532  !  print string("          +---------------------------------+")
  533  !  newline;  outcol = 0
  534  !%end
  535  !
  536  !! Fault reporting
  537  !
  538  %routine REPORT(%integer n,joker)
  539  %integer mark,start,errline,k,editfp
  540  %routine PRINT IDENT(%integer x)
  541    put sym('"')
  542    print string(string(dict(x)_text+charbase))
  543    put sym('"')
  544  %end
  545  %routine PRINT TEXT(%integer x,stream)
  546  %constinteger esc=27
  547  %integer k,p
  548  %switch s(0:errmax)
  549    put sym(mark)
  550    write(line,4)
  551    put sym(modesym);  put sym(' ')
  552    ->s(n&63)
  553  s(formerr):   printstring("Faulty form");   -> print
  554  s(atomerr):   printstring("Unknown atom");  -> print
  555  s(namerr):    printstring("Unknown name");  -> print
  556  s(caterr):    printstring("Unsuitable");    -> print
  557  s(sizerr):    printstring("Size");          -> print
  558  s(typerr):    printstring("Wrong type");    -> print
  559  s(boundserr): printstring("Inside out");    -> print
  560  s(unending):  printstring("Endless loop");  -> print
  561  s(indexerr):  printstring("Index");         -> print
  562  s(accesserr): printstring("Not accessible");-> print
  563  s(notinloop): printstring("Not in loop");   -> print
  564  s(notinrout): printstring("Not in routine");-> print
  565  s(notinfun):  printstring("Not in fn/map"); -> print
  566  s(notinpred): printstring("Not in pred");   -> print
  567  s(plexerr):   printstring("Too complex!");  -> print
  568  s(duperr):    printstring("Duplicate");     -> print
  569  s(ordererr):  printstring("Out of order");  -> print
  570  s(matcherr):  printstring("Mismatch");      -> print
  571  s(rangerr):   printstring("Out of range");  -> print
  572  s(nonliteral):printstring("Not literal");   -> print
  573  s(nonstand):  printstring("Nonstandard");   -> print
  574  s(notin):     printstring("Not in yet");    -> print
  575  s(moperr):    printstring("Faulty operand");-> print
  576  s(nocycle):   printstring("Missing %CYCLE"); -> print
  577  s(nostart):   printstring("Missing %START"); -> print
  578  s(noif):      printstring("Missing %IF");    -> print
  579  s(noterm):    printstring("';' missing");    -> print
  580  s(nonstarter):printstring("Non-starter");    -> print
  581  s(nonvar):    printstring("Not variable");   -> print
  582  s(nonref):    printstring("Not reference");  -> print
  583  s(noparm):    printstring("No parameters");  -> print
  584  s(toofew):    printstring("Too few");        -> print
  585  s(unwanted):  printstring("Unwanted");       -> print
  586  s(toomany):   printstring("Too many");       -> print
  587  s(selfref):   printstring("Self-reference"); -> print
  588  s(nobegin):   printstring("Extra %END");     -> print
  589  print:
  590    spaces(21-length(rep))
  591    p = start
  592    %if p < faultp-50 %then p = faultp-47 %and printstring("...") %c
  593+   %else put sym(' ')
  594    %cycle
  595      k = byteinteger(p);  p = p+1
  596      %if p = faultp %start
  597  !$IF VAX
  598        put sym(esc) %and put sym('F') %if stream = 0
  599  !$FINISH
  600        put sym('~')
  601  !$IF VAX
  602        put sym(esc) %and put sym('G') %if stream = 0
  603  !$FINISH
  604      %finish
  605      %exit %if k = nl
  606      %if ' ' <= k <= '~' %then put sym(k) %c
  607+     %else put sym('[') %and write(k,-1) %and put sym(']')
  608    %repeat
  609    %return
  610  s(noend):     printstring("%END");           ->mend
  611  s(noresult):  printstring("Result");         ->mend
  612  s(nofinish):  printstring("%FINISH");        ->mend0
  613  s(norepeat):  printstring("%REPEAT")
  614  mend0:        printstring(" etc") %if curlab > lab1+2
  615                -> mend
  616  s(idmissing):
  617    %cycle
  618  !    newline %and spaces(8) %and outcol = 8 %if outcol > 50
  619      put sym(' ')
  620      print ident(x)
  621      print string("(?)") %if dict(x)_flags&spec = 0;  !switch
  622      x = dict(x)_val
  623    %repeat %until x = 0
  624  mend:
  625    printstring(" missing")
  626    %if c_type # 0 %start
  627      print string(" at END of ")
  628      print ident(c_pidpos)
  629    %finish %else n = 0
  630    %return
  631  s(counterr):
  632    %if elements < 0 %start
  633      write(-elements,0);  printstring(" extra")
  634    %finish %else %start
  635      write(elements,0);  printstring(" missing")
  636    %finish
  637    printstring(" value(s) for ")
  638    print ident(x)
  639    %return
  640  s(asserr):
  641    print ident(x)
  642    print string(" void")
  643  %end
  644  
  645  !Warning or error
  646    mark = '?'
  647    %if n&warn = 0 %start
  648      mark = '*'
  649      c_faults = c_faults+1;  faults = faults+1
  650    %finish
  651    faultnum = 0;  c_access = -1
  652  !Ignore uncorrected earlier error
  653    %return %if main_start1 <= fp < change
  654  !Track back if before current line
  655    start = linestart;  errline = line
  656    %if n&point = 0 %then faultp = 0 %else %start
  657      faultp = joker %if joker > 0
  658      %while faultp <= start %cycle
  659        start = start-1
  660        errline = errline-1 %if byteinteger(start) = nl
  661      %repeat
  662      start = start-1 %while start # curstart %and byteinteger(start-1) # nl
  663    %finish
  664    editfp = start;  editfp = faultp-1 %if faultp > start
  665    editfp = mainfp %if curlim = extra_lim2
  666    start = start+1 %while byteinteger(start) = ' '
  667    print text(joker,0)
  668    newline %and %return %if n&warn # 0 %or nonstop # 0
  669    main_fp = editfp;  main_line = line
  670    %if change # 0 %then main_change = 16_7FFFFFFE
  671    edi(main,null,rep)
  672    rep = ""
  673    nonstop = 1 %if main_flag = 'I'
  674    %stop %if main_flag < 0
  675    %signal 12 %if main_change < 16_7FFFFFFE {change made}
  676   %end;
?K unused
  677        ;  !report
  677  
  678  %routine CROAK(%string(255) s)
  679    print string("** ".s.".  Checking abandoned at line ")
  680    write(line,0);  newline
  681    nonstop = -999
  682    %signal 12
  683  %end
  684  
  685  %routine FAULT(%integer n)
  686  !Note fault number and position of (earliest) fault
  687  ! for subsequent reporting (warnings and weak errors)
  688    faultnum = n %and faultp = atomp %if faultnum = 0
  689  %end
  690  %routine EXPFAULT(%integer n)
  691    faultnum = n!point %and faultp = expp %if faultnum = 0 %or expp < faultp
  692  %end
  693  
  694  %constinteger pred=1, uparr=1<<1, nocomma=1<<2, overload=1<<3,
  695+               ranges=1<<4, nolength=1<<5, initass=1<<6, kgoto=1<<7,
  696+               hyphen=1<<8, naming=1<<9, klabel=1<<10, ibmhex=1<<11,
  697+               oldcycle=1<<12, loop2=1<<13
  698  %routine NONSTANDARD(%integer case)
  699  %owninteger hadit=0
  700    %if control&nonsbit # 0 %and case&hadit = 0 %start
  701      hadit = hadit+case
  702      fault(nonstand+point+warn)
  703    %finish
  704  %end
  705  
  706  %routine ERROR(%integer case)
  707    report(case,atomp)
  708    %signal 14
  709  %end
  710  
  711  %routine NAME ERROR
  712  !check if the culprit has occurred before
  713  !and, if not, add it to the pool of unknowns stored at the
  714  !far end of the dictionary.
  715    %while item < 0 %c
  716+      %and string(dict(-item)_text+charbase) # string(charlim) %cycle
  717       item = dict(-item)_link
  718    %repeat
  719    %if item >= 0 %start;  !first time
  720      report(namerr+point,atomp)
  721      %if charmin-newlen-80 >= charlim %start
  722        dmin = dmin-1
  723        charmin = charmin-newlen-1
  724        string(charmin) = string(charlim)
  725        dict(dmin)_text = charmin-charbase
  726        head == dict(head)_link %while head > 0;  !find last link
  727        dict(dmin)_link = head;  head = -dmin
  728      %finish
  729    %finish
  730    %signal 14
  731  %end
  732  
  733  %routine SYNTAX ERROR
  734  %integer e
  735    e = formerr+point;  e = atomerr+point %if atom = dud
  736    report(e,atomp)
  737    %signal 14
  738  %end
  739  
  740  !!!!!!!!!!!!!!!!!!!!   CELL  CONSTRUCTORS  !!!!!!!!!!!!!!!!!!!
  741  !
  742  !%integerfn litref(%integer v)
  743  !%integer i
  744  !  %result = v %if smallmin <= v <= smallmax
  745  !  litstore(litpos) = v
  746  !  i = litmin-1
  747  !  i = i+1 %until litstore(i) = v
  748  !  %if i = litpos %start
  749  !    litpos = litpos+1
  750  !    croak("Too many literals") %if litpos >= slitpos
  751  !  %finish
  752  !  %result = i
  753  !%end
  754  
  755  !%integerfn litval(%integer v)
  756  !  %result = v %if v <= smallmax
  757  !  %result = litstore(v)
  758  !%end
  759  
  760  %integerfn floated(%integer item)
  761    %result = 0 %if item = 0
  762    %result = explo;!expref(float,item,0)
  763  %end
  764  
  765  !%predicate is short (%integer v)
  766  !  %true %if -32768 <= v <= 32767
  767  !  %false
  768  !%end
  769  
  770  !%predicate is mite (%integer v)
  771  !  %true %if -128 <= v <= 127
  772  !  %false
  773  !%end
  774  
  775  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  776  !!!!!!!!!!!!!!!!!    CODE  GENERATION   !!!!!!!!!!!!!!!!!!!!!!!!
  777  !
  778  %routine forget
  779  %end
  780  %routine forget all
  781  %integer i,j
  782    litpos = litmin;  explo = expmax+1;  oldexplo = explo
  783  %end
?J unused
?I unused
  784  !
  785  %routine set label(%integer b)
  786  %end;
?B unused
  787       ;  !set label
  787  %routine set user label(%integer dpos)
  788  %end
?DPOS unused
  789  %routine compile(%integer from,to)
  790  !  show exp(from,to) %if control&explist # 0
  791    np = np0
  792  %end
?TO unused
?FROM unused
  793  %routine compile entry
  794  %end
  795  %routine compile end
  796  %end;  !compile end
  797  !!!!!!!!!!!!!!!  end of Code Generation  !!!!!!!!!!!!!!!!!!!!!!!
  798  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  799  
  800  %routine PUT3(%integer act,x,y)
  801  !  exp(np)_act = act;  exp(np)_x = x;  exp(np)_y = y
  802  !  np = np+1
  803  %end
?Y unused
?X unused
?ACT unused
  804  !
  805  %routine PUT2(%integer act,x)
  806  %end
?X unused
?ACT unused
  807  !
  808  %integerfn TEMPVAR
  809    %result = dlim
  810  %end
  811  
  812  %routine OPEN BLOCK(%integer pidpos)
  813    forget;  !a bit extreme
  814    croak("Too many levels") %if level = maxlevel
  815    hold(level) = c;  level = level+1
  816    c = 0
  817    starts = 0;  cycles = 0
  818    curlab = lab1;  looplab = 0
  819    forget all
  820    c_flags = 0;  c_type = d_type
  821    c_pidpos = pidpos
  822    c_localdpos = dlim;  c_parlim = dlim;  c_localtext = charlim
  823    c_localpc = pc;  c_localspc = spc
  824    c_access = 1
  825  %end;  !OPEN BLOCK
  826  
  827  %routine CLOSE BLOCK
  828  %integer i
  829  %integer miss,dpos
  830  %integername p
  831  %record(identinfo)%name dp
  832    !Check identifier usage
  833    miss = 0;  p == miss
  834    dpos = c_localdpos
  835    %while dpos # dlim %cycle
  836      dp == dict(dpos)
  837  !    %if (dp_xtype = ptrxtype %and dp_type = dpos)
  838      %if dp_flags&(proc+lab) # 0 %and dp_flags&(ext+spec) = spec %start
  839            p = dpos;  p == dp_val;  p = 0
  840      %finish
  841  !    %if hashindex(dp_spare) = dpos %start
  842  !      dp_link = dict(dp_link)_link %while dp_link >= c_localdpos
  843  !      hashindex(dp_spare) = dp_link
  844  !    %finish
  845  !    dpos = dp_xtype %if dp_type = 0 %and dp_xtype > dpos;  !skip fields
  846      dpos = dpos+1
  847    %repeat
  848    report(idmissing,miss) %if miss # 0
  849    compile end
  850    pc = c_localpc;  spc = c_localspc
  851    dlim = c_parlim;  charlim = c_localtext
  852    %for i = 0,1,255 %cycle
  853       hashindex(i) = dict(hashindex(i))_link %while hashindex(i) >= c_localdpos
  854    %repeat
  855    level = level-1;  c = hold(level)
  856    starts = 0;  cycles = 0
  857  %end;  !CLOSE BLOCK
  858  
  859  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  860  !!!!!!!!!!!!!!!!!!!!  Source input  !!!!!!!!!!!!!!!!!!!!!!!!!!!!
  861  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  862  !
  863  %routine SWITCH INPUT
  864  !  croak("Input ended") %if fp = main_lim2
  865    %signal 12 %if fp = main_lim2
  866    %if nonstop < 0 %start;  !perming
  867      nonstop = nonstop+3;  permlim = dlim
  868      c_localdpos = dlim;  c_parlim = dlim
  869      statements = 0
  870    %finish
  871    %if fp # main_lim1 %start
  872      nonstop = nonstop-1
  873      fp = mainfp;  line = mainline
  874      curstart = main_start1;  curlim = main_lim1
  875    %finish %else fp = main_start2
  876    %if main_start2 <= fp <= main_lim2 %start
  877      curstart = main_start2;  curlim = main_lim2
  878    %finish
  879    modesym = ' ';  sym = nl
  880  %end
  881  
  882  %routine READ LINE
  883  ! Read (or otherwise make available) the next source line
  884  !     Skip remnant of previous line if SYM # NL        *NB*
  885  !     Set LINESTART to point to start of new line
  886    report(faultnum,faultp) %if faultnum # 0
  887    %while sym # nl %cycle;               !Skip remnant
  888      sym = byteinteger(fp);  fp = fp+1
  889    %repeat
  890    %while fp = curlim %cycle
  891      switch input
  892    %repeat
  893    line = line+1;  linestart = fp
  894    sym = 0
  895  %end;  !READ LINE
  896  !
  897  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  898  !!!!!!!!!!!!!!!!!!!!  Lexical processing  !!!!!!!!!!!!!!!!!!!!!!
  899  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  900  
  901  %owninteger percent=0, subatom=0
  902  !
  903  !Aliases:
  904  %constinteger ARROW=resolve
  905  %constinteger EXCLAM=logor, EXCLAM2=logxor, DOT=concat
  906  %constinteger STAR=mult, SLASH=fdiv, SLASH2=idiv,
  907+               AMPERSAND=logand
  908  %constinteger BACKSLASH=fpower, BACKSLASH2=ipower,
  909+               UPARROW=fpower,   UPARROW2=ipower,
  910+               TILDE=lognot
  911  %constinteger LEFT=aref, UNDERLINE=recref, LEFTBRACKET=106
  912  
  913  %constinteger SIMPLE=104, MAJOR=plus,
  914+               SCOND=equals, COND=keyand
  915  !
  916  ! Type compatibility vectors:
  917  %constinteger RECOK=1<<0, ARROK=1<<1, STRINGOK=1<<2,
  918+               REALOK=1<<3, INTOK=1<<4, CHAROK=1<<5, 
  919+               BOOLOK=1<<6, ENUMOK=1<<7, SETOK=1<<8
  920  %constinteger ZNOP=1<<9, REFONLY=1<<10, VARONLY=1<<11
  921  %constinteger ARITHOK=intok+realok,
  922+               ORDOK=intok+charok+boolok+enumok,
  923+               ANY=realok+ordok+stringok+arrok+recok
  924  !
  925  %constintegerarray opbits(64:atommax) =
  926+   {BOOLAND}    boolok,
  927+   {BOOLOR}     boolok,
  928+                0, 0, 0, 0,
  929+   {EQUALS}     any,
  930+   {NOTEQ}      any,
  931+   {LESSEQ}     setok+stringok+ordok+realok,
  932+   {LESS}       stringok+ordok+realok,
  933+   {GREATEQ}    setok+stringok+ordok+realok,
  934+   {GREATER}    stringok+ordok+realok,
  935+                any,
  936+                any,
  937+                0,
  938+   {RESOLVE}    stringok,
  939+   {PLUS}       znop+setok+arithok,
  940+   {MINUS}      znop+setok+arithok,
  941+   {LOGOR}      znop+intok,
  942+   {LOGXOR}     znop+intok,
  943+   {CONCAT}     stringok,
  944+                0, 0, 0,
  945+   {MULT}       arithok,
  946+   {FDIV}       arithok,
  947+   {IDIV}       intok,
  948+   {LOGAND}     intok,
  949+                0, 0, 0, 0,
  950+   {FPOWER}     arithok,
  951+   {IPOWER}     intok,
  952+                0, 0,
  953+   {LSHIFT}     znop+intok,
  954+   {RSHIFT}     znop+intok,
  955+   {LOGNOT}     intok,
  956+                0,
  957+   {AREF}       arrok,
  958+   {RECREF}     recok,
  959+   {}           0, 0
  960  !
  961  %integerfn NEXT ATOM
  962  !Encode next atom from source file
  963  ![Time-critical]
  964  %switch s(0:255)
  965  %constinteger tab=9
  966  %integer i,j,p,radix,digits
  967  %real rval
  968  %constbyteintegerarray map(0:127) =
  969+   0 ('0'),
  970+   '0','1','2','3','4','5','6','7','8','9',
  971+   0, 0, 0, 0, 0, 0, 0,
  972+   'a','b','c','d','e','f','g','h','i','j','k','l','m',
  973+   'n','o','p','q','r','s','t','u','v','w','x','y','z',
  974+   0, 0, 0, 0, 0, 0,
  975+   'a','b','c','d','e','f','g','h','i','j','k','l','m',
  976+   'n','o','p','q','r','s','t','u','v','w','x','y','z',
  977+   0, 0, 0, 0, 0
  978  
  979  %routine assemble real
  980    j = 0
  981    %cycle
  982      %cycle
  983        sym = byteinteger(fp);  fp = fp+1
  984      %repeat %until sym # ' '
  985      i = sym-'0'
  986      %return %unless 0 <= i < radix
  987      rval = rval*radix+i;  j = j+1
  988    %repeat
  989  %end
  990  
  991  !  atoms = atoms+1
  992    matched = 0
  993  again: s(tab):
  994    read line %if sym = nl
  995    %cycle
  996      sym = byteinteger(fp);  fp = fp+1
  997    %repeat %until sym # ' '
  998    atomp = fp;     !(actually one after)
  999    -> s(sym)
 1000  linebreak: s(nl):
 1001    %result = terminator %if atom # comma
 1002    -> again
 1003  
 1004  s('{'):
 1005    %cycle
 1006      sym = byteinteger(fp);  fp = fp+1
 1007      -> linebreak %if sym = nl
 1008    %repeat %until sym = '}'
 1009    -> again
 1010  
 1011  s('+'): %result = plus
 1012  s('-'): fp = fp+1 %and %result = arrow %if byteinteger(fp) = '>'
 1013          -> again %if byteinteger(fp) = nl
 1014          %result = minus
 1015  s('*'): %result = star
 1016  s('/'): fp = fp+1 %and %result = slash2 %if byteinteger(fp) = '/'
 1017          %result = slash
 1018  s('\'): fp = fp+1 %and %result = backslash2 %if byteinteger(fp) = '\'
 1019          %result = backslash
 1020  s('^'): nonstandard(uparr)
 1021          fp = fp+1 %and %result = uparrow2 %if byteinteger(fp) = '^'
 1022          %result = uparrow
 1023  s('!'): fp = fp+1 %and %result = exclam2 %if byteinteger(fp) = '!'
 1024          %result = exclam
 1025  s('&'): %result = ampersand
 1026  s('.'): %result = dot
 1027  s('='): fp = fp+1 %and %result = eqeq %if byteinteger(fp) = '='
 1028          %result = equals
 1029  s('#'): fp = fp+1 %and %result = noteqeq %if byteinteger(fp) = '#'
 1030          %result = noteq
 1031  s('<'): fp = fp+1 %and %result = lesseq %if byteinteger(fp) = '='
 1032          fp = fp+1 %and %result = noteq %if byteinteger(fp) = '>'
 1033          fp = fp+1 %and %result = lshift %if byteinteger(fp) = '<'
 1034          %result = less
 1035  s('>'): fp = fp+1 %and %result = greateq %if byteinteger(fp) = '='
 1036          fp = fp+1 %and %result = rshift %if byteinteger(fp) = '>'
 1037          %result = greater
 1038  s('_'): %result = underline
 1039  s(':'): %result = colon
 1040  s(','): %result = comma
 1041  s(';'): %result = terminator
 1042  s('('): %result = left
 1043  s(')'): %result = right
 1044  s('|'): %result = modsign
 1045  
 1046  s('E'): s('e'):
 1047    fp = fp+1 %and -> stringconst %if byteinteger(fp) = '"'
 1048  s('M'): s('m'): s('C'): s('c'):
 1049    fp = fp+1 %and -> charconst %if byteinteger(fp) = ''''
 1050  s('A'):s('B'):s('D'):s('F'):s('G'):s('H'):
 1051  s('I'):s('J'):s('K'):s('L'):s('N'):s('O'):s('P'):
 1052  s('Q'):s('R'):s('S'):s('T'):s('U'):s('V'):s('W'):s('X'):
 1053  s('Y'):s('Z'):s('a'):s('b'):s('d'):s('f'):
 1054  s('g'):s('h'):s('i'):s('j'):s('k'):s('l'):s('n'):
 1055  s('o'):s('p'):s('q'):s('r'):s('s'):s('t'):s('u'):s('v'):
 1056  s('w'):s('x'):s('y'):s('z'):
 1057    -> keyword %if percent # 0
 1058  !  identatoms = identatoms+1
 1059    newlen = charlim+1;  hash = sym!casebit;  !lower-case (if letter)
 1060    byteinteger(newlen) = hash
 1061    %cycle
 1062      sym = byteinteger(fp);  fp = fp+1
 1063    %repeat %until sym # ' '
 1064  !$IF AMDAHL
 1065  {  %if sym = '''' %start
 1066  {    radix = 16 %and -> ibm %if hash = 'x'
 1067  {    radix = 8 %and -> ibm %if hash = 'k'
 1068  {    radix = 2 %and -> ibm %if hash = 'b'
 1069  {  %finish
 1070  !$FINISH
 1071    sym = map(sym)
 1072    %if sym # 0 %start
 1073      %cycle
 1074        newlen = newlen+1;  byteinteger(newlen) = sym
 1075        hash = hash<<1!!sym
 1076        %cycle
 1077          sym = byteinteger(fp);  fp = fp+1
 1078        %repeat %until sym # ' '
 1079        sym = map(sym)
 1080      %repeat %until sym = 0
 1081    %finish
 1082    fp = fp-1
 1083    newlen = newlen-charlim;  byteinteger(charlim) = newlen
 1084    head == hashindex(hash&255)
 1085    item = head
 1086    %if item > 0 %start
 1087      %cycle
 1088        %result = ident %if item <= 0
 1089        ditem == dict(item)
 1090        %exit %if string(ditem_text+charbase) = string(charlim)
 1091  !      misses = misses+1
 1092        item = ditem_link
 1093      %repeat %until item <= 0
 1094    %finish
 1095    %result = ident
 1096  
 1097  s('%'):
 1098    sym = byteinteger(fp)
 1099    -> again %unless 'a' <= sym!casebit <= 'z'
 1100    fp = fp+1
 1101  keyword:
 1102    percent = 0
 1103    p = syminit(sym!casebit)
 1104    %cycle
 1105  !     %cycle
 1106  !       sym = byteinteger(fp)!casebit
 1107  !       %exit %if symbol(p) # sym
 1108      %while symbol(p) = byteinteger(fp)!casebit %cycle
 1109        p = p+1;  fp = fp+1
 1110      %repeat
 1111      %exit %if symbol(p) >= 128
 1112      atom = altdisp(p)
 1113      %if atom = 0 %start
 1114        %result = dud %unless sym!casebit = 'c' %and byteinteger(fp) = nl
 1115        read line
 1116        ->again
 1117      %finish
 1118      p = p+atom
 1119    %repeat
 1120    percent = 1 %if 'a' <= byteinteger(fp)!casebit <= 'z'
 1121    subatom = altdisp(p)
 1122    atom = symbol(p)-128
 1123    %result = dud %if atom = 0
 1124    %result = atom
 1125  
 1126  !$IF AMDAHL
 1127  {ibm:
 1128  {  nonstandard(ibmhex)
 1129  {  item = -1;  t_val = 0
 1130  {  -> ibm1
 1131  !$FINISH
 1132  s('0'):s('1'):s('2'):s('3'):s('4'):s('5'):s('6'):s('7'):s('8'):s('9'):
 1133    item = 0;  t_type = inty
 1134    radix = 10;  t_val = sym-'0'
 1135  ibm1:
 1136    %cycle
 1137      %cycle
 1138        %cycle
 1139          sym = byteinteger(fp);  fp = fp+1
 1140        %repeat %until sym # ' '
 1141        i = sym-'0'
 1142        %if radix = 10 %start
 1143          %exit %if i < 0 %or i >= 10
 1144          %if t_val > max10 %or (t_val=max10 %and i > maxdig) %start
 1145            t_type = realy;  rval = t_val
 1146            assemble real
 1147            %exit
 1148          %finish
 1149          t_val = t_val*10+i
 1150        %finish %else %start
 1151          i = sym!casebit-'a'+10 %if i >= 10
 1152          %exit %if i < 0 %or i >= radix
 1153          j = radix
 1154          %cycle
 1155            i = i+t_val %if j&1 # 0
 1156            t_val = t_val<<1;  j = j>>1
 1157          %repeat %until j = 0
 1158          t_val = i
 1159        %finish
 1160      %repeat
 1161      %exit %unless sym = '_'
 1162      radix = t_val
 1163      %result = dud %if radix = 0
 1164      t_val = 0
 1165    %repeat
 1166    %if sym = '.' %start
 1167      t_type = realy %and rval = t_val %if t_type = inty
 1168      assemble real
 1169      %result = dud %if j = 0
 1170      rval = rval/radix\j
 1171    %finish
 1172  !  %if t_type = realy %start;  !vax->ieee
 1173  !    t_val = integer(addr(rval))
 1174  !    t_val = t_val<<16+t_val>>16-16_01000000
 1175  !  %finish
 1176  !  numatoms = numatoms+1
 1177  !$IF AMDAHL
 1178  {  %if item < 0 %start
 1179  {    %result = dud %if sym # ''''
 1180  {    item = 0
 1181  {  %finish %else %start
 1182  {    fp = fp-1;  sym = 0
 1183  {  %finish
 1184  !$IF VAX OR APM
 1185    fp = fp-1;  sym = 0
 1186  !$FINISH
 1187    %result = const
 1188  
 1189  s(''''):
 1190  charconst:
 1191    item = 0;  t_type = inty
 1192    t_val = 0
 1193    %cycle
 1194      sym = byteinteger(fp);  fp = fp+1
 1195      %result = dud %if sym = nl;  !?allow
 1196      %if sym = '''' %start
 1197        %exit %unless byteinteger(fp) = ''''
 1198        fp = fp+1
 1199      %finish
 1200      t_val = t_val<<8+sym
 1201    %repeat
 1202    %result = const %if t_val # 0
 1203    %result = dud
 1204  
 1205  s('"'):
 1206  stringconst:
 1207    item = 0;  t_type = stringy
 1208    stringp = atomp;  !for include
 1209    t_val = 0
 1210    i = line;  j = linestart
 1211    %cycle
 1212      sym = byteinteger(fp);  fp = fp+1
 1213      %if sym = '"' %start
 1214        %exit %if byteinteger(fp) # '"'
 1215        fp = fp+1
 1216      %finish
 1217      t_val = t_val+1
 1218      %if t_val > 255 %start
 1219        sym = 0
 1220        fp = atomp;  linestart = j
 1221        %result = dud
 1222      %finish
 1223      read line %if sym = nl
 1224    %repeat
 1225    %result = const
 1226  
 1227  s(*):
 1228    %result = dud
 1229  %end;
?IBM1 unused
?DIGITS unused
 1230       ;  !NEXT ATOM
 1230  
 1231  %routine LOOKUP FIELD IDENT(%integer list)
 1232    item = list;  %return %if item = 0
 1233    %cycle
 1234      ditem == dict(item)
 1235      %if ditem_flags&typeid = 0 %start
 1236        %return %if string(ditem_text+charbase) = string(charlim)
 1237        %exit %if ditem_flags&more = 0
 1238      %finish
 1239      item = item+1;  !misses = misses+1
 1240    %repeat
 1241    item = 0
 1242  %end
 1243  
 1244  %predicate A (%integer k)
 1245  !Basic atom-testing predicate
 1246    atom = next atom %if matched # 0
 1247    %false %if k # atom
 1248    matched = 1
 1249    %true
 1250  %end
 1251  
 1252  %routine GET(%integer k)
 1253    atom = next atom %if matched # 0
 1254    matched = 1
 1255    %return %if atom = k
 1256    syntax error %if atom = dud
 1257    faultp = atomp;  report(formerr+point,-k)
 1258    %signal 14
 1259  %end
 1260  
 1261  %routine ALLOW(%integer k)
 1262    %if a(k) %start
 1263    %finish
 1264  %end
 1265  
 1266  %routine DECLARE
 1267    %if speccing = 0 %start;  !not within spec params
 1268      %if item >= c_localdpos %start;  !there already
 1269        %if d_flags&spec = 0 %and d_flags+spec = ditem_flags %c
 1270+       %and ditem_type = d_type %start
 1271          ditem_flags = ditem_flags-spec
 1272          %return
 1273        %finish
 1274        fault(duperr+point)
 1275      %finish
 1276      d_link = head;  head = dlim;  !insert in list
 1277  !    d_spare = hash&255
 1278      %if item > 0 %then d_text = ditem_text %c
 1279+     %else %start
 1280        d_text = charlim-charbase;  charlim = charlim+newlen+1
 1281        croak("Identifier space exhausted") %if charlim+80 >= charmin
 1282      %finish
 1283    %finish %else d_text = 0
 1284    item = dlim;  ditem == dict(item)
 1285    ditem = d
 1286    dlim = dlim+1;  croak("Too many identifiers") %if dlim >= dmin
 1287  %end;  !DECLARE
 1288  
 1289  %routine DECLARE ANON
 1290    d_text = 0;  d_link = 0
 1291    dict(dlim) = d
 1292    dlim = dlim+1;  croak("Too many identifiers") %if dlim >= dmin
 1293  %end
 1294  
 1295  %owninteger jammy
 1296  %predicate A ASSOP
 1297    atom = next atom %if matched # 0
 1298    %if atom # equals %and atom # eqeq %start
 1299      %false %unless atom = less %and byteinteger(fp) = '-'
 1300      jammy = 2;  fp = fp+1
 1301    %finish %else jammy = 0
 1302    matched = 1
 1303    %true
 1304  %end
 1305  
 1306  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 1307  !!!!!!!!!!!!!!!!!!!!  Expressions  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 1308  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 1309  
 1310  %owninteger literal=0
 1311  %routinespec get EXPRESSION(%integer rank,control)
 1312  
 1313  %integerfn COMPAT(%integer control)
 1314    %if t_type = inty %start
 1315      %if control&intok = 0 %and control&realok # 0 %start
 1316        item = floated(item)
 1317        t_type = realy
 1318      %finish
 1319      %result = control&(intok+realok)
 1320    %finish
 1321    %result = control&(boolok>>(booltype-t_type)) %if t_type <= booltype
 1322    %result = control&enumok %if t_type < direct
 1323    %result = control&arrok
 1324  %end
 1325  !
 1326  %integerfn LISTMATCH(%integer alist,blist)
 1327  %record(identinfo)%name ap,bp
 1328    %result = 1 %if alist = blist
 1329    %result = 0 %if alist < dictmin %or blist < dictmin
 1330    %cycle
 1331      ap == dict(alist);  bp == dict(blist)
 1332      %result = 0 %if ap_type # bp_type;  !for now
 1333      alist = alist+1;  blist = blist+1
 1334    %repeat %until ap_flags&bp_flags&more = 0
 1335    %result = 0 %if ap_flags&more # 0 %or bp_flags&more # 0;  !for now
 1336    %result = 1
 1337  %end
 1338  !
 1339  %routine GET REFERENCE(%integer reftype)
 1340  %integer type,temp
 1341    get EXPRESSION(simple,refonly+any)
 1342    type = ditem_type&puretype;  reftype = reftype&puretype
 1343    %return %if reftype = type
 1344    %if type < reftype %start
 1345      temp = type;  type = reftype;  reftype = temp
 1346    %finish
 1347    %return %if reftype = nulltype;  !untyped %name
 1348    type = dict(type)_type
 1349    %return %if type <= inty %and type = reftype
 1350    %return %if type >= direct %and type = dict(reftype)_type;  !aname
 1351    expfault(typerr+point)
 1352  %end
 1353  !
 1354  %routine GET VALUE(%integer valtype)
 1355  %record(identinfo)%name dp,p
 1356    get EXPRESSION(major,any)
 1357    valtype = valtype&puretype
 1358    dp == dict(valtype)
 1359    %if t_type # dp_type %start;  !base types differ
 1360      %return %if item = 0 = t_val;  !zero
 1361      %if dp_type = realy %and t_type = inty %start
 1362        !float
 1363        t_type = realy
 1364        %return
 1365      %finish
 1366    %else %if t_type >= inty;  !scalar
 1367      %if item = 0 %start
 1368        %return %if dp_low <= t_val <= dp_val
 1369        jammy = jammy!1 %if jammy >= 0
 1370      %finish %else %start
 1371        %if t_low >= dp_low %start
 1372          %return %if t_val <= dp_val
 1373          jammy = jammy!1 %if jammy >= 0
 1374          %return %if t_low <= dp_val
 1375        %finish %else %start
 1376          jammy = jammy!1 %if jammy >= 0
 1377          %return %if t_val >= dp_low
 1378        %finish
 1379      %finish
 1380      expfault(rangerr+point) %if jammy < 2
 1381      %return
 1382    %else %if t_type = stringy
 1383      %if t_val > dp_val %start;  !VALUE = LENGTH*
 1384        jammy = jammy!1 %if jammy >= 0
 1385        expfault(rangerr+point) %if item = 0 %and jammy < 2
 1386      %finish
 1387      %return
 1388    %else %if t_type = recy
 1389      %return %if t_extra = dp_extra
 1390      jammy = jammy!1 %and %return %if jammy >= 2
 1391      !partial assignment?
 1392    %else %if t_type = realy
 1393      %return
 1394    %finish
 1395    expfault(typerr+point)
 1396  %end;
?P unused
 1397       ;  !GET VALUE
 1397  !
 1398  %routine GET LITERAL(%integer littype)
 1399    literal = literal+1
 1400    get VALUE(littype)
 1401    literal = literal-1
 1402  %end
 1403  !
 1404  %routine GET LITINT
 1405    literal = literal+1
 1406    get EXPRESSION(major,intok)
 1407    literal = literal-1
 1408  %end
 1409  !
 1410  %routine GET LITSTRING
 1411  %integer holditem
 1412  !Must be quoted string (for %alias and %include)
 1413    holditem = item;  !preserve
 1414    get(const)
 1415    error(typerr+point) %if t_type # stringy
 1416    item = holditem;  !restore
 1417  %end
 1418  !
 1419  %routine GET PARMLIST
 1420  %record(identinfo)%name hp,dp
 1421  %integer i,j,headitem,headact,dpos,case,procnp,first
 1422    headitem = item;  hp == ditem
 1423    headact = rcall
 1424    !stack procedure ident
 1425  !  procnp = np;  put3(headact,headitem,0)
 1426    i = 0;  first = 1
 1427    dpos = headitem;  dp == hp
 1428    %cycle
 1429    !Set up expression state from formal param details
 1430      error(toomany+point) %if dp_flags&more = 0
 1431      dpos = dpos+1 %and dp == dict(dpos) %until dp_flags&parm # 0
 1432      %if dp_flags&proc # 0 %start
 1433        get(ident)
 1434        name error %if item <= 0
 1435        fault(typerr+point) %if ditem_flags&proc = 0;  !for now
 1436        fault(caterr+point) %if item > headitem
 1437      %else %if dp_type < indirect;  !value
 1438  !      %if pp_type&numericmask # 0 %then case = i&7 %and i = i+1 %c
 1439  !      %else case = i>>3+8 %and i = i+8
 1440        case = i&7;  i = i+1
 1441        get VALUE(dp_type)
 1442      %finish %else %start;  !name or proc
 1443        case = i>>3+8;  i = i+8
 1444        get REFERENCE(dp_type)
 1445      %finish
 1446  !    case = case<<8+headact
 1447  !    item = litref(t_val) %if item = 0
 1448  !    j = np-1
 1449  !    %if first = 0 %start
 1450  !      j = np
 1451  !      !NB Don't re-order parameters for implicits
 1452  !      %if item >= expmin %and headitem > dnewline %start
 1453  !        %while j > procnp %and exp(j-1)_y < expmin %cycle
 1454  !          exp(j)_act = exp(j-1)_act;  exp(j)_y = exp(j-1)_y
 1455  !          j = j-1
 1456  !        %repeat
 1457  !      %finish
 1458  !      exp(np)_x = 0;  np = np+1
 1459  !    %finish
 1460  !    exp(j)_act =  case;  exp(j)_y = item
 1461  !    first = 0
 1462    %repeat %until %not a(comma)
 1463  !  %if hp_type # nulltype %start
 1464  !    i = explo
 1465  !    %while i <= expmax %cycle
 1466  !      %if exp(i)_x = headitem %start;  ![enough?]
 1467  !        item = i;  j = procnp
 1468  !        %cycle
 1469  !          %exit %if exp(i)_y # exp(j)_y
 1470  !          i = i+1;  j = j+1
 1471  !          ->okf %if j >= np
 1472  !        %repeat
 1473  !      %finish
 1474  !      i = i+1
 1475  !    %repeat
 1476  !    %cycle
 1477  !      explo = explo-1;  np = np-1
 1478  !      exp(explo) = exp(np)
 1479  !    %repeat %until np = procnp
 1480      item = explo
 1481  !okf:np = procnp
 1482  !  %finish
 1483  %end;
?PROCNP unused
?J unused
 1484       ;  !get PARMLIST
 1484  
 1485  %routine GET RESOLUTION
 1486    %if %not a(left) %start
 1487      get REFERENCE(anystringvar)
 1488      get(dot)
 1489      get(left)
 1490    %finish
 1491    get VALUE(anystring)
 1492    get(right)
 1493    %if a(dot) %start
 1494      get REFERENCE(anystringvar)
 1495    %finish
 1496  %end
 1497  !
 1498  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 1499  !
 1500  %routine GET EXPRESSION(%integer rank,control)
 1501  !Main expression recognition routine
 1502  !To bring together the treatment of all binary operators
 1503  ! and ensure fast recognition of simple expressions,
 1504  ! expressions of different levels are handled by
 1505  ! precedence techniques rather than syntactically
 1506  !CONTROL defines acceptability
 1507  %integer type,f,opok,c1,op,atomp1,item1
 1508  %record(objinfo) t1
 1509  %record(identinfo)%name dp
 1510  
 1511  %integerfn litval
 1512  %switch lit(64:atommax)
 1513    -> lit(op)
 1514  lit(plus):    %result = t1_val+t_val
 1515  lit(minus):   %result = t1_val-t_val
 1516  lit(mult):    %result = t1_val*t_val
 1517  lit(idiv):    %result = t1_val//t_val %if t_val # 0
 1518                fault(rangerr)
 1519                %result = 0
 1520  lit(logand):
 1521  lit(booland): %result = t1_val&t_val
 1522  lit(logor):
 1523  lit(boolor):  %result = t1_val!t_val
 1524  lit(logxor):  %result = t1_val!!t_val
 1525  lit(lshift):  %result = t1_val<<t_val
 1526  lit(rshift):  %result = t1_val>>t_val
 1527  lit(boolnot): %result = t_val!!true
 1528  lit(lognot):  %result = \t_val
 1529  !lit(negate):  %result = -t_val
 1530  lit(equals):  %result = true %if t1_val = t_val
 1531                %result = false
 1532  lit(noteq):   %result = true %if t1_val # t_val
 1533                %result = false
 1534  lit(lesseq):  %result = true %if t1_val <= t_val
 1535                %result = false
 1536  lit(less):    %result = true %if t1_val < t_val
 1537                %result = false
 1538  lit(greateq): %result = true %if t1_val >= t_val
 1539                %result = false
 1540  lit(greater): %result = true %if t1_val > t_val
 1541                %result = false
 1542  lit(concat):  %result = t1_val+t_val
 1543  lit(*):       !report(notwhat,-op)
 1544                %result = 1
 1545  %end
 1546  
 1547  !Get leading operand
 1548    atom = next atom %if matched # 0
 1549    atomp1 = atomp;  !note position for reports
 1550    %if atom = ident %start
 1551      matched = 1
 1552      name error %if item <= 0
 1553      fault(selfref+point) %if item >= dlim0
 1554      type = ditem_type
 1555      %if control&(refonly+varonly) # 0 %start
 1556        error(nonvar+point) %if control&varonly # 0 %and f&var = 0
 1557        error(nonref+point) %if type < direct
 1558      %finish
 1559      f = ditem_flags
 1560      %if inty <= type <= booltype %and f&proc = 0 %start;  !literal
 1561        item = 0;  t = ditem_details
 1562      %else
 1563        fault(nonliteral+point) %if literal > 0
 1564        %if f&proc # 0 %start
 1565          ditem == dict(type) %and type = ditem_type %if f&parm # 0
 1566          error(caterr+point) %if type = nulltype;  !routine
 1567          %if a(left) %start
 1568            dp == ditem
 1569            get PARMLIST;  get(right)
 1570            ditem == dp
 1571          %else
 1572            error(toofew+point) %if ditem_flags&more # 0
 1573            item = explo;!expref(f&var+fcall,item,0)
 1574          %finish
 1575        %finish
 1576        %cycle
 1577          dp == dict(type&puretype);  t = dp_details
 1578          atom = next atom %if matched # 0
 1579          %exit %if atom # underline %and atom # left
 1580          matched = 1
 1581          item1 = item
 1582          %if atom = left %start
 1583            %cycle
 1584              syntax error %if t_type < direct;  !element type
 1585              type = t_type
 1586              get VALUE(t_val);  !index
 1587              item = explo;!expref(aref,item1,item,t_val)
 1588              ditem == dp
 1589              %exit %if %not a(comma)
 1590              dp == dict(type&puretype);  t = dp_details
 1591              item1 = item
 1592            %repeat
 1593            get(right)
 1594          %else;  !rec subfield
 1595            syntax error %if t_type # recy
 1596            get(ident)
 1597            lookup field ident(t_extra)
 1598            error(namerr+point) %if item <= 0
 1599            type = ditem_type
 1600            item = explo;!expref(recref,item,item1)
 1601          %finish
 1602        %repeat
 1603        -> final %if control&(varonly+refonly) # 0
 1604      %finish
 1605    %else
 1606      error(nonvar+point) %if control&varonly # 0
 1607      error(nonref+point) %if control&refonly # 0
 1608      %if a(const) %start
 1609      %else %if atom = minus;  !leave unmatched
 1610        item = 0;  t = 0;  t_type = inty
 1611      %else %if a(left)
 1612        %if rank < major %start;  !condition
 1613          get EXPRESSION(cond,any)
 1614        %finish %else %start
 1615          jammy = jammy-4
 1616          c1 = control;  c1 = c1!intok %if c1&realok # 0
 1617          get EXPRESSION(major,c1)
 1618          jammy = jammy+4
 1619        %finish
 1620        get(right)
 1621      %else %if a(keynot)
 1622        syntax error %if rank >= major
 1623        get EXPRESSION(scond,any)
 1624        %if item = 0 %then t_val = t_val!!true %c
 1625+       %else item = explo;!expref(boolnot,item,0)
 1626      %else %if atom = backslash
 1627        item = 0;  t = 0;  t_type = inty
 1628        atom = tilde
 1629      %else %if a(modsign)
 1630        fault(typerr+point) %if control&arithok = 0
 1631        get EXPRESSION(major,arithok)
 1632        get(modsign)
 1633        %if item = 0 %start
 1634          %if t_val < 0 %start
 1635            %if t_val # minint %then t_val = -t_val %else expfault(rangerr)
 1636          %finish
 1637        %else %if t_type = inty
 1638          item = explo;!expref(imod,item,0)
 1639        %else %if t_type = realy
 1640          item = explo;!expref(fmod,item,0)
 1641        %else
 1642          error(typerr)
 1643        %finish
 1644      %else
 1645        syntax error
 1646      %finish
 1647    %finish
 1648    atom = next atom %if matched # 0
 1649    %while atom >= rank %cycle
 1650      op = atom;  matched = 1
 1651      opok = opbits(op);  c1 = compat(opok);  ![may change ITEM,T_TYPE]
 1652      fault(typerr+point) %if c1 = 0
 1653      item1 = item;  t1 = t
 1654      %if op >= major %start;  !non-conditional
 1655        %if op = dot %then get EXPRESSION(dot,stringok) {right-associate} %c
 1656+       %else get EXPRESSION(op&(\7)+8,c1)
 1657        %if t_type = realy %and t1_type = inty %start
 1658          item1 = floated(item1);  t1_type = realy
 1659        %finish
 1660  !      op = op+? %if t_type = realy %and opok&intok # 0
 1661      %else
 1662         %if op = resolve %start
 1663           get RESOLUTION
 1664        %else %if op >= eqeq
 1665          get EXPRESSION(simple,any+refonly)
 1666        %else %if op >= equals
 1667          get EXPRESSION(major,c1)
 1668          %if equals <= atom < eqeq %start
 1669            op = atom;  matched = 1
 1670            get EXPRESSION(major,c1)
 1671          %finish
 1672          %if t_type = realy %and t1_type = inty %start
 1673            item1 = floated(item1);  t1_type = realy
 1674          %finish
 1675        %else
 1676          get EXPRESSION(scond,any)
 1677          %if atom >= cond %start
 1678            syntax error %if atom # op
 1679          %finish
 1680        %finish
 1681        t_type = booltype
 1682        t_low = 0 %and t_val = 1 %if item # 0
 1683      %finish
 1684      %if item1 = 0 %start;  !first operand literal
 1685        %if item = 0 %start;  !both literal
 1686          t_val = litval
 1687          %continue %if item = 0
 1688  !        item1 = litref(t1_val)
 1689  !     %else %if inverse(op) # 0;  !invertable
 1690  !        op = inverse(op)
 1691  !        temp = t;  t = t1;  t1 = temp;  !standardise order
 1692  !        item1 = item;  item = 0
 1693        %else
 1694  !        item1 = litref(t1_val)
 1695        %finish
 1696      %finish
 1697      %if item = 0 %start;  !second operand literal
 1698        %if op = minus %and t_type = inty %start;  !standardise
 1699          t_val = -t_val %if t_val # minint;  op = plus
 1700        %finish
 1701        item = item1 %and %continue %if t_val = 0 %and opok&znop # 0
 1702      %finish
 1703      item = explo;!expref(op,item1,item,t_val)
 1704      t_low = minint;  t_val = maxint;  !?real
 1705    %repeat
 1706  final:
 1707    expp = atomp1;  !restore to start
 1708    expfault(typerr) %if compat(control) = 0
 1709  %end;  !get EXPRESSION
 1710    
 1711  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 1712  !!!!!!!!!!!!!!!!!!!!  Conditions and loops  !!!!!!!!!!!!!!!!!!!!
 1713  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 1714  !
 1715  %routine GET CONDITION
 1716  %integer polarity
 1717    polarity = subatom
 1718    condnp = np
 1719    get EXPRESSION(cond,any)
 1720  !  put3(jump+polarity,item,0)
 1721  %end;  !get CONDITION
 1722  
 1723  %routine GET STATEMENTS(%integer stopper)
 1724  %integer holdnp,holdlooplab
 1725  %switch initial(0:atommax)
 1726  
 1727  %routine GET INSTRUCTION
 1728  %integer item1,hold,act
 1729  %record(identinfo)%name ditem1
 1730  %routine putact
 1731  !  put3(act,t_val,hold)
 1732  %end
 1733  !
 1734    %if c_flags < hadinst %start;  !first in block
 1735      c_flags = c_flags+hadinst
 1736      fault(ordererr) %if level <= outerlevel
 1737    %finish
 1738    instnp = np
 1739    %cycle
 1740      %if a(ident) %start
 1741        name error %if item <= 0
 1742        %if ditem_flags&var # 0 %start
 1743          matched = 0
 1744          get EXPRESSION(simple,any)
 1745          item1 = item;  ditem1 == ditem
 1746          %if a(equals) %start
 1747            get VALUE(ditem1_type)
 1748  !          put2(assign,item1)
 1749         %else %if a(eqeq)
 1750            syntax error %if ditem1_type < indirect
 1751            get REFERENCE(ditem1_type)
 1752            item = item+ad %if item # 0
 1753  !          put2(assign,item1+ad)
 1754         %else %if atom = less %and byteinteger(fp) = '-'
 1755            fp = fp+1;  matched = 1
 1756            jammy = 2
 1757            get VALUE(ditem1_type)
 1758  !          put2(jamassign,item1)
 1759          %else
 1760            syntax error %if %not a(arrow)
 1761            get RESOLUTION
 1762  !          put2(resolve,item1)
 1763          %finish
 1764        %else
 1765          error(caterr+point) %if ditem_flags&proc = 0
 1766          ditem == dict(ditem_type) %if ditem_flags&parm # 0
 1767          error(caterr+point) %if ditem_type # nulltype
 1768          %if a(left) %start
 1769            get PARMLIST;  get(right)
 1770          %else;  !parameterless routine
 1771            error(toofew+point) %if ditem_flags&more # 0
 1772  !          put3(rcall,item,0)
 1773          %finish
 1774        %finish
 1775      %finish %else %start
 1776        act = atom;  hold = subatom;  t_val = 0
 1777        c_access = 0
 1778        %if a(monitor) %start
 1779          c_access = 1
 1780  !        fault(monitor<<8)
 1781        %else %if a(exit);  !%exit, %continue
 1782          %if looplab = 0 %then fault(notinloop+point) %c
 1783+         %else t_val = looplab %and putact
 1784          %exit
 1785        %else %if a(return)
 1786          %if c_type # nulltype %then fault(notinrout+point) %c
 1787+         %else putact
 1788          %exit
 1789        %else %if a(result)
 1790          error(notinfun+point) %if c_type <= nulltype
 1791          syntax error %if %not a assop
 1792          %if c_type < direct %start;  !function
 1793            fault(caterr+point) %if atom = eqeq
 1794            get VALUE(c_type)
 1795  !          put2(result,0)
 1796          %else;  !map
 1797            fault(caterr+point) %if atom # eqeq
 1798            get REFERENCE(c_type+(indirect-direct))
 1799  !          put2(result,0)
 1800          %finish
 1801          %exit
 1802        %else %if a(tf);  !%true, %false
 1803          %if c_type # booltype %then fault(notinpred+point) %c
 1804+         %else putact
 1805          %exit
 1806        %else %if a(arrow) %or a(goto)
 1807          nonstandard(kgoto) %if atom = goto
 1808          get(ident)
 1809          %if byteinteger(fp) # '(' %start
 1810            %if item < c_localdpos %or ditem_flags&lab = 0 %c
 1811+           %or ditem_type # nulltype %start
 1812              d_flags = spec+lab;  d_type = nulltype
 1813              declare
 1814            %finish
 1815  !          put3(jump,item,0)
 1816          %finish %else %start
 1817            name error %if item < c_localdpos
 1818            syntax error %if ditem_flags&lab = 0 %or ditem_type = nulltype
 1819            get(left)
 1820            get VALUE(ditem_type);  !index
 1821            get(right)
 1822          %finish
 1823          %exit
 1824        %else %if a(stop)
 1825          putact
 1826          %exit
 1827        %else %if a(signal)
 1828          c_access = 1
 1829          allow(keyevent)
 1830          get LITINT
 1831          expfault(rangerr+point) %unless 0 <= t_val <= 15
 1832          hold = t_val;  t_val = 0
 1833          get LITINT %if a(comma)
 1834          hold = t_val<<4+hold
 1835          item = 0;  t_val = 0
 1836          get VALUE(anyint) %if a(comma)
 1837  !        put2(act,hold)
 1838          %exit
 1839        %else
 1840          syntax error
 1841        %finish
 1842      %finish
 1843    %repeat %until %not a(keyand)
 1844  %end;  !GET INSTRUCTION
 1845  
 1846  %routine GET FOR CLAUSE
 1847  %integer loopvar,k,s,start,sval,i,inc,ival,e,n,temp
 1848  %integer eval
 1849  %record(identinfo)%name dp
 1850    holdnp = np;  temp = 0
 1851    dict(curlab)_val = 1;  !dummy
 1852    condnp = np
 1853    get(ident)
 1854    name error %if item <= 0
 1855    fault(typerr+point) %if dict(ditem_type&puretype)_type # inty
 1856    fault(caterr+point+warn) %if ditem_type # direct+inttype
 1857    loopvar = item;  dp == ditem
 1858    get(equals)
 1859    get VALUE(ditem_type)
 1860    start = item;  sval = t_val
 1861    get(comma)
 1862    get VALUE(anyint)
 1863    inc = item;  ival = t_val
 1864    expfault(rangerr+point) %and ival = 1 %if inc = 0 = ival
 1865    get(comma)
 1866    get VALUE(ditem_type)
 1867  !Deal with INC and replace START by START-INC
 1868  !  k = undef
 1869  !  k = exp(start)_y %if start >= expmin %and exp(start)_act = plus
 1870    %if inc = 0 %start;  !literal increment
 1871      i = 1;  !litref(ival)
 1872      %if start = 0 %start;  !START and INC both literal
 1873        sval = sval-ival;  s = 1;  !litref(sval)
 1874  !   %else %if k <= litmax;  !START is x+lit
 1875  !      k = ival-litval(k)
 1876  !      s = exp(start)_x;  s = explo;!expref(plus,s,litref(k)) %if k # 0
 1877      %else
 1878        s = explo;!expref(plus,start,litref(-ival))
 1879      %finish
 1880    %finish %else %start;  !allocate temp var
 1881  !    i = tempvar;  put3(assign,i,inc);  temp = temp-4
 1882  !    %if start = inc %start;  !identical
 1883  !      s = 0;  sval = 0
 1884  !   %else %if k = inc;  !START is x+INC
 1885  !      s = exp(start)_x
 1886  !    %else
 1887  !      s = start;  s = litref(sval) %if s = 0
 1888        s = explo;!expref(minus,s,i)
 1889  !    %finish
 1890    %finish
 1891  !  %if item = 0 %start;  !literal end-value
 1892  !    e = litref(t_val);  eval = t_val
 1893  !  %finish %else %start
 1894  !    e = tempvar;  put3(assign,e,item);  temp = temp-4
 1895  !  %finish
 1896  !  put3(assign,loopvar,s)
 1897  !  put3(label,curlab,0)
 1898    %if start!inc!item = 0 %start;  !all literal
 1899      k = t_val-sval;  n = k//ival
 1900      fault(boundserr) %if n < 0
 1901      fault(unending) %if n*ival # k
 1902  !    %if 0 <= t_val <= 32767 %start
 1903  !      temp = loopvar
 1904  !    %finish
 1905    %finish
 1906  !  %if temp <= 0 %start
 1907  !    c_fortemps = c_fortemps-temp;  !ie increment
 1908  !    put3(compare,loopvar,e)
 1909  !    put3(eq,0,curlab+1)
 1910  !  %finish
 1911  !  put3(plusass,loopvar,i)
 1912  !  compile(holdnp,np)
 1913  %end;
?EVAL unused
?E unused
 1914       ;  !get FORCLAUSE
 1914  
 1915  %routine GET SWITCH INDEX
 1916  %integer item1
 1917  %record(identinfo)%name dp
 1918    item1 = item;  dp == ditem
 1919    get(left)
 1920    item = 1
 1921    %if a(star) %start
 1922      fault(duperr+point) %if dp_spare # 0
 1923      dp_spare = 1
 1924    %else
 1925      get LITERAL(dp_type)
 1926     !beware faulty declaration or index
 1927      %if dp_type > inttype %and faultnum = 0 %start
 1928        t_val = t_val-dict(dp_type)_low+dp_val
 1929        expfault(duperr+point) %if final(t_val) # 0
 1930  !      define jumps(final(t_val));  !in case of lit jumps
 1931        final(t_val) = 1
 1932      %finish
 1933    %finish
 1934    get(right)
 1935    c_access = 1
 1936  %end
 1937  
 1938  ![unsure of efficiency implications of trapping overflow lower down]
 1939  %on %event 1,14 %start
 1940  !$IF VAX
 1941    report(rangerr,0) %if event_event = 1
 1942  !$IF AMDAHL
 1943  {  report(rangerr,0) %if eventinf>>8 = 1
 1944  !$FINISH
 1945    -> skip
 1946  %finish
 1947  !!!!!!!!!!!!!!!!!!!  Start of new statement  !!!!!!!!!!!!!!!!!!!
 1948  next:
 1949    statements = statements+1
 1950  next1:
 1951    report(faultnum,faultp) %if faultnum # 0
 1952    d = 0;  declmode = 0;  dsize = 0
 1953    dlim0 = dlim;  elements = 0
 1954    speccing = 0;  mcoding = 0
 1955    literal = 0;  jammy = 0
 1956    dict(curlab)_val = 0;  dict(curlab+1)_val = 0
 1957    np = np0;  instnp = np0;  condnp = np0
 1958  !  constad == finalad;  constbound = purebound
 1959    %if explo < expmin+50 %or litpos > litmax-50 %start
 1960      !zaps = zaps+1;  zaps = zaps+999 %if litpos > litmax-50
 1961      forget all
 1962    %finish
 1963    t_val = 0
 1964  !
 1965  initial(terminator):
 1966    atom = next atom;  matched = 1
 1967    -> initial(atom)
 1968  initial(star): initial(exclam): initial(exclam2):
 1969    read line
 1970    -> next1
 1971  term:
 1972    get(terminator)
 1973    -> next
 1974  
 1975  skip:
 1976    c_access = -1
 1977    %if atom # terminator %start
 1978      %cycle
 1979        subatom = atom;  atom = next atom
 1980      %repeat %until atom = terminator
 1981      starts = starts+1 %if subatom = start
 1982      cycles = cycles+1 %if subatom = cycle
 1983    %finish
 1984    -> next
 1985  
 1986  initial(dud):
 1987    syntax error;  !ie atom error
 1988  
 1989  initial(*):
 1990    error(nonstarter+point)
 1991  
 1992  initial(ident):
 1993    %if byteinteger(fp) = ':' %start;  !simple label
 1994      fp = fp+1
 1995      d_flags = lab;  d_type = nulltype
 1996      declare
 1997      set user label(item)
 1998      ->next
 1999    %finish
 2000    name error %if item <= 0
 2001    %if ditem_flags&lab # 0 %start
 2002      get SWITCH INDEX
 2003      get(colon)
 2004      ->next
 2005    %finish
 2006  initial(return): initial(result): initial(tf):
 2007  initial(stop): initial(signal): initial(monitor):
 2008  initial(exit): initial(goto): initial(arrow):
 2009    matched = 0
 2010    get INSTRUCTION
 2011    -> next %if a(terminator)
 2012    c_access = 1
 2013    %if a(iu) %start
 2014      holdnp = np
 2015      get CONDITION
 2016  !    compile(holdnp,np)
 2017    %else %if a(while)
 2018      holdnp = np
 2019  !    put3(label,curlab,0)
 2020      get CONDITION
 2021  !    compile(holdnp,np)
 2022  !    put3(jump,curlab,0)
 2023  !    put3(label,curlab+1,0)
 2024    %else %if a(for)
 2025      get FOR CLAUSE
 2026  !    put3(jump,curlab,0)
 2027  !    put3(label,curlab+1,0)
 2028    %else
 2029      syntax error %if %not a(until)
 2030      get CONDITION
 2031    %finish
 2032    -> term
 2033  
 2034  initial(iu):  !%if, %unless
 2035    %cycle
 2036      holdnp = np
 2037      get CONDITION
 2038  !    compile(holdnp,np)
 2039      %if a(then) %start
 2040        -> fudge %if a(start)
 2041        get INSTRUCTION
 2042      %finish %else %start
 2043        get(start)
 2044  fudge:
 2045        %cycle
 2046          get(terminator)
 2047          curlab = curlab+2
 2048          get STATEMENTS(else)
 2049          curlab = curlab-2
 2050          %exit %if atom # else;  !%finish ->
 2051          get CONDITION %if a(iu)
 2052        %repeat
 2053        %return %if atom # finish
 2054      %finish
 2055      %exit %if %not a(else)
 2056      -> fudge %if a(start)
 2057      get INSTRUCTION %and %exit %if %not a(iu)
 2058    %repeat
 2059    -> term
 2060  
 2061  initial(cycle):
 2062    %if a(terminator) %start
 2063      holdlooplab = looplab;  looplab = curlab
 2064      curlab = curlab+2
 2065      get STATEMENTS(repeat)
 2066      curlab = curlab-2;  looplab = holdlooplab
 2067      %return %if atom # repeat
 2068      get CONDITION %if a(until)
 2069      -> term
 2070    %finish
 2071    nonstandard(oldcycle)
 2072    get FOR CLAUSE
 2073    -> for1
 2074  initial(while):
 2075    holdnp = np
 2076  !  put3(label,curlab,0)
 2077    get CONDITION
 2078  !  compile(holdnp,np)
 2079    get(cycle)
 2080    get(terminator)
 2081    holdlooplab = looplab;  looplab = curlab
 2082    curlab = curlab+2
 2083    get STATEMENTS(repeat)
 2084    curlab = curlab-2;  looplab = holdlooplab
 2085    %return %if atom # repeat
 2086    nonstandard(loop2) %and get CONDITION %if a(until)
 2087  !  put3(jump,curlab,0)
 2088  !  put3(label,curlab+1,0)
 2089    ->term
 2090  initial(for):
 2091    get FOR CLAUSE
 2092    get(cycle)
 2093  for1:
 2094    get(terminator)
 2095    holdlooplab = looplab;  looplab = curlab
 2096    curlab = curlab+2
 2097    get STATEMENTS(repeat)
 2098    curlab = curlab-2;  looplab = holdlooplab
 2099    %return %if atom # repeat
 2100  !  put3(repeat,0,0)
 2101    -> term
 2102  
 2103  initial(on):
 2104    fault(ordererr+point) %if c_flags >= hadon %or level <= outerlevel
 2105    c_flags = c_flags!hadon
 2106    matched = 1
 2107    allow(keyevent)
 2108    %cycle
 2109      get LITINT
 2110      expfault(rangerr+point) %unless 0 <= t_val <= 15
 2111      c_events = c_events!1<<t_val
 2112    %repeat %until %not a(comma)
 2113    get(start)
 2114  !  put3(on,0,0)
 2115    curlab = curlab+2
 2116    get STATEMENTS(finish)
 2117    curlab = curlab-2
 2118    %return %if atom # finish
 2119    -> term
 2120  !
 2121  initial(else):
 2122    -> skip %if starts # 0
 2123    %return %if stopper = else
 2124    error(noif) %if stopper = finish
 2125  initial(finish):
 2126    starts = starts-1 %and -> skip %if starts # 0
 2127    %return %if stopper = finish %or stopper = else
 2128    error(nostart)
 2129  initial(repeat):
 2130    cycles = cycles-1 %and -> skip %if cycles # 0
 2131    %return %if stopper = repeat
 2132    error(nocycle)
 2133  
 2134  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 2135  !!!!!!!!!!!!!!!!!!!!  Declarations  !!!!!!!!!!!!!!!!!!!!!!!!!!!!
 2136  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 2137  !
 2138  %integerfn NEWATYPE(%integer eltype,xtype)
 2139  %integer dpos
 2140  %record(identinfo)%name dp
 2141  %ownrecord(identinfo) d=0
 2142    dpos = dictmin
 2143    %cycle
 2144      dp == dict(dpos)
 2145      %result = dpos+direct %if dp_flags&typeid # 0 %c
 2146+                    %and dp_type = eltype %and dp_val = xtype
 2147      dpos = dpos+1
 2148    %repeat %until dpos = dlim
 2149    d_flags = typeid;  d_type = eltype;  d_val = xtype
 2150    dict(dpos) = d
 2151    dlim = dlim+1;  croak("Too many identifers") %if dlim >= dmin
 2152    %result = dpos+direct
 2153  %end
 2154  !
 2155  %integerfn NEWSTYPE(%integer max)
 2156  %integer dpos
 2157  %record(identinfo)%name dp
 2158  %ownrecord(identinfo) d=0
 2159    dpos = dictmin
 2160    %cycle
 2161      dp == dict(dpos)
 2162      %result = dpos %if dp_type = stringy %and dp_val = max
 2163      dpos = dpos+1
 2164    %repeat %until dpos = dlim
 2165    d_flags = typeid;  d_type = stringy
 2166    d_val = max
 2167    dict(dpos) = d
 2168    dlim = dlim+1;  croak("Too many identifers") %if dlim >= dmin
 2169    %result = dpos
 2170  %end
 2171  !
 2172  %integerfn NEWRANGE(%integer type,lower,upper)
 2173  %integer dpos
 2174  %record(identinfo)%name dp
 2175  %ownrecord(identinfo) d=0
 2176    fault(boundserr) %and upper = lower %if lower > upper
 2177    elements = maxint
 2178    elements = upper-lower %if upper!!lower >= 0 %c
 2179+     %or minint+upper-lower < 0
 2180    elements = elements+1 %if elements # maxint
 2181    dpos = dictmin
 2182    %cycle
 2183      dp == dict(dpos)
 2184      %result = dpos %if dp_flags = typeid %and dp_type = type %c
 2185+                    %and dp_low = lower %and dp_val = upper
 2186      dpos = dpos+1
 2187    %repeat %until dpos = dlim
 2188    d_flags = typeid;  d_type = type
 2189    d_low = lower;  d_val = upper
 2190    dict(dpos) = d
 2191    dlim = dlim+1;  croak("Too many identifers") %if dlim >= dmin
 2192    %result = dpos
 2193  %end
 2194  
 2195  %routine GET LITBOUNDS
 2196  %integer lower
 2197    get(left)
 2198    get LITINT;  lower = t_val
 2199    get(colon)
 2200    get LITINT;
 2201    get(right)
 2202    t_low = lower
 2203    item = newrange(inty,t_low,t_val);  !always integer at present
 2204  %end
 2205  
 2206  %routine GET IDENT
 2207    dlim0 = dlim
 2208    get(ident)
 2209    declare
 2210    get LITSTRING %if d_flags&ext # 0 %and a(alias)
 2211  %end
 2212  
 2213  %routine GET IDENTLIST
 2214    dlim0 = dlim
 2215    %cycle
 2216      get(ident)
 2217      declare
 2218      get LITSTRING %if d_flags&ext # 0 %and a(alias)
 2219     %repeat %until %not a(comma)
 2220  %end
 2221  
 2222  %routine GET TYPE(%integer flags)
 2223  %owninteger fbase
 2224  %ownrecord(identinfo)%name formp,fieldp
 2225  !
 2226  %routine GET FORMATDEF;  !(%integername base)
 2227  %integer disp,max,base
 2228  %routine GET FIELD IDENT
 2229    get(ident)
 2230    %if item > 0 %then d_text = ditem_text %c
 2231+   %else %start
 2232      d_text = charlim-charbase;  charlim = charlim+newlen+1
 2233      croak("Identifier space exhausted") %if charlim+80 >= charmin
 2234    %finish
 2235    ditem == dict(dlim);  fieldp == ditem
 2236    ditem = d
 2237    %if formp_extra = 0 %then formp_extra = dlim %c
 2238+   %else %start
 2239  !    lookup field ident(formp_extra)
 2240  !    fault(duperr+point) %and item = dlim %if item # dlim
 2241    %finish
 2242    dlim = dlim+1;  croak("Too many identifiers") %if dlim >= dmin
 2243  %end
 2244  %routine get UNIT
 2245    %cycle
 2246      %if a(left) %start
 2247        get FORMATDEF;  get(right)
 2248        %return %if %not a(comma)
 2249      %else
 2250        get TYPE(static+more)
 2251        %if d_flags&parm = 0 %start;  !not array
 2252          %cycle
 2253            disp = disp+1 %if disp&1 # 0 %and dsize # 1
 2254            d_val = disp
 2255            disp = disp+dsize
 2256            get FIELD IDENT
 2257            %return %if %not a(comma)
 2258            atom = next atom
 2259          %repeat %until atom # ident
 2260        %else;  !array
 2261          d_flags = d_flags-parm
 2262          disp = disp+1 %if disp&1 # 0;  d_val = disp
 2263          get FIELD IDENT
 2264          get LITBOUNDS
 2265          fieldp_type = newatype(d_type,item)
 2266          disp = disp+dsize*elements
 2267          %return %if %not a(comma)
 2268        %finish
 2269      %finish
 2270    %repeat
 2271  %end
 2272    max = 0;  base = 0
 2273    %cycle
 2274      disp = base
 2275      get UNIT
 2276      max = disp %if max < disp
 2277    %repeat %until %not a(keyor)
 2278    base = max
 2279  %end;  !get FORMATDEF
 2280  
 2281    dsize = 0;  d_mode = 0;  d_val = 0
 2282    d_type = nulltype
 2283    %if a(rpred) %start;  !%routine,(%integerfn)
 2284      flags = flags&(\static) %if flags&ext # 0
 2285      syntax error %if flags&static # 0
 2286      nonstandard(pred) %and d_type = booltype %if subatom # 0
 2287      d_flags = flags+proc;  declmode = declmode+pcmode
 2288      %return
 2289    %finish
 2290    %if a(krange) %start;                 !%byte,%short,%half,%mite
 2291      d_type = inttype+subatom;  dsize = 1
 2292      dsize = 2 %if d_type = shorttype %or d_type = halftype
 2293      nonstandard(ranges) %if d_type >= mitetype
 2294      allow(keyinteger)
 2295    %else %if a(keyinteger);                    !%integer
 2296      d_type = inttype;  dsize = 4
 2297      atom = next atom
 2298      %if atom = left %start
 2299        get LITBOUNDS
 2300        d_type = item
 2301        dsize = 2 %if elements <= 65536 %and t_low >= -32768
 2302        dsize = 1 %if elements <= 256 %and t_low >= -128
 2303      %finish
 2304    %else %if a(keylong);                   !%long
 2305      d_type = longinttype;  dsize = 8
 2306      d_type = longrealtype %and get(keyreal) %if %not a(keyinteger)
 2307    %else %if a(keyreal);                   !%real
 2308      d_type = realtype;  dsize = 4
 2309    %else %if a(keystring);                 !%string
 2310      d_type = stringy
 2311      t_val = 255;  dsize = 256
 2312      %if a(left) %start
 2313        t_val = 0
 2314        %if %not a(star) %start
 2315          get LITINT
 2316          expfault(rangerr+point) %and t_val = 255 %unless 0 < t_val <= 255
 2317        %finish
 2318        get(right)
 2319      %finish %else nonstandard(nolength)
 2320      %if t_val # 0 %start
 2321        d_type = newstype(t_val)
 2322        dsize = (t_val+2)&(\1);  !+1 & evened up
 2323      %finish
 2324    %else %if a(keyrecord);                    !%record
 2325      d_type = recy
 2326      %if a(keyformat) %start
 2327        syntax error %if flags&(static+ext) # 0
 2328        %if a(keyspec) %start
 2329          d_flags = typeid+spec
 2330          get IDENT
 2331        %finish %else %start
 2332          d_flags = typeid
 2333          get IDENT
 2334          formp == ditem
 2335          get(left)
 2336          fbase = 0
 2337          get FORMATDEF
 2338          fieldp_flags = fieldp_flags-more
 2339          get(right)
 2340        %finish
 2341        d_flags = typeid
 2342        %return
 2343      %finish
 2344      get(left)
 2345      %if %not a(star) %start
 2346        %if %not a(ident) %start
 2347          get FORMATDEF
 2348          fieldp_flags = fieldp_flags-more
 2349          get(right)
 2350          d_flags = typeid
 2351          declare anon
 2352        %finish
 2353        name error %if item <= 0
 2354        syntax error %if ditem_type # recy
 2355        d_type = item;  dsize = ditem_val
 2356      %finish
 2357      get(right)
 2358    %else
 2359      syntax error %if atom # keyname;            !untyped %name
 2360    %finish
 2361    !End of basic type info: set item size in DECLMODE
 2362    %if dsize <= 4 %start
 2363      %if dsize <= 2 %then declmode = dsize<<sizeshift %c
 2364+     %else declmode = longsize<<sizeshift
 2365    %finish
 2366    !Appendages
 2367    %if a(fnmap) %start;  !%fn, %map
 2368      flags = flags&(\static) %if flags&ext # 0
 2369      syntax error %if flags&static # 0
 2370      flags = flags+var %and d_type = d_type+direct %if subatom # 0;  !map
 2371      d_flags = flags+proc;  declmode = declmode+pcmode
 2372      %return
 2373    %finish
 2374    d_type = d_type+direct
 2375    %while a(keyarray) %or a(keyname) %cycle
 2376      %if atom = keyarray %start;                  !%array
 2377        nonstandard(naming) %if d_type >= indirect
 2378        %if %not a(keyname) %start
 2379          syntax error %if flags&parm # 0
 2380          flags = flags+parm;  !as indic
 2381          %exit
 2382        %finish
 2383        d_type = newatype(d_type,inty)
 2384      %finish
 2385      syntax error %if d_type >= indirect
 2386      d_type = d_type+(indirect-direct)
 2387      dsize = 4
 2388    %repeat
 2389    d_flags = flags!!var
 2390  %end;  !GET TYPE
 2391  !
 2392  %routine GET OWN ARRAY DECLARATION
 2393  %integer holdval,dpos
 2394  %record(identinfo)%name dp
 2395  !  constad = constad+1 %if constad&1 # 0
 2396  !  d_val = constad
 2397  !  d_val = d_val-ownbase %if d_val >= ownbase
 2398    get IDENT
 2399    dpos = item;  dp == ditem
 2400    get LITBOUNDS
 2401    dp_type = newatype(d_type,item)
 2402    %if a assop %start
 2403      allow(terminator)
 2404      %cycle
 2405        get LITERAL(d_type)
 2406        faultnum = rangerr+point+warn %if faultnum = rangerr+point
 2407        holdval = t_val
 2408        t_val = 1
 2409        %if a(left) %start
 2410          t_val = elements
 2411          get LITINT %if %not a(star)
 2412          get(right)
 2413        %finish
 2414  !      plant const(holdval,t_val)
 2415        elements = elements-t_val
 2416      %repeat %until %not a(comma)
 2417      report(counterr,dpos) %if elements # 0 %and faultnum = 0
 2418    %finish
 2419  !  plant const(0,elements) %if elements > 0
 2420  %end;  !get OWN ADECL
 2421  
 2422  %routine GET ARRAY DECLARATION
 2423  !ie get IDENTLISTS and BOUNDS
 2424  %integer i,dlim1,hold,holdval,type
 2425  
 2426  !%routine put bound pair
 2427  !  hold = litref(holdval) %if hold = 0
 2428  !  item = litref(t_val) %if item = 0
 2429  !  put3(r,hold,item);  !(range),lower,upper
 2430  !%end
 2431  
 2432  %routine GET BOUNDS
 2433  %integer range
 2434    get VALUE(anyint)
 2435    hold = item;  t_val = minint %if hold # 0
 2436    holdval = t_val
 2437    get(colon)
 2438    get VALUE(anyint)
 2439    t_val = maxint %if item # 0
 2440    range = newrange(inty,holdval,t_val)
 2441    GET BOUNDS %if a(comma)
 2442    type = newatype(type,range)
 2443  %end
 2444  
 2445  %cycle
 2446    type = d_type
 2447    get IDENTLIST
 2448    dlim1 = dlim
 2449    get(left)
 2450    GET BOUNDS
 2451    get(right)
 2452  !  %if hold = 0 = item {both literal} %and np = np0 {1-dim} %c
 2453  !  %and elements <= 32767 {safe to multiply?} %c
 2454  !  %and (elements*dsize*(dlim-dpos))<<1-c_sp-c_delta <= 32000 %start
 2455  !     d_par = parref(inty,0,r,0)
 2456  !  %finish %else %start
 2457  !    put bound pair
 2458  !     d_par = 0
 2459  !    i = np
 2460  !    %while i # np0 %cycle
 2461  !      i = i-1
 2462  !       d_par = parref(inty,0,exp(i)_act,d_par)
 2463  !    %repeat
 2464  !    exp(np0)_act = adecl
 2465  !  %finish
 2466  !  i = np
 2467    %while dlim0 # dlim1 %cycle
 2468  !    %if i = np0 %start
 2469  !      c_delta = c_delta-elements*dsize
 2470  !      c_delta = c_delta-1 %if c_delta&1 # 0
 2471  !      dict(dlim0)_flags = dict(dlim0)_flags!static
 2472  !    %finish %else %start
 2473  !      np = i;  compile(np0,np0)
 2474  !      c_flags = c_flags!dynarray
 2475  !    %finish
 2476  !    dict(dlim0)_val = c_sp+c_delta
 2477      dict(dlim0)_type = type
 2478      dlim0 = dlim0+1
 2479    %repeat
 2480  %repeat %until %not a(comma)
 2481  %end;
?I unused
 2482       ;  !get BOUNDS
 2482  
 2483  %routine GET PARMDEF
 2484  %integer headitem,dpos,dlim1
 2485  %record(identinfo)%name headditem,dp
 2486  %integerfn PARMMATCH(%integer apos)
 2487  %integer bpos
 2488  %record(identinfo)%name ap,bp
 2489    bpos = dlim1
 2490    ap == dict(apos)
 2491    %while bpos # dlim %cycle
 2492      %result = 0 %if ap_flags&more = 0
 2493      apos = apos+1 %and ap == dict(apos) %until ap_flags&parm # 0
 2494      bp == dict(bpos)
 2495      %result = 0 %if ap_type # bp_type;  !for now
 2496      bpos = bpos+1
 2497    %repeat
 2498    %result = 1 %if ap_flags&more = 0
 2499    %result = 0
 2500  %end
 2501  !
 2502    headitem = item;  headditem == ditem
 2503    dlim1 = dlim
 2504    %if a(left) %start
 2505      %cycle
 2506        get TYPE(parm!more) %if atom # ident
 2507        %if d_flags&proc = 0 %start
 2508          get IDENT
 2509          %exit %if %not a(comma) %and atom = right
 2510          %if atom # comma %then nonstandard(nocomma) %c
 2511+         %else atom = next atom
 2512        %finish %else %start
 2513          get IDENT
 2514          speccing = speccing+2
 2515          get PARMDEF
 2516          speccing = speccing-2
 2517          %exit %if %not a(comma)
 2518        %finish
 2519      %repeat
 2520      dict(dlim-1)_flags = dict(dlim-1)_flags-more
 2521      get(right)
 2522    %finish
 2523    %if speccing >= 2 %start
 2524      dpos = dictmin
 2525      %cycle
 2526        dp == dict(dpos)
 2527        %if dp_flags&proc # 0 %and dp_type = headditem_type %start
 2528          %if parmmatch(dpos) # 0 %start
 2529            headditem_type = dpos;  dlim = dlim1
 2530            %return
 2531          %finish
 2532        %finish
 2533        dpos = dpos+1
 2534      %repeat %until dpos >= headitem
 2535      fault(caterr);  dlim = dlim1
 2536      %return
 2537    %finish
 2538    %if speccing = 0 %and headditem_flags&spec # 0 %start
 2539      headditem_flags = headditem_flags-spec
 2540      fault(matcherr) %if parmmatch(headitem) = 0
 2541    %else
 2542      headditem_flags = headditem_flags!more %if dlim # dlim1
 2543    %finish
 2544  %end;  !get PARMDEF
 2545  
 2546  initial(keylabel):  nonstandard(klabel)
 2547    d_flags = lab+spec;  d_type = nulltype
 2548    get IDENTLIST
 2549    -> term
 2550  
 2551  initial(prefix):
 2552    d_flags = subatom;  ! !wflag!okflag
 2553  !  fault(prefix<<8) %if d_flags&extmask # 0
 2554    atom = next atom
 2555  initial(krange): initial(keylong):
 2556  initial(keyinteger): initial(keyreal):
 2557  initial(keystring):  initial(keyrecord):
 2558  initial(rpred):
 2559    matched = 0
 2560    get TYPE(d_flags)
 2561    %if a(keyspec) %start
 2562      %if a(left) %start
 2563        get LITINT;  get(right)
 2564        declmode = declmode&sizemask+absmode
 2565        d_val = t_val
 2566        get IDENT
 2567        speccing = 1 %and get PARMDEF %if d_flags&proc # 0
 2568        -> term
 2569      %finish
 2570      d_flags = d_flags+spec
 2571      get IDENTLIST %and -> term %if d_flags&proc = 0
 2572    %finish
 2573    %if d_flags&proc # 0 %start
 2574      get(ident)
 2575      %if item >= c_localdpos %and ditem_type = d_type %c
 2576+     %and ditem_flags&proc # 0 %start
 2577        %if ditem_flags&spec = 0 %or d_flags&spec # 0 %start
 2578          item = 0;  d_flags = d_flags+alt
 2579          declare
 2580        %finish
 2581      %finish %else declare
 2582      get LITSTRING %if d_flags&ext # 0 %and a(alias)
 2583      %if d_flags&spec # 0 %start
 2584        speccing = 1
 2585        get PARMDEF
 2586      %finish %else %start
 2587        open block(item)
 2588        get PARMDEF
 2589        c_parlim = dlim
 2590        compile entry
 2591        get(terminator)
 2592        get STATEMENTS(end)
 2593  !      %if c_access > 0 %start
 2594  !        report(noresult,0) %if c_type > nulltype;  !fn/map/pred
 2595  !      %finish
 2596        close block
 2597      %finish
 2598    %else %if d_flags = typeid {dealt with}
 2599    %else %if d_flags&parm # 0;  !array
 2600      d_flags = d_flags-parm
 2601      %if d_flags&static # 0 %start
 2602        get OWN ARRAY DECLARATION
 2603      %finish %else %start
 2604        %if d_flags&static = 0 %and c_flags >= hadon %start
 2605          fault(ordererr);  c_flags = c_flags&(\(hadon+hadinst))
 2606        %finish
 2607        get ARRAY DECLARATION
 2608      %finish
 2609    %else %if d_flags = static {const}
 2610      d_type = dict(d_type&puretype)_type
 2611      d_type = d_type+direct %if d_type = recy %or d_type = stringy
 2612      %cycle
 2613        get IDENT
 2614        syntax error %if %not a assop
 2615        get LITERAL(d_type)
 2616        faultnum = rangerr+point+warn %if faultnum = rangerr+point
 2617        dict(dlim-1)_val = t_val
 2618      %repeat %until %not a(comma)
 2619    %else %if d_flags&static # 0 {own}
 2620  !    constad == ownad;  constbound = finalbound
 2621      declmode = declmode+ownmode
 2622      %cycle
 2623  !      constad = constad+1 %if constad&1 # 0 %and dsize # 1
 2624  !      t_val = constad-ownbase
 2625        get IDENT
 2626        t_val = 0
 2627        %if a assop %start
 2628  !        %if d_flags&direct = 0
 2629          get LITERAL(d_type)
 2630          faultnum = rangerr+point+warn %if faultnum = rangerr+point
 2631        %finish
 2632        elements = 1
 2633      !      plant const(t_val,1)
 2634      %repeat %until %not a(comma)
 2635    %else;      !dynamic variable
 2636  !    declmode = declmode+dispmode+level
 2637      %if d_flags&static = 0 %and c_flags >= hadon %start
 2638        fault(ordererr);  c_flags = c_flags&(\(hadon+hadinst))
 2639      %finish
 2640      %cycle
 2641  !problematic c_delta = c_delta-1 %if c_delta&1 # 0 %and dsize # 1
 2642        c_delta = c_delta-dsize
 2643        c_delta = c_delta-1 %if c_delta&1 # 0
 2644        t_val = c_sp+c_delta
 2645        get IDENT
 2646        %if a assop %start
 2647          nonstandard(initass)
 2648          %if d_type >= indirect %start
 2649            fault(caterr+point) %if atom # eqeq
 2650            get REFERENCE(d_type)
 2651            item = item+ad %if item # 0
 2652  !          put3(assign,dlim-1+ad,item)
 2653          %finish %else %start
 2654            fault(caterr+point) %if atom = eqeq
 2655            get VALUE(d_type)
 2656  !          put2(assign,dlim-1)
 2657          %finish
 2658  !        compile(np0,np0)
 2659        %finish
 2660      %repeat %until %not a(comma)
 2661    %finish
 2662    -> term
 2663  
 2664  %routine GET SWITCH DECLARATION
 2665  %integer i,j,dlim1
 2666    matched = 1
 2667    %cycle
 2668      d_flags = lab;  d_type = nulltype
 2669      declmode = pcmode+wordsize<<sizeshift
 2670      get IDENTLIST
 2671      dlim1 = dlim
 2672      get LITBOUNDS
 2673      %cycle;  !For each ident in group
 2674        %exit %if spc-elements <= 0;  !ignore if too many
 2675        %for i = 1,1,elements %cycle
 2676          spc = spc-1;  final(spc) = 0
 2677        %repeat
 2678        dict(dlim0)_val = spc
 2679        dict(dlim0)_type = item
 2680        dlim0 = dlim0+1
 2681      %repeat %until dlim0 = dlim1
 2682    %repeat %until %not a(comma)
 2683  %end
?J unused
 2684  initial(keyswitch):
 2685    get SWITCH DECLARATION
 2686    ->term
 2687  
 2688  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 2689  !!!!!!!!!!!!!!!  Control statements  !!!!!!!!!!!!!!!!!!!!!!!!!!!
 2690  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 2691  !
 2692  initial(keycontrol):
 2693    get LITINT
 2694    control = 0 %if t_val = 0
 2695    control = control!!t_val
 2696    ->term
 2697  
 2698  initial(include):
 2699    get LITSTRING
 2700    extra_name = ""
 2701    %while t_val > 0 %cycle
 2702      extra_name = extra_name.tostring(byteinteger(atomp))
 2703      atomp = atomp+1;  t_val = t_val-1
 2704    %repeat
 2705    get(terminator)
 2706    %if faultnum = 0 %start
 2707      connect edfile(extra)
 2708      nonstop = -999 %and %signal 12 %if extra_flag # 0
 2709      mainfp = fp;  mainline = line
 2710      line = 0;  sym = nl
 2711      fp = extra_start2;  curstart = fp;  curlim = extra_lim2
 2712      modesym = '&';  nonstop = nonstop+1
 2713    %finish
 2714    ->next
 2715  
 2716  initial(keylist):
 2717    ->term
 2718  
 2719  initial(begin):
 2720    c_sp = -8
 2721    get(terminator)
 2722    open block(0)
 2723    get STATEMENTS(0)
 2724    close block
 2725    -> term %if stopper >= 0
 2726    %return
 2727  
 2728  initial(end):
 2729    %if %not a(of) %start
 2730      fault(nofinish) %if stopper = else %or stopper = finish
 2731      fault(norepeat) %if stopper = repeat
 2732      %return %if stopper >= 0
 2733      fault(nobegin)
 2734      ->term
 2735    %finish
 2736    %if a(keylist) %start
 2737      ->term
 2738    %finish
 2739    %if a(keyfile) %start
 2740      %if curlim = extra_lim2 %start
 2741        switch input
 2742        ->next
 2743      %finish
 2744    %finish %else get(program)
 2745  %end;  !GET STATEMENTS
 2746  
 2747  %routine INIT(%integer t,l,h)
 2748    d_flags = typeid;  d_type = t;  d_low = l;  d_val = h
 2749    dict(dlim) = d;  dlim = dlim+1
 2750  %end
 2751  
 2752  %on %event 12 %start
 2753    -> printout %if fp = main_lim2
 2754    -> ended %if main_flag < 0 %or nonstop = -999;  !abandon or CROAK
 2755    change = main_change
 2756  %finish
 2757  
 2758    printstring("  IMP Checker  ");  newline
 2759    hashindex(i) = 0 %for i = 0,1,255;  !hash table empty
 2760    charbase = addr(char(0));  byteinteger(charbase) = 0;  !for anon ident
 2761    charlim = charbase+1
 2762    charmin = charlim+charbound;  !(1 over top)
 2763    dict(i)_val = 0 %for i = d0,1,labmax
 2764    d_flags = typeid;  d_low = minint;  d_val = maxint
 2765    dmin = dictmax-1;  dlim = dictmin
 2766    %cycle
 2767      d_type = dlim;  dict(dlim) = d
 2768      dlim = dlim+1
 2769    %repeat %until dlim > booltype
 2770    d_flags = 0
 2771    init(booltype,0,0)
 2772    init(booltype,0,1)
 2773    d_flags = typeid
 2774    init(inty,minint,maxint)
 2775    init(inty,-32768,32767)
 2776    init(inty,0,65535)
 2777    init(inty,0,255)
 2778    init(inty,-128,127)
 2779    init(inty,0,1)
 2780    init(inty,minint,maxint)
 2781    init(realy,minint,maxint)
 2782    init(realy,minint,maxint)
 2783    c = 0;  c_localdpos = dlim;  c_parlim = dlim
 2784    level = outerlevel
 2785    spc = finalbound
 2786    faults = 0;  line = 0;  mainline = 0
 2787  !
 2788    mainfp = main_start1
 2789    extra_name = permfile
 2790    connect edfile(extra)
 2791    nonstop = -999 %and %signal 12 %if extra_flag # 0
 2792    fp = extra_start2;  curstart = fp;  curlim = extra_lim2
 2793    nonstop = -2;  nonstop = -1 %if main_flag = 'I'
 2794    sym = nl
 2795    get STATEMENTS(-1)
 2796  !  report(noend,0) %if level < mainlevel
 2797  !  report(nobegin,0) %if level > mainlevel
 2798  !  compile end %while level >= mainlevel
 2799  printout:
 2800  !  time2 = cputime
 2801    %if faults = 0 %start
 2802      write(statements,1)
 2803      print string(" statements checked  ")
 2804    %finish %else %start
 2805      write(faults,1)
 2806      print string(" fault")
 2807      put sym('s') %if faults > 1
 2808      print string(" reported  ")
 2809    %finish
 2810    newline
 2811  ended:
 2812    newline;  !*for now to ensure message not erased*
 2813  !  %if control&logbit # 0 %start
 2814  !!    write(zaps,1);  print symbol('Z')
 2815  !    write(statements,1);  print symbol('S')
 2816  !    statements = 1 %if statements = 0
 2817  !    atoms = atoms+statements
 2818  !    print(atoms/statements,1,1);  print symbol('A')
 2819  !    print(numatoms/statements,1,1);  print symbol('N')
 2820  !    print(identatoms/statements,1,1);  print symbol('I')
 2821  !    print(misses/identatoms,1,2);  print symbol('H')
 2822  !    print((time2-time1)/statements,3,3);  print symbol('M')
 2823  !!    write(finalad,1);  print symbol('B')
 2824  !!    write(ownad-ownbase,1);  print symbol('O')
 2825  !    newline
 2826  !  %finish
 2827  
 2828  %end;
?LISTMATCH unused
?LEFTBRACKET unused
?TEMPVAR unused
?PUT2 unused
?PUT3 unused
?COMPILE unused
?SETLABEL unused
?IBMHEX unused
?HYPHEN unused
?OVERLOAD unused
?LISTOUT unused
?CHARS unused
?PROLINE unused
?DIAGLINE unused
?CASEMASK unused
?OWNAD unused
?FINALAD unused
?DYNARRAY unused
?NONLOCALREF unused
?WRONGCC unused
?IREADENTRY unused
?INDEXENTRY unused
?AGETENTRY unused
?BOUNDENTRY unused
?SCOMPENTRY unused
?SIGENTRY unused
?DNEWLINE unused
?DREAD unused
?DPRINTSTR unused
?DOUBLE unused
?CS unused
?CC unused
?GE unused
?LT unused
?LE unused
?GT unused
?NE unused
?EQ unused
?ACTMAX unused
?ADECL unused
?LABEL unused
?JUMP unused
?COMPARE unused
?PLUSASS unused
?JAMASSIGN unused
?ASSIGN unused
?SWGOTO unused
?FCALL unused
?FMOD unused
?IMOD unused
?FLOAT unused
?RIGHTBRACKET unused
?COMMENT unused
?WFLAG unused
?RFLAG unused
?OKFLAG unused
?LITMODE unused
?INDEXMODE unused
?PREMODE unused
?POSTMODE unused
?INDMODE unused
?AMODE unused
?DMODE unused
?BYTESIZE unused
?LITSTORE unused
?SLITPOS unused
?DICTSHOWN unused
?ANYNAME unused
?ANYINTVAR unused
?FALSECONST unused
?FREE unused
?A2B unused
?A1B unused
?A0B unused
?D2B unused
?D1B unused
?D0B unused
?MAXAREG unused
?MAXDREG unused
?UNDEF unused
?PREA7 unused
?POSTA7 unused
?A7 unused
?A6 unused
?A1 unused
?D7 unused
?D6 unused
?D2 unused
?D1 unused
?SMALLMIN unused
?EXTRANAME unused
 2829       ;  !of ECCECI
 2829  %endoffile

 2102 Statements compiled
