#include <stdio.h>

#define NIL 
#define INT int
#define CHAR char
#define BOOL char
#define VOID void

#define REPR
#define ABS
#define FORWARD
#define REF

#define TRUE 1
#define FALSE 0

#define BEGIN {
#define IF if (
#define THEN ) {
#define ELIF ;} else if (
#define ELSE  ;} else {
#define FI ; }

#define NOT !
#define OREL ||
#define ANDTH &&
#define OR ||
#define AND &&
#define MOD %

#define WHILE while (
#define DO ) {
#define OD ; }

#define END }


#define tk_EOF EOF
#define _arg(n) argv[n]


#define exit exit(0);

FILE *inpfile;
FILE *outfile;
FILE *runfile;


void close(int f)
{
  if (f==1) fclose(inpfile);
  else if (f==2) fclose(runfile);
  else if (f==5) fclose(outfile);
  return;
}

int open(int f, char *name)
{
  int r = -1;
  if (f==1) { inpfile = fopen(name, "rt"); r = inpfile?0:-1; } 
  else if (f==2) { runfile = fopen(name, "rt"); r = runfile?0:-1; }
  return r;
}

int establish(int f, char *name)
{
  outfile = fopen(name, "wt"); 
  return (outfile?0:-1);
}

char readc(int f)
{
  char ch = 0;
  if (f==1) ch = fgetc(inpfile);
  else if (f==2) ch = fgetc(runfile);
  return ch;
}

#define readchar getchar()

#define str2int atoi
#define int2str itos



#define tk_COLON  ABS ':'
#define tk_LESS  ABS '<'
#define tk_GREATER  ABS '>'
#define tk_DIV  ABS '/'
#define tk_EQUAL  ABS '='
#define tk_MULT  ABS '*'
#define tk_PLUS  ABS '+'
#define tk_MINUS  ABS '-'
#define tk_PIPE  ABS '|'
#define tk_LBRACKET  ABS '['
#define tk_RBRACKET  ABS ']'
#define tk_LPARENTH  ABS '('
#define tk_RPARENTH  ABS ')'
#define tk_SEMICOLON  ABS ';'
#define tk_COMMA  ABS ','

#define tk_REF  257
#define tk_LOC  258
#define tk_STRUCT  259
#define tk_UNION  260
#define tk_TRUE  261
#define tk_FALSE  262
#define tk_NIL  263
#define tk_CHARCONST  264
#define tk_POWER  265
#define tk_UPB  266
#define tk_LWB  267
#define tk_BEGIN  268
#define tk_END  269
#define tk_IF  270
#define tk_THEN  271
#define tk_ELSE  272
#define tk_ELIF  273
#define tk_FI  274
#define tk_FOR  275
#define tk_FROM  276
#define tk_BY  277
#define tk_TO  278
#define tk_WHILE  279
#define tk_DO  280
#define tk_OD  281
#define tk_REPR  282
#define tk_FORWARD  283
#define tk_MOD  284
#define tk_ESAC  285
#define tk_PROC  286
#define tk_ID  287
#define tk_INTCONST  288
#define tk_STRCONST  289
#define tk_COMMENT  290
#define tk_MODE  291
#define tk_AMODE  292

#define tk_ASSIGN  293
#define tk_OR  294
#define tk_OREL  295
#define tk_AND  296
#define tk_ANDTH  297
#define tk_NOT  298
#define tk_ABS  299
#define tk_NEQ  300
#define tk_GEQ  301
#define tk_LEQ  302
#define tk_IS  303
#define tk_ISNT  304
#define tk_OF  305

/*
#define tk_EOF  0
*/

#define tk_ERROR  1001


// Forward declarations-macros

#ifndef debugger
#define debugger debugger()
#endif
VOID debugger;

// General constants

#define string_size  256
// (upper bound - 4, size in octets - 4)
#define array_header_size  8
#define struc_header_size  0


// New modes & structures

typedef CHAR STRING[string_size];
typedef struct TOKEN TOKEN;
struct TOKEN
{
INT id;
 STRING str;
 STRING descr;
 INT line;
 BOOL used;
};



// Variables

TOKEN token;
CHAR nextChar = REPR 0;
INT line = 1;
BOOL debug_echo = FALSE;
BOOL debug_stop = FALSE;
BOOL debug_stepwise = FALSE;
BOOL debug_expr = FALSE;
BOOL code_refs = FALSE;
BOOL code_comments = FALSE;


// Error: on error display message and terminate!

VOID error(STRING msg)
BEGIN
  printf("ERROR: at token '%s', %s(%i): %s\n", token.str, token.descr, token.id, msg);
  close(1);
  close(5);
  exit;
  return;
END;


#ifndef read
#define read read()
#endif
CHAR read
BEGIN
  CHAR ch = readc(1);
//  IF (ch == 10) THEN line = line + 1 FI;
  return (ch);
END;


VOID itos(INT value, REF STRING s)
BEGIN
  INT val = value;
  INT d, i;
  INT base;
  BOOL started = FALSE;

  base = 1000000;
  IF val < 0 THEN s[0] = '-'; val = -val; i = 1; ELSE i = 0; FI;
  WHILE base > 1 
  DO
    d = ABS '0';
    WHILE val >= base DO d = d + 1; val = val - base; OD;
    IF started OREL d > ABS '0' THEN
      s[i] = REPR d;
      started = TRUE;
      i = i + 1;
    FI;
    base = base / 10; 
  OD;
  s[i] = REPR (val + ABS '0');
  s[i+1] = REPR 0;
  return;
END;


BOOL IsDigit(STRING s)
BEGIN
  return (s[0] == '-' OREL (s[0] >= '0' ANDTH s[0] <= '9'));
END;

BOOL StrEqual(STRING s1, STRING s2)
BEGIN
  INT i = 0;
  WHILE i < string_size ANDTH s1[i] != REPR 0 ANDTH s2[i] != REPR 0 ANDTH s1[i] == s2[i]
  DO 
    i = i + 1
  OD;
  return (s1[i] == s2[i]);
END;


INT StrLen(STRING s)
BEGIN
  INT i = 0;
  WHILE (s[i] != REPR 0) DO i = i + 1 OD;
  return (i);
END;


BOOL StrUCase(STRING s)
BEGIN
  INT i = 0;
  WHILE i < string_size ANDTH s[i] != REPR 0 ANDTH s[i] >= 'A' ANDTH s[i] <= 'Z'
  DO 
    i = i + 1
  OD;
  return (s[i] == REPR 0);
END;


INT StrFind(STRING s, CHAR ch, INT start)
BEGIN
  INT i = start;
  WHILE i < string_size ANDTH s[i] != REPR 0 ANDTH s[i] != ch DO i = i + 1; OD;
  return (i);
END;


BOOL StrBelongs(STRING s, CHAR ch)
BEGIN
  INT i = 0;
  WHILE i < string_size ANDTH s[i] != REPR 0 ANDTH s[i] != ch DO i = i + 1; OD;
  return (s[i] != REPR 0);
END;


VOID StrAssign(REF STRING s1, STRING s2)
BEGIN
  INT i = 0;
  WHILE i < string_size ANDTH s2[i] != REPR 0
  DO
    s1[i] = s2[i]; 
    i = i + 1
  OD;
  s1[i] = s2[i];
  return;
END;


VOID StrTail(REF STRING s1, STRING s2, INT pos)
BEGIN
  INT i = 0;
  WHILE i+pos < string_size ANDTH s2[i+pos] != REPR 0 DO
    s1[i] = s2[i+pos]; 
    i = i + 1
  OD;
  s1[i] = s2[i+pos];
  return;
END;


VOID StrSlice(REF STRING t, STRING s, INT start, INT end)
BEGIN
  INT k = start;
  WHILE k < string_size ANDTH k <= end
  DO
    t[k-start] = s[k]; 
    k = k + 1
  OD;
  t[k-start] = REPR 0; 
  return;
END;


VOID StrAppend(REF STRING s, STRING s1, STRING s2)
BEGIN
  STRING t;
  INT i = 0, j = 0;
  WHILE i < string_size ANDTH s1[i] != REPR 0 DO t[j] = s1[i]; i = i + 1; j = j + 1 OD;
  i = 0;
  WHILE i < string_size ANDTH s2[i] != REPR 0 DO t[j] = s2[i]; i = i + 1; j = j + 1 OD;
  t[j] = REPR 0;
  StrAssign(s, t);
  return;
END;


VOID store_token(INT id, STRING descr)
BEGIN
  token.id = id;
  StrAssign(token.descr, descr);
  token.line = line;
  return;
END;


#ifndef GetTokenId
#define GetTokenId GetTokenId()
#endif
VOID GetTokenId
BEGIN
  StrAssign(token.descr, "RESERVED");
  IF StrEqual(token.str, "REF") THEN token.id = tk_REF;
  ELIF StrEqual(token.str, "LOC") THEN token.id = tk_LOC;
  ELIF StrEqual(token.str, "STRUCT") THEN token.id = tk_STRUCT;
  ELIF StrEqual(token.str, "TRUE") THEN token.id = tk_TRUE;
  ELIF StrEqual(token.str, "FALSE") THEN token.id = tk_FALSE;
  ELIF StrEqual(token.str, "NIL") THEN token.id = tk_NIL;
  ELIF StrEqual(token.str, "ABS") THEN token.id = tk_ABS;
  ELIF StrEqual(token.str, "NOT") THEN token.id = tk_NOT;
  ELIF StrEqual(token.str, "AND") THEN token.id = tk_AND;
  ELIF StrEqual(token.str, "OR") THEN token.id = tk_OR;
  ELIF StrEqual(token.str, "ANDTH") THEN token.id = tk_ANDTH;
  ELIF StrEqual(token.str, "OREL") THEN token.id = tk_OREL;
  ELIF StrEqual(token.str, "IS") THEN token.id = tk_IS;
  ELIF StrEqual(token.str, "ISNT") THEN token.id = tk_ISNT;
  ELIF StrEqual(token.str, "OF") THEN token.id = tk_OF;
  ELIF StrEqual(token.str, "BEGIN") THEN token.id = tk_BEGIN;
  ELIF StrEqual(token.str, "END") THEN token.id = tk_END;
  ELIF StrEqual(token.str, "IF") THEN token.id = tk_IF;
  ELIF StrEqual(token.str, "THEN") THEN token.id = tk_THEN;
  ELIF StrEqual(token.str, "ELSE") THEN token.id = tk_ELSE;
  ELIF StrEqual(token.str, "ELIF") THEN token.id = tk_ELIF;
  ELIF StrEqual(token.str, "FI") THEN token.id = tk_FI;
  ELIF StrEqual(token.str, "FOR") THEN token.id = tk_FOR;
  ELIF StrEqual(token.str, "FROM") THEN token.id = tk_FROM;
  ELIF StrEqual(token.str, "BY") THEN token.id = tk_BY;
  ELIF StrEqual(token.str, "TO") THEN token.id = tk_TO;
  ELIF StrEqual(token.str, "WHILE") THEN token.id = tk_WHILE;
  ELIF StrEqual(token.str, "DO") THEN token.id = tk_DO;
  ELIF StrEqual(token.str, "OD") THEN token.id = tk_OD;
  ELIF StrEqual(token.str, "PROC") THEN token.id = tk_PROC;
  ELIF StrEqual(token.str, "MODE") THEN token.id = tk_MODE;
  ELIF StrEqual(token.str, "LWB") THEN token.id = tk_LWB;
  ELIF StrEqual(token.str, "UPB") THEN token.id = tk_UPB;
  ELIF StrEqual(token.str, "REPR") THEN token.id = tk_REPR;
  ELIF StrEqual(token.str, "FORWARD") THEN token.id = tk_FORWARD;
  ELIF StrEqual(token.str, "MOD") THEN token.id = tk_MOD;
  ELIF StrUCase(token.str) THEN 
    store_token(tk_AMODE, "AMODE");
  ELSE 
    store_token(tk_ID, "IDENTIFIER");
  FI;
  return;
END;


BOOL IsSeparator(CHAR ch)
BEGIN
  BOOL result;
  IF (ch == '(') 
     OREL (ch == ')') 
     OREL (ch == '[') 
     OREL (ch == ']') 
     OREL (ch == ':') 
     OREL (ch == ';') 
     OREL (ch == ',') 
     OREL (ch == '*') 
     OREL (ch == '+') 
     OREL (ch == '-') 
     OREL (ch == '=') 
     OREL (ch == '/') 
     OREL (ch == '>') 
     OREL (ch == '<') 
     OREL (ch == '|') 
  THEN
    result = TRUE
  ELSE
    result = FALSE
  FI;
  return (result);
END;


BOOL IsBlank(CHAR ch)
BEGIN
  BOOL result;
  IF ch <= ' ' ANDTH ch != REPR tk_EOF THEN
    result = TRUE
  ELSE
    result = FALSE
  FI;
  return (result);
END;


BOOL IsNumber(CHAR ch)
BEGIN
  BOOL result;
  IF (ch >= '0') ANDTH (ch <= '9') THEN
    result = TRUE
  ELSE
    result = FALSE
  FI;
  return (result);
END;


BOOL IsIdChar(CHAR ch)
BEGIN
  BOOL result;
  IF ((ch >= 'A') ANDTH (ch <= 'Z'))
     OREL ((ch >= 'a') ANDTH (ch <= 'z'))
     OREL IsNumber(ch)
     OREL (ch == '_')
  THEN
    result = TRUE
  ELSE
    result = FALSE
  FI;
  return (result);
END;


#ifndef GetSeparator
#define GetSeparator GetSeparator()
#endif
VOID GetSeparator
BEGIN
  IF nextChar == ':' THEN
    nextChar = read;
    IF nextChar == '=' THEN 
      store_token(tk_ASSIGN, "ASSIGN");				// ASSIGN 
      StrAssign(token.str, ":=");
      nextChar = read;
    ELSE
      store_token(tk_COLON, "COLON");				// COLON 
      StrAssign(token.str, ":");
    FI;
  ELIF nextChar == '<' THEN
    nextChar = read;
    IF nextChar == '=' THEN 
      store_token(tk_LEQ, "LEQ");					// LESSEQUAL 
      StrAssign(token.str, "<=");
      nextChar = read;
    ELSE
      store_token(tk_LESS, "LESS");
      StrAssign(token.str, "<")	;				// LESS 
    FI;
  ELIF nextChar == '>' THEN
    nextChar = read;
    IF nextChar == '=' THEN 
      store_token(tk_GEQ, "GEQ");					// GREATEREQUAL 
      StrAssign(token.str, ">=");
      nextChar = read;
    ELSE
      store_token(tk_GREATER, "GREATER");				// GREATER 
      StrAssign(token.str, ">");
    FI;
  ELIF nextChar == '/' THEN
    nextChar = read;
    IF nextChar == '=' THEN 
      store_token(tk_NEQ, "NEQ");					// NOTEQUAL 
      StrAssign(token.str, "/=");
      nextChar = read;
    ELSE
      store_token(tk_DIV, "DIV");					// DIV 
      StrAssign(token.str, "/");
    FI;
  ELIF nextChar == '=' THEN
    nextChar = read;
    store_token(tk_EQUAL, "EQUAL");					// EQUAL 
    StrAssign(token.str, "=");
  ELIF nextChar == '*' THEN
    nextChar = read;
    IF nextChar == '*' THEN 
      store_token(tk_POWER, "POWER");				// POWER
      StrAssign(token.str, "**");
      nextChar = read;
    ELSE
      store_token(tk_MULT, "MULT");					// MULT 
      StrAssign(token.str, "*");
    FI;
  ELIF nextChar == '+' THEN
    nextChar = read;
    store_token(tk_PLUS, "PLUS");					// PLUS 
    StrAssign(token.str, "+");
  ELIF nextChar == '-' THEN
    nextChar = read;
    store_token(tk_MINUS, "MINUS");					// MINUS 
    StrAssign(token.str, "-");
  ELIF nextChar == '|' THEN
    nextChar = read;
    store_token(tk_PIPE, "PIPE");					// PIPE 
    StrAssign(token.str, "|");
  ELIF nextChar == '[' THEN
    nextChar = read;
    store_token(tk_LBRACKET, "LBRACKET");				// LEFT BRACKET 
    StrAssign(token.str, "[");
  ELIF nextChar == ']' THEN
    nextChar = read;
    store_token(tk_RBRACKET, "RBRACKET");				// RIGHT BRACKET 
    StrAssign(token.str, "]");
  ELIF nextChar == '(' THEN
    nextChar = read;
    store_token(tk_LPARENTH, "LPARENTH");				// LEFT PARENTHESIS 
    StrAssign(token.str, "(");
  ELIF nextChar == ')' THEN
    nextChar = read;
    store_token(tk_RPARENTH, "RPARENTH");				// RIGHT PARENTHESIS 
    StrAssign(token.str, ")");
  ELIF nextChar == ';' THEN
    nextChar = read;
    store_token(tk_SEMICOLON, "SEMICOLON");			// SEMI-COLON 
    StrAssign(token.str, ";");
  ELIF nextChar == ',' THEN
    nextChar = read;
    store_token(tk_COMMA, "COMMA");					// COMMA 
    StrAssign(token.str, ",");
  ELSE
    printf("UNEXPECTED ERROR!\n");
  FI;
  return;
END;


#ifndef GetNextToken
#define GetNextToken GetNextToken()
#endif
VOID GetNextToken
BEGIN
  INT i = 0;

  IF debug_stepwise THEN debugger; FI;

  WHILE IsBlank(nextChar) OREL nextChar == '#'
  DO
    WHILE IsBlank(nextChar) DO				// Handle WHITE SPACE
      nextChar = read;
    OD;
    IF nextChar == '#' THEN					// Handle COMMENTS
      nextChar = read;
      WHILE nextChar != '\n' DO nextChar = read OD;
      nextChar = read;
    ELIF nextChar == '@' THEN
      nextChar = read;
      IF nextChar == '+' THEN debug_echo = TRUE; nextChar = read;
      ELIF nextChar == '-' THEN debug_echo = FALSE; nextChar = read;
      ELSE debugger;
      FI;
    FI;
  OD;

  IF nextChar == REPR tk_EOF THEN
    store_token(tk_EOF, "EOF");
