Subversion Repositories tendra.SVN

Rev

Rev 5 | Show entire file | Ignore whitespace | Details | Blame | Last modification | View Log | RSS feed

Rev 5 Rev 6
Line -... Line 1...
-
 
1
/*
-
 
2
 * Copyright (c) 2002-2005 The TenDRA Project <http://www.tendra.org/>.
-
 
3
 * All rights reserved.
-
 
4
 *
-
 
5
 * Redistribution and use in source and binary forms, with or without
-
 
6
 * modification, are permitted provided that the following conditions are met:
-
 
7
 *
-
 
8
 * 1. Redistributions of source code must retain the above copyright notice,
-
 
9
 *    this list of conditions and the following disclaimer.
-
 
10
 * 2. Redistributions in binary form must reproduce the above copyright notice,
-
 
11
 *    this list of conditions and the following disclaimer in the documentation
-
 
12
 *    and/or other materials provided with the distribution.
-
 
13
 * 3. Neither the name of The TenDRA Project nor the names of its contributors
-
 
14
 *    may be used to endorse or promote products derived from this software
-
 
15
 *    without specific, prior written permission.
-
 
16
 *
-
 
17
 * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ``AS
-
 
18
 * IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO,
-
 
19
 * THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
-
 
20
 * PURPOSE ARE DISCLAIMED.  IN NO EVENT SHALL THE COPYRIGHT HOLDERS OR
-
 
21
 * CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
-
 
22
 * EXEMPLARY OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
-
 
23
 * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;
-
 
24
 * OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
-
 
25
 * WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
-
 
26
 * OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
-
 
27
 * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
-
 
28
 *
-
 
29
 * $Id$
-
 
30
 */
1
/*
31
/*
2
    		 Crown Copyright (c) 1997
32
    		 Crown Copyright (c) 1997
3
    
33
 
4
    This TenDRA(r) Computer Program is subject to Copyright
34
    This TenDRA(r) Computer Program is subject to Copyright
5
    owned by the United Kingdom Secretary of State for Defence
35
    owned by the United Kingdom Secretary of State for Defence
6
    acting through the Defence Evaluation and Research Agency
36
    acting through the Defence Evaluation and Research Agency
7
    (DERA).  It is made available to Recipients with a
37
    (DERA).  It is made available to Recipients with a
8
    royalty-free licence for its use, reproduction, transfer
38
    royalty-free licence for its use, reproduction, transfer
9
    to other parties and amendment for any purpose not excluding
39
    to other parties and amendment for any purpose not excluding
10
    product development provided that any such use et cetera
40
    product development provided that any such use et cetera
11
    shall be deemed to be acceptance of the following conditions:-
41
    shall be deemed to be acceptance of the following conditions:-
12
    
42
 
13
        (1) Its Recipients shall ensure that this Notice is
43
        (1) Its Recipients shall ensure that this Notice is
14
        reproduced upon any copies or amended versions of it;
44
        reproduced upon any copies or amended versions of it;
15
    
45
 
16
        (2) Any amended version of it shall be clearly marked to
46
        (2) Any amended version of it shall be clearly marked to
17
        show both the nature of and the organisation responsible
47
        show both the nature of and the organisation responsible
18
        for the relevant amendment or amendments;
48
        for the relevant amendment or amendments;
19
    
49
 
20
        (3) Its onward transfer from a recipient to another
50
        (3) Its onward transfer from a recipient to another
21
        party shall be deemed to be that party's acceptance of
51
        party shall be deemed to be that party's acceptance of
22
        these conditions;
52
        these conditions;
23
    
53
 
24
        (4) DERA gives no warranty or assurance as to its
54
        (4) DERA gives no warranty or assurance as to its
25
        quality or suitability for any purpose and DERA accepts
55
        quality or suitability for any purpose and DERA accepts
26
        no liability whatsoever in relation to any use to which
56
        no liability whatsoever in relation to any use to which
27
        it may be put.
57
        it may be put.
28
*/
58
*/
Line 109... Line 139...
109
 * Revision 1.1  1994/05/03  14:49:53  djch
139
 * Revision 1.1  1994/05/03  14:49:53  djch
110
 * Initial revision
140
 * Initial revision
111
 *
141
 *
112
 * Revision 1.6  93/09/27  14:55:15  14:55:15  ra (Robert Andrews)
142
 * Revision 1.6  93/09/27  14:55:15  14:55:15  ra (Robert Andrews)
113
 * Only whitespace.
143
 * Only whitespace.
114
 * 
144
 *
115
 * Revision 1.5  93/08/27  11:37:55  11:37:55  ra (Robert Andrews)
145
 * Revision 1.5  93/08/27  11:37:55  11:37:55  ra (Robert Andrews)
116
 * A couple of lint-like changes.
146
 * A couple of lint-like changes.
117
 * 
147
 *
118
 * Revision 1.4  93/08/13  14:45:51  14:45:51  ra (Robert Andrews)
148
 * Revision 1.4  93/08/13  14:45:51  14:45:51  ra (Robert Andrews)
119
 * Allow the stabs for long double to vary depending on DOUBLE_SZ.
149
 * Allow the stabs for long double to vary depending on DOUBLE_SZ.
120
 * 
150
 *
121
 * Revision 1.3  93/07/05  18:26:29  18:26:29  ra (Robert Andrews)
151
 * Revision 1.3  93/07/05  18:26:29  18:26:29  ra (Robert Andrews)
122
 * A couple of minor corrections.  Introduced stab_ptrs to avoid duplication
152
 * A couple of minor corrections.  Introduced stab_ptrs to avoid duplication
123
 * of basic pointer types.
153
 * of basic pointer types.
124
 * 
154
 *
125
 * Revision 1.2  93/06/29  14:32:54  14:32:54  ra (Robert Andrews)
155
 * Revision 1.2  93/06/29  14:32:54  14:32:54  ra (Robert Andrews)
126
 * Fairly major rewrite and reformat.  There were a number of errors which
156
 * Fairly major rewrite and reformat.  There were a number of errors which
127
 * meant that the diagnostics were not previously working.
157
 * meant that the diagnostics were not previously working.
128
 * 
158
 *
129
 * Revision 1.1  93/06/24  14:59:22  14:59:22  ra (Robert Andrews)
159
 * Revision 1.1  93/06/24  14:59:22  14:59:22  ra (Robert Andrews)
130
 * Initial revision
160
 * Initial revision
131
 * 
161
 *
132
--------------------------------------------------------------------------
162
--------------------------------------------------------------------------
133
*/
163
*/
134
 
164
 
135
 
165
 
136
#define SPARCTRANS_CODE
166
#define SPARCTRANS_CODE
Line 163... Line 193...
163
#include "install_fns.h"
193
#include "install_fns.h"
164
#include "installglob.h"
194
#include "installglob.h"
165
#include "externs.h"
195
#include "externs.h"
166
#include "out.h"
196
#include "out.h"
167
#include "sparcdiags.h"
197
#include "sparcdiags.h"
168
extern bool last_param PROTO_S ( ( exp ) ) ;
198
extern bool last_param(exp);
169
 
199
 
170
 
200
 
171
/*
201
/*
172
  FORWARD DECLARATIONS
202
  FORWARD DECLARATIONS
173
*/
203
*/
174
 
204
 
175
static long stab_scope_open PROTO_S ( ( long ) ) ;
205
static long stab_scope_open(long);
176
static void stab_scope_close PROTO_S ( ( long ) ) ;
206
static void stab_scope_close(long);
177
static void ready_scope PROTO_S ( ( void ) );
207
static void ready_scope(void);
178
 
208
 
179
 
209
 
180
	/* label number sequence independent from text code */
210
	/* label number sequence independent from text code */
181
static int diag_lab_no = 0;
211
static int diag_lab_no = 0;
182
 
212
 
183
static int next_d_lab
213
static int next_d_lab
184
    PROTO_Z ()
214
(void)
185
{
215
{
186
  return ++diag_lab_no;
216
  return ++diag_lab_no;
187
}
217
}
188
 
218
 
189
 
219
 
190
/*
220
/*
191
  DIAGNOSTICS FILE
221
  DIAGNOSTICS FILE
192
*/
222
*/
193
 
223
 
194
static FILE *dg_file ;
224
static FILE *dg_file;
195
static char *dg_file_name ;
225
static char *dg_file_name;
196
 
226
 
197
 
227
 
198
/*
228
/*
199
  BASIC TYPE NUMBERS
229
  BASIC TYPE NUMBERS
200
*/
230
*/
Line 214... Line 244...
214
 
244
 
215
/*
245
/*
216
  BASIC POINTERS
246
  BASIC POINTERS
217
*/
247
*/
218
 
248
 
219
static long stab_ptrs [ NO_STABS ] = {
249
static long stab_ptrs[NO_STABS] = {
220
  0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0
250
  0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0
221
} ;
251
};
222
 
252
 
223
 
253
 
224
/*
254
/*
225
  CURRENT TYPE NUMBER
255
  CURRENT TYPE NUMBER
226
*/
256
*/
227
 
257
 
228
static long typeno ;
258
static long typeno;
229
 
259
 
230
 
260
 
