make it look like kernel driver
[unix-history] / usr / src / old / dbx / object.c
index 1aed74d..dc2479d 100644 (file)
@@ -1,6 +1,14 @@
-/* Copyright (c) 1982 Regents of the University of California */
+/*
+ * Copyright (c) 1983 Regents of the University of California.
+ * All rights reserved.  The Berkeley software License Agreement
+ * specifies the terms and conditions for redistribution.
+ */
+
+#ifndef lint
+static char sccsid[] = "@(#)object.c   5.1 (Berkeley) %G%";
+#endif not lint
 
 
-static char sccsid[] = "@(#)object.c 1.14 %G%";
+static char rcsid[] = "$Header: object.c,v 1.6 84/12/26 10:40:51 linton Exp $";
 
 /*
  * Object code interface, mainly for extraction of symbolic information.
 
 /*
  * Object code interface, mainly for extraction of symbolic information.
@@ -8,6 +16,7 @@ static char sccsid[] = "@(#)object.c 1.14 %G%";
 
 #include "defs.h"
 #include "object.h"
 
 #include "defs.h"
 #include "object.h"
+#include "stabstring.h"
 #include "main.h"
 #include "symbols.h"
 #include "names.h"
 #include "main.h"
 #include "symbols.h"
 #include "names.h"
@@ -27,25 +36,36 @@ struct {
     unsigned int nlines;       /* number of lines */
 } nlhdr;
 
     unsigned int nlines;       /* number of lines */
 } nlhdr;
 
+#include "languages.h"
+#include "symbols.h"
+
+#endif
+
+#ifndef N_MOD2
+#    define N_MOD2 0x50
 #endif
 
 public String objname = "a.out";
 #endif
 
 public String objname = "a.out";
-public Integer objsize;
-public char *stringtab;
+public integer objsize;
+
+public Language curlang;
+public Symbol curmodule;
+public Symbol curparam;
+public Symbol curcomm;
+public Symbol commchain;
 
 
-private String progname = nil;
-private Language curlang;
-private Symbol curmodule;
-private Symbol curparam;
+private char *stringtab;
+private struct nlist *curnp;
 private Boolean warned;
 private Boolean warned;
-private Symbol curcomm;
-private Symbol commchain;
 private Boolean strip_ = false;
 
 private Filetab *filep;
 private Linetab *linep, *prevlinep;
 
 private Boolean strip_ = false;
 
 private Filetab *filep;
 private Linetab *linep, *prevlinep;
 
-#define curfilename() (filep-1)->filename
+public String curfilename ()
+{
+    return ((filep-1)->filename);
+}
 
 /*
  * Blocks are figured out on the fly while reading the symbol table.
 
 /*
  * Blocks are figured out on the fly while reading the symbol table.
@@ -53,35 +73,72 @@ private Linetab *linep, *prevlinep;
 
 #define MAXBLKDEPTH 25
 
 
 #define MAXBLKDEPTH 25
 
-private Symbol curblock;
+public Symbol curblock;
+
 private Symbol blkstack[MAXBLKDEPTH];
 private Symbol blkstack[MAXBLKDEPTH];
-private Integer curlevel;
-private Integer bnum, nesting;
+private integer curlevel;
+private integer bnum, nesting;
 private Address addrstk[MAXBLKDEPTH];
 
 private Address addrstk[MAXBLKDEPTH];
 
-#define enterblock(b) { \
-    blkstack[curlevel] = curblock; \
-    ++curlevel; \
-    b->level = curlevel; \
-    b->block = curblock; \
-    curblock = b; \
+public pushBlock (b)
+Symbol b;
+{
+    if (curlevel >= MAXBLKDEPTH) {
+       fatal("nesting depth too large (%d)", curlevel);
+    }
+    blkstack[curlevel] = curblock;
+    ++curlevel;
+    curblock = b;
+    if (traceblocks) {
+       printf("entering block %s\n", symname(b));
+    }
 }
 
 }
 
-#define exitblock() { \
-    if (curblock->class == FUNC or curblock->class == PROC) { \
-       if (prevlinep != linep) { \
-           curblock->symvalue.funcv.src = true; \
-       } \
-    } \
-    --curlevel; \
-    curblock = blkstack[curlevel]; \
+/*
+ * Change the current block with saving the previous one,
+ * since it is assumed that the symbol for the current one is to be deleted.
+ */
+
+public changeBlock (b)
+Symbol b;
+{
+    curblock = b;
+}
+
+public enterblock (b)
+Symbol b;
+{
+    if (curblock == nil) {
+       b->level = 1;
+    } else {
+       b->level = curblock->level + 1;
+    }
+    b->block = curblock;
+    pushBlock(b);
+}
+
+public exitblock ()
+{
+    if (curblock->class == FUNC or curblock->class == PROC) {
+       if (prevlinep != linep) {
+           curblock->symvalue.funcv.src = true;
+       }
+    }
+    if (curlevel <= 0) {
+       panic("nesting depth underflow (%d)", curlevel);
+    }
+    --curlevel;
+    if (traceblocks) {
+       printf("exiting block %s\n", symname(curblock));
+    }
+    curblock = blkstack[curlevel];
 }
 
 /*
  * Enter a source line or file name reference into the appropriate table.
  * Expanded inline to reduce procedure calls.
  *
 }
 
 /*
  * Enter a source line or file name reference into the appropriate table.
  * Expanded inline to reduce procedure calls.
  *
- * private enterline(linenumber, address)
+ * private enterline (linenumber, address)
  * Lineno linenumber;
  * Address address;
  *  ...
  * Lineno linenumber;
  * Address address;
  *  ...
@@ -102,10 +159,6 @@ private Address addrstk[MAXBLKDEPTH];
     } \
 }
 
     } \
 }
 
-#define NTYPES 1000
-
-private Symbol typetable[NTYPES];
-
 /*
  * Read in the namelist from the obj file.
  *
 /*
  * Read in the namelist from the obj file.
  *
@@ -113,7 +166,7 @@ private Symbol typetable[NTYPES];
  * for efficiency sake; there's a lot of data being read here.
  */
 
  * for efficiency sake; there's a lot of data being read here.
  */
 
