--- stack/stack.c	2002/03/20 05:29:29	1.117
+++ stack/stack.c	2002/03/21 03:19:32	1.120
@@ -123,6 +123,9 @@
   value *nval= malloc(sizeof(value));
   stackitem *nitem= malloc(sizeof(stackitem));
 
+  assert(nval != NULL);
+  assert(nitem != NULL);
+
   nval->content.ptr= NULL;
   nval->type= empty;
 
@@ -335,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;
@@ -349,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'){
@@ -418,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 */
@@ -530,6 +537,7 @@
     tstack= stack;
     do {
       titem=malloc(sizeof(stackitem));
+      assert(titem != NULL);
       titem->item=val;
       titem->next=tstack;
       tstack=titem;		/* Put it on the stack */
@@ -1101,7 +1109,7 @@
   }
 
   if(myenv.interactive) {
-    printf("Stack version $Revision: 1.117 $\n\
+    printf("Stack version $Revision: 1.120 $\n\
 Copyright (C) 2002  Mats Alritzson and Teddy Hogeborn\n\
 Stack comes with ABSOLUTELY NO WARRANTY; for details type 'warranty;'.\n\
 This is free software, and you are welcome to redistribute it\n\
@@ -1161,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);
@@ -1760,6 +1769,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;
@@ -1767,6 +1777,7 @@
   
   inlength= strlen(env->in_string)+1;
   match= malloc(inlength);
+  assert(match != NULL);
 
   if(sscanf(env->in_string, blankform, &readlength) != EOF
      && readlength != -1) {
@@ -2435,3 +2446,81 @@
   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);
+}