[unix-history] / usr / src / usr.bin / f77 / pass1.tahoe / stab.c

/*
 * Copyright (c) 1980 Regents of the University of California.
 * All rights reserved.  The Berkeley software License Agreement
 * specifies the terms and conditions for redistribution.
 */

#ifndef lint
static char sccsid[] = "@(#)stab.c	5.1 (Berkeley) 6/7/85";
#endif not lint

/*
 * stab.c
 *
 * Symbolic debugging info interface for the f77 compiler.
 *
 * Here we generate pseudo-ops that cause the assembler to put
 * symbolic debugging information into the object file.
 *
 * University of Utah CS Dept modification history:
 *
 * $Log:	stab.c,v $
 * Revision 1.2  85/02/02  01:30:09  donn
 * Don't put the 'program' name into the file; it only confuses dbx, sigh.
 * 
 */

#include "defs.h"

#include <sys/types.h>
#include <a.out.h>
#include <stab.h>

#define public
#define private static
#define and &&
#define or ||
#define not !
#define div /
#define mod %
#define nil 0

typedef enum { false, true } Boolean;

static char asmline[128];
int len;
extern char *malloc();

prstab(s, code, type, loc)
char *s, *loc;
int code, type;
{
    char *locout;

    if (sdbflag) {
	locout = (loc == nil) ? "0" : loc;
	if (s == nil) {
	    sprintf(asmline, "\t.stabn\t0x%x,0,0x%x,%s\n", code, type, locout);
	} else {
	    sprintf(asmline, "\t.stabs\t\"%s\",0x%x,0,0x%x,%s\n", s, code, type,
		locout);
	}
        p2pass( asmline );
    }
}

filenamestab(s)
char *s;
{
   sprintf(asmline,"\t.stabs\t\"%s\",0x%x,0,0,0\n", s, N_SO);
   p2pass( asmline );
}

linenostab(lineno)
int lineno;
{
   sprintf(asmline,"\t.stabd\t0x%x,0,%d\n", N_SLINE, lineno);
   p2pass( asmline );
}

/*
 * Generate information for an entry point
 */

public entrystab(p,class)
register struct Entrypoint *p;
int class;
{
int et;
Namep q;

  switch(class) {
    case CLMAIN: 
        et=writestabtype(TYSUBR);
	sprintf(asmline, "\t.stabs\t\"MAIN:F%2d\",0x%x,0,0,L%d\n",
				et,N_FUN,p->entrylabel);
	p2pass(asmline);
	break;
	
     case CLBLOCK:     /* May need to something with block data LATER */
	break;

     default :
 	if( (q=p->enamep) == nil) fatal("entrystab has no nameblock");
	sprintf(asmline, "\t.stabs\t\"%s:F", varstr(VL,q->varname));
	len = strlen(asmline);
	/* when insufficient information is around assume TYSUBR; enddcl
	   will fill this in*/
	if(q->vtype == TYUNKNOWN || (q->vtype == TYCHAR && q->vleng == nil) ){
           sprintf(asmline+len, "%2d", writestabtype(TYSUBR));
 	}
        else addtypeinfo(q);
	len += strlen(asmline+len);
	sprintf(asmline+len, "\",0x%x,0,0,L%d\n",N_FUN,p->entrylabel);
	p2pass(asmline);
        break;
   }
}

/*
 * Generate information for a symbol table (name block ) entry.
 */

