37 |
#include <unistd.h> |
#include <unistd.h> |
38 |
/* EX_NOINPUT, EX_USAGE */ |
/* EX_NOINPUT, EX_USAGE */ |
39 |
#include <sysexits.h> |
#include <sysexits.h> |
40 |
|
/* assert */ |
41 |
|
#include <assert.h> |
42 |
|
|
43 |
|
#ifdef __linux__ |
44 |
/* mtrace, muntrace */ |
/* mtrace, muntrace */ |
45 |
#include <mcheck.h> |
#include <mcheck.h> |
46 |
/* ioctl */ |
/* ioctl */ |
47 |
#include <sys/ioctl.h> |
#include <sys/ioctl.h> |
48 |
/* KDMKTONE */ |
/* KDMKTONE */ |
49 |
#include <linux/kd.h> |
#include <linux/kd.h> |
50 |
|
#endif /* __linux__ */ |
51 |
|
|
52 |
#include "stack.h" |
#include "stack.h" |
53 |
|
|
123 |
stackitem *nitem= malloc(sizeof(stackitem)); |
stackitem *nitem= malloc(sizeof(stackitem)); |
124 |
|
|
125 |
nval->content.ptr= NULL; |
nval->content.ptr= NULL; |
126 |
|
nval->type= integer; |
127 |
|
|
128 |
nitem->item= nval; |
nitem->item= nval; |
129 |
nitem->next= env->gc_ref; |
nitem->next= env->gc_ref; |
261 |
value *new_value= new_val(env); |
value *new_value= new_val(env); |
262 |
|
|
263 |
new_value->content.c= malloc(sizeof(cons)); |
new_value->content.c= malloc(sizeof(cons)); |
264 |
|
assert(new_value->content.c!=NULL); |
265 |
new_value->type= tcons; |
new_value->type= tcons; |
266 |
CAR(new_value)= val; |
CAR(new_value)= val; |
267 |
CDR(new_value)= env->head; |
CDR(new_value)= env->head; |
474 |
printf("\"%s\"", (char*)CAR(stack_head)->content.ptr); |
printf("\"%s\"", (char*)CAR(stack_head)->content.ptr); |
475 |
break; |
break; |
476 |
case symb: |
case symb: |
477 |
printf("%s", ((symbol *)(CAR(stack_head)->content.ptr))->id); |
printf("%s", CAR(stack_head)->content.sym->id); |
478 |
break; |
break; |
479 |
case func: |
case func: |
480 |
printf("#<function %p>", (funcp)(CAR(stack_head)->content.ptr)); |
printf("#<function %p>", (funcp)(CAR(stack_head)->content.ptr)); |
601 |
return; |
return; |
602 |
} |
} |
603 |
|
|
604 |
val= ((symbol *)(CAR(env->head)->content.ptr))->val; |
val= CAR(env->head)->content.sym->val; |
605 |
if(val == NULL){ |
if(val == NULL){ |
606 |
printerr("Unbound Variable"); |
printerr("Unbound Variable"); |
607 |
env->err= 3; |
env->err= 3; |
662 |
push_val(env, CAR(iterator)); |
push_val(env, CAR(iterator)); |
663 |
|
|
664 |
if(CAR(env->head)->type==symb |
if(CAR(env->head)->type==symb |
665 |
&& (((symbol*)(CAR(env->head)->content.ptr))->id[0]==';')) { |
&& CAR(env->head)->content.sym->id[0]==';') { |
666 |
toss(env); |
toss(env); |
667 |
if(env->err) return; |
if(env->err) return; |
668 |
|
|
724 |
iterator= env->head; |
iterator= env->head; |
725 |
if(iterator==NULL |
if(iterator==NULL |
726 |
|| (CAR(iterator)->type==symb |
|| (CAR(iterator)->type==symb |
727 |
&& ((symbol*)(CAR(iterator)->content.ptr))->id[0]=='[')) { |
&& CAR(iterator)->content.sym->id[0]=='[')) { |
728 |
temp= NULL; |
temp= NULL; |
729 |
toss(env); |
toss(env); |
730 |
} else { |
} else { |
731 |
/* Search for first delimiter */ |
/* Search for first delimiter */ |
732 |
while(CDR(iterator)!=NULL |
while(CDR(iterator)!=NULL |
733 |
&& (CAR(CDR(iterator))->type!=symb |
&& (CAR(CDR(iterator))->type!=symb |
734 |
|| ((symbol*)(CAR(CDR(iterator))->content.ptr))->id[0]!='[')) |
|| CAR(CDR(iterator))->content.sym->id[0]!='[')) |
735 |
iterator= CDR(iterator); |
iterator= CDR(iterator); |
736 |
|
|
737 |
/* Extract list */ |
/* Extract list */ |
890 |
if(env->free_string!=NULL) |
if(env->free_string!=NULL) |
891 |
free(env->free_string); |
free(env->free_string); |
892 |
|
|
893 |
|
#ifdef __linux__ |
894 |
muntrace(); |
muntrace(); |
895 |
|
#endif |
896 |
|
|
897 |
exit(EXIT_SUCCESS); |
exit(EXIT_SUCCESS); |
898 |
} |
} |
949 |
return; |
return; |
950 |
} |
} |
951 |
|
|
952 |
sym_id= ((symbol*)(CAR(stack_head)->content.ptr))->id; |
sym_id= CAR(stack_head)->content.sym->id; |
953 |
toss(env); |
toss(env); |
954 |
|
|
955 |
return forget_sym(hash(env->symbols, sym_id)); |
return forget_sym(hash(env->symbols, sym_id)); |
967 |
|
|
968 |
int c; /* getopt option character */ |
int c; /* getopt option character */ |
969 |
|
|
970 |
|
#ifdef __linux__ |
971 |
mtrace(); |
mtrace(); |
972 |
|
#endif |
973 |
|
|
974 |
init_env(&myenv); |
init_env(&myenv); |
975 |
|
|
1024 |
return EXIT_SUCCESS; /* EOF */ |
return EXIT_SUCCESS; /* EOF */ |
1025 |
} else if(myenv.head!=NULL |
} else if(myenv.head!=NULL |
1026 |
&& CAR(myenv.head)->type==symb |
&& CAR(myenv.head)->type==symb |
1027 |
&& ((symbol*)(CAR(myenv.head)->content.ptr))->id[0] |
&& CAR(myenv.head)->content.sym->id[0] |
1028 |
==';') { |
==';') { |
1029 |
toss(&myenv); /* No error check in main */ |
toss(&myenv); /* No error check in main */ |
1030 |
eval(&myenv); |
eval(&myenv); |
1267 |
|
|
1268 |
protect(old_value); |
protect(old_value); |
1269 |
new_value= new_val(env); |
new_value= new_val(env); |
|
protect(new_value); |
|
1270 |
new_value->type= old_value->type; |
new_value->type= old_value->type; |
1271 |
|
|
1272 |
switch(old_value->type){ |
switch(old_value->type){ |
1281 |
strdup((char *)(old_value->content.ptr)); |
strdup((char *)(old_value->content.ptr)); |
1282 |
break; |
break; |
1283 |
case tcons: |
case tcons: |
|
new_value= NULL; |
|
1284 |
|
|
1285 |
new_value->content.c= malloc(sizeof(cons)); |
new_value->content.c= malloc(sizeof(cons)); |
1286 |
|
assert(new_value->content.c!=NULL); |
1287 |
|
|
1288 |
CAR(new_value)= copy_val(env, CAR(old_value)); /* recurse */ |
CAR(new_value)= copy_val(env, CAR(old_value)); /* recurse */ |
1289 |
CDR(new_value)= copy_val(env, CDR(old_value)); /* recurse */ |
CDR(new_value)= copy_val(env, CDR(old_value)); /* recurse */ |
1290 |
break; |
break; |
1291 |
} |
} |
1292 |
|
|
1293 |
unprotect(old_value); unprotect(new_value); |
unprotect(old_value); |
1294 |
|
|
1295 |
return new_value; |
return new_value; |
1296 |
} |
} |
1373 |
eval(env); |
eval(env); |
1374 |
} |
} |
1375 |
|
|
1376 |
|
extern void sx_656c7365(environment *env) |
1377 |
|
{ |
1378 |
|
if(env->head==NULL || CDR(env->head)==NULL |
1379 |
|
|| CDR(CDR(env->head))==NULL || CDR(CDR(CDR(env->head)))==NULL |
1380 |
|
|| CDR(CDR(CDR(CDR(env->head))))==NULL) { |
1381 |
|
printerr("Too Few Arguments"); |
1382 |
|
env->err= 1; |
1383 |
|
return; |
1384 |
|
} |
1385 |
|
|
1386 |
|
if(CAR(CDR(env->head))->type!=symb |
1387 |
|
|| strcmp(CAR(CDR(env->head))->content.sym->id, "then")!=0 |
1388 |
|
|| CAR(CDR(CDR(CDR(env->head))))->type!=symb |
1389 |
|
|| strcmp(CAR(CDR(CDR(CDR(env->head))))->content.sym->id, "if")!=0) { |
1390 |
|
printerr("Bad Argument Type"); |
1391 |
|
env->err= 2; |
1392 |
|
return; |
1393 |
|
} |
1394 |
|
|
1395 |
|
swap(env); toss(env); rot(env); toss(env); |
1396 |
|
ifelse(env); |
1397 |
|
} |
1398 |
|
|
1399 |
|
extern void then(environment *env) |
1400 |
|
{ |
1401 |
|
if(env->head==NULL || CDR(env->head)==NULL |
1402 |
|
|| CDR(CDR(env->head))==NULL) { |
1403 |
|
printerr("Too Few Arguments"); |
1404 |
|
env->err= 1; |
1405 |
|
return; |
1406 |
|
} |
1407 |
|
|
1408 |
|
if(CAR(CDR(env->head))->type!=symb |
1409 |
|
|| strcmp(CAR(CDR(env->head))->content.sym->id, "if")!=0) { |
1410 |
|
printerr("Bad Argument Type"); |
1411 |
|
env->err= 2; |
1412 |
|
return; |
1413 |
|
} |
1414 |
|
|
1415 |
|
swap(env); toss(env); |
1416 |
|
sx_6966(env); |
1417 |
|
} |
1418 |
|
|
1419 |
/* "while" */ |
/* "while" */ |
1420 |
extern void sx_7768696c65(environment *env) |
extern void sx_7768696c65(environment *env) |
1421 |
{ |
{ |
1542 |
push_val(env, CAR(iterator)); |
push_val(env, CAR(iterator)); |
1543 |
push_val(env, loop); |
push_val(env, loop); |
1544 |
eval(env); if(env->err) return; |
eval(env); if(env->err) return; |
1545 |
if (CDR(iterator)->type == tcons){ |
if (iterator->type == tcons){ |
1546 |
iterator= CDR(iterator); |
iterator= CDR(iterator); |
1547 |
} else { |
} else { |
1548 |
printerr("Bad Argument Type"); /* Improper list */ |
printerr("Bad Argument Type"); /* Improper list */ |
1591 |
|
|
1592 |
if(iterator==NULL |
if(iterator==NULL |
1593 |
|| (CAR(iterator)->type==symb |
|| (CAR(iterator)->type==symb |
1594 |
&& ((symbol*)(CAR(iterator)->content.ptr))->id[0]=='[')) { |
&& CAR(iterator)->content.sym->id[0]=='[')) { |
1595 |
temp= NULL; |
temp= NULL; |
1596 |
toss(env); |
toss(env); |
1597 |
} else { |
} else { |
1598 |
/* Search for first delimiter */ |
/* Search for first delimiter */ |
1599 |
while(CDR(iterator)!=NULL |
while(CDR(iterator)!=NULL |
1600 |
&& (CAR(CDR(iterator))->type!=symb |
&& (CAR(CDR(iterator))->type!=symb |
1601 |
|| ((symbol*)(CAR(CDR(iterator))->content.ptr))->id[0] |
|| CAR(CDR(iterator))->content.sym->id[0]!='[')) |
|
!='[')) |
|
1602 |
iterator= CDR(iterator); |
iterator= CDR(iterator); |
1603 |
|
|
1604 |
/* Extract list */ |
/* Extract list */ |
1706 |
return sx_72656164(env); |
return sx_72656164(env); |
1707 |
} |
} |
1708 |
|
|
1709 |
|
#ifdef __linux__ |
1710 |
extern void beep(environment *env) |
extern void beep(environment *env) |
1711 |
{ |
{ |
1712 |
int freq, dur, period, ticks; |
int freq, dur, period, ticks; |
1749 |
abort(); |
abort(); |
1750 |
} |
} |
1751 |
} |
} |
1752 |
|
#endif /* __linux__ */ |
1753 |
|
|
1754 |
/* "wait" */ |
/* "wait" */ |
1755 |
extern void sx_77616974(environment *env) |
extern void sx_77616974(environment *env) |