Subversion Repositories tendra.SVN

Rev

Go to most recent revision | Details | Last modification | View Log | RSS feed

Rev Author Line No. Line
2 7u83 1 
/*
2 
    		 Crown Copyright (c) 1997
3 
 
4 
    This TenDRA(r) Computer Program is subject to Copyright
5 
    owned by the United Kingdom Secretary of State for Defence
6 
    acting through the Defence Evaluation and Research Agency
7 
    (DERA).  It is made available to Recipients with a
8 
    royalty-free licence for its use, reproduction, transfer
9 
    to other parties and amendment for any purpose not excluding
10 
    product development provided that any such use et cetera
11 
    shall be deemed to be acceptance of the following conditions:-
12 
 
13 
        (1) Its Recipients shall ensure that this Notice is
14 
        reproduced upon any copies or amended versions of it;
15 
 
16 
        (2) Any amended version of it shall be clearly marked to
17 
        show both the nature of and the organisation responsible
18 
        for the relevant amendment or amendments;
19 
 
20 
        (3) Its onward transfer from a recipient to another
21 
        party shall be deemed to be that party's acceptance of
22 
        these conditions;
23 
 
24 
        (4) DERA gives no warranty or assurance as to its
25 
        quality or suitability for any purpose and DERA accepts
26 
        no liability whatsoever in relation to any use to which
27 
        it may be put.
28 
*/
29 
 
30 
 
31 
/* freebsd/diag_out.c */
32 
 
33 
#include "config.h"
34 
#include "common_types.h"
35 
#include "basicread.h"
36 
#include "out.h"
37 
#include "machine.h"
38 
#include "shapemacs.h"
39 
#include "expmacs.h"
40 
#include "tags.h"
41 
#include "szs_als.h"
42 
#include "diagglob.h"
43 
#include "xalloc.h"
44 
#include "exp.h"
45 
#include "mark_scope.h"
46 
#include "externs.h"
47 
#ifdef NEWDIAGS
48 
#include "codermacs.h"
49 
#include "instr.h"
50 
#endif
51 
 
52 
 
53 
 
54 
/*
55 
    FORWARD DECLARATIONS
56 
*/
57 
 
58 
static void stab_scope_open PROTO_S ( ( long ) ) ;
59 
static void stab_scope_close PROTO_S ( ( long ) ) ;
60 
static void stab_file PROTO_S ( ( long, bool ) ) ;
61 
static void stab_local PROTO_S ( ( diag_info *, int, exp ) ) ;
62 
static void stab_types PROTO_S ( ( void ) ) ;
63 
 
64 
 
65 
 
66 
 
67 
/*
68 
    DIAGNOSTICS FILE
69 
*/
70 
 
71 
static FILE *dg_file ;
72 
static char *dg_file_name ;
73 
 
74 
 
75 
/*
76 
    BASIC TYPE NUMBERS
77 
*/
78 
 
79 
#define STAB_SCHAR	4
80 
#define STAB_UCHAR	6
81 
#define STAB_SSHRT	2
82 
#define STAB_USHRT	3
83 
#define STAB_SLONG	1
84 
#define STAB_ULONG	8
85 
#define STAB_FLOAT	10
86 
#define STAB_DBL	11
87 
#define STAB_LDBL	12
88 
#define STAB_VOID	13
89 
#define STAB_S64	14
90 
#define STAB_U64	15
91 
#define NO_STABS	16
92 
 
93 
 
94 
/*
95 
    80x86 register numbers
96 
*/
97 
 
98 
#ifdef NEWDIAGS
99 
static long reg_stabno [8] = {0, 2, 1, 3, 7, 6, 5, 4};
100 
#endif
101 
 
102 
/*
103 
    BASIC POINTERS
104 
*/
105 
 
106 
static long stab_ptrs [ NO_STABS ] = {
107 
    0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0
108 
} ;
109 
 
110 
 
111 
/*
112 
    CURRENT TYPE NUMBER
113 
*/
114 
 
115 
static long typeno ;
116 
 
117 
 
118 
/*
119 
    SIZE OF LAST STAB TYPE OUTPUT
120 
*/
121 
 
122 
static long last_type_sz = 0 ;
123 
 
124 
 
125 
/*
126 
    CURRENT LINE NUMBER AND FILE NUMBER
127 
*/
128 
 
129 
long currentlno = -1 ;
130 
long currentfile = -1 ;
131 
 
132 
 
133 
/*
134 
    ARRAY OF TYPE SIZES
135 
*/
136 
 
137 
static long *type_sizes ;
138 
static int total_type_sizes = 0 ;
139 
 
140 
 
141 
/*
142 
    SETTING AND GETTING TYPE SIZES
143 
*/
144 
 
145 
#define set_stab_size( i )	type_sizes [ ( i ) ] = last_type_sz
146 
#define get_stab_size( i )	( type_sizes [ ( i ) ] )
147 
 
148 
 
149 
/*
150 
    GET THE NEXT TYPE NUMBER
151 
*/
152 
 
153 
static long next_typen
154 
    PROTO_Z ()
