const	BPW =		{BPW};

const	BUFSIZE	=	1025;
const	TEXTLEN	=	129;
const	QUEUELEN=	256;

var	Buffer[BUFSIZE], Cp, Ep, Rejected;
var	OBuffer[BUFSIZE], Obp;
var	Addr;

var	Registers, NReg, Rx, Depth;
var	LdQueue[QUEUELEN], Qs, Qe;

var	Label;
var	Dataname;
var	Pubname[TEXTLEN];
var	Segment;
const	TEXT=1, DATA=2, BSS=3;

const	ICLAB=129, IDLAB=130, IDECL=131, IDATA=132, ICREF=133,
	IDREF=134, ISTR=135, IPSTR=136, IINIT=137, IHDR=010,
	IEND=011,

	INEG=012, ILNOT=013, IBNOT=014, IPOP=015, ICLEAN=144,
	INOP=017,

	IINDB=018, IIND=019, IDREFB=020, IDEREF=021, IINCG=150,
	IINCL=151,

	IMUL=024, IDIV=025, IMOD=026, IADD=027, ISUB=028, IBAND=029,
	IBOR=030, IBXOR=031,

	IBSHL=032, IBSHR=033, IEQU=034, INEQU=035, ILESS=036,
	IGRTR=037, ILTEQ=038, IGTEQ=039,

	ILDG=168, ILDGV=169, ILDL=170, ILDLV=171, ILDLAB=172,

	INUM=173, ISAVG=174, ISAVL=175, ISTORE=048, ISTORB=049,

	ISTACK=178, ICALL=179, ICALR=52, IEXEC=181, IBRF=182,
	IBRT=183, INBRF=184, INBRT=185, IJUMP=186, IUNEXT=187,
	IDNEXT=188, IHALT=061,

	IPUB=190, IEXT=191,

	IUMUL=64, IUDIV=65, IULESS=66, IUGRTR=67, IULTEQ=68,
	IUGTEQ=69,

	IDUP = 70, ISWAP = 71,

	ILINE = 200, IGSYM = 201, ILSYM = 202,

	IENDOFSET=75;


init() do
	Ep := 1;
	Cp := 1;
	Rejected := %1;
	Obp := 0;
	Addr := 0;
	Registers := [
		{REGISTERS}
		%1
	];
	NReg := 0;
	while (Registers[NReg] \= %1) NReg := NReg+1;
	Rx := 0;
	Depth := 0;
	Qs := 0;
	Qe := 0;
	Label := 0;
	Segment := 0;
	Dataname := 0;
	Pubname[0] := 0;
end


error(msg) do
	select(1, 2);
	writes(ntoa(Addr, 0));
	writes(": ");
	writes(msg);
	newline();
	close(open("TXCG.ERR", 1));
	halt;
end


internal(msg) do
	select(1, 2);
	writes("internal error: ");
	error(msg);
end


newlab() do
	Label := Label + 1;
	if (\Label) internal("too many tlabels");
	return Label;
end


rdch() do
	if (Rejected >= 0) do
		var	o;
		o := Rejected;
		Rejected := %1;
		return o;
	end
	if (Cp >= Ep) do
		Ep := reads(Buffer, BUFSIZE-1);
		Cp := 0;
		if (\Ep) return %1;
	end
	Cp := Cp+1;
	Addr := Addr+1;
	return Buffer[Cp-1];
end


queue(op, arg) do
	if (Qe >= QUEUELEN) error("Load queue overflow");
	LdQueue[Qe] := op;
	LdQueue[Qe+1] := arg;
	Qe := Qe+2;
end


strcpy(d, s) do
	var	i;

	i := 0;
	while (s[i]) do
		d[i] := s[i];
		i := i+1;
	end
	d[i] := 0;
	return i;
end


var untoa_buf[12];
untoa(u) do
	var	i;

	i := 10;
	untoa_buf[11] := 0;
	while (1) do
		untoa_buf[i] := u mod 10 + '0';
		u := u ./ 10;
		if (\u) leave;
		i := i-1;
	end
	return @untoa_buf[i];
end


