BSD 4_3 release

[unix-history] / usr / src / ucb / dbx / symbols.c

diff --git a/usr/src/ucb/dbx/symbols.c b/usr/src/ucb/dbx/symbols.c
index 736dec7..b4ad438 100644 (file)
--- a/usr/src/ucb/dbx/symbols.c
+++ b/usr/src/ucb/dbx/symbols.c
@@ -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[] = "@(#)symbols.c  5.2 (Berkeley) 9/5/85";
+#endif not lint

 
 

-static char sccsid[] = "@(#)symbols.c 1.11 8/16/83";
+static char rcsid[] = "$Header: symbols.c,v 1.6 84/12/26 10:42:31 linton Exp $";

 
 /*
  * Symbol management.
 
 /*
  * Symbol management.


@@ -26,16 +34,17 @@ typedef struct Symbol *Symbol;
 #include "machine.h"
 #include "names.h"
 #include "languages.h"
 #include "machine.h"
 #include "names.h"
 #include "languages.h"

+#include "tree.h"

 
 /*
  * Symbol classes
  */
 
 typedef enum {
 
 /*
  * Symbol classes
  */
 
 typedef enum {

-    BADUSE, CONST, TYPE, VAR, ARRAY, PTRFILE, RECORD, FIELD,
+    BADUSE, CONST, TYPE, VAR, ARRAY, DYNARRAY, SUBARRAY, PTRFILE, RECORD, FIELD,

     PROC, FUNC, FVAR, REF, PTR, FILET, SET, RANGE, 
     LABEL, WITHPTR, SCAL, STR, PROG, IMPROPER, VARNT,
     PROC, FUNC, FVAR, REF, PTR, FILET, SET, RANGE, 
     LABEL, WITHPTR, SCAL, STR, PROG, IMPROPER, VARNT,

-    FPROC, FFUNC, MODULE, TAG, COMMON, TYPEREF
+    FPROC, FFUNC, MODULE, TAG, COMMON, EXTREF, TYPEREF

 } Symclass;
 
 typedef enum { R_CONST, R_TEMP, R_ARG, R_ADJUST } Rangetype; 
 } Symclass;
 
 typedef enum { R_CONST, R_TEMP, R_ARG, R_ADJUST } Rangetype; 


@@ -48,9 +57,11 @@ struct Symbol {
     Symbol type;
     Symbol chain;
     union {
     Symbol type;
     Symbol chain;
     union {

+       Node constval;          /* value of constant symbol */

        int offset;             /* variable address */
        long iconval;           /* integer constant value */
        double fconval;         /* floating constant value */
        int offset;             /* variable address */
        long iconval;           /* integer constant value */
        double fconval;         /* floating constant value */

+       int ndims;              /* no. of dimensions for dynamic/sub-arrays */

        struct {                /* field offset and size (both in bits) */
            int offset;
            int length;
        struct {                /* field offset and size (both in bits) */
            int offset;
            int length;


@@ -67,8 +78,10 @@ struct Symbol {
        } rangev;
        struct {
            int offset : 16;    /* offset for of function value */
        } rangev;
        struct {
            int offset : 16;    /* offset for of function value */

-           Boolean src : 8;    /* true if there is source line info */
-           Boolean inline : 8; /* true if no separate act. rec. */
+           Boolean src : 1;    /* true if there is source line info */
+           Boolean inline : 1; /* true if no separate act. rec. */
+           Boolean intern : 1; /* internal calling sequence */
+           int unused : 13;

            Address beginaddr;  /* address of function code */
        } funcv;
        struct {                /* variant record info */
            Address beginaddr;  /* address of function code */
        } funcv;
        struct {                /* variant record info */


@@ -76,6 +89,8 @@ struct Symbol {
            Symbol vtorec;
            Symbol vtag;
        } varnt;
            Symbol vtorec;
            Symbol vtag;
        } varnt;

+       String typeref;         /* type defined by "<module>:<type>" */
+       Symbol extref;          /* indirect symbol for external reference */

     } symvalue;
     Symbol block;              /* symbol containing this symbol */
     Symbol next_sym;           /* hash chain */
     } symvalue;
     Symbol block;              /* symbol containing this symbol */
     Symbol next_sym;           /* hash chain */


@@ -90,20 +105,28 @@ Symbol t_char;
 Symbol t_int;
 Symbol t_real;
 Symbol t_nil;
 Symbol t_int;
 Symbol t_real;
 Symbol t_nil;

+Symbol t_addr;

 
 Symbol program;
 Symbol curfunc;
 
 
 Symbol program;
 Symbol curfunc;
 

+boolean showaggrs;
+

 #define symname(s) ident(s->name)
 #define codeloc(f) ((f)->symvalue.funcv.beginaddr)
 #define isblock(s) (Boolean) ( \
     s->class == FUNC or s->class == PROC or \
     s->class == MODULE or s->class == PROG \
 )
 #define symname(s) ident(s->name)
 #define codeloc(f) ((f)->symvalue.funcv.beginaddr)
 #define isblock(s) (Boolean) ( \
     s->class == FUNC or s->class == PROC or \
     s->class == MODULE or s->class == PROG \
 )

+#define isroutine(s) (Boolean) ( \
+    s->class == FUNC or s->class == PROC \
+)

 
 #define nosource(f) (not (f)->symvalue.funcv.src)
 #define isinline(f) ((f)->symvalue.funcv.inline)
 
 
 #define nosource(f) (not (f)->symvalue.funcv.src)
 #define isinline(f) ((f)->symvalue.funcv.inline)
 