155 
{
156 
    if ( typeno >= total_type_sizes ) {
157 
	int i, n = total_type_sizes, m = n + 100 ;
158 
	type_sizes = ( long * ) xrealloc ( (void*)(CH type_sizes),
159 
					m * sizeof ( long ) ) ;
160 
	for ( i = n ; i < m ; i++ ) type_sizes [i] = 0 ;
161 
	total_type_sizes = m ;
162 
    }
163 
    return ( typeno++ ) ;
164 
}
165 
 
166 
 
167 
/*
168 
    ARRAY OF FILE DESCRIPTORS
169 
*/
170 
 
171 
static filename *fds = NULL ;
172 
static int szfds = 0 ;
173 
static int nofds = 0 ;
174 
 
175 
 
176 
/*
177 
    ADD A NEW FILE TO THE ARRAY OF FILE DESCRIPTORS
178 
*/
179 
 
180 
void stab_collect_files
181 
    PROTO_N ( (f) )
182 
    PROTO_T ( filename f )
183 
{
184 
    if ( fds == NULL ) {
185 
	szfds += 10 ;
186 
	fds = ( filename * ) xmalloc ( szfds * sizeof ( filename ) ) ;
187 
    } else if ( nofds >= szfds ) {
188 
	szfds += 10 ;
189 
	fds = ( filename * ) xrealloc ( (void*)(CH fds),
190 
				szfds * sizeof ( filename ) ) ;
191 
    }
192 
    fds [ nofds++ ] = f ;
193 
    return ;
194 
}
195 
 
196 
 
197 
/*
198 
    FIND THE FILE DESCRIPTOR CORRESPONDING TO A FILE NAME
199 
*/
200 
 
201 
static long find_file
202 
    PROTO_N ( (f) )
203 
    PROTO_T ( char * f )
204 
{
205 
    long i ;
206 
    for ( i = 0 ; i < nofds ; i++ ) {
207 
	if ( strcmp ( f, fds [i]->file.ints.chars ) == 0 ) return ( i ) ;
208 
    }
209 
    return ( 0 ) ;
210 
}
211 
 
212 
 
213 
static int last_proc_cname;
214 
static char * last_proc_pname;
215 
static int in_proc = 0;
216 
 
217 
static void out_procname
218 
    PROTO_Z ()
219 
{
220 
  if (last_proc_cname == -1) {
221 
    outs (last_proc_pname);
222 
  }
223 
  else {
224 
    outs(local_prefix);
225 
    outn ((long)last_proc_cname);
226 
  };
227 
}
228 
 
229 
 
230 
/*
231 
    OUTPUT A FILE POSITION CONSTRUCT
232 
*/
233 
 
234 
#define N_SLINE 0x44
235 
#define N_DSLINE 0x46
236 
#define N_BSLINE 0x48
237 
#define N_LBRAC  0xc0
238 
#define N_RBRAC  0xe0
239 
 
240 
static void stabd
241 
    PROTO_N ( (findex, lno, seg) )
242 
    PROTO_T ( long findex X long lno X int seg )
243 
{
244 
    long i ;
245 
 
246 
    if ( findex == currentfile && lno == currentlno ) return ;
247 
    stab_file ( findex, 1 ) ;
248 
 
249 
    if (seg != 0)		/* 0 suppresses always */
250 
    {
251 
      if (seg < 0)
252 
	seg = - seg;
253 
      if (seg > 0)		/* -ve line nos are put out in the stabs */
254 
      {
255 
	i = next_lab () ;
256 
	fprintf ( dg_file, "%sL.%ld:\n", local_prefix, i ) ;
257 
	fprintf ( dg_file, "\t.stabn\t0x%x,0,%ld,%sL.%ld",seg, lno, local_prefix, i ) ;
258 
	outnl ();
259 
      }
260 
    }
261 
    currentlno = lno ;
262 
    return ;
263 
}
264 
 
265 
 
266 
#ifdef NEWDIAGS
267 
/*
268 
    OUTPUT DIAGNOSTICS SURROUNDING CODE
269 
*/
270 
 
271 
void code_diag_info
272 
    PROTO_N ( (d, proc_no, mcode, args) )
273 
    PROTO_T ( diag_info * d X int proc_no X void (*mcode) PROTO_S ((void *)) X void * args )
