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
#include "config.h"
32
#if FS_STDARG
33
#include <stdarg.h>
34
#else
35
#include <varargs.h>
36
#endif
37
#include <limits.h>
38
#include "system.h"
39
#include "version.h"
40
#include "c_types.h"
41
#include "err_ext.h"
42
#include "exp_ops.h"
43
#include "loc_ext.h"
44
#include "error.h"
45
#include "catalog.h"
46
#include "option.h"
47
#include "tdf.h"
48
#include "basetype.h"
49
#include "buffer.h"
50
#include "capsule.h"
51
#include "dump.h"
52
#include "file.h"
53
#include "lex.h"
54
#include "literal.h"
55
#include "preproc.h"
56
#include "print.h"
57
#include "save.h"
58
#include "statement.h"
59
#include "ustring.h"
60
#include "xalloc.h"
61
 
62
 
63
/*
64
    PROGRAM NAME
65
 
66
    These variables give the program name and version number.
67
*/
68
 
69
CONST char *progname = NULL ;
70
CONST char *progvers = NULL ;
71
 
72
 
73
/*
74
    SET PROGRAM NAME
75
 
76
    This routine sets the program name to the basename of prog and the
77
    program version to vers.
78
*/
79
 
80
void set_progname
81
    PROTO_N ( ( prog, vers ) )
82
    PROTO_T ( CONST char *prog X CONST char *vers )
83
{
84
    error_file = stderr ;
85
    if ( prog ) {
86
	char *s = strrchr ( prog, '/' ) ;
87
	if ( s ) prog = s + 1 ;
88
	s = strrchr ( prog, file_sep ) ;
89
	if ( s ) prog = s + 1 ;
90
	progname = prog ;
91
    } else {
92
	progname = "unknown" ;
93
    }
94
    progvers = vers ;
95
    return ;
96
}
97
 
98
 
99
/*
100
    PRINT VERSION NUMBER
101
 
102
    This routine prints the program name and version number plus the
103
    versions of C++ and the TDF specification it supports to the print
104
    buffer, returning the result.
105
*/
106
 
107
string report_version
108
    PROTO_N ( ( vers ) )
109
    PROTO_T ( int vers )
110
{
111
    BUFFER *bf = clear_buffer ( &print_buff, NIL ( FILE ) ) ;
112
    bfprintf ( bf, "%x: Version %x", progname, progvers ) ;
113
    if ( vers ) {
114
	char buff [20] ;
115
	char *v = LANGUAGE_VERSION ;
116
	sprintf_v ( buff, "%.4s-%.2s", v, v + 4 ) ;
117
	bfprintf ( bf, " (%x %x", LANGUAGE_NAME, buff ) ;
118
	bfprintf ( bf, " to TDF %d.%d", TDF_major, TDF_minor ) ;
119
#ifdef RELEASE
120
	bfprintf ( bf, ", Release %x", RELEASE ) ;
121
#endif
122
	bfprintf ( bf, ")" ) ;
123
    }
124
    return ( bf->start ) ;
125
}
126
 
127
 
128
/*
129
    CURRENT FILE POSITION
130
 
131
    This structure gives the current file position.  This consists of a
132
    string, giving the file name, an integer, giving the line number, and
133
    a pointer to any previous positions from which this is derived by a
134
    #include directive.
135
*/
136
 
137
LOCATION crt_loc = NULL_loc ;
138
LOCATION builtin_loc = NULL_loc ;
139
 
140
 
141
/*
142
    ERROR REPORTING VARIABLES
143
 
144
    These variables are used by the error reporting routines.  exit_status
145
    gives the overall status of the program - it is EXIT_SUCCESS if no
146
    serious errors have occurred, and EXIT_FAILURE otherwise.  A count of
147
    the number of serious errors is kept in number_errors, up to a maximum
148
    of max_errors.
149
*/
150
 
151
FILE *error_file = NULL ;
152
int exit_status = EXIT_SUCCESS ;
153
unsigned long number_errors = 0 ;
154
unsigned long number_warnings = 0 ;
155
unsigned long max_errors = 32 ;
156
int error_threshold = ERROR_NONE ;
157
int no_error_args = 0 ;
158
int verbose = 0 ;
159
static int print_short = 0 ;
160
static int print_error_loc = 0 ;
161
static int print_error_name = 0 ;
162
static int print_error_source = 0 ;
163
static int print_iso_ref = 1 ;
164
static int print_ansi_ref = 0 ;
165
 
166
 
167
/*
168
    PROCESS AN ERROR FORMATTING OPTION
169
 
170
    This routine processes the error formatting options given by opt.
171
    This corresponds to the command-line option '-mopt'.
172
*/
173
 
174
void error_option
175
    PROTO_N ( ( opt ) )
176
    PROTO_T ( string opt )
177
{
178
    int out = 1 ;
179
    character c ;
180
    while ( c = *( opt++ ), c != 0 ) {
181
	switch ( c ) {
182
	    case 'a' : print_ansi_ref = out ; break ;
183
	    case 'c' : print_error_source = out ; break ;
184
	    case 'e' : print_error_name = out ; break ;
185
	    case 'f' : good_fseek = out ; break ;
186
	    case 'g' : record_location = out ; break ;
187
	    case 'i' : good_stat = out ; break ;
188
	    case 'k' : output_spec = out ; break ;
189
	    case 'l' : print_error_loc = out ; break ;
190
	    case 'm' : allow_multibyte = out ; break ;
191
	    case 'p' : preproc_space = out ; break ;
192
	    case 'q' : print_short = out ; break ;
193
	    case 'r' : allow_dos_newline = out ; break ;
194
	    case 's' : print_iso_ref = out ; break ;
195
	    case 't' : print_type_alias = out ; break ;
196
	    case 'x' : print_c_style = out ; break ;
197
	    case '+' : out = 1 ; break ;
198
	    case '-' : out = 0 ; break ;
199
	    case 'o' : {
200
		error_file = ( out ? stdout : stderr ) ;
201
		break ;
202
	    }
203
	    case 'w' : {
204
		OPTION sev = OPTION_WARN ;
205
		if ( out ) sev = OPTION_OFF ;
206
		OPT_CATALOG [ OPT_warning ].def [0] = sev ;
207
		OPT_CATALOG [ OPT_warning ].def [1] = sev ;
208
		break ;
209
	    }
210
	    case 'z' : {
211
		OPTION sev = OPTION_ON ;
212
		if ( out ) sev = OPTION_WARN ;
213
		OPT_CATALOG [ OPT_error ].def [0] = sev ;
214
		OPT_CATALOG [ OPT_error ].def [1] = sev ;
215
		break ;
216
	    }
217
	    default : {
218
		/* Unknown output options */
219
		CONST char *err = "Unknown error formatting option, '%c'" ;
220
		error ( ERROR_WARNING, err, ( int ) c ) ;
221
		break ;
222
	    }
223
	}
224
    }
225
    return ;
226
}
227
 
