#include <stdio.h>
#include <errno.h>
#include <stdlib.h>
#include <string.h>

int
main (int argc, char **argv)
{
FILE *outfile, *source, *object, *list;
/*
  //  LC (Low-level compiler) for 8086
  //  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.
*/

  const int linemax = 80, atommax = 50, tagmax = 200, textmax = 20;
  const int codemax = 3499, glamax = 499;
  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;
  int val;
  int t;
  int v;
  int atompos;
  int ifpos;
  int floc;
  int parms;
  int oldapos;
  int oldcpos;
  int oldtpos;
  int access;
  int textlevel;
  int lineno = 0, cloc = 0, gloc = 0, level = 0, gpos = 0, cpos = 0, tagpos = 1;
  char program[255],
       program_source[255],
       program_object[255],
       program_list[255];
  // Atom types
  const int unknown = 0, constant = 1, string = 2, label = 3;
  const int var = 4, wordbit = 1, 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
  const int kconst = KCONST, kword = 18, kbyte = 19, kspec = 20, kproc = 21;
  const int kend = 22, kmove = 23, kjump = 24, kreturn = 25, kprogram = 26;
#define KREPEAT 30
  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];
#define n1(x) n1[(x)-kconst]
  static int n2[KREPEAT - KCONST + 1];
#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;
  auto 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;
    //selectoutput (diag);
    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);
    //selectoutput (list);
    fprintf (list, "%s%s%d\n", "** ", s (n), atompos - 1);
    // AST 2616: SIGNAL 2613 0 0
    exit(1);
