--- stack/stack.c	2002/03/12 14:06:05	1.104
+++ stack/stack.c	2002/03/16 09:12:39	1.110
@@ -37,12 +37,17 @@
 #include <unistd.h>
 /* EX_NOINPUT, EX_USAGE */
 #include <sysexits.h>
+/* assert */
+#include <assert.h>
+
+#ifdef __linux__
 /* mtrace, muntrace */
 #include <mcheck.h>
 /* ioctl */
 #include <sys/ioctl.h>
 /* KDMKTONE */
 #include <linux/kd.h>
+#endif /* __linux__ */
 
 #include "stack.h"
 
@@ -118,6 +123,7 @@
   stackitem *nitem= malloc(sizeof(stackitem));
 
   nval->content.ptr= NULL;
+  nval->type= integer;
 
   nitem->item= nval;
   nitem->next= env->gc_ref;
@@ -182,7 +188,6 @@
   if(env->interactive)
     printf(".");
 
-
   env->gc_count= 0;
 
   while(env->gc_ref!=NULL) {	/* Sweep unused values */
@@ -197,7 +202,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);
@@ -217,7 +247,7 @@
   env->gc_ref= new_head;
 
   if(env->interactive)
-    printf("done\n");
+    printf("done (%d bytes still allocated)\n", env->gc_count);
 
 }
 
@@ -255,6 +285,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;
@@ -467,7 +498,7 @@
       printf("\"%s\"", (char*)CAR(stack_head)->content.ptr);
     break;
   case symb:
-    printf("%s", ((symbol *)(CAR(stack_head)->content.ptr))->id);
+    printf("%s", CAR(stack_head)->content.sym->id);
     break;
   case func:
     printf("#<function %p>", (funcp)(CAR(stack_head)->content.ptr));
@@ -594,17 +625,17 @@
     return;
   }
 
-  val= ((symbol *)(CAR(env->head)->content.ptr))->val;
+  val= CAR(env->head)->content.sym->val;
   if(val == NULL){
     printerr("Unbound Variable");
     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
@@ -655,7 +686,7 @@
       push_val(env, CAR(iterator));
       
       if(CAR(env->head)->type==symb
-	 && (((symbol*)(CAR(env->head)->content.ptr))->id[0]==';')) {
+	 && CAR(env->head)->content.sym->id[0]==';') {
 	toss(env);
 	if(env->err) return;
 	
@@ -665,7 +696,7 @@
 	eval(env);
 	if(env->err) return;
       }
-      if (CDR(iterator)->type == tcons) 
+      if (CDR(iterator)==NULL || CDR(iterator)->type == tcons) 
 	iterator= CDR(iterator);
       else {
 	printerr("Bad Argument Type"); /* Improper list */
@@ -717,14 +748,14 @@
   iterator= env->head;
   if(iterator==NULL
      || (CAR(iterator)->type==symb
-     && ((symbol*)(CAR(iterator)->content.ptr))->id[0]=='[')) {
+     && CAR(iterator)->content.sym->id[0]=='[')) {
     temp= NULL;
     toss(env);
   } else {
     /* Search for first delimiter */
     while(CDR(iterator)!=NULL
 	  && (CAR(CDR(iterator))->type!=symb
-	   || ((symbol*)(CAR(CDR(iterator))->content.ptr))->id[0]!='['))
+	   || CAR(CDR(iterator))->content.sym->id[0]!='['))
       iterator= CDR(iterator);
     
     /* Extract list */
@@ -880,10 +911,14 @@
   env->gc_limit= 0;
   gc_maybe(env);
 
+  words(env);
+
   if(env->free_string!=NULL)
     free(env->free_string);
   
+#ifdef __linux__
   muntrace();
+#endif
 
   exit(EXIT_SUCCESS);
 }
@@ -904,6 +939,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;
     }
@@ -940,7 +979,7 @@
     return;
   }
 
-  sym_id= ((symbol*)(CAR(stack_head)->content.ptr))->id;
+  sym_id= CAR(stack_head)->content.sym->id;
   toss(env);
 
   return forget_sym(hash(env->symbols, sym_id));
