static char rcsid[] = "$Header:machine.c 12.0$";
#include "defs.h"

#ifdef SDB
#	include <a.out.h>
extern int types2[];
#	ifndef N_SO
#		include <stab.h>
#	endif
#endif

#include "pccdefs.h"


/*
	MACHINE SPECIFIC ROUTINES
*/


int maxregvar = MAXREGVAR;
int regnum[] =  { 10, 9, 8, 7, 6 } ;

ftnint intcon[14] =
	{ 2, 2, 2, 2,
	  15, 31, 24, 56,
	  -128, -128, 127, 127,
	  32767, 2147483647 };

#if HERE == VAX
	/* then put in constants in octal */
long realcon[6][2] =
	{
		{ 0200, 0 },
		{ 0200, 0 },
		{ 037777677777, 0 },
		{ 037777677777, 037777777777 },
		{ 032200, 0 },
		{ 022200, 0 }
	};
#else
double realcon[6] =
	{
	0x3810000000000000,
	0x0010000000000000,
	0x47efffffc0000000,
	0x7fefffffffffffff,
	0x38e0000000000000,
	0x3cb0000000000000,
	};
#endif




prsave(proflab)
int proflab;
{
if(profileflag)
	{
/*	fprintf(asmfile, "L%d:\t.space\t4\n", proflab);*/
/*	p2pi("\tmovab\tL%d,r0", proflab);*/
/*	p2pass("\tjsb\tmcount");*/
	}
}

#define	MAXRVAR 11

int firstuse = 0;
goret(type)
int type;
{
/* 9/23/86
 * JSW - This generates code to load a double being returned from a function
 * into r2 and r3, when the function only leaves it's address in r2.
 * This is part of the fix to ptm #2079.
 */
if ( type == TYDREAL )
	{
	p2pass("\tget r3,4(r2)\t|dbl rtn(goret)");
	p2pass("\tget r2,0(r2)\t|dbl rtn(goret)");
	}
p2pijkl("\tlm\t%%LOWREG%d,-64+L%d+LREGSPACE%d+LOWREG%d*4(sp)\t| epilogue",procno,procno,procno,procno);
p2pass("\tbrx\tr15\t|epilogue");
p2pij("\tai\tsp,sp,36+L%d+LREGSPACE%d\t|epilogue",procno,procno);

p2pass("\t.data");
p2pass("\t.align\t2");
p2pass("\t.ltorg");
p2pi("\t.DATA%d:",procno);
if (firstuse == 0)
{
	firstuse = 1;
	p2pass("\tv.1:");
}
p2pass("\t.align\t2");
p2pass("\t.text");
p2pass("\t.align\t2\t| fix it so it works");
p2pij(".DP%d:\t.long\t.DATA%d",procno,procno);
}

/*
 * move argument slot arg1 (relative to ap)
 * to slot arg2 (relative to ARGREG)
 */

mvarg(type, arg1, arg2)
int type, arg1, arg2;
{
/* (ef) 2/19/86 */
/*p2pi("\tget\tr15,%d(r12)\t| move arguments",arg1+ARGOFFSET);*/
p2pij("\tget\tr15,%d(r%d)\t| move arguments",arg1+ARGOFFSET,ARGREG);
p2pi("\tput\tr15,%d(r13)\t| move arguments",arg2+argloc);
}




prlabel(fp, k)
FILEP fp;
int k;
{
fprintf(fp, "L%d:\n", k);
}



prconi(fp, type, n)
FILEP fp;
int type;
ftnint n;
{
fprintf(fp, "\t%s\t%ld\n", (type==TYSHORT ? ".short" : ".long"), n);
}



prcona(fp, a)
FILEP fp;
ftnint a;
{
fprintf(fp, "\t.long\tL%ld\n", a);
}



#ifndef vax
prconr(fp, type, x)
FILEP fp;
int type;
double x;
{
	float zzz;

	if (type==TYREAL)
	{
		zzz = (float) x;
		fprintf(fp, "\t.int 0x%x\n",*(int*)&zzz);
	} else
	{
		fprintf(fp, "\t.int 0x%x,0x%x\n",x);
	}
}
#endif