228
 
229
/*
230
    ERROR MESSAGE PARAMETERS
231
 
232
    These macros are used to parameterise the form of the error messages.
233
*/
234
 
235
#define HEADER_FATAL		"Fatal error"
236
#define HEADER_SERIOUS		"Error"
237
#define HEADER_WARNING		"Warning"
238
#define HEADER_INTERNAL		"Internal error"
239
#define HEADER_ASSERT		"Assertion"
240
 
241
#define PRINT_HEADER( M, L, F )\
242
	print_location ( ( L ), ( F ) ) ;\
243
	fputs_v ( ": ", ( F ) ) ;\
244
	fputs_v ( ( M ), ( F ) ) ;\
245
	fputs_v ( ":\n", ( F ) )
246
 
247
#define PRINT_SOURCE( L, F )\
248
	print_source ( ( L ), 1, 0, "    ", ( F ) )
249
 
250
#define PRINT_FROM( L, F )\
251
	fputs_v ( "    (included from ", ( F ) ) ;\
252
	print_location ( ( L ), ( F ) ) ;\
253
	fputs_v ( ")\n", ( F ) )
254
 
255
#define PRINT_START( M, F )\
256
	fputs_v ( ( M ), ( F ) ) ;\
257
	fputs_v ( ": ", ( F ) )
258
 
259
#define MESSAGE_START		"  "
260
#define MESSAGE_END		".\n"
261
#define MESSAGE_TERM		"\n"
262
#define MESSAGE_NAME		"[%x]: "
263
#define MESSAGE_ISO		"[ISO %x]: "
264
#define MESSAGE_ANSI		"[ANSI "
265
#define MESSAGE_ANSI_END	"]: "
266
#define MESSAGE_PRAGMA		"[Pragma]: "
267
#define MESSAGE_PRINTF		"[Printf]: "
268
#define MESSAGE_SYNTAX		"[Syntax]: "
269
#define MESSAGE_TOKEN		"[Token]: "
270
 
271
 
272
/*
273
    FORWARD DECLARATION
274
 
275
    The following forward declaration is necessary.
276
*/
277
 
278
static void print_error_msg PROTO_S ( ( ERROR, LOCATION *, FILE * ) ) ;
279
 
280
 
281
/*
282
    TERMINATE PROGRAM
283
 
284
    This routine is called to terminate the program.  It tidies up any
285
    output files and error messages and then exits.  fatal is true after
286
    a memory allocation error when the amount of tidying up which can
287
    be done is limited, although some memory is freed to give a little
288
    leeway.
289
*/
290
 
291
void term_error
292
    PROTO_N ( ( fatal ) )
293
    PROTO_T ( int fatal )
294
{
295
    if ( fatal ) {
296
	/* Cope with memory allocation errors */
297
	exit_status = EXIT_FAILURE ;
298
	output_capsule = 0 ;
299
	output_spec = 0 ;
300
	free_buffer ( &token_buff ) ;
301
    }
302
    if ( do_dump ) {
303
	/* End dump file */
304
	term_dump () ;
305
	do_dump = 0 ;
306
    }
307
    if ( do_error ) {
308
	/* Report errors in dump file */
309
	unsigned long e = number_errors ;
310
	unsigned long w = number_warnings ;
311
	int sev = ( e ? ERROR_SERIOUS : ERROR_WARNING ) ;
312
	do_error = 0 ;
313
	error ( sev, "%lu error(s), %lu warning(s)", e, w ) ;
314
    }
315
    if ( output_name [ OUTPUT_SPEC ] ) {
316
	/* Write spec file */
317
	begin_spec () ;
318
	end_spec () ;
319
    }
320
    if ( output_tdf ) {
321
	/* Write capsule */
322
	write_capsule () ;
323
    }
324
    exit ( exit_status ) ;
325
}
326
 
327
 
328
/*
329
    ERROR BREAKPOINT ROUTINE
330
 
331
    This routine is intended to aid in debugging.  It is called just after
332
    any error message is printed.
333
*/
334
 
335
static void error_break
336
    PROTO_Z ()
337
{
338
    return ;
339
}
340
 
341
 
342
/*
343
    FIND AN ERROR MESSAGE HEADER
344
 
345
    This routine returns the error message header for an error of severity
346
    sev.  It also updates the internal flags.
347
*/
348
 
349
static CONST char *error_header
350
    PROTO_N ( ( sev ) )
351
    PROTO_T ( int sev )
352
{
353
    CONST char *msg ;
354
    switch ( sev ) {
355
	case ERROR_FATAL : {
356
	    msg = HEADER_FATAL ;
357
	    exit_status = EXIT_FAILURE ;
358
	    output_capsule = 0 ;
359
	    number_errors++ ;
360
	    break ;
361
	}
362
	case ERROR_INTERNAL : {
363
	    msg = HEADER_INTERNAL ;
364
	    if ( error_severity [ OPTION_ON ] == ERROR_SERIOUS ) {
365
		exit_status = EXIT_FAILURE ;
366
		output_capsule = 0 ;
367
	    }
368
	    number_errors++ ;
369
	    break ;
370
	}
371
	default : {
372
	    msg = HEADER_SERIOUS ;
373
	    if ( error_severity [ OPTION_ON ] == ERROR_SERIOUS ) {
374
		exit_status = EXIT_FAILURE ;
375
		output_capsule = 0 ;
376
	    }
377
	    number_errors++ ;
378
	    break ;
379
	}
380
	case ERROR_WARNING : {
381
	    msg = HEADER_WARNING ;
382
	    number_warnings++ ;
383
	    break ;
384
	}
385
    }
386
    return ( msg ) ;
387
}
388
 