// ---------------------------------------------------------------------------------	#
// 						SEPARATORS 							#
// ---------------------------------------------------------------------------------	#
  ELIF IsSeparator(nextChar) THEN
    GetSeparator;
// ---------------------------------------------------------------------------------	#
// 						 STRINGS 							#
// ---------------------------------------------------------------------------------	#
  ELIF nextChar == '\"' THEN 
    store_token(tk_STRCONST, "STRCONST");
    (token.str)[i] = nextChar;
    i = i + 1;
    nextChar = read;
    WHILE nextChar != '\"' DO
      (token.str)[i] = nextChar;
      i = i + 1;
      IF nextChar == '\\' THEN (token.str)[i] = read; i = i + 1; FI;
      nextChar = read;
    OD;
    (token.str)[i] = nextChar;
    (token.str)[i+1] = REPR 0;
    nextChar = read;
// ---------------------------------------------------------------------------------	#
// 						CHARACTERS 							#
// ---------------------------------------------------------------------------------	#
  ELIF nextChar == '\'' THEN
    nextChar = read;
    IF nextChar == '\\' THEN					  // handle special characters
      nextChar = read;
      IF nextChar == '\'' OREL nextChar == '\"' OREL nextChar == '\\' THEN (token.str)[0] = nextChar;
      ELIF nextChar == 't' THEN (token.str)[0] = REPR 9;
      ELIF nextChar == 'n' THEN (token.str)[0] = REPR 10;
      ELSE error("Invalid char constant!");
      FI;
    ELSE
      (token.str)[0] = nextChar;			  // store char
    FI;
    nextChar = read;
    IF nextChar != '\'' THEN					  // end of char
      error("Invalid char constant!");
    ELSE
      (token.str)[1] = REPR 0;
      store_token(tk_CHARCONST, "CHARCONST");
    FI;
    nextChar = read;
// ---------------------------------------------------------------------------------	#
// 						INTEGERS 							#
// ---------------------------------------------------------------------------------	#
  ELIF IsNumber(nextChar) THEN 
    store_token(tk_INTCONST, "INTCONST");
    WHILE IsNumber(nextChar) 
    DO
      (token.str)[i] = nextChar;
      i = i + 1;
      nextChar = read;
    OD;
    (token.str)[i] = REPR 0;
// ---------------------------------------------------------------------------------	#
// 					     IDENTIFIERS 							#
// ---------------------------------------------------------------------------------	#
  ELIF IsIdChar(nextChar) THEN 
    WHILE IsIdChar(nextChar) 
    DO
      (token.str)[i] = nextChar;
      i = i + 1;
      nextChar = read;
    OD;
    (token.str)[i] = REPR 0;
    GetTokenId;
// ---------------------------------------------------------------------------------	#
// 						  ERROR 							#
// ---------------------------------------------------------------------------------	#
  ELSE 
    store_token(tk_ERROR, "ERROR");
    (token.str)[0] = nextChar;
    (token.str)[1] = REPR 0;
    nextChar = read;
  FI;
  token.used = FALSE;
  return;
END;








#ifndef generate_code
#define generate_code generate_code()
#endif
VOID generate_code;
#ifndef process_frame
#define process_frame process_frame()
#endif
VOID process_frame;
INT lookup(STRING name);


#define stack_bound  3000
#define proc_info_bound  1000
#define temps_bound  1000

#define rule_assign  1
#define rule_identity  2
#define rule_itemize  3


#define context_firm  1
#define context_strong  2
#define context_meek  3
#define context_week  4
#define context_soft  5


#define entity_empty  0
#define entity_frame  1
#define entity_var  2
#define entity_tempvar  3
#define entity_ptrvar  4
#define entity_argvar  5
#define entity_param  6
#define entity_constant  7
#define entity_proc  8
#define entity_mode  9
#define entity_label  10
#define entity_startscope  11
#define entity_endscope  12


#define max_nesting  10
#define max_gtemps  10
#define max_files  5
#define max_params  10


STRING dummy;


// ##################################################################################################// #
// TABLE table_strings: all constant strings are stored here!							#
// ##################################################################################################// #
// <table_strings_bound>	- maximum table size 										#
// <table_strings>		- where strings are stored during compile time						#
// current_strindex	- next char to be used for storing strings into the table				#
// current_stroffset	- next run-time offset with respect to global register <strp>			#
// ##################################################################################################// #
#define table_strings_bound  20000
CHAR table_strings[table_strings_bound];
INT current_stroffset = 0;
INT current_strindex = 0;



// ##################################################################################################// #
// Structure PROCINFO: information about procedures									#
// ##################################################################################################// #
// <label>		- procedure label in the assembly code								#
// <quadptr>		- pointer to the quad of table <quads> where the procedure starts				#
// <temps_used>	- array where the used temporaries are kept							#
// <max_temp>	- the highest rank of used temporary within the procedure					#
// <done>		- mark TRUE if code was generated for this procedure						#
// ##################################################################################################// #
typedef struct PROCINFO PROCINFO;
struct PROCINFO
{
STRING label;
 INT quadptr;
 BOOL temps_used[temps_bound];
 INT max_temp;
 BOOL done;
};


PROCINFO table_proc_info[proc_info_bound];
INT proc_info_index = 0;
INT current_proc = 0;
INT current_nesting = 0;


// ##################################################################################################// #
// Structure ENTITY: information about symbol table entries								#
// ##################################################################################################// #
// <type>		- type of entry												#
// <name>		- symbol name (variable, constant, procedure name, etc.)					#
// <value>		- constant value (if applicable)									#
// <nesting>		- nesting level												#
// <id>		- symbol id number for temporaries and labels							#
// <mode>		- symbol mode name											#
// <mode_size>	- the required size in bytes							 			#
// <storage_type>	- where the symbol is stored (<register>, <constant>, or <memory>)			#
// <addr_offset>	- variable's offset, if stored in memory								#
// <reg>		- variable's register, if in register								#
// <proc_info>	- pointer to procedure information table <table_proc_info>					#
// <scopeptr>	- pointer to start of previous scope in table <stack>						#
// ##################################################################################################// #
typedef struct ENTITY ENTITY;
struct ENTITY
{
INT type;
 STRING name;
 STRING value;
 INT nesting;
 INT id;
 INT proc_info;
 INT scopeptr;
 			   STRING mode;
 INT mode_size;
 INT storage_type;
 INT addr_offset;
 INT reg;
};



ENTITY stack[stack_bound];
INT stack_index = 1;
INT current_scope_start = 1;


INT arg_count = 0;

INT label_count = 0;
INT quad_index = 0;


INT align(INT n)
BEGIN
  INT i; 
  IF n MOD 8 == 0 THEN i = n ELSE i = 8*(n/8+1) FI;
  return (i);
END;


#ifndef set_next_proc
#define set_next_proc set_next_proc()
#endif
VOID set_next_proc
BEGIN
  current_proc = proc_info_index;
  WHILE current_proc > 0 AND table_proc_info[current_proc].done
  DO
    current_proc = current_proc - 1;
  OD;
  return;
END;


#ifndef reset_temps
#define reset_temps reset_temps()
#endif
VOID reset_temps
BEGIN
  INT i = 0;
  table_proc_info[proc_info_index].max_temp = 0;			// CAUTION: is proc_info_index right?
  WHILE i < temps_bound 
  DO 
    (table_proc_info[proc_info_index].temps_used)[i] = FALSE;
    i = i + 1;
  OD;
  return;
END;


#ifndef get_next_temp
#define get_next_temp get_next_temp()
#endif
INT get_next_temp
BEGIN
  INT i = 0;
  WHILE i < temps_bound AND (table_proc_info[current_proc].temps_used)[i] DO i = i + 1; OD;
  IF i == temps_bound THEN error("Temporary variables exhausted!"); FI;
  IF i > table_proc_info[current_proc].max_temp THEN 
    table_proc_info[current_proc].max_temp = table_proc_info[current_proc].max_temp + 1; 
  FI;
  (table_proc_info[current_proc].temps_used)[i] = TRUE;
  return (i);
END;


#ifndef reset_args
#define reset_args reset_args()
#endif
VOID reset_args
BEGIN
  arg_count = 0; 
  return;
END;


#ifndef get_arg_temp
#define get_arg_temp get_arg_temp()
#endif
INT get_arg_temp
BEGIN
  INT i = arg_count;
  arg_count = arg_count + 1;
  return (i);
END;


VOID free_temp(INT ptr)
BEGIN
  INT n;
  IF stack[ptr].type == entity_tempvar OR stack[ptr].type == entity_ptrvar THEN
    n = stack[ptr].id;
    (table_proc_info[current_proc].temps_used)[n] = FALSE;
    IF debug_echo THEN printf("\nTemp %i freed\n", n); FI;
  ELSE
    IF debug_echo THEN printf("\nFailed to free temp!\n"); FI;
  FI;
  return;
END;


#ifndef reset_labels
#define reset_labels reset_labels()
#endif
VOID reset_labels
BEGIN
  label_count = 0;
  return;
END;


#ifndef get_next_label
#define get_next_label get_next_label()
#endif
INT get_next_label
BEGIN
  label_count = label_count + 1;
  return (label_count);
END;


#ifndef inc_stack_index
#define inc_stack_index inc_stack_index()
#endif
VOID inc_stack_index
BEGIN
  stack_index = stack_index + 1;
  IF stack_index >= stack_bound THEN printf("Panic: Max stack limit exceeded!\n"); exit; FI;
  return;
END;


// ##################################################################################################// #
// MODE MANIPULATION FUNCTIONS													#
// ##################################################################################################// #


BOOL IsPrefix(STRING s, STRING p)
BEGIN
  INT i = 0;
  WHILE p[i] != REPR 0 AND s[i] == p[i] DO i = i + 1 OD;
  return (p[i] == REPR 0);
END;


BOOL is_mode_void(INT ptr)
BEGIN
  return (StrEqual(stack[ptr].mode, "VOID"));
END;


BOOL is_mode_array(INT ptr)
BEGIN
  return (IsPrefix(stack[ptr].mode, "[") OR IsPrefix(stack[ptr].mode, "REF ["));
END;


BOOL is_mode_struc(INT ptr)
BEGIN
  return (IsPrefix(stack[ptr].mode, "(") OR IsPrefix(stack[ptr].mode, "REF ("));
END;


INT get_storage_size(STRING m, BOOL array)
BEGIN
  INT ptr, size;
  STRING mode;

  IF IsPrefix(mode, "REF") THEN StrTail(mode, m, 4); ELSE StrAssign(mode, m); FI;

  IF array THEN
    IF StrEqual(mode, "REF") THEN size = 8;
    ELIF StrEqual(mode, "FILE") THEN size = 4;
    ELIF StrEqual(mode, "INT") THEN size = 4;
    ELIF StrEqual(mode, "CHAR") THEN size = 1;
    ELIF StrEqual(mode, "BOOL") THEN size = 1;
    ELIF StrEqual(mode, "STRING") THEN size = string_size;
    ELIF StrEqual(mode, "VOID") THEN size = 0;
    ELSE ptr = lookup(mode); size = stack[ptr].mode_size;
    FI;
  ELSE
    IF StrEqual(mode, "REF") THEN size = 8;
    ELIF StrEqual(mode, "FILE") THEN size = 8;
    ELIF StrEqual(mode, "INT") THEN size = 8;
    ELIF StrEqual(mode, "CHAR") THEN size = 8;
    ELIF StrEqual(mode, "BOOL") THEN size = 8;
    ELIF StrEqual(mode, "STRING") THEN size = string_size;
    ELIF StrEqual(mode, "VOID") THEN size = 0;
    ELSE ptr = lookup(mode); size = stack[ptr].mode_size; 
    FI;
  FI;
  return (size);
END;


INT get_element_size(INT ptr)
BEGIN
  STRING mode;
  INT size;

  IF is_mode_array(ptr) THEN StrTail(mode, stack[ptr].mode, 3) 
  ELSE StrAssign(mode, stack[ptr].mode) FI; 

  IF IsPrefix(mode, "REF") THEN size = 8;
  ELIF StrEqual(mode, "FILE") THEN size = 4;
  ELIF StrEqual(mode, "INT") THEN size = 4;
  ELIF StrEqual(mode, "CHAR") THEN size = 1;
  ELIF StrEqual(mode, "BOOL") THEN size = 1;
  ELIF StrEqual(mode, "STRING") THEN size = string_size;
  ELSE
    printf("get_element_size: mode %s not implemented!\n", mode);
    error("");
  FI;
  return (size);
END;


CHAR get_storage_code(INT ptr)
BEGIN
  STRING mode;
  CHAR code;

  IF IsPrefix(stack[ptr].mode, "REF") THEN StrTail(mode, stack[ptr].mode, 4); 
  ELSE StrAssign(mode, stack[ptr].mode); FI; 

  IF is_mode_array(ptr) THEN StrTail(mode, mode, StrFind(mode, ']', 0) + 2); FI; 

  IF IsPrefix(mode, "REF") THEN code = 'O';
  ELIF StrEqual(mode, "INT") THEN code = 'T';
  ELIF StrEqual(mode, "CHAR") THEN code = 'B';
  ELIF StrEqual(mode, "BOOL") THEN code = 'B';
  ELIF StrEqual(mode, "STRING") THEN code = 'B';
  ELSE
    printf("get_storage_code: non-primitive mode _%s_\n", mode);
    error("");
  FI;
  return (code );
END;


INT deref_mode(STRING source_mode, STRING target_mode)
BEGIN
  STRING mode;
  INT count = 0;
  StrAssign(mode, source_mode);
  WHILE NOT StrEqual(mode, target_mode) AND IsPrefix(mode, "REF")
  DO 
    count = count + 1;
    StrTail(mode, mode, 4);
  OD;
  IF NOT StrEqual(mode, target_mode) THEN count = -1; FI;
  return (count);
END;


BOOL check_mode(INT ptr, STRING mode)
BEGIN
  return (deref_mode(stack[ptr].mode, mode) >= 0);
END;


VOID accept_mode(INT ptr, STRING mode)
BEGIN
  IF NOT check_mode(ptr, mode) THEN
    printf("Expected mode %s and found %s! ", mode, stack[ptr].mode);
    error("Incompatible modes!")
  FI;
  return;
END;


BOOL is_mode_composite(INT ptr)
BEGIN
  return (check_mode(ptr, "STRING") OR is_mode_array(ptr) OR is_mode_struc(ptr));
END;


BOOL is_mode_ref(INT ptr)
BEGIN
  return (IsPrefix(stack[ptr].mode, "REF"));
END;


INT StrMatchPrefix(REF STRING str, STRING prefix)
BEGIN
  STRING tmp;
  INT j = 0;
  WHILE prefix[j] != REPR 0 AND prefix[j] == str[j]
  DO 
    IF str[j] == '[' THEN 
      StrSlice(tmp, str, 0, j);
      StrTail(str, str, StrFind(str, ']', j));
      StrAppend(str, tmp, str);
    FI;
    j = j + 1; 
  OD;
  return (j);
END;


VOID unify(REF STRING lmode, REF STRING rmode, REF STRING mode)
BEGIN
  STRING prefix;
  INT i, j, n;
  BOOL found;

  IF IsPrefix(mode, "{}") AND 
     NOT IsPrefix(rmode, "REF") AND NOT IsPrefix(rmode, "(") AND NOT IsPrefix(rmode, "[")
  THEN
    StrAppend(lmode, lmode, rmode);
    StrAssign(mode, "");
  ELIF IsPrefix(mode, "{") THEN
    i = 1;
    n = StrLen(mode);
    found = FALSE;
    WHILE i < n AND NOT found
    DO
      j = StrFind(mode, ',', i);
      IF j == n THEN StrSlice(prefix, mode, i, j - 2); ELSE StrSlice(prefix, mode, i, j - 1); FI;
      IF StrEqual(rmode, prefix) THEN 
        StrAppend(lmode, lmode, prefix);
        StrAssign(mode, "");
        found = TRUE;
      FI;
      i = j + 1;
    OD;
  ELSE
    i = StrMatchPrefix(rmode, mode);
// printf("StrMatchPrefix(%s,%s) == %i\n", rmode, mode, i);
    StrSlice(prefix, rmode, 0, i - 1);
    StrAppend(lmode, lmode, prefix);
    StrTail(rmode, rmode, i);
    StrTail(mode, mode, i);
// printf("unify: (prefix,lmode,rmode,mode) == (%s,%s,%s,%s)\n", prefix, lmode, rmode, mode);
  FI;
  return;
END;


VOID unify_labels(INT target, INT source)
BEGIN
  stack[target].id = stack[source].id;
  StrAssign(stack[target].name, stack[source].name);
  return;
END;



// ##################################################################################################// #
// EXTRACT SEMANTIC INFO FOR PROCEDURES											#
// --------------------------------------------------------------------------------------------------- #
// get_proc_mode: returns the mode of a procedure									#
// get_param_mode: returns the mode of a procedure's parameter							#
// ##################################################################################################// #

VOID get_proc_mode(INT proc, REF STRING mode)
BEGIN
  StrTail(mode, stack[proc].mode, StrFind(stack[proc].mode, ':', 0) + 1);
  return;
END;


