eval.c

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

#	    else
		error("\"psym\" is not supported");
#	    endif
	    break;

	case O_QLINE:
	    eval(p->value.arg[1]);
	    break;

	case O_STEPV:
	    b = inst_tracing;
	    inst_tracing = (Boolean) (not p->value.step.source);
	    if (p->value.step.skipcalls) {
			nextv();
	    } else {
			stepv();
	    }
	    inst_tracing = b;
	    useInstLoc = (Boolean) (not p->value.step.source);
	    printnews();
	    break;

	case O_STEP:
	    b = inst_tracing;
	    inst_tracing = (Boolean) (not p->value.step.source);
	    if (p->value.step.skipcalls) {
		next();
	    } else {
		stepc();
	    }
	    inst_tracing = b;
	    useInstLoc = (Boolean) (not p->value.step.source);
	    printnews();
	    break;

	case O_SET:
		if(p->value.arg[0] == nil) {
	    	set(p->value.arg[0], p->value.arg[1]);
		} else {
			if(p->value.arg[0]->value.name->identifier[0] != '$') {
				switch(p->value.arg[1]->op) {
					case O_LCON:
						addr = p->value.arg[1]->value.lcon;
						break;

					case O_SYM:
						addr = address(p->value.arg[1]->value.sym, nil);
						break;

					case O_DOT:
						eval(p->value.arg[1]);
						addr= pop(long);
						break;
				
					default:
						error("expression must resolve to an address"); 
				}
						
    			s = insert(p->value.arg[0]->value.name);
    			s->language = findlanguage(ASSEMBLER);	/* RBN 2-27-90 */
    			s->class = VAR;
    			s->type = t_int;
    			s->level = program->level;
    			s->block = curblock;
				s->symvalue.offset = addr;
			} else {
	    		set(p->value.arg[0], p->value.arg[1]);
			}
		}
		break;

	case O_WHATIS:
	    if (p->value.arg[0]->op == O_SYM) {
		printdecl(p->value.arg[0]->value.sym);
	    } else {
		printdecl(p->value.arg[0]->nodetype);
	    }
	    break;

	case O_WHERE:
	    wherecmd();
	    break;

	case O_WHEREIS:
	    if (p->value.arg[0]->op == O_SYM) {
		printwhereis(stdout, p->value.arg[0]->value.sym);
	    } else {
		printwhereis(stdout, p->value.arg[0]->nodetype);
	    }
	    break;

	case O_WHICH:
	    if (p->value.arg[0]->op == O_SYM) {
		printwhich(stdout, p->value.arg[0]->value.sym);
	    } else {
		printwhich(stdout, p->value.arg[0]->nodetype);
	    }
	    putchar('\n');
	    break;
	
	case O_ALIAS:
	    n1 = p->value.arg[0];
	    n2 = p->value.arg[1];
	    if (n2 == nil) {
	    if (n1 == nil) {
		    alias(nil, nil, nil, false);
	    } else {
		    alias(n1->value.name, nil, nil, false);
	    }
	    } else if (n2->op == O_NAME) {
		str = ident(n2->value.name);
		alias(n1->value.name, nil, strdup(str), false);
	    } else {
		if (n1->op == O_COMMA) {
		    alias(
			n1->value.arg[0]->value.name,
			(List) n1->value.arg[1],
			n2->value.scon,
			false
		    );
		} else {
		    alias(n1->value.name, nil, n2->value.scon, false);
		}
	    }
	    break;

	case O_UNALIAS:
	    unalias(p->value.arg[0]->value.name);
	    break;

	case O_CALLPROC:
	    callproc(p, false);
	    break;

	case O_CALL:
	    callproc(p, true);
	    break;

	case O_CATCH:
	    if (p->value.lcon == 0) {
		printsigscaught(process);
	    } else {
		psigtrace(process, p->value.lcon, true);
	    }
	    break;

	case O_CD:
	    do_chdir(p->value.scon);
	    break;

	case O_RECORD:
	    set_record(p->value.scon);
	    break;

	case O_EDIT:
	    edit(p->value.scon);
	    break;

        case O_DEBUG:
#	    ifdef INHOUSE
            	debug(p);
#	    else
		error("\"debug\" is not supported");
#	    endif
	    break;

	case O_DOWN:
	    checkref(p->value.arg[0]);
	    assert(p->value.arg[0]->op == O_LCON);
	    down(p->value.arg[0]->value.lcon);
	    break;

	case O_DUMP:
	    if (p->value.arg[0] == nil) {
		dumpall();
	    } else {
		s = p->value.arg[0]->value.sym;
		if (s == curfunc) {
		    dump(nil);
		} else {
		    dump(s);
		}
	    }
	    break;

	case O_GRIPE:
	    error ("%s\n%s",
	        "please submit a written SPR, or",
	        "contact your nearest service representative");
	    break;

	case O_GETENV:
	    get_env(p->value.arg[0]);
	    break;

	case O_HELP:
	    help();
	    break;

	case O_IGNORE:
	    if (p->value.lcon == 0) {
		printsigsignored(process);
	    } else {
		psigtrace(process, p->value.lcon, false);
	    }
	    break;

	case O_RETURN:
	    if (p->value.arg[0] == nil) {
		rtnfunc(nil);
	    } else {
		assert(p->value.arg[0]->op == O_SYM);
		rtnfunc(p->value.arg[0]->value.sym);
	    }
	    break;

	case O_RUN:
	    run();
	    break;

	case O_SETENV:
	    set_env(p->value.arg[0], p->value.arg[1]);
	    break;

	case O_SEARCH:
	    search(p->value.arg[0]->value.lcon, p->value.arg[1]->value.scon);
	    break;

	case O_SOURCE:
	    setinput(p->value.scon);
	    break;

	case O_STATUS:
	    status();
	    break;

	case O_TRACE:
	case O_TRACEI:
	    trace(p);
	    break;

	case O_STOP:
	case O_STOPI:
	    stop(p);
	    break;

	case O_UNSET:
	    undefvar(p->value.arg[0]->value.name);
	    break;

	case O_UP:
	    checkref(p->value.arg[0]);
	    assert(p->value.arg[0]->op == O_LCON);
	    up(p->value.arg[0]->value.lcon);
	    break;

	case O_ADDEVENT:
	    addevent(p->value.event.cond, p->value.event.actions);
	    break;

	case O_DELETE:
	    n1 = p->value.arg[0];
	    if (n1 == nil) {
	        delallevents();
	    } else {
	        while (n1->op == O_COMMA) {
		    n2 = n1->value.arg[0];
		    assert(n2->op == O_LCON);
	            if (not delevent((unsigned int) n2->value.lcon)) {
		        warning("unknown event %ld", n2->value.lcon);
	            }
		    n1 = n1->value.arg[1];
	        }
	        assert(n1->op == O_LCON);
	        if (not delevent((unsigned int) n1->value.lcon)) {
		    warning("unknown event %ld", n1->value.lcon);
	        }
	    }
	    break;

	case O_ENDX:
	    endprogram();
	    break;

	case O_IF:
	    if (cond(p->value.event.cond)) {
		evalcmdlist(p->value.event.actions);
	    }
	    break;

	case O_ONCE:
	    event_once(p->value.event.cond, p->value.event.actions);
	    break;

	case O_PRINTCALL:
	    printcall(p->value.sym, whatblock(return_addr()));
	    break;

	/* O_PRINTENTRY node is basically the same as O_TRACEON.  However,
	 * it insures that *initial* routine entry is noted.  It has to
	 * be handled specially because initial entry is encountered as
 	 * a breakpoint, rather than single-stepping to it and knowing
	 * that your're at a calls/g instruction (see nextaddr(), 
	 * machine.c).  (006 - vjh)
	 */
	case O_PRINTENTRY:
	    if (not single_stepping) {  /* traceon() sets single_stepping  */
	        callflag = true;	/* so test here first.		   */
	    } else {
	        callflag = false;
	    }
	    traceon(p->value.trace.inst, p->value.trace.event,
		p->value.trace.actions);

	    /* Test callflag.  If we are single stepping already, then      */
	    /* no need to callnews(); it will be done by nextaddr() in      */
	    /* machine.c.  Otherwise, we got here by reaching a breakpoint, */
	    /* and we want to note the occasion. */
	    if (callflag) {
	        callnews(true);
	    }
	    break;

	case O_PRINTIFCHANGED:
	    printifchanged(p->value.arg[0]);
	    break;

	case O_PRINTRTN:
            printrtn(p->value.sym);
	    break;

	case O_PRINTSRCPOS:
	    getsrcpos();
	    if (p->value.arg[0] == nil) {
		printsrcpos();
		putchar('\n');
		printlines(curline, curline);
	    } else if (p->value.arg[0]->op == O_QLINE) {
		if ((p->value.arg[0]->value.arg[1]->value.lcon == 0) or 
							(p->value.arg[0]->value.arg[0] == nil)) {
		    printf("tracei: ");
		    printinst(pc, pc);
		} else {
		    if (canReadSource()) {
		    printf("trace:  ");
		    printlines(curline, curline);
		}
		}
	    } else {
		printsrcpos();
		printf(": ");
		eval(p->value.arg[0]);
		prtree(stdout, p->value.arg[0]);
		printf(" = ");
		printval(p->value.arg[0]->nodetype);
		putchar('\n');
	    }
	    break;

	case O_PROCRTN:
	    procreturn(p->value.sym);
	    break;

	case O_PWD:
		do_pwd();
	    break;

	case O_STOPIFCHANGED:
	    stopifchanged(p->value.arg[0]);
	    break;

	case O_STOPX:
	    isstopped = true;
	    break;

	case O_TRACEON:
	    traceon(p->value.trace.inst, p->value.trace.event,
		p->value.trace.actions);
	    break;

	case O_TRACEOFF:
	    traceoff(p->value.lcon);
	    break;

	default:
	    panic("eval: bad op %d", p->op);
    }
    if (traceeval) { 
	fprintf(stderr, "end eval %s\n", opname(p->op));
 }
}