274 
{
275 
  if (d == nildiag) {
276 
    (*mcode)(args);
277 
    return;
278 
  }
279 
  switch (d->key) {
280 
    case DIAG_INFO_SCOPE: {
281 
	stab_scope_open ( currentfile ) ;
282 
	stabd ( currentfile, ( long ) ( currentlno + 1 ), N_SLINE ) ;
283 
	code_diag_info (d->more, proc_no, mcode, args);
284 
	stab_scope_close ( currentfile ) ;
285 
	return;
286 
    }
287 
    case DIAG_INFO_SOURCE: {
288 
	sourcemark *s = &d->data.source.beg ;
289 
	long f = find_file ( s->file->file.ints.chars ) ;
290 
	stabd ( f, ( long ) s->line_no.nat_val.small_nat ,N_SLINE) ;
291 
	code_diag_info (d->more, proc_no, mcode, args);
292 
	s = &d->data.source.end ;
293 
	f = find_file ( s->file->file.ints.chars ) ;
294 
	stabd ( f, ( long ) s->line_no.nat_val.small_nat ,N_SLINE) ;
295 
	return;
296 
    }
297 
    case DIAG_INFO_ID: {
298 
	exp acc = d -> data.id_scope.access;
299 
	if (name(acc) != hold_tag)
300 
	  failer("not hold_tag");
301 
	acc = son(acc);
302 
	if (name(acc) == cont_tag && name(son(acc)) == name_tag && isvar(son(son(acc))))
303 
	  acc = son(acc);
304 
	if ( ( name(acc) == name_tag && !isdiscarded(acc) && !isglob(son(acc)) ) ||
305 
		name(acc) == val_tag )
306 
	  stab_local ( d, proc_no, acc );
307 
	code_diag_info (d->more, proc_no, mcode, args);
308 
    }
309 
  };
310 
  return;
311 
}
312 
 
313 
 
314 
#else
315 
 
316 
/*
317 
    OUTPUT INITIAL DIAGNOSTICS FOR A DIAGNOSE_TAG
318 
*/
319 
 
320 
void output_diag
321 
    PROTO_N ( (d, proc_no, e) )
322 
    PROTO_T ( diag_info * d X int proc_no X exp e )
323 
{
324 
  if ( d->key == DIAG_INFO_SOURCE ) {
325 
    sourcemark *s = &d->data.source.beg ;
326 
    long f = find_file ( s->file->file.ints.chars ) ;
327 
    stabd ( f, ( long ) s->line_no.nat_val.small_nat ,N_SLINE) ;
328 
    return ;
329 
  }
330 
 
331 
  if (d -> key == DIAG_INFO_ID) {
332 
    exp acc = d -> data.id_scope.access;
333 
 
334 
    if ( isglob ( son ( acc ) ) || no ( son ( acc ) ) == 1 ) return;
335 
    mark_scope(e);
336 
 
337 
    if ( props ( e ) & 0x80 ) {
338 
      stab_scope_open ( currentfile ) ;
339 
      stabd ( currentfile, ( long ) ( currentlno + 1 ), N_SLINE ) ;
340 
    }
341 
 
342 
    stab_local ( d, proc_no, acc );
343 
    return ;
344 
  }
345 
}
346 
 
347 
 
348 
/*
349 
    OUTPUT FINAL DIAGNOSTICS FOR A DIAGNOSE_TAG
350 
*/
351 
 
352 
void output_end_scope
353 
    PROTO_N ( (d, e) )
354 
    PROTO_T ( diag_info * d X exp e )
355 
{
356 
    if ( d->key == DIAG_INFO_SOURCE ) {
357 
	sourcemark *s = &d->data.source.end ;
358 
	long f = find_file ( s->file->file.ints.chars ) ;
359 
	long lno = s->line_no.nat_val.small_nat ;
360 
	stabd ( f, lno, N_SLINE) ;
361 
	return ;
362 
    }
363 
    if ( d->key == DIAG_INFO_ID && props ( e ) & 0x80 ) {
364 
	stab_scope_close ( currentfile ) ;
365 
	return ;
366 
    }
367 
    return ;
368 
}
369 
 
370 
 
371 
#endif
372 
/*
373 
    INITIALISE DIAGNOSTICS
374 
*/
375 
 
376 
void out_diagnose_prelude
377 
    PROTO_Z ()
378 
{
379 
    dg_file_name = tmpnam ( NULL ) ;
380 
    dg_file = fopen ( dg_file_name, "w" ) ;
381 
    if ( dg_file == NULL ) {
382 
	failer ( "Can't open temporary diagnostics file" ) ;
383 
	exit (EXIT_FAILURE) ;
384 
    }
385 
    stab_types () ;
386 
    return ;
387 
}
388 
 
389 
 
390 
/*
391 
    INITIALIZE DIAGNOSTICS
392 
*/
393 
 
394 
void init_stab_aux
395 
    PROTO_Z ()
396 
{
397 
    int c ;
398 
    FILE *f ;
399 
    int i, j = -1 ;
400 
    for ( i = 0 ; i < nofds ; i++ ) {
401 
	char *s = fds [i]->file.ints.chars ;
402 
	int n = ( int ) strlen ( s ) ;
403 
	if ( n && s [ n - 1 ] != 'h' ) j = i ;
404 
    }
405 
    fclose ( dg_file ) ;
406 
    dg_file = fpout ;
407 
    if (j >= 0)
408 
	fprintf (dg_file, "\t.file\t\"%s\"\n", fds[j]->file.ints.chars) ;
409 
    else
410 
	fprintf (dg_file, "\t.file\t\"no_source_file\"\n") ;
411 
    stab_file ( ( long ) j, 0 ) ;
412 
    f = fopen ( dg_file_name, "r" ) ;
413 
    if ( f == NULL ) {
414 
	failer ( "Can't open temporary diagnostics file" ) ;
415 
	exit (EXIT_FAILURE) ;
416 
    }
417 
    while ( c = fgetc ( f ), c != EOF ) outc ( c ) ;
418 
    fclose ( f ) ;
419 
    remove ( dg_file_name ) ;
420 
    return ;
421 
}
422 
 
