* interp/daase.lisp: Remove conditionals on :CCL.

	* interp/fname.lisp: Likewise.
	* interp/foam_l.lisp: Likewise.
	* interp/macros.lisp: Likewise.
	* interp/nlib.lisp: Likewise.
	* interp/patches.lisp: Likewise.
	* interp/sfsfun-l.lisp: Likewise.
	* interp/spad.lisp: Likewise.
	* interp/util.lisp: Likewise.
	* interp/vmlisp.lisp: Likewise.

16 files changed, 55 insertions, 260 deletions

diff --git a/configure b/configure
index f937844e..af36569a 100755
--- a/configure
+++ b/configure
@@ -1,6 +1,6 @@
 #! /bin/sh
 # Guess values for system-dependent variables and create Makefiles.
-# Generated by GNU Autoconf 2.63 for OpenAxiom 1.4.0-2010-02-06.
+# Generated by GNU Autoconf 2.63 for OpenAxiom 1.4.0-2010-02-07.
 #
 # Report bugs to <open-axiom-bugs@lists.sf.net>.
 #
@@ -745,8 +745,8 @@ SHELL=${CONFIG_SHELL-/bin/sh}
 # Identity of this package.
 PACKAGE_NAME='OpenAxiom'
 PACKAGE_TARNAME='openaxiom'
-PACKAGE_VERSION='1.4.0-2010-02-06'
-PACKAGE_STRING='OpenAxiom 1.4.0-2010-02-06'
+PACKAGE_VERSION='1.4.0-2010-02-07'
+PACKAGE_STRING='OpenAxiom 1.4.0-2010-02-07'
 PACKAGE_BUGREPORT='open-axiom-bugs@lists.sf.net'
 
 ac_unique_file="src/Makefile.pamphlet"
@@ -1511,7 +1511,7 @@ if test "$ac_init_help" = "long"; then
   # Omit some internal or obsolete options to make the list less imposing.
   # This message is too long to be a string in the A/UX 3.1 sh.
   cat <<_ACEOF
