mirror of
https://github.com/SEPPDROID/Digital-Research-Source-Code.git
synced 2025-10-25 17:34:06 +00:00
290 lines
6.5 KiB
Plaintext
290 lines
6.5 KiB
Plaintext
$title ('PSEUDO INSTRUCTION MODULE-2')
|
|
pseudom:
|
|
do;
|
|
|
|
/*
|
|
|
|
modified 3/28/81 R. Silberstein
|
|
modified 4/1/81 R. Silberstein
|
|
modified 4/9/81 R. Silberstein
|
|
modified 4/15/81 R. Silberstein
|
|
modified 7/24/81 R. Silberstein
|
|
modified 9/2/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:ermod.lit)
|
|
$include (:f1:files.ext)
|
|
$include (:f1:subr1.ext)
|
|
$include (:f1:subr2.ext)
|
|
$include (:f1:scan.ext)
|
|
$include (:f1:print.ext)
|
|
$include (:f1:expr.ext)
|
|
$include (:f1:ermod.ext)
|
|
$include (:f1:pseud2.x86)
|
|
|
|
$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;
|
|
|
|
/* perform handling for PAGEWIDTH- and PAGESIZE-routine */
|
|
|
|
sizewidth: proc(p);
|
|
dcl oper operandstruc at (.operands(0)),p address,dest based p byte;
|
|
if pass=0 then$do
|
|
call skip$rest$of$line; /* do nothing in pass 0 */
|
|
else$do
|
|
if expression(.oper) then$do
|
|
if oper.stype = number then$do
|
|
dest=oper.offset;
|
|
call test$emptyline;
|
|
return;
|
|
end$if;
|
|
end$if;
|
|
call errmsg(pseudooperr);
|
|
call skip$rest$of$line;
|
|
end$if;
|
|
end sizewidth;
|
|
|
|
$eject
|
|
|
|
/***************** PSEUDO SUBROUTINES **************/
|
|
|
|
IFrout: proc public;
|
|
DECLARE IFNESTMAX LIT '5'; /* MAX LEVEL OF IF NEXTING */
|
|
dcl oper operandstruc at (.operands(0)),bool byte;
|
|
|
|
IFerr: proc;
|
|
call errmsg(ifparerr);
|
|
call skip$rest$of$line;
|
|
end IFerr;
|
|
|
|
skip$until$ENDIF: proc;
|
|
dcl pseudotype byte at (.token.value);
|
|
DECLARE LOCIFLEVEL BYTE;
|
|
DECLARE TEMP BYTE;
|
|
LOCIFLEVEL = IFLEVEL + 1;
|
|
IF PRINTON AND NOT IFLIST THEN$DO
|
|
CALL PRINTSOURCELINE;
|
|
PRINTON = FALSE;
|
|
TEMP = TRUE;
|
|
ELSE$DO
|
|
TEMP = FALSE;
|
|
END$IF;
|
|
do while not eofset; /* (forever) */
|
|
call scan;
|
|
IF TOKEN.TYPE = PSEUDO THEN$DO
|
|
IF PSEUDOTYPE = PENDIF THEN$DO
|
|
LOCIFLEVEL = LOCIFLEVEL - 1;
|
|
IF LOCIFLEVEL = 0 THEN$DO
|
|
CALL SCAN;
|
|
CALL TESTEMPTYLINE;
|
|
IF TEMP THEN PRINTON = TRUE;
|
|
RETURN;
|
|
END$IF;
|
|
ELSE$DO
|
|
IF PSEUDOTYPE = PIF THEN$DO
|
|
LOCIFLEVEL = LOCIFLEVEL + 1;
|
|
END$IF;
|
|
END$IF;
|
|
END$IF;
|
|
call skip$rest$of$line;
|
|
end$while;
|
|
end skip$until$ENDIF;
|
|
|
|
IF IFLEVEL = IFNESTMAX THEN$DO
|
|
call errmsg(nestediferr);
|
|
call skip$rest$of$line;
|
|
else$do
|
|
if not noforwardexpr(.oper) then$do
|
|
call IFerr;
|
|
else$do
|
|
if oper.stype <> number then$do
|
|
call IFerr;
|
|
else$do
|
|
bool=oper.offset;
|
|
if bool <> 0 then$do
|
|
IFLEVEL = IFLEVEL + 1;
|
|
call test$emptyline;
|
|
else$do
|
|
call skip$rest$of$line;
|
|
call skip$until$ENDIF;
|
|
end$if;
|
|
end$if;
|
|
end$if;
|
|
end$if;
|
|
end IFrout;
|
|
|
|
ENDIFrout: proc public;
|
|
IF IFLEVEL > 0 THEN$DO
|
|
IFLEVEL = IFLEVEL - 1;
|
|
call test$emptyline;
|
|
else$do
|
|
call errmsg(missiferr);
|
|
call skip$rest$of$line;
|
|
end$if;
|
|
end ENDIFrout;
|
|
|
|
INCLUDErout: proc public;
|
|
dcl (disk,i,errflag) byte,filname(11) byte,filtype(3) byte at (.filname (8));
|
|
|
|
syntaxerr: proc;
|
|
call errmsg(filesynterr);
|
|
errflag=true;
|
|
end syntaxerr;
|
|
|
|
accum$not$alpha: proc byte;
|
|
i=0ffh;
|
|
do while (i:=i+1) < acclen;
|
|
if not alphanumeric(accum(i)) then return true;
|
|
end$while;
|
|
return false;
|
|
end accum$not$alpha;
|
|
|
|
if include$on then$do
|
|
call errmsg(nestedincludeerr);
|
|
call skip$rest$of$line;
|
|
return;
|
|
end$if;
|
|
|
|
errflag=false;
|
|
disk=include$default; /* default disk is current one */
|
|
CALL FILL (SPACE, SIZE (FILNAME), .FILNAME);
|
|
|
|
if (acclen=1) and (nextch=':') and (letter(accum(0))) then$do
|
|
|
|
/* disk name found */
|
|
disk=accum(0)-'A';
|
|
call scan; /* skip : */
|
|
call scan; /* get filename */
|
|
end$if;
|
|
|
|
/* test syntax of filename */
|
|
if (acclen > 8) or accum$not$alpha then$do
|
|
call syntaxerr; /* illegal filename */
|
|
else$do
|
|
call copy(acclen,.accum(0),.filname); /* pick up filename */
|
|
call scan; /* skip filename */
|
|
|
|
/* test if filetype - if so, pick it up */
|
|
if specialtoken('.') then$do
|
|
call scan; /* skip . */
|
|
if (acclen > 3) or accum$not$alpha then$do
|
|
call syntaxerr;
|
|
else$do
|
|
call copy(acclen,.accum(0),.filtype(0));
|
|
call scan;
|
|
end$if;
|
|
ELSE$DO
|
|
CALL COPY (3, .('A86'), .FILTYPE); /* DEFAULT FILE TYPE */
|
|
end$if;
|
|
end$if;
|
|
|
|
if errflag then$do
|
|
call skip$rest$of$line;
|
|
else$do
|
|
/* try to open include file */
|
|
call i$file$setup(disk,.filname,.filtype);
|
|
CALL OPEN$INCLUDE;
|
|
call test$emptyline;
|
|
include$on=true;
|
|
end$if;
|
|
end INCLUDErout;
|
|
|
|
ENDrout: proc public;
|
|
call test$emptyline;
|
|
eofset=true;
|
|
end ENDrout;
|
|
|
|
PAGESIZErout: proc public;
|
|
call sizewidth(.pagesize);
|
|
end PAGESIZErout;
|
|
|
|
PAGEWIDTHrout: proc public;
|
|
call sizewidth(.maxcol);
|
|
end PAGEWIDTHrout;
|
|
|
|
TITLErout: proc public;
|
|
do case pass;
|
|
do; /* pass 0 */
|
|
if token.type=string then$do
|
|
call fill(0,length(title),.title(0));
|
|
if acclen > length(title) then acclen=length(title);
|
|
call copy(acclen,.accum(0),.title(0));
|
|
end$if;
|
|
call skip$rest$of$line;
|
|
end;
|
|
do; /* do nothing in pass 1 */
|
|
call skip$rest$of$line;
|
|
end;
|
|
do; /* pass 2 */
|
|
if token.type=string then$do
|
|
call scan;
|
|
call test$emptyline;
|
|
else$do
|
|
call errmsg(pseudooperr);
|
|
call skip$rest$of$line;
|
|
end$if;
|
|
end;
|
|
end$case;
|
|
end TITLErout;
|
|
|
|
EJECTrout: proc public;
|
|
if print$on then call printnewpage;
|
|
call test$emptyline;
|
|
end EJECTrout;
|
|
|
|
SIMFORMrout: proc public;
|
|
simform=true;
|
|
call test$emptyline;
|
|
end SIMFORMrout;
|
|
|
|
LISTrout: proc public;
|
|
call test$emptyline;
|
|
if printswitchoff then$do
|
|
printswitchoff=false;
|
|
print$on=true;
|
|
sourceptr=0;
|
|
end$if;
|
|
end LISTrout;
|
|
|
|
NOLISTrout: proc public;
|
|
if print$on then$do
|
|
call test$emptyline;
|
|
call printsourceline;
|
|
printswitchoff=true;
|
|
print$on=false;
|
|
else$do
|
|
call test$emptyline;
|
|
end$if;
|
|
end NOLISTrout;
|
|
|
|
IFLISTROUT: PROC PUBLIC;
|
|
CALL TESTEMPTYLINE;
|
|
IFLIST = TRUE;
|
|
END IFLISTROUT;
|
|
|
|
NOIFLISTROUT: PROC PUBLIC;
|
|
CALL TESTEMPTYLINE;
|
|
IFLIST = FALSE;
|
|
END NOIFLISTROUT;
|
|
|
|
end$module pseudom;
|