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 ASTREE = REF ASNODE ;

MODE MODETREE = REF MODENODE ;

MODE MODESLIST = REF MODESNODE ;

MODE IDLIST = REF IDNODE ;

MODE CLIST = REF CNODE ;

MODE MODECOERLIST = REF MODECOERNODE ;

MODE DOUBLEMCLIST = REF DOUBLEMCNODE ;

MODE ASNODE = STRUCT ( INT tag, REF [] CHAR semval, MODETREE themode,
                     ASTREE childi, ASTREE childii, ASTREE childiii,
                     ASTREE childiv, ASTREE childv, ASTREE childvi,
                     ASTREE succ, INT blocknum, INT context,
                     CLIST coercionstodo);

MODE MODENODE = STRUCT ( INT tag, INT size, INT alignment, MODETREE
                       innermode, MODESLIST argsmode, IDLIST fieldlist);

MODE MODESNODE = STRUCT ( MODETREE themode, MODESLIST succ);

MODE IDNODE = STRUCT ( REF [] CHAR theid, INT offset, MODETREE themode,
                    ASTREE thevalue, IDLIST succ);

MODE CNODE = STRUCT ( INT thecoercion, CLIST succ);

MODE MODECOERNODE = STRUCT ( MODETREE themode, CLIST coercionstodo,
                           MODECOERLIST succ);

MODE USERDEFMODE = STRUCT ( REF [] CHAR usermodeind, MODETREE definedmode);

MODE BLOCKINFO = STRUCT ( INT parent, INT maxoffset,
                        ASTREE blocksubtree, IDLIST variables);

MODE DOUBLEMCNODE = STRUCT ( MODECOERLIST thelist, DOUBLEMCLIST succ);

REF [] CHAR stringnil = REF [] CHAR ( NIL) ;
ASTREE astreenil = ASTREE ( NIL) ;
MODETREE modetreenil = MODETREE ( NIL) ;
MODESLIST modeslistnil = MODESLIST ( NIL) ;
IDLIST idlistnil = IDLIST ( NIL) ;
CLIST clistnil = CLIST ( NIL);
MODECOERLIST modecoerlistnil = MODECOERLIST ( NIL) ;
DOUBLEMCLIST doublemclistnil = DOUBLEMCLIST ( NIL) ;


{ these are codes for the tag field of ASNODE s }
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;

{ these are codes for the tag field of MODENODE s }
INT boolmode = 129;
INT intmode = 130;
INT charmode = 131;
INT voidmode = 132;
INT errormode = 133;
INT refmode = 134;
INT rowmode = 135;
INT structmode = 136;
INT procmode = 137;
INT whatever = 138;

{ these are codes for the coercions and the contexts of algol68-Nix }
INT voiding = 3;
INT dereferencing = 2;
INT weakdereferencing = 1;
INT deproceduring = 0;

INT strong = 4;
INT meek = 3;
INT weak = 2;
INT soft = 1;
INT none = 0;
{ we also use undefined as a special context }

{ global variables used to do simple stack-wise register allocation }
REF INT newtemporary = LOC INT;

{ global variables used to uniquely identify labels }
REF INT newlabel = LOC INT;

{ this constant denotates the displacement in each activation record }
{ due to the presence of the organizational cells ie three octa s }
INT displacement = 24 ;

{ this constant specifies the maximum width of label in the MMS output }
INT labelwidth = 32 ;

BOOL debugging = FALSE ;


  { 256 is an hardwired constant that is also used in the procs }
  { initusermodetable and gatherusermodes }
REF [] USERDEFMODE usermodetable = LOC [256] USERDEFMODE;

  { 4096 is an hardwired constant that is also used in the procs }
  { buildblocktable }
REF [] BLOCKINFO blocktable = LOC [4096] BLOCKINFO;

REF INT nextblocknum = LOC INT ;


PROC( MODECOERLIST) VOID writemclist = ( MODECOERLIST themodecoerc) VOID :
BEGIN
  REF CLIST acoerc = LOC CLIST;
 
  IF themodecoerc ISNT NIL
  THEN writemodetree(themode OF themodecoerc, 0);
        acoerc := coercionstodo OF themodecoerc;
        WHILE acoerc ISNT NIL
        DO
          fputs(1, "$ ");
          fputint(1, thecoercion OF acoerc);
          fputs(1, " $ ->");
          acoerc := succ OF acoerc
        OD;
        fputs(1, ".");
        fputnl(1);
        writemclist(succ OF themodecoerc)
  ELSE fputs(1, "-");
       fputnl(1)
  FI

END;


PROC( CLIST) VOID writeclist = ( CLIST thecoerc) VOID :

BEGIN
  REF CLIST acoerc = LOC CLIST;
 
        acoerc := thecoerc;
        WHILE acoerc ISNT NIL
        DO
          fputs(1, "$ ");
          fputint(1, thecoercion OF acoerc);
          fputs(1, " $ ->");
          acoerc := succ OF acoerc
        OD;
        fputs(1, ".");
        fputnl(1)

END;







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

PROC( REF [] CHAR) INT asciitoint = ( REF [] CHAR textual) INT :
BEGIN
  REF INT result = LOC INT;
  REF INT nextdigit = LOC INT;
  REF INT i = LOC INT;

  result := 0;
  i := 0;
  nextdigit := ABS textual[i];
  WHILE nextdigit > 0
  DO
    result := result * 10 + nextdigit - ABS '0' ;
    i := i + 1 ;
    nextdigit := ABS textual[i]
  OD;

  result
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( REF [] CHAR) VOID error = ( REF [] CHAR msg) VOID :
BEGIN
  fputs(1, msg) ;
  fputnl(1) ;

  exit(1)
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 ;
  themode OF leafnode := NIL ;

  blocknum OF leafnode := -1 ;
  context OF leafnode := none;
  coercionstodo OF leafnode := NIL ;

  leafnode
END ;

PROC( INT) MODETREE newmodenode = ( INT atag) MODETREE :
BEGIN
  REF MODENODE leafnode = HEAP MODENODE ;

  tag OF leafnode := atag ;

  innermode OF leafnode := NIL ;
  argsmode OF leafnode := NIL ;
  fieldlist OF leafnode := NIL ;

  { now we set the size and the alignment for this mode }
  IF atag = refmode
  THEN
    { ref are mapped onto octa and are aligned as octas }
    size OF leafnode := 8 ;
    alignment OF leafnode := 8
  ELSE
    IF atag = intmode
    THEN
      { int are mapped onto tetra and are aligned as tetras }
      size OF leafnode := 4 ;
      alignment OF leafnode := 4
    ELSE
      IF atag = charmode
      THEN
        { char are mapped onto byte and are aligned as bytes }
        size OF leafnode := 1 ;
        alignment OF leafnode := 1
      ELSE
        IF atag = boolmode
        THEN
          { bool are mapped onto byte and are aligned as bytes }
          size OF leafnode := 1 ;
          alignment OF leafnode := 1
        ELSE
          { among the others voidmode and procmode must take zeros }
          { struct and row will be fixed up later }
          size OF leafnode := 0 ;
          alignment OF leafnode := 0
        FI
      FI
    FI
  FI ;

  leafnode
END ;

PROC( MODETREE) MODESLIST newmodesnode = ( MODETREE amode) MODESLIST :
BEGIN
  REF MODESNODE leafnode = HEAP MODESNODE ;

  themode OF leafnode := amode ;
  succ OF leafnode := NIL ;

  leafnode
END ;

PROC IDLIST newidnode = IDLIST :
BEGIN
  REF IDNODE leafnode = HEAP IDNODE ;

  theid OF leafnode := HEAP [256] CHAR ;
  offset OF leafnode := 0 ;
  themode OF leafnode := NIL ;
  thevalue OF leafnode := NIL ;
  succ OF leafnode := NIL ;

  leafnode
END ;

PROC( INT) CLIST newcnode = ( INT acoercion) CLIST :
BEGIN
  REF CNODE leafnode = HEAP CNODE ;

  thecoercion OF leafnode := acoercion ;
  succ OF leafnode := NIL ;

  leafnode
END ;

PROC MODECOERLIST newmodecoernode = MODECOERLIST :
BEGIN
  REF MODECOERNODE leafnode = HEAP MODECOERNODE ;

  themode OF leafnode := NIL ;
  coercionstodo OF leafnode := NIL ;
  succ OF leafnode := NIL ;

  leafnode
END ;

PROC ASTREE readast = ASTREE :
BEGIN
  REF [] CHAR oneline = LOC [256] CHAR;
  REF INT onelineindex = LOC INT;
  REF [] CHAR data = LOC [256] CHAR;
  REF INT dataindex = LOC INT;
  REF ASTREE resulttree = LOC ASTREE;
  REF ASTREE next = LOC ASTREE;
  REF BOOL done = LOC BOOL;

  fgets(0, oneline, 256) ;
  onelineindex := 0 ;

  WHILE ABS oneline[onelineindex] <= 32
  DO
    IF ABS oneline[onelineindex] = 0
    THEN
      fgets(0, oneline, 256) ;
      onelineindex := 0
    ELSE
      onelineindex := onelineindex + 1
    FI
  OD;

  IF ABS oneline[onelineindex] = ABS '-'
  THEN
    onelineindex := onelineindex + 1;
    resulttree := NIL
  ELSE
    IF ABS oneline[onelineindex] = ABS '('
    THEN
      onelineindex := onelineindex + 1;
      dataindex := 0;
      WHILE (ABS oneline[onelineindex] >= ABS '0') ANDTH
            (ABS oneline[onelineindex] <= ABS '9')
      DO
        data[dataindex] := oneline[onelineindex];
        dataindex := dataindex + 1 ;
        onelineindex := onelineindex + 1
      OD;
      data[dataindex] := REPR 0 ;
      resulttree := newasnode(asciitoint(data));
      IF ABS oneline[onelineindex] = ABS ' '
      THEN
        onelineindex := onelineindex + 1;
        dataindex := 0;
        done := TRUE;
        WHILE done
        DO
          IF (ABS oneline[onelineindex] = ABS ')') ANDTH
             ((ABS oneline[onelineindex+1] = 10) OREL
              ((ABS oneline[onelineindex+1] = ABS ' ') ANDTH
               (ABS oneline[onelineindex+2] = ABS '-') ANDTH
               (ABS oneline[onelineindex+3] = ABS '>') ANDTH
               (ABS oneline[onelineindex+4] = 10)))
          THEN
            data[dataindex] := REPR 0;
            onelineindex := onelineindex + 1;
            done := FALSE
          ELSE
            data[dataindex] := oneline[onelineindex] ;
            dataindex := dataindex + 1 ;
            onelineindex := onelineindex + 1
          FI
        OD ;
        semval OF resulttree := HEAP [256] CHAR;
        stringcopy(semval OF resulttree, data)
      ELSE
        childi OF resulttree := readast ;
        childii OF resulttree := readast ;
        childiii OF resulttree := readast ;
        childiv OF resulttree := readast ;
        childv OF resulttree := readast ;
        childvi OF resulttree := readast ;

        fgets(0, oneline, 256);
        onelineindex := 0;

        WHILE ABS oneline[onelineindex] <= 32
        DO
          IF ABS oneline[onelineindex] = 0
          THEN
            fgets(0, oneline, 256);
            onelineindex := 0
          ELSE
            onelineindex := onelineindex + 1
          FI
        OD;
        IF ABS oneline[onelineindex] /= ABS ')'
        THEN
          error("PANIC: expecting a close paren")
        ELSE
          onelineindex := onelineindex + 1
        FI
      FI ;
      IF (ABS oneline[onelineindex] = ABS ' ') ANDTH
         (ABS oneline[onelineindex+1] = ABS '-') ANDTH
         (ABS oneline[onelineindex+2] = ABS '>')
      THEN
        onelineindex := onelineindex + 3 ;
        next := readast ;
        succ OF resulttree := next
      FI
    ELSE
      error("PANIC: expecting an open paren or a dash")
    FI
  FI;
  
  IF debugging ANDTH (resulttree ISNT astreenil)
  THEN
    fputs(1, "Created a node of tag: ") ;
    fputint(1, tag OF resulttree) ;
    fputnl(1)
  FI;

  resulttree
END ;

PROC( ASTREE) MODETREE packmodetree = ( ASTREE astree) MODETREE :
BEGIN
  REF MODETREE newtree = LOC MODETREE ;
  REF MODESLIST argscursor = LOC MODESLIST ;
  REF ASTREE modecursor = LOC ASTREE ;
  REF IDLIST idcursor = LOC IDLIST ;
  REF INT anindex = LOC INT ;
  INT thetag = tag OF astree ;
  
  IF thetag = tbasemode
  THEN
    IF stringcmp(semval OF astree, "BOOL") = 0
    THEN
      newtree := newmodenode(boolmode)
    ELSE
      IF stringcmp(semval OF astree, "CHAR") = 0
      THEN
        newtree := newmodenode(charmode)
      ELSE
        IF stringcmp(semval OF astree, "INT") = 0
        THEN
          newtree := newmodenode(intmode)
        ELSE
          IF stringcmp(semval OF astree, "VOID") = 0
          THEN
            newtree := newmodenode(voidmode)
          ELSE
            { here we have a user defined mode }
            { perform a table lookup for the associated modetree }
            { dont worry if what we find is just a placeholder }
            { because it will be fixed up by fixusermodes }
            anindex := 0 ;
            WHILE (usermodeind OF usermodetable[anindex] ISNT stringnil) ANDTH
                  (stringcmp(usermodeind OF usermodetable[anindex],
                             semval OF astree) /= 0)
            DO
              anindex := anindex + 1
            OD ;
            IF usermodeind OF usermodetable[anindex] IS stringnil
            THEN
              { this should never happen }
              error("PANIC: I can't find anything in this table!!")
            ELSE
              newtree := definedmode OF usermodetable[anindex]
            FI
          FI
        FI
      FI
    FI
  ELSE
    IF thetag = tref
    THEN
      newtree := newmodenode(refmode) ;
      innermode OF newtree :=
         packmodetree (childi OF astree)
    ELSE
      IF thetag = tlbracket
      THEN
        newtree := newmodenode(rowmode) ;
        innermode OF newtree :=
           packmodetree (childi OF astree) ;
        IF childii OF astree IS astreenil
        THEN
          size OF newtree := 0
        ELSE
          IF tag OF childii OF astree = tintconst
          THEN
            size OF newtree :=
              asciitoint (semval OF childii OF astree)
          ELSE
            error("Semantic Error: can only specify integer constant as array size")
          FI
        FI ;
        { set the alignment to be the same as that of the innermode }
        alignment OF newtree :=
           alignment OF innermode OF newtree ;
        size OF newtree := size OF newtree *
                                        size OF innermode OF newtree
      ELSE
        IF thetag = tstruct
        THEN
          REF INT structsize = LOC INT ;
          REF INT structalignment = LOC INT ;
          REF INT tmpalignment = LOC INT ;

          newtree := newmodenode(structmode) ;
          modecursor := childi OF astree ;
          fieldlist OF newtree := newidnode ;
          idcursor := fieldlist OF newtree ;
          themode OF idcursor :=
             packmodetree (modecursor) ;
          { set up the initial value for the alignment and size of this struct }
          structsize := size OF themode OF idcursor ;
          structalignment := alignment OF
                                        themode OF idcursor ;

          modecursor := succ OF modecursor ;
          stringcopy(theid OF idcursor,
                     semval OF modecursor) ;

          modecursor := succ OF modecursor ;
          WHILE modecursor ISNT astreenil
          DO
            succ OF idcursor := newidnode ;
            idcursor := succ OF idcursor ;
            themode OF idcursor :=
               packmodetree (modecursor) ;
            { figure out the offset for this field }
            tmpalignment := alignment OF themode OF idcursor ;
            structsize := ( ( structsize + tmpalignment - 1 ) OVER
                                        tmpalignment
                                      ) * tmpalignment ;
                                      
            offset OF idcursor := structsize ;
            { now update both the alignment and size of this struct }
            structsize := structsize +
                                      size OF themode OF idcursor ;
            IF tmpalignment > structalignment
            THEN
              structalignment := tmpalignment
            FI ;

            modecursor := succ OF modecursor ;
            stringcopy(theid OF idcursor,
                       semval OF modecursor) ;
            modecursor := succ OF modecursor
          OD ;
          { before setting the size of this struct provide for additional padding }
          { this is required to ensure that the size is a multiple of the alignment }
          structsize := ( ( structsize + structalignment - 1 ) OVER
                                      structalignment
                                    ) * structalignment ;
          size OF newtree := structsize ;
          alignment OF newtree := structalignment
        ELSE
          IF thetag = tproc
          THEN
            newtree := newmodenode(procmode) ;
            { an old proc mode has one child that has two children: }
            { an optional list of args mode ... }
            modecursor := childi OF childi OF astree ;
            IF modecursor ISNT astreenil
            THEN
              argsmode OF newtree
                 := newmodesnode (packmodetree (modecursor)) ;
              argscursor := argsmode OF newtree ;
              modecursor := succ OF modecursor ;
              WHILE modecursor ISNT astreenil
              DO
                succ OF argscursor
                   := newmodesnode (packmodetree (modecursor)) ;
                argscursor := succ OF argscursor ;
                modecursor := succ OF modecursor
              OD
            FI ;
            { ... and the return mode }
            innermode OF newtree :=
               packmodetree (childii OF childi OF astree)
          ELSE
            newtree := newmodenode(errormode) ;
            debugprint("error while converting modes")
          FI
        FI
      FI
    FI
  FI ;

  newtree

END ;

PROC( MODETREE, MODETREE) BOOL modecmp = ( MODETREE amode, MODETREE anothermode) BOOL :
BEGIN
  REF BOOL answer = LOC BOOL ;
  REF INT atag = LOC INT ;
  REF MODESLIST alist = LOC MODESLIST ;
  REF MODESLIST anotherlist = LOC MODESLIST ;
  REF IDLIST anidcursor = LOC IDLIST ;
  REF IDLIST anotheridcursor = LOC IDLIST ;

  IF (amode IS modetreenil) ANDTH (anothermode IS modetreenil)
  THEN
    answer := TRUE
  ELSE
    IF (amode ISNT modetreenil) ANDTH (anothermode ISNT modetreenil)
    THEN
      IF (tag OF amode = tag OF anothermode)
      THEN
        { before going on we check whether the two modetrees are the same }
        { this could happen if they are both usermode taken from usermodetable }
        IF amode IS anothermode
        THEN
          answer := TRUE
        ELSE
          { basis cases do not need special care }
          { neither do ref or row so we just check for struct and proc mode }
          atag := tag OF amode ;
          IF atag = procmode
          THEN
            IF modecmp (innermode OF amode,
                        innermode OF anothermode)
            THEN
              alist := argsmode OF amode ;
              anotherlist := argsmode OF anothermode ;
              answer := TRUE ;

              WHILE answer ANDTH
                    (alist ISNT modeslistnil) ANDTH
                    (anotherlist ISNT modeslistnil)
              DO
                answer := modecmp (themode OF alist,
                                        themode OF anotherlist) ;
                alist := succ OF alist ;
                anotherlist := succ OF anotherlist
              OD ;

              IF answer ANDTH
                 ((alist ISNT modeslistnil) OREL
                  (anotherlist ISNT modeslistnil))
              THEN
                answer := FALSE
              FI
            ELSE
              answer := FALSE
            FI
          ELSE
            IF atag = structmode
            THEN
              anidcursor := fieldlist OF amode ;
              anotheridcursor := fieldlist OF anothermode ;
              answer := TRUE ;
              WHILE answer ANDTH
                    (anidcursor ISNT idlistnil) ANDTH
                    (anotheridcursor ISNT idlistnil)
              DO
                IF stringcmp (theid OF anidcursor,
                              theid OF anotheridcursor) = 0
                THEN
                  answer := modecmp (themode OF anidcursor,
                                        themode OF anotheridcursor) ;
                  IF answer
                  THEN
                    anidcursor := succ OF anidcursor ;
                    anotheridcursor := succ OF anotheridcursor
                  FI
                ELSE
                  answer := FALSE
                FI
              OD
            ELSE
              { now we just need to recurse on the inner mode }
              answer := modecmp (innermode OF amode,
                                        innermode OF anothermode)
            FI
          FI
        FI
      ELSE
        { even if the tags are different they could still be the same }
        { because one of them is the special mode whatever }
        IF (tag OF amode = whatever) OREL
           (tag OF anothermode = whatever)
        THEN
          answer := TRUE
        ELSE
          answer := FALSE
        FI
      FI
    ELSE
      answer := FALSE
    FI
  FI ;

  answer
END ;

PROC( ASTREE) VOID gatherusermodes = ( ASTREE parsetree) VOID :
BEGIN
  REF INT anindex = LOC INT ;

  IF tag OF parsetree = ntusermodedecl
  THEN

    { first we check whether we already met this guy }
    anindex := 0 ;

    WHILE (usermodeind OF usermodetable[anindex] ISNT stringnil) ANDTH
          (stringcmp(usermodeind OF usermodetable[anindex],
                     semval OF childi OF parsetree) /= 0)
    DO
      anindex := anindex + 1
    OD ;

    IF anindex < 256
    THEN
      IF usermodeind OF usermodetable[anindex] IS stringnil
      THEN

        { first time we see this user defined mode indicant so we add it }
        usermodeind OF usermodetable[anindex] := HEAP [256] CHAR ;
        stringcopy(usermodeind OF usermodetable[anindex],
                   semval OF childi OF parsetree) ;
        { for now we just stick a dummy mode tree in the table }
        definedmode OF usermodetable[anindex] := newmodenode(errormode)
        { this will be finished up by fixupusermodes }
        { this is done so that recursive types do find something in the }
        { table even before the call is completed }
      ELSE
        { we are trying to redefine a mode indicant - this is bad }
        fputs(1, "Semantic Error: ") ;
        fputs(1, semval OF childi OF parsetree) ;
        error(": cannot redefine user modes in the same program!")
      FI
    ELSE
      error("PANIC: too many user defined modes!!!")
    FI
  ELSE
    IF childi OF parsetree ISNT astreenil
    THEN
      gatherusermodes (childi OF parsetree)
    FI ;
    IF childii OF parsetree ISNT astreenil
    THEN
      gatherusermodes (childii OF parsetree)
    FI ;
    IF childiii OF parsetree ISNT astreenil
    THEN
      gatherusermodes (childiii OF parsetree)
    FI ;
    IF childiv OF parsetree ISNT astreenil
    THEN
      gatherusermodes (childiv OF parsetree)
    FI ;
    IF childv OF parsetree ISNT astreenil
    THEN
      gatherusermodes (childv OF parsetree)
    FI ;
    IF childvi OF parsetree ISNT astreenil
    THEN
      gatherusermodes (childvi OF parsetree)
    FI
  FI ;
  IF succ OF parsetree ISNT astreenil
  THEN
   gatherusermodes (succ OF parsetree)
  FI
END ;