-\`configure' configures OpenAxiom 1.4.0-2010-02-06 to adapt to many kinds of systems.
+\`configure' configures OpenAxiom 1.4.0-2010-02-07 to adapt to many kinds of systems.
 
 Usage: $0 [OPTION]... [VAR=VALUE]...
 
@@ -1581,7 +1581,7 @@ fi
 
 if test -n "$ac_init_help"; then
   case $ac_init_help in
-     short | recursive ) echo "Configuration of OpenAxiom 1.4.0-2010-02-06:";;
+     short | recursive ) echo "Configuration of OpenAxiom 1.4.0-2010-02-07:";;
    esac
   cat <<\_ACEOF
 
@@ -1688,7 +1688,7 @@ fi
 test -n "$ac_init_help" && exit $ac_status
 if $ac_init_version; then
   cat <<\_ACEOF
-OpenAxiom configure 1.4.0-2010-02-06
+OpenAxiom configure 1.4.0-2010-02-07
 generated by GNU Autoconf 2.63
 
 Copyright (C) 1992, 1993, 1994, 1995, 1996, 1998, 1999, 2000, 2001,
@@ -1702,7 +1702,7 @@ cat >config.log <<_ACEOF
 This file contains any messages produced by compilers while
 running configure, to aid debugging if configure makes a mistake.
 
-It was created by OpenAxiom $as_me 1.4.0-2010-02-06, which was
+It was created by OpenAxiom $as_me 1.4.0-2010-02-07, which was
 generated by GNU Autoconf 2.63.  Invocation command line was
 
   $ $0 $@
@@ -21148,7 +21148,7 @@ exec 6>&1
 # report actual input values of CONFIG_FILES etc. instead of their
 # values after options handling.
 ac_log="
-This file was extended by OpenAxiom $as_me 1.4.0-2010-02-06, which was
+This file was extended by OpenAxiom $as_me 1.4.0-2010-02-07, which was
 generated by GNU Autoconf 2.63.  Invocation command line was
 
   CONFIG_FILES    = $CONFIG_FILES
@@ -21211,7 +21211,7 @@ Report bugs to <bug-autoconf@gnu.org>."
 _ACEOF
 cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1
 ac_cs_version="\\
-OpenAxiom config.status 1.4.0-2010-02-06
+OpenAxiom config.status 1.4.0-2010-02-07
 configured by $0, generated by GNU Autoconf 2.63,
   with options \\"`$as_echo "$ac_configure_args" | sed 's/^ //; s/[\\""\`\$]/\\\\&/g'`\\"
 
diff --git a/configure.ac b/configure.ac
index 57d5ca28..7deb6f37 100644
--- a/configure.ac
+++ b/configure.ac
@@ -1,6 +1,6 @@
 sinclude(config/open-axiom.m4)
 sinclude(config/aclocal.m4)
-AC_INIT([OpenAxiom], [1.4.0-2010-02-06], 
+AC_INIT([OpenAxiom], [1.4.0-2010-02-07], 
         [open-axiom-bugs@lists.sf.net])
 
 AC_CONFIG_AUX_DIR(config)
diff --git a/configure.ac.pamphlet b/configure.ac.pamphlet
index 610be798..fd90e421 100644
--- a/configure.ac.pamphlet
+++ b/configure.ac.pamphlet
@@ -1183,7 +1183,7 @@ information:
 <<Autoconf init>>=
 sinclude(config/open-axiom.m4)
 sinclude(config/aclocal.m4)
-AC_INIT([OpenAxiom], [1.4.0-2010-02-06], 
+AC_INIT([OpenAxiom], [1.4.0-2010-02-07], 
         [open-axiom-bugs@lists.sf.net])
 
 @
diff --git a/src/ChangeLog b/src/ChangeLog
index 4e34a158..65af692f 100644
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,3 +1,16 @@
+2010-02-07  Gabriel Dos Reis  <gdr@cs.tamu.edu>
+
+	* interp/daase.lisp: Remove conditionals on :CCL.
+	* interp/fname.lisp: Likewise.
+	* interp/foam_l.lisp: Likewise.
+	* interp/macros.lisp: Likewise.
+	* interp/nlib.lisp: Likewise.
+	* interp/patches.lisp: Likewise.
+	* interp/sfsfun-l.lisp: Likewise.
+	* interp/spad.lisp: Likewise.
+	* interp/util.lisp: Likewise.
+	* interp/vmlisp.lisp: Likewise.
+
 2010-01-03  Aleksej Saushev  <asau@inbox.ru>
 
 	* hyper/addfile.c (strpostfix): Simplify.
diff --git a/src/interp/daase.lisp b/src/interp/daase.lisp
index e4193d52..10c02fd7 100644
--- a/src/interp/daase.lisp
+++ b/src/interp/daase.lisp
@@ -1,6 +1,6 @@
 ;; Copyright (c) 1991-2002, The Numerical Algorithms Group Ltd.
 ;; All rights reserved.
-;; Copyright (C) 2007-2009, Gabriel Dos Reis.
+;; Copyright (C) 2007-2010, Gabriel Dos Reis.
 ;; All rights reserved.
 ;;
 ;; Redistribution and use in source and binary forms, with or without
@@ -1074,11 +1074,6 @@
 		      (cdr (assoc index alist :test #'string=))))
 	  (let (cname kind key alist (systemdir? nil) 
 		      oldmaps asharp-name dbstruct abbrev)
-#+:CCL
-  ;; Open the library
-  (let (lib)
-    (if (filep (setq lib (make-pathname :name object :type "lib")) )
-        (setq input-libraries (cons (open-library (truename lib)) input-libraries))))
    (set-file-getter object)  ; sets the autoload property for G-object
    (dolist (domain asy)
      (setq key (first domain))
@@ -1234,21 +1229,12 @@
 		     (remprop key 'loaded)
 		     (if (null noexpose) 
 			 (|setExposeAddConstr| (cons key nil)))
-		     #-:CCL
 		     (setf (symbol-function key) ; sets the autoload property for cname
 			   #'(lambda (&rest args)
 			       (unless (get key 'loaded)
 				 (|startTimingProcess| '|load|)
 				 (|loadLibNoUpdate| key key object)) ; used to be cname key
 			       (apply key args)))
-		     #+:CCL
-		     (let (lib)
-		       (if (filep 
-			    (setq lib (make-pathname :name object :type "lib")) )
-			   (setq input-libraries 
-				 (cons (open-library (truename lib)) 
-				       input-libraries)))
-		       (|unloadOneConstructor| (get abbrev 'abbreviationfor) abbrev) )
 		     (|sayKeyedMsg| 'S2IU0001 (list key object))))))
 
 ; making new databases consists of:
@@ -1705,29 +1691,6 @@
   (cond ((not type?) obj)
         (t (|makeOldAxiomDispatchDomain| obj))))
 
-;; CCL doesn't have closures, so we use an intermediate function in
-;; asharpMkAutoLoadFunctor.
-#+:CCL
-(defun mkFunctorStub (func cosig cname)
-  (setf (symbol-function cname)
-        (if (vectorp (car func))
-          `(lambda () ',func)  ;; constant domain
-          `(lambda (&rest args2)
-              (apply ',(|ClosFun| func)
-                 (nconc
-                    (mapcar #'wrapDomArgs args2 ',(cdr cosig))
-                    (list ',(|ClosEnv| func))))))))
-
-#+:CCL
-(defun asharpMkAutoLoadFunctor (file cname asharp-name cosig)
-  (setf (symbol-function cname)
-        `(lambda (&rest args)
-            (mkFunctorStub
-              (getconstructor (eval (file-getter-name ',file)) ',asharp-name)
-              ',cosig ',cname)
-            (apply ',cname args))))
-
-#-:CCL
 (defun asharpMkAutoLoadFunctor (file cname asharp-name cosig)
   (setf (symbol-function cname)
   #'(lambda (&rest args)
@@ -1742,35 +1705,6 @@
                     (list (|ClosEnv| func)))))))
       (apply cname args)))))
 