@@ -958,7 +997,9 @@
 
   int c;			/* getopt option character */
 
+#ifdef __linux__
   mtrace();
+#endif
 
   init_env(&myenv);
 
@@ -972,7 +1013,7 @@
 	break;
       case '?':
 	fprintf (stderr,
-		 "Unknown option character `\\x%x'.\n",
+		 "Unknown option character '\\x%x'.\n",
 		 optopt);
 	return EX_USAGE;
       default:
@@ -989,11 +1030,11 @@
   }
 
   if(myenv.interactive) {
-    printf("Stack version $Revision: 1.104 $\n\
+    printf("Stack version $Revision: 1.110 $\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) {
@@ -1008,12 +1049,13 @@
       }
       myenv.err=0;
     }
-    sx_72656164(&myenv);
-    if (myenv.err==4) {
-      return EXIT_SUCCESS;	/* EOF */
+    sx_72656164(&myenv);	/* "read" */
+    if (myenv.err==4) {		/* EOF */
+      myenv.err=0;
+      quit(&myenv);
     } else if(myenv.head!=NULL
 	      && CAR(myenv.head)->type==symb
-	      && ((symbol*)(CAR(myenv.head)->content.ptr))->id[0]
+	      && CAR(myenv.head)->content.sym->id[0]
 	      ==';') {
       toss(&myenv); 		/* No error check in main */
       eval(&myenv);
@@ -1256,7 +1298,6 @@
 
   protect(old_value);
   new_value= new_val(env);
-  protect(new_value);
   new_value->type= old_value->type;
 
   switch(old_value->type){
@@ -1271,15 +1312,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;
 }
@@ -1362,6 +1404,49 @@
   eval(env);
 }
 
+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
+     || CDR(CDR(CDR(CDR(env->head))))==NULL) {
+    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==NULL || CDR(env->head)==NULL
+     || CDR(CDR(env->head))==NULL) { 
+    printerr("Too Few Arguments");
+    env->err= 1;
+    return;
+  }
+
+  if(CAR(CDR(env->head))->type!=symb
+     || strcmp(CAR(CDR(env->head))->content.sym->id, "if")!=0) {
+    printerr("Bad Argument Type");
+    env->err= 2;
+    return;
+  }
+
+  swap(env); toss(env);
+  sx_6966(env);
+}
+
 /* "while" */
 extern void sx_7768696c65(environment *env)
 {
@@ -1488,7 +1573,7 @@
     push_val(env, CAR(iterator));
     push_val(env, loop);
     eval(env); if(env->err) return;
-    if (CDR(iterator)->type == tcons){
+    if (iterator->type == tcons){
       iterator= CDR(iterator);
     } else {
       printerr("Bad Argument Type"); /* Improper list */
@@ -1537,15 +1622,14 @@
 
   if(iterator==NULL
      || (CAR(iterator)->type==symb
-	 && ((symbol*)(CAR(iterator)->content.ptr))->id[0]=='[')) {
+	 && CAR(iterator)->content.sym->id[0]=='[')) {
     temp= NULL;
     toss(env);
   } else {
     /* Search for first delimiter */
-    while(CDR(iterator)!=NULL
+    while(CDR(iterator)!=NULL 
 	  && (CAR(CDR(iterator))->type!=symb
-	      || ((symbol*)(CAR(CDR(iterator))->content.ptr))->id[0]
-	      !='['))
+	      || CAR(CDR(iterator))->content.sym->id[0]!='['))
       iterator= CDR(iterator);
     
     /* Extract list */
@@ -1653,6 +1737,7 @@
     return sx_72656164(env);
 }
 
+#ifdef __linux__
 extern void beep(environment *env)
 {
   int freq, dur, period, ticks;
@@ -1695,6 +1780,7 @@
     abort();
   }
 }
+#endif /* __linux__ */
 
 /* "wait" */
 extern void sx_77616974(environment *env)