389
 
390
/*
391
    PRINT A LOCATION TO A FILE
392
 
393
    This routine prints the location loc to the file f.
394
*/
395
 
396
static void print_location
397
    PROTO_N ( ( loc, f ) )
398
    PROTO_T ( LOCATION *loc X FILE *f )
399
{
400
    BUFFER *bf = clear_buffer ( &print_buff, f ) ;
401
    IGNORE print_loc ( loc, NIL ( LOCATION ), bf, 0 ) ;
402
    output_buffer ( bf, 0 ) ;
403
    return ;
404
}
405
 
406
 
407
/*
408
    CONVERT AN ISO SECTION NUMBER TO AN ANSI SECTION NUMBER
409
 
410
    The ISO C standard was based on the ANSI C standard but the sections
411
    were renumbered.  The ISO and ANSI C++ standards are identical.  This
412
    routine converts the ISO section number s to the corresponding ANSI
413
    section number, printing it to the buffer bf.
414
*/
415
 
416
static void iso_to_ansi
417
    PROTO_N ( ( bf, s ) )
418
    PROTO_T ( BUFFER *bf X CONST char *s )
419
{
420
#if LANGUAGE_C
421
    char c ;
422
    unsigned long n = 0 ;
423
    CONST char *p = "1." ;
424
    CONST char *q = s ;
425
    while ( c = *q, ( c >= '0' && c <= '9' ) ) {
426
	n = 10 * n + ( unsigned long ) ( c - '0' ) ;
427
	q++ ;
428
    }
429
    if ( n == 0 ) {
430
	bfprintf ( bf, "%x", s ) ;
431
    } else {
432
	switch ( n ) {
433
	    case 1 : n = 2 ; break ;
434
	    case 2 : n = 3 ; break ;
435
	    case 3 : n = 6 ; break ;
436
	    case 4 : n = 7 ; break ;
437
	    default : p = "" ; n -= 3 ; break ;
438
	}
439
	bfprintf ( bf, "%x%lu%x", p, n, q ) ;
440
    }
441
#else
442
    bfprintf ( bf, "%x", s ) ;
443
#endif
444
    return ;
445
}
446
 
447
 
448
/*
449
    PRINT THE START OF AN ERROR MESSAGE
450
 
451
    This routine prints the start of an error message of severity sev and
452
    location loc to the file f.
453
*/
454
 
455
static void print_error_start
456
    PROTO_N ( ( f, loc, sev ) )
457
    PROTO_T ( FILE *f X LOCATION *loc X int sev )
458
{
459
    CONST char *msg = error_header ( sev ) ;
460
    if ( loc ) {
461
	PRINT_HEADER ( msg, loc, f ) ;
462
	if ( print_error_loc ) {
463
	    /* Print full error location */
464
	    LOCATION floc ;
465
	    LOCATION *ploc = loc ;
466
	    for ( ; ; ) {
467
		PTR ( LOCATION ) from ;
468
		PTR ( POSITION ) posn = ploc->posn ;
469
		if ( IS_NULL_ptr ( posn ) ) break ;
470
		from = DEREF_ptr ( posn_from ( posn ) ) ;
471
		if ( IS_NULL_ptr ( from ) ) break ;
472
		DEREF_loc ( from, floc ) ;
473
		ploc = &floc ;
474
		PRINT_FROM ( ploc, f ) ;
475
	    }
476
	}
477
	if ( print_error_source ) {
478
	    /* Print source line */
479
	    PRINT_SOURCE ( loc, f ) ;
480
	}
481
    } else {
482
	PRINT_START ( msg, f ) ;
483
    }
484
    return ;
485
}
486
 
487
 
488
/*
489
    PRINT THE END OF AN ERROR MESSAGE
490
 
491
    This routine prints the end of an error message of severity sev to
492
    the file f.
493
*/
494
 
495
static void print_error_end
496
    PROTO_N ( ( f, sev ) )
497
    PROTO_T ( FILE *f X int sev )
498
{
499
    unsigned long n = number_errors ;
500
    if ( n >= max_errors && sev != ERROR_FATAL ) {
501
	ERROR err = ERR_fail_too_many ( n ) ;
502
	print_error_msg ( err, &crt_loc, f ) ;
503
	sev = ERROR_FATAL ;
504
    }
505
    fputs_v ( MESSAGE_TERM, f ) ;
506
    error_break () ;
507
    if ( sev == ERROR_FATAL ) term_error ( 0 ) ;
508
    return ;
509
}
510
 
511
 
512
/*
513
    OPTION SEVERITY LEVELS
514
 
515
    This table gives the mapping between options and error severity
516
    levels.
517
*/
518
 
519
int error_severity [] = {
520
    ERROR_NONE,				/* OPTION_OFF */
521
    ERROR_WARNING,			/* OPTION_WARN */
522
    ERROR_SERIOUS,			/* OPTION_ON */
523
    ERROR_WHATEVER			/* OPTION_WHATEVER */
524
} ;
525
 
526
int default_severity [] = {
527
    ERROR_NONE,				/* OPTION_OFF */
528
    ERROR_WARNING,			/* OPTION_WARN */
529
    ERROR_SERIOUS,			/* OPTION_ON */
530
    ERROR_WHATEVER			/* OPTION_WHATEVER */
531
} ;
532
 
533
 
534
/*
535
    CREATE AN ERROR STRUCTURE
536
 
537
    This routine creates a structure for error n in the error catalogue.
538
    Any extra arguments needed by the error should also be given.  Because
539
    of restrictions imposed by the way that stdarg is implemented, any
540
    structure arguments need to be explicitly passed by reference.  Note
541
    that these arguments are stored in the result in reverse order.
542
*/
543
 
544
ERROR make_error
545
    PROTO_V ( ( int n, ... ) ) /* VARARGS */
