mirror of
https://github.com/SEPPDROID/Digital-Research-Source-Code.git
synced 2025-10-23 00:14:25 +00:00
506 lines
9.8 KiB
C
506 lines
9.8 KiB
C
/*
|
|
Copyright 1981
|
|
Alcyon Corporation
|
|
8716 Production Ave.
|
|
San Diego, Ca. 92121
|
|
*/
|
|
|
|
/* Expression evaluator */
|
|
|
|
# include "as68.h"
|
|
|
|
/*precedence of operators*/
|
|
# define PAO 2 /*AND, OR*/
|
|
# define PPM 2 /*+ -*/
|
|
# define PMD 3 /** /*/
|
|
# define PLP 1 /* (*/
|
|
# define PRP 4 /* )*/
|
|
# define PEE 0 /* all other special chars*/
|
|
|
|
|
|
/*global integers for this package*/
|
|
struct it exitm; /*expression item*/
|
|
int prcnt; /*paren count*/
|
|
int rval; /*relocation value*/
|
|
int lpflg;
|
|
int lastopr; /*last token was operator when set*/
|
|
|
|
long gval(); /*get operand value*/
|
|
|
|
/*
|
|
* expression evaluator
|
|
* call with:
|
|
* address of function to get input
|
|
* returns:
|
|
* item type in itype
|
|
* item value in ival
|
|
* relocation flag in reloc:
|
|
* 0 => absolute
|
|
* 1 => data
|
|
* 2 => text
|
|
* 3 => bss
|
|
* 4 => external
|
|
*
|
|
* The only expressions involving externals which are legal are
|
|
* external+constant or external-constant
|
|
*/
|
|
|
|
struct it *piop, *pitr;
|
|
int iop, itr;
|
|
|
|
struct it opstk[OPSTLEN]; /*operator stack*/
|
|
struct it tree[TREELEN]; /*operand stack*/
|
|
|
|
expr(iploc)
|
|
int (*iploc)();
|
|
{
|
|
register int i, ipr;
|
|
|
|
extflg = starmul = iop = lpflg = 0;
|
|
piop = &opstk[0];
|
|
itr = -1; /*tree stack pointer*/
|
|
pitr = &tree[0];
|
|
pitr--;
|
|
/* form end of expression operator*/
|
|
opstk[0].itty = ITSP; /*special character*/
|
|
opstk[0].itop.wd2 = '?';
|
|
lastopr = 1;
|
|
|
|
/* get an input item*/
|
|
while(1) {
|
|
if(itr >= TREELEN-2) {
|
|
rpterr("expr tree overflow\n");
|
|
abort();
|
|
}
|
|
if(iop >= OPSTLEN-1) {
|
|
rpterr("expr opstk overflow\n");
|
|
abort();
|
|
}
|
|
(*iploc)(); /*get an input term*/
|
|
if (itype==ITPC) return;
|
|
starmul=0; /* * is location counter*/
|
|
|
|
/* special character*/
|
|
if(itype==ITSP) {
|
|
ipr = gprc(i=ival.wd2); /*get precedence of character*/
|
|
if(ipr==PEE) /*end of expression*/
|
|
break;
|
|
lastopr = 1;
|
|
if(ipr==PLP) { /*left paren*/
|
|
lpflg++;
|
|
prcnt++;
|
|
iop++; /*up stack pointer*/
|
|
piop++;
|
|
piop->swd1=exitm.swd1; /*put operator on stack*/
|
|
piop->itop=exitm.itop;
|
|
continue;
|
|
}
|
|
if(ipr==PRP) { /*right paren*/
|
|
if(lpflg) { exerr(1); return; }
|
|
starmul = 1; /* * is multiply*/
|
|
prcnt--; /*down one level*/
|
|
|
|
while (piop->itop != '(') { /* top stk is '(' */
|
|
itr++; /*up tree pointer*/
|
|
pitr++;
|
|
pitr->swd1 = piop->swd1; /*move operator*/
|
|
pitr->itop = piop->itop;
|
|
iop--; /*reduce operand stack*/
|
|
piop--;
|
|
}
|
|
iop--; /*remove stack*/
|
|
piop--;
|
|
continue;
|
|
}
|
|
|
|
while(ipr<=gprc(i=piop->itop.wd2)) { /* >= precedence */
|
|
itr++;
|
|
pitr++;
|
|
pitr->swd1 = piop->swd1; /*move operator*/
|
|
pitr->itop = piop->itop;
|
|
iop--; /*reduce operand stack*/
|
|
piop--;
|
|
}
|
|
iop++; /*up operator stack*/
|
|
piop++;
|
|
piop->swd1 = exitm.swd1; /*put in operator stack*/
|
|
piop->itop = exitm.itop;
|
|
continue;
|
|
}
|
|
|
|
/* symbol or constant*/
|
|
else {
|
|
lastopr = lpflg = 0; /*clear flag*/
|
|
itr++; /*up tree pointer*/
|
|
pitr++;
|
|
pitr->swd1 = exitm.swd1; /*put in tree*/
|
|
pitr->itop = exitm.itop;
|
|
starmul = 1; /* * is multiply*/
|
|
continue;
|
|
}
|
|
} /* end while(1)... */
|
|
|
|
/*output the rest of the operator stack to the tree*/
|
|
for(i=iop; i>=0; i--) {
|
|
itr++;
|
|
pitr++;
|
|
pitr->swd1 = piop->swd1; /*move operator*/
|
|
pitr->itop = piop->itop;
|
|
piop--;
|
|
}
|
|
|
|
collapse();
|
|
}
|
|
|
|
/* collapse the tree into one entry*/
|
|
collapse()
|
|
{
|
|
register int rv1, rv2, topr, i, bos;
|
|
register long tv1, tv2;
|
|
|
|
bos = 0;
|
|
exct1:
|
|
if(itr>=3) {
|
|
piop = &tree[bos];
|
|
iop = bos;
|
|
while (iop<=(itr-3+bos) && (piop->itty==ITSP ||
|
|
(piop+1)->itty==ITSP || (piop+2)->itty!=ITSP)) {
|
|
iop++;
|
|
piop++;
|
|
}
|
|
if (iop<=(itr-3+bos)) {
|
|
tv1 = gval(piop); /*get value of first operand*/
|
|
rv1 = rval; /*relocation value*/
|
|
tv2 = gval(piop+1);
|
|
rv2 = rval;
|
|
topr = (piop+2)->itop; /*operator*/
|
|
|
|
/* handle operators */
|
|
if (topr == '+') {
|
|
tv1=+ tv2;
|
|
rv1 = ckrl1(rv1,rv2); /*relocation*/
|
|
}
|
|
else if (topr == '-') {
|
|
tv1 =- tv2;
|
|
rv1 = ckrl2(rv1,rv2); /*relocation*/
|
|
}
|
|
else {
|
|
switch(topr) { /*operator*/
|
|
case '/': /* division */
|
|
tv1 =/ tv2; break;
|
|
case '*': /* multiplication */
|
|
tv1 =* tv2; break;
|
|
case '&': /* logical and */
|
|
tv1 =& tv2; break;
|
|
case '!': /* logical or */
|
|
tv1 =| tv2; break;
|
|
case '<': /* left shift */
|
|
tv1 =<< tv2.wd2; break;
|
|
case '>': /* right shift */
|
|
tv1 =>> tv2.wd2; break;
|
|
default: /*invalid operator*/
|
|
exerr(2); return;
|
|
}
|
|
rv1 = ckrl3(rv1,rv2); /* relocation */
|
|
}
|
|
|
|
/*put new value in tree*/
|
|
if (iop==bos) {
|
|
bos =+ 2;
|
|
iop = bos;
|
|
}
|
|
piop = &tree[iop];
|
|
piop->itty = ITCN; /*must be constant*/
|
|
piop->itop = tv1; /*value*/
|
|
piop->itrl = rv1; /*relocation value*/
|
|
|
|
if (iop != bos) { /* push up the rest of the tree... */
|
|
i = iop + 2 - bos;
|
|
pitr = piop+2;
|
|
for(; i<itr; i++) {
|
|
piop++;
|
|
pitr++;
|
|
piop->swd1 = pitr->swd1;
|
|
piop->itop = pitr->itop;
|
|
}
|
|
}
|
|
itr =- 2;
|
|
goto exct1;
|
|
}
|
|
}
|
|
|
|
/* check for unary minus and unary plus*/
|
|
if (tree[bos+1].itty!=ITSP && tree[bos].itop.wd2=='?')
|
|
{ exerr(3); return; }
|
|
if (tree[bos+1].itty!=ITSP || tree[bos].itty==ITSP) {
|
|
reloc = ABS;
|
|
ival = 0;
|
|
itype = ITCN;
|
|
return;
|
|
}
|
|
|
|
if(tree[bos+1].itop.wd2!='?') { /*end of statement*/
|
|
if(tree[bos+1].itop.wd2!='+') { /*ignore unary plus*/
|
|
if(tree[bos+1].itop.wd2!='-') { /* invalid operator */
|
|
exerr(4);
|
|
return;
|
|
}
|
|
tree[bos+1].itop = -gval(&tree[bos]);
|
|
tree[bos+1].itty = ITCN;
|
|
tree[bos+1].itrl = tree[bos].itrl;
|
|
bos++;
|
|
itr--;
|
|
goto exct1;
|
|
}
|
|
}
|
|
/* send results back to caller*/
|
|
if ((itype = tree[bos].itty)==ITCN)
|
|
ival = gval(&tree[bos]);
|
|
else {
|
|
ival = tree[bos].itop;
|
|
if(itype==ITSY && !(ival.ptrw2->flags&SYDF)) { /*undef symbol*/
|
|
reloc = ABS;
|
|
ival = 0;
|
|
itype = ITCN;
|
|
return;
|
|
}
|
|
}
|
|
get_val(tree[bos].itrl);
|
|
}
|
|
|
|
/*
|
|
*if defined symbol get value and say constant
|
|
* except for externals and equated registers
|
|
*/
|
|
get_val(reloc_val)
|
|
int reloc_val;
|
|
{
|
|
if(itype==ITSY && (ival.ptrw2->flags&(SYXR|SYER))==0) {
|
|
if(ival.ptrw2->flags&SYRA) /*get symbol relocation factor*/
|
|
reloc = DATA;
|
|
else if(ival.ptrw2->flags&SYRO)
|
|
reloc = TEXT;
|
|
else if(ival.ptrw2->flags&SYBS)
|
|
reloc = BSS;
|
|
else reloc = ABS;
|
|
ival = ival.ptrw2->vl1; /*symbol vaue*/
|
|
itype = ITCN; /*constant*/
|
|
}
|
|
else
|
|
if(itype == ITSY && ival.ptrw2->flags&SYXR) { /*external symbol*/
|
|
fixext(ival.ptrw2);
|
|
reloc = EXTRN;
|
|
}
|
|
else
|
|
reloc = reloc_val; /*relocation value of item*/
|
|
}
|
|
|
|
exerr(n) /* [vlh] */
|
|
int n;
|
|
{
|
|
uerr(6);
|
|
ival = 0;
|
|
itype = ITCN;
|
|
reloc = ABS;
|
|
}
|
|
|
|
/*
|
|
* get precedence of a operator
|
|
* call with
|
|
* operator
|
|
* returns
|
|
* precedence
|
|
*/
|
|
gprc(dprc)
|
|
{
|
|
|
|
switch(dprc) {
|
|
|
|
case '+':
|
|
case '-':
|
|
case '&': /* and*/
|
|
case '!': /* or*/
|
|
case '^': /*exclusive or*/
|
|
return(PPM);
|
|
|
|
case '/':
|
|
case '*':
|
|
case '<': /*left shift*/
|
|
case '>': /*right shift*/
|
|
return(PMD);
|
|
|
|
case '(':
|
|
if(lastopr)
|
|
return(PLP);
|
|
break;
|
|
|
|
case ')':
|
|
if(!prcnt) /*no left parens*/
|
|
break;
|
|
return(PRP);
|
|
|
|
}
|
|
return(PEE); /*end of expression*/
|
|
}
|
|
|
|
/*
|
|
* get value from an it format item
|
|
* call with
|
|
* address of it format item
|
|
* returns
|
|
* the value
|
|
* relocation value in rval
|
|
* calls uerr if it cant get a value
|
|
*/
|
|
long gval(avwrd)
|
|
struct it *avwrd;
|
|
{
|
|
register struct it *vwrd;
|
|
register struct symtab *p;
|
|
|
|
vwrd = avwrd;
|
|
if(vwrd->itty == ITCN) { /*constant*/
|
|
rval = vwrd->itrl;
|
|
return(vwrd->itop); /*value*/
|
|
}
|
|
if(vwrd->itty != ITSY) {
|
|
uerr(6);
|
|
rval = ABS;
|
|
return(0);
|
|
}
|
|
p = vwrd->itop.ptrw2;
|
|
if(p->flags&SYXR) { /*external reference*/
|
|
fixext(p);
|
|
return(0);
|
|
}
|
|
if((p->flags&SYDF) != SYDF || (p->flags&SYER)) {
|
|
uerr(6);
|
|
rval = ABS;
|
|
return(0);
|
|
}
|
|
rval = (p->flags&SYRA) ? DATA : (p->flags&SYRO) /* reloc of item */
|
|
? TEXT : (p->flags&SYBS) ? BSS : ABS;
|
|
return(p->vl1);
|
|
}
|
|
|
|
/*
|
|
* get items for expression evaluator (pass one)
|
|
* returns:
|
|
* item type in itype
|
|
* item value in ival
|
|
* item in it format in exitm
|
|
*/
|
|
p1gi()
|
|
{
|
|
if(fcflg) /*used item so must pass it*/
|
|
gterm(TRUE);
|
|
if(!fcflg && ckspc(fchr)==1) {
|
|
fcflg=1; /*just pass first character*/
|
|
itype=ITSP; /*special char*/
|
|
ival=fchr; /*value is the char*/
|
|
}
|
|
else { /*get a whole term*/
|
|
fcflg = 0;
|
|
gterm(TRUE); /*get a term*/
|
|
if(itype==ITSY) { /* got a symbol*/
|
|
ival.ptrw2=lemt(sirt,FALSE); /*look it up in main table*/
|
|
if(ival.ptrw2==lmte) /*not there before*/
|
|
mmte(); /*put it in table*/
|
|
}
|
|
else
|
|
if(itype == ITCN)
|
|
exitm.itrl = reloc;
|
|
}
|
|
exitm.itty = itype;
|
|
exitm.itop = ival;
|
|
}
|
|
|
|
/*
|
|
* get items for expression evaluator (pass 2)
|
|
* returns:
|
|
* item type in itype
|
|
* item value in ival
|
|
* item in it format in exitm
|
|
*/
|
|
p2gi()
|
|
{
|
|
if(pitw==pnite) { /*end of statement*/
|
|
itype = ITSP;
|
|
ival = ' '; /*blank*/
|
|
exitm.itty = itype;
|
|
exitm.itop = ival;
|
|
return;
|
|
}
|
|
|
|
if((itype = pitw->itty) == ITPC) { /*vlh*/
|
|
pitw->itop = loctr;
|
|
if (p2flg || format==6) itype = pitw->itty = ITCN;
|
|
}
|
|
ival = pitw->itop; /*value*/
|
|
exitm.swd1 = pitw->swd1;
|
|
exitm.itop = ival;
|
|
pitw++;
|
|
}
|
|
|
|
/*
|
|
*check for a special character
|
|
* call with
|
|
* character to check
|
|
* returns:
|
|
* 0 => character is number or letter
|
|
*/
|
|
ckspc(acksc)
|
|
{
|
|
register cksc;
|
|
|
|
cksc = acksc;
|
|
if (isalnum(cksc)) return(0);
|
|
return((index("_~*.@$%\'",cksc) != -1) ? 0 : 1); /*[vlh] compacted*/
|
|
}
|
|
|
|
/* generate new relocation for op + op*/
|
|
ckrl1(rv1,rv2)
|
|
{
|
|
if(rv1==rv2)
|
|
return(rv1);
|
|
if(rv1==ABS || rv2==ABS)
|
|
return(rv1+rv2); /*the one that is not ABS*/
|
|
uerr(27);
|
|
return(ABS);
|
|
}
|
|
|
|
/*generate new relocation for op - op*/
|
|
ckrl2(rv1,rv2)
|
|
{
|
|
if(rv2==EXTRN)
|
|
uerr(26);
|
|
if(rv1==rv2)
|
|
return(ABS);
|
|
if(rv2==ABS)
|
|
return(rv1+rv2);
|
|
uerr(27);
|
|
return(ABS);
|
|
}
|
|
|
|
/*generate new relocation for op /*&|<>^! op*/
|
|
ckrl3(rv1,rv2)
|
|
{
|
|
if(rv1!=ABS || rv2!=ABS)
|
|
uerr(27);
|
|
return(ABS);
|
|
}
|
|
|
|
fixext(p)
|
|
struct symtab *p;
|
|
{
|
|
if(extflg)
|
|
uerr(36); /*two externals in expr*/
|
|
extflg++;
|
|
extref = p->vl1.wd2; /*get external #*/
|
|
rval = EXTRN;
|
|
itype = ITCN;
|
|
ival = 0;
|
|
}
|
|
|
|
|