!	SLD -- A simple X.OUT and DOS EXE linker.
!	Copyright (C) 1998,2000 Nils M Holm
!	See the file LICENSE for conditions of use.

#r5;

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

!-------------------- IOSTREAM DEFINITIONS START --------------------!
struct IOS =	IOS_FD,
		IOS_BUFFER,
		IOS_FLAGS,
		IOS_LEN,
		IOS_PTR,
		IOS_END;

const		IOF_READ	= 00001,
		IOF_WRITE	= 00002,
		IOF_EOF		= 00004,
		IOF_LASTW	= 00008;

const		SEEK_SET	= 0,
		SEEK_REL	= 1,
		SEEK_END	= 2;


ios_create(iostream, fd, buffer, len, mode) do
	iostream[IOS_FD] := fd;
	iostream[IOS_BUFFER] := buffer;
	iostream[IOS_FLAGS] := mode;
	iostream[IOS_LEN] := len;
	iostream[IOS_PTR] := 0;
	iostream[IOS_END] := 0;
	return iostream;
end


ios_open(iostream, name, buffer, len, flags) do
	var	fd, mode;

	mode := flags = IOF_READ-> 0:
		flags = IOF_WRITE-> 1:
		flags = IOF_READ|IOF_WRITE-> 2: %1;
	if (mode < 0) return %1;
	fd := open(name, mode);
	if (fd < 0) return %1;
	return ios_create(iostream, fd, buffer, len, flags);
end


ios_flush(iostream) do
	var	k;

	if (	iostream[IOS_FLAGS] & IOF_WRITE /\
		iostream[IOS_FLAGS] & IOF_LASTW /\
		iostream[IOS_PTR]
	) do
		k := writepacked(iostream[IOS_FD], iostream[IOS_BUFFER],
			iostream[IOS_PTR]);
		if (k \= iostream[IOS_PTR]) return %1;
	end
	iostream[IOS_PTR] := 0;
	iostream[IOS_END] := 0;
	return 0;
end


ios_close(iostream) do
	if (ios_flush(iostream) = %1) return %1;
	close(iostream[IOS_FD]);
	iostream[IOS_FLAGS] := 0;
	return 0;
end


ios_wrch(iostream, ch) do
	iostream[IOS_FLAGS] := iostream[IOS_FLAGS] | IOF_LASTW;
	if (	iostream[IOS_PTR] >= iostream[IOS_LEN] /\
		ios_flush(iostream) = %1
	)
		return %1;
	iostream[IOS_BUFFER]::iostream[IOS_PTR] := ch;
	iostream[IOS_PTR] := iostream[IOS_PTR]+1;
	return ch;
end


ios_write(iostream, buffer, len) do
	var	i, p, l, b;

	iostream[IOS_FLAGS] := iostream[IOS_FLAGS] | IOF_LASTW;
	i := 0;
	p := iostream[IOS_PTR];
	l := iostream[IOS_LEN];
	b := iostream[IOS_BUFFER];
	while (len) do
		if (p >= l) do
			iostream[IOS_PTR] := p;
			if (ios_flush(iostream) = %1) return %1;
			p := iostream[IOS_PTR];
			l := iostream[IOS_LEN];
		end
		b::p := buffer::i;
		p := p+1;
		i := i+1;
		len := len-1;
	end
	iostream[IOS_PTR] := p;
	return i;
end


ios_writes(iostream, str) do
	var	k;
	var	b[1024];

	k := 0;
	while (str[k]) k := k+1;
	if (k > 1024) return %1;
	pack(str, b);
	return ios_write(iostream, b, k);
end


ios_more(iostream) do
	var	k;

	if (iostream[IOS_FLAGS] & IOF_READ) do
		k := readpacked(iostream[IOS_FD], iostream[IOS_BUFFER],
			iostream[IOS_LEN]);
		if (k < 0) return %1;
		if (k = 0)
			iostream[IOS_FLAGS] := iostream[IOS_FLAGS] | IOF_EOF;
		iostream[IOS_END] := k;
		iostream[IOS_PTR] := 0;
	end
	return k;
end


ios_rdch(iostream) do
	var	c;

	iostream[IOS_FLAGS] := iostream[IOS_FLAGS] & ~IOF_LASTW;
	if (iostream[IOS_FLAGS] & IOF_EOF) return %1;
	if (	iostream[IOS_PTR] >= iostream[IOS_END] /\
		ios_more(iostream) < 1
	)
		return %1;
	c := iostream[IOS_BUFFER]::iostream[IOS_PTR];
	iostream[IOS_PTR] := iostream[IOS_PTR]+1;
	return c;