PROC( ASTREE) VOID fixusermodes = ( ASTREE parsetree) VOID :
BEGIN
  REF MODETREE tmpmode = LOC MODETREE;
  REF MODETREE auxmode = LOC MODETREE;
  REF INT anindex = LOC INT ;

  IF tag OF parsetree = ntusermodedecl
  THEN
    { search for the placeholder for this user defined mode indicant }
    anindex := 0 ;
    WHILE (usermodeind OF usermodetable[anindex] ISNT stringnil) ANDTH
          (stringcmp(usermodeind OF usermodetable[anindex],
                     semval OF childi OF parsetree) /= 0)
    DO
      anindex := anindex + 1
    OD ;
    IF usermodeind OF usermodetable[anindex] IS stringnil
    THEN
      { this should never happen }
      error("PANIC: I can't find anything in this table!!")
    ELSE
      { during the gather phase we just put a placeholder in this entry }
      { of the table so now we need to do some fixup }
      { first we call packmodetree to translate the mode reprsentation }

      IF debugging
      THEN
        fputs(1, "I'm about to fix up the definition of ") ;
        fputs(1, semval OF childi OF parsetree) ;
        fputnl(1)
      FI ;

      auxmode := packmodetree (childii OF parsetree) ;

      { then we copy all fields from the above call into the dummy node }
      { present in the table }
      tmpmode := definedmode OF usermodetable[anindex] ;
      tag OF tmpmode := tag OF auxmode ;
      size OF tmpmode := size OF auxmode ;
      alignment OF tmpmode := alignment OF auxmode ;
      innermode OF tmpmode := innermode OF auxmode ;
      argsmode OF tmpmode := argsmode OF auxmode ;
      fieldlist OF tmpmode := fieldlist OF auxmode ;
      { now everything should be fine }

      { we also stick the mode just computed in the field the mode of }
      { both children of the current node in the parsetree }
      themode OF childi OF parsetree := auxmode ;
      themode OF childii OF parsetree := auxmode
    FI
  ELSE
    { in order to traverse the whole tree we follow all the pointers }
    IF childi OF parsetree ISNT astreenil
    THEN
      fixusermodes (childi OF parsetree)
    FI ;
    IF childii OF parsetree ISNT astreenil
    THEN
      fixusermodes (childii OF parsetree)
    FI ;
    IF childiii OF parsetree ISNT astreenil
    THEN
      fixusermodes (childiii OF parsetree)
    FI ;
    IF childiv OF parsetree ISNT astreenil
    THEN
      fixusermodes (childiv OF parsetree)
    FI ;
    IF childv OF parsetree ISNT astreenil
    THEN
      fixusermodes (childv OF parsetree)
    FI ;
    IF childvi OF parsetree ISNT astreenil
    THEN
      fixusermodes (childvi OF parsetree)
    FI
  FI ;
  IF succ OF parsetree ISNT astreenil
  THEN
    fixusermodes (succ OF parsetree)
  FI
END ;

PROC( ASTREE) IDLIST gatheridlist = ( ASTREE ablock) IDLIST :
BEGIN
  REF IDLIST theidlist = LOC IDLIST ;
  REF MODETREE auxmode = LOC MODETREE ;

  IF tag OF ablock = ntidentitydecl
  THEN
    IF debugging
    THEN
      fputs(1, "I'm about to consider the declaration of ") ;
      fputs(1, semval OF childii OF ablock) ;
      fputnl(1)
    FI ;

    theidlist := newidnode ;
    stringcopy(theid OF theidlist,
               semval OF childii OF ablock) ;
    { pack the mode tree for the mode indicant ... }
    auxmode := packmodetree (childi OF ablock) ;
    { ... and stick it both in the mode indicant itself ... }
    themode OF childi OF ablock := auxmode ;
    { ... and the identifier being declared }
    themode OF childii OF ablock := auxmode ;
    { Now fill up the entry in the idlist }
    themode OF theidlist := auxmode ;
    thevalue OF theidlist := childiii OF ablock;
    IF succ OF ablock ISNT astreenil
    THEN
       succ OF theidlist :=
          gatheridlist (succ OF ablock)
    FI
  ELSE
    { we need to analyze only this block so we just follow the succ pointer }
    IF succ OF ablock ISNT astreenil
    THEN
      theidlist := gatheridlist (succ OF ablock)
    ELSE
      theidlist := NIL
    FI
  FI ;

  theidlist
END ;

PROC( ASTREE) VOID gatherblock = ( ASTREE parsetree) VOID :
BEGIN
  REF ASTREE cursor = LOC ASTREE ;
  REF IDLIST idcursor = LOC IDLIST ;
  REF INT definedblock = LOC INT ;
  REF MODETREE auxmode = LOC MODETREE;

  INT thetag = tag OF parsetree ;

  IF thetag = ntroutineval
  THEN
    { create a new entry in the block table }
    parent OF blocktable[nextblocknum] :=
       blocknum OF parsetree ;
    blocksubtree OF blocktable[nextblocknum] := parsetree ;
    { since routine denotation will cause an activation record to be }
    { created on the control stack when evaluated we can initialize }
    { its maxoffset to displacement which is a constant that is defined }
    { so as to skip the space occupied by organizational cells }
    maxoffset OF blocktable[nextblocknum] := displacement ;

    { now we examine the prototype to determine which identifiers }
    { are being introduced and their respective modes }
    cursor := childi OF childi OF parsetree ;
    IF cursor ISNT astreenil
    THEN
      variables OF blocktable[nextblocknum] := newidnode ;
      idcursor := variables OF blocktable[nextblocknum] ;
      { pack the mode tree for the mode indicant ... }
      auxmode := packmodetree (cursor) ;
      { ... and stick it both in the mode indicant itself ... }
      themode OF cursor := auxmode ;
      { ... and the identifier being declared }
      cursor := succ OF cursor ;
      themode OF cursor := auxmode ;
      { Now fill up the entry in the idlist }
      themode OF idcursor := auxmode ;
      stringcopy(theid OF idcursor,
                 semval OF cursor) ;
      cursor := succ OF cursor ;
      WHILE cursor ISNT astreenil
      DO
        succ OF idcursor := newidnode ;
        idcursor := succ OF idcursor ;
        { pack the mode tree for the mode indicant ... }
        auxmode := packmodetree (cursor) ;
        { ... and stick it both in the mode indicant itself ... }
        themode OF cursor := auxmode ;
        { ... and the identifier being declared }
        cursor := succ OF cursor ;
        themode OF cursor := auxmode ;
        { Now fill up the entry in the idlist }
        themode OF idcursor := auxmode ;
        stringcopy(theid OF idcursor,
                   semval OF cursor) ;
        cursor := succ OF cursor
      OD
    FI ;

    { set the block number in the two children }
    blocknum OF childi OF parsetree :=
       blocknum OF parsetree ;
    blocknum OF childii OF parsetree :=
       nextblocknum ;

    { advance the index to the next unused block entry }
    nextblocknum := nextblocknum + 1 ;

    { recurse on the prototype of the procedure }
    gatherblock(childi OF parsetree) ;

    { recurse on the body of the procedure }
    gatherblock(childii OF parsetree)
  ELSE
    IF thetag = ntclosedclause
    THEN
      { create a new entry in the block table }
      parent OF blocktable[nextblocknum] :=
         blocknum OF parsetree ;
      blocksubtree OF blocktable[nextblocknum] := parsetree ;
      variables OF blocktable[nextblocknum] :=
         gatheridlist (childi OF parsetree) ;

      blocknum OF childi OF parsetree
         := nextblocknum ;

      nextblocknum := nextblocknum + 1 ;

      { recurse on the underlying serial clause }
      gatherblock(childi OF parsetree)
    ELSE
      IF thetag = ntloopclause
      THEN
        { first check for the presence of the for induction variable }
        IF childi OF parsetree ISNT astreenil
        THEN
          definedblock := nextblocknum ;

          { this block introduces the integer induction variable }
          parent OF blocktable[nextblocknum] :=
             blocknum OF parsetree ;
          blocknum OF childi OF parsetree :=
             definedblock ;
          blocksubtree OF blocktable[nextblocknum] := parsetree ;
          variables OF blocktable[nextblocknum] := newidnode ;
          idcursor := variables OF blocktable[nextblocknum] ;
          stringcopy(theid OF idcursor,
                     semval OF childi OF parsetree) ;
          themode OF idcursor := newmodenode(intmode) ;

          { attach the mode INT also to the induction variable }
          themode OF childi OF parsetree :=
             themode OF idcursor ;

          nextblocknum := nextblocknum + 1
        ELSE
          definedblock := blocknum OF parsetree
        FI ;

        { now recurse on the optional FROM and BY and TO units }
        IF childii OF parsetree ISNT astreenil
        THEN
          blocknum OF childii OF parsetree :=
             definedblock ;
          gatherblock(childii OF parsetree)
        FI;

        IF childiii OF parsetree ISNT astreenil
        THEN
          blocknum OF childiii OF parsetree :=
             definedblock ;
          gatherblock(childiii OF parsetree)
        FI;

        IF childiv OF parsetree ISNT astreenil
        THEN
          blocknum OF childiv OF parsetree :=
             definedblock ;
          gatherblock(childiv OF parsetree)
        FI ;

        { if there is a while clause then fix it up now }
        IF childv OF parsetree ISNT astreenil
        THEN
          parent OF blocktable[nextblocknum] :=
             definedblock ;
          blocksubtree OF blocktable[nextblocknum] :=
             childv OF parsetree ;
          variables OF blocktable[nextblocknum] :=
             gatheridlist (childv OF parsetree) ;

          blocknum OF childv OF parsetree :=
             nextblocknum ;

          definedblock := nextblocknum ;

          nextblocknum := nextblocknum + 1 ;

          { recurse on the while serial clause }
          gatherblock(childv OF parsetree)
        FI ;

        { prepare the entry for the serial clause in the do part }
        parent OF blocktable[nextblocknum] :=
           definedblock ;
        blocksubtree OF blocktable[nextblocknum] :=
           childvi OF parsetree ;
        variables OF blocktable[nextblocknum] :=
           gatheridlist (childvi OF parsetree) ;

        blocknum OF childvi OF parsetree
           := nextblocknum ;

        nextblocknum := nextblocknum + 1 ;

        { recurse on the do serial clause }
        gatherblock(childvi OF parsetree)
      ELSE
        IF thetag = ntifclause
        THEN
          { create a new entry for the ifcondition serial clause }
          parent OF blocktable[nextblocknum] :=
             blocknum OF parsetree ;
          blocksubtree OF blocktable[nextblocknum] :=
             childi OF parsetree ;
          variables OF blocktable[nextblocknum] :=
             gatheridlist (childi OF parsetree) ;

          blocknum OF childi OF parsetree
             := nextblocknum ;

          nextblocknum := nextblocknum + 1 ;

          { create a new entry for the thenpart serial clause }
          parent OF blocktable[nextblocknum] :=
             blocknum OF childi OF parsetree ;
          blocksubtree OF blocktable[nextblocknum] :=
             childii OF parsetree ;
          variables OF blocktable[nextblocknum] :=
             gatheridlist (childii OF parsetree) ;

          blocknum OF childii OF parsetree
             := nextblocknum ;

          nextblocknum := nextblocknum + 1 ;

          { now we examine the optional elif s }
          cursor := childiii OF parsetree ;
          WHILE cursor ISNT astreenil
          DO
            blocknum OF cursor :=
               blocknum OF parsetree ;

            { create a new entry for the condition part of this elif }
            parent OF blocktable[nextblocknum] :=
               nextblocknum - 2 ;
            blocksubtree OF blocktable[nextblocknum] :=
               childi OF cursor ;
            variables OF blocktable[nextblocknum] :=
               gatheridlist (childi OF cursor) ;

            blocknum OF childi OF cursor :=
               nextblocknum ;

            nextblocknum := nextblocknum + 1 ;

            { create a new entry for the then part this elif }
            parent OF blocktable[nextblocknum] :=
               nextblocknum - 1 ;
            blocksubtree OF blocktable[nextblocknum] :=
               childii OF cursor ;
            variables OF blocktable[nextblocknum] :=
               gatheridlist (childii OF cursor) ;

            blocknum OF childii OF cursor :=
               nextblocknum ;

            nextblocknum := nextblocknum + 1 ;

            cursor := succ OF cursor
          OD ;

          { check for the presence of an optional else }
          IF childiv OF parsetree ISNT astreenil
          THEN
            { create a new entry for the else part serial clause }
            parent OF blocktable[nextblocknum] :=
               nextblocknum - 2 ;
            blocksubtree OF blocktable[nextblocknum] :=
               childiv OF parsetree ;
            variables OF blocktable[nextblocknum] :=
               gatheridlist (childiv OF parsetree) ;

            blocknum OF childiv OF parsetree :=
               nextblocknum ;

            nextblocknum := nextblocknum + 1
          FI ;

          { now it is time to recurse }

          { recurse on the ifcondition serial clause }
          gatherblock (childi OF parsetree) ;

          { recurse on the thenpart serial clause }
          gatherblock (childii OF parsetree) ;

          { recurse on the optional elif s }
          cursor := childiii OF parsetree ;
          WHILE cursor ISNT astreenil
          DO
            gatherblock (childi OF cursor) ;
            gatherblock (childii OF cursor) ;

            cursor := succ OF cursor
          OD ;

          { recurse on the elsepart serial clause }
          IF childiv OF parsetree ISNT astreenil
          THEN
            gatherblock(childiv OF parsetree)
          FI
        ELSE
          definedblock := blocknum OF parsetree ;

          { in all the remaining cases there is no new block to create }
          { so we just need to pass the current blocknum to the children }

          IF childi OF parsetree ISNT astreenil
          THEN
            blocknum OF childi OF parsetree :=
               definedblock ;
            gatherblock(childi OF parsetree)
          FI;

          IF childii OF parsetree ISNT astreenil
          THEN
            blocknum OF childii OF parsetree :=
               definedblock ;
            gatherblock(childii OF parsetree)
          FI;

          IF childiii OF parsetree ISNT astreenil
          THEN
            blocknum OF childiii OF parsetree :=
               definedblock ;
            gatherblock(childiii OF parsetree)
          FI;

          IF childiv OF parsetree ISNT astreenil
          THEN
            blocknum OF childiv OF parsetree :=
               definedblock ;
            gatherblock(childiv OF parsetree)
          FI;

          IF childv OF parsetree ISNT astreenil
          THEN
            blocknum OF childv OF parsetree :=
               definedblock ;
            gatherblock(childv OF parsetree)
          FI;

          IF childvi OF parsetree ISNT astreenil
          THEN
            blocknum OF childvi OF parsetree :=
               definedblock ;
            gatherblock(childvi OF parsetree)
          FI
        FI
      FI
    FI
  FI ;

  IF succ OF parsetree ISNT astreenil
  THEN
    blocknum OF succ OF parsetree :=
       blocknum OF parsetree ;
    gatherblock (succ OF parsetree)
  FI

END ;

PROC( ASTREE) INT blockofname = ( ASTREE targetid) INT :
BEGIN
  REF IDLIST anidlist = LOC IDLIST ;
  REF BOOL found = LOC BOOL ;
  REF INT ablock = LOC INT ;

  REF [] CHAR aname = semval OF targetid ;

  ablock := blocknum OF targetid ;
  found := FALSE;

  anidlist := NIL;
  { search in each surrounding block }
  WHILE (ablock /= -1) ANDTH NOT found
  DO
    anidlist := variables OF blocktable[ablock];

    { search the list of variables declared in this block }
    WHILE (anidlist ISNT idlistnil) ANDTH (stringcmp(theid OF anidlist,
                                        aname) /= 0)
    DO
      anidlist := succ OF anidlist
    OD ;
    IF anidlist ISNT idlistnil
    THEN
      found := TRUE
    ELSE
      ablock := parent OF blocktable[ablock]
    FI
  OD ;
 
  ablock
END;

PROC( ASTREE) IDLIST resolvename = ( ASTREE targetid) IDLIST :
BEGIN
  REF IDLIST anidlist = LOC IDLIST ;
  REF BOOL found = LOC BOOL ;
  REF INT ablock = LOC INT ;

  REF [] CHAR aname = semval OF targetid ;

  ablock := blocknum OF targetid ;
  found := FALSE;

  anidlist := NIL;
  { search in each surrounding block }
  WHILE (ablock /= -1) ANDTH NOT found
  DO
    anidlist := variables OF blocktable[ablock];

    { search the list of variables declared in this block }
    WHILE (anidlist ISNT idlistnil) ANDTH (stringcmp(theid OF anidlist,
                                        aname) /= 0)
    DO
      anidlist := succ OF anidlist
    OD ;
    IF anidlist ISNT idlistnil
    THEN
      found := TRUE
    ELSE
      ablock := parent OF blocktable[ablock]
    FI
  OD ;
 
  anidlist
END;

{ since block number increase more rapidly than static nesting }
{ we need a procedure to compute the nesting of a given block }
PROC( INT) INT computenesting = ( INT blocknum) INT :
BEGIN
  REF INT ablock = LOC INT ;
  REF INT nesting = LOC INT ;

  ablock := blocknum ;
  nesting := 0 ;
  WHILE ablock /= -1
  DO
    { nesting increase when we get a routine val }
    { those are the only entries with non-dummy maxoffset field }
    IF maxoffset OF blocktable[ablock] /= -1
    THEN
      nesting := nesting + 1
    FI ;
    ablock := parent OF blocktable[ablock]
  OD ;

  nesting
END ;