VOID get_param_mode(INT proc, INT rank, REF STRING mode)
BEGIN
  STRING pmode;
  INT pos, k, count = rank - 1;
  StrAssign(pmode, stack[proc].mode);
  pos = StrFind(pmode, '(', 0) + 1;
  k = pos;
  WHILE count > 0 
  DO
    IF pmode[pos] == '|' THEN count = count - 1; pos = pos + 1; k = pos; FI;
    pos = pos + 1;
  OD;
  StrSlice(mode, pmode, k, StrFind(pmode, '|', k) - 1);
  return;
END;



// ##################################################################################################// #
// calc_mode_size - compute the size of a mode (ignore initial REF?)						#
// ##################################################################################################// #

INT get_next_field(REF STRING fieldmode, REF STRING fieldname, STRING mode, INT pos)
BEGIN
  INT paren;
  INT i = pos;
  INT j;

  IF mode[i] == '(' THEN
    paren = 1;
    i = i + 1;
    WHILE paren > 0
    DO
      IF mode[i] == '(' THEN paren = paren + 1; ELIF mode[i] == ')' THEN paren = paren - 1; FI;
      i = i + 1;
    OD;
  ELSE
    WHILE mode[i] < 'a' OR mode[i] > 'z' DO i = i + 1; OD;
  FI;
  StrSlice(fieldmode, mode, pos, i - 2);

  WHILE mode[i] == ' ' DO i = i + 1; OD;
  j = i;
  WHILE mode[i] != ')' AND mode[i] != ',' DO i = i + 1; OD;
  StrSlice(fieldname, mode, j, i - 1);

  IF mode[i] == ')' THEN i = -1; ELSE i = i + 1; FI;

  return (i);
END;


INT calc_mode_size(STRING source_mode, BOOL array)
BEGIN
  INT size, k, pos;
  STRING next_mode, mode, field, items;
  INT ptr;

  IF IsPrefix(source_mode, "REF") THEN StrTail(mode, source_mode, 4); 
  ELSE StrAssign(mode, source_mode); 
  FI;

// CAUTION: STRUCT recursiveness does NOT work!

  IF IsPrefix(mode, "[") THEN 
    k = StrFind(mode, '[', 0);
    pos = StrFind(mode, ']', 0);
    StrSlice(items, mode, k + 1, pos - 1);
    StrTail(next_mode, mode, pos + 2);
    size = align(array_header_size + str2int(items) * calc_mode_size(next_mode, TRUE));      
  ELIF IsPrefix(mode, "(") THEN
    pos = StrFind(mode, '(', 0) + 1;
    size = struc_header_size;
    WHILE pos > 0 
    DO
      pos = get_next_field(next_mode, field, mode, pos);
      size = size + calc_mode_size(next_mode, FALSE);
    OD;
  ELSE
    IF array THEN
      IF IsPrefix(mode, "REF") THEN size = 8;
      ELIF StrEqual(mode, "FILE") THEN size = 4;
      ELIF StrEqual(mode, "INT") THEN size = 4;
      ELIF StrEqual(mode, "CHAR") THEN size = 1;
      ELIF StrEqual(mode, "BOOL") THEN size = 1;
      ELIF StrEqual(mode, "STRING") THEN size = string_size;
      ELIF StrEqual(mode, "VOID") OR StrEqual(mode, "?") THEN size = 0;
      ELSE 
        ptr = lookup(mode);
        size = calc_mode_size(stack[ptr].mode, FALSE);
      FI;
    ELSE
      IF IsPrefix(mode, "REF") THEN size = 8;
      ELIF StrEqual(mode, "FILE") THEN size = 8;
      ELIF StrEqual(mode, "INT") THEN size = 8;
      ELIF StrEqual(mode, "CHAR") THEN size = 8;
      ELIF StrEqual(mode, "BOOL") THEN size = 8;
      ELIF StrEqual(mode, "STRING") THEN size = string_size;
      ELIF StrEqual(mode, "VOID") OR StrEqual(mode, "?") THEN size = 0;
      ELSE 
        ptr = lookup(mode);
        size = calc_mode_size(stack[ptr].mode, FALSE);
      FI;
    FI;
  FI;
  return (size);
END;


INT calc_mode_items(STRING mode)
BEGIN
  INT i, j;
  STRING items;
  IF IsPrefix(mode, "[") OR IsPrefix(mode, "REF [") THEN 
    i = StrFind(mode, '[', 0);
    j = StrFind(mode, ']', i);
    StrSlice(items, mode, i + 1, j - 1);
  ELSE
    printf("calc_mode_items: %s not an array!", mode);
    error("");
  FI;
  return (str2int(items));
END;






// ##################################################################################################// #
// FUNCTIONS	FOR STRUCTURES													#
// ##################################################################################################// #


INT match(STRING strucmode, STRING fieldname, INT start)
BEGIN
  INT i = start;
  INT j = 0;

  WHILE fieldname[j] != REPR 0 AND fieldname[j] == strucmode[i] 
  DO
    j = j + 1;
    i = i + 1;
  OD;
  IF NOT (fieldname[j] == REPR 0 AND 
    (strucmode[i] == REPR 0 OR strucmode[i] == ',' OR strucmode[i] == ')'))
  THEN
    i = -1;
  FI;
  return (i);
END;


INT calc_field_offset(STRING mode, STRING name)
BEGIN
  STRING fieldmode, field;
  INT pos = StrFind(mode, '(', 0) + 1;
  INT offset = struc_header_size;
  WHILE pos > 0 
  DO
    pos = get_next_field(fieldmode, field, mode, pos);
    IF StrEqual(field, name) THEN pos = 0;
    ELSE offset = offset + calc_mode_size(fieldmode, FALSE); FI;
  OD;
  return (offset);
END;


BOOL find_field(REF STRING strucmode, STRING fieldname, REF STRING fieldmode)
BEGIN
  STRING alias, mode, field;
  BOOL found = FALSE;
  INT paren, pos, k;
  INT i;
  INT ptr;

//  printf("STRUCMODE == %s\n", strucmode);

// get rid of leading REF
  IF IsPrefix(strucmode, "REF") THEN 
    i = 4;
    StrSlice(fieldmode, strucmode, 0, i - 1); 
  ELSE 
    i = 0;
  FI;

// CAUTION: this should be a WHILE loop
  IF strucmode[i] != '(' THEN
    StrTail(alias, strucmode, i);
    strucmode[i] = REPR 0;
    ptr = lookup(alias);
    StrAppend(strucmode, strucmode, stack[ptr].mode);
  FI;

  i = i + 1;
  k = i;

  WHILE strucmode[i] != REPR 0 AND NOT found
  DO 

    IF strucmode[i] == '(' THEN
      paren = 1;
      i = i + 1;
      WHILE paren > 0
      DO
        IF strucmode[i] == '(' THEN paren = paren + 1; ELIF strucmode[i] == ')' THEN paren = paren - 1; FI;
        i = i + 1;
      OD;
    FI;

    IF strucmode[i] >= 'a' AND strucmode[i] <= 'z' THEN
      pos = match(strucmode, fieldname, i);
// printf("MATCHING '%s' in '%s' => %i\n", fieldname, strucmode + i, pos);
      IF pos == -1 THEN
        WHILE NOT (strucmode[i] == ',' OR strucmode[i] == ')') DO i = i + 1; OD;
        IF strucmode[i] == ',' THEN i = i + 1; k = i; FI;
      ELSE
        StrSlice(mode, strucmode, k, i - 2);
        StrAppend(fieldmode, fieldmode, mode);
        found = TRUE;
      FI;

    ELSE
      i = i + 1;
    FI;
  OD;
  return (found);
END;


VOID set_fieldvar(INT struc, INT field)
BEGIN
  STRING fieldmode;
  STRING tmp;

  IF NOT find_field(stack[struc].mode, stack[field].name, fieldmode) THEN
    printf("Field %s not found in structure %s!", stack[field].name, stack[struc].mode);
    error("")
  FI;
//  printf("Final mode is _%s_\n", fieldmode);

  stack[field].type = entity_ptrvar;
  StrAssign(stack[field].mode, fieldmode);
  stack[field].mode_size = calc_mode_size(fieldmode, FALSE);
  stack[field].addr_offset = calc_field_offset(stack[struc].mode, stack[field].name);

  stack[field].id = get_next_temp;
  int2str(stack[field].id, tmp);
  StrAppend(stack[field].name, "%", tmp);
  return;
END;




// ##################################################################################################// #
// SYMBOL TABLE ENTRY FUNCTIONS												#
// ##################################################################################################// #


INT record_string(STRING name)
BEGIN
  INT offset = current_stroffset;
  INT i;
  IF StrLen(name) > 2 THEN
    table_strings[current_strindex] = name[0];
    current_strindex = current_strindex + 1;
    current_stroffset = current_stroffset + 1;
    i = 1;
    WHILE name[i+1] != REPR 0 
    DO
      IF name[i] == '\"' THEN								// MMIX wants quotes out of string
        table_strings[current_strindex] = '\"';
        table_strings[current_strindex+1] = ',';
        table_strings[current_strindex+2] = '\'';
        table_strings[current_strindex+3] = '\"';
        table_strings[current_strindex+4] = '\'';
        table_strings[current_strindex+5] = ',';
        table_strings[current_strindex+6] = '\"';
        current_strindex = current_strindex + 7;
        current_stroffset = current_stroffset + 1;
        i = i + 1;
      ELSE
        table_strings[current_strindex] = name[i];
        current_strindex = current_strindex + 1;
        current_stroffset = current_stroffset + 1;
        i = i + 1;
      FI;
    OD;
    table_strings[current_strindex] = name[i];
    table_strings[current_strindex+1] = name[i+1];
    current_strindex = current_strindex + 2;
    current_stroffset = align(current_stroffset + 8);			// trailing zero + zero octabyte!
  ELSE
    offset = current_stroffset - 8;						// use previous!
  FI;
  return (offset);
END;


INT new_mode(STRING name, STRING mode)
BEGIN
  INT ptr = stack_index;
  stack[stack_index].type = entity_mode;
  StrAssign(stack[stack_index].name, name);
  stack[stack_index].nesting = current_nesting;
  StrAssign(stack[stack_index].mode, mode);
  stack[stack_index].mode_size = calc_mode_size(mode, FALSE); 
  stack[stack_index].addr_offset = 0;
  stack[stack_index].reg = -1;
  inc_stack_index;
  return (ptr);
END;


INT new_var(STRING name, STRING mode)
BEGIN
  INT ptr = stack_index;
  stack[stack_index].type = entity_var;
  StrAssign(stack[stack_index].name, name);
  stack[stack_index].nesting = current_nesting;
  StrAssign(stack[stack_index].mode, mode);
  stack[stack_index].mode_size = calc_mode_size(mode, FALSE); 
  stack[stack_index].addr_offset = 0;
  stack[stack_index].reg = -1;
  inc_stack_index;
  return (ptr);
END;


INT new_tempvar(STRING mode)
BEGIN
  STRING tmp;
  INT ptr = stack_index;
  stack[stack_index].type = entity_tempvar;
  stack[stack_index].id = get_next_temp;
  int2str(stack[stack_index].id, tmp);
  StrAppend(stack[stack_index].name, "%", tmp);
  stack[stack_index].nesting = current_nesting;
  StrAssign(stack[stack_index].mode, mode);
  stack[stack_index].mode_size = calc_mode_size(mode, FALSE);
  stack[stack_index].addr_offset = 0;
  stack[stack_index].reg = -1;
  inc_stack_index;
  return (ptr);
END;


INT new_argvar(STRING mode)
BEGIN
  STRING tmp;
  INT ptr = stack_index;
  stack[stack_index].type = entity_argvar;
  stack[stack_index].id = get_arg_temp;
  int2str(stack[stack_index].id, tmp);
  StrAppend(stack[stack_index].name, "&", tmp);
  stack[stack_index].nesting = current_nesting;
  StrAssign(stack[stack_index].mode, mode);
  stack[stack_index].mode_size = calc_mode_size(mode, FALSE);
  stack[stack_index].reg = -1;
  inc_stack_index;
  return (ptr);
END;


INT new_param(STRING name, STRING mode)
BEGIN
  INT ptr = stack_index;
  stack[stack_index].type = entity_param;
  StrAssign(stack[stack_index].name, name);
  stack[stack_index].nesting = current_nesting;
  StrAssign(stack[stack_index].mode, mode);
  stack[stack_index].mode_size = calc_mode_size(mode, FALSE);
  stack[stack_index].addr_offset = 0;
  stack[stack_index].reg = -1;
  inc_stack_index;
  return (ptr );
END;


INT new_const(STRING name, STRING mode)
BEGIN
  INT ptr = stack_index;
  stack[stack_index].type = entity_constant;
  StrAssign(stack[stack_index].name, name);
  StrAssign(stack[stack_index].value, name);
  stack[stack_index].nesting = current_nesting;
  StrAssign(stack[stack_index].mode, mode);
  stack[stack_index].mode_size = calc_mode_size(mode, FALSE);
  stack[stack_index].addr_offset = 0;
  stack[stack_index].reg = -1;
  inc_stack_index;
  return (ptr);
END;


INT new_charconst(STRING name)
BEGIN
  INT ptr = stack_index;
  stack[stack_index].type = entity_constant;
  (stack[stack_index].name)[0] = '\'';
  (stack[stack_index].name)[1] = name[0];
  (stack[stack_index].name)[2] = '\'';
  StrAssign(stack[stack_index].value, name);
  stack[stack_index].nesting = -1;
  StrAssign(stack[stack_index].mode, "CHAR");
  stack[stack_index].mode_size = 0;
  stack[stack_index].addr_offset = 0;
  stack[stack_index].reg = -1;
  inc_stack_index;
  return (ptr);
END;


INT new_strconst(STRING name)
BEGIN
  INT ptr = stack_index;
  stack[stack_index].type = entity_constant;
  StrAssign(stack[stack_index].name, name);
  StrAssign(stack[stack_index].value, name);
  stack[stack_index].nesting = -1;
  StrAssign(stack[stack_index].mode, "STRING");
  stack[stack_index].mode_size = string_size;
  stack[stack_index].addr_offset = record_string(name);
  stack[stack_index].reg = -1;
  inc_stack_index;
  return (ptr);
END;


#ifndef new_label
#define new_label new_label()
#endif
INT new_label
BEGIN
  STRING lbl;
  INT ptr = stack_index;
  stack[stack_index].type = entity_label;
  stack[stack_index].id = get_next_label;				// CAUTION: Do we need this?
  int2str(stack[stack_index].id, lbl);
  StrAppend(stack[stack_index].name, "L", lbl);
  stack[stack_index].nesting = current_nesting;
  inc_stack_index;
  return (ptr);
END;


INT new_fixedlabel(STRING label)
BEGIN
  STRING lbl;
  INT ptr = stack_index;
  stack[stack_index].type = entity_label;
  StrAssign(stack[stack_index].name, label);
  stack[stack_index].nesting = current_nesting;
  inc_stack_index;
  return (ptr);
END;


INT new_proc(STRING name)
BEGIN
  INT ptr = stack_index;
  stack[stack_index].type = entity_proc;
  StrAssign(stack[stack_index].name, name);
  StrAssign(stack[stack_index].mode, "");
  stack[stack_index].nesting = current_nesting + 1;
  proc_info_index = proc_info_index + 1;
  IF proc_info_index >= proc_info_bound THEN error("Procedure entries maximum exceeded!"); FI;
  current_proc = proc_info_index;
  stack[stack_index].proc_info = proc_info_index;
  table_proc_info[proc_info_index].quadptr = quad_index;
  table_proc_info[proc_info_index].done = FALSE;
  reset_temps;
  inc_stack_index;
  return (ptr);
END;


VOID set_proc_properties(INT ptr, INT label, STRING mode, INT mode_size)
BEGIN
  INT proc_info = stack[ptr].proc_info;
  current_proc = proc_info;
  StrAssign(table_proc_info[proc_info].label, stack[label].name);
  StrAssign(stack[ptr].mode, mode);
  stack[ptr].mode_size = mode_size;
  return;
END;


VOID runtime_proc(STRING name, STRING label, STRING mode, INT mode_size)
BEGIN
  stack[stack_index].type = entity_proc;
  StrAssign(stack[stack_index].name, name);
  stack[stack_index].nesting = current_nesting + 1;
  proc_info_index = proc_info_index + 1;
  IF proc_info_index >= proc_info_bound THEN error("Procedure entries maximum exceeded!"); FI;
  current_proc = proc_info_index;
  stack[stack_index].proc_info = proc_info_index;
  table_proc_info[proc_info_index].quadptr = 0;
  table_proc_info[proc_info_index].done = TRUE;
  reset_temps;
  StrAssign(table_proc_info[proc_info_index].label, label);
  StrAssign(stack[stack_index].mode, mode);
  stack[stack_index].mode_size = mode_size;
  inc_stack_index;
  return;
END;


#ifndef open_scope
#define open_scope open_scope()
#endif
VOID open_scope
BEGIN
  stack[stack_index].type = entity_startscope;
  StrAssign(stack[stack_index].name, "");
  inc_stack_index;
  return;
END;


#ifndef close_scope
#define close_scope close_scope()
#endif
VOID close_scope
BEGIN
  stack[stack_index].type = entity_endscope;
  StrAssign(stack[stack_index].name, "");
  inc_stack_index;
  return;
END;


#ifndef open_frame
#define open_frame open_frame()
#endif
VOID open_frame
BEGIN
  IF current_nesting > 0 THEN process_frame; FI;
  stack[stack_index].type = entity_frame;
  StrAssign(stack[stack_index].name, "");
  current_nesting = current_nesting + 1;
  IF current_nesting > max_nesting THEN error("Maximum procedure nesting level exceeded!") FI;
  stack[stack_index].nesting = current_nesting;
  stack[stack_index].scopeptr = current_scope_start;
  current_scope_start = stack_index;
  inc_stack_index;
  return;
END;


