!	TXOPT -- A Tcode Optimizer for T3X.
!	Copyright (C) 1998,1999 Nils M Holm
!
!	See the file LICENSE for conditions of use.
!
!	TXOPT is much faster then TSOPT (the intermediate code optimizer
!	used by T3) because it does not build a tree structure, but
!	processes the Tcode program directly.
!	The only drawback of this method is the limitation of the input
!	program size to maximally 32766 bytes. (Of course, this limitation
!	could be removed by using a more intelligent I/O scheme.)
!
!	TXOPT currently performs the following transformations:
!
!	[ N,M,K = constant  X = variable  L = label ]
!
!	1) Constant expression folding
!	N op M	-->  K  for op in {+,*,-,/,mod,&,|,^,<<,>>,<,>,<=,>=,=,\=,
!				   .*,./,.<,.>,.<=,.>=}
!	op N	-->  M  for op in  {~,-,\}
!	X * 0	-->  0
!	0 * X	-->  0
!	X * 1	-->  X
!	1 * X	-->  X
!	X * -1	-->  -X
!	-1 * X	-->  -X
!	0 / X	-->  0
!	X / 0	-->  error
!	X / 1	-->  X
!	X / -1	-->  -X
!	0 mod X	-->  0
!	X mod 0	-->  error
!	X mod 1	-->  0
!	0 + X	-->  X
!	X + 0	-->  X
!	0 - X	-->  -X
!	X - 0	-->  X
!	0 & X	-->  0
!	X & 0	-->  0
!	X & -1	-->  X
!	-1 & X	-->  X
!	0 | X	-->  X
!	X | 0	-->  X
!	X | -1	-->  -1
!	-1 | X	-->  -1
!	X << 0	-->  X
!	0 << X	-->  0
!	X >> 0	-->  X
!	0 >> X	-->  0
!	X ^ -1	-->  ~X
!	-1 ^ X	-->  ~X
!	X .* 0	-->  0
!	0 .* X	-->  0
!	X .* 1	-->  X
!	1 .* X	-->  X
!	0 ./ X	-->  0
!	X ./ 0	-->  error
!	X ./ 1	-->  X
!	X[N]	-->  X-N  for local vectors X
!	X[0]	-->  X[]
!
!	2) Peephole optimizations
!	X:=X+N	-->  inc(X,N)
!	X:=X-N	-->  inx(X,-N)
!
!	3) Constant condition folding and reduction
!	NUM N BRT L	-->  JUMP L	for N\=0
!	NUM N BRT L	-->  NOP	for N=0
!	NUM N BRF L	-->  NOP	for N\=0
!	NUM N BRF L	-->  JUMP L	for N=0
!	NOT BRT L	-->  BRF L
!	NOT BRF L	-->  BRT L
!
!	4) Jump to jump redirection
!               +-----+           +-----+
!               |     V           |     V
!          JUMP N ... CLAB N JUMP M ... CLAB M ...
!       -> JUMP M ... CLAB N JUMP M ... CLAB M ...
!               |                       ^
!               +-----------------------+
!
!	The optimizations are performed in exactly the above order,
!	because 1) may produce additional constant conditions and
!	3) may introduce new jumps to jumps.
!	Because TXOPT processes the input program as an array of
!	Tcode instructions, it replaced instructions with NOPs to
!	delete them. The generated NOPs will be removed between the
!	steps 3) and 4).
!
!	Constant expressions are folded by interpreting the Tcode
!	they consist of. This is equal to a depth-first traversal
!	of the respective expression tree and consequently, expressions
!	like 2+3*4 will be folded completely:
!
!	  +              +
!	 / \            / \
!	2   *    -->   2   12   -->   14
!          / \
!         3   4
!
!	Currently, no attempts to reorder expressions are made.
!	Therefore, expressions of the form (N op X op M) will not be
!	folded, even if 'op' is commutative. (In this case, the
!	expression could be transformed into (N op M op X), first.)
!
!	5) Elimination of dead procedures
!	Procedures which are never referenced in the program will
!	be removed during this step. The algorithm is as follows:
!
!	1- Mark all procedures unused by reversing the signs of
!		their labels:
!			CLAB n HDR  -->  CLAB -n HDR
!	2- Recursively traverse all procedures which can be reached
!		from the main program which starts at label 0 and
!		extends up to the top (end) of the program (Ctop).
!		Each visited procedure is marked 'used' again.
!		All procedures which can be reached through CALL or
!		LDLAB instructions will be unmarked by this step.
!	3- Iterate through the program and unmark all procedures which
!		are referenced by CREF instructions.
!	4- Procedures which are still marked at this point cannot
!		be reached at execution time. They are overwritten
!		with NOP instructions.
!	5- The program is condensed by removing all NOPs.