praddr(fp, stg, varno, offset)
FILE *fp;
int stg, varno;
ftnint offset;
{
char *memname();

if(stg == STGNULL)
	fprintf(fp, "\t.long\t0\n");
else
	{
	fprintf(fp, "\t.long\t%s", memname(stg,varno));
	if(offset)
		fprintf(fp, "+%ld", offset);
	fprintf(fp, "\n");
	}
}




preven(k)
int k;
{
register int lg;

if(k > 4)
	lg = 3;
else if(k > 2)
	lg = 2;
else if(k > 1)
	lg = 2;
else
	lg = 2;
/*	return;*/
fprintf(asmfile, "\t.align\t%d\n", lg);
}




pralign(k)
int k;
{
  register int lg;

  if (k > 4)
    lg = 3;
  else if (k > 2)
    lg = 2;
  else if (k > 1)
    lg = 2;
  else
    lg = 2;
/*    return;*/

  fprintf(initfile, "\t.align\t%d\n", lg);
  return;
}

vaxgoto(index, nlab, labs)
expptr index;
register int nlab;
struct Labelblock *labs[];
{
register int i;
register int arrlab;

putforce(TYINT, index);
p2pi("\tcasel\tr0,$1,$%d", nlab-1);
p2pi("L%d:", arrlab = newlabel() );
for(i = 0; i< nlab ; ++i)
	if( labs[i] ){
printf("vaxgoto:puttting out .word\n");
		p2pij("\t.word\tL%d-L%d", labs[i]->labelno, arrlab);
	}
}

prcmgoto(index, nlab, skiplabel, lab)
expptr index;
register int nlab;
register int skiplabel;
register int lab;
{
register int i;

putforce(TYINT, index);

/* note: generated code assumes r15 is free!! (TGP) */

for(i = 0; i< nlab; ++i)
{
	p2pi("get\tr15,$.long(L%d)\t| prcmgoto",lab);
	p2pi("get\tr15,%d(r15)\t| prcmgoto",(i+1)*4);
	p2pi("ci\tr2,%d\t| prcmgoto",i+1);
	p2pi("ber\tr15\t| prcmgoto");
}
p2pi("b\tL%d\t| prcmgoto",skiplabel);

}

/* 	PRint ARithmetic IF to intermediate file */
/*
 *	If they node is an expression or address, force a result
 *	into r2.   The results may be an address or a value according
 *	to the following rules:
 *
 *	1. EXPRESSION nodes of type REAL and DOUBLE PRECISION always 
 *		return an address.
 *      2. EXPRESSION nodes of type INTEGER return a value.
 *	3. ADDRESS nodes of type DOUBLE PRECISION return an address.
 *	4. ADDRESS nodes of any other type return a value.
 *
 *	If an address is given then the value is loaded into a 
 *	register.  
 *
 *      Once a value is in a register, an ADD is done to set 
 * 	the carry bit (indicating whether the values is positive 
 *      or negative and also getting rid of the sign bit).  
 * 	If the value is a double, then the second 
 *	words is OR'ed in to determine whether or not the 
 *      double has any bits set (i.e., is not 0).
 *
 *	The appropriate branching pattern is put out.
 *
 *	If we have a CONSTANT node, then we already have the
 *	value and only need to put out the appropriate branch.
 */