end


ios__read(iostream, buffer, len, ckln) do
	var	i, p, e, b;

	iostream[IOS_FLAGS] := iostream[IOS_FLAGS] & ~IOF_LASTW;
	i := 0;
	p := iostream[IOS_PTR];
	e := iostream[IOS_END];
	b := iostream[IOS_BUFFER];
	while (len) do
		if (p >= e) do
			iostream[IOS_PTR] := p;
			if (ios_more(iostream) < 1) leave;
			p := iostream[IOS_PTR];
			e := iostream[IOS_END];
		end
		buffer::i := b::p;
		p := p+1;
		i := i+1;
		len := len-1;
		if (ckln /\ buffer::(i-1) = '\n') leave;
	end
	if (ckln) buffer::i := 0;
	iostream[IOS_PTR] := p;
	iostream[IOS_END] := e;
	return i;
end


ios_read(iostream, buffer, len) return ios__read(iostream, buffer, len, 0);


ios_reads(iostream, buffer, len) return ios__read(iostream, buffer, len, 1);


ios_position(iostream, offh, offl, how) do
	var	delta;

	ie (how = SEEK_REL /\ iostream[IOS_FLAGS] & IOF_LASTW) do
		if (ios_flush(iostream) = %1) return %1;
	end
	else ie (how = SEEK_REL) do
		delta := iostream[IOS_END] - iostream[IOS_PTR];
		if (ios_flush(iostream) = %1) return %1;
		offl := offl - delta;
		if (offl<0 /\ offl+delta>=0) offh := offh - 1;
	end
	else do
		if (ios_flush(iostream) = %1) return %1;
	end
	return reposition(iostream[IOS_FD], offh, offl, how);
end


ios_eof(iostream) return (iostream[IOS_FLAGS] & IOF_EOF) -> %1: 0;
!-------------------- IOSTREAM DEFINITIONS END --------------------!

const	DEBUG = 0;

const	CMDLEN =	128;
const	TEXTLEN =	129;
const	BUFLEN =	1024;

const	NAMELEN =	16;

const	IDSPACE =	28672;
const	PUBSPACE =	3072;	! words
const	EXTSPACE =	2048;	! words
const	MKSPACE =	3072;
const	RELSPACE =	3072;

const	CTEXT = 'T', CDATA = 'D', CBSS = 'B';

const	HHMAGIC = 0, HLMAGIC = 1, HFLAGS = 2,
	HTEXTLEN = 3, HDATALEN = 4, HBSSLEN = 5,
	HPUBLEN = 6, HEXTLEN = 7, HRLCLEN = 8,
	HEADER = 9;

const	PADDR = 0, PCLSS = 1, PNAME = 2, P_LEN = 12;
const	EADDR = 0, ECLSS = 1, EMRKS = 2, ENAME = 4, E_LEN = 16;
const	MADDR = 0, MCLSS = 1, MNEXT = 2, M_LEN = 3;
const	RTYPE = 0, RADDR = 1, R_LEN = 2;

const	XHMAGIC = 0, XLMAGIC = 1, XFLAGS = 2, XLTEXT = 3, XLDATA = 4,
	XLBSS = 5, XLSYM = 6, XHDR = 8;

const	EXECMAGIC_HI=	6514,
	EXECMAGIC_LO=	1060;
const	OBJMAGIC_HI=	6513,
	OBJMAGIC_LO=	1046;

const	EXECPURE	= 1;
const	EXECRELOC	= 2;

const	T_OXYGENE = 1, T_DOSEXE = 2, T_IMAGE = 3;

var	O_verbose;
var	O_outfile::CMDLEN;
var	O_debug;
var	O_type;
var	O_strip;

var	Pubsyms[PUBSPACE+TEXTLEN], Pt;
var	Extsyms[EXTSPACE+TEXTLEN], Et;
var	Marks[MKSPACE], Mp, Nmark;
var	Rloctbl[RELSPACE], Rb, Rt;

var	Errcount, Nmodules;

var	Dtop, Ctop, Btop, Ytop;

var	Dstream[IOS], Dbuf::BUFLEN,
	Cstream[IOS], Cbuf::BUFLEN;


plength(s) do
	var	k;

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


pstrcpy(a, b) memcopy(a, b, plength(b)+1);


