!	S86 -- A simple one-pass assembler for an 8086 subset
!	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;


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: %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) 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) < 0) return %1;
	close(iostream[IOS_FD]);
	iostream[IOS_FLAGS] := 0;
	return 0;
end


ios_wrch(iostream, ch) do
	if (	iostream[IOS_PTR] >= iostream[IOS_LEN] /\
		ios_flush(iostream) < 0
	)
		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;

	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) < 0) 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__read(iostream, buffer, len, ckln) do
	var	i, p, e, b;

	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);
!-------------------- IOSTREAM DEFINITIONS END --------------------!

const	DEBUG = 0;

const	BUFSIZE=	1026,	! Must be <= 2050 !
	OBUFL=		1024,	! Must be <= 1025 !
	SYMBSPACE=	6144,
	NSPACE=		4096,
	MKSPACE=	2048,
	IMKSPACE=	512,
	TEXTLEN=	129,
	CSPACE=		16384,
	DSPACE=		4096,
	RSPACE=		3072;

const	META = 256;

const	ENDOFLINE = 1, ENDOFFILE = %1;

const	SYMBOL = 20, STRING = 22, MNEMO = 23;

const	COMMA = 30, COLON = 31, STAR = 36, PLUS = 37;

const	K_BYTE = 100, K_DB = 101, K_DW = 102, K_EQU = 103,
	K_EXTRN = 104, K_GLOBL= 105, K_WORD = 106, K_OFFSET = 107,
	K_TEXT = 108, K_DATA = 109, K_BSS = 110;

const	MNAME = 0, MCODE = 1, MTYPE = 2;
const	SNAME = 0, SADDR = 1, SCLSS = 2, SFLGS = 3, SYM_LEN = 4;
const	MADDR = 0, MCLSS = 1, MNEXT = 2, MARK_LEN = 3;
const	MRELATIVE = 256, MSHORT = 512;
const	RCLSS = 0, RADDR = 1, RSREF = 2, RLC_LEN = 3;
const	HHMAGIC = 0, HLMAGIC = 1, HFLAGS = 2,
	HTEXTLEN = 3, HDATALEN = 4, HBSSLEN = 5,
	HPUBLEN = 6, HEXTLEN = 7, HRLCLEN = 8,
	HDR_LEN = 9;

const	MAGIC_HI = 6513, MAGIC_LO = 1046;
const	MID_86 = 001;
const	TDATA='D', TBSS='B', TCODE='T', TNONE='X';
const	FUNDEFD=1, FGLOBAL=2, FEXTERN=4;

var	Symbols[SYMBSPACE], St, Maxlabel;
var	Names::NSPACE, Nt;
var	Marks[MKSPACE], Mt;
var	Imarks[IMKSPACE], It, Ni;
var	Code::CSPACE, Ctop;
var	Origin;
var	Data::DSPACE, Dtop;
var	Btop;
var	Reloc[RSPACE], Rtop;
var	Line;
var	Errcount;
var	Token;
var	Text, Textbuf::TEXTLEN, Tp;
var	Op;
var	Buffer[BUFSIZE], Cp, Ep, Lowp, Nomore;
var	Obuf::OBUFL, Ostream[IOS];
var	Mlist;
var	Nmn;
var	Segment;
var	Wop, IsOffset, Off1, Off2;
var	Oper1, Oper2;