public namestab(sym)
Namep sym;
{
    register Namep p;
    char *varname, *classname;
    Boolean ignore;
    int vartype;

	ignore = false;
	p = sym;
	if(!p->vdcldone) return;
	vartype = p->vtype;
	varname = varstr(VL, p->varname);
	switch (p->vclass) {
	    case CLPARAM:	/* parameter (constant) */
		classname = "c";
		break;

	    case CLVAR:		/* variable */
	    case CLUNKNOWN:   
 		if(p->vstg == STGARG) classname = "v";
    		else classname = "V";
		break;

	    case CLMAIN:	/* main program */
	    case CLENTRY:	/* secondary entry point */
	    case CLBLOCK:       /* block data name*/
	    case CLPROC:	/* external or function or subroutine */
		ignore = true;  /* these are put out by entrystab */
		break;


	}
	if (not ignore) {
	    sprintf(asmline, "\t.stabs\t\"%s:%s", varname, classname);
	    len = strlen(asmline);
            addtypeinfo(p);
	    len += strlen(asmline+len);
	    switch(p->vstg) {

	      case STGUNKNOWN :
	      case STGCONST :
	      case STGEXT :
	      case STGINTR :
	      case STGSTFUNCT :
	      case STGLENG :
	      case STGNULL :
	      case STGREG :
	      case STGINIT :
	          sprintf(asmline+len,
		  "\",0x%x,0,0,0 /* don't know how to calc loc for stg %d*/ \n",
			       N_LSYM,p->vstg);
		  break;

	      case STGARG :
		  sprintf(asmline+len,"\",0x%x,0,0,%d \n",
			      N_PSYM,p->vardesc.varno + ARGOFFSET );
		  break;

	      case STGCOMMON :
		  sprintf(asmline+len, "\",0x%x,0,0,%d\n", 
		       N_GSYM, p->voffset);
		  break;

	      case STGBSS :
		  sprintf(asmline+len, "\",0x%x,0,0,v.%d\n",
		     	 (p->inlcomm ? N_LCSYM : N_STSYM), 
                         p->vardesc.varno);
		  break;

	      case STGEQUIV :
		  sprintf(asmline+len, "\",0x%x,0,0,%s + %d \n",
		     	 (p->inlcomm ? N_LCSYM : N_STSYM) , 
                         memname(STGEQUIV,p->vardesc.varno),(p->voffset)) ;
		  break;

	      case STGAUTO :
		  sprintf(asmline+len, "\",0x%x,0,0,-%d \n",
		     	N_LSYM, p->voffset);

	    }
	    p2pass(asmline);       
	}
}

static typenum[NTYPES]; /* has the given type already been defined ?*/

private writestabtype(type)
int type;
{
 char asmline[130];
 static char *typename[NTYPES] =
 { "unknown", "addr","integer*2", "integer", "real", "double precision",
   "complex", "double complex", "logical", "char", "void", "error" };

 static int typerange[NTYPES] = { 0, 3, 2, 3, 4, 5, 6, 7, 3, 9, 10, 11 };

 /* compare with typesize[] in init.c */
 static int typebounds[2] [NTYPES] ={
 /* "unknown", "addr","integer*2", "integer",    "real", "double precision", */
    { 0      ,   0   ,   -32768,    -2147483648,   4,       8,
 /* "complex", "double complex", "logical", "char", "void", "error" }; */
      8,         16,               0,        0,       0,          0 },
 /* "unknown", "addr","integer*2", "integer",    "real", "double precision", */
    { 0  ,       -1,      32767,    2147483647,   0,         0,
 /* "complex", "double complex", "logical", "char", "void", "error" }; */
      0,         0,               1,        127,       0,          0 }
 };
                    

 if( type < 0 || type > NTYPES) badtype("writestabtype",type);

    if (typenum[type]) return(typenum[type]);
    typenum[type] = type;
    sprintf(asmline, "\t.stabs\t\"%s:t%d=r%d;%ld;%ld;\",0x%x,0,0,0 \n", 
	typename[type], type, typerange[type], typebounds[0][type], 
        typebounds[1][type], N_GSYM) ;
    p2pass(asmline);
    return(typenum[type]);
}


private getbasenum(p)
Namep p;
{

  int t;
  t = p->vtype;
  if( t < TYSHORT || t > TYSUBR)
  dclerr("can't get dbx basetype information",p);

  if (p->vtype == TYCHAR || p->vdim != nil ) writestabtype(TYINT);
  return(writestabtype(t));
}

/*
 * Generate debugging information for the given type of the given symbol.
 */