error(m, s) do
	var	o;

	o := select(1, 2);
	writes("SLD: ");
	if (s) do
		writepacked(2, s, plength(s));
		writes(": ");
	end
	writes(m);
	newline();
	select(1, o);
	if (\O_debug) Errcount := Errcount+1;
end


fatal(m, s) do
	error(m, s);
	select(1, 2);
	writes("SLD: terminating."); newline();
	halt;
end


msg(s) do writes(s); newline(); end


iswhite(x) return x = '\s' \/ x = '\t';


rdwrd(s) return ios_rdch(s) | (ios_rdch(s) << 8);


wrwrd(s, w) do
	ios_wrch(s, w&255);
	return ios_wrch(s, w>>8);
end


var	word_buf::5;
word(n) do
	var	digits;

	digits := "0123456789ABCDEF";
	word_buf::0 := digits[(n>>8&255) / 16];
	word_buf::1 := digits[(n>>8&255) mod 16];
	word_buf::2 := digits[(n&255) / 16];
	word_buf::3 := digits[(n&255) mod 16];
	word_buf::4 := 0;
	return word_buf;
end


dumpsym(type, addr, clss, name) do
	var	c::1;

	c::0 := type;
	writepacked(1, @c, 1);
	writepacked(1, "\s", 1);
	c::0 := clss;
	writepacked(1, @c, 1);
	writepacked(1, word(addr), 4);
	writepacked(1, "\s", 1);
	writepacked(1, @name::1, name::0);
	newline();
end


adjust(a, c, n)
	ie (c = CTEXT)
		return a+Ctop;
	else ie (c = CDATA)
		return a+Dtop;
	else ie (c = CBSS)
		return a+Btop;
	else
		error("bad symbol class", n);


findpub(name) do
	var	i, n;

	for (i=0, Pt, P_LEN) do
		n := @Pubsyms[i+PNAME];
		if (name::0 = n::0 /\ \memcomp(@name::1, @n::1, n::0))
			return @Pubsyms[i];
	end
	return %1;
end


ldpubsyms(om, len) do
	var	lsym;
	var	sym, name;
	var	c, a;

	while (len) do
		if (len < 0) fatal("consistency check failed", 0);
		if (Pt+P_LEN >= PUBSPACE)
			fatal("public symbol table overflow", 0);
		sym := @Pubsyms[Pt];
		lsym := rdwrd(om);
		a := rdwrd(om);
		c := rdwrd(om);
		name := @sym[PNAME];
		if (ios_read(om, @name::1, lsym) \= lsym)
			fatal("file read error", 0);
		name::0 := lsym & 15;
		name::(lsym+1) := 0;
		if (findpub(name) \= %1) do
			error("redefined", @name::1);
		end
		a := adjust(a, c, @name::1);
		sym[PADDR] := a;
		sym[PCLSS] := c;
		Pt := Pt+P_LEN;
		if (O_debug) dumpsym('P', sym[PADDR], sym[PCLSS], name);
		len := len-lsym-6;
	end
end


newmark(link, addr, clss) do
	var	m, here, c::1;

	here := Mp;
	while (1) do
		if (Mp+M_LEN >= MKSPACE) Mp := 0;
		if (Marks[Mp+MCLSS] = 0) do
			m := @Marks[Mp];
			m[MCLSS] := clss;
			m[MADDR] := adjust(addr, clss & 255, packed "(mark)");
			m[MNEXT] := link;
			if (O_debug) do
				writepacked(1, packed "\s\s", 2);
				c::0 := m[MCLSS];
				writepacked(1, c, 1);
				writepacked(1, word(m[MADDR]), 4);
				c::0 := (m[MCLSS] & 256)-> '+': '\s';
				writepacked(1, c, 1);
			end
			Nmark := Nmark+1;
			return m;
		end
		Mp := Mp+M_LEN;
		if (Mp = here) leave;
	end
	fatal("out of mark slots", 0);
end


findext(name) do
	var	i, n;

	for (i=0, Et, E_LEN) do
		n := @Extsyms[i+ENAME];
		if (name::0 = n::0 /\ \memcomp(@name::1, @n::1, n::0))
			return @Extsyms[i];
	end
	return %1;
end