interface	readpacked(3) = 11,
		writepacked(3),
		reposition(4),
		rename(2),
		memcopy(3),
		memcomp(3);


!#ifeq SMALL 0
const	CODESIZE	= 32766;
const	NLABELS		= 4096;
!#end
!#ifeq SMALL 1
! const	CODESIZE	= 20480;
! const	NLABELS		= 1024;
!#end
const	STACKLEN	= 64;

var	Code::CODESIZE;
var	Labels[NLABELS];
var	Stack[STACKLEN], Sp;
var	Ctop;


!	Tcode Instructions

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=72;


fatal(m, n) do
	select(1, 2);
	writes("TXOPT: ");
	writes(m);
	if (n) do
		writes(": ");
		writes(n);
	end
	newline();
	close(open("TXOPT.ERR", 1));
	writes("terminating."); newline();
	halt;
end


getw(a) do
	var	n, k64;

	k64 := 16384; k64 := k64 << 2;
	n := Code::(a+1) << 8 | Code::a;
	return (n > 32767)-> n-k64: n;	! 32-bit hack !
end


putw(n, v) do
	Code::n := v & 255;
	Code::(n+1) := v >> 8 & 255;
end


readcode() do
	var	v;

	Ctop := readpacked(0, Code, CODESIZE);
	if (Ctop = CODESIZE) fatal("program too big", 0);
	Code::(CODESIZE-1) := ILDG;
	if (Code::0 \= IINIT) fatal("bad input file format", 0);
	v := getw(1);
	if (v \= 1 /\ v \=2) fatal("unsupported Tcode version", 0);
end


writecode() do
	var	k;

	k := writepacked(1, Code, Ctop);
	if (k \= Ctop) fatal("file write error", 0);
end


next(p) do
	if (Code::p = IINIT) do
		if (Code::(p+1) = 2) return p+5;
		return p+3;
	end
	if (	Code::p = ISTR \/ Code::p = IPSTR \/
		Code::p = IPUB \/ Code::p = IEXT
	)
		return p+getw(p+1)+3;
	if (Code::p = IGSYM \/ Code::p = ILSYM)
		return p+getw(p+1)+5;
	if (Code::p = IINCL \/ Code::p = IINCG) return p+5;
	if (Code::p & 128) return p+3;
	return p+1;
end


nop3(p) do
	Code::p := INOP;
	Code::(p+1) := INOP;
	Code::(p+2) := INOP;
end


fold_mul(p, a1, a2, t1, t2, v1, v2) do
	if (	t1 = INUM /\ v1 = 0 \/		! x*0, 0*x --> 0
		t2 = INUM /\ v2 = 0
	) do
		nop3(a2);
		Code::a1 := INUM;
		putw(a1+1, 0);
		Code::p := INOP;
		Sp := Sp-1;
		return %1;
	end
	if (t1 = INUM /\ v1 = 1) do		! x*1 --> x
		nop3(a1);
		Code::p := INOP;
		Sp := Sp-1;
		Stack[Sp-1] := a2;
		return %1;
	end
	if (t2 = INUM /\ v2 = 1) do		! 1*x --> x
		nop3(a2);
		Code::p := INOP;
		Sp := Sp-1;
		return %1;
	end
	if (t1 = INUM /\ v1 = %1) do		! x*-1 --> -x
		nop3(a1);
		Code::p := INEG;
		Sp := Sp-1;
		Stack[Sp-1] := a2;
		return %1;
	end
	if (t2 = INUM /\ v2 = %1) do		! -1*x --> -x
		nop3(a2);
		Code::p := INEG;
		Sp := Sp-1;
		return %1;
	end
	return 0;
end


fold_div(p, a1, a2, t1, t2, v1, v2) do
	if (t1 = INUM /\ v1 = 0) do		! 0/x --> 0
		nop3(a2);
		Code::a1 := INUM;
		putw(a1+1, 0);
		Code::p := INOP;
		Sp := Sp-1;
		return %1;
	end
	if (t2 = INUM /\ v2 = 0) do		! x/0 --> _|_
		fatal("constant divide by zero", 0);
	end
	if (t2 = INUM /\ v2 = 1) do		! x/1 --> x
		nop3(a2);
		Code::p := INOP;
		Sp := Sp-1;
		return %1;
	end
	if (t2 = INUM /\ v2 = %1) do		! x/-1 --> -x
		nop3(a2);
		Code::p := INEG;
		Sp := Sp-1;
		return %1;
	end
	return 0;