+#define isreg(s)               (s->level < 0)
+

 #include "tree.h"
 
 /*
 #include "tree.h"
 
 /*


@@ -163,15 +186,14 @@ public Symbol symbol_alloc()
     return &(sympool->sym[nleft]);
 }
 
     return &(sympool->sym[nleft]);
 }
 

-
-public symbol_dump(func)
+public symbol_dump (func)

 Symbol func;
 {
     register Symbol s;
 Symbol func;
 {
     register Symbol s;

-    register Integer i;
+    register integer i;

 
     printf(" symbols in %s \n",symname(func));
 
     printf(" symbols in %s \n",symname(func));

-    for (i = 0; i< HASHTABLESIZE; i++) {
+    for (i = 0; i < HASHTABLESIZE; i++) {

        for (s = hashtab[i]; s != nil; s = s->next_sym) {
            if (s->block == func) {
                psym(s);
        for (s = hashtab[i]; s != nil; s = s->next_sym) {
            if (s->block == func) {
                psym(s);


@@ -217,6 +239,7 @@ Symbol chain;
 
     s = symbol_alloc();
     s->name = name;
 
     s = symbol_alloc();
     s->name = name;

+    s->language = primlang;

     s->level = blevel;
     s->class = class;
     s->type = type;
     s->level = blevel;
     s->class = class;
     s->type = type;


@@ -260,9 +283,36 @@ Name name;
     return s;
 }
 
     return s;
 }
 

+/*
+ * Delete a symbol from the symbol table.
+ */
+
+public delete (s)
+Symbol s;
+{
+    register Symbol t;
+    register unsigned int h;
+
+    h = hash(s->name);
+    t = hashtab[h];
+    if (t == nil) {
+       panic("delete of non-symbol '%s'", symname(s));
+    } else if (t == s) {
+       hashtab[h] = s->next_sym;
+    } else {
+       while (t->next_sym != s) {
+           t = t->next_sym;
+           if (t == nil) {
+               panic("delete of non-symbol '%s'", symname(s));
+           }
+       }
+       t->next_sym = s->next_sym;
+    }
+}
+

 /*
  * Dump out all the variables associated with the given
 /*
  * Dump out all the variables associated with the given

- * procedure, function, or program at the given recursive level.
+ * procedure, function, or program associated with the given stack frame.

  *
  * This is quite inefficient.  We traverse the entire symbol table
  * each time we're called.  The assumption is that this routine
  *
  * This is quite inefficient.  We traverse the entire symbol table
  * each time we're called.  The assumption is that this routine


@@ -290,33 +340,30 @@ Frame frame;
     }
 }
 
     }
 }
 

-/*
- * Create base types.
- */
-
-public symbols_init()
-{
-    t_boolean = maketype("$boolean", 0L, 1L);
-    t_int = maketype("$integer", 0x80000000L, 0x7fffffffL);
-    t_char = maketype("$char", 0L, 127L);
-    t_real = maketype("$real", 8L, 0L);
-    t_nil = maketype("$nil", 0L, 0L);
-}
-

 /*
  * Create a builtin type.
  * Builtin types are circular in that btype->type->type = btype.
  */
 
 /*
  * Create a builtin type.
  * Builtin types are circular in that btype->type->type = btype.
  */
 

-public Symbol maketype(name, lower, upper)
+private Symbol maketype(name, lower, upper)

 String name;
 long lower;
 long upper;
 {
     register Symbol s;
 String name;
 long lower;
 long upper;
 {
     register Symbol s;

+    Name n;

 
 

-    s = newSymbol(identname(name, true), 0, TYPE, nil, nil);
-    s->language = findlanguage(".c");
+    if (name == nil) {
+       n = nil;
+    } else {
+       n = identname(name, true);
+    }
+    s = insert(n);
+    s->language = primlang;
+    s->level = 0;
+    s->class = TYPE;
+    s->type = nil;
+    s->chain = nil;

     s->type = newSymbol(nil, 0, RANGE, s, nil);
     s->type->symvalue.rangev.lower = lower;
     s->type->symvalue.rangev.upper = upper;
     s->type = newSymbol(nil, 0, RANGE, s, nil);
     s->type->symvalue.rangev.lower = lower;
     s->type->symvalue.rangev.upper = upper;


@@ -324,27 +371,34 @@ long upper;
 }
 
 /*
 }
 
 /*

- * These functions are now compiled inline.
- *
- * public String symname(s)
-Symbol s;
-{
-    checkref(s);
-    return ident(s->name);
-}
+ * Create the builtin symbols.
+ */

 
 

- *
- * public Address codeloc(f)
-Symbol f;
+public symbols_init ()

 {
 {

-    checkref(f);
-    if (not isblock(f)) {
-       panic("codeloc: \"%s\" is not a block", ident(f->name));
-    }
-    return f->symvalue.funcv.beginaddr;
+    Symbol s;
+
+    t_boolean = maketype("$boolean", 0L, 1L);
+    t_int = maketype("$integer", 0x80000000L, 0x7fffffffL);
+    t_char = maketype("$char", 0L, 255L);
+    t_real = maketype("$real", 8L, 0L);
+    t_nil = maketype("$nil", 0L, 0L);
+    t_addr = insert(identname("$address", true));
+    t_addr->language = primlang;
+    t_addr->level = 0;
+    t_addr->class = TYPE;
+    t_addr->type = newSymbol(nil, 1, PTR, t_int, nil);
+    s = insert(identname("true", true));
+    s->class = CONST;
+    s->type = t_boolean;
+    s->symvalue.constval = build(O_LCON, 1L);
+    s->symvalue.constval->nodetype = t_boolean;
+    s = insert(identname("false", true));
+    s->class = CONST;
+    s->type = t_boolean;
+    s->symvalue.constval = build(O_LCON, 0L);
+    s->symvalue.constval->nodetype = t_boolean;

 }
 }

- *
- */

 
 /*
  * Reduce type to avoid worrying about type names.
 
 /*
  * Reduce type to avoid worrying about type names.


@@ -357,21 +411,114 @@ Symbol type;
 
     t = type;
     if (t != nil) {
 
     t = type;
     if (t != nil) {

-       if (t->class == VAR or t->class == FIELD or t->class == REF ) {
+       if (t->class == VAR or t->class == CONST or
+           t->class == FIELD or t->class == REF
+       ) {

            t = t->type;
        }
            t = t->type;
        }

+       if (t->class == TYPEREF) {
+           resolveRef(t);
+       }

        while (t->class == TYPE or t->class == TAG) {
            t = t->type;
        while (t->class == TYPE or t->class == TAG) {
            t = t->type;

+           if (t->class == TYPEREF) {
+               resolveRef(t);
+           }

        }
     }
     return t;
 }
 
        }
     }
     return t;
 }
 

-public Integer level(s)
+/*
+ * Find the end of a module name.  Return nil if there is none
+ * in the given string.
+ */
+
+private String findModuleMark (s)
+String s;
+{
+    register char *p, *r;
+    register boolean done;
+
+    p = s;
+    done = false;
+    do {
+       if (*p == ':') {
+           done = true;
+           r = p;
+       } else if (*p == '\0') {
+           done = true;
+           r = nil;
+       } else {
+           ++p;
+       }
+    } while (not done);
+    return r;
+}
+
+/*
+ * Resolve a type reference by modifying to be the appropriate type.
+ *
+ * If the reference has a name, then it refers to an opaque type and
+ * the actual type is directly accessible.  Otherwise, we must use
+ * the type reference string, which is of the form "module:{module:}name".
+ */
+
+public resolveRef (t)
+Symbol t;
+{
+    register char *p;
+    char *start;
+    Symbol s, m, outer;
+    Name n;
+
+    if (t->name != nil) {
+       s = t;
+    } else {
+       start = t->symvalue.typeref;
+       outer = program;
+       p = findModuleMark(start);
+       while (p != nil) {
+           *p = '\0';
+           n = identname(start, true);
+           find(m, n) where m->block == outer endfind(m);
+           if (m == nil) {
+               p = nil;
+               outer = nil;
+               s = nil;
+           } else {
+               outer = m;
+               start = p + 1;
+               p = findModuleMark(start);
+           }
+       }
+       if (outer != nil) {
+           n = identname(start, true);
+           find(s, n) where s->block == outer endfind(s);
+       }
+    }
+    if (s != nil and s->type != nil) {
+       t->name = s->type->name;
+       t->class = s->type->class;
+       t->type = s->type->type;
+       t->chain = s->type->chain;
+       t->symvalue = s->type->symvalue;
+       t->block = s->type->block;
+    }
+}
+
+public integer regnum (s)

 Symbol s;
 {
 Symbol s;
 {

+    integer r;
+

     checkref(s);
     checkref(s);

-    return s->level;
+    if (s->level < 0) {
+       r = s->symvalue.offset;
+    } else {
+       r = -1;
+    }
+    return r;

 }
 
 public Symbol container(s)
 }
 
 public Symbol container(s)


@@ -381,6 +528,16 @@ Symbol s;
     return s->block;
 }
 
     return s->block;
 }
 

