cleanup from lisp

5 files changed, 11 insertions, 60 deletions

diff --git a/src/interp/debug.lisp b/src/interp/debug.lisp
index 2c951e31..1f1b9c5c 100644
--- a/src/interp/debug.lisp
+++ b/src/interp/debug.lisp
@@ -290,8 +290,6 @@
             (compile (EVAL DEF))))
         ( DEF
           (FUNCALL OP (LIST DEF)) ) )
-      #+Lucid(system::compiler-options :messages nil :warnings nil)
-      #+Lucid(TERPRI)
       (COND
         ( TRACEFLAG
           (/TRACE-2 /FN NIL) ) )
diff --git a/src/interp/hash.lisp b/src/interp/hash.lisp
index affd3f6e..98ac338a 100644
--- a/src/interp/hash.lisp
+++ b/src/interp/hash.lisp
@@ -44,8 +44,7 @@
                      ((EQ ID) #'eq)
                      (CVEC #'equal)
                      (EQL #'eql)
-                     #+Lucid ((UEQUAL EQUALP) #'EQUALP)
-                     #-Lucid ((UEQUAL EQUAL) #'equal)
+                     ((UEQUAL EQUAL) #'equal)
                      (otherwise (error "bad arg to make-hashtable")))))     
       (make-hash-table :test test)))
 
@@ -60,9 +59,6 @@
         #'(lambda (key val) (declare (ignore val)) (push key keys)) table)
         keys))
 
-#+Lucid
-(define-function 'HASHTABLE-CLASS #'system::hash-table-test)
-
 #+AKCL
 (clines "int mem_value(x ,i)object x;int i; { return ((short *)x)[i];}")
 #+AKCL
diff --git a/src/interp/metalex.lisp b/src/interp/metalex.lisp
index e6cc1485..bc80c1d6 100644
--- a/src/interp/metalex.lisp
+++ b/src/interp/metalex.lisp
@@ -407,10 +407,10 @@ NonBlank is true if the token is not preceded by a blank."
         (*print-pretty* t))
     (if store
         (progn (format t "~%Reduction stack contains:~%")
-               (mapcar #'(lambda (x) (if (eq (type-of x) 'token)
-                               #+Symbolics (zl:describe-defstruct x)
-                               #-Symbolics (describe x)
-                                         (print x)))
+               (mapcar #'(lambda (x)
+			   (if (eq (type-of x) 'token)
+                               (describe x)
+			     (print x)))
                        (stack-store reduce-stack)))
         (format t "~%There is nothing on the reduction stack.~%"))))
 
@@ -524,19 +524,13 @@ empty (if File-Closed (return nil))
       (format t "~%The number of valid tokens is ~S.~%" Valid-Tokens))
   (if (> Valid-Tokens 0)
       (progn (format t "The current token is~%")
-             #+Symbolics (zl:describe-defstruct current-token)
-             #-Symbolics (describe current-token)
-             ))
+             (describe current-token)))
   (if (> Valid-Tokens 1)
       (progn (format t "The next token is~%")
-             #+Symbolics (zl:describe-defstruct next-token)
-             #-Symbolics (describe next-token)
-             ))
+             (describe next-token)))
   (if (token-type prior-token)
       (progn (format t "The prior token was~%")
-             #+Symbolics (zl:describe-defstruct prior-token)
-             #-Symbolics (describe prior-token)
-             )))
+             (describe prior-token))))
 
 (defmacro token-stack-clear ()
   `(progn (setq valid-tokens 0)
diff --git a/src/interp/spad.lisp b/src/interp/spad.lisp
index 2c2a01ee..853fcbc8 100644
--- a/src/interp/spad.lisp
+++ b/src/interp/spad.lisp
@@ -241,14 +241,8 @@
 (defun |sort| (seq spadfn)
     (sort (copy-seq seq) (function (lambda (x y) (SPADCALL X Y SPADFN)))))
 
-#-Lucid
 (defun DIVIDE2 (X Y) (multiple-value-call #'cons (TRUNCATE X Y)))
 
-#+Lucid
-(defun DIVIDE2 (X Y)
-  (if (zerop y) (truncate 1 Y)
-    (multiple-value-call #'cons (TRUNCATE X Y))))
-
 (define-function '|not| #'NOT)
 
 (defun |random| () (random (expt 2 26)))
@@ -425,9 +419,7 @@
 
 (defun |hashable| (dom)
   (memq (|knownEqualPred| dom)
-        #-Lucid '(EQ EQL EQUAL)
-        #+Lucid '(EQ EQL EQUAL EQUALP)
-        ))
+        '(EQ EQL EQUAL)))
 
 ;; simpler interpface to RDEFIOSTREAM
 (defun RDEFINSTREAM (&rest fn)
diff --git a/src/interp/vmlisp.lisp b/src/interp/vmlisp.lisp
index af7021cd..6d10bd30 100644
--- a/src/interp/vmlisp.lisp
+++ b/src/interp/vmlisp.lisp
@@ -77,7 +77,6 @@
 (defmacro applx (&rest args)
  `(apply ,@args))
 