423 
void out_diagnose_postlude
424 
    PROTO_Z ()
425 
{
426 
    long i = next_lab () ;
427 
    fprintf ( dg_file, ".text\n" ) ;
428 
    fprintf ( dg_file, "%sL.%ld:\n", local_prefix, i ) ;
429 
    fprintf ( dg_file, "\t.stabs\t\"\",0x64,0,0,%sL.%ld\n", local_prefix, i ) ;
430 
    return ;
431 
}
432 
 
433 
 
434 
/*
435 
    FIND THE STAB OF A SIMPLE SHAPE
436 
*/
437 
 
438 
static long out_sh_type
439 
    PROTO_N ( (s) )
440 
    PROTO_T ( shape s )
441 
{
442 
    last_type_sz = shape_size ( s ) ;
443 
    switch ( name ( s ) ) {
444 
	case scharhd : return ( STAB_SCHAR ) ;
445 
	case ucharhd : return ( STAB_UCHAR ) ;
446 
	case swordhd : return ( STAB_SSHRT ) ;
447 
	case uwordhd : return ( STAB_USHRT ) ;
448 
	case slonghd : return ( STAB_SLONG ) ;
449 
	case ulonghd : return ( STAB_ULONG ) ;
450 
	case s64hd : return ( STAB_S64 ) ;
451 
	case u64hd : return ( STAB_U64 ) ;
452 
	case shrealhd : return ( STAB_FLOAT ) ;
453 
	case realhd : return ( STAB_DBL ) ;
454 
	case doublehd : return ( STAB_LDBL ) ;
455 
    }
456 
    return ( STAB_VOID ) ;
457 
}
458 
 
459 
 
460 
/*
461 
    OUTPUT DIAGNOSTICS DIRECTIVE FOR A FILE
462 
*/
463 
 
464 
static void stab_file
465 
    PROTO_N ( (findex, internal) )
466 
    PROTO_T ( long findex X bool internal )
467 
{
468 
    static long i = 0 ;
469 
 
470 
    if ( findex == currentfile || findex < 0 || findex >= szfds ) {
471 
	return ;
472 
    }
473 
 
474 
    if ( !internal ) {
475 
	/* source file */
476 
	i = next_lab () ;
477 
	fprintf ( dg_file, "%sL.%ld:\n", local_prefix, i ) ;
478 
	fprintf ( dg_file, "\t.stabs\t\"%s\",0x64,0,0,%sL.%ld\n",
479 
		  fds [ findex ]->file.ints.chars, local_prefix, i ) ;
480 
    } else {
481 
	/* included file */
482 
	fprintf ( dg_file, "\t.stabs\t\"%s\",0x84,0,0,%sL.%ld\n",
483 
		  fds [ findex ]->file.ints.chars, local_prefix, i ) ;
484 
    }
485 
    currentfile = findex ;
486 
    return ;
487 
}
488 
 
489 
 
490 
/*
491 
    ARRAY OF DIAGNOSTIC SCOPES
492 
*/
493 
 
494 
static long open_label = 0 ;
495 
static long bracket_level = 0 ;
496 
 
497 
 
498 
/*
499 
    START OF A DIAGNOSTICS SCOPE
500 
*/
501 
 
502 
static void stab_scope_open
503 
    PROTO_N ( (findex) )
504 
    PROTO_T ( long findex )
505 
{
506 
    long i ;
507 
    stab_file ( findex, 1 ) ;
508 
    if ( open_label != 0 )
509 
    {
510 
	fprintf ( dg_file, "\t.stabn\t0x%x,0,%ld,%sL.%ld\n", N_LBRAC,
511 
		  bracket_level, local_prefix, open_label ) ;
512 
    }
513 
    i = next_lab () ;
514 
    fprintf ( dg_file, "%sL.%ld:\n", local_prefix, i ) ;
515 
    bracket_level++ ;
516 
    open_label = i ;
517 
    return ;
518 
}
519 
 
520 
 
521 
/*
522 
    END OF A DIAGNOSTICS SCOPE
523 
*/
524 
 
525 
static void stab_scope_close
526 
    PROTO_N ( (findex) )
527 
    PROTO_T ( long findex )
528 
{
529 
    long i ;
530 
    if ( open_label != 0 )
531 
    {
532 
	fprintf ( dg_file, "\t.stabn\t0x%x,0,%ld,%sL.%ld\n", N_LBRAC,
533 
		  bracket_level, local_prefix, open_label ) ;
534 
	open_label = 0 ;
535 
    }
536 
    i = next_lab () ;
537 
    fprintf ( dg_file, "%sL.%ld:\n", local_prefix, i ) ;
538 
    fprintf ( dg_file, "\t.stabn\t0x%x,0,%ld,%sL.%ld\n", N_RBRAC,
539 
		  bracket_level, local_prefix, i ) ;
540 
    bracket_level-- ;
541 
    return ;
542 
}
543 
 
544 
 
545 
/*
546 
    DEPTH COUNT FOR STAB TYPES
547 
*/
548 
 
