%{
/* Currently being edited. Adding n-tuples, maybe procedures,
then CSE, op precedence, register allocation, a real code-
generator, and maybe a direct interpreter. Small tweaks:
print formatting, data types, type checking. */
/* Done: added triple for IFTHENELSE */
#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#include <stdarg.h>
#define DEBUG_TREES 1
#define DEBUG_TRIPS 1
#define DEBUG_SOURCE 1
/* This short section necessary for parser generator */
#include "log.h"
#include "taccutil.h"
#include "debug.h"
#include "mmalloc.h"
int exit_flag = FALSE;
int printing = TRUE;
extern int _debug; /* set to true for parser diags */
char *ProgName = "language";
int verbose = FALSE;
void (*cur_handler)(char *s);
void ignore(char *s)
{
}
/* program proper... */
// We use a stringpool, and strings are indexes into this pool. This
// is useful for the same reasons that the AST is an array indexed
// by integers rather than a struct with pointers. It may also
// save space by reusing common strings. And we get a free tag
// to describe strings. (Also we can compare strings just with
// an integer tag comparison, if we ever want to)
char stringpool[1024];
int nextstring = 0;
/*
Overall structure:
parse to AST, generate code from AST into CODE. Generated code
maps 1:1 with AST, but is linearized and ready for translation
into executable code. (TO DO). Note that code as-is treats some
instructions as immediate (eg declarations). This needs to change.
CODE array also has labels.
Start of documentation for triples. NOT YET CORRECT. This is from
memory, but will be more detailed as I work on it.
ERROR,
used in parser when no return is needed, eg null productions
SEQUENCE,
top-level statements, use these entrypoints to either generate code from
or start interpreting immediately. Start of program is first of these.
opd1: triple to start code generation from
opd2: link to next SEQUENCE node
CONST,
opd1: value
opd2: type
TAG,
opd1: name
opd2: type
ASSIGN,
opd1: target
opd2: source
DECLARE
opd1: var
VAR,
opd1: link to tag
IFTHEN,
opd1: condition
opd2: thenpart
IFTHENELSE,
This is a real ternary operation, shortly to replace the above...
opd1: condition
opd2: thenelse
opd3: elsepart
AND,
OR,
logical and/or - can use short-circuit evaluation
ADD,
SUB,
MUL,
DIV,
binary operators -
opd1: left operator
opd2: right operator
NEG,
unary arithmentic negation
NOT,
unary complement
EQ,
NE,
LT,
GT,
LE,
GE,
opd1: left side of comparison
opd2: right side of comparison
INT,
used as a type, never as a trip
REAL,
used as a type, never as a trip (it's a double, not a float, by the way)
LOOP, ENDLOOP
start of a loop. Statements are compiled until a matching ENDLOOP:
opd1: label for continue
opd2: label for endloop
ENDLOOP,
... at which point everthing between the loop/endloop is moved as a
tree under the LOOP triple which is renamed to LOOPENDLOOP,
and the individual LOOP and ENDLOOP triples are removed
BREAK,
opd1: links to the enclosing LOOP/ENDLOOP
CONTINUE,
opd1: LOOP (later LOOPENDLOOP) triple
REDIRECT,
when a triple is removed by common-sub-expression elimination,
the old location is replaced with a 'redirect' to the canonical version.
opd1: target triple
LINE
opd1: lineno
opd2: source code of line
*/
typedef enum opcode {
ERROR,
SEQUENCE,
CONST, TAG,
ASSIGN, DECLARE, VAR, IFTHEN, IFTHENELSE,
INPUT, PRINT,
AND, OR,
ADD, SUB, MUL, DIV,
NEG, NOT,
EQ, NE, LT, GT, LE, GE,
INT, REAL,
LOOP, ENDLOOP, BREAK, CONTINUE,
REDIRECT,
LINE
} OPCODE;
char *name[] = {
"ERROR",
"SEQUENCE",
"CONST", "TAG",
"ASSIGN", "DECLARE", "VAR", "IFTHEN", "IFTHENELSE",
"INPUT", "PRINT",
"AND", "OR",
"ADD", "SUB", "MUL", "DIV",
"NEG", "NOT",
"EQ", "NE", "LT", "GT", "LE", "GE",
"INT", "REAL",
"LOOP", "ENDLOOP", "BREAK", "CONTINUE",
"REDIRECT",
"LINE"
};
char *shortname[] = {
"ERROR",
";",
"CONST", "TAG",
"=", "DECLARE", "VAR", "if (...) then", "if (...) then ... else ...",
"INPUT", "PRINT",
"&&", "||",
"'+'", "'-'", "'*'", "'/'",
"'-'", "'~'",
"==", "!=", "<", ">", "<=", ">=",
"INT", "REAL",
"LOOP", "ENDLOOP", "BREAK", "CONTINUE",
"REDIRECT",
"LINE"
};
char *c_infix_op[] = {
"ERROR",
";",
"CONST", "TAG",
"=", "DECLARE", "VAR", "if (...) then", "if (...) then ... else ...",
"INPUT", "PRINT",
"&&", "||",
"+", "-", "*", "/",
"-", "~",
"==", "!=", "<", ">", "<=", ">=",
"INT", "REAL",
"LOOP", "ENDLOOP", "BREAK", "CONTINUE",
"REDIRECT",
"LINE"
};
int arity[] = {
3,
3,
3, 3,
3, 2 /* DECLARE */, 3, 3, 4,
2, 2,
3, 3,
3, 3, 3, 3,
/* NEG */ 2, /* NOT */ 2,
3, 3, 3, 3, 3, 3,
3, 3,
3, 3, 3, 3,
3,
3
};
int display_children[] = {
0,
2,
0, 0,
2, 1, 0, 2, 3,
1, 1,
2, 2,
2, 2, 2, 2,
1, 1,
2, 2, 2, 2, 2, 2,
1, 0,
/*LOOP*/0, 0, 0, 0,
0,
0
};
int display_leftchild[] = {
FALSE,
TRUE,
FALSE, FALSE,
TRUE, TRUE, FALSE, TRUE, TRUE,
TRUE, TRUE,
TRUE, TRUE,
TRUE, TRUE, TRUE, TRUE,
TRUE, TRUE,
TRUE, TRUE, TRUE, TRUE, TRUE, TRUE,
FALSE, FALSE,
FALSE, FALSE, FALSE, FALSE,
TRUE,
FALSE
};
int display_rightchild[] = {
FALSE,
TRUE,
FALSE, FALSE,
TRUE, FALSE, FALSE, TRUE, TRUE,
FALSE, FALSE,
TRUE, TRUE,
TRUE, TRUE, TRUE, TRUE,
FALSE, FALSE,
TRUE, TRUE, TRUE, TRUE, TRUE, TRUE,
FALSE, FALSE,
FALSE, FALSE, FALSE, FALSE,
FALSE,
FALSE
};
#define opsym(root) AST[root]
#define leftchild(root) AST[root+1]
#define rightchild(root) AST[root+2]
#define nthchild(root, n) AST[root+n]
#define MAXTRIPS 1024
int AST[1024];
int nexttrip = 0;
//#define MAXCODES 1024
//TRIPLE CODE[1024];
//int nextcode = 0;
/* trip is not a pointer, just an index into the array of triples */
/* - this makes debugging the array *MUCH* easier */
typedef int TRIP;
/* Globals */
TRIP prevtrip = -1;
TRIP curtrip = -1;
TRIP progstart = -1;
char *nameof(TRIP t)
{
// I realise that the malloc here is heap lossage, but for now
// its not worth fixing. Choices are either use a stack to allocate
// temporary space (same as in tacc) or keep a cyclic buffer, since
// this is only called in the context of printing so we really
// only need a few active at once.
char *result = malloc(40 /* constants are also bad. I'm lazy. */);
int op = opsym(t);
if (op == CONST) {
sprintf(result, "%d", rightchild(t));
} else if (op == VAR) { // for simpler diagrams, skip a level
sprintf(result, "%s",
stringpool+rightchild(leftchild(t))); // punt to tag
} else {
sprintf(result, "%s", shortname[op]);
}
return(result);
}
void declare(char *name)
{
fprintf(stdout, " int %s;\n", name);
}
void loadconst(char *format, TRIP dest, int value)
{
fprintf(stdout, " ");
fprintf(stdout, format, dest, value);
}
void loadvar(char *format, TRIP dest, char *varname)
{
fprintf(stdout, " ");
fprintf(stdout, format, dest, varname);
}
void store(char *format, char *varname, TRIP source)
{
fprintf(stdout, " ");
fprintf(stdout, format, varname, source);
}
void operate(char *format, TRIP dest, TRIP leftop, char *op, TRIP rightop)
{
fprintf(stdout, " ");
fprintf(stdout, format, dest, leftop, op, rightop);
}
void monoperate(char *format, TRIP dest, char *op, TRIP leftop)
{
fprintf(stdout, " ");
fprintf(stdout, format, dest, op, leftop);
}
void put_goto(int lab)
{
fprintf(stdout, " ");
fprintf(stdout, "goto L%02d;\n", lab);
}
void put_ifgoto(int cond, int lab, int sense)
{
fprintf(stdout, " ");
fprintf(stdout, "if (%s_t%d) goto L%02d;\n", (sense ? "" : "!"), cond, lab);
}
void input(TRIP i)
{ /* TACC BUG! CANNOT ESCAPE double quotes properly */
fprintf(stdout, " ");
fprintf(stdout, "fprintf(stderr, %c%s: %c); fflush(stderr); fscanf(stdin, %c%%d%c, &%s);\n",
'"', nameof(leftchild(i)), '"',
'"', '"', nameof(leftchild(i)));
}
void print(TRIP i)
{
fprintf(stdout, " ");
fprintf(stdout, "fprintf(stdout, %c%%d\\n%c, _t%d); fflush(stdout);\n", '"', '"', leftchild(i));
}
// this macro was used in debugging, not really needed now.
#define put_label(n) xput_label(n, __LINE__)
void xput_label(int lab, int line)
{
fprintf(stdout, "L%02d:\n", lab);
}
/*-----------------------------------------------------------------------*/
#ifdef DEBUG_TREES
typedef enum { typeCon, typeId, typeOpr } nodeEnum;
/* constants */
typedef struct {
int value; /* value of constant */
} conNodeType;
/* identifiers */
typedef struct {
int i; /* subscript to sym array */
} idNodeType;
/* operators */
typedef struct {
int oper; /* operator */
int nops; /* number of operands */
struct nodeTypeTag *op[1]; /* operands (expandable) */
} oprNodeType;
typedef struct nodeTypeTag {
nodeEnum type; /* type of node */
/* union must be last entry in nodeType */
/* because operNodeType may dynamically increase */
union {
conNodeType con; /* constants */
idNodeType id; /* identifiers */
oprNodeType opr; /* operators */
};
} nodeType;
/* --- */
int del = /*was 1*/4; /* distance of graph columns */
int eps = 3; /* distance of graph lines */
/* interface for drawing (can be replaced by "real" graphic using GD or other) */
void graphInit (void);
void graphFinish();
void graphBox (char *s, int *w, int *h);
void graphDrawBox (char *s, int c, int l);
void graphDrawArrow (int c1, int l1, int c2, int l2);
/* recursive drawing of the syntax tree */
void exNode (int trip, int c, int l, int *ce, int *cm, int depth, int *needed);
/*****************************************************************************/
/* main entry point of the manipulation of the syntax tree */
/* draw_tree is taken from the yacc/lex demo by Thomas Niemann
at http://epaperpress.com/lexandyacc/
- I prefer my own drawing code whenever possible (the trees look
prettier) but my code does not handle n-tuples where n > 2,
so I fall back to this code if a diagram requires such a tuple. */
void draw_tree_orig(int root);
void draw_tree(int trip) {
int rte, rtm, needed;
graphInit ();
needed = FALSE;
exNode (trip, 0, 0, &rte, &rtm, 0, &needed);
if (needed) {
graphFinish();
} else {
draw_tree_orig(trip);
}
}
/*c----cm---ce----> drawing of leaf-nodes
l leaf-info
*/
/*c---------------cm--------------ce----> drawing of non-leaf-nodes
l node-info
* |
* ------------- ...----
* | | |
* v v v
* child1 child2 ... child-n
* che che che
*cs cs cs cs
*
*/
void indent(int d)
{
int i;
for (i = 0; i < d*4; i++) {
putchar(' ');
}
}
void exNode
( int trip,
int c, int l, /* start column and line of node */
int *ce, int *cm, /* resulting end column and mid of node */
int depth, int *needed
)
{
int op;
int w, h; /* node width and height */
char *s; /* node text */
int cbar; /* "real" start column of node (centred above subnodes) */
int k; /* child number */
int che, chm; /* end column and mid of children */
int cs; /* start column of children */
char word[40];
//indent(depth);fprintf(stdout, "start: TRIP=%d startcol=%d startline=%d\n", trip, c, l);
if (trip == -1) return;
op = opsym(trip);
if (display_children[op] >= 3) *needed = TRUE;
s = nameof(trip);
sprintf(word, "%s", s);
s = word;
//indent(depth);fprintf(stdout, "graphbox: s = %s\n", s);
/* construct node text box */
graphBox (s, &w, &h);
cbar = c;
//indent(depth);fprintf(stdout, "assign: c=%d\n", c);
*ce = c + w;
*cm = c + w / 2;
/* node is leaf */
if (
(op == CONST ||
op == VAR ||
display_children[op] == 0)
) {
//indent(depth);fprintf(stdout, "drawbox: s = %s cbar=%d\n", s, cbar);
graphDrawBox (s, cbar, l);
return;
}
/* node has children */
cs = c;
//indent(depth);fprintf(stdout, "node has %d children: cs=c=%d\n", display_children[op], c);
for (k = 1; k <= display_children[op]; k++) {
//indent(depth);fprintf(stdout, "%d: exnode1 %d cs=%d\n", k, nthchild(trip, k), cs);
exNode (nthchild(trip, k), cs, l+h+eps, &che, &chm, depth+1, needed);
cs = che;
}
/* total node width */
if (w < che - c) {
cbar += (che - c - w) / 2;
*ce = che;
*cm = (c + che) / 2;
}
/* draw node */
//indent(depth);fprintf(stdout, "cbar=%d\n", cbar);
graphDrawBox (s, cbar, l);
/* draw arrows (not optimal: children are drawn a second time) */
cs = c;
for (k = 1; k <= display_children[op]; k++) {
//indent(depth);fprintf(stdout, "%d: exnode2 %d cs=%d\n", k, nthchild(trip, k), cs);
exNode (nthchild(trip, k), cs, l+h+eps, &che, &chm, depth+1, needed);
graphDrawArrow (*cm, l+h, chm, l+h+eps-1);
cs = che;
}
}
/* interface for drawing */
#define lmax 200
#define cmax 200
char graph[lmax][cmax]; /* array for ASCII-Graphic */
void graphTest (int l, int c)
{ int ok;
ok = 1;
if (l < 0) ok = 0;
if (l >= lmax) ok = 0;
if (c < 0) ok = 0;
if (c >= cmax) ok = 0;
if (ok) return;
printf ("\n+++error: l=%d, c=%d not in drawing rectangle 0, 0 ... %d, %d",
l, c, lmax, cmax);
// fprintf (stderr, "\n+++error: l=%d, c=%d not in drawing rectangle 0, 0 ... %d, %d",
// l, c, lmax, cmax);
{
int i, j;
int lmx=20, cmx=60;
for (i = 0; i < lmx; i++) {
for (j = cmx-1; j > 0 && graph[i][j] == ' '; j--);
graph[i][cmx-1] = 0;
if (j < cmx-1) graph[i][j+1] = 0;
if (graph[i][j] == ' ') graph[i][j] = 0;
}
for (i = lmx-1; i > 0 && graph[i][0] == 0; i--);
printf ("\n");
for (j = 0; j <= i; j++) printf ("\n // %s", graph[j]);
printf("\n");
};
exit (1);
}
void graphInit (void) {
int i, j;
for (i = 0; i < lmax; i++) {
for (j = 0; j < cmax; j++) {
graph[i][j] = ' ';
}
}
}
void graphFinish() {
int i, j;
char *s;
for (i = 0; i < lmax; i++) {
for (j = cmax-1; j > 0 && graph[i][j] == ' '; j--);
graph[i][cmax-1] = 0;
if (j < cmax-1) graph[i][j+1] = 0;
if (graph[i][j] == ' ') graph[i][j] = 0;
}
for (i = lmax-1; i > 0 && graph[i][0] == 0; i--);
printf ("\n");
for (j = 0; j <= i; j++) {
char *p;
s = graph[j];
// hacks to slightly improve formatting
if (j == 0) s += 2;
else if (j == 1) s += 1;
else if ((p=strchr(s, '|')) == NULL || p[1]=='|') s += 2;
printf ("\n // %s", s);
}
printf("\n\n");
}
void graphBox (char *s, int *w, int *h) {
*w = strlen (s) + del;
*h = 1;
}
void graphDrawBox (char *s, int c, int l) {
int i;
//fprintf(stdout, "c=%d strlen=%d del=%d\n", c, strlen(s), del);
graphTest (l, c+strlen(s)-1+del);
for (i = 0; i < strlen (s); i++) {
graph[l][c+i+del] = s[i];
}
}
void graphDrawArrow (int c1, int l1, int c2, int l2) {
int m;
graphTest (l1, c1);
graphTest (l2, c2);
m = (l1 + l2) / 2;
while (l1 != m) { graph[l1][c1] = '|'; if (l1 < l2) l1++; else l1--; }
while (c1 != c2) { graph[l1][c1] = '-'; if (c1 < c2) c1++; else c1--; }
while (l1 != l2) { graph[l1][c1] = '|'; if (l1 < l2) l1++; else l1--; }
graph[l1][c1] = '|';
}
#endif
/*-----------------------------------------------------------------------*/
/*-----------------------------------------------------------------------*/
#ifdef DEBUG_TREES
/* See drawtree.c for test harness. Small mods made for this interface. */
/* NOTE!!! Now we have n-ary trees, this will not work. ifthenelse breaks */
static int tree_debug = (0!=0);
static int vertical = (0==0);
static int horizontal = (0==0);
static int wide = (0!=0);
static int trim = (0==0);
static int testone = (0==0);
// row col
long pic[256][256]; // 0..255 is char, >= 256 is ptr to string
int oldtextblit(int row, int col, char *src)
{
// post-processing string expansion
int l = 0;
for (;;) {
if (*src == '\0') break;
if (tree_debug) fprintf(stderr, "1: Planting '%c' at [%d][%d]\n", *src, row, col);
pic[row][col++] = *src++;
l += 1;
}
return l;
}
int textblit(int row, int col, char *src)
{
// store pointer to string, unpack later on output
int l = strlen(src);
pic[row][col] = (int)src;
return (l+(wide?3:1))>>(wide?2:1); // half size because on diagonal
}
void layout(int id, int idx, int rowoff, int coloff, int *depth, int *width)
{
char *operator;
int op;
int leftkid, rightkid;
int leftkiddepth = 0, leftkidwidth = 0;
int rightkiddepth = 0, rightkidwidth = 0;
int deltadepth = 0, deltawidth = 0;
int i;
if (tree_debug) fprintf(stderr, ">> %d:layout(%d, rowcol[%d][%d], depth %d, width %d);\n", id, idx, rowoff, coloff, *depth, *width);
operator = nameof(idx);
leftkid = leftchild(idx);
rightkid = rightchild(idx);
// Anchor the corner node.
(void)textblit(rowoff, coloff, operator); /* not strcpy - don't copy NUL */
deltawidth = 1;
if (display_rightchild[opsym(idx)]) {
int len = ((strlen(nameof(leftkid))+(wide?3:1))>>(wide?2:1))+1; // text on the diagonal
while (len-- > 1) {deltawidth += 1; pic[rowoff][coloff-1+deltawidth] = (vertical ? '\\' : '-');}
// attach the RHS tree
if (tree_debug) fprintf(stderr, "Recursing to right node %d\n", rightkid);
layout(2*id, rightkid, rowoff, coloff+deltawidth, &rightkiddepth, &rightkidwidth);
deltadepth = rightkiddepth;
} else {
deltadepth = 1; /* The op itself */
}
// testing: correcting a typo
if (((strlen(operator)+(wide?3:1))>>(wide?2:1)) >= deltawidth) deltawidth = ((strlen(operator)+(wide?3:1))>>(wide?2:1))+2;
if (display_leftchild[opsym(idx)]) {
// draw the down link
// calculate extra height
if ((((strlen(nameof(leftkid))+(wide?3:1))>>(wide?2:1))) > deltadepth) {
deltadepth = ((strlen(nameof(leftkid))+(wide?3:1))>>(wide?2:1));
}
for (i = 1; i < deltadepth+1 /* +1 for spacer row */; i++) {
if (tree_debug) fprintf(stderr, "2: Planting '%c' at [%d][%d]\n", '/', rowoff+i, coloff);
pic[rowoff+i][coloff] = (horizontal ? '/' : '|');
}
// recurse on the LHS tree
if (tree_debug) fprintf(stderr, "Recursing to left node %d\n", leftkid);
layout(2*id+1, leftkid, rowoff+deltadepth+1, coloff, &leftkiddepth, &leftkidwidth);
*depth = (*depth) + leftkiddepth + deltadepth + 1;
} else *depth = (*depth) + deltadepth;
if (rightkidwidth+deltawidth > leftkidwidth) {
*width = (rightkidwidth+deltawidth);
} else {
*width = leftkidwidth;
}
if (tree_debug) fprintf(stderr, "<< %d:layout(%d, rowcol[%d][%d], depth %d, width %d);\n", id, idx, rowoff, coloff, *depth, *width);
}
void draw_tree_orig(int root)
{
int depth = 0, width = 0, row, col, offset, trimmable;
fprintf(stdout, "\n");
// Init.
for (col = 0; col < 256; col++) {
for (row = 0; row < 256; row++) {
pic[row][col] = ' ';
}
}
/* Generate layout */
layout(1, root, 128, 0, &depth, &width);
if (tree_debug) fprintf(stderr, "Dump layout: rows = %d cols = %d\n", depth, width);
if (tree_debug) fflush(stderr);
if (vertical) {
/* apply vertical shear first */
offset = 1;
for (col = 1; col < 256; col++) {
// move this column down by 'offset'
for (row = 255; row > offset; row--) {
pic[row][col] = pic[row-offset][col]; pic[row-offset][col] = ' ';
}
offset += 1;
}
}
if (horizontal) {
/* apply horizontal shear next */
row = 255; // start at bottom of drawing
offset = 0;
for (;;) {
static long temp[1024];
for (col = 0; col < 256; col++) {
temp[col] = ' ';
}
for (col = 0; col < 256; col++) {
temp[col*2+offset] = pic[row][col];
temp[col*2+offset+1] = ' ';
}
for (col = 0; col < 256; col++) {
pic[row][col] = temp[col];
}
if (row == 0) break;
offset += 1; /* more shear on next row up */
row -= 1;
}
}
if (trim) {
trimmable = (0==0);
for (;;) {
for (row = 0; row < 256; row++) {
if (pic[row][0] != ' ') {
trimmable = (0!=0);
break;
}
}
if (!trimmable) break;
for (row = 0; row < 256; row++) {
for (col = 0; col+1 < 256; col++) {
pic[row][col] = pic[row][col+1];
}
pic[row][255] = ' ';
}
}
}
if (wide) {
/* apply widening last */
row = 255; // start at bottom of drawing
offset = 0;
for (;;) {
static long temp[1024];
for (col = 0; col < 256; col++) {
temp[col] = ' ';
}
for (col = 0; col < 256; col++) {
temp[col*2+offset] = pic[row][col];
temp[col*2+offset+1] = ' ';
}
for (col = 0; col < 256; col++) {
pic[row][col] = temp[col];
}
if (row == 0) break;
row -= 1;
}
}
/* display tree */
for (row = 0; row < 256; row++) {
trimmable = (0 == 0);
for (col = 0; col < 256; col++) {
if (pic[row][col] != ' ') {
trimmable = (0!=0);
break;
}
}
if (!trimmable) {
fprintf(stdout, " "); // INDENT
for (col = 255; col >= 0; col--) {
if (pic[row][col] != ' ') break;
pic[row][col] = '\0';
}
printf(" // ");
for (col = 0; col < 256; col++) {
if ((pic[row][col] < -128) || (pic[row][col] > 255)) {
oldtextblit(row, col, (char *)pic[row][col]);
} else if (pic[row][col] == '\0') break;
putchar(pic[row][col]);
}
putchar('\n');
}
}
putchar('\n');
fflush(stdout);
return;
}
#endif /* DEBUG_TREES */
/*-----------------------------------------------------------------------*/
/* This is the type of objects passed around as $n in the tacc parser */
#define USERTYPE TRIP
static TRIP entrypoint; // temporary hack until code is restructured
// nested blocks/control structures...
// not much used yet in the demo language
// purpose is to find enclosing loops for break,
// make sure something that starts as a for loop doesn't finish
// as an until, etc :-)
// This is most needed when compiling statement at a time rather
// than recursing in the parser to compile a whole block.
#define MAX_NEST 40
static int control_block[MAX_NEST];
static int type_check[MAX_NEST];
static int next_nest = 0;
void push_block(int typecheck, int lab)
{
// when we actually have more types of nested structure, we'll
// go to the bother of checking that starts and finished match up...
control_block[next_nest++] = lab;
}
void pop_block(int typecheck, int *lab)
{
*lab = control_block[--next_nest];
}
static int nextlab = 0;
// Codegen is the guts of the compiler, which effectively serialises
// the AST into sequentially executable statements. A further phase
// is required to actually generate executable code.
// (However... if you just want to interpret, you can just about
// get away with doing that directly in the AST without this stage)
void codegen(TRIP root, int thenlab, int elselab, int donelab) {
// the labels are only used in short-circuit conditionals - it's
// easier to handle that here than have a complex structure of
// mutually recursive routines. When not needed they will be -1.
TRIP cond, thenpart, elsepart;
switch (opsym(root)) {
case CONST:
loadconst("_t%d = %d;\n", root, rightchild(root));
break;
case DECLARE:
root = leftchild(root);
declare(stringpool+rightchild(leftchild(root)));
break;
case VAR:
loadvar("_t%d = %s;\n", root, nameof(root));
break;
case IFTHENELSE:
/* Simple if ... then ... */
/* Use two trips to simulate a three-way branch: if ... then ... else ... */
// now that we have n-ary tuples, this code needs to change to make
// a new IFTHENELSE opcode use a quad instead.
cond = leftchild(root); thenpart = rightchild(root); elsepart = nthchild(root, 3);
{
int thenlab = ++nextlab;
int donelab = ++nextlab;
int elselab = ++nextlab;
codegen(cond, thenlab, elselab, thenlab);
put_label(thenlab);
codegen(thenpart, -1, -1, -1);
put_goto(donelab);
put_label(elselab);
codegen(elsepart, -1, -1, -1);
put_label(donelab);
}
break;
case IFTHEN:
/* Simple if ... then ... */
cond = leftchild(root); thenpart = rightchild(root);
{
int thenlab = ++nextlab;
int donelab = ++nextlab;
codegen(cond, thenlab, donelab, thenlab);
put_label(thenlab);
codegen(thenpart, -1, -1, -1);
put_label(donelab);
}
break;
case ASSIGN:
codegen(rightchild(root), -1, -1, -1);
store("%s = _t%d;\n", nameof(leftchild(root)), rightchild(root));
break;
case LOOP:
put_label(leftchild(root));
break;
case ENDLOOP:
put_goto(leftchild(root));
put_label(rightchild(root));
break;
case BREAK:
put_goto(rightchild(root));
break;
case SEQUENCE:
codegen(leftchild(root), -1, -1, -1);
codegen(rightchild(root), -1, -1, -1);
break;
// handling short-circuit evaluation of booleans is a bit tricky
// and I don't guarantee that this code is 100% the right way
// to do it - actually it depends a lot on the language being
// compiled. Algol differs from Pascal differs from C, for example.
case AND:
case OR:
{
int truelab = thenlab, falselab = elselab, dropthrough = donelab;
int thenlab, elselab, donelab;
int nexttestlab = ++nextlab;
if (opsym(root) == AND) {
thenlab = nexttestlab; elselab = falselab;
} else {
thenlab = truelab; elselab = nexttestlab;
}
donelab = nexttestlab;
codegen(leftchild(root), thenlab, elselab, donelab);
/* if the first one was true, drop through to next part of && and check it too */
put_label(nexttestlab);
codegen(rightchild(root), truelab, falselab, dropthrough);
/* drop through may be to truelab; if not (because we're nested), jump to truelab */
}
break;
case INPUT:
input(root);
break;
case PRINT:
codegen(leftchild(root), -1, -1, -1);
print(root);
break;
case NEG:
case NOT:
codegen(leftchild(root), thenlab, elselab, donelab);
monoperate("_t%d = %s_t%d;\n", root, c_infix_op[opsym(root)], leftchild(root));
break;
default:
/* Be careful not to default anything other than binary operators! */
if (arity[opsym(root)] != 3) {
fprintf(stdout, "*** Not Implemented: codegen(%s)\n", name[opsym(root)]);
break;
}
codegen(leftchild(root), thenlab, elselab, donelab);
codegen(rightchild(root), thenlab, elselab, donelab);
operate("_t%d = (_t%d %s _t%d);\n", root,
leftchild(root), c_infix_op[opsym(root)], rightchild(root));
{int op;
// maybe a case statement would be more efficient here, or a range test
if (((op = opsym(root)) == EQ) || (op == NE) || (op == LT) || (op == GT) || (op == LE) || (op == GE)) {
// need to change this to call a procedure rather than print
if (thenlab != donelab) put_ifgoto(root, thenlab, TRUE);
// fprintf(stdout, " if (_t%d) goto L%02d;\n", root, thenlab);
if (elselab != donelab) put_ifgoto(root, elselab, FALSE);
// fprintf(stdout, " if (!t_%d) goto L%02d;\n", root, elselab);
}
}
break;
}
}
/*----------------------------------------------------------------------*/
#ifdef DEBUG_TRIPS
/* this is ONLY used for diagnostics and is the same in all test harness programs */
void printtrip(TRIP i) {
int op, parm1, parm2;
if (i < 0) {
fprintf(stdout, "** Too small: TRIP %d\n", i); (void)*(int *)0;
}
if (i >= MAXTRIPS) {
fprintf(stdout, "** Too large: TRIP %d\n", i); (void)*(int *)0;
}
op = opsym(i);
parm1 = leftchild(i);
parm2 = rightchild(i);
switch (opsym(i)) {
case DECLARE:
fprintf(stdout, "// %d: %s [@AST %d]\n",
i, name[op], parm1);
break;
case VAR:
fprintf(stdout, "// %d: %s %s[@AST %d] TYPE=%s\n",
i, name[op], stringpool+rightchild(parm1), parm1, name[parm2]);
break;
case TAG: /* parm1 not used for the moment */
fprintf(stdout, "// %d: %s %s[@Stringpool %d]\n",
i, name[op], stringpool+parm2, parm2);
break;
case CONST:
fprintf(stdout, "// %d: %s %s %d\n",
i, name[op], name[parm1], parm2);
break;
case ASSIGN:
fprintf(stdout, "// %d: %s [declared @AST %d] [value @AST %d]\n",
i, name[op], parm1, parm2);
break;
case IFTHENELSE:
fprintf(stdout, "// %d: %s [condition @AST %d] [then-statement @AST %d] [else-statements @AST %d]\n",
i, name[op], parm1, parm2, nthchild(i, 3));
break;
case IFTHEN:
fprintf(stdout, "// %d: %s [condition @AST %d] [then-statement @AST %d]\n",
i, name[op], parm1, parm2);
break;
case LINE:
fprintf(stdout, "// %d: %s %d: %s\n",
i, name[op], parm1, (char *)parm2);
break;
case AND:
case OR:
case ADD:
case SUB:
case MUL:
case DIV:
fprintf(stdout, "// %d: %s [@AST %d] [@AST %d]\n",
i, name[op], parm1, parm2);
break;
case EQ:
case NE:
case LT:
case GT:
case LE:
case GE:
fprintf(stdout, "// %d: [@AST %d] %s [@AST %d]\n",
i, parm1, name[op], parm2);
break;
case NEG:
case NOT:
fprintf(stdout, "// %d: %s [@AST %d]\n",
i, name[op], parm1);
break;
default:
if (arity[opsym(i)] == 3) {
fprintf(stdout, "// %d: %s %d %d\n",
i, name[op], parm1, parm2);
} else if (arity[opsym(i)] == 2) {
fprintf(stdout, "// %d: %s [@AST %d]\n",
i, name[op], parm1);
} else {
fprintf(stdout, "// %d: %s ...? (%d ops)\n",
i, name[op], arity[opsym(i)]);
}
break;
}
}
#endif
/*----------------------------------------------------------------------*/
#define tripsize(i) arity[opsym(i)]
TRIP make_unary_tuple(OPCODE op, TRIP parm1) {
int trip = nexttrip;
opsym(trip) = op; nexttrip += tripsize(trip);
leftchild(trip) = parm1;
#ifdef DEBUG_TRIPS
printtrip(trip);
#endif
return trip;
}
TRIP make_binary_tuple(OPCODE op, TRIP parm1, TRIP parm2) {
int trip = nexttrip;
opsym(trip) = op; nexttrip += tripsize(trip);
leftchild(trip) = parm1;
rightchild(trip) = parm2;
#ifdef DEBUG_TRIPS
printtrip(trip);
#endif
return trip;
}
TRIP make_nary_tuple(OPCODE op, TRIP parm1, ...) {
// to do - use varagrs or stdargs
// we use this for if/then/else, and procedure calls with
// parameter lists.
int trip;
int parm;
va_list ptr;
trip = nexttrip++;
opsym(trip) = op;
leftchild(trip) = parm1;
va_start(ptr, parm1);
for (parm = 2; parm <= arity[op]; parm++) {
nthchild(trip, parm) = va_arg(ptr, TRIP); nexttrip += 1;
}
va_end(ptr);
#ifdef DEBUG_TRIPS
printtrip(trip);
#endif
return trip;
}
TRIP make_int_const(int datatype, char *value) {
return make_binary_tuple(CONST, datatype, (int)atol(value));
}
TRIP make_real_const(int datatype, char *value) {
return make_binary_tuple(CONST, datatype, (int)atof(value) /* Hacky. Should fix this. */);
}
/* getvar needs to be more complex. Currently it just maps
from a string to the triple for a pre-declared var, adding
any unrecognised string as an int. Should really add it as
an error type, and handle scope rules */
TRIP getvar(char *s) { /* tag must exist */
int i, trip, tag;
strcpy(stringpool+nextstring, s); /* Create a backstop in case not found */
for (tag = 0; tag <= nextstring; tag++) {
if (strcmp(stringpool+tag, s) == 0) {
break; /* found, one way or another */
}
}
if (tag == nextstring) {
nextstring += strlen(s)+1; /* Not found, add it */
trip = make_binary_tuple(TAG, 0, tag);
fprintf(stderr, "ERROR: variable '%s' not declared. Creating as int.\n", s);
return make_binary_tuple(VAR, trip, INT);
}
/* having located the stringpool entry,
now find the appropriate declaration whose tag is using it */
for (i = 0; i < nexttrip; i++) {
if ((opsym(i) == VAR) &&
(rightchild(leftchild(i)) == tag) &&
(rightchild(i) == INT)) {
return i;
}
}
fprintf(stderr, "Oops: cannot find declaration for this name!\n"); exit(1);
}
TRIP newtag(char *s) { /* tag must *not* exist */
int i, trip, tag;
strcpy(stringpool+nextstring, s); /* Create a backstop for when not found */
for (tag = 0; tag <= nextstring; tag++) {
if (strcmp(stringpool+tag, s) == 0) {
break; /* found, one way or another */
}
}
if (tag != nextstring) {
fprintf(stderr, "ERROR: name '%s' already exists.\n", s);
/* forget about scope rules for now */
} else nextstring += strlen(s)+1; /* Not found, add it */
return make_binary_tuple(TAG, 0, tag);
}
%}
/* Main cheats - it invokes the parsing routines explicitly,
in order to reduce the size of the parse tree for a whole
file. Also allows recovery of errors at useful boundaries */
main: ""
{
YYTYPE *subroot;
void *stacktop;
int i;
if (strcmp(argv[argc-1], "-v") == 0) {
argc -= 1;
verbose = TRUE;
}
if (strcmp(argv[argc-1], "-d") == 0) {
argc -= 1;
_debug = TRUE;
}
if (strcmp(argv[argc-1], "-vd") == 0) {
argc -= 1;
_debug = TRUE;
verbose = TRUE;
}
if (argc == 1) {
yyin = fopen("test.language", "r");
} else if (argc != 2) {
fprintf(stderr, "syntax: language test\n");
/* Let's just resume for now... */
yyin = fopen(argv[1], "r");
} else {
yyin = fopen(argv[1], "r");
}
if (yyin == NULL) {
fprintf(stderr, "language: cannot open input\n");
exit(EXIT_FAILURE);
}
fprintf(stderr, "%s: processing %s\n", argv[0], argv[1] == NULL ? "test.language" : argv[1]);
cur_handler = ignore;
if (verbose) fprintf(stderr, "Starting\n");
fprintf(stdout, "#include <stdio.h>\nint main(int argc, char **argv) {\n");
{int i;
for (i = 0; i < 1024; i++) {
fprintf(stdout, "int _t%d; ", i); if ((i&7) == 7) putchar(10);
}
}
fprintf(stdout, "// --------------------- PARSE PHASE ----------------------\n");
prevtrip = curtrip = progstart = make_binary_tuple(SEQUENCE, -1, -1);
for (;;) {
stacktop = stackmark();
if (item_parse(&subroot)) {
entrypoint = -1; // entrypoint hack needs to go!
execute_parsetree(subroot); // we could build an entire parse tree using the
// grammar below, but doing it a statement at a time
// should allow for better error diagnostics. (TO DO)
if (entrypoint != -1) {
rightchild(prevtrip) = curtrip;
leftchild(curtrip) = entrypoint;
rightchild(curtrip) = make_binary_tuple(SEQUENCE, -1, -1);
prevtrip = curtrip;
curtrip = rightchild(prevtrip);
}
#ifdef DEBUG_TREES
if (entrypoint != -1) draw_tree(entrypoint);
#endif
} else {
return(FALSE);
}
stackrelease(stacktop);
if (exit_flag) {
fprintf(stdout, "// --------------------- CODEGEN PHASE ----------------------\n");
curtrip = progstart;
for (;;) {
if (curtrip == -1) break;
fprintf(stdout, "\n");
// fprintf(stdout, "Statement @ %d:\n", curtrip);
if (leftchild(curtrip) == -1) break;
printtrip(curtrip+tripsize(curtrip));
printtrip(leftchild(curtrip));
draw_tree(leftchild(curtrip));
codegen(leftchild(curtrip), -1, -1, -1);
if (leftchild(curtrip) == -1 /* for now */) break;
if (opsym(curtrip) != SEQUENCE) {
fprintf(stdout, "ERROR AT %d: ", curtrip); printtrip(curtrip);
break;
}
curtrip = rightchild(curtrip);
}
fprintf(stdout, " exit(0);\n return(0);\n}\n");
return(TRUE);
}
}
}
;
item: <lookahead> { /* always fails - hack to save text of every line!*/ }
| <sp> <statement> <termin> { };
// THIS IS ALL WRONG. NEED TO MOVE IT ALL INTO THE AST!
statement:
<eof> {
int i;
exit_flag = TRUE;
$$ = ERROR;
}
| "#.*" { /* comment */ $$ = ERROR; }
| "var" <sp> <newname> <sp> <declist> {
if ($5 != ERROR) {
$$ = entrypoint = make_binary_tuple(SEQUENCE, make_unary_tuple(DECLARE, make_binary_tuple(VAR, $3, INT)), $5);
} else {
$$ = entrypoint = make_unary_tuple(DECLARE, make_binary_tuple(VAR, $3, INT));
}
}
| <simpleclause> {
/* handled in simpleclause */
$$ = entrypoint = $1;
}
| "input" <sp> <name> {
$$ = entrypoint = make_unary_tuple(INPUT, $3);
}
| "print" <sp> <expr> {
$$ = entrypoint = make_unary_tuple(PRINT, $3);
}
| "if" <sp> "\(" <expr> "\)" <sp> <simpleclause> <optelse> {
if ($8 == ERROR) {
$$ = entrypoint = make_binary_tuple(IFTHEN, $4, $7);
} else {
$$ = entrypoint = make_nary_tuple(IFTHENELSE, $4, $7, $8);
}
}
| "loop" {
int loopstart, exitlab;
loopstart = ++nextlab;
push_block(LOOP, loopstart);
exitlab = ++nextlab;
push_block(ENDLOOP, exitlab);
$$ = entrypoint = make_binary_tuple(LOOP, loopstart, exitlab);
}
| "endloop" {
int loopstart, exitlab;
// this should be in codegen, not parser
pop_block(ENDLOOP, &exitlab);
pop_block(LOOP, &loopstart);
//put_label(loopstart);
//put_label(exitlab);
//put_goto(loopstart);
$$ = entrypoint = make_binary_tuple(ENDLOOP, loopstart, exitlab);
}
| <!multi> ".*" "$" { // what happens when we have an error
// in a line that does contain a ';'???
fprintf(stderr, "Syntax: %s\n\n", @1.text);
$$ = ERROR;
}
;
simpleclause: <assignment> {
$$ = $1;
}
| "break" {
int loopstart, exitlab;
pop_block(ENDLOOP, &exitlab);
pop_block(LOOP, &loopstart);
push_block(LOOP, loopstart);
push_block(ENDLOOP, exitlab);
// put_label(exitlab);
$$ = make_binary_tuple(BREAK, loopstart, exitlab);
// TO DO: take sequence following LOOP, hook it into
// slot in loop, so that SEQUENCE following LOOP
// is the code *after* the loop.
}
;
optelse: <sp> "else" <sp> <simpleclause> {
$$ = $4;
}
| "" { $$ = ERROR; };
assignment: <name> "[ \t]*=[ \t]*" <expr> {
$$ = make_binary_tuple(ASSIGN, $1, $3);
};
multi: ".*;" { };
declist: "," <sp> <newname> <sp> <declist> {
if ($5 != ERROR) { /* TO DO: don't call declare, junk make_binary_tuple!!!! */
$$ = make_binary_tuple(SEQUENCE, make_unary_tuple(DECLARE, make_binary_tuple(VAR, $3, INT)), $5);
} else {
$$ = make_unary_tuple(DECLARE, make_binary_tuple(VAR, $3, INT));
}
}
| "" { $$ = ERROR; }
;
termin: ";[ \t]*" { } | "[ \t]*$" { };
sp: "[ \t]*" { };
expr: <term> "[ \t]*" <op> "[ \t]*" <expr> <sp>
{
$$ = make_binary_tuple(/* op */$3, /*left*/$1, /*right*/$5);
}
| <term> { $$ = $1; }
;
monop: "-" { $$ = NEG; } | "~" { $$ = NOT; /* "\\" didn't work - parser bug */};
op: "\*" { $$ = MUL; } /* no pretence about operator precedence yet! */
| "+" { $$ = ADD; }
| "-" { $$ = SUB; }
| "/" { $$ = DIV; }
| "\&\&" { $$ = AND; }
| "\|\|" { $$ = OR; }
| "==" { $$ = EQ; }
| "<=" { $$ = LE; }
| "<" { $$ = LT; }
| ">=" { $$ = GE; }
| ">" { $$ = GT; }
| "!=" { $$ = NE; }
;
term: <monop> <simpleterm> { /* -fred is OK, --fred is not */
$$ = make_unary_tuple($1, $2);
}
| <simpleterm> {
$$ = $1;
}
;
simpleterm: <number> { $$ = $1; }
| <name> { $$ = $1; }
| "\(" <expr> "\)" { $$ = $2; }
;
number: "[0-9][0-9]*" { $$ = make_int_const(INT, @1.text); };
name: "[a-z][a-z0-9]*" { $$ = getvar(@1.text); };
newname: "[a-z][a-z0-9]*" {
/* One of the advantages of not tokenising first
is that we can have context-sensitive actions
for the same token. Here we enter variables
into the namelist on the fly as we parse.
However if we were stricter about making an AST
first then compiling from the finished parse
tree, then this would not be helpful. */
$$ = newtag(@1.text);
};
%{
extern int debug(const char *fmt, ...);
extern int debug_enter(const char *fmt, ...);
extern int debug_exit(const char *fmt, ...);
extern FILE *yyin;
int eof_parse(YYTYPE **p)
{
int c;
c = fgetc(yyin);
if (c == EOF) return(TRUE);
ungetc(c, yyin);
return(FALSE);
}
int lookahead_parse(YYTYPE **p)
{
/* This is executed at parse time for every line in the grammar above! */
static int lineno = 0;
char *s;
long __pos;
void *__stack;
char line[128];
*p = NULL; /* Initialise in case of failure */
__stack = stackmark();
(void)note_backtrack(&__pos);
line[0] = '\0';
fgets(line, 127, yyin);
s = strchr(line, '\n'); if (s != NULL) *s = '\0';
do_backtrack(__pos);
stackrelease(__stack);
if (*line != '\0') make_binary_tuple(LINE, ++lineno, (int)strdup(line));
fflush(stdout);
return(FALSE);
}
%}