/*
 * Evaluate a list of commands.
 */

public evalcmdlist(cl)
Cmdlist cl;
{
    Command c;

    foreach (Command, c, cl)
	evalcmd(c);
    endfor
}

/*
 * Push "len" bytes onto the expression stack from address "addr"
 * in the process.  If there isn't room on the stack, print an error message.
 */

public rpush(addr, len)
Address addr;
int len;
{
    if (not canpush(len)) {
	error("expression too large to evaluate");
    } else {
	chksp();
        dread(sp, addr, len);
	sp += len;
    }
}

/*
 * Check if the stack has n bytes available.
 */

public Boolean canpush(n)
Integer n;
{
    return (Boolean) (sp + n < &stack[STACKSIZE]);
}

/*
 * Push a small scalar of the given type onto the stack.
 */

public pushsmall(t, v)
Symbol t;
long v;
{
    register Integer s;

    s = size(t);
    switch (s) {
	case sizeof(char):
	    push(char, v);
	    break;

	case sizeof(short):
	    push(short, v);
	    break;

	case sizeof(long):
	    push(long, v);
	    break;

	default:
	    panic("bad size %d in popsmall", s);
    }
}

/*
 * Pop an item of the given type which is assumed to be no larger
 * than a long and return it expanded into a long.
 */

public long popsmall(t)
Symbol t;
{
    register integer n;
    long r;

    n = size(t);
    if (n == sizeof(char)) {
	if (t->class == RANGE and t->symvalue.rangev.lower >= 0) {
	    r = (long) pop(unsigned char);
	} else {
	    r = (long) pop(char);
	}
    } else if (n == sizeof(short)) {
	if (t->class == RANGE and t->symvalue.rangev.lower >= 0) {
	    r = (long) pop(unsigned short);
	} else {
	    r = (long) pop(short);
	}
    } else if (n == sizeof(long)) {
	    r = pop(long);
    } else {
	error("[internal error: size %d in popsmall]", n);
    }
    return r;
}

