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

Diff of /stack/symbols.c

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

revision 1.2 by masse, Mon Aug 4 14:13:16 2003 UTC revision 1.9 by masse, Wed Aug 13 11:58:00 2003 UTC
# Line 1  Line 1 
 #include <stdio.h>  
1  #include "stack.h"  #include "stack.h"
2    #include "messages.h"
3    
4  /* Print newline. */  /* Print newline. */
5  extern void nl(environment *env)  extern void nl(environment *env)
# 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, port, empty))
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){
17      perror("nl");      perror("nl");
# Line 33  extern void nlport(environment *env) Line 24  extern void nlport(environment *env)
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, unknown, empty))
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, unknown, empty))
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, unknown, empty))
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, port, unknown, empty))
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, port, unknown, empty))
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, unknown, unknown, unknown, empty))
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, tcons, empty))
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, unknown, unknown, empty))
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, integer, empty))
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, symb, unknown, empty))
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.ptr;    sym= CAR(env->head)->content.sym;
237    
238    /* Bind the symbol to the value */    /* Bind the symbol to the value */
239    sym->val= CAR(CDR(env->head));    sym->val= CAR(CDR(env->head));
# Line 305  extern void def(environment *env) Line 244  extern void def(environment *env)
244  /* Clear stack */  /* Clear stack */
245  extern void clear(environment *env)  extern void clear(environment *env)
246  {  {
247    while(env->head->type != empty)    env->head= new_val(env);
     toss(env);  
248  }  }
249    
250  /* Forgets a symbol (remove it from the hash table) */  /* Forgets a symbol (remove it from the hash table) */
# Line 314  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, symb, empty))
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 347  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, unknown, unknown, empty))
280      printerr("Too Few Arguments");      return printerr(env);
     env->err= 1;  
     return;  
   }  
281    
282    if(CAR(env->head)->type==string    if(check_args(env, string, string, empty)==0) {
      && CAR(CDR(env->head))->type==string) {  
283      a_val= CAR(env->head);      a_val= CAR(env->head);
284      b_val= CAR(CDR(env->head));      b_val= CAR(CDR(env->head));
285      protect(a_val); protect(b_val);      protect(a_val); protect(b_val);
286      toss(env); if(env->err) return;      toss(env); if(env->err) return;
287      toss(env); if(env->err) return;      toss(env); if(env->err) return;
288      len= strlen(a_val->content.ptr)+strlen(b_val->content.ptr)+1;      len= strlen(a_val->content.string)+strlen(b_val->content.string)+1;
289      new_string= malloc(len);      new_string= malloc(len);
290      assert(new_string != NULL);      assert(new_string != NULL);
291      strcpy(new_string, b_val->content.ptr);      strcpy(new_string, b_val->content.string);
292      strcat(new_string, a_val->content.ptr);      strcat(new_string, a_val->content.string);
293      push_cstring(env, new_string);      push_cstring(env, new_string);
294      unprotect(a_val); unprotect(b_val);      unprotect(a_val); unprotect(b_val);
295      free(new_string);      free(new_string);
# Line 372  extern void sx_2b(environment *env) Line 297  extern void sx_2b(environment *env)
297      return;      return;
298    }    }
299        
300    if(CAR(env->head)->type==integer    if(check_args(env, integer, integer, empty)==0) {
      && CAR(CDR(env->head))->type==integer) {  
301      a= CAR(env->head)->content.i;      a= CAR(env->head)->content.i;
302      toss(env); if(env->err) return;      toss(env); if(env->err) return;
303      b= CAR(env->head)->content.i;      b= CAR(env->head)->content.i;
# Line 383  extern void sx_2b(environment *env) Line 307  extern void sx_2b(environment *env)
307      return;      return;
308    }    }
309    
310    if(CAR(env->head)->type==tfloat    if(check_args(env, tfloat, tfloat, empty)==0) {
      && CAR(CDR(env->head))->type==tfloat) {  
311      fa= CAR(env->head)->content.f;      fa= CAR(env->head)->content.f;
312      toss(env); if(env->err) return;      toss(env); if(env->err) return;
313      fb= CAR(env->head)->content.f;      fb= CAR(env->head)->content.f;
# Line 394  extern void sx_2b(environment *env) Line 317  extern void sx_2b(environment *env)
317      return;      return;
318    }    }
319    
320    if(CAR(env->head)->type==tfloat    if(check_args(env, tfloat, integer, empty)==0) {
      && CAR(CDR(env->head))->type==integer) {  
321      fa= CAR(env->head)->content.f;      fa= CAR(env->head)->content.f;
322      toss(env); if(env->err) return;      toss(env); if(env->err) return;
323      b= CAR(env->head)->content.i;      b= CAR(env->head)->content.i;
# Line 405  extern void sx_2b(environment *env) Line 327  extern void sx_2b(environment *env)
327      return;      return;
328    }    }
329    
330    if(CAR(env->head)->type==integer    if(check_args(env, integer, tfloat, empty)==0) {
      && CAR(CDR(env->head))->type==tfloat) {  
331      a= CAR(env->head)->content.i;      a= CAR(env->head)->content.i;
332      toss(env); if(env->err) return;      toss(env); if(env->err) return;
333      fb= CAR(env->head)->content.f;      fb= CAR(env->head)->content.f;
# Line 416  extern void sx_2b(environment *env) Line 337  extern void sx_2b(environment *env)
337      return;      return;
338    }    }
339    
340    printerr("Bad Argument Type");    return printerr(env);
   env->err=2;  
