PROC( INT,  REF [] REF [] CHAR)  INT main = ( INT  argc,  REF [] REF [] CHAR  argv)  INT :
BEGIN

PROC (INT) VOID exit = SKIP;

PROC (INT, REF [] CHAR, REF [] CHAR) INT fopen = SKIP;

PROC (INT) INT fclose = SKIP;

PROC (INT, REF [] CHAR, INT) INT fread = SKIP;

PROC (INT, REF [] CHAR, INT) INT fgets = SKIP;

PROC (INT, REF [] CHAR, INT) INT fwrite = SKIP;

PROC (INT, REF [] CHAR) INT fputs = SKIP;

PROC (INT) INT fputnl = SKIP;

MODE TOKEN =  STRUCT ( INT  type,  REF  []    CHAR  info);

MODE ASTREE =  REF ASNODE ;

MODE ASNODE =  STRUCT ( INT  tag,  REF  []    CHAR  semval,  ASTREE  succ, 
               ASTREE  childi,  ASTREE  childii,  ASTREE  childiii, 
               ASTREE  childiv,  ASTREE  childv,  ASTREE  childvi);

ASTREE astreenil = ASTREE ( NIL) ;
REF  []    CHAR stringnil = REF  []    CHAR ( NIL) ;

INT tabs         =   0;
INT tand         =   1;
INT tandth       =   2;
INT tassign      =   3;
INT tbasemode    =   4;
INT tbegin       =   5;
INT tby          =   6;
INT tcharconst   =   7;
INT tcolon       =   8;
INT tcomma       =   9;
INT tdo          =  10;
INT telif        =  11;
INT telse        =  12;
INT tend         =  13;
INT teq          =  14;
INT tfalse       =  15;
INT tfi          =  16;
INT tfor         =  17;
INT tfrom        =  18;
INT tgeq         =  19;
INT tgreater     =  20;
INT theap        =  21;
INT tid          =  22;
INT tif          =  23;
INT tintconst    =  24;
INT tis          =  25;
INT tisnt        =  26;
INT tlbracket    =  27;
INT tleq         =  28;
INT tless        =  29;
INT tloc         =  30;
INT tlwb         =  31;
INT tmax         =  32;
INT tmin         =  33;
INT tminus       =  34;
INT tmod         =  35;
INT tmode        =  36;
INT tneq         =  37;
INT tnil         =  38;
INT tnot         =  39;
INT tod          =  40;
INT tof          =  41;
INT tor          =  42;
INT torel        =  43;
INT tover        =  44;
INT tplus        =  45;
INT tpow         =  46;
INT tproc        =  47;
INT trbracket    =  48;
INT tref         =  49;
INT trepr        =  50;
INT tsemicolon   =  51;
INT tsign        =  52;
INT tskip        =  53;
INT tstringconst =  54;
INT tstruct      =  55;
INT tthen        =  56;
INT ttimes       =  57;
INT tto          =  58;
INT ttrue        =  59;
INT tupb         =  60;
INT twhile       =  61;

INT ntassignment          = 65;
INT ntclosedclause        = 66;
INT ntformallist          = 67;
INT ntidentitydecl        = 68;
INT ntifclause            = 69;
INT ntloopclause          = 70;
INT ntmodecast            = 71;
INT ntproccall            = 72;
INT ntprototype           = 73;
INT ntroutineval          = 74; 
INT ntstrucdisplay        = 75;
INT ntsubscript           = 76;
INT ntusermodedecl        = 77;

INT undefined            = 254;
INT endoftokens          = 255;

BOOL debugging = FALSE;
REF [] TOKEN tokens = LOC [25000]  TOKEN ;
REF INT tokenindex = LOC INT ;
REF INT lastreadindex = LOC INT ;
REF [] INT firsttokenonline  = LOC [10000]  INT ;

PROC( REF  []    CHAR)  VOID debugprint = ( REF  []    CHAR  message)  VOID :
BEGIN
  IF debugging 
  THEN
    fputs(1,  message) ;
    fputnl(1)
  FI
END ;

PROC( REF  []    CHAR,  REF  []    CHAR)  INT stringcopy = ( REF  []    CHAR  s,  REF  []    CHAR  t)  INT :
BEGIN
  REF INT result = LOC INT ;

  result := 0 ;
  s[result] := t[result] ;
  WHILE ABS  t[result] /= 0
  DO
    result  := result + 1 ;
    s[result] := t[result]
  OD ;

  result
END ;

PROC( REF  []    CHAR,  REF  []    CHAR)  INT stringcmp = ( REF  []    CHAR  s,  REF  []    CHAR  t)  INT :
BEGIN
  REF INT result = LOC INT;
  REF INT cofs   = LOC INT;
  REF INT coft   = LOC INT;
  REF INT aux    = LOC INT;
  
  result := 0;

  aux  := 0;
  cofs := ABS  s[aux];
  coft := ABS  t[aux];
  WHILE (cofs /= 0) ANDTH (cofs = coft)
  DO
    aux  := aux + 1;
    cofs := ABS  s[aux];
    coft := ABS  t[aux]
  OD;

  IF cofs = 0
  THEN 
    IF coft = 0
    THEN 
      result := 0
    ELSE 
      result := -1
    FI
  ELSE 
    IF cofs < coft
    THEN 
      result := -1
    ELSE 
      result := 1
    FI    
  FI;

  result
END ;

PROC( INT,  INT)  INT fputint = ( INT  filenum,  INT  anint)  INT :
BEGIN
  REF  []    CHAR astring = LOC  [256] CHAR ;
  REF INT toconvert = LOC INT ;
  REF INT ndigits = LOC INT ;
  REF CHAR tmp = LOC CHAR ;
  INT zeroascii = ABS  '0' ;

  ndigits := 0 ;
  astring[ndigits] := REPR(zeroascii + anint MOD 10) ;
  toconvert := anint OVER 10 ;
  ndigits := ndigits + 1 ;
  WHILE toconvert > 0 
  DO
    astring[ndigits] := REPR(zeroascii + toconvert MOD 10) ;
    toconvert := toconvert OVER 10 ;
    ndigits := ndigits + 1
  OD ;
  astring[ndigits] := REPR 0 ;
  
  FOR i TO  ndigits OVER 2
  DO
    tmp := astring[i - 1] ;
    astring[i - 1] := astring[ndigits - i] ;
    astring[ndigits - i] := tmp    
  OD ;

  IF filenum = 0
  THEN
    ndigits := fputs(0,  astring)
  ELSE
    IF filenum = 1
    THEN
      ndigits := fputs(1,  astring)
    ELSE
      IF filenum = 2
      THEN
        ndigits := fputs(2,  astring)
      ELSE
        IF filenum = 3
        THEN
          ndigits := fputs(3,  astring)
        ELSE
          IF filenum = 4
          THEN
            ndigits := fputs(4,  astring)
          ELSE
            IF filenum = 5
            THEN
              ndigits := fputs(5,  astring)
            ELSE
              IF filenum = 6
              THEN
                ndigits := fputs(6,  astring)
              ELSE
                IF filenum = 7
                THEN
                  ndigits := fputs(7,  astring)
                ELSE
                  error("Run Time Error: max handle is 7")
                FI
              FI
            FI
          FI
        FI
      FI
    FI
  FI ;

  ndigits
END ;

PROC( INT,  CHAR)  INT fputchar = ( INT  filenum,  CHAR  achar)  INT :
BEGIN
  REF [] CHAR astring = LOC [2]  CHAR ;
  REF INT ndigits = LOC INT ;
 
  astring[0] := achar ;
  astring[1] := REPR 0 ;

  IF filenum = 0
  THEN
    ndigits := fputs(0,  astring)
  ELSE
    IF filenum = 1
    THEN
      ndigits := fputs(1,  astring)
    ELSE
      IF filenum = 2
      THEN
        ndigits := fputs(2,  astring)
      ELSE
        IF filenum = 3
        THEN
          ndigits := fputs(3,  astring)
        ELSE
          IF filenum = 4
          THEN
            ndigits := fputs(4,  astring)
          ELSE
            IF filenum = 5
            THEN
              ndigits := fputs(5,  astring)
            ELSE
              IF filenum = 6
              THEN
                ndigits := fputs(6,  astring)
              ELSE
                IF filenum = 7
                THEN
                  ndigits := fputs(7,  astring)
                ELSE
                  error("Run Time Error: max handle is 7")
                FI
              FI
            FI
          FI
        FI
      FI
    FI
  FI ;

  ndigits
END ;

PROC( INT,  BOOL)  INT fputbool = ( INT  filenum,  BOOL  abool)  INT :
BEGIN
  REF [] CHAR astring = LOC [6]  CHAR ;
  REF INT ndigits = LOC INT ;

  IF abool 
  THEN  
    stringcopy(astring, "TRUE")
  ELSE
    stringcopy(astring, "FALSE")
  FI ;

  IF filenum = 0
  THEN
    ndigits := fputs(0,  astring)
  ELSE
    IF filenum = 1
    THEN
      ndigits := fputs(1,  astring)
    ELSE
      IF filenum = 2
      THEN
        ndigits := fputs(2,  astring)
      ELSE
        IF filenum = 3
        THEN
          ndigits := fputs(3,  astring)
        ELSE
          IF filenum = 4
          THEN
            ndigits := fputs(4,  astring)
          ELSE
            IF filenum = 5
            THEN
              ndigits := fputs(5,  astring)
            ELSE
              IF filenum = 6
              THEN
                ndigits := fputs(6,  astring)
              ELSE
                IF filenum = 7
                THEN
                  ndigits := fputs(7,  astring)
                ELSE
                  error("Run Time Error: max handle is 7")
                FI
              FI
            FI
          FI
        FI
      FI
    FI
  FI ;

  ndigits
