symbols.c

<B>Digital的Unix操作系统VAX 4.2源码</B>

 */

#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 isreg(s)		(s->level < 0)
#define isvreg(s)		(s->level == -4)

public Address address (s, frame)
Symbol s;
Frame frame;
{
    register Frame frp;
    register Address addr;
    register Symbol cur;

    checkref(s);
    if (not isactive(s->block)) {
	error("\"%s\" is not currently defined", symname(s));
    } else if (isglobal(s)) {
	addr = s->symvalue.offset;
    } else {
	frp = frame;
	if (frp == nil) {
	    cur = s->block;
	    while (cur != nil and cur->class == MODULE) {
		cur = cur->block;
	    }
	    if (cur == nil) {
		frp = nil;
	    } else {
		frp = findframe(cur);
		if (frp == nil) {
		    error("[internal error: unexpected nil frame for \"%s\"]",
			symname(s)
		    );
		}
	    }
	}
	if (islocaloff(s)) {
	    addr = locals_base(frp) + s->symvalue.offset;
	} else if (isparamoff(s)) {
	    addr = args_base(frp) + s->symvalue.offset;
	} else if (isvreg(s)) {
	    addr = vregaddr(s->symvalue.raddr.reg);
	} else if (isreg(s)) {
	    addr = regaddr(s, frp);
/*	    addr = savereg(s->symvalue.offset, frp); */
	} else {
	    panic("address: bad symbol \"%s\"", symname(s));
	}
    }
    return addr;
}

/* Routine to read the contents of a register, and do
 * indirection and displacement.  Return the final result.
 */
private Address regaddr(s, frp)
Symbol s;
Frame frp;
{
    Word contents;

    contents = savereg(s->symvalue.raddr.reg, frp);
    if (s->symvalue.raddr.indirect) {
        dread(&contents, contents, sizeof(Address));
    }
    contents += s->symvalue.raddr.displacement;
    return contents;
}

/*
 * Define a symbol used to access register values.
 */

public defregname (n, r)
Name n;
integer r;
{
    register Symbol s;

    s = insert(n);
    s->language = t_addr->language;
    s->class = VAR;
    s->level = -3;
    s->type = t_addr;
    s->block = program;
    s->symvalue.raddr.reg = r;
    s->symvalue.raddr.indirect = false;
    s->symvalue.raddr.displacement = 0;
}

/*
 * Define a symbol used to access vector register values.
 */

public defvregname (n, r)
Name n;
integer r;
{
    register Symbol s, t;

    s = insert(n);
    s->language = t_addr->language;
    s->class = VAR;
    s->level = -4;

    /* Make vector registers of type array of quad indexed 0 thru 63 */
    t = newSymbol(nil, 0, ARRAY, t_vquad, nil);
    t->chain = newSymbol(nil, 0, RANGE, t_int, nil);
    t->chain->language = s->language;
    t->chain->symvalue.rangev.lower = 0;
    t->chain->symvalue.rangev.upper = 63;
    
    s->type = t;
    s->block = program;
    s->symvalue.raddr.reg = r;
    s->symvalue.raddr.indirect = false;
    s->symvalue.raddr.displacement = 0;
}

/*
 * Define a symbol used to access vcr and vlr register values.
 */

public defvcrname (n, r)
Name n;
integer r;
{
    register Symbol s;

    s = insert(n);
    s->language = t_addr->language;
    s->class = VAR;
    s->level = -4;
    s->type = t_int;
    s->block = program;
    s->symvalue.raddr.reg = r;
    s->symvalue.raddr.indirect = false;
    s->symvalue.raddr.displacement = 0;
}

/*
 * Define a symbol used to access vmr register value.
 */

public defvmrname (n, r)
Name n;
integer r;
{
    register Symbol s, t;

    s = insert(n);
    s->language = t_addr->language;
    s->class = VAR;
    s->level = -4;

    /* Make vmr of type array of boolean indexed 0 thru 63 */
    t = newSymbol(nil, 0, ARRAY, t_vmr, nil);
    t->chain = newSymbol(nil, 0, RANGE, t_int, nil);
    t->chain->language = s->language;
    t->chain->symvalue.rangev.lower = 0;
    t->chain->symvalue.rangev.upper = 63;
    
    s->type = t;
    s->block = program;
    s->symvalue.raddr.reg = r;
    s->symvalue.raddr.indirect = false;
    s->symvalue.raddr.displacement = 0;
}

/*
 * Resolve an "abstract" type reference.
 *
 * It is possible in C to define a pointer to a type, but never define
 * the type in a particular source file.  Here we try to resolve
 * the type definition.  This is problematic, it is possible to
 * have multiple, different definitions for the same name type.
 */

public findtype(s)
Symbol s;
{
    register Symbol t, u, prev;

    u = s;
    prev = nil;
    while (u != nil and u->class != BADUSE) {
	if (u->name != nil) {
	    prev = u;
	}
	u = u->type;
    }
    if (prev == nil) {
	error("couldn't find link to type reference");
    }
    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 {
	prev->type = t->type;
    }
}

/*
 * Find the size in bytes of the given type.
 *
 * This is probably the WRONG thing to do.  The size should be kept
 * as an attribute in the symbol information as is done for structures
 * and fields.  I haven't gotten around to cleaning this up yet.
 */