init() do
	var	i;

	Tp := 0;
	St := SYMBSPACE;
	Nt := 0;
	Line := 1;
	Errcount := 0;
	Cp := 0;
	Ep := 0;
	Lowp := 0;
	Nomore := 0;
	Segment := K_TEXT;
	Btop := 0;
	Ctop := 0;
	Origin := 0;
	Dtop := 0;
	Rtop := 0;
	Mt := 0;
	It := 0;
	Ni := 0;
	for (i=0, IMKSPACE-MARK_LEN, MARK_LEN) Imarks[i+MCLSS] := %1;
	Maxlabel := %1;
	Mlist := [
	[ "",			0,		0	],
	[ packed "aaa",		"37",		'b'	],
	[ packed "aad",		"0AD5",		'w'	],
	[ packed "aam",		"0AD4",		'w'	],
	[ packed "aas",		"3F",		'b'	],
	[ packed "adc",		"8010",		1	],
	[ packed "add",		"8000",		1	],
	[ packed "and",		"8020",		1	],
	[ packed "call"	,	"E8FF10",	4	],
	[ packed "cbw",		"98",		'b'	],
	[ packed "clc",		"F8",		'b'	],
	[ packed "cld",		"FC",		'b'	],
	[ packed "cli",		"FA",		'b'	],
	[ packed "cmc",		"F5",		'b'	],
	[ packed "cmp",		"8038",		1	],
	[ packed "cmpsb",	"A6",		'b'	],
	[ packed "cmpsw",	"A7",		'b'	],
	[ packed "cseg",	"2E",		'b'	],
	[ packed "cwd",		"99",		'b'	],
	[ packed "daa",		"27",		'b'	],
	[ packed "das",		"2F",		'b'	],
	[ packed "dec",		"FE08",		2	],
	[ packed "div",		"F630",		2	],
	[ packed "dseg",	"3E",		'b'	],
	[ packed "eseg",	"26",		'b'	],
	[ packed "hlt",		"F4",		'b'	],
	[ packed "idiv",	"F638",		2	],
	[ packed "imul",	"F628",		2	],
	[ packed "inb",		"EC",		'b'	],
	[ packed "inc",		"FE00",		2	],
	[ packed "int",		"CCCD",		6	],
	[ packed "into",	"CE",		'b'	],
	[ packed "inw",		"ED",		'b'	],
	[ packed "iret",	"CF",		'b'	],
	[ packed "ja",		"77",		4	],
	[ packed "jae",		"73",		4	],
	[ packed "jb",		"72",		4	],
	[ packed "jbe",		"76",		4	],
	[ packed "jc",		"72",		4	],
	[ packed "jcxz",	"E3",		4	],
	[ packed "je",		"74",		4	],
	[ packed "jg",		"7F",		4	],
	[ packed "jge",		"7D",		4	],
	[ packed "jl",		"7C",		4	],
	[ packed "jle",		"7E",		4	],
	[ packed "jmp",		"E9FF20",	4	],
	[ packed "jmps",	"EB",		4	],
	[ packed "jnc",		"73",		4	],
	[ packed "jne",		"75",		4	],
	[ packed "jno",		"71",		4	],
	[ packed "jnp",		"7B",		4	],
	[ packed "jns",		"79",		4	],
	[ packed "jnz",		"75",		4	],
	[ packed "jo",		"70",		4	],
	[ packed "jp",		"7A",		4	],
	[ packed "js",		"78",		4	],
	[ packed "jz",		"74",		4	],
	[ packed "lahf",	"9F",		'b'	],
	[ packed "lock",	"F0",		'b'	],
	[ packed "lodsb",	"AC",		'b'	],
	[ packed "lodsw",	"AD",		'b'	],
	[ packed "loop",	"E2",		4	],
	[ packed "loopnz",	"E0",		4	],
	[ packed "loopz",	"E1",		4	],
	[ packed "mov",		"C688",		1	],
	[ packed "movsb",	"A4",		'b'	],
	[ packed "movsw",	"A5",		'b'	],
	[ packed "mul",		"F620",		2	],
	[ packed "neg",		"F618",		2	],
	[ packed "nop",		"90",		'b'	],
	[ packed "not",		"F610",		2	],
	[ packed "or",		"8008",		1	],
	[ packed "outb",	"EE",		'b'	],
	[ packed "outw",	"EF",		'b'	],
	[ packed "pop",		"5807",		5	],
	[ packed "popf",	"9D",		'b'	],
	[ packed "push",	"5006",		5	],
	[ packed "pushf",	"9C",		'b'	],
	[ packed "rcl",		"D010",		3	],
	[ packed "rcr",		"D018",		3	],
	[ packed "rep",		"F3",		'b'	],
	[ packed "repnz",	"F2",		'b'	],
	[ packed "repz",	"F3",		'b'	],
	[ packed "ret",		"C3",		'b'	],
	[ packed "rol",		"D000",		3	],
	[ packed "ror",		"D008",		3	],
	[ packed "sahf",	"9E",		'b'	],
	[ packed "sal",		"D020",		3	],
	[ packed "sar",		"D038",		3	],
	[ packed "sbb",		"8018",		1	],
	[ packed "scasb",	"AE",		'b'	],
	[ packed "scasw",	"AF",		'b'	],
	[ packed "shl",		"D020",		3	],
	[ packed "shr",		"D028",		3	],
	[ packed "sseg",	"36",		'b'	],
	[ packed "stc",		"F9",		'b'	],
	[ packed "std",		"FD",		'b'	],
	[ packed "sti",		"FB",		'b'	],
	[ packed "stosb",	"AA",		'b'	],
	[ packed "stosw",	"AB",		'b'	],
	[ packed "sub",		"8028",		1	],
	[ packed "test",	"F684",		1	],
	[ packed "wait",	"9B",		'b'	],
	[ packed "xchg",	"8086",		1	],
	[ packed "xlat",	"D7",		'b'	],
	[ packed "xor",		"8030",		1	],
	%1
	];
	Nmn := 0;
	while (Mlist[Nmn] \= %1) Nmn := Nmn+1;
end


plength(a) do
	var	k;

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


issym(x) return 'a' <= x /\ x <= 'z' \/ 'A' <= x /\ x <= 'Z' \/ x = '_';


isdigit(x) return '0' <= x /\ x <= '9' \/ x = '$';


error(m, s) do
	var	buf[12], o;

	o := select(1, 2);
	writes("S86: ");
	writes(ntoa(Line, buf));
	writes(": ");
	writes(m);
	if (s) do
		writes(": ");
		writepacked(2, s, plength(s));
	end
	newline();
	select(1, o);
	Errcount := Errcount +1;
end


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


bigval() error("value too big", Text);


badops() error("bad operand(s)", 0);


fillbuf() do
	var	i;

	if (Nomore) return 0;
	for (i=Cp, Ep) Buffer[i-Cp] := Buffer[i];
	i := Ep-Cp;
	Cp := 0;
	Ep := reads(@Buffer[i], BUFSIZE/2-1);
	if (\Ep) Nomore := 1;
	Ep := Ep + i;
	Lowp := Ep-TEXTLEN;
end


eof() return Nomore /\ Cp >= Ep;


getce() do
	var	c;

	c := Buffer[Cp]; Cp := Cp+1;
	if (c \= '\\') return c;
	c := Buffer[Cp]; Cp := Cp+1;
	if (c = 'a') return '\a';
	if (c = 'b') return '\b';
	if (c = 'e') return '\e';
	if (c = 'f') return '\f';
	if (c = 'n') return '\n';
	if (c = 'q') return '"' | META;
	if (c = '"') return '"' | META;
	if (c = 'r') return '\r';
	if (c = 's') return '\s';
	if (c = 't') return '\t';
	if (c = 'v') return '\v';
	return c;
end


findkw(s) do
	if (\memcomp(s, packed ".bss", 5)) return K_BSS;
	if (\memcomp(s, packed ".data", 6)) return K_DATA;
	if (\memcomp(s, packed ".extrn", 7)) return K_EXTRN;
	if (\memcomp(s, packed ".globl", 7)) return K_GLOBL;
	if (\memcomp(s, packed ".text", 6)) return K_TEXT;
	if (\memcomp(s, packed "byte", 5)) return K_BYTE;
	if (\memcomp(s, packed "db", 3)) return K_DB;
	if (\memcomp(s, packed "dw", 3)) return K_DW;
	if (\memcomp(s, packed "equ", 4)) return K_EQU;
	if (\memcomp(s, packed "offset", 7)) return K_OFFSET;
	if (\memcomp(s, packed "word", 5)) return K_WORD;
	return 0;
end