/*
 * Evaluate a conditional expression.
 */

public Boolean cond(p)
Node p;
{
    register Boolean b;

    if (p == nil) {
	b = true;
    } else {
	eval(p);
	b = (Boolean) pop(Boolrep);
    }
    return b;
}

/*
 * Return the address corresponding to a given tree.
 */

public Address lval(p)
Node p;
{
    if (p->op == O_RVAL) {
	eval(p->value.arg[0]);
    } else {
	eval(p);
    }
    return (Address) (pop(long));
}

/*
 * Process a trace command, translating into the appropriate events
 * and associated actions.
 */

public trace(p)
Node p;
{
    Node exp, place, cond;
    Node left;

    exp = p->value.arg[0];
    place = p->value.arg[1];
    cond = p->value.arg[2];
    if (exp == nil) {
	traceall(p->op, place, cond);
    } else if (exp->op == O_QLINE or exp->op == O_LCON) {
	traceinst(p->op, exp, cond);
    } else if (place != nil and place->op == O_QLINE) {
	traceat(p->op, exp, place, cond);
    } else {
	left = exp;
	if (left->op == O_RVAL or left->op == O_CALL) {
	    left = left->value.arg[0];
	}
	if (left->op == O_SYM and isblock(left->value.sym)) {
	    traceproc(p->op, left->value.sym, place, cond);
	} else {
	    tracedata(p->op, exp, place, cond);
	}
    }
}

/*
 * Set a breakpoint that will turn on tracing.
 */

private traceall(op, place, cond)
Operator op;
Node place;
Node cond;
{
    Symbol s;
    Node event;
    Command action;

    /* trace:  Special hack for FORTRAN when tracing entire program.
     * f77 startup prolog is without source information (/lib/crt0.o).
     * Setting a tmp. breakpoint at "program" (0x02) and then dissassembling
     * to the first source line consequently did not work:  the call to
     * main() was stepped over (nosource and canskip, nextaddr() in 
     * machine.c); since main() calls MAIN(), MAIN() was missed as well.
     * The hack is to make this appear as if the user has requested
     * "trace in MAIN".  (006 - vjh)
     */
    if (place == nil) {
        s = findproc("MAIN");
	if (s == nil) {
	    s = program;
	}
    } else {
        s = place->value.sym;
    }
    event = build(O_EQ, build(O_SYM, procsym), build(O_SYM, s));
    action = build(O_PRINTSRCPOS,
	build(O_QLINE, nil, build(O_LCON, (op == O_TRACE) ? 1 : 0)));
    if (cond != nil) {
	action = build(O_IF, cond, buildcmdlist(action));
    }
    /* Build O_PRINTENTRY rather than O_TRACEON, so that initial routine
     * entry is announced.  (006 - vjh)
     */
    action = build(O_TRACEON, (op == O_TRACEI), buildcmdlist(action));
    action->value.trace.event = addevent(event, buildcmdlist(action));
    if (isstdin()) {
	printevent(action->value.trace.event);
    }
}

/*
 * Set up the appropriate breakpoint for tracing an instruction.
 */

private traceinst(op, exp, cond)
Operator op;
Node exp;
Node cond;
{
    Node event, wh;
    Command action;
    Event e;

    if (exp->op == O_LCON) {
	wh = build(O_QLINE, build(O_SCON, strdup(cursource)), exp);
    } else {
	wh = exp;
    }
    if (op == O_TRACEI) {
	wh = build(O_QLINE, nil, exp);
	event = build(O_EQ, build(O_SYM, pcsym), wh);
    } else {
	event = build(O_EQ, build(O_SYM, linesym), wh);
    }
    action = build(O_PRINTSRCPOS, wh);
    if (cond) {
	action = build(O_IF, cond, buildcmdlist(action));
    }
    e = addevent(event, buildcmdlist(action));
    if (isstdin()) {
	printevent(e);
    }
}

/*
 * Set a breakpoint to print an expression at a given line or address.
 */