prarif(p, neg, zero, pos)
expptr p;
int neg, zero, pos;
{
	int type = p->headblock.vtype;     	/* node type */
	int is_real = ISREAL(type);     	/* is node a REAL type? */
	int tag = p->tag; 

	switch (tag) {
	case TEXPR:
	case TADDR:
		putforce( type, p );
		if ((tag==TEXPR && is_real) || (tag==TADDR && type==TYDREAL)) 
			{
			p2pass("ls\tr15,0(r2)\t| prarif"); 
			p2pass("a\tr15,r15\t| prarif");
			if (type == TYDREAL)
				{
				p2pass("ls\tr2,4(r2)\t| prarif - DREAL");
				p2pass("o\tr15,r2\t| prarif - DREAL");
				}
			} 
		else
			p2pass("a\tr2,r2\t| prarif");
		p2pi("be\tL%d\t| prarif - REAL", zero);
		p2pi("bc0\tL%d\t| prarif - REAL", neg);
		p2pi("b\tL%d\t| prarif - REAL", pos);
		break;
	case TCONST:
		if ( is_real ) 
			if ( p->constblock.constant.cd[0] > 0.0 )
				p2pi("b\tL%d\t| prarif - REAL CONST", pos);
			else if ( p->constblock.constant.cd[0] == 0.0 )
				p2pi("b\tL%d\t| prarif - REAL CONST", zero);
			else		    
				p2pi("b\tL%d\t| prarif - REAL CONST", neg);
		else
			if ( p->constblock.constant.ci > 0 )
				p2pi("b\tL%d\t| prarif - INTEGER CONST", pos);
			else if ( p->constblock.constant.ci == 0 )
				p2pi("b\tL%d\t| prarif - INTEGER CONST", zero);
			else		    
				p2pi("b\tL%d\t| prarif - INTEGER CONST", neg);
		break;
	}	
}




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, "LCOM.%d", mem);
		break;

	case STGCONST:
		sprintf(s, "L%d", mem);
		break;

	case STGEQUIV:
		sprintf(s, "LCOM.q.%d", mem+eqvstart);
		break;

	default:
		badstg("memname", stg);
	}
return(s);
}




prlocvar(s, len)
char *s;
ftnint len;
{
fprintf(asmfile, "\t.lcomm\t%s,%ld\n", s, len);
}




char *
packbytes(cp)
register Constp cp;
{
  static short shrt[1];
/* JSW - 10/25/86
 * The code expects these to be word aligned, they were `static char [4]`,
 * etc.  Pcc would word align them but hc would not.  This caused strange
 * things to happen with double or complex constants.  This is the fix
 * for ptm 2234.
 */
  static long lng[1];
  static long quad[2];
  static long oct[3];

  register int type;
  register int *ip, *jp;
  register float *fip, *fjp;

  switch (cp->vtype)
    {
    case TYSHORT:
      *((short *) shrt) = (short) cp->constant.ci;
      return ((char *)shrt);

    case TYLONG:
    case TYLOGICAL:
 /* case TYREAL: */
      *((int *) lng) = cp->constant.ci;
      return ((char *)lng);

    case TYREAL:
      *((float*)lng)= cp->constant.cd[0];
      return ((char *)lng);

    case TYDREAL:
      ip = (int *) quad;
      jp = (int *) &(cp->constant.cd[0]);
      ip[0] = jp[0];
      ip[1] = jp[1];
      return ((char *)quad);

    case TYCOMPLEX:
      fip = (float *) quad;
      fip[0] = cp->constant.cd[0];
      fip[1] = cp->constant.cd[1];
      return ((char *)quad);

    case TYDCOMPLEX:
      ip = (int *) oct;
      jp = (int *) &(cp->constant.cd[0]);
      *ip++ = *jp++;
      *ip++ = *jp++;
      *ip++ = *jp++;
      *ip = *jp;
      return ((char *)oct);

    default:
      badtype("packbytes", cp->vtype);
    }
}




prsdata(s, len)
register char *s;
register int len;
{
  static char *longfmt = "\t.long\t0x%x\n";
  static char *wordfmt = "\t.short\t0x%x\n";
  static char *bytefmt = "\t.byte\t0x%x\n";

  register int i;

  i = 0;
  if ((len - i) >= 4)
    {
      fprintf(initfile, longfmt, *((int *) s));
      i += 4;
    }
  if ((len - i) >= 2)
    {
      fprintf(initfile, wordfmt, 0xffff & (*((short *) (s + i))));
      i += 2;
    }
  if ((len - i) > 0)
    fprintf(initfile,bytefmt, 0xff & s[i]);

  return;
}



prquad(s)
long *s;
{
  static char *quadfmt1 = "\t.dlong\t0x%x\n";
  static char *quadfmt2 = "\t.dlong\t0x%x%08x\n";

  fprintf(initfile, "\t.long\t0x%x,0x%x\n",*s,*(s+1));
/*  if ( *((int *) (s + 4)) == 0 )
    fprintf(initfile, quadfmt1, *((int *) s));
  else
    fprintf(initfile, quadfmt2, *((int *) (s + 4)), *((int *) s));
*/
  return;
}