end


fold_mod(p, a1, a2, t1, t2, v1, v2) do
	if (t1 = INUM /\ v1 = 0) do		! 0 mod x --> 0
		nop3(a2);
		Code::a1 := INUM;
		putw(a1+1, 0);
		Code::p := INOP;
		Sp := Sp-1;
		return %1;
	end
	if (t2 = INUM /\ v2 = 0) do		! x mod 0 --> _|_
		fatal("constant divide by zero", 0);
	end
	if (t2 = INUM /\ v2 = 1) do		! x mod 1 --> 0
		nop3(a2);
		Code::p := INOP;
		Code::a1 := INUM;
		putw(a1+1, 0);
		Sp := Sp-1;
		return %1;
	end
	return 0;
end


fold_add(p, a1, a2, t1, t2, v1, v2) do
	if (t1 = INUM /\ v1 = 0) do		! 0+x --> x
		nop3(a1);
		Code::p := INOP;
		Sp := Sp-1;
		Stack[Sp-1] := a2;
		return %1;
	end
	if (t2 = INUM /\ v2 = 0) do		! x+0 --> x
		nop3(a2);
		Code::p := INOP;
		Sp := Sp-1;
		return %1;
	end
	return 0;
end


fold_sub(p, a1, a2, t1, t2, v1, v2) do
	if (t1 = INUM /\ v1 = 0) do		! 0-x --> -x
		nop3(a1);
		Code::p := INEG;
		Sp := Sp-1;
		Stack[Sp-1] := a2;
		return %1;
	end
	if (t2 = INUM /\ v2 = 0) do		! x-0 --> x
		nop3(a2);
		Code::p := INOP;
		Sp := Sp-1;
		return %1;
	end
	return 0;
end


fold_band(p, a1, a2, t1, t2, v1, v2) do
	if (	t1 = INUM /\ v1 = 0 \/
		t2 = INUM /\ v2 = 0
	) do					! 0&x, x&0 --> 0
		nop3(a2);
		Code::a1 := INUM;
		putw(a1+1, 0);
		Code::p := INOP;
		Sp := Sp-1;
		return %1;
	end
	if (t1 = INUM /\ v1 = %1) do		! %1&x --> x
		nop3(a1);
		Code::p := INOP;
		Sp := Sp-1;
		Stack[Sp-1] := a2;
		return %1;
	end
	if (t2 = INUM /\ v2 = %1) do		! x&%1 --> x
		nop3(a2);
		Code::p := INOP;
		Sp := Sp-1;
		return %1;
	end
	return 0;
end


fold_bor(p, a1, a2, t1, t2, v1, v2) do
	if (	t1 = INUM /\ v1 = %1 \/
		t2 = INUM /\ v2 =%1 
	) do					! %1|x, x|%1 --> %1
		nop3(a2);
		Code::a1 := INUM;
		putw(a1+1, %1);
		Code::p := INOP;
		Sp := Sp-1;
		return %1;
	end
	if (t1 = INUM /\ v1 = 0) do		! 0|x --> x
		nop3(a1);
		Code::p := INOP;
		Sp := Sp-1;
		Stack[Sp-1] := a2;
		return %1;
	end
	if (t2 = INUM /\ v2 = 0) do		! x|0 --> x
		nop3(a2);
		Code::p := INOP;
		Sp := Sp-1;
		return %1;
	end
	return 0;
end


fold_bshl(p, a1, a2, t1, t2, v1, v2) do
	if (t1 = INUM /\ v1 = 0) do		! 0<<x --> 0
		nop3(a2);
		Code::a1 := INUM;
		putw(a1+1, 0);
		Code::p := INOP;
		Sp := Sp-1;
		return %1;
	end
	if (t2 = INUM /\ v2 = 0) do		! x<<0 --> x
		nop3(a2);
		Code::p := INOP;
		Sp := Sp-1;
		return %1;
	end
	return 0;
end


fold_bshr(p, a1, a2, t1, t2, v1, v2)
	return fold_bshl(p, a1, a2, t1, t2, v1, v2);
	