findmnemo(s) do
	var	p, d, r, k;

	p := 64;
	d := 32;
	k := plength(s)+1;
	while (d) do
		ie (p < 0) do
			p := p+d;
		end
		else ie (p >= Nmn) do
			p := p-d;
		end
		else do
			r := memcomp(s, Mlist[p][0], k);
			ie (\r) return p;
			else ie (r>0) p := p+d;
			else p := p-d;
		end
		d := d>>1;
		if (p&1 /\ \d) d := 1;
	end
	return 0;
end


scan() do
	var	c, i, bc[3];

	if (Cp >= Lowp) fillbuf();
	c := Buffer[Cp]; Cp := Cp+1;
	while (1) do
		while (	c = '\s' \/ c = '\t' \/
			c = '\r' \/ c = '\f'
		) do
			c := Buffer[Cp]; Cp := Cp+1;
		end
		if (c \= ';') leave;
		while (c \= '\n') do
			c := Buffer[Cp]; Cp := Cp+1;
		end
		if (Cp >= Lowp) fillbuf();
	end
	if (c = '\n') do
		Line := Line+1;
		Tp := 0;
		return ENDOFLINE;
	end
	Text := @Textbuf::Tp;
	if (eof()) return ENDOFFILE;
	if (c = ',') return COMMA;
	if (c = ':') return COLON;
	if (c = '*') return STAR;
	if (c = '+') return PLUS;
	if (c = '@') return K_OFFSET;
	if (	'a' <= c /\ c <= 'z' \/
		'A' <= c /\ c <= 'Z' \/
		c = '_' \/ c = '.'
	) do
		while (1) do
			if (\('a' <= c /\ c <= 'z' \/
				'A' <= c /\ c <= 'Z' \/
				'0' <= c /\ c <= '9' \/
				c = '_' \/ c = '.')
			)
				leave;
			if (Tp >= TEXTLEN-1) fatal("line too long", 0);
			Textbuf::Tp := c;
			Tp := Tp+1;
			c := Buffer[Cp]; Cp := Cp+1;
		end
		Textbuf::Tp := 0;
		Tp := Tp+1;
		Cp := Cp-1;
		c := findkw(Text);
		if (c) return c;
		Op := findmnemo(Text);
		if (Op) return MNEMO;
		return SYMBOL;
	end
	if (c = '[') do
		i := 0;
		while (c \= ']') do
			if (Tp >= TEXTLEN-1) fatal("line too long", 0);
			Textbuf::Tp := c; Tp := Tp+1;
			c := Buffer[Cp]; Cp := Cp+1;
		end
		Textbuf::Tp := ']';
		Textbuf::(Tp+1) := 0;
		Tp := Tp+2;
		return SYMBOL;
	end
	if ('0' <= c /\ c <= '9' \/ c = '-') do
		i := 0;
		while ('0' <= c /\ c <= '9' \/ c = '-') do
			if (Tp >= TEXTLEN-1) fatal("line too long", 0);
			Textbuf::Tp := c; Tp := Tp+1;
			c := Buffer[Cp]; Cp := Cp+1;
		end
		Textbuf::Tp := 0;
		Tp := Tp+1;
		Cp := Cp-1;
		return SYMBOL;
	end
	if (c = '$') do
		i := 0;
		while (	'0' <= c /\ c <= '9' \/
			'A' <= c /\ c <= 'F' \/ c = '$'
		) do
			if (Tp >= TEXTLEN-1) fatal("line too long", 0);
			Textbuf::Tp := c; Tp := Tp+1;
			c := Buffer[Cp]; Cp := Cp+1;
		end
		Textbuf::Tp := 0;
		Tp := Tp+1;
		Cp := Cp-1;
		return SYMBOL;
	end
	if (c = '\'') do
		Textbuf::Tp := '\'';
		Textbuf::(Tp+1) := getce();
		Textbuf::(Tp+2) := '\'';
		Textbuf::(Tp+3) := 0;
		Tp := Tp+4;
		ie (c \= '\'')
			error("missing `''", 0);
		else
			Cp := Cp+1;
		return SYMBOL;
	end
	if (c = '"') do
		i := 0;
		c := getce();
		while (c \= '"') do
			if (Tp >= TEXTLEN-2) fatal("line too long", 0);
			Textbuf::Tp := c & ~META;
			Tp := Tp+1;
			c := getce();
			if (eof()) fatal("unexpected EOF", 0);
		end
		Textbuf::Tp := 0;
		Tp := Tp+1;
		return STRING;
	end
	bc::0 := c/16 + (c/16 > 9-> 'A'-10: '0');
	bc::1 := c mod 16 + (c mod 16 > 9-> 'A'-10: '0');
	bc::2 := 0;
	fatal("bad input character", bc);
end


match(t, s) do
	ie (t = Token)
		Token := scan();
	else
		error(s, 0);
end


synch() do
	while (Token \= ENDOFLINE /\ Token \= ENDOFFILE)
		Token := scan();
end


nl() do
	ie (Token = ENDOFLINE) do
		Token := scan();
	end
	else do
		error("trailing garbage", 0);
		synch();
	end
end


byte(s) do
	var	l, h;

	h := s[0]; l := s[1];
	return (('0'<=h /\ h<='9' -> h-'0': h-'A'+10)<<4)
		+ ('0'<=l /\ l<='9' -> l-'0': l-'A'+10);
end


word(s) do
	var	v, i, d;

	v := 0;
	i := 0;
	while(s::i) do
		d := s::i;
		ie ('0' <= d /\ d <= '9')
			d := d-'0';
		else ie ('A' <= d /\ d <= 'F')
			d := d-'A'+10;
		else
			leave;
		v := (v<<4) + d;
		i := i+1;
	end
	return v;
end


decl findsym(2);

