V7addenda/f77/11r/pdp11.c
#include "defs"
#if FAMILY == DMR
# include "dmrdefs"
#endif
#if FAMILY==PCC
# include "pccdefs"
#endif
/*
PDP 11-SPECIFIC ROUTINES
*/
int maxregvar = 0;
int regnum[] = { 3, 2 };
ftnint intcon[14] =
{ 2, 2, 2, 2,
15, 31, 24, 56,
-128, -128, 127, 127,
32767, 2147483647 };
#if HERE == PDP11
/* then put in constants in octal */
long realcon[6][2] =
{
{ 040000000, 0 },
{ 040000000, 0 },
{ 017777777777, 0 },
{ 017777777777, 037777777777 },
{ 06440000000, 0 },
{ 04440000000, 0 }
};
#else
double realcon[6] =
{
2.9387358771e-39,
2.938735877055718800e-39
1.7014117332e+38,
1.701411834604692250e+38
5.960464e-8,
1.38777878078144567e-17,
};
#endif
prsave()
{
}
goret(type)
int type;
{
#if FAMILY == DMR
p2op(P2RETURN);
#endif
#if FAMILY==PCC
p2pass("\tjmp\tcret");
#endif
}
/*
* move argument slot arg1 (relative to ap)
* to slot arg2 (relative to ARGREG)
*/
mvarg(type, arg1, arg2)
int type, arg1, arg2;
{
mvarg1(arg1+4, arg2);
if(type == TYLONG)
mvarg1(arg1+6, arg2+2);
}
mvarg1(m, n)
int m, n;
{
#if FAMILY == DMR
p2reg(ARGREG, P2SHORT|P2PTR);
p2op2(P2ICON, P2SHORT);
p2i(n);
p2op2(P2PLUS, P2SHORT|P2PTR);
p2op2(P2INDIRECT, P2SHORT);
p2reg(AUTOREG, P2SHORT|P2PTR);
p2op2(P2ICON, P2SHORT);
p2i(m);
p2op2(P2PLUS, P2SHORT|P2PTR);
p2op2(P2INDIRECT, P2SHORT);
p2op2(P2ASSIGN, P2SHORT);
putstmt();
#endif
#if FAMILY == PCC
p2pij("\tmov\t%d.(r5),%d.(r4)", m, n);
#endif
}
prlabel(fp, k)
FILEP fp;
int k;
{
fprintf(fp, "L%d:\n", k);
}
prconi(fp, type, n)
FILEP fp;
int type;
ftnint n;
{
register int *np;
np = &n;
if(type == TYLONG)
fprintf(fp, "\t%d.;%d.\n", np[0], np[1]);
else
fprintf(fp, "\t%d.\n", np[1]);
}
prcona(fp, a)
FILEP fp;
ftnint a;
{
fprintf(fp, "\tL%ld\n", a);
}
#if HERE!=PDP11
BAD NEWS
#endif
#if HERE==PDP11
prconr(fp, type, x)
FILEP fp;
int type;
double x;
{
register int k, *n;
n = &x; /* nonportable cheat */
k = (type==TYREAL ? 2 : 4);
fprintf(fp, "\t");
while(--k >= 0)
fprintf(fp, "%d.%c", *n++, (k==0 ? '\n' : ';') );
}
#endif
praddr(fp, stg, varno, offset)
FILE *fp;
int stg, varno;
ftnint offset;
{
char *memname();
if(stg == STGNULL)
fprintf(fp, "\t0\n");
else
{
fprintf(fp, "\t%s", memname(stg,varno));
if(offset)
fprintf(fp, "+%ld.", offset);
fprintf(fp, "\n");
}
}
preven(k)
int k;
{
if(k > 1)
fprintf(asmfile, "\t.even\n", k);
}
#if FAMILY == PCC
prcmgoto(p, nlab, skiplabel, labarray)
expptr p;
int nlab, skiplabel, labarray;
{
int regno;
putforce(p->vtype, p);
if(p->vtype == TYLONG)
{
regno = 1;
p2pass("\ttst\tr0");
p2pi("\tbne\tL%d", skiplabel);
}
else
regno = 0;
p2pij("\tcmp\tr%d,$%d.", regno, nlab);
p2pi("\tbhi\tL%d", skiplabel);
p2pi("\tasl\tr%d", regno);
p2pij("\tjmp\t*L%d(r%d)", labarray, regno);
}
prarif(p, neg,zer,pos)
expptr p;
int neg, zer, pos;
{
register int ptype;
putforce( ptype = p->vtype, p);
if( ISINT(ptype) )
{
p2pass("\ttst\tr0");
p2pi("\tjlt\tL%d", neg);
p2pi("\tjgt\tL%d", pos);
if(ptype != TYSHORT)
{
p2pass("\ttst\tr1");
p2pi("\tjeq\tL%d", zer);
}
p2pi("\tjbr\tL%d", pos);
}
else
{
p2pass("\ttstf\tr0");
p2pass("\tcfcc");
p2pi("\tjeq\tL%d", zer);
p2pi("\tjlt\tL%d", neg);
p2pi("\tjmp\tL%d", pos);
}
}
#endif
char *memname(stg, mem)
int stg, mem;
{
static char s[20];
switch(stg)
{
case STGCOMMON:
case STGEXT:
sprintf(s, "_%s", varstr(XL, extsymtab[mem].extname) );
break;
case STGBSS:
case STGINIT:
sprintf(s, "v.%d", mem);
break;
case STGCONST:
sprintf(s, "L%d", mem);
break;
case STGEQUIV:
sprintf(s, "q.%d", mem+eqvstart);
break;
default:
fatali("memname: invalid vstg %d", stg);
}
return(s);
}
prlocvar(s, len)
char *s;
ftnint len;
{
fprintf(asmfile, "%s:", s);
prskip(asmfile, len);
}
prext(name, leng, init)
char *name;
ftnint leng;
int init;
{
if(leng==0 || init)
fprintf(asmfile, "\t.globl\t_%s\n", name);
else
fprintf(asmfile, "\t.comm\t_%s,%ld.\n", name, leng);
}
prendproc()
{
}
prtail()
{
#if FAMILY == PCC
p2pass("\t.globl\tcsv,cret");
#else
p2op(P2EOF);
#endif
}
prolog(ep, argvec)
struct Entrypoint *ep;
struct Addrblock *argvec;
{
int i, argslot, proflab;
register chainp p;
register struct Nameblock *q;
register struct Dimblock *dp;
struct Constblock *mkaddcon();
if(procclass == CLMAIN)
prentry("MAIN__");
if(ep->entryname)
prentry( varstr(XL, ep->entryname->extname) );
if(procclass == CLBLOCK)
return;
if(profileflag)
proflab = newlabel();
#if FAMILY == PCC
if(profileflag)
{
fprintf(asmfile, "L%d:\t. = .+2\n", proflab);
p2pi("\tmov\t$L%d,r0", proflab);
p2pass("\tjsr\tpc,mcount");
}
p2pass("\tjsr\tr5,csv");
p2pi("\tsub\t$.F%d,sp", procno);
#else
if(profileflag)
p2op2(P2PROFILE, proflab);
p2op(P2SAVE);
p2op2(P2SETSTK, ( (((int) autoleng)+1) & ~01) );
#endif
if(argvec == NULL)
addreg(argloc = 4);
else
{
addreg( argloc = argvec->memoffset->constblock.const.ci );
if(proctype == TYCHAR)
{
mvarg(TYADDR, 0, chslot);
mvarg(TYLENG, SZADDR, chlgslot);
argslot = SZADDR + SZLENG;
}
else if( ISCOMPLEX(proctype) )
{
mvarg(TYADDR, 0, cxslot);
argslot = SZADDR;
}
else
argslot = 0;
for(p = ep->arglist ; p ; p =p->nextp)
{
q = p->datap;
mvarg(TYADDR, argslot, q->vardesc.varno);
argslot += SZADDR;
}
for(p = ep->arglist ; p ; p = p->nextp)
{
q = p->datap;
if(q->vtype==TYCHAR || q->vclass==CLPROC)
{
if( q->vleng && ! ISCONST(q->vleng) )
mvarg(TYLENG, argslot, q->vleng->addrblock.memno);
argslot += SZLENG;
}
}
}
for(p = ep->arglist ; p ; p = p->nextp)
if(dp = ( (struct Nameblock *) (p->datap) ) ->vdim)
{
for(i = 0 ; i < dp->ndim ; ++i)
if(dp->dims[i].dimexpr)
puteq( fixtype(cpexpr(dp->dims[i].dimsize)),
fixtype(cpexpr(dp->dims[i].dimexpr)));
if(dp->basexpr)
puteq( cpexpr(fixtype(dp->baseoffset)),
cpexpr(fixtype(dp->basexpr)));
}
if(typeaddr)
puteq( cpexpr(typeaddr), mkaddcon(ep->typelabel) );
putgoto(ep->entrylabel);
}
prentry(s)
char *s;
{
#if FAMILY == PCC
p2ps("_%s:", s);
#else
p2op(P2RLABEL);
putc('_', textfile);
p2str(s);
#endif
}
addreg(k)
int k;
{
#if FAMILY == PCC
p2pass("\tmov\tr5,r4");
p2pi("\tadd\t$%d.,r4", k);
#else
p2reg(ARGREG, P2SHORT);
p2reg(AUTOREG, P2SHORT);
p2op2(P2ICON, P2SHORT);
p2i(k);
p2op2(P2PLUS, P2SHORT);
p2op2(P2ASSIGN, P2SHORT);
putstmt();
#endif
}
prhead(fp)
FILEP fp;
{
#if FAMILY == PCC
p2triple(P2LBRACKET, ARGREG-1-highregvar, procno);
p2word( (long) (BITSPERCHAR*autoleng) );
p2flush();
#endif
}
prdbginfo()
{
register char *s;
char *t, buff[50];
register struct Nameblock *p;
struct Hashentry *hp;
if(s = entries->entryname->extname)
s = varstr(XL, s);
else if(procclass == CLMAIN)
s = "MAIN__";
else
return;
if(procclass != CLBLOCK)
fprintf(asmfile, "~~%s = _%s\n", s, s);
for(hp = hashtab ; hp<lasthash ; ++hp)
if(p = hp->varp)
{
s = NULL;
if(p->vstg == STGARG)
{
sprintf(buff, "%o", p->vardesc.varno+argloc);
s = buff;
}
else if(p->vclass == CLVAR)
switch(p->vstg)
{
case STGBSS:
case STGINIT:
case STGEQUIV:
t = memname(p->vstg, p->vardesc.varno);
if(p->voffset)
sprintf(buff, "%s+%o", t, p->voffset);
else
sprintf(buff, "%s", t);
s = buff;
break;
case STGAUTO:
sprintf(buff, "%o", p->voffset);
s = buff;
break;
default:
break;
}
if(s)
fprintf(asmfile, "~%s = %s\n", varstr(VL,p->varname), s);
}
fprintf(asmfile, "~~:\n");
}