mirror of
https://github.com/SEPPDROID/Digital-Research-Source-Code.git
synced 2025-10-24 08:54:17 +00:00
1131 lines
25 KiB
Plaintext
1131 lines
25 KiB
Plaintext
$title('assembler for ddt86')
|
||
$date(6/15/81)
|
||
$compact
|
||
$optimize(2)
|
||
|
||
ddtasm: do;
|
||
|
||
declare
|
||
logical literally 'byte',
|
||
true literally '1',
|
||
false literally '0',
|
||
tab literally '09h',
|
||
cr literally '0dh',
|
||
lf literally '0ah';
|
||
|
||
declare
|
||
tab$ptrs (5) address external,
|
||
nops (5) byte external,
|
||
opn$in (6) byte external,
|
||
optab (480) byte external;
|
||
|
||
declare
|
||
token (32) byte, /* ASCII token */
|
||
token$word address at (.token), /* used for word compares */
|
||
token$len byte, /* number of chars in token */
|
||
token$type byte, /* number, string, or delimiter */
|
||
string$type literally '0',
|
||
number$type literally '1',
|
||
delim$type literally '2',
|
||
token$value address, /* value if token$type = number */
|
||
next$ch byte; /* next char of input stream */
|
||
|
||
declare
|
||
assem$ptr pointer,
|
||
assem$offset address at (.assem$ptr),
|
||
assem$segment address at (.assem$ptr+2),
|
||
assem$byte based assem$ptr byte;
|
||
|
||
declare
|
||
seg$reg (8) byte EXTERNAL,
|
||
reg16 (16) byte EXTERNAL,
|
||
reg8 (16) byte EXTERNAL,
|
||
base$reg (*) byte data ('BX', 'BP'),
|
||
index$reg (*) byte data ('SI', 'DI');
|
||
|
||
declare
|
||
op$base address,
|
||
(op1, op2, op based op$base) structure (
|
||
seg$reg$num byte,
|
||
reg$num byte,
|
||
base$reg$num byte,
|
||
index$reg$num byte,
|
||
seg$reg$type logical,
|
||
reg$16$type logical,
|
||
reg$8$type logical,
|
||
num$type logical,
|
||
acc$type logical,
|
||
null$type logical,
|
||
far$type logical,
|
||
mod$rm$type logical,
|
||
w$bit byte,
|
||
bw$prefix byte,
|
||
sub$type byte,
|
||
seg$value address,
|
||
value address);
|
||
|
||
/*
|
||
op.sub$types
|
||
|
||
1 reg8
|
||
2 reg16
|
||
3 [num]
|
||
4 [pointer reg]
|
||
5 [index reg]
|
||
6 [pointer reg + index reg]
|
||
7 num [pointer reg]
|
||
8 num [index reg]
|
||
9 num [pointer reg + index reg]
|
||
*/
|
||
|
||
declare
|
||
prefix (3) byte, /* up to 3 prefixes */
|
||
nprefix byte, /* number of prefixes */
|
||
seg$prefix$flag byte,
|
||
lock$flag byte,
|
||
rep$flag byte;
|
||
|
||
declare
|
||
mod$bits byte,
|
||
reg$bits byte,
|
||
rm$bits byte,
|
||
op$type byte,
|
||
mnemonic$index byte,
|
||
instr$1 byte,
|
||
disp$len byte, /* number of bytes in optional disp field */
|
||
disp$word address; /* value of optional disp field */
|
||
|
||
declare
|
||
delimiters (*) byte data (',', ':', '+', cr, ' ', tab),
|
||
left$bracket byte data ('['),
|
||
right$bracket byte data (']'),
|
||
num$delims literally '(length (delimiters) + 2)';
|
||
|
||
go$ddt: procedure external; /* return to assem loop in ddt on error */
|
||
end go$ddt;
|
||
|
||
ddt$set: procedure (assem$off, b) external;
|
||
declare assem$off address, b byte;
|
||
end ddt$set;
|
||
|
||
ddt$getline: procedure external;
|
||
end ddt$getline;
|
||
|
||
conin: procedure byte external;
|
||
end conin;
|
||
|
||
conout: procedure (b) external;
|
||
declare b byte;
|
||
end conout;
|
||
|
||
printm: procedure (a) EXTERNAL;
|
||
declare a address;
|
||
end printm;
|
||
|
||
crlf: procedure;
|
||
call conout (cr);
|
||
call conout (lf);
|
||
end crlf;
|
||
|
||
getline: procedure;
|
||
call ddt$getline;
|
||
next$ch = 0;
|
||
end getline;
|
||
|
||
print$word: procedure (a) EXTERNAL;
|
||
declare a address;
|
||
end print$word;
|
||
|
||
error: procedure;
|
||
call crlf;
|
||
call conout ('?');
|
||
call go$ddt;
|
||
end error;
|
||
|
||
ambig: procedure;
|
||
call printm (.(cr,lf,'ambiguous operand$'));
|
||
call go$ddt;
|
||
end ambig;
|
||
|
||
check$ambig: procedure;
|
||
if (op1.w$bit and op2.w$bit) = 0ffh then call ambig;
|
||
if (op1.w$bit xor op2.w$bit) = 1 then call error;
|
||
end check$ambig;
|
||
|
||
compare: procedure (a, b, c) logical;
|
||
/* should be able to replace this with a PL/M builtin */
|
||
declare (a, b) address, c byte;
|
||
declare a1 based a byte, b1 based b byte;
|
||
do while (c := c - 1) <> 255;
|
||
if a1 <> b1 then return false;
|
||
a = a + 1;
|
||
b = b + 1;
|
||
end;
|
||
return true;
|
||
end compare;
|
||
|
||
/*********************************/
|
||
/* */
|
||
/* token scanning procedures */
|
||
/* */
|
||
/*********************************/
|
||
|
||
delimiter: procedure (b) logical;
|
||
declare b byte;
|
||
declare i byte;
|
||
do i = 0 to num$delims - 1;
|
||
if delimiters (i) = b then return true;
|
||
end;
|
||
return false;
|
||
end delimiter;
|
||
|
||
number: procedure (b) logical;
|
||
declare b byte;
|
||
return (b - '0' <= 9) or (b - 'A' <= 5);
|
||
end number;
|
||
|
||
hex: procedure (b) byte;
|
||
declare b byte;
|
||
if b - '0' <= 9 then return b - '0';
|
||
else return b - 'A' + 10;
|
||
end hex;
|
||
|
||
get$token: procedure;
|
||
declare numeric logical;
|
||
token$value = 0;
|
||
numeric = true;
|
||
token$len = 0;
|
||
if next$ch = 0 then next$ch = conin;
|
||
do while true;
|
||
token (token$len) = next$ch;
|
||
if (token$len := token$len + 1) >= length (token) then
|
||
call error;
|
||
if delimiter (next$ch) then
|
||
do;
|
||
if token$len = 1 then
|
||
do;
|
||
token$type = delim$type;
|
||
next$ch = 0;
|
||
end;
|
||
else
|
||
do;
|
||
token$len = token$len - 1;
|
||
if numeric then token$type = number$type;
|
||
else token$type = string$type;
|
||
end;
|
||
return;
|
||
end;
|
||
if numeric then
|
||
do;
|
||
if number (next$ch) then token$value =
|
||
shl (token$value,4) or hex (next$ch);
|
||
else numeric = false;
|
||
end;
|
||
next$ch = conin;
|
||
end;
|
||
end get$token;
|
||
|
||
get$real$token: procedure;
|
||
do while true;
|
||
call get$token;
|
||
if token (0) <> ' ' and token (0) <> tab then return;
|
||
end;
|
||
end get$real$token;
|
||
|
||
/***********************************/
|
||
/* */
|
||
/* operand scanning procedures */
|
||
/* */
|
||
/***********************************/
|
||
|
||
look$up$reg: procedure (reg$tab$ptr, tab$len, reg$num$ptr) logical;
|
||
declare (reg$tab$ptr, reg$num$ptr) address;
|
||
declare reg$word based reg$tab$ptr address;
|
||
declare reg$num based reg$num$ptr byte;
|
||
declare tab$len byte;
|
||
declare i byte;
|
||
do i = 0 to tab$len - 1;
|
||
if token$word = reg$word then
|
||
do;
|
||
reg$num = i;
|
||
return true;
|
||
end;
|
||
reg$tab$ptr = reg$tab$ptr + 2;
|
||
end;
|
||
return false;
|
||
end look$up$reg;
|
||
|
||
check$base$reg: procedure logical;
|
||
return look$up$reg (.base$reg, 2, .op.base$reg$num);
|
||
end check$base$reg;
|
||
|
||
check$index$reg: procedure logical;
|
||
return look$up$reg (.index$reg, 2, .op.index$reg$num);
|
||
end check$index$reg;
|
||
|
||
check$seg$reg: procedure logical;
|
||
if look$up$reg (.seg$reg, 4, .op.seg$reg$num) then
|
||
do;
|
||
op.seg$reg$type = true;
|
||
return true;
|
||
end;
|
||
return false;
|
||
end check$seg$reg;
|
||
|
||
check$reg$8: procedure logical;
|
||
if look$up$reg (.reg$8, 8, .op.reg$num) then
|
||
do;
|
||
op.reg$8$type, op.modrm$type = true;
|
||
if op.reg$num = 0 then op.acc$type = true;
|
||
op.sub$type = 1;
|
||
op.w$bit = 0;
|
||
return true;
|
||
end;
|
||
return false;
|
||
end check$reg$8;
|
||
|
||
check$reg$16: procedure logical;
|
||
if look$up$reg (.reg$16, 8, .op.reg$num) then
|
||
do;
|
||
op.reg$16$type, op.modrm$type = true;
|
||
if op.reg$num = 0 then op.acc$type = true;
|
||
op.sub$type = 2;
|
||
op.w$bit = 1;
|
||
return true;
|
||
end;
|
||
return false;
|
||
end check$reg$16;
|
||
|
||
check$bw$prefix: procedure logical;
|
||
if token$type = string$type then
|
||
do;
|
||
if token$word = 'YB' then op.bw$prefix = 0;
|
||
else if token$word = 'OW' then op.bw$prefix = 1;
|
||
if op.bw$prefix <> 0ffh then return true;
|
||
end;
|
||
return false;
|
||
end check$bw$prefix;
|
||
|
||
check$seg$prefix: procedure logical;
|
||
return check$seg$reg and (next$ch = ':');
|
||
end check$seg$prefix;
|
||
|
||
set$prefix: procedure (b);
|
||
declare b byte;
|
||
prefix (nprefix) = b;
|
||
nprefix = nprefix + 1;
|
||
end set$prefix;
|
||
|
||
set$seg$prefix: procedure;
|
||
if seg$prefix$flag then call error;
|
||
call set$prefix (26h or shl (op.seg$reg$num, 3));
|
||
seg$prefix$flag = true;
|
||
call get$token; /* eat ':' */
|
||
op.seg$reg$type = false; /* operand is not a seg reg */
|
||
end set$seg$prefix;
|
||
|
||
get$prefix: procedure;
|
||
do while true;
|
||
call get$real$token;
|
||
if token$type = delim$type then
|
||
do;
|
||
if token (0) = cr then op.null$type = true;
|
||
return;
|
||
end;
|
||
if check$seg$prefix then call set$seg$prefix;
|
||
else if check$bw$prefix then
|
||
do;
|
||
if op.w$bit <> 0ffh then call error;
|
||
else op.w$bit = op.bw$prefix;
|
||
end;
|
||
else return; /* must not be a prefix */
|
||
end;
|
||
end get$prefix;
|
||
|
||
reg$indirect: procedure (x);
|
||
declare x byte;
|
||
op.modrm$type = true;
|
||
if check$base$reg then
|
||
do;
|
||
call get$token;
|
||
if token (0) = right$bracket then
|
||
do;
|
||
op.modrm$type = true;
|
||
op.sub$type = 7 - x;
|
||
return;
|
||
end;
|
||
else if token (0) = '+' then
|
||
do;
|
||
op.sub$type = 9 - x;
|
||
call get$token;
|
||
end;
|
||
else call error;
|
||
end;
|
||
else op.sub$type = 8 - x;
|
||
if check$index$reg then
|
||
do;
|
||
call get$token;
|
||
if token (0) = right$bracket then return;
|
||
end;
|
||
call error;
|
||
end reg$indirect;
|
||
|
||
get$operand: procedure;
|
||
op.seg$reg$type, op.reg$16$type, op.reg$8$type, op.num$type,
|
||
op.acc$type, op.null$type, op.far$type, op.modrm$type = false;
|
||
op.bw$prefix, op.w$bit = 0ffh; /* indeterminate */
|
||
call get$prefix;
|
||
if op.null$type then return;
|
||
if check$seg$reg then return;
|
||
else if check$reg$8 then return;
|
||
else if check$reg$16 then return;
|
||
else if token$type = number$type then
|
||
do;
|
||
op.value = token$value;
|
||
if next$ch = left$bracket then
|
||
do;
|
||
call get$token; /* eat '[' */
|
||
call get$token;
|
||
call reg$indirect (0);
|
||
end;
|
||
else if next$ch = ':' then
|
||
do;
|
||
op.seg$value = token$value;
|
||
call get$token; /* eat ':' */
|
||
call get$token;
|
||
if token$type <> number$type then call error;
|
||
op.value = token$value;
|
||
op.far$type = true;
|
||
end;
|
||
else op.num$type = true;
|
||
end;
|
||
else
|
||
do;
|
||
if token (0) <> left$bracket then call error;
|
||
call get$token;
|
||
if token$type = number$type then
|
||
do;
|
||
op.value = token$value;
|
||
call get$token;
|
||
if token (0) = right$bracket then
|
||
do;
|
||
op.sub$type = 3;
|
||
op.modrm$type = true;
|
||
end;
|
||
else call error;
|
||
end;
|
||
else call reg$indirect (3);
|
||
end;
|
||
end get$operand;
|
||
|
||
get$operand$1: procedure;
|
||
op$base = .op1;
|
||
call get$operand;
|
||
call get$token;
|
||
if token (0) <> ',' then call error;
|
||
end get$operand$1;
|
||
|
||
get$operand$2: procedure;
|
||
op$base = .op2;
|
||
call get$operand;
|
||
if op.null$type then return;
|
||
call get$token;
|
||
if token (0) <> cr then call error;
|
||
end get$operand$2;
|
||
|
||
/**********************************/
|
||
/* */
|
||
/* opcode scanning procedures */
|
||
/* */
|
||
/**********************************/
|
||
|
||
lookup$optab: procedure;
|
||
declare i address;
|
||
do i = 0 to last (optab) by 4;
|
||
if optab (i) = mnemonic$index then
|
||
do;
|
||
op$type = op$tab (i+1);
|
||
instr$1 = op$tab (i+2);
|
||
reg$bits = op$tab (i+3);
|
||
return;
|
||
end;
|
||
end;
|
||
call error; /* should never get here */
|
||
end lookup$optab;
|
||
|
||
valid$mnemonic: procedure logical;
|
||
declare
|
||
i byte,
|
||
table$base address,
|
||
mnemonic based table$base byte;
|
||
if token$len - 2 > 4 then call error;
|
||
table$base = tab$ptrs (token$len - 2);
|
||
do i = 0 to nops (token$len - 2) - 1;
|
||
if compare (.token, .mnemonic, token$len) then
|
||
do;
|
||
mnemonic$index = i + opn$in (token$len - 2);
|
||
return true;
|
||
end;
|
||
table$base = table$base + token$len;
|
||
end;
|
||
return false;
|
||
end valid$mnemonic;
|
||
|
||
get$opcode: procedure logical;
|
||
nprefix = 0;
|
||
rep$flag, lock$flag, seg$prefix$flag = false;
|
||
do while true;
|
||
call get$real$token;
|
||
if token (0) = cr or token (0) = '.' then return false; /* no opcode */
|
||
if check$seg$prefix then call set$seg$prefix;
|
||
else if valid$mnemonic then
|
||
do;
|
||
call look$up$op$tab;
|
||
if op$type = 0ffh then
|
||
do;
|
||
if lock$flag then call error;
|
||
lock$flag = true;
|
||
call set$prefix (instr$1);
|
||
end;
|
||
else if op$type = 0feh then /* repeat */
|
||
do;
|
||
if rep$flag then call error;
|
||
rep$flag = true;
|
||
call set$prefix (instr$1);
|
||
end;
|
||
else return true; /* opcode present */
|
||
end;
|
||
else call error;
|
||
end;
|
||
end get$opcode;
|
||
|
||
/******************************************/
|
||
/* */
|
||
/* forming and output of instructions */
|
||
/* */
|
||
/******************************************/
|
||
|
||
put$mem: procedure (b);
|
||
declare b byte;
|
||
call ddt$set (assem$offset, b);
|
||
assem$offset = assem$offset + 1;
|
||
end put$mem;
|
||
|
||
put$prefix: procedure;
|
||
declare i byte;
|
||
i = 0;
|
||
do while (nprefix := nprefix - 1) <> 0ffh;
|
||
call put$mem (prefix (i));
|
||
i = i + 1;
|
||
end;
|
||
end put$prefix;
|
||
|
||
put$instr: procedure;
|
||
call put$prefix;
|
||
call put$mem (instr$1);
|
||
end put$instr;
|
||
|
||
set$instr: procedure (b);
|
||
declare b byte;
|
||
instr$1 = b;
|
||
call put$instr;
|
||
end set$instr;
|
||
|
||
put$word: procedure (a);
|
||
declare a address;
|
||
call put$mem (low (a));
|
||
call put$mem (high (a));
|
||
end put$word;
|
||
|
||
set$w$bit: procedure;
|
||
if (op1.w$bit and op2.w$bit) = 1 then instr$1 = instr$1 or 1;
|
||
end set$w$bit;
|
||
|
||
set$mod: procedure;
|
||
if op.value > 7FH then mod$bits, disp$len = 2;
|
||
else mod$bits, disp$len = 1;
|
||
end set$mod;
|
||
|
||
set$modrm: procedure;
|
||
disp$len = 0;
|
||
disp$word = op.value;
|
||
do case op.sub$type - 1;
|
||
do; /* 1 */
|
||
mod$bits = 3;
|
||
rm$bits = op.reg$num;
|
||
end;
|
||
do; /* 2 */
|
||
mod$bits = 3;
|
||
rm$bits = op.reg$num;
|
||
end;
|
||
do; /* 3 */
|
||
mod$bits = 0;
|
||
rm$bits = 6;
|
||
disp$len = 2;
|
||
end;
|
||
do; /* 4 */
|
||
if op.base$reg$num = 1 then /* BP */
|
||
do;
|
||
mod$bits = 1;
|
||
rm$bits = 6;
|
||
disp$len = 1;
|
||
disp$word = 0;
|
||
end;
|
||
else
|
||
do;
|
||
mod$bits = 0;
|
||
rm$bits = 7;
|
||
end;
|
||
end;
|
||
do; /* 5 */
|
||
mod$bits = 0;
|
||
rm$bits = op.index$reg$num + 4;
|
||
end;
|
||
do; /* 6 */
|
||
mod$bits = 0;
|
||
rm$bits = op.base$reg$num * 2 + op.index$reg$num;
|
||
end;
|
||
do; /* 7 */
|
||
call set$mod;
|
||
rm$bits = 7 - op.base$reg$num;
|
||
end;
|
||
do; /* 8 */
|
||
call set$mod;
|
||
rm$bits = op.index$reg$num + 4;
|
||
end;
|
||
do; /* 9 */
|
||
call set$mod;
|
||
rm$bits = op.base$reg$num * 2 + op.index$reg$num;
|
||
end;
|
||
end;
|
||
end set$modrm;
|
||
|
||
do$modrm: procedure (op$ptr);
|
||
declare op$ptr address;
|
||
op$base = op$ptr;
|
||
call set$modrm;
|
||
call put$instr;
|
||
call put$mem (shl (mod$bits, 6) or shl (reg$bits, 3) or rm$bits);
|
||
if disp$len > 0 then call put$mem (low (disp$word));
|
||
if disp$len > 1 then call put$mem (high (disp$word));
|
||
end do$modrm;
|
||
|
||
modrm$w: procedure (ins, reg, op$ptr);
|
||
declare (ins, reg) byte;
|
||
declare op$ptr address;
|
||
op$base = op$ptr;
|
||
if op.modrm$type then
|
||
do;
|
||
if op.w$bit = 0ffh then call ambig;
|
||
instr$1 = ins or op.w$bit;
|
||
reg$bits = reg;
|
||
call do$modrm (op$ptr);
|
||
end;
|
||
else call error;
|
||
end modrm$w;
|
||
|
||
modrm$16: procedure (ins, reg);
|
||
declare (ins, reg) byte;
|
||
if op2.modrm$type and not op2.reg$8$type then
|
||
do;
|
||
instr$1 = ins;
|
||
reg$bits = reg;
|
||
call do$modrm (.op2);
|
||
end;
|
||
else call error;
|
||
end modrm$16;
|
||
|
||
modregrm: procedure;
|
||
call check$ambig;
|
||
if op1.sub$type <= 2 then /* first op is register */
|
||
do;
|
||
reg$bits = op1.reg$num;
|
||
call do$modrm (.op2);
|
||
end;
|
||
else
|
||
do;
|
||
instr$1 = instr$1 or op2.w$bit;
|
||
reg$bits = op2.reg$num;
|
||
call do$modrm (.op1);
|
||
end;
|
||
end modregrm;
|
||
|
||
modregrm$w: procedure;
|
||
call set$w$bit;
|
||
call modregrm;
|
||
end modregrm$w;
|
||
|
||
modregrm$dw: procedure;
|
||
if op1.modrm$type and (op1.sub$type <= 2) then instr$1 = instr$1 or 2; /* set d bit */
|
||
call modregrm$w;
|
||
end modregrm$dw;
|
||
|
||
put$immed: procedure;
|
||
call put$mem (low (op2.value));
|
||
if op1.w$bit then call put$mem (high (op2.value));
|
||
end put$immed;
|
||
|
||
put$immed$s: procedure;
|
||
call put$mem (low (op2.value));
|
||
if (instr$1 and 3) = 1 then call put$mem (high (op2.value));
|
||
end put$immed$s;
|
||
|
||
check$w$and$val: procedure;
|
||
if op1.w$bit = 0 and op2.value > 255 then call error;
|
||
if op1.w$bit = 0ffh then
|
||
do;
|
||
if op2.value >= 256 then op1.w$bit = 1;
|
||
else call ambig;
|
||
end;
|
||
end check$w$and$val;
|
||
|
||
acc$immed: procedure;
|
||
call check$w$and$val;
|
||
call set$w$bit;
|
||
call put$instr;
|
||
call put$immed;
|
||
end acc$immed;
|
||
|
||
modrm$immed: procedure;
|
||
call check$w$and$val;
|
||
call set$w$bit;
|
||
call do$modrm (.op1);
|
||
call put$immed;
|
||
end modrm$immed;
|
||
|
||
set$instr$w: procedure (b);
|
||
declare b byte;
|
||
if op2.sub$type <= 2 then instr$1 = b or op2.w$bit;
|
||
else instr$1 = b or op1.w$bit;
|
||
end set$instr$w;
|
||
|
||
check$acc$immed: procedure logical;
|
||
return op1.acc$type and op2.num$type;
|
||
end check$acc$immed;
|
||
|
||
check$modrm$immed: procedure logical;
|
||
return op1.modrm$type and op2.num$type;
|
||
end check$modrm$immed;
|
||
|
||
check$modrm$modrm: procedure logical;
|
||
return op1.modrm$type and op2.modrm$type and not
|
||
(op1.sub$type > 2 and op2.sub$type > 2);
|
||
end check$modrm$modrm;
|
||
|
||
/**************************************/
|
||
/* */
|
||
/* mnemonic processing procedures */
|
||
/* */
|
||
/**************************************/
|
||
|
||
type1: procedure;
|
||
/*
|
||
mnemonics: simple one-byte instructions
|
||
operands: none
|
||
forms: xxxxxxxx
|
||
*/
|
||
call get$operand$2;
|
||
if op2.null$type then call put$instr;
|
||
else call error;
|
||
end type1;
|
||
|
||
type2: procedure;
|
||
/*
|
||
mnemonics: aad aam
|
||
operands: none
|
||
forms: xxxxxxxx 00001010
|
||
*/
|
||
call get$operand$2;
|
||
if op2.null$type then
|
||
do;
|
||
call put$instr;
|
||
call put$mem (0ah);
|
||
end;
|
||
else call error;
|
||
end type2;
|
||
|
||
type3: procedure;
|
||
/*
|
||
mnemonics: conditional jumps loopxx jmps
|
||
operands: 1 (number)
|
||
forms: xxxxxxxx IP-INC8
|
||
*/
|
||
call get$operand$2;
|
||
if op2.num$type and (op2.value - (assem$offset - 7eh) <= 255) then
|
||
do;
|
||
call put$instr;
|
||
call put$mem (low (op2.value - (assem$offset + 1)));
|
||
end;
|
||
else call error;
|
||
end type3;
|
||
|
||
type4: procedure;
|
||
/*
|
||
mnemonics: logical shifts and rotates
|
||
operands: 2
|
||
forms: xxxxxxvw mmxxxr/m [disp-lo] [disp-hi]
|
||
*/
|
||
call get$operand$1;
|
||
call get$operand$2;
|
||
if op1.modrm$type then
|
||
do;
|
||
if op2.reg$8$type and (op2.reg$num = 1) then
|
||
instr$1 = instr$1 or 2; /* set v bit */
|
||
else if not (op2.num$type and (op2.value = 1)) then call error;
|
||
call modrm$w (instr1, reg$bits, .op1);
|
||
end;
|
||
else call error;
|
||
end type4;
|
||
|
||
type5: procedure;
|
||
/*
|
||
mnemonics: div idiv mul imul not neg
|
||
operands: 1
|
||
forms: xxxxxxxw mmxxxr/m [disp-lo] [disp-hi]
|
||
*/
|
||
call get$operand$2;
|
||
call modrm$w (instr$1, reg$bits, .op2);
|
||
end type5;
|
||
|
||
type6: procedure;
|
||
/*
|
||
mnemonics: les lds lea
|
||
operands: 2 (reg16, memory)
|
||
forms: xxxxxxxx mmregr/m [disp-lo] [disp-hi]
|
||
*/
|
||
call get$operand$1;
|
||
call get$operand$2;
|
||
if op1.reg$16$type and op2.modrm$type and (op2.sub$type > 2) then
|
||
call mod$reg$rm;
|
||
else call error;
|
||
end type6;
|
||
|
||
declare
|
||
type$7$struc (2) structure (op$val (2) byte) initial (
|
||
048h, 001h, /* dec */
|
||
040h, 000h); /* inc */
|
||
|
||
type7: procedure;
|
||
/*
|
||
mnemonics: inc dec
|
||
operands: 1
|
||
forms: xxxxxreg
|
||
xxxxxxxw mmxxxr/m [disp-lo] [disp-hi]
|
||
*/
|
||
call get$operand$2;
|
||
if op2.reg$16$type then call set$instr (type$7$struc (instr$1).op$val (0) or op2.reg$num);
|
||
else call modrm$w (0feh, type$7$struc (instr$1).op$val (1), .op2);
|
||
end type7;
|
||
|
||
type8or8a: procedure;
|
||
if op2.seg$reg$type then call set$instr (type$8$struc (instr$1).op$val (0) or
|
||
shl (op2.seg$reg$num, 3));
|
||
else if op2.reg$16$type then call set$instr (type$8$struc (instr$1).op$val (1) or op2.reg$num);
|
||
else call modrm$16 (type$8$struc (instr$1).op$val (2),
|
||
type$8$struc (instr$1).op$val (3));
|
||
end type8or8a;
|
||
|
||
declare
|
||
type$8$struc (2) structure (op$val (4) byte) initial (
|
||
07h, 58h, 8fh, 00h, /* pop */
|
||
06h, 50h, 0ffh, 06h); /* push */
|
||
|
||
type8: procedure;
|
||
/*
|
||
mnemonics: push
|
||
operands: 1
|
||
forms: xxxSRxxx
|
||
xxxxxreg
|
||
xxxxxxxx mmxxxr/m [disp-lo] [disp-hi]
|
||
*/
|
||
call get$operand2;
|
||
call type8or8a;
|
||
end type8;
|
||
|
||
type8a: procedure;
|
||
/*
|
||
mnemonics: pop
|
||
operands: 1
|
||
forms: xxxSRxxx
|
||
xxxxxreg
|
||
xxxxxxxx mmxxxr/m [disp-lo] [disp-hi]
|
||
*/
|
||
call get$operand2;
|
||
if op2.seg$reg$type and (op2.seg$reg$num = 1) then call error;
|
||
else call type8or8a;
|
||
end type8a;
|
||
|
||
type9or10: procedure (type);
|
||
declare type byte;
|
||
call get$operand$1;
|
||
call get$operand$2;
|
||
if check$acc$immed then
|
||
do;
|
||
instr$1 = instr$1 or 4;
|
||
call acc$immed;
|
||
end;
|
||
else if check$modrm$immed then
|
||
do;
|
||
instr$1 = 80h;
|
||
if type = 9 then
|
||
do;
|
||
if op2.value < 80h or op2.value >= 0ff80h then
|
||
instr$1 = instr$1 or 2;
|
||
call check$w$and$val;
|
||
call set$w$bit;
|
||
call do$modrm (.op1);
|
||
call put$immed$s;
|
||
end;
|
||
else call modrm$immed;
|
||
end;
|
||
else if check$modrm$modrm then call mod$reg$rm$dw;
|
||
else call error;
|
||
end type9or10;
|
||
|
||
type9: procedure;
|
||
/*
|
||
mnemonics: add adc cmp sub sbb
|
||
operands: 2
|
||
forms: xxxxxxxw data-lo data-hi (if w=1)
|
||
xxxxxxsw mmxxxr/m [disp-lo] [disp-hi] data-lo data-hi (if sw=01)
|
||
xxxxxxdw mmregr/m [disp-lo] [disp-hi]
|
||
*/
|
||
call type9or10 (9);
|
||
end type9;
|
||
|
||
type10: procedure;
|
||
/*
|
||
mnemonics: and or xor
|
||
operands: 2
|
||
forms: xxxxxxxw data-lo data-hi (if w=1)
|
||
xxxxxxxw mmxxxr/m [disp-lo] [disp-hi] data-lo data-hi (if w=1)
|
||
xxxxxxdw mmregr/m [disp-lo] [disp-hi]
|
||
*/
|
||
call type9or10 (10);
|
||
end type10;
|
||
|
||
declare type11$struc (2) structure (op$val (2) byte) initial (
|
||
0e8h, 2, /* call */
|
||
0e9h, 4); /* jmp */
|
||
|
||
type11: procedure;
|
||
/*
|
||
mnemonics: call jmp
|
||
operands: 1
|
||
forms: xxxxxxxx IP-INC16
|
||
xxxxxxxx mmxxxr/m [disp-lo] [disp-hi]
|
||
*/
|
||
call get$operand$2;
|
||
if op2.num$type then
|
||
do;
|
||
call set$instr (type11$struc (instr$1).op$val (0));
|
||
call put$word (op2.value - (assem$offset + 2));
|
||
end;
|
||
else call modrm$16 (0ffh, type$11$struc (instr$1).op$val (1));
|
||
end type11;
|
||
|
||
type$int: procedure;
|
||
call get$operand$2;
|
||
if op2.num$type and (op2.value <= 255) then
|
||
do;
|
||
if op2.value = 3 then call set$instr (0cch);
|
||
else
|
||
do;
|
||
call set$instr (0cdh);
|
||
call put$mem (low (op2.value));
|
||
end;
|
||
end;
|
||
else call error;
|
||
end type$int;
|
||
|
||
type$esc: procedure;
|
||
call get$operand$1;
|
||
call get$operand$2;
|
||
if op1.num$type and (op1.value < 64) and op2.modrm$type then
|
||
do;
|
||
instr$1 = instr$1 or shr (low (op1.value), 3);
|
||
reg$bits = low (op1.value) and 7;
|
||
call do$modrm (.op2);
|
||
end;
|
||
else call error;
|
||
end type$esc;
|
||
|
||
type$ret$retf: procedure;
|
||
op$base = .op2;
|
||
call get$operand;
|
||
if op2.null$type then call set$instr (instr$1 or 1);
|
||
else if op2.num$type then
|
||
do;
|
||
call put$instr;
|
||
call put$word (op2.value);
|
||
end;
|
||
else call error;
|
||
end type$ret$retf;
|
||
|
||
type$in: procedure;
|
||
call get$operand$1;
|
||
if not op1.acc$type then call error;
|
||
call get$operand$2;
|
||
if op2.reg$16$type and (op2.reg$num = 2) /* DX */ then
|
||
call set$instr (instr$1 or 8 or op1.w$bit);
|
||
else if op2.num$type and (op2.value <= 255) then
|
||
do;
|
||
call put$instr;
|
||
call put$mem (low (op2.value));
|
||
end;
|
||
else call error;
|
||
end type$in;
|
||
|
||
type$out: procedure;
|
||
declare temp byte;
|
||
call get$operand$1;
|
||
if op1.reg$16$type and (op1.reg$num = 2) /* DX */ then temp = 1;
|
||
else if op1.num$type and (op1.value <= 255) then temp = 0;
|
||
else call error;
|
||
call get$operand$2;
|
||
if not op2.acc$type then call error;
|
||
call put$mem (instr$1 or shl (temp,3) or op2.w$bit);
|
||
if temp = 0 then call put$mem (low (op1.value));
|
||
end type$out;
|
||
|
||
declare cjstruc (2) structure (op$val (2) byte) initial (
|
||
09ah, 3, /* callf */
|
||
0eah, 5); /* jmpf */
|
||
|
||
type$callf$jmpf: procedure;
|
||
call get$operand$2;
|
||
if op2.far$type then
|
||
do;
|
||
call set$instr (cjstruc (instr$1).op$val (0));
|
||
call put$word (op2.value);
|
||
call put$word (op2.seg$value);
|
||
end;
|
||
else call modrm$16 (0ffh, cj$struc (instr$1).op$val (1));
|
||
end type$callf$jmpf;
|
||
|
||
type$test: procedure;
|
||
call get$operand$1;
|
||
call get$operand$2;
|
||
if check$acc$immed then
|
||
do;
|
||
instr$1 = 0a8h;
|
||
call acc$immed;
|
||
end;
|
||
else if check$modrm$immed then
|
||
do;
|
||
instr$1 = 0f6h;
|
||
call modrm$immed;
|
||
end;
|
||
else if check$modrm$modrm then
|
||
do;
|
||
call set$instr$w (84h);
|
||
call mod$reg$rm;
|
||
end;
|
||
else call error;
|
||
end type$test;
|
||
|
||
type$xchg: procedure;
|
||
call get$operand$1;
|
||
call get$operand$2;
|
||
if op1.acc$type and op1.w$bit and op2.reg$16$type then
|
||
call set$instr (90h + op2.reg$num);
|
||
else if check$modrm$modrm then
|
||
do;
|
||
call set$instr$w (86h);
|
||
call modregrm;
|
||
end;
|
||
else call error;
|
||
end type$xchg;
|
||
|
||
type$mov: procedure;
|
||
call get$operand$1;
|
||
call get$operand$2;
|
||
if op1.seg$reg$type and op2.modrm$type and not op2.reg$8$type then
|
||
do;
|
||
instr$1 = 8eh;
|
||
reg$bits = op1.seg$reg$num;
|
||
call do$modrm (.op2);
|
||
end;
|
||
else if op1.modrm$type and not (op1.sub$type = 1) and op2.seg$reg$type then
|
||
do;
|
||
instr$1 = 8ch;
|
||
reg$bits = op2.seg$reg$num;
|
||
call do$modrm (.op1);
|
||
end;
|
||
else if op1.acc$type and op2.modrm$type and (op2.subtype = 3) then
|
||
do;
|
||
instr$1 = 0a0h or op1.w$bit;
|
||
call put$instr;
|
||
call put$word (op2.value);
|
||
end;
|
||
else if op2.acc$type and op1.modrm$type and (op1.sub$type = 3) then
|
||
do;
|
||
instr$1 = 0a2h or op2.w$bit;
|
||
call put$instr;
|
||
call put$word (op1.value);
|
||
end;
|
||
else if check$modrm$immed then
|
||
do;
|
||
if op1.sub$type <= 2 then
|
||
do;
|
||
call set$instr (0b0h or shl (op1.w$bit, 3) or op1.reg$num);
|
||
call put$immed;
|
||
end;
|
||
else
|
||
do;
|
||
instr$1 = 0c6h;
|
||
call modrm$immed;
|
||
end;
|
||
end;
|
||
else if check$modrm$modrm then
|
||
do;
|
||
instr$1 = 88h;
|
||
call mod$reg$rm$dw;
|
||
end;
|
||
else call error;
|
||
end type$mov;
|
||
|
||
asm: procedure (loc) address public;
|
||
declare loc pointer;
|
||
assem$ptr = loc;
|
||
call crlf;
|
||
call print$word (assem$segment);
|
||
call conout (':');
|
||
call print$word (assem$offset);
|
||
call conout (' ');
|
||
call get$line;
|
||
op$base = .op1; /* must be set for prefix scan */
|
||
if get$opcode then
|
||
do;
|
||
if op$type > 21 then call error;
|
||
do case optype;
|
||
call error;
|
||
call type1;
|
||
call type2;
|
||
call type3;
|
||
call type4;
|
||
call type5;
|
||
call type6;
|
||
call type7;
|
||
call type8;
|
||
call type9;
|
||
call type10;
|
||
call type11;
|
||
call type$int;
|
||
call type$esc;
|
||
call type$ret$retf;
|
||
call type$in;
|
||
call type$out;
|
||
call type$callf$jmpf;
|
||
call type$test;
|
||
call type$xchg;
|
||
call type$mov;
|
||
call type8a;
|
||
end;
|
||
end;
|
||
else call put$prefix; /* may be prefix without opcode */
|
||
return assem$offset;
|
||
end asm;
|
||
|
||
end ddtasm;
|
||
|