mirror of
https://github.com/SEPPDROID/Digital-Research-Source-Code.git
synced 2025-10-24 08:54:17 +00:00
453 lines
12 KiB
Plaintext
453 lines
12 KiB
Plaintext
$title ('CODEMACRO SUBROUTINE MODULE')
|
||
cmsubr:
|
||
do;
|
||
|
||
/*
|
||
|
||
modified 4/7/81 R. Silberstein
|
||
modified 4/13/81 R. Silberstein
|
||
modified 5/5/81 R. Silberstein
|
||
modified 9/2/81 R. Silberstein
|
||
|
||
*/
|
||
|
||
/*
|
||
This is the module to
|
||
|
||
1) test if a set of operands matches a given instruction
|
||
|
||
and
|
||
|
||
2) produce output code for matched instruction
|
||
|
||
The module interfaces the CODEOUTPUT module to
|
||
physically send code bytes to the HEX output file.
|
||
*/
|
||
|
||
$include (:f1:macro.lit)
|
||
$include (:f1:equals.lit)
|
||
$include (:f1:cmacd.lit)
|
||
$include (:f1:outp.lit)
|
||
$include (:f1:scan.ext)
|
||
$include (:f1:subr1.ext)
|
||
$INCLUDE (:F1:SUBR2.EXT)
|
||
$include (:f1:outp.ext)
|
||
$include (:f1:ermod.ext)
|
||
$include (:f1:cmsubr.x86)
|
||
$eject
|
||
dcl /* global variables */
|
||
bytevar based macroptr byte, /* variables within codemacros */
|
||
addrvar based macroptr addr,
|
||
emitbyte(80) byte, /* buffer of output codebytes */
|
||
emitindex byte, /* index of "emitbyte" */
|
||
bitcomtab(2) byte data /* legal commands within "DBIT" */
|
||
(mnumberbits,mformalbits);
|
||
$eject
|
||
|
||
/********** MICHELLANEOUS SUBROUTINES: **********/
|
||
|
||
clearcmindex: proc public;
|
||
emitindex=0;
|
||
end clearcmindex;
|
||
|
||
emit: proc public; /* emit codebytes for an instruction */
|
||
dcl i byte;
|
||
i=0ffh;
|
||
do while (i:=i+1) < emitindex;
|
||
call emitcodebyte(emitbyte(i),CSdata);
|
||
end$while;
|
||
end emit;
|
||
|
||
emitdummies: proc public; /* emit dummy (NO-OP-) bytes if error */
|
||
dcl (i,j) byte,nodum(4) byte data(2,5,6,8);
|
||
j=nooper;
|
||
if j>3 then j=3;
|
||
i=0ffh;
|
||
do while (i:=i+1) < nodum(j);
|
||
call emitcodebyte(90h,CSdata); /* 90H = NOP */
|
||
end$while;
|
||
end emitdummies;
|
||
|
||
emitsinglebyte: proc(ch); /* fill local emitbuffer with a new byte */
|
||
dcl ch byte;
|
||
if noerror then$do
|
||
emitbyte(emitindex)=ch;
|
||
emitindex=emitindex+1;
|
||
end$if;
|
||
end emitsinglebyte;
|
||
|
||
emitsingleword: proc (var); /* fill 2 new bytes into emitbuffer */
|
||
dcl var addr, byt1 byte at(.var), byt2 byte at(.var+1);
|
||
call emitsinglebyte(byt1);
|
||
call emitsinglebyte(byt2);
|
||
end emitsingleword;
|
||
|
||
incrmacroptr: proc;
|
||
macroptr=macroptr+1;
|
||
end incrmacroptr;
|
||
|
||
getoperadr: proc address;
|
||
dcl pt address;
|
||
pt=.operands(bytevar);
|
||
call incrmacroptr;
|
||
return pt;
|
||
end getoperadr;
|
||
|
||
/* recognize codemacro command type */
|
||
commandtype: proc(comno,lg,pt) byte public;
|
||
dcl (comno,lg,i) byte,pt address,ch based pt(1) byte;
|
||
i=0ffh;
|
||
do while (i:=i+1) < lg;
|
||
if comno=ch(i) then$do call incrmacroptr; return i; end$if;
|
||
end$while;
|
||
return lg;
|
||
end commandtype;
|
||
$eject
|
||
|
||
/******* CODEMACRO COMMAND SUBROUTINES: ********/
|
||
|
||
|
||
mDBNrout: proc public;
|
||
call emitsinglebyte(bytevar);
|
||
call incrmacroptr;
|
||
end mDBNrout;
|
||
|
||
mDBFrout: proc public;
|
||
dcl pt address,opr based pt operandstruc;
|
||
pt=getoperadr;
|
||
call emitsinglebyte(opr.offset);
|
||
end mDBFrout;
|
||
|
||
mDWNrout: proc public;
|
||
call emitsingleword(addrvar);
|
||
call incrmacroptr;
|
||
call incrmacroptr;
|
||
end mDWNrout;
|
||
|
||
mDWFrout: proc public;
|
||
dcl pt address,opr based pt operandstruc;
|
||
pt=getoperadr;
|
||
call emitsingleword(opr.offset);
|
||
end mDWFrout;
|
||
|
||
mDDFrout: proc public;
|
||
dcl pt address,opr based pt operandstruc;
|
||
pt=getoperadr;
|
||
if (opr.sflag and segmbit) = 0 then call errmsg(misssegminfo);
|
||
call emitsingleword(opr.offset);
|
||
call emitsingleword(opr.segment);
|
||
end mDDFrout;
|
||
|
||
mRELBrout: proc public;
|
||
dcl pt address,opr based pt operandstruc,displ addr;
|
||
pt=getoperadr;
|
||
displ=opr.offset-cip-2;
|
||
if (opr.segment <> csegvalue) or (typecalc(displ)=wrd) then$do
|
||
call errmsg(laboutofrange);
|
||
end$if;
|
||
call emitsinglebyte(displ);
|
||
IF ABSADDR (0) = SPACE THEN$DO
|
||
CALL HEX2OUT (OPR.OFFSET, .ABSADDR);
|
||
END$IF;
|
||
end mRELBrout;
|
||
|
||
mRELWrout: proc public;
|
||
dcl pt address,opr based pt operandstruc;
|
||
pt=getoperadr;
|
||
if opr.segment <> csegvalue then call errmsg(laboutofrange);
|
||
call emitsingleword(opr.offset-cip-3);
|
||
IF ABSADDR (0) = SPACE THEN$DO
|
||
CALL HEX2OUT (OPR.OFFSET, .ABSADDR);
|
||
END$IF;
|
||
end mRELWrout;
|
||
|
||
mNOSEGFIXrout: proc public;
|
||
dcl (segr,flag,segt) byte,pt address,opr based pt operandstruc;
|
||
segr=bytevar;
|
||
call incrmacroptr;
|
||
pt=getoperadr;
|
||
if (opr.baseindex and nooverridebit) = 0 then$do
|
||
flag=opr.sflag;
|
||
segt=shr(flag,segtypecount) and 3;
|
||
noerror=(segt=segr);
|
||
end$if;
|
||
end mNOSEGFIXrout;
|
||
|
||
mSEGFIXrout: proc public;
|
||
dcl pt address,opr based pt operandstruc,(segr,override,sflag) byte;
|
||
DSovertest: proc byte;
|
||
segr=shr(opr.baseindex,baseregcount) and 1;
|
||
return (((sflag and bregbit) <> 0) and (segr=1)); /* 1 = BP */
|
||
end DSovertest;
|
||
|
||
pt=getoperadr;
|
||
sflag=opr.sflag;
|
||
if (opr.baseindex and nooverridebit) = 0 then$do
|
||
segr=shr(sflag,segtypecount) and 3;
|
||
do case segr;
|
||
do; override=true; segr=ESover; end; /* ES */
|
||
do; override=true; segr=CSover; end; /* CS */
|
||
do; override=not DSovertest; segr=SSover; end; /* SS */
|
||
do; override=DSovertest; segr=DSover; end; /* DS */
|
||
end$case;
|
||
if override then call emitsinglebyte(segr);
|
||
end$if;
|
||
end mSEGFIXrout;
|
||
|
||
MODRM: proc (regfield,pt);
|
||
dcl pt address,opr based pt operandstruc,
|
||
(regfield,modfield,rmfield,dispflag,stype,sflag,segr) byte,
|
||
BASEIND BYTE,
|
||
offset addr,
|
||
displow byte at(.offset),disphigh byte at (.offset+1);
|
||
|
||
disptype: proc byte;
|
||
if segr=rcs then return 2; /* disp always 2 for variable in CS */
|
||
if offset = 0 then return 0;
|
||
return typecalc(offset);
|
||
end disptype;
|
||
|
||
indextype: proc byte;
|
||
if (sflag and iregbit) <> 0 then$do
|
||
if (sflag and bregbit) <> 0 then return 0;
|
||
return 1;
|
||
end$if;
|
||
return 2;
|
||
end indextype;
|
||
|
||
offset=opr.offset; /* pick up operand attributes */
|
||
stype=opr.stype;
|
||
sflag=opr.sflag;
|
||
segr=shr(sflag,segtypecount) and 3;
|
||
BASEIND = OPR.BASEINDEX AND (BASEREGBIT OR INDEXREGBIT);
|
||
|
||
if stype=reg then$do
|
||
rmfield=offset;
|
||
modfield=11b;
|
||
dispflag=0;
|
||
else$do
|
||
if (sflag and (iregbit or bregbit)) = 0 then$do
|
||
rmfield=110b;
|
||
modfield=0;
|
||
dispflag=2;
|
||
else$do
|
||
dispflag=disptype; /* get no of DISP bytes */
|
||
modfield=dispflag;
|
||
do case indextype;
|
||
|
||
/* both base- and index-reg */
|
||
RMFIELD = BASEIND AND (INDEXREGBIT OR BASEREGBIT);
|
||
|
||
/* index reg only */
|
||
RMFIELD = 100B OR (BASEIND AND INDEXREGBIT);
|
||
|
||
do; /* base reg only */
|
||
IF (BASEIND AND BASEREGBIT) > 0 THEN$DO
|
||
rmfield=110b;
|
||
/* mod=00 and r/m=110B is a special case */
|
||
if dispflag=0 then$do
|
||
dispflag,modfield=1;
|
||
end$if;
|
||
else$do
|
||
rmfield=111b;
|
||
end$if;
|
||
end;
|
||
end$case;
|
||
end$if;
|
||
end$if;
|
||
regfield=shl(regfield,3) and 38h;
|
||
modfield=shl(modfield,6) and 0c0h;
|
||
call emitsinglebyte(regfield or modfield or rmfield);
|
||
if dispflag > 0 then$do
|
||
call emitsinglebyte(displow);
|
||
if dispflag=2 then call emitsinglebyte(disphigh);
|
||
end$if;
|
||
end MODRM;
|
||
|
||
mMODRM1rout: proc public;
|
||
dcl regfield byte;
|
||
regfield=bytevar;
|
||
call incrmacroptr;
|
||
call MODRM(regfield,getoperadr);
|
||
end mMODRM1rout;
|
||
|
||
mMODRM2rout: proc public;
|
||
dcl regfield byte,pt address,opr based pt operandstruc;
|
||
pt=getoperadr;
|
||
regfield=opr.offset;
|
||
call MODRM(regfield,getoperadr);
|
||
end mMODRM2rout;
|
||
|
||
mDBITrout: proc public;
|
||
dcl (result,crbit) byte,bittab(8) byte data(1,2,4,8,16,32,64,128);
|
||
|
||
join: proc(numb,nobit,noshift);
|
||
dcl (numb,nobit,noshift) byte;
|
||
if noshift > 0 then numb=shr(numb,noshift);
|
||
if nobit < 8 then numb=shl(numb,8-nobit);
|
||
do while (crbit <> 0ffh) and (nobit > 0);
|
||
if (numb and 80h) <> 0 then result=result or bittab(crbit);
|
||
crbit=crbit-1;
|
||
nobit=nobit-1;
|
||
numb=shl(numb,1);
|
||
end$while;
|
||
end join;
|
||
|
||
NUMBERBITSrout: proc;
|
||
dcl nobit byte;
|
||
nobit=bytevar;
|
||
call incrmacroptr;
|
||
call join(bytevar,nobit,0);
|
||
call incrmacroptr;
|
||
end NUMBERBITSrout;
|
||
|
||
FORMBITSrout: proc;
|
||
dcl (nobit,numb) byte,pt address,opr based pt operandstruc;
|
||
nobit=bytevar;
|
||
call incrmacroptr;
|
||
pt=getoperadr;
|
||
numb=opr.offset;
|
||
call join(numb,nobit,bytevar);
|
||
call incrmacroptr;
|
||
end FORMBITSrout;
|
||
|
||
result=0;
|
||
crbit=7; /* current bit position */
|
||
do while bytevar <> mendbit; /* do until ENDBIT command */
|
||
do case commandtype(bytevar,length(bitcomtab),.bitcomtab);
|
||
call NUMBERBITSrout;
|
||
call FORMBITSrout;
|
||
do; end;
|
||
end$case;
|
||
end$while;
|
||
call incrmacroptr; /* skip ENDBIT command */
|
||
call emitsinglebyte(result);
|
||
end mDBITrout;
|
||
|
||
$eject
|
||
|
||
/********* ROUTINES TO MATCH OPERANDS TO INSTRUCTION ********/
|
||
|
||
/* test user operand against codemacro parameter */
|
||
matchsingleop: proc(opno) byte;
|
||
dcl (match,specletter,modletter,range,rangetype) byte,
|
||
(rangev1,rangev2,opno) byte,
|
||
pt address, oper based pt operandstruc;
|
||
|
||
|
||
rangetest: proc byte; /* perform rangetest */
|
||
dcl opervalue byte;
|
||
rangev1=bytevar;
|
||
call incrmacroptr;
|
||
if range=doublerange then$do
|
||
rangev2=bytevar;
|
||
call incrmacroptr;
|
||
end$if;
|
||
opervalue=oper.offset;
|
||
if range=doublerange then$do
|
||
return ((opervalue>=rangev1) and (opervalue<=rangev2));
|
||
else$do
|
||
return (opervalue=rangev1);
|
||
end$if;
|
||
end rangetest;
|
||
|
||
modlettertest: proc byte;
|
||
dcl numb addr,(styp,modbyt) byte;
|
||
styp=oper.stype;
|
||
if styp=lab then return true;
|
||
modbyt=oper.sflag and typebit;
|
||
if styp = reg then return (modbyt=modletter);
|
||
if styp = variable then
|
||
return ((modbyt=nomod) or (modbyt=modletter));
|
||
if styp=number then$do
|
||
numb=oper.offset;
|
||
do case modletter-1;
|
||
return not wrdtest(numb); /* BYTE */
|
||
return wrdtest(numb); /* WORD */
|
||
return (typecalc(numb)=byt); /* signed BYTE */
|
||
return false; /* DWORD */
|
||
end$case;
|
||
end$if;
|
||
return false;
|
||
end modlettertest;
|
||
|
||
speclettertest: proc byte;
|
||
dcl (opertype,locvalue,loctype) byte;
|
||
memtest: proc byte;
|
||
return (opertype=variable);
|
||
end memtest;
|
||
|
||
opertype=oper.stype;
|
||
locvalue=oper.offset;
|
||
loctype=oper.sflag and typebit;
|
||
do case specletter;
|
||
/* A - accumulator (AX or AL) */
|
||
return ((opertype=reg) and (locvalue=rax));
|
||
/* C - code reference,i.e. label */
|
||
return (opertype=lab);
|
||
/* D - immediate data */
|
||
return (opertype=number);
|
||
/* E - effective address, i.e. memory address or register */
|
||
return (memtest or (opertype=reg));
|
||
/* M - memory address */
|
||
return memtest;
|
||
/* R - register except segment register */
|
||
return ((opertype=reg) and (loctype <> dwrd));
|
||
/* S - segment register */
|
||
return ((opertype=reg) and (loctype = dwrd));
|
||
/* X - memory address without indexing */
|
||
return ((opertype=variable) and
|
||
((oper.sflag and (iregbit or bregbit))=0));
|
||
end$case;
|
||
end speclettertest;
|
||
|
||
specletter=bytevar; /* pick up codemacro attributes */
|
||
call incrmacroptr;
|
||
modletter=bytevar and modletter$bit;
|
||
range=bytevar and range$and;
|
||
rangetype=bytevar and rangetype$and;
|
||
call incrmacroptr;
|
||
pt=.operands(opno); /* address of current user operand */
|
||
|
||
match=true;
|
||
if range <> norange then match=rangetest;
|
||
if modletter <> 0 then match=match and modlettertest;
|
||
if match then match=speclettertest;
|
||
return match;
|
||
end matchsingleop;
|
||
|
||
/* test if operands match a specific codemacro */
|
||
matchingops: proc byte;
|
||
dcl savept address,(nopara,match,parno) byte;
|
||
savept=macroptr;
|
||
call incrmacroptr; /* macroptr=macroptr+2 */
|
||
call incrmacroptr;
|
||
nopara=bytevar; /* pick up no of parameters */
|
||
call incrmacroptr; /* advance to first formal */
|
||
if (nopara and prefix$on) <> 0 then return true; /* PREFIX */
|
||
if nopara <> nooper then$do
|
||
match=false;
|
||
else$do
|
||
match=true;
|
||
parno=0ffh;
|
||
do while (parno:=parno+1) < nopara;
|
||
match=match and matchsingleop(parno);
|
||
end$while;
|
||
end$if;
|
||
if not match then macroptr=savept;
|
||
return match;
|
||
end matchingops;
|
||
|
||
/* test if operands match instruction */
|
||
searchformatch: proc byte public;
|
||
dcl next based macroptr address;
|
||
macroptr=firstmacroptr;
|
||
do forever;
|
||
if matchingops then return true;
|
||
if next=0 then return false;
|
||
macroptr=next;
|
||
end$forever;
|
||
end searchformatch;
|
||
|
||
end$module cmsubr;
|
||
|