xref: /original-bsd/usr.bin/pascal/pc3/pc3.c (revision d25e1985)
1     /* Copyright (c) 1980 Regents of the University of California */
2 
3 static	char sccsid[] = "@(#)pc3.c 1.6 09/09/80";
4 
5     /*
6      *	     Pc3 is a pass in the Berkeley Pascal compilation
7      *	process that is performed just prior to linking Pascal
8      *	object files.  Its purpose is to enforce the rules of
9      *	separate compilation for Berkeley Pascal.  Pc3 is called
10      *	with the same argument list of object files that is sent to
11      *	the loader.  These checks are performed by pc3 by examining
12      *	the symbol tables of the object files:
13      *	(1)  All source and included files must be "up-to-date" with
14      *	     the object files of which they are components.
15      *	(2)  Each global Pascal symbol (label, constant, type,
16      *	     variable, procedure, or function name) must be uniquely
17      *	     declared, i.e. declared in only one included file or
18      *	     source file.
19      *	(3)  Each external function (or procedure) may be resolved
20      *	     at most once in a source file which included the
21      *	     external declaration of the function.
22      *
23      *	     The symbol table of each object file is scanned and
24      *	each global Pascal symbol is placed in a hashed symbol
25      *	table.  The Pascal compiler has been modified to emit all
26      *	Pascal global symbols to the object file symbol table.  The
27      *	information stored in the symbol table for each such symbol
28      *	is:
29      *
30      *	   - the name of the symbol;
31      *	   - a subtype descriptor;
32      *	   - for file symbols, their last modify time;
33      *	   - the file which logically contains the declaration of
34      *	     the symbol (not an include file);
35      *	   - the file which textually contains the declaration of
36      *	     the symbol (possibly an include file);
37      *	   - the line number at which the symbol is declared;
38      *	   - the file which contains the resolution of the symbol.
39      *	   - the line number at which the symbol is resolved;
40      *
41      *	     If a symbol has been previously entered into the symbol
42      *	table, a check is made that the current declaration is of
43      *	the same type and from the same include file as the previous
44      *	one.  Except for files and functions and procedures, it is
45      *	an error for a symbol declaration to be encountered more
46      *	than once, unless the re-declarations come from the same
47      *	included file as the original.
48      *
49      *	     As an include file symbol is encountered in a source
50      *	file, the symbol table entry of each symbol declared in that
51      *	include file is modified to reflect its new logical
52      *	inclusion in the source file.  File symbols are also
53      *	encountered as an included file ends, signaling the
54      *	continuation of the enclosing file.
55      *
56      *	     Functions and procedures which have been declared
57      *	external may be resolved by declarations from source files
58      *	which included the external declaration of the function.
59      *	Functions and procedures may be resolved at most once across
60      *	a set of object files.  The loader will complain if a
61      *	function is not resolved at least once.
62      */
63 
64 char	program[] = "pc";
65 
66 #include <sys/types.h>
67 #include <ar.h>
68 #include <stdio.h>
69 #include <ctype.h>
70 #include <a.out.h>
71 #include <stab.h>
72 #include <pagsiz.h>
73 #include <stat.h>
74 #include "pstab.h"
75 #include "pc3.h"
76 
77 int	errors = 0;
78 
79     /*
80      *	check each of the argument .o files (or archives of .o files).
81      */
82 main( argc , argv )
83     int		argc;
84     char	**argv;
85     {
86 	struct fileinfo	ofile;
87 
88 	while ( ++argv , --argc ) {
89 #	    ifdef DEBUG
90 		fprintf( stderr , "[main] *argv = %s\n" , *argv );
91 #	    endif DEBUG
92 	    ofile.name = *argv;
93 	    checkfile( &ofile );
94 	}
95 	exit( errors );
96     }
97 
98     /*
99      *	check the namelist of a file, or all namelists of an archive.
100      */
101 checkfile( ofilep )
102     struct fileinfo	*ofilep;
103     {
104 	union {
105 	    char	mag_armag[ SARMAG + 1 ];
106 	    struct exec	mag_exec;
107 	}		mag_un;
108 	int		red;
109 	struct stat	filestat;
110 
111 	ofilep -> file = fopen( ofilep -> name , "r" );
112 	if ( ofilep -> file == NULL ) {
113 	    error( WARNING , "cannot open: %s" , ofilep -> name );
114 	    return;
115 	}
116 	fstat( fileno( ofilep -> file ) , &filestat );
117 	ofilep -> modtime = filestat.st_mtime;
118 	red = fread( (char *) &mag_un , 1 , sizeof mag_un , ofilep -> file );
119 	if ( red != sizeof mag_un ) {
120 	    error( WARNING , "cannot read header: %s" , ofilep -> name );
121 	    return;
122 	}
123 	if ( mag_un.mag_exec.a_magic == OARMAG ) {
124 	    error( WARNING , "old archive: %s" , ofilep -> name );
125 	    return;
126 	}
127 	if ( strncmp( mag_un.mag_armag , ARMAG , SARMAG ) == 0 ) {
128 		/* archive, iterate through elements */
129 #	    ifdef DEBUG
130 		fprintf( stderr , "[checkfile] archive %s\n" , ofilep -> name );
131 #	    endif DEBUG
132 	    ofilep -> nextoffset = SARMAG;
133 	    while ( nextelement( ofilep ) ) {
134 		checknl( ofilep );
135 	    }
136 	} else if ( N_BADMAG( mag_un.mag_exec ) ) {
137 		/* not a file.o */
138 	    error( WARNING , "bad format: %s" , ofilep -> name );
139 	    return;
140 	} else {
141 		/* a file.o */
142 #	    ifdef DEBUG
143 		fprintf( stderr , "[checkfile] .o file %s\n" , ofilep -> name );
144 #	    endif DEBUG
145 	    fseek( ofilep -> file , 0L , 0 );
146 	    ofilep -> nextoffset = filestat.st_size;
147 	    checknl( ofilep );
148 	}
149 	fclose( ofilep -> file );
150     }
151 
152     /*
153      *	check the namelist of this file for conflicts with
154      *	previously entered symbols.
155      */
156 checknl( ofilep )
157     register struct fileinfo	*ofilep;
158     {
159 
160 	long			red;
161 	struct exec		oexec;
162 	off_t			symoff;
163 	long			numsyms;
164 	register struct nlist	*nlp;
165 	register char		*stringp;
166 	long			strsize;
167 	long			sym;
168 
169 	red = fread( (char *) &oexec , 1 , sizeof oexec , ofilep -> file );
170 	if ( red != sizeof oexec ) {
171 	    error( WARNING , "error reading struct exec: %s"
172 		    , ofilep -> name );
173 	    return;
174 	}
175 	if ( N_BADMAG( oexec ) ) {
176 	    return;
177 	}
178 	symoff = N_SYMOFF( oexec ) - sizeof oexec;
179 	fseek( ofilep -> file , symoff , 1 );
180 	numsyms = oexec.a_syms / sizeof ( struct nlist );
181 	if ( numsyms == 0 ) {
182 	    error( WARNING , "no name list: %s" , ofilep -> name );
183 	    return;
184 	}
185 	nlp = (struct nlist *) calloc( numsyms , sizeof ( struct nlist ) );
186 	if ( nlp == 0 ) {
187 	    error( FATAL , "no room for %d nlists" , numsyms );
188 	}
189 	red = fread( ( char * ) nlp , numsyms , sizeof ( struct nlist )
190 		    , ofilep -> file );
191 	if (   ftell( ofilep -> file ) + sizeof ( off_t )
192 	    >= ofilep -> nextoffset ) {
193 	    error( WARNING , "no string table (old format .o?)"
194 		    , ofilep -> name );
195 	    return;
196 	}
197 	red = fread( (char *) &strsize , sizeof strsize , 1
198 		    , ofilep -> file );
199 	if ( red != 1 ) {
200 	    error( WARNING , "no string table (old format .o?)"
201 		    , ofilep -> name );
202 	    return;
203 	}
204 	stringp  = ( char * ) malloc( strsize );
205 	if ( stringp == 0 ) {
206 	    error( FATAL , "no room for %d bytes of strings" , strsize );
207 	}
208 	red = fread( stringp + sizeof strsize
209 		    , strsize - sizeof ( strsize ) , 1 , ofilep -> file );
210 	if ( red != 1 ) {
211 	    error( WARNING , "error reading string table: %s"
212 		    , ofilep -> name );
213 	}
214 #	ifdef DEBUG
215 	    fprintf( stderr , "[checknl] %s: %d symbols\n"
216 		    , ofilep -> name , numsyms );
217 #	endif DEBUG
218 	for ( sym = 0 ; sym < numsyms ; sym++) {
219 	    if ( nlp[ sym ].n_un.n_strx ) {
220 		nlp[ sym ].n_un.n_name = stringp + nlp[ sym ].n_un.n_strx;
221 	    } else {
222 		nlp[ sym ].n_un.n_name = "";
223 	    }
224 	    checksymbol( &nlp[ sym ] , ofilep );
225 	}
226 	if ( nlp ) {
227 	    free( nlp );
228 	}
229 	if ( stringp ) {
230 	    free( stringp );
231 	}
232     }
233 
234     /*
235      *	check a symbol.
236      *	look it up in the hashed symbol table,
237      *	entering it if necessary.
238      *	this maintains a state of which .p and .i files
239      *	it is currently in the midst from the nlist entries
240      *	for source and included files.
241      *	if we are inside a .p but not a .i, pfilep == ifilep.
242      */
243 checksymbol( nlp , ofilep )
244     struct nlist	*nlp;
245     struct fileinfo	*ofilep;
246     {
247 	static struct symbol	*pfilep = NIL;
248 	static struct symbol	*ifilep = NIL;
249 	register struct symbol	*symbolp;
250 
251 #	ifdef DEBUG
252 	    if ( pfilep && ifilep ) {
253 		fprintf( stderr , "[checksymbol] pfile %s ifile %s\n"
254 			, pfilep -> name , ifilep -> name );
255 	    }
256 	    fprintf( stderr , "[checksymbol] ->name %s ->n_desc %x (%s)\n"
257 		    , nlp -> n_un.n_name , nlp -> n_desc
258 		    , classify( nlp -> n_desc ) );
259 #	endif DEBUG
260 	if ( nlp -> n_type != N_PC ) {
261 		/* don't care about the others */
262 	    return;
263 	}
264 	symbolp = entersymbol( nlp -> n_un.n_name );
265 	if ( symbolp -> lookup == NEW ) {
266 #	    ifdef DEBUG
267 		fprintf( stderr , "[checksymbol] ->name %s is NEW\n"
268 			, symbolp -> name );
269 #	    endif DEBUG
270 	    symbolp -> desc = nlp -> n_desc;
271 	    switch ( symbolp -> desc ) {
272 		case N_PGLABEL:
273 		case N_PGCONST:
274 		case N_PGTYPE:
275 		case N_PGVAR:
276 		case N_PGFUNC:
277 		case N_PGPROC:
278 			symbolp -> sym_un.sym_str.rfilep = ifilep;
279 			symbolp -> sym_un.sym_str.rline = nlp -> n_value;
280 			symbolp -> sym_un.sym_str.fromp = pfilep;
281 			symbolp -> sym_un.sym_str.fromi = ifilep;
282 			symbolp -> sym_un.sym_str.iline = nlp -> n_value;
283 			return;
284 		case N_PEFUNC:
285 		case N_PEPROC:
286 			symbolp -> sym_un.sym_str.rfilep = NIL;
287 			symbolp -> sym_un.sym_str.rline = 0;
288 			    /*
289 			     *	functions can only be declared external
290 			     *	in included files.
291 			     */
292 			if ( pfilep == ifilep ) {
293 			    error( WARNING
294 				    , "%s, line %d: %s %s must be declared in included file"
295 				    , pfilep -> name , nlp -> n_value
296 				    , classify( symbolp -> desc )
297 				    , symbolp -> name );
298 			}
299 			symbolp -> sym_un.sym_str.fromp = pfilep;
300 			symbolp -> sym_un.sym_str.fromi = ifilep;
301 			symbolp -> sym_un.sym_str.iline = nlp -> n_value;
302 			return;
303 		case N_PSO:
304 			pfilep = symbolp;
305 			/* and fall through */
306 		case N_PSOL:
307 			ifilep = symbolp;
308 			symbolp -> sym_un.modtime = mtime( symbolp -> name );
309 			if ( symbolp -> sym_un.modtime > ofilep -> modtime ) {
310 			    error( WARNING , "%s is out of date with %s"
311 				    , ofilep -> name , symbolp -> name );
312 			}
313 			return;
314 	    }
315 	} else {
316 #	    ifdef DEBUG
317 		fprintf( stderr , "[checksymbol] ->name %s is OLD\n"
318 			, symbolp -> name );
319 #	    endif DEBUG
320 	    switch ( symbolp -> desc ) {
321 		case N_PSO:
322 			    /*
323 			     *	finding a file again means you are back
324 			     *	in it after finishing an include file.
325 			     */
326 			pfilep = symbolp;
327 			/* and fall through */
328 		case N_PSOL:
329 			    /*
330 			     *	include files can be seen more than once,
331 			     *	but they still have to be timechecked.
332 			     *	(this will complain twice for out of date
333 			     *	include files which include other files.
334 			     *	sigh.)
335 			     */
336 			ifilep = symbolp;
337 			if ( symbolp -> sym_un.modtime > ofilep -> modtime ) {
338 			    error( WARNING , "%s is out of date with %s"
339 				    , ofilep -> name , symbolp -> name );
340 			}
341 			return;
342 		case N_PEFUNC:
343 		case N_PEPROC:
344 			    /*
345 			     *	we may see any number of external declarations,
346 			     *	but they all have to come
347 			     *	from the same include file.
348 			     */
349 			if (   nlp -> n_desc == N_PEFUNC
350 			    || nlp -> n_desc == N_PEPROC ) {
351 			    goto included;
352 			}
353 			    /*
354 			     *	an external function can be resolved by
355 			     *	the resolution of the function
356 			     *	if the resolving file
357 			     *	included the external declaration.
358 			     */
359 			if (    (  symbolp -> desc == N_PEFUNC
360 				&& nlp -> n_desc != N_PGFUNC )
361 			    ||  (  symbolp -> desc == N_PEPROC
362 				&& nlp -> n_desc != N_PGPROC )
363 			    || symbolp -> sym_un.sym_str.fromp != pfilep ) {
364 			    break;
365 			}
366 			    /*
367 			     *	an external function can only be resolved once.
368 			     */
369 			if ( symbolp -> sym_un.sym_str.rfilep != NIL ) {
370 			    break;
371 			}
372 			symbolp -> sym_un.sym_str.rfilep = ifilep;
373 			symbolp -> sym_un.sym_str.rline = nlp -> n_value;
374 			return;
375 		case N_PGFUNC:
376 		case N_PGPROC:
377 			    /*
378 			     *	functions may not be seen more than once.
379 			     *	the loader will complain about
380 			     *	`multiply defined', but we can, too.
381 			     */
382 			break;
383 		case N_PGLABEL:
384 		case N_PGCONST:
385 		case N_PGTYPE:
386 		case N_PGVAR:
387 			    /*
388 			     *	labels, constants, types, variables
389 			     *	and external declarations
390 			     *	may be seen as many times as they want,
391 			     *	as long as they come from the same include file.
392 			     *	make it look like they come from this .p file.
393 			     */
394 included:
395 			if (  nlp -> n_desc != symbolp -> desc
396 			   || symbolp -> sym_un.sym_str.fromi != ifilep ) {
397 			    break;
398 			}
399 			symbolp -> sym_un.sym_str.fromp = pfilep;
400 			return;
401 	    }
402 		/*
403 		 *	this is the breaks
404 		 */
405 	    error( WARNING , "%s, line %d: %s already defined (%s, line %d)."
406 		    , ifilep -> name , nlp -> n_value , nlp -> n_un.n_name
407 		    , symbolp -> sym_un.sym_str.rfilep -> name
408 		    , symbolp -> sym_un.sym_str.rline );
409 	}
410     }
411 
412     /*
413      *	quadratically hashed symbol table.
414      *	things are never deleted from the hash symbol table.
415      *	as more hash table is needed,
416      *	a new one is alloc'ed and chained to the end.
417      *	search is by rehashing within each table,
418      *	traversing chains to next table if unsuccessful.
419      */
420 struct symbol *
421 entersymbol( name )
422     char	*name;
423     {
424 	static struct symboltableinfo	*symboltable = NIL;
425 	char				*enteredname;
426 	long				hashindex;
427 	register struct symboltableinfo	*tablep;
428 	register struct symbol		**herep;
429 	register struct symbol		**limitp;
430 	register long			increment;
431 
432 	enteredname = enterstring( name );
433 	hashindex = SHORT_ABS( ( long ) enteredname ) % SYMBOLPRIME;
434 	for ( tablep = symboltable ; /*return*/ ; tablep = tablep -> chain ) {
435 	    if ( tablep == NIL ) {
436 #		ifdef DEBUG
437 		    fprintf( stderr , "[entersymbol] calloc\n" );
438 #		endif DEBUG
439 		tablep = ( struct symboltableinfo * )
440 			    calloc( sizeof ( struct symboltableinfo ) , 1 );
441 		if ( tablep == NIL ) {
442 		    error( FATAL , "ran out of memory (entersymbol)" );
443 		}
444 		if ( symboltable == NIL ) {
445 		    symboltable = tablep;
446 		}
447 	    }
448 	    herep = &( tablep -> entry[ hashindex ] );
449 	    limitp = &( tablep -> entry[ SYMBOLPRIME ] );
450 	    increment = 1;
451 	    do {
452 #		ifdef DEBUG
453 		    fprintf( stderr , "[entersymbol] increment %d\n"
454 			    , increment );
455 #		endif DEBUG
456 		if ( *herep == NIL ) {
457 			/* empty */
458 		    if ( tablep -> used > ( ( SYMBOLPRIME / 3 ) * 4 ) ) {
459 			    /* too full, break for next table */
460 			break;
461 		    }
462 		    tablep -> used++;
463 		    *herep = symbolalloc();
464 		    ( *herep ) -> name = enteredname;
465 		    ( *herep ) -> lookup = NEW;
466 #		    ifdef DEBUG
467 			fprintf( stderr , "[entersymbol] name %s NEW\n"
468 				, enteredname );
469 #		    endif DEBUG
470 		    return *herep;
471 		}
472 		    /* a find? */
473 		if ( ( *herep ) -> name == enteredname ) {
474 		    ( *herep ) -> lookup = OLD;
475 #		    ifdef DEBUG
476 			fprintf( stderr , "[entersymbol] name %s OLD\n"
477 				, enteredname );
478 #		    endif DEBUG
479 		    return *herep;
480 		}
481 		herep += increment;
482 		if ( herep >= limitp ) {
483 		    herep -= SYMBOLPRIME;
484 		}
485 		increment += 2;
486 	    } while ( increment < SYMBOLPRIME );
487 	}
488     }
489 
490     /*
491      *	allocate a symbol from the dynamically allocated symbol table.
492      */
493 struct symbol *
494 symbolalloc()
495     {
496 	static struct symbol	*nextsymbol = NIL;
497 	static long		symbolsleft = 0;
498 	struct symbol		*newsymbol;
499 
500 	if ( symbolsleft <= 0 ) {
501 #	    ifdef DEBUG
502 		fprintf( stderr , "[symbolalloc] malloc\n" );
503 #	    endif DEBUG
504 	    nextsymbol = ( struct symbol * ) malloc( SYMBOLALLOC );
505 	    if ( nextsymbol == 0 ) {
506 		error( FATAL , "ran out of memory (symbolalloc)" );
507 	    }
508 	    symbolsleft = SYMBOLALLOC / sizeof( struct symbol );
509 	}
510 	newsymbol = nextsymbol;
511 	nextsymbol++;
512 	symbolsleft--;
513 	return newsymbol;
514     }
515 
516     /*
517      *	hash a string based on all of its characters.
518      */
519 long
520 hashstring( string )
521     char	*string;
522     {
523 	register char	*cp;
524 	register long	value;
525 
526 	value = 0;
527 	for ( cp = string ; *cp ; cp++ ) {
528 	    value = ( value * 2 ) + *cp;
529 	}
530 	return value;
531     }
532 
533     /*
534      *	quadratically hashed string table.
535      *	things are never deleted from the hash string table.
536      *	as more hash table is needed,
537      *	a new one is alloc'ed and chained to the end.
538      *	search is by rehashing within each table,
539      *	traversing chains to next table if unsuccessful.
540      */
541 char *
542 enterstring( string )
543     char	*string;
544     {
545 	static struct stringtableinfo	*stringtable = NIL;
546 	long				hashindex;
547 	register struct stringtableinfo	*tablep;
548 	register char			**herep;
549 	register char			**limitp;
550 	register long			increment;
551 
552 	hashindex = SHORT_ABS( hashstring( string ) ) % STRINGPRIME;
553 	for ( tablep = stringtable ; /*return*/ ; tablep = tablep -> chain ) {
554 	    if ( tablep == NIL ) {
555 #		ifdef DEBUG
556 		    fprintf( stderr , "[enterstring] calloc\n" );
557 #		endif DEBUG
558 		tablep = ( struct stringtableinfo * )
559 			    calloc( sizeof ( struct stringtableinfo ) , 1 );
560 		if ( tablep == NIL ) {
561 		    error( FATAL , "ran out of memory (enterstring)" );
562 		}
563 		if ( stringtable == NIL ) {
564 		    stringtable = tablep;
565 		}
566 	    }
567 	    herep = &( tablep -> entry[ hashindex ] );
568 	    limitp = &( tablep -> entry[ STRINGPRIME ] );
569 	    increment = 1;
570 	    do {
571 #		ifdef DEBUG
572 		    fprintf( stderr , "[enterstring] increment %d\n"
573 			    , increment );
574 #		endif DEBUG
575 		if ( *herep == NIL ) {
576 			/* empty */
577 		    if ( tablep -> used > ( ( STRINGPRIME / 3 ) * 4 ) ) {
578 			    /* too full, break for next table */
579 			break;
580 		    }
581 		    tablep -> used++;
582 		    *herep = charalloc( strlen( string ) );
583 		    strcpy( *herep , string );
584 #		    ifdef DEBUG
585 			fprintf( stderr , "[enterstring] string %s copied\n"
586 				, *herep );
587 #		    endif DEBUG
588 		    return *herep;
589 		}
590 		    /* quick, check the first chars and then the rest */
591 		if ( **herep == *string && strcmp( *herep , string ) == 0 ) {
592 #		    ifdef DEBUG
593 			fprintf( stderr , "[enterstring] string %s found\n"
594 				, *herep );
595 #		    endif DEBUG
596 		    return *herep;
597 		}
598 		herep += increment;
599 		if ( herep >= limitp ) {
600 		    herep -= STRINGPRIME;
601 		}
602 		increment += 2;
603 	    } while ( increment < STRINGPRIME );
604 	}
605     }
606 
607     /*
608      *	copy a string to the dynamically allocated character table.
609      */
610 char *
611 charalloc( length )
612     register long	length;
613     {
614 	static char	*nextchar = NIL;
615 	static long	charsleft = 0;
616 	register long	lengthplus1 = length + 1;
617 	register long	askfor;
618 	char		*newstring;
619 
620 	if ( charsleft < lengthplus1 ) {
621 	    askfor = lengthplus1 > CHARALLOC ? lengthplus1 : CHARALLOC;
622 #	    ifdef DEBUG
623 		fprintf( stderr , "[charalloc] malloc( %d )\n"
624 			, askfor );
625 #	    endif DEBUG
626 	    nextchar = ( char * ) malloc( askfor );
627 	    if ( nextchar == 0 ) {
628 		error( FATAL , "no room for %d characters" , askfor );
629 	    }
630 	    charsleft = askfor;
631 	}
632 	newstring = nextchar;
633 	nextchar += lengthplus1;
634 	charsleft -= lengthplus1;
635 	return newstring;
636     }
637 
638     /*
639      *	read an archive header for the next element
640      *	and find the offset of the one after this.
641      */
642 BOOL
643 nextelement( ofilep )
644     struct fileinfo	*ofilep;
645     {
646 	register char	*cp;
647 	register long	red;
648 	register off_t	arsize;
649 	struct ar_hdr	archdr;
650 
651 	fseek( ofilep -> file , ofilep -> nextoffset , 0 );
652 	red = fread( (char *) &archdr , 1 , sizeof archdr , ofilep -> file );
653 	if ( red != sizeof archdr ) {
654 	    return FALSE;
655 	}
656 	    /* null terminate the blank-padded name */
657 	cp = &archdr.ar_name[ ( sizeof archdr.ar_name ) - 1 ];
658 	*cp = '\0';
659 	while ( *--cp == ' ' ) {
660 	    *cp = '\0';
661 	}
662 	    /* set up the address of the beginning of next element */
663 	arsize = atol( archdr.ar_size );
664 	    /* archive elements are aligned on 0 mod 2 boundaries */
665 	if ( arsize & 1 ) {
666 	    arsize += 1;
667 	}
668 	ofilep -> nextoffset = ftell( ofilep -> file ) + arsize;
669 	    /* say we had one */
670 	return TRUE;
671     }
672 
673     /*
674      *	variable number of arguments to error, like printf.
675      */
676 error( fatal , message , arg1 , arg2 , arg3 , arg4 , arg5 , arg6 )
677     int		fatal;
678     char	*message;
679     {
680 	fprintf( stderr , "%s: " , program );
681 	fprintf( stderr , message , arg1 , arg2 , arg3 , arg4 , arg5 , arg6 );
682 	fprintf( stderr , "\n" );
683 	if ( fatal == FATAL ) {
684 	    exit( 2 );
685 	}
686 	errors = 1;
687     }
688 
689     /*
690      *	find the last modify time of a file.
691      *	on error, return the current time.
692      */
693 time_t
694 mtime( filename )
695     char	*filename;
696     {
697 	struct stat	filestat;
698 
699 #	ifdef DEBUG
700 	    fprintf( stderr , "[mtime] filename %s\n"
701 		    , filename );
702 #	endif DEBUG
703 	if ( stat( filename , &filestat ) != 0 ) {
704 	    error( WARNING , "%s: cannot open" , filename );
705 	    return ( (time_t) time( 0 ) );
706 	}
707 	return filestat.st_mtime;
708     }
709 
710 char *
711 classify( type )
712     unsigned char	type;
713     {
714 	switch ( type ) {
715 	    case N_PSO:
716 		return "source file";
717 	    case N_PSOL:
718 		return "include file";
719 	    case N_PGLABEL:
720 		return "label";
721 	    case N_PGCONST:
722 		return "constant";
723 	    case N_PGTYPE:
724 		return "type";
725 	    case N_PGVAR:
726 		return "variable";
727 	    case N_PGFUNC:
728 		return "function";
729 	    case N_PGPROC:
730 		return "procedure";
731 	    case N_PEFUNC:
732 		return "external function";
733 	    case N_PEPROC:
734 		return "external procedure";
735 	    default:
736 		return "unknown symbol";
737 	}
738     }
739