#ifdef NOTDEF

/*  The code for generating .fill directives has been      */
/*  ifdefed out because of bugs in the UCB VAX assembler.  */
/*  If those bugs are ever fixed (and it seems unlikely),  */
/*  the NOTDEF's should be replaced by UCBVAXASM.          */


prfill(n, s)
int n;
register char *s;
{
  static char *fillfmt1 = "\t.fill\t%d,8,0x%x\n";
  static char *fillfmt2 = "\t.fill\t%d,8,0x%x%08x\n";

  if (*((int *) (s + 4)) == 0)
    fprintf(initfile, fillfmt1, n, *((int *) s));
  else
    fprintf(initfile, fillfmt2, n, *((int *) (s + 4)), *((int *) s));

  return;
}

#endif



prext(ep)
register struct Extsym *ep;
{
  static char *globlfmt = "\t.globl\t_.%s\n";
  static char *commfmt = "\t.comm\t_%s,%ld\n";
  static char *spacefmt = "\t.space\t%d\n";
  static char *align2fmt = "\t.align\t2\n";
  static char *labelfmt = "_%s:\n";

  static char *seekerror = "seek error on tmp file";
  static char *readerror = "read error on tmp file";

  char *tag;
  register int leng;
  long pos;
  register int i;
  char oldvalue[8];
  char newvalue[8];
  register int n;
  register int repl;

  tag = varstr(XL, ep->extname);
  leng = ep->maxleng;

  if (leng == 0)
    {
      fprintf(asmfile, globlfmt, tag);
      return;
    }

  if (ep->init == NO)
    {
      fprintf(asmfile, commfmt, tag, leng);
      return;
    }

if (ep->extstg == STGCOMMON)
  fprintf(asmfile,"\t.globl\t_%s\n",tag);
else
  fprintf(asmfile, globlfmt, tag);
  fprintf(initfile, align2fmt);
  fprintf(initfile, labelfmt, tag);

  pos = lseek(cdatafile, ep->initoffset, 0);
  if (pos == -1)
    {
      err(seekerror);
      done(1);
    }

  *((int *) oldvalue) = 0;
  *((int *) (oldvalue + 4)) = 0;
  n = read(cdatafile, oldvalue, 8);
  if (n < 0)
    {
      err(readerror);
      done(1);
    }

  if (leng <= 8)
    {
      i = leng;
      while (i > 0 && oldvalue[--i] == '\0') /* SKIP */;
      if (oldvalue[i] == '\0')
	fprintf(initfile, spacefmt, leng);
      else if (leng == 8)
	prquad(oldvalue);
      else
	prsdata(oldvalue, leng);

      return;
    }

  repl = 1;
  leng -= 8;

  while (leng >= 8)
    {
      *((int *) newvalue) = 0;
      *((int *) (newvalue + 4)) = 0;

      n = read(cdatafile, newvalue, 8);
      if (n < 0)
	{
	  err(readerror);
	  done(1);
	}

      leng -= 8;

      if (*((int *) oldvalue) == *((int *) newvalue)
	  && *((int *) (oldvalue + 4)) == *((int *) (newvalue + 4)))
	repl++;
      else
	{
	  if (*((int *) oldvalue) == 0
	      && *((int *) (oldvalue + 4)) == 0)
	    fprintf(initfile, spacefmt, 8*repl);
	  else if (repl == 1)
	    prquad(oldvalue);
	  else
#ifdef NOTDEF
	    prfill(repl, oldvalue);
#else
	    {
	      while (repl-- > 0)
		prquad(oldvalue);
	    }
#endif
	  *((int *) oldvalue) = *((int *) newvalue);
	  *((int *) (oldvalue + 4)) = *((int *) (newvalue + 4));
	  repl = 1;
	}
    }

  *((int *) newvalue) = 0;
  *((int *) (newvalue + 4)) = 0;

  if (leng > 0)
    {
      n = read(cdatafile, newvalue, leng);
      if (n < 0)
	{
	  err(readerror);
	  done(1);
	}
    }

  if (*((int *) (oldvalue + 4)) == 0
      && *((int *) oldvalue) == 0
      && *((int *) (newvalue + 4)) == 0
      && *((int *) newvalue) == 0)
    {
      fprintf(initfile, spacefmt, 8*repl + leng);
      return;
    }

  if (*((int *) (oldvalue + 4)) == 0
      && *((int *) oldvalue) == 0)
    fprintf(initfile, spacefmt, 8*repl);
  else if (repl == 1)
    prquad(oldvalue);
  else
#ifdef NOTDEF
    prfill(repl, oldvalue);
#else
    {
      while (repl-- > 0)
	prquad(oldvalue);
    }
#endif

  prsdata(newvalue, leng);

  return;
}