PROC( ASTREE) VOID annotatecontext = ( ASTREE parsetree) VOID :
BEGIN
  REF ASTREE cursor = LOC ASTREE ;
  REF ASTREE anothercursor = LOC ASTREE ;
  REF INT currentcontext = LOC INT ;

  INT thetag = tag OF parsetree ;

  IF thetag = ntroutineval
  THEN
    { set the context of the body to be strong and recurse only on it }
    context OF childii OF parsetree := strong ;
    annotatecontext(childii OF parsetree)
  ELSE
    IF thetag = ntclosedclause
    THEN
      { set the context of all phrases but last to be strong and recurse }
      cursor := childi OF parsetree ;
      WHILE succ OF cursor ISNT astreenil
      DO
        context OF cursor := strong ;
        annotatecontext(cursor) ;

        cursor := succ OF cursor
      OD ;

      { pass along the current context to the last unit and recurse }
      context OF cursor := context OF parsetree;
      annotatecontext(cursor)
    ELSE
      IF thetag = ntloopclause
      THEN
        { nothing to do for the eventual induction variable }

        { the optional FROM and BY and TO units all get a meek context }
        IF childii OF parsetree ISNT astreenil
        THEN
          context OF childii OF parsetree := meek ;
          annotatecontext(childii OF parsetree)
        FI;

        IF childiii OF parsetree ISNT astreenil
        THEN
          context OF childiii OF parsetree := meek ;
          annotatecontext(childiii OF parsetree)
        FI;

        IF childiv OF parsetree ISNT astreenil
        THEN
          context OF childiv OF parsetree := meek ;
          annotatecontext(childiv OF parsetree)
        FI ;

        { if there is a while clause the last unit gets a meek context too }
        { all the other phrases takes on a strong contxt cfr closedclause }
        IF childv OF parsetree ISNT astreenil
        THEN
          cursor := childv OF parsetree ;
          WHILE succ OF cursor ISNT astreenil
          DO
            context OF cursor := strong ;
            annotatecontext(cursor) ;

            cursor := succ OF cursor
          OD ;

          context OF cursor := meek ;
          annotatecontext(cursor)
        FI ;

        { for the do part set the context of all phrases but last to strong }
        cursor := childvi OF parsetree ;
        WHILE succ OF cursor ISNT astreenil
        DO
          context OF cursor := strong ;
          annotatecontext(cursor) ;

          cursor := succ OF cursor
        OD ;

        { actually also the last unit in the do part has a strong context }
        context OF cursor := strong ;
        annotatecontext(cursor)
      ELSE
        IF thetag = ntifclause
        THEN
          { first we set the context of the if part as meek }
          { as usual since it is a serial clause we distinguish }
          { the last unit from all the other phrases }
          cursor := childi OF parsetree ;
          WHILE succ OF cursor ISNT astreenil
          DO
            context OF cursor := strong ;
            annotatecontext(cursor) ;

            cursor := succ OF cursor
          OD ;

          context OF cursor := meek ;
          annotatecontext(cursor) ;

          IF (childiii OF parsetree IS astreenil) ANDTH
             (childiv OF parsetree IS astreenil)
          THEN
            { if there is just if then fi we know how to balance it }
            { usual allbutlast stuff }
            cursor := childii OF parsetree ;
            WHILE succ OF cursor ISNT astreenil
            DO
              context OF cursor := strong ;
              annotatecontext(cursor) ;

              cursor := succ OF cursor
            OD ;

            { pass along the current context to the last unit of the then }
            context OF cursor := context OF parsetree ;
            annotatecontext(cursor)
          ELSE
            { otherwise balancing requires extra care }

            { then part }
            cursor := childii OF parsetree ;
            WHILE succ OF cursor ISNT astreenil
            DO
              context OF cursor := strong ;
              annotatecontext (cursor) ;

              cursor := succ OF cursor
            OD ;
            { signal that we do not yet know the context for this clause }
            context OF cursor := undefined ;
            annotatecontext (cursor) ;

            { elif s }
            anothercursor := childiii OF parsetree ;
            WHILE anothercursor ISNT astreenil
            DO
              context OF anothercursor := meek ;
              { set up the condition part }
              cursor := childi OF anothercursor ;
              WHILE succ OF cursor ISNT astreenil
              DO
                context OF cursor := strong ;
                annotatecontext (cursor) ;

                cursor := succ OF cursor
              OD ;
              { the condition is in a meek context }
              context OF cursor := meek ;
              annotatecontext (cursor) ;

              { now fix the then part }
              cursor := childii OF anothercursor ;
              WHILE succ OF cursor ISNT astreenil
              DO
                context OF cursor := strong ;
                annotatecontext (cursor) ;

                cursor := succ OF cursor
              OD ;
              { signal that we do not yet know the context for this clause }
              context OF cursor := undefined ;
              annotatecontext (cursor) ;

              anothercursor := succ OF anothercursor
            OD ;

            { optional else part }
            cursor := childiv OF parsetree ;
            IF cursor ISNT astreenil
            THEN
              WHILE succ OF cursor ISNT astreenil
              DO
                context OF cursor := strong ;
                annotatecontext (cursor) ;

                cursor := succ OF cursor
              OD ;
              { signal that we do not yet know the context for this clause }
              context OF cursor := undefined ;
              annotatecontext (cursor)
            FI
          FI
        ELSE
          IF thetag = ntproccall
          THEN
            { set the context of the functor to be meek }
            context OF childi OF parsetree := meek ;
            annotatecontext(childi OF parsetree) ;
            { set the context of all the arguments to be strong }
            cursor := childii OF parsetree ;
            WHILE cursor ISNT astreenil
            DO
              context OF cursor := strong ;
              annotatecontext(cursor) ;

              cursor := succ OF cursor
            OD
          ELSE
            IF thetag = ntstrucdisplay
            THEN
              { set the context of all the units to the the parent s }
              cursor := childi OF parsetree ;
              WHILE cursor ISNT astreenil
              DO
                context OF cursor :=
                   context OF parsetree ;
                annotatecontext(cursor) ;

                cursor := succ OF cursor
              OD
            ELSE
              IF thetag = ntmodecast
              THEN
               { set the context of the enclclause to be strong }
               context OF childii OF parsetree := strong ;
               annotatecontext(childii OF parsetree)
              ELSE
                IF thetag = ntassignment
                THEN
                  { set the context of the lhs to soft }
                  context OF childi OF parsetree := soft ;
                  annotatecontext(childi OF parsetree) ;

                  { set the context of the rhs to strong }
                  context OF childii OF parsetree := strong ;
                  annotatecontext(childii OF parsetree)
                ELSE
                  IF (thetag = tis) OREL (thetag = tisnt)
                  THEN
                    { one side should be soft and the other strong }
                    { but we do not yet know which is which }
                    { better to arbitrarily set strong to the lhs }
                    context OF childi OF parsetree := strong ;
                    annotatecontext(childi OF parsetree) ;
                    context OF childii OF parsetree := soft ;
                    annotatecontext(childii OF parsetree)
                  ELSE
                    IF thetag = ntidentitydecl
                    THEN
                      { set the context of the rhs to be strong }
                      context OF childiii OF parsetree := strong ;
                      annotatecontext(childiii OF parsetree)
                    ELSE
                      IF (thetag = tplus) OREL (thetag = tminus) OREL
                         (thetag = tabs) OREL (thetag = tsign) OREL
                         (thetag = trepr) OREL (thetag = tnot) OREL
                         (thetag = tlwb) OREL (thetag = tupb) OREL
                         (thetag = tandth) OREL (thetag = torel) OREL
                         (thetag = tor) OREL (thetag = tand) OREL
                         (thetag = teq) OREL (thetag = tneq) OREL
                         (thetag = tless) OREL (thetag = tgreater) OREL
                         (thetag = tleq) OREL (thetag = tgeq) OREL
                         (thetag = ttimes) OREL (thetag = tover) OREL
                         (thetag = tmod) OREL (thetag = tpow) OREL
                         (thetag = tmax) OREL (thetag = tmin)
                      THEN
                        { both childi and childii if present get a meek context }
                        context OF childi OF parsetree := meek ;
                        annotatecontext(childi OF parsetree) ;
                        IF childii OF parsetree ISNT astreenil
                        THEN
                          context OF childii OF parsetree := meek ;
                          annotatecontext(childii OF parsetree)
                        FI
                      ELSE
                        IF thetag = ntsubscript
                        THEN
                          { set the context of the id to weak }
                          context OF childi OF parsetree := weak ;
                          annotatecontext(childi OF parsetree) ;

                          { set the context of all the subscripts to meek }
                          cursor := childii OF parsetree ;
                          WHILE cursor ISNT astreenil
                          DO
                            context OF cursor := meek ;
                            annotatecontext(cursor) ;

                            cursor := succ OF cursor
                          OD
                        ELSE
                          IF thetag = tof
                          THEN
                            { set the context of the secondary to be weak }
                            context OF childii OF parsetree := weak ;
                            annotatecontext(childii OF parsetree)
                          ELSE
                            IF (thetag = tloc) OREL (thetag = theap)
                            THEN
                              { set the context of the eventual units to meek }
                              cursor := childi OF parsetree ;
                              WHILE cursor ISNT astreenil
                              DO
                                context OF cursor := meek ;
                                annotatecontext(cursor) ;

                                cursor := succ OF cursor
                              OD
                            ELSE
                              IF (thetag /= tbasemode) ANDTH (thetag /= tref) ANDTH
                                 (thetag /= tlbracket) ANDTH (thetag /= tproc) ANDTH
                                 (thetag /= tstruct)
                              THEN
                                { nothing special to do here }
                                { just need to pass the current context on }

                                currentcontext := context OF parsetree ;

                                IF childi OF parsetree ISNT astreenil
                                THEN
                                  context OF childi OF parsetree :=
                                  currentcontext ;
                                  annotatecontext(childi OF parsetree)
                                FI;

                                IF childii OF parsetree ISNT astreenil
                                THEN
                                  context OF childii OF parsetree :=
                                     currentcontext ;
                                  annotatecontext(childii OF parsetree)
                                FI;

                                IF childiii OF parsetree ISNT astreenil
                                THEN
                                  context OF childiii OF parsetree :=
                                     currentcontext ;
                                  annotatecontext(childiii OF parsetree)
                                FI;

                                IF childiv OF parsetree ISNT astreenil
                                THEN
                                  context OF childiv OF parsetree :=
                                     currentcontext ;
                                  annotatecontext(childiv OF parsetree)
                                FI;

                                IF childv OF parsetree ISNT astreenil
                                THEN
                                  context OF childv OF parsetree :=
                                     currentcontext ;
                                  annotatecontext(childv OF parsetree)
                                FI;

                                IF childvi OF parsetree ISNT astreenil
                                THEN
                                  context OF childvi OF parsetree :=
                                     currentcontext ;
                                  annotatecontext(childvi OF parsetree)
                                FI
                              FI
                            FI
                          FI
                        FI
                      FI
                    FI
                  FI
                FI
              FI
            FI
          FI
        FI
      FI
    FI
  FI
END ;

PROC( MODETREE, INT) MODECOERLIST admissiblemodes = ( MODETREE amode, INT acontext) MODECOERLIST :
BEGIN
  REF MODECOERLIST thelist = LOC MODECOERLIST ;
  REF MODECOERLIST tmplist = LOC MODECOERLIST ;
  REF CLIST tmpcoercions = LOC CLIST ;

  INT thetag = tag OF amode ;

  thelist := newmodecoernode ;
  themode OF thelist := amode ;
  { nothing else to be done for voidmode and whatever }
  IF (thetag /= voidmode) ANDTH (thetag /= whatever)
  THEN
    IF (thetag = boolmode) OREL (thetag = intmode) OREL
       (thetag = charmode) OREL (thetag = rowmode) OREL
       (thetag = structmode) OREL
       ((thetag = procmode) ANDTH (argsmode OF amode ISNT modeslistnil))
    THEN
      { the only coercion we can apply is voiding so check the context }
      IF acontext = strong
      THEN
        { create the node representing the voidmode and the voiding coercion }
        tmplist := newmodecoernode ;
        themode OF tmplist := newmodenode (voidmode) ;
        tmpcoercions := newcnode (voiding) ;
        coercionstodo OF tmplist := tmpcoercions ;
        { add this node as the second and last of the list to be returned }
        succ OF thelist := tmplist
      FI
    ELSE
      IF (thetag = procmode) ANDTH (argsmode OF amode IS modeslistnil)
      THEN
        { we can always apply deproceduring so we recurse on the result mode }
        tmplist := admissiblemodes (innermode OF amode, acontext) ;
        succ OF thelist := tmplist ;
        { prepend to each list of coercion the deproceduring we just applied }
        WHILE tmplist ISNT modecoerlistnil
        DO
          tmpcoercions := newcnode (deproceduring) ;
          succ OF tmpcoercions :=
             coercionstodo OF tmplist ;
          coercionstodo OF tmplist := tmpcoercions ;

          tmplist := succ OF tmplist
        OD
      ELSE
        IF thetag = refmode
        THEN
          { before applying dereferencing check whether acontext allows it }
          IF (acontext = strong) OREL (acontext = meek) OREL
             ((acontext = weak) ANDTH
              (tag OF innermode OF amode = refmode))
          THEN
            tmplist := admissiblemodes (innermode OF amode, acontext) ;
            succ OF thelist := tmplist ;
            { prepend to each list of coercion the dereferencing we just applied }
            WHILE tmplist ISNT modecoerlistnil
            DO
              tmpcoercions := newcnode (dereferencing) ;
              succ OF tmpcoercions :=
                 coercionstodo OF tmplist ;
              coercionstodo OF tmplist := tmpcoercions ;

              tmplist := succ OF tmplist
            OD
          FI
        ELSE
          { we should never get here }
          fputint(1, thetag) ;
          error("PANIC: I found an unknown mode tag!!")
        FI
      FI
    FI
  FI ;

  thelist
END ;

PROC( ASTREE, CLIST) VOID appendcoerlist = ( ASTREE parsetree, CLIST morecoercions) VOID :
BEGIN
  REF CLIST oldlist = LOC CLIST ;

  IF coercionstodo OF parsetree IS clistnil
  THEN
    coercionstodo OF parsetree := morecoercions
  ELSE
    oldlist := coercionstodo OF parsetree ;
    WHILE succ OF oldlist ISNT clistnil
    DO
      oldlist := succ OF oldlist
    OD ;
    succ OF oldlist := morecoercions
  FI
END ;

PROC( ASTREE, MODETREE) MODECOERLIST iscoercibleto = ( ASTREE parsetree, MODETREE targetmode) MODECOERLIST :
BEGIN
  REF MODECOERLIST result = LOC MODECOERLIST ;

  { special care is needed for assigments and casts }
  IF ((tag OF parsetree = ntassignment) OREL
      (tag OF parsetree = ntmodecast)) ANDTH
     (tag OF targetmode = voidmode)
  THEN
    IF context OF parsetree = strong
    THEN
      { we can void directly without intermediate coercions }
      result := newmodecoernode ;
      themode OF result := newmodenode (voidmode) ;
      coercionstodo OF result := newcnode (voiding)
    ELSE
      result := NIL
    FI
  ELSE
    { first collect all admissible modes for this subtree of the parsetree }
    result := admissiblemodes (themode OF parsetree,
                                        context OF parsetree) ;

    { now we go through the list of admissible modes until we either run out }
    { of possibilities or find what we are looking for }
    WHILE (result ISNT modecoerlistnil) ANDTH
          NOT modecmp (themode OF result, targetmode)
    DO
      result := succ OF result
    OD
  FI ;

  result
END ;

PROC( MODECOERLIST, MODECOERLIST) MODECOERLIST matchlists = ( MODECOERLIST alist, MODECOERLIST anotherlist) MODECOERLIST :
BEGIN
  REF MODECOERLIST result = LOC MODECOERLIST ;
  REF MODECOERLIST cursor = LOC MODECOERLIST ;
  REF MODETREE targetmode = LOC MODETREE ;
  REF BOOL found = LOC BOOL;


  { we search each mode in the first list... }

  found := FALSE ;
  result := alist ;
  WHILE NOT found ANDTH (result ISNT modecoerlistnil)
  DO
    targetmode := themode OF result ;

    { ...against each mode of the second list }

    cursor := anotherlist ;
    WHILE (cursor ISNT modecoerlistnil) ANDTH
          NOT modecmp (themode OF cursor, targetmode)
    DO
      cursor := succ OF cursor
    OD ;
    IF cursor ISNT modecoerlistnil
    THEN
      found := TRUE
    ELSE
      result := succ OF result
    FI
  OD ;

  result
END ;

PROC( DOUBLEMCLIST) MODECOERLIST aremodesconsistent = ( DOUBLEMCLIST adoublelist) MODECOERLIST :
BEGIN
  REF DOUBLEMCLIST nexttocheck = LOC DOUBLEMCLIST ;
  REF MODECOERLIST result = LOC MODECOERLIST ;
  REF MODECOERLIST tmplist = LOC MODECOERLIST ;

  result := thelist OF adoublelist ;
  nexttocheck := succ OF adoublelist ;
  WHILE (result ISNT modecoerlistnil) ANDTH (nexttocheck ISNT doublemclistnil)
  DO
    tmplist := matchlists (result, thelist OF nexttocheck) ;
    IF tmplist IS result
    THEN
      nexttocheck := succ OF nexttocheck
    ELSE
      result := tmplist ;
      nexttocheck := succ OF adoublelist
    FI
  OD;

  result
END ;

PROC( ASTREE) VOID balanceclause = ( ASTREE parsetree) VOID :
BEGIN
  REF DOUBLEMCNODE allclausesmodes = LOC DOUBLEMCNODE ;
  REF DOUBLEMCLIST listcursor = LOC DOUBLEMCLIST ;
  REF ASTREE cursor = LOC ASTREE ;
  REF ASTREE elifs = LOC ASTREE ;
  REF MODETREE amode = LOC MODETREE ;
  REF MODECOERLIST result = LOC MODECOERLIST ;

  INT thetag = tag OF parsetree ;

  IF thetag = ntifclause
  THEN
    IF context OF parsetree = strong
    THEN
      { this is the easy case since we know that everything }
      { get a strong context }
      { first we set up the context to the THEN clause and }
      { meanwhile we type check all of them }
      amode := newmodenode (voidmode) ;
      cursor := childii OF parsetree ;
      WHILE succ OF cursor ISNT astreenil
      DO
        context OF cursor := strong ;
        annotatecontext(cursor) ;
        { just void intermediate clauses }
        annotatemode(cursor) ;
        result := iscoercibleto (cursor, amode) ;
        IF result ISNT modecoerlistnil
        THEN
          appendcoerlist(cursor, coercionstodo OF result) ;
          themode OF cursor := amode
        ELSE
          writeast(parsetree, 0);
          error("Semantic Error: couldn\'t void a clause in the THEN part")
        FI ;

        cursor := succ OF cursor
      OD ;
      context OF cursor := strong ;
      annotatecontext(cursor) ;
      { just type check the last clause }
      annotatemode(cursor) ;
      { now we start building the list to be passed to aremodesconsistent }
      listcursor := allclausesmodes ;
      thelist OF listcursor :=
         admissiblemodes (themode OF cursor, context OF cursor) ;
      succ OF listcursor := NIL ;
      
      { now we go on to the optional elif s }
      elifs := childiii OF parsetree ;
      WHILE elifs ISNT astreenil
      DO
        { skip first child since it contains the elif condition }
        cursor := childii OF elifs ;
        { set up the context and type check this THEN clause }
        WHILE succ OF cursor ISNT astreenil
        DO
          context OF cursor := strong ;
          annotatecontext(cursor) ;
          { just void intermediate clauses }
          annotatemode(cursor) ;
          result := iscoercibleto (cursor, amode) ;
          IF result ISNT modecoerlistnil
          THEN
            appendcoerlist(cursor, coercionstodo OF result) ;
            themode OF cursor := amode
          ELSE
            writeast(parsetree, 0);
            error("Semantic Error: couldn\'t void a clause in the THEN part of an ELIF")
          FI ;

          cursor := succ OF cursor
        OD ;
        context OF cursor := strong ;
        annotatecontext(cursor) ;
        { just type check the last clause }
        annotatemode(cursor) ;
        { continue building the list to be passed to aremodesconsistent }
        succ OF listcursor := LOC DOUBLEMCNODE ;
        listcursor := succ OF listcursor ;
        thelist OF listcursor :=
           admissiblemodes (themode OF cursor, context OF cursor) ;
        succ OF listcursor := NIL ;

        elifs := succ OF elifs
      OD ;
      { now we go on to the optional else }
      cursor := childiv OF parsetree ;
      IF cursor ISNT astreenil
      THEN
        { set up the context and type check this ELSE clause }
        WHILE succ OF cursor ISNT astreenil
        DO
          context OF cursor := strong ;
          annotatecontext(cursor) ;
          { just void intermediate clauses }
          annotatemode(cursor) ;
          result := iscoercibleto (cursor, amode) ;
          IF result ISNT modecoerlistnil
          THEN
            appendcoerlist(cursor, coercionstodo OF result) ;
            themode OF cursor := amode
          ELSE
            writeast(parsetree, 0);
            error("Semantic Error: couldn\'t void a clause in the ELSE part")
          FI ;

          cursor := succ OF cursor
        OD ;
        context OF cursor := strong ;
        annotatecontext(cursor) ;
        { just type check the last clause }
        annotatemode(cursor) ;
        { continue building the list to be passed to aremodesconsistent }
        succ OF listcursor := LOC DOUBLEMCNODE ;
        listcursor := succ OF listcursor ;
        thelist OF listcursor :=
           admissiblemodes (themode OF cursor, context OF cursor) ;
        succ OF listcursor := NIL
      FI ;
      { now we are ready to balance these clauses }
      result := aremodesconsistent (allclausesmodes) ;
      IF result ISNT modecoerlistnil
      THEN
        amode := themode OF result ;
        { go back to all the alternatives and set the mode }
        cursor := childii OF parsetree ;
        WHILE succ OF cursor ISNT astreenil
        DO
          cursor := succ OF cursor
        OD ;
        { this is the last unit in the serial cluase of the THEN part }
        result := iscoercibleto (cursor, amode) ;
        IF result ISNT modecoerlistnil
        THEN
          appendcoerlist(cursor, coercionstodo OF result) ;
          themode OF cursor := amode
        ELSE
          error("PANIC: something wrong with the procedure aremodesconsistent")
        FI ;
            
        { now we go on to the optional elif s }
        elifs := childiii OF parsetree ;
        WHILE elifs ISNT astreenil
        DO
          cursor := childii OF elifs ;
          WHILE succ OF cursor ISNT astreenil
          DO
            cursor := succ OF cursor
          OD ;
          { last unit in the serial cluase of the THEN part of this ELIF }
          result := iscoercibleto (cursor, amode) ;
          IF result ISNT modecoerlistnil
          THEN
            appendcoerlist(cursor, coercionstodo OF result) ;
            themode OF cursor := amode
          ELSE
            error("PANIC: something wrong with the procedure aremodesconsistent")
          FI ;
        
          elifs := succ OF elifs
        OD ;
        
        { now we go on to the optional else }
        cursor := childiv OF parsetree ;
        IF cursor ISNT astreenil
        THEN
          WHILE succ OF cursor ISNT astreenil
          DO
            cursor := succ OF cursor
          OD ;
          { last unit in the serial cluase of the ELSE part }
          result := iscoercibleto (cursor, amode) ;
          IF result ISNT modecoerlistnil
          THEN
            appendcoerlist(cursor, coercionstodo OF result) ;
            themode OF cursor := amode
          ELSE
            error("PANIC: something wrong with the procedure aremodesconsistent")
          FI
        FI ;

        { finally we can set the mode of this IF clause }
        themode OF parsetree := amode
      ELSE
        writeast(parsetree, 0);
        error("Semantic Error: couldn\'t balance the alternatives of this IF clause")
      FI
    ELSE
      error("complex elifs have not been implemented yet")
    FI
  ELSE
    error("PANIC: balanceclause should only be called on IFs")
  FI

END ;

