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.4 (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 5.3 86/01/10 17:12:58 donn
24 * Add junk to handle PARAMETER variables.
25 *
26 * Revision 5.2 86/01/10 13:51:31 donn
27 * Changes to produce correct stab information for logical and logical*2 types
28 * (from Jerry Berkman) plus changes for dummy procedures.
29 *
30 * Revision 5.1 85/08/10 03:50:06 donn
31 * 4.3 alpha
32 *
33 * Revision 1.2 85/02/02 01:30:09 donn
34 * Don't put the 'program' name into the file; it only confuses dbx, sigh.
35 *
36 */
37
38 #include "defs.h"
39
40 #include <sys/types.h>
41 #include <a.out.h>
42 #include <stab.h>
43
44 #define public
45 #define private static
46 #define and &&
47 #define or ||
48 #define not !
49 #define div /
50 #define mod %
51 #define nil 0
52
53 typedef enum { false, true } Boolean;
54
55 static char asmline[128];
56 int len;
57 extern char *malloc();
58
prstab(s,code,type,loc)59 prstab(s, code, type, loc)
60 char *s, *loc;
61 int code, type;
62 {
63 char *locout;
64
65 if (sdbflag) {
66 locout = (loc == nil) ? "0" : loc;
67 if (s == nil) {
68 sprintf(asmline, "\t.stabn\t0x%x,0,0x%x,%s\n", code, type, locout);
69 } else {
70 sprintf(asmline, "\t.stabs\t\"%s\",0x%x,0,0x%x,%s\n", s, code, type,
71 locout);
72 }
73 p2pass( asmline );
74 }
75 }
76
filenamestab(s)77 filenamestab(s)
78 char *s;
79 {
80 sprintf(asmline,"\t.stabs\t\"%s\",0x%x,0,0,0\n", s, N_SO);
81 p2pass( asmline );
82 }
83
linenostab(lineno)84 linenostab(lineno)
85 int lineno;
86 {
87 sprintf(asmline,"\t.stabd\t0x%x,0,%d\n", N_SLINE, lineno);
88 p2pass( asmline );
89 }
90
91 /*
92 * Generate information for an entry point
93 */
94
entrystab(p,class)95 public entrystab(p,class)
96 register struct Entrypoint *p;
97 int class;
98 {
99 int et;
100 Namep q;
101
102 switch(class) {
103 case CLMAIN:
104 et=writestabtype(TYSUBR);
105 sprintf(asmline, "\t.stabs\t\"MAIN:F%2d\",0x%x,0,0,L%d\n",
106 et,N_FUN,p->entrylabel);
107 p2pass(asmline);
108 break;
109
110 case CLBLOCK: /* May need to something with block data LATER */
111 break;
112
113 default :
114 if( (q=p->enamep) == nil) fatal("entrystab has no nameblock");
115 sprintf(asmline, "\t.stabs\t\"%s:F", varstr(VL,q->varname));
116 len = strlen(asmline);
117 /* when insufficient information is around assume TYSUBR; enddcl
118 will fill this in*/
119 if(q->vtype == TYUNKNOWN || (q->vtype == TYCHAR && q->vleng == nil) ){
120 sprintf(asmline+len, "%2d", writestabtype(TYSUBR));
121 }
122 else addtypeinfo(q);
123 len += strlen(asmline+len);
124 sprintf(asmline+len, "\",0x%x,0,0,L%d\n",N_FUN,p->entrylabel);
125 p2pass(asmline);
126 break;
127 }
128 }
129
130 /*
131 * Generate information for a symbol table (name block ) entry.
132 */
133
namestab(sym)134 public namestab(sym)
135 Namep sym;
136 {
137 register Namep p;
138 char *varname, *classname;
139 expptr ep;
140 char buf[100];
141 Boolean ignore;
142 int vartype;
143
144 ignore = false;
145 p = sym;
146 if(!p->vdcldone) return;
147 vartype = p->vtype;
148 varname = varstr(VL, p->varname);
149 switch (p->vclass) {
150 case CLPARAM: /* parameter (constant) */
151 classname = buf;
152 if ((ep = ((struct Paramblock *) p)->paramval) &&
153 ep->tag == TCONST) {
154 switch(ep->constblock.vtype) {
155 case TYLONG:
156 case TYSHORT:
157 case TYLOGICAL:
158 case TYADDR:
159 sprintf(buf, "c=i%d", ep->constblock.constant.ci);
160 break;
161 case TYREAL:
162 case TYDREAL:
163 sprintf(buf, "c=r%f", ep->constblock.constant.cd[0]);
164 break;
165 default:
166 /* punt */
167 ignore = true;
168 break;
169 }
170 } else {
171 ignore = true;
172 }
173 break;
174
175 case CLVAR: /* variable */
176 case CLUNKNOWN:
177 if(p->vstg == STGARG) classname = "v";
178 else classname = "V";
179 break;
180
181 case CLPROC: /* external or function or subroutine */
182 if(p->vstg == STGARG) {
183 classname = "v";
184 break;
185 }
186 /* FALL THROUGH */
187 case CLMAIN: /* main program */
188 case CLENTRY: /* secondary entry point */
189 case CLBLOCK: /* block data name*/
190 ignore = true; /* these are put out by entrystab */
191 break;
192
193
194 }
195 if (not ignore) {
196 sprintf(asmline, "\t.stabs\t\"%s:%s", varname, classname);
197 len = strlen(asmline);
198 addtypeinfo(p);
199 len += strlen(asmline+len);
200 switch(p->vstg) {
201
202 case STGUNKNOWN :
203 case STGCONST :
204 case STGEXT :
205 case STGINTR :
206 case STGSTFUNCT :
207 case STGLENG :
208 case STGNULL :
209 case STGREG :
210 case STGINIT :
211 if (p->vclass == CLPARAM) {
212 /* these have zero storage class for some reason */
213 sprintf(asmline+len, "\",0x%x,0,0,0\n", N_LSYM);
214 break;
215 }
216 sprintf(asmline+len,
217 "\",0x%x,0,0,0 /* don't know how to calc loc for stg %d*/ \n",
218 N_LSYM,p->vstg);
219 break;
220
221 case STGARG :
222 sprintf(asmline+len,"\",0x%x,0,0,%d \n",
223 N_PSYM,p->vardesc.varno + ARGOFFSET );
224 break;
225
226 case STGCOMMON :
227 sprintf(asmline+len, "\",0x%x,0,0,%d\n",
228 N_GSYM, p->voffset);
229 break;
230
231 case STGBSS :
232 sprintf(asmline+len, "\",0x%x,0,0,v.%d\n",
233 (p->inlcomm ? N_LCSYM : N_STSYM),
234 p->vardesc.varno);
235 break;
236
237 case STGEQUIV :
238 sprintf(asmline+len, "\",0x%x,0,0,%s + %d \n",
239 (p->inlcomm ? N_LCSYM : N_STSYM) ,
240 memname(STGEQUIV,p->vardesc.varno),(p->voffset)) ;
241 break;
242
243 case STGAUTO :
244 sprintf(asmline+len, "\",0x%x,0,0,-%d \n",
245 N_LSYM, p->voffset);
246
247 }
248 p2pass(asmline);
249 }
250 }
251
252 static typenum[NTYPES+1]; /* has the given type already been defined ?*/
253
writestabtype(type)254 private writestabtype(type)
255 int type;
256 {
257 char asmline[130];
258 static char *typename[NTYPES+1] = {
259 "unknown", "addr", "integer*2", "integer", "real", "double precision",
260 "complex", "double complex", "logical", "char", "void", "error", "logical*2" };
261
262 static int typerange[NTYPES+1] = { 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12 };
263
264 /* compare with typesize[] in init.c */
265 static int typebounds[2] [NTYPES+1] ={
266 /* "unknown", "addr","integer*2", "integer", "real", "double precision", */
267 { 0 , 0 , -32768, -2147483648, 4, 8,
268 /* "complex", "d-complex", "logical", "char", "void", "error", "logical*2" */
269 8, 16, 4, 0, 0, 0, 2 },
270 /* "unknown", "addr","integer*2", "integer", "real", "double precision", */
271 { 0 , -1, 32767, 2147483647, 0, 0,
272 /* "complex", "d-complex", "logical", "char", "void", "error", "logical*2" */
273 0, 0, 0, 127, 0, 0, 0 }
274 };
275
276
277 if (type < 0 || type > NTYPES)
278 badtype("writestabtype",type);
279
280 /* substitute "logical*2" for "logical" when "-i2" compiler flag used */
281 if (type == TYLOGICAL && tylogical == TYSHORT)
282 type = NTYPES;
283
284 if (typenum[type]) return(typenum[type]);
285 typenum[type] = type;
286 sprintf(asmline, "\t.stabs\t\"%s:t%d=r%d;%ld;%ld;\",0x%x,0,0,0 \n",
287 typename[type], type, typerange[type], typebounds[0][type],
288 typebounds[1][type], N_GSYM) ;
289 p2pass(asmline);
290 return(typenum[type]);
291 }
292
293
getbasenum(p)294 private getbasenum(p)
295 Namep p;
296 {
297
298 int t;
299
300 if (p->vclass == CLPROC && p->vstg == STGARG)
301 t = TYADDR;
302 else
303 t = p->vtype;
304
305 if (t < TYADDR || t > TYSUBR)
306 dclerr("can't get dbx basetype information",p);
307
308 if (p->vtype == TYCHAR || p->vdim != nil)
309 writestabtype(TYINT);
310 return(writestabtype(t));
311 }
312
313 /*
314 * Generate debugging information for the given type of the given symbol.
315 */
316
addtypeinfo(sym)317 private addtypeinfo(sym)
318 Namep sym;
319 {
320 Namep p;
321 int i,tnum;
322 char lb[20],ub[20];
323
324 p = sym;
325 if (p->tag != TNAME) badtag("addtypeinfo",p->tag);
326 if (p->vclass == CLPARAM)
327 return;
328
329 tnum = getbasenum(p);
330 if(p->vdim != (struct Dimblock *) ENULL) {
331
332 for (i = p->vdim->ndim-1; i >=0 ; --i) {
333 if(p->vdim->dims[i].lbaddr == ENULL) {
334 sprintf(lb,"%d", p->vdim->dims[i].lb->constblock.constant.ci);
335 }
336 else {
337 sprintf(lb,"T%d", p->vdim->dims[i].lbaddr->addrblock.memoffset->constblock.constant.ci);
338 }
339 if(p->vdim->dims[i].ubaddr == ENULL) {
340 sprintf(ub,"%d",p->vdim->dims[i].ub->constblock.constant.ci);
341 }
342 else {
343 sprintf(ub,"T%d",p->vdim->dims[i].ubaddr->addrblock.memoffset->constblock.constant.ci);
344 }
345 sprintf(asmline+len, "ar%d;%s;%s;", TYINT, lb, ub);
346 len += strlen(asmline+len);
347 }
348 }
349 if (p->vtype == TYCHAR) {
350 /* character type always an array(1:?) */
351 if( ! (p->vleng ) )
352 fatalstr("missing length in addtypeinfo for character variable %s", varstr(p->varname));
353
354 if (ISCONST(p->vleng)) sprintf(ub,"%d",p->vleng->constblock.constant.ci);
355 else sprintf(ub,"A%d",p->vleng->addrblock.memno + ARGOFFSET);
356
357 sprintf(asmline+len,"ar%d;1;%s;", TYINT, ub);
358 len += strlen(asmline+len);
359 }
360 sprintf(asmline+len, "%d",tnum);
361 }
362