xtoi(s) do
	var	v, d, i, g, y;

	i := 0;
	g := 0;
	ie (s::i = '-') do
		g := 1; i := 1;
	end
	else if (s::i = '+') do
		i := 1;
	end
	if (s::i = '\'') return g-> -s::(i+1): s::(i+1);
	if (s::i = '$') return g-> -word(@s::(i+1)): word(@s::(i+1));
	if (s::i = '@') do
		v := plength(s);
		ie (s::(v-1) = ']')
			s::(v-1) := 0;
		else
			v := 0;
		y := findsym(@s::(i+1), 0);
		if (v) s::(v-1) := ']';
		if (y = %1) error("undefined symbol", @s::(i+1));
		return y = %1-> %1: y[SADDR];
	end
	v := 0;
	while (s::i) do
		d := s::i;
		ie ('0' <= d /\ d <= '9')
			d := d-'0';
		else
			leave;
		v := v*10 + d;
		i := i+1;
	end
	return g-> -v: v;
end


demit(n) do
	if (Dtop >= DSPACE) fatal("data segment overflow", 0);
	Data::Dtop := n;
	Dtop := Dtop+1;
end


demitword(n) do
	demit(n&255);
	demit(n>>8);
end


emit(n) do
	if (Segment = K_DATA) return demit(n);
	if (Ctop >= CSPACE) fatal("text segment overflow", 0);
	Code::Ctop := n;
	Ctop := Ctop+1;
end


emitword(n) do
	if (Segment = K_DATA) return demitword(n);
	emit(n&255);
	emit(n>>8);
end


decl	newsym(3);


extend(k) do var s, i, n;
	n := k*SYM_LEN+SYM_LEN;
	for (i=(Maxlabel+1)*SYM_LEN, n, SYM_LEN) do
		s := @Symbols[i];
		s[SNAME] := %1;
	end
	Maxlabel := k;
end


findsym(name, add) do
	var	i, s, k;

	ie (name::0 = 'A') do
		k := xtoi(@name::1)*2;
		if (k > Maxlabel) extend(k);
		if ((k+1) * SYM_LEN > St-SYM_LEN)
			fatal("symbol table overflow (labels)", name);
		s := @Symbols[k*SYM_LEN];
		if (s[SNAME] \= %1) return s;
	end
	else ie (name::0 = 'T') do
		k := xtoi(@name::1)*2+1;
		if (k > Maxlabel) extend(k);
		if ((k+1) * SYM_LEN > St-SYM_LEN)
			fatal("symbol table overflow (tmp)", name);
		s := @Symbols[k*SYM_LEN];
		if (s[SNAME] \= %1) return s;
	end
	else do
		k := plength(name);
		for (i=St, SYMBSPACE, SYM_LEN) do
			s := @Symbols[i];
			if (s[SNAME]::0 = k /\ \memcomp(@s[SNAME]::1, name, k))
				return s;
		end
	end
	if (add) return newsym(name, FUNDEFD, 0);
	return %1;
end


newmark(sym, base, rel) do
	var	m;

	if (Mt + MARK_LEN >= MKSPACE)
		fatal("out of free marks", 0);
	m := @Marks[Mt];
	Mt := Mt+MARK_LEN;
	m[MADDR] := base = TCODE-> Ctop: Dtop;
	m[MCLSS] := rel-> base|MRELATIVE: base;
	m[MNEXT] := sym[SADDR];
	sym[SADDR] := m;
end


intmark(sym, base, rel, shrt) do
	var	m, here;

	here := It >= IMKSPACE-MARK_LEN-> 0: It;
	while (1) do
		It := It+MARK_LEN;
		if (It >= IMKSPACE-MARK_LEN) It := 0;
		if (Imarks[It+MCLSS] = %1) leave;
		if (It = here) fatal("ouf of free imarks", 0);
	end
	m := @Imarks[It];
	! It := It+MARK_LEN;
	m[MADDR] := base = TCODE-> Ctop: Dtop;
	m[MCLSS] := base | (rel-> MRELATIVE: 0) | (shrt-> MSHORT: 0);
	m[MNEXT] := sym[SADDR];
	sym[SADDR] := m;
	Ni := Ni+1;
end


pwrite(s, b, l) do
	var	i;

	for (i=0, l) do
		ios_wrch(s, b[i] & 255);
		ios_wrch(s, b[i] >> 8);
	end
end


mkrlcent(ref, clss, base) do
	var	rel;

	if (Rtop+RLC_LEN >= RSPACE) fatal("relocation table overflow", 0);
	rel := @Reloc[Rtop];
	Rtop := Rtop+RLC_LEN;
	rel[RCLSS] := clss << 8 | base;
	rel[RADDR] := base = TCODE-> Ctop: Dtop;
	rel[RSREF] := ref;
end


findaddr(name, clss, base, rloc, shrt) do
	var	s, a;

	s := findsym(name, 1);
	a := s[SADDR];
	ie (s[SFLGS] & FEXTERN) do
		newmark(s, base, clss = TCODE /\ base = TCODE);
		return %1;
	end
	else if (s[SFLGS] & FUNDEFD) do
		intmark(s, base, clss = TCODE /\ base = TCODE, shrt);
		a := Ctop+Origin;
	end
	if (rloc) mkrlcent(s, s[SCLSS], base);
	return a;
end


iresolve(s) do
	var	a, m, n, i;
	var	seg, dest, clss, disp;

	m := s[SADDR];
	a := Segment = K_TEXT-> (Ctop+Origin): Segment = K_BSS-> Btop: Dtop;
	s[SADDR] := a;
	while (m \= %1) do
		clss := m[MCLSS];
		seg := clss & 255 = TCODE-> Code: Data;
		dest := m[MADDR];
		ie (clss & MRELATIVE) do
			ie (clss & MSHORT) do
				disp := a - (dest+Origin) - 1;
				if (disp < %128 \/ disp > 127)
					error("short branch out of range", 0);
				seg::dest := disp;
			end
			else do
				disp := a - (dest+Origin) - 2;
				seg::dest := disp&255;
				seg::(dest+1) := disp>>8;
			end
		end
		else do
			seg::dest := a&255;
			seg::(dest+1) := a>>8;
		end
		n := m;
		m := m[MNEXT];
		n[MCLSS] := %1;
		Ni := Ni-1;
	end
	for (i=0, Rtop, RLC_LEN) do
		if (Reloc[i+RSREF] = s) do
			Reloc[i+RCLSS] := Reloc[i+RCLSS] & 255 |
				(s[SCLSS] << 8);
		end
	end
