%{
// This code attempts to handle old style (PDP15) imp, old Emas Imp,
// various Imp77 flavours, and Imp80. Clearly this is impossible as
// some of these versions are incompatible. I need to start documenting
// the differences when they're found.
// HOWEVER!!! This code is not structured well enough to be a full Imp77 or Imp80
// compiler, so my goal at the moment is only to be able to translate
// Robertson's Imp77 compiler itself (pass1.imp and pass2.imp) for
// bootstrapping purposes.
// We assume GCC extensions present. Here's the list:
// https://gcc.gnu.org/onlinedocs/gcc/C-Extensions.html#C-Extensions
// Also I think https://gcc.gnu.org/onlinedocs/gcc-4.7.2/gcc/Function-Attributes.html
// suggests a way of implementing %alias.
// Most Imp constructs can be simulated using these. A few such as
// %dynamicroutinespec may require system-specific calls. (Both Windows and Linux
// support DLLs but the calling mechanism is different for each)
// We might be able to use 'inline' to compile %prim routines such as newline etc.
// todo: neater code for cycles with -1 step
// check that cycles with non-constants as step are handled correctly
// (ie whether they go up or down - probably a != test rather than <= )
// AA-type implicit multiplication from Imp15 (this is decode.i)
// J = X//40; K = X-40J
// I = J//40; J = J-40I
// BUG: %IF I='''' %THEN %START
// generates if (i == '\\') {
// (check to see if this is still true and fix it if it is)
// There are some warnings when converting pass1.imp about old style
// strings, which I think are actually character constants. Have to
// look at those and determine what's happening.
// 2_101010 style constants not yet parsed or output generated
// - the gcc extended syntax is i = 0b101010; NOTE!!! Gnu indent does not handle 0b111 - turns it into 0 b1111
// Octal and hex are supported - other bases will have to be converted, e.g. Imp15's use of 40_
// %IF X=40_JMS %AND 4<=N1<=56 %THEN JMS(N1) %ELSE WRITE(N1,1)
// Currently, integers with leading 0 accidentally become octal
// Check the syntax for aritrary bases in old Emas Imp (if even supported)
// Is there an issue with negative switch labels?
// This code does not handle operator precedence. We need to
// apply imp precedence rules while building the parse tree,
// and C precedence rules when writing out the C expressions.
// (or we could generate fully bracketed code which would be ugly -
// we already have more spurious brackets than we'd like)
/*
I'm going to generate very imp-like code using macros and ()
rather than [] for array elements. This makes the translation
*much* easier, but less C-like to read which may be a problem
for some. However a prepass with the pre-processor could
sort all that out in seconds...
Functions (and maps) with no parameters look like variables when
they are referenced. To avoid the need for this translator to
implement a full name/type table, we use a macro trick to make
the call into proper C syntax.
However there is potentially a problem if there are nested
functions of the same name, and also we need to undef the
name at the end of the current enclosing scope. Forward
declarations as below might also be a problem.
auto int gapp (void);
#define gapp gapp()
newapp = gapp;
auto int gapp (void)
#define gapp gapp()
k = gapp;
I've discussed the ;! construct in the middle of a multiline statement with John.
This one also shows up in pass2.c - lines ending in %and or %or are implicitly
continued, with need for %c
%while i < cotp-7 %cycle
%if contable(i) = byteinteger(addr(double)) %and
contable(i+1) = byteinteger(addr(double)+1) %and
contable(i+2) = byteinteger(addr(double)+2) %and
contable(i+3) = byteinteger(addr(double)+3) %and
contable(i+4) = byteinteger(addr(double)+4) %and
contable(i+5) = byteinteger(addr(double)+5) %and
contable(i+6) = byteinteger(addr(double)+6) %and
contable(i+7) = byteinteger(addr(double)+7) %then %result = i + cotoffset
i = i + 4
%repeat
Here's another problem:
%routine writeifrecord(%integer type, %integer length, %byteintegerarrayname buffer)
becomes
auto void writeifrecord (int type, int length, unsigned char buffer)
and accesses to buffer(i) are not mapped to buffer[i]
*/
#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#include <stdarg.h>
#include <assert.h>
#include "log.h"
#include "taccutil.h"
#include "sscanr.h"
#include "debug.h"
#include "mmalloc.h"
int my_exit(int rc, int line, char *file)
{
fprintf(stderr, "Exit at %s, line %d\n", file, line);
exit(rc);
return rc;
}
#define exit(n) my_exit(n, __LINE__, __FILE__)
/*
This is an Imp to C translator based on an earlier program which was
an Imp source formatter (and Imp to Imp translator which generated the
common Imp80 subset from whatever language version input it was given)
The program parses the source using a grammar derived from Peter Stephens
Imp80 grammar; it generates an Abstract Syntax Tree, and does a minimal
amount of symbol table management in order to differential between
some context-sensitive language constructs (for example should "I"
be implemented as "i", "*i", "i()", or "*i()"; or "A(2)" be "a[2]"
or "a(2)"?)
The translation was originally intended to be as high-level as possible,
creating a source which looks like it could have been written natively in C
rather than translated. Some library help will be required.
The input for this program must come from the "filter" program also
in this directory. Filter needs a little work done to it, for example
one version of Imp77 allowed an implicit continuation after percent-or
and percent-and; another used "-" as a continuation character. Various
versions of Imp treat "percent-C" at the end of a "!" comment differently.
Limitations:
1) no command line options at all. No parameterisation of indents etc.
2) {comments} are completely lost. Only !Comments are preserved.
(my later parsing system did support tagging atoms with those comments
but this project is not worth backporting to that parser)
3) The parser generator used here has several opportunities for
optimisation which have never been taken advantage of so it is
currently slow. Addressing those optimisations will speed up
this program simply by rebuilding.
4) The parser generator uses huge amounts of Ram, especially when
translating long declaration lists, which it does rather slowly.
Design features: (you may call these bugs but they are deliberate)
1) No formatting. Post-process the output with 'indent'.
2) Tries to map Imp strings to C strings to make more maintainable
code; this is not always 100 percent possible
Bugs:
1) No error recovery whatsoever if a parse fails. Assumes both that
this code is correct and that the input file compiles correctly
under Imp80
2) The grammar this is built on was intended to be used with code
to check certain combinations which the grammar allows but the
language does not. For instance an "Assop" can be "=", "==",
"<-" (jam transfer), or "->" (string assignment). However in
the context of the result of a function, only "=" or maybe "<-"
might be valid; in a map only "==" is valid, and "percent-result ->"
is *never* valid. Except that it is in this program, ie the
language it accepts includes some invalid constructs.
Notes:
1) Interesting grammar feature found caused by the original using
built-in phrases versus this one doing all parsing at the top level:
I = M'fred'
was parsed as (name I) (assop =) (name M) <error>, i.e. the
test for a name came before the test for a multi-constant, and
caused a parse-fail because of the lack of lookahead by one token.
This was corrected by adding a guard after <name> which checked for
a quote and failed if present.
TO DO:
1) remove all tweaks from codegen, replace with an intermediate
procedure which manipulates the tree, then do a simple walk
when we acually generate code.
2) remove the 'depth' junk, have an explicit flag for generating ';'
3) create tables for binops, so we can easily reverse conditions etc
4) major rationalisation of opcodes needed, clean up AST to
canonical set - especially if/then/else stuff.
5) MUST FIX BUG IN PARSER - broken character constants are a pain
and editing the output each time is tedious
6) string resolution - I do have runtime procedures to replicate
Imp's behaviour, but it would be much nicer to map to standard
C calls such as strstr which is often possible. See some of the
hand-coded tweaks in JGH's converted programs.
7) printf and format strings instead of various imp output procs
8) i += 1 => i++
9) !(a == b && c == d) => (a != b || c != d)
10) priorities - think I can do it on output of binop (by induction)
11) *** DECLARATIONS *** - need to build up a symbol table
12) with symbol table, do proper I as i, *i, i() or *i()
13) output procedures for strings, ints etc - convert X'ab01' to 0xab01
at input stage (for all types) Need \ in strings and consts
14) map names to other names if they clash with keywords (eg switch)
15) special handling for imp percent-alias external proc names. (does GCC
have any hacks for this?)
16) case labels need to be sorted. I'm using pds's trick of
planting simple labels and using a case statement to jump
to them, but have to remember special handling for negative
numbers (plus I have to actually decode things like 'a' rather
than leaving them as ascii constants). Might also consider
gccs extension to use a jump table (&&lab)
17) code assumes gccs extensions for nested procedures. Unnesting
them is *way* too complex (viz local stack frame access for
recursive procedures - need to pass a context around as a
parameter, put all vars in a struct. Yech.)
18) delete all the 'indent' stuff.
19) Parser: as well as all the other stuff mentioned before,
there's a problem with an unbalanced double-quote in comments!
*/
/* This is the type of objects passed around as $1, $$ etc. */
#define USERTYPE int
#define RBRACE '}'
/* Bug in tacc translation - } skipped OK in strings but not int consts */
#define SQUOTE 39
#define DQUOTE 34
#define BSLASH 92
int exit_flag = FALSE;
int printing = TRUE;
int ilev = 0; /* nested begin/end for now. Later use a stack */
int delayed_ilev = 0;
extern int _debug; /* set to true for parser diags */
int label = FALSE;
char *ProgName = "imp";
extern char **argv;
extern int argc;
int verbose = FALSE;
int formatf(char *s, ...) // WHY IS THIS NULL?????
{
return 0;
}
int addstr(char *s);
int sformatf(char *s, ...) // returns a stringpool index
{
/* Size the string by vfprint'ing it to /dev/null... */
/* then heapmalloc an appropriate area */
char *APPROPRIATE_STRING;
va_list ap;
va_start(ap, s);
{
static FILE *nullfile = NULL;
int string_length;
if (nullfile == NULL) nullfile = fopen("/dev/null", "w");
if (nullfile == NULL) {
fprintf(stderr, "Major error - cannot open /dev/null\n");
fflush(stderr);
exit(1);
}
string_length = vfprintf(nullfile, s, ap);
/* fclose(nullfile); */
APPROPRIATE_STRING = tempheapmalloc(string_length+1);
vsprintf(APPROPRIATE_STRING, s, ap);
}
va_end(ap);
return(addstr(APPROPRIATE_STRING));
}
char *strlwr(char *orig)
{
char *s = orig;
for (;;) {
if (*s == '\0') break;
if ((isalpha(*s)) && (isupper(*s))) *s = tolower(*s);
s++;
}
return(orig);
}
/* --------------------------------- COMPILER SUPPORT --------------------------------------- */
static int reals_long = FALSE;
//static int scope_level = 0; /* 0 = prims, 1 = %begin/%endofprogram/%externalroutine */
#define NONE 0
#define HOLE 0
/* Basic types - might upgrade this using the bitfields from imp77 compiler */
const int REAL = 1;
const int INTEGER = 2;
const int STRING = 3;
const int LONG = 4;
const int BYTE = 8;
const int HALF = 16;
const int SHORT = 32;
/* in case these are needed... */
const int ARRAY = 64;
const int RECORD = 128;
const int NAME = 256;
#define UOP_POS 1
#define UOP_NEG 2
#define UOP_LOGNOT 3
#define UOP_BITNOT 4
#define UOP_ABS 5
#define UOP_DEBUG 6
#define DEBUGITEM(x) maketuple(MONOP, UOP_DEBUG, x)
//#define DEBUGITEM(x) x
/* The whole TYPE thing needs to be cleaned up a lot, this is currently */
/* a hack driven by the parser. We should use type bits as in the */
/* various real imp compilers. */
#define OP_AND 1
#define OP_OR 2
#define OP_PTRASSIGN 3
#define OP_ASSIGN 4
#define OP_JAMTRANSFER 5
#define OP_STRINGRESOLVE 6
#define OP_PTREQ 7
#define OP_LE 8
#define OP_GE 9
#define OP_GT 10
#define OP_LT 11
#define OP_EQ 12
#define OP_NE 13
#define OP_TESTRESOLVE 14
#define OP_PTRNE 15
#define OP_IF 16
#define OP_UNLESS 17
#define OP_ADD 18
#define OP_SUB 19
#define OP_BITAND 20
#define OP_IEXP 21
#define OP_EXP 22
#define OP_MUL 23
#define OP_EOR 24
#define OP_IOR 25
#define OP_IDIV 26
#define OP_RDIV 27
#define OP_SHR 28
#define OP_SHL 29
#define OP_CONCAT 30
/* AST entries */
#define VAR_OR_FNCALL 1 /* fred */
#define RECORD 2 /* left_right */
#define ARRAY_OR_FNMAP 3 /* fred(parms) */
#define CONST 4 /* <TYPE> 23, "jim", 3.14 */
#define LETTERCHARCONST 5 /* 'fred' (aka M'fred') */
#define MONOP 6 /* -<expr> */
#define BINOP 7 /* NOTE: a op b op c op d HAS NO PRECEDENCE IN AST */
#define BRACKET 8 /* "("<expr>")" - for forcing precedence */
#define NUMERICLABEL 9 /* 99: */
#define LINE 10 /* lineno "source line" */
#define SPEC 11 /* blah %spec */
#define TYPE_INTEGER 12 /* basic */
#define TYPE_REAL 13 /* basic */
#define TYPE_LONG 14 /* basic */
#define TYPE_STRING 15 /* basic */
#define TYPE_BYTEINTEGER 16 /* basic */
#define TYPE_SHORTINTEGER 17 /* basic */
#define TYPE_HALFINTEGER 18 /* basic */
#define TYPE_RECORD 19 /* basic */
#define PARAMLIST 20 /* first, rest */
#define PROCCALL 21
#define LABEL 22
#define SWITCHLABEL 23
#define MULTI 24
#define RECORDFIELD 25
#define ARRAYINDEX 26
#define SEQUENCE 27
#define SWITCHDECL 28
#define COMMENT 29
#define CONDITIONAL 30
#define FINISHELSE 31
#define FINISH 32
#define LOOP 33
#define ENDLOOP 34
#define DECLARATION 35
#define ENDPROG 36
#define ENDFILE 37
#define ENDPERM 38
#define ENDLIST 39
#define ENDBLOCKPROCFN 40
#define PROCDEF 41
#define OWNDEC 42
#define INCLUDE 43
#define BEGINBLOCK 44
#define ONEVENT 45
#define FINISHELSEIFSTART 46
#define FINISHELSESTART 47
#define ASM 48
#define DEFAULTCASE 49
#define WHILE 50
#define UNTIL 51
#define ALIAS 52
#define FORLOOP 53
#define TYPE_LONGREAL 54
#define TYPE_LONGLONGREAL 55
#define ROUTINE 56
#define PREDICATE 57
#define FUNCTION 58
#define MAP 59
#define ROUTINENAME 60
#define PREDICATENAME 61
#define FUNCTIONNAME 62
#define MAPNAME 63
#define PROCCALL_OR_ARRAY_OR_MAP 64
#define ARRAYDECLARATION 65
#define ARRAYFORMATDECLARATION 66
#define BOUND_PAIR 67
#define BREAK 68
#define CONTINUE 69
#define DECLARE_ARRAY 70
#define DOUBLE_SIDED 71
#define ELSE 72
#define ELSEIFORUNLESS 73
#define ELSESTART 74
#define FORMALPARAMETER 75
#define FUNCTION_PARAMETER 76
#define GOTO_LABEL 77
#define GOTO_SWITCH 78
#define INITCONST 79
#define INITCONSTARRAY 80
#define MONITOR 81
#define THENELSE 82
#define OWNARRAYDEC 83
#define RECORDFORMAT 84
#define RECORDFORMATDECLARATION 85
#define RECORDFORMATELEMENT 86
#define RECORDFORMATSPEC 87
#define RESULT 88
#define RETURN 89
#define SIGNAL 90
#define STOP 91
#define TYPE_ARRAYNAME 92
#define TYPE_AUTO 93
#define TYPE_CONST 94
#define TYPE_DYNAMIC 95
#define TYPE_EXTERN 96
#define TYPE_EXTERNAL 97
#define TYPE_FORMAT 98
#define TYPE_GENERICNAME 99
#define TYPE_NAME 100
#define TYPE_OWN 101
#define TYPE_PRIM 102
#define TYPE_SYSTEM 103
#define VARIANTRECORDFORMAT 104
#define WHATEVER 105
#define OWNSCALARDEC 106
#define SUBSEQUENCE 107
#define REPEATUNTIL 108
#define RETURN_TRUE 109
#define RETURN_FALSE 110
#define C_IF_THEN_ELSE 111
#define ELSEIFORUNLESSSTART 112
#define IFORUNLESSSTART 113
#define FINISHELSEIFORUNLESS 114
#define FINISHELSEIFORUNLESSSTART 115
#define VAR 116
#define TYPE_LABEL 117
#define LAST_ITEM TYPE_LABEL
int Arity[] = {
0, /* NONE . */
1, /* VAR_OR_FNCALL . "name" */
2, /* RECORD . record subfield */
2, /* ARRAY_OR_FNMAP . name parms */
2, /* CONST . type value */
1, /* LETTERCHARCONST . "string" */
2, /* MONOP . op expr */
3, /* BINOP . op left right */
1, /* BRACKET . expr */
1, /* NUMERICLABEL . "99:" */
2, /* LINE . lineno "sourceline" */
1, /* SPEC . (hole for procedure) */
0, /* TYPE_INTEGER . basic */
0, /* TYPE_REAL . basic */
0, /* TYPE_LONG . basic */
1, /* TYPE_STRING . basic */
0, /* TYPE_BYTE . basic */
0, /* TYPE_SHORT . basic */
0, /* TYPE_HALF . basic */
1, /* TYPE_RECORD . basic */
2, /* PARAMLIST . first, rest */
2, /* PROCCALL . name params */
1, /* LABEL . name */
2, /* SWITCHLABEL . name index */
2, /* MULTI . simple multi? */
2, /* RECORDFIELD . left field */
2, /* ARRAYINDEX . array index */
2, /* SEQUENCE . stmnt following */
5, /* SWITCHDECL . name names? lower upper <more> */
1, /* COMMENT . "text" */
3, /* CONDITIONAL . if-or-unl cond thenpart */ /* NEEDS WORK - else buried in thenpart? */
1, /* FINISHELSE . elsepart */ /* could be else-if, simple UI, or nothing */
0, /* FINISH . */
0, /* LOOP . */
0, /* ENDLOOP . */
3, /* DECLARATION . type name */
0, /* ENDPROG . */
0, /* ENDFILE . */
0, /* ENDPERM . */
0, /* ENDLIST . */
0, /* ENDBLOCKPROCFN . */
6, /* PROCDEF . <TODO> */ /* being lazy */
3, /* OWNDEC . xown type owndec */
1, /* INCLUDE . "filename" */
1, /* BEGINBLOCK . {ENDPTR} */
3, /* ONEVENT . evno evlist {FINISHPTR} */
2, /* FINISHELSEIFSTART. <TODO> */
0, /* FINISHELSESTART . */
1, /* ASM . "string" */
1, /* DEFAULTCASE . name */
2, /* WHILE . cond stmnt */
2, /* UNTIL . cond stmnt */
1, /* ALIAS . "string" */
5, /* FORLOOP . body/hole var init inc final */
0, /* TYPE_LONGREAL . */
0, /* TYPE_LONGLONGREAL. */
1, /* ROUTINE . args */
1, /* PREDICATE . args */
3, /* FUNCTION . args type result */ // WHY RESULT?
3, /* MAP . args type result */ // ditto
1, /* ROUTINENAME . args */
1, /* PREDICATENAME . args */
2, /* FUNCTIONNAME . type args */
2, /* MAPNAME . type args */
/* THE FOLLOWING ITEMS NEED THEIR ARITIES TO BE CORRECTLY ENTERED */
2, /* PROCCALL_OR_ARRAY_OR_MAP . */
2, /* ARRAYDECLARATION . */
2, /* ARRAYFORMATDECLARATION . */
2, /* BOUND_PAIR . */
1, /* BREAK . */
1, /* CONTINUE . */
2, /* DECLARE_ARRAY . */
5, /* DOUBLE_SIDED . */
1, /* ELSE . */
3, /* ELSEIFORUNLESS . */
0, /* ELSESTART . */
3, /* FORMALPARAMETER . */
2, /* FUNCTION_PARAMETER . */
1, /* GOTO_LABEL . */
2, /* GOTO_SWITCH . */
1, /* INITCONST . */
3, /* INITCONSTARRAY . */
0, /* MONITOR . */
2, /* THENELSE . */
6, /* OWNARRAYDEC . */
2, /* RECORDFORMAT . */
2, /* RECORDFORMATDECLARATION . */
2, /* RECORDFORMATELEMENT . */
1, /* RECORDFORMATSPEC . */
2, /* RESULT . ASSOP EXPR */
0, /* RETURN . */
3, /* SIGNAL . */
0, /* STOP . */
0, /* TYPE_ARRAYNAME . */
0, /* TYPE_AUTO . */
0, /* TYPE_CONST . */
0, /* TYPE_DYNAMIC . */
0, /* TYPE_EXTERN . */
0, /* TYPE_EXTERNAL . */
0, /* TYPE_FORMAT . */
1, /* TYPE_GENERICNAME . */
0, /* TYPE_NAME . */
0, /* TYPE_OWN . */
0, /* TYPE_PRIM . */
0, /* TYPE_SYSTEM . */
2, /* VARIANTRECORDFORMAT . */
4, /* WHATEVER . */
3, /* OWNSCALARDEC . */
2, /* SUBSEQUENCE . inst seq */
1, /* REPEATUNTIL . cond */
0, /* RETURN_TRUE . */
0, /* RETURN_FALSE . */
3, /* C_IF_THEN_ELSE . if <cond> <thenpart> <elsepart> */
2, /* ELSEIFORUNLESSSTART . */
2, /* IFORUNLESSSTART . */
3, /* FINISHELSEIFORUNLESS . */
2, /* FINISHELSEIFORUNLESSSTART . */
10, /* VAR . blah blah blah */
0, /* TYPE_LABEL . basic */
};
char *Opname[] = {
"NONE",
"VAR_OR_FNCALL",
"RECORD",
"ARRAY_OR_FNMAP",
"CONST",
"LETTERCHARCONST",
"MONOP",
"BINOP",
"BRACKET",
"NUMERICLABEL",
"LINE",
"SPEC",
"TYPE_INTEGER",
"TYPE_REAL",
"TYPE_LONG",
"TYPE_STRING",
"TYPE_BYTE",
"TYPE_SHORT",
"TYPE_HALF",
"TYPE_RECORD",
"PARAMLIST",
"PROCCALL",
"LABEL",
"SWITCHLABEL",
"MULTI",
"RECORDFIELD",
"ARRAYINDEX",
"SEQUENCE",
"SWITCHDECL",
"COMMENT",
"CONDITIONAL",
"FINISHELSE",
"FINISH",
"LOOP",
"ENDLOOP",
"DECLARATION",
"ENDPROG",
"ENDFILE",
"ENDPERM",
"ENDLIST",
"ENDBLOCKPROCFN",
"PROCDEF",
"OWNDEC",
"INCLUDE",
"BEGINBLOCK",
"ONEVENT",
"FINISHELSEIFSTART",
"FINISHELSESTART",
"ASM",
"DEFAULTCASE",
"WHILE",
"UNTIL",
"ALIAS",
"FORLOOP",
"TYPE_LONGREAL",
"TYPE_LONGLONGREAL",
"ROUTINE",
"PREDICATE",
"FUNCTION",
"MAP",
"ROUTINENAME",
"PREDICATENAME",
"FUNCTIONNAME",
"MAPNAME",
"PROCCALL_OR_ARRAY_OR_MAP",
"ARRAYDECLARATION",
"ARRAYFORMATDECLARATION",
"BOUND_PAIR",
"BREAK",
"CONTINUE",
"DECLARE_ARRAY",
"DOUBLE_SIDED",
"ELSE",
"ELSEIFORUNLESS",
"ELSESTART",
"FORMALPARAMETER",
"FUNCTION_PARAMETER",
"GOTO_LABEL",
"GOTO_SWITCH",
"INITCONST",
"INITCONSTARRAY",
"MONITOR",
"THENELSE",
"OWNARRAYDEC",
"RECORDFORMAT",
"RECORDFORMATDECLARATION",
"RECORDFORMATELEMENT",
"RECORDFORMATSPEC",
"RESULT",
"RETURN",
"SIGNAL",
"STOP",
"TYPE_ARRAYNAME",
"TYPE_AUTO",
"TYPE_CONST",
"TYPE_DYNAMIC",
"TYPE_EXTERN",
"TYPE_EXTERNAL",
"TYPE_FORMAT",
"TYPE_GENERICNAME",
"TYPE_NAME",
"TYPE_OWN",
"TYPE_PRIM",
"TYPE_SYSTEM",
"VARIANTRECORDFORMAT",
"WHATEVER",
"OWNSCALARDEC",
"SUBSEQUENCE",
"REPEATUNTIL",
"RETURN_TRUE",
"RETURN_FALSE",
"C_IF_THEN_ELSE",
"ELSEIFORUNLESSSTART",
"IFORUNLESSSTART",
"FINISHELSEIFORUNLESS",
"FINISHELSEIFORUNLESSSTART",
"VAR",
"TYPE_LABEL",
};
// a VAR node is a universal data holder for symbol table entries,
// expressions etc. Will contain things like base, type, scope,
// size etc etc - maybe get some of the details from my own compilers101
// postings.
#define VAR_INTEGER 1
#define VAR_REAL 2
#define VAR_STRING 3
#define VAR_RECORD 4
// VAR strtag basetype arrayptr indirect function
// I think I also need a string pool, and a linked list in order to
// do symbol table lookups.
#define MAX_AST 0x100000
int AST[MAX_AST];
int ASTP = 100; /* leave room for crapping all over items at 0 */
// at some point I need to actually check the array for droppings and
// see if the potential bug ever actually existed...
int nextpool = 0;
#define MAX_POOL 0x100000
char stringpool[MAX_POOL];
#define MAX_STRING 0x10000
char *strings[MAX_STRING];
int nextfreestring = 0;
int isstr(int astp)
{
return(astp >= MAX_AST);
}
int addstr(char *s)
{
int i;
if (strcmp(s, "else")==0) s = "else_"; // crude hack to test renaming (wrong place)
for (i = 0; i < nextfreestring; i++) {
if (strcmp(s, strings[i]) == 0) return(MAX_AST+i);
}
strings[nextfreestring] = &stringpool[nextpool];
nextpool += (strlen(s)+1);
strcpy(strings[nextfreestring], s);
return(MAX_AST + nextfreestring++);
}
char *notc(char *s) {
// Unfortunately this gets called for text inside strings too!
// it'll do just to get something going, but the whole concept needs rework.
if (strcmp(s, "char") == 0) return "_char_";
if (strcmp(s, "int") == 0) return "_int_";
if (strcmp(s, "float") == 0) return "_float_";
if (strcmp(s, "double") == 0) return "_double_";
if (strcmp(s, "label") == 0) return "_label_";
if (strcmp(s, "const") == 0) return "_const_";
return s;
}
char *str_(int astp, int line, char *file)
{
// we may be able to intercept keywords here?
if ((astp - MAX_AST) < MAX_STRING) return(notc(strings[astp - MAX_AST]));
//fprintf(stderr, "Warning: old-style string str(%c%s%c) at %s:%d\n", DQUOTE, (char *)astp, DQUOTE, file, line);
//return (char *)astp;
if (strlen((char *)astp) > 1) {
return notc((char *)astp); // fix needed for '''' or '\\' or '\''
} else {
return (strdup(strcat(notc((char *)astp), " /* Old style string quotes? */")));
}
}
#define str(a) ((char *)str_((int)(a), __LINE__, __FILE__))
int entrypoint = 0; /* This is the pointer to our compiled program.
Linked list terminated by 0 */
// in transitional code, these do nothing except pass on the hacky
// pointer; as soon as all locations where this hack is used are
// identified, we'll convert it into using a string pool instead,
// and maybe as an interim measure use "0x40000000" as a flag bit to
// escape the astp as a stringpool index.
char *ccharconst(int type, char *s)
{
char line[1024];
char *t;
int c;
t = line;
switch (type) {
case 'c':
c = *s++;
if (c == SQUOTE) return((char *)sformatf("%c%c%c%c", SQUOTE, BSLASH, SQUOTE, SQUOTE));
if (c == '\n') return((char *)sformatf("%c%c%c%c", SQUOTE, BSLASH, 'n', SQUOTE));
if (c == BSLASH) return((char *)sformatf("%c%c%c%c", SQUOTE, BSLASH, BSLASH, SQUOTE));
return((char *)sformatf("%c%c%c", SQUOTE, c, SQUOTE));
break;
case 'M':
// 'xxxx' - non-std gnu extension for multi-char constants
*t++ = SQUOTE;
{int i;
for (i = 0; i < strlen(s); i++) {
c = s[i];
if (c == BSLASH) { *t++ = c; *t++ = c;}
else if (c == '\n') { *t++ = BSLASH; *t++ = 'n'; }
else if (c == SQUOTE) { *t++ = BSLASH; *t++ = SQUOTE; }
else *t++ = c;
}
}
*t++ = SQUOTE;
*t++ = '\0';
return((char *)sformatf("%s", line));
case 'R':; // R'FFFF' is a long real expressed as hex, I think
return((char *)sformatf("(float)0x%s", s));
case 'X':
// hex
return((char *)sformatf("0x%s", s));
case 'B':
{
// no binary in C so convert to hex
long i = 0L;
for (;;) {
if (*s == '\0') break;
assert(*s == '0' || *s == '1');
i = (i << 1L) | (*s++ - '0');
}
return((char *)sformatf("0x%0x", i));
}
case 'K':
// octal 0777
return((char *)sformatf("0%s", s));
case 'H':
// hex 0xFFFF
return((char *)sformatf("0x%s", s));
case 'C':
case 'D':
assert(0==1);
}
}
void debug_ast(int t)
{
int arg;
if (isstr(t) || (AST[t] > LAST_ITEM) || (AST[t] < 0)) {
fprintf(stdout, "AST[%d] = %d *** Out of range!\n", t, AST[t]); exit(1);
}
if (!_debug) return;
fprintf(stdout, "// AST %d: ", t); fflush(stdout);
fprintf(stdout, "%s", Opname[AST[t]]); fflush(stdout);
if (Arity[AST[t]] > 0) {
for (arg = 1; arg <= Arity[AST[t]]; arg++) {
if (isstr(AST[t+arg])) {
fprintf(stdout, " %s", str(AST[t+arg])); fflush(stdout);
} else {
fprintf(stdout, " %d", AST[t+arg]); fflush(stdout);
}
}
}
fprintf(stdout, "\n");
}
/* codegen outputs an AST either as a sequence of statements (including */
/* semicolons after each, if needed) or as a single sttement, eg one */
/* that could be used in "if (cond) then statement1; else statement2;" */
/* In other words if single_statement is true and the parameter is a */
/* sequence, it will be output as "{ statement1; statement2; }" with */
/* no terminating ";" after it. */
/* items which are not statements (eg expressions) are never output */
/* with "{}" or ";" ((though later they might be output as bracketed */
/* comma-expressions)) */
#define SINGLE_STATEMENT 1
#define MULTIPLE_STATEMENTS 2
#define SUB_EXPR 3
int maketuple(int type, ...);
int reverse_list(int astp)
{
int next, link, ap = astp, i, stmntcount = 0;
while (AST[astp] == SEQUENCE) {
stmntcount += 1;
astp = AST[astp+2];
if (astp == 0) break;
}
int temp[stmntcount];
astp = ap;
while (AST[astp] == SEQUENCE) {
stmntcount -= 1;
temp[stmntcount] = AST[astp+1];
astp = AST[astp+2];
if (astp == 0) break;
}
entrypoint = 0;
astp = ap;
while (AST[astp] == SEQUENCE) {
if (entrypoint == 0) {
entrypoint = maketuple(SEQUENCE, temp[stmntcount], HOLE);
link = entrypoint+2;
} else {
next = maketuple(SEQUENCE, temp[stmntcount], HOLE);
AST[link] = next;
link = next+2;
}
stmntcount += 1;
astp = AST[astp+2];
if (astp == 0) break;
}
astp = entrypoint;
for (i = 0; i < stmntcount; i++) {
//fprintf(stdout, "@%d: STATEMENT at %d, link=%d\n", astp, AST[astp+1], AST[astp+2]);
astp = AST[astp+2];
}
return entrypoint;
}
//++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
#ifdef NEVER
case RETURN:
// for cleanness, hook into current proc/fn/map/begin (yes, begin)
break;
case RESULT: // ignoring astp+1 which is assop :-(
// hook into current fn/map
//fixup(AST[astp+2], 1);
break;
case RETURN_TRUE:
// hook into current predicate
break;
case RETURN_FALSE:
// hook into current predicate
break;
#endif
void codegen(int astp, int single_statement)
{
// the stack is for *lexical* (i.e. imp source-level) scope only
#define SCOPE_BEGIN 1
#define SCOPE_EVENT_START 2
#define SCOPE_PROCFNMAPDEF 3
#define SCOPE_MAIN 4
#define SCOPE_FORLOOP 5
#define SCOPE_WHILELOOP 6
#define SCOPE_UNTILLOOP 7
#define SCOPE_LOOP 8
#define SCOPE_THENSTART 9
#define SCOPE_ELSESTART 10
static int scope, stackp = 0;
static int scope_stack[1024];
static int ast_stack[1024];
static int extra_stack[1024];
void push_scope(int scope, int astp, int extra)
{
assert(stackp < 1024);
ast_stack[stackp] = astp;
scope_stack[stackp] = scope;
extra_stack[stackp] = extra;
stackp += 1;
//fprintf(stdout, "// PUSH %d, stackp after = %d\n", scope, stackp);
}
int pop_scope(int *astp, int *extra)
{
int scope;
int i = stackp;
if (stackp <= 0) {
fprintf(stdout, "{ASSERTION: stackp <= 0 ... %d}", stackp);
stackp = 0;
return scope_stack[0];
// assert(stackp > 0);
}
stackp -= 1;
*astp = ast_stack[stackp];
*extra = extra_stack[stackp];
scope = scope_stack[stackp];
//fprintf(stdout, "// POP -> %d [@%d], stackp before = %d\n", scope, *astp, i);
return(scope);
}
#define EVAL_RVALUE 1
#define EVAL_LVALUE 2
// eg for *ptr = *ptr + 1
#define EVAL_ADDRESS 3
// eg for ptr1 == ptr2
void eval(int astp, int a_or_v) // evaluate the value or the address
{
if (isstr(astp)) {
fprintf(stdout, "%s%s", str(astp), (_debug?"/*V1*/":""));
} else if (AST[astp] == RECORDFIELD) {
eval(AST[astp+1], EVAL_RVALUE);
if (0) { // WE NEED TO KNOW IF THE OBJECT IS A %name OR NOT.
fprintf(stdout, ".");
} else { // for now we'll handle all record subfields as being via pointers
fprintf(stdout, "->");
}
eval(AST[astp+2], EVAL_RVALUE);
} else if (AST[astp] == VAR_OR_FNCALL) {
fprintf(stdout, "%s%s", str(AST[astp+1]), (_debug?"/*V2*/":"")); /* or %s() if FNCALL */
} else if (AST[astp] == PROCCALL_OR_ARRAY_OR_MAP) {
eval(AST[astp+1], EVAL_RVALUE);
fprintf(stdout, "("); /* or *%s() if CALL and/or MAP */
eval(AST[astp+2], EVAL_RVALUE); // TODO: if it is a MULTI, use "][" between items, not ","
fprintf(stdout, ")");
} else if (AST[astp] == ARRAY_OR_FNMAP) {
if ((isstr(AST[astp+1])) && (strcmp(str(AST[astp+1]), "charno") == 0)) { /*check scope of decln */
assert(AST[AST[astp+2]] == MULTI);
eval(AST[AST[astp+2]+1], EVAL_RVALUE);
fprintf(stdout, "(("); /* or *%s() if FN or MAP */
eval(AST[AST[astp+2]+2], EVAL_RVALUE); // TODO: use "][" between items, not ","
fprintf(stdout, ")-1)");
} else if ((isstr(AST[astp+1])) && (strcmp(str(AST[astp+1]), "length") == 0)) { /*check scope of decln */
fprintf(stdout, "strlen("); /* or *%s() if FN or MAP */
eval(AST[astp+2], EVAL_RVALUE);
fprintf(stdout, ")");
} else if (isstr(AST[astp+1])) {
eval(AST[astp+1], EVAL_RVALUE);
fprintf(stdout, "("); /* or *%s() if FN or MAP */
eval(AST[astp+2], EVAL_RVALUE);
fprintf(stdout, ")");
} else {
eval(AST[astp+1], EVAL_RVALUE);
fprintf(stdout, "("); /* or *%s() if FN or MAP */
eval(AST[astp+2], EVAL_RVALUE);
fprintf(stdout, ")");
}
} else if (AST[astp] == CONST) {
/* CHECK TYPE FIRST! (more than the crude check below) */
if (AST[astp+1] == STRING) putchar(34);
fprintf(stdout, "%s", str(AST[astp+2]));
if (AST[astp+1] == STRING) putchar(34);
fprintf(stdout, "%s", (_debug?"/*V3*/":""));
} else if (AST[astp] == LETTERCHARCONST) {
/* CHECK TYPE FIRST! (more than the crude check below) */
// putchar(SQUOTE); -- now stored in the string itself
fprintf(stdout, "%s%s", str(AST[astp+1]), (_debug?"/*V4*/":""));
// putchar(SQUOTE);
} else if (AST[astp] == BRACKET) {
fprintf(stdout, "(");
eval(AST[astp+1], EVAL_RVALUE);
fprintf(stdout, ")");
} else if (AST[astp] == MULTI) {
eval(AST[astp+1], EVAL_RVALUE);
if (AST[astp+2] != 0) {
fprintf(stdout, ", ");
eval(AST[astp+2], EVAL_RVALUE);
}
} else if (AST[astp] == ARRAYINDEX) {
eval(AST[astp+1], EVAL_RVALUE);
fprintf(stdout, "("); // need to handle MULTI-dimensional bounds properly
eval(AST[astp+2], EVAL_RVALUE);
fprintf(stdout, ")");
} else if (AST[astp] == PROCCALL) {
if (AST[astp+2] != NONE) { // params?
// look up name, if it is a routinename parameter, may need
// special handling?
fprintf(stdout, "%s%s(", str(AST[astp+1]), (_debug?"/*V5*/":""));
eval(AST[astp+2], EVAL_RVALUE);
fprintf(stdout, ")\n");
} else {
fprintf(stdout, "%s%s()\n", str(AST[astp+1]), (_debug?"/*V1*/":""));
}
} else if (AST[astp] == MONOP) {
switch (AST[astp+1]) {
case UOP_POS:
eval(AST[astp+2], EVAL_RVALUE);
break;
case UOP_NEG:
/* need a 'prio' procedure which outputs brackets IF brackets */
/* are needed; eg following '-' it must be an atom, and no brackets */
/* are needed, but if the expr contains a binop, then one is */
/* needed. I suspect that the same thing can be done with */
/* binops, looking at the prios of the binop itself and of */
/* the two children. if the children bind tighter than the */
/* parent, no extra parentheses are needed. */
fprintf(stdout, "(-(");
eval(AST[astp+2], EVAL_RVALUE); // TO DO: AVOID EXTRA BRACKETS IF ATOMIC
fprintf(stdout, "))");
break;
case UOP_LOGNOT:
fprintf(stdout, "(!("); /* is that correct C??? */
eval(AST[astp+2], EVAL_RVALUE);
fprintf(stdout, "))");
break;
case UOP_BITNOT:
fprintf(stdout, "(~("); /* is that correct C??? */
eval(AST[astp+2], EVAL_RVALUE);
fprintf(stdout, "))");
break;
case UOP_ABS:
fprintf(stdout, "abs("); /* is that correct C??? */
eval(AST[astp+2], EVAL_RVALUE);
fprintf(stdout, ")");
break;
case UOP_DEBUG:
fprintf(stdout, "DEBUGITEM("); /* is that correct C??? */
eval(AST[astp+2], EVAL_RVALUE);
fprintf(stdout, ")");
break;
default:
assert(FALSE);
}
} else if (AST[astp] == BINOP) {
// **** MAJOR 'TO DO' HERE!!! ****
// This is where we must take a sequence of A op B op C etc and apply Imp operator precedence rules
// to rotate nodes and correct the tree structure. Having done that, we need to output the expression
// using *C*'s precedence - where << is lower than + unlike Imp.
// Or we could rewrite the grammar as multi-level so that the Imp precedence is applied automatically.
// Still need the unparsing to C though (unless we bracket *everything* which is ugly)
/*
Algorithm for printing with minimal brackets...
int cprec(int OP);
#define type(n) AST[n+0]
#define op(n) AST[n+1]
#define lhs(n) AST[n+2]
#define rhs(n) AST[n+3]
ASSUMING tree already reflects true expression, (which it doesn't, yet)
if type(astp) == BINOP && ( type(lhs(astp)) == BINOP || type(rhs(astp)) == BINOP )
if type(lhs(astp)) == BINOP && cprec(op(lhs(astp))) < cprec(op(astp)) put "(",eval(lhs(astp)),")"
put op(astp)
if type(rhs(astp)) == BINOP && cprec(op(rhs(astp)) < cprec(op(astp)) put "(",eval(rhs(astp)),")"
*/
switch (AST[astp+1]) {
case OP_AND:
fprintf(stdout, "(");
eval(AST[astp+2], EVAL_RVALUE);
fprintf(stdout, " && ");
eval(AST[astp+3], EVAL_RVALUE);
fprintf(stdout, ")");
break;
case OP_OR:
fprintf(stdout, "(");
eval(AST[astp+2], EVAL_RVALUE);
fprintf(stdout, " || ");
eval(AST[astp+3], EVAL_RVALUE);
fprintf(stdout, ")");
break;
case OP_PTRASSIGN:
// eg %integername p1, p2, %integer v1
// p1 == v1 => p1 = &v1;
// p1 == p2 => p1 = p2;
// p1 = p2 => *p1 = *p2;
eval(AST[astp+2], EVAL_ADDRESS);
fprintf(stdout, " = ");
eval(AST[astp+3], EVAL_ADDRESS);
fprintf(stdout, " /* Pointer assignment */");
fprintf(stdout, ";\n");
break;
case OP_JAMTRANSFER:
// like assign, but with a cast if byte or short int,
// and with strncpy if string
case OP_ASSIGN: // astp:BINOP OP_ASSIGN LHS RHS
{ /* due to imp syntax this is a statement, not a SUB_EXPR */
int lhs = AST[astp+2];
if ((!isstr(lhs)) && (AST[lhs] == PROCCALL_OR_ARRAY_OR_MAP) && (AST[lhs+1] > MAX_AST) && (strcmp(str(AST[lhs+1]), "length") == 0)) {
/* length(lhs) = n => lhs[n] = '\0' */
eval(AST[lhs+2], EVAL_LVALUE);
fprintf(stdout, "(");
eval(AST[astp+3], EVAL_RVALUE);
fprintf(stdout, ") = %c%c0%c;", SQUOTE,BSLASH,SQUOTE);
break;
} else {
{
int rhs = AST[astp+3];
// TO DO s = a.b."xxx".d => sprintf(s, "%s%sxxx%s", a, b, d);
if ((!isstr(rhs)) && (AST[rhs] == CONST) && (AST[rhs+1] == STRING)) {
/* lhs = "..." => strcpy(lhs, "...") */
fprintf(stdout, "strcpy(");
eval(AST[astp+2], EVAL_RVALUE);
fprintf(stdout, ", ");
eval(AST[astp+3], EVAL_RVALUE); /* should optimise for empty string => *lhs = '\0' */
fprintf(stdout, ");");
break;
}
/* AST 10043: LINE 470 JUNK=JUNK."0"ifCHARNO(JUNK,LENGTH(JUNK))='0' */
/* AST 10046: SEQUENCE 10040 10043 */
/* AST 10049: VAR_OR_FNCALL junk */
/* AST 10051: CONST 3 0 */
/* AST 10054: rhs:BINOP OP_CONCAT 0 10051 */
/* AST 10058: astp:BINOP 4 lhs=junk 10054 */
/* 135156224,10054 */
/* junk = concat (junk, "0"); */
if ((isstr(lhs)) && ((!isstr(rhs)))) {
if (AST[rhs] == BINOP) {
if (isstr(AST[AST[rhs+2]+1]) && isstr(lhs) &&
strcmp(str(AST[AST[rhs+2]+1]), str(lhs)) == 0) { /* one check short... */
if (AST[rhs+1] == OP_CONCAT) {
fprintf(stdout, "strcat(");
eval(AST[astp+2], EVAL_RVALUE);
fprintf(stdout, ", ");
eval(AST[rhs+3], EVAL_RVALUE);
fprintf(stdout, ")");
} else if (AST[rhs+1] == OP_ADD && (AST[AST[rhs+3]] != BINOP)) {/* should be table-driven */
eval(AST[astp+2], EVAL_LVALUE);
fprintf(stdout, " += ");
eval(AST[rhs+3], EVAL_RVALUE);
} else if (AST[rhs+1] == OP_SUB && (AST[AST[rhs+3]] != BINOP)) {
eval(AST[astp+2], EVAL_LVALUE);
fprintf(stdout, " -= ");
eval(AST[rhs+3], EVAL_RVALUE);
} else {
eval(AST[astp+2], EVAL_LVALUE);
fprintf(stdout, " = ");
eval(AST[astp+3], EVAL_RVALUE);
}
fprintf(stdout, ";\n");
break;
}
}
}
}
eval(AST[astp+2], EVAL_LVALUE);
fprintf(stdout, " = ");
eval(AST[astp+3], EVAL_RVALUE);
fprintf(stdout, ";\n");
}
}
break;
case OP_STRINGRESOLVE:
fprintf(stdout, "(void)imp_resolve(%c...%c); /* temp */\n", DQUOTE, DQUOTE);
break;
case OP_LE:
eval(AST[astp+2], EVAL_RVALUE);
fprintf(stdout, " <= ");
eval(AST[astp+3], EVAL_RVALUE);
break;
case OP_GE:
eval(AST[astp+2], EVAL_RVALUE);
fprintf(stdout, " >= ");
eval(AST[astp+3], EVAL_RVALUE);
break;
case OP_GT:
eval(AST[astp+2], EVAL_RVALUE);
fprintf(stdout, " > ");
eval(AST[astp+3], EVAL_RVALUE);
break;
case OP_LT:
eval(AST[astp+2], EVAL_RVALUE);
fprintf(stdout, " < ");
eval(AST[astp+3], EVAL_RVALUE);
break;
case OP_PTREQ:
// make sure both left and right are pointers, and output simple "=="
case OP_EQ:
{
int rhs = AST[astp+3];
if (AST[rhs] == CONST && AST[rhs+1] == STRING) {
fprintf(stdout, "(strcmp(");
eval(AST[astp+2], EVAL_RVALUE);
fprintf(stdout, ", ");
eval(AST[astp+3], EVAL_RVALUE);
fprintf(stdout, ") == 0)");
break;
}
}
eval(AST[astp+2], EVAL_RVALUE);
fprintf(stdout, " == ");
eval(AST[astp+3], EVAL_RVALUE);
break;
case OP_PTRNE:
// check types of operands
case OP_NE:
{
int rhs = AST[astp+3];
if (AST[rhs] == CONST && AST[rhs+1] == STRING) {
fprintf(stdout, "strcmp(");
eval(AST[astp+2], EVAL_RVALUE);
fprintf(stdout, ", ");
eval(AST[astp+3], EVAL_RVALUE);
fprintf(stdout, ")");
break;
}
}
eval(AST[astp+2], EVAL_RVALUE);
fprintf(stdout, " != ");
eval(AST[astp+3], EVAL_RVALUE);
break;
case OP_TESTRESOLVE:
if (AST[AST[astp+3]] == BRACKET) { /* I.e. only one param, S -> ("lit") */
int param = AST[AST[astp+3]+1];
if ((AST[param] == CONST) &&
(AST[param+1] == STRING) &&
(strlen(str(AST[param+2])) == 1)) {
/* AST 1608: LINE 82 elseifS->("EXT") */
/* AST 1611: SEQUENCE 1605 1608 */
/* AST 1614: VAR_OR_FNCALL s */
/* AST 1616: CONST 3 EXT */
/* AST 1619: BRACKET 1616 */
/* AST 1621: BINOP 14 1614 1619 */
/* AST 1625: FINISHELSEIFSTART 16 1621 */
/* AST 1628: SEQUENCE 1611 1625 */
/* AST 6987: CONST 3 OUT */
/* AST 6990: BRACKET 6987 */
/* AST 6992: BINOP 14 6985 6990 */
fprintf(stdout, "strchr(");
eval(AST[astp+2], EVAL_RVALUE);
fprintf(stdout, ", %c%c%c)", SQUOTE,*str(AST[param+2]),SQUOTE);
} else {
fprintf(stdout, "strstr(");
eval(AST[astp+2], EVAL_RVALUE);
fprintf(stdout, ", ");
eval(AST[astp+3], EVAL_RVALUE);
fprintf(stdout, ")");
}
} else {
fprintf(stdout, "imp_resolve(");
eval(AST[astp+2], EVAL_RVALUE);
fprintf(stdout, ", ");
// REPLACE THE SIMPLE CODEGEN WITH MORE COMPLEX CODE WHICH
// BUILDS UP A FORMAT STRING, WHERE (X) -> %s and "lit" -> string
// eval(AST[astp+3], EVAL_RVALUE);
fprintf(stdout, "%c... fill in later ...%c)", DQUOTE, DQUOTE);
}
break;
case OP_IF:
case OP_UNLESS:
debug_ast(astp);
break;
case OP_ADD:
eval(AST[astp+2], EVAL_RVALUE);
fprintf(stdout, " + ");
eval(AST[astp+3], EVAL_RVALUE);
break;
case OP_SUB:
eval(AST[astp+2], EVAL_RVALUE);
fprintf(stdout, " - ");
eval(AST[astp+3], EVAL_RVALUE);
break;
case OP_BITAND:
eval(AST[astp+2], EVAL_RVALUE);
fprintf(stdout, " & ");
eval(AST[astp+3], EVAL_RVALUE);
break;
case OP_IEXP:
fprintf(stdout, "iexp(");
eval(AST[astp+2], EVAL_RVALUE);
fprintf(stdout, ", ");
eval(AST[astp+3], EVAL_RVALUE);
fprintf(stdout, ")");
break;
case OP_EXP:
fprintf(stdout, "exp(");
eval(AST[astp+2], EVAL_RVALUE);
fprintf(stdout, ", ");
eval(AST[astp+3], EVAL_RVALUE);
fprintf(stdout, ")");
break;
case OP_MUL:
eval(AST[astp+2], EVAL_RVALUE);
fprintf(stdout, " * ");
eval(AST[astp+3], EVAL_RVALUE);
break;
case OP_EOR:
eval(AST[astp+2], EVAL_RVALUE);
fprintf(stdout, " ^ ");
eval(AST[astp+3], EVAL_RVALUE);
break;
case OP_IOR:
eval(AST[astp+2], EVAL_RVALUE);
fprintf(stdout, " | ");
eval(AST[astp+3], EVAL_RVALUE);
break;
case OP_IDIV:
fprintf(stdout, "((int)(");
eval(AST[astp+2], EVAL_RVALUE);
fprintf(stdout, ") / (int)(");
eval(AST[astp+3], EVAL_RVALUE);
fprintf(stdout, "))");
break;
case OP_RDIV:
fprintf(stdout, "((float)(");
eval(AST[astp+2], EVAL_RVALUE);
fprintf(stdout, ") / (float)(");
eval(AST[astp+3], EVAL_RVALUE);
fprintf(stdout, "))");
break;
case OP_SHR:
eval(AST[astp+2], EVAL_RVALUE);
fprintf(stdout, " >> ");
eval(AST[astp+3], EVAL_RVALUE);
break;
case OP_SHL:
eval(AST[astp+2], EVAL_RVALUE);
fprintf(stdout, " << ");
eval(AST[astp+3], EVAL_RVALUE);
break;
case OP_CONCAT: // check for str = str.rest and use strcat
fprintf(stdout, "concat(");
eval(AST[astp+2], EVAL_RVALUE);
fprintf(stdout, ", ");
eval(AST[astp+3], EVAL_RVALUE);
fprintf(stdout, ")");
break;
default:
debug_ast(astp);
}
} else {
fprintf(stderr, "eval(): not MONOP or BINOP: %d\n", astp);
exit(1);
}
}
auto void print_type(int type) {
if (AST[type] == TYPE_INTEGER) {
fprintf(stdout, "int ");
} else if (AST[type] == TYPE_LONG) {
fprintf(stdout, "long ");
} else if (AST[type] == TYPE_SHORTINTEGER) {
fprintf(stdout, "short ");
} else if (AST[type] == TYPE_HALFINTEGER) {
fprintf(stdout, "unsigned short ");
} else if (AST[type] == TYPE_BYTEINTEGER) {
fprintf(stdout, "unsigned char ");
} else if (AST[type] == TYPE_REAL) {
fprintf(stdout, "float ");
} else if (AST[type] == TYPE_LONGREAL) {
fprintf(stdout, "double ");
} else if (AST[type] == TYPE_LONGLONGREAL) {
fprintf(stdout, "long double ");
} else if (AST[type] == TYPE_STRING) {
fprintf(stdout, "char *");
} else if (AST[type] == TYPE_STRING) {
fprintf(stdout, "__label__ "); // https://www.geeksforgeeks.org/local-labels-in-c/
} else if (AST[type] == TYPE_RECORD) {
fprintf(stdout, "%s ", str(AST[type+1]));
} else {
fprintf(stdout, "/*resulttype*/ ");
}
}
/* To do: patch up various conditionals so that they
all call C_IF_THEN_ELSE */
int arg;
int /*p,*/ startp, extra;
//fprintf(stdout, "CODEGEN: %d %d\n", astp, single_statement);
if (astp == 0) return;
if (isstr(astp)) {
/* This is a hack... anything >= MAX_AST is assumed to be a name to be printed! */
/*fprintf(stderr, "ERROR: astp = %d\n", astp); */
/*fprintf(stderr, " %s\n", (char *)astp); */
fprintf(stdout, "%s%s", str(astp), (_debug?"/*X*/":""));
return;
}
if (isstr(astp) || AST[astp] > LAST_ITEM) {
fprintf(stdout, " *** Out of range!\n"); exit(1);
}
//debug_ast(astp);
if (AST[astp] == BINOP) {
eval(astp, EVAL_RVALUE);
return;
}
switch(AST[astp]) {
case SUBSEQUENCE:
fprintf(stdout, "{");
for (;;) {
assert(AST[astp] == SUBSEQUENCE);
codegen(AST[astp+1], SINGLE_STATEMENT);
if (AST[astp+2] == 0 /* Link cell */) break;
astp = AST[astp+2];
}
fprintf(stdout, "}");
return;
case SEQUENCE:
/* SEQUENCE is always a link followed by a statement */
/* would have been more consistent (lisp-like) to have them */
/* the other way around. May fix later. */
codegen(AST[astp+1], SINGLE_STATEMENT);
codegen(AST[astp+2], MULTIPLE_STATEMENTS);
break;
case INCLUDE:
{char *include = str(AST[AST[astp+1]+2]);
if (strcmp(include+strlen(include)-4, ".imp") == 0) {
include[+strlen(include)-4] = '\0';
fprintf(stdout, "\n#include %c%s.h%c\n", DQUOTE,
include,
DQUOTE);
} else if (strcmp(include+strlen(include)-2, ".i") == 0) {
include[strlen(include)-2] = '\0';
fprintf(stdout, "\n#include %c%s.h%c\n", DQUOTE,
include,
DQUOTE);
} else {
fprintf(stdout, "\n#include %c%s.h%c\n", DQUOTE,
include,
DQUOTE);
}
}
break;
case LINE:
/*fprintf(stdout, "#line %d\n", AST[astp+1]); */
/* fprintf(stdout, " / * %s * /\n", str(AST[astp+2])); */
break;
case COMMENT:
fprintf(stdout, " // %s\n", str(AST[astp+1]));
break;
case ASM:
fprintf(stdout, "asm(%c%s%c);\n", DQUOTE,str(AST[astp+1]),DQUOTE);
break;
case PROCCALL:
eval(astp, EVAL_RVALUE);
fprintf(stdout, ";\n");
break;
case GOTO_LABEL:
fprintf(stdout, "goto %s;\n", str(AST[astp+1]));
break;
//SWITCHDEC: <NAME><NLISTquote>"\("<EXPR>":"<EXPR>"\)"<RESTOFSWLIST> {
// $$ = maketuple(SWITCHDECL, $1, $2, $4, $6, $8);
case SWITCHDECL:
// A VERY QUICK HACK FOR SINGLE SWITCH DECL JUST TO TEST THE GENERATED CODE:
fprintf(stdout, "static void *%s[/*bounds*/] = { &&%s_default };\n", str(AST[astp+1]), str(AST[astp+1]));
break;
case GOTO_SWITCH:
// fprintf(stdout, "{_sw = ");
// eval(AST[astp+2], EVAL_RVALUE);
// fprintf(stdout, "; goto dispatch_%s;}\n", str(AST[astp+1]));
fprintf(stdout, "goto *%s[", str(AST[astp+1]));
eval(AST[astp+2], EVAL_RVALUE);
fprintf(stdout, "];\n");
break;
case SWITCHLABEL:
if (AST[astp+2] == 0) {
/* simple label */
fprintf(stdout, "%s:\n", str(AST[astp+1]));
} else {
/* switch label */
/* fprintf(stdout, "%s(", str(AST[astp+1])); */
/* codegen(AST[astp+2], depth+1); */
/* fprintf(stdout, "):\n"); */
fprintf(stdout, "%s_", str(AST[astp+1]));
/* TODO: fix L_'A' -> L_65, and negative values */
eval(AST[astp+2], EVAL_RVALUE); /* emit const as simple int */
// maybe something like:
// eval(maketuple(CONVERT_TO_LABEL, AST[astp+2]), EVAL_RVALUE); /* emit const as simple int */
fprintf(stdout, ": /* ");
eval(AST[astp+2], EVAL_RVALUE); /* and as symbol in comments */
fprintf(stdout, " */\n");
}
break;
case NUMERICLABEL:
fprintf(stdout, "L_%s:\n", str(AST[astp+1]));
break;
case MONITOR:
fprintf(stdout, "assert(_IMP_MONITOR_);");
break;
case STOP:
fprintf(stdout, "exit(0);");
break;
case BEGINBLOCK: /* need to check level. if not 0, just emit { */
{
if (stackp == 0) { // outer-level %begin
fprintf(stdout, "int main(int argc, char **argv) {\n");
push_scope(SCOPE_MAIN, astp, 0);
} else {
static int unique = 0;
unique += 1;
fprintf(stdout, "\nauto inline void block_%0d(void) {\n", unique);
// if we want to use patched up value AST[astp+1], we need a
// fixup pass, *or* run codegen with output to /dev/null
push_scope(SCOPE_BEGIN, astp, unique);
// TODO!!!! Need to *call* the procedure on the %end
}
}
break;
case ONEVENT:
assert(AST[astp+3] == HOLE);
push_scope(SCOPE_EVENT_START, astp, 0);
// matched up with finish, stored in extra arg.
fprintf(stdout, "auto inline void signal_event(int event, int subevent, int extra) {\n" /*, AST[astp+3]*/);
break;
// AST 111: LINE 2 routineR1
// AST 114: SEQUENCE 111 108
// AST 117: ROUTINE 0
// AST 119: PROCDEF 0 117 0 r1 0 0
// void r1 (void)
// AST 139: LINE 4 routineR2(integerI)
// AST 142: SEQUENCE 139 136
// AST 145: ROUTINE 0
// AST 147: TYPE_INTEGER
// AST 148: MULTI i 0
// AST 151: FORMALPARAMETER 147 0 148
// AST 155: PARAMLIST 151 0
// AST 158: PROCDEF 0 145 0 r2 0 155
// void r2 (int i)
// AST 1068: LINE 37 routineREFILL(byteintegermapX(integerI,J),integerN,integernameCOUNT)
// AST 1071: SEQUENCE 1068 1065
// AST 1074: ROUTINE 0
// AST 1076: TYPE_BYTE
// AST 1077: MAP 0 1076
// AST 1080: TYPE_INTEGER
// AST 1081: MULTI j 0
// AST 1084: MULTI i 1081
// AST 1087: FORMALPARAMETER 1080 0 1084
// AST 1091: PARAMLIST 1087 0
// AST 1094: MULTI x 0
// AST 1097: FUNCTION_PARAMETER 1077 1094
// AST 1100: TYPE_INTEGER
// AST 1101: MULTI n 0
// AST 1104: FORMALPARAMETER 1100 0 1101
// AST 1108: TYPE_INTEGER
// AST 1109: TYPE_NAME
// AST 1110: MULTI count 0
// AST 1113: FORMALPARAMETER 1108 1109 1110
// AST 1117: PARAMLIST 1113 0
// AST 1120: PARAMLIST 1104 1117
// AST 1123: PARAMLIST 1097 1120
// AST 1126: PROCDEF 0 1074 0 refill 0 1123
// AST 1133: SEQUENCE 1126 1071
case PROCDEF: // %SEX[1] %RT[2] %spec[3] name[4] %alias[5] params[6]
{
int rt, paramlist, multi, formalparam;
int pendingcomma = 0;
int Parameterless_fn;
char *function_name;
function_name=str(AST[astp+4]);
fprintf(stdout, "\n#ifdef %s\n#undef %s // just in case\n#endif\n", function_name, function_name); // TEMP HACK
if ((stackp == 0) && (AST[astp+1] == 0)) fprintf(stdout, "static ");
else if ((stackp > 0) && (AST[astp+1] == 0)) fprintf(stdout, "auto ");
if (AST[astp+3] != SPEC) push_scope(SCOPE_PROCFNMAPDEF, astp, 0);
Parameterless_fn = TRUE;
rt = AST[astp+2];
if (AST[rt] == ROUTINE) { // args[1]
Parameterless_fn = FALSE; // a %routine with no parameters is determinable by the grammar
fprintf(stdout, "void ");
} else if (AST[rt] == FUNCTION || AST[rt] == MAP) { // args[1] type[2] result[3]
int type = AST[rt+2];
print_type(type); // MAX LENGTH OF RESULT IS IN str(AST[AST[type+1]+2]))
} else if (AST[rt] == PREDICATE) { // args[1]
fprintf(stdout, "int ");
} else {
fprintf(stdout, "/*unknown object*/ ");
}
if (AST[rt] == MAP) fprintf(stdout, "*");
//if ((AST[astp+2] != 0) && (AST[AST[astp+2]] == TYPE_NAME)) fprintf(stdout, "*"); // %name (UNTESTED)
fprintf(stdout, "%s(", function_name=str(AST[astp+4]));
paramlist = AST[astp+6];
assert(paramlist == 0 || AST[paramlist] == PARAMLIST);
if (paramlist == 0) {
fprintf(stdout, "void");
} else {
Parameterless_fn = FALSE; // Fn call with parameters is recognisable too.
while (paramlist != 0) {
formalparam = AST[paramlist+1];
if (AST[formalparam] == FUNCTION_PARAMETER) {
fprintf(stdout, "/* procedure parameter */");
paramlist = AST[paramlist+2];
} else if (AST[formalparam] == FORMALPARAMETER) {
multi = AST[formalparam+3];
for (;;) {
if (multi == 0) break;
assert(AST[multi] == MULTI);
if (pendingcomma != 0) fprintf(stdout, ", ");
print_type(AST[formalparam+1]);
if (AST[AST[formalparam+2]] == TYPE_NAME) fprintf(stdout, "*");
fprintf(stdout, "%s", str(AST[multi+1]));// need tweak to drop final comma
pendingcomma = 1;
multi = AST[multi+2];
}
paramlist = AST[paramlist+2];
} else if (AST[formalparam] == TYPE_GENERICNAME) {
fprintf(stdout, "/* GENERICNAME */");
paramlist = AST[paramlist+2];
} else {
fprintf(stdout, "// AST[formalparam] = %d\n", AST[formalparam]);
exit(1);
}
}
}
fprintf(stdout, ")");
if (AST[astp+3] == SPEC) {
// if it is not an external and stackp>0 then output "auto" for forward
// references to local procedures
fprintf(stdout, ";\n");
} else {
fprintf(stdout, " {\n");
}
if (Parameterless_fn) {
fprintf(stdout, "#define %s %s()\n", function_name, function_name);
}
}
break;
case ARRAYDECLARATION:
#ifdef NEVER
#include <stdio.h>
#include <stdlib.h>
int main(int argc, char **argv)
{
// test of declaration of array(n:m) where n=100 and m=110
int n = 100, m=110;
int array_1_l=n, array_1_u=m; // freeze the values
int array[array_1_u-array_1_l+1];
#define array(N) array[(N)-array_1_l]
array[2] = 44;
fprintf(stdout, "array(102) = %d\n", array(102));
exit(0);
return(0);
}
#endif
// AST 110: LINE 2 integerarrayFRED(0:10)
// AST 113: SEQUENCE 110 107
// AST 116: TYPE_INTEGER <--- LOST???
// AST 117: CONST 2 0
// AST 120: CONST 2 10
// AST 123: bound_pair: BOUND_PAIR 117 120
// AST 126: bounds: MULTI 123 0
// AST 129: name: MULTI fred 0
// AST 132: declare_array: DECLARE_ARRAY 129 126
// AST 135: each: MULTI 132 0
// AST 138: astp: ARRAYDECLARATION 135
// TO DEBUG:
// AST 121: LINE 3 integerarrayP,Q,R,S(0:255,0:255)
// AST 124: SEQUENCE 121 118
// AST 127: TYPE_INTEGER
// AST 128: MULTI s 0
// AST 131: MULTI r 128
// AST 134: MULTI q 131
// AST 137: CONST 2 0
// AST 140: CONST 2 255
// AST 143: CONST 2 0
// AST 146: CONST 2 255
// AST 149: BOUND_PAIR 143 146
// AST 152: MULTI 149 0
// AST 155: BOUND_PAIR 137 140
// AST 158: MULTI 155 152
// AST 161: MULTI p 134
// AST 164: DECLARE_ARRAY 161 158
// AST 167: each 0:MULTI 164 0
// AST 170: ARRAYDECLARATION 0/HOLE 167
{
int each, type, declare_array, name, bounds, bound_pair;
each = AST[astp+2];
type = AST[astp+1];
// AST 139: LINE 3 record(TESTFM)arrayTEST(0:10)
// AST 142: SEQUENCE 139 136
// AST 145: TYPE_RECORD testfm
// AST 147: CONST 2 0
// AST 150: CONST 2 10
// AST 153: BOUND_PAIR 147 150
// AST 156: MULTI 153 0
// AST 159: MULTI test 0
// AST 162: DECLARE_ARRAY 159 156
// AST 165: MULTI 162 0
// AST 168: ARRAYDECLARATION 0 165
// AST 168: ARRAYDECLARATION 145 165
// AST 171: SEQUENCE 168 142
print_type(type);
for (;;) { // each group: {fred(1:10)}, {jim,joe(2:5)}, {bert(1:2, 3:4, 5:6)}
// %integerarray fred(1:10), jim,joe(2:5), bert(1:2, 3:4, 5:6)
assert(AST[each] == MULTI);
declare_array = AST[each+1];
assert(AST[declare_array] == DECLARE_ARRAY);
name = AST[declare_array+1];
assert(AST[name] == MULTI);
for (;;) { // each name {jim},{joe}(2:5)
char *varname;
bounds = AST[declare_array+2];
assert(AST[bounds] == MULTI);
// if (AST[astp+1] != 0 && AST[AST[astp+1]] == TYPE_INTEGER) fprintf(stdout, "int /*FIX?*/");
fprintf(stdout, "%s", varname=str(AST[name+1]));
for (;;) { // each bound: bert({1:2}, {3:4}, {5:6})
bound_pair = AST[bounds+1];
assert(AST[bound_pair] == BOUND_PAIR);
fprintf(stdout, "[");
eval(AST[bound_pair+2], EVAL_RVALUE);
fprintf(stdout, "-"); // should maketuple(OP_SUB, ...)
eval(AST[bound_pair+1], EVAL_RVALUE);
fprintf(stdout, "+1]");
bounds = AST[bounds+2];
if (bounds == 0) break;
if (AST[bounds] == 0) break;
assert(AST[bounds] == MULTI);
}
fprintf(stdout, ";\n");
fprintf(stdout, "#undef %s\n", varname); // UNACCEPTABLE CRUDE HACK
if (AST[type] == TYPE_RECORD) {
fprintf(stdout, "#define %s(x) &%s[x] //3b (struct): may need more parameters added eg s(x,y) -> s[x][y] ...\n", varname, varname);
} else {
fprintf(stdout, "#define %s(x) %s[x] //3a: may need more parameters added eg s(x,y) -> s[x][y] ...\n", varname, varname);
}
name = AST[name+2];
if (name == 0) break;
}
each = AST[each+2];
if (each == 0) break;
}
}
break;
case DECLARATION:
/* type, TYPE_NAME/TYPE_ARRAYNAME/0, maketuple(MULTI, $2, $3)) */
// AST 116: TYPE_INTEGER
// AST 117: MULTI intvar 0
// AST 120: DECLARATION 116 0 117
// AST 127: LINE 3 integernamePOINTER
// AST 130: SEQUENCE 127 124
// AST 133: TYPE_INTEGER
// AST 134: TYPE_NAME
// AST 135: MULTI pointer 0
// AST 138: DECLARATION 0 134 135
// AST 138: DECLARATION 133 134 135
// can we restructure this with the loops outside and
// a call to print_type inside?
if (AST[AST[astp+1]] == TYPE_STRING) {
int stringinfo = AST[astp+1];
int stringsize = AST[AST[stringinfo+1]+2]; // *** ASSUMING CONST INT!
int multi = AST[astp+3];
for (;;) {
char *name;
if (AST[AST[astp+1]] == TYPE_STRING) fprintf(stdout, "char ");
if (AST[AST[astp+2]] == TYPE_NAME) fprintf(stdout, "*"); // %name
fprintf(stdout, "%s[", name=str(AST[multi+1]));//add brackets
eval(AST[stringinfo+1], EVAL_RVALUE); // str(stringsize)
fprintf(stdout, "+1];\n");//add brackets
multi = AST[multi+2];
if (multi == 0) break;
}
break;
} else if (AST[AST[astp+1]] == TYPE_RECORD) {
// AST 139: LINE 3 record(TESTFM)DATA
// AST 142: SEQUENCE 139 136
// AST 145: TYPE_RECORD testfm
// AST 147: MULTI data 0
// AST 150: DECLARATION 145 0 147
// AST 160: LINE 4 record(TESTFM)nameDATAPTR
// AST 163: SEQUENCE 160 157
// AST 166: TYPE_RECORD testfm
// AST 168: TYPE_NAME
// AST 169: MULTI dataptr 0
// AST 172: DECLARATION 166 168 169
int recordname = AST[astp+1];
int multi = AST[astp+3];
for (;;) {
char *varname;
if (AST[AST[astp+2]] == TYPE_NAME) {
fprintf(stdout, "%s *%s;\n", str(AST[recordname+1]), varname=str(AST[multi+1]));
//fprintf(stdout, "#undef %s /*2*/\n", varname); // UNACCEPTABLE CRUDE HACK
//fprintf(stdout, "#define %s &%s //4a: may need more parameters added eg s(x,y) -> s[x][y] ...\n", varname, varname);
} else {
fprintf(stdout, "%s %s;\n", str(AST[recordname+1]), varname=str(AST[multi+1]));
fprintf(stdout, "#define %s (&%s) // all record accesses now via pointers (A->B), not (A.B)\n", varname, varname);
}
multi = AST[multi+2];
if (multi == 0) break;
}
break;
} else {
int multi = AST[astp+3];
for (;;) {
char *varname;
print_type(AST[astp+1]);
if (AST[AST[astp+2]] == TYPE_NAME) fprintf(stdout, "*"); // %name
fprintf(stdout, "%s;\n", varname=str(AST[multi+1]));
multi = AST[multi+2];
if (multi == 0) break;
}
break;
}
// debug_ast(astp);
break;
case OWNDEC:
/* AST 712: LINE 38 constintegerSUMMARY=0 */
/* AST 715: SEQUENCE 709 712 */
/* AST 718: TYPE_CONST */
/* AST 719: TYPE_INTEGER */
/* AST 720: CONST 2 0 */
/* AST 723: INITCONST 720 */
/* AST 725: WHATEVER summary 0 723 0 */
/* AST 730: OWNSCALARDEC 0 0 725 */
/* AST 734: OWNDEC 718 719 730 */
/* AST 738: SEQUENCE 715 734 */
// AST 110: LINE 2 ownintegerPRINT1=0,PRINT2=0
// AST 113: SEQUENCE 110 107
// AST 116: TYPE_OWN
// AST 117: TYPE_INTEGER
// AST 118: CONST 2 0
// AST 121: INITCONST 118
// AST 123: CONST 2 0
// AST 126: INITCONST 123
// AST 128: WHATEVER print2 0 126 0
// AST 133: WHATEVER print1 0 121 128
// AST 138: OWNSCALARDEC 0 0 133
// AST 142: OWNDEC 116 117 138
{
int strsize = -1;
if (AST[AST[astp+1]] == TYPE_CONST) {
fprintf(stdout, "const ");
} else if (AST[AST[astp+1]] == TYPE_OWN) {
fprintf(stdout, "static ");
} else if (AST[AST[astp+1]] == TYPE_EXTERN) {
if (stackp > 0) fprintf(stdout, "extern ");
}
print_type(AST[astp+2]);
#ifdef NEVER
if (AST[AST[astp+2]] == TYPE_INTEGER) {
fprintf(stdout, "int ");
} else if (AST[AST[astp+2]] == TYPE_STRING) {
fprintf(stdout, "char "); strsize = AST[AST[AST[astp+2]+1]+2];
} else if (AST[AST[astp+2]] == TYPE_RECORD) {
// AST 170: LINE 4 externalrecord(TESTFM)DATA
// AST 173: SEQUENCE 170 167
// AST 176: TYPE_EXTERN
// AST 177: TYPE_RECORD testfm
// AST 179: WHATEVER data 0 0 0
// AST 184: OWNSCALARDEC 0 0 179
// AST 188: OWNDEC 176 177 184
fprintf(stdout, "%s ", str(AST[AST[astp+2]+1]));
// AST 201: TYPE_EXTERN
// AST 202: TYPE_RECORD testfm
// AST 204: TYPE_NAME
// AST 205: WHATEVER dataptr 0 0 0
// AST 210: OWNSCALARDEC 204 0 205
// AST 214: OWNDEC 201 202 210
} else {
fprintf(stdout, "/*owndectype*/ ");
}
#endif
if (AST[AST[astp+3]] == OWNSCALARDEC) {
int var = AST[astp+3];
int pendingcomma = 0;
if (AST[var+2] == 0) {
int whatever = AST[var+3];
for (;;) {
if (AST[whatever+2] == 0) {
int initconst = AST[whatever+3];
if (pendingcomma != 0) fprintf(stdout, ", ");
if (AST[var+1] != 0) fprintf(stdout, "*");
eval(AST[whatever+1], EVAL_LVALUE);
if (strsize != -1) {
fprintf(stdout, "[%s+1]", str(strsize));
}
if (AST[whatever+3] != 0) {
fprintf(stdout, " = ");
eval(AST[initconst+1], EVAL_RVALUE);
}
pendingcomma = 1;
}
whatever = AST[whatever+4];
if (whatever == 0) break;
}
}
fprintf(stdout, ";\n");
} else if (AST[AST[astp+3]] == OWNARRAYDEC) {
int ownarray = AST[astp+3];
int name = AST[ownarray+3];
int bounds_multi = AST[ownarray+5];
eval(name, EVAL_LVALUE);
for (;;) {
int bound_pair = AST[bounds_multi+1];
assert(AST[bound_pair] == BOUND_PAIR);
fprintf(stdout, "[");
eval(AST[bound_pair+2], EVAL_RVALUE);
fprintf(stdout, "-");
eval(AST[bound_pair+1], EVAL_RVALUE);
fprintf(stdout, "+1]");
bounds_multi = AST[bounds_multi+2];
if (bounds_multi == 0) break;
}
fprintf(stdout, ";\n");
fprintf(stdout, "#define %s(x) %s[x] // may need more parameters added eg s(x,y) -> s[x][y] ...\n", str(name), str(name));
}
}
break;
/* AST 718: TYPE_CONST */
/* AST 719: TYPE_INTEGER */
/* AST 720: CONST 2 0 */
/* AST 723: INITCONST 720 */
/* AST 725: WHATEVER summary 0 723 0 */
/* AST 730: OWNSCALARDEC 0 0 725 */
/* AST 734: OWNDEC 718 719 730 */
case RECORDFORMAT:
// AST 117: TYPE_INTEGER
// AST 118: MULTI two 0
// AST 121: MULTI one 118
// AST 124: RECORDFORMATELEMENT 0 121
// AST 127: RECORDFORMATDECLARATION 117 124
// AST 130: MULTI 127 0
// AST 133: RECORDFORMAT testfm 130
//this breaks
// AST 111: LINE 2 recordformatTESTFM(integerarrayRA(0:4))
// AST 114: SEQUENCE 111 108
// AST 117: type: TYPE_INTEGER
// AST 118: CONST 2 0
// AST 121: CONST 2 4
// AST 124: BOUND_PAIR 118 121
// AST 127: MULTI 124 0
// AST 130: MULTI ra 0
// AST 133: DECLARE_ARRAY 130 127
// AST 136: rfel: MULTI 133 0
// AST 139: each: RECORDFORMATDECLARATION 117 136
// AST 142: parm: MULTI 139 0
// AST 145: astp: RECORDFORMAT testfm 142
// AST 148: SEQUENCE 145 114
fprintf(stdout, "typedef struct %s {\n", str(AST[astp+1]));
{
int parm = AST[astp+2];
while (parm != 0) {
int each, type, rfel, namelist;
assert(AST[parm] == MULTI);
each = AST[parm+1];
assert(AST[each] == RECORDFORMATDECLARATION);
type = AST[each+1];
print_type(type);
#ifdef NEVER
if (AST[type] == TYPE_INTEGER) {
fprintf(stdout, "int ");
} else {
fprintf(stdout, "/*simpletype*/ ");
}
#endif
rfel = AST[each+2];
if (AST[rfel] == MULTI) {
int what = AST[rfel+1];
assert(AST[what] == DECLARE_ARRAY);
fprintf(stdout, "/*declarearray*/");
//codegen(what, ???);
} else {
namelist = AST[rfel+2]; // "one, two"
assert(AST[namelist] == MULTI);
for (;;) {
// AST 136: LINE 3 recordformatRD2(record(RD)nameRDN)
// AST 139: SEQUENCE 136 133
// AST 142: TYPE_RECORD rd
// AST 144: TYPE_NAME
// AST 145: MULTI rdn 0
// AST 148: rfel: RECORDFORMATELEMENT 144 145
// AST 151: RECORDFORMATDECLARATION 142 148
// AST 154: MULTI 151 0
// AST 157: RECORDFORMAT rd2 154
// AST 160: SEQUENCE 157 139
if (AST[rfel+1] != 0 && AST[AST[rfel+1]]==TYPE_NAME) fprintf(stdout, "*");
fprintf(stdout, "%s", str(AST[namelist+1]));
namelist = AST[namelist+2];
if (namelist == 0) break;
fprintf(stdout, ", ");
}
}
fprintf(stdout, ";\n");
parm = AST[parm+2];
}
}
fprintf(stdout, "} %s;\n", str(AST[astp+1]));
break;
case LOOP:
push_scope(SCOPE_LOOP, astp, 0);
fprintf(stdout, "for (;;) {\n");
break;
case CONTINUE:
// find enclosing cycle, hook up link to it.
// may not be needed for translator but would be needed for compiler
fprintf(stdout, "continue;");
break;
case BREAK:
// find enclosing cycle, hook up link to it.
// may not be needed for translator but would be needed for compiler
// NOTE THAT "continue" and "break" in C *MIGHT* go to the wrong place
// compared to what is exoected in imp. Switch statements for example
// could throw it for a loop!
fprintf(stdout, "break;");
break;
case FORLOOP:
if (AST[astp+2] == HOLE) {
push_scope(SCOPE_FORLOOP, astp, 0);
}
// needs special handling for negative or variable increments...
fprintf(stdout, "for (");
eval(AST[astp+1], EVAL_RVALUE);
fprintf(stdout, " = ");
eval(AST[astp+3], EVAL_RVALUE);
fprintf(stdout, "; ");
eval(AST[astp+1], EVAL_RVALUE);
fprintf(stdout, "<="); // this is why
eval(AST[astp+5], EVAL_RVALUE);
fprintf(stdout, "; ");
eval(AST[astp+1], EVAL_RVALUE);
fprintf(stdout, "+=");
eval(AST[astp+4], EVAL_RVALUE);
fprintf(stdout, ") ");
if (AST[astp+2] == HOLE) {
fprintf(stdout, " {\n");
} else {
codegen(AST[astp+2], SINGLE_STATEMENT);
}
break;
case WHILE:
if (AST[astp+2] == HOLE) {
push_scope(SCOPE_WHILELOOP, astp, 0);
}
if (AST[astp+2] == HOLE) {
fprintf(stdout, "while (");
eval(AST[astp+1], EVAL_RVALUE);
fprintf(stdout, ") {\n");
} else {
fprintf(stdout, "while (");
eval(AST[astp+1], EVAL_RVALUE);
fprintf(stdout, ") ");
codegen(AST[astp+2], SINGLE_STATEMENT);
}
break;
case UNTIL:
if (AST[astp+2] == HOLE) {
push_scope(SCOPE_UNTILLOOP, astp, 0);
}
fprintf(stdout, "do {");
if (AST[astp+2] != HOLE) {
codegen(AST[astp+2], SINGLE_STATEMENT);
fprintf(stdout, "} while (!(");
eval(AST[astp+1], EVAL_RVALUE);
fprintf(stdout, "));");
}
break;
case REPEATUNTIL:
scope = pop_scope(&startp, &extra);
assert(scope == SCOPE_WHILELOOP || scope == SCOPE_LOOP);
fprintf(stdout, "if (");
eval(AST[astp+1], EVAL_RVALUE);/* be careful with precedence/bracketing */
fprintf(stdout, ") break;\n");
fprintf(stdout, "}\n");
break;
case ELSE:
// this is the body of the current else - hook it up to C_IF_THEN_ELSE node?
/*if (AST[AST[astp+1]] == SEQUENCE) fprintf(stdout, "{"); */
codegen(AST[astp+1], SINGLE_STATEMENT); /* {...} or xxx; ??? */
/*if (AST[AST[astp+1]] == SEQUENCE) fprintf(stdout, "}"); */
break;
case THENELSE:
// this is the body of the current then - hook it up to C_IF_THEN_ELSE node?
/*if (AST[AST[astp+1]] == SEQUENCE) fprintf(stdout, "{"); */
codegen(AST[astp+1], SINGLE_STATEMENT); /* {...} or xxx; ??? */
/*if (AST[AST[astp+1]] == SEQUENCE) fprintf(stdout, "}"); */
fprintf(stdout, " else "); /* BE CAREFUL HERE - THERE ARE SEVERAL 'ELSE' PARTS POSSIBLE */
codegen(AST[astp+2], SINGLE_STATEMENT); /* See 'ELSEquote:' */
break;
//TODO does this ever happen at the top level or is it only inside a then-part?
case ELSESTART:
// whatever follows here is a multi-statement sequence to be hooked
// in to the else-part of current C_IF_THEN_ELSE
push_scope(SCOPE_ELSESTART, astp, 0);
fprintf(stdout, "{");
break;
case FINISHELSE:
scope = pop_scope(&startp, &extra);
if (scope != SCOPE_THENSTART) {
const char *lookup[] = {"SCOPE_BEGIN","SCOPE_EVENT_START","SCOPE_PROCFNMAPDEF","SCOPE_MAIN","SCOPE_FORLOOP",
"SCOPE_WHILELOOP","SCOPE_UNTILLOOP","SCOPE_LOOP","SCOPE_THENSTART","SCOPE_ELSESTART"};
fprintf(stderr, "scope = %d\n", scope);
if (scope >= 1 && scope <= 10) fprintf(stderr, "a: scope = %s\n", lookup[scope-1]);
assert(scope == SCOPE_THENSTART);
}
fprintf(stdout, "} else ");
codegen(AST[astp+1], SINGLE_STATEMENT);
/*fprintf(stdout, ";\n"); */
/* *OR*... */
/* codegen(AST[astp+1], 0); ??? */
break;
case FINISHELSEIFSTART:
scope = pop_scope(&startp, &extra);
if (scope != SCOPE_THENSTART) {
const char *lookup[] = {"SCOPE_BEGIN","SCOPE_EVENT_START","SCOPE_PROCFNMAPDEF","SCOPE_MAIN","SCOPE_FORLOOP",
"SCOPE_WHILELOOP","SCOPE_UNTILLOOP","SCOPE_LOOP","SCOPE_THENSTART","SCOPE_ELSESTART"};
fprintf(stderr, "scope = %d\n", scope);
if (scope >= 1 && scope <= 10) fprintf(stderr, "b: scope = %s\n", lookup[scope-1]);
assert(scope == SCOPE_THENSTART);
}
push_scope(SCOPE_THENSTART, astp, 0);
fprintf(stdout, "} else if (");
if (AST[astp+1] == OP_UNLESS) fprintf(stdout, "!(");
eval(AST[astp+2], EVAL_RVALUE);
if (AST[astp+1] == OP_UNLESS) fprintf(stdout, ")");
fprintf(stdout, ") {\n");
break;
case FINISHELSESTART:
// finish off the then part, start the else part
scope = pop_scope(&startp, &extra);
if (scope != SCOPE_THENSTART) {
const char *lookup[] = {"SCOPE_BEGIN","SCOPE_EVENT_START","SCOPE_PROCFNMAPDEF","SCOPE_MAIN","SCOPE_FORLOOP",
"SCOPE_WHILELOOP","SCOPE_UNTILLOOP","SCOPE_LOOP","SCOPE_THENSTART","SCOPE_ELSESTART"};
fprintf(stderr, "scope = %d\n", scope);
if (scope >= 1 && scope <= 10) fprintf(stderr, "c: scope = %s\n", lookup[scope-1]);
assert(scope == SCOPE_THENSTART);
}
push_scope(SCOPE_ELSESTART, astp, 0);
fprintf(stdout, "} else {\n");
break;
case FINISHELSEIFORUNLESS:
scope = pop_scope(&startp, &extra);
if (scope != SCOPE_THENSTART) {
const char *lookup[] = {"SCOPE_BEGIN","SCOPE_EVENT_START","SCOPE_PROCFNMAPDEF","SCOPE_MAIN","SCOPE_FORLOOP",
"SCOPE_WHILELOOP","SCOPE_UNTILLOOP","SCOPE_LOOP","SCOPE_THENSTART","SCOPE_ELSESTART"};
fprintf(stderr, "scope = %d\n", scope);
if (scope >= 1 && scope <= 10) fprintf(stderr, "d: scope = %s\n", lookup[scope-1]);
assert(scope == SCOPE_THENSTART);
}
fprintf(stdout, "\n} /* untested - check this line */"); // remove once tested
fprintf(stdout, "else /* extra? */ ");
case ELSEIFORUNLESS:
// maketuple(ELSEIFORUNLESS, $2, cond, $5);
assert(AST[astp+1] != 0);
fprintf(stdout, "if (");
if (AST[astp+1] == OP_UNLESS) fprintf(stdout, "!(");
eval(AST[astp+2], EVAL_RVALUE);
if (AST[astp+1] == OP_UNLESS) fprintf(stdout, ")");
fprintf(stdout, ") ");
codegen(AST[astp+3], SINGLE_STATEMENT);
break;
case FINISHELSEIFORUNLESSSTART:
scope = pop_scope(&startp, &extra);
if (scope != SCOPE_THENSTART) {
const char *lookup[] = {"SCOPE_BEGIN","SCOPE_EVENT_START","SCOPE_PROCFNMAPDEF","SCOPE_MAIN","SCOPE_FORLOOP",
"SCOPE_WHILELOOP","SCOPE_UNTILLOOP","SCOPE_LOOP","SCOPE_THENSTART","SCOPE_ELSESTART"};
fprintf(stderr, "scope = %d\n", scope);
if (scope >= 1 && scope <= 10) fprintf(stderr, "e: scope = %s\n", lookup[scope-1]);
assert(scope == SCOPE_THENSTART);
}
fprintf(stdout, "} ");
case ELSEIFORUNLESSSTART:
fprintf(stdout, "else ");
case IFORUNLESSSTART:
push_scope(SCOPE_THENSTART, astp, 0);
assert(AST[astp+1] != 0);
fprintf(stdout, "if (");
if (AST[astp+1] == OP_UNLESS) fprintf(stdout, "!(");
eval(AST[astp+2], EVAL_RVALUE);
if (AST[astp+1] == OP_UNLESS) fprintf(stdout, ")");
fprintf(stdout, ") ");
fprintf(stdout, "{\n");
break;
case CONDITIONAL: /* if-or-unl cond thenpart */
// Nasty case: %if j=k %then j=j %else %if k=j %then k=k %and j=j %else %if j=k %then k=j %else %start
// AST 170: ELSESTART
// AST 171: THENELSE 166 170
// AST 174: ELSEIFORUNLESS 16 160 171
// AST 178: THENELSE 153 174
// AST 181: ELSEIFORUNLESS 16 134 178
// AST 185: THENELSE 126 181
// AST 188: CONDITIONAL 16 120 185
// AST 192: SEQUENCE 188 113
#ifdef NEVER
// originally used a 'fixup' procedure, and this complex code
// was the only way to find the %start; now we recurse properly
// while code generating, and find the %start whereever it is.
// make this a C_IF_THEN_ELSE, insert a OP_NOT for unless
assert(AST[astp+1] != 0);
//fixup(AST[astp+2], 1);
if (AST[astp+3] == HOLE) {
push_scope(SCOPE_THENSTART, astp, 0);
} else {
int p = AST[astp+3];
while (AST[p] == THENELSE) {
p = AST[p+2];
if (AST[p] == ELSEIFORUNLESS) {
p = AST[p+3];
}
}
if (AST[p] == ELSESTART) push_scope(SCOPE_ELSESTART, astp, 0);
}
#endif
assert(AST[astp+1] != 0);
fprintf(stdout, "if (");
if (AST[astp+1] == OP_UNLESS) fprintf(stdout, "!(");
eval(AST[astp+2], EVAL_RVALUE);
if (AST[astp+1] == OP_UNLESS) fprintf(stdout, ")");
fprintf(stdout, ") ");
if (AST[astp+3] == HOLE) {
push_scope(SCOPE_THENSTART, astp, 0);
fprintf(stdout, "{\n");
} else {
codegen(AST[astp+3], SINGLE_STATEMENT);
/*fprintf(stdout, ";\n"); */
}
break;
case FINISH:
scope = pop_scope(&startp, &extra);
if (scope != SCOPE_THENSTART && scope != SCOPE_ELSESTART && scope != SCOPE_EVENT_START) {
const char *lookup[] = {"SCOPE_BEGIN","SCOPE_EVENT_START","SCOPE_PROCFNMAPDEF","SCOPE_MAIN","SCOPE_FORLOOP",
"SCOPE_WHILELOOP","SCOPE_UNTILLOOP","SCOPE_LOOP","SCOPE_THENSTART","SCOPE_ELSESTART"};
fprintf(stderr, "scope = %d\n", scope);
if (scope >= 1 && scope <= 10) fprintf(stderr, "f: scope = %s\n", lookup[scope-1]);
assert(scope == SCOPE_THENSTART ||
scope == SCOPE_ELSESTART ||
scope == SCOPE_EVENT_START);
}
if (scope == SCOPE_EVENT_START) {
// patch up HOLE in %on %event so that block can be
// remembered and skipped during code generation
assert(AST[startp] == ONEVENT);
assert(AST[startp+3] == HOLE);
AST[startp+3] = astp; // or = ap?
}
fprintf(stdout, "}\n");
break;
case ENDLOOP:
scope = pop_scope(&startp, &extra);
if (scope != SCOPE_LOOP && scope != SCOPE_FORLOOP && scope != SCOPE_WHILELOOP && scope != SCOPE_UNTILLOOP) {
const char *lookup[] = {"SCOPE_BEGIN","SCOPE_EVENT_START","SCOPE_PROCFNMAPDEF","SCOPE_MAIN","SCOPE_FORLOOP",
"SCOPE_WHILELOOP","SCOPE_UNTILLOOP","SCOPE_LOOP","SCOPE_THENSTART","SCOPE_ELSESTART"};
fprintf(stderr, "scope = %d\n", scope);
if (scope >= 1 && scope <= 10) fprintf(stderr, "g: scope = %s\n", lookup[scope-1]);
assert(scope == SCOPE_LOOP ||
scope == SCOPE_FORLOOP ||
scope == SCOPE_WHILELOOP ||
scope == SCOPE_UNTILLOOP /* top-until */);
}
if (AST[startp] == UNTIL) {
fprintf(stdout, "} while (!(");
eval(AST[startp+1], EVAL_RVALUE);
fprintf(stdout, "));");
} else {
fprintf(stdout, "}\n");
}
break;
case ENDBLOCKPROCFN:
scope = pop_scope(&startp, &extra);
assert(scope == SCOPE_PROCFNMAPDEF || scope == SCOPE_BEGIN || scope == SCOPE_MAIN);
// allow for %begin %end %endoffile as well as %begin %endoprogram
if (AST[startp] == BEGINBLOCK) { // back-patching only works if 2-pass :-(
assert(AST[startp+1] == HOLE);
AST[startp+1] = astp;
} // more TODO
fprintf(stdout, "}\n");
if (scope == SCOPE_BEGIN) {
// just finished compiling an anonymous block - now call it...
fprintf(stdout, "block_%0d();\n", extra);
}
break;
case ENDPROG:
scope = pop_scope(&startp, &extra);
assert(scope == SCOPE_MAIN);
fprintf(stdout, "}\n");
break;
case ENDFILE:
/* exit(0); */
break;
case RETURN:
// WARNING: %return from within a %begin/%end block needs special handling
// which *could* be faked by emitting "auto inline void block_%0d(void) {"
// for the "%begin"... (which I'm now doing)
fprintf(stdout, "return;");
break;
case RESULT: // ignoring astp+1 which is assop :-(
fprintf(stdout, "return(");
eval(AST[astp+2], EVAL_RVALUE);
fprintf(stdout, ");");
break;
case RETURN_TRUE:
fprintf(stdout, "return(0==0);");
break;
case RETURN_FALSE:
fprintf(stdout, "return(0!=0);");
break;
case ARRAYINDEX: // *** TEMP ***
case RECORDFIELD:
case VAR_OR_FNCALL:
case PROCCALL_OR_ARRAY_OR_MAP:
case ARRAY_OR_FNMAP: // need to distinguish type here, finally...
case CONST:
case LETTERCHARCONST:
case BRACKET:
case MULTI:
fprintf(stderr, "Warning: case %d should not be called in codegen\n", AST[astp]);
eval(astp, EVAL_RVALUE);
break;
// MONOP and BINOP should never be called
default:
fprintf(stdout, "// AST %d: %s", astp, Opname[AST[astp]]);
for (arg = 1; arg <= Arity[AST[astp]]; arg++) {
if (isstr(AST[astp+arg])) {
fprintf(stdout, " %s", str(AST[astp+arg]));
} else {
fprintf(stdout, " %d", AST[astp+arg]);
}
}
fprintf(stdout, "\n");
}
}
int maketuple(int type, ...)
{
int arg, result = ASTP;
ASTP += Arity[type]+1;
AST[result] = type;
va_list ap;
va_start(ap, type);
for (arg = 1; arg <= Arity[type]; arg++) {
AST[result+arg] = va_arg(ap, int);
}
va_end(ap);
debug_ast(result);
return(result);
}
/* --------------------------------- COMPILER SUPPORT --------------------------------------- */
%}
/* 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.ii", "r");
} else if (argc != 2) {
fprintf(stderr, "syntax: imp infile.ii\n");
/* Let's just resume for now... */
// yyin = fopen(argv[1], "r");
exit(0);
} else {
if (
(strcmp(argv[1]+strlen(argv[1])-4, ".imp") == 0) ||
(strcmp(argv[1]+strlen(argv[1])-2, ".i") == 0)
) {
char command[1024];
sprintf(command, "/home/gtoal/src/new-gt-imp/filter < %s > /tmp/imptmp.ii", argv[1]);
system(command);
yyin = fopen("/tmp/imptmp.ii", "r"); // cannot use popen, parser requires ability to fseek.
} else if (strcmp(argv[1]+strlen(argv[1])-3, ".ii") == 0) {
yyin = fopen(argv[1], "r");
} else {
fprintf(stderr, "imp2c: file '%s' must end in .i or .imp (or be pre-processed in .ii)\n", argv[1]);
exit(1);
}
}
if (yyin == NULL) {
fprintf(stderr, "imp: cannot open input\n");
exit(EXIT_FAILURE);
}
fprintf(stderr, "%s: processing %s\n", argv[0], argv[1] == NULL ? "test.ii" : argv[1]);
if (verbose) fprintf(stderr, "Starting\n");
fprintf(stdout,"#include \"i2clib.h\"\n");
fprintf(stdout,"#define DEBUGITEM(x) (x)\n");
for (;;) {
stacktop = stackmark();
if (SS_parse(&subroot)) {
execute_parsetree(subroot);
} else {
/* TEMP HACK: does this on failed parse */
fprintf(stdout, "-----------------------------------------------------------------\n");
codegen(entrypoint, MULTIPLE_STATEMENTS);
fprintf(stderr, "imp2c parse failure, partial results generated\n");
return(FALSE);
}
stackrelease(stacktop);
if (exit_flag) return(TRUE);
/* printf("\n"); */
ilev += delayed_ilev; delayed_ilev = 0;
}
}
;
OPERAND: <CONST> { /* Done */
$$=$1;
} |
<NAME><APP><RECORDFIELD> {
/* If <APP> is present, this is an array or a map/fn call */
/* If RECORDFIELD is present, <NAME><APP> is a record type (array or map) */
/* Plain <NAME> is either a simple variable/constant or a function call */
/* To work it out properly we do need to implement a symbol table */
int left;
if (($2 == 0) && ($3 == 0)) {
$$ = maketuple(VAR_OR_FNCALL, $1);
} else {
if ($2 == 0) left = $1; else left = maketuple(ARRAY_OR_FNMAP, $1, $2);
if ($3 != 0) {
assert(AST[$3] == RECORDFIELD);
//assert(AST[$3+1] == HOLE);
//fprintf(stdout, " /* sub sub field broken (1) */\n");
AST[$3+1] = left; // THIS NEEDS REVIEW - RECORD SUBFIELDS: "." or "->"?
$$ = $3;
} else $$ = left;
}
} |
"\|"<EXPR>"\|" {
$$=maketuple(MONOP, UOP_ABS, $2); /* Added by GT for imp77 */
} |
"\("<EXPR>"\)" {
$$=maketuple(BRACKET, $2); /* Done */
};
COPERAND: <NAME> { $$=$1; /* Only if name is a constant! */ } |
<CONST> { $$=$1; } |
"\|"<CEXPR>"\|" { $$=maketuple(MONOP, UOP_ABS, $2); /* Added by GT for imp77 */} |
"\("<CEXPR>"\)" { $$=maketuple(BRACKET, $2); };
/* Just a check to see if comments are allowed between procedures */
CEXPR: <UNARY><COPERAND><RESTOFCEXPR> {
if ($3 != NONE) {
assert(AST[$3] == BINOP);
AST[$3+2] = $2;
if ($1 == 0) $$ = $3; else $$=maketuple(MONOP, $1, $3);
} else {
if ($1 == 0) $$ = $2; else $$=maketuple(MONOP, $1, $2);
}
};
STAROREXPR: <UNARY><COPERAND><RESTOFCEXPR> {
if ($3 != NONE) {
assert(AST[$3] == BINOP);
assert(AST[$3+2] == HOLE);
AST[$3+2] = $2;
if ($1 == 0) $$ = $3; else $$=maketuple(MONOP, $1, $3);
} else {
if ($1 == 0) $$ = $2; else $$=maketuple(MONOP, $1, $2);
}
} |
"\*" {
$$=0;
};
EXPR: <UNARY><OPERAND><RESTOFEXPR> {
if ($3 != NONE) {
assert(AST[$3] == BINOP);
assert(AST[$3+2] == HOLE);
AST[$3+2] = $2;
if ($1 != NONE) {
$$ = maketuple(MONOP, $1, $3); /* Precedence with all of these may be wrong for monop */
} else $$ = $3;
} else {
if ($1 != NONE) {
$$ = maketuple(MONOP, $1, $2);
} else {
$$ = $2;
}
}
};
RESTOFEXPR: <OP><OPERAND><RESTOFEXPR> {
if ($3 != NONE) {
assert(AST[$3] == BINOP);
assert(AST[$3+2] == HOLE);
AST[$3+2] = $2;
$$ = maketuple(BINOP, $1, /*hole*/0, $3);
} else {
$$ = maketuple(BINOP, $1, /*hole*/0, $2);
}
} |
"" {
$$ = NONE;
};
RESTOFCEXPR: <OP><COPERAND><RESTOFCEXPR> {
if ($3 != NONE) {
assert(AST[$3] == BINOP);
assert(AST[$3+2] == HOLE);
AST[$3+2] = $2;
$$ = maketuple(BINOP, $1, /*hole*/0, $3);
} else {
$$ = maketuple(BINOP, $1, /*hole*/0, $2);
}
} |
"" { $$=0; };
APP: "\("<EXPR><RESTOFAPP>"\)" {
if ($3 != NONE) {
$$ = maketuple(MULTI, $2, $3);
} else {
$$ = $2;
}
} |
"" { $$=0; };
RESTOFAPP: ","<EXPR><RESTOFAPP> {
if ($3 != NONE) {
$$ = maketuple(MULTI, $2, $3);
} else {
$$ = $2;
}
} |
"" { $$=0; };
PercentIU: "if" { $$ = OP_IF; } |
"unless" { $$ = OP_UNLESS; };
PercentWU: "while"<SC><RESTOFCOND> {
int cond;
if ($3) {
cond = $3;
assert(AST[cond] == BINOP);
assert(AST[cond+2] == HOLE);
AST[cond+2] = $2;
} else cond = $2;
$$ = maketuple(WHILE, cond, HOLE);
} |
"until"<SC><RESTOFCOND> {
int cond;
if ($3) {
cond = $3;
assert(AST[cond] == BINOP);
assert(AST[cond+2] == HOLE);
AST[cond+2] = $2;
} else cond = $2;
$$ = maketuple(UNTIL, cond, HOLE);
} |
"for"<CYCPARM> {
$$ = $2;
};
ALIASquote: "alias"<TEXTTEXT> {
$$ = maketuple(ALIAS, $2);
} |
"" { $$=0; };
NLISTquote: ","<NAME><NLISTquote> {
$$ = maketuple(MULTI, $2, $3);
} |
"" { $$=0; };
TYPE: "label" { $$ = maketuple(TYPE_BYTEINTEGER); } |
"integer" { $$ = maketuple(TYPE_INTEGER); } |
"longinteger" { $$ = maketuple(TYPE_LONG); } |
"real" { $$ = maketuple(TYPE_REAL); } |
"longlongreal" { $$ = maketuple(TYPE_LONGLONGREAL); } |
"longreal" { $$ = maketuple(TYPE_LONGREAL); } |
"long" { $$ = maketuple(TYPE_LONG, $2); } |
"byteinteger" { $$ = maketuple(TYPE_BYTEINTEGER); } |
"byte" { $$ = maketuple(TYPE_BYTEINTEGER); } |
"string"<REPFACT> { $$ = maketuple(TYPE_STRING, $2); } |
"halfinteger" { $$ = maketuple(TYPE_HALFINTEGER); } |
"half" { $$ = maketuple(TYPE_HALFINTEGER); } |
"shortinteger" { $$ = maketuple(TYPE_SHORTINTEGER); } |
"short" { $$ = maketuple(TYPE_SHORTINTEGER); } |
"record\(\*\)" { $$ = maketuple(TYPE_RECORD, 0); /* added for Imp77 */ } |
"record\("<RFREF>"\)" { $$ = maketuple(TYPE_RECORD, $2); } |
"record" { /* added for pre-imp80 EMAS imp */
// REQUIRES RECORD TYPE TO COME AFTER DECLARATION OF NAME
// eg %recordformat recfm(%integer i)
// %record r(recfm)
// Not sure if any of these are allowed:
// %record r,s,t(recfm)
// %record r(recfm), s(sfm), t(tfm)
// %record r(recfm), s,t(tfm)
// so until I hit one, I'll keep it at a single declaration
$$ = maketuple(TYPE_RECORD, 0);
};
FN: "fn" { } | "function" { };
RT: "routine" { $$ = maketuple(ROUTINE, HOLE /* args */); } |
"predicate" { $$ = maketuple(PREDICATE, HOLE /* args */); /* Added for Imp77 */ } |
<TYPE><FN> { $$ = maketuple(FUNCTION, HOLE /* args */, $1 /* type */, HOLE /* result */); } |
<TYPE>"map" { $$ = maketuple(MAP, HOLE /* args */, $1, HOLE /* result */); };
FPDEL: <TYPE><PercentQNAMEquote><NAME><NLISTquote> {
/* use multi for (NAME, NLISTquote) */
$$ = maketuple(FORMALPARAMETER, $/* basic type */1, $/*type-name or type_arrayname */2, maketuple(MULTI, $3, $4));
} |
<RT><PercentNAMEquote><NAME><NLISTquote><FPP> {
int call;
call = $1;
assert(AST[$1] == ROUTINE || AST[$1] == PREDICATE ||
AST[$1] == FUNCTION || AST[$1] == MAP);
if ($2 != 0) {
if (AST[$1] == ROUTINE) AST[$1] == ROUTINENAME;
if (AST[$1] == PREDICATE) AST[$1] == PREDICATENAME;
if (AST[$1] == FUNCTION) AST[$1] == FUNCTIONNAME;
if (AST[$1] == MAP) AST[$1] == MAPNAME;
}
AST[call+1] = $5; /* Parameters */
$$ = maketuple(FUNCTION_PARAMETER, call, maketuple(MULTI, $3, $4));
/* Again, need to turn MULTI's inside-out ... */
} |
"name"<NAME><NLISTquote> { /* Generic %name variable (untyped pointer) */
$$ = maketuple(TYPE_GENERICNAME, maketuple(MULTI, $2, $3));
};
PercentNAMEquote: "name" { $$ = maketuple(TYPE_NAME); } |
"" { $$=0; };
PercentQNAMEquote: "arrayname" { $$ = maketuple(TYPE_ARRAYNAME); } |
"name" { $$ = maketuple(TYPE_NAME); } |
"" { $$=0; };
FPP: "\("<FPDEL><RESTOFFPLIST>"\)" {
$$ = maketuple(PARAMLIST, $2, $3);
} |
"" { $$=0;
};
RESTOFFPLIST: <commaquote><FPDEL><RESTOFFPLIST> {
if ($1 != NONE) {
$$ = maketuple(PARAMLIST, $2, $3);
} else $$ = 0;
} |
"" { $$=0;
};
PercentFORMATquote: "format" { $$ = maketuple(TYPE_FORMAT); } |
"" { $$=0; };
SC: <EXPR><COMP><EXPR><RESTOFSC> {
if ($4 != NONE) {
int left = maketuple(BINOP, $2, $1, $3);
int right = maketuple(BINOP, AST[$4+1], $3, AST[$4+3]);
/* TO DO: $$ = maketuple(DOUBLE_SIDED, $1, $2, $3, AST[$4+1], AST[$4+3]); */
$$ = maketuple(BINOP, OP_AND, left, right);
} else {
$$ = maketuple(BINOP, $2, $1, $3);
}
} |
<EXPR> { /* predicate for imp77 - maybe not the best way to do this */
$$ = $1; /* TO DO - mark as predicate */
} |
"\("<SC><RESTOFCOND>"\)" {
int cond = $3;
if (cond != 0) {
assert(AST[cond] == BINOP);
assert(AST[cond+2] == HOLE);
AST[cond+2]=$2;
} else {
cond = $2;
}
$$ = cond;
} |
"not"<SC> { $$ = maketuple(MONOP, UOP_LOGNOT, $2); };
RESTOFSC: <COMPtwo><EXPR> { $$ = maketuple(BINOP, $1, HOLE, $2); } |
"" { $$=0; };
RESTOFCOND: "and"<SC><RESTOFANDC> {
if ($3 != NONE) {
assert(AST[$3] == BINOP);
assert(AST[$3+2] == HOLE);
AST[$3+2] = $2;
$$ = maketuple(BINOP, OP_AND, HOLE, $3);
} else {
$$ = maketuple(BINOP, OP_AND, HOLE, $2);
}
} |
"or"<SC><RESTOFORC> {
if ($3 != NONE) {
assert(AST[$3] == BINOP);
assert(AST[$3+2] == HOLE);
AST[$3+2] = $2;
$$ = maketuple(BINOP, OP_OR, HOLE, $3);
} else {
$$ = maketuple(BINOP, OP_OR, HOLE, $2);
}
} |
"" { $$=0; };
RESTOFANDC: "and"<SC><RESTOFANDC> {
if ($3 != NONE) {
assert(AST[$3] == BINOP);
assert(AST[$3+2] == HOLE);
AST[$3+2] = $2;
$$ = maketuple(BINOP, OP_AND, HOLE, $3);
} else {
$$ = maketuple(BINOP, OP_AND, HOLE, $2);
}
} |
"" { $$=0; };
RESTOFORC: "or"<SC><RESTOFORC> {
if ($3 != NONE) {
assert(AST[$3] == BINOP);
assert(AST[$3+2] == HOLE);
AST[$3+2] = $2;
$$ = maketuple(BINOP, OP_OR, HOLE, $3);
} else {
$$ = maketuple(BINOP, OP_OR, HOLE, $2);
}
} |
"" { $$=0; };
PercentSPECquote: "spec" { $$ = SPEC; } |
"" { $$=NONE; };
VSPECquote: "spec" { $$ = SPEC; } |
"" { $$=NONE; };
RESTOFBPLIST: ","<EXPR>":"<EXPR><RESTOFBPLIST> {
$$ = maketuple(MULTI, maketuple(BOUND_PAIR, $2, $4), $5);
} |
"" { $$=0; };
OLDRECquote: "\("<RFREF>"\)" { // GT addition. Not yet confirmed.
// OLD-STYLE record declaration %record fred,jim,joe(fredfm)
$$ = maketuple(TYPE_RECORD, $2);
} |
"" { $$=0; };
DECLN: <PercentQNAMEquote><NAME><NLISTquote><OLDRECquote> {
$$ = maketuple(DECLARATION, $4 /* For type */, $1 /* TYPE_NAME/TYPE_ARRAYNAME/0 */, maketuple(MULTI, $2, $3));
} |
"array"<PercentFORMATquote><ADECLN> {
if ($2 != 0) {
$$ = maketuple(ARRAYFORMATDECLARATION, HOLE, $2); // NEED TO ADD HOLES HERE TOO!
} else {
$$ = maketuple(ARRAYDECLARATION, HOLE, $3); // NEED TO ADD HOLES HERE TOO!
}
};
ADECLN: <NAME><NLISTquote><BPAIR><RESTOFARLIST> {
$$ = maketuple(MULTI /* TO DO - FIX!!! (like SWITCHDECL) */, maketuple(DECLARE_ARRAY, maketuple(MULTI, $1, $2), $3), $4);
};
RESTOFARLIST: ","<ADECLN> { $$ = $2; } |
"" { $$=0; };
WHATEVER: <NAME><ALIASquote><CONSTquote><RESTOFOWNDEC> {
$$ = maketuple(WHATEVER, $1, $2, $3, $4);
};
OWNDEC: <PercentQNAMEquote><VSPECquote>
<WHATEVER><S> { /* I.e. initialised decln */
$$ = maketuple(OWNSCALARDEC, $1, $2, $3); /* not good enough. assemble parts and DECLARE */
} |
"array"<PercentFORMATquote><VSPECquote><NAME><ALIASquote><BPAIR><CONSTLIST> {
$$ = maketuple(OWNARRAYDEC, $2, $3, $4, $5, $6, $7);
};
RESTOFOWNDEC: ","<WHATEVER> {
$$ = $2;
} |
"" { $$=0; };
XOWN: "own" { $$ = maketuple(TYPE_OWN); } |
"external" { $$ = maketuple(TYPE_EXTERN); } |
"extrinsic" { $$ = maketuple(TYPE_EXTERN); } |
"constant" { $$ = maketuple(TYPE_CONST); } |
"const" { $$ = maketuple(TYPE_CONST); } |
"" { $$ = maketuple(TYPE_AUTO); /* Added initialised auto variables for Imp77 */ };
CONSTLIST: "="<CONSTITEMS> {
$$ = $2;
} |
"" { $$=0; };
CONSTITEMS: <READLINEquery><UNARY><COPERAND><RESTOFCEXPR><REPFACT><ROCL> {
int con /* need to fold const expr */, rest;
if ($2 != 0) con = maketuple(MONOP, $2, $3); else con = $3;
if ($4 != 0) {
assert(AST[$4] == BINOP);
assert(AST[$4+2] == HOLE);
AST[$4+2] = con; con = $4;
}
$$ = maketuple(INITCONSTARRAY, con, $5, $6); /* move 'rest' into a while loop */
};
ROCL: ","<CONSTITEMS> {
$$ = $2;
} |
"" { $$=0; };
REPFACT: "\("<STAROREXPR>"\)" { $$ = $2; } |
"" { $$=0; };
RESTOFELIST: ","<CEXPR><RESTOFELIST> {
$$ = maketuple(MULTI, $2, $3);
} |
"" { $$=0; };
PercentEVENTquote: "event" { $$=1; } |
"" { $$=0; };
OPEXPR: ","<EXPR> { $$ = $2; } |
"" { $$=0; };
RESTOFREPEAT: "until"<SC><RESTOFCOND> {
if ($3 != NONE) {
assert(AST[$3] == BINOP);
assert(AST[$3+2] == NONE);
AST[$3+2] = $2;
$$ = maketuple(REPEATUNTIL, $3);
} else {
$$ = maketuple(REPEATUNTIL, $2);
}
} |
"" { $$=0; };
RESTOFSS: <COLON> {
printf("{debug: label = TRUE}"); label = TRUE; $$ = $1;
} |
<S> {
$$ = 0;
} |
<PercentIU><SC><RESTOFCOND><S> {
if ($3 != NONE) {
assert(AST[$3] == BINOP);
assert(AST[$3+2] == NONE);
AST[$3+2] = $1;
$$ = maketuple(CONDITIONAL, $1 /* IF or UNLESS */, $3, HOLE /* for body */);
} else {
$$ = maketuple(CONDITIONAL, $1 /* IF or UNLESS */, $2, HOLE /* for body */);
}
} |
<PercentWU><S> {
$$ = $1; /* Need mechanism to hook up preceding UIs in PercentWU HOLE */
};
UIRESTOFSS: <UI><PercentIU><SC><RESTOFCOND><S> {
if ($4 != NONE) {
assert(AST[$4] == BINOP);
assert(AST[$4+2] == NONE);
AST[$4+2] = $3;
$$ = maketuple(CONDITIONAL, $2 /* IF or UNLESS */, $4, $1);
} else {
$$ = maketuple(CONDITIONAL, $2 /* IF or UNLESS */, $3, $1);
}
} |
<UI><PercentWU><S> {
assert(AST[$2+2] == HOLE);
AST[$2+2] = $1;
$$ = $2;
};
RESTOFIU: "start" { $$ = 0; } |
"thenstart" { $$ = 0; } |
"then"<UI><ELSEquote> { /* ELSE Needs special handling TODO */
if ($3 != NONE) {
// $3 = 0, or ELSESTART, ELSEIFORUNLESSSTART, ELSEIFORUNLESS, ELSE
$$ = maketuple(THENELSE, $2, $3);
} else {
$$ = $2;
}
};
ELSEquote: "elsestart" {
$$ = maketuple(ELSESTART);
} |
"else"<PercentIU><SC><RESTOFCOND><RESTOFIU> {
int cond;
if ($4 != NONE) {
assert(AST[$4] == BINOP);
assert(AST[$4+2] == NONE);
AST[$4+2] = $3;
cond = $4;
} else {
cond = $3;
}
if ($5 == 0) {
$$ = maketuple(ELSEIFORUNLESSSTART, $2, cond);
} else {
// $5 = tuple(THENELSE,
// (ELSESTART, ELSEIFORUNLESSSTART, ELSEIFORUNLESS, ELSE))
// ... *or* an arbitrary <UI> ???
// assert(AST[$5] == THENELSE);
if (AST[$5] != THENELSE) {
// looks like it is a SUBSEQUENCE
// fprintf(stdout, "*** Assertion failed: AST[%d] = %d\n", $5, AST[$5]);
// exit(1);
}
// fails on: %finish %else %if I=1 %and a=b %then a=' ' %and b='%' %and i=i+2
$$ = maketuple(ELSEIFORUNLESS, $2, cond, $5);
}
} |
"else"<UI> { $$ = maketuple(ELSE, $2);
} |
"" { $$=0; };
BPAIR: "\("<EXPR>":"<EXPR><RESTOFBPLIST>"\)" {
$$ = maketuple(MULTI, maketuple(BOUND_PAIR, $2, $4), $5);
};
CONSTquote: "="<UNARY><OPERAND><RESTOFCEXPR> {
int con; /* need to fold const expr */
if ($2 != 0) con = maketuple(MONOP, $2, $3); else con = $3;
if ($4 != 0) {
assert(AST[$4] == BINOP);
assert(AST[$4+2] == HOLE);
AST[$4+2] = con; con = $4;
}
$$ = maketuple(INITCONST, con);
} |
"" { $$=0; };
PercentSEX: "system" { $$ = maketuple(TYPE_SYSTEM); } |
"external" { $$ = maketuple(TYPE_EXTERNAL); } |
"dynamic" { $$ = maketuple(TYPE_DYNAMIC); } |
"prim" { $$ = maketuple(TYPE_PRIM); /* Added for Imp77 */ } |
"" { $$=0; };
CYCPARM: <NAME>"="<EXPR>","<EXPR>","<EXPR> {
$$ = maketuple(FORLOOP, $1, HOLE, $3, $5, $7);
/* Hole is for body of loop AND MUST BE IN AST[2] for while/until compat */
} |
"" { $$=0; };
RESTOFRFDEC: ","<RFDEC><RESTOFRFDEC> {
$$ = maketuple(MULTI, $2, $3);
} |
"" { $$=0; };
RFSTMNT: "spec"<NAME> {
$$ = maketuple(RECORDFORMATSPEC, $2);
} |
<NAME>"\("<RFDEC><RESTOFRFDEC><ALTRFDEC>"\)" {
if ($5 != NONE) {
$$ = maketuple(VARIANTRECORDFORMAT, $1, maketuple(MULTI, $3, $4), $5);
} else {
$$ = maketuple(RECORDFORMAT, $1, maketuple(MULTI, $3, $4));
}
};
RFREF: <NAME> {
$$ = $1;
} |
<RFDEC><RESTOFRFDEC><ALTRFDEC> {
if ($3 != NONE) {
$$ = maketuple(VARIANTRECORDFORMAT, $1, maketuple(MULTI, $1, $2), $3);
} else {
$$ = maketuple(RECORDFORMAT, HOLE, maketuple(MULTI, $1, $2));
}
};
RFDEC: <TYPE><RFELMNT> {
$$ = maketuple(RECORDFORMATDECLARATION, $1, $2);
} |
"\("<RFDEC><RESTOFRFDEC><ALTRFDEC>"\)" {
if ($4 != NONE) {
$$ = maketuple(VARIANTRECORDFORMAT, maketuple(MULTI, $2, $3), $4);
} else {
$$ = maketuple(RECORDFORMAT /* WRONG TAG! */, NONE, maketuple(MULTI, $2, $3));
}
};
RFELMNT: <PercentQNAMEquote><NAME><NLISTquote> {
$$ = maketuple(RECORDFORMATELEMENT, $1 /* name or arrayname */, maketuple(MULTI, $2, $3));
} |
"array"<ADECLN> {
$$ = $2; /* is this sufficient? */
};
ALTRFDEC: "or"<RFDEC><RESTOFRFDEC><ALTRFDEC> {
if ($4 != NONE) {
$$ = maketuple(VARIANTRECORDFORMAT, maketuple(MULTI, $2, $3), $4);
} else {
$$ = maketuple(RECORDFORMAT /* WRONG TAG! */, NONE, maketuple(MULTI, $2, $3));
}
} |
"" { $$=0; };
OPTINC: "+"<N> { $$ = formatf("+%s", $2); } |
"-"<N> { $$ = formatf("-%s", $2); } |
"" { $$=0; };
ATquote: "@" { $$ = formatf("%s", @1.text); } |
"=" { $$ = formatf("%s", @1.text); } |
"" { $$=0; };
XAPP: "\("<EXPR><RESTOFAPP>"\)" {
$$ = maketuple(MULTI, $2, $3);
};
RECORDFIELD: "_"<NAME><APP><RECORDFIELD> {
int field;
if ($3 != 0) {
field = maketuple(ARRAYINDEX, $2, $3);
} else {
field = $2;
}
if ($4 != 0) {
int node = $4;
assert(AST[node+1] == HOLE);
AST[node+1] = maketuple(RECORDFIELD, HOLE, field);
$$ = node;
} else {
$$ = maketuple(RECORDFIELD, HOLE, field);
}
} |
"" { $$=0; };
XRECORDFIELD: "_"<NAME><APP><RECORDFIELD> {
int field;
if ($3 != 0) {
field = maketuple(ARRAYINDEX, $2, $3);
} else {
field = $2;
}
if ($4 != 0) {
int node = $4;
assert(AST[node+1] == HOLE);
AST[node+1] = maketuple(RECORDFIELD, HOLE, field);
$$ = node;
} else {
$$ = maketuple(RECORDFIELD, HOLE, field);
}
};
NAMEAPP: <NAME><XAPP> { /* NOTE: MAY BE AN ARRAY ACCESS */
$$ = maketuple(PROCCALL_OR_ARRAY_OR_MAP, $1, $2);
} | <NAME> {
$$ = maketuple(PROCCALL, $1, 0);
};
BASIC:
<NAME><XAPP><XRECORDFIELD><ASSOP><EXPR> {
/* record array element with subfield assignment */
/* TODO fred(1)_jim = 3 may be a map to a record */
int lhs = maketuple(ARRAYINDEX, $1, $2);
assert(AST[$3+1] == HOLE);
AST[$3+1] = lhs;
$$ = maketuple(BINOP, $4, $3, $5);
} |
<NAME><XRECORDFIELD><ASSOP><EXPR> {
/* record with subfield assignment */
//assert(AST[$2+1] == HOLE);
//fprintf(stdout, " /* sub sub field bug to be fixed (2) */\n");
AST[$2+1] = $1; // AGAIN, "." vs "->"??
$$ = maketuple(BINOP, $3, $2, $4);
} |
<NAME><XAPP><ASSOP><EXPR> {
/* array element assignment */
$$ = maketuple(BINOP, $3, maketuple(PROCCALL_OR_ARRAY_OR_MAP, $1, $2), $4);
} |
<NAME><ASSOP><EXPR> {
/* variable or map assignment */
$$ = maketuple(BINOP, $2, $1, $3);
} |
<NAME><APP>":" {
/* Switch label. possibly regular label if APP is null??? */
$$ = maketuple(SWITCHLABEL, $1, $2);
} |
<NAME>":" {
$$ = maketuple(LABEL, $1);
} |
<NAME><XAPP> {
/* procedure call with params. */
$$ = maketuple(PROCCALL, $1, $2);
} |
<NAME> {
/* procedure call, no params. */
$$ = maketuple(PROCCALL, $1, 0);
};
/* NOTE: imp80 does not allow %if a=b %then x=y %and %start */
AUI: "and"<UI> {
if (AST[$2] == SUBSEQUENCE) {
$$ = maketuple(SUBSEQUENCE, HOLE, $2);
} else {
$$ = maketuple(SUBSEQUENCE, HOLE, maketuple(SUBSEQUENCE, $2, 0));
}
} |
"" { $$=0; };
UI: <BASIC>"and"<UI> {
if (AST[$3] != SUBSEQUENCE) {
$$ = maketuple(SUBSEQUENCE, $1, maketuple(SUBSEQUENCE, $3, 0));
} else {
$$ = maketuple(SUBSEQUENCE, $1, $3);
}
/* Much worse parsing performance, easier to handle however */
} | <BASIC> {
$$ = $1;
/* Much worse parsing performance, easier to handle however */
} |
"->" "[1-9][0-9]*" { $$ = maketuple(GOTO_LABEL,
sformatf("L_%s", @2.text)); /* Added for Imp15 */} |
"->"<NAME><APP> {
if ($3 != NONE) {
$$ = maketuple(GOTO_SWITCH, $2, $3);
} else {
$$ = maketuple(GOTO_LABEL, $2);
}
} |
"return" { $$ = maketuple(RETURN); } |
"true" { $$ = maketuple(RETURN_TRUE); } |
"false" { $$ = maketuple(RETURN_FALSE); } |
"result"<ASSOP><EXPR> { $$ = maketuple(RESULT, $2, $3); } |
"monitorstop" {
$$ = maketuple(SUBSEQUENCE,
maketuple(MONITOR),
maketuple(SUBSEQUENCE,
maketuple(STOP),
0));
} |
"monitor"<AUI> {
if ($2 != NONE) { /* %monitor, followed by UI. */
assert(AST[$2] == SUBSEQUENCE);
assert(AST[$2+1] == HOLE);
assert((AST[$2+2] == 0) || (AST[AST[$2+2]] == SUBSEQUENCE));
AST[$2+1] = maketuple(MONITOR);
$$ = $2;
} else {
$$ = maketuple(MONITOR);
}
} |
"stop" { $$ = maketuple(STOP); } |
"signal"<PercentEVENTquote><CEXPR><OPEXPR><OPEXPR> {
$$ = maketuple(SIGNAL, $3, $4, $5); /* should make into a signal bitmask */
} |
"exit" { $$ = maketuple(BREAK, HOLE /* destination */); } |
"continue" { $$ = maketuple(CONTINUE, HOLE /* destination */); };
SWITCHDEC: <NAME><NLISTquote>"\("<EXPR>":"<EXPR>"\)"<RESTOFSWLIST> {
$$ = maketuple(SWITCHDECL, $1, $2, $4, $6, $8);
};
RESTOFSWLIST: ","<SWITCHDEC> {
$$ = $2;
} |
"" { $$=0; };
SS: <lookahead> { /* always fails - hack to save text of every line!*/
} |
<eof> { exit_flag = TRUE;
/* Successful parse: generate the C code now. */
entrypoint = reverse_list(entrypoint);
//fixup_scopes(entrypoint, 0);
printf("//============================================================================\n");
codegen(entrypoint, 0);
} |
<UIRESTOFSS> {
label = FALSE;
entrypoint = maketuple(SEQUENCE, $1, entrypoint);
$$ = entrypoint;
} |
<UI><RESTOFSS> {
label = FALSE;
if ($2 == NONE) {
entrypoint = maketuple(SEQUENCE, $1, entrypoint);
$$ = entrypoint;
} else {
entrypoint = maketuple(SEQUENCE, maketuple(SEQUENCE, $1, $2), entrypoint);
$$ = entrypoint;
}
} |
"[1-9][0-9]*" ":" "$" { /* Added for Imp15 */
label = FALSE;
entrypoint = maketuple(SEQUENCE, maketuple(NUMERICLABEL, (int)sformatf("%s", @1.text)), entrypoint);
$$ = entrypoint;
} |
<TEXT> "$" {
entrypoint = maketuple(SEQUENCE, maketuple(COMMENT, $1), entrypoint);
$$ = entrypoint;
} |
<PercentIU><SC><RESTOFCOND><RESTOFIU><S> {
int cond, hack;
if ($3 != NONE) {
cond = $3;
assert(AST[cond] == BINOP);
assert(AST[cond+2] == HOLE);
AST[cond+2] = $2;
} else cond = $2;
// if <$4/RESTOFIU> is 0, it's a "start"...
if ($4 == 0) {
entrypoint = maketuple(SEQUENCE,
maketuple(IFORUNLESSSTART, $1, cond), entrypoint);
$$ = entrypoint;
} else {
// PROBLEM CASE: fixed in fixup_...
// %if j=k %then j=j %else %if k=j %then k=k %else %start
entrypoint = maketuple(SEQUENCE,
maketuple(CONDITIONAL, $1, cond, $4), entrypoint);
$$ = entrypoint;
}
} |
"finish"<ELSEquote><S> {
if ($2 != NONE) {
int stmnt = 0;
// $2 = ELSESTART, ELSEIFORUNLESSSTART, ELSEIFORUNLESS, ELSE
if (AST[$2] == ELSESTART) stmnt = FINISHELSESTART;
if (AST[$2] == ELSEIFORUNLESSSTART) stmnt = FINISHELSEIFORUNLESSSTART;
if (AST[$2] == ELSEIFORUNLESS) stmnt = FINISHELSEIFORUNLESS;
if (AST[$2] == ELSE) stmnt = FINISHELSE;
if (stmnt == 0) {
fprintf(stderr, "finish<ELSEquote><S> -> $2=%d", $2);
fprintf(stdout, "finish<ELSEquote><S> -> $2=%d", $2);
exit(1);
}
AST[$2] = stmnt;
entrypoint = maketuple(SEQUENCE, $2, entrypoint);
$$ = entrypoint;
/* FLOW CONTROL NEEDS TO BE PATCHED UP IN THE AST! */
} else {
entrypoint = maketuple(SEQUENCE, maketuple(FINISH), entrypoint);
$$ = entrypoint;
}
} |
"cycle"<CYCPARM><S> {
if ($2 != NONE) {
entrypoint = maketuple(SEQUENCE, $2, entrypoint); /* CYCPARM passes up FORLOOP TODO */
$$ = entrypoint;
} else {
entrypoint = maketuple(SEQUENCE, maketuple(LOOP), entrypoint);
$$ = entrypoint;
}
} |
"repeat"<RESTOFREPEAT><S> {
/* Should link these up with starting FORLOOP/LOOP */
if ($2 != NONE) {
entrypoint = maketuple(SEQUENCE, $2, entrypoint); /* RESTOFREPEAT passes up REPEATUNTIL TODO */
$$ = entrypoint;
} else {
entrypoint = maketuple(SEQUENCE, maketuple(ENDLOOP), entrypoint);
$$ = entrypoint;
}
} |
<PercentWU>"cycle"<S> {
/* while/until/for - but not "" */
entrypoint = maketuple(SEQUENCE, $1, entrypoint); /* PercentWU passes up WHILELOOP, UNTILLOOP, or FORLOOP */
$$ = entrypoint;
} |
<TYPE><DECLN><S> {
int decln = $2;
assert(AST[decln+1] == HOLE || (AST[$1] == TYPE_RECORD)); // HOLE is first param for all 3 DECLN types now
if (AST[decln+1] == HOLE) AST[decln+1] = $1;
debug_ast(decln); // with plugged hole
if ((AST[$1] == TYPE_RECORD) && (AST[$1+1] == HOLE)) {
// need to do a bit of fixup here for record declarations in the old form of %record r(rfm)
// but be careful because "%record (*) r" also comes through here...
fprintf(stdout, "// UNKNOWN RECORD TYPE\n");
}
entrypoint = maketuple(SEQUENCE, $2, entrypoint);
$$ = entrypoint;
} | "realslong" <S> {
reals_long = TRUE; /* probably not appropriate to put this in the parser but it works */
} | "realsnormal" <S> {
reals_long = FALSE;
} | "endofprogramme"<S> {
entrypoint = maketuple(SEQUENCE, maketuple(ENDPROG), entrypoint);
$$ = entrypoint;
} | "endofprogram"<S> {
entrypoint = maketuple(SEQUENCE, maketuple(ENDPROG), entrypoint);
$$ = entrypoint;
} | "endoffile"<S> {
entrypoint = maketuple(SEQUENCE, maketuple(ENDFILE), entrypoint);
$$ = entrypoint;
} | "endofperm"<S> {
entrypoint = maketuple(SEQUENCE, maketuple(ENDPERM), entrypoint);
$$ = entrypoint;
} | "endoflist"<S> {
entrypoint = maketuple(SEQUENCE, maketuple(ENDLIST), entrypoint);
$$ = entrypoint;
} | "end"<S> {
entrypoint = maketuple(SEQUENCE, maketuple(ENDBLOCKPROCFN), entrypoint); /* end of scope for symtab */
$$ = entrypoint;
} |
"recordformat"<RFSTMNT><S> {
entrypoint = maketuple(SEQUENCE, $2, entrypoint);
$$ = entrypoint;
} |
<PercentSEX><RT><PercentSPECquote><NAME><ALIASquote><FPP><S> {
entrypoint = maketuple(SEQUENCE, maketuple(PROCDEF, $1, $2, $3, $4, $5, $6), entrypoint);
$$ = entrypoint;
} | <XOWN><TYPE><OWNDEC> {
entrypoint = maketuple(SEQUENCE, maketuple(OWNDEC, $1, $2, $3), entrypoint);
$$ = entrypoint;
} |
"include"<CONST> { /* No <S>? */
entrypoint = maketuple(SEQUENCE, maketuple(INCLUDE, $2), entrypoint);
$$ = entrypoint;
} |
"begin"<S> {
entrypoint = maketuple(SEQUENCE, maketuple(BEGINBLOCK, HOLE), entrypoint);
$$ = entrypoint;
} |
"on"<PercentEVENTquote><CEXPR><RESTOFELIST>"start"<S> {
entrypoint = maketuple(SEQUENCE, maketuple(ONEVENT, $3, $4, HOLE), entrypoint); /*NOTESTART*/
$$ = entrypoint;
} |
"switch"<SWITCHDEC><S> {
entrypoint = maketuple(SEQUENCE, $2, entrypoint);
$$ = entrypoint;
} |
"list"<S> {
} |
"else"<S> {
entrypoint = maketuple(SEQUENCE, maketuple(FINISHELSESTART), entrypoint);
$$ = entrypoint;
} |
"else"<PercentIU><SC><RESTOFCOND><S> { /* else if for imp77 */
int cond;
if ($4 != NONE) {
cond = $4;
assert(AST[cond] == BINOP);
AST[cond+2] = $3;
} else cond = $3;
entrypoint = maketuple(SEQUENCE, maketuple(FINISHELSEIFSTART, $2, cond), entrypoint); /* CONDITIONAL?? */
$$ = entrypoint;
/* $$ = formatf("ELSE: if/unless=%d sc=%d restofcond=%d\n", $2, $3, $4); */
} |
"\*"<UCI> {
entrypoint = maketuple(SEQUENCE, maketuple(ASM, $2), entrypoint);
$$ = entrypoint;
} |
"trustedprogram"<S> {
} |
"mainep"<NAME><S> {
} |
"control"<CONST><S> {
} |
"diagnose"<CONST><S> {
} |
"printtext"<OLDSTRING> {
entrypoint = maketuple(SEQUENCE, maketuple(PROCCALL, "printstring", $2), entrypoint);
$$ = entrypoint;
} |
<NAME>"\(\*\):" {
/* default case statement. Ought to have been picked up in BASIC */
entrypoint = maketuple(SEQUENCE, maketuple(DEFAULTCASE, $1), entrypoint);
$$ = entrypoint;
} |
<S> { };
ASSOP: "==" { $$=OP_PTRASSIGN; } |
"=" { $$=OP_ASSIGN; } |
"<-" { $$=OP_JAMTRANSFER; } |
"->" { $$=OP_STRINGRESOLVE; };
COLON: ":" { $$=formatf("%s", @1.text); };
COMP: "==" { $$=OP_PTREQ; } |
"<=" { $$=OP_LE; } |
">=" { $$=OP_GE; } |
">" { $$=OP_GT; } |
"->" { $$=OP_TESTRESOLVE; } |
"=" { $$=OP_EQ; } |
<notequivcomp> { $$=$1; } | <notcomp> { $$=$1; } |
"<" { $$=OP_LT; };
notcomp: "#" { $$=OP_NE; } |
"\\=" { $$=OP_NE; } |
"<>" { $$=OP_NE; };
notequivcomp: "##" { $$=OP_PTRNE; } |
"\\==" { $$=OP_PTRNE; };
COMPtwo:
"==" { $$=OP_PTREQ; } |
"<=" { $$=OP_LE; } |
">=" { $$=OP_GE; } |
">" { $$=OP_GT; } |
"->" { $$=OP_TESTRESOLVE; /* SOME OF THESE ARE INVALID IN A DOUBLE-SIDED */} |
"=" { $$=OP_EQ; } |
<notequivcomp> { $$=$1; } | <notcomp> { $$=$1; } |
"<" { $$=OP_LT; };
CONST: <realconst> { $$=maketuple(CONST, REAL, $1); } |
<basedconst> { $$=maketuple(CONST, INTEGER, $1); } |
<intconst> { $$=maketuple(CONST, INTEGER, $1); } |
<stringconst> { $$=maketuple(CONST, STRING, $1); } |
<lettercharconst> { $$=$1; };
realconst: "[0-9][0-9]*\.[0-9][0-9]*E[0-9][0-9]*" { $$=sformatf("%s", @1.text); } |
"[0-9][0-9]*\.[0-9][0-9]*" { $$=sformatf("%s", @1.text); } |
"[0-9][0-9]*@[0-9][0-9]*" { $$=sformatf("%s", @1.text); };
basedconst: "[0-9][0-9]*_[0-9A-Z][0-9A-Z]*" {
if (strncmp(@1.text, "16_", 3) == 0) {
$$=sformatf("0x%s", @1.text+3);
} else if (strncmp(@1.text, "2_", 2) == 0) {
$$=sformatf("0b%s", @1.text+2);
} else {
$$=sformatf("%s", @1.text); // needs work
}
};
intconst: "[0-9][0-9]*" { $$=sformatf("%s", @1.text); };
stringconst: <TEXTTEXT> { $$=$1; } |
"E" <TEXTTEXT> { $$=sformatf("E%s", str($2)); /* EBCDIC string */ };
lettercharconst: <squote> <schar> <squote> { /* These need some work for type determination */
$$=maketuple(LETTERCHARCONST, str(ccharconst('c', str($2))));
} |
"[RHX]" <squote> <hexchars> <squote> {
$$=sformatf("%s", str(ccharconst(*@1.text, str($3))));
} |
"B" <squote> <binchars> <squote> {
char *s = str($3);
int c = *@1.text;
char *t = ccharconst('B', s);
assert(c == 'B');
assert(t != NULL);
$$=sformatf("%s", str(t));
} |
"K" <squote> <octchars> <squote> {
$$=sformatf("%s", str(ccharconst(*@1.text, str($3))));
} |
"[CMD]" <squote> <mchars> <squote> {
/* I'm not sure what the syntax of D'...' is */
/* so I'll allow anything, for now */
// M'''' causes crash ...
$$=sformatf("%s", str(ccharconst(*@1.text, str($3))));
};
squote: "'" { };
mchar: <squote><squote> {
$$=sformatf("%c", SQUOTE); // fixed for M''''
} |
<!squote> "." { $$=sformatf("%s", @2.text); };
schar: <squote><squote> {
$$=sformatf("%c%c", BSLASH, SQUOTE);
} |
<!squote> "." { $$=sformatf("%s", @2.text); };
schars: <schar> <schars> { $$=sformatf("%s%s", str($1), str($2)); } |
"" { $$=sformatf(""); };
mchars: <mchar> <mchars> { $$=sformatf("%s%s", str($1), str($2)); } |
"" { $$=sformatf(""); };
hexchars: "[0-9A-Fa-f][0-9A-Fa-f]*" { $$=sformatf("%s", @1.text); };
octchars: "[0-7][0-7]*" { $$=sformatf("%s", @1.text); };
binchars: "[01][01]*" { $$=sformatf("%s", @1.text); };
DOWN: "" { /* Internal routine to push a level */ };
DUMMYSTART: "" { };
HOLE: "" { };
ICONST: "[0-9][0-9]*" { $$=sformatf("%s", @1.text); };
LISTOFF: "" { };
LISTON: "" { };
MARK: "" { };
NAME: "[A-Z][A-Z0-9]*" <!eitherquote> { $$=sformatf("%s", strlwr(@1.text)); };
eitherquote: "['\"]" { /* Protects M'fred' or E"string" from being seen as
simple names M or E */ };
NOTECYCLE: "" { };
NOTEFINISH: "" { };
NOTEREPEAT: "" { };
NOTESTART: "" { };
N: "[0-9][0-9]*" { /* 16-bit */ $$=sformatf("%s", @1.text); };
Nbyte: "[0-9][0-9]*" { /* between 0 and 255 */ $$=sformatf("%s", @1.text); };
OP: "+" { $$=OP_ADD; } |
"-" { $$=OP_SUB; } |
"\&" { $$=OP_BITAND; } |
"\*\*\*\*" { $$=OP_IEXP; } |
"\*\*" { $$=OP_EXP; } |
"\*" { $$=OP_MUL; } |
"!!" { $$=OP_EOR; } |
"!" { $$=OP_IOR; } |
"//" { $$=OP_IDIV; } |
"/" { $$=OP_RDIV; } |
">>" { $$=OP_SHR; } |
"<<" { $$=OP_SHL; } |
"\." { $$=OP_CONCAT; } |
"\\\\" { $$=OP_IEXP; /* WHAT IS THIS OPERATOR??? Emas integer exponentiation?*/ } |
"\^" { $$=OP_EXP; /* Imp77-only */ } |
"\\" { $$=OP_EXP; };
READLINEquery: "$" { $$=formatf("%", "s\"); } |
"" { $$=0; };
SETNEM: "n[A-Z][A-Z0-9]*" <optsub> { /* Set Mnemonic */ $$=formatf("%", @1.text); };
optsub: "" { $$=sformatf("s__%", @1.text); } |
"" { $$=0; };
S: "s$" { /* also ';', but we convert earlier */ } |
";" { };
OLDSTRING: <squote> <oldstringchars> <squote> {
$$=sformatf("%c%s%", DQUOTE, str($2), DQUOTE);
};
oldstringchars: <squote><squote> <oldstringchars> {
$$=sformatf("c%c%", SQUOTE, str($3));
} |
<!squote> "s.[^']*" <oldstringchars> {
$$=sformatf("%s%s", @2.text, str($3));
} |
"$" <oldstringchars> {
$$=sformatf("%cn%s", BSLASH, str($2));
} |
"" { $$=sformatf(""); };
TEXTTEXT: <quote> <stringchars> <quote> {
$$=sformatf("%s", str($2));
/* $$=sformatf("%c%s%c", DQUOTE, str($2), DQUOTE);*/
};
quote: "\"" { $$=1; };
stringchars: <quote><quote> <stringchars> {
$$=sformatf("%c%c%s", BSLASH, DQUOTE, str($3));
} |
<!quote> ".[^\"]*" <stringchars> {
$$=sformatf("%s%s", @2.text, str($3));
} |
"$" <stringchars> {
$$=sformatf("%cn%s", BSLASH, str($2));
} |
"" { $$=sformatf(""); };
TEXT: "#.*" { $$=sformatf("%s", @1.text); } |
"!.*" { $$=sformatf("%s", (@1.text)+1); } |
"comment.*" { $$=sformatf("%s", (@1.text)+7); };
UCI: ".*" {
/* unparsed m/c code */
$$=sformatf("%s", @1.text);
};
commaquote: "," { $$=1; } |
<!rparen> "" { /* fast error recovery */ $$=0; };
rparen: "\)" { };
UNARY: "+" { $$=UOP_POS; } |
"-" { $$=UOP_NEG; } |
"\~" { $$=UOP_BITNOT; } |
"\\" { $$=UOP_BITNOT; } |
"" { $$=0; };
%{
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 setdebug_parse(YYTYPE **p)
{
_debug = TRUE;
return(TRUE);
}
int candebug_parse(YYTYPE **p)
{
_debug = FALSE;
return(TRUE);
}
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] = '\';
fgets(line, 127, yyin);
s = strchr(line, '0\'); if (s != NULL) *s = 'n\';
if (verbose) {
fprintf(stderr, "INPUT: %s\n", line);
}
do_backtrack(__pos);
stackrelease(__stack);
if (*line != '0\') entrypoint = maketuple(SEQUENCE, maketuple(LINE, ++lineno, addstr(line)), entrypoint);
fflush(stdout);
return(FALSE);
}
%}
ÿÿ