546
{
547
    int sev ;
548
    ERROR e ;
549
    OPTION opt ;
550
    va_list args ;
551
    ERR_DATA *msg ;
552
    CONST char *s ;
553
#if FS_STDARG
554
    va_start ( args, n ) ;
555
#else
556
    int n ;
557
    va_start ( args ) ;
558
    n = va_arg ( args, int ) ;
559
#endif
560
 
561
    /* Check severity level */
562
    msg = ERR_CATALOG + n ;
563
    if ( crt_opt ) {
564
	opt = crt_opt [ msg->usage ] ;
565
    } else {
566
	/* Can have errors before crt_opt is initialised */
567
	opt = OPT_CATALOG [ msg->usage ].def [0] ;
568
    }
569
    sev = error_severity [ opt ] ;
570
    if ( sev == ERROR_NONE ) {
571
	va_end ( args ) ;
572
	return ( NULL_err ) ;
573
    }
574
 
575
    /* Read arguments */
576
    s = msg->signature ;
577
    if ( s == NULL ) {
578
	MAKE_err_simple ( sev, n, e ) ;
579
    } else {
580
	unsigned i, m = ( unsigned ) strlen ( s ) ;
581
	if ( no_error_args ) m = 0 ;
582
	MAKE_err_simple_args ( sev, n, m, e ) ;
583
	for ( i = 0 ; i < m ; i++ ) {
584
	    switch ( s [i] ) {
585
		case ERR_KEY_BASE_TYPE : {
586
		    BASE_TYPE arg = va_arg ( args, BASE_TYPE ) ;
587
		    COPY_btype ( err_arg ( e, i, BASE_TYPE ), arg ) ;
588
		    break ;
589
		}
590
		case ERR_KEY_CLASS_TYPE : {
591
		    CLASS_TYPE arg = va_arg ( args, CLASS_TYPE ) ;
592
		    COPY_ctype ( err_arg ( e, i, CLASS_TYPE ), arg ) ;
593
		    break ;
594
		}
595
		case ERR_KEY_CV_SPEC : {
596
		    CV_SPEC arg = va_arg ( args, CV_SPEC ) ;
597
		    COPY_cv ( err_arg ( e, i, CV_SPEC ), arg ) ;
598
		    break ;
599
		}
600
		case ERR_KEY_ACCESS :
601
		case ERR_KEY_DECL_SPEC : {
602
		    DECL_SPEC arg = va_arg ( args, DECL_SPEC ) ;
603
		    COPY_dspec ( err_arg ( e, i, DECL_SPEC ), arg ) ;
604
		    break ;
605
		}
606
		case ERR_KEY_FLOAT : {
607
		    FLOAT arg = va_arg ( args, FLOAT ) ;
608
		    COPY_flt ( err_arg ( e, i, FLOAT ), arg ) ;
609
		    break ;
610
		}
611
		case ERR_KEY_HASHID : {
612
		    HASHID arg = va_arg ( args, HASHID ) ;
613
		    COPY_hashid ( err_arg ( e, i, HASHID ), arg ) ;
614
		    break ;
615
		}
616
		case ERR_KEY_IDENTIFIER :
617
		case ERR_KEY_LONG_ID : {
618
		    IDENTIFIER arg = va_arg ( args, IDENTIFIER ) ;
619
		    COPY_id ( err_arg ( e, i, IDENTIFIER ), arg ) ;
620
		    break ;
621
		}
622
		case ERR_KEY_LEX : {
623
		    LEX arg = va_arg ( args, LEX ) ;
624
		    COPY_int ( err_arg ( e, i, LEX ), arg ) ;
625
		    break ;
626
		}
627
		case ERR_KEY_NAMESPACE : {
628
		    NAMESPACE arg = va_arg ( args, NAMESPACE ) ;
629
		    COPY_nspace ( err_arg ( e, i, NAMESPACE ), arg ) ;
630
		    break ;
631
		}
632
		case ERR_KEY_NAT : {
633
		    NAT arg = va_arg ( args, NAT ) ;
634
		    COPY_nat ( err_arg ( e, i, NAT ), arg ) ;
635
		    break ;
636
		}
637
		case ERR_KEY_PPTOKEN_P : {
638
		    PPTOKEN_P arg = va_arg ( args, PPTOKEN_P ) ;
639
		    COPY_pptok ( err_arg ( e, i, PPTOKEN_P ), arg ) ;
640
		    break ;
641
		}
642
		case ERR_KEY_PTR_LOC : {
643
		    PTR_LOC arg = va_arg ( args, PTR_LOC ) ;
644
		    COPY_ptr ( err_arg ( e, i, PTR_LOC ), arg ) ;
645
		    break ;
646
		}
647
		case ERR_KEY_QUALIFIER : {
648
		    QUALIFIER arg = va_arg ( args, QUALIFIER ) ;
649
		    COPY_qual ( err_arg ( e, i, QUALIFIER ), arg ) ;
650
		    break ;
651
		}
652
		case ERR_KEY_STRING : {
653
		    STRING arg = va_arg ( args, STRING ) ;
654
		    COPY_str ( err_arg ( e, i, STRING ), arg ) ;
655
		    break ;
656
		}
657
		case ERR_KEY_TYPE : {
658
		    TYPE arg = va_arg ( args, TYPE ) ;
659
		    COPY_type ( err_arg ( e, i, TYPE ), arg ) ;
660
		    break ;
661
		}
662
		case ERR_KEY_cint : {
663
		    cint arg = va_arg ( args, cint ) ;
664
		    COPY_int ( err_arg ( e, i, cint ), arg ) ;
665
		    break ;
666
		}
667
		case ERR_KEY_cstring : {
668
		    cstring arg = va_arg ( args, cstring ) ;
669
		    string uarg = ustrlit ( arg ) ;
670
		    COPY_string ( err_arg ( e, i, string ), uarg ) ;
671
		    break ;
672
		}
673
		case ERR_KEY_string : {
674
		    string arg = va_arg ( args, string ) ;
675
		    COPY_string ( err_arg ( e, i, string ), arg ) ;
676
		    break ;
677
		}
678
		case ERR_KEY_ulong :
679
		case ERR_KEY_ucint : {
680
		    ulong arg = va_arg ( args, ulong ) ;
681
		    COPY_ulong ( err_arg ( e, i, ulong ), arg ) ;
682
		    break ;
683
		}
684
		case ERR_KEY_unsigned :
685
		case ERR_KEY_plural : {
686
		    unsigned arg = va_arg ( args, unsigned ) ;
687
		    COPY_unsigned ( err_arg ( e, i, unsigned ), arg ) ;
688
		    break ;
689
		}
690
		default : {
691
		    FAIL ( Bad signature ) ;
692
		    break ;
693
		}
694
	    }
695
	}
696
    }
697
    va_end ( args ) ;
698
    return ( e ) ;
699
}
700
 