END ;

PROC( ASTREE,  INT)  INT writeast = ( ASTREE  codetree,  INT  indentation)  INT :
BEGIN
  FOR i TO  indentation
  DO
    fputs(1,  " ")
  OD;

  IF codetree IS astreenil
  THEN
    fputs(1,  "-");
    fputnl(1)
  ELSE
    fputs(1,  "(");
    fputint(1, tag OF  codetree);
    IF semval OF  codetree ISNT stringnil
    THEN 
      fputs(1,  " ");
      fputs(1,  semval OF  codetree);
      fputs(1,  ")")
    ELSE
      fputnl(1);

      writeast(childi OF  codetree, indentation+1);
      writeast(childii OF  codetree, indentation+1);
      writeast(childiii OF  codetree, indentation+1);
      writeast(childiv OF  codetree, indentation+1);
      writeast(childv OF  codetree, indentation+1);
      writeast(childvi OF  codetree, indentation+1);

      FOR i TO  indentation
      DO
        fputs(1,  " ")
      OD;
      fputs(1,  ")")
    FI;

    IF succ OF  codetree ISNT astreenil
    THEN 
      fputs(1,  " ->");
      fputnl(1);
      writeast(succ OF  codetree, indentation)
    ELSE
      fputnl(1)
    FI
  FI ;

  0
END ;

PROC  VOID readtokens =  VOID :
BEGIN
  REF  []    CHAR thetoken = LOC  [256] CHAR ;
  REF  []    CHAR thevalue = LOC  [256] CHAR ;
  REF INT nchars = LOC INT ;
  REF INT nlines = LOC INT ;

  tokenindex := 0 ;
  nlines := 0 ;
  firsttokenonline[0] := 0;

  WHILE (nchars := fgets(0,  thetoken,  256)) /= -1
  DO
    thetoken[nchars - 1] := REPR 0; 

    IF ABS  thetoken[0] > 32 THEN
      type OF   tokens[tokenindex] := undefined;
      info OF  tokens[tokenindex] := NIL;  
      IF stringcmp(thetoken, "TID") = 0
      THEN
        type OF   tokens[tokenindex] := tid;
        info OF  tokens[tokenindex] := HEAP [256] CHAR;    
        IF (nchars := fgets(0,  thevalue,  256)) = -1
        THEN
          fputs(1,  "unexecpted error while reading an identifier");
          fputnl(1);
          exit(1)
        ELSE
          thevalue[nchars - 1] := REPR 0 ;
          stringcopy(info OF  tokens[tokenindex], thevalue)
        FI
      ELSE 
        IF stringcmp(thetoken, "TBASEMODE") = 0
        THEN 
          type OF   tokens[tokenindex] := tbasemode;
          info OF  tokens[tokenindex] := HEAP [256] CHAR;    
          IF (nchars := fgets(0,  thevalue,  256)) = -1
          THEN
            fputs(1,  "unexecpted error while reading a user-defined mode");
            fputnl(1);
            exit(1)
          ELSE
            thevalue[nchars - 1] := REPR 0 ;
            stringcopy(info OF  tokens[tokenindex], thevalue)
          FI
        ELSE 
          IF stringcmp(thetoken, "TSTRING_CONSTANT") = 0
          THEN 
            type OF   tokens[tokenindex] := tstringconst;
            info OF  tokens[tokenindex] := HEAP [256] CHAR;    
            IF (nchars := fgets(0,  thevalue,  256)) = -1
            THEN
              fputs(1,  "unexecpted error while reading a string literal");
              fputnl(1);
              exit(1)
            ELSE
             thevalue[nchars - 1] := REPR 0 ;
             stringcopy(info OF  tokens[tokenindex], thevalue)
            FI
          ELSE 
            IF stringcmp(thetoken, "TINTEGER_CONSTANT") = 0
            THEN 
              type OF   tokens[tokenindex] := tintconst;
              info OF  tokens[tokenindex] := HEAP [256] CHAR;    
              IF (nchars := fgets(0,  thevalue,  256)) = -1
              THEN
                fputs(1,  "unexecpted error while reading an integer literal");
                fputnl(1);
                exit(1)
              ELSE
                thevalue[nchars - 1] := REPR 0 ;
                stringcopy(info OF  tokens[tokenindex], thevalue)
              FI
            ELSE 
              IF stringcmp(thetoken, "TCHAR_CONSTANT") = 0
              THEN 
                type OF   tokens[tokenindex] := tcharconst;
                info OF  tokens[tokenindex] := HEAP [256] CHAR;    
                IF (nchars := fgets(0,  thevalue,  256)) = -1
                THEN
                  fputs(1,  "unexecpted error while reading a character literal");
                  fputnl(1);
                  exit(1)
                ELSE
                  thevalue[nchars - 1] := REPR 0 ;
                  stringcopy(info OF  tokens[tokenindex], thevalue)
                FI
              ELSE
                info OF  tokens[tokenindex] := NIL;
                IF stringcmp(thetoken, "TBEGIN") = 0
                THEN 
                  type OF  tokens[tokenindex] := tbegin
                FI;
                IF stringcmp(thetoken, "TEND") = 0
                THEN
                  type OF  tokens[tokenindex] := tend
                FI;
                IF stringcmp(thetoken, "TLBRACKET") = 0
                THEN
                  type OF  tokens[tokenindex] := tlbracket
                FI;
                IF stringcmp(thetoken, "TRBRACKET") = 0
                THEN
                  type OF  tokens[tokenindex] := trbracket
                FI;
                IF stringcmp(thetoken, "TREF") = 0
                THEN
                  type OF  tokens[tokenindex] := tref
                FI;
                IF stringcmp(thetoken, "TSTRUCT") = 0
                THEN
                  type OF  tokens[tokenindex] := tstruct
                FI;
                IF stringcmp(thetoken, "TPROC") = 0
                THEN
                  type OF  tokens[tokenindex] := tproc
                FI;
                IF stringcmp(thetoken, "TLOC") = 0
                THEN
                  type OF  tokens[tokenindex] := tloc
                FI;
                IF stringcmp(thetoken, "THEAP") = 0
                THEN
                  type OF  tokens[tokenindex] := theap
                FI;
                IF stringcmp(thetoken, "TMODE") = 0
                THEN
                  type OF  tokens[tokenindex] := tmode
                FI;
                IF stringcmp(thetoken, "TSKIP") = 0
                THEN
                  type OF  tokens[tokenindex] := tskip
                FI;
                IF stringcmp(thetoken, "TNIL") = 0
                THEN
                  type OF  tokens[tokenindex] := tnil
                FI;
                IF stringcmp(thetoken, "TIF") = 0
                THEN
                  type OF  tokens[tokenindex] := tif
                FI;
                IF stringcmp(thetoken, "TTHEN") = 0
                THEN
                  type OF  tokens[tokenindex] := tthen
                FI;
                IF stringcmp(thetoken, "TELSE") = 0
                THEN
                  type OF  tokens[tokenindex] := telse
                FI;
                IF stringcmp(thetoken, "TELIF") = 0
                THEN
                  type OF  tokens[tokenindex] := telif
                FI;
                IF stringcmp(thetoken, "TFI") = 0
                THEN
                  type OF  tokens[tokenindex] := tfi
                FI;
                IF stringcmp(thetoken, "TFOR") = 0
                THEN
                  type OF  tokens[tokenindex] := tfor
                FI;
                IF stringcmp(thetoken, "TFROM") = 0
                THEN
                  type OF  tokens[tokenindex] := tfrom
                FI;
                IF stringcmp(thetoken, "TBY") = 0
                THEN
                  type OF  tokens[tokenindex] := tby
                FI;
                IF stringcmp(thetoken, "TTO") = 0
                THEN
                  type OF  tokens[tokenindex] := tto
                FI;
                IF stringcmp(thetoken, "TWHILE") = 0
                THEN
                  type OF  tokens[tokenindex] := twhile
                FI;
                IF stringcmp(thetoken, "TDO") = 0
                THEN
                  type OF  tokens[tokenindex] := tdo
                FI;
                IF stringcmp(thetoken, "TOD") = 0
                THEN
                  type OF  tokens[tokenindex] := tod
                FI;
                IF stringcmp(thetoken, "TOF") = 0
                THEN
                  type OF  tokens[tokenindex] := tof
                FI;
                IF stringcmp(thetoken, "TIS") = 0
                THEN
                  type OF  tokens[tokenindex] := tis
                FI;
                IF stringcmp(thetoken, "TISNT") = 0
                THEN
                  type OF  tokens[tokenindex] := tisnt
                FI;
                IF stringcmp(thetoken, "TASSIGN") = 0
                THEN
                  type OF  tokens[tokenindex] := tassign
                FI;
                IF stringcmp(thetoken, "TABS") = 0
                THEN
                  type OF  tokens[tokenindex] := tabs
                FI;
                IF stringcmp(thetoken, "TSIGN") = 0
                THEN
                  type OF  tokens[tokenindex] := tsign
                FI;
                IF stringcmp(thetoken, "TREPR") = 0
                THEN
                  type OF  tokens[tokenindex] := trepr
                FI;
                IF stringcmp(thetoken, "TNOT") = 0
                THEN
                  type OF  tokens[tokenindex] := tnot
                FI;
                IF stringcmp(thetoken, "TLWB") = 0
                THEN
                  type OF  tokens[tokenindex] := tlwb
                FI;
                IF stringcmp(thetoken, "TUPB") = 0
                THEN
                  type OF  tokens[tokenindex] := tupb
                FI;
                IF stringcmp(thetoken, "TANDTH") = 0
                THEN
                  type OF  tokens[tokenindex] := tandth
                FI;
                IF stringcmp(thetoken, "TOREL") = 0
                THEN
                  type OF  tokens[tokenindex] := torel
                FI;
                IF stringcmp(thetoken, "TAND") = 0
                THEN
                  type OF  tokens[tokenindex] := tand
                FI;
                IF stringcmp(thetoken, "TOR") = 0
                THEN
                  type OF  tokens[tokenindex] := tor
                FI;
                IF stringcmp(thetoken, "TEQ") = 0
                THEN
                  type OF  tokens[tokenindex] := teq
                FI;
                IF stringcmp(thetoken, "TNEQ") = 0
                THEN
                  type OF  tokens[tokenindex] := tneq
                FI;
                IF stringcmp(thetoken, "TLESS") = 0
                THEN
                  type OF  tokens[tokenindex] := tless
                FI;
                IF stringcmp(thetoken, "TGREATER") = 0
                THEN
                  type OF  tokens[tokenindex] := tgreater
                FI;
                IF stringcmp(thetoken, "TLEQ") = 0
                THEN
                  type OF  tokens[tokenindex] := tleq
                FI;
                IF stringcmp(thetoken, "TGEQ") = 0
                THEN
                  type OF  tokens[tokenindex] := tgeq
                FI;
                IF stringcmp(thetoken, "TPLUS") = 0
                THEN
                  type OF  tokens[tokenindex] := tplus
                FI;
                IF stringcmp(thetoken, "TMINUS") = 0
                THEN
                  type OF  tokens[tokenindex] := tminus
                FI;
                IF stringcmp(thetoken, "TTIMES") = 0
                THEN
                  type OF  tokens[tokenindex] := ttimes
                FI;
                IF stringcmp(thetoken, "TOVER") = 0
                THEN
                  type OF  tokens[tokenindex] := tover
                FI;
                IF stringcmp(thetoken, "TMOD") = 0
                THEN
                  type OF  tokens[tokenindex] := tmod
                FI;
                IF stringcmp(thetoken, "TPOW") = 0
                THEN
                  type OF  tokens[tokenindex] := tpow
                FI;
                IF stringcmp(thetoken, "TMAX") = 0
                THEN
                  type OF  tokens[tokenindex] := tmax
                FI;
                IF stringcmp(thetoken, "TMIN") = 0
                THEN
                  type OF  tokens[tokenindex] := tmin
                FI;
                IF stringcmp(thetoken, "TCOMMA") = 0
                THEN
                  type OF  tokens[tokenindex] := tcomma
                FI;
                IF stringcmp(thetoken, "TSEMICOLON") = 0
                THEN
                  type OF  tokens[tokenindex] := tsemicolon
                FI;
                IF stringcmp(thetoken, "TCOLON") = 0
                THEN
                  type OF  tokens[tokenindex] := tcolon
                FI;
                IF stringcmp(thetoken, "TTRUE") = 0
                THEN
                  type OF  tokens[tokenindex] := ttrue
                FI;
                IF stringcmp(thetoken, "TFALSE") = 0
                THEN
                  type OF  tokens[tokenindex] := tfalse
                FI;
                IF stringcmp(thetoken, "EMPTYLINE") = 0
                THEN
                  nlines := nlines + 1 ;
                  firsttokenonline[nlines] := tokenindex ;
                  tokenindex := tokenindex - 1          
                FI
              FI
            FI
          FI
        FI
      FI ;

      IF type OF   tokens[tokenindex] = undefined
      THEN
        fputs(1,  "PANIC: Unexpected token during parsing: ") ;
        fputs(1,  thetoken) ;
        fputnl(1) ;
       exit(1)
      ELSE
        tokenindex := tokenindex + 1
      FI
    FI
  OD;

  firsttokenonline[nlines] := endoftokens ;
  IF debugging
  THEN
    fputs(1,  "read: ") ;
    fputint(1, nlines) ;
    fputs(1,  " lines of input, and ") ;
    fputint(1,  tokenindex) ;
    fputs(1,  " tokens") ;
    fputnl(1)
  FI ;

  type OF  tokens[tokenindex] := endoftokens;
  tokenindex := tokenindex + 1    