fold_bxor(p, a1, a2, t1, t2, v1, v2) do
	if (t1 = INUM /\ v1 = %1) do		! x^%1 --> ~x
		nop3(a1);
		Code::p := IBNOT;
		Sp := Sp-1;
		Stack[Sp-1] := a2;
		return %1;
	end
	if (t2 = INUM /\ v2 = %1) do		! x^%1 --> ~x
		nop3(a2);
		Code::p := IBNOT;
		Sp := Sp-1;
		return %1;
	end
	return 0;
end


fold_deref(p, a1, a2, t1, t2, v1, v2) do
	! Fold the address computation of local vector members
	! at constant offsets
	if (t1 = ILDLV /\ t2 = INUM) do		! x[N] --> @(x-N)
		putw(a1+1, v1 - v2);
		nop3(a2);
		Code::p := INOP;
		Sp := Sp-1;
		return %1;
	end
	if (t2 = INUM /\ v2 = 0) do		! x[0] --> x[]
		nop3(a2);
		Code::p := INOP;
		return %1;
	end
	return 0;
end


fold_umul(p, a1, a2, t1, t2, v1, v2) do
	if (	t1 = INUM /\ v1 = 0 \/		! x.*0, 0.*x --> 0
		t2 = INUM /\ v2 = 0
	) do
		nop3(a2);
		Code::a1 := INUM;
		putw(a1+1, 0);
		Code::p := INOP;
		Sp := Sp-1;
		return %1;
	end
	if (t1 = INUM /\ v1 = 1) do		! x.*1 --> x
		nop3(a1);
		Code::p := INOP;
		Sp := Sp-1;
		Stack[Sp-1] := a2;
		return %1;
	end
	if (t2 = INUM /\ v2 = 1) do		! 1.*x --> x
		nop3(a2);
		Code::p := INOP;
		Sp := Sp-1;
		return %1;
	end
	return 0;
end


fold_udiv(p, a1, a2, t1, t2, v1, v2) do
	if (t1 = INUM /\ v1 = 0) do		! 0./x --> 0
		nop3(a2);
		Code::a1 := INUM;
		putw(a1+1, 0);
		Code::p := INOP;
		Sp := Sp-1;
		return %1;
	end
	if (t2 = INUM /\ v2 = 0) do		! x./0 --> _|_
		fatal("constant divide by zero", 0);
	end
	if (t2 = INUM /\ v2 = 1) do		! x./1 --> x
		nop3(a2);
		Code::p := INOP;
		Sp := Sp-1;
		return %1;
	end
	return 0;
end


fold_binary(p) do
	var	op, t1, t2, a1, a2, v1, v2;

	op := Code::p;
	a1 := Stack[Sp-2];
	a2 := Stack[Sp-1];
	t1 := Code::a1;
	t2 := Code::a2;
	v1 := getw(a1+1);
	v2 := getw(a2+1);
	Sp := Sp-1;
	! Fold operations with two constant operands
	! constant OP constant --> constant
	if (t1 = INUM /\ t2 = INUM) do
		v1 := getw(a1+1);
		v2 := getw(a2+1);
		if (\v2 /\ (op = IMOD \/ op = IDIV))
			fatal("constant divide by zero", 0);
		ie (op = IDEREF) v1 := v1 - v2;
		else ie (op = IMUL) v1 := v1 * v2;
		else ie (op = IDIV) v1 := v1 / v2;
		else ie (op = IMOD) v1 := v1 mod v2;
		else ie (op = IADD) v1 := v1 + v2;
		else ie (op = ISUB) v1 := v1 - v2;
		else ie (op = IBAND) v1 := v1 & v2;
		else ie (op = IBOR) v1 := v1 | v2;
		else ie (op = IBXOR) v1 := v1 ^ v2;
		else ie (op = IBSHL) v1 := v1 << v2;
		else ie (op = IBSHR) v1 := v1 >> v2;
		else ie (op = IEQU) v1 := v1 = v2;
		else ie (op = INEQU) v1 := v1 \= v2;
		else ie (op = ILESS) v1 := v1 < v2;
		else ie (op = IGRTR) v1 := v1 > v2;
		else ie (op = ILTEQ) v1 := v1 <= v2;
		else ie (op = IGTEQ) v1 := v1 >= v2;
		else ie (op = IUMUL) v1 := v1 .* v2;
		else ie (op = IUDIV) v1 := v1 ./ v2;
		else ie (op = IULESS) v1 := v1 .< v2;
		else ie (op = IUGRTR) v1 := v1 .> v2;
		else ie (op = IULTEQ) v1 := v1 .<= v2;
		else if (op = IUGTEQ) v1 := v1 .>= v2;
		putw(a1+1, v1);
		nop3(a2);
		Code::p := INOP;
		return 0;
	end
	if (op = IDEREF /\ fold_deref(p, a1, a2, t1, t2, v1, v2)) return 0;
	if (op = IMUL /\ fold_mul(p, a1, a2, t1, t2, v1, v2)) return 0;
	if (op = IDIV /\ fold_div(p, a1, a2, t1, t2, v1, v2)) return 0;
	if (op = IMOD /\ fold_mod(p, a1, a2, t1, t2, v1, v2)) return 0;
	if (op = IADD /\ fold_add(p, a1, a2, t1, t2, v1, v2)) return 0;
	if (op = ISUB /\ fold_sub(p, a1, a2, t1, t2, v1, v2)) return 0;
	if (op = IBAND /\ fold_band(p, a1, a2, t1, t2, v1, v2)) return 0;
	if (op = IBOR /\ fold_bor(p, a1, a2, t1, t2, v1, v2)) return 0;
	if (op = IBSHL /\ fold_bshl(p, a1, a2, t1, t2, v1, v2)) return 0;
	if (op = IBSHR /\ fold_bshl(p, a1, a2, t1, t2, v1, v2)) return 0;
	if (op = IBXOR /\ fold_bxor(p, a1, a2, t1, t2, v1, v2)) return 0;
	if (op = IUMUL /\ fold_umul(p, a1, a2, t1, t2, v1, v2)) return 0;
	if (op = IUDIV /\ fold_udiv(p, a1, a2, t1, t2, v1, v2)) return 0;
	! otherwise, make sure the result is non-constant
	Stack[Sp-1] := CODESIZE-1;
