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

Rename kernel.private:getenv/setenv to special-object/set-special-object to mirror recent renaming on the VM side

db4
Slava Pestov 2010-01-13 18:08:18 +13:00
parent 7bf76b9f13
commit 1c10196c43
26 changed files with 122 additions and 115 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 setenv
\ yield-callback ?callback 17 setenv
\ sleep-callback ?callback 18 setenv ;
\ eval-callback ?callback 16 set-special-object
\ yield-callback ?callback 17 set-special-object
\ sleep-callback ?callback 18 set-special-object ;
MAIN: init-remote-control

98
basis/bootstrap/image/image.factor
View File

@ -1,4 +1,4 @@
! Copyright (C) 2004, 2009 Slava Pestov.
! Copyright (C) 2004, 2010 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: alien alien.strings arrays byte-arrays generic hashtables
hashtables.private io io.binary io.files io.encodings.binary
@ -93,7 +93,7 @@ CONSTANT: image-version 4
CONSTANT: data-base 1024
CONSTANT: userenv-size 70
CONSTANT: special-objects-size 70
CONSTANT: header-size 10
@ -176,58 +176,58 @@ SYMBOL: architecture
RESET
! Boot quotation, set in stage1.factor
USERENV: bootstrap-startup-quot 20
SPECIAL-OBJECT: bootstrap-startup-quot 20
! Bootstrap global namesapce
USERENV: bootstrap-global 21
SPECIAL-OBJECT: bootstrap-global 21
! JIT parameters
USERENV: jit-prolog 23
USERENV: jit-primitive-word 24
USERENV: jit-primitive 25
USERENV: jit-word-jump 26
USERENV: jit-word-call 27
USERENV: jit-if-word 28
USERENV: jit-if 29
USERENV: jit-epilog 30
USERENV: jit-return 31
USERENV: jit-profiling 32
USERENV: jit-push 33
USERENV: jit-dip-word 34
USERENV: jit-dip 35
USERENV: jit-2dip-word 36
USERENV: jit-2dip 37
USERENV: jit-3dip-word 38
USERENV: jit-3dip 39
USERENV: jit-execute 40
USERENV: jit-declare-word 41
SPECIAL-OBJECT: jit-prolog 23
SPECIAL-OBJECT: jit-primitive-word 24
SPECIAL-OBJECT: jit-primitive 25
SPECIAL-OBJECT: jit-word-jump 26
SPECIAL-OBJECT: jit-word-call 27
SPECIAL-OBJECT: jit-if-word 28
SPECIAL-OBJECT: jit-if 29
SPECIAL-OBJECT: jit-epilog 30
SPECIAL-OBJECT: jit-return 31
SPECIAL-OBJECT: jit-profiling 32
SPECIAL-OBJECT: jit-push 33
SPECIAL-OBJECT: jit-dip-word 34
SPECIAL-OBJECT: jit-dip 35
SPECIAL-OBJECT: jit-2dip-word 36
SPECIAL-OBJECT: jit-2dip 37
SPECIAL-OBJECT: jit-3dip-word 38
SPECIAL-OBJECT: jit-3dip 39
SPECIAL-OBJECT: jit-execute 40
SPECIAL-OBJECT: jit-declare-word 41
USERENV: c-to-factor-word 42
USERENV: lazy-jit-compile-word 43
USERENV: unwind-native-frames-word 44
SPECIAL-OBJECT: c-to-factor-word 42
SPECIAL-OBJECT: lazy-jit-compile-word 43
SPECIAL-OBJECT: unwind-native-frames-word 44
USERENV: callback-stub 48
SPECIAL-OBJECT: callback-stub 48
! PIC stubs
USERENV: pic-load 49
USERENV: pic-tag 50
USERENV: pic-tuple 51
USERENV: pic-check-tag 52
USERENV: pic-check-tuple 53
USERENV: pic-hit 54
USERENV: pic-miss-word 55
USERENV: pic-miss-tail-word 56
SPECIAL-OBJECT: pic-load 49
SPECIAL-OBJECT: pic-tag 50
SPECIAL-OBJECT: pic-tuple 51
SPECIAL-OBJECT: pic-check-tag 52
SPECIAL-OBJECT: pic-check-tuple 53
SPECIAL-OBJECT: pic-hit 54
SPECIAL-OBJECT: pic-miss-word 55
SPECIAL-OBJECT: pic-miss-tail-word 56
! Megamorphic dispatch
USERENV: mega-lookup 57
USERENV: mega-lookup-word 58
USERENV: mega-miss-word 59
SPECIAL-OBJECT: mega-lookup 57
SPECIAL-OBJECT: mega-lookup-word 58
SPECIAL-OBJECT: mega-miss-word 59
! Default definition for undefined words
USERENV: undefined-quot 60
SPECIAL-OBJECT: undefined-quot 60
: userenv-offset ( symbol -- n )
userenvs get at header-size + ;
: special-object-offset ( symbol -- n )
special-objects get at header-size + ;
: emit ( cell -- ) image get push ;
@ -243,7 +243,7 @@ USERENV: undefined-quot 60
: fixup ( value offset -- ) image get set-nth ;
: heap-size ( -- size )
image get length header-size - userenv-size -
image get length header-size - special-objects-size -
bootstrap-cells ;
: here ( -- size ) heap-size data-base + ;
@ -282,10 +282,10 @@ GENERIC: ' ( obj -- ptr )
0 emit ! pointer to bignum 0
0 emit ! pointer to bignum 1
0 emit ! pointer to bignum -1
userenv-size [ f ' emit ] times ;
special-objects-size [ f ' emit ] times ;
: emit-userenv ( symbol -- )
[ get ' ] [ userenv-offset ] bi fixup ;
: emit-special-object ( symbol -- )
[ get ' ] [ special-object-offset ] bi fixup ;
! Bignums
@ -548,8 +548,8 @@ M: quotation '
\ unwind-native-frames unwind-native-frames-word set
[ undefined ] undefined-quot set ;
: emit-userenvs ( -- )
userenvs get keys [ emit-userenv ] each ;
: emit-special-objects ( -- )
special-objects get keys [ emit-special-object ] each ;
: fixup-header ( -- )
heap-size data-heap-size-offset fixup ;
@ -566,8 +566,8 @@ M: quotation '
emit-jit-data
"Serializing global namespace..." print flush
emit-global
"Serializing user environment..." print flush
emit-userenvs
"Serializing special object table..." print flush
emit-special-objects
"Performing word fixups..." print flush
fixup-words
"Performing header fixups..." print flush

10
basis/bootstrap/image/syntax/syntax.factor
View File

@ -1,14 +1,14 @@
! Copyright (C) 2009 Slava Pestov.
! Copyright (C) 2009, 2010 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: parser kernel namespaces assocs words.symbol ;
IN: bootstrap.image.syntax
SYMBOL: userenvs
SYMBOL: special-objects
SYNTAX: RESET H{ } clone userenvs set-global ;
SYNTAX: RESET H{ } clone special-objects set-global ;
SYNTAX: USERENV:
SYNTAX: SPECIAL-OBJECT:
CREATE-WORD scan-word
[ swap userenvs get set-at ]
[ swap special-objects get set-at ]
[ drop define-symbol ]
2bi ;

2
basis/cocoa/application/application.factor
View File

@ -49,7 +49,7 @@ TUPLE: objc-error alien reason ;
M: objc-error summary ( error -- )
drop "Objective C exception" ;
[ [ objc-error ] 19 setenv ] "cocoa.application" add-startup-hook
[ [ objc-error ] 19 set-special-object ] "cocoa.application" add-startup-hook
: running.app? ( -- ? )
#! Test if we're running a .app.

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

@ -8,7 +8,8 @@ IN: command-line
SYMBOL: script
SYMBOL: command-line
: (command-line) ( -- args ) 10 getenv sift [ alien>native-string ] map ;
: (command-line) ( -- args )
10 special-object sift [ alien>native-string ] map ;
: rc-path ( name -- path )
os windows? [ "." prepend ] unless

2
basis/compiler/cfg/intrinsics/intrinsics.factor
View File

@ -30,7 +30,7 @@ IN: compiler.cfg.intrinsics
{
{ kernel.private:tag [ drop emit-tag ] }
{ kernel.private:getenv [ emit-getenv ] }
{ kernel.private:special-object [ emit-special-object ] }
{ kernel.private:(identity-hashcode) [ drop emit-identity-hashcode ] }
{ math.private:both-fixnums? [ drop emit-both-fixnums? ] }
{ math.private:fixnum+ [ drop emit-fixnum+ ] }

4
basis/compiler/cfg/intrinsics/misc/misc.factor
View File

@ -9,8 +9,8 @@ IN: compiler.cfg.intrinsics.misc
: emit-tag ( -- )
ds-pop tag-mask get ^^and-imm ^^tag-fixnum ds-push ;
: emit-getenv ( node -- )
"userenv" ^^vm-field-ptr
: emit-special-object ( node -- )
"special-objects" ^^vm-field-ptr
swap node-input-infos first literal>>
[ ds-drop 0 ^^slot-imm ] [ ds-pop ^^offset>slot ^^slot ] if*
ds-push ;

4
basis/compiler/codegen/codegen.factor
View File

@ -474,7 +474,7 @@ M: ##alien-indirect generate-insn
TUPLE: callback-context ;
: current-callback ( -- id ) 2 getenv ;
: current-callback ( -- id ) 2 special-object ;
: wait-to-return ( token -- )
dup current-callback eq? [
@ -485,7 +485,7 @@ TUPLE: callback-context ;
: do-callback ( quot token -- )
init-catchstack
[ 2 setenv call ] keep
[ 2 set-special-object call ] keep
wait-to-return ; inline
: callback-return-quot ( ctype -- quot )

4
basis/compiler/tests/intrinsics.factor
View File

@ -54,8 +54,8 @@ IN: compiler.tests.intrinsics
[ HEX: 123456 ] [ 1 [ "a\u123456c" string-nth ] compile-call ] unit-test
[ HEX: 123456 ] [ [ 1 "a\u123456c" string-nth ] compile-call ] unit-test
[ ] [ [ 0 getenv ] compile-call drop ] unit-test
[ ] [ 1 getenv [ 1 setenv ] compile-call ] unit-test
[ ] [ [ 0 special-object ] compile-call drop ] unit-test
[ ] [ 1 special-object [ 1 set-special-object ] compile-call ] unit-test
[ ] [ 1 [ drop ] compile-call ] unit-test
[ ] [ [ 1 drop ] compile-call ] unit-test

6
basis/stack-checker/known-words/known-words.factor
View File

@ -489,10 +489,10 @@ M: bad-executable summary
\ word-xt { word } { integer integer } define-primitive
\ word-xt make-flushable
\ getenv { fixnum } { object } define-primitive
\ getenv make-flushable
\ special-object { fixnum } { object } define-primitive
\ special-object make-flushable
\ setenv { object fixnum } { } define-primitive
\ set-special-object { object fixnum } { } define-primitive
\ (exists?) { string } { object } define-primitive

16
basis/threads/threads.factor
View File

@ -21,7 +21,7 @@ mailbox
variables
sleep-entry ;
: self ( -- thread ) 63 getenv ; inline
: self ( -- thread ) 63 special-object ; inline
! Thread-local storage
: tnamespace ( -- assoc )
@ -36,7 +36,7 @@ sleep-entry ;
: tchange ( key quot -- )
tnamespace swap change-at ; inline
: threads ( -- assoc ) 64 getenv ;
: threads ( -- assoc ) 64 special-object ;
: thread ( id -- thread ) threads at ;
@ -61,7 +61,7 @@ ERROR: not-running thread ;
: unregister-thread ( thread -- )
check-registered id>> threads delete-at ;
: set-self ( thread -- ) 63 setenv ; inline
: set-self ( thread -- ) 63 set-special-object ; inline
PRIVATE>
@ -75,9 +75,9 @@ PRIVATE>
: <thread> ( quot name -- thread )
\ thread new-thread ;
: run-queue ( -- dlist ) 65 getenv ;
: run-queue ( -- dlist ) 65 special-object ;
: sleep-queue ( -- heap ) 66 getenv ;
: sleep-queue ( -- heap ) 66 special-object ;
: resume ( thread -- )
f >>state
@ -216,9 +216,9 @@ GENERIC: error-in-thread ( error thread -- )
<PRIVATE
: init-threads ( -- )
H{ } clone 64 setenv
<dlist> 65 setenv
<min-heap> 66 setenv
H{ } clone 64 set-special-object
<dlist> 65 set-special-object
<min-heap> 66 set-special-object
initial-thread global
[ drop [ ] "Initial" <thread> ] cache
<box> >>continuation

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

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

2
basis/tools/deploy/shaker/strip-cocoa.factor
View File

@ -17,7 +17,7 @@ IN: cocoa.application
: objc-error ( error -- ) die ;
[ [ die ] 19 setenv ] "cocoa.application" add-startup-hook
[ [ die ] 19 set-special-object ] "cocoa.application" add-startup-hook
H{ } clone \ pool [
global [

4
basis/vm/vm.factor
View File

@ -1,4 +1,4 @@
! Copyright (C) 2009 Phil Dawes.
! 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 ;
IN: vm
@ -30,7 +30,7 @@ STRUCT: vm
{ nursery zone }
{ cards-offset cell }
{ decks-offset cell }
{ userenv cell[70] } ;
{ special-objects cell[70] } ;
: vm-field-offset ( field -- offset ) vm offset-of ; inline

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

@ -67,6 +67,6 @@ M: string string>symbol string>symbol* ;
M: sequence string>symbol [ string>symbol* ] map ;
[
8 getenv utf8 alien>string string>cpu \ cpu set-global
9 getenv utf8 alien>string string>os \ os set-global
8 special-object utf8 alien>string string>cpu \ cpu set-global
9 special-object utf8 alien>string string>os \ os set-global
] "alien.strings" add-startup-hook

4
core/bootstrap/primitives.factor
View File

@ -421,8 +421,8 @@ tuple
{ "float-u>=" "math.private" (( x y -- ? )) }
{ "(word)" "words.private" (( name vocab -- word )) }
{ "word-xt" "words" (( word -- start end )) }
{ "getenv" "kernel.private" (( n -- obj )) }
{ "setenv" "kernel.private" (( obj n -- )) }
{ "special-object" "kernel.private" (( n -- obj )) }
{ "set-special-object" "kernel.private" (( obj n -- )) }
{ "(exists?)" "io.files.private" (( path -- ? )) }
{ "minor-gc" "memory" (( -- )) }
{ "gc" "memory" (( -- )) }

4
core/combinators/combinators.factor
View File

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

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

@ -100,7 +100,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 ) 47 getenv ; inline
: effect-counter ( -- n ) 47 special-object ; inline
GENERIC: bump-effect-counter* ( defspec -- ? )
@ -132,7 +132,11 @@ M: object bump-effect-counter* drop f ;
or ;
: bump-effect-counter ( -- )
bump-effect-counter? [ 47 getenv 0 or 1 + 47 setenv ] when ;
bump-effect-counter? [
47 special-object 0 or
1 +
47 set-special-object
] when ;
: notify-observers ( -- )
updated-definitions dup assoc-empty?

16
core/continuations/continuations.factor
View File

@ -13,7 +13,7 @@ SYMBOL: restarts
<PRIVATE
: catchstack* ( -- catchstack )
1 getenv { vector } declare ; inline
1 special-object { vector } declare ; inline
: >c ( continuation -- ) catchstack* push ;
@ -23,13 +23,13 @@ SYMBOL: restarts
: dummy-1 ( -- obj ) f ;
: dummy-2 ( obj -- obj ) dup drop ;
: init-catchstack ( -- ) V{ } clone 1 setenv ;
: init-catchstack ( -- ) V{ } clone 1 set-special-object ;
PRIVATE>
: catchstack ( -- catchstack ) catchstack* clone ; inline
: set-catchstack ( catchstack -- ) >vector 1 setenv ; inline
: set-catchstack ( catchstack -- ) >vector 1 set-special-object ; inline
TUPLE: continuation data call retain name catch ;
@ -71,12 +71,12 @@ PRIVATE>
: continue-with ( obj continuation -- * )
[
swap 4 setenv
swap 4 set-special-object
>continuation<
set-catchstack
set-namestack
set-retainstack
[ set-datastack drop 4 getenv f 4 setenv f ] dip
[ set-datastack drop 4 special-object f 4 set-special-object f ] dip
set-callstack
] (( obj continuation -- * )) call-effect-unsafe ;
@ -173,12 +173,12 @@ M: condition compute-restarts
! VM calls on error
[
! 63 = self
63 getenv error-thread set-global
63 special-object error-thread set-global
continuation error-continuation set-global
rethrow
] 5 setenv
] 5 set-special-object
! VM adds this to kernel errors, so that user-space
! can identify them
"kernel-error" 6 setenv ;
"kernel-error" 6 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 getenv ;
: startup-quot ( -- quot ) 20 special-object ;
: set-startup-quot ( quot -- ) 20 setenv ;
: set-startup-quot ( quot -- ) 20 set-special-object ;
: shutdown-quot ( -- quot ) 22 getenv ;
: shutdown-quot ( -- quot ) 22 special-object ;
: set-shutdown-quot ( quot -- ) 22 setenv ;
: set-shutdown-quot ( quot -- ) 22 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 getenv alien>native-string cwd prepend-path \ image set-global
14 getenv alien>native-string cwd prepend-path \ vm 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
image parent-directory "resource-path" set-global
] "io.files" add-startup-hook

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

@ -61,9 +61,9 @@ M: c-reader stream-read-until
M: c-io-backend init-io ;
: stdin-handle ( -- alien ) 11 getenv ;
: stdout-handle ( -- alien ) 12 getenv ;
: stderr-handle ( -- alien ) 61 getenv ;
: stdin-handle ( -- alien ) 11 special-object ;
: stdout-handle ( -- alien ) 12 special-object ;
: stderr-handle ( -- alien ) 61 special-object ;
: init-c-stdio ( -- )
stdin-handle <c-reader>

8
core/kernel/kernel-docs.factor
View File

@ -655,13 +655,13 @@ HELP: tag ( object -- n )
{ $values { "object" object } { "n" "a tag number" } }
{ $description "Outputs an object's tag number, between zero and one less than " { $link num-types } ". This is implementation detail and user code should call " { $link class } " instead." } ;
HELP: getenv ( n -- obj )
HELP: special-object ( n -- obj )
{ $values { "n" "a non-negative integer" } { "obj" object } }
{ $description "Reads an object from the Factor VM's environment table. User code never has to read the environment table directly; instead, use one of the callers of this word." } ;
{ $description "Reads an object from the Factor VM's special object table. User code never has to read the special object table directly; instead, use one of the callers of this word." } ;
HELP: setenv ( obj n -- )
HELP: set-special-object ( obj n -- )
{ $values { "obj" object } { "n" "a non-negative integer" } }
{ $description "Writes an object to the Factor VM's environment table. User code never has to write to the environment table directly; instead, use one of the callers of this word." } ;
{ $description "Writes an object to the Factor VM's special object table. User code never has to write to the special object table directly; instead, use one of the callers of this word." } ;
HELP: object
{ $class-description

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 getenv ; foldable
: cell ( -- n ) 7 special-object ; foldable
: (first-bignum) ( m -- n ) tag-bits get - 1 - 2^ ; foldable
>>

6
core/namespaces/namespaces.factor
View File

@ -6,7 +6,7 @@ IN: namespaces
<PRIVATE
: namestack* ( -- namestack ) 0 getenv { vector } declare ; inline
: namestack* ( -- namestack ) 0 special-object { vector } declare ; inline
: >n ( namespace -- ) namestack* push ;
: ndrop ( -- ) namestack* pop* ;
@ -14,8 +14,8 @@ PRIVATE>
: namespace ( -- namespace ) namestack* last ; inline
: namestack ( -- namestack ) namestack* clone ;
: set-namestack ( namestack -- ) >vector 0 setenv ;
: global ( -- g ) 21 getenv { hashtable } declare ; inline
: set-namestack ( namestack -- ) >vector 0 set-special-object ;
: global ( -- g ) 21 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

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