Simtel MSDOS 1992 June/SIMTEL_0692.cdr/msdos/pascal/qparser.arc/SKELRTBL.PAS

Pascal/Delphi Source File | 1985-08-16 | 5.1 KB | 167 lines

    { SKELRTBL:  Parser table reading procedures for skeleton files,
                 version 3. }
    { Copyright (C) 1984 by QCAD Systems Inc., All Rights Reserved. }

    const TBL_VERSION = 23;  { table file version 2.3 }
    var TFILEX:  int;  { the 'next' value in tfile (lookahead) }
        FILE_ID:  string[80];  { table file identification string }
        ERRWORD:  int;  { error location in table file }

    {................}
    procedure TNEXT;
      { grab the 'next' value in the tfile }
    begin
      errword := errword + 1;
      read(tfile, tfilex)
    end;

    {................}
    function NEXT_VALUE:  int;
      { read the 'next' value from tfile }
    begin
      next_value := tfilex;
      tnext
    end;

    {................}
    procedure VERIFY(VALUE:  int);
      { squawk if the next thing in tfile is not equal to value. }
    var s: string[10];
    begin
      if tfilex = value then
        tnext
      else begin
        str(errword, s);
        abort('Initialization error for table file '+file_id+' at word '+s)
        end
    end;

    {................}
    function READ_STRING:  string80;
      { grabs a null-terminated string from the file.  Characters are
        packed two to the word.  If there are an odd number of chars
        in the string, then the pad char is a null.
        A full word of zeros is required to terminate the
        string.  Only the first eighty characters are kept. }
      var STR:  string80;

    {. . . . . . . .}
    function LOBYTE(VAL: int): byte;
      var REC: record case boolean of
                true: (IVAL: int);
                false: (BVAL: packed array [0..1] of byte);
                end;
    begin
      with rec do begin
        ival:=val;
        lobyte:=bval[1];
        end
      end;

    {. . . . . . . .}
    function HIBYTE(VAL: int): byte;
      var REC: record case boolean of
                true: (IVAL: int);
                false: (BVAL: packed array [0..1] of byte);
                end;
    begin
      with rec do begin
        ival:=val;
        hibyte:=bval[0];
        end
      end;

    begin   { read_string }
      str:='';
      while (tfilex <> 0) do begin
        { first, handle the "high" order byte. }
        if length(str) < 80 then begin
          str:=str+' ';
          str[length(str)] := chr(hibyte(tfilex))
          end;
        { next, take care of the "low" order byte. }
        if length(str) >= 80 then
          tnext  { too many chars; just read the next word }
        else begin
          if lobyte(tfilex)>0 then begin
            str:=str+' ';
            str[length(str)] := chr(lobyte(tfilex));
            end;
          tnext
          end
        end;
      tnext;  { skip the terminating null word }
      read_string := str
      end;

    {................}
    procedure READ_HEADER;
      { grabs the file id (which is mostly for debugging) and then
        verifies that the tables are right ones (or at least of the
        right size). }
    begin
      errword := -1;  { initialize }
      tnext;  { fill the tfile lookahead pipe }
      file_id := read_string;
      { Validate the file.  The first number verified is the table
        file version number which this skeleton file can handle. }
      verify(tbl_version);
      { OK, if that worked, then we can grab the data. }
      verify(maxstate);   verify(reducelen);
      verify(sstokens);   verify(rltokens);
      verify(lookstate);  verify(prodtoks);
      verify(all_toks)
    end;

    {................}
    procedure READ_TABLE_FILE;
      { read the non-debugging portion of the table file }
      var INDEX:  int;

      {. . . . . . . . .}
      procedure GETSYM;
        { grabs a symbol from tfile and defines it as a reserved word }
        var
          NAME:  string80;  { the symbol name in string format. }
          TSYM:  symbol;  { ditto, in symbol format. }
          SYMP:  symtabp;  { the new symbol. }
          I:  byte;  { name copying index. }
      begin
        fillchar(tsym, maxtoklen, ' ');
        name := read_string;
        for i := 1 to length(name) do
          tsym[i] := name[i];
        symp := makesym(tsym, reserved, -1);
        symp^.tokval := next_value
      end;

    begin { read_table_file }
      { read the goodies }
      while tfilex <> -1 do
        getsym;
      verify(-1);
      for index := 1 to maxstate do
        statex[index] := next_value;
      verify(-1);
      for index := 1 to reducelen do
        map[index] := next_value;
      verify(-1);
      for index := 1 to reducelen do
        popno[index] := next_value;
      verify(-1);
      for index := 0 to sstokens do
        stk_state[index] := next_value;
      verify(-1);
      for index := 0 to sstokens do
        stk_tostate[index] := next_value;
      verify(-1);
      for index := 0 to rltokens do
        toknum[index] := next_value;
      verify(-1);
      for index := 0 to rltokens do
        tostate[index] := next_value;
      verify(-1)
      { that's all for the non-debugging information }
    end { read_table_file };