ldextsyms(om, len) do
	var	lsym, lmark;
	var	sym, name;
	var	i;
	var	addr, clss, link;
	var	old;

	while (len) do
		if (len < 0) fatal("consistency check failed", 0);
		if (Et+E_LEN >= EXTSPACE) do
			!XXX attempt compression, first
			!XXX maybe, change to cyclic allocation, anyway
			fatal("external symbol table overflow", 0);
		end
		sym := @Extsyms[Et];
		lsym := rdwrd(om);
		sym[EADDR] := rdwrd(om);
		sym[ECLSS] := rdwrd(om);
		name := @sym[ENAME];
		if (ios_read(om, @name::1, lsym) \= lsym)
			fatal("file read error", 0);
		name::0 := lsym & 15;
		name::(lsym+1) := 0;
		old := findext(name);
		ie (old \= %1 /\ old[ECLSS] = sym[ECLSS]) do
			link := old[EMRKS];
			sym := old;
		end
		else do
			Et := Et+E_LEN;
			link := %1;
		end
		if (O_debug) dumpsym('X', sym[EADDR], sym[ECLSS], name);
		lmark := rdwrd(om);
		for (i=0, lmark>>2) do
			if (i /\ \(i mod 8) /\ O_debug) newline();
			addr := rdwrd(om);
			clss := rdwrd(om);
			if (clss & 255 \= 'T' /\ clss & 255 \= 'D')
				error("bad class in mark table", 0);
			link := newmark(link, addr, clss);
		end
		if (O_debug) newline();
		sym[EMRKS] := link;
		len := len-lsym-8-lmark;
	end
end


newrle(t, a) do
	var	r;

	if (Rt+R_LEN >= RELSPACE)
		fatal("relocation table overflow", 0);
	r := @Rloctbl[Rt];
	Rt := Rt+R_LEN;
	r[RTYPE] := t;
	r[RADDR] := a;
	return r;
end


ldrloctbl(om, len) do
	var	r;

	Rt := Rb;
	while (len) do
		if (len < 0) fatal("consistency check failed", 0);
		r := newrle(0, 0);
		r[RTYPE] := rdwrd(om);
		r[RADDR] := rdwrd(om);
		len := len-4;
	end
end


! Bubble-sort the relocation table. Hmm... To be improved.
sortreloc() do
	var i, j, t, r1, r2, next;

	for (i=0, Rt-Rb, R_LEN) do
		next := 0;
		for (j=Rb, Rt-i-R_LEN, R_LEN) do
			r1 := @Rloctbl[j];
			r2 := @Rloctbl[j+R_LEN];
			if (r1[RADDR] > r2[RADDR]) do
				t := r1[RADDR];
				r1[RADDR] := r2[RADDR];
				r2[RADDR] := t;
				t := r1[RTYPE];
				r1[RTYPE] := r2[RTYPE];
				r2[RTYPE] := t;
				next := 1;
			end
		end
		if (\next) leave;
	end
end


nextreloc(pos, clss) do var re;
	while (pos < Rt) do
		re := @Rloctbl[pos];
		if (re[RTYPE] & 255 = clss) return pos;
		pos := pos+R_LEN;
	end
	return %1;
end


ldimage(om, out, clss, len, name) do
	var	i, j, re, ra, ad, c::1;
	var	k, pos;
	var	ch, nextre, nextaddr;

	nextre := nextreloc(Rb, clss);
	nextaddr := nextre=%1-> %1: Rloctbl[nextre+RADDR];
	k := 0;
	pos := 0;
	while (pos .< len) do
		ch := ios_rdch(om);
		if (pos = nextaddr) do
			re := @Rloctbl[nextre];
			ra := re[RADDR];
			nextre := nextreloc(nextre+R_LEN, clss);
			nextaddr := nextre=%1-> %1: Rloctbl[nextre+RADDR];
			ad := adjust(0, re[RTYPE]>>8, packed"(reloc)");
			if (O_debug) do
				if (\(k mod 3)) do
					if (k) newline();
					writes("R:");
				end
				writes("\s\s\s\s");
				c::0 := re[RTYPE];
				writepacked(1, c, 1);
				writes("->");
				c::0 := re[RTYPE] >> 8;
				writepacked(1, c, 1);
				writes("\s");
				writepacked(1, word(re[RADDR]), 4);
				writes(" +");
				writepacked(1, word(ad), 4);
				k := k+1;
			end
			j := ch;
			j := j + (ad & 255);
			ios_wrch(out, j);
			ch := ios_rdch(om);
			pos := pos+1;
			ch := ch + (ad>>8) + (j>>8);
		end
		ios_wrch(out, ch);
		pos := pos+1;
	end
	if (O_debug /\ k) newline();
end