end


newsym(name, flags, check) do
	var	s, k, redef, c;
	var	pname[TEXTLEN];

	redef := 0;
	if (check) do
		s := findsym(name, 0);
		if (s \= %1) do
			if (\(s[SFLGS] & FUNDEFD) \/ flags) do
				error("duplicate symbol", name);
				return 0;
			end
			redef := 1;
		end
	end
	ie (redef) do
		c := Segment = K_TEXT-> TCODE: Segment = K_DATA-> TDATA: TBSS;
		! Cannot catch this...
		! if (s[SCLSS] \= c)
		!	error("inconsistent redefinition", name);
		! changing class instead...
		s[SCLSS] := c;
		s[SFLGS] := s[SFLGS] & ~FUNDEFD;
		if (\flags) iresolve(s);
	end
	else do
		ie (name::0 = 'A') do
			k := xtoi(@name::1)*2;
			if (k > Maxlabel) extend(k);
			if ((k+1) * SYM_LEN >= St-SYM_LEN)
				fatal("symbol table overflow (labels)", name);
			s := @Symbols[k*SYM_LEN];
			s[SNAME] := 0;
		end
		else ie (name::0 = 'T') do
			k := xtoi(@name::1)*2+1;
			if (k > Maxlabel) extend(k);
			if ((k+1) * SYM_LEN >= St-SYM_LEN)
				fatal("symbol table overflow (tmp)", name);
			s := @Symbols[k*SYM_LEN];
			s[SNAME] := 0;
		end
		else do
			k := plength(name);
			if (St - SYM_LEN < Maxlabel * SYM_LEN)
				fatal("symbol table overflow", name);
			St := St-SYM_LEN;
			s := @Symbols[St];
			s[SNAME] := @Names::Nt;
			if (Nt + k+1 >= NSPACE)
				fatal("out of name space", name);
			Names::Nt := k;
			memcopy(@Names::(Nt+1), name, k);
			Nt := Nt + k+1;
		end
		s[SFLGS] := flags;
	end
	ie (flags & (FEXTERN|FUNDEFD))
		s[SADDR] := %1;
	else do
		s[SADDR] := Segment = K_TEXT-> (Ctop+Origin):
			Segment = K_BSS-> Btop: Dtop;
	end
	s[SCLSS] := Segment = K_TEXT-> TCODE: Segment = K_DATA-> TDATA: TBSS;
	return s;
end


emitdef(n, w) ie (w)
	emitword(n);
else
	emit(n);


defblock(w, v) do
	var	r, i;

	if (Token \= STAR) error("`* COUNT' expected", Text);
	Token := scan();
	ie (\isdigit(Text::0)) do
		error("bad repeat count", Text);
		r := 1;
	end
	else do
		r := xtoi(Text);
	end
	ie (Segment = K_BSS) do
		Btop := Btop + (w-> r*2: r);
		if ((Btop>>1) + (Dtop>>1) > 32000)
			fatal("BSS overflow", 0);
	end
	else do
		for (i=1,r) emitdef(v, w);
	end
end


defdata() do
	var	w, v, r, i;

	w := Token = K_DW;
	r := Segment = K_BSS;
	Token := scan();
	if (r) do
		defblock(w, 0);
		Token := scan();
		return 0;
	end
	while (1) do
		ie (Token = SYMBOL) do
			ie (	isdigit(Text::0) \/ Text::0 = '-' \/
				Text::0 = '\''
			) do
				v := xtoi(Text);
				if ((v > 255 \/ v < %128) /\ \w) bigval();
				emitdef(v, w);
			end
			else do
				error("invalid number", Text);
			end
			r := 1;
		end
		else ie (Token = STRING) do
			r := 0;
			i := 0;
			while (Text::i) do
				emitdef(Text::i, w); i := i+1;
			end
		end
		else ie (Token = K_OFFSET) do
			Token := scan();
			ie (Token = SYMBOL)
				emitword(findaddr(Text, TNONE,
				Segment=K_TEXT-> TCODE: TDATA, 1, 0));
			else
				error("symbol expected", Text);
			r := 0;
		end
		else ie (Token = STAR) do
			ie (\r)
				error("object is not repeatable", 0);
			else
				defblock(w, v);
			r := 0;
		end
		else do
			error("initializer expected", Text);
			synch();
			leave;
		end
		Token := scan();
		if (Token \= COMMA /\ Token \= STAR) leave;
		if (Token = COMMA) Token := scan();
	end
	nl();
end


defequ() do
	Token := scan();
	if (St = SYMBSPACE) error("missing label", 0);
	ie (	isdigit(Text::0) \/ Text::0 = '-' \/
		Text::0 = '\''
	) do
		Symbols[St+SADDR] := xtoi(Text);
	end
	else do
		error("invalid number", Text);
	end
	Token := scan();
	nl();
end


defsyms() do
	var	t;

	t := Token = K_GLOBL-> FGLOBAL: FEXTERN;
	Token := scan();
	while (1) do
		if (Token \= SYMBOL \/ \issym(Text::0)) do
			error("symbol name expected", Text);
			synch();
			leave;
		end
		newsym(Text, t=FGLOBAL-> t|FUNDEFD: t, 1);
		Token := scan();
		if (Token \= COMMA) leave;
		Token := scan();
	end
	nl();
end


defseg() do
	Segment := Token;
	Token := scan();
	if (Segment = K_TEXT) do
		if (Token \= ENDOFLINE) do
			ie (	isdigit(Text::0) \/ Text::0 = '-' \/
				Text::0 = '\''
			) do
				Origin := xtoi(Text);
			end
			else do
				error("invalid number", Text);
			end
			Token := scan();
		end
	end
	nl();
end


reg(s) do
	var	owop, p;
	var	regs;

	if (\(s::0 /\ s::1) \/ s::2) return %1;

	owop := Wop;
	Wop := 1;
	regs := "axcxdxbxspbpsidi";
	for (p=0, 16, 2) do
		if (s::0 = regs[p] /\ s::1 = regs[p+1])
			return(p>>1);
	end
	Wop := 0;
	regs := "alcldlblahchdhbh";
	for (p=0, 16, 2) do
		if (s::0 = regs[p] /\ s::1 = regs[p+1])
			return(p>>1);
	end
	Wop := owop;
	return(%1);
