15 |
/* mtrace, muntrace */ |
/* mtrace, muntrace */ |
16 |
#include <mcheck.h> |
#include <mcheck.h> |
17 |
|
|
18 |
#define HASHTBLSIZE 2048 |
#include "stack.h" |
|
|
|
|
/* First, define some types. */ |
|
|
|
|
|
/* A value of some type */ |
|
|
typedef struct { |
|
|
enum { |
|
|
integer, |
|
|
string, |
|
|
func, /* Function pointer */ |
|
|
symb, |
|
|
list |
|
|
} type; /* Type of stack element */ |
|
|
|
|
|
union { |
|
|
void *ptr; /* Pointer to the content */ |
|
|
int val; /* ...or an integer */ |
|
|
} content; /* Stores a pointer or an integer */ |
|
|
|
|
|
int gc_garb; |
|
|
|
|
|
} value; |
|
|
|
|
|
/* A symbol with a name and possible value */ |
|
|
/* (These do not need reference counters, they are kept unique by |
|
|
hashing.) */ |
|
|
typedef struct symbol_struct { |
|
|
char *id; /* Symbol name */ |
|
|
value *val; /* The value (if any) bound to it */ |
|
|
struct symbol_struct *next; /* In case of hashing conflicts, a */ |
|
|
} symbol; /* symbol is a kind of stack item. */ |
|
|
|
|
|
/* A type for a hash table for symbols */ |
|
|
typedef symbol *hashtbl[HASHTBLSIZE]; /* Hash table declaration */ |
|
|
|
|
|
/* An item (value) on a stack */ |
|
|
typedef struct stackitem_struct |
|
|
{ |
|
|
value *item; /* The value on the stack */ |
|
|
/* (This is never NULL) */ |
|
|
struct stackitem_struct *next; /* Next item */ |
|
|
} stackitem; |
|
|
|
|
|
/* An environment; gives access to the stack and a hash table of |
|
|
defined symbols */ |
|
|
typedef struct { |
|
|
stackitem *gc_ref; |
|
|
int gc_limit, gc_count; |
|
|
|
|
|
stackitem *head; /* Head of the stack */ |
|
|
hashtbl symbols; /* Hash table of all variable bindings */ |
|
|
int err; /* Error flag */ |
|
|
char *in_string; /* Input pending to be read */ |
|
|
char *free_string; /* Free this string when all input is |
|
|
read from in_string */ |
|
|
FILE *inputstream; /* stdin or a file, most likely */ |
|
|
int interactive; /* print prompts, stack, etc */ |
|
|
} environment; |
|
|
|
|
|
/* A type for pointers to external functions */ |
|
|
typedef void (*funcp)(environment *); /* funcp is a pointer to a void |
|
|
function (environment *) */ |
|
19 |
|
|
20 |
/* Initialize a newly created environment */ |
/* Initialize a newly created environment */ |
21 |
void init_env(environment *env) |
void init_env(environment *env) |
83 |
} |
} |
84 |
} |
} |
85 |
|
|
|
extern void gc_init(environment*); |
|
|
|
|
86 |
value* new_val(environment *env) { |
value* new_val(environment *env) { |
87 |
value *nval= malloc(sizeof(value)); |
value *nval= malloc(sizeof(value)); |
88 |
stackitem *nitem= malloc(sizeof(stackitem)); |
stackitem *nitem= malloc(sizeof(stackitem)); |
89 |
|
|
|
if(env->gc_count >= env->gc_limit) |
|
|
gc_init(env); |
|
|
|
|
90 |
nval->content.ptr= NULL; |
nval->content.ptr= NULL; |
91 |
|
|
92 |
nitem->item= nval; |
nitem->item= nval; |
121 |
symbol *tsymb; |
symbol *tsymb; |
122 |
int i; |
int i; |
123 |
|
|
124 |
|
if(env->gc_count < env->gc_limit) |
125 |
|
return; |
126 |
|
|
127 |
while(iterator!=NULL) { |
while(iterator!=NULL) { |
128 |
iterator->item->gc_garb= 1; |
iterator->item->gc_garb= 1; |
129 |
iterator= iterator->next; |
iterator= iterator->next; |
178 |
} |
} |
179 |
} |
} |
180 |
|
|
181 |
env->gc_limit= env->gc_count+20; |
env->gc_limit= env->gc_count*2; |
182 |
env->gc_ref= new_head; |
env->gc_ref= new_head; |
183 |
} |
} |
184 |
|
|
534 |
in_func= (funcp)(env->head->item->content.ptr); |
in_func= (funcp)(env->head->item->content.ptr); |
535 |
toss(env); |
toss(env); |
536 |
if(env->err) return; |
if(env->err) return; |
537 |
return (*in_func)(env); |
return in_func(env); |
538 |
|
|
539 |
/* If it's a list */ |
/* If it's a list */ |
540 |
case list: |
case list: |
745 |
toss(env); toss(env); |
toss(env); toss(env); |
746 |
} |
} |
747 |
|
|
|
extern void clear(environment *); |
|
|
void forget_sym(symbol **); |
|
|
|
|
748 |
/* Quit stack. */ |
/* Quit stack. */ |
749 |
extern void quit(environment *env) |
extern void quit(environment *env) |
750 |
{ |
{ |
832 |
push_int(env, env->err); |
push_int(env, env->err); |
833 |
} |
} |
834 |
|
|
|
extern void sx_72656164(environment*); |
|
|
|
|
835 |
int main(int argc, char **argv) |
int main(int argc, char **argv) |
836 |
{ |
{ |
837 |
environment myenv; |
environment myenv; |
889 |
toss(&myenv); /* No error check in main */ |
toss(&myenv); /* No error check in main */ |
890 |
eval(&myenv); |
eval(&myenv); |
891 |
} |
} |
892 |
|
gc_init(&myenv); |
893 |
} |
} |
894 |
quit(&myenv); |
quit(&myenv); |
895 |
return EXIT_FAILURE; |
return EXIT_FAILURE; |
1144 |
} while(truth); |
} while(truth); |
1145 |
} |
} |
1146 |
|
|
1147 |
/* "for"; For-loop */ |
|
1148 |
|
/* "for"; for-loop */ |
1149 |
extern void sx_666f72(environment *env) { |
extern void sx_666f72(environment *env) { |
1150 |
|
value *loop; |
1151 |
|
int foo1, foo2; |
1152 |
|
|
1153 |
|
if(env->head==NULL || env->head->next==NULL |
1154 |
|
|| env->head->next->next==NULL) { |
1155 |
|
printerr("Too Few Arguments"); |
1156 |
|
env->err= 1; |
1157 |
|
return; |
1158 |
|
} |
1159 |
|
|
1160 |
|
if(env->head->next->item->type!=integer |
1161 |
|
|| env->head->next->next->item->type!=integer) { |
1162 |
|
printerr("Bad Argument Type"); |
1163 |
|
env->err= 2; |
1164 |
|
return; |
1165 |
|
} |
1166 |
|
|
1167 |
|
loop= env->head->item; |
1168 |
|
toss(env); if(env->err) return; |
1169 |
|
|
1170 |
|
foo2= env->head->item->content.val; |
1171 |
|
toss(env); if(env->err) return; |
1172 |
|
|
1173 |
|
foo1= env->head->item->content.val; |
1174 |
|
toss(env); if(env->err) return; |
1175 |
|
|
1176 |
|
if(foo1<=foo2) { |
1177 |
|
while(foo1<=foo2) { |
1178 |
|
push_int(env, foo1); |
1179 |
|
push_val(env, loop); |
1180 |
|
eval(env); if(env->err) return; |
1181 |
|
foo1++; |
1182 |
|
} |
1183 |
|
} else { |
1184 |
|
while(foo1>=foo2) { |
1185 |
|
push_int(env, foo1); |
1186 |
|
push_val(env, loop); |
1187 |
|
eval(env); if(env->err) return; |
1188 |
|
foo1--; |
1189 |
|
} |
1190 |
|
} |
1191 |
|
} |
1192 |
|
|
1193 |
|
/* Variant of for-loop */ |
1194 |
|
extern void foreach(environment *env) { |
1195 |
|
|
1196 |
value *loop, *foo; |
value *loop, *foo; |
1197 |
stackitem *iterator; |
stackitem *iterator; |