format(buf, tp, va) do
	var	i, j, k;

	i := 0;
	j := 0;
	k := 0;
	while (tp[i]) do
		ie (tp[i] = '%') do
			i := i+1;
			ie (tp[i] = 'D') do
				j := j + strcpy(@buf[j], ntoa(va[k], 0));
				k := k+1;
			end
			else ie (tp[i] = 'S') do
				j := j + strcpy(@buf[j], va[k]);
				k := k+1;
			end
			else ie (tp[i] = 'U') do
				j := j + strcpy(@buf[j], untoa(va[k]));
				k := k+1;
			end
			else do
				buf[j] := tp[i];
				j := j+1;
			end
		end
		else do
			buf[j] := tp[i];
			j := j+1;
		end
		i := i+1;
	end
	buf[j] := 0;
	return buf;
end


genraw(s) do
	var	k;

	k := 0;
	while (s[k]) do
		if (Obp >= BUFSIZE-1) do
			OBuffer[Obp] := 0;
			writes(OBuffer);
			Obp := 0;
		end
		OBuffer[Obp] := s[k];
		Obp := Obp+1;
		k := k+1;
	end
end


gen(cmd, va) do
	var	genbuf[TEXTLEN];

	format(genbuf, cmd, va);
	genraw(genbuf); genraw("\n");
end


var	genref_buf[TEXTLEN];
var	genref_buf2[TEXTLEN];
genref(m, a) do
	var	va;

	va := [ 0, 0, %1 ];
	genref_buf2[0] := 0;
	ie (m = ILDG) do
		va[0] := a;
		format(genref_buf, {GLOB_REF}, va);
	end
	else ie (m = ILDGV) do
		va[0] := a;
		format(genref_buf, {GLOB_VEC_REF}, va);
	end
	else ie (m = ILDL) do
		va[0] := -a*BPW;
		format(genref_buf, {LOC_REF}, va);
	end
	else ie (m = ILDLV) do
		va[0] := -a*BPW;
		format(genref_buf, {LOC_VEC_REF}, va);
		strcpy(genref_buf2, {LOC_VEC_ADJUST});
	end
	else ie (m = ILDLAB) do
		va[0] := a;
		format(genref_buf, {LAB_REF}, va);
	end
	else ie (m = INUM) do
		va[0] := a;
		format(genref_buf, {CONST_REF}, va);
	end
	else do
		internal("unknown mode in GENREF()");
	end
	va[0] := genref_buf;
	va[1] := genref_buf2;
	return va;
end


allocreg(va) do
	ie (Depth \/ Rx >= NReg) do
		if (Rx >= NReg) Rx := 0;
		va[0] := Registers[Rx][0];
		{PUSH_REG_SEQ}
		Depth := Depth+1;
	end
	else do
		va[0] := Registers[Rx][0];
	end
	return Rx;
end


load(m, a) do
	var	va;
	var	i2;

	va := [ 0, 0 ];
	allocreg(va);
#ifeq SRC_DEST TRUE
	va[0] := genref(m, a);
	i2 := va[0][1];
	va[0] := va[0][0];
	va[1] := Registers[Rx][0];
	{LOAD_REG_SEQ}
	if (i2[0]) gen(i2, @va[1]);
#end
#ifeq SRC_DEST FALSE
	va[1] := genref(m, a);
	i2 := va[1][1];
	va[0] := Registers[Rx][0];
	va[1] := va[1][0];
	{LOAD_REG_SEQ}
	if (i2[0]) gen(i2, va);
#end
	Rx := Rx+1;
end


flush(n) do
	while (Qs < Qe-(n<<1)) do
		load(LdQueue[Qs], LdQueue[Qs+1]);
		Qs := Qs+2;
	end
	if (n = 0) do
		Qs := 0;
		Qe := 0;
	end
end


{LOCAL_ROUTINES}


unary(op) do
	var	va;

	flush(0);
	if (\Rx) internal("no registers active in UNARY()");
	va := [ 0, 0 ];
	va[0] := Registers[Rx-1][0];
	ie (op = INEG) do
		{NEG_REG_SEQ}
	end
	else ie (op = IBNOT) do
		{NOT_REG_SEQ}
	end
	else ie (op = IIND) do
		va[1] := va[0];
		{IND_REG_SEQ}
	end
	else ie (op = IINDB) do
		va[1] := va[0];
		{IND_REG_BYTE_SEQ}
	end
	else ie (op = ILNOT) do
		va[1] := va[0];
		{LOGICAL_NOT_SEQ}
	end
	else do
		internal("unknown instruction in UNARY()");
	end