PROC( ASTREE) VOID annotatemode = ( ASTREE parsetree) VOID :
BEGIN
  REF MODECOERLIST result = LOC MODECOERLIST ;
  REF MODECOERLIST auxresult = LOC MODECOERLIST ;
  REF ASTREE anothercursor = LOC ASTREE ;
  REF ASTREE cursor = LOC ASTREE ;
  REF MODETREE amode = LOC MODETREE ;
  REF MODETREE anothermode = LOC MODETREE ;
  REF IDLIST anidlist = LOC IDLIST ;
  REF MODESLIST alist = LOC MODESLIST ;
  REF INT anint = LOC INT ;
  REF REF [] CHAR astring = LOC REF [] CHAR ;

  INT thetag = tag OF parsetree ;

  IF debugging
  THEN
    fputs(1, "annotating the mode of a ") ;
    fputint(1, thetag) ;
    fputnl(1)
  FI ;

  IF thetag = tid
  THEN
    { use the block table to find out the mode of this identifier }
    anidlist := resolvename (parsetree) ;
    IF anidlist ISNT idlistnil
    THEN
      themode OF parsetree := themode OF anidlist
    ELSE
      fputs(1, "while looking up: ") ;
      fputs(1, semval OF parsetree) ;
      fputnl(1) ;
      error("Semantic Error: undeclared variable")
    FI
  ELSE
    IF thetag = tstringconst
    THEN
      { string denotations have mode REF [256] CHAR }
      amode := newmodenode (rowmode) ;
      innermode OF amode := newmodenode (charmode) ;
      size OF amode := 256 ;
      themode OF parsetree := newmodenode (refmode) ;
      innermode OF themode OF parsetree := amode
    ELSE
      IF thetag = tcharconst
      THEN
        { character denotations have mode CHAR }
        themode OF parsetree := newmodenode (charmode)
      ELSE
        IF thetag = tintconst
        THEN
          { integer denotations have mode INT }
          themode OF parsetree := newmodenode (intmode)
        ELSE
          IF (thetag = ttrue) OREL (thetag = tfalse)
          THEN
            { TRUE and FALSE have mode BOOL }
            themode OF parsetree := newmodenode (boolmode)
          ELSE
            IF thetag = tskip
            THEN
              { SKIP is a special denotation of mode whatever }
              themode OF parsetree := newmodenode (whatever)
            ELSE
              IF thetag = tnil
              THEN
                { NIL is a special denotation of mode ref whatever }
                amode := newmodenode (refmode) ;
                innermode OF amode := newmodenode (whatever) ;
                themode OF parsetree := amode
              ELSE
                IF thetag = ntroutineval
                THEN
                  { compute the resulting mode for this routine }
                  annotatemode (childii OF parsetree) ;
                  cursor := childii OF childi OF parsetree ;
                  amode := packmodetree (cursor) ;
                  themode OF cursor := amode ;
                  { check that the mode of the body is coercible to the above mode }
                  result := iscoercibleto (childii OF parsetree,
                                        amode) ;
                  IF result ISNT modecoerlistnil
                  THEN
                    appendcoerlist(childii OF parsetree,
                                   coercionstodo OF result) ;
                    themode OF childii OF parsetree :=
                       themode OF result
                  ELSE
                    writeast(parsetree, 0);
                    error("Semantic Error: proc\'s body doesn\'t match prototype")
                  FI ;
                  { prepare the mode tree for this routine value }
                  anothermode := newmodenode (procmode) ;
                  innermode OF anothermode := amode ;
                  { set up a cursor to go through the modes of the formals }
                  cursor := childi OF childi OF parsetree ;
                  IF cursor ISNT astreenil
                  THEN
                    argsmode OF anothermode :=
                       newmodesnode(themode OF cursor) ;
                    alist := argsmode OF anothermode ;

                    { skip over the formal parameter }
                    cursor := succ OF cursor ;
                    cursor := succ OF cursor ;
                    WHILE cursor ISNT astreenil
                    DO
                      succ OF alist :=
                         newmodesnode(themode OF cursor) ;

                      alist := succ OF alist ;
                      { skip over the formal parameter }
                      cursor := succ OF cursor ;
                      cursor := succ OF cursor
                    OD
                  FI ;
                  { now the proc mode is ready as anothermode }
                  themode OF parsetree := anothermode
                ELSE
                  IF thetag = ntclosedclause
                  THEN
                    { just annotate the mode of all phrases in this clause... }
                    cursor := childi OF parsetree ;
                    amode := newmodenode (voidmode) ;
                    WHILE succ OF cursor ISNT astreenil
                    DO
                      annotatemode(cursor) ;
                      { ...void the mode of all intermediate phrases ... }
                      result := iscoercibleto (cursor, amode) ;
                      IF result ISNT modecoerlistnil
                      THEN
                        appendcoerlist(cursor,
                                       coercionstodo OF result) ;
                        themode OF cursor := amode
                      ELSE
                        writeast(parsetree, 0);
                        error ("Semantic Error: couldn\'t void a phrase in this closed clause")
                      FI ;

                      cursor := succ OF cursor
                    OD ;
                    { ...and retain the mode of the last unit as final mode }
                    annotatemode(cursor) ;
                    themode OF parsetree := themode OF cursor
                  ELSE
                    IF thetag = ntloopclause
                    THEN
                      { nothing to do for the eventual induction variable }

                      { the optional FROM and BY and TO units all should yield an INT }
                      amode := newmodenode(intmode) ;

                      IF childii OF parsetree ISNT astreenil
                      THEN
                        annotatemode (childii OF parsetree) ;
                        result := iscoercibleto (childii OF parsetree,
                                        amode) ;
                        IF result ISNT modecoerlistnil
                        THEN
                          appendcoerlist(childii OF parsetree,
                                        coercionstodo OF result) ;
                          themode OF childii OF parsetree :=
                             themode OF result
                        ELSE
                          writeast(parsetree, 0);
                          error("Semantic Error: FROM unit must yield an INT")
                        FI
                      FI ;

                      IF childiii OF parsetree ISNT astreenil
                      THEN
                        annotatemode (childiii OF parsetree) ;
                        result := iscoercibleto (childiii OF parsetree,
                                        amode) ;
                        IF result ISNT modecoerlistnil
                        THEN
                          appendcoerlist(childiii OF parsetree,
                                        coercionstodo OF result) ;
                          themode OF childiii OF parsetree :=
                             themode OF result
                        ELSE
                          writeast(parsetree, 0);
                          error("Semantic Error: BY unit must yield an INT")
                        FI
                      FI ;

                      IF childiv OF parsetree ISNT astreenil
                      THEN
                        annotatemode (childiv OF parsetree) ;
                        result := iscoercibleto (childiv OF parsetree,
                                        amode) ;
                        IF result ISNT modecoerlistnil
                        THEN
                          appendcoerlist(childiv OF parsetree,
                                        coercionstodo OF result) ;
                          themode OF childiv OF parsetree :=
                             themode OF result
                        ELSE
                          writeast(parsetree, 0);
                          error("Semantic Error: TO unit must yield an INT")
                        FI
                      FI ;

                      { if there is a while the last unit should yield a BOOL }
                      IF childv OF parsetree ISNT astreenil
                      THEN
                        amode := newmodenode (voidmode) ;

                        cursor := childv OF parsetree ;
                        WHILE succ OF cursor ISNT astreenil
                        DO
                          annotatemode (cursor) ;
                          result := iscoercibleto (cursor,
                                        amode) ;
                          IF result ISNT modecoerlistnil
                          THEN
                            appendcoerlist(cursor,
                                        coercionstodo OF result) ;
                            themode OF cursor :=
                               themode OF result
                          ELSE
                            writeast(parsetree, 0);
                            error("Semantic Error: couldn\'t type check the WHILE condition")
                          FI ;

                          cursor := succ OF cursor
                        OD ;
                        amode := newmodenode (boolmode) ;

                        annotatemode (cursor) ;
                        result := iscoercibleto (cursor,
                                        amode) ;
                        IF result ISNT modecoerlistnil
                        THEN
                          appendcoerlist(cursor,
                                        coercionstodo OF result) ;
                          themode OF cursor :=
                             themode OF result
                        ELSE
                          writeast(parsetree, 0);
                          error("Semantic Error: WHILE clause must yield a BOOL")
                        FI
                      FI ;

                      { for the do part everything should just be voidable }
                      amode := newmodenode(voidmode) ;

                      cursor := childvi OF parsetree ;
                      WHILE cursorISNT astreenil
                      DO
                        annotatemode (cursor) ;
                        result := iscoercibleto (cursor,
                                        amode) ;
                        IF result ISNT modecoerlistnil
                        THEN
                          appendcoerlist (cursor,
                                        coercionstodo OF result) ;
                          themode OF cursor :=
                             themode OF result
                        ELSE
                          writeast(parsetree, 0);
                          error("Semantic Error: couldn\'t type check the DO clause")
                        FI ;

                        cursor := succ OF cursor
                      OD ;

                      { set the mode of the entire loop clause do be void }
                      themode OF parsetree := amode

                    ELSE
        IF thetag = ntifclause
        THEN
          { first we type check the condition in the IF part }
          { as usual since it is a serial clause we distinguish }
          { the last unit from all the other phrases }
          amode := newmodenode (voidmode) ;
          anothermode := newmodenode (boolmode) ;

          cursor := childi OF parsetree ;
          WHILE succ OF cursor ISNT astreenil
          DO
            { just void intermediate clauses }
            annotatemode(cursor) ;
            result := iscoercibleto (cursor, amode) ;
            IF result ISNT modecoerlistnil
            THEN
              appendcoerlist(cursor, coercionstodo OF result) ;
              themode OF cursor := amode
            ELSE
              writeast(parsetree, 0);
              error("Semantic Error: couldn\'t void a clause in the IF condition")
            FI ;

            cursor := succ OF cursor
          OD ;
          { last unit must yield a BOOL }
          annotatemode(cursor) ;
          result := iscoercibleto (cursor, anothermode) ;
          IF result ISNT modecoerlistnil
          THEN
            appendcoerlist(cursor, coercionstodo OF result) ;
            themode OF cursor := anothermode
          ELSE
            writeast(parsetree, 0);
            error("Semantic Error: the IF condition must yield a BOOL")
          FI ;

          IF (childiii OF parsetree IS astreenil) ANDTH
             (childiv OF parsetree IS astreenil)
          THEN
            { if there is just if then fi we know how to balance it }
            { the THEN part must be voidable and VOID is the resulting mode }
            cursor := childii OF parsetree ;
            WHILE succ OF cursor ISNT astreenil
            DO
              { just void intermediate clauses }
              annotatemode(cursor) ;
              result := iscoercibleto (cursor, amode) ;
              IF result ISNT modecoerlistnil
              THEN
                appendcoerlist(cursor, coercionstodo OF result) ;
                themode OF cursor := amode
              ELSE
                writeast(parsetree, 0);
                error("Semantic Error: couldn\'t void a clause in the THEN part")
              FI ;

              cursor := succ OF cursor
            OD ;
            { also the last unit must yield a VOID }
            annotatemode(cursor) ;
            result := iscoercibleto (cursor, amode) ;
            IF result ISNT modecoerlistnil
            THEN
              appendcoerlist(cursor, coercionstodo OF result) ;
              themode OF cursor := amode
            ELSE
              writeast(parsetree, 0);
              error("Semantic Error: a THEN with no ELSE must yield VOID")
            FI ;

            { the whole thing gets VOID }
            themode OF parsetree := amode
          ELSE
            { otherwise balancing requires extra care }
            { this will be done by balanceclause }
            { before calling that proc we fix the BOOL parts }

            { elif s }
            anothercursor := childiii OF parsetree ;
            WHILE anothercursor ISNT astreenil
            DO
              { type check the condition part }
              cursor := childi OF anothercursor ;
              WHILE succ OF cursor ISNT astreenil
              DO
                { just void intermediate clauses }
                annotatemode(cursor) ;
                result := iscoercibleto (cursor, amode) ;
                IF result ISNT modecoerlistnil
                THEN
                  appendcoerlist(cursor, coercionstodo OF result) ;
                  themode OF cursor := amode
                ELSE
                  writeast(parsetree, 0);
                  error("Semantic Error: couldn\'t void a clause in the condition of an ELIF")
                FI ;

                cursor := succ OF cursor
              OD ;
              { last unit must yield a BOOL }
              annotatemode(cursor) ;
              result := iscoercibleto (cursor, anothermode) ;
              IF result ISNT modecoerlistnil
              THEN
                appendcoerlist(cursor, coercionstodo OF result) ;
                themode OF cursor := anothermode
              ELSE
                writeast(parsetree, 0);
                error("Semantic Error: the ELIF condition must yield a BOOL")
              FI ;

              { we do not fix the then part now }

              anothercursor := succ OF anothercursor
            OD ;

            { we do not fix the optional else part now }
            { this will be done by balanceclause }
            balanceclause (parsetree)
          FI
        ELSE
          IF thetag = ntproccall
          THEN
            { first check the mode of the functor to be a proc mode }
            annotatemode(childi OF parsetree) ;
            amode := themode OF childi OF parsetree ;

            IF tag OF amode = procmode
            THEN
              { set the resulting mode from the mode of the functor }
              themode OF parsetree :=
                 innermode OF amode ;
              { now type check the actuals }
              alist := argsmode OF amode ;
              cursor := childii OF parsetree;

              WHILE (alist ISNT modeslistnil) ANDTH (cursor ISNT astreenil)
              DO
                annotatemode(cursor) ;
                result := iscoercibleto(cursor,
                                        themode OF alist) ;
                IF result ISNT modecoerlistnil
                THEN
                  themode OF cursor
                     := themode OF result ;
                  appendcoerlist(cursor, coercionstodo OF result) ;
                  alist := succ OF alist ;
                  cursor := succ OF cursor
                ELSE
                  writeast(parsetree, 0);
                  error("Semantic Error: couldn\'t type check the actuals of a call")
                FI
              OD ;
              IF (alist ISNT modeslistnil) OREL (cursor ISNT astreenil)
              THEN
               writeast(parsetree, 0);
               error("Semantic Error: couldn\'t match actuals with formals")
              FI
            ELSE
              writeast(parsetree, 0);
              error("Semantic Error: an id used as functor has not a proc mode")
            FI
          ELSE
            IF thetag = ntstrucdisplay
            THEN
              { first check to see whether it is the empty clause }
              IF childi OF parsetree IS astreenil
              THEN
                { the empty clause stands for an empty array of whatever }
                amode := newmodenode (rowmode) ;
                innermode OF amode := newmodenode (whatever) ;
                themode OF parsetree := amode
              ELSE
                { now we have a set of units that must have all the same mode }
                { this is not currently implemented }
                writeast(parsetree, 0) ;
                error("PANIC: array constant haven\'t been implemted yet")
              FI
            ELSE
              IF thetag = ntmodecast
              THEN
                { first type check the enclclause }

                annotatemode(childii OF parsetree);
                { now pack up the mode of this cast }
                amode := packmodetree(childi OF parsetree);
                themode OF childi OF parsetree := amode;
                themode OF parsetree := amode;
                result := iscoercibleto(childii OF parsetree,
                                        amode);
                IF result ISNT modecoerlistnil
                THEN
                  themode OF childii OF parsetree :=
                     themode OF result;
                  appendcoerlist(childii OF parsetree,
                                 coercionstodo OF result)
                ELSE
                  writeast(parsetree, 0);
                  error("Semantic Error: couldn\'t cast the enclose clause as indicated")
                FI
              ELSE
                IF thetag = ntassignment
                THEN
                  { first type check the lhs }
                  annotatemode (childi OF parsetree) ;
                  { check that it yields a REF mode }
                  amode := newmodenode (refmode) ;
                  innermode OF amode := newmodenode (whatever) ;
                  result := iscoercibleto (childi OF parsetree,
                                        amode) ;
                  IF result ISNT modecoerlistnil
                  THEN
                    appendcoerlist (childi OF parsetree,
                                    coercionstodo OF result) ;
                    amode := themode OF result ;
                    themode OF childi OF parsetree := amode ;
                    { the mode of the assignment is the mode of the lhs }
                    themode OF parsetree := amode ;
                    { if the lhs is REF a the rhs must be coercible to a }
                    amode := innermode OF amode ;
                    annotatemode (childii OF parsetree) ;
                    result := iscoercibleto (childii OF parsetree,
                                        amode) ;
                    IF result ISNT modecoerlistnil
                    THEN
                      appendcoerlist (childii OF parsetree,
                                      coercionstodo OF result) ;
                      amode := themode OF result ;
                      themode OF childii OF parsetree := amode
                    ELSE
                      writeast(parsetree, 0);
                      error("Semantic Error: lhs and rhs have incompatible modes")
                    FI
                  ELSE
                    writeast(parsetree, 0);
                    error("Semantic Error: lhs is not a REF mode")
                  FI
                ELSE
                  IF (thetag = tis) OREL (thetag = tisnt)
                  THEN
                    { one side should be soft and the other strong }
                    { and yet they should be coercible to the same ref mode }
                    themode OF parsetree := NIL ;
                    { let us try with the lhs to be in soft context }
                    { propagate the soft context in the left subtree }
                    { check if it can be coerced to some ref mode }
                    annotatemode(childii OF parsetree) ;
                    amode := newmodenode (refmode) ;
                    innermode OF amode := newmodenode (whatever) ;
                    result := iscoercibleto (childii OF parsetree,
                                        amode) ;
                    { NIL cannot go in the strong side of an identity relation }
                    IF result ISNT modecoerlistnil
                    THEN
                      { before applying coercions we need to make sure that }
                      { the other side is OK too --- just save result for now }
                      auxresult := result ;
                      amode := themode OF result ;

                      { the rhs gets a strong context in this try }
                      { propagate the strong context in the right subtree }
                      { check if it can be coerced to the ref mode of the lhs }
                      annotatemode(childi OF parsetree) ;
                      result := iscoercibleto (childi OF parsetree,
                                        amode) ;
                      IF result ISNT modecoerlistnil
                      THEN
                        { now it is time to record coercions }
                        { first the rhs... }
                        appendcoerlist (childii OF parsetree,
                                        coercionstodo OF auxresult) ;
                        amode := themode OF auxresult ;
                        themode OF childii OF parsetree := amode ;
                        { ...then the lhs }
                        appendcoerlist (childi OF parsetree,
                                        coercionstodo OF result) ;
                        amode := themode OF result ;
                        themode OF childi OF parsetree := amode ;
                        { everything went well so this node yield a BOOL }
                        themode OF parsetree := newmodenode (boolmode)
                      FI
                    FI ;
                    IF themode OF parsetree IS modetreenil
                    THEN

















































                        writeast(parsetree, 0);
                        error("Semantic Error: couldn\'t type check an identity relation")
                    FI
                  ELSE
                    IF thetag = ntidentitydecl
                    THEN
                      { type check the rhs so that it matches the lhs mode }
                      annotatemode(childiii OF parsetree);
                      result := iscoercibleto(childiii OF parsetree,
                                        themode OF childi OF parsetree);
                      IF result ISNT modecoerlistnil
                      THEN
                        themode OF childiii OF parsetree
                                        := themode OF result;
                        coercionstodo OF childiii OF parsetree
                                        := coercionstodo OF result ;
                        { now assign void as the mode of this declaration }
                        themode OF parsetree := newmodenode (voidmode)
                      ELSE
                        writeast(parsetree, 0);
                        error("Semantic Error: rhs of an identity declaration has wrong mode")
                      FI
                    ELSE
                      IF (thetag = tandth) OREL (thetag = torel) OREL
                         (thetag = tand) OREL (thetag = tor)
                      THEN
                        { both operands must be BOOL }
                        amode := newmodenode(boolmode) ;
                        cursor := childi OF parsetree ;
                        annotatemode (cursor) ;
                        result := iscoercibleto(cursor, amode) ;
                        IF result ISNT modecoerlistnil
                        THEN
                          themode OF cursor := amode ;
                          appendcoerlist(cursor, coercionstodo OF result) ;
                          cursor := childii OF parsetree ;
                          annotatemode (cursor) ;
                          result := iscoercibleto (cursor, amode) ;
                          IF result ISNT modecoerlistnil
                          THEN
                            themode OF cursor := amode ;
                            appendcoerlist(cursor, coercionstodo OF result) ;
                            { also the resulting type is BOOL }
                            themode OF parsetree := amode
                          ELSE
                            writeast(parsetree, 0);
                            error("Semantic Error: second operand must yield BOOL")
                          FI
                        ELSE
                          writeast(parsetree, 0);
                          error("Semantic Error: first operand must yield BOOL")
                        FI
                      ELSE
                        IF thetag = tnot
                        THEN
                          { the operand must be BOOL }
                          amode := newmodenode(boolmode) ;
                          cursor := childi OF parsetree ;
                          annotatemode (cursor) ;
                          result := iscoercibleto(cursor, amode) ;
                          IF result ISNT modecoerlistnil
                          THEN
                            themode OF cursor := amode ;
                            appendcoerlist(cursor, coercionstodo OF result) ;
                            { also the resulting type is BOOL }
                            themode OF parsetree := amode
                          ELSE
                            writeast(parsetree, 0);
                            error("Semantic Error: the operand of a NOT must be a BOOL")
                          FI
                        ELSE
                          IF (thetag = teq) OREL (thetag = tneq) OREL
                             (thetag = tless) OREL (thetag = tgeq) OREL
                             (thetag = tgreater) OREL (thetag = tleq)
                          THEN
                            { both operands must be INT }
                            amode := newmodenode(intmode) ;
                            cursor := childi OF parsetree ;
                            annotatemode (cursor) ;
                            result := iscoercibleto(cursor, amode) ;
                            IF result ISNT modecoerlistnil
                            THEN
                              themode OF cursor := amode ;
                              appendcoerlist(cursor, coercionstodo OF result) ;
                              cursor := childii OF parsetree ;
                              annotatemode (cursor) ;
                              result := iscoercibleto (cursor, amode) ;
                              IF result ISNT modecoerlistnil
                              THEN
                                themode OF cursor := amode ;
                                appendcoerlist(cursor, coercionstodo OF result) ;
                                { the resulting type is BOOL }
                                themode OF parsetree := newmodenode (boolmode)
                              ELSE
                                writeast(parsetree, 0);
                                error("Semantic Error: second operand must yield INT")
                              FI
                            ELSE
                              writeast(parsetree, 0);
                              error("Semantic Error: first operand must yield INT")
                            FI
                          ELSE
                            IF (thetag = tplus) OREL (thetag = tminus)
                            THEN
                              { both operands must be INT but the second is optional }
                              amode := newmodenode(intmode) ;
                              cursor := childi OF parsetree ;
                              annotatemode (cursor) ;
                              result := iscoercibleto(cursor, amode) ;
                              IF result ISNT modecoerlistnil
                              THEN
                                themode OF cursor := amode ;
                                appendcoerlist(cursor, coercionstodo OF result) ;
                                cursor := childii OF parsetree ;
                                IF cursor ISNT astreenil
                                THEN
                                  annotatemode (cursor) ;
                                  result := iscoercibleto(cursor, amode) ;
                                  IF result ISNT modecoerlistnil
                                  THEN
                                    themode OF cursor := amode ;
                                    appendcoerlist(cursor, coercionstodo OF result)
                                  ELSE
                                    writeast(parsetree, 0);
                                    error("Semantic Error: second operand must yield INT")
                                  FI
                                FI ;
                                { the resulting type is INT }
                                themode OF parsetree := amode
                              ELSE
                                writeast(parsetree, 0);
                                error("Semantic Error: first operand must yield INT")
                              FI
                            ELSE
                              IF (thetag = ttimes) OREL (thetag = tmax) OREL
                                 (thetag = tover) OREL (thetag = tmin) OREL
                                 (thetag = tmod) OREL (thetag = tpow)
                              THEN
                                { both operands must be INT }
                                amode := newmodenode(intmode) ;
                                cursor := childi OF parsetree ;
                                annotatemode (cursor) ;
                                result := iscoercibleto(cursor, amode) ;
                                IF result ISNT modecoerlistnil
                                THEN
                                  themode OF cursor := amode ;
                                  appendcoerlist(cursor, coercionstodo OF result) ;
                                  cursor := childii OF parsetree ;
                                  annotatemode (cursor) ;
                                  result := iscoercibleto(cursor, amode) ;
                                  IF result ISNT modecoerlistnil
                                  THEN
                                    themode OF cursor := amode ;
                                    appendcoerlist(cursor,
                                        coercionstodo OF result) ;
                                    { the resulting type is INT }
                                    themode OF parsetree := amode
                                  ELSE
                                    writeast(parsetree, 0);
                                    error("Semantic Error: second operand must yield INT")
                                  FI
                                ELSE
                                  writeast(parsetree, 0);
                                  error("Semantic Error: first operand must yield INT")
                                FI
                              ELSE
                                IF thetag = tsign
                                THEN
                                  { SIGN takes an INT and yields an INT }
                                  amode := newmodenode(intmode) ;
                                  cursor := childi OF parsetree ;
                                  annotatemode (cursor) ;
                                  result := iscoercibleto(cursor, amode) ;
                                  IF result ISNT modecoerlistnil
                                  THEN
                                    themode OF cursor := amode ;
                                    appendcoerlist(cursor, coercionstodo OF result) ;
                                    { the resulting type is also an INT }
                                    themode OF parsetree := amode
                                  ELSE
                                    writeast(parsetree, 0);
                                    error("Semantic Error: the operand of SIGN must be an INT")
                                  FI
                                ELSE
                                  IF thetag = tabs
                                  THEN
                                    { ABS takes a CHAR and yields an INT }
                                    amode := newmodenode(charmode) ;
                                    cursor := childi OF parsetree ;
                                    annotatemode (cursor) ;
                                    result := iscoercibleto(cursor, amode) ;
                                    IF result ISNT modecoerlistnil
                                    THEN
                                      themode OF cursor := amode ;
                                      appendcoerlist(cursor, coercionstodo OF result) ;
                                      { the resulting type is INT }
                                      themode OF parsetree := newmodenode(intmode)
                                    ELSE
                                      writeast(parsetree, 0);
                                      error("Semantic Error: the operand of ABS must be a CHAR")
                                    FI
                                  ELSE
                                    IF thetag = trepr
                                    THEN
                                      { REPR takes an INT and yields a CHAR }
                                      amode := newmodenode(intmode) ;
                                      cursor := childi OF parsetree ;
                                      annotatemode (cursor) ;
                                      result := iscoercibleto(cursor, amode) ;
                                      IF result ISNT modecoerlistnil
                                      THEN
                                        themode OF cursor := amode ;
                                        appendcoerlist(cursor, coercionstodo OF result) ;
                                        { the resulting type is CHAR }
                                        themode OF parsetree := newmodenode(charmode)
                                      ELSE
                                        writeast(parsetree, 0);
                                        error("Semantic Error: the operand of REPR must be a INT")
                                      FI
                                    ELSE
                                      IF thetag = tlwb
                                      THEN
                                        { LWB takes a ROW mode and yields an INT }
                                        amode := newmodenode(rowmode) ;
                                        innermode OF amode := newmodenode (whatever) ;
                                        cursor := childi OF parsetree;
                                        result := iscoercibleto(cursor,
                                        amode);
                                        IF result ISNT modecoerlistnil
                                        THEN
                                        themode OF cursor :=
                                        themode OF result;
                                        appendcoerlist(cursor,
                                        coercionstodo OF result);
                                        { the resulting type is INT }
                                        themode OF parsetree := newmodenode(intmode)
                                        ELSE
                                        writeast(parsetree, 0);
                                        error("Semantic Error: the operand of LWB must have ROW mode")
                                        FI
                                      ELSE
                                        IF thetag = tupb
                                        THEN
                                        { UPB takes a ROW mode and yields an INT }
                                        amode := newmodenode(rowmode) ;
                                        innermode OF amode := newmodenode (whatever) ;
                                        cursor := childi OF parsetree;
                                        result := iscoercibleto(cursor,
                                        amode);
                                        IF result ISNT modecoerlistnil
                                        THEN
                                        themode OF cursor :=
                                        themode OF result;
                                        appendcoerlist(cursor,
                                        coercionstodo OF result);
                                        { the resulting type is INT }
                                        themode OF parsetree := newmodenode(intmode)
                                        ELSE
                                        writeast(parsetree, 0);
                                        error("Semantic Error: the operand of UPB must have ROW mode")
                                        FI
                      ELSE
                        IF thetag = ntsubscript
                        THEN
                          amode := newmodenode(intmode);
                          { anint mantains the number of subscripts in childii }
                          anint := 0 ;
                          cursor := childii OF parsetree;
                          WHILE cursor ISNT astreenil
                          DO
                            annotatemode(cursor);
                            { each unit in the subscript list must yield an int }
                            result := iscoercibleto(cursor, amode);
                            IF result ISNT modecoerlistnil
                            THEN
                              themode OF cursor := themode OF result;
                              appendcoerlist(cursor, coercionstodo OF result);

                              anint := anint + 1 ;
                              cursor := succ OF cursor
                            ELSE
                              writeast(parsetree, 0);
                              error("Semantic Error: subscripts must yield an INT")
                            FI
                          OD;
                          { now we look at the id which should have ROW or REF ROW mode }
                          { with the appropriate number of ROW which is anint }
                          amode := newmodenode(whatever) ;
                          FOR i TO anint
                          DO
                            anothermode := newmodenode(rowmode) ;
                            innermode OF anothermode := amode ;
                            amode := anothermode
                          OD ;

                          cursor := childi OF parsetree;
                          annotatemode(cursor);
                          result := iscoercibleto(cursor, amode);
                          IF result ISNT modecoerlistnil
                          THEN
                            themode OF cursor := themode OF result;
                            appendcoerlist(cursor, coercionstodo OF result);
                            amode := themode OF result;
                            { now recover the basic mode and assign it to the current node }
                            FOR i TO anint
                            DO
                              amode := innermode OF amode
                            OD;
                            themode OF parsetree := amode
                          ELSE
                            { the id could also have a leading REF }
                            anothermode := newmodenode(refmode);
                            innermode OF anothermode := amode;
                            amode := anothermode;
                            result := iscoercibleto(cursor, amode);
                            IF result ISNT modecoerlistnil
                            THEN
                              themode OF cursor := themode OF result;
                              appendcoerlist(cursor, coercionstodo OF result);
                              amode := innermode OF themode OF result;
                              FOR i TO anint
                              DO
                                amode := innermode OF amode
                              OD;
                              anothermode := newmodenode(refmode);
                              innermode OF anothermode := amode;
                              themode OF parsetree := anothermode
                            ELSE
                              writeast(parsetree, 0);
                              error("Semantic Error: id of subscripts must be ROW or REF ROW")
                            FI
                          FI
                        ELSE
                          IF thetag = tof
                          THEN
                            cursor := childii OF parsetree ;
                            annotatemode(cursor) ;
                            amode := newmodenode (structmode) ;
                            result := iscoercibleto (cursor,
                                        amode) ;
                            IF result ISNT modecoerlistnil
                            THEN
                              appendcoerlist (cursor,
                                        coercionstodo OF result) ;
                              amode := themode OF result ;
                              themode OF cursor := amode ;
                              anidlist := fieldlist OF amode ;
                              astring := semval OF childi OF parsetree ;
                              WHILE (anidlist ISNT idlistnil) ANDTH
                                    (stringcmp(astring, theid OF anidlist) /= 0)
                              DO
                                anidlist := succ OF anidlist
                              OD ;
                              IF anidlist ISNT idlistnil
                              THEN
                                themode OF childi OF parsetree :=
                                   themode OF anidlist ;
                                themode OF parsetree :=
                                   themode OF anidlist
                              ELSE
                                writeast(parsetree, 0);
                                error("Semantic Error: no field with appropriate name in the STRUCT")
                              FI
                            ELSE
                              anothermode := amode ;
                              amode := newmodenode (refmode) ;
                              innermode OF amode := anothermode;
                              result := iscoercibleto (cursor,
                                        amode) ;
                              IF result ISNT modecoerlistnil
                              THEN
                                appendcoerlist (cursor,
                                        coercionstodo OF result) ;
                                amode := themode OF result ;
                                themode OF cursor := amode ;
                                anidlist :=
                                   fieldlist OF innermode OF amode ;
                                astring := semval OF childi OF parsetree ;
                                WHILE (anidlist ISNT idlistnil) ANDTH
                                      (stringcmp(astring, theid OF anidlist) /= 0)
                                DO
                                  anidlist := succ OF anidlist
                                OD ;
                                IF anidlist ISNT idlistnil
                                THEN
                                  themode OF childi OF parsetree :=
                                     themode OF anidlist ;
                                  amode := newmodenode (refmode) ;
                                  innermode OF amode :=
                                     themode OF anidlist ;
                                  themode OF parsetree := amode
                                ELSE
                                  writeast(parsetree, 0);
                                  error("Semantic Error: no field with appropriate name in the STRUCT")
                                FI
                              ELSE
                                writeast(parsetree, 0);
                                error("Semantic Error: OF requires a STRUCT or REF STRUCT on the rhs")
                              FI
                            FI
                          ELSE
                            IF (thetag = tloc) OREL (thetag = theap)
                            THEN
                              { first we type check the inner mode }
                              cursor := childii OF parsetree ;
                              amode := packmodetree (cursor) ;
                              themode OF cursor := amode ;

                              { all eventual units must yield int }
                              { while we chech them we build the return mode }
                              cursor := childi OF parsetree ;
                              WHILE cursor ISNT astreenil
                              DO
                                annotatemode(cursor) ;
                                result := iscoercibleto (cursor,
                                        newmodenode (intmode)) ;
                                IF result ISNT modecoerlistnil
                                THEN
                                  appendcoerlist (cursor,
                                        coercionstodo OF result) ;
                                  themode OF cursor :=
                                     themode OF result
                                ELSE
                                  writeast(parsetree, 0);
                                  error("Semantic Error: couldn\'t type check a LOC-HEAP clause")
                                FI ;

                                anothermode := newmodenode (rowmode) ;
                                innermode OF anothermode :=
                                   amode ;
                                amode := anothermode ;
                                cursor := succ OF cursor
                              OD ;

                              { add the ref in front of the mode built so far }
                              anothermode := newmodenode (refmode) ;
                              innermode OF anothermode :=
                                 amode ;
                              amode := anothermode ;
                              
                              themode OF parsetree := amode
                            ELSE
                              IF (thetag = tbasemode) OREL (thetag = tref) OREL
                                 (thetag = tlbracket) OREL (thetag = tproc) OREL
                                 (thetag = tstruct)
                              THEN
                                { we should never get here! }
                                { just compute the mode and stick it in the correct field }
                                themode OF parsetree :=
                                   packmodetree (parsetree)
                              ELSE
                                IF thetag = ntusermodedecl
                                THEN
                                  { we just need to void user modes declaration }
                                  themode OF parsetree := newmodenode (voidmode)
                                ELSE
                                  { all remaining cases do not need special care }
                                  IF debugging
                                  THEN
                                    fputs(1, "Skipping annotatemode on a ") ;
                                    fputint (1, tag OF parsetree) ;
                                    fputnl(1)
                                  FI
                                FI
                              FI
                            FI
                          FI
                        FI
                      FI
                    FI

                                      FI
                                    FI
                                  FI
                                FI
                              FI
                            FI
                          FI
                        FI
                      FI
                    FI
                  FI
                FI
              FI
            FI
          FI
        FI

