Move the arity-dispatcher-tag from the microcode to the runtime system.

diff --git a/src/microcode/utabmd.c b/src/microcode/utabmd.c
index a24b20463e010b18296a7491660bc028de03e07c..a141b622c7e1d3296bb8d99c62de49d0a2a71ab6 100644 (file)
--- a/src/microcode/utabmd.c
+++ b/src/microcode/utabmd.c
@@ -172,9 +172,6 @@ initialize_fixed_objects_vector (void)
   STORE_FIXOBJ (GENERIC_TRAMPOLINE_REMAINDER, SHARP_F);
   STORE_FIXOBJ (GENERIC_TRAMPOLINE_MODULO, SHARP_F);
 
-  STORE_FIXOBJ (ARITY_DISPATCHER_TAG,
-               (char_pointer_to_symbol
-                ("#[(microcode)arity-dispatcher-tag]")));
   STORE_FIXOBJ (FIXOBJ_PROXIED_RECORD_TYPES,
                (make_vector ((FASDUMP_RECORD_MARKER_END
                               - FASDUMP_RECORD_MARKER_START),

diff --git a/src/runtime/procedure.scm b/src/runtime/procedure.scm
index 6306ef4c8ea73feaa5e1b02d31f33b56e78b3c62..e34fbc1cf4a01001290a44c77d4ed780c9127062 100644 (file)
--- a/src/runtime/procedure.scm
+++ b/src/runtime/procedure.scm
@@ -454,15 +454,21 @@ USA.
   ;; SELF argument.
   (make-entity default
               (list->vector
-               (cons (fixed-objects-item 'arity-dispatcher-tag)
+               (cons arity-dispatcher-tag
                      dispatched-cases))))
 
 (define (arity-dispatched-procedure? object)
   (and (entity? object)
        (vector? (entity-extra object))
        (fix:< 0 (vector-length (entity-extra object)))
-       (eq? (vector-ref (entity-extra object) 0)
-           (fixed-objects-item 'arity-dispatcher-tag))))
+       (eq? (vector-ref (entity-extra object) 0) arity-dispatcher-tag)))
+
+(define-integrable arity-dispatcher-tag
+  '|#[(microcode)arity-dispatcher-tag]|)
+
+(defer-boot-action 'fixed-objects
+  (lambda ()
+    (set-fixed-objects-item! 'arity-dispatcher-tag arity-dispatcher-tag)))
 
 (define (procedure-chains-to p1 p2)
   (let loop ((p1 p1))