end


pop() do
	var	va[1], o;

	o := Rx;
	Rx := Rx-1;
	if (Rx < 1) Rx := Depth-> NReg: 0;
	if (Depth) do
		va[0] := Registers[o-1][0];
		{POP_REG_SEQ}
		Depth := Depth-1;
	end
end


unstack(va) do
	var	t;

	if (Rx < 1) internal("active count wrong in UNSTACK()");
	ie (Rx >= 2) do
#ifeq SRC_DEST TRUE
		va[0] := Registers[Rx-1][0];
		va[1] := Registers[Rx-2][0];
#end
#ifeq SRC_DEST FALSE
		va[0] := Registers[Rx-2][0];
		va[1] := Registers[Rx-1][0];
#end
	end
	else do
		if (\Depth) internal("stack underflow in UNSTACK()");
#ifeq SRC_DEST TRUE
		va[0] := Registers[0][0];
		va[1] := Registers[NReg-1][0];
#end
#ifeq SRC_DEST FALSE
		va[0] := Registers[NReg-1][0];
		va[1] := Registers[0][0];
#end
	end
end


binary(op) do
	var	op2;
	var	va[4];
	var	relop, flg;

	flush(op = IDEREF-> 0: 1);
	if (\Rx) internal("no registers active in BINARY()");
	if (Rx < 2 /\ Depth = 0 /\ Qe-Qs=0)
		internal("too few operands in BINARY()");
	ie (Qs-Qe = 0) do
		unstack(va);
	end
	else do
#ifeq SRC_DEST TRUE
		va[0] := genref(LdQueue[Qs], LdQueue[Qs+1]);
		!XXX bug or feature??
		if (va[0][1][0]) error("performing math on @local");
		va[0] := va[0][0];
		va[1] := Registers[Rx-1][0];
#end
#ifeq SRC_DEST FALSE
 		va[0] := Registers[Rx-1][0];
 		va[1] := genref(LdQueue[Qs], LdQueue[Qs+1]);
		!XXX bug or feature??
 		if (va[1][1][0]) error("performing math on @local");
 		va[1] := va[1][0];
#end
	end
	ie (op = IDREFB) do
		{DEREF_BYTE_SEQ}
	end
	else ie (op = IDEREF) do
		{DEREF_SEQ}
	end
	else ie (op = IMUL) do
		{MUL_REG_SEQ}
	end
	else ie (op = IDIV) do
		{DIV_REG_SEQ}
	end
	else ie (op = IMOD) do
		{MOD_REG_SEQ}
	end
	else ie (op = IUMUL) do
		{UMUL_REG_SEQ}
	end
	else ie (op = IUDIV) do
		{UDIV_REG_SEQ}
	end
	else ie (op = IADD) do
		{ADD_REG_SEQ}
	end
	else ie (op = ISUB) do
		{SUB_REG_SEQ}
	end
	else ie (op = IBAND ) do
		{BIN_AND_REG_SEQ}
	end
	else ie (op = IBOR) do
		{BIN_OR_REG_SEQ}
	end
	else ie (op = IBXOR) do
		{BIN_XOR_REG_SEQ}
	end
	else ie (op = IBSHL) do
		{BIN_SHL_REG_SEQ}
	end
	else ie (op = IBSHR) do
		{BIN_SHR_REG_SEQ}
	end
	else do
		{COMP_REG_SEQ}
		op2 := rdch();
		ie (op2 = IBRT \/ op2 = IBRF) do
			pop();
			flg := op2=IBRF;
			va[0] := rdch();
			va[0] := rdch() << 8 | va[0];
