diff --git a/Makefile.defs b/Makefile.defs
index 119a0fb1b4852bdcc245c78e0254cb740ced2940..64b7431aa305d7d27fc423d47fe7c84814b47d90 100644
--- a/Makefile.defs
+++ b/Makefile.defs
@@ -9,35 +9,6 @@ SHARED_EXT = so
 LISP	= ../src/lispi$(exe)
 DCL	= dcli
 
-# Set the case mode when building and dumping an image
-# case_mode:
-#	ansi -- traditional case-insensitive upper-case CL
-#	modern -- case-sensitive lower-case CL
-case_mode = modern
-
-ifeq ($(case_mode),ansi)
-CASE_MODE		= :case-insensitive-upper
-endif
-
-ifeq ($(case_mode),modern)
-CASE_MODE		= :case-sensitive-lower
-endif
-
-ifndef CASE_MODE
-..........................case_mode not defined or bad value...................
-endif
-
-# This controls whether patches are loaded before dumping an image.
-# They should be loaded except during development
-# load_patches:
-#	yes -- load them
-#	no -- don't load
-load_patches = yes
-
-ifeq ($(load_patches),no)
-STOP_PATCHES = '(pushnew :clim-dont-load-patches *features*)'
-endif
-
 CL	= $(LISP) -I $(DCL)
 CLOPTS	= -qq -batch -backtrace-on-error -locale japan.euc
 
@@ -73,10 +44,6 @@ endif
 # Used for tags
 ALL_SRC = *.lisp */*.lisp *.cl */*.cl *.c */*.c *.h */*.h
 