549 
static int max_depth = 64 ;
550 
static int depth_now = 0 ;
551 
 
552 
 
553 
/*
554 
    OUTPUT A DIAGNOSTICS TYPE
555 
*/
556 
 
557 
#define OUT_DT_SHAPE( dt )	out_dt_shape ( ( depth_now = 0, dt ) )
558 
 
559 
static void out_dt_shape
560 
    PROTO_N ( (dt) )
561 
    PROTO_T ( diag_type dt )
562 
{
563 
    if ( dt->been_outed ) {
564 
	fprintf ( dg_file, "%d",(int) dt->been_outed ) ;
565 
	last_type_sz = get_stab_size ( dt->been_outed ) ;
566 
	return ;
567 
    }
568 
 
569 
    /* SunOS as(1) rejects stab lines >2k so reduce size arbitrarily */
570 
    if ( depth_now >= max_depth ) {
571 
	fprintf ( dg_file, "%d", STAB_SLONG ) ;
572 
	return ;
573 
    }
574 
    depth_now++ ;
575 
 
576 
    switch ( dt->key ) {
577 
 
578 
	case DIAG_TYPE_PTR : {
579 
	    long non ;
580 
	    diag_type pdt = dt->data.ptr.object ;
581 
	    if ( pdt->key == DIAG_TYPE_VARIETY ) {
582 
		long pn = out_sh_type ( f_integer ( pdt->data.var ) ) ;
583 
		non = stab_ptrs [ pn ] ;
584 
		if ( non == 0 ) {
585 
		    non = next_typen () ;
586 
		    stab_ptrs [ pn ] = non ;
587 
		    fprintf ( dg_file, "%ld=*%ld", non, pn ) ;
588 
		} else {
589 
		    fprintf ( dg_file, "%ld", non ) ;
590 
		}
591 
	    } else {
592 
		non = next_typen () ;
593 
		fprintf ( dg_file, "%ld=*", non ) ;
594 
		out_dt_shape ( dt->data.ptr.object ) ;
595 
	    }
596 
	    dt->been_outed = non ;
597 
	    last_type_sz = 32 ;
598 
	    set_stab_size ( non ) ;
599 
	    break ;
600 
	}
601 
 
602 
	case DIAG_TYPE_ARRAY : {
603 
#if 0
604 
	    long str = no ( dt->data.array.stride ) ;
605 
#endif
606 
	    long lwb = no ( dt->data.array.lower_b ) ;
607 
	    long upb = no ( dt->data.array.upper_b ) ;
608 
	    diag_type index_type = dt->data.array.index_type ;
609 
	    diag_type element_type = dt->data.array.element_type ;
610 
	    long non = next_typen () ;
611 
	    dt->been_outed = non ;
612 
	    fprintf ( dg_file, "%ld=ar", non ) ;
613 
	    out_dt_shape ( index_type ) ;
614 
	    fprintf ( dg_file, ";%ld;%ld;", lwb, upb ) ;
615 
	    out_dt_shape ( element_type ) ;
616 
	    last_type_sz *= ( upb - lwb + 1 ) ;
617 
	    set_stab_size ( non ) ;
618 
	    break ;
619 
	}
620 
 
621 
	case DIAG_TYPE_STRUCT :
622 
	case DIAG_TYPE_UNION : {
623 
	    int i ;
624 
	    char su ;
625 
	    shape s ;
626 
	    diag_field_list fields ;
627 
	    long non = next_typen () ;
628 
	    dt->been_outed = non ;
629 
 
630 
	    if ( dt->key == DIAG_TYPE_STRUCT ) {
631 
		fields = dt->data.t_struct.fields ;
632 
		s = dt->data.t_struct.tdf_shape ;
633 
		su = 's';
634 
	    } else {
635 
		fields = dt->data.t_union.fields ;
636 
		s = dt->data.t_union.tdf_shape;
637 
		su = 'u' ;
638 
	    }
639 
	    fprintf ( dg_file, "%ld=%c%d", non, su, shape_size ( s ) / 8 ) ;
640 
 
641 
	    for ( i = fields->lastused - 1 ; i >= 0 ; i-- ) {
642 
		diag_field sf =  ( fields->array ) [i] ;
643 
		long offset = no ( sf->where );
644 
 
645 
		if ( depth_now >= max_depth ) return ;
646 
		depth_now++ ;
647 
		fprintf ( dg_file, "%s:", sf->field_name.ints.chars ) ;
648 
		out_dt_shape ( sf->field_type ) ;
649 
		fprintf ( dg_file, ",%ld,%ld;", offset, last_type_sz ) ;
650 
	    }
651 
	    fprintf ( dg_file, ";" ) ;
652 
	    last_type_sz = shape_size ( s ) ;
653 
	    set_stab_size ( non ) ;
654 
	    break ;
655 
	}
656 
 
657 
	case DIAG_TYPE_VARIETY : {
658 
	    dt->been_outed = out_sh_type ( f_integer ( dt->data.var ) ) ;
659 
	    fprintf ( dg_file, "%ld", dt->been_outed ) ;
660 
	    break ;
661 
	}
662 
 
663 
	case DIAG_TYPE_PROC: {
664 
	    diag_type result_type = dt->data.proc.result_type ;
665 
	    long non1 = next_typen () ;
666 
	    long non2 = next_typen () ;
667 
	    dt->been_outed = non1 ;
668 
	    fprintf ( dg_file, "%ld=*%ld=f", non1, non2 ) ;
669 
	    out_dt_shape ( result_type ) ;
670 
	    last_type_sz = 32 ;
671 
	    set_stab_size ( non1 ) ;
672 
	    set_stab_size ( non2 ) ;
673 
	    break ;
674 
	}
675 
 
676 
	case DIAG_TYPE_LOC: {
677 
	    /* +++ use qualifier which gives "const"/"volatile" */
678 
	    out_dt_shape ( dt->data.loc.object ) ;
679 
	    break ;
680 
	}
681 
 
682 
	case DIAG_TYPE_FLOAT : {
683 
	    dt->been_outed = out_sh_type ( f_floating ( dt->data.f_var ) ) ;
684 
	    fprintf ( dg_file, "%ld", dt->been_outed ) ;
685 
	    break ;
686 
	}
687 
 
688 
	case DIAG_TYPE_NULL : {
689 
	    fprintf ( dg_file, "%d", STAB_VOID ) ;
690 
	    last_type_sz = 0 ;
691 
	    break ;
692 
	}
693 
 
694 
	case DIAG_TYPE_BITFIELD : {
695 
	    long sz = dt->data.bitfield.no_of_bits.nat_val.small_nat ;
696 
	    fprintf ( dg_file, "%d", STAB_SLONG ) ;
697 
	    last_type_sz = sz ;
698 
	    break ;
699 
	}
700 
 
701 
	case DIAG_TYPE_ENUM : {
702 
	    int i ;
703 
	    enum_values_list enumvals = dt->data.t_enum.values;
704 
	    long non = next_typen () ;
705 
	    dt->been_outed = non ;
706 
	    fprintf ( dg_file, "%ld=e", non ) ;
707 
	    for ( i = enumvals->lastused - 1 ; i >= 0 ; i-- ) {
708 
		enum_values ef =  ( enumvals->array ) [i] ;
709 
		fprintf ( dg_file, "%s:%d,", ef->nme.ints.chars, no ( ef->val ) );
710 
	    }
711 
	    fprintf ( dg_file, ";" ) ;
712 
	    last_type_sz = 32 ;
713 
	    set_stab_size ( non ) ;
714 
	    break ;
715 
	}
716 
 
717 
	default : {
718 
	    fprintf ( dg_file, "%d", STAB_VOID ) ;
719 
	    last_type_sz = 0 ;
720 
	    break ;
721 
	}
722 
    }
723 
    return ;
724 
}
725 
 
