mirror of
https://github.com/SEPPDROID/Digital-Research-Source-Code.git
synced 2025-10-24 17:04:19 +00:00
Upload
Digital Research
This commit is contained in:
546
CPM OPERATING SYSTEMS/CPM 68K/1.0X SOURCES/v102a/c168/smatch.c.1
Normal file
546
CPM OPERATING SYSTEMS/CPM 68K/1.0X SOURCES/v102a/c168/smatch.c.1
Normal file
@@ -0,0 +1,546 @@
|
||||
/*
|
||||
Copyright 1982
|
||||
Alcyon Corporation
|
||||
8716 Production Ave.
|
||||
San Diego, Ca. 92121
|
||||
|
||||
@(#)smatch.c 1.9 11/22/83
|
||||
*/
|
||||
|
||||
/* Code Skeleton expansion and matching */
|
||||
|
||||
#include "cgen.h"
|
||||
#include "cskel.h"
|
||||
#define SK_TYPE(x) (x&017)
|
||||
|
||||
/* expand - code skeleton expansion*/
|
||||
/* Handles the expansion of code skeleton macros.*/
|
||||
expand(tp,cookie,freg,skp) /* returns register result is in*/
|
||||
struct tnode *tp; /* pointer to expression tree*/
|
||||
int cookie; /* goal of expression tree*/
|
||||
int freg; /* register to leave results in*/
|
||||
struct skeleton *skp; /* pointer to code skeleton*/
|
||||
{
|
||||
register short op, nreg, reg;
|
||||
register short c;
|
||||
register short extf, i2f;
|
||||
register struct tnode *ltp, *rtp;
|
||||
register char *p;
|
||||
register short i, sreg, flag, subtrees, scookie;
|
||||
register char *macro;
|
||||
|
||||
/**
|
||||
* This is a kludge because not all of the arithmetic operators
|
||||
* will work on address registers - the 68000 clone strikes again
|
||||
**/
|
||||
op = tp->t_op;
|
||||
#ifdef DEBUG
|
||||
if(eflag) printf("expand op=%d left=%x right=%x skp=%lo\n",op,
|
||||
skp->sk_left,skp->sk_right,skp);
|
||||
#endif
|
||||
if(((op>=MULT && op<=COMPL) || (op>=LMULT && op<=LMOD)) || tp->t_type==CHAR)
|
||||
freg = DREG(freg); /* [vlh] 4.1 added UMINUS, COMPL, LMUL, LDIV */
|
||||
macro = skp->sk_def;
|
||||
i2f = extf = 0;
|
||||
rtp = ltp = tp->t_left;
|
||||
subtrees = 1;
|
||||
if( BINOP(op) ) {
|
||||
subtrees++;
|
||||
rtp = tp->t_right;
|
||||
if( (LONGORPTR(tp->t_type)) && (op == DIV || op == MOD ||
|
||||
(op != MULT && (ISDREG(freg)) &&
|
||||
!(LONGORPTR(ltp->t_type)) && !(LONGORPTR(rtp->t_type)))) )
|
||||
extf++;
|
||||
switch( op ) {
|
||||
|
||||
case RSH:
|
||||
case LSH:
|
||||
case EQLSH:
|
||||
case EQRSH:
|
||||
if( UNSIGN(ltp->t_type) )
|
||||
i2f++;
|
||||
break;
|
||||
|
||||
case MULT:
|
||||
case EQMULT:
|
||||
case DIV:
|
||||
case MOD:
|
||||
case EQDIV:
|
||||
case EQMOD:
|
||||
if( UNSIGN(ltp->t_type) || UNSIGN(rtp->t_type) )
|
||||
i2f++;
|
||||
break;
|
||||
}
|
||||
}
|
||||
nreg = freg + 1;
|
||||
while( c = *macro++ ) {
|
||||
c &= 0xff;
|
||||
switch( c ) {
|
||||
|
||||
default:
|
||||
putchar(c);
|
||||
break;
|
||||
|
||||
case POP:
|
||||
stacksize--;
|
||||
printf("(sp)+");
|
||||
break;
|
||||
|
||||
case POP4:
|
||||
stacksize--;
|
||||
popstack(4);
|
||||
break;
|
||||
|
||||
case POP8:
|
||||
stacksize -= 2;
|
||||
popstack(8);
|
||||
break;
|
||||
|
||||
case PSH:
|
||||
if( cookie == FORSP ) /*don't affect sp*/
|
||||
printf("(sp)");
|
||||
else
|
||||
printf("-(sp)");
|
||||
stacksize++;
|
||||
break;
|
||||
|
||||
case MOV:
|
||||
case MOVL:
|
||||
case JSR:
|
||||
case CLR:
|
||||
case CLRL:
|
||||
case EXTW:
|
||||
case EXTL:
|
||||
case LEA:
|
||||
case STK:
|
||||
printf("%s",strtab[c-128]);
|
||||
break;
|
||||
|
||||
case OPCALL:
|
||||
op_expand(op,tp->t_type,ltp->t_type);
|
||||
break;
|
||||
|
||||
case TLEFT:
|
||||
outtype( LEAFOP(op) ? tp->t_type : ltp->t_type );
|
||||
break;
|
||||
|
||||
case TLEFTL:
|
||||
outatype( LEAFOP(op) ? tp->t_type : ltp->t_type );
|
||||
break;
|
||||
|
||||
case TEITHER:
|
||||
if( LONGORPTR(rtp->t_type) || LONGORPTR(ltp->t_type) )
|
||||
outtype(LONG);
|
||||
break;
|
||||
|
||||
case TRIGHT:
|
||||
outtype(rtp->t_type);
|
||||
break;
|
||||
|
||||
case OP:
|
||||
case AOP:
|
||||
if( c == AOP || i2f )
|
||||
i = optab[op][1];
|
||||
else
|
||||
i = optab[op][0];
|
||||
printf(mnemonics[i]);
|
||||
break;
|
||||
|
||||
case LADDR:
|
||||
case RADDR:
|
||||
p = ((c==RADDR) ? rtp : ltp);
|
||||
if( *macro == '+' ) {
|
||||
macro++;
|
||||
outaexpr(p,A_DOPOST|A_DOIMMED);
|
||||
}
|
||||
else if( *macro == '-' ) {
|
||||
macro++;
|
||||
outaexpr(p,A_DOPRE|A_DOIMMED);
|
||||
}
|
||||
else
|
||||
outaexpr(p,A_DOIMMED|A_DOPRE|A_DOPOST);
|
||||
break;
|
||||
|
||||
case CR:
|
||||
outcreg(freg);
|
||||
break;
|
||||
|
||||
case NR:
|
||||
outcreg(nreg);
|
||||
break;
|
||||
|
||||
case CAR:
|
||||
outcreg(AREG(freg));
|
||||
break;
|
||||
|
||||
case NAR:
|
||||
outcreg(AREG(nreg));
|
||||
break;
|
||||
|
||||
case EXL:
|
||||
outextend(ltp,LONG,freg);
|
||||
break;
|
||||
|
||||
case EXRL:
|
||||
case EXRLN:
|
||||
outextend(rtp,ltp->t_type,c==EXRL?freg:nreg);
|
||||
break;
|
||||
|
||||
case EXLR:
|
||||
case EXLRN:
|
||||
outextend(ltp,rtp->t_type,c==EXLR?freg:nreg);
|
||||
break;
|
||||
|
||||
case LEFT:
|
||||
case RIGHT:
|
||||
subtrees--;
|
||||
case TREE:
|
||||
p = (c==LEFT?ltp:c==RIGHT?rtp:tp);
|
||||
flag = *macro++;
|
||||
scookie = FORREG;
|
||||
if( flag & S_STACK ) {
|
||||
if( cookie == FORSP )
|
||||
scookie = FORSP;
|
||||
else
|
||||
scookie = FORSTACK;
|
||||
}
|
||||
else if( flag & S_FORCC )
|
||||
scookie = FORCC;
|
||||
if( flag & S_NEXT )
|
||||
reg = nreg;
|
||||
else
|
||||
reg = freg;
|
||||
if( flag & S_INDR ) {
|
||||
if( p->t_op != INDR )
|
||||
error("code skeleton error: %d\n",op);
|
||||
p = p->t_left; /*skip INDR*/
|
||||
if( coffset(p) ) {
|
||||
p = p->t_left;
|
||||
if( LONGORPTR(p->t_type) == 0 && (flag&S_STACK) != 0 )
|
||||
p = tnalloc(INT2L,LONG,0,0,p);
|
||||
}
|
||||
reg = AREG(reg); /*no qualifications before...*/
|
||||
#ifdef DEBUG
|
||||
if (eflag)
|
||||
printf("reg = %d, nreg = %d, freg = %d\n",reg,nreg,freg);
|
||||
#endif
|
||||
}
|
||||
sreg = codegen(p,scookie,reg); /*code for subtree*/
|
||||
if( scookie == FORREG ) {
|
||||
if( flag & S_INDR ) {
|
||||
if( ISDREG(sreg) )
|
||||
outmovr(sreg,AREG(reg),p);
|
||||
}
|
||||
else if( flag & S_NEXT )
|
||||
nreg = sreg;
|
||||
else if( sreg != reg ) {
|
||||
/*
|
||||
* result was not in expected register, if remaining sub-tree can be
|
||||
* compiled using the remaining registers, update current and next
|
||||
* registers, saving us the trouble of moving the register.
|
||||
*/
|
||||
if( c == TREE || ((ISDREG(sreg)) && subtrees > 0 &&
|
||||
((c == LEFT &&
|
||||
sucomp(rtp,sreg,0) <= skp->sk_right &&
|
||||
sucomp(rtp,sreg,1) <= SU_ANY) ||
|
||||
( c == RIGHT &&
|
||||
sucomp(ltp,sreg,0) <= skp->sk_left &&
|
||||
sucomp(ltp,sreg,1) <= SU_ANY))) ) {
|
||||
freg = DREG(sreg);
|
||||
nreg = freg + 1;
|
||||
}
|
||||
else
|
||||
outmovr(sreg,DREG(freg),p);
|
||||
}
|
||||
}
|
||||
break;
|
||||
|
||||
case LOFFSET:
|
||||
case ROFFSET:
|
||||
p = (c==LOFFSET) ? ltp->t_left : rtp->t_left;
|
||||
if((p=coffset(p)) != 0 && (p->t_op != CINT || p->t_value != 0))
|
||||
outaexpr(p,A_NOIMMED);
|
||||
break;
|
||||
|
||||
case MODSWAP:
|
||||
switch( op ) {
|
||||
|
||||
case LMOD:
|
||||
case LEQMOD:
|
||||
extf++;
|
||||
case MOD:
|
||||
case EQMOD:
|
||||
OUTSWAP(freg);
|
||||
}
|
||||
break;
|
||||
|
||||
}
|
||||
}
|
||||
if( extf && cookie == FORREG && (ISDREG(freg)) ) {
|
||||
if( UNSIGN(ltp->t_type) || UNSIGN(rtp->t_type) )
|
||||
OUTUEXT(freg);
|
||||
else
|
||||
OUTEXT(freg);
|
||||
}
|
||||
#ifdef DEBUG
|
||||
if(eflag) printf("ending expand skp=%lo\n",skp);
|
||||
#endif
|
||||
return(freg);
|
||||
}
|
||||
|
||||
/* op_expand - printf out the subroutine being called */
|
||||
op_expand(op,type,ltype)
|
||||
int op, type,ltype;
|
||||
{
|
||||
if( ISFLOAT(type) || ISFLOAT(ltype) ) {
|
||||
switch( op ) {
|
||||
|
||||
case ADD:
|
||||
case EQADD:
|
||||
case PREINC: /* [vlh] 4.2 */
|
||||
case POSTINC: /* [vlh] 4.2 */
|
||||
printf("_fpadd");
|
||||
break;
|
||||
|
||||
case SUB:
|
||||
case EQSUB:
|
||||
case PREDEC: /* [vlh] 4.2 */
|
||||
case POSTDEC: /* [vlh] 4.2 */
|
||||
printf("_fpsub");
|
||||
break;
|
||||
|
||||
case MULT:
|
||||
case EQMULT:
|
||||
printf("_fpmult");
|
||||
break;
|
||||
|
||||
case DIV:
|
||||
case EQDIV:
|
||||
printf("_fpdiv");
|
||||
break;
|
||||
|
||||
case UMINUS:
|
||||
case EQNEG:
|
||||
printf("_fpneg");
|
||||
break;
|
||||
|
||||
case FLOAT2L:
|
||||
case FLOAT2I:
|
||||
printf("_fpftol");
|
||||
break;
|
||||
|
||||
case LONG2F:
|
||||
case INT2F:
|
||||
printf("_fpltof");
|
||||
break;
|
||||
|
||||
case EQUALS:
|
||||
case NEQUALS:
|
||||
case GREAT:
|
||||
case GREATEQ:
|
||||
case LESS:
|
||||
case LESSEQ:
|
||||
printf("_fpcmp");
|
||||
break;
|
||||
|
||||
default:
|
||||
error("invalid floating point op %d\n",op);
|
||||
break;
|
||||
}
|
||||
}
|
||||
else {
|
||||
switch( op ) {
|
||||
|
||||
case MULT:
|
||||
case LMULT:
|
||||
printf("lmul");
|
||||
break;
|
||||
|
||||
case DIV:
|
||||
case LDIV:
|
||||
printf("ldiv");
|
||||
break;
|
||||
|
||||
case MOD:
|
||||
case LMOD:
|
||||
printf("lrem");
|
||||
break;
|
||||
|
||||
default:
|
||||
error("opcall bad op %d",op);
|
||||
break;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
/**
|
||||
* match - try to match expression tree with code skeleton
|
||||
* Given the expression tree, tries to match the given tree with
|
||||
* the appropriate code skeleton. The code skeleton list is
|
||||
* gotten from the root operator and the cookie value. The code
|
||||
* skeleton list is then searched, checking the Sethy-Ullman numbers
|
||||
* of the sub-trees against the Sethy-Ullman numbers in the code
|
||||
* skeleton list. If the Sethy-Ullman numbers are OK, then the
|
||||
* left and right sub-trees are checked for compatability, e.g.
|
||||
* integer pointers, etc. If a match is found, the code skeleton
|
||||
* list pointer is returned.
|
||||
**/
|
||||
char * /* returns ptr to code skeleton*/
|
||||
match(tp,cookie,reg) /* or 0 if no skeleton*/
|
||||
struct tnode *tp; /* pointer to tree*/
|
||||
int cookie; /* goal for code expansion*/
|
||||
int reg; /* register to use*/
|
||||
{
|
||||
register struct skeleton *skp;
|
||||
register short op, bop;
|
||||
short i;
|
||||
register struct tnode *ltp, *rtp;
|
||||
|
||||
#ifdef DEBUG
|
||||
if(mflag) printf("match op=%d cookie=%d reg=%d\n",tp->t_op,cookie,reg);
|
||||
#endif
|
||||
PUTEXPR(mflag,"match",tp);
|
||||
if( (op=tp->t_op) >= LCGENOP )
|
||||
return(0);
|
||||
if( LEAFOP(op) )
|
||||
ltp = tp;
|
||||
else
|
||||
ltp = tp->t_left;
|
||||
if ( bop=BINOP(op) ) {
|
||||
rtp = tp->t_right;
|
||||
if( CONVOP(ltp->t_op) ) {
|
||||
if(op!=LSH && NOTCONVOP(rtp->t_op)
|
||||
&& cookie != FORSTACK && cookie!=FORSP && cookie!=FORCREG) {
|
||||
if( !(UNSIGN(ltp->t_left->t_type)) || op == ASSIGN ) {
|
||||
tp->t_left = ltp->t_left;
|
||||
if( (skp=match(tp,cookie,reg)) != 0 )
|
||||
return(skp);
|
||||
tp->t_left = ltp;
|
||||
}
|
||||
}
|
||||
}
|
||||
else if( CONVOP(rtp->t_op) ) {
|
||||
if( !(UNSIGN(rtp->t_left->t_type)) || op == ASSIGN ) {
|
||||
tp->t_right = rtp->t_left;
|
||||
if( (skp=match(tp,cookie,reg)) != 0 )
|
||||
return(skp);
|
||||
tp->t_right = rtp;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
switch( cookie ) {
|
||||
case FORCC:
|
||||
i = 3;
|
||||
break;
|
||||
|
||||
case FOREFF:
|
||||
i = 2;
|
||||
break;
|
||||
|
||||
case FORSTACK:
|
||||
case FORSP:
|
||||
i = 4;
|
||||
break;
|
||||
|
||||
case FORREG:
|
||||
i = 5;
|
||||
break;
|
||||
|
||||
default:
|
||||
error("match cookie=%d\n",cookie);
|
||||
return(0);
|
||||
}
|
||||
#ifdef DEBUG
|
||||
if(mflag) printf("match op=%d i=%d ",op,i);
|
||||
#endif
|
||||
if( !(i=optab[op][i]) )
|
||||
return(0);
|
||||
skp = codeskels[i];
|
||||
#ifdef DEBUG
|
||||
if(mflag) printf("codeskels[%d]=%o\n",i,skp);
|
||||
#endif
|
||||
#ifdef DEBUG
|
||||
if(mflag) {
|
||||
printf("match LEFT ");
|
||||
puttsu(ltp);
|
||||
if(bop) {
|
||||
printf(" RIGHT ");
|
||||
puttsu(rtp);
|
||||
}
|
||||
putchar('\n');
|
||||
}
|
||||
#endif
|
||||
for( ; skp->sk_left != 0; skp++ ) {
|
||||
#ifdef DEBUG
|
||||
if( mflag > 1 )
|
||||
printf("sk_left=%x sk_right=%x\n",skp->sk_left,skp->sk_right);
|
||||
#endif
|
||||
if( !(skelmatch(ltp,skp->sk_left)) )
|
||||
continue;
|
||||
if( bop && !(skelmatch(rtp,skp->sk_right)) )
|
||||
continue;
|
||||
#ifdef DEBUG
|
||||
if( mflag )
|
||||
printf("match found skp=%o left=%x right=%x\n",skp,
|
||||
skp->sk_left,skp->sk_right);
|
||||
#endif
|
||||
return(skp);
|
||||
}
|
||||
return(0);
|
||||
}
|
||||
|
||||
/* skelmatch - sub-tree type matching for match*/
|
||||
/* This checks a subtree for type compatability in match.*/
|
||||
skelmatch(tp,skinfo) /* returns 1 if matched, else 0*/
|
||||
struct tnode *tp; /* pointer to expression tree*/
|
||||
int skinfo;
|
||||
{
|
||||
register short type, unsignf, const, stype;
|
||||
|
||||
if( tp->t_su > skinfo || ((skinfo&T_INDR) && tp->t_op != INDR) )
|
||||
return(0);
|
||||
stype = SK_TYPE(skinfo);
|
||||
type = tp->t_type;
|
||||
if( ISFUNCTION(type) )
|
||||
type = BTYPE(type);
|
||||
if( unsignf = UNSIGN(type) )
|
||||
type = BASETYPE(type);
|
||||
const = 0;
|
||||
switch( tp->t_op ) {
|
||||
|
||||
case CFLOAT: /* [vlh] 3.4 */
|
||||
case CLONG:
|
||||
if( tp->t_su > SU_CONST )
|
||||
break;
|
||||
case CINT:
|
||||
const++;
|
||||
break;
|
||||
}
|
||||
switch( stype ) {
|
||||
|
||||
case T_CHAR:
|
||||
return( type == CHAR );
|
||||
|
||||
case T_ANY: /*either short or char*/
|
||||
if( type == CHAR )
|
||||
return(1);
|
||||
case T_INT:
|
||||
return( type == INT || const );
|
||||
|
||||
case T_UNSN:
|
||||
case T_UANY: /* [vlh] 4.2 */
|
||||
case T_UCHAR: /* [vlh] 4.2 */
|
||||
case T_ULONG: /* [vlh] 4.2 */
|
||||
return( unsignf );
|
||||
|
||||
case T_LONG:
|
||||
return( LONGORPTR(type) );
|
||||
|
||||
case T_FLOAT:
|
||||
return( ISFLOAT(type) );
|
||||
|
||||
default:
|
||||
error("skelmatch type: %x",stype);
|
||||
return(0);
|
||||
}
|
||||
Reference in New Issue
Block a user