end


sreg(s) do
	var	owop;

	owop := Wop;
	Wop := 1;
	if (\memcomp(s, packed "cs", 3)) return 1;
	if (\memcomp(s, packed "ds", 3)) return 3;
	if (\memcomp(s, packed "es", 3)) return 0;
	if (\memcomp(s, packed "ss", 3)) return 2;
	Wop := owop;
	return(%1);
end


indirect(s) do
	if (s::0 \= '[') return(%1);
	if (\memcomp(s, packed "[si]", 5)) return 4;
	if (\memcomp(s, packed "[di]", 5)) return 5;
	if (\memcomp(s, packed "[bx]", 5)) return 7;
	if (\memcomp(s, packed "[bx+si]", 8)) return 0;
	if (\memcomp(s, packed "[bx+di]", 8)) return 1;
	if (\memcomp(s, packed "[bp+si]", 8)) return 2;
	if (\memcomp(s, packed "[bp+di]", 8)) return 3;
	return(%1);
end


inddisp(s) do
	if (s::0 \= '[') return(%1);
	if (\memcomp(s, packed "[bp]", 4)) return(6);
	if (	\('0' <= s::4 /\ s::4 <= '9') /\
		\('A' <= s::4 /\ s::4 <= 'F') /\
		s::4 \= '$' /\ s::4 \= '@'
	)
		return(%1);
	if (s::3 \= '+' /\ s::3 \= '-') return(%1);
	if (\memcomp(s, packed "[bx", 3)) return(7);
	if (\memcomp(s, packed "[bp", 3)) return(6);
	if (\memcomp(s, packed "[di", 3)) return(5);
	if (\memcomp(s, packed "[si", 3)) return(4);
	return(%1);
end


rrasm(o1, o2, m1, m2) do	! Register, Register
	emit(o1 | Wop);
	emit(o2 | 192 | m1 | (m2<<3));	! 0xc0
end


riasm(o1, o2, m1, m2) do	! Register, Indirect
	emit(o1 | 2 | Wop);
	emit(o2 | m2 | (m1<<3));
end


rmasm(o1, o2, m1, m2, sym) do	! Register, Memory
	emit(o1 | 2 | Wop);
	emit(o2 | m2 | (m1<<3));
	emitword(findaddr(sym, TDATA, TCODE, 1, 0)+Off2);
end


rnasm(o1, o2, m1, val) do	! Register, Immediate
	ie (o1 = 198) do	! 0cx6
		emit(176 | (Wop<<3) | m1);	! 0xb0
	end
	else do
		emit(o1 | Wop);
		emit(o2 | 192 | m1);	! 0xc0
	end
	ie (Wop)
		emitword(val);
	else ie (val > 255 \/ val < %127)
		bigval();
	else
		emit(val);
end


roasm(o1, o2, m1, sym) do	! Register, Offset
	ie (o1 = 198) do	! 0cx6
		emit(176 | (Wop<<3) | m1);	! 0xb0
	end
	else do
		emit(o1 | Wop);
		emit(o2 | 192 | m1);	! 0xc0
	end
	emitword(findaddr(sym, TNONE, TCODE, 1, 0)+Off2);
end


irasm(o1, o2, m1, m2) do	! Indirect, Register
	emit(o1 | Wop);
	emit(o2 | m1 | (m2<<3));
end


mrasm(o1, o2, m1, m2, sym) do	! Memory, Register
	emit(o1 | Wop);
	emit(o2 | m1 | (m2<<3));
	emitword(findaddr(sym, TDATA, TCODE, 1, 0)+Off1);
end


mnasm(o1, o2, m1, sym, val) do	! Memory, Immediate
	emit(o1 | Wop);
	emit(o2 | m1);
	emitword(findaddr(sym, TDATA, TCODE, 1, 0)+Off1);
	ie (Wop)
		emitword(val);
	else ie (val > 255 \/ val < %127)
		bigval();
	else
		emit(val);
end


inasm(o1, o2, m1, val) do	! Indirect, Immediate
	emit(o1 | Wop);
	emit(o2 | m1);
	ie (Wop)
		emitword(val);
	else ie (val > 255 \/ val < %127)
		bigval();
	else
		emit(val);
end


rdasm(o1, o2, m1, m2, val) do	! Register, Register+Displacement
	emit(o1 | 2 | Wop);
	ie (val > 127 \/ val < %128) do
		emit(o2 | 128 | (m1<<3) | m2);	! 0x80
		emitword(val);
	end
	else do
		emit(o2 | 64 | (m1<<3) | m2);	! 0x40
		emit(val);
	end
end


drasm(o1, o2, m1, m2, val) do	! Register+Displacement, Register
	emit(o1 | Wop);
	ie (val > 127 \/ val < %128) do
		emit(o2 | 128 | m1 | (m2<<3));	! 0x80
		emitword(val);
	end
	else do
		emit(o2 | 64 | m1 | (m2<<3));	! 0x40
		emit(val);
	end
end


dnasm(o1, o2, m, disp, val) do	! Register+Displacement, Immediate
	emit(o1 | Wop);
	ie (disp > 127 \/ disp < %128) do
		emit(o2 | 128 | m);	! 0x80
		emitword(disp);
	end
	else do
		emit(o2 | 64 | m);	! 0x40
		emit(disp);
	end
	ie (Wop)
		emitword(val);
	else
		emit(val);
end