#ifndef close_frame
#define close_frame close_frame()
#endif
VOID close_frame
BEGIN
  printf("Generating code...\n");
  generate_code;
  stack_index = current_scope_start;
  current_scope_start = stack[stack_index].scopeptr;
  table_proc_info[current_proc].done = TRUE;
  current_nesting = current_nesting - 1;
  set_next_proc;
  return;
END;


#ifndef init_stack
#define init_stack init_stack()
#endif
VOID init_stack
BEGIN
  stack[0].type = entity_empty;
  StrAssign(stack[0].name, "EMPTY");
  stack[0].id = -1;
  stack[0].proc_info = -1;
  stack[0].scopeptr = -1;
  StrAssign(stack[0].mode, "EMPTY");
  stack[0].storage_type = -1;
  stack[0].addr_offset = -1;
  stack[0].reg = -1;
  return;
END;


INT lookup(STRING name)
BEGIN
  INT enclosed;
  INT index = stack_index - 1;
  WHILE index >= 1 AND NOT StrEqual(stack[index].name, name)
  DO
    IF stack[index].type == entity_endscope THEN
      enclosed = 1;
      WHILE enclosed > 0 
      DO
        index = index - 1;
        IF stack[index].type == entity_endscope THEN enclosed = enclosed + 1;
        ELIF stack[index].type == entity_startscope THEN enclosed = enclosed - 1;
        FI;
      OD;
    FI;
    index = index - 1;
  OD;
  return (index);
END;


INT flookup(STRING name)
BEGIN
  INT index = lookup(name);
  IF index == 0 THEN printf("Symbol %s undeclared!\n", name); error(""); FI;
  return (index);
END;








typedef struct QUAD QUAD;
struct QUAD
{
INT type;
 INT result;
 INT left;
 INT right;
};


#define max_tetra  65535
#define max_byte  255

#define quad_bound  10000
#define register_bound  200

// #define quad_nop  0

#define quad_jump  1
#define quad_test  2
#define quad_label  3
#define quad_ret  5
#define quad_call  6
#define quad_arg  7
#define quad_proc  8
#define quad_endproc  9
#define quad_printn  10
#define quad_printc  11
#define quad_prints  12
#define quad_printi  13
#define quad_subscript  14
#define quad_of  15
#define quad_main  16
#define quad_alloc  17
#define quad_halt  18
#define quad_upb  19
#define quad_dump  20
#define quad_close  21
#define quad_open  22
#define quad_readc  23
#define quad_establish  24
#define quad_argref  25
#define quad_argsize  26
#define quad_addstr  27
#define quad_neg  28
#define quad_readchar  29
#define quad_alias  30


#define storage_constant  0
#define storage_register  1
#define storage_stackframe  2
#define storage_regaddr  3


INT approx_code_lines = 0;


// ##################################################################################################// #
// Structure STACKFRAME: information on the current stack frame							#
// ##################################################################################################// #
// <param_size>	- parameter fixed frame size in bytes								#
// <localvar_size>	- local variable fixed frame size in bytes							#
// <retaddr_reg>	- register holding the return address								#
// <display_reg>	- register holding the appropriate global display address					#
// <frameptr_reg>	- register holding the old frame pointer								#
// ##################################################################################################// #
typedef struct STACKFRAME STACKFRAME;
struct STACKFRAME
{
INT param_size;
 INT localvar_size;
 INT retaddr_reg;
 INT display_reg;
 INT frameptr_reg;
};



QUAD quads[quad_bound];
STACKFRAME stack_frame;


INT temp_regs, param_regs, var_regs, ret_regs;

#ifndef init_regs
#define init_regs init_regs()
#endif
VOID init_regs
BEGIN
  temp_regs = table_proc_info[current_proc].max_temp + 1;
  param_regs = 0;
  var_regs = 0;
  ret_regs = 0;
  return;
END;

#ifndef get_param_reg
#define get_param_reg get_param_reg()
#endif
INT get_param_reg
BEGIN
  param_regs = param_regs + 1;
  return (param_regs - 1);
END;

#ifndef get_var_reg
#define get_var_reg get_var_reg()
#endif
INT get_var_reg
BEGIN
  var_regs = var_regs + 1;
  return (param_regs + temp_regs + var_regs - 1);
END;

INT get_temp_reg(INT offset)
BEGIN
  return (param_regs + offset);
END;

#ifndef get_last_reg
#define get_last_reg get_last_reg()
#endif
INT get_last_reg
BEGIN
  return (param_regs + temp_regs + var_regs + ret_regs);
END;

#ifndef get_arg_reg
#define get_arg_reg get_arg_reg()
#endif
INT get_arg_reg
BEGIN
  arg_count = arg_count + 1;
  return (get_last_reg + arg_count);
END;




// ##################################################################################################// #
// HANDLE QUADRUPLES														#
// ##################################################################################################// #

VOID generate_quad(INT type, INT result, INT left, INT right)
BEGIN
  IF quad_index > 0 AND quads[quad_index-1].type == quad_label AND type == quad_label THEN
    unify_labels(result, quads[quad_index-1].result);
  ELSE
    quads[quad_index].type = type; 
    quads[quad_index].result = result;
    quads[quad_index].left = left;
    quads[quad_index].right = right;
    quad_index = quad_index + 1;
    IF quad_index >= quad_bound THEN printf("Panic: Max quad array limit exceeded!\n"); exit; FI;
  FI;
  return;
END;


VOID print_quad(INT index)
BEGIN
  INT resptr, lptr, rptr;
  INT proc_info;
  STRING tmp;

  resptr = quads[index].result;
  lptr = quads[index].left;
  rptr = quads[index].right;
  IF quads[index].type == tk_ASSIGN THEN 
    fprintf(outfile, "ASSIGN %s = %s\n", stack[resptr].name, stack[rptr].name);
  ELIF quads[index].type == quad_alias THEN 
    fprintf(outfile, "ALIAS %s -> %s\n", stack[lptr].name, stack[resptr].name);
  ELIF quads[index].type == quad_main THEN 
    fprintf(outfile, "MAIN\n");
  ELIF quads[index].type == quad_halt THEN 
    fprintf(outfile, "HALT\n");
  ELIF quads[index].type == quad_dump THEN 
    fprintf(outfile, "DUMPFRAME\n");
  ELIF quads[index].type == ABS '=' THEN 
    fprintf(outfile, "EQUAL %s == %s -> %s\n", stack[lptr].name, stack[rptr].name, stack[resptr].name);
  ELIF quads[index].type == ABS '>' THEN 
    fprintf(outfile, "GREATER %s > %s -> %s\n", stack[lptr].name, stack[rptr].name, stack[resptr].name);
  ELIF quads[index].type == ABS '<' THEN 
    fprintf(outfile, "LESS %s < %s -> %s\n", stack[lptr].name, stack[rptr].name, stack[resptr].name);
  ELIF quads[index].type == tk_GEQ THEN 
    fprintf(outfile, "GEQ %s >= %s -> %s\n", stack[lptr].name, stack[rptr].name, stack[resptr].name);
  ELIF quads[index].type == tk_LEQ THEN 
    fprintf(outfile, "LEQ %s <= %s -> %s\n", stack[lptr].name, stack[rptr].name, stack[resptr].name);
  ELIF quads[index].type == tk_NEQ THEN 
    fprintf(outfile, "NEQ %s != %s -> %s\n", stack[lptr].name, stack[rptr].name, stack[resptr].name);
  ELIF quads[index].type == tk_NOT THEN 
    fprintf(outfile, "NOT %s -> %s\n", stack[lptr].name, stack[resptr].name);
  ELIF quads[index].type == quad_neg THEN 
    fprintf(outfile, "NEG -%s -> %s\n", stack[lptr].name, stack[resptr].name);
  ELIF quads[index].type == ABS '+' THEN 
    fprintf(outfile, "PLUS %s = %s + %s\n", stack[resptr].name, stack[lptr].name, stack[rptr].name);
  ELIF quads[index].type == ABS '-' THEN 
    fprintf(outfile, "MINUS %s = %s - %s\n", stack[resptr].name, stack[lptr].name, stack[rptr].name);
  ELIF quads[index].type == ABS '*' THEN 
    fprintf(outfile, "MULT %s = %s * %s\n", stack[resptr].name, stack[lptr].name, stack[rptr].name);
  ELIF quads[index].type == ABS '/' THEN 
    fprintf(outfile, "DIV %s = %s / %s\n", stack[resptr].name, stack[lptr].name, stack[rptr].name);
  ELIF quads[index].type == tk_MOD THEN 
    fprintf(outfile, "MOD %s = %s MOD %s\n", stack[resptr].name, stack[lptr].name, stack[rptr].name);
  ELIF quads[index].type == tk_OR THEN 
    fprintf(outfile, "OR %s = %s || %s\n", stack[resptr].name, stack[lptr].name, stack[rptr].name);
  ELIF quads[index].type == tk_AND THEN 
    fprintf(outfile, "AND %s = %s && %s\n", stack[resptr].name, stack[lptr].name, stack[rptr].name);
  ELIF quads[index].type == quad_subscript THEN 
    fprintf(outfile, "SUBSCRIPT %s[%s] -> %s\n", stack[lptr].name, stack[rptr].name, stack[resptr].name);
  ELIF quads[index].type == quad_of THEN 
    fprintf(outfile, "OF %s OF %s -> %s\n", stack[resptr].name, stack[rptr].name, stack[resptr].name);
  ELIF quads[index].type == quad_upb THEN 
    fprintf(outfile, "UPB %s -> %s\n", stack[lptr].name, stack[resptr].name);
  ELIF quads[index].type == quad_jump THEN 
    fprintf(outfile, "JUMP %s\n", stack[resptr].name);
  ELIF quads[index].type == quad_test THEN 
    fprintf(outfile, "TEST %s -> %s\n", stack[lptr].name, stack[resptr].name);
  ELIF quads[index].type == quad_label THEN 
    fprintf(outfile, "%s: ", stack[resptr].name); print_quad(index + 1);
  ELIF quads[index].type == quad_printn THEN 
    fprintf(outfile, "PRINTn\n");
  ELIF quads[index].type == quad_printc THEN 
    fprintf(outfile, "PRINTc %s\n", stack[resptr].name);
  ELIF quads[index].type == quad_prints THEN 
    fprintf(outfile, "PRINTs %s\n", stack[resptr].name);
  ELIF quads[index].type == quad_printi THEN 
    fprintf(outfile, "PRINTi %s\n", stack[resptr].name);
  ELIF quads[index].type == quad_open THEN 
    fprintf(outfile, "OPEN %s, %s -> %s\n", stack[lptr].name, stack[rptr].name, stack[resptr].name);
  ELIF quads[index].type == quad_close THEN 
    fprintf(outfile, "CLOSE %s\n", stack[lptr].name);
  ELIF quads[index].type == quad_readc THEN 
    fprintf(outfile, "READC %s -> %s\n", stack[lptr].name, stack[resptr].name);
  ELIF quads[index].type == quad_readchar THEN 
    fprintf(outfile, "READCHAR -> %s\n", stack[resptr].name);
  ELIF quads[index].type == quad_alloc THEN 
    fprintf(outfile, "ALLOC %s of mode %s, %i items\n", stack[resptr].name, stack[resptr].mode, stack[resptr].mode_size);
  ELIF quads[index].type == quad_ret THEN 
    fprintf(outfile, "RET value %s\n", stack[resptr].name);
  ELIF quads[index].type == quad_arg THEN 
    fprintf(outfile, "ARG %s of mode %s -> %s\n", stack[lptr].name, stack[lptr].mode, stack[resptr].mode);
  ELIF quads[index].type == quad_argref THEN 
    fprintf(outfile, "ARGREF %s of mode %s and offset %i\n", stack[lptr].name, stack[lptr].mode, resptr - 8);
  ELIF quads[index].type == quad_argsize THEN 
    fprintf(outfile, "ARGSIZE size is %i\n", resptr + 8);
  ELIF quads[index].type == quad_call THEN 
    get_proc_mode(lptr, tmp);
    fprintf(outfile, "CALL procedure %s of mode %s -> %s\n", stack[lptr].name, tmp, stack[resptr].name);
  ELIF quads[index].type == quad_proc THEN 
    proc_info = stack[resptr].proc_info;
    get_proc_mode(resptr, tmp);
    fprintf(outfile, "PROC %s of mode %s with label %s\n", stack[resptr].name, tmp, table_proc_info[proc_info].label);
  ELIF quads[index].type == quad_endproc THEN 
    fprintf(outfile, "ENDPROC %s\n", stack[resptr].name);
  ELSE
    fprintf(outfile, "UNKNOWN\n", index);
  FI;
  return;
END;


#ifndef process_frame
#define process_frame process_frame()
#endif
VOID process_frame
BEGIN
  INT reg;
  INT index;
  INT param_offset = 0, localvar_offset = 0;

  init_regs;

  index = stack_index - 1;
  WHILE stack[index].type != entity_frame DO index = index - 1; OD;

// reserve three registers to hold return address, old frame pointer and global display
  IF index > 1 THEN ret_regs = 3; FI; 

  WHILE index < stack_index 
  DO
// ---------------------------------------------------------------------------------------------	#
// 							CONSTANTS								#
// ---------------------------------------------------------------------------------------------	#
    IF stack[index].type == entity_constant THEN 
      stack[index].storage_type = storage_constant;
      stack[index].reg = -1;					// do not remove this!

// ---------------------------------------------------------------------------------------------	#
// 							PARAMETERS								#
// ---------------------------------------------------------------------------------------------	#
    ELIF stack[index].type == entity_param AND NOT is_mode_void(index) THEN
// CAUTION: move everything to stack!
      IF is_mode_ref(index) THEN 								// ALL REFs are handled here!
        stack[index].storage_type = storage_regaddr;
        stack[index].reg = get_param_reg;
      ELIF is_mode_composite(index) THEN 							// composite non-REFs 
        stack[index].storage_type = storage_regaddr;
        stack[index].reg = get_param_reg;
      ELSE												// primitive non-REFs 
        stack[index].storage_type = storage_register;
        stack[index].reg = get_param_reg;
      FI;

// ---------------------------------------------------------------------------------------------	#
// 							VARIABLES								#
// ---------------------------------------------------------------------------------------------	#
    ELIF stack[index].type == entity_var AND NOT is_mode_void(index) THEN 
      stack[index].storage_type = storage_stackframe;
      stack[index].addr_offset = localvar_offset;
// TRICK: for arrays, the first 8 bytes belong to the header, so make offset point to data!
      IF is_mode_array(index) THEN 
        stack[index].addr_offset = stack[index].addr_offset + 8;
      FI;
      localvar_offset = localvar_offset + stack[index].mode_size;

//      ELSE
//        stack[index].storage_type = storage_register;
//        stack[index].reg = get_var_reg;
//      FI;

// ---------------------------------------------------------------------------------------------	#
// 							ARGUMENTS								#
// ---------------------------------------------------------------------------------------------	#
    ELIF stack[index].type == entity_argvar AND NOT is_mode_void(index) THEN 
      IF is_mode_composite(index) AND NOT is_mode_ref(index) THEN 
        IF is_mode_array(index) THEN						// variable size non-REF composites
          stack[index].storage_type = storage_regaddr;
          stack[index].reg = -1;
        ELSE										// fixed size non-REF composites
          stack[index].storage_type = storage_stackframe;
          stack[index].addr_offset = localvar_offset;
          // TRICK: for arrays, the first 8 bytes belong to the header, so make offset point to data!
          IF is_mode_array(index) THEN 
            stack[index].addr_offset = stack[index].addr_offset + 8;
          FI;
          localvar_offset = localvar_offset + stack[index].mode_size;
        FI;
      ELSE
        stack[index].storage_type = storage_register;
        stack[index].reg = -1;
      FI;

// ---------------------------------------------------------------------------------------------	#
// 							TEMPORARIES								#
// ---------------------------------------------------------------------------------------------	#
    ELIF stack[index].type == entity_tempvar AND NOT is_mode_void(index) THEN 
      IF is_mode_composite(index) THEN 
        stack[index].reg = get_temp_reg(stack[index].id);			// CAUTION: not always needed!
        stack[index].storage_type = storage_stackframe;
        stack[index].addr_offset = localvar_offset;
// TRICK: for arrays, the first 8 bytes belong to the header, so make offset point to data!
        IF is_mode_array(index) THEN 
          stack[index].addr_offset = stack[index].addr_offset + 8;
        FI;
        localvar_offset = localvar_offset + stack[index].mode_size;
      ELSE
        stack[index].storage_type = storage_register;
        stack[index].reg = get_temp_reg(stack[index].id);
      FI;

// ---------------------------------------------------------------------------------------------	#
// 							POINTERS?								#
// ---------------------------------------------------------------------------------------------	#
    ELIF stack[index].type == entity_ptrvar AND NOT is_mode_void(index) THEN 
      stack[index].storage_type = storage_regaddr;
//      stack[index].addr_offset = stack[index].addr_offset;
// TRICK: for arrays, the first 8 bytes belong to the header, so make offset point to data!
      IF is_mode_array(index) THEN 
        stack[index].addr_offset = stack[index].addr_offset + 8;
      FI;
      stack[index].reg = get_temp_reg(stack[index].id);
    FI;

    index = index + 1;
  OD;

  IF ret_regs != 0 THEN 
    stack_frame.retaddr_reg = get_var_reg; 
    stack_frame.display_reg = get_var_reg;
    stack_frame.frameptr_reg = get_var_reg;
  FI; 

  stack_frame.param_size = param_offset; 
  stack_frame.localvar_size = localvar_offset;
  printf("Stack frame produced\n"); 
  IF debug_stop THEN debugger; FI;
  return;
END;