end


fold_inc(p, start) do		! x := x+N --> inc(x,N)
	var	op, a;		! x := x-N --> inc(x,-N)
	var	q, q2;

	op := Code::p;
	if (	Code::start = ILDL /\ op = ISAVL \/
		Code::start = ILDG /\ op = ISAVG
	) do
		a := getw(start+1);
		if (a \= getw(p+1)) return 0;
		q := next(start);
		if (Code::q \= INUM) return 0;
		q2 := next(q);
		if (Code::q2 \= IADD /\ Code::q2 \= ISUB) return 0;
		Code::start := Code::start = ILDL-> IINCL: IINCG;
		putw(start+3, Code::q2 = ISUB-> -getw(start+4): getw(start+4));
		nop3(start+5);
		nop3(p);
	end
end


foldexpr() do
	var	i, op, a, v;
	var	state;
	var	last[3];

	Sp := 0;
	i := 0;
	last[0] := 0;
	last[1] := 0;
	last[2] := 0;
	while (i < Ctop) do
		op := Code::i;
		ie (	op = ILDG \/ op = ILDGV \/
			op = ILDL \/ op = ILDLV \/
			op = ILDLAB \/ op = INUM
		) do
			if (Sp+1 >= STACKLEN)
				fatal("FOLDEXPR: stack overflow", 0);
			Stack[Sp] := i;
			Sp := Sp+1;
		end
		else ie (Sp /\ (op = INEG \/ op = ILNOT \/ op = IBNOT)) do
			ie (Code::(Stack[Sp-1]) = INUM) do
				a := Stack[Sp-1];
				v := getw(a+1);
				ie (op = INEG) v := -v;
				else ie (op = ILNOT) v := \v;
				else v := ~v;
				putw(a+1, v);
				Code::i := INOP;
			end
			else do
				! make sure it is non-constant
				Stack[Sp-1] := CODESIZE-1;
			end
		end
		else ie (Sp>1 /\
			(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 = IUGRTR)
		) do
			fold_binary(i);
		end
		else ie (op = IDLAB \/ op = IDECL \/ op = IDATA \/
			op = ICREF \/ op = IDREF \/ op = ISTR \/
			op = IPSTR \/ op = INOP \/ op = ILINE \/
			op = IGSYM \/ op = ILSYM
		) do
			! ignore
		end
		else do
			Sp := 0;
			if ((op = ISAVL \/ op = ISAVG) /\ last[0])
				fold_inc(i, last[0]);
		end
		last[0] := last[1];
		last[1] := last[2];
		last[2] := i;
		i := next(i);
	end
