cleanup, add manual pages

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

diff --git a/usr/src/old/dbx/symbols.c b/usr/src/old/dbx/symbols.c
index 36f0fb5..2f68dda 100644 (file)
--- a/usr/src/old/dbx/symbols.c
+++ b/usr/src/old/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.
+ */

 
 

-static char sccsid[] = "@(#)symbols.c  1.15 (Berkeley) %G%";
+#ifndef lint
+static char sccsid[] = "@(#)symbols.c  5.5 (Berkeley) %G%";
+#endif not lint
+
+static char rcsid[] = "$Header: symbols.c,v 1.4 88/04/02 01:29:03 donn Exp $";

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


@@ -26,13 +34,15 @@ 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, OPENARRAY, DYNARRAY, SUBARRAY,
+    PTRFILE, RECORD, FIELD,

     PROC, FUNC, FVAR, REF, PTR, FILET, SET, RANGE, 
     LABEL, WITHPTR, SCAL, STR, PROG, IMPROPER, VARNT,
     FPROC, FFUNC, MODULE, TAG, COMMON, EXTREF, TYPEREF
     PROC, FUNC, FVAR, REF, PTR, FILET, SET, RANGE, 
     LABEL, WITHPTR, SCAL, STR, PROG, IMPROPER, VARNT,
     FPROC, FFUNC, MODULE, TAG, COMMON, EXTREF, TYPEREF