// ##################################################################################################// #
// get_bp																#
// ##################################################################################################// #
VOID get_bp(INT ptr, REF STRING bp)
BEGIN
  IF current_nesting == stack[ptr].nesting THEN 
    StrAssign(bp, "fp");
  ELSE 
    int2str(stack[ptr].nesting, bp);
    StrAppend(bp, "disp", bp);
  FI;
  return;
END;


// ##################################################################################################// #
// mmix_set																#
// ##################################################################################################// #
// x - register number														#
// val - integer															#
// ##################################################################################################// #
VOID mmix_set(INT x, INT val)
BEGIN
  IF val < 0 THEN 
    mmix_set(x, -val);
    fprintf(outfile, "\tNEGU $%i,0,$%i\n", x, x);
  ELSE
    IF val > max_tetra THEN
      fprintf(outfile, "\tSETL $%i,%i&#ffff\n", x, val);
      fprintf(outfile, "\tORML $%i,%i>>16\n", x, val);
    ELSE
      fprintf(outfile, "\tSETL $%i,%i\n", x, val);
    FI;
  FI;
  return;
END;


// ##################################################################################################// #
// mmix_sets																#
// ##################################################################################################// #
// x - register string														#
// val - integer															#
// ##################################################################################################// #
VOID mmix_sets(STRING x, INT val)
BEGIN
  IF val < 0 THEN 
    mmix_sets(x, -val);
    fprintf(outfile, "\tNEGU %s,0,%s\n", x, x);
  ELSE
    IF val > max_tetra THEN
      fprintf(outfile, "\tSETL %s,%i&#ffff\n", x, val);
      fprintf(outfile, "\tORML %s,%i>>16\n", x, val);
    ELSE
      fprintf(outfile, "\tSETL %s,%i\n", x, val);
    FI;
  FI;
  return;
END;


// ##################################################################################################// #
// mmix_add																#
// ##################################################################################################// #
// x - register number														#
// y - register number														#
// z - integer															#
// ##################################################################################################// #
VOID mmix_add(INT x, INT y, INT zz)
BEGIN
  INT z = zz;
  STRING opcode;

  IF z == 0 THEN 
    IF x != y THEN fprintf(outfile, "\tSET $%i,$%i\n", x, y); FI;
  ELSE
    IF z > 0 THEN StrAssign(opcode, "ADDU") ELSE z = -z; StrAssign(opcode, "SUBU"); FI;
    IF z > max_byte THEN mmix_sets("temp1", z); fprintf(outfile, "\t%s $%i,$%i,temp1\n", opcode, x, y);
    ELSE fprintf(outfile, "\t%s $%i,$%i,%i\n", opcode, x, y, z); 
    FI;
  FI;
  return;
END;


// ##################################################################################################// #
// mmix_addssi															#
// ##################################################################################################// #
// x - register string														#
// y - register string														#
// z - integer															#
// ##################################################################################################// #
VOID mmix_addssi(STRING x, STRING y, INT zz)
BEGIN
  INT z = zz;
  STRING opcode;

  IF z == 0 THEN 
    IF NOT StrEqual(x, y) THEN fprintf(outfile, "\tSET %s,%s\n", x, y); FI;
  ELSE
    IF z > 0 THEN StrAssign(opcode, "ADDU") ELSE z = -z; StrAssign(opcode, "SUBU"); FI;
    IF z > max_byte THEN mmix_sets("$255", z); fprintf(outfile, "\t%s %s,%s,$255\n", opcode, x, y);
    ELSE fprintf(outfile, "\t%s %s,%s,%i\n", opcode, x, y, z); 
    FI;
  FI;
  return;
END;


// ##################################################################################################// #
// mmix_strappend - string concatenation (CAUTION: not updated!)							#
// ##################################################################################################// #
// 																	#
// 																	#
// 																	#
// ##################################################################################################// #
VOID mmix_strappend(INT target_symbol, INT left_symbol, INT right_symbol)
BEGIN
  STRING source, target, val;

  StrAssign(source, "temp1");
  StrAssign(target, "temp2");
  StrAssign(val, "temp3");

// Copy left string operand
  mmix_sets(source, stack[left_symbol].addr_offset);
  mmix_sets(target, stack[target_symbol].addr_offset);
  fprintf(outfile, "1H\tLDB %s,fp,%s\n", val, source);
  fprintf(outfile, "\tSTB %s,fp,%s\n", val, target);
  fprintf(outfile, "\tADD %s,%s,1\n", source, source);
  fprintf(outfile, "\tADD %s,%s,1\n", target, target);
  fprintf(outfile, "\tPBNZ %s,1B\n", val);

// Copy right string operand
  mmix_sets(source, stack[right_symbol].addr_offset);
  fprintf(outfile, "\tSUBU %s,%s,1\n", target, target);
  fprintf(outfile, "1H\tLDB %s,fp,%s\n", val, source);
  fprintf(outfile, "\tSTB %s,fp,%s\n", val, target);
  fprintf(outfile, "\tADD %s,%s,1\n", source, source);
  fprintf(outfile, "\tADD %s,%s,1\n", target, target);
  fprintf(outfile, "\tPBNZ %s,1B\n", val);

// write the ending zero to target
  fprintf(outfile, "\tSTB %s,fp,%s\n", val, target);

END;


// ##################################################################################################// #
// mmix_fix8c - handles load/store instructions when the Z value is an integer					#
// ##################################################################################################// #
// <opcode> 	- the mmix instruction opcode											#
// <c>		- the storage size ('B', 'W', 'T', or 'O')								#
// <x>		- the X register													#
// <y>		- the Y register													#
// <z>		- the Z value													#
// ##################################################################################################// #
// CAUTION: temp10 to be used exclusively by mmix_fix8c!								#
// ##################################################################################################// #
VOID mmix_fix8c(STRING opcode, CHAR c, STRING x, STRING y, INT z)
BEGIN
  IF z > max_byte THEN 
    mmix_sets("temp10", z); 
    fprintf(outfile, "\t%s%c %s,%s,temp10\n", opcode, c, x, y);
  ELSE
    fprintf(outfile, "\t%s%c %s,%s,%i\n", opcode, c, x, y, z);
  FI;
  return;
END;


// ##################################################################################################// #
// mmix_loadaddr - loads <source>'s absolute address into a register						#
// ##################################################################################################// #
// <outreg> 	- returned register where the address will be stored							#
// <inreg>	- register to use, if no register is designated for <source>					#
// <source>	- symbol whose address is needed										#
// ##################################################################################################// #
VOID mmix_loadaddr(REF STRING outreg, STRING inreg, INT source)
BEGIN
  STRING bp;

  StrAssign(outreg, inreg);

  IF stack[source].storage_type == storage_constant THEN
    fprintf(outfile, "\tGETA %s,STRINGS\n", outreg);
    mmix_addssi(outreg, outreg, stack[source].addr_offset);

  ELIF stack[source].storage_type == storage_stackframe THEN
    get_bp(source, bp);
    mmix_addssi(outreg, bp, stack[source].addr_offset);

  ELIF stack[source].storage_type == storage_regaddr THEN
//    int2str(stack[source].reg, outreg);
//    StrAppend(outreg, "$", outreg);
     fprintf(outfile, "\tSET %s,$%i\n", outreg, stack[source].reg);

  ELSE
    error("mmix_loadaddr: storage type should be <stackframe> or <regaddr>!");
  FI;
  return;
END;


// ##################################################################################################// #
// mmix_strcmp - compare two strings												#
// ##################################################################################################// #
// <opcode>	- appropriate opcode for '=', '/=', '>', '<', '<=', '=>' operations				#
// <result>	- symbol where the result is stored										#
// <lsymbol> - "left" symbol to be compared										#
// <rsymbol> - "right" symbol to be compared										#
// ##################################################################################################// #
VOID mmix_strcmp(STRING opcode, INT result, INT lsymbol, INT rsymbol)
BEGIN
  STRING lreg, rreg, val1, val2, ireg;

  StrAssign(val1, "temp3");
  StrAssign(val2, "temp4");
  StrAssign(ireg, "temp5");
  fprintf(outfile, "\tSETL %s,0\n", ireg);
  mmix_loadaddr(lreg, "temp1", lsymbol); 
  mmix_loadaddr(rreg, "temp2", rsymbol); 
  fprintf(outfile, "1H\tLDBU %s,%s,%s\n", val1, lreg, ireg);
  fprintf(outfile, "\tLDBU %s,%s,%s\n", val2, rreg, ireg);
  fprintf(outfile, "\tCMP %s,%s,%s\n", val2, val1, val2);
  fprintf(outfile, "\tBNZ %s,2F\n", val2);
  fprintf(outfile, "\tBZ %s,2F\n", val1);
  fprintf(outfile, "\tADD %s,%s,1\n", ireg, ireg);
  fprintf(outfile, "\tJMP 1B\n");
  fprintf(outfile, "2H\t%s $%i,%s,1\n", opcode, stack[result].reg, val2);
  return;
END;


// ##################################################################################################// #
// mmix_retcopy -															#
// ##################################################################################################// #
// 																	#
// 																	#
// 																	#
// ##################################################################################################// #
VOID mmix_retcopy(INT target_symbol, INT retreg)
BEGIN
  STRING target, val, n;
  CHAR code = get_storage_code(target_symbol);

// CAUTION: only return STRING implemented
  StrAssign(target, "temp1");
  StrAssign(val, "temp2");
  StrAssign(n, "temp3");
  mmix_sets(n, stack[target_symbol].mode_size);
  mmix_loadaddr(target, "temp4", target_symbol); 
  fprintf(outfile, "1H\tLD%c %s,$%i,0\n", code, val, retreg);
  fprintf(outfile, "\tST%c %s,%s,0\n", code, val, target);
  fprintf(outfile, "\tADD $%i,$%i,1\n", retreg, retreg);
  fprintf(outfile, "\tADD %s,%s,1\n", target, target);
  fprintf(outfile, "\tSUB %s,%s,1\n", n, n);
  fprintf(outfile, "\tPBNZ %s,1B\n", n);
  return;
END;


// ##################################################################################################// #
// mmix_memcopy - copy composite objects											#
// ##################################################################################################// #
// <source_symbol> - source symbol to copy from										#
// <target_symbol> - target symbol to copy to										#
// ##################################################################################################// #
VOID mmix_memcopy(INT source_symbol, INT target_symbol)
BEGIN
  STRING sreg, treg, ireg, val, size;
  INT i, n;
  STRING s;
  CHAR code = get_storage_code(source_symbol);

  IF source_symbol != target_symbol THEN
    StrAssign(val, "temp3");
    StrAssign(size, "temp4");
    StrAssign(ireg, "temp5");
    fprintf(outfile, "\tSETL %s,%i\n", size, stack[source_symbol].mode_size);
    IF is_mode_array(source_symbol) THEN
      fprintf(outfile, "\tNEGU %s,0,8\n", ireg);
    ELSE
      fprintf(outfile, "\tSETL %s,0\n", ireg);
    FI;
    mmix_loadaddr(sreg, "temp1", source_symbol); 
    mmix_loadaddr(treg, "temp2", target_symbol); 
    fprintf(outfile, "1H\tLDOU %s,%s,%s\n", val, sreg, ireg);
    fprintf(outfile, "\tSTOU %s,%s,%s\n", val, treg, ireg);
    fprintf(outfile, "\tBZ %s,2F\n", val);								// zero-octet heuristic
    fprintf(outfile, "\tADD %s,%s,8\n", ireg, ireg);
    fprintf(outfile, "\tSUB %s,%s,8\n", size, size);
    fprintf(outfile, "\tPBNZ %s,1B\n", size);
    fprintf(outfile, "2H\tSET $255,$255\n");								// dummy instruction
  FI;
  return;
END;


// ##################################################################################################// #
// mmix_loadref - loads <source>'s value into its designated register						#
// ##################################################################################################// #
// <source>	- symbol stored as <regaddr>											#
// ##################################################################################################// #
VOID mmix_loadref(STRING reg, INT source)
BEGIN
  IF stack[source].storage_type != storage_regaddr THEN 
    error("mmix_loadref: source must be stored as <regaddr>!");
  FI;
  fprintf(outfile, "\tLD%c %s,$%i,0\n", get_storage_code(source), reg, stack[source].reg);
  stack[source].storage_type = storage_register;
  return;
END;


// ##################################################################################################// #
// mmix_loadsource - loads <source>'s value into a register								#
// ##################################################################################################// #
// <outreg> 	- returned register where the value will be stored							#
// <inreg>	- register to use, if no register is designated for <source>					#
// <source>	- symbol whose value is needed										#
// ##################################################################################################// #
VOID mmix_loadsource(REF STRING outreg, STRING inreg, INT source)
BEGIN
  STRING bp;

  StrAssign(outreg, inreg);

  IF stack[source].storage_type == storage_register THEN
//    int2str(stack[source].reg, outreg);
//    StrAppend(outreg, "$", outreg);
     fprintf(outfile, "\tSET %s,$%i\n", outreg, stack[source].reg);

  ELIF stack[source].storage_type == storage_constant THEN
    IF StrEqual(stack[source].mode, "CHAR") THEN
      fprintf(outfile, "\tSETL %s,%i\n", outreg, ABS (stack[source].value)[0]);
    ELIF StrEqual(stack[source].mode, "BOOL") THEN
      IF StrEqual(stack[source].value, "FALSE") THEN
        fprintf(outfile, "\tSETL %s,0\n", outreg);
      ELSE
        fprintf(outfile, "\tSETL %s,1\n", outreg);
      FI;
    ELSE
      mmix_sets(outreg, str2int(stack[source].value));
    FI;

  ELIF stack[source].storage_type == storage_stackframe THEN
    get_bp(source, bp);
    mmix_fix8c("LD", get_storage_code(source), outreg, bp, stack[source].addr_offset);

  ELIF stack[source].storage_type == storage_regaddr THEN
//    int2str(stack[source].reg, outreg);
//    StrAppend(outreg, "$", outreg);
    mmix_loadref(outreg, source);

  ELSE
    error("mmix_loadsource: unexpected storage type!");
  FI;
  return;
END;


// ##################################################################################################// #
// mmix_alias - implements identity "assignments"									#
// ##################################################################################################// #
// <target>	- target symbol 													#
// <source>	- source symbol													#
// ##################################################################################################// #
VOID mmix_alias(INT target, INT source)
BEGIN
  STRING reg;
  IF NOT is_mode_void(target) AND NOT is_mode_void(source) THEN
    IF stack[source].storage_type == storage_regaddr THEN 
      fprintf(outfile, "\tSET $%i,$%i\n", stack[target].reg, stack[source].reg);
      stack[target].storage_type = storage_regaddr;

    ELIF stack[source].storage_type == storage_register THEN 
      fprintf(outfile, "\tSET $%i,$%i\n", stack[target].reg, stack[source].reg);
      stack[target].storage_type = storage_register;

    ELIF stack[source].storage_type == storage_stackframe THEN
      mmix_loadaddr(reg, "temp1", source);
      fprintf(outfile, "\tSET $%i,%s\n", stack[target].reg, reg);
      stack[target].storage_type = storage_regaddr;

    ELIF stack[source].storage_type == storage_constant THEN
      mmix_loadsource(reg, "temp1", source);
      fprintf(outfile, "\tSET $%i,%s\n", stack[target].reg, reg);
      stack[target].storage_type = storage_register;
    FI;
  FI;
  return;
END;


// ##################################################################################################// #
// mmix_store - stores <source> to <target>										#
// ##################################################################################################// #
// <target>	- target symbol 													#
// <source>	- source symbol													#
// ##################################################################################################// #
VOID mmix_store(INT target, INT source)
BEGIN
  STRING reg, bp;
  INT val;

  IF is_mode_composite(source) THEN mmix_memcopy(source, target);

  ELIF NOT is_mode_void(target) THEN
    mmix_loadsource(reg, "temp1", source);

    IF stack[target].storage_type == storage_regaddr THEN 
      fprintf(outfile, "\tST%c %s,$%i,0\n", get_storage_code(target), reg, stack[target].reg);

    ELIF stack[target].storage_type == storage_register THEN 
      fprintf(outfile, "\tSET $%i,%s\n", stack[target].reg, reg);

    ELIF stack[target].storage_type == storage_stackframe THEN
      get_bp(target, bp);
      mmix_fix8c("ST", get_storage_code(target), reg, bp, stack[target].addr_offset);

    ELSE
      printf("source %s (%s), target %s (%s,%i)\n", stack[source].name, stack[source].mode, stack[target].name, stack[target].mode, stack[target].storage_type);
      error("Code generation 'mmix_store': invalid storage type!");
    FI;

  FI;
  return;
END;


// ##################################################################################################// #
// generate_code -															#
// ##################################################################################################// #
// 																	#
// 																	#
// 																	#
// ##################################################################################################// #
#ifndef generate_code
#define generate_code generate_code()
#endif
VOID generate_code
BEGIN
  INT ptr, lptr, rptr;
  STRING opcode, lreg, rreg, resreg, bp;
  INT index, quadptr;
  INT reg;
  INT proc_info;
  INT val;
  INT n;

  quadptr = table_proc_info[current_proc].quadptr;

  process_frame;							// determine address/register allocation 

  index = quadptr;
  WHILE index < quad_index 
  DO
    ptr  = quads[index].result;
    lptr = quads[index].left;
    rptr = quads[index].right;

    IF code_comments THEN
      IF (index > quadptr AND quads[index-1].type != quad_label) OR (index == quadptr) THEN
        fprintf(outfile, "\n\t%% "); 
        print_quad(index);
        approx_code_lines = approx_code_lines + 10;
        IF approx_code_lines > 60000 THEN 
          fprintf(outfile, "\n#\t1 \"foo.mms\"\n\n"); 
          approx_code_lines = 0;
        FI;
      FI;
    FI;

