automat.pas

This is Pascal compiler

   275  
   276      gattr: attr;                    (*describes the expr currently compiled*)
   277  
   278  
   279                                      (*structured constants:*)
   280                                      (***********************)
   281  
   282      constbegsys,simptypebegsys,typebegsys,blockbegsys,selectsys,facbegsys,
   283      statbegsys,typedels: setofsys;
   284      chartp : array[char] of chtp;
   285      rw:  array [1..35(*nr. of res. words*)] of alpha;
   286      frw: array [1..9] of 1..36(*nr. of res. words + 1*);
   287      rsy: array [1..35(*nr. of res. words*)] of symbol;
   288      ssy: array [char] of symbol;
   289      rop: array [1..35(*nr. of res. words*)] of operator;
   290      sop: array [char] of operator;
   291      na:  array [1..35] of alpha;
   292      mn:  array [0..60] of packed array [1..4] of char;
   293      sna: array [1..23] of packed array [1..4] of char;
   294      cdx: array [0..60] of -4..+4;
   295      pdx: array [1..23] of -7..+7;
   296      ordint: array [char] of integer;
   297  
   298      intlabel,mxint10,digmax: integer;
   299  (*-------------------------------------------------------------------------*)
   300    procedure mark(var p: marktype); begin end;
   301    procedure release(p: marktype); begin end;
   302  
   303    procedure endofline;
   304      var lastpos,freepos,currpos,currnmr,f,k: integer;
   305    begin
   306      if errinx > 0 then   (*output error messages*)
   307        begin write(output,linecount:6,' ****  ':9);
   308          lastpos := 0; freepos := 1;
   309          for k := 1 to errinx do
   310            begin
   311              with errlist[k] do
   312                begin currpos := pos; currnmr := nmr end;
   313              if currpos = lastpos then write(output,',')
   314              else
   315                begin
   316                  while freepos < currpos do
   317                    begin write(output,' '); freepos := freepos + 1 end;
   318                  write(output,'^');
   319                  lastpos := currpos
   320                end;
   321              if currnmr < 10 then f := 1
   322              else if currnmr < 100 then f := 2
   323                else f := 3;
   324              write(output,currnmr:f);
   325              freepos := freepos + f + 1
   326            end;
   327          writeln(output); errinx := 0
   328        end;
   329      linecount := linecount + 1;
   330      if list and (not eof(input)) then
   331        begin write(output,linecount:6,'  ':2);
   332          if dp then write(output,lc:7) else write(output,ic:7);
   333          write(output,' ')
   334        end;
   335      chcnt := 0
   336    end  (*endofline*) ;
   337  
   338    procedure error(ferrnr: integer);
   339    begin
   340      if errinx >= 9 then
   341        begin errlist[10].nmr := 255; errinx := 10 end
   342      else
   343        begin errinx := errinx + 1;
   344          errlist[errinx].nmr := ferrnr
   345        end;
   346      errlist[errinx].pos := chcnt
   347    end (*error*) ;
   348  
   349    procedure insymbol;
   350      (*read next basic symbol of source program and return its
   351      description in the global variables sy, op, id, val and lgth*)
   352      label 1,2,3;
   353      var i,k: integer;
   354          digit: packed array [1..strglgth] of char;
   355          string: packed array [1..strglgth] of char;
   356          lvp: csp; test: boolean;
   357  
   358      procedure nextch;
   359      begin if eol then
   360        begin if list then writeln(output); endofline
   361        end;
   362        if not eof(input) then
   363         begin eol := eoln(input); read(input,ch);
   364          if list then write(output,ch);
   365          chcnt := chcnt + 1
   366         end
   367        else
   368          begin writeln(output,'   *** eof ','encountered');
   369            test := false
   370          end
   371      end;
   372  
   373      procedure options;
   374      begin
   375        repeat nextch;
   376          if ch <> '*' then
   377            begin
   378              if ch = 't' then
   379                begin nextch; prtables := ch = '+' end
   380              else
   381                if ch = 'l' then
   382                  begin nextch; list := ch = '+';
   383                    if not list then writeln(output)
   384                  end
   385                else
   386               if ch = 'd' then
   387                 begin nextch; debug := ch = '+' end
   388               else
   389                  if ch = 'c' then
   390                    begin nextch; prcode := ch = '+' end;
   391              nextch
   392            end
   393        until ch <> ','
   394      end (*options*) ;
   395  
   396    begin (*insymbol*)
   397    1:
   398      repeat while ((ch = ' ') or (ch = '	' (*tab*))) and not eol do nextch;
   399        test := eol;
   400        if test then nextch
   401      until not test;
   402      if chartp[ch] = illegal then
   403        begin sy := othersy; op := noop;
   404          error(399); nextch
   405        end
   406      else
   407      case chartp[ch] of
   408        letter:
   409          begin k := 0;
   410            repeat
   411              if k < 8 then
   412               begin k := k + 1; id[k] := ch end ;
   413              nextch
   414            until chartp[ch] in [special,illegal,chstrquo,chcolon,
   415                                  chperiod,chlt,chgt,chlparen,chspace];
   416            if k >= kk then kk := k
   417            else
   418              repeat id[kk] := ' '; kk := kk - 1
   419              until kk = k;
   420            for i := frw[k] to frw[k+1] - 1 do
   421              if rw[i] = id then
   422                begin sy := rsy[i]; op := rop[i]; goto 2 end;
   423              sy := ident; op := noop;
   424    2:    end;
   425        number:
   426          begin op := noop; i := 0;
   427            repeat i := i+1; if i<= digmax then digit[i] := ch; nextch
   428            until chartp[ch] <> number;
   429            if ((ch = '.') and (input^ <> '.')) or (ch = 'e') then
   430              begin
   431                    k := i;
   432                    if ch = '.' then
   433                      begin k := k+1; if k <= digmax then digit[k] := ch;
   434                        nextch; (*if ch = '.' then begin ch := ':'; goto 3 end;*)
   435                        if chartp[ch] <> number then error(201)
   436                        else
   437                          repeat k := k + 1;
   438                            if k <= digmax then digit[k] := ch; nextch
   439                          until chartp[ch] <>  number
   440                      end;
   441                    if ch = 'e' then
   442                      begin k := k+1; if k <= digmax then digit[k] := ch;
   443                        nextch;
   444                        if (ch = '+') or (ch ='-') then
   445                          begin k := k+1; if k <= digmax then digit[k] := ch;
   446                            nextch
   447                          end;
   448                        if chartp[ch] <> number then error(201)
   449                        else
   450                          repeat k := k+1;
   451                            if k <= digmax then digit[k] := ch; nextch
   452                          until chartp[ch] <> number
   453                       end;
   454                     new(lvp,reel); sy:= realconst; lvp^.cclass := reel;
   455                     with lvp^ do
   456                       begin for i := 1 to strglgth do rval[i] := ' ';
   457                         if k <= digmax then
   458                           for i := 2 to k + 1 do rval[i] := digit[i-1]
   459                         else begin error(203); rval[2] := '0';
   460                                rval[3] := '.'; rval[4] := '0'
   461                              end
   462                       end;
   463                     val.valp := lvp
   464              end
   465            else
   466    3:    begin
   467                if i > digmax then begin error(203); val.ival := 0 end
   468                else
   469                  with val do
   470                    begin ival := 0;
   471                      for k := 1 to i do
   472                        begin
   473                          if ival <= mxint10 then
   474                            ival := ival*10+ordint[digit[k]]
   475                          else begin error(203); ival := 0 end
   476                        end;
   477                      sy := intconst
   478                    end
   479              end
   480          end;
   481        chstrquo:
   482          begin lgth := 0; sy := stringconst;  op := noop;
   483            repeat
   484              repeat nextch; lgth := lgth + 1;
   485                     if lgth <= strglgth then string[lgth] := ch
   486              until (eol) or (ch = '''');
   487              if eol then error(202) else nextch
   488            until ch <> '''';
   489            lgth := lgth - 1;   (*now lgth = nr of chars in string*)
   490            if lgth = 0 then error(205) else
   491            if lgth = 1 then val.ival := ord(string[1])
   492            else
   493              begin new(lvp,strg); lvp^.cclass:=strg;
   494                if lgth > strglgth then
   495                  begin error(399); lgth := strglgth end;
   496                with lvp^ do
   497                  begin slgth := lgth;
   498                    for i := 1 to lgth do sval[i] := string[i]
   499                  end;
   500                val.valp := lvp
   501              end
   502          end;
   503        chcolon:
   504          begin op := noop; nextch;
   505            if ch = '=' then
   506              begin sy := becomes; nextch end
   507            else sy := colon
   508          end;
   509        chperiod:
   510          begin op := noop; nextch;
   511            if ch = '.' then
   512              begin sy := colon; nextch end
   513            else sy := period
   514          end;
   515        chlt:
   516          begin nextch; sy := relop;
   517            if ch = '=' then
   518              begin op := leop; nextch end
   519            else
   520              if ch = '>' then
   521                begin op := neop; nextch end
   522              else op := ltop
   523          end;
   524        chgt:
   525          begin nextch; sy := relop;
   526            if ch = '=' then
   527              begin op := geop; nextch end
   528            else op := gtop
   529          end;
   530        chlparen:
   531         begin nextch;
   532           if ch = '*' then
   533             begin nextch;
   534               if ch = '$' then options;
   535               repeat
   536                 while (ch <> '*') and not eof(input) do nextch;
   537                 nextch
   538               until (ch = ')') or eof(input);
   539               nextch; goto 1
   540             end;
   541           sy := lparent; op := noop
   542         end;
   543        special:
   544          begin sy := ssy[ch]; op := sop[ch];
   545            nextch
   546          end;
   547        chspace: sy := othersy
   548      end (*case*)