// LC (Low-level compiler) for 8086
#include <stdio.h>
#include <errno.h>
#include <stdlib.h>
#include <string.h>
// Statement -> CONST {tag = cexpr}+
// {WORD, BYTE} {tag { (cexpr:cexpr) }? {= {data}+ }? }*
// SPEC tag string
// PROC tag {string}? {tag}*
// END
// tag :
// {instruction, ELSE}? {IF expr comp expr}?
// CYCLE
// FINISH
// Instruction -> MOVE {string opd, cexpr opd opd}
// JUMP tag
// REPEAT
// RETURN {expr}?
// opd = expr
// tag {expr}*
// Data -> {string, cexpr { (cexpr) }? }
// Cexpr -> const {op const}*
// Expr -> {opd, const} {op {opd, const} }*
// Opd -> tag { ( {opd, const} ) }?
// Op -> + - & ! \ * / % << >>
// Comp -> = # < > <= >= [ ] [= ]=
// Comments are enclosed between { and } or | and NL.
// Calling convention: Push parms, then XCALL or Push CS, CALL.
// Entry: Push DS, Push BP, Mov BP,SP, {Sub SP,framesize}?,
// {Mov AX,Glaseg, Mov DS,AX}? Xor AX,AX, Push AX
// Return: Mov SP,BP, Pop BP, Pop DS, Xret parmsize.
FILE *outfile, *source, *object, *list; // Streams
#define LINEMAX 80
#define CODEMAX 3499
#define GLAMAX 499
#define ATOMMAX 50
#define TAGMAX 200
#define TEXTMAX 20
const int linemax = LINEMAX, atommax = ATOMMAX, tagmax = TAGMAX, textmax = TEXTMAX;
const int codemax = CODEMAX, glamax = GLAMAX;
unsigned char line[LINEMAX];
#define line(x) line[(x)-1]
unsigned char code[CODEMAX + 1];
#define code(x) code[x]
unsigned char gla[GLAMAX + 1];
#define gla(x) gla[x]
int atomtype[ATOMMAX], atomval[ATOMMAX];
#define atomtype(x) atomtype[(x)-1]
#define atomval(x) atomval[(x)-1]
int tag1[TAGMAX], tag2[TAGMAX], tagtype[TAGMAX], tagval[TAGMAX];
#define tag1(x) tag1[(x)-1]
#define tag2(x) tag2[(x)-1]
#define tagtype(x) tagtype[(x)-1]
#define tagval(x) tagval[(x)-1]
int texttype[TEXTMAX], textval[TEXTMAX];
#define texttype(x) texttype[(x)-1]
#define textval(x) textval[(x)-1]
int type, val, t, v, atompos, ifpos, floc, parms;
int oldapos, oldcpos, oldtpos, access, textlevel;
int lineno = 0, cloc = 0, gloc = 0, level = 0, gpos = 0, cpos = 0, tagpos = 1;
char program[255];
char program_source[255], program_object[255], program_list[255];
// Atom types
#define WORDBIT 1
const int unknown = 0, constant = 1, string = 2, label = 3;
const int var = 4, wordbit = WORDBIT, glabit = 2, varmask = 0xFC;
const int proc = 8, xproc = 9, spec = 10;
const int op = 11, comp = 12, colon = 13, sep = 14, bracket = 15, bx = 16 | WORDBIT;
// Keyword types
#define KCONST 17
#define KREPEAT 30
const int kconst = KCONST, kword = 18, kbyte = 19, kspec = 20, kproc = 21;
const int kend = 22, kmove = 23, kjump = 24, kreturn = 25, kprogram = 26;
const int kelse = 27, kfinish = 28, kcycle = 29, krepeat = KREPEAT;
// Operator codes
#define LOAD 1
#define ADD 2
#define SUB 3
#define AND 4
#define OR 5
#define XOR 6
#define CMP 7
#define MUL 8
#define DIV 9
#define REM 10
#define LEFT 11
#define RIGHT 12
#define STORE 13
#define LEA 14
const int load = 1, add = 2, sub = 3, and = 4, or = 5, xor = 6, cmp = 7,
mul = 8, /* div = 9,*/ rem = 10, left = 11, right = 12, store = 13, lea = 14;
// Keyword tag codes (1:36 = A:Z,0:9) 1st {*37 + 2nd {*37 + 3rd}? }?
const int if_ = 339;
static int n1[KREPEAT - KCONST + 1] = {
4676, 32060, 3683, 26608, 22585, 7367, 18374, 14480, 24847, 22585,
7308, 8561, 5035, 24843};
#define n1(x) n1[(x)-kconst]
static int n2[KREPEAT - KCONST + 1] = {
723, 4, 5, 3, 3, 0, 5, 16, 29429, 10250,
5, 13032, 449, 6902};
#define n2(x) n2[(x)-kconst]
// Fault numbers
#define MAXFAULT 16
const int complex = 1, atom = 2, consterr = 3, bfull = 4, form = 5, ambig =
6, nested = 7, declate = 8, far = 9, labund = 10, level0 = 11, varund =
12, dfull = 13, repexp = 14, finexp = 15, context = 16, maxfault =
MAXFAULT;
void fault (int n) {
static char *s[MAXFAULT] = {
"Complex",
"Atom",
"Not constant",
"Buffer full",
"Form",
"Ambiguous",
"Nesting",
"Too late",
"Too far",
"Label missing",
"Code misplaced",
"Name",
"Dict full",
"Repeat expected",
"Finish expected",
"Context"
};
#define s(x) s[(x)-1]
int i;
int sym;
fprintf (stderr, "%1d ", lineno);
i = 1;
for (;;) {
sym = line (i++);
fputc (sym, stderr);
if (sym == '\n') break;
}
fprintf (stderr, "%s%1d\n", s (n), atompos - 1);
fprintf (list, "%s%s%d\n", "** ", s (n), atompos - 1);
exit (1);
#undef s
}
void phex (int x) {
int k, i;
for (i = 12; i >= 0; i -= 4) {
k = (x >> i) & 15;
if (k > 9) k += 7;
fputc (k + '0', list);
}
}
void putatom (int t, int v) {
if (atompos > atommax) fault (complex);
atomtype (atompos) = t;
atomval (atompos++) = v;
}
void readline (void) {
static int semi = 0;
static int quote = 0;
int sym, n1, n2, radix, i, quoted, lpos;
for (;;) {
if (semi == 0) fprintf (list, "%4d C%04X D%04X ", lineno + 1, cloc, gloc);
lpos = 1; quoted = 0;
for (;;) {
next:
sym = ((lpos + quoted == linemax) ? ((quoted == 0) ? '\n' : quote) : fgetc (source) );
// line nearly too long: force end
fputc (sym, list);
if (quoted == 0) {
if ((sym == '\'' || sym == '"')) quoted = 1;
if (quoted != 0) quote = sym;
} else if (sym == quote) quoted = 0;
if (quoted == 0) {
if (sym == '{') { // Comment
for (;;) {
sym = fgetc (source); fputc (sym, list);
if (sym == '\n') {
lineno += 1;
{int i;for (i = 0; i < 18; i++)fputc (' ', list);}
}
if (sym == '}') break;
}
goto next;
}
if (('a' <= sym) && (sym <= 'z')) sym -= 32;
semi = 0;
if (sym == ';') {sym = '\n'; lineno -= 1; semi = 1;}
if (sym == '|') do { sym = fgetc (source); fputc (sym, list);} while (sym != '\n');
}
if (sym == '\n') lineno += 1;
line (lpos++) = sym;
if ((sym == '\n') && (quoted == 0)) break;
}
if (lpos > 2) break;
}
// non-empty line
// Now decompose line into atoms
atompos = 1; ifpos = 0; lpos = 1;
nextatom:
for (;;) {
sym = line (lpos++);
if (('A' <= sym) && (sym <= 'Z')) goto tag;
if (('0' <= sym) && (sym <= '9')) goto num;
if (sym == '\n') {
putatom (sep, 0); atompos = 1; return;
}
if (sym == ':')
putatom (colon, 0);
else if (sym == '+')
putatom (op, add);
else if (sym == '-')
putatom (op, sub);
else if (sym == '&')
putatom (op, and);
else if (sym == '!')
putatom (op, or);
else if (sym == '\\')
putatom (op, xor);
else if (sym == '*')
putatom (op, mul);
else if (sym == '%')
putatom (op, rem);
else if (sym == '/')
putatom (op, DIV);
else if ((sym == '<' || sym == '>')) {
if (line (lpos) == sym) { // '<<', '>>'
lpos += 1;
putatom (op, ((sym == '<') ? left : right));
} else { // '<', '>', '<=', '>='
square: // +'[', ']', '[=', ']='
if (line (lpos) == '=') {
lpos += 1; sym += 128;
}
putatom (comp, sym);
}
} else if ((sym == '(') || (sym == ')'))
putatom (bracket, sym);
else if ((sym == '[') || (sym == ']'))
goto square;
else if ((sym == '=') || (sym == '#'))
putatom (comp, sym);
else if (sym == '"') {
putatom (string, lpos);
while (line (lpos) != '"') lpos += 1; // we know it's there
lpos += 1;
} else if (sym == '\'') {
sym = line (lpos);
if (sym == '\'') lpos += 1;
if (line (lpos + 1) != '\'') fault (atom);
putatom (constant, sym); lpos += 2;
} else if (sym != ' ') fault (atom);
}
num:
i = 0; radix = 10; // I accumulates number, default radix is ten
for (;;) {
if (sym == '_') { // change radix
radix = i; i = 0;
} else if (('9' < sym && sym < 'A')) {
endconst:
putatom (constant, i); lpos -= 1; goto nextatom;
} else {
if (sym > '9') sym -= 7;
sym -= '0';
if (!((0 <= sym) && (sym < radix))) goto endconst;
i = i * radix + sym;
}
sym = line (lpos++);
}
tag:
n1 = sym - 'A' + 1; n2 = 0; i = 1; // I counts name length
for (;;) {
sym = line (lpos);
if (('A' <= sym) && (sym <= 'Z'))
sym = sym - 'A' + 1;
else if (('0' <= sym) && (sym <= '9'))
sym = sym - '0' + 27;
else {
if (n1 == if_) {
if (ifpos != 0) fault (form);
ifpos = atompos; putatom (sep, 0);
} else {
// Look up in dictionary
for (i = tagpos - 1; i >= 1; i -= 1) {
if ((tag1 (i) == n1) && (tag2 (i) == n2)) {
n1 = tagtype (i); n2 = tagval (i);
if (n1 == unknown) n2 = i;
putatom (n1, n2);
goto nextatom;
}
}
// Not found: enter name and details
tag1 (tagpos) = n1; tag2 (tagpos) = n2;
tagtype (tagpos) = unknown; tagval (tagpos) = 0;
putatom (unknown, tagpos);
if (tagpos > tagmax) fault (dfull); else tagpos += 1;
}
goto nextatom;
}
if (i < 3) n1 = n1 * 37 + sym;
else if (i < 6) n2 = n2 * 37 + sym;
i += 1; lpos += 1;
}
}
void nextatom (void) {
type = atomtype (atompos); val = atomval (atompos);
if (type != sep) atompos += 1;
}
int openbracket (void) {
if ((atomtype (atompos) != bracket) || (atomval (atompos) != '(')) return (0 != 0);
atompos += 1; return (0 == 0);
}
void closebracket (void) {
if ((atomtype (atompos) != bracket) || (atomval (atompos) != ')')) fault (form);
atompos += 1;
}
int equalsign (void) {
if ((atomtype (atompos) != comp) || (atomval (atompos) != '=')) return (0 != 0);
atompos += 1; return (0 == 0);
}
void unary (void);
int cexpr (int must) {
int value, oper;
nextatom ();
unary ();
value = val;
if (type != constant) fault (consterr);
for (;;) {
if (atomtype (atompos) != op) return (value);
if ((must == 0) && (atomtype (atompos + 1) != constant)) return (value);
oper = atomval (atompos++);
nextatom (); if (type != constant) fault (consterr);
switch (oper) {
case ADD: /* add */ value += val; continue;
case SUB: /* sub */ value -= val; continue;
case AND: /* and */ value &= val; continue;
case OR: /* or */ value |= val; continue;
case XOR: /* xor */ value ^= val; continue;
case REM: /* rem */ value -= (((int) (value) / (int) (val)) * val); continue;
case DIV: /* div */ value /= val; continue;
case MUL: /* mul */ value *= val; continue;
case LEFT: /* left */ value <<= val; continue;
case RIGHT: /* right */ value >>= val;
} /* end switch s */
}
}
void unary (void) {
int *v;
if ((type != op) || (atomtype (atompos) != constant)) return;
if ((val != sub) && (val != xor)) return;
v = &atomval (atompos) /* Pointer assignment */ ;
*v = ~*v; if (val == sub) *v += 1;
val = cexpr (0); type = constant;
}
void gbyte (int b) {
if (gpos > glamax) fault (bfull);
gla (gpos++) = b & 255; gloc += 1;
}
void gword (int x) {
gbyte (x); gbyte (x >> 8);
}
void gflush (void) {
int i;
if (gpos == 0) return;
fputc (2, object); fputc (4, object);
fputc (gpos & 255, object); fputc ((gpos >> 8) & 255, object);
for (i = 0; i <= gpos - 1; i += 1) fputc (gla (i), object);
gpos = 0;
}
void dumpstring (int p) {
int l;
l = 0;
while (line (p) != '"') { l += 1; p += 1; }
gbyte (l); p -= l;
while (l > 0) { gbyte (line (p++)); l -= 1; }
}
void dump (int byte) {
if (cpos > codemax) fault (bfull);
code (cpos++) = byte & 255; cloc += 1;
}
void dumpw (int byte2) {
if ((cpos+1) > codemax) fault (bfull);
code (cpos++) = byte2 & 255; cloc += 1;
code (cpos++) = (byte2>>8) & 255; cloc += 1;
}
void flush (void) {
int i;
if (cpos == 0) return;
fputc (1, object); fputc (4, object);
fputc (cpos & 255, object); fputc ((cpos >> 8) & 255, object);
for (i = 0; i < cpos; i += 1) fputc (code (i), object);
cpos = 0;
}
void satrefs (int ref, int val) {
int abs, rel, disp;
while (ref != 0) {
rel = ref; abs = rel - cloc + cpos; disp = val - rel - 2;
ref = (code (abs + 1) << 8) + code (abs);
code (abs) = disp & 255; code (abs + 1) = (disp >> 8) & 255;
}
}
void labelref (int type, int val) {
if (type == label) {
dumpw (val - (cloc + 2));
} else {
if (type != unknown) fault (form);
dumpw (tagval (val));
tagval (val) = cloc - 2;
}
}
void pushtext (int t, int v) {
if (++textlevel > textmax) fault (complex);
texttype (textlevel) = t; textval (textlevel) = v;
}
void poptext (void) {
if (textlevel == 0) fault (context);
type = texttype (textlevel); val = textval (textlevel--);
}
void expr (void);
const int pushax = 0x50, popax = 0x58;
void call (int t, int v) {
type = atomtype (atompos);
if (type != op) {
while ((type != sep) && (type != comp)) {
expr (); dump (pushax); type = atomtype (atompos);
}
}
if (t == spec) {
dumpw (0x1EFF); dumpw (v); // Xcall
} else {
dumpw (0xE80E); labelref (label, v); // PushCs, Call
}
}
void immediate (int op, int val) {
switch (op) {
case LOAD: /* load */ dump (0xB8); break;
case ADD: /* add */ dump (0x05); break;
case SUB: /* sub */ dump (0x2D); break;
case AND: /* and */ dump (0x25); break;
case OR: /* or */ dump (0x0D); break;
case XOR: /* xor */ dump (0x35); break;
case CMP: /* cmp */ dump (0x3D); break;
case LEFT: /* left */
case RIGHT:/* right */
if (val == 1) val = 0xD1; else {
dump (0xB1); dump (val & 15); // Mov CL,nn
val = 0xD3;
}
dump (val); dump ((op == left) ? 0xE0 : 0xE8);
return;
case MUL: /* mul */ case DIV: /* div */ case REM: /* rem */
dump (0xB9); dumpw (val); // Mov CX,nn
if (op != mul) dump (0x99); // Cwd
dumpw ((op == mul) ? 0xE9F7 : 0xF9F7);
if (op != rem) return;
dumpw (0xC28B); // Mov ax,dx
}
dumpw (val);
}
#undef code
void direct (int op, int type, int val, int index) {
static int code[LEA - LOAD + 1] = {
0x8a, 0x02, 0x2a, 0x22, 0x0a,
0x32, 0x3a, 0x28, 0x38, 0x30,
0xe0, 0xe8, 0x88, 0x8d
};
#define code(x) code[(x)-load]
int oper, extra;
if (type == constant) { immediate (op, val); return; }
oper = code (op);
if ((op != left) && (op != right)) {
extra = 0; if (op == mul) { extra = oper; oper = 0xF6; }
if ((op == DIV) || (op == rem)) {
dump (((type & wordbit) != 0) ? 0x99 : 0x98);
extra = oper; oper = 0xF6;
}
if ((type & wordbit) != 0) oper += 1;
dump (oper);
if (type == bx) { dump (0xC3 + extra); return; }
if (type == unknown) {
tagtype (val) = var + wordbit; tagval (val) = -2;
fault (varund);
}
if ((type & varmask) != var) fault (form);
if ((type & glabit) == 0) {
oper = (((-128 <= val) && (val <= 127)) ? 0x42 : 0x82);
if (index == 0) oper += 4;
} else oper = (index == 0 ? 6 : (((-128 <= val) && (val <= 127)) ? 0x44 : 0x84));
dump (oper + extra); dump (val);
if ((oper & 0x40) == 0) dump (val >> 8);
if (op == rem) { dumpw (0xC28B); }
if (((type & wordbit) == 0) && (op == load)) { dumpw (0xE432); }
} else {
dump (pushax);
direct (load, type, val, index);
dumpw (0xC189); // Mov Cx,Ax
dump (popax); dump (((type & wordbit) == 0) ? 0xD2 : 0xD3); dump (oper);
}
#undef code
}
#define code(x) code[x]
void double_ (int t) { // index for word arrays
if ((t & wordbit) == 0) return;
dumpw (0xC003); // Add ax,ax
}
void expr (void) {
int oper, t, v, index;
oper = load;
for (;;) {
nextatom ();
unary ();
if (type == constant) {
if (oper == load) { atompos -= 1; val = cexpr (0); }
immediate (oper, val);
} else if ((type & varmask) == var) {
t = type; v = val;
if (openbracket ()) {
if (oper != load) dump (pushax);
expr ();
double_ (t);
dumpw (0xF08B); // Mov si,ax
if (oper != load) dump (popax);
closebracket ();
index = 1;
} else index = 0;
direct (oper, t, v, index);
} else if ((type == proc) || (type == xproc) || (type == spec)) {
if (oper == load) call (type, val);
else {
dump (pushax); call (type, val); dumpw (0xD88B); // mov bx,ax
dump (popax); direct (oper, bx, 0, 0);
}
} else fault (form);
if (atomtype (atompos) != op) return;
nextatom ();
oper = val;
}
}
void return_ (void) {
dumpw (0xE58B); // Mov sp,bp
dumpw (0x1F5D); // Pop bp, pop ds
if (parms == 0) dump (0xCB); else {
dump (0xCA); dumpw (parms);
}
access = 0;
}
void terminatedeclarations (void) {
int i;
if (level == 0) fault (level0);
if (level == 1) {
level = 2; i = -floc;
if (i > 127) {
dumpw (0xEC81); dumpw (i); // Sub sp,nn
} else if (i != 0) {
dumpw (0xEC83); dump (i); // sub sp,n
}
floc -= 2;
}
}
void constdef (void) {
int c;
for (;;) {
nextatom (); if (type == sep) return;
if (type != unknown) fault (ambig); c = val;
if (!equalsign ()) fault (form);
tagtype (c) = constant; tagval (c) = cexpr (1);
}
}
void vardef (int key) {
int t, lb, ub, c, r;
int *v;
for (;;) {
nextatom ();
next: if (type == sep) return;
if (type != unknown) fault (ambig);
t = var;
if (key == kword) t += wordbit;
if (level == 0) t += glabit;
tagtype (val) = t; v = &tagval (val) /* Pointer assignment */ ;
if (openbracket ()) {
lb = cexpr (1); nextatom (); if (type != colon) fault (form);
ub = cexpr (1) + 1; closebracket ();
} else { lb = 0; ub = 1; }
if (key == kword) { lb += lb; ub += ub; }
if (level == 0) {
*v = gloc - lb; t = *v + ub;
if (equalsign ()) {
for (;;) {
nextatom ();
if (gloc >= t) { gflush (); goto next; }
if (type == string) {
dumpstring (val);
} else if (type == sep) {
readline ();
} else {
atompos -= 1; c = cexpr (1); r = 1;
if (openbracket ()) { r = cexpr (1); closebracket (); }
while (r-- > 0) if (key == kword) gword (c); else gbyte (c);
}
}
} else {
fputc (2, object); fputc (3, object);
fputc (t & 255, object); fputc ((t >> 8) & 255, object); gloc = t;
}
} else {
if (level == 2) fault (declate);
floc = floc - ub + lb; *v = floc - lb;
}
}
}
int getstring (char *s) {
int sym;
strcpy (s, "");
for (;;) {
sym = line (val); if (sym == '"') return sym;
val += 1; s[strlen (s) + 1] = '\0'; s[strlen (s)] = sym;
}
}
void procdef (int key) {
int p;
int sym;
char s[32];
nextatom (); if (type != unknown) fault (ambig);
if (key == kspec) {
tagtype (val) = spec; tagval (val) = gloc;
nextatom (); if (type != string) fault (form);
sym = getstring (s); p = strlen (s);
fputc (2, object);
fputc (8, object); fputc (p, object); fprintf (object, "%s", s);
fputc (7, object); fputc (0, object);
gloc += 4; return;
}
if (level != 0) fault (nested);
level = 1; access = 1; textlevel = 0;
v = val; t = proc; nextatom ();
if (type == string) {
sym = getstring (s);
fputc (1, object); fputc (6, object);
fputc (strlen (s), object); fprintf (object, "%s", s);
t = xproc; nextatom ();
}
tagtype (v) = t; tagval (v) = cloc;
dumpw (0x551E); // Push ds, push bp
dumpw (0xEC8B); // Mov BP,SP
dumpw (0xC033); // Xor AX,AX
dump (pushax); // For event mechanism
if (t == xproc) {
if (*program == '\0') fault (labund);
dump (0xB8); flush (); // Mov ax,nn=dseg
fputc (7, object); fputc (strlen (program), object); fprintf (object, "%s", program);
cloc += 2; dumpw (0xD88E); // Mov ds,ax
}
parms = 0; oldtpos = v + 1;
while (type != sep) {
if (type != unknown) fault (ambig);
tagtype (val) = var + wordbit;
parms += 1; nextatom ();
}
p = tagpos - parms; parms += parms; sym = parms + 6;
while (p < tagpos) { tagval (p++) = sym; sym -= 2; }
floc = 0;
}
void instruction (void) {
int t, v, i, oper, st, sv, si, dt, dv;
nextatom ();
if (type == kmove) {
nextatom ();
oper = 0xA4; // Movb
if (type == string) {
st = var + glabit; sv = gloc; si = 0;
dumpstring (val); val = gloc - sv; gflush ();
if ((val & 1) == 0) {
val >>= 1; oper = 0xA5; // Movw
}
immediate (load, val); dump (pushax);
} else {
expr (); dump (pushax);
nextatom (); st = type; sv = val; si = 0;
if ((st & varmask) != var) fault (form);
if (openbracket ()) {
expr (); double_ (st); si = 1; dump (pushax);
closebracket ();
}
if ((st & wordbit) != 0) oper = 0xA5; // Movw
}
nextatom ();
dt = type; dv = val;
if ((dt & varmask) != var) fault (form);
if (openbracket ()) {
expr (); double_ (dt); dumpw (0xF88B); // Mov di,ax
direct (lea, dt, dv, 0); dumpw (0xF803); // add di,ax
closebracket ();
} else {
direct (lea, dt, dv, 0); dumpw (0xF88B); // Mov di,ax
}
direct (lea, st, sv, 0);
dumpw (0xF08B); // Mov si,ax
if (si != 0) { dump (popax); dumpw (0xF003); } // add,si,ax
dump (((dt & glabit) == 0) ? 0x16 : 0x1E); // Push SS/DS
dump (0x07); // Pop ES
if ((st & glabit) == 0) { dump (0x1E); dumpw (0x1F16); } // Push DS,SS, Pop DS
dumpw (0xF259); dump (oper); // Pop cx, rep
if ((st & glabit) == 0) dump (0x1F); // Pop DS
} else if (type == krepeat) {
poptext (); if (type != repexp) fault (type);
dump (0xE9); labelref (label, val);
} else if (type == kjump) {
nextatom (); dump (0xE9); labelref (type, val);
} else if (type == kreturn) {
if (atomtype (atompos) != sep) expr ();
return_ ();
} else if ((type & varmask) == var) {
t = type; v = val; i = 0;
if (openbracket ()) {
expr (); double_ (t); dump (pushax);
closebracket ();
i = 1;
}
if (!equalsign ()) fault (form);
expr (); if (i != 0) dump (0x5E); // pop si
direct (store, t, v, i);
} else if ((type == proc) || (type == xproc) || (type == spec))
call (type, val);
else
atompos -= 1;
}
int cond (void) {
// Evaluate condition, return value of jump opcode
expr (); nextatom (); if (type != comp) fault (form);
v = val; nextatom (); unary ();
if ((atomtype (atompos) != sep)
|| ((type != constant) && ((type & varmask) != var))) {
dump (pushax); atompos -= 1; expr ();
dumpw (0xD88B); dump (popax); // Mov bx,ax
type = bx;
}
direct (cmp, type, val, 0);
if (v == ']' + 128) return (0x72);
if (v == '[') return (0x73);
if (v == '#') return (0x74);
if (v == '=') return (0x75);
if (v == ']') return (0x76);
if (v == '[' + 128) return (0x77);
if (v == '>' + 128) return (0x7C);
if (v == '<') return (0x7D);
if (v == '>') return (0x7E);
return (0x7F); // %if v='<'+128
}
// Main Program
int main (int argc, char **argv) {
if (tagpos == 1) {
if (argc != 2) {
fprintf (stderr, "syntax: lc basename\n");
exit (1);
}
sprintf (program, "%s", argv[1]);
sprintf (program_source, "%s.lc", argv[1]);
sprintf (program_object, "%s.iob", argv[1]);
sprintf (program_list, "%s.lis", argv[1]);
source = fopen (program_source, "r");
if (source == NULL) {
// Maybe switch to using stdin?
fprintf (stderr, "lc: %s - %s\n", strerror (errno), program_source);
exit (1);
}
object = fopen (program_object, "wb");
if (object == NULL) {
// Or send to stdout?
fprintf (stderr, "lc: %s - %s\n", strerror (errno), program_object);
exit (1);
}
list = fopen (program_list, "w");
if (list == NULL) {
fprintf (stderr, "lc: %s - %s\n", strerror (errno), program_list);
exit (1);
}
fprintf (list, " LC Cross-compiler 06/01/81\n\n");
for (type = kconst; type <= krepeat; type += 1) {
tag1 (tagpos) = n1 (type); tag2 (tagpos) = n2 (type);
tagtype (tagpos) = type; tagval (tagpos++) = -1;
}
*program = '\0';
}
for (;;) {
readline ();
for (;;) {
// Deal with labels
nextatom ();
if ((type != unknown) || (atomtype (atompos) != colon)) break;
tagtype (val) = label; satrefs (tagval (val), cloc);
tagval (val) = cloc;
atompos += 1;
access = 1;
}
if ((type == sep) && (ifpos == 0)) continue;
if (type == kconst)
constdef ();
else if ((type == kbyte) || (type == kword))
vardef (type);
else if ((type == kspec) || (type == kproc))
procdef (type);
else if (type == kend) {
if (level == 0) break; level = 0;
if (access != 0) return_ (); flush ();
val = oldtpos; oldtpos = tagpos; tagpos = val; // Reset tagpos before moaning
while (oldtpos > tagpos) { if (tagtype (--oldtpos) == unknown) fault (labund); }
if (textlevel != 0) { poptext (); textlevel = 0; fault (type); }
} else if (type == kprogram) {
if (*program != '\0') fault (ambig);
nextatom (); if (type != string) fault (form);
if (val == '"') fault (form); // Null name not allowed
v = line (val);
for (;;) {
program[strlen (program) + 1] = '\0'; program[strlen (program)] = v;
if ((v = line (++val)) == '"') break;
}
if (program[(strlen (program)) - 1] != '_') {
program[strlen (program) + 1] = '\0'; program[strlen (program)] = '_';
}
fputc (2, object); fputc (6, object);
fputc (strlen (program), object); fprintf (object, "%s", program);
} else if (type == kcycle)
pushtext (repexp, cloc);
else if (type == kelse) {
poptext (); if (type != finexp) fault (type);
satrefs (val, cloc + 3);
poptext (); if (type != finexp) fault (type);
dump (0xE9); dumpw (val);
if (ifpos == 0) pushtext (context, 0);
else {
pushtext (finexp, cloc - 2);
atompos = ifpos + 1;
dump (cond () ^ 1); dumpw (0xE903); dumpw (0x0000);
if (ifpos != 2) { atompos = ifpos; fault (form); }
ifpos = 0;
}
pushtext (finexp, cloc - 2);
} else if (type == kfinish) {
poptext (); if ((type != finexp) && (type != context)) fault (type);
satrefs (val, cloc);
poptext (); satrefs (val, cloc); access = 1;
} else {
if (type == unknown) fault (varund);
terminatedeclarations ();
if (ifpos == 0) { // Statement
atompos -= 1; instruction ();
} else if (type == sep) { // IF condition
if (ifpos != atompos) fault (form);
atompos = ifpos + 1;
dump (cond () ^ 1); dumpw (0xE903); dumpw (0x0000);
pushtext (finexp, 0); pushtext (finexp, cloc - 2);
} else { // Statement IF condition
oldapos = atompos - 1; atompos = ifpos + 1;
dump (cond ());
oldcpos = cpos; dump (0);
atompos = oldapos; instruction ();
v = cpos - oldcpos - 1; if (v > 127) fault (far);
code (oldcpos) = v;
access = 1;
}
ifpos = 0;
}
nextatom (); if ((type != sep) || (ifpos != 0)) fault (form);
}
fputc (10, object);
fputc ('\n', list);
exit (0);
return (1);
}