[number address map]
disam86:
begin

external	label	entry		address	5;
external	word	bdos.base	address	6;
word			start.himem					value	himem;
word			wk.word;

word			start.key.offset;
word			start.code.addr;
word			code.addr;
word			prev.code.addr;
word			line.code.addr;
word			end.code.addr;
word			wk.code.offset;
byte			wk.byte;
byte			pass.num;
byte			curr.op.byte;
byte			curr.mod.r.m;
byte			curr.reg.ix;
byte			curr.op.type;
byte			curr.op.mask;
byte			double.word.flag			value	"N";
byte			byte.word.flag;
byte			bkwds.mod.r.m				value	"N";
byte			mod.r.m.txt.flag			value	"Y";
byte			sign.ext.flag				value	"N";
byte			neg.hex.flag				value	"N";
byte			enable.neg.hex				value	"N";
byte			hex.only.flag				value	"N";
byte			rep.was.present				value	'N';
byte			label.needed				value	"N";
byte			mem.map.8080				value	"N";
byte			full.MOVS.text				value	"N";

string			wk.str				81;
string			wk.str.2			81;
string pointer	wk.sp;
string pointer	lookup.sp;
byte pointer	wk.bp;

string			curr.op.txt			11;
string			seg.prefix.txt			51;
byte			seg.prefix.present			value	"N";
string			rep.lock.prefix.txt	51;
byte			rep.lock.prefix.present		value	"Y";