+public Node constval(s)
+Symbol s;
+{
+    checkref(s);
+    if (s->class != CONST) {
+       error("[internal error: constval(non-CONST)]");
+    }
+    return s->symvalue.constval;
+}
+

 /*
  * Return the object address of the given symbol.
  *
 /*
  * Return the object address of the given symbol.
  *


@@ -392,12 +549,11 @@ Symbol s;
  *     register        - offset is register number
  */
 
  *     register        - offset is register number
  */
 

-#define isglobal(s)            (s->level == 1 or s->level == 2)
-#define islocaloff(s)          (s->level >= 3 and s->symvalue.offset < 0)
-#define isparamoff(s)          (s->level >= 3 and s->symvalue.offset >= 0)
-#define isreg(s)               (s->level < 0)
+#define isglobal(s)            (s->level == 1)
+#define islocaloff(s)          (s->level >= 2 and s->symvalue.offset < 0)
+#define isparamoff(s)          (s->level >= 2 and s->symvalue.offset >= 0)

 
 

-public Address address(s, frame)
+public Address address (s, frame)

 Symbol s;
 Frame frame;
 {
 Symbol s;
 Frame frame;
 {


@@ -418,11 +574,14 @@ Frame frame;
                cur = cur->block;
            }
            if (cur == nil) {
                cur = cur->block;
            }
            if (cur == nil) {

-               cur = whatblock(pc);
-           }
-           frp = findframe(cur);
-           if (frp == nil) {
-               panic("unexpected nil frame for \"%s\"", symname(s));
+               frp = nil;
+           } else {
+               frp = findframe(cur);
+               if (frp == nil) {
+                   error("[internal error: unexpected nil frame for \"%s\"]",
+                       symname(s)
+                   );
+               }

            }
        }
        if (islocaloff(s)) {
            }
        }
        if (islocaloff(s)) {


@@ -442,20 +601,17 @@ Frame frame;
  * Define a symbol used to access register values.
  */
 
  * Define a symbol used to access register values.
  */
 

-public defregname(n, r)
+public defregname (n, r)

 Name n;
 Name n;

-Integer r;
+integer r;

 {
 {

-    register Symbol s, t;
+    Symbol s;

 
     s = insert(n);
 
     s = insert(n);

-    t = newSymbol(nil, 0, PTR, t_int, nil);
-    t->language = findlanguage(".s");
-    s->language = t->language;
+    s->language = t_addr->language;

     s->class = VAR;
     s->level = -3;
     s->class = VAR;
     s->level = -3;

-    s->type = t;
-    s->block = program;
+    s->type = t_addr;

     s->symvalue.offset = r;
 }
 
     s->symvalue.offset = r;
 }
 


@@ -484,10 +640,17 @@ Symbol s;
     if (prev == nil) {
        error("couldn't find link to type reference");
     }
     if (prev == nil) {
        error("couldn't find link to type reference");
     }

-    find(t, prev->name) where
-       t->type != nil and t->class == prev->class and
-       t->type->class != BADUSE and t->block->class == MODULE
-    endfind(t);
+    t = lookup(prev->name);
+    while (t != nil and
+       not (
+           t != prev and t->name == prev->name and
+           t->block->class == MODULE and t->class == prev->class and
+           t->type != nil and t->type->type != nil and
+           t->type->type->class != BADUSE
+       )
+    ) {
+       t = t->next_sym;
+    }

     if (t == nil) {
        error("couldn't resolve reference");
     } else {
     if (t == nil) {
        error("couldn't resolve reference");
     } else {


@@ -510,22 +673,63 @@ Symbol s;
 #define MINSHORT -32768
 #define MAXSHORT 32767
 
 #define MINSHORT -32768
 #define MAXSHORT 32767
 

-public Integer size(sym)
+public findbounds (u, lower, upper)
+Symbol u;
+long *lower, *upper;
+{
+    Rangetype lbt, ubt;
+    long lb, ub;
+
+    if (u->class == RANGE) {
+       lbt = u->symvalue.rangev.lowertype;
+       ubt = u->symvalue.rangev.uppertype;
+       lb = u->symvalue.rangev.lower;
+       ub = u->symvalue.rangev.upper;
+       if (lbt == R_ARG or lbt == R_TEMP) {
+           if (not getbound(u, lb, lbt, lower)) {
+               error("dynamic bounds not currently available");
+           }
+       } else {
+           *lower = lb;
+       }
+       if (ubt == R_ARG or ubt == R_TEMP) {
+           if (not getbound(u, ub, ubt, upper)) {
+               error("dynamic bounds not currently available");
+           }
+       } else {
+           *upper = ub;
+       }
+    } else if (u->class == SCAL) {
+       *lower = 0;
+       *upper = u->symvalue.iconval - 1;
+    } else {
+       error("[internal error: unexpected array bound type]");
+    }
+}
+
+public integer size(sym)

 Symbol sym;
 {
 Symbol sym;
 {

-    register Symbol s, t;
-    register int nel, elsize;
+    register Symbol s, t, u;
+    register integer nel, elsize;

     long lower, upper;
     long lower, upper;

-    int r;
+    integer r, off, len;

 
     t = sym;
     checkref(t);
 
     t = sym;
     checkref(t);

+    if (t->class == TYPEREF) {
+       resolveRef(t);
+    }

     switch (t->class) {
        case RANGE:
            lower = t->symvalue.rangev.lower;
            upper = t->symvalue.rangev.upper;
     switch (t->class) {
        case RANGE:
            lower = t->symvalue.rangev.lower;
            upper = t->symvalue.rangev.upper;

-           if (upper == 0 and lower > 0) {             /* real */
+           if (upper == 0 and lower > 0) {
+               /* real */

                r = lower;
                r = lower;

+           } else if (lower > upper) {
+               /* unsigned long */
+               r = sizeof(long);

            } else if (
                (lower >= MINCHAR and upper <= MAXCHAR) or
                (lower >= 0 and upper <= MAXUCHAR)
            } else if (
                (lower >= MINCHAR and upper <= MAXCHAR) or
                (lower >= 0 and upper <= MAXUCHAR)


@@ -545,32 +749,23 @@ Symbol sym;
            elsize = size(t->type);
            nel = 1;
            for (t = t->chain; t != nil; t = t->chain) {
            elsize = size(t->type);
            nel = 1;
            for (t = t->chain; t != nil; t = t->chain) {

-               if (t->symvalue.rangev.lowertype == R_ARG or
-                 t->symvalue.rangev.lowertype == R_TEMP)  {
-                   if (not getbound(t, t->symvalue.rangev.lower,
-                     t->symvalue.rangev.lowertype, &lower)) {
-                       error("dynamic bounds not currently available");
-                   }
-               } else {
-                   lower = t->symvalue.rangev.lower;
-               }
-               if (t->symvalue.rangev.uppertype == R_ARG or
-                 t->symvalue.rangev.uppertype == R_TEMP) {
-                   if (not getbound(t, t->symvalue.rangev.upper,
-                     t->symvalue.rangev.uppertype, &upper)) {
-                       error("dynamic bounds nor currently available");
-                   }
-               } else {
-                   upper = t->symvalue.rangev.upper;
-               }
+               u = rtype(t);
+               findbounds(u, &lower, &upper);

                nel *= (upper-lower+1);
            }
            r = nel*elsize;
            break;
 
                nel *= (upper-lower+1);
            }
            r = nel*elsize;
            break;
 

+       case DYNARRAY:
+           r = (t->symvalue.ndims + 1) * sizeof(Word);
+           break;
+
+       case SUBARRAY:
+           r = (2 * t->symvalue.ndims + 1) * sizeof(Word);
+           break;
+

        case REF:
        case VAR:
        case REF:
        case VAR:

-       case FVAR:

            r = size(t->type);
            /*
             *
            r = size(t->type);
            /*
             *


@@ -580,7 +775,9 @@ Symbol sym;
            */
            break;
 
            */
            break;
 

+       case FVAR:

        case CONST:
        case CONST:

+       case TAG:

            r = size(t->type);
            break;
 
            r = size(t->type);
            break;
 


@@ -591,12 +788,10 @@ Symbol sym;
            r = size(t->type);
            break;
 
            r = size(t->type);
            break;
 

-       case TAG:
-           r = size(t->type);
-           break;
-

        case FIELD:
        case FIELD:

-           r = (t->symvalue.field.length + 7) div 8;
+           off = t->symvalue.field.offset;
+           len = t->symvalue.field.length;
+           r = (off + len + 7) div 8 - (off div 8);

            break;
 
        case RECORD:
            break;
 
        case RECORD:


@@ -608,6 +803,7 @@ Symbol sym;
            break;
 
        case PTR:
            break;
 
        case PTR:

+       case TYPEREF:

        case FILET:
            r = sizeof(Word);
            break;
        case FILET:
            r = sizeof(Word);
            break;


@@ -637,13 +833,67 @@ Symbol sym;
            r = sizeof(Symbol);
            break;
 
            r = sizeof(Symbol);
            break;
 

+       case SET:
+           u = rtype(t->type);
+           switch (u->class) {
+               case RANGE:
+                   r = u->symvalue.rangev.upper - u->symvalue.rangev.lower + 1;
+                   break;
+
+               case SCAL:
+                   r = u->symvalue.iconval;
+                   break;
+
+               default:
+                   error("expected range for set base type");
+                   break;
+           }
+           r = (r + BITSPERBYTE - 1) div BITSPERBYTE;
+           break;
+
+       /*
+        * These can happen in C (unfortunately) for unresolved type references
+        * Assume they are pointers.
+        */
+       case BADUSE:
+           r = sizeof(Address);
+           break;
+

        default:
            if (ord(t->class) > ord(TYPEREF)) {
                panic("size: bad class (%d)", ord(t->class));
            } else {
        default:
            if (ord(t->class) > ord(TYPEREF)) {
                panic("size: bad class (%d)", ord(t->class));
            } else {

-               error("improper operation on a %s", classname(t));
+               fprintf(stderr, "can't compute size of a %s\n", classname(t));

            }
            }

-           /* NOTREACHED */
+           r = 0;
+           break;
+    }
+    return r;
+}
+
+/*
+ * Return the size associated with a symbol that takes into account
+ * reference parameters.  This might be better as the normal size function, but
+ * too many places already depend on it working the way it does.
+ */
+
+public integer psize (s)
+Symbol s;
+{
+    integer r;
+    Symbol t;
+
+    if (s->class == REF) {
+       t = rtype(s->type);
+       if (t->class == DYNARRAY) {
+           r = (t->symvalue.ndims + 1) * sizeof(Word);
+       } else if (t->class == SUBARRAY) {
+           r = (2 * t->symvalue.ndims + 1) * sizeof(Word);
+       } else {
+           r = sizeof(Word);
+       }
+    } else {
+       r = size(s);

     }
     return r;
 }
     }
     return r;
 }


@@ -665,6 +915,19 @@ Symbol s;
     return (Boolean) (t != nil);
 }
 
     return (Boolean) (t != nil);
 }
 

+/*
+ * Test if a type is an open array parameter type.
+ */
+
+public boolean isopenarray (type)
+Symbol type;
+{
+    Symbol t;
+
+    t = rtype(type);
+    return (boolean) (t->class == DYNARRAY);
+}
+

 /*
  * Test if a symbol is a var parameter, i.e. has class REF.
  */
 /*
  * Test if a symbol is a var parameter, i.e. has class REF.
  */


@@ -681,27 +944,20 @@ Symbol s;
  */
 
 public Boolean isvariable(s)
  */
 
 public Boolean isvariable(s)

-register Symbol s;
+Symbol s;

 {
     return (Boolean) (s->class == VAR or s->class == FVAR or s->class == REF);
 }
 
 /*
 {
     return (Boolean) (s->class == VAR or s->class == FVAR or s->class == REF);
 }
 
 /*

- * Test if a symbol is a block, e.g. function, procedure, or the
- * main program.
- *
- * This function is now expanded inline for efficiency.
- *
- * public Boolean isblock(s)
-register Symbol s;
+ * Test if a symbol is a constant.
+ */
+
+public Boolean isconst(s)
+Symbol s;

 {
 {

-    return (Boolean) (
-       s->class == FUNC or s->class == PROC or
-       s->class == MODULE or s->class == PROG
-    );
+    return (Boolean) (s->class == CONST);

 }
 }

- *
- */

 
 /*
  * Test if a symbol is a module.
 
 /*
  * Test if a symbol is a module.


@@ -714,14 +970,64 @@ register Symbol s;
 }
 
 /*
 }
 
 /*

- * Test if a symbol is builtin, that is, a predefined type or
- * reserved word.
+ * Mark a procedure or function as internal, meaning that it is called
+ * with a different calling sequence.

  */
 
  */
 

-public Boolean isbuiltin(s)
+public markInternal (s)
+Symbol s;
+{
+    s->symvalue.funcv.intern = true;
+}
+
+public boolean isinternal (s)
+Symbol s;
+{
+    return s->symvalue.funcv.intern;
+}
+
+/*
+ * Decide if a field begins or ends on a bit rather than byte boundary.
+ */
+
+public Boolean isbitfield(s)

 register Symbol s;
 {
 register Symbol s;
 {

-    return (Boolean) (s->level == 0 and s->class != PROG and s->class != VAR);
+    boolean b;
+    register integer off, len;
+    register Symbol t;
+
+    off = s->symvalue.field.offset;
+    len = s->symvalue.field.length;
+    if ((off mod BITSPERBYTE) != 0 or (len mod BITSPERBYTE) != 0) {
+       b = true;
+    } else {
+       t = rtype(s->type);
+       b = (Boolean) (
+           (t->class == SCAL and len != (sizeof(int)*BITSPERBYTE)) or
+           len != (size(t)*BITSPERBYTE)
+       );
+    }
+    return b;
+}
+
+private boolean primlang_typematch (t1, t2)
+Symbol t1, t2;
+{
+    return (boolean) (
+       (t1 == t2) or
+       (
+           t1->class == RANGE and t2->class == RANGE and
+           t1->symvalue.rangev.lower == t2->symvalue.rangev.lower and
+           t1->symvalue.rangev.upper == t2->symvalue.rangev.upper
+       ) or (
+           t1->class == PTR and t2->class == RANGE and
+           t2->symvalue.rangev.upper >= t2->symvalue.rangev.lower
+       ) or (
+           t2->class == PTR and t1->class == RANGE and
+           t1->symvalue.rangev.upper >= t1->symvalue.rangev.lower
+       )
+    );

 }
 
 /*
 }
 
 /*


@@ -735,6 +1041,7 @@ public Boolean compatible(t1, t2)
 register Symbol t1, t2;
 {
     Boolean b;
 register Symbol t1, t2;
 {
     Boolean b;

+    Symbol rt1, rt2;

 
     if (t1 == t2) {
        b = true;
 
     if (t1 == t2) {
        b = true;


@@ -744,15 +1051,22 @@ register Symbol t1, t2;
        b = isblock(t2);
     } else if (t2 == procsym) {
        b = isblock(t1);
        b = isblock(t2);
     } else if (t2 == procsym) {
        b = isblock(t1);

+    } else if (t1->language == primlang) {
+       if (t2->language == primlang) {
+           b = primlang_typematch(rtype(t1), rtype(t2));
+       } else {
+           b = (boolean) (*language_op(t2->language, L_TYPEMATCH))(t1, t2);
+       }
+    } else if (t2->language == primlang) {
+       b = (boolean) (*language_op(t1->language, L_TYPEMATCH))(t1, t2);

     } else if (t1->language == nil) {
     } else if (t1->language == nil) {

-       b = (Boolean) (t2->language == nil or
-           (*language_op(t2->language, L_TYPEMATCH))(t1, t2));
-    } else if (t2->language == nil) {
-       b = (Boolean) (*language_op(t1->language, L_TYPEMATCH))(t1, t2);
-    } else if ( isbuiltin(t1) or isbuiltin(t1->type) ) {
-       b = (Boolean) (*language_op(t2->language, L_TYPEMATCH))(t1, t2);
+       if (t2->language == nil) {
+           b = false;
+       } else {
+           b = (boolean) (*language_op(t2->language, L_TYPEMATCH))(t1, t2);
+       }

     } else {
     } else {

-       b = (Boolean) (*language_op(t1->language, L_TYPEMATCH))(t1, t2);
+       b = (boolean) (*language_op(t1->language, L_TYPEMATCH))(t1, t2);

     }
     return b;
 }
     }
     return b;
 }


@@ -765,14 +1079,40 @@ public Boolean istypename(type, name)
 Symbol type;
 String name;
 {
 Symbol type;
 String name;
 {

-    Symbol t;
+    register Symbol t;

     Boolean b;
 
     t = type;
     Boolean b;
 
     t = type;

-    checkref(t);
-    b = (Boolean) (
-       t->class == TYPE and t->name == identname(name, true)
-    );
+    if (t == nil) {
+       b = false;
+    } else {
+       b = (Boolean) (
+           t->class == TYPE and streq(ident(t->name), name)
+       );
+    }
+    return b;
+}
+
+/*
+ * Determine if a (value) parameter should actually be passed by address.
+ */
+
+public boolean passaddr (p, exprtype)
+Symbol p, exprtype;
+{
+    boolean b;
+    Language def;
+
+    if (p == nil) {
+       def = findlanguage(".c");
+       b = (boolean) (*language_op(def, L_PASSADDR))(p, exprtype);
+    } else if (p->language == nil or p->language == primlang) {
+       b = false;
+    } else if (isopenarray(p->type)) {
+       b = true;
+    } else {
+       b = (boolean) (*language_op(p->language, L_PASSADDR))(p, exprtype);
+    }

     return b;
 }
 
     return b;
 }
 


@@ -794,15 +1134,15 @@ typedef char *Arglist;
 #define nextarg(type)  ((type *) (ap += sizeof(type)))[-1]
 
 private Symbol mkstring();
 #define nextarg(type)  ((type *) (ap += sizeof(type)))[-1]
 
 private Symbol mkstring();

-private Symbol namenode();

 
 /*
  * Determine the type of a parse tree.
 
 /*
  * Determine the type of a parse tree.

+ *

  * Also make some symbol-dependent changes to the tree such as
  * Also make some symbol-dependent changes to the tree such as

- * changing removing RVAL nodes for constant symbols.
+ * removing indirection for constant or register symbols.

  */
 
  */
 

-public assigntypes(p)
+public assigntypes (p)

 register Node p;
 {
     register Node p1;
 register Node p;
 {
     register Node p1;


@@ -810,30 +1150,35 @@ register Node p;
 
     switch (p->op) {
        case O_SYM:
 
     switch (p->op) {
        case O_SYM:

-           p->nodetype = namenode(p);
+           p->nodetype = p->value.sym;

            break;
 
        case O_LCON:
            p->nodetype = t_int;
            break;
 
            break;
 
        case O_LCON:
            p->nodetype = t_int;
            break;
 

+       case O_CCON:
+           p->nodetype = t_char;
+           break;
+

        case O_FCON:
            p->nodetype = t_real;
            break;
 
        case O_SCON:
        case O_FCON:
            p->nodetype = t_real;
            break;
 
        case O_SCON:

-           p->value.scon = strdup(p->value.scon);
-           s = mkstring(p->value.scon);
-           if (s == t_char) {
-               p->op = O_LCON;
-               p->value.lcon = p->value.scon[0];
-           }
-           p->nodetype = s;
+           p->nodetype = mkstring(p->value.scon);

            break;
 
        case O_INDIR:
            p1 = p->value.arg[0];
            break;
 
        case O_INDIR:
            p1 = p->value.arg[0];

-           chkclass(p1, PTR);
+           s = rtype(p1->nodetype);
+           if (s->class != PTR) {
+               beginerrmsg();
+               fprintf(stderr, "\"");
+               prtree(stderr, p1);
+               fprintf(stderr, "\" is not a pointer");
+               enderrmsg();
+           }

            p->nodetype = rtype(p1->nodetype)->type;
            break;
 
            p->nodetype = rtype(p1->nodetype)->type;
            break;
 


@@ -845,21 +1190,16 @@ register Node p;
            p1 = p->value.arg[0];
            p->nodetype = p1->nodetype;
            if (p1->op == O_SYM) {
            p1 = p->value.arg[0];
            p->nodetype = p1->nodetype;
            if (p1->op == O_SYM) {

-               if (p1->nodetype->class == FUNC) {
-                   p->op = O_CALL;
-                   p->value.arg[1] = nil;
+               if (p1->nodetype->class == PROC or p->nodetype->class == FUNC) {
+                   p->op = p1->op;
+                   p->value.sym = p1->value.sym;
+                   p->nodetype = p1->nodetype;
+                   dispose(p1);

                } else if (p1->value.sym->class == CONST) {
                } else if (p1->value.sym->class == CONST) {

-                   if (compatible(p1->value.sym->type, t_real)) {
-                       p->op = O_FCON;
-                       p->value.fcon = p1->value.sym->symvalue.fconval;
-                       p->nodetype = t_real;
-                       dispose(p1);
-                   } else {
-                       p->op = O_LCON;
-                       p->value.lcon = p1->value.sym->symvalue.iconval;
-                       p->nodetype = p1->value.sym->type;
-                       dispose(p1);
-                   }
+                   p->op = p1->op;
+                   p->value = p1->value;
+                   p->nodetype = p1->nodetype;
+                   dispose(p1);

                } else if (isreg(p1->value.sym)) {
                    p->op = O_SYM;
                    p->value.sym = p1->value.sym;
                } else if (isreg(p1->value.sym)) {
                    p->op = O_SYM;
                    p->value.sym = p1->value.sym;


@@ -876,6 +1216,11 @@ register Node p;
            }
            break;
 
            }
            break;
 

+       case O_COMMA:
+           p->nodetype = p->value.arg[0]->nodetype;
+           break;
+
+       case O_CALLPROC:

        case O_CALL:
            p1 = p->value.arg[0];
            p->nodetype = rtype(p1->nodetype)->type;
        case O_CALL:
            p1 = p->value.arg[0];
            p->nodetype = rtype(p1->nodetype)->type;


@@ -894,8 +1239,9 @@ register Node p;
            if (not compatible(s, t_int)) {
                if (not compatible(s, t_real)) {
                    beginerrmsg();
            if (not compatible(s, t_int)) {
                if (not compatible(s, t_real)) {
                    beginerrmsg();

+                   fprintf(stderr, "\"");

                    prtree(stderr, p->value.arg[0]);
                    prtree(stderr, p->value.arg[0]);

-                   fprintf(stderr, "is improper type");
+                   fprintf(stderr, "\" is improper type");

                    enderrmsg();
                } else {
                    p->op = O_NEGF;
                    enderrmsg();
                } else {
                    p->op = O_NEGF;


@@ -907,46 +1253,17 @@ register Node p;
        case O_ADD:
        case O_SUB:
        case O_MUL:
        case O_ADD:
        case O_SUB:
        case O_MUL:

+           binaryop(p, nil);
+           break;
+

        case O_LT:
        case O_LE:
        case O_GT:
        case O_GE:
        case O_EQ:
        case O_NE:
        case O_LT:
        case O_LE:
        case O_GT:
        case O_GE:
        case O_EQ:
        case O_NE:

-       {
-           Boolean t1real, t2real;
-           Symbol t1, t2;
-
-           t1 = rtype(p->value.arg[0]->nodetype);
-           t2 = rtype(p->value.arg[1]->nodetype);
-           t1real = compatible(t1, t_real);
-           t2real = compatible(t2, t_real);
-           if (t1real or t2real) {
-               p->op = (Operator) (ord(p->op) + 1);
-               if (not t1real) {
-                   p->value.arg[0] = build(O_ITOF, p->value.arg[0]);
-               } else if (not t2real) {
-                   p->value.arg[1] = build(O_ITOF, p->value.arg[1]);
-               }
-           } else {
-               if (t1real) {
-                   convert(&(p->value.arg[0]), t_int, O_NOP);
-               }
-               if (t2real) {
-                   convert(&(p->value.arg[1]), t_int, O_NOP);
-               }
-           }
-           if (ord(p->op) >= ord(O_LT)) {
-               p->nodetype = t_boolean;
-           } else {
-               if (t1real or t2real) {
-                   p->nodetype = t_real;
-               } else {
-                   p->nodetype = t_int;
-               }
-           }
+           binaryop(p, t_boolean);

            break;
            break;

-       }

 
        case O_DIVF:
            convert(&(p->value.arg[0]), t_real, O_ITOF);
 
        case O_DIVF:
            convert(&(p->value.arg[0]), t_real, O_ITOF);


@@ -979,37 +1296,51 @@ register Node p;
 }
 
 /*
 }
 
 /*

- * Create a node for a name.  The symbol for the name has already
- * been chosen, either implicitly with "which" or explicitly from
- * the dot routine.
+ * Process a binary arithmetic or relational operator.
+ * Convert from integer to real if necessary.

  */
 
  */
 

-private Symbol namenode(p)
+private binaryop (p, t)

 Node p;
 Node p;

+Symbol t;

 {
 {

-    register Symbol r, s;
-    register Node np;
-
-    s = p->value.sym;
-    if (s->class == REF) {
-       np = new(Node);
-       np->op = p->op;
-       np->nodetype = s;
-       np->value.sym = s;
-       p->op = O_INDIR;
-       p->value.arg[0] = np;
-    }
-/*
- * Old way
- *
-    if (s->class == CONST or s->class == VAR or s->class == FVAR) {
-       r = s->type;
+    Node p1, p2;
+    Boolean t1real, t2real;
+    Symbol t1, t2;
+
+    p1 = p->value.arg[0];
+    p2 = p->value.arg[1];
+    t1 = rtype(p1->nodetype);
+    t2 = rtype(p2->nodetype);
+    t1real = compatible(t1, t_real);
+    t2real = compatible(t2, t_real);
+    if (t1real or t2real) {
+       p->op = (Operator) (ord(p->op) + 1);
+       if (not t1real) {
+           p->value.arg[0] = build(O_ITOF, p1);
+       } else if (not t2real) {
+           p->value.arg[1] = build(O_ITOF, p2);
+       }
+       p->nodetype = t_real;

     } else {
     } else {

-       r = s;
+       if (size(p1->nodetype) > sizeof(integer)) {
+           beginerrmsg();
+           fprintf(stderr, "operation not defined on \"");
+           prtree(stderr, p1);
+           fprintf(stderr, "\"");
+           enderrmsg();
+       } else if (size(p2->nodetype) > sizeof(integer)) {
+           beginerrmsg();
+           fprintf(stderr, "operation not defined on \"");
+           prtree(stderr, p2);
+           fprintf(stderr, "\"");
+           enderrmsg();
+       }
+       p->nodetype = t_int;
+    }
+    if (t != nil) {
+       p->nodetype = t;

     }
     }

- *
- */
-    return s;

 }
 
 /*
 }
 
 /*


@@ -1024,24 +1355,24 @@ Node *tp;
 Symbol typeto;
 Operator op;
 {
 Symbol typeto;
 Operator op;
 {

-#define tree    (*tp)
-
-    Symbol s;
+    Node tree;
+    Symbol s, t;

 
 

+    tree = *tp;

     s = rtype(tree->nodetype);
     s = rtype(tree->nodetype);

-    typeto = rtype(typeto);
-    if (compatible(typeto, t_real) and compatible(s, t_int)) {
+    t = rtype(typeto);
+    if (compatible(t, t_real) and compatible(s, t_int)) {

        tree = build(op, tree);
        tree = build(op, tree);

-    } else if (not compatible(s, typeto)) {
+    } else if (not compatible(s, t)) {

        beginerrmsg();
        beginerrmsg();

-       prtree(stderr, s);
-       fprintf(stderr, " is improper type");
+       fprintf(stderr, "expected integer or real, found \"");
+       prtree(stderr, tree);
+       fprintf(stderr, "\"");

        enderrmsg();
        enderrmsg();

-    } else if (op != O_NOP and s != typeto) {
+    } else if (op != O_NOP and s != t) {

        tree = build(op, tree);
     }
        tree = build(op, tree);
     }

-
-#undef tree
+    *tp = tree;

 }
 
 /*
 }
 
 /*


@@ -1057,26 +1388,27 @@ public Node dot(record, fieldname)
 Node record;
 Name fieldname;
 {
 Node record;
 Name fieldname;
 {

-    register Node p;
+    register Node rec, p;

     register Symbol s, t;
 
     register Symbol s, t;
 

-    if (isblock(record->nodetype)) {
+    rec = record;
+    if (isblock(rec->nodetype)) {

        find(s, fieldname) where
        find(s, fieldname) where

-           s->block == record->nodetype and
-           s->class != FIELD and s->class != TAG
+           s->block == rec->nodetype and
+           s->class != FIELD

        endfind(s);
        if (s == nil) {
            beginerrmsg();
            fprintf(stderr, "\"%s\" is not defined in ", ident(fieldname));
        endfind(s);
        if (s == nil) {
            beginerrmsg();
            fprintf(stderr, "\"%s\" is not defined in ", ident(fieldname));

-           printname(stderr, record->nodetype);
+           printname(stderr, rec->nodetype);

            enderrmsg();
        }
        p = new(Node);
        p->op = O_SYM;
        p->value.sym = s;
            enderrmsg();
        }
        p = new(Node);
        p->op = O_SYM;
        p->value.sym = s;

-       p->nodetype = namenode(p);
+       p->nodetype = s;

     } else {
     } else {

-       p = record;
+       p = rec;

        t = rtype(p->nodetype);
        if (t->class == PTR) {
            s = findfield(fieldname, t->type);
        t = rtype(p->nodetype);
        if (t->class == PTR) {
            s = findfield(fieldname, t->type);


@@ -1086,15 +1418,16 @@ Name fieldname;
        if (s == nil) {
            beginerrmsg();
            fprintf(stderr, "\"%s\" is not a field in ", ident(fieldname));
        if (s == nil) {
            beginerrmsg();
            fprintf(stderr, "\"%s\" is not a field in ", ident(fieldname));

-           prtree(stderr, record);
+           prtree(stderr, rec);

            enderrmsg();
        }
            enderrmsg();
        }

-       if (t->class == PTR and not isreg(record->nodetype)) {
-           p = build(O_INDIR, record);
+       if (t->class != PTR or isreg(rec->nodetype)) {
+           p = unrval(p);

        }
        }

+       p->nodetype = t_addr;

        p = build(O_DOT, p, build(O_SYM, s));
     }
        p = build(O_DOT, p, build(O_SYM, s));
     }

-    return p;
+    return build(O_RVAL, p);

 }
 
 /*
 }
 
 /*


@@ -1105,38 +1438,37 @@ Name fieldname;
 public Node subscript(a, slist)
 Node a, slist;
 {
 public Node subscript(a, slist)
 Node a, slist;
 {

-Symbol t;
+    Symbol t;
+    Node p;

 
 

-   t = rtype(a->nodetype);
-   if(t->language == nil) {
-       error("unknown language");
-   }
-   else {
-        return ( (Node)
-        (*language_op(t->language, L_BUILDAREF)) (a,slist)
-               );
-   }
+    t = rtype(a->nodetype);
+    if (t->language == nil or t->language == primlang) {
+       p = (Node) (*language_op(findlanguage(".s"), L_BUILDAREF))(a, slist);
+    } else {
+       p = (Node) (*language_op(t->language, L_BUILDAREF))(a, slist);
+    }
+    return build(O_RVAL, p);

 }
 
 /*
  * Evaluate a subscript index.
  */
 
 }
 
 /*
  * Evaluate a subscript index.
  */
 

-public int evalindex(s, i)
+public int evalindex(s, base, i)

 Symbol s;
 Symbol s;

+Address base;

 long i;
 {
 long i;
 {

-Symbol t;
+    Symbol t;
+    int r;

 
 

-   t = rtype(s);
-   if(t->language == nil) {
-       error("unknown language");
-   }
-   else {
-        return (
-             (*language_op(t->language, L_EVALAREF)) (s,i)
-               );
-   }
+    t = rtype(s);
+    if (t->language == nil or t->language == primlang) {
+       r = ((*language_op(findlanguage(".s"), L_EVALAREF)) (s, base, i));
+    } else {
+       r = ((*language_op(t->language, L_EVALAREF)) (s, base, i));
+    }
+    return r;

 }
 
 /*
 }
 
 /*


@@ -1156,53 +1488,19 @@ register Node p;
 }
 
 /*
 }
 
 /*

- * Check to make sure the given tree has a type of the given class.
- */
-
-private chkclass(p, class)
-Node p;
-Symclass class;
-{
-    struct Symbol tmpsym;
-
-    tmpsym.class = class;
-    if (rtype(p->nodetype)->class != class) {
-       beginerrmsg();
-       fprintf(stderr, "\"");
-       prtree(stderr, p);
-       fprintf(stderr, "\" is not a %s", classname(&tmpsym));
-       enderrmsg();
-    }
-}
-
-/*
- * Construct a node for the type of a string.  While we're at it,
- * scan the string for '' that collapse to ', and chop off the ends.
+ * Construct a node for the type of a string.

  */
 
 private Symbol mkstring(str)
 String str;
 {
  */
 
 private Symbol mkstring(str)
 String str;
 {

-    register char *p, *q;

     register Symbol s;
 
     register Symbol s;
 

-    p = str;
-    q = str;
-    while (*p != '\0') {
-       if (*p == '\\') {
-           ++p;
-       }
-       *q = *p;
-       ++p;
-       ++q;
-    }
-    *q = '\0';

     s = newSymbol(nil, 0, ARRAY, t_char, nil);
     s = newSymbol(nil, 0, ARRAY, t_char, nil);

-    s->language = findlanguage(".s");

     s->chain = newSymbol(nil, 0, RANGE, t_int, nil);
     s->chain->language = s->language;
     s->chain->symvalue.rangev.lower = 1;
     s->chain = newSymbol(nil, 0, RANGE, t_int, nil);
     s->chain->language = s->language;
     s->chain->symvalue.rangev.lower = 1;

-    s->chain->symvalue.rangev.upper = p - str + 1;
+    s->chain->symvalue.rangev.upper = strlen(str) + 1;

     return s;
 }
 
     return s;
 }
 


@@ -1217,59 +1515,121 @@ Symbol s;
 }
 
 /*
 }
 
 /*

- * Figure out the "current" variable or function being referred to,
- * this is either the active one or the most visible from the
- * current scope.
+ * Figure out the "current" variable or function being referred to
+ * by the name n.

  */
 
  */
 

-public Symbol which(n)
+private boolean stwhich(), dynwhich();
+
+public Symbol which (n)

 Name n;
 {
 Name n;
 {

-    register Symbol s, p, t, f;
+    Symbol s;

 
 

-    find(s, n) where s->class != FIELD and s->class != TAG endfind(s);
-    if (s == nil) {
-       s = lookup(n);
-    }
+    s = lookup(n);

     if (s == nil) {
        error("\"%s\" is not defined", ident(n));
     if (s == nil) {
        error("\"%s\" is not defined", ident(n));

-    } else if (s == program or isbuiltin(s)) {
-       t = s;
-    } else {
-    /*
-     * Old way
-     *
-       if (not isactive(program)) {
-           f = program;
-       } else {
-           f = whatblock(pc);
-           if (f == nil) {
-               panic("no block for addr 0x%x", pc);
+    } else if (not stwhich(&s) and isambiguous(s) and not dynwhich(&s)) {
+       printf("[using ");
+       printname(stdout, s);
+       printf("]\n");
+    }
+    return s;
+}
+
+/*
+ * Static search.
+ */
+
+private boolean stwhich (var_s)
+Symbol *var_s;
+{
+    Name n;            /* name of desired symbol */
+    Symbol s;          /* iteration variable for symbols with name n */
+    Symbol f;          /* iteration variable for blocks containing s */
+    integer count;     /* number of levels from s->block to curfunc */
+    Symbol t;          /* current best answer for stwhich(n) */
+    integer mincount;  /* relative level for current best answer (t) */
+    boolean b;         /* return value, true if symbol found */
+
+    s = *var_s;
+    n = s->name;
+    t = s;
+    mincount = 10000; /* force first match to set mincount */
+    do {
+       if (s->name == n and s->class != FIELD and s->class != TAG) {
+           f = curfunc;
+           count = 0;
+           while (f != nil and f != s->block) {
+               ++count;
+               f = f->block;
+           }
+           if (f != nil and count < mincount) {
+               t = s;
+               mincount = count;
+               b = true;

            }
        }
            }
        }

-     *
-     * Now start with curfunc.
-     */
-       p = curfunc;
-       do {
-           find(t, n) where
-               t->block == p and t->class != FIELD and t->class != TAG
-           endfind(t);
-           p = p->block;
-       } while (t == nil and p != nil);
-       if (t == nil) {
-           t = s;
+       s = s->next_sym;
+    } while (s != nil);
+    if (mincount != 10000) {
+       *var_s = t;
+       b = true;
+    } else {
+       b = false;
+    }
+    return b;
+}
+
+/*
+ * Dynamic search.
+ */
+
+private boolean dynwhich (var_s)
+Symbol *var_s;
+{
+    Name n;            /* name of desired symbol */
+    Symbol s;          /* iteration variable for possible symbols */
+    Symbol f;          /* iteration variable for active functions */
+    Frame frp;         /* frame associated with stack walk */
+    boolean b;         /* return value */
+
+    f = curfunc;
+    frp = curfuncframe();
+    n = (*var_s)->name;
+    b = false;
+    if (frp != nil) {
+       frp = nextfunc(frp, &f);
+       while (frp != nil) {
+           s = *var_s;
+           while (s != nil and
+               (
+                   s->name != n or s->block != f or
+                   s->class == FIELD or s->class == TAG
+               )
+           ) {
+               s = s->next_sym;
+           }
+           if (s != nil) {
+               *var_s = s;
+               b = true;
+               break;
+           }
+           if (f == program) {
+               break;
+           }
+           frp = nextfunc(frp, &f);

        }
     }
        }
     }

-    return t;
+    return b;

 }
 
 /*
 }
 
 /*

- * Find the symbol which is has the same name and scope as the
+ * Find the symbol that has the same name and scope as the

  * given symbol but is of the given field.  Return nil if there is none.
  */
 
  * given symbol but is of the given field.  Return nil if there is none.
  */
 

-public Symbol findfield(fieldname, record)
+public Symbol findfield (fieldname, record)

 Name fieldname;
 Symbol record;
 {
 Name fieldname;
 Symbol record;
 {