#include ../inc/basic.inc
#include ../inc/ios.inc


const	BUFLEN		= 1024;
const	POOLSIZE	= 16384;

var	In[IOS], Out[IOS], Inbuf::BUFLEN, Outbuf::BUFLEN;
var	Lineno;
var	Pool::POOLSIZE, Pt;


length(s) do
	var	k;

	k := 0;
	while (s::k) k := k+1;
	return k;
end


ucase(s) do
	var	i;

	i := 0;
	while (s::i) do
		if ('a' <= s::i /\ s::i <= 'z')
			s::i := s::i+'A'-'a';
		i := i+1;
	end
end


error(m, n) do
	select(1, 2);
	writes("TXCGG: ");
	writes(ntoa(Lineno, 0));
	writes(": ");
	writes(m);
	if (n) do
		writes(": ");
		writepacked(2, n, length(n));
	end
	newline();
	halt;
end


init() do
	if (ios_create(In, 0, Inbuf, BUFLEN, IOF_READ) = %1)
		error("cannot establish input stream", 0);
	if (ios_create(Out, 1, Outbuf, BUFLEN, IOF_WRITE) = %1)
		error("cannot establish output stream", 0);
	Lineno := 0;
	Pt := 0;
end


isname(x) return 'A' <= x /\ x <= 'Z' \/ x = '_';


skip(s, i) do
	while (s::i = '\s' \/ s::i = '\t') i := i+1;
	return i;
end


newmacro(name, text) do
	var	len, k, lt, mac;

	k := length(name);
	lt := text-> length(text): 0;
	len := k+1 + lt+2 + 2;
	if (Pt + len >= POOLSIZE) error("out of macro space", 0);
	mac := Pt;
	Pool::(Pt+2) := k;
	memcopy(@Pool::(Pt+3), name, k);
	k := k+3;
	Pool::(Pt+k) := lt;
	Pool::(Pt+k+1) := lt>>8;
	k := k+2;
	if (text) memcopy(@Pool::(Pt+k), text, lt);
	Pool::mac := len;
	Pool::(mac+1) := len>>8;
	Pt := Pt+len;
	return mac;
end


addtomacro(mac, text, len) do
	var	k, l;

	if (Pt + len >= POOLSIZE) error("out of string space", 0);
	memcopy(@Pool::Pt, text, len);
	Pt := Pt+len;
	k := Pool::(mac+1)<<8 | Pool::mac;
	k := k + len;
	Pool::mac := k;
	Pool::(mac+1) := k>>8;
	l := mac + Pool::(mac+2) + 3;
	k := Pool::(l+1)<<8 | Pool::l;
	k := k + len;
	Pool::l := k;
	Pool::(l+1) := k>>8;
end


truncatemac(mac, len) do
	var	p, k, l;

	k := Pool::(mac+1)<<8 | Pool::mac;
	p := mac + Pool::(mac+2)+3;
	l := Pool::(p+1)<<8 | Pool::p;
	if (l < len) return 0;
	if (Pool::(p+2+l-len) = '\n' /\ Pool::(p+1+l-len) = '\r')
		len := len+1;
	l := l - len;
	Pool::p := l;
	Pool::(p+1) := l>>8;
	k := k - len;
	Pool::mac := k;
	Pool::(mac+1) := k>>8;
	Pt := Pt-len;
end


readdesc() do
	var	line::129;
	var	k, i, j, mac, off;

	k := ios_reads(In, line, 128);
	while (\ios_eof(In)) do
		Lineno := Lineno+1;
		if (k>1 /\ line::(k-2) = '\r') k:=k-1;
		line::(k-1) := 0;
		if (line::0 = 0 \/ line::0 = '!') do
			k := ios_reads(In, line, 128);
			loop;
		end
		if (\isname(line::0)) error("label expected", line);
		i := 0;
		while (isname(line::i)) i := i+1;
		j := i;
		i := skip(line, i);
		if (\line::i) error("missing text", line);
		line::j := 0;
		ie (line::i \= '{') do
			newmacro(line, @line::i);
		end
		else do
			mac := newmacro(line, 0);
			k := ios_reads(In, line, 128);
			off := 0;
			off := skip(line, off);
			while (line::0 \= '}') do
				if (ios_eof(In))
					error("EOF in routine text", 0);
				addtomacro(mac, @line::off, k-off);
				k := ios_reads(In, line, 128);
				off := 0;
			end
			truncatemac(mac, 1);
		end
		k := ios_reads(In, line, 128);
	end
end


dumpmacs() do
	var	p, q, k;

	p := 0;
	while (p<Pt) do
		k := Pool::(p+2);
		writepacked(1, @Pool::(p+3), k);
		writepacked(1, packed" = ", 3);
		q := p+k+3;
		k := Pool::(q+1)<<8 | Pool::q;
		writepacked(1, @Pool::(q+2), k);
		newline();
		p := p + (Pool::(p+1)<<8 | Pool::p);
	end
end


findmac(s) do
	var	p, q, k, l;

	p := 0;
	l := length(s);
	while (p<Pt) do
		k := Pool::(p+2);
		q := p+k+3;
		if (k = l /\ \memcomp(@Pool::(p+3), s, k))
			return @Pool::q;
		p := p + (Pool::(p+1)<<8 | Pool::p);
	end
	return 0;
end


require_bool(s) do
	var	text, k;

	text := findmac(s);
	if (\text) error("undefined symbol", s);
	k := text::1<<8 | text::0;
	ucase(@text::2);
	text := @text::2;
	if (	(k \= 4 \/ memcomp(text, packed"TRUE", 4)) /\
		(k \= 5 \/ memcomp(text, packed"FALSE", 5))
	)
		error("must be either TRUE or FALSE", s);
	ios_writes(Out, "#define\s");
	ios_write(Out, s, length(s)); ios_wrch(Out, '\s');
	ios_write(Out, text, k); ios_wrch(Out, '\n');
end


generate() do
	var	text, k;
	var	ch;
	var	name::256, i;

	ios_close(In);
	if (ios_open(In, "txcg_frame", Inbuf, BUFLEN, IOF_READ) = %1)
		error("cannot open TXCG frame file", packed"txcg_frame");
	require_bool(packed"SRC_DEST");
	require_bool(packed"LONG_BRANCHES");
	ios_wrch(Out, '\n');
	ch := ios_rdch(In);
	while (\ios_eof(In)) do
		ie (ch = '{') do
			ch := ios_rdch(In);
			i := 0;
			while (ch \= '}') do
				if (i >= 254) do
					name::255 := 0;
					error("routine name too long", name);
				end
				name::i := ch;
				i := i+1;
				ch := ios_rdch(In);
			end
			name::i := 0;
			text := findmac(name);
			if (\text) error("undefined routine", name);
			k := text::1<<8 | text::0;
			ios_write(Out, @text::2, k);
		end
		else do
			ios_wrch(Out, ch);
		end
		ch := ios_rdch(In);
	end
end


finish() do
	ios_close(In);
	ios_close(Out);
end


do
	init();
	readdesc();
	!dumpmacs();
	generate();
	finish();
end
