Slightly more compact format for proclamations / sysfun

src/cmp/proclamations.lsp

@@ -42,8 +42,7 @@
 
 (in-package "C")
 
-(defmacro proclamation (&whole form name arg-types return-type
-                        &rest properties)
+(defun proclaim-function (name arg-types return-type &rest properties)
   (when (sys:get-sysprop name 'proclaimed-arg-types)
     (warn "Duplicate proclamation for ~A" name))
   (when (eq arg-types '())
@@ -56,15 +55,14 @@
      do (case p
           (:no-sp-change
            (sys:put-sysprop name 'no-sp-change t))
-          ((:predicate :pure)
+          ((:predicate :pure):q
            (sys:put-sysprop name 'pure t)
            (sys:put-sysprop name 'no-side-effects t))
           ((:no-side-effects :reader)
            (sys:put-sysprop name 'no-side-effects t))
           (otherwise
            (error "Unknown property ~S in function proclamation ~S"
-                  p form))))
-  nil)
+                  p form)))))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; AUXILIARY TYPES
@@ -161,6 +159,8 @@
   'unsigned-byte)
 
 
+(eval-when (:compile-toplevel :execute)
+(defparameter +proclamations+ '(
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;;
 ;;; ALL FUNCTION DECLARATIONS
@@ -1275,24 +1275,34 @@
 (proclamation si:unbound () t :pure)
 
 #+clos
-(progn
 (proclamation si:allocate-raw-instance (t t fixnum) si:instance)
+#+clos
 (proclamation si:instance-ref-safe (t fixnum) t)
+#+clos
 (proclamation si:instance-ref (t fixnum) t :reader)
+#+clos
 (proclamation si::instance-sig (standard-object) list :reader)
+#+clos
 (proclamation si:instance-set (t fixnum t) t)
+#+clos
 (proclamation si:instance-class (t) t :reader)
+#+clos
 (proclamation si:instance-class-set (t t) t)
+#+clos
 (proclamation si:instancep (t) t :pure)
+#+clos
 (proclamation si:sl-boundp (t) t :reader)
+#+clos
 (proclamation si:sl-makunbound (t fixnum) t)
+#+clos
 (proclamation standard-instance-access (standard-object fixnum) t :reader)
+#+clos
 (proclamation funcallable-standard-instance-access
               (funcallable-standard-object fixnum)
               t :reader)
+#+clos
 (proclamation associate-methods-to-gfun (generic-function *)
               generic-function)
-)
 
 ;;;
 ;;; A. FFI
@@ -1301,3 +1311,8 @@
 (proclamation si:pointer (t) unsigned-byte)
 (proclamation si:foreign-data-p (t) gen-bool :pure)
 
+))) ; eval-when
+
+(loop for i in '#.(mapcar #'rest +proclamations+)
+   do (apply #'proclaim-function i))
+

src/cmp/sysfun.lsp

@@ -22,9 +22,9 @@
 
 (in-package "COMPILER")
 
-(defmacro def-inline (name safety arg-types return-rep-type expansion
-                      &key (one-liner t) (exact-return-type nil)
-		      &aux arg-rep-types)
+(defun def-inline (name safety arg-types return-rep-type expansion
+                   &key (one-liner t) (exact-return-type nil)
+                   &aux arg-rep-types)
   (setf safety
 	(case safety
 	  (:unsafe :inline-unsafe)
@@ -57,11 +57,10 @@
                  (not (equalp return-type (inline-info-return-type i))))
        do (format t "~&;;; Redundand inline definition for ~A~&;;; ~<~A~>~&;;; ~<~A~>"
                   name i inline-info))
-    (put-sysprop name safety (cons inline-info previous)))
-  nil)
-
-(eval '(progn
+    (put-sysprop name safety (cons inline-info previous))))
 
+(eval-when (:compile-toplevel :execute)
+(defparameter +inline-forms+ '(
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;;
 ;;; ALL FUNCTION DECLARATIONS AND INLINE FORMS
@@ -847,45 +846,55 @@
  "MAKE_FIXNUM((((~((cl_fixnum)-1 << (#0))) << (#1)) & (cl_fixnum)(#2)) >> (#1))")
 
 ;; Functions only available with threads
-#+threads(progn
-
+#+threads
 (def-inline mp:lock-count :unsafe (mp:lock) fixnum "((#0)->lock.count)")
-)
 
 ;; Functions only available with CLOS
 
-#+clos(progn
-
+#+clos
 (def-inline si:instance-ref :always (t fixnum) t "ecl_instance_ref((#0),(#1))")
+#+clos
 (def-inline si:instance-ref :unsafe (standard-object fixnum) t
  "(#0)->instance.slots[#1]")
 
+#+clos
 (def-inline si::instance-sig :unsafe (standard-object) list
  "(#0)->instance.sig")
 
+#+clos
 (def-inline si:instance-set :unsafe (t fixnum t) t
  "ecl_instance_set((#0),(#1),(#2))")
+#+clos
 (def-inline si:instance-set :unsafe (standard-object fixnum t) t
  "(#0)->instance.slots[#1]=(#2)")
 
+#+clos
 (def-inline si:instance-class :always (standard-object) t "CLASS_OF(#0)")
 
+#+clos
 (def-inline si::instancep :always (t) :bool "@0;ECL_INSTANCEP(#0)")
+#+clos
 (def-inline si:unbound :always nil t "ECL_UNBOUND")
 
+#+clos
 (def-inline si:sl-boundp :always (t) :bool "(#0)!=ECL_UNBOUND")
 
+#+clos
 (def-inline standard-instance-access :always (standard-object fixnum) t "ecl_instance_ref((#0),(#1))")
+#+clos
 (def-inline standard-instance-access :unsafe (standard-object fixnum) t
  "(#0)->instance.slots[#1]")
 
+#+clos
 (def-inline funcallable-standard-instance-access :always (funcallable-standard-object fixnum) t "ecl_instance_ref((#0),(#1))")
+#+clos
 (def-inline funcallable-standard-instance-access :unsafe (funcallable-standard-object fixnum) t
  "(#0)->instance.slots[#1]")
 
-)
+))) ; eval-when
 
-)) ; eval
+(loop for i in '#.(mapcar #'rest +inline-forms+)
+   do (apply #'def-inline i))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;;