@@ -40,17 +50,26 @@ typedef enum {
 
 typedef enum { R_CONST, R_TEMP, R_ARG, R_ADJUST } Rangetype; 
 
 
 typedef enum { R_CONST, R_TEMP, R_ARG, R_ADJUST } Rangetype; 
 

+#define INREG 0
+#define STK 1
+#define EXT 2
+
+typedef unsigned integer Storage;
+

 struct Symbol {
     Name name;
     Language language;
     Symclass class : 8;
 struct Symbol {
     Name name;
     Language language;
     Symclass class : 8;

-    Integer level : 8;
+    Storage storage : 2;
+    unsigned int level : 6;    /* for variables stored on stack only */

     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;


@@ -94,11 +113,13 @@ Symbol t_char;
 Symbol t_int;
 Symbol t_real;
 Symbol t_nil;
 Symbol t_int;
 Symbol t_real;
 Symbol t_nil;

-Symbol t_open;
+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) ( \
 #define symname(s) ident(s->name)
 #define codeloc(f) ((f)->symvalue.funcv.beginaddr)
 #define isblock(s) (Boolean) ( \


@@ -108,11 +129,12 @@ Symbol curfunc;
 #define isroutine(s) (Boolean) ( \
     s->class == FUNC or s->class == PROC \
 )
 #define isroutine(s) (Boolean) ( \
     s->class == FUNC or s->class == PROC \
 )

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

 
 #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->storage == INREG)
+

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


@@ -135,19 +157,21 @@ Symbol curfunc;
 
 /*
  * Symbol table structure currently does not support deletions.
 
 /*
  * Symbol table structure currently does not support deletions.

+ * Hash table size is a power of two to make hashing faster.
+ * Using a non-prime is ok since we aren't doing rehashing.

  */
 
  */
 

-#define HASHTABLESIZE 2003
+#define HASHTABLESIZE 8192

 
 private Symbol hashtab[HASHTABLESIZE];
 
 
 private Symbol hashtab[HASHTABLESIZE];
 

-#define hash(name) ((((unsigned) name) >> 2) mod HASHTABLESIZE)
+#define hash(name) ((((unsigned) name) >> 2) & (HASHTABLESIZE - 1))

 
 /*
  * Allocate a new symbol.
  */
 
 
 /*
  * Allocate a new symbol.
  */
 

-#define SYMBLOCKSIZE 100
+#define SYMBLOCKSIZE 1000

 
 typedef struct Sympool {
     struct Symbol sym[SYMBLOCKSIZE];
 
 typedef struct Sympool {
     struct Symbol sym[SYMBLOCKSIZE];


@@ -163,7 +187,7 @@ public Symbol symbol_alloc()
 
     if (nleft <= 0) {
        newpool = new(Sympool);
 
     if (nleft <= 0) {
        newpool = new(Sympool);

-       bzero(newpool, sizeof(newpool));
+       bzero(newpool, sizeof(*newpool));

        newpool->prevpool = sympool;
        sympool = newpool;
        nleft = SYMBLOCKSIZE;
        newpool->prevpool = sympool;
        sympool = newpool;
        nleft = SYMBLOCKSIZE;


@@ -172,23 +196,26 @@ public Symbol symbol_alloc()
     return &(sympool->sym[nleft]);
 }
 
     return &(sympool->sym[nleft]);
 }
 

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

 Symbol func;
 {
 Symbol func;
 {

-  register Symbol s;
-  register Integer i;
+    register Symbol s;
+    register integer i;

 
 

-       printf(" symbols in %s \n",symname(func));
-       for(i=0; i< HASHTABLESIZE; i++)
-          for(s=hashtab[i]; s != nil; s=s->next_sym)  {
-               if (s->block == func) psym(s);
-               }
+    printf(" symbols in %s \n",symname(func));
+    for (i = 0; i < HASHTABLESIZE; i++) {
+       for (s = hashtab[i]; s != nil; s = s->next_sym) {
+           if (s->block == func) {
+               psym(s);
+           }
+       }
+    }

 }
 
 /*
  * Free all the symbols currently allocated.
  */
 }
 
 /*
  * Free all the symbols currently allocated.
  */

+

 public symbol_free()
 {
     Sympool s, t;
 public symbol_free()
 {
     Sympool s, t;


@@ -222,6 +249,8 @@ Symbol chain;
 
     s = symbol_alloc();
     s->name = name;
 
     s = symbol_alloc();
     s->name = name;

+    s->language = primlang;
+    s->storage = EXT;

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


@@ -294,7 +323,7 @@ Symbol s;
 
 /*
  * 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


@@ -327,44 +356,60 @@ Frame frame;
  * Builtin types are circular in that btype->type->type = btype.
  */
 
  * 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);
+    if (name == nil) {
+       n = nil;
+    } else {
+       n = identname(name, true);
+    }
+    s = insert(n);

     s->language = primlang;
     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 = newSymbol(nil, 0, RANGE, s, nil);

-    s->type->language = s->language;

     s->type->symvalue.rangev.lower = lower;
     s->type->symvalue.rangev.upper = upper;
     return s;
 }
 
 /*
     s->type->symvalue.rangev.lower = lower;
     s->type->symvalue.rangev.upper = upper;
     return s;
 }
 
 /*

- * 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.


@@ -377,7 +422,9 @@ 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;
        }
        if (t->class == TYPEREF) {
            t = t->type;
        }
        if (t->class == TYPEREF) {


@@ -471,11 +518,18 @@ Symbol t;
     }
 }
 
     }
 }
 

-public Integer level(s)
+public integer regnum (s)

 Symbol s;
 {
 Symbol s;
 {

+    integer r;
+

     checkref(s);
     checkref(s);

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

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


@@ -485,6 +539,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.
  *


@@ -496,11 +560,11 @@ Symbol s;
  *     register        - offset is register number
  */
 
  *     register        - offset is register number
  */
 

-#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)
+#define isglobal(s)            (s->storage == EXT)
+#define islocaloff(s)          (s->storage == STK and s->symvalue.offset < 0)
+#define isparamoff(s)          (s->storage == STK and s->symvalue.offset >= 0)

 
 

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

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


@@ -521,11 +585,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)) {


@@ -545,20 +612,18 @@ 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 = primlang;
-    s->language = t->language;
+    s->language = t_addr->language;

     s->class = VAR;
     s->class = VAR;

-    s->level = -3;
-    s->type = t;
-    s->block = program;
+    s->storage = INREG;
+    s->level = 3;
+    s->type = t_addr;

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


@@ -587,11 +652,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 != prev 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
-    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 {


@@ -614,27 +685,6 @@ Symbol s;
 #define MINSHORT -32768
 #define MAXSHORT 32767
 
 #define MINSHORT -32768
 #define MAXSHORT 32767
 

-/*
- * When necessary, compute the upper bound for an open array (Modula-2 style).
- */
-
-public chkOpenArray (sym)
-Symbol sym;
-{
-    Symbol t;
-    Address a;
-    integer n;
-
-    if (sym->class == REF or sym->class == VAR) {
-       t = rtype(sym->type);
-       if (t->class == ARRAY and t->chain == t_open) {
-           a = address(sym, nil);
-           dread(&n, a + sizeof(Word), sizeof(n));
-           t->chain->type->symvalue.rangev.upper = n - 1;
-       }
-    }
-}
-

 public findbounds (u, lower, upper)
 Symbol u;
 long *lower, *upper;
 public findbounds (u, lower, upper)
 Symbol u;
 long *lower, *upper;


@@ -665,7 +715,7 @@ long *lower, *upper;
        *lower = 0;
        *upper = u->symvalue.iconval - 1;
     } else {
        *lower = 0;
        *upper = u->symvalue.iconval - 1;
     } else {

-       panic("unexpected array bound type");
+       error("[internal error: unexpected array bound type]");

     }
 }
 
     }
 }
 