prlocdata(sname, leng, type, initoffset, inlcomm)
char *sname;
ftnint leng;
int type;
long initoffset;
char *inlcomm;
{
  static char *seekerror = "seek error on tmp file";
  static char *readerror = "read error on tmp file";

  static char *labelfmt = "%s:\n";
  static char *spacefmt = "\t.space\t%d\n";

  register int k;
  register int i;
  register int repl;
  register int first;
  register long pos;
  register long n;
  char oldvalue[8];
  char newvalue[8];

  *inlcomm = NO;

  k = leng;
  first = YES;

  pos = lseek(vdatafile, initoffset, 0);
  if (pos == -1)
    {
      err(seekerror);
      done(1);
    }

  *((int *) oldvalue) = 0;
  *((int *) (oldvalue + 4)) = 0;
  n = read(vdatafile, oldvalue, 8);
  if (n < 0)
    {
      err(readerror);
      done(1);
    }

  if (k <= 8)
    {
      i = k;
      while (i > 0 && oldvalue[--i] == '\0')
	/*  SKIP  */ ;
      if (oldvalue[i] == '\0')
	{
	  if (SMALLVAR(leng))
	    {
	      pralign(typealign[type]);
	      fprintf(initfile, labelfmt, sname);
	      fprintf(initfile, spacefmt, leng);
	    }
	  else
	    {
	      preven(ALIDOUBLE);
	      prlocvar(sname, leng);
	      *inlcomm = YES;
	    }
	}
      else
	{
	  pralign(typealign[type]);
	  fprintf(initfile, labelfmt, sname);
	  if (leng == 8)
	    prquad(oldvalue);
	  else
	    prsdata(oldvalue, leng);
	}
      return;
    }

  repl = 1;
  k -= 8;

  while (k >=8)
    {
      *((int *) newvalue) = 0;
      *((int *) (newvalue + 4)) = 0;

      n = read(vdatafile, newvalue, 8);
      if (n < 0)
	{
	  err(readerror);
	  done(1);
	}

      k -= 8;

      if (*((int *) oldvalue) == *((int *) newvalue)
	  && *((int *) (oldvalue + 4)) == *((int *) (newvalue + 4)))
	repl++;
      else
	{
	  if (first == YES)
	    {
	      pralign(typealign[type]);
	      fprintf(initfile, labelfmt, sname);
	      first = NO;
	    }

	  if (*((int *) oldvalue) == 0
	      && *((int *) (oldvalue + 4)) == 0)
	    fprintf(initfile, spacefmt, 8*repl);
	  else
	    {
	      while (repl-- > 0)
		prquad(oldvalue);
	    }
	  *((int *) oldvalue) = *((int *) newvalue);
	  *((int *) (oldvalue + 4)) = *((int *) (newvalue + 4));
	  repl = 1;
	}
    }

  *((int *) newvalue) = 0;
  *((int *) (newvalue + 4)) = 0;

  if (k > 0)
    {
      n = read(vdatafile, newvalue, k);
      if (n < 0)
	{
	  err(readerror);
	  done(1);
	}
    }

  if (*((int *) (oldvalue + 4)) == 0
      && *((int *) oldvalue) == 0
      && *((int *) (newvalue + 4)) == 0
      && *((int *) newvalue) == 0)
    {
      if (first == YES && !SMALLVAR(leng))
	{
	  prlocvar(sname, leng);
	  *inlcomm = YES;
	}
      else
	{
	  if (first == YES)
	    {
	      pralign(typealign[type]);
	      fprintf(initfile, labelfmt, sname);
	    }
	  fprintf(initfile, spacefmt, 8*repl + k);
	}
      return;
    }

  if (first == YES)	
    {
      pralign(typealign[type]);
      fprintf(initfile, labelfmt, sname);
    }

  if (*((int *) (oldvalue + 4)) == 0
      && *((int *) oldvalue) == 0)
    fprintf(initfile, spacefmt, 8*repl);
  else
    {
      while (repl-- > 0)
	prquad(oldvalue);
    }

  prsdata(newvalue, k);

  return;
}
	    



