constants for special object hardcoded literals

basis/alien/remote-control/remote-control.factor

@@ -19,8 +19,8 @@ IN: alien.remote-control
     dup optimized? [ execute ] [ drop f ] if ; inline
 
 : init-remote-control ( -- )
-    \ eval-callback ?callback 16 set-special-object
+    \ eval-callback ?callback OBJ-EVAL-CALLBACK set-special-object
-    \ yield-callback ?callback 17 set-special-object
+    \ yield-callback ?callback OBJ-YIELD-CALLBACK set-special-object
-    \ sleep-callback ?callback 18 set-special-object ;
+    \ sleep-callback ?callback OBJ-SLEEP-CALLBACK set-special-object ;
 
 MAIN: init-remote-control

basis/command-line/command-line.factor

@@ -10,7 +10,7 @@ SYMBOL: script
 SYMBOL: command-line
 
 : (command-line) ( -- args )
-    10 special-object sift [ alien>native-string ] map ;
+    OBJ-ARGS special-object sift [ alien>native-string ] map ;
 
 : rc-path ( name -- path )
     home prepend-path ;

basis/threads/threads.factor

@@ -13,7 +13,7 @@ IN: threads
 ! Wrap sub-primitives; we don't want them inlined into callers
 ! since their behavior depends on what frames are on the callstack
 : context ( -- context )