231
/*
261
/*
232
  SIZE OF LAST STAB TYPE OUTPUT
262
  SIZE OF LAST STAB TYPE OUTPUT
233
*/
263
*/
234
 
264
 
235
static long last_type_sz = 0 ;
265
static long last_type_sz = 0;
236
 
266
 
237
 
267
 
238
/*
268
/*
239
  CURRENT LINE NUMBER AND FILE NUMBER
269
  CURRENT LINE NUMBER AND FILE NUMBER
240
*/
270
*/
241
 
271
 
242
long currentlno = -1 ;
272
long currentlno = -1;
243
long currentfile = -1 ;
273
long currentfile = -1;
244
 
274
 
245
 
275
 
246
/*
276
/*
247
  ARRAY OF TYPE SIZES
277
  ARRAY OF TYPE SIZES
248
*/
278
*/
249
 
279
 
250
static long *type_sizes ;
280
static long *type_sizes;
251
static int total_type_sizes = 0 ;
281
static int total_type_sizes = 0;
252
 
282
 
253
 
283
 
254
/*
284
/*
255
  SETTING AND GETTING TYPE SIZES
285
  SETTING AND GETTING TYPE SIZES
256
*/
286
*/
257
 
287
 
258
#define set_stab_size( i )	type_sizes [ ( i ) ] = last_type_sz
288
#define set_stab_size(i)	type_sizes[(i)] = last_type_sz
259
#define get_stab_size( i )	( type_sizes [ ( i ) ] )
289
#define get_stab_size(i)	(type_sizes[(i)])
260
 
290
 
261
 
291
 
262
/*
292
/*
263
  GET THE NEXT TYPE NUMBER
293
  GET THE NEXT TYPE NUMBER
264
*/
294
*/
265
 
295
 
266
static long next_typen 
296
static long next_typen
267
    PROTO_Z ()
297
(void)
268
{
298
{
269
  if ( typeno >= total_type_sizes ) {
299
  if (typeno >= total_type_sizes) {
270
    int i, n = total_type_sizes, m = n + 100 ;
300
    int i, n = total_type_sizes, m = n + 100;
271
    type_sizes = ( long * ) xrealloc ( type_sizes, m * sizeof ( long ) ) ;
301
    type_sizes = (long *)xrealloc(type_sizes, m * sizeof(long));
272
    for ( i = n ; i < m ; i++ ) type_sizes [i] = 0 ;
302
    for (i = n; i < m; i++)type_sizes[i] = 0;
273
    total_type_sizes = m ;
303
    total_type_sizes = m;
274
  }
304
  }
275
  return ( typeno++ ) ;
305
  return(typeno++);
276
}
306
}
277
 
307
 
278
 
308
 
279
/*
309
/*
280
    ARRAY OF FILE DESCRIPTORS
310
    ARRAY OF FILE DESCRIPTORS
281
*/
311
*/
282
 
312
 
283
static filename *fds = null ;
313
static filename *fds = null;
284
static int szfds = 0 ;
314
static int szfds = 0;
285
static int nofds = 0 ;
315
static int nofds = 0;
286
 
316
 
287
 
317
 
288
/*
318
/*
289
  ADD A NEW FILE TO THE ARRAY OF FILE DESCRIPTORS
319
  ADD A NEW FILE TO THE ARRAY OF FILE DESCRIPTORS
290
*/
320
*/
291
 
321
 
292
void stab_collect_files 
322
void stab_collect_files
293
    PROTO_N ( ( f ) )
-
 
294
    PROTO_T ( filename f )
323
(filename f)
295
{
324
{
296
  if ( fds == null ) {
325
  if (fds == null) {
297
    szfds += 10 ;
326
    szfds += 10;
298
    fds = ( filename * ) xmalloc ( szfds * sizeof ( filename ) ) ;
327
    fds = (filename *)xmalloc(szfds * sizeof(filename));
299
  } 
328
  }
300
  else if ( nofds >= szfds ) {
329
  else if (nofds >= szfds) {
301
    szfds += 10 ;
330
    szfds += 10;
302
    fds = ( filename * ) xrealloc ( fds, szfds * sizeof ( filename ) ) ;
331
    fds = (filename *)xrealloc(fds, szfds * sizeof(filename));
303
  }
332
  }
304
  fds [ nofds++ ] = f ;
333
  fds[nofds++] = f;
305
  return ;
334
  return;
306
}
335
}
307
 
336
 
308
 
337
 
309
/*
338
/*
310
  FIND THE FILE DESCRIPTOR CORRESPONDING TO A FILE NAME
339
  FIND THE FILE DESCRIPTOR CORRESPONDING TO A FILE NAME
311
*/
340
*/
312
 
341
 
313
static long find_file 
342
static long find_file
314
    PROTO_N ( ( f ) )
-
 
315
    PROTO_T ( char * f )
343
(char * f)
316
{
344
{
317
  long i ;
345
  long i;
318
  for ( i = 0 ; i < nofds ; i++ ) {
346
  for (i = 0; i < nofds; i++) {
319
    if ( strcmp ( f, fds [i]->file.ints.chars ) == 0 ) return ( i ) ;
347
    if (strcmp(f, fds[i] ->file.ints.chars) == 0) return(i);
320
  }
348
  }
321
  return ( 0 ) ;
349
  return(0);
322
}
350
}
323
 
351
 
324
 
352
 
325
 
353
 
326
/*
354
/*
327
  OUTPUT A FILE POSITION CONSTRUCT
355
  OUTPUT A FILE POSITION CONSTRUCT
328
*/
356
*/
329
 
357
 
330
#define N_SLINE 0x44
358
#define N_SLINE 0x44
331
#define N_DSLINE 0x46
359
#define N_DSLINE 0x46
332
#define N_BSLINE 0x48
360
#define N_BSLINE 0x48
333
 
361
 
334
void stabd 
362
void stabd
335
    PROTO_N ( ( findex, lno, seg ) )
-
 
336
    PROTO_T ( long findex X long lno X int seg )
363
(long findex, long lno, int seg)
337
{
364
{
338
  long i ;
365
  long i;
339
  if ( findex == currentfile && lno == currentlno ) return ;
366
  if (findex == currentfile && lno == currentlno) return;
340
  stab_file ( findex, 1 ) ;
367
  stab_file(findex, 1);
341
  
368
 
342
  if (seg != 0){		/* 0 suppresses always */
369
  if (seg != 0){		/* 0 suppresses always */
343
      
370
 
344
    if (seg > 0)	/* -ve line nos are put out in the stabs */
371
    if (seg > 0)	/* -ve line nos are put out in the stabs */
345
      {
372
      {
346
	i = next_d_lab () ;
373
	i = next_d_lab();
347
	fprintf ( dg_file, "\t.stabn\t0x%x,0,%ld,LL.%ld\n",seg, lno, i ) ;
374
	fprintf(dg_file, "\t.stabn\t0x%x,0,%ld,LL.%ld\n",seg, lno, i);
348
	fprintf ( dg_file, "LL.%ld:\n", i ) ;
375
	fprintf(dg_file, "LL.%ld:\n", i);
349
      }
376
      }
350
  }
377
  }
351
  currentlno = lno ;
378
  currentlno = lno;
352
  return ;
379
  return;
353
}
380
}
354
 
381
 
355
 
382
 
356
#ifdef NEWDIAGS
383
#ifdef NEWDIAGS
357
/*
384
/*
358
    OUTPUT DIAGNOSTICS SURROUNDING CODE
385
    OUTPUT DIAGNOSTICS SURROUNDING CODE
359
*/
386
*/
360
 
387
 