{ this closes from the start down to the conditional clause included }
                  FI
                FI
              FI
            FI
          FI
        FI
      FI
    FI
  FI
END;

PROC VOID initusermodetable = VOID :
BEGIN
  FOR i FROM 0 BY 1 TO 255
  DO
    usermodeind OF usermodetable[i] := NIL ;
    definedmode OF usermodetable[i] := NIL
  OD
END ;

PROC( ASTREE) VOID buildblocktable = ( ASTREE parsetree) VOID :
BEGIN
  REF INT actrecordblock = LOC INT ;
  REF INT currentoffset = LOC INT ;
  REF INT tmpalignment = LOC INT ;
  REF IDLIST idcursor = LOC IDLIST ;

  { first initialize the table }
  FOR i FROM 0 BY 1 TO 4095
  DO
    parent OF blocktable[i] := -1 ;
    maxoffset OF blocktable[i] := -1 ;
    blocksubtree OF blocktable[i] := NIL ;
    variables OF blocktable[i] := NIL
  OD ;

  { fill the first entry ad hoc }
  blocknum OF parsetree := 0 ;

  blocksubtree OF blocktable[0] := parsetree ;
  variables OF blocktable[0] := gatheridlist (parsetree) ;
  
  nextblocknum := 1 ;

  { now call the recursive gatherblock to fill it up }
  gatherblock (parsetree) ;

  { now it is time to assign offsets to variables }
  { not all blocks correspond to an activation record }
  { only blocks introduced by ntroutineval do }
  { those blocks had the maxoffset field set to the value of }
  { the constant displacement during the call to gatherblock }

  { we do not consider block 0 since it just contain the main }
  FOR i FROM 1 BY 1 TO nextblocknum - 1
  DO
    { first we need to find an ancestor associated to an activation }
    { record --- we can distinguish them from their maxoffset field }
    actrecordblock := i ;
    WHILE maxoffset OF blocktable[actrecordblock] = -1
    DO
      actrecordblock := parent OF blocktable[actrecordblock]
    OD ;
    currentoffset := maxoffset OF blocktable[actrecordblock] ;
    { prepare to go through all vars in the list variables of the block at hand }
    idcursor := variables OF blocktable[i] ;

    WHILE idcursor ISNT idlistnil
    DO
      IF tag OF themode OF idcursor /= procmode
      THEN
        { figure out the offset for this field }
        tmpalignment := alignment OF themode OF idcursor ;
        currentoffset := ( ( currentoffset + tmpalignment - 1 ) OVER
                                       tmpalignment
                                     ) * tmpalignment ;

        offset OF idcursor := currentoffset ;
        { now update the currentoffset }
        currentoffset := currentoffset +
                                     size OF themode OF idcursor
      FI ;
      idcursor := succ OF idcursor
    OD ;

      { update the value of the max offset used in this activation record }
    maxoffset OF blocktable[actrecordblock] := currentoffset
  OD
END ;

PROC( MODETREE, INT) VOID checkforloopandwrite = ( MODETREE modetree, INT indentation) VOID :
BEGIN
   REF INT anindex = LOC INT;

   anindex := 0;

   WHILE (definedmode OF usermodetable[anindex] ISNT modetreenil) ANDTH
         (definedmode OF usermodetable[anindex] ISNT modetree)
   DO
     anindex := anindex + 1
   OD;
   
   IF definedmode OF usermodetable[anindex] IS modetreenil
   THEN writemodetree(modetree, indentation)
   ELSE FOR i TO indentation
        DO
          fputs(1, " ")
        OD;
        fputs(1, "basemode ");
        fputs(1, usermodeind OF usermodetable[anindex]);
        fputnl(1)
   FI
END;

PROC( IDLIST, INT) VOID writeidlist = ( IDLIST idlist, INT indentation) VOID :
BEGIN
  REF IDLIST idcursor = LOC IDLIST ;
     
  idcursor := idlist;

  FOR i TO indentation
  DO
    fputs(1, " ")
  OD ;
  fputs(1, theid OF idcursor) ;
  fputs(1, ": +");
  fputint(1, offset OF idcursor);
  fputnl(1) ;

  checkforloopandwrite(themode OF idcursor, indentation + 1) ;
  idcursor := succ OF idcursor ;
  WHILE idcursor ISNT idlistnil
  DO
    fputs(1, " ->") ;
    fputnl(1) ;
  FOR i TO indentation
  DO
    fputs(1, " ")
  OD ;
  fputs(1, theid OF idcursor) ;
  fputs(1, ": +");
  fputint(1, offset OF idcursor);
  fputnl(1) ;

  checkforloopandwrite(themode OF idcursor, indentation + 1) ;
  idcursor := succ OF idcursor
  OD
END ;

PROC( MODETREE, INT) VOID writemodetree = ( MODETREE modetree, INT indentation) VOID :
BEGIN
  REF MODESLIST modecursor = LOC MODESLIST ;

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

  IF modetree IS modetreenil
  THEN
    error("PANIC: there should be a mode tree here!!")
  ELSE
    IF indentation > 20
    THEN
      fputs(1, "( ... )")
    ELSE
      fputs(1, "(");
      fputint(1, tag OF modetree);
      fputs(1, ": ") ;
      fputint(1, size OF modetree) ;
      fputs(1, " ") ;
      fputint(1, alignment OF modetree) ;
      fputnl(1);

      IF (tag OF modetree /= boolmode) ANDTH
         (tag OF modetree /= intmode) ANDTH
         (tag OF modetree /= charmode) ANDTH
         (tag OF modetree /= voidmode)
      THEN
        IF tag OF modetree = refmode
        THEN
          fputnl(1);

          checkforloopandwrite(innermode OF modetree, indentation+1)
        ELSE
          IF tag OF modetree = rowmode
          THEN
            fputnl(1);
  
            checkforloopandwrite(innermode OF modetree, indentation+1)
          ELSE
            IF tag OF modetree = structmode
            THEN
              fputnl(1);
  
              writeidlist(fieldlist OF modetree, indentation + 1)
            ELSE
              IF tag OF modetree = procmode
              THEN
                fputnl(1);

                modecursor := argsmode OF modetree;
                IF modecursor ISNT modeslistnil
                THEN
                  checkforloopandwrite(themode OF modecursor, indentation+1) ;
                  modecursor := succ OF modecursor ;
                  WHILE modecursor ISNT modeslistnil
                  DO
                    fputs(1, " ->") ;
                    fputnl(1) ;
                    checkforloopandwrite(themode OF modecursor, indentation+1) ;
                    modecursor := succ OF modecursor
                  OD ;
                  fputnl(1)
                FI ;
            
                checkforloopandwrite(innermode OF modetree, indentation+1)
              FI
            FI
          FI
        FI ;
        FOR i TO indentation
        DO
          fputs(1, " ")
        OD
      FI ;
      fputs(1, ")") ;
      fputnl(1)
    FI
  FI
END ;

PROC VOID writeusermodes = VOID :
BEGIN
  REF INT anindex = LOC INT ;
  REF INT anotherindex = LOC INT ;

  anindex := 0 ;
  anotherindex := 0 ;
  WHILE usermodeind OF usermodetable[anindex] ISNT stringnil
  DO
    fputs(1, usermodeind OF usermodetable[anindex]) ;
    fputnl(1) ;

    writemodetree(definedmode OF usermodetable[anindex], 0) ;
    fputnl(1) ;
    fputnl(1) ;
    anindex := anindex + 1
  OD
END ;

PROC VOID writeblocktable = VOID :
BEGIN
  FOR i FROM 0 BY 1 TO nextblocknum - 1
  DO
    fputs(1, "block no. < ") ;
    fputint(1, i) ;
    fputs(1, " >") ;
 
    fputnl(1) ;

    IF variables OF blocktable[i] ISNT idlistnil
    THEN
      writeidlist(variables OF blocktable[i], 0)
    ELSE
      fputs(1, "no identifier declared in this block")
    FI ;

    fputnl(1) ;
    fputnl(1)
  OD