#define MAXUCHAR 255
#define MAXUSHORT 65535L
#define MINCHAR -128
#define MAXCHAR 127
#define MINSHORT -32768
#define MAXSHORT 32767

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;
{
    register Symbol s, t, u;
    register integer nel, elsize;
    long lower, upper;
    integer r, off, len;

    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;
	    if (upper == 0 and lower > 0) {
		/* real, quad */
		r = lower;
	    } else if (lower > upper) {
		/* unsigned long */
		r = sizeof(long);
	    } else if (
  		(lower >= MINCHAR and upper <= MAXCHAR) or
  		(lower >= 0 and upper <= MAXUCHAR)
  	      ) {
		r = sizeof(char);
  	    } else if (
  		(lower >= MINSHORT and upper <= MAXSHORT) or
  		(lower >= 0 and upper <= MAXUSHORT)
  	      ) {
		r = sizeof(short);
	    } else {
		r = sizeof(long);
	    }
	    break;

	case ARRAY:
	    assert(t != t->type);
	    elsize = size(t->type);
	    nel = 1;
	    for (t = t->chain; t != nil; t = t->chain) {
		u = rtype(t);
		findbounds(u, &lower, &upper);
		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:
	    assert(t != t->type);
	    r = size(t->type);
	    /*
	     *
	    if (r < sizeof(Word) and isparam(t)) {
		r = sizeof(Word);
	    }
	    */
	    break;

	case FVAR:
	case CONST:
	case TAG:
	    assert(t != t->type);
	    r = size(t->type);
	    break;

	case TYPE:
	    if (t->type->class == PTR and t->type->type->class == BADUSE) {
		findtype(t);
	    }
	    assert(t != t->type);
	    r = size(t->type);
	    break;

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

	case RECORD:
	case VARNT:
	    r = t->symvalue.offset;
	    if (r == 0 and t->chain != nil) {
		panic("missing size information for record");
	    }
	    break;

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

	case SCAL:
	    r = sizeof(Word);
	    /*
	     *
	    if (t->symvalue.iconval > 255) {
		r = sizeof(short);
	    } else {
		r = sizeof(char);
	    }
	     *
	     */
	    break;

	case FPROC:
	case FFUNC:
	    r = sizeof(Word);
	    break;

	case PROC:
	case FUNC:
	case MODULE:
	case PROG:
	    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 {
		fprintf(stderr, "can't compute size of a %s\n", classname(t));
	    }
	    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;
}

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

public Boolean isparam(s)
Symbol s;
{
    register Symbol t;

    t = s->block;
    while (t != nil and t != s) {
	t = t->chain;
    }
    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.
 */

public Boolean isvarparam(s)
Symbol s;
{
    return (Boolean) (s->class == REF);
}

/*
 * Test if a symbol is a variable (actually any addressible quantity
 * with do).
 */

public Boolean isvariable(s)
register Symbol s;
{
    return (Boolean) (s->class == VAR or s->class == FVAR or s->class == REF);
}

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

public Boolean isconst(s)
Symbol s;
{
    return (Boolean) (s->class == CONST);
}

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

public Boolean ismodule(s)
register Symbol s;
{
    return (Boolean) (s->class == MODULE);
}

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

public markInternal (s)
Symbol s;
{
    s->symvalue.funcv.intern = true;
}

/* Make note that the procedure is a jsb-routine, so that the start
 * address is correctly determined by findbeginning() (runtime.c).
 */

public mark_jsb(s)
Symbol s;
{
    s->symvalue.funcv.jsb = true;
}

/*
 * 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
	) or (
	    /* Start vector support */
	    t1->class == RANGE and t2->class == RANGE and
	    t1->type == t_vquad and t2->type == t_int
	    /* End vector support */
	)
    );
}

/*
 * Test if two types match.
 * Equivalent names implies a match in any language.
 *
 * Special symbols must be handled with care.
 */

public Boolean compatible(t1, t2)
register Symbol t1, t2;
{
    Boolean b;
    Symbol rt1, rt2;

   	if (t1 == t2)
   	{
		b = true;
   	}
   	else 
		if (t1 == nil or t2 == nil)
		{
	    	b = false;
        }
        else 
	    	if (t1 == procsym)
	    	{
				b = isblock(t2);
    	    } 
	    	else
	 		if (t2 == procsym)
			{
		    	b = isblock(t1);
    		}
	 		else
			{
				if(t1->type->type == t_vmr && t2->name &&
					(streq(ident(t2->name), "true") ||
							streq(ident(t2->name), "false")))
				{
					return(true);
		    	}
				if (t1->language == primlang)
		    	{
					if (t2->language == primlang)
		        	{
	    		    	b = primlang_typematch(rtype(t1), rtype(t2));
					}
		        	else 
					{
			    		if (t2->language == nil) 
			    		{
	    		        	b = false;
			    		} 
			    		else
	    		        	b = (boolean) (*language_op(t2->language, 
													L_TYPEMATCH))(t1, t2);
					}
    		    } 
		    	else 
		        	if (t2->language == primlang) 
		        	{
			    		if (t1->language == nil) 
			    		{
	    		        	b = false;
			    		} 
			    		else
			        		b = (boolean) (*language_op(t1->language, 
													L_TYPEMATCH))(t1, t2);
    		       	} 
		        	else 
		            	if (t1->language == nil) 
		            	{
			        		if (t2->language == nil) 
			        		{
	    		            	b = false;
			        		} 
			        		else 
			        		{
	    		            	b = (boolean) (*language_op(t2->language, 
														L_TYPEMATCH))(t1, t2);
			        		}
    		            } 
		            	else 
		            	{
							if(t1->language == t2->language)
							{