asm1(immed, op1, op2) do	! Group 1 (Binary) Instructions
	var	m1, m2;

	m1 := reg(Oper1);
	ie (m1 >= 0) do
		if (immed = 198) do	! 0xc6
			m2 := sreg(Oper2);
			if (m2 >= 0) do
				emit(140);	! 0x8c
				emit(192 | m1 | (m2<<3)); ! 0xc0
				return 0;
			end
		end
		m2 := reg(Oper2);
		ie (m2 >= 0)
			rrasm(op1, op2, m1, m2);
		else ie (issym(Oper2::0)) do
			ie (IsOffset) do
				roasm(immed, op1, m1, Oper2);
			end
			else do
				rmasm(op1, op2, m1, 6, Oper2);
			end
		end
		else ie (isdigit(Oper2::0) \/ Oper2::0 = '\'' \/
			Oper2::0 = '-'	
		) do
			rnasm(immed, op1, m1, xtoi(Oper2));
		end
		else ie (indirect(Oper2) >= 0)
			riasm(op1, op2, m1, indirect(Oper2));
		else ie (inddisp(Oper2) >= 0)
			rdasm(op1, op2, m1, inddisp(Oper2), xtoi(@Oper2::3));
		else
			badops();
	end
	else ie (immed = 198 /\ sreg(Oper1) >= 0) do	! 0xc6
		m2 := reg(Oper2);
		if (m2 < 0) badops();
		emit(142);	! 0x8e
		emit(192 | (sreg(Oper1)<<3) | m2);	! 0xc0
	end
	else ie (issym(Oper1::0)) do
		ie (reg(Oper2) >= 0) do
			mrasm(op1, op2, 6, reg(Oper2), Oper1);
		end
		else ie (isdigit(Oper2::0) \/ Oper2::0 = '\'' \/
			Oper2::0 = '-'	
		) do
			mnasm(immed, op2, 6, Oper1, xtoi(Oper2));
		end
		else do
			badops();
		end
	end
	else ie (indirect(Oper1) >= 0) do
		m1 := indirect(Oper1);
		m2 := reg(Oper2);
		ie (m2 >= 0)
			irasm(op1, op2, m1, m2);
		else ie (isdigit(Oper2::0) \/ Oper2::0 = '\'' \/
			Oper2::0 = '-'
		)
			! inasm(immed, immed=192-> 0: op1, m1, xtoi(Oper2));
			inasm(immed, 0, m1, xtoi(Oper2));
			! 0xc0
		else
			badops();
	end
	else ie (inddisp(Oper1) >= 0) do
		m2 := reg(Oper2);
		ie (m2 >= 0)
			drasm(op1, op2, inddisp(Oper1), m2, xtoi(@Oper1::3));
		else ie (isdigit(Oper2::0) \/ Oper2::0 = '\'' \/
			Oper2::0 = '-'
		) do
			dnasm(immed, op2, inddisp(Oper1), xtoi(@Oper1::3),
				xtoi(Oper2));
		end
		else do
			badops();
		end
	end
	else do
		badops();
	end
end


rasm(o1, o2, m1) do	! Register
	emit(o1 | Wop);
	emit(o2 | 192 | m1);	! 0xc0
end


iasm(o1, o2, m1) do	! Indirect
	emit(o1 | Wop);
	emit(o2 | m1);
end


masm(o1, o2, m1, sym) do	! Memory
	emit(o1 | Wop);
	emit(o2 | m1);
	emitword(findaddr(sym, TDATA, TCODE, 1, 0)+Off1);
end


asm2(op1, op2) do	! Group 2 (Unary) Instructions
	var	m1;

	m1 := reg(Oper1);
	if (m1 >= 0) do
		rasm(op1, op2, m1);
		return 0;
	end
	m1 := indirect(Oper1);
	if (m1 >= 0) do
		iasm(op1, op2, m1);
		return 0;
	end
	if (issym(Oper1::0)) do
		masm(op1, op2, 6, Oper1);
		return 0;
	end
	badops();
end


asm3(op1, op2) do	! Group 3 (Shift,Rotate) Instructions
	ie (Oper2::0 = '1' /\ Oper2::1 = 0)
		asm2(op1, op2);
	else ie (\memcomp(Oper2, packed "cl", 3))
		asm2(op1|2, op2);
	else
		badops();
end


asm4(op1, a1, a2, jlong) do	! Group 4 (Jump,Call) Instructions
	var	dest, disp;

	if (\issym(Oper1::0) \/ reg(Oper1) >= 0) do
		if (\jlong) error("invalid indirect branch", 0);
		asm2(a1, a2);
		return 0;
	end
	emit(op1);
	dest := findaddr(Oper1, TCODE, TCODE, 0, \jlong)+Off1;
	disp := dest - ((Ctop+Origin)+(jlong-> 2: 1));
	ie (jlong)
		emitword(disp);
	else ie (dest \= %1 /\ (disp < %128 \/ disp > 127))
		error("short branch out of range", 0);
	else
		emit(disp&255);
end


asm5(op1, ops) do	! Group 5 (Push,Pop) Instructions
	var	m1;

	m1 := Reg(Oper1);
	if (m1 >= 0) do
		emit(op1 | m1);
		return 0;
	end
	m1 := sreg(Oper1);
	if (m1 >= 0) do
		emit(ops | (m1<<3));
		return 0;
	end
	badops();
end


asm6(op1, op2) do	! Group 6: INT instruction
	var	n;

	if (\isdigit(Oper1::0)) badops();
	n := xtoi(Oper1);
	if (n > 255) bigval();
	ie (n = 3) do
		emit(op1);
	end
	else do
		emit(op2);
		emit(n);
	end
end


plusoff(offp) do
	if (Token \= PLUS) return 0;
	Token := scan();
	ie (Token \= SYMBOL \/ \isdigit(Text::0)) do
		error("bad offset", Text);
	end
	else do
		offp[0] := xtoi(Text);
	end
	Token := scan();
end