prendproc()
{
}

prtail()
{
}

prolog(ep, argvec)
struct Entrypoint *ep;
Addrp  argvec;
{
int i, argslot, proflab;
int size;
register chainp p;
register Namep q;
register struct Dimblock *dp;
expptr tp;

#ifndef FLEXNAMES
p2ps(" .ascii \"<%.8s>\"",ep->entryname->extname);
#else
p2ps(" .ascii \"<%s>\"",ep->entryname->extname);
#endif

p2ps(" .align 2\n");

if(procclass == CLMAIN) {
		{
		fprintf(asmfile,".text\n");
		fprintf(asmfile,"_.MAIN_:\n");
		p2pass( ".data");
		p2pass( ".globl	_MAIN_");
		p2pass( "_MAIN_: .long _.MAIN_");
		if (profileflag)
		   p2pass("\t.int\t0\t| profileing");
		if (ep->entryname)
		{
		   fprintf(asmfile,"b _.%s\n",
			varstr(XL,ep->entryname->extname));
		   p2ps( ".globl _%s",varstr(XL, ep->entryname->extname));
		   p2ps2("_%s: .long _.%s",varstr(XL, ep->entryname->extname),
			varstr(XL,ep->entryname->extname));
		   p2pass(".text");
		   p2ps("_.%s:",varstr(XL,ep->entryname->extname));
		}
		else
		{
		   fprintf(asmfile,".text\n");
		   fprintf(asmfile,"b L%d\n",fudgelabel=newlabel());
		   p2pass(".text");
		   p2ps("L%d:",fudgelabel);
		   fudgelabel = 0;
		}
		fprintf(asmfile,".data\n");
		}

} else if(ep->entryname)
		{
		p2ps("_.%s:",  varstr(XL, ep->entryname->extname));
		p2pass( ".data");
		p2ps(".globl _%s", varstr(XL, ep->entryname->extname));
		p2ps2("_%s: .long _.%s",varstr(XL, ep->entryname->extname),
			varstr(XL, ep->entryname->extname));
		if (profileflag)
			p2pass("\t.int\t0\t| profileing");
		p2pass(".text");
		}

if(procclass == CLBLOCK)
	return;

#ifndef FLEXNAMES
p2ps("|-----------------| %.8s |-------------------|",ep->entryname->extname);
#else
p2ps("|-----------------| %s |-------------------|",ep->entryname->extname);
#endif


p2pij("\tstm\t%%LOWREG%d,-100+LOWREG%d*4(sp)\t| prolog",procno,procno);
/* (ef) 2/19/86 */
/*p2pass("\tai\tr12,sp,-16\t| prologue");*/
p2pass("\tai\tr11,sp,-16\t| prologue");
p2pij("\tai\tsp,sp,-36-L%d-LREGSPACE%d\t| prologue",procno,procno);
p2pij("\tcal\tr13,L%d%d(sp)\t| prologue",procno,AUTOINIT/SZCHAR);

if (ep->entryname && procclass!=CLMAIN)
	p2pis("\tai\tr14,r0,.DATA%d-_%s\t| prolog",procno,ep->entryname->extname);
else
	p2pass("\tcas\tr14,r0,r0\t| prologue");

p2pi("\t.using\t.DATA%d,r14\t| prologue",procno);

if (procclass != CLMAIN)
{
    for (i=0;i<4;i++)
    {
/* (ef) 2/19/86 */
/*	p2pij("\tsts\tr%d,%d(r12)\t| store args",2+i,4*i);*/
	p2pij("\tsts\tr%d,%d(r11)\t| store args",2+i,4*i);
    }
}

if(argvec)
	{
	if (argvec->tag != TADDR) badtag ("prolog",argvec->tag);
	argloc = argvec->memoffset->constblock.constant.ci + SZINT;
			/* first slot holds count */
	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 = (Namep) (p->datap);
		mvarg(TYADDR, argslot, q->vardesc.varno);
		argslot += SZADDR;
		}
	for(p = ep->arglist ; p ; p = p->nextp)
		{
		q = (Namep) (p->datap);
		if(q->vtype==TYCHAR && q->vclass!=CLPROC)
			{
			if(q->vleng && ! ISCONST(q->vleng) )
				mvarg(TYLENG, argslot,
					q->vleng->addrblock.memno);
			argslot += SZLENG;
			}
		}
/* (ef) 2/19/86 */
/*	p2pi("\tai\tr12,r13,%d\t| set up arguments", argloc-ARGOFFSET);*/
	p2pij("\tai\tr%d,r13,%d\t| set up arguments", ARGREG,argloc-ARGOFFSET);
	}

