From 6aee6b3adcf575040fde1099c1cc88286e1351e2 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Thu, 18 Mar 2010 22:06:00 +1300 Subject: [PATCH] Add context-specific special object table, generalizing catchstack_save and current_callback_save fields of context struct --- basis/compiler/codegen/codegen.factor | 39 +++++------------- basis/compiler/tests/alien.factor | 21 +++------- basis/stack-checker/alien/alien.factor | 7 ++-- .../known-words/known-words.factor | 5 +++ .../row-polymorphism/row-polymorphism.factor | 1 - core/alien/alien.factor | 28 ++++++++++++- core/bootstrap/primitives.factor | 2 + core/bootstrap/stage1.factor | 2 +- core/continuations/continuations.factor | 25 ++++++------ core/namespaces/namespaces.factor | 6 +-- vm/contexts.cpp | 40 ++++++++++++++----- vm/contexts.hpp | 27 +++++++------ vm/objects.cpp | 8 ++-- vm/objects.hpp | 6 +-- vm/primitives.cpp | 2 + vm/primitives.hpp | 2 + vm/slot_visitor.hpp | 25 ++++++------ vm/vm.hpp | 5 ++- 18 files changed, 138 insertions(+), 113 deletions(-) diff --git a/basis/compiler/codegen/codegen.factor b/basis/compiler/codegen/codegen.factor index 3edfcc565b..73cfd6b86e 100755 --- a/basis/compiler/codegen/codegen.factor +++ b/basis/compiler/codegen/codegen.factor @@ -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>> diff --git a/basis/compiler/tests/alien.factor b/basis/compiler/tests/alien.factor index acb5555bc3..ad8dac3ef9 100755 --- a/basis/compiler/tests/alien.factor +++ b/basis/compiler/tests/alien.factor @@ -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 ; diff --git a/basis/stack-checker/alien/alien.factor b/basis/stack-checker/alien/alien.factor index 81d8a93240..9039c5d3f0 100644 --- a/basis/stack-checker/alien/alien.factor +++ b/basis/stack-checker/alien/alien.factor @@ -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 ; diff --git a/basis/stack-checker/known-words/known-words.factor b/basis/stack-checker/known-words/known-words.factor index 2c08533ebb..d0cbb05919 100644 --- a/basis/stack-checker/known-words/known-words.factor +++ b/basis/stack-checker/known-words/known-words.factor @@ -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 diff --git a/basis/stack-checker/row-polymorphism/row-polymorphism.factor b/basis/stack-checker/row-polymorphism/row-polymorphism.factor index d91c766fea..1b8bd8faed 100644 --- a/basis/stack-checker/row-polymorphism/row-polymorphism.factor +++ b/basis/stack-checker/row-polymorphism/row-polymorphism.factor @@ -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 ; diff --git a/core/alien/alien.factor b/core/alien/alien.factor index 631fdcfc93..191886393a 100644 --- a/core/alien/alien.factor +++ b/core/alien/alien.factor @@ -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 ; + 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 + + [ 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 -- ? ) diff --git a/core/bootstrap/primitives.factor b/core/bootstrap/primitives.factor index 2772b68875..19a179a6b1 100644 --- a/core/bootstrap/primitives.factor +++ b/core/bootstrap/primitives.factor @@ -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 -- )) } diff --git a/core/bootstrap/stage1.factor b/core/bootstrap/stage1.factor index 78658206de..41218fff6d 100644 --- a/core/bootstrap/stage1.factor +++ b/core/bootstrap/stage1.factor @@ -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 diff --git a/core/continuations/continuations.factor b/core/continuations/continuations.factor index 687f7153a1..cfceb1f715 100644 --- a/core/continuations/continuations.factor +++ b/core/continuations/continuations.factor @@ -13,7 +13,7 @@ SYMBOL: restarts 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 ; +: catchstack ( -- catchstack ) catchstack* clone ; inline -PRIVATE> +: set-catchstack ( catchstack -- ) + >vector 1 set-context-object ; inline -: catchstack ( -- catchstack ) catchstack* clone ; inline +: init-catchstack ( -- ) f set-catchstack ; -: set-catchstack ( catchstack -- ) >vector 1 set-special-object ; inline +PRIVATE> TUPLE: continuation data call retain name catch ; @@ -39,14 +40,12 @@ C: continuation datastack callstack retainstack namestack catchstack ; +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 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 diff --git a/vm/contexts.cpp b/vm/contexts.cpp index 394d14e55d..1079c572d2 100644 --- a/vm/contexts.cpp +++ b/vm/contexts.cpp @@ -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)); diff --git a/vm/contexts.hpp b/vm/contexts.hpp index 9ba9bb313c..e555bd4a92 100644 --- a/vm/contexts.hpp +++ b/vm/contexts.hpp @@ -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() diff --git a/vm/objects.cpp b/vm/objects.cpp index f1201c4de7..6b007f5d42 100644 --- a/vm/objects.cpp +++ b/vm/objects.cpp @@ -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() diff --git a/vm/objects.hpp b/vm/objects.hpp index 2d777ac516..772863d3f1 100644 --- a/vm/objects.hpp +++ b/vm/objects.hpp @@ -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 */ diff --git a/vm/primitives.cpp b/vm/primitives.cpp index be9d5c6ff6..aa1e10f5a5 100644 --- a/vm/primitives.cpp +++ b/vm/primitives.cpp @@ -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) diff --git a/vm/primitives.hpp b/vm/primitives.hpp index 520df423a1..a36050323f 100644 --- a/vm/primitives.hpp +++ b/vm/primitives.hpp @@ -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) diff --git a/vm/slot_visitor.hpp b/vm/slot_visitor.hpp index 0ab9cc171d..e8ff7e30d2 100644 --- a/vm/slot_visitor.hpp +++ b/vm/slot_visitor.hpp @@ -26,6 +26,7 @@ template 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::visit_handle(cell *handle) *handle = visit_pointer(*handle); } +template +void slot_visitor::visit_object_array(cell *start, cell *end) +{ + while(start < end) visit_handle(start++); +} + template void slot_visitor::visit_slots(object *ptr, cell payload_start) { @@ -64,7 +71,7 @@ void slot_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::visit_slots(object *ptr) template void slot_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 @@ -88,11 +94,7 @@ void slot_visitor::visit_data_roots() std::vector::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 @@ -162,8 +164,7 @@ void slot_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 @@ -175,9 +176,7 @@ void slot_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; } diff --git a/vm/vm.hpp b/vm/vm.hpp index 714794aa32..f20145b43f 100755 --- a/vm/vm.hpp +++ b/vm/vm.hpp @@ -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(); -- 2.34.1