#ifeq LONG_BRANCHES TRUE
			ie (op = IEQU) relop := flg-> {BNE}: {BE};
			else ie (op = INEQU) relop := flg-> {BE}: {BNE};
			else ie (op = ILESS) relop := flg-> {BGE}: {BL};
			else ie (op = IGRTR) relop := flg-> {BLE}: {BG};
			else ie (op = ILTEQ) relop := flg-> {BG}: {BLE};
			else ie (op = IGTEQ) relop := flg-> {BL}: {BGE};
			else ie (op = IULESS) relop := flg-> {BUGE}: {BUL};
			else ie (op = IUGRTR) relop := flg-> {BULE}: {BUG};
			else ie (op = IULTEQ) relop := flg-> {BUG}: {BULE};
			else ie (op = IUGTEQ) relop := flg-> {BUL}: {BUGE};
			else internal("unknown relation in BINARY()");
			genraw(relop); genraw("\t"); gen({JUMP_DEST}, va);
#end
#ifeq LONG_BRANCHES FALSE
			va[1] := newlab();
			ie (op = IEQU) relop := flg-> {BE}: {BNE};
			else ie (op = INEQU) relop := flg-> {BNE}: {BE};
			else ie (op = ILESS) relop := flg-> {BL}: {BGE};
			else ie (op = IGRTR) relop := flg-> {BG}: {BLE};
			else ie (op = ILTEQ) relop := flg-> {BLE}: {BG};
			else ie (op = IGTEQ) relop := flg-> {BGE}: {BL};
			else ie (op = IULESS) relop := flg-> {BUL}: {BUGE};
			else ie (op = IUGRTR) relop := flg-> {BUG}: {BULE};
			else ie (op = IULTEQ) relop := flg-> {BULE}: {BUG};
			else ie (op = IUGTEQ) relop := flg-> {BUGE}: {BUL};
			else internal("unknown relation in BINARY()");
			genraw(relop); genraw("\t");
				gen({BRANCH_DEST}, @va[1]);
			gen({JUMP}, va);
			gen({TMPLAB}, @va[1]);
#end
		end
		else do
			Rejected := op2;
			va[2] := newlab();
			va[3] := newlab();
			ie (op = IEQU) relop := {BNE};
			else ie (op = INEQU) relop := {BE};
			else ie (op = ILESS) relop := {BGE};
			else ie (op = IGRTR) relop := {BLE};
			else ie (op = ILTEQ) relop := {BG};
			else ie (op = IGTEQ) relop := {BL};
			else ie (op = IULESS) relop := {BUGE};
			else ie (op = IUGRTR) relop := {BULE};
			else ie (op = IULTEQ) relop := {BUG};
			else ie (op = IUGTEQ) relop := {BUL};
			else internal("unknown relation in BINARY()");
			genraw(relop); genraw("\t");
				gen({BRANCH_DEST}, @va[2]);
#ifeq SRC_DEST TRUE
			va[0] := va[1];
#end
#ifeq SRC_DEST FALSE
			va[1] := va[0];
#end
			gen({TRUE_REG}, va);
			gen({BRANCH}, @va[3]);
			gen({TMPLAB}, @va[2]);
			gen({FALSE_REG}, va);
			gen({TMPLAB}, @va[3]);
		end
	end
	if (Qe-Qs = 0) pop();
	Qs := 0;
	Qe := 0;
end


store(op, arg) do
	var	va[2];

	flush(0);
	ie (op = ISAVG \/ op = ISAVL) do
		if (Rx < 1) internal("active count wrong in STORE()");
#ifeq SRC_DEST TRUE
		va[0] := Registers[Rx-1][0];
		va[1] := genref(op=ISAVL-> ILDL: ILDG, arg);
		va[1] := va[1][0];
#end
#ifeq SRC_DEST FALSE
 		va[1] := Registers[Rx-1][0];
 		va[0] := genref(op=ISAVL-> ILDL: ILDG, arg);
 		va[0] := va[0][0];
#end
		{STORE_REG_SEQ}
		!Rx := Rx-1;
		pop();
	end
	else do
		unstack(va);
		ie (op = ISTORB) do
			{STORE_BYTE_SEQ}
		end
		else do
			{STORE_IND_REG_SEQ}
		end
		pop();
		pop();
	end
	! Leftover values are OK when computing dynamic tables
	! if (Rx) internal("unbalanced expression in STORE()");
	! if (Depth) internal("leftover values in STORE()");
end


