steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

constants for special object hardcoded literals

db4
Joe Groff 2011-11-02 12:54:31 -07:00
parent 94db86a6db
commit 186bf65a00
19 changed files with 172 additions and 54 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
basis/alien/remote-control/remote-control.factor
View File

@ -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
\ 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

2
basis/command-line/command-line.factor
View File

@ -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 ;

26
basis/threads/threads.factor
View File

@ -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
<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>

5
basis/tools/deploy/shaker/shaker.factor
View File

@ -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

6
basis/vm/vm.factor
View File

@ -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

2
core/alien/alien.factor
View File

@ -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

6
core/alien/strings/strings.factor
View File

@ -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
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

2
core/combinators/combinators.factor
View File

@ -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>

7
core/compiler/units/units.factor
View File

@ -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
1 +
49 set-special-object
REDEFINITION-COUNTER special-object 0 or
1 + REDEFINITION-COUNTER set-special-object
] when ;
: notify-observers ( -- )

23
core/continuations/continuations.factor
View File

@ -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>

8
core/init/init.factor
View File

@ -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

4
core/io/files/files.factor
View File

@ -57,7 +57,7 @@ PRIVATE>
[
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

6
core/io/streams/c/c.factor
View File

@ -53,9 +53,9 @@ M: c-reader stream-read-until
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>

104
core/kernel/kernel.factor
View File

@ -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>

2
core/layouts/layouts.factor
View File

@ -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
>>

8
core/namespaces/namespaces.factor
View File

@ -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 ;
: 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 ;

2
core/system/system.factor
View File

@ -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) ;

3
vm/contexts.hpp
View File

@ -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 {

4
vm/objects.hpp
View File

@ -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 {