--- stack/stack.c	2002/03/12 14:53:19	1.105
+++ stack/stack.c	2002/03/31 02:19:54	1.125
@@ -1,3 +1,4 @@
+/* -*- coding: utf-8; -*- */
 /*
     stack - an interactive interpreter for a stack-based language
     Copyright (C) 2002	Mats Alritzson and Teddy Hogeborn
@@ -20,8 +21,8 @@
 	     Teddy Hogeborn <teddy@fukt.bth.se>
 */
 
-#define CAR(X) X->content.c->car
-#define CDR(X) X->content.c->cdr
+#define CAR(X) ((X)->content.c->car)
+#define CDR(X) ((X)->content.c->cdr)
 
 /* printf, sscanf, fgets, fprintf, fopen, perror */
 #include <stdio.h>
@@ -37,12 +38,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"
 
@@ -55,7 +61,7 @@
   env->gc_count= 0;
   env->gc_ref= NULL;
 
-  env->head= NULL;
+  env->head= new_val(env);
   for(i= 0; i<HASHTBLSIZE; i++)
     env->symbols[i]= NULL;
   env->err= 0;
@@ -73,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;
@@ -117,7 +123,11 @@
   value *nval= malloc(sizeof(value));
   stackitem *nitem= malloc(sizeof(stackitem));
 
+  assert(nval != NULL);
+  assert(nitem != NULL);
+
   nval->content.ptr= NULL;
+  nval->type= empty;
 
   nitem->item= nval;
   nitem->next= env->gc_ref;
@@ -158,7 +168,6 @@
 extern void gc_init(environment *env)
 {
   stackitem *new_head= NULL, *titem;
-  cons *iterator;
   symbol *tsymb;
   int i;
 
@@ -182,27 +191,65 @@
   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 */
 
-      if(env->gc_ref->item->type==string) /* Remove content */
+      /* Remove content */
+      switch(env->gc_ref->item->type){
+      case string:
 	free(env->gc_ref->item->content.ptr);
+	break;
+      case tcons:
+	free(env->gc_ref->item->content.c);
+	break;
+      case port:
+      case empty:
+      case integer:
+      case tfloat:
+      case func:
+      case symb:
+	/* Symbol strings are freed when walking the hash table */
+      }
 
       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.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);
     if(env->gc_ref->item->type==string)
-      env->gc_count += strlen(env->gc_ref->item->content.ptr);
+      env->gc_count += strlen(env->gc_ref->item->content.ptr)+1;
     
     titem= env->gc_ref->next;
     env->gc_ref->next= new_head;
@@ -217,7 +264,7 @@
   env->gc_ref= new_head;
 
   if(env->interactive)
-    printf("done\n");
+    printf("done (%d bytes still allocated)\n", env->gc_count);
 
 }
 
