From 0f2688147d8bd88e47a0d45f42eef3ca0da1eb90 Mon Sep 17 00:00:00 2001 From: Juan Jose Garcia Ripoll Date: Wed, 19 Dec 2012 22:44:01 +0100 Subject: [PATCH] Merged STANDARD-INSTANCE-GET and STANDARD-INSTANCE-ACCESS. --- src/c/symbols_list.h | 4 ++-- src/c/symbols_list2.h | 4 ++-- src/clos/slotvalue.lsp | 4 ++-- src/clos/std-slot-value.lsp | 6 +++--- src/cmp/proclamations.lsp | 6 ++---- src/cmp/sysfun.lsp | 10 +++------- src/h/external.h | 2 ++ 7 files changed, 16 insertions(+), 20 deletions(-) diff --git a/src/c/symbols_list.h b/src/c/symbols_list.h index fa085643e..bb59dda88 100755 --- a/src/c/symbols_list.h +++ b/src/c/symbols_list.h @@ -1668,7 +1668,7 @@ cl_symbols[] = { {CLOS_ "FIND-METHOD-COMBINATION", CLOS_ORDINARY, NULL, -1, OBJNULL}, {CLOS_ "FORWARD-REFERENCED-CLASS", CLOS_ORDINARY, NULL, -1, OBJNULL}, {CLOS_ "FUNCALLABLE-STANDARD-CLASS", CLOS_ORDINARY, NULL, -1, OBJNULL}, -{CLOS_ "FUNCALLABLE-STANDARD-INSTANCE-ACCESS", CLOS_ORDINARY, si_instance_ref, 2, OBJNULL}, +{CLOS_ "FUNCALLABLE-STANDARD-INSTANCE-ACCESS", CLOS_ORDINARY, ECL_NAME(clos_funcallable_standard_instance_access), 2, OBJNULL}, {CLOS_ "FUNCALLABLE-STANDARD-OBJECT", CLOS_ORDINARY, NULL, -1, OBJNULL}, {CLOS_ "GENERIC-FUNCTION-ARGUMENT-PRECEDENCE-ORDER", CLOS_ORDINARY, NULL, -1, OBJNULL}, {CLOS_ "GENERIC-FUNCTION-DECLARATIONS", CLOS_ORDINARY, NULL, -1, OBJNULL}, @@ -1713,7 +1713,7 @@ cl_symbols[] = { {CLOS_ "STANDARD-ACCESSOR-METHOD", CLOS_ORDINARY, NULL, -1, OBJNULL}, {CLOS_ "STANDARD-DIRECT-SLOT-DEFINITION", CLOS_ORDINARY, NULL, -1, OBJNULL}, {CLOS_ "STANDARD-EFFECTIVE-SLOT-DEFINITION", CLOS_ORDINARY, NULL, -1, OBJNULL}, -{CLOS_ "STANDARD-INSTANCE-ACCESS", CLOS_ORDINARY, si_instance_ref, 2, OBJNULL}, +{CLOS_ "STANDARD-INSTANCE-ACCESS", CLOS_ORDINARY, ECL_NAME(clos_standard_instance_access), 2, OBJNULL}, {CLOS_ "STANDARD-READER-METHOD", CLOS_ORDINARY, NULL, -1, OBJNULL}, {CLOS_ "STANDARD-SLOT-DEFINITION", CLOS_ORDINARY, NULL, -1, OBJNULL}, {CLOS_ "STANDARD-WRITER-METHOD", CLOS_ORDINARY, NULL, -1, OBJNULL}, diff --git a/src/c/symbols_list2.h b/src/c/symbols_list2.h index be8fb5eec..27946a40a 100644 --- a/src/c/symbols_list2.h +++ b/src/c/symbols_list2.h @@ -1668,7 +1668,7 @@ cl_symbols[] = { {CLOS_ "FIND-METHOD-COMBINATION",NULL}, {CLOS_ "FORWARD-REFERENCED-CLASS",NULL}, {CLOS_ "FUNCALLABLE-STANDARD-CLASS",NULL}, -{CLOS_ "FUNCALLABLE-STANDARD-INSTANCE-ACCESS","si_instance_ref"}, +{CLOS_ "FUNCALLABLE-STANDARD-INSTANCE-ACCESS","ECL_NAME(clos_funcallable_standard_instance_access)"}, {CLOS_ "FUNCALLABLE-STANDARD-OBJECT",NULL}, {CLOS_ "GENERIC-FUNCTION-ARGUMENT-PRECEDENCE-ORDER",NULL}, {CLOS_ "GENERIC-FUNCTION-DECLARATIONS",NULL}, @@ -1713,7 +1713,7 @@ cl_symbols[] = { {CLOS_ "STANDARD-ACCESSOR-METHOD",NULL}, {CLOS_ "STANDARD-DIRECT-SLOT-DEFINITION",NULL}, {CLOS_ "STANDARD-EFFECTIVE-SLOT-DEFINITION",NULL}, -{CLOS_ "STANDARD-INSTANCE-ACCESS","si_instance_ref"}, +{CLOS_ "STANDARD-INSTANCE-ACCESS","ECL_NAME(clos_standard_instance_access)"}, {CLOS_ "STANDARD-READER-METHOD",NULL}, {CLOS_ "STANDARD-SLOT-DEFINITION",NULL}, {CLOS_ "STANDARD-WRITER-METHOD",NULL}, diff --git a/src/clos/slotvalue.lsp b/src/clos/slotvalue.lsp index dfbffa8d5..98f9a7dbc 100644 --- a/src/clos/slotvalue.lsp +++ b/src/clos/slotvalue.lsp @@ -28,14 +28,14 @@ (defmethod slot-value-using-class ((class std-class) self slotd) (declare (ignore class)) (let* ((location (slot-definition-location slotd)) - (value (standard-instance-get self location))) + (value (standard-instance-access self location))) (if (si:sl-boundp value) value (values (slot-unbound class self (slot-definition-name slotd)))))) (defmethod slot-boundp-using-class ((class std-class) self slotd) (declare (ignore class)) - (si:sl-boundp (standard-instance-get self (slot-definition-location slotd)))) + (si:sl-boundp (standard-instance-access self (slot-definition-location slotd)))) (defmethod (setf slot-value-using-class) (val (class std-class) self slotd) (declare (ignore class)) diff --git a/src/clos/std-slot-value.lsp b/src/clos/std-slot-value.lsp index 4726bc49d..57f5c2570 100644 --- a/src/clos/std-slot-value.lsp +++ b/src/clos/std-slot-value.lsp @@ -163,7 +163,7 @@ ;;; Specific functions for slot reading, writing, boundness checking, etc. ;;; -(defun standard-instance-get (instance location) +(defun standard-instance-access (instance location) (with-early-accessors (+standard-class-slots+ +slot-definition-slots+) (ensure-up-to-date-instance instance) @@ -198,7 +198,7 @@ (if location-table (let ((location (gethash slot-name location-table nil))) (if location - (let ((value (standard-instance-get self location))) + (let ((value (standard-instance-access self location))) (if (si:sl-boundp value) value (values (slot-unbound class self slot-name)))) @@ -220,7 +220,7 @@ (if location-table (let ((location (gethash slot-name location-table nil))) (if location - (si:sl-boundp (standard-instance-get self location)) + (si:sl-boundp (standard-instance-access self location)) (values (slot-missing class self slot-name 'SLOT-BOUNDP)))) (let ((slotd (find slot-name (class-slots class) :key #'slot-definition-name))) (if slotd diff --git a/src/cmp/proclamations.lsp b/src/cmp/proclamations.lsp index b45e503cf..5c6e9a1bc 100644 --- a/src/cmp/proclamations.lsp +++ b/src/cmp/proclamations.lsp @@ -290,8 +290,6 @@ ;; Slot accessors: ; (proclamation unbound-slot-instance (condition) si::instance :predicate) -#+clos -(proclamation clos::standard-instance-get (ext:instance t) t) #+clos (proclamation clos::standard-instance-set (t ext:instance t) t) #+clos @@ -1344,10 +1342,10 @@ #+clos (proclamation si:sl-makunbound (t fixnum) t) #+clos -(proclamation clos:standard-instance-access (standard-object fixnum) t :reader) +(proclamation clos:standard-instance-access (standard-object t) t :reader) #+clos (proclamation clos:funcallable-standard-instance-access - (clos:funcallable-standard-object fixnum) + (clos:funcallable-standard-object t) t :reader) #+clos (proclamation associate-methods-to-gfun (generic-function *) diff --git a/src/cmp/sysfun.lsp b/src/cmp/sysfun.lsp index 2439c512d..24867db29 100644 --- a/src/cmp/sysfun.lsp +++ b/src/cmp/sysfun.lsp @@ -839,16 +839,12 @@ #+clos (def-inline si:sl-boundp :always (t) :bool "(#0)!=ECL_UNBOUND") -#+clos -(def-inline clos:standard-instance-access :always (t t) t "ecl_instance_ref((#0),ecl_to_size(#1))") #+clos (def-inline clos:standard-instance-access :always (t fixnum) t "ecl_instance_ref((#0),(#1))") #+clos (def-inline clos:standard-instance-access :unsafe (standard-object fixnum) t "(#0)->instance.slots[#1]") -#+clos -(def-inline clos:funcallable-standard-instance-access :always (t t) t "ecl_instance_ref((#0),ecl_to_size(#1))") #+clos (def-inline clos:funcallable-standard-instance-access :always (t fixnum) t "ecl_instance_ref((#0),(#1))") #+clos @@ -938,8 +934,8 @@ clos:std-compute-applicable-methods clos:std-compute-effective-method clos:compute-effective-method-function - ;; standard-instance-access ; this function is a synonym for si:instance-ref - ;; funcallable-standard-instance-access ; same for this one + standard-instance-access + ;; funcallable-standard-instance-access alias for standard-instance-access subclassp of-class-p ;; boot.lsp slot-boundp @@ -1006,7 +1002,7 @@ ,@'(;; defclass.lsp clos::ensure-class ;; std-slot-value.lsp - clos::standard-instance-get + clos::standard-instance-access clos::standard-instance-set clos::find-slot-definition ;; combin.lsp diff --git a/src/h/external.h b/src/h/external.h index 7936fcd5e..4f625f7b1 100755 --- a/src/h/external.h +++ b/src/h/external.h @@ -2159,6 +2159,8 @@ extern ECL_API cl_object clos_standard_instance_set _ECL_ARGS((cl_narg narg, cl_ /* std-slot-value */ extern ECL_API cl_object cl_slot_value(cl_object object, cl_object slot); extern ECL_API cl_object clos_slot_value_set(cl_object value, cl_object instance, cl_object name); +extern ECL_API cl_object clos_standard_instance_access(cl_object object, cl_object location); +#define clos_funcallable_standard_instance_access clos_standard_instance_access #endif