dup optimized? [ execute ] [ drop f ] if ; inline
: init-remote-control ( -- )
- \ eval-callback ?callback 16 set-special-object
- \ yield-callback ?callback 17 set-special-object
- \ sleep-callback ?callback 18 set-special-object ;
+ \ eval-callback ?callback OBJ-EVAL-CALLBACK set-special-object
+ \ yield-callback ?callback OBJ-YIELD-CALLBACK set-special-object
+ \ sleep-callback ?callback OBJ-SLEEP-CALLBACK set-special-object ;
MAIN: init-remote-control
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 ;
! 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
! 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 )
{
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 ;
[ 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? ;
: 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
<PRIVATE
: init-thread-state ( -- )
- H{ } clone 66 set-special-object
- <dlist> 67 set-special-object
- <min-heap> 68 set-special-object
- H{ } clone 70 set-special-object ;
+ H{ } clone OBJ-THREADS set-special-object
+ <dlist> OBJ-RUN-QUEUE set-special-object
+ <min-heap> OBJ-SLEEP-QUEUE set-special-object
+ H{ } clone OBJ-WAITING-CALLBACKS set-special-object ;
: init-initial-thread ( -- )
[ ] "Initial" <thread>
'[ 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 ( -- )
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
! 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
{ 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
{ 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
! 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
M: array symbol>string [ (symbol>string) ] map ;
[
- 8 special-object utf8 alien>string string>cpu \ cpu set-global
- 9 special-object utf8 alien>string string>os \ os set-global
- 69 special-object utf8 alien>string \ vm-compiler set-global
+ OBJ-CPU special-object utf8 alien>string string>cpu \ cpu set-global
+ OBJ-OS special-object utf8 alien>string string>os \ os set-global
+ OBJ-VM-COMPILER special-object utf8 alien>string \ vm-compiler set-global
] "alien.strings" add-startup-hook
: 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>
! 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 -- ? )
: bump-effect-counter ( -- )
bump-effect-counter? [
- 49 special-object 0 or
- 1 +
- 49 set-special-object
+ REDEFINITION-COUNTER special-object 0 or
+ 1 + REDEFINITION-COUNTER set-special-object
] when ;
: notify-observers ( -- )
<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 ;
: 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 ;
: 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 ;
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 -- * )
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 ;
! 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>
: 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
[
cwd current-directory set-global
- 13 special-object alien>native-string cwd prepend-path \ image set-global
- 14 special-object alien>native-string cwd prepend-path \ vm set-global
+ OBJ-IMAGE special-object alien>native-string cwd prepend-path \ image 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
M: c-io-backend init-io ;
-: stdin-handle ( -- alien ) 11 special-object ;
-: stdout-handle ( -- alien ) 12 special-object ;
-: stderr-handle ( -- alien ) 63 special-object ;
+: stdin-handle ( -- alien ) OBJ-STDIN special-object ;
+: stdout-handle ( -- alien ) OBJ-STDOUT special-object ;
+: stderr-handle ( -- alien ) OBJ-STDERR special-object ;
: init-c-stdio ( -- )
stdin-handle <c-reader>
: 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>
! 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
>>
<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* ;
: namespace ( -- namespace ) namestack* last ; inline
: namestack ( -- namestack ) namestack* clone ;
-: set-namestack ( namestack -- ) >vector 0 set-context-object ;
-: global ( -- g ) 21 special-object { hashtable } declare ; inline
+: set-namestack ( namestack -- )
+ >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 ;
: vm ( -- path ) \ vm get-global ;
-: embedded? ( -- ? ) 15 special-object ;
+: embedded? ( -- ? ) OBJ-EMBEDDED special-object ;
: exit ( n -- * ) do-shutdown-hooks (exit) ;
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 {
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 {