END ;

PROC( REF  []    CHAR)  VOID error = ( REF  []    CHAR  msg)  VOID :
BEGIN
  REF INT errorline = LOC INT ;
  
  errorline := 0 ;
  WHILE lastreadindex > firsttokenonline[errorline]
  DO
    errorline := errorline + 1
  OD ;
  fputs(1,  msg) ;
  fputs(1,  " at line ") ;
  fputint(1, errorline) ;
  fputnl(1)

END ;

PROC( INT)  BOOL lookahead = ( INT  shouldbenext)  BOOL :
BEGIN
  REF BOOL result = LOC BOOL ;
  REF INT nextone = LOC INT ;
 
  nextone := type OF  tokens[tokenindex] ;

  IF debugging
  THEN
    fputs(1,  "searching for a ") ;
    fputint (1, shouldbenext) ;
    fputs(1,  " against a ") ;
    fputint (1,  nextone) ;
    IF info OF  tokens[tokenindex] ISNT stringnil
    THEN
      fputs(1,  " <") ;
      fputs(1,  info OF  tokens[tokenindex]) ;
      fputs(1,  ">")
    FI ;
    fputs(1,  " <") ;
    fputint (1,  tokenindex) ;
    fputs(1,  ">") ;
    fputnl(1)
  FI ;

  IF nextone = shouldbenext
  THEN
 
    IF debugging
    THEN
      fputs(1,  "Found a ") ;
      fputint (1, shouldbenext) ;
      fputnl(1)
    FI ;

    result := TRUE;
    IF tokenindex > lastreadindex
    THEN
      lastreadindex := tokenindex
    FI ;
    tokenindex := tokenindex + 1
  ELSE

    IF debugging
    THEN
      fputs(1,  "NOT found a ") ;
      fputint (1, shouldbenext) ;
      fputnl(1)
    FI ;

    result := FALSE
  FI;

  result
END ;

PROC( INT)  ASTREE newasnode = ( INT  thetag)  ASTREE :
BEGIN
  REF ASNODE leafnode = HEAP ASNODE ;

  tag OF  leafnode := thetag ;

  semval OF  leafnode := NIL ;
  childi OF  leafnode := NIL ;
  childii OF  leafnode := NIL ;
  childiii OF  leafnode := NIL ;
  childiv OF  leafnode := NIL ;
  childv OF  leafnode := NIL ;
  childvi OF  leafnode := NIL ;
  succ OF  leafnode   := NIL ;

  leafnode
END ;

PROC  ASTREE identifier =  ASTREE :
BEGIN
  REF ASTREE result = LOC ASTREE;

  IF lookahead(tid) 
  THEN 
    result := newasnode(tid);
    semval OF  result := HEAP [256] CHAR;
    stringcopy(semval OF  result, info OF  tokens[tokenindex - 1])
  ELSE 
    result := NIL
  FI;

  result  
END ;

PROC  ASTREE user =  ASTREE :
BEGIN
  REF ASTREE result = LOC ASTREE;

  IF lookahead(tbasemode) 
  THEN 
    result := newasnode(tbasemode);
    semval OF  result := HEAP [256] CHAR;
    stringcopy(semval OF  result, info OF  tokens[tokenindex - 1])
  ELSE 
     result := NIL
  FI;

  result  
END ;

PROC  ASTREE string =  ASTREE :
BEGIN
  REF ASTREE result = LOC ASTREE;

  IF lookahead(tstringconst) 
  THEN 
    result := newasnode(tstringconst) ;
    semval OF  result := HEAP [256] CHAR;
    stringcopy(semval OF  result, info OF  tokens[tokenindex - 1])
  ELSE
     result := NIL
  FI;

  result  
END ;

PROC  ASTREE character =  ASTREE :
BEGIN
  REF ASTREE result = LOC ASTREE;

  IF lookahead(tcharconst) 
  THEN 
    result := newasnode(tcharconst) ;
    semval OF  result := HEAP [256] CHAR;
    stringcopy(semval OF  result, info OF  tokens[tokenindex - 1])
  ELSE 
    result := NIL
  FI;

  result  