private addtypeinfo(sym)
Namep sym;
{
    Namep p;
    int i,tnum;
    char lb[20],ub[20];

    p = sym;
    if (p->tag != TNAME) badtag("addtypeinfo",p->tag);

    tnum = getbasenum(p);
    if(p->vdim != (struct Dimblock *) ENULL) {
    
      for (i = p->vdim->ndim-1; i >=0 ; --i) { 
         if(p->vdim->dims[i].lbaddr == ENULL) {
	      sprintf(lb,"%d", p->vdim->dims[i].lb->constblock.const.ci);
	 }
	 else  { 
	      sprintf(lb,"T%d", p->vdim->dims[i].lbaddr->addrblock.memoffset->constblock.const.ci);
         }
         if(p->vdim->dims[i].ubaddr == ENULL) {
	      sprintf(ub,"%d",p->vdim->dims[i].ub->constblock.const.ci);
	 }
	 else  {
	      sprintf(ub,"T%d",p->vdim->dims[i].ubaddr->addrblock.memoffset->constblock.const.ci);
         }
       	 sprintf(asmline+len, "ar%d;%s;%s;", TYINT, lb, ub);
	 len += strlen(asmline+len);
     }
   }
    if (p->vtype == TYCHAR) {
    /* character type always an array(1:?) */
        if( ! (p->vleng ) )
           fatalstr("missing length in addtypeinfo for character variable %s", varstr(p->varname));

        if (ISCONST(p->vleng)) sprintf(ub,"%d",p->vleng->constblock.const.ci);
         else sprintf(ub,"A%d",p->vleng->addrblock.memno + ARGOFFSET);

	sprintf(asmline+len,"ar%d;1;%s;", TYINT, ub);
	len += strlen(asmline+len);
    }
    sprintf(asmline+len, "%d",tnum);
}
Commit	Line	Data
1364805a KB	1	/*
	2	* Copyright (c) 1980 Regents of the University of California.
	3	* All rights reserved. The Berkeley software License Agreement
	4	* specifies the terms and conditions for redistribution.
	5	*/
	6
	7	#ifndef lint
	8	static char sccsid[] = "@(#)stab.c 5.1 (Berkeley) 6/7/85";
	9	#endif not lint
	10
	11	/*
	12	* stab.c
	13	*
	14	* Symbolic debugging info interface for the f77 compiler.
	15	*
	16	* Here we generate pseudo-ops that cause the assembler to put
	17	* symbolic debugging information into the object file.
	18	*
	19	* University of Utah CS Dept modification history:
	20	*
	21	* $Log: stab.c,v $
	22	* Revision 1.2 85/02/02 01:30:09 donn
	23	* Don't put the 'program' name into the file; it only confuses dbx, sigh.
	24	*
	25	*/
	26
	27	#include "defs.h"
	28
	29	#include <sys/types.h>
	30	#include <a.out.h>
	31	#include <stab.h>
	32
	33	#define public
	34	#define private static
	35	#define and &&
	36	#define or \|\|
	37	#define not !
	38	#define div /
	39	#define mod %
	40	#define nil 0
	41
	42	typedef enum { false, true } Boolean;
	43
	44	static char asmline[128];
	45	int len;
	46	extern char *malloc();
	47
	48	prstab(s, code, type, loc)
	49	char s, loc;
	50	int code, type;
	51	{
	52	char *locout;
	53
	54	if (sdbflag) {
	55	locout = (loc == nil) ? "0" : loc;
	56	if (s == nil) {
	57	sprintf(asmline, "\t.stabn\t0x%x,0,0x%x,%s\n", code, type, locout);
	58	} else {
	59	sprintf(asmline, "\t.stabs\t\"%s\",0x%x,0,0x%x,%s\n", s, code, type,
	60	locout);
	61	}
	62	p2pass( asmline );
	63	}
	64	}
