eval.c

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

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

    if (op == O_TRACEI) {
	event = build(O_EQ, build(O_SYM, pcsym), place);
    } else {
	event = build(O_EQ, build(O_SYM, linesym), place);
    }
    action = build(O_PRINTSRCPOS, exp);
    if (cond != nil) {
	action = build(O_IF, cond, buildcmdlist(action));
    }
    e = addevent(event, buildcmdlist(action));
    if (isstdin()) {
	printevent(e);
    }
}

/*
 * Construct event for tracing a procedure.
 *
 * What we want here is
 *
 * 	when $proc = p do
 *	    if <condition> then
 *	        printcall;
 *	        once $pc = $retaddr do
 *	            printrtn;
 *	        end;
 *	    end if;
 *	end;
 *
 * Note that "once" is like "when" except that the event
 * deletes itself as part of its associated action.
 */

private traceproc(op, p, place, cond)
Operator op;
Symbol p;
Node place;
Node cond;
{
    Node event;
    Command action;
    Cmdlist actionlist;
    Event e;

    /* check for error conditions */
    if (place != nil)
		error ("place cannot be specified with procedure trace");

    action = build(O_PRINTCALL, p);
    actionlist = list_alloc();
    cmdlist_append(action, actionlist);
    event = build(O_EQ, build(O_SYM, pcsym), build(O_SYM, retaddrsym));
    action = build(O_ONCE, event, buildcmdlist(build(O_PRINTRTN, p)));
    cmdlist_append(action, actionlist);
    if (cond != nil) {
	actionlist = buildcmdlist(build(O_IF, cond, actionlist));
    }
    event = build(O_EQ, build(O_SYM, procsym), build(O_SYM, p));
    e = addevent(event, actionlist);
    if (isstdin()) {
	printevent(e);
    }
}

/*
 * Set up breakpoint for tracing data.
 */

private tracedata(op, exp, place, cond)
Operator op;
Node exp;
Node place;
Node cond;
{
    Symbol p;
    Node event;
    Command action;

	p = exp->value.sym;
	if((p->level == -3) or (streq(ident(exp->nodetype->name), "$vquad"))) {
		error("can't trace a register value");
	}
    p = (place == nil) ? tcontainer(exp) : place->value.sym;
    if (p == nil) {
	p = program;
    }
    action = build(O_PRINTIFCHANGED, exp);
    if (cond != nil) {
	action = build(O_IF, cond, buildcmdlist(action));
    }
    action = build(O_TRACEON, (op == O_TRACEI), buildcmdlist(action));
    event = build(O_EQ, build(O_SYM, procsym), build(O_SYM, p));
    action->value.trace.event = addevent(event, buildcmdlist(action));
    if (isstdin()) {
	printevent(action->value.trace.event);
    }
}

/*
 * Setting and unsetting of stops.
 */

public stop(p)
Node p;
{
    Node exp, place, cond, t;
    Symbol s;
    Command action;
    Event e;

    exp = p->value.arg[0];
    place = p->value.arg[1];
    cond = p->value.arg[2];
    if (exp != nil) {
	stopvar(p->op, exp, place, cond);
    } else {
	action = build(O_STOPX);
	if (cond != nil) {
	    action = build(O_IF, cond, buildcmdlist(action));
	}
	if (place == nil or place->op == O_SYM) {
	    if (place == nil) {
		s = program;
	    } else {
		s = place->value.sym;
	    }
	    t = build(O_EQ, build(O_SYM, procsym), build(O_SYM, s));
	    if (cond != nil) {
		action = build(O_TRACEON, (p->op == O_STOPI),
		    buildcmdlist(action));
		e = addevent(t, buildcmdlist(action));
		action->value.trace.event = e;
	    } else {
		e = addevent(t, buildcmdlist(action));
	    }
	    if (isstdin()) {
		printevent(e);
	    }
	} else {
	    stopinst(p->op, place, cond, action);
	}
    }
}