@@ -718,10 +768,17 @@ Symbol sym;
            r = nel*elsize;
            break;
 
            r = nel*elsize;
            break;
 

+       case OPENARRAY:
+       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:
-           chkOpenArray(t);

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


@@ -731,18 +788,23 @@ Symbol sym;
            */
            break;
 
            */
            break;
 

+       case FVAR:

        case CONST:
        case CONST:

+       case TAG:

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

+           /*
+            * This causes problems on the IRIS because of the compiler bug
+            * with stab offsets for parameters.  Not sure it's really
+            * necessary anyway.
+            */
+#          ifndef IRIS

            if (t->type->class == PTR and t->type->type->class == BADUSE) {
                findtype(t);
            }
            if (t->type->class == PTR and t->type->type->class == BADUSE) {
                findtype(t);
            }

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

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


@@ -750,7 +812,6 @@ Symbol sym;
            off = t->symvalue.field.offset;
            len = t->symvalue.field.length;
            r = (off + len + 7) div 8 - (off div 8);
            off = t->symvalue.field.offset;
            len = t->symvalue.field.length;
            r = (off + len + 7) div 8 - (off div 8);

-           /* r = (t->symvalue.field.length + 7) div 8; */

            break;
 
        case RECORD:
            break;
 
        case RECORD:


@@ -762,6 +823,7 @@ Symbol sym;
            break;
 
        case PTR:
            break;
 
        case PTR:

+       case TYPEREF:

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


@@ -809,11 +871,19 @@ Symbol sym;
            r = (r + BITSPERBYTE - 1) div BITSPERBYTE;
            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 {

-               fprintf(stderr, "!! size(%s) ??", classname(t));
+               fprintf(stderr, "can't compute size of a %s\n", classname(t));

            }
            r = 0;
            break;
            }
            r = 0;
            break;


@@ -821,6 +891,33 @@ Symbol sym;
     return r;
 }
 
     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 == OPENARRAY) {
+           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;
+}
+

 /*
  * Test if a symbol is a parameter.  This is true if there
  * is a cycle from s->block to s via chain pointers.
 /*
  * Test if a symbol is a parameter.  This is true if there
  * is a cycle from s->block to s via chain pointers.


@@ -842,15 +939,17 @@ Symbol s;
  * Test if a type is an open array parameter type.
  */
 
  * Test if a type is an open array parameter type.
  */
 

-public Boolean isopenarray (t)
-Symbol t;
+public boolean isopenarray (type)
+Symbol type;

 {
 {

-    return (Boolean) (t->class == ARRAY and t->chain == t_open);
+    Symbol t;
+
+    t = rtype(type);
+    return (boolean) (t->class == OPENARRAY);

 }
 
 /*
 }
 
 /*

- * Test if a symbol is a var parameter, i.e. has class REF but
- * is not an open array parameter (those are treated special).
+ * Test if a symbol is a var parameter, i.e. has class REF.

  */
 
 public Boolean isvarparam(s)
  */
 
 public Boolean isvarparam(s)


@@ -865,27 +964,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.


@@ -897,17 +989,6 @@ register Symbol s;
     return (Boolean) (s->class == MODULE);
 }
 
     return (Boolean) (s->class == MODULE);
 }
 

-/*
- * Test if a symbol is builtin, that is, a predefined type or
- * reserved word.
- */
-
-public Boolean isbuiltin(s)
-register Symbol s;
-{
-    return (Boolean) (s->level == 0 and s->class != PROG and s->class != VAR);
-}
-

 /*
  * Mark a procedure or function as internal, meaning that it is called
  * with a different calling sequence.
 /*
  * Mark a procedure or function as internal, meaning that it is called
  * with a different calling sequence.


@@ -925,6 +1006,50 @@ Symbol s;
     return s->symvalue.funcv.intern;
 }
 
     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;
+{
+    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
+       )
+    );
+}
+

 /*
  * Test if two types match.
  * Equivalent names implies a match in any language.
 /*
  * Test if two types match.
  * Equivalent names implies a match in any language.


@@ -946,30 +1071,20 @@ 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) {
-           rt1 = rtype(t1);
-           rt2 = rtype(t2);
-           b = (boolean) (
-               (rt1->type == t_open and rt2->type == t_int) or
-               (rt2->type == t_open and rt1->type == t_int) or
-               rt1 == rt2
-           );
-       } 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) {
        if (t2->language == nil) {
            b = false;
     } else if (t1->language == nil) {
        if (t2->language == nil) {
            b = false;

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

        } else {
            b = (boolean) (*language_op(t2->language, L_TYPEMATCH))(t1, t2);
        }
        } else {
            b = (boolean) (*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);

     } else {
        b = (boolean) (*language_op(t1->language, L_TYPEMATCH))(t1, t2);
     }
     } else {
        b = (boolean) (*language_op(t1->language, L_TYPEMATCH))(t1, t2);
     }


@@ -984,14 +1099,17 @@ 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 streq(ident(t->name), name)
-    );
+    if (t == nil) {
+       b = false;
+    } else {
+       b = (Boolean) (
+           t->class == TYPE and streq(ident(t->name), name)
+       );
+    }

     return b;
 }
 
     return b;
 }
 


@@ -1036,15 +1154,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;


@@ -1052,30 +1170,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;
 


@@ -1087,21 +1210,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;


@@ -1118,9 +1236,11 @@ register Node p;
            }
            break;
 
            }
            break;
 

-       /*
-        * Perform a cast if the call is of the form "type(expr)".
-        */
+       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;