341  }  }
342    
343  /* "-" */  /* "-" */
# Line 426  extern void sx_2d(environment *env) Line 346  extern void sx_2d(environment *env)
346    int a, b;    int a, b;
347    float fa, fb;    float fa, fb;
348    
349    if(env->head->type==empty || CDR(env->head)->type==empty) {    if(check_args(env, unknown, unknown, empty))
350      printerr("Too Few Arguments");      return printerr(env);
351      env->err=1;  
352      return;    if(check_args(env, integer, integer, empty)==0) {
   }  
     
   if(CAR(env->head)->type==integer  
      && CAR(CDR(env->head))->type==integer) {  
353      a= CAR(env->head)->content.i;      a= CAR(env->head)->content.i;
354      toss(env); if(env->err) return;      toss(env); if(env->err) return;
355      b= CAR(env->head)->content.i;      b= CAR(env->head)->content.i;
# Line 443  extern void sx_2d(environment *env) Line 359  extern void sx_2d(environment *env)
359      return;      return;
360    }    }
361    
362    if(CAR(env->head)->type==tfloat    if(check_args(env, tfloat, tfloat, empty)==0) {
      && CAR(CDR(env->head))->type==tfloat) {  
363      fa= CAR(env->head)->content.f;      fa= CAR(env->head)->content.f;
364      toss(env); if(env->err) return;      toss(env); if(env->err) return;
365      fb= CAR(env->head)->content.f;      fb= CAR(env->head)->content.f;
# Line 454  extern void sx_2d(environment *env) Line 369  extern void sx_2d(environment *env)
369      return;      return;
370    }    }
371    
372    if(CAR(env->head)->type==tfloat    if(check_args(env, tfloat, integer, empty)==0) {
      && CAR(CDR(env->head))->type==integer) {  
373      fa= CAR(env->head)->content.f;      fa= CAR(env->head)->content.f;
374      toss(env); if(env->err) return;      toss(env); if(env->err) return;
375      b= CAR(env->head)->content.i;      b= CAR(env->head)->content.i;
# Line 465  extern void sx_2d(environment *env) Line 379  extern void sx_2d(environment *env)
379      return;      return;
380    }    }
381    
382    if(CAR(env->head)->type==integer    if(check_args(env, integer, tfloat, empty)==0) {
      && CAR(CDR(env->head))->type==tfloat) {  
383      a= CAR(env->head)->content.i;      a= CAR(env->head)->content.i;
384      toss(env); if(env->err) return;      toss(env); if(env->err) return;
385      fb= CAR(env->head)->content.f;      fb= CAR(env->head)->content.f;
# Line 476  extern void sx_2d(environment *env) Line 389  extern void sx_2d(environment *env)
389      return;      return;
390    }    }
391    
392    printerr("Bad Argument Type");    return printerr(env);
   env->err=2;  