assemble() do
	var	m, c;

	m := Mlist[Op][MTYPE];
	c := Mlist[Op][MCODE];
	Token := scan();
	Wop := 1;
	Off1 := 0;
	Off2 := 0;
	ie (Token = K_WORD) do
		Wop := 1;
		Token := scan();
	end
	else if (Token = K_BYTE) do
		Wop := 0;
		Token := scan();
	end
	if (m = 'b') do
		emit(byte(Mlist[Op][MCODE]));
		nl();
		return 0;
	end
	if (m = 'w') do
		emitword(word(Mlist[Op][MCODE]));
		nl();
		return 0;
	end
	if (m = 2 \/ m = 4 \/ m = 5 \/ m = 6) do
		if (Token \= SYMBOL) error("operand expected", Text);
		Oper1 := Text;
		Token := scan();
		plusoff(@Off1);
		ie (m = 2) do
			asm2(byte(c), byte(@c[2]));
		end
		else ie (m = 4) do
			ie (c[2])
				asm4(byte(c), byte(@c[2]), byte(@c[4]), 1);
			else
				asm4(byte(c), 0, 0, 0);
		end
		else ie (m = 5) do
			asm5(byte(c), byte(@c[2]));
		end
		else if (m = 6) do
			asm6(byte(c), byte(@c[2]));
		end
		nl();
		return 0;
	end
	if (m = 1 \/ m = 3) do
		if (Token \= SYMBOL) error("operand expected", Text);
		Oper1 := Text;
		Token := scan();
		plusoff(@Off1);
		match(COMMA, "',' expected");
		ie (Token = K_OFFSET) do
			IsOffset := 1;
			Token := scan();
		end
		else do
			IsOffset := 0;
		end
		if (Token \= SYMBOL) error("operand expected", Text);
		Oper2 := Text;
		Token := scan();
		plusoff(@Off2);
		ie (m = 1) asm1(byte(c), byte(@c[2]), 0);
		else if (m = 3) asm3(byte(c), byte(@c[2]));
		nl();
		return 0;
	end
end


statement() do
	if (Token = SYMBOL) do
		if (\issym(Text::0)) error("bad label", Text);
		newsym(Text, 0, 1);
		Token := scan();
		match(COLON, "missing ':'");
	end
	ie (Token = K_DB \/ Token = K_DW) do
		defdata();
	end
	else ie (Token = K_EQU) do
		defequ();
	end
	else ie (Token = K_GLOBL \/ Token = K_EXTRN) do
		defsyms();
	end
	else ie (Token = K_TEXT \/ Token = K_DATA \/ Token = K_BSS) do
		defseg();
	end
	else ie (Token = MNEMO) do
		assemble();
	end
	else ie (Token = ENDOFLINE) do
		Token := scan();
	end
	else do
		error("bad statement", 0);
		synch();
	end
end


pass() do
	var	in;

	Token := scan();
	while (Token \= ENDOFFILE) statement();
end


s0(s, b) do
	memcopy(b, @s::1, s::0);
	b::(s::0) := 0;
	return b;
end


concat() do
	var	header[HDR_LEN], buf::256;
	var	in;
	var	k, i, j, p;
	var	s[SYM_LEN];
	var	n[TEXTLEN];

	header[HHMAGIC] := MAGIC_HI;
	header[HLMAGIC] := MAGIC_LO;
	header[HFLAGS] := MID_86 << 8 | 0;
	header[HTEXTLEN] := Ctop;
	header[HDATALEN] := Dtop;
	header[HBSSLEN] := Btop;
	k := 0;
	for (i=St, SYMBSPACE, SYM_LEN) do
		if (Symbols[i+SFLGS] & FGLOBAL) do
			k := k+6+Symbols[i+SNAME]::0;
			if (Symbols[i+SFLGS] & FUNDEFD)
				error("undefined global",
					s0(Symbols[i+SNAME], buf));
		end
		if (Symbols[i+SFLGS] & (FUNDEFD|FEXTERN) = FUNDEFD) do
			error("undefined symbol",
				s0(Symbols[i+SNAME], buf));
		end
	end
	header[HPUBLEN] := k;
	header[HRLCLEN] := Rtop*2/3*(RLC_LEN-1);
	k := 0;
	for (i=St, SYMBSPACE, SYM_LEN) do
		if (Symbols[i+SFLGS] & FEXTERN) do
			k := k+8+Symbols[i+SNAME]::0;
			p := Symbols[i+SADDR];
			while (p \= %1) do
				k := k+4;
				p := p[MNEXT];
			end
		end
	end
	header[HEXTLEN] := k;
	if (ios_create(Ostream, 1, Obuf, OBUFL, IOF_WRITE) = %1)
		fatal("cannot create stdout stream", 0);
	pwrite(Ostream, header, HDR_LEN);
	if (ios_write(Ostream, Code, Ctop) \= Ctop)
		fatal("failed to write text segment", 0);
	if (ios_write(Ostream, Data, Dtop) \= Dtop)
		fatal("failed to write data segment", 0);
	for (i=St, SYMBSPACE, SYM_LEN) do
		if (Symbols[i+SFLGS] & FGLOBAL) do
			s[SNAME] := Symbols[i+SNAME]::0;
			s[SADDR] := Symbols[i+SADDR];
			s[SCLSS] := Symbols[i+SCLSS];
			pwrite(Ostream, @s, 3);
			ios_write(Ostream, @Symbols[i+SNAME]::1,
				Symbols[i+SNAME]::0);
		end
	end
	for (i=St, SYMBSPACE, SYM_LEN) do
		if (Symbols[i+SFLGS] & FEXTERN) do
			s[SNAME] := Symbols[i+SNAME]::0;
			s[SADDR] := %1;
			s[SCLSS] := Symbols[i+SCLSS];
			pwrite(Ostream, @s, 3);
			ios_write(Ostream, @Symbols[i+SNAME]::1,
				Symbols[i+SNAME]::0);
			k := 0;
			p := Symbols[i+SADDR];
			while (p \= %1) do
				k := k+4;
				p := p[MNEXT];
			end
			pwrite(Ostream, @k, 1);
			p := Symbols[i+SADDR];
			while (p \= %1) do
				pwrite(Ostream, p, 2);
				p := p[MNEXT];
			end
		end
	end
	j := 0;
	for (i=0, Rtop, RLC_LEN) do
		Reloc[j+RCLSS] := Reloc[i+RCLSS];
		Reloc[j+RADDR] := Reloc[i+RADDR];
		j := j+RLC_LEN-1;
	end
	pwrite(Ostream, Reloc, j);
	ios_close(Ostream);
end


do
	init();
	pass();
	if (\Errcount) concat();
end