-public readobj(file)
+public readobj (file)
 String file;
 {
     Fileid f;
 String file;
 {
     Fileid f;
@@ -125,10 +178,17 @@ String file;
        fatal("can't open %s", file);
     }
     read(f, &hdr, sizeof(hdr));
        fatal("can't open %s", file);
     }
     read(f, &hdr, sizeof(hdr));
-    objsize = hdr.a_text;
-    nlhdr.nsyms = hdr.a_syms / sizeof(nlist);
-    nlhdr.nfiles = nlhdr.nsyms;
-    nlhdr.nlines = nlhdr.nsyms;
+    if (N_BADMAG(hdr)) {
+       objsize = 0;
+       nlhdr.nsyms = 0;
+       nlhdr.nfiles = 0;
+       nlhdr.nlines = 0;
+    } else {
+       objsize = hdr.a_text;
+       nlhdr.nsyms = hdr.a_syms / sizeof(nlist);
+       nlhdr.nfiles = nlhdr.nsyms;
+       nlhdr.nlines = nlhdr.nsyms;
+    }
     if (nlhdr.nsyms > 0) {
        lseek(f, (long) N_STROFF(hdr), 0);
        read(f, &(nlhdr.stringsize), sizeof(nlhdr.stringsize));
     if (nlhdr.nsyms > 0) {
        lseek(f, (long) N_STROFF(hdr), 0);
        read(f, &(nlhdr.stringsize), sizeof(nlhdr.stringsize));
@@ -141,56 +201,72 @@ String file;
        ordfunctab();
        setnlines();
        setnfiles();
        ordfunctab();
        setnlines();
        setnfiles();
+    } else {
+       initsyms();
     }
     close(f);
 }
 
     }
     close(f);
 }
 
+/*
+ * Found the beginning of the externals in the object file
+ * (signified by the "-lg" or find an external), close the
+ * block for the last procedure.
+ */
+
+private foundglobals ()
+{
+    if (curblock->class != PROG) {
+       exitblock();
+       if (curblock->class != PROG) {
+           exitblock();
+       }
+    }
+    enterline(0, (linep-1)->addr + 1);
+}
+
 /*
  * Read in symbols from object file.
  */
 
 /*
  * Read in symbols from object file.
  */
 
