mirror of
https://github.com/SEPPDROID/Digital-Research-Source-Code.git
synced 2025-10-26 09:54:20 +00:00
355 lines
8.6 KiB
Plaintext
355 lines
8.6 KiB
Plaintext
$title ('PSEUDO INSTRUCTION MODULE-1')
|
|
pseudom:
|
|
do;
|
|
|
|
/*
|
|
|
|
modified 4/9/81 R. Silberstein
|
|
modified 4/15/81 R. Silberstein
|
|
modified 5/7/81 R. Silberstein
|
|
modified 7/24/81 R. Silberstein
|
|
modified 8/26/81 R. Silberstein
|
|
modified 8/19/81 R. Silberstein
|
|
|
|
*/
|
|
|
|
/*
|
|
This is the module to perform the decoding of
|
|
all legal pseudo instructions of the assembler.
|
|
There is one subroutine for each corresponding
|
|
pseudoinstruction.
|
|
*/
|
|
|
|
$include (:f1:macro.lit)
|
|
$include (:f1:struc.lit)
|
|
$include (:f1:equals.lit)
|
|
$include (:f1:pseud1.x86)
|
|
$include (:f1:outp.lit)
|
|
$include (:f1:subr2.ext)
|
|
$include (:f1:print.ext)
|
|
$include (:f1:scan.ext)
|
|
$include (:f1:symb.ext)
|
|
$include (:f1:expr.ext)
|
|
$include (:f1:ermod.ext)
|
|
$include (:f1:outp.ext)
|
|
$include (:f1:global.ext)
|
|
|
|
$eject
|
|
/*************** COMMON SUBROUTINES *************/
|
|
|
|
/* routine to test if rest of line is either a comment or empty -
|
|
if not, print error message - skip rest of line */
|
|
|
|
test$emptyline: proc;
|
|
if not emptyline then call errmsg(end$of$line$err);
|
|
call skip$rest$of$line;
|
|
end test$emptyline;
|
|
|
|
/* list current address in front of printline */
|
|
|
|
listcip: proc PUBLIC;
|
|
if (prefixptr=0) and (pass <> 0) then$do
|
|
call hex2out(cip,.prefix(1));
|
|
prefixptr=6;
|
|
end$if;
|
|
end list$cip;
|
|
|
|
/* common routine for ORG and RS (reserve storage pseudo) */
|
|
|
|
orgrs: proc (disp,typ);
|
|
dcl disp addr,typ byte,oper operandstruc at (.operands(0));
|
|
|
|
if noforwardexpr(.oper) then$do /* evaluate operand */
|
|
if oper.stype=number then$do
|
|
currentsymbol.length=oper.offset;
|
|
cip=disp+oper.offset*typ; /* compute new instruction pointer */
|
|
call test$emptyline;
|
|
return;
|
|
end$if;
|
|
end$if;
|
|
|
|
/* error in expression */
|
|
|
|
call errmsg(pseudooperr);
|
|
call skip$rest$of$line;
|
|
end orgrs;
|
|
|
|
|
|
/* perform handling for CSEG,DSEG,SSEG,ESEG routines */
|
|
|
|
segmentrout: proc (p1,p2,p3,segr);
|
|
dcl segr byte,(p1,p2,p3) address,
|
|
currentseg based p1 addr,
|
|
segspecified based p2 byte,
|
|
cipsave based p3 addr,
|
|
oper operandstruc at (.operands(0)),
|
|
low byte at (.csegvalue),high byte at (.csegvalue+1);
|
|
|
|
emit: proc;
|
|
dcl datatab(4) byte data (ESvalue,CSvalue,SSvalue,DSvalue);
|
|
call emitcodebyte(high,datatab(segr));
|
|
call emitcodebyte(low,datatab(segr));
|
|
call hex2out(csegvalue,.prefix(3)); /* print value on print line */
|
|
prefixptr=7;
|
|
end emit;
|
|
|
|
|
|
do case csegtype; /* save current segment attributes */
|
|
|
|
do; cureseg=csegvalue; espec=csegspec; escip=cip; end; /* ES */
|
|
do; curcseg=csegvalue; cspec=csegspec; cscip=cip; end; /* CS */
|
|
do; cursseg=csegvalue; sspec=csegspec; sscip=cip; end; /* SS */
|
|
do; curdseg=csegvalue; dspec=csegspec; dscip=cip; end; /* DS */
|
|
end$case;
|
|
|
|
if emptyline then$do /* allow no parameter */
|
|
call skip$rest$of$line;
|
|
csegvalue=0;
|
|
csegtype=segr;
|
|
csegspec=false; /* no segment value specified */
|
|
cip=0;
|
|
return;
|
|
end$if;
|
|
|
|
if specialtoken('$') then$do /* allow "$" */
|
|
csegtype=segr; /* pick up previous values */
|
|
csegspec=segspecified;
|
|
csegvalue=currentseg;
|
|
cip=cipsave;
|
|
if csegspec then call emit;
|
|
call scan; /* skip $ */
|
|
call test$emptyline;
|
|
return;
|
|
end$if;
|
|
|
|
if expression(.oper) then$do /* operand must be expression */
|
|
if oper.stype=number then$do
|
|
csegvalue=oper.offset; /* pick up segment value */
|
|
csegtype=segr;
|
|
csegspec=true; /* value is specified */
|
|
cip=0;
|
|
call emit;
|
|
call test$emptyline;
|
|
return;
|
|
end$if;
|
|
end$if;
|
|
|
|
/* must be illegal operand */
|
|
call skip$rest$of$line;
|
|
call errmsg(pseudooperr);
|
|
|
|
end segmentrout;
|
|
|
|
/* common routine for DB,DW and DD */
|
|
|
|
DB$DW$DD$common: proc(n);
|
|
dcl(n,continue) byte,lg addr;
|
|
DECLARE EP BYTE;
|
|
|
|
item: proc(n); /* find one element of element list */
|
|
dcl (n,i,errorprinted) byte,
|
|
oper operandstruc at (.operands(0)),
|
|
low byte at (.oper.offset),
|
|
high byte at (.oper.offset+1),
|
|
seglow byte at (.oper.segment),
|
|
seghigh byte at (.oper.segment+1);
|
|
emit: proc (outputbyte);
|
|
dcl outputbyte byte,
|
|
datatab(4) byte data (ESdata,CSdata,SSdata,DSdata);
|
|
call emitcodebyte(outputbyte,datatab(csegtype));
|
|
end emit;
|
|
|
|
locexpr: proc byte;
|
|
if expression(.oper) then$do
|
|
i=oper.stype;
|
|
if (i=number) or (i=variable) or (i=lab) then return true;
|
|
end$if;
|
|
return false;
|
|
end locexpr;
|
|
|
|
DBhandle: proc;
|
|
if (token.type=string) and (acclen > 1) then$do
|
|
lg=lg+acclen-1;
|
|
i=0ffh;
|
|
do while (i:=i+1) < acclen;
|
|
call emit(accum(i));
|
|
end$while;
|
|
oper.stype=number; /* dummy */
|
|
call scan; /* skip string */
|
|
else$do
|
|
if locexpr then$do
|
|
call emit(low);
|
|
else$do
|
|
call emit(0);
|
|
call errmsg(illexprelem);
|
|
end$if;
|
|
end$if;
|
|
end DBhandle;
|
|
|
|
DWhandle: proc;
|
|
if locexpr then$do
|
|
call emit(low);
|
|
call emit(high);
|
|
else$do
|
|
call emit(0);
|
|
call emit(0);
|
|
call errmsg(illexprelem);
|
|
end$if;
|
|
end DWhandle;
|
|
|
|
DDhandle: proc;
|
|
if locexpr then$do
|
|
if oper.stype <> number then$do
|
|
if (oper.sflag and segmbit) <> 0 then$do
|
|
call emit(low);
|
|
call emit(high);
|
|
call emit(seglow);
|
|
call emit(seghigh);
|
|
return;
|
|
else$do
|
|
call errmsg(misssegminfo);
|
|
end$if;
|
|
end$if;
|
|
end$if;
|
|
do i=0 to 3; call emit(0); end$do; /* dummy */
|
|
call errmsg(illexprelem);
|
|
end DDhandle;
|
|
|
|
/* ITEM main program */
|
|
lg=lg+1;
|
|
do case n;
|
|
call DBhandle;
|
|
call DWhandle;
|
|
call DDhandle;
|
|
end$case;
|
|
if specialtoken(',') then$do
|
|
call scan;
|
|
continue=true;
|
|
else$do
|
|
if emptyline then$do
|
|
call skip$rest$of$line;
|
|
else$do
|
|
CALL ERRMSG (ENDOFLINEERR);
|
|
CALL SKIPRESTOFLINE;
|
|
end$if;
|
|
end$if;
|
|
end item;
|
|
|
|
/* DB$DW$DD$common main program */
|
|
|
|
CALL LISTCIP;
|
|
EP = FALSE;
|
|
lg=0;
|
|
continue=true;
|
|
do while continue;
|
|
errorprinted=false;
|
|
continue=false;
|
|
call item(n);
|
|
EP = EP OR ERRORPRINTED;
|
|
end$while;
|
|
currentsymbol.length=lg;
|
|
ERRORPRINTED = EP; /* SO SOURCE LINE IS ECHOED IF ERROR */
|
|
end DB$DW$DD$common;
|
|
|
|
$eject
|
|
|
|
/***************** PSEUDO SUBROUTINES **************/
|
|
|
|
DBrout: proc public;
|
|
call DB$DW$DD$common(0);
|
|
end DBrout;
|
|
|
|
DWrout: proc public;
|
|
call DB$DW$DD$common(1);
|
|
end DWrout;
|
|
|
|
DDrout: proc public;
|
|
call DB$DW$DD$common(2);
|
|
end DDrout;
|
|
|
|
RSrout: proc (typ) public;
|
|
dcl typ byte;
|
|
call listcip; /* list current address on printline */
|
|
call orgrs(cip,typ); /* cip = cip + typ * expression */
|
|
end RSrout;
|
|
|
|
CSEGrout: proc public;
|
|
call segmentrout(.curcseg,.cspec,.cscip,rcs);
|
|
end CSEGrout;
|
|
|
|
DSEGrout: proc public;
|
|
call segmentrout(.curdseg,.dspec,.dscip,rds);
|
|
end DSEGrout;
|
|
|
|
SSEGrout: proc public;
|
|
call segmentrout(.cursseg,.sspec,.sscip,rss);
|
|
end SSEGrout;
|
|
|
|
ESEGrout: proc public;
|
|
call segmentrout(.cureseg,.espec,.escip,res);
|
|
end ESEGrout;
|
|
|
|
ORGrout: proc public;
|
|
call orgrs(0,byt); /* cip = 0 + expression */
|
|
end ORGrout;
|
|
|
|
EQUrout: proc public;
|
|
dcl oper operandstruc at (.operands(0)),
|
|
macdefpt based codemacroptr address;
|
|
codempossible: proc byte;
|
|
return (nextch=cr or nextch=';');
|
|
end codempossible;
|
|
|
|
do case pass;
|
|
|
|
do; /* pass 0 */
|
|
if codempossible and
|
|
findcodemacro(acclen,.accum(0),.codemacroptr) then$do
|
|
currentsymbol.stype=code;
|
|
call enterattributes(symbtabadr,.currentsymbol);
|
|
if not newmacro(acclensave,.accumsave,macdefpt) then
|
|
fullsymbtab=true;
|
|
else$do
|
|
nooper=0; /* find normal operand expression */
|
|
IF NOFORWARDOPER THEN$DO
|
|
call enterattributes(symbtabadr,.operands(0));
|
|
call skip$rest$of$line;
|
|
else$do
|
|
currentsymbol.stype=udefsymb;
|
|
call enterattributes(symbtabadr,.currentsymbol);
|
|
call skip$rest$of$line;
|
|
end$if;
|
|
end$if;
|
|
end;
|
|
|
|
do; /* pass 1 */
|
|
if currentsymbol.stype <> code then$do /* update symbol value */
|
|
nooper=0;
|
|
IF NOFORWARDOPER THEN$DO
|
|
call enterattributes(symbtabadr,.operands(0));
|
|
end$if;
|
|
end$if;
|
|
call skip$rest$of$line;
|
|
end;
|
|
|
|
do; /* pass 2 - scan to produce possible errormessages */
|
|
if currentsymbol.stype=code then$do
|
|
call scan;
|
|
else$do
|
|
nooper=0;
|
|
IF NOT NOFORWARDOPER OR (CURRENTSYMBOL.STYPE = ERROR) THEN$DO
|
|
call errmsg(pseudooperr);
|
|
call skip$rest$of$line; /* only one error message */
|
|
else$do
|
|
prefixptr=7;
|
|
call hex2out(oper.offset,.prefix(3));
|
|
end$if;
|
|
end$if;
|
|
call test$emptyline;
|
|
end;
|
|
|
|
end$case;
|
|
end EQUrout;
|
|
|
|
end$module pseudom;
|