pcall(op, arg) do
	var	i, rl, va[1];
	var	buf[40];

	flush(0);
	rl := op = ICALR-> Rx-1: Rx;
	if (Depth) do
		for (i=op=ICALR-> rl+1: rl, NReg) do
			va[0] := Registers[i][0];
			{PUSH_REG_SEQ}
			Depth := Depth+1;
		end
	end
	for (i=0, rl) do
		va[0] := Registers[i][0];
		{PUSH_REG_SEQ}
		Depth := Depth+1;
	end
	ie (op = ICALR) do
		va[0] := Registers[rl][0];
		{CALL_REG_SEQ}
	end
	else ie (op = ICALL) do
		va[0] := genref(ILDG, arg);
		va[0] := va[0][0];
		{CALL_PROC_SEQ}
	end
	else do
		va[0] := arg;
		{CALL_GVEC_PROC_SEQ}
	end
	Rx := 1;
end


pclean(arg) do
	var	va[2];
	var	i, top;

	if (arg) do
		Depth := Depth-arg;
		va[0] := arg*BPW;
		{CLEAN_STACK_SEQ}
	end
	top := (Depth+1) mod NReg - 1;
	if (top < 0 /\ Depth) top := top + NReg;
	if (top) do
#ifeq SRC_DEST TRUE
		va[0] := Registers[0][0];
		va[1] := Registers[top][0];
#end
#ifeq SRC_DEST FALSE
		va[0] := Registers[top][0];
		va[1] := Registers[0][0];
#end
		{MOVE_REG_SEQ}
	end
	for (i=top-1, %1, %1) do
		va[0] := Registers[i][0];
		{POP_REG_SEQ}
	end
	Rx := top+1;
	Depth := Depth-top;
	if (Depth) do
		for (i=NReg-1, top, %1) do
			va[0] := Registers[i][0];
			{POP_REG_SEQ}
		end
		Depth := Depth - NReg + top + 1;
	end
end


branch(op, arg) do
	var	va[2];

	flush(0);
	ie (op = IJUMP) do
		gen({JUMP}, @arg);
		! XXX This POP() may generate a dead instruction in
		! P(a,b,c,d,e->f:g);  To be improved.
		pop();
	end
	else do
		if (\Rx) internal("no registers active in BRANCH()");
		va[0] := Registers[Rx-1][0];
		va[1] := va[0];
		{CMP_ZERO_REG_SEQ}
		if (op = IBRT \/ op = IBRF) pop();
#ifeq LONG_BRANCHES TRUE
		genraw(op=IBRT\/op=INBRT-> {BNE}: {BE});
		genraw("\t"); gen({JUMP_DEST}, @arg);
#end
#ifeq LONG_BRANCHES FALSE
		va[0] := newlab();
		genraw(op=IBRT\/op=INBRT-> {BE}: {BNE});
		genraw("\t"); gen({BRANCH_DEST}, va);
		gen({JUMP}, @arg);
		gen({TMPLAB}, va);
#end
	end
end


genstr(ext, s, len, lab) do
	var	buf[20];
	var	va[1];
	var	i, j, k;

	ext := ext = ISTR;
	if (lab) do
		va[0] := lab;
		format(buf, {DATALABEL}, va);
		genraw(buf); genraw("\t");
	end
	k := 0;
	for (i=0, len / 5) do
		genraw(ext-> {WORDDATA}: {BYTEDATA});
		for (j=0, 5) do
			genraw(ntoa(s[k], 0)); k := k+1;
			if (j<4) genraw(", ");
		end
		if (i < len/5-1) genraw("\n");
	end
	if (k < len) do
		if (i) genraw("\n");
		genraw(ext-> {WORDDATA}: {BYTEDATA});
		while (k<len) do
			genraw(ntoa(s[k], 0)); k := k+1;
			if (k<len) genraw(", ");
		end
	end
	if (\k) do
		genraw({WORDDATA}); genraw("0"); len := 1;
	end
	ie (ext) do
		genraw(", 0");
	end
	else do
		while (1) do
			genraw(", 0");
			len := len+1;
			if (\(len mod BPW)) leave;
		end
	end
	genraw("\n");
end


dest(seg) do
	if (Segment \= seg) do
		ie (seg = TEXT) gen({SET_TEXT}, 0);
		else ie (seg = DATA) gen({SET_DATA}, 0);
		else gen({SET_BSS}, 0);
	end
	Segment := seg;