701
 
702
/*
703
    PRINT THE BODY OF AN ERROR STRUCTURE
704
 
705
    This routine prints the body of the simple error message e to the
706
    buffer bf.
707
*/
708
 
709
static void print_error_body
710
    PROTO_N ( ( e, loc, bf ) )
711
    PROTO_T ( ERROR e X LOCATION *loc X BUFFER *bf )
712
{
713
    char c ;
714
    QUALIFIER qual = qual_none ;
715
 
716
    /* Extract error information */
717
    int n = DEREF_int ( err_simple_number ( e ) ) ;
718
    unsigned sz = DEREF_unsigned ( err_simple_size ( e ) ) ;
719
 
720
    /* Look up error in catalogue */
721
    ERR_DATA *msg = ERR_CATALOG + n ;
722
    CONST char *sig = msg->signature ;
723
    CONST char *s = msg->key_STD ;
724
 
725
    /* Print the error message */
726
    if ( s == NULL ) return ;
727
    while ( c = *( s++ ), c != 0 ) {
728
	if ( c == '%' ) {
729
	    /* Error argument - find number */
730
	    unsigned a ;
731
	    c = *( s++ ) ;
732
	    if ( c >= '0' && c <= '9' ) {
733
		/* Arguments 0 to 9 */
734
		a = ( unsigned ) ( c - '0' ) ;
735
	    } else {
736
		if ( c != '%' ) bfputc ( bf, '%' ) ;
737
		bfputc ( bf, c ) ;
738
		continue ;
739
	    }
740
 
741
	    /* Find argument type */
742
	    if ( a < sz ) {
743
		c = sig [a] ;
744
	    } else {
745
		c = '?' ;
746
	    }
747
 
748
	    /* Print appropriate argument */
749
	    switch ( c ) {
750
		case ERR_KEY_ACCESS : {
751
		    ACCESS arg = DEREF_dspec ( err_arg ( e, a, ACCESS ) ) ;
752
		    IGNORE print_access ( arg, bf, 0 ) ;
753
		    break ;
754
		}
755
		case ERR_KEY_BASE_TYPE : {
756
		    BASE_TYPE arg ;
757
		    arg = DEREF_btype ( err_arg ( e, a, BASE_TYPE ) ) ;
758
		    IGNORE print_btype ( arg, bf, 0 ) ;
759
		    break ;
760
		}
761
		case ERR_KEY_CLASS_TYPE : {
762
		    CLASS_TYPE arg ;
763
		    arg = DEREF_ctype ( err_arg ( e, a, CLASS_TYPE ) ) ;
764
		    IGNORE print_ctype ( arg, qual_none, 0, bf, 0 ) ;
765
		    break ;
766
		}
767
		case ERR_KEY_CV_SPEC : {
768
		    CV_SPEC arg = DEREF_cv ( err_arg ( e, a, CV_SPEC ) ) ;
769
		    if ( !print_cv ( arg, bf, 0 ) ) {
770
			bfprintf ( bf, "<none>" ) ;
771
		    }
772
		    break ;
773
		}
774
		case ERR_KEY_DECL_SPEC : {
775
		    DECL_SPEC arg ;
776
		    arg = DEREF_dspec ( err_arg ( e, a, DECL_SPEC ) ) ;
777
		    if ( !print_dspec ( arg, bf, 0 ) ) {
778
			bfprintf ( bf, "<none>" ) ;
779
		    }
780
		    break ;
781
		}
782
		case ERR_KEY_FLOAT : {
783
		    FLOAT arg = DEREF_flt ( err_arg ( e, a, FLOAT ) ) ;
784
		    IGNORE print_flt ( arg, bf, 0 ) ;
785
		    break ;
786
		}
787
		case ERR_KEY_HASHID : {
788
		    HASHID arg = DEREF_hashid ( err_arg ( e, a, HASHID ) ) ;
789
		    IGNORE print_hashid ( arg, 1, 1, bf, 0 ) ;
790
		    break ;
791
		}
792
		case ERR_KEY_IDENTIFIER : {
793
		    IDENTIFIER arg ;
794
		    arg = DEREF_id ( err_arg ( e, a, IDENTIFIER ) ) ;
795
		    IGNORE print_id_short ( arg, qual, bf, 0 ) ;
796
		    qual = qual_none ;
797
		    break ;
798
		}
799
		case ERR_KEY_LEX : {
800
		    LEX arg = DEREF_int ( err_arg ( e, a, LEX ) ) ;
801
		    IGNORE print_lex ( arg, bf, 0 ) ;
802
		    break ;
803
		}
804
		case ERR_KEY_LONG_ID : {
805
		    LONG_ID arg = DEREF_id ( err_arg ( e, a, LONG_ID ) ) ;
806
		    IGNORE print_id_long ( arg, qual, bf, 0 ) ;
807
		    qual = qual_none ;
808
		    break ;
809
		}
810
		case ERR_KEY_NAMESPACE : {
811
		    NAMESPACE arg ;
812
		    arg = DEREF_nspace ( err_arg ( e, a, NAMESPACE ) ) ;
813
		    IGNORE print_nspace ( arg, qual_none, 0, bf, 0 ) ;
814
		    break ;
815
		}
816
		case ERR_KEY_NAT : {
817
		    NAT arg = DEREF_nat ( err_arg ( e, a, NAT ) ) ;
818
		    IGNORE print_nat ( arg, 0, bf, 0 ) ;
819
		    break ;
820
		}
821
		case ERR_KEY_PPTOKEN_P : {
822
		    PPTOKEN_P arg ;
823
		    arg = DEREF_pptok ( err_arg ( e, a, PPTOKEN_P ) ) ;
824
		    IGNORE print_pptok ( arg, bf, 0 ) ;
825
		    break ;
826
		}
827
		case ERR_KEY_PTR_LOC : {
828
		    PTR_LOC arg ;
829
		    arg = DEREF_ptr ( err_arg ( e, a, PTR_LOC ) ) ;
830
		    if ( !IS_NULL_ptr ( arg ) ) {
831
			LOCATION ploc ;
832
			DEREF_loc ( arg, ploc ) ;
833
			IGNORE print_loc ( &ploc, loc, bf, 0 ) ;
834
		    } else {
835
			IGNORE print_loc ( loc, loc, bf, 0 ) ;
836
		    }
837
		    break ;
838
		}
839
		case ERR_KEY_QUALIFIER : {
840
		    QUALIFIER arg ;
841
		    arg = DEREF_qual ( err_arg ( e, a, QUALIFIER ) ) ;
842
		    qual = arg ;
843
		    break ;
844
		}
845
		case ERR_KEY_STRING : {
846
		    STRING arg = DEREF_str ( err_arg ( e, a, STRING ) ) ;
847
		    IGNORE print_str ( arg, bf, 0 ) ;
848
		    break ;
849
		}
850
		case ERR_KEY_TYPE : {
851
		    TYPE arg = DEREF_type ( err_arg ( e, a, TYPE ) ) ;
852
		    IGNORE print_type ( arg, bf, 0 ) ;
853
		    break ;
854
		}
855
		case ERR_KEY_cint : {
856
		    cint arg = DEREF_int ( err_arg ( e, a, cint ) ) ;
857
		    unsigned long ca = ( unsigned long ) arg ;
858
		    print_char ( ca, CHAR_SIMPLE, 0, bf ) ;
859
		    break ;
860
		}
861
		case ERR_KEY_plural : {
862
		    plural arg = DEREF_unsigned ( err_arg ( e, a, plural ) ) ;
863
		    if ( arg != 1 ) bfputc ( bf, 's' ) ;
864
		    break ;
865
		}
866
		case ERR_KEY_cstring :
867
		case ERR_KEY_string : {
868
		    string arg = DEREF_string ( err_arg ( e, a, string ) ) ;
869
		    if ( arg ) {
870
			ulong u ;
871
			while ( u = ( ulong ) *( arg++ ), u != 0 ) {
872
			    print_char ( u, CHAR_SIMPLE, 0, bf ) ;
873
			}
874
		    }
875
		    break ;
876
		}
877
		case ERR_KEY_ucint : {
878
		    ucint arg = DEREF_ulong ( err_arg ( e, a, ucint ) ) ;
879
		    if ( arg <= ( ucint ) 0xffff ) {
880
			print_char ( arg, CHAR_UNI4, 0, bf ) ;
881
		    } else {
882
			print_char ( arg, CHAR_UNI8, 0, bf ) ;
883
		    }
884
		    break ;
885
		}
886
		case ERR_KEY_ulong : {
887
		    ulong arg = DEREF_ulong ( err_arg ( e, a, ulong ) ) ;
888
		    bfprintf ( bf, "%lu", arg ) ;
889
		    break ;
890
		}
891
		case ERR_KEY_unsigned : {
892
		    unsigned arg ;
893
		    arg = DEREF_unsigned ( err_arg ( e, a, unsigned ) ) ;
894
		    bfprintf ( bf, "%u", arg ) ;
895
		    break ;
896
		}
897
		default : {
898
		    bfprintf ( bf, "<arg%u>", a ) ;
899
		    break ;
900
		}
901
	    }
902
	} else {
903
	    /* Other characters */
904
	    bfputc ( bf, c ) ;
905
	}
906
    }
907
    return ;
908
}
909
 
