Subversion Repositories tendra.SVN

Rev

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