END ;

PROC  ASTREE integer =  ASTREE :
BEGIN
  REF ASTREE result = LOC ASTREE;

  IF lookahead(tintconst) 
  THEN 
    result := newasnode(tintconst);
    semval OF  result := HEAP [256] CHAR;
    stringcopy(semval OF  result, info OF  tokens[tokenindex - 1])
  ELSE 
    result := NIL
  FI;

  result  
END ;

PROC  ASTREE program =  ASTREE :
BEGIN
  REF ASTREE parsetree = LOC ASTREE ;

  parsetree := identitydecl  ;
  
  parsetree
END ;

PROC  ASTREE phrase =  ASTREE :
BEGIN
  REF ASTREE parsetree = LOC ASTREE ;

  parsetree := declaration  ;
  IF parsetree IS astreenil 
  THEN
    parsetree := unit 
  FI ;

  parsetree
END ;

PROC  ASTREE unit =  ASTREE :
BEGIN
  REF ASTREE parsetree = LOC ASTREE ;
  INT undoindex = tokenindex ;

  IF lookahead(tskip) 
  THEN 
    parsetree := newasnode (tskip)
  ELSE
    parsetree := routineval  ;
    IF parsetree IS astreenil 
    THEN 
      ASTREE leftpart = tertiary ;
      IF leftpart ISNT astreenil
      THEN
        IF lookahead (tassign) 
        THEN 
          ASTREE rightpart = unit  ;
          IF rightpart ISNT astreenil
          THEN
            parsetree := newasnode (ntassignment) ;
            childi OF  parsetree := leftpart ;
            childii OF  parsetree := rightpart
          ELSE
            tokenindex := undoindex ;
            parsetree := NIL
          FI
        ELSE
          IF lookahead (tis) 
          THEN
            ASTREE rightpart = tertiary  ;
            IF rightpart ISNT astreenil
            THEN
              parsetree := newasnode (tis) ;
              childi OF  parsetree := leftpart ;
              childii OF  parsetree := rightpart
            ELSE
              tokenindex := undoindex;
              parsetree := NIL 
            FI
          ELSE 
            IF lookahead (tisnt)
            THEN
              ASTREE rightpart = tertiary  ;
              IF rightpart ISNT astreenil
              THEN
                parsetree := newasnode (tisnt) ;
                childi OF  parsetree := leftpart ;
                childii OF  parsetree := rightpart
              ELSE
                tokenindex := undoindex ;
                parsetree := NIL 
              FI
            ELSE
              parsetree := leftpart 
            FI
          FI 
        FI 
      FI
    FI
  FI ;
  
  parsetree
END ;

PROC  ASTREE tertiary =  ASTREE :
BEGIN
  REF ASTREE parsetree = LOC ASTREE ;

  IF lookahead (tnil)
  THEN
    parsetree := newasnode (tnil)
  ELSE
    parsetree := formula 
  FI ;
  
  parsetree
END ;

PROC  ASTREE secondary =  ASTREE :
BEGIN
  REF ASTREE parsetree = LOC ASTREE ;
  INT undoindex = tokenindex ;

  IF lookahead (tloc)
  THEN 
    { parsing a loc generator }
    parsetree := generator  ;
    IF parsetree ISNT astreenil
    THEN
      { we only need to set the type of this subtree }
      tag OF  parsetree := tloc
    ELSE
      { undoing the step forward on the token tloc }
      tokenindex := undoindex 
    FI
  ELSE 
    IF lookahead (theap)
    THEN
      { parsing a heap generator }
      parsetree := generator  ;
      IF parsetree ISNT astreenil
      THEN
        { we only need to set the type of this subtree }
        tag OF  parsetree := theap
      ELSE
        { undoing the step forward on the token theap }
        tokenindex := undoindex 
      FI
    ELSE
      { the only other strictly secondary alternative starts with an id }
      { but there are also some primaries starting with id }
      { for this reason we need to be careful before calling primary }
      ASTREE leftpart = identifier  ;
      IF leftpart ISNT astreenil
      THEN
        IF lookahead (tof)
        THEN
          { the previous id belong to a selection so we read the rest }
          ASTREE rightpart = secondary  ;
          IF rightpart ISNT astreenil
          THEN
            parsetree := newasnode (tof) ;
            childi OF  parsetree := leftpart ;
            childii OF  parsetree := rightpart
          ELSE
            tokenindex := undoindex ;
            parsetree := NIL 
          FI
        ELSE
          IF lookahead(tbegin)
          THEN 
            { here the previous id is a functor so we read the args }
            { notice that this is actually a primary }
            ASTREE rightpart = strucdisplay  ;
            IF (rightpart ISNT astreenil) 
            THEN 
              { we actually found all args and the close paren }
              parsetree := newasnode (ntproccall) ;
              childi OF  parsetree := leftpart ;
              childii OF  parsetree := rightpart
            ELSE 
              { something went wrong with args or close paren so undo }
              tokenindex := undoindex ;
              parsetree := NIL 
            FI
          ELSE
            IF lookahead(tlbracket)
            THEN
              { now we deal with possibly multiple array subsripting } 
              { notice again that this is actually a primary }
              ASTREE rightpart = subscript ;
              IF (rightpart ISNT astreenil)
              THEN 
                { we found indeed a consistent array subscripting }
                parsetree := newasnode (ntsubscript) ;
                childi OF  parsetree := leftpart ;
                childii OF  parsetree := rightpart
              ELSE 
                { something went wrong with subscripting hence we undo }
                tokenindex := undoindex ;
                parsetree := NIL 
              FI
            ELSE
              { we are now in the case that the id read before was just }
              { an instance of an applied use of identifiers }
              parsetree := leftpart
            FI
          FI
        FI
      ELSE
        { this secondary does not even start with id so we call primary }
        parsetree := primary  
      FI
    FI
  FI ;

  parsetree
END ;

PROC  ASTREE primary =  ASTREE :
BEGIN
  REF ASTREE parsetree = LOC ASTREE ;
  INT undoindex = tokenindex ;

  { first we check if it is a denotation ie bool or char or int literal }
  IF lookahead (tfalse)
  THEN
    parsetree := newasnode (tfalse) 
  ELSE
    IF lookahead (ttrue)
    THEN
      parsetree := newasnode (ttrue) 
    ELSE
      parsetree := character  ;
      IF parsetree IS astreenil
      THEN
        parsetree := integer  ;
        IF parsetree IS astreenil
        THEN
          { now we check for casting }
          parsetree := modecast  ;
          IF parsetree IS astreenil
          THEN
            { all other alternatives but enclclause starts with an id }
            ASTREE leftpart = identifier  ;
            IF leftpart ISNT astreenil
            THEN
              IF lookahead(tbegin)
              THEN 
                { now we can infer that the previous id is a functor }
                { before parsing its arguments we set things up for undo }
                ASTREE rightpart = strucdisplay  ;
                IF (rightpart ISNT astreenil) 
                THEN 
                  { we actually found all args including the close paren }
                  parsetree := newasnode (ntproccall) ;
                  childi OF  parsetree := leftpart ;
                  childii OF  parsetree := rightpart
                ELSE 
                  { something went wrong with args or close paren so undo }
                  tokenindex := undoindex ;
                  parsetree := NIL 
                FI
              ELSE
                IF lookahead(tlbracket)
                THEN
                  { now we deal with possibly multiple array subsripting }
                  { here undoing will be limited to one token }
                  ASTREE rightpart = subscript ;
                  IF (rightpart ISNT astreenil)
                  THEN 
                    { we found indeed a consistent array subscripting }
                    parsetree := newasnode (ntsubscript) ;
                    childi OF  parsetree := leftpart ;
                    childii OF  parsetree := rightpart
                  ELSE 
                    { something went wrong with subscripting hence we undo }
                    tokenindex := undoindex ;
                    parsetree := NIL 
                  FI
                ELSE
                  { we are now in the case that the id read before }
                  { was just an instance of an applied use of identifiers }
                  parsetree := leftpart
                FI
              FI
            ELSE
              { here the only alternative remaining is an enclclause }
              parsetree := enclclause  
            FI
          FI
        FI
      FI
    FI
  FI ;
  
  parsetree
END ;

PROC  ASTREE subscript =  ASTREE :
BEGIN
  REF ASTREE parsetree = LOC ASTREE;
  REF ASTREE nextunit = LOC ASTREE;
  REF ASTREE cursor = LOC ASTREE;
  INT undoindex = tokenindex;

    debugprint("inside arrayelem...");

  parsetree := unit ;
  IF (parsetree ISNT astreenil) ANDTH lookahead(trbracket)
  THEN 
    cursor := parsetree;
    WHILE (parsetree ISNT astreenil) ANDTH lookahead(tlbracket)
    DO
      nextunit := unit ;
      IF (nextunit ISNT astreenil) ANDTH lookahead(trbracket)
      THEN 
        succ OF  cursor := nextunit;
        cursor := succ OF  cursor
      ELSE
        parsetree := NIL
      FI
    OD
  ELSE 
    parsetree := NIL
  FI;
  
  IF parsetree IS astreenil
  THEN
    tokenindex := undoindex
  FI ;

  parsetree
END ;

