[unix-history] / usr / src / cmd / f77 / pdp11.c

#include "defs"
#if FAMILY == DMR
#	include "dmrdefs"
#endif
#if FAMILY==SCJ && OUTPUT==BINARY
#	include "scjdefs"
#endif

/*
      PDP 11-SPECIFIC PRINTING ROUTINES
*/

int maxregvar = 0;
static char textline[50];
int regnum[] = { 3, 2 };


prsave()
{
}


goret(type)
int type;
{
#if  FAMILY == DMR
	p2op(P2RETURN);
#endif
#if FAMILY==SCJ
	p2pass(sprintf(textline, "\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 == SCJ
	p2pass(sprintf(textline, "\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, "L%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


preven(k)
int k;
{
if(k > 1)
	fprintf(asmfile, "\t.even\n", k);
}


#if FAMILY == SCJ

prcmgoto(p, nlab, skiplabel, labarray)
expptr p;
int nlab, skiplabel, labarray;
{
int regno;

putforce(p->vtype, p);

if(p->vtype == TYLONG)
	{
	regno = 1;
	p2pass(sprintf(textline, "\ttst\tr0"));
	p2pass(sprintf(textline, "\tbne\tL%d", skiplabel));
	}
else
	regno = 0;

p2pass(sprintf(textline, "\tcmp\tr%d,$%d.", regno, nlab));
p2pass(sprintf(textline, "\tbhi\tL%d", skiplabel));
p2pass(sprintf(textline, "\tasl\tr%d", regno));
p2pass(sprintf(textline, "\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(sprintf(textline, "\ttst\tr0"));
	p2pass(sprintf(textline, "\tjlt\tL%d", neg));
	p2pass(sprintf(textline, "\tjgt\tL%d", pos));
	if(ptype != TYSHORT)
		{
		p2pass(sprintf(textline, "\ttst\tr1"));
		p2pass(sprintf(textline, "\tjeq\tL%d", zer));
		}
	p2pass(sprintf(textline, "\tjbr\tL%d", pos));
	}
else
	{
	p2pass(sprintf(textline, "\ttstf\tr0"));
	p2pass(sprintf(textline, "\tcfcc"));
	p2pass(sprintf(textline, "\tjeq\tL%d", zer));
	p2pass(sprintf(textline, "\tjlt\tL%d", neg));
	p2pass(sprintf(textline, "\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);
		break;

	default:
		fatal1("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 == SCJ
	p2pass(sprintf(textline, "\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 == SCJ
	if(profileflag)
		{
		fprintf(asmfile, "L%d:\t. = .+2\n", proflab);
		p2pass(sprintf(textline, "\tmov\t$L%d,r0", proflab));
		p2pass(sprintf(textline, "\tjsr\tpc,mcount"));
		}
	p2pass(sprintf(textline, "\tjsr\tr5,csv"));
	p2pass(sprintf(textline, "\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->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->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 == SCJ
	p2pass(sprintf(textline, "_%s:", s));
#else
	p2op(P2RLABEL);
	putc('_', textfile);
	p2str(s);
#endif
}


addreg(k)
int k;
{
#if FAMILY == SCJ
	p2pass(sprintf(textline, "\tmov\tr5,r4"));
	p2pass(sprintf(textline, "\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==SCJ
#	if OUTPUT == BINARY
		p2triple(P2LBRACKET, ARGREG-1-highregvar, procno);
		p2word( (long) (BITSPERCHAR*autoleng) );
		p2flush();
#	else
		fprintf(fp, "[%02d\t%06ld\t%02d\t\n", procno,
			BITSPERCHAR*autoleng, ARGREG-1-highregvar);
#	endif
#endif
}
\f
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)
		s = sprintf(buff, "%o", p->vardesc.varno+argloc);
	else if(p->vclass == CLVAR)
		switch(p->vstg)
			{
			case STGBSS:
			case STGINIT:
			case STGEQUIV:
				t = memname(p->vstg, p->vardesc.varno);
				if(p->voffset)
					s = sprintf(buff, "%s+%o", t, p->voffset);
				else
					s = sprintf(buff, "%s", t);
				break;

			case STGAUTO:
				s = sprintf(buff, "%o", p->voffset);
				break;

			default:
				break;
			}
	if(s)
		fprintf(asmfile, "~%s = %s\n", varstr(VL,p->varname), s);
	}
fprintf(asmfile, "~~:\n");
}
Commit	Line	Data
eb5ad1d2 F	1	#include "defs"
	2	#if FAMILY == DMR
	3	# include "dmrdefs"
	4	#endif
	5	#if FAMILY==SCJ && OUTPUT==BINARY
	6	# include "scjdefs"
	7	#endif
	8
	9	/*
	10	PDP 11-SPECIFIC PRINTING ROUTINES
	11	*/
	12
	13	int maxregvar = 0;
	14	static char textline[50];
	15	int regnum[] = { 3, 2 };
	16
	17
	18	prsave()
	19	{
	20	}
	21
	22
	23
	24	goret(type)
	25	int type;
	26	{
	27	#if FAMILY == DMR
	28	p2op(P2RETURN);
	29	#endif
	30	#if FAMILY==SCJ
	31	p2pass(sprintf(textline, "\tjmp\tcret"));
	32	#endif
	33	}
	34
	35
	36
	37
	38	/*
	39	* move argument slot arg1 (relative to ap)
	40	* to slot arg2 (relative to ARGREG)
	41	*/
	42
	43	mvarg(type, arg1, arg2)
	44	int type, arg1, arg2;
	45	{
	46	mvarg1(arg1+4, arg2);
	47	if(type == TYLONG)
	48	mvarg1(arg1+6, arg2+2);
	49	}
	50
	51
	52
	53
	54	mvarg1(m, n)
	55	int m, n;
	56	{
	57	#if FAMILY == DMR
	58	p2reg(ARGREG, P2SHORT\|P2PTR);
	59	p2op2(P2ICON, P2SHORT);
	60	p2i(n);
	61	p2op2(P2PLUS, P2SHORT\|P2PTR);
	62	p2op2(P2INDIRECT, P2SHORT);
	63	p2reg(AUTOREG, P2SHORT\|P2PTR);
	64	p2op2(P2ICON, P2SHORT);
65	p2i(m);
66	p2op2(P2PLUS, P2SHORT\|P2PTR);
67	p2op2(P2INDIRECT, P2SHORT);
68	p2op2(P2ASSIGN, P2SHORT);
69	putstmt();
70	#endif
71	#if FAMILY == SCJ
72	p2pass(sprintf(textline, "\tmov\t%d.(r5),%d.(r4)", m, n));
73	#endif
74	}
75
76
77
78
79	prlabel(fp, k)
80	FILEP fp;
81	int k;
82	{
83	fprintf(fp, "L%d:\n", k);
84	}
85
86
87
88	prconi(fp, type, n)
89	FILEP fp;
90	int type;
91	ftnint n;
92	{
93	register int *np;
94	np = &n;
95	if(type == TYLONG)
96	fprintf(fp, "\t%d.;%d.\n", np[0], np[1]);
97	else
98	fprintf(fp, "\t%d.\n", np[1]);
99	}
100
101
102
103	prcona(fp, a)
104	FILEP fp;
105	ftnint a;
106	{
107	fprintf(fp, "L%ld\n", a);
108	}
109
110
111
112	#if HERE!=PDP11
113	BAD NEWS
114	#endif
115
116	#if HERE==PDP11
117	prconr(fp, type, x)
118	FILEP fp;
119	int type;
120	double x;
121	{
122	register int k, *n;
123	n = &x; /* nonportable cheat */
124	k = (type==TYREAL ? 2 : 4);
125	fprintf(fp, "\t");
126	while(--k >= 0)
127	fprintf(fp, "%d.%c", *n++, (k==0 ? '\n' : ';') );
128	}
129	#endif
130
131
132
133
134	preven(k)
135	int k;
136	{
137	if(k > 1)
138	fprintf(asmfile, "\t.even\n", k);
139	}
140
141
142
143	#if FAMILY == SCJ
144
145	prcmgoto(p, nlab, skiplabel, labarray)
146	expptr p;
147	int nlab, skiplabel, labarray;
148	{
149	int regno;
150
151	putforce(p->vtype, p);
152
153	if(p->vtype == TYLONG)
154	{
155	regno = 1;
156	p2pass(sprintf(textline, "\ttst\tr0"));
157	p2pass(sprintf(textline, "\tbne\tL%d", skiplabel));
158	}
159	else
160	regno = 0;
161
162	p2pass(sprintf(textline, "\tcmp\tr%d,$%d.", regno, nlab));
163	p2pass(sprintf(textline, "\tbhi\tL%d", skiplabel));
164	p2pass(sprintf(textline, "\tasl\tr%d", regno));
165	p2pass(sprintf(textline, "\tjmp\t*L%d(r%d)", labarray, regno));
166	}
167
168
169	prarif(p, neg,zer,pos)
170	expptr p;
171	int neg, zer, pos;
172	{
173	register int ptype;
174
175	putforce( ptype = p->vtype, p);
176	if( ISINT(ptype) )
177	{
178	p2pass(sprintf(textline, "\ttst\tr0"));
179	p2pass(sprintf(textline, "\tjlt\tL%d", neg));
180	p2pass(sprintf(textline, "\tjgt\tL%d", pos));
181	if(ptype != TYSHORT)
182	{
183	p2pass(sprintf(textline, "\ttst\tr1"));
184	p2pass(sprintf(textline, "\tjeq\tL%d", zer));
185	}
186	p2pass(sprintf(textline, "\tjbr\tL%d", pos));
187	}
188	else
189	{
190	p2pass(sprintf(textline, "\ttstf\tr0"));
191	p2pass(sprintf(textline, "\tcfcc"));
192	p2pass(sprintf(textline, "\tjeq\tL%d", zer));
193	p2pass(sprintf(textline, "\tjlt\tL%d", neg));
194	p2pass(sprintf(textline, "\tjmp\tL%d", pos));
195	}
196	}
197
198	#endif
199
200
201
202
203	char *memname(stg, mem)
204	int stg, mem;
205	{
206	static char s[20];
207
208	switch(stg)
209	{
210	case STGCOMMON:
211	case STGEXT:
212	sprintf(s, "_%s", varstr(XL, extsymtab[mem].extname) );
213	break;
214
215	case STGBSS:
216	case STGINIT:
217	sprintf(s, "v.%d", mem);
218	break;
219
220	case STGCONST:
221	sprintf(s, "L%d", mem);
222	break;
223
224	case STGEQUIV:
225	sprintf(s, "q.%d", mem);
226	break;
227
228	default:
229	fatal1("memname: invalid vstg %d", stg);
230	}
231	return(s);
232	}
233
234
235	prlocvar(s, len)
236	char *s;
237	ftnint len;
238	{
239	fprintf(asmfile, "%s:", s);
240	prskip(asmfile, len);
241	}
242
243
244
245	prext(name, leng, init)
246	char *name;
247	ftnint leng;
248	int init;
249	{
250	if(leng==0 \|\| init)
251	fprintf(asmfile, "\t.globl\t_%s\n", name);
252	else
253	fprintf(asmfile, "\t.comm\t_%s,%ld.\n", name, leng);
254	}
255
256
257
258	prendproc()
259	{
260	}
261
262
263
264	prtail()
265	{
266	#if FAMILY == SCJ
267	p2pass(sprintf(textline, "\t.globl\tcsv,cret"));
268	#else
269	p2op(P2EOF);
270	#endif
271	}
272
273
274
275	prolog(ep, argvec)
276	struct entrypoint *ep;
277	struct addrblock *argvec;
278	{
279	int i, argslot, proflab;
280	register chainp p;
281	register struct nameblock *q;
282	register struct dimblock *dp;
283	struct constblock *mkaddcon();
284
285	if(procclass == CLMAIN)
286	prentry("MAIN__");
287
288	if(ep->entryname)
289	prentry( varstr(XL, ep->entryname->extname) );
290
291	if(procclass == CLBLOCK)
292	return;
293	if(profileflag)
294	proflab = newlabel();
295	#if FAMILY == SCJ
296	if(profileflag)
297	{
298	fprintf(asmfile, "L%d:\t. = .+2\n", proflab);
299	p2pass(sprintf(textline, "\tmov\t$L%d,r0", proflab));
300	p2pass(sprintf(textline, "\tjsr\tpc,mcount"));
301	}
302	p2pass(sprintf(textline, "\tjsr\tr5,csv"));
303	p2pass(sprintf(textline, "\tsub\t$.F%d,sp", procno));
304	#else
305	if(profileflag)
306	p2op2(P2PROFILE, proflab);
307	p2op(P2SAVE);
308	p2op2(P2SETSTK, ( (((int) autoleng)+1) & ~01) );
309	#endif
310
311	if(argvec == NULL)
312	addreg(argloc = 4);
313	else
314	{
315	addreg( argloc = argvec->memoffset->const.ci );
316	if(proctype == TYCHAR)
317	{
318	mvarg(TYADDR, 0, chslot);
319	mvarg(TYLENG, SZADDR, chlgslot);
320	argslot = SZADDR + SZLENG;
321	}
322	else if( ISCOMPLEX(proctype) )
323	{
324	mvarg(TYADDR, 0, cxslot);
325	argslot = SZADDR;
326	}
327	else
328	argslot = 0;
329
330	for(p = ep->arglist ; p ; p =p->nextp)
331	{
332	q = p->datap;
333	mvarg(TYADDR, argslot, q->vardesc.varno);
334	argslot += SZADDR;
335	}
336	for(p = ep->arglist ; p ; p = p->nextp)
337	{
338	q = p->datap;
339	if(q->vtype==TYCHAR \|\| q->vclass==CLPROC)
340	{
341	if( q->vleng && ! ISCONST(q->vleng) )
342	mvarg(TYLENG, argslot, q->vleng->memno);
343	argslot += SZLENG;
344	}
345	}
346	}
347
348	for(p = ep->arglist ; p ; p = p->nextp)
349	if(dp = ( (struct nameblock *) (p->datap) ) ->vdim)
350	{
351	for(i = 0 ; i < dp->ndim ; ++i)
352	if(dp->dims[i].dimexpr)
353	puteq( fixtype(cpexpr(dp->dims[i].dimsize)),
354	fixtype(cpexpr(dp->dims[i].dimexpr)));
355	if(dp->basexpr)
356	puteq( cpexpr(fixtype(dp->baseoffset)),
357	cpexpr(fixtype(dp->basexpr)));
358	}
359
360	if(typeaddr)
361	puteq( cpexpr(typeaddr), mkaddcon(ep->typelabel) );
362	putgoto(ep->entrylabel);
363	}
364
365
366
367	prentry(s)
368	char *s;
369	{
370	#if FAMILY == SCJ
371	p2pass(sprintf(textline, "_%s:", s));
372	#else
373	p2op(P2RLABEL);
374	putc('_', textfile);
375	p2str(s);
376	#endif
377	}
378
379
380
381
382	addreg(k)
383	int k;
384	{
385	#if FAMILY == SCJ
386	p2pass(sprintf(textline, "\tmov\tr5,r4"));
387	p2pass(sprintf(textline, "\tadd\t$%d.,r4", k));
388	#else
389	p2reg(ARGREG, P2SHORT);
390	p2reg(AUTOREG, P2SHORT);
391	p2op2(P2ICON, P2SHORT);
392	p2i(k);
393	p2op2(P2PLUS, P2SHORT);
394	p2op2(P2ASSIGN, P2SHORT);
395	putstmt();
396	#endif
397	}
398
399
400
401
402
403	prhead(fp)
404	FILEP fp;
405	{
406	#if FAMILY==SCJ
407	# if OUTPUT == BINARY
408	p2triple(P2LBRACKET, ARGREG-1-highregvar, procno);
409	p2word( (long) (BITSPERCHAR*autoleng) );
410	p2flush();
411	# else
412	fprintf(fp, "[%02d\t%06ld\t%02d\t\n", procno,
413	BITSPERCHAR*autoleng, ARGREG-1-highregvar);
414	# endif
415	#endif
416	}
417	\f
418	prdbginfo()
419	{
420	register char *s;
421	char *t, buff[50];
422	register struct nameblock *p;
423	struct hashentry *hp;
424
425	if(s = entries->entryname->extname)
426	s = varstr(XL, s);
427	else if(procclass == CLMAIN)
428	s = "MAIN__";
429	else
430	return;
431
432	if(procclass != CLBLOCK)
433	fprintf(asmfile, "~~%s = _%s\n", s, s);
434
435	for(hp = hashtab ; hp<lasthash ; ++hp)
436	if(p = hp->varp)
437	{
438	s = NULL;
439	if(p->vstg == STGARG)
440	s = sprintf(buff, "%o", p->vardesc.varno+argloc);
441	else if(p->vclass == CLVAR)
442	switch(p->vstg)
443	{
444	case STGBSS:
445	case STGINIT:
446	case STGEQUIV:
447	t = memname(p->vstg, p->vardesc.varno);
448	if(p->voffset)
449	s = sprintf(buff, "%s+%o", t, p->voffset);
450	else
451	s = sprintf(buff, "%s", t);
452	break;
453
454	case STGAUTO:
455	s = sprintf(buff, "%o", p->voffset);
456	break;
457
458	default:
459	break;
460	}
461	if(s)
462	fprintf(asmfile, "~%s = %s\n", varstr(VL,p->varname), s);
463	}
464	fprintf(asmfile, "~~:\n");
465	}