--- stack/stack.c	2003/08/13 06:12:26	1.134
+++ stack/stack.c	2004/02/19 15:35:38	1.137
@@ -23,11 +23,11 @@
 
 #include "stack.h"
 
-const char* start_message= "Stack version $Revision: 1.134 $\n\
+const char* start_message= "Stack version $Revision: 1.137 $\n\
 Copyright (C) 2002  Mats Alritzson and Teddy Hogeborn\n\
 Stack comes with ABSOLUTELY NO WARRANTY; for details type 'warranty;'.\n\
 This is free software, and you are welcome to redistribute it\n\
-under certain conditions; type 'copying;' for details.\n";
+under certain conditions; type 'copying;' for details.";
 
 
 /* Initialize a newly created environment */
@@ -50,8 +50,29 @@
 }
 
 
-void printerr(environment *env, const char* in_string)
+void printerr(environment *env)
 {
+  char *in_string;
+
+  switch(env->err) {
+  case 0:
+    return;
+  case 1:
+    in_string= "Too Few Arguments";
+    break;
+  case 2:
+    in_string= "Bad Argument Type";
+    break;
+  case 3:
+    in_string= "Unbound Variable";
+    break;
+  case 5:
+    return perror(env->errsymb);
+  default:
+    in_string= "Unknown error";
+    break;
+  }
+
   fprintf(stderr, "\"%s\":\nErr: %s\n", env->errsymb, in_string);
 }
 
@@ -111,166 +132,6 @@
 }
 
 