361
void code_diag_info (d, proc_no, mcode, args)
388
void code_diag_info(d, proc_no, mcode, args)
362
diag_info * d;
389
diag_info * d;
363
int proc_no;
390
int proc_no;
364
void (*mcode)();
391
void(*mcode)();
365
void * args;
392
void * args;
366
{
393
{
367
  if (d == nildiag) {
394
  if (d == nildiag) {
368
    (*mcode)(args);
395
   (*mcode)(args);
369
    return;
396
    return;
370
  }
397
  }
371
  switch (d->key) {
398
  switch (d->key) {
372
    case DIAG_INFO_SCOPE: {
399
    case DIAG_INFO_SCOPE: {
373
	stab_scope_open ( currentfile ) ;
400
	stab_scope_open(currentfile);
374
	stabd ( currentfile, ( long ) ( currentlno + 1 ), N_SLINE ) ;
401
	stabd(currentfile,(long)(currentlno + 1), N_SLINE);
375
	code_diag_info (d->more, proc_no, mcode, args);
402
	code_diag_info(d->more, proc_no, mcode, args);
376
	stab_scope_close ( currentfile ) ;
403
	stab_scope_close(currentfile);
377
	return;
404
	return;
378
    }
405
    }
379
    case DIAG_INFO_SOURCE: {
406
    case DIAG_INFO_SOURCE: {
380
	sourcemark *s = &d->data.source.beg ;
407
	sourcemark *s = &d->data.source.beg;
381
	long f = find_file ( s->file->file.ints.chars ) ;
408
	long f = find_file(s->file->file.ints.chars);
382
	ready_scope () ;
409
	ready_scope();
383
	stabd ( f, ( long ) s->line_no.nat_val.small_nat ,N_SLINE) ;
410
	stabd(f,(long)s->line_no.nat_val.small_nat ,N_SLINE);
384
	code_diag_info (d->more, proc_no, mcode, args);
411
	code_diag_info(d->more, proc_no, mcode, args);
385
	s = &d->data.source.end ;
412
	s = &d->data.source.end;
386
	f = find_file ( s->file->file.ints.chars ) ;
413
	f = find_file(s->file->file.ints.chars);
387
	stabd ( f, ( long ) s->line_no.nat_val.small_nat ,N_SLINE) ;
414
	stabd(f,(long)s->line_no.nat_val.small_nat ,N_SLINE);
388
	return;
415
	return;
389
    }
416
    }
390
    case DIAG_INFO_ID: {
417
    case DIAG_INFO_ID: {
391
	exp acc = d -> data.id_scope.access;
418
	exp acc = d -> data.id_scope.access;
392
	if (name(acc) != hold_tag)
419
	if (name(acc)!= hold_tag)
393
	  fail("not hold_tag");
420
	  fail("not hold_tag");
394
	acc = son(acc);
421
	acc = son(acc);
395
	if (name(acc) == cont_tag && name(son(acc)) == name_tag && isvar(son(son(acc))))
422
	if (name(acc) == cont_tag && name(son(acc)) == name_tag && isvar(son(son(acc))))
396
	  acc = son(acc);
423
	  acc = son(acc);
397
	if ( name(acc) == name_tag && !isdiscarded(acc) && !isglob(son(acc)) ) {
424
	if (name(acc) == name_tag && !isdiscarded(acc) && !isglob(son(acc))) {
398
	  stab_local ( d->data.id_scope.nme.ints.chars, d->data.id_scope.typ,
425
	  stab_local(d->data.id_scope.nme.ints.chars, d->data.id_scope.typ,
399
	       acc, 0, currentfile ) ;
426
	       acc, 0, currentfile);
400
 
427
 
401
	  if ( last_param ( son ( acc ) ) ) {
428
	  if (last_param(son(acc))) {
402
	    stabd ( currentfile, ( long ) ( currentlno + 1 ),N_SLINE) ;
429
	    stabd(currentfile,(long)(currentlno + 1),N_SLINE);
403
	  }
430
	  }
404
	}
431
	}
405
	else if ( name(acc) == val_tag ) {
432
	else if (name(acc) == val_tag) {
406
	  ; /* should be able to do something with val_tag */
433
	  ; /* should be able to do something with val_tag */
407
	}
434
	}
408
	code_diag_info (d->more, proc_no, mcode, args);
435
	code_diag_info(d->more, proc_no, mcode, args);
409
    }
436
    }
410
  };
437
  };
411
  return;
438
  return;
412
}
439
}
413
 
440
 
414
 
441
 
415
#else
442
#else
416
 
443
 
417
/*
444
/*
418
  OUTPUT INITIAL DIAGNOSTICS FOR A DIAGNOSE_TAG
445
  OUTPUT INITIAL DIAGNOSTICS FOR A DIAGNOSE_TAG
419
*/
446
*/
420
 
447
 
421
void stab_begin 
448
void stab_begin
422
    PROTO_N ( ( d, proc_no, e ) )
-
 
423
    PROTO_T ( diag_info * d X int proc_no X exp e )
449
(diag_info * d, int proc_no, exp e)
424
{
450
{
425
  exp x ;
451
  exp x;
426
 
452
 
427
  if ( d->key == DIAG_INFO_SOURCE ) {
453
  if (d->key == DIAG_INFO_SOURCE) {
428
    sourcemark *s = &d->data.source.beg ;
454
    sourcemark *s = &d->data.source.beg;
429
    long f = find_file ( s->file->file.ints.chars ) ;
455
    long f = find_file(s->file->file.ints.chars);
430
    ready_scope () ;
456
    ready_scope();
431
    stabd ( f, ( long ) s->line_no.nat_val.small_nat ,N_SLINE) ;
457
    stabd(f,(long)s->line_no.nat_val.small_nat ,N_SLINE);
432
    return ;
458
    return;
433
  }
459
  }
434
  
460
 
435
  if ( d->key != DIAG_INFO_ID ) {
461
  if (d->key != DIAG_INFO_ID) {
436
    /* not implemented */
462
    /* not implemented */
437
    return ;
463
    return;
438
  }
464
  }
439
  
465
 
440
  x = d->data.id_scope.access ;
466
  x = d->data.id_scope.access;
441
  /* MIPS */
467
  /* MIPS */
442
  if ( isglob ( son ( x ) ) || no ( son ( x ) ) == 1 ) return;
468
  if (isglob(son(x)) || no(son(x)) == 1) return;
443
  
469
 
444
  mark_scope ( e ) ;
470
  mark_scope(e);
445
  if ( props ( e ) & 0x80 ) {
471
  if (props(e) & 0x80) {
446
    ( void ) stab_scope_open ( currentfile ) ;
472
   (void)stab_scope_open(currentfile);
447
    stabd ( currentfile, ( long ) ( currentlno + 1 ), N_SLINE ) ;
473
    stabd(currentfile,(long)(currentlno + 1), N_SLINE);
448
  }
474
  }
449
  
475
 
450
  stab_local ( d->data.id_scope.nme.ints.chars, d->data.id_scope.typ,
476
  stab_local(d->data.id_scope.nme.ints.chars, d->data.id_scope.typ,
451
	       x, 0, currentfile ) ;
477
	       x, 0, currentfile);
452
 
478
 
453
  if ( last_param ( son ( x ) ) ) {
479
  if (last_param(son(x))) {
454
    stabd ( currentfile, ( long ) ( currentlno + 1 ),N_SLINE) ;
480
    stabd(currentfile,(long)(currentlno + 1),N_SLINE);
455
  }
481
  }
456
  return ;
482
  return;
457
}
483
}
458
 
484
 
459
 
485
 
460
/*
486
/*
461
  OUTPUT FINAL DIAGNOSTICS FOR A DIAGNOSE_TAG
487
  OUTPUT FINAL DIAGNOSTICS FOR A DIAGNOSE_TAG
462
*/
488
*/
463
 
489
 
464
void stab_end 
490
void stab_end
465
    PROTO_N ( ( d, e ) )
-
 
466
    PROTO_T ( diag_info * d X exp e )
491
(diag_info * d, exp e)
467
{
492
{
468
  if ( d->key == DIAG_INFO_SOURCE ) {
493
  if (d->key == DIAG_INFO_SOURCE) {
469
    sourcemark *s = &d->data.source.end ;
494
    sourcemark *s = &d->data.source.end;
470
    long f = find_file ( s->file->file.ints.chars ) ;
495
    long f = find_file(s->file->file.ints.chars);
471
    long lno = s->line_no.nat_val.small_nat ;
496
    long lno = s->line_no.nat_val.small_nat;
472
    stabd (f,(long)lno,N_SLINE);
497
    stabd(f,(long)lno,N_SLINE);
473
    return ;
-
 
474
  }
-
 
475
  if ( d->key == DIAG_INFO_ID && props ( e ) & 0x80 ) {
-
 
476
    stab_scope_close ( currentfile ) ;
-
 
477
    return ;
498
    return;
478
  }
499
  }
-
 
500
  if (d->key == DIAG_INFO_ID && props(e) & 0x80) {
-
 
501
    stab_scope_close(currentfile);
-
 
502
    return;
-
 
503
  }
479
  return ;
504
  return;
480
}
505
}
481
#endif
506
#endif
482
 
507
 
483
 
508
 
484
/*
509
/*
485
  INITIALISE DIAGNOSTICS
510
  INITIALISE DIAGNOSTICS
486
*/
511
*/
487
 
512
 
488
void init_stab 
513
void init_stab
489
    PROTO_Z ()
514
(void)
490
{
515
{
491
  dg_file_name = tmpnam ( NULL ) ;
516
  dg_file_name = tmpnam(NULL);
492
  dg_file = fopen ( dg_file_name, "w" ) ;
517
  dg_file = fopen(dg_file_name, "w");
493
  if ( dg_file == NULL ) {
518
  if (dg_file == NULL) {
494
    fail ( "Can't open temporary diagnostics file" ) ;
519
    fail("Can't open temporary diagnostics file");
495
    exit ( EXIT_FAILURE ) ;
520
    exit(EXIT_FAILURE);
496
  }
521
  }
497
  stab_types () ;
522
  stab_types();
498
  return ;
523
  return;
499
}
524
}
500
 
525
 
501
 
526
 
502
/*
527
/*
503
  INITIALIZE DIAGNOSTICS
528
  INITIALIZE DIAGNOSTICS
504
*/
529
*/
505
 
530
 
506
void init_stab_aux 
531
void init_stab_aux
507
    PROTO_Z ()
