--- stack/stack.c	2002/03/12 21:05:11	1.107
+++ stack/stack.c	2002/03/16 20:09:51	1.112
@@ -37,6 +37,8 @@
 #include <unistd.h>
 /* EX_NOINPUT, EX_USAGE */
 #include <sysexits.h>
+/* assert */
+#include <assert.h>
 
 #ifdef __linux__
 /* mtrace, muntrace */
@@ -58,7 +60,8 @@
   env->gc_count= 0;
   env->gc_ref= NULL;
 
-  env->head= NULL;
+  env->head= new_val(env);
+  env->head->type= empty;
   for(i= 0; i<HASHTBLSIZE; i++)
     env->symbols[i]= NULL;
   env->err= 0;
@@ -76,7 +79,7 @@
 /* Discard the top element of the stack. */
 extern void toss(environment *env)
 {
-  if(env->head==NULL) {
+  if(env->head->type==empty) {
     printerr("Too Few Arguments");
     env->err= 1;
     return;
@@ -121,6 +124,7 @@
   stackitem *nitem= malloc(sizeof(stackitem));
 
   nval->content.ptr= NULL;
+  nval->type= integer;
 
   nitem->item= nval;
   nitem->next= env->gc_ref;
@@ -185,7 +189,6 @@
   if(env->interactive)
     printf(".");
 
-
   env->gc_count= 0;
 
   while(env->gc_ref!=NULL) {	/* Sweep unused values */
@@ -200,7 +203,32 @@
       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.ptr);
+      break;
+    case symb:
+      printf(" symb: %s", env->gc_ref->item->content.sym->id);
+      break;
+    case tcons:
+      printf(" tcons: %p\t%p", env->gc_ref->item->content.c->car,
+	     env->gc_ref->item->content.c->cdr);
+      break;
+    default:
+      printf(" <unknown %d>", (env->gc_ref->item->type));
+    }
+    printf("\n");
+#endif /* DEBUG */
 
     /* Keep values */     
     env->gc_count += sizeof(value);
@@ -220,7 +248,7 @@
   env->gc_ref= new_head;
 
   if(env->interactive)
-    printf("done\n");
+    printf("done (%d bytes still allocated)\n", env->gc_count);
 
 }
 
@@ -258,6 +286,7 @@
   value *new_value= new_val(env);
 
   new_value->content.c= malloc(sizeof(cons));
+  assert(new_value->content.c!=NULL);
   new_value->type= tcons;
   CAR(new_value)= val;
   CDR(new_value)= env->head;
@@ -324,7 +353,7 @@
 {
   char *new_string;
 
-  if(env->head==NULL) {
+  if(env->head->type==empty) {
     printerr("Too Few Arguments");
     env->err= 1;
     return;
@@ -421,17 +450,16 @@
 /* Gets the type of a value */
 extern void type(environment *env)
 {
-  int typenum;
-
-  if(env->head==NULL) {
+  if(env->head->type==empty) {
     printerr("Too Few Arguments");
     env->err= 1;
     return;
   }
 
-  typenum= CAR(env->head)->type;
-  toss(env);
-  switch(typenum){
+  switch(CAR(env->head)->type){
+  case empty:
+    push_sym(env, "empty");
+    break;
   case integer:
     push_sym(env, "integer");
     break;
@@ -451,12 +479,18 @@
     push_sym(env, "list");
     break;
   }
+  swap(env);
+  if (env->err) return;
+  toss(env);
 }    
 
 /* Prints the top element of the stack. */
 void print_h(value *stack_head, int noquote)
 {
   switch(CAR(stack_head)->type) {
+  case empty:
+    printf("[]");
+    break;
   case integer:
     printf("%d", CAR(stack_head)->content.i);
     break;
@@ -465,9 +499,9 @@
     break;
   case string:
     if(noquote)
-      printf("%s", (char*)CAR(stack_head)->content.ptr);
+      printf("%s", (char*)(CAR(stack_head)->content.ptr));
     else
-      printf("\"%s\"", (char*)CAR(stack_head)->content.ptr);
+      printf("\"%s\"", (char*)(CAR(stack_head)->content.ptr));
     break;
   case symb:
     printf("%s", CAR(stack_head)->content.sym->id);
@@ -479,19 +513,27 @@
     /* A list is just a stack, so make stack_head point to it */
     stack_head= CAR(stack_head);
     printf("[ ");
-    while(stack_head != NULL) {
+    while(stack_head->type != empty) {
       print_h(stack_head, noquote);
-      printf(" ");
+      switch(CDR(stack_head)->type){
+      case empty:
+	break;
+      case tcons:
+	printf(" ");
+	break;
+      default:
+	printf(" . ");		/* Improper list */
+      }
       stack_head= CDR(stack_head);
     }
-    printf("]");
+    printf(" ]");
     break;
   }
 }
 
 extern void print_(environment *env)
 {
-  if(env->head==NULL) {
+  if(env->head->type==empty) {
     printerr("Too Few Arguments");
     env->err= 1;
     return;
@@ -510,7 +552,7 @@
 
 extern void princ_(environment *env)
 {
-  if(env->head==NULL) {
+  if(env->head->type==empty) {
     printerr("Too Few Arguments");
     env->err= 1;
     return;
@@ -529,7 +571,7 @@
 /* Only to be called by function printstack. */
 void print_st(value *stack_head, long counter)
 { 
-  if(CDR(stack_head) != NULL)
+  if(CDR(stack_head)->type != empty)
     print_st(CDR(stack_head), counter+1);
   printf("%ld: ", counter);
   print_h(stack_head, 0);
@@ -539,7 +581,7 @@
 /* Prints the stack. */
 extern void printstack(environment *env)
 {
-  if(env->head == NULL) {
+  if(env->head->type == empty) {
     printf("Stack Empty\n");
     return;
   }
@@ -552,7 +594,7 @@
 {
   value *temp= env->head;
   
-  if(env->head==NULL || CDR(env->head)==NULL) {
+  if(env->head->type == empty || CDR(env->head)->type == empty) {
     printerr("Too Few Arguments");
     env->err=1;
     return;
@@ -568,8 +610,8 @@
 {
   value *temp= env->head;
   
-  if(env->head==NULL || CDR(env->head)==NULL
-     || CDR(CDR(env->head))==NULL) {
+  if(env->head->type == empty || CDR(env->head)->type == empty
+     || CDR(CDR(env->head))->type == empty) {
     printerr("Too Few Arguments");
     env->err= 1;
     return;
@@ -585,7 +627,7 @@
 {
   value *val;
 
-  if(env->head==NULL) {
+  if(env->head->type==empty) {
     printerr("Too Few Arguments");
     env->err= 1;
     return;
@@ -603,11 +645,11 @@
     env->err= 3;
     return;
   }
-  protect(val);
-  toss(env);		/* toss the symbol */
+  push_val(env, val);		/* Return the symbol's bound value */
+  swap(env);
+  if(env->err) return;
+  toss(env);			/* toss the symbol */
   if(env->err) return;
-  push_val(env, val); /* Return its bound value */
-  unprotect(val);
 }
 
 /* If the top element is a symbol, determine if it's bound to a
@@ -623,7 +665,7 @@
 
   gc_maybe(env);
 
-  if(env->head==NULL) {
+  if(env->head->type==empty) {
     printerr("Too Few Arguments");
     env->err= 1;
     return;
@@ -654,7 +696,7 @@
     toss(env); if(env->err) return;
     iterator= temp_val;
     
-    while(iterator!=NULL) {
+    while(iterator->type != empty) {
       push_val(env, CAR(iterator));
       
       if(CAR(env->head)->type==symb
@@ -662,13 +704,13 @@
 	toss(env);
 	if(env->err) return;
 	
-	if(CDR(iterator)==NULL){
+	if(CDR(iterator)->type == empty){
 	  goto eval_start;
 	}
 	eval(env);
 	if(env->err) return;
       }
-      if (CDR(iterator)->type == tcons) 
+      if (CDR(iterator)->type == empty || CDR(iterator)->type == tcons) 
 	iterator= CDR(iterator);
       else {
 	printerr("Bad Argument Type"); /* Improper list */
@@ -689,12 +731,15 @@
 {
   value *old_head, *new_head, *item;
 
-  if(env->head==NULL) {
+  if(env->head->type==empty) {
     printerr("Too Few Arguments");
     env->err= 1;
     return;
   }
 
+  if(CAR(env->head)->type==empty)
+    return;			/* Don't reverse an empty list */
+
   if(CAR(env->head)->type!=tcons) {
     printerr("Bad Argument Type");
     env->err= 2;
@@ -702,8 +747,9 @@
   }
 
   old_head= CAR(env->head);
-  new_head= NULL;
-  while(old_head!=NULL) {
+  new_head= new_val(env);
+  new_head->type= empty;
+  while(old_head->type != empty) {
     item= old_head;
     old_head= CDR(old_head);
     CDR(item)= new_head;
@@ -715,17 +761,20 @@
 /* Make a list. */
 extern void pack(environment *env)
 {
-  value *iterator, *temp;
+  value *iterator, *temp, *ending;
+
+  ending=new_val(env);
+  ending->type=empty;
 
   iterator= env->head;
-  if(iterator==NULL
+  if(iterator->type == empty
      || (CAR(iterator)->type==symb
      && CAR(iterator)->content.sym->id[0]=='[')) {
-    temp= NULL;
+    temp= ending;
     toss(env);
   } else {
     /* Search for first delimiter */
-    while(CDR(iterator)!=NULL
+    while(CDR(iterator)->type != empty
 	  && (CAR(CDR(iterator))->type!=symb
 	   || CAR(CDR(iterator))->content.sym->id[0]!='['))
       iterator= CDR(iterator);
@@ -733,9 +782,9 @@
     /* Extract list */
     temp= env->head;
     env->head= CDR(iterator);
-    CDR(iterator)= NULL;
+    CDR(iterator)= ending;
 
-    if(env->head!=NULL)
+    if(env->head->type != empty)
       toss(env);
   }
 
@@ -751,7 +800,7 @@
   value *temp, *new_head;
 
   /* Is top element a list? */
-  if(env->head==NULL) {
+  if(env->head->type==empty) {
     printerr("Too Few Arguments");
     env->err= 1;
     return;
@@ -774,7 +823,7 @@
   toss(env);
 
   /* Find the end of the list */
-  while(CDR(temp)->content.ptr != NULL) {
+  while(CDR(temp)->type != empty) {
     if (CDR(temp)->type == tcons)
       temp= CDR(temp);
     else {
@@ -795,7 +844,7 @@
 {
   void *left, *right;
 
-  if(env->head==NULL || CDR(env->head)==NULL) {
+  if(env->head->type==empty || CDR(env->head)->type==empty) {
     printerr("Too Few Arguments");
     env->err= 1;
     return;
@@ -813,7 +862,7 @@
 {
   int val;
 
-  if(env->head==NULL) {
+  if(env->head->type==empty) {
     printerr("Too Few Arguments");
     env->err= 1;
     return;
@@ -844,7 +893,7 @@
   symbol *sym;
 
   /* Needs two values on the stack, the top one must be a symbol */
-  if(env->head==NULL || CDR(env->head)==NULL) {
+  if(env->head->type==empty || CDR(env->head)->type==empty) {
     printerr("Too Few Arguments");
     env->err= 1;
     return;
@@ -883,6 +932,8 @@
   env->gc_limit= 0;
   gc_maybe(env);
 
+  words(env);
+
   if(env->free_string!=NULL)
     free(env->free_string);
   
@@ -896,7 +947,7 @@
 /* Clear stack */
 extern void clear(environment *env)
 {
-  while(env->head!=NULL)
+  while(env->head->type != empty)
     toss(env);
 }
 
@@ -909,6 +960,10 @@
   for(i= 0; i<HASHTBLSIZE; i++) {
     temp= env->symbols[i];
     while(temp!=NULL) {
+#ifdef DEBUG
+      if (temp->val != NULL && temp->val->gc.flag.protect)
+	printf("(protected) ");
+#endif /* DEBUG */
       printf("%s\n", temp->id);
       temp= temp->next;
     }
@@ -931,21 +986,20 @@
 extern void forget(environment *env)
 {
   char* sym_id;
-  value *stack_head= env->head;
 
-  if(stack_head==NULL) {
+  if(env->head->type==empty) {
     printerr("Too Few Arguments");
     env->err= 1;
     return;
   }
   
-  if(CAR(stack_head)->type!=symb) {
+  if(CAR(env->head)->type!=symb) {
     printerr("Bad Argument Type");
     env->err= 2;
     return;
   }
 
-  sym_id= CAR(stack_head)->content.sym->id;
+  sym_id= CAR(env->head)->content.sym->id;
   toss(env);
 
   return forget_sym(hash(env->symbols, sym_id));
@@ -979,7 +1033,7 @@
 	break;
       case '?':
 	fprintf (stderr,
-		 "Unknown option character `\\x%x'.\n",
+		 "Unknown option character '\\x%x'.\n",
 		 optopt);
 	return EX_USAGE;
       default:
@@ -996,11 +1050,11 @@
   }
 
   if(myenv.interactive) {
-    printf("Stack version $Revision: 1.107 $\n\
+    printf("Stack version $Revision: 1.112 $\n\
 Copyright (C) 2002  Mats Alritzson and Teddy Hogeborn\n\
-Stack comes with ABSOLUTELY NO WARRANTY; for details type `warranty;'.\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.\n");
   }
 
   while(1) {
@@ -1015,10 +1069,11 @@
       }
       myenv.err=0;
     }
-    sx_72656164(&myenv);
-    if (myenv.err==4) {
-      return EXIT_SUCCESS;	/* EOF */
-    } else if(myenv.head!=NULL
+    sx_72656164(&myenv);	/* "read" */
+    if (myenv.err==4) {		/* EOF */
+      myenv.err=0;
+      quit(&myenv);
+    } else if(myenv.head->type!=empty
 	      && CAR(myenv.head)->type==symb
 	      && CAR(myenv.head)->content.sym->id[0]
 	      ==';') {
@@ -1040,7 +1095,7 @@
   char* new_string;
   value *a_val, *b_val;
 
-  if(env->head==NULL || CDR(env->head)==NULL) {
+  if(env->head->type==empty || CDR(env->head)->type==empty) {
     printerr("Too Few Arguments");
     env->err= 1;
     return;
@@ -1118,7 +1173,7 @@
   int a, b;
   float fa, fb;
 
-  if(env->head==NULL || CDR(env->head)==NULL) {
+  if(env->head->type==empty || CDR(env->head)->type==empty) {
     printerr("Too Few Arguments");
     env->err=1;
     return;
@@ -1178,7 +1233,7 @@
   int a, b;
   float fa, fb;
 
-  if(env->head==NULL || CDR(env->head)==NULL) {
+  if(env->head->type==empty || CDR(env->head)->type==empty) {
     printerr("Too Few Arguments");
     env->err= 1;
     return;
@@ -1263,7 +1318,6 @@
 
   protect(old_value);
   new_value= new_val(env);
-  protect(new_value);
   new_value->type= old_value->type;
 
   switch(old_value->type){
@@ -1278,15 +1332,16 @@
       strdup((char *)(old_value->content.ptr));
     break;
   case tcons:
-    new_value= NULL;
 
     new_value->content.c= malloc(sizeof(cons));
+    assert(new_value->content.c!=NULL);
+
     CAR(new_value)= copy_val(env, CAR(old_value)); /* recurse */
     CDR(new_value)= copy_val(env, CDR(old_value)); /* recurse */
     break;
   }
 
-  unprotect(old_value); unprotect(new_value);
+  unprotect(old_value);
 
   return new_value;
 }
@@ -1294,7 +1349,7 @@
 /* "dup"; duplicates an item on the stack */
 extern void sx_647570(environment *env)
 {
-  if(env->head==NULL) {
+  if(env->head->type==empty) {
     printerr("Too Few Arguments");
     env->err= 1;
     return;
@@ -1307,7 +1362,7 @@
 {
   int truth;
 
-  if(env->head==NULL || CDR(env->head)==NULL) {
+  if(env->head->type==empty || CDR(env->head)->type==empty) {
     printerr("Too Few Arguments");
     env->err= 1;
     return;
@@ -1338,8 +1393,8 @@
 {
   int truth;
 
-  if(env->head==NULL || CDR(env->head)==NULL 
-     || CDR(CDR(env->head))==NULL) {
+  if(env->head->type==empty || CDR(env->head)->type==empty
+     || CDR(CDR(env->head))->type==empty) {
     printerr("Too Few Arguments");
     env->err= 1;
     return;
@@ -1371,8 +1426,31 @@
 
 extern void sx_656c7365(environment *env)
 {
-  if(env->head==NULL || CDR(env->head)==NULL 
-     || CDR(CDR(env->head))==NULL || CDR(CDR(CDR(env->head)))==NULL) {
+  if(env->head->type==empty || CDR(env->head)->type==empty 
+     || CDR(CDR(env->head))->type==empty || CDR(CDR(CDR(env->head)))->type==empty
+     || CDR(CDR(CDR(CDR(env->head))))->type==empty) {
+    printerr("Too Few Arguments");
+    env->err= 1;
+    return;
+  }
+
+  if(CAR(CDR(env->head))->type!=symb
+     || strcmp(CAR(CDR(env->head))->content.sym->id, "then")!=0
+     || CAR(CDR(CDR(CDR(env->head))))->type!=symb
+     || strcmp(CAR(CDR(CDR(CDR(env->head))))->content.sym->id, "if")!=0) {
+    printerr("Bad Argument Type");
+    env->err= 2;
+    return;
+  }
+
+  swap(env); toss(env); rot(env); toss(env);
+  ifelse(env);
+}
+
+extern void then(environment *env)
+{
+  if(env->head->type==empty || CDR(env->head)->type==empty
+     || CDR(CDR(env->head))->type==empty) { 
     printerr("Too Few Arguments");
     env->err= 1;
     return;
@@ -1386,7 +1464,7 @@
   }
 
   swap(env); toss(env);
-  ifelse(env);
+  sx_6966(env);
 }
 
 /* "while" */
@@ -1395,7 +1473,7 @@
   int truth;
   value *loop, *test;
 
-  if(env->head==NULL || CDR(env->head)==NULL) {
+  if(env->head->type==empty || CDR(env->head)->type==empty) {
     printerr("Too Few Arguments");
     env->err= 1;
     return;
@@ -1441,8 +1519,8 @@
   value *loop;
   int foo1, foo2;
 
-  if(env->head==NULL || CDR(env->head)==NULL 
-     || CDR(CDR(env->head))==NULL) {
+  if(env->head->type==empty || CDR(env->head)->type==empty 
+     || CDR(CDR(env->head))->type==empty) {
     printerr("Too Few Arguments");
     env->err= 1;
     return;
@@ -1489,7 +1567,7 @@
   value *loop, *foo;
   value *iterator;
   
-  if(env->head==NULL || CDR(env->head)==NULL) {
+  if(env->head->type==empty || CDR(env->head)->type==empty) {
     printerr("Too Few Arguments");
     env->err= 1;
     return;
@@ -1532,7 +1610,7 @@
   int ending, start, i;
   value *iterator, *temp;
 
-  if(env->head==NULL || CDR(env->head)==NULL) {
+  if(env->head->type==empty || CDR(env->head)->type==empty) {
     printerr("Too Few Arguments");
     env->err= 1;
     return;
@@ -1562,7 +1640,7 @@
 
   iterator= env->head;
 
-  if(iterator==NULL
+  if(iterator->type==empty
      || (CAR(iterator)->type==symb
 	 && CAR(iterator)->content.sym->id[0]=='[')) {
     temp= NULL;
@@ -1684,7 +1762,7 @@
 {
   int freq, dur, period, ticks;
 
-  if(env->head==NULL || CDR(env->head)==NULL) {
+  if(env->head->type==empty || CDR(env->head)->type==empty) {
     printerr("Too Few Arguments");
     env->err= 1;
     return;
@@ -1729,7 +1807,7 @@
 {
   int dur;
 
-  if(env->head==NULL) {
+  if(env->head->type==empty) {
     printerr("Too Few Arguments");
     env->err= 1;
     return;
@@ -1749,7 +1827,7 @@
 
 extern void copying(environment *env)
 {
-  printf("GNU GENERAL PUBLIC LICENSE\n\
+  printf("		    GNU GENERAL PUBLIC LICENSE\n\
 		       Version 2, June 1991\n\
 \n\
  Copyright (C) 1989, 1991 Free Software Foundation, Inc.\n\
@@ -2038,7 +2116,7 @@
   int a, b;
   float fa, fb;
 
-  if(env->head==NULL || CDR(env->head)==NULL) {
+  if(env->head->type==empty || CDR(env->head)->type==empty) {
     printerr("Too Few Arguments");
     env->err= 1;
     return;
@@ -2098,7 +2176,7 @@
   int a, b;
   float fa, fb;
 
-  if(env->head==NULL || CDR(env->head)==NULL) {
+  if(env->head->type==empty || CDR(env->head)->type==empty) {
     printerr("Too Few Arguments");
     env->err= 1;
     return;
@@ -2157,7 +2235,7 @@
 {
   int a, b;
 
-  if(env->head==NULL || CDR(env->head)==NULL) {
+  if(env->head->type==empty || CDR(env->head)->type==empty) {
     printerr("Too Few Arguments");
     env->err= 1;
     return;
@@ -2183,7 +2261,7 @@
 {
   int a, b;
   
-  if(env->head==NULL || CDR(env->head)==NULL) {
+  if(env->head->type==empty || CDR(env->head)->type==empty) {
     printerr("Too Few Arguments");
     env->err= 1;
     return;