393  }  }
394    
395  /* ">" */  /* ">" */
# Line 486  extern void sx_3e(environment *env) Line 398  extern void sx_3e(environment *env)
398    int a, b;    int a, b;
399    float fa, fb;    float fa, fb;
400    
401    if(env->head->type==empty || CDR(env->head)->type==empty) {    if(check_args(env, unknown, unknown, empty))
402      printerr("Too Few Arguments");      return printerr(env);
403      env->err= 1;  
404      return;    if(check_args(env, integer, integer, empty)==0) {
   }  
     
   if(CAR(env->head)->type==integer  
      && CAR(CDR(env->head))->type==integer) {  
405      a= CAR(env->head)->content.i;      a= CAR(env->head)->content.i;
406      toss(env); if(env->err) return;      toss(env); if(env->err) return;
407      b= CAR(env->head)->content.i;      b= CAR(env->head)->content.i;
# Line 503  extern void sx_3e(environment *env) Line 411  extern void sx_3e(environment *env)
411      return;      return;
412    }    }
413    
414    if(CAR(env->head)->type==tfloat    if(check_args(env, tfloat, tfloat, empty)==0) {
      && CAR(CDR(env->head))->type==tfloat) {  
415      fa= CAR(env->head)->content.f;      fa= CAR(env->head)->content.f;
416      toss(env); if(env->err) return;      toss(env); if(env->err) return;
417      fb= CAR(env->head)->content.f;      fb= CAR(env->head)->content.f;
# Line 514  extern void sx_3e(environment *env) Line 421  extern void sx_3e(environment *env)
421      return;      return;
422    }    }
423    
424    if(CAR(env->head)->type==tfloat    if(check_args(env, tfloat, integer, empty)==0) {
      && CAR(CDR(env->head))->type==integer) {  
425      fa= CAR(env->head)->content.f;      fa= CAR(env->head)->content.f;
426      toss(env); if(env->err) return;      toss(env); if(env->err) return;
427      b= CAR(env->head)->content.i;      b= CAR(env->head)->content.i;
# Line 525  extern void sx_3e(environment *env) Line 431  extern void sx_3e(environment *env)
431      return;      return;
432    }    }
433    
434    if(CAR(env->head)->type==integer    if(check_args(env, integer, tfloat, empty)==0) {
      && CAR(CDR(env->head))->type==tfloat) {  
435      a= CAR(env->head)->content.i;      a= CAR(env->head)->content.i;
436      toss(env); if(env->err) return;      toss(env); if(env->err) return;
437      fb= CAR(env->head)->content.f;      fb= CAR(env->head)->content.f;
# Line 536  extern void sx_3e(environment *env) Line 441  extern void sx_3e(environment *env)
441      return;      return;
442    }    }
443    
444    printerr("Bad Argument Type");    return printerr(env);
   env->err= 2;  
445  }  }
446    
447  /* "<" */  /* "<" */
# Line 564  extern void sx_3e3d(environment *env) Line 468  extern void sx_3e3d(environment *env)
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    if(env->head->type==empty) {    if(check_args(env, unknown, empty))
472      printerr("Too Few Arguments");      return printerr(env);
473      env->err= 1;  
     return;  
   }  
