Menu
▾
▴
clisp-cvs Digest, Vol 55, Issue 6
|
From: <cli...@li...> - 2010-12-15 01:09:37
|
Send clisp-cvs mailing list submissions to cli...@li... 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 cli...@li... You can reach the person managing the list at cli...@li... 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 ChangeLog, 1.7575, 1.7576 constobj.d, 1.222, 1.223 constsym.d, 1.396, 1.397 defs1.lisp, 1.80, 1.81 lispbibl.d, 1.916, 1.917 spvw.d, 1.543, 1.544 subr.d, 1.279, 1.280 symbol.d, 1.45, 1.46 threads.lisp, 1.25, 1.26 (Vladimir Tzankov) ---------------------------------------------------------------------- Message: 1 Date: Sun, 14 Nov 2010 16:02:43 +0000 From: Vladimir Tzankov <vt...@us...> Subject: clisp/src ChangeLog, 1.7575, 1.7576 constobj.d, 1.222, 1.223 constsym.d, 1.396, 1.397 defs1.lisp, 1.80, 1.81 lispbibl.d, 1.916, 1.917 spvw.d, 1.543, 1.544 subr.d, 1.279, 1.280 symbol.d, 1.45, 1.46 threads.lisp, 1.25, 1.26 To: cli...@li... Message-ID: <E1P...@sf...> Update of /cvsroot/clisp/clisp/src In directory sfp-cvsdas-2.v30.ch3.sourceforge.com:/tmp/cvs-serv4740/src Modified Files: ChangeLog constobj.d constsym.d defs1.lisp lispbibl.d spvw.d subr.d symbol.d threads.lisp Log Message: [MULTITHREAD]: thread safe GENSYM and GENTEMP Index: ChangeLog =================================================================== RCS file: /cvsroot/clisp/clisp/src/ChangeLog,v retrieving revision 1.7575 retrieving revision 1.7576 diff -u -d -r1.7575 -r1.7576 --- ChangeLog 8 Nov 2010 16:59:24 -0000 1.7575 +++ ChangeLog 14 Nov 2010 16:02:40 -0000 1.7576 @@ -1,3 +1,17 @@ +2010-11-14 Vladimir Tzankov <vtz...@gm...> + + [MULTITHREAD]: thread safe GENSYM and GENTEMP + * lispbibl.d (gensym_lock, gentemp_lock): add locks guarding gensym and + gentemp counters + * spvw.d (init_multithread): initialize gensym_lock and gentemp_lock + * defs1.lisp (GENTEMP): remove. implemented in C + * subr.d, constsym.d: add GENTEMP to subr and symbol tables + * constobj.d: add gentemp prefix and counter to object table + * threads.lisp (*DEFAULT-SPECIAL-BINDINGS*): remove *gensym-counter* + * symbol.d: define gensym_lock, gentemp_lock + (GENSYM): re-implement. lock *gensym-counter* increment + (GENTEMP): implement in C + 2010-11-08 Sam Steingold <sd...@gn...> * modules/rawsock/rawsock.c (check_sockopt_name): add Index: subr.d =================================================================== RCS file: /cvsroot/clisp/clisp/src/subr.d,v retrieving revision 1.279 retrieving revision 1.280 diff -u -d -r1.279 -r1.280 --- subr.d 30 Oct 2010 21:02:59 -0000 1.279 +++ subr.d 14 Nov 2010 16:02:41 -0000 1.280 @@ -1274,6 +1274,7 @@ LISPFUNNR(cs_symbol_name,1) LISPFUNNR(keywordp,1) LISPFUN(gensym,seclass_read,0,1,norest,nokey,0,NIL) +LISPFUN(gentemp,seclass_read,0,2,norest,nokey,0,NIL) /* ---------- LISPARIT ---------- */ LISPFUN(decimal_string,seclass_no_se,1,0,norest,nokey,0,NIL) LISPFUNNF(zerop,1) Index: constsym.d =================================================================== RCS file: /cvsroot/clisp/clisp/src/constsym.d,v retrieving revision 1.396 retrieving revision 1.397 diff -u -d -r1.396 -r1.397 --- constsym.d 15 Feb 2010 20:44:45 -0000 1.396 +++ constsym.d 14 Nov 2010 16:02:41 -0000 1.397 @@ -1056,6 +1056,7 @@ LISPSYM(keywordp,"KEYWORDP",lisp) LISPSYM(special_variable_p,"SPECIAL-VARIABLE-P",ext) LISPSYM(gensym,"GENSYM",lisp) +LISPSYM(gentemp,"GENTEMP",lisp) LISPSYM(plist,"PLIST",system) /* type in type.lisp */ /* ---------- LISPARIT ---------- */ LISPSYM(decimal_string,"DECIMAL-STRING",system) Index: defs1.lisp =================================================================== RCS file: /cvsroot/clisp/clisp/src/defs1.lisp,v retrieving revision 1.80 retrieving revision 1.81 diff -u -d -r1.80 -r1.81 --- defs1.lisp 18 Aug 2010 22:49:27 -0000 1.80 +++ defs1.lisp 14 Nov 2010 16:02:41 -0000 1.81 @@ -34,18 +34,6 @@ ) sym)) -(let ((gentemp-count 0)) ;; Common LISP, p. 170 - (defun gentemp (&optional (prefix "T") (package *package*)) - (loop - (setq gentemp-count (1+ gentemp-count)) - (multiple-value-bind (sym flag) - (intern - (string-concat prefix - (write-to-string gentemp-count :base 10 :radix nil :readably nil)) - package) - (unless flag (return sym)))))) - - ;;; macros for packages (Chapter 11), p. 187-188 (defmacro do-symbols ((var &optional (packageform '*package*) (resultform nil)) &body body) Index: symbol.d =================================================================== RCS file: /cvsroot/clisp/clisp/src/symbol.d,v retrieving revision 1.45 retrieving revision 1.46 diff -u -d -r1.45 -r1.46 --- symbol.d 8 Oct 2009 14:57:29 -0000 1.45 +++ symbol.d 14 Nov 2010 16:02:41 -0000 1.46 @@ -314,56 +314,70 @@ VALUES_IF(symbolp(obj) && keywordp(obj)); } +#ifdef MULTITHREAD +global xmutex_t gensym_lock; /* global GENSYM counter lock */ +global xmutex_t gentemp_lock; /* global GETEMP counter lock */ +#endif + LISPFUN(gensym,seclass_read,0,1,norest,nokey,0,NIL) -{ /* (GENSYM x), CLTL S. 169, CLtL2 S. 245-246 - (defun gensym (&optional (x nil s)) - (let ((prefix "G") ; a String - (counter *gensym-counter*)) ; an integer >=0 - (when s - (cond ((stringp x) (setq prefix x)) - ((integerp x) - (if (minusp x) - (error-of-type 'type-error - :datum x :expected-type '(INTEGER 0 *) - (ENGLISH "~S: index ~S is negative") - 'gensym x) - (setq counter x))) - (t (error-of-type 'type-error - :datum x :expected-type '(OR STRING INTEGER) - (ENGLISH "~S: invalid argument ~S") - 'gensym x)))) - (prog1 - (make-symbol - (string-concat - prefix - #-CLISP (write-to-string counter :base 10 :radix nil) - #+CLISP (sys::decimal-string counter))) - (unless (integerp x) (setq *gensym-counter* (1+ counter)))))) */ - var object prefix = O(gensym_prefix); /* "G" */ - var object counter = Symbol_value(S(gensym_counter)); /* *GENSYM-COUNTER* */ - var object x = popSTACK(); /* Argument */ - if (boundp(x)) { /* x supplied */ - if (stringp(x)) { - prefix = x; /* set prefix */ - } else if (integerp(x)) { - counter = x = check_pos_integer(x); /* set counter to an integer >=0 */ - prefix = O(gensym_prefix); /* reset: invalidated by GC */ - } else error_string_integer(x); +{ /* (GENSYM x), CLTL S. 169, CLtL2 S. 245-246 */ + if (!boundp(STACK_0)) { + STACK_0 = O(gensym_prefix); /* set default prefix */ + goto string_arg_supplied; /* skip next "if (stringp(STACK_0))" */ } - /* construct string: */ - pushSTACK(prefix); /* 1st part of string */ - pushSTACK(counter); /* counter */ - if (!integerp(x)) { - if (!(integerp(counter) && !R_minusp(counter))) { /* integer >= 0 */ - var object new_value = Symbol_value(S(gensym_counter)) = Fixnum_0; /* reset *GENSYM-COUNTER* */ + if (stringp(STACK_0)) { /* have string - use *gensym-counter* */ + string_arg_supplied: + /* with MT if *gensym-counter* is bound in calling thread there is no need + to lock. however this should be extremely rare case and checking for + it will eat more cycles overall */ + var bool was_negative; + WITH_OS_MUTEX_LOCK(0, &gensym_lock, { + pushSTACK(Symbol_value(S(gensym_counter))); + if (!(was_negative = R_minusp(STACK_0))) { + Symbol_value(S(gensym_counter)) = I_1_plus_I(STACK_0); + } else { + Symbol_value(S(gensym_counter)) = Fixnum_0;/* reset *GENSYM-COUNTER* */ + } + value1 = popSTACK(); + }); + if (was_negative) { /* complain about negative *GENSYM-COUNTER* */ + var object counter = value1; pushSTACK(counter); /* TYPE-ERROR slot DATUM */ pushSTACK(O(type_posinteger)); /* TYPE-ERROR slot EXPECTED-TYPE */ - pushSTACK(new_value); pushSTACK(counter); + pushSTACK(Fixnum_0); pushSTACK(counter); error(type_error,GETTEXT("The value of *GENSYM-COUNTER* was not a nonnegative integer. Old value ~S. New value ~S.")); } - Symbol_value(S(gensym_counter)) = I_1_plus_I(counter); /* (incf *GENSYM-COUNTER*) */ - } + pushSTACK(value1); /* counter */ + } else if (integerp(STACK_0)) { /* counter available */ + var object counter = check_pos_integer(popSTACK());/* ensure positive */ + pushSTACK(O(gensym_prefix)); pushSTACK(counter); + } else /* argument with incorrect type */ + error_string_integer(popSTACK()); + /* STACK layout: STACK_0 = counter, STACK_1 = prefix */ funcall(L(decimal_string),1); /* (sys::decimal-string counter) */ pushSTACK(value1); /* 2nd part of string */ VALUES1(make_symbol(coerce_imm_ss(string_concat(2)))); } + +LISPFUN(gentemp,seclass_read,0,2,norest,nokey,0,NIL) +{ /* (GENTEMP prefix package), CLTL p. 170 */ + var gcv_object_t *prefix = &STACK_1; + var gcv_object_t *package = &STACK_0; + /* validate prefix */ + *prefix = (boundp(*prefix) ? check_string(*prefix) : O(gentemp_prefix)); + /* do not validate package argument - intern will barf anyway */ + do { + WITH_OS_MUTEX_LOCK(0, &gentemp_lock, { + value1 = O(gentemp_counter) = I_1_plus_I(O(gentemp_counter)); + }); + pushSTACK(*prefix); /* 1st part of string */ + pushSTACK(value1); /* counter */ + funcall(L(decimal_string),1); /* (sys::decimal-string counter) */ + pushSTACK(value1); /* 2nd part of string */ + pushSTACK(coerce_imm_ss(string_concat(2))); /* concatenate */ + pushSTACK(*package); + funcall(L(intern),2); /* try to intern */ + } while (!nullp(value2)); + skipSTACK(2); + mv_count = 1; /* single value */ +} Index: threads.lisp =================================================================== RCS file: /cvsroot/clisp/clisp/src/threads.lisp,v retrieving revision 1.25 retrieving revision 1.26 diff -u -d -r1.25 -r1.26 --- threads.lisp 23 Feb 2010 17:39:42 -0000 1.25 +++ threads.lisp 14 Nov 2010 16:02:41 -0000 1.26 @@ -39,7 +39,6 @@ ;; standartd input/output streams). (defvar *DEFAULT-SPECIAL-BINDINGS* '((*random-state* . *random-state*) - (*gensym-counter* . *gensym-counter*) (ext::*command-index* . ext::*command-index*) (*print-base* . *print-base*) (*print-length* . *print-length*) Index: spvw.d =================================================================== RCS file: /cvsroot/clisp/clisp/src/spvw.d,v retrieving revision 1.543 retrieving revision 1.544 diff -u -d -r1.543 -r1.544 --- spvw.d 21 Oct 2010 18:42:17 -0000 1.543 +++ spvw.d 14 Nov 2010 16:02:41 -0000 1.544 @@ -552,6 +552,8 @@ xmutex_init(&all_exemptions_lock); /* O(all_exemptions) lock */ xmutex_init(&all_weakpointers_lock); /* O(all_weakpointers) lock */ xmutex_init(&all_packages_lock); /* O(all_packages) lock */ + xmutex_init(&gensym_lock); /* GENSYM lock */ + xmutex_init(&gentemp_lock); /* internal GENTEMP counter lock */ initialize_circ_detection(); /* initialize the circ detection */ spinlock_init(&timeout_call_chain_lock); Index: constobj.d =================================================================== RCS file: /cvsroot/clisp/clisp/src/constobj.d,v retrieving revision 1.222 retrieving revision 1.223 diff -u -d -r1.222 -r1.223 --- constobj.d 6 Aug 2010 19:08:49 -0000 1.222 +++ constobj.d 14 Nov 2010 16:02:41 -0000 1.223 @@ -322,7 +322,9 @@ /* default-package for -modern: */ LISPOBJ(modern_user_package,".") /* for SYMBOL.D: */ - LISPOBJ(gensym_prefix,"\"G\"") /* prefix for gensym, a string */ + LISPOBJ_S(gensym_prefix,"G") /* prefix for gensym */ + LISPOBJ_S(gentemp_prefix, "T") /* prefix for gentemp */ + LISPOBJ(gentemp_counter, "0") /* gentemp internal counter */ /* for MISC.D: basic knowledge: */ LISPOBJ_S(lisp_implementation_type_string,"CLISP") @@ -720,7 +722,6 @@ LISPOBJ(foreign_callin_table,"#.(make-hash-table :test #'eq)") LISPOBJ(foreign_callin_vector,"#.(let ((array (make-array 1 :adjustable t :fill-pointer 1))) (sys::store array 0 0) array)") #endif - #if !defined(MULTITHREAD) #define LISPOBJ_TL(n,initstring) LISPOBJ(n,initstring) #include "constobj_tl.c" Index: lispbibl.d =================================================================== RCS file: /cvsroot/clisp/clisp/src/lispbibl.d,v retrieving revision 1.916 retrieving revision 1.917 diff -u -d -r1.916 -r1.917 --- lispbibl.d 21 Oct 2010 18:42:17 -0000 1.916 +++ lispbibl.d 14 Nov 2010 16:02:41 -0000 1.917 @@ -17106,7 +17106,7 @@ /* helper macro for locking mutex that allows GC and thread interrupts while waiting. To be used only here and in zthread.d. In all other places WITH_OS_MUTEX_LOCK() should be used since it guarantees correct unlocking - in case of non-local exit and thread interruption + in case of non-local exit and thread interrupt > mutex: mutex to lock > locked: pointer to bool filled with true in case the lock has been acquired (before handling of pending interrupts) */ @@ -17496,8 +17496,13 @@ /* mutex for guarding access to O(all_packages) */ extern xmutex_t all_packages_lock; /* mutex protecting the O(all_threads) and list of clisp_thread_t structs - NB: when it is hold heap allocation will cause deadlock */ + NB: when it is hold - any heap allocation will cause deadlock */ extern xmutex_t allthreads_lock; +/* mutex serializing gensym (only when *gensym-counter* is not + per thread bound) */ +extern xmutex_t gensym_lock; +/* mutex guarding internal counter used by gentemp */ +extern xmutex_t gentemp_lock; /* operations on a lisp stack that is not the current one (NC) - ie. belongs to other not yet started threads */ ------------------------------ ------------------------------------------------------------------------------ Centralized Desktop Delivery: Dell and VMware Reference Architecture Simplifying enterprise desktop deployment and management using Dell EqualLogic storage and VMware View: A highly scalable, end-to-end client virtualization framework. Read more! http://p.sf.net/sfu/dell-eql-dev2dev ------------------------------ _______________________________________________ clisp-cvs mailing list cli...@li... https://lists.sourceforge.net/lists/listinfo/clisp-cvs End of clisp-cvs Digest, Vol 55, Issue 6 **************************************** |
