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

Add context-specific special object table, generalizing catchstack_save and current_callback_save fields of context struct

db4
Slava Pestov 2010-03-18 22:06:00 +13:00
parent aa4a9f8288
commit 6aee6b3adc
18 changed files with 139 additions and 114 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -1,11 +1,12 @@
! Copyright (C) 2008, 2010 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: namespaces make math math.order math.parser sequences accessors
kernel kernel.private layouts assocs words summary arrays
combinators classes.algebra alien alien.c-types
alien.strings alien.arrays alien.complex alien.libraries sets libc
continuations.private fry cpu.architecture classes classes.struct locals
source-files.errors slots parser generic.parser strings
USING: namespaces make math math.order math.parser sequences
accessors kernel layouts assocs words summary arrays combinators
classes.algebra alien alien.private alien.c-types alien.strings
alien.arrays alien.complex alien.libraries sets libc
continuations.private fry cpu.architecture classes
classes.struct locals source-files.errors slots parser
generic.parser strings quotations
compiler.errors
compiler.alien
compiler.constants
@ -461,22 +462,6 @@ M: ##alien-indirect generate-insn
box-parameters
] with-param-regs ;
TUPLE: callback-context ;
: current-callback ( -- id ) 2 special-object ;
: wait-to-return ( token -- )
dup current-callback eq? [
drop
] [
yield-hook get call( -- ) wait-to-return
] if ;
: do-callback ( quot token -- )
init-catchstack
[ 2 set-special-object call ] keep
wait-to-return ; inline
: callback-return-quot ( ctype -- quot )
return>> {
{ [ dup void? ] [ drop [ ] ] }
@ -488,12 +473,10 @@ TUPLE: callback-context ;
parameters>> [ c-type c-type-boxer-quot ] map spread>quot ;
: wrap-callback-quot ( params -- quot )
[
[ callback-prep-quot ]
[ quot>> ]
[ callback-return-quot ] tri 3append ,
[ callback-context new do-callback ] %
] [ ] make ;
[ callback-prep-quot ] [ quot>> ] [ callback-return-quot ] tri 3append
yield-hook get
'[ _ _ do-callback ]
>quotation ;
M: ##alien-callback generate-insn
params>>

21
basis/compiler/tests/alien.factor
View File

@ -330,26 +330,15 @@ FUNCTION: ulonglong ffi_test_38 ( ulonglong x, ulonglong y ) ;
: callback-3 ( -- callback ) void { } "cdecl" [ 5 "x" set ] alien-callback ;
[ t ] [
namestack*
3 "x" set callback-3 callback_test_1
namestack* eq?
] unit-test
[ 5 ] [
[ t 3 5 ] [
[
3 "x" set callback-3 callback_test_1 "x" get
namestack*
3 "x" set callback-3 callback_test_1
namestack* eq?
"x" get "x" get-global
] with-scope
] unit-test
: callback-4 ( -- callback )
void { } "cdecl" [ "Hello world" write ] alien-callback
gc ;
[ "Hello world" ] [
[ callback-4 callback_test_1 ] with-string-writer
] unit-test
: callback-5 ( -- callback )
void { } "cdecl" [ gc ] alien-callback ;

7
basis/stack-checker/alien/alien.factor
View File

@ -1,9 +1,10 @@
! Copyright (C) 2008, 2010 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: kernel sequences accessors combinators math namespaces
init sets words assocs alien.libraries alien alien.c-types
cpu.architecture fry stack-checker.backend stack-checker.errors
stack-checker.visitor stack-checker.dependencies ;
init sets words assocs alien.libraries alien alien.private
alien.c-types cpu.architecture fry stack-checker.backend
stack-checker.errors stack-checker.visitor
stack-checker.dependencies ;
IN: stack-checker.alien
TUPLE: alien-node-params return parameters abi in-d out-d ;

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

@ -509,6 +509,11 @@ M: bad-executable summary
\ set-special-object { object fixnum } { } define-primitive
\ context-object { fixnum } { object } define-primitive
\ context-object make-flushable
\ set-context-object { object fixnum } { } define-primitive
\ (exists?) { string } { object } define-primitive
\ minor-gc { } { } define-primitive

1
basis/stack-checker/row-polymorphism/row-polymorphism.factor
View File

@ -4,7 +4,6 @@ continuations effects fry kernel locals math math.order namespaces
quotations sequences splitting
stack-checker.backend
stack-checker.errors
stack-checker.known-words
stack-checker.state
stack-checker.values
stack-checker.visitor ;

28
core/alien/alien.factor
View File

@ -1,7 +1,8 @@
! Copyright (C) 2004, 2010 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors assocs kernel math namespaces sequences system
kernel.private byte-arrays byte-vectors arrays init ;
kernel.private byte-arrays byte-vectors arrays init
continuations.private ;
IN: alien
PREDICATE: pinned-alien < alien underlying>> not ;
@ -83,6 +84,8 @@ ERROR: alien-assembly-error code ;
: alien-assembly ( args... return parameters abi quot -- return... )
dup alien-assembly-error ;
<PRIVATE
! Callbacks are registered in a global hashtable. Note that they
! are also pinned in a special callback area, so clearing this
! hashtable will not reclaim callbacks. It should only be
@ -91,8 +94,29 @@ SYMBOL: callbacks
[ H{ } clone callbacks set-global ] "alien" add-startup-hook
<PRIVATE
! Every context object in the VM is identified from the Factor
! side by a unique identifier
TUPLE: context-id < identity-tuple ;
C: <context-id> context-id
: context-id ( -- id ) 2 context-object ;
: set-context-id ( id -- ) 2 set-context-object ;
: wait-to-return ( yield-quot id -- )
dup context-id eq?
[ 2drop ] [ over call( -- ) wait-to-return ] if ;
! Used by compiler.codegen to wrap callback bodies
: do-callback ( callback-quot yield-quot -- )
init-namespaces
init-catchstack
<context-id>
[ set-context-id drop call ] [ wait-to-return drop ] 3bi ; inline
! A utility for defining global variables that are recompiled in
! every session
TUPLE: expiry-check object alien ;
: recompute-value? ( check -- ? )

2
core/bootstrap/primitives.factor
View File

@ -447,8 +447,10 @@ tuple
{ "call-clear" "kernel.private" "primitive_call_clear" (( quot -- * )) }
{ "check-datastack" "kernel.private" "primitive_check_datastack" (( array in# out# -- ? )) }
{ "compute-identity-hashcode" "kernel.private" "primitive_compute_identity_hashcode" (( obj -- )) }
{ "context-object" "kernel.private" "primitive_context_object" (( n -- obj )) }
{ "innermost-frame-executing" "kernel.private" "primitive_innermost_stack_frame_executing" (( callstack -- obj )) }
{ "innermost-frame-scan" "kernel.private" "primitive_innermost_stack_frame_scan" (( callstack -- n )) }
{ "set-context-object" "kernel.private" "primitive_set_context_object" (( obj n -- )) }
{ "set-datastack" "kernel.private" "primitive_set_datastack" (( ds -- )) }
{ "set-innermost-frame-quot" "kernel.private" "primitive_set_innermost_stack_frame_quot" (( n callstack -- )) }
{ "set-retainstack" "kernel.private" "primitive_set_retainstack" (( rs -- )) }

2
core/bootstrap/stage1.factor
View File

@ -40,7 +40,7 @@ load-help? off
run-file
] [
"Cannot find " write write "." print
"Please move " write image write " to the same directory as the Factor sources," print
"Please move " write image write " into the same directory as the Factor sources," print
"and try again." print
1 (exit)
] if

27
core/continuations/continuations.factor
View File

@ -13,7 +13,7 @@ SYMBOL: restarts
<PRIVATE
: catchstack* ( -- catchstack )
1 special-object { vector } declare ; inline
1 context-object { vector } declare ; inline
: >c ( continuation -- ) catchstack* push ;
@ -23,13 +23,14 @@ SYMBOL: restarts
: dummy-1 ( -- obj ) f ;
: dummy-2 ( obj -- obj ) dup drop ;
: init-catchstack ( -- ) V{ } clone 1 set-special-object ;
PRIVATE>
: catchstack ( -- catchstack ) catchstack* clone ; inline
: set-catchstack ( catchstack -- ) >vector 1 set-special-object ; inline
: set-catchstack ( catchstack -- )
>vector 1 set-context-object ; inline
: init-catchstack ( -- ) f set-catchstack ;
PRIVATE>
TUPLE: continuation data call retain name catch ;
@ -39,14 +40,12 @@ C: <continuation> continuation
datastack callstack retainstack namestack catchstack
<continuation> ;
<PRIVATE
: >continuation< ( continuation -- data call retain name catch )
{
[ data>> ]
[ call>> ]
[ retain>> ]
[ name>> ]
[ catch>> ]
} cleave ;
{ [ data>> ] [ call>> ] [ retain>> ] [ name>> ] [ catch>> ] } cleave ;
PRIVATE>
: ifcc ( capture restore -- )
[ dummy-1 continuation ] 2dip [ dummy-2 ] prepose ?if ; inline
@ -172,7 +171,7 @@ M: condition compute-restarts
<PRIVATE
: init-error-handler ( -- )
V{ } clone set-catchstack
init-catchstack
! VM calls on error
[
! 63 = self

6
core/namespaces/namespaces.factor
View File

@ -1,4 +1,4 @@
! Copyright (C) 2003, 2008 Slava Pestov.
! Copyright (C) 2003, 2010 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: kernel vectors sequences hashtables
arrays kernel.private math strings assocs ;
@ -6,7 +6,7 @@ IN: namespaces
<PRIVATE
: namestack* ( -- namestack ) 0 special-object { vector } declare ; inline
: namestack* ( -- namestack ) 0 context-object { vector } declare ; inline
: >n ( namespace -- ) namestack* push ;
: ndrop ( -- ) namestack* pop* ;
@ -14,7 +14,7 @@ PRIVATE>
: namespace ( -- namespace ) namestack* last ; inline
: namestack ( -- namestack ) namestack* clone ;
: set-namestack ( namestack -- ) >vector 0 set-special-object ;
: set-namestack ( namestack -- ) >vector 0 set-context-object ;
: global ( -- g ) 21 special-object { hashtable } declare ; inline
: init-namespaces ( -- ) global 1array set-namestack ;
: get ( variable -- value ) namestack* assoc-stack ; inline

40
vm/contexts.cpp
View File

@ -10,12 +10,26 @@ context::context(cell ds_size, cell rs_size) :
retainstack(0),
datastack_region(new segment(ds_size,false)),
retainstack_region(new segment(rs_size,false)),
catchstack_save(0),
current_callback_save(0),
next(NULL)
{
reset_datastack();
reset_retainstack();
reset_context_objects();
}
void context::reset_datastack()
{
datastack = datastack_region->start - sizeof(cell);
}
void context::reset_retainstack()
{
retainstack = retainstack_region->start - sizeof(cell);
}
void context::reset_context_objects()
{
memset_cell(context_objects,false_object,context_object_count * sizeof(cell));
}
context *factor_vm::alloc_context()
@ -47,12 +61,9 @@ void factor_vm::nest_stacks()
new_ctx->callstack_bottom = (stack_frame *)-1;
new_ctx->callstack_top = (stack_frame *)-1;
/* save per-callback special_objects */
new_ctx->current_callback_save = special_objects[OBJ_CURRENT_CALLBACK];
new_ctx->catchstack_save = special_objects[OBJ_CATCHSTACK];
new_ctx->reset_datastack();
new_ctx->reset_retainstack();
new_ctx->reset_context_objects();
new_ctx->next = ctx;
ctx = new_ctx;
@ -66,10 +77,6 @@ void nest_stacks(factor_vm *parent)
/* called when leaving a compiled callback */
void factor_vm::unnest_stacks()
{
/* restore per-callback special_objects */
special_objects[OBJ_CURRENT_CALLBACK] = ctx->current_callback_save;
special_objects[OBJ_CATCHSTACK] = ctx->catchstack_save;
context *old_ctx = ctx;
ctx = old_ctx->next;
dealloc_context(old_ctx);
@ -89,6 +96,19 @@ void factor_vm::init_stacks(cell ds_size_, cell rs_size_)
unused_contexts = NULL;
}
void factor_vm::primitive_context_object()
{
fixnum n = untag_fixnum(ctx->peek());
ctx->replace(ctx->context_objects[n]);
}
void factor_vm::primitive_set_context_object()
{
fixnum n = untag_fixnum(ctx->pop());
cell value = ctx->pop();
ctx->context_objects[n] = value;
}
bool factor_vm::stack_to_array(cell bottom, cell top)
{
fixnum depth = (fixnum)(top - bottom + sizeof(cell));

27
vm/contexts.hpp
View File

@ -1,6 +1,14 @@
namespace factor
{
static const cell context_object_count = 10;
enum context_object {
OBJ_NAMESTACK,
OBJ_CATCHSTACK,
OBJ_CONTEXT_ID,
};
/* Assembly code makes assumptions about the layout of this struct */
struct context {
/* C stack pointer on entry */
@ -19,13 +27,16 @@ struct context {
/* memory region holding current retain stack */
segment *retainstack_region;
/* saved special_objects slots on entry to callback */
cell catchstack_save;
cell current_callback_save;
/* context-specific special objects, accessed by context-object and
set-context-object primitives */
cell context_objects[context_object_count];
context *next;
context(cell ds_size, cell rs_size);
void reset_datastack();
void reset_retainstack();
void reset_context_objects();
cell peek()
{
@ -50,16 +61,6 @@ struct context {
replace(tagged);
}
void reset_datastack()
{
datastack = datastack_region->start - sizeof(cell);
}
void reset_retainstack()
{
retainstack = retainstack_region->start - sizeof(cell);
}
static const cell stack_reserved = (64 * sizeof(cell));
void fix_stacks()

8
vm/objects.cpp
View File

@ -5,15 +5,15 @@ namespace factor
void factor_vm::primitive_special_object()
{
fixnum e = untag_fixnum(ctx->peek());
ctx->replace(special_objects[e]);
fixnum n = untag_fixnum(ctx->peek());
ctx->replace(special_objects[n]);
}
void factor_vm::primitive_set_special_object()
{
fixnum e = untag_fixnum(ctx->pop());
fixnum n = untag_fixnum(ctx->pop());
cell value = ctx->pop();
special_objects[e] = value;
special_objects[n] = value;
}
void factor_vm::primitive_identity_hashcode()

6
vm/objects.hpp
View File

@ -4,11 +4,7 @@ namespace factor
static const cell special_object_count = 70;
enum special_object {
OBJ_NAMESTACK, /* used by library only */
OBJ_CATCHSTACK, /* used by library only, per-callback */
OBJ_CURRENT_CALLBACK = 2, /* used by library only, per-callback */
OBJ_WALKER_HOOK, /* non-local exit hook, used by library only */
OBJ_WALKER_HOOK = 3, /* non-local exit hook, used by library only */
OBJ_CALLCC_1, /* used to pass the value in callcc1 */
ERROR_HANDLER_QUOT = 5, /* quotation called when VM throws an error */

2
vm/primitives.cpp
View File

@ -47,6 +47,7 @@ PRIMITIVE(code_blocks)
PRIMITIVE(code_room)
PRIMITIVE(compact_gc)
PRIMITIVE(compute_identity_hashcode)
PRIMITIVE(context_object)
PRIMITIVE(data_room)
PRIMITIVE(datastack)
PRIMITIVE(die)
@ -111,6 +112,7 @@ PRIMITIVE(resize_string)
PRIMITIVE(retainstack)
PRIMITIVE(save_image)
PRIMITIVE(save_image_and_exit)
PRIMITIVE(set_context_object)
PRIMITIVE(set_datastack)
PRIMITIVE(set_innermost_stack_frame_quot)
PRIMITIVE(set_retainstack)

2
vm/primitives.hpp
View File

@ -43,6 +43,7 @@ DECLARE_PRIMITIVE(code_blocks)
DECLARE_PRIMITIVE(code_room)
DECLARE_PRIMITIVE(compact_gc)
DECLARE_PRIMITIVE(compute_identity_hashcode)
DECLARE_PRIMITIVE(context_object)
DECLARE_PRIMITIVE(data_room)
DECLARE_PRIMITIVE(datastack)
DECLARE_PRIMITIVE(die)
@ -107,6 +108,7 @@ DECLARE_PRIMITIVE(resize_string)
DECLARE_PRIMITIVE(retainstack)
DECLARE_PRIMITIVE(save_image)
DECLARE_PRIMITIVE(save_image_and_exit)
DECLARE_PRIMITIVE(set_context_object)
DECLARE_PRIMITIVE(set_datastack)
DECLARE_PRIMITIVE(set_innermost_stack_frame_quot)
DECLARE_PRIMITIVE(set_retainstack)

25
vm/slot_visitor.hpp
View File

@ -26,6 +26,7 @@ template<typename Visitor> struct slot_visitor {
cell visit_pointer(cell pointer);
void visit_handle(cell *handle);
void visit_object_array(cell *start, cell *end);
void visit_slots(object *ptr, cell payload_start);
void visit_slots(object *ptr);
void visit_stack_elements(segment *region, cell *top);
@ -55,6 +56,12 @@ void slot_visitor<Visitor>::visit_handle(cell *handle)
*handle = visit_pointer(*handle);
}
template<typename Visitor>
void slot_visitor<Visitor>::visit_object_array(cell *start, cell *end)
{
while(start < end) visit_handle(start++);
}
template<typename Visitor>
void slot_visitor<Visitor>::visit_slots(object *ptr, cell payload_start)
{
@ -64,7 +71,7 @@ void slot_visitor<Visitor>::visit_slots(object *ptr, cell payload_start)
if(slot != end)
{
slot++;
for(; slot < end; slot++) visit_handle(slot);
visit_object_array(slot,end);
}
}
@ -77,8 +84,7 @@ void slot_visitor<Visitor>::visit_slots(object *ptr)
template<typename Visitor>
void slot_visitor<Visitor>::visit_stack_elements(segment *region, cell *top)
{
for(cell *ptr = (cell *)region->start; ptr <= top; ptr++)
visit_handle(ptr);
visit_object_array((cell *)region->start,top + 1);
}
template<typename Visitor>
@ -88,11 +94,7 @@ void slot_visitor<Visitor>::visit_data_roots()
std::vector<data_root_range>::const_iterator end = parent->data_roots.end();
for(; iter < end; iter++)
{
data_root_range r = *iter;
for(cell index = 0; index < r.len; index++)
visit_handle(r.start + index);
}
visit_object_array(iter->start,iter->start + iter->len);
}
template<typename Visitor>
@ -162,8 +164,7 @@ void slot_visitor<Visitor>::visit_roots()
visit_callback_roots();
visit_literal_table_roots();
for(cell i = 0; i < special_object_count; i++)
visit_handle(&parent->special_objects[i]);
visit_object_array(parent->special_objects,parent->special_objects + special_object_count);
}
template<typename Visitor>
@ -175,9 +176,7 @@ void slot_visitor<Visitor>::visit_contexts()
{
visit_stack_elements(ctx->datastack_region,(cell *)ctx->datastack);
visit_stack_elements(ctx->retainstack_region,(cell *)ctx->retainstack);
visit_handle(&ctx->catchstack_save);
visit_handle(&ctx->current_callback_save);
visit_object_array(ctx->context_objects,ctx->context_objects + context_object_count);
ctx = ctx->next;
}

5
vm/vm.hpp
View File

@ -18,7 +18,8 @@ struct factor_vm
cell cards_offset;
cell decks_offset;
/* TAGGED user environment data; see getenv/setenv prims */
/* Various special objects, accessed by special-object and
set-special-object primitives */
cell special_objects[special_object_count];
/* Data stack and retain stack sizes */
@ -100,6 +101,8 @@ struct factor_vm
void nest_stacks();
void unnest_stacks();
void init_stacks(cell ds_size_, cell rs_size_);
void primitive_context_object();
void primitive_set_context_object();
bool stack_to_array(cell bottom, cell top);
cell array_to_stack(array *array, cell bottom);
void primitive_datastack();