65
66	filenamestab(s)
67	char *s;
68	{
69	sprintf(asmline,"\t.stabs\t\"%s\",0x%x,0,0,0\n", s, N_SO);
70	p2pass( asmline );
71	}
72
73	linenostab(lineno)
74	int lineno;
75	{
76	sprintf(asmline,"\t.stabd\t0x%x,0,%d\n", N_SLINE, lineno);
77	p2pass( asmline );
78	}
79
80	/*
81	* Generate information for an entry point
82	*/
83
84	public entrystab(p,class)
85	register struct Entrypoint *p;
86	int class;
87	{
88	int et;
89	Namep q;
90
91	switch(class) {
92	case CLMAIN:
93	et=writestabtype(TYSUBR);
94	sprintf(asmline, "\t.stabs\t\"MAIN:F%2d\",0x%x,0,0,L%d\n",
95	et,N_FUN,p->entrylabel);
96	p2pass(asmline);
97	break;
98
99	case CLBLOCK: /* May need to something with block data LATER */
100	break;
101
102	default :
103	if( (q=p->enamep) == nil) fatal("entrystab has no nameblock");
104	sprintf(asmline, "\t.stabs\t\"%s:F", varstr(VL,q->varname));
105	len = strlen(asmline);
106	/* when insufficient information is around assume TYSUBR; enddcl
107	will fill this in*/
108	if(q->vtype == TYUNKNOWN \|\| (q->vtype == TYCHAR && q->vleng == nil) ){
109	sprintf(asmline+len, "%2d", writestabtype(TYSUBR));
110	}
111	else addtypeinfo(q);
112	len += strlen(asmline+len);
113	sprintf(asmline+len, "\",0x%x,0,0,L%d\n",N_FUN,p->entrylabel);
114	p2pass(asmline);
115	break;
116	}
117	}
118
119	/*
120	* Generate information for a symbol table (name block ) entry.
121	*/
122
123	public namestab(sym)
124	Namep sym;
125	{
126	register Namep p;
127	char varname, classname;
128	Boolean ignore;
129	int vartype;
130
131	ignore = false;
132	p = sym;
133	if(!p->vdcldone) return;
134	vartype = p->vtype;
135	varname = varstr(VL, p->varname);
136	switch (p->vclass) {
137	case CLPARAM: /* parameter (constant) */
138	classname = "c";
139	break;
140
141	case CLVAR: /* variable */
142	case CLUNKNOWN:
143	if(p->vstg == STGARG) classname = "v";
144	else classname = "V";
145	break;
146
147	case CLMAIN: /* main program */
148	case CLENTRY: /* secondary entry point */
149	case CLBLOCK: /* block data name*/
150	case CLPROC: /* external or function or subroutine */
151	ignore = true; /* these are put out by entrystab */
152	break;
153
154
155	}
156	if (not ignore) {
157	sprintf(asmline, "\t.stabs\t\"%s:%s", varname, classname);
158	len = strlen(asmline);
159	addtypeinfo(p);
160	len += strlen(asmline+len);
161	switch(p->vstg) {
162
163	case STGUNKNOWN :
164	case STGCONST :
165	case STGEXT :
166	case STGINTR :
167	case STGSTFUNCT :
168	case STGLENG :
169	case STGNULL :
170	case STGREG :
171	case STGINIT :
172	sprintf(asmline+len,
173	"\",0x%x,0,0,0 /* don't know how to calc loc for stg %d*/ \n",
174	N_LSYM,p->vstg);
175	break;
176
177	case STGARG :
178	sprintf(asmline+len,"\",0x%x,0,0,%d \n",
179	N_PSYM,p->vardesc.varno + ARGOFFSET );
180	break;
181
182	case STGCOMMON :
183	sprintf(asmline+len, "\",0x%x,0,0,%d\n",
184	N_GSYM, p->voffset);
185	break;
186
187	case STGBSS :
188	sprintf(asmline+len, "\",0x%x,0,0,v.%d\n",
189	(p->inlcomm ? N_LCSYM : N_STSYM),
190	p->vardesc.varno);
191	break;
192
193	case STGEQUIV :
194	sprintf(asmline+len, "\",0x%x,0,0,%s + %d \n",
195	(p->inlcomm ? N_LCSYM : N_STSYM) ,
196	memname(STGEQUIV,p->vardesc.varno),(p->voffset)) ;
197	break;
198
199	case STGAUTO :
200	sprintf(asmline+len, "\",0x%x,0,0,-%d \n",
201	N_LSYM, p->voffset);
202
203	}
204	p2pass(asmline);
205	}
206	}
207
208	static typenum[NTYPES]; /* has the given type already been defined ?*/
209
210	private writestabtype(type)
211	int type;
212	{
213	char asmline[130];
214	static char *typename[NTYPES] =
215	{ "unknown", "addr","integer*2", "integer", "real", "double precision",
216	"complex", "double complex", "logical", "char", "void", "error" };
217
218	static int typerange[NTYPES] = { 0, 3, 2, 3, 4, 5, 6, 7, 3, 9, 10, 11 };
219
220	/* compare with typesize[] in init.c */
221	static int typebounds[2] [NTYPES] ={
222	/* "unknown", "addr","integer2", "integer", "real", "double precision", /
223	{ 0 , 0 , -32768, -2147483648, 4, 8,
224	/* "complex", "double complex", "logical", "char", "void", "error" }; */
225	8, 16, 0, 0, 0, 0 },
226	/* "unknown", "addr","integer2", "integer", "real", "double precision", /
227	{ 0 , -1, 32767, 2147483647, 0, 0,
228	/* "complex", "double complex", "logical", "char", "void", "error" }; */
229	0, 0, 1, 127, 0, 0 }
230	};
231
232
233	if( type < 0 \|\| type > NTYPES) badtype("writestabtype",type);
234
235	if (typenum[type]) return(typenum[type]);
236	typenum[type] = type;
237	sprintf(asmline, "\t.stabs\t\"%s:t%d=r%d;%ld;%ld;\",0x%x,0,0,0 \n",
238	typename[type], type, typerange[type], typebounds[0][type],
239	typebounds[1][type], N_GSYM) ;
240	p2pass(asmline);
241	return(typenum[type]);
242	}
243
244
245	private getbasenum(p)
246	Namep p;
247	{
248
249	int t;
250	t = p->vtype;
251	if( t < TYSHORT \|\| t > TYSUBR)
252	dclerr("can't get dbx basetype information",p);
253
254	if (p->vtype == TYCHAR \|\| p->vdim != nil ) writestabtype(TYINT);
255	return(writestabtype(t));
256	}
257
258	/*
259	* Generate debugging information for the given type of the given symbol.
260	*/
261
262	private addtypeinfo(sym)
263	Namep sym;
264	{
265	Namep p;
266	int i,tnum;
267	char lb[20],ub[20];
268
269	p = sym;
270	if (p->tag != TNAME) badtag("addtypeinfo",p->tag);
271
272	tnum = getbasenum(p);
273	if(p->vdim != (struct Dimblock *) ENULL) {
274
275	for (i = p->vdim->ndim-1; i >=0 ; --i) {
276	if(p->vdim->dims[i].lbaddr == ENULL) {
277	sprintf(lb,"%d", p->vdim->dims[i].lb->constblock.const.ci);
278	}
279	else {
280	sprintf(lb,"T%d", p->vdim->dims[i].lbaddr->addrblock.memoffset->constblock.const.ci);
281	}
282	if(p->vdim->dims[i].ubaddr == ENULL) {
283	sprintf(ub,"%d",p->vdim->dims[i].ub->constblock.const.ci);
284	}
285	else {
286	sprintf(ub,"T%d",p->vdim->dims[i].ubaddr->addrblock.memoffset->constblock.const.ci);
287	}
288	sprintf(asmline+len, "ar%d;%s;%s;", TYINT, lb, ub);
289	len += strlen(asmline+len);
290	}
291	}
292	if (p->vtype == TYCHAR) {
293	/* character type always an array(1:?) */
294	if( ! (p->vleng ) )
295	fatalstr("missing length in addtypeinfo for character variable %s", varstr(p->varname));
296
297	if (ISCONST(p->vleng)) sprintf(ub,"%d",p->vleng->constblock.const.ci);
298	else sprintf(ub,"A%d",p->vleng->addrblock.memno + ARGOFFSET);
299
300	sprintf(asmline+len,"ar%d;1;%s;", TYINT, ub);
301	len += strlen(asmline+len);
302	}
303	sprintf(asmline+len, "%d",tnum);
304	}