// ##################################################################################################// #
// QUADS ADDSTR															#
// ##################################################################################################// #
    IF quads[index].type == quad_addstr THEN mmix_strappend(ptr, lptr, rptr);


// ##################################################################################################// #
// QUAD tk_MOD															#
// ##################################################################################################// #
    ELIF quads[index].type == tk_MOD THEN 
      mmix_loadsource(lreg, "temp1", lptr);
      mmix_loadsource(rreg, "temp2", rptr);
      fprintf(outfile, "\tDIV $%i,%s,%s\n", stack[ptr].reg, lreg, rreg);
      fprintf(outfile, "\tGET $%i,rR\n", stack[ptr].reg);


// ##################################################################################################// #
// QUADS '+', '-', '*', '/', tk_OR, tk_AND										#
// ##################################################################################################// #
    ELIF quads[index].type == ABS '+' OR quads[index].type == ABS '-' OR
       quads[index].type == ABS '/' OR quads[index].type == ABS '*' OR
       quads[index].type == tk_OR OR quads[index].type == tk_AND
    THEN 
      IF quads[index].type == ABS '+' THEN StrAssign(opcode, "ADD");
      ELIF quads[index].type == ABS '-' THEN StrAssign(opcode, "SUB");
      ELIF quads[index].type == ABS '*' THEN StrAssign(opcode, "MUL");
      ELIF quads[index].type == ABS '/' THEN StrAssign(opcode, "DIV");
      ELIF quads[index].type == tk_OR THEN StrAssign(opcode, "OR");
      ELIF quads[index].type == tk_AND THEN StrAssign(opcode, "AND");
      FI;
      mmix_loadsource(lreg, "temp1", lptr);
      mmix_loadsource(rreg, "temp2", rptr);
      fprintf(outfile, "\t%s $%i,%s,%s\n", opcode, stack[ptr].reg, lreg, rreg);


// ##################################################################################################// #
// QUAD UPB																#
// ##################################################################################################// #
    ELIF quads[index].type == quad_upb THEN
      mmix_loadaddr(lreg, "temp1", lptr);
      fprintf(outfile, "\tSUB $%i,%s,4\n", stack[ptr].reg, lreg);
      fprintf(outfile, "\tLDT $%i,$%i,0\n", stack[ptr].reg, stack[ptr].reg);


// ##################################################################################################// #
// QUAD SUBSCRIPT															#
// --------------------------------------------------------------------------------------------------- #
// 1. If source symbol <lptr> is a pure array (not a string), load the base address from its header	#
// 2. Add the appropriate offset: <rptr> * (<ptr> size)								#
// 3. Mark <storage_type> as pointer, to indicate that <ptr> contains a pointer to the variable		#
// ##################################################################################################// #
    ELIF quads[index].type == quad_subscript THEN
      mmix_loadsource(rreg, "temp1", rptr);
      mmix_loadaddr(lreg, "temp2", lptr);
      n = calc_mode_size(stack[ptr].mode, TRUE);
      IF n == 1 THEN
        fprintf(outfile, "\tADDU $%i,%s,%s\n", stack[ptr].reg, lreg, rreg);
      ELIF n == 2 OR n == 4 OR n == 8 OR n == 16 THEN
        fprintf(outfile, "\t%iADDU $%i,%s,%s\n", n, stack[ptr].reg, rreg, lreg);
      ELSE
        mmix_sets("temp3", n);
        fprintf(outfile, "\tMULU $%i,%s,temp3\n", stack[ptr].reg, rreg);
        fprintf(outfile, "\tADDU $%i,%s,$%i\n", stack[ptr].reg, lreg, stack[ptr].reg);
      FI;
      stack[ptr].storage_type = storage_regaddr;


// ##################################################################################################// #
// QUAD OF																#
// --------------------------------------------------------------------------------------------------- #
// Add the structure's offset to the field's offset									#
// ##################################################################################################// #
    ELIF quads[index].type == quad_of THEN
      mmix_loadaddr(rreg, "temp1", rptr);
      int2str(stack[ptr].reg, resreg);
      StrAppend(resreg, "$", resreg);
      mmix_addssi(resreg, rreg, stack[ptr].addr_offset);
      stack[ptr].storage_type = storage_regaddr;


// ##################################################################################################// #
// QUAD ASSIGN: code to assign symbol <rptr> to symbol <ptr>								#
// ##################################################################################################// #
    ELIF quads[index].type == tk_ASSIGN THEN mmix_store(ptr, rptr);


// ##################################################################################################// #
// QUAD ALIAS: code for aliasing symbol <lptr> to symbol <ptr>							#
// ##################################################################################################// #
    ELIF quads[index].type == quad_alias THEN mmix_alias(ptr, lptr);


// ##################################################################################################// #
// QUADS '>', '<', '=', tk_GEQ, tk_LEQ, tk_NEQ										#
// ##################################################################################################// #
    ELIF quads[index].type == ABS '>' OR quads[index].type == tk_GEQ OR
         quads[index].type == ABS '<' OR quads[index].type == tk_LEQ OR
         quads[index].type == ABS '=' OR quads[index].type == tk_NEQ
    THEN 
      IF quads[index].type == ABS '>' THEN StrAssign(opcode, "ZSP");
      ELIF quads[index].type == ABS '<' THEN StrAssign(opcode, "ZSN");
      ELIF quads[index].type == ABS '=' THEN StrAssign(opcode, "ZSZ");
      ELIF quads[index].type == tk_GEQ THEN StrAssign(opcode, "ZSNN");
      ELIF quads[index].type == tk_LEQ THEN StrAssign(opcode, "ZSNP");
      ELIF quads[index].type == tk_NEQ THEN StrAssign(opcode, "ZSNZ");
      FI;
      IF check_mode(lptr, "STRING") THEN mmix_strcmp(opcode, ptr, lptr, rptr);
      ELSE
        mmix_loadsource(lreg, "temp1", lptr);
        mmix_loadsource(rreg, "temp2", rptr);
        fprintf(outfile, "\tSUB $%i,%s,%s\n", stack[ptr].reg, lreg, rreg);
        fprintf(outfile, "\t%s $%i,$%i,1\n", opcode, stack[ptr].reg, stack[ptr].reg);
      FI;


// ##################################################################################################// #
// QUAD tk_NOT															#
// ##################################################################################################// #
    ELIF quads[index].type == tk_NOT THEN 
      mmix_loadsource(lreg, "temp1", lptr);
      fprintf(outfile, "\tNEGU $%i,1,%s\n", stack[ptr].reg, lreg);


// ##################################################################################################// #
// QUAD NEG																#
// ##################################################################################################// #
    ELIF quads[index].type == quad_neg THEN 
      mmix_loadsource(lreg, "temp1", lptr);
      fprintf(outfile, "\tNEG $%i,0,%s\n", stack[ptr].reg, lreg);


// ##################################################################################################// #
// QUAD TEST																#
// ##################################################################################################// #
    ELIF quads[index].type == quad_test THEN
      mmix_loadsource(lreg, "temp1", lptr);
      fprintf(outfile, "\tBZ %s,%s\n", lreg, stack[ptr].name);				// jump if false


// ##################################################################################################// #
// QUAD JUMP																#
// ##################################################################################################// #
    ELIF quads[index].type == quad_jump THEN 
      fprintf(outfile, "\tJMP %s\n", stack[ptr].name);


// ##################################################################################################// #
// QUAD PRINTn: code to print new line on the screen									#
// ##################################################################################################// #
    ELIF quads[index].type == quad_printn THEN 
	fprintf(outfile, "\tLDA $255,Printn\n");
      fprintf(outfile, "\tTRAP 0,Fputs,StdOut\n");


// ##################################################################################################// #
// QUAD PRINTc: code to print a character on the screen								#
// ##################################################################################################// #
    ELIF quads[index].type == quad_printc THEN 
      mmix_loadsource(resreg, "temp1", ptr);
	fprintf(outfile, "\tLDA $255,Buffer\n");
      fprintf(outfile, "\tSTBU %s,$255,0\n", resreg);
	fprintf(outfile, "\tLDA $255,BufArg\n");
      fprintf(outfile, "\tTRAP 0,Fwrite,StdOut\n");


// ##################################################################################################// #
// QUAD PRINTs: code to print a string on the screen									#
// ##################################################################################################// #
    ELIF quads[index].type == quad_prints THEN
      mmix_loadaddr(resreg, "$255", ptr);
      IF NOT StrEqual(resreg, "$255") THEN fprintf(outfile, "\tSET $255,%s\n", resreg); FI;
      fprintf(outfile, "\tTRAP 0,Fputs,StdOut\n");


// ##################################################################################################// #
// QUAD OPEN: open a file for reading											#
// --------------------------------------------------------------------------------------------------- #
// 1. Try opening file (mode is TextRead)											#
// 2. Return status														#
// ##################################################################################################// #
    ELIF quads[index].type == quad_open THEN 
      val = str2int(stack[lptr].value);
      IF val > max_files THEN error("Too many files!"); FI; 

      fprintf(outfile, "\tSETL temp2,%i\n", val - 1);			// temp2 contains file num - 1
      fprintf(outfile, "\tLDA temp1,FArg0\n");				// temp1 points to table FArgs
      fprintf(outfile, "\t16ADDU temp1,temp2,temp1\n");			// temp1 points within FArgs

      mmix_loadaddr(rreg, "temp3", rptr);
      fprintf(outfile, "\tSTOU %s,temp1,0\n", rreg);			// store the file name address

      fprintf(outfile, "\tSETL temp3,TextRead\n");
      fprintf(outfile, "\tSTO temp3,temp1,8\n");				// store the file mode

      fprintf(outfile, "\tLDA $255,temp1\n");				// $255 == file arg address
      fprintf(outfile, "\tTRAP 0,Fopen,%i\n", val + 2);		 	// open the file
      fprintf(outfile, "\tSET $%i,$255\n", stack[ptr].reg);		// return status


// ##################################################################################################// #
// QUAD ESTABLISH: open a file	for writing											#
// --------------------------------------------------------------------------------------------------- #
// 1. Try opening file (mode is TextWrite)											#
// 2. Return status														#
// ##################################################################################################// #
    ELIF quads[index].type == quad_establish THEN 
      val = str2int(stack[lptr].value);
      IF val > max_files THEN error("Too many files!"); FI; 

      fprintf(outfile, "\tSETL temp2,%i\n", val - 1);			// temp2 contains file num - 1
      fprintf(outfile, "\tLDA temp1,FArg0\n");				// temp1 points to table FArgs
      fprintf(outfile, "\t16ADDU temp1,temp2,temp1\n");			// temp1 points within FArgs

      mmix_loadaddr(rreg, "temp3", rptr);
      fprintf(outfile, "\tSTOU %s,temp1,0\n", rreg);			// store the file name address

      fprintf(outfile, "\tSETL temp3,TextWrite\n");
      fprintf(outfile, "\tSTO temp3,temp1,8\n");				// store the file mode

      fprintf(outfile, "\tLDA $255,temp1\n");				// $255 == file arg address
      fprintf(outfile, "\tTRAP 0,Fopen,%i\n", val + 2);		 	// open the file
      fprintf(outfile, "\tSET $%i,$255\n", stack[ptr].reg);		// return status


// ##################################################################################################// #
// QUAD CLOSE: close a file													#
// ##################################################################################################// #
    ELIF quads[index].type == quad_close THEN 
      val = str2int(stack[lptr].value);
      fprintf(outfile, "\tTRAP 0,Fclose,%i\n", val + 2);				// close the file
      fprintf(outfile, "\tSET $%i,$255\n", stack[ptr].reg);


// ##################################################################################################// #
// QUAD READC: read a character from a file										#
// ##################################################################################################// #
    ELIF quads[index].type == quad_readc THEN 
      val = str2int(stack[lptr].value);
      fprintf(outfile, "\tSETL temp1,%i\n", val - 1);				// get offset
      fprintf(outfile, "\tLDA temp2,FArg1\n");					// point to FArg1
      fprintf(outfile, "\t16ADDU temp2,temp1,temp2\n");				// point to FArg1 + offset
      fprintf(outfile, "\tSET $255,temp2\n");
      fprintf(outfile, "\tTRAP 0,Fread,%i\n", val + 2);				// read
      fprintf(outfile, "\tLDA temp3,FBuffer\n");					// point to FBuffer
      fprintf(outfile, "\tLDBU $%i,temp3,temp1\n", stack[ptr].reg);	// write it to result
      fprintf(outfile, "\tCSN $%i,$255,0\n", stack[ptr].reg);		// if end of file, set to zero
      stack[ptr].storage_type = storage_register;


// ##################################################################################################// #
// QUAD READCHAR: read a character from standard input									#
// ##################################################################################################// #
    ELIF quads[index].type == quad_readchar THEN 
	fprintf(outfile, "\tLDA $255,BufArg\n");
      fprintf(outfile, "\tTRAP 0,Fread,StdIn\n");					// read from standard input
      fprintf(outfile, "\tLDA temp1,Buffer\n");					// point to Buffer
      fprintf(outfile, "\tLDBU $%i,temp1,0\n", stack[ptr].reg);		// write it to result
      stack[ptr].storage_type = storage_register;


// ##################################################################################################// #
// QUAD ARG																#
// --------------------------------------------------------------------------------------------------- #
// - Composite objects: copy arguments to memory if passed by value						#
// - Primitive objects: copy arguments to registers									#
// ##################################################################################################// #
    ELIF quads[index].type == quad_arg THEN 
      IF stack[ptr].id == 0 THEN reset_args; FI;
      IF is_mode_ref(ptr) THEN							// ALL REFs are handled here!
        stack[ptr].reg = get_arg_reg;
        mmix_loadaddr(lreg, "temp1", lptr); 
        fprintf(outfile, "\tSET $%i,%s\n", stack[ptr].reg, lreg);

      ELIF is_mode_composite(ptr) THEN						// composite non-REFs
        IF code_refs THEN 
          stack[ptr].reg = get_arg_reg;					// CAUTION: pass arg by reference!
          mmix_loadaddr(lreg, "temp1", lptr); 
          fprintf(outfile, "\tSET $%i,%s\n", stack[ptr].reg, lreg);
        ELSE										// pass by value (make copy)
          stack[ptr].reg = get_arg_reg;
          IF is_mode_array(ptr) THEN						// variable size arguments
            fprintf(outfile, "\tSET $%i,sp\n", stack[ptr].reg);		
            // TRICK: adjust address (array convention)
            fprintf(outfile, "\tADD $%i,$%i,8\n", stack[ptr].reg, stack[ptr].reg);
            mmix_loadaddr(lreg, "temp1", lptr);					// <lptr> address into temp1
            fprintf(outfile, "\tSUB temp1,temp1,8\n");
            fprintf(outfile, "\tLDT temp1,temp1,0\n");					// load array size (in octets)
            fprintf(outfile, "\tSL temp1,temp1,3\n");					// convert to number of bytes
            fprintf(outfile, "\tADD sp,sp,temp1\n");					// update stack pointer
            mmix_memcopy(lptr, ptr);
          ELSE										// fixed-size arguments
            mmix_memcopy(lptr, ptr);
            mmix_loadaddr(resreg, "temp1", ptr); 
            fprintf(outfile, "\tSET $%i,%s\n", stack[ptr].reg, resreg);
          FI;
        FI;

      ELSE											// primitive non-REFs
        stack[ptr].reg = get_arg_reg;
        IF stack[ptr].reg != stack[lptr].reg THEN 
          mmix_loadsource(lreg, "temp1", lptr);
          fprintf(outfile, "\tSET $%i,%s\n", stack[ptr].reg, lreg);
        ELSE
          fprintf(outfile, "\tSET temp1,temp1\n");						// trick to avoid dangling labels
        FI;
      FI;


// ##################################################################################################// #
// QUAD ARGREF															#
// --------------------------------------------------------------------------------------------------- #
// - Composite objects: copy pointer to stack										#
// - Primitive objects: copy value to stack										#
// ##################################################################################################// #
    ELIF quads[index].type == quad_argref THEN 
      IF is_mode_composite(lptr) THEN
        mmix_loadaddr(lreg, "temp1", lptr);
        fprintf(outfile, "\tSTOU %s,sp,%i\n", lreg, ptr - 8);			// direct use of ptr (weird one!)
      ELSE
        mmix_loadsource(lreg, "temp1", lptr);
        fprintf(outfile, "\tSTOU %s,sp,%i\n", lreg, ptr - 8);			// direct use of ptr (weird one!)
      FI;


// ##################################################################################################// #
// QUAD ARGSIZE															#
// ##################################################################################################// #
    ELIF quads[index].type == quad_argsize THEN 
      fprintf(outfile, "\tSET temp1,%i\n", ptr + 8);				// load arguments' total size
      fprintf(outfile, "\tSTOU temp1,sp,%i\n", ptr);				// store it!
      fprintf(outfile, "\tADD sp,sp,%i\n", ptr + 8);				// update stack pointer


// ##################################################################################################// #
// QUAD ALLOC: allocate memory for arrays/structures									#
// --------------------------------------------------------------------------------------------------- #
// Arrays: initialize the 8-byte size header (size + upper bound)							#
// ##################################################################################################// #
    ELIF quads[index].type == quad_alloc THEN
// size in octets (1 tetra)
      mmix_sets("temp1", (stack[ptr].mode_size)/8);
      mmix_sets("temp2", stack[ptr].addr_offset - 8);
      fprintf(outfile, "\tSTT temp1,fp,temp2\n");
// upper bound (1 tetra)
      mmix_sets("temp1", calc_mode_items(stack[ptr].mode));
      mmix_sets("temp2", stack[ptr].addr_offset - 4);
      fprintf(outfile, "\tSTT temp1,fp,temp2\n");