end


publicate(name) do
	genraw({DECL_GLOBAL}); genraw(name); genraw("\n");
	genraw(name); genraw(":\n");
end


generate(op, a1, a2, sbuf) do
	var	va[2];

	ie (op = ILDG \/ op = ILDGV \/ op = ILDL \/ op = ILDLV \/
		op = ILDLAB \/ op = INUM
	) do
		queue(op, a1);
	end
	else ie (op = INEG \/ op = ILNOT \/ op = IBNOT \/ op = IINDB \/
		op = IIND
	) do
		dest(TEXT);
		unary(op);
	end
	else ie (op = IDREFB \/ op = IDEREF \/ op = IMUL \/ op = IDIV \/
		op = IMOD \/ op = IADD \/ op = ISUB \/ op = IBAND \/
		op = IBOR \/ op = IBXOR \/ op = IBSHL \/ op = IBSHR \/
		op = IEQU \/ op = INEQU \/ op = ILESS \/ op = IGRTR \/
		op = ILTEQ \/ op = IGTEQ \/ op = IUMUL \/ op = IUDIV \/
		op = IULESS \/ op = IUGRTR \/ op = IULTEQ \/ op = IUGTEQ
	) do
		dest(TEXT);
		binary(op);
	end
	else ie (op = ISAVG \/ op = ISAVL \/ op = ISTORE \/ op = ISTORB) do
		dest(TEXT);
		store(op, a1);
	end
	else ie (op = ICALL \/ op = ICALR \/ op = IEXEC) do
		dest(TEXT);
		pcall(op, a1);
	end
	else ie (op = IPOP) do
		dest(TEXT);
		flush(0);
		pop();
	end
	else ie (op = ICLEAN) do
		dest(TEXT);
		pclean(a1);
	end
	else ie (op = ISTACK) do
		dest(TEXT);
		va[0] := a1*BPW;
		{ADJUST_STACK_SEQ}
	end
	else ie (op = IINCG) do
		dest(TEXT);
#ifeq SRC_DEST TRUE
		va[0] := a2;
		va[1] := a1;
#end
#ifeq SRC_DEST FALSE
		va[0] := a1;
		va[1] := a2;
#end
		{INC_GLOBAL_SEQ}
	end
	else ie (op = IINCL) do
		dest(TEXT);
#ifeq SRC_DEST TRUE
		va[0] := a2;
		va[1] := -a1*BPW;
#end
#ifeq SRC_DEST FALSE
		va[0] := -a1*BPW;
		va[1] := a2;
#end
		{INC_LOCAL_SEQ}
	end
	else ie (op = IUNEXT \/ op = IDNEXT) do
		dest(TEXT);
		flush(0);
		unstack(va);
		{COMP_REG_SEQ}
#ifeq LONG_BRANCHES TRUE
		genraw(op = IUNEXT-> {BGE}: {BLE});
		genraw("\t"); gen({JUMP_DEST}, @a1);
#end
#ifeq LONG_BRANCHES FALSE
		va[0] := newlab();
		genraw(op = IUNEXT-> {BL}: {BG});
		genraw("\t"); gen({BRANCH_DEST}, va);
		va[1] := a1;
		gen({JUMP}, @va[1]);
		gen({TMPLAB}, va);
