/**
* Handler called whenever a global message is spoken in a NPC's area
*/
int npc_chat_sub(struct block_list *bl, va_list ap)
{
struct npc_data *nd = (struct npc_data *) bl;
struct npc_parse* npcParse = (struct npc_parse *) nd->chatdb;
char *msg;
int len, i;
struct map_session_data *sd;
struct npc_label_list* lst;
struct pcrematch_set* pcreset;
struct pcrematch_entry* e;
// Not interested in anything you might have to say...
if (npcParse == NULL || npcParse->active == NULL)
return 0;
msg = va_arg(ap,char *);
len = va_arg(ap,int);
sd = va_arg(ap,struct map_session_data *);
// iterate across all active sets
for (pcreset = npcParse->active; pcreset != NULL; pcreset = pcreset->next)
{
// interate across all patterns in that set
for (e = pcreset->head; e != NULL; e = e->next)
{
int offsets[2*10 + 10]; // 1/3 reserved for temp space requred by pcre_exec
// perform pattern match
int r = pcre_exec(e->pcre_, e->pcre_extra_, msg, len, 0, 0, offsets, ARRAYLENGTH(offsets));
if (r > 0)
{
// save out the matched strings
for (i = 0; i < r; i++)
{
char var[6], val[255];
snprintf(var, sizeof(var), "$@p%i$", i);
pcre_copy_substring(msg, offsets, r, i, val, sizeof(val));
set_var(sd, var, val);
}
// find the target label.. this sucks..
lst = nd->u.scr.label_list;
ARR_FIND(0, nd->u.scr.label_list_num, i, strncmp(lst[i].name, e->label, sizeof(lst[i].name)) == 0);
if (i == nd->u.scr.label_list_num) {
ShowWarning("Unable to find label: %s\n", e->label);
return 0;
}
// run the npc script
run_script(nd->u.scr.script,lst[i].pos,sd->bl.id,nd->bl.id);
return 0;
}
}
}
return 0;
}
int main(void)
{
int *q, a = 10;
q = &a;
set_var(q);
printf("%c", p);
return 0;
}
void on_sequence( int which ) {
if( query_var("sequence_count") == which - 1 )
set_var( "sequence_count", which );
else {
set_var( "sequence_count", 0 );
if( query_var("sequence_break_message") )
msg_room( environment(), query_var("sequence_break_message") );
return;
}
if( query_var("sequence_count") < query_var("sequence_length") &&
query_var("sequence_message") &&
environment() )
msg_room( environment(), query_var("sequence_message") );
else if( query_var("sequence_count") >= query_var("sequence_length") &&
query_var("sequence_finish_message") &&
environment() )
msg_room( environment(), query_var("sequence_finish_message") );
}
/*
Виртуальная машина
*/
int do_command(unsigned char cop)
{
double op1, op2; //операнды
char name[SIZENAME];
switch(cop) {
case CNOP:
break;
case CPUSH:
push(get_value());
break;
case CIN:
fscanf(vmin, "%lf", &op1);
push(op1);
break;
case COUT:
fprintf(vmout, "%g", pull());
break;
case CNVAR:
get_name(name);
add_var(name);
break;
case CGVAR:
get_name(name);
push(get_var(name));
break;
case CSVAR:
get_name(name);
set_var(name, pull());
break;
case CADD:
push(pull()+pull());
break;
case CSUB:
op1 = pull();
op2 = pull();
push(op2-op1);
break;
case CMULT:
push(pull()*pull());
break;
case CDIV:
op1 = pull();
op2 = pull();
if (op1==0.0) cerror("divide by zero");
push(op2/op1);
break;
case CHALT:
return 0;
default:
cerror("undefined command");
}
return 1;
}
int main(int argc, char **argv)
{
int fd = 0;
struct fb_var_screeninfo vinfo;
int ret = 0;
int just_read = 0;
int hbp, hfp, hsw;
int vbp, vfp, vsw;
if (argc == 1) {
just_read = 1;
} else if (argc != 7) {
printf("usage: ./setfb HBP HFP HSW VBP VFP VSW\n");
return 1;
}
fd = open("/dev/fb0", O_RDWR);
if (fd < 0) {
printf("Error: cannot open framebuffer device.\n");
exit(3);
}
/* Get variable screen information */
if (ioctl(fd, FBIOGET_VSCREENINFO, &vinfo) < 0) {
printf("Error reading variable information.\n");
close(fd);
exit(4);
}
print_var(&vinfo);
if (just_read)
goto L_OUT;
hbp = atoi(argv[1]);
hfp = atoi(argv[2]);
hsw = atoi(argv[3]);
vbp = atoi(argv[4]);
vfp = atoi(argv[5]);
vsw = atoi(argv[6]);
set_var(&vinfo, hbp, hfp, hsw, vbp, vfp, vsw);
ret = ioctl(fd, FBIOPUT_VSCREENINFO, &vinfo);
if (ret) {
perror("set to vga failed");
} else
print_var(&vinfo);
L_OUT:
close(fd);
return ret;
}
static Cmdret conf_variable(List *args, Cmdarg *ca)
{
log_msg("CONFIG", "conf_variable");
log_err("CONFIG", "%s", ca->cmdline->line);
/* statement needs valid name */
Token *lhs = tok_arg(args, 1);
char *key = list_arg(args, 1, VAR_STRING);
if (!lhs || !key)
return NORET;
/* find where '=' delimits statement */
int delm = -1;
for (int i = 0; i < utarray_len(args->items); i++) {
char *op = list_arg(args, i, VAR_STRING);
if (op && !strcmp(op, "=")) {
delm = i+1;
break;
}
}
if (delm == -1 || delm >= utarray_len(args->items))
return NORET;
char *expr = cmdline_line_from(ca->cmdline, delm);
fn_var var = {
.key = strdup(key),
.var = strdup(expr),
};
/* when delm isn't 3 the key should be expanded */
if (delm != 3) {
char *pvar = opt_var(key, cmd_callstack());
if (!pvar)
goto cleanup;
char *newexpr = repl_elem(pvar, expr, args, 2, delm - 1);
if (!newexpr)
goto cleanup;
SWAP_ALLOC_PTR(var.var, newexpr);
}
fn_func *blk = cmd_callstack();
if (!ca->flags)
blk = NULL;
set_var(&var, blk);
return NORET;
cleanup:
free(var.key);
free(var.var);
return NORET;
}
/*
* Returns 1 if bootenv.rc is modified or 0 if no modification was
* necessary. This allows us to implement non super-user look-up of
* variables by name without the user being yelled at for trying to
* modify the bootenv.rc file.
*/
static int
proc_var(char *name, eplist_t *list)
{
register char *val;
if ((val = strchr(name, '=')) == NULL) {
print_var(name, list);
return (0);
} else {
*val++ = '\0';
return (set_var(name, val, list));
}
}
/**
* tests fd() as well as chk_inst()
*/
static char * test_fd() {
Logo good, b_varnum, b_inst, b_chk_inst;
char *buffer;
int ret;
printf("Testing %s\n", __FUNCTION__);
/* good input */
good = setup(2, "FD 20");
insert_line(good, "FD A");
/* bad varnum */
b_varnum = setup(1, "FD AB");
/* bad instruction */
b_inst = setup(1, "RT 20");
/* test chk_inst error checking */
b_chk_inst = setup(1, "FD");
ret = fd(good);
mu_assert("error, ret != 0", ret == 0);
good->counter = good->counter + 1;
/* set the variable */
set_var("A", good->vars, 30.0);
ret = fd(good);
mu_assert("error, ret != 0", ret == 0);
tear_down(good);
/* expect postscript and test the output file */
char str[STR_LENGTH] = "";
char tmp[LINE_LENGTH];
sprintf(tmp, "%.2f 0 rlineto\n", 20 * LOGO2PS_FACTOR);
strcat(str, tmp);
sprintf(tmp, "%.2f 0 rlineto\n", 30 * LOGO2PS_FACTOR);
strcat(str, tmp);
buffer = get_content(TEST_OUT);
mu_assert("error, TEST_OUT is not as expected",
strcmp(buffer, str) == 0);
free(buffer);
ret = fd(b_varnum);
mu_assert("error, ret != PARSE_ERR", ret == PARSE_ERR);
tear_down(b_varnum);
ret = fd(b_inst);
mu_assert("error, ret != PARSE_ERR", ret == PARSE_ERR);
tear_down(b_inst);
ret = fd(b_chk_inst);
mu_assert("error, ret != PARSE_ERR", ret == PARSE_ERR);
tear_down(b_chk_inst);
return 0;
}
void syzygy(const ElementType& a, const ElementType& b,
ElementType &x, ElementType &y) const // remove?
// returns x,y s.y. x*a + y*b == 0.
// if possible, x is set to 1.
// no need to consider the case a==0 or b==0.
{
set_var(x,0); //set x=1
if(!is_zero(b))
{
set(y,a);
negate(y,y);
divide(y,y,b);
}
}
static void set_content(t_env *env, char *line)
{
char *var;
char *val;
static t_obj obj;
(void)env;
if (ft_strcmp(ft_strtrim(line), "{") && ft_strcmp(ft_strtrim(line), "}"))
{
var = get_info(line, &val);
set_var(ft_strtrim(var), val, &obj);
}
if (!ft_strcmp(ft_strtrim(line), "}"))
objpushback(env, &obj);
}
void op_pull(void)
{
if(zversion == 6) { /* v6 uses user stacks */
if(numoperands == 0 || operand[0] == 0)
mop_store_result(stack_pop());
else {
zword space = LOWORD(operand[0]) + 1; /* One more slot is free */
LOWORDwrite(operand[0], space);
mop_store_result(LOWORD(operand[0] + space * ZWORD_SIZE));
}
} else {
zword val = stack_pop();
set_var(operand[0], val);
}
}
Variable_ID Rel_Body::get_local(const Variable_ID v)
{
Global_Var_ID g;
if (v->kind() == Global_Var) {
g = v->get_global_var();
if (g->arity()) return get_local(g,v->function_of());
return get_local(g);
}
if (is_set()) return set_var(v->get_position());
if (v->kind() == Input_Var) return input_var(v->get_position());
if (v->kind() == Output_Var) return output_var(v->get_position());
assert(0 && "Can only get local for variable with global scope");
exit(1);
return 0;
}
/**
* tests varnum()
*/
static char * test_varnum() {
Logo good, b_var, b_number;
int ret;
float op;
printf("Testing %s\n", __FUNCTION__);
/* good input */
good = setup(4, "20");
/* decimals and negative numbers */
insert_line(good, "2.5");
insert_line(good, "-2.5");
insert_line(good, "A");
/* bad input */
b_var = setup(3, "AB");
/* non existant var */
insert_line(b_var, "C");
insert_line(b_var, "3-");
b_number = setup(1, "209x");
/* test them */
ret = varnum(good->lines[0], good, &op);
mu_assert("error, ret != 0", ret == 0);
mu_assert("error, op not set correctly", op == 20);
ret = varnum(good->lines[1], good, &op);
mu_assert("error, ret != 0", ret == 0);
mu_assert("error, op not set correctly", op == 2.5);
ret = varnum(good->lines[2], good, &op);
mu_assert("error, ret != 0", ret == 0);
mu_assert("error, op not set correctly", op == -2.5);
/* set the var A */
set_var("A", good->vars, 20);
ret = varnum(good->lines[3], good, &op);
mu_assert("error, ret != 0", ret == 0);
mu_assert("error, op not set correctly", op == 20);
ret = varnum(b_var->lines[0], b_var, &op);
mu_assert("error, ret != PARSE_ERR", ret == PARSE_ERR);
ret = varnum(b_var->lines[1], b_var, &op);
mu_assert("error, ret != VAR_ERR", ret == VAR_ERR);
ret = varnum(b_var->lines[2], b_var, &op);
mu_assert("error, ret != VAR_ERR", ret == PARSE_ERR);
ret = varnum(b_number->lines[0], b_number, &op);
mu_assert("error, ret != PARSE_ERR", ret == PARSE_ERR);
tear_down(good);
tear_down(b_var);
tear_down(b_number);
return 0;
}
int
config (int init)
{
FILE *f;
char *ptr, *var;
int len, line = 0;
char path[_POSIX_PATH_MAX];
char buf[1024];
snprintf (path, sizeof (path), "%s/config", Config_Dir);
if ((f = fopen (path, "r")))
{
log_message ("config: reading %s", path);
buf[sizeof buf - 1] = 0;
while (fgets (buf, sizeof (buf) - 1, f))
{
line++;
ptr = buf;
while (isspace (*ptr))
ptr++;
if (!*ptr || *ptr == '#')
continue;
len = strlen (ptr);
while (len > 0 && isspace (*(ptr + len - 1)))
len--;
*(ptr + len) = 0;
var = next_arg (&ptr);
if (!ptr)
{
log_message ("config: error in %s:%d: missing value", path, line);
continue;
}
if (set_var (var, ptr, init) != 0)
log_message ("config: error in %s, line %d", path, line);
}
fclose (f);
}
else if (errno != ENOENT)
{
logerr ("config", path);
return -1;
}
if (init)
config_user_level (get_str_var ("usermode"));
return 0;
}
int Control :: init_update(double tm)
{ set_var();
lvm.new_tab("EVENTS");
lvm.reg("Messages", send_message);
Component::RegMeta(lvm);
m_dpy = XOpenDisplay( NULL );
Keyboard::instance().setDisplay(m_dpy);
Mousedevice::instance().setDisplay(m_dpy);
Manager :: sendMessage(MSG_ACTIVE, nullptr, getNumQueue());
LOG_INFO("%s: second init.", getName());
do_update = (MUpdate)&Control::run_update;
return 1;
}
void run_commands(void)
{
if (send_now)
send_response();
if (send_hk)
send_housekeeping();
if (send_data)
send_sensor_data();
if (msg_received)
send_coms_packet();
if (read_response)
send_read_response();
if (write_response)
send_write_response();
if (set_sens_h)
set_sensor_high();
if (set_sens_l)
set_sensor_low();
if (set_varf)
set_var();
if (new_tm_msgf)
receive_tm_msg();
if (tc_packet_readyf)
send_pus_packet_tc();
if (event_readyf)
send_event();
if (ask_alive)
send_ask_alive();
if (enter_low_powerf)
enter_low_power();
if (exit_low_powerf)
exit_low_power();
if (enter_take_overf)
enter_take_over();
if (exit_take_overf)
exit_take_over();
if (pause_operationsf)
pause_operations();
if (resume_operationsf)
resume_operations();
return;
}
void take_func(struct var_struct * p, struct var_struct * q, int kind)
{
int i,j;
makesure(1,0);
if(kind<23) {
makesize(p, q->height, q->width);
makesure(1,0);
for(i=0;i<q->height;i++)
for(j=0;j<q->width;j++) {
switch(kind) {
case 0: p->p[i][j]=sin(q->p[i][j]); break;
case 1: p->p[i][j]=cos(q->p[i][j]); break;
case 2: p->p[i][j]=tan(q->p[i][j]); break;
case 3: p->p[i][j]=asin(q->p[i][j]); break;
case 4: p->p[i][j]=acos(q->p[i][j]); break;
case 5: p->p[i][j]=atan(q->p[i][j]); break;
case 6: p->p[i][j]=log10(q->p[i][j]); break;
case 7: p->p[i][j]=exp(q->p[i][j]); break;
case 8: p->p[i][j]=log(q->p[i][j]); break;
case 9: p->p[i][j]=factorial(q->p[i][j]); break;
case 10: p->p[i][j]=sinh(q->p[i][j]); break;
case 11: p->p[i][j]=cosh(q->p[i][j]); break;
case 12: p->p[i][j]=tanh(q->p[i][j]); break;
case 13: p->p[i][j]=asinh(q->p[i][j]); break;
case 14: p->p[i][j]=acosh(q->p[i][j]); break;
case 15: p->p[i][j]=atanh(q->p[i][j]); break;
case 16: p->p[i][j]=fabs(q->p[i][j]); break;
case 17: p->p[i][j]=(q->p[i][j]>0)?1:((q->p[i][j]<0)?-1:0); break;
case 18: p->p[i][j]=(q->p[i][j])*(q->p[i][j]); break;
case 19: p->p[i][j]=sqrt(q->p[i][j]); break;
case 20: p->p[i][j]=rint(q->p[i][j]); break;
case 21: p->p[i][j]=floor(q->p[i][j]); break;
case 22: p->p[i][j]=ceil(q->p[i][j]); break;
}
}
}
else {
switch(kind) {
case 23: set_var(p, envalue(q)); break;
case 24: inverse(p, q); break;
}
}
}
void string_funct( char s[] ){
if( !strncmp( "set", s, 3 ) ){
set_var( s[ 3 ] - 'a', pop() );
} else if( !strncmp( "get", s, 3 ) ){
push( get_var( s[ 3 ] - 'a' ) );
} else if( !strcmp( "last", s ) ){
push( last );
} else if( !strcmp( "fabs", s ) ){
push( fabs( pop() ) );
} else if( !strcmp( "sqrt", s ) ){
push( sqrt( pop() ) );
} else if( !strcmp( "pow", s ) ){
double op2;
op2 = pop();
if( op2 != 0.0 )
push( pow( pop(), op2 ) );
else
printf( "error: op1 igual a cero\n" );
} else printf( "error: %s comando no soportado\n", s );
}
int main()
{
unsigned char* ptr = Program;
/* так можно размещать перемнные до запуска ВМ */
add_var("pi");
set_var("pi", 3.14159265);
/* так создаются пермеменные в программе ВМ */
put_commd(&ptr, CNVAR); put_strng(&ptr, "x1");
put_commd(&ptr, CPUSH); put_value(&ptr, 2.0);
put_commd(&ptr, CSVAR); put_strng(&ptr, "x1");
/* вычисление выражения (2.3+4.7)*2.1 */
put_commd(&ptr, CPUSH); put_value(&ptr, 2.3);
put_commd(&ptr, CPUSH); put_value(&ptr, 4.7);
put_commd(&ptr, CADD);
put_commd(&ptr, CPUSH); put_value(&ptr, 2.1);
put_commd(&ptr, CMULT);
/* делим результат на Pi */
put_commd(&ptr, CGVAR); put_strng(&ptr, "pi");
put_commd(&ptr, CDIV);
/* умножаем на x1 */
put_commd(&ptr, CGVAR); put_strng(&ptr, "x1");
put_commd(&ptr, CMULT);
/* выводим результат, останавливаем машину */
put_commd(&ptr, COUT);
put_commd(&ptr, CHALT);
vmin = stdin;
vmout = stdout;
run();
return 1;
}
static int
c_dfe (cilist64 *a, unit **fu)
{
unit *ftnunit;
extern FILE *debugfile;
if ((ftnunit = *fu = find_luno (a->ciunit)) == NULL)
if (fk_open (DIR, FMT, a->ciunit))
err(a->cierr, 104, "dfe");
while (fu != &f77curunit && test_and_set( &ftnunit->lock_unit, 1L ))
;
ftnunit->f77errlist.cierr = a->cierr;
ftnunit->f77errlist.ciend = a->ciend;
ftnunit->f77errlist.cieor = a->cieor;
ftnunit->f77errlist.cisize = a->cisize;
ftnunit->f77errlist.iciunit = 0;
ftnunit->f77cursor = ftnunit->f77recpos = ftnunit->f77recend = 0;
ftnunit->f77scale = 0;
ftnunit->ufd = ftnunit->ufd;
if (!ftnunit->ufmt)
err(a->cierr, 102, "dfe")
if (!ftnunit->useek)
err(a->cierr, 104, "dfe")
if (a->cirec < 1)
err(a->cierr, 168, "dfe");
ftnunit->f77fmtbuf = a->cifmt;
/* fprintf( debugfile, "At position %d for thread %d, oldrec = %d, newrec = %d\n", ftell( ftnunit->ufd ), mp_my_threadnum_(), ftnunit->uirec, a->cirec ); */
if (FSEEK (ftnunit->ufd, (ftnll)ftnunit->url * (a->cirec - 1), 0))
err( a->cierr, errno, "Direct formatted");
if (ftnunit->uassocv)
set_var ((ftnintu *)ftnunit->uassocv,
ftnunit->umask, ASSOCV, a->cirec);
ftnunit->uend = 0;
return (0);
}
int smtp_start(int notify)
{
char hostname[BIG_BUF];
clean_var("smtp-last-error", VAR_TEMP);
notify_type = notify;
my_socket = -1;
servercaps = 0;
receipients = 0;
build_hostname(hostname,sizeof(hostname));
if(!try_connect_EHLO(hostname)) {
if(!try_connect_HELO(hostname)) {
if(my_socket != -1)
sock_close(my_socket);
my_socket = -1;
set_var("smtp-last-error", "Error connecting to SMTP server.", VAR_TEMP);
return 0;
}
}
return 1;
}
double eval_expression(Node* root) {
switch (root->type) {
case AFFECTATION:
set_var(root->children[0]->var, root->children[1]);
return eval_expression(root->children[0]);
case NOMBRE:
return root->val;
case VARIABLE:
return root->var->value;
case PLUS:
return eval_expression(root->children[0]) + eval_expression(root->children[1]);
case MOINS:
return eval_expression(root->children[0]) - eval_expression(root->children[1]);
case MULT:
return eval_expression(root->children[0]) * eval_expression(root->children[1]);
case DIVISION:
return eval_expression(root->children[0]) / eval_expression(root->children[1]);
case SUPERIOR:
return (eval_expression(root->children[0]) > eval_expression(root->children[1]));
case INFERIOR:
return (eval_expression(root->children[0]) < eval_expression(root->children[1]));
case EQUAL:
return (eval_expression(root->children[0]) == eval_expression(root->children[1]));
case DIFFERENT:
return (eval_expression(root->children[0]) != eval_expression(root->children[1]));
case SUPERIOR_EQUAL:
return (eval_expression(root->children[0]) >= eval_expression(root->children[1]));
case INFERIOR_EQUAL:
return (eval_expression(root->children[0]) <= eval_expression(root->children[1]));
default:
printf("Error: unknown expression type: %d\n", root->type);
break;
}
}
int calc_main()
{
char cmd[1005];
char history[HIST][1005];
char einfo[20][30]={
"",
"",
"矩阵太大",
"矩阵宽度不一致",
"矩阵长度不一致",
"矩阵大小不一致",
"除数不能为0",
"底数必须为正数",
"必须为正方矩阵",
"越界错",
"矩阵长度必须为1",
"表达式出错",
"操作数必须不为矩阵",
"该矩阵无法求逆",
"变量名称错",
"变量数目过多",
"矩阵输入错误",
"单步值不能为0",
"表达式出错",
""};
int y,x,res,i,ch,hi,oldmode;
oldmode=uinfo.mode;
modify_user_mode(CALC);
for(i=0;i<HIST;i++) history[i][0]=0;
res = get_var("res");
set_var(vars+get_var("%pi"), Pi);
set_var(vars+get_var("%e"), exp(1));
clear();
outline("欢迎使用超级计算器1.0 作者:[email protected]\n");
outline("输入exit退出，输入help帮助\n\n");
while(1) {
hi=0;
getyx(&y, &x);
cmd[0]=0;
do{
UPDOWN = true;
ch = multi_getdata(y, x, scr_cols-1, "> ", cmd, 995, 13, 0,0 );
UPDOWN = false;
if(ch==-KEY_UP) {
if(hi==HIST) cmd[0]=0;
else strncpy(cmd, history[hi], 1000);
hi++; if(hi>HIST) hi=0;
} else if(ch==-KEY_DOWN) {
hi--; if(hi<0) hi=HIST;
if(hi==HIST) cmd[0]=0;
else strncpy(cmd, history[hi], 1000);
}
} while(ch<0);
y = y-1+ch;
if(y>=scr_lns) y = scr_lns-1;
move(y, 0);
outline("\n");
if(!cmd[0]) continue;
if(!strncasecmp(cmd, "exit", 5)) break;
if(!strncasecmp(cmd, "quit", 5)) break;
for(i=HIST-1;i>0;i--)
strncpy(history[i],history[i-1],1000);
strncpy(history[0],cmd,1000);
if(!strncasecmp(cmd, "help", 5)||!strncasecmp(cmd, "?", 2)) {
outline("变量: 1到6个字母,例如x=3\n");
outline("常量: %pi, %e\n");
outline("矩阵: [3,4;5,6] a(3:4,1:5:2) 1:5:0.5\n");
outline("函数: sin,cos,tan,asin,acos,atan,log,exp,ln,fact,\n");
outline(" sinh,cosh,tanh,asinh,acosh,atanh\n");
outline(" abs,sign,sqr,sqrt,round,floor,ceil\n");
outline(" det,inv\n");
outline("操作: + - * / ^ '(转置) .*(矩阵乘) ./(矩阵除) \n");
continue;
}
if(strchr(cmd, '=')) {
i=strchr(cmd, '=')-cmd;
if(i<=0||!check_var_name(cmd, i)) {
calcerr=19;
goto checkcalcerr;
}
cmd[i]=0;
res = get_var(cmd);
i++;
}
else {
res = get_var("res");
i=0;
}
eval(vars+res, cmd+i, 0, strlen(cmd+i)-1);
checkcalcerr:
if(calcerr) {
outline(einfo[calcerr]);
outline("\n");
calcerr=0;
continue;
}
else
print_var(vars+res);
}
for(i=0;i<vart;i++)
del(vars+i);
modify_user_mode(oldmode);
return 0;
}
void eval(struct var_struct * p, char * s, int l, int r)
{
int i,j,n;
char op[9]=";, +-*/^E";
char buf[1000];
while(s[l]==' '&&l<=r) l++;
while(s[r]==' '&&l<=r) r--;
makesure(l<=r,11);
while((s[l]=='('&&s[r]==')'&&get_rl(s,r,l)==l)||
(s[l]=='['&&s[r]==']'&&get_rl3(s,r,l)==l)) {
l++; r--;
while(s[l]==' '&&l<=r) l++;
while(s[r]==' '&&l<=r) r--;
}
if(check_var_name(s+l, r-l+1)||(s[l]=='%'&&check_var_name(s+l+1, r-l))) {
strncpy(buf, s+l, 1000);
buf[r-l+1]=0;
i=get_var(buf);
copy_var(vars+i, p);
return;
}
if(check_var_double(s+l, r-l+1)) {
double f;
strncpy(buf, s+l, 1000);
buf[r-l+1]=0;
f = atof(buf);
set_var(p, f);
return;
}
if(check_var_array(s+l, r-l+1)) {
double f1,f2,f3;
strncpy(buf, s+l, 1000);
buf[r-l+1]=0;
i=check_var_array(s+l,r-l+1);
if(buf[0]==':'&&!buf[1]) {
p->p=0;
return;
}
else if(i==1) {
sscanf(buf, "%lf:%lf", &f1, &f2);
if(f1<f2) f3=1; else f3=-1;
}
else {
sscanf(buf, "%lf:%lf:%lf", &f1, &f2, &f3);
if(fabs(f3)<MINIMUM) {
calcerr=17;
return;
}
if((f2-f1)/f3<0) f3=-f3;
}
if(f3>0)
makesize(p, 1, (int)((f2-f1+MINIMUM)/f3)+1);
else
makesize(p, 1, (int)((f2-f1-MINIMUM)/f3)+1);
makesure(1,0);
i=0;
do{
p->p[0][i]=f1;
f1+=f3;
i++;
if(i>p->width) break;
}while((f1-MINIMUM<=f2&&f3>0)||(f1+MINIMUM>=f2&&f3<0));
return;
}
i=l;
while(isalpha(s[i])&&i<=r) i++;
if(i>l&&s[i]=='('&&s[r]==')'&&get_rl(s,r,l)==i) {
struct var_struct u,v;
u.p=0; v.p=0;
strncpy(buf, s+l, 1000);
buf[i-l]=0;
j=0;
while(funcname[j][0]) {
if(!strncasecmp(funcname[j],buf,10)) break;
j++;
}
if(funcname[j][0]) {
eval(&u, s, i+1, r-1);
makesure(1,0);
take_func(p, &u, j);
del(&u);
}
else {
int k;
char* kk;
j=get_var(buf);
strncpy(buf, s+i+1, 1000);
buf[r-1-i]=0;
kk=strchr(buf, ',');
if(!kk) {
calcerr=18;
return;
}
k=kk-buf;
eval(&u, buf, 0, k-1);
makesure(1,0);
eval(&v, buf, k+1, strlen(buf)-1);
makesure(1,0);
selmatrix(vars+j, &u, &v, p);
del(&u);
del(&v);
}
return ;
}
for(j=0;j<9;j++) {
n=r;
do{
if(toupper(s[n])==op[j]) {
struct var_struct m1,m2,m3;
m1.p=0; m2.p=0; m3.p=0;
if(n>l&&s[n-1]=='.'&&(j==4||j==5||j==6)) eval(&m1,s,l,n-2);
else eval(&m1,s,l,n-1);
makesure(1,0);
eval(&m2,s,n+1,r);
makesure(1,0);
switch(j) {
case 0:
link_h(&m1, &m2, p);
break;
case 1:
case 2:
link_w(&m1, &m2, p);
break;
case 3:
add_var(&m1, &m2, p);
break;
case 4:
sub_var(&m1, &m2, p);
break;
case 5:
if(n>l&&s[n-1]=='.') domatrix(&m1,&m2,p,4);
else mul_var(&m1, &m2, p);
break;
case 6:
if(n>l&&s[n-1]=='.') domatrix(&m1,&m2,p,5);
else {
inverse(&m3, &m2);
mul_var(&m1, &m3, p);
del(&m3);
}
break;
case 7:
if(n>l&&s[n-1]=='.') domatrix(&m1,&m2,p,6);
else {
makesure(is_single_var(&m1)&&is_single_var(&m2),12);
makesure((**(m1.p))>0,7);
set_var(p, exp(log(**(m1.p))*(**(m2.p))));
}
break;
case 8:
makesure(is_single_var(&m1)&&is_single_var(&m2),12);
set_var(p, exp(log(10)*(**(m2.p)))*(**m1.p));
break;
}
del(&m1);
del(&m2);
return;
}
if(s[n]==')') n=get_rl(s,n,l);
if(s[n]==']') n=get_rl3(s,n,l);
n--;
}while(n>=l);
}
if(s[r]=='\'') {
struct var_struct m;
m.p = 0;
eval(&m, s, l, r-1);
makesure(1,0);
reverse(&m,p);
del(&m);
return;
}
calcerr=18;
}
int* setbind(struct Item* list, char* name, int value)
{
return &(set_var(list, name, value)->value);
}
static int
f_rew_com (alist *a, int lock)
{
unit *ftnunit;
if ((ftnunit = find_luno (a->aunit)) == NULL)
return(0);
while (lock && test_and_set( &ftnunit->lock_unit, 1L ))
;
if (ftnunit->uacc == KEYED)
errret(a->aerr, 164, "rewind");
if (ftnunit->uconn <= 0) {
ftnunit->lock_unit = 0;
return (0);
}
if (!ftnunit->useek && !ftnunit->uistty)
errret(a->aerr, 106, "rewind");
ftnunit->uend = 0;
/* Need to reset the associate variable to 1 if exists */
if (ftnunit->uassocv)
set_var (ftnunit->uassocv, ftnunit->umask, ASSOCV, (ftnll) 1);
/* Rewind of a direct unformatted file. */
if ((ftnunit->uacc == DIRECT) && (ftnunit->ufmt == 0)) {
if (-1 == lseek ((int) ftnunit->ufd, 0, SEEK_SET)) {
errret(a->aerr, 106, "rewind");
}
/* need to change the internal buffer position in fio_direct_io as well */
_fio_set_seek((int) ftnunit->ufd, (ftnll) 0, 0);
ftnunit->uirec = 0;
ftnunit->lock_unit = 0;
return (1);
}
#ifdef I90
/* Make sure these variables are zeroed out to allow record to be reread. */
ftnunit->f77recpos = 0;
ftnunit->f77recend = 0;
#endif
if (f77vms_flag_[VMS_EF]) { /* rewind to the last endfile record
* or beginning of file */
char buf[513];
XINT64 y, x;
int i, n;
char ch;
/* If last operation was a WRITE, truncate the file and then make
sure that the file mode is switched to READ so the the next
REWIND/BACKSPACE won't truncate the file again
*/
if (ftnunit->uwrt & WR_OP) {
#ifdef I90
/* If in Fortran-90 nonadvancing mode, write endfile record (\n only). */
if (ftnunit->f90sw == 1 && ftnunit->f90nadv == 1 ) {
putc ('\n', ftnunit->ufd);
ftnunit->f90nadv = 0;
}
#endif
(void) t_runc (ftnunit, a->aerr);
/* If the file is in write-only mode make sure that it is readable */
if (f77nowreading(ftnunit))
errret(a->aerr, 106, "rewind");
}
if (ftnunit->ufmt != 1) {
if (ftell (ftnunit->ufd) == 0) {
ftnunit->lock_unit = 0;
return (0); /* already at beginning of file */
}
if (fseek (ftnunit->ufd, (long) (-sizeof (int)), 1) < 0)
errret(a->aerr, 106, "rewind");
for (i = 0;; i++) {
(void) fread ((char *) &n, sizeof (int), 1, ftnunit->ufd);
if (n != 1 || i == 0) {
if (fseek (ftnunit->ufd, (long) (-n - 3 * sizeof (int)), 1)) {
rewind (ftnunit->ufd);
ftnunit->lock_unit = 0;
return (0);
}
} else {
if (fseek (ftnunit->ufd, -(sizeof (int) + 1), 1)) {
rewind (ftnunit->ufd);
ftnunit->lock_unit = 0;
return (0);
}
(void) fread ((char *) &ch, 1, 1, ftnunit->ufd);
if (ch == '\032') {
fseek (ftnunit->ufd, sizeof (int), 1);
ftnunit->lock_unit = 0;
return (0);
}
fseek (ftnunit->ufd, -(2 * sizeof (int) + 1), 1);
}
}
}
y = x = FTELL (ftnunit->ufd) - 2; /* skip the last endfile
* record */
if (y < 0) {
(void) fseek(ftnunit->ufd, 0L, 0);
ftnunit->lock_unit = 0;
return(0);
}
ch = '\0';
for (;;) {
if (x < sizeof (buf) - 1)
x = 0;
else
x -= sizeof (buf) - 1;
(void) FSEEK (ftnunit->ufd, x, 0);
n = (int) fread (buf, 1, (int) (y - x), ftnunit->ufd);
buf[n] = ch;
for (i = n - 1; i >= 1; i--) {
if (buf[i] != '\032' || buf[i + 1] != '\n')
continue;
(void) fseek (ftnunit->ufd, (long) (i + 2 - n), 1);
ftnunit->lock_unit = 0;
return (0);
}
if (x == 0) {
(void) fseek (ftnunit->ufd, 0L, 0);
ftnunit->lock_unit = 0;
return (0);
}
y = x;
ch = buf[0];
}
}
/* If last operation was a WRITE, truncate the file and then make
sure that the file mode is switched to READ so the the next
REWIND/BACKSPACE won't truncate the file again
*/
if (ftnunit->uwrt & WR_OP) {
#ifdef I90
/* If in Fortran-90 nonadvancing mode, write endfile record (\n only). */
if (ftnunit->f90sw == 1 && ftnunit->f90nadv == 1 ) {
putc ('\n', ftnunit->ufd);
ftnunit->f90nadv = 0;
}
#endif
(void) t_runc (ftnunit, a->aerr);
/* If the file is in write-only mode make sure that it is readable */
if (f77nowreading(ftnunit))
errret(a->aerr, 106, "backspace");
}
rewind (ftnunit->ufd);
ftnunit->lock_unit = 0;
return (0);
}
f_inqu0_com (inlist *a, int *mask, int lock)
#endif
{
flag byfile;
flag sysfile = 0; /* set this flag if the file name is
* "SYS$*" */
int i;
char buf[PATH_MAX], *abuf;
int x = 0;
ino_t inod;
unit *ftnunit;
if (a->infile != NULL) {
char *flname;
flname = a->infile;
byfile = 1;
if (flname[3] == '$' && _I90_uppercase(flname, buf) &&
(!strcmp (buf, "SYS$INPUT") || !strcmp (buf, "SYS$OUTPUT")
|| !strcmp (buf, "SYS$ERROR")))
sysfile = 1;
if (a->indefaultfile) {
g_char (a->indefaultfile, a->indefaultfilelen, buf);
abuf = buf + strlen (buf);
} else
abuf = buf;
g_char (a->infile, a->infilen, abuf);
/* bug fix 12983 */
x = f77inode (buf, &inod);
if (x < 0) {
mkidxname (buf, buf);
x = f77inode (buf, &inod);
}
if (strlen (buf) > PATH_MAX) {
/* can't use err() with inquire since f77curunit is never defined
by a call to map_luno
err (a->inerr, 145, "inquire");
*/
if (a->inerr) {
return(errno=F_ERFNAME);
} else {
fprintf(stderr, "Error in INQUIRE: file name too long: %s\n", buf);
_cleanup ();
exit(F_ERFNAME);
}
}
ftnunit = NULL;
if (x < 0)
goto setvar;
for (i = 0; i < mxunit; i++) /* sjc #1963 11Dec 87 */
if (f77units[i].uinode == inod && f77units[i].uconn > 0) {
ftnunit = &f77units[i];
/*
while (lock && test_and_set( &ftnunit->lock_unit, 1L ))
;
*/
break;
}
} else {
byfile = 0;
ftnunit = map_luno (a->inunit);
/*
while (lock && test_and_set( &ftnunit->lock_unit, 1L ))
;
*/
}
setvar:
if (a->inex)
/* Fix BN 11327 .
* If the file name is SYS$* then the file always exists. The sysfile
* flag gets set above and hence when a user does and inquire with EXIST, then
* the exist variable will be set .
*
* ---ravi---1/16/92
*/
set_var (a->inex, *mask, INEX,
(byfile && x > 0 || !byfile && ftnunit != NULL || sysfile) ? 1 : 0);
if (a->inopen)
set_var (a->inopen, *mask, INOPEN, byfile ? (ftnunit != NULL) : (ftnunit && ftnunit->uconn > 0));
if (a->innum)
set_var (a->innum, *mask, INNUM, ftnunit ? ftnunit->luno : 0);
if (a->innamed)
set_var (a->innamed, *mask, INNAMED,
(byfile || ftnunit != NULL && ftnunit->ufnm != NULL) ? 1 : 0);
if (a->inname != NULL)
if (byfile)
b_char (buf, a->inname, a->innamlen);
else if (ftnunit != NULL && ftnunit->ufnm != NULL)
b_char (ftnunit->ufnm, a->inname, a->innamlen);
else
b_char ("", a->inname, a->innamlen);
if (a->inacc)
if (ftnunit && ftnunit->uconn > 0)
switch (ftnunit->uacc) {
case SEQUENTIAL:
b_char ("SEQUENTIAL", a->inacc, a->inacclen);
break;
case DIRECT:
b_char ("DIRECT", a->inacc, a->inacclen);
break;
case KEYED:
b_char ("KEYED", a->inacc, a->inacclen);
break;
default:
b_char ("UNKNOWN", a->inacc, a->inacclen);
}
else
b_char ("UNKNOWN", a->inacc, a->inacclen);
if (a->inseq != NULL)
if (ftnunit)
b_char ((ftnunit->uacc == SEQUENTIAL) ? "YES" : "NO",
a->inseq, a->inseqlen);
else
b_char ("UNKNOWN", a->inseq, a->inseqlen);
if (a->indir != NULL)
if (ftnunit)
b_char ((ftnunit->uacc == DIRECT) ? "YES" : "NO",
a->indir, a->indirlen);
else
b_char ("UNKNOWN", a->indir, a->indirlen);
if (a->infmt != NULL)
if (ftnunit)
if (!ftnunit->ufmt)
b_char ("UNFORMATTED", a->infmt, a->infmtlen);
else if (ftnunit->ufmt == 1)
b_char ("FORMATTED", a->infmt, a->infmtlen);
else
b_char ("BINARY", a->infmt, a->infmtlen);
else
b_char ("UNKNOWN", a->infmt, a->infmtlen);
if (a->inform != NULL)
if (ftnunit)
b_char (ftnunit->ufmt > 0 ? "YES" : "NO", a->inform, a->informlen);
else
b_char ("UNKNOWN", a->inform, a->informlen);
if (a->inunf)
if (ftnunit)
b_char (ftnunit->ufmt > 0 ? "NO" : "YES", a->inunf, a->inunflen);
else
b_char ("UNKNOWN", a->inunf, a->inunflen);
if (a->inrecl)
set_var (a->inrecl, *mask, INRECL,
(int) (ftnunit ? (ftnunit->ufmt || f77vms_flag_[OLD_RL] ?
ftnunit->url : ftnunit->url / sizeof (int)) : 0));
if (a->innrec) {
/* CALVIN: need to determine if a->innrec points to a *4 or a *8 */
if (ftnunit && (ftnunit->uacc == DIRECT) && (ftnunit->ufmt == 0)) {
set_var (a->innrec, *mask, INNREC,
(ftnunit && ftnunit->uacc == DIRECT && ftnunit->url) ? ftnunit->uirec + 1 : 0);
} else {
set_var (a->innrec, *mask, INNREC,
(ftnunit && ftnunit->uacc == DIRECT && ftnunit->url) ? ftell (ftnunit->ufd) / ftnunit->url + 1 : 0);
}
}
if (a->inblank)
if (ftnunit && ftnunit->ufmt > 0)
b_char (ftnunit->ublnk ? "ZERO" : "NULL", a->inblank, a->inblanklen);
else
b_char ("UNKNOWN", a->inblank, a->inblanklen);
if (a->incc)
if (ftnunit && ftnunit->ufmt > 0)
switch (ftnunit->ucc) {
case CC_FORTRAN:
b_char ("FORTRAN", a->incc, a->incclen);
break;
case CC_LIST:
b_char ("LIST", a->incc, a->incclen);
break;
case CC_NONE:
b_char ("NONE", a->incc, a->incclen);
break;
default:
b_char ("UNKNOWN", a->incc, a->incclen);
}
else
b_char ("UNKNOWN", a->incc, a->incclen);
if (a->inkeyed)
if (ftnunit)
b_char (ftnunit->uacc == KEYED ? "YES" : "NO", a->inkeyed, a->inkeyedlen);
else
b_char ("UNKNOWN", a->inkeyed, a->inkeyedlen);
if (a->inorg)
if (ftnunit)
switch (ftnunit->uacc) {
case SEQUENTIAL:
b_char ("SEQUNTIAL", a->inorg, a->inorglen);
break;
case DIRECT:
b_char ("RELATIVE", a->inorg, a->inorglen);
break;
case KEYED:
b_char ("INDEXED", a->inorg, a->inorglen);
break;
default:
b_char ("UNKNOWN", a->inorg, a->inorglen);
}
else
b_char ("UNKNOWN", a->inorg, a->inorglen);
if (a->inrecordtype)
if (ftnunit)
switch (ftnunit->uacc) {
case SEQUENTIAL:
b_char (ftnunit->ufmt == 1 ? "STREAM_LF" : "VARIABLE",
a->inrecordtype, a->inrecordtypelen);
break;
case DIRECT:
case KEYED:
b_char ("FIXED", a->inrecordtype, a->inrecordtypelen);
break;
default:
b_char ("UNKNOWN", a->inrecordtype, a->inrecordtypelen);
}
else
b_char ("UNKNOWN", a->inrecordtype, a->inrecordtypelen);
/*
if (ftnunit) {
ftnunit->lock_unit = 0;
}
*/
return (0);
}
Variable::Variable(double var) {
set_var(var);
}
void FSM_Proc(u8 key)
{
if(key!=0)
{
Key_Value=key;
DISP_Update=1;
goto Parse;
}
Key_Value=update_key();
if(Key_Value==0)
{
return ;
}
DISP_Update=1;
/****GoBack******/
Parse:
if(Key_Value==MENU_KEY_B)
{
Key_Cmd_Length=0;
if(FSM_VAL==DISP_MENU41||FSM_VAL==DISP_MENU42)
{
FSM_VAL=0;
return ;
}
if(GETMENU4!=MENU_NULL)
{
CLEAR_MENU(4);
}else if(GETMENU3!=MENU_NULL)
{
CLEAR_MENU(3);
}else if(GETMENU2!=MENU_NULL)
{
CLEAR_MENU(2);
}
else if(GETMENU1!=MENU_NULL)
{
CLEAR_MENU(1);
}
return ;
}
if(GETMENU4!=MENU_NULL)
{
if(Key_Value==MENU_KEY_Y&&Key_Cmd_Length>0)
{
aPoints[curve_current_len++].y=Key_Cmd_Length==2?Key_Cmd_Value[0]*10+Key_Cmd_Value[1]:Key_Cmd_Value[0];
Key_Cmd_Length=0;
FSM_VAL=DISP_MENU41;
}
else if(IS_KEY_NUM(Key_Value))
{
if(Key_Cmd_Length==2)
{
return ;
}
Key_Cmd_Value[Key_Cmd_Length++]=Key_Value-'0';
}
}else if(GETMENU3!=MENU_NULL)
{
if(Key_Value==MENU_KEY_Y&&Key_Cmd_Length>0)
{
if(getValue()!=-1)
{
if(curve_current_len>0)
{
if(getValue()<=aPoints[curve_current_len-1].x)
{
goto BACK2MENU41;
}
}
aPoints[curve_current_len].x=getValue();
SET_MENU(4,1);
}else
{
BACK2MENU41:
FSM_VAL=DISP_MENU41;
}
Key_Cmd_Length=0;
}
else if(IS_KEY_NUM(Key_Value))
{
if(Key_Cmd_Length==4)
{
return ;
}
Key_Cmd_Value[Key_Cmd_Length++]=Key_Value-'0';
}
}else if(GETMENU2!=MENU_NULL)//已点二级菜单
{
switch(GETMENU1)//
{
case MENU1_SET_ALARM:
switch(GETMENU2)
{
case MENU_SUB1:
if(set_var(Key_Value,&_tmp))
{
PID_alarm_MIN=_tmp;
RESTRAINALARM_MIN(PID_alarm_MIN)
RESTRAIN_LH(PID_alarm_MIN,PID_alarm_MAX);
AT24CXX_Write(TARGET_MIN_STORGE_ADDR,(u8*)&PID_alarm_MIN,sizeof(PID_alarm_MIN));
}
break;
case MENU_SUB2:
if(set_var(Key_Value,&_tmp))
{
PID_alarm_MAX=_tmp;
RESTRAINALARM_MAX(PID_alarm_MAX)
RESTRAIN_LH(PID_alarm_MIN,PID_alarm_MAX);
AT24CXX_Write(TARGET_MAX_STORGE_ADDR,(u8*)&PID_alarm_MAX,sizeof(PID_alarm_MAX));
}
break;
}
break;
case MENU1_SET_HEATER:
switch(GETMENU2)
{
case MENU_SUB1:
set_var(Key_Value,&PID_output);
break;
}
case MENU1_SET_CURVE:
switch(GETMENU2)
{
case MENU_SUB1:
if(Key_Value==MENU_KEY_Y)
{
SET_MENU(3,1);
}else if(Key_Value==MENU_KEY_2)
{
if(Curve_Top>1)
{
Curve_Top--;
}
}else if(Key_Value==MENU_KEY_8||Key_Value==MENU_KEY_5)
{
if(Curve_Top<curve_current_len)
{
Curve_Top++;
}
}
break;
case MENU_SUB2:
break;
case MENU_SUB3:
break;
}
break;
}
}else if(GETMENU1!=MENU_NULL)//已点一级菜单
{
switch(GETMENU1)
{
case MENU1_SET_ALARM:
if(Key_Value==MENU_KEY_1||Key_Value==MENU_KEY_2)
{
SET_MENU(2,Key_Value-'0');
}
break;
case MENU1_SET_TEMP:
//输入的是设定温度
if(set_var(Key_Value,&PID_target))
{
AT24CXX_Write(TARGET_STORGE_ADDR,(u8*)&PID_target,sizeof(PID_target));
}
break;
case MENU1_SET_HEATER:
//输入的是加热功率
if(Key_Value==MENU_KEY_1)
{
forceMANUAL=1;
PID.SetMode(MANUAL);
SET_MENU(2,Key_Value-'0');
}else if(Key_Value==MENU_KEY_2)
{
forceMANUAL=0;
PID.SetMode(AUTOMATIC);
FSM_VAL=0;
}
//set_var(Key_Value,&PID_output);
break;
case MENU1_SET_CURVE:
if(Key_Value==MENU_KEY_1||Key_Value==MENU_KEY_2||Key_Value==MENU_KEY_3)
{
SET_MENU(2,Key_Value-'0');
}
if(Key_Value==MENU_KEY_2)
{
AccordingCurve=1;
curveStartTime=millis();
}
break;
}
}else//IDLE状态
{
if(Key_Value==MENU_KEY_1||Key_Value==MENU_KEY_2||Key_Value==MENU_KEY_3||Key_Value==MENU_KEY_4)
{
SET_MENU(1,Key_Value-'0');
}
}
}
//TODO check number of arguments given to builtins
object_t *eval(object_t *exp, object_t *env) {
char comeback = 1;
while(comeback) {
comeback = 0;
if(is_self_evaluating(exp)) {
return exp;
}
if(list_begins_with(exp, quote_symbol)) {
return cadr(exp);
}
// (define... )
if(list_begins_with(exp, define_symbol)) {
object_t *var = cadr(exp);
// (define a b)
if(issymbol(var)) {
object_t *val = caddr(exp);
return define_var(env, var, val);
}
// (define (a ...) ...) TODO use scheme macro
if(ispair(var)) {
object_t *name = car(cadr(exp)),
*formals = cdr(cadr(exp)),
*body = cddr(exp),
*lambda = cons(lambda_symbol,
cons(formals, body));
exp = cons(define_symbol,
cons(name, cons(lambda, empty_list)));
comeback = 1;
continue;
}
fprintf(stderr, "Syntax error.\n");
exit(-1);
}
// (set! a b)
if(list_begins_with(exp, set_symbol)) {
object_t *var = cadr(exp);
object_t *val = caddr(exp);
return set_var(env, var, val);
}
// (if c a b)
if(list_begins_with(exp, if_symbol)) {
exp = eval_if(env, cadr(exp), caddr(exp), cadddr(exp));
comeback = 1;
continue;
}
// (cond ...)
if(list_begins_with(exp, cond_symbol)) {
object_t *tail = cons(void_symbol, empty_list);
object_t *ifs = tail; //empty_list;
object_t *rules = reverse_list(cdr(exp));
while(!isemptylist(rules)) {
object_t *rule = car(rules),
*condition = car(rule),
*consequence = cadr(rule);
if(isemptylist(consequence)) {
consequence = cons(void_obj, empty_list);
}
ifs = cons(if_symbol,
cons(condition,
cons(consequence,
cons(ifs, empty_list))));
rules = cdr(rules);
}
exp = ifs;
comeback = 1;
continue;
}
// (begin ...)
if(list_begins_with(exp, begin_symbol)) {
object_t *result = empty_list, *exps;
for(exps = cdr(exp); ! isemptylist(exps); exps = cdr(exps)) {
result = eval(car(exps), env);
}
return result;
}
if(list_begins_with(exp, lambda_symbol)) {
object_t *fn = cons(begin_symbol,
cdr(cdr(exp)));
return make_compound_proc(empty_list, cadr(exp),
fn,
env);
}
// (let ...)
if(list_begins_with(exp, let_symbol)) {
//if(! issymbol(cadr(exp)))
object_t *bindings = cadr(exp);
object_t *body = cddr(exp);
object_t *formals = empty_list;
object_t *values = empty_list;
while(!isemptylist(bindings)) {
formals = cons(caar(bindings), formals);
values = cons(cadr(car(bindings)), values);
bindings = cdr(bindings);
}
exp = cons(cons(lambda_symbol, cons(formals, body)),
values);
comeback = 1;
continue;
}
if(issymbol(exp)) {
return var_get_value(env, exp);
}
if(ispair(exp)) {
object_t *exp_car = car(exp);
object_t *fn = eval(exp_car, env); //var_get_value(env, car);
if(!iscallable(fn)) {
fprintf(stderr, "object_t is not callable\n");
exit(-1);
}
object_t *args = cdr(exp);
object_t *evaluated_args = evaluate_list(env, args, empty_list);
if(isprimitiveproc(fn)) {
return fn->value.prim_proc.fn(evaluated_args);
} else if(iscompoundproc(fn)) {
object_t *fn_formals = fn->value.compound_proc.formals;
object_t *fn_body = fn->value.compound_proc.body;
object_t *fn_env = fn->value.compound_proc.env;
ARGS_EQ(evaluated_args, list_size(fn_formals));
exp = fn_body;
env = extend_environment(fn_formals, evaluated_args, fn_env);
comeback = 1;
continue;
}
assert(0);
}
}
fprintf(stderr, "Unable to evaluate expression: \n");
write(exp);
exit(-1);
}