532
(void)
508
{
533
{
509
  int c ;
534
  int c;
510
  FILE *f ;
535
  FILE *f;
511
  int i, j = 0 ;
536
  int i, j = 0;
512
  for ( i = 0 ; i < nofds ; i++ ) {
537
  for (i = 0; i < nofds; i++) {
513
    char *s = fds [i]->file.ints.chars ;
538
    char *s = fds[i] ->file.ints.chars;
514
    int n = ( int ) strlen ( s ) ;
539
    int n = (int)strlen(s);
515
    if ( n && s [ n - 1 ] != 'h' ) j = i ;
540
    if (n && s[n - 1]!= 'h')j = i;
516
  }
-
 
517
  fclose ( dg_file ) ;
-
 
518
  dg_file = as_file ;
-
 
519
  stab_file ( ( long ) j, 0 ) ;
-
 
520
  f = fopen ( dg_file_name, "r" ) ;
-
 
521
  if ( f == NULL ) {
-
 
522
    fail ( "Can't open temporary diagnostics file" ) ;
-
 
523
    exit ( EXIT_FAILURE ) ;
-
 
524
  }
541
  }
-
 
542
  fclose(dg_file);
-
 
543
  dg_file = as_file;
-
 
544
  stab_file((long)j, 0);
-
 
545
  f = fopen(dg_file_name, "r");
-
 
546
  if (f == NULL) {
-
 
547
    fail("Can't open temporary diagnostics file");
-
 
548
    exit(EXIT_FAILURE);
-
 
549
  }
525
  while ( c = fgetc ( f ), c != EOF ) outc ( c ) ;
550
  while (c = fgetc(f), c != EOF)outc(c);
526
  fclose ( f ) ;
551
  fclose(f);
527
  remove ( dg_file_name ) ;
552
  remove(dg_file_name);
528
  return ;
553
  return;
529
}
554
}
530
 
555
 
531
 
556
 
532
/*
557
/*
533
  FIND THE STAB OF A SIMPLE SHAPE
558
  FIND THE STAB OF A SIMPLE SHAPE
534
*/
559
*/
535
 
560
 
536
static long out_sh_type 
561
static long out_sh_type
537
    PROTO_N ( ( s ) )
-
 
538
    PROTO_T ( shape s )
562
(shape s)
539
{
563
{
540
  last_type_sz = shape_size ( s ) ;
564
  last_type_sz = shape_size(s);
541
  switch ( name ( s ) ) {
565
  switch (name(s)) {
542
    case scharhd : return ( STAB_SCHAR ) ;
566
    case scharhd: return(STAB_SCHAR);
543
    case ucharhd : return ( STAB_UCHAR ) ;
567
    case ucharhd: return(STAB_UCHAR);
544
    case swordhd : return ( STAB_SSHRT ) ;
568
    case swordhd: return(STAB_SSHRT);
545
    case uwordhd : return ( STAB_USHRT ) ;
569
    case uwordhd: return(STAB_USHRT);
546
    case slonghd : return ( STAB_SLONG ) ;
570
    case slonghd: return(STAB_SLONG);
547
    case ulonghd : return ( STAB_ULONG ) ;
571
    case ulonghd: return(STAB_ULONG);
548
    case shrealhd : return ( STAB_FLOAT ) ;
572
    case shrealhd: return(STAB_FLOAT);
549
    case realhd : return ( STAB_DBL ) ;
573
    case realhd: return(STAB_DBL);
550
    case doublehd : return ( STAB_LDBL ) ;
574
    case doublehd: return(STAB_LDBL);
551
  }
575
  }
552
  return ( STAB_VOID ) ;
576
  return(STAB_VOID);
553
}
577
}
554
 
578
 
555
 
579
 
556
/*
580
/*
557
  OUTPUT DIAGNOSTICS DIRECTIVE FOR A FILE
581
  OUTPUT DIAGNOSTICS DIRECTIVE FOR A FILE
558
*/
582
*/
559
 
583
 
560
void stab_file 
584
void stab_file
561
    PROTO_N ( ( findex, internal ) )
-
 
562
    PROTO_T ( long findex X bool internal )
585
(long findex, bool internal)
563
{
586
{
564
  static long i = 0 ;
587
  static long i = 0;
565
  
-
 
566
  if ( findex == currentfile || findex < 0 || findex >= szfds ) {
-
 
567
    return ;
-
 
568
  }
-
 
569
 
588
 
-
 
589
  if (findex == currentfile || findex < 0 || findex >= szfds) {
-
 
590
    return;
-
 
591
  }
-
 
592
 
570
  if ( !internal ) {
593
  if (!internal) {
571
    /* source file */
594
    /* source file */
572
    i = next_d_lab () ;
595
    i = next_d_lab();
573
    fprintf ( dg_file, "\t.stabs\t\"%s\",0x64,0,0,LL.%ld\n",
596
    fprintf(dg_file, "\t.stabs\t\"%s\",0x64,0,0,LL.%ld\n",
574
	      fds [ findex ]->file.ints.chars, i ) ;
597
	      fds[findex] ->file.ints.chars, i);
575
    fprintf ( dg_file, "LL.%ld:\n", i ) ;
598
    fprintf(dg_file, "LL.%ld:\n", i);
576
  } 
599
  }
577
  else {
600
  else {
578
    /* included file */
601
    /* included file */
579
    fprintf ( dg_file, "\t.stabs\t\"%s\",0x84,0,0,LL.%ld\n",
602
    fprintf(dg_file, "\t.stabs\t\"%s\",0x84,0,0,LL.%ld\n",
580
	      fds [ findex ]->file.ints.chars, i ) ;
603
	      fds[findex] ->file.ints.chars, i);
581
    }
604
    }
582
    currentfile = findex ;
605
    currentfile = findex;
583
    return ;
606
    return;
-
 
607
}
-
 
608
 
-
 
609
 
-
 
610
/*
-
 
611
  DIAGNOSTIC SCOPES
-
 
612
*/
-
 
613
 
-
 
614
static long open_label = 0;
-
 
615
static long bracket_level = 1;
-
 
616
 
-
 
617
static void ready_scope
-
 
618
(void)
-
 
619
{
-
 
620
  if (open_label != 0) {
-
 
621
    fprintf(dg_file, "\t.stabn\t0xc0,0,%ld,LL.%ld\n",
-
 
622
	      bracket_level, open_label);
-
 
623
    open_label = 0;
-
 
624
  }
-
 
625
}
-
 
626
 
-
 
627
 
-
 
628
/*
-
 
629
  START OF A DIAGNOSTICS SCOPE
-
 
630
*/
-
 
631
 
-
 
632
static long stab_scope_open
-
 
633
(long findex)
-
 
634
{
-
 
635
  long i;
-
 
636
  stab_file(findex, 1);
-
 
637
  i = next_d_lab();
-
 
638
  ready_scope();
-
 
639
  fprintf(dg_file, "LL.%ld:\n", i);
-
 
640
  open_label = i;
-
 
641
  bracket_level++;
-
 
642
  return(i);
584
}
643
}
585
 
644
 
586
 
645
 
587
/*
646
/*
588
  DIAGNOSTIC SCOPES
647
  END OF A DIAGNOSTICS SCOPE
589
*/
648
*/
590
 
649
 
591
static long open_label = 0 ;
-
 
592
static long bracket_level = 1 ;
-
 
593
 
-
 
594
static void ready_scope 
650
static void stab_scope_close
595
    PROTO_Z ()
651
(long findex)
596
{
652
{
-
 
653
  long i;
-
 
654
  bracket_level--;
597
  if ( open_label != 0 ) {
655
  if (open_label != 0) {
598
    fprintf ( dg_file, "\t.stabn\t0xc0,0,%ld,LL.%ld\n",
-
 
599
	      bracket_level, open_label ) ;
656
    ready_scope();
600
    open_label = 0 ;
657
    open_label = 0;
601
  }
658
  }
602
}
-
 
603
 
-
 
604
 
-
 
605
/*
-
 
606
  START OF A DIAGNOSTICS SCOPE
-
 
607
*/
-
 
608
 
-
 
609
static long stab_scope_open 
-
 
610
    PROTO_N ( ( findex ) )
-
 
611
    PROTO_T ( long findex )
-
 
612
{
-
 
613
  long i ;
-
 
614
  stab_file ( findex, 1 ) ;
-
 
615
  i = next_d_lab () ;
-
 
616
  ready_scope ();
-
 
617
  fprintf ( dg_file, "LL.%ld:\n", i ) ;
-
 
618
  open_label = i ;
-
 
619
  bracket_level++ ;
-
 
620
  return ( i ) ;
-
 
621
}
-
 
622
 
-
 
623
 
-
 
624
/*
-
 
625
  END OF A DIAGNOSTICS SCOPE
-
 
626
*/
-
 
627
 
-
 
628
static void stab_scope_close 
-
 
629
    PROTO_N ( ( findex ) )
-
 
630
    PROTO_T ( long findex )
-
 
631
{
-
 
632
  long i ;
-
 
633
  bracket_level-- ;
-
 
634
  if ( open_label != 0 ) {
-
 
635
    ready_scope ();
-
 
636
    open_label = 0 ;
-
 
637
  }
-
 
638
  i = next_d_lab () ;
659
  i = next_d_lab();
639
  fprintf ( dg_file, "\t.stabn\t0xe0,0,%ld,LL.%ld\n",
660
  fprintf(dg_file, "\t.stabn\t0xe0,0,%ld,LL.%ld\n",
640
	      bracket_level, i ) ;
661
	      bracket_level, i);
641
  fprintf ( dg_file, "LL.%ld:\n", i ) ;
662
  fprintf(dg_file, "LL.%ld:\n", i);
642
  return ;
663
  return;
643
}
664
}
644
 