726 
 
727 
/*
728 
    OUTPUT DIAGNOSTICS FOR A GLOBAL VARIABLE
729 
*/
730 
 
731 
void diag_val_begin
732 
    PROTO_N ( (d, global, cname, pname) )
733 
    PROTO_T ( diag_global * d X int global X int cname X char * pname )
734 
{
735 
  stabd ( find_file ( d->data.id.whence.file->file.ints.chars ),
736 
	 ( long ) d->data.id.whence.line_no.nat_val.small_nat
737 
	 , -N_DSLINE ) ;
738 
 
739 
  fprintf ( dg_file, "\t.stabs\t\"%s:%c",
740 
	d->data.id.nme.ints.chars, (global ? 'G' : 'S'));
741 
  OUT_DT_SHAPE ( d->data.id.new_type ) ;
742 
  if (global)
743 
    fprintf ( dg_file, "\",0x20,0,%d,0\n",
744 
	d->data.id.whence.line_no.nat_val.small_nat);
745 
  else {
746 
    fprintf ( dg_file, "\",0x28,0,%d,",
747 
	d->data.id.whence.line_no.nat_val.small_nat);
748 
    if (cname == -1) {
749 
      outs (pname);
750 
    }
751 
    else {
752 
      outs(local_prefix);
753 
      outn ((long)cname);
754 
    };
755 
    outnl ();
756 
  };
757 
  return ;
758 
}
759 
 
760 
void diag_val_end
761 
    PROTO_N ( (d) )
762 
    PROTO_T ( diag_global * d )
763 
{
764 
  UNUSED(d);
765 
  return;
766 
}
767 
 
768 
 
769 
/*
770 
    OUTPUT DIAGNOSTICS FOR A PROCEDURE
771 
*/
772 
 
773 
void diag_proc_begin
774 
    PROTO_N ( (d, global, cname, pname) )
775 
    PROTO_T ( diag_global * d X int global X int cname X char * pname )
