changes from donn@utah-cs for common header file for pcc
[unix-history] / usr / src / usr.bin / pascal / pc3 / pc3.c
index 997c89d..2078bb2 100644 (file)
@@ -1,7 +1,8 @@
+#ifndef lint
+static char sccsid[] = "@(#)pc3.c      1.13 (Berkeley) %G%";
+#endif
     /* Copyright (c) 1980 Regents of the University of California */
 
     /* Copyright (c) 1980 Regents of the University of California */
 
-static char sccsid[] = "@(#)pc3.c 1.3 %G%";
-
     /*
      *      Pc3 is a pass in the Berkeley Pascal compilation
      * process that is performed just prior to linking Pascal
     /*
      *      Pc3 is a pass in the Berkeley Pascal compilation
      * process that is performed just prior to linking Pascal
@@ -10,8 +11,8 @@ static        char sccsid[] = "@(#)pc3.c 1.3 %G%";
      * with the same argument list of object files that is sent to
      * the loader.  These checks are performed by pc3 by examining
      * the symbol tables of the object files:
      * with the same argument list of object files that is sent to
      * the loader.  These checks are performed by pc3 by examining
      * the symbol tables of the object files:
-     * (1)  All source and included files must be "up-to-date" with
-     *      the object files of which they are components.
+     * (1)  All .o files must be up to date with respect to the
+     *      runtime libraries.
      * (2)  Each global Pascal symbol (label, constant, type,
      *      variable, procedure, or function name) must be uniquely
      *      declared, i.e. declared in only one included file or
      * (2)  Each global Pascal symbol (label, constant, type,
      *      variable, procedure, or function name) must be uniquely
      *      declared, i.e. declared in only one included file or
@@ -28,15 +29,17 @@ static      char sccsid[] = "@(#)pc3.c 1.3 %G%";
      * is:
      * 
      *    - the name of the symbol;
      * is:
      * 
      *    - the name of the symbol;
-     *    - a type specifier;
-     *    - for file symbols, their last modify time;
+     *    - a subtype descriptor;
      *    - the file which logically contains the declaration of
      *    - the file which logically contains the declaration of
-     *      the symbol (not an include file);
-     *    - the file which textually contains the declaration of
-     *      the symbol (possibly an include file);
-     *    - the line number at which the symbol is declared;
-     *    - the file which contains the resolution of the symbol.
-     *    - the line number at which the symbol is resolved;
+     *      the symbol or which caused the inclusion of an include file.
+     *    - for included files:
+     *         - a checksum;
+     *    - for symbols:
+     *         - the file which textually contains the declaration of
+     *           the symbol (possibly an include file);
+     *         - the line number at which the symbol is declared;
+     *         - the file which contains the resolution of the symbol.
+     *         - the line number at which the symbol is resolved;
      * 
      *      If a symbol has been previously entered into the symbol
      * table, a check is made that the current declaration is of
      * 
      *      If a symbol has been previously entered into the symbol
      * table, a check is made that the current declaration is of
@@ -61,20 +64,20 @@ static      char sccsid[] = "@(#)pc3.c 1.3 %G%";
      * function is not resolved at least once.
      */
 \f
      * function is not resolved at least once.
      */
 \f
-char   program[] = "pc3";
+char   program[] = "pc";
 
 #include <sys/types.h>
 
 #include <sys/types.h>
+#include <sys/stat.h>
 #include <ar.h>
 #include <stdio.h>
 #include <ctype.h>
 #include <a.out.h>
 #include <stab.h>
 #include <ar.h>
 #include <stdio.h>
 #include <ctype.h>
 #include <a.out.h>
 #include <stab.h>
-#include <pagsiz.h>
-#include <stat.h>
-#include "/usr/src/new/pc0/p.a.out.h"
+#include "pstab.h"
 #include "pc3.h"
 
 #include "pc3.h"
 