clrrloctbl() do
	var	i, j, re, b;

	j := Rb;
	for (i=Rb, Rt, R_LEN) do
		re := @Rloctbl[i];
		if (re[RTYPE] >> 8 = CBSS) do
			b := @Rloctbl[j];
			b[RTYPE] := re[RTYPE];
			b[RADDR] := re[RADDR] +
				(b[RTYPE] & 255 = CTEXT-> Ctop: Dtop);
			j := j+R_LEN;
		end
	end
	Rb := j;
end


stats() do
	writes("Pubsyms="); writes(ntoa(Pt,0)); writes("\s\s");
	writes("Extsyms="); writes(ntoa(Et,0)); writes("\s\s");
	writes("Marks="); writes(ntoa(Nmark*M_LEN*2,0)); writes("\s\s");
	writes("Rloctbl="); writes(ntoa(Rt,0));
	newline();
end


loadmodule(om, name, so) do
	var	hbuf::HEADER*2, hdr[HEADER];

	if (ios_read(om, hbuf, HEADER*2) \= HEADER*2) do
		error("short file", name);
		return %1;
	end
	hdr[HHMAGIC] := hbuf::1 << 8 | hbuf::0;
	hdr[HLMAGIC] := hbuf::3 << 8 | hbuf::2;
	hdr[HFLAGS] := hbuf::5 << 8 | hbuf::4;
	hdr[HTEXTLEN] := hbuf::7 << 8 | hbuf::6;
	hdr[HDATALEN] := hbuf::9 << 8 | hbuf::8;
	hdr[HBSSLEN] := hbuf::11 << 8 | hbuf::10;
	hdr[HPUBLEN] := hbuf::13 << 8 | hbuf::12;
	hdr[HEXTLEN] := hbuf::15 << 8 | hbuf::14;
	hdr[HRLCLEN] := hbuf::17 << 8 | hbuf::16;
	ios_position(om, 0, HEADER*2, SEEK_SET);
	ios_position(om, 0, hdr[HTEXTLEN], SEEK_REL);
	ios_position(om, 0, hdr[HDATALEN], SEEK_REL);
	ldpubsyms(om, hdr[HPUBLEN]);
	ldextsyms(om, hdr[HEXTLEN]);
	ldrloctbl(om, hdr[HRLCLEN]);
	ios_position(om, 0, HEADER*2, SEEK_SET);
	sortreloc();
	ldimage(om, Cstream, CTEXT, hdr[HTEXTLEN], name);
	ldimage(om, Dstream, CDATA, hdr[HDATALEN], name);
	clrrloctbl();
	!XXX it would be possible to resolve externals using
	!XXX the recently loaded publics at this point,
	!XXX thereby saving space in the EXTSYMS table.
	Ctop := Ctop + hdr[HTEXTLEN];
	Dtop := Dtop + hdr[HDATALEN];
	Btop := Btop + hdr[HBSSLEN];
	if (O_debug) stats();
	Nmodules := Nmodules+1;
	return 0;
end


load(name) do
	var	modstrm[IOS], modbuf::BUFLEN;
	var	hmagic, lmagic;
	var	uname[TEXTLEN];

	unpack(name, uname);
	if (ios_open(modstrm, uname, modbuf, BUFLEN, IOF_READ) = %1) do
		error("no such file", name);
		return 0;
	end
	if (O_verbose) do
		writes(uname);
		writes(": ");
	end
	hmagic := rdwrd(modstrm);
	lmagic := rdwrd(modstrm);
	ie (hmagic = OBJMAGIC_HI /\ lmagic = OBJMAGIC_LO) do
		if (O_verbose) do
			writes("relocatable object"); newline();
		end
		ios_position(modstrm, 0, 0, SEEK_SET);
		loadmodule(modstrm, name, 1);
	end
	else do
		if (O_verbose) do
			writes("unknown"); newline();
		end
		error("unknown type (skipping)", name);
	end
	ios_close(modstrm);
end


usage() do
	newline();
	msg("-d\ttoggle debug mode (ON implies -v)");
	msg("-g\tgenerate executable and exit");
	msg("-h\tprint this help text");
	msg("-o file\tdirect output to `file'");
	msg("-q\tquit, do not generate any output");
	msg("-s\tstrip symbol information");
	msg("-t type\tset output type to `type'");
	msg("\t(types: exe, img, oxy)");
	msg("-v\tturn verbose mode on/off");
	msg("name\tload object `name'");
	newline();
