1683 lines
30 KiB
Raku
1683 lines
30 KiB
Raku
! 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
|