-int    errors = 0;
+int    errors = NONE;
+BOOL   wflag = FALSE;  
 
     /*
      * check each of the argument .o files (or archives of .o files).
 
     /*
      * check each of the argument .o files (or archives of .o files).
@@ -85,7 +88,17 @@ main( argc , argv )
     {
        struct fileinfo ofile;
 
     {
        struct fileinfo ofile;
 
-       while ( ++argv , --argc ) {
+       for ( argv++ ; *argv != 0 && **argv == '-' ; argv++ ) {
+           (*argv)++;
+           switch ( **argv ) {
+               default:
+                   error( FATAL , "pc3: bad flag -%c\n" , **argv );
+               case 'w':
+                   wflag = TRUE;
+                   break;
+           }
+       }
+       for ( /* void */ ; *argv != 0 ; argv++ ) {
 #          ifdef DEBUG
                fprintf( stderr , "[main] *argv = %s\n" , *argv );
 #          endif DEBUG
 #          ifdef DEBUG
                fprintf( stderr , "[main] *argv = %s\n" , *argv );
 #          endif DEBUG
@@ -110,14 +123,13 @@ checkfile( ofilep )
 
        ofilep -> file = fopen( ofilep -> name , "r" );
        if ( ofilep -> file == NULL ) {
 
        ofilep -> file = fopen( ofilep -> name , "r" );
        if ( ofilep -> file == NULL ) {
-           error( WARNING , "cannot open: %s" , ofilep -> name );
+           error( ERROR , "cannot open: %s" , ofilep -> name );
            return;
        }
        fstat( fileno( ofilep -> file ) , &filestat );
            return;
        }
        fstat( fileno( ofilep -> file ) , &filestat );
-       ofilep -> modtime = filestat.st_mtime;
        red = fread( (char *) &mag_un , 1 , sizeof mag_un , ofilep -> file );
        if ( red != sizeof mag_un ) {
        red = fread( (char *) &mag_un , 1 , sizeof mag_un , ofilep -> file );
        if ( red != sizeof mag_un ) {
-           error( WARNING , "cannot read header: %s" , ofilep -> name );
+           error( ERROR , "cannot read header: %s" , ofilep -> name );
            return;
        }
        if ( mag_un.mag_exec.a_magic == OARMAG ) {
            return;
        }
        if ( mag_un.mag_exec.a_magic == OARMAG ) {
@@ -135,7 +147,7 @@ checkfile( ofilep )
            }
        } else if ( N_BADMAG( mag_un.mag_exec ) ) {
                /* not a file.o */
            }
        } else if ( N_BADMAG( mag_un.mag_exec ) ) {
                /* not a file.o */
-           error( WARNING , "bad format: %s" , ofilep -> name );
+           error( ERROR , "bad format: %s" , ofilep -> name );
            return;
        } else {
                /* a file.o */
            return;
        } else {
                /* a file.o */
@@ -168,7 +180,7 @@ checknl( ofilep )
 
        red = fread( (char *) &oexec , 1 , sizeof oexec , ofilep -> file );
        if ( red != sizeof oexec ) {
 
        red = fread( (char *) &oexec , 1 , sizeof oexec , ofilep -> file );
        if ( red != sizeof oexec ) {
-           error( WARNING , "error reading struct exec: %s"
+           error( ERROR , "error reading struct exec: %s"
                    , ofilep -> name );
            return;
        }
                    , ofilep -> name );
            return;
        }
@@ -247,54 +259,47 @@ checksymbol( nlp , ofilep )
        static struct symbol    *pfilep = NIL;
        static struct symbol    *ifilep = NIL;
        register struct symbol  *symbolp;
        static struct symbol    *pfilep = NIL;
        static struct symbol    *ifilep = NIL;
        register struct symbol  *symbolp;
+       int                     errtype;
 
 #      ifdef DEBUG
            if ( pfilep && ifilep ) {
                fprintf( stderr , "[checksymbol] pfile %s ifile %s\n"
                        , pfilep -> name , ifilep -> name );
            }
 
 #      ifdef DEBUG
            if ( pfilep && ifilep ) {
                fprintf( stderr , "[checksymbol] pfile %s ifile %s\n"
                        , pfilep -> name , ifilep -> name );
            }
-           fprintf( stderr , "[checksymbol] ->name %s ->n_type %x (%s)\n"
-                   , nlp -> n_un.n_name , nlp -> n_type
-                   , classify( nlp -> n_type ) );
+           fprintf( stderr , "[checksymbol] ->name %s ->n_desc %x (%s)\n"
+                   , nlp -> n_un.n_name , nlp -> n_desc
+                   , classify( nlp -> n_desc ) );
 #      endif DEBUG
 #      endif DEBUG
-       switch ( nlp -> n_type ) {
-           case N_PGLAB:
-           case N_PGCON:
-           case N_PGTYP:
-           case N_PGVAR:
-           case N_PGFUN:
-           case N_PGPRC:
-           case N_PEFUN:
-           case N_PEPRC:
-           case N_PSO:
-           case N_PSOL:
-                   symbolp = entersymbol( nlp -> n_un.n_name );
-                   break;
-           default:
-                       /* don't care about the others */
-                   return;
+       if ( nlp -> n_type != N_PC ) {
+               /* don't care about the others */
+           return;
        }
        }
+       symbolp = entersymbol( nlp -> n_un.n_name );
        if ( symbolp -> lookup == NEW ) {
 #          ifdef DEBUG
                fprintf( stderr , "[checksymbol] ->name %s is NEW\n"
                        , symbolp -> name );
 #          endif DEBUG
        if ( symbolp -> lookup == NEW ) {
 #          ifdef DEBUG
                fprintf( stderr , "[checksymbol] ->name %s is NEW\n"
                        , symbolp -> name );
 #          endif DEBUG
-           symbolp -> type = nlp -> n_type;
-           switch ( symbolp -> type ) {
-               case N_PGLAB:
-               case N_PGCON:
-               case N_PGTYP:
+           symbolp -> desc = nlp -> n_desc;
+           symbolp -> fromp = pfilep;
+           switch ( symbolp -> desc ) {
+               default:
+                       error( FATAL , "panic: [checksymbol] NEW" );
+               case N_PGLABEL:
+               case N_PGCONST:
+               case N_PGTYPE:
                case N_PGVAR:
                case N_PGVAR:
-               case N_PGFUN:
-               case N_PGPRC:
+               case N_PGFUNC:
+               case N_PGPROC:
+               case N_PLDATA:
+               case N_PLTEXT:
                        symbolp -> sym_un.sym_str.rfilep = ifilep;
                        symbolp -> sym_un.sym_str.rline = nlp -> n_value;
                        symbolp -> sym_un.sym_str.rfilep = ifilep;
                        symbolp -> sym_un.sym_str.rline = nlp -> n_value;
-                       symbolp -> sym_un.sym_str.fromp = pfilep;
                        symbolp -> sym_un.sym_str.fromi = ifilep;
                        symbolp -> sym_un.sym_str.iline = nlp -> n_value;
                        return;
                        symbolp -> sym_un.sym_str.fromi = ifilep;
                        symbolp -> sym_un.sym_str.iline = nlp -> n_value;
                        return;
-               case N_PEFUN:
-               case N_PEPRC:
+               case N_PEFUNC:
+               case N_PEPROC:
                        symbolp -> sym_un.sym_str.rfilep = NIL;
                        symbolp -> sym_un.sym_str.rline = 0;
                            /*
                        symbolp -> sym_un.sym_str.rfilep = NIL;
                        symbolp -> sym_un.sym_str.rline = 0;
                            /*
@@ -305,23 +310,25 @@ checksymbol( nlp , ofilep )
                            error( WARNING
                                    , "%s, line %d: %s %s must be declared in included file"
                                    , pfilep -> name , nlp -> n_value
                            error( WARNING
                                    , "%s, line %d: %s %s must be declared in included file"
                                    , pfilep -> name , nlp -> n_value
-                                   , classify( symbolp -> type )
+                                   , classify( symbolp -> desc )
                                    , symbolp -> name );
                        }
                                    , symbolp -> name );
                        }
-                       symbolp -> sym_un.sym_str.fromp = pfilep;
                        symbolp -> sym_un.sym_str.fromi = ifilep;
                        symbolp -> sym_un.sym_str.iline = nlp -> n_value;
                        return;
                case N_PSO:
                        symbolp -> sym_un.sym_str.fromi = ifilep;
                        symbolp -> sym_un.sym_str.iline = nlp -> n_value;
                        return;
                case N_PSO:
+                       if ( nlp -> n_value < N_FLAGCHECKSUM ) {
+                           error( WARNING,
+                               "%s is out of date and should be recompiled",
+                               ofilep -> name );
+                       }
                        pfilep = symbolp;
                        pfilep = symbolp;
-                       /* and fall through */
+                       ifilep = symbolp;
+                       symbolp -> sym_un.checksum = N_FLAGCHECKSUM;
+                       return;
                case N_PSOL:
                        ifilep = symbolp;
                case N_PSOL:
                        ifilep = symbolp;
-                       symbolp -> sym_un.modtime = mtime( symbolp -> name );
-                       if ( symbolp -> sym_un.modtime > ofilep -> modtime ) {
-                           error( WARNING , "%s is out of date with %s"
-                                   , ofilep -> name , symbolp -> name );
-                       }
+                       symbolp -> sym_un.checksum = nlp -> n_value;
                        return;
            }
        } else {
                        return;
            }
        } else {
@@ -329,72 +336,117 @@ checksymbol( nlp , ofilep )
                fprintf( stderr , "[checksymbol] ->name %s is OLD\n"
                        , symbolp -> name );
 #          endif DEBUG
                fprintf( stderr , "[checksymbol] ->name %s is OLD\n"
                        , symbolp -> name );
 #          endif DEBUG
-           switch ( symbolp -> type ) {
+           errtype = ERROR;
+           switch ( symbolp -> desc ) {
+               default:
+                       error( FATAL , "panic [checksymbol] OLD" );
+                       return;
                case N_PSO:
                            /*
                             *  finding a file again means you are back
                             *  in it after finishing an include file.
                             */
                case N_PSO:
                            /*
                             *  finding a file again means you are back
                             *  in it after finishing an include file.
                             */
+                       if ( symbolp -> desc != nlp -> n_desc ) {
+                           error( FATAL , "panic [checksymbol] PSO" );
+                           return;
+                       }
                        pfilep = symbolp;
                        pfilep = symbolp;
-                       /* and fall through */
+                       ifilep = symbolp;
+                       return;
                case N_PSOL:
                            /*
                             *  include files can be seen more than once,
                case N_PSOL:
                            /*
                             *  include files can be seen more than once,
-                            *  but they still have to be timechecked.
-                            *  (this will complain twice for out of date
-                            *  include files which include other files.
-                            *  sigh.)
+                            *  but their checksums are checked if they are
+                            *  greater than N_FLAGCHECKSUM.
+                            *  PSOL's are seen with checksums as the
+                            *  include file is entered, and with
+                            *  N_FLAGCHECKSUM as we are back in an
+                            *  included file from a nested include.
                             */
                             */
-                       ifilep = symbolp;
-                       if ( symbolp -> sym_un.modtime > ofilep -> modtime ) {
-                           error( WARNING , "%s is out of date with %s"
-                                   , ofilep -> name , symbolp -> name );
+                       if ( symbolp -> desc != nlp -> n_desc ) {
+                           error( FATAL , "panic [checksymbol] PSOL" );
+                           return;
+                       }
+                       if ((unsigned) symbolp->sym_un.checksum > N_FLAGCHECKSUM
+                          && (unsigned) nlp -> n_value > N_FLAGCHECKSUM
+                          && symbolp -> sym_un.checksum != nlp -> n_value ) {
+                           error( ERROR,
+                           "%s included in %s differs from %s included in %s",
+                               symbolp -> name, pfilep -> name,
+                               symbolp -> name, symbolp -> fromp -> name );
                        }
                        }
+                       ifilep = symbolp;
                        return;
                        return;
-               case N_PEFUN:
-               case N_PEPRC:
+               case N_PEFUNC:
+               case N_PEPROC:
                            /*
                            /*
-                            *  we may see any number of external declarations,
-                            *  but they all have to come
-                            *  from the same include file.
+                            *  this might be the resolution of the external
+                            *  has to match func/proc of external
+                            *  and has to have included external
+                            *  and has to not have been previously resolved.
                             */
                             */
-                       if (   nlp -> n_type == N_PEFUN
-                           || nlp -> n_type == N_PEPRC ) {
-                           goto included;
+                       if (  (  ( symbolp -> desc == N_PEFUNC
+                                && nlp -> n_desc == N_PGFUNC )
+                             || ( symbolp -> desc == N_PEPROC
+                                && nlp -> n_desc == N_PGPROC ) )
+                          && ( symbolp -> fromp == pfilep )
+                          && ( symbolp -> sym_un.sym_str.rfilep == NIL ) ) {
+                               /*
+                                *      resolve external
+                                */
+#                          ifdef DEBUG
+                               fprintf( stderr , "[checksymbol] resolving external\n" );
+#                          endif DEBUG
+                           symbolp -> sym_un.sym_str.rfilep = ifilep;
+                           symbolp -> sym_un.sym_str.rline = nlp -> n_value;
+                           return;
                        }
                            /*
                        }
                            /*
-                            *  an external function can be resolved by
-                            *  the resolution of the function
-                            *  if the resolving file
-                            *  included the external declaration.
+                            *  otherwise, it might be another external,
+                            *  which is okay if it's
+                            *  the same type and from the same include file
                             */
                             */
-                       if (    (  symbolp -> type == N_PEFUN
-                               && nlp -> n_type != N_PGFUN )
-                           ||  (  symbolp -> type == N_PEPRC
-                               && nlp -> n_type != N_PGPRC )
-                           || symbolp -> sym_un.sym_str.fromp != pfilep ) {
-                           break;
+                       if (  (  ( symbolp -> desc == N_PEFUNC
+                                && nlp -> n_desc == N_PEFUNC )
+                             || ( symbolp -> desc == N_PEPROC
+                                && nlp -> n_desc == N_PEPROC ) )
+                          && ( symbolp -> sym_un.sym_str.fromi == ifilep ) ) {
+                               /*
+                                *      just another pretty external
+                                *      make it look like it comes from here.
+                                */
+#                          ifdef DEBUG
+                               fprintf( stderr , "[checksymbol] just another pretty external\n" );
+#                          endif DEBUG
+                           symbolp -> fromp = pfilep;
+                           return;
                        }
                            /*
                        }
                            /*
-                            *  an external function can only be resolved once.
+                            *  something is wrong
+                            *  if it's not resolved, use the header file
+                            *  otherwise, it's just a regular error
                             */
                             */
-                       if ( symbolp -> sym_un.sym_str.rfilep != NIL ) {
-                           break;
+                       if ( symbolp -> sym_un.sym_str.rfilep == NIL ) {
+                           error( ERROR ,
+                   "%s, line %d: %s is already defined\n\t(%s, line %d)." ,
+                               ifilep -> name , nlp -> n_value , 
+                               nlp -> n_un.n_name , 
+                               symbolp -> sym_un.sym_str.fromi -> name ,
+                               symbolp -> sym_un.sym_str.iline );
+                           return;
                        }
                        }
-                       symbolp -> sym_un.sym_str.rfilep = ifilep;
-                       symbolp -> sym_un.sym_str.rline = nlp -> n_value;
-                       return;
-               case N_PGFUN:
-               case N_PGPRC:
+                       break;
+               case N_PGFUNC:
+               case N_PGPROC:
                            /*
                             *  functions may not be seen more than once.
                             *  the loader will complain about
                             *  `multiply defined', but we can, too.
                             */
                        break;
                            /*
                             *  functions may not be seen more than once.
                             *  the loader will complain about
                             *  `multiply defined', but we can, too.
                             */
                        break;
-               case N_PGLAB:
-               case N_PGCON:
-               case N_PGTYP:
+               case N_PGLABEL:
+               case N_PGCONST:
+               case N_PGTYPE:
                case N_PGVAR:
                            /*
                             *  labels, constants, types, variables
                case N_PGVAR:
                            /*
                             *  labels, constants, types, variables
@@ -404,20 +456,52 @@ checksymbol( nlp , ofilep )
                             *  make it look like they come from this .p file.
                             */
 included:
                             *  make it look like they come from this .p file.
                             */
 included:
-                       if (  nlp -> n_type != symbolp -> type
+                       if (  nlp -> n_desc != symbolp -> desc
                           || symbolp -> sym_un.sym_str.fromi != ifilep ) {
                            break;
                        }
                           || symbolp -> sym_un.sym_str.fromi != ifilep ) {
                            break;
                        }
-                       symbolp -> sym_un.sym_str.fromp = pfilep;
+                       symbolp -> fromp = pfilep;
                        return;
                        return;
+               case N_PLDATA:
+               case N_PLTEXT:
+                       switch ( nlp -> n_desc ) {
+                           default:
+                               error( FATAL , "pc3: unknown stab 0x%x"
+                                       , nlp -> n_desc );
+                               return;
+                           case N_PSO:
+                           case N_PSOL:
+                           case N_PGCONST:
+                           case N_PGTYPE:
+                               /* these won't conflict with library */
+                               return;
+                           case N_PGLABEL:
+                           case N_PGVAR:
+                           case N_PGFUNC:
+                           case N_PGPROC:
+                           case N_PEFUNC:
+                           case N_PEPROC:
+                           case N_PLDATA:
+                           case N_PLTEXT:
+                               errtype = WARNING;
+                               break;
+                       }
+                       break;
            }
                /*
                 *      this is the breaks
                 */
            }
                /*
                 *      this is the breaks
                 */
-           error( WARNING , "%s, line %d: %s already defined (%s, line %d)."
-                   , ifilep -> name , nlp -> n_value , nlp -> n_un.n_name
-                   , symbolp -> sym_un.sym_str.rfilep -> name
-                   , symbolp -> sym_un.sym_str.rline );
+           error( errtype
+               , "%s, line %d: %s %s is already defined\n\t%s%s (%s, line %d)."
+               , ifilep -> name
+               , nlp -> n_value
+               , classify( nlp -> n_desc )
+               , nlp -> n_un.n_name
+               , ( symbolp -> desc == nlp -> n_desc ? "" : " as " )
+               , ( symbolp -> desc == nlp -> n_desc
+                       ? "" : article( symbolp -> desc ) )
+               , symbolp -> sym_un.sym_str.rfilep -> name
+               , symbolp -> sym_un.sym_str.rline );
        }
     }
 
        }
     }
 
@@ -433,7 +517,7 @@ struct symbol *
 entersymbol( name )
     char       *name;
     {
 entersymbol( name )
     char       *name;
     {
-       static struct symboltableinfo   *symboltable = NIL;
+       static struct symboltableinfo   symboltable;
        char                            *enteredname;
        long                            hashindex;
        register struct symboltableinfo *tablep;
        char                            *enteredname;
        long                            hashindex;
        register struct symboltableinfo *tablep;
@@ -443,31 +527,32 @@ entersymbol( name )
 
        enteredname = enterstring( name );
        hashindex = SHORT_ABS( ( long ) enteredname ) % SYMBOLPRIME;
 
        enteredname = enterstring( name );
        hashindex = SHORT_ABS( ( long ) enteredname ) % SYMBOLPRIME;
-       for ( tablep = symboltable ; /*return*/ ; tablep = tablep -> chain ) {
+       for ( tablep = &symboltable ; /*return*/ ; tablep = tablep -> chain ) {
            if ( tablep == NIL ) {
            if ( tablep == NIL ) {
-#              ifdef DEBUG
-                   fprintf( stderr , "[entersymbol] calloc\n" );
-#              endif DEBUG
-               tablep = ( struct symboltableinfo * )
-                           calloc( sizeof ( struct symboltableinfo ) , 1 );
-               if ( tablep == NIL ) {
-                   error( FATAL , "ran out of memory (entersymbol)" );
+#              ifdef SPACEDEBUG
+                   fprintf( stderr ,
+                           "[entersymbol] calloc'ing table for %d symbols\n" , 
+                           SYMBOLPRIME );
+#              endif SPACEDEBUG
+               for ( tablep = &symboltable
+                   ; tablep->chain != NIL
+                   ; tablep = tablep->chain ) {
+                       continue;
                }
                }
-               if ( symboltable == NIL ) {
-                   symboltable = tablep;
+               tablep->chain = ( struct symboltableinfo * )
+                           calloc( 1 , sizeof ( struct symboltableinfo ) );
+               if ( tablep->chain == NIL ) {
+                   error( FATAL , "ran out of memory (entersymbol)" );
                }
                }
+               tablep = tablep->chain;
            }
            herep = &( tablep -> entry[ hashindex ] );
            limitp = &( tablep -> entry[ SYMBOLPRIME ] );
            increment = 1;
            do {
            }
            herep = &( tablep -> entry[ hashindex ] );
            limitp = &( tablep -> entry[ SYMBOLPRIME ] );
            increment = 1;
            do {
-#              ifdef DEBUG
-                   fprintf( stderr , "[entersymbol] increment %d\n" 
-                           , increment );
-#              endif DEBUG
                if ( *herep == NIL ) {
                        /* empty */
                if ( *herep == NIL ) {
                        /* empty */
-                   if ( tablep -> used > ( ( SYMBOLPRIME / 3 ) * 4 ) ) {
+                   if ( tablep -> used > ( ( SYMBOLPRIME / 4 ) * 3 ) ) {
                            /* too full, break for next table */
                        break;
                    }
                            /* too full, break for next table */
                        break;
                    }
@@ -475,19 +560,20 @@ entersymbol( name )
                    *herep = symbolalloc();
                    ( *herep ) -> name = enteredname;
                    ( *herep ) -> lookup = NEW;
                    *herep = symbolalloc();
                    ( *herep ) -> name = enteredname;
                    ( *herep ) -> lookup = NEW;
-#                  ifdef DEBUG
-                       fprintf( stderr , "[entersymbol] name %s NEW\n"
-                               , enteredname );
-#                  endif DEBUG
+#                  ifdef HASHDEBUG
+                       fprintf( stderr ,
+                               "[entersymbol] name %s NEW after %d\n" ,
+                               enteredname , increment / 2 );
+#                  endif HASHDEBUG
                    return *herep;
                }
                    /* a find? */
                if ( ( *herep ) -> name == enteredname ) {
                    ( *herep ) -> lookup = OLD;
                    return *herep;
                }
                    /* a find? */
                if ( ( *herep ) -> name == enteredname ) {
                    ( *herep ) -> lookup = OLD;
-#                  ifdef DEBUG
-                       fprintf( stderr , "[entersymbol] name %s OLD\n"
-                               , enteredname );
-#                  endif DEBUG
+#                  ifdef HASHDEBUG
+                       fprintf( stderr , "[entersymbol] name %s OLD at %d\n" ,
+                               enteredname , increment / 2 );
+#                  endif HASHDEBUG
                    return *herep;
                }
                herep += increment;
                    return *herep;
                }
                herep += increment;
@@ -496,6 +582,9 @@ entersymbol( name )
                }
                increment += 2;
            } while ( increment < SYMBOLPRIME );
                }
                increment += 2;
            } while ( increment < SYMBOLPRIME );
+#          ifdef HASHDEBUG
+               fprintf( stderr , "[entersymbol] next symboltable\n" );
+#          endif HASHDEBUG
        }
     }
 
        }
     }
 
