#ifdef NEVER
// test/27
int main (int argc, char **argv)
{
auto void jim (int x, int y, int z);
// ^^^^ add auto so that forward declarations work properly
void fred (int i, int j, int k)
{
jim (k, j, i);
return;
// ^^^^ remove (0) (may have been inserted assuming end of program)
}
void jim (int p, int q, int r)
{
p = (q + r);
}
// ^^^ make sure closing braces are there at outer level
fred (11, 22, 33);
return(0);
// ^^^^^^^^^^ make sure final return or exit is present,
// and final closing brace
}
#endif
/*
Current difficulties with C generation:
the jumps around procedures appear to cause problems with gcc
which doesn't like code coming before nested procedures. We'll
probably have to exbed all declarations so they come first (or
code so it comes last - same thing, different approach) but
a cheap hack for most programs which don't have procedures in
the middle of data will be to edit pass1 and remove the jumps
around the procedures:
def lab(0) %IF block tag # 0 %AND level # 1; !for jump around
c(130):block x = x
op('F', 0) %IF decl&spec = 0 %AND level # 0; !jump round proc
The problem with exbedding is that subsequent declarations
may shadow variables, eg
%begin
%routine outer(%integer i)
%end
%routine inner
%routine test1
%end
outer(nl)
%routine outer(%integer i)
%end
test1
%end
inner
%endofprogram
This can probably be worked around by name mangling...
*/
//#define GDBARG "test/4"
#include <stdio.h>
#include <stdarg.h>
#include <string.h>
#include <assert.h>
#include <stdlib.h>
#include <ctype.h>
#include <errno.h>
#include <sys/types.h>
#include <sys/stat.h>
#include "auto_gdb.c"
//#include "../../../../devel/mnemosyne/mnemosyne.h"
int memprintf(char *s, ...);
/*
WORK IN PROGRESS: trying to generate low-level C as an alternative
to native code generation for icode.
I'm actually programming right here in this web directory, so this
file is quite liable to be broken at any time you might look at it,
and indeed I might be editing it *right now*. So by all means
browse to see how development is coming along, but don't take copies
until it is released. You'll know when that is, because it will
start having version numbers attached.
*/
#ifndef FALSE
#define TRUE (0==0)
#define FALSE (0!=0)
#endif
/* these three communication variables are a bit of a hack, but
make parsing parameter lists and record formats much much easier */
static int RECORDFORMAT = FALSE;
static int SPEC = FALSE;
static int PROCFNMAPPRED = FALSE;
static int ARRAYDECL = FALSE;
static int debug_input = FALSE;
static int opt_safeforloop = FALSE;
static int opt_safenames = FALSE;
static int opt_c_only = FALSE;
static char *indent = " ";
char *imp_dirname;
FILE *cur_impfile;
FILE *icode_file;
FILE *source_file;
int source_line = 0;
#define MAX_STACK 1024
int cstack[MAX_STACK]; /* compile-time stack */
static int *cstackp = cstack;
/*static int next_stack = 0;*/
static int nest_proc = 0; /* depth of procedure/begin blocks */
#define FOR_LOOP 1
#define OTHER_LOOP 2
static int loop_type[128]; /* real for loop or one of our fake ones? */
static int nest_loop = 0; /* depth of structured loops */
char *cond[256];
char *rcond[256];
#include "lines.c"
#include "tags.c"
#include "names.c"
#include "io.c"
#include "codegen.c"
void check_empty_stack(void)
{
if (cstackp != cstack) {
memprintf("STACK:\n");
while (cstackp != cstack) {
memprintf(" %s\n", tag_rhs_value(cpop()));
}
*(int *)0 = 0;
}
}
int main (int argc, char **argv)
{
char *p1, *p2, *p3, *p4, *p5;
int /*, i2, i3, i4, i5*/i1;
short h1, /*, h3, h4, h5*/h2; /* half. 's' is for strings */
int opcode;
short int d; int w;
char icode_filename[256], source_filename[256];
// restart_under_gdb(argc, argv);
/* Note: pass1 is not handling %include well. Could just be
a problem with the imp80 runtime, however the icode definition
for this version doesn't appear to have the include filename
support that later ones have, which is needed for good
source diagnostics. It may be necessary to rebuild from
the Mouses pass1 without Andy's mods. */
#include "init.c"
opcode = get_icode (icode_file);
for (;;) {
if (opcode == EOF)
break;
/* used[opcode] = TRUE; */
/* if invoked with the option for coverage testing (not yet written)
we log every opcode used, and check at the end to see if any
were omitted. The option should be invoked only when testing
with a special imp program carefully designed to generate
every possible icode supported by pass1. */
switch (opcode) {
case '\n':
break;
/* Looks like we do *not* need to shuffle data around to allow
imp's declarations that come anywhere:
http://gcc.gnu.org/onlinedocs/gcc-3.2/gcc/Mixed-Declarations.html#Mixed%20Declarations
Must verify whether this applies to procedures as well as code */
case '$': /* DEF TAG TEXT TYPE FORM SIZE SPEC PREFIX */
{
char *decls, *typedefname;
/* create the descriptor. If the object requires
space, create it and set 'data' to point to it.
Otherwise stuff the actual data into 'data' */
short int deftag, deftagcopy, a, b, c;
int started = FALSE;
p1 = getvar (&deftag);
p2 = getname ();
assert (get_icode (icode_file) == ',');
p3 = strdup (getshort (&a));
assert (get_icode (icode_file) == ',');
p4 = strdup (getshort (&b));
assert (get_icode (icode_file) == ',');
p5 = getshort (&c);
/* define may set one of these ... */
RECORDFORMAT = FALSE;
SPEC = FALSE;
PROCFNMAPPRED = FALSE;
ARRAYDECL = FALSE;
// TODO: new scheme - if it is an array declaration, don't
// print it, but push it on the stack until we get the
// following bounds statements followed by a DIM
// Note: more that one array can be declared in one statement
memprintf("%s", indent);
decls = define_tag(deftag, strdup(p2) /* heap lossage */, a, b, c); /* may set one of above */
typedefname = NULL;
free (p3);
free (p4);
if (RECORDFORMAT) {
typedefname = strrchr(decls, ' ');
*typedefname++ = '\0';
} else if (ARRAYDECL) {
/* NOTE: although I was about to use gcc's dynamically
sized arrays here, in fact they won't work because
they have a fixed lower bound of zero, and although
you can adjust the base of a pointer, you can't
adjust the base of an array.
I *might* have been able to use "alloca()" but
that has to be called within the procedure making
the declaration - the buck can't be passed to a
helper procedure, which is what's necessary in order
to loop over the creation of multi-dimensional arrays.
We could flatten the array and use alloca(), but that
means passing all the bounds around with any array
in order to scale all indexes; it's much simpler then
if we stick with the original 'malloc' scheme and
use pointers (i.e. an iliffe vector) for extra dimensions.
We just have to be careful to free() all these on return.
*/
if ((tag[deftag].c&7) == 0) {
/* If it is a const or static (and probably 'or extern,
or switch'), there are INITs later but no DIM - I
think DIM is only for auto. An idea: peek ahead one
byte for an INIT. If none, output the declaration.
*/
memprintf("// ON DIM DO: %s\n", decls);
cpush(deftag);
} else {
opcode = get_icode (icode_file);
// unfortunately i've just remembered that the next opcode is PUSHI etc
// *then* INIT :-(
if (opcode != 'A' /* INIT */) {
memprintf("// do it now: %s {NO INIT}\n", decls);
continue; /* back to dispatch loop */
}
memprintf("// do it now: %s", decls);
p1 = getshortdecimal(NULL);
if (cstackp == cstack) {
/* init to unass pattern */
memprintf("; /* uninitialised */\n", decls);
} else {
memprintf(" = {\n%s}\n", indent);
//TODO: (void)cpop(); cpop();
}
break;
}
break; /* Wait until later ... */
}
memprintf("%s", decls);
deftagcopy = deftag;
/*
At the start of a procedure, bump the lexical level,
and note the current tag pointer in an array indexed
by lexical level. on exit from the procedure, the
tag pointer will be reset to that value, thus losing
all declarations made within the procedure. (This
also applies to %begin/%end blocks which are implemented
as anonymous procedures. Sort of.
*/
if (!(RECORDFORMAT || PROCFNMAPPRED || SPEC)) {
memprintf(";\n");
break;
}
opcode = get_icode (icode_file);
if (opcode != '{' /* START */) {
/* if procedure,
if spec output: (...);
if body output: (...) {
if recordformat output: (....) FORMATNAME;
*/
memprintf("/*2*/;\n");
continue; /* back to dispatch loop */
}
/* now pick up parameters and attach to definition */
push(deftag);
if (RECORDFORMAT) memprintf("{"); else memprintf("(");
while (opcode != '}' /* FINISH */) {
if (started) if (RECORDFORMAT) memprintf("; "); else memprintf(", ");
if (opcode == '$') started = TRUE;
if (RECORDFORMAT) {
/* add another variable to format */
//memprintf("*** Declaring record format\n");
/* opcode may be DEF (or ALTBEG/ALT/ALTEND???) */
if (opcode == '$') {
int fieldtag;
started = TRUE;
p1 = getvar (NULL);
p2 = getname ();
assert (get_icode (icode_file) == ',');
p3 = strdup (getshort (&a));
assert (get_icode (icode_file) == ',');
p4 = strdup (getshort (&b));
assert (get_icode (icode_file) == ',');
p5 = getshort (&c);
/* fieldtag is always 0 so issue one of our own */
fieldtag = makenewinternaltag();
memprintf("%s", define_tag(fieldtag, strdup(p2), a, b, c));
// need sos = recordforat, tos = field
push(fieldtag);
//memprintf("adding record field %s deftag=%d fieldtag=%d\n", p2, deftag, fieldtag);
asspar(); /* identical to adding a param to a procdeure */
deftag = cpop(); cpush(deftag); /* asspar modifies deftag when it adds params */
assert(deftag != deftagcopy);
tag[deftagcopy].b = deftag; /* is b the correct field to use? */
free (p3);
free (p4);
} /* else error? */
} else if (PROCFNMAPPRED) {
/* add another parameter to procedure */
/* opcode may only be DEF */
if (opcode == '$') {
/* reads tags and attaches */
p1 = getvar (&deftag);
p2 = getname ();
//memprintf("adding parameter/local declaration %s\n", p2);
assert (get_icode (icode_file) == ',');
p3 = strdup (getshort (&a));
assert (get_icode (icode_file) == ',');
p4 = strdup (getshort (&b));
assert (get_icode (icode_file) == ',');
p5 = getshort (&c);
memprintf("%s", define_tag(deftag, strdup(p2), a, b, c));
free (p3);
free (p4);
}
} else if (SPEC) {
/* add another parameter to procedure */
/* opcode may only be DEF */
if (opcode == '$') {
/* reads tags and attaches */
p1 = getvar (&deftag);
p2 = getname ();
//memprintf("adding dummy format parameter %s\n", p2);
assert (get_icode (icode_file) == ',');
p3 = strdup (getshort (&a));
assert (get_icode (icode_file) == ',');
p4 = strdup (getshort (&b));
assert (get_icode (icode_file) == ',');
p5 = getshort (&c);
memprintf("%s", define_tag(deftag, strdup(p2), a, b, c));
/* definitions are lost almost immediately on
the closing bracket of the parameter list */
free (p3);
free (p4);
}
} else {
/* ERROR */
assert(opcode == '$');
}
opcode = get_icode (icode_file);
}
if (RECORDFORMAT) memprintf(";} %s", typedefname); else memprintf(")");
(void)cpop();
if (SPEC||RECORDFORMAT) memprintf(";\n");
else if (PROCFNMAPPRED) memprintf("\n{\n");
else /* ERROR */;
/* FINISH has no parameters */
}
break;
case '"': /* JUMPIFD cond label */
/* leaves tos on the stack */
/* to translate this properly we should assign tos to a
temp (local off the stack) and replace tos with the
temp for the subequent JUMPIF. Otherwise if the
evaluation of TOS has side-effects, they will occur twice.
*/
case '?': /* JUMPIF cond label */
/* if you have the JUMPIF first then the LOCATE clears it. */
/* if you have the LOCATE first then the REPEAT clears it. */
p1 = getcond (&i1);
p2 = getforwardlab (&h2);
ifcond(opcode, i1, h2);
break;
case 'k': /* BF label */
case 't': /* BT label */
p2 = getforwardlab (&h2);
ifcond(opcode, opcode, h2);
break;
case 'C': /* JUMPIFA cond label */
p1 = getcond (&i1);
p2 = getforwardlab (&h2);
ifcond(opcode, i1, h2);
break;
case '\'': /* PUSHS sconst */
(void)getimpstring (&p1);
pushs(p1);
break;
case 'D': /* PUSHR rconst */
memprintf("%s/* TODO */ %s %s\n",
indent, icode_name[opcode], getwordconst (NULL));
break;
case 'N': /* PUSHI iconst */
(void)getwordconst (&w);
pushi(w);
break;
case 'L': /* LABEL label - permanent, not wiped? */
(void)getshort(&d);
memprintf("%s:\n", setuserlab (d));
// memprintf("%s: /* LABEL (user) */\n", setuserlab (d));
break;
case ':': /* LOCATE label */
{
int linenod;
(void)getshort(&d);
if (lineno[d] != 0) {
memprintf("%s:\n", setforwardlab (d));
break;
} else {
memprintf("%sfor (;;) {\n%s:\n", indent,
setbackwardlab (d, &linenod));
loop_type[nest_loop] = OTHER_LOOP;
nest_loop += 1;
break;
}
// memprintf("%s: /* LOCATE label */\n", setforwardlab (d));
break;
}
case 'B': /* REPEAT label */
{
int linenod, saved;
nest_loop -= 1;
(void)getshort(&d);
saved = lineno[d];
p1 = setrepeatlab (d, &linenod);
if (loop_type[nest_loop] == FOR_LOOP) {
// memprintf("L_%04x: /* %%continue */\n", linenod);
}
memprintf("%s}\n", indent);
// memprintf("%s} /* end loop L_%04x */\n", indent, saved);
if (loop_type[nest_loop] == FOR_LOOP) {
// memprintf("L_%04x: /* %%exit */\n", linenod+1);
}
}
break;
case 'F': /* GOTO label */
/* check for nest and if id matches, map to an exit/continue */
memprintf("%sgoto %s;\n", indent, getforwardlab (NULL));
break;
case 'J': /* JUMP label */
memprintf("%sgoto %s;\n", indent, getuserlab ());
break;
case 'f': /* FOR label (label was missing from thesis
description) */
p1 = getbackwardlab (&d);
p2 = nextlab (d+1);
/* ASSUME EXIT LABEL IS IMPLICITLY NEXT LABEL */
for_loop(opcode, nest_loop, d, d+1);
loop_type[nest_loop] = FOR_LOOP;
nest_loop += 1;
break;
case 'O': /* LINE decimal */
p1 = getshortdecimal (&d);
if (!opt_c_only) memprintf("#line %d\n", d + 1);
/* output source file up to line %d */
if (!opt_c_only && (source_file != NULL)) {
while (source_line < d + 1) {
if (fgets (line, MAX_LINE, source_file) == NULL)
break;
source_line += 1;
memprintf("//%6d ", source_line);
line[MAX_LINE] = '\0';
memprintf("%s\n", line, stdout);
}
}
break;
case '@': /* PUSH tag */
(void)getvar (&d);
push(d);
break;
case '^': /* PROC tag */
memprintf("%s%s %s\n", indent, icode_name[opcode], getvar (NULL));
break;
case 'n': /* SELECT tag */
{
short int subtag;
(void)getshort (&subtag);
cpush(subtag);
fieldselect(opcode);
// memprintf("%s%s %d\n", indent, icode_name[opcode], subtag);
}
break;
case 'W': /* SJUMP sd */
(void)getshortdecimal (&h1),
memprintf("%sgoto *%s[%s];\n",
indent, tag_rhs_value(h1),
tag_rhs_value(cpop()));
break;
/*
You can specify a range of consecutive values in a single case label,
like this:
case low ... high:
This has the same effect as the proper number of individual case labels,
one for each integer value from low to high, inclusive.
This feature is especially useful for ranges of ASCII character codes:
case 'A' ... 'Z':
Be careful: Write spaces around the ..., for otherwise it may be parsed
wrongly when you use it with integer values. For example, write this:
case 1 ... 5: rather than this: case 1...5:
*/
case '_': /* SLABEL sd */
/* BUG: if switch bounds include negative numbers, label is invalid */
(void)getshortdecimal (&h1),
memprintf("%s_%s:\n",
/* no indent */
tag_rhs_value(h1),
tag_rhs_value(cpop()));
break;
case 'd': /* DIM short numbounds, short numdecls */
{
int each, i, decl;
char bounds[1024];
char arrayname[1024];
char baseelementtype[1024];
char *s;
short int numdecls, numbounds;
p1 = strdup (getshort (&numbounds));
assert (get_icode (icode_file) == ',');
p2 = getshort (&numdecls); /* changed order of decls/bounds */
bounds[0] = '\0';
for (i = 0; i < numbounds; i++) {
p3 = tag_rhs_value(cpop());
p4 = tag_rhs_value(cpop());
sprintf(bounds+strlen(bounds), ", %s, %s", p4, p3);
/* GCC allows dynamically sized arrays: http://gcc.gnu.org/onlinedocs/gcc-3.2/gcc/Variable-Length.html#Variable%20Length */
}
for (each = 0; each < numdecls; each++) {
decl = cpop(); /* get decl and print it */
sprintf(baseelementtype, "%s", cdecl(decl)); /* cdecl currently returns inapproprate information */
s = strrchr(baseelementtype, '*');
assert(s != NULL);
*s++ = '\0';
strcpy(arrayname, s);
if ((i = numbounds) > 1) {
i -= 1;
while (--i > 0) {
s = strrchr(baseelementtype, '*'); *s = '\0';
}
}
memprintf("%s%s = ARRAY(%s, %s, %0d%s)\n",
indent, cdecl(decl), baseelementtype,
arrayname, numbounds, bounds);
// TODO: in the modified scheme the array decl is also pushed on the stack
memprintf("%s%s %s %s\n", indent, icode_name[opcode], p1, p2);
}
free (p1);
}
check_empty_stack();
break;
/*
In GNU C you can give the elements in any order, specifying the
array indices or structure field names they apply to. This extension
is not implemented in GNU C++.
To specify an array index, write `[index]' or `[index] =' before the
element value. For example,
int a[6] = { [4] 29, [2] = 15 };
To initialize a range of elements to the same value,
write `[first ... last] = value'. For example,
int widths[] = { [0 ... 9] = 1, [10 ... 99] = 2, [100] = 3 };
*/
case 'b': /* BOUNDS */
p1 = tag_rhs_value(cpop());
p2 = tag_rhs_value(cpop());
memprintf("%s// bounds [%s : %s]\n", indent, p2, p1);
break;
case 'Y': /* DEFAULT short */
// memprintf("%s%s %s\n",
// indent, icode_name[opcode], p1);
break;
case 'A': /* INIT short */
p1 = getshortdecimal(NULL);
if (cstackp == cstack) {
/* init to unass pattern */
} else {
(void)cpop();
}
// memprintf("%s%s %s\n",
// indent, icode_name[opcode], p1);
break;
case 'e': /* EVENT short */
cpop(); /* pop 2nd int in %signal 15,15 */
memprintf("// %s%s %s\n",
indent, icode_name[opcode], getshort (NULL));
break;
case 'l': /* LANG short */
getshort (&h1);
if (h1 == 0) {
if (!opt_c_only) memprintf("\n/*\n %s\n */\n",
"Edinburgh IMP77 Compiler - Version 8.4");
} else {
memprintf("// %s%s %04x\n",
indent, icode_name[opcode], h1);
}
break;
case 'o': /* ON byte, short mask, short label */
(void)getshort(&h1);
assert (get_icode (icode_file) == ',');
p1 = getforwardlab (NULL);
memprintf("%sif (imp_onevent(0x%04x)) goto %s /* returns FALSE during longjump setup */\n",
indent, h1, p1);
break;
case 'r': /* RESOLVE m */
memprintf("%s/* TODO */ %s %s\n",
indent, icode_name[opcode], getbyte ());
break;
case '!': /* OR */
case '%': /* XOR */
case '&': /* AND */
case '*': /* MUL */
case 'u': /* ADDA */ /* don't yet know what this does */
case '+': /* ADD */
// sos_op_tos(opcode);
// break;
case '-': /* SUB */
case '/': /* QUOT */
case 'Q': /* DIVIDE (reversed params) */
case '[': /* LSH */
case ']': /* RSH */
sos_op_tos(opcode);
break;
case '.': /* CONCAT */
cpop(); /* TODO */
// sos_op_tos(opcode);
break;
case 'v': /* MOD */
case '\\': /* NOT */
case 'U': /* NEGATE */
monop(opcode);
break;
case 'x': /* REXP */
case 'X': /* IEXP */
call_sos_tos(opcode);
break;
case 'S': /* ASSVAL */
assval();
break;
case 'Z': /* ASSREF */
assref();
break;
case 'i': /* INDEX */
/* TODO multi-dimensional arrays */
cpop(); /* for now */
break;
case 'a': /* ACCESS */
arrayaccess(opcode);
break;
case 'm': /* MONITOR *//* Should really invoke imp diag routine */
memprintf("%sassert(FALSE);\n", indent);
break;
case 'H': /* BEGIN *//* Assume main program for now, fix later */
nest_proc += 1;
memprintf("int main(int argc, char **argv) {\n");
break;
case ';': /* END */
nest_proc -= 1;
/* memprintf("%sEND %d\n", indent, nest_proc); */
if (nest_proc < 0) break; /* probably end of file */
if (nest_proc == 0) {
memprintf("%sreturn(0);\n", indent);
/* I hope this is end of program */
}
memprintf("}\n"); /* end of any begin/end or proc */
break;
case '{': /* START */
/* Could lookahead for this opcode after $DEF of a record
format or a procedure/fn/map/pred [spec?].
Or... keep a variable noting the address of forementioned
in opcode/tag array and hook these on to last active item. */
memprintf("(/*should not get here any more*/");
break;
case '}': /* FINISH */
memprintf("/*or here*/)\n");
break;
/* start and end of variant records */
case 'h': /* ALTBEG */
case '|': /* ALT */
case 'q': /* ALTEND */
break;
case 'p': /* ASSPAR */
asspar();
break;
case 'E': /* CALL */
call();
break;
case 'K': /* FALSE */
case 'T': /* TRUE */
break;
case 'M': /* MAP */
/* TODO */
case 'V': /* RESULT */
result(opcode); /* tos */
break;
case 'R': /* RETURN */
memprintf("%sreturn;\n", indent);
break;
case 's': /* STOP */
memprintf("%sexit(0);\n", indent);
break;
case 'j': /* JAM */
/* like assign? */
assval();
break;
case 'y': /* DIAG */
case 'z': /* CONTROL */
p1 = getshort (&d);
break;
case '#': /* BNE possibly not implemented */
case 'G': /* ALIAS */
/* See http://gcc.gnu.org/onlinedocs/gcc/Asm-Labels.html#Asm%20Labels */
case 'P': /* PLANT */
memprintf("%s%s\n", indent, icode_name[opcode]);
break;
/* Should be able to map imp's inline assembler rather well!:
http://gcc.gnu.org/onlinedocs/gcc-3.2/gcc/Extended-Asm.html#Extended%20Asm
*/
case 'c': /* MCODE */
memprintf("%s*** icode documentation bug\n", indent);
break;
case 'w': /* SUBA */ /* appears to actually be MCODE */
{
int i1;
short int h1;
memprintf("%sasm {", indent);
for (;;) {
p1 = getmcstring(&i1);
memprintf(" %s", p1);
if (i1 == ';') break;
p2 = getshort(&h1);
memprintf("%s", tag_rhs_value(h1));
}
memprintf("};\n");
}
break;
default:
memprintf("?%s%s\n", indent, icode_name[opcode]);
break;
}
opcode = get_icode (icode_file);
}
if (!opt_c_only && (source_file != NULL)) {
for (;;) { /* mop up any remaining source lines */
if (fgets (line, MAX_LINE, source_file) == NULL)
break;
source_line += 1;
memprintf("//%6d ", source_line);
line[MAX_LINE] = '\0';
memprintf("%s\n", line, stdout);
}
}
check_empty_stack();
exit (0);
return (0);
}