10 |
/* Print a newline to a port */ |
/* Print a newline to a port */ |
11 |
extern void nlport(environment *env) |
extern void nlport(environment *env) |
12 |
{ |
{ |
13 |
switch(check_args(env, port, empty)) { |
if(check_args(env, port, empty)) |
14 |
case 1: |
return printerr(env); |
|
printerr(env, "Too Few Arguments"); |
|
|
return; |
|
|
case 2: |
|
|
printerr(env, "Bad Argument Type"); |
|
|
return; |
|
|
default: |
|
|
break; |
|
|
} |
|
15 |
|
|
16 |
if(fprintf(CAR(env->head)->content.p, "\n") < 0){ |
if(fprintf(CAR(env->head)->content.p, "\n") < 0){ |
17 |
perror("nl"); |
perror("nl"); |
25 |
extern void type(environment *env) |
extern void type(environment *env) |
26 |
{ |
{ |
27 |
|
|
28 |
switch(check_args(env, unknown, empty)) { |
if(check_args(env, unknown, empty)) |
29 |
case 1: |
return printerr(env); |
|
printerr(env, "Too Few Arguments"); |
|
|
return; |
|
|
case 2: |
|
|
printerr(env, "Bad Argument Type"); |
|
|
return; |
|
|
default: |
|
|
break; |
|
|
} |
|
30 |
|
|
31 |
switch(CAR(env->head)->type){ |
switch(CAR(env->head)->type){ |
32 |
case empty: |
case empty: |
66 |
extern void print_(environment *env) |
extern void print_(environment *env) |
67 |
{ |
{ |
68 |
|
|
69 |
switch(check_args(env, unknown, empty)) { |
if(check_args(env, unknown, empty)) |
70 |
case 1: |
return printerr(env); |
|
printerr(env, "Too Few Arguments"); |
|
|
return; |
|
|
case 2: |
|
|
printerr(env, "Bad Argument Type"); |
|
|
return; |
|
|
default: |
|
|
break; |
|
|
} |
|
71 |
|
|
72 |
print_val(env, CAR(env->head), 0, NULL, stdout); |
print_val(env, CAR(env->head), 0, NULL, stdout); |
73 |
if(env->err) return; |
if(env->err) return; |
87 |
extern void princ_(environment *env) |
extern void princ_(environment *env) |
88 |
{ |
{ |
89 |
|
|
90 |
switch(check_args(env, unknown, empty)) { |
if(check_args(env, unknown, empty)) |
91 |
case 1: |
return printerr(env); |
|
printerr(env, "Too Few Arguments"); |
|
|
return; |
|
|
case 2: |
|
|
printerr(env, "Bad Argument Type"); |
|
|
return; |
|
|
default: |
|
|
break; |
|
|
} |
|
92 |
|
|
93 |
print_val(env, CAR(env->head), 1, NULL, stdout); |
print_val(env, CAR(env->head), 1, NULL, stdout); |
94 |
} |
} |
105 |
extern void printport_(environment *env) |
extern void printport_(environment *env) |
106 |
{ |
{ |
107 |
|
|
108 |
switch(check_args(env, port, unknown, empty)) { |
if(check_args(env, port, unknown, empty)) |
109 |
case 1: |
return printerr(env); |
|
printerr(env, "Too Few Arguments"); |
|
|
return; |
|
|
case 2: |
|
|
printerr(env, "Bad Argument Type"); |
|
|
return; |
|
|
default: |
|
|
break; |
|
|
} |
|
110 |
|
|
111 |
print_val(env, CAR(CDR(env->head)), 0, NULL, CAR(env->head)->content.p); |
print_val(env, CAR(CDR(env->head)), 0, NULL, CAR(env->head)->content.p); |
112 |
if(env->err) return; |
if(env->err) return; |
125 |
extern void princport_(environment *env) |
extern void princport_(environment *env) |
126 |
{ |
{ |
127 |
|
|
128 |
switch(check_args(env, port, unknown, empty)) { |
if(check_args(env, port, unknown, empty)) |
129 |
case 1: |
return printerr(env); |
|
printerr(env, "Too Few Arguments"); |
|
|
return; |
|
|
case 2: |
|
|
printerr(env, "Bad Argument Type"); |
|
|
return; |
|
|
default: |
|
|
break; |
|
|
} |
|
130 |
|
|
131 |
print_val(env, CAR(CDR(env->head)), 1, NULL, CAR(env->head)->content.p); |
print_val(env, CAR(CDR(env->head)), 1, NULL, CAR(env->head)->content.p); |
132 |
toss(env); if(env->err) return; |
toss(env); if(env->err) return; |
145 |
{ |
{ |
146 |
value *temp= env->head; |
value *temp= env->head; |
147 |
|
|
148 |
switch(check_args(env, unknown, unknown, unknown, empty)) { |
if(check_args(env, unknown, unknown, unknown, empty)) |
149 |
case 1: |
return printerr(env); |
|
printerr(env, "Too Few Arguments"); |
|
|
return; |
|
|
case 2: |
|
|
printerr(env, "Bad Argument Type"); |
|
|
return; |
|
|
default: |
|
|
break; |
|
|
} |
|
150 |
|
|
151 |
env->head= CDR(CDR(env->head)); |
env->head= CDR(CDR(env->head)); |
152 |
CDR(CDR(temp))= CDR(env->head); |
CDR(CDR(temp))= CDR(env->head); |
158 |
{ |
{ |
159 |
value *temp, *new_head; |
value *temp, *new_head; |
160 |
|
|
161 |
switch(check_args(env, tcons, empty)) { |
if(check_args(env, tcons, empty)) |
162 |
case 1: |
return printerr(env); |
|
printerr(env, "Too Few Arguments"); |
|
|
return; |
|
|
case 2: |
|
|
printerr(env, "Bad Argument Type"); |
|
|
return; |
|
|
default: |
|
|
break; |
|
|
} |
|
163 |
|
|
164 |
rev(env); |
rev(env); |
165 |
|
|
177 |
if (CDR(temp)->type == tcons) |
if (CDR(temp)->type == tcons) |
178 |
temp= CDR(temp); |
temp= CDR(temp); |
179 |
else { |
else { |
180 |
printerr(env, "Bad Argument Type"); /* Improper list */ |
env->err= 2; /* Improper list */ |
181 |
env->err= 2; |
return printerr(env); |
|
return; |
|
182 |
} |
} |
183 |
} |
} |
184 |
|
|
193 |
{ |
{ |
194 |
void *left, *right; |
void *left, *right; |
195 |
|
|
196 |
switch(check_args(env, unknown, unknown, empty)) { |
if(check_args(env, unknown, unknown, empty)) |
197 |
case 1: |
return printerr(env); |
|
printerr(env, "Too Few Arguments"); |
|
|
return; |
|
|
case 2: |
|
|
printerr(env, "Bad Argument Type"); |
|
|
return; |
|
|
default: |
|
|
break; |
|
|
} |
|
198 |
|
|
199 |
left= CAR(env->head)->content.ptr; |
left= CAR(env->head)->content.ptr; |
200 |
right= CAR(CDR(env->head))->content.ptr; |
right= CAR(CDR(env->head))->content.ptr; |
208 |
{ |
{ |
209 |
int val; |
int val; |
210 |
|
|
211 |
switch(check_args(env, integer, empty)) { |
if(check_args(env, integer, empty)) |
212 |
case 1: |
return printerr(env); |
|
printerr(env, "Too Few Arguments"); |
|
|
return; |
|
|
case 2: |
|
|
printerr(env, "Bad Argument Type"); |
|
|
return; |
|
|
default: |
|
|
break; |
|
|
} |
|
213 |
|
|
214 |
val= CAR(env->head)->content.i; |
val= CAR(env->head)->content.i; |
215 |
toss(env); |
toss(env); |
229 |
symbol *sym; |
symbol *sym; |
230 |
|
|
231 |
/* Needs two values on the stack, the top one must be a symbol */ |
/* Needs two values on the stack, the top one must be a symbol */ |
232 |
switch(check_args(env, symb, unknown, empty)) { |
if(check_args(env, symb, unknown, empty)) |
233 |
case 1: |
return printerr(env); |
|
printerr(env, "Too Few Arguments"); |
|
|
return; |
|
|
case 2: |
|
|
printerr(env, "Bad Argument Type"); |
|
|
return; |
|
|
default: |
|
|
break; |
|
|
} |
|
234 |
|
|
235 |
/* long names are a pain */ |
/* long names are a pain */ |
236 |
sym= CAR(env->head)->content.sym; |
sym= CAR(env->head)->content.sym; |
252 |
{ |
{ |
253 |
char* sym_id; |
char* sym_id; |
254 |
|
|
255 |
switch(check_args(env, symb, empty)) { |
if(check_args(env, symb, empty)) |
256 |
case 1: |
return printerr(env); |
|
printerr(env, "Too Few Arguments"); |
|
|
return; |
|
|
case 2: |
|
|
printerr(env, "Bad Argument Type"); |
|
|
return; |
|
|
default: |
|
|
break; |
|
|
} |
|
257 |
|
|
258 |
sym_id= CAR(env->head)->content.sym->id; |
sym_id= CAR(env->head)->content.sym->id; |
259 |
toss(env); |
toss(env); |
276 |
char* new_string; |
char* new_string; |
277 |
value *a_val, *b_val; |
value *a_val, *b_val; |
278 |
|
|
279 |
if(check_args(env, unknown, unknown, empty)==1) { |
if(check_args(env, unknown, unknown, empty)) |
280 |
printerr(env, "Too Few Arguments"); |
return printerr(env); |
|
return; |
|
|
} |
|
281 |
|
|
282 |
if(check_args(env, string, string, empty)==0) { |
if(check_args(env, string, string, empty)==0) { |
283 |
a_val= CAR(env->head); |
a_val= CAR(env->head); |
337 |
return; |
return; |
338 |
} |
} |
339 |
|
|
340 |
printerr(env, "Bad Argument Type"); |
return printerr(env); |
|
env->err=2; |
|
341 |
} |
} |
342 |
|
|
343 |
/* "-" */ |
/* "-" */ |
346 |
int a, b; |
int a, b; |
347 |
float fa, fb; |
float fa, fb; |
348 |
|
|
349 |
if(check_args(env, unknown, unknown, empty)==1) { |
if(check_args(env, unknown, unknown, empty)) |
350 |
printerr(env, "Too Few Arguments"); |
return printerr(env); |
|
return; |
|
|
} |
|
351 |
|
|
352 |
if(check_args(env, integer, integer, empty)==0) { |
if(check_args(env, integer, integer, empty)==0) { |
353 |
a= CAR(env->head)->content.i; |
a= CAR(env->head)->content.i; |
389 |
return; |
return; |
390 |
} |
} |
391 |
|
|
392 |
printerr(env, "Bad Argument Type"); |
return printerr(env); |
|
env->err=2; |
|
393 |
} |
} |
394 |
|
|
395 |
/* ">" */ |
/* ">" */ |
398 |
int a, b; |
int a, b; |
399 |
float fa, fb; |
float fa, fb; |
400 |
|
|
401 |
if(check_args(env, unknown, unknown, empty)==1) { |
if(check_args(env, unknown, unknown, empty)) |
402 |
printerr(env, "Too Few Arguments"); |
return printerr(env); |
|
return; |
|
|
} |
|
403 |
|
|
404 |
if(check_args(env, integer, integer, empty)==0) { |
if(check_args(env, integer, integer, empty)==0) { |
405 |
a= CAR(env->head)->content.i; |
a= CAR(env->head)->content.i; |
441 |
return; |
return; |
442 |
} |
} |
443 |
|
|
444 |
printerr(env, "Bad Argument Type"); |
return printerr(env); |
|
env->err= 2; |
|
445 |
} |
} |
446 |
|
|
447 |
/* "<" */ |
/* "<" */ |
468 |
/* "dup"; duplicates an item on the stack */ |
/* "dup"; duplicates an item on the stack */ |
469 |
extern void sx_647570(environment *env) |
extern void sx_647570(environment *env) |
470 |
{ |
{ |
471 |
switch(check_args(env, unknown, empty)) { |
if(check_args(env, unknown, empty)) |
472 |
case 1: |
return printerr(env); |
|
printerr(env, "Too Few Arguments"); |
|
|
return; |
|
|
case 2: |
|
|
printerr(env, "Bad Argument Type"); |
|
|
return; |
|
|
default: |
|
|
break; |
|
|
} |
|
473 |
|
|
474 |
push_val(env, copy_val(env, CAR(env->head))); |
push_val(env, copy_val(env, CAR(env->head))); |
475 |
} |
} |
479 |
{ |
{ |
480 |
int truth; |
int truth; |
481 |
|
|
482 |
switch(check_args(env, unknown, integer, empty)) { |
if(check_args(env, unknown, integer, empty)) |
483 |
case 1: |
return printerr(env); |
|
printerr(env, "Too Few Arguments"); |
|
|
return; |
|
|
case 2: |
|
|
printerr(env, "Bad Argument Type"); |
|
|
return; |
|
|
default: |
|
|
break; |
|
|
} |
|
484 |
|
|
485 |
swap(env); |
swap(env); |
486 |
if(env->err) return; |
if(env->err) return; |
501 |
{ |
{ |
502 |
int truth; |
int truth; |
503 |
|
|
504 |
switch(check_args(env, unknown, unknown, integer, empty)) { |
if(check_args(env, unknown, unknown, integer, empty)) |
505 |
case 1: |
return printerr(env); |
|
printerr(env, "Too Few Arguments"); |
|
|
return; |
|
|
case 2: |
|
|
printerr(env, "Bad Argument Type"); |
|
|
return; |
|
|
default: |
|
|
break; |
|
|
} |
|
506 |
|
|
507 |
rot(env); |
rot(env); |
508 |
if(env->err) return; |
if(env->err) return; |
526 |
extern void sx_656c7365(environment *env) |
extern void sx_656c7365(environment *env) |
527 |
{ |
{ |
528 |
|
|
529 |
switch(check_args(env, |
if(check_args(env, unknown, symb, unknown, symb, integer, empty)) |
530 |
unknown, symb, unknown, symb, integer, |
return printerr(env); |
|
empty)) { |
|
|
case 1: |
|
|
printerr(env, "Too Few Arguments"); |
|
|
return; |
|
|
case 2: |
|
|
printerr(env, "Bad Argument Type"); |
|
|
return; |
|
|
default: |
|
|
break; |
|
|
} |
|
531 |
|
|
532 |
/// XXX |
/// XXX |
533 |
|
|
535 |
|| strcmp(CAR(CDR(env->head))->content.sym->id, "then")!=0 |
|| strcmp(CAR(CDR(env->head))->content.sym->id, "then")!=0 |
536 |
|| CAR(CDR(CDR(CDR(env->head))))->type!=symb |
|| CAR(CDR(CDR(CDR(env->head))))->type!=symb |
537 |
|| strcmp(CAR(CDR(CDR(CDR(env->head))))->content.sym->id, "if")!=0) { |
|| strcmp(CAR(CDR(CDR(CDR(env->head))))->content.sym->id, "if")!=0) { |
|
printerr(env, "Bad Argument Type"); |
|
538 |
env->err= 2; |
env->err= 2; |
539 |
return; |
return printerr(env); |
540 |
} |
} |
541 |
|
|
542 |
swap(env); toss(env); rot(env); toss(env); |
swap(env); toss(env); rot(env); toss(env); |
546 |
extern void then(environment *env) |
extern void then(environment *env) |
547 |
{ |
{ |
548 |
|
|
549 |
switch(check_args(env, unknown, symb, integer, empty)) { |
if(check_args(env, unknown, symb, integer, empty)) |
550 |
case 1: |
return printerr(env); |
|
printerr(env, "Too Few Arguments"); |
|
|
return; |
|
|
case 2: |
|
|
printerr(env, "Bad Argument Type"); |
|
|
return; |
|
|
default: |
|
|
break; |
|
|
} |
|
551 |
|
|
552 |
/// XXX |
/// XXX |
553 |
|
|
554 |
if(CAR(CDR(env->head))->type!=symb |
if(CAR(CDR(env->head))->type!=symb |
555 |
|| strcmp(CAR(CDR(env->head))->content.sym->id, "if")!=0) { |
|| strcmp(CAR(CDR(env->head))->content.sym->id, "if")!=0) { |
|
printerr(env, "Bad Argument Type"); |
|
556 |
env->err= 2; |
env->err= 2; |
557 |
return; |
return printerr(env); |
558 |
} |
} |
559 |
|
|
560 |
swap(env); toss(env); |
swap(env); toss(env); |
567 |
int truth; |
int truth; |
568 |
value *loop, *test; |
value *loop, *test; |
569 |
|
|
570 |
switch(check_args(env, unknown, integer, empty)) { |
if(check_args(env, unknown, integer, empty)) |
571 |
case 1: |
return printerr(env); |
|
printerr(env, "Too Few Arguments"); |
|
|
return; |
|
|
case 2: |
|
|
printerr(env, "Bad Argument Type"); |
|
|
return; |
|
|
default: |
|
|
break; |
|
|
} |
|
572 |
|
|
573 |
loop= CAR(env->head); |
loop= CAR(env->head); |
574 |
protect(loop); |
protect(loop); |
585 |
/// XXX |
/// XXX |
586 |
|
|
587 |
if(CAR(env->head)->type != integer) { |
if(CAR(env->head)->type != integer) { |
|
printerr(env, "Bad Argument Type"); |
|
588 |
env->err= 2; |
env->err= 2; |
589 |
return; |
return printerr(env); |
590 |
} |
} |
591 |
|
|
592 |
truth= CAR(env->head)->content.i; |
truth= CAR(env->head)->content.i; |
611 |
value *loop; |
value *loop; |
612 |
int foo1, foo2; |
int foo1, foo2; |
613 |
|
|
614 |
switch(check_args(env, unknown, integer, integer, empty)) { |
if(check_args(env, unknown, integer, integer, empty)) |
615 |
case 1: |
return printerr(env); |
|
printerr(env, "Too Few Arguments"); |
|
|
return; |
|
|
case 2: |
|
|
printerr(env, "Bad Argument Type"); |
|
|
return; |
|
|
default: |
|
|
break; |
|
|
} |
|
616 |
|
|
617 |
loop= CAR(env->head); |
loop= CAR(env->head); |
618 |
protect(loop); |
protect(loop); |
649 |
value *loop, *foo; |
value *loop, *foo; |
650 |
value *iterator; |
value *iterator; |
651 |
|
|
652 |
switch(check_args(env, unknown, tcons, empty)) { |
if(check_args(env, unknown, tcons, empty)) |
653 |
case 1: |
return printerr(env); |
|
printerr(env, "Too Few Arguments"); |
|
|
return; |
|
|
case 2: |
|
|
printerr(env, "Bad Argument Type"); |
|
|
return; |
|
|
default: |
|
|
break; |
|
|
} |
|
654 |
|
|
655 |
loop= CAR(env->head); |
loop= CAR(env->head); |
656 |
protect(loop); |
protect(loop); |
671 |
if (iterator->type == tcons){ |
if (iterator->type == tcons){ |
672 |
iterator= CDR(iterator); |
iterator= CDR(iterator); |
673 |
} else { |
} else { |
674 |
printerr(env, "Bad Argument Type"); /* Improper list */ |
env->err= 2; /* Improper list */ |
|
env->err= 2; |
|
675 |
break; |
break; |
676 |
} |
} |
677 |
} |
} |
678 |
unprotect(loop); unprotect(foo); |
unprotect(loop); unprotect(foo); |
679 |
|
|
680 |
|
return printerr(env); |
681 |
} |
} |
682 |
|
|
683 |
/* "to" */ |
/* "to" */ |
686 |
int ending, start, i; |
int ending, start, i; |
687 |
value *iterator, *temp, *end; |
value *iterator, *temp, *end; |
688 |
|
|
689 |
switch(check_args(env, integer, integer, empty)) { |
if(check_args(env, integer, integer, empty)) |
690 |
case 1: |
return printerr(env); |
|
printerr(env, "Too Few Arguments"); |
|
|
return; |
|
|
case 2: |
|
|
printerr(env, "Bad Argument Type"); |
|
|
return; |
|
|
default: |
|
|
break; |
|
|
} |
|
691 |
|
|
692 |
end= new_val(env); |
end= new_val(env); |
693 |
|
|
744 |
{ |
{ |
745 |
FILE *stream; |
FILE *stream; |
746 |
|
|
747 |
switch(check_args(env, port, empty)) { |
if(check_args(env, port, empty)) |
748 |
case 1: |
return printerr(env); |
|
printerr(env, "Too Few Arguments"); |
|
|
return; |
|
|
case 2: |
|
|
printerr(env, "Bad Argument Type"); |
|
|
return; |
|
|
default: |
|
|
break; |
|
|
} |
|
749 |
|
|
750 |
stream=CAR(env->head)->content.p; |
stream=CAR(env->head)->content.p; |
751 |
readlinestream(env, stream); if(env->err) return; |
readlinestream(env, stream); if(env->err) return; |
765 |
{ |
{ |
766 |
FILE *stream; |
FILE *stream; |
767 |
|
|
768 |
switch(check_args(env, port, empty)) { |
if(check_args(env, port, empty)) |
769 |
case 1: |
return printerr(env); |
|
printerr(env, "Too Few Arguments"); |
|
|
return; |
|
|
case 2: |
|
|
printerr(env, "Bad Argument Type"); |
|
|
return; |
|
|
default: |
|
|
break; |
|
|
} |
|
770 |
|
|
771 |
stream=CAR(env->head)->content.p; |
stream=CAR(env->head)->content.p; |
772 |
readstream(env, stream); if(env->err) return; |
readstream(env, stream); if(env->err) return; |
780 |
{ |
{ |
781 |
int freq, dur, period, ticks; |
int freq, dur, period, ticks; |
782 |
|
|
783 |
switch(check_args(env, integer, integer, empty)) { |
if(check_args(env, integer, integer, empty)) |
784 |
case 1: |
return printerr(env); |
|
printerr(env, "Too Few Arguments"); |
|
|
return; |
|
|
case 2: |
|
|
printerr(env, "Bad Argument Type"); |
|
|
return; |
|
|
default: |
|
|
break; |
|
|
} |
|
785 |
|
|
786 |
dur= CAR(env->head)->content.i; |
dur= CAR(env->head)->content.i; |
787 |
toss(env); |
toss(env); |
815 |
{ |
{ |
816 |
int dur; |
int dur; |
817 |
|
|
818 |
switch(check_args(env, integer, empty)) { |
if(check_args(env, integer, empty)) |
819 |
case 1: |
return printerr(env); |
|
printerr(env, "Too Few Arguments"); |
|
|
return; |
|
|
case 2: |
|
|
printerr(env, "Bad Argument Type"); |
|
|
return; |
|
|
default: |
|
|
break; |
|
|
} |
|
820 |
|
|
821 |
dur= CAR(env->head)->content.i; |
dur= CAR(env->head)->content.i; |
822 |
toss(env); |
toss(env); |
824 |
usleep(dur); |
usleep(dur); |
825 |
} |
} |
826 |
|
|
|
/// XXXXXX |
|
|
|
|
827 |
|
|
828 |
/* "*" */ |
/* "*" */ |
829 |
extern void sx_2a(environment *env) |
extern void sx_2a(environment *env) |
831 |
int a, b; |
int a, b; |
832 |
float fa, fb; |
float fa, fb; |
833 |
|
|
834 |
if(env->head->type==empty || CDR(env->head)->type==empty) { |
if(check_args(env, unknown, unknown, empty)) |
835 |
printerr(env, "Too Few Arguments"); |
return printerr(env); |
836 |
env->err= 1; |
|
837 |
return; |
if(check_args(env, integer, integer, empty)==0) { |
|
} |
|
|
|
|
|
if(CAR(env->head)->type==integer |
|
|
&& CAR(CDR(env->head))->type==integer) { |
|
838 |
a= CAR(env->head)->content.i; |
a= CAR(env->head)->content.i; |
839 |
toss(env); if(env->err) return; |
toss(env); if(env->err) return; |
840 |
b= CAR(env->head)->content.i; |
b= CAR(env->head)->content.i; |
844 |
return; |
return; |
845 |
} |
} |
846 |
|
|
847 |
if(CAR(env->head)->type==tfloat |
if(check_args(env, tfloat, tfloat, empty)==0) { |
|
&& CAR(CDR(env->head))->type==tfloat) { |
|
848 |
fa= CAR(env->head)->content.f; |
fa= CAR(env->head)->content.f; |
849 |
toss(env); if(env->err) return; |
toss(env); if(env->err) return; |
850 |
fb= CAR(env->head)->content.f; |
fb= CAR(env->head)->content.f; |
854 |
return; |
return; |
855 |
} |
} |
856 |
|
|
857 |
if(CAR(env->head)->type==tfloat |
if(check_args(env, tfloat, integer, empty)==0) { |
|
&& CAR(CDR(env->head))->type==integer) { |
|
858 |
fa= CAR(env->head)->content.f; |
fa= CAR(env->head)->content.f; |
859 |
toss(env); if(env->err) return; |
toss(env); if(env->err) return; |
860 |
b= CAR(env->head)->content.i; |
b= CAR(env->head)->content.i; |
864 |
return; |
return; |
865 |
} |
} |
866 |
|
|
867 |
if(CAR(env->head)->type==integer |
if(check_args(env, integer, tfloat, empty)==0) { |
|
&& CAR(CDR(env->head))->type==tfloat) { |
|
868 |
a= CAR(env->head)->content.i; |
a= CAR(env->head)->content.i; |
869 |
toss(env); if(env->err) return; |
toss(env); if(env->err) return; |
870 |
fb= CAR(env->head)->content.f; |
fb= CAR(env->head)->content.f; |
874 |
return; |
return; |
875 |
} |
} |
876 |
|
|
877 |
printerr(env, "Bad Argument Type"); |
return printerr(env); |
|
env->err= 2; |
|
878 |
} |
} |
879 |
|
|
880 |
/* "/" */ |
/* "/" */ |
883 |
int a, b; |
int a, b; |
884 |
float fa, fb; |
float fa, fb; |
885 |
|
|
886 |
if(env->head->type==empty || CDR(env->head)->type==empty) { |
if(check_args(env, unknown, unknown, empty)) |
887 |
printerr(env, "Too Few Arguments"); |
return printerr(env); |
888 |
env->err= 1; |
|
889 |
return; |
if(check_args(env, integer, integer, empty)==0) { |
|
} |
|
|
|
|
|
if(CAR(env->head)->type==integer |
|
|
&& CAR(CDR(env->head))->type==integer) { |
|
890 |
a= CAR(env->head)->content.i; |
a= CAR(env->head)->content.i; |
891 |
toss(env); if(env->err) return; |
toss(env); if(env->err) return; |
892 |
b= CAR(env->head)->content.i; |
b= CAR(env->head)->content.i; |
896 |
return; |
return; |
897 |
} |
} |
898 |
|
|
899 |
if(CAR(env->head)->type==tfloat |
if(check_args(env, tfloat, tfloat, empty)==0) { |
|
&& CAR(CDR(env->head))->type==tfloat) { |
|
900 |
fa= CAR(env->head)->content.f; |
fa= CAR(env->head)->content.f; |
901 |
toss(env); if(env->err) return; |
toss(env); if(env->err) return; |
902 |
fb= CAR(env->head)->content.f; |
fb= CAR(env->head)->content.f; |
906 |
return; |
return; |
907 |
} |
} |
908 |
|
|
909 |
if(CAR(env->head)->type==tfloat |
if(check_args(env, tfloat, integer, empty)==0) { |
|
&& CAR(CDR(env->head))->type==integer) { |
|
910 |
fa= CAR(env->head)->content.f; |
fa= CAR(env->head)->content.f; |
911 |
toss(env); if(env->err) return; |
toss(env); if(env->err) return; |
912 |
b= CAR(env->head)->content.i; |
b= CAR(env->head)->content.i; |
916 |
return; |
return; |
917 |
} |
} |
918 |
|
|
919 |
if(CAR(env->head)->type==integer |
if(check_args(env, integer, tfloat, empty)==0) { |
|
&& CAR(CDR(env->head))->type==tfloat) { |
|
920 |
a= CAR(env->head)->content.i; |
a= CAR(env->head)->content.i; |
921 |
toss(env); if(env->err) return; |
toss(env); if(env->err) return; |
922 |
fb= CAR(env->head)->content.f; |
fb= CAR(env->head)->content.f; |
926 |
return; |
return; |
927 |
} |
} |
928 |
|
|
929 |
printerr(env, "Bad Argument Type"); |
return printerr(env); |
|
env->err= 2; |
|
930 |
} |
} |
931 |
|
|
932 |
/* "mod" */ |
/* "mod" */ |
934 |
{ |
{ |
935 |
int a, b; |
int a, b; |
936 |
|
|
937 |
if(env->head->type==empty || CDR(env->head)->type==empty) { |
if(check_args(env, unknown, unknown, empty)) |
938 |
printerr(env, "Too Few Arguments"); |
return printerr(env); |
939 |
env->err= 1; |
|
940 |
return; |
if(check_args(env, integer, integer, empty)==0) { |
|
} |
|
|
|
|
|
if(CAR(env->head)->type==integer |
|
|
&& CAR(CDR(env->head))->type==integer) { |
|
941 |
a= CAR(env->head)->content.i; |
a= CAR(env->head)->content.i; |
942 |
toss(env); if(env->err) return; |
toss(env); if(env->err) return; |
943 |
b= CAR(env->head)->content.i; |
b= CAR(env->head)->content.i; |
947 |
return; |
return; |
948 |
} |
} |
949 |
|
|
950 |
printerr(env, "Bad Argument Type"); |
return printerr(env); |
|
env->err= 2; |
|
951 |
} |
} |
952 |
|
|
953 |
|
|
954 |
/* "div" */ |
/* "div" */ |
955 |
extern void sx_646976(environment *env) |
extern void sx_646976(environment *env) |
956 |
{ |
{ |
957 |
int a, b; |
int a, b; |
|
|
|
|
if(env->head->type==empty || CDR(env->head)->type==empty) { |
|
|
printerr(env, "Too Few Arguments"); |
|
|
env->err= 1; |
|
|
return; |
|
|
} |
|
|
|
|
|
if(CAR(env->head)->type==integer |
|
|
&& CAR(CDR(env->head))->type==integer) { |
|
|
a= CAR(env->head)->content.i; |
|
|
toss(env); if(env->err) return; |
|
|
b= CAR(env->head)->content.i; |
|
|
toss(env); if(env->err) return; |
|
|
push_int(env, (int)b/a); |
|
|
|
|
|
return; |
|
|
} |
|
958 |
|
|
959 |
printerr(env, "Bad Argument Type"); |
if(check_args(env, integer, integer, empty)) |
960 |
env->err= 2; |
return printerr(env); |
961 |
|
|
962 |
|
a= CAR(env->head)->content.i; |
963 |
|
toss(env); if(env->err) return; |
964 |
|
b= CAR(env->head)->content.i; |
965 |
|
toss(env); if(env->err) return; |
966 |
|
push_int(env, (int)b/a); |
967 |
} |
} |
968 |
|
|
969 |
|
|
970 |
extern void setcar(environment *env) |
extern void setcar(environment *env) |
971 |
{ |
{ |
|
if(env->head->type==empty || CDR(env->head)->type==empty) { |
|
|
printerr(env, "Too Few Arguments"); |
|
|
env->err= 1; |
|
|
return; |
|
|
} |
|
972 |
|
|
973 |
if(CDR(env->head)->type!=tcons) { |
if(check_args(env, tcons, unknown, empty)) |
974 |
printerr(env, "Bad Argument Type"); |
return printerr(env); |
|
env->err= 2; |
|
|
return; |
|
|
} |
|
975 |
|
|
976 |
CAR(CAR(CDR(env->head)))=CAR(env->head); |
CAR(CAR(CDR(env->head)))=CAR(env->head); |
977 |
toss(env); |
toss(env); |
979 |
|
|
980 |
extern void setcdr(environment *env) |
extern void setcdr(environment *env) |
981 |
{ |
{ |
|
if(env->head->type==empty || CDR(env->head)->type==empty) { |
|
|
printerr(env, "Too Few Arguments"); |
|
|
env->err= 1; |
|
|
return; |
|
|
} |
|
982 |
|
|
983 |
if(CDR(env->head)->type!=tcons) { |
if(check_args(env, tcons, unknown, empty)) |
984 |
printerr(env, "Bad Argument Type"); |
return printerr(env); |
|
env->err= 2; |
|
|
return; |
|
|
} |
|
985 |
|
|
986 |
CDR(CAR(CDR(env->head)))=CAR(env->head); |
CDR(CAR(CDR(env->head)))=CAR(env->head); |
987 |
toss(env); |
toss(env); |
989 |
|
|
990 |
extern void car(environment *env) |
extern void car(environment *env) |
991 |
{ |
{ |
|
if(env->head->type==empty) { |
|
|
printerr(env, "Too Few Arguments"); |
|
|
env->err= 1; |
|
|
return; |
|
|
} |
|
992 |
|
|
993 |
if(CAR(env->head)->type!=tcons) { |
if(check_args(env, tcons, empty)) |
994 |
printerr(env, "Bad Argument Type"); |
return printerr(env); |
|
env->err= 2; |
|
|
return; |
|
|
} |
|
995 |
|
|
996 |
CAR(env->head)=CAR(CAR(env->head)); |
CAR(env->head)=CAR(CAR(env->head)); |
997 |
} |
} |
998 |
|
|
999 |
extern void cdr(environment *env) |
extern void cdr(environment *env) |
1000 |
{ |
{ |
|
if(env->head->type==empty) { |
|
|
printerr(env, "Too Few Arguments"); |
|
|
env->err= 1; |
|
|
return; |
|
|
} |
|
1001 |
|
|
1002 |
if(CAR(env->head)->type!=tcons) { |
if(check_args(env, tcons, empty)) |
1003 |
printerr(env, "Bad Argument Type"); |
return printerr(env); |
|
env->err= 2; |
|
|
return; |
|
|
} |
|
1004 |
|
|
1005 |
CAR(env->head)=CDR(CAR(env->head)); |
CAR(env->head)=CDR(CAR(env->head)); |
1006 |
} |
} |
1009 |
{ |
{ |
1010 |
value *val; |
value *val; |
1011 |
|
|
1012 |
if(env->head->type==empty || CDR(env->head)->type==empty) { |
if(check_args(env, unknown, unknown, empty)) |
1013 |
printerr(env, "Too Few Arguments"); |
return printerr(env); |
|
env->err= 1; |
|
|
return; |
|
|
} |
|
1014 |
|
|
1015 |
val=new_val(env); |
val=new_val(env); |
1016 |
val->content.c= malloc(sizeof(pair)); |
val->content.c= malloc(sizeof(pair)); |
1027 |
swap(env); if(env->err) return; |
swap(env); if(env->err) return; |
1028 |
toss(env); if(env->err) return; |
toss(env); if(env->err) return; |
1029 |
swap(env); if(env->err) return; |
swap(env); if(env->err) return; |
1030 |
toss(env); if(env->err) return; |
toss(env); |
1031 |
} |
} |
1032 |
|
|
1033 |
|
|
1038 |
|
|
1039 |
/* Needs two values on the stack, the top one must be an association |
/* Needs two values on the stack, the top one must be an association |
1040 |
list */ |
list */ |
1041 |
if(env->head->type==empty || CDR(env->head)->type==empty) { |
if(check_args(env, tcons, unknown, empty)) |
1042 |
printerr(env, "Too Few Arguments"); |
return printerr(env); |
|
env->err= 1; |
|
|
return; |
|
|
} |
|
|
|
|
|
if(CAR(env->head)->type!=tcons) { |
|
|
printerr(env, "Bad Argument Type"); |
|
|
env->err= 2; |
|
|
return; |
|
|
} |
|
1043 |
|
|
1044 |
key=CAR(CDR(env->head)); |
key=CAR(CDR(env->head)); |
1045 |
item=CAR(env->head); |
item=CAR(env->head); |
1046 |
|
|
1047 |
while(item->type == tcons){ |
while(item->type == tcons){ |
1048 |
if(CAR(item)->type != tcons){ |
if(CAR(item)->type != tcons){ |
|
printerr(env, "Bad Argument Type"); |
|
1049 |
env->err= 2; |
env->err= 2; |
1050 |
return; |
return printerr(env); |
1051 |
} |
} |
1052 |
|
|
1053 |
push_val(env, key); |
push_val(env, key); |
1054 |
push_val(env, CAR(CAR(item))); |
push_val(env, CAR(CAR(item))); |
1055 |
eqfunc(env); if(env->err) return; |
eqfunc((void*)env); if(env->err) return; |
1056 |
|
|
1057 |
/* Check the result of 'eqfunc' */ |
/* Check the result of 'eqfunc' */ |
1058 |
if(env->head->type==empty) { |
if(check_args(env, integer, empty)) |
1059 |
printerr(env, "Too Few Arguments"); |
return printerr(env); |
|
env->err= 1; |
|
|
return; |
|
|
} |
|
|
if(CAR(env->head)->type!=integer) { |
|
|
printerr(env, "Bad Argument Type"); |
|
|
env->err= 2; |
|
|
return; |
|
|
} |
|
1060 |
|
|
1061 |
if(CAR(env->head)->content.i){ |
if(CAR(env->head)->content.i){ |
1062 |
toss(env); if(env->err) return; |
toss(env); if(env->err) return; |
1065 |
toss(env); if(env->err) return; |
toss(env); if(env->err) return; |
1066 |
|
|
1067 |
if(item->type!=tcons) { |
if(item->type!=tcons) { |
|
printerr(env, "Bad Argument Type"); |
|
1068 |
env->err= 2; |
env->err= 2; |
1069 |
return; |
return printerr(env); |
1070 |
} |
} |
1071 |
|
|
1072 |
item=CDR(item); |
item=CDR(item); |
1088 |
/* 1: [ [ 1 . 2 ] [ 3 . 4 ] ] => 1: [ 3 . 4 ] */ |
/* 1: [ [ 1 . 2 ] [ 3 . 4 ] ] => 1: [ 3 . 4 ] */ |
1089 |
extern void assq(environment *env) |
extern void assq(environment *env) |
1090 |
{ |
{ |
1091 |
assocgen(env, eq); |
assocgen(env, (void*)eq); |
1092 |
} |
} |
1093 |
|
|
1094 |
|
|
1107 |
value *new_port; |
value *new_port; |
1108 |
FILE *stream; |
FILE *stream; |
1109 |
|
|
1110 |
if(env->head->type == empty || CDR(env->head)->type == empty) { |
if(check_args(env, string, string, empty)) |
1111 |
printerr(env, "Too Few Arguments"); |
return printerr(env); |
|
env->err=1; |
|
|
return; |
|
|
} |
|
|
|
|
|
if(CAR(env->head)->type != string |
|
|
|| CAR(CDR(env->head))->type != string) { |
|
|
printerr(env, "Bad Argument Type"); |
|
|
env->err= 2; |
|
|
return; |
|
|
} |
|
1112 |
|
|
1113 |
stream=fopen(CAR(CDR(env->head))->content.ptr, |
stream=fopen(CAR(CDR(env->head))->content.ptr, |
1114 |
CAR(env->head)->content.ptr); |
CAR(env->head)->content.ptr); |
1137 |
{ |
{ |
1138 |
int ret; |
int ret; |
1139 |
|
|
1140 |
if(env->head->type == empty) { |
if(check_args(env, port, empty)) |
1141 |
printerr(env, "Too Few Arguments"); |
return printerr(env); |
|
env->err=1; |
|
|
return; |
|
|
} |
|
|
|
|
|
if(CAR(env->head)->type != port) { |
|
|
printerr(env, "Bad Argument Type"); |
|
|
env->err= 2; |
|
|
return; |
|
|
} |
|
1142 |
|
|
1143 |
ret= fclose(CAR(env->head)->content.p); |
ret= fclose(CAR(env->head)->content.p); |
1144 |
|
|
1151 |
toss(env); |
toss(env); |
1152 |
} |
} |
1153 |
|
|
1154 |
|
|
1155 |
extern void mangle(environment *env) |
extern void mangle(environment *env) |
1156 |
{ |
{ |
1157 |
char *new_string; |
char *new_string; |
1158 |
|
|
1159 |
if(env->head->type==empty) { |
if(check_args(env, string, empty)) |
1160 |
printerr(env, "Too Few Arguments"); |
return printerr(env); |
|
env->err= 1; |
|
|
return; |
|
|
} |
|
|
|
|
|
if(CAR(env->head)->type!=string) { |
|
|
printerr(env, "Bad Argument Type"); |
|
|
env->err= 2; |
|
|
return; |
|
|
} |
|
1161 |
|
|
1162 |
new_string= mangle_str(CAR(env->head)->content.string); |
new_string= mangle_str(CAR(env->head)->content.string); |
1163 |
|
|
1177 |
extern void sx_77616974706964(environment *env) |
extern void sx_77616974706964(environment *env) |
1178 |
{ |
{ |
1179 |
|
|
1180 |
if(env->head->type==empty) { |
if(check_args(env, integer, empty)) |
1181 |
printerr(env, "Too Few Arguments"); |
return printerr(env); |
|
env->err= 1; |
|
|
return; |
|
|
} |
|
|
|
|
|
if(CAR(env->head)->type!=integer) { |
|
|
printerr(env, "Bad Argument Type"); |
|
|
env->err= 2; |
|
|
return; |
|
|
} |
|
1182 |
|
|
1183 |
push_int(env, waitpid(CAR(env->head)->content.i, NULL, 0)); |
push_int(env, waitpid(CAR(env->head)->content.i, NULL, 0)); |
1184 |
swap(env); toss(env); |
swap(env); toss(env); |
1188 |
/* Discard the top element of the stack. */ |
/* Discard the top element of the stack. */ |
1189 |
extern void toss(environment *env) |
extern void toss(environment *env) |
1190 |
{ |
{ |
1191 |
if(env->head->type==empty) { |
|
1192 |
printerr(env, "Too Few Arguments"); |
if(check_args(env, unknown, empty)) |
1193 |
env->err= 1; |
return printerr(env); |
1194 |
return; |
|
|
} |
|
|
|
|
1195 |
env->head= CDR(env->head); /* Remove the top stack item */ |
env->head= CDR(env->head); /* Remove the top stack item */ |
1196 |
} |
} |
1197 |
|
|
1272 |
|
|
1273 |
extern void copying(environment *env) |
extern void copying(environment *env) |
1274 |
{ |
{ |
1275 |
printf(license_message); |
puts(license_message); |
1276 |
} |
} |
1277 |
|
|
1278 |
|
|
1279 |
extern void warranty(environment *env) |
extern void warranty(environment *env) |
1280 |
{ |
{ |
1281 |
printf(warranty_message); |
puts(warranty_message); |
1282 |
} |
} |