-;; CCL doesn't have closures, so we use an intermediate function in
-;; asharpMkAutoLoadCategory.
-#+:CCL
-(defun mkCategoryStub (func cosig packname)
-  (setf (symbol-function packname)
-        (if (vectorp (car func))
-         `(lambda (self)  ;; constant category
-           (|CCall| (elt ',(car func) 5) ',(cdr func) (wrapDomArgs self t)))
-         `(lambda (self &rest args)
-           (let ((precat
-                  (apply (|ClosFun| ',func)
-                         (nconc
-                          (mapcar #'wrapDomArgs args ',(cdr cosig))
-                          (list (|ClosEnv| ',func))))))
-             (|CCall| (elt (car precat) 5) (cdr precat) (wrapDomArgs self t)))))
-))
-
-#+:CCL
-(defun asharpMkAutoLoadCategory (file cname asharp-name cosig)
-  (asharpMkAutoLoadFunctor file cname asharp-name cosig)
-  (let ((packname (INTERN (STRCONC cname "&"))))
-    (setf (symbol-function packname)
-          `(lambda (self &rest args)
-                 (mkCategoryStub
-                 (getconstructor (eval (file-getter-name ',file)) ',asharp-name)
-                 ',cosig ',packname)
-            (apply ',packname self args)))))
-
-#-:CCL
 (defun asharpMkAutoLoadCategory (file cname asharp-name cosig)
   (asharpMkAutoLoadFunctor file cname asharp-name cosig)
   (let ((packname (INTERN (STRCONC cname '"&"))))
@@ -1790,17 +1724,6 @@
               (|CCall| (elt (car precat) 5) (cdr precat) (wrapDomArgs self t))))))
       (apply packname self args))))))
 
-#+:CCL
-(defun asharpMkAutoLoadFunction (file asharpname)
- (setf (symbol-value asharpname)
-  (cons
-   `(lambda (&rest l)
-     (let ((args (butlast l))
-           (func (getconstructor (eval (file-getter-name ',file)) ',asharpname)))
-        (apply (car func) (append args (list (cdr func))))))
-      ())))
-
-#-:CCL
 (defun asharpMkAutoLoadFunction (file asharpname)
   (setf (symbol-value asharpname)
    (cons
@@ -1826,10 +1749,7 @@
 (defun init-file-getter (env)
   (let ((getter-name (car env))
         (filename (cdr env)))
-#-:CCL
     (load filename)
-#+:CCL
-    (load-module filename)
     (|CCall| (eval getter-name))))
 
 (defun set-lib-file-getter (filename cname)
@@ -1841,10 +1761,7 @@
   (let* ((getter-name (car env))
          (cname (cdr env))
          (filename (|getConstructorModuleFromDB| cname)))
-#-:CCL
     (load filename)
-#+:CCL
-    (load-module (pathname-name filename))
     (|CCall| (eval getter-name))))
 
 ;; following 2 functions are called by file-exports and file-imports macros
diff --git a/src/interp/debug.lisp b/src/interp/debug.lisp
index a6cdc383..9e61867c 100644
--- a/src/interp/debug.lisp
+++ b/src/interp/debug.lisp
@@ -1136,8 +1136,6 @@ EXAMINE (SETQ RECNO (NOTE |$InputStream|))
 
 (defun lisp-break-from-axiom (&rest ignore) 
     (boot::|handleLispBreakLoop| boot::|$BreakMode|))
-#+:CCL (setq lisp:*break-loop* 'boot::lisp-break-from-axiom)
 
-#-:CCL
 (defun interrupt (&rest ignore))
 
diff --git a/src/interp/fname.lisp b/src/interp/fname.lisp
index a3c622d5..32dd202d 100644
--- a/src/interp/fname.lisp
+++ b/src/interp/fname.lisp
@@ -1,6 +1,6 @@
 ;; Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
 ;; All rights reserved.
-;; Copyright (C) 2007-2008, Gabriel Dos Reis.
+;; Copyright (C) 2007-2010, Gabriel Dos Reis.
 ;; All rights reserved.
 ;;
 ;; Redistribution and use in source and binary forms, with or without
@@ -84,8 +84,6 @@
   (if (probe-file (namestring f)) 't nil))
 
 (defun |fnameReadable?| (f)
-#+:CCL (file-readablep f)
-#-:CCL
   (let ((s (open f :direction :input :if-does-not-exist nil)))
     (cond (s (close s) 't) ('t nil)) )
   )
diff --git a/src/interp/foam_l.lisp b/src/interp/foam_l.lisp
index 8863d2d6..55390f44 100644
--- a/src/interp/foam_l.lisp
+++ b/src/interp/foam_l.lisp
@@ -1,6 +1,6 @@
 ;; Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
 ;; All rights reserved.
-;; Copyright (C) 2007-2008, Gabriel Dos Reis.
+;; Copyright (C) 2007-2010, Gabriel Dos Reis.
 ;; All rights reserved.
 ;;
 ;; Redistribution and use in source and binary forms, with or without
@@ -520,11 +520,6 @@
                                    (cddr ,x) nil))
 (defmacro |SetEnvInfo|  (x val)   `(rplacd (cdr  ,x) ,val))
 
-#+:CCL
-(defmacro |FoamEnvEnsure| (e) 
-  `(let ((einf (|EnvInfo| ,e)))
-     (if einf (|CCall| einf) nil)))
-#-:CCL
 (defmacro |FoamEnvEnsure| (e) 
   `(if (|EnvInfo| ,e) (|CCall| (|EnvInfo| ,e)) nil))
 
@@ -666,7 +661,6 @@
 (defmacro block-return (obj val)
   `(return-from ,obj ,val))
 
-#-:CCL
 (defmacro typed-let (letvars &rest forms)
   `(let ,(mapcar #'(lambda (var)
                      (list (car var) (type2init (cadr var))))
@@ -676,12 +670,6 @@
                         letvars))
      ,@forms))
 
-#+:CCL
-(defmacro typed-let (letvars &rest forms)
-  `(let ,(mapcar #'(lambda (var) (car var))
-                 letvars )
-     ,@forms))
-
 (defmacro cases (&rest junk)
   `(case ,@junk))
 
@@ -709,7 +697,6 @@
                :element-type ',type
                :initial-element ,(type2init type))))
 
-#-:CCL
 (defun type2init (x)
   (cond
    ((eq x '|Char|) '|CharInit|)
@@ -731,9 +718,6 @@
    ((eq x '|Nil|) nil)
    (t nil)))
 
-#+:CCL
-(defun type2init (x) nil)
-
 ;; opsys interface
 (defvar |G-mainArgc| 0)
 (defvar |G-mainArgv| (vector))
diff --git a/src/interp/hash.lisp b/src/interp/hash.lisp
index b9f3463e..affd3f6e 100644
--- a/src/interp/hash.lisp
+++ b/src/interp/hash.lisp
@@ -78,14 +78,6 @@
         (2 'EQUAL)
         (t "error unknown hash table class")))
 
-#+:CCL
-(defun HASHTABLE-CLASS (table)
-  (case (hashtable-flavour table)
-        (0 'EQ)
-        (1 'EQL)
-        (2 'EQUAL)
-        (t (format nil "error unknown hash table class ~a" (hashtable-flavour table)))))
-
 (define-function 'HCOUNT #'hash-table-count)
 
 ;17.4 Searching and Updating
diff --git a/src/interp/macros.lisp b/src/interp/macros.lisp
index 809c5c1e..8c73a892 100644
--- a/src/interp/macros.lisp
+++ b/src/interp/macros.lisp
@@ -1,6 +1,6 @@
 ;; Copyright (c) 1991-2002, The Numerical Algorithms Group Ltd.
 ;; All rights reserved.
-;; Copyright (C) 2007-2008, Gabriel Dos Reis.
+;; Copyright (C) 2007-2010, Gabriel Dos Reis.
 ;; All rights reserved.
 ;;
 ;; Redistribution and use in source and binary forms, with or without
@@ -150,10 +150,6 @@
            ((eql n (qvmaxindex vec)) vec)
            (t (subseq vec 0 (+ n 1))))))
  
-;; In CCL ASH assumes a 2's complement machine.  We use ASH in Integer and
-;; assume we have a sign and magnitude setup.
-#+:CCL (defmacro ash (u v) `(lisp::ash1 ,u ,v))
-
 ; 14 SEQUENCES
  
 ; 14.1 Simple Sequence Functions
@@ -526,11 +522,11 @@ terminals and empty or at-end files.  In Common Lisp, we must assume record size
  
 #+IBCL
 (defmacro |elapsedGcTime| () '(system:gbc-time-report))
+
 #+AKCL
 (defmacro |elapsedGcTime| () '(system:gbc-time))
-#+:CCL
-(defmacro |elapsedGcTime| () '(lisp:gctime))
-#-(OR :CCL IBCL AKCL)
+
+#-(OR IBCL AKCL)
 (defmacro |elapsedGcTime| () '0)
  
 (defmacro |do| (&rest args) (CONS 'PROGN args))
diff --git a/src/interp/nlib.lisp b/src/interp/nlib.lisp
index 434970e6..a81d840b 100644
--- a/src/interp/nlib.lisp
+++ b/src/interp/nlib.lisp
@@ -1,6 +1,6 @@
 ;; Copyright (c) 1991-2002, The Numerical Algorithms Group Ltd.
 ;; All rights reserved.
-;; Copyright (C) 2007-2009, Gabriel Dos Reis.
+;; Copyright (C) 2007-2010, Gabriel Dos Reis.
 ;; All rights reserved.
 ;;
 ;; Redistribution and use in source and binary forms, with or without
@@ -120,14 +120,6 @@
     (princ pos stream)
     (finish-output stream)))
 
-;;#+:ccl
-;;(defun putindextable (indextable dirname)
-;;  (with-open-file
-;;    (stream (concat dirname "/" |$IndexFilename|)
-;;             :direction :io :if-does-not-exist :create)
-;;    (file-position stream :end)
-;;    (write-indextable indextable stream)))
-;;#-:ccl
 (defun putindextable (indextable dirname)
   (with-open-file
     (stream (concat dirname "/" |$IndexFilename|)
@@ -351,12 +343,12 @@
         (copy-file name1 name2))))
 
 
-#+(OR :AKCL (AND :CCL :UNIX))
+#+ :AKCL
 (defun copy-lib-directory (name1 name2)
    (|checkMkdir| name2)
    (system (concat "sh -c 'cp " name1 "/* " name2 "'")))
 
-#+(OR :AKCL (AND :CCL :UNIX))
+#+ :AKCL
 (defun copy-file (namestring1 namestring2)
   (system (concat "cp " namestring1 " " namestring2)))
 
diff --git a/src/interp/patches.lisp b/src/interp/patches.lisp
index e6d206ba..958fcda4 100644
--- a/src/interp/patches.lisp
+++ b/src/interp/patches.lisp
@@ -1,6 +1,6 @@
 ;; Copyright (c) 1991-2002, The Numerical Algorithms Group Ltd.
 ;; All rights reserved.
-;; Copyright (C) 2007-2008, Gabriel Dos Reis.
+;; Copyright (C) 2007-2010, Gabriel Dos Reis.
 ;; All rights reserved.
 ;;
 ;; Redistribution and use in source and binary forms, with or without
@@ -97,14 +97,9 @@
      (type (pathname-type input-file)))
     (cond
      ((string= type "boot")
-#-:CCL
       (boot input-file
          (setq lfile (make-pathname :type "lisp"
                            :defaults input-file)))
-#+:CCL
-      (boot input-file
-         (setq lfile (make-pathname :name (pathname-name input-file)
-                                :type "lisp")))
       (load lfile))
      ((string= type "lisp") (load input-file))
      ((string= type "bbin") (load input-file))
@@ -222,22 +217,16 @@
            (name ))  ;; this is used for printing
 #+(and :gcl (not (or :dos :win32)))
 (defun |xdrOpen| (str dir) (make-xdr-stream :handle (system:xdr-open str) :name str))
-#+:CCL
-(defun |xdrOpen| (str dir) (xdr-open str dir) )
 #+(and :gcl (or :dos :win32))
 (defun |xdrOpen| (str dir) (format t "xdrOpen called"))
 
 #+(and :akcl (not (or :dos :win32)))
 (defun |xdrRead| (xstr r) (system:xdr-read (xdr-stream-handle xstr) r) )
-#+:CCL
-(defun |xdrRead| (xstr r) (xdr-read xstr r) )
 #+(and :gcl (or :dos :win32))
 (defun |xdrRead| (str) (format t "xdrRead called"))
 
 #+(and :akcl (not (or :dos :win32)))
 (defun |xdrWrite| (xstr d) (system:xdr-write (xdr-stream-handle xstr) d) )
-#+:CCL
-(defun |xdrWrite| (xstr d) (xdr-write xstr d) )
 #+(and :gcl (or :dos :win32))
 (defun |xdrWrite| (str) (format t "xdrWrite called"))
 
diff --git a/src/interp/sfsfun-l.lisp b/src/interp/sfsfun-l.lisp
index 810cbe21..4014543b 100644
--- a/src/interp/sfsfun-l.lisp
+++ b/src/interp/sfsfun-l.lisp
@@ -1,6 +1,6 @@
 ;; Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
 ;; All rights reserved.
-;; Copyright (C) 2007-2008, Gabriel Dos Reis.
+;; Copyright (C) 2007-2010, Gabriel Dos Reis.
 ;; All rights reserved.
 ;;
 ;; Redistribution and use in source and binary forms, with or without
@@ -40,9 +40,6 @@
 ;; SMW Feb 91
 ;;
 
-;; #-:CCL
-;; (defun |float| (x) (|float| x))
-
 ;; Conversion between spad and lisp complex representations
 (defun s-to-c (c) (complex (car c) (cdr c)))
 (defun c-to-s (c) (cons (realpart c) (imagpart c)))
@@ -56,7 +53,6 @@
 (defun rlngamma  (x)           (|lnrgamma| x) )
 (defun clngamma  (z)   (c-to-s (|lncgamma| (s-to-c z)) ))
 
-;; #-:CCL
 (defun rgamma    (x)           (|rgamma|   x))
 (defun cgamma    (z)   (c-to-s (|cgamma|   (s-to-c z)) ))
 
diff --git a/src/interp/spad.lisp b/src/interp/spad.lisp
index aefc8608..7761a1ef 100644
--- a/src/interp/spad.lisp
+++ b/src/interp/spad.lisp
@@ -1,6 +1,6 @@
 ;; Copyright (c) 1991-2002, The Numerical Algorithms Group Ltd.
 ;; All rights reserved.
-;; Copyright (C) 2007-2008, Gabriel Dos Reis.
+;; Copyright (C) 2007-2010, Gabriel Dos Reis.
 ;; All rights reserved.
 ;;
 ;; Redistribution and use in source and binary forms, with or without
@@ -442,28 +442,18 @@
 
 ;; function to create byte and half-word vectors in new runtime system 8/90
 
-#-:CCL
 (defun |makeByteWordVec| (initialvalue)
   (let ((n (cond ((null initialvalue) 7) ('t (reduce #'max initialvalue)))))
     (make-array (length initialvalue)
       :element-type (list 'mod (1+ n))
       :initial-contents initialvalue)))
 
-#+:CCL
-(defun |makeByteWordVec| (initialvalue)
-   (list-to-vector initialvalue))
-
-#-:CCL
 (defun |makeByteWordVec2| (maxelement initialvalue)
   (let ((n (cond ((null initialvalue) 7) ('t maxelement))))
     (make-array (length initialvalue)
       :element-type (list 'mod (1+ n))
       :initial-contents initialvalue)))
 
-#+:CCL
-(defun |makeByteWordVec2| (maxelement initialvalue)
-   (list-to-vector initialvalue))
-
 (defun |knownEqualPred| (dom)
   (let ((fun (|compiledLookup| '= '((|Boolean|) $ $) dom)))
     (if fun (get (bpiname (car fun)) '|SPADreplace|)
diff --git a/src/interp/util.lisp b/src/interp/util.lisp
index 6abfbbd3..1da23cf4 100644
--- a/src/interp/util.lisp
+++ b/src/interp/util.lisp
@@ -1,6 +1,6 @@
 ;; Copyright (c) 1991-2002, The Numerical Algorithms Group Ltd.
 ;; All rights reserved.
-;; Copyright (C) 2007-2009, Gabriel Dos Reis.
+;; Copyright (C) 2007-2010, Gabriel Dos Reis.
 ;; All rights reserved.
 ;;
 ;; Redistribution and use in source and binary forms, with or without
@@ -208,19 +208,13 @@
 (defun compile-boot-file (file)
   "compile and load a boot file"
   (boot (concat file ".boot") (concat file ".lisp"))
-#-:ccl
   (compile-file (concat file ".lisp"))
-#-:ccl
   (load (concat file "." |$faslType|))
-#+:CCL
-  (load (concat file ".lisp"))
 )
 
 
 ;; Translate a single boot file to common lisp
 (defun translate (file) ;; translates a single boot file
-#+:CCL
-  (setq *package* (find-package "BOOT"))
 #+:AKCL
   (in-package "BOOT")
   (let (*print-level* *print-length* (fn (pathname-name file))
@@ -297,8 +291,6 @@
 (defun |setBootAutloadProperties| (fun-list file-list)
 #+:AKCL
   (mapc #'(lambda (fun) (|setBootAutoLoadProperty| fun file-list)) fun-list)
-#+:CCL
-  (mapc #'(lambda (fun) (lisp::set-autoload fun file-list)) fun-list)
 )
 
 
diff --git a/src/interp/vmlisp.lisp b/src/interp/vmlisp.lisp
index 72d79e12..e7bedb34 100644
--- a/src/interp/vmlisp.lisp
+++ b/src/interp/vmlisp.lisp
@@ -1,6 +1,6 @@
 ;; Copyright (c) 1991-2002, The Numerical Algorithms Group Ltd.
 ;; All rights reserved.
-;; Copyright (C) 2007-2008, Gabriel Dos Reis.
+;; Copyright (C) 2007-2010, Gabriel Dos Reis.
 ;; All rights reserved.
 ;;
 ;; Redistribution and use in source and binary forms, with or without
@@ -70,7 +70,6 @@
 (defmacro absval (x)
  `(abs ,x))
 
-#-:CCL
 (defmacro add1 (x)
  `(1+ ,x))
 
@@ -81,18 +80,12 @@
 (defmacro applx (&rest args)
  `(apply ,@args))
 
-#-(or LispM Lucid :CCL)
+#-(or LispM Lucid)
 (defmacro assq (a b)
  `(assoc ,a ,b :test #'eq))
 
-#+:CCL
-(defmacro assq (a b) `(atsoc ,a ,b))
-
-#-:CCL
 (defmacro bintp (n)
  `(typep ,n 'bignum))
-#+:CCL
-(defun bintp (n) (and (integerp n) (not (fixp n))))
 
 (defmacro closedfn (form)
  `(function ,form))
@@ -106,7 +99,6 @@
 (defmacro dcq (&rest args)
  (cons 'setqp args))
 
-#-:CCL
 (defmacro difference (&rest args)
  `(- ,@args))
 
@@ -125,7 +117,6 @@
        (and (consp x) (eq (car x) 'quote) 
             (symbolp (cadr x))))))
 
-#-:CCL
 (defmacro eqcar (x y)
  (let ((test
         (cond
@@ -156,11 +147,9 @@
 (defmacro fetchchar (x i)
  `(char ,x ,i))
 
-#-:CCL  ;; fixp in ccl tests for fixnum
 (defmacro fixp (x)
  `(integerp ,x))
 
-#-:CCL
 (defmacro greaterp (&rest args)
  `(> ,@args))
 
@@ -211,7 +200,6 @@
 (defmacro lastpair (l)
  `(last ,l))
 
-#-:CCL
 (defmacro lessp (&rest args)
  `(< ,@args))
 
@@ -226,11 +214,10 @@
 (defmacro maxindex (x)
  `(the fixnum (1- (the fixnum (length ,x)))))
 
-#-(or LispM Lucid :CCL)
+#-(or LispM Lucid)
 (defmacro memq (a b)
  `(member ,a ,b :test #'eq))
 
-#-:CCL
 (defmacro minus (x)
  `(- ,x))
 
@@ -243,11 +230,8 @@
 
 (defmacro ne (a b) `(not (equal ,a ,b)))
 
-;;; This may need adjustment in CCL where NEQ means (NOT (EQUAL ..)))
-#-:CCL
 (defmacro neq (a b) `(not (eq ,a ,b)))
 
-#-:CCL
 (defmacro nreverse0 (x)
   (if (atom x)
       `(if (atom ,x) ,x (nreverse ,x))
@@ -267,7 +251,6 @@
 (defmacro pairp (x)
  `(consp ,x)) 
 
-#-:CCL
 (defmacro plus (&rest args)
  `(+ ,@ args))
 
@@ -275,23 +258,21 @@
 ;  `(assoc ,a ,b :test #'eq))
 (defmacro qassq (a b) `(assq ,a ,b))
 
-#-:CCL
 (defmacro qcar (x)
  `(car (the cons ,x)))
-#-:CCL
+
 (defmacro qcdr (x)
  `(cdr (the cons ,x)))
 
-#-:CCL
 (defmacro qcaar (x)
  `(car (the cons (car (the cons ,x)))))
-#-:CCL
+
 (defmacro qcadr (x)
  `(car (the cons (cdr (the cons ,x)))))
-#-:CCL
+
 (defmacro qcdar (x)
  `(cdr (the cons (car (the cons ,x)))))
-#-:CCL
+
 (defmacro qcddr (x)
  `(cdr (the cons (cdr (the cons ,x)))))
 
@@ -447,11 +428,6 @@
 (defmacro qvsize (x)
  `(the fixnum (length (the simple-vector ,x))))
 
-; #-:CCL
-; (defmacro refvecp (v)
-;  `(typep ,v '(vector t)))
-; #+:CCL
-; (defun refvecp (v) (and (vectorp v) (not (stringp v))))
 (defmacro refvecp (v) `(simple-vector-p ,v))
 
 (defmacro resetq (a b)
@@ -475,7 +451,6 @@
    (setq ,id ,item)
    (lam\,fileactq ',id (list 'setq ',id (list 'quote ,id)))))
 
-#-:CCL
 (defmacro setelt (vec ind val)
  `(setf (elt ,vec ,ind) ,val))
 
@@ -491,17 +466,15 @@
 (defmacro sfp (x)
  `(special-form-p ,x))
 
-#-:CCL
 (defmacro sintp (n)
  `(typep ,n 'fixnum))
-#+:CCL
+
 (defmacro sintp (n)
   `(fixp ,n))
 
-#-:CCL
 (defmacro smintp (n)
  `(typep ,n 'fixnum))
-#+:CCL
+
 (defmacro smintp (n)
   `(fixp ,n))
 
@@ -514,24 +487,17 @@
 (defmacro throw-protect (exp1 exp2)
  `(unwind-protect ,exp1 ,exp2))
 
-#-:CCL
 (defmacro times (&rest args)
  `(* ,@args))
 
 (defmacro vec-setelt (vec ind val)
  `(setf (svref ,vec ,ind) ,val))
 
-; #-:CCL
-; (defmacro vecp (v)
-;  `(typep ,v '(vector t)))
-; #+:CCL
-; (defun vecp (v) (and (vectorp v) (not (stringp v))))
 (defmacro vecp (v) `(simple-vector-p ,v))
 
-#-:CCL
 (defmacro zero? (x)
   `(and (typep ,x 'fixnum) (zerop (the fixnum ,x))))
-#+:CCL
+
 (defmacro zero? (x) `(zerop ,x))
 
 ;; defuns
@@ -541,12 +507,9 @@
 (defun $TOTAL-ELAPSED-TIME ()
    (list (get-internal-run-time) (get-internal-real-time)))
 
-#-(OR IBCL KCL :CMULISP :CCL)
+#-(OR IBCL KCL :CMULISP)
 (defun $TOTAL-GC-TIME () (list 0 0))
 
-#+:CCL
-(defun $TOTAL-GC-TIME () (list (gctime) (gctime)))
-
 #+IBCL
 (defun $TOTAL-GC-TIME (&aux (gcruntime (system:gbc-time-report)))
   (list gcruntime gcruntime))
@@ -635,8 +598,6 @@
   (cond ((atom (car fnlist)) (list (COMPILE1 fnlist)))
         (t (MAPCAR #'(lambda (x) (COMPILE1 x)) fnlist))))
 
-#+:CCL (proclaim '(special *vars* *decl*)) ;; declare not handled right
-
 (defun |compileLispDefinition| (name def)
   (when *COMP370-APPLY* 
     (funcall *COMP370-APPLY* name def)))
@@ -709,7 +670,6 @@
 
 ; 9.5 Identifiers
 
-#-:CCL
 (defun gensymp (x) (and (symbolp x) (null (symbol-package x))))
 
 (defun digitp (x)
@@ -722,9 +682,8 @@
     (digit-char-p (char (symbol-name x) 0))
     (digit-char-p x)))
 
-#-:CCL
 (defun LN (x) (LOG x))
-#-:CCL
+
 (defun LOG2 (x) (LOG x 2.0))
 (defun |log| (x) (LOG x 10.0))
 
@@ -743,7 +702,7 @@
        (eq (system:fp-output-stream stream)
            (system:fp-output-stream *terminal-io*))))
 
-#-(OR Lucid KCL :CCL)
+#-(OR Lucid KCL)
 (defun IS-CONSOLE (stream)
   (cond ((not (streamp stream))
 	 nil)
@@ -796,10 +755,8 @@
 ;; property lists in vmlisp are alists
 (defun PROPLIST (x)
   (if (symbolp x)
-#-:CCL
+
    (plist2alist (symbol-plist x))
-#+:CCL
-   (plist2alist (plist x))
     nil))
 
 (defun plist2alist (x)
@@ -830,13 +787,11 @@
 
 (define-function 'vm/ #'quotient)
 
-#-:CCL
 (defun REMAINDER (x y)
   (if (and (integerp x) (integerp y))
       (rem x y)
       (- x (* y (QUOTIENT x y)))))
 
-#-:CCL
 (defun DIVIDE (x y)
   (if (and (integerp x) (integerp y))
       (multiple-value-list (truncate x y))
@@ -898,8 +853,6 @@
 
 ; 14.3 Searching
 
-#+:CCL (DEFMACRO |assoc| (X Y) `(ASSOC** ,X ,Y))
-#-:CCL
 (DEFUN |assoc| (X Y)
   "Return the pair associated with key X in association list Y."
   ; ignores non-nil list terminators
@@ -972,9 +925,7 @@
 ;; is compiled and the latter is byte-coded!
 (defun size (l) 
   (cond ((vectorp l) (length l))
-#+:CCL  ((stringp l) (length l)) ;; Until ACN fixes his lisp -> C translator.
-#-:CCL  ((consp l)   (list-length l))
-#+:CCL  ((consp l)   (length l))
+        ((consp l)   (list-length l))
         (t           0)))
 
 (define-function 'MOVEVEC #'replace)
@@ -1540,9 +1491,7 @@
 (defun EMBEDDED () (mapcar #'car *embedded-functions*))
 
 (defun EMBED (CURRENT-BINDING NEW-DEFINITION)
-  (PROG
-#+:CCL (OP BV BODY OLD-DEF *COMP)
-#-:CCL (OP BV BODY OLD-DEF)
+  (PROG (OP BV BODY OLD-DEF)
       (COND
         ( (NOT (IDENTP CURRENT-BINDING))
           (SETQ CURRENT-BINDING
@@ -1566,17 +1515,13 @@
             ( 'T
               `((LAMBDA (,CURRENT-BINDING) ,NEW-DEFINITION) ',OLD-DEF)))
             ) )
-#+:CCL (IF (CONSP NEW-DEFINITION) (SETQ NEW-DEFINITION (CDR NEW-DEFINITION)))
       (push (LIST CURRENT-BINDING NEW-DEFINITION OLD-DEF) *embedded-functions*)
       (RETURN CURRENT-BINDING) ) )
 
 (defun UNEMBED (CURRENT-BINDING)
-    (PROG
-#+:CCL  (TMP E-LIST CUR-DEF *COMP)
-#-:CCL  (TMP E-LIST CUR-DEF)
+    (PROG (TMP E-LIST CUR-DEF)
       (SETQ E-LIST *embedded-functions*)
       (SETQ CUR-DEF (symbol-function CURRENT-BINDING))
-#+:CCL (IF (CONSP CUR-DEF) (SETQ CUR-DEF (CDR CUR-DEF)))
       (COND
         ( (NOT (consp E-LIST))
           NIL )
@@ -1768,8 +1713,6 @@
 (defun reclaim () (gbc t))
 #+:allegro
 (defun reclaim () (excl::gc t))
-#+:CCL
-(defun reclaim () (gc))
 
 #+Lucid
 (defun BPINAME (func)
@@ -1801,11 +1744,6 @@
 #+:allegro
 (defun bpiname (func)
  func)
-#+:CCL
-(defun bpiname (x)
-   (if (symbolp x)
-     (intern (symbol-name (symbol-function x)) "BOOT")
-    nil))
 
 #+(or :SBCL :clisp :ecl)
 (defun BPINAME (x)