* Variable *EVAL-WHEN-COMPILE* is no longer used.

* FIND-CLASS belongs to the C library -- it can now be directly called.
* Class BUILT-IN renamed to BUILT-IN-CLASS
* Macro PROG1 slightly optimized

src/c/all_functions.d

@@ -127,6 +127,9 @@ const struct function_info all_functions[] = {
 	{"CHAR-NAME", clLchar_name, cl},
 	{"NAME-CHAR", clLname_char, cl},
 
+	/* clos.c */
+	{"FIND-CLASS", clLfind_class, cl},
+
 	/* cmpaux.c */
 
 	{"SPECIALP", siLspecialp, si},

src/c/all_symbols.d

@@ -47,7 +47,7 @@ const struct symbol_info all_symbols[] = {
 #ifdef CLOS
 {&siVclass_name_hash_table, "*CLASS-NAME-HASH-TABLE*", SI_SPECIAL},
 {&clSclass, "CLASS", CL_ORDINARY},
-{&clSbuilt_in, "BUILT-IN", CL_ORDINARY},
+{&clSbuilt_in_class, "BUILT-IN-CLASS", CL_ORDINARY},
 #endif
 
 /* compiler.c */

src/c/alloc_2.d

@@ -112,7 +112,7 @@ cl_alloc_atomic(cl_index n)
 void
 cl_dealloc(void *p, cl_index s)
 {
-	GC_free(p);	
+	/* GC_free(p); */
 }
 
 /*

src/c/clos.d

@@ -20,7 +20,7 @@
 cl_object class_class, class_object, class_built_in;
 cl_object @'si::*class-name-hash-table*';
 cl_object @'class';
-cl_object @'built-in';
+cl_object @'built-in-class';
 
 /******************************* ------- ******************************/
 
@@ -56,11 +56,22 @@ make_our_hash_table(cl_object test, int size)
 	return(h);
 }
 
+@(defun find-class (name &optional (errorp Ct) env)
+	cl_object class;
+@
+	class = gethash_safe(name, SYM_VAL(@'si::*class-name-hash-table*'), Cnil);
+	if (class == Cnil) {
+		if (!Null(errorp))
+			FEerror("No class named ~S.", 1, name);
+	}
+	@(return class)
+@)	
+
 static void
 clos_boot(void)
 {
 
-	SYM_VAL(siVclass_name_hash_table) = make_our_hash_table(@'eq', 1024);
+	SYM_VAL(@'si::*class-name-hash-table*') = make_our_hash_table(@'eq', 1024);
 
 	/* booting Class CLASS */
 	
@@ -72,19 +83,19 @@ clos_boot(void)
 	CLASS_INFERIORS(class_class) = Cnil;
 	CLASS_SLOTS(class_class) = OBJNULL;	/* filled later */
 
-	sethash(@'class', SYM_VAL(siVclass_name_hash_table), class_class);
+	sethash(@'class', SYM_VAL(@'si::*class-name-hash-table*'), class_class);
 
-	/* booting Class BUILT-IN */
+	/* booting Class BUILT-IN-CLASS */
 	
   	class_built_in = cl_alloc_instance(4);
 	register_root(&class_built_in);
 	CLASS_OF(class_built_in) = class_class;
-	CLASS_NAME(class_built_in) = @'built-in';
+	CLASS_NAME(class_built_in) = @'built-in-class';
 	CLASS_SUPERIORS(class_built_in) = CONS(class_class, Cnil);
 	CLASS_INFERIORS(class_built_in) = Cnil;
 	CLASS_SLOTS(class_built_in) = OBJNULL;	/* filled later */
 
-	sethash(@'built-in', SYM_VAL(siVclass_name_hash_table), class_built_in);
+	sethash(@'built-in-class', SYM_VAL(@'si::*class-name-hash-table*'), class_built_in);
 
 	/* booting Class T (= OBJECT) */
 	
@@ -96,7 +107,7 @@ clos_boot(void)
 	CLASS_INFERIORS(class_object) = CONS(class_class, Cnil);
 	CLASS_SLOTS(class_object) = Cnil;
 
-	sethash(Ct, SYM_VAL(siVclass_name_hash_table), class_object);
+	sethash(Ct, SYM_VAL(@'si::*class-name-hash-table*'), class_object);
 
 	/* complete now Class CLASS */
 	CLASS_SUPERIORS(class_class) = CONS(class_object, Cnil);
@@ -106,7 +117,7 @@ clos_boot(void)
 void
 init_clos(void)
 {
-	SYM_VAL(siVclass_name_hash_table) = OBJNULL;
+	SYM_VAL(@'si::*class-name-hash-table*') = OBJNULL;
 
 	clos_boot();
 }

src/clos/boot.lsp

@@ -14,7 +14,7 @@
 
 (defun boot ()
   (let ((class (find-class 'class))
-	(built-in (find-class 'built-in)))
+	(built-in-class (find-class 'built-in-class)))
 
     ;; class CLASS	--------
     (setf (class-slots class)
@@ -56,25 +56,25 @@
       (or supplied-superclasses
 	  (list (find-class 't))))
 
-    ;; class BUILT-IN	--------
-    (setf (class-slots built-in)
+    ;; class BUILT-IN-CLASS	--------
+    (setf (class-slots built-in-class)
 	  (parse-slots '((NAME :INITARG :NAME :INITFORM NIL)
 			       (SUPERIORS :INITARG :DIRECT-SUPERCLASSES)
 			       (INFERIORS :INITFORM NIL)
 			       (SLOTS :INITARG :SLOTS))))
 
-    (defmethod slot-value ((self built-in) slot)
+    (defmethod slot-value ((self built-in-class) slot)
       (let ((position (position slot (class-slots (si:instance-class self))
 				:key #'slotd-name)))
 	(if position
 	    (si:instance-ref self position)
 	    (slot-missing (si:instance-class self) self slot 'slot-value))))
 
-    (defmethod make-instance ((class built-in) &rest initargs)
+    (defmethod make-instance ((class built-in-class) &rest initargs)
       (declare (ignore initargs))
       (error "The built-in class (~A) cannot be instantiated" class))
 
-    (defmethod initialize-instance ((class built-in)
+    (defmethod initialize-instance ((class built-in-class)
 				    &rest initargs &key &allow-other-keys)
 
 	(call-next-method)		; from class T
@@ -87,7 +87,7 @@
 	  (push class (class-inferiors s)))
 	class)
 
-    (defmethod print-object ((class built-in) stream)
+    (defmethod print-object ((class built-in-class) stream)
       (print-unreadable-object
        (class stream)
        (format stream "The ~A ~A" (class-name (si:instance-class class))

src/clos/builtin.lsp

@@ -57,7 +57,7 @@
 
 (eval-when (compile load eval)
   (mapcar #'(lambda (args &aux (class (first args)) (super (cdr args)))
-	      (eval `(defclass ,class ,super () (:metaclass built-in))))
+	      (eval `(defclass ,class ,super () (:metaclass built-in-class))))
 	  '(;(t object)
 	    (sequence t)
 	      (list sequence)
@@ -96,10 +96,10 @@
 ;;; Now we protect classes from redefinition:
 (defun setf-find-class (name new-value)
   (cond
-   ((typep (find-class name nil) 'built-in)
+   ((typep (find-class name nil) 'built-in-class)
     (error "The class associated to the CL specifier ~S cannot be changed."
 	   name))
-   ((member name '(CLASS BUILT-IN) :test #'eq)
+   ((member name '(CLASS BUILT-IN-CLASS) :test #'eq)
     (error "The kernel CLOS class ~S cannot be changed." name))
    ((classp new-value)
     (setf (gethash name si:*class-name-hash-table*) new-value))

src/clos/macros.lsp

@@ -45,13 +45,6 @@
 ;(defvar *class-name-hash-table* (make-hash-table :test #'eq)
 ; "The hash table containing all classes")
 
-(defun find-class (name &optional (errorp t) environment)
-  (declare (ignore environment))
-  (let ((class (gethash name si:*class-name-hash-table*)))
-    (cond (class class)
-	  (errorp (error "No class named ~S." name))
-	  (t nil))))
-
 ;;; This is only used during boot. The real one is in built-in.
 (defun setf-find-class (name new-value)
   (if (classp new-value)
@@ -109,20 +102,3 @@
 ;;; a variable declared of type standard-class.
 (defmacro slot-index-table (a-standard-class)
   `(the hash-table (si:instance-ref ,a-standard-class 5)))
-
-;;; ----------------------------------------------------------------------
-;;; Low level printing
-;;;
-
-(defun set-function-name (fn new-name)
-  (cond ((compiled-function-p fn)
-	 (si::set-compiled-function-name fn new-name))
-	((and (listp fn)
-	      (eq (car fn) 'LAMBDA-BLOCK))
-	 (setf (cadr fn) new-name))
-	((and (listp fn)
-	      (eq (car fn) 'LAMBDA))
-	 (setf (car fn) 'LAMBDA-BLOCK
-	       (cdr fn) (cons new-name (cdr fn)))))
-  fn)
-

src/doc/user.txi

@@ -2453,12 +2453,6 @@ open-coded in-line.  To control runtime error checking, supply appropriate
 The @ecl{} compiler processes the @code{eval-when} special form exactly as
 specified in @bibcite{Steele:84} (see Section 5.3.3 of @bibcite{Steele:84}).
 
-Notice that KCL and AKCL instead behave differently from the @clisp{}
-specification, since they normally process all top-level forms in
-@emph{compile-time-too} mode.  If it is desired that each top-level form be
-processed in @emph{compile-time-too} mode, set the value of the @ecl{}
-specific variable @code{*eval-when-compiler*} to @true{}.
-
 The @ecl{} compiler is invoked by the functions @code{compile-file},
 @code{compile}, and @code{disassemble} described below.  In addition, the
 @ecl{} compiler may be invoked directly by the Shell commands @code{ecl}.
@@ -2590,13 +2584,6 @@ intermediate data-file is specified by the keyword parameter @kwd{data-file}.
 
 @end defun
 
-@defvar {*eval-when-compile*}
-The compiler processes each top-level form in @dfn{not-compile-time} mode if
-the value of this variable is @nil{}, and in @dfn{compile-time-too} mode,
-otherwise.  See Section 5.3.3 of @bibcite{Steele:84} for these two modes.  The
-initial value of this variable is @nil{}.
-@end defvar
-
 
 @node Declarations, OS interface, The compiler, Top
 @chapter Declarations
@@ -3973,8 +3960,6 @@ that case @code{suspend} will return the values specified by @code{resume}.
 @end defvar
 @defvar {*error-output*}
 @end defvar
-@defvar {*eval-when-compile*}
-@end defvar
 @defvar {*evalhook*}
 @end defvar
 @defvar {*features*}

src/h/lisp_external.h

@@ -132,7 +132,8 @@ extern cl_object clLname_char _ARGS((int narg, cl_object s));
 #ifdef CLOS
 extern cl_object siVclass_name_hash_table;
 extern cl_object clSclass;
-extern cl_object clSbuilt_in;
+extern cl_object clSbuilt_in_class;
+extern cl_object clLfind_class _ARGS((int narg, cl_object name, ...));
 #endif
 
 /* cmpaux.c */

src/lsp/evalmacros.lsp

@@ -258,9 +258,10 @@ to NIL) sequentially, and executes STATEMENTs.  Returns NIL."
 (defmacro prog1 (first &rest body &aux (sym (gensym)))
   "Syntax: (prog1 first-form {form}*)
 Evaluates FIRST-FORM and FORMs in order.  Returns the value of FIRST-FORM."
+  (if (null body) first
   `(LET ((,sym ,first))
 ;    (DECLARE (:READ-ONLY ,sym)) ; Beppe
-    ,@body ,sym))
+    ,@body ,sym)))
 
 (defmacro prog2 (first second &rest body &aux (sym (gensym)))
   "Syntax: (prog2 first-form second-form {forms}*)

src/lsp/export.lsp

@@ -299,8 +299,6 @@
 	  space
 	  safety
 	  compilation-speed
-
-	  *eval-when-compile*
 	  ))
 
 (si::select-package "SI")
@@ -391,7 +389,6 @@
 	  define-method-combination
 	  defmethod
 	  ensure-generic-function
-	  find-class
 	  find-method
 	  generic-flet
 	  generic-function
@@ -427,7 +424,7 @@
 	  with-slots
 
 	  class
-	  built-in
+	  built-in-class
 	  standard-class
 	  standard-generic-function
 	  standard-method

src/lsp/predlib.lsp

@@ -340,11 +340,6 @@ Returns T if X belongs to TYPE; NIL otherwise."
 	 t)
 	(t nil)))
 
-;;; Dummy version before CLOS is loaded
-#+(and clos ecl-min)
-(unless (fboundp 'sys::fpp)
-  (defun find-class (n &optional err env) (declare (ignore n err env)) nil))
-
 ;;; SUBTYPEP predicate.
 (defun subtypep (type1 type2 &aux t1 t2 i1 i2 ntp1 ntp2 c1 c2)
   "Args: (type1 type2)