-# These are the files that make up the source code product.
-PRODUCT_SRC_FILES = sys/*.lisp utils/*.lisp  silica/*.lisp clim/*.lisp \
-	demo/*.lisp test/test-suite.lisp
-
 ifneq ($(OS_NAME),windows)
 # This has to be kept consistent with xlib/xlib-funs.lisp
 UNDEFS=misc/undefinedsymbols
diff --git a/Makefile.generic b/Makefile.generic
index 5872eb9795f8cf1eabe28a023af35ec6a779287b..4a52d157676790ef90fcb26d4b95662c247a112e 100644
--- a/Makefile.generic
+++ b/Makefile.generic
@@ -18,8 +18,6 @@ compile: FORCE $(PRODUCT-OBJS) $(ICS-PRODUCT-OBJS) $(compile_depends)
 	echo '(setq sys::*libxt-pathname* "$(XTLIB)")' >> build.tmp
 	echo '(setq sys::*libx11-pathname* "$(XLIB)")' >> build.tmp
 	echo '(setq sys::*libwnn-pathname* "$(WNNLIB)")' >> build.tmp
-	echo '(excl:set-case-mode $(CASE_MODE))' >> build.tmp
-	echo $(STOP_PATCHES) >> build.tmp
 	echo '(load "misc/compile-1.lisp")' >> build.tmp
 	echo '(declaim (optimize (speed $(SPEED)) (debug $(DEBUG)) (safety $(SAFETY))))' >> build.tmp
 	echo '(setq *compile-print* $(compile_print))' >> build.tmp
@@ -204,9 +202,6 @@ install_obj:
 install_clim: install_obj
 	cp $(PRODUCT-FASLS) $(ICS-PRODUCT-FASLS) $(DEST)
 
-echo_src_files:
-	@echo $(PRODUCT_SRC_FILES)
-
 include Makefile.cobjs
 
 include Makefile.wnn
diff --git a/aclpc/acl-frames.lisp b/aclpc/acl-frames.lisp
index ffd2db2809708f2ba3fdc992e5ca08608934d3b6..5f6717bff6f8fbe8ef2603ded5703e4d22f8b194 100644
--- a/aclpc/acl-frames.lisp
+++ b/aclpc/acl-frames.lisp
@@ -288,7 +288,7 @@
   (setf (aref stringvar newlen) #\null)
   (setf (fill-pointer stringvar) newlen))
 
-(eval-when (compile load eval)
+(eval-when (:compile-toplevel :load-toplevel :execute)
   (defconstant *nstringify-buffer-default-size* 2048)
   (defvar nstringify-buffer 
       (make-array *nstringify-buffer-default-size* :fill-pointer t 
@@ -1127,7 +1127,7 @@ to be run from another."
 	    (car dotted-pair) (cdr dotted-pair) (code-char 0)
 	    (cdr dotted-pair) (code-char 0))))
 
-(eval-when (compile load eval) 
+(eval-when (:compile-toplevel :load-toplevel :execute)
   ;; All pathnames returned by SELECT-FILE must fit in the scratch string,
   ;; so make it pretty big.
   (defconstant *scratch-string-length* 2048)
@@ -1139,7 +1139,7 @@ to be run from another."
 (defparameter *scratch-c-string*
   (ff:allocate-fobject-c `(:array :char ,*scratch-string-length*)))
 
-(eval-when (compile eval load)
+(eval-when (:compile-toplevel :execute :load-toplevel)
   ;; this type useful since we don't open code anonymous types well yet:
   (ff:def-foreign-type foreign-string (:array :char 1))
   )
diff --git a/aclpc/acl-medium.lisp b/aclpc/acl-medium.lisp
index ff4a20ee98f7d46970fc84dfc810e3ee503c8f20..52c19ebd54ddfca797b1a00ced53fd78082a7f54 100644
--- a/aclpc/acl-medium.lisp
+++ b/aclpc/acl-medium.lisp
@@ -155,15 +155,12 @@
   (color-rgb (wincolor->color (win:GetSysColor win:COLOR_BTNFACE))))
 
 (defmethod dc-image-for-ink ((medium acl-medium) (ink (eql +foreground-ink+)))
-  (declare (values image created-bitmap created-mask-bitmap))
   (dc-image-for-ink medium (medium-foreground medium)))
 
 (defmethod dc-image-for-ink ((medium acl-medium) (ink (eql +background-ink+)))
-  (declare (values image created-bitmap created-mask-bitmap))
   (dc-image-for-ink medium (medium-background medium)))
 
 (defmethod dc-image-for-ink ((medium acl-medium) (ink t))
-  (declare (values image created-bitmap created-mask-bitmap))
   ;; Don't blow out if somebody tries to use a fancy ink like compose-in.
   (dc-image-for-ink medium (medium-foreground medium)))
 
@@ -209,7 +206,6 @@
 			(convert blue))))))
 
 (defmethod dc-image-for-ink ((medium acl-medium) (ink color))
-  (declare (values image created-bitmap created-mask-bitmap))
   (let ((cache (port-dc-cache (port medium))))
     (or (gethash ink cache)
 	(setf (gethash ink cache)
@@ -235,17 +231,14 @@
   *blank-image*)
 
 (defmethod dc-image-for-ink ((medium acl-medium) (ink (eql +everywhere+)))
-  (declare (values image created-bitmap created-mask-bitmap))
   (dc-image-for-ink medium +foreground-ink+))
 
 (defmethod dc-image-for-ink ((medium acl-medium) (ink standard-opacity))
-  (declare (values image created-bitmap created-mask-bitmap))
   (if (>= (opacity-value ink) 0.5)
     (dc-image-for-ink medium +foreground-ink+)
     *blank-image*))
 
 (defmethod dc-image-for-ink ((medium acl-medium) (ink region))
-  (declare (values image created-bitmap created-mask-bitmap))
   (dc-image-for-ink medium +foreground-ink+))
 
 ;;; ink for patterns, tiles, etc
@@ -439,7 +432,6 @@
        (color->wincolor (elt designs tcolor))))))
 
 (defmethod dc-image-for-ink ((medium acl-medium) (ink pattern))
-  (declare (values image created-bitmap created-mask-bitmap))
   ;; The "pattern" part of the ink is put into the brush.
   ;; This will return a list of two DCs if one of the inks is transparent.
   (let ((cache (port-dc-cache (port medium))))
@@ -506,7 +498,6 @@ draw icons and mouse cursors on the screen.
 |#
 
 (defmethod dc-image-for-ink ((medium acl-medium) (ink rectangular-tile))
-  (declare (values image created-bitmap created-mask-bitmap))
   ;; The only case we handle right now is stipples
   (let ((cache (port-dc-cache (port medium))))
     (or (gethash ink cache)
@@ -541,7 +532,6 @@ draw icons and mouse cursors on the screen.
   (error "This NT CLIM operation is NYI (Not Yet Implemented)."))
 
 (defmethod dc-image-for-ink ((medium acl-medium) (ink flipping-ink))
-  (declare (values image created-bitmap created-mask-bitmap))
   (let ((cache (port-dc-cache (port medium))))
     (or (gethash ink cache)
 	(setf (gethash ink cache)
@@ -565,7 +555,6 @@ draw icons and mouse cursors on the screen.
 			       :background-color nil))))))))
 
 (defmethod dc-image-for-ink ((medium acl-medium) (ink contrasting-ink))
-  (declare (values image created-bitmap created-mask-bitmap))
   (dc-image-for-ink medium (make-color-for-contrasting-ink ink)))
 
 (defmethod dc-image-for-ink ((medium acl-medium) (ink composite-out))
@@ -1819,7 +1808,7 @@ device-independent bitmap, an icon, nor a cursor."))
     (setf (gethash "magenta" table) +magenta+)
     table))
 
-(eval-when (load eval)
+(eval-when (:load-toplevel :execute)
   (initialize-named-colors))
 
 (defun clim-internals::kana-process-gesture (istream gesture type)
diff --git a/aclpc/acl-scroll.lisp b/aclpc/acl-scroll.lisp
index 208a21932d30b5886339e7e36b3b9ee703ab350f..3775d441dd2b820dd492889e4a4eb32108800c2d 100644
--- a/aclpc/acl-scroll.lisp
+++ b/aclpc/acl-scroll.lisp
@@ -16,7 +16,7 @@
 
 (in-package :silica)
 
-(eval-when (compile load eval)
+(eval-when (:compile-toplevel :load-toplevel :execute)
   (define-event-class scrollbar-event (event) 
     ((sheet :reader event-sheet :initarg :sheet)
      (orientation :initarg :orientation :reader scrollbar-event-orientation)
@@ -474,7 +474,7 @@
     (resize-sheet child nwidth nheight)	;;; get the viewport sized correctly!
     (allocate-space child nwidth nheight)))
 
-(eval-when (compile load eval) 
+(eval-when (:compile-toplevel :load-toplevel :execute)
   ;; Turn this on as long as it gets turned off in pkgdcl.lisp
   (setq excl:*enable-package-locked-errors* common-lisp-user::*lock-preference*)
   (provide :climnt))
diff --git a/aclpc/acl-widget.lisp b/aclpc/acl-widget.lisp
index 561e98728289e7cf6f2b9f13b26c5002c4414d58..9932990ed510be071d7a6e390d8100519dd61ce0 100644
--- a/aclpc/acl-widget.lisp
+++ b/aclpc/acl-widget.lisp
@@ -486,7 +486,6 @@
 ;;; Retreive the start and end position of the
 ;;; selection in a mswin-text-edit gadget.
 (defmethod get-selection ((pane mswin-text-edit)) 
-  (declare (values startpos endpos))
   (let ((mirror (sheet-direct-mirror pane)))
     (cond (mirror
            (let ((startptr
diff --git a/aclpc/pkgdcl.lisp b/aclpc/pkgdcl.lisp
index 1882e804161af2abeef6d776243eaba4a003f101..f429f76f3f569d8f5df4ba8cb6dcd42b84784794 100644
--- a/aclpc/pkgdcl.lisp
+++ b/aclpc/pkgdcl.lisp
@@ -15,7 +15,7 @@
     #-(and mswindows 64bit) t)
 
 ;; Invite everybody to the party.
-(eval-when (compile load eval)
+(eval-when (:compile-toplevel :load-toplevel :execute)
   (require :climg)
   ;; [rfe4951]: not needed anymore:
   ;; (require :ffcompat)
@@ -48,7 +48,7 @@
    #:make-windows-font-named		;make a windows font from a name
    ))
  
-(eval-when (compile load eval)
+(eval-when (:compile-toplevel :load-toplevel :execute)
   (pushnew :aclmerge *features*)
   (pushnew :os-threads *features*))
 
diff --git a/clim/accept-values.lisp b/clim/accept-values.lisp
index 37d12877ebcb57ff05414a4cd52e18d2d18c76a6..e59d12ecc9b680cc446b0b05fe5abfccf4708a68 100644
--- a/clim/accept-values.lisp
+++ b/clim/accept-values.lisp
@@ -28,7 +28,6 @@
   (:default-initargs :query-table (make-hash-table :test #'equal)))
 
 (defmethod find-query ((record accept-values-output-record) query-identifier)
-  (declare (values query found-p))
   (gethash query-identifier (slot-value record 'query-table)))
 
 ;; We are in control of the AVV code, and we know that there is only 1 AVV
@@ -1144,12 +1143,6 @@
                                                                                                                  &body body &environment env)
   #+Genera (declare (zwei:indentation 1 3 2 1))
   #-(or Genera Minima) (declare (ignore env))
-  #-acl3.0 ; temporary restriction?
-  (declare (arglist ((&optional stream 
-                                &key documentation query-identifier
-                                (cache-value t) (cache-test #'eql)
-                                view resynchronize)
-                     prompt &body body)))
   (default-input-stream stream accept-values-command-button)
   (with-keywords-removed (options options '(:view))
     (let ((constant-prompt-p
diff --git a/clim/accept.lisp b/clim/accept.lisp
index 930240259a31ddc25ebf81fde5071194a2b9ce46..38c526e02c102eac4c184af6958d22738dc708bf 100644
--- a/clim/accept.lisp
+++ b/clim/accept.lisp
@@ -24,7 +24,6 @@
                (insert-default nil) (replace-input t)
                (present-p nil) (active-p t))
   (declare (dynamic-extent accept-args))
-  (declare (values object type))
   (declare (ignore prompt-mode display-default
 		   activation-gestures additional-activation-gestures
 		   delimiter-gestures additional-delimiter-gestures 
@@ -336,7 +335,6 @@
 				(delimiter-gestures nil delimiter-gestures-p)
 				(additional-delimiter-gestures nil)
 				(start 0) (end nil))
-  (declare (values object type index))
 
   ;; Allow the arguments to be presentation type abbreviations
   (multiple-value-bind (expansion expanded)
diff --git a/clim/basic-translators.lisp b/clim/basic-translators.lisp
index 6ba5a75e4deb3e865900916ea02e811326398c09..b6a2a94f6d0b280ff08237a2d4e9581376121116 100644
--- a/clim/basic-translators.lisp
+++ b/clim/basic-translators.lisp
@@ -43,7 +43,7 @@
                (presentation-subtypep-1 type-name context-name)
                (presentation-typep object context-type))))))))
 
-(eval-when (compile eval load)
+(eval-when (:compile-toplevel :execute :load-toplevel)
   ;; Only the PRESENTATION-MENU translator lives in this
   (unless (find-command-table 'presentation-menu-command-table :errorp nil)
     (make-command-table 'presentation-menu-command-table :inherit-from nil))
diff --git a/clim/clim-defs.lisp b/clim/clim-defs.lisp
index c1048995b60e6d88a6cfca93e8414904c8647fd6..0916b7e66ff894f286f8ba4d31c7b6f03eafb693 100644
--- a/clim/clim-defs.lisp
+++ b/clim/clim-defs.lisp
@@ -88,7 +88,7 @@
            ,(if record-supplied record `(stream-recording-p ,new-stream))
            ,(if draw-supplied draw `(stream-drawing-p ,new-stream)))))))
 
-(eval-when (compile eval load)
+(eval-when (:compile-toplevel :execute :load-toplevel)
 (defvar *output-record-constructor-cache* (make-hash-table))
 
 (defmacro construct-output-record (type &rest initargs &environment env)
@@ -292,8 +292,7 @@
             &key partial-completers allow-any-input
                  possibility-printer (help-displays-possibilities t)) 
            &body body)
-  (declare (values object success string nmatches)
-           (ignore allow-any-input possibility-printer help-displays-possibilities))
+  (declare (ignore allow-any-input possibility-printer help-displays-possibilities))
   #+Genera (declare (zwei:indentation 0 3 1 1))
   (let ((string '#:string)
         (action '#:action))
@@ -345,14 +344,6 @@
 
 ;;; From ACCEPTING-VALUES.LISP
 (defmacro accepting-values ((&optional stream &rest args) &body body)
-  (declare (arglist (&optional stream
-                     &key frame-class command-table own-window
-                          background foreground text-style
-                          exit-boxes resize-frame align-prompts
-                          initially-select-query-identifier modify-initial-query
-                          resynchronize-every-pass (check-overlapping t)
-                          label x-position y-position width height (scroll-bars nil))
-                    &body body))
   #+Genera (declare (zwei:indentation 0 3 1 1))
   (default-input-stream stream accepting-values)
   `(flet ((accepting-values-body (,stream) ,@body))
diff --git a/clim/command.lisp b/clim/command.lisp
index 81c1ae43012a48c743013dbe9fe722ad60a031a9..3d0b31dbea86585ee6bb6b83ecc572de4eb8c54d 100644
--- a/clim/command.lisp
+++ b/clim/command.lisp
@@ -313,7 +313,6 @@
   (gethash command-name (slot-value command-table 'commands)))
 
 (defun command-accessible-in-command-table-p (command-name command-table)
-  (declare (values command-table))
   (do-command-table-inheritance (comtab command-table)
     (when (command-present-in-command-table-p command-name comtab)
       (return-from command-accessible-in-command-table-p comtab)))
@@ -385,7 +384,6 @@
          (slot-value (find-command-table command-table) 'command-line-names))))
 
 (defun find-command-from-command-line-name (name command-table &key (errorp t))
-  (declare (values command command-table))
   (do-command-table-inheritance (comtab command-table)
     ;;--- Use binary search on COMMAND-LINE-NAMES (completion aarrays)
     (let ((item (find name (slot-value comtab 'command-line-names)
@@ -549,7 +547,6 @@
        (slot-value (find-command-table command-table) 'menu)))
 
 (defun find-menu-item (menu-name command-table &key (errorp t))
-  (declare (values menu-item command-table))
   (let* ((command-table (find-command-table command-table))
          (item (find menu-name (slot-value command-table 'menu)
                      :test #'menu-name-equal :key #'first)))
@@ -786,7 +783,6 @@
 
 (defun find-keystroke-item (keystroke command-table
                             &key (test #'keyboard-event-matches-gesture-name-p) (errorp t))
-  (declare (values menu-item command-table))
   (let* ((command-table (find-command-table command-table))
          (entry (block find-entry
                   ;; Do it the hard way so that GESTURE-SPEC-EQL doesn't see NILs
@@ -805,7 +801,6 @@
 
 (defun lookup-keystroke-item (keystroke command-table
                               &key (test #'keyboard-event-matches-gesture-name-p))
-  (declare (values menu-item command-table))
   (labels ((map-menu (command-table)
              (map nil #'(lambda (entry)
                           (let ((item (third entry)))
@@ -919,7 +914,6 @@
           (funcall function translator))))))
 
 (defun find-presentation-translator (translator-name command-table &key (errorp t))
-  (declare (values command command-table))
   (when (presentation-translator-p translator-name)
     (setq translator-name (presentation-translator-name translator-name)))
   (do-command-table-inheritance (comtab command-table)
@@ -1178,7 +1172,6 @@
 (defvar *define-command-options* '(:command-table :name :menu :keystroke))
 
 (defun decode-name-and-options (name-and-options &optional command-table-name)
-  (declare (values command-name command-options))
   (if (symbolp name-and-options)
       (values name-and-options nil)
     (let ((name (first name-and-options))
diff --git a/clim/completer.lisp b/clim/completer.lisp
index f99face190d38a3cf7adb039a812afbe6af9586e..a8a0ee790a51f6de2499380e656a70a4c6b4471f 100644
--- a/clim/completer.lisp
+++ b/clim/completer.lisp
@@ -44,7 +44,6 @@
                        &key partial-completers allow-any-input possibility-printer
                             (help-displays-possibilities t))
   (declare (dynamic-extent function))
-  (declare (values answer-object success string))
   (with-temporary-string (stuff-so-far :length 100 :adjustable t)
    (with-delimiter-gestures (partial-completers)
     (with-activation-gestures (*magic-completion-gestures*)
@@ -278,7 +277,6 @@
 (defun complete-from-possibilities (string completions delimiters
                                     &key (action :complete) predicate
                                          (name-key #'first) (value-key #'second))
-  (declare (values string success object nmatches possibilities))
   (when (and (not (eq action :possibilities))
              (not (eq action :apropos-possibilities))
              (zerop (length string)))
@@ -318,7 +316,6 @@
 ;; gotten by funcalling a generator rather than from a completion alist.
 (defun complete-from-generator (string generator delimiters
                                 &key (action :complete) predicate)
-  (declare (values string success object nmatches possibilities))
   (declare (dynamic-extent generator))
   (when (and (not (eq action :possibilities))
              (not (eq action :apropos-possibilities))
@@ -356,7 +353,6 @@
 (defun chunkwise-complete-string (string completion object action delimiters
                                   best-completion best-length best-object
                                   nmatches possibilities)
-  (declare (values best-completion best-length best-object nmatches possibilities))
   (let* ((length (length string))
          (matches (if (eq action :apropos-possibilities)
                       (if (search string completion :test #'char-equal) length 0)
@@ -408,7 +404,6 @@
 ;; where the strings mismatches and the index of the last character that was
 ;; unambiguous.  When MERGE-P, STRING1 gets side-effected.
 (defun chunkwise-string-compare (string1 string2 delimiters &optional merge-p end1)
-  (declare (values matched ambiguous))
   (let ((len1 (or end1 (length string1)))
         (len2 (length string2))
         (matched 0)
diff --git a/clim/cursor.lisp b/clim/cursor.lisp
index b105ce03354ba8535a3ec795a17a5b69ed0d430a..5fa958d14e39712338f7aca4ea54228765ae872a 100644
--- a/clim/cursor.lisp
+++ b/clim/cursor.lisp
@@ -51,15 +51,14 @@
     ;; cares?? --CIM
     (values x y (+ x width) (+ y width))))
 
-(defconstant cursor_active (byte 1 0))
-(defconstant cursor_state  (byte 1 1))
-(defconstant cursor_focus  (byte 1 2))
+(defparameter +cursor-active+ (byte 1 0))
+(defparameter +cursor-state+  (byte 1 1))
+(defparameter +cursor-focus+  (byte 1 2))
 
 (defun decode-cursor-flags (flags)
-  #+Genera (declare (values active state focus))
-  (values (ldb-test cursor_active flags)
-          (ldb-test cursor_state flags)
-          (ldb-test cursor_focus flags)))
+  (values (ldb-test +cursor-active+ flags)
+          (ldb-test +cursor-state+ flags)
+          (ldb-test +cursor-focus+ flags)))
 
 ;;; Required method
 (defmethod (setf cursor-stream) (new-value (cursor standard-text-cursor))
@@ -96,33 +95,33 @@
     (multiple-value-bind (active state focus)
         (decode-cursor-flags flags)
       (declare (ignore active focus))
-      (setf (ldb cursor_state flags) (if new-state 1 0))
+      (setf (ldb +cursor-state+ flags) (if new-state 1 0))
       (note-cursor-change cursor 'cursor-state state new-state))))
 
 (defmethod cursor-state ((cursor standard-text-cursor))
-  (ldb-test cursor_state (slot-value cursor 'flags)))
+  (ldb-test +cursor-state+ (slot-value cursor 'flags)))
 
 (defmethod (setf cursor-active) (new-active (cursor standard-text-cursor))
   (with-slots (flags) cursor
     (multiple-value-bind (active state focus)
         (decode-cursor-flags flags)
       (declare (ignore state focus))
-      (setf (ldb cursor_active flags) (if new-active 1 0))
+      (setf (ldb +cursor-active+ flags) (if new-active 1 0))
       (note-cursor-change cursor 'cursor-active active new-active))))
 
 (defmethod cursor-active ((cursor standard-text-cursor))
-  (ldb-test cursor_active (slot-value cursor 'flags)))
+  (ldb-test +cursor-active+ (slot-value cursor 'flags)))
 
 (defmethod (setf cursor-focus) (new-focus (cursor standard-text-cursor))
   (with-slots (flags) cursor
     (multiple-value-bind (active state focus)
         (decode-cursor-flags flags)
       (declare (ignore active state))
-      (setf (ldb cursor_focus flags) (if new-focus 1 0))
+      (setf (ldb +cursor-focus+ flags) (if new-focus 1 0))
       (note-cursor-change cursor 'cursor-focus focus new-focus))))
 
 (defmethod cursor-focus ((cursor standard-text-cursor))
-  (ldb-test cursor_focus (slot-value cursor 'flags)))
+  (ldb-test +cursor-focus+ (slot-value cursor 'flags)))
 
 (defmethod (setf cursor-color) (color (cursor standard-text-cursor))
   (with-slots (flipping-ink flags) cursor
diff --git a/clim/db-menu.lisp b/clim/db-menu.lisp
index ca1293c7e8060d3e137ddd5f8350be712b3259da..aef0faa9bfb8e110a54cd90c44a07a661c9f90ca 100644
--- a/clim/db-menu.lisp
+++ b/clim/db-menu.lisp
@@ -27,7 +27,7 @@
     ((next-menu :initform nil :initarg :next-menu)))
 
 ;;;#+(or aclpc acl86win32)
-;;;(eval-when (compile load eval)
+;;;(eval-when (:compile-toplevel :load-toplevel :execute)
 ;;;   ;;mm: 11Jan95 - this is defined later in  ???
 ;;;   (unless (ignore-errors (find-class 'pull-down-menu))
 ;;;      (defclass pull-down-menu () ())))
@@ -285,8 +285,10 @@
 				      (make-pane 'menu-bar-button-logic
 						 :label name
 						 :next-menu value)
-				    (error "not yet implemented")
-				    )))
+                                      (make-pane 'push-button
+                                                 :label name)
+                                      ;(error "not yet implemented")
+                                      )))
 			    (make-command-table-menu command-table))))
 	       (make-pane 'hbox-pane :contents buttons 
 			  :min-height 2 :height 2))))
diff --git a/clim/db-stream.lisp b/clim/db-stream.lisp
index 5d6c77e178524aec73ece0f817e20ca6f0632f21..0b454275dbd871b5aa9dddfa97560d4801fb01d8 100644
--- a/clim/db-stream.lisp
+++ b/clim/db-stream.lisp
@@ -137,7 +137,6 @@
     (setf display-time value)))
 
 (defmethod pane-needs-redisplay ((pane clim-stream-pane))
-  (declare (values needs-redisplay clear))
   (with-slots (display-time) pane
     (ecase display-time
       ((t)
@@ -379,7 +378,7 @@
   ()
   (:default-initargs :default-view +gadget-dialog-view+))
 
-(eval-when (compile)
+(eval-when (:compile-toplevel)
   ;; defined later in the compilation...
   (declaim (special *default-menu-text-style*))
   )
@@ -454,8 +453,10 @@
                                           :name name
                                           :thickness 1
                                           :contents pane
-                                          :background background)
-                     :background background)))
+                                          ;; :background background
+                                          )
+                     ;; :background background -- NOTE this actually should work!
+                     )))
       (values pane stream))))
 
 (defmacro make-clim-interactor-pane (&rest options)
diff --git a/clim/design-recording.lisp b/clim/design-recording.lisp
index 36ecc4c714df72954a4aedac4393f6b04b8dbc20..1e0f97b05b6107dc9922300a959e3c3ff8500213 100644
--- a/clim/design-recording.lisp
+++ b/clim/design-recording.lisp
@@ -28,9 +28,7 @@
       (map-over-output-records #'make-design record))
     (make-instance 'composite-over :designs (apply #'vector designs))))
 
-(defgeneric draw-design (design stream &rest args)
-  #-(or aclpc acl86win32) (declare (arglist design stream &key . #.(all-drawing-options-lambda-list nil))))
-
+(defgeneric draw-design (design stream &rest args))
 
 ;;; Simple composite designs
 (defmethod draw-design ((composite composite-over) stream &rest args)
diff --git a/clim/dragging-output.lisp b/clim/dragging-output.lisp
index e9d715c9f97d216670e1e71657b35029fdec7355..e1e5e95e7b51410210b99282e22e05aaaca3f823 100644
--- a/clim/dragging-output.lisp
+++ b/clim/dragging-output.lisp
@@ -26,7 +26,6 @@
                            &key (repaint t) multiple-window
                                 (erase #'erase-output-record erase-sp) feedback
                                 (finish-on-release *dragging-output-finish-on-release*))
-  (declare (values final-x final-y delta-x delta-y))
   (let (last-x last-y
         (delta-x 0)
         (delta-y 0)
diff --git a/clim/frames.lisp b/clim/frames.lisp
index 2ae4cc0b6ca0e7c039110ffca9c11f7bc18736c9..633e732914b0a02058ac9711b520608709c065d4 100644
--- a/clim/frames.lisp
+++ b/clim/frames.lisp
@@ -138,7 +138,7 @@
                                   (frame standard-application-frame))
   (adjust-layout-requirements frame (frame-current-layout frame)))
 
-(eval-when (compile load eval)
+(eval-when (:compile-toplevel :load-toplevel :execute)
 (defun define-application-frame-1 (name state-variables pane-descriptions
                                    &key top-level layouts
                                         command-table)
@@ -233,7 +233,7 @@
                                `',layout)))
                        layouts))))
       `(progn
-         (eval-when (compile)
+         (eval-when (:compile-toplevel)
            (when ',command-table
              (setf (compile-time-property ',(first command-table) 'command-table-name) t))
            (define-application-frame-1 ',name ',slots ,pane-constructors
@@ -907,69 +907,69 @@
 
 (defmethod default-frame-top-level ((frame standard-application-frame)
                                     &key command-parser command-unparser
-                                         partial-command-parser
-                                         (prompt "Command: "))
+                                      partial-command-parser
+                                      (prompt "Command: "))
   (unless (eq (frame-state frame) :enabled)
     (enable-frame frame))
   (loop
-    (let* ((*standard-output*
-	    (or (frame-standard-output frame) *standard-output*))
-	   (*standard-input*
-	    (or (frame-standard-input frame) *standard-input*))
-	   (*query-io*
-	    (or (frame-query-io frame) *query-io*))
-	   (*error-output*
-	    (or (frame-error-output frame) *error-output*))
-	   (*pointer-documentation-output*
-	    (frame-pointer-documentation-output frame))
-	   (interactor
-	    (not (null (find-frame-pane-of-type frame 'interactor-pane))))
-	   (*command-parser*
-	    (or command-parser
-		(if interactor
-		    #'command-line-command-parser
-		  #'menu-command-parser)))
-	   (*command-unparser*
-	    (or command-unparser
-		#'command-line-command-unparser))
-	   (*partial-command-parser*
-	    (or partial-command-parser
-		(if interactor
-		    #'command-line-read-remaining-arguments-for-partial-command
-		  #'menu-read-remaining-arguments-for-partial-command)))
-	   (command-stream
-	    ;;--- We have to ask the frame since we do not want to
-	    ;;--- just pick up a stream from the dynamic environment
-	    (let ((si (or (frame-standard-input frame)
-			  (frame-standard-output frame))))
-	      (typecase si
-		(output-protocol-mixin si)
-		(t (frame-top-level-sheet frame)))))
-	   (*avv-refreshed* nil))
-      ;; The read-eval-print loop for applications...
-      (letf-globally (((frame-actual-pointer-documentation-pane frame)
-		       *pointer-documentation-output*))
-	(loop
-	  ;; Redisplay all the panes
-	  (catch-abort-gestures ("Return to ~A command level" (frame-pretty-name frame))
-	    (redisplay-frame-panes frame)
-	    (when (not *avv-refreshed*) 
-	      ;;; This needs to happen after the 
-	      ;;; call to redisplay-frame-panes
-	      ;;; but only do it the first time.
-	      (force-refresh-avv-streams frame)
-	      (setq *avv-refreshed* t))
-	    (when interactor
-	      (fresh-line *standard-input*)
-	      (if (stringp prompt)
-		  (write-string prompt *standard-input*)
-		(funcall prompt *standard-input* frame)))
-	    (let ((command (read-frame-command frame :stream command-stream)))
-	      (when interactor
-		(terpri *standard-input*))
-	      ;; Need this check in case the user aborted out of a command menu
-	      (when command
-		(execute-frame-command frame command)))))))))
+     (let* ((*standard-output*
+             (or (frame-standard-output frame) *standard-output*))
+            (*standard-input*
+             (or (frame-standard-input frame) *standard-input*))
+            (*query-io*
+             (or (frame-query-io frame) *query-io*))
+            (*error-output*
+             (or (frame-error-output frame) *error-output*))
+            (*pointer-documentation-output*
+             (frame-pointer-documentation-output frame))
+            (interactor
+             (not (null (find-frame-pane-of-type frame 'interactor-pane))))
+            (*command-parser*
+             (or command-parser
+                 (if interactor
+                     #'command-line-command-parser
+                     #'menu-command-parser)))
+            (*command-unparser*
+             (or command-unparser
+                 #'command-line-command-unparser))
+            (*partial-command-parser*
+             (or partial-command-parser
+                 (if interactor
+                     #'command-line-read-remaining-arguments-for-partial-command
+                     #'menu-read-remaining-arguments-for-partial-command)))
+            (command-stream
+             ;;--- We have to ask the frame since we do not want to
+             ;;--- just pick up a stream from the dynamic environment
+             (let ((si (or (frame-standard-input frame)
+                           (frame-standard-output frame))))
+               (typecase si
+                 (output-protocol-mixin si)
+                 (t (frame-top-level-sheet frame)))))
+            (*avv-refreshed* nil))
+       ;; The read-eval-print loop for applications...
+       (letf-globally (((frame-actual-pointer-documentation-pane frame)
+                        *pointer-documentation-output*))
+         (loop
+            ;; Redisplay all the panes
+            (catch-abort-gestures ("Return to ~A command level" (frame-pretty-name frame))
+              (redisplay-frame-panes frame)
+              (when (not *avv-refreshed*) 
+;;; This needs to happen after the 
+;;; call to redisplay-frame-panes
+;;; but only do it the first time.
+                (force-refresh-avv-streams frame)
+                (setq *avv-refreshed* t))
+              (when interactor
+                (fresh-line *standard-input*)
+                (if (stringp prompt)
+                    (write-string prompt *standard-input*)
+                    (funcall prompt *standard-input* frame)))
+              (let ((command (read-frame-command frame :stream command-stream)))
+                (when interactor
+                  (terpri *standard-input*))
+                ;; Need this check in case the user aborted out of a command menu
+                (when command
+                  (execute-frame-command frame command)))))))))
 
 (defmethod force-refresh-avv-streams (frame)
   ;;; NOTE:  Not using get-frame-pane-to-avv-stream-table.
@@ -1278,7 +1278,10 @@
      (re-enable-menu-items ,frame)))
 
 (defmethod execute-frame-command ((frame standard-application-frame) command)
-  (apply (command-name command) (command-arguments command))
+  ;; NOTE WORKAROUND added a when clause because demo sometimes passes :timeout
+  ;; as `command', which is obviously not a list. -- jacek.zlydach, 2017-05-14
+  (when (listp command)
+    (apply (command-name command) (command-arguments command)))
   #+ignore ;; from jeff on 4/8/99
   (with-menu-disabled frame
     (apply (command-name command) (command-arguments command))))
@@ -1370,7 +1373,7 @@
   (process-command-event sheet event))
 
 ;;;#+(or aclpc acl86win32)
-;;;(eval-when (compile load eval)
+;;;(eval-when (:compile-toplevel :load-toplevel :execute)
 ;;;   ;;mm: 11Jan95 - this is defined later in  ???
 ;;;   (unless (ignore-errors (find-class 'activity-frame))
 ;;;      (defclass activity-frame () ())))
@@ -1489,13 +1492,18 @@
 
 (defun find-frame-pane-of-type (frame type)
   (map-over-sheets #'(lambda (sheet)
-                       (when (typep sheet type)
-                         (return-from find-frame-pane-of-type sheet)))
-                   (frame-top-level-sheet frame)))
+                        (when (typep sheet type)
+                          (return-from find-frame-pane-of-type sheet)))
+                          (frame-top-level-sheet frame)))
 
 (defmethod frame-standard-output ((frame standard-application-frame))
-  (if (not (member '*standard-output* (slot-value frame 
-						  'non-frame-stream-names)))
+  ;; NOTE WORKAROUND returning `*standard-output*' instead of executing the following block,
+  ;; because the value found by it (during initialization of the demo) causes a "app pane not a stream"
+  ;; error.
+  *standard-output*
+  ;; commented out because it causes frame-not-a-stream error
+  #+nil(if (not (member '*standard-output* (slot-value frame 
+                                                  'non-frame-stream-names)))
       (or 
        (find-frame-pane-of-type frame 'application-pane)
        (find-frame-pane-of-type frame 'interactor-pane))
@@ -1503,9 +1511,9 @@
 
 (defmethod frame-standard-input ((frame standard-application-frame))
   (if (not (member '*standard-input* (slot-value frame 
-						  'non-frame-stream-names)))
+                                                 'non-frame-stream-names)))
       (or (find-frame-pane-of-type frame 'interactor-pane)
-	  (frame-standard-output frame))))
+          (frame-standard-output frame))))
   
 (defmethod frame-query-io ((frame standard-application-frame))
   (if (not (member '*query-io* (slot-value frame 
diff --git a/clim/gestures.lisp b/clim/gestures.lisp
index d86ef06b124982ccc6b6075ba517fb39caaff318..7288d190ec855f96e3533e4098d86948786f48a3 100644
--- a/clim/gestures.lisp
+++ b/clim/gestures.lisp
@@ -15,7 +15,7 @@
 ;;;    as per CLtL.
 ;;; 2) The set of possible "mouse buttons" is :LEFT, :MIDDLE, and :RIGHT.
 
-(eval-when (compile load eval)
+(eval-when (:compile-toplevel :load-toplevel :execute)
 
 ;; Button indices are 0, 1, or 2
 (defun-inline button-index (name)
@@ -85,7 +85,6 @@
              ,@body))))))
 
 (defun gesture-name-button-and-modifiers (gesture-name)
-  (declare (values button modifier-state))
   (do-button-and-modifier-state (button modifier-state bucket)
     (when (member gesture-name bucket)
       (return-from gesture-name-button-and-modifiers
@@ -94,7 +93,6 @@
   nil)
 
 (defun gesture-name-keysym-and-modifiers (gesture-name)
-  (declare (values keysym modifier-state))
   (dotimes (index (ash 1 (length *modifier-keys*)))
     (let ((bucket (aref *keysym-and-modifier-key->gesture* index)))
       (dolist (entry bucket)
@@ -241,7 +239,6 @@
            (= m1 m2)))))
 
 (defun parse-gesture-spec (gesture-spec)
-  (declare (values keysym modifier-state))
   (when (atom gesture-spec)
     (return-from parse-gesture-spec
       (if (and (characterp gesture-spec)
@@ -267,7 +264,6 @@
 ;; A slower, more careful version of the above that gets used to
 ;; validate programmer input
 (defun decode-gesture-spec (gesture-spec &key (errorp t))
-  (declare (values keysym modifiers))
   (when (atom gesture-spec)
     (return-from decode-gesture-spec
       (values gesture-spec nil)))
diff --git a/clim/histories.lisp b/clim/histories.lisp
index c35f464cdd885b43f6d2bbe7f640aae4773c89ad..cfdea3aa61be050d6b423451baf5bd13fd6f1d8f 100644
--- a/clim/histories.lisp
+++ b/clim/histories.lisp
@@ -97,7 +97,6 @@
 
 ;; Get the element from HISTORY indexed by INDEX.
 (defmethod history-element ((history basic-history) index &optional fixup-p)
-  (declare (values element index))
   (let ((delta 0))
     (with-slots (elements current-length temporary-element) history
       (without-scheduling
@@ -119,8 +118,6 @@
 ;; of one argument, the element.
 (defmacro do-history-elements ((history element-var index-var &rest options)
                                &body body)
-  (declare (arglist (history element-var index-var
-                     &key index offset cutoff-length test) &body body))
   `(flet ((do-history-elements-body (,element-var ,index-var) ,@body))
      (declare (dynamic-extent #'do-history-elements-body))
      (do-history-elements-1 ,history #'do-history-elements-body ,@options)))
@@ -363,11 +360,11 @@
   (view nil))
 
 #+(and allegro aclpc)
-(eval-when (compile load)
+(eval-when (:compile-toplevel :load-toplevel)
   (setf (find-class 'presentation-history-element) nil))
 
 #+(and allegro aclpc)
-(eval-when (compile)
+(eval-when (:compile-toplevel)
   (warn "~S structure hacked for bug2419" 'presentation-history-element))
 
 (defun make-presentation-type-history (type &key (maximum-length *default-history-length*)
diff --git a/clim/incremental-redisplay.lisp b/clim/incremental-redisplay.lisp
index 8b4d7772120747b679cc3d8a4281c9633d600516..e275a47bab0906018ecee6346a8bb9a7bb26e8e2 100644
--- a/clim/incremental-redisplay.lisp
+++ b/clim/incremental-redisplay.lisp
@@ -13,7 +13,9 @@
 ;;; We use the term "extent" here to mean a bounding rectangle...
 
 ;; A fixnum, incremented only with ATOMIC-INCF
-(defvar *generation-tick* 0)
+(declaim (type fixnum *generation-tick*))
+#+sbcl(sb-ext:defglobal *generation-tick* 0)
+#-sbcl(defvar *generation-tick* 0)
 
 (define-protocol-class updating-output-record (output-record))
 
@@ -315,8 +317,14 @@
   `(letf-globally (((stream-redisplaying-p ,stream) t))
      ;; the generation is only necessary for output-records that move
      ;; in the hierarchy.
-     (let ((*generation-tick* (atomic-incf *generation-tick*)))
-       ,@body)))
+
+     ;; NOTE not sure if this is a proper workaround due to SBCL requiring
+     ;; *generation-tick* to be "global", i.e. not special. -- jacek.zlydach, 2017-05-06
+     #-sbcl (let ((*generation-tick* (atomic-incf *generation-tick*)))
+             ,@body)
+     #+sbcl (progn
+              (atomic-incf *generation-tick*)
+              ,@body)))
 
 (defun redisplay (record stream &key (check-overlapping t))
   (unless (redisplayable-stream-p stream)
@@ -445,7 +453,6 @@
                       (x-offset (coordinate 0)) (y-offset (coordinate 0))
                       (old-x-offset (coordinate 0)) (old-y-offset (coordinate 0)))
   (declare (type coordinate x-offset y-offset old-x-offset old-y-offset))
-  (declare (values erases moves draws erase-overlapping move-overlapping))
   #-aclpc (declare (ignore check-overlapping))
   #+ignore (when (eq record wt::*c*) (break "found it"))
   (let ((erases nil)
@@ -549,7 +556,6 @@
                              &optional (x-offset (coordinate 0)) (y-offset (coordinate 0))
                                        (old-x-offset (coordinate 0)) (old-y-offset (coordinate 0)))
   (declare (type coordinate x-offset y-offset old-x-offset old-y-offset))
-  (declare (values erases moves draws erase-overlapping move-overlapping))
   (let ((new-draws nil))
     (labels ((augment-draws (record x-offset y-offset old-x-offset old-y-offset)
                (let ((erases-that-overlap nil))
@@ -815,8 +821,6 @@
                       (old-child-extent
                         (output-record-old-bounding-rectangle child))
                       erases moves draws erase-overlapping move-overlapping)
-  (declare (values new-mode new-erases new-moves new-draws
-                   new-erase-overlapping new-move-overlapping))
   #-aclpc (declare (ignore move-overlapping erase-overlapping draws 
                    moves erases old-child-extent old-child-position)) ;--- Why
   ;; If :DELETE, and deleted all children, delete self,
@@ -930,7 +934,6 @@
             &optional check-overlapping
                       (x-offset (coordinate 0)) (y-offset (coordinate 0))
                       (old-x-offset (coordinate 0)) (old-y-offset (coordinate 0)))
-  (declare (values erases moves draws erase-overlapping move-overlapping))
   #-aclpc (declare (ignore old-x-offset old-y-offset check-overlapping))
   (with-slots (all-new old-bounding-rectangle contents-ok old-parent) record
     ;; if it's all-new, don't bother walking the hierarchy, just redraw.
diff --git a/clim/input-defs.lisp b/clim/input-defs.lisp
index 4319a5f15a102d5aeadccbf7f168049a87a3bcaa..3d2a8e7518ec291282de9a7887ca4f32e2fa3e31 100644
--- a/clim/input-defs.lisp
+++ b/clim/input-defs.lisp
@@ -264,7 +264,6 @@
                 (pointer-y-position pointer) y-position))))))
 
 (defmethod query-pointer ((pointer standard-pointer))
-  (declare (values sheet x y))
   (with-slots (sheet x-position y-position) pointer
     (values sheet x-position y-position)))
 
diff --git a/clim/input-editor-commands.lisp b/clim/input-editor-commands.lisp
index 7307fca2aeb4a71cec37053a3c81fc13861ee8d6..9aab205cf0b73fc64060e7b6a8dc0325998c767b 100644
--- a/clim/input-editor-commands.lisp
+++ b/clim/input-editor-commands.lisp
@@ -10,7 +10,7 @@
 ;;; on INPUT-EDITING-STREAM-MIXIN rather than on our specific implementation of
 ;;; an input editor.  This may prove to be a foolish decision down the pike.
 
-(eval-when (compile load eval)
+(eval-when (:compile-toplevel :load-toplevel :execute)
 (defvar *ie-command-arglist* '(stream input-buffer gesture numeric-argument))
 )
 
@@ -334,7 +334,6 @@ This may confused the input editor" gestures))
       (queue-rescan stream ':activation))))
 
 (defun complete-symbol-name (stream input-buffer &aux (colon-string ":"))
-  (declare (values string ambiguous word-start))
   (multiple-value-bind (word-start word-end colon)
       (word-start-and-end input-buffer '(#\space #\( #\) #\")
                           (stream-insertion-pointer stream))
@@ -1068,7 +1067,6 @@ This may confused the input editor" gestures))
 ;;; Lispy input editing commands
 
 (defun function-arglist (function)
-  (declare (values arglist found-p))
   #+Clozure      (values (ccl:arglist function) t)
   #+Genera       (values (sys:arglist function) T)
   #+Cloe-Runtime (sys::arglist function)
@@ -1076,7 +1074,6 @@ This may confused the input editor" gestures))
   #+Lucid        (values (lucid-common-lisp:arglist function) t))
 
 (defun word-start-and-end (string start-chars &optional (start 0))
-  (declare (values word-start word-end colon))
   (flet ((open-paren-p (thing)
            (or (not (characterp thing))                ;noise strings and blips are delimiters
                (member thing start-chars)))
@@ -1108,7 +1105,6 @@ This may confused the input editor" gestures))
               colon))))
 
 (defun symbol-at-position (stream input-buffer delimiters)
-  (declare (values symbol package start end))
   (multiple-value-bind (word-start word-end)
       (word-start-and-end input-buffer delimiters
                           (stream-insertion-pointer stream))
diff --git a/clim/input-protocol.lisp b/clim/input-protocol.lisp
index 685ce4a66e8f6137cae67b9de93dbe720d3c9209..11d488ae76c0375a0551cdae3d0149e1372024fa 100644
--- a/clim/input-protocol.lisp
+++ b/clim/input-protocol.lisp
@@ -413,7 +413,7 @@
          (process-abort-gesture stream gesture))))
 
 ;;;#+(or aclpc acl86win32)
-;;;(eval-when (compile load eval)
+;;;(eval-when (:compile-toplevel :load-toplevel :execute)
 ;;;   ;;mm: 11Jan95 - this is defined later in  ???
 ;;;   (unless (ignore-errors (find-class 'interactor-pane))
 ;;;      (defclass interactor-pane () ()))
@@ -458,10 +458,6 @@
 ;;; keyword :STREAM argument to *standard-input*.  The application can call
 ;;; stream-read-gesture directly.
 (defun read-gesture (&rest args &key (stream *standard-input*) &allow-other-keys)
-  (declare (arglist &rest args
-                    &key (stream *standard-input*)
-                         timeout peek-p input-wait-test input-wait-handler
-                         pointer-button-press-handler))
   (declare (dynamic-extent args))
   (with-keywords-removed (keywords args '(:stream))
     (apply #'stream-read-gesture stream keywords)))
diff --git a/clim/interactive-defs.lisp b/clim/interactive-defs.lisp
index 2f488c7db61b2d6efde8b1d9e6318e00091c28d7..bceed9443a97ac44a7caf7bd31c9ef723d9dd24d 100644
--- a/clim/interactive-defs.lisp
+++ b/clim/interactive-defs.lisp
@@ -22,7 +22,7 @@
 
 ;; Noise strings and ACCEPT results
 
-(eval-when (compile load eval)
+(eval-when (:compile-toplevel :load-toplevel :execute)
 (defstruct (noise-string (:constructor make-noise-string-1))
   display-string
   text-style
diff --git a/clim/interactive-protocol.lisp b/clim/interactive-protocol.lisp
index 03da2395bc407d1c1fe07f6de501b0acdd9a6029..bf93c93bfba2b402d09194fb646971c2452515db 100644
--- a/clim/interactive-protocol.lisp
+++ b/clim/interactive-protocol.lisp
@@ -591,7 +591,6 @@
 ;; the result does not want to include the space, but which succeeds on a
 ;; balancing open-paren and the result does want to include the paren.
 (defun forward-or-backward (input-buffer start-position reverse-p predicate)
-  (declare (values new-position))
   (let ((position start-position)
         (adjustment (if reverse-p -1 +1))
         (limit (if reverse-p 0 (fill-pointer input-buffer))))
@@ -1059,7 +1058,7 @@
 
 
 ;;;#+(or aclpc acl86win32)
-;;;(eval-when (compile load eval)
+;;;(eval-when (:compile-toplevel :load-toplevel :execute)
 ;;;   ;;mm: 11Jan95 - this is defined later in  ???
 ;;;   (unless (ignore-errors (find-class 'accept-values-pane))
 ;;;      (defclass accept-values-pane () ()))
diff --git a/clim/japanese-input-editor.lisp b/clim/japanese-input-editor.lisp
index 2ffa3ef0994a529fd0bab5db008adaa1cff9a0ed..21fdf1d971bd2254c6c0b82b56a96cad1ba0be2e 100644
--- a/clim/japanese-input-editor.lisp
+++ b/clim/japanese-input-editor.lisp
@@ -5,7 +5,7 @@
 (in-package :clim-internals)
 
 #-ics
-(eval-when (compile)
+(eval-when (:compile-toplevel)
   (warn "~S contains fat strings but is being compiled with a non-ICS lisp"
 	excl:*source-pathname*))
 
diff --git a/clim/lucid-after.lisp b/clim/lucid-after.lisp
index 9e2e6e735ae1f42d2bc46044df41cd714af035ea..d6d29d713fec2dff04a57c5f66dcdbbf7b51c4c1 100644
--- a/clim/lucid-after.lisp
+++ b/clim/lucid-after.lisp
@@ -43,7 +43,7 @@
   (pushnew 'rehash-ptypes *restart-cleanup-functions*))
 
 
-(eval-when (load)
+(eval-when (:load-toplevel)
   (pushnew :clim-2-0 *features*)
   (defparameter *clim-repacking-date* (universal-time-string (get-universal-time)))
   #+ignore                                ;breaks in 2.0
diff --git a/clim/menus.lisp b/clim/menus.lisp
index a546737f4ce1db3f680b23f70532ae7d6a192ad3..bca8b2641b6f737aba8f69dc10c01475dbaeb673 100644
--- a/clim/menus.lisp
+++ b/clim/menus.lisp
@@ -274,7 +274,6 @@
                              (cell-align-x ':left) (cell-align-y ':top)
                              pointer-documentation menu-type gesture
                              x-position y-position)
-  (declare (values value chosen-item gesture))
   (declare (ignore text-style default-item foreground background
                    label scroll-bars printer presentation-type
                    cache unique-id id-test cache-value cache-test
@@ -301,7 +300,6 @@
                  (cell-align-x ':left) (cell-align-y ':top)
                  pointer-documentation menu-type gesture
                  background foreground)
-  (declare (values value chosen-item gesture))
   (declare (ignore #-aclpc keys gesture))
   (flet ((present-item (item stream)
            (present item presentation-type :stream stream)))
@@ -498,7 +496,6 @@
                                       x-spacing y-spacing (row-wise nil)
                                       (cell-align-x ':left) (cell-align-y ':top)
                                       menu-type)
-  (declare (values value chosen-item gesture))
   (flet ((present-item (item stream)
            (present item presentation-type :stream stream)))
     (declare (dynamic-extent #'present-item))
@@ -614,7 +611,6 @@
                              label text-style (scroll-bars t)
                              pointer-documentation menu-type
                         &allow-other-keys)
-  (declare (values value chosen-item gesture))
   (declare (dynamic-extent keys))
   (with-slots (name menu-contents items default-presentation root-window)
               static-menu
diff --git a/clim/output-protocol.lisp b/clim/output-protocol.lisp
index 4ac4fce6241871447fdd541038270372934103db..b2d69c8d2b3fe24e0dc3bb1417c1bd917a0e0e09 100644
--- a/clim/output-protocol.lisp
+++ b/clim/output-protocol.lisp
@@ -587,7 +587,6 @@
 
 (defmethod text-size ((stream output-protocol-mixin) string
                       &key (text-style (medium-merged-text-style stream)) (start 0) end)
-  (declare (values largest-x total-height last-x last-y baseline))
   (when (characterp string)
     (setq string (string string)
           start 0
@@ -602,7 +601,6 @@
 ;;; useful as that might be.
 (defmethod stream-string-output-size ((stream output-protocol-mixin)
                                       string &key (start 0) end text-style)
-  (declare (values last-x largest-x last-y total-height baseline))
   (when (characterp string) (setq string (string string)))
   (unless end (setf end (length string)))
   (let ((style (or text-style (medium-merged-text-style stream)))
@@ -725,7 +723,6 @@
 
 ;; Damnable string streams!
 (defmethod text-size ((stream t) string &key text-style (start 0) end)
-  (declare (values largest-x total-height last-x last-y baseline))
   (declare (ignore text-style))
   (let ((char-width 8)
         (line-height 12)
@@ -769,8 +766,6 @@
 ;;; A few utilities for string writing.
 
 (defmethod decode-stream-for-writing ((stream output-protocol-mixin) &optional brief-p)
-  (declare (values cursor-x cursor-y baseline line-height
-                   style max-x record-p draw-p glyph-buffer))
   (multiple-value-bind (cursor-x cursor-y) (stream-cursor-position stream)
     (let ((baseline (stream-baseline stream))
           (line-height (stream-current-line-height stream))
@@ -806,7 +801,6 @@
                                            (medium medium)
                                            string start end style
                                            cursor-x max-x &optional glyph-buffer)
-  (declare (values write-char next-char-index new-cursor-x new-baseline new-height font))
   (declare (type coordinate cursor-x max-x))
   (declare (type fixnum start end))
   (block stream-scan-string-for-writing
@@ -898,7 +892,6 @@
 ;;; characters; they are handled in WRITE-CHAR instead.
 (defmethod stream-scan-character-for-writing ((stream output-protocol-mixin) medium
                                               character style cursor-x max-x)
-  (declare (values char-normal new-cursor-x new-baseline new-height font))
   (declare (type coordinate cursor-x max-x))
   (multiple-value-bind (index font escapement-x escapement-y origin-x origin-y bb-x bb-y)
       (port-glyph-for-character (port medium) character style)
@@ -926,7 +919,6 @@
 
 (defmethod stream-handle-line-wrap ((stream output-protocol-mixin) cursor-y height max-x
                                     draw-p record-p)
-  (declare (values cursor-x cursor-y baseline line-height))
   (when record-p (stream-close-text-output-record stream t))
   (when draw-p
     (draw-character-wrap-indicator stream cursor-y height max-x record-p))
diff --git a/clim/pixmap-streams.lisp b/clim/pixmap-streams.lisp
index 48eac4d17ad73890f32433f43d91220226a526d4..39510c21ae6c17a5516ac6d6e1c1c02e9140572b 100644
--- a/clim/pixmap-streams.lisp
+++ b/clim/pixmap-streams.lisp
@@ -73,7 +73,7 @@
         (funcall continuation pixmap-stream))
       (slot-value pixmap-medium 'silica::pixmap))))
 
-(defconstant +gray-out-ink+
+(defparameter +gray-out-ink+
     (compose-in (make-opacity .5) +background-ink+))
 
 (defun pixmap-from-menu-item (associated-window menu-item printer presentation-type
diff --git a/clim/present.lisp b/clim/present.lisp
index b9fa3f25d57fbb5607ac929d7913553baa1213db..21d1728d4da143fb8c72e48407594445fb8329dc 100644
--- a/clim/present.lisp
+++ b/clim/present.lisp
@@ -15,17 +15,6 @@
                 &allow-other-keys)
   #-acl86win32
   (declare (dynamic-extent present-args))
-  (declare (arglist object &optional (presentation-type (presentation-type-of object))
-                    &rest present-args
-                    &key (stream *standard-output*)
-                         (view (stream-default-view stream))
-                         (modifier nil) (acceptably nil)
-                         (for-context-type presentation-type) (single-box nil)
-                         (allow-sensitive-inferiors *allow-sensitive-inferiors*)
-                         (sensitive *allow-sensitive-inferiors*)
-                         prompt query-identifier
-                         (record-type 'standard-presentation)
-                    &allow-other-keys))
   (multiple-value-bind (expansion expanded)
       (expand-presentation-type-abbreviation presentation-type)
     (when expanded
diff --git a/clim/ptypes1.lisp b/clim/ptypes1.lisp
index 01e96eca8228718f6c01d4977f36038c94e203fd..c1f760be5a95c93ad10d30e6cf1fe2b071e18ffa 100644
--- a/clim/ptypes1.lisp
+++ b/clim/ptypes1.lisp
@@ -23,7 +23,6 @@
 ;;; actually was incorporated into the result.
 ;;; We use uninterned symbols as the dummy values.
 (defun meta-evaluate-form (form lambda-list &optional another-lambda-list)
-  (declare (values value bindings more-bindings))
   (let ((bindings nil) (more-bindings nil))
     (labels ((do-lambda-list (lambda-list)
                (dolist (item lambda-list)
@@ -301,8 +300,13 @@
            ((class presentation-type-class) (meta standard-class))
   t)
 
+#+ (or sbcl ccl)
+(defmethod closer-mop:validate-superclass
+           ((class presentation-type-class) (meta standard-class))
+  t)
+
 ;;;#+(or aclpc acl86win32)
-;;;(eval-when (compile load eval)
+;;;(eval-when (:compile-toplevel :load-toplevel :execute)
 ;;;   ;;mm: 11Jan95 - this is defined later in  ???
 ;;;   (unless (ignore-errors (find-class 'basic-history))
 ;;;      (defclass basic-history () ())))
@@ -319,11 +323,11 @@
      ',(class-presentation-type-name object #+Symbolics 'compile-file)
      ',(presentation-type-parameters object)
      ',(presentation-type-options object)
-     ',(let ((superclasses (class-direct-superclasses object)))
+     ',(let ((superclasses (closer-mop:class-direct-superclasses object)))
          (if (cdr superclasses)
              (mapcar #'(lambda (class)
                          (class-presentation-type-name class #+Symbolics 'compile-file))
-                     (class-direct-superclasses object))
+                     (closer-mop:class-direct-superclasses object))
              ;; Use an atom instead of a one-element list to work around a Lucid bug
              ;; where it blows up if anything here is a list that gets consed freshly
              ;; each time make-load-form is called, because make-load-form gets called
@@ -416,14 +420,8 @@
          *class-prototype-for-t*)
         (t
          ;; Finalization is necessary according to AMOP. -smh 18may93
-         (unless (#+aclpc acl:class-finalized-p
-                  #+Clozure ccl:class-finalized-p
-                  #-(or aclpc Clozure) clos:class-finalized-p
-                  class)
-           (#+aclpc acl:finalize-inheritance
-            #+Clozure ccl:finalize-inheritance
-            #-(or aclpc Clozure) clos:finalize-inheritance
-            class))
+         (unless (closer-mop:class-finalized-p class)
+           (closer-mop:finalize-inheritance class))
          (class-prototype class))))
 
 (defun-inline find-class-precedence-list (class)
@@ -432,15 +430,9 @@
   ;; can come up with structure classes
   #+Symbolics (find-class-prototype class)
   ;; Finalization is necessary according to AMOP. -smh 18may93
-  (unless (#+aclpc acl:class-finalized-p
-           #+Clozure ccl:class-finalized-p
-           #-(or aclpc Clozure) clos:class-finalized-p
-           class)
-    (#+aclpc acl:finalize-inheritance
-     #+Clozure ccl:finalize-inheritance
-     #-(or aclpc Clozure) clos:finalize-inheritance
-     class))
-  (class-precedence-list class))
+  (unless (closer-mop:class-finalized-p class)
+    (closer-mop:finalize-inheritance class))
+  (closer-mop:class-precedence-list class))
 
 ;;; Hide the long name when printing these
 (defmethod print-object ((object presentation-type-class) stream)
@@ -492,9 +484,6 @@
 
 ;;; Given a presentation type class get its internal inheritance information
 (defun presentation-type-inheritance (class &optional environment)
-  (declare (values direct-supertypes                ;These three values are lists of
-                   parameter-massagers                ;equal length and parallel contents.
-                   options-massagers))
   (let ((list (cond ((eq class (second *presentation-type-being-defined*))
                      (cddddr *presentation-type-being-defined*))
                     ((and (compile-file-environment-p environment)
@@ -577,7 +566,7 @@
                the same name as a CLOS class.")))
     ;; Generate the expander function and pass it to load-presentation-type-abbreviation
     `(define-group ,name define-presentation-type-abbreviation
-       (eval-when (compile)
+       (eval-when (:compile-toplevel)
          #+(or Genera Cloe-Runtime Minima (and MCL CCL-2))
            (setf (compile-time-property ',name 'presentation-type-abbreviation)
                  ,function)
@@ -614,7 +603,6 @@
 
 ;;; Like macroexpand-1
 (defun expand-presentation-type-abbreviation-1 (type &optional environment)
-  (declare (values expansion expanded))
   (with-presentation-type-decoded (name parameters options) type
     (let ((expander (or (and (compile-file-environment-p environment)
                              (compile-time-property name 'presentation-type-abbreviation))
@@ -654,7 +642,6 @@
 
 ;;; Like macroexpand
 (defun expand-presentation-type-abbreviation (type &optional environment)
-  (declare (values expansion expanded))
   (let ((flag nil))
     (loop
       (multiple-value-bind (expansion expanded)
@@ -715,7 +702,7 @@
            (direct-superclasses (and class
                                      (mapcar #'(lambda (class)
                                                  (class-proper-name class environment))
-                                             (class-direct-superclasses class))))
+                                             (closer-mop:class-direct-superclasses class))))
            ;; Default the supertype if unsupplied or nil
            ;; This assumes consistency of the compile-time and load-time environments.  Okay?
            (inherit-from (cond (inherit-from)
@@ -760,7 +747,7 @@
           ;; Generate the form that stores all the information and defines the
           ;; automatically-defined presentation methods
           `(progn
-             (eval-when (compile)
+             (eval-when (:compile-toplevel)
                (ensure-presentation-type ',name ',parameters ',options ',direct-supertypes
                                          ',description ',history
                                          ',parameters-are-types
@@ -824,7 +811,7 @@
            (class (find-presentation-type-class name nil environment))
            #-CLIM-extends-CLOS
            (old-direct-superclasses (if class
-                                        (class-direct-superclasses class)
+                                        (closer-mop:class-direct-superclasses class)
                                         direct-superclasses))
            #+(or (and MCL CCL-2) aclpc Clozure)
            (registered-class-name
@@ -865,8 +852,7 @@
                         name (class-proper-name superclass environment)
                         'define-presentation-type
                         (typecase superclass
-                          #-Clozure (funcallable-standard-class 'defgeneric)
-                          #+Clozure (ccl:funcallable-standard-class 'defgeneric)
+                          (closer-mop:funcallable-standard-class 'defgeneric)
                           (standard-class 'defclass)
                           #+Symbolics                ;Symbolics CLOS, that is
                           (clos:structure-class 'defstruct)
@@ -889,8 +875,8 @@
                         #+(or aclpc (and MCL CCL-2) Clozure) :name
                         #+(and MCL CCL-2) class-name
                         #+(or aclpc Clozure) registered-class-name
-                        #-(or PCL aclpc (and MCL CCL-2) allegro Clozure) :slots
-                        #+(or PCL aclpc (and MCL CCL-2) allegro Clozure) :direct-slots
+                        #-(or PCL aclpc (and MCL CCL-2) allegro Clozure sbcl ccl) :slots
+                        #+(or PCL aclpc (and MCL CCL-2) allegro Clozure sbcl ccl) :direct-slots
                         nil)
                      #+Lucid (make-instance 'presentation-type-class
                                      :direct-superclasses direct-superclasses
@@ -899,17 +885,19 @@
                ;; very bad things to happen
                #+(and MCL CCL-2) (setf (slot-value class 'ccl::slots) (cons nil (vector)))
                ;; If the class name couldn't be set while making the class, set it now
-               #-(or Genera Cloe-Runtime Lucid aclpc (and MCL CCL-2) Clozure)
-               (setf (class-name class) class-name)
+
+               ;; FIXME not sure what to do with this, commenting out for now. -- jacek.zlydach, 2017-05-06
+               ;; #-(or Genera Cloe-Runtime Lucid aclpc (and MCL CCL-2) Clozure)
+               ;; (setf (class-name class) class-name)
                ))
-            ((not (or (equal (class-direct-superclasses class) direct-superclasses)
+            ((not (or (equal (closer-mop:class-direct-superclasses class) direct-superclasses)
                       ;; The above equal would suffice if it were not for the fact that when
                       ;; a CLOS class in the compile-file environment has a superclass in the
                       ;; runtime environment, CLOS uses a forward-referenced-class instead
                       ;; of using the run-time class
                       (every #'(lambda (class type)
                                  (eq (class-proper-name class environment) type))
-                             (class-direct-superclasses class) supertypes-list)
+                             (closer-mop:class-direct-superclasses class) supertypes-list)
                       (presentation-type-class-p class)))
              ;; Inheritance must be consistent between CLOS and CLIM classes,
              ;; but only when CLOS and CLIM use the same class object.
@@ -920,7 +908,7 @@
                    name supertypes-list class
                    (mapcar #'(lambda (class)
                                (class-proper-name class environment))
-                           (class-direct-superclasses class)))))
+                           (closer-mop:class-direct-superclasses class)))))
 
       ;; This used to be done only in the case where we were creating a class
       ;; "de novo".  However, CCL-2 currently doesn't record anything about
@@ -1038,64 +1026,69 @@
 ;;; If there is parameterized inheritance, compile code to do it efficiently
 ;;; rather than interpreting the inheritance information at run time.
 (defun generate-map-over-presentation-type-supertypes-method-if-needed
-       (name class function-var parameters-var options-var type-var
-        &optional environment)
+    (name class function-var parameters-var options-var type-var
+     &optional environment)
   (let ((superclasses
-          #-(or aclpc allegro) (cdr (class-precedence-list class))
-          #+aclpc
-          (progn
-            (unless (acl:class-finalized-p class)
-              (acl:finalize-inheritance class))
-            (cdr (class-precedence-list class)))
-          #+allegro ;; Work around bug in CLOS compilation environments...
-          (multiple-value-bind (no-errorp result)
-              (excl:errorset (progn
-                               ;; Finalization is necessary according to AMOP. -smh 18may93
-                                 (unless (clos:class-finalized-p class)
-                                 (clos:finalize-inheritance class))
-                               (cdr (class-precedence-list class)))
-                             nil)
-            (if no-errorp
-                result
-                (return-from generate-map-over-presentation-type-supertypes-method-if-needed)))))
+         ;;#-(or allegro aclpc) (cdr (closer-mop:class-precedence-list class)) ;; FIXME dropping?
+         #+ (or sbcl ccl)
+         (progn
+           (unless (closer-mop:class-finalized-p class)
+             (closer-mop:finalize-inheritance class))
+           (cdr (closer-mop:class-precedence-list class)))
+         #+aclpc
+         (progn
+           (unless (acl:class-finalized-p class)
+             (acl:finalize-inheritance class))
+           (cdr (class-precedence-list class)))
+         #+allegro ;; Work around bug in CLOS compilation environments...
+         (multiple-value-bind (no-errorp result)
+             (excl:errorset (progn
+                              ;; Finalization is necessary according to AMOP. -smh 18may93
+                              (unless (clos:class-finalized-p class)
+                                (clos:finalize-inheritance class))
+                              (cdr (class-precedence-list class)))
+                            nil)
+           (if no-errorp
+               result
+               (return-from generate-map-over-presentation-type-supertypes-method-if-needed)))))
     #+Minima (setq superclasses (elide-nonessential-superclasses superclasses))
     (multiple-value-bind (bindings alist)
         (generate-type-massagers class superclasses parameters-var options-var t environment)
       (unless (every #'(lambda (class)
                          (let ((massage-forms (cdr (assoc class alist))))
-                           (and (null (first massage-forms))                ;no parameters
-                                (null (second massage-forms)))))        ;no options
+                           (and (null (first massage-forms))     ;no parameters
+                                (null (second massage-forms))))) ;no options
                      superclasses)
         `((define-presentation-method-without-massaging
-                map-over-presentation-type-supertypes
-                (,parameters-var ,options-var (,type-var ,name) ,function-var)
-            ,parameters-var ,options-var        ;might not be used
+              map-over-presentation-type-supertypes
+              (,parameters-var ,options-var (,type-var ,name) ,function-var)
+            ,parameters-var ,options-var ;might not be used
             (funcall ,function-var ',name ,type-var)
             ,@(make-stack-list-bindings bindings
-                (mapcan #'(lambda (class)
-                            (let* ((massage-forms (cdr (assoc class alist)))
-                                   (parameters (first massage-forms))
-                                   (options (second massage-forms))
-                                   (type-name (class-presentation-type-name class)))
-                              (if (or options parameters)
-                                  (make-stack-list-bindings
-                                    `((type ,(if options
-                                                 (if (constantp parameters)
-                                                     (if (constantp options)
-                                                         `',(cons (cons type-name
-                                                                        (eval parameters))
-                                                                  (eval options))
-                                                         `(cons ',(cons type-name
-                                                                        (eval parameters))
-                                                                ,options))
-                                                     `(cons (cons ',type-name ,parameters)
-                                                            ,options))
-                                                 (if (constantp parameters)
-                                                     `',(cons type-name (eval parameters))
-                                                     `(cons ',type-name ,parameters)))))
-                                    `((funcall ,function-var ',type-name type)))
-                                  `((funcall ,function-var ',type-name ',type-name)))))
-                        superclasses))
+                                        (mapcan #'(lambda (class)
+                                                    (let* ((massage-forms (cdr (assoc class alist)))
+                                                           (parameters (first massage-forms))
+                                                           (options (second massage-forms))
+                                                           (type-name (class-presentation-type-name class)))
+                                                      (if (or options parameters)
+                                                          (make-stack-list-bindings
+                                                           `((type ,(if options
+                                                                        (if (constantp parameters)
+                                                                            (if (constantp options)
+                                                                                `',(cons (cons type-name
+                                                                                               (eval parameters))
+                                                                                         (eval options))
+                                                                                `(cons ',(cons type-name
+                                                                                               (eval parameters))
+                                                                                       ,options))
+                                                                            `(cons (cons ',type-name ,parameters)
+                                                                                   ,options))
+                                                                        (if (constantp parameters)
+                                                                            `',(cons type-name (eval parameters))
+                                                                            `(cons ',type-name ,parameters)))))
+                                                           `((funcall ,function-var ',type-name type)))
+                                                          `((funcall ,function-var ',type-name ',type-name)))))
+                                                superclasses))
             nil))))))
 
 ;;; Wrap some let* bindings around some forms
@@ -1140,7 +1133,6 @@
 ;;; The second value is a list of elements (class parameters-form options-form)
 (defun generate-type-massagers (class superclasses parameters-var options-var accuratep
                                 &optional environment)
-  (declare (values bindings alist))
   (let ((paths nil)
         (classes-seen nil)
         (class-bindings-used nil)        ;((class parameters-count options-count)...)
@@ -1149,7 +1141,7 @@
     (labels ((map-over-superclasses (function class &rest trail)
                (declare (dynamic-extent trail))
                (funcall function class trail)
-               (dolist (superclass (class-direct-superclasses class))
+               (dolist (superclass (closer-mop:class-direct-superclasses class))
                  (apply #'map-over-superclasses function superclass class trail)))
              (note-path (class trail)
                (unless (assoc class paths)
@@ -1304,7 +1296,6 @@
 ;;; if the length is 1, each value is just the list element, to save space in
 ;;; compiled files.
 (defun analyze-inherit-from (backquote parameters-ll options-ll)
-  (declare (values direct-supertypes parameter-massagers options-massagers))
   (multiple-value-bind (expansion parameters-bindings options-bindings)
       (meta-evaluate-form backquote parameters-ll options-ll)
     (with-presentation-type-decoded (expanded-name expanded-parameters expanded-options)
@@ -1400,7 +1391,12 @@
 (defun generate-presentation-type-inheritance-methods
     (name class parameters-var options-var &optional environment)
   (let ((superclasses
-         #-(or allegro aclpc) (cdr (class-precedence-list class))
+         ;;#-(or allegro aclpc) (cdr (closer-mop:class-precedence-list class)) ;; FIXME dropping?
+         #+ (or sbcl ccl)
+         (progn
+           (unless (closer-mop:class-finalized-p class)
+             (closer-mop:finalize-inheritance class))
+           (cdr (closer-mop:class-precedence-list class)))
          #+aclpc
           (progn
             (unless (acl:class-finalized-p class)
@@ -1562,13 +1558,12 @@
 ;;; Presentation generic functions have their own class just so we can define
 ;;; one method that aids in implementing presentation-method-combination
 #-(and MCL CCL-2)
-(eval-when (eval load compile)
+(eval-when (:execute :load-toplevel :compile-toplevel)
 (defclass presentation-generic-function
           (standard-generic-function #+Minima-Developer standard-object)
   ()
-  (:metaclass #-Clozure funcallable-standard-class
-              #+Clozure ccl:funcallable-standard-class))
-)        ;end of (eval-when (eval load compile)
+  (:metaclass closer-mop:funcallable-standard-class))
+)        ;end of (eval-when (:execute :load-toplevel :compile-toplevel)
 
 #+CLIM-extends-CLOS
 (defvar *presentation-method-argument-class*)
@@ -1609,7 +1604,7 @@
 ;;; extension to call-method
 ;;;--- If combined methods were generated during compile-file, this would need
 ;;;--- to get an environment argument from somewhere
-(eval-when (compile load eval)
+(eval-when (:compile-toplevel :load-toplevel :execute)
 (define-method-combination presentation-method-combination ()
       ((around (:around))
        (before (:before))
@@ -1677,7 +1672,7 @@
             (if bindings
                 `(let* ,bindings ,form)
                 form)))))))
-)        ;end of (eval-when (compile load eval)
+)        ;end of (eval-when (:compile-toplevel :load-toplevel :execute)
 
 
 ;;;; Definitions of Presentation Generic Functions
@@ -1693,9 +1688,7 @@
             ;; &key &allow-other-keys allows methods to receive only the keyword arguments
             ;; that they are interested in.  We know the caller will never supply
             ;; misspelled keywords since only the CLIM system calls this.
-  #-(or aclpc acl86win32 (and MCL CCL-2))
-  (declare (arglist type-key parameters options object type stream view
-                    &key acceptably for-context-type)))
+)
 
 (define-presentation-generic-function accept-method
                                       accept
@@ -1704,10 +1697,7 @@
             ;; &key &allow-other-keys allows methods to receive only the keyword arguments
             ;; that they are interested in.  We know the caller will never supply
             ;; misspelled keywords since only the CLIM system calls this.
-  #-(or aclpc acl86win32 (and MCL CCL-2))
-  (declare (arglist type-key parameters options type stream view
-                    &key default default-type)
-           (values object type)))
+)
 
 (define-presentation-generic-function describe-presentation-type-method
                                       describe-presentation-type
@@ -1719,9 +1709,7 @@
 
 (define-presentation-generic-function presentation-subtypep-method
                                       presentation-subtypep
-  (type-key type putative-supertype)
-  #-(or aclpc (and MCL CCL-2))
-  (declare (values subtype-p known-p)))
+  (type-key type putative-supertype))
 
 (define-presentation-generic-function presentation-type-history-method
                                       presentation-type-history
@@ -1733,9 +1721,7 @@
             ;; &key &allow-other-keys allows methods to receive only the keyword arguments
             ;; that they are interested in.  We know the caller will never supply
             ;; misspelled keywords since only the CLIM system calls this.
-  #-(or aclpc acl86win32 (and MCL CCL-2))
-  (declare (arglist type-key default type &key default-type)
-           (values default default-type)))
+)
 
 (define-presentation-generic-function presentation-type-specifier-p-method
                                       presentation-type-specifier-p
@@ -1746,26 +1732,15 @@
   (type-key parameters options type
             stream view default default-supplied-p
             present-p query-identifier
-            &key &allow-other-keys)
-  #-(or aclpc acl86win32 (and MCL CCL-2))
-  (declare (arglist type-key parameters options type
-                    stream view default default-supplied-p
-                    present-p query-identifier
-                    &key (prompt t) (active-p t))))
+            &key &allow-other-keys))
 
 (define-presentation-generic-function gadget-includes-prompt-p-method
                                       gadget-includes-prompt-p
-  (type-key parameters options type stream view)
-  #-(or aclpc acl86win32 (and MCL CCL-2))
-  (declare (arglist type-key parameters options type stream view)))
+  (type-key parameters options type stream view))
 
 (define-presentation-generic-function decode-indirect-view-method
                                       decode-indirect-view
-  (type-key parameters options type view frame-manager &key &allow-other-keys)
-  #-(or aclpc acl86win32 (and MCL CCL-2))
-  (declare (arglist type-key parameters options type
-                    view frame-manager
-                    &key query-identifier read-only)))
+  (type-key parameters options type view frame-manager &key &allow-other-keys))
 
 (define-presentation-generic-function presentation-refined-position-test-method
                                       presentation-refined-position-test
@@ -1785,7 +1760,6 @@
 ;;; lexical bindings of the presentation type parameters and options.
 (defmacro define-presentation-method (presentation-function-name &rest body
                                       &environment environment)
-  (declare (arglist presentation-function-name [qualifiers]* specialized-lambda-list &body body))
   (define-presentation-method-1 presentation-function-name body ':massage environment))
 
 ;;; The next level down from define-presentation-method, this doesn't create
@@ -1794,7 +1768,6 @@
 ;;; a type-key or type-class parameter.
 (defmacro define-presentation-method-without-massaging (presentation-function-name &rest body
                                                         &environment environment)
-  (declare (arglist presentation-function-name [qualifiers]* specialized-lambda-list &body body))
   (define-presentation-method-1 presentation-function-name body nil environment))
 
 ;;; Define a default method for a presentation generic function.
@@ -1802,7 +1775,6 @@
 ;;; There is no parameters/options processing, this macro just exists for abstraction.
 (defmacro define-default-presentation-method (presentation-function-name &rest body
                                               &environment environment)
-  (declare (arglist presentation-function-name [qualifiers]* specialized-lambda-list &body body))
   (define-presentation-method-1 presentation-function-name body ':default environment))
 
 ;;; Common subroutine of the three forms of define-presentation-method
diff --git a/clim/ptypes2.lisp b/clim/ptypes2.lisp
index d96c639f1c60c9906f6dac788231f313cc0f860b..55193d8af9ef4e5f8acf0aee9a81dad5366bd7e1 100644
--- a/clim/ptypes2.lisp
+++ b/clim/ptypes2.lisp
@@ -351,7 +351,6 @@
 ;;  NIL,NIL => Don't know, the answer cannot definitively be determined
 ;;  T,NIL   => Can't ever happen
 (defun presentation-subtypep (type putative-supertype)
-  (declare (values subtype-p known-p))
   (multiple-value-bind (subtype-p known-p)
       (presentation-subtypep-1 type putative-supertype)
     (when (and (eq subtype-p nil)
@@ -368,7 +367,6 @@
 ;; The guts of the above, but faster since we don't worry about the case
 ;; where a type abbreviation was passed in.
 (defun presentation-subtypep-1 (type putative-supertype)
-  (declare (values subtype-p known-p))
   (with-presentation-type-decoded (type-name type-parameters) type
     (with-presentation-type-decoded (supertype-name supertype-parameters) putative-supertype
 
diff --git a/clim/r-tree.lisp b/clim/r-tree.lisp
index b6cc55dfac50844d83b3ca0b5f3553008f301429..bc097c8d21454077af2e1e146a9f129001b7aa7b 100644
--- a/clim/r-tree.lisp
+++ b/clim/r-tree.lisp
@@ -225,7 +225,6 @@
 
 ;; Add a record to an R tree, and return the (possibly new) root
 (defun r-tree-insert (root record)
-  (declare (values new-root))
   (let ((leaf root))
     (loop 
       (when (r-tree-leaf-node-p leaf)
@@ -451,7 +450,6 @@
 
 ;; Remove an object from the R tree and trim it appropriately
 (defun r-tree-delete (root record)
-  (declare (values new-root found-p))
   (with-stack-array (orphans 20 :fill-pointer 0)
     (multiple-value-bind (found-p delete-p)
         (r-tree-delete-1 root record orphans)
diff --git a/clim/recording-protocol.lisp b/clim/recording-protocol.lisp
index c3abc592e45ae7cba36a782cd1fe72e5a13d84ec..9714d5913573a0a80de6f981c363584086530b38 100644
--- a/clim/recording-protocol.lisp
+++ b/clim/recording-protocol.lisp
@@ -324,8 +324,7 @@
 #+Genera (zwei:defindentation (map-over-output-records-overlapping-region 2 1))
 (defgeneric map-over-output-records-overlapping-region
             (function record region
-             &optional x-offset y-offset &rest continuation-args)
-  (declare (dynamic-extent function continuation-args)))
+             &optional x-offset y-offset &rest continuation-args))
 
 ;;; This must map over the children in such a way that, when it maps over
 ;;; overlapping children, the topmost (most recently inserted) child is
@@ -336,8 +335,7 @@
 #+Genera (zwei:defindentation (map-over-output-records-containing-position 3 1))
 (defgeneric map-over-output-records-containing-position
             (function record x y
-             &optional x-offset y-offset &rest continuation-args)
-  (declare (dynamic-extent function continuation-args)))
+             &optional x-offset y-offset &rest continuation-args))
 
 ;;; X-offset and Y-offset represent the accumulated offset between the
 ;;; regions's native coordinates and "our" coordinates and must be added
@@ -425,7 +423,6 @@
 ;; to be ADDED to any coordinates relative to OUTPUT-RECORD to give you
 ;; absolute coordinates.
 (defun convert-from-relative-to-absolute-coordinates (stream output-record)
-  (declare (values x-offset y-offset))
   (cond ((null output-record)
          ;;--- Why on earth do we need this now?
          (values (coordinate 0) (coordinate 0)))
@@ -449,7 +446,6 @@
 ;; to be ADDED to any absolute coordinates to give you coordinates
 ;; relative to OUTPUT-RECORD.
 (defun convert-from-absolute-to-relative-coordinates (stream output-record)
-  (declare (values x-offset y-offset))
   (cond ((null output-record)
          ;;--- Why on earth do we need this now?
          (values (coordinate 0) (coordinate 0)))
@@ -474,7 +470,6 @@
 ;; relative to ANCESTOR in order to get coordinates relative to
 ;; DESCENDANT.
 (defun convert-from-ancestor-to-descendant-coordinates (ancestor descendant)
-  (declare (values x-offset y-offset))
   (cond ((eq descendant ancestor)
          (values (coordinate 0) (coordinate 0)))
         ((null descendant)
@@ -495,7 +490,6 @@
 ;; relative to DESCENDANT in order to get coordinates relative to
 ;; ANCESTOR.
 (defun convert-from-descendant-to-ancestor-coordinates (descendant ancestor)
-  (declare (values x-offset y-offset))
   (cond ((eq descendant ancestor)
          (values (coordinate 0) (coordinate 0)))
         ((null descendant)
diff --git a/clim/standard-types.lisp b/clim/standard-types.lisp
index 509c6778f67d5f0a00cb39b65cc17ea0980da45f..5081bd98125665531d46c93bcb50b5c4f3ac4d64 100644
--- a/clim/standard-types.lisp
+++ b/clim/standard-types.lisp
@@ -811,7 +811,6 @@
 (defun accept-comma (stream desired-type view
                      &key (delimiter-character #\,)
                           echo-space echo-string-before-blip)
-  (declare (values more-to-come object type))
   (with-input-context (desired-type) (object type)
        (loop
          (let ((char (read-gesture :stream stream)))
@@ -953,12 +952,20 @@
 
 ;;;; Sequence Presentation Types
 
-(define-presentation-type sequence (element-type)
-  :inherit-from t                        ;enforce CL definition
+#+sbcl(define-presentation-type sequence (element-type)
+  :inherit-from (find-class 't)                     ;enforce CL definition ; NOTE changed "t" to "(find-class 't)" -- jacek.zlydach, 2017-05-06
+  :parameters-are-types t
+  :options ((separator #\,)
+            (echo-space t)))
+
+;;; NOTE CCL seems to like it the old way -- jacek.zlydach, 2017-05-06
+#-sbcl(define-presentation-type sequence (element-type)
+  :inherit-from t                     ;enforce CL definition
   :parameters-are-types t
   :options ((separator #\,)
             (echo-space t)))
 
+
 (define-presentation-method describe-presentation-type :after
                             ((type sequence) stream plural-count)
   (declare (ignore plural-count))        ;primary method gets it
@@ -1073,7 +1080,6 @@
 
 (defun accept-sequence-element (stream element-type view separators
                                 element-default element-default-type default-supplied-p)
-  (declare (values object object-type))
   (multiple-value-bind (object object-type)
       (with-input-context (element-type) (object object-type)
            (with-delimiter-gestures (separators)
@@ -1726,7 +1732,6 @@
 
 #+Genera
 (defun dw-type-to-clim-type (object dw-type)
-  (declare (values new-object clim-type changed-p))
   (dw:with-type-decoded (type-name data-args pr-args) dw-type
      (let ((new (assoc type-name *dw-type-to-clim-type-alist*)))
        (if new
diff --git a/clim/stream-defprotocols.lisp b/clim/stream-defprotocols.lisp
index 74b65fec855b0d019ffa3f7b7013b0ea6f3bdd2f..8bf42e3771b586878bb49e0d6562335a8f12ce2b 100644
--- a/clim/stream-defprotocols.lisp
+++ b/clim/stream-defprotocols.lisp
@@ -114,8 +114,7 @@
   ((stream basic-extended-input-protocol) &key timeout input-wait-test))
 
 (defoperation stream-pointer-position basic-extended-input-protocol
-  ((stream basic-extended-input-protocol) &key (timeout 0) pointer)
-  #-aclpc (declare (values x y)))
+  ((stream basic-extended-input-protocol) &key (timeout 0) pointer))
 
 (defoperation stream-set-pointer-position basic-extended-input-protocol
   ((stream basic-extended-input-protocol) x y &key pointer))
@@ -124,12 +123,10 @@
   ((stream basic-extended-input-protocol) pointer button modifier-state x y))
 
 (defoperation stream-pointer-input-rectangle* basic-extended-input-protocol
-  ((stream basic-extended-input-protocol) pointer &key left top right bottom)
-  #-aclpc (declare (values left top right bottom)))
+  ((stream basic-extended-input-protocol) pointer &key left top right bottom))
 
 (defoperation stream-accept basic-extended-input-protocol
-  ((stream basic-extended-input-protocol) presentation-type &rest accept-args)
-  #-aclpc (declare (values object type)))
+  ((stream basic-extended-input-protocol) presentation-type &rest accept-args))
 
 (defoperation prompt-for-accept basic-extended-input-protocol
   ((stream basic-extended-input-protocol) type view &rest accept-args))
@@ -261,12 +258,10 @@
 
 (defoperation text-size basic-extended-output-protocol
   ((stream basic-extended-output-protocol) string &key text-style start end)
-  #-aclpc (declare (values largest-x total-height last-x last-y baseline))
   (:no-defgeneric t))
 
 (defoperation stream-cursor-position basic-extended-output-protocol
-  ((stream basic-extended-output-protocol))
-  #-aclpc (declare (values x y)))
+  ((stream basic-extended-output-protocol)))
 
 (defoperation stream-set-cursor-position basic-extended-output-protocol
   ((stream basic-extended-output-protocol) x y))
@@ -409,8 +404,7 @@
   ((window window-mixin) x y))
 
 (defoperation window-inside-size window-mixin
-  ((window window-mixin))
-  #-aclpc (declare (values width height)))
+  ((window window-mixin)))
 
 (defoperation window-set-inside-size window-mixin
   ((window window-mixin) new-width new-height))
diff --git a/clim/surround-output.lisp b/clim/surround-output.lisp
index 61b1a9d8c06f5cc34c97e8b26974144ce2f4758c..d90fa07b56237b4165be07ff35699677d09d0d40 100644
--- a/clim/surround-output.lisp
+++ b/clim/surround-output.lisp
@@ -9,7 +9,7 @@
 
 (defvar *border-shape-drawer-alist* nil)
 
-(eval-when (eval compile load)
+(eval-when (:execute :compile-toplevel :load-toplevel)
 
 (defparameter *border-shape-drawer-arglist* '(stream record left top right bottom))
 
diff --git a/clim/tracking-pointer.lisp b/clim/tracking-pointer.lisp
index 7a6e50d683757ea82dff0e6193d3f40655175e17..29d728e93f159d7b810b40dd783a19adea160f42 100644
--- a/clim/tracking-pointer.lisp
+++ b/clim/tracking-pointer.lisp
@@ -7,7 +7,7 @@
 ;;;"Copyright (c) 1990, 1991, 1992 Symbolics, Inc.  All rights reserved.
 ;;; Portions copyright (c) 1988, 1989, 1990 International Lisp Associates."
 
-(eval-when (compile load eval)
+(eval-when (:compile-toplevel :load-toplevel :execute)
 
 ;;; For compile-time checking.
 (defvar *tracking-pointer-clauses* nil)                ;each clause looks like (name arglist)
@@ -16,7 +16,6 @@
   `(push-unique '(,name ,arglist) *tracking-pointer-clauses* :key #'car))
 
 (defun validate-tracking-pointer-clause (name arglist)
-  (declare (values new-arglist ignores))
   (let ((item (find name *tracking-pointer-clauses* :key #'car)))
     (unless item
       (error "~S is not a known TRACKING-POINTER clause." name))
diff --git a/clim/translators.lisp b/clim/translators.lisp
index 724b200a3a170c4716de94623ed9b068970b3409..5c63ec8d44ef8e57dfe3dca8a05bef089b7e5cea 100644
--- a/clim/translators.lisp
+++ b/clim/translators.lisp
@@ -20,7 +20,7 @@
 (setq clos-internals::*invalidate-clim-handler-caches* #'invalidate-presentation-caches)
 
 ;;; maybe this wants to be taken out after the load-only phase?
-(eval-when (compile load #+(or aclpc acl86win32) eval)
+(eval-when (:compile-toplevel :load-toplevel #+(or aclpc acl86win32) :execute)
 
 (defvar *translator-function-arglist*
         '(object presentation context-type frame event window x y)))
@@ -510,7 +510,6 @@
 (defun presentation-matches-context-type (presentation context-type
                                           frame window x y
                                           &key event (modifier-state 0))
-  (declare (values translator any-match-p))
   (let ((one-matched nil)
         (translators
           (find-presentation-translators
diff --git a/clim/view-defs.lisp b/clim/view-defs.lisp
index adbefd1b488842e74bf7f7ec39e5af1e91c16a8f..b81f2afcbaff94256188947e36138b52e02c832b 100644
--- a/clim/view-defs.lisp
+++ b/clim/view-defs.lisp
@@ -45,7 +45,6 @@
 
 (defmethod initialize-instance :after ((view actual-gadget-view) 
                                        &rest initargs &key &allow-other-keys)
-  #-(or aclpc Clozure) (declare (non-dynamic-extent initargs))
   (setf (slot-value view 'initargs) initargs))
 
 (defmacro define-gadget-view (name)
diff --git a/clim/window-stream.lisp b/clim/window-stream.lisp
index 219ec619e401a18709a659cca3327a20c475745c..0adeef1c2a506ed3be318a372d139139247295ac 100644
--- a/clim/window-stream.lisp
+++ b/clim/window-stream.lisp
@@ -32,7 +32,9 @@
   nil)
 
 
-#-silica        ;--- no such slots in Silica
+;;; NOTE disabled for sbcl and ccl because :silica seems not to be in features anyway,
+;;; and this print-object is presently broken. -- jacek.zlydach 2017-05-14
+#- (or silica sbcl ccl)                             ;--- no such slots in Silica
 (defmethod print-object ((window window-stream) stream)
   (print-unreadable-object (window stream :type t :identity t)
     (let ((left (safe-slot-value window 'left))
@@ -41,6 +43,13 @@
           (bottom (safe-slot-value window 'bottom)))
       (format stream "/x ~D:~D y ~D:~D/" left right top bottom))))
 
+;;; NOTE FIXME this needs a proper implementation.
+;;; -- jacek.zlydach 2017-05-14
+#+ (or silica sbcl ccl)
+(defmethod print-object ((window window-stream) stream)
+  (print-unreadable-object (window stream :type t :identity t)
+    (format stream "a window stream")))
+
 (defmethod window-stream-class-name ((window-stream window-stream))
   (class-name (class-of window-stream)))
 
diff --git a/clx/clx-port.lisp b/clx/clx-port.lisp
index 43effd5ab34085f5ecaa236801db808b76880e72..d242c1c47080739bf2ec1c049f871bd6baa8bc44 100644
--- a/clx/clx-port.lisp
+++ b/clx/clx-port.lisp
@@ -62,6 +62,7 @@
 		 #+Allegro (or (system:getenv "DISPLAY") (short-site-name))
 		 #+Lucid   (or (lcl:environment-variable "DISPLAY") (machine-instance))
                  #+CCL     (or (ccl:getenv "DISPLAY") (machine-instance))
+                 #+sbcl    (or (sb-posix:getenv "DISPLAY") (machine-instance))
                  ))
     (multiple-value-bind (host display-number nscreen)
 	(disassemble-display-spec host (or display-number 0) (or screen 0))
@@ -105,7 +106,6 @@
 					    :background *clx-white-color*))))))))
 
 (defun disassemble-display-spec (display &optional (default-display 0) (default-screen 0))
-  (declare (values host display-number nscreen))
   (let ((host-n (position #\: display)))
     (unless host-n
       (return-from disassemble-display-spec 
@@ -322,7 +322,6 @@
 
 (defmethod port-glyph-for-character ((port clx-port)
 				     character text-style &optional our-font)
-  (declare (values index font escapement-x escapement-y origin-x origin-y bb-x bb-y))
   (multiple-value-bind (character-set index)
       (char-character-set-and-index character)
     (when (eq character-set *standard-character-set*)
diff --git a/clx/pkgdcl.lisp b/clx/pkgdcl.lisp
index 1618e8a548d4c571606fa2b8c9be4abeec8a1dac..5088f47fb79e48f47e73bb1c6a95eb3b014b2c07 100644
--- a/clx/pkgdcl.lisp
+++ b/clx/pkgdcl.lisp
@@ -2,11 +2,11 @@
 ;; See the file LICENSE for the full license governing this code.
 ;;
 
-(in-package #-ANSI-90 :user #+ANSI-90 :common-lisp-user)
+(in-package :cl-user)
 
 ;;;"Copyright (c) 1992 Symbolics, Inc.  All rights reserved."
 
-(#-(or ANSI-90 Lucid) clim-lisp::defpackage #+(or ANSI-90 Lucid) defpackage clx-clim
+(defpackage clx-clim
   (:use clim-lisp clim-sys clim clim-utils clim-silica)
 
   (:shadowing-import-from clim-utils
diff --git a/compatibility/clim1-compatibility.lisp b/compatibility/clim1-compatibility.lisp
index 118b1006ea99c2c762c5574f8e721c5ca69a25f4..122048e9298a8ebf86d027fd908dd9d01d837160 100644
--- a/compatibility/clim1-compatibility.lisp
+++ b/compatibility/clim1-compatibility.lisp
@@ -9,7 +9,7 @@
 
 ;;; Compatibility stubs for CLIM 1.1
 
-(eval-when (compile load eval)
+(eval-when (:compile-toplevel :load-toplevel :execute)
   ;; We use this below to flag the compatibility code...
   (pushnew :CLIM-1-compatibility *features*))
 
@@ -130,7 +130,7 @@
   (transform-position transform x y))
 
 
-(eval-when (compile load eval)
+(eval-when (:compile-toplevel :load-toplevel :execute)
 (defun probably-stream-or-medium-p (symbol)
   (and (symbolp symbol)
        ;;--- This is really not completely safe
@@ -842,7 +842,6 @@
 		    (insert-default nil) (replace-input t)
 		    (present-p nil) (active-p t))
   (declare (dynamic-extent accept-args))
-  (declare (values object type))
   (declare (ignore prompt-mode display-default query-identifier
 		   activation-gestures additional-activation-gestures
 		   delimiter-gestures additional-delimiter-gestures 
@@ -1183,7 +1182,6 @@
 					  &key event (modifier-state 0)
 					       #+CLIM-1-compatibility
 					       (shift-mask 0 shift-mask-p))
-  (declare (values translator any-match-p))
   #+CLIM-1-compatibility
   (when shift-mask-p
     (setq modifier-state shift-mask))
@@ -1596,7 +1594,6 @@
 			     #+CLIM-1-compatibility default-style
 			     #+CLIM-1-compatibility inter-row-spacing
 			     #+CLIM-1-compatibility inter-column-spacing)
-  (declare (values value chosen-item gesture))
   (declare (ignore associated-window
 		   text-style default-item
 		   label printer presentation-type
@@ -1653,7 +1650,6 @@
 		 #+CLIM-1-compatibility default-style
 		 #+CLIM-1-compatibility inter-row-spacing
 		 #+CLIM-1-compatibility inter-column-spacing)
-  (declare (values value chosen-item gesture))
   (declare (ignore keys))
   #+CLIM-1-compatibility
   (when default-style
@@ -1718,7 +1714,6 @@
 				      #+CLIM-1-compatibility default-style
 				      #+CLIM-1-compatibility inter-row-spacing
 				      #+CLIM-1-compatibility inter-column-spacing)
-  (declare (values value chosen-item gesture))
   #+CLIM-1-compatibility
   (when default-style
     (setq text-style default-style))
diff --git a/compatibility/packages.lisp b/compatibility/packages.lisp
index 5708817d4ba6077b3536612104628b7b97c82d90..5f0b56f2509fedec2abc2f29949eae81ec784cf0 100644
--- a/compatibility/packages.lisp
+++ b/compatibility/packages.lisp
@@ -7,7 +7,7 @@
 ;;;"Copyright (c) 1992 Symbolics, Inc.  All rights reserved."
 
 
-(eval-when (compile load eval)
+(eval-when (:compile-toplevel :load-toplevel :execute)
 (defvar *clim-1-symbols*
 	'(*abort-characters*
 	  *activation-characters*
@@ -109,7 +109,7 @@
   `(progn ,@body))
 
 ;; Import the above symbols into the CLIM package, then export them
-(eval-when (compile load eval)
+(eval-when (:compile-toplevel :load-toplevel :execute)
   (let ((clim (find-package :clim)))
     (dolist (symbol *clim-1-symbols*)
       (import symbol clim)
diff --git a/demo/browser.lisp b/demo/browser.lisp
index 64459df4e9f8205c763441c2d68fe89a7d3237ce..2a30e8feb7208fe1f64d638f5b4e07aedd8e570e 100644
--- a/demo/browser.lisp
+++ b/demo/browser.lisp
@@ -109,8 +109,7 @@
 (defgeneric display-node (call-node stream))
 (defgeneric node-generate-inferior-objects (call-node subtype))
 (defgeneric node-any-inferior-objects-p (call-node subtype))
-(defgeneric node-arc-drawer (call-node)
-  #+genera (declare (values arc-drawer arc-drawing-options)))
+(defgeneric node-arc-drawer (call-node))
 
 
 (defclass basic-call-node ()
@@ -170,13 +169,13 @@
 
 ;; This is the most basic instantiable sort of call node.
 ;; Commands and translators are written on this, not on BASIC-CALL-NODE.
-(eval-when (compile load eval)
+(eval-when (:compile-toplevel :load-toplevel :execute)
 (defclass call-node (basic-call-node) ())
 )
 
 ;; CALL-SUBNODEs are a stripped-down version of CALL-NODEs, which mostly
 ;; means that most commands and translators don't operate on subnodes.
-(eval-when (compile load eval)
+(eval-when (:compile-toplevel :load-toplevel :execute)
 (defclass call-subnode (basic-call-node) ())
 )
 
@@ -189,7 +188,7 @@
 
 
 ;; Ellipsis nodes
-(eval-when (load compile eval)
+(eval-when (:load-toplevel :compile-toplevel :execute)
 (defclass ellipsis-call-node
 	  (basic-call-node)
   ((replaced-node :reader ellipsis-node-replaced-node :initarg :replaced-node)))
@@ -219,9 +218,7 @@
 (defvar *browser-types* nil)
 
 (defgeneric browser-type-subtypes (type))
-(defgeneric browser-type-information (type subtype)
-  #+genera (declare (values node-maker root-node-maker
-			    graph-type grapher-args presentation-type options)))
+(defgeneric browser-type-information (type subtype))
 
 (defmacro define-browser-type (type presentation-type graph-type options &body subtypes)
   #+genera (declare (zwei:indentation 3 3 4 1))
diff --git a/demo/cad-demo.lisp b/demo/cad-demo.lisp
index 23df5f6855ccc5990c8e4679f428e3b2c3fefd7d..5ded3174b1b8ac6eb11b66f02113cadd3749e3b3 100644
--- a/demo/cad-demo.lisp
+++ b/demo/cad-demo.lisp
@@ -183,7 +183,7 @@
 (defclass input (connection) ())
 
 #+allegro
-(eval-when (compile load eval)
+(eval-when (:compile-toplevel :load-toplevel :execute)
   (defclass input (connection) ()))
 
 (defmethod presentation-type ((input input))
@@ -206,7 +206,7 @@
 (defclass output (connection) ())
 
 #+allegro
-(eval-when (compile load eval)
+(eval-when (:compile-toplevel :load-toplevel :execute)
   (defclass output (connection) ()))
 
 (defmethod presentation-type ((output output))
@@ -230,7 +230,7 @@
   (:default-initargs :size *component-size*))
 
 #+allegro
-(eval-when (compile load eval)
+(eval-when (:compile-toplevel :load-toplevel :execute)
   (defclass component
 	    (basic-thing)
       ((inputs :initform nil)
diff --git a/demo/custom-records.lisp b/demo/custom-records.lisp
index 3c9bd205934f96e7bfbad4acd9e97887bca07f73..217d415d78e813657c7b2ca243a5a0e54b8c7ce1 100644
--- a/demo/custom-records.lisp
+++ b/demo/custom-records.lisp
@@ -137,7 +137,7 @@
   ;; Eat up the initargs that records are supposed to handle
   (declare (ignore object type single-box)))
 
-(eval-when (compile)
+(eval-when (:compile-toplevel)
   (proclaim '(inline make-data-point)))
 
 (defun make-data-point (u v)
@@ -318,7 +318,6 @@
 (defun bsearch (number vector 
 		&key (key #'identity) (start 0) (end (1- (length vector))))
   ;; If a number is in between two values, return the first of the two
-  (declare (values index element))
   (if (< end start)
       (values nil 0)
       (let (#+Genera (vector vector) 
@@ -397,7 +396,6 @@
 	      internal-time-units-per-second))))))
 
 (defun display-sample-dataset (dataset &optional (stream *standard-output*))
-  (declare (values output-record elapsed-time))
   (terpri stream)
   (elapsed-time (display-data dataset stream)))
 
diff --git a/demo/demo-driver.lisp b/demo/demo-driver.lisp
index 3bffeb8082e84c3523732c7f9805953f663f6a01..5ac68b3b903a8d61b4f92411bb418586f344cf0b 100644
--- a/demo/demo-driver.lisp
+++ b/demo/demo-driver.lisp
@@ -8,6 +8,8 @@
 
 (defvar *demos* nil)
 
+(define-presentation-type demo ())      ;<-- ?? It seems to help though. - jacek.zlydach, 2017-05-04.
+
 (defclass demo ()
   ((name :reader demo-name :initarg :name)
    (class :reader demo-class :initarg :class)
@@ -46,8 +48,12 @@
 	;; which occurs while printing the demos name.
 	;; In particular, this can occur when listing
 	;; the Japanese graphics-editor when the correct
-	;; Japanese fonts are not accessible.	
-	(let ((result (catch 'excl::printer-error
+	;; Japanese fonts are not accessible.
+
+        ;; NOTE WORKAROUND added #'error clause for non-Allegro Lisps, because
+        ;; that seems to be the closest equivalent as far as I can tell without access
+        ;; to Allegro environment. -- jacek.zlydach, 2017-05-14
+	(let ((result (catch #-allegro 'error #+Allegro 'excl::printer-error
 			(with-output-as-presentation (stream demo 'demo)
 			  (format stream "~A~%" name))
 			nil)))
@@ -84,25 +90,23 @@
 	     (when (or force (null frame))
 	       (setq frame (apply (if activity-p
 				      #'make-instance
-				    #'make-application-frame)
+                                      #'make-application-frame)
 				  (demo-class demo)
 				  :frame-manager (find-frame-manager :port port)
 				  (demo-initargs demo))))
 	     (if entry
 		 (setf (cdr entry) frame)
-	       (push (cons port frame) (demo-frames demo)))
+                 (push (cons port frame) (demo-frames demo)))
 	     (if (slot-value frame 'clim-internals::top-level-process)
 		 (unless activity-p
 		   (when (eq (frame-state frame) :shrunk)
 		     (note-frame-deiconified (frame-manager frame) frame))
 		   (raise-frame frame))
-	       (run-frame-top-level frame)))))
-    (if background 
-	(mp:process-run-function 
-	 `(:name ,(demo-name demo)
-	   :initial-bindings ((*package* . ',*package*)))
-	 #'do-it)
-      (do-it))))
+                 (run-frame-top-level frame)))))
+    (if background
+        (let ((bt:*default-special-bindings* `((*package* . ',*package*))))
+          (bt:make-thread #'do-it :name (demo-name demo)))
+        (do-it))))
 	
 (defvar *demo-frame* nil)
 
diff --git a/demo/graphics-demos.lisp b/demo/graphics-demos.lisp
index 54b0711925ae7eea6fa5d20c0bfef0ac9a6c2f7c..400a7ab60f334efac85deafc054f006a4317f924 100644
--- a/demo/graphics-demos.lisp
+++ b/demo/graphics-demos.lisp
@@ -180,9 +180,9 @@ rotation and scaling."
 			     :ink (if (oddp i) +background-ink+ +foreground-ink+))))
 	  (demo-sleep stream 2))))))
 
-(defconstant *random-ink-list*
-	     (list +red+ +green+ +blue+
-		   +cyan+ +magenta+ +yellow+ +black+))
+(defparameter *random-ink-list*
+  (list +red+ +green+ +blue+
+        +cyan+ +magenta+ +yellow+ +black+))
 
 (defun random-ink ()
   (nth (random (length *random-ink-list*)) *random-ink-list*))
diff --git a/demo/japanese-graphics-editor.lisp b/demo/japanese-graphics-editor.lisp
index bf1d9b9edde806bcbce600b1d5a3c532e629dedc..7cbcab17d650ce07edb65e0954ef731c0486cafa 100644
--- a/demo/japanese-graphics-editor.lisp
+++ b/demo/japanese-graphics-editor.lisp
@@ -10,12 +10,12 @@
 
 ;;; Ensure that the japanese characters are compiled
 ;;; with the correct external-format.
-(eval-when (compile)
+(eval-when (:compile-toplevel)
   (when (streamp comp::*compile-file-stream*)
     (setf (stream-external-format comp::*compile-file-stream*) :utf8)))
 
 #-ics
-(eval-when (compile)
+(eval-when (:compile-toplevel)
   (warn "~S contains fat strings but is being compiled with a non-ICS lisp"
 	excl:*source-pathname*))
 
diff --git a/demo/listener.lisp b/demo/listener.lisp
index 60ddb56f428615e9717f1edd45bdeddaa8c3ae11..971543ee77cc61f6330db375f7d4e753519cd515 100644
--- a/demo/listener.lisp
+++ b/demo/listener.lisp
@@ -653,8 +653,9 @@
 
 (define-demo "Lisp Listener" lisp-listener :width 600 :height 500)
 
+;;; NOTE WORKAROUND deleted the \210 literal character, because it broke the SBCL reader for me. -- jacek.zlydach, 2017-05-14
 #+Genera
 (define-genera-application lisp-listener
 			   :pretty-name "CLIM Lisp Listener"
-			   :select-key #\ˆ
+			   :select-key #\ [FIXME insert character 210]
 			   :width +fill+ :height +fill+)
diff --git a/demo/navfun.lisp b/demo/navfun.lisp
index e728cc892a2eda0a716f59cdee6b69d8593e9b8e..ec21ce3f096c58d3672c866c20f133dc854fa39b 100644
--- a/demo/navfun.lisp
+++ b/demo/navfun.lisp
@@ -61,7 +61,7 @@
 		:accessor position-deviation)))
 
 #+allegro
-(eval-when (compile load eval)
+(eval-when (:compile-toplevel :load-toplevel :execute)
   (defclass fp-point ()
       ((latitude :initarg :latitude
 		 :accessor point-latitude)
@@ -106,7 +106,7 @@
 	       :accessor position-longname)))
 
 #+allegro
-(eval-when (compile load eval)
+(eval-when (:compile-toplevel :load-toplevel :execute)
   (defclass named-position (ground-position)
       ((name :initarg :name
 	     :accessor position-name)
@@ -125,7 +125,7 @@
       (write (position-name position) :stream stream :escape nil))))
 
 
-(eval-when (compile load eval)
+(eval-when (:compile-toplevel :load-toplevel :execute)
 
 (defun degminsec (degrees &optional (minutes 0) (seconds 0))
   (float (/ (+ (* degrees 3600) (* minutes 60) seconds) 3600)))
@@ -235,7 +235,7 @@
 (defclass airport (named-position) ())
 
 #+allegro
-(eval-when (compile load eval)
+(eval-when (:compile-toplevel :load-toplevel :execute)
   (defclass airport (named-position) ()))
 
 (defmethod draw-position ((airport airport) stream &optional label)
@@ -255,7 +255,7 @@
 (defclass vor (named-position) ())
 
 #+allegro
-(eval-when (compile load eval)
+(eval-when (:compile-toplevel :load-toplevel :execute)
   (defclass waypoint (named-position) ())
   (defclass vor (named-position) ()))
 
@@ -299,7 +299,7 @@
 (defclass ndb (named-position) ())
 
 #+allegro
-(eval-when (compile load eval)
+(eval-when (:compile-toplevel :load-toplevel :execute)
   (defclass ndb (named-position) ()))
 
 (defmethod describe-position-object ((ndb ndb) stream)
@@ -310,7 +310,7 @@
 (defclass named-intersection (named-position) ())
 
 #+allegro
-(eval-when (compile load eval)
+(eval-when (:compile-toplevel :load-toplevel :execute)
   (defclass named-intersection (named-position) ()))
 
 (defmethod draw-position ((intersection named-intersection) stream &optional label)
@@ -327,7 +327,7 @@
 (defclass visual-checkpoint (named-position) ())
 
 #+allegro
-(eval-when (compile load eval)
+(eval-when (:compile-toplevel :load-toplevel :execute)
   (defclass visual-checkpoint (named-position) ()))
 
 
@@ -395,7 +395,7 @@
      (legs :initarg :legs :accessor route-legs)))
 
 #+allegro
-(eval-when (compile load eval)
+(eval-when (:compile-toplevel :load-toplevel :execute)
   (defclass basic-route-segment ()
       ((at :initarg :at
 	   :accessor route-segment-at)))
@@ -438,7 +438,7 @@
 (defclass route (basic-route) ())
 
 #+allegro
-(eval-when (compile load eval)
+(eval-when (:compile-toplevel :load-toplevel :execute)
   (defclass route (basic-route) ()))
 
 (defun route-segment-position-name (route-segment)
@@ -473,7 +473,7 @@
 (defclass victor-airway (basic-route) ())
 
 #+allegro
-(eval-when (compile load eval)
+(eval-when (:compile-toplevel :load-toplevel :execute)
   (defclass victor-airway-segment (basic-route-segment)
       ((properties :accessor victor-airway-segment-properties)
        (next-leg :accessor victor-airway-segment-next-leg)))
@@ -575,7 +575,7 @@
 		   :accessor aircraft-hobs-or-tach)))
 
 #+allegro
-(eval-when (compile load eval)
+(eval-when (:compile-toplevel :load-toplevel :execute)
   (defclass aircraft ()
       ((identification :initarg :identification	; Aircraft tail number
 		       :accessor aircraft-identification)
@@ -689,7 +689,7 @@
      (color :initarg :color
 	    :accessor flight-plan-color)))
 #+allegro
-(eval-when (compile load eval)
+(eval-when (:compile-toplevel :load-toplevel :execute)
   (defclass flight-plan ()
       ((type :initarg :type :accessor flight-plan-type)
        (aircraft-id :initarg :aircraft-id :accessor flight-plan-aircraft-id)
diff --git a/demo/output-record.lisp b/demo/output-record.lisp
index c7fef8e0d00482dc855df7e07edc3f2cb5101d21..3d9755e8d9804fc9a6c2b581f14fbf45bf4e2698 100644
--- a/demo/output-record.lisp
+++ b/demo/output-record.lisp
@@ -18,7 +18,6 @@
 		       (end (1- (length array))))
   "Binary search to find a number in a sorted array."
   ;; If a number is inbetween two values, return the first of the two.
-  (declare (values index element))
   (if (< end start)
       (values nil 0)
       (let ((array array) mid Nmid found)
diff --git a/demo/packages.lisp b/demo/packages.lisp
index ccf851e50842bdf237657f41314315f2a9c0387e..24cb8774d1f861e428a1a37b626a8bb223d88350 100644
--- a/demo/packages.lisp
+++ b/demo/packages.lisp
@@ -2,12 +2,12 @@
 ;; See the file LICENSE for the full license governing this code.
 ;;
 
-(in-package #-ansi-90 :user #+ansi-90 :common-lisp-user)
+(in-package :cl-user)
 
 ;;;"Copyright (c) 1990, 1991 Symbolics, Inc.  All rights reserved.
 ;;; Portions copyright (c) 1988, 1989, 1990 International Lisp Associates."
 
-(#-ansi-90 clim-lisp::defpackage #+ansi-90 defpackage clim-demo
+(defpackage clim-demo
   (:use clim-lisp clim)
 
   (:shadowing-import-from clim-utils
@@ -23,7 +23,7 @@
     start-demo))
 
 
-(#-ansi-90 clim-lisp::defpackage #+ansi-90 defpackage clim-graphics-editor
+(defpackage clim-graphics-editor
   (:use clim-lisp clim clim-demo)
 
   (:shadowing-import-from clim-utils
diff --git a/genera/genera-mirror.lisp b/genera/genera-mirror.lisp
index 18b80f8a6e61713b9063dd1450f103074c8dfcc5..110fcab5384f0da71823a57752f3913e4dc001db 100644
--- a/genera/genera-mirror.lisp
+++ b/genera/genera-mirror.lisp
@@ -414,7 +414,6 @@
 (defvar *old-mouse-chord-shifts* 0)
 
 (defun-inline buttons-up (old-buttons new-buttons)
-  (declare (values buttons-up buttons-down))
   (values (boole boole-andc2 old-buttons new-buttons)
 	  (boole boole-andc2 new-buttons old-buttons)))
 
@@ -741,7 +740,6 @@
 ;; See general comments about sheet-native-native-region* and
 ;; sheet-native-region* about functions vs macros, etc.
 (defun genera-window-margins (mirror)
-  (declare (values left top inside-width inside-height))
   (multiple-value-bind (left top)
       (scl:send mirror :margins)
     (multiple-value-bind (width height)
diff --git a/genera/genera-port.lisp b/genera/genera-port.lisp
index 22108eb03917e3e7e7ebbaa069031a64606acb1f..dac96553cab8581feea37ae97bcf3cccbf9f6f2e 100644
--- a/genera/genera-port.lisp
+++ b/genera/genera-port.lisp
@@ -301,7 +301,6 @@
 
 (defmethod port-glyph-for-character ((port genera-port)
 				     character style &optional our-font)
-  (declare (values index font escapement-x escapement-y origin-x origin-y bb-x bb-y
 		   fixed-width-font-p))
   (with-genera-glyph-for-character
     (port-glyph-for-character port character style our-font)))
diff --git a/gramps-clim2.asd b/gramps-clim2.asd
new file mode 100644
index 0000000000000000000000000000000000000000..806fd2163912babd78cd9c34696979d3a9e7b443
--- /dev/null
+++ b/gramps-clim2.asd
@@ -0,0 +1,224 @@
+
+(in-package #:asdf-user)
+
+(defsystem #:gramps-clim2
+  :description "CLIM 2 implementation released by Franz Inc."
+  :license "BSD-4-Clause"
+  :depends-on (#:gramps-clim2/core))
+
+;;; based on `clim-standalone' in sys/sysdcl.lisp
+(defsystem #:gramps-clim2/core
+  :description "Core functionality (doesn't contain backends)."
+  :depends-on (#:gramps-clim2/silica)
+  :components ((:module "clim"
+                        :components
+                        (;; Basic tools
+                         (:file "gestures")
+                         (:file "defprotocol")
+                         (:file "stream-defprotocols")
+                         (:file "defresource")
+                         (:file "temp-strings")
+                         (:file "clim-defs")
+
+                         ;; Definitions and protocols
+                         (:file "stream-class-defs")
+                         (:file "interactive-defs")
+                         (:file "cursor")
+                         (:file "view-defs")
+                         (:file "input-defs")
+                         (:file "input-protocol")
+                         (:file "output-protocol")
+
+                         ;; Output recording
+                         (:file "recording-defs")
+                         (:file "formatted-output-defs")
+                         (:file "recording-protocol")
+                         (:file "text-recording")
+                         (:file "graphics-recording")
+                         (:file "design-recording")
+
+			 ;; Input editing
+                         (:file "interactive-protocol")
+                         (:file "input-editor-commands")
+                         #+(and allegro (not acl86win32)) (:file "japanese-input-editor")
+
+                         ;; Incremental redisplay
+                         (:file "incremental-redisplay")
+
+                         ;; Windows (sheets)
+                         (:file "coordinate-sorted-set")
+                         (:file "r-tree")
+                         (:file "window-stream")
+                         (:file "pixmap-streams")
+
+			 ;; Presentation types
+                         (:file "ptypes1")
+                         (:file "completer")
+                         (:file "presentations")
+                         (:file "translators")
+                         (:file "histories")
+                         (:file "ptypes2")
+                         (:file "standard-types")
+                         #+allegro (:file "excl-presentations")
+
+                         ;; Formatted output
+                         (:file "table-formatting")
+                         (:file "graph-formatting")
+                         (:file "surround-output")
+                         (:file "text-formatting")
+
+			 ;; Pointer tracking
+                         (:file "tracking-pointer")
+                         (:file "dragging-output")
+
+                         ;; Gadgets
+                         (:file "db-stream")
+                         (:file "gadget-output")
+
+                         ;; Application building substrate
+                         (:file "accept")
+                         (:file "present")
+                         (:file "command")
+                         (:file "command-processor")
+                         (:file "basic-translators")
+                         (:file "frames")
+                         (:file "panes")
+                         (:file "default-frame")
+                         (:file "activities")
+                         (:file "db-menu")
+                         #+acl86win32 (:file "db-list")
+                         #+acl86win32 (:file "db-text")
+                         (:file "noting-progress")
+                         (:file "menus")
+                         (:file "accept-values")
+                         (:file "drag-and-drop")
+                         (:file "item-list-manager")
+
+                         ;; Bootstrap everything
+                         (:file "stream-trampolines")))))
+
+;;; based on `clim-utils'
+(defsystem #:gramps-clim2/utils
+  :depends-on (#:closer-mop)
+  :components
+  ((:module "utils"
+            :components ((:file "packages")
+                         (:file "defun-utilities")
+                         (:file "reader")
+                         (:file "clos-patches")
+                         (:file "clos")
+
+                         ;; General lisp extensions
+                         (:file "utilities")
+                         (:file "lisp-utilities")
+                         (:file "processes")
+                         (:file "queue")
+                         (:file "timers")
+                         (:file "protocols")
+
+                         ;; Establish a uniform stream model
+                         #+ (or) (:file "trivial-gray-streams")
+                         (:file "clim-streams")
+                         (:file "cl-streams")
+
+                         ;; Basic utilities for Silica and CLIM
+                         (:file "clim-macros")
+                         (:file "transformations")
+                         (:file "regions")
+                         (:file "region-arithmetic")
+                         (:file "extended-regions")
+                         (:file "base-designs")
+                         (:file "designs")))))
+
+;;; based on `clim-silica'
+(defsystem #:gramps-clim2/silica
+  :depends-on (#:gramps-clim2/utils
+               #:closer-mop)
+  :components
+  ((:module "silica"
+            :components
+            (;; Silica
+             (:file "macros")
+             (:file "classes")
+             (:file "text-style")
+             (:file "sheet")
+             (:file "mirror")
+             (:file "event")
+             (:file "port")
+             (:file "medium")
+             (:file "framem")
+             (:file "graphics")
+             (:file "pixmaps")
+             (:file "std-sheet")
+
+             ;; "Windshield", aka "DashBoard"
+             ;; Layout gadgets
+             (:file "layout")
+             (:file "db-layout")
+             (:file "db-box")
+             (:file "db-table")
+
+             ;; 'Physical' gadgets
+             (:file "gadgets")
+             (:file "db-border")
+             (:file "db-scroll")
+             (:file "db-button")
+             (:file "db-label")
+             (:file "scroll-pane")))))
+
+#+ (or)
+(defsystem #:gramps-clim2/homegrown
+  :depends-on (#:gramps-clim2/silica)
+  :components
+  ((:module "homegrown"
+  	    :components
+	    ;; not fully compatible with silica (???)
+  	    ((:file "scroll-pane")
+  	     (:file "db-button")
+  	     (:file "db-label")
+  	     (:file "db-slider")
+  	     (:file "db-menu")
+  	     (:file "db-list" :depends-on ("db-menu"))
+  	     (:file "db-text")
+  	     (:file "last")))))
+
+(defsystem #:gramps-clim2/postscript
+  :description "Draw-only backend as defined in the specification.")
+
+;;; based on `clx-clim' in clx/sysdcl.lisp
+(defsystem #:gramps-clim2/clx-backend
+  :description "Reference backend for X-Window system."
+  :depends-on (#:clx #:gramps-clim2/core)
+  :components
+  ((:module "clx"
+	    :components
+	    ((:file "pkgdcl")
+	     (:file "clx-port")
+	     (:file "clx-mirror")
+	     (:file "clx-medium")
+	     (:file "clx-pixmaps")
+	     (:file "clx-frames")))))
+
+;;; based on `clim-demo' in demo/sysdcl.lisp
+(defsystem #:gramps-clim2/examples
+  :description "Applications bundled in gramps-clim2 repository."
+  :depends-on (#:gramps-clim2/core
+               #:bordeaux-threads)
+
+  :components
+  ((:module "demo"
+            :components
+            ((:file "packages")
+             (:file "demo-driver" :depends-on ("packages"))
+             (:file "listener" :depends-on ("demo-driver"))
+             (:file "graphics-demos" :depends-on ("demo-driver"))
+             ;(:file "cad-demo" :depends-on ("demo-driver"))
+             ;(:file "navdata" :depends-on ("packages"))
+             ;(:file "navfun" :depends-on ("navdata"))
+             ;(:file "puzzle" :depends-on ("demo-driver"))
+             ;(:file "address-book" :depends-on ("demo-driver"))
+             ;(:file "thinkadot" :depends-on ("demo-driver"))
+             ;(:file "plot" :depends-on ("demo-driver"))
+             ;(:file "color-editor" :depends-on ("demo-driver"))
+             ;(:file "graphics-editor" :depends-on ("demo-driver"))
+             ))))
diff --git a/hpgl/hpgl-medium.lisp b/hpgl/hpgl-medium.lisp
index eb405941008433e74e4aa5d58c8ad882b5827be1..5531415f99dc0c04a63d33bb19b182013f96e191 100644
--- a/hpgl/hpgl-medium.lisp
+++ b/hpgl/hpgl-medium.lisp
@@ -701,7 +701,6 @@ a point. Hence we have 72dpi resolution printer.
 (defmethod port-glyph-for-character ((port hpgl-port)
 				     character appearance &optional our-font)
   #+Genera
-  (declare (values index font escapement-x escapement-y origin-x origin-y bb-x bb-y))
   (with-hpgl-port-glyph-for-character (port)
     (port-glyph-for-character medium character appearance our-font)))
 
@@ -722,8 +721,6 @@ a point. Hence we have 72dpi resolution printer.
 					    string start end
 					    style cursor-x max-x
 					    &optional glyph-buffer)
-  #+Genera (declare (values write-char next-char-index new-cursor-x
-			    new-baseline new-height font))
   ;;(declare (ignore stream))
   (let (#+ignore (port (port medium)))
     (with-hpgl-port-glyph-for-character (port)
diff --git a/misc/clos-preload.cl b/misc/clos-preload.cl
index 1637b5cadede7a17f3235086deb150f4f8031a29..7f43f50932bda0a73732c86b3a97afd82d3db943 100644
--- a/misc/clos-preload.cl
+++ b/misc/clos-preload.cl
@@ -22,7 +22,7 @@
 
 (in-package :clos)
 
-(eval-when (compile)
+(eval-when (:compile-toplevel)
   (unless (boundp 'si::*clos-preload-packages*)
     (setq si::*clos-preload-packages* nil)))
 
diff --git a/misc/compile-1.lisp b/misc/compile-1.lisp
index 02168ae4050a694d09e08aebbbbdba5e6018aeeb..be4c5510dd54d7d5c25da77344151e8ce5d48c2b 100644
--- a/misc/compile-1.lisp
+++ b/misc/compile-1.lisp
@@ -1,9 +1,9 @@
-;; -*- mode: common-lisp; package: user -*-
+;; -*- mode: common-lisp; package: cl-user -*-
 ;;
 ;; See the file LICENSE for the full license governing this code.
 ;;
 
-(in-package :user)
+(in-package :cl-user)
 
 ;;; This should not matter
 ;;; (setq *ignore-package-name-case* t)
@@ -12,33 +12,9 @@
 (pushnew :ansi-90 *features*)
 
 #+(and allegro microsoft)
-(eval-when (compile load eval) 
+(eval-when (:compile-toplevel :load-toplevel :execute) 
   (pushnew :acl86win32 *features*))
 
-#-(version>= 6 0)
-(setq comp:generate-call-count-code-switch
-  (named-function |(> debug 1)|
-		  (lambda (safety size speed debug)
-		    (declare (ignore safety size speed))
-		    (> debug 1))))
-
-#-(version>= 8 2)
-(setq comp:declared-fixnums-remain-fixnums-switch
-  (named-function |(> speed 2)|
-		  (lambda (safety size speed debug)
-		    (declare (ignore safety size debug))
-		    (> speed 2))))
-
-
-;; [bug18430]:
-#+(version>= 8 2)
-(setq comp:declared-fixnums-remain-fixnums-switch
-  (named-function |(> speed 2)|
-		  (lambda (safety size speed debug compilation-speed)
-		    (declare (ignore safety size debug compilation-speed))
-		    (> speed 2))))
-
-
 ;;;; Set up translations so we can find stuff.
 ;;;
 (setf (logical-pathname-translations "clim2")
diff --git a/misc/pixmaps.lisp b/misc/pixmaps.lisp
index a9bad9555456fd47340cf1f40f8670f0682cb9ea..41cadca98872622bd5accd0ee4590ef6b0fc030f 100644
--- a/misc/pixmaps.lisp
+++ b/misc/pixmaps.lisp
@@ -86,7 +86,7 @@
 #+Genera (SYSTEM-INTERNALS:PATCH-SECTION-ATTRIBUTES
   "-*- Mode: LISP; Syntax: Common-lisp; Package: CLIM; Base: 10; Lowercase: Yes -*-")
 
-(eval-when (compile load eval)
+(eval-when (:compile-toplevel :load-toplevel :execute)
   (scl:export 'clim::(with-output-to-pixmap-stream) 'clim))
 
 (defmacro with-output-to-pixmap-stream ((stream) &body body)
@@ -102,7 +102,7 @@
 #+Genera (SYSTEM-INTERNALS:PATCH-SECTION-ATTRIBUTES
   "-*- Mode: LISP; Syntax: Common-lisp; Package: CLIM; Base: 10; Lowercase: Yes -*-")
 
-(eval-when (compile load eval)
+(eval-when (:compile-toplevel :load-toplevel :execute)
   (scl:export 'clim::(copy-area
 		      allocate-pixmap deallocate-pixmap
 		      copy-to-pixmap copy-from-pixmap
diff --git a/postscript/postscript-medium.lisp b/postscript/postscript-medium.lisp
index bcacba4db7572a2ad6135ba3ea79039ad98053ff..ab2c68c189f753a725c8038dc904731813f09f85 100644
--- a/postscript/postscript-medium.lisp
+++ b/postscript/postscript-medium.lisp
@@ -550,11 +550,8 @@
 
 (defmethod port-glyph-for-character ((port postscript-port)
 				     character style &optional our-font)
-  (declare (values index font escapement-x escapement-y origin-x origin-y bb-x bb-y
-		   fixed-width-font-p))
   (with-postscript-glyph-for-character
-    (port-glyph-for-character port character style our-font)))
-)
+    (port-glyph-for-character port character style our-font))))
 
 ;;-- Is this needed??
 
diff --git a/postscript/postscript-port.lisp b/postscript/postscript-port.lisp
index fe21e90c86d508e3391d694492c18617d33f3d38..6e66505462a723a60b3ec9e3cc5a349503b30e7e 100644
--- a/postscript/postscript-port.lisp
+++ b/postscript/postscript-port.lisp
@@ -1164,7 +1164,7 @@ end } def
 ;;;**********************************************************************
 
 ;;; This needs to be loaded before the next form is compiled.
-(eval-when (compile load eval)
+(eval-when (:compile-toplevel :load-toplevel :execute)
 (define-graphics-generic draw-postscript-literal (string x y)
   :positions-to-transform (x y) )
 )
diff --git a/pre-silica/cloe-implementation.lisp b/pre-silica/cloe-implementation.lisp
index ff813a8b7558cab3f00c6f895b0a5855c76235c5..c4665221ec16aace705ef3154b3297a5a053e605 100644
--- a/pre-silica/cloe-implementation.lisp
+++ b/pre-silica/cloe-implementation.lisp
@@ -47,7 +47,7 @@
 
 ;;;
 
-(eval-when (compile load eval)
+(eval-when (:compile-toplevel :load-toplevel :execute)
 	   
 ;; Define the new key chars for Cloe CLIM.  Regular Cloe defines 0-127, we define
 ;; 128-139 as the F-keys (F1 thru F12), 140 for c-sh-A, and 141 as c-sh-V
diff --git a/pre-silica/clx-implementation.lisp b/pre-silica/clx-implementation.lisp
index 32f5f38b134a551e0e4ab7480d99b103d0183b09..284fe5c77be9b59f2f2e37b098db9f2413a7b721 100644
--- a/pre-silica/clx-implementation.lisp
+++ b/pre-silica/clx-implementation.lisp
@@ -124,7 +124,6 @@
   (:default-initargs :input-buffer nil))
 
 (defun disassemble-display-spec (display &optional (default-display 0) (default-screen 0))
-  (declare (values host display-number nscreen))
   (let ((host-n (position #\: display)))
     (unless host-n
       (return-from disassemble-display-spec 
@@ -1788,7 +1787,6 @@
 ;; TEXT-STYLE  must be a fully merged text style
 (defmethod stream-glyph-for-character
 	   ((stream clx-window) character text-style &optional our-font)
-  (declare (values index font escapement-x escapement-y origin-x origin-y bb-x bb-y))
   (with-slots (window display-device-type) stream
     (multiple-value-bind (character-set index)
 	(char-character-set-and-index character)
@@ -1835,7 +1833,6 @@
 
 ;;; Too bad we have to copy the glyphs again, but that's life...
 (defun noop-translate-function (src src-start src-end font dst dst-start)
-  (declare (values ending-index horizontal-motion width))
   (declare (ignore font))
   (replace dst src :start1 dst-start :start2 src-start :end2 src-end)
   (values src-end nil nil))
diff --git a/pre-silica/define-application.lisp b/pre-silica/define-application.lisp
index 6bfa9a54533bfad13f26656ca42904baaa3c47c4..33c614d658573d7c39653baaff6608b1018f85e9 100644
--- a/pre-silica/define-application.lisp
+++ b/pre-silica/define-application.lisp
@@ -52,7 +52,7 @@
 	  #-Genera t
       (setf (window-label top-level-sheet) name))))
 
-(eval-when (eval compile load)
+(eval-when (:execute :compile-toplevel :load-toplevel)
 
 (defstruct (frame-descriptor (:print-function print-frame-descriptor))
   name
@@ -176,7 +176,7 @@
 				     `(list ',name ',type ,@options)))
 			       pane-descriptions)))
 	`(progn
-	   (eval-when (compile)
+	   (eval-when (:compile-toplevel)
 	     (when ',command-table
 	       (setf (compile-time-property ',(first command-table) 'command-table-name) t))
 	     (define-application-frame-1 ',name ',slots ,pane-descriptions
diff --git a/pre-silica/defs-graphics-generics.lisp b/pre-silica/defs-graphics-generics.lisp
index 47534df24e465a5a86a51fcaa5829b69de9a66a4..e518a2b9d843f97cb8bd82ffc69535b4f79248cd 100644
--- a/pre-silica/defs-graphics-generics.lisp
+++ b/pre-silica/defs-graphics-generics.lisp
@@ -6,7 +6,7 @@
 "Copyright (c) 1990, 1991, 1992 Symbolics, Inc.  All rights reserved.
  Portions copyright (c) 1989, 1990 International Lisp Associates."
 
-(eval-when (compile load eval)
+(eval-when (:compile-toplevel :load-toplevel :execute)
 
 ;; NOTE: if you change this list of keywords, you also have to change the keyword arguments
 ;; accepted by (CLOS:METHOD INVOKE-WITH-DRAWING-OPTIONS (DRAWING-STATE-MIXIN T))
diff --git a/pre-silica/genera-implementation.lisp b/pre-silica/genera-implementation.lisp
index e348dc1f1554a2f468e7b2e1e93e0f57b7e93504..0b77757ee8ab38b6fa8d280fdbf08b10a6b3a718 100644
--- a/pre-silica/genera-implementation.lisp
+++ b/pre-silica/genera-implementation.lisp
@@ -6,7 +6,7 @@
 "Copyright (c) 1990, 1991, 1992 Symbolics, Inc.  All rights reserved."
 
 ;;; Defined below
-(eval-when (compile load eval)
+(eval-when (:compile-toplevel :load-toplevel :execute)
   (proclaim '(special *sheet-device*))
   #+IMach (proclaim '(special *small-sheet-device*)))
 
@@ -888,8 +888,6 @@
 
 (defmethod stream-glyph-for-character ((stream sheet-implementation-mixin)
 				       character style &optional our-font)
-  (declare (values index font escapement-x escapement-y origin-x origin-y bb-x bb-y
-		   fixed-width-font-p))
   (with-sheet-stream-glyph-for-character
     (stream-glyph-for-character stream character style our-font)))
 
@@ -1021,7 +1019,6 @@
 
 ;;; Interface to Genera scroll bars.
 (scl:defmethod (:y-scroll-position clim-sheet) ()
-  (declare (values top-displayed height-displayed minimum-y maximum-y))
   (let* ((stream (sheet-for-genera-window scl:self :error-if-no-match nil))
 	 (history (and stream (stream-output-history stream)))
 	 (viewport (and stream (window-viewport stream))))
@@ -1048,7 +1045,6 @@
 (defun calculate-new-viewport-position (stream x-or-y type position
 					&optional (context-nlines 1))
   (declare (ignore context-nlines))
-  (declare (values viewport-left viewport-top))
   (let ((viewport (window-viewport stream)))
     (ecase x-or-y
       (:y
diff --git a/pre-silica/postscript-implementation.lisp b/pre-silica/postscript-implementation.lisp
index e6de148a683527f4734e3f9e2f588ff81dd7abd3..2270df3a1ad8162e48970bb9d2c2e4bbeb825e08 100644
--- a/pre-silica/postscript-implementation.lisp
+++ b/pre-silica/postscript-implementation.lisp
@@ -908,8 +908,6 @@ x y translate xra yra scale 0 0 1 sa ea arcp setmatrix end} def
 
 (defmethod stream-glyph-for-character ((stream postscript-implementation-mixin)
 				       character style &optional our-font)
-  (declare (values index font escapement-x escapement-y origin-x origin-y bb-x bb-y
-		   fixed-width-font-p))
   (with-ps-stream-glyph-for-character
     (stream-glyph-for-character stream character style our-font)))
 
diff --git a/silica/classes.lisp b/silica/classes.lisp
index 4f5bd6c180b6663c8b4d2aa8d28399174e7adbbe..6c7aa9e566121e9b9c8b3cae6d7abce06072c48b 100644
--- a/silica/classes.lisp
+++ b/silica/classes.lisp
@@ -43,7 +43,7 @@
      (mapping-cache :initform
 		    #+(or aclpc acl86win32) (cons nil nil)
 		    #-(or aclpc acl86win32) (mapping-cache-initform))
-#+(or aclpc acl86win32)
+#+(or aclpc acl86win32 (and))
      (undefined-text-style :initform *undefined-text-style*
                            :accessor port-undefined-text-style)
      ;; When this is true, the text style to device font mapping is done
@@ -74,6 +74,12 @@
 	    v))
    (:-ics (make-hash-table :test #'equal))))
 
+;;; NOTE temporary definition to make examples work; not sure
+;;; what implementation would be right. -- jacek.zlydach, 2017-05-06
+#+ (or sbcl ccl)
+(defun mapping-table-initform ()
+  (make-hash-table :test #'equal))
+
 #+(and Allegro (not (or aclpc acl86win32)))
 (defun mapping-cache-initform ()
   (excl:ics-target-case
@@ -84,6 +90,12 @@
 	    v))
    (:-ics (cons nil nil))))
 
+;;; NOTE temporary definition to make examples work; not sure
+;;; what implementation would be right. -- jacek.zlydach, 2017-05-06
+#+ (or sbcl ccl)
+(defun mapping-cache-initform ()
+  (cons nil nil))
+
 (define-protocol-class sheet ())
 
 (defclass basic-sheet (sheet)
@@ -147,7 +159,9 @@
                 *keyword-package*))))
 
 ;; A fixnum, incremented only with ATOMIC-INCF
-(defvar *event-timestamp* 0)
+(declaim (type fixnum *event-timestamp*))
+#+sbcl (sb-ext:defglobal *event-timestamp* 0)
+#-sbcl (defvar *event-timestamp* 0)
 
 (define-event-class event ()
   ((timestamp :reader event-timestamp
@@ -244,7 +258,7 @@
 (defconstant +pointer-right-button+  (ash 1 10))
 
 ;; The order of this must match the values above
-(defconstant *pointer-buttons* '#(:left :middle :right))
+(defparameter *pointer-buttons* '#(:left :middle :right))
 
 (deftype button-name () '(member :left :middle :right))
 
@@ -260,7 +274,7 @@
 (defconstant +double-key+  (ash 1 5))
 
 ;; The order of this must match the values above
-(defconstant *modifier-keys* '#(:shift :control :meta :super :hyper :double))
+(defparameter *modifier-keys* '#(:shift :control :meta :super :hyper :double))
 
 (deftype shift-keysym   () '(member :left-shift :right-shift))
 (deftype double-keysym  () '(member :left-double :right-double))
diff --git a/silica/db-box.lisp b/silica/db-box.lisp
index c66e3c485321c1c7193fcd87fcfa5621f30fa977..ae10bc1869339673c4c414339503195514ff2a82 100644
--- a/silica/db-box.lisp
+++ b/silica/db-box.lisp
@@ -21,16 +21,19 @@
 (defmethod initialize-instance :after 
 	   ((pane box-pane) &key contents &allow-other-keys)
   (dolist (child contents)
-    (etypecase child
+    ;;NOTE WORKAROUND temporarily changed etypecase to typecase, to avoid a runtime error in demo.
+    ;; Should be restored to etypecase after the source of that error is found.
+    ;;  -- jacek.zlydach, 2017-05-14
+    (typecase child
       (number)
       ((member :fill))
       (pane (sheet-adopt-child pane child))
       (cons
-	;; Handle top-down layout syntax
-	(unless (and (typep (first child) '(or (member :fill) (real 0 *)))
-		     (panep (second child)))
-	  (error "Invalid box child: ~S" child))
-	(sheet-adopt-child pane (second child)))))
+       ;; Handle top-down layout syntax
+       (unless (and (typep (first child) '(or (member :fill) (real 0 *)))
+                    (panep (second child)))
+         (error "Invalid box child: ~S" child))
+       (sheet-adopt-child pane (second child)))))
   (setf (slot-value pane 'contents) contents))
 
 (defmethod handle-event :after ((pane box-pane) (event pointer-motion-event))
@@ -59,40 +62,44 @@
 	    (minor-max most-positive-fixnum)
 	    scale)
 	(dolist (entry contents)
-	  (cond ((eq entry :fill) (incf major+ +fill+))
-		((numberp entry) (incf major entry))
-		(t
-		 (if (consp entry)
-		     (psetf entry (second entry) 
-			    scale (let ((n (first entry)))
-				    (if (numberp n) (float n) n)))
-		   (setf scale 1.0))
-		 (let ((space-req (apply #'compose-space entry width-or-height)))
-		   (flet ((scale (x) 
-			    (if (and (numberp scale) (< x +fill+)) (/ x scale) x)))
-		     (declare (dynamic-extent #'scale))
-		     (cond ((eq scale :fill)
-			    (incf major+ +fill+)
-			    (incf major (scale (funcall fn-major space-req)))
-			    (incf major- (scale (funcall fn-major- space-req))))
-			   ((= scale 1.0)
-			    (incf major+ (scale (funcall fn-major+ space-req)))
-			    (incf major (scale (funcall fn-major space-req)))
-			    (incf major- (scale (funcall fn-major- space-req))))
-			   ((> scale 1.0)
-			    (incf major+ scale)
-			    (incf major scale)
-			    (incf major- scale))
-			   (t
-			    ;; It is maxf because we use the scaling
-			    ;; to calculate the desired size of the
-			    ;; overall pane
-			    (maxf major+ (scale (funcall fn-major+ space-req)))
-			    (maxf major (scale (funcall fn-major space-req)))
-			    (maxf major- (scale (funcall fn-major- space-req)))))
-		     (setq minor (max minor (funcall fn-minor space-req))) 
-		     (maxf minor-min (funcall fn-minor- space-req))
-		     (minf minor-max (funcall fn-minor+ space-req)))))))
+          ;; NOTE WORKAROUND wrapped the whole cond in a when block, to avoid error caused
+          ;; by `entry' being NIL for some reason during initialization of the demo.
+          ;;   -- jacek.zlydach, 2017-05-14
+          (when entry
+           (cond ((eq entry :fill) (incf major+ +fill+))
+                 ((numberp entry) (incf major entry))
+                 (t
+                  (if (consp entry)
+                      (psetf entry (second entry) 
+                             scale (let ((n (first entry)))
+                                     (if (numberp n) (float n) n)))
+                      (setf scale 1.0))
+                  (let ((space-req (apply #'compose-space entry width-or-height)))
+                    (flet ((scale (x) 
+                             (if (and (numberp scale) (< x +fill+)) (/ x scale) x)))
+                      (declare (dynamic-extent #'scale))
+                      (cond ((eq scale :fill)
+                             (incf major+ +fill+)
+                             (incf major (scale (funcall fn-major space-req)))
+                             (incf major- (scale (funcall fn-major- space-req))))
+                            ((= scale 1.0)
+                             (incf major+ (scale (funcall fn-major+ space-req)))
+                             (incf major (scale (funcall fn-major space-req)))
+                             (incf major- (scale (funcall fn-major- space-req))))
+                            ((> scale 1.0)
+                             (incf major+ scale)
+                             (incf major scale)
+                             (incf major- scale))
+                            (t
+                             ;; It is maxf because we use the scaling
+                             ;; to calculate the desired size of the
+                             ;; overall pane
+                             (maxf major+ (scale (funcall fn-major+ space-req)))
+                             (maxf major (scale (funcall fn-major space-req)))
+                             (maxf major- (scale (funcall fn-major- space-req)))))
+                      (setq minor (max minor (funcall fn-minor space-req))) 
+                      (maxf minor-min (funcall fn-minor- space-req))
+                      (minf minor-max (funcall fn-minor+ space-req))))))))
 	;;--- These calcs lead to weirdness when fills are involved.
 	;;--- This looks like a leftover from the time when +/- were relative
 	;;(setq minor- (max 0 (- minor minor-min)))
@@ -173,23 +180,26 @@
 (defmethod allocate-space ((box-pane vbox-pane) width height)
   (with-slots (contents spacing) box-pane
     (let ((space-requirement
-	    (compose-space box-pane :width width :height height)))
+           (compose-space box-pane :width width :height height)))
       (flet ((compose (x)
-	       (cond ((atom x) (compose-space x :width width))
-		     ((eq (car x) :fill) :fill)
-		     (t (car x)))))
+	       (cond
+                 ;;NOTE WORKAROUND added null clause as a safeguard for NIL showing up during initialization of the demo -- jacek.zlydach, 2017-05-14
+                 ((null x) :fill)
+                 ((atom x) (compose-space x :width width))
+                 ((eq (car x) :fill) :fill)
+                 (t (car x)))))
 	(declare (dynamic-extent #'compose))
 	(let* ((adjust (* spacing (1- (length (sheet-children box-pane)))))
 	       (sizes 
 		(allocate-space-to-items
-		  (- height adjust)
-		  (space-requirement+* space-requirement :height (- adjust))
-		  contents
-		  #'space-requirement-min-height
-		  #'space-requirement-height
-		  #'space-requirement-max-height
-		  #'compose))
-	      (y 0))
+                 (- height adjust)
+                 (space-requirement+* space-requirement :height (- adjust))
+                 contents
+                 #'space-requirement-min-height
+                 #'space-requirement-height
+                 #'space-requirement-max-height
+                 #'compose))
+               (y 0))
 	  (mapc #'(lambda (sheet size)
 		    (when (or (panep sheet)
 			      (and (consp sheet)
diff --git a/silica/db-button.lisp b/silica/db-button.lisp
index 5241b4825b2d4b007999340a66d3ff6ac4a5db96..ca7acff0da366a20d2493b4c399a95edb6167947 100644
--- a/silica/db-button.lisp
+++ b/silica/db-button.lisp
@@ -577,44 +577,44 @@ toggle button base. This way they can share the draw code.
     (maxf new-height original-height)
     (multiple-value-bind (result foundp)
         (gethash (list original-pattern new-width new-height) *grow-button-pattern-cache*)
-      (when foundp 
+      (when foundp
         (return-from grow-button-pattern result)))
     (multiple-value-bind (original-array designs)
         (decode-pattern original-pattern)
       (let ((center-x (floor original-width 2))
             (center-y (floor original-height 2))
             (intermediate-array
-              (make-array (list original-height new-width)
-                          :element-type `(unsigned-byte ,(integer-length (1- (length designs)))) 
-                          :initial-element 0))
-            (final-array 
-              (make-array (list new-height new-width) 
-                          :element-type `(unsigned-byte ,(integer-length (1- (length designs))))
-                          :initial-element 0)))
+             (make-array (list original-height new-width)
+                         :element-type `(unsigned-byte ,(integer-length (1- (length designs))))
+                         :initial-element 0))
+            (final-array
+             (make-array (list new-height new-width)
+                         :element-type `(unsigned-byte ,(integer-length (1- (length designs))))
+                         :initial-element 0)))
         (loop for x from 0 to center-x
-              do (loop for y from 0 to (1- original-height)
-                       do (setf (aref intermediate-array y x) (aref original-array y x))))
+           do (loop for y from 0 to (1- original-height)
+                 do (setf (aref intermediate-array y x) (aref original-array y x))))
         (loop for x from (1- new-width) downto (- new-width center-x)
-              for old-x from (1- original-width) by -1
-              do (loop for y from 0 to (1- original-height)
-                       do (setf (aref intermediate-array y x) (aref original-array y old-x))))
+           for old-x downfrom (1- original-width) by 1
+           do (loop for y from 0 to (1- original-height)
+                 do (setf (aref intermediate-array y x) (aref original-array y old-x))))
         (loop for x from (1+ center-x) to (- new-width center-x 1)
-              do (loop for y from 0 to (1- original-height)
-                       do (setf (aref intermediate-array y x)
-                                (aref original-array y center-x))))
+           do (loop for y from 0 to (1- original-height)
+                 do (setf (aref intermediate-array y x)
+                          (aref original-array y center-x))))
         ;; Now the other direction
         (loop for y from 0 to center-y
-              do (loop for x from 0 to (1- new-width)
-                       do (setf (aref final-array y x) (aref intermediate-array y x))))
+           do (loop for x from 0 to (1- new-width)
+                 do (setf (aref final-array y x) (aref intermediate-array y x))))
         (loop for y from (1- new-height) downto (- new-height center-y)
-              for old-y from (1- original-height) by -1
-              do (loop for x from 0 to (1- new-width)
-                       do (setf (aref final-array y x) (aref intermediate-array old-y x))))
+           for old-y downfrom (1- original-height) by 1
+           do (loop for x from 0 to (1- new-width)
+                 do (setf (aref final-array y x) (aref intermediate-array old-y x))))
         (loop for y from (1+ center-y) to (- new-height center-y 1)
-              do (loop for x from 0 to (1- new-width)
-                       do (setf (aref final-array y x) (aref intermediate-array center-y x))))
+           do (loop for x from 0 to (1- new-width)
+                 do (setf (aref final-array y x) (aref intermediate-array center-y x))))
         (let ((result-pattern (make-pattern final-array designs)))
-          (setf (gethash (list original-pattern new-width new-height) 
+          (setf (gethash (list original-pattern new-width new-height)
                          *grow-button-pattern-cache*)
                 result-pattern))))))
 
diff --git a/silica/db-scroll.lisp b/silica/db-scroll.lisp
index 5ee6f9d10e6afb7d263b140f4a808b7a8493c204..5e0f0c386cfc2aecfa040d4abb8fec6275884761 100644
--- a/silica/db-scroll.lisp
+++ b/silica/db-scroll.lisp
@@ -317,7 +317,6 @@
 ;;; Given min1, max1 and value1 which is between them it will return
 ;;; value2 which would be proportionally between min2 and max2.
 (defun compute-symmetric-value (min1 max1 value1 min2 max2)
-  (declare (values value2))
   (let* ((distance1 (- max1 min1))
          (fraction1 (if (zerop distance1)
                         0
diff --git a/silica/event.lisp b/silica/event.lisp
index 15725639a3fada6e3bdb056541b813acf2ebf3c0..08f01233360fd9eedfb393ca4a9ae69925df9cd6 100644
--- a/silica/event.lisp
+++ b/silica/event.lisp
@@ -701,21 +701,10 @@
   ;; Gosh, this macro is bad style, and violates the MOP.
   ;; Piling warts upon warts, we have to force finalization at
   ;; macroexpand time... - smh 18may93
-  (#+Allegro clos:finalize-inheritance 
-   #+aclpc acl:finalize-inheritance
-   #+Clozure ccl:finalize-inheritance
-   #-(or Allegro aclpc Clozure) cl:finalize-inheritance
-   (find-class event-class)) ;smh 18may93
-  (let* ((slots #+aclpc  (acl:class-slots (find-class event-class))
-                #+(and MCL CCL-2) (ccl:class-slots (find-class event-class))
-                #+Clozure (ccl:class-slots (find-class event-class))
-                #-(or (and MCL CCL-2) aclpc Clozure) (clos:class-slots (find-class event-class))
-                )
-         (slot-names #+aclpc (mapcar #'acl:slot-definition-name slots)
-                     #+(and MCL CCL-2) (mapcar #'ccl:slot-definition-name slots)
-                     #+Clozure (mapcar #'ccl:slot-definition-name slots)
-                     #-(or (and MCL CCL-2) aclpc Clozure) (mapcar #'clos:slot-definition-name slots)
-                     )
+  (closer-mop:finalize-inheritance
+   (find-class event-class))            ;smh 18may93
+  (let* ((slots (closer-mop:class-slots (find-class event-class)))
+         (slot-names (mapcar #'closer-mop:slot-definition-name slots))
          (resource-name (fintern "*~A-~A*" event-class 'resource)))
     `(progn
        (defvar ,resource-name nil)
@@ -723,25 +712,25 @@
          ,@(mapcar #'(lambda (slot)
                        (if (eq slot 'timestamp)
                            `(setf (slot-value event ',slot)
-                              (or ,slot (atomic-incf *event-timestamp*)))
-                         `(setf (slot-value event ',slot) ,slot)))
+                                  (or ,slot (atomic-incf *event-timestamp*)))
+                           `(setf (slot-value event ',slot) ,slot)))
                    slot-names))
        (let ((old (assoc ',event-class *resourced-events*)))
          (unless old
            (setq *resourced-events*
-             (append *resourced-events*
-                     (list (list ',event-class ',resource-name
-                                 ;; Allocates, misses, creates, deallocates
-                                 #+meter-events ,@(list 0 0 0 0)))))))
+                 (append *resourced-events*
+                         (list (list ',event-class ',resource-name
+                                     ;; Allocates, misses, creates, deallocates
+                                     #+meter-events ,@(list 0 0 0 0)))))))
        ;; When an event is in the event resource, we use the timestamp
        ;; to point to the next free event
        (let ((previous-event (make-instance ',event-class)))
          (setq ,resource-name previous-event)
          (repeat ,(1- nevents)
-                 (let ((event (make-instance ',event-class
-                                             :timestamp nil)))
-                   (setf (slot-value previous-event 'timestamp) event)
-                   (setq previous-event event)))))))
+           (let ((event (make-instance ',event-class
+                                       :timestamp nil)))
+             (setf (slot-value previous-event 'timestamp) event)
+             (setq previous-event event)))))))
 
 (define-event-resource pointer-motion-event 20)
 (define-event-resource pointer-enter-event 20)
@@ -829,15 +818,9 @@
 (defun copy-event (event)
   (let* ((class (class-of event))
          (copy (allocate-instance class)))
-    (dolist (slot (#+aclpc acl:class-slots 
-                   #+Clozure ccl:class-slots
-                   #-(or aclpc Clozure) clos:class-slots class))
-      (let ((name (#+aclpc acl:slot-definition-name 
-                   #+Clozure ccl:slot-definition-name
-                   #-(or aclpc Clozure) clos:slot-definition-name slot))
-            (allocation (#+aclpc acl:slot-definition-allocation
-                         #+Clozure ccl:slot-definition-allocation
-                         #-(or aclpc Clozure) clos:slot-definition-allocation slot)))
+    (dolist (slot (closer-mop:class-slots class))
+      (let ((name (closer-mop:slot-definition-name slot))
+            (allocation (closer-mop:slot-definition-allocation slot)))
         (when (and (eql allocation :instance)
                    (slot-boundp event name))
           (setf (slot-value copy name) (slot-value event name)))))
diff --git a/silica/framem.lisp b/silica/framem.lisp
index 371d2c5acd102c6c28b00ad42bf8e055b4564a4b..ee6d8cc85cb5c32c0018cda8aa0665eb04baad1e 100644
--- a/silica/framem.lisp
+++ b/silica/framem.lisp
@@ -106,8 +106,8 @@
                                :region (multiple-value-bind (width height)
                                            (bounding-rectangle-size top-pane)
                                          (make-bounding-rectangle 0 0 width height))
-#-(or aclpc acl86win32) :background #-(or aclpc acl86win32) (frame-background frame)
-#-(or aclpc acl86win32) :foreground #-(or aclpc acl86win32) (frame-foreground frame)
+#-(or aclpc acl86win32 (and)) :background #-(or aclpc acl86win32 (and)) (frame-background frame)
+#-(or aclpc acl86win32 (and)) :foreground #-(or aclpc acl86win32 (and)) (frame-foreground frame)
                                :text-style (frame-text-style frame)))))
       (sheet-adopt-child (find-graft :port (port frame)) sheet)
       (setf (frame-top-level-sheet frame) sheet
@@ -220,5 +220,5 @@
                options))))
 
 (defmethod make-pane-arglist ((framem standard-frame-manager) type &rest options)
-  (declare (ignore type) #-Clozure (non-dynamic-extent options))
+  (declare (ignore type))
   options)
diff --git a/silica/gadgets.lisp b/silica/gadgets.lisp
index bbefb32bdea0d40cff7649bf3c72835ad837b3f3..8708c4e0dadbf9b5522d0c0548e1dc9d1501aa6d 100644
--- a/silica/gadgets.lisp
+++ b/silica/gadgets.lisp
@@ -478,13 +478,11 @@
 ;;;
 
 (defclass push-button 
-	  (action-gadget labelled-gadget-mixin) 
-    ((show-as-default :initform nil :initarg :show-as-default
-		      :accessor push-button-show-as-default)
-     #+(or aclpc acl86win32)
-     (pattern :initarg :pattern)
-     #+(or aclpc acl86win32)
-     (icon-pattern :initarg :icon-pattern)))
+    (action-gadget labelled-gadget-mixin) 
+  ((show-as-default :initform nil :initarg :show-as-default
+                    :accessor push-button-show-as-default)
+   (pattern :initarg :pattern)
+   (icon-pattern :initarg :icon-pattern)))
 
 
 ;;; Toggle button
@@ -784,7 +782,7 @@ The text-field must have the focus before you can call this function."))
 	:height h :min-height 0 :max-height max-height))))
 
 ;;;#+(or aclpc acl86win32)
-;;;(eval-when (compile load eval)
+;;;(eval-when (:compile-toplevel :load-toplevel :execute)
 ;;;   ;;mm: 11Jan95 - this is defined later in clim\db-strea
 ;;;   (unless (ignore-errors (find-class 'clim-stream-pane))
 ;;;      (defclass clim-stream-pane () ())))
diff --git a/silica/graphics.lisp b/silica/graphics.lisp
index 6e013959462bc017ac8fa0a9cf643df6281592cc..37098315c5911fc58ae4c81b1bd4e76bff4bef85 100644
--- a/silica/graphics.lisp
+++ b/silica/graphics.lisp
@@ -8,7 +8,7 @@
 ;;; Portions copyright (c) 1991, 1992 Franz, Inc.  All rights reserved."
 
 
-(eval-when (compile load eval)
+(eval-when (:compile-toplevel :load-toplevel :execute)
 
 ;; NOTE: if you change this list of keywords, you also have to change the keyword arguments
 ;; accepted by (CLOS:METHOD INVOKE-WITH-DRAWING-OPTIONS (DRAWING-STATE-MIXIN T))
@@ -66,7 +66,7 @@
 )        ;eval-when
 
 
-(eval-when (compile load eval)
+(eval-when (:compile-toplevel :load-toplevel :execute)
 
 (defun write-graphics-function-transformer (name
                                             medium-graphics-function-name
@@ -525,10 +525,6 @@
                     &key (from-head nil) (to-head t) (head-length 10) (head-width 5)
                     &allow-other-keys)
   (declare (dynamic-extent args))
-  (declare (arglist medium x1 y1 x2 y2
-                    &rest args
-                    &key (from-head nil) (to-head t) (head-length 10) (head-width 5)
-                    . #.(all-drawing-options-lambda-list :line-cap)))
   (flet ((draw-arrow ()
            (let* ((dx (- x2 x1))
                   (dy (- y2 y1))
@@ -568,10 +564,6 @@
 
 (defun draw-arrow (medium point1 point2 &rest args)
   (declare (dynamic-extent args))
-  (declare (arglist medium x1 y1 x2 y2
-                    &rest args
-                    &key (from-head nil) (to-head t) (head-length 10) (head-width 5)
-                    . #.(all-drawing-options-lambda-list :line-cap)))
   (apply #'draw-arrow*
          medium (point-x point1) (point-y point1) (point-x point2) (point-y point2) args))
 
@@ -642,10 +634,6 @@
 (defun draw-regular-polygon* (medium x1 y1 x2 y2 nsides
                               &rest args &key (handedness :left) (closed t) &allow-other-keys)
   (declare (dynamic-extent args))
-  (declare (arglist medium x1 y1 x2 y2 nsides
-                    &rest args
-                    &key (filled t) (handedness :left) (closed t)
-                    . #.(all-drawing-options-lambda-list :line-joint-cap)))
   (let* ((theta (* (float (* pi (/ 2.0 nsides)) 0.0)
                    (ecase handedness
                      (:left +1)
@@ -669,10 +657,6 @@
 
 (defun draw-regular-polygon (medium point1 point2 nsides &rest args)
   (declare (dynamic-extent args))
-  (declare (arglist medium point1 point2 nsides
-                    &rest args
-                    &key (handedness :left) (closed t) (filled t)
-                    . #.(all-drawing-options-lambda-list :line-joint-cap)))
   (apply #'draw-regular-polygon* medium
                                  (point-x point1) (point-y point1)
                                  (point-x point2) (point-y point2)
@@ -680,17 +664,11 @@
 
 (defun draw-triangle (medium p1 p2 p3 &rest args)
   (declare (dynamic-extent args))
-  (declare (arglist medium p1 p2 p3
-                    &rest args
-                    &key (filled t) . #.(all-drawing-options-lambda-list :line-joint)))
   (with-stack-list (points p1 p2 p3)
     (apply #'draw-polygon medium points :closed t args)))
 
 (defun draw-triangle* (medium x1 y1 x2 y2 x3 y3 &rest args)
   (declare (dynamic-extent args))
-  (declare (arglist medium x1 y1 x2 y2 x3 y3
-                    &rest args
-                    &key (filled t) . #.(all-drawing-options-lambda-list :line-joint)))
   (with-stack-list (points x1 y1 x2 y2 x3 y3)
     (apply #'draw-polygon* medium points :closed t args)))
 
@@ -705,10 +683,6 @@
 
 (defun draw-circle (medium center radius &rest args)
   (declare (dynamic-extent args))
-  (declare (arglist medium center radius
-                    &rest args
-                    &key start-angle end-angle (filled t)
-                    . #.(all-drawing-options-lambda-list :line-cap)))
   (apply #'draw-ellipse medium center radius 0 0 radius args))
 
 (define-compiler-macro draw-circle (medium center radius &rest args)
@@ -722,10 +696,6 @@
 
 (defun draw-circle* (medium center-x center-y radius &rest args)
   (declare (dynamic-extent args))
-  (declare (arglist medium center-x center-y radius
-                    &rest args
-                    &key start-angle end-angle (filled t)
-                    . #.(all-drawing-options-lambda-list :line-cap)))
   (apply #'draw-ellipse* medium center-x center-y radius 0 0 radius args))
 
 (define-compiler-macro draw-circle* (medium center-x center-y radius &rest args)
@@ -742,9 +712,6 @@
 (defun draw-oval* (medium center-x center-y x-radius y-radius
                    &rest args &key (filled t) &allow-other-keys)
   (declare (dynamic-extent args))
-  (declare (arglist medium center-x center-y x-radius y-radius
-                    &rest args
-                    . #.(all-drawing-options-lambda-list :line-cap)))
   (flet ((draw-oval ()
            (let ((left (- center-x x-radius))
                  (right (+ center-x x-radius))
@@ -794,9 +761,6 @@
 
 (defun draw-oval (medium center x-radius y-radius &rest args)
   (declare (dynamic-extent args))
-  (declare (arglist medium point x-radius y-radius
-            &rest args
-            . #.(all-drawing-options-lambda-list :line-cap)))
   (apply #'draw-oval*
          medium (point-x center) (point-y center) x-radius y-radius args))
 
diff --git a/silica/macros.lisp b/silica/macros.lisp
index 42f993b5178cf93b021c810866df9712204878ed..a13f4799e7d1202a6ab50a61149a56d139b59a13 100644
--- a/silica/macros.lisp
+++ b/silica/macros.lisp
@@ -7,16 +7,14 @@
 ;;;"Copyright (c) 1991, 1992 Franz, Inc.  All rights reserved.
 ;;; Portions copyright (c) 1992 Symbolics, Inc.  All rights reserved."
 
-(defgeneric invoke-with-sheet-medium (sheet continuation)
-  (declare (dynamic-extent continuation)))
+(defgeneric invoke-with-sheet-medium (sheet continuation))
 
 (defmacro with-sheet-medium ((medium sheet) &body body)
   `(flet ((with-sheet-medium-body (,medium) ,@body))
      (declare (dynamic-extent #'with-sheet-medium-body))
      (invoke-with-sheet-medium ,sheet #'with-sheet-medium-body)))
 
-(defgeneric invoke-with-sheet-medium-bound (sheet medium continuation)
-  (declare (dynamic-extent continuation)))
+(defgeneric invoke-with-sheet-medium-bound (sheet medium continuation))
 
 (defmacro with-sheet-medium-bound ((sheet medium) &body body)
   `(flet ((with-sheet-medium-bound-body () ,@body))
diff --git a/silica/medium.lisp b/silica/medium.lisp
index 98da1216c03b8bb8f812627953343ec1dd80ce7d..598788dc767593ee73cee8a75b3a87f1a8d576a1 100644
--- a/silica/medium.lisp
+++ b/silica/medium.lisp
@@ -107,7 +107,7 @@
 (defclass sheet-with-resources-mixin ()
   ((foreground :initform nil :accessor pane-foreground)
    (background :initform nil :accessor pane-background)
-   (text-style :initform nil :accessor pane-text-style)
+   (text-style :initform nil :initarg :text-style :accessor pane-text-style)
    (initargs :initform nil :reader sheet-with-resources-initargs)))
   
 (defmethod initialize-instance :after 
@@ -487,7 +487,6 @@
 
 (defoperation text-size medium-protocol
   ((medium medium) string &key text-style start end)
-  (declare (values largest-x total-height last-x last-y baseline))
   (:no-defgeneric t))
 
 
diff --git a/silica/mirror.lisp b/silica/mirror.lisp
index 13cf1351f004bd14f149eefc7462f7f405b1b5c3..2827d0c07a027189411eead8f97cdb6097c12a40 100644
--- a/silica/mirror.lisp
+++ b/silica/mirror.lisp
@@ -173,14 +173,12 @@
 
 ;; Returns the coordinates of sheet's mirror in the coordinates of the
 ;; parent of the mirror
-(defgeneric mirror-region* (port sheet)
-  #-aclpc (declare (values left top right bottom)))
+(defgeneric mirror-region* (port sheet))
 
 ;; Returns the coordinates of sheet's mirror in the coordinates of the
 ;; mirror itself.  That is, it will return 0,0,WIDTH,HEIGHT for most
 ;; known window systems
-(defgeneric mirror-inside-region* (port sheet)
-  (declare (values left top right bottom)))
+(defgeneric mirror-inside-region* (port sheet))
 
 (defgeneric mirror-native-edges* (port sheet))
 (defgeneric mirror-inside-edges* (port sheet))
diff --git a/silica/port.lisp b/silica/port.lisp
index 9496658ebe196637faaf4f258816ff6b52e40c41..f459327b6d6ed60046fdba243714356f7071321c 100644
--- a/silica/port.lisp
+++ b/silica/port.lisp
@@ -10,12 +10,12 @@
 
 ;; Ports and grafts
 
-(defvar *default-server-path* #+(and allegro (not microsoft)) '(:motif)
-                              #+Lucid '(:clx)
-                              #+Genera `(:genera)
-                              #+Cloe-Runtime `(:cloe)
-                              #+(and allegro microsoft) '(:aclpc)
-                              #-(or allegro Lucid Genera Cloe-Runtime) nil)
+(defvar *default-server-path*
+  #+(and allegro (not microsoft)) '(:motif)
+  #+Genera `(:genera)
+  #+Cloe-Runtime `(:cloe)
+  #+(and allegro microsoft) '(:aclpc)
+  #-(or allegro Lucid Genera Cloe-Runtime) '(:clx))
 
 
 (defvar *ports* nil)
@@ -230,7 +230,6 @@
 
 (defun fit-region*-in-region* (left1 top1 right1 bottom1
                                left2 top2 right2 bottom2)
-  #+Genera (declare (values left1 top1 right1 bottom1 adjusted-p))
   (let* ((adjusted-p nil)
          (w (- right1 left1))
          (h (- bottom1 top1))
diff --git a/silica/protocols.lisp b/silica/protocols.lisp
index 2737d34bdac5584ff1d377204d3bd35ab2a2f77e..f0086f24c31dfe93c1c17383f752183c30b50c53 100644
--- a/silica/protocols.lisp
+++ b/silica/protocols.lisp
@@ -50,13 +50,13 @@
 
 (defmacro defprotocol (name supers &rest options)
   (declare (ignore supers options))
-  `(eval-when (compile eval load)
+  `(eval-when (:compile-toplevel :execute :load-toplevel)
      (setf (find-protocol ',name)
 	     (make-instance 'protocol :name ',name))))
 
 (defmacro defrole (class supers slots &rest options)
   (declare (ignore supers options))
-  `(eval-when (compile eval load)
+  `(eval-when (:compile-toplevel :execute :load-toplevel)
      #+PCL
      (pcl::do-standard-defsetf
        ,@(mapcan #'(lambda (slot)
@@ -88,7 +88,7 @@
 				t))
 			required-arg-specs))
 	 (extra-args (and pos (subseq arg-specs pos))))
-    `(eval-when (compile eval load)
+    `(eval-when (:compile-toplevel :execute :load-toplevel)
        ;; Define a group named (OPERATION PROTOCOL NAME), since we can
        ;; have multiple DEFOPERATIONs for the same operation in
        ;; different protocols (used to just be named NAME).
diff --git a/silica/scroll-pane.lisp b/silica/scroll-pane.lisp
index a64f76046d7c0a91605a46b391f5157ddc82b34e..84e3bfebb1893546a21bd322dc0222e0332fe1b9 100644
--- a/silica/scroll-pane.lisp
+++ b/silica/scroll-pane.lisp
@@ -239,7 +239,18 @@
         (:horizontal (- right left))
         (:vertical (- bottom top))))))
 
-(defmethod scroll-up-line-callback ((scroll-bar scroll-bar-pane) scroller-pane orientation)
+;;; NOTE WORKAROUND
+;;; The following methods requires 4 parameters. Added `workaround' parameter for that,
+;;; but the methods should be further reviewed for correctness.
+;;; - scroll-up-line-callback
+;;; - scroll-down-line-callback
+;;; - scroll-up-page-callback
+;;; - scroll-down-page-callback
+;;; - scroll-to-top-callback
+;;; - scroll-to-bottom-callback
+;;;
+;;; -- jacek.zlydach 2017-05-14
+(defmethod scroll-up-line-callback ((scroll-bar scroll-bar-pane) scroller-pane orientation whatever)
   (with-slots (current-size current-value port) scroll-bar
     (with-slots (viewport contents) scroller-pane
       (let* ((contents-range (contents-range scroller-pane orientation))
@@ -252,7 +263,7 @@
         (scroll-bar-value-changed-callback
           scroll-bar scroller-pane orientation new-value current-size)))))
 
-(defmethod scroll-down-line-callback ((scroll-bar scroll-bar-pane) scroller-pane orientation)
+(defmethod scroll-down-line-callback ((scroll-bar scroll-bar-pane) scroller-pane orientation whatever)
   (with-slots (current-size current-value port) scroll-bar
     (with-slots (viewport contents) scroller-pane
       (let* ((contents-range (contents-range scroller-pane orientation))
@@ -265,7 +276,7 @@
         (scroll-bar-value-changed-callback
           scroll-bar scroller-pane orientation new-value current-size)))))
 
-(defmethod scroll-up-page-callback ((scroll-bar scroll-bar-pane) scroller-pane orientation)
+(defmethod scroll-up-page-callback ((scroll-bar scroll-bar-pane) scroller-pane orientation whatever)
   (with-slots (current-size current-value) scroll-bar
     (with-slots (viewport contents) scroller-pane
       (let* ((contents-range (contents-range scroller-pane orientation))
@@ -279,7 +290,7 @@
         (scroll-bar-value-changed-callback
           scroll-bar scroller-pane orientation new-value current-size)))))
 
-(defmethod scroll-down-page-callback ((scroll-bar scroll-bar-pane) scroller-pane orientation)
+(defmethod scroll-down-page-callback ((scroll-bar scroll-bar-pane) scroller-pane orientation whatever)
   (with-slots (current-size current-value) scroll-bar
     (with-slots (viewport contents) scroller-pane
       (let* ((contents-range (contents-range scroller-pane orientation))
@@ -293,11 +304,11 @@
       (scroll-bar-value-changed-callback
         scroll-bar scroller-pane orientation new-value current-size)))))
 
-(defmethod scroll-to-top-callback ((scroll-bar scroll-bar-pane) client id)
+(defmethod scroll-to-top-callback ((scroll-bar scroll-bar-pane) client id whatever)
   (with-slots (current-size current-value) scroll-bar
     (scroll-bar-value-changed-callback scroll-bar client id 0 current-size)))
 
-(defmethod scroll-to-bottom-callback ((scroll-bar scroll-bar-pane) client id)
+(defmethod scroll-to-bottom-callback ((scroll-bar scroll-bar-pane) client id whatever)
   (with-slots (current-size current-value) scroll-bar
     (scroll-bar-value-changed-callback
       scroll-bar client id 1.0 current-size)))
diff --git a/silica/sheet.lisp b/silica/sheet.lisp
index 72960ac7aab948f264f891c5700b67b3fdb2e221..f27dc45707ea7f216df51f913ffe353450f1482c 100644
--- a/silica/sheet.lisp
+++ b/silica/sheet.lisp
@@ -220,8 +220,7 @@
                        (sheet-transformation child) left top right bottom))))
           (sheet-children sheet)))))
 
-(defgeneric map-over-sheets-containing-position (function sheet x y)
-  (declare (dynamic-extent function)))
+(defgeneric map-over-sheets-containing-position (function sheet x y))
 (defmethod map-over-sheets-containing-position (function (sheet basic-sheet) x y)
   (declare (dynamic-extent function))
   (dolist (child (sheet-children sheet))
@@ -231,8 +230,7 @@
                  (region-contains-position-p (sheet-region child) x y)))
       (funcall function child))))
 
-(defgeneric map-over-sheets-overlapping-region (function sheet region)
-  (declare (dynamic-extent function)))
+(defgeneric map-over-sheets-overlapping-region (function sheet region))
 (defmethod map-over-sheets-overlapping-region (function (sheet basic-sheet) region)
   (declare (dynamic-extent function))
   (if (or (null region)                                ;--- kludge
diff --git a/silica/text-style.lisp b/silica/text-style.lisp
index 2b52a3749ba49403dfdba0b58692a842cc741e13..1209efdf24fbacaecf10dee4b2f5f2eae3f79490 100644
--- a/silica/text-style.lisp
+++ b/silica/text-style.lisp
@@ -346,9 +346,9 @@
             (setf (cdr mapping-pair) underlying)
             (push (cons logical underlying) (cdr pair)))))))
 
-(defconstant %%face-code-no-merge (byte 1 28))
-(defconstant %%face-code-class (byte 4 24))
-(defconstant %%face-code-faces (byte 24 0))
+(defparameter %%face-code-no-merge (byte 1 28))
+(defparameter %%face-code-class (byte 4 24))
+(defparameter %%face-code-faces (byte 24 0))
 
 (defun face->face-code (face)
   (when (null face) (return-from face->face-code nil))
@@ -494,7 +494,6 @@
 (defmethod text-size ((medium basic-medium) string
                       &key (text-style (medium-merged-text-style medium))
                            (start 0) end)
-  (declare (values largest-x total-height last-x last-y baseline))
   ;; this shouldn't be necessary because of trampolines directly above
   ;;  31jan97 tjm w/colin
   #+(or aclpc acl86win32)
@@ -815,7 +814,6 @@
 
 #-(or aclpc acl86win32)
 (defun-inline char-character-set-and-index (character)
-  (declare (values character-set index))
   (values #+Allegro
 	  (excl:ics-target-case
            (:-ics *standard-character-set*)
@@ -830,7 +828,6 @@
 #+(or aclpc acl86win32)
 ;;; For now, only standard character set characters are understood...
 (defun-inline char-character-set-and-index (character)
-  (declare (values character-set index))
   (values *standard-character-set* (char-code character)))
 
 
diff --git a/specs/clim-sys.tex b/specs/clim-sys.tex
index fb1ea6662cd6ac4915e9b3af4c916b751280372c..7cfe6996d8df137d001f2681924e9d0108f71f94 100644
--- a/specs/clim-sys.tex
+++ b/specs/clim-sys.tex
@@ -260,7 +260,6 @@ called \cl{sample-output-record} might be defined as follows:
 
 \begin{verbatim}
 (defgeneric output-record-position (record)
-  (declare (values x y)))
 (defgeneric* (setf output-record-position) (x y record))
 
 (defmethod output-record-position ((record sample-output-record))
diff --git a/specs/design-classes.lisp b/specs/design-classes.lisp
index c3c7026eb0046468efd2015373a1a0a16d849936..4a302ff043f0ff8fdf90a092866d7cf21051d503 100644
--- a/specs/design-classes.lisp
+++ b/specs/design-classes.lisp
@@ -2,7 +2,7 @@
  
 (defvar *classes*)
 
-(eval-when (compile load eval)
+(eval-when (:compile-toplevel :load-toplevel :execute)
   (pushnew :eps-bbox cl:*features*))
 
 (defmacro with-postscript-stream ((stream pathname) &body body)
diff --git a/specs/rendering-conventions.lisp b/specs/rendering-conventions.lisp
index ee272a35aa9361285279e6c21a6e0490b2dd7684..4aef6eb0f519d5f49fd928c0efdf6cc7fea26135 100644
--- a/specs/rendering-conventions.lisp
+++ b/specs/rendering-conventions.lisp
@@ -51,7 +51,7 @@
 		(loop for y from dtop below dbottom do
 		  (graphics:draw-point (+ x .5) (+ y .5)))))))))))
 
-(eval-when (compile load eval)
+(eval-when (:compile-toplevel :load-toplevel :execute)
   (pushnew :eps-bbox cl:*features*))
 
 (defmacro with-postscript-stream ((stream pathname) &body body)
diff --git a/sys/compile.lisp b/sys/compile.lisp
index 408ef0d0a5e88f52d2a1dbdcf6d5d62ac9b66944..059ddac55c6ab43ea613d89b1bd1fc1e2b87cea3 100644
--- a/sys/compile.lisp
+++ b/sys/compile.lisp
@@ -10,7 +10,7 @@
 (proclaim '(optimize (speed 3) (safety 1) (debug 1)))
 
 #+(and allegro microsoft)
-(eval-when (compile load eval) 
+(eval-when (:compile-toplevel :load-toplevel :execute) 
   (pushnew :acl86win32 *features*))
 
 #+microsoft
@@ -27,7 +27,7 @@
 
 ;; should probably change ANSI-90 to ANSI-CL throughout the CLIM code but
 ;; until then... (aclpc gets this feature in defsystem)
-(eval-when (compile load eval)
+(eval-when (:compile-toplevel :load-toplevel :execute)
   (pushnew :ansi-90 *features*)
   (setf (logical-pathname-translations "clim2")
     `((";**;*.*" ,*clim-root*)))
diff --git a/sys/defsystem.lisp b/sys/defsystem.lisp
index 3c7d82b7a8fd287b6ca3b05ca19055b74134f757..2c135b2716c468b7137907389a64492113fc45f5 100644
--- a/sys/defsystem.lisp
+++ b/sys/defsystem.lisp
@@ -35,7 +35,7 @@
 ;; ANSI-90, corresponding to what we think the spec will be, in late 1990.
 
 #+Allegro
-(eval-when (compile load eval)
+(eval-when (:compile-toplevel :load-toplevel :execute)
   (warn "This file is no longer used in the Allegro port. \
 Something is wrong if this warning appears!"))
 
@@ -45,7 +45,7 @@ Something is wrong if this warning appears!"))
   (pushnew :ansi-90 *features*))
 
 #+Genera
-(eval-when (compile load eval)
+(eval-when (:compile-toplevel :load-toplevel :execute)
   (multiple-value-bind (major minor) (sct:get-system-version)
     (declare (ignore minor))
     (when (>= major 437)
@@ -111,7 +111,7 @@ Something is wrong if this warning appears!"))
 ;;; *** A temporary workaround, easier than fixing all references to
 ;;; *** LISP:<foo>.  --RWK 20.Nov.90
 #+ANSI-90
-(eval-when (eval compile load)
+(eval-when (:execute :compile-toplevel :load-toplevel)
   (flet ((fix-package (pack-name add-name)
            (setq add-name (string add-name))
            (let ((pack (find-package pack-name)))
@@ -136,12 +136,12 @@ Something is wrong if this warning appears!"))
 ;;;
 
 #-(or Minima Genera)
-(eval-when (eval load compile)
+(eval-when (:execute :load-toplevel :compile-toplevel)
   (shadow (list (intern (symbol-name :make-pathname) :lisp)
                 (intern (symbol-name :pathname-directory) :lisp))))
 
 #-(or Minima Genera)
-(eval-when (eval load compile)
+(eval-when (:execute :load-toplevel :compile-toplevel)
   (export (list (intern (symbol-name :make-pathname) :clim-defsystem)
                 (intern (symbol-name :pathname-directory) :clim-defsystem))))
 
@@ -1211,7 +1211,7 @@ pathname fields are evaluated."
 
 ;; The following are used to prevent multiple compilations/loads from occuring
 ;; during a single call to LOAD-SYSTEM or COMPILE-SYSTEM.
-(eval-when (eval compile)
+(eval-when (:execute :compile-toplevel)
   (proclaim '(special *loaded-systems* *loaded-modules* 
                       *compiled-systems* *compiled-modules*
                       *tracep*)))
diff --git a/sys/load-clim2.lisp b/sys/load-clim2.lisp
index 9591caa0f81ffd7800d2fa251d16cbe79b91ec82..bbf07d788d42aa29ee2e5b0695c94f52215d3b3b 100644
--- a/sys/load-clim2.lisp
+++ b/sys/load-clim2.lisp
@@ -10,7 +10,7 @@
 		 ;; CLIM 2.0
 		 clim-sys clim-silica clim-internals clx-clim genera-clim
 		 ;; CLIM 0.9
-		 clim-conditions clim-shared clim-stream
+		 clim-shared clim-stream
 		 silica windshield on-x on-genera))
     (when (find-package pkg)
       (delete-package pkg)))
diff --git a/sys/load.lisp b/sys/load.lisp
index 9e6d6e9d2d8e8813cabc6706130eb50114d64b6b..807b7ba6103c27402034d35bde842c9875bac0a0 100644
--- a/sys/load.lisp
+++ b/sys/load.lisp
@@ -4,7 +4,7 @@
 (in-package :user)
 
 #+(and Allegro (or microsoft mswindows))
-(eval-when (compile load eval) (push :acl86win32 *features*))
+(eval-when (:compile-toplevel :load-toplevel :execute) (push :acl86win32 *features*))
 
 #+acl86win32
 (let ((excl::*enable-package-locked-errors* nil))
diff --git a/sys/sysdcl-pc.lisp b/sys/sysdcl-pc.lisp
index 3e967c7c3e0c08c6412525231db479e792691ea0..fd705997acdf907f3e49513bdebb8e717ecf5572 100644
--- a/sys/sysdcl-pc.lisp
+++ b/sys/sysdcl-pc.lisp
@@ -6,7 +6,7 @@
 
 "Copyright (c) 1990, 1991, 1992 Symbolics, Inc.  All rights reserved."
 
-(eval-when (compile load eval)
+(eval-when (:compile-toplevel :load-toplevel :execute)
 
 ;;; Tell the world that we're here
 ;;;--- These need to be in the CLIM.fasl also.
@@ -43,7 +43,7 @@
 ;;; our own trampolines which will call our generic function, and then write default
 ;;; methods which will invoke the COMMON-LISP package equivalents.
 
-(eval-when (compile load eval)
+(eval-when (:compile-toplevel :load-toplevel :execute)
 
 #+(or Allegro 
       Minima)
@@ -56,11 +56,6 @@
       CCL-2)				;Except for CLOSE (and WITH-OPEN-STREAM)
 (pushnew :clim-uses-lisp-stream-functions *features*)
 
-;;; CLIM-ANSI-Conditions means this lisp truly supports the ANSI CL condition system
-;;; CLIM-Conditions      means that it has a macro called DEFINE-CONDITION but that it works
-;;;                      like Allegro 3.1.13 or Lucid.
-(pushnew :CLIM-ANSI-Conditions *features*)
-
 #+Allegro
 (pushnew :allegro-v4.0-constructors *features*)
 
diff --git a/sys/sysdcl.lisp b/sys/sysdcl.lisp
index 6ff30dc30fcb33bfc14c709b7c9036898f814027..4d9f3072dcb4eaeed0e8387b3a89d79669e000bb 100644
--- a/sys/sysdcl.lisp
+++ b/sys/sysdcl.lisp
@@ -17,7 +17,7 @@
 
 "Copyright (c) 1990, 1991, 1992 Symbolics, Inc.  All rights reserved."
 
-(eval-when (compile load eval)
+(eval-when (:compile-toplevel :load-toplevel :execute)
 
 ;;; Tell the world that we're here
 ;;;--- These need to be in the CLIM.fasl also.
@@ -57,7 +57,7 @@
 ;;; our own trampolines which will call our generic function, and then write default
 ;;; methods which will invoke the COMMON-LISP package equivalents.
 
-(eval-when (compile load eval)
+(eval-when (:compile-toplevel :load-toplevel :execute)
 
 #+(or allegro
       Minima
@@ -74,11 +74,6 @@
       SBCL)
 (pushnew :clim-uses-lisp-stream-functions *features*)
 
-;;; CLIM-ANSI-Conditions means this lisp truly supports the ANSI CL condition system
-;;; CLIM-Conditions      means that it has a macro called DEFINE-CONDITION but that it works
-;;;                      like allegro 3.1.13 or Lucid.
-(pushnew :clim-ansi-conditions *features*)
-
 #+allegro
 (pushnew :allegro-v4.0-constructors *features*)
 
@@ -126,7 +121,6 @@
    "reader"
    "clos-patches"
    "clos"
-   #+CLIM-conditions "condpat" ;get the define-condition macro
 
    ;; General Lisp extensions
    "utilities"
@@ -148,7 +142,7 @@
 
    ;; Basic utilities for Silica and CLIM
    "clim-macros"
-   ("transformations" #+CLIM-conditions (:load-before-compile "condpat"))
+   "transformations"
    "regions"
    "region-arithmetic"
    "extended-regions"
@@ -206,7 +200,6 @@
    "stream-defprotocols"
    "defresource"
    "temp-strings"
-   #+(and MCL CCL-2) "coral-defs"
    "clim-defs"
 
    ;; Definitions and protocols
diff --git a/test/test-driver.lisp b/test/test-driver.lisp
index e680312a90408596d39f2cd33216a23a21837445..963043870824d5485c642e7822bf07e8bcf11673 100644
--- a/test/test-driver.lisp
+++ b/test/test-driver.lisp
@@ -843,7 +843,7 @@
 ;; How can we wait for a frame to be created. Grab hold of it and then
 ;; run some commands on it.
 
-(eval-when (compile load eval)
+(eval-when (:compile-toplevel :load-toplevel :execute)
   (require :prof))
 
 (defun do-frame-test-with-profiling (test &key (type :time) prefix)
diff --git a/test/test-suite.lisp b/test/test-suite.lisp
index 8002cbf8ec63f32f1933426aef527934e5ad845e..8e41d355574c5335b41e03f6d1b77f3a44750419 100644
--- a/test/test-suite.lisp
+++ b/test/test-suite.lisp
@@ -2708,7 +2708,7 @@ Luke Luck licks the lakes Luke's duck likes."))
   ;; First collect the data files
   ;; DATA is ((short-name long-name results flavors-p)...)
   (let ((data
-          (clim-utils:with-standard-io-environment
+          (with-standard-io-syntax
             (let ((data nil)
                   (*package* (or (find-package :common-lisp-user)
                                  (error "Package COMMON-LISP-USER not found"))))
diff --git a/tk-silica/xt-frames.lisp b/tk-silica/xt-frames.lisp
index 9af87cb42ca0ea770a5a64d2ea9686ff1a4825ba..79889a9b163de1f5a837ab1bdf9fd76bb5c5bdff 100644
--- a/tk-silica/xt-frames.lisp
+++ b/tk-silica/xt-frames.lisp
@@ -103,7 +103,6 @@
 	  default-item  ;; bug12221/spr25238
 	  
 	  )
-  (declare (values value chosen-item gesture))
   ;; let's degrade to CLIM 1 style menus if we need scroll-bars
   (if scroll-bars
       (call-next-method)
diff --git a/tk/convenience.lisp b/tk/convenience.lisp
index 276598955ac85890aa80bb0c515ee2238c2931e7..ec47011404b5f39eb8a4c30eff7a6c074ec25921 100644
--- a/tk/convenience.lisp
+++ b/tk/convenience.lisp
@@ -5,13 +5,13 @@
 (in-package :tk)
 
 #-(version>= 6 1)
-(eval-when (eval compile)
+(eval-when (:execute :compile-toplevel)
   (defmacro define-convenience-class (class superclasses entry-point)
     (let ((c-function-name
 	   (intern (substitute #\_ #\-
 			       (lispify-tk-name entry-point :package nil)))))
       `(progn
-	 (eval-when (eval compile)
+	 (eval-when (:execute :compile-toplevel)
 	   (defforeign ',c-function-name
 	       :entry-point (ff:convert-foreign-name ,entry-point)
 	       :call-direct t
@@ -39,13 +39,13 @@
 		   (xt_manage_child o))
 		 o))))))))
 #+(version>= 6 1)
-(eval-when (eval compile)
+(eval-when (:execute :compile-toplevel)
   (defmacro define-convenience-class (class superclasses entry-point)
     (let ((c-function-name
 	   (intern (substitute #\_ #\-
 			       (lispify-tk-name entry-point :package nil)))))
       `(progn
-	 (eval-when (eval compile)
+	 (eval-when (:execute :compile-toplevel)
 	   (def-foreign-call (,c-function-name ,entry-point)
 	       ((w :foreign-address) (x :foreign-address) (y :foreign-address) (z :int fixnum))
 	     :returning :foreign-address
diff --git a/tk/gcontext.lisp b/tk/gcontext.lisp
index dc2023463333f2839c890640a5810485c7ab71c5..4db0aa01463771b50476784cebc2c02af5eb8bf1 100644
--- a/tk/gcontext.lisp
+++ b/tk/gcontext.lisp
@@ -4,7 +4,7 @@
 
 (in-package :tk)
 
-(eval-when (compile load eval)
+(eval-when (:compile-toplevel :load-toplevel :execute)
   #+ignore
   (defconstant *gcontext-components*
       '((function :int)
@@ -41,7 +41,7 @@
 (defun make-xgcvalues ()
   (clim-utils::allocate-cstruct 'x11::xgcvalues :initialize t))
 
-(eval-when (compile eval)
+(eval-when (:compile-toplevel :execute)
   #+ignore
   (defun gcontext-component-to-slot-definition (x)
     (destructuring-bind
diff --git a/tk/load-xm.lisp b/tk/load-xm.lisp
index b7f1a1747121ddcedf740cd4b031754f9e8021d8..cab334f1ba1a17def218d6ec48c5442322c6825e 100644
--- a/tk/load-xm.lisp
+++ b/tk/load-xm.lisp
@@ -4,7 +4,7 @@
 
 (cl:in-package #:user)
 
-(eval-when (compile eval load)
+(eval-when (:compile-toplevel :execute :load-toplevel)
   (require :climg))
 
 (defvar sys::*clim-library-search-path* '("/usr/X11/lib/" "/usr/X11R6/lib/" "/usr/local/lib/"
diff --git a/tk/xlib.lisp b/tk/xlib.lisp
index 1108bb3825e4aca7e0b62bbb811147e0678b675d..9c7de55d50f8acb569833ffb302e1e29fe8cbf81 100644
--- a/tk/xlib.lisp
+++ b/tk/xlib.lisp
@@ -30,7 +30,7 @@
 (defclass window (drawable)
   ((plist :accessor window-property-list :initform nil)))
 
-(eval-when (compile load eval)
+(eval-when (:compile-toplevel :load-toplevel :execute)
   (defconstant *window-set-attributes-bit-mask*
       '(background-pixmap background-pixel border-pixmap border-pixel
 	bit-gravity win-gravity backing-store backing-planes backing-pixel
@@ -46,7 +46,7 @@
 (defun make-xwindowattributes ()
   (clim-utils::allocate-cstruct 'x11::xwindowattributes :initialize t))
 
-(eval-when (compile eval)
+(eval-when (:compile-toplevel :execute)
   (defmacro define-window-reader (name &optional decoder &rest args)
     `(defmethod ,(intern (format nil "~A-~A" 'window name)) ((window window))
        ,(let ((body
@@ -292,7 +292,7 @@
 			      (setq *x-io-error-handler-address*
 				(register-foreign-callable 'x-io-error-handler)))))
 
-(eval-when (load)
+(eval-when (:load-toplevel)
   (setup-error-handlers))
 
 (define-condition x-colormap-full (serious-condition) ())
diff --git a/tk/xm-widgets.lisp b/tk/xm-widgets.lisp
index 7884689b3362ce4db7c46c5cabd48caccb3fc72c..e31d812e607e8c1062e00fb838963049bd9609ef 100644
--- a/tk/xm-widgets.lisp
+++ b/tk/xm-widgets.lisp
@@ -110,7 +110,7 @@
   
   (defvar *empty-compound-string* nil)
 
-  (eval-when (compile) (declaim (special *font-list-tags*)))
+  (eval-when (:compile-toplevel) (declaim (special *font-list-tags*)))
   
   (defun partition-compound-string (s f &key (start 0) (end (length s)))
     (unless (eql (length s) 0)
diff --git a/utils/autoconstructor.lisp b/utils/autoconstructor.lisp
index 2a4897789922b5c53b98add3df66861fa5fed146..4e9967736826b355c6bd05c703892caea974353d 100644
--- a/utils/autoconstructor.lisp
+++ b/utils/autoconstructor.lisp
@@ -93,7 +93,7 @@
        ;; the compile time environment that a function with this name and
        ;; this argument list has been defined.  The portable way to do this
        ;; is with defun.
-       (eval-when (compile load eval)
+       (eval-when (:compile-toplevel :load-toplevel :execute)
 	 (proclaim '(notinline ,name))
 	 (proclaim '(function ,name)))
        #+++ignore ;; See if FUNCTION proclamation is sufficient.
diff --git a/utils/base-designs.lisp b/utils/base-designs.lisp
index 5928553df40357cfedd208bc1930c0c125f1a9c1..126d7b796612c94660cb4226cd233d3eed4b49a1 100644
--- a/utils/base-designs.lisp
+++ b/utils/base-designs.lisp
@@ -171,7 +171,7 @@
 
 ;;; Foreground and background (indirect) inks
 
-(defconstant +foreground-ink+ (make-instance 'design))
+(defparameter +foreground-ink+ (make-instance 'design))
 
 (defmethod make-load-form ((design (eql (symbol-value '+foreground-ink+)))
 			   #-aclpc &optional #-aclpc environment)
@@ -180,7 +180,7 @@
   #+aclpc '(symbol-value '+foreground-ink+))
 
 
-(defconstant +background-ink+ (make-instance 'design))
+(defparameter +background-ink+ (make-instance 'design))
 
 (defmethod make-load-form ((design (eql (symbol-value '+background-ink+)))
 			   #-aclpc &optional #-aclpc environment)
diff --git a/utils/cl-stream-functions.lisp b/utils/cl-stream-functions.lisp
index 19a0993ff54e40c42611a13e998b4675b2303030..725358a86b3f8b885625b6507790bb29d2bf1dd4 100644
--- a/utils/cl-stream-functions.lisp
+++ b/utils/cl-stream-functions.lisp
@@ -47,7 +47,7 @@
     (when (eq (first optional-args) '&optional)
       (pop optional-args))
     `(define-group ,name write-forwarding-cl-output-stream-function
-       (eval-when (compile load eval) (proclaim '(inline ,name)))
+       (eval-when (:compile-toplevel :load-toplevel :execute) (proclaim '(inline ,name)))
        (defun ,name (,@required-args &optional stream ,@optional-args)
 	 (cond ((null stream) (setq stream *standard-output*))
 	       ((eq stream t) (setq stream *terminal-io*)))
@@ -96,7 +96,7 @@
     (when (member (first (last method-lambda-list)) lambda-list-keywords)
       (setf method-lambda-list (butlast method-lambda-list)))
     `(define-group ,name write-forwarding-cl-input-stream-function
-       (eval-when (compile load eval) (proclaim '(inline ,name)))
+       (eval-when (:compile-toplevel :load-toplevel :execute) (proclaim '(inline ,name)))
        ,(if eof
 	    (let ((args `(eof-error-p eof-value ,@(and (not (eq eof :no-recursive))
 						       '(recursive-p)))))
diff --git a/utils/cl-streams.lisp b/utils/cl-streams.lisp
index 24cc0feb520fcf3992e3d6f3decf78cf0e2b44a1..dda1d5c6db5903067d9ce28c4a4a9899a08f147f 100644
--- a/utils/cl-streams.lisp
+++ b/utils/cl-streams.lisp
@@ -98,8 +98,8 @@
 (progn
 
 (defmacro write-forwarding-cl-output-stream-function (name args &key #+Genera message)
-  (let* ((cl-name (find-symbol (symbol-name name) (find-package :lisp)))
-	 (method-name (intern (lisp:format nil "~A-~A" 'stream (symbol-name name))))
+  (let* ((cl-name (find-symbol (symbol-name name) (find-package :cl)))
+	 (method-name (intern (cl:format nil "~A-~A" 'stream (symbol-name name))))
 	 (optional-args (or (member '&optional args) (member '&key args)))
 	 (required-args (ldiff args optional-args))
 	 (optional-parameters (mapcan #'(lambda (arg)
@@ -126,7 +126,7 @@
        ;; Shadow the Common Lisp function with one that calls the generic function,
        ;; except in Genera and Cloe where the Common Lisp function will work
        #-(or Genera (and MCL CCL-2))
-       (eval-when (compile load eval) (proclaim '(inline ,name)))
+       (eval-when (:compile-toplevel :load-toplevel :execute) (proclaim '(inline ,name)))
        #-(or Genera (and MCL CCL-2))
        (defun ,name (,@required-args &optional stream ,@optional-args)
 	 (case stream
@@ -172,7 +172,7 @@
 
 ;;;
 
-(eval-when (compile load eval)
+(eval-when (:compile-toplevel :load-toplevel :execute)
 (defun order-preserving-set-difference (set-one set-two)
   #-(and MCL CCL-2) (set-difference set-one set-two)
   #+(and MCL CCL-2) (nreverse (set-difference set-one set-two)))
@@ -182,8 +182,8 @@
 						     &key eof
 							  #+Genera message
 							  additional-arguments)
-  (let* ((cl-name (find-symbol (symbol-name name) (find-package :lisp)))
-	 (method-name (intern (lisp:format nil "~A-~A" 'stream (symbol-name name))))
+  (let* ((cl-name (find-symbol (symbol-name name) (find-package :cl)))
+	 (method-name (intern (cl:format nil "~A-~A" 'stream (symbol-name name))))
 	 (args (mapcar #'(lambda (var) (if (atom var) var (first var)))
 		       (order-preserving-set-difference lambda-list lambda-list-keywords)))
 	 (stream-args (remove 'stream args))
@@ -196,7 +196,7 @@
        ;; Shadow the Common Lisp function with one that calls the generic function,
        ;; except in Genera or Cloe where the Common Lisp function will work
        #-(or Genera (and MCL CCL-2))
-       (eval-when (compile load eval) (proclaim '(inline ,name)))
+       (eval-when (:compile-toplevel :load-toplevel :execute) (proclaim '(inline ,name)))
        #-(or Genera (and MCL CCL-2))
        ,(if eof
 	    (let ((args `(eof-error-p eof-value ,@(and (not (eq eof :no-recursive))
@@ -264,10 +264,10 @@
   (cond ((streamp stream)
 	 ;; this isn't going to quite work for ~&,
 	 ;; but it's better than nothing.
-	 (write-string (apply #'lisp:format nil format-control format-args) stream)
+	 (write-string (apply #'cl:format nil format-control format-args) stream)
 	 nil)
 	(t
-	 (apply #'lisp:format stream format-control format-args))))
+	 (apply #'cl:format stream format-control format-args))))
 
 ) ;; #-Cloe-Runtime
 
diff --git a/utils/clim-macros.lisp b/utils/clim-macros.lisp
index f349eb11c4e0a76f0e45d1d7a42131962dc17db9..e18ebd80e9eeeb5e7b0fe2493cf6223e8a563f6b 100644
--- a/utils/clim-macros.lisp
+++ b/utils/clim-macros.lisp
@@ -50,7 +50,7 @@
      (invoke-with-clipping-region ,stream #'with-clipping-region-body ,region)))
 
 (defmacro with-drawing-options ((medium &rest options) &body body)
-  (declare (arglist (medium
+  #+Genera(declare (arglist (medium
                      &key ink clipping-region transformation
                           line-style line-unit line-thickness line-dashes
                           line-joint-shape line-cap-shape
diff --git a/utils/clos-patches.lisp b/utils/clos-patches.lisp
index 312bcd642f010626b954fa753f4cc00e6da1a2e2..0d439b25114742af23d4513b87b2a6a6cf02adad 100644
--- a/utils/clos-patches.lisp
+++ b/utils/clos-patches.lisp
@@ -35,7 +35,7 @@
       sys::*compile-file-environment*))
 
 #+(and allegro never-in-a-million-years)
-(eval-when (compile)
+(eval-when (:compile-toplevel)
   (warn "~S hacked for lack of environment support in 4.1" 'compile-file-environment-p))
 
 #+(or (and MCL CCL-2) Clozure)
@@ -45,6 +45,12 @@
       #-Clozure t
       (ccl:augment-environment environment)))
 
+#+ (or sbcl ccl)
+(defun-inline  compile-file-environment-p (environment)
+  (declare (ignore environment))
+  ;; FIXME this shouldn't even need to exist, I think. -- jacek.zlydach, 2017-05-06
+  nil)
+
 #+(and allegro (not (version>= 4 1)))
 (defgeneric make-load-form (object))
 
@@ -84,7 +90,7 @@
 ;;; by load-reference-to-presentation-type-class isn't sufficient without this,
 ;;; because a MAKE-LOAD-FORM form for a presentatation type class could be evaluated
 ;;; before a superclass has been defined.
-(eval-when (compile load eval)
+(eval-when (:compile-toplevel :load-toplevel :execute)
   (setq compiler::.random-forms-max. 0))
 
 
@@ -93,7 +99,6 @@
 
 #+(and allegro (not (version>= 4 1)))
 (lisp:defun slot-value-alist (body)
-  (declare (values real-body alist))
   (let ((alist nil))
     (do* ((real-body body (cdr real-body))
           (form (car real-body) (car real-body)))
diff --git a/utils/clos.lisp b/utils/clos.lisp
index f7fda0b541a4e58e6a57bb0a6a5f78fc7d504398..6fb70d5f3cdeb833ce4fa00245e58653ca930aa3 100644
--- a/utils/clos.lisp
+++ b/utils/clos.lisp
@@ -11,7 +11,7 @@
 (in-package :clim-utils)
 
 #+Allegro-v4.0-constructors
-(eval-when (compile eval load) (require :constructor))
+(eval-when (:compile-toplevel :execute :load-toplevel) (require :constructor))
 
 ;;; ----------------
 ;;; Constructors
@@ -36,7 +36,7 @@
 (defmacro define-constructor (name class lambda-list &body initargs)
   (let ((rest-arg (member '&rest lambda-list)))
     `(progn
-       (eval-when (compile load eval) (proclaim '(inline ,name)))
+       (eval-when (:compile-toplevel :load-toplevel :execute) (proclaim '(inline ,name)))
        (defun ,name ,lambda-list
 	 ,@(when rest-arg
 	     `((declare (dynamic-extent ,(second rest-arg)))))
@@ -106,7 +106,7 @@
 
 ;(defvar *dynamic-classes* (make-hash-table :test #'equal))
 ;
-;(eval-when (compile load eval) (proclaim '(inline %make-standard-class)))
+;(eval-when (:compile-toplevel :load-toplevel :execute) (proclaim '(inline %make-standard-class)))
 ;(defun %make-standard-class (name supers)
 ;
 ;  #+Lucid
@@ -224,7 +224,6 @@
   (values `(setf ,accessor-name) t))
 
 (defun make-setf*-function-name (accessor-name)
-  (declare (values setf-function-name defsetf-done-p))
   (let ((writer (get accessor-name 'setf-function-name))
 	(old-p nil))
     (when writer
@@ -276,8 +275,6 @@
 ;; For example, (DEFMETHOD* (SETF CURSOR-POSITION) (NX NY (CURSOR T)) ...)
 ;; Then (SETF (CURSOR-POSITION cursor) (VALUES nx ny))
 (defmacro defmethod* (name &body quals-lambda-list-and-body)
-  (declare (arglist name [qualifiers]* lambda-list &body body))
-  #+Genera (declare (zwei:indentation . zwei:indent-for-clos-defmethod))
   (assert (and (listp name) (eq (first name) 'setf) (null (cddr name))) ()
 	  "Syntax error in ~S: This only works on ~S methods" 'defmethod* 'setf)
   (let (qualifiers real-arglist body accessor-arg
diff --git a/utils/condpat.lisp b/utils/condpat.lisp
deleted file mode 100644
index 3d8956d89685b8a5a27482dd70984d1f75da4d99..0000000000000000000000000000000000000000
--- a/utils/condpat.lisp
+++ /dev/null
@@ -1,50 +0,0 @@
-;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-UTILS; Base: 10; Lowercase: Yes -*-
-;; See the file LICENSE for the full license governing this code.
-;;
-
-(in-package :clim-utils)
-
-;;;"Copyright (c) 1990 International Lisp Associates.  All rights reserved."
-
-;;; Lucid and Franz have an old syntax for defining conditions.  We define
-;;; a macro here which supports [a subset of] the ANSI syntax and which
-;;; forwards to their syntax.  Then we can just write DEFINE-CONDITION
-;;; with [relative] impunity.  I suppose there is some question about
-;;; whether this macro should be in all implementations so that we can
-;;; detect the non-portable cases more easily.  I'll think about it.
-(defmacro define-condition (name parent-types &optional slots &rest options)
-  (let ((readers nil)
-	(real-slots slots)
-	(trampoline-define-condition
-	  (intern (symbol-name 'define-condition)
-		  (find-package #+Lucid :lucid-common-lisp
-				#-Lucid :conditions)))
-	(conc-name (format nil "~A-~A-" name 'accessor-for)))
-    (unless parent-types
-      (setq parent-types '(condition)))
-    (unless (keywordp (first slots))
-      (setq real-slots nil)
-      (dolist (slot slots)
-	(let ((reader (getf (rest slot) ':reader)))
-	  (when reader
-	    (let ((trampoline (intern (format nil "~A~A" conc-name (first slot))
-				      (symbol-package name))))
-	      ;; Not likely to be EQL, but can causes an infinite loop
-	      ;; in Lucid if it is...
-	      (unless (eq trampoline reader)
-		(push `(eval-when (compile load eval)
-			 (proclaim '(inline ,reader))) readers)
-		(push `(defun ,reader (condition)
-			 (,trampoline condition)) readers)))))
-	(let ((initarg (getf (rest slot) ':initarg)))
-	  (unless (eq initarg (intern (symbol-name (first slot)) *keyword-package*))
-	    (error "We can't support initargs to DEFINE-CONDITION that ~
-                    don't match the slot name.")))
-	(let ((initform (getf (rest slot) ':initform)))
-	  (if initform
-	      (push `(,(first slot) ,initform) real-slots)
-	      (push `(,(first slot)) real-slots)))))
-    `(progn (,trampoline-define-condition ,name ,parent-types ,(nreverse real-slots)
-	     (:conc-name ,conc-name)
-	     ,@options)
-	    ,@(nreverse readers))))
diff --git a/utils/defpackage.lisp b/utils/defpackage.lisp
index 70054898dafc80bc5f27ee7799f0be8b345dd64c..ecdbbeb59f749206b0712a53da7815a574b7cfd1 100644
--- a/utils/defpackage.lisp
+++ b/utils/defpackage.lisp
@@ -12,7 +12,7 @@
 #+(or Allegro Lucid) (defpackage :clim-lisp)
 
 #-(or Allegro Lucid)
-(eval-when (compile load eval)
+(eval-when (:compile-toplevel :load-toplevel :execute)
   (unless (find-package :clim-lisp)
     (make-package "CLIM-LISP" :use '("COMMON-LISP"))))
 
@@ -61,7 +61,7 @@
 			   :key #'first)))
 	(when bad-option
 	  (warn "Unknown ~S option: ~S" 'defpackage (first bad-option))))
-      `(eval-when (compile load eval)
+      `(eval-when (:compile-toplevel :load-toplevel :execute)
 	 (let ((,package-var (make-package-aux
 			       ',package-name :use nil
 			       ,@(when nicknames `(:nicknames ',(mapcar #'string nicknames)))
diff --git a/utils/defun-utilities.lisp b/utils/defun-utilities.lisp
index 2663b02ada8672c4e83a60d2b337c0fbb8acfeb2..2109daa8c4a5d8c227c010801bd969924c1f7d57 100644
--- a/utils/defun-utilities.lisp
+++ b/utils/defun-utilities.lisp
@@ -6,18 +6,6 @@
 
 ;;;"Copyright (c) 1991 International Lisp Associates.  All rights reserved."
 
-;;; Useful proclamations, very early on
-
-;; not part of ANSI CL, but they're nice to have around
-#+(or (and MCL CCL-2) allegro Minima Clozure SBCL)
-(eval-when (compile load eval)
-  (proclaim '(declaration values))
-  (proclaim '(declaration arglist)))
-
-#+aclpc
-(eval-when (compile load eval)
-  (proclaim '(declaration arglist)))
-
 ;;; Moved here from DEFUN.  DEFUN now only contains the portable implementation
 ;;; of the DYNAMIC-EXTENT declaration, and so is not loaded into Lisps which 
 ;;; implement that declaration.
@@ -27,7 +15,6 @@
 (defparameter *declarations-may-be-exposed-by-macro-expansion* nil)
 
 (cl:defun extract-declarations (body &optional environment)
-  (declare (values documentation declarations body))
   (let ((declarations nil)
 	(documentation nil))
     (block process-declarations
@@ -88,7 +75,7 @@
 ;;;; don't use define-group, because it does a excl::record-source-file,
 ;;;; which will be also done by defun!  This causes duplicate definition in
 ;;;; file warnings.
-     (eval-when (compile load eval) (proclaim '(inline ,name)))
+     (eval-when (:compile-toplevel :load-toplevel :execute) (proclaim '(inline ,name)))
      (defun ,name ,lambda-list
        ,@body)))
 
@@ -114,7 +101,7 @@
     `(let ((,native-string-var ,string-exp))
        ,@body))
 
-  (eval-when (compile load eval) (export 'with-native-string))
+  (eval-when (:compile-toplevel :load-toplevel :execute) (export 'with-native-string))
 
   (defun mb-to-string (mb-vector)
     (let* ((lgth (length mb-vector))
@@ -122,4 +109,4 @@
       (dotimes (i lgth string)
 	(setf (schar string i) (code-char (aref mb-vector i))))))
 
-  (eval-when (compile load eval) (export 'mb-to-string)))
+  (eval-when (:compile-toplevel :load-toplevel :execute) (export 'mb-to-string)))
diff --git a/utils/defun.lisp b/utils/defun.lisp
index f03320da04454673bf28f04b6fb8693575b094cf..52422b4d167989cfc7a1b2cdf3550657c54b872c 100644
--- a/utils/defun.lisp
+++ b/utils/defun.lisp
@@ -57,7 +57,6 @@
 ;;; The heart of function body processing:
 (lisp:defun decode-function (lambda-list body environment
 			     &key clos-method-p function-name downward-p generic-function-p)
-  (declare (values new-lambda-list new-body))
   #-Genera (declare (ignore function-name))
   (let* ((ignores nil)
 	 (new-lambda-list nil)
@@ -220,7 +219,7 @@
 			:downward-p ,downward-p)
      ,@body))
 
-(eval-when (compile load eval)
+(eval-when (:compile-toplevel :load-toplevel :execute)
 (lisp:defun lintern (symbol)
   (intern (symbol-name symbol) #+Genera :future-common-lisp #-Genera :lisp))
 )
@@ -357,7 +356,7 @@
     #-PCL `(cl:method ,function-name ,specifier-list ,@qualifiers)))
 
 #+(and allegro (not acl86win32) (version>= 4 1))
-(eval-when (compile load eval) (require :scm))
+(eval-when (:compile-toplevel :load-toplevel :execute) (require :scm))
 #+(and allegro (not acl86win32) (version>= 4 1))
 (excl::define-simple-parser defmethod scm::defmethod-parser)
 
diff --git a/utils/designs.lisp b/utils/designs.lisp
index 42c7d577f2daa54b9de8a08c109d73b987d4d731..ba6e29a29d78daa0fc80afdfb20787c0f31a7c1f 100644
--- a/utils/designs.lisp
+++ b/utils/designs.lisp
@@ -33,8 +33,8 @@
 
 
 ;; Black and white are the same everywhere
-(defconstant +black+ (make-gray-color-1 0f0))
-(defconstant +white+ (make-gray-color-1 1f0))
+(defparameter +black+ (make-gray-color-1 0f0))
+(defparameter +white+ (make-gray-color-1 1f0))
 
 
 ;;; Gray colors
@@ -115,8 +115,8 @@
 ;;; Color constants
 
 (defmacro define-primary-color (color-name r g b)
-  `(defconstant ,color-name
-		(make-rgb-color-1 (float ,r 0f0) (float ,g 0f0) (float ,b 0f0))))
+  `(defparameter ,color-name
+     (make-rgb-color-1 (float ,r 0f0) (float ,g 0f0) (float ,b 0f0))))
 
 ;; The primary colors, constant across all platforms
 (define-primary-color +red+     1 0 0)
@@ -331,7 +331,7 @@ Try closing color-intensive applications such as Netscape, or try~%~
 setting the colormap X resource to yes to get a private colormap,~%~
 then restart your application.")
 
-(eval-when (#-allegro compile load eval)
+(eval-when (#-allegro :compile-toplevel :load-toplevel :execute)
 (define-condition palette-full (error)
   ((palette :initarg :palette :reader palette-full-palette)
    (color :initarg :color :reader palette-full-color))
@@ -562,7 +562,7 @@ then restart your application.")
     (with-slots (design1 design2) design
       (cl:format stream "~A and ~A" design1 design2))))
 
-(defconstant +flipping-ink+ (make-flipping-ink-1 +foreground-ink+ +background-ink+))
+(defparameter +flipping-ink+ (make-flipping-ink-1 +foreground-ink+ +background-ink+))
 
 (defmethod make-flipping-ink (design1 design2)
   (cond ((eq design1 design2)
@@ -712,7 +712,6 @@ then restart your application.")
 ;;; This could be done with methods, but there is very little point to that
 #-(or aclpc acl86win32)
 (defun decode-tile-as-stipple (rectangular-tile)
-  (declare (values array width height))
   (multiple-value-bind (pattern width height)
       (decode-rectangular-tile rectangular-tile)
     (when (typep pattern 'pattern)
@@ -727,7 +726,6 @@ then restart your application.")
 
 #+(or aclpc acl86win32)
 (defun decode-tile-as-stipple (rectangular-tile)
-  (declare (values array width height))
   (multiple-value-bind (pattern width height)
       (decode-rectangular-tile rectangular-tile)
     (declare (ignore width height))
diff --git a/utils/excl-verification.lisp b/utils/excl-verification.lisp
index 5de85be10991fd74e2bc9e7badaa70dfb9061a2a..3e147bfdbdcbfe8ce4d6b29e86bc7ffa0c66b04c 100644
--- a/utils/excl-verification.lisp
+++ b/utils/excl-verification.lisp
@@ -26,11 +26,11 @@ v5: Fix postscript, GC cursor, Windows text field bugs, speed up
 (in-package :sys)
 
 #+ignore
-(eval-when (compile)
+(eval-when (:compile-toplevel)
   (assert (member excl::*current-case-mode*
 		  '(:case-insensitive-lower :case-insensitive-upper))))
 
-(eval-when (compile load eval)
+(eval-when (:compile-toplevel :load-toplevel :execute)
   (pushnew :clim *features*)
   (pushnew :clim-2 *features*)
   (pushnew :clim-2.1 *features*)
diff --git a/utils/last.lisp b/utils/last.lisp
index 42b9a8cd05bb374e9a8f7dab56a29b2988d447b3..7e4b021dfe4a5de866a98a4b8930d86ccb7f78e4 100644
--- a/utils/last.lisp
+++ b/utils/last.lisp
@@ -5,24 +5,6 @@
 
 (in-package :system)
 
-;;; This is, perhaps, a temporary hack to get the EUC stuff loaded at
-;;; a non-bad time.
-;;
-;; This is no longer needed, since we're using native-to-* interface now
-;; The euc module may be autoloaded due to process-code usage, but the
-;; autoload no longer produces a mesage at inopportune times.
-#+ignore
-(eval-when (:load-toplevel :execute)
-  (require :euc)
-  (find-external-format :euc))
-
-#-(version>= 5 0 pre-final 16)
-(load-patches "patch" "sys:;update-clim;*.fasl")
-#+(and (version>= 5 0 pre-final 16)
-       (not clim-dont-load-patches))
-(load-patches :product #.*patch-product-code-clim*
-	      :version #.excl::*cl-patch-version-char*)
-
 (provide
  #+mswindows :climnt
  #-mswindows
diff --git a/utils/lisp-package-fixups.lisp b/utils/lisp-package-fixups.lisp
index 26475402b889afdc3b70e3888e052ef93339dfa2..ce36809d33564f1d87aba698fafd186b14e946b1 100644
--- a/utils/lisp-package-fixups.lisp
+++ b/utils/lisp-package-fixups.lisp
@@ -42,7 +42,7 @@
 ;;; I left a copy of this form in defsystem.lisp so that defsystem
 ;;; can be compiled (it has lots of references to LISP: symbols).
 #+(and ANSI-90 (not Allegro))
-(eval-when (eval compile load)
+(eval-when (:execute :compile-toplevel :load-toplevel)
   (flet ((fix-package (pack-name add-name)
 	   (setq add-name (string add-name))
 	   (let ((pack (find-package pack-name)))
@@ -65,7 +65,7 @@
 ;;; is really to add the ANSI names COMMON-LISP and COMMON-LISP-USER
 ;;; to the LISP and USER packages found in non-ANSI Lisps.
 #-(or Allegro aclpc)
-(eval-when (compile load eval)
+(eval-when (:compile-toplevel :load-toplevel :execute)
   (flet ((clean-up-package (old-package-name primary-name required-nicknames)
 	   (let* ((package (or (find-package old-package-name)
 			       (find-package primary-name)))
diff --git a/utils/lisp-utilities.lisp b/utils/lisp-utilities.lisp
index ad6f661b09c3f77824296579d329ff91a3301cc9..f5bbff18dd3e1d353e082974d0686dd981edf1fd 100644
--- a/utils/lisp-utilities.lisp
+++ b/utils/lisp-utilities.lisp
@@ -48,7 +48,7 @@
 			       (reverse ,run-time-vals))
 	    ,wrapped-body)))))
 
-(eval-when (compile load eval)
+(eval-when (:compile-toplevel :load-toplevel :execute)
 (defun decode-once-only-arguments (variables)
   (let ((vars nil)
 	(env nil)
@@ -316,48 +316,6 @@
        (or (char-equal char #\Space)
 	   (eql char #\Tab))))
 
-;;; Make sure we don't get screwed by environments like Coral's that
-;;; have *print-case* set to :downcase by default.
-#+(or (not ansi-90) aclpc)
-(defvar *standard-io-environment-val-cache* nil)
-
-#+(or (not ansi-90) aclpc)
-(defun standard-io-environment-vars-and-vals ()
-  (unless *standard-io-environment-val-cache*
-    (setq *standard-io-environment-val-cache*
-	  (list 10				;*read-base*
-		(copy-readtable nil)		;*readtable*
-		(find-package :user)		;*package*
-		t				;*print-escape*
-		nil				;*print-pretty*
-		nil				;*print-radix*
-		10				;*print-base*
-		nil				;*print-circle*
-		nil				;*print-level*
-		nil				;*print-length*
-		:upcase				;*print-case*
-		t				;*print-gensym*
-		t				;*print-array*
-		nil)))				;*read-suppress*
-  (values
-    '(*read-base* *readtable* *package* *print-escape* *print-pretty*
-      *print-radix* *print-base* *print-circle* *print-level* *print-length*
-      *print-case* *print-gensym* *print-array* *read-suppress*)
-    *standard-io-environment-val-cache*))
-
-(defmacro with-standard-io-environment (&body body)
-  #+(or (not ansi-90) aclpc)
-  `(multiple-value-bind (vars vals)
-       (standard-io-environment-vars-and-vals)
-     (progv vars vals
-       ,@body))
-  #-(or (not ansi-90) aclpc)
-  `(with-standard-io-syntax ,@body))
-
-#+(and (or (not ansi-90) aclpc) (not Clozure) (not Genera))
-(defmacro with-standard-io-syntax (&body body)
-  `(with-standard-io-environment ,@body))
-
 ;; Define this so we don't have to deal with stupid warnings about
 ;; the iteration variable being used, or not used, or what not
 (defmacro repeat (n &body body)
@@ -388,7 +346,7 @@
   (let ((aborted-variable (gensymbol 'aborted-p))
 	(temporary-stream-variable (gensymbol 'stream)))
     (multiple-value-bind (documentation declarations actual-body)
-	(extract-declarations body env)
+	(extract-declarations body env) ;;; FIXME this here breaks file compilation on SBCL; should we compile this macro anyway? -- jacek.zlydach, 2017-05-06
       (declare (ignore documentation))
       `(let (,temporary-stream-variable
 	     (,aborted-variable t))
@@ -404,16 +362,10 @@
 
 (defun follow-synonym-stream (stream)
   #+Genera (si:follow-syn-stream stream)
-  #+(and ansi-90 (not Genera)) (typecase stream
-				 (synonym-stream
-				   (symbol-value (synonym-stream-symbol stream)))
-				 (t stream))
-  #-(or Genera ansi-90) stream)
-
-#-(or Genera ansi-90)
-(eval-when (compile)
-  (warn "You haven't defined ~S for this implementation.  A stub has been provided."
-	'follow-synonym-stream))
+  #-Genera (typecase stream
+             (synonym-stream
+              (symbol-value (synonym-stream-symbol stream)))
+             (t stream)))
 
 ;;; Interning. There are three places where the package matters here:
 ;;; the current package, the package that is current when FORMAT is
@@ -430,7 +382,7 @@
   ;; this argument order is unfortunate.
   (declare (dynamic-extent format-args))
   (intern (let ((pkg *package*))
-	    (with-standard-io-environment
+	    (with-standard-io-syntax
 		(let ((*package* pkg))
 		  (apply #'cl:format () format-string
 			 (mapcar #'(lambda (x)
@@ -447,7 +399,7 @@
 
 (defvar *gensymbol* 0)
 
-(eval-when (compile load eval)
+(eval-when (:compile-toplevel :load-toplevel :execute)
 (defun gensymbol (&rest parts)
   (declare (dynamic-extent parts))
   (when (null parts) (setf parts '(gensymbol)))
@@ -555,11 +507,11 @@
 	   (when ,condition-value (setf ,@unwind-forms)))))))
 
 #-(and ansi-90 (not allegro) (not Symbolics))
-(eval-when (compile load eval)
+(eval-when (:compile-toplevel :load-toplevel :execute)
   (proclaim '(declaration non-dynamic-extent)))
 
 #+aclpc
-(eval-when (compile load eval)
+(eval-when (:compile-toplevel :load-toplevel :execute)
   (proclaim '(declaration non-dynamic-extent ignorable)))
 
 #+(and ansi-90 (not allegro) (not aclpc) (not Symbolics))
@@ -914,7 +866,6 @@
 
 (defun canonicalize-and-match-lambda-lists (canonical-order user-specified
 					    &optional allow-user-keys)
-  (declare (values lambda-list ignores))
   (check-type canonical-order list)
   (check-type user-specified list)
   (let* ((new-lambda-list nil)
@@ -972,7 +923,7 @@
   (let ((function-name
 	  (make-symbol (cl:format nil "~A-~A-~A" symbol indicator 'property))))
     `(progn (defun ,function-name ,lambda-list ,@body)
-	    (eval-when (load eval) (setf (get ',symbol ',indicator) #',function-name)))))
+	    (eval-when (:load-toplevel :execute) (setf (get ',symbol ',indicator) #',function-name)))))
 
 (defmacro do-delimited-substrings (((string &key (start 0) end)
 				    (start-index-var end-index-var &optional char-var))
@@ -1125,12 +1076,6 @@
 					     ,arglist)))))))))
 
 
-#-(or Genera Clozure (and ansi-90 (not (and allegro (not (version>= 4 1))))))
-(defmacro define-compiler-macro (name lambda-list &body body &environment env)
-  env
-  #+Allegro `(excl::defcmacro ,name ,lambda-list ,@body)
-  #-(or Genera allegro) (progn name lambda-list body env nil))	;Suppress compiler warnings.
-
 #+aclpc
 (defmacro define-compiler-macro (name lambda-list &body body &environment env)
   env
@@ -1145,52 +1090,6 @@
   (mapc #'compiler:function-defined (cdr decl)))
 
 
-#-(or Genera ansi-90)
-(defmacro print-unreadable-object ((object stream &key type identity) &body body)
-  `(flet ((print-unreadable-object-body () ,@body))
-     (declare (dynamic-extent #'print-unreadable-object-body))
-     (print-unreadable-object-1 ,object ,stream ,type ,identity
-				#'print-unreadable-object-body
-				',(not (null body)))))
-
-#-(or Genera ansi-90)
-;;; EXTRA-SPACE-REQUIRED is optional because old compiled code didn't always supply it.
-(defun print-unreadable-object-1 (object stream type identity continuation
-					 &optional (extra-space-required t))
-  (write-string "#<" stream)
-  ;; wish TYPE-OF worked in PCL
-  (when type (cl:format stream "~S " (class-name (class-of object))))
-  (funcall continuation)
-  (when identity
-    (when extra-space-required (write-char #\space stream))
-    (#+PCL pcl::printing-random-thing-internal	;; I assume PCL gets this right. -- rsl
-     #-PCL print-unreadable-object-identity
-     object stream))
-  (write-string ">" stream))
-
-#-(or PCL Genera ansi-90)
-(defun print-unreadable-object-identity (object stream)
-  #+Genera (format stream "~O" (sys:%pointer object))
-  #+Allegro (format stream "@~X" (excl::pointer-to-address object))
-  ;; Lucid prints its addresses out in Hex.
-  #+Lucid (format stream "~X" (sys:%pointer object))
-  ;; Probably aren't any #+(and (not Genera) (not allegro) (not PCL) (not ansi-90))
-  ;; implementations (actually, this is false: Lispworks).
-  #-(or Genera allegro Lucid) (declare (ignore object))
-  #-(or Genera allegro Lucid) (cl:format stream "???"))
-
-#-(or Genera ansi-90 Lucid)
-(defvar *print-readably* nil)
-
-#-(or Genera Lucid ansi-90)
-(deftype real (&optional (min '*) (max '*))
-  (labels ((convert (limit floatp)
-	     (typecase limit
-	       (number (if floatp (float limit 0f0) (rational limit)))
-	       (list (map 'list #'convert limit))
-	       (otherwise limit))))
-    `(or (float ,(convert min t) ,(convert max t))
-	 (rational ,(convert min nil) ,(convert max nil)))))
 
 #+Genera-Release-8-1
 (defun realp (x)
@@ -1366,7 +1265,7 @@
 	        (find-class name errorp environment)))
 
 #+(and allegro never-never-and-never)
-(eval-when (compile)
+(eval-when (:compile-toplevel)
   (warn "~S hacked for lack of environment support in 4.1" 'find-class-that-works))
 
 
@@ -1408,7 +1307,6 @@
 ;; The idiom for using this is
 ;; (MULTIPLE-VALUE-SETQ (VECTOR FP) (SIMPLE-VECTOR-PUSH-EXTEND ELEMENT VECTOR FP)).
 (defun simple-vector-push-extend (element vector fill-pointer &optional extension)
-  (declare (values vector fill-pointer))
   (declare (type fixnum fill-pointer)
 	   (type simple-vector vector))
   (let ((length (array-dimension vector 0)))
@@ -1425,7 +1323,6 @@
     (values vector fill-pointer)))
 
 (defun simple-vector-insert-element (element index vector fill-pointer &optional extension)
-  (declare (values vector fill-pointer))
   (declare (type fixnum index fill-pointer)
 	   (type simple-vector vector))
   (let ((length (array-dimension vector 0)))
diff --git a/utils/lucid-stream-functions.lisp b/utils/lucid-stream-functions.lisp
index 160afb29ddd60ba2b5311a6d2d03faaed03c234f..3c54fc9000e53b1024f064237a0b980b0601f541 100644
--- a/utils/lucid-stream-functions.lisp
+++ b/utils/lucid-stream-functions.lisp
@@ -15,7 +15,7 @@
 
 ;;; just for development
 #+ignore
-(eval-when (compile load eval)
+(eval-when (:compile-toplevel :load-toplevel :execute)
   (defparameter sym-list '("PEEK-CHAR" "READ-BYTE" "READ-CHAR" "UNREAD-CHAR"
 			   "READ-CHAR-NO-HANG" "LISTEN" "READ-LINE" 
 			   "CLEAR-INPUT" "WRITE-BYTE" "WRITE-CHAR"
@@ -200,7 +200,7 @@
 ;;; Higher level lisp printing functions.
 
 
-(eval-when (load)
+(eval-when (:load-toplevel)
   (let ((original-lucid-closure
 	  (or (getf (symbol-plist 'lisp:format) :original-lucid-closure) 
 	      (setf (getf (symbol-plist 'lisp:format) :original-lucid-closure)
diff --git a/utils/packages.lisp b/utils/packages.lisp
index 1cba4dd7879cac59e3ad7638e1fc91dbd5b0b43c..ac9b4846feeb2e2fd246ce66e4d1999cc0149406 100644
--- a/utils/packages.lisp
+++ b/utils/packages.lisp
@@ -34,6 +34,8 @@
  (:import-from :ccl #:atomic-incf #:atomic-decf #:class-prototype
                #:class-direct-superclasses #:class-precedence-list)
 
+ (:import-from :closer-mop :class-prototype)
+
  (:export
    &allow-other-keys
    &aux
@@ -2821,7 +2823,6 @@
     with-stack-copy-of-list
     with-stack-list
     with-stack-list*
-    with-standard-io-environment
     with-warnings-for-definition
     writing-clauses
 
@@ -3006,7 +3007,7 @@
     modifier-key-index-name))
 
 #+(or aclpc acl86win32)
-(eval-when (compile load eval)
+(eval-when (:compile-toplevel :load-toplevel :execute)
  (intern '#:non-dynamic-extent (find-package :clim-utils)))
 
 (defpackage clim-silica
@@ -3032,7 +3033,7 @@
     *ports*
     *standard-character-set*
     *all-character-sets*
-    #+(or aclpc acl86win32) *undefined-text-style*
+    #+(or aclpc acl86win32 (and)) *undefined-text-style*
     +highlighting-line-style+
     activate-gadget-event
     add-sheet-callbacks
@@ -3185,7 +3186,7 @@
     port-set-sheet-grabbed-pointer-cursor
     port-terminated
     port-trace-thing
-    #+(or aclpc acl86win32) port-undefined-text-style
+    #+(or aclpc acl86win32 (and)) port-undefined-text-style
     process-event-locally
     pull-down-menu
     pull-down-menu-button
diff --git a/utils/processes.lisp b/utils/processes.lisp
index 85f57ab76656f0edbe2321e2b0575303295415bc..ac9bf024cff094a8d6b50b6213d99ea12ec722a2 100644
--- a/utils/processes.lisp
+++ b/utils/processes.lisp
@@ -11,7 +11,7 @@
 
 ;;; Locks 
 #+Allegro
-(eval-when (compile load eval)
+(eval-when (:compile-toplevel :load-toplevel :execute)
 ;;;  (require :mdproc)
   (require :process))
 
@@ -231,7 +231,7 @@
     (warn "No implementation of MAKE-PROCESS for this system.")
     ))
 
-(eval-when (compile load eval) (proclaim '(inline processp)))
+(eval-when (:compile-toplevel :load-toplevel :execute) (proclaim '(inline processp)))
 (defun processp (object)
   #+(and MCL CCL-2)  (member object '(:user :event :interrupt))
   #+Lucid      (lcl:processp object)
@@ -265,7 +265,7 @@
 #+(and MCL CCL-2)
 (defvar *current-process* :user)
 
-(eval-when (compile load eval) (proclaim '(inline current-process)))
+(eval-when (:compile-toplevel :load-toplevel :execute) (proclaim '(inline current-process)))
 (defun current-process ()
   #+Lucid        lcl:*current-process*
   #+Allegro      mp:*current-process*
@@ -280,7 +280,7 @@
   #+SBCL         sb-thread:*current-thread*
   )
 
-(eval-when (compile load eval) (proclaim '(inline all-processes)))
+(eval-when (:compile-toplevel :load-toplevel :execute) (proclaim '(inline all-processes)))
 (defun all-processes ()
   #+Lucid        lcl:*all-processes*
   #+Allegro      mp:*all-processes*
@@ -299,7 +299,7 @@
   #-(or Lucid Genera) (all-processes)
   )
   
-(eval-when (compile load eval) (proclaim '(inline process-yield)))
+(eval-when (:compile-toplevel :load-toplevel :execute) (proclaim '(inline process-yield)))
 (defun process-yield ()
   #+Lucid        (lcl:process-allow-schedule)
   #+Allegro      (mp:process-allow-schedule)
diff --git a/utils/protocols.lisp b/utils/protocols.lisp
index 178f2f51069d256ae498c93e3d6e57e528dd84c7..f37f23129f17cb2c5fae5342c5d70babb238f2cd 100644
--- a/utils/protocols.lisp
+++ b/utils/protocols.lisp
@@ -28,7 +28,7 @@
 
 (defmacro defprotocol (name supers &rest options)
  (declare (ignore supers options))
-  `(eval-when (compile eval load)
+  `(eval-when (:compile-toplevel :execute :load-toplevel)
      (setf (find-protocol ',name)
            (make-instance 'protocol :name ',name))))
 
@@ -47,7 +47,7 @@
   
 (defmacro defrole (class supers slots &rest options)
   (declare (ignore supers options))
-  `(eval-when (compile eval load)
+  `(eval-when (:compile-toplevel :execute :load-toplevel)
      #+PCL
      (pcl::do-standard-defsetf
        ,@(mapcan #'(lambda (slot)
@@ -106,7 +106,7 @@
       (setq trampoline-extra-args (append (ldiff extra-args keyword-args)
                                           (unless (member '&rest extra-args)
                                             `(&rest keyword-arguments)))))
-    `(eval-when (compile eval load)
+    `(eval-when (:compile-toplevel :execute :load-toplevel)
        #-VDPCL ,@defgeneric                        ;PCL's defgeneric fails.
        (let* ((protocol (find-protocol ',protocol))
               (operation
diff --git a/utils/queue.lisp b/utils/queue.lisp
index 64559e23acb8faca8e0e5cc385f19e05c49d38ac..a0a6a56f2cc8e124b2ff4f090934c5e70688f268 100644
--- a/utils/queue.lisp
+++ b/utils/queue.lisp
@@ -78,8 +78,7 @@
   "return a list of all the queue contents"
   (copy-list (queue-head queue)))
 
-(defgeneric map-over-queue (function queue)
-  (declare (dynamic-extent function)))
+(defgeneric map-over-queue (function queue))
 
 (defmethod map-over-queue (function (queue queue))
   (declare (dynamic-extent function))
diff --git a/utils/regions.lisp b/utils/regions.lisp
index 8af70ed39ce67b1c7eabbe4d17a3d5f9dae56288..709508498e7f9423cfac705ea0d4324e85243bef 100644
--- a/utils/regions.lisp
+++ b/utils/regions.lisp
@@ -11,8 +11,7 @@
 (defgeneric transform-region (transformation region))
 (defgeneric untransform-region (transformation region))
 
-(defgeneric point-position (point)
-  #-aclpc (declare (values x y)))
+(defgeneric point-position (point))
 (defgeneric point-x (point))
 (defgeneric point-y (point))
 
@@ -24,8 +23,7 @@
 
 (defgeneric region-set-function (region))
 (defgeneric region-set-regions (region &key normalize))
-(defgeneric map-over-region-set-regions (function region &key normalize)
-  (declare (dynamic-extent function)))
+(defgeneric map-over-region-set-regions (function region &key normalize))
 
 (defgeneric region-union (region1 region2))
 (defgeneric region-intersection (region1 region2))
@@ -33,10 +31,8 @@
 
 (defgeneric polyline-closed (polyline))
 (defgeneric polygon-points (polygon))
-(defgeneric map-over-polygon-coordinates (function polygon)
-  (declare (dynamic-extent function)))
-(defgeneric map-over-polygon-segments (function polygon)
-  (declare (dynamic-extent function)))
+(defgeneric map-over-polygon-coordinates (function polygon))
+(defgeneric map-over-polygon-segments (function polygon))
 
 (defgeneric line-start-point (line))
 (defgeneric line-end-point (line))
@@ -45,34 +41,27 @@
 
 (defgeneric rectangle-min-point (rectangle))
 (defgeneric rectangle-max-point (rectangle))
-(defgeneric rectangle-edges* (rectangle)
-  #-aclpc (declare (values min-x min-y max-x max-y)))
+(defgeneric rectangle-edges* (rectangle))
 (defgeneric rectangle-min-x (rectangle))
 (defgeneric rectangle-min-y (rectangle))
 (defgeneric rectangle-max-x (rectangle))
 (defgeneric rectangle-max-y (rectangle))
 (defgeneric rectangle-width (rectangle))
 (defgeneric rectangle-height (rectangle))
-(defgeneric rectangle-size (rectangle)
-  #-aclpc (declare (values width height)))
+(defgeneric rectangle-size (rectangle))
 
 (defgeneric ellipse-center-point (ellipse))
 (defgeneric ellipse-center-point* (ellipse))
-(defgeneric ellipse-radii (ellipse)
-  #-aclpc (declare (values radius-1-dx radius-1-dy radius-2-dx radius-2-dy)))
+(defgeneric ellipse-radii (ellipse))
 (defgeneric ellipse-start-angle (ellipse))
 (defgeneric ellipse-end-angle (ellipse))
 
 (defgeneric opacity-value (opacity))
 
-(defgeneric bounding-rectangle* (region)
-  #-aclpc (declare (values left top right bottom)))
-(defgeneric bounding-rectangle-set-edges (region left top right bottom)
-  #-aclpc (declare (values region)))
-(defgeneric bounding-rectangle-set-position (region x y)
-  #-aclpc (declare (values region)))
-(defgeneric bounding-rectangle-set-size (region width height)
-  #-aclpc (declare (values region)))
+(defgeneric bounding-rectangle* (region))
+(defgeneric bounding-rectangle-set-edges (region left top right bottom))
+(defgeneric bounding-rectangle-set-position (region x y))
+(defgeneric bounding-rectangle-set-size (region width height))
 
 (defmacro define-symmetric-region-method (name (region1 region2) &body body)
   `(progn
@@ -668,7 +657,6 @@
 ;; Make a new bounding rectangle for the region, and shift its position by DX,DY,
 ;; and return the new rectangle.
 (defun bounding-rectangle-shift-position (region dx dy &optional reuse-rectangle)
-  (declare (values region))
   (declare (type real dx dy))
   (let ((rectangle (bounding-rectangle region reuse-rectangle))
 	(dx (coordinate dx))
@@ -721,7 +709,6 @@
     (- bottom top)))
 
 (#-acl86win32 defun-inline #+acl86win32 defun bounding-rectangle-size (region)
-  (declare (values width height))
   (with-bounding-rectangle* (left top right bottom) region 
     #||(when (> right 10000) 
        (setq *reg* region)
@@ -756,7 +743,6 @@
 	    (+ top (/ (- bottom top) 2)))))
 
 (defun bounding-rectangle-ltrb (region)
-  (declare (values left top right bottom))
   (with-bounding-rectangle* (left top right bottom) region
     (values left top right bottom)))
 
@@ -776,30 +762,30 @@
     top))
 (define-bounding-rectangle-setf top)
 
-(defun-inline bounding-rectangle-right (region) 
-  (with-bounding-rectangle-ltrb (left top right bottom) region 
+(defun-inline bounding-rectangle-right (region)
+  (with-bounding-rectangle-ltrb (left top right bottom) region
     (declare (ignore left top bottom))
     right))
 (define-bounding-rectangle-setf right)
 
-(defun-inline bounding-rectangle-bottom (region) 
-  (with-bounding-rectangle-ltrb (left top right bottom) region 
+(defun-inline bounding-rectangle-bottom (region)
+  (with-bounding-rectangle-ltrb (left top right bottom) region
     (declare (ignore left top right))
     bottom))
 (define-bounding-rectangle-setf bottom)
 
 (defgeneric* (setf bounding-rectangle*) (left top right bottom region))
-(defmethod* (setf bounding-rectangle*) 
-	    (left top right bottom (region standard-bounding-rectangle))
+(defmethod* (setf bounding-rectangle*)
+    (left top right bottom (region standard-bounding-rectangle))
   (bounding-rectangle-set-edges region left top right bottom))
 
 (defgeneric* (setf bounding-rectangle-position) (x y region))
-(defmethod* (setf bounding-rectangle-position) 
+(defmethod* (setf bounding-rectangle-position)
 	    (x y (region standard-bounding-rectangle))
   (bounding-rectangle-set-position region x y))
 
 (defgeneric* (setf bounding-rectangle-size) (width height region))
-(defmethod* (setf bounding-rectangle-size) 
+(defmethod* (setf bounding-rectangle-size)
 	    (width height (region standard-bounding-rectangle))
   (bounding-rectangle-set-size region width height))
 
diff --git a/utils/transformations.lisp b/utils/transformations.lisp
index f66719f3dccc35e71889a820c3202148659d68aa..85388c18f55bd187e30d8bf538b37048383af3c5 100644
--- a/utils/transformations.lisp
+++ b/utils/transformations.lisp
@@ -25,20 +25,14 @@
 (defgeneric compose-scaling-with-transformation (transform mx my &optional origin))
 (defgeneric compose-rotation-with-transformation (transform angle &optional origin))
 
-(defgeneric transform-position (transform x y)
-  #-aclpc (declare (values x y)))
-(defgeneric untransform-position (transform x y)
-  #-aclpc (declare (values x y)))
-
-(defgeneric transform-distance (transform dx dy)
-  #-aclpc (declare (values dx dy)))
-(defgeneric untransform-distance (transform dx dy)
-  #-aclpc (declare (values dx dy)))
-
-(defgeneric transform-rectangle* (transform x1 y1 x2 y2)
-  #-aclpc (declare (values x1 y1 x2 y2)))
-(defgeneric untransform-rectangle* (transform x1 y1 x2 y2)
-  #-aclpc (declare (values x1 y1 x2 y2)))
+(defgeneric transform-position (transform x y))
+(defgeneric untransform-position (transform x y))
+
+(defgeneric transform-distance (transform dx dy))
+(defgeneric untransform-distance (transform dx dy))
+
+(defgeneric transform-rectangle* (transform x1 y1 x2 y2))
+(defgeneric untransform-rectangle* (transform x1 y1 x2 y2))
 
 
 ;;; Transformations
diff --git a/utils/utilities.lisp b/utils/utilities.lisp
index 68f53561d1f3880858d04c8f2056323c05a00674..e15d5b5c03df1abd3f0e9a9dcc814d75a2fc5b5f 100644
--- a/utils/utilities.lisp
+++ b/utils/utilities.lisp
@@ -20,7 +20,7 @@
   (warn warn-string)
   nil)
 
-(eval-when (compile load eval)
+(eval-when (:compile-toplevel :load-toplevel :execute)
 (defmacro with-collection (&body body)
   `(let (($with-collection-result$ nil)
          $with-collection-tail$)
diff --git a/xlib/ffi.lisp b/xlib/ffi.lisp
index 2517b8385ba02c7d1564adb44be2bd702683e9e8..138a7c4191d4f4eb37860c3f1caf1a0c2e1768f3 100644
--- a/xlib/ffi.lisp
+++ b/xlib/ffi.lisp
@@ -9,11 +9,11 @@
 (defmacro def-exported-constant (name value)
   ;; define the constant and export it from :x11
   `(progn
-     (eval-when (eval load compile)
+     (eval-when (:execute :load-toplevel :compile-toplevel)
        (export ',name))
      (defconstant ,name ,value)))
 
-(eval-when (compile load eval)
+(eval-when (:compile-toplevel :load-toplevel :execute)
   (defun transmogrify-ff-type (type)
     (if (consp type)
 	(case (car type)
@@ -27,7 +27,7 @@
 
 (defmacro def-exported-foreign-synonym-type (new-name old-name)
   `(progn
-     (eval-when (eval load compile)
+     (eval-when (:execute :load-toplevel :compile-toplevel)
        (export ',new-name))
      (ff::def-c-typedef ,new-name ,@(transmogrify-ff-type old-name))))
 
@@ -47,7 +47,7 @@
 			(mapcar #'(lambda (x)
 				    (fintern "~A-~A" name (car x)))
 				slots))))
-	  `(eval-when (eval load compile)
+	  `(eval-when (:execute :load-toplevel :compile-toplevel)
 	     (export '(,@(make-exports name)
 		       ,@(make-exports array-name)))))
        ,(flet ((foo-slot (slot)
@@ -144,9 +144,9 @@
 #-(version>= 6 1)
 (defmacro def-exported-foreign-function ((name &rest options) &rest args)
   `(progn
-     (eval-when (eval load compile)
+     (eval-when (:execute :load-toplevel :compile-toplevel)
        (export ',name))
-     (eval-when (compile eval load)
+     (eval-when (:compile-toplevel :execute :load-toplevel)
        ,(let ((c-name (ff:convert-foreign-name (second (assoc :name options))))
 	      (return-type (or (second (assoc :return-type options))
 			       'void)))
@@ -195,9 +195,9 @@
 #+(version>= 6 1)
 (defmacro def-exported-foreign-function ((name &rest options) &rest args)
   `(progn
-     (eval-when (eval load compile)
+     (eval-when (:execute :load-toplevel :compile-toplevel)
        (export ',name))
-     (eval-when (compile eval load)
+     (eval-when (:compile-toplevel :execute :load-toplevel)
        ,(let ((c-name (second (assoc :name options)))
 	      (return-type (or (second (assoc :return-type options))
 			       'void)))