-    2 context-object ; inline
+    CONTEXT-OBJ-CONTEXT context-object ; inline
 
 : set-context ( obj context -- obj' )
     (set-context) ; inline
@@ -29,10 +29,10 @@ IN: threads
 
 ! Context introspection
 : namestack-for ( context -- namestack )
-    [ 0 ] dip context-object-for ;
+    [ CONTEXT-OBJ-NAMESTACK ] dip context-object-for ;
 
 : catchstack-for ( context -- catchstack )
-    [ 1 ] dip context-object-for ;
+    [ CONTEXT-OBJ-CATCHSTACK ] dip context-object-for ;
 
 : continuation-for ( context -- continuation )
     {
@@ -60,7 +60,7 @@ mailbox
 sleep-entry ;
 
 : self ( -- thread )
-    65 special-object { thread } declare ; inline
+    OBJ-CURRENT-THREAD special-object { thread } declare ; inline
 
 : thread-continuation ( thread -- continuation )
     context>> check-box value>> continuation-for ;
@@ -79,7 +79,7 @@ sleep-entry ;
     [ tnamespace ] dip change-at ; inline
 
 : threads ( -- assoc )
-    66 special-object { hashtable } declare ; inline
+    OBJ-THREADS special-object { hashtable } declare ; inline
 
 : thread-registered? ( thread -- ? )
     id>> threads key? ;
@@ -92,18 +92,18 @@ sleep-entry ;
 : unregister-thread ( thread -- )
     id>> threads delete-at ;
 
-: set-self ( thread -- ) 65 set-special-object ; inline
+: set-self ( thread -- ) OBJ-CURRENT-THREAD set-special-object ; inline
 
 PRIVATE>
 
 : run-queue ( -- dlist )
-    67 special-object { dlist } declare ; inline
+    OBJ-RUN-QUEUE special-object { dlist } declare ; inline
 
 : sleep-queue ( -- heap )
-    68 special-object { min-heap } declare ; inline
+    OBJ-SLEEP-QUEUE special-object { min-heap } declare ; inline
 
 : waiting-callbacks ( -- assoc )
-    70 special-object { hashtable } declare ; inline
+    OBJ-WAITING-CALLBACKS special-object { hashtable } declare ; inline
 
 : new-thread ( quot name class -- thread )
     new
@@ -234,10 +234,10 @@ M: real sleep
 <PRIVATE
 
 : init-thread-state ( -- )
-    H{ } clone 66 set-special-object
+    H{ } clone OBJ-THREADS set-special-object
-    <dlist> 67 set-special-object
+    <dlist> OBJ-RUN-QUEUE set-special-object
-    <min-heap> 68 set-special-object
+    <min-heap> OBJ-SLEEP-QUEUE set-special-object
-    H{ } clone 70 set-special-object ;
+    H{ } clone OBJ-WAITING-CALLBACKS set-special-object ;
 
 : init-initial-thread ( -- )
     [ ] "Initial" <thread>

basis/tools/deploy/shaker/shaker.factor

@@ -405,7 +405,7 @@ IN: tools.deploy.shaker
         '[ drop _ member? not ] assoc-filter
         [ drop string? not ] assoc-filter ! strip CLI args
         sift-assoc
-        21 set-special-object
+        OBJ-GLOBAL set-special-object
     ] [ drop ] if ;
 
 : strip-c-io ( -- )
@@ -556,7 +556,8 @@ SYMBOL: deploy-vocab
     strip-c-io
     strip-default-methods
     strip-compiler-classes
-    f 5 set-special-object ! we can't use the Factor debugger or Factor I/O anymore
+    ! we can't use the Factor debugger or Factor I/O anymore
+    f ERROR-HANDLER-QUOT set-special-object
     deploy-vocab get vocab-main deploy-startup-quot
     find-megamorphic-caches
     stripped-word-props

basis/vm/vm.factor

@@ -1,6 +1,6 @@
 ! Copyright (C) 2009, 2010 Phil Dawes, Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: classes.struct alien.c-types alien.syntax ;
+USING: classes.struct alien.c-types alien.syntax kernel.private ;
 IN: vm
 
 TYPEDEF: uintptr_t cell
@@ -14,7 +14,7 @@ STRUCT: context
 { datastack-region void* }
 { retainstack-region void* }
 { callstack-region void* }
-{ context-objects cell[10] } ;
+{ context-objects cell[context-object-count] } ;
 
 : context-field-offset ( field -- offset ) context offset-of ; inline
 
@@ -31,7 +31,7 @@ STRUCT: vm
 { cards-offset cell }
 { decks-offset cell }
 { signal-handler-addr cell }
-{ special-objects cell[80] } ;
+{ special-objects cell[special-object-count] } ;
 
 : vm-field-offset ( field -- offset ) vm offset-of ; inline
 

core/alien/alien.factor

@@ -103,7 +103,7 @@ SYMBOL: callbacks
 
 ! Used by compiler.codegen to wrap callback bodies
 : do-callback ( callback-quot wait-quot: ( callback -- ) -- )
-    t 3 set-context-object
+    t CONTEXT-OBJ-IN-CALLBACK-P set-context-object
     init-namespaces
     init-catchstack
     current-callback

core/alien/strings/strings.factor

@@ -65,7 +65,7 @@ M: byte-array symbol>string (symbol>string) ;
 M: array symbol>string [ (symbol>string) ] map ;
 
 [
-     8 special-object utf8 alien>string string>cpu \ cpu set-global
+    OBJ-CPU special-object utf8 alien>string string>cpu \ cpu set-global
-     9 special-object utf8 alien>string string>os \ os set-global
+    OBJ-OS special-object utf8 alien>string string>os \ os set-global
-    69 special-object utf8 alien>string \ vm-compiler set-global
+    OBJ-VM-COMPILER special-object utf8 alien>string \ vm-compiler set-global
 ] "alien.strings" add-startup-hook

core/combinators/combinators.factor

@@ -16,7 +16,7 @@ IN: combinators
 : execute-effect-unsafe ( word effect -- ) drop execute ;
 
 M: object throw
-    5 special-object [ die ] or
+    ERROR-HANDLER-QUOT special-object [ die ] or
     ( error -- * ) call-effect-unsafe ;
 
 PRIVATE>

core/compiler/units/units.factor

@@ -106,7 +106,7 @@ GENERIC: definitions-changed ( assoc obj -- )
 ! Incremented each time stack effects potentially changed, used
 ! by compiler.tree.propagation.call-effect for call( and execute(
 ! inline caching
-: effect-counter ( -- n ) 49 special-object ; inline
+: effect-counter ( -- n ) REDEFINITION-COUNTER special-object ; inline
 
 GENERIC: always-bump-effect-counter? ( defspec -- ? )
 
@@ -141,9 +141,8 @@ M: object always-bump-effect-counter? drop f ;
 
 : bump-effect-counter ( -- )
     bump-effect-counter? [
-        49 special-object 0 or
+        REDEFINITION-COUNTER special-object 0 or
-        1 +
+        1 + REDEFINITION-COUNTER set-special-object
-        49 set-special-object
     ] when ;
 
 : notify-observers ( -- )

core/continuations/continuations.factor

@@ -21,7 +21,7 @@ SYMBOL: restarts
 <PRIVATE
 
 : catchstack* ( -- catchstack )
-    1 context-object { vector } declare ; inline
+    CONTEXT-OBJ-CATCHSTACK context-object { vector } declare ; inline
 
 ! We have to defeat some optimizations to make continuations work
 : dummy-1 ( -- obj ) f ;
@@ -30,7 +30,7 @@ SYMBOL: restarts
 : catchstack ( -- catchstack ) catchstack* clone ; inline
 
 : set-catchstack ( catchstack -- )
-    >vector 1 set-context-object ; inline
+    >vector CONTEXT-OBJ-CATCHSTACK set-context-object ; inline
 
 : init-catchstack ( -- ) f set-catchstack ;
 
@@ -74,12 +74,17 @@ PRIVATE>
 
 : continue-with ( obj continuation -- * )
     [
-        swap 4 set-special-object
+        swap OBJ-CALLCC-1 set-special-object
         >continuation<
         set-catchstack
         set-namestack
         set-retainstack
-        [ set-datastack drop 4 special-object f 4 set-special-object f ] dip
+        [
+            set-datastack drop
+            OBJ-CALLCC-1 special-object
+            f OBJ-CALLCC-1 set-special-object
+            f
+        ] dip
         set-callstack
     ] ( obj continuation -- * ) call-effect-unsafe ;
 
@@ -113,7 +118,7 @@ thread-error-hook [ [ die ] ] initialize
 M: object error-in-thread ( error thread -- * )
     thread-error-hook get-global call( error thread -- * ) ;
 
-: in-callback? ( -- ? ) 3 context-object ;
+: in-callback? ( -- ? ) CONTEXT-OBJ-IN-CALLBACK-P context-object ;
 
 SYMBOL: callback-error-hook ! ( error -- * )
 
@@ -124,7 +129,7 @@ callback-error-hook [ [ die ] ] initialize
     catchstack* [
         in-callback?
         [ callback-error-hook get-global call( error -- * ) ]
-        [ 65 special-object error-in-thread ]
+        [ OBJ-CURRENT-THREAD special-object error-in-thread ]
         if
     ] [ pop continue-with ] if-empty ;
 
@@ -191,12 +196,12 @@ M: condition compute-restarts
     ! VM calls on error
     [
         ! 65 = self
-        65 special-object error-thread set-global
+        OBJ-CURRENT-THREAD special-object error-thread set-global
         continuation error-continuation set-global
         [ original-error set-global ] [ rethrow ] bi
-    ] 5 set-special-object
+    ] ERROR-HANDLER-QUOT set-special-object
     ! VM adds this to kernel errors, so that user-space
     ! can identify them
-    "kernel-error" 6 set-special-object ;
+    "kernel-error" OBJ-ERROR set-special-object ;
 
 PRIVATE>

core/init/init.factor

@@ -27,12 +27,12 @@ shutdown-hooks global [ drop V{ } clone ] cache drop
 
 : boot ( -- ) init-namespaces init-catchstack init-error-handler ;
 
-: startup-quot ( -- quot ) 20 special-object ;
+: startup-quot ( -- quot ) OBJ-STARTUP-QUOT special-object ;
 
-: set-startup-quot ( quot -- ) 20 set-special-object ;
+: set-startup-quot ( quot -- ) OBJ-STARTUP-QUOT set-special-object ;
 
-: shutdown-quot ( -- quot ) 22 special-object ;
+: shutdown-quot ( -- quot ) OBJ-SHUTDOWN-QUOT special-object ;
 
-: set-shutdown-quot ( quot -- ) 22 set-special-object ;
+: set-shutdown-quot ( quot -- ) OBJ-SHUTDOWN-QUOT set-special-object ;
 
 [ do-shutdown-hooks ] set-shutdown-quot

core/io/files/files.factor

@@ -57,7 +57,7 @@ PRIVATE>
 
 [
     cwd current-directory set-global
-    13 special-object alien>native-string cwd prepend-path \ image set-global
+    OBJ-IMAGE special-object alien>native-string cwd prepend-path \ image set-global
-    14 special-object alien>native-string cwd prepend-path \ vm set-global
+    OBJ-EXECUTABLE special-object alien>native-string cwd prepend-path \ vm set-global
     image parent-directory "resource-path" set-global
 ] "io.files" add-startup-hook

core/io/streams/c/c.factor

@@ -53,9 +53,9 @@ M: c-reader stream-read-until
 
 M: c-io-backend init-io ;
 
-: stdin-handle ( -- alien ) 11 special-object ;
+: stdin-handle ( -- alien ) OBJ-STDIN special-object ;
-: stdout-handle ( -- alien ) 12 special-object ;
+: stdout-handle ( -- alien ) OBJ-STDOUT special-object ;
-: stderr-handle ( -- alien ) 63 special-object ;
+: stderr-handle ( -- alien ) OBJ-STDERR special-object ;
 
 : init-c-stdio ( -- )
     stdin-handle <c-reader>

core/kernel/kernel.factor

@@ -245,4 +245,108 @@ ERROR: assert got expect ;
 
 : do-primitive ( number -- ) "Improper primitive call" throw ;
 
+! Special object count and identifiers must be kept in sync with:
+!   vm/objects.hpp
+!   basis/bootstrap/image/image.factor
+
+CONSTANT: special-object-count 80
+
+CONSTANT: OBJ-WALKER-HOOK 3
+
+CONSTANT: OBJ-CALLCC-1 4
+
+CONSTANT: ERROR-HANDLER-QUOT 5
+CONSTANT: OBJ-ERROR 6
+
+CONSTANT: OBJ-CELL-SIZE 7
+CONSTANT: OBJ-CPU 8
+CONSTANT: OBJ-OS 9
+
+CONSTANT: OBJ-ARGS 10
+CONSTANT: OBJ-STDIN 11
+CONSTANT: OBJ-STDOUT 12
+
+CONSTANT: OBJ-IMAGE 13
+CONSTANT: OBJ-EXECUTABLE 14
+
+CONSTANT: OBJ-EMBEDDED 15
+CONSTANT: OBJ-EVAL-CALLBACK 16
+CONSTANT: OBJ-YIELD-CALLBACK 17
+CONSTANT: OBJ-SLEEP-CALLBACK 18
+
+CONSTANT: OBJ-STARTUP-QUOT 20
+CONSTANT: OBJ-GLOBAL 21
+CONSTANT: OBJ-SHUTDOWN-QUOT 22
+
+CONSTANT: JIT-PROLOG 23
+CONSTANT: JIT-PRIMITIVE-WORD 24
+CONSTANT: JIT-PRIMITIVE 25
+CONSTANT: JIT-WORD-JUMP 26
+CONSTANT: JIT-WORD-CALL 27
+CONSTANT: JIT-IF-WORD 28
+CONSTANT: JIT-IF 29
+CONSTANT: JIT-EPILOG 30
+CONSTANT: JIT-RETURN 31
+CONSTANT: JIT-PROFILING 32
+CONSTANT: JIT-PUSH-IMMEDIATE 33
+CONSTANT: JIT-DIP-WORD 34
+CONSTANT: JIT-DIP 35
+CONSTANT: JIT-2DIP-WORD 36
+CONSTANT: JIT-2DIP 37
+CONSTANT: JIT-3DIP-WORD 38
+CONSTANT: JIT-3DIP 39
+CONSTANT: JIT-EXECUTE 40
+CONSTANT: JIT-DECLARE-WORD 41
+
+CONSTANT: C-TO-FACTOR-WORD 42
+CONSTANT: LAZY-JIT-COMPILE-WORD 43
+CONSTANT: UNWIND-NATIVE-FRAMES-WORD 44
+CONSTANT: GET-FPU-STATE-WORD 45
+CONSTANT: SET-FPU-STATE-WORD 46
+CONSTANT: SIGNAL-HANDLER-WORD 47
+CONSTANT: LEAF-SIGNAL-HANDLER-WORD 48
+
+CONSTANT: REDEFINITION-COUNTER 49
+
+CONSTANT: CALLBACK-STUB 50
+
+CONSTANT: PIC-LOAD 51
+CONSTANT: PIC-TAG 52
+CONSTANT: PIC-TUPLE 53
+CONSTANT: PIC-CHECK-TAG 54
+CONSTANT: PIC-CHECK-TUPLE 55
+CONSTANT: PIC-HIT 56
+CONSTANT: PIC-MISS-WORD 57
+CONSTANT: PIC-MISS-TAIL-WORD 58
+
+CONSTANT: MEGA-LOOKUP 59
+CONSTANT: MEGA-LOOKUP-WORD 60
+CONSTANT: MEGA-MISS-WORD 61
+
+CONSTANT: OBJ-UNDEFINED 62
+
+CONSTANT: OBJ-STDERR 63
+
+CONSTANT: OBJ-STAGE2 64
+
+CONSTANT: OBJ-CURRENT-THREAD 65
+
+CONSTANT: OBJ-THREADS 66
+CONSTANT: OBJ-RUN-QUEUE 67
+CONSTANT: OBJ-SLEEP-QUEUE 68
+
+CONSTANT: OBJ-VM-COMPILER 69
+
+CONSTANT: OBJ-WAITING-CALLBACKS 70
+
+! Context object count and identifiers must be kept in sync with:
+!   vm/contexts.hpp
+
+CONSTANT: context-object-count 10
+
+CONSTANT: CONTEXT-OBJ-NAMESTACK 0
+CONSTANT: CONTEXT-OBJ-CATCHSTACK 1
+CONSTANT: CONTEXT-OBJ-CONTEXT 2
+CONSTANT: CONTEXT-OBJ-IN-CALLBACK-P 3
+
 PRIVATE>

core/layouts/layouts.factor

@@ -36,7 +36,7 @@ SYMBOL: header-bits
 ! We do this in its own compilation unit so that they can be
 ! folded below
 <<
-: cell ( -- n ) 7 special-object ; foldable
+: cell ( -- n ) OBJ-CELL-SIZE special-object ; foldable
 
 : (first-bignum) ( m -- n ) tag-bits get - 1 - 2^ ; foldable
 >>

core/namespaces/namespaces.factor

@@ -6,7 +6,8 @@ IN: namespaces
 
 <PRIVATE
 
-: namestack* ( -- namestack ) 0 context-object { vector } declare ; inline
+: namestack* ( -- namestack )
+    CONTEXT-OBJ-NAMESTACK context-object { vector } declare ; inline
 : >n ( namespace -- ) namestack* push ;
 : ndrop ( -- ) namestack* pop* ;
 
@@ -14,8 +15,9 @@ PRIVATE>
 
 : namespace ( -- namespace ) namestack* last ; inline
 : namestack ( -- namestack ) namestack* clone ;
-: set-namestack ( namestack -- ) >vector 0 set-context-object ;
+: set-namestack ( namestack -- )
-: global ( -- g ) 21 special-object { hashtable } declare ; inline
+    >vector CONTEXT-OBJ-NAMESTACK set-context-object ;
+: global ( -- g ) OBJ-GLOBAL special-object { hashtable } declare ; inline
 : init-namespaces ( -- ) global 1array set-namestack ;
 : get ( variable -- value ) namestack* assoc-stack ; inline
 : set ( value variable -- ) namespace set-at ;

core/system/system.factor

@@ -54,6 +54,6 @@ PRIVATE>
 
 : vm ( -- path ) \ vm get-global ;
 
-: embedded? ( -- ? ) 15 special-object ;
+: embedded? ( -- ? ) OBJ-EMBEDDED special-object ;
 
 : exit ( n -- * ) do-shutdown-hooks (exit) ;

vm/contexts.hpp

@@ -1,6 +1,9 @@
 namespace factor
 {
 
+// Context object count and identifiers must be kept in sync with:
+//   core/kernel/kernel.factor
+
 static const cell context_object_count = 10;
 
 enum context_object {

vm/objects.hpp

@@ -1,6 +1,10 @@
 namespace factor
 {
 
+// Special object count and identifiers must be kept in sync with:
+//   core/kernel/kernel.factor
+//   core/bootstrap/image/image.factor
+
 static const cell special_object_count = 80;
 
 enum special_object {