end


hv(c) return ('0' <= c /\ c <= '9')-> c-'0': c-'A'+10;

hex(s) do var v;
	v := hv(s::0);
	if (s::1) v := v*16 + hv(s::1);
	return v;
end

wrbs(out, s) do var i;
	i := 0;
	while (s::i) do
		ios_wrch(out, hex(@s::i));
		i := i+2;
	end
end


dossegsetup() do
	wrbs(Cstream, packed"8CC8");		! MOV AX,CS
	wrbs(Cstream, packed"05");		! ADD AX,
		wrwrd(Cstream, -1);		!	$FFFF
	wrbs(Cstream, packed"8ED0");		! MOV SS,AX
	wrbs(Cstream, packed"BCFEFF");		! MOV SP,$FFFE
	wrbs(Cstream, packed"8ED8");		! MOV DS,AX
	wrbs(Cstream, packed"8CC2");		! MOV DX,ES
	wrbs(Cstream, packed"8EC0");		! MOV ES,AX
	Ctop := Ctop+16;
end


command(s) do
	var	i;

	i := 1;
	while (iswhite(s::i)) i := i+1;
	ie (s::0 = 'd') do
		O_debug := \O_debug;
		if (O_debug) O_verbose := 1;
		if (O_verbose) do
			writes("debug mode O");
			writes(O_debug-> "N": "FF");
			newline();
		end
	end
	else ie (s::0 = 'g') do
		return 1;
	end
	else ie (s::0 = 'h' \/ s::0 = '?') do
		usage();
	end
	else ie (s::0 = 'o') do
		if (\s::i) error("-o: missing name", 0);
		pstrcpy(O_outfile, @s::i);
		if (O_verbose) do
			writes("output file: ");
			writepacked(1, O_outfile, plength(O_outfile));
			newline();
		end
	end
	else ie (s::0 = 'q') do
		Errcount := Errcount+1;
		return 1;
	end
	else ie (s::0 = 's') do
		O_strip := 1;
	end
	else ie (s::0 = 't') do
		if (\s::i) error("-t: missing type", 0);
		ie (\memcomp(@s::i, packed"exe", 4)) do
			ie (Ctop) error(
			"'-t exe' must be specified before any objects", 0);
			else do
				if (O_type \= T_DOSEXE) dossegsetup();
				O_type := T_DOSEXE;
			end
		end
		else ie (\memcomp(@s::i, packed"img", 4)) do
			ie (O_type = T_DOSEXE)
				error("type already set to 'exe'", 0);
			else
				error("-t img: unimplemented", 0);
		end
		else ie (\memcomp(@s::i, packed"oxy", 4)) do
			ie (O_type = T_DOSEXE)
				error("type already set to 'exe'", 0);
			else
				O_type := T_OXYGENE;
		end
		else
			error("bad argument to -t", @s::i);
	end
	else ie (s::0 = 'v') do
		O_verbose := \O_verbose;
		if (O_verbose) msg("verbose mode");
	end
	else do
		error("unknown command", s);
	end
	return 0;
end


init() do
	var	i;

	O_verbose := 0;
	pstrcpy(O_outfile, packed "X.OUT");
	O_debug := 0;
	O_type := T_OXYGENE;
	O_strip := 0;
	Pt := 0;
	Et := 0;
	Mp := 0;
	Nmark := 0;
	Rb := 0;
	Rt := 0;
	Errcount := 0;
	Btop := 0;
	Ctop := 0;
	Dtop := 0;
	if (ios_open(Dstream, "_LDDATA", Dbuf, BUFLEN, IOF_WRITE) = %1)
		fatal("cannot create file", "_LDDATA");
	if (ios_open(Cstream, "_LDTEXT", Cbuf, BUFLEN, IOF_WRITE) = %1)
		fatal("cannot create file", "_LDTEXT");
	for (i=0, MKSPACE, M_LEN) Marks[i+MCLSS] := 0;
end