private stopinst(op, place, cond, action)
Operator op;
Node place;
Node cond;
Command action;
{
    Node event;
    Event e;

    if (op == O_STOP) {
	event = build(O_EQ, build(O_SYM, linesym), place);
    } else {
	event = build(O_EQ, build(O_SYM, pcsym), place);
    }
    e = addevent(event, buildcmdlist(action));
    if (isstdin()) {
	printevent(e);
    }
}

/*
 * Implement stopping on assignment to a variable by adding it to
 * the variable list.
 */

private stopvar(op, exp, place, cond)
Operator op;
Node exp;
Node place;
Node cond;
{
    Symbol p;
    Node event;
    Command action;

    if (place == nil) {
	if (exp->op == O_LCON) {
	    p = program;
	} else {
	    p = tcontainer(exp);
	    if (p == nil) {
		p = program;
	    }
	}
    } else {
	p = place->value.sym;
    }
    action = build(O_STOPIFCHANGED, exp);
    if (cond != nil) {
	action = build(O_IF, cond, buildcmdlist(action));
    }
    action = build(O_TRACEON, (op == O_STOPI), buildcmdlist(action));
    event = build(O_EQ, build(O_SYM, procsym), build(O_SYM, p));
    action->value.trace.event = addevent(event, buildcmdlist(action));
    if (isstdin()) {
	printevent(action->value.trace.event);
    }
}

/*
 * Assign the value of an expression to a variable (or term).
 */

public assign(var, exp)
Node var;
Node exp;
{
    Address addr;
    integer varsize, expsize;
    integer fieldvalue;
    char cvalue, *vreg_decode_array, *str1, *str2, *str_tmp;
    short svalue;
    long lvalue;
    float fvalue;
    Vquad vquadvalue;
	Boolean scan_failure = false;


    eval(exp);

    if (var->op == O_SYM and regnum(var->value.sym) != -1) {
	setreg(regnum(var->value.sym), pop(Address));
    } else if (var->op == O_VREG) {
		lvalue = 0;
		expsize = size(exp->nodetype);
		popn(expsize, &lvalue);
		setnreg(var->nodetype->symvalue.raddr.reg, lvalue);
    } else {
        addr = lval(var);
		if(var->op != O_LCON && var->value.sym->type->class == PTR)
			dread(&addr, addr, sizeof(Address));
		varsize = size(var->nodetype);
		expsize = size(exp->nodetype);
	
	/* Start vector support */
	if (var->nodetype == t_vquad) {
	    vquadvalue.val[0] = 0;
	    vquadvalue.val[1] = 0;
		if((vreg_decode_array = malloc(expsize)) == nil) {
			sp -= expsize;
			error("unable to malloc memory for decode of vreg");
		}
	    popn(expsize, vreg_decode_array);
		if(str2 = (char *)strchr(vreg_decode_array, ',')) {
			str1 = vreg_decode_array;
			str2[0] =  '\0';
			str2++;
			if(strpbrk(str1, "Xx")) {
				if((str_tmp = (char *)strchr(str1, 'X')) ||
						(str_tmp = (char *)strchr(str1, 'x'))) {
					str_tmp[0] =  '\0';
					str_tmp++;
					if(sscanf(str_tmp, "%lx", &vquadvalue.val[0]) != 1) {
						scan_failure = true;
					}
				}
			}
			else {
				if(strpbrk(str1, "Ee.")) {
					if(sscanf(str1, "%f", &vquadvalue.val[0]) != 1) {
						scan_failure = true;
					}
				}
				else {
					if(sscanf(str1, "%ld", &vquadvalue.val[0]) != 1) {
						scan_failure = true;
					}
				}
			}
			if(strpbrk(str2, "Xx")) {
				if((str_tmp = (char *)strchr(str2, 'X')) ||
						(str_tmp = (char *)strchr(str2, 'x'))) {
					str_tmp[0] =  '\0';
					str_tmp++;
					if(sscanf(str_tmp, "%lx", &vquadvalue.val[1]) != 1) {
						scan_failure = true;
					}
				}
			}
			else {
				if(strpbrk(str2, "Ee.")) {
					if(sscanf(str2, "%f", &vquadvalue.val[1]) != 1) {
						scan_failure = true;
					}
				}
				else {
					if(sscanf(str2, "%ld", &vquadvalue.val[1]) != 1) {
						scan_failure = true;
					}
				}
			}
		}
		else {
			if(strpbrk(vreg_decode_array, "Xx")) {
				if((str2 = (char *)strchr(vreg_decode_array, 'X')) ||
						(str2 = (char *)strchr(vreg_decode_array, 'x'))) {
					str2[0] =  '\0';
					str2++;
				}
				if(sscanf(str2, "%lx", &vquadvalue.val[0]) != 1) {
					scan_failure = true;
				}
			}
			else {
				if(strpbrk(vreg_decode_array, "Ee.")) {
					if(sscanf(vreg_decode_array, "%F",
											&vquadvalue.val[0]) != 1) {
						scan_failure = true;
					}
				}
				else {
					if(sscanf(vreg_decode_array, "%ld", &vquadvalue.val[0]) !=
																			1) {
						scan_failure = true;
					}
				}
			}
		}
		free(vreg_decode_array);
		if(scan_failure) {
			yyerror("syntax error");
		}
		else {
	    	setvreg(addr, &vquadvalue);
		}
	    return;
	}
	else
		if(var->nodetype == t_vmr) {
		lvalue = 0;
		expsize = size(exp->nodetype);
		popn(expsize, &lvalue);
		setvmrreg(addr - (Address )vreg(VMR), lvalue);
	    return;
	}

	/* End vector support */
	if (varsize == sizeof(float) and expsize == sizeof(double)) {
	    fvalue = (float) pop(double);
	    dwrite(&fvalue, addr, sizeof(fvalue));
	} else {
	    if (var->nodetype->class == FIELD && isbitfield(var->nodetype)) {
	        rpush(addr, sizeof(int), t_int);
		fieldvalue = popsmall(t_int);
		depositField(fieldvalue, var->nodetype);
		dwrite(sp-sizeof(int), addr, varsize);
	    } else if (varsize < sizeof(long)) {
	        lvalue = 0;
		popn(expsize, &lvalue);
		if (varsize == sizeof(char)) {
		    cvalue = lvalue;
		    dwrite(&cvalue, addr, sizeof(cvalue));
		} else if (varsize == sizeof(short)) {
		    svalue = lvalue;
		    dwrite(&svalue, addr, sizeof(svalue));
		} else {
		    error("[internal error: bad size %d in assign", varsize);
		}
	  } else {
	      if (expsize <= varsize || var->value.sym->type->class == PTR) {
		  sp -= expsize;
		  dwrite(sp, addr, expsize);
	      } else {
		  sp -= expsize;
		  dwrite(sp, addr, varsize);
	      }
	    }
	}
    }
}