474    push_val(env, copy_val(env, CAR(env->head)));    push_val(env, copy_val(env, CAR(env->head)));
475  }  }
476    
# Line 577  extern void sx_6966(environment *env) Line 479  extern void sx_6966(environment *env)
479  {  {
480    int truth;    int truth;
481    
482    if(env->head->type==empty || CDR(env->head)->type==empty) {    if(check_args(env, unknown, integer, empty))
483      printerr("Too Few Arguments");      return printerr(env);
     env->err= 1;  
     return;  
   }  
484    
   if(CAR(CDR(env->head))->type != integer) {  
     printerr("Bad Argument Type");  
     env->err= 2;  
     return;  
   }  
     
485    swap(env);    swap(env);
486    if(env->err) return;    if(env->err) return;
487        
# Line 608  extern void ifelse(environment *env) Line 501  extern void ifelse(environment *env)
501  {  {
502    int truth;    int truth;
503    
504    if(env->head->type==empty || CDR(env->head)->type==empty    if(check_args(env, unknown, unknown, integer, empty))
505       || CDR(CDR(env->head))->type==empty) {      return printerr(env);
     printerr("Too Few Arguments");  
     env->err= 1;  
     return;  
   }  
506    
   if(CAR(CDR(CDR(env->head)))->type!=integer) {  
     printerr("Bad Argument Type");  
     env->err= 2;  
     return;  
   }  
     
507    rot(env);    rot(env);
508    if(env->err) return;    if(env->err) return;
509        
# Line 642  extern void ifelse(environment *env) Line 525  extern void ifelse(environment *env)
525  /* "else" */  /* "else" */
526  extern void sx_656c7365(environment *env)  extern void sx_656c7365(environment *env)
527  {  {
528    if(env->head->type==empty || CDR(env->head)->type==empty  
529       || CDR(CDR(env->head))->type==empty || CDR(CDR(CDR(env->head)))->type==empty    if(check_args(env, unknown, symb, unknown, symb, integer, empty))
530       || CDR(CDR(CDR(CDR(env->head))))->type==empty) {      return printerr(env);
531      printerr("Too Few Arguments");  
532      env->err= 1;    /// XXX
     return;  
   }  
533    
534    if(CAR(CDR(env->head))->type!=symb    if(CAR(CDR(env->head))->type!=symb
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("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);
# Line 665  extern void sx_656c7365(environment *env Line 545  extern void sx_656c7365(environment *env
545    
546  extern void then(environment *env)  extern void then(environment *env)
547  {  {
548    if(env->head->type==empty || CDR(env->head)->type==empty    
549       || CDR(CDR(env->head))->type==empty) {    if(check_args(env, unknown, symb, integer, empty))
550      printerr("Too Few Arguments");      return printerr(env);
551      env->err= 1;  
552      return;    /// 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("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);
# Line 689  extern void sx_7768696c65(environment *e Line 567  extern void sx_7768696c65(environment *e
567    int truth;    int truth;
568    value *loop, *test;    value *loop, *test;
569    
570    if(env->head->type==empty || CDR(env->head)->type==empty) {    if(check_args(env, unknown, integer, empty))
571      printerr("Too Few Arguments");      return printerr(env);
     env->err= 1;  
     return;  
   }  
572    
573    loop= CAR(env->head);    loop= CAR(env->head);
574    protect(loop);    protect(loop);
# Line 706  extern void sx_7768696c65(environment *e Line 581  extern void sx_7768696c65(environment *e
581    do {    do {
582      push_val(env, test);      push_val(env, test);
583      eval(env);      eval(env);
584    
585        /// XXX
586            
587      if(CAR(env->head)->type != integer) {      if(CAR(env->head)->type != integer) {
       printerr("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;
# Line 735  extern void sx_666f72(environment *env) Line 611  extern void sx_666f72(environment *env)
611    value *loop;    value *loop;
612    int foo1, foo2;    int foo1, foo2;
613    
614    if(env->head->type==empty || CDR(env->head)->type==empty    if(check_args(env, unknown, integer, integer, empty))
615       || 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;  
   }  
616    
617    loop= CAR(env->head);    loop= CAR(env->head);
618    protect(loop);    protect(loop);
# Line 783  extern void foreach(environment *env) Line 648  extern void foreach(environment *env)
648  {    {  
649    value *loop, *foo;    value *loop, *foo;
650    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;  
   }  
651    
652      if(check_args(env, unknown, tcons, empty))
653        return printerr(env);
654      
655    loop= CAR(env->head);    loop= CAR(env->head);
656    protect(loop);    protect(loop);
657    toss(env); if(env->err) return;    toss(env); if(env->err) return;
# Line 810  extern void foreach(environment *env) Line 666  extern void foreach(environment *env)
666      push_val(env, CAR(iterator));      push_val(env, CAR(iterator));
667      push_val(env, loop);      push_val(env, loop);
668      eval(env); if(env->err) return;      eval(env); if(env->err) return;
669    
670        /// XXX
671      if (iterator->type == tcons){      if (iterator->type == tcons){
672        iterator= CDR(iterator);        iterator= CDR(iterator);
673      } else {      } else {
674        printerr("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" */
# Line 827  extern void to(environment *env) Line 686  extern void to(environment *env)
686    int ending, start, i;    int ending, start, i;
687    value *iterator, *temp, *end;    value *iterator, *temp, *end;
688    
689    end= new_val(env);    if(check_args(env, integer, integer, empty))
690        return printerr(env);
   if(env->head->type==empty || CDR(env->head)->type==empty) {  
     printerr("Too Few Arguments");  
     env->err= 1;  
     return;  
   }  
691    
692    if(CAR(env->head)->type!=integer    end= new_val(env);
      || CAR(CDR(env->head))->type!=integer) {  
     printerr("Bad Argument Type");  
     env->err= 2;  
     return;  
   }  
693    
694    ending= CAR(env->head)->content.i;    ending= CAR(env->head)->content.i;
695    toss(env); if(env->err) return;    toss(env); if(env->err) return;
# Line 895  extern void readlineport(environment *en Line 744  extern void readlineport(environment *en
744  {  {
745    FILE *stream;    FILE *stream;
746    
747    if(env->head->type==empty) {    if(check_args(env, port, empty))
748      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;  
   }  
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;
# Line 925  extern void readport(environment *env) Line 765  extern void readport(environment *env)
765  {  {
766    FILE *stream;    FILE *stream;
767    
768    if(env->head->type==empty) {    if(check_args(env, port, empty))
769      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;  
   }  
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;
# Line 949  extern void beep(environment *env) Line 780  extern void beep(environment *env)
780  {  {
781    int freq, dur, period, ticks;    int freq, dur, period, ticks;
782    
783    if(env->head->type==empty || CDR(env->head)->type==empty) {    if(check_args(env, integer, integer, empty))
784      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;  
   }  
785    
786    dur= CAR(env->head)->content.i;    dur= CAR(env->head)->content.i;
787    toss(env);    toss(env);
# Line 994  extern void sx_77616974(environment *env Line 815  extern void sx_77616974(environment *env
815  {  {
816    int dur;    int dur;
817    
818    if(env->head->type==empty) {    if(check_args(env, integer, empty))
819      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;  
   }  
820    
821    dur= CAR(env->head)->content.i;    dur= CAR(env->head)->content.i;
822    toss(env);    toss(env);
# Line 1012  extern void sx_77616974(environment *env Line 824  extern void sx_77616974(environment *env
824    usleep(dur);    usleep(dur);
825  }  }
826    
827    
828  /* "*" */  /* "*" */
829  extern void sx_2a(environment *env)  extern void sx_2a(environment *env)
830  {  {
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("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;
# Line 1035  extern void sx_2a(environment *env) Line 844  extern void sx_2a(environment *env)
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;
# Line 1046  extern void sx_2a(environment *env) Line 854  extern void sx_2a(environment *env)
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;
# Line 1057  extern void sx_2a(environment *env) Line 864  extern void sx_2a(environment *env)
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;
# Line 1068  extern void sx_2a(environment *env) Line 874  extern void sx_2a(environment *env)
874      return;      return;
875    }    }
876    
877    printerr("Bad Argument Type");    return printerr(env);
   env->err= 2;  
878  }  }
879    
880  /* "/" */  /* "/" */
# Line 1078  extern void sx_2f(environment *env) Line 883  extern void sx_2f(environment *env)
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("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;
# Line 1095  extern void sx_2f(environment *env) Line 896  extern void sx_2f(environment *env)
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;
# Line 1106  extern void sx_2f(environment *env) Line 906  extern void sx_2f(environment *env)
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;
# Line 1117  extern void sx_2f(environment *env) Line 916  extern void sx_2f(environment *env)
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;
# Line 1128  extern void sx_2f(environment *env) Line 926  extern void sx_2f(environment *env)
926      return;      return;
927    }    }
928    
929    printerr("Bad Argument Type");    return printerr(env);
   env->err= 2;  
930  }  }
931    
932  /* "mod" */  /* "mod" */
# Line 1137  extern void mod(environment *env) Line 934  extern void mod(environment *env)
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("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;
# Line 1154  extern void mod(environment *env) Line 947  extern void mod(environment *env)
947      return;      return;
948    }    }
949    
950    printerr("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("Too Few Arguments");  
     env->err= 1;  
     return;  
   }  
958    
959    if(CAR(env->head)->type==integer    if(check_args(env, integer, integer, empty))
960       && CAR(CDR(env->head))->type==integer) {      return printerr(env);
961      a= CAR(env->head)->content.i;    
962      toss(env); if(env->err) return;    a= CAR(env->head)->content.i;
963      b= CAR(env->head)->content.i;    toss(env); if(env->err) return;
964      toss(env); if(env->err) return;    b= CAR(env->head)->content.i;
965      push_int(env, (int)b/a);    toss(env); if(env->err) return;
966      push_int(env, (int)b/a);
     return;  
   }  
   
   printerr("Bad Argument Type");  
   env->err= 2;  
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("Too Few Arguments");  
     env->err= 1;  
     return;  
   }  
972    
973    if(CDR(env->head)->type!=tcons) {    if(check_args(env, tcons, unknown, empty))
974      printerr("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);
# Line 1204  extern void setcar(environment *env) Line 979  extern void setcar(environment *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("Too Few Arguments");  
     env->err= 1;  
     return;  
   }  
982    
983    if(CDR(env->head)->type!=tcons) {    if(check_args(env, tcons, unknown, empty))
984      printerr("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);
# Line 1222  extern void setcdr(environment *env) Line 989  extern void setcdr(environment *env)
989    
990  extern void car(environment *env)  extern void car(environment *env)
991  {  {
   if(env->head->type==empty) {  
     printerr("Too Few Arguments");  
     env->err= 1;  
     return;  
   }  
992    
993    if(CAR(env->head)->type!=tcons) {    if(check_args(env, tcons, empty))
994      printerr("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("Too Few Arguments");  
     env->err= 1;  
     return;  
   }  
1001    
1002    if(CAR(env->head)->type!=tcons) {    if(check_args(env, tcons, empty))
1003      printerr("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  }  }
# Line 1258  extern void cons(environment *env) Line 1009  extern void cons(environment *env)
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("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));
# Line 1279  extern void cons(environment *env) Line 1027  extern void cons(environment *env)
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    
# Line 1290  void assocgen(environment *env, funcp eq Line 1038  void assocgen(environment *env, funcp eq
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("Too Few Arguments");      return printerr(env);
     env->err= 1;  
     return;  
   }  
   
   if(CAR(env->head)->type!=tcons) {  
     printerr("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("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("Too Few Arguments");        return printerr(env);
       env->err= 1;  
     return;  
     }  
     if(CAR(env->head)->type!=integer) {  
       printerr("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;
# Line 1334  void assocgen(environment *env, funcp eq Line 1065  void assocgen(environment *env, funcp eq
1065      toss(env); if(env->err) return;      toss(env); if(env->err) return;
1066    
1067      if(item->type!=tcons) {      if(item->type!=tcons) {
       printerr("Bad Argument Type");  
1068        env->err= 2;        env->err= 2;
1069        return;        return printerr(env);
1070      }      }
1071    
1072      item=CDR(item);      item=CDR(item);
# Line 1358  void assocgen(environment *env, funcp eq Line 1088  void assocgen(environment *env, funcp eq
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    
# Line 1377  extern void sx_6f70656e(environment *env Line 1107  extern void sx_6f70656e(environment *env
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("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;  
   }  
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);
# Line 1417  extern void sx_636c6f7365(environment *e Line 1137  extern void sx_636c6f7365(environment *e
1137  {  {
1138    int ret;    int ret;
1139    
1140    if(env->head->type == empty) {    if(check_args(env, port, empty))
1141      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;  
   }  
1142    
1143    ret= fclose(CAR(env->head)->content.p);    ret= fclose(CAR(env->head)->content.p);
1144    
# Line 1439  extern void sx_636c6f7365(environment *e Line 1150  extern void sx_636c6f7365(environment *e
1150    
1151    toss(env);    toss(env);
1152  }  }
1153    
1154    
1155    extern void mangle(environment *env)
1156    {
1157      char *new_string;
1158    
1159      if(check_args(env, string, empty))
1160        return printerr(env);
1161    
1162      new_string= mangle_str(CAR(env->head)->content.string);
1163    
1164      toss(env);
1165      if(env->err) return;
1166    
1167      push_cstring(env, new_string);
1168    }
1169    
1170    /* "fork" */
1171    extern void sx_666f726b(environment *env)
1172    {
1173      push_int(env, fork());
1174    }
1175    
1176    /* "waitpid" */
1177    extern void sx_77616974706964(environment *env)
1178    {
1179    
1180      if(check_args(env, integer, empty))
1181        return printerr(env);
1182    
1183      push_int(env, waitpid(CAR(env->head)->content.i, NULL, 0));
1184      swap(env); toss(env);
1185    }
1186    
1187    
1188    /* Discard the top element of the stack. */
1189    extern void toss(environment *env)
1190    {
1191    
1192      if(check_args(env, unknown, empty))
1193        return printerr(env);
1194    
1195      env->head= CDR(env->head); /* Remove the top stack item */
1196    }
1197    
1198    
1199    /* Quit stack. */
1200    extern void quit(environment *env)
1201    {
1202      int i;
1203    
1204      env->head= new_val(env);
1205    
1206      if (env->err) return;
1207      for(i= 0; i<HASHTBLSIZE; i++) {
1208        while(env->symbols[i]!= NULL) {
1209          forget_sym(&(env->symbols[i]));
1210        }
1211        env->symbols[i]= NULL;
1212      }
1213    
1214      env->gc_limit= 0;
1215      gc_maybe(env);
1216    
1217      words(env);
1218    
1219      if(env->free_string!=NULL)
1220        free(env->free_string);
1221      
1222    #ifdef __linux__
1223      muntrace();
1224    #endif
1225    
1226      exit(EXIT_SUCCESS);
1227    }
1228    
1229    
1230    /* List all defined words */
1231    extern void words(environment *env)
1232    {
1233      symbol *temp;
1234      int i;
1235      
1236      for(i= 0; i<HASHTBLSIZE; i++) {
1237        temp= env->symbols[i];
1238        while(temp!=NULL) {
1239    #ifdef DEBUG
1240          if (temp->val != NULL && temp->val->gc.flag.protect)
1241            printf("(protected) ");
1242    #endif /* DEBUG */
1243          printf("%s ", temp->id);
1244          temp= temp->next;
1245        }
1246      }
1247    }
1248    
1249    
1250    /* Only to be called by itself function printstack. */
1251    void print_st(environment *env, value *stack_head, long counter)
1252    {
1253      if(CDR(stack_head)->type != empty)
1254        print_st(env, CDR(stack_head), counter+1);
1255      printf("%ld: ", counter);
1256      print_val(env, CAR(stack_head), 0, NULL, stdout);
1257      printf("\n");
1258    }
1259    
1260    
1261    /* Prints the stack. */
1262    extern void printstack(environment *env)
1263    {
1264      if(env->head->type == empty) {
1265        printf("Stack Empty\n");
1266        return;
1267      }
1268    
1269      print_st(env, env->head, 1);
1270    }
1271    
1272    
1273    extern void copying(environment *env)
1274    {
1275      puts(license_message);
1276    }
1277    
1278    
1279    extern void warranty(environment *env)
1280    {
1281      puts(warranty_message);
1282    }
Legend:
Removed from v.1.2  
changed lines
  Added in v.1.9
root@recompile.se
 ViewVC Help
Powered by ViewVC 1.1.26