


              ERCC. Portable Imp80 Compiler Release 4 Version 13 Aug 96


  4095 12285
 12370        %endoffile
   259        {***  end  of generated tables ***}
   260        
   261        %constbytearray AtoE(0:127) =
   262                    16_00,16_01,16_02,16_03,16_04,16_05,16_06,16_07,
     C                    16_08,16_09,16_0A,16_0B,16_0C,16_0D,16_0E,16_0F,
     C                    16_10,16_11,16_12,16_13,16_14,16_15,16_16,16_17,
     C                    16_18,16_19,16_1A,16_1B,16_1C,16_1D,16_1E,16_1F,
     C                    16_40,16_5A,16_7F,16_7B,16_5B,16_6C,16_50,16_7D,
     C                    16_4D,16_5D,16_5C,16_4E,16_6B,16_60,16_4B,16_61,
     C                    16_F0,16_F1,16_F2,16_F3,16_F4,16_F5,16_F6,16_F7,
     C                    16_F8,16_F9,16_7A,16_5E,16_4C,16_7E,16_6E,16_6F,
     C                    16_7C,16_C1,16_C2,16_C3,16_C4,16_C5,16_C6,16_C7,
     C                    16_C8,16_C9,16_D1,16_D2,16_D3,16_D4,16_D5,16_D6,
     C                    16_D7,16_D8,16_D9,16_E2,16_E3,16_E4,16_E5,16_E6,
     C                    16_E7,16_E8,16_E9,16_AD,16_E0,16_BD,16_5F,16_6D,
     C                    16_79,16_81,16_82,16_83,16_84,16_85,16_86,16_87,
     C                    16_88,16_89,16_91,16_92,16_93,16_94,16_95,16_96,
     C                    16_97,16_98,16_99,16_A2,16_A3,16_A4,16_A5,16_A6,
     C                    16_A7,16_A8,16_A9,16_C0,16_6A,16_D0,16_A1,16_7F
   278        
   279        
   280        %routine Flush Buffer
   281           %integer j
   282           %if faulty = 0 %start
   283              select output(Object Out)
   284              printsymbol(buff(j)) %for J = 1, 1, Bp
   285              select output(listing)
   286           %finish
   287           bp = 0
   288        %END
   289        %routine print ident(%integer p, mode)
   290           %integer j, ad
   291           p = tag(p)_text
   292           %if p = 0 %start
   293              bp = bp+1 %and buff(bp) = '?' %if Mode # 0
   294              %RETURN
   295           %finish
   296           ad = addr(dict(p+1))
   297           %if mode = 0 %then printstring(string(ad)) %else %start
   298              %for j = ad+1, 1, ad+byteinteger(ad) %cycle
   299                 bp = bp+1
   300                 buff(bp) = byteinteger(j)
   301              %repeat
   302           %finish
   303        %end
   304        %routine abandon(%integer n)
   305           %switch reason(0:10)
   306           %integer stream
   307           stream = listing
   308           %cycle
   309              newline %if sym # nl
   310              printsymbol('*');  write(lines,4);  space
   311              ->reason(n)
   312        reason(0):printstring("compiler error!");          ->more
   313        reason(1):printstring("switch vector too large");  ->more
   314        reason(2):printstring("too many names");           ->more
   315        reason(3):printstring("program too complex");      ->more
   316        reason(4):printstring("feature not implemented");  ->more
   317        reason(5):printstring("input ended: ")
   318                  %if quote # 0 %start
   319                    %if quote < 0 %then printsymbol(cquote) %C
     C                                  %else printsymbol(squote)
   321                  %else
   322                     printstring("%endof")
   323                     %if progmode >= 0 %then printstring("program") %C
     C                                       %else printstring("file")
   325                  %finish
   326                  printstring(" missing?");                ->more
   327        reason(6):printstring("too many faults!");         ->more
   328        reason(7):printstring("string constant too long"); ->more
   329        reason(8):printstring("dictionary full"); -> more
   330        reason(9):printstring("Included file ".include file." does not exist");  ->More
   331        Reason(10):Printstring("Include files nested too deeply");  ->More
   332        
   333        more: newline
   334              printstring("***  compilation abandoned ***");  newline
   335              %exit %if stream = report %or tty # 0
   336              stream = report
   337              select output(report)
   338           %repeat
   339           %signal 14,15 %if diag&4096 # 0
   340           %signal 0                             {caught at end}
   341        %end
   342        %routine Put Tag(%integer Tag)
   343           Buff(Bp+1) <- Tag>>8
   344           Buff(Bp+2) <- Tag
   345           Bp = Bp+2
   346        %end
   347        %routine op(%integer code, param)
   348              buff(bp+1) <- code
   349              buff(bp+2) <- param>>8
   350              buff(bp+3) <- param
   351              bp = bp+3
   352        %end
   353        %routine set const(%integer m)
   354              buff(bp+1) <- 'N'
   355              buff(bp+5) <- m;  m = m>>8
   356              buff(bp+4) <- m;  m = m>>8
   357              buff(bp+3) <- m;  m = m>>8
   358              buff(bp+2) <- m
   359              bp = bp+5
   360        %end
   361        
   362        
   363        
   364        %routine compile block(%integer level, block tag, dmin, tmax, id)
   365        
   366           %integerfnspec gapp
   367           %routinespec delete names(%integer quiet, Base)
   368           %routinespec analyse
   369           %routinespec compile
   370        
   371           %integer open       ;  open    = closed      {zero if can return from proc}
   372           %integer dbase      ;  dbase   = dmax        {dictionary base}
   373           %integer tbase      ;  tbase   = tmax        {tag base}
   374           %integer tstart     ;  tstart  = tmax
   375           %integer IncBase                             {tag base for include processing}
   376           %integer access     ;  access  = 1           {non-zero if accessible}
   377           %integer inhibit    ;  inhibit = 0           {non-zero inhibits declaratons}
   378        
   379           %shortintegername bflags   ;  bflags     == tag(block tag)_flags
   380           %integer block type        ;  blocktype  =  bflags>>4&7
   381           %integer block form        ;  blockform  =  bflags&15
   382           %integer block fm          ;  blockfm    =  tag(block tag)_format
   383           %integer block otype       ;  blockotype =  otype
   384           %integername block app     ;  blockapp   == tag(block tag)_app
   385        
   386           %integer l, new app
   387        
   388           %recordformat Inclfm(%string(255) From, File, %integer Depth,
     C                                %record(Inclfm)%name Link)
   390           {%const}%ownrecord(Inclfm)%name Inclfm Type {== 0}
   391           %record(Inclfm)%name Includes {== Nil}
   392        
   393        
   394        %routine fault(%integer n)
   395        
   396            { -5 : -1  - warnings}
   397            {  1 : 23  - errors}
   398        
   399            %switch fm(-5:23)
   400            %integer st
   401        
   402            %routine print ss
   403               %integer s, p
   404               %return %if pos = 0
   405               space
   406               p = 1
   407               %cycle
   408                  printsymbol(marker) %if p = pos1
   409                  %exit %if p = pos
   410                  s = char(p);  p = p+1
   411                  %exit %if s = nl %or (s='%' %and p = pos)
   412                  %if s < ' ' %start         {beware of tabs}
   413                     %if s = ff %then s = nl %else s = ' '
   414                  %finish
   415                  printsymbol(s)
   416               %repeat
   417               pos = 0 %if list <= 0
   418            %end
   419        
   420            %return %if N < 0 %and Options&LL Warn = 0
   421            pos1 = pos2 %if pos2 > pos1
   422            newline %if sym # nl
   423            st = report
   424            %if n = -3 %or tty # 0 %start   {unused or listing to console}
   425               st = listing
   426               Pos = 0                      {inhibit PRINT SS}
   427            %finish
   428            %cycle
   429               SELECT OUTPUT(st)
   430               %if n < 0 %then printsymbol('?') %and pos1 = 0 %else printsymbol('*')
   431               %if st # report %start
   432                  %if list <= 0 %and pos1 # 0 %start
   433                     spaces(pos1+margin);  printstring("      ! ")
   434                  %finish
   435               %finish %else %start
   436                  printstring(include file) %if include file # ""
   437                  write(lines, 4);  printsymbol(csym);  space
   438               %finish
   439               ->fm(n) %if -5 <= n <= 23
   440               printstring("fault");  write(n, 2);              ->ps
   441        
   442        fm(-5):printstring("Dubious statement");  dubious = 0;  ->psd
   443        fm(-4):printstring("Non-local")
   444               pos1 = for warn;  for warn = 0;                  ->ps
   445        fm(-3):print ident(x, 0);  printstring(" unused");      ->nps
   446        fm(-2):printstring("""}""");                            ->miss
   447        fm(-1):printstring("access");                           ->psd
   448        
   449        fm(0): printstring("form");                             ->ps
   450        fm(1): printstring("atom");                             ->ps
   451        fm(2): printstring("not declared");                     ->ps
   452        fm(3): printstring("too complex");                      ->ps
   453        fm(4): printstring("duplicate ");  print Ident(Copy, 0);->ps
   454        fm(5): printstring("type");                             ->ps
   455        fm(6): printstring("match");                            ->psd
   456        fm(7): printstring("context");                          ->psd
   457        fm(21):printstring("context ");  print ident(this, 0);  ->ps
   458        fm(8): printstring("%cycle");                           ->miss
   459        fm(9): printstring("%start");                           ->miss
   460        fm(10):printstring("size");  write(lit, 1) %if pos1 = 0;->ps
   461        fm(11):printstring("bounds")
   462               write(ocount, 1) %unless ocount < 0;             ->ps
   463        fm(12):printstring("index");                            ->ps
   464        fm(13):printstring("order");                            ->psd
   465        fm(14):printstring("not a location");                   ->ps
   466        fm(15):printstring("%begin");                           ->miss
   467        fm(16):printstring("%end");                             ->miss
   468        fm(17):printstring("%repeat");                          ->miss
   469        fm(18):printstring("%finish");                          ->miss
   470        fm(19):printstring("result");                           ->miss
   471        fm(22):printstring("format");                           ->ps
   472        fm(20):printsymbol('"');  print ident(x, 0);  printsymbol('"');  ->Miss
   473        fm(23):printstring(Includes_File." has not been included")
   474               printstring(" from ".Includes_From) %if Includes_From # "" ; -> nps
   475        miss:  printstring(" missing");                         ->nps
   476        psd:   pos1 = 0
   477        ps:    print ss
   478        nps:   newline
   479               %exit %if st = listing
   480               st = listing
   481            %repeat
   482            %if n >= 0 %start
   483               %signal 14,15 %if diag&4096 # 0
   484               %if n # 13 %start           {order is fairly safe}
   485                  ocount = -1
   486                  gg = 0
   487                  copy = 0;  quote = 0
   488                  search base = 0;  escape class = 0
   489                  gg = 0
   490               %finish
   491               faulty = faulty+1
   492           
   493               {check that there haven't been too many faults}
   494           
   495               fault rate = fault rate+3;  abandon(6) %if fault rate > 30
   496               fault rate = 3 %if fault rate <= 0
   497            %finish
   498            tbase = tstart
   499            %if list <= 0 %and sym # nl %start
   500               error margin = column
   501               error sym = sym;  sym = nl
   502            %finish
   503        %end
   504        
   505           dmin = dmin-1;  dict(dmin) = -1            {end marker for starts & cycles}
   506           Dict Upper = Dmin %if Dmin < Dict Upper
   507           abandon(2) %if dmax = dmin
   508        
   509           %if list > 0 %and Quiet = 0 %and level > 0 %start
   510              write(lines, 5);  spaces(level*3-1)
   511              %if block tag = 0 %start
   512                 printstring("Begin")
   513              %finish %else %start
   514                 printstring("Procedure ");  print ident(block tag, 0)
   515              %finish
   516              newline
   517           %finish
   518        
   519           {deal with procedure definition (parameters)}
   520        
   521           %if block tag # 0 %start                   {proc}
   522              analyse;  compile %if ss # 0
   523        
   524              %if block otype # 0 %start              {external-ish}
   525                 %if bflags&spec = 0 %start           {definition}
   526                    %if progmode <= 0 %and level = 1 %then progmode = -1 %C
     C                                                     %else fault(7)
   528                 %finish
   529              %finish
   530        
   531              new app = gapp                          {generate app grammar}
   532              %if spec given # 0 %start               {definition after spec}
   533                 fault(6) %if new app # block app     {different from spec}
   534              %finish
   535              block app = new app                     {use the latest}
   536        
   537              %if level < 0 %start                    {not procedure definition}
   538                 delete names(0, Tbase)
   539                 ->Done
   540              %finish
   541           %finish %else %start
   542              open = 0                                {can return from a block?}
   543           %finish
   544        
   545           %cycle
   546              analyse
   547              %continue %if ss = 0
   548              compile
   549              fault(-5) %if dubious # 0
   550              flush buffer %if bp >= Buffer Safe Limit
   551              %if sstype > 0 %start                 {block in or out}
   552                 %exit %if sstype = 2               {out}
   553                 compile block(spec mode, block x, dmin, tmax, id)
   554                 %exit %if ss < 0                   {endofprogram}
   555              %finish
   556           %repeat
   557           %if list > 0 %and quiet = 0 %and level > 0 %start
   558              write(lines, 5);  spaces(level*3-1)
   559              printstring("End")
   560              newline
   561           %finish
   562           delete names(0, Tbase)
   563        Done: %begin
   564                 %record(Inclfm)%name I
   565                 %while Includes ## Nil %cycle
   566                    Fault(23) %if Includes_Depth >= 0
   567                    I == Includes;  Includes == I_Link
   568                    DISPOSE(I)
   569                 %repeat
   570              %end
   571           %return
   572        
   573           %integerfn gapp                            {generate app grammar (backwards)}
   574              %constinteger comma = 140               {psep}
   575              %routinespec set cell(%integer g, tt)
   576              %routinespec class(%record(tagfm)%name v)
   577              %record(tagfm)%name v
   578              %integer p, link, tp, c, ap, t
   579        
   580              %result = 0 %if tmax = local            {no app needed}
   581        
   582              p = gmax1;  link = 0;  t = tmax
   583        
   584              %cycle
   585                 v == tag(t);  t = t-1
   586                 class(v)                             {deduce class from tag}
   587                 %if c < 0 %start                     {insert %PARAM}
   588                    c = -c
   589                    set cell(196, tp)
   590                    tp = -1
   591                 %finish
   592                 set cell(c, tp)
   593                 %exit %if t = local                  {end of parameters}
   594                 set cell(comma, -1)                  {add the separating comma}
   595              %repeat
   596              abandon(3) %if gmax > gmin
   597        
   598              %result = link
   599        
   600              %routine set cell(%integer g, tt)
   601        
   602                 {add the cell to the grammar, combining common tails}
   603        
   604                 %WHILE p # gmax %cycle
   605                    p = p+1
   606                    %if glink(p) = link %and gram(p) = g %start
   607                       %if tt < 0 %or (gram(p+1) = tt %and glink(p+1)=ap) %start
   608                          link = p                    {already there}
   609                          %return
   610                       %finish
   611                    %finish
   612                 %repeat
   613        
   614                 {add a new cell}
   615        
   616                 gmax = gmax+1
   617                 gram(gmax) = g
   618                 glink(gmax) = link
   619                 link = gmax
   620        
   621                 %if tt >= 0 %start             { set type cell}
   622                    gmax = gmax+1
   623                    gram(gmax) = tt
   624                    glink(gmax) = ap
   625                 %finish
   626        
   627                 p = gmax
   628              %end
   629        
   630              %routine class(%record(tagfm)%name v)
   631                 %constinteger err    = 89,
     C                               rtp    = 100,
     C                               fnp    = 101,
     C                               mapp   = 102,
     C                               predp  = 103
   636                 %constintegerarray class map(0:15) = %C
     C                 err,1764, 247, err(4), -rtp, -fnp, -mapp, -predp, err, 214,
     C                 err, 229, err
   639                 %integer tags, type, form
   640                 ap = 0
   641                 tags = v_flags
   642                 type = tags>>4&7;  form = tags&15
   643                 tp = v_format<<3!type
   644                 c = class map(form)
   645                 c = 208 %and tp = 0 %if type = 0 %and form = 2  {%name}
   646                 ap = v_app %if tags&parameters # 0
   647              %end
   648           %end
   649        
   650        %routine check prims
   651           %integer Flags
   652           x = tmax
   653           %while x > tbase %cycle
   654              flags = tag(x)_flags
   655              Fault(20) %if Flags&Spec # 0 %and Flags&Own Bit = 0
   656              x = x-1
   657           %repeat
   658        %end
   659        
   660        %routine delete names(%integer quiet, Base)
   661           %integer flags
   662           %record(tagfm)%name tx
   663           Tag Lower = Tmax %if Tmax > Tag Lower
   664           %WHILE tmax > Base %cycle
   665              x = tmax;  tmax = tmax-1
   666              tx == tag(x)
   667              %if Diag&8 # 0 %start
   668                 Printstring(" Delete """)
   669                 Print Ident(X, 0)
   670                 Printsymbol('"');  Newline
   671              %finish
   672              flags = tx_flags
   673        
   674              %if flags&used bit = 0 %start           {identifier unused}
   675                 Fault(-3) %if Quiet  = 0 %and %C     {warn unused unless ...}
     C                               Level >= 0 %and %C     {global}
     C                               List  <= 0             {no listing}
   678              %else                                   {identifier used}
   679                 Fault(20) %if flags&spec # 0 %and flags&own bit = 0
   680                 {spec and use with no definition}
   681              %finish
   682        
   683              dict(tx_text) = tx_link
   684           %repeat
   685        %end
   686        
   687        %routine analyse
   688        
   689           %constinteger order bits = x'3000', order bit = x'1000'
   690           %constinteger escape     = x'1000'
   691           %integer strp, mark, flags, prot err, k, s, c
   692           %owninteger key = 0
   693           %shortinteger node
   694           %shortintegername z
   695           %record(arfm)%name arp
   696           %switch act(actions:phrasal), paction(0:15)
   697        
   698           %routine trace analysis
   699              {diagnostic trace routine (diagnose&1 # 0)}
   700              %integer a
   701              %routine show(%integer a)
   702                 %if 0 < a < 130 %start
   703                    space
   704                    printstring(text(a))
   705                 %finish %else write(a, 3)
   706              %end
   707              %owninteger la1=0, la2=0, lsa=0, lt=0
   708              newline %if mon pos # pos %and sym # nl
   709              mon pos = pos
   710              write(g, 3)
   711              space
   712              printstring(text(class))
   713              printsymbol('"') %if gg&trans bit # 0
   714              a = gg>>8&15
   715              %if a # 0 %start
   716                 printsymbol('{')
   717                 write(a, 0)
   718                 printsymbol('}')
   719              %finish
   720              %if atom1 # la1 %or atom2 # la2 %or lsa # subatom %C
     C                              %or lt # type %start
   722                 printstring(" [")
   723                    la1 = atom1;    show(la1)
   724                    la2 = atom2;    show(la2)
   725                    lsa = subatom;  write(lsa, 3)
   726                    lt = type;      write(lt, 5)
   727                 printsymbol(']')
   728              %finish
   729              newline
   730           %end
   731        
   732        %routine get sym
   733           readsymbol(sym)
   734           pos = pos+1 %if pos # 133
   735           char(pos) = sym
   736           printsymbol(sym) %if list <= 0
   737           column = column+1
   738        %end
   739        %routine Read Sym
   740           %switch Schar(0:6)
   741           %integer Msym
   742           %owninteger Last = 0
   743           %constbyteintegerarray mapped(0:127) = %C
     C              0,  0,  0,  0,   0,  0,  0,  0,    0,  0, nl,  0,  3 ,  0,  0,  0,
     C              0,  0,  0,  0,   0,  0,  0,  0,    0,  0,  0,  0,   0,  0,  0,  0,
     C             0 ,'!',  4,'#', '$', 1 ,'&',  4,  '(',')','*','+', ',','-','.','/',
     C            '0','1','2','3', '4','5','6','7',  '8','9',':',';', '<','=','>','!',
     C            '@','A','B','C', 'D','E','F','G',  'H','I','J','K', 'L','M','N','O',
     C            'P','Q','R','S', 'T','U','V','W',  'X','Y','Z','[', '\',']','^','_',
     C            '`','A','B','C', 'D','E','F','G',  'H','I','J','K', 'L','M','N','O',
     C            'P','Q','R','S', 'T','U','V','W',  'X','Y','Z', 2 , '|','}','~',  0
   752        
   753           {   0 = space}
   754           {   1 = %}
   755           {   2 = {}
   756           {   3 = ff}
   757           {   4 = " or '}
   758           {   5 = -}
   759           {   6 = C}
   760           {   other values represent themselves}
   761        
   762           %if sym = nl %start
   763        s1:   lines = lines+1
   764              printsymbol(end mark) %if end mark # 0
   765        s11:  pos = 0;  pos1 = 0;  pos2 = 0;  margin = 0;  column = 0
   766              Last = 0
   767              end mark = 0
   768              %if list <= 0 %start
   769                 %if include file # "" %start
   770                    printstring(" &");  write(lines, -4)
   771                 %finish %else  write(lines, 5)
   772                 csym = cont;  printsymbol(csym)
   773                 space
   774                 %if error margin # 0 %start
   775                    lines = lines-1
   776                    spaces(error margin)
   777                    error margin = 0
   778                    %if error sym # 0 %start
   779                       printsymbol(error sym)
   780                       pos = 1;  char(1) = error sym
   781                       sym = error sym;  error sym = 0
   782                       ->s5
   783                    %finish
   784                 %finish
   785              %finish
   786        Schar(0):
   787        s2:   symtype = 1
   788           %finish
   789        s3:readsymbol(sym)
   790           pos = pos+1 %if pos # 133
   791           char(pos) = sym
   792           printsymbol(sym) %if list <= 0
   793           column = column+1
   794        s5:%if sym # nl %start
   795              %return %if quote # 0                     {dont alter strings}
   796              Msym  = Mapped(Sym&127)
   797              %if Msym <= 4 %start                       {special symbol}
   798                 ->Schar(Msym)
   799        Schar(1):symtype = 2;  ->s3                     {%}
   800        Schar(2):%cycle
   801                    Get Sym
   802                    ->S3 %if Sym = '}'
   803                    ->S4 %if Sym = NL
   804                 %repeat
   805        Schar(3):cont = '+';   ->s11                    {ff}
   806        Schar(4):Symtype = 4                            {quotes, >0 note}
   807                 Last = Sym
   808              %else
   809                 Last = Sym
   810                 Sym = Msym
   811                 key = kdict(sym)
   812                 Symtype = Key&3-2 %unless  key&3 = 0 %and symtype = 2       {keyword}
   813              %finish
   814              %return
   815           %finish
   816        s4:symtype = quote
   817           ->S1 %if Last = 0 %and Quote = 0
   818           Cont = '+'
   819        %end
   820        
   821        %integerfn format selected
   822           format list = tag(format)_app      {number of names}
   823           %if format list < 0 %start         {forward ref}
   824              atom1 = error+22
   825              %result = 0
   826           %finish
   827           %if sym = '_' %start
   828              escape class = esc rec
   829              search base = tag(format)_format
   830           %finish
   831           %result = 1
   832        %end
   833        
   834        %routine code atom(%integer target)
   835           %owninteger Ebcdic = 0
   836           %integer dbase, da
   837           %integer base, n, mul, pend quote
   838           %integer j,k,l, pt
   839        
   840           %routine lookup(%integer d)
   841              %constinteger magic = 6700421
   842              %integer new name, vid, k1, k2, form
   843              %record(tagfm)%name t
   844              %integer new
   845        
   846              {first locate the text of the name}
   847        
   848              new = addr(dict(dmax+1))
   849        
   850              K2 = hash value*magic
   851              k2 = k2>>(32-2*name bits)!1
   852              k1 = k2>>name bits                      {giving name bits}
   853              %cycle
   854                 newname = hash(k1)
   855                 %exit %if newname = 0                {not in}
   856                 ->in %if string(addr(dict(newname+1))) = string(new)
   857                 k1 = (k1+k2)&max names
   858              %repeat
   859        
   860              { not found}
   861        
   862              spare names = spare names-1
   863              abandon(2) %if spare names <= 0
   864              hash(k1) = dmax                               {put it in}
   865              dict(dmax) = -1
   866              Subatom = -Dmax;                              {for include files}
   867              newname =  Dmax;  dmax = dp;  ->not in
   868        
   869        in:   search base = rbase %if this >= 0 %and d # 0  {record elem defn}
   870              %if search base # 0 %start                    {record subname}
   871                 new = -1
   872                 x = search base
   873                 %cycle
   874                    ->not in %if x < format list
   875                    %exit %if tag(x)_text = new name
   876                    x = x-1
   877                 %repeat
   878              %finish %else %start                   {hash in for normal names}
   879                 x = dict(newname)
   880                 ->not in %if x <= limit             {wrong level}
   881              %finish
   882        
   883              subatom = x                            {name found, extract info}
   884              t == tag(x)
   885              atom flags = t_flags
   886              format = t_format;  app = t_app
   887              protection = atom flags&prot
   888              type = atom flags>>4&7;  atom1 = amap(atom flags&15)
   889        
   890              %if diag&8 # 0 %start
   891                 printstring("lookup:")
   892                 write(atom1, 3)
   893                 write(type, 1)
   894                 write(app, 3)
   895                 write(format, 5)
   896                 write(atom flags, 3)
   897                 newline
   898              %finish
   899        
   900              %if d = 0 %start                             {old name wanted}
   901                 t_flags <- t_flags!used bit
   902                 search base = 0
   903        
   904                 %if atom flags&subname # 0 %and format # 0 %start {a record}
   905                    %return %if format selected = 0
   906                 %finish
   907        
   908                 %if atom flags&parameters # 0 %start      {proc or array}
   909        
   910                    %if app = 0 %start                     {no parameters needed}
   911                       atom2 = atom1
   912                       atom1 = atom1-4
   913                       %if 97 <= atom1 <= 98 %start
   914                          map gg = atom1;  atom1 = var
   915                       %finish
   916                    %finish %else %if sym = '(' %start
   917                       search base = 0                  {ignore format for now}
   918                       %if atom1 >= 106 %start          {arrays}
   919                          app = phrase(app+200)
   920                          escape class = esc array
   921                          atom1 = (atom1-106)>>1+91     {a,an->v  na,nan->n}
   922                       %finish %else %start             {procedures}
   923                          escape class = esc proc
   924                          atom1 = atom1-4
   925                       %finish
   926                       phrase(200) = app
   927                    %finish
   928                    pos2 = pos;  %return
   929                 %finish
   930        
   931                 {deal with constintegers etc}
   932        
   933                 %if atom flags&const bit # 0 %and atom1 = var %start
   934                       map gg = const;  atom2 = const
   935                       subatom = -subatom %if type = integer
   936                 %finish
   937                 Escape Class = EscN %if Atom1 = 92 {N} %and (Sym = '[' %C
     C                                        %or (Sym = '(' %and Nextsymbol = ':'))
   939                 %return
   940        
   941              %finish
   942              %return %if D = Lab ! 1024                {include}
   943                                                        {new name wanted}
   944              ->not in %if tbase # tstart               {don't fault proc parm-parm}
   945              %if d = lab+spec+used bit %start
   946                 t_flags = t_flags!used bit
   947                 %return
   948              %finish
   949              %if atom flags&spec # 0 %start            {a spec has been given}
   950                 %if d = lab %start                     {define label}
   951                    t_flags <- t_Flags-Spec
   952                    %return
   953                 %finish
   954                 %if {7 <= decl&15 <= 10 %and} decl&spec = 0 %start
   955        
   956                    {procedure definition after spec}
   957        
   958                    %if (decl!!atom flags)&b'1111111' = 0 %start  {correct type?}
   959                       t_flags = t_flags-spec
   960                       spec given = 1 %if 7 <= Decl&15 <= 10  {procedure}
   961                       %return
   962                    %finish
   963        
   964                 %finish
   965                 %if decl&15 = recfm %start              {recordformat}
   966                    t_flags = record<<4+recfm
   967                    t_format = fdef
   968                    %return
   969                 %finish
   970              %finish
   971              %return %if last1 = jump %and atom1 = swit
   972              copy = x %if copy = 0
   973        
   974        notin:app = 0;  vid = 0
   975              atom1 = error+2
   976        
   977              %return %if d = 0                         {old name wanted}
   978              type = d>>4&7;  form = d&15;  atom1 = amap(form)
   979        
   980              %if this < 0 %start                       {normal scope}
   981                 new = newname
   982                 tmax = tmax+1;  x = tmax
   983              %finish %else %start                      {recordformat scope}
   984                 new = -1
   985                 recid = recid-1;  vid = recid
   986                 tmin = tmin-1;  x = tmin
   987                 format list = tmin
   988              %finish
   989        
   990              %if 11 <= form <= 14 %start               {arrays}
   991                 dim = 1 %if dim = 0                    {set dim for owns}
   992                 app = dim
   993              %finish
   994        
   995              d = d!used bit %if (otype > 2 %and d&spec = 0) %or perm # 0
   996        
   997              {external definitions need not be used in the file in which}
   998              {they are defined, so inhibit a useless unused warning.}
   999        
  1000              t == tag(x)
  1001              %if form = lab %and D&1024 = 0 %start
  1002                 {beware of %from}
  1003                 id = id+1;  vid = id
  1004              %finish
  1005              t_index = vid
  1006              t_text   = new name
  1007              t_flags <- d
  1008              t_app    = app
  1009              t_format = fdef;  format = fdef
  1010              subatom = x
  1011        
  1012              %if new >= 0 %start                             {insert into hash table}
  1013                 t_link = dict(new);  dict(new) = x
  1014                 %if gmin = max grammar %start                {proc param params}
  1015                    tmin = tmin-1;  subatom = tmin
  1016                    tag(tmin) = t
  1017                 %finish
  1018              %finish
  1019              abandon(2) %if tmax >= tmin
  1020           %end
  1021        
  1022        
  1023        
  1024        Again:pos1 = pos
  1025              subatom = 0;  pend quote = 0;  atom flags = 0     {***new***}
  1026        
  1027              {app and format must be left for assigning to papp & pformat}
  1028        
  1029              ->Text   %if Quote # 0                     {Completion of text}
  1030              ->name   %if symtype = -2                  {letter}
  1031              ->number %if symtype < 0                   {digit}
  1032              %if symtype = 0 %start
  1033                 atom1 = termin;  atom2 = 0
  1034                 %return
  1035              %finish
  1036              %if symtype # 2 %start                     {catch keywords here}
  1037                  Ebcdic = 0                             {Default to ASCII}
  1038        Try Quote:->Strings %if Sym = squote             {start of string}
  1039                  ->Symbols %if Sym = cquote             {start of symbol}
  1040                  ->Number  %if Sym = '.' %and '0' <= nextsymbol <= '9'
  1041              %finish
  1042        
  1043                                                         {locate atom in fixed dict}
  1044              k = key>>2;  read sym
  1045              %cycle
  1046                 j = kdict(k)
  1047                 %exit %if j&x'4000' # 0
  1048                 %if j&127 # sym %or symtype < 0 %start
  1049                    ->err %unless j < 0
  1050                    k = k+1
  1051                 %finish %else %start
  1052                    l = j>>7&127;  read sym
  1053                    %if j > 0 %start
  1054                       %if l # 0 %start
  1055                          ->err %if l # sym %or symtype < 0
  1056                          read sym
  1057                       %finish
  1058                       l = 1
  1059                    %finish
  1060                    k = k+l
  1061                 %finish
  1062              %repeat
  1063              Subatom = Kdict(K+1)&16_3FFF
  1064              Atom2 = J>>7&127
  1065              atom1 = j&127
  1066              %if atom1 = 0 %start                      {comma or continuation}
  1067                 ->Again %if Subatom = 0                 {%C<nl> or -<nl>}
  1068                 atom1 = 19
  1069                 %if sym = nl %start
  1070                    %return %if ocount >= 0
  1071        
  1072                    {special action needs to be taken with <comma nl> as}
  1073                    {const array lists can be enormous}
  1074        
  1075                    read sym
  1076                 %finish
  1077                 %return
  1078              %finish
  1079              %return
  1080        
  1081              {report an error. adjust the error marker (pos1) to point}
  1082              {to the faulty character in an atom, but care needs to be taken}
  1083              {to prevent misleading reports in cases like ...?????}
  1084        
  1085        err:  atom1 = error+1;  atom2 = 0
  1086              pos1 = pos %if pos-pos1 > 2
  1087              %return
  1088        
  1089                {take care with strings and symbol constants.}
  1090                {make sure the constant is valid here before sucking it in}
  1091                {(and potentially loosing many lines)}
  1092        
  1093        symbols:atom1 = var;  atom2 = const;  type = integer
  1094                map gg = const;  protection = prot
  1095                subatom = lp;  abandon(3) %if lp >= lit max
  1096                quote = \pend quote
  1097                %return
  1098        
  1099              {an integer constant is acceptable so get it in and}
  1100              {get the next atom}
  1101        
  1102        chars:n = 0
  1103              %cycle
  1104                 read sym
  1105                 Cont = Cquote
  1106                 %if sym = cquote %start
  1107                    %exit %if nextsymbol # cquote
  1108                    read sym
  1109                 %finish
  1110                 %if n&(\((-1)>>byte size)) # 0 %start { overflow}
  1111                    pos1 = pos;  atom1 = error+10;  %return
  1112                 %finish
  1113                 ->err %if quote = 0
  1114                 Sym = AtoE(Sym&127) %if Ebcdic # 0
  1115                 n = n<<byte size+sym
  1116                 quote = quote+1
  1117              %repeat
  1118              quote = 0;  cont = ' '
  1119              readsym %if sym # nl
  1120              lit pool(lp) = n;  lp = lp+1
  1121              ->Again
  1122        
  1123                {sniff the grammar before getting the string}
  1124        
  1125        
  1126        Strings:atom1 = var;  atom2 = const;  type = stringv
  1127                subatom = (strp-stbase)!x'4000'
  1128                map gg = const;  protection = prot
  1129                quote = subatom
  1130                text line = lines                         {in case of errors}
  1131                %return
  1132        
  1133              {a string constant is ok here, so pull it in and get}
  1134              {the next atom}
  1135        
  1136        text: ->chars %if quote < 0                       {character consts}
  1137              l = strp; n = strp
  1138              j = addr(glink(gmin-1))                     {absolute limit}
  1139              k = l+256                                   {string length limit}
  1140              k = j %if j < k                             {choose lower}
  1141        
  1142              %cycle
  1143                 quote = 1
  1144                 %cycle
  1145                    read sym
  1146                    Cont = Squote
  1147                    %if sym = squote %start                             {terminator?}
  1148                       %if Nextsymbol # Squote %start                   {yes ->}
  1149                          Quote = 0
  1150                          Readsym
  1151                          %exit
  1152                       %finish
  1153                       Read Sym                                         {skip quote}
  1154                    %finish
  1155                    Sym = AtoE(Sym&127) %if Ebcdic # 0
  1156                    l = l+1;  byteinteger(l) = sym
  1157                    lines = text line %and abandon(7) %if l >= k {too many chars}
  1158                 %repeat
  1159                 byteinteger(n) = l-n                            {plug in length}
  1160                 Ebcdic = 0
  1161        
  1162                 strp = l+1                                      {ready for next string}
  1163                 Cont = ' '
  1164                 code atom(target)
  1165                 %return %if Atom1 # 48                          {.}
  1166                 %if Sym = 'E' %and Nextsymbol = Squote %start   {E"}
  1167                    Readsym
  1168                    Ebcdic = 1
  1169                 %finish %else %if Sym # Squote %start
  1170                    %return
  1171                 %finish
  1172              %repeat
  1173        
  1174              %routine get(%integer limit)
  1175                 %integer s, shift
  1176                 shift = 0
  1177                 %if base # 10 %start
  1178                    %if base = 16 %start
  1179                       shift = 4
  1180                    %finish %else %if base = 8 %start
  1181                       shift = 3
  1182                    %finish %else %if base = 2 %start
  1183                       shift = 1
  1184                    %finish
  1185                 %finish
  1186                 n = 0
  1187                 %cycle
  1188                    %if symtype = -1 %start                       {digit}
  1189                       s = sym-'0'
  1190                    %finish %else %if symtype < 0 %start          {letter}
  1191                       s = sym-'A'+10
  1192                    %finish %else %start
  1193                       %return
  1194                    %finish
  1195                    %return %if s >= limit
  1196                    pt = pt+1;  byteinteger(pt) = sym
  1197                    %if base = 10 %start            {check overflow}
  1198                       %if n >= max int %and (s > max dig %or n > max int) %start
  1199        
  1200                          {too big for an integer,}
  1201                          {so call it a real}
  1202        
  1203                          base = 0;  type = real;  n = 0
  1204                       %finish
  1205                    %finish
  1206                    %if shift = 0 %start
  1207                       n = n*base+s
  1208                    %finish %else %start
  1209                       n = n<<shift+s
  1210                    %finish
  1211                    read sym
  1212                 %repeat
  1213              %end
  1214        
  1215        number:base = 10
  1216        bxk:   atom1 = var;  atom2 = const;  type = integer;  subatom = lp
  1217               map gg = const;  protection = prot
  1218               abandon(3) %if lp >= lit max
  1219               pt = strp;  mul = 0
  1220               %cycle
  1221                  get(base)
  1222                  %exit %unless sym = '_' %and base # 0 %and pend quote = 0    {change of base
  1223                  pt = pt+1;  byteinteger(pt) = '_'
  1224                  read sym
  1225                  base = n
  1226               %repeat
  1227        
  1228               %if pend quote # 0 %start
  1229                  ->err %if sym # cquote
  1230                  readsym
  1231               %finish
  1232               %if sym = '.' %and (Ptype = 0 %or Ptype = Real) %start   {a real constant}
  1233                  pt = pt+1;  byteinteger(pt) = '.'
  1234                  read sym
  1235                  type = real;  n = base;  base = 0;  get(n)
  1236               %finish
  1237        
  1238               %if sym = '@' %start                        {an exponent}
  1239                  pt = pt+1;  byteinteger(pt) = '@';  k = pt
  1240                  readsym
  1241                  type = integer;  base = 10
  1242                  %if sym = '-' %start
  1243                     read sym;  get(10);  n = -n
  1244                  %finish %else %start
  1245                     get(10)
  1246                  %finish
  1247                  pt = k+1;  byteinteger(pt) = lp;  litpool(lp) = n;  lp = lp+1
  1248                  atom1 = error+10 %if base = 0
  1249                  type = real                              {exponents force the type}
  1250               %finish
  1251        
  1252               %if type = real %start
  1253                  byteinteger(strp) = pt-strp
  1254                  subatom = (strp-stbase)!x'2000';  strp = pt+1
  1255               %finish %else %start
  1256                  litpool(lp) = n
  1257                  lp = lp+1
  1258               %finish
  1259               %return
  1260        
  1261        name: atom1 = 0 %and %return %if 27 <= target <= 41
  1262              hash value = 0
  1263        
  1264              {*****************************}
  1265              {*machine dependent for speed*}
  1266              {*****************************}
  1267        
  1268              dp = dmax+1
  1269              da = addr(dict(dp));  dbase = da
  1270              %cycle
  1271                 hash value = hash value+(hash value+sym)        {is this good enough?}
  1272                 da = da+1;  byteinteger(da) = sym
  1273                 read sym
  1274                 %exit %if symtype >= 0
  1275              %repeat
  1276              %if symtype = 4 %start                             {a quote}
  1277                 Pend Quote = 100
  1278                 %if Hash Value = 'E' %start                     {an ebcdic thing}
  1279                    Ebcdic = 1
  1280                    ->Try Quote
  1281                 %finish
  1282                 ->symbols %if hash value = 'M'
  1283                 read sym
  1284                 %if hash value = 'X' %then base = 16 %and ->bxk
  1285                 %if hash value = 'K' %C
     C                 %or hash value = 'O' %then base = 8 %and ->bxk
  1287                 %if hash value = 'B' %then base = 2 %and ->bxk
  1288                 ->err
  1289              %finish
  1290              n = da-dbase
  1291              byteinteger(dbase) = n
  1292              dp = dp+(n+2)>>1
  1293              abandon(8) %if dp >= dmin
  1294        
  1295              atom2 = 90                                    {ident}
  1296              %if last1 = 0 %and sym = ':' %start           {label}
  1297                 limit = local;  lookup(lab);  %return
  1298              %finish
  1299              %if last1 = jump %start                       {->label}
  1300                 limit = local;  lookup(lab+spec+used bit);  %return
  1301              %finish
  1302              %if decl # 0 %and target = 90 %start          {identifier}
  1303                 search base = fm base
  1304                 limit = local;  lookup(decl)
  1305                 search base = 0
  1306              %finish %else %start
  1307                 limit = 0;  lookup(0)
  1308              %finish
  1309           %end
  1310        
  1311           %integerfn parsed machine code
  1312              {   *opcode_??????????}
  1313              atom1 = error %and %result=0 %unless symtype = -2  {starts with letter}
  1314              flush buffer %if bp >= Buffer Safe Limit
  1315              bp=bp+1;  buff(bp)='w'
  1316              %cycle
  1317                 bp=bp+1;  buff(bp)=sym
  1318                 read sym
  1319              %repeat %until Sym = '_' %or Symtype = 0
  1320              bp=bp+1;  buff(bp)='_'
  1321              %if symtype # 0 %start                   {not terminator}
  1322                 read sym
  1323                 %while symtype # 0 %cycle
  1324                    %if symtype < 0 %start             {complex}
  1325                       code atom(0);  %result=0 %if atom1&error # 0
  1326                       %if atom2 = const %and type = integer %start
  1327                          %if subatom < 0 %then Set const(tag(-subatom)_format) %C
     C                                          %else Set const(litpool(subatom))
  1329                       %finish %else %if 91 <= atom1 <= 109 %start
  1330                          %if atom1 = 104 {label} %and %C
     C                              Tag(Subatom)_Flags&Closed = 0 %start
  1332                             This = Subatom;  Atom1 = Error+21
  1333                             %result = 0
  1334                          %finish
  1335                          op(' ', tag(subatom)_index)
  1336                       %finish %else %start
  1337                          atom1 = error;  %result=0
  1338                       %finish
  1339                    %finish %else %start
  1340                       Sym = Sym!128 %if Symtype = 2      {underline with %}
  1341                       bp=bp+1;  buff(bp)=sym;  read sym
  1342                    %finish
  1343                 %repeat
  1344              %finish
  1345              bp=bp+1;  buff(bp)=';'
  1346              %result=1
  1347           %end
  1348           %routine Set FTP
  1349              Arp == Ar(Nmax)
  1350              X = Arp_X
  1351              Pos1 = Arp_Pos
  1352              Pos2 = 0
  1353              App  = 0
  1354              Format = Tag(X)_Format
  1355              Flags  = Tag(X)_Flags
  1356              Type   = Flags>>4&7
  1357              Protection = Flags&Prot
  1358              Protection = 0 %if Flags&Aname # 0
  1359           %end
  1360        
  1361           cont = ' ' %if gg = 0
  1362           last1 = 0;  mapgg = 0
  1363           s = 0;  ss = 0;  sstype = -2; fdef = 0
  1364           fm base = 0
  1365           app = 0
  1366        
  1367           {deal with alignment following an error in one statement}
  1368           {of several on a line}
  1369        
  1370           margin = column                              {start of statement}
  1371        
  1372           pos = 0
  1373           stbase = addr(glink(gmax+1));  strp = stbase;  lp = 0
  1374           tbase = tstart                               {??????????????}
  1375           local = tbase
  1376        
  1377           %begin
  1378              %on %event 9 %start                                 {input ended}
  1379                 Pos = Pos-1 %while Pos > 0 %and Char(Pos) <= ' ' {ignore blanks}
  1380                 Abandon(5) %if Pos # 0
  1381                 %if Perm = 0 %start                              {in user program}
  1382                    Atom1 = 76                                    {endoffile}
  1383                 %else                                            {in perm definition}
  1384                    Atom1 = 77                                    {endofperm}
  1385                 %finish
  1386                 Atom2 = Atom1;  Subatom = 0
  1387                 Sym = NL;  Symtype = 0
  1388              %else
  1389                 %IF gg = 0 %or ocount >= 0 %START             {data or not continuation(z)}
  1390           again:   %WHILE sym type = 0 %CYCLE;                !skip redundant terminators
  1391                       C = Nextsymbol                          {provoke input ended}
  1392                       c = cont
  1393                       cont = ' ';  cont = '+' %IF ocount >= 0
  1394                       read sym
  1395                       cont = c
  1396                    %REPEAT
  1397                    ->skip %IF sym = '!';                      !comment
  1398                    this = -1
  1399                    code atom(0)
  1400                    %IF atom1 = comment %START
  1401           skip:       quote = 1
  1402                       c = cont
  1403                       read sym %AND cont = c %WHILE sym # nl; !skip to end of line
  1404                       quote = 0;  symtype = 0;  Pos = 0
  1405                       ->again
  1406                    %FINISH
  1407                 %FINISH
  1408              %finish
  1409           %end
  1410           decl = 0;  mark = 0
  1411           gentype = 0;  force = 0
  1412           dim = 0;  prot err = 0
  1413           node = 0;  nmax = 0;  nmin = rec size+1
  1414           order = 1;  gmin = max grammar+1
  1415           sstype = 0 %and ->more %if gg # 0            {continuation}
  1416           ptype = 0;  spec given = 0
  1417        
  1418           stats = stats+1;  op('O', lines) %if perm = 0
  1419        
  1420           ->fail1 %if atom1&error # 0                  {first atom faulty}
  1421        
  1422           %if escape class # 0 %start                  {enter the hard way after}
  1423              g = imp phrase;  sstype = -1;  ->a3
  1424           %finish
  1425        
  1426        EOF:
  1427           g = initial(atom1)                           {pick up entry point}
  1428           %if g = 0 %start                             {invalid first atom}
  1429              g = initial(0);  sstype = 0;  ->a3        {declarator?}
  1430           %finish
  1431           %if g < 0 %start                             {phrase imp}
  1432              g = g&255
  1433              nmax = 1
  1434              ar(1)_class = 0;  ar(1)_link = 0;  ar(1)_sub = imp phrase
  1435           %finish
  1436        
  1437           gg = gram(g);  class = gg&255;  sstype = gg>>12&3-1
  1438           ->a1
  1439        
  1440        act(194): ptype = type;  papp = app;  pformat = format;  ->more
  1441        act(196):k =g+1;  ->a610
  1442        act(188):k = ar(nmax)_sub+1
  1443        a610:     papp = glink(k)
  1444                  k = gram(k)
  1445                  ->more %if k = 0                        {%name}
  1446                  ptype = k&7;  pformat = k>>3
  1447        act(183): k = type;  gentype = k %if gentype = 0 %or k = real   {%TYPE}
  1448                  %if pformat < 0 %start                  {general type}
  1449                     app = papp;  format = pformat
  1450                     k = real %if ptype = real %and type = integer
  1451                     k = force %and force = 0 %if force # 0
  1452                  %finish
  1453                  %unless papp = app %and (ptype = k %or ptype = 0) %start
  1454                     ->Fail2 %unless Ptype = Stringv %and K = Integer   {*new coersion*}
  1455                     Type = Stringv
  1456                  %finish
  1457                  ->more %if pformat=format %or pformat = 0 %or format = 0
  1458                  ->fail2
  1459        act(197):arp == ar(nmin)
  1460                 k = arp_sub
  1461                 ->fail3 %unless block form = k&15
  1462                 arp_sub = k>>4
  1463        
  1464                 type = block type
  1465                 ptype = block type;  pformat = block fm;  papp = app
  1466                 pformat = -1 %if ptype # record
  1467                 ->more
  1468        act(195):->Fail2 %if Type # 0 %and Type # integer %and %C
     C                                           Type # Real
  1470                 arp == ar(nmin)
  1471                 k = arp_sub
  1472                 arp_sub = k>>2
  1473                 k = k&3
  1474                                                              {1 = check integer}
  1475                                                              {2 = check real}
  1476                                                              {3 = check real + int}
  1477                  ->more %if k = 0                            {0 = no action}
  1478                  %if k = 1 %start
  1479                     force = integer
  1480                     ->more %if type = integer %or type = 0
  1481                     ->fail2
  1482                  %finish
  1483                  ->fail2 %unless ptype = real %or ptype = 0  {or added?}
  1484                  force = integer %if k = 3
  1485                  ->more
  1486        act(198):                                    {%OTHER}
  1487                 k = gg>>8&15
  1488                 %if k = 0 %start                    {restore atom}
  1489                    atom1 = last1
  1490                    ->more
  1491                 %finish
  1492                 %if k = 1 %start                    {test string}
  1493                    ->fail2 %unless type = stringv
  1494                    ->more
  1495                 %finish
  1496                 %if k = 2 %start                     {fault record comparisons}
  1497                    ->fail2 %if type = record
  1498                    ->more
  1499                 %finish
  1500                 %if k = 3 %start                    {check own variable coming}
  1501                    code atom(0)
  1502                    ->A7 %if atom flags&own bit = 0
  1503                    ->more
  1504                 %finish
  1505                 %if k = 6 %start
  1506                    Set FTP
  1507                    Atom1 = 91 {V}
  1508                    ->More
  1509                 %finish
  1510                 %if K = 7 %start
  1511                    Type = Stringv
  1512                     ->More
  1513                 %finish
  1514                 for warn = pos1 %if x <= local      {%forTEST}
  1515                 ->more
  1516        paction(1):%if type = record %then g = phrase(242) %else pformat = -1
  1517                                                       ->a3
  1518        paction(2):ptype = real;     pformat = -1;     ->a3
  1519        paction(3):ptype = stringv;  pformat = -1;     ->a3
  1520        paction(4):ptype = integer;  pformat = -1;     ->a3
  1521        paction(5):->a3 %if ptype = integer
  1522                   g = phrase(212) %and pformat=-1 %if ptype = real
  1523                   g = phrase(213) %if ptype = stringv
  1524                   ->a3
  1525        paction(6):ptype = gram(ar(nmax)_sub+1)&7;  pformat = -1;  ->a3
  1526        paction(7):ptype=real %if ptype = integer;  pformat = -1;  ->a3
  1527        
  1528        a1:   last1 = class;  atom1 = 0;  s = subatom
  1529        
  1530        a2:   %if gg&trans bit = 0 %start                {insert into analysis record}
  1531                 z == node
  1532                 %cycle                                  {insert cell in order}
  1533                    k = z
  1534                    %exit %if gg&order bits = 0 %or k = 0
  1535                    gg = gg-order bit;  z == ar(k)_link
  1536                 %repeat
  1537                 gg = map gg %if map gg # 0 %and gg&255 = var
  1538                 nmin = nmin-1;  ->fail0 %if nmin = nmax
  1539                 z = nmin
  1540                 arp == ar(nmin)
  1541                 arp_sub = s;  arp_class = (gg&255)!mark
  1542                 arp_link = k
  1543              %finish
  1544              mark = 0;  map gg = 0
  1545        
  1546        more: g = glink(g)                               {chain down the grammar}
  1547        
  1548        paction(0):
  1549        a3:   gg = gram(g);  class = gg&255
  1550              trace analysis %if diag&1 # 0
  1551              ->a5 %if class = 0                         {end of phrase}
  1552        
  1553              %if class < actions %start                 {not a phrase or an action}
  1554                 class = atomic(class) %if class >= figurative
  1555                 ->a2 %if class >= manifest
  1556                 code atom(class) %if atom1 = 0
  1557                 %if escape class # 0 %start             {escape to new grammar}
  1558                    class = escape class;  escape class = 0
  1559                    g = g+escape
  1560        
  1561                    {note that following an escape the next item is}
  1562                    {forced to be transparent!}
  1563        
  1564        esc:        gg = 0
  1565                    arp == ar(nmax+1)
  1566                    arp_papp = papp;  arp_x = x;  ->a4
  1567                 %finish
  1568        
  1569                 ->a1 %if class = atom1 %or class = atom2
  1570        
  1571        a7:      ->fail1 %if gg >= 0                     {no alternative}
  1572                 g = g+1
  1573                 ->a3
  1574              %finish
  1575        
  1576              %if class >= phrasal %start                {a phrase}
  1577        a4:      nmax = nmax+1;  ->fail0 %if nmax = nmin
  1578                 arp == ar(nmax)
  1579                 arp_ptype = ptype
  1580                 arp_pos = pos1
  1581                 arp_pformat = pformat
  1582                 arp_link = gentype
  1583                 arp_class = node
  1584                 arp_sub = g
  1585                 node = 0
  1586                 g = phrase(class)
  1587                 ptype = force %and force = 0 %if force # 0
  1588                 gentype = 0
  1589                 ->paction(gg>>8&15)
  1590              %finish
  1591        
  1592              ->act(class)                               {only actions left}
  1593        
  1594        a5:   {reverse links}
  1595        
  1596              s = 0
  1597              %while node # 0 %cycle
  1598                 z == ar(node)_link
  1599                 k = z;  z = s;  s = node;  node = k
  1600              %repeat
  1601              ss = s
  1602        
  1603        a6:   %if nmax # 0 %start
  1604                 k = gentype                             {type of phrase}
  1605                 arp == ar(nmax);  nmax = nmax-1
  1606                 node = arp_class
  1607                 gentype = arp_link
  1608                 ptype = arp_ptype
  1609                 pformat = arp_pformat
  1610                 g = arp_sub
  1611                 %if g&escape # 0 %start
  1612                    g = g-escape
  1613                    papp = arp_papp
  1614                    mark = 255
  1615                    subatom = s
  1616                    ->a3
  1617                 %finish
  1618                 gentype = k %if gentype = 0 %or k = real
  1619                 type = gen type
  1620        
  1621                 k = gg                                  {exit-point code}
  1622                 %cycle
  1623                    gg = gram(g)
  1624                    ->a2 %if k = 0
  1625                    ->fail1 %if gg >= 0                  {no alternative phrase}
  1626                    k = k-order bit
  1627                    g = g+1                              {sideways step}
  1628                 %repeat
  1629        
  1630              %finish
  1631        
  1632              Fault(4)  %if copy # 0
  1633              fault(13) %if order = 0
  1634              fault(-4) %if for warn # 0
  1635              pos1 = 0
  1636              fault rate = fault rate-1
  1637              %return
  1638        
  1639        act(193):gg = 0 %and ->a5 %unless sym = '=' %or sym = '<'  {cdummy}
  1640        act(181):atom1 = amap(decl&15)                             {dummy}
  1641                 ->more
  1642        
  1643        act(182):class = escdec;  g = glink(g)!escape
  1644                 decl = 0;  otype = 0;  ->esc                      {decl}
  1645        
  1646        act(199):                                                   {compile}
  1647        
  1648                 s = 0
  1649                 %while node # 0 %cycle
  1650                    z == ar(node)_link
  1651                    k = z;  z = s;  s = node;  node = k
  1652                 %repeat
  1653                 ss = s
  1654        
  1655                 code atom(28) %if quote # 0                       {expend}
  1656                 compile;  ->more %if atom1&error = 0
  1657                 ->fail1
  1658        
  1659        act(184):->fail4 %unless type = integer
  1660                 %if subatom < 0 %then lit = tag(-subatom)_format %C
     C                                 %else lit = lit pool(subatom)
  1662                 ->fail4 %if lit # 0
  1663                 ->more
  1664        act(185):                                                   {apply parameters}
  1665                 s = 0
  1666                 %while node # 0 %cycle
  1667                    z == ar(node)_link
  1668                    k = z;  z = s;  s = node;  node = k
  1669                 %repeat
  1670                 ss = s
  1671        
  1672                 atom1 = ar(s)_class;  atom2 = 0
  1673                 atom1 = var %if atom1 = 97 %or atom1 = 98
  1674                 Set FTP
  1675        
  1676                 %if flags&subname # 0 %and format # 0 %start
  1677                    ->fail1 %if format selected = 0
  1678                 %finish
  1679        
  1680                 Escape Class = EscN %if Atom1 = 92 {N} %and Sym = '['
  1681        
  1682                 ->a6
  1683        
  1684        act(187):protection = prot;  ->more            {%SETPROT}
  1685        act(186):->More %if protection&prot = 0
  1686                 prot err = nmin
  1687                 ->A7
  1688        act(191):k = protection                        {%GUARD}
  1689                 code atom(0)
  1690                 protection = k %if atom flags&aname = 0
  1691                 ->more
  1692        
  1693        act(192):->fail1 %if parsed machine code=0
  1694                 ->more
  1695        
  1696        act(189):k = gapp                              {%GAPP}
  1697                 delete names(1, Tbase)
  1698                 tmax = tbase;  tbase = gram (gmin)    {restore tmax}
  1699                 local= tbase
  1700                 gmin = gmin+1
  1701        
  1702                 x = ar(ar(nmax)_class)_sub
  1703                 tag(x)_app = k                        {update app}
  1704                 ->more
  1705        
  1706        act(180):Atom1 = 45             {Sign}
  1707                 Atom2 = 0
  1708                 Subatom = 36           {Minus}
  1709                 ->More
  1710        
  1711        act(190):gmin = gmin-1                         {%LOCAL}
  1712                 abandon(2) %if gmin <= gmax
  1713                 gram (gmin) = tbase;  tbase = tmax
  1714                 local = tbase
  1715                 ->more
  1716        
  1717        { errors}
  1718        
  1719        fail4:k = error+10;            ->failed        {*size}
  1720        fail3:k = error+7;             ->failed        {*context}
  1721        fail2:k = error+5;  pos2 = 0;  ->failed        {*type}
  1722        fail0:k = error+3;             ->failed        {*too complex}
  1723        fail1:k = atom1;    pos2 = 0
  1724        
  1725        failed:
  1726              %if diag&32 # 0 %start
  1727                 printstring("Atom1 =");       write(atom1, 3)
  1728                 printstring("  Atom2 =");     write(atom2, 3)
  1729                 printstring("  subatom =");   write(subatom, 3);  newline
  1730                 printstring("Type =");        write(type, 1)
  1731                 printstring("   Ptype =");    write(ptype, 1);    newline
  1732                 printstring("App =");         write(app, 1)
  1733                 printstring("   Papp =");     write(papp, 1);     newline
  1734                 printstring("Format =");      write(format, 1)
  1735                 printstring("   Pformat =");  write(pformat, 1);  newline
  1736                 %SIGNAL 13,15
  1737               %finish
  1738        
  1739               quote = 0 %and readsym %while sym # nl %and sym # ';'
  1740               %if k&error # 0 %start
  1741                  fault(k&255)
  1742               %finish %else %start
  1743                 %if prot err = nmin %then fault(14) %else fault(0)
  1744               %finish
  1745               gg = 0;  ss = 0;  symtype = 0
  1746           %end                                               {of analyse}
  1747        
  1748           %routine compile
  1749        
  1750              %constinteger then = 4, else = 8, loop = 16
  1751        
  1752              %switch c(0:actions), litop(1:12)
  1753        
  1754              %constbyteintegerarray operator(1:14) = %C
     C                                 '[',  ']',  'X',  '/', '&',  '!',  '%',  '+',
     C                                 '-',  '*',  'Q',  'x', '.',  'v'
  1757        
  1758              %constbyteintegerarray cc(0 : 7) = '#','=',')','<','(','>', 'k','t'
  1759        
  1760              %constbyteintegerarray anyform(0:15) = 1,0,1,1(4),1,0,1,1,0,1,1,1,1
  1761        
  1762              %constshortintegerarray decmap(0:15) = %C
     C                 1,             2,
     C                 x'100B',       x'100D',       x'140C',      x'140E',
     C                 3,             4,
     C                 x'1007',       x'1008',       x'1009',      x'100A',
     C                 6,             0,             0,            0
  1768              %ownbyteintegerarray cnest(0:15)
  1769              %record(Tagfm)%name T
  1770              %integer lmode, clab, dupid
  1771              %integer resln
  1772              %owninteger last def = 0
  1773              %owninteger lb, ub
  1774              %integer cp, ord
  1775              %integer next, link, j, k, n, done, St Len
  1776              %integer class
  1777              %integer lit2, defs, decs, cident
  1778              %integername PP
  1779              %integer pending;  %ownintegerarray pstack(1:40)
  1780              %ownstring(8) name = ""
  1781              %owninteger count = 0
  1782        
  1783              %routine def lab(%integer l)
  1784                 op(':', l)
  1785                 access = 1
  1786              %end
  1787        
  1788              %routine get next
  1789                 %record(arfm)%name p
  1790        gn:      %if next = 0 %start                        {end of phrase}
  1791                    class = 0 %and %return %if link = 0     {end of statement}
  1792                    p == ar(link)
  1793                    next = p_link
  1794                    link = p_sub
  1795                 %finish
  1796                 %cycle
  1797                    p == ar(next)
  1798                    x = p_sub
  1799                    class = p_class
  1800                    %exit %if class < actions               {an atom}
  1801                    %if x = 0 %start                        {null phrase}
  1802                       next = p_link;  ->gn
  1803                    %finish
  1804                    %if p_link # 0 %start                   {follow a phrase}
  1805                       p_sub = link;  link = next
  1806                    %finish
  1807                    next = x
  1808                 %repeat
  1809                 next = p_link
  1810                 %if diag&2 # 0 %start
  1811                    spaces(8-length(name)) %unless name = ""
  1812                    name = text(class)
  1813                    write(x, 2)
  1814                    space
  1815                    printstring(name)
  1816                    space
  1817                    count = count-1
  1818                    %if count <= 0 %start
  1819                       count = 5
  1820                       name = ""
  1821                       newline
  1822                    %finish
  1823                 %finish
  1824              %end
  1825        
  1826              %routine set subs(%integer n)
  1827        
  1828                 {update the app field in n array descriptors}
  1829        
  1830                 %integer p
  1831                 p = tmax
  1832                 %while n > 0 %cycle
  1833                    %SIGNAL 14,15 %if p < tbase
  1834                    tag(p)_app = dimension
  1835                    p = p-1;  n = n-1
  1836                 %repeat
  1837              %end
  1838        
  1839              %routine set bp
  1840        
  1841                 {define a constant bound pair from the last stacked constants}
  1842        
  1843                 pending = pending-2
  1844                 lb = pstack(pending+1);  ub = pstack(pending+2)
  1845                 %if ub-lb+1 < 0 %start
  1846                    pos1 = 0;  next = link;  fault(11)
  1847                    ub = lb
  1848                 %finish
  1849                 set const(lb);  set const(ub)
  1850                 bp=bp+1 %and buff(bp)='b' %unless class = 146
  1851              %end
  1852        
  1853              %routine compile end(%integer type)
  1854        
  1855                 { type = 0:eof, 1:eop, 2:end}
  1856        
  1857                 %if access # 0 %start
  1858                    open = 0
  1859                    fault(19) %if block form > proc           {can reach end}
  1860                 %finish
  1861        
  1862                 %while dict(dmin) >= 0 %cycle                {finishes & repeats}
  1863                    fault(17+dict(dmin)&1)
  1864                    dmin = dmin+1
  1865                 %repeat
  1866                 {delete names(0, Tbase)}
  1867                 bp=bp+1;  buff(bp)=';'
  1868                 bp=bp+1 %and buff(bp)=';' %if type = 1       {endofprogram}
  1869        
  1870                 bflags = bflags!open                         {show if it returns}
  1871        
  1872                 %if type # 2 %start                          {eop, eof}
  1873                    fault(16) %if level # type                {end missing}
  1874                 %finish %else %if level = 0 %start
  1875                    fault(15)                              {spurious end}
  1876                 %finish
  1877        
  1878              %end
  1879        
  1880              %routine def(%integer p)
  1881        
  1882                 {dump a descriptor}
  1883        
  1884                 %integer t, f, type
  1885                 %record(tagfm)%name v
  1886                 flush buffer %if bp >= Buffer Safe Limit
  1887                 defs = defs+1
  1888                 v == tag(p)
  1889                 t = 0
  1890                 %unless v_index < 0 %start                   {no index for subnames}
  1891                    id = id+1 %and v_index = id %if v_index = 0
  1892                    last def = v_index
  1893                    t = last def
  1894                 %finish
  1895                 op('$', t)
  1896                 print ident(p, 1)                            {output the name}
  1897                 t = v_flags
  1898                 type = t
  1899                 type = type&(\(7<<4)) %if type&(7<<4) >= 6<<4{routine & pred}
  1900                 op(',', type&b'1111111')             {type & form}
  1901                 f = v_format
  1902                 f = tag(f)_index %if t&x'70' = record<<4
  1903                 f = v_index %if f < 0
  1904                 Put Tag(f)               {format}
  1905        !PSR!    f = otype+t>>4&b'1111000'            {was this just for FROZEN?}
  1906                 f = otype + (t>>4)&8                 {don't forget spec bit}
  1907                 f = f!8 %if class = 125              {add spec from %DUP}
  1908                 dim = v_app                          {dimension}
  1909                 dim = 0 %unless 0 < dim <= dim limit
  1910                 Put Tag(f+dim<<8)                    {otype & spec}
  1911                 defs = 0 %if t&parameters = 0
  1912                 f = t&15
  1913                 %if v_flags&spec # 0 %start
  1914                    ocount = -1                       {external specs have no constants}
  1915                 %finish
  1916                 dimension = 0
  1917                 %if otype = 2 %and (f=2 %or f=12 %or f=14) %start
  1918                    v_flags = v_flags-1               {convert to simple}
  1919                 %finish
  1920              %end
  1921        
  1922              %routine def s lab(%integer n)
  1923        
  1924                 {define a switch label, x defines the switch tag}
  1925        
  1926                 %integer p, l, b, w, bit
  1927                 p = tag(x)_format                               {pointer to table}
  1928                 %return %if p <= 0                              {following an error?}
  1929                 l = dict(p)                                     {lower bound}
  1930                 %if l <= n <= dict(p+1) %start
  1931                    b = n-l
  1932                    w = b>>4+p
  1933                    bit = 1<<(b&15)
  1934                    %if dict(w+2)&bit # 0 %start                 {already set}
  1935                       fault(4) %if pending # 0
  1936                       %return
  1937                    %finish
  1938                    dict(w+2) <- dict(w+2)!bit %if pending # 0
  1939                    set const(n)
  1940                    op('_', tag(x)_index)   
  1941                 %finish %else %start
  1942                    fault(12)
  1943                 %finish
  1944                 access = 1
  1945              %end
  1946        
  1947              %routine call
  1948                 %record(tagfm)%name T
  1949                 t == tag(x)
  1950                 op('@', t_index)
  1951                 access = 0 %if t_flags&closed # 0                {never comes back}
  1952                 bp=bp+1 %and buff(bp)='E' %if t_app = 0          {no parameters}
  1953              %end
  1954        
  1955              %routine pop def
  1956                 set const(pstack(pending));  pending = pending-1
  1957              %end
  1958        
  1959              %routine pop lit
  1960                 %if pending = 0 %then lit = 0 %else %start
  1961                    lit = pstack(pending);  pending = pending-1
  1962                 %finish
  1963              %end
  1964        
  1965        
  1966           {%constrecord(Inclfm)%name} Inclfm Type == 0
  1967           {%record(Inclfm)%name} Includes == Nil
  1968        
  1969        
  1970              %if sstype < 0 %start                       {executable statement}
  1971                 %if level = 0 %start                     {outermost level}
  1972                    fault(13)                             {*order}
  1973                 %finish %else %start
  1974                    %if access = 0 %start
  1975                       access = 1;  fault(-1)             {only a warning}
  1976                    %finish
  1977                 %finish
  1978              %finish
  1979        
  1980              %if diag&2 # 0 %start
  1981                 newline %if sym # nl
  1982                 printstring("ss =")
  1983                 write(ss, 1)
  1984                 newline
  1985                 count = 5
  1986                 name = ""
  1987              %finish
  1988        
  1989              next = ss
  1990              pending = 0;  lmode = 0
  1991              link = 0;  decs = 0
  1992              defs = 0;  resln = 0;  done = 0;  St Len = 0
  1993              ord = level
  1994              ord = 1 %if this >= 0                       {recordformat declarations}
  1995        c(0):
  1996        top:  %if next # link %start
  1997                 get next;  ->c(class)
  1998              %finish
  1999        
  2000              {all done, tidy up declarations and jumps}
  2001        
  2002              newline %if diag&2 # 0 %and count # 5
  2003        
  2004              %if lmode&(loop!then!else) # 0 %start       {pending labels and jumps}
  2005                 op('B', label-1) %if lmode&loop # 0      {repeat}
  2006                 def lab(label)   %if lmode&then # 0      {entry from then}
  2007                 def lab(label-1) %if lmode&else # 0      {entry from else}
  2008              %finish
  2009        
  2010              %return %if decs = 0
  2011              atom1 = error %and %return %if atom1 # 0    {%integerROUTINE}
  2012              order = ord
  2013              decl = decl&(\15)+decmap(decl&15)           {construct declarator flags}
  2014              atom1 = atoms(decl&15)                      {generate class}
  2015              %if otype # 0 %start                        {own, const etc.}
  2016                 atom1 = atom1+1 %if atom1 # proc
  2017                 %if otype = 2 %start                     {const}
  2018                    n = decl&15
  2019                    %if n&1 # 0 %start
  2020                       decl = decl!prot
  2021                       decl = decl!const bit %if decl&b'1111111' = iform
  2022                    %finish
  2023                 %else
  2024                    decl = decl!own bit
  2025                 %finish
  2026              %finish
  2027              sstype = 1 %if sstype = 0 %and atom1 = proc
  2028              atom1 = atom1+1 %if decl&spec # 0             {onto spec variant}
  2029              ocount = 0 %and cont = '+' %if atom1 = 5      {own array}
  2030              %if anyform(decl&15) = 0 %start               {check meaningful}
  2031                 %if decl>>4&7 = record %start
  2032                    this = fdef %if tag(fdef)_flags&spec # 0
  2033                    atom1 = error+21 %if fdef = this        {*context for format}
  2034                 %finish
  2035                 %if Fdef = 0 %start                         {*Size ?}
  2036                    Atom1 = Error+10 %unless Otype = 2 %and %C
     C                                             Decl&2_1111 111 = stringV<<4+1
  2038                    {Permit conststring(*) Fred}
  2039                 %finish
  2040              %finish
  2041              %return
  2042        
  2043        atop:   access = 0;  ->top
  2044        
  2045        { declarators}
  2046        
  2047        c(88):                                                {rtype}
  2048        c(28): decl = x&(\7)                                 {stype}
  2049               fdef = x&7                                    {precision}
  2050               decs = 1;  ->top
  2051        c(34):                                                {own}
  2052        c(35): otype = x;  ord = 1;  ->top                   {external}
  2053        c(17): pop lit;  otype = lit<<8+6;  ord = 1;  ->top  {prim}
  2054        c(152):decl = decl+x<<1;  ->top                      {xname}
  2055        c(31):                                                {proc}
  2056        c(32): spec mode = level+1                           {fn/map}
  2057               decl = decl!prot %if x = 9                    {function}
  2058        c(29): ord = 1                                       {array}
  2059               dim = 0
  2060        c(30): decl = decl+x                                 {name}
  2061               decs = 1
  2062               ->top
  2063        c(27): lit = 0                                       {arrayd}
  2064               %if pending # 0 %start
  2065                  pop lit
  2066                  %unless 0<lit<=dim limit %start
  2067                     atom1 = error + 11;  %return
  2068                  %finish
  2069               %finish
  2070               dim = lit
  2071               decl = decl + x;  decs = 1
  2072               -> top
  2073        c(37): x = x!subname                                 {record}
  2074        c(36): lit = 0                                       {string}
  2075               %if pending # 0 %start
  2076                 pop lit
  2077                  %unless 0 < lit <= 255 %start              {max length wrong}
  2078                     atom1 = error+10;  %return
  2079                  %finish
  2080               %finish
  2081               fdef = lit                                    {format or length}
  2082        c(33): decl = x                                      {switch}
  2083               decs = 1
  2084               ->top
  2085        c(39): decl = decl!spec                              {spec}
  2086               ocount = -1                                   {no initialisation}
  2087               spec mode = -1
  2088               ->top
  2089        c(38): decl = 64+4                                   {recordformat (spec)}
  2090               order = 1
  2091               atom1 = x
  2092               decl = decl!spec %if atom1 = 12               {formatspec}
  2093               fdef = tmax+1                                 {format tag}
  2094               %return
  2095        c(175):id = id+1;  tag(x)_index = id;  %return       {FSID}
  2096        c(41): decs = 1;  decl = x!spec!closed;  ->top       {label}
  2097        c(133):recid = 0;  rbase = tmin-1                    {fname}
  2098               this = x
  2099               fm base = fdef;  format list = tmin
  2100               def(this);                      ->top
  2101        c(148):fdef = 0 %and ->top %if next = 0              {reclb}
  2102               get next                                      {skip name}
  2103               fdef = x
  2104               ->top
  2105        c(127):bp=bp+1;  buff(bp)='}';  ->top                {%POUT}
  2106        c(126):bp=bp+1;  buff(bp)='{';  ->top                {%PIN}
  2107        
  2108        c(174):set bp                                        {rangerb}
  2109        c(171):                                               {fmlb}
  2110        c(172):                                               {fmrb}
  2111        c(173):bp=bp+1;  buff(bp)='~'
  2112               bp=bp+1;  buff(bp)=class-171+'A';  ->top      {fmor}
  2113        c(168):rbase = -rbase                                {orrb}
  2114               sstype = 0;  spec mode = 0
  2115        
  2116        c(147):search base = 0                               {recrb}
  2117               tag(this)_app = tmin
  2118               tag(this)_format = rbase
  2119               ->top
  2120        
  2121        c(45):bp=bp+1 %and buff(bp)='U' %if x = 36;  ->top   {sign}
  2122        c(46):bp=bp+1;  buff(bp)='\';  ->top                 {uop}
  2123        c(47):                                                {mod}
  2124        c(48):                                                {dot}
  2125        c(42):                                                {op1}
  2126        c(43):                                                {op2}
  2127        c(44):bp=bp+1;  buff(bp)=operator(x);  ->top         {op3}
  2128        
  2129        {conditions & jumps}
  2130        
  2131              %routine push(%integer x)
  2132                 %if cnest(cp)&2 # x %start
  2133                    cnest(cp) = cnest(cp)!1;  x = x+4
  2134                 %finish
  2135                 clab = clab+1 %if cnest(cp)&1 # 0
  2136                 cnest(cp+1) = x;  cp = cp+1
  2137              %end
  2138        
  2139              %routine pop label(%integer mode)
  2140                 lmode = dict(dmin)
  2141                 %if lmode < 0 %or lmode&1 # mode %start
  2142                    fault(mode+8)
  2143                 %finish %else %start
  2144                    dmin = dmin+1;  label = label-4
  2145                 %finish
  2146              %end
  2147        
  2148        c(56):                                         {and}
  2149        c(57):push(x);  ->top                         {or}
  2150        c(58):cnest(cp) = cnest(cp)!!2;  ->top        {not}
  2151        
  2152        c(138):x = 128+32+16+4                        {csep: treat like %while}
  2153        c(59):                                         {while}
  2154        c(60):%if class = 138 %then op('f', label-1) %C
     C                              %else def lab(label-1)  {until}
  2156        c(166):                                        {runtil}
  2157        c(62):lmode = (lmode&(else!loop)) !(x>>3)     {cword}
  2158              clab = label;  cp = 1;  cnest(1) = x&7
  2159              ->top
  2160        c(72):pop label(0)                            {repeat}
  2161              def lab(label+1) %if lmode&32 # 0;  ->atop
  2162        c(69):pop label(1);               ->top       {finish}
  2163        c(163):                                        {xelse}
  2164        c(70):pop label(1)                            {finish else ...}
  2165              fault(7) %if lmode&3 = 3                {dangling else}
  2166        c(68):lmode = (lmode&else)!3                  {...else...}
  2167              %if access # 0 %start
  2168                 op('F', label-1);  lmode = else!3
  2169              %finish
  2170              def lab(label)
  2171              ->top %if next # 0
  2172        
  2173        c(120):                                        {%MSTART}
  2174        c(67):                                         {start}
  2175        c(71):                                         {cycle}
  2176        stcy: def lab(label-1) %and lmode = loop %if lmode = 0{cycle}
  2177              dmin = dmin-1;  abandon(3) %if dmin <= dmax
  2178              Dict Upper = Dmin %if Dmin < Dict Upper
  2179              dict(dmin) = lmode
  2180              label = label+4
  2181              %return
  2182        
  2183        c(64):fault(13) %if dict(dmin) >= 0 %or inhibit # 0  {on event}
  2184              inhibit = 1
  2185              n = 0
  2186              n = x'FFFF' %if pending = 0             {* = all events}
  2187              %while pending > 0 %cycle
  2188                 pop lit;  fault(10) %if lit&(\15) # 0{too big}
  2189                 j = 1<<lit
  2190                 dubious = 1 %if n&j # 0
  2191                 n = n!j                              {construct bit mask}
  2192              %repeat
  2193              op('o', n);  Put Tag(label)
  2194              lmode = then!1;  ->stcy
  2195        
  2196        
  2197        c(104):op('J', tag(x)_index)                   {l}
  2198               inhibit = 1;            ->atop
  2199        c(149):stats = stats-1                         {lab}
  2200               access = 1;  inhibit = 1
  2201               op('L', tag(x)_index);  ->top
  2202        
  2203        c(63):j = dmin;  l = label                   {exit, continue}
  2204              %cycle
  2205                 l = l-4
  2206                 fault(7) %and ->top %if dict(j) < 0
  2207                 %exit %if dict(j)&1 = 0
  2208                 j = j+1
  2209              %repeat
  2210              l = l+1 %if x = 32                       {continue}
  2211              op('F', l)
  2212              dict(j) = dict(j)!x                      {show given}
  2213              ->atop
  2214        
  2215        c(50):bp=bp+1;  buff(bp)='C';  ->cop           {acomp}
  2216        
  2217        c(176):x = 2     {<}
  2218        c(49): bp = bp+1
  2219               %if next # 0 %start                     {comparator}
  2220                  buff(bp)='"';  push(0)               {double sided}
  2221               %finish %else %start
  2222                  buff(bp)='?'
  2223               %finish
  2224        
  2225        cop:   x = x!!1 %if cnest(cp)&2 # 0            {invert the condition}
  2226               j = cp;  l = clab
  2227               %while cnest(j)&4 = 0 %cycle
  2228                  j = j-1;  l = l-cnest(j)&1
  2229               %repeat
  2230               op(cc(x), l)
  2231               def lab(clab+1) %if cnest(cp)&1 # 0
  2232               cp = cp-1
  2233               clab = clab-cnest(cp)&1
  2234               ->top
  2235        
  2236        c(78):                                          {fresult}
  2237        c(79):                                          {mresult}
  2238        c(80):open = 0                                  {return, true, false}
  2239              access = 0
  2240        c(15):                                          {[index]}
  2241        c(81):bp=bp+1;  buff(bp)=x;  ->top              {monitor}
  2242        
  2243        c(82):                                          {stop}
  2244        c(65):pop lit;  op('e', lit)                    {signal}
  2245              Fault(10) %unless 0 <= Lit <= 15
  2246              ->Atop
  2247        c(123):Set const(0);  ->Top                     {%stackz}
  2248        
  2249        c(51):bp=bp+1;  buff(bp)='S';  ->top            {eq}
  2250        c(53):bp=bp+1;  buff(bp)='j';  ->top            {jam transfer}
  2251        c(52):bp=bp+1;  buff(bp)='Z';  ->top            {eqeq}
  2252        
  2253        C(73):Fault(7) %if Level # 0                    {Section}
  2254              Tbase = 0;  Tstart = 0
  2255              Delete names(0, Tbase)
  2256              Id = 0
  2257              List = List+1
  2258              Section Lines = Lines;  Section Stats = Stats
  2259              Gmin = Max Grammar;  Tmin = Max Tag
  2260              Perm = 1
  2261              Select Input(2);  Reset Input
  2262              Bp = Bp+1;  Buff(Bp) = 'c'
  2263              %if Next # 0 %start                         {section id given}
  2264                 Get Next;  ->Pstr
  2265              %finish
  2266              Bp = Bp+1;  Buff(Bp) = 0                    {default null string}
  2267              %return
  2268        c(74):%if level = 0 %start                         {begin}
  2269                 %if progmode <= 0 %then progmode = 1 %else fault(7)
  2270                 {Permit BEGIN after external defs}
  2271              %finish
  2272              spec mode = level+1
  2273              block x = 0
  2274              bp=bp+1;  buff(bp)='H';  %return
  2275        c(77):perm = 0                                     {endofperm}
  2276              Lines = Section Lines;  Stats = Section Stats
  2277              select input(source)
  2278              list = list-1
  2279              Check Prims
  2280              tbase = tmax;  tstart = tmax
  2281              %return
  2282        
  2283              %string(255)%fn Next Include
  2284                 %record(Inclfm)%name I
  2285                 I == Includes
  2286                 %while I ## Nil %cycle
  2287                    %if I_Depth = Include Depth %start
  2288                       I_Depth = -1
  2289                       %result = Actual Include(I_From, I_File)
  2290                    %finish
  2291                    I == I_Link
  2292                 %repeat
  2293                 %result = ""
  2294              %end
  2295        
  2296              %routine End of Include
  2297                 %record(Includefm)%name I
  2298                 Sstype = 0
  2299                 Close Input
  2300                 Lines        = Including_Lines
  2301                 List         = Including_List
  2302                 Include File = Including_File
  2303                 I == Including;  Including == Including_Link;  DISPOSE(I)
  2304                 Include Depth = Include Depth-1
  2305        
  2306                 Select Input(Include Stream(Include Depth))
  2307                 Flush Buffer
  2308                 Buff(Bp+1) = 'q';  Buff(Bp+2) = 0    {null string}
  2309                 Bp = Bp+2
  2310                 %if Options&LL Mon # 0 %start
  2311                    Select Output(0)
  2312                    Printstring("Returning to """.Include File."""");  Newline
  2313                    Select Output(Listing)
  2314                 %finish
  2315              %end
  2316        
  2317              %routine Select Include(%string(255) File)
  2318                 %record(Includefm)%name I
  2319                 %integer S, J
  2320                 %return %if File = ""
  2321                 I == New(Includefm Type)
  2322                 I_Link == Including;  Including == I
  2323                 I_File = Include File
  2324                 I_Lines = Lines;  Lines = 0
  2325                 I_List  = List;
  2326                 Include Depth = Include Depth+1
  2327                 Abandon(10) %if Include Depth >= 5
  2328                 S = Include Stream(Include Depth)
  2329                 %begin
  2330                    %on 9 %start
  2331                       Include File = Event_Message
  2332                       Abandon(9)
  2333                    %finish
  2334                    Open Input(S, File)
  2335                 %end
  2336                 Select Input(S)
  2337        !N!      Include File = Input Name
  2338        {C}      Include File = File                   {transputer RTL bug}
  2339                 Flush Buffer
  2340                 %if Options&LL Mon # 0 %start
  2341                    Select Output(0)
  2342                    Printstring("Including """.Include File."""");  Newline
  2343                    Select Output(Listing)
  2344                 %finish
  2345                 Bp = Bp+1;  Buff(Bp) = 'q'
  2346                 Bp = Bp+1;  Buff(Bp) = Length(Include File)
  2347                 %for J = 1, 1, Length(Include File) %cycle
  2348                    Bp = Bp+1;  Buff(Bp) = Charno(Include File, J)
  2349                 %repeat
  2350              %end
  2351        
  2352        c(76):%if Including ## Nil %and x = 0 %start       {end of ...}
  2353                 End of Include
  2354                 Select Include(Next Include)
  2355                 %return
  2356              %finish
  2357              ss = -1                                      {prog/file}
  2358        c(75):compile end(x);  %return                     {%end}
  2359        
  2360        c(85):%if x=0 %then control=lit %else %start       {control}
  2361                 diag = lit&x'3FFF' %if lit>>14&3 = 1
  2362              %finish
  2363              op('z'-x, lit)
  2364              ->top
  2365        c(83):list = list+x-2;   ->top                     {%LIST/%endOFLIST}
  2366        
  2367        c(89):                                             {from}
  2368        c(86): Decl = Lab!1024;  IncBase = Tmax;  ->Top    {include}
  2369        
  2370        c(119):get next                                    {include "file"}
  2371              Select Include(string(x-x'4000'+stbase))
  2372              ->top
  2373        
  2374              %string(255)%fn GetFile(%integer X)
  2375                 %result = String(Addr(Dict(1-X))) %if X < 0
  2376                 %result = String(Addr(Dict(Tag(X)_Text+1)))
  2377              %end
  2378        
  2379              %routine Get Include List(%string(255) From)
  2380                 %record(Inclfm)%name I
  2381                 %string(255) File
  2382                 %cycle
  2383                    Get Next;  %return %if Class # 90  {ident}
  2384                    File = GetFile(X)
  2385                    I == Includes
  2386                    %cycle
  2387                       %if I == Nil %start
  2388                          I == NEW(inclfm Type)
  2389                          I_Link == Includes;  Includes == I
  2390                          I_Depth = Include Depth
  2391                          I_From = From;  I_File = File
  2392                          %exit
  2393                       %finish
  2394                       %exit %if I_From = From %and I_File = File
  2395                       I == I_Link
  2396                    %repeat
  2397                 %repeat
  2398              %end
  2399        
  2400        c(129):Get Next                                    {%NOFROM}
  2401               Get Include List("")                        {default}
  2402               ->IncF
  2403        
  2404        c(118):Get Next                                    {%FROM}
  2405               Get Include List(GetFile(X))
  2406        
  2407        IncF:  Delete Names(1, IncBase)
  2408               Select Include(Next Include)
  2409               ->Top %if Class = 0
  2410               ->C(Class)
  2411        
  2412        c(154):dimension = dimension+1                     {dbsep}
  2413               fault(11) %if dimension = dim limit+1
  2414               ->top
  2415        c(145):set bp;                       ->top         {crb}
  2416        c(146):set bp                                      {rcrb}
  2417        c(142):                                            {bplrb}
  2418               dimension = 1 %if dimension = 0
  2419               op('d', dimension);  Put Tag(defs)
  2420               %if class # 146 %start
  2421                  set subs(defs)
  2422                  fault(13) %if dict(dmin) >= 0 %or inhibit # 0 %or level=0
  2423               %finish
  2424               dimension = 0;  defs = 0
  2425               ->top
  2426        c(128):id = dupid;  ->top                          {EDUP}
  2427        c(130):block x = x
  2428        c(125):dupid = id                                  {%DUP}
  2429               %return %if Level < 0                        {spec about}
  2430        c(90): def(x);  ->top                              {ident}
  2431        c(131):T == Tag(X)                                 {cident}
  2432               %if T_flags&(b'1111111'+const bit) = iform+const bit %start
  2433                  T_format = lit
  2434               %finish %else %start
  2435                  set const(lit) %if pending # 0
  2436                  %if T_Flags&2_111 1111 = stringV<<4+1 %start   {Simple string}
  2437                     T_Format = St Len %if T_Format = 0
  2438                     Fault(10) %if St Len > T_Format
  2439                  %finish
  2440                  def(x)
  2441                  op('A', 1)
  2442               %finish
  2443               cident = x
  2444               ->top
  2445        c(124):dubious = 1 %if tag(cident)_flags&prot # 0 {%DUBIOUS}
  2446               ->top
  2447        c(97):                                              {f}
  2448        c(98):                                              {m}
  2449        c(99):                                              {p}
  2450        c(96): call;  ->top                                 {r}
  2451        
  2452        c(165):                                             {nlab}
  2453        c(100):                                             {rp}
  2454        c(101):                                             {fp}
  2455        c(102):                                             {mp}
  2456        c(103):                                             {pp}
  2457        c(91):                                              {v}
  2458        c(92):                                              {n}
  2459        c(106):                                             {a}
  2460        c(107):                                             {an}
  2461        c(108):                                             {na}
  2462        c(109):                                             {nan}
  2463              k = tag(x)_index
  2464              %if k < 0 %then op('n', -k) %else op('@', k)
  2465              ->top
  2466        c(121):set const(0);  ->top                        {special for zero}
  2467        c(167):bp=bp+1;  buff(bp)='G';  ->pstr             {aconst (alias)}
  2468        c(const):                                          {const}
  2469               %if x < 0 %start                            {constinteger}
  2470                  set const(tag(-x)_format);  ->top
  2471               %finish
  2472               %if x&x'4000' # 0 %start                    {strings}
  2473                  bp=bp+1;  buff(bp)=''''
  2474        pstr:     x = x-x'4000'+stbase
  2475                  St Len = byteinteger(x)
  2476                  Flush Buffer %if Bp >= Buffer Safe Limit
  2477                  bp=bp+1;  buff(bp)=St Len
  2478                  k = St Len+x
  2479                  %cycle
  2480                     ->top %if x = k
  2481                     x = x+1;  bp=bp+1;  buff(bp)=byteinteger(x)
  2482                  %repeat
  2483               %finish
  2484               %if x&x'2000' # 0 %start                    {real}
  2485                  x = x-x'2000'+stbase
  2486                  k = byteinteger(x)
  2487                  op('D', k)
  2488                  k = k+x
  2489                  %cycle
  2490                     ->top %if x = k
  2491                     x = x+1;  j = byteinteger(x)
  2492                     %if j = '@' %start
  2493                        op('@', litpool(byteinteger(x+1)));  ->top
  2494                     %finish
  2495                     bp=bp+1;  buff(bp)=j
  2496                  %repeat
  2497               %finish
  2498               set const(lit pool(x))
  2499               ->top
  2500        
  2501        c(137):bp=bp+1;  buff(bp)='i';               ->top         {asep}
  2502        c(141):bp=bp+1;  buff(bp)='a';               ->top         {arb}
  2503        
  2504        {own arrays}
  2505        
  2506        c(132):ocount = ub-lb+1
  2507               def(x)                               {oident}
  2508               dimension = 1;  set subs(1)
  2509               %if next = 0 %start                  {no initialisation}
  2510                  op('A', ocount) %if ocount > 0
  2511                  ocount = -1
  2512               %finish %else %start                 {initialisation given}
  2513                  get next
  2514               %finish
  2515               Flush Buffer %if Bp >= Buffer Safe Limit
  2516               ->top
  2517        c(162):lit = ocount;  ->ins                 {indef}
  2518        c(143):pop lit                              {orb}
  2519        ins:   fault(10) %and lit = 0 %if lit < 0
  2520               get next
  2521               ->inst
  2522        c(139):                                      {osep (x=19)}
  2523        c(153):lit = 1
  2524        inst:  pop def %if pending # 0              {ownt (x=0)}
  2525               op('A', lit)
  2526               ocount = ocount-lit
  2527               %if ocount >= 0 %start
  2528                  ->top %if x # 0                          {more coming}
  2529                  ocount = -1 %and %return %if ocount = 0  {all done}
  2530               %finish
  2531               fault(11);  %return
  2532        
  2533        c(swit):op('W', tag(x)_index);  inhibit = 1;  ->atop
  2534        c(134):def(x)                               {swid}
  2535               n = ub-lb+1
  2536               n = (n+15)>>4                        {slots needed (includes zero)}
  2537               j = dmax;  dmax = dmax+n+2
  2538               abandon(1) %if dmax >= dmin
  2539               tag(x)_format = j
  2540               dict(j) = lb;  dict(j+1) = ub
  2541               %cycle
  2542                  n = n-1
  2543                  ->top %if n < 0
  2544                  j = j+1;  dict(j+1) = 0
  2545               %repeat
  2546        c(151):stats = stats-1                      {slab}
  2547               fault(7) %and %return %if x < tbase
  2548               %if pending # 0 %start               {explicit label}
  2549                  def s lab(pstack(1))
  2550               %finish %else %start
  2551                  fault(4) %and %return %if tag(x)_app # 0
  2552                  tag(x)_app = 1
  2553                  n = tag(x)_format
  2554                  %for j = dict(n), 1, dict(n+1) %cycle
  2555                     def s lab(j)
  2556                     flush buffer %if bp >= Buffer Safe Limit
  2557                  %repeat
  2558               %finish
  2559               inhibit = 1
  2560               %return
  2561        
  2562        c(140):bp=bp+1;  buff(bp)='p';                     ->top          {psep}
  2563        c(144):buff(bp+1)='p';  buff(bp+2)='E';  bp=bp+2;  ->top          {prb}
  2564        
  2565        {constant expressions}
  2566        
  2567        c(155):                                                           {pconst}
  2568                     %if x < 0 %then lit = tag(-x)_format %c
     C                               %else lit = lit pool(x)
  2570                     pending = pending+1
  2571        Set Lit:     Pstack(Pending) = Lit;  ->top
  2572        c(156):Lit = pstack(pending);  Lit = -Lit %if Lit < 0;  ->SetLit  {cmod}
  2573        c(157):->Top %unless X = 36     {ignore leading +}
  2574               Lit = pstack(pending);  Lit = -Lit;              ->SetLit  {csign}
  2575        c(158):Lit = pstack(pending);  Lit = \Lit;              ->SetLit  {cuop}
  2576        c(159):                                      {cop1}
  2577        c(160):                                      {cop2}
  2578        c(161):pending = pending-1                   {cop3}
  2579               lit  = Pstack(Pending)
  2580               lit2 = pstack(pending+1)
  2581               ->litop(x>>2)
  2582        litop(10):Lit = Lit*lit2;   ->SetLit
  2583        litop(12):
  2584        litop(3):n = 1                               {lit = lit\\lit2}
  2585                 fault(10) %if lit2 < 0
  2586                 Lit2 = Lit2-1 %and N = N*Lit %while lit2 > 0
  2587                 Lit = n;           ->SetLit
  2588        litop(1):Lit = Lit<<lit2;   ->SetLit
  2589        litop(2):Lit = Lit>>lit2;   ->SetLit
  2590        litop(5):Lit = Lit&lit2;    ->SetLit
  2591        litop(11):
  2592        litop(4):%if lit2 = 0 %then fault(10) %else Lit = Lit//lit2
  2593                                    ->SetLit
  2594        litop(8):Lit = Lit+lit2;    ->SetLit
  2595        litop(9):Lit = Lit-lit2;    ->SetLit
  2596        litop(6):Lit = Lit!lit2;    ->SetLit
  2597        litop(7):Lit = Lit!!lit2;   ->SetLit
  2598        
  2599        c(170):!!!!!Fault(4) %if IMPCOM_Option # ""
  2600               !!!!!IMPCOM_Option = string(x-x'4000'+Stbase)      {Option string}
  2601               ->Top
  2602        
  2603        !string resolution
  2604        
  2605        c(135):resln = 2;                    ->top           {dotl}
  2606        c(136):resln = resln+1;              ->top           {dotr}
  2607        c(55): op('r', resln);    resln = 0; ->top           {resop}
  2608        c(164):op('r', resln+4);  resln = 0                  {cresop}
  2609        c(122):x = 6;                        ->cop           {%PRED}
  2610        c(87): set const(pstack(1))                          {mass}
  2611               bp=bp+1;  buff(bp)='P';       ->top
  2612           %end
  2613        
  2614        %end                                       {of compile block}
  2615        
  2616           %on 0 %start                            {stop}
  2617              No Faults = Faulty+1
  2618              ->Stop it
  2619           %finish
  2620        
  2621           {%ownrecord(Includefm)%name} Includefm Type == 0
  2622           {%ownrecord(Includefm)%name} Including == 0
  2623        
  2624           {%string(255)} Include file = ""
  2625        
  2626        
  2627           list = 15 %and Quiet = 1 %if Options&LL List   = 0
  2628           Tty  =  1                %if Options&LL Report = 0
  2629        
  2630           select output(listing)
  2631        
  2632           %if Options&LL Predef = 0 %start        {no perdefinition file}
  2633              Select Input(Source)
  2634              Perm = 0
  2635              List = List-1
  2636           %else
  2637              Select Input(2)
  2638           %finish
  2639        
  2640           tag(max tag) = 0                        {%BEGIN defn}
  2641           tag(0) = 0;  tag(0)_flags = 7           {%BEGIN tag!}
  2642           Hash(x) = 0 %for x = 0, 1, max names
  2643           op('l', 0)
  2644           compile block(0, 0, max dict, 0, 0)
  2645           bp=bp+1;  buff(bp)=nl                    {for bouncing off}
  2646           flush buffer
  2647           No Stats  = Stats
  2648           No Faults = Faulty
  2649           %if Options&LL Mon # 0 %start
  2650              Select Output(0)
  2651              printstring("Tags: ");  write(Tag Lower, 0);  write(Tmin, 1);  newline
  2652              printstring("Dict: ");  write(Dmax, 0);  write(Dict Upper, 1);  newline
  2653              printstring("Gram: ");  write(Gmax, 0);  write(Gmin, 1);  newline
  2654           %finish
  2655        
  2656        Stop It:
  2657        %end
  2658        %endoffile

  2658 LINES ANALYSED   SIZE= 118064

** Unassigned variable **

Entered from line 7110 of routine/fn/map brectrip starting at line 7098

Local variables
opern      = 180
optype     = 81
flags      = 32768      (X'00008000')
opnd1      = Record(x'00810051 00000003 81818181 00000000 00000007 81818181')
opnd2      = Record(x'00000051 00000E0F 00000000 00000001 00000005 00000000')
cell       = 24
test       = 3
currt      = Invalid Address 401413E8


Diagnostics Entered from line 3751 of routine/fn/map cui starting at line 3614

Local variables
code       = 1
pt         =-2122219135      (X'81818181')
marker     =-2122219135      (X'81818181')
j          = 14
lname      =-2122219135      (X'81818181')
typep      =-2122219135      (X'81818181')
precp      =-2122219135      (X'81818181')
alt        = 7
kk         = 0
opnd1      = Record(x'00810051 00000003 81818181 00000000 00000007 81818181')
head1      = 0
bot1       = 0
nops       = 2
rpop       = Record(x'83000000 00000000 00000000 00000002 00000000 00000000')


Entered from line 3839 of routine/fn/map cifthen starting at line 3763

Local variables
markiu     = 1
markc      = 31045      (X'00007945')
markui     = 31022      (X'0000792E')
marke      = 0
markr      = 0
skip       = 0
altui      = 7
ccres      = 0
elres      =-2122219135      (X'81818181')
thenlab    = 29982      (X'0000751E')
elselab    = 0
userlab    =-1
report     = 0
start      = 0
elsealt    =-2122219135      (X'81818181')
k          =-2122219135      (X'81818181')
j          =-2122219135      (X'81818181')
cs         = 0
linetrip   = 20


Entered from line  794 of routine/fn/map css starting at line 698

Local variables
pinit      = 31019      (X'0000792B')
p          = 31043      (X'00007943')
sndisp     = 0
acc        = 4
k          = 440      (X'000001B8')
kform      = 0
stname     =-2122219135      (X'81818181')
midcell    = 262144      (X'00040000')
tcell      = 12031      (X'00002EFF')
jj         =-2122219135      (X'81818181')
jjj        =-2122219135      (X'81818181')
kk         =-2122219135      (X'81818181')
qq         =-2122219135      (X'81818181')
marker     = 31043      (X'00007943')
reportui   = 0
xdisp      =-2147483648      (X'80000000')
mask       = 136
base       = 0
area       =-2122219135      (X'81818181')
access     = 0
disp       = 440      (X'000001B8')
extrn      =-2122219135      (X'81818181')
currinst   = 0
value      =-2122219135      (X'81818181')
stringl    =-2122219135      (X'81818181')
ptype      = 81
i          = 0
j          = 0
oldi       = 2
usebits    = 2
strfnres   =-2122219135      (X'81818181')
markiu     = 31044      (X'00007944')
markui     = 31022      (X'0000792E')
markc      = 31045      (X'00007945')
marke      = 0
markr      = 0
inaformat  = 0
litl       = 0
rout       = 0
nam        = 0
arr        = 0
prec       = 5
type       = 1
expopnd    = Record(x'00000051 00000E0F 00000000 00000001 00000005 00000000')
nameopnd   = Record(x'02000051 00000091 80000000 00000051 00000E0F 00000000')
mlopnd     = Record(x'00000000 00000000 00000000 02000051 00000091 80000000')


Entered from line  693 of routine/fn/map compileastm starting at line 685

Local variables
i          = 31014      (X'00007926')


Entered from line  655 of Block starting at line 594

Local variables
currinf    = Invalid Address 40279190
twsphead   = 0
forcnt     = 2
fordpth    = 0
forcecnt   = 26

Entered from line  655 of routine/fn/map icl9cezdrsi starting at line 10

Local variables
i          = 31
k          = 256      (X'00000100')
dummyformat= 12285      (X'00002FFD')
p1size     = 118064      (X'0001CD30')
starsize   = 60
asl        = 11968      (X'00002EC0')
arsize     = 785364      (X'000BFBD4')
oldline    = 0
nextp      = 31074      (X'00007962')
snum       = 0
rlevel     = 2
nmax       = 32
plabel     = 29982      (X'0000751E')
level      = 3
profaad    =-2122219135      (X'81818181')
lastinst   = 0
line       = 339      (X'00000153')
n          = 304      (X'00000130')
bfflag     = 0
rbase      = 2
q          = 29255      (X'00007247')
r          = 118064      (X'0001CD30')
fname      = 2290      (X'000008F2')
stmts      = 311      (X'00000137')
filesize   = 91940      (X'00016724')
bimstr     = 0
maxulab    = 20479      (X'00004FFF')
sflabel    = 20989      (X'000051FD')
nexttrip   = 25
sstl       = 4824      (X'000012D8')
ustptr     = 7460      (X'00001D24')
mainep     = "s#go"
parm       = Record(x'018B0076 00000100 00000002 01000000 00000000 02010000')
worka      = Record(x'00000FFF 0003FE00 00000000 00002FFD 00002D0D 00000062')

No Global variables


Entered from line 2554 of routine/fn/map compile starting at line 2519

Local variables
argc       = 4
argv       =-1073744028      (X'BFFFF764')
s          = CONTAINS UNPRINTABLE CHARS
i          =-2122219135      (X'81818181')

Global variables
rcsid      = "$What: <@(#) ftncomp.i,v 63.0> $"
copyright  = " Copyright (c) 1987, 1989 Edinburgh Portable Compilers Ltd. All Rights Reserved."
dwarfversio= "EPC Fortran77 (88000) 2.6.6"
xoptimiseop= 0
poptimiseop= 0
unasscheck = 0
srclink    = 135540608      (X'08142F80')
workad     = 1075056648      (X'40141008')
srcid      = 4
srcsize    = 24147      (X'00005E53')
targetvaria= 7
cgoptions  = 16778752      (X'01000600')
botraceopti= 0
boinhibopti= 0
gisproc    = 0
gisfraglow = 0
gisfraghigh= 0
gisbuffzone= 0
gisfullopt = 0
gistrace   = 0
gisinhib   = 0
rangeregion=-1
syntaxcheck= 0
monopt     = 0
mmon       = 0
adcstr     = 135424816      (X'08126B30')
includedir = ""
includepath= ""
f77parm    =-2147482857      (X'80000317')
control    = 2
options1   = 0
options2   = 0
srcflags   = 0
optflags   = 0
liststream =-1
diagstream = 2
consolestre= 0


End of diagnostics


Program stopped
