From e840718997348c252188191082deaa72cfec33fa Mon Sep 17 00:00:00 2001 From: Nixon Enraght-Moony Date: Thu, 12 May 2022 14:47:58 +0100 Subject: [PATCH] init --- t3x9-book/Makefile | 23 + t3x9-book/README | 20 + t3x9-book/_csums | 14 + t3x9-book/dump.c | 21 + t3x9-book/t.c | 1562 ++++++++++++++++++++++++++++ t3x9-book/t.elf | Bin 0 -> 31436 bytes t3x9-book/t.pl1 | 30 + t3x9-book/t.pl2 | 11 + t3x9-book/t.pl3 | 23 + t3x9-book/t.pl4 | 23 + t3x9-book/t.t | 1574 +++++++++++++++++++++++++++++ t3x9-book/t3x-history.txt | 59 ++ t3x9-book/t3x.bnf | 221 ++++ t3x9-book/t3x.txt | 689 +++++++++++++ t3x9-book/test.t | 47 + t3x9r3-extended/CHANGES | 29 + t3x9r3-extended/MANIFEST | 17 + t3x9r3-extended/Makefile | 42 + t3x9r3-extended/README | 30 + t3x9r3-extended/_csums | 16 + t3x9r3-extended/dump.c | 21 + t3x9r3-extended/t-vm.t | 1651 ++++++++++++++++++++++++++++++ t3x9r3-extended/t.c | 1616 +++++++++++++++++++++++++++++ t3x9r3-extended/t.elf | Bin 0 -> 33912 bytes t3x9r3-extended/t.t | 1682 +++++++++++++++++++++++++++++++ t3x9r3-extended/t.vm | Bin 0 -> 19335 bytes t3x9r3-extended/t3x-history.txt | 61 ++ t3x9r3-extended/t3x.bnf | 221 ++++ t3x9r3-extended/t3x.txt | 768 ++++++++++++++ t3x9r3-extended/tcdis.c | 251 +++++ t3x9r3-extended/tcvm.c | 318 ++++++ t3x9r3-extended/test.t | 47 + 32 files changed, 11087 insertions(+) create mode 100644 t3x9-book/Makefile create mode 100644 t3x9-book/README create mode 100644 t3x9-book/_csums create mode 100644 t3x9-book/dump.c create mode 100644 t3x9-book/t.c create mode 100755 t3x9-book/t.elf create mode 100644 t3x9-book/t.pl1 create mode 100644 t3x9-book/t.pl2 create mode 100644 t3x9-book/t.pl3 create mode 100644 t3x9-book/t.pl4 create mode 100644 t3x9-book/t.t create mode 100644 t3x9-book/t3x-history.txt create mode 100644 t3x9-book/t3x.bnf create mode 100644 t3x9-book/t3x.txt create mode 100644 t3x9-book/test.t create mode 100644 t3x9r3-extended/CHANGES create mode 100644 t3x9r3-extended/MANIFEST create mode 100644 t3x9r3-extended/Makefile create mode 100644 t3x9r3-extended/README create mode 100644 t3x9r3-extended/_csums create mode 100644 t3x9r3-extended/dump.c create mode 100644 t3x9r3-extended/t-vm.t create mode 100644 t3x9r3-extended/t.c create mode 100644 t3x9r3-extended/t.elf create mode 100644 t3x9r3-extended/t.t create mode 100755 t3x9r3-extended/t.vm create mode 100644 t3x9r3-extended/t3x-history.txt create mode 100644 t3x9r3-extended/t3x.bnf create mode 100644 t3x9r3-extended/t3x.txt create mode 100644 t3x9r3-extended/tcdis.c create mode 100644 t3x9r3-extended/tcvm.c create mode 100644 t3x9r3-extended/test.t diff --git a/t3x9-book/Makefile b/t3x9-book/Makefile new file mode 100644 index 0000000..2f1b8e9 --- /dev/null +++ b/t3x9-book/Makefile @@ -0,0 +1,23 @@ +all: t0 t.elf + +t0: t.c t.t + cc -static -o t0 t.c + +t.elf: test + cp t3 t.elf + +test: t0 + touch t1 t2 t3; chmod +x t1 t2 t3 + ./t0 t1 && ./t1 t2 && ./t2 t3 && cmp t2 t3 + +mksums: clean + ls | grep -v t3x9.tgz | grep -v _csums | csum -m >_csums + +csums: + csum -u <_csums >_csums.new && mv -f _csums.new _csums + +clean: + rm -f t0 t1 t2 t3 a.out dump *.o *.core t3x9.tgz + +arc: clean + (cd ..; tar cvf - t3x9 | gzip -9 >t3x9.tgz); mv -f ../t3x9.tgz . diff --git a/t3x9-book/README b/t3x9-book/README new file mode 100644 index 0000000..d70ffe3 --- /dev/null +++ b/t3x9-book/README @@ -0,0 +1,20 @@ + + This is the T3X9 compiler, as described in the book + + "Write Your Own Compiler" + by Nils M Holm + + More details about the book can be found at T3X.ORG. + + To compile the compiler on FreeBSD, just do + + chmod +x t.elf && ./t.elf t.new + + To compile it on any system providing a C89 compiler: + + cc -o t0 t.c && ./t0 t.new + + NOTE: some patches have been applied to the compiler since + publication. The source code in the "t.t" file reflects the + latest patchlevel. Patches are contained in the files t.pl?. + diff --git a/t3x9-book/_csums b/t3x9-book/_csums new file mode 100644 index 0000000..c83b325 --- /dev/null +++ b/t3x9-book/_csums @@ -0,0 +1,14 @@ +41114 1 Makefile +50469 1 README +14051 1 dump.c +15789 26 t.c +55434 31 t.elf +16731 1 t.pl1 +41318 1 t.pl2 +55592 1 t.pl3 +47836 1 t.pl4 +9277 28 t.t +39214 3 t3x-history.txt +45560 3 t3x.bnf +58677 17 t3x.txt +50723 1 test.t diff --git a/t3x9-book/dump.c b/t3x9-book/dump.c new file mode 100644 index 0000000..4b5989b --- /dev/null +++ b/t3x9-book/dump.c @@ -0,0 +1,21 @@ +#include + +#define Z 65536 +#define byte unsigned char + +byte T[Z]; + +int main(void) { + int k, i; + + k = fread(T, 1, Z, stdin); + printf(".byte "); + for (i=0x74; i ELF-FreeBSD-386 compiler + * Nils M Holm, 2017, CC0 license + * https://creativecommons.org/publicdomain/zero/1.0/ + */ + +#include +#include +#include +#include + +#define BPW 4 + +#define PROG_SIZE 0x10000 + +#define TEXT_VADDR 0x08048000 +#define DATA_VADDR 0x08058000 + +#define TEXT_SIZE 0x10000 +#define DATA_SIZE 0x10000 + +#define NRELOC 10000 + +#define STACK_SIZE 100 + +#define SYMTBL_SIZE 1000 +#define NLIST_SIZE 10000 + +#define byte unsigned char +#define word unsigned int + +int Stk[STACK_SIZE], Sp = 0; + +int Line = 1; + +void aw(char *m, char *s) { + fprintf(stderr, "t3x9: %d: %s", Line, m); + if (s != NULL) + fprintf(stderr, ": %s", s); + fputc('\n', stderr); + exit(1); +} + +void oops(char *m, char *s) { + fprintf(stderr, "t3x9: internal error\n"); + aw(m, s); +} + +void push(int x) { + if (Sp >= STACK_SIZE) + aw("too many nesting levels", NULL); + Stk[Sp++] = x; +} + +int tos(void) { + return Stk[Sp-1]; +} + +int pop(void) { + if (Sp < 1) + oops("stack underflow", NULL); + return Stk[--Sp]; +} + +void swap(void) { + int t; + + if (Sp < 2) + oops("stack underflow", NULL); + t = Stk[Sp-1]; + Stk[Sp-1] = Stk[Sp-2]; + Stk[Sp-2] = t; +} + +/* + * Symbol table + */ + +struct _symbol { + char *name; + int flags; + int value; +}; + +#define sym struct _symbol + +#define GLOBF 1 +#define CNST 2 +#define VECT 4 +#define DECL 8 +#define FUNC 16 + +sym Sym[SYMTBL_SIZE]; +char Nlist[NLIST_SIZE]; + +int Yp = 0, Np = 0; + +sym *find(char *s) { + int i; + + for (i=Yp-1; i>=0; i--) { + if (!strcmp(Sym[i].name, s)) + return &Sym[i]; + } + return NULL; +} + +sym *lookup(char *s, int f) { + sym *y; + + y = find(s); + if (NULL == y) + aw("undefined", s); + if ((y->flags & f) != f) + aw("unexpected type", s); + return y; +} + +sym *add(char *s, int f, int v) { + sym *y; + + y = find(s); + if (y != NULL && (y->flags & GLOBF) == (f & GLOBF)) { + if (y->flags & DECL && f & FUNC) + return y; + else + aw("redefined", s); + } + if (Yp >= SYMTBL_SIZE) + aw("too many symbols", NULL); + Sym[Yp].name = strdup(s); + Sym[Yp].flags = f; + Sym[Yp].value = v; + Yp++; + return &Sym[Yp-1]; +} + +/* + * Emitter + */ + +#define HEADER_SIZE 0x74 +#define PAGE_SIZE 0x1000 + +struct _reloc { + int addr; + int seg; +}; + +#define reloc struct _reloc + +reloc Rel[NRELOC]; + +byte Text[TEXT_SIZE]; +byte Data[DATA_SIZE]; + +int Rp = 0, Tp = 0, Dp = 0, Lp = 0; + +int Loaded = 0; + +#define CG_INIT "89e5" +#define CG_PUSH "50" +#define CG_LDVAL "b8,w" +#define CG_LDADDR "b8,a" +#define CG_LDLREF "8d85,w" +#define CG_LDGLOB "a1,a" +#define CG_LDLOCL "8b85,w" +#define CG_CLEAR "31c0" +#define CG_STGLOB "a3,a" +#define CG_STLOCL "8985,w" +#define CG_STINDR "5b8903" +#define CG_STINDB "5b8803" +#define CG_ALLOC "81ec,w" +#define CG_DEALLOC "81c4,w" +#define CG_LOCLVEC "89e050" +#define CG_GLOBVEC "8925,a" +#define CG_HALT "68,w5031c040cd80" +#define CG_INDEX "c1e0025b01d8" +#define CG_DEREF "8b00" +#define CG_INDXB "5b01d8" +#define CG_DREFB "89c331c08a03" +#define CG_CALL "e8,w" +#define CG_MARK ",m" +#define CG_JUMPFWD "e9,>" +#define CG_JUMPBACK "e9,<" +#define CG_ENTER "5589e5" +#define CG_EXIT "5dc3" +#define CG_RESOLV ",r" +#define CG_NEG "f7d8" +#define CG_INV "f7d0" +#define CG_LOGNOT "f7d819c0f7d0" +#define CG_ADD "5b01d8" +#define CG_SUB "89c35829d8" +#define CG_MUL "5bf7e3" +#define CG_DIV "89c35899f7fb" +#define CG_MOD "89c35899f7fb89d0" +#define CG_AND "5b21d8" +#define CG_OR "5b09d8" +#define CG_XOR "5b31d8" +#define CG_SHL "89c158d3e0" +#define CG_SHR "89c158d3e8" +#define CG_EQ "5b39c30f95c20fb6c248" +#define CG_NEQ "5b39c30f94c20fb6c248" +#define CG_LT "5b39c30f9dc20fb6c248" +#define CG_GT "5b39c30f9ec20fb6c248" +#define CG_LE "5b39c30f9fc20fb6c248" +#define CG_GE "5b39c30f9cc20fb6c248" +#define CG_JMPFALSE "09c00f84,>" +#define CG_JMPTRUE "09c00f85,>" +#define CG_FOR "5b39c30f8d,>" +#define CG_FORDOWN "5b39c30f8e,>" +#define CG_INCGLOB "8105,w" +#define CG_INCLOCL "8185,w" +#define CG_WORD ",w" + +#define CG_P_READ \ + "8b4424048744240c89442404b803000000cd800f830300000031c048c3" +#define CG_P_WRITE \ + "8b4424048744240c89442404b804000000cd800f830300000031c048c3" +#define CG_P_MEMCOMP \ + "8b74240c8b7c24088b4c240441fcf3a609c90f850300000031c0c38a46ff2a47ff66986699c3" +#define CG_P_MEMCOPY \ + "8b74240c8b7c24088b4c2404fcf3a4c3" +#define CG_P_MEMFILL \ + "8b7c240c8b4424088b4c2404fcf3aac3" +#define CG_P_MEMSCAN \ + "8b7c240c8b4424088b4c24044189fafcf2ae09c90f840600000089f829d048c331c048c3" + +void gen(char *s, int v); + +void spill(void) { + if (Loaded) + gen(CG_PUSH, 0); + else + Loaded = 1; +} + +int loaded(void) { + return Loaded; +} + +void clear(void) { + Loaded = 0; +} + +int hex(int c) { + if (isdigit(c)) + return c-'0'; + else + return c-'a'+10; +} + +void emit(int x) { + Text[Tp++] = (byte) x; +} + +void emitw(int x) { + emit(255&x); + emit(255&x>>8); + emit(255&x>>16); + emit(255&x>>24); +} + +void tpatch(int a, int x) { + Text[a] = 255&x; + Text[a+1] = 255&x>>8; + Text[a+2] = 255&x>>16; + Text[a+3] = 255&x>>24; +} + +int tfetch(int a) { + return Text[a] | (Text[a+1]<<8) | (Text[a+2]<<16) | (Text[a+3]<<24); +} + +void data(int x) { + Data[Dp++] = (byte) x; +} + +void dataw(int x) { + data(255&x); + data(255&x>>8); + data(255&x>>16); + data(255&x>>24); +} + +void dpatch(int a, int x) { + Data[a] = 255&x; + Data[a+1] = 255&x>>8; + Data[a+2] = 255&x>>16; + Data[a+3] = 255&x>>24; +} + +int dfetch(int a) { + return Data[a] | (Data[a+1]<<8) | (Data[a+2]<<16) | (Data[a+3]<<24); +} + +void tag(int seg) { + if (Rp >= NRELOC) + oops("relocation buffer overflow", NULL); + Rel[Rp].seg = seg; + Rel[Rp].addr = 't' == seg? Tp-BPW: Dp-BPW; + Rp++; +} + +void resolve(void) { + int i, a, dist; + + dist = DATA_VADDR + (HEADER_SIZE + Tp) % PAGE_SIZE; + for (i=0; i' == s[1]) { + push(Tp); + emitw(0); + } + else if ('<' == s[1]) { + emitw(pop()-Tp-BPW); + } + else if ('r' == s[1]) { + x = pop(); + tpatch(x, Tp-x-BPW); + } + else { + oops("bad code", NULL); + } + } + else { + emit(hex(*s)*16+hex(s[1])); + } + s += 2; + } +} + +void builtin(char *name, int arity, char *code) { + gen(CG_JUMPFWD, 0); + add(name, GLOBF|FUNC | (arity << 8), Tp); + gen(code, 0); + gen(CG_RESOLV, 0); +} + +int align(int x, int a) { + return (x+a) & ~(a-1); +} + +void hexwrite(char *b) { + while (*b) { + fputc(16*hex(*b)+hex(b[1]), stdout); + b += 2; + } +} + +void lewrite(int x) { + fputc(x & 0xff, stdout); + fputc(x>>8 & 0xff, stdout); + fputc(x>>16 & 0xff, stdout); + fputc(x>>24 & 0xff, stdout); +} + +void elfheader(void) { + hexwrite("7f454c46"); /* magic */ + hexwrite("01"); /* 32-bit */ + hexwrite("01"); /* little endian */ + hexwrite("01"); /* header version */ + hexwrite("09"); /* FreeBSD ABI */ + hexwrite("0000000000000000"); /* padding */ + hexwrite("0200"); /* executable */ + hexwrite("0300"); /* 386 */ + lewrite(1); /* version */ + lewrite(TEXT_VADDR+HEADER_SIZE);/* initial entry point */ + lewrite(0x34); /* program header offset */ + lewrite(0); /* no header segments */ + lewrite(0); /* flags */ + hexwrite("3400"); /* header size */ + hexwrite("2000"); /* program header size */ + hexwrite("0200"); /* number of program headers */ + hexwrite("2800"); /* segment header size (unused) */ + hexwrite("0000"); /* number of segment headers */ + hexwrite("0000"); /* string index (unused) */ + lewrite(0x01); /* loadable segment */ + lewrite(HEADER_SIZE); /* offset in file */ + lewrite(TEXT_VADDR); /* virtual load address */ + lewrite(TEXT_VADDR); /* physical load address */ + lewrite(Tp); /* size in file */ + lewrite(Tp); /* size in memory */ + lewrite(0x05); /* flags = read, execute */ + lewrite(PAGE_SIZE); /* alignment (page) */ + lewrite(0x01); /* loadable segment */ + lewrite(HEADER_SIZE+Tp); /* offset in file */ + lewrite(DATA_VADDR); /* virtual load address */ + lewrite(DATA_VADDR); /* physical load address */ + lewrite(Dp); /* size in file */ + lewrite(Dp); /* size in memory */ + lewrite(0x06); /* flags = read, write */ + lewrite(PAGE_SIZE); /* alignment (page) */ +} + +/* + * Scanner + */ + +char Prog[PROG_SIZE]; + +int Pp = 0, Psize; + +void readprog(void) { + Psize = fread(Prog, 1, PROG_SIZE, stdin); + if (Psize >= PROG_SIZE) + aw("program too big", NULL); +} + +int readrc(void) { + return Pp >= Psize? EOF: Prog[Pp++]; +} + +int readc(void) { + return Pp >= Psize? EOF: tolower(Prog[Pp++]); +} + +#define META 256 + +int readec(void) { + int c; + + c = readrc(); + if (c != '\\') + return c; + c = readc(); + if ('a' == c) return '\a'; + if ('b' == c) return '\b'; + if ('e' == c) return '\033'; + if ('f' == c) return '\f'; + if ('n' == c) return '\n'; + if ('q' == c) return '"' | META; + if ('r' == c) return '\r'; + if ('s' == c) return ' '; + if ('t' == c) return '\t'; + if ('v' == c) return '\v'; + return c; +} + +void reject(void) { + Pp--; +} + +#define TOKEN_LEN 128 + +int T; +char Str[TOKEN_LEN]; +int Val; +int Oid; + +int Equal_op, Minus_op, Mul_op, Add_op; + +struct _oper { + int prec; + int len; + char *name; + int tok; + char *code; +}; + +#define oper struct _oper + +enum { ENDFILE = -1, + SYMBOL = 100, INTEGER, STRING, + ADDROF = 200, ASSIGN, BINOP, BYTEOP, COLON, COMMA, COND, + CONJ, DISJ, LBRACK, LPAREN, RBRACK, RPAREN, SEMI, UNOP, + KCONST, KDECL, KDO, KELSE, KEND, KFOR, KHALT, KIE, KIF, + KLEAVE, KLOOP, KRETURN, KSTRUCT, KVAR, KWHILE +}; + +oper Ops[] = { + { 7, 3, "mod", BINOP, CG_MOD }, + { 6, 1, "+", BINOP, CG_ADD }, + { 7, 1, "*", BINOP, CG_MUL }, + { 0, 1, ";", SEMI, NULL }, + { 0, 1, ",", COMMA, NULL }, + { 0, 1, "(", LPAREN, NULL }, + { 0, 1, ")", RPAREN, NULL }, + { 0, 1, "[", LBRACK, NULL }, + { 0, 1, "]", RBRACK, NULL }, + { 3, 1, "=", BINOP, CG_EQ }, + { 5, 1, "&", BINOP, CG_AND }, + { 5, 1, "|", BINOP, CG_OR }, + { 5, 1, "^", BINOP, CG_XOR }, + { 0, 1, "@", ADDROF, NULL }, + { 0, 1, "~", UNOP, CG_INV }, + { 0, 1, ":", COLON, NULL }, + { 0, 2, "::", BYTEOP, NULL }, + { 0, 2, ":=", ASSIGN, NULL }, + { 0, 1, "\\", UNOP, CG_LOGNOT }, + { 1, 2, "\\/", DISJ, NULL }, + { 3, 2, "\\=", BINOP, CG_NEQ }, + { 4, 1, "<", BINOP, CG_LT }, + { 4, 2, "<=", BINOP, CG_LE }, + { 5, 2, "<<", BINOP, CG_SHL }, + { 4, 1, ">", BINOP, CG_GT }, + { 4, 2, ">=", BINOP, CG_GE }, + { 5, 2, ">>", BINOP, CG_SHR }, + { 6, 1, "-", BINOP, CG_SUB }, + { 0, 2, "->", COND, NULL }, + { 7, 1, "/", BINOP, CG_DIV }, + { 2, 2, "/\\", CONJ, NULL }, + { 0, 0, NULL, 0, NULL } +}; + +int skip(void) { + int c; + + c = readc(); + for (;;) { + while (' ' == c || '\t' == c || '\n' == c || '\r' == c) { + if ('\n' == c) + Line++; + c = readc(); + } + if (c != '!') + return c; + while (c != '\n' && c != EOF) + c = readc(); + } +} + +int findkw(char *s) { + if ('c' == s[0]) { + if (!strcmp(s, "const")) return KCONST; + return 0; + } + if ('d' == s[0]) { + if (!strcmp(s, "do")) return KDO; + if (!strcmp(s, "decl")) return KDECL; + return 0; + } + if ('e' == s[0]) { + if (!strcmp(s, "else")) return KELSE; + if (!strcmp(s, "end")) return KEND; + return 0; + } + if ('f' == s[0]) { + if (!strcmp(s, "for")) return KFOR; + return 0; + } + if ('h' == s[0]) { + if (!strcmp(s, "halt")) return KHALT; + return 0; + } + if ('i' == s[0]) { + if (!strcmp(s, "if")) return KIF; + if (!strcmp(s, "ie")) return KIE; + return 0; + } + if ('l' == s[0]) { + if (!strcmp(s, "leave")) return KLEAVE; + if (!strcmp(s, "loop")) return KLOOP; + return 0; + } + if ('m' == s[0]) { + if (!strcmp(s, "mod")) return BINOP; + return 0; + } + if ('r' == s[0]) { + if (!strcmp(s, "return")) return KRETURN; + return 0; + } + if ('s' == s[0]) { + if (!strcmp(s, "struct")) return KSTRUCT; + return 0; + } + if ('v' == s[0]) { + if (!strcmp(s, "var")) return KVAR; + return 0; + } + if ('w' == s[0]) { + if (!strcmp(s, "while")) return KWHILE; + return 0; + } + return 0; +} + +int scanop(int c) { + int i, j; + + i = 0; + j = 0; + Oid = -1; + while (Ops[i].len > 0) { + if (Ops[i].len > j) { + if (Ops[i].name[j] == c) { + Oid = i; + Str[j] = c; + c = readc(); + j++; + } + } + else { + break; + } + i++; + } + if (-1 == Oid) { + Str[j++] = c; + Str[j] = 0; + aw("unknown operator", Str); + } + Str[j] = 0; + reject(); + return Ops[Oid].tok; +} + +void findop(char *s) { + int i; + + i = 0; + while (Ops[i].len > 0) { + if (!strcmp(s, Ops[i].name)) { + Oid = i; + return; + } + i++; + } + oops("operator not found", s); +} + +int scan(void) { + int c, i, k, sgn; + + c = skip(); + if (EOF == c) { + strcpy(Str, "end of file"); + return ENDFILE; + } + if (isalpha(c) || '_' == c || '.' == c) { + i = 0; + while (isalpha(c) || '_' == c || '.' == c || isdigit(c)) { + if (i >= TOKEN_LEN-1) { + Str[i] = 0; + aw("symbol too long", Str); + } + Str[i++] = c; + c = readc(); + } + Str[i] = 0; + reject(); + if ((k = findkw(Str)) != 0) { + if (BINOP == k) + findop(Str); + return k; + } + return SYMBOL; + } + if (isdigit(c) || '%' == c) { + sgn = 1; + i = 0; + if ('%' == c) { + sgn = -1; + c = readc(); + Str[i++] = c; + if (!isdigit(c)) { + reject(); + return scanop('-'); + } + } + Val = 0; + while (isdigit(c)) { + if (i >= TOKEN_LEN-1) { + Str[i] = 0; + aw("integer too long", Str); + } + Str[i++] = c; + Val = Val * 10 + c - '0'; + c = readc(); + } + Str[i] = 0; + reject(); + Val = Val * sgn; + return INTEGER; + } + if ('\'' == c) { + Val = readec(); + if (readc() != '\'') + aw("missing ''' in character", NULL); + return INTEGER; + } + if ('"' == c) { + i = 0; + c = readec(); + while (c != '"' && c != EOF) { + if (i >= TOKEN_LEN-1) { + Str[i] = 0; + aw("string too long", Str); + } + Str[i++] = c & (META-1); + c = readec(); + } + Str[i] = 0; + return STRING; + } + return scanop(c); +} + +/* + * Parser + */ + +#define MAXTBL 128 +#define MAXLOOP 100 + +int Fun = 0; +int Loop0 = -1; +int Leaves[MAXLOOP], Lvp = 0; +int Loops[MAXLOOP], Llp = 0; + +void expect(int t, char *s) { + char b[100]; + + if (t == T) + return; + sprintf(b, "%s expected", s); + aw(b, Str); +} + +void eqsign(void) { + if (T != BINOP || Oid != Equal_op) + expect(0, "'='"); + T = scan(); +} + +void semi(void) { + expect(SEMI, "';'"); + T = scan(); +} + +void xlparen(void) { + expect(LPAREN, "'('"); + T = scan(); +} + +void xrparen(void) { + expect(RPAREN, "')'"); + T = scan(); +} + +int constfac(void) { + int v; + sym *y; + + if (INTEGER == T) { + v = Val; + T = scan(); + return v; + } + if (SYMBOL == T) { + y = lookup(Str, CNST); + T = scan(); + return y->value; + } + aw("constant value expected", Str); + return 0; /*LINT*/ +} + +int constval(void) { + int v; + + v = constfac(); + if (BINOP == T && Mul_op == Oid) { + T = scan(); + v *= constfac(); + } + else if (BINOP == T && Add_op == Oid) { + T = scan(); + v += constfac(); + } + return v; +} + +void vardecl(int glob) { + sym *y; + int size; + + T = scan(); + while (1) { + expect(SYMBOL, "symbol"); + size = 1; + if (glob & GLOBF) + y = add(Str, glob, Dp); + else + y = add(Str, 0, Lp); + T = scan(); + if (LBRACK == T) { + T = scan(); + size = constval(); + if (size < 1) + aw("invalid size", NULL); + y->flags |= VECT; + expect(RBRACK, "']'"); + T = scan(); + } + else if (BYTEOP == T) { + T = scan(); + size = constval(); + if (size < 1) + aw("invalid size", NULL); + size = (size + BPW-1) / BPW; + y->flags |= VECT; + } + if (glob & GLOBF) { + if (y->flags & VECT) { + gen(CG_ALLOC, size*BPW); + gen(CG_GLOBVEC, Dp); + } + dataw(0); + } + else { + gen(CG_ALLOC, size*BPW); + Lp -= size*BPW; + if (y->flags & VECT) { + gen(CG_LOCLVEC, 0); + Lp -= BPW; + } + y->value = Lp; + } + if (T != COMMA) + break; + T = scan(); + } + semi(); +} + +void constdecl(int glob) { + sym *y; + + T = scan(); + while (1) { + expect(SYMBOL, "symbol"); + y = add(Str, glob|CNST, 0); + T = scan(); + eqsign(); + y->value = constval(); + if (T != COMMA) + break; + T = scan(); + } + semi(); +} + +void stcdecl(int glob) { + sym *y; + int i; + + T = scan(); + expect(SYMBOL, "symbol"); + y = add(Str, glob|CNST, 0); + T = scan(); + i = 0; + eqsign(); + while (1) { + expect(SYMBOL, "symbol"); + add(Str, glob|CNST, i++); + T = scan(); + if (T != COMMA) + break; + T = scan(); + } + y->value = i; + semi(); +} + +void fwddecl(void) { + sym *y; + int n; + + T = scan(); + while (1) { + expect(SYMBOL, "symbol"); + y = add(Str, GLOBF|DECL, 0); + T = scan(); + xlparen(); + n = constval(); + y->flags |= n << 8; + xrparen(); + if (n < 0) + aw("invalid arity", NULL); + if (T != COMMA) + break; + T = scan(); + } + semi(); +} + +void resolve_fwd(int loc, int fn) { + int nloc; + + while (loc != 0) { + nloc = tfetch(loc); + tpatch(loc, fn-loc-BPW); + loc = nloc; + } +} + +void compound(void); +void stmt(void); + +void fundecl(void) { + int l_base, l_addr = 2*BPW; + int i, na = 0; + int oyp; + sym *y; + + gen(CG_JUMPFWD, 0); + y = add(Str, GLOBF|FUNC, Tp); + T = scan(); + xlparen(); + oyp = Yp; + l_base = Yp; + while (SYMBOL == T) { + add(Str, 0, l_addr); + l_addr += BPW; + na++; + T = scan(); + if (T != COMMA) + break; + T = scan(); + } + for (i = l_base; i < Yp; i++) { + Sym[i].value = 12+na*BPW - Sym[i].value; + } + if (y->flags & DECL) { + resolve_fwd(y->value, Tp); + if (na != y->flags >> 8) + aw("redefinition with different type", y->name); + y->flags &= ~DECL; + y->flags |= FUNC; + y->value = Tp; + } + xrparen(); + y->flags |= na << 8; + gen(CG_ENTER, 0); + Fun = 1; + stmt(); + Fun = 0; + gen(CG_CLEAR, 0); + gen(CG_EXIT, 0); + gen(CG_RESOLV, 0); + Yp = oyp; + Lp = 0; +} + +void declaration(int glob) { + if (KVAR == T) + vardecl(glob); + else if (KCONST == T) + constdecl(glob); + else if (KSTRUCT== T) + stcdecl(glob); + else if (KDECL == T) + fwddecl(); + else + fundecl(); +} + +void expr(int clr); + +void fncall(sym *fn) { + int i = 0; + + T = scan(); + if (NULL == fn) + aw("call of non-function", NULL); + while (T != RPAREN) { + expr(0); + i++; + if (COMMA != T) + break; + T = scan(); + if (RPAREN == T) + aw("syntax error", Str); + } + if (i != (fn->flags >> 8)) + aw("wrong number of arguments", fn->name); + expect(RPAREN, "')'"); + T = scan(); + if (loaded()) + spill(); + if (fn->flags & DECL) { + gen(CG_CALL, fn->value); + fn->value = Tp-BPW; + } + else { + gen(CG_CALL, fn->value-Tp-5); /* TP-BPW+1 */ + } + if (i != 0) + gen(CG_DEALLOC, i*BPW); + Loaded = 1; +} + +int mkstring(char *s) { + int i, a, k; + + a = Dp; + k = strlen(s); + for (i=0; i<=k; i++) + data(s[i]); + while (Dp % 4 != 0) + data(0); + return a; +} + +int mktable(void) { + int n, i; + int loc; + int tbl[MAXTBL], af[MAXTBL]; + int dynamic = 0; + + T = scan(); + n = 0; + while (T != RBRACK) { + if (n >= MAXTBL) + aw("table too big", NULL); + if (LPAREN == T) { + T = scan(); + dynamic = 1; + continue; + } + else if (dynamic) { + expr(1); + gen(CG_STGLOB, 0); + tbl[n] = 0; + af[n++] = Tp-BPW; + if (RPAREN == T) { + T = scan(); + dynamic = 0; + } + } + else if (INTEGER == T || SYMBOL == T) { + tbl[n] = constval(); + af[n++] = 0; + } + else if (STRING == T) { + tbl[n] = mkstring(Str); + af[n++] = 1; + T = scan(); + } + else if (LBRACK == T) { + tbl[n] = mktable(); + af[n++] = 1; + } + else { + aw("invalid table element", Str); + } + if (T != COMMA) + break; + T = scan(); + } + expect(RBRACK, "']'"); + T = scan(); + loc = Dp; + for (i=0; i 1) { + tpatch(af[i], Dp-4); + } + } + return loc; +} + +void load(sym *y) { + if (y->flags & GLOBF) + gen(CG_LDGLOB, y->value); + else + gen(CG_LDLOCL, y->value); +} + +void store(sym *y) { + if (y->flags & GLOBF) + gen(CG_STGLOB, y->value); + else + gen(CG_STLOCL, y->value); +} + +void factor(void); + +sym *address(int lv, int *bp) { + sym *y; + + y = lookup(Str, 0); + T = scan(); + if (y->flags & CNST) { + if (lv > 0) aw("invalid address", y->name); + spill(); + gen(CG_LDVAL, y->value); + } + else if (y->flags & (FUNC|DECL)) { + if (2 == lv) aw("invalid address", y->name); + } + else if (0 == lv || LBRACK == T || BYTEOP == T) { + spill(); + load(y); + } + if (LBRACK == T || BYTEOP == T) + if (y->flags & (FUNC|DECL|CNST)) + aw("bad subscript", y->name); + while (LBRACK == T) { + *bp = 0; + T = scan(); + expr(0); + expect(RBRACK, "']'"); + T = scan(); + y = NULL; + gen(CG_INDEX, 0); + if (LBRACK == T || BYTEOP == T || 0 == lv) + gen(CG_DEREF, 0); + } + if (BYTEOP == T) { + *bp = 1; + T = scan(); + factor(); + y = NULL; + gen(CG_INDXB, 0); + if (0 == lv) + gen(CG_DREFB, 0); + } + return y; +} + +void factor(void) { + sym *y; + int op; + int b; + + if (INTEGER == T) { + spill(); + gen(CG_LDVAL, Val); + T = scan(); + } + else if (SYMBOL == T) { + y = address(0, &b); + if (LPAREN == T) { + fncall(y); + } + } + else if (STRING == T) { + spill(); + gen(CG_LDADDR, mkstring(Str)); + T = scan(); + } + else if (LBRACK == T) { + spill(); + gen(CG_LDADDR, mktable()); + } + else if (ADDROF == T) { + T = scan(); + y = address(2, &b); + if (NULL == y) { + ; + } + else if (y->flags & GLOBF) { + spill(); + gen(CG_LDADDR, y->value); + } + else { + spill(); + gen(CG_LDLREF, y->value); + } + } + else if (BINOP == T) { + op = Oid; + if (Oid != Minus_op) + aw("syntax error", Str); + T = scan(); + factor(); + gen(CG_NEG, 0); + } + else if (UNOP == T) { + op = Oid; + T = scan(); + factor(); + gen(Ops[op].code, 0); + } + else if (LPAREN == T) { + T = scan(); + expr(0); + xrparen(); + } + else { + aw("syntax error", Str); + } +} + +int emitop(int *stk, int sp) { + gen(Ops[stk[sp-1]].code, 0); + return sp-1; +} + +void arith(void) { + int stk[10], sp; + + sp = 0; + factor(); + while (BINOP == T) { + while (sp && Ops[Oid].prec <= Ops[stk[sp-1]].prec) + sp = emitop(stk, sp); + stk[sp++] = Oid; + T = scan(); + factor(); + } + while (sp > 0) { + sp = emitop(stk, sp); + } +} + +void conjn(void) { + int n = 0; + + arith(); + while (CONJ == T) { + T = scan(); + gen(CG_JMPFALSE, 0); + clear(); + arith(); + n++; + } + while (n > 0) { + gen(CG_RESOLV, 0); + n--; + } +} + +void disjn(void) { + int n = 0; + + conjn(); + while (DISJ == T) { + T = scan(); + gen(CG_JMPTRUE, 0); + clear(); + conjn(); + n++; + } + while (n > 0) { + gen(CG_RESOLV, 0); + n--; + } +} + +void expr(int clr) { + if (clr) { + clear(); + } + disjn(); + if (COND == T) { + T = scan(); + gen(CG_JMPFALSE, 0); + expr(1); + expect(COLON, "':'"); + T = scan(); + gen(CG_JUMPFWD, 0); + swap(); + gen(CG_RESOLV, 0); + expr(1); + gen(CG_RESOLV, 0); + } +} + +void stmt(void); + +void halt_stmt(void) { + T = scan(); + gen(CG_HALT, constval()); + semi(); +} + +void return_stmt(void) { + T = scan(); + if (0 == Fun) + aw("can't return from main body", 0); + if (SEMI == T) + gen(CG_CLEAR, 0); + else + expr(1); + if (Lp != 0) { + gen(CG_DEALLOC, -Lp); + } + gen(CG_EXIT, 0); + semi(); +} + +void if_stmt(int alt) { + T = scan(); + xlparen(); + expr(1); + gen(CG_JMPFALSE, 0); + xrparen(); + stmt(); + if (alt) { + gen(CG_JUMPFWD, 0); + swap(); + gen(CG_RESOLV, 0); + expect(KELSE, "ELSE"); + T = scan(); + stmt(); + } + else if (KELSE == T) { + aw("ELSE without IE", NULL); + } + gen(CG_RESOLV, 0); +} + +void while_stmt(void) { + int olp, olv; + + olp = Loop0; + olv = Lvp; + T = scan(); + xlparen(); + gen(CG_MARK, 0); + Loop0 = tos(); + expr(1); + xrparen(); + gen(CG_JMPFALSE, 0); + stmt(); + swap(); + gen(CG_JUMPBACK, 0); + gen(CG_RESOLV, 0); + while (Lvp > olv) { + push(Leaves[Lvp-1]); + gen(CG_RESOLV, 0); + Lvp--; + } + Loop0 = olp; +} + +void for_stmt(void) { + sym *y; + int step = 1; + int oll, olp, olv; + int test; + + T = scan(); + oll = Llp; + olv = Lvp; + olp = Loop0; + Loop0 = 0; + xlparen(); + expect(SYMBOL, "symbol"); + y = lookup(Str, 0); + T = scan(); + if (y->flags & (CNST|FUNC|DECL)) + aw("unexpected type", y->name); + eqsign(); + expr(1); + store(y); + expect(COMMA, "','"); + T = scan(); + gen(CG_MARK, 0); + test = tos(); + load(y); + expr(0); + if (COMMA == T) { + T = scan(); + step = constval(); + } + gen(step<0? CG_FORDOWN: CG_FOR, 0); + xrparen(); + stmt(); + while (Llp > oll) { + push(Loops[Llp-1]); + gen(CG_RESOLV, 0); + Llp--; + } + if (y->flags & GLOBF) + gen(CG_INCGLOB, y->value); + else + gen(CG_INCLOCL, y->value); + gen(CG_WORD, step); + swap(); + gen(CG_JUMPBACK, 0); + gen(CG_RESOLV, 0); + while (Lvp > olv) { + push(Leaves[Lvp-1]); + gen(CG_RESOLV, 0); + Lvp--; + } + Llp = oll; + Loop0 = olp; +} + +void leave_stmt(void) { + if (Loop0 < 0) + aw("LEAVE not in loop context", 0); + T = scan(); + semi(); + if (Lvp >= MAXLOOP) + aw("too many LEAVEs", NULL); + gen(CG_JUMPFWD, 0); + Leaves[Lvp++] = pop(); +} + +void loop_stmt(void) { + if (Loop0 < 0) + aw("LOOP not in loop context", 0); + T = scan(); + semi(); + if (Loop0 > 0) { + push(Loop0); + gen(CG_JUMPBACK, 0); + } + else { + if (Llp >= MAXLOOP) + aw("too many LOOPs", NULL); + gen(CG_JUMPFWD, 0); + Loops[Llp++] = pop(); + } +} + +void asg_or_call(void) { + sym *y; + int b; + + clear(); + y = address(1, &b); + if (LPAREN == T) { + fncall(y); + } + else if (ASSIGN == T) { + T = scan(); + expr(0); + if (NULL == y) + gen(b? CG_STINDB: CG_STINDR, 0); + else if (y->flags & (FUNC|DECL|CNST|VECT)) + aw("bad location", y->name); + else + store(y); + } + else { + aw("syntax error", Str); + } + semi(); +} + +void stmt(void) { + if (KFOR == T) + for_stmt(); + else if (KHALT == T) + halt_stmt(); + else if (KIE == T) + if_stmt(1); + else if (KIF == T) + if_stmt(0); + else if (KLEAVE == T) + leave_stmt(); + else if (KLOOP == T) + loop_stmt(); + else if (KRETURN == T) + return_stmt(); + else if (KWHILE == T) + while_stmt(); + else if (KDO == T) + compound(); + else if (SYMBOL == T) + asg_or_call(); + else if (SEMI == T) + T = scan(); + else + expect(0, "statement"); +} + +void compound(void) { + int oyp, olp; + + expect(KDO, "DO"); + T = scan(); + oyp = Yp; + olp = Lp; + while (KVAR == T || KCONST == T || KSTRUCT == T) + declaration(0); + while (T != KEND) + stmt(); + T = scan(); + if (olp - Lp != 0) + gen(CG_DEALLOC, olp-Lp); + Yp = oyp; + Lp = olp; +} + +void program(void) { + int i; + + gen(CG_INIT, 0); + T = scan(); + while ( KVAR == T || KCONST == T || SYMBOL == T || + KDECL == T || KSTRUCT == T + ) + declaration(GLOBF); + if (T != KDO) + aw("DO or declaration expected", NULL); + compound(); + gen(CG_HALT, 0); + for (i=0; iWKd*qpHsQ)lhV5{|CT3*(THI&W9*+LQ$Il0h?FiE!zYiDv^QMgZ(!41X`tTi% z1>nbPkGYoLH9IcYS&A_(jWLxpic==^ubDEwfBuwl=N@?NuA?41rdN~LdHqL6PXE|Q z%ce~`NY{@(Gp&PDhqv#??3F<*P=nD0Jx z!BIPoS@$kLq8mwKh$xG93Qk||fsv7s^r+hsqjc~7Ju%tRH+{Wt$}s-xC%fGZn<&>EMI!fP*uDi+R5t#Aamj+X2a2Mx%sOOpMhB^xqi*i$E$BXFW4;4NCaj}etd4Yi0tTV5xdPA<{OsfBIJCKVdakV1e{z$!<8rJY_h{b4OrWa1yS zLUHbJ3;SL`j6XyTiC*J(s||%bzK!2irttX$1th*+))vvZhcfoE#8^Fh&+xu8nQ&i) zzI%oz!fyJezK-koAt1ZtJMg9~2P=Xg2iVjAXv&y702v@jqcRh5#_X}0w(&*POH`oN zn8Z&?jnn8_+lzPF`BH4eMJ$SBdy5z>&ksP+iD9F~6mcyE7n`-YuIaEyh9&_g%JhpM zI%Hqq7`E)t`BHK%JjF(HuA~n^LT*Ax?vHOVm{NXCu8ar?uSt|aYW5#pSWea<0|&hF zr9|M$k{2IvgqO*h7tWtk?T(iLnm|s7V6?4<1j{6HBfNU)4Vw&7Qx1{?ja()Le;G;( zmIWm(=HDR6xAL-hJznATrCr>qKO&FNKG*ITL6TLAIDrAb$BnhRjztx9S{0g=Mo}z@ z1*R{GRIt9Bl-UdS|1POf36$rMOoV|DXtJjw&LFfjuO?P`zXI_=-dU?61&s<{(M;`k z`auY?c;5PeM`43L#xF-hG-JnE(Y>ei46m&p1LwaO{PzrV>(MuLL2$iDu8W}9H+2cF z;}%>pZ7jtN1s;>KFVV(Y(@AZ-8x^27g#i-I$w=x{M@N=!nifT(I(R2BcB7su8o{^4 zhKH%Yb$%Rn<-`d3ez@T0ihigrt$;T`w`D3DfS^>Pu_Pn+}G9&Qqh+Qe~Kp~sYLpiL%mK<2h^0;A-_ z1jI>*GRQlT^l^~nYRk$QL&MUAdWW*Ph5?3lPKY5|305z;L?xq)B1=bwOI9+9X`$>~ z;Syq$$ny_LdBiyo=}`1vKQ?D&AT*T0bUXXnxA3SvDP+&OMYcSbLG~P5WXmd%lV$k; z9WW=WO1*fW(d%q|hIb<1qeej8UBNxKi;Vyi?%DaeHN@1S{(smuZ426{S1<+6iYa_&FMA8P8K=!O#WXp3I zWY4ihwyXx$cZoJ5yP-Qy(mjKUt&VJITTQMQeXwbsjB5+eTX-(wp$Kf(*!6Q@HYfpf zo(2X{G(()?USOHBElPCeq8Y?Z1jAzkWaAK4w3Q{u%uiOVJ6s(VKZ=2N!W0dPlALf_ zKx3h!Az?bFo^yb>yE4)C5~AEN=#Z`+{}1{k)g4z?CUJHN32y%kiS>?z=r5=4l{73g z_X4egtUUKf%1U*sCqYdoZdvPGe?>vOKM zilxrj6$G*+ui8KsFAVs=r8ljds&d5?GBvyQ|IQRp&gYEnr~~dSf{|ApDH)rBTiqGA z>y!E`u6C5g*Ubsiz#6isN9d&6Z*q&fv)1^6%ttpD0%zfZsdp6!&?V?ydM(Y0>hlre z$8<5-2@DcjhQB))Zd~tJ4U*v=(L!nU9(o&YotuV7u@MiXbxGn&xrnFMSS}uX^5n0t z7grf80yqgrt0A?I5`LauC5!TPIlI4w=V#UU;)UGaK`)5 ziI}~P8tZDbc=^F+K2^3+;uzsE@?SLbk-y@wM0$$b(TOS|bW+XSjk$xIxXHAR7 z4EP}Lguhz>5dJhfBu8tI!jIm?1r{|qjuR+3^|CW89WuOFj!sTJ=8+gOvM@Cr$E_M% z$l&m}1O39C+38p;mdvt;c~+KO#~eK&|CN1-E;j`0dnH(mY-y~UOR#7;X{>gKC5*L! zVH(*mwXMGII-@rQaJL5>5WuY-khy_F)_cG>0j%_Z@d9Y^fXM>5!~>=XV4eqXU32QE z9>B+E#&oFh`+QHGpx)&HxX0M9r2*?aV1`Wh3m3?vIspuMz+3^`>jCow@C^@`FMzLl zz{LVs>j7GZcll|#z00Ws9z%puze@w2asZR$A4>xw2Z#=DEwC=Evw7}7Vj z4cGBvT+$HnmB|gTTOU5;)a(ClN_RFWNr-eCm8bJ_DGDiOjwQ^%?v422EH^ZA7Lb`RiXOd%AhjUltE>>OH<`3b{SNz zd>Zw0C8$i1(fjcaOb`x+{d{^%X(cR7^Pe@0MYjuO+0Zt|*UsbP1{* zsK3QYScJk!#NvabF7_=5c?j*iNSy}fHnt47Y#wLh!Y*|dumsb+p8~}8lJ{h9UC=AL z%Fv>Esd_t>dP!=dyetsS0otEkOJ+IE*EKiXlIm7g$_7na2$o z1U){H)k}EXVCLNpjQ9bUEkw&Nqa=WqZM}dIzM9EJO@=$~L1zMDkvB84sr&xT z20um&`eAe&{xR=Q@S%&YHvkJsH}f{s`Z}HzSmZ52dQmB9#!63ftDwy)MdK`C;NI$i&M7Y0Ba1aUFy`^YenuBpr8cIU--Y=vVl#*sKdoa>Vfs<5kNP35me*4)H z;aJEWj5HraCrO8TdsIk&qm(os&H0tvC1_WdqMdjM9JGzf!EPa)EhWup?m5^aXn%aB zL=jQ53lm+QNViEZ7>1|1 z+}lTJBZEauFtDDp=s4_72qeDyJB}lp{w1%M0Xc+``j8+wbYsP#U_N|UOg>$~Xm*@Q zWzE9?&AAqZMKBP}Ks#jpShW*Jvwae*&9Q||VCD@p8gEQ5w)u#Om~+d)Lc9lwWq``U zev(WjVmpiOfl4!%oi2?nON4ECl-YnObgw$_Yiq2P(A6d!z34>{=KOl`^xEE)dBFTE zx?TAZ*vBC(sAe@`3Z0;4a$9)NYyIS}Eca=2%>k^ttShMLI8ZZQHXHn; zM{9e72XDjCr0!JHpkA#CeS)eF5A~57+4of<-#@awbaB6uR3guG4at|GWKB||TkXsA z_QvY+bg?&UOJSWlwPcPbxKIoxeZ4q&w}-vKnnk5!t_Hf;fF7fcaL4~??ToHl%kSsK z$z*e#^o7t) zp@YTb;OpI_7)gGHVD3oBIlMb%sX(0Js*v1NjakOWL$QD1r4E#OI`EMUY`lTx1= zcHzSI=x^>3?d$bh!MMG?2iN|zsTmae_955s5CqS1U~$Q{;Lf#XN6!#2L5zSpz84eWsnldG}H7n`g}inRFMCO!p9&VT^5-~2)SsNAn)?X&tTO`Df6YX zT(nz|@9@aqP9U=)hqO8@MNbNHmqQj#cWaa|^BU!d)g-F3Q-Lckt&@zJXD8F1Vyh!F z9>^(IJCEa~x)bBdsmGnO>e^BL9#xpgYE3t+cP#yAF9k8He2TLQ-7P{rhlyNKq27m8 z(j2Fj-5*y3%f7b6Dp_8r1)eiqL_7jLBBq&q`x%PH<@ZKamioF9>fG9>x8PSsZcV+F z)NRdd)yuR4Ka=P5BIg|_PMw^lVEUFNC4rVn=1O3xH{SL?Pmz_??=DU!-=^S}D$Sg$ zKPoFjKQ#iL>JYUx4J?z#FL$Q!RCQu{y{twtq?YveK|s`>v7Zpx)yE;U9$}Z?+FV)e6mJmdr~*%uzaFxOBhsDHZIXvf3g& zSbc8vODXYv0pUTLNIj4uiA@OxQ6#7h&syGfq%+2|!h|Elb_XEZGs5;i-I`7;-5|?63!VM)r@~uB(CH0czyg#Z(QC?}UIRnYW zY9tUq{RuP=O@K9)R@{P6sm=qzAjq5qgK+|wAoD-%2z48fN9Ft)3D5!O?{;Imkv~K} z?KDm$e@m6jt4P?`g_`0hTT2nsX4C}X5%mwK^+iR8u!gHGZoC3R%cxUN0ez||ARgqJ z)61ym1D2W-=?#kXIgHf061aXnFj(Y^eoD%Ls-D9>M=$bTq#rdMDoMr{P!+RG#m7lO ze91g+*|kzpOQXd{t4-RxeP@G$_kxE*Q01AH>G;ox=jsh4gg{-_gQ&A6`*sLmDeq!F zHNENqDdZ#qN;prv@?omUWSE@J2lGK$$RuE1n(D)4VBBw(X3(${D!tZ~i;j=X{ z!?G!z1jen?c06T8Ppmo*Be?43nfhW$0D9G*2Q~E)3Us~dFCewZyZn8|R|us`6zsRZ_T3}Kko7-&Q`!8v&_SqX2tV_Q1Ppnjb+VX{5) z5*C&?6Ms=Sp?M<$|GWHh?@v@pX?BMNRN2WSdl6HNp z;C!za1UAP60b>Mz+ z74s7px{CZjNKeAzp=XE>ZX`87feXYUW6_)?S>Ew*!5(^k4c4jSMl6T!x-8(aVC6A~ zOQw*rX9*C^JXA{MF*o@!GyE7nr%aCFR#~k>LWo(2$j{qErdP3+F21U7yl6s+E&hO; zA|xj$7X%68i6OgCc96FyS~tzdr7pe>Cb~^>C#Jqcn>vj`<2avFSGhT4a3YYgrXn@J z@9qag@bEGf9_;F62(y`lDF*q`gVTASqrMUwl^9$*o!_pBMplt|9X-_pJFQ0I1rkPN zQ&C{`$%axy(&r>eem9RX;)`HCvKj!j^Sb_&V|-_jR)HpTJFJPOv=0{9jZc z#X>~T%i%p9OR9bpZ%>qkt@A3Y)`pq_OLA4;)WVr8{KKX zXma{TJnE5MmZE-lmgD5_FzD@&)ttPl?48An%s6JudyOL%KPZ;QjIDDuH~vh9BJjD; zYFUBtIvbW2hit(G)ucAPV9dujoWf?;Tn3Iq#V395qsX3iCDxi=|4c(%Wh+h92yl~V zmzp;2#f@V!Hc*KEUe522(B%;1jo(-nsX^2^K#7~6fOrvP(nDy?_n}v(3UwWVkq!qD z-zc$Mys_K54KfpQHq4$v+L{8G`qzuYm?7Dx6TMxs>C9qQdSeb{W0emcJV{a?aFTE; zBgxl6z$isXg-2`p+)?Kg4oPb4Q-G8cL``~0ws=T+C4$I$RN_89+VjFlkeqI5h3QN* zycw$0Iv4U~rWWxkC{7)N(njJ~d>!U73ZYFTnW!i;U*G&oCf2{-h=Q>G!UNVy3>P$8 za^YQ*!7G-uvEVtww!yWY;#XdLVRu0PI!8ag4Lb7%ESUQOuUX_U&4E`y+Jr$C*v97>S4{P9;u)jd&mgWdG@|&7ed42b)t$8^ z5X2#qODJ)z86ZYV>RVT_*WxlRzyz5R&MwnmN~eFJ+jfE6~>c9P72;L zGzo!_QIy{jMS0GEC~9*e2RMPXJUV@T03G`EW{a9kpVvv$=FG7aK1blHLZ)5lP~SNR z65+~oFwT+H9FUg^9Q?|i2M7m8Kp8HRgu6v`=7ZMybjVYe;1x45r!XRVg-IaM3M*pz z^xobts_1AUP1X_uy4Sq=l<6r2dB9pr4ZO)0+`U?s2)f%hB zQS@Ur;Ml+Er4&`vS60P9WK~f~&UG(Qlu0;&HO3>xDRC&3kWB>pHV{lw*T?f0aC-GU zL|{`3KmN2KW}+E26!8@V8w6jMXvK-rX6Pd4e{yZ)~NgDD*D$n!7t{nza1oZ9}donC$R*H(mO zo@Qyiatdkw0K+s*bvbfQPPI8Y@k~FOvnIWLH%GsL<3e!}txc zvH~#A*w>iHp}yjh+Gsu<-Ym;G+pYNO$zK@-sY?(HBdXl`#8^M~VEt#fo6R^}^db zF0%iz(iE9Jq@#8sEL$fc<@j>^)88B5Xj1rrCry%@7teqkFY#7=3dfA%qUz`H%J=}N zT13i1Hhi5^hK;#tHhuuAJwtRysmA^l7cK;=tATB_&5&)3nkRorqdp%HbswI@>*&FE zZ>?Ya?uS-x)%_3zm?j*PT5!P6+xT|;W8(k_q-3cDB=Kw9n;c;~$eECi*zvbOP+NH! z(M~{Tsc1)=d0moTC!+2Bg%ypj=3CJwIu6t(T&kh}D$(w9XBdYl+Kb={tEPR422Y1j zW69KCK~A%7N0kWoO`?s!220ni*70CYIyO6Pnv;$;#tXFtIl~l1-*tp0fv(lkiw`=4 z7w>`2!$b3*xIQz<96w2jcbCJHl{^FFA+9>#O_=3`>iWG*d8-|=dJD|Sh<`I9-eX4$ z@bq7^m^5Vx|H~+vSVvBs`%TNgQ6sDQSun)-#L1ut2DCRVdu#-rfIrZQ+ z%Ugo{!2MQ3>7j$1F8&fG)A2&2)lMnOd>rZC1@*A5F1=R&fixpaG_V~+^$E4iXPy9S z)xS!8Q`1_p4iGqRD8 zle)ob%iVSgRc{$rw;>UkW&Z73R+VPFI_4D%k*RXg7BSMN5#dc3d*unEfrLSw`hAD6 z;s5YqzVZ^OdU;AhQ#Apg)6HvwhKL1A@QH;Mr>?bgsh>cFx+IL5gtT3V0oiBdfJ)r) zuUaq>NAJTw@(3{Ab7Rg;0n3AIJ!@qEO`P;Jl1g@>SWK#wll&(?!)HV;Gu` zb`zzC4$^=Et4u%krWu%JW_2G?Y`4tG!v3!BS!wj?k|{lDRN8>NMO^JrqdHBHPMA|o z4z8LYNy48$=K2y2SM9*opNGq9?jZjB%2sk;qPd?&R;bbZnVx3+c@pFie|`uTlK*~e zeU)CRm!1pjEkv@}R$90*%A_(X zP7b8A=}5);Qz8@p(UFOjr?tSRzGK;sdHiiDQW?&RlaKh_iJ*D^#$^Wy8<`uiV3rDq zcq;0;EpDptlx6}Rz#CnNe@r9=v)RAM4N(sup#(|P{2J3}jsuelptR~11e^FZuVA`t z8MKc;q46${MuSYEF~sU+SEv8Mv3si@!t_yQ2%uQ7{cgeH7C(eVS#pRJu33t2!o$Ub zR_6E&KaiWAU|+IC!&m9}w}eg6#XW+q2#iKp{wG8YPmpQg$xbe}8Cm+qkJuLwU@TYv+S%95 z5X=lA0_pj^$wxdrDj+eL`RON!Y3~k)&_QjwR!eeZf!mT!3>+$=Kb189BU37x&IEUoy0qEi|?^u_35`A zJy1^lf=uYGB|Q@tKji6U$(e~4?{f46pc9e_#{L~kao5BjNvCwE1$@Al`dA+gGd|dt zD}99*U^Bsd5J=HRVK6}$-~?gy#oMjK`rR08g);GF5Ljmb$-6IwMiFM;O4lN+{K;T_ z#Xl#fulPr3^%dP$U-ADc&{uqCR$tN2_0M}@(xRmTz1Bl{k{-1QwB1AbW2R`CKri)B{s>9ZseS$(UYQ6gh+C zJn`S)pXdgT){k0DEK_;e?{aSvZ47&<`e41MqRu$POL zQ?Z;-$-FzlUalj4;^un&i>KT?91Z_hoA1Rx!`Q6qzvL<}A3;#_j-`5^%uCuF7_7b*{Ac%R8D4 zK==E53`u<0)6&{eXa;n7M`6{nLQ}EOoGq?iR>%}PJG1Tij@8-j)$NU)ZP|`|d!ZY6 zT?IcTg~RT5^eGlr6|>!iE7}Vk#Vm<6wq8L3U4^#JrhKurvm@KMyrrek70B3}FXqdQ zY0Nign>w2d9FPCjE4#FihZ=-xTW7}=nK>Vy`r_) zoz1tvNV8Q_t4NC$dqubifLZ*is;X>jN49BczAF!_lexhoNjci2QSOtqri#w04_9TX zK7=+6ZF-gAFOw1dltene{r0Ikj0?$*zXE~^$-fzKq&-sihoiww>!%R8FH z8k;){-J+QGe6eY1cHa5t%_o0N`L;GHsH3yv42wG&ynA&=F~3UtG4WP*!9ueg%i9}i z>MhxP*A>g@6LcubRLnQF6`W;IubN*CFSHei4BRwbr|apW>*m#P;?}0D4CB0%z0kg_ zxY~d$UF&_sDF>skbuVx1Zt7}X#(7C6J$L%P>Z~g0siUfx)fSm;>FR7pgnGMVJz@~A-(_vbxIJb*Ig4CUvf8m9>3a9}tkf2=35z3n8 znLK4zwicImE-z+3em>)E(ds(j)3`@dXZtexOEyHy%)2n#*_EXS!_dWuyzv&h@~v&O zc;^M(kl)1Dthc0D5^*w_ttb;~YntSa`Di=t8|!Bv@@M$2a%M>1=XuZa@JZa)H`mW1 z1`D3&ai6c5A^nHr{&n^@>VCdrGw!SCuhsp0Mecaq*Ei^X=FTa&pVe63P+f~ZScCgI zeP7Re=A(JUuc@9z3Ooe8Snlc8_~#ya zJML$L&so)!tggDLxn67|i@qWBwan2vItBOp^u6@IANQ}C{u=NNJb`nYnz`BQj@9KP z+}DHSS@km;NNp-$(*&nwPN6ZAISu!79Zo|-%bXTK5fjknr{MJsdY)pnbj?gvzunt ziLIQ8{ykxTU9z8hu{Xp1=43yWGznW1yM_&gWIxJ^OnunjlI)*}{sm!wQ?j26y9)jE zhdNwu!Zp4!D1S$`;CdVU^?tNnXnWCy(GH+ZfE`b!Eu+mvn~$~#tqpAr+6`!%(YB!t zp*@NAJlX-Y@vwvA(Wao)q0K{EfYye#4sA2qHnjWE_Mj=WH_;|SPg%4&w0UTY&{mz-Mno1}n$fc1 zGqv_!?7g0zFv?g|Z2XKib`Ixls&AYF6REBTEq>S4)wDFV)aGZyryDRU+)Gp9tWCA` z`MTLHEi?0Vb6Q$v&u&0~)O?huC6wy)NUo)s3v-H$Zcf3=9~`f)roN#i5A2!wg5j^O zdbZ{dJ@is2QpY-eb57QQjOWY=3Oi%Qe)=H&igAAoTITB-PM@d$5ufl$22MZ!5E?&( zR|7s#?zAsj_yvHA(E`9Z_#yrhz!~%Tp}+G(_$t5|>-kxzzXX0G;LI8PEY@EF-wHT$ z1wS7~qfDf;18~YkA1AN8CVY>9bIvsZ{8a;|td|Gy@tZUq>gF6Yen=+^IOpQ$8vP~k zdcc{37*o#*;5oplLw?RO9f#q1Dd5yOKW9+@d6qzw`B%Cm2ggg59eJEIBN@jD1)`bI}Lsn;ZP89 z*&@JMdsO-i!`{bXttX?^q0L8YMq7in5p5gV5ZYd}*U=_GA5+lgqFs#EhPDoEGun2v zU1-mv9Y8xCbI(AVhqefBEl literal 0 HcmV?d00001 diff --git a/t3x9-book/t.pl1 b/t3x9-book/t.pl1 new file mode 100644 index 0000000..9e67378 --- /dev/null +++ b/t3x9-book/t.pl1 @@ -0,0 +1,30 @@ +--- t.t.old 2017-05-18 10:13:35.000000000 +0200 ++++ t.t 2017-05-18 10:14:16.000000000 +0200 +@@ -1217,7 +1217,7 @@ + gen(CG_JMPFALSE, 0); + xrparen(); + stmt(); +- ie (alt) do ++ if (alt) do + gen(CG_JUMPFWD, 0); + swap(); + gen(CG_RESOLV, 0); +@@ -1225,9 +1225,6 @@ + T := scan(); + stmt(); + end +- else if (T = KELSE) do +- aw("ELSE without IE", 0); +- end + gen(CG_RESOLV, 0); + end + +@@ -1370,6 +1367,8 @@ + if_stmt(1); + else ie (T = KIF) + if_stmt(0); ++ else ie (T = KELSE) ++ aw("ELSE without IE", 0); + else ie (T = KLEAVE) + leave_stmt(); + else ie (T = KLOOP) diff --git a/t3x9-book/t.pl2 b/t3x9-book/t.pl2 new file mode 100644 index 0000000..9d0331e --- /dev/null +++ b/t3x9-book/t.pl2 @@ -0,0 +1,11 @@ +--- t.t.old 2017-05-23 10:43:30.000000000 +0200 ++++ t.t 2017-05-23 10:43:50.000000000 +0200 +@@ -906,6 +906,8 @@ + fncall(fn) do var i; + T := scan(); + if (fn = 0) aw("call of non-function", 0); ++ if (fn[SFLAGS] & (FUNC|FORW) = 0) ++ aw("call of non-function", fn[SNAME]); + i := 0; + while (T \= RPAREN) do + expr(0); diff --git a/t3x9-book/t.pl3 b/t3x9-book/t.pl3 new file mode 100644 index 0000000..7056787 --- /dev/null +++ b/t3x9-book/t.pl3 @@ -0,0 +1,23 @@ +--- t.t.old 2018-03-22 08:59:31.000000000 +0100 ++++ t.t 2018-03-22 09:01:22.000000000 +0100 +@@ -1389,15 +1389,18 @@ + else + expect(%1, "statement"); + +-compound() do var oyp, olp, onp; ++compound() do var oyp, olp, onp, msg; ++ msg := "unexpected end of compound statement"; + T := scan(); + oyp := Yp; + onp := Np; + olp := Lp; + while (T = KVAR \/ T = KCONST \/ T = KSTRUCT) + declaration(0); +- while (T \= KEND) ++ while (T \= KEND) do ++ if (T = ENDFILE) aw(msg, 0); + stmt(); ++ end + T := scan(); + if (olp-Lp \= 0) + gen(CG_DEALLOC, olp-Lp); diff --git a/t3x9-book/t.pl4 b/t3x9-book/t.pl4 new file mode 100644 index 0000000..f3578a9 --- /dev/null +++ b/t3x9-book/t.pl4 @@ -0,0 +1,23 @@ +--- t.t.old 2019-07-20 12:04:34.000000000 +0200 ++++ t.t 2019-07-20 12:03:27.000000000 +0200 +@@ -1510,9 +1510,9 @@ + tfill := "8b7c240c8b4424088b4c2404fcf3aa31c0c3"; + tscan := + "8b7c240c8b4424088b4c24044189fafcf2ae09c90f840600000089f829d048c331c048c3"; +- Ops := [[ 7, 1, "mod", BINOP, CG_MOD ], ++ Ops := [[ 7, 3, "mod", BINOP, CG_MOD ], + [ 6, 1, "+", BINOP, CG_ADD ], +- [ 7, 2, "*", BINOP, CG_MUL ], ++ [ 7, 1, "*", BINOP, CG_MUL ], + [ 0, 1, ";", SEMI, 0 ], + [ 0, 1, ",", COMMA, 0 ], + [ 0, 1, "(", LPAREN, 0 ], +@@ -1539,7 +1539,7 @@ + [ 5, 2, ">>", BINOP, CG_SHR ], + [ 6, 1, "-", BINOP, CG_SUB ], + [ 0, 2, "->", COND, 0 ], +- [ 7, 2, "/", BINOP, CG_DIV ], ++ [ 7, 1, "/", BINOP, CG_DIV ], + [ 2, 2, "/\\", CONJ, 0 ], + [ 0, 0, 0, 0, 0 ] ]; + Equal_op := findop("="); diff --git a/t3x9-book/t.t b/t3x9-book/t.t new file mode 100644 index 0000000..d01411e --- /dev/null +++ b/t3x9-book/t.t @@ -0,0 +1,1574 @@ +! T3X9 -> ELF-FreeBSD-386 compiler +! Nils M Holm, 2017, CC0 license +! https://creativecommons.org/publicdomain/zero/1.0/ +! Patchlevel 4 + +const BPW = 4; + +const PROG_SIZE = 65536; + +const TEXT_SIZE = 65536; ! must be a multiple of PAGE_SIZE ! +const DATA_SIZE = 65536; + +const NRELOC = 10000; + +const STACK_SIZE = 100; + +const SYMTBL_SIZE = 1000; +const NLIST_SIZE = 10000; + +var Stack[STACK_SIZE], Sp; + +var Line; + +const ENDFILE = %1; + +var ntoa_buf::100; + +ntoa(x) do var i, k; + if (x = 0) return "0"; + i := 0; + k := x<0-> -x: x; + while (k > 0) do + i := i+1; + k := k/10; + end + i := i+1; + if (x < 0) i := i+1; + ntoa_buf::i := 0; + k := x<0-> -x: x; + while (k > 0) do + i := i-1; + ntoa_buf::i := '0' + k mod 10; + k := k/10; + end + if (x < 0) do + i := i-1; + ntoa_buf::i := '-'; + end + return @ntoa_buf::i; +end + +str.length(s) return t.memscan(s, 0, 32767); + +str.copy(sd, ss) t.memcopy(ss, sd, str.length(ss)+1); + +str.append(sd, ss) t.memcopy(ss, @sd::str.length(sd), str.length(ss)+1); + +str.equal(s1, s2) return t.memcomp(s1, s2, str.length(s1)+1) = 0; + +writes(s) t.write(1, s, str.length(s)); + +log(s) t.write(2, s, str.length(s)); + +aw(m, s) do + log("t3x9: "); + log(ntoa(Line)); + log(": "); + log(m); + if (s \= 0) do + log(": "); + log(s); + end + log("\n"); + halt 1; +end + +oops(m, s) do + log("t3x9: internal error\n"); + aw(m, s); +end + +push(x) do + if (Sp >= STACK_SIZE) oops("stack overflow", 0); + Stack[Sp] := x; + Sp := Sp+1; +end + +tos() return Stack[Sp-1]; + +pop() do + if (Sp < 1) oops("stack underflow", 0); + Sp := Sp-1; + return Stack[Sp]; +end + +swap() do var t; + if (Sp < 2) oops("stack underflow", 0); + t := Stack[Sp-1]; + Stack[Sp-1] := Stack[Sp-2]; + Stack[Sp-2] := t; +end + +numeric(c) return '0' <= c /\ c <= '9'; + +alphabetic(c) return 'a' <= c /\ c <= 'z' \/ + 'A' <= c /\ c <= 'Z'; + +! +! Symbol table +! + +struct SYM = SNAME, SFLAGS, SVALUE; + +const GLOBF = 1; +const CNST = 2; +const VECT = 4; +const FORW = 8; +const FUNC = 16; + +var Syms[SYM*SYMTBL_SIZE]; +var Nlist::NLIST_SIZE; + +var Yp, Np; + +find(s) do var i; + i := Yp-SYM; + while (i >= 0) do + if (str.equal(Syms[i+SNAME], s)) + return @Syms[i]; + i := i - SYM; + end + return 0; +end + +lookup(s, f) do var y; + y := find(s); + if (y = 0) aw("undefined", s); + if (y[SFLAGS] & f \= f) + aw("unexpected type", s); + return y; +end + +newname(s) do var k, new; + k := str.length(s)+1; + if (Np+k >= NLIST_SIZE) + aw("too many symbol names", s); + new := @Nlist::Np; + t.memcopy(s, new, k); + Np := Np+k; + return new; +end + +add(s, f, v) do var y; + y := find(s); + if (y \= 0) do + ie (y[SFLAGS] & FORW /\ f & FUNC) + return y; + else + aw("redefined", s); + end + if (Yp+SYM >= SYMTBL_SIZE*SYM) + aw("too many symbols", 0); + y := @Syms[Yp]; + Yp := Yp+SYM; + y[SNAME] := newname(s); + y[SFLAGS] := f; + y[SVALUE] := v; + return y; +end + +! +! Emitter +! + +const TEXT_VADDR = 134512640; ! 0x08048000 +const DATA_VADDR = TEXT_VADDR + TEXT_SIZE; + +const HEADER_SIZE = 116; ! 0x74 + +const PAGE_SIZE = 4096; + +struct RELOC = RADDR, RSEG; + +var Rel[RELOC*NRELOC]; + +var Text_seg::TEXT_SIZE; +var Data_seg::DATA_SIZE; +var Header::HEADER_SIZE; + +var Rp, Tp, Dp, Lp, Hp; + +var Acc; + +var Codetbl; + +struct CG = CG_PUSH, CG_CLEAR, + CG_LDVAL, CG_LDADDR, CG_LDLREF, CG_LDGLOB, + CG_LDLOCL, + CG_STGLOB, CG_STLOCL, CG_STINDR, CG_STINDB, + CG_INCGLOB, CG_INCLOCL, + CG_ALLOC, CG_DEALLOC, CG_LOCLVEC, CG_GLOBVEC, + CG_INDEX, CG_DEREF, CG_INDXB, CG_DREFB, + CG_MARK, CG_RESOLV, + CG_CALL, CG_JUMPFWD, CG_JUMPBACK, CG_JMPFALSE, + CG_JMPTRUE, CG_FOR, CG_FORDOWN, + CG_ENTER, CG_EXIT, CG_HALT, + CG_NEG, CG_INV, CG_LOGNOT, CG_ADD, CG_SUB, + CG_MUL, CG_DIV, CG_MOD, CG_AND, CG_OR, CG_XOR, + CG_SHL, CG_SHR, CG_EQ, CG_NEQ, CG_LT, CG_GT, + CG_LE, CG_GE, + CG_WORD; + +emit(x) do + if (Tp >= DATA_SIZE) + aw("text segment too big", 0); + Text_seg::Tp := x; + Tp := Tp+1; +end + +emitw(x) do + emit(255&x); + emit(255&(x>>8)); + emit(255&(x>>16)); + emit(255&(x>>24)); +end + +tag(seg) do + if (Rp+RELOC >= RELOC*NRELOC) + oops("relocation buffer overflow", 0); + Rel[Rp+RADDR] := seg = 't'-> Tp-BPW: Dp-BPW; + Rel[Rp+RSEG] := seg; + Rp := Rp+RELOC; +end + +tpatch(a, x) do + Text_seg::a := 255&x; + Text_seg::(a+1) := 255&(x>>8); + Text_seg::(a+2) := 255&(x>>16); + Text_seg::(a+3) := 255&(x>>24); +end + +tfetch(a) return Text_seg::a + | (Text_seg::(a+1)<<8) + | (Text_seg::(a+2)<<16) + | (Text_seg::(a+3)<<24); + +data(x) do + Data_seg::Dp := x; + Dp := Dp+1; +end + +dataw(x) do + if (Dp >= DATA_SIZE) + aw("data segment too big", 0); + data(255&x); + data(255&(x>>8)); + data(255&(x>>16)); + data(255&(x>>24)); +end + +dpatch(a, x) do + Data_seg::a := 255&x; + Data_seg::(a+1) := 255&(x>>8); + Data_seg::(a+2) := 255&(x>>16); + Data_seg::(a+3) := 255&(x>>24); +end + +dfetch(a) return Data_seg::a + | (Data_seg::(a+1)<<8) + | (Data_seg::(a+2)<<16) + | (Data_seg::(a+3)<<24); + +hex(c) ie (numeric(c)) + return c-'0'; + else + return c-'a'+10; + +rgen(s, v) do var x; + while (s::0) do + ie (s::0 = ',') do + ie (s::1 = 'w') do + emitw(v); + end + else ie (s::1 = 'a') do + emitw(v); + tag('t'); + end + else ie (s::1 = 'm') do + push(Tp); + end + else ie (s::1 = '>') do + push(Tp); + emitw(0); + end + else ie (s::1 = '<') do + emitw(pop()-Tp-BPW); + end + else ie (s::1 = 'r') do + x := pop(); + tpatch(x, Tp-x-BPW); + end + else do + oops("bad code", 0); + end + end + else do + emit(hex(s::0)*16+hex(s::1)); + end + s := s+2; + end +end + +gen(id, v) rgen(Codetbl[id][1], v); + +spill() ie (Acc) + gen(CG_PUSH, 0); + else + Acc := 1; + +active() return Acc; + +clear() Acc := 0; + +activate() Acc := 1; + +relocate() do var i, a, dist; + dist := DATA_VADDR + (HEADER_SIZE + Tp) mod PAGE_SIZE; + for (i=0, Rp, RELOC) do + ie (Rel[i+RSEG] = 't') do + a := tfetch(Rel[i+RADDR]); + a := a + dist; + tpatch(Rel[i+RADDR], a); + end + else do + a := dfetch(Rel[i+RADDR]); + a := a + dist; + dpatch(Rel[i+RADDR], a); + end + end +end + +builtin(name, arity, code) do + gen(CG_JUMPFWD, 0); + add(name, GLOBF|FUNC | (arity << 8), Tp); + rgen(code, 0); + gen(CG_RESOLV, 0); +end + +align(x, a) return (x+a) & ~(a-1); + +hdwrite(b) do + if (Hp >= HEADER_SIZE) + oops("ELF header too long", 0); + Header::Hp := b; + Hp := Hp+1; +end + +hexwrite(b) + while (b::0) do + hdwrite(16*hex(b::0)+hex(b::1)); + b := b+2; + end + +lewrite(x) do + hdwrite(x & 255); + hdwrite(x>>8 & 255); + hdwrite(x>>16 & 255); + hdwrite(x>>24 & 255); +end + +elfheader() do + hexwrite("7f454c46"); ! magic + hexwrite("01"); ! 32-bit + hexwrite("01"); ! little endian + hexwrite("01"); ! header version + hexwrite("09"); ! FreeBSD ABI + hexwrite("0000000000000000"); ! padding + hexwrite("0200"); ! executable + hexwrite("0300"); ! 386 + lewrite(1); ! version + lewrite(TEXT_VADDR+HEADER_SIZE);! initial entry point + lewrite(52); ! program header offset (0x34) + lewrite(0); ! no header segments + lewrite(0); ! flags + hexwrite("3400"); ! header size + hexwrite("2000"); ! program header size + hexwrite("0200"); ! number of program headers + hexwrite("2800"); ! segment header size (unused) + hexwrite("0000"); ! number of segment headers + hexwrite("0000"); ! string index (unused) + ! text segment description + lewrite(1); ! loadable segment + lewrite(HEADER_SIZE); ! offset in file + lewrite(TEXT_VADDR); ! virtual load address + lewrite(TEXT_VADDR); ! physical load address + lewrite(Tp); ! size in file + lewrite(Tp); ! size in memory + lewrite(5); ! flags := read, execute + lewrite(PAGE_SIZE); ! alignment (page) + ! data segment description + lewrite(1); ! loadable segment + lewrite(HEADER_SIZE+Tp); ! offset in file + lewrite(DATA_VADDR); ! virtual load address + lewrite(DATA_VADDR); ! physical load address + lewrite(Dp); ! size in file + lewrite(Dp); ! size in memory + lewrite(6); ! flags := read, write + lewrite(PAGE_SIZE); ! alignment (page) +end + +! +! Scanner +! + +const META = 256; + +const TOKEN_LEN = 128; + +var Prog::PROG_SIZE; + +var Pp, Psize; + +var T; +var Str::TOKEN_LEN; +var Val; +var Oid; + +var Equal_op, Minus_op, Mul_op, Add_op; + +struct OPER = OPREC, OLEN, ONAME, OTOK, OCODE; + +var Ops; + +struct TOKENS = + SYMBOL, INTEGER, STRING, + ADDROF, ASSIGN, BINOP, BYTEOP, COLON, COMMA, COND, + CONJ, DISJ, LBRACK, LPAREN, RBRACK, RPAREN, SEMI, UNOP, + KCONST, KDECL, KDO, KELSE, KEND, KFOR, KHALT, KIE, KIF, + KLEAVE, KLOOP, KRETURN, KSTRUCT, KVAR, KWHILE; + +readprog() do + Psize := t.read(0, Prog, PROG_SIZE); + if (Psize >= PROG_SIZE) + aw("program too big", 0); +end + +readrc() do var c; + c := Pp >= Psize-> ENDFILE: Prog::Pp; + Pp := Pp+1; + return c; +end + +readc() do var c; + c := readrc(); + return 'A' <= c /\ c <= 'Z'-> c-'A'+'a': c; +end + +readec() do var c; + c := readrc(); + if (c \= '\\') return c; + c := readrc(); + if (c = 'a') return '\a'; + if (c = 'b') return '\b'; + if (c = 'e') return '\e'; + if (c = 'f') return '\f'; + if (c = 'n') return '\n'; + if (c = 'q') return '"' | META; + if (c = 'r') return '\r'; + if (c = 's') return '\s'; + if (c = 't') return '\t'; + if (c = 'v') return '\v'; + return c; +end + +reject() Pp := Pp-1; + +skip() do var c; + c := readc(); + while (1) do + while (c = ' ' \/ c = '\t' \/ c = '\n' \/ c = '\r') do + if (c = '\n') Line := Line+1; + c := readc(); + end + if (c \= '!') + return c; + while (c \= '\n' /\ c \= ENDFILE) + c := readc(); + end +end + +findkw(s) do + if (s::0 = 'c') do + if (str.equal(s, "const")) return KCONST; + return 0; + end + if (s::0 = 'd') do + if (str.equal(s, "do")) return KDO; + if (str.equal(s, "decl")) return KDECL; + return 0; + end + if (s::0 = 'e') do + if (str.equal(s, "else")) return KELSE; + if (str.equal(s, "end")) return KEND; + return 0; + end + if (s::0 = 'f') do + if (str.equal(s, "for")) return KFOR; + return 0; + end + if (s::0 = 'h') do + if (str.equal(s, "halt")) return KHALT; + return 0; + end + if (s::0 = 'i') do + if (str.equal(s, "if")) return KIF; + if (str.equal(s, "ie")) return KIE; + return 0; + end + if (s::0 = 'l') do + if (str.equal(s, "leave")) return KLEAVE; + if (str.equal(s, "loop")) return KLOOP; + return 0; + end + if (s::0 = 'm') do + if (str.equal(s, "mod")) return BINOP; + return 0; + end + if (s::0 = 'r') do + if (str.equal(s, "return")) return KRETURN; + return 0; + end + if (s::0 = 's') do + if (str.equal(s, "struct")) return KSTRUCT; + return 0; + end + if (s::0 = 'v') do + if (str.equal(s, "var")) return KVAR; + return 0; + end + if (s::0 = 'w') do + if (str.equal(s, "while")) return KWHILE; + return 0; + end + return 0; +end + +scanop(c) do var i, j; + i := 0; + j := 0; + Oid := %1; + while (Ops[i][OLEN] > 0) do + ie (Ops[i][OLEN] > j) do + if (Ops[i][ONAME]::j = c) do + Oid := i; + Str::j := c; + c := readc(); + j := j+1; + end + end + else do + leave; + end + i := i+1; + end + if (Oid = %1) do + Str::j := c; + j := j+1; + Str::j := 0; + aw("unknown operator", Str); + end + Str::j := 0; + reject(); + return Ops[Oid][OTOK]; +end + +findop(s) do var i; + i := 0; + while (Ops[i][OLEN] > 0) do + if (str.equal(s, Ops[i][ONAME])) do + Oid := i; + return Oid; + end + i := i+1; + end + oops("operator not found", s); +end + +symbolic(c) return alphabetic(c) \/ c = '_' \/ c = '.'; + +scan() do var c, i, k, sgn; + c := skip(); + if (c = ENDFILE) do + str.copy(Str, "end of file"); + return ENDFILE; + end + if (symbolic(c)) do + i := 0; + while (symbolic(c) \/ numeric(c)) do + if (i >= TOKEN_LEN-1) do + Str::i := 0; + aw("symbol too long", Str); + end + Str::i := c; + i := i+1; + c := readc(); + end + Str::i := 0; + reject(); + k := findkw(Str); + if (k \= 0) do + if (k = BINOP) findop(Str); + return k; + end + return SYMBOL; + end + if (numeric(c) \/ c = '%') do + sgn := 1; + i := 0; + if (c = '%') do + sgn := %1; + c := readc(); + Str::i := c; + i := i+1; + if (\numeric(c)) + aw("missing digits after '%'", 0); + end + Val := 0; + while (numeric(c)) do + if (i >= TOKEN_LEN-1) do + Str::i := 0; + aw("integer too long", Str); + end + Str::i := c; + i := i+1; + Val := Val * 10 + c - '0'; + c := readc(); + end + Str::i := 0; + reject(); + Val := Val * sgn; + return INTEGER; + end + if (c = '\'') do + Val := readec(); + if (readc() \= '\'') + aw("missing ''' in character", 0); + return INTEGER; + end + if (c = '"') do + i := 0; + c := readec(); + while (c \= '"' /\ c \= ENDFILE) do + if (i >= TOKEN_LEN-1) do + Str::i := 0; + aw("string too long", Str); + end + Str::i := c & (META-1); + i := i+1; + c := readec(); + end + Str::i := 0; + return STRING; + end + return scanop(c); +end + +! +! Parser +! + +const MAXTBL = 128; +const MAXLOOP = 100; + +var Fun; +var Loop0; +var Leaves[MAXLOOP], Lvp; +var Loops[MAXLOOP], Llp; + +expect(tok, s) do var b::100; + if (tok = T) return; + str.copy(b, s); + str.append(b, " expected"); + aw(b, Str); +end + +xeqsign() do + if (T \= BINOP \/ Oid \= Equal_op) + expect(BINOP, "'='"); + T := scan(); +end + +xsemi() do + expect(SEMI, "';'"); + T := scan(); +end + +xlparen() do + expect(LPAREN, "'('"); + T := scan(); +end + +xrparen() do + expect(RPAREN, "')'"); + T := scan(); +end + +xsymbol() expect(SYMBOL, "symbol"); + +constfac() do var v, y; + if (T = INTEGER) do + v := Val; + T := scan(); + return v; + end + if (T = SYMBOL) do + y := lookup(Str, CNST); + T := scan(); + return y[SVALUE]; + end + aw("constant value expected", Str); +end + +constval() do var v; + v := constfac(); + ie (T = BINOP /\ Oid = Mul_op) do + T := scan(); + v := v * constfac(); + end + else if (T = BINOP /\ Oid = Add_op) do + T := scan(); + v := v + constfac(); + end + return v; +end + +vardecl(glob) do var y, size; + T := scan(); + while (1) do + xsymbol(); + ie (glob & GLOBF) + y := add(Str, glob, Dp); + else + y := add(Str, 0, Lp); + T := scan(); + size := 1; + ie (T = LBRACK) do + T := scan(); + size := constval(); + if (size < 1) + aw("invalid size", 0); + y[SFLAGS] := y[SFLAGS] | VECT; + expect(RBRACK, "']'"); + T := scan(); + end + else if (T = BYTEOP) do + T := scan(); + size := constval(); + if (size < 1) + aw("invalid size", 0); + size := (size + BPW-1) / BPW; + y[SFLAGS] := y[SFLAGS] | VECT; + end + ie (glob & GLOBF) do + if (y[SFLAGS] & VECT) do + gen(CG_ALLOC, size*BPW); + gen(CG_GLOBVEC, Dp); + end + dataw(0); + end + else do + gen(CG_ALLOC, size*BPW); + Lp := Lp - size*BPW; + if (y[SFLAGS] & VECT) do + gen(CG_LOCLVEC, 0); + Lp := Lp - BPW; + end + y[SVALUE] := Lp; + end + if (T \= COMMA) leave; + T := scan(); + end + xsemi(); +end + +constdecl(glob) do var y; + T := scan(); + while (1) do + xsymbol(); + y := add(Str, glob|CNST, 0); + T := scan(); + xeqsign(); + y[SVALUE] := constval(); + if (T \= COMMA) leave; + T := scan(); + end + xsemi(); +end + +stcdecl(glob) do var y, i; + T := scan(); + xsymbol(); + y := add(Str, glob|CNST, 0); + T := scan(); + xeqsign(); + i := 0; + while (1) do + xsymbol(); + add(Str, glob|CNST, i); + i := i+1; + T := scan(); + if (T \= COMMA) leave; + T := scan(); + end + y[SVALUE] := i; + xsemi(); +end + +fwddecl() do var y, n; + T := scan(); + while (1) do + xsymbol(); + y := add(Str, GLOBF|FORW, 0); + T := scan(); + xlparen(); + n := constval(); + if (n < 0) aw("invalid arity", 0); + y[SFLAGS] := y[SFLAGS] | (n << 8); + xrparen(); + if (T \= COMMA) leave; + T := scan(); + end + xsemi(); +end + +resolve_fwd(loc, fn) do var nloc; + while (loc \= 0) do + nloc := tfetch(loc); + tpatch(loc, fn-loc-BPW); + loc := nloc; + end +end + +decl compound(0), stmt(0); + +fundecl() do + var l_base, l_addr; + var i, na, oyp, onp; + var y; + + l_addr := 2*BPW; + na := 0; + gen(CG_JUMPFWD, 0); + y := add(Str, GLOBF|FUNC, Tp); + T := scan(); + xlparen(); + oyp := Yp; + onp := Np; + l_base := Yp; + while (T = SYMBOL) do + add(Str, 0, l_addr); + l_addr := l_addr + BPW; + na := na+1; + T := scan(); + if (T \= COMMA) leave; + T := scan(); + end + for (i = l_base, Yp, SYM) do + Syms[i+SVALUE] := 12+na*BPW - Syms[i+SVALUE]; + end + if (y[SFLAGS] & FORW) do + resolve_fwd(y[SVALUE], Tp); + if (na \= y[SFLAGS] >> 8) + aw("function does not match DECL", y[SNAME]); + y[SFLAGS] := y[SFLAGS] & ~FORW; + y[SFLAGS] := y[SFLAGS] | FUNC; + y[SVALUE] := Tp; + end + xrparen(); + y[SFLAGS] := y[SFLAGS] | (na << 8); + gen(CG_ENTER, 0); + Fun := 1; + stmt(); + Fun := 0; + gen(CG_CLEAR, 0); + gen(CG_EXIT, 0); + gen(CG_RESOLV, 0); + Yp := oyp; + Np := onp; + Lp := 0; +end + +declaration(glob) + ie (T = KVAR) + vardecl(glob); + else ie (T = KCONST) + constdecl(glob); + else ie (T = KSTRUCT) + stcdecl(glob); + else ie (T = KDECL) + fwddecl(); + else + fundecl(); + +decl expr(1); + +fncall(fn) do var i; + T := scan(); + if (fn = 0) aw("call of non-function", 0); + if (fn[SFLAGS] & (FUNC|FORW) = 0) + aw("call of non-function", fn[SNAME]); + i := 0; + while (T \= RPAREN) do + expr(0); + i := i+1; + if (T \= COMMA) leave; + T := scan(); + if (T = RPAREN) + aw("syntax error", Str); + end + if (i \= fn[SFLAGS] >> 8) + aw("wrong number of arguments", fn[SNAME]); + expect(RPAREN, "')'"); + T := scan(); + if (active()) + spill(); + ie (fn[SFLAGS] & FORW) do + gen(CG_CALL, fn[SVALUE]); + fn[SVALUE] := Tp-BPW; + end + else do + gen(CG_CALL, fn[SVALUE]-Tp-5); ! TP-BPW+1 + end + if (i \= 0) gen(CG_DEALLOC, i*BPW); + activate(); +end + +mkstring(s) do var i, a, k; + a := Dp; + k := str.length(s); + for (i=0, k+1) + data(s::i); + while (Dp mod BPW \= 0) + data(0); + return a; +end + +mktable() do + var n, i, a; + var tbl[MAXTBL], af[MAXTBL]; + var dynamic; + + T := scan(); + dynamic := 0; + n := 0; + while (T \= RBRACK) do + if (n >= MAXTBL) + aw("table too big", 0); + ie (T = LPAREN /\ \dynamic) do + T := scan(); + dynamic := 1; + loop; + end + else ie (dynamic) do + expr(1); + gen(CG_STGLOB, 0); + tbl[n] := 0; + af[n] := Tp-BPW; + n := n+1; + if (T = RPAREN) do + T := scan(); + dynamic := 0; + end + end + else ie (T = INTEGER \/ T = SYMBOL) do + tbl[n] := constval(); + af[n] := 0; + n := n+1; + end + else ie (T = STRING) do + tbl[n] := mkstring(Str); + af[n] := 1; + n := n+1; + T := scan(); + end + else ie (T = LBRACK) do + tbl[n] := mktable(); + af[n] := 1; + n := n+1; + end + else do + aw("invalid table element", Str); + end + if (T \= COMMA) leave; + T := scan(); + if (T = RBRACK) + aw("syntax error", Str); + end + if (dynamic) + aw("missing ')' in dynamic table", 0); + expect(RBRACK, "']'"); + if (n = 0) aw("empty table", 0); + T := scan(); + a := Dp; + for (i=0, n) do + dataw(tbl[i]); + ie (af[i] = 1) do + tag('d'); + end + else if (af[i] > 1) do + tpatch(af[i], Dp-4); + end + end + return a; +end + +load(y) ie (y[SFLAGS] & GLOBF) + gen(CG_LDGLOB, y[SVALUE]); + else + gen(CG_LDLOCL, y[SVALUE]); + +store(y) + ie (y[SFLAGS] & GLOBF) + gen(CG_STGLOB, y[SVALUE]); + else + gen(CG_STLOCL, y[SVALUE]); + +decl factor(0); + +address(lv, bp) do var y; + y := lookup(Str, 0); + T := scan(); + ie (y[SFLAGS] & CNST) do + if (lv > 0) aw("invalid location", y[SNAME]); + spill(); + gen(CG_LDVAL, y[SVALUE]); + end + else ie (y[SFLAGS] & (FUNC|FORW)) do + if (lv = 2) aw("invalid location", y[SNAME]); + end + else if (lv = 0 \/ T = LBRACK \/ T = BYTEOP) do + spill(); + load(y); + end + if (T = LBRACK \/ T = BYTEOP) + if (y[SFLAGS] & (FUNC|FORW|CNST)) + aw("bad subscript", y[SNAME]); + while (T = LBRACK) do + T := scan(); + bp[0] := 0; + expr(0); + expect(RBRACK, "']'"); + T := scan(); + y := 0; + gen(CG_INDEX, 0); + if (lv = 0 \/ T = LBRACK \/ T = BYTEOP) + gen(CG_DEREF, 0); + end + if (T = BYTEOP) do + T := scan(); + bp[0] := 1; + factor(); + y := 0; + gen(CG_INDXB, 0); + if (lv = 0) gen(CG_DREFB, 0); + end + return y; +end + +factor() do var y, op, b; + ie (T = INTEGER) do + spill(); + gen(CG_LDVAL, Val); + T := scan(); + end + else ie (T = SYMBOL) do + y := address(0, @b); + if (T = LPAREN) fncall(y); + end + else ie (T = STRING) do + spill(); + gen(CG_LDADDR, mkstring(Str)); + T := scan(); + end + else ie (T = LBRACK) do + spill(); + gen(CG_LDADDR, mktable()); + end + else ie (T = ADDROF) do + T := scan(); + y := address(2, @b); + ie (y = 0) do + ; + end + else ie (y[SFLAGS] & GLOBF) do + spill(); + gen(CG_LDADDR, y[SVALUE]); + end + else do + spill(); + gen(CG_LDLREF, y[SVALUE]); + end + end + else ie (T = BINOP) do + if (Oid \= Minus_op) + aw("syntax error", Str); + T := scan(); + factor(); + gen(CG_NEG, 0); + end + else ie (T = UNOP) do + op := Oid; + T := scan(); + factor(); + gen(Ops[op][OCODE], 0); + end + else ie (T = LPAREN) do + T := scan(); + expr(0); + xrparen(); + end + else do + aw("syntax error", Str); + end +end + +emitop(stk, p) do + gen(Ops[stk[p-1]][OCODE], 0); + return p-1; +end + +arith() do var stk[10], p; + factor(); + p := 0; + while (T = BINOP) do + while (p /\ Ops[Oid][OPREC] <= Ops[stk[p-1]][OPREC]) + p := emitop(stk, p); + stk[p] := Oid; + p := p+1; + T := scan(); + factor(); + end + while (p > 0) + p := emitop(stk, p); +end + +conjn() do var n; + arith(); + n := 0; + while (T = CONJ) do + T := scan(); + gen(CG_JMPFALSE, 0); + clear(); + arith(); + n := n+1; + end + while (n > 0) do + gen(CG_RESOLV, 0); + n := n-1; + end +end + +disjn() do var n; + conjn(); + n := 0; + while (T = DISJ) do + T := scan(); + gen(CG_JMPTRUE, 0); + clear(); + conjn(); + n := n+1; + end + while (n > 0) do + gen(CG_RESOLV, 0); + n := n-1; + end +end + +expr(clr) do + if (clr) clear(); + disjn(); + if (T = COND) do + T := scan(); + gen(CG_JMPFALSE, 0); + expr(1); + expect(COLON, "':'"); + T := scan(); + gen(CG_JUMPFWD, 0); + swap(); + gen(CG_RESOLV, 0); + expr(1); + gen(CG_RESOLV, 0); + end +end + +halt_stmt() do + T := scan(); + gen(CG_HALT, constval()); + xsemi(); +end + +return_stmt() do + T := scan(); + if (Fun = 0) + aw("can't return from main body", 0); + ie (T = SEMI) + gen(CG_CLEAR, 0); + else + expr(1); + if (Lp \= 0) do + gen(CG_DEALLOC, -Lp); + end + gen(CG_EXIT, 0); + xsemi(); +end + +if_stmt(alt) do + T := scan(); + xlparen(); + expr(1); + gen(CG_JMPFALSE, 0); + xrparen(); + stmt(); + if (alt) do + gen(CG_JUMPFWD, 0); + swap(); + gen(CG_RESOLV, 0); + expect(KELSE, "ELSE"); + T := scan(); + stmt(); + end + gen(CG_RESOLV, 0); +end + +while_stmt() do var olp, olv; + T := scan(); + olp := Loop0; + olv := Lvp; + gen(CG_MARK, 0); + Loop0 := tos(); + xlparen(); + expr(1); + xrparen(); + gen(CG_JMPFALSE, 0); + stmt(); + swap(); + gen(CG_JUMPBACK, 0); + gen(CG_RESOLV, 0); + while (Lvp > olv) do + push(Leaves[Lvp-1]); + gen(CG_RESOLV, 0); + Lvp := Lvp-1; + end + Loop0 := olp; +end + +for_stmt() do + var y; + var step; + var oll, olp, olv; + var test; + + T := scan(); + oll := Llp; + olv := Lvp; + olp := Loop0; + Loop0 := 0; + xlparen(); + xsymbol(); + y := lookup(Str, 0); + if (y[SFLAGS] & (CNST|FUNC|FORW)) + aw("unexpected type", y[SNAME]); + T := scan(); + xeqsign(); + expr(1); + store(y); + expect(COMMA, "','"); + T := scan(); + gen(CG_MARK, 0); + test := tos(); + load(y); + expr(0); + ie (T = COMMA) do + T := scan(); + step := constval(); + end + else do + step := 1; + end + gen(step<0-> CG_FORDOWN: CG_FOR, 0); + xrparen(); + stmt(); + while (Llp > oll) do + push(Loops[Llp-1]); + gen(CG_RESOLV, 0); + Llp := Llp-1; + end + ie (y[SFLAGS] & GLOBF) + gen(CG_INCGLOB, y[SVALUE]); + else + gen(CG_INCLOCL, y[SVALUE]); + gen(CG_WORD, step); + swap(); + gen(CG_JUMPBACK, 0); + gen(CG_RESOLV, 0); + while (Lvp > olv) do + push(Leaves[Lvp-1]); + gen(CG_RESOLV, 0); + Lvp := Lvp-1; + end + Loop0 := olp; +end + +leave_stmt() do + T := scan(); + if (Loop0 < 0) + aw("LEAVE not in loop context", 0); + xsemi(); + if (Lvp >= MAXLOOP) + aw("too many LEAVEs", 0); + gen(CG_JUMPFWD, 0); + Leaves[Lvp] := pop(); + Lvp := Lvp+1; +end + +loop_stmt() do + T := scan(); + if (Loop0 < 0) + aw("LOOP not in loop context", 0); + xsemi(); + ie (Loop0 > 0) do + push(Loop0); + gen(CG_JUMPBACK, 0); + end + else do + if (Llp >= MAXLOOP) + aw("too many LOOPs", 0); + gen(CG_JUMPFWD, 0); + Loops[Llp] := pop(); + Llp := Llp+1; + end +end + +asg_or_call() do var y, b; + clear(); + y := address(1, @b); + ie (T = LPAREN) do + fncall(y); + end + else ie (T = ASSIGN) do + T := scan(); + expr(0); + ie (y = 0) + gen(b-> CG_STINDB: CG_STINDR, 0); + else ie (y[SFLAGS] & (FUNC|FORW|CNST|VECT)) + aw("bad location", y[SNAME]); + else + store(y); + end + else do + aw("syntax error", Str); + end + xsemi(); +end + +stmt() ie (T = KFOR) + for_stmt(); + else ie (T = KHALT) + halt_stmt(); + else ie (T = KIE) + if_stmt(1); + else ie (T = KIF) + if_stmt(0); + else ie (T = KELSE) + aw("ELSE without IE", 0); + else ie (T = KLEAVE) + leave_stmt(); + else ie (T = KLOOP) + loop_stmt(); + else ie (T = KRETURN) + return_stmt(); + else ie (T = KWHILE) + while_stmt(); + else ie (T = KDO) + compound(); + else ie (T = SYMBOL) + asg_or_call(); + else ie (T = SEMI) + T := scan(); + else + expect(%1, "statement"); + +compound() do var oyp, olp, onp, msg; + msg := "unexpected end of compound statement"; + T := scan(); + oyp := Yp; + onp := Np; + olp := Lp; + while (T = KVAR \/ T = KCONST \/ T = KSTRUCT) + declaration(0); + while (T \= KEND) do + if (T = ENDFILE) aw(msg, 0); + stmt(); + end + T := scan(); + if (olp-Lp \= 0) + gen(CG_DEALLOC, olp-Lp); + Yp := oyp; + Np := onp; + Lp := olp; +end + +program() do var i; + T := scan(); + while ( T = KVAR \/ T = KCONST \/ T = SYMBOL \/ + T = KDECL \/ T = KSTRUCT + ) + declaration(GLOBF); + if (T \= KDO) + aw("DO or declaration expected", 0); + gen(CG_ENTER, 0); + compound(); + if (T \= ENDFILE) + aw("trailing characters", Str); + gen(CG_HALT, 0); + for (i=0, Yp, SYM) + if (Syms[i+SFLAGS] & FORW /\ Syms[i+SVALUE]) + aw("undefined function", Syms[i+SNAME]); +end + +! +! Main +! + +init() do var i, tread, twrite, tcomp, tcopy, tfill, tscan; + Rp := 0; + Tp := 0; + Dp := 0; + Lp := 0; + Sp := 0; + Yp := 0; + Np := 0; + Pp := 0; + Hp := 0; + Line := 1; + Acc := 0; + Fun := 0; + Loop0 := %1; + Lvp := 0; + Llp := 0; + Codetbl := [ + [ CG_PUSH, "50" ], + [ CG_CLEAR, "31c0" ], + [ CG_LDVAL, "b8,w" ], + [ CG_LDADDR, "b8,a" ], + [ CG_LDLREF, "8d85,w" ], + [ CG_LDGLOB, "a1,a" ], + [ CG_LDLOCL, "8b85,w" ], + [ CG_STGLOB, "a3,a" ], + [ CG_STLOCL, "8985,w" ], + [ CG_STINDR, "5b8903" ], + [ CG_STINDB, "5b8803" ], + [ CG_INCGLOB, "8105,a" ], + [ CG_INCLOCL, "8185,w" ], + [ CG_ALLOC, "81ec,w" ], + [ CG_DEALLOC, "81c4,w" ], + [ CG_LOCLVEC, "89e050" ], + [ CG_GLOBVEC, "8925,a" ], + [ CG_INDEX, "c1e0025b01d8" ], + [ CG_DEREF, "8b00" ], + [ CG_INDXB, "5b01d8" ], + [ CG_DREFB, "89c331c08a03" ], + [ CG_MARK, ",m" ], + [ CG_RESOLV, ",r" ], + [ CG_CALL, "e8,w" ], + [ CG_JUMPFWD, "e9,>" ], + [ CG_JUMPBACK, "e9,<" ], + [ CG_JMPFALSE, "09c00f84,>" ], + [ CG_JMPTRUE, "09c00f85,>" ], + [ CG_FOR, "5b39c30f8d,>" ], + [ CG_FORDOWN, "5b39c30f8e,>" ], + [ CG_ENTER, "5589e5" ], + [ CG_EXIT, "5dc3" ], + [ CG_HALT, "68,w5031c040cd80" ], + [ CG_NEG, "f7d8" ], + [ CG_INV, "f7d0" ], + [ CG_LOGNOT, "f7d819c0f7d0" ], + [ CG_ADD, "5b01d8" ], + [ CG_SUB, "89c35829d8" ], + [ CG_MUL, "5bf7eb" ], + [ CG_DIV, "89c35899f7fb" ], + [ CG_MOD, "89c35899f7fb89d0" ], + [ CG_AND, "5b21d8" ], + [ CG_OR, "5b09d8" ], + [ CG_XOR, "5b31d8" ], + [ CG_SHL, "89c158d3e0" ], + [ CG_SHR, "89c158d3e8" ], + [ CG_EQ, "5b39c30f95c20fb6c248" ], + [ CG_NEQ, "5b39c30f94c20fb6c248" ], + [ CG_LT, "5b39c30f9dc20fb6c248" ], + [ CG_GT, "5b39c30f9ec20fb6c248" ], + [ CG_LE, "5b39c30f9fc20fb6c248" ], + [ CG_GE, "5b39c30f9cc20fb6c248" ], + [ CG_WORD, ",w" ], + [ %1, "" ] ]; + tread := "8b4424048744240c89442404b803000000cd800f830300000031c048c3"; + twrite := "8b4424048744240c89442404b804000000cd800f830300000031c048c3"; + tcomp := + "8b74240c8b7c24088b4c240441fcf3a609c90f850300000031c0c38a46ff2a47ff669898c3"; + tcopy := "8b74240c8b7c24088b4c2404fcf3a431c0c3"; + tfill := "8b7c240c8b4424088b4c2404fcf3aa31c0c3"; + tscan := + "8b7c240c8b4424088b4c24044189fafcf2ae09c90f840600000089f829d048c331c048c3"; + Ops := [[ 7, 3, "mod", BINOP, CG_MOD ], + [ 6, 1, "+", BINOP, CG_ADD ], + [ 7, 1, "*", BINOP, CG_MUL ], + [ 0, 1, ";", SEMI, 0 ], + [ 0, 1, ",", COMMA, 0 ], + [ 0, 1, "(", LPAREN, 0 ], + [ 0, 1, ")", RPAREN, 0 ], + [ 0, 1, "[", LBRACK, 0 ], + [ 0, 1, "]", RBRACK, 0 ], + [ 3, 1, "=", BINOP, CG_EQ ], + [ 5, 1, "&", BINOP, CG_AND ], + [ 5, 1, "|", BINOP, CG_OR ], + [ 5, 1, "^", BINOP, CG_XOR ], + [ 0, 1, "@", ADDROF, 0 ], + [ 0, 1, "~", UNOP, CG_INV ], + [ 0, 1, ":", COLON, 0 ], + [ 0, 2, "::", BYTEOP, 0 ], + [ 0, 2, ":=", ASSIGN, 0 ], + [ 0, 1, "\\", UNOP, CG_LOGNOT ], + [ 1, 2, "\\/", DISJ, 0 ], + [ 3, 2, "\\=", BINOP, CG_NEQ ], + [ 4, 1, "<", BINOP, CG_LT ], + [ 4, 2, "<=", BINOP, CG_LE ], + [ 5, 2, "<<", BINOP, CG_SHL ], + [ 4, 1, ">", BINOP, CG_GT ], + [ 4, 2, ">=", BINOP, CG_GE ], + [ 5, 2, ">>", BINOP, CG_SHR ], + [ 6, 1, "-", BINOP, CG_SUB ], + [ 0, 2, "->", COND, 0 ], + [ 7, 1, "/", BINOP, CG_DIV ], + [ 2, 2, "/\\", CONJ, 0 ], + [ 0, 0, 0, 0, 0 ] ]; + Equal_op := findop("="); + Minus_op := findop("-"); + Mul_op := findop("*"); + Add_op := findop("+"); + i := 0; + while (Codetbl[i][0] \= %1) do + if (Codetbl[i][0] \= i) + oops("bad code table entry", ntoa(i)); + i := i+1; + end + builtin("t.read", 3, tread); + builtin("t.write", 3, twrite); + builtin("t.memcomp", 3, tcomp); + builtin("t.memcopy", 3, tcopy); + builtin("t.memfill", 3, tfill); + builtin("t.memscan", 3, tscan); +end + +do + init(); + readprog(); + program(); + ! 16-byte align in file + Tp := align(HEADER_SIZE+Tp, 16)-HEADER_SIZE; + relocate(); + elfheader(); + t.write(1, Header, Hp); + t.write(1, Text_seg, Tp); + t.write(1, Data_seg, Dp); +end diff --git a/t3x9-book/t3x-history.txt b/t3x9-book/t3x-history.txt new file mode 100644 index 0000000..bc02ebe --- /dev/null +++ b/t3x9-book/t3x-history.txt @@ -0,0 +1,59 @@ + + A SHORT HISTORY OF THE T3X LANGUAGE + + T3X is a tiny block-structured language that you probably + haven't heard about. It had a tiny community back in the + mid-1990's. Software written in T3X includes its own compiler + (of course), its own text-based IDE, a few LISP interpreters, + an assembler and linker for the 8086, and a database system + used by a local church community. It was also used in a few + college courses, most probably because its community was so + tiny that nobody could be bothered to do your homework + assignments for you. + + The T3X language started as a very minimalistic language + with a single-file compiler that targeted the 8086 and 386 + processors. It supported FreeBSD via the GNU binutils and + emitted DOS EXE files through its own assembler and linker. + + In its lifetime, several enhancements were made to both the + language and its implementation: + + - An object system was added to the language, and the entire + runtime support infrastructure was rewritten as a set of + classes. + - Tcode, an abstract target language, was added. It could be + interpreted, optimized, linked, and converted to native + code. + - A back-end for the AXP 21064 (Alpha) was added. + - A C back-end was added, allowing to use T3X on otherwise + unsupported processors. + - Runtime support for the following platforms was added: + NetBSD-386, NetBSD-Alpha, FreeBSD-386, Coherent-386, + Linux-386, and Plan 9 (via C). + + T3X is probably notable, because it is a typeless object + oriented language. Objects are distinguished by the methods + they implement, and the methods are typeless procedures. + The T3X object system is more similar to ADA packages than + to the C++ or Java approach. It implements reusable modules + rather than data types. + + T3X-8.1.7 was the last version of T3X and it was released in + 2004 with some minor updates in 2011 and 2014. Its generic + (Tcode) port still runs on modern operating systems. + + T3X9 is a subset of the T3X language that compiles directly + from T3X to ELF-FreeBSD-386. + + If you are familiar with T3X, this is what the compiler omits + from the original language: modules, objects, classes, packed + vectors, function pointers and indirect function calls, meta + commands, unsigned operators. Also, constant expression syntax + is only a subset. + + The T3X9 compiler is under 1600 lines in size and compiles + itself from source to ELF in about 0.06 seconds on a 750MHz + notebook computer. The resulting binary has a size of less + than 32K bytes. + diff --git a/t3x9-book/t3x.bnf b/t3x9-book/t3x.bnf new file mode 100644 index 0000000..5c6c47e --- /dev/null +++ b/t3x9-book/t3x.bnf @@ -0,0 +1,221 @@ +%token SYMBOL, INTEGER, CHARACTER, STRING +%token VAR, CONST, STRUCT, DECL, DO, END +%token IF, IE, ELSE, WHILE, FOR, LEAVE, LOOP, +%token RETURN, HALT, MODULO + +%% + +Program: + Declarations CompoundStmt + ; + +Declarations: + Declaration + | Declaration Declarations + ; + +Declaration: + VAR VarList ';' + | CONST ConstList ';' + | DECL DeclList ';' + | STRUCT SYMBOL '=' StructMembers ';' + | FunctionDecl + ; + +VarList: + SYMBOL + | SYMBOL '[' ConstValue ']' + | VarList ',' SYMBOL + ; + +ConstList: + ConstDef + | ConstDef ',' ConstList + ; + +ConstDef: + SYMBOL '=' ConstValue + ; + +DeclList: + Decl + | Decl ',' DeclList + ; + +Decl: + SYMBOL '(' ConstValue ')' + ; + +StructMembers: + SYMBOL + | SYMBOL ',' StructMembers ';' + ; + +FunctionDecl: + SYMBOL '(' OptFormalArgs ')' Statement + ; + +OptFormalArgs: + | ArgumentList + ; + +ArgumentList: + SYMBOL + | SYMBOL ',' ArgumentList + ; + +Statement: + CompoundStmt + | SYMBOL ':=' Expression ';' + | SYMBOL Subscripts ':=' Expression ';' + | FunctionCall + | IF '(' Expression ')' Statement + | IE '(' Expression ')' Statement + ELSE Statement + | WHILE '(' Expression ')' Statement + | FOR '(' SYMBOL '=' Expression ',' + Expression ')' + Statement + | FOR '(' SYMBOL '=' Expression ',' + Expression, + ConstValue ')' + Statement + | LEAVE ';' + | LOOP ';' + | RETURN Expression ';' + | HALT ConstValue ';' + | ';' + ; + +CompoundStmt: + DO END + | DO LocalDecls END + | DO StatementList END + | DO LocalDecls StatementList END + ; + +LocalDecls: + LocalDecl + | LocalDecl LocalDecls + ; + +LocalDecl: + VAR VarList ';' + | CONST ConstList ';' + | STRUCT SYMBOL '=' StructMembers ';' + ; + +StatementList: + Statement + | Statement StatementList + ; + +ExprList: + Expression + | Expression ',' ExprList + ; + +Expression: + Disjunction + | Disjunction '->' Expression ':' Expression + ; + +Disjunction: + Conjunction + | Conjunction '/\\' Disjunction + ; + +Conjunction: + Equation + | Equation '\\/' Conjunction + ; + +Equation: + Relation + | Relation '=' Equation + | Relation '\\=' Equation + ; + +Relation: + BitOperation + | BitOperation '<' Relation + | BitOperation '>' Relation + | BitOperation '<=' Relation + | BitOperation '>=' Relation + ; + +BitOperation: + Sum + | Sum '&' BitOperation + | Sum '|' BitOperation + | Sum '^' BitOperation + | Sum '<<' BitOperation + | Sum '>>' BitOperation + ; + +Sum: + Term + | Term '+' Sum + | Term '-' Sum + ; + +Term: + Factor + | Factor '*' Term + | Factor '/' Term + | Factor MODULO Term + ; + +Factor: + INTEGER + | FunctionCall + | STRING + | Table + | SYMBOL + | SYMBOL Subscripts + | '@' SYMBOL + | '@' SYMBOL Subscripts + | '-' Factor + | '\\' Factor + | '~' Factor + | '(' Expression ')' + ; + +Subscripts: + '[' Expression ']' + | '[' Expression ']' Subscripts + | '::' Factor + ; + +Table: + '[' MemberList ']' + ; + +MemberList: + TableMember + | TableMember ',' MemberList + ; + +TableMember: + ConstValue + | STRING + | Table + | '(' ExprList ')' + ; + +FunctionCall: + SYMBOL '(' ')' + | SYMBOL '(' ExprList ')' + ; + +ConstValue: + SYMBOL + | Integer + ; + +Integer: + INTEGER + | CHARACTER + ; +%% + diff --git a/t3x9-book/t3x.txt b/t3x9-book/t3x.txt new file mode 100644 index 0000000..e4b6977 --- /dev/null +++ b/t3x9-book/t3x.txt @@ -0,0 +1,689 @@ + + + ################# ############ ###### ###### + ## ## ## ## ## ## ## ## + ####### ####### ####### ## ## ### ## + ## ## ## ## ## ## + ## ## ####### ## ## ### ## + ## ## ## ## ## ## ## ## + ####### ############ ###### ###### + + ------- A MINIMAL PROCEDURAL LANGUAGE -------- + + + PROGRAM + ------- + + A program is a set of declarations followed by a compound + statement. Here is the minimal T3X program: + + DO END + + + COMMENTS + -------- + + A comment is started with an exclamation point (!) and extends + up to the end of the current line. Example: + + DO END ! Do nothing + + + DECLARATIONS + ------------ + + CONST name = cvalue, ... ; + + Assign names to constant values. + + Example: CONST false = 0, true = %1; + + + VAR name, ... ; + VAR name[cvalue], ... ; + VAR name::cvalue, ... ; + + Define variables, vectors, and byte vectors, respectively. + Different definitions may be mixed. Vector elements start at + an index of 0. + + Example: VAR stack[STACK_LEN], ptr; + + + STRUCT name = name_1, ..., name_N; + + Shorthand for CONST name_1 = 0, ..., name_N = N-1, name = N; + Used to impose structure on vectors and byte vectors. + + Example: STRUCT POINT = PX, PY, PCOLOR; + VAR p[POINT]; + + + DECL name(cvalue), ... ; + + Declare functions whose definitions follow later, where the + cvalue is the number of arguments. Used to implement mutual + recursion. + + Example: DECL odd(1); + even(x) RETURN x=0-> 1: odd(x-1); + odd(x) RETURN x=1-> 1: even(x-1); + + + name(name_1, ...) statement + + Define function "name" with arguments "name_1", ... and a + statement as its body. The number of arguments must match + any previous DECL of the same function. + + The arguments of a function are only visible within the + (statement) of the function. + + Example: hello(s, x) DO VAR i; + FOR (i=0, x) DO + writes(s); + writes("\n"); + END + END + + (Writes() writes a string; it is defined later in this text.) + + + STATEMENTS + ---------- + + name := expression; + + Assign the value of an expression to a variable. + + Example: DO VAR x; x := 123; END + + + name[value]... := value; + name::value := value; + + Assign the value of an expression to an element of a vector + or a byte vector. Multiple subscripts may be applied to to a + vector: + + vec[i][j]... := i*j; + + In general, VEC[i][j] denotes the j'th element of the i'th + element of VEC. + + Note that the :: operator is right-associative, so v::x::i + equals v::(x::i). This is particularly important when mixing + subscripts, because + + vec[i]::j[k] := 0; + + would assign 0 to the j[k]'th element of vec[i]. (This makes + sense, because vec[i]::j would not deliver a valid address.) + + + name(); + name(expression_1, ...); + + Call the function with the given name, passing the values of the + expressions to the function. An empty set of parentheses is used + to pass zero arguments. The result of the function is discarded. + + For further details see the description of function calls in the + expression section. + + + IF (condition) statement_1 + IE (condition) statement_1 ELSE statement_2 + + Both of these statements run statement_1, if the given + condition is true. + + In addition, IE/ELSE runs statement_2, if the conditions is + false. In this case, IF just passes control to the subsequent + statement. + + Example: IE (0) + IF (1) RETURN 1; + ELSE + RETURN 2; + + The example always returns 2, because only an IE statement can + have an ELSE branch. There is no "dangling else" problem. + + + WHILE (condition) statement + + Repeat the statement while the condition is true. When the + condition is not true initially, never run the statement. + + Example: ! Count from 1 to 10 + DO VAR i; + i := 0; + WHILE (i < 10) + i := i+1; + END + + + FOR (name=expression_1, expression_2, cvalue) statement + FOR (name=expression_1, expression_2) statement + + Assign the value of expression_1 to name, then compare name to + expression_2. If cvalue is not negative, repeat the statement + while name < expression_2. Otherwise repeat the statement while + name > expression_2. After running the statement, add cvalue + to name. Formally: + + name := expression_1; + WHILE ( cvalue > 0 /\ name < expression \/ + cvalue < 0 /\ name > expression ) + DO + statement; + name := name + cvalue; + END + + When the cvalue is omitted, it defaults to 1. + + Examples: DO VAR i; + FOR (i=1, 11); ! count from 1 to 10 + FOR (i=10, 0, %1); ! count from 10 to 1 + END + + + LEAVE; + + Leave the innermost WHILE or FOR loop, passing control to the + first statement following the loop. + + Example: DO VAR i; ! Count from 1 to 50 + FOR (i=1, 100) IF (i=50) LEAVE; + END + + + LOOP; + + Re-enter the innermost WHILE or FOR loop. WHILE loops are + re-entered at the point where the condition is tested, and + FOR loops are re-entered at the point where the counter is + incremented. + + Example: DO VAR i; ! This program never prints X + FOR (i=1, 10) DO + LOOP; + T.WRITE(1, "x", 1); + END + END + + + RETURN expression; + + Return a value from a function. For further details see the + description of function calls in the expression section. + + Example: inc(x) RETURN x+1; + + + HALT cvalue; + + Halt program and return the given exit code to the operating + system. + + Example: HALT 1; + + + DO statement ... END + DO declaration ... statement ... END + + Compound statement of the form DO ... END are used to place + multiple statements in a context where only a single statement + is expected, like selection, loop, and function bodies. + + A compound statement may declare its own local variables, + constant, and structures (using VAR, CONST, or STRUCT). A + local variable of a compound statement is created and + allocated at the beginning of the statement is ceases to + exist at the end of the statement. + + Note that the form + + DO declaration ... END + + also exists, but is essentially an empty statement. + + Example: DO var i, x; ! Compute 10 factorial + x := 1; + for (i=1, 10) + x := x*i; + END + + + DO END + ; + + These are both empty statements or null statements. They do not + do anything when run and may be used as placeholders where a + statement would be expected. They are also used to show that + nothing is to be done in a specific situation, like in + + IE (x = 0) + ; + ELSE IE (x < 0) + statement; + ELSE + statement; + + Examples: FOR (i=0, 100000) DO END ! waste some time + + + EXPRESSIONS + ----------- + + An expression is a variable or a literal or a function call or + a set of operators applied to one of these. There are unary, + binary, and ternary operators. + + Examples: -a ! negate a + b*c ! product of b and c + x->y:z ! if x then y else z + + In the following, the symbols X, Y, and Z denote variables or + literals. + + These operators exist (P denotes precedence, A associativity): + + OPERATOR P A DESCRIPTION + + X[Y] 9 L the Y'th element of the vector X + X::Y 9 R the Y'th byte of the byte vector X + + -X 8 - the negative value of X + ~X 8 - the bitwise inverse of X + \X 8 - logical NOT of X + @X 8 - the address of X + + X*Y 7 L the product of X and Y + Y/Y 7 L the integer quotient of X and Y + X mod Y 7 L the division remainder of X and Y + + X+Y 6 L the sum of X and Y + X-Y 6 L the difference between X and Y + + X&Y 5 L the bitwise AND of X and Y + X|Y 5 L the bitwise OR of X and Y + X^Y 5 L the bitwise XOR of X and Y + X<>Y 5 L X shifted to the right by Y bits + + XY 4 L %1, if X is less than Y, else 0 + X<=Y 4 L %1, if X is less/equal Y, else 0 + X>=Y 4 L %1, if X is greater/equal Y, else 0 + + X=Y 3 L %1, if X equals Y, else 0 + X\=Y 3 L %1, if X does not equal Y, else 0 + + X/\Y 2 L if X then Y else 0 + (short-circuit logical AND) + + X\/Y 1 L if X then X else Y + (short-circuit logical OR) + + X->Y:Z 0 - if X then Y else Z + + Higher precedence means that an operator binds stronger, e.g. + -X::Y actually means -(X::Y). + + Left-associativity (L) means that x+y+z = (x+y)+z and + right-associativity (R) means that x::y::z = x::(y::z). + + + CONDITIONS + ---------- + + A condition is an expression appearing in a condition context, + like the condition of an IF or WHILE statement or the first + operand of the X->Y:Z operator. + + In an expression context, the value 0 is considered to be + "false", and any other value is considered to be true. For + example: + + X=X is true + 1=2 is false + "x" is true + 5>7 is false + + The canonical truth value, as returned by 1=1, is %1. + + + FUNCTION CALLS + -------------- + + When a function call appears in an expression, the result of + the function, as returned by RETURN is used as an operand. + + A function call is performed as follows: + + Each actual argument in the call + + function(argument_1, ...) + + is passed to the function and bound to the corresponding formal + argument ("argument") of the receiving function. The function + then runs its statement, which may produce a value via RETURN. + When no RETURN statement exists in the statement, 0 is returned. + + Function arguments evaluate from the left to the right, so in + + f(a,b,c); + + A is guaranteed to evaluate before B and C and B is guaranteed + to evaluate before C. + + Example: pow(x, y) DO VAR a; + a := 1; + WHILE (y) DO + a := a*x; + y := y-1; + END + RETURN a; + END + + DO VAR x; + x := pow(2,10); + END + + + LITERALS + -------- + + INTEGERS + + An integer is a number representing its own value. Note that + negative numbers have a leading '%' sign rather than a '-' sign. + While the latter also works, it is, strictly speaking, the + application of the '-' operator to a positive number, so it may + not appear in cvalue contexts. + + Examples: 0 + 12345 + %1 + + + CHARACTERS + + Characters are integers internally. They are represented by + single characters enclosed in single quotes. In addition, the + same escape sequences as in strings may be used. + + Examples: 'x' + '\\' + ''' + '\e' + + + STRINGS + + A string is a byte vector filled with characters. Strings are + delimited by '"' characters and NUL-terminated internally. All + characters between the delimiting double quotes represent + themselves. In addition, the following escape sequences may be + used to include some special characters: + + \a BEL Bell + \b BS Backspace + \e ESC Escape + \f FF Form Feed + \n LF Line Feed (newline) + \q " Quote + \r CR Carriage Return + \s Space + \t HT Horizontal Tabulator + \v VT Vertical Tabulator + \\ \ Backslash + + Examples: "" + "hello, world!\n" + "\qhi!\q, she said" + + + TABLES + + A table is a vector literal, i.e. a sequence of subsequent + values. It is delimited by square brackets and elements are + separated by commas. Table elements can be cvalues, strings, + and tables. + + Examples: [1, 2, 3] + ["5 times -7", %35] + [[1,0,0],[0,1,0],[0,0.1]] + + + DYNAMIC TABLES + + The dynamic table is a special case of the table in which one + or multiple elements are computed at program run time. Dynamic + table elements are enclosed in parentheses. E.g. in the table + + ["x times 7", (x*7)] + + the value of the second element would be computed and filled + in when the table is being evaluated. Note that dynamic table + elements are being replaced in situ, and remain the same only + until they are replaced again. + + Multiple dynamic elements may be enclosed by a single pair of + parentheses. For instance, the following tables are the same: + + [(x), (y), (z)] + [(x, y, z)] + + + CVALUES + ------- + + A cvalue (constant value) is an expression whose value is known + at compile time. In full T3X, this is a large subset of full + expressions, but in T3X9, it it limited to the following: + + * integers + * characters + * constants + + as well as (given that X and Y are one of the above): + + * X+Y + * X*Y + + + NAMING CONVENTIONS + ------------------ + + Symbolic names for variables, constants, structures, and + functions are constructed from the following alphabet: + + * the characters a-z + * the digits 0-9 + * the special characters '_' and '.' + + The first character of a name must be non-numeric, the remaining + characters may be any of the above. + + Upper and lower case is not distinguished, the symbolic names + + FOO, Foo, foo + + are all considered to be equal. + + By convention, + + * CONST names are all upper-case + * STRUCT names are all upper-case + * global VAR names are capitalized + * local VAR names are all lower-case + * function names are all lower-case + + Keywords, like VAR, IF, DO, etc, are sometimes printed in upper + case in documentation, but are usually in lower case in actual + programs. + + + SHADOWING + --------- + + There is a single name space without any shadowing in T3X: + + * all global names must be different + * no local name may have the same name as a global name + * all local names in the same scope must be different + + The latter means that local names may be re-used in subsequent + scopes, e.g.: + + f(x) RETURN x; + g(x) RETURN x; + + would be a valid program. However, + + f(x) DO VAR x; END !!! WRONG !!! + + would not be a valid program, because VAR x; redefines the + argument of F. + + + BUILT-IN FUNCTIONS + ------------------ + + The following built-in functions exist in T3X9. They resemble + the functions of the T3X core module of the full language, i.e. + a T3X9 program can be compiled by a T3X compiler by adding the + following code to the top of the program: + + MODULE name(t3x); + OBJECT t[t3x]. + + These functions are built into the T3X9 compiler, though, and + do not have to be declared in any way. The '.' in the function + names resembles the message operator of the full language. + + + T.READ(fd, buf, len) + + Read up to LEN characters from the file descriptor FD into the + buffer BUF. Return the number of characters actually read. + Return %1 in case of an error. + + + T.WRITE(fd, buf, len) + + Write LEN characters from the buffer BUF to the file descriptor + FD. Return the number of characters actually written. Return %1 + in case of an error. + + Example: t.write(1, "hello, world!\n", 14); + + + T.MEMCOMP(b1, b2, len) + + Compare the first LEN bytes of the byte vectors B1 and B2. + Return the difference of the first pair of mismatching bytes. + A return code of 0 means that the compared regions are equal. + + Example: t.memcomp("aaa", "aba", 3) ! gives 'b'-'a' = %1 + + + T.MEMCOPY(bs, bd, len) + + Copy LEN bytes from the byte vector BS (source) to the byte + vector BD (destination). Return 0. + + Example: DO VAR b:100; t.memcopy("hello", b, 5); END + + + T.MEMFILL(bv, b, len) + + Fill the first LEN bytes of the byte vector BV with the byte + value B. Return 0. + + Example: DO VAR b:100; t.memfill(b, 0, 100); END + + + T.MEMSCAN(bv, b, len) + + Locate the first occurrence of the byte value B in the first LEN + bytes of the byte vector BV and return its offset in the vector. + When B does not exist in the given region, return %1. + + Example: t.memscan("aaab", 'b', 4) ! returns 3 + + + VARIADIC FUNCTIONS + ------------------ + + T3X implements variadic functions (i.e. functions of a variable + number of arguments) using dynamic tables. For instance, the + following function returns the sum of a vector of arguments: + + sum(k, v) DO var i, n; + n := 0; + FOR (i=0, k) + n := n+v[i]; + RETURN n; + END + + Its is an ordinary function returning the sum of a vector. It + can be considered to be a variadic function, because a dynamic + table can be passed to it in the V argument: + + sum(5, [(a,b,c,d,e)]) + + + EXAMPLE PROGRAM + --------------- + + var ntoa_buf::100; + + ntoa(x) do var i, k; + if (x = 0) return "0"; + i := 0; + k := x<0-> -x: x; + while (k > 0) do + i := i+1; + k := k/10; + end + i := i+1; + if (x < 0) i := i+1; + ntoa_buf::i := 0; + k := x<0-> -x: x; + while (k > 0) do + i := i-1; + ntoa_buf::i := '0' + k mod 10; + k := k/10; + end + if (x < 0) do + i := i-1; + ntoa_buf::i := '-'; + end + return @ntoa_buf::i; + end + + str.length(s) return t.memscan(s, 0, 32767); + + writes(s) t.write(1, s, str.length(s)); + + fib(n) do var r1, r2, i, t; + r1 := 0; + r2 := 1; + for (i=1, n) do + t := r2; + r2 := r2 + r1; + r1 := t; + end + return r2; + end + + do var i; + for (i=1, 11) do + writes(ntoa(fib(i))); + writes("\n"); + end + end diff --git a/t3x9-book/test.t b/t3x9-book/test.t new file mode 100644 index 0000000..673a4df --- /dev/null +++ b/t3x9-book/test.t @@ -0,0 +1,47 @@ +var ntoa_buf::100; + +ntoa(x) do var i, k; + if (x = 0) return "0"; + i := 0; + k := x<0-> -x: x; + while (k > 0) do + i := i+1; + k := k/10; + end + i := i+1; + if (x < 0) i := i+1; + ntoa_buf::i := 0; + k := x<0-> -x: x; + while (k > 0) do + i := i-1; + ntoa_buf::i := '0' + k mod 10; + k := k/10; + end + if (x < 0) do + i := i-1; + ntoa_buf::i := '-'; + end + return @ntoa_buf::i; +end + +str.length(s) return t.memscan(s, 0, 32767); + +writes(s) t.write(1, s, str.length(s)); + +fib(n) do var r1, r2, i, t; + r1 := 0; + r2 := 1; + for (i=1, n) do + t := r2; + r2 := r2 + r1; + r1 := t; + end + return r2; +end + +do var i; + for (i=1, 11) do + writes(ntoa(fib(i))); + writes("\n"); + end +end diff --git a/t3x9r3-extended/CHANGES b/t3x9r3-extended/CHANGES new file mode 100644 index 0000000..b040311 --- /dev/null +++ b/t3x9r3-extended/CHANGES @@ -0,0 +1,29 @@ +************************************************************************ +IMPORTANT: + +The book version of the T3X compiler uses a T.MEMCOPY procedure with +the following arguments: + +T.MEMCOPY(SOURCE, DESTINATION, LENGTH) + +Note that this version is incompatible with the original T3X language, +which uses + +T.MEMCOPY(DESTINATION, SOURCE, LENGTH) + +The compiler in this archive uses the original T3X version with the +destination argument to the left of the source argument. Hence it is +slightly incompatible to the book version! +************************************************************************ + +20200304 Added MODULE and OBJECT dummy declarations (T3X compatibility). +20190913 Made T.MEMCOPY compatible with the original T3X version. +20190720 Fixed harmless minor inconsistency in operator table. +20170605 Add hexa-decimal integer literals to language. +20170605 Add T3X packed vectors (byte vectors) to language. +20170528 Add tcdis, Tcode9 disassembler. +20170528 Add tcvm, ad-hoc Tcode9 virtual machine. +20170523 Add t-vm.t, T3X9->Tcode9 compiler. +20170520 Fix: DO VAR x; x(); END would not report call of non-function. +20170518 Fix parser bug mis-parsing IE (x) IF (y) v; ELSE w;. +20170430 Add T.CREATE, T.OPEN, T.CLOSE, T.RENAME, T.REMOVE built-ins. diff --git a/t3x9r3-extended/MANIFEST b/t3x9r3-extended/MANIFEST new file mode 100644 index 0000000..6610430 --- /dev/null +++ b/t3x9r3-extended/MANIFEST @@ -0,0 +1,17 @@ +CHANGES change log +MANIFEST this file +Makefile Makefile +README read me +_csums checksums +dump.c dump code part of a T3X9-generated ELF file +t-vm.t T3X9->Tcode9 compiler +t.c T3X9->ELF boostrapping compiler +t.elf T3X9->ELF compiler, FreeBSD-386-ELF executable +t.t T3X9->ELF compiler +t.vm T3X9->Tcode9 compiler, Tcode9 VM executable +t3x-history.txt short summary of T3X language +t3x.bnf yaccable T3X9 grammar +t3x.txt T3X9 micro manual +tcdis.c Tcode9 disassembler +tcvm.c ad-hoc Tcode9 virtual machine +test.t test program diff --git a/t3x9r3-extended/Makefile b/t3x9r3-extended/Makefile new file mode 100644 index 0000000..8f44458 --- /dev/null +++ b/t3x9r3-extended/Makefile @@ -0,0 +1,42 @@ +D= t3x9r3 +A= $D.tgz + +all: t0 t.elf t.vm tcvm + +t0: t.c t.t + cc -static -o t0 t.c + +t.vm: t-vm + ./t-vm t.vm + +t-vm: t-vm.t + ./t3 t-vm && chmod +x t-vm + +tcvm: tcvm.c + cc -O2 -g -o tcvm tcvm.c + +t.elf: test + cp t3 t.elf + +test: t0 + touch t1 t2 t3; chmod +x t1 t2 t3 + ./t0 t1 && ./t1 t2 && ./t2 t3 && cmp t2 t3 + +vmtest: tcvm + ./tcvm t.vm t1.vm + ./tcvm t1.vm t2.vm + ./tcvm t2.vm t3.vm + cmp t2.vm t3.vm + +mksums: clean + ls | grep -v $A | grep -v _csums | csum -m >_csums + +csums: + csum -u <_csums >_csums.new && mv -f _csums.new _csums + +clean: + rm -f t0 t1 t2 t3 t1.vm t2.vm t3.vm t-vm a.out tcvm dump *.o *.core \ + $A + +arc: clean + (cd ..; tar cvf - $D | gzip -9 >$A); mv -f ../$A . diff --git a/t3x9r3-extended/README b/t3x9r3-extended/README new file mode 100644 index 0000000..dc52a48 --- /dev/null +++ b/t3x9r3-extended/README @@ -0,0 +1,30 @@ + + This is the T3X9 compiler, Release 2 + + It is superset of the compiler described in + + "Write Your Own Compiler" + by Nils M Holm + + More details about the book can be found at T3X.ORG. + + ********************************************************* + Please consult the CHANGES file before usig this version! + ********************************************************* + + To compile the compiler on FreeBSD-386, just do + + chmod +x t.elf && ./t.elf t.new + + To compile it on any system providing a C89 compiler: + + cc -o t0 t.c && ./t0 t.new + + Alternatively, use the Tcode9 virtual machine: + + cc -o tcvm tcvm.c && ./tcvm t.vm t.new + + You can then compile T3X9 programs using + + ./tcvm t.new vm-program + diff --git a/t3x9r3-extended/_csums b/t3x9r3-extended/_csums new file mode 100644 index 0000000..166e744 --- /dev/null +++ b/t3x9r3-extended/_csums @@ -0,0 +1,16 @@ +15731 2 CHANGES +46710 1 MANIFEST +13049 1 Makefile +62480 1 README +14051 1 dump.c +37533 29 t-vm.t +32747 27 t.c +10398 34 t.elf +26599 31 t.t +31885 19 t.vm +28851 3 t3x-history.txt +45560 3 t3x.bnf +32461 21 t3x.txt +33423 6 tcdis.c +7233 7 tcvm.c +33987 1 test.t diff --git a/t3x9r3-extended/dump.c b/t3x9r3-extended/dump.c new file mode 100644 index 0000000..4b5989b --- /dev/null +++ b/t3x9r3-extended/dump.c @@ -0,0 +1,21 @@ +#include + +#define Z 65536 +#define byte unsigned char + +byte T[Z]; + +int main(void) { + int k, i; + + k = fread(T, 1, Z, stdin); + printf(".byte "); + for (i=0x74; i Tcode9 compiler +! Nils M Holm, 2017,2020 CC0 license +! https://creativecommons.org/publicdomain/zero/1.0/ + +const BPW = 4; + +const PROG_SIZE = 65536; + +const TEXT_SIZE = 65536; +const DATA_SIZE = 65536; + +const NRELOC = 10000; + +const STACK_SIZE = 100; + +const SYMTBL_SIZE = 1000; +const NLIST_SIZE = 10000; + +var Stack[STACK_SIZE], Sp; + +var Line; + +const ENDFILE = %1; + +var ntoa_buf::100; + +ntoa(x) do var i, k; + if (x = 0) return "0"; + i := 0; + k := x<0-> -x: x; + while (k > 0) do + i := i+1; + k := k/10; + end + i := i+1; + if (x < 0) i := i+1; + ntoa_buf::i := 0; + k := x<0-> -x: x; + while (k > 0) do + i := i-1; + ntoa_buf::i := '0' + k mod 10; + k := k/10; + end + if (x < 0) do + i := i-1; + ntoa_buf::i := '-'; + end + return @ntoa_buf::i; +end + +str_length(s) return t.memscan(s, 0, 32767); + +str_copy(sd, ss) t.memcopy(sd, ss, str_length(ss)+1); + +str_append(sd, ss) t.memcopy(@sd::str_length(sd), ss, str_length(ss)+1); + +str_equal(s1, s2) return t.memcomp(s1, s2, str_length(s1)+1) = 0; + +writes(s) t.write(1, s, str_length(s)); + +log(s) t.write(2, s, str_length(s)); + +aw(m, s) do + log("t3x9: "); + log(ntoa(Line)); + log(": "); + log(m); + if (s \= 0) do + log(": "); + log(s); + end + log("\n"); + halt 1; +end + +oops(m, s) do + log("t3x9: internal error\n"); + aw(m, s); +end + +push(x) do + if (Sp >= STACK_SIZE) oops("stack overflow", 0); + Stack[Sp] := x; + Sp := Sp+1; +end + +tos() return Stack[Sp-1]; + +pop() do + if (Sp < 1) oops("stack underflow", 0); + Sp := Sp-1; + return Stack[Sp]; +end + +swap() do var t; + if (Sp < 2) oops("stack underflow", 0); + t := Stack[Sp-1]; + Stack[Sp-1] := Stack[Sp-2]; + Stack[Sp-2] := t; +end + +numeric(c) return '0' <= c /\ c <= '9'; + +alphabetic(c) return 'a' <= c /\ c <= 'z' \/ + 'A' <= c /\ c <= 'Z'; + +! +! Symbol table +! + +struct SYM = SNAME, SFLAGS, SVALUE; + +const GLOBF = 1; +const CNST = 2; +const VECT = 4; +const FORW = 8; +const FUNC = 16; + +var Syms[SYM*SYMTBL_SIZE]; +var Nlist::NLIST_SIZE; + +var Yp, Np; + +find(s) do var i; + i := Yp-SYM; + while (i >= 0) do + if (str_equal(Syms[i+SNAME], s)) + return @Syms[i]; + i := i - SYM; + end + return 0; +end + +lookup(s, f) do var y; + y := find(s); + if (y = 0) aw("undefined", s); + if (y[SFLAGS] & f \= f) + aw("unexpected type", s); + return y; +end + +newname(s) do var k, new; + k := str_length(s)+1; + if (Np+k >= NLIST_SIZE) + aw("too many symbol names", s); + new := @Nlist::Np; + t.memcopy(new, s, k); + Np := Np+k; + return new; +end + +add(s, f, v) do var y; + y := find(s); + if (y \= 0) do + ie (y[SFLAGS] & FORW /\ f & FUNC) + return y; + else + aw("redefined", s); + end + if (Yp+SYM >= SYMTBL_SIZE*SYM) + aw("too many symbols", 0); + y := @Syms[Yp]; + Yp := Yp+SYM; + y[SNAME] := newname(s); + y[SFLAGS] := f; + y[SVALUE] := v; + return y; +end + +! +! Emitter +! + +const TEXT_VADDR = 0; +const DATA_VADDR = 0; + +const HEADER_SIZE = 36; + +const PAGE_SIZE = 4096; + +struct RELOC = RADDR, RSEG; + +var Rel[RELOC*NRELOC]; + +var Text_seg::TEXT_SIZE; +var Data_seg::DATA_SIZE; +var Header::HEADER_SIZE; + +var Rp, Tp, Dp, Lp, Hp; + +var Acc; + +var Codetbl; + +struct CG = CG_PUSH, CG_CLEAR, + CG_LDVAL, CG_LDADDR, CG_LDLREF, CG_LDGLOB, + CG_LDLOCL, + CG_STGLOB, CG_STLOCL, CG_STINDR, CG_STINDB, + CG_INCGLOB, CG_INCLOCL, + CG_ALLOC, CG_DEALLOC, CG_LOCLVEC, CG_GLOBVEC, + CG_INDEX, CG_DEREF, CG_INDXB, CG_DREFB, + CG_MARK, CG_RESOLV, + CG_CALL, CG_JUMPFWD, CG_JUMPBACK, CG_JMPFALSE, + CG_JMPTRUE, CG_FOR, CG_FORDOWN, + CG_ENTER, CG_EXIT, CG_HALT, + CG_NEG, CG_INV, CG_LOGNOT, CG_ADD, CG_SUB, + CG_MUL, CG_DIV, CG_MOD, CG_AND, CG_OR, CG_XOR, + CG_SHL, CG_SHR, CG_EQ, CG_NEQ, CG_LT, CG_GT, + CG_LE, CG_GE, + CG_WORD; + +emit(x) do + if (Tp >= DATA_SIZE) + aw("text segment too big", 0); + Text_seg::Tp := x; + Tp := Tp+1; +end + +emitw(x) do + emit(255&x); + emit(255&(x>>8)); + emit(255&(x>>16)); + emit(255&(x>>24)); +end + +tag(seg) do + if (Rp+RELOC >= RELOC*NRELOC) + oops("relocation buffer overflow", 0); + Rel[Rp+RADDR] := seg = 't'-> Tp-BPW: Dp-BPW; + Rel[Rp+RSEG] := seg; + Rp := Rp+RELOC; +end + +tpatch(a, x) do + Text_seg::a := 255&x; + Text_seg::(a+1) := 255&(x>>8); + Text_seg::(a+2) := 255&(x>>16); + Text_seg::(a+3) := 255&(x>>24); +end + +tfetch(a) return Text_seg::a + | (Text_seg::(a+1)<<8) + | (Text_seg::(a+2)<<16) + | (Text_seg::(a+3)<<24); + +data(x) do + Data_seg::Dp := x; + Dp := Dp+1; +end + +dataw(x) do + if (Dp >= DATA_SIZE) + aw("data segment too big", 0); + data(255&x); + data(255&(x>>8)); + data(255&(x>>16)); + data(255&(x>>24)); +end + +dpatch(a, x) do + Data_seg::a := 255&x; + Data_seg::(a+1) := 255&(x>>8); + Data_seg::(a+2) := 255&(x>>16); + Data_seg::(a+3) := 255&(x>>24); +end + +dfetch(a) return Data_seg::a + | (Data_seg::(a+1)<<8) + | (Data_seg::(a+2)<<16) + | (Data_seg::(a+3)<<24); + +hex(c) ie (numeric(c)) + return c-'0'; + else + return c-'a'+10; + +rgen(s, v) do var x, f, b; + f := %1; + b := 0; + while (s::0) do + ie (s::0 = ',') do + ie (s::1 = 'w') do + ie (b) + emit(v); + else + emitw(v); + end + else ie (s::1 = 'a') do + emitw(v); + tag('t'); + end + else ie (s::1 = 'W') do + emitw(v); + end + else ie (s::1 = 'm') do + push(Tp); + end + else ie (s::1 = '>') do + push(Tp); + emitw(0); + end + else ie (s::1 = '<') do + emitw(pop()-Tp-BPW); + end + else ie (s::1 = 'r') do + x := pop(); + tpatch(x, Tp-x-BPW); + end + else do + oops("bad code", 0); + end + end + else do + x := hex(s::0)*16+hex(s::1); + if (f /\ %127 <= v /\ v <= 127) do + x := x | 128; + b := 1; + end + emit(x); + end + f := 0; + s := s+2; + end +end + +gen(id, v) rgen(Codetbl[id][1], v); + +spill() ie (Acc) + gen(CG_PUSH, 0); + else + Acc := 1; + +active() return Acc; + +clear() Acc := 0; + +activate() Acc := 1; + +relocate() do var i, a, dist; + dist := Tp; + for (i=0, Rp, RELOC) do + ie (Rel[i+RSEG] = 't') do + a := tfetch(Rel[i+RADDR]); + a := a + dist; + tpatch(Rel[i+RADDR], a); + end + else do + a := dfetch(Rel[i+RADDR]); + a := a + dist; + dpatch(Rel[i+RADDR], a); + end + end +end + +builtin(name, arity, code) do + gen(CG_JUMPFWD, 0); + add(name, GLOBF|FUNC | (arity << 8), Tp); + rgen(code, 0); + gen(CG_RESOLV, 0); +end + +align(x, a) return (x+a) & ~(a-1); + +hdwrite(b) do + if (Hp >= HEADER_SIZE) + oops("Tcode9 header too long", 0); + Header::Hp := b; + Hp := Hp+1; +end + +strwrite(b) + while (b::0) do + hdwrite(b::0); + b := b+1; + end + +lewrite(x) do + hdwrite(x & 255); + hdwrite(x>>8 & 255); + hdwrite(x>>16 & 255); + hdwrite(x>>24 & 255); +end + +tcode_header() do + strwrite("#! /u/bin/tcvm\n"); + strwrite("T3X9"); ! magic + lewrite(Tp); ! text segment size + lewrite(Dp); ! data segment size +end + +! +! Scanner +! + +const META = 256; + +const TOKEN_LEN = 128; + +var Prog::PROG_SIZE; + +var Pp, Psize; + +var Tk; +var Str::TOKEN_LEN; +var Val; +var Oid; + +var Equal_op, Minus_op, Mul_op, Add_op; + +struct OPER = OPREC, OLEN, ONAME, OTOK, OCODE; + +var Ops; + +struct TOKENS = + SYMBOL, INTEGER, STRING, + ADDROF, ASSIGN, BINOP, BYTEOP, COLON, COMMA, COND, + CONJ, DISJ, LBRACK, LPAREN, RBRACK, RPAREN, SEMI, UNOP, + KCONST, KDECL, KDO, KELSE, KEND, KFOR, KHALT, KIE, KIF, + KLEAVE, KLOOP, KMODULE, KOBJECT, KPACKED, KRETURN, + KSTRUCT, KVAR, KWHILE; + +readprog() do + Psize := t.read(0, Prog, PROG_SIZE); + if (Psize >= PROG_SIZE) + aw("program too big", 0); +end + +readrc() do var c; + c := Pp >= Psize-> ENDFILE: Prog::Pp; + Pp := Pp+1; + return c; +end + +readc() do var c; + c := readrc(); + return 'A' <= c /\ c <= 'Z'-> c-'A'+'a': c; +end + +readec() do var c; + c := readrc(); + if (c \= '\\') return c; + c := readrc(); + if (c = 'a') return '\a'; + if (c = 'b') return '\b'; + if (c = 'e') return '\e'; + if (c = 'f') return '\f'; + if (c = 'n') return '\n'; + if (c = 'q') return '"' | META; + if (c = 'r') return '\r'; + if (c = 's') return '\s'; + if (c = 't') return '\t'; + if (c = 'v') return '\v'; + return c; +end + +reject() Pp := Pp-1; + +skip() do var c; + c := readc(); + while (1) do + while (c = ' ' \/ c = '\t' \/ c = '\n' \/ c = '\r') do + if (c = '\n') Line := Line+1; + c := readc(); + end + if (c \= '!') + return c; + while (c \= '\n' /\ c \= ENDFILE) + c := readc(); + end +end + +findkw(s) do + if (s::0 = 'c') do + if (str_equal(s, "const")) return KCONST; + return 0; + end + if (s::0 = 'd') do + if (str_equal(s, "do")) return KDO; + if (str_equal(s, "decl")) return KDECL; + return 0; + end + if (s::0 = 'e') do + if (str_equal(s, "else")) return KELSE; + if (str_equal(s, "end")) return KEND; + return 0; + end + if (s::0 = 'f') do + if (str_equal(s, "for")) return KFOR; + return 0; + end + if (s::0 = 'h') do + if (str_equal(s, "halt")) return KHALT; + return 0; + end + if (s::0 = 'i') do + if (str_equal(s, "if")) return KIF; + if (str_equal(s, "ie")) return KIE; + return 0; + end + if (s::0 = 'l') do + if (str_equal(s, "leave")) return KLEAVE; + if (str_equal(s, "loop")) return KLOOP; + return 0; + end + if (s::0 = 'm') do + if (str_equal(s, "mod")) return BINOP; + if (str_equal(s, "module")) return KMODULE; + return 0; + end + if (s::0 = 'o') do + if (str_equal(s, "object")) return KOBJECT; + return 0; + end + if (s::0 = 'p') do + if (str_equal(s, "packed")) return KPACKED; + return 0; + end + if (s::0 = 'r') do + if (str_equal(s, "return")) return KRETURN; + return 0; + end + if (s::0 = 's') do + if (str_equal(s, "struct")) return KSTRUCT; + return 0; + end + if (s::0 = 'v') do + if (str_equal(s, "var")) return KVAR; + return 0; + end + if (s::0 = 'w') do + if (str_equal(s, "while")) return KWHILE; + return 0; + end + return 0; +end + +scanop(c) do var i, j; + i := 0; + j := 0; + Oid := %1; + while (Ops[i][OLEN] > 0) do + ie (Ops[i][OLEN] > j) do + if (Ops[i][ONAME]::j = c) do + Oid := i; + Str::j := c; + c := readc(); + j := j+1; + end + end + else do + leave; + end + i := i+1; + end + if (Oid = %1) do + Str::j := c; + j := j+1; + Str::j := 0; + aw("unknown operator", Str); + end + Str::j := 0; + reject(); + return Ops[Oid][OTOK]; +end + +findop(s) do var i; + i := 0; + while (Ops[i][OLEN] > 0) do + if (str_equal(s, Ops[i][ONAME])) do + Oid := i; + return Oid; + end + i := i+1; + end + oops("operator not found", s); +end + +symbolic(c) return alphabetic(c) \/ c = '_' \/ c = '.'; + +scan() do var c, i, k, sgn, base; + c := skip(); + if (c = ENDFILE) do + str_copy(Str, "end of file"); + return ENDFILE; + end + if (symbolic(c)) do + i := 0; + while (symbolic(c) \/ numeric(c)) do + if (i >= TOKEN_LEN-1) do + Str::i := 0; + aw("symbol too long", Str); + end + Str::i := c; + i := i+1; + c := readc(); + end + Str::i := 0; + reject(); + k := findkw(Str); + if (k \= 0) do + if (k = BINOP) findop(Str); + return k; + end + return SYMBOL; + end + if (numeric(c) \/ c = '%') do + sgn := 1; + i := 0; + if (c = '%') do + sgn := %1; + c := readc(); + Str::i := c; + i := i+1; + if (\numeric(c)) + aw("missing digits after '%'", 0); + end + base := 10; + if (c = '0') do + c := readc(); + if (c = 'x') do + base := 16; + c := readc(); + if (\numeric(c) /\ (c < 'a' \/ c > 'f')) + aw("missing digits after '0x'", 0); + end + end + Val := 0; + while ( numeric(c) \/ + base = 16 /\ 'a' <= c /\ c <= 'f' + ) do + if (i >= TOKEN_LEN-1) do + Str::i := 0; + aw("integer too long", Str); + end + Str::i := c; + i := i+1; + c := c >= 'a'-> c-'a'+10: c-'0'; + Val := Val * base + c; + c := readc(); + end + Str::i := 0; + reject(); + Val := Val * sgn; + return INTEGER; + end + if (c = '\'') do + Val := readec(); + if (readc() \= '\'') + aw("missing ''' in character", 0); + return INTEGER; + end + if (c = '"') do + i := 0; + c := readec(); + while (c \= '"' /\ c \= ENDFILE) do + if (i >= TOKEN_LEN-1) do + Str::i := 0; + aw("string too long", Str); + end + Str::i := c & (META-1); + i := i+1; + c := readec(); + end + Str::i := 0; + return STRING; + end + return scanop(c); +end + +! +! Parser +! + +const MAXTBL = 128; +const MAXLOOP = 100; + +var Fun; +var Loop0; +var Leaves[MAXLOOP], Lvp; +var Loops[MAXLOOP], Llp; + +expect(tok, s) do var b::100; + if (tok = Tk) return; + str_copy(b, s); + str_append(b, " expected"); + aw(b, Str); +end + +xeqsign() do + if (Tk \= BINOP \/ Oid \= Equal_op) + expect(BINOP, "'='"); + Tk := scan(); +end + +xsemi() do + expect(SEMI, "';'"); + Tk := scan(); +end + +xlparen() do + expect(LPAREN, "'('"); + Tk := scan(); +end + +xrparen() do + expect(RPAREN, "')'"); + Tk := scan(); +end + +xsymbol() expect(SYMBOL, "symbol"); + +constfac() do var v, y; + if (Tk = INTEGER) do + v := Val; + Tk := scan(); + return v; + end + if (Tk = SYMBOL) do + y := lookup(Str, CNST); + Tk := scan(); + return y[SVALUE]; + end + aw("constant value expected", Str); +end + +constval() do var v; + v := constfac(); + ie (Tk = BINOP /\ Oid = Mul_op) do + Tk := scan(); + v := v * constfac(); + end + else if (Tk = BINOP /\ Oid = Add_op) do + Tk := scan(); + v := v + constfac(); + end + return v; +end + +vardecl(glob) do var y, size; + Tk := scan(); + while (1) do + xsymbol(); + ie (glob & GLOBF) + y := add(Str, glob, Dp); + else + y := add(Str, 0, Lp); + Tk := scan(); + size := 1; + ie (Tk = LBRACK) do + Tk := scan(); + size := constval(); + if (size < 1) + aw("invalid size", 0); + y[SFLAGS] := y[SFLAGS] | VECT; + expect(RBRACK, "']'"); + Tk := scan(); + end + else if (Tk = BYTEOP) do + Tk := scan(); + size := constval(); + if (size < 1) + aw("invalid size", 0); + size := (size + BPW-1) / BPW; + y[SFLAGS] := y[SFLAGS] | VECT; + end + ie (glob & GLOBF) do + if (y[SFLAGS] & VECT) do + gen(CG_ALLOC, size*BPW); + gen(CG_GLOBVEC, Dp); + end + dataw(0); + end + else do + gen(CG_ALLOC, size*BPW); + Lp := Lp - size*BPW; + if (y[SFLAGS] & VECT) do + gen(CG_LOCLVEC, 0); + Lp := Lp - BPW; + end + y[SVALUE] := Lp; + end + if (Tk \= COMMA) leave; + Tk := scan(); + end + xsemi(); +end + +constdecl(glob) do var y; + Tk := scan(); + while (1) do + xsymbol(); + y := add(Str, glob|CNST, 0); + Tk := scan(); + xeqsign(); + y[SVALUE] := constval(); + if (Tk \= COMMA) leave; + Tk := scan(); + end + xsemi(); +end + +stcdecl(glob) do var y, i; + Tk := scan(); + xsymbol(); + y := add(Str, glob|CNST, 0); + Tk := scan(); + xeqsign(); + i := 0; + while (1) do + xsymbol(); + add(Str, glob|CNST, i); + i := i+1; + Tk := scan(); + if (Tk \= COMMA) leave; + Tk := scan(); + end + y[SVALUE] := i; + xsemi(); +end + +fwddecl() do var y, n; + Tk := scan(); + while (1) do + xsymbol(); + y := add(Str, GLOBF|FORW, 0); + Tk := scan(); + xlparen(); + n := constval(); + if (n < 0) aw("invalid arity", 0); + y[SFLAGS] := y[SFLAGS] | (n << 8); + xrparen(); + if (Tk \= COMMA) leave; + Tk := scan(); + end + xsemi(); +end + +resolve_fwd(loc, fn) do var nloc; + while (loc \= 0) do + nloc := tfetch(loc); + tpatch(loc, fn-loc-BPW); + loc := nloc; + end +end + +decl compound(0), stmt(0); + +fundecl() do + var l_base, l_addr; + var i, na, oyp, onp; + var y; + + l_addr := 2*BPW; + na := 0; + gen(CG_JUMPFWD, 0); + y := add(Str, GLOBF|FUNC, Tp); + Tk := scan(); + xlparen(); + oyp := Yp; + onp := Np; + l_base := Yp; + while (Tk = SYMBOL) do + add(Str, 0, l_addr); + l_addr := l_addr + BPW; + na := na+1; + Tk := scan(); + if (Tk \= COMMA) leave; + Tk := scan(); + end + for (i = l_base, Yp, SYM) do + Syms[i+SVALUE] := 12+na*BPW - Syms[i+SVALUE]; + end + if (y[SFLAGS] & FORW) do + resolve_fwd(y[SVALUE], Tp); + if (na \= y[SFLAGS] >> 8) + aw("function does not match DECL", y[SNAME]); + y[SFLAGS] := y[SFLAGS] & ~FORW; + y[SFLAGS] := y[SFLAGS] | FUNC; + y[SVALUE] := Tp; + end + xrparen(); + y[SFLAGS] := y[SFLAGS] | (na << 8); + gen(CG_ENTER, 0); + Fun := 1; + stmt(); + Fun := 0; + gen(CG_CLEAR, 0); + gen(CG_EXIT, 0); + gen(CG_RESOLV, 0); + Yp := oyp; + Np := onp; + Lp := 0; +end + +declaration(glob) + ie (Tk = KVAR) + vardecl(glob); + else ie (Tk = KCONST) + constdecl(glob); + else ie (Tk = KSTRUCT) + stcdecl(glob); + else ie (Tk = KDECL) + fwddecl(); + else + fundecl(); + +decl expr(1); + +fncall(fn) do var i; + Tk := scan(); + if (fn = 0) aw("call of non-function", 0); + if (fn[SFLAGS] & (FUNC|FORW) = 0) + aw("call of non-function", fn[SNAME]); + i := 0; + while (Tk \= RPAREN) do + expr(0); + i := i+1; + if (Tk \= COMMA) leave; + Tk := scan(); + if (Tk = RPAREN) + aw("syntax error", Str); + end + if (i \= fn[SFLAGS] >> 8) + aw("wrong number of arguments", fn[SNAME]); + expect(RPAREN, "')'"); + Tk := scan(); + if (active()) + spill(); + ie (fn[SFLAGS] & FORW) do + gen(CG_CALL, fn[SVALUE]); + fn[SVALUE] := Tp-BPW; + end + else do + gen(CG_CALL, fn[SVALUE]-Tp-5); ! TP-BPW+1 + end + if (i \= 0) gen(CG_DEALLOC, i*BPW); + activate(); +end + +mkstring(s) do var i, a, k; + a := Dp; + k := str_length(s); + for (i=0, k+1) + data(s::i); + while (Dp mod BPW \= 0) + data(0); + return a; +end + +mkbytevec() do var a, k; + Tk := scan(); + expect(LBRACK, "'['"); + Tk := scan(); + a := Dp; + k := 0; + while (1) do + expect(INTEGER, "cvalue"); + if (Val > 255 \/ Val < 0) + aw("byte vector member out of range", Str); + data(Val); + Tk := scan(); + if (Tk \= COMMA) leave; + Tk := scan(); + end + expect(RBRACK, "']'"); + Tk := scan(); + while (Dp mod BPW \= 0) + data(0); + return a; +end + +mktable() do + var n, i, a; + var tbl[MAXTBL], af[MAXTBL]; + var dynamic; + + Tk := scan(); + dynamic := 0; + n := 0; + while (Tk \= RBRACK) do + if (n >= MAXTBL) + aw("table too big", 0); + ie (Tk = LPAREN /\ \dynamic) do + Tk := scan(); + dynamic := 1; + loop; + end + else ie (dynamic) do + expr(1); + gen(CG_STGLOB, 0); + tbl[n] := 0; + af[n] := Tp-BPW; + n := n+1; + if (Tk = RPAREN) do + Tk := scan(); + dynamic := 0; + end + end + else ie (Tk = INTEGER \/ Tk = SYMBOL) do + tbl[n] := constval(); + af[n] := 0; + n := n+1; + end + else ie (Tk = STRING) do + tbl[n] := mkstring(Str); + af[n] := 1; + n := n+1; + Tk := scan(); + end + else ie (Tk = LBRACK) do + tbl[n] := mktable(); + af[n] := 1; + n := n+1; + end + else ie (Tk = KPACKED) do + tbl[n] := mkbytevec(); + af[n] := 1; + n := n+1; + end + else do + aw("invalid table element", Str); + end + if (Tk \= COMMA) leave; + Tk := scan(); + if (Tk = RBRACK) + aw("syntax error", Str); + end + if (dynamic) + aw("missing ')' in dynamic table", 0); + expect(RBRACK, "']'"); + if (n = 0) aw("empty table", 0); + Tk := scan(); + a := Dp; + for (i=0, n) do + dataw(tbl[i]); + ie (af[i] = 1) do + tag('d'); + end + else if (af[i] > 1) do + tpatch(af[i], Dp-4); + end + end + return a; +end + +load(y) ie (y[SFLAGS] & GLOBF) + gen(CG_LDGLOB, y[SVALUE]); + else + gen(CG_LDLOCL, y[SVALUE]); + +store(y) + ie (y[SFLAGS] & GLOBF) + gen(CG_STGLOB, y[SVALUE]); + else + gen(CG_STLOCL, y[SVALUE]); + +decl factor(0); + +address(lv, bp) do var y; + y := lookup(Str, 0); + Tk := scan(); + ie (y[SFLAGS] & CNST) do + if (lv > 0) aw("invalid location", y[SNAME]); + spill(); + gen(CG_LDVAL, y[SVALUE]); + end + else ie (y[SFLAGS] & (FUNC|FORW)) do + if (lv = 2) aw("invalid location", y[SNAME]); + end + else if (lv = 0 \/ Tk = LBRACK \/ Tk = BYTEOP) do + spill(); + load(y); + end + if (Tk = LBRACK \/ Tk = BYTEOP) + if (y[SFLAGS] & (FUNC|FORW|CNST)) + aw("bad subscript", y[SNAME]); + while (Tk = LBRACK) do + Tk := scan(); + bp[0] := 0; + expr(0); + expect(RBRACK, "']'"); + Tk := scan(); + y := 0; + gen(CG_INDEX, 0); + if (lv = 0 \/ Tk = LBRACK \/ Tk = BYTEOP) + gen(CG_DEREF, 0); + end + if (Tk = BYTEOP) do + Tk := scan(); + bp[0] := 1; + factor(); + y := 0; + gen(CG_INDXB, 0); + if (lv = 0) gen(CG_DREFB, 0); + end + return y; +end + +factor() do var y, op, b; + ie (Tk = INTEGER) do + spill(); + gen(CG_LDVAL, Val); + Tk := scan(); + end + else ie (Tk = SYMBOL) do + y := address(0, @b); + if (Tk = LPAREN) fncall(y); + end + else ie (Tk = STRING) do + spill(); + gen(CG_LDADDR, mkstring(Str)); + Tk := scan(); + end + else ie (Tk = LBRACK) do + spill(); + gen(CG_LDADDR, mktable()); + end + else ie (Tk = KPACKED) do + spill(); + gen(CG_LDADDR, mkbytevec()); + end + else ie (Tk = ADDROF) do + Tk := scan(); + y := address(2, @b); + ie (y = 0) do + ; + end + else ie (y[SFLAGS] & GLOBF) do + spill(); + gen(CG_LDADDR, y[SVALUE]); + end + else do + spill(); + gen(CG_LDLREF, y[SVALUE]); + end + end + else ie (Tk = BINOP) do + if (Oid \= Minus_op) + aw("syntax error", Str); + Tk := scan(); + factor(); + gen(CG_NEG, 0); + end + else ie (Tk = UNOP) do + op := Oid; + Tk := scan(); + factor(); + gen(Ops[op][OCODE], 0); + end + else ie (Tk = LPAREN) do + Tk := scan(); + expr(0); + xrparen(); + end + else do + aw("syntax error", Str); + end +end + +emitop(stk, p) do + gen(Ops[stk[p-1]][OCODE], 0); + return p-1; +end + +arith() do var stk[10], p; + factor(); + p := 0; + while (Tk = BINOP) do + while (p /\ Ops[Oid][OPREC] <= Ops[stk[p-1]][OPREC]) + p := emitop(stk, p); + stk[p] := Oid; + p := p+1; + Tk := scan(); + factor(); + end + while (p > 0) + p := emitop(stk, p); +end + +conjn() do var n; + arith(); + n := 0; + while (Tk = CONJ) do + Tk := scan(); + gen(CG_JMPFALSE, 0); + clear(); + arith(); + n := n+1; + end + while (n > 0) do + gen(CG_RESOLV, 0); + n := n-1; + end +end + +disjn() do var n; + conjn(); + n := 0; + while (Tk = DISJ) do + Tk := scan(); + gen(CG_JMPTRUE, 0); + clear(); + conjn(); + n := n+1; + end + while (n > 0) do + gen(CG_RESOLV, 0); + n := n-1; + end +end + +expr(clr) do + if (clr) clear(); + disjn(); + if (Tk = COND) do + Tk := scan(); + gen(CG_JMPFALSE, 0); + expr(1); + expect(COLON, "':'"); + Tk := scan(); + gen(CG_JUMPFWD, 0); + swap(); + gen(CG_RESOLV, 0); + expr(1); + gen(CG_RESOLV, 0); + end +end + +halt_stmt() do + Tk := scan(); + gen(CG_HALT, constval()); + xsemi(); +end + +return_stmt() do + Tk := scan(); + if (Fun = 0) + aw("can't return from main body", 0); + ie (Tk = SEMI) + gen(CG_CLEAR, 0); + else + expr(1); + if (Lp \= 0) do + gen(CG_DEALLOC, -Lp); + end + gen(CG_EXIT, 0); + xsemi(); +end + +if_stmt(alt) do + Tk := scan(); + xlparen(); + expr(1); + gen(CG_JMPFALSE, 0); + xrparen(); + stmt(); + if (alt) do + gen(CG_JUMPFWD, 0); + swap(); + gen(CG_RESOLV, 0); + expect(KELSE, "ELSE"); + Tk := scan(); + stmt(); + end + gen(CG_RESOLV, 0); +end + +while_stmt() do var olp, olv; + Tk := scan(); + olp := Loop0; + olv := Lvp; + gen(CG_MARK, 0); + Loop0 := tos(); + xlparen(); + expr(1); + xrparen(); + gen(CG_JMPFALSE, 0); + stmt(); + swap(); + gen(CG_JUMPBACK, 0); + gen(CG_RESOLV, 0); + while (Lvp > olv) do + push(Leaves[Lvp-1]); + gen(CG_RESOLV, 0); + Lvp := Lvp-1; + end + Loop0 := olp; +end + +for_stmt() do + var y; + var step; + var oll, olp, olv; + var test; + + Tk := scan(); + oll := Llp; + olv := Lvp; + olp := Loop0; + Loop0 := 0; + xlparen(); + xsymbol(); + y := lookup(Str, 0); + if (y[SFLAGS] & (CNST|FUNC|FORW)) + aw("unexpected type", y[SNAME]); + Tk := scan(); + xeqsign(); + expr(1); + store(y); + expect(COMMA, "','"); + Tk := scan(); + gen(CG_MARK, 0); + test := tos(); + load(y); + expr(0); + ie (Tk = COMMA) do + Tk := scan(); + step := constval(); + end + else do + step := 1; + end + gen(step<0-> CG_FORDOWN: CG_FOR, 0); + xrparen(); + stmt(); + while (Llp > oll) do + push(Loops[Llp-1]); + gen(CG_RESOLV, 0); + Llp := Llp-1; + end + ie (y[SFLAGS] & GLOBF) + gen(CG_INCGLOB, y[SVALUE]); + else + gen(CG_INCLOCL, y[SVALUE]); + gen(CG_WORD, step); + swap(); + gen(CG_JUMPBACK, 0); + gen(CG_RESOLV, 0); + while (Lvp > olv) do + push(Leaves[Lvp-1]); + gen(CG_RESOLV, 0); + Lvp := Lvp-1; + end + Loop0 := olp; +end + +leave_stmt() do + Tk := scan(); + if (Loop0 < 0) + aw("LEAVE not in loop context", 0); + xsemi(); + if (Lvp >= MAXLOOP) + aw("too many LEAVEs", 0); + gen(CG_JUMPFWD, 0); + Leaves[Lvp] := pop(); + Lvp := Lvp+1; +end + +loop_stmt() do + Tk := scan(); + if (Loop0 < 0) + aw("LOOP not in loop context", 0); + xsemi(); + ie (Loop0 > 0) do + push(Loop0); + gen(CG_JUMPBACK, 0); + end + else do + if (Llp >= MAXLOOP) + aw("too many LOOPs", 0); + gen(CG_JUMPFWD, 0); + Loops[Llp] := pop(); + Llp := Llp+1; + end +end + +asg_or_call() do var y, b; + clear(); + y := address(1, @b); + ie (Tk = LPAREN) do + fncall(y); + end + else ie (Tk = ASSIGN) do + Tk := scan(); + expr(0); + ie (y = 0) + gen(b-> CG_STINDB: CG_STINDR, 0); + else ie (y[SFLAGS] & (FUNC|FORW|CNST|VECT)) + aw("bad location", y[SNAME]); + else + store(y); + end + else do + aw("syntax error", Str); + end + xsemi(); +end + +stmt() ie (Tk = KFOR) + for_stmt(); + else ie (Tk = KHALT) + halt_stmt(); + else ie (Tk = KIE) + if_stmt(1); + else ie (Tk = KIF) + if_stmt(0); + else ie (Tk = KELSE) + aw("ELSE without IE", 0); + else ie (Tk = KLEAVE) + leave_stmt(); + else ie (Tk = KLOOP) + loop_stmt(); + else ie (Tk = KRETURN) + return_stmt(); + else ie (Tk = KWHILE) + while_stmt(); + else ie (Tk = KDO) + compound(); + else ie (Tk = SYMBOL) + asg_or_call(); + else ie (Tk = SEMI) + Tk := scan(); + else + expect(%1, "statement"); + +compound() do var oyp, olp, onp; + Tk := scan(); + oyp := Yp; + onp := Np; + olp := Lp; + while (Tk = KVAR \/ Tk = KCONST \/ Tk = KSTRUCT) + declaration(0); + while (Tk \= KEND) + stmt(); + Tk := scan(); + if (olp-Lp \= 0) + gen(CG_DEALLOC, olp-Lp); + Yp := oyp; + Np := onp; + Lp := olp; +end + +checkclass() + if (\str_equal(Str, "t3x")) + aw("class name must be T3X", Str); + +module_decl() do + Tk := scan(); + xsymbol(); + Tk := scan(); + xlparen(); + xsymbol(); + checkclass(); + Tk := scan(); + xrparen(); + xsemi(); +end + +object_decl() do + Tk := scan(); + xsymbol(); + if (\str_equal(Str, "t")) + aw("object name must be T", Str); + Tk := scan(); + expect(LBRACK, "'['"); + Tk := scan(); + expect(SYMBOL, "symbol"); + checkclass(); + Tk := scan(); + expect(RBRACK, "']'"); + Tk := scan(); + xsemi(); +end + +program() do var i; + Tk := scan(); + if (Tk = KMODULE) module_decl(); + if (Tk = KOBJECT) object_decl(); + while ( Tk = KVAR \/ Tk = KCONST \/ Tk = SYMBOL \/ + Tk = KDECL \/ Tk = KSTRUCT + ) + declaration(GLOBF); + if (Tk \= KDO) + aw("DO or declaration expected", 0); + gen(CG_ENTER, 0); + compound(); + if (Tk \= ENDFILE) + aw("trailing characters", Str); + gen(CG_HALT, 0); + for (i=0, Yp, SYM) + if (Syms[i+SFLAGS] & FORW /\ Syms[i+SVALUE]) + aw("undefined function", Syms[i+SNAME]); +end + +! +! Main +! + +init() do + var i; + var tcomp, tcopy, tfill, tscan; + var tcreate, topen, tclose, tread, twrite; + var trename, tremove; + + Rp := 0; + Tp := 0; + Dp := 0; + Lp := 0; + Sp := 0; + Yp := 0; + Np := 0; + Pp := 0; + Hp := 0; + Line := 1; + Acc := 0; + Fun := 0; + Loop0 := %1; + Lvp := 0; + Llp := 0; + Codetbl := [ + [ CG_PUSH, "00" ], + [ CG_CLEAR, "01" ], + [ CG_LDVAL, "02,w" ], + [ CG_LDADDR, "03,a" ], + [ CG_LDLREF, "04,w" ], + [ CG_LDGLOB, "05,a" ], + [ CG_LDLOCL, "06,w" ], + [ CG_STGLOB, "07,a" ], + [ CG_STLOCL, "08,w" ], + [ CG_STINDR, "09" ], + [ CG_STINDB, "0a" ], + [ CG_INCGLOB, "0b,a" ], + [ CG_INCLOCL, "0c,w" ], + [ CG_ALLOC, "0d,w" ], + [ CG_DEALLOC, "0e,w" ], + [ CG_LOCLVEC, "0f" ], + [ CG_GLOBVEC, "10,a" ], + [ CG_INDEX, "11" ], + [ CG_DEREF, "12" ], + [ CG_INDXB, "13" ], + [ CG_DREFB, "14" ], + [ CG_MARK, ",m" ], + [ CG_RESOLV, ",r" ], + [ CG_CALL, "17,W" ], + [ CG_JUMPFWD, "18,>" ], + [ CG_JUMPBACK, "19,<" ], + [ CG_JMPFALSE, "1a,>" ], + [ CG_JMPTRUE, "1b,>" ], + [ CG_FOR, "1c,>" ], + [ CG_FORDOWN, "1d,>" ], + [ CG_ENTER, "1e" ], + [ CG_EXIT, "1f" ], + [ CG_HALT, "20,w" ], + [ CG_NEG, "21" ], + [ CG_INV, "22" ], + [ CG_LOGNOT, "23" ], + [ CG_ADD, "24" ], + [ CG_SUB, "25" ], + [ CG_MUL, "26" ], + [ CG_DIV, "27" ], + [ CG_MOD, "28" ], + [ CG_AND, "29" ], + [ CG_OR, "2a" ], + [ CG_XOR, "2b" ], + [ CG_SHL, "2c" ], + [ CG_SHR, "2d" ], + [ CG_EQ, "2e" ], + [ CG_NEQ, "2f" ], + [ CG_LT, "30" ], + [ CG_GT, "31" ], + [ CG_LE, "32" ], + [ CG_GE, "33" ], + [ CG_WORD, ",W" ], + [ %1, "" ] ]; + tcomp := "3500"; + tcopy := "3501"; + tfill := "3502"; + tscan := "3503"; + tcreate := "3504"; + topen := "3505"; + tclose := "3506"; + tread := "3507"; + twrite := "3508"; + trename := "3509"; + tremove := "350a"; + Ops := [[ 7, 3, "mod", BINOP, CG_MOD ], + [ 6, 1, "+", BINOP, CG_ADD ], + [ 7, 1, "*", BINOP, CG_MUL ], + [ 0, 1, ";", SEMI, 0 ], + [ 0, 1, ",", COMMA, 0 ], + [ 0, 1, "(", LPAREN, 0 ], + [ 0, 1, ")", RPAREN, 0 ], + [ 0, 1, "[", LBRACK, 0 ], + [ 0, 1, "]", RBRACK, 0 ], + [ 3, 1, "=", BINOP, CG_EQ ], + [ 5, 1, "&", BINOP, CG_AND ], + [ 5, 1, "|", BINOP, CG_OR ], + [ 5, 1, "^", BINOP, CG_XOR ], + [ 0, 1, "@", ADDROF, 0 ], + [ 0, 1, "~", UNOP, CG_INV ], + [ 0, 1, ":", COLON, 0 ], + [ 0, 2, "::", BYTEOP, 0 ], + [ 0, 2, ":=", ASSIGN, 0 ], + [ 0, 1, "\\", UNOP, CG_LOGNOT ], + [ 1, 2, "\\/", DISJ, 0 ], + [ 3, 2, "\\=", BINOP, CG_NEQ ], + [ 4, 1, "<", BINOP, CG_LT ], + [ 4, 2, "<=", BINOP, CG_LE ], + [ 5, 2, "<<", BINOP, CG_SHL ], + [ 4, 1, ">", BINOP, CG_GT ], + [ 4, 2, ">=", BINOP, CG_GE ], + [ 5, 2, ">>", BINOP, CG_SHR ], + [ 6, 1, "-", BINOP, CG_SUB ], + [ 0, 2, "->", COND, 0 ], + [ 7, 1, "/", BINOP, CG_DIV ], + [ 2, 2, "/\\", CONJ, 0 ], + [ 0, 0, 0, 0, 0 ] ]; + Equal_op := findop("="); + Minus_op := findop("-"); + Mul_op := findop("*"); + Add_op := findop("+"); + i := 0; + while (Codetbl[i][0] \= %1) do + if (Codetbl[i][0] \= i) + oops("bad code table entry", ntoa(i)); + i := i+1; + end + builtin("t.memcomp", 3, tcomp); + builtin("t.memcopy", 3, tcopy); + builtin("t.memfill", 3, tfill); + builtin("t.memscan", 3, tscan); + builtin("t.create", 1, tcreate); + builtin("t.open", 2, topen); + builtin("t.close", 1, tclose); + builtin("t.read", 3, tread); + builtin("t.write", 3, twrite); + builtin("t.rename", 2, trename); + builtin("t.remove", 1, tremove); +end + +do + init(); + readprog(); + program(); + Tp := align(Tp, 4); + relocate(); + tcode_header(); + t.write(1, Header, Hp); + t.write(1, Text_seg, Tp); + t.write(1, Data_seg, Dp); +end diff --git a/t3x9r3-extended/t.c b/t3x9r3-extended/t.c new file mode 100644 index 0000000..1de1f19 --- /dev/null +++ b/t3x9r3-extended/t.c @@ -0,0 +1,1616 @@ +/* + * T3X9r2 -> ELF-FreeBSD-386 compiler + * Nils M Holm, 2017, CC0 license + * https://creativecommons.org/publicdomain/zero/1.0/ + */ + +#include +#include +#include +#include + +#define BPW 4 + +#define PROG_SIZE 0x10000 + +#define TEXT_VADDR 0x08048000 +#define DATA_VADDR 0x08058000 + +#define TEXT_SIZE 0x10000 +#define DATA_SIZE 0x10000 + +#define NRELOC 10000 + +#define STACK_SIZE 100 + +#define SYMTBL_SIZE 1000 +#define NLIST_SIZE 10000 + +#define byte unsigned char +#define word unsigned int + +int Stk[STACK_SIZE], Sp = 0; + +int Line = 1; + +void aw(char *m, char *s) { + fprintf(stderr, "t3x9: %d: %s", Line, m); + if (s != NULL) + fprintf(stderr, ": %s", s); + fputc('\n', stderr); + exit(1); +} + +void oops(char *m, char *s) { + fprintf(stderr, "t3x9: internal error\n"); + aw(m, s); +} + +void push(int x) { + if (Sp >= STACK_SIZE) + aw("too many nesting levels", NULL); + Stk[Sp++] = x; +} + +int tos(void) { + return Stk[Sp-1]; +} + +int pop(void) { + if (Sp < 1) + oops("stack underflow", NULL); + return Stk[--Sp]; +} + +void swap(void) { + int t; + + if (Sp < 2) + oops("stack underflow", NULL); + t = Stk[Sp-1]; + Stk[Sp-1] = Stk[Sp-2]; + Stk[Sp-2] = t; +} + +/* + * Symbol table + */ + +struct _symbol { + char *name; + int flags; + int value; +}; + +#define sym struct _symbol + +#define GLOBF 1 +#define CNST 2 +#define VECT 4 +#define DECL 8 +#define FUNC 16 + +sym Sym[SYMTBL_SIZE]; +char Nlist[NLIST_SIZE]; + +int Yp = 0, Np = 0; + +sym *find(char *s) { + int i; + + for (i=Yp-1; i>=0; i--) { + if (!strcmp(Sym[i].name, s)) + return &Sym[i]; + } + return NULL; +} + +sym *lookup(char *s, int f) { + sym *y; + + y = find(s); + if (NULL == y) + aw("undefined", s); + if ((y->flags & f) != f) + aw("unexpected type", s); + return y; +} + +sym *add(char *s, int f, int v) { + sym *y; + + y = find(s); + if (y != NULL && (y->flags & GLOBF) == (f & GLOBF)) { + if (y->flags & DECL && f & FUNC) + return y; + else + aw("redefined", s); + } + if (Yp >= SYMTBL_SIZE) + aw("too many symbols", NULL); + Sym[Yp].name = strdup(s); + Sym[Yp].flags = f; + Sym[Yp].value = v; + Yp++; + return &Sym[Yp-1]; +} + +/* + * Emitter + */ + +#define HEADER_SIZE 0x74 +#define PAGE_SIZE 0x1000 + +struct _reloc { + int addr; + int seg; +}; + +#define reloc struct _reloc + +reloc Rel[NRELOC]; + +byte Text[TEXT_SIZE]; +byte Data[DATA_SIZE]; + +int Rp = 0, Tp = 0, Dp = 0, Lp = 0; + +int Loaded = 0; + +#define CG_INIT "89e5" +#define CG_PUSH "50" +#define CG_LDVAL "b8,w" +#define CG_LDADDR "b8,a" +#define CG_LDLREF "8d85,w" +#define CG_LDGLOB "a1,a" +#define CG_LDLOCL "8b85,w" +#define CG_CLEAR "31c0" +#define CG_STGLOB "a3,a" +#define CG_STLOCL "8985,w" +#define CG_STINDR "5b8903" +#define CG_STINDB "5b8803" +#define CG_ALLOC "81ec,w" +#define CG_DEALLOC "81c4,w" +#define CG_LOCLVEC "89e050" +#define CG_GLOBVEC "8925,a" +#define CG_HALT "68,w5031c040cd80" +#define CG_INDEX "c1e0025b01d8" +#define CG_DEREF "8b00" +#define CG_INDXB "5b01d8" +#define CG_DREFB "89c331c08a03" +#define CG_CALL "e8,w" +#define CG_MARK ",m" +#define CG_JUMPFWD "e9,>" +#define CG_JUMPBACK "e9,<" +#define CG_ENTER "5589e5" +#define CG_EXIT "5dc3" +#define CG_RESOLV ",r" +#define CG_NEG "f7d8" +#define CG_INV "f7d0" +#define CG_LOGNOT "f7d819c0f7d0" +#define CG_ADD "5b01d8" +#define CG_SUB "89c35829d8" +#define CG_MUL "5bf7e3" +#define CG_DIV "89c35899f7fb" +#define CG_MOD "89c35899f7fb89d0" +#define CG_AND "5b21d8" +#define CG_OR "5b09d8" +#define CG_XOR "5b31d8" +#define CG_SHL "89c158d3e0" +#define CG_SHR "89c158d3e8" +#define CG_EQ "5b39c30f95c20fb6c248" +#define CG_NEQ "5b39c30f94c20fb6c248" +#define CG_LT "5b39c30f9dc20fb6c248" +#define CG_GT "5b39c30f9ec20fb6c248" +#define CG_LE "5b39c30f9fc20fb6c248" +#define CG_GE "5b39c30f9cc20fb6c248" +#define CG_JMPFALSE "09c00f84,>" +#define CG_JMPTRUE "09c00f85,>" +#define CG_FOR "5b39c30f8d,>" +#define CG_FORDOWN "5b39c30f8e,>" +#define CG_INCGLOB "8105,w" +#define CG_INCLOCL "8185,w" +#define CG_WORD ",w" + +#define CG_P_READ \ + "8b4424048744240c89442404b803000000cd800f830300000031c048c3" +#define CG_P_WRITE \ + "8b4424048744240c89442404b804000000cd800f830300000031c048c3" +#define CG_P_MEMCOMP \ + "8b74240c8b7c24088b4c240441fcf3a609c90f850300000031c0c38a46ff2a47ff66986699c3" +#define CG_P_MEMCOPY \ + "8b7c240c8b7424088b4c2404fcf3a4c3" +#define CG_P_MEMFILL \ + "8b7c240c8b4424088b4c2404fcf3aac3" +#define CG_P_MEMSCAN \ + "8b7c240c8b4424088b4c24044189fafcf2ae09c90f840600000089f829d048c331c048c3" + +void gen(char *s, int v); + +void spill(void) { + if (Loaded) + gen(CG_PUSH, 0); + else + Loaded = 1; +} + +int loaded(void) { + return Loaded; +} + +void clear(void) { + Loaded = 0; +} + +int hex(int c) { + if (isdigit(c)) + return c-'0'; + else + return c-'a'+10; +} + +void emit(int x) { + Text[Tp++] = (byte) x; +} + +void emitw(int x) { + emit(255&x); + emit(255&x>>8); + emit(255&x>>16); + emit(255&x>>24); +} + +void tpatch(int a, int x) { + Text[a] = 255&x; + Text[a+1] = 255&x>>8; + Text[a+2] = 255&x>>16; + Text[a+3] = 255&x>>24; +} + +int tfetch(int a) { + return Text[a] | (Text[a+1]<<8) | (Text[a+2]<<16) | (Text[a+3]<<24); +} + +void data(int x) { + Data[Dp++] = (byte) x; +} + +void dataw(int x) { + data(255&x); + data(255&x>>8); + data(255&x>>16); + data(255&x>>24); +} + +void dpatch(int a, int x) { + Data[a] = 255&x; + Data[a+1] = 255&x>>8; + Data[a+2] = 255&x>>16; + Data[a+3] = 255&x>>24; +} + +int dfetch(int a) { + return Data[a] | (Data[a+1]<<8) | (Data[a+2]<<16) | (Data[a+3]<<24); +} + +void tag(int seg) { + if (Rp >= NRELOC) + oops("relocation buffer overflow", NULL); + Rel[Rp].seg = seg; + Rel[Rp].addr = 't' == seg? Tp-BPW: Dp-BPW; + Rp++; +} + +void resolve(void) { + int i, a, dist; + + dist = DATA_VADDR + (HEADER_SIZE + Tp) % PAGE_SIZE; + for (i=0; i' == s[1]) { + push(Tp); + emitw(0); + } + else if ('<' == s[1]) { + emitw(pop()-Tp-BPW); + } + else if ('r' == s[1]) { + x = pop(); + tpatch(x, Tp-x-BPW); + } + else { + oops("bad code", NULL); + } + } + else { + emit(hex(*s)*16+hex(s[1])); + } + s += 2; + } +} + +void builtin(char *name, int arity, char *code) { + gen(CG_JUMPFWD, 0); + add(name, GLOBF|FUNC | (arity << 8), Tp); + gen(code, 0); + gen(CG_RESOLV, 0); +} + +int align(int x, int a) { + return (x+a) & ~(a-1); +} + +void hexwrite(char *b) { + while (*b) { + fputc(16*hex(*b)+hex(b[1]), stdout); + b += 2; + } +} + +void lewrite(int x) { + fputc(x & 0xff, stdout); + fputc(x>>8 & 0xff, stdout); + fputc(x>>16 & 0xff, stdout); + fputc(x>>24 & 0xff, stdout); +} + +void elfheader(void) { + hexwrite("7f454c46"); /* magic */ + hexwrite("01"); /* 32-bit */ + hexwrite("01"); /* little endian */ + hexwrite("01"); /* header version */ + hexwrite("09"); /* FreeBSD ABI */ + hexwrite("0000000000000000"); /* padding */ + hexwrite("0200"); /* executable */ + hexwrite("0300"); /* 386 */ + lewrite(1); /* version */ + lewrite(TEXT_VADDR+HEADER_SIZE);/* initial entry point */ + lewrite(0x34); /* program header offset */ + lewrite(0); /* no header segments */ + lewrite(0); /* flags */ + hexwrite("3400"); /* header size */ + hexwrite("2000"); /* program header size */ + hexwrite("0200"); /* number of program headers */ + hexwrite("2800"); /* segment header size (unused) */ + hexwrite("0000"); /* number of segment headers */ + hexwrite("0000"); /* string index (unused) */ + lewrite(0x01); /* loadable segment */ + lewrite(HEADER_SIZE); /* offset in file */ + lewrite(TEXT_VADDR); /* virtual load address */ + lewrite(TEXT_VADDR); /* physical load address */ + lewrite(Tp); /* size in file */ + lewrite(Tp); /* size in memory */ + lewrite(0x05); /* flags = read, execute */ + lewrite(PAGE_SIZE); /* alignment (page) */ + lewrite(0x01); /* loadable segment */ + lewrite(HEADER_SIZE+Tp); /* offset in file */ + lewrite(DATA_VADDR); /* virtual load address */ + lewrite(DATA_VADDR); /* physical load address */ + lewrite(Dp); /* size in file */ + lewrite(Dp); /* size in memory */ + lewrite(0x06); /* flags = read, write */ + lewrite(PAGE_SIZE); /* alignment (page) */ +} + +/* + * Scanner + */ + +char Prog[PROG_SIZE]; + +int Pp = 0, Psize; + +void readprog(void) { + Psize = fread(Prog, 1, PROG_SIZE, stdin); + if (Psize >= PROG_SIZE) + aw("program too big", NULL); +} + +int readrc(void) { + return Pp >= Psize? EOF: Prog[Pp++]; +} + +int readc(void) { + return Pp >= Psize? EOF: tolower(Prog[Pp++]); +} + +#define META 256 + +int readec(void) { + int c; + + c = readrc(); + if (c != '\\') + return c; + c = readc(); + if ('a' == c) return '\a'; + if ('b' == c) return '\b'; + if ('e' == c) return '\033'; + if ('f' == c) return '\f'; + if ('n' == c) return '\n'; + if ('q' == c) return '"' | META; + if ('r' == c) return '\r'; + if ('s' == c) return ' '; + if ('t' == c) return '\t'; + if ('v' == c) return '\v'; + return c; +} + +void reject(void) { + Pp--; +} + +#define TOKEN_LEN 128 + +int T; +char Str[TOKEN_LEN]; +int Val; +int Oid; + +int Equal_op, Minus_op, Mul_op, Add_op; + +struct _oper { + int prec; + int len; + char *name; + int tok; + char *code; +}; + +#define oper struct _oper + +enum { ENDFILE = -1, + SYMBOL = 100, INTEGER, STRING, + ADDROF = 200, ASSIGN, BINOP, BYTEOP, COLON, COMMA, COND, + CONJ, DISJ, LBRACK, LPAREN, RBRACK, RPAREN, SEMI, UNOP, + KCONST, KDECL, KDO, KELSE, KEND, KFOR, KHALT, KIE, KIF, + KLEAVE, KLOOP, KMODULE, KOBJECT, KRETURN, KSTRUCT, KVAR, + KWHILE +}; + +oper Ops[] = { + { 7, 3, "mod", BINOP, CG_MOD }, + { 6, 1, "+", BINOP, CG_ADD }, + { 7, 1, "*", BINOP, CG_MUL }, + { 0, 1, ";", SEMI, NULL }, + { 0, 1, ",", COMMA, NULL }, + { 0, 1, "(", LPAREN, NULL }, + { 0, 1, ")", RPAREN, NULL }, + { 0, 1, "[", LBRACK, NULL }, + { 0, 1, "]", RBRACK, NULL }, + { 3, 1, "=", BINOP, CG_EQ }, + { 5, 1, "&", BINOP, CG_AND }, + { 5, 1, "|", BINOP, CG_OR }, + { 5, 1, "^", BINOP, CG_XOR }, + { 0, 1, "@", ADDROF, NULL }, + { 0, 1, "~", UNOP, CG_INV }, + { 0, 1, ":", COLON, NULL }, + { 0, 2, "::", BYTEOP, NULL }, + { 0, 2, ":=", ASSIGN, NULL }, + { 0, 1, "\\", UNOP, CG_LOGNOT }, + { 1, 2, "\\/", DISJ, NULL }, + { 3, 2, "\\=", BINOP, CG_NEQ }, + { 4, 1, "<", BINOP, CG_LT }, + { 4, 2, "<=", BINOP, CG_LE }, + { 5, 2, "<<", BINOP, CG_SHL }, + { 4, 1, ">", BINOP, CG_GT }, + { 4, 2, ">=", BINOP, CG_GE }, + { 5, 2, ">>", BINOP, CG_SHR }, + { 6, 1, "-", BINOP, CG_SUB }, + { 0, 2, "->", COND, NULL }, + { 7, 1, "/", BINOP, CG_DIV }, + { 2, 2, "/\\", CONJ, NULL }, + { 0, 0, NULL, 0, NULL } +}; + +int skip(void) { + int c; + + c = readc(); + for (;;) { + while (' ' == c || '\t' == c || '\n' == c || '\r' == c) { + if ('\n' == c) + Line++; + c = readc(); + } + if (c != '!') + return c; + while (c != '\n' && c != EOF) + c = readc(); + } +} + +int findkw(char *s) { + if ('c' == s[0]) { + if (!strcmp(s, "const")) return KCONST; + return 0; + } + if ('d' == s[0]) { + if (!strcmp(s, "do")) return KDO; + if (!strcmp(s, "decl")) return KDECL; + return 0; + } + if ('e' == s[0]) { + if (!strcmp(s, "else")) return KELSE; + if (!strcmp(s, "end")) return KEND; + return 0; + } + if ('f' == s[0]) { + if (!strcmp(s, "for")) return KFOR; + return 0; + } + if ('h' == s[0]) { + if (!strcmp(s, "halt")) return KHALT; + return 0; + } + if ('i' == s[0]) { + if (!strcmp(s, "if")) return KIF; + if (!strcmp(s, "ie")) return KIE; + return 0; + } + if ('l' == s[0]) { + if (!strcmp(s, "leave")) return KLEAVE; + if (!strcmp(s, "loop")) return KLOOP; + return 0; + } + if ('m' == s[0]) { + if (!strcmp(s, "mod")) return BINOP; + if (!strcmp(s, "module")) return KMODULE; + return 0; + } + if ('o' == s[0]) { + if (!strcmp(s, "object")) return KOBJECT; + return 0; + } + if ('r' == s[0]) { + if (!strcmp(s, "return")) return KRETURN; + return 0; + } + if ('s' == s[0]) { + if (!strcmp(s, "struct")) return KSTRUCT; + return 0; + } + if ('v' == s[0]) { + if (!strcmp(s, "var")) return KVAR; + return 0; + } + if ('w' == s[0]) { + if (!strcmp(s, "while")) return KWHILE; + return 0; + } + return 0; +} + +int scanop(int c) { + int i, j; + + i = 0; + j = 0; + Oid = -1; + while (Ops[i].len > 0) { + if (Ops[i].len > j) { + if (Ops[i].name[j] == c) { + Oid = i; + Str[j] = c; + c = readc(); + j++; + } + } + else { + break; + } + i++; + } + if (-1 == Oid) { + Str[j++] = c; + Str[j] = 0; + aw("unknown operator", Str); + } + Str[j] = 0; + reject(); + return Ops[Oid].tok; +} + +void findop(char *s) { + int i; + + i = 0; + while (Ops[i].len > 0) { + if (!strcmp(s, Ops[i].name)) { + Oid = i; + return; + } + i++; + } + oops("operator not found", s); +} + +int scan(void) { + int c, i, k, sgn, base; + + c = skip(); + if (EOF == c) { + strcpy(Str, "end of file"); + return ENDFILE; + } + if (isalpha(c) || '_' == c || '.' == c) { + i = 0; + while (isalpha(c) || '_' == c || '.' == c || isdigit(c)) { + if (i >= TOKEN_LEN-1) { + Str[i] = 0; + aw("symbol too long", Str); + } + Str[i++] = c; + c = readc(); + } + Str[i] = 0; + reject(); + if ((k = findkw(Str)) != 0) { + if (BINOP == k) + findop(Str); + return k; + } + return SYMBOL; + } + if (isdigit(c) || '%' == c) { + sgn = 1; + i = 0; + if ('%' == c) { + sgn = -1; + c = readc(); + Str[i++] = c; + if (!isdigit(c)) { + reject(); + return scanop('-'); + } + } + base = 10; + if ('0' == c) { + c = readc(); + if ('x' == c) { + base = 16; + c = readc(); + if (!isdigit(c) && (c < 'a' || c > 'f')) + aw("missing digits after '0x'", 0); + } + } + Val = 0; + while (isdigit(c)) { + if (i >= TOKEN_LEN-1) { + Str[i] = 0; + aw("integer too long", Str); + } + Str[i++] = c; + c = c >= 'a'? c-'a'+10: c-'0'; + Val = Val * base + c; + c = readc(); + } + Str[i] = 0; + reject(); + Val = Val * sgn; + return INTEGER; + } + if ('\'' == c) { + Val = readec(); + if (readc() != '\'') + aw("missing ''' in character", NULL); + return INTEGER; + } + if ('"' == c) { + i = 0; + c = readec(); + while (c != '"' && c != EOF) { + if (i >= TOKEN_LEN-1) { + Str[i] = 0; + aw("string too long", Str); + } + Str[i++] = c & (META-1); + c = readec(); + } + Str[i] = 0; + return STRING; + } + return scanop(c); +} + +/* + * Parser + */ + +#define MAXTBL 128 +#define MAXLOOP 100 + +int Fun = 0; +int Loop0 = -1; +int Leaves[MAXLOOP], Lvp = 0; +int Loops[MAXLOOP], Llp = 0; + +void expect(int t, char *s) { + char b[100]; + + if (t == T) + return; + sprintf(b, "%s expected", s); + aw(b, Str); +} + +void eqsign(void) { + if (T != BINOP || Oid != Equal_op) + expect(0, "'='"); + T = scan(); +} + +void semi(void) { + expect(SEMI, "';'"); + T = scan(); +} + +void xlparen(void) { + expect(LPAREN, "'('"); + T = scan(); +} + +void xrparen(void) { + expect(RPAREN, "')'"); + T = scan(); +} + +int constfac(void) { + int v; + sym *y; + + if (INTEGER == T) { + v = Val; + T = scan(); + return v; + } + if (SYMBOL == T) { + y = lookup(Str, CNST); + T = scan(); + return y->value; + } + aw("constant value expected", Str); + return 0; /*LINT*/ +} + +int constval(void) { + int v; + + v = constfac(); + if (BINOP == T && Mul_op == Oid) { + T = scan(); + v *= constfac(); + } + else if (BINOP == T && Add_op == Oid) { + T = scan(); + v += constfac(); + } + return v; +} + +void vardecl(int glob) { + sym *y; + int size; + + T = scan(); + while (1) { + expect(SYMBOL, "symbol"); + size = 1; + if (glob & GLOBF) + y = add(Str, glob, Dp); + else + y = add(Str, 0, Lp); + T = scan(); + if (LBRACK == T) { + T = scan(); + size = constval(); + if (size < 1) + aw("invalid size", NULL); + y->flags |= VECT; + expect(RBRACK, "']'"); + T = scan(); + } + else if (BYTEOP == T) { + T = scan(); + size = constval(); + if (size < 1) + aw("invalid size", NULL); + size = (size + BPW-1) / BPW; + y->flags |= VECT; + } + if (glob & GLOBF) { + if (y->flags & VECT) { + gen(CG_ALLOC, size*BPW); + gen(CG_GLOBVEC, Dp); + } + dataw(0); + } + else { + gen(CG_ALLOC, size*BPW); + Lp -= size*BPW; + if (y->flags & VECT) { + gen(CG_LOCLVEC, 0); + Lp -= BPW; + } + y->value = Lp; + } + if (T != COMMA) + break; + T = scan(); + } + semi(); +} + +void constdecl(int glob) { + sym *y; + + T = scan(); + while (1) { + expect(SYMBOL, "symbol"); + y = add(Str, glob|CNST, 0); + T = scan(); + eqsign(); + y->value = constval(); + if (T != COMMA) + break; + T = scan(); + } + semi(); +} + +void stcdecl(int glob) { + sym *y; + int i; + + T = scan(); + expect(SYMBOL, "symbol"); + y = add(Str, glob|CNST, 0); + T = scan(); + i = 0; + eqsign(); + while (1) { + expect(SYMBOL, "symbol"); + add(Str, glob|CNST, i++); + T = scan(); + if (T != COMMA) + break; + T = scan(); + } + y->value = i; + semi(); +} + +void fwddecl(void) { + sym *y; + int n; + + T = scan(); + while (1) { + expect(SYMBOL, "symbol"); + y = add(Str, GLOBF|DECL, 0); + T = scan(); + xlparen(); + n = constval(); + y->flags |= n << 8; + xrparen(); + if (n < 0) + aw("invalid arity", NULL); + if (T != COMMA) + break; + T = scan(); + } + semi(); +} + +void resolve_fwd(int loc, int fn) { + int nloc; + + while (loc != 0) { + nloc = tfetch(loc); + tpatch(loc, fn-loc-BPW); + loc = nloc; + } +} + +void compound(void); +void stmt(void); + +void fundecl(void) { + int l_base, l_addr = 2*BPW; + int i, na = 0; + int oyp; + sym *y; + + gen(CG_JUMPFWD, 0); + y = add(Str, GLOBF|FUNC, Tp); + T = scan(); + xlparen(); + oyp = Yp; + l_base = Yp; + while (SYMBOL == T) { + add(Str, 0, l_addr); + l_addr += BPW; + na++; + T = scan(); + if (T != COMMA) + break; + T = scan(); + } + for (i = l_base; i < Yp; i++) { + Sym[i].value = 12+na*BPW - Sym[i].value; + } + if (y->flags & DECL) { + resolve_fwd(y->value, Tp); + if (na != y->flags >> 8) + aw("redefinition with different type", y->name); + y->flags &= ~DECL; + y->flags |= FUNC; + y->value = Tp; + } + xrparen(); + y->flags |= na << 8; + gen(CG_ENTER, 0); + Fun = 1; + stmt(); + Fun = 0; + gen(CG_CLEAR, 0); + gen(CG_EXIT, 0); + gen(CG_RESOLV, 0); + Yp = oyp; + Lp = 0; +} + +void declaration(int glob) { + if (KVAR == T) + vardecl(glob); + else if (KCONST == T) + constdecl(glob); + else if (KSTRUCT== T) + stcdecl(glob); + else if (KDECL == T) + fwddecl(); + else + fundecl(); +} + +void expr(int clr); + +void fncall(sym *fn) { + int i = 0; + + T = scan(); + if (NULL == fn) + aw("call of non-function", NULL); + while (T != RPAREN) { + expr(0); + i++; + if (COMMA != T) + break; + T = scan(); + if (RPAREN == T) + aw("syntax error", Str); + } + if (i != (fn->flags >> 8)) + aw("wrong number of arguments", fn->name); + expect(RPAREN, "')'"); + T = scan(); + if (loaded()) + spill(); + if (fn->flags & DECL) { + gen(CG_CALL, fn->value); + fn->value = Tp-BPW; + } + else { + gen(CG_CALL, fn->value-Tp-5); /* TP-BPW+1 */ + } + if (i != 0) + gen(CG_DEALLOC, i*BPW); + Loaded = 1; +} + +int mkstring(char *s) { + int i, a, k; + + a = Dp; + k = strlen(s); + for (i=0; i<=k; i++) + data(s[i]); + while (Dp % 4 != 0) + data(0); + return a; +} + +int mktable(void) { + int n, i; + int loc; + int tbl[MAXTBL], af[MAXTBL]; + int dynamic = 0; + + T = scan(); + n = 0; + while (T != RBRACK) { + if (n >= MAXTBL) + aw("table too big", NULL); + if (LPAREN == T) { + T = scan(); + dynamic = 1; + continue; + } + else if (dynamic) { + expr(1); + gen(CG_STGLOB, 0); + tbl[n] = 0; + af[n++] = Tp-BPW; + if (RPAREN == T) { + T = scan(); + dynamic = 0; + } + } + else if (INTEGER == T || SYMBOL == T) { + tbl[n] = constval(); + af[n++] = 0; + } + else if (STRING == T) { + tbl[n] = mkstring(Str); + af[n++] = 1; + T = scan(); + } + else if (LBRACK == T) { + tbl[n] = mktable(); + af[n++] = 1; + } + else { + aw("invalid table element", Str); + } + if (T != COMMA) + break; + T = scan(); + } + expect(RBRACK, "']'"); + T = scan(); + loc = Dp; + for (i=0; i 1) { + tpatch(af[i], Dp-4); + } + } + return loc; +} + +void load(sym *y) { + if (y->flags & GLOBF) + gen(CG_LDGLOB, y->value); + else + gen(CG_LDLOCL, y->value); +} + +void store(sym *y) { + if (y->flags & GLOBF) + gen(CG_STGLOB, y->value); + else + gen(CG_STLOCL, y->value); +} + +void factor(void); + +sym *address(int lv, int *bp) { + sym *y; + + y = lookup(Str, 0); + T = scan(); + if (y->flags & CNST) { + if (lv > 0) aw("invalid address", y->name); + spill(); + gen(CG_LDVAL, y->value); + } + else if (y->flags & (FUNC|DECL)) { + if (2 == lv) aw("invalid address", y->name); + } + else if (0 == lv || LBRACK == T || BYTEOP == T) { + spill(); + load(y); + } + if (LBRACK == T || BYTEOP == T) + if (y->flags & (FUNC|DECL|CNST)) + aw("bad subscript", y->name); + while (LBRACK == T) { + *bp = 0; + T = scan(); + expr(0); + expect(RBRACK, "']'"); + T = scan(); + y = NULL; + gen(CG_INDEX, 0); + if (LBRACK == T || BYTEOP == T || 0 == lv) + gen(CG_DEREF, 0); + } + if (BYTEOP == T) { + *bp = 1; + T = scan(); + factor(); + y = NULL; + gen(CG_INDXB, 0); + if (0 == lv) + gen(CG_DREFB, 0); + } + return y; +} + +void factor(void) { + sym *y; + int op; + int b; + + if (INTEGER == T) { + spill(); + gen(CG_LDVAL, Val); + T = scan(); + } + else if (SYMBOL == T) { + y = address(0, &b); + if (LPAREN == T) { + fncall(y); + } + } + else if (STRING == T) { + spill(); + gen(CG_LDADDR, mkstring(Str)); + T = scan(); + } + else if (LBRACK == T) { + spill(); + gen(CG_LDADDR, mktable()); + } + else if (ADDROF == T) { + T = scan(); + y = address(2, &b); + if (NULL == y) { + ; + } + else if (y->flags & GLOBF) { + spill(); + gen(CG_LDADDR, y->value); + } + else { + spill(); + gen(CG_LDLREF, y->value); + } + } + else if (BINOP == T) { + op = Oid; + if (Oid != Minus_op) + aw("syntax error", Str); + T = scan(); + factor(); + gen(CG_NEG, 0); + } + else if (UNOP == T) { + op = Oid; + T = scan(); + factor(); + gen(Ops[op].code, 0); + } + else if (LPAREN == T) { + T = scan(); + expr(0); + xrparen(); + } + else { + aw("syntax error", Str); + } +} + +int emitop(int *stk, int sp) { + gen(Ops[stk[sp-1]].code, 0); + return sp-1; +} + +void arith(void) { + int stk[10], sp; + + sp = 0; + factor(); + while (BINOP == T) { + while (sp && Ops[Oid].prec <= Ops[stk[sp-1]].prec) + sp = emitop(stk, sp); + stk[sp++] = Oid; + T = scan(); + factor(); + } + while (sp > 0) { + sp = emitop(stk, sp); + } +} + +void conjn(void) { + int n = 0; + + arith(); + while (CONJ == T) { + T = scan(); + gen(CG_JMPFALSE, 0); + clear(); + arith(); + n++; + } + while (n > 0) { + gen(CG_RESOLV, 0); + n--; + } +} + +void disjn(void) { + int n = 0; + + conjn(); + while (DISJ == T) { + T = scan(); + gen(CG_JMPTRUE, 0); + clear(); + conjn(); + n++; + } + while (n > 0) { + gen(CG_RESOLV, 0); + n--; + } +} + +void expr(int clr) { + if (clr) { + clear(); + } + disjn(); + if (COND == T) { + T = scan(); + gen(CG_JMPFALSE, 0); + expr(1); + expect(COLON, "':'"); + T = scan(); + gen(CG_JUMPFWD, 0); + swap(); + gen(CG_RESOLV, 0); + expr(1); + gen(CG_RESOLV, 0); + } +} + +void stmt(void); + +void halt_stmt(void) { + T = scan(); + gen(CG_HALT, constval()); + semi(); +} + +void return_stmt(void) { + T = scan(); + if (0 == Fun) + aw("can't return from main body", 0); + if (SEMI == T) + gen(CG_CLEAR, 0); + else + expr(1); + if (Lp != 0) { + gen(CG_DEALLOC, -Lp); + } + gen(CG_EXIT, 0); + semi(); +} + +void if_stmt(int alt) { + T = scan(); + xlparen(); + expr(1); + gen(CG_JMPFALSE, 0); + xrparen(); + stmt(); + if (alt) { + gen(CG_JUMPFWD, 0); + swap(); + gen(CG_RESOLV, 0); + expect(KELSE, "ELSE"); + T = scan(); + stmt(); + } + else if (KELSE == T) { + aw("ELSE without IE", NULL); + } + gen(CG_RESOLV, 0); +} + +void while_stmt(void) { + int olp, olv; + + olp = Loop0; + olv = Lvp; + T = scan(); + xlparen(); + gen(CG_MARK, 0); + Loop0 = tos(); + expr(1); + xrparen(); + gen(CG_JMPFALSE, 0); + stmt(); + swap(); + gen(CG_JUMPBACK, 0); + gen(CG_RESOLV, 0); + while (Lvp > olv) { + push(Leaves[Lvp-1]); + gen(CG_RESOLV, 0); + Lvp--; + } + Loop0 = olp; +} + +void for_stmt(void) { + sym *y; + int step = 1; + int oll, olp, olv; + int test; + + T = scan(); + oll = Llp; + olv = Lvp; + olp = Loop0; + Loop0 = 0; + xlparen(); + expect(SYMBOL, "symbol"); + y = lookup(Str, 0); + T = scan(); + if (y->flags & (CNST|FUNC|DECL)) + aw("unexpected type", y->name); + eqsign(); + expr(1); + store(y); + expect(COMMA, "','"); + T = scan(); + gen(CG_MARK, 0); + test = tos(); + load(y); + expr(0); + if (COMMA == T) { + T = scan(); + step = constval(); + } + gen(step<0? CG_FORDOWN: CG_FOR, 0); + xrparen(); + stmt(); + while (Llp > oll) { + push(Loops[Llp-1]); + gen(CG_RESOLV, 0); + Llp--; + } + if (y->flags & GLOBF) + gen(CG_INCGLOB, y->value); + else + gen(CG_INCLOCL, y->value); + gen(CG_WORD, step); + swap(); + gen(CG_JUMPBACK, 0); + gen(CG_RESOLV, 0); + while (Lvp > olv) { + push(Leaves[Lvp-1]); + gen(CG_RESOLV, 0); + Lvp--; + } + Llp = oll; + Loop0 = olp; +} + +void leave_stmt(void) { + if (Loop0 < 0) + aw("LEAVE not in loop context", 0); + T = scan(); + semi(); + if (Lvp >= MAXLOOP) + aw("too many LEAVEs", NULL); + gen(CG_JUMPFWD, 0); + Leaves[Lvp++] = pop(); +} + +void loop_stmt(void) { + if (Loop0 < 0) + aw("LOOP not in loop context", 0); + T = scan(); + semi(); + if (Loop0 > 0) { + push(Loop0); + gen(CG_JUMPBACK, 0); + } + else { + if (Llp >= MAXLOOP) + aw("too many LOOPs", NULL); + gen(CG_JUMPFWD, 0); + Loops[Llp++] = pop(); + } +} + +void asg_or_call(void) { + sym *y; + int b; + + clear(); + y = address(1, &b); + if (LPAREN == T) { + fncall(y); + } + else if (ASSIGN == T) { + T = scan(); + expr(0); + if (NULL == y) + gen(b? CG_STINDB: CG_STINDR, 0); + else if (y->flags & (FUNC|DECL|CNST|VECT)) + aw("bad location", y->name); + else + store(y); + } + else { + aw("syntax error", Str); + } + semi(); +} + +void stmt(void) { + if (KFOR == T) + for_stmt(); + else if (KHALT == T) + halt_stmt(); + else if (KIE == T) + if_stmt(1); + else if (KIF == T) + if_stmt(0); + else if (KLEAVE == T) + leave_stmt(); + else if (KLOOP == T) + loop_stmt(); + else if (KRETURN == T) + return_stmt(); + else if (KWHILE == T) + while_stmt(); + else if (KDO == T) + compound(); + else if (SYMBOL == T) + asg_or_call(); + else if (SEMI == T) + T = scan(); + else + expect(0, "statement"); +} + +void compound(void) { + int oyp, olp; + + expect(KDO, "DO"); + T = scan(); + oyp = Yp; + olp = Lp; + while (KVAR == T || KCONST == T || KSTRUCT == T) + declaration(0); + while (T != KEND) + stmt(); + T = scan(); + if (olp - Lp != 0) + gen(CG_DEALLOC, olp-Lp); + Yp = oyp; + Lp = olp; +} + +void checkclass(void) { + if (strcmp(Str, "t3x")) + aw("class name must be T3X", Str); +} + +void module_decl(void) { + T = scan(); + expect(SYMBOL, "symbol"); + T = scan(); + xlparen(); + expect(SYMBOL, "symbol"); + checkclass(); + T = scan(); + xrparen(); + expect(SEMI, "symbol"); + T = scan(); +} + +void object_decl(void) { + T = scan(); + expect(SYMBOL, "symbol"); + if (strcmp(Str, "t")) + aw("object name must be T", Str); + T = scan(); + expect(LBRACK, "'['"); + T = scan(); + expect(SYMBOL, "symbol"); + checkclass(); + T = scan(); + expect(RBRACK, "']'"); + T = scan(); + expect(SEMI, "symbol"); + T = scan(); +} + +void program(void) { + int i; + + gen(CG_INIT, 0); + T = scan(); + if (T == KMODULE) module_decl(); + if (T == KOBJECT) object_decl(); + while ( KVAR == T || KCONST == T || SYMBOL == T || + KDECL == T || KSTRUCT == T + ) + declaration(GLOBF); + if (T != KDO) + aw("DO or declaration expected", NULL); + compound(); + gen(CG_HALT, 0); + for (i=0; i*+k?WS5TAzxNWNI}rsjNt8rOoQxjY<;(mE!w;KhOE~`P@5z?*8$; zuh(HdpXWU1InVQ)=hr!(&%OM^B@5m%YSgF`3ifkM;n>0`T=%USJ+{FC@wcH+EF4pq zA`t246>!*gTvaHrjUjA&LB`MRVgDHPj~Ux|a-qO>ob9hn#>Kk6N#oXCH)-s;1(QZ! zbnw~Fp778~{l@}6ZQJ%6-g4;dw;pQUv}t<`GNT-Y&&Vq zD*;Ipk{Bk+725@8p#R{ZLx=LCK9w1zz591ns1&^!=szIC_-~l(Ha~2-V3Kr_(zq6l z+T~`_A(U}o`@&oHzo?`tcMH9mBeD_&-u`N&Nd~E%WSxkHnJt5BkNqDPlWU>VsF;xG zEGuXg5B0zWPgUaY1c!^rTUC!hDt|AE8A%6kd9Dk@(H8%kNFCCUp-9g^k$HlKfmZm2!VIx2nZeX zK|hiUm?OKycSdACmnHi*IkJ{7rG8p10&_fpVA1M6R#X}_)FK9*XX%kYdr8fHPe=rG z!{Dq{3i?DeY+H8NeRj6XY0Kv8p5wv!0vIg|A*waE`Ob8)bguV+b^R*wwGkw1OB=n@ zo`D(DB|>099^IVpA!&=CoaF&+^zdZbwz-e25`m{#&f5fUl*hBYIO8}?I>?NSYS&SN z^EfJ{XEA==>bZLjAn7XU#1%~O7C(NFkui~x-`aCbFqlOH$69hW1`Uz8%w|nI8X0-8 z5?SX=yo~9v?lCEF7UGa_wjtu|kgO^ti^fQ75C)=2b2B}vGifNdV`(Fi9e^}CgpLJ5DZ-;GS+0~rcPeElqX(uVh>-D`Oc`WmJ@3PEwhkHG8k8?30#}y2gn%Qw z>{c|+pO{Y1%OFi45h56!sfK*65|x?p&$(=un{tR8Xx6Whf(HYWYtnmfJGtrFa21j>x!sipQ=JxX%fYfSY-O5NCWFj zQkvkR{lCd-R03t;dd7EjL!gO)ia3MNQeJJW3VsFRL%efVMGA@vUs0y^d;K5;IlN$f zz@xBHALEy&A)0aHoan(*R_|TaI10{x3iw~WmwTdt$rGaMiE`ZsiUX62xURI~l4)ZK zZYc1moPCKl=Gsnb<5j2t)f5IvIFXUmshSi^H>E|9s1DvqjNPbHrHAm>VZ+0sDk|s!iec0p zNcu2HaYDetH|n6@sd@I5}&L!SG{yMg z@11H!HtU;{CEYWqFqIPD_DKCJwIMdm6C-#D*8)#c9*V$rtzG{D%tj@E=4oIMMH%80 z_W;Y5ZE2=6Nv9Gw6Ab?%LbeX!M7yR6nfb|yb-S;lDi30yn=nU%qGTtW646-XX-Jq( z%r88k(mOKI&MKnZFlb0O4?p87qDuY9Brd2T!R?JkqP%y5x$UwuLa>u)u-%hl~X;}Rlc&SNS$$G6v&o5 z?E+b4QN#x>gJ~tE&KFb2)a=^-8(TnmpR=}O4*IhQMqYEgWNZrVbZ6aeKvx{KDxOOI3E{Gy^SD1m!Nm)TG|!W^AX}#=wh-H7$UX| ze^oTxx*m^VK~aVWL)kXyicNV^t|dt*wxii7H;=%*T5>UoB@3w6sbp=OGN3vcLnl;A&35U$^sECpJivu$u=x z)l*AH(c&zZ7$KKP`E6SMK>s0m7u#_OjlSJ)4^xIHH&xM3CEV1b3*6WVlmdjd1&jKY z`1AgqNTb#u-Cm-BKH}Fq>{Z3bH%X`Ra@}6%DYN($ap9qF=Q0|w!x{?hYSv{bfI6kvpXG! z#gbX}Fi*;oYs}FJ`LFCtwA>J^uU28X^lu`po2#&BIeA*09!nVO0K+u0yQppRb>Eq$ z0=P2(whG{u0N5sgwE-|JfNKKaK>@S|z-|G&GXS0vz`OvUz7zBP0N`^yYdX~US3*yN zpnf(0aF4Mc&jZ#3z+Rc|M?R3J`vfo?00#wdPXLTwL&bbL0LBU6rT{oa0ILE(Wq4(n zmfO3;91IvDl=)2_@VE!qB>zwzka~bT08Gs10)QbpF`ozk<)c3UgbyK2moo1UJreWH zd-H&|d4O&^O=BJq(ycsuOw6l2hUARIjPU>(oI8S;2&Lg@0*V=!JQdfKD{x6e#GgVk z$ZkD+NX(mm;o{cNB!CC`kM=Rq7l|mevQ#9~!fg*# zP656$GDu_}P3#em5OAk+L%h>OSA7Ii`A9soSpnio!yWJP$cM8glk(zm2e3z?ek6!uEEQx>hP)svlm91N#N;X5&zL0Ry1>8)i9YG!@>!M zJh(j`V;vKY<0d;p4wZo~kIF|FWG09DziOZ|)zm;`y314LDRvE1u6!Q#swz~b$n^F2 z2POyy!+t(Lrn(XqRq&rYYHt;JK`qumrSH~Yn(s^Gsa{m~2m-iD}Gc9rqk_fz$5EcKKb zyXK;(w`#1M4(lUG@3MR#Y07XD6`=A~IE*8Ix+Q-&FL1bSvVa>i3ZmlMp_jSa{1%TJ z?7a5^qw)=(Ekw%?j}a}qdI2M%QYCG++y%Ed7Z8WMn32tV<>xN=F=EgU)06R!eSd-v zU9{c+EGFH;+gR&scv9eyTZHuDYSN6Afo7Ya&8$Y_8U2wssP_4ogJnYc@jX?-{Z)p8 z6@qq8H5!-ZNE}p$l32ah3F(E^q*=@!iF6xqvg(aVuM*OKda_D57IH@-%?Ht0(y`vw z3h7T*ljftjuyQvF+O^eauRRJ5Iu6Uh1|eOnCe3IbIM^g;&;Li24j7q^q=U}GaJKC6$kMG-zB6cR+IkUM?reoVM*UBq`&pED!s8-I1<;@ zDJ$lBtB`K3CS5!V($y(0COs^qPpl@*0DL5_tMgn;dWVp{dv}#Wn7off`WoP5ohc^0 zQ%JwFn)DelX(?sxM)>r&>eAXvx^3>nFg&v6!9|L8Xs7`b49@2)nq9lCMEpviGIgB-?hi4 zyEujRn$w&Ym8K~D;I081s}(zdv&3uv@l{VYq4whhskWU-Ag{}t7W!FE?fi+8 zMJ#Rgu&a2eqQsnye^p2-?-nfXkpugo5augZu9uD;){{!)v9)F2K*_3IMR(el>D`UfLm;+)u zS@z;>TFKJ%@A+l6X|9wG2}(q3j6{3%M_x3LDh$;lggD(?>nCS)cn7-IiRAXtPA1%w zsg&H-?(;oWB z?h}VTbQibI^{(66B~=Qo&}Q^(n?Va%RCH~ce(UU{!lTkWzuw1x3ELR7q-gmdB?LrQ zIWJ7>z(Uq0F9pPW2y^MId%;cO(LzuV`)G^o-0VQ1O3pmk2$ zwtATRUheTWfj?XRCFZ)FP6@Uny^AU`pUJ~jBJ-K=JA5T5CnZgw%mXXVoyeg$Iq)mn z&vOAS5eFMBd%jcSEK^UCrZV-J;7w6Pbrp zNxDstcLe13)I{cMjY&Ez$hQaNsTpMM6CtfEX_7uD$UPoeINhlzamizqBUY1%ncT04 zORM>q`%$=x%xZhvPiFEEj>?9A&x$%eM+^9Ge3moN3tg7-=RmuH0w$4p=d`zeO?uH z25PfBPraSg-NwbKmuVG#CSNrXId4Zn;^ovOG-o?f68~5pTnQ}m+@Hc1pk!tBHQ2Mr zx83zfscfIzw93lRPpyDwcto|P!FqZ0bwLi#{L4P8C(VhnOSOt2wXDAn0b*9V5$0_W zS`8r+xnP67Tu>i0GyvtpeDe`!04^3%Jhd5{+chvcGfGnG5hw9@&oO-!E|c_tc*a8i zPPh3b3RGF`%6EWZ`9F@sG7j;1K+IPit{H%ikBa|;5&wVQ5%^b|7xu94RSmMLP?nLx z{Wr;8hOBO<6ssl+C?D$c7)71csayrBoe^92%1MHz<$(cDnKhjrMXz%HsNZC0H?xWyZ|=HeA|sMp91n> zIiHy4e87+Gg}sY>>NH*@AEZj=jY!zqg?T_iKXu|PMNFGfla6GHZla@D!+oe$RRvdL zXbpAh6ws%c1maPyIlG2>KI^D?k)ESSS7D^;O5pkeYP87De27V|F92o3o&j zYNf zZU9klP44|8z;fQjd}@2mBB_39kD7}zFBREpQheEmNkmNZPGA11-1fD+0W5EnK@U`C z(6|(;zShb`<0G>_EzR06%Q8}$Y2&VkVaNOm zxm><2qWf+6Zp}cy0g{DsXJ(fKM045cdO+;N?1ZMsY+`Qk6S|d_fbRTeog7qX_K^~V za+x1u*C0$Cg#~=h;Z~Mls8c`EJg)g~BHS~auIFPY_Z2be(!l55`%6;l1)P%yo0afg z3M9wF3|gm~U6|}@nGQ=_sC-Cfr+)L*fP{8Ub;rXs*7Yk=2&Kq}cBw8#f>&F%9699R zQcRxCaZEO2oC!YCiF8dj3;=(?o0xsWfqI@%Kcspld4mqZI-&t%ghAH+q9H+6`wl0( z{hv_Q94$$=K2C7HIS%qE_a82U9eT`3C&6!MBWfVCbdueC%dL%y)JkF=4frgP9ho$M zxeIsTK@Zl03;QK1x{7=SO?y}__4;S3Y^T+p*eL6}- zo_uIoz*E_g$Bco$*)dCiXy-Zouw(u)jF}q7@JV=f9&VM*8YF}Y3laGOrO5O&*3!pU z^SX-lT37r5H%CZLQ07Dlqw@i`P;OALC|Wno$EPm7a45RXawn#KxtcnSLUDWrZcgxX z*w`5bGS*b27WUoi01>>z`~ZutDvh(5-zgnFI9&`n<`uAsIFPyN!e&r3(n01mdYVPw zavG^DlrTbW;anTQ?Ecd>gq`1CDtIUQg4kFcbNZ`#M?p z3ew!joM3r~`L|Rc#qvxCkH?al<|tRHP@&((zECm4vE}y=4nt7FrA^7?QZLQHolY9J zc<9TmHN8W3We!J@6L%Zm@Wag_VVFH)^m}pPjXuuVvLSILlSpPx_$Ha)(2?FscMlo3 zu&^xJ;`(X0wrW=W@E0OwQ|0Gs69E6?M z1rE1zAqCLQ{DZ>ty5D%YCpfH^z8*J7@hnmQe$1dtuj=GM40)6FxEnm>*29@0etw9D zo_LehU67o)9T*<{M*6A_<~-RmulADQ&Pj3{ zgs@7Xd>N&vJ!_8VkWA+qeX>+7h*=Ax6Ar5d2||+H9QTzEfCI}5xXMk}1_&ywD!o}} zIu=S(osTrNh&O`b%nNumO$@QZJ*s7bHgS|P^M&n~GjZj^VLF=IQBHRpq8fgbFMK$q>-xOu_v=p$vI|lBcZ=9qCeTwubhiD5B?&UqdyXy^u^S1Vnf&@cA5u& z<-pG2p{AUkgw~XZ))zf3!~m@Kl?fszN_Tk3 z1kBH%&A$?~dCY{MUAuY`pV8{+4ZzdyPdHTiXwc1MNfNZ4iqyTw;cA3J>xF-JOZw6| zkbqj7gCS2=IUp}1aInIo3J1qQ89s5vhXv-5uQ^ur)Wv*%w>2kcjZ~4>g6`W@VSVVx zAMJ!i6&*FuWE~-(2SVnz_qmD9I54XRE)F%T`G5J2L#_Nu<_xhlFqYr1FlD_h;;=g4 z3WxJY=I~O_VWm4Fgv+dV_S1exil}jlp~YmKhkk8d3GuAp<}x{YpbNb`f_%NrDKWcn z8U5%JH*Vi`DMb~FM^?q$d)*3*#MYYMQk0F4d*cz~lys4@{I;pZ`?fWaPwy9Z7)nf3=^=+_uZgTDc0utzIxFXY8z}bn(~g`Jic+nuao}0_@Q0 z;`L;pI2Rd%({h!oa!i=6+P%-i81rv9fso(taeI=j&$!Wvxy&C=m?!Y)O3R}!fYOLY zemZGh;c1%RsCwe-SWnpx6wIicX3!_iRcW)E(h|g%1>0vY^%c*ZC=bqvC)U|Mm zEaD-M?o-^^xrRs#$x)GA)hd8%M+sSdjS2NYGFO2))t|$sqJ7jg;{)?zCKnN(*5spp z7JrXF0I6JpxvZkeR5mcOey}fS%(2hX!%kYNp=Asgwl*I8q7&bo{A0V2<~0bVDOK(~ zswK?*5Xo!Z&w!Gh`!YATeZX}8j~vNiXw|(nn=NW6ve$}@aQp6eTvej?2C9vFGRB(s zx=HNdoiG5ka2kTUna)PlJkPHlr4PI6qBtX|?@19@FPQJAX9xw4&mI~wqy zStrImOIr%7_B6&R4S zN#2?bKXm5uad>6rAgDS-vO_jPl~jX`Ie9j|3974y>5fv%{TLTMfSYT9ZM998w?@rl zTl z!Y+7t6VfnMf#2F#UPH9kptD-E6Uk8~KZ$6kdeQjJAt%~Zo&)ndF3s@&lxPz?;iDAo zzrYn%O?`<5PlqrqWa<@R-AMb8hKe-y40Oo#ebQNsM>A$CH&j2P7b_x!zA$BvJF%sOb{( z_}4r~-vDzm;^%h6-?|Zld~~F2WY=3l;YNxk)`9Qgf8LR^=FeI;JBAN~Q~*2X-JS*g zjci&be$@u{p;1@gO%Y^L3dx7xdDH#7pzOz<^h8f9Wzu(S?eixC<|jzoBIS3`PrbbV zQ5PgC=(4Kajf|zUr?G$D73dJzycSjx?1-r)^Emp00sVt_=2o-h`%<2mCF$K_A(tR& zS_}CBUQQ4TF<(MmmNA7%ez1r#A1d>4$j1JSZuH0*5fR z2xJENc59+I!cHc?;3qz|INmbkkI9h_Lx(tBuwjC7w2y3Ul=iXIo2o`$iOkg4!Ss~G8K z&f zR+xlzam9e#3l@M1iSSH>i8y^7{*mXmDZ`L6(I4IC**zKRF#iV`K~@xs+*jKw`JQ#6 zIKi}ns&Dv=moW~_9e$$x&>}MCKwd$2?4A7lw$j3&KCB^`$_a{%9frqs_g5% ziP?Rx6FhBDf^@>f412g4h9nt(-s1Z*4tJ9WJAcMAte4@>$sIK{H$6u_C_VOPdYbj; z36Mwp`2k!={=*Y5^;LSMENX7b7A`}17$i&LiMW#3Xn`6Ji!*fTG(ZC0r?E4}9 zJkh?q<+Fo?jY(V+M+HOz74z%c{Z#Q8&-aWIM>oC=q+mDu_xd4b70Qh$iQ4Z|Tg_3o zSp`s9^9cl-%CkYiblDnc7eb+x9RZC7nMGrW)nzwl|IxF1OBllRQDX?8NI(1if>m0> z5EfmH$B;bBJ9c+A;ob4jnrzOy%u4*@+A7K>Wa0|uGj}O z8k|Ktqc+;Fsk)m28V@LIOiEv_Tp7@CRSWH-5`8KtT zBzVYt{{btrEox+!qi^;|tjW$u6L9bGNEVOK&9m4{s^Zo8?b~{=B7Iv=XRxp9aa|?E za;>pGwoY9uOL*v?9i{N{f+Wrx*=+;ECqLE`V)|5;DL zclnO%37dp}gbvRNnaWe&zX4sAy*q@xB_px7C1UTOM>3s`lzoS1n^3vmKVUQqJOU<1 zTpkvL@Q$~60vlCxrpMAJC_4meMIbZAA((fe4iRZCN7?4B-#mpQQ8jQq3}vO7wHi65 z;4gbwyW+c^H89A}h(6GPF}AbX2i_h!ah0VVdr#H7kw@V@@N{@j0lP<=Sl@$%ww$=A z6ud_aYA1ClhMt)Jdy6xu%qy-F?{r{uFXF4E2g>&u!?kS<9$~Wtcq5R~!T=e}5C%9y z*j(fp*H_<;1w!S$AggK>!y56qQoMIP`fE{z{35+x@z+ZAif=jS6~nJy@xQ{+D+X%4 zVw~2iB93eIia!i0IeUn|^QAEUcCKFWz$xWAN;R)A?%VZ>HDEe%{g|;s{BhrOAFed^ zr*l8*GD6xWm$LWXAeY>aq`T!3HO--P%EyTN6faxkat|-p%H?ie4$I{(UKTbG_c311 zkxSIkhtkD2gN6ANX*aGCvqw(eSSJqgyR7LRfqpkY`2Zz-N}%@!=v+dLKyM3BesNL6 zwaJd6+R`o98SNw7fv23|uSCE51!Njuz|D+Q6VK+8Nx(?=k}K-~#@yu0EHS;GaGqj& zWi4UV%5CMZsh`msG1@(|Isiyw9^S%n+>)l_<6dT>#QbaMof!8@sx%)9y;I^|E^K11 z3cU@|D|s8O9lhDYV>;1L^h3Uhx%p#W810-utFvFmxH{iCQ92m~67wG4*@j8& z|J%i@5k7o~(l=wp?DLC-f@>_471rL>SMKR5brj1zJ>5No_x6>V-(T#$y4=&+(S41( zU*6SX0oot#F(mV0PiuQuxdqVWUF8+a%FTV{mSW$^W#vL&cXzR~)U~qMyRx&XyQA1u z>MZvHucsWwi6q~zS${dgXmb2JaE}J&h&aN zN1=X({+-dFe*spw?VsLg?;YI!<=B_B1J^%SmYYbPpf;r(6R*K`%Tmz8@;eV7OzcU|o2?kl!-!*sw;S4*+Gwb;s0 z)=apHqVLZ3-rn}ErNx%^rR{ya#ZoJbw^%p1jM6leg)i{WY5csTU+YtJ=8ev}H`f*F-h?&d!ZmYFTobCE_Ey~hY{^v0JOIh zd)q%i^%Ux^r~{u_n7c3awD&Q?v@Y*z77K3aF87MkI!k@cZN+()T)coZnoAuWR9;ti z*EtUNaPZ!hU45k$>ifjIrUzDC>{{O0ME7VdmU@;hrytP?DO25|x?;?q z#`1Uf6g$g0VtF4&^_04nmPMYvQd39STOZd!uSy2oy+KZ#TbqGq0rn>>V=&lN*6nq z_x2T=%EilPEClc1UwuE<2{>&;{Z{om@9jlc2%`-gOpG@;O}&QPvHjMPZxUQaXTLO&C|;D z_0wlI)lX|_Bnn^VDH5+qa|XAYjktFhe~J6~LZ^8Kb=O!Tx6mcpLcphX779FrTgGcd zKOV7MhwHM{>uYeomiM!#UVzKO1hh?hKZp0PMcab=`q|C(^{tH!#Nshv8elUC<8j>% zz-BhhnB6=Bm@P_==W}~vcv<1x&K)3pCNwg$P~a|n{5ssXGz|DhCEbuwAo{}}x zH@7s3Z4}X0kG|IPR7a=deu3UgKhLZd+x}_b8+Zce(M|{8PIr@VzXtb>;CN=^^x32~ z8L*9l(|TUHsZcl*_gg&9?Afj7wE_y;M@w_?#@Ra06!h&B8q;MJ&%*s)xv!Tw&c^*g zxt}5ZJW?Kaqwq0pW@F2YGPs=z*u)qH-uPgl9x$il*)yA`*S9v!YM$O8wsJ1|=f(XE z*?#VhTjKtfY(JH>Chjk1`%wZF?uh$av;EW2KOFZrXZyLZPobaw(17dF*l^-c0af~; z@wlD<|CmA_L7R`Z5UmYu1=?D)O=w%tQnUxrcA*)x188GmOB2xQ(dMEhXl-bHXsggR zplwFG8*LbE7uwTkW3dhs(59fxL%STU1?@Vt8__nS-HrAj+EZxz&_+XsQ_!ZM%|Tm? zb{*QSXj{>Cqa8#W3z<$qYiv5NVLHqgf3Z~cjg3uMn1=d>hH0(Mtusoq;9IldF)(v2 zDrxP_Ga5?`vszoHmm1D%ZJjl1HUbqr!_puv()6^1QiG19P6J*;HD2k+cn#AUXSbF> zb$Y36`D>`3rTn3X-csKHj>I#CvqE7OSgxN&oLPp`7rq-B&$Il`*83yT;Ar4jPHWGjdd$#oZVdG8D!i<*sQCFg>amSs zUT8!}x0g`>YShRDF8l%9{`;73O|eWkI*0gk4m3;YB7Q} zc_IE3z*%qbvlw*98{u;Sr|gXDOxC2yF$*o6@q7;O2`BzC3um03g8>{%_*x5R&Os{o zbT(T!qqEb(nWxyCy%`IiOgJaNhw~P2D#kjCAIjkDa01|@Sw}b& zL|nFdz*&cl^l5>8U5B<2?Jl%owB2a?(8fXMlhEd%U5?g)wg&B1w0qHZpgo0l5bYH3 zI~8pn+G4amv>VaxK--G;7}{R6(cotyS_9gAG%hjark&BI-1&lTV~W@e^>CY4=sOoX zDwgHpdKo(ej-7FbyY9u#M6R2A$|&)12^{RI0qi@sxuY9f`@VD0)x!I0u#41tR`iP7 LQ|`o353m0patx=` literal 0 HcmV?d00001 diff --git a/t3x9r3-extended/t.t b/t3x9r3-extended/t.t new file mode 100644 index 0000000..f4650c7 --- /dev/null +++ b/t3x9r3-extended/t.t @@ -0,0 +1,1682 @@ +! T3X9r3 -> ELF-FreeBSD-386 compiler +! Nils M Holm, 2017,2019,2020 CC0 license +! https://creativecommons.org/publicdomain/zero/1.0/ + +module t3x9r3(t3x); + +object t[t3x]; + +const BPW = 4; + +const PROG_SIZE = 65536; + +const TEXT_SIZE = 65536; ! must be a multiple of PAGE_SIZE ! +const DATA_SIZE = 65536; + +const NRELOC = 10000; + +const STACK_SIZE = 100; + +const SYMTBL_SIZE = 1000; +const NLIST_SIZE = 10000; + +var Stack[STACK_SIZE], Sp; + +var Line; + +const ENDFILE = %1; + +var ntoa_buf::100; + +ntoa(x) do var i, k; + if (x = 0) return "0"; + i := 0; + k := x<0-> -x: x; + while (k > 0) do + i := i+1; + k := k/10; + end + i := i+1; + if (x < 0) i := i+1; + ntoa_buf::i := 0; + k := x<0-> -x: x; + while (k > 0) do + i := i-1; + ntoa_buf::i := '0' + k mod 10; + k := k/10; + end + if (x < 0) do + i := i-1; + ntoa_buf::i := '-'; + end + return @ntoa_buf::i; +end + +str_length(s) return t.memscan(s, 0, 32767); + +str_copy(sd, ss) t.memcopy(sd, ss, str_length(ss)+1); + +str_append(sd, ss) t.memcopy(@sd::str_length(sd), ss, str_length(ss)+1); + +str_equal(s1, s2) return t.memcomp(s1, s2, str_length(s1)+1) = 0; + +writes(s) t.write(1, s, str_length(s)); + +log(s) t.write(2, s, str_length(s)); + +aw(m, s) do + log("t3x9: "); + log(ntoa(Line)); + log(": "); + log(m); + if (s \= 0) do + log(": "); + log(s); + end + log("\n"); + halt 1; +end + +oops(m, s) do + log("t3x9: internal error\n"); + aw(m, s); +end + +push(x) do + if (Sp >= STACK_SIZE) oops("stack overflow", 0); + Stack[Sp] := x; + Sp := Sp+1; +end + +tos() return Stack[Sp-1]; + +pop() do + if (Sp < 1) oops("stack underflow", 0); + Sp := Sp-1; + return Stack[Sp]; +end + +swap() do var t; + if (Sp < 2) oops("stack underflow", 0); + t := Stack[Sp-1]; + Stack[Sp-1] := Stack[Sp-2]; + Stack[Sp-2] := t; +end + +numeric(c) return '0' <= c /\ c <= '9'; + +alphabetic(c) return 'a' <= c /\ c <= 'z' \/ + 'A' <= c /\ c <= 'Z'; + +! +! Symbol table +! + +struct SYM = SNAME, SFLAGS, SVALUE; + +const GLOBF = 1; +const CNST = 2; +const VECT = 4; +const FORW = 8; +const FUNC = 16; + +var Syms[SYM*SYMTBL_SIZE]; +var Nlist::NLIST_SIZE; + +var Yp, Np; + +find(s) do var i; + i := Yp-SYM; + while (i >= 0) do + if (str_equal(Syms[i+SNAME], s)) + return @Syms[i]; + i := i - SYM; + end + return 0; +end + +lookup(s, f) do var y; + y := find(s); + if (y = 0) aw("undefined", s); + if (y[SFLAGS] & f \= f) + aw("unexpected type", s); + return y; +end + +newname(s) do var k, new; + k := str_length(s)+1; + if (Np+k >= NLIST_SIZE) + aw("too many symbol names", s); + new := @Nlist::Np; + t.memcopy(new, s, k); + Np := Np+k; + return new; +end + +add(s, f, v) do var y; + y := find(s); + if (y \= 0) do + ie (y[SFLAGS] & FORW /\ f & FUNC) + return y; + else + aw("redefined", s); + end + if (Yp+SYM >= SYMTBL_SIZE*SYM) + aw("too many symbols", 0); + y := @Syms[Yp]; + Yp := Yp+SYM; + y[SNAME] := newname(s); + y[SFLAGS] := f; + y[SVALUE] := v; + return y; +end + +! +! Emitter +! + +const TEXT_VADDR = 0x08048000; +const DATA_VADDR = TEXT_VADDR + TEXT_SIZE; + +const HEADER_SIZE = 0x74; + +const PAGE_SIZE = 4096; + +struct RELOC = RADDR, RSEG; + +var Rel[RELOC*NRELOC]; + +var Text_seg::TEXT_SIZE; +var Data_seg::DATA_SIZE; +var Header::HEADER_SIZE; + +var Rp, Tp, Dp, Lp, Hp; + +var Acc; + +var Codetbl; + +struct CG = CG_PUSH, CG_CLEAR, + CG_LDVAL, CG_LDADDR, CG_LDLREF, CG_LDGLOB, + CG_LDLOCL, + CG_STGLOB, CG_STLOCL, CG_STINDR, CG_STINDB, + CG_INCGLOB, CG_INCLOCL, + CG_ALLOC, CG_DEALLOC, CG_LOCLVEC, CG_GLOBVEC, + CG_INDEX, CG_DEREF, CG_INDXB, CG_DREFB, + CG_MARK, CG_RESOLV, + CG_CALL, CG_JUMPFWD, CG_JUMPBACK, CG_JMPFALSE, + CG_JMPTRUE, CG_FOR, CG_FORDOWN, + CG_ENTER, CG_EXIT, CG_HALT, + CG_NEG, CG_INV, CG_LOGNOT, CG_ADD, CG_SUB, + CG_MUL, CG_DIV, CG_MOD, CG_AND, CG_OR, CG_XOR, + CG_SHL, CG_SHR, CG_EQ, CG_NEQ, CG_LT, CG_GT, + CG_LE, CG_GE, + CG_WORD; + +emit(x) do + if (Tp >= DATA_SIZE) + aw("text segment too big", 0); + Text_seg::Tp := x; + Tp := Tp+1; +end + +emitw(x) do + emit(255&x); + emit(255&(x>>8)); + emit(255&(x>>16)); + emit(255&(x>>24)); +end + +tag(seg) do + if (Rp+RELOC >= RELOC*NRELOC) + oops("relocation buffer overflow", 0); + Rel[Rp+RADDR] := seg = 't'-> Tp-BPW: Dp-BPW; + Rel[Rp+RSEG] := seg; + Rp := Rp+RELOC; +end + +tpatch(a, x) do + Text_seg::a := 255&x; + Text_seg::(a+1) := 255&(x>>8); + Text_seg::(a+2) := 255&(x>>16); + Text_seg::(a+3) := 255&(x>>24); +end + +tfetch(a) return Text_seg::a + | (Text_seg::(a+1)<<8) + | (Text_seg::(a+2)<<16) + | (Text_seg::(a+3)<<24); + +data(x) do + Data_seg::Dp := x; + Dp := Dp+1; +end + +dataw(x) do + if (Dp >= DATA_SIZE) + aw("data segment too big", 0); + data(255&x); + data(255&(x>>8)); + data(255&(x>>16)); + data(255&(x>>24)); +end + +dpatch(a, x) do + Data_seg::a := 255&x; + Data_seg::(a+1) := 255&(x>>8); + Data_seg::(a+2) := 255&(x>>16); + Data_seg::(a+3) := 255&(x>>24); +end + +dfetch(a) return Data_seg::a + | (Data_seg::(a+1)<<8) + | (Data_seg::(a+2)<<16) + | (Data_seg::(a+3)<<24); + +hex(c) ie (numeric(c)) + return c-'0'; + else + return c-'a'+10; + +rgen(s, v) do var x; + while (s::0) do + ie (s::0 = ',') do + ie (s::1 = 'w') do + emitw(v); + end + else ie (s::1 = 'a') do + emitw(v); + tag('t'); + end + else ie (s::1 = 'm') do + push(Tp); + end + else ie (s::1 = '>') do + push(Tp); + emitw(0); + end + else ie (s::1 = '<') do + emitw(pop()-Tp-BPW); + end + else ie (s::1 = 'r') do + x := pop(); + tpatch(x, Tp-x-BPW); + end + else do + oops("bad code", 0); + end + end + else do + emit(hex(s::0)*16+hex(s::1)); + end + s := s+2; + end +end + +gen(id, v) rgen(Codetbl[id][1], v); + +spill() ie (Acc) + gen(CG_PUSH, 0); + else + Acc := 1; + +active() return Acc; + +clear() Acc := 0; + +activate() Acc := 1; + +relocate() do var i, a, dist; + dist := DATA_VADDR + (HEADER_SIZE + Tp) mod PAGE_SIZE; + for (i=0, Rp, RELOC) do + ie (Rel[i+RSEG] = 't') do + a := tfetch(Rel[i+RADDR]); + a := a + dist; + tpatch(Rel[i+RADDR], a); + end + else do + a := dfetch(Rel[i+RADDR]); + a := a + dist; + dpatch(Rel[i+RADDR], a); + end + end +end + +builtin(name, arity, code) do + gen(CG_JUMPFWD, 0); + add(name, GLOBF|FUNC | (arity << 8), Tp); + rgen(code, 0); + gen(CG_RESOLV, 0); +end + +align(x, a) return (x+a) & ~(a-1); + +hdwrite(b) do + if (Hp >= HEADER_SIZE) + oops("ELF header too long", 0); + Header::Hp := b; + Hp := Hp+1; +end + +hexwrite(b) + while (b::0) do + hdwrite(16*hex(b::0)+hex(b::1)); + b := b+2; + end + +lewrite(x) do + hdwrite(x & 255); + hdwrite(x>>8 & 255); + hdwrite(x>>16 & 255); + hdwrite(x>>24 & 255); +end + +elfheader() do + hexwrite("7f454c46"); ! magic + hexwrite("01"); ! 32-bit + hexwrite("01"); ! little endian + hexwrite("01"); ! header version + hexwrite("09"); ! FreeBSD ABI + hexwrite("0000000000000000"); ! padding + hexwrite("0200"); ! executable + hexwrite("0300"); ! 386 + lewrite(1); ! version + lewrite(TEXT_VADDR+HEADER_SIZE);! initial entry point + lewrite(0x34); ! program header offset + lewrite(0); ! no header segments + lewrite(0); ! flags + hexwrite("3400"); ! header size + hexwrite("2000"); ! program header size + hexwrite("0200"); ! number of program headers + hexwrite("2800"); ! segment header size (unused) + hexwrite("0000"); ! number of segment headers + hexwrite("0000"); ! string index (unused) + ! text segment description + lewrite(1); ! loadable segment + lewrite(HEADER_SIZE); ! offset in file + lewrite(TEXT_VADDR); ! virtual load address + lewrite(TEXT_VADDR); ! physical load address + lewrite(Tp); ! size in file + lewrite(Tp); ! size in memory + lewrite(5); ! flags := read, execute + lewrite(PAGE_SIZE); ! alignment (page) + ! data segment description + lewrite(1); ! loadable segment + lewrite(HEADER_SIZE+Tp); ! offset in file + lewrite(DATA_VADDR); ! virtual load address + lewrite(DATA_VADDR); ! physical load address + lewrite(Dp); ! size in file + lewrite(Dp); ! size in memory + lewrite(6); ! flags := read, write + lewrite(PAGE_SIZE); ! alignment (page) +end + +! +! Scanner +! + +const META = 256; + +const TOKEN_LEN = 128; + +var Prog::PROG_SIZE; + +var Pp, Psize; + +var Tk; +var Str::TOKEN_LEN; +var Val; +var Oid; + +var Equal_op, Minus_op, Mul_op, Add_op; + +struct OPER = OPREC, OLEN, ONAME, OTOK, OCODE; + +var Ops; + +struct TOKENS = + SYMBOL, INTEGER, STRING, + ADDROF, ASSIGN, BINOP, BYTEOP, COLON, COMMA, COND, + CONJ, DISJ, LBRACK, LPAREN, RBRACK, RPAREN, SEMI, UNOP, + KCONST, KDECL, KDO, KELSE, KEND, KFOR, KHALT, KIE, KIF, + KLEAVE, KLOOP, KMODULE, KOBJECT, KPACKED, KRETURN, + KSTRUCT, KVAR, KWHILE; + +readprog() do + Psize := t.read(0, Prog, PROG_SIZE); + if (Psize >= PROG_SIZE) + aw("program too big", 0); +end + +readrc() do var c; + c := Pp >= Psize-> ENDFILE: Prog::Pp; + Pp := Pp+1; + return c; +end + +readc() do var c; + c := readrc(); + return 'A' <= c /\ c <= 'Z'-> c-'A'+'a': c; +end + +readec() do var c; + c := readrc(); + if (c \= '\\') return c; + c := readrc(); + if (c = 'a') return '\a'; + if (c = 'b') return '\b'; + if (c = 'e') return '\e'; + if (c = 'f') return '\f'; + if (c = 'n') return '\n'; + if (c = 'q') return '"' | META; + if (c = 'r') return '\r'; + if (c = 's') return '\s'; + if (c = 't') return '\t'; + if (c = 'v') return '\v'; + return c; +end + +reject() Pp := Pp-1; + +skip() do var c; + c := readc(); + while (1) do + while (c = ' ' \/ c = '\t' \/ c = '\n' \/ c = '\r') do + if (c = '\n') Line := Line+1; + c := readc(); + end + if (c \= '!') + return c; + while (c \= '\n' /\ c \= ENDFILE) + c := readc(); + end +end + +findkw(s) do + if (s::0 = 'c') do + if (str_equal(s, "const")) return KCONST; + return 0; + end + if (s::0 = 'd') do + if (str_equal(s, "do")) return KDO; + if (str_equal(s, "decl")) return KDECL; + return 0; + end + if (s::0 = 'e') do + if (str_equal(s, "else")) return KELSE; + if (str_equal(s, "end")) return KEND; + return 0; + end + if (s::0 = 'f') do + if (str_equal(s, "for")) return KFOR; + return 0; + end + if (s::0 = 'h') do + if (str_equal(s, "halt")) return KHALT; + return 0; + end + if (s::0 = 'i') do + if (str_equal(s, "if")) return KIF; + if (str_equal(s, "ie")) return KIE; + return 0; + end + if (s::0 = 'l') do + if (str_equal(s, "leave")) return KLEAVE; + if (str_equal(s, "loop")) return KLOOP; + return 0; + end + if (s::0 = 'm') do + if (str_equal(s, "mod")) return BINOP; + if (str_equal(s, "module")) return KMODULE; + return 0; + end + if (s::0 = 'o') do + if (str_equal(s, "object")) return KOBJECT; + return 0; + end + if (s::0 = 'p') do + if (str_equal(s, "packed")) return KPACKED; + return 0; + end + if (s::0 = 'r') do + if (str_equal(s, "return")) return KRETURN; + return 0; + end + if (s::0 = 's') do + if (str_equal(s, "struct")) return KSTRUCT; + return 0; + end + if (s::0 = 'v') do + if (str_equal(s, "var")) return KVAR; + return 0; + end + if (s::0 = 'w') do + if (str_equal(s, "while")) return KWHILE; + return 0; + end + return 0; +end + +scanop(c) do var i, j; + i := 0; + j := 0; + Oid := %1; + while (Ops[i][OLEN] > 0) do + ie (Ops[i][OLEN] > j) do + if (Ops[i][ONAME]::j = c) do + Oid := i; + Str::j := c; + c := readc(); + j := j+1; + end + end + else do + leave; + end + i := i+1; + end + if (Oid = %1) do + Str::j := c; + j := j+1; + Str::j := 0; + aw("unknown operator", Str); + end + Str::j := 0; + reject(); + return Ops[Oid][OTOK]; +end + +findop(s) do var i; + i := 0; + while (Ops[i][OLEN] > 0) do + if (str_equal(s, Ops[i][ONAME])) do + Oid := i; + return Oid; + end + i := i+1; + end + oops("operator not found", s); +end + +symbolic(c) return alphabetic(c) \/ c = '_' \/ c = '.'; + +scan() do var c, i, k, sgn, base; + c := skip(); + if (c = ENDFILE) do + str_copy(Str, "end of file"); + return ENDFILE; + end + if (symbolic(c)) do + i := 0; + while (symbolic(c) \/ numeric(c)) do + if (i >= TOKEN_LEN-1) do + Str::i := 0; + aw("symbol too long", Str); + end + Str::i := c; + i := i+1; + c := readc(); + end + Str::i := 0; + reject(); + k := findkw(Str); + if (k \= 0) do + if (k = BINOP) findop(Str); + return k; + end + return SYMBOL; + end + if (numeric(c) \/ c = '%') do + sgn := 1; + i := 0; + if (c = '%') do + sgn := %1; + c := readc(); + Str::i := c; + i := i+1; + if (\numeric(c)) + aw("missing digits after '%'", 0); + end + base := 10; + if (c = '0') do + c := readc(); + if (c = 'x') do + base := 16; + c := readc(); + if (\numeric(c) /\ (c < 'a' \/ c > 'f')) + aw("missing digits after '0x'", 0); + end + end + Val := 0; + while ( numeric(c) \/ + base = 16 /\ 'a' <= c /\ c <= 'f' + ) do + if (i >= TOKEN_LEN-1) do + Str::i := 0; + aw("integer too long", Str); + end + Str::i := c; + i := i+1; + c := c >= 'a'-> c-'a'+10: c-'0'; + Val := Val * base + c; + c := readc(); + end + Str::i := 0; + reject(); + Val := Val * sgn; + return INTEGER; + end + if (c = '\'') do + Val := readec(); + if (readc() \= '\'') + aw("missing ''' in character", 0); + return INTEGER; + end + if (c = '"') do + i := 0; + c := readec(); + while (c \= '"' /\ c \= ENDFILE) do + if (i >= TOKEN_LEN-1) do + Str::i := 0; + aw("string too long", Str); + end + Str::i := c & (META-1); + i := i+1; + c := readec(); + end + Str::i := 0; + return STRING; + end + return scanop(c); +end + +! +! Parser +! + +const MAXTBL = 128; +const MAXLOOP = 100; + +var Fun; +var Loop0; +var Leaves[MAXLOOP], Lvp; +var Loops[MAXLOOP], Llp; + +expect(tok, s) do var b::100; + if (tok = Tk) return; + str_copy(b, s); + str_append(b, " expected"); + aw(b, Str); +end + +xeqsign() do + if (Tk \= BINOP \/ Oid \= Equal_op) + expect(BINOP, "'='"); + Tk := scan(); +end + +xsemi() do + expect(SEMI, "';'"); + Tk := scan(); +end + +xlparen() do + expect(LPAREN, "'('"); + Tk := scan(); +end + +xrparen() do + expect(RPAREN, "')'"); + Tk := scan(); +end + +xsymbol() expect(SYMBOL, "symbol"); + +constfac() do var v, y; + if (Tk = INTEGER) do + v := Val; + Tk := scan(); + return v; + end + if (Tk = SYMBOL) do + y := lookup(Str, CNST); + Tk := scan(); + return y[SVALUE]; + end + aw("constant value expected", Str); +end + +constval() do var v; + v := constfac(); + ie (Tk = BINOP /\ Oid = Mul_op) do + Tk := scan(); + v := v * constfac(); + end + else if (Tk = BINOP /\ Oid = Add_op) do + Tk := scan(); + v := v + constfac(); + end + return v; +end + +vardecl(glob) do var y, size; + Tk := scan(); + while (1) do + xsymbol(); + ie (glob & GLOBF) + y := add(Str, glob, Dp); + else + y := add(Str, 0, Lp); + Tk := scan(); + size := 1; + ie (Tk = LBRACK) do + Tk := scan(); + size := constval(); + if (size < 1) + aw("invalid size", 0); + y[SFLAGS] := y[SFLAGS] | VECT; + expect(RBRACK, "']'"); + Tk := scan(); + end + else if (Tk = BYTEOP) do + Tk := scan(); + size := constval(); + if (size < 1) + aw("invalid size", 0); + size := (size + BPW-1) / BPW; + y[SFLAGS] := y[SFLAGS] | VECT; + end + ie (glob & GLOBF) do + if (y[SFLAGS] & VECT) do + gen(CG_ALLOC, size*BPW); + gen(CG_GLOBVEC, Dp); + end + dataw(0); + end + else do + gen(CG_ALLOC, size*BPW); + Lp := Lp - size*BPW; + if (y[SFLAGS] & VECT) do + gen(CG_LOCLVEC, 0); + Lp := Lp - BPW; + end + y[SVALUE] := Lp; + end + if (Tk \= COMMA) leave; + Tk := scan(); + end + xsemi(); +end + +constdecl(glob) do var y; + Tk := scan(); + while (1) do + xsymbol(); + y := add(Str, glob|CNST, 0); + Tk := scan(); + xeqsign(); + y[SVALUE] := constval(); + if (Tk \= COMMA) leave; + Tk := scan(); + end + xsemi(); +end + +stcdecl(glob) do var y, i; + Tk := scan(); + xsymbol(); + y := add(Str, glob|CNST, 0); + Tk := scan(); + xeqsign(); + i := 0; + while (1) do + xsymbol(); + add(Str, glob|CNST, i); + i := i+1; + Tk := scan(); + if (Tk \= COMMA) leave; + Tk := scan(); + end + y[SVALUE] := i; + xsemi(); +end + +fwddecl() do var y, n; + Tk := scan(); + while (1) do + xsymbol(); + y := add(Str, GLOBF|FORW, 0); + Tk := scan(); + xlparen(); + n := constval(); + if (n < 0) aw("invalid arity", 0); + y[SFLAGS] := y[SFLAGS] | (n << 8); + xrparen(); + if (Tk \= COMMA) leave; + Tk := scan(); + end + xsemi(); +end + +resolve_fwd(loc, fn) do var nloc; + while (loc \= 0) do + nloc := tfetch(loc); + tpatch(loc, fn-loc-BPW); + loc := nloc; + end +end + +decl compound(0), stmt(0); + +fundecl() do + var l_base, l_addr; + var i, na, oyp, onp; + var y; + + l_addr := 2*BPW; + na := 0; + gen(CG_JUMPFWD, 0); + y := add(Str, GLOBF|FUNC, Tp); + Tk := scan(); + xlparen(); + oyp := Yp; + onp := Np; + l_base := Yp; + while (Tk = SYMBOL) do + add(Str, 0, l_addr); + l_addr := l_addr + BPW; + na := na+1; + Tk := scan(); + if (Tk \= COMMA) leave; + Tk := scan(); + end + for (i = l_base, Yp, SYM) do + Syms[i+SVALUE] := 12+na*BPW - Syms[i+SVALUE]; + end + if (y[SFLAGS] & FORW) do + resolve_fwd(y[SVALUE], Tp); + if (na \= y[SFLAGS] >> 8) + aw("function does not match DECL", y[SNAME]); + y[SFLAGS] := y[SFLAGS] & ~FORW; + y[SFLAGS] := y[SFLAGS] | FUNC; + y[SVALUE] := Tp; + end + xrparen(); + y[SFLAGS] := y[SFLAGS] | (na << 8); + gen(CG_ENTER, 0); + Fun := 1; + stmt(); + Fun := 0; + gen(CG_CLEAR, 0); + gen(CG_EXIT, 0); + gen(CG_RESOLV, 0); + Yp := oyp; + Np := onp; + Lp := 0; +end + +declaration(glob) + ie (Tk = KVAR) + vardecl(glob); + else ie (Tk = KCONST) + constdecl(glob); + else ie (Tk = KSTRUCT) + stcdecl(glob); + else ie (Tk = KDECL) + fwddecl(); + else + fundecl(); + +decl expr(1); + +fncall(fn) do var i; + Tk := scan(); + if (fn = 0) aw("call of non-function", 0); + if (fn[SFLAGS] & (FUNC|FORW) = 0) + aw("call of non-function", fn[SNAME]); + i := 0; + while (Tk \= RPAREN) do + expr(0); + i := i+1; + if (Tk \= COMMA) leave; + Tk := scan(); + if (Tk = RPAREN) + aw("syntax error", Str); + end + if (i \= fn[SFLAGS] >> 8) + aw("wrong number of arguments", fn[SNAME]); + expect(RPAREN, "')'"); + Tk := scan(); + if (active()) + spill(); + ie (fn[SFLAGS] & FORW) do + gen(CG_CALL, fn[SVALUE]); + fn[SVALUE] := Tp-BPW; + end + else do + gen(CG_CALL, fn[SVALUE]-Tp-5); ! TP-BPW+1 + end + if (i \= 0) gen(CG_DEALLOC, i*BPW); + activate(); +end + +mkstring(s) do var i, a, k; + a := Dp; + k := str_length(s); + for (i=0, k+1) + data(s::i); + while (Dp mod BPW \= 0) + data(0); + return a; +end + +mkbytevec() do var a, k; + Tk := scan(); + expect(LBRACK, "'['"); + Tk := scan(); + a := Dp; + k := 0; + while (1) do + expect(INTEGER, "cvalue"); + if (Val > 255 \/ Val < 0) + aw("byte vector member out of range", Str); + data(Val); + Tk := scan(); + if (Tk \= COMMA) leave; + Tk := scan(); + end + expect(RBRACK, "']'"); + Tk := scan(); + while (Dp mod BPW \= 0) + data(0); + return a; +end + +mktable() do + var n, i, a; + var tbl[MAXTBL], af[MAXTBL]; + var dynamic; + + Tk := scan(); + dynamic := 0; + n := 0; + while (Tk \= RBRACK) do + if (n >= MAXTBL) + aw("table too big", 0); + ie (Tk = LPAREN /\ \dynamic) do + Tk := scan(); + dynamic := 1; + loop; + end + else ie (dynamic) do + expr(1); + gen(CG_STGLOB, 0); + tbl[n] := 0; + af[n] := Tp-BPW; + n := n+1; + if (Tk = RPAREN) do + Tk := scan(); + dynamic := 0; + end + end + else ie (Tk = INTEGER \/ Tk = SYMBOL) do + tbl[n] := constval(); + af[n] := 0; + n := n+1; + end + else ie (Tk = STRING) do + tbl[n] := mkstring(Str); + af[n] := 1; + n := n+1; + Tk := scan(); + end + else ie (Tk = LBRACK) do + tbl[n] := mktable(); + af[n] := 1; + n := n+1; + end + else ie (Tk = KPACKED) do + tbl[n] := mkbytevec(); + af[n] := 1; + n := n+1; + end + else do + aw("invalid table element", Str); + end + if (Tk \= COMMA) leave; + Tk := scan(); + if (Tk = RBRACK) + aw("syntax error", Str); + end + if (dynamic) + aw("missing ')' in dynamic table", 0); + expect(RBRACK, "']'"); + if (n = 0) aw("empty table", 0); + Tk := scan(); + a := Dp; + for (i=0, n) do + dataw(tbl[i]); + ie (af[i] = 1) do + tag('d'); + end + else if (af[i] > 1) do + tpatch(af[i], Dp-4); + end + end + return a; +end + +load(y) ie (y[SFLAGS] & GLOBF) + gen(CG_LDGLOB, y[SVALUE]); + else + gen(CG_LDLOCL, y[SVALUE]); + +store(y) + ie (y[SFLAGS] & GLOBF) + gen(CG_STGLOB, y[SVALUE]); + else + gen(CG_STLOCL, y[SVALUE]); + +decl factor(0); + +address(lv, bp) do var y; + y := lookup(Str, 0); + Tk := scan(); + ie (y[SFLAGS] & CNST) do + if (lv > 0) aw("invalid location", y[SNAME]); + spill(); + gen(CG_LDVAL, y[SVALUE]); + end + else ie (y[SFLAGS] & (FUNC|FORW)) do + if (lv = 2) aw("invalid location", y[SNAME]); + end + else if (lv = 0 \/ Tk = LBRACK \/ Tk = BYTEOP) do + spill(); + load(y); + end + if (Tk = LBRACK \/ Tk = BYTEOP) + if (y[SFLAGS] & (FUNC|FORW|CNST)) + aw("bad subscript", y[SNAME]); + while (Tk = LBRACK) do + Tk := scan(); + bp[0] := 0; + expr(0); + expect(RBRACK, "']'"); + Tk := scan(); + y := 0; + gen(CG_INDEX, 0); + if (lv = 0 \/ Tk = LBRACK \/ Tk = BYTEOP) + gen(CG_DEREF, 0); + end + if (Tk = BYTEOP) do + Tk := scan(); + bp[0] := 1; + factor(); + y := 0; + gen(CG_INDXB, 0); + if (lv = 0) gen(CG_DREFB, 0); + end + return y; +end + +factor() do var y, op, b; + ie (Tk = INTEGER) do + spill(); + gen(CG_LDVAL, Val); + Tk := scan(); + end + else ie (Tk = SYMBOL) do + y := address(0, @b); + if (Tk = LPAREN) fncall(y); + end + else ie (Tk = STRING) do + spill(); + gen(CG_LDADDR, mkstring(Str)); + Tk := scan(); + end + else ie (Tk = LBRACK) do + spill(); + gen(CG_LDADDR, mktable()); + end + else ie (Tk = KPACKED) do + spill(); + gen(CG_LDADDR, mkbytevec()); + end + else ie (Tk = ADDROF) do + Tk := scan(); + y := address(2, @b); + ie (y = 0) do + ; + end + else ie (y[SFLAGS] & GLOBF) do + spill(); + gen(CG_LDADDR, y[SVALUE]); + end + else do + spill(); + gen(CG_LDLREF, y[SVALUE]); + end + end + else ie (Tk = BINOP) do + if (Oid \= Minus_op) + aw("syntax error", Str); + Tk := scan(); + factor(); + gen(CG_NEG, 0); + end + else ie (Tk = UNOP) do + op := Oid; + Tk := scan(); + factor(); + gen(Ops[op][OCODE], 0); + end + else ie (Tk = LPAREN) do + Tk := scan(); + expr(0); + xrparen(); + end + else do + aw("syntax error", Str); + end +end + +emitop(stk, p) do + gen(Ops[stk[p-1]][OCODE], 0); + return p-1; +end + +arith() do var stk[10], p; + factor(); + p := 0; + while (Tk = BINOP) do + while (p /\ Ops[Oid][OPREC] <= Ops[stk[p-1]][OPREC]) + p := emitop(stk, p); + stk[p] := Oid; + p := p+1; + Tk := scan(); + factor(); + end + while (p > 0) + p := emitop(stk, p); +end + +conjn() do var n; + arith(); + n := 0; + while (Tk = CONJ) do + Tk := scan(); + gen(CG_JMPFALSE, 0); + clear(); + arith(); + n := n+1; + end + while (n > 0) do + gen(CG_RESOLV, 0); + n := n-1; + end +end + +disjn() do var n; + conjn(); + n := 0; + while (Tk = DISJ) do + Tk := scan(); + gen(CG_JMPTRUE, 0); + clear(); + conjn(); + n := n+1; + end + while (n > 0) do + gen(CG_RESOLV, 0); + n := n-1; + end +end + +expr(clr) do + if (clr) clear(); + disjn(); + if (Tk = COND) do + Tk := scan(); + gen(CG_JMPFALSE, 0); + expr(1); + expect(COLON, "':'"); + Tk := scan(); + gen(CG_JUMPFWD, 0); + swap(); + gen(CG_RESOLV, 0); + expr(1); + gen(CG_RESOLV, 0); + end +end + +halt_stmt() do + Tk := scan(); + gen(CG_HALT, constval()); + xsemi(); +end + +return_stmt() do + Tk := scan(); + if (Fun = 0) + aw("can't return from main body", 0); + ie (Tk = SEMI) + gen(CG_CLEAR, 0); + else + expr(1); + if (Lp \= 0) do + gen(CG_DEALLOC, -Lp); + end + gen(CG_EXIT, 0); + xsemi(); +end + +if_stmt(alt) do + Tk := scan(); + xlparen(); + expr(1); + gen(CG_JMPFALSE, 0); + xrparen(); + stmt(); + if (alt) do + gen(CG_JUMPFWD, 0); + swap(); + gen(CG_RESOLV, 0); + expect(KELSE, "ELSE"); + Tk := scan(); + stmt(); + end + gen(CG_RESOLV, 0); +end + +while_stmt() do var olp, olv; + Tk := scan(); + olp := Loop0; + olv := Lvp; + gen(CG_MARK, 0); + Loop0 := tos(); + xlparen(); + expr(1); + xrparen(); + gen(CG_JMPFALSE, 0); + stmt(); + swap(); + gen(CG_JUMPBACK, 0); + gen(CG_RESOLV, 0); + while (Lvp > olv) do + push(Leaves[Lvp-1]); + gen(CG_RESOLV, 0); + Lvp := Lvp-1; + end + Loop0 := olp; +end + +for_stmt() do + var y; + var step; + var oll, olp, olv; + var test; + + Tk := scan(); + oll := Llp; + olv := Lvp; + olp := Loop0; + Loop0 := 0; + xlparen(); + xsymbol(); + y := lookup(Str, 0); + if (y[SFLAGS] & (CNST|FUNC|FORW)) + aw("unexpected type", y[SNAME]); + Tk := scan(); + xeqsign(); + expr(1); + store(y); + expect(COMMA, "','"); + Tk := scan(); + gen(CG_MARK, 0); + test := tos(); + load(y); + expr(0); + ie (Tk = COMMA) do + Tk := scan(); + step := constval(); + end + else do + step := 1; + end + gen(step<0-> CG_FORDOWN: CG_FOR, 0); + xrparen(); + stmt(); + while (Llp > oll) do + push(Loops[Llp-1]); + gen(CG_RESOLV, 0); + Llp := Llp-1; + end + ie (y[SFLAGS] & GLOBF) + gen(CG_INCGLOB, y[SVALUE]); + else + gen(CG_INCLOCL, y[SVALUE]); + gen(CG_WORD, step); + swap(); + gen(CG_JUMPBACK, 0); + gen(CG_RESOLV, 0); + while (Lvp > olv) do + push(Leaves[Lvp-1]); + gen(CG_RESOLV, 0); + Lvp := Lvp-1; + end + Loop0 := olp; +end + +leave_stmt() do + Tk := scan(); + if (Loop0 < 0) + aw("LEAVE not in loop context", 0); + xsemi(); + if (Lvp >= MAXLOOP) + aw("too many LEAVEs", 0); + gen(CG_JUMPFWD, 0); + Leaves[Lvp] := pop(); + Lvp := Lvp+1; +end + +loop_stmt() do + Tk := scan(); + if (Loop0 < 0) + aw("LOOP not in loop context", 0); + xsemi(); + ie (Loop0 > 0) do + push(Loop0); + gen(CG_JUMPBACK, 0); + end + else do + if (Llp >= MAXLOOP) + aw("too many LOOPs", 0); + gen(CG_JUMPFWD, 0); + Loops[Llp] := pop(); + Llp := Llp+1; + end +end + +asg_or_call() do var y, b; + clear(); + y := address(1, @b); + ie (Tk = LPAREN) do + fncall(y); + end + else ie (Tk = ASSIGN) do + Tk := scan(); + expr(0); + ie (y = 0) + gen(b-> CG_STINDB: CG_STINDR, 0); + else ie (y[SFLAGS] & (FUNC|FORW|CNST|VECT)) + aw("bad location", y[SNAME]); + else + store(y); + end + else do + aw("syntax error", Str); + end + xsemi(); +end + +stmt() ie (Tk = KFOR) + for_stmt(); + else ie (Tk = KHALT) + halt_stmt(); + else ie (Tk = KIE) + if_stmt(1); + else ie (Tk = KIF) + if_stmt(0); + else ie (Tk = KELSE) + aw("ELSE without IE", 0); + else ie (Tk = KLEAVE) + leave_stmt(); + else ie (Tk = KLOOP) + loop_stmt(); + else ie (Tk = KRETURN) + return_stmt(); + else ie (Tk = KWHILE) + while_stmt(); + else ie (Tk = KDO) + compound(); + else ie (Tk = SYMBOL) + asg_or_call(); + else ie (Tk = SEMI) + Tk := scan(); + else + expect(%1, "statement"); + +compound() do var oyp, olp, onp, msg; + msg := "unexpected end of compound statement"; + Tk := scan(); + oyp := Yp; + onp := Np; + olp := Lp; + while (Tk = KVAR \/ Tk = KCONST \/ Tk = KSTRUCT) + declaration(0); + while (Tk \= KEND) do + if (Tk = ENDFILE) aw(msg, 0); + stmt(); + end + Tk := scan(); + if (olp-Lp \= 0) + gen(CG_DEALLOC, olp-Lp); + Yp := oyp; + Np := onp; + Lp := olp; +end + +checkclass() + if (\str_equal(Str, "t3x")) + aw("class name must be T3X", Str); + +module_decl() do + Tk := scan(); + xsymbol(); + Tk := scan(); + xlparen(); + xsymbol(); + checkclass(); + Tk := scan(); + xrparen(); + xsemi(); +end + +object_decl() do + Tk := scan(); + xsymbol(); + if (\str_equal(Str, "t")) + aw("object name must be T", Str); + Tk := scan(); + expect(LBRACK, "'['"); + Tk := scan(); + expect(SYMBOL, "symbol"); + checkclass(); + Tk := scan(); + expect(RBRACK, "']'"); + Tk := scan(); + xsemi(); +end + +program() do var i; + Tk := scan(); + if (Tk = KMODULE) module_decl(); + if (Tk = KOBJECT) object_decl(); + while ( Tk = KVAR \/ Tk = KCONST \/ Tk = SYMBOL \/ + Tk = KDECL \/ Tk = KSTRUCT + ) + declaration(GLOBF); + if (Tk \= KDO) + aw("DO or declaration expected", 0); + gen(CG_ENTER, 0); + compound(); + if (Tk \= ENDFILE) + aw("trailing characters", Str); + gen(CG_HALT, 0); + for (i=0, Yp, SYM) + if (Syms[i+SFLAGS] & FORW /\ Syms[i+SVALUE]) + aw("undefined function", Syms[i+SNAME]); +end + +! +! Main +! + +init() do + var i; + var tcomp, tcopy, tfill, tscan; + var tcreate, topen, tclose, tread, twrite; + var trename, tremove; + + Rp := 0; + Tp := 0; + Dp := 0; + Lp := 0; + Sp := 0; + Yp := 0; + Np := 0; + Pp := 0; + Hp := 0; + Line := 1; + Acc := 0; + Fun := 0; + Loop0 := %1; + Lvp := 0; + Llp := 0; + Codetbl := [ + [ CG_PUSH, "50" ], + [ CG_CLEAR, "31c0" ], + [ CG_LDVAL, "b8,w" ], + [ CG_LDADDR, "b8,a" ], + [ CG_LDLREF, "8d85,w" ], + [ CG_LDGLOB, "a1,a" ], + [ CG_LDLOCL, "8b85,w" ], + [ CG_STGLOB, "a3,a" ], + [ CG_STLOCL, "8985,w" ], + [ CG_STINDR, "5b8903" ], + [ CG_STINDB, "5b8803" ], + [ CG_INCGLOB, "8105,a" ], + [ CG_INCLOCL, "8185,w" ], + [ CG_ALLOC, "81ec,w" ], + [ CG_DEALLOC, "81c4,w" ], + [ CG_LOCLVEC, "89e050" ], + [ CG_GLOBVEC, "8925,a" ], + [ CG_INDEX, "c1e0025b01d8" ], + [ CG_DEREF, "8b00" ], + [ CG_INDXB, "5b01d8" ], + [ CG_DREFB, "89c331c08a03" ], + [ CG_MARK, ",m" ], + [ CG_RESOLV, ",r" ], + [ CG_CALL, "e8,w" ], + [ CG_JUMPFWD, "e9,>" ], + [ CG_JUMPBACK, "e9,<" ], + [ CG_JMPFALSE, "09c00f84,>" ], + [ CG_JMPTRUE, "09c00f85,>" ], + [ CG_FOR, "5b39c30f8d,>" ], + [ CG_FORDOWN, "5b39c30f8e,>" ], + [ CG_ENTER, "5589e5" ], + [ CG_EXIT, "5dc3" ], + [ CG_HALT, "68,w5031c040cd80" ], + [ CG_NEG, "f7d8" ], + [ CG_INV, "f7d0" ], + [ CG_LOGNOT, "f7d819c0f7d0" ], + [ CG_ADD, "5b01d8" ], + [ CG_SUB, "89c35829d8" ], + [ CG_MUL, "5bf7eb" ], + [ CG_DIV, "89c35899f7fb" ], + [ CG_MOD, "89c35899f7fb89d0" ], + [ CG_AND, "5b21d8" ], + [ CG_OR, "5b09d8" ], + [ CG_XOR, "5b31d8" ], + [ CG_SHL, "89c158d3e0" ], + [ CG_SHR, "89c158d3e8" ], + [ CG_EQ, "5b39c30f95c20fb6c248" ], + [ CG_NEQ, "5b39c30f94c20fb6c248" ], + [ CG_LT, "5b39c30f9dc20fb6c248" ], + [ CG_GT, "5b39c30f9ec20fb6c248" ], + [ CG_LE, "5b39c30f9fc20fb6c248" ], + [ CG_GE, "5b39c30f9cc20fb6c248" ], + [ CG_WORD, ",w" ], + [ %1, "" ] ]; + tcomp := + "8b74240c8b7c24088b4c240441fcf3a609c90f850300000031c0c38a46ff2a47ff669898c3"; + tcopy := "8b7c240c8b7424088b4c2404fcf3a431c0c3"; + tfill := "8b7c240c8b4424088b4c2404fcf3aa31c0c3"; + tscan := + "8b7c240c8b4424088b4c24044189fafcf2ae09c90f840600000089f829d048c331c048c3"; + tcreate := + "68a40100006801060000ff74240c6a00b805000000cd800f830300000031c04883c410c3"; + topen := "8b4424048744240889442404b805000000cd800f830300000031c048c3"; + tclose := "b806000000cd800f830300000031c048c3"; + tread := "8b4424048744240c89442404b803000000cd800f830300000031c048c3"; + twrite := "8b4424048744240c89442404b804000000cd800f830300000031c048c3"; + trename := + "8b4424048744240889442404b880000000cd800f830300000031c048c3"; + tremove := "b80a000000cd800f830300000031c048c3"; + Ops := [[ 7, 3, "mod", BINOP, CG_MOD ], + [ 6, 1, "+", BINOP, CG_ADD ], + [ 7, 1, "*", BINOP, CG_MUL ], + [ 0, 1, ";", SEMI, 0 ], + [ 0, 1, ",", COMMA, 0 ], + [ 0, 1, "(", LPAREN, 0 ], + [ 0, 1, ")", RPAREN, 0 ], + [ 0, 1, "[", LBRACK, 0 ], + [ 0, 1, "]", RBRACK, 0 ], + [ 3, 1, "=", BINOP, CG_EQ ], + [ 5, 1, "&", BINOP, CG_AND ], + [ 5, 1, "|", BINOP, CG_OR ], + [ 5, 1, "^", BINOP, CG_XOR ], + [ 0, 1, "@", ADDROF, 0 ], + [ 0, 1, "~", UNOP, CG_INV ], + [ 0, 1, ":", COLON, 0 ], + [ 0, 2, "::", BYTEOP, 0 ], + [ 0, 2, ":=", ASSIGN, 0 ], + [ 0, 1, "\\", UNOP, CG_LOGNOT ], + [ 1, 2, "\\/", DISJ, 0 ], + [ 3, 2, "\\=", BINOP, CG_NEQ ], + [ 4, 1, "<", BINOP, CG_LT ], + [ 4, 2, "<=", BINOP, CG_LE ], + [ 5, 2, "<<", BINOP, CG_SHL ], + [ 4, 1, ">", BINOP, CG_GT ], + [ 4, 2, ">=", BINOP, CG_GE ], + [ 5, 2, ">>", BINOP, CG_SHR ], + [ 6, 1, "-", BINOP, CG_SUB ], + [ 0, 2, "->", COND, 0 ], + [ 7, 1, "/", BINOP, CG_DIV ], + [ 2, 2, "/\\", CONJ, 0 ], + [ 0, 0, 0, 0, 0 ] ]; + Equal_op := findop("="); + Minus_op := findop("-"); + Mul_op := findop("*"); + Add_op := findop("+"); + i := 0; + while (Codetbl[i][0] \= %1) do + if (Codetbl[i][0] \= i) + oops("bad code table entry", ntoa(i)); + i := i+1; + end + builtin("t.memcomp", 3, tcomp); + builtin("t.memcopy", 3, tcopy); + builtin("t.memfill", 3, tfill); + builtin("t.memscan", 3, tscan); + builtin("t.create", 1, tcreate); + builtin("t.open", 2, topen); + builtin("t.close", 1, tclose); + builtin("t.read", 3, tread); + builtin("t.write", 3, twrite); + builtin("t.rename", 2, trename); + builtin("t.remove", 1, tremove); +end + +do + init(); + readprog(); + program(); + ! 16-byte align in file + Tp := align(HEADER_SIZE+Tp, 16)-HEADER_SIZE; + relocate(); + elfheader(); + t.write(1, Header, Hp); + t.write(1, Text_seg, Tp); + t.write(1, Data_seg, Dp); +end diff --git a/t3x9r3-extended/t.vm b/t3x9r3-extended/t.vm new file mode 100755 index 0000000000000000000000000000000000000000..834f5c02fecf262a3c9e91fd4e1c2bdac0b46e92 GIT binary patch literal 19335 zcmb_k4|r77m4B0&kO6~6KyMV#;g5#e2vJZ`sRavaUAodOZD~bxl9@p4BomSee=60- z6UGUJD8e?A5dkGw!qNeiezmPzZRPt)TUyhWwsebbc9-3CjlW`DnP@0)oO zW4rr(JN5GJJ@?#m&%b-_x%a(v#+`;>l()`pS$Ab!3CDJ;X=zwmspnd zRrB!aR*8Q2^&_AkrTQ^OKg#qYs2^kXW8C;Be3tbDN$-d}VSNbH{|M@PcLa6>l0nUno~xTAa@`mU6|avRu+a;v?OWgkXrvE~>zmek~4N}jY zr=@di4mP*d1Y!j2&Q}EZXoXVcI6tBumw?*qqE zWyUE2uGQG0JJrSpmHlC2Y#kySPUOW*1*y*?z5^z|Em&LWn6}{Tglz2w+t>XVhk*u7 zyVrvSdmP;PBsB&?dFsAnn)+fxUDavodT!rAq2{5YDa1)(N5ITkVrVRPX>@x3_-h{tf%CU_1YCI>xO4D@%oxm1U%dGR$|J7jgo}DU|H4xj1Ibxb1pO@W z$M?;~x{iR^@fB65twAmQ86#0lWbk7-a8+6_W^O{qRw9ED0J?WR35vD~ze7`H%00b1 zI|BQN!@*tOf(jf95aIpPnmXO4le!5Q@>x;7KOyAHZIuwJ5)Wja9?W%A@ik2vxVgVs{bl{wQF7wLZntAOC^~zx*KoL z_gNJuF>t(Pp>`@?>qTwH%!<=^q;IFNrDsvKvAy_QMGg``wqE&f@?XlqwxBVvZPNo_ zh%%0Zmwtj|N`~<-x_j)-9&rR0U^~ID0JwVuumV8!$OvF1fe#80bRA*ujBr!ZZ965} z+^+V@Z!>Ie(`-^&yHumYo9WC>BAdbHX&IIS2h(HO>JyTIgYBi>F+Lg7ZYY#=mys0M z_?)mIN=TOP!XAM(1>L3<1J{Qx3UHCv(^pc|2eCbU{-QoezYX)9$kOi#r$YI8iX+n->w?%MmL#+bXkQHDh1WTY^SD5AM`1pU(74owG z{~1|pSJ)e&T>~3cyZOFRw43ky6WY}{qFqxh(rzB+(QY1Aq}>ltZw#BaGOPq7Y|`;+ z4(>}|fIim42aytW(-vpLi>TG6_Y5Qo(_1Vl- zBsQ42NYhkHBpjwC@?iEa=w_LBP&k{p%wVsQZYN=@BO38dcF=K2{nObz*&B5CE8gzL zY-R%5dJU-$4^hta(_W0*vY9CbjH!ab`0;Bl%s_gr7k5E6GZk(1Nnq)q0__A2+Ugq` zd9fF{C7WTkq-FtG05IwJ1rLbr}~vTty+XK;khJYdNIlr4tPTjpSQYN#+w=Lkc# zdW#werf(i)^nUT6KRJ55SZ#X_fyV0kECr|LK8n^}r&2baZ-}z6*&+LNDh`XyB<#sv zrS7GNm2+vq$;6|B&ZW}W>}q);slhzSU^fcr9DKHiN|gMw^gQk3%rx8ZQrB}9{hnf# za&NQ+N5@KyjabPFXh>Ejvt!-T@lD^g%c@MV7lP@*R`xJ`Mi;8*g% z)p=k=0r*#WU}XXLApwFe6S%$p2)S1=0s0ftxL+E2t#mrNA)#I8;Q?fdk`-(M_IMjq zDz>Ahbpw@_60S1>TYddMsq3;W0G0BeqD+2zcU>= zLLfeDzzAY8&3MypHSLgTV;M^SSkqo-+80P0|45?E2({PM*Fn)2)cv%P^>z3?15_p@ za@tNP`;>Sl#2TBG0|O--mwieO7^sdnTZ%v>Nz#Wy7~?UX64fRl*>x1^;?QXx9SW(V zIs-=6@KKRl-K|Hwi4k3E@sIF*2CH13uDR9JWivdrVlnt%riZBC4bX8i$crs!0Ip$T=|P=DJpW07AM?N`7LkAfT@t;5y48bviI6xW@J0{((jpSDxy$fb zLA~9Bs)|t86j1vFRe4Y=i%=U1jGY(M{@)bTaJewnFYwbI_+>>TVg(Wdg4*Ljoh&4V z1isS)pHf5u8@sC>3vtm_^&ZqxArTPxUwYtEi%7%^GM5YL3=irRMX1dM)JcLm^dAM8 zuPj2vigA@bMNog}K@An5Vlla>GX?co59+icRIDo(wOUZudr+qrp(5XMQELQssRwli zQSl#^-&ibj*>t(rG9hq=%XUNSrH82cWX??hcuB_7>_~WW==sc&5%3Zw3`1Bf$zV1! zgDW7XX);E$2OZngo7jOfnR}UdI&@u>Vis#??qd(}MaR5Oa?emYm@Z#F?DknUP?Yc@1bZGC_|C=qbs+krIALrq6Jvhh`;V zWX|zoCX^>l%TdQMkB(Q#JOv#mb8?qSld7ELyj_pej(N+0fcgWDVj7|jKnh&B3?>Ib z`luw4L}~|B7|3r1S7kG4xH1yl0VALT&_eKzW6FS9 zE36c_@URJ8sD(o8fWFPyMDdssIRB0*g3h>9KYg+$E6Pz<3n@Z2;EclwDpLKb!iB0q zY9w$#5^`dNkL8)He_qePJVj;*=^3oDC*Uq*(g{Wy8#x`kCW4JQ;V(T~2zw3DF+ zgFo<`;5t5SF{dho zGAL5P3OV`|FF198EKLKZ)##Mk{z?+kSKL8$5)rSAV?bak2{;wDe+n^FgdrfPo_i0* zc-tQmjN3KFmiJ&>Wcz0dMo44SdN3x+ESBw`B^d8=^)j=T8yY#@X%T$c%%wmTcS+^c zl`aWnxxsx#Oz7)s;z%IC{h9i>I0sx|0ICV~oFs6B@mp_%)}MiEU6o=#7);4+H2FSABpj|4!oOtI1EBhPG#Tn;7*QJ!aVivor39;bCGD~EyTRqOGK$&N)iB7Yv;TxamX6-_G#pWtadw=V(}(r!nE#lIp_Yv{ z@z=S0IB_bEw;2;N3WMQgWVmwVIH*!>mT^?7y{e{5%{=rjWU^`<1X``Nrq|&AeBoFh&cz;LoU(Lbh66r>^dOk zl&nss+QaZ^-qazxE5UmT2dV(oz;oSpQOA=9+qVxQ)wQ}_A(3-t&Es`d3zdmBQ*I;d zlUP}>-GE)d`^r&yneX4U5cVb5Vut>;e-K2W=0Se8r(KUMz$y+4h)bJSb?vGG@oWSV z8K-wRSI8Ruk;zxe2C?;bzBtLUaL36yErS@8)%{mW;~Cx1mwmgXk?hwm$j-}~Jd9;1 z>X?Gnx*j6C8$Qw?Ibh(Z@KvycpvE_s#tst-o%`Xj=)9%SIjzv?lQln zlYz9tb%Kl#;(FdiM>C%U8VGfM5!noKe8zZen8c#H0=b^dEX?dE zAtgt^@9U)uJ-D6&-#*wbn)cv{Phs_!;&nl%S^dz~QJv;rDDj6I+C$Q(-sFQ}yBX7& z!=G$%Sd#FA;G68u-;?v;nU)?!Gd?Y7 zUC_rc-Xxdrll$zq-AUCJT%n2&VAc9_3#qGFa?`9HbbB;g`U=69d5Cm zWoq@B+daDYd$|V$wD?RuC6v!89Jt3@h{})af3bD8xzrphcpl5m{re0U?P4j~uPw$;LzNA^yOX4U2uwqzB%9&3SQuxF{6R3>5%7-p<;SawUAEGX7APT~9l^o9 z*a1eTkp7FpxGUc?ZYJh_pK;=h3urOJ=jVUrF`AnNNJxqyG4#6Rg(f5|_l#a3qr1*x zLb0?Cpb=uwBc@6>9d-*rs+VsoBpq>MZOTRc?ccFW{SlWHdQu(_WcBkiwq$M(udj@j zhZt|)V!RC)Um(Q6kxQ0*1cyH?cI*>#I7WMm#&}*{2zfy6l0nG&8pi~;5BV^tD+Sj~ z4qjM^^XxwP7ja6`pM0Fec}4*fM^b_$PChHyR+_J4oiPRQ7X|#j1j-7SVGjZMq)pSk z+a*x0^CxXODmZkOJR^~P1v!)GO?;HvDCrT$lw?hR1L)sPWfMWt2K$#Bt1bd@Bw+-L z5O4e=!Ra`J$kWn0pMJ^BcdA*Ph8!xQS0nV&H*z2|#Ozblk69+=MT-r`DG6-5Fc&6K z&%x0<0`G^)iJn`vYu?Fazg2 zMH*_ZoSRgei_O62TnucyQq~#PpOJ*lu<98#g% ziRRx>Fcz74PTR>|tOhd=I$p@&ykR8;u9}9$mc3oaQ4tu9F;q{xjOtGHDxT}LmVOPx zcYT3~poq5{9y(XMbg(9dJ8Hl=U5B?8w*lZucgAHiv(cmKT&m9HqUmqGK}OU?kY8QE zDd05n9^`~+U_N@S`RHN0pbHW|(8QLAYZ!U)ikg7#w< zt&}HG%xF$-gXD=`-u)A@Wu(H32HBGJf%P59N#t`KCYuBA(j4act8i8kz%vLSI)l;2 z+wVw2bwXyavQ=2Q!(~N13ot3}6^h1J9@j$-p--(t_<`o(v6i{%SgU)l`DtEF_v`sC zvHcadQ@?w8ND8VxoD#HSUk4&acXI_7ocw^Ca1T%~xp<{RPz<8DwUFV%xkR*5qNlqb z$|+;NT-}i6e}9KcP$iT=Tl^O~9eWLXr1~Q8oy&y6s{%IjzbFlv0@o_fXXJY$z9FzR zOja_!0QxbBn=y}g#-P89{B?a@+*w$X!%0nvk;lCxQhi8LME=qs1sc?H^=m2dQcQ~z zg0d7}ITRA4VQ~b#0mva9*G>3hi3fR|KU7l9vOORUsaUV5d#yX2dJt=$8shz>oZ!{1 zvJE=;zF`)JsvKM&7P`$HVs!l_on8G71XJfhUwwyX$^e~He+_7y6K|3EowwR}9_!u};lX09A)!4~FV~7A0Wowu*#0(1O z8sZN+Q=&Qi_w@hYFFJ-qjmCJ3yrT6t8l0n05NON1TJ-DUB?XDwqi=n~o zIdUs8<4%l$i*Lcj=zd&>6(@g8)9Jmh^G-I9K1fFNfjN-PY(YycLFOa^Q@hV1kJA@j z2+1Li9nzjVPJ8ZHvBBph6G|^+Kle_0n;bEi*CWBe+T{M}-$EIQA?KCeQ)EtmQwxq> z{H<^#Im~V%nl!6N(A00S9wnH3%m+aY&&u2f?)z_KKi8wfz$*>>A+Vpmya2zt)?MGh56bqLe^WQT=qNa$=qPCJZ|OY0!S;iTs_z!^ zkxP$iRu^DP?Lt@_R=;?|Fo&=xliMK5-?Pr4 z5ZYz@uZnzS-{*(}I&nYY@u*Kr2gV?xAjB+pSx|#m>xy}qs7pP=W*`3PJU~{f^BsrT z5yn5Dv0rFZ(`5wHU&PmVx zx`*#;)t-Dej=TY!g79gG?snWB^)dipaw*pg^LV$zxX4s}gi?QmJq+jy1DaK^8q7Tx zQW^x9`>H~#_*P)zsIGw3b`F~wT;XpDL?@XKDS~92-tz5})RTEjF-x|2RsT+&FMRbV zpl)|4};SWv_m+)@p!Xhxs4IM*n=0F5v6W zv#*gkw&(m9)b%X*mt6ldCHW=e<}`&T(ii?M3m$wag9op^@Zg&g$C5vU!y~3!&AN{t z1^9|QhL zeDwRL@NwQhlaF)$YCih>^Y}RHU%tA*^$Q}Ym{$A8L z%-=^U+^c?qa~LlmE=DBLw~cZ-qci!3h=jWeL<)5+J)qnlz+I|vEjQsw?x0`l3(^S1g24Vot)+@_tg)sHl2fs55=t8Z%1VwcugTOHD%r7q|U zzSh>DXW;j$4~(iia##WK8NLGzbP*>gZlxYZ(xPI( z!CvqAh92qYYm|o2Q_!#b_HlI{+AC1~wZ_KXEx zL?fZZ#^$J%h{r>X;iiqD){Tv|@mQ!S+!$>IUQ4tvW&{qq|4+X}bVDN48eQEOZAyel zthQk_3A99G@w#xLA>I_KZL6=3ws>TWgcIS>#?*!*p}Ke^%JIutxjD2Z8ipo>a4g;g z$}@`p{M_Q-pA-N8`fF~9uWku9=2@L2KHg%j3CDV`yXC|nOm3sqfJMOvfx)ofrVJ#uxCh70&rRaK#ercm9Qa7!3oC47N@PLrRP^hf)J zTvtSA)rYFAs#{TJp?sjq@NQY6^Dz8oT{zYjEsSVr0-zxhYHj#D)nirNR|P(cVQxFz z(vaZyHuY^yb>eN2c(hfN))-FItqCn&@)4dJth#V4M&&ido33?n{}jA+V^bo$L9bKd zt#5(*g__zLYw61Mp>WIUHu^jl3}vdix5}y$IV`JoVslI`IWOsqoO@)u>K4cxZmLRzw0DQ13U~>Us<--*>aPE9e5~NmZ={@%>dmmH}E|6dh%HfrDB+uk2w7wy+ zCJu{ybP3~c!qqk6wpAAkx59rADMO8It%*==G=vZXp1_x0(<3?or|tE6)OuTdPY9N0 z6v4s~rz|XnL`%3K#ub!bRjtsEiN~RWXV!2d!EY(jtD5Whmr$0qg7xdGu}fIIz_uc6 z&#ex#%}gu7_B`DmKzj?@H|YLSw0E<8qwXJrb~oEM>HadbkFz~r_w)Z;;{@A?u6&b! znsv;?J*$uPT0QOpwENkv)8op~&aoZQZN3XCUyOECx0yyxVH+`&2d!$UXhzy=C#M(L%q7uvMxb=1M7%Vyh_?aoSUjYjjE+k zo?v@^HPR}};zySI*}l1&Z!@jSP>!)3*8Mzozsh#4Zcj$Lm+d;;=DU(Uwj;Vd73~4G z5v{I3-GbL&2l;rPQI7icHCpx%+LdfWzGVjc2LM|~dakZ%U+3t5MJGf`j4`VE$K z73wQk$D75gQID{G6Z{SJX4dC}9_pJ|hs{2KdWv<}>>AW}vtDaiA4GjW>vhl->PJ|Q zSQd}KFR>oAtl6laU>!2>gxHJvT=*kh@+|A%AOBhBSqK04&l+SM{Nq2%x&ySKd5B<@ zqs|}F&f!Ybm%%qyqQp=(p=?LlgK`ArWt3AWXHd?e459>}*GVWdQEE^YqAW#Off7M! zM%jdtLP?_>LU{@0B+40-^C&|o0q|FW5<;m)nUAs?C{I{Wp0J)g zWnD9;;M(+~EWZ7o*MfcZ&!9 zGT>#VeT(TRLHjh|)H#2*PyqZ0?*}{}E%=goa^Ap4HT@Z=uf#$kjQCRkXWZm(CFqbh z!sh`_8M)>dm`IajmKr$M-vZzhPW*_0)6o`S0LK!($-rq_20WL}ZUd)--sYim#K7sO zw_$)w=Y)YXHn6z' Expression ':' Expression + ; + +Disjunction: + Conjunction + | Conjunction '/\\' Disjunction + ; + +Conjunction: + Equation + | Equation '\\/' Conjunction + ; + +Equation: + Relation + | Relation '=' Equation + | Relation '\\=' Equation + ; + +Relation: + BitOperation + | BitOperation '<' Relation + | BitOperation '>' Relation + | BitOperation '<=' Relation + | BitOperation '>=' Relation + ; + +BitOperation: + Sum + | Sum '&' BitOperation + | Sum '|' BitOperation + | Sum '^' BitOperation + | Sum '<<' BitOperation + | Sum '>>' BitOperation + ; + +Sum: + Term + | Term '+' Sum + | Term '-' Sum + ; + +Term: + Factor + | Factor '*' Term + | Factor '/' Term + | Factor MODULO Term + ; + +Factor: + INTEGER + | FunctionCall + | STRING + | Table + | SYMBOL + | SYMBOL Subscripts + | '@' SYMBOL + | '@' SYMBOL Subscripts + | '-' Factor + | '\\' Factor + | '~' Factor + | '(' Expression ')' + ; + +Subscripts: + '[' Expression ']' + | '[' Expression ']' Subscripts + | '::' Factor + ; + +Table: + '[' MemberList ']' + ; + +MemberList: + TableMember + | TableMember ',' MemberList + ; + +TableMember: + ConstValue + | STRING + | Table + | '(' ExprList ')' + ; + +FunctionCall: + SYMBOL '(' ')' + | SYMBOL '(' ExprList ')' + ; + +ConstValue: + SYMBOL + | Integer + ; + +Integer: + INTEGER + | CHARACTER + ; +%% + diff --git a/t3x9r3-extended/t3x.txt b/t3x9r3-extended/t3x.txt new file mode 100644 index 0000000..a92415b --- /dev/null +++ b/t3x9r3-extended/t3x.txt @@ -0,0 +1,768 @@ + + + ################ ############ ###### ###### + ## ## ## ## ## ## ## ## + ###### ###### ####### ## ## ### ## + ## ## ## ## ## ## + ## ## ####### ## ## ### ## + ## ## ## ## ## ## ## ## + ######## ############ ###### ###### + + ----==[ A MINIMAL PROCEDURAL LANGUAGE ]==---- + + + PROGRAM + *-------* + + A program is a set of declarations followed by a compound + statement. Here is the minimal T3X program: + + DO END + + + COMMENTS + *--------* + + A comment is started with an exclamation point (!) and extends + up to the end of the current line. Example: + + DO END ! Do nothing + + + DECLARATIONS + *------------* + + -----[ CONST name = cvalue, ... ; ]----------------------------- + + Assign names to constant values. + + Example: CONST false = 0, true = %1; + + + VAR name, ... ; + -----[ VAR name[cvalue], ... ; ]-------------------------------- + VAR name::cvalue, ... ; + + Define variables, vectors, and byte vectors, respectively. + Different definitions may be mixed. Vector elements start at + an index of 0. + + Example: VAR stack[STACK_LEN], ptr; + + -----[ STRUCT name = name_1, ..., name_N; ]--------------------- + + Shorthand for CONST name_1 = 0, ..., name_N = N-1, name = N; + Used to impose structure on vectors and byte vectors. + + Example: STRUCT POINT = PX, PY, PCOLOR; + VAR p[POINT]; + + + -----[ DECL name(cvalue), ... ; ]------------------------------- + + Declare functions whose definitions follow later, where the + cvalue is the number of arguments. Used to implement mutual + recursion. + + Example: DECL odd(1); + even(x) RETURN x=0-> 1: odd(x-1); + odd(x) RETURN x=1-> 1: even(x-1); + + + -----[ name(name_1, ...) statement ]---------------------------- + + Define function "name" with arguments "name_1", ... and a + statement as its body. The number of arguments must match + any previous DECL of the same function. + + The arguments of a function are only visible within the + (statement) of the function. + + Example: hello(s, x) DO VAR i; + FOR (i=0, x) DO + writes(s); + writes("\n"); + END + END + + (Writes() writes a string; it is defined later in this text.) + + + STATEMENTS + *----------* + + -----[ name := expression; ]------------------------------------ + + Assign the value of an expression to a variable. + + Example: DO VAR x; x := 123; END + + + -----[ name[value]... := value; ]------------------------------- + name::value := value; + + Assign the value of an expression to an element of a vector + or a byte vector. Multiple subscripts may be applied to to a + vector: + + vec[i][j]... := i*j; + + In general, VEC[i][j] denotes the j'th element of the i'th + element of VEC. + + Note that the :: operator is right-associative, so v::x::i + equals v::(x::i). This is particularly important when mixing + subscripts, because + + vec[i]::j[k] := 0; + + would assign 0 to the j[k]'th element of vec[i]. (This makes + sense, because vec[i]::j would not deliver a valid address.) + + + -----[ name(); ]------------------------------- + name(expression_1, ...); + + Call the function with the given name, passing the values of the + expressions to the function. An empty set of parentheses is used + to pass zero arguments. The result of the function is discarded. + + For further details see the description of function calls in the + expression section. + + + -----[ IF (condition) statement_1 ]------------------- + IE (condition) statement_1 ELSE statement_2 + + Both of these statements run statement_1, if the given + condition is true. + + In addition, IE/ELSE runs statement_2, if the conditions is + false. In this case, IF just passes control to the subsequent + statement. + + Example: IE (0) + IF (1) RETURN 1; + ELSE + RETURN 2; + + The example always returns 2, because only an IE statement can + have an ELSE branch. There is no "dangling else" problem. + + + -----[ WHILE (condition) statement ]---------------------------- + + Repeat the statement while the condition is true. When the + condition is not true initially, never run the statement. + + Example: ! Count from 1 to 10 + DO VAR i; + i := 0; + WHILE (i < 10) + i := i+1; + END + + + ---[ FOR (name=expression_1, expression_2, cvalue) statement ]-- + FOR (name=expression_1, expression_2) statement + + Assign the value of expression_1 to name, then compare name to + expression_2. If cvalue is not negative, repeat the statement + while name < expression_2. Otherwise repeat the statement while + name > expression_2. After running the statement, add cvalue + to name. Formally: + + name := expression_1; + WHILE ( cvalue > 0 /\ name < expression \/ + cvalue < 0 /\ name > expression ) + DO + statement; + name := name + cvalue; + END + + When the cvalue is omitted, it defaults to 1. + + Examples: DO VAR i; + FOR (i=1, 11); ! count from 1 to 10 + FOR (i=10, 0, %1); ! count from 10 to 1 + END + + + -----[ LEAVE; ]------------------------------------------------- + + Leave the innermost WHILE or FOR loop, passing control to the + first statement following the loop. + + Example: DO VAR i; ! Count from 1 to 50 + FOR (i=1, 100) IF (i=50) LEAVE; + END + + + -----[ LOOP; ]-------------------------------------------------- + + Re-enter the innermost WHILE or FOR loop. WHILE loops are + re-entered at the point where the condition is tested, and + FOR loops are re-entered at the point where the counter is + incremented. + + Example: DO VAR i; ! This program never prints X + FOR (i=1, 10) DO + LOOP; + T.WRITE(1, "x", 1); + END + END + + + -----[ RETURN expression; ]------------------------------------- + + Return a value from a function. For further details see the + description of function calls in the expression section. + + Example: inc(x) RETURN x+1; + + + -----[ HALT cvalue; ]------------------------------------------- + + Halt program and return the given exit code to the operating + system. + + Example: HALT 1; + + + -----[ DO statement ... END ]------------------- + DO declaration ... statement ... END + + Compound statement of the form DO ... END are used to place + multiple statements in a context where only a single statement + is expected, like selection, loop, and function bodies. + + A compound statement may declare its own local variables, + constant, and structures (using VAR, CONST, or STRUCT). A + local variable of a compound statement is created and + allocated at the beginning of the statement is ceases to + exist at the end of the statement. + + Note that the form + + DO declaration ... END + + also exists, but is essentially an empty statement. + + Example: DO var i, x; ! Compute 10 factorial + x := 1; + for (i=1, 10) + x := x*i; + END + + + -----[ DO END ]------------------------------------------------- + ; + + These are both empty statements or null statements. They do not + do anything when run and may be used as placeholders where a + statement would be expected. They are also used to show that + nothing is to be done in a specific situation, like in + + IE (x = 0) + ; + ELSE IE (x < 0) + statement; + ELSE + statement; + + Examples: FOR (i=0, 100000) DO END ! waste some time + + + EXPRESSIONS + *-----------* + + An expression is a variable or a literal or a function call or + a set of operators applied to one of these. There are unary, + binary, and ternary operators. + + Examples: -a ! negate a + b*c ! product of b and c + x->y:z ! if x then y else z + + In the following, the symbols X, Y, and Z denote variables or + literals. + + These operators exist (P denotes precedence, A associativity): + + +--------------------------------------------------------+ + | OPERATOR | P | A | DESCRIPTION | + |===========+============================================| + | X[Y] | 9 | L | the Y'th element of the vector X | + | X::Y | 9 | R | the Y'th byte of the byte vector X | + |-----------+---+---+------------------------------------| + | -X | 8 | - | the negative value of X | + | ~X | 8 | - | the bitwise inverse of X | + | \X | 8 | - | logical NOT of X | + | @X | 8 | - | the address of X | + |-----------+---+---+------------------------------------| + | X*Y | 7 | L | the product of X and Y | + | Y/Y | 7 | L | the integer quotient of X and Y | + | X mod Y | 7 | L | the division remainder of X and Y | + |-----------+---+---+------------------------------------| + | X+Y | 6 | L | the sum of X and Y | + | X-Y | 6 | L | the difference between X and Y | + |-----------+---+---+------------------------------------| + | X&Y | 5 | L | the bitwise AND of X and Y | + | X|Y | 5 | L | the bitwise OR of X and Y | + | X^Y | 5 | L | the bitwise XOR of X and Y | + | X<>Y | 5 | L | X shifted to the right by Y bits | + |-----------+---+---+------------------------------------| + | XY | 4 | L | %1, if X is less than Y, else 0 | + | X<=Y | 4 | L | %1, if X is less/equal Y, else 0 | + | X>=Y | 4 | L | %1, if X is greater/equal Y, else 0| + |-----------+---+---+------------------------------------| + | X=Y | 3 | L | %1, if X equals Y, else 0 | + | X\=Y | 3 | L | %1, if X does not equal Y, else 0 | + |-----------+---+---+------------------------------------| + | X/\Y | 2 | L | if X then Y else 0 | + | | | | (short-circuit logical AND) | + |-----------+---+---+------------------------------------| + | X\/Y | 1 | L | if X then X else Y | + | | | | (short-circuit logical OR) | + |-----------+---+---+------------------------------------| + | X->Y:Z | 0 | - | if X then Y else Z | + +--------------------------------------------------------+ + + Higher precedence means that an operator binds stronger, e.g. + -X::Y actually means -(X::Y). + + Left-associativity (L) means that x+y+z = (x+y)+z and + right-associativity (R) means that x::y::z = x::(y::z). + + + CONDITIONS + *----------* + + A condition is an expression appearing in a condition context, + like the condition of an IF or WHILE statement or the first + operand of the X->Y:Z operator. + + In an expression context, the value 0 is considered to be + "false", and any other value is considered to be true. For + example: + + X=X is true + 1=2 is false + "x" is true + 5>7 is false + + The canonical truth value, as returned by 1=1, is %1. + + + FUNCTION CALLS + *--------------* + + When a function call appears in an expression, the result of + the function, as returned by RETURN is used as an operand. + + A function call is performed as follows: + + Each actual argument in the call + + function(argument_1, ...) + + is passed to the function and bound to the corresponding formal + argument ("argument") of the receiving function. The function + then runs its statement, which may produce a value via RETURN. + When no RETURN statement exists in the statement, 0 is returned. + + Function arguments evaluate from the left to the right, so in + + f(a,b,c); + + A is guaranteed to evaluate before B and C and B is guaranteed + to evaluate before C. + + Example: pow(x, y) DO VAR a; + a := 1; + WHILE (y) DO + a := a*x; + y := y-1; + END + RETURN a; + END + + DO VAR x; + x := pow(2,10); + END + + + LITERALS + *--------* + + INTEGERS + + An integer is a number representing its own value. Note that + negative numbers have a leading '%' sign rather than a '-' sign. + While the latter also works, it is, strictly speaking, the + application of the '-' operator to a positive number, so it may + not appear in cvalue contexts. + + Integers may have a '0x' prefix (after the '%' prefix, if + that also exists). In this case, the subsequent digits will + be interpreted as a hexa-decimal number. + + Examples: 0 + 12345 + %1 + 0xfff + %0xA5 + + + CHARACTERS + + Characters are integers internally. They are represented by + single characters enclosed in single quotes. In addition, the + same escape sequences as in strings may be used. + + Examples: 'x' + '\\' + ''' + '\e' + + + STRINGS + + A string is a byte vector filled with characters. Strings are + delimited by '"' characters and NUL-terminated internally. All + characters between the delimiting double quotes represent + themselves. In addition, the following escape sequences may be + used to include some special characters: + + \a BEL Bell + \b BS Backspace + \e ESC Escape + \f FF Form Feed + \n LF Line Feed (newline) + \q " Quote + \r CR Carriage Return + \s Space + \t HT Horizontal Tabulator + \v VT Vertical Tabulator + \\ \ Backslash + + Examples: "" + "hello, world!\n" + "\qhi!\q, she said" + + + PACKED TABLES + + A packed table is a byte vector literal. It is a set of cvalues + delimited by square brackets and separated by commas. Note that + string notation is a short and portable, but also limited, + notation for byte vectors. For instance, the byte vectors + + "HELLO" + PACKED [ 'H', 'E', 'L', 'L', 'O', 0 ] + + are identical. Byte vectors can contain any values in the range + from 0 to 255. + + Examples: PACKED [ 1 ] + PACKED [ 1, 2, 3 ] + PACKED [ 14, 'H', 'i', 15 ] + + + TABLES + + A table is a vector literal, i.e. a sequence of values. It is + delimited by square brackets and elements are separated by + commas. Table elements can be cvalues, strings, and tables. + + Examples: [1, 2, 3] + ["5 times -7", %35] + [[1,0,0],[0,1,0],[0,0,1]] + + + DYNAMIC TABLES + + The dynamic table is a special case of the table in which one + or multiple elements are computed at program run time. Dynamic + table elements are enclosed in parentheses. E.g. in the table + + ["x times 7", (x*7)] + + the value of the second element would be computed and filled + in when the table is being evaluated. Note that dynamic table + elements are being replaced in situ, and remain the same only + until they are replaced again. + + Multiple dynamic elements may be enclosed by a single pair of + parentheses. For instance, the following tables are the same: + + [(x), (y), (z)] + [(x, y, z)] + + + CVALUES + *-------* + + A cvalue (constant value) is an expression whose value is known + at compile time. In full T3X, this is a large subset of full + expressions, but in T3X9, it it limited to the following: + + * integers + * characters + * constants + + as well as (given that X and Y are one of the above): + + * X+Y + * X*Y + + + NAMING CONVENTIONS + *------------------* + + Symbolic names for variables, constants, structures, and + functions are constructed from the following alphabet: + + * the characters a-z + * the digits 0-9 + * the special characters '_' and '.' + + The first character of a name must be non-numeric, the remaining + characters may be any of the above. + + Upper and lower case is not distinguished, the symbolic names + + FOO, Foo, foo + + are all considered to be equal. + + By convention, + + * CONST names are all upper-case + * STRUCT names are all upper-case + * global VAR names are capitalized + * local VAR names are all lower-case + * function names are all lower-case + + Keywords, like VAR, IF, DO, etc, are sometimes printed in upper + case in documentation, but are usually in lower case in actual + programs. + + + SHADOWING + *---------* + + There is a single name space without any shadowing in T3X: + + * all global names must be different + * no local name may have the same name as a global name + * all local names in the same scope must be different + + The latter means that local names may be re-used in subsequent + scopes, e.g.: + + f(x) RETURN x; + g(x) RETURN x; + + would be a valid program. However, + + f(x) DO VAR x; END !!! WRONG !!! + + would not be a valid program, because VAR x; redefines the + argument of F. + + + BUILT-IN FUNCTIONS + *------------------* + + The following built-in functions exist in T3X9. They resemble + the functions of the T3X core module of the full language, i.e. + a T3X9 program can be compiled by a T3X compiler by adding the + following code to the top of the program: + + MODULE name(t3x); + OBJECT t[t3x]; + + These functions are built into the T3X9 compiler, though, and + do not have to be declared in any way. The '.' in the function + names resembles the message operator of the full language. + + T3X9r3 accepts (and ignores) the above declarations at the + beginning of a program. A program containing these declarations + can be compiled by any T3X compiler. + + + MEMORY FUNCTIONS + + -----[ T.MEMCOMP(b1, b2, len) ]--------------------------------- + + Compare the first LEN bytes of the byte vectors B1 and B2. + Return the difference of the first pair of mismatching bytes. + A return code of 0 means that the compared regions are equal. + + Example: t.memcomp("aaa", "aba", 3) ! gives 'b'-'a' = %1 + + + -----[ T.MEMCOPY(bs, bd, len) ]--------------------------------- + + Copy LEN bytes from the byte vector BS (source) to the byte + vector BD (destination). Return 0. + + Unlike in the full T3X language, BS and BD may not overlap. + + Example: DO VAR b::100; t.memcopy(b, "hello", 5); END + + + -----[ T.MEMFILL(bv, b, len) ]---------------------------------- + + Fill the first LEN bytes of the byte vector BV with the byte + value B. Return 0. + + Example: DO VAR b::100; t.memfill(b, 0, 100); END + + + -----[ T.MEMSCAN(bv, b, len) ]---------------------------------- + + Locate the first occurrence of the byte value B in the first LEN + bytes of the byte vector BV and return its offset in the vector. + When B does not exist in the given region, return %1. + + Example: t.memscan("aaab", 'b', 4) ! returns 3 + + + INPUT/OUTPUT FUNCTIONS + + -----[ T.CREATE(path) ]----------------------------------------- + + Create a file with the given PATH, open it, and return its file + descriptor. In case of an error, return -1. + + Example: t.create("new-file"); + + + -----[ T.OPEN(path, mode) ]------------------------------------- + + Open file PATH in the given MODE, where 0=read-only, 1=write- + only, and 2=read/write. Return -1 in case of an error. + + Example: t.open("existing-file", 0); + + + -----[ T.CLOSE(fd) ]-------------------------------------------- + + Close the file descriptor FD. Return 0 for success and -1 in + case of an error. + + Example: DO var fd; + fd := t.create("file"); + if (fd >= 0) t.close(); + END + + + -----[ T.READ(fd, buf, len) ]----------------------------------- + + Read up to LEN characters from the file descriptor FD into the + buffer BUF. Return the number of characters actually read. + Return %1 in case of an error. + + Example: DO b::100; t.read(0, b, 99); END + + + -----[ T.WRITE(fd, buf, len) ]---------------------------------- + + Write LEN characters from the buffer BUF to the file descriptor + FD. Return the number of characters actually written. Return %1 + in case of an error. + + Example: t.write(1, "hello, world!\n", 14); + + + -----[ T.RENAME(path, new) ]------------------------------------ + + Rename the file given in PATH to NEW. Return 0 for success and + -1 in case of an error. + + Example: t.rename("old-name", "new-name"); + + + -----[ T.REMOVE(path) ]----------------------------------------- + + Remove the file given in PATH. Return 0 for success and -1 in + case of an error. + + Example: t.remove("temp-file"); + + + VARIADIC FUNCTIONS + *------------------* + + T3X implements variadic functions (i.e. functions of a variable + number of arguments) using dynamic tables. For instance, the + following function returns the sum of a vector of arguments: + + sum(k, v) DO var i, n; + n := 0; + FOR (i=0, k) + n := n+v[i]; + RETURN n; + END + + Its is an ordinary function returning the sum of a vector. It + can be considered to be a variadic function, because a dynamic + table can be passed to it in the V argument: + + sum(5, [(a,b,c,d,e)]) + + + EXAMPLE PROGRAM + *---------------* + + var ntoa_buf::100; + + ntoa(x) do var i, k; + if (x = 0) return "0"; + i := 0; + k := x<0-> -x: x; + while (k > 0) do + i := i+1; + k := k/10; + end + i := i+1; + if (x < 0) i := i+1; + ntoa_buf::i := 0; + k := x<0-> -x: x; + while (k > 0) do + i := i-1; + ntoa_buf::i := '0' + k mod 10; + k := k/10; + end + if (x < 0) do + i := i-1; + ntoa_buf::i := '-'; + end + return @ntoa_buf::i; + end + + str.length(s) return t.memscan(s, 0, 32767); + + writes(s) t.write(1, s, str.length(s)); + + fib(n) do var r1, r2, i, t; + r1 := 0; + r2 := 1; + for (i=1, n) do + t := r2; + r2 := r2 + r1; + r1 := t; + end + return r2; + end + + do var i; + for (i=1, 11) do + writes(ntoa(fib(i))); + writes("\n"); + end + end diff --git a/t3x9r3-extended/tcdis.c b/t3x9r3-extended/tcdis.c new file mode 100644 index 0000000..4c86e4b --- /dev/null +++ b/t3x9r3-extended/tcdis.c @@ -0,0 +1,251 @@ +/* + * Tcode9 disassembler + * Nils M Holm, 2017, CC0 license + * https://creativecommons.org/publicdomain/zero/1.0/ + */ + +#include +#include +#include +#include +#include + +#define MEMSIZE 131072 + +#define byte unsigned char +#define sbyte signed char +#define cell int + +byte *M; +sbyte *S; +cell Red; +cell Data; + +void writes(char *s) { + write(1, s, strlen(s)); +} + +void wlog(char *s) { + write(1, s, strlen(s)); +} + +void fail(char *s) { + wlog("tcdis: "); + wlog(s); + wlog("\n"); + _exit(1); +} + +#define BSIZE 1024 + +char B[BSIZE]; +int Fd, C, K; + +int rdch(void) { + if (C >= K) { + K = read(Fd, B, BSIZE); + C = 0; + if (K < 1) return -1; + } + C = C+1; + return B[C-1] & 255; +} + +cell rdwd(void) { + cell v; + + v = rdch(); + v = v | (rdch() << 8); + v = v | (rdch() << 16); + v = v | (rdch() << 24); + return v; +} + +void readblk(byte *v, int k) { + int i, c; + + for (i=0; i +#include +#include +#include +#include + +#undef DEBUG + +#define MINSIZE 131072 +#define STKLEN 65536 + +#define byte unsigned char +#define sbyte signed char +#define cell int + +byte *M; +sbyte *S; +cell Red; +cell Memsize; + +void writes(char *s) { + write(1, s, strlen(s)); +} + +void wlog(char *s) { + write(2, s, strlen(s)); +} + +void fail(char *s) { + wlog("tcvm: "); + wlog(s); + wlog("\n"); + _exit(1); +} + +#define BSIZE 1024 + +char B[BSIZE]; +int Fd, C, K; + +int rdch(void) { + if (C >= K) { + K = read(Fd, B, BSIZE); + C = 0; + if (K < 1) return -1; + } + C = C+1; + return B[C-1] & 255; +} + +cell rdwd(void) { + cell v; + + v = rdch(); + v = v | (rdch() << 8); + v = v | (rdch() << 16); + v = v | (rdch() << 24); + return v; +} + +void readblk(byte *v, int k) { + int i, c; + + for (i=0; i> 8) & 255; + M[a+2] = (w >> 16) & 255; + M[a+3] = (w >> 24) & 255; +} + +void push(cell x) { + P -= 4; + Sw(P, x); +} + +cell pop(void) { + P += 4; + return w(P-4); +} + +#define a() w(I+1) +#define a2() w(I+5) +#define s() S[I+1] +#define s2() w(I+2) + +cell memscan(cell p, cell c, cell k) { + cell i; + + for (i=0; i= A) { I += a(); } I += 4; break; + case 0x9d: + case 0x1d: if (pop() <= A) { I += a(); } I += 4; break; + case 0x9e: + case 0x1e: push(F); F = P; break; + case 0x9f: + case 0x1f: F = pop(); I = pop(); break; + case 0xa0: exit(s()); break; + case 0x20: exit(a()); break; + case 0xa1: + case 0x21: A = -A; break; + case 0xa2: + case 0x22: A = ~A; break; + case 0xa3: + case 0x23: A = 0==A? -1: 0; break; + case 0xa4: + case 0x24: A = pop() + A; break; + case 0xa5: + case 0x25: A = pop() - A; break; + case 0xa6: + case 0x26: A = pop() * A; break; + case 0xa7: + case 0x27: A = pop() / A; break; + case 0xa8: + case 0x28: A = pop() % A; break; + case 0xa9: + case 0x29: A = pop() & A; break; + case 0xaa: + case 0x2a: A = pop() | A; break; + case 0xab: + case 0x2b: A = pop() ^ A; break; + case 0xac: + case 0x2c: A = pop() << A; break; + case 0xad: + case 0x2d: A = (unsigned) pop() >> A; break; + case 0xae: + case 0x2e: A = pop() == A? -1: 0; break; + case 0xaf: + case 0x2f: A = pop() != A? -1: 0; break; + case 0xb0: + case 0x30: A = pop() < A? -1: 0; break; + case 0xb1: + case 0x31: A = pop() > A? -1: 0; break; + case 0xb2: + case 0x32: A = pop() <= A? -1: 0; break; + case 0xb3: + case 0x33: A = pop() >= A? -1: 0; break; + /* case 0xb4: WORD */ + /* case 0x34: WORD */ + case 0xb5: + case 0x35: A = sys_call(M[I+1]); I = pop(); break; + default: fail("invalid opcode"); break; + }} +} + +int size(void) { + int k, n; + + k = 0; + for (I = 0;; I++) { + n = 0; + switch (M[I]) { + case 0x8d: n = s(); I++; break; + case 0x0d: n = a(); I += 4; break; + case 0x90: + case 0x10: I += 4; break; + case 0x98: + case 0x18: I += a(); I += 4; break; + default: return k; + } + k += n; + } + return k; +} + +cell main(cell argc, char **argv) { + if (argc != 2) fail("usage: tcvm program"); + load(argv[1]); + run(size()); + return 0; +} diff --git a/t3x9r3-extended/test.t b/t3x9r3-extended/test.t new file mode 100644 index 0000000..fedb80b --- /dev/null +++ b/t3x9r3-extended/test.t @@ -0,0 +1,47 @@ +var ntoa_buf::100; + +ntoa(x) do var i, k; + if (x = 0) return "0"; + i := 0; + k := x<0-> -x: x; + while (k > 0) do + i := i+1; + k := k/10; + end + i := i+1; + if (x < 0) i := i+1; + ntoa_buf::i := 0; + k := x<0-> -x: x; + while (k > 0) do + i := i-1; + ntoa_buf::i := '0' + k mod 10; + k := k/10; + end + if (x < 0) do + i := i-1; + ntoa_buf::i := '-'; + end + return @ntoa_buf::i; +end + +str.length(s) return t.memscan(s, 0, 32767); + +writes(s) t.write(1, s, str.length(s)); + +fib(n) do var r1, r2, i, t; + r1 := 0; + r2 := 1; + for (i=1, n) do + t := r2; + r2 := r2 + r1; + r1 := t; + end + return r2; +end + +do var i; + for (i=1, 11) do + writes(ntoa(10 mod i)); + writes("\n"); + end +end