DataMuseum.dk

top - metrics - download

    Length: 5376 (0x1500)
    Types: TextFile
    Names: »dumptables  «

└─⟦01e83a425⟧ Bits:30008166 Bånd med SW8010 og SW8500 source code
    └─⟦75ff9bef3⟧ 
        └─⟦this⟧ »dumptables  « 

TextFile

job bbj 3 1 time 2 0
(p=algol
p
finis)
begin

  integer
   symbmax,          <* the no of different symbols *>
   prodmax,          <* no of productions *>
   lrmax,            <* size of lr-tables *>
   lxmax,            <* size of lexical tables *>
   errorval,         <*     *>
   nameval,          <* internal value of name *>
   constval,         <*    -        -   - const *>
   stringval,        <*    -        -   - string *>
   stringch,         <* stringescape char *>
   lexical1,entry1,lr1;<* local variables to avoid testoutput *>
   zone parsetables(128,1,stderror);
   integer field f2,f4,f6,f8,f10,f12,f14,f16,f18;

  f2:=2; f4:=4; f6:=6; f8:=8; f10:=10; f12:=12; f14:=14; f16:=16; f18:=18;
  open(parsetables,4,<:parsetables:>,0);
  inrec6(parsetables,18);
  symbmax:=parsetables.f2; prodmax:=parsetables.f4;
  lrmax:=parsetables.f6; lxmax:=parsetables.f8;
  errorval:=parsetables.f10; nameval:=parsetables.f12;
  constval:=parsetables.f14; stringval:=parsetables.f16;
  stringch:=parsetables.f18;

  begin
    integer array lrchain,lrnext,lr(0:lrmax);
            <* lr(.) bit 0 - 2 kind
                     bit 3 - 11 symb/rs
                     bit 12 - 23 lb/prd (if kind=5 then this field is 0)
             *>
    integer  kind, symb, err,  lb;
    boolean newline;
    integer stacktop, newtop;
    integer array entry(1:4,32:127);
                  <* entry(1,.) - np (0:lxmax)
                     entry(2,.) - hp (    -   )
                     entry(3,.) - tv (0:symbmax)
                     entry(4,.) - ch4 ( charvalue )
                  *>
    integer np,tv,hp,ch4;
    integer array lx(1:4,0:lxmax);     <* lexical tables *>
    integer no,stringescape;
  

    procedure dumplr;
    begin integer i,j;
      write(out,newline,1,<:   i chain  next kind  symb prod :>,newline,1);
      for i:=0 step 1 until lrmax do
      begin
        kind := lr(i) extract 3;
        write(out,<<dddd>,i,<<ddddd>,lrchain(i),lrnext(i),kind);
        if kind=5 then lb := lr(i) shift (-3)
                  else begin symb:=(lr(i) shift (-3)) extract 9;
                         err :=lr(i) shift (-12)
                       end;
        if kind=5 then write(out,<<ddddd>,lb) else write(out,<<ddddd>,symb,err);
        write(out,newline,1);
      end for i;
    end proc dumplr;

    procedure initialize;
    <* variables and tables are initialized in this routine *>
    begin
      integer  i,  j;
     
      <* initialization only concerning the algol 6 version : *>
      np := 1; hp := no := 2; ch4 := 4; tv := 3;
      newline := false add 10;
      for i:=32 step 1 until 127 do entry(1,i) :=-1;
  
      for i:=1 step 1 until 63 do
      begin
        inrec6(parsetables,8);
        j:=parsetables.f2; 
        if (j>64) and (j<94) then j:=j+32;
        entry(ch4,j):=j;
        entry(np,j):=parsetables.f4; entry(hp,j):=parsetables.f6;
        entry(tv,j):=parsetables.f8;
      end init entry;
      write(out,newline,1,symbmax,prodmax,lrmax,lxmax,errorval,
            nameval,constval,stringval,newline,1);
        write(out,false add 13,1);
        write(out,newline,2,<: --- entry --- :>,newline,2);
        for i:=32 step 1 until 127 do
        if entry(1,i) <>-1 then 
        begin write(out,<<ddd>,i,<: :>); outchar(out,entry(ch4,i));
          write(out,<: :>,entry(np,i),entry(hp,i),entry(tv,i),newline,1);
        end;

      for i:=0 step 1 until lxmax do
      begin inrec6(parsetables,8);
        j:=parsetables.f2;
        if (j>64) and (j<94) then lx(ch4,i):=j+32 else lx(ch4,i):=j;
        lx(np,i):=parsetables.f4;
        lx(hp,i):=parsetables.f6; lx(tv,i):=parsetables.f8;
      end;
        write(out,newline,2,<: --- lexical --- :>,newline,2);
        for i:= 0 step 1 until lxmax do
        begin write(out,<<ddd>,i,<: :>); outchar(out,lx(ch4,i));
          write(out,lx(np,i),lx(hp,i),lx(tv,i),newline,1);
        end;

      if stringch=32 then <* string facility not used *>
                          stringescape := -2
                     else stringescape := entry(tv,stringch);
      write(out,newline,2,<: stringescape :>,stringescape,newline,1);

      for i:=0 step 1 until lrmax do
      begin
        inrec6(parsetables,8);
        lrchain(i):=parsetables.f2; lrnext(i):=parsetables.f4;
        kind:=parsetables.f6; symb:=parsetables.f8;
        if kind<>5 then
        begin inrec6(parsetables,2); err:=parsetables.f2;
        end;
        if kind = 5 then lr(i) := (symb shift 3) add 5
                    else lr(i) := (err shift 12) add (symb shift 3) add kind;
      end for lr;
      close(parsetables,true);
        write(out,newline,2,<: --- lr --- :>,newline,2);
        dumplr;
        write(out,newline,2);
    end proc initialize;
   initialize;
  end;
end
▶EOF◀