Menu
▾
▴
clisp-cvs Digest, Vol 40, Issue 36
|
From: <cli...@li...> - 2009-08-16 20:21:32
|
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.7049,1.7050 package.d,1.119,1.120 (Vladimir Tzankov) 2. clisp/modules/queens Makefile,1.12,1.13 (Sam Steingold) 3. clisp/modules/bindings/win32 Makefile,1.9,1.10 (Sam Steingold) 4. clisp/modules/clx/mit-clx Makefile,1.7,1.8 (Sam Steingold) 5. clisp/modules/gdbm Makefile.in,1.6,1.7 (Sam Steingold) ---------------------------------------------------------------------- Message: 1 Date: Sun, 16 Aug 2009 17:08:51 +0000 From: Vladimir Tzankov <vt...@us...> Subject: clisp/src ChangeLog,1.7049,1.7050 package.d,1.119,1.120 To: cli...@li... Message-ID: <E1M...@dd...> Update of /cvsroot/clisp/clisp/src In directory ddv4jf1.ch3.sourceforge.com:/tmp/cvs-serv16109/src Modified Files: ChangeLog package.d Log Message: [MULTITHREAD]: make packages threads safe Index: ChangeLog =================================================================== RCS file: /cvsroot/clisp/clisp/src/ChangeLog,v retrieving revision 1.7049 retrieving revision 1.7050 diff -u -d -r1.7049 -r1.7050 --- ChangeLog 13 Aug 2009 23:38:59 -0000 1.7049 +++ ChangeLog 16 Aug 2009 17:08:48 -0000 1.7050 @@ -1,3 +1,22 @@ +2009-08-16 Vladimir Tzankov <vtz...@gm...> + + [MULTITHREAD]: make packages threads safe + * package.d (rehash_symtab): do not reuse old cons cell. allocate new + symtab + (make_present, unexport, make_external): assign returned symtab - + possibly newly allocated + (unuse_1package): do not lock anything. caller should have obtained + both package mutexes + (unuse_package): obtain package locks before calling unuse_1package + (USE-PACKAGE, UNUSE-PACKAGE): obtain global packages lock since more + than one package mutex will be locked at a time + (%IN-PACKAGE): lock while modifying existing packages + (DELETE-PACKAGE): lock existing package during unuse_1package + (WITH_PACKAGE_LIST_MUTEX_LOCK): macro for obtaining all mutexes + of a list of packages. on unwinding releases them + (use_package): use it + (make_package): guard insertion into all_packages + 2009-08-13 Sam Steingold <sd...@gn...> * makemake.in (lisp${SHREXT}) [dynamic_modules]: new target Index: package.d =================================================================== RCS file: /cvsroot/clisp/clisp/src/package.d,v retrieving revision 1.119 retrieving revision 1.120 diff -u -d -r1.119 -r1.120 --- package.d 23 Dec 2008 00:43:51 -0000 1.119 +++ package.d 16 Aug 2009 17:08:48 -0000 1.120 @@ -17,26 +17,20 @@ There is global mutex for O(all_packages) and per package recursive lisp mutex. If both of them should be obtained (for any package) - the order O(all_packages_lock) --> package lock should be preserved. Otherwise deadlocks -are possible. - -Partially implemented. -Some high level locking of changes in the package structures. -(USE-PACKAGE is not safe) - -Still not implemented (TODO): -In order to avoid locking on simple lookups (most common case - but other -as well) - we will try to implement the Symtabs via lock free hashtables. -We will need atomic CAS op for gcv_object_t objects (not clear whether always -possible). -Probably the same will be useful for hashtables (hashtabl.d). +are possible. Also if multiple package locks should be obtained at the same +time - first all_package_lock should be obtained - such cases are use-package, +unuse-package. -Currently the Symtab delete & lookup are not safe (and because of this -the insert as well - regardless that intern() is guarded with mutex. The -latter lock in intern() helps avoid deadlocks however) -all this will not lead to crashes (hopefully) but to some weird behavior. +Symbol lookup and deletion are not guarded but are safe due to the way +symtab_insert and rehash_symtab work. On MT rehash_symtab always returns +newly allocated symtab that does not share nor modifies the old one - thus +any thread that may perform lookups on the old one will not be "surpised" by +modified internals (and intern (e.g. symtab_insert) is guarded by package mutex) +This copy semantic on rehashing is slower than previous cons cell reuse but is +better than obtaining lock on symbol lookup. -TODO: USE-PACKAGE is not protected in any way. -*/ +The use of WITH_xxx macros for locking makes debugging harder but is clean way +to handle stack unwind and release acquired locks.*/ /* data structure of the symbols: see LISPBIBL.D data structure of the symbol table: @@ -152,7 +146,7 @@ TheSvector(STACK_1)->data[index] = sym; /* enter new entry in newtable */ } -local object rehash_symtab (object symtab) { +local maygc object rehash_symtab (object symtab) { pushSTACK(symtab); /* save symbol-table */ var uintL oldsize = posfixnum_to_V(Symtab_size(symtab)); /* old size */ var uintL newsize; /* new size */ @@ -203,8 +197,10 @@ if (consp(oldentry)) /* this time process only non-empty symbol-lists */ do { pushSTACK(Cdr(oldentry)); /* save rest-list */ + #ifndef MULTITHREAD /* no cons cell reuse with MT */ /* cons oldentry in front of free-conses */ Cdr(oldentry) = STACK_2; STACK_2 = oldentry; + #endif /* enter symbol in the new table */ newinsert(Car(oldentry),newsize); oldentry = popSTACK(); /* rest-list */ @@ -229,6 +225,13 @@ } /* stack layout: tab, oldtable, free-conses, newtable. */ { /* update tab: */ + #ifdef MULTITHREAD + /* allocate new symtab. other threads may have obtained pointer to + the old one for lookup - do not modify it */ + var object new_symtab = allocate_vector(3); /* vector of length 3 */ + Symtab_count(new_symtab) = Symtab_count(STACK_3); /* set the count */ + STACK_3 = new_symtab; /* replace symtab on the stack */ + #endif var object newtable = popSTACK(); /* newtable */ skipSTACK(2); symtab = popSTACK(); /* tab */ @@ -508,10 +511,13 @@ ThePackage(STACK_0)->pack_mutex = value1; #endif /* and insert in ALL_PACKAGES: */ - var object new_cons = allocate_cons(); - pack = popSTACK(); - Car(new_cons) = pack; Cdr(new_cons) = O(all_packages); - O(all_packages) = new_cons; + pushSTACK(allocate_cons()); /* new_cons */ + WITH_OS_MUTEX_LOCK(2,&all_packages_lock, { + var object new_cons = popSTACK(); + Car(new_cons) = STACK_0; Cdr(new_cons) = O(all_packages); + O(all_packages) = new_cons; + }); + pack=popSTACK(); /* finished: */ clr_break_sem_2(); return pack; @@ -769,11 +775,14 @@ only call, if BREAK_SEM_2 is set can trigger GC */ local maygc void make_present (object sym, object pack) { + pushSTACK(pack); if (!eq(pack,O(keyword_package))) { if (nullp(Symbol_package(sym))) Symbol_package(sym) = pack; /* Insert symbol into the internal symbols: */ - symtab_insert(sym,ThePackage(pack)->pack_internal_symbols); + var object symtab = + symtab_insert(sym,ThePackage(pack)->pack_internal_symbols); + ThePackage(STACK_0)->pack_internal_symbols = symtab; } else { if (nullp(Symbol_package(sym))) { pushSTACK(pack); /* save */ @@ -783,8 +792,11 @@ set_const_flag(TheSymbol(sym)); /* mark as constant */ } /* Insert symbol into the external symbols: */ - symtab_insert(sym,ThePackage(pack)->pack_external_symbols); + var object symtab = + symtab_insert(sym,ThePackage(pack)->pack_external_symbols); + ThePackage(STACK_0)->pack_external_symbols = symtab; } + skipSTACK(1); } /* UP: Interns a symbol with a given printname in a package. @@ -1194,7 +1206,8 @@ set_break_sem_2(); symtab_delete(sym,symtab); /* remove sym from the external symbols */ /* therefor, insert it into the internal symbols */ - symtab_insert(sym,ThePackage(pack)->pack_internal_symbols); + symtab = symtab_insert(sym,ThePackage(pack)->pack_internal_symbols); + ThePackage(*pack_)->pack_internal_symbols = symtab; clr_break_sem_2(); } else { /* Search, if the symbol is accessible at all. */ @@ -1224,7 +1237,11 @@ /* remove sym from the internal symbols */ symtab_delete(sym,ThePackage(pack)->pack_internal_symbols); /* therefor, insert it into the external symbols */ - symtab_insert(sym,ThePackage(pack)->pack_external_symbols); + pushSTACK(pack); + var object symtab = + symtab_insert(sym,ThePackage(pack)->pack_external_symbols); + pack = popSTACK(); + ThePackage(pack)->pack_external_symbols = symtab; clr_break_sem_2(); } @@ -1435,6 +1452,37 @@ skipSTACK(1); } +/* define macro for locking mutexes of list of packages */ +#ifdef MULTITHREAD + #define PACKAGE_LIST_MUTEX_LOCK_HELP_(packlist_) do { \ + pushSTACK(*packlist_); \ + while (mconsp(STACK_0)) { \ + pushSTACK(ThePackage(Car(STACK_0))->pack_mutex); \ + funcall(L(mutex_lock),1); \ + STACK_0 = Cdr(STACK_0); \ + } \ + skipSTACK(1); \ + } while(0) + #define PACKAGE_LIST_MUTEX_UNLOCK_HELP_(packlist_,keep_mv_space) \ + do { \ + var uintC cnt=mv_count; \ + if (keep_mv_space) mv_to_STACK(); \ + pushSTACK(*packlist_); \ + while (mconsp(STACK_0)) { \ + pushSTACK(ThePackage(Car(STACK_0))->pack_mutex); \ + funcall(L(mutex_unlock),1); \ + STACK_0 = Cdr(STACK_0); \ + } \ + skipSTACK(1); \ + if (keep_mv_space) STACK_to_mv(cnt); \ + } while(0) + /* packlist_ should be pointer to GC safe location. */ + #define WITH_PACKAGE_LIST_MUTEX_LOCK(stack_count,keep_mv_space,packlist_,body) \ + WITH_MUTEX_LOCK_HELP_(stack_count,keep_mv_space,packlist_,PACKAGE_LIST_MUTEX_LOCK_HELP_,PACKAGE_LIST_MUTEX_UNLOCK_HELP_,body) +#else /* no MT */ + #define WITH_PACKAGE_LIST_MUTEX_LOCK(stack_count,keep_mv_space,packlist_,body) body +#endif + /* UP: Effectuates, that all external symbols of a given list of packages become implicitly accessible in a given package. use_package(packlist,pack); @@ -1481,119 +1529,125 @@ if (true) { /* do not discard, advance: */ packlistr_ = &Cdr(packlistr); packlistr = *packlistr_; } else { /* discard (car packlistr) : */ - delete_pack_to_test: + delete_pack_to_test: packlistr = *packlistr_ = Cdr(packlistr); } } } - /* build conflict list. - A conflict is an at least two-element list - of symbols of the same printname, together with the package, - from which this symbol is taken: - ((pack1 . sym1) ...) means, that on execution of the USE-PACKAGE - the symbole sym1,... (from pack1 etc.) would compete for - the visibility in package pack. - The conflict list is the list of all occurring conflicts. */ - { - var gcv_object_t *pack_ = &STACK_1; - var gcv_object_t *packlist_ = &STACK_0; - var gcv_object_t *conflicts_, *conflict_resolver_; - pushSTACK(NIL); /* (so far empty) conflict list */ - conflicts_ = &STACK_0; - /* stack-layout: pack, packlist, conflicts. */ - { /* peruse package list: */ - pushSTACK(*packlist_); - while (mconsp(STACK_0)) { - var object pack_to_use = Car(STACK_0); - STACK_0 = Cdr(STACK_0); - /* apply use_package_aux to all external symbols of pack_to_use: */ - map_symtab_c(&use_package_aux,conflicts_, - ThePackage(pack_to_use)->pack_external_symbols); - } - skipSTACK(1); - } - { /* reconstruct conflict list: Each conflict ((pack1 . sym1) ...) is - transformed into ((packname1 pack1 . sym1) ...). */ - pushSTACK(*conflicts_); /* traverse conflict list */ - while (mconsp(STACK_0)) { - var object conflict = Car(STACK_0); - STACK_0 = Cdr(STACK_0); - pushSTACK(conflict); /* process conflict */ + var gcv_object_t *packlist_lock_ = &STACK_0; + var gcv_object_t *pack_lock_ = &STACK_1; + WITH_PACKAGE_LIST_MUTEX_LOCK(2,false,packlist_lock_, { + /* build conflict list. + A conflict is an at least two-element list + of symbols of the same printname, together with the package, + from which this symbol is taken: + ((pack1 . sym1) ...) means, that on execution of the USE-PACKAGE + the symbole sym1,... (from pack1 etc.) would compete for + the visibility in package pack. + The conflict list is the list of all occurring conflicts. */ + { + var gcv_object_t *pack_ = &STACK_1; + var gcv_object_t *packlist_ = &STACK_0; + var gcv_object_t *conflicts_; + var gcv_object_t *conflict_resolver_; + pushSTACK(NIL); /* (so far empty) conflict list */ + conflicts_ = &STACK_0; + /* stack-layout: pack, packlist, conflicts. */ + { /* peruse package list: */ + pushSTACK(*packlist_); while (mconsp(STACK_0)) { - var object new_cons = allocate_cons(); /* new cons */ - var object old_cons = Car(STACK_0); /* (pack . sym) */ - /* replace pack by its name */ - Car(new_cons) = ThePackage(Car(old_cons))->pack_name; - /* insert new-cons */ - Cdr(new_cons) = old_cons; Car(STACK_0) = new_cons; + var object pack_to_use = Car(STACK_0); STACK_0 = Cdr(STACK_0); + /* apply use_package_aux to all external symbols of pack_to_use: */ + map_symtab_c(&use_package_aux,conflicts_, + ThePackage(pack_to_use)->pack_external_symbols); } skipSTACK(1); } - skipSTACK(1); - } - /* conflict-list finished. */ - pushSTACK(NIL); /* conflict-resolver := NIL */ - conflict_resolver_ = &STACK_0; - /* stack-layout: pack, packlist, conflicts, conflict-resolver. */ - /* treat conflicts with user-queries: */ - while (!nullp(*conflicts_)) { /* only necessary for conflicts/=NIL */ - /* raise correctable error: */ - pushSTACK(Car(*conflicts_)); /* OPTIONS */ - pushSTACK(*pack_); /* PACKAGE-ERROR slot PACKAGE */ - pushSTACK(*pack_); - pushSTACK(Symbol_name(Cdr(Cdr(Car(Car(*conflicts_)))))); /* name */ - pushSTACK(fixnum(llength(*conflicts_))); /* (length conflicts) */ - pushSTACK(*pack_); pushSTACK(*packlist_); pushSTACK(S(use_package)); - correctable_error(package_error,GETTEXT("(~S ~S ~S): ~S name conflicts remain\nWhich symbol with name ~S should be accessible in ~S?")); - pushSTACK(value1); /* sym */ - { - var object new_cons = allocate_cons(); - Car(new_cons) = popSTACK(); /* sym */ - Cdr(new_cons) = *conflict_resolver_; - /* conflict-resolver := (cons sym conflict-resolver) */ - *conflict_resolver_ = new_cons; - } - *conflicts_ = Cdr(*conflicts_); - } - /* stack-layout: pack, packlist, conflicts, conflict-resolver. */ - { /* resolve conflicts: */ - set_break_sem_3(); - /* traverse conflict-resolver: */ - while (mconsp(STACK_0)) { - pushSTACK(Car(STACK_0)); /* symbol from conflict-resolver */ - /* make it into a shadowing-symbol in pack */ - shadowing_import(&STACK_0,&STACK_4); + { /* reconstruct conflict list: Each conflict ((pack1 . sym1) ...) is + transformed into ((packname1 pack1 . sym1) ...). */ + pushSTACK(*conflicts_); /* traverse conflict list */ + while (mconsp(STACK_0)) { + var object conflict = Car(STACK_0); + STACK_0 = Cdr(STACK_0); + pushSTACK(conflict); /* process conflict */ + while (mconsp(STACK_0)) { + var object new_cons = allocate_cons(); /* new cons */ + var object old_cons = Car(STACK_0); /* (pack . sym) */ + /* replace pack by its name */ + Car(new_cons) = ThePackage(Car(old_cons))->pack_name; + /* insert new-cons */ + Cdr(new_cons) = old_cons; Car(STACK_0) = new_cons; + STACK_0 = Cdr(STACK_0); + } + skipSTACK(1); + } skipSTACK(1); - STACK_0 = Cdr(STACK_0); } - skipSTACK(2); /* forget conflicts and conflict-resolver */ - /* stack-layout: pack, packlist. */ - /* traverse packlist: */ - while (mconsp(STACK_0)) { - pushSTACK(Car(STACK_0)); /* pack_to_use */ - { /* (push pack_to_use (package-use-list pack)) */ + /* conflict-list finished. */ + pushSTACK(NIL); /* conflict-resolver := NIL */ + conflict_resolver_ = &STACK_0; + /* stack-layout: pack, packlist, conflicts, conflict-resolver. */ + /* treat conflicts with user-queries: */ + while (!nullp(*conflicts_)) { /* only necessary for conflicts/=NIL */ + /* raise correctable error: */ + pushSTACK(Car(*conflicts_)); /* OPTIONS */ + pushSTACK(*pack_); /* PACKAGE-ERROR slot PACKAGE */ + pushSTACK(*pack_); + pushSTACK(Symbol_name(Cdr(Cdr(Car(Car(*conflicts_)))))); /* name */ + pushSTACK(fixnum(llength(*conflicts_))); /* (length conflicts) */ + pushSTACK(*pack_); pushSTACK(*packlist_); pushSTACK(S(use_package)); + correctable_error(package_error,GETTEXT("(~S ~S ~S): ~S name conflicts remain\nWhich symbol with name ~S should be accessible in ~S?")); + pushSTACK(value1); /* sym */ + { var object new_cons = allocate_cons(); - var object pack = STACK_2; - Car(new_cons) = STACK_0; /* pack_to_use */ - Cdr(new_cons) = ThePackage(pack)->pack_use_list; - ThePackage(pack)->pack_use_list = new_cons; + Car(new_cons) = popSTACK(); /* sym */ + Cdr(new_cons) = *conflict_resolver_; + /* conflict-resolver := (cons sym conflict-resolver) */ + *conflict_resolver_ = new_cons; } - { /* (push pack (package-used-by-list pack_to_use)) */ - var object new_cons = allocate_cons(); - var object pack_to_use = popSTACK(); - Car(new_cons) = STACK_1; /* pack */ - Cdr(new_cons) = ThePackage(pack_to_use)->pack_used_by_list; - ThePackage(pack_to_use)->pack_used_by_list = new_cons; + *conflicts_ = Cdr(*conflicts_); + } + /* stack-layout: pack, packlist, conflicts, conflict-resolver. */ + { /* resolve conflicts: */ + set_break_sem_3(); + /* traverse conflict-resolver: */ + while (mconsp(STACK_0)) { + pushSTACK(Car(STACK_0)); /* symbol from conflict-resolver */ + /* make it into a shadowing-symbol in pack */ + shadowing_import(&STACK_0,&STACK_4); + skipSTACK(1); + STACK_0 = Cdr(STACK_0); } - STACK_0 = Cdr(STACK_0); + skipSTACK(2); /* forget conflicts and conflict-resolver */ + /* stack-layout: pack, packlist. */ + /* traverse packlist: */ + while (mconsp(STACK_0)) { + pushSTACK(Car(STACK_0)); /* pack_to_use */ + { /* (push pack_to_use (package-use-list pack)) */ + var object new_cons = allocate_cons(); + var object pack = STACK_2; + Car(new_cons) = STACK_0; /* pack_to_use */ + Cdr(new_cons) = ThePackage(pack)->pack_use_list; + ThePackage(pack)->pack_use_list = new_cons; + } + { /* (push pack (package-used-by-list pack_to_use)) */ + var object new_cons = allocate_cons(); + var object pack_to_use = popSTACK(); + Car(new_cons) = STACK_1; /* pack */ + Cdr(new_cons) = ThePackage(pack_to_use)->pack_used_by_list; + ThePackage(pack_to_use)->pack_used_by_list = new_cons; + } + STACK_0 = Cdr(STACK_0); + } + skipSTACK(2); /* forget pack and packlist */ + clr_break_sem_3(); } - skipSTACK(2); /* forget pack and packlist */ - clr_break_sem_3(); } - } + }); } + /* UP: Auxiliary function for use_package: Test the argument (an external symbol from one of the packages of packlist), if it creates a conflict. If yes, extend conflicts. @@ -1721,31 +1775,17 @@ > qpack: package Removes qpack from the use-list of pack and pack from the used-by-list of qpack. - can trigger GC - MT: we lock here both of the packages - one after the other. - this is needed since if we try to obtain 2 different mutexes at the - same time - we have to establish some order of acquiring them. Otherwise - deadlocks are possible. - Clearly this is not the most efficient (especially about pack) but - is safe. */ + can trigger GC */ local maygc void unuse_1package (object pack, object qpack) { safe_check_pack_lock(S(use_package),pack,qpack); - pushSTACK(pack); pushSTACK(qpack); - var gcv_object_t *pack_ = &STACK_1; - var gcv_object_t *qpack_ = &STACK_0; set_break_sem_2(); /* remove qpack from the use-list of pack: */ - WITH_LISP_MUTEX_LOCK(0,false,&ThePackage(*pack_)->pack_mutex,{ - ThePackage(*pack_)->pack_use_list = - deleteq(ThePackage(*pack_)->pack_use_list,*qpack_); - }); + ThePackage(pack)->pack_use_list = + deleteq(ThePackage(pack)->pack_use_list,qpack); /* remove pack from the used-by-list of qpack: */ - WITH_LISP_MUTEX_LOCK(0,false,&ThePackage(*qpack_)->pack_mutex,{ - ThePackage(*qpack_)->pack_used_by_list = - deleteq(ThePackage(*qpack_)->pack_used_by_list,*pack_); - }); + ThePackage(qpack)->pack_used_by_list = + deleteq(ThePackage(qpack)->pack_used_by_list,pack); clr_break_sem_2(); - skipSTACK(2); } /* UP: Effectuates, that a list of given packages is not USE-ed anymore @@ -1762,10 +1802,19 @@ pushSTACK(packlist); set_break_sem_3(); /* traverse packlist: */ - while (mconsp(STACK_0)) { - unuse_1package(STACK_1,Car(STACK_0)); - STACK_0 = Cdr(STACK_0); - } + var gcv_object_t *pack_ = &STACK_1; + WITH_LISP_MUTEX_LOCK(1,false,&ThePackage(*pack_)->pack_mutex,{ + pushSTACK(NIL); + var gcv_object_t *qpack_ = &STACK_0; + while (mconsp(STACK_1)) { + STACK_0 = Car(STACK_1); + WITH_LISP_MUTEX_LOCK(0,false,&ThePackage(*qpack_)->pack_mutex,{ + unuse_1package(*pack_,*qpack_); + }); + STACK_1 = Cdr(STACK_1); + } + skipSTACK(1); + }); clr_break_sem_3(); skipSTACK(2); } @@ -2386,18 +2435,22 @@ /* (USE-PACKAGE packs-to-use [package]), CLTL p. 187 */ LISPFUN(use_package,seclass_default,1,1,norest,nokey,0,NIL) { prepare_use_package(); - var object pack = popSTACK(); - var object packlist = popSTACK(); - use_package(packlist,pack); + WITH_OS_MUTEX_LOCK(2, &all_packages_lock, { + var object pack = popSTACK(); + var object packlist = popSTACK(); + use_package(packlist,pack); + }); VALUES1(T); } /* (UNUSE-PACKAGE packs-to-use [package]), CLTL p. 187 */ LISPFUN(unuse_package,seclass_default,1,1,norest,nokey,0,NIL) { prepare_use_package(); - var object pack = popSTACK(); - var object packlist = popSTACK(); - unuse_package(packlist,pack); + WITH_OS_MUTEX_LOCK(2, &all_packages_lock, { + var object pack = popSTACK(); + var object packlist = popSTACK(); + unuse_package(packlist,pack); + }); VALUES1(T); } @@ -2561,26 +2614,36 @@ STACK_1 = STACK_2; /* use-list as 1. argument for USE-PACKAGE */ STACK_0 = STACK_4; /* pack as 2. argument for USE-PACKAGE */ prepare_use_package(); /* check arguments STACK_1, STACK_0 */ - /* stack-layout: pack, nicknames, -, new use-list, pack. */ - { /* execute USE-PACKAGE (with copied use-list): */ - var object temp = reverse(STACK_1); - use_package(temp,STACK_4); - } - /* All packages, that are still listed in the use-list of pack, - but which do not occur in the uselist located in STACK_1, - are removed with unuse_1package: */ - pack = STACK_4; - { /* traverse use-list of pack */ - STACK_0 = ThePackage(pack)->pack_use_list; - while (mconsp(STACK_0)) { - var object qpack = Car(STACK_0); - /* search in uselist: */ - if (nullp(memq(qpack,STACK_1))) - /* not found in uselist */ - unuse_1package(STACK_4,qpack); - STACK_0 = Cdr(STACK_0); + WITH_OS_MUTEX_LOCK(5, &all_packages_lock, { + /* stack-layout: pack, nicknames, -, new use-list, pack. */ + { /* execute USE-PACKAGE (with copied use-list): */ + var object temp = reverse(STACK_1); + use_package(temp,STACK_4); } - } + /* All packages, that are still listed in the use-list of pack, + but which do not occur in the uselist located in STACK_1, + are removed with unuse_1package: */ + { /* traverse use-list of pack */ + var gcv_object_t *pack_ = &STACK_4; + WITH_LISP_MUTEX_LOCK(2,false,&ThePackage(*pack_)->pack_mutex, { + pushSTACK(NIL); + var gcv_object_t *qpack_ = &STACK_0; + STACK_1 = ThePackage(*pack_)->pack_use_list; + while (mconsp(STACK_1)) { + *qpack_ = Car(STACK_1); + /* search in uselist: */ + if (nullp(memq(*qpack_,STACK_2))) { + /* not found in uselist */ + WITH_LISP_MUTEX_LOCK(0,false,&ThePackage(*qpack_)->pack_mutex, { + unuse_1package(*pack_,*qpack_); + }); + } + STACK_1 = Cdr(STACK_1); + } + skipSTACK(1); + }); + } + }); } /* the use-list is adjusted correctly. */ skipSTACK(4); /* forget uselist, nicknames etc. */ @@ -2645,38 +2708,41 @@ 'DELETE-PACKAGE pack used-by-list) */ funcall(L(cerror_of_type),8); } - WITH_OS_MUTEX_LOCK(1, &all_packages_lock, { - /* in thread builds it's possible another thread to have deleted - the package already - so check again with lock held */ - if (!pack_deletedp(STACK_0)) { - /* execute (DOLIST (p used-py-list) (UNUSE-PACKAGE pack p)) : */ - set_break_sem_3(); - while ((pack = STACK_0, mconsp(ThePackage(pack)->pack_used_by_list))) { - unuse_1package(Car(ThePackage(pack)->pack_used_by_list),pack); - } - clr_break_sem_3(); - /* execute (UNUSE-PACKAGE (package-use-list pack) pack) : */ - unuse_package(ThePackage(STACK_0)->pack_use_list,STACK_0); - /* apply delete_package_aux to the symbols present in pack: - in MT we should get the package lock - since delete_package_aux() - calls unintern(). */ - var gcv_object_t *pack_ = &STACK_0; - WITH_LISP_MUTEX_LOCK(0,false,&ThePackage(*pack_)->pack_mutex,{ + var gcv_object_t *pack_ = &STACK_0; + WITH_OS_MUTEX_LOCK(0, &all_packages_lock, { + WITH_LISP_MUTEX_LOCK(0,true,&ThePackage(*pack_)->pack_mutex,{ + /* in MT build package may have been deleted while we were wating */ + if (!pack_deletedp(*pack_)) { + /* execute (DOLIST (p used-py-list) (UNUSE-PACKAGE pack p)) : */ + set_break_sem_3(); + pushSTACK(NIL); + var gcv_object_t *qpack_ = &STACK_0; + while (mconsp(ThePackage(*pack_)->pack_used_by_list)) { + STACK_0 = Car(ThePackage(*pack_)->pack_used_by_list); + WITH_LISP_MUTEX_LOCK(0,false,&ThePackage(*qpack_)->pack_mutex,{ + unuse_1package(*qpack_,*pack_); + }); + } + skipSTACK(1); + clr_break_sem_3(); + /* execute (UNUSE-PACKAGE (package-use-list pack) pack) : */ + unuse_package(ThePackage(*pack_)->pack_use_list,*pack_); + /* apply delete_package_aux to the symbols present in pack: */ map_symtab_c(&delete_package_aux,pack_, ThePackage(*pack_)->pack_external_symbols); map_symtab_c(&delete_package_aux,pack_, ThePackage(*pack_)->pack_internal_symbols); - }); - /* remove pack from the list of all packages and mark as deleted: */ - set_break_sem_2(); - O(all_packages) = deleteq(O(all_packages),*pack_); - mark_pack_deleted(*pack_); - clr_break_sem_2(); - VALUES1(T); - } else - VALUES1(NIL); - skipSTACK(1); + /* remove pack from the list of all packages and mark as deleted: */ + set_break_sem_2(); + O(all_packages) = deleteq(O(all_packages),*pack_); + mark_pack_deleted(*pack_); + clr_break_sem_2(); + VALUES1(T); + } else + VALUES1(NIL); + }); }); + skipSTACK(1); } /* UP: Auxiliary function for DELETE-PACKAGE: ------------------------------ Message: 2 Date: Sun, 16 Aug 2009 20:21:24 +0000 From: Sam Steingold <sd...@us...> Subject: clisp/modules/queens Makefile,1.12,1.13 To: cli...@li... Message-ID: <E1M...@dd...> Update of /cvsroot/clisp/clisp/modules/queens In directory ddv4jf1.ch3.sourceforge.com:/tmp/cvs-serv2303/modules/queens Modified Files: Makefile Log Message: avoid GNU extensions Reported by Aleksej Saushev <as...@in...> Index: Makefile =================================================================== RCS file: /cvsroot/clisp/clisp/modules/queens/Makefile,v retrieving revision 1.12 retrieving revision 1.13 diff -u -d -r1.12 -r1.13 --- Makefile 6 Aug 2009 20:28:45 -0000 1.12 +++ Makefile 16 Aug 2009 20:21:22 -0000 1.13 @@ -26,20 +26,25 @@ clisp-module : $(GENERATED) queens.o : $(srcdir)/queens.c - $(CC) $(CPPFLAGS) $(CFLAGS) -c $< + $(CC) $(CPPFLAGS) $(CFLAGS) -c $(srcdir)/queens.c callqueens.m.c : $(srcdir)/callqueens.c - $(CLISP) -C $(INCLUDES)/modprep $< -o ./ + $(CLISP) -C $(INCLUDES)/modprep $(srcdir)/callqueens.c -o ./ callqueens.o : callqueens.m.c $(CC) $(CPPFLAGS) $(CFLAGS) -I$(INCLUDES) -c callqueens.m.c -o callqueens.o link.sh : $(srcdir)/link.sh - $(LN_S) $< . + $(LN_S) $(srcdir)/link.sh . # Make a module distribution into $(distribdir) clisp-module-distrib : clisp-module force $(LN) $(DISTRIBFILES) $(distribdir) +clean : force + rm -f core *.o *.a *.m.c *.fas *.lib + +distclean : clean + force : ------------------------------ Message: 3 Date: Sun, 16 Aug 2009 20:21:23 +0000 From: Sam Steingold <sd...@us...> Subject: clisp/modules/bindings/win32 Makefile,1.9,1.10 To: cli...@li... Message-ID: <E1M...@dd...> Update of /cvsroot/clisp/clisp/modules/bindings/win32 In directory ddv4jf1.ch3.sourceforge.com:/tmp/cvs-serv2303/modules/bindings/win32 Modified Files: Makefile Log Message: avoid GNU extensions Reported by Aleksej Saushev <as...@in...> Index: Makefile =================================================================== RCS file: /cvsroot/clisp/clisp/modules/bindings/win32/Makefile,v retrieving revision 1.9 retrieving revision 1.10 diff -u -d -r1.9 -r1.10 --- Makefile 6 Aug 2009 20:28:44 -0000 1.9 +++ Makefile 16 Aug 2009 20:21:21 -0000 1.10 @@ -24,17 +24,22 @@ clisp-module : $(GENERATED) win32.c win32.fas : $(srcdir)/win32.lisp - $(CLISP) -c $< -o ./ + $(CLISP) -c $(srcdir)/win32.lisp -o ./ win32.o : win32.c $(INCLUDES)/clisp.h $(CC) $(CPPFLAGS) $(CFLAGS) -I$(INCLUDES) -c win32.c link.sh : $(srcdir)/link.sh - $(LN_S) $< . + $(LN_S) $(srcdir)/link.sh . # Make a module distribution into $(distribdir) clisp-module-distrib : clisp-module force $(LN) $(DISTRIBFILES) $(distribdir) +clean : force + rm -f core *.o *.a *.fas *.lib + +distclean : clean + force : ------------------------------ Message: 4 Date: Sun, 16 Aug 2009 20:21:23 +0000 From: Sam Steingold <sd...@us...> Subject: clisp/modules/clx/mit-clx Makefile,1.7,1.8 To: cli...@li... Message-ID: <E1M...@dd...> Update of /cvsroot/clisp/clisp/modules/clx/mit-clx In directory ddv4jf1.ch3.sourceforge.com:/tmp/cvs-serv2303/modules/clx/mit-clx Modified Files: Makefile Log Message: avoid GNU extensions Reported by Aleksej Saushev <as...@in...> Index: Makefile =================================================================== RCS file: /cvsroot/clisp/clisp/modules/clx/mit-clx/Makefile,v retrieving revision 1.7 retrieving revision 1.8 diff -u -d -r1.7 -r1.8 --- Makefile 5 Aug 2009 20:56:01 -0000 1.7 +++ Makefile 16 Aug 2009 20:21:21 -0000 1.8 @@ -90,13 +90,13 @@ clisp-module : defsystem.fas stamp.fas $(ALLFAS) # Make a module distribution into $(distribdir) - clisp-module-distrib : clisp-module force $(LN) $(DISTRIBFILES) $(distribdir) - clean: force -rm -f *.lib *.fas *.mem +distclean : clean + force: ------------------------------ Message: 5 Date: Sun, 16 Aug 2009 20:21:24 +0000 From: Sam Steingold <sd...@us...> Subject: clisp/modules/gdbm Makefile.in,1.6,1.7 To: cli...@li... Message-ID: <E1M...@dd...> Update of /cvsroot/clisp/clisp/modules/gdbm In directory ddv4jf1.ch3.sourceforge.com:/tmp/cvs-serv2303/modules/gdbm Modified Files: Makefile.in Log Message: avoid GNU extensions Reported by Aleksej Saushev <as...@in...> Index: Makefile.in =================================================================== RCS file: /cvsroot/clisp/clisp/modules/gdbm/Makefile.in,v retrieving revision 1.6 retrieving revision 1.7 diff -u -d -r1.6 -r1.7 --- Makefile.in 6 Aug 2009 20:28:44 -0000 1.6 +++ Makefile.in 16 Aug 2009 20:21:21 -0000 1.7 @@ -21,24 +21,26 @@ # default target: make the module clisp-module : $(GENERATED) -%.fas: $(srcdir)/%.lisp - $(CLISP) -c $< -o ./ +gdbm.fas: $(srcdir)/gdbm.lisp + $(CLISP) -c $(srcdir)/gdbm.lisp -o ./ gdbm.o : gdbm.m.c config.h $(CC) $(CPPFLAGS) $(GDBMCPPFLAGS) $(CFLAGS) -I$(INCLUDES) -c gdbm.m.c -o gdbm.o gdbm.m.c : $(srcdir)/gdbm.c - $(CLISP) -C $(INCLUDES)/modprep $< ./ + $(CLISP) -C $(INCLUDES)/modprep $(srcdir)/gdbm.c ./ preload.lisp : $(srcdir)/preload.lisp - $(LN_S) $< . + $(LN_S) $(srcdir)/preload.lisp . # Make a module distribution into $(distribdir) clisp-module-distrib : clisp-module force $(LN) $(DISTRIBFILES) $(distribdir) clean : force - rm -f core *.o *.a + rm -f core *.o *.a *.m.c *.fas *.lib + +distclean : clean force : ------------------------------ ------------------------------------------------------------------------------ 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 cli...@li... https://lists.sourceforge.net/lists/listinfo/clisp-cvs End of clisp-cvs Digest, Vol 40, Issue 36 ***************************************** |