end


foldcond() do
	var	i, v, op;
	var	last;

	i := 0;
	last := 0;
	while (i < Ctop) do
		op := Code::i;
		ie (	(op = IBRF \/ op = IBRT) /\
			Code::last = INUM
		) do
			v := getw(last+1);
			! NUM T BRT L --> JUMP L
			! NUM F BRT L --> NOP
			ie (op = IBRT) do
				nop3(last);
				ie (v)
					Code::i := IJUMP;
				else
					nop3(i);
			end
			! NUM T BRF L --> NOP
			! NUM F BRF L --> JUMP L
			else do ! BRF
				nop3(last);
				ie (v)
					nop3(i);
				else
					Code::i := IJUMP;
			end
		end
		else if ((op = IBRF \/ op = IBRT) /\
			Code::last = ILNOT
		) do
			! NOT BRT  --> BRF
			! NOT BRF  --> BRT
			! NOT NBRT --> NBRF
			! NOT NBRF --> NBRT
			Code::i := op = IBRT-> IBRF:
				op = IBRF-> IBRT:
				op = INBRT-> INBRF:
				INBRT;
			Code::last := INOP;
		end
		if (Code::i \= INOP) last := i;
		i := next(i);
	end
end


jumpredir() do
	var	i, j, k;

	for (i=0, NLABELS) Labels[i] := %1;
	i := 0;
	while (i < Ctop) do
		if (Code::i = ICLAB) do
			j := getw(i+1);
			if (j >= NLABELS) fatal("too many labels", 0);
			Labels[j] := i+3;
		end
		i := next(i);
	end
	i := 0;
	while (i < Ctop) do
		if (Code::i = IJUMP) do
			j := i;
			while (1) do
				if (Code::j \= IJUMP) leave;
				k := getw(j+1);
				if (k >= NLABELS \/ Labels[k] = %1)
					fatal("JMPREDIR: invalid destination",
						0);
				j := Labels[k];
				if (i = j) leave;
			end
			if (i \= j) putw(i+1, k);
		end
		i := next(i);
	end
end


condense() do
	var	i, j, k, m;

	i := 0;
	j := 0;
	while (i < Ctop) do
		k := next(i) - i;
		if (Code::i \= INOP) do
			memcopy(@Code::j, @Code::i, k);
			j := j+k;
		end
		i := i+k;
	end
	k := Ctop;
	Ctop := j;
	return k-Ctop;
end


unmark(a) do
	var	v;

	if (Code::a \= IHDR \/ Code::(a-3) \= ICLAB)
		fatal("UNMARK: not a procedure? Oops.", 0);
	v := getw(a-2);
	if (v > 0) return 0;
	if (v \= 0) putw(a-2, -v);
	while (a < Ctop) do
		v := Code::a;
		if (v = IEND) return 0;
		if (v = ICALL \/ v = ILDLAB) do
			v := getw(a+1);
			if (v < NLABELS /\ Labels[v] \= %1)
				unmark(Labels[v]);
		end
		a := next(a);
	end
end


unmarkrefs() do
	var	i, v;

	i := 0;
	while (i < Ctop) do
		if (Code::i = ICREF) do
			v := getw(i+1);
			if (v >= NLABELS \/ Labels[v] = %1)
				fatal("UNMARKREFS: invalid CREF", 0);
			unmark(Labels[v]);
		end
		i := next(i);
	end
end


deadprocs() do
	var	i, v, j;
	var	ndead;

	i := 0;
	while (i < Ctop) do
		if (Code::i = ICLAB /\ Code::(i+3) = IHDR)
			putw(i+1, -getw(i+1));
		i := next(i);
	end
	unmark(Labels[0]);
	unmarkrefs();
	i := 0;
	ndead := 0;
	while (i < Ctop) do
		if (Code::i = ICLAB /\ Code::(i+3) = IHDR) do
			if (getw(i+1) < 0) do
				j := i;
				while (Code::j \= IEND /\ j < Ctop)
					j := next(j);
				if (j >= Ctop) fatal(
					"DEADPROCS: unexpected end of code",
					0);
				while (i <= j) do
					Code::i := INOP;
					i := i+1;
				end
				ndead := ndead+1;
				loop;
			end
		end
		i := next(i);
	end
	if (ndead) condense();
end


do
	readcode();
	foldexpr();
	foldcond();
	condense();
	jumpredir();
	deadprocs();
	writecode();
end