#undef s
  }
  auto void readline (void)
  {
    static int semi = 0;
    static int quote = 0;
    int sym;
    int n1;
    int n2;
    int radix;
    int i;
    int quoted;
    int lpos;
    auto void phex (int x)
    {
      int k;
      int i;
      for (i = 12; i >= 0; i -= 4)
	{
	  k = (x >> i) & 15;
	  if (k > 9) k += 7;
	  fputc (k + '0', list);
	}
    }
    auto void putatom (int t, int v)
    {
      if (atompos > atommax) fault (complex);
      atomtype (atompos) = t; atomval (atompos++) = v;
    }
    //selectoutput (list);
    for (;;)
      {
	if (semi == 0) fprintf(list, "%4d C%04x D%04x ", lineno + 1, cloc, gloc);
	lpos = 1;
	quoted = 0;
	for (;;)
	  {
	  next:
	    if (lpos + quoted == linemax)
		//  line nearly too long: force end
		sym = ((quoted == 0) ? '\n' : quote);
	    else
		sym = fgetc(source);
	    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;
      }
  }
  auto void nextatom (void)
  {
    type = atomtype (atompos);
    val = atomval (atompos);
    if (type != sep) atompos += 1;
  }
  auto int openbracket (void)
  {
    if ((atomtype (atompos) != bracket) || (atomval (atompos) != '('))
      return (0 != 0);
    atompos += 1;
    return (0 == 0);
  }
  auto void closebracket (void)
  {
    if ((atomtype (atompos) != bracket) || (atomval (atompos) != ')'))
      fault (form);
    atompos += 1;
  }
  auto int equalsign (void)
  {
    if ((atomtype (atompos) != comp) || (atomval (atompos) != '='))
      return (0 != 0);
    atompos += 1;
    return (0 == 0);
  }
  auto void unary (void);
  auto int cexpr (int must)
  {
    int value;
    int oper;
    nextatom ();
    unary ();
    value = val;
    if (type != constant) fault (consterr);
    for (;;)
      {
	if (atomtype (atompos) != op) return (value);
	if (must == 0)
	  {
	    if (atomtype (atompos + 1) != constant) return (value);
	  }
	oper = atomval (atompos);
	atompos += 1;
	nextatom ();
	if (type != constant) fault (consterr);
	switch (oper) {
      case ADD:			/* add */
	value += val;
	continue;
      case SUB:			/* sub */
	value -= val;
	continue;
      case AND:			/* and */
	value = value & val;
	continue;
      case OR:			/* or */
	value = value | val;
	continue;
      case XOR:			/* xor */
	value = value ^ val;
	continue;
      case REM:			/* rem */
	value = value - (((int) (value) / (int) (val)) * val);
	continue;
      case DIV:			/* div */
	value = ((int) (value) / (int) (val));
	continue;
      case MUL:			/* mul */
	value = value * val;
	continue;
      case LEFT:			/* left */
	value = value << val;
	continue;
      case RIGHT:			/* right */
	value = value >> val;
      } /* end switch s */
      }
  }
  auto 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;
  }
  auto void gbyte (int b)
  {
    if (gpos > glamax) fault (bfull);
    gla (gpos++) = b & 255;
    gloc += 1;
  }
  auto void gword (int x)
  {
    gbyte (x); gbyte (x >> 8);
  }
  auto void gflush (void)
  {
    int i;
    if (gpos == 0) return;
    //selectoutput (object);
    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;
  }
  auto 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;
      }
  }
  auto void dump (int byte)
  {
    if (cpos > codemax) fault (bfull);
    code (cpos++) = byte & 255;
    cloc += 1;
  }
  auto void flush (void)
  {
    int i;
    if (cpos == 0) return;
    //selectoutput (object);
    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;
  }
  auto void satrefs (int ref, int val)
  {
    int abs;
    int rel;
    int 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;
      }
  }
  auto void labelref (int type, int val)
  {
    int tvv;
    if (type == label)
      {
	val -= (cloc + 2);
	dump (val);
	dump (val >> 8);
      }
    else
      {
	if (type != unknown) fault (form);
	tvv = tagval (val);
	dump (tvv);
	dump (tvv >> 8);
	tagval (val) = cloc - 2;
      }
  }
  auto void pushtext (int t, int v)
  {
    if (++textlevel > textmax) fault (complex);
    texttype (textlevel) = t;
    textval (textlevel) = v;
  }
  auto void poptext (void)
  {
    if (textlevel == 0) fault (context);
    type = texttype (textlevel);
    val = textval (textlevel--);
  }
  auto void expr (void);
  const int pushax = 0x50, popax = 0x58;
  auto void call (int t, int v)
  {
    type = atomtype (atompos);
    if (type != op)
      {
	for (;;)
	  {
	    if ((type == sep) || (type == comp)) break;
	    expr ();
	    dump (pushax);
	    type = atomtype (atompos);
	  }
      }
    if (t == spec)
      {
	dump (0xFF); dump (0x1E); dump (v); dump (v >> 8); // Xcall
      }
    else
      {
	dump (0x0E); dump (0xE8); labelref (label, v); // PushCs, Call
      }
  }
  auto void immediate (int op, int val)
  {
    switch (op) {
  case LOAD:			/* load */
    dump (0xB8);
    goto imm;
  case ADD:			/* add */
    dump (0x05);
    goto imm;
  case SUB:			/* sub */
    dump (0x2D);
    goto imm;
  case AND:			/* and */
    dump (0x25);
    goto imm;
  case OR:			/* or */
    dump (0x0D);
    goto imm;
  case XOR:			/* xor */
    dump (0x35);
    goto imm;
  case CMP:			/* cmp */
    dump (0x3D);
    goto imm;
  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); dump (val); dump (val >> 8); // Mov CX,nn
    if (op != mul) dump (0x99); // Cwd
    dump (0xF7);
    if (op == mul) dump (0xE9); else dump (0xF9);
    if (op != rem) return;
    dump (0x8B); dump (0xC2); // Mov ax,dx
    }
  imm:
    dump (val); dump (val >> 8);
  }
#undef code
  auto 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;
    int extra;
    if (type == constant)
      {
	immediate (op, val);
	return;
      }
    oper = code (op);
    if ((op == left) || (op == right))
      goto shift;
    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)
      {
	dump (0x8B); dump (0xC2);
      }
    if (((type & wordbit) == 0) && (op == load))
      {
	dump (0x32); dump (0xE4);
      }
    return;
  shift:
    dump (pushax);
    direct (load, type, val, index);
    dump (0x89); dump (0xC1);
    // Mov Cx,Ax
    dump (popax);
    dump (((type & wordbit) == 0) ? 0xD2 : 0xD3);
    dump (oper);
#undef code
  }