776 
{
777 
  last_proc_pname = pname;
778 
  last_proc_cname = cname;
779 
  in_proc = 1;
780 
  if (!d)
781 
    return;
782 
 
783 
  stabd ( find_file ( d->data.id.whence.file->file.ints.chars ),
784 
	 ( long ) d->data.id.whence.line_no.nat_val.small_nat
785 
	 ,0) ;
786 
 
787 
  outs ("\t.stabs\t\"");
788 
  outs (d->data.id.nme.ints.chars);
789 
  if (global)
790 
    outs (":F");
791 
  else
792 
    outs (":f");
793 
  OUT_DT_SHAPE ( d->data.id.new_type->data.proc.result_type ) ;
794 
  outs ("\",0x24,0,0,");
795 
  out_procname ();
796 
  outnl ();
797 
  return ;
798 
}
799 
 
800 
void diag_proc_end
801 
    PROTO_N ( (d) )
802 
    PROTO_T ( diag_global * d )
803 
{
804 
  UNUSED(d);
805 
  in_proc = 0;
806 
  return;
807 
}
808 
 
809 
 
810 
 
811 
/*
812 
    OUTPUT DIAGNOSTICS FOR A LOCAL VARIABLE
813 
*/
814 
 
815 
static void stab_local
816 
    PROTO_N ( (d, proc_no, acc) )
817 
    PROTO_T ( diag_info * d X int proc_no X exp acc )
