|
»
clisp-cvs Digest, Vol 43, Issue 4
|
View:
New views
1 Messages
—
Rating Filter:
Alert me
|
 |
clisp-cvs Digest, Vol 43, Issue 4
by clisp-cvs-request
::
Rate this Message:
Send clisp-cvs mailing list submissions to
clisp-cvs@... To subscribe or unsubscribe via the World Wide Web, visit https://lists.sourceforge.net/lists/listinfo/clisp-cvs or, via email, send a message with subject or body 'help' to clisp-cvs-request@... You can reach the person managing the list at clisp-cvs-owner@... When replying, please edit your Subject line so it is more specific than "Re: Contents of clisp-cvs digest..." CLISP CVS commits for today Today's Topics: 1. clisp/src eval.d,1.273,1.274 io.d,1.361,1.362 (Sam Steingold) 2. clisp/src ChangeLog, 1.7189, 1.7190 control.d, 1.168, 1.169 eval.d, 1.274, 1.275 lispbibl.d, 1.896, 1.897 spvw.d, 1.516, 1.517 threads.lisp, 1.22, 1.23 zthread.d, 1.71, 1.72 (Vladimir Tzankov) ---------------------------------------------------------------------- Message: 1 Date: Tue, 03 Nov 2009 16:20:54 +0000 From: Sam Steingold <sds@...> Subject: clisp/src eval.d,1.273,1.274 io.d,1.361,1.362 To: clisp-cvs@... Message-ID: <E1N5M7q-0005gi-Pu@...> Update of /cvsroot/clisp/clisp/src In directory ddv4jf1.ch3.sourceforge.com:/tmp/cvs-serv21861/src Modified Files: eval.d io.d Log Message: comment spelling (interprete -> interpret) Index: eval.d =================================================================== RCS file: /cvsroot/clisp/clisp/src/eval.d,v retrieving revision 1.273 retrieving revision 1.274 diff -u -d -r1.273 -r1.274 --- eval.d 25 Oct 2009 13:44:54 -0000 1.273 +++ eval.d 3 Nov 2009 16:20:52 -0000 1.274 @@ -3857,7 +3857,7 @@ { var uintC count = TheCodevec(codevec)->ccv_numkey; /* number of Keyword-parameters */ dotimesC(count,count, { pushSTACK(unbound); } ); /* initialize with #<UNBOUND> */ - interpret_bytecode(closure,codevec,CCV_START_KEY); /* interprete bytecode starting at Byte 12 */ + interpret_bytecode(closure,codevec,CCV_START_KEY); /* interpret bytecode starting at Byte 12 */ } goto done; apply_cclosure_key: /* jump to Closure only with &KEY: */ @@ -3884,7 +3884,7 @@ and poss. discard remaining arguments: */ closure = match_cclosure_key(*closure_,argcount,key_args_pointer,rest_args_pointer); codevec = TheCclosure(closure)->clos_codevec; - interpret_bytecode(closure,codevec,CCV_START_KEY); /* interprete bytecode starting at Byte 12 */ + interpret_bytecode(closure,codevec,CCV_START_KEY); /* interpret bytecode starting at Byte 12 */ } goto done; apply_cclosure_rest_nokey: { @@ -3912,7 +3912,7 @@ apply_cclosure_nokey: /* jump to Closure without &KEY : */ closure = *closure_; codevec = TheCclosure(closure)->clos_codevec; apply_cclosure_nokey_: - interpret_bytecode(closure,codevec,CCV_START_NONKEY); /* interprete bytecode starting at Byte 8 */ + interpret_bytecode(closure,codevec,CCV_START_NONKEY); /* interpret bytecode starting at Byte 8 */ done: CHECK_STACK_C(STACKbefore,closure); skipSTACK(1); /* discard Closure */ @@ -6802,7 +6802,7 @@ #define CALLC() \ { check_STACK(); check_SP(); /* check STACK and SP */ \ with_saved_context( \ - /* interprete compiled closure starting at Byte 8 */ \ + /* interpret compiled closure starting at Byte 8 */ \ interpret_bytecode(value1,TheCclosure(value1)->clos_codevec,CCV_START_NONKEY); \ ); \ } @@ -6810,7 +6810,7 @@ #define CALLCKEY() \ { check_STACK(); check_SP(); /* check STACK and SP */ \ with_saved_context( \ - /* interprete compiled closure starting at Byte 12: */ \ + /* interpret compiled closure starting at Byte 12: */ \ interpret_bytecode(value1,TheCclosure(value1)->clos_codevec,CCV_START_KEY); \ ); \ } Index: io.d =================================================================== RCS file: /cvsroot/clisp/clisp/src/io.d,v retrieving revision 1.361 retrieving revision 1.362 diff -u -d -r1.361 -r1.362 --- io.d 2 Oct 2009 10:55:13 -0000 1.361 +++ io.d 3 Nov 2009 16:20:52 -0000 1.362 @@ -1472,7 +1472,7 @@ { a_digit < base }+ { a_ratio { a_digit < base }+ | } is matching. 4. set base:=10. - 5. try to interprete the token as a floating-point-number or decimal-integer: + 5. try to interpret the token as a floating-point-number or decimal-integer: Test, if the syntax { a_plus | a_minus | } - already read { a_digit }* { a_dot { a_digit }* | } @@ -1915,7 +1915,7 @@ } /* reading of Token finished */ if (!nullpSv(read_suppress)) /* *READ-SUPPRESS* /= NIL ? */ - return NIL; /* yes -> don't interprete Token, NIL as value */ + return NIL; /* yes -> don't interpret Token, NIL as value */ /* Token must be interpreted the Token is in TLO(token_buff_1), TLO(token_buff_2), token_escape_flag. */ if ((!token_escape_flag) && test_dots()) { @@ -1964,7 +1964,7 @@ } } { /* Token cannot be interpreted as number. - we interprete the Token as Symbol (even, if the Token matches + we interpret the Token as Symbol (even if the Token matches Potential-number-Syntax, thus being a 'reserved token' (in the spirit of CLTL S. 341 top) ). first determine the distribution of colons (Characters with @@ -1975,8 +1975,8 @@ 3. one colon, not at the beginning -> external Symbol 4. two colons, not at the beginning -> internal Symbol In the last three cases no more colons may occur. - (It cannot be checked here , that at step 2. the name-part - respectively at 3. and 4. the package-part and the name-part + (It cannot be checked here that at step 2 the name-part + [respectively at 3 and 4 the package-part and the name-part] do not have the syntax of a number, because TOKEN_ESCAPE_FLAG is valid for the whole Token. Compare |USER|:: and |USER|::|| ) */ @@ -3034,7 +3034,7 @@ /* n must be a Fixnum between 2 and 36 (inclusive): */ if (posfixnump(STACK_0) && (base = posfixnum_to_V(STACK_0), (base >= 2) && (base <= 36))) { - return_Values radix_2(base); /* interprete Token as rational number */ + return_Values radix_2(base); /* interpret Token as rational number */ } else { pushSTACK(*stream_); /* STREAM-ERROR slot STREAM */ pushSTACK(STACK_(0+1)); /* n */ ------------------------------ Message: 2 Date: Tue, 03 Nov 2009 21:10:34 +0000 From: Vladimir Tzankov <vtz@...> Subject: clisp/src ChangeLog, 1.7189, 1.7190 control.d, 1.168, 1.169 eval.d, 1.274, 1.275 lispbibl.d, 1.896, 1.897 spvw.d, 1.516, 1.517 threads.lisp, 1.22, 1.23 zthread.d, 1.71, 1.72 To: clisp-cvs@... Message-ID: <E1N5QeA-0007zH-81@...> Update of /cvsroot/clisp/clisp/src In directory ddv4jf1.ch3.sourceforge.com:/tmp/cvs-serv30643/src Modified Files: ChangeLog control.d eval.d lispbibl.d spvw.d threads.lisp zthread.d Log Message: [MULTITHREAD]: create dynamic bindings for all special variables Index: zthread.d =================================================================== RCS file: /cvsroot/clisp/clisp/src/zthread.d,v retrieving revision 1.71 retrieving revision 1.72 diff -u -d -r1.71 -r1.72 --- zthread.d 25 Oct 2009 13:51:35 -0000 1.71 +++ zthread.d 3 Nov 2009 21:10:32 -0000 1.72 @@ -156,6 +156,38 @@ }); } +/* UP: creates initial bindings in thread context from alist + > initial_bindings: alist of (symbol . form) elements */ +global void initialize_thread_bindings(gcv_object_t *initial_bindings) { + /* do not defer interrupts by default and while evaluating initial forms */ + Symbol_thread_value(S(defer_interrupts)) = NIL; + Symbol_thread_value(S(deferred_interrupts)) = NIL; + if (!missingp(*initial_bindings)) { + var uintC bind_count = 0; + var gcv_object_t *bottom = &STACK_0; + while (!endp(*initial_bindings)) { /* it is proper list */ + var object pair=Car(*initial_bindings); + if (consp(pair) && symbolp(Car(pair))) { + var object sym = Car(pair); + /* only if the symbol already has per thread value cell. + we do not want to add new one here. */ + if (TheSymbol(sym)->tls_index != SYMBOL_TLS_INDEX_NONE) { + /* look in the stack whether we have already bound this symbol */ + var gcv_object_t *top = &STACK_0; + for (;bottom != top && !eq(*top,sym); top skipSTACKop 1) ; + if (bottom == top) { /* not found */ + pushSTACK(sym); bind_count++; /* push the symbol */ + eval(Cdr(pair)); /* maygc */ + Symbol_thread_value(STACK_0) = value1; + } + } + } + *initial_bindings = Cdr(*initial_bindings); + } + skipSTACK(bind_count); /* restore the stack */ + } +} + /* All newly created threads start here.*/ local THREADPROC_SIGNATURE thread_stub(void *arg) { @@ -190,27 +222,8 @@ finish_entry_frame(DRIVER,returner,,{skipSTACK(2+3);goto end_of_thread;}); /* initialize the low level i/o stuff for this thread*/ init_reader_low(me); - /* create special vars initial dynamic bindings. - do not create DYNBIND frame since anyway we are at the - "top level" of the thread. */ - if (!missingp(*initial_bindings)) { - while (!endp(*initial_bindings)) { - var object pair=Car(*initial_bindings); - if (consp(pair) && symbolp(Car(pair))) { - /* only if the symbol is special per thread variable */ - if (TheSymbol(Car(pair))->tls_index != SYMBOL_TLS_INDEX_NONE) { - eval(Cdr(pair)); /* maygc */ - pair=Car(*initial_bindings); - Symbol_thread_value(Car(pair)) = value1; - } - } - *initial_bindings = Cdr(*initial_bindings); - } - } - /* to be on the safe side - always set *defer-interrupts* to nil and - *deferred-interrupts* to empty list - user may pass bad initial bindings*/ - Symbol_thread_value(S(defer_interrupts)) = NIL; - Symbol_thread_value(S(deferred_interrupts)) = NIL; + /* initialize thread special varaible bindings */ + initialize_thread_bindings(initial_bindings); funcall(*funptr,0); /* call fun */ reset(0); /* unwind what we have till now */ } @@ -256,13 +269,17 @@ /* check initial bindings */ if (!boundp(STACK_0)) /* if not bound set to mt:*default-special-bidnings* */ STACK_0 = Symbol_value(S(default_special_bindings)); + /* check that the list is proper one */ STACK_0 = check_list(STACK_0); + var object tail = NIL; + var object len = list_length(STACK_0, &tail); + if (!nullp(tail)) error_proper_list_dotted(S(make_thread),tail); + if (nullp(len)) error_proper_list_circular(S(make_thread),STACK_0); /* check the function object has been passed*/ if (!functionp(STACK_2)) STACK_2 = check_function_replacement(STACK_2); /* set thread name */ STACK_1 = check_name_arg(STACK_1,Closure_name(STACK_2)); - /* do allocations before thread locking */ pushSTACK(allocate_thread(&STACK_1)); /* put it in GC visible place */ pushSTACK(allocate_cons()); Index: ChangeLog =================================================================== RCS file: /cvsroot/clisp/clisp/src/ChangeLog,v retrieving revision 1.7189 retrieving revision 1.7190 diff -u -d -r1.7189 -r1.7190 --- ChangeLog 2 Nov 2009 02:56:44 -0000 1.7189 +++ ChangeLog 3 Nov 2009 21:10:31 -0000 1.7190 @@ -1,3 +1,18 @@ +2009-11-03 Vladimir Tzankov <vtzankov@...> + + [MULTITHREAD]: create dynamic bindings for all special variables + * zthread.d (initialize_thread_bindings): initializes symbols per + thread value cells during thread creation + (thread_stub): use it + (MAKE-THREAD): check that :initial-bindings is proper list + * lispbibl.d (initialize_thread_bindings): declare as global + * spvw.d (mt_main_actions): use it + * control.d (make_variable_frame): allocate per thread value cells + for locally declared special variables (if needed) + * eval.d (progv, cod_bind): ditto + * threads.lisp (*DEFAULT-SPECIAL-BINDINGS*): initialize per thread + bindings with global symbol values + 2009-11-01 Sam Steingold <sds@...> * compiler.lisp (c-cerror): extract predefun from ... Index: eval.d =================================================================== RCS file: /cvsroot/clisp/clisp/src/eval.d,v retrieving revision 1.274 retrieving revision 1.275 diff -u -d -r1.274 -r1.275 --- eval.d 3 Nov 2009 16:20:52 -0000 1.274 +++ eval.d 3 Nov 2009 21:10:31 -0000 1.275 @@ -614,6 +614,12 @@ } Car(STACK_0) = sym; } + #ifdef MULTITHREAD + /* allocate per thread value cell for the symbol if it does not have */ + if (TheSymbol(sym)->tls_index == SYMBOL_TLS_INDEX_NONE) { + add_per_thread_special_var(sym); + } + #endif } skipSTACK(1); vallist = popSTACK(); symlist = popSTACK(); /* demand room on STACK: */ @@ -6422,6 +6428,15 @@ CASE cod_bind: { /* (BIND n) */ var uintL n; U_operand(n); + #if defined(MULTITHREAD) + var Symbol sym=TheSymbol(TheCclosure(closure)->clos_consts[n]); + if (sym->tls_index == SYMBOL_TLS_INDEX_NONE) { + var uintC mvc = mv_count; + mv_to_STACK(); /* save mv_space */ + with_saved_context({add_per_thread_special_var(sym); /* maygc */}); + STACK_to_mv(mvc); /* restore mv_space */ + } + #endif dynamic_bind(TheCclosure(closure)->clos_consts[n],value1); } goto next_byte; CASE cod_unbind1: /* (UNBIND1) */ Index: threads.lisp =================================================================== RCS file: /cvsroot/clisp/clisp/src/threads.lisp,v retrieving revision 1.22 retrieving revision 1.23 diff -u -d -r1.22 -r1.23 --- threads.lisp 13 Jul 2009 20:21:07 -0000 1.22 +++ threads.lisp 3 Nov 2009 21:10:31 -0000 1.23 @@ -35,26 +35,24 @@ (defvar *defer-interrupts* nil) (defvar *deferred-interrupts* '()) ; list of pending interrupts -;; TODO: add more variables (something should done about the -;; standartd input/output streams. +;; TODO: add more variables (something should be done about the +;; standartd input/output streams). (defvar *DEFAULT-SPECIAL-BINDINGS* - '((*random-state* . (make-random-state t)) - (*defer-interrupts* . nil) - (*deferred-interrupts* . nil) - (*gensym-counter* . 0) - (ext::*command-index* . 0) - (*print-base* . 10) - (*print-length* . nil) - (*print-level* . nil) - (*print-circle* . nil) - (*print-radix* . nil) - (*print-case* . :upcase) - (*print-gensym* . t) - (*print-pretty* . t) - (*print-readably* . nil) - (*read-suppress* . nil) - (*read-default-float-format* . 'single-float) - (*readtable* . (copy-readtable nil)))) + '((*random-state* . *random-state*) + (*gensym-counter* . *gensym-counter*) + (ext::*command-index* . ext::*command-index*) + (*print-base* . *print-base*) + (*print-length* . *print-length*) + (*print-level* . *print-level*) + (*print-circle* . *print-circle*) + (*print-radix* . *print-radix*) + (*print-case* . *print-case*) + (*print-gensym* . *print-gensym*) + (*print-pretty* . *print-pretty*) + (*print-readably* . *print-readably*) + (*read-suppress* . *read-suppress*) + (*read-default-float-format* . *read-default-float-format*) + (*readtable* . (copy-readtable)))) (defmacro with-deferred-interrupts (&body body) `(let ((*defer-interrupts* t) Index: spvw.d =================================================================== RCS file: /cvsroot/clisp/clisp/src/spvw.d,v retrieving revision 1.516 retrieving revision 1.517 diff -u -d -r1.516 -r1.517 --- spvw.d 25 Oct 2009 13:51:35 -0000 1.516 +++ spvw.d 3 Nov 2009 21:10:31 -0000 1.517 @@ -3662,9 +3662,10 @@ me->_SP_anchor=(void*)SP(); /* reinitialize the system thread id */ TheThread(me->_lthread)->xth_system = xthread_self(); - /* initialize deferred interrupts */ - Symbol_thread_value(S(defer_interrupts)) = NIL; - Symbol_thread_value(S(deferred_interrupts)) = NIL; + /* initialize thread special varaible bindings */ + pushSTACK(Symbol_value(S(default_special_bindings))); + initialize_thread_bindings(&STACK_0); + skipSTACK(1); /* now we are ready to start main_actions()*/ main_actions(args); thread_cleanup(); @@ -4116,7 +4117,8 @@ end_system_call(); #if defined(HAVE_DLERROR) var char * e = dlerror(); - return e == NULL ? O(unknown_error) : asciz_to_string(e,O(misc_encoding)); + /* g++ needs explicit cast here */ + return e == NULL ? (object)O(unknown_error) : asciz_to_string(e,O(misc_encoding)); #elif defined(WIN32_NATIVE) var char* buf; /* note that this message is likely to be less informative Index: control.d =================================================================== RCS file: /cvsroot/clisp/clisp/src/control.d,v retrieving revision 1.168 retrieving revision 1.169 diff -u -d -r1.168 -r1.169 --- control.d 25 Oct 2009 13:44:54 -0000 1.168 +++ control.d 3 Nov 2009 21:10:31 -0000 1.169 @@ -480,6 +480,22 @@ /* store special-declared symbol in stack: */ pushSTACK(specdecl); /* SPECDECL as "value" */ pushSTACK_symbolwithflags(declsym,0); /* Symbol inactive */ + #if defined(MULTITHREAD) + /* this is locally declared special variable. make it per thread + if not already.*/ + if (TheSymbol(declsym)->tls_index == SYMBOL_TLS_INDEX_NONE) { + /* this call is may gc now */ + pushSTACK(value1); pushSTACK(value2); /* save */ + pushSTACK(caller); pushSTACK(varspecs); /* save */ + pushSTACK(declarations); pushSTACK(declspecs); /* save */ + pushSTACK(declspec); /* save */ + add_per_thread_special_var(declsym); + declspec = popSTACK(); + declspecs = popSTACK(); declarations = popSTACK(); /* restore */ + varspecs = popSTACK(); caller = popSTACK(); /* restore */ + value2 = popSTACK(); value1 = popSTACK(); /* restore */ + } + #endif check_STACK(); spec_count++; } Index: lispbibl.d =================================================================== RCS file: /cvsroot/clisp/clisp/src/lispbibl.d,v retrieving revision 1.896 retrieving revision 1.897 diff -u -d -r1.896 -r1.897 --- lispbibl.d 20 Oct 2009 20:44:24 -0000 1.896 +++ lispbibl.d 3 Nov 2009 21:10:31 -0000 1.897 @@ -17436,6 +17436,9 @@ global void lock_threads (void); /* unlocks global thread array */ global void unlock_threads (void); +/* UP: creates initial bindings in thread context from alist + > initial_bindings: alist of (symbol . form) elements */ +global void initialize_thread_bindings(gcv_object_t *initial_bindings); /* UP: Suspends all running threads /besides the current/ at GC safe points/regions. > lock_heap: if false - the caller already owns the heap lock ------------------------------ ------------------------------------------------------------------------------ Let Crystal Reports handle the reporting - Free Crystal Reports 2008 30-Day trial. Simplify your report design, integration and deployment - and focus on what you do best, core application coding. Discover what's new with Crystal Reports now. http://p.sf.net/sfu/bobj-july ------------------------------ _______________________________________________ clisp-cvs mailing list clisp-cvs@... https://lists.sourceforge.net/lists/listinfo/clisp-cvs End of clisp-cvs Digest, Vol 43, Issue 4 **************************************** ------------------------------------------------------------------------------ Let Crystal Reports handle the reporting - Free Crystal Reports 2008 30-Day trial. Simplify your report design, integration and deployment - and focus on what you do best, core application coding. Discover what's new with Crystal Reports now. http://p.sf.net/sfu/bobj-july _______________________________________________ clisp-devel mailing list clisp-devel@... https://lists.sourceforge.net/lists/listinfo/clisp-devel |
| Free embeddable forum powered by Nabble | Forum Help |