public char *make_string(s, len)
char *s;
int len;
{
    if (!s)
	return(nil);
    return strcpy(malloc((unsigned) strlen(s) + 1 + len), s);
}

extern String getenv();

public do_chdir (string1)
char *string1;
{
	char bad = 0;

	if(string1) {
		if(chdir(string1)) {
			bad++;
		}
	} else {
		String out = getenv("HOME");

		if(out) {
			if(chdir(out)) {
				bad++;
			}
		} else {
			bad++;
		}
	}
	if(bad) {
		error("unable to change directory");
	}
	do_pwd();
}

public do_pwd()
{

	char *cwd, *getcwd();

	if((cwd = getcwd(nil, 256)) == nil) {
		error("pwd failure");
	}
	printf("%s\n", cwd);
	free(cwd);

}

public get_env (string1)
Node string1;
{
	String out = getenv(string1->value.name->identifier);

	if(out == nil)
		error("%s is not present", string1->value.name->identifier);
	else
		error(out);
}

public set_env (string1, string2)
Node string1, string2;
{
	char *str1 = string1->value.name->identifier;
	char *str2;
	char *s;
	
	switch(string2->op)
	{
		case O_NAME:
			str2 = string2->value.name->identifier;
			break;
		
		case O_SCON:
			str2 = string2->value.scon;
			break;
		
		default:
			error("type mismatch on setenv");
			break;
	}
	s = make_string(str1, strlen(str2) +3);
	if(s == nil)
		error("malloc failure on setenv string");
	strcat(s , "=");
	strcat(s , str2);
	if(putenv(s))
		error("putenv failure on setenv");
}