910
 
911
/*
912
    PRINT AN ERROR STRUCTURE
913
 
914
    This routine prints the body of the error message given by e to the
915
    file f.
916
*/
917
 
918
static void print_error_msg
919
    PROTO_N ( ( e, loc, f ) )
920
    PROTO_T ( ERROR e X LOCATION *loc X FILE *f )
921
{
922
    if ( IS_err_simple ( e ) ) {
923
	/* Print simple error message */
924
	BUFFER *bf ;
925
	int n = DEREF_int ( err_simple_number ( e ) ) ;
926
	ERR_DATA *msg = ERR_CATALOG + n ;
927
	ERR_PROPS props = msg->props ;
928
	int sev = DEREF_int ( err_severity ( e ) ) ;
929
	if ( sev == ERROR_WHATEVER && print_short ) return ;
930
	bf = clear_buffer ( &print_buff, f ) ;
931
	if ( loc ) bfprintf ( bf, MESSAGE_START ) ;
932
	if ( print_error_name ) {
933
	    CONST char *name = msg->name ;
934
	    if ( name ) bfprintf ( bf, MESSAGE_NAME, name ) ;
935
	}
936
	if ( !( props & ERR_PROP_non_iso ) && print_iso_ref ) {
937
	    CONST char *iso ;
938
	    ERR_DATA *prev = msg ;
939
	    while ( iso = prev->key_ISO, iso == NULL ) {
940
		/* Scan back to current section number */
941
		if ( prev == ERR_CATALOG ) break ;
942
		prev-- ;
943
	    }
944
	    msg->key_ISO = iso ;
945
	    if ( iso && iso [0] ) {
946
		if ( print_ansi_ref ) {
947
		    bfprintf ( bf, MESSAGE_ANSI ) ;
948
		    iso_to_ansi ( bf, iso ) ;
949
		    bfprintf ( bf, MESSAGE_ANSI_END ) ;
950
		} else {
951
		    bfprintf ( bf, MESSAGE_ISO, iso ) ;
952
		}
953
	    }
954
	}
955
	if ( props ) {
956
	    if ( props & ERR_PROP_pragma ) bfprintf ( bf, MESSAGE_PRAGMA ) ;
957
	    if ( props & ERR_PROP_printf ) bfprintf ( bf, MESSAGE_PRINTF ) ;
958
	    if ( props & ERR_PROP_token ) bfprintf ( bf, MESSAGE_TOKEN ) ;
959
	    if ( props & ERR_PROP_syntax ) bfprintf ( bf, MESSAGE_SYNTAX ) ;
960
	}
961
	print_error_body ( e, loc, bf ) ;
962
	bfprintf ( bf, MESSAGE_END ) ;
963
	output_buffer ( bf, 1 ) ;
964
 
965
    } else {
966
	/* Print composite error message */
967
	ERROR e1 = DEREF_err ( err_compound_head ( e ) ) ;
968
	ERROR e2 = DEREF_err ( err_compound_tail ( e ) ) ;
969
	print_error_msg ( e1, loc, f ) ;
970
	print_error_msg ( e2, loc, f ) ;
971
    }
972
    return ;
973
}
974
 