665
 
645
 
666
 
646
/*
667
/*
647
  DEPTH COUNT FOR STAB TYPES
668
  DEPTH COUNT FOR STAB TYPES
648
*/
669
*/
649
 
670
 
650
static int max_depth = 64 ;
671
static int max_depth = 64;
651
static int depth_now = 0 ;
672
static int depth_now = 0;
652
 
673
 
653
 
674
 
654
/*
675
/*
655
  OUTPUT A DIAGNOSTICS TYPE
676
  OUTPUT A DIAGNOSTICS TYPE
656
*/
677
*/
657
 
678
 
658
#define OUT_DT_SHAPE( dt )	out_dt_shape ( ( depth_now = 0, dt ) )
679
#define OUT_DT_SHAPE(dt)	out_dt_shape((depth_now = 0, dt))
659
 
680
 
660
static void out_dt_shape 
681
static void out_dt_shape
661
    PROTO_N ( ( dt ) )
-
 
662
    PROTO_T ( diag_type dt )
682
(diag_type dt)
663
{
683
{
664
  if ( dt->been_outed ) {
684
  if (dt->been_outed) {
665
    fprintf ( dg_file, "%d",(int) dt->been_outed ) ;
685
    fprintf(dg_file, "%d",(int)dt->been_outed);
666
    last_type_sz = get_stab_size ( dt->been_outed ) ;
686
    last_type_sz = get_stab_size(dt->been_outed);
667
    return ;
687
    return;
668
  }
688
  }
669
  
-
 
670
  depth_now++ ;
-
 
671
  
-
 
672
  switch ( dt->key ) {
-
 
673
 
689
 
-
 
690
  depth_now++;
-
 
691
 
-
 
692
  switch (dt->key) {
-
 
693
 
674
    case DIAG_TYPE_PTR : {
694
    case DIAG_TYPE_PTR: {
675
      long non ;
695
      long non;
676
      diag_type pdt = dt->data.ptr.object ;
696
      diag_type pdt = dt->data.ptr.object;
677
      if ( pdt->key == DIAG_TYPE_VARIETY ) {
697
      if (pdt->key == DIAG_TYPE_VARIETY) {
678
	long pn = out_sh_type ( f_integer ( pdt->data.var ) ) ;
698
	long pn = out_sh_type(f_integer(pdt->data.var));
679
	non = stab_ptrs [ pn ] ;
699
	non = stab_ptrs[pn];
680
	if ( non == 0 ) {
700
	if (non == 0) {
681
	  non = next_typen () ;
701
	  non = next_typen();
682
	  stab_ptrs [ pn ] = non ;
702
	  stab_ptrs[pn] = non;
683
	  fprintf ( dg_file, "%ld=*%ld", non, pn ) ;
703
	  fprintf(dg_file, "%ld=*%ld", non, pn);
684
	} 
704
	}
685
	else {
705
	else {
686
	  fprintf ( dg_file, "%ld", non ) ;
706
	  fprintf(dg_file, "%ld", non);
687
	}
707
	}
688
      } 
708
      }
689
      else {
709
      else {
690
	non = next_typen () ;
710
	non = next_typen();
691
	fprintf ( dg_file, "%ld=*", non ) ;
711
	fprintf(dg_file, "%ld=*", non);
692
	out_dt_shape ( dt->data.ptr.object ) ;
712
	out_dt_shape(dt->data.ptr.object);
693
      }
713
      }
694
      dt->been_outed = non ;
714
      dt->been_outed = non;
695
      last_type_sz = 32 ;
715
      last_type_sz = 32;
696
      set_stab_size ( non ) ;
716
      set_stab_size(non);
697
      break ;
-
 
698
    }
-
 
699
    case DIAG_TYPE_ARRAY : {
-
 
700
      long lwb = no ( dt->data.array.lower_b ) ;
-
 
701
      long upb = no ( dt->data.array.upper_b ) ;
-
 
702
      diag_type index_type = dt->data.array.index_type ;
-
 
703
      diag_type element_type = dt->data.array.element_type ;
-
 
704
      long non = next_typen () ;
-
 
705
      dt->been_outed = non ;
-
 
706
      fprintf ( dg_file, "%ld=", non ) ;
-
 
707
      fprintf ( dg_file, "ar" ) ;
-
 
708
      out_dt_shape ( index_type ) ;
-
 
709
      fprintf ( dg_file, ";%ld;%ld;", lwb, upb ) ;
-
 
710
      out_dt_shape ( element_type ) ;
-
 
711
      last_type_sz *= ( upb - lwb + 1 ) ;
-
 
712
      set_stab_size ( non ) ;
-
 
713
      break ;
717
      break;
714
    }
718
    }
-
 
719
    case DIAG_TYPE_ARRAY: {
-
 
720
      long lwb = no(dt->data.array.lower_b);
-
 
721
      long upb = no(dt->data.array.upper_b);
-
 
722
      diag_type index_type = dt->data.array.index_type;
-
 
723
      diag_type element_type = dt->data.array.element_type;
-
 
724
      long non = next_typen();
-
 
725
      dt->been_outed = non;
-
 
726
      fprintf(dg_file, "%ld=", non);
-
 
727
      fprintf(dg_file, "ar");
-
 
728
      out_dt_shape(index_type);
-
 
729
      fprintf(dg_file, ";%ld;%ld;", lwb, upb);
-
 
730
      out_dt_shape(element_type);
-
 
731
      last_type_sz *= (upb - lwb + 1);
-
 
732
      set_stab_size(non);
-
 
733
      break;
-
 
734
    }
-
 
735
 
-
 
736
    case DIAG_TYPE_STRUCT:
-
 
737
    case DIAG_TYPE_UNION: {
-
 
738
      int i;
-
 
739
      char su;
-
 
740
      shape s;
-
 
741
      diag_field_list fields;
-
 
742
      long non = next_typen();
-
 
743
      dt->been_outed = non;
715
 
744
 
716
    case DIAG_TYPE_STRUCT :
-
 
717
    case DIAG_TYPE_UNION : {
-
 
718
      int i ;
-
 
719
      char su ;
-
 
720
      shape s ;
-
 
721
      diag_field_list fields ;
-
 
722
      long non = next_typen () ;
-
 
723
      dt->been_outed = non ;
-
 
724
      
-
 
725
      if ( dt->key == DIAG_TYPE_STRUCT ) {
745
      if (dt->key == DIAG_TYPE_STRUCT) {
726
	fields = dt->data.t_struct.fields ;
746
	fields = dt->data.t_struct.fields;
727
	s = dt->data.t_struct.tdf_shape ;
747
	s = dt->data.t_struct.tdf_shape;
728
	su = 's';
748
	su = 's';
729
      } 
749
      }
730
      else {
750
      else {
731
	fields = dt->data.t_union.fields ;
751
	fields = dt->data.t_union.fields;
732
	s = dt->data.t_union.tdf_shape;
752
	s = dt->data.t_union.tdf_shape;
733
	su = 'u' ;
753
	su = 'u';
734
      }
754
      }
735
      fprintf ( dg_file, "%ld=%c%d", non, su, shape_size ( s ) / 8 ) ;
755
      fprintf(dg_file, "%ld=%c%d", non, su, shape_size(s) / 8);
-
 
756
 
-
 
757
      for (i = fields->lastused - 1; i >= 0; i--) {
-
 
758
	diag_field sf = (fields->array)[i];
-
 
759
	long offset = no(sf->where);
736
 
760
 
737
      for ( i = fields->lastused - 1 ; i >= 0 ; i-- ) {
-
 
738
	diag_field sf =  ( fields->array ) [i] ;
-
 
739
	long offset = no ( sf->where );
-
 
740
	
-
 
741
/*	if ( depth_now >= max_depth ) return ;*/
761
/*	if ( depth_now >= max_depth ) return ;*/
742
	if(depth_now >= max_depth){
762
	if (depth_now >= max_depth) {
743
	  depth_now = 0;
763
	  depth_now = 0;
744
	  fprintf (dg_file, "\\\\\",0x80,0,%d,%d\n",0,0 ) ;
764
	  fprintf(dg_file, "\\\\\",0x80,0,%d,%d\n",0,0);
745
	  fprintf(dg_file,"\t.stabs\t\"");
765
	  fprintf(dg_file,	}
746
	}
-
 
747
	depth_now++ ;
766
	depth_now++;
748
	fprintf ( dg_file, "%s:", sf->field_name.ints.chars ) ;
767
	fprintf(dg_file, "%s:", sf->field_name.ints.chars);
749
	out_dt_shape ( sf->field_type ) ;
768
	out_dt_shape(sf->field_type);
750
	fprintf ( dg_file, ",%ld,%ld;", offset, last_type_sz ) ;
769
	fprintf(dg_file, ",%ld,%ld;", offset, last_type_sz);
751
      }
770
      }
752
      fprintf ( dg_file, ";" ) ;
771
      fprintf(dg_file, ";");
753
      last_type_sz = shape_size ( s ) ;
772
      last_type_sz = shape_size(s);
754
      set_stab_size ( non ) ;
773
      set_stab_size(non);
755
      break ;
774
      break;
756
    }
775
    }
757
  
776
 
758
    case DIAG_TYPE_VARIETY : {
777
    case DIAG_TYPE_VARIETY: {
759
      dt->been_outed = out_sh_type ( f_integer ( dt->data.var ) ) ;
778
      dt->been_outed = out_sh_type(f_integer(dt->data.var));
760
      fprintf ( dg_file, "%ld", dt->been_outed ) ;
779
      fprintf(dg_file, "%ld", dt->been_outed);
761
      break ;
780
      break;
762
    }
781
    }
763
  
782
 
764
    case DIAG_TYPE_PROC : {
783
    case DIAG_TYPE_PROC: {
765
      diag_type result_type = dt->data.proc.result_type ;
784
      diag_type result_type = dt->data.proc.result_type;
766
      long non1 = next_typen () ;
785
      long non1 = next_typen();
767
      long non2 = next_typen () ;
786
      long non2 = next_typen();
768
      dt->been_outed = non1 ;
787
      dt->been_outed = non1;
769
      fprintf ( dg_file, "%ld=*%ld=f", non1, non2 ) ;
788
      fprintf(dg_file, "%ld=*%ld=f", non1, non2);
770
      out_dt_shape ( result_type ) ;
789
      out_dt_shape(result_type);
771
      last_type_sz = 32 ;
790
      last_type_sz = 32;
772
      set_stab_size ( non1 ) ;
791
      set_stab_size(non1);
773
      set_stab_size ( non2 ) ;
792
      set_stab_size(non2);
774
      break ;
793
      break;
775
    }
794
    }
776
  
795
 
777
    case DIAG_TYPE_LOC : {
796
    case DIAG_TYPE_LOC: {
778
      /* +++ use qualifier which gives "const"/"volatile" */
797
      /* +++ use qualifier which gives "const"/"volatile" */
779
      out_dt_shape ( dt->data.loc.object ) ;
798
      out_dt_shape(dt->data.loc.object);
780
      break ;
-
 
781
    }
-
 
782
  
-
 
783
    case DIAG_TYPE_FLOAT : {
-
 
784
      dt->been_outed = out_sh_type ( f_floating ( dt->data.f_var ) ) ;
-
 
785
      fprintf ( dg_file, "%ld", dt->been_outed ) ;
-
 
786
      break ;
799
      break;
787
    }
800
    }
-
 
801
 
-
 
802
    case DIAG_TYPE_FLOAT: {
-
 
803
      dt->been_outed = out_sh_type(f_floating(dt->data.f_var));
-
 
804
      fprintf(dg_file, "%ld", dt->been_outed);
-
 
805
      break;
788
   
806
    }
-
 
807
 
789
    case DIAG_TYPE_NULL : {
808
    case DIAG_TYPE_NULL: {
790
      fprintf ( dg_file, "%d", STAB_VOID ) ;
809
      fprintf(dg_file, "%d", STAB_VOID);
791
      last_type_sz = 0 ;
810
      last_type_sz = 0;
792
      break ;
811
      break;
793
    }
812
    }
794
  
813
 
795
    case DIAG_TYPE_BITFIELD : {
814
    case DIAG_TYPE_BITFIELD: {
796
      long sz = dt->data.bitfield.no_of_bits.nat_val.small_nat ;
815
      long sz = dt->data.bitfield.no_of_bits.nat_val.small_nat;
797
      fprintf ( dg_file, "%d", STAB_SLONG ) ;
816
      fprintf(dg_file, "%d", STAB_SLONG);
798
      last_type_sz = sz ;
817
      last_type_sz = sz;
799
      break ;
818
      break;
800
    }
819
    }
801
 
820
 
802
    case DIAG_TYPE_ENUM : {
821
    case DIAG_TYPE_ENUM: {
803
      int i ;
822
      int i;
804
      enum_values_list enumvals = dt->data.t_enum.values;
823
      enum_values_list enumvals = dt->data.t_enum.values;
805
      long non = next_typen () ;
824
      long non = next_typen();
806
      dt->been_outed = non ;
825
      dt->been_outed = non;
807
      fprintf ( dg_file, "%ld=e", non ) ;
826
      fprintf(dg_file, "%ld=e", non);
808
      for ( i = enumvals->lastused - 1 ; i >= 0 ; i-- ) {
827
      for (i = enumvals->lastused - 1; i >= 0; i--) {
809
	  enum_values ef =  ( enumvals->array ) [i] ;
828
	  enum_values ef = (enumvals->array)[i];
810
	  fprintf ( dg_file, "%s:%d,", ef->nme.ints.chars, no ( ef->val ) );
829
	  fprintf(dg_file, "%s:%d,", ef->nme.ints.chars, no(ef->val));
811
      }
830
      }
812
      fprintf ( dg_file, ";" ) ;
831
      fprintf(dg_file, ";");
813
      last_type_sz = 32 ;
832
      last_type_sz = 32;
814
      set_stab_size ( non ) ;
833
      set_stab_size(non);
815
      break ;
834
      break;
816
    }
835
    }
817
 
836
 
818
    default : {
837
    default : {
819
      fprintf ( dg_file, "%d", STAB_VOID ) ;
838
      fprintf(dg_file, "%d", STAB_VOID);
820
      last_type_sz = 0 ;
839
      last_type_sz = 0;
821
      break ;
840
      break;
822
    }
841
    }
823
  }
842
  }
824
    return ;
843
    return;
825
}
844
}
826
 
845
 
827
 
846
 
828
/*
847
/*
829
  OUTPUT DIAGNOSTICS FOR A GLOBAL VARIABLE
848
  OUTPUT DIAGNOSTICS FOR A GLOBAL VARIABLE
830
*/
849
*/
831
 
850
 
832
void stab_global 
851
void stab_global
833
    PROTO_N ( ( dd, global, id, ext ) )
-
 
834
    PROTO_T ( diag_descriptor * dd X exp global X char * id X bool ext )
852
(diag_descriptor * dd, exp global, char * id, bool ext)
835
{
853
{
836
  if ( dd == NULL ) return ;
854
  if (dd == NULL) return;
837
  
-
 
838
  stabd ( find_file ( dd->data.id.whence.file->file.ints.chars ),
-
 
839
	 ( long ) dd->data.id.whence.line_no.nat_val.small_nat
-
 
840
	 , -N_DSLINE ) ;
-
 
841
 
855
 
-
 
856
  stabd(find_file(dd->data.id.whence.file->file.ints.chars),
-
 
857
	(long)dd->data.id.whence.line_no.nat_val.small_nat
-
 
858
	 , -N_DSLINE);
-
 
859
 
842
  fprintf ( dg_file, "\t.stabs\t\"%s:%c", dd->data.id.nme.ints.chars,
860
  fprintf(dg_file, "\t.stabs\t\"%s:%c", dd->data.id.nme.ints.chars,
843
	   ( ext ? 'G' : 'S' ) ) ;
861
	  (ext ? 'G' : 'S'));
844
  OUT_DT_SHAPE ( dd->data.id.new_type ) ;
862
  OUT_DT_SHAPE(dd->data.id.new_type);
845
  fprintf ( dg_file, "\",%#x,0,%d,%s\n", ( ext ? 0x24 : ((no(global)!=0)?0x26:0x28) ),
863
  fprintf(dg_file, "\",%#x,0,%d,%s\n",(ext ? 0x24 :((no(global)!=0)?0x26:0x28)),
846
	   dd->data.id.whence.line_no.nat_val.small_nat /*0*/,
864
	   dd->data.id.whence.line_no.nat_val.small_nat /*0*/,
847
	   id
865
	   id
848
	   ) ;
866
	  );
849
  return ;
867
  return;
850
}
868
}
851
 
869
 
852
 
870
 
853
/*
871
/*
854
  OUTPUT DIAGNOSTICS FOR A PROCEDURE
872
  OUTPUT DIAGNOSTICS FOR A PROCEDURE
855
*/
873
*/
856
 
874
 
857
void stab_proc 
875
void stab_proc
858
    PROTO_N ( ( dd, proc, id, ext ) )
-
 
859
    PROTO_T ( diag_descriptor * dd X exp proc X char * id X bool ext )
876
(diag_descriptor * dd, exp proc, char * id, bool ext)
860
{
877
{
861
  if ( dd == NULL ) return ;
878
  if (dd == NULL) return;
862
  
-
 
863
  stabd ( find_file ( dd->data.id.whence.file->file.ints.chars ),
-
 
864
	 ( long ) dd->data.id.whence.line_no.nat_val.small_nat 
-
 
865
	 ,0) ;
-
 
866
 
879
 
-
 
880
  stabd(find_file(dd->data.id.whence.file->file.ints.chars),
-
 
881
	(long)dd->data.id.whence.line_no.nat_val.small_nat
-
 
882
	 ,0);
-
 
883
 
867
  fprintf ( dg_file, "\t.stabs\t\"%s:%c",
884
  fprintf(dg_file, "\t.stabs\t\"%s:%c",
868
	   dd->data.id.nme.ints.chars, ( ext ? 'F' : 'f' ) ) ;
885
	   dd->data.id.nme.ints.chars,(ext ? 'F' : 'f'));
869
  OUT_DT_SHAPE ( dd->data.id.new_type->data.proc.result_type ) ;
886
  OUT_DT_SHAPE(dd->data.id.new_type->data.proc.result_type);
870
  fprintf ( dg_file, "\",0x24,0,%d,%s\n", 0, id ) ;
887
  fprintf(dg_file, "\",0x24,0,%d,%s\n", 0, id);
871
  return ;
888
  return;
872
}
889
}
873
 
890
 
874
 
891
 
875
/*
892
/*
876
  OUTPUT DIAGNOSTICS FOR A LOCAL VARIABLE
893
  OUTPUT DIAGNOSTICS FOR A LOCAL VARIABLE
877
*/
894
*/
878
 
895
 
879
void stab_local
896
void stab_local
880
    PROTO_N ( ( nm, dt, ldid, disp, findex ) )
-
 
881
    PROTO_T ( char *nm X diag_type dt X exp ldid X long disp X long findex )
897
(char *nm, diag_type dt, exp ldid, long disp, long findex)
882
{
898
{
883
  exp id = son ( ldid ) ;
899
  exp id = son(ldid);
884
 
900
 
885
  if (name (id) == ident_tag && ((props (id) & defer_bit) == 0))
901
  if (name(id) == ident_tag && ((props(id) & defer_bit) == 0))
886
    disp += boff ( id ).offset ;	/* is this condition right ? */
902
    disp += boff ( id ).offset ;	/* is this condition right ? */
887
  again :
903
  again :
888
    if ( name ( id ) == ident_tag ) {
904
    if (name(id) == ident_tag) {
889
      if ( ( props ( id ) & defer_bit ) == 0 ) {
905
      if ((props(id) & defer_bit) == 0) {
890
	/* +++ add assembler comment to say which reg is being used */
906
	/* +++ add assembler comment to say which reg is being used */
891
	if ( isparam ( id ) ) {
907
	if (isparam(id)) {
892
	  fprintf ( dg_file, "\t.stabs\t\"%s:p", nm ) ;
908
	  fprintf(dg_file, "\t.stabs\t\"%s:p", nm);
893
	  OUT_DT_SHAPE ( dt ) ;
909
	  OUT_DT_SHAPE(dt);
894
	  fprintf ( dg_file, "\",0xa0,0,%d,%ld\n",
910
	  fprintf(dg_file, "\",0xa0,0,%d,%ld\n",
895
		    0,
911
		    0,
896
		    disp ) ;
912
		    disp);
897
	  if(disp <= 88) { /* register useage comment */
913
	  if(disp <= 88) { /* register useage comment */
898
	    fprintf(dg_file, "\t.stabs\t\"%s:r",nm);
914
	    fprintf(dg_file, "\t.stabs\t\"%s:r",nm);
899
	    OUT_DT_SHAPE(dt);
915
	    OUT_DT_SHAPE(dt);
900
	    fprintf(dg_file,"\",0x40,0,%d,%ld\n",0,24+ ((disp-68)/4));
916
	    fprintf(dg_file,"\",0x40,0,%d,%ld\n",0,24+ ((disp-68) /4));
901
	  }
917
	  }
902
	  return ;
918
	  return;
903
	} 
919
	}
904
	else {
920
	else {
905
	  fprintf ( dg_file, "\t.stabs\t\"%s:", nm ) ;
921
	  fprintf(dg_file, "\t.stabs\t\"%s:", nm);
906
	  OUT_DT_SHAPE ( dt ) ;
922
	  OUT_DT_SHAPE(dt);
907
	  fprintf ( dg_file, "\",0x80,0,%d,%ld\n",
923
	  fprintf(dg_file, "\",0x80,0,%d,%ld\n",
908
		    0,
924
		    0,
909
		    disp ) ;
925
		    disp);
910
	  return ;
926
	  return;
911
	}
927
	}
912
      } 
928
      }
913
      else {
929
      else {
914
	exp sn = son ( id ) ;
930
	exp sn = son(id);
915
	long d = disp ;
931
	long d = disp;
916
 
932
 
917
	while ( sn != nilexp ) {
933
	while (sn != nilexp) {
918
	  switch ( name ( sn ) ) {
934
	  switch (name(sn)) {
919
	    case name_tag : {
935
	    case name_tag: {
920
	      disp = d + no ( sn ) ;
936
	      disp = d + no(sn);
921
	      id = son ( sn ) ;
937
	      id = son(sn);
922
	      if ( isvar ( id ) ) dt = dt->data.ptr.object ;
938
	      if (isvar(id))dt = dt->data.ptr.object;
923
	      goto again ;
939
	      goto again;
924
	    }
940
	    }
925
	    case reff_tag : {
941
	    case reff_tag: {
926
	      d += no ( sn ) ;
942
	      d += no(sn);
927
	      sn = son ( sn ) ;
943
	      sn = son(sn);
928
	      break ;
944
	      break;
929
	    }
945
	    }
930
	    case cont_tag : {
946
	    case cont_tag: {
931
	      sn = son ( sn ) ;
947
	      sn = son(sn);
932
	      break ;
948
	      break;
933
	    }
949
	    }
934
	    default : {
950
	    default : {
935
	      return ;
951
	      return;
936
	    }
952
	    }
937
	  }
953
	  }
938
	}
954
	}
939
      }
955
      }
940
    }
956
    }
941
  return ;
957
  return;
942
}
958
}
943
 
959
 
944
 
960
 
945
/*
961
/*
946
  DEAL WITH BASIC TYPES
962
  DEAL WITH BASIC TYPES
947
*/
963
*/
948
 
964
 
949
void stab_types 
965
void stab_types
950
    PROTO_Z ()
966
(void)
951
{
967
{
952
  total_type_sizes = NO_STABS ;
968
  total_type_sizes = NO_STABS;
953
  typeno = NO_STABS ;
969
  typeno = NO_STABS;
954
  type_sizes = ( long * ) xmalloc ( NO_STABS * sizeof ( long ) ) ;
970
  type_sizes = (long *)xmalloc(NO_STABS * sizeof(long));
955
  fputs ( "\t.stabs\t\"int:t1=r1;-2147483648;2147483647;\",0x80,0,0,0\n", dg_file ) ;
971
  fputs("\t.stabs\t\"int:t1=r1;-2147483648;2147483647;\",0x80,0,0,0\n", dg_file);
956
  fputs ( "\t.stabs\t\"short int:t2=r1;-32768;32767;\",0x80,0,0,0\n",
972
  fputs("\t.stabs\t\"short int:t2=r1;-32768;32767;\",0x80,0,0,0\n",
957
	    dg_file ) ;
973
	    dg_file);
958
  fputs ( "\t.stabs\t\"short unsigned int:t3=r1;0;65535;\",0x80,0,0,0\n", dg_file ) ;
974
  fputs("\t.stabs\t\"short unsigned int:t3=r1;0;65535;\",0x80,0,0,0\n", dg_file);
959
  fputs ( "\t.stabs\t\"char:t4=r4;0;127;\",0x80,0,0,0\n", dg_file ) ;
975
  fputs("\t.stabs\t\"char:t4=r4;0;127;\",0x80,0,0,0\n", dg_file);
960
  fputs ( "\t.stabs\t\"signed char:t5=r1;-128;127;\",0x80,0,0,0\n",
976
  fputs("\t.stabs\t\"signed char:t5=r1;-128;127;\",0x80,0,0,0\n",
961
	  dg_file ) ;
977
	  dg_file);
962
  fputs ( "\t.stabs\t\"unsigned char:t6=r1;0;255;\",0x80,0,0,0\n",
978
  fputs("\t.stabs\t\"unsigned char:t6=r1;0;255;\",0x80,0,0,0\n",
963
	  dg_file ) ;
979
	  dg_file);
964
  fputs ( "\t.stabs\t\"long int:t7=r1;-2147483648;2147483647;\",0x80,0,0,0\n", dg_file ) ;
980
  fputs("\t.stabs\t\"long int:t7=r1;-2147483648;2147483647;\",0x80,0,0,0\n", dg_file);
965
    fputs ( "\t.stabs\t\"unsigned int:t8=r1;0;-1;\",0x80,0,0,0\n",
981
    fputs("\t.stabs\t\"unsigned int:t8=r1;0;-1;\",0x80,0,0,0\n",
966
	    dg_file ) ;
982
	    dg_file);
967
    fputs ( "\t.stabs\t\"long unsigned int:t9=r1;0;-1;\",0x80,0,0,0\n",
983
    fputs("\t.stabs\t\"long unsigned int:t9=r1;0;-1;\",0x80,0,0,0\n",
968
	    dg_file ) ;
984
	    dg_file);
969
    fputs ( "\t.stabs\t\"float:t10=r1;4;0;\",0x80,0,0,0\n", dg_file ) ;
985
    fputs("\t.stabs\t\"float:t10=r1;4;0;\",0x80,0,0,0\n", dg_file);
970
    fputs ( "\t.stabs\t\"double:t11=r1;8;0;\",0x80,0,0,0\n", dg_file ) ;
986
    fputs("\t.stabs\t\"double:t11=r1;8;0;\",0x80,0,0,0\n", dg_file);
971
    fprintf ( dg_file, "\t.stabs\t\"long double:t12=r1;%ld;0;\",0x80,0,0,0\n",
987
    fprintf(dg_file, "\t.stabs\t\"long double:t12=r1;%ld;0;\",0x80,0,0,0\n",
972
	      DOUBLE_SZ / 8 ) ;
988
	      DOUBLE_SZ / 8);
973
    fputs ( "\t.stabs\t\"void:t13=13\",0x80,0,0,0\n", dg_file ) ;
989
    fputs("\t.stabs\t\"void:t13=13\",0x80,0,0,0\n", dg_file);
974
    type_sizes [0] = 0 ;
990
    type_sizes[0] = 0;
975
    type_sizes [1] = 32 ;
991
    type_sizes[1] = 32;
976
    type_sizes [2] = 16 ;
992
    type_sizes[2] = 16;
977
    type_sizes [3] = 16 ;
993
    type_sizes[3] = 16;
978
    type_sizes [4] = 8 ;
994
    type_sizes[4] = 8;
979
    type_sizes [5] = 8 ;
995
    type_sizes[5] = 8;
980
    type_sizes [6] = 8 ;
996
    type_sizes[6] = 8;
981
    type_sizes [7] = 32 ;
997
    type_sizes[7] = 32;
982
    type_sizes [8] = 32 ;
998
    type_sizes[8] = 32;
983
    type_sizes [9] = 32 ;
999
    type_sizes[9] = 32;
984
    type_sizes [10] = 32 ;
1000
    type_sizes[10] = 32;
985
    type_sizes [11] = 64 ;
1001
    type_sizes[11] = 64;
986
    type_sizes [12] = DOUBLE_SZ ;
1002
    type_sizes[12] = DOUBLE_SZ;
987
    type_sizes [13] = 0 ;
1003
    type_sizes[13] = 0;
988
    return ;
1004
    return;
989
}
1005
}
990
 
1006
 
991
 
1007
 
992
/*
1008
/*
993
    DEAL WITH STRUCTURE, UNION AND ENUM TAGS
1009
    DEAL WITH STRUCTURE, UNION AND ENUM TAGS
994
*/
1010
*/
995
 
1011
 
996
void stab_tagdefs
1012
void stab_tagdefs
997
    PROTO_Z ()
1013
(void)
998
{
1014
{
999
    diag_tagdef **di = unit_ind_diagtags ;
1015
    diag_tagdef **di = unit_ind_diagtags;
1000
    int i, n = unit_no_of_diagtags, istag ;
1016
    int i, n = unit_no_of_diagtags, istag;
1001
 
1017
 
1002
    for ( i = 0 ; i < n ; i++ ) {
1018
    for (i = 0; i < n; i++) {
1003
	diag_type d = di [i]->d_type ;
1019
	diag_type d = di[i] ->d_type;
1004
	istag = 1;
1020
	istag = 1;
1005
 
1021
 
1006
	switch ( d->key ) {
1022
	switch (d->key) {
1007
 
1023
 
1008
	    case DIAG_TYPE_STRUCT : {
1024
	    case DIAG_TYPE_STRUCT: {
1009
		char *nme = d->data.t_struct.nme.ints.chars ;
1025
		char *nme = d->data.t_struct.nme.ints.chars;
1010
		if ( nme && *nme ) {
1026
		if (nme && *nme) {
1011
		    fprintf ( dg_file, "\t.stabs\t\"%s:", nme ) ;
1027
		    fprintf(dg_file, "\t.stabs\t\"%s:", nme);
1012
		} else {
1028
		} else {
1013
		    static int s_count = 0 ;
1029
		    static int s_count = 0;
1014
		    fprintf ( dg_file, "\t.stabs\t\"_struct%d:", s_count++ ) ;
1030
		    fprintf(dg_file, "\t.stabs\t\"_struct%d:", s_count++);
-
 
1031
		}
-
 
1032
		break;
-
 
1033
	    }
-
 
1034
	    case DIAG_TYPE_UNION: {
-
 
1035
		char *nme = d->data.t_union.nme.ints.chars;
-
 
1036
		if (nme && *nme) {
-
 
1037
		    fprintf(dg_file, "\t.stabs\t\"%s:", nme);
-
 
1038
		} else {
-
 
1039
		    static int u_count = 0;
-
 
1040
		    fprintf(dg_file, "\t.stabs\t\"_union%d:", u_count++);
1015
		}
1041
		}
1016
		break ;
1042
		break;
1017
	    }
1043
	    }
1018
	    case DIAG_TYPE_UNION : {
1044
	    case DIAG_TYPE_ENUM: {
1019
		char *nme = d->data.t_union.nme.ints.chars ;
1045
		char *nme = d->data.t_enum.nme.ints.chars;
1020
		if ( nme && *nme ) {
1046
		if (nme && *nme) {
1021
		    fprintf ( dg_file, "\t.stabs\t\"%s:", nme ) ;
1047
		    fprintf(dg_file, "\t.stabs\t\"%s:", nme);
1022
		} else {
1048
		} else {
1023
		    static int u_count = 0 ;
1049
		    static int e_count = 0;
1024
		    fprintf ( dg_file, "\t.stabs\t\"_union%d:", u_count++ ) ;
1050
		    fprintf(dg_file, "\t.stabs\t\"_enum%d:", e_count++);
1025
		}
1051
		}
1026
		break ;
1052
		break;
1027
	    }
-
 
1028
	    case DIAG_TYPE_ENUM : {
-
 
1029
		char *nme = d->data.t_enum.nme.ints.chars ;
-
 
1030
		if ( nme && *nme ) {
-
 
1031
		    fprintf ( dg_file, "\t.stabs\t\"%s:", nme ) ;
-
 
1032
		} else {
-
 
1033
		    static int e_count = 0 ;
-
 
1034
		    fprintf ( dg_file, "\t.stabs\t\"_enum%d:", e_count++ ) ;
-
 
1035
		}
-
 
1036
		break ;
-
 
1037
	    }
-
 
1038
	    default: {
-
 
1039
		istag = 0 ;
-
 
1040
		break ;
-
 
1041
	    }
1053
	    }
-
 
1054
	    default: {
-
 
1055
		istag = 0;
-
 
1056
		break;
-
 
1057
	    }
1042
	}
1058
	}
1043
	if (istag) {
1059
	if (istag) {
1044
	    if ( d->been_outed && 0) {
1060
	    if (d->been_outed && 0) {
1045
		fprintf ( dg_file, "%d", (int)d->been_outed ) ;
1061
		fprintf(dg_file, "%d",(int)d->been_outed);
1046
	    } else {
1062
	    } else {
1047
		fprintf ( dg_file, "T" ) ;
1063
		fprintf(dg_file, "T");
1048
		OUT_DT_SHAPE ( d ) ;
1064
		OUT_DT_SHAPE(d);
1049
	    }
1065
	    }
1050
	    fprintf ( dg_file, "\",0x80,0,0,0\n" ) ;
1066
	    fprintf(dg_file, "\",0x80,0,0,0\n");
1051
	}
1067
	}
1052
    }
1068
    }
1053
    return ;
1069
    return;
1054
}
1070
}
1055
 
1071
 
1056
 
1072
 
1057
/*
1073
/*
1058
  DEAL WITH TYPEDEFS
1074
  DEAL WITH TYPEDEFS
1059
*/
1075
*/
1060
 
1076
 
1061
void stab_typedefs 
1077
void stab_typedefs
1062
    PROTO_Z ()
1078
(void)
1063
{
1079
{
1064
  diag_descriptor *di = unit_diagvar_tab.array ;
1080
  diag_descriptor *di = unit_diagvar_tab.array;
1065
  int i, n = unit_diagvar_tab.lastused ;
1081
  int i, n = unit_diagvar_tab.lastused;
1066
  for ( i = 0 ; i < n ; i++ ) {
1082
  for (i = 0; i < n; i++) {
1067
    if ( di [i].key == DIAG_TYPEDEF_KEY ) {
1083
    if (di[i].key == DIAG_TYPEDEF_KEY) {
1068
      long non = next_typen () ;
1084
      long non = next_typen();
1069
      fprintf ( dg_file, "\t.stabs\t\"%s:t%ld=",
1085
      fprintf(dg_file, "\t.stabs\t\"%s:t%ld=",
1070
		di [i].data.typ.nme.ints.chars, non ) ;
1086
		di[i].data.typ.nme.ints.chars, non);
1071
      OUT_DT_SHAPE ( di [i].data.typ.new_type ) ;
1087
      OUT_DT_SHAPE(di[i].data.typ.new_type);
1072
      fprintf ( dg_file, "\",0x80,0,0,0\n" ) ;
1088
      fprintf(dg_file, "\",0x80,0,0,0\n");
1073
    }
1089
    }
1074
  }
1090
  }
1075
  return ;
1091
  return;
1076
}
1092
}