--- stack/symbols.c	2003/08/04 11:23:43	1.1
+++ stack/symbols.c	2004/02/19 15:35:38	1.11
@@ -1,5 +1,27 @@
-#include <stdio.h>
+/*
+    stack - an interactive interpreter for a stack-based language
+    Copyright (C) 2002	Mats Alritzson and Teddy Hogeborn
+
+    This program is free software; you can redistribute it and/or modify
+    it under the terms of the GNU General Public License as published by
+    the Free Software Foundation; either version 2 of the License, or
+    (at your option) any later version.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+    GNU General Public License for more details.
+
+    You should have received a copy of the GNU General Public License
+    along with this program; if not, write to the Free Software
+    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+    Authors: Mats Alritzson <masse@fukt.bth.se>
+	     Teddy Hogeborn <teddy@fukt.bth.se>
+*/
+
 #include "stack.h"
+#include "messages.h"
 
 /* Print newline. */
 extern void nl(environment *env)
@@ -10,39 +32,31 @@
 /* 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(check_args(env, 1, port))
+    return printerr(env);
 
-  if(fprintf(CAR(env->head)->content.p, "\n") < 0){
-    perror("nl");
+  if(fprintf(CAR(env->head)->content.p, "\n") < 0) {
     env->err= 5;
-    return;
+    return printerr(env);
   }
+
   toss(env);
 }
 
 /* Gets the type of a value */
 extern void type(environment *env)
 {
-  if(env->head->type==empty) {
-    printerr("Too Few Arguments");
-    env->err= 1;
-    return;
-  }
+
+  if(check_args(env, 1, unknown))
+    return printerr(env);
 
   switch(CAR(env->head)->type){
   case empty:
     push_sym(env, "empty");
     break;
+  case unknown:
+    push_sym(env, "unknown");
+    break;
   case integer:
     push_sym(env, "integer");
     break;
@@ -73,11 +87,10 @@
 /* Print the top element of the stack but don't discard it */
 extern void print_(environment *env)
 {
-  if(env->head->type==empty) {
-    printerr("Too Few Arguments");
-    env->err= 1;
-    return;
-  }
+
+  if(check_args(env, 1, unknown))
+    return printerr(env);
+
   print_val(env, CAR(env->head), 0, NULL, stdout);
   if(env->err) return;
   nl(env);
@@ -95,11 +108,10 @@
    discard it. */
 extern void princ_(environment *env)
 {
-  if(env->head->type==empty) {
-    printerr("Too Few Arguments");
-    env->err= 1;
-    return;
-  }
+
+  if(check_args(env, 1, unknown))
+    return printerr(env);
+
   print_val(env, CAR(env->head), 1, NULL, stdout);
 }
 
@@ -114,17 +126,9 @@
 /* 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;
-  }
+  if(check_args(env, 2, port, unknown))
+    return printerr(env);
 
   print_val(env, CAR(CDR(env->head)), 0, NULL, CAR(env->head)->content.p);
   if(env->err) return;
@@ -142,17 +146,9 @@
 /* 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;
-  }
+  if(check_args(env, 2, port, unknown))
+    return printerr(env);
 
   print_val(env, CAR(CDR(env->head)), 1, NULL, CAR(env->head)->content.p);
   toss(env); if(env->err) return;
@@ -170,13 +166,9 @@
 extern void rot(environment *env)
 {
   value *temp= env->head;
-  
-  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(check_args(env, 3, unknown, unknown, unknown))
+    return printerr(env);
   
   env->head= CDR(CDR(env->head));
   CDR(CDR(temp))= CDR(env->head);
@@ -188,18 +180,8 @@
 {
   value *temp, *new_head;
 
-  /* Is top element a list? */
-  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;
-  }
+  if(check_args(env, 1, tcons))
+    return printerr(env);
 
   rev(env);
 
@@ -211,14 +193,14 @@
 
   toss(env);
 
+  /// XXX
   /* Find the end of the list */
   while(CDR(temp)->type != empty) {
     if (CDR(temp)->type == tcons)
       temp= CDR(temp);
     else {
-      printerr("Bad Argument Type"); /* Improper list */
-      env->err= 2;
-      return;
+      env->err= 2; /* Improper list */
+      return printerr(env); 
     }
   }
 
@@ -233,11 +215,8 @@
 {
   void *left, *right;
 
-  if(env->head->type==empty || CDR(env->head)->type==empty) {
-    printerr("Too Few Arguments");
-    env->err= 1;
-    return;
-  }
+  if(check_args(env, 2, unknown, unknown))
+    return printerr(env);
 
   left= CAR(env->head)->content.ptr;
   right= CAR(CDR(env->head))->content.ptr;
@@ -251,17 +230,8 @@
 {
   int val;
 
-  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(check_args(env, 1, integer))
+    return printerr(env);
 
   val= CAR(env->head)->content.i;
   toss(env);
@@ -281,20 +251,11 @@
   symbol *sym;
 
   /* Needs two values on the stack, the top one must be a symbol */
-  if(env->head->type==empty || CDR(env->head)->type==empty) {
-    printerr("Too Few Arguments");
-    env->err= 1;
-    return;
-  }
-
-  if(CAR(env->head)->type!=symb) {
-    printerr("Bad Argument Type");
-    env->err= 2;
-    return;
-  }
+  if(check_args(env, 2, symb, unknown))
+    return printerr(env);
 
   /* long names are a pain */
-  sym= CAR(env->head)->content.ptr;
+  sym= CAR(env->head)->content.sym;
 
   /* Bind the symbol to the value */
   sym->val= CAR(CDR(env->head));
@@ -305,8 +266,7 @@
 /* Clear stack */
 extern void clear(environment *env)
 {
-  while(env->head->type != empty)
-    toss(env);
+  env->head= new_val(env);
 }
 
 /* Forgets a symbol (remove it from the hash table) */
@@ -314,17 +274,8 @@
 {
   char* sym_id;
 
-  if(env->head->type==empty) {
-    printerr("Too Few Arguments");
-    env->err= 1;
-    return;
-  }
-  
-  if(CAR(env->head)->type!=symb) {
-    printerr("Bad Argument Type");
-    env->err= 2;
-    return;
-  }
+  if(check_args(env, 1, symb))
+    return printerr(env);
 
   sym_id= CAR(env->head)->content.sym->id;
   toss(env);
@@ -347,24 +298,17 @@
   char* new_string;
   value *a_val, *b_val;
 
-  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) {
+  if(check_args(env, 2, string, string)==0) {
     a_val= CAR(env->head);
     b_val= CAR(CDR(env->head));
     protect(a_val); protect(b_val);
     toss(env); if(env->err) return;
     toss(env); if(env->err) return;
-    len= strlen(a_val->content.ptr)+strlen(b_val->content.ptr)+1;
+    len= strlen(a_val->content.string)+strlen(b_val->content.string)+1;
     new_string= malloc(len);
     assert(new_string != NULL);
-    strcpy(new_string, b_val->content.ptr);
-    strcat(new_string, a_val->content.ptr);
+    strcpy(new_string, b_val->content.string);
+    strcat(new_string, a_val->content.string);
     push_cstring(env, new_string);
     unprotect(a_val); unprotect(b_val);
     free(new_string);
@@ -372,8 +316,7 @@
     return;
   }
   
-  if(CAR(env->head)->type==integer
-     && CAR(CDR(env->head))->type==integer) {
+  if(check_args(env, 2, integer, integer)==0) {
     a= CAR(env->head)->content.i;
     toss(env); if(env->err) return;
     b= CAR(env->head)->content.i;
@@ -383,8 +326,7 @@
     return;
   }
 
-  if(CAR(env->head)->type==tfloat
-     && CAR(CDR(env->head))->type==tfloat) {
+  if(check_args(env, 2, tfloat, tfloat)==0) {
     fa= CAR(env->head)->content.f;
     toss(env); if(env->err) return;
     fb= CAR(env->head)->content.f;
@@ -394,8 +336,7 @@
     return;
   }
 
-  if(CAR(env->head)->type==tfloat
-     && CAR(CDR(env->head))->type==integer) {
+  if(check_args(env, 2, tfloat, integer)==0) {
     fa= CAR(env->head)->content.f;
     toss(env); if(env->err) return;
     b= CAR(env->head)->content.i;
@@ -405,8 +346,7 @@
     return;
   }
 
-  if(CAR(env->head)->type==integer
-     && CAR(CDR(env->head))->type==tfloat) {
+  if(check_args(env, 2, integer, tfloat)==0) {
     a= CAR(env->head)->content.i;
     toss(env); if(env->err) return;
     fb= CAR(env->head)->content.f;
@@ -416,8 +356,7 @@
     return;
   }
 
-  printerr("Bad Argument Type");
-  env->err=2;
+  return printerr(env);
 }
 
 /* "-" */
@@ -426,14 +365,7 @@
   int a, b;
   float fa, fb;
 
-  if(env->head->type==empty || CDR(env->head)->type==empty) {
-    printerr("Too Few Arguments");
-    env->err=1;
-    return;
-  }
-  
-  if(CAR(env->head)->type==integer
-     && CAR(CDR(env->head))->type==integer) {
+  if(check_args(env, 2, integer, integer)==0) {
     a= CAR(env->head)->content.i;
     toss(env); if(env->err) return;
     b= CAR(env->head)->content.i;
@@ -443,8 +375,7 @@
     return;
   }
 
-  if(CAR(env->head)->type==tfloat
-     && CAR(CDR(env->head))->type==tfloat) {
+  if(check_args(env, 2, tfloat, tfloat)==0) {
     fa= CAR(env->head)->content.f;
     toss(env); if(env->err) return;
     fb= CAR(env->head)->content.f;
@@ -454,8 +385,7 @@
     return;
   }
 
-  if(CAR(env->head)->type==tfloat
-     && CAR(CDR(env->head))->type==integer) {
+  if(check_args(env, 2, tfloat, integer)==0) {
     fa= CAR(env->head)->content.f;
     toss(env); if(env->err) return;
     b= CAR(env->head)->content.i;
@@ -465,8 +395,7 @@
     return;
   }
 
-  if(CAR(env->head)->type==integer
-     && CAR(CDR(env->head))->type==tfloat) {
+  if(check_args(env, 2, integer, tfloat)==0) {
     a= CAR(env->head)->content.i;
     toss(env); if(env->err) return;
     fb= CAR(env->head)->content.f;
@@ -476,8 +405,7 @@
     return;
   }
 
-  printerr("Bad Argument Type");
-  env->err=2;
+  return printerr(env);
 }
 
 /* ">" */
@@ -486,14 +414,7 @@
   int a, b;
   float fa, fb;
 
-  if(env->head->type==empty || CDR(env->head)->type==empty) {
-    printerr("Too Few Arguments");
-    env->err= 1;
-    return;
-  }
-  
-  if(CAR(env->head)->type==integer
-     && CAR(CDR(env->head))->type==integer) {
+  if(check_args(env, 2, integer, integer)==0) {
     a= CAR(env->head)->content.i;
     toss(env); if(env->err) return;
     b= CAR(env->head)->content.i;
@@ -503,8 +424,7 @@
     return;
   }
 
-  if(CAR(env->head)->type==tfloat
-     && CAR(CDR(env->head))->type==tfloat) {
+  if(check_args(env, 2, tfloat, tfloat)==0) {
     fa= CAR(env->head)->content.f;
     toss(env); if(env->err) return;
     fb= CAR(env->head)->content.f;
@@ -514,8 +434,7 @@
     return;
   }
 
-  if(CAR(env->head)->type==tfloat
-     && CAR(CDR(env->head))->type==integer) {
+  if(check_args(env, 2, tfloat, integer)==0) {
     fa= CAR(env->head)->content.f;
     toss(env); if(env->err) return;
     b= CAR(env->head)->content.i;
@@ -525,8 +444,7 @@
     return;
   }
 
-  if(CAR(env->head)->type==integer
-     && CAR(CDR(env->head))->type==tfloat) {
+  if(check_args(env, 2, integer, tfloat)==0) {
     a= CAR(env->head)->content.i;
     toss(env); if(env->err) return;
     fb= CAR(env->head)->content.f;
@@ -536,8 +454,7 @@
     return;
   }
 
-  printerr("Bad Argument Type");
-  env->err= 2;
+  return printerr(env);
 }
 
 /* "<" */
@@ -564,11 +481,9 @@
 /* "dup"; duplicates an item on the stack */
 extern void sx_647570(environment *env)
 {
-  if(env->head->type==empty) {
-    printerr("Too Few Arguments");
-    env->err= 1;
-    return;
-  }
+  if(check_args(env, 1, unknown))
+    return printerr(env);
+
   push_val(env, copy_val(env, CAR(env->head)));
 }
 
@@ -577,18 +492,9 @@
 {
   int truth;
 
-  if(env->head->type==empty || CDR(env->head)->type==empty) {
-    printerr("Too Few Arguments");
-    env->err= 1;
-    return;
-  }
+  if(check_args(env, 2, unknown, integer))
+    return printerr(env);
 
-  if(CAR(CDR(env->head))->type != integer) {
-    printerr("Bad Argument Type");
-    env->err= 2;
-    return;
-  }
-  
   swap(env);
   if(env->err) return;
   
@@ -608,19 +514,9 @@
 {
   int truth;
 
-  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(check_args(env, 3, unknown, unknown, integer))
+    return printerr(env);
 
-  if(CAR(CDR(CDR(env->head)))->type!=integer) {
-    printerr("Bad Argument Type");
-    env->err= 2;
-    return;
-  }
-  
   rot(env);
   if(env->err) return;
   
@@ -642,21 +538,18 @@
 /* "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(check_args(env, 5, unknown, symb, unknown, symb, integer))
+    return printerr(env);
+
+  /// XXX
 
   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;
+    return printerr(env);
   }
 
   swap(env); toss(env); rot(env); toss(env);
@@ -665,18 +558,16 @@
 
 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(check_args(env, 3, unknown, symb, integer))
+    return printerr(env);
+
+  /// XXX
 
   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;
+    return printerr(env);
   }
 
   swap(env); toss(env);
@@ -689,11 +580,8 @@
   int truth;
   value *loop, *test;
 
-  if(env->head->type==empty || CDR(env->head)->type==empty) {
-    printerr("Too Few Arguments");
-    env->err= 1;
-    return;
-  }
+  if(check_args(env, 2, unknown, integer))
+    return printerr(env);
 
   loop= CAR(env->head);
   protect(loop);
@@ -706,11 +594,12 @@
   do {
     push_val(env, test);
     eval(env);
+
+    /// XXX
     
     if(CAR(env->head)->type != integer) {
-      printerr("Bad Argument Type");
       env->err= 2;
-      return;
+      return printerr(env);
     }
     
     truth= CAR(env->head)->content.i;
@@ -735,19 +624,8 @@
   value *loop;
   int foo1, foo2;
 
-  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!=integer
-     || CAR(CDR(CDR(env->head)))->type!=integer) {
-    printerr("Bad Argument Type");
-    env->err= 2;
-    return;
-  }
+  if(check_args(env, 3, unknown, integer, integer))
+    return printerr(env);
 
   loop= CAR(env->head);
   protect(loop);
@@ -783,19 +661,10 @@
 {  
   value *loop, *foo;
   value *iterator;
-  
-  if(env->head->type==empty || CDR(env->head)->type==empty) {
-    printerr("Too Few Arguments");
-    env->err= 1;
-    return;
-  }
-
-  if(CAR(CDR(env->head))->type!=tcons) {
-    printerr("Bad Argument Type");
-    env->err= 2;
-    return;
-  }
 
+  if(check_args(env, 2, unknown, tcons))
+    return printerr(env);
+  
   loop= CAR(env->head);
   protect(loop);
   toss(env); if(env->err) return;
@@ -810,15 +679,18 @@
     push_val(env, CAR(iterator));
     push_val(env, loop);
     eval(env); if(env->err) return;
+
+    /// XXX
     if (iterator->type == tcons){
       iterator= CDR(iterator);
     } else {
-      printerr("Bad Argument Type"); /* Improper list */
-      env->err= 2;
+      env->err= 2; /* Improper list */
       break;
     }
   }
   unprotect(loop); unprotect(foo);
+  
+  return printerr(env);
 }
 
 /* "to" */
@@ -827,20 +699,10 @@
   int ending, start, i;
   value *iterator, *temp, *end;
 
-  end= new_val(env);
+  if(check_args(env, 2, integer, integer))
+    return printerr(env);
 
-  if(env->head->type==empty || CDR(env->head)->type==empty) {
-    printerr("Too Few Arguments");
-    env->err= 1;
-    return;
-  }
-
-  if(CAR(env->head)->type!=integer 
-     || CAR(CDR(env->head))->type!=integer) {
-    printerr("Bad Argument Type");
-    env->err= 2;
-    return;
-  }
+  end= new_val(env);
 
   ending= CAR(env->head)->content.i;
   toss(env); if(env->err) return;
@@ -895,17 +757,8 @@
 {
   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;
-  }
+  if(check_args(env, 1, port))
+    return printerr(env);
 
   stream=CAR(env->head)->content.p;
   readlinestream(env, stream); if(env->err) return;
@@ -925,17 +778,8 @@
 {
   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;
-  }
+  if(check_args(env, 1, port))
+    return printerr(env);
 
   stream=CAR(env->head)->content.p;
   readstream(env, stream); if(env->err) return;
@@ -949,18 +793,8 @@
 {
   int freq, dur, period, ticks;
 
-  if(env->head->type==empty || CDR(env->head)->type==empty) {
-    printerr("Too Few Arguments");
-    env->err= 1;
-    return;
-  }
-
-  if(CAR(env->head)->type!=integer
-     || CAR(CDR(env->head))->type!=integer) {
-    printerr("Bad Argument Type");
-    env->err= 2;
-    return;
-  }
+  if(check_args(env, 2, integer, integer))
+    return printerr(env);
 
   dur= CAR(env->head)->content.i;
   toss(env);
@@ -980,9 +814,8 @@
     usleep(dur);
     return;
   case -1:
-    perror("beep");
     env->err= 5;
-    return;
+    return printerr(env);
   default:
     abort();
   }
@@ -994,17 +827,8 @@
 {
   int dur;
 
-  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(check_args(env, 1, integer))
+    return printerr(env);
 
   dur= CAR(env->head)->content.i;
   toss(env);
@@ -1012,20 +836,14 @@
   usleep(dur);
 }
 
+
 /* "*" */
 extern void sx_2a(environment *env)
 {
   int a, b;
   float fa, fb;
 
-  if(env->head->type==empty || CDR(env->head)->type==empty) {
-    printerr("Too Few Arguments");
-    env->err= 1;
-    return;
-  }
-  
-  if(CAR(env->head)->type==integer
-     && CAR(CDR(env->head))->type==integer) {
+  if(check_args(env, 2, integer, integer)==0) {
     a= CAR(env->head)->content.i;
     toss(env); if(env->err) return;
     b= CAR(env->head)->content.i;
@@ -1035,8 +853,7 @@
     return;
   }
 
-  if(CAR(env->head)->type==tfloat
-     && CAR(CDR(env->head))->type==tfloat) {
+  if(check_args(env, 2, tfloat, tfloat)==0) {
     fa= CAR(env->head)->content.f;
     toss(env); if(env->err) return;
     fb= CAR(env->head)->content.f;
@@ -1046,8 +863,7 @@
     return;
   }
 
-  if(CAR(env->head)->type==tfloat
-     && CAR(CDR(env->head))->type==integer) {
+  if(check_args(env, 2, tfloat, integer)==0) {
     fa= CAR(env->head)->content.f;
     toss(env); if(env->err) return;
     b= CAR(env->head)->content.i;
@@ -1057,8 +873,7 @@
     return;
   }
 
-  if(CAR(env->head)->type==integer
-     && CAR(CDR(env->head))->type==tfloat) {
+  if(check_args(env, 2, integer, tfloat)==0) {
     a= CAR(env->head)->content.i;
     toss(env); if(env->err) return;
     fb= CAR(env->head)->content.f;
@@ -1068,8 +883,7 @@
     return;
   }
 
-  printerr("Bad Argument Type");
-  env->err= 2;
+  return printerr(env);
 }
 
 /* "/" */
@@ -1078,14 +892,7 @@
   int a, b;
   float fa, fb;
 
-  if(env->head->type==empty || CDR(env->head)->type==empty) {
-    printerr("Too Few Arguments");
-    env->err= 1;
-    return;
-  }
-  
-  if(CAR(env->head)->type==integer
-     && CAR(CDR(env->head))->type==integer) {
+  if(check_args(env, 2, integer, integer)==0) {
     a= CAR(env->head)->content.i;
     toss(env); if(env->err) return;
     b= CAR(env->head)->content.i;
@@ -1095,8 +902,7 @@
     return;
   }
 
-  if(CAR(env->head)->type==tfloat
-     && CAR(CDR(env->head))->type==tfloat) {
+  if(check_args(env, 2, tfloat, tfloat)==0) {
     fa= CAR(env->head)->content.f;
     toss(env); if(env->err) return;
     fb= CAR(env->head)->content.f;
@@ -1106,8 +912,7 @@
     return;
   }
 
-  if(CAR(env->head)->type==tfloat
-     && CAR(CDR(env->head))->type==integer) {
+  if(check_args(env, 2, tfloat, integer)==0) {
     fa= CAR(env->head)->content.f;
     toss(env); if(env->err) return;
     b= CAR(env->head)->content.i;
@@ -1117,8 +922,7 @@
     return;
   }
 
-  if(CAR(env->head)->type==integer
-     && CAR(CDR(env->head))->type==tfloat) {
+  if(check_args(env, 2, integer, tfloat)==0) {
     a= CAR(env->head)->content.i;
     toss(env); if(env->err) return;
     fb= CAR(env->head)->content.f;
@@ -1128,8 +932,7 @@
     return;
   }
 
-  printerr("Bad Argument Type");
-  env->err= 2;
+  return printerr(env);
 }
 
 /* "mod" */
@@ -1137,14 +940,7 @@
 {
   int a, b;
 
-  if(env->head->type==empty || CDR(env->head)->type==empty) {
-    printerr("Too Few Arguments");
-    env->err= 1;
-    return;
-  }
-  
-  if(CAR(env->head)->type==integer
-     && CAR(CDR(env->head))->type==integer) {
+  if(check_args(env, 2, integer, integer)==0) {
     a= CAR(env->head)->content.i;
     toss(env); if(env->err) return;
     b= CAR(env->head)->content.i;
@@ -1154,49 +950,31 @@
     return;
   }
 
-  printerr("Bad Argument Type");
-  env->err= 2;
+  return printerr(env);
 }
 
+
 /* "div" */
 extern void sx_646976(environment *env)
 {
   int a, b;
-  
-  if(env->head->type==empty || CDR(env->head)->type==empty) {
-    printerr("Too Few Arguments");
-    env->err= 1;
-    return;
-  }
-
-  if(CAR(env->head)->type==integer
-     && CAR(CDR(env->head))->type==integer) {
-    a= CAR(env->head)->content.i;
-    toss(env); if(env->err) return;
-    b= CAR(env->head)->content.i;
-    toss(env); if(env->err) return;
-    push_int(env, (int)b/a);
-
-    return;
-  }
 
-  printerr("Bad Argument Type");
-  env->err= 2;
+  if(check_args(env, 2, integer, integer))
+    return printerr(env);
+  
+  a= CAR(env->head)->content.i;
+  toss(env); if(env->err) return;
+  b= CAR(env->head)->content.i;
+  toss(env); if(env->err) return;
+  push_int(env, (int)b/a);
 }
 
+
 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;
-  }
+  if(check_args(env, 2, tcons, unknown))
+    return printerr(env);
 
   CAR(CAR(CDR(env->head)))=CAR(env->head);
   toss(env);
@@ -1204,17 +982,9 @@
 
 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;
-  }
+  if(check_args(env, 2, tcons, unknown))
+    return printerr(env);
 
   CDR(CAR(CDR(env->head)))=CAR(env->head);
   toss(env);
@@ -1222,34 +992,18 @@
 
 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;
-  }
+  if(check_args(env, 1, tcons))
+    return printerr(env);
 
   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;
-  }
+  if(check_args(env, 1, tcons))
+    return printerr(env);
 
   CAR(env->head)=CDR(CAR(env->head));
 }
@@ -1258,11 +1012,8 @@
 {
   value *val;
 
-  if(env->head->type==empty || CDR(env->head)->type==empty) {
-    printerr("Too Few Arguments");
-    env->err= 1;
-    return;
-  }
+  if(check_args(env, 2, unknown, unknown))
+    return printerr(env);
 
   val=new_val(env);
   val->content.c= malloc(sizeof(pair));
@@ -1279,14 +1030,68 @@
   swap(env); if(env->err) return;
   toss(env); if(env->err) return;
   swap(env); if(env->err) return;
+  toss(env);
+}
+
+
+/* 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(check_args(env, 2, tcons, unknown))
+    return printerr(env);
+
+  key=CAR(CDR(env->head));
+  item=CAR(env->head);
+
+  while(item->type == tcons){
+    if(CAR(item)->type != tcons){
+      env->err= 2;
+      return printerr(env);
+    }
+
+    push_val(env, key);
+    push_val(env, CAR(CAR(item)));
+    eqfunc((void*)env); if(env->err) return;
+
+    /* Check the result of 'eqfunc' */
+    if(check_args(env, 1, integer))
+      return printerr(env);
+
+    if(CAR(env->head)->content.i){
+      toss(env); if(env->err) return;
+      break;
+    }
+    toss(env); if(env->err) return;
+
+    if(item->type!=tcons) {
+      env->err= 2;
+      return printerr(env);
+    }
+
+    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);
 }
 
+
 /*  2: 3                        =>                */
 /*  1: [ [ 1 . 2 ] [ 3 . 4 ] ]  =>  1: [ 3 . 4 ]  */
 extern void assq(environment *env)
 {
-  assocgen(env, eq);
+  assocgen(env, (void*)eq);
 }
 
 
@@ -1305,26 +1110,15 @@
   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;
-  }
+  if(check_args(env, 2, string, string))
+    return printerr(env);
 
   stream=fopen(CAR(CDR(env->head))->content.ptr,
 	       CAR(env->head)->content.ptr);
 
   if(stream == NULL) {
-    perror("open");
     env->err= 5;
-    return;
+    return printerr(env);
   }
 
   new_port=new_val(env);
@@ -1345,25 +1139,258 @@
 {
   int ret;
 
+  if(check_args(env, 1, port))
+    return printerr(env);
+
+  ret= fclose(CAR(env->head)->content.p);
+
+  if(ret != 0){
+    env->err= 5;
+    return printerr(env);
+  }
+
+  toss(env);
+}
+
+
+extern void mangle(environment *env)
+{
+  char *new_string;
+
+  if(check_args(env, 1, string))
+    return printerr(env);
+
+  new_string= mangle_str(CAR(env->head)->content.string);
+
+  toss(env);
+  if(env->err) return;
+
+  push_cstring(env, new_string);
+}
+
+/* "fork" */
+extern void sx_666f726b(environment *env)
+{
+  push_int(env, fork());
+}
+
+/* "waitpid" */
+extern void sx_77616974706964(environment *env)
+{
+
+  if(check_args(env, 1, integer))
+    return printerr(env);
+
+  push_int(env, waitpid(CAR(env->head)->content.i, NULL, 0));
+  swap(env); toss(env);
+}
+
+
+/* Discard the top element of the stack. */
+extern void toss(environment *env)
+{
+
+  if(check_args(env, 1, unknown))
+    return printerr(env);
+
+  env->head= CDR(env->head); /* Remove the top stack item */
+}
+
+
+/* Quit stack. */
+extern void quit(environment *env)
+{
+  int i;
+
+  env->head= new_val(env);
+
+  if (env->err) return;
+  for(i= 0; i<HASHTBLSIZE; i++) {
+    while(env->symbols[i]!= NULL) {
+      forget_sym(&(env->symbols[i]));
+    }
+    env->symbols[i]= NULL;
+  }
+
+  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);
+}
+
+
+/* List all defined words */
+extern void words(environment *env)
+{
+  symbol *temp;
+  int i;
+  
+  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 ", temp->id);
+      temp= temp->next;
+    }
+  }
+}
+
+
+/* Only to be called by itself function printstack. */
+void print_st(environment *env, value *stack_head, long counter)
+{ 
+  if(CDR(stack_head)->type != empty)
+    print_st(env, CDR(stack_head), counter+1);
+  printf("%ld: ", counter);
+  print_val(env, CAR(stack_head), 0, NULL, stdout);
+  printf("\n");
+}
+
+
+/* Prints the stack. */
+extern void printstack(environment *env)
+{
   if(env->head->type == empty) {
-    printerr("Too Few Arguments");
-    env->err=1;
+    printf("Stack Empty\n");
     return;
   }
 
-  if(CAR(env->head)->type != port) {
-    printerr("Bad Argument Type");
-    env->err= 2;
+  print_st(env, env->head, 1);
+}
+
+
+extern void copying(environment *env)
+{
+  puts(license_message);
+}
+
+
+extern void warranty(environment *env)
+{
+  puts(warranty_message);
+}
+
+
+/* random */
+extern void sx_72616e646f6d(environment *env)
+{
+  push_int(env, (int)rand());
+}
+
+
+extern void seed(environment *env)
+{
+  if(check_args(env, 1, integer))
+    return printerr(env);
+
+  srand(CAR(env->head)->content.i);
+  toss(env);
+}
+
+
+extern void ticks(environment *env)
+{
+  int val;
+
+  val= (int)time(NULL);
+  if(val<0) {
+    env->err= 5;
+    return printerr(env);
+  }
+  
+  return push_int(env, val);
+}
+
+
+extern void push(environment *env)
+{
+  symbol *sym;
+  value *oldval;
+  value *newval;
+
+  if(check_args(env, 2, symb, unknown)==0) {
+    sym= CAR(env->head)->content.sym;
+    oldval= sym->val;
+  
+    if(oldval==NULL)
+      oldval= new_val(env);
+
+    sym->val= new_val(env);
+    sym->val->content.c= malloc(sizeof(pair));
+    assert(sym->val->content.c!=NULL);
+    env->gc_count += sizeof(pair);
+    sym->val->type= tcons;
+    CDR(sym->val)= oldval;
+    CAR(sym->val)= CAR(CDR(env->head));
+    env->head= CDR(CDR(env->head));
+
     return;
   }
 
-  ret= fclose(CAR(env->head)->content.p);
+  if(check_args(env, 2, tcons, unknown)==0
+     || check_args(env, 2, empty, unknown)==0) {
+    oldval= CAR(env->head);
+    env->head= CDR(env->head);
+    newval= new_val(env);
+    newval->content.c= malloc(sizeof(pair));
+    assert(newval->content.c!=NULL);
+    env->gc_count += sizeof(pair);
+    newval->type= tcons;
+    CDR(newval)= oldval;
+    CAR(newval)= CAR(env->head);
+    env->head= CDR(env->head);
+    push_val(env, newval);
+    
+    return;
+  }
+
+  return printerr(env);
+}
+
+
+extern void pop(environment *env)
+{
+  symbol *sym;
+  value *val;
+
+  if(check_args(env, 1, symb)==0) {
+    sym= CAR(env->head)->content.sym;
+
+    if(sym->val==NULL) {
+      env->err= 3;
+      return printerr(env);
+    }
+
+    env->head= CDR(env->head);
+    if(sym->val->type==tcons) {
+      push_val(env, CAR(sym->val));
+      sym->val= CDR(sym->val);
+    } else {
+      env->err= 2;
+      return printerr(env);
+    }
 
-  if(ret != 0){
-    perror("close");
-    env->err= 5;
     return;
   }
 
-  toss(env);
+  if(check_args(env, 1, tcons)==0) {
+    val= CAR(env->head);
+    env->head= CDR(env->head);
+    push_val(env, CAR(val));
+    return;
+  }
+
+  return printerr(env);
 }