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

Pascal/Delphi Source File | 1985-07-26 | 28.3 KB | 918 lines

{ Copyright (C) 1984 by QCAD Systems, Inc., All Rights Reserved. }

{#P -- program line goes here }
program #(input, output);

  { Calcskel:

    This is the skeleton file for a four-function calculator run
    by an LALR(1) table-driven parser.  It is based on LR1SKEL, but
    doesn't have all the file opening options, and doesn't use
    a report file. }

  const
    STACKSIZE = 60;   { maximum size of LR(1) parser stack }
    EOS = 0;          { marks end of line in LINE }
    EOFCH = 26;       { reader end-of-file character }
    EOLCH = 12;       { end of line character }
    LINELEN = 80;     { maximum length of a line }
    STRTABLEN = 500;  { maximum number of chars in string table }
    STRING_QUOTE = '''';  { character delimiting quoted strings }
    MAXERRORS = 20;   { maximum errors before aborting }
    HASHSIZE = 67;    { hash table size -- prime number! }
    HLIMIT = 66;      { limit in hash table (hashsize minus one) }
    MAXTOKLEN = 15;   { length of a token or symbol }

{#C -- constants defined by the parser generator go here }
    IDENT_TOKLEN = #C;  { maximum user identifier length }
    MAXRPLEN = #D;    { length of longest production right part }
    TERM_TOKS = #E;   { number of terminal tokens }
    NTERM_TOKS = #F;  { number of nonterminal tokens }
    ALL_TOKS = #G;    { term_toks + nterm_toks }
    IDENT_TOKX = #H;  { token number of <identifier> }
    INT_TOKX = #I;    { token number of <integer> }
    REAL_TOKX = #J;   { token number of <real> }
    STR_TOKX = #K;    { token number of <string> }
    STOP_TOKX = #L;   { token number of stopsign (end-of-file) }
    GOAL_TOKX = #M;   { token number of goal }
    EOL_TOKX = #N;    { token number of end-of-line }
    READSTATE = #O;   { first READ state }
    LOOKSTATE = #P;   { first LOOK state }
    MAXSTATE = #Q;    { largest state number }
    REDUCELEN = #R;   { number of productions }
    RLTOKENS = #S;
    SSTOKENS = #T;
    PRODTOKS = #U;
    TOKCHARS = #V;
    START_STATE = #W;  { initial state }
    STK_STATE_1 = #X;  { state initially pushed on stack }
{#> -- end of constants }
{#F -- form for FLAG constants }
    #N = #V;

  type
    INT = -32767..32767;
    STRING8 = string[8];
    STRING80 = string[80];
    TOKRANGE = 1..term_toks;
    {================== added operator for calcskel ==================}
    OPERATOR = int;  { same type as the flags }

    SYMBOL = packed array [1..maxtoklen] of char;
    {================ added real_variable for calcskel ===============}
    SYMTYPE = (RESERVED, SYMERR, USER, REAL_VARIABLE);
    SYMTABP = ^symtabtype;
    SYMTABTYPE = record
                   { structure for <identifier>s and keywords }
                   NEXT: symtabp;
                   LEVEL: int;
                   SYM: symbol;
                   case SYMT: symtype of
                     reserved: (TOKVAL: tokrange);
                     {=========== added for calcskel ==============}
                     real_variable: (RVAL:  real);
                 end;
    SYMTABNAMES = array [symtype] of string[8];
  const SYMTYPENAME: symtabnames =
                  ('reserved', 'symerr  ', 'user    ', 'real var');

  type
    SEMTYPE = (OTHER, IDENT, FIXED, FLOAT, STRNG);
    SEMRECP = ^semrec;
    SEMREC = record   { semantic stack structure }
               case SEMT: semtype of
                 ident: (SYMP: symtabp);
                 fixed: (NUMVAL: integer);  { fixed point }
                 float: (RVAL: real);   { floating point }
                 strng: (STX: int);  { position in strtab }
                 { Add more options as needed }
             end;
    SEMTABNAMES = array [semtype] of string[5];
  const SEMTYPENAME: semtabnames =
                  ('other', 'ident', 'fixed', 'float', 'strng');

  type
    STATE_STACK = array [0..stacksize] of int;
    { Types for parser tables.  NB:  These type names are used by
      the typed constant generation. }
    STATE_ARRAY = array [1..maxstate] of int;
    REDUCE_ARRAY = array [1..reducelen] of int;
    POP_ARRAY = array [1..reducelen] of byte;
    TOKEN_ARRAY = array [0..rltokens] of byte;
    TOSTATE_ARRAY = array [0..rltokens] of int;
    SS_ARRAY = array [0..sstokens] of int;
    PROD_ARRAY = array [1..prodtoks] of byte;
    TOKX_ARRAY = array [1..all_toks] of int;
    TOKCHAR_ARRAY = array [1..tokchars] of char;
    INSYM_ARRAY = array [1..lookstate] of int;

{#<C -- put typed constants here, if they've been requested }
  const
    { Static parser data structures (parser tables). }
{#IP}
{#>}

  var
    { Dynamic parser data structures }
    STACK:  state_stack;  { the LR(1) state stack }
    SEMSTACK:  array [0..stacksize] of semrecp;  { semantics stack }
    STACKX:  int;  { index of top of stack }

{#<~C -- the following are redundant if typed constants are used }
    { Static parser data structures (parser tables). }
    STATEX:  state_array;    { stack top index }
    MAP:  reduce_array;      { mapping from state to apply numbers }
    POPNO:  pop_array;       { reduce pop size }
    TOKNUM:  token_array;    { token list }
    TOSTATE:  tostate_array;  { read, look states }
    STK_STATE:  ss_array;
    STK_TOSTATE: ss_array;
{#<D -- these are for parser stack dumps. }
    PRODX:  reduce_array;    { prod index into ... }
    PRODS:  prod_array;      { token number, index into ... }
    INSYM:  insym_array;
{#> -- end if for debugging. }
{#> -- end if for typed constants. }

{#<D -- debugging (these cannot be typed constants.) }
    { These guys are for printing tokens in parser stack dumps. }
    TOKX:  tokx_array;       { token index, index into ... }
    TOKCHAR:  tokchar_array;  { token characters }
{#> -- end if for debugging. }

    { Lexical and token data }
    LINE:  string[linelen];  { source line }
    LX:  int;                { index of next character in LINE }
    ERRPOS:int;              { current token position in LINE }
    PROMPT_LEN:int;          { number of prompt characters }
    CH:  char;               { next character from input file }
    TOKEN:  int;             { Next token in input list }
    LSEMP:  semrecp;         { current semantics assoc. with token }
    TOKENX:  int;            { index into TOKARY, LSEMPARY }
    TOKARY:  array [0..1] of int;  { token queue }
    LSEMPARY:  array [0..1] of semrecp;
    ERRSYM:  symbol;        { special symbol reserved for errors }
    { The next table can be omitted if real numbers are not used. }
    PWR10_2:  array [0..8] of real;  { Binary powers of ten. }

    { Symbol table data }
    SYMTAB: array [0..hlimit] of symtabp;
    STRTAB: packed array [0..strtablen] of char;
    STRTABX: int;

    SFILE, RFILE: text;      { source, report files }
    SFILENAME, RFILENAME: string80;  { source, report file name }
    TFILE: file of int;      { sometimes used for table inits }

    ERRORS: int;
    DEBUG: int;              { >0 turns on some tracing }

{ GENERAL UTILITIES }

  {*********************}
  function RESP(MSG: string80):  char;
    { print a message and return a single character response. }
    var CH: char;
  begin
    write(msg);
    read(kbd, ch);
    writeln(ch);
    resp := ch
  end;

  {*********************}
  function YESRESP (MSG: string80): boolean;
    { query with a Y or N reply }
    var CH: char;
  begin
    ch := resp(msg);
    yesresp := (ch='y') or (ch='Y');
  end;

  {******************}
  procedure MORE(MSG: string80);
    { print the string, and let the user type
      any character to proceed. }
    var FOO:  char;
  begin
    foo := resp(msg)
  end;

  {******************}
  procedure REPORT_ERR(MSG: string80);
  begin
    if errpos+prompt_len>1 then
      write(rfile, ' ':errpos+prompt_len-1);
    writeln(rfile, '^');  { mark error point }
    writeln(rfile, 'ERROR: ', msg);
    errors := errors+1;
  end;

  {*******************}
  procedure ABORT(MSG: string80);
  begin
    report_err(msg);
    while true do more('FATAL -- PLEASE ABORT:')
  end;

  {******************}
  procedure ERROR(MSG: string80);
  begin
    report_err(msg);
    if errors>maxerrors then abort('Error limit exceeded');
    more('Type any character to continue:')
  end;

  {*****************}
  function UPSHIFT(CH: char): char;
  begin
    if (ch>='a') and (ch<='z') then
      upshift := chr(ord(ch) - ord('a') + ord('A'))
    else
      upshift := ch
  end;

  {$I skelsyms.pas}

{#<D -- debugging utilities. }
  {=========== changed for calcskel ==============}
  {$I calcdbug.pas}

{#> -- end debugging stuff. }
{ LEXICAL ANALYZER }

  {*******************}
  procedure GETLINE;
    { read the next source line, when nextch exhausts
      the current one. }

    {.............}
    procedure GENEOF;
    begin
      line := chr(eofch);
      lx := 1
    end;

    {............}
    procedure GRABLINE;
      var TX: int;
    begin
      readln(sfile, line);
      {======================== not needed in calcskel ===============}
      { writeln(rfile, line); }
      lx := 1
    end;

  begin { getline }
    if sfilename='' then begin
      { prompt if from the console file }
      write('> ');
      grabline;
      if line = 'EOF' then geneof
      end
    else if eof(sfile) then
      geneof
    else
      grabline;
{#<E -- the line ending gets treated differently here. }
    { The appended blank allows a reduction containing <EOL> to take
      place before reading another line.  This behavior is essential
      for interactive systems, and makes no difference in batch. }
    line := line+chr(eolch)+' '
{#: -- case where <EOL> is not significant. }
    { The appended eol character ensures that tokens are broken over
      line endings; they would otherwise be invisible to the scanner.
      eolch allows the string scanner to distinguish ends of lines. }
    line := line+chr(eolch)
{#> -- end of eol business. }
  end;

  {*******************}
  procedure NEXTCH;
    { gets next character from line }
  begin
    if lx > length(line) then
      getline;
    ch := line[lx];
    { don't move past an eof mark }
    if ch <> chr(eofch) then lx := lx+1
  end;

{#<~E -- Pick a blank skipper, depending on appearance of <eol> }
  {********************}
  procedure SKIPBLANKS;  { when <eol> has NOT appeared }
    { This considers left brace as an open comment and right brace
      as a close-comment; comments may run over multiple lines. }
  begin
    repeat
      while ch = ' ' do nextch;
      if ch='{' then begin  { open a comment }
        while (ch <> '}') and (ch <> chr(eofch)) do nextch;
        if ch=chr(eofch) then
          error('unclosed comment')
        else
          nextch
      end
    until ch <> ' '
  end;

{#: -- the second choice}
  {********************}
  procedure SKIPBLANKS;  { when <eol> HAS appeared }
    { This version of skipblanks treats everything from OC to the
      end of a line as a comment. }
    const OC= ';';
  begin
    while ch=' ' do nextch;
    if ch=oc then while ch<>chr(eolch) do nextch
  end;

{#> -- end of the selection}
  {********************}
  procedure PUTSTRCH(CH: char);
  begin
    if strtabx>strtablen then
      abort('String table overflow ... please abort');
    strtab[strtabx] := ch;
    strtabx := strtabx+1;
  end;

  {******************}
  procedure PUTSTR(STR: string80);
    var SX: int;
  begin
    for sx := 1 to length(str) do putstrch(str[sx]);
    putstrch(chr(eos));
  end;

  {****************}
  procedure GET_SYMBOL;
    var SX: int;
        SYM: symbol;
        STP: symtabp;
  begin
    fillchar(sym, maxtoklen, ' ');
    sx := 1;
    { keep snarfing alphanumeric characters.  up to the first
      maxtoklen of them will be put in the symbol spelling. }
    while ((ch>='a') and (ch<='z')) or
          ((ch>='A') and (ch<='Z')) or
          ((ch>='0') and (ch<='9')) or
          (ch='_') do begin
      if sx <= maxtoklen then
        sym[sx] := upshift(ch);
      sx := sx+1;
      nextch;
    end;
    stp := makesym(sym, user, 0);  { the default level is 0 }
    with lsemp^ do begin
      if stp^.symt=reserved then begin
        { a reserved keyword }
        semt := other;
        token := stp^.tokval;
      end
      else begin
        semt := ident;
        symp := stp;
        token := ident_tokx;
      end
    end
  end;

  {$I skelnum.pas}   { Number scanning }

  {*****************}
  procedure GET_STRING;
    { Scans a string, putting it into the string table, and setting
      up the semantic record for it correctly.  Removing the "and
      (ch <> chr(eolch))" clause in the WHILE loop below will allow
      strings to run over the end of a line by storing embedded
      eolch's.  However, this could have unpleasant consequences for
      languages with <eol> in the grammar.  See the comments at the
      end of getline. }
    var END_OF_STRING:  boolean;
  begin
    nextch;  { get past the first quote mark }
    lsemp^.semt := strng;
    lsemp^.stx := strtabx;
    repeat
      while (ch <> chr(eofch)) and (ch <> chr(eolch))
            and (ch <> string_quote) do begin
        putstrch(ch);
        nextch
      end;
      end_of_string := true;
      { peek ahead a bit to see if there's a doubled quote }
      if ch = string_quote then begin
        nextch;
        if ch = string_quote then begin
          end_of_string := false;
          putstrch(ch);
          nextch
        end
      end
      else if (ch = chr(eofch)) or (ch = chr(eolch)) then begin
        error('unterminated string')
      end
    until end_of_string;
    putstrch(chr(eos));
    token := str_tokx;
  end;

  {********************}
  procedure GET_TOKEN;
    { Pascal-style lexical analyzer -- sets TOKEN to token number }
  begin
    lsemp^.semt := other;  { default case }
    skipblanks;
    errpos:=lx-1;
    case ch of
      'a'..'z', 'A'..'Z': get_symbol;
      '0'..'9':           get_number;
      string_quote:       get_string;
{#<D -- if debugging, invoke idebug on a bang (or other char). }
      '!':  begin
              idebug;
              nextch;
              get_token
            end;
{#>}
{#G   special symbol cases go here }
      ELSE  begin
              if ch=chr(eofch) then
                token := stop_tokx
              else if ch=chr(eolch) then begin
                nextch;
{#<E            end-of-line token dealt with here }
                token := eol_tokx  { accept an end-of-line token }
{#:}
                get_token  { go find another (significant) character }
{#>}
              end
              else begin
                error('illegal character');
                nextch;
                get_token  { try again }
              end
            end { case alternatives }
    end { case }
  end { get_token };

  {*******************}
  procedure NEXT_TOKEN;
  begin
    if tokenx>1 then begin
      tokenx := 1;
      get_token;  { goes into token, lsemp }
      tokary[1] := token;
      lsempary[1] := lsemp;
    end
    else begin
      { is in tokary }
      token := tokary[tokenx];
      lsemp := lsempary[tokenx];
    end
  end;

  {*****************}
  procedure TOKENREAD;
  begin
    tokenx := tokenx+1;
  end;

  { LR(1) PARSER procedures }

  {======================= calculator semantics ======================}
  {$I calcutil.pas}        { utility routines }
  {$I calcsem.pas}         { the apply procedure }

  {****************}
  function ERROR_RECOVERY(var MSTACK: state_stack;
                          var MSTACKX: int; MCSTATE: int): int;
    label 99, 100;
    var STACK: state_stack;  { local copy of stack }
        STACKX,              { local stack pointer }
        CSTATE,              { local state }
        JSTX,                { temporary stack limit }
        RX, TL: int;         { index into TOKNUM table }

    {...............}
    procedure COPY_STACK;
      var STX: int;
    begin
      if (jstx<0) or (jstx>mstackx) then abort('ERROR RECOVERY BUG');
      for stx := 0 to jstx do
        stack[stx] := mstack[stx];
      stackx := jstx;
      if jstx=mstackx then
        cstate := mcstate
      else
        cstate := mstack[jstx+1];
    end;

    {...............}
    procedure PUSHREAD(CSTATE: int);
      { adjusts the state stack }
    begin
      stackx := stackx+1;
      if stackx>stacksize then
        abort('stack overflow');
      stack[stackx] := cstate;
    end;

    {...............}
    function TRIAL_PARSE: boolean;
      { parses from current read state through the inserted and the
        error token; if successful, returns TRUE. }
      label 99;
      var RX: int;
    begin
      trial_parse := true;  { until proven otherwise }
      while cstate<>0 do begin
        if cstate < readstate then begin
          { a reduce state }
{#<D      dump if debugging enabled. }
          if debug > 3 then stk_dump('E*Reduce', stack,
                                     stackx, cstate);
{#>       end conditional. }
          if popno[cstate]=0 then begin
            { empty production }
            pushread(stk_state[statex[cstate]]);
            cstate := stk_tostate[statex[cstate]];
          end
          else begin
            { non-empty production }
            stackx := stackx - popno[cstate] + 1;
            rx := statex[cstate];   { compute the GOTO state }
            cstate := stack[stackx];
            while (stk_state[rx]<>cstate) and
                  (stk_state[rx]<>0) do rx := rx+1;
            cstate := stk_tostate[rx];
          end
        end
        else if cstate < lookstate then begin
          { a read state }
          next_token;  { need a token now }
{#<D      dump if debugging enabled. }
          if debug > 3 then stk_dump('E*Read', stack, stackx, cstate);
{#>       end conditional. }
          rx := statex[cstate];
          while (toknum[rx]<>0) and
                (toknum[rx]<>token) do rx := rx+1;
          if toknum[rx]=0 then begin
            { failure }
            trial_parse := false;
            goto 99;
          end
          else begin
            { did read something }
            pushread(cstate);
            cstate := tostate[rx];
            tokenread;  { scan the token }
            if tokenx>1 then goto 99 { successful }
          end
        end
        else begin
          { lookahead state }
          next_token;  { need a token now }
{#<D      dump if debugging enabled. }
          if debug > 3 then stk_dump('E*Look', stack, stackx, cstate);
{#>       end conditional. }
          rx := statex[cstate];
          while (toknum[rx]<>0) and
                (toknum[rx]<>token) do rx := rx+1;
          cstate := tostate[rx];
        end
      end;
    99:
    end;

    {.................}
    procedure INCR_ERRSYM;
      { Note that this procedure assumes ASCII. }
    begin
      if errsym[6]='Z' then begin
        errsym[5] := succ(errsym[5]);
        errsym[6] := 'A';
      end
      else
        errsym[6] := succ(errsym[6]);
    end;

    {.................}
    procedure MAKE_DEFAULT(TOKX: int; SEMP: semrecp);
      { creates a default token data structure }
      var SYM: symbol;
    begin
      with semp^ do begin
        case tokx of
          int_tokx:
            begin
              semt := fixed;
              numval := 1;
            end;
          real_tokx:
            begin
              semt := float;
              rval := 1.0;
            end;
          ident_tokx:
            begin
              semt := ident;
              symp := makesym(errsym, symerr, 0);
              incr_errsym;
            end;
          str_tokx:
            begin
              semt := strng;
              stx := 0;  { default string at origin }
            end;
          ELSE
            semt := other;
        end { case tokx }
      end
    end;

  begin  { ERROR_RECOVERY }
    if debug > 3 then writeln(rfile, 'Going into ERROR RECOVERY');
    while true do begin
      jstx := mstackx;
      while jstx>=0 do begin
        copy_stack;
        rx := statex[cstate];
        while toknum[rx]<>0 do begin
          { scan through legal next tokens }
          if debug > 3 then writeln(rfile, '...starting trial parse');
          tokary[0] := toknum[rx];  { the insertion }
          tokenx := 0;
          if trial_parse then goto 99;  { it clicked! }
          rx := rx+1;
          if toknum[rx]<>0 then
            copy_stack;
        end;
        jstx := jstx-1;  { reduce stack }
      end;
      if token=stop_tokx then begin
        { empty stack, no more tokens }
        cstate := 0;  { halt state }
        tokenx := 2;
        jstx := 0;  { bottom of stack }
        goto 100;
      end;
{#<D}
      if debug > 3 then begin
        write(rfile, '...dropping token ');
        tl := wrtok(tokary[1]);
        writeln(rfile);
      end;
{#>}
      tokenx := 2;
      next_token;
{#<D}
      if debug > 3 then begin
        write(rfile, 'New token ');
        tl := wrtok(token);
        writeln(rfile);
      end
{#>}
    end;
  99:  { found a solution }
    copy_stack;
{#<D}
    if debug > 3 then begin
      write(rfile, 'insertion of ');
      tl := wrtok(tokary[0]);
      writeln(rfile, ' succeeded');
    end;
{#>}
    make_default(tokary[0], lsempary[0]);
    tokenx := 0;  { forces a `real' rescan of the insertion }
    if jstx<mstackx then
      cstate := stack[jstx+1]
    else
      cstate := mcstate;  { cstate returned }
  100:
    error_recovery := cstate;
    mstackx := jstx;
    if debug > 3 then writeln(rfile, 'Ending error recovery');
  end;

  {****************}
  procedure PARSER;
    { Carries out a complete parse, until
      the halt state is seen -- same as empty stack}
    var CSTATE, RX: int;
        TSEMP: semrecp;

    {...............}
    procedure PUSHREAD(CSTATE: int; SEMP: semrecp);
      { do the push part of a readstate. }
    begin
      stackx := stackx+1;
      if stackx>stacksize then
        abort('stack overflow');
      semstack[stackx]^ := semp^;
      stack[stackx] := cstate;
    end;

  begin
    cstate := start_state;
    stackx := -1;
    new(tsemp);
    tsemp^.semt := other;
    pushread(stk_state_1, tsemp);
    while cstate<>0 do begin
      if cstate < readstate then begin
        { a reduce state }
{#<D    dump if debugging enabled. }
        if debug > 0 then stk_dump('Reduce', stack, stackx, cstate);
{#>     end conditional. }
        if map[cstate] <> 0 then
          { the semantics action }
          apply(map[cstate], popno[cstate], tsemp);
        if popno[cstate]=0 then begin
          { empty production }
          pushread(stk_state[statex[cstate]], tsemp);
          cstate := stk_tostate[statex[cstate]];
        end
        else begin
          { non-empty production:
            semantics is preserved on a unit production A --> w,
            where |w| = 1, unless something is in TSEMP.  Note that
            if w is nonterminal, the production may be bypassed. }
          stackx := stackx - popno[cstate] + 1;
          if popno[cstate]=1 then begin
            if tsemp^.semt<>other then
              semstack[stackx]^ := tsemp^;
          end
          else
            semstack[stackx]^ := tsemp^;
          { compute the GOTO state }
          rx := statex[cstate];
          cstate := stack[stackx];
          while (stk_state[rx]<>cstate) and (stk_state[rx]<>0) do
            rx := rx+1;
          cstate := stk_tostate[rx];
        end;
        tsemp^.semt := other;
      end
      else if cstate < lookstate then begin
        { a read state }
        next_token;  { need next token now }
{#<D    dump if debugging enabled. }
        if debug > 2 then stk_dump('Read', stack, stackx, cstate);
{#>     end conditional. }
        rx := statex[cstate];
        while (toknum[rx]<>0) and (toknum[rx]<>token) do
          rx := rx+1;
        if toknum[rx]=0 then begin
          error('syntax error');
          cstate := error_recovery(stack, stackx, cstate);
        end
        else begin
          pushread(cstate, lsemp);
          cstate := tostate[rx];
          tokenread;  { token has been scanned }
        end
      end
      else begin
        { lookahead state }
        next_token;  { need another token now }
{#<D    dump if debugging enabled. }
        if debug > 2 then stk_dump('Look', stack, stackx, cstate);
{#>     end conditional. }
        rx := statex[cstate];
        while (toknum[rx]<>0) and (toknum[rx]<>token) do
          rx := rx+1;
        cstate := tostate[rx];
      end
    end;
    end_sem;
  end;

  { PARSE INITIALIZATION }

  {*****************}
  procedure INITTABLES;
    var SX: int;

{#<F import the table file reading function if needed. }
       {$I skelrtbl.pas}
{#<D   debugging wanted, too?
         {$I skeldtbl.pas}
{#>    end debugging }
{#:  else include the auxiliary functions needed by inline inits. }
    {................}
    procedure PUTSYM(STR: string80; TV: int);
      var SYMP: symtabp;
          TSYM: symbol;
          I: int;
    begin
      fillchar(tsym, maxtoklen, ' ');
      for i:=1 to length(str) do
        tsym[i]:=str[i];
      symp:=makesym(tsym, reserved, -1);
      symp^.tokval:=tv;
    end;

{#<D   also need to init debugging tables? }
    {................}
    procedure PUTTOK(PRINTVAL: string80;  TOKNUM, START: int);
      { this procedure is used to initialize the token tables.
        toknum is the number of the token to be initialized, and
        start is where it should start in the tokchar array. }
      var OFFSET:  int;
    begin
      tokx[toknum] := start;
      for offset := 0 to length(printval)-1 do
        tokchar[start+offset] := printval[offset+1];
      tokchar[start+length(printval)] := chr(0)
    end;
{#>    end puttok insertion. }
{#>  end table file conditional. }

    {................}
    procedure INIT_PARSER_TABLES;
      { initialize the parser tables }
    begin
{#<F  read from a table file? }
{#T     insert table file name in next line. }
        assign(tfile, '#');
        reset(tfile);
        read_header;
        read_table_file;
{#<D    take debugging info from the table file? }
          read_debugging_tables;
{#>     end if. }
        close(tfile)
{#:   not a table file; do the necessary inline inits }
{#IS    inline symbol table inits. }
{#<A    assignment style inits? }
{#IP      do the parser tables inline. }
{#>     end assignment inits. }
{#<D    debugging? }
{#IT      do the token tables inline. }
{#>     end debugging }
{#>   end of initialization style selection. }
    end { init_parser_tables };

  begin { inittables }
    pwr10_2[0] := 1E1;  {10^(2^0)}
    pwr10_2[1] := 1E2;  {10^(2^1)}
    pwr10_2[2] := 1E4;
    pwr10_2[3] := 1E8;
    pwr10_2[4] := 1E16;
    pwr10_2[5] := 1E32;
    errsym := 'ERR#AA         ';
    new(lsempary[0]);
    lsempary[0]^.semt := other;
    new(lsempary[1]);
    lsempary[1]^.semt := other;
    lsemp := lsempary[1];
    strtabx := 0;
    putstr('ERROR');  { default error string }
    tokenx := 2;  { no token queue }
    for sx := 0 to hlimit do
      symtab[sx] := nil;  { initialize symbol table }
    for sx := 0 to stacksize do begin
      new(semstack[sx]);
      semstack[sx]^.semt := other;
    end;
    init_parser_tables;
    init_sem;
    line := '';  { fake a new line }
    lx := 1;
    errpos:=1;
    nextch;  { fetch the first character, forcing a line read }
  end;

  {===================== start calcskel changes =====================}
  {*****************}
  procedure OPENFILES;
    { opens 'source' and 'listing' files (actually, the console in
      both cases). }
  begin
    sfilename := '';  { this means to read from the console as well }
    rfilename := '';  { as write to it (for other code's info). }
    prompt_len:=2;    { characters in prompt }
    assign(sfile, 'con:');
    reset(sfile);
    assign(rfile, 'con:');
    rewrite(rfile)
  end;
  {===================== end of calcskel changes =====================}

begin
  writeln('Interactive Calculator (vers. 18-Oct-84) -- "QUIT" to exit.');
  writeln('COPYRIGHT (C) 1984, QCAD Systems, Inc.  All rights reserved');
  writeln;
  errors := 0;
  debug := 0;
  openfiles;
  inittables;
  parser;  { does it all }
  close(sfile);
  close(rfile)
end.