975
 
976
/*
977
    DESTROY AN ERROR STRUCTURE
978
 
979
    This routine destroys the error structure e.  If d is false then the
980
    first component of a compound error is not destroyed.
981
*/
982
 
983
void destroy_error
984
    PROTO_N ( ( e, d ) )
985
    PROTO_T ( ERROR e X int d )
986
{
987
    if ( !IS_NULL_err ( e ) ) {
988
	if ( IS_err_simple ( e ) ) {
989
	    if ( d ) DESTROY_err_simple_args ( e ) ;
990
	} else {
991
	    int sev ;
992
	    ERROR e1, e2 ;
993
	    DESTROY_err_compound ( destroy, sev, e1, e2, e ) ;
994
	    if ( d ) destroy_error ( e1, 1 ) ;
995
	    destroy_error ( e2, 1 ) ;
996
	    UNUSED ( sev ) ;
997
	}
998
    }
999
    return ;
1000
}
1001
 
1002
 
1003
/*
1004
    JOIN TWO ERROR STRUCTURES
1005
 
1006
    This routine joins the error structures e1 and e2 into a single compound
1007
    error structure.
1008
*/
1009
 
1010
ERROR concat_error
1011
    PROTO_N ( ( e1, e2 ) )
1012
    PROTO_T ( ERROR e1 X ERROR e2 )
1013
{
1014
    ERROR e ;
1015
    int s1, s2 ;
1016
    if ( IS_NULL_err ( e1 ) ) return ( e2 ) ;
1017
    if ( IS_NULL_err ( e2 ) ) return ( e1 ) ;
1018
    s1 = DEREF_int ( err_severity ( e1 ) ) ;
1019
    s2 = DEREF_int ( err_severity ( e2 ) ) ;
1020
    if ( s2 > s1 ) s1 = s2 ;
1021
    MAKE_err_compound ( s1, e1, e2, e ) ;
1022
    return ( e ) ;
1023
}
1024
 
1025
 
1026
/*
1027
    OPTIONALLY JOIN TWO ERROR STRUCTURES
1028
 
1029
    This routine joins the error structures e1 and e2 into a single compound
1030
    error structure if e1 represents a serious error.  Otherwise e2 is
1031
    destroyed and e1 is returned.
1032
*/
1033
 
1034
ERROR concat_warning
1035
    PROTO_N ( ( e1, e2 ) )
1036
    PROTO_T ( ERROR e1 X ERROR e2 )
1037
{
1038
    ERROR e ;
1039
    int s1, s2 ;
1040
    if ( IS_NULL_err ( e1 ) ) return ( e2 ) ;
1041
    if ( IS_NULL_err ( e2 ) ) return ( e1 ) ;
1042
    s1 = DEREF_int ( err_severity ( e1 ) ) ;
1043
    if ( s1 > ERROR_WARNING ) {
1044
	s2 = DEREF_int ( err_severity ( e2 ) ) ;
1045
	if ( s2 > s1 ) s1 = s2 ;
1046
	MAKE_err_compound ( s1, e1, e2, e ) ;
1047
    } else {
1048
	destroy_error ( e2, 1 ) ;
1049
	e = e1 ;
1050
    }
1051
    return ( e ) ;
1052
}
1053
 
1054
 
1055
/*
1056
    ADD AN ERROR TO A LIST
1057
 
1058
    This routine adds the error e to the end of the list indicated by err.
1059
    If err is the null pointer then e is destroyed.
1060
*/
1061
 
1062
void add_error
1063
    PROTO_N ( ( err, e ) )
1064
    PROTO_T ( ERROR *err X ERROR e )
1065
{
1066
    if ( !IS_NULL_err ( e ) ) {
1067
	if ( err ) {
1068
	    ERROR e1 = *err ;
1069
	    if ( IS_NULL_err ( e1 ) ) {
1070
		*err = e ;
1071
	    } else {
1072
		int s1 = DEREF_int ( err_severity ( e1 ) ) ;
1073
		int s2 = DEREF_int ( err_severity ( e ) ) ;
1074
		if ( s2 > s1 ) s1 = s2 ;
1075
		MAKE_err_compound ( s1, e1, e, *err ) ;
1076
	    }
1077
	} else {
1078
	    destroy_error ( e, 1 ) ;
1079
	}
1080
    }
1081
    return ;
1082
}
1083
 
1084
 
1085
/*
1086
    STANDARD ERROR PREFIX
1087
 
1088
    These variables give an error message which is added to the start
1089
    of any error before it is printed.  The prefix error severity is not
1090
    taken into account in the overall error severity.
1091
*/
1092
 
1093
static ERROR error_prefix = NULL_err ;
1094
 
1095
 
1096
/*
1097
    SET ERROR PREFIX
1098
 
1099
    This routine sets the error prefix to be e, returning the previous
1100
    value.
1101
*/
1102
 
1103
ERROR set_prefix
1104
    PROTO_N ( ( e ) )
1105
    PROTO_T ( ERROR e )
1106
{
1107
    ERROR p = error_prefix ;
1108
    error_prefix = e ;
1109
    return ( p ) ;
1110
}
1111
 
1112
 
1113
/*
1114
    RESTORE ERROR PREFIX
1115
 
1116
    This routine restores the error prefix to e, destroying the previous
1117
    value.
1118
*/
1119
 
1120
void restore_prefix
1121
    PROTO_N ( ( e ) )
1122
    PROTO_T ( ERROR e )