-#-(or LispM Lucid)
 (defmacro assq (a b)
  `(assoc ,a ,b :test #'eq))
 
@@ -205,7 +204,6 @@
 (defmacro maxindex (x)
  `(the fixnum (1- (the fixnum (length ,x)))))
 
-#-(or LispM Lucid)
 (defmacro memq (a b)
  `(member ,a ,b :test #'eq))
 
@@ -550,8 +548,7 @@
     (setq args (remove-fluids (cadr lamda)))
     (cond ((and (eq ltype 'lambda) (simple-arglist args)) (setq nargs args))
           (t (setq nargs (gensym))
-     #+LispM (setq body `((dsetq ,args (copy-list ,nargs)) ,@body))
-     #-LispM (setq body `((dsetq ,args  ,nargs) ,@body))
+             (setq body `((dsetq ,args  ,nargs) ,@body))
              (cond ((eq ltype 'lambda) (setq nargs `(&rest ,nargs &aux ,@*vars*)))
                    ((eq ltype 'mlambda)
                     (setq nargs `(&whole ,nargs &rest ,(gensym) &aux ,@*vars*)))
@@ -620,20 +617,13 @@
 
 ; 9.13 Streams
 
-#+Lucid
-(defun IS-CONSOLE (stream)
-    (and (streamp stream)
-         (or (not (consp (pathname-directory stream)))
-             (equal (qcar (pathname-directory stream)) "dev")
-             (null (pathname-name stream) ))))
-
 #+KCL
 (defun IS-CONSOLE (stream)
   (and (streamp stream) (output-stream-p stream)
        (eq (system:fp-output-stream stream)
            (system:fp-output-stream *terminal-io*))))
 
-#-(OR Lucid KCL)
+#-KCL
 (defun IS-CONSOLE (stream)
   (cond ((not (streamp stream))
 	 nil)
@@ -1548,14 +1538,6 @@
         (LIST "in the expression:" MESSAGE))
       ())
 
-#+Lucid
-(defun numberofargs (x)
-  (setq x (system::arglist x))
-  (let ((nx (- (length x) (length (memq '&aux x)))))
-    (if (memq '&rest x) (setq nx (- (1- nx))))
-    (if (memq '&optional x) (setq nx (- (1- (abs nx)))))
-    nx))
-
 ; 98.0 Stuff Not In The VMLisp Manual That We Like
 
 ; A version of GET that works with lists
@@ -1603,9 +1585,6 @@
   (read-line st nil eofval))
 
 (defun gcmsg (x)
-  #+Lucid
-  (prog1 (not system::*gc-silence*) 
-    (setq system::*gc-silence* (not x)))
   #+(OR IBCL KCL)
   (prog1 system:*gbc-message* 
     (setq system:*gbc-message* x))
@@ -1615,13 +1594,6 @@
   )
 
 (defun bpiname (func)
-  #+Lucid (if (functionp func)
-	      (if (symbolp func) func
-		(let ((name (svref func 0)))
-		  (if (and (consp name) (eq (car name) 'SYSTEM::NAMED-LAMBDA))
-		      (cadr name)
-		    name))))
-
   #+(OR IBCL KCL) (if (functionp func)
 		      (cond ((symbolp func) func)
 			    ((and (consp func) (eq (car func) 'LAMBDA-BLOCK))
@@ -1639,7 +1611,6 @@
 		 (system::%primitive header-ref func
 				     system::%function-name-slot))
 		('else func)))
-  #+:allegro func
   #+(or :SBCL :clisp :ecl :clozure) (if (symbolp func)
 			       func
 			     (multiple-value-bind (l c n)