@@ -510,9 +599,11 @@ symbolalloc()
        struct symbol           *newsymbol;
 
        if ( symbolsleft <= 0 ) {
        struct symbol           *newsymbol;
 
        if ( symbolsleft <= 0 ) {
-#          ifdef DEBUG
-               fprintf( stderr , "[symbolalloc] malloc\n" );
-#          endif DEBUG
+#          ifdef SPACEDEBUG
+               fprintf( stderr ,
+                       "[symbolalloc] malloc space for %d symbols\n" ,
+                       SYMBOLALLOC / sizeof( struct symbol ) );
+#          endif SPACEDEBUG
            nextsymbol = ( struct symbol * ) malloc( SYMBOLALLOC );
            if ( nextsymbol == 0 ) {
                error( FATAL , "ran out of memory (symbolalloc)" );
            nextsymbol = ( struct symbol * ) malloc( SYMBOLALLOC );
            if ( nextsymbol == 0 ) {
                error( FATAL , "ran out of memory (symbolalloc)" );
@@ -554,7 +645,7 @@ char *
 enterstring( string )
     char       *string;
     {
 enterstring( string )
     char       *string;
     {
-       static struct stringtableinfo   *stringtable = NIL;
+       static struct stringtableinfo   stringtable;
        long                            hashindex;
        register struct stringtableinfo *tablep;
        register char                   **herep;
        long                            hashindex;
        register struct stringtableinfo *tablep;
        register char                   **herep;
@@ -562,49 +653,52 @@ enterstring( string )
        register long                   increment;
 
        hashindex = SHORT_ABS( hashstring( string ) ) % STRINGPRIME;
        register long                   increment;
 
        hashindex = SHORT_ABS( hashstring( string ) ) % STRINGPRIME;
-       for ( tablep = stringtable ; /*return*/ ; tablep = tablep -> chain ) {
+       for ( tablep = &stringtable ; /*return*/ ; tablep = tablep -> chain ) {
            if ( tablep == NIL ) {
            if ( tablep == NIL ) {
-#              ifdef DEBUG
-                   fprintf( stderr , "[enterstring] calloc\n" );
-#              endif DEBUG
-               tablep = ( struct stringtableinfo * )
-                           calloc( sizeof ( struct stringtableinfo ) , 1 );
-               if ( tablep == NIL ) {
-                   error( FATAL , "ran out of memory (enterstring)" );
+#              ifdef SPACEDEBUG
+                   fprintf( stderr ,
+                           "[enterstring] calloc space for %d strings\n" ,
+                           STRINGPRIME );
+#              endif SPACEDEBUG
+               for ( tablep = &stringtable
+                   ; tablep->chain != NIL
+                   ; tablep = tablep->chain ) {
+                       continue;
                }
                }
-               if ( stringtable == NIL ) {
-                   stringtable = tablep;
+               tablep->chain = ( struct stringtableinfo * )
+                           calloc( 1 , sizeof ( struct stringtableinfo ) );
+               if ( tablep->chain == NIL ) {
+                   error( FATAL , "ran out of memory (enterstring)" );
                }
                }
+               tablep = tablep->chain;
            }
            herep = &( tablep -> entry[ hashindex ] );
            limitp = &( tablep -> entry[ STRINGPRIME ] );
            increment = 1;
            do {
            }
            herep = &( tablep -> entry[ hashindex ] );
            limitp = &( tablep -> entry[ STRINGPRIME ] );
            increment = 1;
            do {
-#              ifdef DEBUG
-                   fprintf( stderr , "[enterstring] increment %d\n" 
-                           , increment );
-#              endif DEBUG
                if ( *herep == NIL ) {
                        /* empty */
                if ( *herep == NIL ) {
                        /* empty */
-                   if ( tablep -> used > ( ( STRINGPRIME / 3 ) * 4 ) ) {
+                   if ( tablep -> used > ( ( STRINGPRIME / 4 ) * 3 ) ) {
                            /* too full, break for next table */
                        break;
                    }
                    tablep -> used++;
                    *herep = charalloc( strlen( string ) );
                    strcpy( *herep , string );
                            /* too full, break for next table */
                        break;
                    }
                    tablep -> used++;
                    *herep = charalloc( strlen( string ) );
                    strcpy( *herep , string );
-#                  ifdef DEBUG
-                       fprintf( stderr , "[enterstring] string %s copied\n"
-                               , *herep );
-#                  endif DEBUG
+#                  ifdef HASHDEBUG
+                       fprintf( stderr ,
+                               "[enterstring] string %s copied after %d\n" , 
+                               *herep , increment / 2 );
+#                  endif HASHDEBUG
                    return *herep;
                }
                    /* quick, check the first chars and then the rest */
                if ( **herep == *string && strcmp( *herep , string ) == 0 ) {
                    return *herep;
                }
                    /* quick, check the first chars and then the rest */
                if ( **herep == *string && strcmp( *herep , string ) == 0 ) {
-#                  ifdef DEBUG
-                       fprintf( stderr , "[enterstring] string %s found\n"
-                               , *herep );
-#                  endif DEBUG
+#                  ifdef HASHDEBUG
+                       fprintf( stderr ,
+                               "[enterstring] string %s found after %d\n" ,
+                               *herep , increment / 2 );
+#                  endif HASHDEBUG
                    return *herep;
                }
                herep += increment;
                    return *herep;
                }
                herep += increment;
@@ -613,6 +707,9 @@ enterstring( string )
                }
                increment += 2;
            } while ( increment < STRINGPRIME );
                }
                increment += 2;
            } while ( increment < STRINGPRIME );
+#          ifdef HASHDEBUG
+               fprintf( stderr , "[enterstring] next stringtable\n" );
+#          endif HASHDEBUG
        }
     }
 
        }
     }
 
@@ -631,10 +728,10 @@ charalloc( length )
 
        if ( charsleft < lengthplus1 ) {
            askfor = lengthplus1 > CHARALLOC ? lengthplus1 : CHARALLOC;
 
        if ( charsleft < lengthplus1 ) {
            askfor = lengthplus1 > CHARALLOC ? lengthplus1 : CHARALLOC;
-#          ifdef DEBUG
-               fprintf( stderr , "[charalloc] malloc( %d )\n" 
+#          ifdef SPACEDEBUG
+               fprintf( stderr , "[charalloc] malloc space for %d chars\n" 
                        , askfor );
                        , askfor );
-#          endif DEBUG
+#          endif SPACEDEBUG
            nextchar = ( char * ) malloc( askfor );
            if ( nextchar == 0 ) {
                error( FATAL , "no room for %d characters" , askfor );
            nextchar = ( char * ) malloc( askfor );
            if ( nextchar == 0 ) {
                error( FATAL , "no room for %d characters" , askfor );
@@ -685,38 +782,34 @@ nextelement( ofilep )
     /*
      * variable number of arguments to error, like printf.
      */
     /*
      * variable number of arguments to error, like printf.
      */
-error( fatal , message , arg1 , arg2 , arg3 , arg4 , arg5 , arg6 )
-    int                fatal;
+error( type , message , arg1 , arg2 , arg3 , arg4 , arg5 , arg6 , arg7 , arg8 )
+    int                type;
     char       *message;
     {
     char       *message;
     {
+       errors = type > errors ? type : errors;
+       if ( wflag && type == WARNING ) {
+           return;
+       }
        fprintf( stderr , "%s: " , program );
        fprintf( stderr , "%s: " , program );
-       fprintf( stderr , message , arg1 , arg2 , arg3 , arg4 , arg5 , arg6 );
-       fprintf( stderr , "\n" );
-       if ( fatal == FATAL ) {
-           exit( 2 );
+       switch ( type ) {
+           case WARNING:
+                   fprintf( stderr , "Warning: " );
+                   break;
+           case ERROR:
+                   fprintf( stderr , "Error: " );
+                   break;
+           case FATAL:
+                   fprintf( stderr , "Fatal: " );
+                   break;
+           default:
+                   fprintf( stderr , "Ooops: " );
+                   break;
        }
        }
-       errors = 1;
-    }
-
-    /*
-     * find the last modify time of a file.
-     * on error, return the current time.
-     */
-time_t
-mtime( filename )
-    char       *filename;
-    {
-       struct stat     filestat;
-
-#      ifdef DEBUG
-           fprintf( stderr , "[mtime] filename %s\n"
-                   , filename );
-#      endif DEBUG
-       if ( stat( filename , &filestat ) != 0 ) {
-           error( WARNING , "%s: cannot open" , filename );
-           return ( (time_t) time( 0 ) );
+       fprintf( stderr , message , arg1,arg2,arg3,arg4,arg5,arg6,arg7,arg8 );
+       fprintf( stderr , "\n" );
+       if ( type == FATAL ) {
+           exit( FATAL );
        }
        }
-       return filestat.st_mtime;
     }
 
 char *
     }
 
 char *
@@ -728,23 +821,61 @@ classify( type )
                return "source file";
            case N_PSOL:
                return "include file";
                return "source file";
            case N_PSOL:
                return "include file";
-           case N_PGLAB:
+           case N_PGLABEL:
                return "label";
                return "label";
-           case N_PGCON:
+           case N_PGCONST:
                return "constant";
                return "constant";
-           case N_PGTYP:
+           case N_PGTYPE:
                return "type";
            case N_PGVAR:
                return "variable";
                return "type";
            case N_PGVAR:
                return "variable";
-           case N_PGFUN:
+           case N_PGFUNC:
                return "function";
                return "function";
-           case N_PGPRC:
+           case N_PGPROC:
                return "procedure";
                return "procedure";
-           case N_PEFUN:
+           case N_PEFUNC:
                return "external function";
                return "external function";
-           case N_PEPRC:
+           case N_PEPROC:
                return "external procedure";
                return "external procedure";
+           case N_PLDATA:
+               return "library variable";
+           case N_PLTEXT:
+               return "library routine";
            default:
                return "unknown symbol";
        }
     }
            default:
                return "unknown symbol";
        }
     }
+
+char *
+article( type )
+    unsigned char      type;
+    {
+       switch ( type ) {
+           case N_PSO:
+               return "a source file";
+           case N_PSOL:
+               return "an include file";
+           case N_PGLABEL:
+               return "a label";
+           case N_PGCONST:
+               return "a constant";
+           case N_PGTYPE:
+               return "a type";
+           case N_PGVAR:
+               return "a variable";
+           case N_PGFUNC:
+               return "a function";
+           case N_PGPROC:
+               return "a procedure";
+           case N_PEFUNC:
+               return "an external function";
+           case N_PEPROC:
+               return "an external procedure";
+           case N_PLDATA:
+               return "a library variable";
+           case N_PLTEXT:
+               return "a library routine";
+           default:
+               return "an unknown symbol";
+       }
+    }