PROC  ASTREE enclclause =  ASTREE :
BEGIN
  REF ASTREE parsetree = LOC ASTREE ;
  INT undoindex = tokenindex ;

  { we start checking for the easytodistinguish alternatives }
  parsetree := ifclause  ;
  IF parsetree IS astreenil
  THEN 
    parsetree := loopclause  ;
    IF parsetree IS astreenil
    THEN 
      parsetree := string  ;
      IF (parsetree IS astreenil) ANDTH lookahead(tbegin)
      THEN
        { all alternatives now start with open paren so we needed it }
        IF lookahead(tend)
        THEN 
          { an empty struct or row display though unusual can occur }
          parsetree := newasnode(ntstrucdisplay)
        ELSE 
          { thus there is something inside parens }
          { it could be comma or semicolon separated so we check }
          ASTREE firstpart = phrase  ;
         
          IF firstpart ISNT astreenil
          THEN 
            IF lookahead(tsemicolon)
            THEN 
              { since it is semicolon separated it is a serial clause }
              parsetree := serialclause  ;
              IF parsetree ISNT astreenil
              THEN 
                IF lookahead(tend)
                THEN 
                  succ OF  firstpart := parsetree ;
                  parsetree := newasnode (ntclosedclause) ;
                  childi OF  parsetree := firstpart
                ELSE 
                  { error since we did not find a close paren }
                  tokenindex := undoindex ;
                  parsetree := NIL
                FI
              ELSE 
                { we have a semicolon but nothing afterwards }
                tokenindex := undoindex ;
                parsetree := NIL                
              FI
            ELSE
              { now either we have found a strucdisplay which uses commas }
              { or there was just a single unit inside parens }
              { either way the previous phrase in firstpart must be a unit }
              IF (tag OF  firstpart = ntidentitydecl) OREL 
                 (tag OF  firstpart = ntusermodedecl)
              THEN
                tokenindex := undoindex ;
                parsetree := NIL      
              ELSE
                IF lookahead (tend)
                THEN
                  parsetree := newasnode (ntclosedclause) ;
                  childi OF  parsetree := firstpart
                ELSE
                  IF lookahead (tcomma)
                  THEN
                    { here we have a strucdisplay }
                    parsetree := strucdisplay  ;
                    IF parsetree ISNT astreenil
                    THEN
                      succ OF  firstpart := parsetree ; 
                      parsetree := newasnode (ntstrucdisplay) ;
                      childi OF  parsetree := firstpart
                    ELSE 
                      { we have a comma but nothing afterwards }
                      tokenindex := undoindex ;
                      parsetree := NIL     
                    FI
                  ELSE
                    { after this unit we should have either a comma }
                    { or a semicolon or a close paren so error }
                    tokenindex := undoindex ;
                    parsetree := NIL
                  FI
                FI
              FI
            FI
          ELSE
            { something went wrong since inside paren there should be a phrase }
            tokenindex := undoindex ;
            parsetree := NIL
          FI
        FI
      FI
    FI
  FI ;
  
  parsetree
END ;

PROC  ASTREE serialclause =  ASTREE :
BEGIN
  REF ASTREE parsetree = LOC ASTREE ;
  INT undoindex = tokenindex ; 

  parsetree := phrase ;
  IF parsetree ISNT astreenil
  THEN 
    REF ASTREE cursor = LOC ASTREE ;
    
    cursor := parsetree ;

    WHILE (cursor ISNT astreenil) ANDTH lookahead(tsemicolon)
    DO
      succ OF  cursor := phrase  ;
      cursor := succ OF  cursor
    OD;

    IF (cursor IS astreenil) OREL
       (tag OF  cursor = ntidentitydecl) OREL 
       (tag OF  cursor = ntusermodedecl)
    THEN 
       tokenindex := undoindex ;
       parsetree := NIL
    FI
  FI;

  parsetree
END ;

PROC  ASTREE ifclause =  ASTREE :
BEGIN
  REF ASTREE parsetree = LOC ASTREE ;
  REF BOOL nonilerror = LOC BOOL ;
  INT undoindex = tokenindex ;

  parsetree := NIL ;
  nonilerror := TRUE ;

  IF lookahead(tif)
  THEN
    ASTREE ifpart = serialclause  ;
    IF (ifpart ISNT astreenil) ANDTH lookahead(tthen)
    THEN 
      ASTREE thenpart = serialclause  ;
      REF ASTREE elifpart = LOC ASTREE ;
      REF ASTREE elsepart = LOC ASTREE ;
      elifpart := NIL ;
      elsepart := NIL ;
      IF thenpart ISNT astreenil
      THEN
        { check if we have any optional elif s }
        IF lookahead(telif)
        THEN
          elifpart := newasnode(telif) ;
          parsetree := serialclause  ;
          IF (parsetree ISNT astreenil) ANDTH lookahead(tthen)
          THEN
            childi OF  elifpart := parsetree ;
            parsetree := serialclause  ;
            IF parsetree ISNT astreenil
            THEN 
              REF ASTREE cursor = LOC ASTREE ;
              childii OF  elifpart := parsetree ;
              cursor := elifpart ;
              WHILE (cursor ISNT astreenil) ANDTH lookahead(telif)
              DO
                succ OF  cursor := newasnode (telif) ;
                cursor := succ OF  cursor ;
                parsetree := serialclause  ;
                IF (parsetree ISNT astreenil) ANDTH lookahead(tthen)
                THEN 
                  childi OF  cursor := parsetree ;
                  parsetree := serialclause ;
                  IF parsetree ISNT astreenil
                  THEN
                    childii OF  cursor := parsetree
                  ELSE
                    nonilerror := FALSE ;
                    cursor := NIL
                  FI
                ELSE
                  nonilerror := FALSE;
                  cursor := NIL
                FI
              OD
            ELSE
              nonilerror := FALSE 
            FI
          ELSE
            nonilerror := FALSE 
          FI  
        FI;
        IF nonilerror ANDTH lookahead (telse) 
        THEN
          elsepart := serialclause ;
          IF (elsepart ISNT astreenil) ANDTH lookahead (tfi)
          THEN
            parsetree := newasnode(ntifclause);
            childi OF  parsetree := ifpart;
            childii OF  parsetree := thenpart;
            childiii OF  parsetree := elifpart;
            childiv OF  parsetree := elsepart
          ELSE
            nonilerror := FALSE
          FI 
        ELSE
          IF lookahead (tfi)
          THEN
            parsetree := newasnode(ntifclause);
            childi OF  parsetree := ifpart;
            childii OF  parsetree := thenpart;
            childiii OF  parsetree := elifpart
          FI
        FI          
      FI
    FI
  FI ;

  IF NOT nonilerror
  THEN
    parsetree := NIL
  FI ;

  IF parsetree IS astreenil 
  THEN
    tokenindex := undoindex 
  FI ;

  parsetree
END ;

PROC  ASTREE loopclause =  ASTREE :
BEGIN
  REF ASTREE parsetree = LOC ASTREE ;
  REF ASTREE forpart   = LOC ASTREE ;
  REF ASTREE frompart  = LOC ASTREE ;
  REF ASTREE bypart    = LOC ASTREE ;
  REF ASTREE topart    = LOC ASTREE ;
  REF ASTREE whilepart = LOC ASTREE ;
  REF ASTREE dopart    = LOC ASTREE ;
  INT undoindex = tokenindex  ;
  REF BOOL nonilerror  = LOC BOOL   ;

  nonilerror := TRUE ;    

  IF lookahead(tfor)
  THEN 
    forpart := identifier  ;
    nonilerror := (forpart ISNT astreenil)
  ELSE
    forpart := NIL
  FI ;

  IF nonilerror ANDTH lookahead(tfrom)
  THEN 
    frompart := unit  ;
    nonilerror := (frompart ISNT astreenil)
  ELSE
    frompart := NIL
  FI;

  IF nonilerror ANDTH lookahead(tby)
  THEN 
    bypart := unit ;
    nonilerror := (bypart ISNT astreenil)
  ELSE
    bypart := NIL
  FI;

  IF nonilerror ANDTH lookahead(tto)
  THEN 
    topart := unit ;
    nonilerror := (topart ISNT astreenil)
  ELSE
    topart := NIL
  FI;

  IF nonilerror ANDTH lookahead(twhile)
  THEN 
    whilepart := serialclause ;
    nonilerror := (whilepart ISNT astreenil)
  ELSE
    whilepart := NIL
  FI;

  IF nonilerror ANDTH lookahead(tdo)
  THEN 
    dopart := serialclause ;
    nonilerror := ((dopart ISNT astreenil) ANDTH lookahead(tod))
  ELSE
    nonilerror := FALSE
  FI ;
  
  IF nonilerror
  THEN
    parsetree := newasnode(ntloopclause) ;
    childi OF  parsetree := forpart;
    childii OF  parsetree := frompart;
    childiii OF  parsetree := bypart;
    childiv OF  parsetree := topart;
    childv OF  parsetree := whilepart;
    childvi OF  parsetree := dopart
  ELSE
    tokenindex := undoindex ;
    parsetree := NIL
  FI;

  parsetree
END ;