// ##################################################################################################// #
// QUAD PROC																#
// --------------------------------------------------------------------------------------------------- #
// 1. print procedure label													#
// 2. store return jump address into reserved <retaddr_reg>								#
// 3. store global display register of appropriate nesting into reserved <display_reg>			#
// 4. store old frame pointer <fp> into reserved <frameptr_reg>							#
// 5. set new frame pointer <fp> to old stack pointer <sp>								#
// 6. set new stack pointer <sp> to point right after fixed-size data area					#
// 7. set global display register to new frame pointer <fp>								#
// ##################################################################################################// #
    ELIF quads[index].type == quad_proc THEN 
// OPTIMIZE: remove retreg if there is no recursive call!
      IF current_nesting != stack[ptr].nesting THEN error("Unexpected nesting disgreement!") FI;
      proc_info = stack[ptr].proc_info;
      fprintf(outfile, "\n%s", table_proc_info[proc_info].label);
      fprintf(outfile, "\tGET $%i,rJ\n", stack_frame.retaddr_reg);
      fprintf(outfile, "\tSET $%i,disp%i\n", stack_frame.display_reg, current_nesting);
      fprintf(outfile, "\tSET $%i,fp\n", stack_frame.frameptr_reg);
      fprintf(outfile, "\tSET fp,sp\n");
      mmix_addssi("sp", "sp", stack_frame.localvar_size);
      fprintf(outfile, "\tSET disp%i,fp\n", current_nesting);

// CAUTION: remove later, it initializes stack frame to a series of dot characters
//      fprintf(outfile, "\tSET temp2,'.'\n");
//      fprintf(outfile, "\tSET temp1,fp\n");
//      mmix_sets("temp3", stack_frame.localvar_size);
//      fprintf(outfile, "1H\tSTB temp2,temp1,0\n");
//      fprintf(outfile, "\tADD temp1,temp1,1\n");
//      fprintf(outfile, "\tSUB temp3,temp3,1\n");
//      fprintf(outfile, "\tBNZ temp3,1B\n");


// ##################################################################################################// #
// QUAD RET																#
// --------------------------------------------------------------------------------------------------- #
// 1. restore old stack pointer <sp>												#
// 2. restore old frame pointer <fp>												#
// 3. restore global display register <disp#>										#
// 4. restore return jump register <rJ>											#
// 5. put return value address into register <$0>, if applicable							#
// 6. return to caller 														#
// ##################################################################################################// #
    ELIF quads[index].type == quad_ret THEN 
      IF NOT is_mode_void(ptr) THEN
        IF stack[ptr].storage_type == storage_register THEN 
          fprintf(outfile, "\tSET $0,$%i\n", stack[ptr].reg);
        ELIF stack[ptr].storage_type == storage_stackframe THEN 
          IF is_mode_composite(ptr) THEN 
            mmix_loadaddr(lreg, "$0", ptr);					// CAUTION: $0 should be enforced
          ELSE
            mmix_loadsource(lreg, "$0", ptr); 					// CAUTION: $0 should be enforced
          FI;
        ELIF stack[ptr].storage_type == storage_regaddr THEN 
          mmix_loadaddr(lreg, "$0", ptr);						// CAUTION: $0 should be enforced
          fprintf(outfile, "\tSET $0,$%i\n", lreg);
        ELSE
          error("Generate code: unhandled storage type for return value!");
        FI;
        fprintf(outfile, "\tSET sp,fp\n");
        fprintf(outfile, "\tSET fp,$%i\n", stack_frame.frameptr_reg);
        fprintf(outfile, "\tSET disp%i,$%i\n", current_nesting, stack_frame.display_reg);
        fprintf(outfile, "\tPUT rJ,$%i\n", stack_frame.retaddr_reg);
        fprintf(outfile, "\tPOP 1,0\n");
      ELSE
        fprintf(outfile, "\tSET sp,fp\n");
        fprintf(outfile, "\tSET fp,$%i\n", stack_frame.frameptr_reg);
        fprintf(outfile, "\tSET disp%i,$%i\n", current_nesting, stack_frame.display_reg);
        fprintf(outfile, "\tPUT rJ,$%i\n", stack_frame.retaddr_reg);
        fprintf(outfile, "\tPOP 0,0\n");
      FI;


// ##################################################################################################// #
// QUAD CALL																#
// --------------------------------------------------------------------------------------------------- #
// 1. call the function														#
// 2. copy the return value, if applicable								 			#
// ##################################################################################################// #
    ELIF quads[index].type == quad_call THEN 
      proc_info = stack[lptr].proc_info;
      fprintf(outfile, "\tPUSHJ $%i,%s\n", get_last_reg, table_proc_info[proc_info].label);
      IF NOT is_mode_void(ptr) THEN
        IF is_mode_composite(ptr) OR is_mode_ref(ptr) THEN 
          fprintf(outfile, "\tSET $%i,$%i\n", stack[ptr].reg, get_last_reg);
          stack[ptr].storage_type = storage_regaddr;
// ELIF stack[ptr].storage_type == storage_stackframe THEN 
// mmix_retcopy(ptr, get_last_reg);
        ELSE
          IF stack[ptr].type != entity_argvar THEN 
            fprintf(outfile, "\tSET $%i,$%i\n", stack[ptr].reg, get_last_reg);
          ELSE
            error("Dear parser, you should not assign a returned value directly to an argument!");
          FI;
        FI;
      FI;


// ##################################################################################################// #
// QUAD MAIN																#
// --------------------------------------------------------------------------------------------------- #
// 1. Set the global display to the initial stack pointer <sp>							#
// 2. Set the frame pointer <fp> to the initial stack pointer <sp>							#
// 3. Increase <sp> by the size of the space used local variables							#
// ##################################################################################################// #
    ELIF quads[index].type == quad_main THEN 
      fprintf(outfile, "Main\tLDA sp,STACK\n");
      mmix_addssi("fp", "sp", stack_frame.param_size);
      fprintf(outfile, "\tSET disp1,fp\n");
      mmix_sets("temp1", stack_frame.param_size + stack_frame.localvar_size);
      fprintf(outfile, "\tADD sp,sp,temp1\n");

      ptr = flookup("argc");								// save $0 to argc
      mmix_fix8c("ST", get_storage_code(ptr), "$0", "fp", stack[ptr].addr_offset); 

      ptr = flookup("argv");								// save contents of $1 to argv[]
      mmix_sets("temp2", stack[ptr].addr_offset);				// temp2: pointer to target
      fprintf(outfile, "1H\tSETL temp3,%i\n", string_size); 				// temp3: size
      fprintf(outfile, "\tLDOU temp4,$1,0\n");						// temp4: pointer to source
      fprintf(outfile, "2H\tLDOU temp1,temp4,0\n");					// temp1: octa to be copied
      fprintf(outfile, "\tSTOU temp1,fp,temp2\n");
      fprintf(outfile, "\tADD temp4,temp4,8\n");
      fprintf(outfile, "\tADD temp2,temp2,8\n");
      fprintf(outfile, "\tSUB temp3,temp3,8\n");
      fprintf(outfile, "\tPBNZ temp3,2B\n\n");						// done with current argument?
      fprintf(outfile, "\tADD $1,$1,8\n");
      fprintf(outfile, "\tSUB $0,$0,1\n");							// one argument less
      fprintf(outfile, "\tPBNZ $0,1B\n\n");


// CAUTION: remove later, it initializes stack frame to a series of dot characters
//      fprintf(outfile, "\tSET temp2,'.'\n");
//      fprintf(outfile, "\tSET temp1,fp\n");
//      mmix_sets("temp3", stack_frame.localvar_size);
//      fprintf(outfile, "1H\tSTB temp2,temp1,0\n");
//      fprintf(outfile, "\tADD temp1,temp1,1\n");
//      fprintf(outfile, "\tSUB temp3,temp3,1\n");
//      fprintf(outfile, "\tBNZ temp3,1B\n");


// ##################################################################################################// #
// QUAD HALT - End of program													#
// ##################################################################################################// #
    ELIF quads[index].type == quad_halt THEN 
      fprintf(outfile, "\tTRAP 0,Halt,0\n");


// ##################################################################################################// #
// QUAD DUMP - Dump raw stack frame data											#
// ##################################################################################################// #
    ELIF quads[index].type == quad_dump THEN 
	fprintf(outfile, "\tLDA $255,Frame\n");
      fprintf(outfile, "\tSTO fp,$255,0\n");
      mmix_sets("temp1", stack_frame.localvar_size);
      fprintf(outfile, "\tSTO temp1,$255,8\n");
      fprintf(outfile, "\tTRAP 0,Fwrite,StdOut\n");
	fprintf(outfile, "\tLDA $255,Printn\n");
      fprintf(outfile, "\tTRAP 0,Fputs,StdOut\n");


// ##################################################################################################// #
// QUAD LABEL - Print it out!													#
// ##################################################################################################// #
    ELIF quads[index].type == quad_label THEN 
      fprintf(outfile, "%s", stack[ptr].name);

    ELSE
      printf("%i: * other instruction %s\n", index, stack[ptr].name);
    FI;
    printf("%i:", index);
    index = index + 1;
  OD;
  quad_index = quadptr;
  return;
END;









#ifndef dump_stack
#define dump_stack dump_stack()
#endif
VOID dump_stack
BEGIN
  INT line = 0;
  INT proc_info;
  INT index = stack_index - 1;
  WHILE index >= 1 
  DO
    line = line + 1;
    IF line > 23 THEN line = 0; printf("More..."); readchar; FI;

// Frame -----------------------------------------------------------------------------------------------
    IF stack[index].type == entity_frame THEN 
      printf("%i: START FRAME (nesting %i)\n", index, stack[index].nesting);

// Start scope -----------------------------------------------------------------------------------------
    ELIF stack[index].type == entity_startscope THEN 
      printf("%i: START SCOPE _%s_\n", index, stack[index].name);

// End scope -------------------------------------------------------------------------------------------
    ELIF stack[index].type == entity_endscope THEN 
      printf("%i: END SCOPE _%s_\n", index, stack[index].name);

// Variable --------------------------------------------------------------------------------------------
    ELIF stack[index].type == entity_var THEN 
      printf("%i: variable '%s' of mode %s and size %i\n", index, stack[index].name, stack[index].mode, stack[index].mode_size);

// Pointer --------------------------------------------------------------------------------------------
    ELIF stack[index].type == entity_ptrvar THEN 
      printf("%i: pointer '%s' of mode %s and size %i\n", index, stack[index].name, stack[index].mode, stack[index].mode_size);

// Parameter -------------------------------------------------------------------------------------------
    ELIF stack[index].type == entity_param THEN 
      printf("%i: parameter '%s' of mode %s and size %i\n", index, stack[index].name, stack[index].mode, stack[index].mode_size);

// Temporary -------------------------------------------------------------------------------------------
    ELIF stack[index].type == entity_tempvar THEN 
      printf("%i: temporary '%s' of mode %s and size %i\n", index, stack[index].name, stack[index].mode, stack[index].mode_size);

// Argument --------------------------------------------------------------------------------------------
    ELIF stack[index].type == entity_argvar THEN 
      printf("%i: argument '%s' of mode %s and size %i\n", index, stack[index].name, stack[index].mode, stack[index].mode_size);

// Label -----------------------------------------------------------------------------------------------
    ELIF stack[index].type == entity_label THEN 
      printf("%i: label '%s'\n", index, stack[index].name);

// Procedure -------------------------------------------------------------------------------------------
    ELIF stack[index].type == entity_proc THEN 
      proc_info = stack[index].proc_info;
      printf("%i: procedure '%s' of label %s and mode %s\n", index, stack[index].name, table_proc_info[proc_info].label, stack[index].mode);

// Mode ------------------------------------------------------------------------------------------------
    ELIF stack[index].type == entity_mode THEN 
      printf("%i: mode '%s' is %s\n", index, stack[index].name, stack[index].mode);

// Constant --------------------------------------------------------------------------------------------
    ELIF stack[index].type == entity_constant THEN 
      printf("%i: constant '%s' OF mode %s\n", index, stack[index].name, stack[index].mode);

    ELSE
      printf("%i: other\n", index);
      error("Unknown symbol table entry!");
    FI;
    index = index - 1;
  OD;
  return;
END;


#ifndef dump_frame
#define dump_frame dump_frame()
#endif
VOID dump_frame
BEGIN
  STRING table_storage[4];
  INT offset;
  INT storage_type;
  INT line = 2;
  INT index = stack_index - 1;

  StrAssign(table_storage[0], "con");
  StrAssign(table_storage[1], "reg");
  StrAssign(table_storage[2], "mem");
  StrAssign(table_storage[3], "ptr");

  WHILE stack[index].type != entity_frame DO index = index - 1 OD;
  printf("ID                        STO   SIZE      OFFSET   REG NEST MODE            \n");
  printf("----------------------------------------------------------------------------\n");
  WHILE index < stack_index
  DO
    IF stack[index].type == entity_var OREL
       stack[index].type == entity_tempvar OREL
       stack[index].type == entity_ptrvar OREL
       stack[index].type == entity_argvar OREL
       stack[index].type == entity_param
    THEN 
      line = line + 1;
      IF line > 20 THEN line = 0; printf("More..."); readchar; FI;
      storage_type = stack[index].storage_type;
      IF stack[index].type == entity_param ANDTH is_mode_composite(index) THEN 
        offset = stack[index].addr_offset - stack_frame.param_size; 
      ELSE
        offset = stack[index].addr_offset; 
      FI;
      printf("%-20s(%3i) %-3s %8i %10i $%3i %4i %s\n", stack[index].name, index, table_storage[storage_type], stack[index].mode_size, offset, stack[index].reg, stack[index].nesting, stack[index].mode);
    FI;
    index = index + 1;
  OD;
  printf("----------------------------------------------------------------------------\n");
  printf("FRAME SIZE == %i\n", stack_frame.localvar_size);
  printf("----------------------------------------------------------------------------\n");
  return;
END;


#ifndef dump_procedures
#define dump_procedures dump_procedures()
#endif
VOID dump_procedures
BEGIN
  INT line = 0;
  INT index = 0;
  printf("LABEL      QUADPTR MAXTEMP DONE           \n");
  printf("--------------------------------------------\n");
  WHILE index <= proc_info_index
  DO
    line = line + 1;
    IF line > 20 THEN line = 0; printf("More..."); readchar; FI;
    printf("%-10s %6i %7i %4i\n", table_proc_info[index].label, table_proc_info[index].quadptr, table_proc_info[index].max_temp, table_proc_info[index].done);
    index = index + 1;
  OD;
  return;
END;