END ;

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

  IF codetree IS astreenil
  THEN
    fputs(1, "-");
    fputnl(1)
  ELSE
    fputs(1, "(");

    fputs(1, "<");
    fputint(1, parent OF blocktable[blocknum OF codetree]) ;
    fputs(1, " <-- ") ;
    fputint(1, blocknum OF codetree);
    fputs(1, "> ");

    fputint(1, tag OF codetree);

    fputs(1, " @ ") ;
    fputint(1, context 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
END ;

{ to avoid doing IO of all the structures computed so far }
{ the phase of code generation is contained in this same file }
{ it is conceptually a separate phase that only uses the parsetree }
{ the usermodetable and the blocktable constructed so far }

{ procs that actually issue MMIX assembly code }

PROC( REF [] CHAR) VOID issuesimpleline = ( REF [] CHAR opfield) VOID :
BEGIN
  { first indent }
  FOR i TO labelwidth + 1
  DO
    fputs(1, " ")
  OD ;

  { now issue the code }
  fputs(1, opfield) ;
  fputnl(1)
END ;

PROC( REF [] CHAR, INT) VOID issuelabelnum = ( REF [] CHAR labelfield, INT num) VOID :
BEGIN
  REF INT moreblanks = LOC INT ;
  { issue the label and see how many more blanks do we need }
  moreblanks := labelwidth + 1 - fputs(1, labelfield) ;
  IF num >= 0
  THEN
    moreblanks := moreblanks - fputint (1, num)
  FI ;

  FOR i TO moreblanks
  DO
    fputs(1, " ")
  OD
END ;

PROC( REF [] CHAR) VOID issuelabel = ( REF [] CHAR labelfield) VOID :
BEGIN
  issuelabelnum (labelfield, -1)
END ;

PROC( REF [] CHAR, REF [] CHAR) VOID issuelabelnline = ( REF [] CHAR labelfield, REF [] CHAR opfield) VOID :
BEGIN
  issuelabel (labelfield) ;
  fputs(1, opfield) ;
  fputnl(1)
END ;

PROC( INT, INT) VOID issuecopyinttoreg = ( INT r, INT n) VOID :
BEGIN
  { integer could be more tan 16-bit long }
  { higher wyde }
  issuelabel("") ;
  fputs(1, "SETML $") ;
  fputint(1, r) ;
  fputs(1, ",") ;
  fputint(1, n OVER 65536) ;
  fputnl(1) ;

  { lower wyde }
  issuelabel("") ;
  fputs(1, "INCL $") ;
  fputint(1, r) ;
  fputs(1, ",") ;
  fputint(1, n MOD 65536) ;
  fputnl(1)
END ;

{ this procedure is used to dump the standard MMIX assembly preamble }
PROC VOID issuemmsheader = VOID :
BEGIN
  { some credit to the author ... }
  fputs(1, "*---------------------------------------------------------*") ;
  fputnl(1);
  fputs(1, "| |") ;
  fputnl(1);
  fputs(1, "| 2002/06/25 --- Nicolosi Antonio, CS@NYU |") ;
  fputnl(1);
  fputs(1, "| |") ;
  fputnl(1);
  fputs(1, "| This code was generated with AlgolNix2MMIX version 1.0 |") ;
  fputnl(1);
  fputs(1, "| |") ;
  fputnl(1);
  fputs(1, "| |") ;
  fputnl(1);
  fputs(1, "| (C) 2002 Antonio Nicolosi (just in case :) |") ;
  fputnl(1);
  fputs(1, "| All Rights Reserved |") ;
  fputnl(1);
  fputs(1, "*---------------------------------------------------------*") ;
  fputnl(1);
  
  { set up all the aliases used for registers }

  { special register used for OS calls }
  issuelabelnline("OS", "IS $255") ;
  { base of the control stack }
  issuelabelnline("SB", "GREG Data_Segment") ;
  { base of the current activation record }
  issuelabelnline("FP", "GREG 0") ;
  { top of the control stack used so far }
  issuelabelnline("SP", "GREG 0") ;
  { base of the GCed heap }
  issuelabelnline("HB", "GREG Pool_Segment") ;
  { top of the GCed heap used so far }
  issuelabelnline("HP", "GREG 0") ;
  { we mantain a small display: FP1 is the static link ... }
  issuelabelnline("FP1","GREG 0") ;
  { ... FP2 is the two-level-up static link ... }
  issuelabelnline("FP2", "GREG 0") ;
  { ... FP3 is the three-level-up static link ... }
  issuelabelnline("FP3", "GREG 0") ;
  { ... FP4 is the four-level-up: upper-level are computed on the fly }
  issuelabelnline("FP4", "GREG 0") ;
  { used for procedure calls and other stuff }
  issuelabelnline("EXTRA", "GREG 0") ;
  { used to return the value from a proc call }
  issuelabelnline("VALUE", "GREG 0") ;

  { start issuing code in the Text_Segment }
  { when the main procedure returns it will jump at location #F8 = #100 - #8 }
  { so we need to prepare a pair of instrucions equivalent to the C exit 0 }
  issuesimpleline("LOC #F8") ;
  issuesimpleline("SET OS,0") ;
  issuesimpleline("TRAP 0,Halt,0") ;
  issuesimpleline("LOC #100") ;
  issuelabelnline("Main", "SET FP,SB") ;
  { the bottom of the heap is occupied by argv }
  issuesimpleline("LDO HP,HB") ;

  { the following build a fake activation record for the first proc to be called }
  { notice the return address we are setting }
  issuesimpleline("STCO #F8,FP,0") ;
  issuesimpleline("STCO 0,FP,8");
  issuesimpleline("STCO 0,FP,16") ;
  { the rudimentary OS for MMIX initially sets $0 and $1 as argc and argv formals }
  issuesimpleline("STT $0,FP,24") ;
  issuesimpleline("STO $1,FP,32") ;
  issuesimpleline("SET SP,FP") ;

  { load the maxoffset for block 1 into a temporary register }
  issuecopyinttoreg(newtemporary, maxoffset OF blocktable[1]) ;
  issuelabel("") ;
  fputs(1, "ADDU SP,SP,$") ;
  { complete the above line with the correct temporary register }
  fputint(1, newtemporary);
  fputnl(1)
END ;


{ regs is how many --- so $0 ... $ regs-1 }
PROC( INT) VOID saveglobals = ( INT regs) VOID :
BEGIN
  { align the stack pointer before storing octas }
  issuesimpleline("INCL SP,7") ;
  issuesimpleline("ANDN SP,SP,7") ;
  { save global registers that do not go in the activation record }
  issuesimpleline("STO FP1,SP,0") ;
  issuesimpleline("STO FP2,SP,8") ;
  issuesimpleline("STO FP3,SP,16") ;
  issuesimpleline("STO FP4,SP,24") ;
  { advance SP once for all the pushes }
  issuesimpleline("INCL SP,32") ;
  { now push one by one all the temporaries used so far ie $0 ... $ regs-1 }
  FOR i TO regs
  DO
    issuelabel("") ;
    fputs(1, "STO $") ;
    fputint(1, i - 1) ;
    fputs(1, ",SP") ;
    fputnl(1) ;
    issuesimpleline("INCL SP,8")
  OD
END ;

{ regs is how many --- so $0 ... $ regs-1 }
PROC( INT) VOID unsaveglobals = ( INT regs) VOID :
BEGIN
  { pop one by one all the temporaries used so far ie $0 ... $ regs-1 }
  FOR i TO regs
  DO
    issuesimpleline("SUBU SP,SP,8") ;
    issuelabel("") ;
    fputs(1, "LDO $") ;
    fputint(1, regs - i) ;
    fputs(1, ",SP") ;
    fputnl(1)
  OD ;

  { move SP back once for all next pops }
  issuesimpleline("SUBU SP,SP,32") ;
  { now restore the small display }
  issuesimpleline("LDO FP4,SP,24") ;
  issuesimpleline("LDO FP3,SP,16") ;
  issuesimpleline("LDO FP2,SP,8") ;
  issuesimpleline("LDO FP1,SP,0")
END ;

{ this proc is used to locate the activation record x level up }
PROC( INT) VOID followstaticlink = ( INT x) VOID :
BEGIN
  IF x = 0
  THEN
    issuesimpleline("SET EXTRA,FP")
  ELSE
    IF x = 1
    THEN
      issuesimpleline("SET EXTRA,FP1")
    ELSE
      IF x = 2
      THEN
        issuesimpleline("SET EXTRA,FP2")
      ELSE
        IF x = 3
        THEN
          issuesimpleline("SET EXTRA,FP3")
        ELSE
          IF x >= 4
          THEN
            issuesimpleline("SET EXTRA,FP4") ;
            FOR i FROM 5 BY 1 TO x
            DO
              issuesimpleline("LDO EXTRA,EXTRA,16")
            OD
          ELSE
            error("PANIC: cannot follow the static link a negative number of times!")
          FI
        FI
      FI
    FI
  FI

END ;

PROC( ASTREE) VOID issueproccall = ( ASTREE parsetree) VOID :
BEGIN
  REF ASTREE functor = LOC ASTREE ;
  REF ASTREE cursor = LOC ASTREE ;
  REF IDLIST anid = LOC IDLIST ;
  REF INT distance = LOC INT ;
  REF INT ablock = LOC INT ;
  REF INT anint = LOC INT ;
  REF INT offsetreg = LOC INT ;
  REF INT stackedregs = LOC INT ;

  REF [] CHAR functorid = semval OF childi OF parsetree ;

  { we have to recognize primitive functions and in case generate }
  { the corresponding system call }
  IF stringcmp(functorid, "exit") = 0
  THEN
    cursor := childii OF parsetree ;
    IF tag OF cursor = tintconst
    THEN
      anint := asciitoint(semval OF cursor) ;
      issuelabel("");
      fputs(1, "TRAP 0,Halt,") ;
      fputint(1, anint) ;
      fputnl(1)
    ELSE
      writeast(parsetree, 0);
      error("Code Generation Error: can only specify compile-time INT constant as exit code")
    FI
  ELSE
    IF stringcmp(functorid, "fopen") = 0
    THEN
      cursor := childii OF parsetree ;
      IF tag OF cursor = tintconst
      THEN
        anint := asciitoint(semval OF cursor) ;
        { now evaluate the second argument }
        cursor := succ OF cursor ;
        issuecode(cursor) ;
        { store this value somewhere on the stack but first align SP as octa }
        issuesimpleline("INCL SP,7") ;
        issuesimpleline("ANDN SP,SP,7") ;
        issuesimpleline("STO VALUE,SP,0") ;
        { now evaluate the third argument }
        cursor := succ OF cursor ;
        issuecode(cursor) ;
        { store this value after the previous one on the stack }
        issuesimpleline("STO VALUE,SP,8") ;
        { the system call expect the global register OS to point to the second arg }
        issuesimpleline("SET OS,SP") ;
        issuelabel("") ;
        fputs(1, "TRAP 0,Fopen,") ;
        fputint(1, anint) ;
        fputnl(1) ;
        issuesimpleline("SET VALUE,OS")
      ELSE
        writeast(parsetree, 0);
        error("Code Generation Error: can only specify compile-time INT constant as file handle")
      FI
    ELSE
      IF stringcmp(functorid, "fclose") = 0
      THEN
        cursor := childii OF parsetree ;
        IF tag OF cursor = tintconst
        THEN
          anint := asciitoint(semval OF cursor) ;
          issuelabel("");
          fputs(1, "TRAP 0,Fclose,") ;
          fputint(1, anint) ;
          fputnl(1) ;
          issuesimpleline("SET VALUE,OS")
        ELSE
          writeast(parsetree, 0);
          error("Code Generation Error: can only specify compile-time INT constant as file handle")
        FI
      ELSE
        IF stringcmp(functorid, "fputs") = 0
        THEN
          cursor := childii OF parsetree ;
          IF tag OF cursor = tintconst
          THEN
            anint := asciitoint(semval OF cursor) ;
            { now evaluate the second argument }
            cursor := succ OF cursor ;
            issuecode(cursor) ;
            issuesimpleline("SET OS,VALUE") ;
            issuelabel("") ;
            fputs(1, "TRAP 0,Fputs,") ;
            fputint(1, anint) ;
            fputnl(1) ;
            issuesimpleline("SET VALUE,OS")
          ELSE
            writeast(parsetree, 0);
            error("Code Generation Error: can only specify compile-time INT constant as file handle")
          FI
        ELSE
          IF stringcmp(functorid, "fgets") = 0
          THEN
            cursor := childii OF parsetree ;
            IF tag OF cursor = tintconst
            THEN
              anint := asciitoint(semval OF cursor) ;
              { now evaluate the second argument }
              cursor := succ OF cursor ;
              issuecode(cursor) ;
              { store this value somewhere on the stack but first align SP as octa }
              issuesimpleline("INCL SP,7") ;
              issuesimpleline("ANDN SP,SP,7") ;
              issuesimpleline("STO VALUE,SP,0") ;
              { now evaluate the third argument }
              cursor := succ OF cursor ;
              issuecode(cursor) ;
              { store this value after the previous one on the stack }
              issuesimpleline("STO VALUE,SP,8") ;
              { the system call expect the global register OS to point to the second arg }
              issuesimpleline("SET OS,SP") ;
              issuelabel("") ;
              fputs(1, "TRAP 0,Fgets,") ;
              fputint(1, anint) ;
              fputnl(1) ;
              issuesimpleline("SET VALUE,OS")
            ELSE
              writeast(parsetree, 0);
              error("Code Generation Error: can only specify compile-time INT constant as file handle")
            FI
          ELSE
            IF stringcmp(functorid, "fwrite") = 0
            THEN
              cursor := childii OF parsetree ;
              IF tag OF cursor = tintconst
              THEN
                anint := asciitoint(semval OF cursor) ;
                { now evaluate the second argument }
                cursor := succ OF cursor ;
                issuecode(cursor) ;
                { store this value somewhere on the stack but first align SP as octa }
                issuesimpleline("INCL SP,7") ;
                issuesimpleline("ANDN SP,SP,7") ;
                issuesimpleline("STO VALUE,SP,0") ;
                { now evaluate the third argument }
                cursor := succ OF cursor ;
                issuecode(cursor) ;
                { store this value after the previous one on the stack }
                issuesimpleline("STO VALUE,SP,8") ;
                { the system call expect the global register OS to point to the second arg }
                issuesimpleline("SET OS,SP") ;
                issuelabel("") ;
                fputs(1, "TRAP 0,Fwrite,") ;
                fputint(1, anint) ;
                fputnl(1) ;
                issuesimpleline("SET VALUE,OS")
              ELSE
                writeast(parsetree, 0);
                error("Code Generation Error: can only specify compile-time INT constant as file handle")
              FI
            ELSE
              IF stringcmp(functorid, "fread") = 0
              THEN
                cursor := childii OF parsetree ;
                IF tag OF cursor = tintconst
                THEN
                  anint := asciitoint(semval OF cursor) ;
                  { now evaluate the second argument }
                  cursor := succ OF cursor ;
                  issuecode(cursor) ;
                  { store this value somewhere on the stack but first align SP as octa }
                  issuesimpleline("INCL SP,7") ;
                  issuesimpleline("ANDN SP,SP,7") ;
                  issuesimpleline("STO VALUE,SP,0") ;
                  { now evaluate the third argument }
                  cursor := succ OF cursor ;
                  issuecode(cursor) ;
                  { store this value after the previous one on the stack }
                  issuesimpleline("STO VALUE,SP,8") ;
                  { the system call expect the global register OS to point to the second arg }
                  issuesimpleline("SET OS,SP") ;
                  issuelabel("") ;
                  fputs(1, "TRAP 0,Fread,") ;
                  fputint(1, anint) ;
                  fputnl(1) ;
                  issuesimpleline("SET VALUE,OS")
                ELSE
                  writeast(parsetree, 0);
                  error("Code Generation Error: can only specify compile-time INT constant as file handle")
                FI
              ELSE
                IF stringcmp(functorid, "fputnl") = 0
                THEN
                  cursor := childii OF parsetree ;
                  IF tag OF cursor = tintconst
                  THEN
                    { we need to allocate a string for #a which is the newline in MMIX }
                    issuesimpleline("INCL SP,7") ;
                    issuesimpleline("ANDN SP,SP,7") ;
                    issuesimpleline("SETH VALUE,#0A00") ;
                    issuesimpleline("STO VALUE,SP,0") ;
                    issuesimpleline("SET OS,SP") ;
                    anint := asciitoint(semval OF cursor) ;
                    issuelabel("");
                    fputs(1, "TRAP 0,Fputs,") ;
                    fputint(1, anint) ;
                    fputnl(1) ;
                    issuesimpleline("SET VALUE,OS")
                  ELSE
                    writeast(parsetree, 0);
                    error("Code Generation Error: can only specify compile-time INT constant as file handle")
                  FI
                ELSE
                  { so it is a user defined function }

                  { save the current stack pointer in a temporary reg }
                  issuelabel("") ;
                  fputs(1, "SET $") ;
                  fputint(1, newtemporary) ;
                  fputs(1, ",SP") ;
                  fputnl(1);
                  newtemporary := newtemporary + 1 ;
                  stackedregs := newtemporary ;

                  { now evaluate the actuals }
                  cursor := childii OF parsetree ;
                  WHILE cursor ISNT astreenil
                  DO
                    issuecode(cursor) ;
                    issuelabel("") ;
                    fputs(1, "SET $");
                    fputint(1, newtemporary) ;
                    newtemporary := newtemporary + 1 ;
                    fputs(1, ",VALUE") ;
                    fputnl(1) ;

                    cursor := succ OF cursor
                  OD ;

                  { save the global register for the display }
                  { and the local ones }
                  saveglobals (stackedregs) ;

                  { set up the dynamic and static link }
                  functor := childi OF parsetree ;
                  issuesimpleline("STO FP,SP,8") ;
                  distance := computenesting(blocknum OF functor) -
                                        computenesting(blockofname(functor)) ;


                  followstaticlink (distance) ;
                  issuesimpleline("STO EXTRA,SP,16") ;

                  anid := resolvename (functor) ;
                  IF anid IS idlistnil
                  THEN
                    writeast(parsetree, 0);
                    error("PANIC: how could it pass type checking if I cannot find its definition?")
                  FI ;
                  cursor := childii OF thevalue OF anid ;
                  ablock := blocknum OF cursor ;
                  anid := variables OF blocktable[ablock] ;
                  IF anid ISNT idlistnil
                  THEN
                    { choose a register to hold the offsets }
                    offsetreg := newtemporary ;
                    newtemporary := newtemporary + 1 ;
                    { push formals onto the stack }
                    cursor := childii OF parsetree ;
                    FOR formalreg FROM stackedregs BY 1 TO newtemporary - 2
                    DO
                      issuecopyinttoreg(offsetreg, offset OF anid) ;
                      issuelabel("") ;
                      anint := tag OF themode OF anid ;
                      IF anint = refmode
                      THEN
                        fputs(1, "STO $")
                      ELSE
                        IF anint = intmode
                        THEN
                          fputs(1, "STT $")
                        ELSE
                          IF (anint = charmode) OREL (anint = boolmode)
                          THEN
                            fputs(1, "STBU $")
                          ELSE
                            writeast(parsetree, 0) ;
                            error("Code Generation Error: not implementing composite arguments")
                          FI
                        FI
                      FI ;
                      fputint(1, formalreg) ;
                      fputs(1, ",SP,$") ;
                      fputint(1, offsetreg) ;
                      fputnl(1) ;
                      cursor := succ OF cursor ;
                      anid := succ OF anid
                    OD ;

                    { free the register offsetreg }
                    newtemporary := offsetreg
                  FI ;

                  { set the display global registers for the called proc }
                  IF distance = 0
                  THEN
                    { downward call --- slide current display }
                    issuesimpleline("SET FP4,FP3") ;
                    issuesimpleline("SET FP3,FP2") ;
                    issuesimpleline("SET FP2,FP1") ;
                    { the static link for the calles proc is our frame pointer }
                    issuesimpleline("SET FP1,FP")
                  ELSE
                    IF distance > 1
                    THEN
                      { upward call --- just recompute the display starting from FP1 }
                      followstaticlink (distance) ;
                      issuesimpleline ("SET FP1,EXTRA");
                      followstaticlink (distance + 1) ;
                      issuesimpleline ("SET FP2,EXTRA");
                      followstaticlink (distance + 2) ;
                      issuesimpleline ("SET FP3,EXTRA");
                      followstaticlink (distance + 3) ;
                      issuesimpleline ("SET FP4,EXTRA")
                    FI
                    { the else part means same-level call --- nothing to be done }
                  FI ;
                  { now set the returning address ... }
                  issuesimpleline ("GETA EXTRA,@+28") ;
                  issuesimpleline ("STO EXTRA,SP,0") ;
                  { ... and fix FP and SP }
                  issuesimpleline ("SET FP,SP") ;

                  offsetreg := newtemporary ;
                  newtemporary := newtemporary + 1 ;

                  issuecopyinttoreg(offsetreg, maxoffset OF blocktable[ablock]) ;
                  issuelabel("") ;
                  fputs(1, "ADDU SP,SP,$") ;
                  fputint(1, offsetreg) ;
                  fputnl(1) ;

                  newtemporary := offsetreg ;

                  { finally we go!! }
                  issuelabel("");
                  fputs(1, "JMP ") ;
                  fputs(1, semval OF functor) ;
                  fputnl(1) ;

                  { now we are back from the call --- unsave everything }
                  unsaveglobals (stackedregs) ;
                  issuelabel("") ;
                  fputs(1, "SET SP,$") ;
                  fputint(1, stackedregs - 1) ;
                  fputnl(1) ;
                  newtemporary := stackedregs - 1
                  { the result of the call is left in the global register VALUE }
                FI
              FI
            FI
          FI
        FI
      FI
    FI
  FI
END ;

PROC( ASTREE) VOID issueroutineval = ( ASTREE parsetree) VOID :
BEGIN
  { recurse on the body of this routine value }
  issuecode(childii OF parsetree) ;

  { restore the Stack Pointer and the Frame Pointer }
  issuesimpleline("SET SP,FP") ;
  issuesimpleline("LDO EXTRA,FP") ;
  issuesimpleline("LDO FP,SP,8") ;
  issuesimpleline("GO EXTRA,EXTRA,0")

END ;

PROC( ASTREE) VOID issueidentitydecl = ( ASTREE parsetree) VOID :
BEGIN
  REF IDLIST anidlist = LOC IDLIST ;
  REF INT atag = LOC INT ;
  REF INT offsetreg = LOC INT ;

  atag := tag OF themode OF childii OF parsetree ;
  { declarations of proc are special --- they define code and not data }
  IF atag /= procmode
  THEN
    { evaluate the unit on the rhs }
    issuecode (childiii OF parsetree) ;

    { clearly all identifier we declare are local --- no need to follow static link }
    { now compute the offset for the declared identifier }
    anidlist := resolvename(childii OF parsetree) ;
    offsetreg := newtemporary ;
    newtemporary := newtemporary + 1 ;
    issuecopyinttoreg(offsetreg, offset OF anidlist) ;

    issuelabel("") ;
    { choose the right type of STore instruction based on the mode of the rhs }
    IF atag = refmode
    THEN
      fputs(1, "STO VALUE,FP,$")
    ELSE
      IF atag = intmode
      THEN
        fputs(1, "STT VALUE,FP,$")
      ELSE
        IF (atag = charmode) OREL (atag = boolmode)
        THEN
          fputs(1, "STBU VALUE,FP,$")
        ELSE
          writeast(parsetree, 0) ;
          error("Code Generation Error: not implementing declaration of composites")
        FI
      FI
    FI ;

    { finally print out the right offset }
    fputint(1, offsetreg) ;
    fputnl(1) ;

    newtemporary := offsetreg
  FI
END ;

PROC( ASTREE) VOID issueclosedclause = ( ASTREE parsetree) VOID :
BEGIN
  REF ASTREE cursor = LOC ASTREE;

  cursor := childi OF parsetree ;
  { we need to take care of all the phrases in this closed clause }
  WHILE succ OF cursor ISNT astreenil
  DO
    issuecode(cursor) ;

    cursor := succ OF cursor
  OD ;
  { the last one is special }
  appendcoerlist (cursor, coercionstodo OF parsetree) ;
  themode OF cursor := themode OF parsetree;
  coercionstodo OF parsetree := clistnil ;
  issuecode (cursor)
END ;

PROC( ASTREE) VOID issueifthen = ( ASTREE parsetree) VOID :
BEGIN
  REF ASTREE cursor = LOC ASTREE;
  REF INT filabel = LOC INT ;

  cursor := childi OF parsetree ;
  { we need to take care of all the phrases in the IF serial clause }
  WHILE cursor ISNT astreenil
  DO
    issuecode(cursor) ;

    cursor := succ OF cursor
  OD ;

  issuelabel("") ;
  fputs(1, "BZ VALUE,FI") ;
  fputint(1, newlabel) ;
  fputnl(1);
  filabel := newlabel ;
  newlabel := newlabel + 1 ;

  { here we have the code of the THEN serial clause }
  cursor := childii OF parsetree ;
  { we need to take care of all the phrases in the THEN serial clause }
  WHILE cursor ISNT astreenil
  DO
    issuecode(cursor) ;

    cursor := succ OF cursor
  OD ;

  { define the label for the jump from the IF --- SWYM is MMIX own no-op }
  issuelabelnum("FI", filabel);
  fputs(1, "SWYM");
  fputnl(1)
END ;

PROC( ASTREE) VOID issueifthenelif = ( ASTREE parsetree) VOID :
BEGIN
  REF ASTREE cursor = LOC ASTREE;
  REF ASTREE elifcursor = LOC ASTREE;
  REF INT eliflabel = LOC INT ;
  REF INT filabel = LOC INT ;

  cursor := childi OF parsetree ;
  { we need to take care of all the phrases in the IF serial clause }
  WHILE cursor ISNT astreenil
  DO
    issuecode(cursor) ;

    cursor := succ OF cursor
  OD ;

  issuelabel("") ;
  fputs(1, "BZ VALUE,ELIF") ;
  fputint(1, newlabel) ;
  fputnl(1);
  eliflabel := newlabel ;
  newlabel := newlabel + 1 ;

  { here we have the code of the THEN serial clause }
  cursor := childii OF parsetree ;
  { we need to take care of all the phrases in the THEN serial clause }
  WHILE cursor ISNT astreenil
  DO
    issuecode(cursor) ;

    cursor := succ OF cursor
  OD ;

  { now we iterate on the elif s parts }
  filabel := newlabel ;
  newlabel := newlabel + 1 ;

  elifcursor := childiii OF parsetree ;
  WHILE elifcursor ISNT astreenil
  DO
    { jump out to the FI }
    issuelabel("") ;
    fputs(1, "JMP FI") ;
    fputint(1, filabel) ;
    fputnl(1);

    { define the label for the jump from the IF }
    issuelabelnum("ELIF", eliflabel);
    fputs(1, "SWYM");
    fputnl(1);

    { here we have the code of condition part of the ELIF }
    cursor := childi OF elifcursor ;
    WHILE cursor ISNT astreenil
    DO
      issuecode(cursor) ;

      cursor := succ OF cursor
    OD ;

    issuelabel("") ;
    fputs(1, "BZ VALUE,ELIF") ;
    fputint(1, newlabel) ;
    fputnl(1);
    eliflabel := newlabel ;
    newlabel := newlabel + 1 ;

    { here we have the code of the THEN serial clause }
    cursor := childii OF elifcursor ;
    WHILE cursor ISNT astreenil
    DO
      issuecode(cursor) ;

      cursor := succ OF cursor
    OD ;

    elifcursor := succ OF elifcursor
  OD ;

  { define the label for the jump from the THEN }
  issuelabelnum("FI", filabel);
  fputs(1, "SWYM");
  fputnl(1)
END ;

PROC( ASTREE) VOID issueifthenelse = ( ASTREE parsetree) VOID :
BEGIN
  REF ASTREE cursor = LOC ASTREE;
  REF INT filabel = LOC INT ;
  REF INT elselabel = LOC INT ;

  cursor := childi OF parsetree ;
  { we need to take care of all the phrases in the IF serial clause }
  WHILE cursor ISNT astreenil
  DO
    issuecode(cursor) ;

    cursor := succ OF cursor
  OD ;

  issuelabel("") ;
  fputs(1, "BZ VALUE,ELSE") ;
  fputint(1, newlabel) ;
  fputnl(1);
  elselabel := newlabel ;
  newlabel := newlabel + 1 ;

  { here we have the code of the THEN serial clause }
  cursor := childii OF parsetree ;
  WHILE cursor ISNT astreenil
  DO
    issuecode(cursor) ;

    cursor := succ OF cursor
  OD ;
  
  { now jump out to the FI }
  issuelabel("") ;
  fputs(1, "JMP FI") ;
  fputint(1, newlabel) ;
  fputnl(1);
  filabel := newlabel ;
  newlabel := newlabel + 1 ;

  { define the label for the jump from the IF }
  issuelabelnum("ELSE", elselabel);
  fputs(1, "SWYM");
  fputnl(1);

  { here we have the code of the ELSE serial clause }
  cursor := childiv OF parsetree ;
  WHILE cursor ISNT astreenil
  DO
    issuecode(cursor) ;

    cursor := succ OF cursor
  OD ;
  
  { define the label for the jump from the THEN }
  issuelabelnum("FI", filabel);
  fputs(1, "SWYM");
  fputnl(1)
END ;

PROC( ASTREE) VOID issueifthenelifelse = ( ASTREE parsetree) VOID :
BEGIN
  REF ASTREE cursor = LOC ASTREE;
  REF ASTREE elifcursor = LOC ASTREE;
  REF INT eliflabel = LOC INT ;
  REF INT elselabel = LOC INT ;
  REF INT filabel = LOC INT ;

  cursor := childi OF parsetree ;
  { we need to take care of all the phrases in the IF serial clause }
  WHILE cursor ISNT astreenil
  DO
    issuecode(cursor) ;

    cursor := succ OF cursor
  OD ;

  issuelabel("") ;
  fputs(1, "BZ VALUE,ELIF") ;
  fputint(1, newlabel) ;
  fputnl(1);
  eliflabel := newlabel ;
  newlabel := newlabel + 1 ;

  { here we have the code of the THEN serial clause }
  cursor := childii OF parsetree ;
  { we need to take care of all the phrases in the THEN serial clause }
  WHILE cursor ISNT astreenil
  DO
    issuecode(cursor) ;

    cursor := succ OF cursor
  OD ;

  { now we iterate on the elif s parts }
  filabel := newlabel ;
  newlabel := newlabel + 1 ;

  elifcursor := childiii OF parsetree ;
  WHILE succ OF elifcursor ISNT astreenil
  DO
    { jump out to the FI }
    issuelabel("") ;
    fputs(1, "JMP FI") ;
    fputint(1, filabel) ;
    fputnl(1);

    { define the label for the jump from the IF }
    issuelabelnum("ELIF", eliflabel);
    fputs(1, "SWYM");
    fputnl(1);

    { here we have the code of condition part of the ELIF }
    cursor := childi OF elifcursor ;
    WHILE cursor ISNT astreenil
    DO
      issuecode(cursor) ;

      cursor := succ OF cursor
    OD ;

    issuelabel("") ;
    fputs(1, "BZ VALUE,ELIF") ;
    fputint(1, newlabel) ;
    fputnl(1);
    eliflabel := newlabel ;
    newlabel := newlabel + 1 ;

    { here we have the code of the THEN serial clause }
    cursor := childii OF elifcursor ;
    WHILE cursor ISNT astreenil
    DO
      issuecode(cursor) ;

      cursor := succ OF cursor
    OD ;

    elifcursor := succ OF elifcursor
  OD ;

  { jump out to the FI }
  issuelabel("") ;
  fputs(1, "JMP FI") ;
  fputint(1, filabel) ;
  fputnl(1);

  { define the label for the jump from the IF }
  issuelabelnum("ELIF", eliflabel);
  fputs(1, "SWYM");
  fputnl(1);

  { here we have the code of condition part of the ELIF }
  cursor := childi OF elifcursor ;
  WHILE cursor ISNT astreenil
  DO
    issuecode(cursor) ;

    cursor := succ OF cursor
  OD ;

  issuelabel("") ;
  fputs(1, "BZ VALUE,ELSE") ;
  fputint(1, newlabel) ;
  fputnl(1);
  elselabel := newlabel ;
  newlabel := newlabel + 1 ;

  { here we have the code of the THEN serial clause }
  cursor := childii OF elifcursor ;
  WHILE cursor ISNT astreenil
  DO
    issuecode(cursor) ;

    cursor := succ OF cursor
  OD ;

  { jump out to the FI }
  issuelabel("") ;
  fputs(1, "JMP FI") ;
  fputint(1, filabel) ;
  fputnl(1);

  { define the label for the jump from the last ELIF }
  issuelabelnum("ELSE", elselabel);
  fputs(1, "SWYM");
  fputnl(1);

  { here we have the code of the ELSE serial clause }
  cursor := childiv OF parsetree ;
  WHILE cursor ISNT astreenil
  DO
    issuecode(cursor) ;

    cursor := succ OF cursor
  OD ;

  { define the label for the jump from the THEN }
  issuelabelnum("FI", filabel);
  fputs(1, "SWYM");
  fputnl(1)
END ;

PROC( ASTREE) VOID issueorel = ( ASTREE parsetree) VOID :
BEGIN
  REF INT orellabel = LOC INT ;

  { left-hand operand }
  issuecode (childi OF parsetree) ;

  { if true the short-circuit }
  issuelabel("") ;
  fputs(1, "PBP VALUE,OREL") ;
  fputint(1, newlabel) ;
  fputnl(1);
  orellabel := newlabel ;
  newlabel := newlabel + 1 ;

  { right-hand operand }
  issuecode(childii OF parsetree) ;

  { define the label for the jump from the short-circuit }
  issuelabelnum("OREL", orellabel);
  fputs(1, "SWYM");
  fputnl(1)
END ;

PROC( ASTREE) VOID issueandth = ( ASTREE parsetree) VOID :
BEGIN
  REF INT andthlabel = LOC INT ;

  { left-hand operand }
  issuecode (childi OF parsetree) ;

  { if true the short-circuit }
  issuelabel("") ;
  fputs(1, "BZ VALUE,ANDTH") ;
  fputint(1, newlabel) ;
  fputnl(1);
  andthlabel := newlabel ;
  newlabel := newlabel + 1 ;

  { right-hand operand }
  issuecode(childii OF parsetree) ;

  { define the label for the jump from the short-circuit }
  issuelabelnum("ANDTH", andthlabel);
  fputs(1, "SWYM");
  fputnl(1)
END ;

PROC( ASTREE) VOID issueloop = ( ASTREE parsetree) VOID :
BEGIN
  REF ASTREE cursor = LOC ASTREE ;

  { temporaries to hold various components of the loop }
  REF INT forreg = LOC INT ;
  REF INT fromreg = LOC INT ;
  REF INT byreg = LOC INT ;
  REF INT toreg = LOC INT ;
  { offset to access the induction variable if any }
  REF INT offsetreg = LOC INT ;

  { temporaries to hold the labels out and to the top of the loop }
  REF INT odlabel = LOC INT ;
  REF INT toplabel = LOC INT ;

  REF IDLIST anidlist = LOC IDLIST ;

  fromreg := newtemporary ;
  newtemporary := newtemporary + 1 ;

  { FROM part }
  IF childii OF parsetree ISNT astreenil
  THEN
    cursor := childii OF parsetree ;
    WHILE cursor ISNT astreenil
    DO
      issuecode(cursor) ;

      cursor := succ OF cursor
    OD ;
    issuelabel("") ;
    fputs(1, "SET $") ;
    fputint(1, fromreg) ;
    fputs(1, ",VALUE");
    fputnl(1)
  ELSE
    issuelabel("") ;
    fputs(1, "SETL $") ;
    fputint(1, fromreg) ;
    fputs(1, ",1");
    fputnl(1)
  FI ;

  byreg := newtemporary ;
  newtemporary := newtemporary + 1 ;

  { BY part }
  IF childiii OF parsetree ISNT astreenil
  THEN
    cursor := childiii OF parsetree ;
    WHILE cursor ISNT astreenil
    DO
      issuecode(cursor) ;

      cursor := succ OF cursor
    OD ;
    issuelabel("") ;
    fputs(1, "SET $") ;
    fputint(1, byreg) ;
    fputs(1, ",VALUE") ;
    fputnl(1)
  ELSE
    issuelabel("") ;
    fputs(1, "SETL $") ;
    fputint(1, byreg) ;
    fputs(1, ",1") ;
    fputnl(1)
  FI ;

  forreg := newtemporary ;
  newtemporary := newtemporary + 1 ;

  { FOR part }
  issuelabel("") ;
  fputs(1, "SET $") ;
  fputint(1, forreg) ;
  fputs(1, ",$") ;
  fputint(1, fromreg) ;
  fputnl(1) ;

  IF childi OF parsetree ISNT astreenil
  THEN
    offsetreg := newtemporary ;
    newtemporary := newtemporary + 1 ;
    { compute the offset of the induction variable in this activation record }
    anidlist := resolvename(childi OF parsetree) ;
    IF anidlist ISNT idlistnil
    THEN
      issuecopyinttoreg(offsetreg, offset OF anidlist) ;
      issuelabel("") ;
      fputs(1, "STT $") ;
      fputint(1, forreg) ;
      fputs(1, ",FP,$") ;
      fputint(1, offsetreg) ;
      fputnl(1)
    ELSE
      writeast(parsetree, 0) ;
      error("PANIC: how could it pass type checking if I cannot find an induction variable")
    FI
  FI ;

  toreg := newtemporary ;
  newtemporary := newtemporary + 1 ;

  { TO part }
  IF childiv OF parsetree ISNT astreenil
  THEN
    cursor := childiv OF parsetree ;
    WHILE cursor ISNT astreenil
    DO
      issuecode(cursor) ;

      cursor := succ OF cursor
    OD ;
    issuelabel("") ;
    fputs(1, "SET $") ;
    fputint(1, toreg) ;
    fputs(1, ",VALUE");
    fputnl(1)
  ELSE
    { set the TO field to the max int ie #7FFF FFFF }
    issuelabel("") ;
    fputs(1, "SETML $") ;
    fputint(1, toreg) ;
    fputs(1, ",#7FFF");
    fputnl(1) ;
    issuelabel("") ;
    fputs(1, "INCL $") ;
    fputint(1, toreg) ;
    fputs(1, ",#FFFF");
    fputnl(1)
  FI ;

  { now we have the body of the loop }
  { place a label at the top of the loop }
  toplabel := newlabel ;
  newlabel := newlabel + 1 ;

  issuelabelnum("LOOP", toplabel) ;
  { then we have the test FOR <= TO }
  fputs(1, "SUB VALUE,$") ;
  fputint(1, toreg) ;
  fputs(1, ",$") ;
  fputint(1, forreg) ;
  fputnl(1) ;

  odlabel := newlabel ;
  newlabel := newlabel + 1 ;
  { branch out of the loop if FOR > TO }
  issuelabel("") ;
  fputs(1, "BN VALUE,OD") ;
  fputint(1, odlabel) ;
  fputnl(1) ;

  { WHILE part }
  IF childv OF parsetree ISNT astreenil
  THEN
    cursor := childv OF parsetree ;
    WHILE cursor ISNT astreenil
    DO
      issuecode(cursor) ;

      cursor := succ OF cursor
    OD ;
    { branch out of the loop if WHILE condition is false }
    issuelabel("") ;
    fputs(1, "BZ VALUE,OD") ;
    fputint(1, odlabel) ;
    fputnl(1)
  FI ;

  { DO part }
  cursor := childvi OF parsetree ;
  WHILE cursor ISNT astreenil
  DO
    issuecode(cursor) ;

    cursor := succ OF cursor
  OD ;

  { now prepare for next iteration of the loop }
  issuelabel("") ;
  fputs(1, "ADD $") ;
  fputint(1, forreg) ;
  fputs(1, ",$") ;
  fputint(1, forreg) ;
  fputs(1, ",$") ;
  fputint(1, byreg) ;
  fputnl(1) ;

  IF childi OF parsetree ISNT astreenil
  THEN
    { if the induction variable is declared then update it }
    issuelabel("") ;
    fputs(1, "STT $") ;
    fputint(1, forreg) ;
    fputs(1, ",FP,$") ;
    fputint(1, offsetreg) ;
    fputnl(1)
  FI ;

  { next iteration please! }
  issuelabel("") ;
  fputs(1, "JMP LOOP") ;
  fputint(1, toplabel) ;
  fputnl(1) ;

  { finally this is the out-of-the-loop label }
  issuelabelnum("OD", odlabel) ;
  fputs(1, "SWYM") ;
  fputnl(1) ;

  { let us free all the temporaries used so far - the first used was forreg }
  newtemporary := forreg
END ;

PROC( ASTREE) VOID issueassignment = ( ASTREE parsetree) VOID :
BEGIN
  REF INT lhsreg = LOC INT ;
  REF INT atag = LOC INT ;

  { temporary register to hold the address of the lhs }
  lhsreg := newtemporary ;
  newtemporary := newtemporary + 1 ;

  issuecode (childi OF parsetree) ;
  issuelabel("") ;
  fputs(1, "SET $") ;
  fputint(1, lhsreg) ;
  fputs(1, ",VALUE") ;
  fputnl(1) ;

  issuecode (childii OF parsetree) ;
  atag := tag OF themode OF childii OF parsetree ;

  issuelabel("") ;
  { choose the right type of STore instruction based on the mode of the rhs }
  IF atag = refmode
  THEN
    fputs(1, "STO VALUE,$")
  ELSE
    IF atag = intmode
    THEN
      fputs(1, "STT VALUE,$")
    ELSE
      IF (atag = charmode) OREL (atag = boolmode)
      THEN
        fputs(1, "STBU VALUE,$")
      ELSE
        writeast(parsetree, 0) ;
        error("Code Generation Error: not implementing composite mode assignments")
      FI
    FI
  FI ;

  fputint(1, lhsreg) ;
  fputnl(1) ;

  { the value OF an assignment is the value of the lhs }
  issuelabel("") ;
  fputs(1, "SET VALUE,$") ;
  fputint(1, lhsreg) ;
  fputnl(1) ;
  
  { release the temporaries used so far }
  newtemporary := lhsreg
END ;

PROC( ASTREE) VOID issueof = ( ASTREE parsetree) VOID :
BEGIN
  REF ASTREE cursor = LOC ASTREE ;
  REF MODETREE aux = LOC MODETREE ;
  REF IDLIST alist = LOC IDLIST ;

  REF [] CHAR field = semval OF childi OF parsetree ;

  { first thing we access the secondary of this selection }
  cursor := childii OF parsetree ;
  issuecode(cursor) ;

  { now we need to find out the offset of the field }
  aux := themode OF cursor ;
  IF innermode OF aux ISNT modetreenil
  THEN
    alist := fieldlist OF innermode OF aux ;
    WHILE (alist ISNT idlistnil) ANDTH
          (stringcmp(field, theid OF alist) /= 0)
    DO
      alist := succ OF alist
    OD ;
    IF alist ISNT idlistnil
    THEN
      { the result of this selection is the value of the secondary }
      { translated by the given offset }
      issuelabel("") ;
      fputs(1, "INCL VALUE,") ;
      fputint(1, offset OF alist) ;
      fputnl(1)
    ELSE
      writeast(parsetree, 0) ;
      error("PANIC: how could it pass type checking if I cannot find this field?")
    FI
  ELSE
    writeast(parsetree, 0) ;
    error("Code Generation Error: not implementing selection from plain STRUCT")
  FI
     
END ;

PROC( ASTREE) VOID issuesubscript = ( ASTREE parsetree) VOID :
BEGIN
  REF ASTREE cursor = LOC ASTREE ;
  REF MODETREE aux = LOC MODETREE ;
  REF INT displacementreg = LOC INT ;

  displacementreg := newtemporary ;
  newtemporary := newtemporary + 1;
  { first thing we access the subscripts }
  { at th moment only one level of subscripting is supported }
  issuecode(childii OF parsetree) ;

  { now we need to find out the size of each element of this ROW mode }
  cursor := childi OF parsetree ;
  aux := innermode OF themode OF cursor ;
  IF tag OF aux = rowmode
  THEN
    { the result of this subscripting is the value of the identfier }
    { translated by the a multiple of the size of the base mode }
    issuelabel("") ;
    fputs(1, "MUL $") ;
    fputint(1, displacementreg) ;
    fputs(1, ",VALUE,") ;
    fputint(1, size OF innermode OF aux) ;
    fputnl(1) ;
    
    issuecode(cursor);
    issuelabel("") ;
    fputs(1, "ADD VALUE,VALUE,$") ;
    fputint(1, displacementreg) ;
    fputnl(1)
  ELSE
    writeast(parsetree, 0) ;
    error("Code Generation Error: not implementing subscripting from plain ROW")
  FI ;

  newtemporary := displacementreg
END ;

PROC( ASTREE) VOID issuenil = ( ASTREE parsetree) VOID :
BEGIN
  { NIL is a value of mode REF whatever --- set to -1 by convention }
  issuesimpleline("SETL VALUE,#FFFF");
  issuesimpleline("INCML VALUE,#FFFF");
  issuesimpleline("INCMH VALUE,#FFFF");
  issuesimpleline("INCH VALUE,#FFFF")
END ;

PROC( ASTREE) VOID issueboolconst = ( ASTREE parsetree) VOID :
BEGIN
  IF tag OF parsetree = tfalse
  THEN
    issuesimpleline("SETL VALUE,0")
  ELSE
    issuesimpleline("SETL VALUE,1")
  FI
END ;

PROC( ASTREE) VOID issuecharconst = ( ASTREE parsetree) VOID :
BEGIN
  REF [] CHAR asinglechar = semval OF parsetree ;

  issuelabel("") ;
  fputs(1, "SETL VALUE,") ;
  fputint(1, ABS asinglechar[0]) ;
  fputnl(1)
END ;

PROC( ASTREE) VOID issueintconst = ( ASTREE parsetree) VOID :
BEGIN
  REF INT anint = LOC INT ;

  anint := asciitoint (semval OF parsetree) ;

  { integer could be more tan 16-bit long }
  { higher wyde }
  issuelabel("") ;
  fputs(1, "SETML VALUE,") ;
  fputint(1, anint OVER 65536) ;
  fputnl(1) ;

  { lower wyde }
  issuelabel("") ;
  fputs(1, "INCL VALUE,") ;
  fputint(1, anint MOD 65536) ;
  fputnl(1)
END ;

PROC( ASTREE) VOID issuestringconst = ( ASTREE parsetree) VOID :
BEGIN
  REF [] CHAR astring = semval OF parsetree ;
  REF INT awyde = LOC INT ;

  { the semantics of string constant is that they are REF [256] CHAR values }
  { the space is reserved in the STACK }
  { to copy the value from string to the heap for efficiency we copy }
  { octa s --- this implies that the heap pointer HP must be octa-aligned }
  issuesimpleline("INCL SP,7") ;
  issuesimpleline("ANDN SP,SP,7") ;

  FOR i FROM 0 BY 1 TO 31
  DO
    { prepare group of 8 CHARs in the register VALUE }
    issuelabel("") ;
    awyde := 256 * ABS astring[i*8] + ABS astring[i*8 + 1] ;
    fputs(1, "SETH VALUE,") ;
    fputint(1, awyde) ;
    fputnl(1) ;

    issuelabel("") ;
    awyde := 256 * ABS astring[i*8 + 2] + ABS astring[i*8 + 3] ;
    fputs(1, "INCMH VALUE,") ;
    fputint(1, awyde) ;
    fputnl(1) ;

    issuelabel("") ;
    awyde := 256 * ABS astring[i*8 + 4] + ABS astring[i*8 + 5] ;
    fputs(1, "INCML VALUE,") ;
    fputint(1, awyde) ;
    fputnl(1) ;

    issuelabel("") ;
    awyde := 256 * ABS astring[i*8 + 6] + ABS astring[i*8 + 7] ;
    fputs(1, "INCL VALUE,") ;
    fputint(1, awyde) ;
    fputnl(1) ;

   { now store the octa value in the heap starting at HP with offset i * 8 }
    issuelabel("") ;
    fputs(1, "STO VALUE,SP,") ;
    fputint(1, i * 8) ;
    fputnl(1)
  OD ;

  { place the ref to this string into VALUE... }
  issuesimpleline("SET VALUE,SP") ;
  { ...and push the heap pointer forward by 256 bytes }
  issuesimpleline("INCL SP,256")
END ;

PROC( ASTREE) VOID issueidentifier = ( ASTREE parsetree) VOID :
BEGIN
  REF IDLIST anid = LOC IDLIST ;
  REF INT distance = LOC INT ;
  REF INT atag = LOC INT ;
  REF INT offsetreg = LOC INT ;

  IF (coercionstodo OF parsetree IS clistnil) OREL
     (thecoercion OF coercionstodo OF parsetree /= deproceduring)
  THEN
    { first we need to know if this is a local or non-local identifier }
    distance := computenesting(blocknum OF parsetree) -
                                        computenesting(blockofname(parsetree)) ;

    followstaticlink (distance) ;

    { now in register EXTRA we have the pointer to the base }
    { of the activation record in which this identifier is held }

    { next we have to compute its offest }
    anid := resolvename (parsetree) ;
    IF anid IS idlistnil
    THEN
      writeast(parsetree, 0);
      error("PANIC: how could it pass type checking if I cannot find its definition?")
    FI ;
    offsetreg := newtemporary ;
    newtemporary := newtemporary + 1 ;
    issuecopyinttoreg(offsetreg, offset OF anid) ;

    { now we are ready to load the value in register VALUE }
    { however we have to distinguish the mode of what we are loading }
    issuelabel("") ;
    atag := tag OF themode OF anid ;
    IF atag = refmode
    THEN
      fputs(1, "LDO VALUE,EXTRA,$")
    ELSE
      IF atag = intmode
      THEN
        fputs(1, "LDT VALUE,EXTRA,$")
      ELSE
        IF (atag = charmode) OREL (atag = boolmode)
        THEN
          fputs(1, "LDBU VALUE,EXTRA,$")
        ELSE
          writeast(parsetree, 0) ;
          writemodetree(themode OF parsetree, 0) ;
          error("Code Generation Error: not implementing composite variables")
        FI
      FI
    FI ;
    fputint(1, offsetreg) ;
    fputnl(1) ;

    newtemporary := offsetreg
  FI
END ;

PROC( ASTREE) VOID issuemodecast = ( ASTREE parsetree) VOID :
BEGIN
  issuecode(childii OF parsetree)
END ;

PROC( ASTREE) VOID issueloc = ( ASTREE parsetree) VOID :
BEGIN
  REF ASTREE cursor = LOC ASTREE ;
  REF INT offsetreg = LOC INT ;
  REF INT anint = LOC INT ;

  MODETREE amode = themode OF childii OF parsetree ;

  anint := alignment OF amode - 1 ;

  { align the stack pointer before reserving the space }
  issuelabel ("") ;
  fputs(1, "INCL SP,") ;
  fputint(1, anint) ;
  fputnl(1) ;

  issuelabel ("") ;
  fputs(1, "ANDN SP,SP,") ;
  fputint(1, anint) ;
  fputnl(1) ;

  { now we can reserve the space }
  issuesimpleline("SET VALUE,SP") ;

  { advance SP of the reserved number of bytes }
  anint := size OF amode ;
  cursor := childi OF parsetree ;
  WHILE cursor ISNT astreenil
  DO
    anint := anint *
                         asciitoint (semval OF cursor) ;

    cursor := succ OF cursor
  OD ;

  offsetreg := newtemporary ;
  newtemporary := newtemporary + 1;
  issuecopyinttoreg(offsetreg, anint) ;
  issuelabel ("") ;
  fputs(1, "ADDU SP,SP,$") ;
  fputint(1, offsetreg) ;
  fputnl(1) ;
  newtemporary := offsetreg
END ;

PROC( ASTREE) VOID issueheap = ( ASTREE parsetree) VOID :
BEGIN
  REF ASTREE cursor = LOC ASTREE ;
  REF INT offsetreg = LOC INT ;
  REF INT anint = LOC INT ;

  MODETREE amode = themode OF childii OF parsetree ;

  anint := alignment OF amode - 1 ;

  { align the heap pointer before reserving the space }
  issuelabel ("") ;
  fputs(1, "INCL HP,") ;
  fputint(1, anint) ;
  fputnl(1) ;

  issuelabel ("") ;
  fputs(1, "ANDN HP,HP,") ;
  fputint(1, anint) ;
  fputnl(1) ;

  { now we can reserve the space }
  issuesimpleline("SET VALUE,HP") ;

  { advance HP of the reserved number of bytes }
  anint := size OF amode ;
  cursor := childi OF parsetree ;
  WHILE cursor ISNT astreenil
  DO
    anint := anint *
                         asciitoint (semval OF cursor) ;

    cursor := succ OF cursor
  OD ;

  offsetreg := newtemporary ;
  newtemporary := newtemporary + 1;
  issuecopyinttoreg(offsetreg, anint) ;
  issuelabel ("") ;
  fputs(1, "ADDU HP,HP,$") ;
  fputint(1, offsetreg) ;
  fputnl(1) ;
  newtemporary := offsetreg
END ;

PROC( ASTREE) VOID issuerefcmp = ( ASTREE parsetree) VOID :
BEGIN
  REF INT secondopreg = LOC INT ;

  INT atag = tag OF parsetree ;

  { first evaluate the second operand and place it in a temp reg }
  secondopreg := newtemporary ;
  newtemporary := newtemporary + 1 ;

  issuecode (childii OF parsetree) ;
  issuelabel("") ;
  fputs(1, "SET $") ;
  fputint(1, secondopreg) ;
  fputs(1, ",VALUE") ;
  fputnl(1) ;

  { then evaluate the first operand }
  issuecode (childi OF parsetree) ;

  { now compute the difference firstop - secondop }
  issuelabel("") ;
  fputs(1, "SUB VALUE,VALUE,$") ;
  fputint(1, secondopreg) ;
  fputnl(1) ;

  { based on this difference and on the relation at hand }
  { we conditionally set to 1 or zero the register VALUE }
  issuelabel("") ;
  fputs(1, "ZS") ;
  IF atag = tis
  THEN
    fputs(1, "Z ")
  ELSE
    IF atag = tisnt
    THEN
      fputs(1, "NZ ")
    FI
  FI ;
  fputs(1, "VALUE,VALUE,1") ;
  fputnl(1) ;

  { release the temporaries used so far }
  newtemporary := secondopreg
END ;

PROC( ASTREE) VOID issuecmp = ( ASTREE parsetree) VOID :
BEGIN
  REF INT secondopreg = LOC INT ;

  INT atag = tag OF parsetree ;

  { first evaluate the second operand and place it in a temp reg }
  secondopreg := newtemporary ;
  newtemporary := newtemporary + 1 ;

  issuecode (childii OF parsetree) ;
  issuelabel("") ;
  fputs(1, "SET $") ;
  fputint(1, secondopreg) ;
  fputs(1, ",VALUE") ;
  fputnl(1) ;

  { then evaluate the first operand }
  issuecode (childi OF parsetree) ;

  { now compute the difference firstop - secondop }
  issuelabel("") ;
  fputs(1, "SUB VALUE,VALUE,$") ;
  fputint(1, secondopreg) ;
  fputnl(1) ;

  { based on this difference and on the relation at hand }
  { we conditionally set to 1 or zero the register VALUE }
  issuelabel("") ;
  fputs(1, "ZS") ;
  IF atag = tless
  THEN
    fputs(1, "N ")
  ELSE
    IF atag = teq
    THEN
      fputs(1, "Z ")
    ELSE
      IF atag = tgreater
      THEN
        fputs(1, "P ")
      ELSE
        IF atag = tgeq
        THEN
          fputs(1, "NN ")
        ELSE
          IF atag = tneq
          THEN
            fputs(1, "NZ ")
          ELSE
            IF atag = tleq
            THEN
              fputs(1, "NP ")
            FI
          FI
        FI
      FI
    FI
  FI ;
  fputs(1, "VALUE,VALUE,1") ;
  fputnl(1) ;

  { release the temporaries used so far }
  newtemporary := secondopreg
END ;

PROC( ASTREE) VOID issueplus = ( ASTREE parsetree) VOID :
BEGIN
  REF INT secondopreg = LOC INT ;

  IF childii OF parsetree ISNT astreenil
  THEN
    { binary plus }

    { first evaluate the second operand and place it in a temp reg }
    secondopreg := newtemporary ;
    newtemporary := newtemporary + 1 ;

    issuecode (childii OF parsetree) ;
    issuelabel("") ;
    fputs(1, "SET $") ;
    fputint(1, secondopreg) ;
    fputs(1, ",VALUE") ;
    fputnl(1) ;

    { then evaluate the first operand }
    issuecode (childi OF parsetree) ;

    { finally add up the result in VALUE }
    issuelabel("") ;
    fputs(1, "ADD VALUE,VALUE,$") ;
    fputint(1, secondopreg) ;
    fputnl(1) ;

    { release the temporaries used so far }
    newtemporary := secondopreg
  ELSE
    { if it is a unary plus then just evaluate the only operand }
    issuecode (childi OF parsetree)
  FI
END ;

PROC( ASTREE) VOID issueminus = ( ASTREE parsetree) VOID :
BEGIN
  REF INT secondopreg = LOC INT ;

  IF childii OF parsetree ISNT astreenil
  THEN
    { binary minus }

    { first evaluate the second operand and place it in a temp reg }
    secondopreg := newtemporary ;
    newtemporary := newtemporary + 1 ;

    issuecode (childii OF parsetree) ;
    issuelabel("") ;
    fputs(1, "SET $") ;
    fputint(1, secondopreg) ;
    fputs(1, ",VALUE") ;
    fputnl(1) ;

    { then evaluate the first operand }
    issuecode (childi OF parsetree) ;

    { finally subtract the second from the first and put the result in VALUE }
    issuelabel("") ;
    fputs(1, "SUB VALUE,VALUE,$") ;
    fputint(1, secondopreg) ;
    fputnl(1) ;

    { release the temporaries used so far }
    newtemporary := secondopreg
  ELSE
    { if it is a unary minus then just negate the only operand }
    issuecode (childi OF parsetree) ;
    issuesimpleline("NEG VALUE,0,VALUE")
  FI
END ;

PROC( ASTREE) VOID issuetimes = ( ASTREE parsetree) VOID :
BEGIN
  REF INT secondopreg = LOC INT ;

  { first evaluate the second operand and place it in a temp reg }
  secondopreg := newtemporary ;
  newtemporary := newtemporary + 1 ;

  issuecode (childii OF parsetree) ;
  issuelabel("") ;
  fputs(1, "SET $") ;
  fputint(1, secondopreg) ;
  fputs(1, ",VALUE") ;
  fputnl(1) ;

  { then evaluate the first operand }
  issuecode (childi OF parsetree) ;

  { finally multiply things and put the result in VALUE }
  issuelabel("") ;
  fputs(1, "MUL VALUE,VALUE,$") ;
  fputint(1, secondopreg) ;
  fputnl(1) ;

  { release the temporaries used so far }
  newtemporary := secondopreg
END ;

PROC( ASTREE) VOID issueover = ( ASTREE parsetree) VOID :
BEGIN
  REF INT secondopreg = LOC INT ;

  { first evaluate the second operand and place it in a temp reg }
  secondopreg := newtemporary ;
  newtemporary := newtemporary + 1 ;

  issuecode (childii OF parsetree) ;
  issuelabel("") ;
  fputs(1, "SET $") ;
  fputint(1, secondopreg) ;
  fputs(1, ",VALUE") ;
  fputnl(1) ;

  { then evaluate the first operand }
  issuecode (childi OF parsetree) ;

  { finally divide things and put the result in VALUE }
  issuelabel("") ;
  fputs(1, "DIV VALUE,VALUE,$") ;
  fputint(1, secondopreg) ;
  fputnl(1) ;

  { release the temporaries used so far }
  newtemporary := secondopreg
END ;

PROC( ASTREE) VOID issuemod = ( ASTREE parsetree) VOID :
BEGIN
  REF INT secondopreg = LOC INT ;

  { first evaluate the second operand and place it in a temp reg }
  secondopreg := newtemporary ;
  newtemporary := newtemporary + 1 ;

  issuecode (childii OF parsetree) ;
  issuelabel("") ;
  fputs(1, "SET $") ;
  fputint(1, secondopreg) ;
  fputs(1, ",VALUE") ;
  fputnl(1) ;

  { then evaluate the first operand }
  issuecode (childi OF parsetree) ;

  { now divide properly ... }
  issuelabel("") ;
  fputs(1, "DIV VALUE,VALUE,$") ;
  fputint(1, secondopreg) ;
  fputnl(1) ;

  { ... then get the remainder from the special register rR }
  issuesimpleline("GET VALUE,rR") ;

  { release the temporaries used so far }
  newtemporary := secondopreg
END ;

PROC( ASTREE) VOID issuemax = ( ASTREE parsetree) VOID :
BEGIN
  REF INT secondopreg = LOC INT ;
  REF INT differencereg = LOC INT ;

  { first evaluate the second operand and place it in a temp reg }
  secondopreg := newtemporary ;
  newtemporary := newtemporary + 1 ;

  issuecode (childii OF parsetree) ;
  issuelabel("") ;
  fputs(1, "SET $") ;
  fputint(1, secondopreg) ;
  fputs(1, ",VALUE") ;
  fputnl(1) ;

  { then evaluate the first operand }
  issuecode (childi OF parsetree) ;

  { now compute the difference firstop - secondop }
  differencereg := newtemporary ;
  newtemporary := newtemporary + 1 ;

  issuelabel("") ;
  fputs(1, "SUB $") ;
  fputint(1, differencereg) ;
  fputs(1, ",VALUE,$") ;
  fputint(1, secondopreg) ;
  fputnl(1) ;

  { if this difference is negative then the MAX is secondop }
  issuelabel("") ;
  fputs(1, "CSN VALUE,$") ;
  fputint(1, differencereg) ;
  fputs(1, ",$") ;
  fputint(1, secondopreg) ;
  fputnl(1) ;
  
  { release the temporaries used so far }
  newtemporary := secondopreg
END ;

PROC( ASTREE) VOID issuemin = ( ASTREE parsetree) VOID :
BEGIN
  REF INT secondopreg = LOC INT ;
  REF INT differencereg = LOC INT ;

  { first evaluate the second operand and place it in a temp reg }
  secondopreg := newtemporary ;
  newtemporary := newtemporary + 1 ;

  issuecode (childii OF parsetree) ;
  issuelabel("") ;
  fputs(1, "SET $") ;
  fputint(1, secondopreg) ;
  fputs(1, ",VALUE") ;
  fputnl(1) ;

  { then evaluate the first operand }
  issuecode (childi OF parsetree) ;

  { now compute the difference firstop - secondop }
  differencereg := newtemporary ;
  newtemporary := newtemporary + 1 ;

  issuelabel("") ;
  fputs(1, "SUB $") ;
  fputint(1, differencereg) ;
  fputs(1, ",VALUE,$") ;
  fputint(1, secondopreg) ;
  fputnl(1) ;

  { if this difference is positive then the MIN is secondop }
  issuelabel("") ;
  fputs(1, "CSP VALUE,$") ;
  fputint(1, differencereg) ;
  fputs(1, ",$") ;
  fputint(1, secondopreg) ;
  fputnl(1) ;
  
  { release the temporaries used so far }
  newtemporary := secondopreg
END ;

PROC( ASTREE) VOID issueand = ( ASTREE parsetree) VOID :
BEGIN
  REF INT secondopreg = LOC INT ;

  { first evaluate the second operand and place it in a temp reg }
  secondopreg := newtemporary ;
  newtemporary := newtemporary + 1 ;

  issuecode (childii OF parsetree) ;
  issuelabel("") ;
  fputs(1, "SET $") ;
  fputint(1, secondopreg) ;
  fputs(1, ",VALUE") ;
  fputnl(1) ;

  { then evaluate the first operand }
  issuecode (childi OF parsetree) ;

  { finally logically-and the two operands }
  issuelabel("") ;
  fputs(1, "AND VALUE,VALUE,$") ;
  fputint(1, secondopreg) ;
  fputnl(1) ;

  { release the temporaries used so far }
  newtemporary := secondopreg
END ;

PROC( ASTREE) VOID issueor = ( ASTREE parsetree) VOID :
BEGIN
  REF INT secondopreg = LOC INT ;

  { first evaluate the second operand and place it in a temp reg }
  secondopreg := newtemporary ;
  newtemporary := newtemporary + 1 ;

  issuecode (childii OF parsetree) ;
  issuelabel("") ;
  fputs(1, "SET $") ;
  fputint(1, secondopreg) ;
  fputs(1, ",VALUE") ;
  fputnl(1) ;

  { then evaluate the first operand }
  issuecode (childi OF parsetree) ;

  { finally logically-or the two operands }
  issuelabel("") ;
  fputs(1, "OR VALUE,VALUE,$") ;
  fputint(1, secondopreg) ;
  fputnl(1) ;

  { release the temporaries used so far }
  newtemporary := secondopreg
END ;

PROC( ASTREE) VOID issuenot = ( ASTREE parsetree) VOID :
BEGIN
  { interestengly MMIX does not have a logic NOT }
  { however we can accomplish the same result with NEGU since }
  { NOT x = 1 - x }

  issuecode (childi OF parsetree) ;
  issuesimpleline("NEGU VALUE,1,VALUE")
END ;

PROC( ASTREE) VOID issueabs = ( ASTREE parsetree) VOID :
BEGIN
  { abs converts CHAR to INT }
  { so it is just a matter of modes --- nothing to do at assembly level }
  issuecode (childi OF parsetree)
END ;

PROC( ASTREE) VOID issuerepr = ( ASTREE parsetree) VOID :
BEGIN
  { repr converts INT to CHAR }
  { so it is just a matter of modes --- nothing to do at assembly level }
  issuecode (childi OF parsetree)
END ;

PROC( ASTREE) VOID issuecode = ( ASTREE parsetree) VOID :
BEGIN
  REF ASTREE parent = LOC ASTREE ;
  REF CLIST aux = LOC CLIST ;
  REF INT count = LOC INT ;
  REF INT modetag = LOC INT ;
  INT atag = tag OF parsetree ;

  IF (atag /= tskip) ANDTH (atag /= ntusermodedecl)
  THEN
    IF atag = ntproccall
    THEN
      issueproccall(parsetree)
    ELSE
      IF atag = ntroutineval
      THEN
        issueroutineval(parsetree)
      ELSE
        IF atag = ntidentitydecl
        THEN
          issueidentitydecl(parsetree)
        ELSE
          IF atag = ntclosedclause
          THEN
            issueclosedclause(parsetree)
          ELSE
            IF atag = ntifclause
            THEN
              { for ifclause we distinguish four cases }
              IF childiv OF parsetree IS astreenil
              THEN
                IF childiii OF parsetree IS astreenil
                THEN
                  issueifthen(parsetree)
                ELSE
                  issueifthenelif(parsetree)
                FI
              ELSE
                IF childiii OF parsetree IS astreenil
                THEN
                  issueifthenelse(parsetree)
                ELSE
                  issueifthenelifelse(parsetree)
                FI
              FI
            ELSE
              IF atag = torel
              THEN
                issueorel(parsetree)
              ELSE
                IF atag = tandth
                THEN
                  issueandth(parsetree)
                ELSE
                  IF atag = ntloopclause
                  THEN
                    issueloop(parsetree)
                  ELSE
                    IF atag = ntassignment
                    THEN
                      issueassignment(parsetree)
                    ELSE
                      IF atag = tnil
                      THEN
                        issuenil(parsetree)
                      ELSE
                        IF (atag = ttrue) OREL (atag = tfalse)
                        THEN
                          issueboolconst(parsetree)
                        ELSE
                          IF atag = tcharconst
                          THEN
                            issuecharconst(parsetree)
                          ELSE
                            IF atag = tintconst
                            THEN
                              issueintconst(parsetree)
                            ELSE
                              IF atag = tstringconst
                              THEN
                                issuestringconst(parsetree)
                              ELSE
                                IF atag = tid
                                THEN
                                  issueidentifier(parsetree)
                                ELSE
                                  IF atag = ntmodecast
                                  THEN
                                    issuemodecast(parsetree)
                                  ELSE
                                    IF atag = tloc
                                    THEN
                                      issueloc(parsetree)
                                    ELSE
                                      IF atag = theap
                                      THEN
                                        issueheap(parsetree)
                                      ELSE
                                        IF (atag = tis) OREL (atag = tisnt)
                                        THEN
                                        issuerefcmp(parsetree)
                                        ELSE
                                        IF (atag = tless) OREL (atag = teq) OREL
                                        (atag = tgreater) OREL (atag = tgeq) OREL
                                        (atag = tneq) OREL (atag = tleq)
                                        THEN
                                        issuecmp(parsetree)
                                        ELSE
                                        IF atag = tplus
                                        THEN
                                        issueplus(parsetree)
                                        ELSE
                                        IF atag = tminus
                                        THEN
                                        issueminus(parsetree)
                                        ELSE
                                        IF atag = ttimes
                                        THEN
                                        issuetimes(parsetree)
                                        ELSE
                                        IF atag = tover
                                        THEN
                                        issueover(parsetree)
                                        ELSE
                                        IF atag = tmod
                                        THEN
                                        issuemod(parsetree)
                                        ELSE
                                        IF atag = tmax
                                        THEN
                                        issuemax(parsetree)
                                        ELSE
                                        IF atag = tmin
                                        THEN
                                        issuemin(parsetree)
                                        ELSE
                                        IF atag = tand
                                        THEN
                                        issueand(parsetree)
                                        ELSE
                                        IF atag = tor
                                        THEN
                                        issueor(parsetree)
                                        ELSE
                                        IF atag = tnot
                                        THEN
                                        issuenot(parsetree)
                                        ELSE
                                        IF atag = tabs
                                        THEN
                                        issueabs(parsetree)
                                        ELSE
                                        IF atag = trepr
                                        THEN
                                        issuerepr(parsetree)
                                        ELSE
                                        IF atag = tof
                                        THEN
                                        issueof(parsetree)
                                        ELSE
                                        IF atag = ntsubscript
                                        THEN
                                        issuesubscript(parsetree)
                                        ELSE
                                        issuesimpleline("... NOT YET IMPLEMENTED ...")
                                        FI
                                        FI
                                        FI
                                        FI
                                        FI
                                        FI
                                        FI
                                        FI
                                        FI
                                        FI
                                        FI
                                        FI
                                        FI
                                        FI
                                        FI
                                        FI
                                      FI
                                    FI
                                  FI
                                FI
                              FI
                            FI
                          FI
                        FI
                      FI
                    FI
                  FI
                FI
              FI
            FI
          FI
        FI
      FI
    FI ;

    { now apply all the coercions to the result that was }
    { stored in the register VALUE }
    IF coercionstodo OF parsetree ISNT clistnil
    THEN
      aux := coercionstodo OF parsetree ;
      IF thecoercion OF aux = deproceduring
      THEN
        { to make the call we build a fake ntproccall node }
        parent := newasnode(ntproccall) ;
        childi OF parent := parsetree;
        themode OF parent := themode OF parsetree;
        coercionstodo OF parent := succ OF aux;
        blocknum OF parent := blocknum OF parsetree;

        { recurse on the node just created }
        issuecode(parent)
      ELSE
        IF thecoercion OF aux = dereferencing
        THEN
          count := 0;
          WHILE (succ OF aux ISNT clistnil) ANDTH
                (thecoercion OF succ OF aux = dereferencing)
          DO
            count := count + 1 ;

            aux := succ OF aux
          OD ;
          IF succ OF aux IS clistnil
          THEN
            { all coercions to do are dereferencing }
            { all but the one load octas from memory }
            { the last load depends on the final mode of the node at hand }
            FOR i TO count
            DO
              issuesimpleline("LDO VALUE,VALUE")
            OD ;
            issuelabel("") ;
            modetag := tag OF themode OF parsetree ;
            IF modetag = refmode
            THEN
              fputs(1, "LDO VALUE,VALUE")
            ELSE
              IF modetag = intmode
              THEN
                fputs(1, "LDT VALUE,VALUE")
              ELSE
                IF (modetag = charmode) OREL (modetag = boolmode)
                THEN
                  fputs(1, "LDBU VALUE,VALUE")
                ELSE
                  writeast(parsetree, 0) ;
                  error("Code Generation Error: not implementing composite variables")
                FI
              FI
            FI ;
            fputnl(1)
          ELSE
            { after all this dereferencing there is a voiding --- dont do anything }
            IF thecoercion OF succ OF aux /= voiding
            THEN
              writeast(parsetree, 0) ;
              fputint(1, thecoercion OF aux) ;
              fputnl(1) ;
              error("Code Generation Error: do not know how to apply coercions")
            FI
          FI
        ELSE
          IF thecoercion OF aux /= voiding
          THEN
            { no ELSE part --- nothing to be done to void a value }
            writeast(parsetree, 0) ;
            fputint(1, thecoercion OF aux) ;
            fputnl(1) ;
            error("Code Generation Error: do not know how to apply coercions")
          FI
        FI
      FI
    FI
  FI
END ;

{ this procedure is the main for the code generation phase }
PROC( ASTREE) VOID generatemms = ( ASTREE parsetree) VOID :
BEGIN
  REF IDLIST anidlist = LOC IDLIST ;

  newtemporary = LOC INT ;
  newlabel = LOC INT ;
  { first we initialize the necessary global variables }
  newtemporary := 0 ;
  newlabel := 0 ;

  issuemmsheader ;











  { generate the code for this parsetree! }

  FOR i FROM 0 BY 1 TO nextblocknum - 1
  DO
    anidlist := variables OF blocktable[i] ;
    WHILE anidlist ISNT idlistnil
    DO
      IF tag OF themode OF anidlist = procmode
      THEN
        { place a label with the name of the proc }
        issuelabelnline(theid OF anidlist,
                        "SWYM") ;
        { since each time we call a proc we save all used temp }
        { each routine value can use them all }
        newtemporary := 0 ;
        issuecode (thevalue OF anidlist)
      FI ;

      anidlist := succ OF anidlist
    OD
  OD
END ;

  REF ASTREE myparsetree = LOC ASTREE ;

  SKIP ;

  myparsetree := readast ;

  initusermodetable ;
  gatherusermodes (myparsetree) ;
  fixusermodes (myparsetree) ;

  buildblocktable (myparsetree) ;

  annotatecontext(myparsetree) ;


  annotatemode (myparsetree) ;


  IF debugging
  THEN
    writeast (myparsetree, 0)
  FI ;

  generatemms (myparsetree);

  1
END