/*
 * Set a debugger variable.
 */

private set (var, exp)
Node var, exp;
{
    Symbol t;

    if (var == nil) {
	defvar(nil, nil);
    } else if (exp == nil) {
	defvar(var->value.name, nil);
    } else if (var->value.name == identname("$frame", true)) {
	t = exp->nodetype;
	if (not compatible(t, t_int) and not compatible(t, t_addr)) {
	    error("$frame must be an address");
	}
	eval(exp);
	getnewregs(pop(Address));
    } else {
	defvar(var->value.name, unrval(exp));
    }
}

/*
 * Execute a list command.
 */

private list (p)
Node p;
{
    Symbol f;
    Address addr;
    Lineno line, l1, l2;

	if (p->value.arg[0]->op == O_SYM) {
    	func(p->value.arg[0]);
		f = p->value.arg[0]->value.sym;
		addr = codeloc(curfunc);
		if (addr == NOADDR) {
 	    	error("no source lines for \"%s\"", symname(f));
		}
		setsource(srcfilename(addr));
		line = srcline(addr);
		getsrcwindow(line, &l1, &l2);
    } else {
		eval(p->value.arg[0]);
		l1 = (Lineno) (pop(long));
		eval(p->value.arg[1]);
		l2 = (Lineno) (pop(long));
    }
    printlines(l1, l2);
}

/*
 * Execute a func command.
 */

private func (p)
Node p;
{
    Symbol s, f;
    Address addr;

    if (p == nil) {
		printname(stdout, curfunc);
		putchar('\n');
    } else {
		s = p->value.sym;
		if (isroutine(s)) {
	    	setcurfunc(s);
		} else {
	    	find(f, s->name) where isroutine(f) endfind(f);
	    	if (f == nil) {
				error("%s is not a procedure or function", symname(s));
	    	}
	    	setcurfunc(f);
		}
		addr = codeloc(curfunc);
		if (addr != NOADDR) {
	    	setsource(srcfilename(addr));
	    	cursrcline = srcline(addr);
		}
    }
}

/*
 * Give the user some help.
 */

public help()
{
	puts("sh man dbx             - for more explicit help");
    puts("run                    - begin execution of the program");
    puts("print <exp>            - print the value of the expression");
    puts("where                  - print currently active procedures");
    puts("stop at <line>         - suspend execution at the line");
    puts("stop in <proc>         - suspend execution when <proc> is called");
    puts("cont                   - continue execution");
    puts("step                   - single step one line");
    puts("next                   - step to next line (skip over calls)");
    puts("trace <line#>          - trace execution of the line");
    puts("trace <proc>           - trace calls to the procedure");
    puts("trace <var>            - trace changes to the variable");
    puts("trace <exp> at <line#> - print <exp> when <line> is reached");
    puts("status                 - print trace/stop's in effect");
    puts("delete <number>        - remove trace or stop of given number");
    puts("call <proc>            - call a procedure in program");
    puts("whatis <name>          - print the declaration of the name");
    puts("list <line>, <line>    - list source lines");
    puts("quit                   - exit dbx");
}

/*
 * Divert output to the given file name.
 * Cannot redirect to an existing file.
 */

private int so_fd;
private Boolean notstdout;

public setout(filename)
String filename;
{
    File f;

    f = fopen(filename, "r");
    if (f != nil) {
	fclose(f);
	error("%s: file already exists", filename);
    } else {
	so_fd = dup(1);
	close(1);
	if (creat(filename, 0666) == nil) {
	    unsetout();
	    error("can't create %s", filename);
	}
	notstdout = true;
    }
}

/*
 * Revert output to standard output.
 */

public unsetout()
{
    fflush(stdout);
    close(1);
    if (dup(so_fd) != 1) {
	panic("standard out dup failed");
    }
    close(so_fd);
    notstdout = false;
}

/*
 * Determine is standard output is currently being redirected
 * to a file (as far as we know).
 */

public Boolean isredirected()
{
    return notstdout;
}