818 
{
819 
  int p, param_dec;
820 
#ifdef NEWDIAGS
821 
  long acc_type;
822 
  if (name(acc) == name_tag) {
823 
    acc_type = ptno(son(acc));
824 
    if (no_frame && acc_type != reg_pl)
825 
      return;
826 
  }
827 
  if (name(acc) != name_tag) {
828 
    fprintf ( dg_file, "\t.stabs\t\"%s=i\",0x80,0,0,%d\n",
829 
	d -> data.id_scope.nme.ints.chars, no(acc) );
830 
  }
831 
  else
832 
  if (acc_type == reg_pl) {
833 
    fprintf ( dg_file, "\t.stabs\t\"%s:r",
834 
	d -> data.id_scope.nme.ints.chars );
835 
    OUT_DT_SHAPE ( d -> data.id_scope.typ ) ;
836 
    fprintf ( dg_file, "\",0x40,0,0,%d\n",
837 
		reg_stabno [get_reg_no (no(son(acc)))]);
838 
  }
839 
  else
840 
#endif
841 
  {
842 
    p = (no(acc) + no(son(acc))) / 8;
843 
    param_dec = isparam(son(acc));
844 
 
845 
    fprintf ( dg_file, "\t.stabs\t\"%s:",
846 
	d -> data.id_scope.nme.ints.chars );
847 
    OUT_DT_SHAPE ( d -> data.id_scope.typ ) ;
848 
    fprintf ( dg_file, "\",0x80,0,%d,",
849 
 
850 
    if (param_dec)
851 
      fprintf ( dg_file, "%d\n", p+8);
852 
    else
853 
      fprintf ( dg_file, "%d-%sdisp%d\n", p, local_prefix, proc_no);
854 
  }
855 
  return ;
856 
}
857 
 
858 
 
859 
 
860 
/*
861 
    DEAL WITH BASIC TYPES
862 
*/
863 
 
864 
static void stab_types
865 
    PROTO_Z ()
866 
{
867 
    total_type_sizes = NO_STABS ;
868 
    typeno = NO_STABS ;
869 
    type_sizes = ( long * ) xmalloc ( NO_STABS * sizeof ( long ) ) ;
870 
    fputs ( "\t.stabs\t\"int:t1=r1;-2147483648;2147483647;\",0x80,0,0,0\n",
871 
	    dg_file ) ;
872 
    fputs ( "\t.stabs\t\"short int:t2=r1;-32768;32767;\",0x80,0,0,0\n",
873 
	    dg_file ) ;
874 
    fputs ( "\t.stabs\t\"short unsigned int:t3=r1;0;65535;\",0x80,0,0,0\n",
875 
	    dg_file ) ;
876 
    fputs ( "\t.stabs\t\"char:t4=r4;0;127;\",0x80,0,0,0\n",
877 
	    dg_file ) ;
878 
    fputs ( "\t.stabs\t\"signed char:t5=r1;-128;127;\",0x80,0,0,0\n",
879 
	    dg_file ) ;
880 
    fputs ( "\t.stabs\t\"unsigned char:t6=r1;0;255;\",0x80,0,0,0\n",
881 
	    dg_file ) ;
882 
    fputs ( "\t.stabs\t\"long int:t7=r1;-2147483648;2147483647;\",0x80,0,0,0\n",
883 
	    dg_file ) ;
884 
    fputs ( "\t.stabs\t\"unsigned int:t8=r1;0;-1;\",0x80,0,0,0\n",
885 
	    dg_file ) ;
886 
    fputs ( "\t.stabs\t\"long unsigned int:t9=r1;0;-1;\",0x80,0,0,0\n",
887 
	    dg_file ) ;
888 
    fputs ( "\t.stabs\t\"float:t10=r1;4;0;\",0x80,0,0,0\n",
889 
	    dg_file ) ;
890 
    fputs ( "\t.stabs\t\"double:t11=r1;8;0;\",0x80,0,0,0\n",
891 
	    dg_file ) ;
892 
    fprintf ( dg_file, "\t.stabs\t\"long double:t12=r1;%d;0;\",0x80,0,0,0\n",
893 
	      DOUBLE_SZ / 8 ) ;
894 
    fputs ( "\t.stabs\t\"void:t13=13\",0x80,0,0,0\n",
895 
	    dg_file ) ;
896 
    fputs ( "\t.stabs\t\"long long int:t14=r1;", dg_file ) ;
897 
    fputs ( "01000000000000000000000;0777777777777777777777;\",0x80,0,0,0\n",
898 
	    dg_file ) ;
899 
    fputs ( "\t.stabs\t\"unsigned long long int:t15=r1;", dg_file ) ;
900 
    fputs ( "0000000000000;01777777777777777777777;\",0x80,0,0,0\n",
901 
	    dg_file ) ;
902 
    type_sizes [0] = 0 ;
903 
    type_sizes [1] = 32 ;
904 
    type_sizes [2] = 16 ;
905 
    type_sizes [3] = 16 ;
906 
    type_sizes [4] = 8 ;
907 
    type_sizes [5] = 8 ;
908 
    type_sizes [6] = 8 ;
909 
    type_sizes [7] = 32 ;
910 
    type_sizes [8] = 32 ;
911 
    type_sizes [9] = 32 ;
912 
    type_sizes [10] = 32 ;
913 
    type_sizes [11] = 64 ;
914 
    type_sizes [12] = DOUBLE_SZ ;
915 
    type_sizes [13] = 0 ;
916 
    type_sizes [14] = 64 ;
917 
    type_sizes [15] = 64 ;
918 
    return ;
919 
}
920 
 
921 
 
922 
/*
923 
    DEAL WITH STRUCTURE, UNION AND ENUM TAGS
924 
*/
925 
 
926 
void stab_tagdefs
927 
    PROTO_Z ()
928 
{
929 
    diag_tagdef **di = unit_ind_diagtags ;
930 
    int i, n = unit_no_of_diagtags, istag ;
931 
 
932 
    for ( i = 0 ; i < n ; i++ ) {
933 
	diag_type d = di [i]->d_type ;
934 
	istag = 1;
935 
 
936 
	switch ( d->key ) {
937 
 
938 
	    case DIAG_TYPE_STRUCT : {
939 
		char *nme = d->data.t_struct.nme.ints.chars ;
940 
		if ( nme && *nme ) {
941 
		    fprintf ( dg_file, "\t.stabs\t\"%s:", nme ) ;
942 
		} else {
943 
		    static int s_count = 0 ;
944 
		    fprintf ( dg_file, "\t.stabs\t\"_struct%d:", s_count++ ) ;
945 
		}
946 
		break ;
947 
	    }
948 
	    case DIAG_TYPE_UNION : {
949 
		char *nme = d->data.t_union.nme.ints.chars ;
950 
		if ( nme && *nme ) {
951 
		    fprintf ( dg_file, "\t.stabs\t\"%s:", nme ) ;
952 
		} else {
953 
		    static int u_count = 0 ;
954 
		    fprintf ( dg_file, "\t.stabs\t\"_union%d:", u_count++ ) ;
955 
		}
956 
		break ;
957 
	    }
958 
	    case DIAG_TYPE_ENUM : {
959 
		char *nme = d->data.t_enum.nme.ints.chars ;
960 
		if ( nme && *nme ) {
961 
		    fprintf ( dg_file, "\t.stabs\t\"%s:", nme ) ;
962 
		} else {
963 
		    static int e_count = 0 ;
964 
		    fprintf ( dg_file, "\t.stabs\t\"_enum%d:", e_count++ ) ;
965 
		}
966 
		break ;
967 
	    }
968 
	    default: {
969 
		istag = 0 ;
970 
		break ;
971 
	    }
972 
	}
973 
	if (istag) {
974 
	    if ( d->been_outed && 0) {
975 
		fprintf ( dg_file, "%d", (int)d->been_outed ) ;
976 
	    } else {
977 
		fprintf ( dg_file, "T" ) ;
978 
		OUT_DT_SHAPE ( d ) ;
979 
	    }
980 
	    fprintf ( dg_file, "\",0x80,0,0,0\n" ) ;
981 
	}
982 
    }
983 
    return ;
984 
}
985 
 
986 
 
987 
/*
988 
    DEAL WITH TYPEDEFS
989 
*/
990 
 
991 
void stab_typedefs
992 
    PROTO_Z ()
993 
{
994 
    diag_descriptor *di = unit_diagvar_tab.array ;
995 
    int i, n = unit_diagvar_tab.lastused ;
996 
    for ( i = 0 ; i < n ; i++ ) {
997 
	if ( di [i].key == DIAG_TYPEDEF_KEY ) {
998 
	    long non = next_typen () ;
999 
	    fprintf ( dg_file, "\t.stabs\t\"%s:t%ld=",
1000 
		      di [i].data.typ.nme.ints.chars, non ) ;
1001 
	    OUT_DT_SHAPE ( di [i].data.typ.new_type ) ;
1002 
	    fprintf ( dg_file, "\",0x80,0,0,0\n" ) ;
1003 
	}
1004 
    }
1005 
    return ;
1006 
}