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