#ifndef dump_quads
#define dump_quads dump_quads()
#endif
VOID dump_quads
BEGIN
  INT resptr, lptr, rptr;
  INT proc_info;
  INT line = 0;
  INT index = 0;
  WHILE index < quad_index 
  DO
    line = line + 1;
    IF line > 23 THEN line = 0; printf("More..."); readchar; FI;
    resptr = quads[index].result;
    lptr = quads[index].left;
    rptr = quads[index].right;
    printf("%i: ", index);
    IF quads[index].type == tk_ASSIGN THEN 
      printf("ASSIGN %s (%i) = %s (%i)\n", stack[resptr].name, resptr, stack[rptr].name, rptr);
    ELIF quads[index].type == quad_alias THEN 
      printf("ALIAS %s (%i) -> %s (%i)\n", stack[lptr].name, lptr, stack[resptr].name, resptr);
    ELIF quads[index].type == quad_main THEN 
      printf("MAIN\n");
    ELIF quads[index].type == quad_halt THEN 
      printf("HALT\n");
    ELIF quads[index].type == quad_dump THEN 
      printf("DUMPFRAME\n");
    ELIF quads[index].type == ABS '=' THEN 
      printf("EQUAL %s (%i) == %s (%i) -> %s (%i)\n", stack[lptr].name, lptr, stack[rptr].name, rptr, stack[resptr].name, resptr);
    ELIF quads[index].type == ABS '>' THEN 
      printf("GREATER %s (%i) > %s (%i) -> %s (%i)\n", stack[lptr].name, lptr, stack[rptr].name, rptr, stack[resptr].name, resptr);
    ELIF quads[index].type == ABS '<' THEN 
      printf("LESS %s (%i) > %s (%i) -> %s (%i)\n", stack[lptr].name, lptr, stack[rptr].name, rptr, stack[resptr].name, resptr);
    ELIF quads[index].type == tk_GEQ THEN 
      printf("GEQ %s (%i) >= %s (%i) -> %s (%i)\n", stack[lptr].name, lptr, stack[rptr].name, rptr, stack[resptr].name, resptr);
    ELIF quads[index].type == tk_LEQ THEN 
      printf("LEQ %s (%i) <= %s (%i) -> %s (%i)\n", stack[lptr].name, lptr, stack[rptr].name, rptr, stack[resptr].name, resptr);
    ELIF quads[index].type == tk_NEQ THEN 
      printf("NEQ %s (%i) != %s (%i) -> %s (%i)\n", stack[lptr].name, lptr, stack[rptr].name, rptr, stack[resptr].name, resptr);
    ELIF quads[index].type == tk_NOT THEN 
      printf("NOT %s (%i) -> %s (%i)\n", stack[lptr].name, lptr, stack[resptr].name, resptr);
    ELIF quads[index].type == quad_neg THEN 
      printf("NEG -%s (%i) -> %s (%i)\n", stack[lptr].name, lptr, stack[resptr].name, resptr);
    ELIF quads[index].type == ABS '+' THEN 
      printf("PLUS %s (%i) = %s (%i) + %s (%i)\n", stack[resptr].name, resptr, stack[lptr].name, lptr, stack[rptr].name, rptr);
    ELIF quads[index].type == ABS '-' THEN 
      printf("MINUS %s (%i) = %s (%i) - %s (%i)\n", stack[resptr].name, resptr, stack[lptr].name, lptr, stack[rptr].name, rptr);
    ELIF quads[index].type == ABS '*' THEN 
      printf("MULT %s (%i) = %s (%i) * %s (%i)\n", stack[resptr].name, resptr, stack[lptr].name, lptr, stack[rptr].name, rptr);
    ELIF quads[index].type == ABS '/' THEN 
      printf("DIV %s (%i) = %s (%i) / %s (%i)\n", stack[resptr].name, resptr, stack[lptr].name, lptr, stack[rptr].name, rptr);
    ELIF quads[index].type == tk_OREL THEN 
      printf("OREL %s (%i) = %s (%i) || %s (%i)\n", stack[resptr].name, resptr, stack[lptr].name, lptr, stack[rptr].name, rptr);
    ELIF quads[index].type == tk_ANDTH THEN 
      printf("ANDTH %s (%i) = %s (%i) && %s (%i)\n", stack[resptr].name, resptr, stack[lptr].name, lptr, stack[rptr].name, rptr);
    ELIF quads[index].type == quad_subscript THEN 
      printf("SUBSCRIPT %s[%s] -> %s (%i)\n", stack[lptr].name, stack[rptr].name, stack[resptr].name, resptr);
    ELIF quads[index].type == quad_of THEN 
      printf("OF %s (%i) OF %s (%i) -> %s (%i)\n", stack[resptr].name, resptr, stack[rptr].name, rptr, stack[resptr].name, resptr);
    ELIF quads[index].type == quad_jump THEN 
      printf("JUMP %s\n", stack[resptr].name);
    ELIF quads[index].type == quad_test THEN 
      printf("TEST %s (%i) -> %s\n", stack[lptr].name, lptr, stack[resptr].name)
    ELIF quads[index].type == quad_label THEN 
      printf("LABEL %s\n", stack[resptr].name);
    ELIF quads[index].type == quad_printc THEN 
      printf("PRINTc %s (%i)\n", stack[resptr].name, resptr);
    ELIF quads[index].type == quad_printn THEN 
      printf("PRINTn\n");
    ELIF quads[index].type == quad_prints THEN 
      printf("PRINTs %s (%i)\n", stack[resptr].name, resptr);
    ELIF quads[index].type == quad_printi THEN 
      printf("PRINTi %s (%i)\n", stack[resptr].name, resptr);
    ELIF quads[index].type == quad_open THEN 
      printf("OPEN %s, %s (%i) -> %s (%i)\n", stack[lptr].name, stack[rptr].name, rptr, stack[resptr].name, resptr);
    ELIF quads[index].type == quad_close THEN 
      printf("CLOSE %s\n", stack[lptr].name);
    ELIF quads[index].type == quad_readc THEN 
      printf("READC %s -> %s (%i)\n", stack[lptr].name, stack[resptr].name, resptr);
    ELIF quads[index].type == quad_readchar THEN 
      printf("READCHAR -> %s (%i)\n", stack[resptr].name, resptr);
    ELIF quads[index].type == quad_ret THEN 
      printf("RET value %s (%i)\n", stack[resptr].name, resptr);
    ELIF quads[index].type == quad_upb THEN 
      printf("UPB %s (%i) -> %s (%i)\n", stack[lptr].name, lptr, stack[resptr].name, resptr);
    ELIF quads[index].type == quad_arg THEN 
      printf("ARG %s (%i) of mode %s -> &%i\n", stack[lptr].name, lptr, stack[lptr].mode, stack[resptr].id);
    ELIF quads[index].type == quad_argref THEN 
      printf("ARGREF %s (%i) of mode %s and offset %i\n", stack[lptr].name, lptr, stack[lptr].mode, resptr - 8);
    ELIF quads[index].type == quad_argsize THEN 
      printf("ARGSIZE size is %i\n", resptr + 8);
    ELIF quads[index].type == quad_call THEN 
      printf("CALL procedure %s of mode %s -> %s (%i)\n", stack[lptr].name, stack[lptr].mode, stack[resptr].name, resptr)
    ELIF quads[index].type == quad_proc THEN 
      proc_info = stack[resptr].proc_info;
      printf("PROC %s of mode %s with label %s\n", stack[resptr].name, stack[resptr].mode, table_proc_info[proc_info].label);
    ELIF quads[index].type == quad_endproc THEN 
      printf("ENDPROC %s\n", stack[resptr].name);
    ELSE
      printf("UNKNOWN\n", index);
    FI;
    index = index + 1;
  OD;
  return;
END;


#ifndef debugger
#define debugger debugger()
#endif
VOID debugger
BEGIN
  CHAR cmd = REPR 0;
  BOOL flag = debug_stop;

  debug_stop = TRUE;
  printf("\n");
  WHILE cmd != 'r' ANDTH cmd != 's' ANDTH cmd != 'x'
  DO
    printf("> ");
    cmd = readchar;
    readchar;
    IF cmd == 't' THEN printf("Current token is (%s,%s).\n", token.str, token.descr);
    ELIF cmd == 'r' THEN debug_stepwise = FALSE; debug_expr = FALSE; debug_stop = flag;
    ELIF cmd == 's' THEN debug_stepwise = TRUE; debug_expr = FALSE;
    ELIF cmd == 'x' THEN debug_stepwise = FALSE; debug_expr = TRUE;
    ELIF cmd == 'd' THEN dump_stack;
    ELIF cmd == 'i' THEN dump_quads;
    ELIF cmd == 'f' THEN dump_frame;
    ELIF cmd == 'p' THEN dump_procedures;
    ELIF cmd == 'q' THEN error("Quit!");
    ELSE
      printf("\n");
      printf("-----------------\n");
      printf(" Command summary \n");
      printf("-----------------\n\n");
      printf("r - continue running the parser\n");
      printf("s - run the parser in stepwise mode\n");
      printf("x - run the parser expression by expression (in series)\n");
      printf("t - print current token\n");
      printf("d - stack dump\n");
      printf("i - show generated intermediate code\n");
      printf("f - dump stack frame\n");
      printf("p - dump procedure info\n");
      printf("q - quit the parser\n");
      printf("\n");
    FI;
  OD;
  printf("\n");
  return;
END;










/*
INT set_of_tokens[28];
set_of_tokens[0] = tk_ELIF;
set_of_tokens[1] = tk_ELSE;
set_of_tokens[2] = tk_FI;
set_of_tokens[3] = 0;
set_of_tokens[4] = ABS '*';
set_of_tokens[5] = ABS '/';
set_of_tokens[6] = ABS '+';
set_of_tokens[7] = ABS '-';
set_of_tokens[8] = tk_POWER;
set_of_tokens[9] = tk_MOD;
set_of_tokens[10] = 0;
set_of_tokens[11] = tk_OR;
set_of_tokens[12] = tk_OR;
set_of_tokens[13] = tk_AND;
set_of_tokens[14] = tk_AND;
set_of_tokens[15] = 0;
set_of_tokens[16] = ABS '=';
set_of_tokens[17] = tk_NEQ;
set_of_tokens[18] = ABS '<';
set_of_tokens[19] = ABS '>';
set_of_tokens[20] = tk_LEQ;
set_of_tokens[21] = tk_GEQ;
set_of_tokens[22] = 0;
set_of_tokens[23] = tk_AMODE;
set_of_tokens[24] = tk_REF;
set_of_tokens[25] = ABS '[';
set_of_tokens[26] = tk_STRUCT;
set_of_tokens[27] = 0;
*/


int set_of_tokens[28] = 
{tk_ELIF, tk_ELSE, tk_FI, 0, '*', '/', '+', '-', tk_POWER, tk_MOD, 0,
tk_OR, tk_OR, tk_AND, tk_AND, 0, '=',tk_NEQ,'<','>',tk_LEQ, tk_GEQ, 0, 
tk_AMODE, tk_REF, '[', tk_STRUCT, 0};


#define set_threshold  2000
#define set_elif_else_fi  2000
#define set_arithm_operators  2004
#define set_bool_operators  2011
#define set_rel_operators  2016
#define set_first_amode  2023



// Return operator's priority

INT priority(INT token_id)
BEGIN
  INT pr;

  IF token_id == tk_ASSIGN THEN pr = 10;
  ELIF token_id == tk_OR THEN pr = 20;
  ELIF token_id == tk_OR THEN pr = 20;
  ELIF token_id == tk_AND THEN pr = 30;
  ELIF token_id == tk_AND THEN pr = 30;
  ELIF token_id == ABS '+' THEN pr = 40;
  ELIF token_id == ABS '-' THEN pr = 40;
  ELIF token_id == ABS '*' THEN pr = 50;
  ELIF token_id == ABS '/' THEN pr = 50;
  ELIF token_id == tk_MOD THEN pr = 50;
  ELIF token_id == tk_POWER THEN pr = 60;
  ELSE pr = 0;
  FI;
  return (pr);
END;



BOOL check_token(INT tokenId)
BEGIN
  IF token.used THEN GetNextToken FI;
  return (token.id == tokenId);
END;


BOOL check_tokenset(INT set_index)
BEGIN
  BOOL result;
  INT i;
  IF set_index < set_threshold THEN 
    result = check_token(set_index);
  ELSE
    i = set_index - set_threshold;
    WHILE set_of_tokens[i] != 0 AND NOT check_token(set_of_tokens[i]) DO i = i + 1; OD;
    result = set_of_tokens[i] != 0;
  FI;
  return (result);
END;


BOOL accept_token(INT tokenId)
BEGIN
  BOOL result;

  IF token.used THEN GetNextToken FI;
  IF token.id == tokenId THEN
    printf(" %s ", token.str);
    token.used = TRUE;
    result = TRUE
  ELSE
    error("wrong token");
    result = FALSE
  FI;
  return (result);
END;


INT power(INT x, INT yy)
BEGIN
  INT z = 1;
  INT y = yy;
  WHILE y > 0
  DO
    z = z * x;
    y = y - 1
  OD;
  return (z);
END;


INT calc(INT op, INT lval, INT rval)
BEGIN
  INT result;

  IF op == ABS '+' THEN result = lval + rval;
  ELIF op == ABS '-' THEN result = lval + rval; 
  ELIF op == ABS '*' THEN result = lval * rval;
  ELIF op == ABS '/' THEN result = lval / rval; 
  ELIF op == tk_POWER THEN result = power(lval, rval);
  ELIF op == ABS '=' THEN 
    IF lval == rval THEN result = 1; ELSE result == 0; FI;
  ELIF op == ABS '>' THEN
    IF lval > rval THEN result = 1; ELSE result == 0; FI;
  ELIF op == ABS '<' THEN 
    IF lval < rval THEN result = 1; ELSE result == 0; FI;
  ELIF op == tk_NEQ THEN 
    IF lval != rval THEN result = 1; ELSE result == 0; FI;
  ELIF op == tk_GEQ THEN 
    IF lval >= rval THEN result = 1; ELSE result == 0; FI;
  ELIF op == tk_LEQ THEN 
    IF lval <= rval THEN result = 1; ELSE result == 0; FI;
  ELSE result = rval; 
  FI;
//  IF debug_echo THEN printf("[%i%c%i=%i]", lval, op, rval, result); FI;
  return (result);
END;


// ####################################################################################// #
// FORWARD DECLARATIONS											    #
// ####################################################################################// #
INT unify_modes(INT rule, INT target, INT source);
INT parse_expression(INT result);
VOID parse_amode(REF STRING mode);
INT parse_expr_factor(INT result);


// ####################################################################################// #
// COERCIONS													    #
// ------------------------------------------------------------------------------------- #
// <context>		- the coercion's context							    #
// <symbol>		- the symbol table entry to be coerced					    #
// <mode>		- the mode to which the symbol will be coerced				    #
// <lmode>		- the symbol's final coerced mode						    #
// ------------------------------------------------------------------------------------- #
// voiding:		AMODE => VOID									    #
// dereferencing:	(REF)+ AMODE => AMODE								    #
// rowing:		AMODE => []AMODE									    #
// ####################################################################################// #
INT coerce(INT context, INT symbol, STRING mode, REF STRING lmode)
BEGIN
  STRING rmode, tmode;
  INT i, j;
  INT item, subscript, newsymbol = symbol;

// printf("Coercing %s to %s...\n", stack[symbol].mode, mode);

// CAUTION: remove this?
  IF StrEqual(stack[symbol].mode, "?") THEN
    StrAssign(stack[symbol].mode, mode); 

  ELSE
    StrAssign(lmode, "");
    StrAssign(tmode, mode);
    StrAssign(rmode, stack[symbol].mode);
    WHILE StrLen(tmode) > 0
    DO
//      printf("Unify(%s,%s,%s) -> ", lmode, rmode, tmode);
      unify(lmode, rmode, tmode);
//      printf("(%s,%s,%s)\n", lmode, rmode, tmode);
      IF StrLen(tmode) > 0 THEN
        IF StrEqual(tmode, "VOID") AND context == context_strong THEN 
          // printf("Voiding...\n");
          StrAssign(rmode, "VOID");								// voiding
          StrAssign(stack[symbol].mode, "VOID");
        ELIF IsPrefix(rmode, "REF") THEN 
          // printf("Dereferencing...\n");
          StrTail(rmode, rmode, 4);								// dereferencing
        ELIF IsPrefix(tmode, "[") AND context == context_strong THEN 
          // printf("Rowing...\n");
          StrAppend(rmode, "[1] ", rmode);						// rowing
          newsymbol = new_tempvar(rmode);
          subscript = new_const("0", "INT");
          item = new_tempvar("?");
          unify_modes(rule_itemize, item, newsymbol);
          generate_quad(quad_alloc, newsymbol, 0, 0);
          generate_quad(quad_subscript, item, newsymbol, subscript);
          generate_quad(tk_ASSIGN, item, 0, symbol);
        ELSE
          printf("%s cannot be coerced to %s!", stack[symbol].mode, mode);
          error("");
        FI;
      FI;
    OD;
    i = StrLen(lmode) - 1;
    IF lmode[i] == ' ' THEN lmode[i] = REPR 0; FI;
  FI;
  return (newsymbol);
END;


// ####################################################################################// #
// UNIFY MODES												    #
// ------------------------------------------------------------------------------------- #
// <rule>		- the unification rule (<identity>, <assign>, or <itemize>)		    #
// <target>		- the target symbol table entry						    #
// <mode>		- the target symbol table entry						    #
// ------------------------------------------------------------------------------------- #
// assign:		REF AMODE = AMODE								    #
// identity:		AMODE == AMODE									    #
// itemize:		[]AMODE => AMODE									    #
// ####################################################################################// #
INT unify_modes(INT rule, INT target, INT source)
BEGIN
  STRING items, lmode, rmode;
  INT i, j;
  INT newsource = source;

  IF target == source THEN error("Tragedy: trying to unifying a symbol with itself!"); FI;

  IF rule == rule_assign THEN
// CAUTION: dereference
    IF check_mode(target, "?") THEN
      StrAssign(stack[target].mode, stack[source].mode); 
      stack[target].mode_size = stack[source].mode_size;
    ELSE
      IF IsPrefix(stack[target].mode, "REF") THEN
        StrTail(lmode, stack[target].mode, 4);
        coerce(context_strong, source, lmode, dummy);
      ELSE
        printf("unify_modes: left value should be a name, but is %s!", stack[source].mode);
        error("");
      FI;
    FI;

  ELIF rule == rule_identity THEN
    IF check_mode(target, "?") THEN
      StrAssign(stack[target].mode, stack[source].mode); 
      stack[target].mode_size = stack[source].mode_size;
    FI;
    newsource = coerce(context_strong, source, stack[target].mode, dummy);
// CAUTION: ad hoc unification!
//    stack[target].mode_size = stack[newsource].mode_size;

  ELIF rule == rule_itemize THEN
    IF is_mode_array(source) THEN
      i = StrFind(stack[source].mode, '[', 0);
      StrSlice(stack[target].mode, stack[source].mode, 0, i - 1); 
      j = StrFind(stack[source].mode, ']', 0);
      StrSlice(items, stack[source].mode, i + 1, j - 1);
      StrTail(lmode, stack[source].mode, j + 2); 
      StrAppend(stack[target].mode, stack[target].mode, lmode);
      stack[target].mode_size = calc_mode_size(stack[target].mode, TRUE); 
// printf("\nITEMIZE: mode is %s, size is %i\n", stack[target].mode, stack[target].mode_size);


// CAUTION: This is definetely ad hoc!
    ELIF StrEqual(stack[source].mode, "STRING") THEN
      StrAssign(stack[target].mode, "CHAR");
      stack[target].mode_size = 8;
    ELIF StrEqual(stack[source].mode, "REF STRING") THEN
      StrAssign(stack[target].mode, "REF CHAR");
      stack[target].mode_size = 8;
    ELSE
      printf("unify_modes: error trying to itemize %s!", stack[source].mode);
      error("");
    FI;

  FI;

  return (newsource );
END;


// ####################################################################################// #
// PARSE series												    #
// ####################################################################################// #
INT parse_series(INT follow_set)
BEGIN
  INT ptr;

  open_scope;

  IF debug_echo THEN printf("\nENTER: series\n"); FI;
  ptr = parse_expression(0);
  IF debug_expr THEN debugger; FI;
  WHILE check_token(ABS ';') AND NOT check_tokenset(follow_set) 
  DO
    accept_token(ABS ';');
    free_temp(ptr); 
    printf("\n");
    IF check_tokenset(follow_set) THEN ptr = new_tempvar("VOID"); ELSE ptr = parse_expression(0); FI;
    IF debug_expr THEN debugger; FI;
  OD;
  IF debug_echo THEN printf("\nEXIT: series\n"); FI;

  close_scope;

  return (ptr);
END;


// ####################################################################################// #
// PARSE arg_list == expression (, expression)*							    #
// ####################################################################################// #
VOID parse_arg_list(REF INT args[])
BEGIN
  INT