@@ -1243,45 +1363,9 @@ Symbol t;
     }
 }
 
     }
 }
 

-/*
- * 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.
- */
-
-private Symbol namenode(p)
-Node p;
-{
-    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;
-    } else {
-       r = s;
-    }
- *
- */
-    return s;
-}
-

 /*
  * Convert a tree to a type via a conversion operator;
  * if this isn't possible generate an error.
 /*
  * Convert a tree to a type via a conversion operator;
  * if this isn't possible generate an error.

- *
- * Note the tree is call by address, hence the #define below.

  */
 
 private convert(tp, typeto, op)
  */
 
 private convert(tp, typeto, op)


@@ -1296,15 +1380,13 @@ Operator op;
     s = rtype(tree->nodetype);
     t = rtype(typeto);
     if (compatible(t, t_real) and compatible(s, t_int)) {
     s = rtype(tree->nodetype);
     t = rtype(typeto);
     if (compatible(t, t_real) and compatible(s, t_int)) {

+       /* we can convert int => floating but not the reverse */

        tree = build(op, tree);
     } else if (not compatible(s, t)) {
        beginerrmsg();
        tree = build(op, tree);
     } else if (not compatible(s, t)) {
        beginerrmsg();

-       fprintf(stderr, "expected integer or real, found \"");

        prtree(stderr, tree);
        prtree(stderr, tree);

-       fprintf(stderr, "\"");
+       fprintf(stderr, ": illegal type in operation");

        enderrmsg();
        enderrmsg();

-    } else if (op != O_NOP and s != t) {
-       tree = build(op, tree);

     }
     *tp = tree;
 }
     }
     *tp = tree;
 }


@@ -1322,26 +1404,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);


@@ -1351,15 +1434,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);

 }
 
 /*
 }
 
 /*


@@ -1371,31 +1455,36 @@ public Node subscript(a, slist)
 Node a, slist;
 {
     Symbol t;
 Node a, slist;
 {
     Symbol t;

+    Node p;

 
     t = rtype(a->nodetype);
 
     t = rtype(a->nodetype);

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

     } else {
     } else {

-       return (Node) (*language_op(t->language, L_BUILDAREF))(a, slist);
+       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;
 {
     Symbol t;
 long i;
 {
     Symbol t;

+    int r;

 
     t = rtype(s);
 
     t = rtype(s);

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

     } else {
     } else {

-       return ((*language_op(t->language, L_EVALAREF)) (s, i));
+       r = ((*language_op(t->language, L_EVALAREF)) (s, base, i));

     }
     }

+    return r;

 }
 
 /*
 }
 
 /*


@@ -1414,26 +1503,6 @@ 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.
  */
 /*
  * Construct a node for the type of a string.
  */


@@ -1441,32 +1510,13 @@ Symclass class;
 private Symbol mkstring(str)
 String str;
 {
 private Symbol mkstring(str)
 String str;
 {

-    register char *p, *q;

     register Symbol s;
     register Symbol s;

-    integer len;

 
 

-    p = str;
-    q = str;
-    while (*p != '\0') {
-       if (*p == '\\') {
-           ++p;
-       }
-       *q = *p;
-       ++p;
-       ++q;
-    }
-    *q = '\0';
-    len = p - str;
-    if (len == 1) {
-       s = t_char;
-    } else {
-       s = newSymbol(nil, 0, ARRAY, t_char, nil);
-       s->language = primlang;
-       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 = len + 1;
-    }
+    s = newSymbol(nil, 0, ARRAY, t_char, nil);
+    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 = strlen(str) + 1;

     return s;
 }
 
     return s;
 }
 


@@ -1481,48 +1531,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 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;
+           }
+       }
+       s = s->next_sym;
+    } while (s != nil);
+    if (mincount != 10000) {
+       *var_s = t;
+       b = true;

     } else {
     } else {

-       /* start with current function */
-       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;
+       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;
 {