resolve(cfile, dfile) do
	var	i, ext;
	var	mk, n;
	var	c::1;
	var	k, p, addr, a;
	var	name::17;
	var	rfile, clss;

	Rt := Rb;
	for (i=0, Et, E_LEN) do
		ext := @Extsyms[i];
		p := findpub(@ext[ENAME]);
		if (p = %1) do
			memcopy(name, @ext[ENAME], 16);
			name::(name::0+1) := 0;
			error("unresolved", @name::1);
			loop;
		end
		addr := p[PADDR];
		if (O_debug) do
			writes("L ");
			n := @ext[ENAME];
			writepacked(1, @n::1, n::0);
			writes(" @");
			k := (12+n::0)&~7;
		end
		mk := ext[EMRKS];
		while (mk \= %1) do
			c::0 := mk[MCLSS];
			clss := c::0 & 255;
			if (O_debug) do
				if (k >= 72) do
					newline();
					k := 0;
				end
				writes("\s\s");
				writepacked(1, c, 1);
				writepacked(1, word(mk[MADDR]), 4);
				writes(mk[MCLSS] & 256 -> "+":"\s");
				k := k+8;
			end
			rfile := clss=CTEXT-> cfile: dfile;
			ios_position(rfile, 0, mk[MADDR], SEEK_SET);
			a := rdwrd(rfile) + 1;
			ie (mk[MCLSS] & 256)
				a := addr - mk[MADDR] - 2;
			else
				a := a + addr;
			ios_position(rfile, 0, mk[MADDR], SEEK_SET);
			wrwrd(rfile, a);
			if (p[PCLSS] & 255 = CBSS) do
				newrle(p[PCLSS]<<8|clss, mk[MADDR]);
			end
			mk := mk[MNEXT];
		end
		if (O_debug) newline();
	end
	Rb := Rt;
end


fixbssrefs(clss, file) do
	var	i, re, a, k, c::1;
	var	n;

	k := 0;
	n := 0;
	for (i=0, Rb, R_LEN) do
		re := @Rloctbl[i];
		if (re[RTYPE] & 255 = clss) do
			n := n+1;
			if (O_debug) do
				if (\(k mod 9)) do
					if (k) newline();
					writes("F:");
				end
				writes("\s\s");
				c::0 := clss;
				writepacked(1, c, 1);
				writepacked(1, word(re[RADDR]), 4);
				k := k+1;
			end
			ios_position(file, 0, re[RADDR], SEEK_SET);
			a := rdwrd(file) + Dtop;
			ios_position(file, 0, re[RADDR], SEEK_SET);
			wrwrd(file, a);
		end
	end
	if (O_debug /\ n) newline();
end


fixbsssyms() do
	var	p, i;

	for (i=0, Pt, P_LEN) do
		p := @Pubsyms[i];
		if (p[PCLSS] & 255 = 'B')
			p[PADDR] := p[PADDR] + Dtop;
	end
end


copy(in, out, pad) do
	var	buf::BUFLEN;
	var	k;

	while (1) do
		k := ios_read(in, buf, BUFLEN);
		if (\k) leave;
		if (ios_write(out, buf, k) \= k)
			fatal("file write error", O_outfile);
	end
	while (pad mod 16) do
		ios_wrch(out, 0);
		pad := pad+1;
	end
end


writeoxyhd(file) do
	var	xh[XHDR], i, p;

	Ytop := 0;
	for (i=0, Pt, P_LEN) do
		p := @Pubsyms[i];
		p := @p[PNAME];
		Ytop := Ytop + 6 + p::0;
	end
	xh[XHMAGIC] := EXECMAGIC_HI;
	xh[XLMAGIC] := EXECMAGIC_LO;
	xh[XFLAGS] := 0;
	xh[XLTEXT] := Ctop + 15 & ~15;
	xh[XLDATA] := Dtop + 15 & ~15;
	xh[XLBSS] := Btop + 15 & ~15;
	xh[XLSYM] := Ytop;
	xh[7] := %1;
	for (i=0, XHDR) wrwrd(file, xh[i]);
end


writeexehd(file) do
	const	delta = 32;	! size of non-{TEXT,DATA} area
	var	k, m, n;
	var	ltext, ldata;

	ltext := Ctop + 15 & ~15;
	ldata := Dtop + 15 & ~15;
	m := ltext mod 512;
	n := (ldata+delta) mod 512;
	k := ltext ./ 512 + (ldata+delta) ./ 512;
	ie (m+n >= 512) do
		if (m+n \= 512) k := k+1;
		m := m+n-512;
	end
	else do
		m := m+n;
	end
	! create EXE header
	wrbs(file, packed"4D5A");	! Magic
	wrwrd(file, m);			! Size MOD 512
	wrwrd(file, k+1);		! Size / 512 + 1
	wrwrd(file, 0);			! Num. of RELOC entries
	wrwrd(file, 2);			! (header size + 15) / 16
	wrwrd(file, 0);			! MINALLOC
	wrwrd(file, %1);		! MAXALLOC
	wrwrd(file, ltext./16+2);	! Initial SS
	wrwrd(file, %2);		! Initial SP
	wrwrd(file, 0);			! Checksum (0=ignore)
	wrwrd(file, 0);			! IEP, IP
	wrwrd(file, 0);			! IEP, CS
	wrwrd(file, 28);		! Offset of RELOC
	wrwrd(file, 0);			! Number of overlays
	wrbs(file, packed"FFFFFFFF");
	ios_position(Cstream, 0, 3, SEEK_SET);
	wrwrd(Cstream, ltext>>4);	! See dossegsetup()
	ios_position(Cstream, 0, 0, SEEK_SET);