PROC  ASTREE strucdisplay =  ASTREE :
BEGIN
  REF ASTREE parsetree = LOC ASTREE ;
  INT undoindex = tokenindex ;

  parsetree := unit  ;
  IF parsetree ISNT astreenil
  THEN 
    REF ASTREE cursor  = LOC ASTREE ;
    REF ASTREE anothercursor = LOC ASTREE ;
    cursor := parsetree ;

    WHILE (cursor ISNT astreenil) ANDTH lookahead(tcomma)
    DO
      anothercursor := cursor ;
      cursor  := unit  ;
      succ OF  anothercursor := cursor
    OD ;

    IF (cursor IS astreenil) OREL NOT lookahead (tend)
    THEN
      tokenindex := undoindex ;
      parsetree := NIL
    FI
  FI ;
  
  parsetree
END ;

PROC  ASTREE generator =  ASTREE :
BEGIN
  REF ASTREE parsetree = LOC ASTREE ;
  REF ASTREE leftpart  = LOC ASTREE ;
  REF ASTREE rightpart = LOC ASTREE ;
  REF ASTREE cursor = LOC ASTREE ;
  INT undoindex = tokenindex ;

    debugprint("inside generator...");

  parsetree := NIL ;
  IF lookahead(tlbracket)
  THEN 
    leftpart := unit  ;
    IF leftpart ISNT astreenil 
    THEN 
      IF lookahead (trbracket) 
      THEN 
        cursor := leftpart ;
        WHILE (leftpart ISNT astreenil) ANDTH lookahead (tlbracket)
        DO
          parsetree := unit ;
          IF (parsetree ISNT astreenil) ANDTH lookahead (trbracket)
          THEN
            succ OF  cursor := parsetree ;
            cursor := parsetree
          ELSE
            leftpart := NIL
          FI
        OD ;
        IF leftpart ISNT astreenil
        THEN
          rightpart := mode  ;
          IF rightpart ISNT astreenil
          THEN 
            parsetree := newasnode (undefined) ;
            childi OF  parsetree := leftpart ;
            childii OF  parsetree := rightpart
          FI
        FI
      FI
    FI
  ELSE
    rightpart := mode  ;
    IF rightpart ISNT astreenil
    THEN 
      parsetree := newasnode (undefined) ;
      childi OF  parsetree := NIL ;
      childii OF  parsetree := rightpart
    FI
  FI ;

  IF parsetree IS astreenil
  THEN
    tokenindex := undoindex
  FI ;

  parsetree
END ;

PROC  ASTREE formula =  ASTREE :
BEGIN
  REF ASTREE parsetree = LOC ASTREE;
  REF ASTREE leftpart = LOC ASTREE;
  REF ASTREE rightpart = LOC ASTREE;
  REF BOOL  nonilerror = LOC BOOL ;
  INT undoindex = tokenindex;

    debugprint("inside formula...");

  leftpart := levelonesubf ;
  IF leftpart ISNT astreenil
  THEN
    parsetree := leveloneop ;
    nonilerror := TRUE ;
    WHILE nonilerror ANDTH (parsetree ISNT astreenil)
    DO
      rightpart := levelonesubf ;
      IF rightpart ISNT astreenil
      THEN
        childi OF  parsetree := leftpart ;
        childii OF  parsetree := rightpart ;
        leftpart := parsetree ;
        parsetree := leveloneop 
      ELSE
        tokenindex := undoindex ;
        nonilerror := FALSE ;
        parsetree := NIL
      FI
    OD ;
    IF nonilerror 
    THEN
      parsetree := leftpart
    ELSE
      parsetree := NIL
    FI
  ELSE
    parsetree := NIL
  FI ;

  parsetree
END ;

PROC  ASTREE unaryop =  ASTREE :
BEGIN
  REF ASTREE parsetree = LOC ASTREE;

    debugprint("inside monadic...");

  IF lookahead (tplus)
  THEN
    parsetree := newasnode (tplus)
  ELSE
    IF lookahead(tminus)
    THEN
      parsetree := newasnode (tminus)
    ELSE
      IF lookahead (tabs)
      THEN
        parsetree := newasnode (tabs)
      ELSE
        IF lookahead (tsign)
        THEN
          parsetree := newasnode (tsign)
        ELSE
          IF lookahead (trepr)
          THEN
            parsetree := newasnode (trepr)
          ELSE
            IF lookahead (tnot)
            THEN
              parsetree := newasnode (tnot)
            ELSE
              IF lookahead (tlwb)
              THEN
                parsetree := newasnode (tlwb)
              ELSE
                IF lookahead (tupb)
                THEN
                  parsetree := newasnode (tupb)
                ELSE parsetree := NIL
                FI
              FI
            FI
          FI
        FI
      FI
    FI
  FI;

  parsetree
END ;

PROC  ASTREE leveloneop =  ASTREE :
BEGIN
  REF ASTREE parsetree = LOC ASTREE;

    debugprint("inside leveloneop...") ;

  IF lookahead (tandth)
  THEN
    parsetree := newasnode (tandth)
  ELSE
    IF lookahead (torel)
    THEN
      parsetree := newasnode (torel)
    ELSE
      parsetree := NIL
    FI
  FI ;

  parsetree
END ;

PROC  ASTREE levelonesubf =  ASTREE :
BEGIN
  REF ASTREE parsetree = LOC ASTREE;
  REF ASTREE leftpart = LOC ASTREE;
  REF ASTREE rightpart = LOC ASTREE;
  REF BOOL nonilerror = LOC BOOL;
  INT undoindex = tokenindex;

    debugprint("inside levelone...");

  leftpart := leveltwosubf ;
  IF leftpart ISNT astreenil
  THEN
    nonilerror := TRUE;
    WHILE nonilerror ANDTH lookahead (tor)
    DO
      rightpart := leveltwosubf ;
      IF rightpart ISNT astreenil
      THEN
        parsetree := newasnode (tor) ;
        childi OF  parsetree := leftpart ;
        childii OF  parsetree := rightpart ;
        leftpart := parsetree
      ELSE
        tokenindex := undoindex ;
        nonilerror := FALSE ;
        parsetree := NIL
      FI
    OD ;
    IF nonilerror 
    THEN
      parsetree := leftpart
    ELSE
      parsetree := NIL
    FI
  ELSE
    parsetree := NIL
  FI ;

  parsetree
END ;

PROC  ASTREE leveltwosubf =  ASTREE :
BEGIN
  REF ASTREE parsetree = LOC ASTREE;
  REF ASTREE leftpart = LOC ASTREE;
  REF ASTREE rightpart = LOC ASTREE;
  REF BOOL nonilerror = LOC BOOL;
  INT undoindex = tokenindex;

    debugprint("inside leveltwo...");

  leftpart := levelthreesubf ;
  IF leftpart ISNT astreenil
  THEN
    nonilerror := TRUE;
    WHILE nonilerror ANDTH lookahead (tand)
    DO
      rightpart := levelthreesubf ;
      IF rightpart ISNT astreenil
      THEN
        parsetree := newasnode (tand) ;
        childi OF  parsetree := leftpart ;
        childii OF  parsetree := rightpart ;
        leftpart := parsetree
      ELSE
        tokenindex := undoindex ;
        nonilerror := FALSE ;
        parsetree := NIL
      FI
    OD;
    IF nonilerror 
    THEN
      parsetree := leftpart
    ELSE
      parsetree := NIL
    FI
  ELSE
    parsetree := NIL
  FI ;

  parsetree
END ;

PROC  ASTREE levelthreesubf =  ASTREE :
BEGIN
  REF ASTREE parsetree = LOC ASTREE;
  REF ASTREE leftpart = LOC ASTREE;
  REF ASTREE rightpart = LOC ASTREE;
  REF BOOL  nonilerror = LOC BOOL;
  INT undoindex = tokenindex;

    debugprint("inside levelthree...");

  leftpart := levelfoursubf ;
  IF leftpart ISNT astreenil
  THEN
    parsetree := levelfourop ;
    nonilerror := TRUE ;
    WHILE nonilerror ANDTH (parsetree ISNT astreenil)
    DO
      rightpart := levelfoursubf ;
      IF rightpart ISNT astreenil
      THEN
        childi OF  parsetree := leftpart ;
        childii OF  parsetree := rightpart ;
        leftpart := parsetree ;
        parsetree := levelfourop 
      ELSE
        tokenindex := undoindex ;
        nonilerror := FALSE ;
        parsetree := NIL
      FI
    OD ;
    IF nonilerror 
    THEN
      parsetree := leftpart
    ELSE
      parsetree := NIL
    FI
  ELSE
    parsetree := NIL
  FI ;

  parsetree
END ;

PROC  ASTREE levelfourop =  ASTREE :
BEGIN
  REF ASTREE parsetree = LOC ASTREE;

    debugprint("inside levelfourop...");

  IF lookahead (teq)
  THEN
    parsetree := newasnode (teq)
  ELSE
    IF lookahead (tneq)
    THEN
      parsetree := newasnode (tneq)
    ELSE
      parsetree := NIL
    FI
  FI ;

  parsetree
END ;