@@ -254,7 +301,9 @@
 {
   value *new_value= new_val(env);
 
-  new_value->content.c= malloc(sizeof(cons));
+  new_value->content.c= malloc(sizeof(pair));
+  assert(new_value->content.c!=NULL);
+  env->gc_count += sizeof(pair);
   new_value->type= tcons;
   CAR(new_value)= val;
   CDR(new_value)= env->head;
@@ -290,6 +339,7 @@
   int length= strlen(in_string)+1;
 
   new_value->content.ptr= malloc(length);
+  assert(new_value != NULL);
   env->gc_count += length;
   strcpy(new_value->content.ptr, in_string);
   new_value->type= string;
@@ -304,6 +354,7 @@
   char *new_string, *current;
 
   new_string= malloc((strlen(old_string)*2)+4);
+  assert(new_string != NULL);
   strcpy(new_string, "sx_");	/* Stack eXternal */
   current= new_string+3;
   while(old_string[0] != '\0'){
@@ -321,7 +372,7 @@
 {
   char *new_string;
 
-  if(env->head==NULL) {
+  if(env->head->type==empty) {
     printerr("Too Few Arguments");
     env->err= 1;
     return;
@@ -373,9 +424,11 @@
 
     /* Create a new symbol */
     (*new_symbol)= malloc(sizeof(symbol));
+    assert((*new_symbol) != NULL);
     (*new_symbol)->val= NULL;	/* undefined value */
     (*new_symbol)->next= NULL;
     (*new_symbol)->id= malloc(strlen(in_string)+1);
+    assert((*new_symbol)->id != NULL);
     strcpy((*new_symbol)->id, in_string);
 
     /* Intern the new symbol in the hash table */
@@ -410,25 +463,47 @@
 }
 
 /* Print newline. */
-extern void nl()
+extern void nl(environment *env)
 {
   printf("\n");
 }
 
+/* Print a newline to a port */
+extern void nlport(environment *env)
+{
+  if(env->head->type==empty) {
+    printerr("Too Few Arguments");
+    env->err= 1;
+    return;
+  }
+
+  if(CAR(env->head)->type!=port) {
+    printerr("Bad Argument Type");
+    env->err= 2;
+    return;
+  }
+
+  if(fprintf(CAR(env->head)->content.p, "\n") < 0){
+    perror("nl");
+    env->err= 5;
+    return;
+  }
+  toss(env);
+}
+
 /* 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;
@@ -445,59 +520,182 @@
     push_sym(env, "function");
     break;
   case tcons:
-    push_sym(env, "list");
+    push_sym(env, "pair");
+    break;
+  case port:
+    push_sym(env, "port");
     break;
   }
-}    
+  swap(env);
+  if (env->err) return;
+  toss(env);
+}
 
-/* Prints the top element of the stack. */
-void print_h(value *stack_head, int noquote)
+/* Print a value */
+void print_val(environment *env, value *val, int noquote, stackitem *stack, FILE *stream)
 {
-  switch(CAR(stack_head)->type) {
+  stackitem *titem, *tstack;
+  int depth;
+
+  switch(val->type) {
+  case empty:
+    if(fprintf(stream, "[]") < 0){
+      perror("print_val");
+      env->err= 5;
+      return;
+    }
+    break;
   case integer:
-    printf("%d", CAR(stack_head)->content.i);
+    if(fprintf(stream, "%d", val->content.i) < 0){
+      perror("print_val");
+      env->err= 5;
+      return;
+    }
     break;
   case tfloat:
-    printf("%f", CAR(stack_head)->content.f);
+    if(fprintf(stream, "%f", val->content.f) < 0){
+      perror("print_val");
+      env->err= 5;
+      return;
+    }
     break;
   case string:
-    if(noquote)
-      printf("%s", (char*)CAR(stack_head)->content.ptr);
-    else
-      printf("\"%s\"", (char*)CAR(stack_head)->content.ptr);
+    if(noquote){
+      if(fprintf(stream, "%s", (char*)(val->content.ptr)) < 0){
+	perror("print_val");
+	env->err= 5;
+	return;
+      }
+    } else {			/* quote */
+      if(fprintf(stream, "\"%s\"", (char*)(val->content.ptr)) < 0){
+	perror("print_val");
+	env->err= 5;
+	return;
+      }
+    }
     break;
   case symb:
-    printf("%s", CAR(stack_head)->content.sym->id);
+    if(fprintf(stream, "%s", val->content.sym->id) < 0){
+      perror("print_val");
+      env->err= 5;
+      return;
+    }
     break;
   case func:
-    printf("#<function %p>", (funcp)(CAR(stack_head)->content.ptr));
+    if(fprintf(stream, "#<function %p>", (funcp)(val->content.ptr)) < 0){
+      perror("print_val");
+      env->err= 5;
+      return;
+    }
+    break;
+  case port:
+    if(fprintf(stream, "#<port %p>", (funcp)(val->content.p)) < 0){
+      perror("print_val");
+      env->err= 5;
+      return;
+    }
     break;
   case tcons:
-    /* A list is just a stack, so make stack_head point to it */
-    stack_head= CAR(stack_head);
-    printf("[ ");
-    while(stack_head != NULL) {
-      print_h(stack_head, noquote);
-      printf(" ");
-      stack_head= CDR(stack_head);
+    if(fprintf(stream, "[ ") < 0){
+      perror("print_val");
+      env->err= 5;
+      return;
+    }
+    tstack= stack;
+    do {
+      titem=malloc(sizeof(stackitem));
+      assert(titem != NULL);
+      titem->item=val;
+      titem->next=tstack;
+      tstack=titem;		/* Put it on the stack */
+      /* Search a stack of values being printed to see if we are already
+	 printing this value */
+      titem=tstack;
+      depth=0;
+      while(titem != NULL && titem->item != CAR(val)){
+	titem=titem->next;
+	depth++;
+      }
+      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;
+	}
+      } else {
+	print_val(env, CAR(val), noquote, tstack, stream);
+      }
+      val= CDR(val);
+      switch(val->type){
+      case empty:
+	break;
+      case tcons:
+	/* Search a stack of values being printed to see if we are already
+	   printing this value */
+	titem=tstack;
+	depth=0;
+	while(titem != NULL && titem->item != val){
+	  titem=titem->next;
+	  depth++;
+	}
+	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;
+	    goto printval_end;
+	  }
+	} else {
+	  if(fprintf(stream, " ") < 0){
+	    perror("print_val");
+	    env->err= 5;
+	    goto printval_end;
+	  }
+	}
+	break;
+      default:
+	if(fprintf(stream, " . ") < 0){	/* Improper list */
+	  perror("print_val");
+	  env->err= 5;
+	  goto printval_end;
+        }
+	print_val(env, val, noquote, tstack, stream);
+      }
+    } while(val->type == tcons && titem == NULL);
+
+  printval_end:
+
+    titem=tstack;
+    while(titem != stack){
+      tstack=titem->next;
+      free(titem);
+      titem=tstack;
+    }
+
+    if(! (env->err)){
+      if(fprintf(stream, " ]") < 0){
+	perror("print_val");
+	env->err= 5;
+      }
     }
-    printf("]");
     break;
   }
 }
 
+/* Print the top element of the stack but don't discard it */
 extern void print_(environment *env)
 {
-  if(env->head==NULL) {
+  if(env->head->type==empty) {
     printerr("Too Few Arguments");
     env->err= 1;
     return;
   }
-  print_h(env->head, 0);
-  nl();
+  print_val(env, CAR(env->head), 0, NULL, stdout);
+  if(env->err) return;
+  nl(env);
 }
 
-/* Prints the top element of the stack and then discards it. */
+/* Prints the top element of the stack */
 extern void print(environment *env)
 {
   print_(env);
@@ -505,17 +703,19 @@
   toss(env);
 }
 
+/* Print the top element of the stack without quotes, but don't
+   discard it. */
 extern void princ_(environment *env)
 {
-  if(env->head==NULL) {
+  if(env->head->type==empty) {
     printerr("Too Few Arguments");
     env->err= 1;
     return;
   }
-  print_h(env->head, 1);
+  print_val(env, CAR(env->head), 1, NULL, stdout);
 }
 
-/* Prints the top element of the stack and then discards it. */
+/* Prints the top element of the stack without quotes. */
 extern void princ(environment *env)
 {
   princ_(env);
@@ -523,25 +723,80 @@
   toss(env);
 }
 
-/* Only to be called by function printstack. */
-void print_st(value *stack_head, long counter)
+/* Print a value to a port, but don't discard it */
+extern void printport_(environment *env)
+{
+  if(env->head->type==empty ||  CDR(env->head)->type == empty) {
+    printerr("Too Few Arguments");
+    env->err= 1;
+    return;
+  }
+
+  if(CAR(env->head)->type!=port) {
+    printerr("Bad Argument Type");
+    env->err= 2;
+    return;
+  }
+
+  print_val(env, CAR(CDR(env->head)), 0, NULL, CAR(env->head)->content.p);
+  if(env->err) return;
+  nlport(env);
+}
+
+/* Print a value to a port */
+extern void printport(environment *env)
+{
+  printport_(env);
+  if(env->err) return;
+  toss(env);
+}
+
+/* Print, without quotes, to a port, a value, but don't discard it. */
+extern void princport_(environment *env)
+{
+  if(env->head->type==empty ||  CDR(env->head)->type == empty) {
+    printerr("Too Few Arguments");
+    env->err= 1;
+    return;
+  }
+
+  if(CAR(env->head)->type!=port) {
+    printerr("Bad Argument Type");
+    env->err= 2;
+    return;
+  }
+
+  print_val(env, CAR(CDR(env->head)), 1, NULL, CAR(env->head)->content.p);
+  toss(env); if(env->err) return;
+}
+
+/* Print, without quotes, to a port, the top element. */
+extern void princport(environment *env)
+{
+  princport_(env);
+  if(env->err) return;
+  toss(env);
+}
+
+/* Only to be called by itself function printstack. */
+void print_st(environment *env, value *stack_head, long counter)
 { 
-  if(CDR(stack_head) != NULL)
-    print_st(CDR(stack_head), counter+1);
+  if(CDR(stack_head)->type != empty)
+    print_st(env, CDR(stack_head), counter+1);
   printf("%ld: ", counter);
-  print_h(stack_head, 0);
-  nl();
+  print_val(env, CAR(stack_head), 0, NULL, stdout);
+  nl(env);
 }
 
 /* Prints the stack. */
 extern void printstack(environment *env)
 {
-  if(env->head == NULL) {
+  if(env->head->type == empty) {
     printf("Stack Empty\n");
     return;
   }
 
-  print_st(env->head, 1);
+  print_st(env, env->head, 1);
 }
 
 /* Swap the two top elements on the stack. */
@@ -549,7 +804,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;
@@ -565,8 +820,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;
@@ -582,7 +837,7 @@
 {
   value *val;
 
-  if(env->head==NULL) {
+  if(env->head->type==empty) {
     printerr("Too Few Arguments");
     env->err= 1;
     return;
@@ -600,11 +855,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
@@ -620,7 +875,7 @@
 
   gc_maybe(env);
 
-  if(env->head==NULL) {
+  if(env->head->type==empty) {
     printerr("Too Few Arguments");
     env->err= 1;
     return;
@@ -651,7 +906,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
@@ -659,13 +914,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 */
@@ -676,7 +931,12 @@
     unprotect(temp_val);
     return;
 
-  default:
+  case empty:
+    toss(env); 
+  case integer:
+  case tfloat:
+  case string:
+  case port:
     return;
   }
 }
@@ -686,12 +946,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;
@@ -699,8 +962,8 @@
   }
 
   old_head= CAR(env->head);
-  new_head= NULL;
-  while(old_head!=NULL) {
+  new_head= new_val(env);
+  while(old_head->type != empty) {
     item= old_head;
     old_head= CDR(old_head);
     CDR(item)= new_head;
@@ -712,17 +975,19 @@
 /* Make a list. */
 extern void pack(environment *env)
 {
-  value *iterator, *temp;
+  value *iterator, *temp, *ending;
+
+  ending=new_val(env);
 
   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);
@@ -730,9 +995,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);
   }
 
@@ -748,7 +1013,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;
@@ -771,7 +1036,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 {
@@ -792,7 +1057,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;
@@ -810,7 +1075,7 @@
 {
   int val;
 
-  if(env->head==NULL) {
+  if(env->head->type==empty) {
     printerr("Too Few Arguments");
     env->err= 1;
     return;
@@ -841,7 +1106,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;
@@ -880,10 +1145,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);
 }
@@ -891,7 +1160,7 @@
 /* Clear stack */
 extern void clear(environment *env)
 {
-  while(env->head!=NULL)
+  while(env->head->type != empty)
     toss(env);
 }
 
@@ -904,6 +1173,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;
     }
@@ -926,21 +1199,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));
@@ -958,7 +1230,9 @@
 
   int c;			/* getopt option character */
 
+#ifdef __linux__
   mtrace();
+#endif
 
   init_env(&myenv);
 
@@ -972,7 +1246,7 @@
 	break;
       case '?':
 	fprintf (stderr,
-		 "Unknown option character `\\x%x'.\n",
+		 "Unknown option character '\\x%x'.\n",
 		 optopt);
 	return EX_USAGE;
       default:
@@ -989,11 +1263,11 @@
   }
 
   if(myenv.interactive) {
-    printf("Stack version $Revision: 1.105 $\n\
+    printf("Stack version $Revision: 1.125 $\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) {
@@ -1001,24 +1275,26 @@
       if (myenv.interactive) {
 	if(myenv.err) {
 	  printf("(error %d)\n", myenv.err);
+	  myenv.err= 0;
 	}
-	nl();
+	nl(&myenv);
 	printstack(&myenv);
 	printf("> ");
       }
       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) {		/* EOF or other error */
+      myenv.err=0;
+      quit(&myenv);
+    } else if(myenv.head->type!=empty
 	      && CAR(myenv.head)->type==symb
-	      && CAR(myenv.head)->content.sym->id[0]
-	      ==';') {
-      toss(&myenv); 		/* No error check in main */
+	      && CAR(myenv.head)->content.sym->id[0] == ';') {
+      toss(&myenv); if(myenv.err) continue;
       eval(&myenv);
+    } else {
+      gc_maybe(&myenv);
     }
-    gc_maybe(&myenv);
   }
   quit(&myenv);
   return EXIT_FAILURE;
@@ -1033,7 +1309,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;
@@ -1048,6 +1324,7 @@
     toss(env); if(env->err) return;
     len= strlen(a_val->content.ptr)+strlen(b_val->content.ptr)+1;
     new_string= malloc(len);
+    assert(new_string != NULL);
     strcpy(new_string, b_val->content.ptr);
     strcat(new_string, a_val->content.ptr);
     push_cstring(env, new_string);
@@ -1111,7 +1388,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;
@@ -1171,7 +1448,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;
@@ -1254,9 +1531,7 @@
   if(old_value==NULL)
     return NULL;
 
-  protect(old_value);
   new_value= new_val(env);
-  protect(new_value);
   new_value->type= old_value->type;
 
   switch(old_value->type){
@@ -1264,6 +1539,8 @@
   case integer:
   case func:
   case symb:
+  case empty:
+  case port:
     new_value->content= old_value->content;
     break;
   case string:
@@ -1271,23 +1548,23 @@
       strdup((char *)(old_value->content.ptr));
     break;
   case tcons:
-    new_value= NULL;
 
-    new_value->content.c= malloc(sizeof(cons));
+    new_value->content.c= malloc(sizeof(pair));
+    assert(new_value->content.c!=NULL);
+    env->gc_count += sizeof(pair);
+
     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);
-
   return new_value;
 }
 
 /* "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;
@@ -1300,7 +1577,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;
@@ -1331,8 +1608,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;
@@ -1362,13 +1639,57 @@
   eval(env);
 }
 
+/* "else" */
+extern void sx_656c7365(environment *env)
+{
+  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;
+  }
+
+  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)
 {
   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;
@@ -1414,8 +1735,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;
@@ -1462,7 +1783,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;
@@ -1484,7 +1805,7 @@
 
   iterator= foo;
 
-  while(iterator!=NULL) {
+  while(iterator->type!=empty) {
     push_val(env, CAR(iterator));
     push_val(env, loop);
     eval(env); if(env->err) return;
@@ -1503,9 +1824,11 @@
 extern void to(environment *env)
 {
   int ending, start, i;
-  value *iterator, *temp;
+  value *iterator, *temp, *end;
+
+  end= new_val(env);
 
-  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;
@@ -1535,14 +1858,14 @@
 
   iterator= env->head;
 
-  if(iterator==NULL
+  if(iterator->type==empty
      || (CAR(iterator)->type==symb
 	 && CAR(iterator)->content.sym->id[0]=='[')) {
-    temp= NULL;
+    temp= end;
     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);
@@ -1550,9 +1873,9 @@
     /* Extract list */
     temp= env->head;
     env->head= CDR(iterator);
-    CDR(iterator)= NULL;
+    CDR(iterator)= end;
 
-    if(env->head!=NULL)
+    if(env->head->type!=empty)
       toss(env);
   }
 
@@ -1563,17 +1886,82 @@
 /* Read a string */
 extern void readline(environment *env)
 {
+  readlinestream(env, env->inputstream);
+}
+
+/* Read a string from a port */
+extern void readlineport(environment *env)
+{
+  FILE *stream;
+
+  if(env->head->type==empty) {
+    printerr("Too Few Arguments");
+    env->err= 1;
+    return;
+  }
+
+  if(CAR(env->head)->type!=port) {
+    printerr("Bad Argument Type");
+    env->err= 2;
+    return;
+  }
+
+  stream=CAR(env->head)->content.p;
+  readlinestream(env, stream); if(env->err) return;
+
+  swap(env); if(env->err) return;
+  toss(env);
+}
+
+/* read a line from a stream; used by readline */
+void readlinestream(environment *env, FILE *stream)
+{
   char in_string[101];
 
-  if(fgets(in_string, 100, env->inputstream)==NULL)
+  if(fgets(in_string, 100, stream)==NULL) {
     push_cstring(env, "");
-  else
+    if (! feof(stream)){
+      perror("readline");
+      env->err= 5;
+    }
+  } else {
     push_cstring(env, in_string);
+  }
 }
 
 /* "read"; Read a value and place on stack */
 extern void sx_72656164(environment *env)
 {
+  readstream(env, env->inputstream);
+}
+
+/* "readport"; Read a value from a port and place on stack */
+extern void readport(environment *env)
+{
+  FILE *stream;
+
+  if(env->head->type==empty) {
+    printerr("Too Few Arguments");
+    env->err= 1;
+    return;
+  }
+
+  if(CAR(env->head)->type!=port) {
+    printerr("Bad Argument Type");
+    env->err= 2;
+    return;
+  }
+
+  stream=CAR(env->head)->content.p;
+  readstream(env, stream); if(env->err) return;
+
+  swap(env); if(env->err) return;
+  toss(env);
+}
+
+/* read from a stream; used by "read" and "readport" */
+void readstream(environment *env, FILE *stream)
+{
   const char symbform[]= "%[a-zA-Z0-9!$%*+./:<=>?@^_~-]%n";
   const char strform[]= "\"%[^\"]\"%n";
   const char intform[]= "%i%n";
@@ -1587,7 +1975,7 @@
   int count= -1;
   float ftemp;
   static int depth= 0;
-  char *match, *ctemp;
+  char *match;
   size_t inlength;
 
   if(env->in_string==NULL) {
@@ -1602,6 +1990,7 @@
     }
     
     env->in_string= malloc(strlen(CAR(env->head)->content.ptr)+1);
+    assert(env->in_string != NULL);
     env->free_string= env->in_string; /* Save the original pointer */
     strcpy(env->in_string, CAR(env->head)->content.ptr);
     toss(env); if(env->err) return;
@@ -1609,6 +1998,7 @@
   
   inlength= strlen(env->in_string)+1;
   match= malloc(inlength);
+  assert(match != NULL);
 
   if(sscanf(env->in_string, blankform, &readlength) != EOF
      && readlength != -1) {
@@ -1621,6 +2011,9 @@
     } else {
       push_float(env, ftemp);
     }
+  } else if(sscanf(env->in_string, "\"\"%n", &readlength) != EOF
+	    && readlength != -1) {
+    push_cstring(env, "");
   } else if(sscanf(env->in_string, strform, match, &readlength) != EOF
 	    && readlength != -1) {
     push_cstring(env, match);
@@ -1652,11 +2045,12 @@
     return sx_72656164(env);
 }
 
+#ifdef __linux__
 extern void beep(environment *env)
 {
   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;
@@ -1694,13 +2088,14 @@
     abort();
   }
 }
+#endif /* __linux__ */
 
 /* "wait" */
 extern void sx_77616974(environment *env)
 {
   int dur;
 
-  if(env->head==NULL) {
+  if(env->head->type==empty) {
     printerr("Too Few Arguments");
     env->err= 1;
     return;
@@ -1720,7 +2115,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\
@@ -2009,7 +2404,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;
@@ -2069,7 +2464,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;
@@ -2128,7 +2523,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;
@@ -2154,7 +2549,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;
@@ -2174,3 +2569,257 @@
   printerr("Bad Argument Type");
   env->err= 2;
 }
+
+extern void setcar(environment *env)
+{
+  if(env->head->type==empty || CDR(env->head)->type==empty) {
+    printerr("Too Few Arguments");
+    env->err= 1;
+    return;
+  }
+
+  if(CDR(env->head)->type!=tcons) {
+    printerr("Bad Argument Type");
+    env->err= 2;
+    return;
+  }
+
+  CAR(CAR(CDR(env->head)))=CAR(env->head);
+  toss(env);
+}
+
+extern void setcdr(environment *env)
+{
+  if(env->head->type==empty || CDR(env->head)->type==empty) {
+    printerr("Too Few Arguments");
+    env->err= 1;
+    return;
+  }
+
+  if(CDR(env->head)->type!=tcons) {
+    printerr("Bad Argument Type");
+    env->err= 2;
+    return;
+  }
+
+  CDR(CAR(CDR(env->head)))=CAR(env->head);
+  toss(env);
+}
+
+extern void car(environment *env)
+{
+  if(env->head->type==empty) {
+    printerr("Too Few Arguments");
+    env->err= 1;
+    return;
+  }
+
+  if(CAR(env->head)->type!=tcons) {
+    printerr("Bad Argument Type");
+    env->err= 2;
+    return;
+  }
+
+  CAR(env->head)=CAR(CAR(env->head));
+}
+
+extern void cdr(environment *env)
+{
+  if(env->head->type==empty) {
+    printerr("Too Few Arguments");
+    env->err= 1;
+    return;
+  }
+
+  if(CAR(env->head)->type!=tcons) {
+    printerr("Bad Argument Type");
+    env->err= 2;
+    return;
+  }
+
+  CAR(env->head)=CDR(CAR(env->head));
+}
+
+extern void cons(environment *env)
+{
+  value *val;
+
+  if(env->head->type==empty || CDR(env->head)->type==empty) {
+    printerr("Too Few Arguments");
+    env->err= 1;
+    return;
+  }
+
+  val=new_val(env);
+  val->content.c= malloc(sizeof(pair));
+  assert(val->content.c!=NULL);
+
+  env->gc_count += sizeof(pair);
+  val->type=tcons;
+
+  CAR(val)= CAR(CDR(env->head));
+  CDR(val)= CAR(env->head);
+
+  push_val(env, val);
+
+  swap(env); if(env->err) return;
+  toss(env); if(env->err) return;
+  swap(env); if(env->err) return;
+  toss(env); if(env->err) return;
+}
+
+/*  2: 3                        =>                */
+/*  1: [ [ 1 . 2 ] [ 3 . 4 ] ]  =>  1: [ 3 . 4 ]  */
+extern void assq(environment *env)
+{
+  assocgen(env, eq);
+}
+
+
+/* General assoc function */
+void assocgen(environment *env, funcp eqfunc)
+{
+  value *key, *item;
+
+  /* Needs two values on the stack, the top one must be an association
+     list */
+  if(env->head->type==empty || CDR(env->head)->type==empty) {
+    printerr("Too Few Arguments");
+    env->err= 1;
+    return;
+  }
+
+  if(CAR(env->head)->type!=tcons) {
+    printerr("Bad Argument Type");
+    env->err= 2;
+    return;
+  }
+
+  key=CAR(CDR(env->head));
+  item=CAR(env->head);
+
+  while(item->type == tcons){
+    if(CAR(item)->type != tcons){
+      printerr("Bad Argument Type");
+      env->err= 2;
+      return;
+    }
+    push_val(env, key);
+    push_val(env, CAR(CAR(item)));
+    eqfunc(env); if(env->err) return;
+
+    /* Check the result of 'eqfunc' */
+    if(env->head->type==empty) {
+      printerr("Too Few Arguments");
+      env->err= 1;
+    return;
+    }
+    if(CAR(env->head)->type!=integer) {
+      printerr("Bad Argument Type");
+      env->err= 2;
+      return;
+    }
+
+    if(CAR(env->head)->content.i){
+      toss(env); if(env->err) return;
+      break;
+    }
+    toss(env); if(env->err) return;
+
+    if(item->type!=tcons) {
+      printerr("Bad Argument Type");
+      env->err= 2;
+      return;
+    }
+
+    item=CDR(item);
+  }
+
+  if(item->type == tcons){	/* A match was found */
+    push_val(env, CAR(item));
+  } else {
+    push_int(env, 0);
+  }
+  swap(env); if(env->err) return;
+  toss(env); if(env->err) return;
+  swap(env); if(env->err) return;
+  toss(env);
+}
+
+/* "do" */
+extern void sx_646f(environment *env)
+{
+  swap(env); if(env->err) return;
+  eval(env);
+}
+
+/* "open" */
+/* 2: "file"					*/
+/* 1: "r"	=>	1: #<port 0x47114711>	*/
+extern void sx_6f70656e(environment *env)
+{
+  value *new_port;
+  FILE *stream;
+
+  if(env->head->type == empty || CDR(env->head)->type == empty) {
+    printerr("Too Few Arguments");
+    env->err=1;
+    return;
+  }
+
+  if(CAR(env->head)->type != string
+     || CAR(CDR(env->head))->type != string) {
+    printerr("Bad Argument Type");
+    env->err= 2;
+    return;
+  }
+
+  stream=fopen(CAR(CDR(env->head))->content.ptr,
+	       CAR(env->head)->content.ptr);
+
+  if(stream == NULL) {
+    perror("open");
+    env->err= 5;
+    return;
+  }
+
+  new_port=new_val(env);
+  new_port->type=port;
+  new_port->content.p=stream;
+
+  push_val(env, new_port);
+
+  swap(env); if(env->err) return;
+  toss(env); if(env->err) return;
+  swap(env); if(env->err) return;
+  toss(env);
+}
+
+
+/* "close" */
+extern void sx_636c6f7365(environment *env)
+{
+  int ret;
+
+  if(env->head->type == empty) {
+    printerr("Too Few Arguments");
+    env->err=1;
+    return;
+  }
+
+  if(CAR(env->head)->type != port) {
+    printerr("Bad Argument Type");
+    env->err= 2;
+    return;
+  }
+
+  ret= fclose(CAR(env->head)->content.p);
+
+  if(ret != 0){
+    perror("close");
+    env->err= 5;
+    return;
+  }
+
+  toss(env);
+}