{--------------------------------------------------------

word		last.input.key				value	^hffff;
word		wk.code.word;
byte		last.code.byte;
word		code.word;
								redefine code.word;
		byte		code.byte;
								endredef;

string		input.name	15;

record	input.rec;
	byte	input.byte;
	string	127;
	endrec;

file	input.file,
		disk,	random,	key	input.key,
		record	input.rec,
		value	input.name;

{-----------------------------------------------------

string		put.name	15;

byte	con.echo.switch	value	"N";
byte	show.addr.flag	value	"N";
byte	put.char;
byte	put.colm;

string	put.buff	128;

file	put.file,
		text,	disk,	record	put.char,
		buffer	put.buff,
		value	put.name;

copy "DIS86LBL.TBL";

{--------------------------------------------------------------
{		Label-Table Handling Routines
{--------------------------------------------------------------
{
{	Label-Table Format:
{		Byte			Label-type(hex):
{							0 - Program (Code-Seg) Label
{							1 - Data-Seg Variable
{							2 - Stack-Seg Variable
{							3 - Extra-Seg Variable
{							10 - Absolute Code-Seg Label
{							11 - Absolute Data-Seg Label
{							12 - Absolute Stack-Seg Label
{							13 - Absolute Extra-Seg Label
{							80 - Segment-Reg value for previous entry
{
{		byte			Label-Length:
{							0 - Program label
{							1 - Byte
{							2 - Word
{							4 - Double-Word
{
{		word			Label offset address within seg
{							(Except for type 80 - Seg-Reg value)
{----------------------------------------------------------------------
byte			lbl.type;
byte			lbl.len;
word			lbl.addr;
word			lbl.seg.reg;
byte			last.seg.reg	value	' ';
byte			curr.seg.reg	value	' ';
word			last.seg.value	value	^hffff;
word pointer	start.lbl.tbl			value	himem;
word pointer	end.lbl.tbl				value	himem;
word pointer	lbl.tbl.wp				value	himem;
word pointer	wk.lbl.wp;
byte pointer	wk.lbl.len.bp;
byte pointer	temp.lbl.bp;
set				lbl.entry.len		=	4;
{----------------------------------------------------------------------
{	out:	wk.byte = 'Y' if already in table
{			wk.byte = 'N' if not already in table
{						and lbl.tbl.wp points to 1st entry which
{						is greater than lbl.addr
{----------------------------------------------------------------------
procedure	check.if.lbl.present:
begin
	move 'N' to wk.byte;
	move start.lbl.tbl to lbl.tbl.wp;
	while lbl.tbl.wp < end.lbl.tbl do
		add 1 to lbl.tbl.wp giving wk.lbl.len.bp;
		add 2 to lbl.tbl.wp giving wk.lbl.wp;
		{--ignore 2nd half of absolute label--}
		if @lbl.tbl.wp[bp] <> ^h80 then
			{---keep reloc & absolute labels separate---}
			{---even if 8080-model						}
			switch on lbl.type:
				0 - 3:	if @lbl.tbl.wp[bp] >= ^h10 then
							exit;
							fi;
				^h10 - ^h13:
						if @lbl.tbl.wp[bp] < ^h10 then
							goto skip.this.label;
							fi;
				endswitch;
			{--if 8080 model, label-types are mixed--}
			{--otherwise types are separate			}
			if mem.map.8080 = 'N' then
				if @lbl.tbl.wp[bp] > lbl.type then
					exit;
					fi;
				fi;
			{--here, either it's an 8080-model, or the type matches--}
			{--exit if next is higher address--}
			if @wk.lbl.wp > lbl.addr then
				exit;
			else
				{--check further if same address--}
				if @wk.lbl.wp = lbl.addr then
					if @wk.lbl.len.bp > lbl.len then
						exit;
						fi;
					if @wk.lbl.len.bp = lbl.len then
						move 'Y' to wk.byte;
						exit;
			fi;	fi;	fi;	fi;
skip.this.label:
		add lbl.entry.len to lbl.tbl.wp;
		od;
end;

procedure	put.curr.lbl:
begin
	if pass.num = 1 then
		call check.if.lbl.present;
		if wk.byte = 'Y' then
			{-----------------------------------------------
			{	If label already exists as a simple label,
			{	and the current type is byte or word, then
			{	change the entry to the data type.
			{-----------------------------------------------
			if lbl.type < ^h10
			and lbl.type <> 0
			and @lbl.tbl.wp[bp] = 0 then
				add 2 to lbl.tbl.wp giving wk.lbl.wp;
				if @wk.lbl.wp = lbl.addr then
					move lbl.tbl.wp to wk.lbl.wp;
					move lbl.type to @wk.lbl.wp[bp];
					add 1 to wk.lbl.wp;
					move lbl.len to @wk.lbl.wp[bp];
					move lbl.tbl.wp to wk.lbl.wp;	{-just in case-}
				fi;	fi;
			exit;
			fi;
		{----provide segment-reg override----}
		switch on lbl.type:
			0 - 3:
				switch on curr.seg.reg:
					'C':	move 0 to lbl.type;
					'D':	move 1 to lbl.type;
					'S':	move 2 to lbl.type;
					'E':	move 3 to lbl.type;
					endswitch;
			^h10 - ^h13:
				switch on curr.seg.reg:
					'C':	move ^h10 to lbl.type;
					'D':	move ^h11 to lbl.type;
					'S':	move ^h12 to lbl.type;
					'E':	move ^h13 to lbl.type;
					endswitch;
			else begin
				move 0 to lbl.type;
				end;
			endswitch;
		move ' ' to curr.seg.reg;

		{--make sure room for program stack--}
		subtract end.lbl.tbl from bdos.base giving wk.word;
		if wk.word < ((lbl.entry.len * 3)+100) then
			display "Label table overflow";
			exit;
			fi;

		subtract lbl.tbl.wp from end.lbl.tbl giving wk.word;
		add lbl.entry.len to lbl.tbl.wp giving wk.sp;
		if wk.word <> 0 then
			move @lbl.tbl.wp[sp] to @wk.sp length wk.word reverse;
			fi;
		add lbl.entry.len to end.lbl.tbl;
		move lbl.tbl.wp to wk.lbl.wp;
		move lbl.type to @wk.lbl.wp[bp];
		add 1 to wk.lbl.wp;
		move lbl.len to @wk.lbl.wp[bp];
		add 1 to wk.lbl.wp;
		move lbl.addr to @wk.lbl.wp;

		switch on lbl.type:
			^h10,^h11,^h12,^h13: begin
				add lbl.entry.len to lbl.tbl.wp;
				subtract lbl.tbl.wp from end.lbl.tbl
											giving wk.word;
				add lbl.entry.len to lbl.tbl.wp giving wk.sp;
				if wk.word <> 0 then
					move @lbl.tbl.wp[sp] to @wk.sp
									length wk.word reverse;
					fi;
				add lbl.entry.len to end.lbl.tbl;
				move lbl.tbl.wp to wk.lbl.wp;
				move ^h80 to @wk.lbl.wp[bp];
				add 2 to wk.lbl.wp;
				move lbl.seg.reg to @wk.lbl.wp;
				end;
			endswitch;
		fi;
end;
{--------------------------------------------------------------
{	misc txt output routines
{--------------------------------------------------------------
procedure	put.a.byte:
begin
	if pass.num <> 1 then
		switch on put.char:
		^h09: begin
				do
					add 1 to put.colm;
					and put.colm with ^h07 giving wk.byte;
					od until wk.byte = 0;
				end;
		^h0d:	move 0 to put.colm;
		^h0a:	null;
		else	add 1 to put.colm;
		endswitch;
		write put.file;
		if con.echo.switch = 'Y' then
			mcall entry using 2,put.char;
			fi;
		fi;
end;

procedure	put.crlf:
begin
	move ^h0d to put.char;
	call put.a.byte;
	move ^h0a to put.char;
	goto put.a.byte;
end;

procedure	put.tab:
begin
	move ^h09 to put.char;
	goto put.a.byte;
end;

procedure	put.blank:
begin
	move ' ' to put.char;
	goto put.a.byte;
end;

procedure	put.string:
begin
	while @wk.bp <> 0 do
		move @wk.bp to put.char;
		call put.a.byte;
		add 1 to wk.bp;
		od;
end;

procedure	put.wk.str:
begin
	move #wk.str to wk.bp;
	goto put.string;
end;

procedure	put.seg.prefix:
begin
	if seg.prefix.present = 'Y' then
		move last.seg.reg to curr.seg.reg;
		move #seg.prefix.txt to wk.bp;
		call put.string;
		fi;
	move 'N' to seg.prefix.present;
	move 0 to seg.prefix.txt[byte];
end;

procedure	start.line:
begin
	move ' ' to curr.seg.reg;
	if pass.num <> 1 then
		while lbl.tbl.wp < end.lbl.tbl do
			add 1 to lbl.tbl.wp giving wk.lbl.len.bp;
			add 2 to lbl.tbl.wp giving wk.lbl.wp;
			{--for 8080 model, any relocatable-type is ok--}
			switch on mem.map.8080:
				'N':
					if @lbl.tbl.wp[bp] <> 0 then	{-prog-label-}
						exitdo;
						fi;
				else
					if @lbl.tbl.wp[bp] >= ^h10 then
						exitdo;
						fi;
				endswitch;
			if @wk.lbl.wp > line.code.addr then
				exitdo;
				fi;
			convert @wk.lbl.wp to hex wk.str[+1];
			convert wk.str[+1] to lower case;
			switch on @lbl.tbl.wp[bp]:
				0:	move 'L' to wk.str[byte];
				1:	move 'D' to wk.str[byte];
				2:	move 'S' to wk.str[byte];
				3:	move 'E' to wk.str[byte];
				else move 'X' to wk.str[byte];
				endswitch;
			switch on @wk.lbl.len.bp:
				1:		move "B" to wk.str[+5,word];
				2,4:		move "W" to wk.str[+5,word];
				endswitch;
			subtract @wk.lbl.wp from line.code.addr
								giving wk.word;
			if wk.word <> 0 then
				append '~09~equ~09~$-' to wk.str;
				convert wk.word to wk.str.2;
				append wk.str.2 to wk.str;
				call put.wk.str;
			else
				append ':' to wk.str;
				call put.wk.str;
				fi;
			call put.crlf;
			add lbl.entry.len to lbl.tbl.wp;
			od;
		fi;
	call put.tab;
	if rep.lock.prefix.present = 'Y' then
		move #rep.lock.prefix.txt to wk.bp;
		call put.string;
		fi;
	move 'N' to rep.lock.prefix.present;
	move 0 to rep.lock.prefix.txt[byte];
end;

procedure	put.op:
begin
	move #curr.op.txt to wk.bp;
	goto put.string;
end;

procedure	put.comma:
begin
	move ',' to put.char;
	goto put.a.byte;
end;

procedure	put.colon:
begin
	move ':' to put.char;
	goto put.a.byte;
end;

procedure	put.semicolon:
begin
	move ';' to put.char;
	goto put.a.byte;
end;

procedure	sign.extend.byte:
begin
	if code.byte and ^h80 then
		move ^hff to code.word[+1,byte];
	else
		move ^h00 to code.word[+1,byte];
		fi;
end;

procedure	put.hex.byte:
begin
	move 'N' to hex.only.flag;
	move 'N' to neg.hex.flag;
	if code.byte and ^h80
	and enable.neg.hex = "Y" then
		move "Y" to neg.hex.flag;
		subtract code.byte from 0 giving code.byte;
		fi;
	move "N" to enable.neg.hex;
	if code.byte <= 9 then
		convert code.byte to dec wk.str;
	else
		convert code.byte to hex wk.str;
		convert wk.str to lower case;
		if wk.str[+2,byte] > '9' then
			move '0' to wk.str[byte];
			move wk.str[+2] to wk.str[+1];
		else
			move wk.str[+2] to wk.str;
			fi;
		append 'h' to wk.str;
		fi;
	if neg.hex.flag = "Y" then
		move wk.str to wk.str[+2] length 6 reverse;
		move "(-" to wk.str[word];
		append ")" to wk.str;
		fi;
	call put.wk.str;
end;

procedure	put.ascii.or.hex.byte:
begin
	if hex.only.flag = 'Y' then
		goto put.hex.byte;
		fi;
	switch on code.byte:
		"'": begin
				move "''''" to wk.str;
				call put.wk.str;
				end;
		^h20 - ^h7e: begin
				move "'" to wk.str[byte];
				move code.byte to wk.str[+1,byte];
				move "'" to wk.str[+2,word];
				call put.wk.str;
				end;
		else	goto put.hex.byte;
		endswitch;
end;

procedure	put.hex.word:
begin
	move 'N' to hex.only.flag;
	move 'N' to neg.hex.flag;
	if code.word and ^h8000
	and enable.neg.hex = "Y" then
		move "Y" to neg.hex.flag;
		subtract code.word from 0 giving code.word;
		fi;
	move "N" to enable.neg.hex;
	if code.word <= 9 then
		convert code.word to dec wk.str;
	else
		convert code.word to hex wk.str;
		convert wk.str to lower case;
		while wk.str[byte] = '0'
		and wk.str[+1,byte] <> 0 do
			move wk.str[+1] to wk.str;
			od;
		if wk.str[byte] > '9' then
			move wk.str to wk.str[+1] length 5 reverse;
			move '0' to wk.str[byte];
			fi;
		append 'h' to wk.str;
		fi;
	if neg.hex.flag = "Y" then
		move wk.str to wk.str[+2] length 6 reverse;
		move "(-" to wk.str[word];
		append ")" to wk.str;
		fi;
	call put.wk.str;
end;

procedure	put.extention.lbl:
begin
	if byte.word.flag and ^h01 then
		if double.word.flag = 'Y' then
			move 4 to lbl.len;
		else
			move 2 to lbl.len;
			fi;
	else
		move 1 to lbl.len;
		fi;
	switch on lbl.type:
		0,^h10:	move 0 to lbl.len;
		endswitch;
	move code.word to lbl.addr;
	call put.curr.lbl;
	switch on lbl.type:
		0,^h10:	null;
		else
			switch on lbl.len:
				1,2: null;
				else		call put.BYTE.or.WORD.PTR;
				endswitch;
		endswitch;
	call put.seg.prefix;
	switch on lbl.type:
		0,^h10:	move 'C' to wk.str[byte];
		1,^h11:	move 'D' to wk.str[byte];
		2,^h12:	move 'S' to wk.str[byte];
		3,^h13:	move 'E' to wk.str[byte];
		else	move 'X' to wk.str[byte];
		endswitch;
	convert code.word to hex wk.str[+1];
	convert wk.str[+1] to lower case;
	switch on lbl.type:
		0,^h10:	null;
		else begin
			switch on lbl.len:
				1:		move 'B' to wk.str[+5,word];
				2,4:	move 'W' to wk.str[+5,word];
				endswitch;
			end;
		endswitch;
	call put.wk.str;
end;

procedure	put.hex.lbl:
begin
	move 'L' to wk.str[byte];
	convert code.word to hex wk.str[+1];
	convert wk.str[+1] to lower case;
	goto put.wk.str;
end;

procedure	put.OFFSET:
begin
	move "offset " to wk.str;
	goto put.wk.str;
end;

procedure	put.hex.byte.or.word:
begin
byte	offset.made		value	"N";

	move "N" to offset.made;
	if byte.word.flag and ^h01 then
		{--------------------------------------------------
		{	For WORD operand, lookup in table
		{	if found, make OFFSET, else make constant
		{--------------------------------------------------
		move start.lbl.tbl to temp.lbl.bp;
		while temp.lbl.bp < end.lbl.tbl do
			add 1 to temp.lbl.bp giving wk.lbl.len.bp;
			add 2 to temp.lbl.bp giving wk.lbl.wp;
			{--for 8080 model, any relocatable-type is ok--}
			if @wk.lbl.wp = code.word then
				move "Y" to offset.made;
				call put.OFFSET;
				convert @wk.lbl.wp to hex wk.str[+1];
				convert wk.str[+1] to lower case;
				switch on @temp.lbl.bp:
					0,^h10:	move 'L' to wk.str[byte];
					1,^h11:	move 'D' to wk.str[byte];
					2,^h12:	move 'S' to wk.str[byte];
					3,^h13:	move 'E' to wk.str[byte];
					else move 'X' to wk.str[byte];
					endswitch;
				switch on @wk.lbl.len.bp:
					1:			move "B" to wk.str[+5,word];
					2,4:		move "W" to wk.str[+5,word];
					else		move 0 to wk.str[+5,byte];
					endswitch;
				call put.wk.str;
				exitdo;
				fi;
			add lbl.entry.len to temp.lbl.bp;
			od;
		{-------------------------------
		{	no label, make constant
		{-------------------------------
		if offset.made = "N" then
			if code.word >= start.code.addr
			and code.word <= end.code.addr then
				call put.OFFSET;
				call put.hex.lbl;
				move 0 to lbl.type;
				move 0 to lbl.len;
				move code.word to lbl.addr;
				call put.curr.lbl;
			else
				call put.hex.word;
			fi;	fi;
	else
		call put.ascii.or.hex.byte;
		fi;
	move "N" to enable.neg.hex;
end;

procedure	put.BYTE.or.WORD:
begin
	if byte.word.flag and ^h01 then
		if double.word.flag = 'Y' then
			move 'dword ' to wk.str;
		else
			move 'word ' to wk.str;
			fi;
		move 'N' to double.word.flag;
	else
		move 'byte ' to wk.str;
		fi;
	goto put.wk.str;
end;

procedure	put.BYTE.or.WORD.PTR:
begin
	call put.seg.prefix;
	call put.BYTE.or.WORD;
	move 'ptr ' to wk.str;
	goto put.wk.str;
end;

procedure	put.reg.07:
begin
	and curr.reg.ix with ^h07 giving wk.byte;
	if byte.word.flag and ^h01 then
		add 8 to wk.byte;
		fi;
	index reg.name.entry with wk.byte giving wk.bp;
	goto put.string;
end;

procedure	put.mod.r.m.38:
begin
	divide curr.mod.r.m by 8 giving curr.reg.ix;
	goto put.reg.07;
end;

procedure	put.mod.r.m.txt:
begin
	call put.seg.prefix;
	if mod.r.m.txt.flag <> 'N' then
		call put.BYTE.or.WORD.PTR;
		fi;
	move 'Y' to mod.r.m.txt.flag;
	and curr.mod.r.m with ^h07 giving wk.byte;
	index mod.r.m.txt.entry with wk.byte giving wk.bp;
	goto put.string;
end;

procedure	put.mod.r.m.c7:
begin
	call put.seg.prefix;
	move curr.mod.r.m to curr.reg.ix;
	and curr.mod.r.m with ^hc0 giving wk.byte;
	switch on wk.byte:
		^h00: begin
			and curr.mod.r.m with ^h07 giving wk.byte;
			if wk.byte <> ^h06 then
				call put.mod.r.m.txt;
			else
				call get.next.code.word;
				move 1 to lbl.type;		{-data-seg-}
				call put.extention.lbl;
				fi;
			end;
		^h40: begin
			call get.next.code.byte;
			call sign.extend.byte;
			if code.word >= start.code.addr
			and code.word <= end.code.addr then
				move 1 to lbl.type;	{- data -}
				call put.extention.lbl;
			else
				call put.BYTE.or.WORD.PTR;
				move 'Y' to enable.neg.hex;
				move 'Y' to hex.only.flag;
				call put.hex.byte.or.word;
				fi;
			call put.blank;
			move 'N' to mod.r.m.txt.flag;
			call put.mod.r.m.txt;
			end;
		^h80: begin
			call get.next.code.word;
			if code.word >= start.code.addr
			and code.word <= end.code.addr then
				move 1 to lbl.type;	{- data -}
				call put.extention.lbl;
			else
				call put.BYTE.or.WORD.PTR;
				move 'Y' to hex.only.flag;
				call put.hex.word;
				fi;
			call put.blank;
			move 'N' to mod.r.m.txt.flag;
			call put.mod.r.m.txt;
			end;
		^hc0: begin
			call put.reg.07;
			end;
		endswitch;
	move 'N' to double.word.flag;
end;

procedure	put.mod.r.m:
begin
	move curr.mod.r.m to curr.reg.ix;
	if bkwds.mod.r.m = 'Y' then
		call put.seg.prefix;
		call put.mod.r.m.c7;
		call put.comma;
		move curr.mod.r.m to curr.reg.ix;
		call put.mod.r.m.38;
	else
		move curr.mod.r.m to curr.reg.ix;
		call put.mod.r.m.38;
		call put.comma;
		call put.seg.prefix;
		call put.mod.r.m.c7;
		fi;
	move 'N' to bkwds.mod.r.m;
end;

procedure	put.basic.op.38:
begin
	and curr.op.byte with ^h38 giving wk.byte;
	divide wk.byte by 8;
	index basic.op.entry with wk.byte giving wk.bp;
	goto put.string;
end;

procedure	put.DI:
begin
	call put.BYTE.or.WORD.PTR;
	move '[di]' to wk.str;
	goto put.wk.str;
end;

procedure	put.SI:
begin
	call put.seg.prefix;
	call put.BYTE.or.WORD.PTR;
	move '[si]' to wk.str;
	goto put.wk.str;
end;

procedure	put.CL:
begin
	move 'cl' to wk.str;
	goto put.wk.str;
end;

procedure	put.1:
begin
	move '1' to wk.str;
	goto put.wk.str;
end;

procedure	put.AL:
begin
	move 'al' to wk.str;
	call put.wk.str;
end;

procedure	put.AX:
begin
	move 'ax' to wk.str;
	call put.wk.str;
end;

procedure	put.AX.or.AL:
begin
	if byte.word.flag and ^h01 then
		goto put.AX;
	else
		goto put.AL;
		fi;
end;

procedure	put.seg.reg.from.mod.r.m:
begin
	and curr.mod.r.m with ^h38 giving wk.byte;
	divide wk.byte by 8;
	index seg.reg.entry with wk.byte giving wk.bp;
	call put.string;
end;

procedure	put.shift.38:
begin
	and curr.mod.r.m with ^h38 giving wk.byte;
	divide wk.byte by 8;
	index shift.op.entry with wk.byte giving wk.bp;
	goto put.string;
end;

{-------------------------------------------------
{	in:		code.addr = address of byte to get
{							(in code-seg)
{	out:	curr.byte;
{-------------------------------------------------
procedure	get.code.byte:
begin
	move code.byte to last.code.byte;
	subtract start.code.addr from code.addr giving wk.code.offset;
	divide wk.code.offset by 128 giving input.key;
	add start.key.offset to input.key;
	if input.key <> last.input.key then
		read input.file error fill input.rec with ^h90;
		fi;
	move input.key to last.input.key;
	and wk.code.offset with ^h7f giving wk.bp;
	add #input.rec to wk.bp;
	move @wk.bp to code.byte;
end;

procedure	get.next.code.byte:
begin
	call get.code.byte;
	add 1 to code.addr;
end;

procedure	get.next.code.word:
begin
byte	lo.byte;
	call get.next.code.byte;
	move code.byte to lo.byte;
	call get.next.code.byte;
	move code.word[byte] to code.word[+1,byte];
	move lo.byte to code.word[byte];
end;

procedure	get.next.code.byte.or.word:
begin
	if byte.word.flag and ^h01 then
		goto get.next.code.word;
	else
		goto get.next.code.byte;
		fi;
end;

procedure	get.mod.r.m:
begin
	call get.next.code.byte;
	move code.byte to curr.mod.r.m;
end;

{---------------------------------------------------------
{
{---------------------------------------------------------
procedure	dssmbl.a.stmt:
begin
	mcall entry using 11 giving ,,,wk.byte;
	if wk.byte <> 0 then
		mcall entry using 1 giving ,,,wk.byte;
		and wk.byte with ^h7f;
		if wk.byte = ^h03 then
			goto end;
		fi;	fi;

	if rep.lock.prefix.present <> 'Y'
	and seg.prefix.present <> 'Y' then
		move code.addr to line.code.addr;
		fi;
	call get.next.code.byte;
	move code.byte to curr.op.byte;
	move #lookup.tbl to lookup.sp;
	move ^hff to curr.op.type;
	while lookup.sp < #lookup.end do
		move @lookup.sp[bp] to curr.op.mask;
		add 1 to lookup.sp;
		and code.byte with curr.op.mask giving wk.byte;
		if wk.byte = @lookup.sp[bp] then
			add 1 to lookup.sp;
			move @lookup.sp[bp] to curr.op.type;
			add 1 to lookup.sp;
			move @lookup.sp to curr.op.txt;
			exitdo;
			fi;
		add 13 to lookup.sp;
		od;
	switch on curr.op.type:
{single-byte no variations
	1: begin
		call start.line;
		call put.seg.prefix;
		call put.op;
		{-----force label after ret, retf, iret-----}
		switch on curr.op.byte:
			^hc3, ^hcb, ^hcf: begin
				move code.addr to lbl.addr;
				move 0 to lbl.type;
				move 0 to lbl.len;
				call put.curr.lbl;
				end;
			endswitch;
		exit;
		end;
{prefix byte
	2: begin
		move curr.op.txt[byte] to last.seg.reg;
		append curr.op.txt to seg.prefix.txt;
		append ': ' to seg.prefix.txt;
		move 'Y' to seg.prefix.present;
		goto dssmbl.a.stmt;
		end;
{jump with single-byte displacement
	3: begin
		call put.seg.prefix;
		call get.next.code.byte;
		call sign.extend.byte;
		add code.word to code.addr giving wk.code.word;
		move 0 to lbl.type;	{-prog-label-}
		move 0 to lbl.len;	{-prog-label-}
		move wk.code.word to lbl.addr;
		call put.curr.lbl;
		call start.line;
		call put.op;
		call put.tab;
		move wk.code.word to code.word;
		call put.hex.lbl;
		{--force label after jmp--}
		if curr.op.byte = ^heb then
			move code.addr to lbl.addr;
			move 0 to lbl.type;
			move 0 to lbl.len;
			call put.curr.lbl;
			fi;
		exit;
		end;
{arithmetic with mod-r/m
{:01 = word		/:01 = byte
{:02 = mod-r/m	/:02 = r/m-mod
{:38 = ix to basic-op table
	5: begin
		{--------------------------------------
		{	Special patch to handle data areas filled with zeros
		{--------------------------------------
		if curr.op.byte = 0 then
			move code.addr to wk.code.word;
			call get.code.byte;
			move wk.code.word to code.addr;
			if code.byte = 0 then
				exitswitch;
				fi;
			{--------------------------------------------------
			{	See if any reference to byte following this one
			{	If so, leave this a DB
			{---------------------------------------------------
			move start.lbl.tbl to wk.bp;
			while wk.bp < end.lbl.tbl do
				add 2 to wk.bp giving wk.lbl.wp;
				if @wk.lbl.wp = code.addr then
					exitswitch;
					fi;
				add lbl.entry.len to wk.bp;
				od;
			fi;
		move curr.op.byte to byte.word.flag;
		call start.line;
		call put.basic.op.38;
		call put.tab;
		call get.mod.r.m;
		if curr.op.byte and ^h02 then
			move 'N' to bkwds.mod.r.m;
		else
			move 'Y' to bkwds.mod.r.m;
			fi;
		call put.mod.r.m;
		exit;
		end;
{arithmetic with immediate data
{:01 = word		/:01 = byte
{:38 = ix to basic-op table
	6: begin
		move curr.op.byte to byte.word.flag;
		call start.line;
		call put.seg.prefix;
		call put.basic.op.38;
		call put.tab;
		call put.AX.or.AL;
		call put.comma;
		call get.next.code.byte.or.word;
		call put.hex.byte.or.word;
		exit;
		end;
{first byte:
{:01 = word		/:01 = byte
{:02 = if word(:01), then disp is 1-byte sign-extended
{/:02 = word normal (ignored)
{second-byte
{:38 = ix to basic-op table
{remainder of 2nd byte is like mod-r/m
	7: begin
		move curr.op.byte to byte.word.flag;
		call get.mod.r.m;
		move curr.mod.r.m to curr.op.byte;
		move 'N' to sign.ext.flag;
		if byte.word.flag and ^h02 then
			and curr.mod.r.m with ^h38 giving wk.byte;
			if wk.byte = ^h08
			or wk.byte = ^h20
			or wk.byte = ^h30 then
				exitswitch;	{--invalid--}
				fi;
			fi;
		call start.line;
		call put.basic.op.38;
		call put.tab;
		call put.mod.r.m.c7;
		call put.comma;
		and byte.word.flag with ^h03 giving wk.byte;
		switch on wk.byte:
			^h01:	call get.next.code.word;
			^h03: begin
					call get.next.code.byte;
					move 'Y' to sign.ext.flag;
					end;
			else	call get.next.code.byte;
			endswitch;
		if sign.ext.flag = 'Y' then
			call sign.extend.byte;
			move "Y" to enable.neg.hex;
			fi;
		call put.hex.byte.or.word;
		exit;
		end;
{first byte:
{:01 = word		/:01 = byte
{second byte:
{standard mod-r/m
	9: begin
		call start.line;
		move curr.op.byte to byte.word.flag;
		call get.mod.r.m;
		call put.op;
		call put.tab;
		call put.mod.r.m;
		exit;
		end;
{first byte:
{:01 = word		/:01 = byte
{:02 = mod-r/m	/:02 = r/m-mod
{second byte:
{standard mod-r/m
	10: begin
		call start.line;
		move curr.op.byte to byte.word.flag;
		if curr.op.byte and ^h02 then
			move 'N' to bkwds.mod.r.m;
		else
			move 'Y' to bkwds.mod.r.m;
			fi;
		call put.op;
		call put.tab;
		call get.mod.r.m;
		call put.mod.r.m;
		exit;
		end;
{LEA (only)
{first byte is constant
{second byte is standard mod-r/m
	11: begin
		move ^hff to byte.word.flag;
		move 'N' to bkwds.mod.r.m;
		call start.line;
		call put.op;
		call put.tab;
		call get.mod.r.m;
		and curr.mod.r.m with ^hc0 giving wk.byte;
		if wk.byte = ^hc0 then
			exitswitch;
			fi;
		call put.mod.r.m;
		exit;
		end;
{first byte is constant
{second byte:
{:20 must be zero
{:18 specifies seg-reg
{remainder of 2nd byte is like mod-r/m
	12: begin
		move ^hff to byte.word.flag;
		call get.mod.r.m;
		if curr.mod.r.m and ^h20 then
			exitswitch;	{--invalid--}
			fi;
		call start.line;
		call put.op;
		call put.tab;
		if curr.op.byte and ^h02 then
			call put.seg.reg.from.mod.r.m;
			call put.comma;
			call put.mod.r.m.c7;
		else
			call put.mod.r.m.c7;
			call put.comma;
			call put.seg.reg.from.mod.r.m;
			fi;
		exit;
		end;
{first byte is constant
{second byte:
{:38 must be zero
{remainder of 2nd byte is like mod-r/m
	13: begin
		call get.mod.r.m;
		if curr.mod.r.m and ^h38 then
			exitswitch;	{--invalid--}
			fi;
		move ^hff to byte.word.flag;
		call start.line;
		call put.op;
		call put.tab;
		call put.mod.r.m.c7;
		exit;
		end;
{first byte is constant (for long jump & call)
{bytes 2 & 3 = offset address
{bytes 4 & 5 = new CS reg
	14: begin
		call start.line;
		call put.seg.prefix;
		call put.op;
		call put.tab;
		call get.next.code.word;
		push code.word;
		call get.next.code.word;
		move code.word to lbl.seg.reg;
		pop code.word;
		move ^h10 to lbl.type;	{--fixed code seg--}
		move 0 to lbl.len;
		call put.extention.lbl;
		{--force label after jmp~09~far--}
		if curr.op.byte = ^hea then
			move code.addr to lbl.addr;
			move 0 to lbl.type;
			move 0 to lbl.len;
			call put.curr.lbl;
			fi;
		exit;
		end;
{first byte:
{:01 = word		/:01 = byte
{:02 = fwd	/:02 = bkwds
{bytes 2 & 3 = offset address
	15: begin
		move curr.op.byte to byte.word.flag;
		if curr.op.byte and ^h02 then
			move 'Y' to bkwds.mod.r.m;
		else
			move 'N' to bkwds.mod.r.m;
			fi;
		call start.line;
		call put.op;
		call put.tab;
		call get.next.code.word;
		move 1 to lbl.type;		{-data-seg-}
		if curr.op.byte and ^h02 then
			call put.extention.lbl;
			call put.comma;
			call put.AX.or.AL;
		else
			call put.AX.or.AL;
			call put.comma;
			call put.extention.lbl;
			fi;
		exit;
		end;
{single-byte with only option of :01
{:01 = word		/:01 = byte
	16: begin
		move rep.lock.prefix.present to rep.was.present;
		move curr.op.byte to byte.word.flag;
		call start.line;
		call put.op;
		if full.MOVS.text = 'Y' then
			if rep.was.present = 'Y' then
				call put.blank;
			else
				call put.tab;
				fi;
			switch on curr.op.byte:
				^had,						{-lods (word)-}
				^hac:	call put.SI;		{-lods (byte)-}
				^ha4 - ^ha7: begin			{-cmps,movs-}
					call put.seg.prefix;
					call put.DI;
					call put.comma;
					call put.SI;
					end;
				else begin					{-stos-}
					call put.seg.prefix;
					call put.DI;
					end;
				endswitch;
		else
			if byte.word.flag and ^h01 then
				move 'w' to put.char;
			else
				move 'b' to put.char;
				fi;
			call put.a.byte;
			fi;
		exit;
		end;
{single-byte with immediate data
{:01 = ax,word	/:01 = al,byte
	17: begin
		move curr.op.byte to byte.word.flag;
		call start.line;
		call put.seg.prefix;
		call put.op;
		call put.tab;
		call get.next.code.byte.or.word;
		if byte.word.flag and ^h02 then
			call put.hex.byte.or.word;
			call put.comma;
			call put.AX.or.AL;
		else
			call put.AX.or.AL;
			call put.comma;
			call put.hex.byte.or.word;
			fi;
		exit;
		end;
{single-byte with immediate data
{:01 = Xx,word	/:01 = Xl,byte
{:70 = ix to reg table
	18: begin
		move curr.op.byte to byte.word.flag;
		divide byte.word.flag by 8;
		call start.line;
		call put.seg.prefix;
		call put.op;
		call put.tab;
		move curr.op.byte to curr.reg.ix;
		call put.reg.07;
		call get.next.code.byte.or.word;
		call put.comma;
		call put.hex.byte.or.word;
		exit;
		end;
{single-byte with imm. data
{bytes 2 & 3 are data
	19: begin
		call start.line;
		call put.seg.prefix;
		call put.op;
		call put.tab;
		call get.next.code.word;
		call put.hex.word;
		{---force label after ret, ret~09~far ---}
		switch on curr.op.byte:
			^hc2, ^hca: begin
				move code.addr to lbl.addr;
				move 0 to lbl.type;
				move 0 to lbl.len;
				call put.curr.lbl;
				end;
			endswitch;
		exit;
		end;
{first byte only option :01
{:01 = word		/:01 = byte
{second byte:
{:38 must be zero
{remainder of 2nd byte is like mod-r/m
{3rd ( & 4th if word ) are imm. data
	20: begin
		move curr.op.byte to byte.word.flag;
		call get.mod.r.m;
		if curr.mod.r.m and ^h38 then
			exitswitch;	{--invalid--}
			fi;
		call start.line;
		call put.op;
		call put.tab;
		call put.mod.r.m.c7;
		call put.comma;
		call get.next.code.byte.or.word;
		call put.hex.byte.or.word;
		exit;
		end;
{first byte constant
{second byte is imm. data\
	21: begin
		call start.line;
		call put.seg.prefix;
		call put.op;
		call put.tab;
		call get.next.code.byte;
		call put.ascii.or.hex.byte;
		exit;
		end;
{shift-op with mod-r/m
{:01 = word		/:01 = byte
{:02 = CL=count	/:02 = count=1
{second-byte:
{:38 = ix to shift-op table
{remainder of 2nd byte is like mod-r/m
	22: begin
		move curr.op.byte to byte.word.flag;
		call start.line;
		call get.mod.r.m;
		and curr.mod.r.m with ^h38 giving wk.byte;
		if wk.byte = ^h30 then
			exitswitch;	{-invalid-}
			fi;
		call put.shift.38;
		call put.tab;
		call put.mod.r.m.c7;
		call put.comma;
		if byte.word.flag and ^h02 then
			call put.CL;
		else
			call put.1;
			fi;
		exit;
		end;
{first and second bytes are constant
{second byte = ^h0a
	23: begin
		call get.mod.r.m;
		if curr.mod.r.m <> ^h0a then
			exitswitch;	{--invalid--}
			fi;
		call start.line;
		call put.seg.prefix;
		call put.op;
		exit;
		end;
{escape
{second byte:
{:38 is ignored
{remainder of 2nd byte is like mod-r/m
	24: begin
		move 1 to byte.word.flag;
		call start.line;
		call put.op;
		call put.tab;
		call get.mod.r.m;
		call put.mod.r.m.c7;
		exit;
		end;
{jump & call with 16-bit displacement
{1st byte constant
{2nd & 3rd bytes are 16-bit displacement
	25: begin
		call start.line;
		call put.seg.prefix;
		call put.op;
		call put.tab;
		call get.next.code.word;
		add code.word to code.addr giving wk.code.word;
		move 0 to lbl.type;	{-prog-label-}
		move 0 to lbl.len;	{-prog-label-}
		move wk.code.word to lbl.addr;
		call put.curr.lbl;
		move wk.code.word to code.word;
		call put.hex.lbl;
		{--force label after jmp--}
		if curr.op.byte = ^he9 then
			move code.addr to lbl.addr;
			move 0 to lbl.type;
			move 0 to lbl.len;
			call put.curr.lbl;
			fi;
		exit;
		end;
{special for ^hf6 and ^hf7
{1st byte:
{f6 = word		f7 = byte
{2nd byte:
{:38 = 000 --- op = test, and has imm. data (byte or word)
{else :38 = ix to f6.f7-op table
{remainder of 2nd byte is like mod-r/m
	26: begin
		move curr.op.byte to byte.word.flag;
		call get.mod.r.m;
		and curr.mod.r.m with ^h38 giving wk.byte;
		if wk.byte = ^h08 then
			exitswitch;	{--invalid--}
			fi;
		call start.line;
		and curr.mod.r.m with ^h38 giving wk.byte;
		divide wk.byte by 8;
		index f6.f7.op.entry with wk.byte giving wk.bp;
		call put.string;
		call put.tab;
		call put.mod.r.m.c7;
		if curr.mod.r.m and ^h38 then
		else
			call put.comma;
			if byte.word.flag and ^h01 then
				call get.next.code.word;
				call put.hex.word;
			else
				call get.next.code.byte;
				call put.ascii.or.hex.byte;
				fi;
			fi;
		exit;
		end;
{special for ^hfe anf ^hff
	27: begin
		move curr.op.byte to byte.word.flag;
		call get.mod.r.m;
		and curr.mod.r.m with ^h38 giving wk.byte;
		if wk.byte <> ^h00
		and wk.byte <> ^h08 then
			if byte.word.flag and ^h01 then
				null;
			else
				exitswitch;	{--invalid--}
			fi;	fi;
		move "N" to label.needed;
		move 'N' to double.word.flag;
		move 0 to curr.op.txt[byte];
		switch on wk.byte:
			^h00:		move 'inc'		to curr.op.txt;
			^h08:		move 'dec'		to curr.op.txt;
			^h10:		move 'call'		to curr.op.txt;
			^h18: begin
						move 'call~09~far'	to curr.op.txt;
						move 'Y'		to double.word.flag;
						end;
			^h20: begin
						move 'jmp'		to curr.op.txt;
						move 'Y'		to label.needed;
						end;
			^h28: begin
						move 'jmp~09~far'		to curr.op.txt;
						move 'Y'		to double.word.flag;
						move 'Y'		to label.needed;
						end;
			^h30:		move 'push'		to curr.op.txt;
			endswitch;
		if curr.op.txt[byte] = 0 then
			exitswitch;	{--invalid--}
			fi;
		call start.line;
		call put.op;
		call put.tab;
		call put.mod.r.m.c7;
		if label.needed = 'Y' then
			move code.addr to lbl.addr;
			move 0 to lbl.type;
			move 0 to lbl.len;
			call put.curr.lbl;
			fi;
		exit;
		end;
	28: begin
		append curr.op.txt to rep.lock.prefix.txt;
		append ' ' to rep.lock.prefix.txt;
		move 'Y' to rep.lock.prefix.present;
		goto dssmbl.a.stmt;
		end;
{LDS & LES
{first byte is constant
{second byte is standard mod-r/m
	29: begin
		move ^hff to byte.word.flag;
		move 'N' to bkwds.mod.r.m;
		call start.line;
		call put.op;
		call put.tab;
		call get.mod.r.m;
		and curr.mod.r.m with ^hc0 giving wk.byte;
		if wk.byte = ^hc0 then
			exitswitch;
			fi;
		move 'Y' to double.word.flag;
		call put.mod.r.m;
		exit;
		end;
	endswitch;
	{-------------------------------------------
	{	something was wrong with this op
	{	print a db and try again with the next one
	{-------------------------------------------
	move prev.code.addr to code.addr;
	call get.next.code.byte;
	call start.line;
	call put.seg.prefix;
	move 'db~09~' to wk.str;
	call put.wk.str;
	call put.ascii.or.hex.byte;
end;

	{---start program---}
	accept "file-name to disassemble:           ",wk.str;
	convert wk.str to upper case;
	move wk.str to input.name;
	open input.file input error begin
		display "input file not found";
		goto end;
		end;

	accept "file-name for source-output:        ",wk.str;
	convert wk.str to upper case;
	move wk.str to put.name;

	accept "sector offset to begin disassembly: ",wk.str;
	convert wk.str to start.key.offset;

	accept "address (hex) of first byte:        ",wk.str;
	convert hex wk.str to start.code.addr;

	accept "ending address (hex):               ",wk.str;
	convert hex wk.str to end.code.addr;

	accept "Show address on output file? (Y/N): ",wk.str;
	convert wk.str to upper case;
	move wk.str[byte] to show.addr.flag;

	accept "Echo output to console? (Y/N):      ",wk.str;
	convert wk.str to upper case;
	move wk.str[byte] to con.echo.switch;

	accept '8080 memory map? (Y/N):             ',wk.str;
	convert wk.str to upper case;
	move wk.str[byte] to mem.map.8080;

	accept 'Full expansion on MOVS, CMPS, etc?  ',wk.str;
	convert wk.str to upper case;
	move wk.str[byte] to full.MOVS.text;

	open put.file output remove error standard;
	{------------------------------------------------
	{	first pass - build label table
	{------------------------------------------------
	move start.code.addr to code.addr;
	move start.lbl.tbl to lbl.tbl.wp;
	move 1 to pass.num;
	while code.addr < end.code.addr do
		move code.addr to prev.code.addr;
		call dssmbl.a.stmt;
		od;
	{----------------------------------------------
	{	second pass - actual code output
	{----------------------------------------------
	move start.code.addr to code.addr;
	move start.lbl.tbl to lbl.tbl.wp;
	move 2 to pass.num;

	move "~09~cseg~0d0a~" to wk.str;
	call put.wk.str;

	while code.addr < end.code.addr do
		move code.addr to prev.code.addr;
		call dssmbl.a.stmt;
		exchange code.addr with prev.code.addr;
		do
			call put.tab;
			od until put.colm >= 40;
		call put.semicolon;
		if show.addr.flag = 'Y' then
			convert code.addr to hex wk.str;
			convert wk.str to lower case;
			call put.wk.str;
			call put.tab;
			fi;
		while code.addr < prev.code.addr do
			call get.code.byte;
			switch on code.byte:
				^h21 - ^h7e: begin
						move code.byte to put.char;
						call put.a.byte;
						end;
				else begin
						move '(' to put.char;
						call put.a.byte;
						convert code.byte to hex wk.str;
						convert wk.str to lower case;
						move wk.str[+2] to wk.str;
						call put.wk.str;
						move ')' to put.char;
						call put.a.byte;
						end;
				endswitch;
			add 1 to code.addr;
			od;
		call put.crlf;
		od;
	move ' ' to curr.seg.reg;
	move ' ' to last.seg.reg;
	while lbl.tbl.wp < end.lbl.tbl do
		switch on @lbl.tbl.wp[bp]:	{--label-type--}
			0,^h10:	move 'C' to curr.seg.reg;
			1,^h11:	move 'D' to curr.seg.reg;
			2,^h12:	move 'S' to curr.seg.reg;
			3,^h13:	move 'E' to curr.seg.reg;
			endswitch;
		add 1 to lbl.tbl.wp giving wk.lbl.wp;
		move @wk.lbl.wp[bp] to lbl.len;
		add 1 to wk.lbl.wp;
		move @wk.lbl.wp to code.word;
		switch on curr.seg.reg:
			'A'-'Z': begin
					add lbl.entry.len to lbl.tbl.wp;
					add 2 to lbl.tbl.wp giving wk.lbl.wp;
					move @wk.lbl.wp to code.addr;
					end;
			else begin
					move last.seg.value to code.addr;
					end;
			endswitch;
		if curr.seg.reg <> last.seg.reg
		or code.addr <> last.seg.value then
			move '~09~' to wk.str[byte];
			move curr.seg.reg to wk.str[+1,byte];
			move 'seg' to wk.str[+2];
			call put.wk.str;
			switch on curr.seg.reg:
				'A'-'Z': begin
						call put.tab;
						push code.word;
						move code.addr to code.word;
						call put.hex.word;
						pop code.word;
						move 0 to code.addr;
						end;
				endswitch;
			call put.crlf;
			fi;
		move curr.seg.reg to last.seg.reg;
		move code.addr		to last.seg.value;
		if code.addr <> code.word then
			move "~09~org~09~" to wk.str;
			call put.wk.str;
			call put.hex.word;
			call put.crlf;
			fi;
		move code.word to code.addr;

		convert code.addr to hex wk.str[+1];
		convert wk.str[+1] to lower case;
		move curr.seg.reg to wk.str[byte];
		and wk.str[byte] with ^h5f;	{--upper case--}
		switch on lbl.len:
			1:		move "B~09~rb~09~1"	to wk.str[+5];
			2,4:	move "W~09~rw~09~1"	to wk.str[+5];
			else begin
				move ':' to wk.str[+5,word];
				move 0 to lbl.len;
				end;
			endswitch;
		call put.wk.str;
		call put.crlf;
		add lbl.len to code.addr;
		add lbl.entry.len to lbl.tbl.wp;
		od;
	move '~09~end~0d0a~' to wk.str;
	call put.wk.str;
	close input.file error standard;
	close put.file error standard;
end;