end


writeheader(file) ie (O_type = T_OXYGENE)
			writeoxyhd(file);
		else ie (O_type = T_DOSEXE)
			writeexehd(file);
		else
			;

writepubsyms(file) do
	var	p, n, i;

	for (i=0, Pt, P_LEN) do
		p := @Pubsyms[i];
		n := @p[PNAME];
		wrwrd(file, n::0);
		wrwrd(file, p[PADDR]);
		wrwrd(file, p[PCLSS]);
		ios_write(file, @n::1, n::0);
	end
end


savemodule() do
	var	ostream[IOS], obuf::BUFLEN;
	var	uname[TEXTLEN];

	if (O_debug) writes("writing executable image: ");
	if (O_verbose) do
		writes("Text="); writepacked(1, word(Ctop), 4);
		writes(" Data="); writepacked(1, word(Dtop), 4);
		writes(" BSS="); writepacked(1, word(Btop), 4);
		writes(" Sym="); writepacked(1, word(Ytop), 4);
		newline();
	end
	unpack(O_outfile, uname);
	if (ios_open(ostream, uname, obuf, BUFLEN, IOF_WRITE) = %1)
		fatal("cannot create output file", O_outfile);
	ios_position(Cstream, 0, 0, SEEK_SET);
	ios_position(Dstream, 0, 0, SEEK_SET);
	writeheader(ostream);
	copy(Cstream, ostream, Ctop);
	copy(Dstream, ostream, Dtop);
	if (O_type = T_OXYGENE /\ \O_strip) writepubsyms(ostream);
	ios_close(ostream);
end


generate() do
	if (ios_open(Dstream, "_LDDATA", Dbuf, BUFLEN,
		IOF_READ|IOF_WRITE) = %1)
			fatal("cannot reopen file", "_LDDATA");
	if (ios_open(Cstream, "_LDTEXT", Cbuf, BUFLEN,
		IOF_READ|IOF_WRITE) = %1)
			fatal("cannot reopen file", "_LDTEXT");
	if (O_verbose) msg("resolving");
	resolve(Cstream, Dstream);
	if (O_verbose) msg("fixing up BSS references");
	fixbssrefs(CTEXT, Cstream);
	fixbssrefs(CDATA, Dstream);
	fixbsssyms();
	if (\Errcount) savemodule();
	ios_close(Dstream);
	ios_close(Cstream);
end


finish() do
	ios_close(Dstream);
	ios_close(Cstream);
	if (Nmodules /\ \Errcount) generate();
	if (\DEBUG /\ \O_debug) erase("_LDDATA");
	if (\DEBUG /\ \O_debug) erase("_LDTEXT");
end


killcr(s, l) do		! Remove CR from DOS input
	if (s::(l-2) = '\r') do
		l := l-1;
		s::(l-1) := '\n';
		s::l := 0;
	end
	return l;
end


do
	var	Cmdstream[IOS], Cmdbuf::256;
	var	Cmd::CMDLEN, i;
	var	k;

	init();
	if (ios_create(Cmdstream, 0, Cmdbuf, CMDLEN, IOF_READ) = %1)
		fatal("failed to create input stream", 0);
	while (1) do
		k := ios_reads(Cmdstream, Cmd, CMDLEN-1);
		k := killcr(Cmd, k);
		if (k < 1) leave;
		if (Cmd::(k-1) \= '\n') do
			error("input line too long", 0);
			loop;
		end
		Cmd::(k-1) := 0;
		i := 0;
		while (iswhite(Cmd::i)) i := i+1;
		if (\Cmd::i) loop;
		ie (Cmd::i = '-')
			if (command(@Cmd::(i+1))) leave;
		else
			load(@Cmd::i);
	end
	ios_close(Cmdstream);
	finish();
end