-private readsyms(f)
+private readsyms (f)
 Fileid f;
 {
     struct nlist *namelist;
     register struct nlist *np, *ub;
 Fileid f;
 {
     struct nlist *namelist;
     register struct nlist *np, *ub;
-    register int index;
     register String name;
     register Boolean afterlg;
     register String name;
     register Boolean afterlg;
+    integer index;
+    char *lastchar;
 
     initsyms();
     namelist = newarr(struct nlist, nlhdr.nsyms);
     read(f, namelist, nlhdr.nsyms * sizeof(struct nlist));
     afterlg = false;
     ub = &namelist[nlhdr.nsyms];
 
     initsyms();
     namelist = newarr(struct nlist, nlhdr.nsyms);
     read(f, namelist, nlhdr.nsyms * sizeof(struct nlist));
     afterlg = false;
     ub = &namelist[nlhdr.nsyms];
-    for (np = &namelist[0]; np < ub; np++) {
+    curnp = &namelist[0];
+    np = curnp;
+    while (np < ub) {
        index = np->n_un.n_strx;
        if (index != 0) {
            name = &stringtab[index - 4];
            /*
        index = np->n_un.n_strx;
        if (index != 0) {
            name = &stringtab[index - 4];
            /*
-             *  if the program contains any .f files a trailing _ is stripped
+             *  If the program contains any .f files a trailing _ is stripped
                     *  from the name on the assumption it was added by the compiler.
             *  This only affects names that follow the sdb N_SO entry with
              *  the .f name. 
              */
             if (strip_ and name[0] != '\0' ) {
                     *  from the name on the assumption it was added by the compiler.
             *  This only affects names that follow the sdb N_SO entry with
              *  the .f name. 
              */
             if (strip_ and name[0] != '\0' ) {
-               register char *p;
-
-               p = name;
-               while (*p != '\0') {
-                   ++p;
-               }
-               --p;
-               if (*p == '_') {
-                   *p = '\0';
+               lastchar = &name[strlen(name) - 1];
+               if (*lastchar == '_') {
+                   *lastchar = '\0';
                }
             }
                }
             }
-
        } else {
            name = nil;
        } 
        } else {
            name = nil;
        } 
+
        /*
        /*
-        * assumptions:
+        * Assumptions:
         *      not an N_STAB   ==> name != nil
         *      name[0] == '-'  ==> name == "-lg"
         *      name[0] != '_'  ==> filename or invisible
         *      not an N_STAB   ==> name != nil
         *      name[0] == '-'  ==> name == "-lg"
         *      name[0] != '_'  ==> filename or invisible
@@ -202,48 +278,53 @@ Fileid f;
            enter_nl(name, np);
        } else if (name[0] == '-') {
            afterlg = true;
            enter_nl(name, np);
        } else if (name[0] == '-') {
            afterlg = true;
-           if (curblock->class != PROG) {
-               exitblock();
-               if (curblock->class != PROG) {
-                   exitblock();
-               }
-           }
-           enterline(0, (linep-1)->addr + 1);
+           foundglobals();
        } else if (afterlg) {
        } else if (afterlg) {
-           if (name[0] == '_') {
-               check_global(&name[1], np);
-           }
+           check_global(name, np);
+       } else if ((np->n_type&N_EXT) == N_EXT) {
+           afterlg = true;
+           foundglobals();
+           check_global(name, np);
        } else if (name[0] == '_') {
            check_local(&name[1], np);
        } else if ((np->n_type&N_TEXT) == N_TEXT) {
            check_filename(name);
        }
        } else if (name[0] == '_') {
            check_local(&name[1], np);
        } else if ((np->n_type&N_TEXT) == N_TEXT) {
            check_filename(name);
        }
-    }
-    if (not afterlg) {
-       fatal("not linked for debugging, use \"cc -g ...\"");
+       ++curnp;
+       np = curnp;
     }
     dispose(namelist);
 }
 
     }
     dispose(namelist);
 }
 
+/*
+ * Get a continuation entry from the name list.
+ * Return the beginning of the name.
+ */
+
+public String getcont ()
+{
+    register integer index;
+    register String name;
+
+    ++curnp;
+    index = curnp->n_un.n_strx;
+    if (index == 0) {
+       panic("continuation followed by empty stab");
+    }
+    name = &stringtab[index - 4];
+    return name;
+}
+
 /*
  * Initialize symbol information.
  */
 
 /*
  * Initialize symbol information.
  */
 
-private initsyms()
+private initsyms ()
 {
     curblock = nil;
     curlevel = 0;
     nesting = 0;
 {
     curblock = nil;
     curlevel = 0;
     nesting = 0;
-    if (progname == nil) {
-       progname = strdup(objname);
-       if (rindex(progname, '/') != nil) {
-           progname = rindex(progname, '/') + 1;
-       }
-       if (index(progname, '.') != nil) {
-           *(index(progname, '.')) = '\0';
-       }
-    }
-    program = insert(identname(progname, true));
+    program = insert(identname("", true));
     program->class = PROG;
     program->symvalue.funcv.beginaddr = 0;
     program->symvalue.funcv.inline = false;
     program->class = PROG;
     program->symvalue.funcv.beginaddr = 0;
     program->symvalue.funcv.inline = false;
@@ -257,12 +338,12 @@ private initsyms()
  * Free all the object file information that's being stored.
  */
 
  * Free all the object file information that's being stored.
  */
 
-public objfree()
+public objfree ()
 {
     symbol_free();
 {
     symbol_free();
-    keywords_free();
-    names_free();
-    dispose(stringtab);
+    /* keywords_free(); */
+    /* names_free(); */
+    /* dispose(stringtab); */
     clrfunctab();
 }
 
     clrfunctab();
 }
 
@@ -270,20 +351,14 @@ public objfree()
  * Enter a namelist entry.
  */
 
  * Enter a namelist entry.
  */
 
-private enter_nl(name, np)
+private enter_nl (name, np)
 String name;
 register struct nlist *np;
 {
     register Symbol s;
 String name;
 register struct nlist *np;
 {
     register Symbol s;
-    register Name n, nn;
-    char buf[100];
+    register Name n;
 
     s = nil;
 
     s = nil;
-    if (name == nil) {
-       n = nil;
-    } else {
-       n = identname(name, true);
-    }
     switch (np->n_type) {
        /*
         * Build a symbol for the FORTRAN common area.  All GSYMS that follow
     switch (np->n_type) {
        /*
         * Build a symbol for the FORTRAN common area.  All GSYMS that follow
@@ -294,6 +369,7 @@ register struct nlist *np;
            if (curcomm) {
                curcomm->symvalue.common.chain = commchain;
            }
            if (curcomm) {
                curcomm->symvalue.common.chain = commchain;
            }
+           n = identname(name, true);
            curcomm = lookup(n);
            if (curcomm == nil) {
                curcomm = insert(n);
            curcomm = lookup(n);
            if (curcomm == nil) {
                curcomm = insert(n);
@@ -318,11 +394,12 @@ register struct nlist *np;
            break;
 
        case N_RBRAC:
            break;
 
        case N_RBRAC:
+           --nesting;
            if (addrstk[nesting] == NOADDR) {
                exitblock();
                newfunc(curblock, (linep - 1)->addr);
            if (addrstk[nesting] == NOADDR) {
                exitblock();
                newfunc(curblock, (linep - 1)->addr);
+               addrstk[nesting] = (linep - 1)->addr;
            }
            }
-           --nesting;
            break;
 
        case N_SLINE:
            break;
 
        case N_SLINE:
@@ -333,6 +410,7 @@ register struct nlist *np;
         * Source files.
         */
        case N_SO:
         * Source files.
         */
        case N_SO:
+           n = identname(name, true);
            enterSourceModule(n, (Address) np->n_value);
            break;
 
            enterSourceModule(n, (Address) np->n_value);
            break;
 
@@ -367,6 +445,7 @@ register struct nlist *np;
            break;
 
        case N_PC:
            break;
 
        case N_PC:
+       case N_MOD2:
            break;
 
        default:
            break;
 
        default:
@@ -380,38 +459,167 @@ register struct nlist *np;
     }
 }
 
     }
 }
 
+/*
+ * Try to find the symbol that is referred to by the given name.  Since it's
+ * an external, we need to follow a level or two of indirection.
+ */
+
+private Symbol findsym (n, var_isextref)
+Name n;
+boolean *var_isextref;
+{
+    register Symbol r, s;
+
+    *var_isextref = false;
+    find(s, n) where
+       (
+           s->level == program->level and (
+               s->class == EXTREF or s->class == VAR or
+               s->class == PROC or s->class == FUNC
+           )
+       ) or (
+           s->block == program and s->class == MODULE
+       )
+    endfind(s);
+    if (s == nil) {
+       r = nil;
+    } else if (s->class == EXTREF) {
+       *var_isextref = true;
+       r = s->symvalue.extref;
+       delete(s);
+
+       /*
+        * Now check for another level of indirection that could come from
+        * a forward reference in procedure nesting information.  In this case
+        * the symbol has already been deleted.
+        */
+       if (r != nil and r->class == EXTREF) {
+           r = r->symvalue.extref;
+       }
+/*
+    } else if (s->class == MODULE) {
+       s->class = FUNC;
+       s->level = program->level;
+       r = s;
+ */
+    } else {
+       r = s;
+    }
+    return r;
+}
+
+/*
+ * Create a symbol for a text symbol with no source information.
+ * We treat it as an assembly language function.
+ */
+
+private Symbol deffunc (n)
+Name n;
+{
+    Symbol f;
+
+    f = insert(n);
+    f->language = findlanguage(".s");
+    f->class = FUNC;
+    f->type = t_int;
+    f->block = curblock;
+    f->level = program->level;
+    f->symvalue.funcv.src = false;
+    f->symvalue.funcv.inline = false;
+    return f;
+}
+
+/*
+ * Create a symbol for a data or bss symbol with no source information.
+ * We treat it as an assembly language variable.
+ */
+
+private Symbol defvar (n)
+Name n;
+{
+    Symbol v;
+
+    v = insert(n);
+    v->language = findlanguage(".s");
+    v->class = VAR;
+    v->type = t_int;
+    v->level = program->level;
+    v->block = curblock;
+    return v;
+}
+
+/*
+ * Update a symbol entry with a text address.
+ */
+
+private updateTextSym (s, name, addr)
+Symbol s;
+char *name;
+Address addr;
+{
+    if (s->class == VAR) {
+       s->symvalue.offset = addr;
+    } else {
+       s->symvalue.funcv.beginaddr = addr;
+       if (name[0] == '_') {
+           newfunc(s, codeloc(s));
+           findbeginning(s);
+       }
+    }
+}
+
 /*
  * Check to see if a global _name is already in the symbol table,
  * if not then insert it.
  */
 
 /*
  * Check to see if a global _name is already in the symbol table,
  * if not then insert it.
  */
 
-private check_global(name, np)
+private check_global (name, np)
 String name;
 register struct nlist *np;
 {
     register Name n;
     register Symbol t, u;
 String name;
 register struct nlist *np;
 {
     register Name n;
     register Symbol t, u;
+    char buf[4096];
+    boolean isextref;
+    integer count;
 
 
-    if (not streq(name, "end")) {
-       n = identname(name, true);
+    if (not streq(name, "_end")) {
+       if (name[0] == '_') {
+           n = identname(&name[1], true);
+       } else {
+           n = identname(name, true);
+           if (lookup(n) != nil) {
+               sprintf(buf, "$%s", name);
+               n = identname(buf, false);
+           }
+       }
        if ((np->n_type&N_TYPE) == N_TEXT) {
        if ((np->n_type&N_TYPE) == N_TEXT) {
-           find(t, n) where
-               t->level == program->level and
-               (t->class == PROC or t->class == FUNC)
-           endfind(t);
-           if (t == nil) {
-               t = insert(n);
-               t->language = findlanguage(".s");
-               t->class = FUNC;
-               t->type = t_int;
-               t->block = curblock;
-               t->level = program->level;
-               t->symvalue.funcv.src = false;
-               t->symvalue.funcv.inline = false;
+           count = 0;
+           t = findsym(n, &isextref);
+           while (isextref) {
+               ++count;
+               updateTextSym(t, name, np->n_value);
+               t = findsym(n, &isextref);
+           }
+           if (count == 0) {
+               if (t == nil) {
+                   t = deffunc(n);
+                   updateTextSym(t, name, np->n_value);
+                   if (tracesyms) {
+                       printdecl(t);
+                   }
+               } else {
+                   if (t->class == MODULE) {
+                       u = t;
+                       t = deffunc(n);
+                       t->block = u;
+                       if (tracesyms) {
+                           printdecl(t);
+                       }
+                   }
+                   updateTextSym(t, name, np->n_value);
+               }
            }
            }
-           t->symvalue.funcv.beginaddr = np->n_value;
-           newfunc(t, codeloc(t));
-           findbeginning(t);
        } else if ((np->n_type&N_TYPE) == N_BSS) {
            find(t, n) where
                t->class == COMMON
        } else if ((np->n_type&N_TYPE) == N_BSS) {
            find(t, n) where
                t->class == COMMON
@@ -436,26 +644,54 @@ register struct nlist *np;
  * If not, create a variable for the entry.  In any case,
  * set the offset of the variable according to the value field
  * in the entry.
  * If not, create a variable for the entry.  In any case,
  * set the offset of the variable according to the value field
  * in the entry.
+ *
+ * If the external name has been referred to by several other symbols,
+ * we must update each of them.
  */
 
  */
 
-private check_var(np, n)
+private check_var (np, n)
 struct nlist *np;
 register Name n;
 {
 struct nlist *np;
 register Name n;
 {
-    register Symbol t;
+    register Symbol t, u, next;
+    Symbol conflict;
 
 
-    find(t, n) where
-       t->class == VAR and t->level == program->level
-    endfind(t);
+    t = lookup(n);
     if (t == nil) {
     if (t == nil) {
-       t = insert(n);
-       t->language = findlanguage(".s");
-       t->class = VAR;
-       t->type = t_int;
-       t->level = program->level;
+       t = defvar(n);
+       t->symvalue.offset = np->n_value;
+       if (tracesyms) {
+           printdecl(t);
+       }
+    } else {
+       conflict = nil;
+       do {
+           next = t->next_sym;
+           if (t->name == n) {
+               if (t->class == MODULE and t->block == program) {
+                   conflict = t;
+               } else if (t->class == EXTREF and t->level == program->level) {
+                   u = t->symvalue.extref;
+                   while (u != nil and u->class == EXTREF) {
+                       u = u->symvalue.extref;
+                   }
+                   u->symvalue.offset = np->n_value;
+                   delete(t);
+               } else if (t->level == program->level and
+                   (t->class == VAR or t->class == PROC or t->class == FUNC)
+               ) {
+                   conflict = nil;
+                   t->symvalue.offset = np->n_value;
+               }
+           }
+           t = next;
+       } while (t != nil);
+       if (conflict != nil) {
+           u = defvar(n);
+           u->block = conflict;
+           u->symvalue.offset = np->n_value;
+       }
     }
     }
-    t->block = curblock;
-    t->symvalue.offset = np->n_value;
 }
 
 /*
 }
 
 /*
@@ -463,7 +699,7 @@ register Name n;
  * If not then enter it.
  */
 
  * If not then enter it.
  */
 
-private check_local(name, np)
+private check_local (name, np)
 String name;
 register struct nlist *np;
 {
 String name;
 register struct nlist *np;
 {
@@ -498,12 +734,13 @@ register struct nlist *np;
  * For some reason these are listed as in the text segment.
  */
 
  * For some reason these are listed as in the text segment.
  */
 
-private check_filename(name)
+private check_filename (name)
 String name;
 {
     register String mname;
 String name;
 {
     register String mname;
-    register Integer i;
-    register Symbol s;
+    register integer i;
+    Name n;
+    Symbol s;
 
     mname = strdup(name);
     i = strlen(mname) - 2;
 
     mname = strdup(name);
     i = strlen(mname) - 2;
@@ -513,11 +750,15 @@ String name;
        while (mname[i] != '/' and i >= 0) {
            --i;
        }
        while (mname[i] != '/' and i >= 0) {
            --i;
        }
-       s = insert(identname(&mname[i+1], true));
-       s->language = findlanguage(".s");
-       s->class = MODULE;
-       s->symvalue.funcv.beginaddr = 0;
-       findbeginning(s);
+       n = identname(&mname[i+1], true);
+       find(s, n) where s->block == program and s->class == MODULE endfind(s);
+       if (s == nil) {
+           s = insert(n);
+           s->language = findlanguage(".s");
+           s->class = MODULE;
+           s->symvalue.funcv.beginaddr = 0;
+           findbeginning(s);
+       }
        if (curblock->class != PROG) {
            exitblock();
            if (curblock->class != PROG) {
        if (curblock->class != PROG) {
            exitblock();
            if (curblock->class != PROG) {
@@ -537,22 +778,27 @@ String name;
  * by "whatblock".
  */
 
  * by "whatblock".
  */
 
-private unnamed_block()
+public chkUnnamedBlock ()
 {
     register Symbol s;
     static int bnum = 0;
     char buf[100];
 {
     register Symbol s;
     static int bnum = 0;
     char buf[100];
+    Address startaddr;
 
 
-    ++bnum;
-    sprintf(buf, "$b%d", bnum);
-    s = insert(identname(buf, false));
-    s->class = PROG;
-    s->symvalue.funcv.src = false;
-    s->symvalue.funcv.inline = true;
-    s->symvalue.funcv.beginaddr = addrstk[nesting];
-    enterblock(s);
-    newfunc(s, addrstk[nesting]);
-    addrstk[nesting] = NOADDR;
+    if (nesting > 0 and addrstk[nesting] != NOADDR) {
+       startaddr = (linep - 1)->addr;
+       ++bnum;
+       sprintf(buf, "$b%d", bnum);
+       s = insert(identname(buf, false));
+       s->language = curlang;
+       s->class = PROC;
+       s->symvalue.funcv.src = false;
+       s->symvalue.funcv.inline = true;
+       s->symvalue.funcv.beginaddr = startaddr;
+       enterblock(s);
+       newfunc(s, startaddr);
+       addrstk[nesting] = NOADDR;
+    }
 }
 
 /*
 }
 
 /*
@@ -565,7 +811,7 @@ private unnamed_block()
  * procedure and module.
  */
 
  * procedure and module.
  */
 
-private enterSourceModule(n, addr)
+private enterSourceModule (n, addr)
 Name n;
 Address addr;
 {
 Name n;
 Address addr;
 {
@@ -585,469 +831,40 @@ Address addr;
     if (suffix != nil) {
        *suffix = '\0';
     }
     if (suffix != nil) {
        *suffix = '\0';
     }
-    if (curblock->class != PROG) {
-       exitblock();
+    if (not (*language_op(curlang, L_HASMODULES))()) {
        if (curblock->class != PROG) {
            exitblock();
        if (curblock->class != PROG) {
            exitblock();
-       }
-    }
-    nn = identname(mname, true);
-    if (curmodule == nil or curmodule->name != nn) {
-       s = insert(nn);
-       s->class = MODULE;
-       s->symvalue.funcv.beginaddr = 0;
-       findbeginning(s);
-    } else {
-       s = curmodule;
-    }
-    s->language = curlang;
-    enterblock(s);
-    curmodule = s;
-    if (program->language == nil) {
-       program->language = curlang;
-    }
-    warned = false;
-    enterfile(ident(n), addr);
-    bzero(typetable, sizeof(typetable));
-}
-
-/*
- * Put an nlist into the symbol table.
- * If it's already there just add the associated information.
- *
- * Type information is encoded in the name following a ":".
- */
-
-private Symbol constype();
-private Char *curchar;
-
-#define skipchar(ptr, ch) { \
-    if (*ptr != ch) { \
-       panic("expected char '%c', found char '%c'", ch, *ptr); \
-    } \
-    ++ptr; \
-}
-
-private entersym(str, np)
-String str;
-struct nlist *np;
-{
-    register Symbol s;
-    register char *p;
-    register int c;
-    register Name n;
-    register Integer i;
-    Boolean knowtype, isnew;
-    Symclass class;
-    Integer level;
-
-    p = index(str, ':');
-    *p = '\0';
-    c = *(p+1);
-    n = identname(str, true);
-    if (index("FfGV", c) != nil) {
-       if (c == 'F' or c == 'f') {
-           class = FUNC;
-       } else {
-           class = VAR;
-       }
-       level = (c == 'f' ? curmodule->level : program->level);
-       find(s, n) where s->level == level and s->class == class endfind(s);
-       if (s == nil) {
-           isnew = true;
-           s = insert(n);
-       } else {
-           isnew = false;
-       }
-    } else {
-       isnew = true;
-       s = insert(n);
-    }
-
-    if (nesting > 0 and addrstk[nesting] != NOADDR) {
-       unnamed_block();
-    }
-
-    /*
-     * Default attributes.
-     */
-    s->language = curlang;
-    s->class = VAR;
-    s->block = curblock;
-    s->level = curlevel;
-    s->symvalue.offset = np->n_value;
-    curchar = p + 2;
-    knowtype = false;
-    switch (c) {
-       case 't':       /* type name */
-           s->class = TYPE;
-           i = getint();
-           if (i == 0) {
-               panic("bad input on type \"%s\" at \"%s\"", symname(s),
-                   curchar);
-           } else if (i >= NTYPES) {
-               panic("too many types in file \"%s\"", curfilename());
-           }
-           /*
-            * A hack for C typedefs that don't create new types,
-            * e.g. typedef unsigned int Hashvalue;
-            *  or  typedef struct blah BLAH;
-            */
-           if (*curchar == '\0') {
-               s->type = typetable[i];
-               if (s->type == nil) {
-                   s->type = symbol_alloc();
-                   typetable[i] = s->type;
-               }
-               knowtype = true;
-           } else {
-               typetable[i] = s;
-               skipchar(curchar, '=');
-           }
-           break;
-
-       case 'T':       /* tag */
-           s->class = TAG;
-           i = getint();
-           if (i == 0) {
-               panic("bad input on tag \"%s\" at \"%s\"", symname(s),
-                   curchar);
-           } else if (i >= NTYPES) {
-               panic("too many types in file \"%s\"", curfilename());
-           }
-           if (typetable[i] != nil) {
-               typetable[i]->language = curlang;
-               typetable[i]->class = TYPE;
-               typetable[i]->type = s;
-           } else {
-               typetable[i] = s;
-           }
-           skipchar(curchar, '=');
-           break;
-
-       case 'F':       /* public function */
-       case 'f':       /* private function */
-           s->class = FUNC;
-           if (curblock->class == FUNC or curblock->class == PROC) {
+           if (curblock->class != PROG) {
                exitblock();
            }
                exitblock();
            }
-           enterblock(s);
-           if (c == 'F') {
-               s->level = program->level;
-               isnew = false;
-           }
-           curparam = s;
-           if (isnew) {
-               s->symvalue.funcv.src = false;
-               s->symvalue.funcv.inline = false;
-               s->symvalue.funcv.beginaddr = np->n_value;
-               newfunc(s, codeloc(s));
-               findbeginning(s);
-           }
-           break;
-
-       case 'G':       /* public variable */
-           s->level = program->level;
-           break;
-
-       case 'S':       /* private variable */
-           s->level = curmodule->level;
-           s->block = curmodule;
-           break;
-
-/*
- *  keep global BSS variables chained so can resolve when get the start
- *  of common; keep the list in order so f77 can display all vars in a COMMON
-*/
-       case 'V':       /* own variable */
-           s->level = 2;
-           if (curcomm) {
-             if (commchain != nil) {
-                 commchain->symvalue.common.chain = s;
-             }                   
-             else {
-                 curcomm->symvalue.common.offset = (int) s;
-             }                   
-              commchain = s;
-              s->symvalue.common.offset = np->n_value;
-              s->symvalue.common.chain = nil;
-           }
-           break;
-
-       case 'r':       /* register variable */
-           s->level = -(s->level);
-           break;
-
-       case 'p':       /* parameter variable */
-           curparam->chain = s;
-           curparam = s;
-           break;
-
-       case 'v':       /* varies parameter */
-           s->class = REF;
-           s->symvalue.offset = np->n_value;
-           curparam->chain = s;
-           curparam = s;
-           break;
-
-       default:        /* local variable */
-           --curchar;
-           break;
-    }
-    if (not knowtype) {
-       s->type = constype(nil);
-       if (s->class == TAG) {
-           addtag(s);
-       }
-    }
-    if (tracesyms) {
-       printdecl(s);
-       fflush(stdout);
-    }
-}
-
-/*
- * Construct a type out of a string encoding.
- *
- * The forms of the string are
- *
- *     <number>
- *     <number>=<type>
- *     r<type>;<number>;<number>               $ subrange
- *     a<type>;<type>                          $ array[index] of element
- *     s{<name>:<type>;<number>;<number>}      $ record
- *     S<type>                                 $ set
- *     *<type>                                 $ pointer
- */
-
-private Rangetype getrangetype();
-
-private Symbol constype(type)
-Symbol type;
-{
-    register Symbol t, u;
-    register Char *p, *cur;
-    register Integer n;
-    Integer b;
-    Name name;
-    Char class;
-
-    b = curlevel;
-    if (isdigit(*curchar)) {
-       n = getint();
-       if (n == 0) {
-           panic("bad type number at \"%s\"", curchar);
-       } else if (n >= NTYPES) {
-           panic("too many types in file \"%s\"", curfilename());
-       }
-       if (*curchar == '=') {
-           if (typetable[n] != nil) {
-               t = typetable[n];
-           } else {
-               t = symbol_alloc();
-               typetable[n] = t;
-           }
-           ++curchar;
-           constype(t);
-       } else {
-           t = typetable[n];
-           if (t == nil) {
-               t = symbol_alloc();
-               typetable[n] = t;
-           }
        }
        }
-    } else {
-       if (type == nil) {
-           t = symbol_alloc();
+       nn = identname(mname, true);
+       if (curmodule == nil or curmodule->name != nn) {
+           s = insert(nn);
+           s->class = MODULE;
+           s->symvalue.funcv.beginaddr = 0;
+           findbeginning(s);
        } else {
        } else {
-           t = type;
+           s = curmodule;
        }
        }
-       t->language = curlang;
-       t->level = b;
-       t->block = curblock;
-       class = *curchar++;
-       switch (class) {
-           case 'r':
-               t->class = RANGE;
-               t->type = constype(nil);
-               skipchar(curchar, ';');
-               t->symvalue.rangev.lowertype = getrangetype();
-               t->symvalue.rangev.lower = getint();
-               skipchar(curchar, ';');
-               t->symvalue.rangev.uppertype = getrangetype();
-               t->symvalue.rangev.upper = getint();
-               break;
-
-           case 'a':
-               t->class = ARRAY;
-               t->chain = constype(nil);
-               skipchar(curchar, ';');
-               t->type = constype(nil);
-               break;
-
-           case 'S':
-               t->class = SET;
-               t->type = constype(nil);
-               break;
-
-           case 's':
-           case 'u':
-               t->class = (class == 's') ? RECORD : VARNT;
-               t->symvalue.offset = getint();
-               u = t;
-               cur = curchar;
-               while (*cur != ';' and *cur != '\0') {
-                   p = index(cur, ':');
-                   if (p == nil) {
-                       panic("index(\"%s\", ':') failed", curchar);
-                   }
-                   *p = '\0';
-                   name = identname(cur, true);
-                   u->chain = newSymbol(name, b, FIELD, nil, nil);
-                   cur = p + 1;
-                   u = u->chain;
-                   u->language = curlang;
-                   curchar = cur;
-                   u->type = constype(nil);
-                   skipchar(curchar, ',');
-                   u->symvalue.field.offset = getint();
-                   skipchar(curchar, ',');
-                   u->symvalue.field.length = getint();
-                   skipchar(curchar, ';');
-                   cur = curchar;
-               }
-               if (*cur == ';') {
-                   ++cur;
-               }
-               curchar = cur;
-               break;
-
-           case 'e':
-               t->class = SCAL;
-               u = t;
-               while (*curchar != ';' and *curchar != '\0') {
-                   p = index(curchar, ':');
-                   assert(p != nil);
-                   *p = '\0';
-                   u->chain = insert(identname(curchar, true));
-                   curchar = p + 1;
-                   u = u->chain;
-                   u->language = curlang;
-                   u->class = CONST;
-                   u->level = b;
-                   u->block = curblock;
-                   u->type = t;
-                   u->symvalue.iconval = getint();
-                   skipchar(curchar, ',');
-               }
-               if (*curchar == ';')
-                       curchar++;
-               break;
-
-           case '*':
-               t->class = PTR;
-               t->type = constype(nil);
-               break;
-
-           case 'f':
-               t->class = FUNC;
-               t->type = constype(nil);
-               break;
-
-           default:
-               badcaseval(class);
-       }
-    }
-    return t;
-}
-
-/*
- * Get a range type.
- *
- * Special letters indicate a dynamic bound, i.e. what follows
- * is the offset from the fp which contains the bound.
- * J is a special flag to handle fortran a(*) bounds.
- */
-
-private Rangetype getrangetype()
-{
-    Rangetype t;
-
-    switch (*curchar) {
-       case 'A':
-           t = R_ARG;
-           curchar++;
-           break;
-
-       case 'T':
-           t = R_TEMP;
-           curchar++;
-           break;
-
-       case 'J': 
-           t = R_ADJUST;
-           curchar++;
-           break;
-
-       default:
-           t = R_CONST;
-           break;
-    }
-    return t;
-}
-
-/*
- * Read an integer from the current position in the type string.
- */
-
-private Integer getint()
-{
-    register Integer n;
-    register char *p;
-    register Boolean isneg;
-
-    n = 0;
-    p = curchar;
-    if (*p == '-') {
-       isneg = true;
-       ++p;
-    } else {
-       isneg = false;
+       s->language = curlang;
+       enterblock(s);
+       curmodule = s;
     }
     }
-    while (isdigit(*p)) {
-       n = 10*n + (*p - '0');
-       ++p;
+    if (program->language == nil) {
+       program->language = curlang;
     }
     }
-    curchar = p;
-    return isneg ? (-n) : n;
-}
-
-/*
- * Add a tag name.  This is a kludge to be able to refer
- * to tags that have the same name as some other symbol
- * in the same block.
- */
-
-private addtag(s)
-register Symbol s;
-{
-    register Symbol t;
-    char buf[100];
-
-    sprintf(buf, "$$%.90s", ident(s->name));
-    t = insert(identname(buf, false));
-    t->language = s->language;
-    t->class = TAG;
-    t->type = s->type;
-    t->block = s->block;
+    warned = false;
+    enterfile(ident(n), addr);
+    initTypeTable();
 }
 
 /*
  * Allocate file and line tables and initialize indices.
  */
 
 }
 
 /*
  * Allocate file and line tables and initialize indices.
  */
 
-private allocmaps(nf, nl)
-Integer nf, nl;
+private allocmaps (nf, nl)
+integer nf, nl;
 {
     if (filetab != nil) {
        dispose(filetab);
 {
     if (filetab != nil) {
        dispose(filetab);
@@ -1070,7 +887,7 @@ Integer nf, nl;
  * turn may not also cause a problem.
  */
 
  * turn may not also cause a problem.
  */
 
-private enterfile(filename, addr)
+private enterfile (filename, addr)
 String filename;
 Address addr;
 {
 String filename;
 Address addr;
 {
@@ -1086,7 +903,7 @@ Address addr;
  * to do a binary search, we set it when we're done.
  */
 
  * to do a binary search, we set it when we're done.
  */
 
-private setnlines()
+private setnlines ()
 {
     nlhdr.nlines = linep - linetab;
 }
 {
     nlhdr.nlines = linep - linetab;
 }
@@ -1095,7 +912,7 @@ private setnlines()
  * Similarly for nfiles ...
  */
 
  * Similarly for nfiles ...
  */
 
-private setnfiles()
+private setnfiles ()
 {
     nlhdr.nfiles = filep - filetab;
     setsource(filetab[0].filename);
 {
     nlhdr.nfiles = filep - filetab;
     setsource(filetab[0].filename);