PROC  ASTREE levelfoursubf =  ASTREE :
BEGIN
  REF ASTREE parsetree = LOC ASTREE;
  REF ASTREE leftpart = LOC ASTREE;
  REF ASTREE rightpart = LOC ASTREE;
  REF BOOL  nonilerror = LOC BOOL;
  INT undoindex = tokenindex;

    debugprint("inside levelfour...");

  leftpart := levelfivesubf ;
  IF leftpart ISNT astreenil
  THEN
    parsetree := levelfiveop ;
    nonilerror := TRUE ;
    WHILE nonilerror ANDTH (parsetree ISNT astreenil)
    DO
      rightpart := levelfivesubf ;
      IF rightpart ISNT astreenil
      THEN
        childi OF  parsetree := leftpart ;
        childii OF  parsetree := rightpart ;
        leftpart := parsetree ;
        parsetree := levelfiveop 
      ELSE
        tokenindex := undoindex ;
        nonilerror := FALSE ;
        parsetree := NIL
      FI
    OD ;
    IF nonilerror 
    THEN
      parsetree := leftpart
    ELSE
      parsetree := NIL
    FI
  ELSE
    parsetree := NIL
  FI ;

  parsetree
END ;

PROC  ASTREE levelfiveop =  ASTREE :
BEGIN
  REF ASTREE parsetree = LOC ASTREE;

    debugprint("inside levelfiveop...");

  IF lookahead (tless)
  THEN
    parsetree := newasnode (tless)
  ELSE
    IF lookahead (tgreater)
    THEN parsetree := newasnode(tgreater)
    ELSE
      IF lookahead (tleq)
      THEN
        parsetree := newasnode(tleq)
      ELSE
        IF lookahead (tgeq)
        THEN
          parsetree := newasnode(tgeq)
        ELSE
          parsetree := NIL
        FI
      FI
    FI
  FI;

  parsetree
END ;

PROC  ASTREE levelfivesubf =  ASTREE :
BEGIN
  REF ASTREE parsetree = LOC ASTREE;
  REF ASTREE leftpart = LOC ASTREE;
  REF ASTREE rightpart = LOC ASTREE;
  REF BOOL  nonilerror = LOC BOOL;
  INT undoindex = tokenindex;

    debugprint("inside levelfive...");

  leftpart := levelsixsubf ;
  IF leftpart ISNT astreenil
  THEN
    parsetree := levelsixop ;
    nonilerror := TRUE ;
    WHILE nonilerror ANDTH (parsetree ISNT astreenil)
    DO
      rightpart := levelsixsubf ;
      IF rightpart ISNT astreenil
      THEN
        childi OF  parsetree := leftpart ;
        childii OF  parsetree := rightpart ;
        leftpart := parsetree ;
        parsetree := levelsixop 
      ELSE
        tokenindex := undoindex ;
        nonilerror := FALSE ;
        parsetree := NIL
      FI
    OD ;
    IF nonilerror 
    THEN
      parsetree := leftpart
    ELSE
      parsetree := NIL
    FI
  ELSE
    parsetree := NIL
  FI ;

  parsetree
END ;

PROC  ASTREE levelsixop =  ASTREE :
BEGIN
  REF ASTREE parsetree = LOC ASTREE;

    debugprint("inside lowarith...");

  IF lookahead (tplus)
  THEN
    parsetree := newasnode (tplus)
  ELSE
    IF lookahead (tminus)
    THEN
      parsetree := newasnode (tminus)
    ELSE
      parsetree := NIL
    FI
  FI;

  parsetree
END ;

PROC  ASTREE levelsixsubf =  ASTREE :
BEGIN
  REF ASTREE parsetree = LOC ASTREE;
  REF ASTREE leftpart = LOC ASTREE;
  REF ASTREE rightpart = LOC ASTREE;
  REF BOOL  nonilerror = LOC BOOL;
  INT undoindex = tokenindex;

    debugprint("inside levelsix...");

  leftpart := levelsevensubf ;
  IF leftpart ISNT astreenil
  THEN
    parsetree := levelsevenop ;
    nonilerror := TRUE ;
    WHILE nonilerror ANDTH (parsetree ISNT astreenil)
    DO
      rightpart := levelsevensubf ;
      IF rightpart ISNT astreenil
      THEN
        childi OF  parsetree := leftpart ;
        childii OF  parsetree := rightpart ;
        leftpart := parsetree ;
        parsetree := levelsevenop 
      ELSE
        tokenindex := undoindex ;
        nonilerror := FALSE ;
        parsetree := NIL
      FI
    OD ;
    IF nonilerror 
    THEN
      parsetree := leftpart
    ELSE
      parsetree := NIL
    FI
  ELSE
    parsetree := NIL
  FI ;

  parsetree
END ;

PROC  ASTREE levelsevenop =  ASTREE :
BEGIN
  REF ASTREE parsetree = LOC ASTREE;

    debugprint("inside hightarith...");

  IF lookahead (ttimes)
  THEN parsetree := newasnode (ttimes)
  ELSE
    IF lookahead (tover)
    THEN
      parsetree := newasnode (tover)
    ELSE
      IF lookahead (tmod)
      THEN
        parsetree := newasnode(tmod)
      ELSE parsetree := NIL
      FI
    FI
  FI;

  parsetree
END ;

PROC  ASTREE levelsevensubf =  ASTREE :
BEGIN
  REF ASTREE parsetree = LOC ASTREE;
  REF ASTREE leftpart = LOC ASTREE;
  REF ASTREE rightpart = LOC ASTREE;
  REF BOOL nonilerror = LOC BOOL;
  INT undoindex = tokenindex;

    debugprint("inside levelseven...");

  leftpart := leveleightsubf ;
  IF leftpart ISNT astreenil
  THEN
    nonilerror := TRUE;
    WHILE nonilerror ANDTH lookahead (tpow)
    DO
      rightpart := leveleightsubf ;
      IF rightpart ISNT astreenil
      THEN
        parsetree := newasnode (tpow) ;
        childi OF  parsetree := leftpart ;
        childii OF  parsetree := rightpart ;
        leftpart := parsetree
      ELSE
        tokenindex := undoindex ;
        nonilerror := FALSE ;
        parsetree := NIL
      FI
    OD ;
    IF nonilerror 
    THEN
      parsetree := leftpart
    ELSE
      parsetree := NIL
    FI 
  ELSE
    parsetree := NIL
  FI ;

  parsetree
END ;

PROC  ASTREE leveleightsubf =  ASTREE :
BEGIN
  REF ASTREE parsetree = LOC ASTREE;
  REF ASTREE leftpart = LOC ASTREE;
  REF ASTREE rightpart = LOC ASTREE;
  REF BOOL  nonilerror = LOC BOOL;
  INT undoindex = tokenindex;

    debugprint("inside leveleight...");

  leftpart := levelninesubf ;
  IF leftpart ISNT astreenil
  THEN
    parsetree := levelnineop ;
    nonilerror := TRUE ;
    WHILE nonilerror ANDTH (parsetree ISNT astreenil)
    DO
      rightpart := levelninesubf ;
      IF rightpart ISNT astreenil
      THEN
        childi OF  parsetree := leftpart ;
        childii OF  parsetree := rightpart ;
        leftpart := parsetree ;
        parsetree := levelnineop 
      ELSE
        tokenindex := undoindex ;
        nonilerror := FALSE;
        parsetree := NIL
      FI
    OD ;
    IF nonilerror 
    THEN
      parsetree := leftpart
    ELSE
      parsetree := NIL
    FI
  ELSE
    parsetree := NIL
  FI ;

  parsetree
END ;

PROC  ASTREE levelnineop =  ASTREE :
BEGIN
  REF ASTREE parsetree = LOC ASTREE;

    debugprint("inside levelnineop...");

  IF lookahead (tmax)
  THEN
    parsetree := newasnode (tmax)
  ELSE
    IF lookahead(tmin)
    THEN
      parsetree := newasnode (tmin)
    ELSE
      parsetree := NIL
    FI
  FI ;

  parsetree
END ;

PROC  ASTREE levelninesubf =  ASTREE :
BEGIN
  REF ASTREE parsetree = LOC ASTREE;
  REF ASTREE operand = LOC ASTREE;
  INT undoindex = tokenindex;

    debugprint("inside levelnine...");

  parsetree := unaryop  ;
  IF parsetree ISNT astreenil
  THEN
    operand := secondary  ;
    IF operand ISNT astreenil
    THEN
      childi OF  parsetree := operand
    ELSE
      tokenindex := undoindex ;
      parsetree := NIL
    FI
  ELSE
    parsetree := secondary 
  FI ;

  parsetree 
END ;

PROC  ASTREE modecast =  ASTREE :
BEGIN
  REF ASTREE parsetree = LOC ASTREE ;
  INT undoindex = tokenindex ;
  ASTREE leftpart = mode  ;

  parsetree := NIL ;

  IF leftpart ISNT astreenil
  THEN 
    ASTREE rightpart = enclclause  ;
    IF rightpart ISNT astreenil
    THEN
      parsetree := newasnode (ntmodecast) ;
      childi OF  parsetree := leftpart ;
      childii OF  parsetree := rightpart 
    ELSE
      tokenindex := undoindex
    FI
  FI;

  parsetree
END ;

