/[cvs]/stack/symbols.c
ViewVC logotype

Diff of /stack/symbols.c

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.5 by masse, Fri Aug 8 14:20:49 2003 UTC revision 1.10 by masse, Mon Aug 18 14:39:16 2003 UTC
# Line 10  extern void nl(environment *env) Line 10  extern void nl(environment *env)
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    if(env->head->type==empty) {    if(check_args(env, 1, port))
14      printerr("Too Few Arguments");      return printerr(env);
     env->err= 1;  
     return;  
   }  
   
   if(CAR(env->head)->type!=port) {  
     printerr("Bad Argument Type");  
     env->err= 2;  
     return;  
   }  
15    
16    if(fprintf(CAR(env->head)->content.p, "\n") < 0){    if(fprintf(CAR(env->head)->content.p, "\n") < 0) {
     perror("nl");  
17      env->err= 5;      env->err= 5;
18      return;      return printerr(env);
19    }    }
20    
21    toss(env);    toss(env);
22  }  }
23    
24  /* Gets the type of a value */  /* Gets the type of a value */
25  extern void type(environment *env)  extern void type(environment *env)
26  {  {
27    if(env->head->type==empty) {  
28      printerr("Too Few Arguments");    if(check_args(env, 1, unknown))
29      env->err= 1;      return printerr(env);
     return;  
   }  
30    
31    switch(CAR(env->head)->type){    switch(CAR(env->head)->type){
32    case empty:    case empty:
33      push_sym(env, "empty");      push_sym(env, "empty");
34      break;      break;
35      case unknown:
36        push_sym(env, "unknown");
37        break;
38    case integer:    case integer:
39      push_sym(env, "integer");      push_sym(env, "integer");
40      break;      break;
# Line 73  extern void type(environment *env) Line 65  extern void type(environment *env)
65  /* Print the top element of the stack but don't discard it */  /* Print the top element of the stack but don't discard it */
66  extern void print_(environment *env)  extern void print_(environment *env)
67  {  {
68    if(env->head->type==empty) {  
69      printerr("Too Few Arguments");    if(check_args(env, 1, unknown))
70      env->err= 1;      return printerr(env);
71      return;  
   }  
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;
74    nl(env);    nl(env);
# Line 95  extern void print(environment *env) Line 86  extern void print(environment *env)
86     discard it. */     discard it. */
87  extern void princ_(environment *env)  extern void princ_(environment *env)
88  {  {
89    if(env->head->type==empty) {  
90      printerr("Too Few Arguments");    if(check_args(env, 1, unknown))
91      env->err= 1;      return printerr(env);
92      return;  
   }  
93    print_val(env, CAR(env->head), 1, NULL, stdout);    print_val(env, CAR(env->head), 1, NULL, stdout);
94  }  }
95    
# Line 114  extern void princ(environment *env) Line 104  extern void princ(environment *env)
104  /* Print a value to a port, but don't discard it */  /* Print a value to a port, but don't discard it */
105  extern void printport_(environment *env)  extern void printport_(environment *env)
106  {  {
   if(env->head->type==empty ||  CDR(env->head)->type == empty) {  
     printerr("Too Few Arguments");  
     env->err= 1;  
     return;  
   }  
107    
108    if(CAR(env->head)->type!=port) {    if(check_args(env, 2, port, unknown))
109      printerr("Bad Argument Type");      return printerr(env);
     env->err= 2;  
     return;  
   }  
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;
# Line 142  extern void printport(environment *env) Line 124  extern void printport(environment *env)
124  /* Print, without quotes, to a port, a value, but don't discard it. */  /* Print, without quotes, to a port, a value, but don't discard it. */
125  extern void princport_(environment *env)  extern void princport_(environment *env)
126  {  {
   if(env->head->type==empty ||  CDR(env->head)->type == empty) {  
     printerr("Too Few Arguments");  
     env->err= 1;  
     return;  
   }  
127    
128    if(CAR(env->head)->type!=port) {    if(check_args(env, 2, port, unknown))
129      printerr("Bad Argument Type");      return printerr(env);
     env->err= 2;  
     return;  
   }  
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;
# Line 170  extern void princport(environment *env) Line 144  extern void princport(environment *env)
144  extern void rot(environment *env)  extern void rot(environment *env)
145  {  {
146    value *temp= env->head;    value *temp= env->head;
147      
148    if(env->head->type == empty || CDR(env->head)->type == empty    if(check_args(env, 3, unknown, unknown, unknown))
149       || CDR(CDR(env->head))->type == empty) {      return printerr(env);
     printerr("Too Few Arguments");  
     env->err= 1;  
     return;  
   }  
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);
# Line 188  extern void expand(environment *env) Line 158  extern void expand(environment *env)
158  {  {
159    value *temp, *new_head;    value *temp, *new_head;
160    
161    /* Is top element a list? */    if(check_args(env, 1, tcons))
162    if(env->head->type==empty) {      return printerr(env);
     printerr("Too Few Arguments");  
     env->err= 1;  
     return;  
   }  
   
   if(CAR(env->head)->type!=tcons) {  
     printerr("Bad Argument Type");  
     env->err= 2;  
     return;  
   }  
163    
164    rev(env);    rev(env);
165    
# Line 211  extern void expand(environment *env) Line 171  extern void expand(environment *env)
171    
172    toss(env);    toss(env);
173    
174      /// XXX
175    /* Find the end of the list */    /* Find the end of the list */
176    while(CDR(temp)->type != empty) {    while(CDR(temp)->type != empty) {
177      if (CDR(temp)->type == tcons)      if (CDR(temp)->type == tcons)
178        temp= CDR(temp);        temp= CDR(temp);
179      else {      else {
180        printerr("Bad Argument Type"); /* Improper list */        env->err= 2; /* Improper list */
181        env->err= 2;        return printerr(env);
       return;  
182      }      }
183    }    }
184    
# Line 233  extern void eq(environment *env) Line 193  extern void eq(environment *env)
193  {  {
194    void *left, *right;    void *left, *right;
195    
196    if(env->head->type==empty || CDR(env->head)->type==empty) {    if(check_args(env, 2, unknown, unknown))
197      printerr("Too Few Arguments");      return printerr(env);
     env->err= 1;  
     return;  
   }  
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;
# Line 251  extern void not(environment *env) Line 208  extern void not(environment *env)
208  {  {
209    int val;    int val;
210    
211    if(env->head->type==empty) {    if(check_args(env, 1, integer))
212      printerr("Too Few Arguments");      return printerr(env);
     env->err= 1;  
     return;  
   }  
   
   if(CAR(env->head)->type!=integer) {  
     printerr("Bad Argument Type");  
     env->err= 2;  
     return;  
   }  
213    
214    val= CAR(env->head)->content.i;    val= CAR(env->head)->content.i;
215    toss(env);    toss(env);
# Line 281  extern void def(environment *env) Line 229  extern void def(environment *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    if(env->head->type==empty || CDR(env->head)->type==empty) {    if(check_args(env, 2, symb, unknown))
233      printerr("Too Few Arguments");      return printerr(env);
     env->err= 1;  
     return;  
   }  
   
   if(CAR(env->head)->type!=symb) {  
     printerr("Bad Argument Type");  
     env->err= 2;  
     return;  
   }  
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;
# Line 313  extern void forget(environment *env) Line 252  extern void forget(environment *env)
252  {  {
253    char* sym_id;    char* sym_id;
254    
255    if(env->head->type==empty) {    if(check_args(env, 1, symb))
256      printerr("Too Few Arguments");      return printerr(env);
     env->err= 1;  
     return;  
   }  
     
   if(CAR(env->head)->type!=symb) {  
     printerr("Bad Argument Type");  
     env->err= 2;  
     return;  
   }  
257    
258    sym_id= CAR(env->head)->content.sym->id;    sym_id= CAR(env->head)->content.sym->id;
259    toss(env);    toss(env);
# Line 346  extern void sx_2b(environment *env) Line 276  extern void sx_2b(environment *env)
276    char* new_string;    char* new_string;
277    value *a_val, *b_val;    value *a_val, *b_val;
278    
279    if(env->head->type==empty || CDR(env->head)->type==empty) {    if(check_args(env, 2, string, string)==0) {
     printerr("Too Few Arguments");  
     env->err= 1;  
     return;  
   }  
   
   if(CAR(env->head)->type==string  
      && CAR(CDR(env->head))->type==string) {  
280      a_val= CAR(env->head);      a_val= CAR(env->head);
281      b_val= CAR(CDR(env->head));      b_val= CAR(CDR(env->head));
282      protect(a_val); protect(b_val);      protect(a_val); protect(b_val);
# Line 371  extern void sx_2b(environment *env) Line 294  extern void sx_2b(environment *env)
294      return;      return;
295    }    }
296        
297    if(CAR(env->head)->type==integer    if(check_args(env, 2, integer, integer)==0) {
      && CAR(CDR(env->head))->type==integer) {  
298      a= CAR(env->head)->content.i;      a= CAR(env->head)->content.i;
299      toss(env); if(env->err) return;      toss(env); if(env->err) return;
300      b= CAR(env->head)->content.i;      b= CAR(env->head)->content.i;
# Line 382  extern void sx_2b(environment *env) Line 304  extern void sx_2b(environment *env)
304      return;      return;
305    }    }
306    
307    if(CAR(env->head)->type==tfloat    if(check_args(env, 2, tfloat, tfloat)==0) {
      && CAR(CDR(env->head))->type==tfloat) {  
308      fa= CAR(env->head)->content.f;      fa= CAR(env->head)->content.f;
309      toss(env); if(env->err) return;      toss(env); if(env->err) return;
310      fb= CAR(env->head)->content.f;      fb= CAR(env->head)->content.f;
# Line 393  extern void sx_2b(environment *env) Line 314  extern void sx_2b(environment *env)
314      return;      return;
315    }    }
316    
317    if(CAR(env->head)->type==tfloat    if(check_args(env, 2, tfloat, integer)==0) {
      && CAR(CDR(env->head))->type==integer) {  
318      fa= CAR(env->head)->content.f;      fa= CAR(env->head)->content.f;
319      toss(env); if(env->err) return;      toss(env); if(env->err) return;
320      b= CAR(env->head)->content.i;      b= CAR(env->head)->content.i;
# Line 404  extern void sx_2b(environment *env) Line 324  extern void sx_2b(environment *env)
324      return;      return;
325    }    }
326    
327    if(CAR(env->head)->type==integer    if(check_args(env, 2, integer, tfloat)==0) {
      && CAR(CDR(env->head))->type==tfloat) {  
328      a= CAR(env->head)->content.i;      a= CAR(env->head)->content.i;
329      toss(env); if(env->err) return;      toss(env); if(env->err) return;
330      fb= CAR(env->head)->content.f;      fb= CAR(env->head)->content.f;
# Line 415  extern void sx_2b(environment *env) Line 334  extern void sx_2b(environment *env)
334      return;      return;
335    }    }
336    
337    printerr("Bad Argument Type");    return printerr(env);
   env->err=2;  
338  }  }
339    
340  /* "-" */  /* "-" */
# Line 425  extern void sx_2d(environment *env) Line 343  extern void sx_2d(environment *env)
343    int a, b;    int a, b;
344    float fa, fb;    float fa, fb;
345    
346    if(env->head->type==empty || CDR(env->head)->type==empty) {    if(check_args(env, 2, integer, integer)==0) {
     printerr("Too Few Arguments");  
     env->err=1;  
     return;  
   }  
     
   if(CAR(env->head)->type==integer  
      && CAR(CDR(env->head))->type==integer) {  
347      a= CAR(env->head)->content.i;      a= CAR(env->head)->content.i;
348      toss(env); if(env->err) return;      toss(env); if(env->err) return;
349      b= CAR(env->head)->content.i;      b= CAR(env->head)->content.i;
# Line 442  extern void sx_2d(environment *env) Line 353  extern void sx_2d(environment *env)
353      return;      return;
354    }    }
355    
356    if(CAR(env->head)->type==tfloat    if(check_args(env, 2, tfloat, tfloat)==0) {
      && CAR(CDR(env->head))->type==tfloat) {  
357      fa= CAR(env->head)->content.f;      fa= CAR(env->head)->content.f;
358      toss(env); if(env->err) return;      toss(env); if(env->err) return;
359      fb= CAR(env->head)->content.f;      fb= CAR(env->head)->content.f;
# Line 453  extern void sx_2d(environment *env) Line 363  extern void sx_2d(environment *env)
363      return;      return;
364    }    }
365    
366    if(CAR(env->head)->type==tfloat    if(check_args(env, 2, tfloat, integer)==0) {
      && CAR(CDR(env->head))->type==integer) {  
367      fa= CAR(env->head)->content.f;      fa= CAR(env->head)->content.f;
368      toss(env); if(env->err) return;      toss(env); if(env->err) return;
369      b= CAR(env->head)->content.i;      b= CAR(env->head)->content.i;
# Line 464  extern void sx_2d(environment *env) Line 373  extern void sx_2d(environment *env)
373      return;      return;
374    }    }
375    
376    if(CAR(env->head)->type==integer    if(check_args(env, 2, integer, tfloat)==0) {
      && CAR(CDR(env->head))->type==tfloat) {  
377      a= CAR(env->head)->content.i;      a= CAR(env->head)->content.i;
378      toss(env); if(env->err) return;      toss(env); if(env->err) return;
379      fb= CAR(env->head)->content.f;      fb= CAR(env->head)->content.f;
# Line 475  extern void sx_2d(environment *env) Line 383  extern void sx_2d(environment *env)
383      return;      return;
384    }    }
385    
386    printerr("Bad Argument Type");    return printerr(env);
   env->err=2;  
387  }  }
388    
389  /* ">" */  /* ">" */
# Line 485  extern void sx_3e(environment *env) Line 392  extern void sx_3e(environment *env)
392    int a, b;    int a, b;
393    float fa, fb;    float fa, fb;
394    
395    if(env->head->type==empty || CDR(env->head)->type==empty) {    if(check_args(env, 2, integer, integer)==0) {
     printerr("Too Few Arguments");  
     env->err= 1;  
     return;  
   }  
     
   if(CAR(env->head)->type==integer  
      && CAR(CDR(env->head))->type==integer) {  
396      a= CAR(env->head)->content.i;      a= CAR(env->head)->content.i;
397      toss(env); if(env->err) return;      toss(env); if(env->err) return;
398      b= CAR(env->head)->content.i;      b= CAR(env->head)->content.i;
# Line 502  extern void sx_3e(environment *env) Line 402  extern void sx_3e(environment *env)
402      return;      return;
403    }    }
404    
405    if(CAR(env->head)->type==tfloat    if(check_args(env, 2, tfloat, tfloat)==0) {
      && CAR(CDR(env->head))->type==tfloat) {  
406      fa= CAR(env->head)->content.f;      fa= CAR(env->head)->content.f;
407      toss(env); if(env->err) return;      toss(env); if(env->err) return;
408      fb= CAR(env->head)->content.f;      fb= CAR(env->head)->content.f;
# Line 513  extern void sx_3e(environment *env) Line 412  extern void sx_3e(environment *env)
412      return;      return;
413    }    }
414    
415    if(CAR(env->head)->type==tfloat    if(check_args(env, 2, tfloat, integer)==0) {
      && CAR(CDR(env->head))->type==integer) {  
416      fa= CAR(env->head)->content.f;      fa= CAR(env->head)->content.f;
417      toss(env); if(env->err) return;      toss(env); if(env->err) return;
418      b= CAR(env->head)->content.i;      b= CAR(env->head)->content.i;
# Line 524  extern void sx_3e(environment *env) Line 422  extern void sx_3e(environment *env)
422      return;      return;
423    }    }
424    
425    if(CAR(env->head)->type==integer    if(check_args(env, 2, integer, tfloat)==0) {
      && CAR(CDR(env->head))->type==tfloat) {  
426      a= CAR(env->head)->content.i;      a= CAR(env->head)->content.i;
427      toss(env); if(env->err) return;      toss(env); if(env->err) return;
428      fb= CAR(env->head)->content.f;      fb= CAR(env->head)->content.f;
# Line 535  extern void sx_3e(environment *env) Line 432  extern void sx_3e(environment *env)
432      return;      return;
433    }    }
434    
435    printerr("Bad Argument Type");    return printerr(env);
   env->err= 2;  
436  }  }
437    
438  /* "<" */  /* "<" */
# Line 563  extern void sx_3e3d(environment *env) Line 459  extern void sx_3e3d(environment *env)
459  /* "dup"; duplicates an item on the stack */  /* "dup"; duplicates an item on the stack */
460  extern void sx_647570(environment *env)  extern void sx_647570(environment *env)
461  {  {
462    if(env->head->type==empty) {    if(check_args(env, 1, unknown))
463      printerr("Too Few Arguments");      return printerr(env);
464      env->err= 1;  
     return;  
   }  
465    push_val(env, copy_val(env, CAR(env->head)));    push_val(env, copy_val(env, CAR(env->head)));
466  }  }
467    
# Line 576  extern void sx_6966(environment *env) Line 470  extern void sx_6966(environment *env)
470  {  {
471    int truth;    int truth;
472    
473    if(env->head->type==empty || CDR(env->head)->type==empty) {    if(check_args(env, 2, unknown, integer))
474      printerr("Too Few Arguments");      return printerr(env);
     env->err= 1;  
     return;  
   }  
475    
   if(CAR(CDR(env->head))->type != integer) {  
     printerr("Bad Argument Type");  
     env->err= 2;  
     return;  
   }  
     
476    swap(env);    swap(env);
477    if(env->err) return;    if(env->err) return;
478        
# Line 607  extern void ifelse(environment *env) Line 492  extern void ifelse(environment *env)
492  {  {
493    int truth;    int truth;
494    
495    if(env->head->type==empty || CDR(env->head)->type==empty    if(check_args(env, 3, unknown, unknown, integer))
496       || CDR(CDR(env->head))->type==empty) {      return printerr(env);
     printerr("Too Few Arguments");  
     env->err= 1;  
     return;  
   }  
497    
   if(CAR(CDR(CDR(env->head)))->type!=integer) {  
     printerr("Bad Argument Type");  
     env->err= 2;  
     return;  
   }  
     
498    rot(env);    rot(env);
499    if(env->err) return;    if(env->err) return;
500        
# Line 641  extern void ifelse(environment *env) Line 516  extern void ifelse(environment *env)
516  /* "else" */  /* "else" */
517  extern void sx_656c7365(environment *env)  extern void sx_656c7365(environment *env)
518  {  {
519    if(env->head->type==empty || CDR(env->head)->type==empty  
520       || CDR(CDR(env->head))->type==empty || CDR(CDR(CDR(env->head)))->type==empty    if(check_args(env, 5, unknown, symb, unknown, symb, integer))
521       || CDR(CDR(CDR(CDR(env->head))))->type==empty) {      return printerr(env);
522      printerr("Too Few Arguments");  
523      env->err= 1;    /// XXX
     return;  
   }  
524    
525    if(CAR(CDR(env->head))->type!=symb    if(CAR(CDR(env->head))->type!=symb
526       || strcmp(CAR(CDR(env->head))->content.sym->id, "then")!=0       || strcmp(CAR(CDR(env->head))->content.sym->id, "then")!=0
527       || CAR(CDR(CDR(CDR(env->head))))->type!=symb       || CAR(CDR(CDR(CDR(env->head))))->type!=symb
528       || 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("Bad Argument Type");  
529      env->err= 2;      env->err= 2;
530      return;      return printerr(env);
531    }    }
532    
533    swap(env); toss(env); rot(env); toss(env);    swap(env); toss(env); rot(env); toss(env);
# Line 664  extern void sx_656c7365(environment *env Line 536  extern void sx_656c7365(environment *env
536    
537  extern void then(environment *env)  extern void then(environment *env)
538  {  {
539    if(env->head->type==empty || CDR(env->head)->type==empty    
540       || CDR(CDR(env->head))->type==empty) {    if(check_args(env, 3, unknown, symb, integer))
541      printerr("Too Few Arguments");      return printerr(env);
542      env->err= 1;  
543      return;    /// XXX
   }  
544    
545    if(CAR(CDR(env->head))->type!=symb    if(CAR(CDR(env->head))->type!=symb
546       || strcmp(CAR(CDR(env->head))->content.sym->id, "if")!=0) {       || strcmp(CAR(CDR(env->head))->content.sym->id, "if")!=0) {
     printerr("Bad Argument Type");  
547      env->err= 2;      env->err= 2;
548      return;      return printerr(env);
549    }    }
550    
551    swap(env); toss(env);    swap(env); toss(env);
# Line 688  extern void sx_7768696c65(environment *e Line 558  extern void sx_7768696c65(environment *e
558    int truth;    int truth;
559    value *loop, *test;    value *loop, *test;
560    
561    if(env->head->type==empty || CDR(env->head)->type==empty) {    if(check_args(env, 2, unknown, integer))
562      printerr("Too Few Arguments");      return printerr(env);
     env->err= 1;  
     return;  
   }  
563    
564    loop= CAR(env->head);    loop= CAR(env->head);
565    protect(loop);    protect(loop);
# Line 705  extern void sx_7768696c65(environment *e Line 572  extern void sx_7768696c65(environment *e
572    do {    do {
573      push_val(env, test);      push_val(env, test);
574      eval(env);      eval(env);
575    
576        /// XXX
577            
578      if(CAR(env->head)->type != integer) {      if(CAR(env->head)->type != integer) {
       printerr("Bad Argument Type");  
579        env->err= 2;        env->err= 2;
580        return;        return printerr(env);
581      }      }
582            
583      truth= CAR(env->head)->content.i;      truth= CAR(env->head)->content.i;
# Line 734  extern void sx_666f72(environment *env) Line 602  extern void sx_666f72(environment *env)
602    value *loop;    value *loop;
603    int foo1, foo2;    int foo1, foo2;
604    
605    if(env->head->type==empty || CDR(env->head)->type==empty    if(check_args(env, 3, unknown, integer, integer))
606       || CDR(CDR(env->head))->type==empty) {      return printerr(env);
     printerr("Too Few Arguments");  
     env->err= 1;  
     return;  
   }  
   
   if(CAR(CDR(env->head))->type!=integer  
      || CAR(CDR(CDR(env->head)))->type!=integer) {  
     printerr("Bad Argument Type");  
     env->err= 2;  
     return;  
   }  
607    
608    loop= CAR(env->head);    loop= CAR(env->head);
609    protect(loop);    protect(loop);
# Line 782  extern void foreach(environment *env) Line 639  extern void foreach(environment *env)
639  {    {  
640    value *loop, *foo;    value *loop, *foo;
641    value *iterator;    value *iterator;
     
   if(env->head->type==empty || CDR(env->head)->type==empty) {  
     printerr("Too Few Arguments");  
     env->err= 1;  
     return;  
   }  
   
   if(CAR(CDR(env->head))->type!=tcons) {  
     printerr("Bad Argument Type");  
     env->err= 2;  
     return;  
   }  
642    
643      if(check_args(env, 2, unknown, tcons))
644        return printerr(env);
645      
646    loop= CAR(env->head);    loop= CAR(env->head);
647    protect(loop);    protect(loop);
648    toss(env); if(env->err) return;    toss(env); if(env->err) return;
# Line 809  extern void foreach(environment *env) Line 657  extern void foreach(environment *env)
657      push_val(env, CAR(iterator));      push_val(env, CAR(iterator));
658      push_val(env, loop);      push_val(env, loop);
659      eval(env); if(env->err) return;      eval(env); if(env->err) return;
660    
661        /// XXX
662      if (iterator->type == tcons){      if (iterator->type == tcons){
663        iterator= CDR(iterator);        iterator= CDR(iterator);
664      } else {      } else {
665        printerr("Bad Argument Type"); /* Improper list */        env->err= 2; /* Improper list */
       env->err= 2;  
666        break;        break;
667      }      }
668    }    }
669    unprotect(loop); unprotect(foo);    unprotect(loop); unprotect(foo);
670      
671      return printerr(env);
672  }  }
673    
674  /* "to" */  /* "to" */
# Line 826  extern void to(environment *env) Line 677  extern void to(environment *env)
677    int ending, start, i;    int ending, start, i;
678    value *iterator, *temp, *end;    value *iterator, *temp, *end;
679    
680    end= new_val(env);    if(check_args(env, 2, integer, integer))
681        return printerr(env);
   if(env->head->type==empty || CDR(env->head)->type==empty) {  
     printerr("Too Few Arguments");  
     env->err= 1;  
     return;  
   }  
682    
683    if(CAR(env->head)->type!=integer    end= new_val(env);
      || CAR(CDR(env->head))->type!=integer) {  
     printerr("Bad Argument Type");  
     env->err= 2;  
     return;  
   }  
684    
685    ending= CAR(env->head)->content.i;    ending= CAR(env->head)->content.i;
686    toss(env); if(env->err) return;    toss(env); if(env->err) return;
# Line 894  extern void readlineport(environment *en Line 735  extern void readlineport(environment *en
735  {  {
736    FILE *stream;    FILE *stream;
737    
738    if(env->head->type==empty) {    if(check_args(env, 1, port))
739      printerr("Too Few Arguments");      return printerr(env);
     env->err= 1;  
     return;  
   }  
   
   if(CAR(env->head)->type!=port) {  
     printerr("Bad Argument Type");  
     env->err= 2;  
     return;  
   }  
740    
741    stream=CAR(env->head)->content.p;    stream=CAR(env->head)->content.p;
742    readlinestream(env, stream); if(env->err) return;    readlinestream(env, stream); if(env->err) return;
# Line 924  extern void readport(environment *env) Line 756  extern void readport(environment *env)
756  {  {
757    FILE *stream;    FILE *stream;
758    
759    if(env->head->type==empty) {    if(check_args(env, 1, port))
760      printerr("Too Few Arguments");      return printerr(env);
     env->err= 1;  
     return;  
   }  
   
   if(CAR(env->head)->type!=port) {  
     printerr("Bad Argument Type");  
     env->err= 2;  
     return;  
   }  
761    
762    stream=CAR(env->head)->content.p;    stream=CAR(env->head)->content.p;
763    readstream(env, stream); if(env->err) return;    readstream(env, stream); if(env->err) return;
# Line 948  extern void beep(environment *env) Line 771  extern void beep(environment *env)
771  {  {
772    int freq, dur, period, ticks;    int freq, dur, period, ticks;
773    
774    if(env->head->type==empty || CDR(env->head)->type==empty) {    if(check_args(env, 2, integer, integer))
775      printerr("Too Few Arguments");      return printerr(env);
     env->err= 1;  
     return;  
   }  
   
   if(CAR(env->head)->type!=integer  
      || CAR(CDR(env->head))->type!=integer) {  
     printerr("Bad Argument Type");  
     env->err= 2;  
     return;  
   }  
776    
777    dur= CAR(env->head)->content.i;    dur= CAR(env->head)->content.i;
778    toss(env);    toss(env);
# Line 979  extern void beep(environment *env) Line 792  extern void beep(environment *env)
792      usleep(dur);      usleep(dur);
793      return;      return;
794    case -1:    case -1:
     perror("beep");  
795      env->err= 5;      env->err= 5;
796      return;      return printerr(env);
797    default:    default:
798      abort();      abort();
799    }    }
# Line 993  extern void sx_77616974(environment *env Line 805  extern void sx_77616974(environment *env
805  {  {
806    int dur;    int dur;
807    
808    if(env->head->type==empty) {    if(check_args(env, 1, integer))
809      printerr("Too Few Arguments");      return printerr(env);
     env->err= 1;  
     return;  
   }  
   
   if(CAR(env->head)->type!=integer) {  
     printerr("Bad Argument Type");  
     env->err= 2;  
     return;  
   }  
810    
811    dur= CAR(env->head)->content.i;    dur= CAR(env->head)->content.i;
812    toss(env);    toss(env);
# Line 1011  extern void sx_77616974(environment *env Line 814  extern void sx_77616974(environment *env
814    usleep(dur);    usleep(dur);
815  }  }
816    
817    
818  /* "*" */  /* "*" */
819  extern void sx_2a(environment *env)  extern void sx_2a(environment *env)
820  {  {
821    int a, b;    int a, b;
822    float fa, fb;    float fa, fb;
823    
824    if(env->head->type==empty || CDR(env->head)->type==empty) {    if(check_args(env, 2, integer, integer)==0) {
     printerr("Too Few Arguments");  
     env->err= 1;  
     return;  
   }  
     
   if(CAR(env->head)->type==integer  
      && CAR(CDR(env->head))->type==integer) {  
825      a= CAR(env->head)->content.i;      a= CAR(env->head)->content.i;
826      toss(env); if(env->err) return;      toss(env); if(env->err) return;
827      b= CAR(env->head)->content.i;      b= CAR(env->head)->content.i;
# Line 1034  extern void sx_2a(environment *env) Line 831  extern void sx_2a(environment *env)
831      return;      return;
832    }    }
833    
834    if(CAR(env->head)->type==tfloat    if(check_args(env, 2, tfloat, tfloat)==0) {
      && CAR(CDR(env->head))->type==tfloat) {  
835      fa= CAR(env->head)->content.f;      fa= CAR(env->head)->content.f;
836      toss(env); if(env->err) return;      toss(env); if(env->err) return;
837      fb= CAR(env->head)->content.f;      fb= CAR(env->head)->content.f;
# Line 1045  extern void sx_2a(environment *env) Line 841  extern void sx_2a(environment *env)
841      return;      return;
842    }    }
843    
844    if(CAR(env->head)->type==tfloat    if(check_args(env, 2, tfloat, integer)==0) {
      && CAR(CDR(env->head))->type==integer) {  
845      fa= CAR(env->head)->content.f;      fa= CAR(env->head)->content.f;
846      toss(env); if(env->err) return;      toss(env); if(env->err) return;
847      b= CAR(env->head)->content.i;      b= CAR(env->head)->content.i;
# Line 1056  extern void sx_2a(environment *env) Line 851  extern void sx_2a(environment *env)
851      return;      return;
852    }    }
853    
854    if(CAR(env->head)->type==integer    if(check_args(env, 2, integer, tfloat)==0) {
      && CAR(CDR(env->head))->type==tfloat) {  
855      a= CAR(env->head)->content.i;      a= CAR(env->head)->content.i;
856      toss(env); if(env->err) return;      toss(env); if(env->err) return;
857      fb= CAR(env->head)->content.f;      fb= CAR(env->head)->content.f;
# Line 1067  extern void sx_2a(environment *env) Line 861  extern void sx_2a(environment *env)
861      return;      return;
862    }    }
863    
864    printerr("Bad Argument Type");    return printerr(env);
   env->err= 2;  
865  }  }
866    
867  /* "/" */  /* "/" */
# Line 1077  extern void sx_2f(environment *env) Line 870  extern void sx_2f(environment *env)
870    int a, b;    int a, b;
871    float fa, fb;    float fa, fb;
872    
873    if(env->head->type==empty || CDR(env->head)->type==empty) {    if(check_args(env, 2, integer, integer)==0) {
     printerr("Too Few Arguments");  
     env->err= 1;  
     return;  
   }  
     
   if(CAR(env->head)->type==integer  
      && CAR(CDR(env->head))->type==integer) {  
874      a= CAR(env->head)->content.i;      a= CAR(env->head)->content.i;
875      toss(env); if(env->err) return;      toss(env); if(env->err) return;
876      b= CAR(env->head)->content.i;      b= CAR(env->head)->content.i;
# Line 1094  extern void sx_2f(environment *env) Line 880  extern void sx_2f(environment *env)
880      return;      return;
881    }    }
882    
883    if(CAR(env->head)->type==tfloat    if(check_args(env, 2, tfloat, tfloat)==0) {
      && CAR(CDR(env->head))->type==tfloat) {  
884      fa= CAR(env->head)->content.f;      fa= CAR(env->head)->content.f;
885      toss(env); if(env->err) return;      toss(env); if(env->err) return;
886      fb= CAR(env->head)->content.f;      fb= CAR(env->head)->content.f;
# Line 1105  extern void sx_2f(environment *env) Line 890  extern void sx_2f(environment *env)
890      return;      return;
891    }    }
892    
893    if(CAR(env->head)->type==tfloat    if(check_args(env, 2, tfloat, integer)==0) {
      && CAR(CDR(env->head))->type==integer) {  
894      fa= CAR(env->head)->content.f;      fa= CAR(env->head)->content.f;
895      toss(env); if(env->err) return;      toss(env); if(env->err) return;
896      b= CAR(env->head)->content.i;      b= CAR(env->head)->content.i;
# Line 1116  extern void sx_2f(environment *env) Line 900  extern void sx_2f(environment *env)
900      return;      return;
901    }    }
902    
903    if(CAR(env->head)->type==integer    if(check_args(env, 2, integer, tfloat)==0) {
      && CAR(CDR(env->head))->type==tfloat) {  
904      a= CAR(env->head)->content.i;      a= CAR(env->head)->content.i;
905      toss(env); if(env->err) return;      toss(env); if(env->err) return;
906      fb= CAR(env->head)->content.f;      fb= CAR(env->head)->content.f;
# Line 1127  extern void sx_2f(environment *env) Line 910  extern void sx_2f(environment *env)
910      return;      return;
911    }    }
912    
913    printerr("Bad Argument Type");    return printerr(env);
   env->err= 2;  
914  }  }
915    
916  /* "mod" */  /* "mod" */
# Line 1136  extern void mod(environment *env) Line 918  extern void mod(environment *env)
918  {  {
919    int a, b;    int a, b;
920    
921    if(env->head->type==empty || CDR(env->head)->type==empty) {    if(check_args(env, 2, integer, integer)==0) {
     printerr("Too Few Arguments");  
     env->err= 1;  
     return;  
   }  
     
   if(CAR(env->head)->type==integer  
      && CAR(CDR(env->head))->type==integer) {  
922      a= CAR(env->head)->content.i;      a= CAR(env->head)->content.i;
923      toss(env); if(env->err) return;      toss(env); if(env->err) return;
924      b= CAR(env->head)->content.i;      b= CAR(env->head)->content.i;
# Line 1153  extern void mod(environment *env) Line 928  extern void mod(environment *env)
928      return;      return;
929    }    }
930    
931    printerr("Bad Argument Type");    return printerr(env);
   env->err= 2;  
932  }  }
933    
934    
935  /* "div" */  /* "div" */
936  extern void sx_646976(environment *env)  extern void sx_646976(environment *env)
937  {  {
938    int a, b;    int a, b;
     
   if(env->head->type==empty || CDR(env->head)->type==empty) {  
     printerr("Too Few Arguments");  
     env->err= 1;  
     return;  
   }  
939    
940    if(CAR(env->head)->type==integer    if(check_args(env, 2, integer, integer))
941       && CAR(CDR(env->head))->type==integer) {      return printerr(env);
942      a= CAR(env->head)->content.i;    
943      toss(env); if(env->err) return;    a= CAR(env->head)->content.i;
944      b= CAR(env->head)->content.i;    toss(env); if(env->err) return;
945      toss(env); if(env->err) return;    b= CAR(env->head)->content.i;
946      push_int(env, (int)b/a);    toss(env); if(env->err) return;
947      push_int(env, (int)b/a);
     return;  
   }  
   
   printerr("Bad Argument Type");  
   env->err= 2;  
948  }  }
949    
950    
951  extern void setcar(environment *env)  extern void setcar(environment *env)
952  {  {
   if(env->head->type==empty || CDR(env->head)->type==empty) {  
     printerr("Too Few Arguments");  
     env->err= 1;  
     return;  
   }  
953    
954    if(CDR(env->head)->type!=tcons) {    if(check_args(env, 2, tcons, unknown))
955      printerr("Bad Argument Type");      return printerr(env);
     env->err= 2;  
     return;  
   }  
956    
957    CAR(CAR(CDR(env->head)))=CAR(env->head);    CAR(CAR(CDR(env->head)))=CAR(env->head);
958    toss(env);    toss(env);
# Line 1203  extern void setcar(environment *env) Line 960  extern void setcar(environment *env)
960    
961  extern void setcdr(environment *env)  extern void setcdr(environment *env)
962  {  {
   if(env->head->type==empty || CDR(env->head)->type==empty) {  
     printerr("Too Few Arguments");  
     env->err= 1;  
     return;  
   }  
963    
964    if(CDR(env->head)->type!=tcons) {    if(check_args(env, 2, tcons, unknown))
965      printerr("Bad Argument Type");      return printerr(env);
     env->err= 2;  
     return;  
   }  
966    
967    CDR(CAR(CDR(env->head)))=CAR(env->head);    CDR(CAR(CDR(env->head)))=CAR(env->head);
968    toss(env);    toss(env);
# Line 1221  extern void setcdr(environment *env) Line 970  extern void setcdr(environment *env)
970    
971  extern void car(environment *env)  extern void car(environment *env)
972  {  {
   if(env->head->type==empty) {  
     printerr("Too Few Arguments");  
     env->err= 1;  
     return;  
   }  
973    
974    if(CAR(env->head)->type!=tcons) {    if(check_args(env, 1, tcons))
975      printerr("Bad Argument Type");      return printerr(env);
     env->err= 2;  
     return;  
   }  
976    
977    CAR(env->head)=CAR(CAR(env->head));    CAR(env->head)=CAR(CAR(env->head));
978  }  }
979    
980  extern void cdr(environment *env)  extern void cdr(environment *env)
981  {  {
   if(env->head->type==empty) {  
     printerr("Too Few Arguments");  
     env->err= 1;  
     return;  
   }  
982    
983    if(CAR(env->head)->type!=tcons) {    if(check_args(env, 1, tcons))
984      printerr("Bad Argument Type");      return printerr(env);
     env->err= 2;  
     return;  
   }  
985    
986    CAR(env->head)=CDR(CAR(env->head));    CAR(env->head)=CDR(CAR(env->head));
987  }  }
# Line 1257  extern void cons(environment *env) Line 990  extern void cons(environment *env)
990  {  {
991    value *val;    value *val;
992    
993    if(env->head->type==empty || CDR(env->head)->type==empty) {    if(check_args(env, 2, unknown, unknown))
994      printerr("Too Few Arguments");      return printerr(env);
     env->err= 1;  
     return;  
   }  
995    
996    val=new_val(env);    val=new_val(env);
997    val->content.c= malloc(sizeof(pair));    val->content.c= malloc(sizeof(pair));
# Line 1278  extern void cons(environment *env) Line 1008  extern void cons(environment *env)
1008    swap(env); if(env->err) return;    swap(env); if(env->err) return;
1009    toss(env); if(env->err) return;    toss(env); if(env->err) return;
1010    swap(env); if(env->err) return;    swap(env); if(env->err) return;
1011    toss(env); if(env->err) return;    toss(env);
1012  }  }
1013    
1014    
# Line 1289  void assocgen(environment *env, funcp eq Line 1019  void assocgen(environment *env, funcp eq
1019    
1020    /* 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
1021       list */       list */
1022    if(env->head->type==empty || CDR(env->head)->type==empty) {    if(check_args(env, 2, tcons, unknown))
1023      printerr("Too Few Arguments");      return printerr(env);
     env->err= 1;  
     return;  
   }  
   
   if(CAR(env->head)->type!=tcons) {  
     printerr("Bad Argument Type");  
     env->err= 2;  
     return;  
   }  
1024    
1025    key=CAR(CDR(env->head));    key=CAR(CDR(env->head));
1026    item=CAR(env->head);    item=CAR(env->head);
1027    
1028    while(item->type == tcons){    while(item->type == tcons){
1029      if(CAR(item)->type != tcons){      if(CAR(item)->type != tcons){
       printerr("Bad Argument Type");  
1030        env->err= 2;        env->err= 2;
1031        return;        return printerr(env);
1032      }      }
1033    
1034      push_val(env, key);      push_val(env, key);
1035      push_val(env, CAR(CAR(item)));      push_val(env, CAR(CAR(item)));
1036      eqfunc(env); if(env->err) return;      eqfunc((void*)env); if(env->err) return;
1037    
1038      /* Check the result of 'eqfunc' */      /* Check the result of 'eqfunc' */
1039      if(env->head->type==empty) {      if(check_args(env, 1, integer))
1040        printerr("Too Few Arguments");        return printerr(env);
       env->err= 1;  
     return;  
     }  
     if(CAR(env->head)->type!=integer) {  
       printerr("Bad Argument Type");  
       env->err= 2;  
       return;  
     }  
1041    
1042      if(CAR(env->head)->content.i){      if(CAR(env->head)->content.i){
1043        toss(env); if(env->err) return;        toss(env); if(env->err) return;
# Line 1333  void assocgen(environment *env, funcp eq Line 1046  void assocgen(environment *env, funcp eq
1046      toss(env); if(env->err) return;      toss(env); if(env->err) return;
1047    
1048      if(item->type!=tcons) {      if(item->type!=tcons) {
       printerr("Bad Argument Type");  
1049        env->err= 2;        env->err= 2;
1050        return;        return printerr(env);
1051      }      }
1052    
1053      item=CDR(item);      item=CDR(item);
# Line 1357  void assocgen(environment *env, funcp eq Line 1069  void assocgen(environment *env, funcp eq
1069  /*  1: [ [ 1 . 2 ] [ 3 . 4 ] ]  =>  1: [ 3 . 4 ]  */  /*  1: [ [ 1 . 2 ] [ 3 . 4 ] ]  =>  1: [ 3 . 4 ]  */
1070  extern void assq(environment *env)  extern void assq(environment *env)
1071  {  {
1072    assocgen(env, eq);    assocgen(env, (void*)eq);
1073  }  }
1074    
1075    
# Line 1376  extern void sx_6f70656e(environment *env Line 1088  extern void sx_6f70656e(environment *env
1088    value *new_port;    value *new_port;
1089    FILE *stream;    FILE *stream;
1090    
1091    if(env->head->type == empty || CDR(env->head)->type == empty) {    if(check_args(env, 2, string, string))
1092      printerr("Too Few Arguments");      return printerr(env);
     env->err=1;  
     return;  
   }  
   
   if(CAR(env->head)->type != string  
      || CAR(CDR(env->head))->type != string) {  
     printerr("Bad Argument Type");  
     env->err= 2;  
     return;  
   }  
1093    
1094    stream=fopen(CAR(CDR(env->head))->content.ptr,    stream=fopen(CAR(CDR(env->head))->content.ptr,
1095                 CAR(env->head)->content.ptr);                 CAR(env->head)->content.ptr);
1096    
1097    if(stream == NULL) {    if(stream == NULL) {
     perror("open");  
1098      env->err= 5;      env->err= 5;
1099      return;      return printerr(env);
1100    }    }
1101    
1102    new_port=new_val(env);    new_port=new_val(env);
# Line 1416  extern void sx_636c6f7365(environment *e Line 1117  extern void sx_636c6f7365(environment *e
1117  {  {
1118    int ret;    int ret;
1119    
1120    if(env->head->type == empty) {    if(check_args(env, 1, port))
1121      printerr("Too Few Arguments");      return printerr(env);
     env->err=1;  
     return;  
   }  
   
   if(CAR(env->head)->type != port) {  
     printerr("Bad Argument Type");  
     env->err= 2;  
     return;  
   }  
1122    
1123    ret= fclose(CAR(env->head)->content.p);    ret= fclose(CAR(env->head)->content.p);
1124    
1125    if(ret != 0){    if(ret != 0){
     perror("close");  
1126      env->err= 5;      env->err= 5;
1127      return;      return printerr(env);
1128    }    }
1129    
1130    toss(env);    toss(env);
1131  }  }
1132    
1133    
1134  extern void mangle(environment *env)  extern void mangle(environment *env)
1135  {  {
1136    char *new_string;    char *new_string;
1137    
1138    if(env->head->type==empty) {    if(check_args(env, 1, string))
1139      printerr("Too Few Arguments");      return printerr(env);
     env->err= 1;  
     return;  
   }  
   
   if(CAR(env->head)->type!=string) {  
     printerr("Bad Argument Type");  
     env->err= 2;  
     return;  
   }  
1140    
1141    new_string= mangle_str(CAR(env->head)->content.string);    new_string= mangle_str(CAR(env->head)->content.string);
1142    
# Line 1473  extern void sx_666f726b(environment *env Line 1156  extern void sx_666f726b(environment *env
1156  extern void sx_77616974706964(environment *env)  extern void sx_77616974706964(environment *env)
1157  {  {
1158    
1159    if(env->head->type==empty) {    if(check_args(env, 1, integer))
1160      printerr("Too Few Arguments");      return printerr(env);
     env->err= 1;  
     return;  
   }  
   
   if(CAR(env->head)->type!=integer) {  
     printerr("Bad Argument Type");  
     env->err= 2;  
     return;  
   }  
1161    
1162    push_int(env, waitpid(CAR(env->head)->content.i, NULL, 0));    push_int(env, waitpid(CAR(env->head)->content.i, NULL, 0));
1163    swap(env); toss(env);    swap(env); toss(env);
# Line 1493  extern void sx_77616974706964(environmen Line 1167  extern void sx_77616974706964(environmen
1167  /* Discard the top element of the stack. */  /* Discard the top element of the stack. */
1168  extern void toss(environment *env)  extern void toss(environment *env)
1169  {  {
1170    if(env->head->type==empty) {  
1171      printerr("Too Few Arguments");    if(check_args(env, 1, unknown))
1172      env->err= 1;      return printerr(env);
1173      return;  
   }  
     
1174    env->head= CDR(env->head); /* Remove the top stack item */    env->head= CDR(env->head); /* Remove the top stack item */
1175  }  }
1176    
# Line 1579  extern void printstack(environment *env) Line 1251  extern void printstack(environment *env)
1251    
1252  extern void copying(environment *env)  extern void copying(environment *env)
1253  {  {
1254    printf(license_message);    puts(license_message);
1255  }  }
1256    
1257    
1258  extern void warranty(environment *env)  extern void warranty(environment *env)
1259  {  {
1260    printf(warranty_message);    puts(warranty_message);
1261    }
1262    
1263    
1264    /* random */
1265    extern void sx_72616e646f6d(environment *env)
1266    {
1267      push_int(env, (int)rand());
1268    }
1269    
1270    
1271    extern void seed(environment *env)
1272    {
1273      if(check_args(env, 1, integer))
1274        return printerr(env);
1275    
1276      srand(CAR(env->head)->content.i);
1277      toss(env);
1278    }
1279    
1280    
1281    extern void ticks(environment *env)
1282    {
1283      int val;
1284    
1285      val= (int)time(NULL);
1286      if(val<0) {
1287        env->err= 5;
1288        return printerr(env);
1289      }
1290      
1291      return push_int(env, val);
1292    }
1293    
1294    
1295    extern void push(environment *env)
1296    {
1297      symbol *sym;
1298      value *oldval;
1299      value *newval;
1300    
1301      if(check_args(env, 2, symb, unknown)==0) {
1302        sym= CAR(env->head)->content.sym;
1303        oldval= sym->val;
1304      
1305        if(oldval==NULL)
1306          oldval= new_val(env);
1307    
1308        sym->val= new_val(env);
1309        sym->val->content.c= malloc(sizeof(pair));
1310        assert(sym->val->content.c!=NULL);
1311        env->gc_count += sizeof(pair);
1312        sym->val->type= tcons;
1313        CDR(sym->val)= oldval;
1314        CAR(sym->val)= CAR(CDR(env->head));
1315        env->head= CDR(CDR(env->head));
1316    
1317        return;
1318      }
1319    
1320      if(check_args(env, 2, tcons, unknown)==0
1321         || check_args(env, 2, empty, unknown)==0) {
1322        oldval= CAR(env->head);
1323        env->head= CDR(env->head);
1324        newval= new_val(env);
1325        newval->content.c= malloc(sizeof(pair));
1326        assert(newval->content.c!=NULL);
1327        env->gc_count += sizeof(pair);
1328        newval->type= tcons;
1329        CDR(newval)= oldval;
1330        CAR(newval)= CAR(env->head);
1331        env->head= CDR(env->head);
1332        push_val(env, newval);
1333        
1334        return;
1335      }
1336    
1337      return printerr(env);
1338    }
1339    
1340    
1341    extern void pop(environment *env)
1342    {
1343      symbol *sym;
1344      value *val;
1345    
1346      if(check_args(env, 1, symb)==0) {
1347        sym= CAR(env->head)->content.sym;
1348    
1349        if(sym->val==NULL) {
1350          env->err= 3;
1351          return printerr(env);
1352        }
1353    
1354        env->head= CDR(env->head);
1355        if(sym->val->type==tcons) {
1356          push_val(env, CAR(sym->val));
1357          sym->val= CDR(sym->val);
1358        } else {
1359          env->err= 2;
1360          return printerr(env);
1361        }
1362    
1363        return;
1364      }
1365    
1366      if(check_args(env, 1, tcons)==0) {
1367        val= CAR(env->head);
1368        env->head= CDR(env->head);
1369        push_val(env, CAR(val));
1370        return;
1371      }
1372    
1373      return printerr(env);
1374  }  }
Legend:
Removed from v.1.5  
changed lines
  Added in v.1.10
root@recompile.se
 ViewVC Help
Powered by ViewVC 1.1.26