#define code(x) code[x]
  auto void double_ (int t)
  {
    //  index for word arrays
    if ((t & wordbit) == 0) return;
    dump (0x03); dump (0xC0); // Add ax,ax
  }
  auto 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);
		dump (0x8B); dump (0xF0); // 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);
		dump (0x8B); dump (0xD8); // mov bx,ax
		dump (popax);
		direct (oper, bx, 0, 0);
	      }
	  }
	else
	    fault (form);
	if (atomtype (atompos) != op) return;
	nextatom ();
	oper = val;
      }
  }
  auto void return_ (void)
  {
    dump (0x8B); dump (0xE5); // Mov sp,bp
    dump (0x5D); dump (0x1F); // Pop bp, pop ds
    if (parms == 0)
      dump (0xCB);
    else
      {
	dump (0xCA); dump (parms); dump (parms >> 8);
      }
    access = 0;
  }
  auto void terminatedeclarations (void)
  {
    int i;
    if (level == 0) fault (level0);
    if (level == 1)
      {
	level = 2;
	i = -floc;
	if (i > 127)
	  {
	    dump (0x81); dump (0xEC); dump (i); dump (i >> 8); // Sub sp,nn
	  }
	else if (i != 0)
	  {
	    dump (0x83); dump (0xEC); dump (i); // sub sp,n
	  }
	floc -= 2;
      }
  }
  auto 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);
      }
  }
  auto void vardef (int key)
  {
    int t;
    int lb;
    int ub;
    int c;
    int 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)
			  {
			    r -= 1;
			    if (key == kword)
			      gword (c);
			    else
			      gbyte (c);
			  }
		      }
		  }
	      }
	    else
	      {
		//selectoutput (object);
		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;
	  }
      }
  }
  auto void procdef (int key)
  {
    int p;
    int sym;
    char s[32];
    auto void getstring (void)
    {
      strcpy (s, "");
      for (;;)
	{
	  sym = line (val);
	  if (sym == '"') return;
	  val += 1;
          s[strlen(s)+1] = '\0';
          s[strlen(s)] = sym;
	}
    }
    nextatom ();
    if (type != unknown) fault (ambig);
    if (key == kspec)
      {
	tagtype (val) = spec;
	tagval (val) = gloc;
	nextatom ();
	if (type != string) fault (form);
	getstring ();
	p = strlen (s);
	//selectoutput (object);
	fputc (2, object);
	fputc (8, object);
	fputc (p, object);
	fprintf (outfile, "%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)
      {
	getstring ();
	//selectoutput (object);
	fputc (1, object);
	fputc (6, object);
	fputc (strlen (s), object);
	fprintf (object, "%s", s);
	t = xproc;
	nextatom ();
      }
    tagtype (v) = t;
    tagval (v) = cloc;
    dump (0x1E); dump (0x55); // Push ds, push bp
    dump (0x8B); dump (0xEC); // Mov BP,SP
    dump (0x33); dump (0xC0); // 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;
	dump (0x8E); dump (0xD8); // 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;
  }
  auto void instruction (void)
  {
    int t;
    int v;
    int i;
    int oper;
    int st;
    int sv;
    int si;
    int dt;
    int 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);
	    dump (0x8B); dump (0xF8); // Mov di,ax
	    direct (lea, dt, dv, 0);
	    dump (0x03); dump (0xF8); // add di,ax
	    closebracket ();
	  }
	else
	  {
	    direct (lea, dt, dv, 0);
	    dump (0x8B); dump (0xF8); // Mov di,ax
	  }
	direct (lea, st, sv, 0);
	dump (0x8B); dump (0xF0); // Mov si,ax
	if (si != 0)
	  {
	    dump (popax); dump (0x03); dump (0xF0); // add,si,ax
	  }
	dump (((dt & glabit) == 0) ? 0x16 : 0x1E); // Push SS/DS
	dump (0x07); // Pop ES
	if ((st & glabit) == 0)
	  {
	    dump (0x1E); dump (0x16); dump (0x1F); // Push DS,SS, Pop DS
	  }
	dump (0x59); dump (0xF2); 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;
  }
  auto 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 ();
	dump (0x8B); dump (0xD8); 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
  auto inline void signal_event (int event, int subevent, int extra)
  {
  }
  if (tagpos == 1)
    {
      //  (not via event: first time)
      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);
      }
      //selectoutput (list);
      fprintf (list, "%s\n\n", "                  LC Cross-compiler  06/01/81");
      for (type = kconst; type <= krepeat; type += 1)
	{
	  tag1 (tagpos) = n1 (type);
	  tag2 (tagpos) = n2 (type);
	  tagtype (tagpos) = type;
	  tagval (tagpos) = -1;
	  tagpos += 1;
	}
      strcpy (program, "");
    }
  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)] = '_';
	  }
	  //selectoutput (object);
	  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); dump (val); dump (val >> 8);
	  if (ifpos == 0)
	      pushtext (context, 0);
	  else
	    {
	      pushtext (finexp, cloc - 2);
	      atompos = ifpos + 1;
	      dump (cond() ^ 1); dump (3); dump (0xE9); dump (0); dump (0);
	      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); dump (3); dump (0xE9); dump (0); dump (0);
	      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);
    }
  //selectoutput (object);
  fputc (10, object);
  //selectoutput (list);
  fputc ('\n', list);
  exit(0);
  return(1);
}