diff --git a/src/cmp/proclamations.lsp b/src/cmp/proclamations.lsp index b077fba54..eecc886dc 100644 --- a/src/cmp/proclamations.lsp +++ b/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)) + diff --git a/src/cmp/sysfun.lsp b/src/cmp/sysfun.lsp index e1b66a199..7ea98f157 100644 --- a/src/cmp/sysfun.lsp +++ b/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)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;