-/* Mark values recursively. 
-   Marked values are not collected by the GC. */
-inline void gc_mark(value *val)
-{
-  if(val==NULL || val->gc.flag.mark)
-    return;
-
-  val->gc.flag.mark= 1;
-
-  if(val->type==tcons) {
-    gc_mark(CAR(val));
-    gc_mark(CDR(val));
-  }
-}
-
-
-/* Start GC */
-extern void gc_init(environment *env)
-{
-  stackitem *new_head= NULL, *titem;
-  symbol *tsymb;
-  int i;
-
-  if(env->interactive)
-    printf("Garbage collecting.");
-
-  /* Mark values on stack */
-  gc_mark(env->head);
-
-  if(env->interactive)
-    printf(".");
-
-  /* Mark values in hashtable */
-  for(i= 0; i<HASHTBLSIZE; i++)
-    for(tsymb= env->symbols[i]; tsymb!=NULL; tsymb= tsymb->next)
-      if (tsymb->val != NULL)
-	gc_mark(tsymb->val);
-
-  if(env->interactive)
-    printf(".");
-
-  env->gc_count= 0;
-
-  while(env->gc_ref!=NULL) {	/* Sweep unused values */
-    if(!(env->gc_ref->item->gc.no_gc)){ /* neither mark nor protect */
-
-      /* Remove content */
-      switch(env->gc_ref->item->type){
-      case string:
-	free(env->gc_ref->item->content.string);
-	break;
-      case tcons:
-	free(env->gc_ref->item->content.c);
-	break;
-      case port:
-      case empty:
-      case unknown:
-      case integer:
-      case tfloat:
-      case func:
-      case symb:
-	/* Symbol strings are freed when walking the hash table */
-	break;
-      }
-
-      free(env->gc_ref->item);	/* Remove from gc_ref */
-      titem= env->gc_ref->next;
-      free(env->gc_ref);	/* Remove value */
-      env->gc_ref= titem;
-      continue;
-    }
-
-#ifdef DEBUG
-    printf("Kept value (%p)", env->gc_ref->item);
-    if(env->gc_ref->item->gc.flag.mark)
-      printf(" (marked)");
-    if(env->gc_ref->item->gc.flag.protect)
-      printf(" (protected)");
-    switch(env->gc_ref->item->type){
-    case integer:
-      printf(" integer: %d", env->gc_ref->item->content.i);
-      break;
-    case func:
-      printf(" func: %p", env->gc_ref->item->content.func);
-      break;
-    case symb:
-      printf(" symb: %s", env->gc_ref->item->content.sym->id);
-      break;
-    case tcons:
-      printf(" tcons: %p\t%p", CAR(env->gc_ref->item),
-	     CDR(env->gc_ref->item));
-      break;
-    default:
-      printf(" <unknown %d>", (env->gc_ref->item->type));
-    }
-    printf("\n");
-#endif /* DEBUG */
-
-    /* Keep values */     
-    env->gc_count += sizeof(value);
-    if(env->gc_ref->item->type==string)
-      env->gc_count += strlen(env->gc_ref->item->content.string)+1;
-    
-    titem= env->gc_ref->next;
-    env->gc_ref->next= new_head;
-    new_head= env->gc_ref;
-    new_head->item->gc.flag.mark= 0;
-    env->gc_ref= titem;
-  }
-
-  if (env->gc_limit < env->gc_count*2)
-    env->gc_limit= env->gc_count*2;
-
-  env->gc_ref= new_head;
-
-  if(env->interactive)
-    printf("done (%d bytes still allocated)\n", env->gc_count);
-
-}
-
-
-inline void gc_maybe(environment *env)
-{
-  if(env->gc_count < env->gc_limit)
-    return;
-  else
-    return gc_init(env);
-}
-
-
-/* Protect values from GC */
-void protect(value *val)
-{
-  if(val==NULL || val->gc.flag.protect)
-    return;
-
-  val->gc.flag.protect= 1;
-
-  if(val->type==tcons) {
-    protect(CAR(val));
-    protect(CDR(val));
-  }
-}
-
-
-/* Unprotect values from GC */
-void unprotect(value *val)
-{
-  if(val==NULL || !(val->gc.flag.protect))
-    return;
-
-  val->gc.flag.protect= 0;
-
-  if(val->type==tcons) {
-    unprotect(CAR(val));
-    unprotect(CDR(val));
-  }
-}
-
-
 /* Push a value onto the stack */
 void push_val(environment *env, value *val)
 {
@@ -425,74 +286,46 @@
 
   switch(val->type) {
   case empty:
-    if(fprintf(stream, "[]") < 0){
-      perror("print_val");
+    if(fprintf(stream, "[]") < 0)
       env->err= 5;
-      return;
-    }
     break;
   case unknown:
-    if(fprintf(stream, "UNKNOWN") < 0){
-      perror("print_val");
+    if(fprintf(stream, "UNKNOWN") < 0)
       env->err= 5;
-      return;
-    }
     break;
   case integer:
-    if(fprintf(stream, "%d", val->content.i) < 0){
-      perror("print_val");
+    if(fprintf(stream, "%d", val->content.i) < 0)
       env->err= 5;
-      return;
-    }
     break;
   case tfloat:
-    if(fprintf(stream, "%f", val->content.f) < 0){
-      perror("print_val");
+    if(fprintf(stream, "%f", val->content.f) < 0)
       env->err= 5;
-      return;
-    }
     break;
   case string:
     if(noquote){
-      if(fprintf(stream, "%s", val->content.string) < 0){
-	perror("print_val");
+      if(fprintf(stream, "%s", val->content.string) < 0)
 	env->err= 5;
-	return;
-      }
     } else {			/* quote */
-      if(fprintf(stream, "\"%s\"", val->content.string) < 0){
-	perror("print_val");
+      if(fprintf(stream, "\"%s\"", val->content.string) < 0)
 	env->err= 5;
-	return;
-      }
     }
     break;
   case symb:
-    if(fprintf(stream, "%s", val->content.sym->id) < 0){
-      perror("print_val");
+    if(fprintf(stream, "%s", val->content.sym->id) < 0)
       env->err= 5;
-      return;
-    }
     break;
   case func:
-    if(fprintf(stream, "#<function %p>", val->content.func) < 0){
-      perror("print_val");
+    if(fprintf(stream, "#<function %p>", val->content.func) < 0)
       env->err= 5;
-      return;
-    }
     break;
   case port:
-    if(fprintf(stream, "#<port %p>", val->content.p) < 0){
-      perror("print_val");
+    if(fprintf(stream, "#<port %p>", val->content.p) < 0)
       env->err= 5;
-      return;
-    }
     break;
   case tcons:
-    if(fprintf(stream, "[ ") < 0){
-      perror("print_val");
+    if(fprintf(stream, "[ ") < 0) {
       env->err= 5;
-      return;
+      return printerr(env);
     }
     tstack= stack;
 
@@ -514,10 +347,9 @@
 
       if(titem != NULL){	/* If we found it on the stack, */
 	if(fprintf(stream, "#%d#", depth) < 0){	/* print a depth reference */
-	  perror("print_val");
 	  env->err= 5;
 	  free(titem);
-	  return;
+	  return printerr(env);
 	}
       } else {
 	print_val(env, CAR(val), noquote, tstack, stream);
@@ -539,22 +371,22 @@
 	}
 	if(titem != NULL){	/* If we found it on the stack, */
 	  if(fprintf(stream, " . #%d#", depth) < 0){ /* print a depth reference */
-	    perror("print_val");
 	    env->err= 5;
+	    printerr(env);
 	    goto printval_end;
 	  }
 	} else {
 	  if(fprintf(stream, " ") < 0){
-	    perror("print_val");
 	    env->err= 5;
+	    printerr(env);
 	    goto printval_end;
 	  }
 	}
 	break;
       default:
 	if(fprintf(stream, " . ") < 0){	/* Improper list */
-	  perror("print_val");
 	  env->err= 5;
+	  printerr(env);
 	  goto printval_end;
         }
 	print_val(env, val, noquote, tstack, stream);
@@ -572,12 +404,14 @@
 
     if(! (env->err)){
       if(fprintf(stream, " ]") < 0){
-	perror("print_val");
 	env->err= 5;
       }
     }
     break;
   }
+  
+  if(env->err)
+    return printerr(env);
 }
 
 
@@ -586,16 +420,8 @@
 {
   value *temp= env->head;
 
-  switch(check_args(env, unknown, unknown, empty)) {
-  case 1:
-    printerr(env, "Too Few Arguments");
-    return;
-  case 2:
-    printerr(env, "Bad Argument Type");
-    return;
-  default:
-    break;
-  }
+  if(check_args(env, 2, unknown, unknown))
+    return printerr(env);
   
   env->head= CDR(env->head);
   CDR(temp)= CDR(env->head);
@@ -608,23 +434,15 @@
 {
   value *val;
 
-  switch(check_args(env, symb, empty)) {
-  case 1:
-    printerr(env, "Too Few Arguments");
-    return;
-  case 2:
-    printerr(env, "Bad Argument Type");
-    return;
-  default:
-    break;
-  }
+  if(check_args(env, 1, symb))
+    return printerr(env);
 
   val= CAR(env->head)->content.sym->val;
   if(val == NULL){
-    printerr(env, "Unbound Variable");
     env->err= 3;
-    return;
+    return printerr(env);
   }
+
   push_val(env, val);		/* Return the symbol's bound value */
   swap(env);
   if(env->err) return;
@@ -645,16 +463,8 @@
 
   gc_maybe(env);
 
-  switch(check_args(env, unknown, empty)) {
-  case 1:
-    printerr(env, "Too Few Arguments");
-    return;
-  case 2:
-    printerr(env, "Bad Argument Type");
-    return;
-  default:
-    break;
-  }
+  if(check_args(env, 1, unknown))
+    return printerr(env);
 
   switch(CAR(env->head)->type) {
     /* if it's a symbol */
@@ -671,7 +481,7 @@
   case func:
     in_func= CAR(env->head)->content.func;
     env->head= CDR(env->head);
-    return in_func(env);
+    return in_func((void*)env);
 
     /* If it's a list */
   case tcons:
@@ -697,9 +507,8 @@
       if (CDR(iterator)->type == empty || CDR(iterator)->type == tcons) 
 	iterator= CDR(iterator);
       else {
-	printerr(env, "Bad Argument Type"); /* Improper list */
-	env->err= 2;
-	return;
+	env->err= 2; /* Improper list */
+	return printerr(env); 
       }
     }
     unprotect(temp_val);
@@ -849,8 +658,8 @@
   if(fgets(in_string, 100, stream)==NULL) {
     push_cstring(env, "");
     if (! feof(stream)){
-      perror("readline");
       env->err= 5;
+      return printerr(env);
     }
   } else {
     push_cstring(env, in_string);
@@ -866,16 +675,8 @@
   if(CAR(env->head)->type==empty)
     return;			/* Don't reverse an empty list */
 
-  switch(check_args(env, tcons, empty)) {
-  case 1:
-    printerr(env, "Too Few Arguments");
-    return;
-  case 2:
-    printerr(env, "Bad Argument Type");
-    return;
-  default:
-    break;
-  }
+  if(check_args(env, 1, tcons))
+    return printerr(env);
 
   old_head= CAR(env->head);
   new_head= new_val(env);
@@ -1014,33 +815,26 @@
 }
 
 
-int check_args(environment *env, ...)
+int check_args(environment *env, int num_args, ...)
 {
   va_list ap;
   enum type_enum mytype;
+  int i;
 
   value *iter= env->head;
   int errval= 0;
 
-  va_start(ap, env);
-  while(1) {
+  va_start(ap, num_args);
+  for(i=1; i<=num_args; i++) {
     mytype= va_arg(ap, enum type_enum);
     //    fprintf(stderr, "%s\n", env->errsymb); 
 
-    if(mytype==empty)
-      break;
-    
     if(iter->type==empty || iter==NULL) {
       errval= 1;
       break;
     }
 
-    if(mytype==unknown) {
-      iter=CDR(iter);
-      continue;
-    }
-
-    if(CAR(iter)->type!=mytype) {
+    if(mytype!=unknown && CAR(iter)->type!=mytype) {
       errval= 2;
       break;
     }