--- stack/stack.c	2002/03/12 14:53:19	1.105
+++ stack/stack.c	2002/03/27 14:49:56	1.122
@@ -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,64 @@
   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 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 +263,7 @@
   env->gc_ref= new_head;
 
   if(env->interactive)
-    printf("done\n");
+    printf("done (%d bytes still allocated)\n", env->gc_count);
 
 }
 
@@ -254,7 +300,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 +338,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 +353,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 +371,7 @@
 {
   char *new_string;
 
-  if(env->head==NULL) {
+  if(env->head->type==empty) {
     printerr("Too Few Arguments");
     env->err= 1;
     return;
@@ -373,9 +423,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 */
@@ -418,17 +470,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;
@@ -445,55 +496,107 @@
     push_sym(env, "function");
     break;
   case tcons:
-    push_sym(env, "list");
+    push_sym(env, "pair");
     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(value *val, int noquote, stackitem *stack)
 {
-  switch(CAR(stack_head)->type) {
+  stackitem *titem, *tstack;
+  int depth;
+
+  switch(val->type) {
+  case empty:
+    printf("[]");
+    break;
   case integer:
-    printf("%d", CAR(stack_head)->content.i);
+    printf("%d", val->content.i);
     break;
   case tfloat:
-    printf("%f", CAR(stack_head)->content.f);
+    printf("%f", val->content.f);
     break;
   case string:
     if(noquote)
-      printf("%s", (char*)CAR(stack_head)->content.ptr);
+      printf("%s", (char*)(val->content.ptr));
     else
-      printf("\"%s\"", (char*)CAR(stack_head)->content.ptr);
+      printf("\"%s\"", (char*)(val->content.ptr));
     break;
   case symb:
-    printf("%s", CAR(stack_head)->content.sym->id);
+    printf("%s", val->content.sym->id);
     break;
   case func:
-    printf("#<function %p>", (funcp)(CAR(stack_head)->content.ptr));
+    printf("#<function %p>", (funcp)(val->content.ptr));
     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);
+    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, */
+	printf("#%d#", depth);	/* print a depth reference */
+      } else {
+	print_val(CAR(val), noquote, tstack);
+      }
+      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, */
+	  printf(" . #%d#", depth); /* print a depth reference */
+	} else {
+	  printf(" ");
+	}
+	break;
+      default:
+	printf(" . ");		/* Improper list */
+	print_val(val, noquote, tstack);
+      }
+    } while(val->type == tcons && titem == NULL);
+    titem=tstack;
+    while(titem != stack){
+      tstack=titem->next;
+      free(titem);
+      titem=tstack;
     }
-    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;
   }
-  print_h(env->head, 0);
+  print_val(CAR(env->head), 0, NULL);
   nl();
 }
 
@@ -507,12 +610,12 @@
 
 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(CAR(env->head), 1, NULL);
 }
 
 /* Prints the top element of the stack and then discards it. */
@@ -526,17 +629,17 @@
 /* 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);
+  print_val(CAR(stack_head), 0, NULL);
   nl();
 }
 
 /* Prints the stack. */
 extern void printstack(environment *env)
 {
-  if(env->head == NULL) {
+  if(env->head->type == empty) {
     printf("Stack Empty\n");
     return;
   }
@@ -549,7 +652,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 +668,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 +685,7 @@
 {
   value *val;
 
-  if(env->head==NULL) {
+  if(env->head->type==empty) {
     printerr("Too Few Arguments");
     env->err= 1;
     return;
@@ -600,11 +703,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 +723,7 @@
 
   gc_maybe(env);
 
-  if(env->head==NULL) {
+  if(env->head->type==empty) {
     printerr("Too Few Arguments");
     env->err= 1;
     return;
@@ -651,7 +754,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 +762,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 +779,10 @@
     unprotect(temp_val);
     return;
 
-  default:
+  case empty:
+  case integer:
+  case tfloat:
+  case string:
     return;
   }
 }
@@ -686,12 +792,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 +808,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 +821,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 +841,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 +859,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 +882,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 +903,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 +921,7 @@
 {
   int val;
 
-  if(env->head==NULL) {
+  if(env->head->type==empty) {
     printerr("Too Few Arguments");
     env->err= 1;
     return;
@@ -841,7 +952,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 +991,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 +1006,7 @@
 /* Clear stack */
 extern void clear(environment *env)
 {
-  while(env->head!=NULL)
+  while(env->head->type != empty)
     toss(env);
 }
 
@@ -904,6 +1019,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 +1045,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 +1076,9 @@
 
   int c;			/* getopt option character */
 
+#ifdef __linux__
   mtrace();
+#endif
 
   init_env(&myenv);
 
@@ -972,7 +1092,7 @@
 	break;
       case '?':
 	fprintf (stderr,
-		 "Unknown option character `\\x%x'.\n",
+		 "Unknown option character '\\x%x'.\n",
 		 optopt);
 	return EX_USAGE;
       default:
@@ -989,11 +1109,11 @@
   }
 
   if(myenv.interactive) {
-    printf("Stack version $Revision: 1.105 $\n\
+    printf("Stack version $Revision: 1.122 $\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,10 +1128,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]
 	      ==';') {
@@ -1033,7 +1154,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 +1169,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 +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;
@@ -1171,7 +1293,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;
@@ -1256,7 +1378,6 @@
 
   protect(old_value);
   new_value= new_val(env);
-  protect(new_value);
   new_value->type= old_value->type;
 
   switch(old_value->type){
@@ -1264,6 +1385,7 @@
   case integer:
   case func:
   case symb:
+  case empty:
     new_value->content= old_value->content;
     break;
   case string:
@@ -1271,15 +1393,17 @@
       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);
+  unprotect(old_value);
 
   return new_value;
 }
@@ -1287,7 +1411,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;
@@ -1300,7 +1424,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 +1455,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 +1486,56 @@
   eval(env);
 }
 
+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 +1581,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 +1629,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 +1651,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 +1670,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 +1704,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 +1719,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);
   }
 
@@ -1587,7 +1756,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 +1771,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 +1779,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 +1792,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 +1826,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 +1869,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 +1896,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 +2185,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 +2245,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 +2304,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 +2330,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 +2350,179 @@
   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);
+}