110 |
return 1; |
return 1; |
111 |
} |
} |
112 |
|
|
113 |
|
/* Push a value onto the stack */ |
114 |
|
void push_val(stackitem **stack_head, value *val) |
115 |
|
{ |
116 |
|
stackitem *new_item= malloc(sizeof(stackitem)); |
117 |
|
new_item->item= val; |
118 |
|
val->refcount++; |
119 |
|
push(stack_head, new_item); |
120 |
|
} |
121 |
|
|
122 |
/* Push an integer onto the stack. */ |
/* Push an integer onto the stack. */ |
123 |
int push_val(stackitem **stack_head, int in_val) |
int push_int(stackitem **stack_head, int in_val) |
124 |
{ |
{ |
125 |
value *new_value= malloc(sizeof(value)); |
value *new_value= malloc(sizeof(value)); |
126 |
stackitem *new_item= malloc(sizeof(stackitem)); |
stackitem *new_item= malloc(sizeof(stackitem)); |
157 |
/* ...which will contain... */ |
/* ...which will contain... */ |
158 |
value *new_value; /* A new symbol value */ |
value *new_value; /* A new symbol value */ |
159 |
/* ...which might point to... */ |
/* ...which might point to... */ |
160 |
symbol *new_symbol; /* (if needed) A new actual symbol */ |
symbol **new_symbol; /* (if needed) A new actual symbol */ |
161 |
/* ...which, if possible, will be bound to... */ |
/* ...which, if possible, will be bound to... */ |
162 |
value *new_fvalue; /* (if needed) A new function value */ |
value *new_fvalue; /* (if needed) A new function value */ |
163 |
/* ...which will point to... */ |
/* ...which will point to... */ |
175 |
new_value->refcount= 1; |
new_value->refcount= 1; |
176 |
|
|
177 |
/* Look up the symbol name in the hash table */ |
/* Look up the symbol name in the hash table */ |
178 |
new_value->content.ptr= *hash(env->symbols, in_string); |
new_symbol= hash(env->symbols, in_string); |
179 |
|
new_value->content.ptr= *new_symbol; |
180 |
|
|
181 |
if(new_value->content.ptr==NULL) { /* If symbol was undefined */ |
if(*new_symbol==NULL) { /* If symbol was undefined */ |
182 |
|
|
183 |
/* Create a new symbol */ |
/* Create a new symbol */ |
184 |
new_symbol= malloc(sizeof(symbol)); |
(*new_symbol)= malloc(sizeof(symbol)); |
185 |
new_symbol->val= NULL; /* undefined value */ |
(*new_symbol)->val= NULL; /* undefined value */ |
186 |
new_symbol->next= NULL; |
(*new_symbol)->next= NULL; |
187 |
new_symbol->id= malloc(strlen(in_string)+1); |
(*new_symbol)->id= malloc(strlen(in_string)+1); |
188 |
strcpy(new_symbol->id, in_string); |
strcpy((*new_symbol)->id, in_string); |
189 |
|
|
190 |
/* Intern the new symbol in the hash table */ |
/* Intern the new symbol in the hash table */ |
191 |
new_value->content.ptr= new_symbol; |
new_value->content.ptr= *new_symbol; |
192 |
|
|
193 |
/* Try to load the symbol name as an external function, to see if |
/* Try to load the symbol name as an external function, to see if |
194 |
we should bind the symbol to a new function pointer value */ |
we should bind the symbol to a new function pointer value */ |
200 |
new_fvalue= malloc(sizeof(value)); /* Create a new value */ |
new_fvalue= malloc(sizeof(value)); /* Create a new value */ |
201 |
new_fvalue->type=func; /* The new value is a function pointer */ |
new_fvalue->type=func; /* The new value is a function pointer */ |
202 |
new_fvalue->content.ptr=funcptr; /* Store function pointer */ |
new_fvalue->content.ptr=funcptr; /* Store function pointer */ |
203 |
new_symbol->val= new_fvalue; /* Bind the symbol to the new |
(*new_symbol)->val= new_fvalue; /* Bind the symbol to the new |
204 |
function value */ |
function value */ |
205 |
new_fvalue->refcount= 1; |
new_fvalue->refcount= 1; |
206 |
} |
} |
207 |
} |
} |
348 |
return out_item; |
return out_item; |
349 |
} |
} |
350 |
|
|
351 |
|
extern void rcl(environment *env) |
|
/* If the top element is a reference, determine if it's a reference to a |
|
|
function, and if it is, toss the reference and execute the function. */ |
|
|
extern void eval(environment *env) |
|
352 |
{ |
{ |
353 |
funcp in_func; |
value *val; |
|
stackitem* temp= env->head; |
|
354 |
|
|
355 |
if(temp==NULL) { |
if(env->head == NULL) { |
356 |
printerr("Stack empty"); |
printerr("Stack empty"); |
357 |
return; |
return; |
358 |
} |
} |
359 |
|
|
360 |
if(temp->item->type==symb |
if(env->head->item->type!=symb) { |
361 |
&& ((symbol *)(temp->item->content.ptr))->val != NULL |
printerr("Not a symbol"); |
362 |
&& ((symbol *)(temp->item->content.ptr))->val->type == func) { |
return; |
363 |
in_func= (funcp)(((symbol *)(temp->item->content.ptr))->val->content.ptr); |
} |
364 |
toss(env); |
val=((symbol *)(env->head->item->content.ptr))->val; |
365 |
(*in_func)(env); |
toss(env); /* toss the symbol */ |
366 |
|
push_val(&(env->head), val); /* Return its bound value */ |
367 |
|
} |
368 |
|
|
369 |
|
/* If the top element is a symbol, determine if it's bound to a |
370 |
|
function value, and if it is, toss the symbol and execute the |
371 |
|
function. */ |
372 |
|
extern void eval(environment *env) |
373 |
|
{ |
374 |
|
funcp in_func; |
375 |
|
value* val; |
376 |
|
if(env->head==NULL) { |
377 |
|
printerr("Stack empty"); |
378 |
return; |
return; |
379 |
} |
} |
380 |
|
|
381 |
|
/* if it's a symbol */ |
382 |
|
if(env->head->item->type==symb) { |
383 |
|
|
384 |
|
/* If it's not bound to anything */ |
385 |
|
if (((symbol *)(env->head->item->content.ptr))->val == NULL) { |
386 |
|
printerr("Unbound variable"); |
387 |
|
return; |
388 |
|
} |
389 |
|
|
390 |
|
/* If it contains a function */ |
391 |
|
if (((symbol *)(env->head->item->content.ptr))->val->type == func) { |
392 |
|
in_func= |
393 |
|
(funcp)(((symbol *)(env->head->item->content.ptr))->val->content.ptr); |
394 |
|
toss(env); |
395 |
|
(*in_func)(env); /* Run the function */ |
396 |
|
return; |
397 |
|
} else { /* If it's not a function */ |
398 |
|
val=((symbol *)(env->head->item->content.ptr))->val; |
399 |
|
toss(env); /* toss the symbol */ |
400 |
|
push_val(&(env->head), val); /* Return its bound value */ |
401 |
|
} |
402 |
|
} |
403 |
|
|
404 |
if(temp->item->type==func) { |
/* If it's a lone function value, run it */ |
405 |
in_func= (funcp)(temp->item->content.ptr); |
if(env->head->item->type==func) { |
406 |
|
in_func= (funcp)(env->head->item->content.ptr); |
407 |
toss(env); |
toss(env); |
408 |
(*in_func)(env); |
(*in_func)(env); |
409 |
return; |
return; |
410 |
} |
} |
411 |
|
|
|
push(&(env->head), copy(temp)); |
|
|
swap(env); |
|
|
toss(env); |
|
412 |
} |
} |
413 |
|
|
414 |
/* Make a list. */ |
/* Make a list. */ |
473 |
} |
} |
474 |
/* If integer */ |
/* If integer */ |
475 |
if((convert= sscanf(in_line, "%d %[^\n\r]", &itemp, rest))) { |
if((convert= sscanf(in_line, "%d %[^\n\r]", &itemp, rest))) { |
476 |
push_val(&(env->head), itemp); |
push_int(&(env->head), itemp); |
477 |
break; |
break; |
478 |
} |
} |
479 |
/* Escape ';' with '\' */ |
/* Escape ';' with '\' */ |
573 |
result= (left==right); |
result= (left==right); |
574 |
|
|
575 |
toss(env); toss(env); |
toss(env); toss(env); |
576 |
push_val(&(env->head), result); |
push_int(&(env->head), result); |
577 |
} |
} |
578 |
|
|
579 |
/* Negates the top element on the stack. */ |
/* Negates the top element on the stack. */ |
588 |
|
|
589 |
val= env->head->item->content.val; |
val= env->head->item->content.val; |
590 |
toss(env); |
toss(env); |
591 |
push_val(&(env->head), !val); |
push_int(&(env->head), !val); |
592 |
} |
} |
593 |
|
|
594 |
/* Compares the two top elements on the stack and return 0 if they're the |
/* Compares the two top elements on the stack and return 0 if they're the |
638 |
toss(env); |
toss(env); |
639 |
} |
} |
640 |
|
|
641 |
|
extern void words(environment *env) |
642 |
|
{ |
643 |
|
symbol *temp; |
644 |
|
int i; |
645 |
|
|
646 |
|
for(i= 0; i<HASHTBLSIZE; i++) { |
647 |
|
temp= env->symbols[i]; |
648 |
|
while(temp!=NULL) { |
649 |
|
printf("%s\n", temp->id); |
650 |
|
temp= temp->next; |
651 |
|
} |
652 |
|
} |
653 |
|
} |
654 |
|
|
655 |
int main() |
int main() |
656 |
{ |
{ |
657 |
environment myenv; |
environment myenv; |