for(p = ep->arglist ; p ; p = p->nextp)
	{
	q = (Namep) (p->datap);
	if(dp = q->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)));
#ifdef SDB
                if(sdbflag) {
		for(i = 0 ; i < dp->ndim ; ++i) {
			if(dp->dims[i].lbaddr)
				puteq( fixtype(cpexpr(dp->dims[i].lbaddr)),
					fixtype(cpexpr(dp->dims[i].lb)));
			if(dp->dims[i].ubaddr)
				puteq( fixtype(cpexpr(dp->dims[i].ubaddr)),
					fixtype(cpexpr(dp->dims[i].ub)));
		    
                                                }
                            }
#endif
		size = typesize[ q->vtype ];
		if(q->vtype == TYCHAR)
			if( ISICON(q->vleng) )
				size *= q->vleng->constblock.constant.ci;
			else
				size = -1;

		/* on VAX, get more efficient subscripting if subscripts
		   have zero-base, so fudge the argument pointers for arrays.
		   Not done if array bounds are being checked.
		*/
		if(dp->basexpr)
			puteq( 	cpexpr(fixtype(dp->baseoffset)),
				cpexpr(fixtype(dp->basexpr)));
#ifdef vax
#ifdef SDB
		if( (! checksubs) && (! sdbflag) )
#else
		if(! checksubs)
#endif
			{
			if(dp->basexpr)
				{
				if(size > 0)
					tp = (expptr) ICON(size);
				else
					tp = (expptr) cpexpr(q->vleng);
				putforce(TYINT,
					fixtype( mkexpr(OPSTAR, tp,
						cpexpr(dp->baseoffset)) ));
				p2pi("\tsubl2\tr0,%d(ap)",
					p->datap->nameblock.vardesc.varno +
						ARGOFFSET);
				}
			else if(dp->baseoffset->constblock.constant.ci != 0)
				{
				char buff[25];
				if(size > 0)
					{
					sprintf(buff, "\tsubl2\t$%ld,%d(ap)",
						dp->baseoffset->constblock.constant.ci * size,
						p->datap->nameblock.vardesc.varno +
							ARGOFFSET);
					}
				else	{
					putforce(TYINT, mkexpr(OPSTAR, cpexpr(dp->baseoffset),
						cpexpr(q->vleng) ));
					sprintf(buff, "\tsubl2\tr0,%d(ap)",
						p->datap->nameblock.vardesc.varno +
							ARGOFFSET);
					}
				p2pass(buff);
				}
			}
#endif vax
		}
	}

if(typeaddr)
	puteq( cpexpr(typeaddr), mkaddcon(ep->typelabel) );
if (profileflag)
{
	p2pass("\tcas\tr0,r15,r0\t| profiling");
	p2pass("\tbali\tr15,mcount\t| profiling");
}
p2pi("\tb\tL%d", ep->entrylabel);
p2pass("\t.ltorg");
}

fixlwm()
{
}


prhead(fp)
FILEP fp;
{
#if FAMILY==PCC
	p2triple(P2LBRACKET, ARGREG-highregvar, procno);
	p2word( (long) (BITSPERCHAR*autoleng) );
	p2flush();
#endif
}


