From: <cli...@li...> - 2008-08-08 19:03:18
|
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/modules/dirkey dirkey.c,1.18,1.19 (Sam Steingold) 2. clisp/src ChangeLog,1.6460,1.6461 (Sam Steingold) 3. clisp/doc gray.xml,2.18,2.19 (Sam Steingold) 4. clisp/src ChangeLog,1.6461,1.6462 fill-out.lisp,1.18,1.19 (Sam Steingold) 5. clisp/tests streams.tst,1.54,1.55 (Sam Steingold) 6. clisp/src ChangeLog, 1.6440.4.4, 1.6440.4.5 lispbibl.d, 1.806.2.4, 1.806.2.5 zthread.d, 1.7.2.4, 1.7.2.5 (Vladimir Tzankov) 7. clisp/src pathname.d,1.466,1.467 (Sam Steingold) ---------------------------------------------------------------------- Message: 1 Date: Thu, 07 Aug 2008 20:21:08 +0000 From: Sam Steingold <sd...@us...> Subject: clisp/modules/dirkey dirkey.c,1.18,1.19 To: cli...@li... Message-ID: <E1K...@ma...> Update of /cvsroot/clisp/clisp/modules/dirkey In directory sc8-pr-cvs4.sourceforge.net:/tmp/cvs-serv24965/modules/dirkey Modified Files: dirkey.c Log Message: (init_iteration_node): do not pass pointers into the Lisp heap to system calls Index: dirkey.c =================================================================== RCS file: /cvsroot/clisp/clisp/modules/dirkey/dirkey.c,v retrieving revision 1.18 retrieving revision 1.19 diff -u -d -r1.18 -r1.19 --- dirkey.c 25 Nov 2007 20:08:51 -0000 1.18 +++ dirkey.c 7 Aug 2008 20:21:06 -0000 1.19 @@ -644,14 +644,15 @@ test_dir_key(ITST_DKEY(STACK_4),true); {object dk = test_dir_key(ITST_DKEY(STACK_4/*state*/),true); gcv_object_t *slots = dir_key_slots(dk); - FOREIGN *fp = &(TheFpointer(STACK_0/*handle*/)->fp_pointer); + FOREIGN fp; with_string_0(*new_path,GLO(misc_encoding),pathz,{ open_reg_key((HKEY)SLOT_HANDLE(slots),pathz,check_direction(slots[DK_DIR]), - IF_DOES_NOT_EXIST_UNBOUND/*ignore*/,(HKEY*)fp); + IF_DOES_NOT_EXIST_UNBOUND/*ignore*/,(HKEY*)&fp); }); - if (*fp) { + TheFpointer(STACK_0/*handle*/)->fp_pointer = fp; + if (fp) { DWORD k_size, a_size, d_size; - SYSCALL_WIN32(RegQueryInfoKey((HKEY)*fp,NULL,NULL,NULL,NULL,&k_size, + SYSCALL_WIN32(RegQueryInfoKey((HKEY)fp,NULL,NULL,NULL,NULL,&k_size, NULL,NULL,&a_size,&d_size,NULL,NULL)); NODE_KEY_S(STACK_1) = fixnum(k_size+1); /* node */ NODE_ATT_S(STACK_1) = fixnum(a_size+1); /* node */ ------------------------------ Message: 2 Date: Thu, 07 Aug 2008 20:21:08 +0000 From: Sam Steingold <sd...@us...> Subject: clisp/src ChangeLog,1.6460,1.6461 To: cli...@li... Message-ID: <E1K...@ma...> Update of /cvsroot/clisp/clisp/src In directory sc8-pr-cvs4.sourceforge.net:/tmp/cvs-serv24965/src Modified Files: ChangeLog Log Message: (init_iteration_node): do not pass pointers into the Lisp heap to system calls Index: ChangeLog =================================================================== RCS file: /cvsroot/clisp/clisp/src/ChangeLog,v retrieving revision 1.6460 retrieving revision 1.6461 diff -u -d -r1.6460 -r1.6461 --- ChangeLog 5 Aug 2008 22:36:39 -0000 1.6460 +++ ChangeLog 7 Aug 2008 20:21:06 -0000 1.6461 @@ -1,3 +1,8 @@ +2008-08-07 Sam Steingold <sd...@gn...> + + * modules/dirkey/dirkey.c (init_iteration_node): do not pass + pointers into the Lisp heap to system calls + 2008-08-05 Vladimir Tzankov <vtz...@gm...> * lispbibl.d (Rectype_Thread, Rectype_Mutex, Rectype_Exemption): ------------------------------ Message: 3 Date: Thu, 07 Aug 2008 21:14:39 +0000 From: Sam Steingold <sd...@us...> Subject: clisp/doc gray.xml,2.18,2.19 To: cli...@li... Message-ID: <E1K...@ma...> Update of /cvsroot/clisp/clisp/doc In directory sc8-pr-cvs4.sourceforge.net:/tmp/cvs-serv10684/doc Modified Files: gray.xml Log Message: (fill-stream-flush-buffer): remove the "one-line sexp on its own line" special case, see <http://article.gmane.org/gmane.lisp.clisp.devel/18759> Index: gray.xml =================================================================== RCS file: /cvsroot/clisp/clisp/doc/gray.xml,v retrieving revision 2.18 retrieving revision 2.19 diff -u -d -r2.18 -r2.19 --- gray.xml 28 May 2008 14:07:06 -0000 2.18 +++ gray.xml 7 Aug 2008 21:14:37 -0000 2.19 @@ -392,7 +392,8 @@ (force-output fill) (let ((*my-indent-level* 5)) (format fill "~%and properly indented to the level specified by the ~S argument which can be a ~S or an ~S - cool!" - :TEXT-INDENT 'symbol 'integer)) + :TEXT-INDENT 'symbol 'integer) + (force-output fill)) (format fill "~%Don't forget to call ~S on it, and/or use ~S Pretty formatting of the S-expressions printed with ~~S is preserved: ~S" 'force-output 'with-fill-stream '(defun foo (x y z) (if x (+ y z) (* y z))))))) <computeroutput>" @@ -404,24 +405,26 @@ indented to the level specified by - the :TEXT-INDENT + the + :TEXT-INDENT argument which can be a -SYMBOL - or an INTEGER - - cool! + SYMBOL or an + INTEGER - + cool! Don't forget to call FORCE-OUTPUT on it, and/or use -WITH-FILL-STREAM + WITH-FILL-STREAM Pretty formatting of the S-expressions printed with ~S is preserved: -(DEFUN FOO (X Y Z) - (IF X (+ Y Z) - (* Y Z))) + (DEFUN FOO + (X Y Z) + (IF X (+ Y Z) + (* Y Z))) "</computeroutput></programlisting> </example> </section> ------------------------------ Message: 4 Date: Thu, 07 Aug 2008 21:14:40 +0000 From: Sam Steingold <sd...@us...> Subject: clisp/src ChangeLog,1.6461,1.6462 fill-out.lisp,1.18,1.19 To: cli...@li... Message-ID: <E1K...@ma...> Update of /cvsroot/clisp/clisp/src In directory sc8-pr-cvs4.sourceforge.net:/tmp/cvs-serv10684/src Modified Files: ChangeLog fill-out.lisp Log Message: (fill-stream-flush-buffer): remove the "one-line sexp on its own line" special case, see <http://article.gmane.org/gmane.lisp.clisp.devel/18759> Index: fill-out.lisp =================================================================== RCS file: /cvsroot/clisp/clisp/src/fill-out.lisp,v retrieving revision 1.18 retrieving revision 1.19 diff -u -d -r1.18 -r1.19 --- fill-out.lisp 27 Jul 2008 01:56:56 -0000 1.18 +++ fill-out.lisp 7 Aug 2008 21:14:38 -0000 1.19 @@ -61,14 +61,11 @@ ((t) text-indent) (t sexp-indent-value)))) -;; SEXP output has 3 cases: -;; 0. SEXP in-line: needs _no_ indentation -;; 1. 1-line SEXP on its own line: needs indentation, no embedded newlines -;; 2. multi-line SEXP in its own block: needs indentation on all lines, -;; starts with a newline +;; SEXP is either a single line, then it is formatted inline as a word, +;; or it takes several lines, then it is formatted as an indented block ;; flush the buffer and print a newline (when NEWLINE-P is non-NIL) -(defun fill-stream-flush-buffer (stream newline-p &aux sexp-case) +(defun fill-stream-flush-buffer (stream newline-p &aux sexp-block-p) (with-slots (target-stream buffer pending-indent current-indent pending-space inside-sexp) stream @@ -79,36 +76,29 @@ (when (plusp (length buffer)) ; something in the buffer to flush ;; fill: if the buffer does not fit on the line, TERPRI (let ((pos (fill-stream-line-position stream))) - (if (and pos (<= (right-margin) pos)) ; does not fit on this line - (let ((multiline (find #\newline buffer))) ; only inside sexp - (unless multiline (newline)) - (when inside-sexp ; just finished an S-expression - (setq newline-p t sexp-case (if multiline 2 1)))) - (setq sexp-case 0))) - (unless (and newline-p inside-sexp) ; S-expression on its own line(s) + (when (and pos (<= (right-margin) pos)) ; does not fit on this line + (setq sexp-block-p (find #\newline buffer)) ; only inside sexp + (unless sexp-block-p (newline)) + (when inside-sexp ; just finished an S-expression + (setq newline-p (or newline-p sexp-block-p))))) + (unless sexp-block-p ; S-expression in a block (cond (pending-indent ; do the indent (sys::write-spaces pending-indent target-stream) (setq pending-indent nil)) (pending-space (write-char #\Space target-stream)))) (setq pending-space nil) - (if inside-sexp - (case sexp-case - (0 (write-char-sequence buffer target-stream)) - (1 (sys::write-spaces (fill-stream-sexp-indent stream) - target-stream) - (write-char-sequence buffer target-stream)) - (2 (let ((indent (fill-stream-sexp-indent stream))) - (do* ((beg 0 (1+ end)) - (end (position #\Newline buffer) - (position #\Newline buffer :start beg))) - ((null end) - (write-char-sequence buffer target-stream :start beg)) - (write-char-sequence buffer target-stream - :start beg :end end) - (terpri target-stream) - (sys::write-spaces indent target-stream))))) - (write-char-sequence buffer target-stream)) + (if sexp-block-p + (do* ((indent (fill-stream-sexp-indent stream)) + (beg 0 (1+ end)) + (end (position #\Newline buffer) + (position #\Newline buffer :start beg))) + ((null end) + (write-char-sequence buffer target-stream :start beg)) + (write-char-sequence buffer target-stream :start beg :end end) + (terpri target-stream) + (sys::write-spaces indent target-stream)) + (write-char-sequence buffer target-stream)) (setf (fill-pointer buffer) 0)) (when newline-p (newline))))) Index: ChangeLog =================================================================== RCS file: /cvsroot/clisp/clisp/src/ChangeLog,v retrieving revision 1.6461 retrieving revision 1.6462 diff -u -d -r1.6461 -r1.6462 --- ChangeLog 7 Aug 2008 20:21:06 -0000 1.6461 +++ ChangeLog 7 Aug 2008 21:14:37 -0000 1.6462 @@ -1,3 +1,9 @@ +2008-08-06 Sam Steingold <sd...@gn...> + + * fill-out.lisp (fill-stream-flush-buffer): + remove the "one-line sexp on its own line" special case, + see <http://article.gmane.org/gmane.lisp.clisp.devel/18759> + 2008-08-07 Sam Steingold <sd...@gn...> * modules/dirkey/dirkey.c (init_iteration_node): do not pass ------------------------------ Message: 5 Date: Thu, 07 Aug 2008 21:14:40 +0000 From: Sam Steingold <sd...@us...> Subject: clisp/tests streams.tst,1.54,1.55 To: cli...@li... Message-ID: <E1K...@ma...> Update of /cvsroot/clisp/clisp/tests In directory sc8-pr-cvs4.sourceforge.net:/tmp/cvs-serv10684/tests Modified Files: streams.tst Log Message: (fill-stream-flush-buffer): remove the "one-line sexp on its own line" special case, see <http://article.gmane.org/gmane.lisp.clisp.devel/18759> Index: streams.tst =================================================================== RCS file: /cvsroot/clisp/clisp/tests/streams.tst,v retrieving revision 1.54 retrieving revision 1.55 diff -u -d -r1.54 -r1.55 --- streams.tst 7 Oct 2007 01:00:15 -0000 1.54 +++ streams.tst 7 Aug 2008 21:14:38 -0000 1.55 @@ -751,6 +751,21 @@ (CHARACTER CHARACTER CHARACTER) #+clisp +(let ((*print-right-margin* 15) (*print-pretty* t)) + (with-output-to-string (out) + (with-fill-stream (fill out :text-indent 3) + (format fill "~%~S, ~S, ~S, ~S, ~S, ~S, ~S, ~S, ~S, ~S,~%" + 'a 'bb 'ccc 'dddd 'eeeee 'ffffff 'gggg 'hhh 'ii 'j)))) +#+clisp " + A, BB, CCC, + DDDD + , EEEEE, + FFFFFF + , GGGG, HHH + , II, J, +" + +#+clisp (progn (defvar *my-indent-level*) (with-output-to-string (out) ------------------------------ Message: 6 Date: Thu, 07 Aug 2008 22:46:12 +0000 From: Vladimir Tzankov <vt...@us...> Subject: clisp/src ChangeLog, 1.6440.4.4, 1.6440.4.5 lispbibl.d, 1.806.2.4, 1.806.2.5 zthread.d, 1.7.2.4, 1.7.2.5 To: cli...@li... Message-ID: <E1K...@ma...> Update of /cvsroot/clisp/clisp/src In directory sc8-pr-cvs4.sourceforge.net:/tmp/cvs-serv13356/src Modified Files: Tag: threads ChangeLog lispbibl.d zthread.d Log Message: GC_SAFE_REGION_END fix + blocking system calls macros. Index: zthread.d =================================================================== RCS file: /cvsroot/clisp/clisp/src/zthread.d,v retrieving revision 1.7.2.4 retrieving revision 1.7.2.5 diff -u -d -r1.7.2.4 -r1.7.2.5 --- zthread.d 6 Aug 2008 14:56:11 -0000 1.7.2.4 +++ zthread.d 7 Aug 2008 22:46:09 -0000 1.7.2.5 @@ -42,15 +42,16 @@ LISPFUN(make_thread,seclass_default,1,0,norest,key,1,(kw(name))) { /* (MAKE-THREAD function &key name) */ - var uintM lisp_stack_size=(abs((gcv_object_t *)STACK_start - - (gcv_object_t *)STACK_bound)+0x40)* + /* VTZ: new thread lisp stack size is the same as the calling one + may be add another keyword argument for it ???*/ + var uintM lisp_stack_size=(STACK_item_count(STACK_bound,STACK_start)+0x40)* sizeof(gcv_object_t *); var clisp_thread_t *new_thread; /*allocate before the lock*/ pushSTACK(allocate_thread(&STACK_0)); /* put it in GC visible place */ - _GC_SAFE_REGION_BEGIN(); /* give chance the GC to work while we wait*/ + begin_blocking_system_call(); /* give chance the GC to work while we wait*/ lock_threads(); - _GC_SAFE_REGION_END(); + end_blocking_system_call(); /* after we obtain thread lock - no GC can interrupt us. */ new_thread=create_thread(lisp_stack_size); if (!new_thread) { Index: lispbibl.d =================================================================== RCS file: /cvsroot/clisp/clisp/src/lispbibl.d,v retrieving revision 1.806.2.4 retrieving revision 1.806.2.5 diff -u -d -r1.806.2.4 -r1.806.2.5 --- lispbibl.d 6 Aug 2008 14:56:10 -0000 1.806.2.4 +++ lispbibl.d 7 Aug 2008 22:46:08 -0000 1.806.2.5 @@ -9297,38 +9297,6 @@ #define SAVE_back_trace() #define RESTORE_back_trace() #endif -#if defined(MULTITHREAD) - /* no_gc statement is executed in case the thread should not be suspended for GC.*/ - #define GC_SAFE_POINT_ELSE(no_gc) \ - do{ \ - var clisp_thread_t *thr=current_thread(); \ - if (spinlock_tryacquire(&thr->_gc_suspend_request)) { \ - spinlock_release(&thr->_gc_suspend_ack); \ - xmutex_lock(&thr->_gc_suspend_lock); \ - spinlock_acquire(&thr->_gc_suspend_ack); \ - xmutex_unlock(&thr->_gc_suspend_lock); \ - } else {no_gc;} \ - }while(0) - #define GC_SAFE_POINT() GC_SAFE_POINT_ELSE(;) -/* Giving up suspend ack during we are in system call. So we can be considered - suspended for GC. */ - #define _GC_SAFE_REGION_BEGIN() \ - do { \ - spinlock_release(¤t_thread()->_gc_suspend_ack); \ - }while(0) -/*VTZ: we should acquire the ACK spinlock, however in the existing code the calls to begin/end - calls do not match on many places. So we will check whether there is suspend request. */ - #define _GC_SAFE_REGION_END() GC_SAFE_POINT_ELSE(spinlock_tryacquire(¤t_thread()->_gc_suspend_ack)) - -#define GC_SAFE_REGION_BEGIN() GCTRIGGER() -#define GC_SAFE_REGION_END() GCTRIGGER() - -#else - #define GC_SAFE_POINT_ELSE(no_gc) - #define GC_SAFE_POINT() - #define GC_SAFE_REGION_BEGIN() - #define GC_SAFE_REGION_END() -#endif #define SAVE_GLOBALS() SAVE_mv_count(); SAVE_value1(); SAVE_back_trace(); #define RESTORE_GLOBALS() RESTORE_mv_count(); RESTORE_value1(); RESTORE_back_trace(); #if defined(HAVE_SAVED_STACK) @@ -9376,8 +9344,8 @@ #define begin_system_call() #define end_system_call() #else -#define begin_system_call() begin_call(); GC_SAFE_REGION_BEGIN() -#define end_system_call() end_call(); GC_SAFE_REGION_END() +#define begin_system_call() begin_call() +#define end_system_call() end_call() #endif /* The same holds for setjmp()/longjmp(). Here we avoid an unneeded overhead if at all possible. @@ -9406,8 +9374,8 @@ /* The same holds for arithmetics-functions that use the STACK_registers. On I80386 (%ebx) these are SHIFT_LOOPS, MUL_LOOPS, DIV_LOOPS. */ #if defined(I80386) && !defined(NO_ARI_ASM) && defined(HAVE_SAVED_STACK) - #define begin_arith_call() begin_call() - #define end_arith_call() end_call() + #define begin_arith_call() begin_system_call() + #define end_arith_call() end_system_call() #else #define begin_arith_call() #define end_arith_call() @@ -9415,6 +9383,47 @@ %% export_def(begin_system_call()); %% export_def(end_system_call()); +#if defined(MULTITHREAD) + /* no_gc statement is executed in case the thread should not be suspended for GC.*/ + #define GC_SAFE_POINT_ELSE(no_gc) \ + do{ \ + var clisp_thread_t *thr=current_thread(); \ + if (spinlock_tryacquire(&thr->_gc_suspend_request)) { \ + spinlock_release(&thr->_gc_suspend_ack); \ + xmutex_lock(&thr->_gc_suspend_lock); \ + spinlock_acquire(&thr->_gc_suspend_ack); \ + xmutex_unlock(&thr->_gc_suspend_lock); \ + } else {no_gc;} \ + }while(0) + #define GC_SAFE_POINT() GC_SAFE_POINT_ELSE(;) +/* Giving up suspend ack during we are in system call. So we can be considered + suspended for GC. */ + #define GC_SAFE_REGION_BEGIN() \ + do { \ + spinlock_release(¤t_thread()->_gc_suspend_ack); \ + }while(0) +/* If we cannot get the suspend ack lock again - it means we are in GC - + so go in regular route in this case.*/ + #define GC_SAFE_REGION_END() \ + do { \ + var clisp_thread_t *thr=current_thread(); \ + if (!spinlock_tryacquire(&thr->_gc_suspend_ack)) { \ + GC_SAFE_POINT(); \ + } \ + }while(0) +#else + #define GC_SAFE_POINT_ELSE(no_gc) + #define GC_SAFE_POINT() + #define GC_SAFE_REGION_BEGIN() + #define GC_SAFE_REGION_END() +#endif + +#define begin_blocking_system_call() GCTRIGGER();begin_system_call();GC_SAFE_REGION_BEGIN() +#define end_blocking_system_call() GCTRIGGER();end_system_call();GC_SAFE_REGION_END() + +%% export_def(begin_blocking_system_call()); +%% export_def(end_blocking_system_call()); + #if defined(HAVE_STACK_OVERFLOW_RECOVERY) /* Detection of SP-overflow through a Guard-Page or other mechanisms. */ #define NOCOST_SP_CHECK @@ -16784,8 +16793,8 @@ #endif void* _SP_anchor; - void* _STACK_bound; - void* _STACK_start; + gcv_object_t* _STACK_bound; + gcv_object_t* _STACK_start; unwind_protect_caller_t _unwind_protect_to_save; uintC _index; /* this thread's index in allthreads[] */ @@ -16941,6 +16950,7 @@ gc_resume_all_threads(); \ } while(0) #else /* !MULTITHREAD */ +%% #else #define PERFORM_GC(statement,lock_heap) statement #endif %% #endif Index: ChangeLog =================================================================== RCS file: /cvsroot/clisp/clisp/src/ChangeLog,v retrieving revision 1.6440.4.4 retrieving revision 1.6440.4.5 diff -u -d -r1.6440.4.4 -r1.6440.4.5 --- ChangeLog 6 Aug 2008 14:56:07 -0000 1.6440.4.4 +++ ChangeLog 7 Aug 2008 22:46:06 -0000 1.6440.4.5 @@ -1,3 +1,14 @@ +2008-08-08 Vladimir Tzankov <vtz...@gm...> + + GC_SAFE_REGION_END fix + blocking system calls macros. + * lispbibl.d + (GC_SAFE_REGION_END): fixed possible race condition + (begin/end_blocking_system_call): macros for marking possibly + blocking system calls. + * zthread.d + (make-thread): use STACK_item_count() macro for computing + stack size. use begin/end_blocking_system_call. + 2008-08-06 Vladimir Tzankov <vtz...@gm...> Heap/GC changes ------------------------------ Message: 7 Date: Fri, 08 Aug 2008 14:18:32 +0000 From: Sam Steingold <sd...@us...> Subject: clisp/src pathname.d,1.466,1.467 To: cli...@li... Message-ID: <E1K...@ma...> Update of /cvsroot/clisp/clisp/src In directory sc8-pr-cvs4.sourceforge.net:/tmp/cvs-serv12438/src Modified Files: pathname.d Log Message: (launch): FIXME comment: arglist is wrong: it does not allow different pipe types for i/o. The correct arguments should be: :input, :output, :error should take list arguments like this: (:buffered t :element-type (unsigned-byte 8)) :PIPE should be removed from constobj.d Index: pathname.d =================================================================== RCS file: /cvsroot/clisp/clisp/src/pathname.d,v retrieving revision 1.466 retrieving revision 1.467 diff -u -d -r1.466 -r1.467 --- pathname.d 5 Aug 2008 17:14:09 -0000 1.466 +++ pathname.d 8 Aug 2008 14:18:29 -0000 1.467 @@ -8692,6 +8692,13 @@ Can be NIL (/dev/null), :pipe (pipe streams are created) or :terminal. :element-type, :external-format, :buffered : parameters for created pipe-stream if one or more of :input, :output, :error is :pipe. + + FIXME: this is wrong: it does not allow different pipe types for i/o. + The correct arguments should be: + :input, :output, :error should take list arguments like this: + (:buffered t :element-type (unsigned-byte 8)) + :PIPE should be removed from constobj.d + :priority : :HIGH/:LOW/:NORMAL or fixnum on UNIX - see nice(2) on Windows - see CreateProcess dwCreationFlags parameter. ------------------------------ ------------------------------------------------------------------------- This SF.Net email is sponsored by the Moblin Your Move Developer's challenge Build the coolest Linux based applications with Moblin SDK & win great prizes Grand prize is a trip for two to an Open Source event anywhere in the world http://moblin-contest.org/redirect.php?banner_id=100&url=/ ------------------------------ _______________________________________________ clisp-cvs mailing list cli...@li... https://lists.sourceforge.net/lists/listinfo/clisp-cvs End of clisp-cvs Digest, Vol 28, Issue 9 **************************************** |