#end
		pop();
		pop();
	end
	else ie (op = IBRF \/ op = IBRT \/ op = INBRF \/ op = INBRT \/
		op = IJUMP
	) do
		dest(TEXT);
		branch(op, a1);
	end
	else ie (op = IHDR) do
		dest(TEXT);
		if (Pubname[0]) publicate(Pubname);
		{PROC_PROLOGUE}
		Pubname[0] := 0;
	end
	else ie (op = IEND) do
		dest(TEXT);
		{PROC_EPILOGUE}
	end
	else ie (op = IINIT) do
		if (a1 & 256) error("input program has been precompiled");
		a1 := a1 & 255;
		if (a1 \= 1 /\ a1 \= 2) error("unknwon Tcode ID");
	end
	else ie (op = ICLAB) do
		dest(TEXT);
		flush(0);
		va[0] := a1;
		gen({LABEL}, va);
	end
	else ie (op = IDLAB) do
		if (Dataname) do
			dest(DATA);
			gen({DATALABEL_ALIAS}, @Dataname);
		end
		Dataname := a1;
	end
	else ie (op = IDECL) do
		dest(BSS);
		if (Pubname[0]) publicate(Pubname);
		va[0] := Dataname;
		va[1] := (a1=0->1:a1);
		{DECL_VAR_SEQ}
		Dataname := 0;
		Pubname[0] := 0;
	end
	else ie (op = IDATA \/ op = IDREF \/ op = ICREF) do
		dest(DATA);
		ie (Dataname) do
			va[0] := Dataname;
			va[1] := a1;
			{DECL_NAMED_DATA_SEQ}
		end
		else do
			va[0] := a1;
			{DECL_DATA_SEQ}
		end
		Dataname := 0;
	end
	else ie (op = ISTR \/ op = IPSTR) do
		dest(DATA);
		genstr(op, sbuf, a1, Dataname);
		Dataname := 0;
	end
	else ie (op = INOP) do
	end
	else ie (op = IHALT) do
		dest(TEXT);
		{HALT_SEQ}
	end
	else ie (op = IPUB) do
		strcpy(Pubname, sbuf);
	end
	else ie (op = IEXT) do
		genraw({DECL_EXTERN});
		genraw(sbuf); genraw("\n");
		genraw({JMP_TO_LABEL});
		genraw("\t"); genraw(sbuf); genraw("\n");
	end
	else ie (op = IDUP) do var r;
		flush(0);
		if (\Rx /\ \Depth)
			internal("stack underflow in GENERATE(DUP)");
#ifeq SRC_DEST TRUE
		allocreg(@va[1]);
#end
#ifeq SRC_DEST FALSE
		allocreg(va);
#end
		r := Rx=0-> NReg-1: Rx-1;
		va[0] := Registers[r][0];
		{MOVE_REG_SEQ}
		Rx := Rx+1;
	end
	else ie (op = ISWAP) do var r, r2;
		flush(0);
		if (Rx < 2 /\ \Depth)
			internal("stack underflow in GENERATE(SWAP)");
		r := Rx=0-> NReg-1: Rx-1;
		r2 := r=0-> NReg-1: r-1;
		va[0] := Registers[r2][0];
		va[1] := Registers[r][0];
		{SWAP_REGS_SEQ}
	end
	else do
		internal("unknown instruction in GENERATE()");
	end
end


xlate() do
	var	op, o2, a1, a2, a3, i, j, ch;
	var	sbuf[256];
	var	k64;

	op := rdch();
	if (op = %1) return 0;
	o2 := op & ~128;
	k64 := 16384;	! split k64 := 16384<<2; to
	k64 := k64<<2;	! avoid constant expression folding
	if (o2 < 1 \/ o2 >= IENDOFSET) error("invalid opcode");
	if (op & 128) do
		a1 := rdch();
		a1 := rdch() << 8 | a1;
		if (a1 > 32767) a1 := a1-k64;	! 32-bit hack!
	end
	ie (op = IINCL \/ op = IINCG \/ op = IINIT /\ a1 > 1) do
		a2 := rdch();
		a2 := rdch() << 8 | a2;
		if (a2 > 32767) a2 := a2-k64;	! 32-bit hack!
	end
	else if (op = ISTR \/ op = IPSTR \/ op = IPUB \/ op = IEXT \/
		op = IGSYM \/ op = ILSYM
	) do
		for (i=0, a1) sbuf[i] := rdch();
		sbuf[i] := 0;
		if (op = op = IGSYM \/ op = ILSYM) do
			a3 := rdch();
			a3 := rdch() << 8 | a2;
			if (a3 > 32767) a2 := a2-k64;	! 32-bit hack!
		end
	end
	generate(op, a1, a2, sbuf);
end


prologue() do
	genraw({HEADER});
	genraw("\n");
	{INIT_SEQ}
end


epilogue() do
	{END_SEQ}
end


do
	init();
	prologue();
	while (Ep) xlate();
	epilogue();
	if (Obp) do
		OBuffer[Obp] := 0;
		writes(Obuffer);
	end
end