PROC  ASTREE mode =  ASTREE :
BEGIN
  REF ASTREE parsetree = LOC ASTREE;
  REF ASTREE leftpart = LOC ASTREE;
  REF ASTREE rightpart = LOC ASTREE;
  REF INT modetype = LOC INT;
  INT undoindex = tokenindex;

    debugprint("inside mode...");

  rightpart := NIL ;
  leftpart := user  ;
  IF leftpart IS astreenil
  THEN 
    modetype := undefined ;
    IF lookahead(tref)
    THEN 
      modetype := tref;
      leftpart := mode 
    ELSE 
      IF lookahead (tlbracket)
      THEN 
        rightpart := unit  ;
        IF lookahead (trbracket)
        THEN 
          modetype := tlbracket ;
          leftpart := mode 
        ELSE
          rightpart := NIL
        FI
      ELSE 
        IF lookahead (tstruct)
        THEN 
          IF lookahead (tbegin)
          THEN 
            leftpart := fieldlist  ;
            IF leftpart ISNT astreenil
            THEN 
              IF lookahead (tend)
              THEN 
                modetype := tstruct
              FI
            FI
          FI
        ELSE 
          IF lookahead (tproc)
          THEN 
            modetype := tproc ;
            leftpart := formallist 
          FI
        FI
      FI
    FI ;
    IF (modetype = undefined) OREL (leftpart IS astreenil)
    THEN 
      tokenindex := undoindex ;
      parsetree := NIL
    ELSE 
      parsetree := newasnode (modetype) ;
      childi OF  parsetree := leftpart ;
      childii OF  parsetree := rightpart
    FI
  ELSE
    parsetree := leftpart
  FI;

  parsetree
END ;

PROC  ASTREE fieldlist =  ASTREE :
BEGIN
  REF ASTREE parsetree = LOC ASTREE ;
  REF ASTREE leftpart  = LOC ASTREE ;
  REF ASTREE cursor    = LOC ASTREE ;
  REF BOOL nonilerror  = LOC BOOL   ;
  INT undoindex = tokenindex ;

    debugprint("inside fieldlist...");

  nonilerror := TRUE ;
  leftpart := mode  ;
  IF leftpart ISNT astreenil
  THEN
    cursor := identifier  ;
    IF cursor ISNT astreenil
    THEN
      succ OF  leftpart := cursor ;
      WHILE nonilerror ANDTH lookahead(tcomma)
      DO
        parsetree := mode  ;
        IF parsetree ISNT astreenil
        THEN
          succ OF  cursor := parsetree;
          cursor := parsetree ;
          parsetree := identifier  ;
          IF parsetree ISNT astreenil
          THEN
            succ OF  cursor := parsetree;
            cursor := parsetree
          ELSE
              nonilerror := FALSE 
          FI
        ELSE
          nonilerror := FALSE 
        FI
      OD      
    ELSE
      nonilerror := FALSE
    FI
  ELSE
    nonilerror := FALSE 
  FI ;
  
  IF nonilerror 
  THEN
    parsetree := leftpart
  ELSE
    tokenindex := undoindex ;
    parsetree := NIL
  FI;

  parsetree
END ;

PROC  ASTREE routineval =  ASTREE :
BEGIN

  REF ASTREE parsetree = LOC ASTREE;
 
  REF ASTREE leftpart = LOC ASTREE;
  REF ASTREE rightpart = LOC ASTREE;
  INT undoindex = tokenindex;

    debugprint("inside routinedenotation...");

  parsetree := NIL;  
  leftpart := prototype  ;
  IF (leftpart ISNT astreenil) ANDTH lookahead (tcolon)
  THEN
    rightpart := unit  ;
    IF rightpart ISNT astreenil
    THEN 
      parsetree := newasnode (ntroutineval) ;
      childi OF  parsetree := leftpart;
      childii OF  parsetree := rightpart
    ELSE
      tokenindex := undoindex
    FI
  FI;

  parsetree
END ;

PROC  ASTREE prototype =  ASTREE :
BEGIN
  REF ASTREE parsetree = LOC ASTREE ;
  REF ASTREE leftpart = LOC ASTREE ;
  REF ASTREE rightpart = LOC ASTREE ;
  REF BOOL nonilerror = LOC BOOL ;
  INT undoindex = tokenindex ;

    debugprint("inside prototype...");

  IF lookahead (tbegin)
  THEN 
    leftpart := fieldlist  ;
    nonilerror := ((leftpart ISNT astreenil) ANDTH lookahead (tend))
  ELSE
    nonilerror := TRUE ;
    leftpart := NIL  
  FI ;

  IF nonilerror 
  THEN
    rightpart := mode  ;
    nonilerror := (rightpart ISNT astreenil)
  FI ;

  IF nonilerror
  THEN
    parsetree := newasnode (ntprototype) ;
    childi OF  parsetree := leftpart;
    childii OF  parsetree := rightpart
  ELSE
    tokenindex := undoindex ;
    parsetree := NIL
  FI ;

  parsetree
END ;

PROC  ASTREE formallist =  ASTREE :
BEGIN
  REF ASTREE parsetree = LOC ASTREE ;
  REF ASTREE leftpart  = LOC ASTREE ;
  REF ASTREE rightpart = LOC ASTREE ;
  REF ASTREE cursor    = LOC ASTREE ;
  REF BOOL nonilerror  = LOC BOOL   ;
  INT undoindex = tokenindex ;

    debugprint("inside formallist...");

  nonilerror := TRUE ;
  IF lookahead (tbegin)
  THEN
    leftpart := mode  ;
    IF leftpart ISNT astreenil
    THEN
      cursor := leftpart ;
      WHILE nonilerror ANDTH lookahead(tcomma)
      DO
        parsetree := mode  ;
        IF parsetree ISNT astreenil
        THEN
          succ OF  cursor := parsetree;
          cursor := parsetree
        ELSE
          nonilerror := FALSE 
        FI
      OD ;

      IF nonilerror ANDTH NOT lookahead(tend)
      THEN 
        nonilerror := FALSE
      FI
    ELSE
      nonilerror := FALSE
    FI
  ELSE
    leftpart := NIL 
  FI ;
  
  IF nonilerror
  THEN
    rightpart := mode ;
    nonilerror := (rightpart ISNT astreenil) 
  FI ;

  IF nonilerror 
  THEN 
    parsetree := newasnode (ntformallist) ;
    childi OF  parsetree := leftpart ;
    childii OF  parsetree := rightpart
  ELSE
    tokenindex := undoindex ;
    parsetree := NIL
  FI;

  parsetree
END ;

PROC  ASTREE declaration =  ASTREE :
BEGIN
  REF ASTREE parsetree = LOC ASTREE;

    debugprint("inside declaration...");

  parsetree := usermodedecl  ;
  IF parsetree IS astreenil
  THEN parsetree := identitydecl 
  FI;

  parsetree
END ;

PROC  ASTREE usermodedecl =  ASTREE :
BEGIN
  REF ASTREE parsetree = LOC ASTREE;

  REF ASTREE leftpart = LOC ASTREE;
  REF ASTREE rightpart = LOC ASTREE;
  INT undoindex = tokenindex;

    debugprint("inside modedeclaration...");

  parsetree := NIL ;
  IF lookahead(tmode)
  THEN 
    leftpart := user  ;
    IF (leftpart ISNT astreenil) ANDTH lookahead (teq)
    THEN 
      rightpart := mode  ;
      parsetree := newasnode (ntusermodedecl) ;
      childi OF  parsetree := leftpart;
      childii OF  parsetree := rightpart
    ELSE 
      tokenindex := undoindex 
    FI
  FI;

  parsetree
END ;

PROC  ASTREE identitydecl =  ASTREE :
BEGIN
  REF ASTREE parsetree= LOC ASTREE;
  REF ASTREE leftpart = LOC ASTREE;
  REF ASTREE midpart = LOC ASTREE;
  REF ASTREE rightpart = LOC ASTREE;
  INT undoindex = tokenindex;

    debugprint("inside identitydeclaration...");

  parsetree := NIL ;
  leftpart := mode  ;
  IF leftpart ISNT astreenil
  THEN 
    midpart := identifier  ;
    IF (midpart ISNT astreenil) ANDTH  lookahead (teq)
    THEN 
      rightpart := unit  ;
      IF rightpart ISNT astreenil
      THEN
        parsetree := newasnode (ntidentitydecl) ;
        childi OF  parsetree := leftpart ;
        childii OF  parsetree := midpart ;
        childiii OF  parsetree := rightpart
      FI
    FI
  FI ;

  IF parsetree IS astreenil
  THEN 
    tokenindex := undoindex
  FI;

  parsetree
END ;

  REF ASTREE myparsetree = LOC ASTREE ;
  SKIP ;


  readtokens ;




































  tokenindex := 0 ;
  lastreadindex := 0 ;

  myparsetree := program  ;
  IF (myparsetree ISNT astreenil) ANDTH lookahead(endoftokens) 
  THEN
    IF debugging 
    THEN
      fputs(1,  "Recognized a program") ;
      fputnl(1) 
    FI ;
    writeast (myparsetree, 0)
  ELSE
    error("Parse error") ;
    exit(1)
  FI ;

















  1
END