1123
{
1124
    destroy_error ( error_prefix, 1 ) ;
1125
    error_prefix = e ;
1126
    return ;
1127
}
1128
 
1129
 
1130
/*
1131
    PRINT AN ERROR MESSAGE
1132
 
1133
    This routine prints the error e at location loc.
1134
*/
1135
 
1136
void print_error
1137
    PROTO_N ( ( loc, e ) )
1138
    PROTO_T ( LOCATION *loc X ERROR e )
1139
{
1140
    if ( !IS_NULL_err ( e ) ) {
1141
	int d = 1 ;
1142
	int sev = DEREF_int ( err_severity ( e ) ) ;
1143
	if ( sev > error_threshold ) {
1144
	    ERROR p = error_prefix ;
1145
	    if ( !IS_NULL_err ( p ) ) {
1146
		/* Add error prefix */
1147
		MAKE_err_compound ( sev, p, e, e ) ;
1148
		d = 0 ;
1149
	    }
1150
	    if ( do_error && dump_error ( e, loc, sev, 0 ) ) {
1151
		/* Dump error to file */
1152
		unsigned long n ;
1153
		IGNORE error_header ( sev ) ;
1154
		n = number_errors ;
1155
		error_break () ;
1156
		if ( sev == ERROR_FATAL ) term_error ( 0 ) ;
1157
		if ( n >= max_errors ) term_error ( 0 ) ;
1158
	    } else {
1159
		/* Print error to standard error */
1160
		FILE *f = error_file ;
1161
		print_error_start ( f, loc, sev ) ;
1162
		print_error_msg ( e, loc, f ) ;
1163
		print_error_end ( f, sev ) ;
1164
	    }
1165
	}
1166
	destroy_error ( e, d ) ;
1167
    }
1168
    return ;
1169
}
1170
 
1171
 
1172
/*
1173
    CREATE AN INSTALLER ERROR EXPRESSION
1174
 
1175
    This routine creates an install-time error expression for the error
1176
    e at the location loc.
1177
*/
1178
 
1179
EXP install_error
1180
    PROTO_N ( ( loc, e ) )
1181
    PROTO_T ( LOCATION *loc X ERROR e )
1182
{
1183
    EXP a = NULL_exp ;
1184
    if ( !IS_NULL_err ( e ) ) {
1185
	int sev = DEREF_int ( err_severity ( e ) ) ;
1186
	if ( sev > ERROR_WARNING ) {
1187
	    string s ;
1188
	    BUFFER *bf = clear_buffer ( &print_buff, NIL ( FILE ) ) ;
1189
	    if ( loc ) {
1190
		IGNORE print_loc ( loc, NIL ( LOCATION ), bf, 0 ) ;
1191
		bfprintf ( bf, ": " ) ;
1192
	    }
1193
	    print_error_body ( e, loc, bf ) ;
1194
	    bfputc ( bf, 0 ) ;
1195
	    s = xustrcpy ( bf->start ) ;
1196
	    MAKE_exp_fail ( type_bottom, s, a ) ;
1197
	}
1198
	destroy_error ( e, 1 ) ;
1199
    }
1200
    return ( a ) ;
1201
}
1202
 
1203
 
1204
/*
1205
    PRINT A SIMPLE ERROR
1206
 
1207
    This routine prints a simple error message at the current location of
1208
    severity sev given by the printf style string s.  Any extra arguments
1209
    needed by s should also be given.
1210
*/
1211
 
1212
void error
1213
    PROTO_V ( ( int sev, CONST char *s, ... ) ) /* VARARGS */
1214
{
1215
    va_list args ;
1216
#if FS_STDARG
1217
    va_start ( args, s ) ;
1218
#else
1219
    int sev ;
1220
    CONST char *s ;
1221
    va_start ( args ) ;
1222
    sev = va_arg ( args, int ) ;
1223
    s = va_arg ( args, CONST char * ) ;
1224
#endif
1225
    if ( sev > error_threshold ) {
1226
	FILE *f = error_file ;
1227
	print_error_start ( f, NIL ( LOCATION ), sev ) ;
1228
	vfprintf_v ( f, s, args ) ;
1229
	fputs_v ( MESSAGE_END, f ) ;
1230
	print_error_end ( f, sev ) ;
1231
    }
1232
    va_end ( args ) ;
1233
    return ;
1234
}
1235
 
1236
 
1237
/*
1238
    PRINT A RUNNING COMMENTARY
1239
 
1240
    This routine is used in verbose mode to print a running commentary of
1241
    the compilation of the object id.
1242
*/
1243
 
1244
void commentary
1245
    PROTO_N ( ( id ) )
1246
    PROTO_T ( IDENTIFIER id )
1247
{
1248
    if ( verbose && !IS_NULL_id ( id ) ) {
1249
	BUFFER *bf = clear_buffer ( &print_buff, stdout ) ;
1250
	print_id_desc++ ;
1251
	IGNORE print_id_long ( id, qual_none, bf, 0 ) ;
1252
	print_id_desc-- ;
1253
	bfprintf ( bf, " ;\n" ) ;
1254
	output_buffer ( bf, 1 ) ;
1255
    }
1256
    return ;
1257
}
1258
 
1259
 
1260
/*
1261
    PRINT AN ASSERTION
1262
 
1263
    The routine assertion prints the assertion s which occurred at the
1264
    location given by file and line.  The routine is_true is used to
1265
    check whether the condition of an assertion is false.
1266
*/
1267
 
1268
#ifdef ASSERTS
1269
 
1270
void assertion
1271
    PROTO_N ( ( s, file, line ) )
1272
    PROTO_T ( CONST char *s X CONST char *file X int line )
1273
{
1274
    FILE *f = error_file ;
1275
    PRINT_HEADER ( HEADER_ASSERT, &crt_loc, f ) ;
1276
    fprintf_v ( f, "  %s, %s: line %d.\n\n", s, file, line ) ;
1277
    error_break () ;
1278
    abort () ;
1279
}
1280
 
1281
int is_true
1282
    PROTO_N ( ( c ) )
1283
    PROTO_T ( int c )
1284
{
1285
    return ( c ) ;
1286
}
1287
 
1288
#endif