clisp-devel — closed list for developers and testers

[ clisp-Bugs-3124235 ] hex format directive ignores upper/lower case distinction

[SourceForge.net <no...@so...>]

Bugs item #3124235, was opened at 2010-12-01 04:58
Message generated for change (Comment added) made by sf-robot
You can respond by visiting: 
https://sourceforge.net/tracker/?func=detail&atid=101355&aid=3124235&group_id=1355

Please note that this message will contain a full copy of the comment thread,
including the initial issue submission, for this request,
not just the latest update.
Category: clisp
Group: ANSI compliance issue
>Status: Closed
Resolution: Invalid
Priority: 5
Private: No
Submitted By: Andrew Pennebaker (mcandre)
Assigned to: Sam Steingold (sds)
Summary: hex format directive ignores upper/lower case distinction

Initial Comment:
(format nil "~x" 10) => "A"

when it should evaluate to "a".

Specs:

GNU CLISP 2.49 (2010-07-07) (built 3499977130) (memory 3499977680)
Software: GNU C 4.2.1 (Apple Inc. build 5646)

That's clisp x2.49 (via MacPorts) on Mac OS X 10.6.5 / MacBook Pro 5,1.

----------------------------------------------------------------------

>Comment By: SourceForge Robot (sf-robot)
Date: 2010-12-15 15:20

Message:
This Tracker item was closed automatically by the system. It was
previously set to a Pending status, and the original submitter
did not respond within 14 days (the time period specified by
the administrator of this Tracker).

----------------------------------------------------------------------

Comment By: Bruno Haible (haible)
Date: 2010-12-11 16:00

Message:
See CLHS 22.3.2.5 Tilde X: Hexadecimal
<http://www.ai.mit.edu/projects/iiip/doc/CommonLISP/HyperSpec/Body/sec_22-3-2-5.html>:
FORMAT ~X is like WRITE with *PRINT-BASE* being 16.
In
<http://www.ai.mit.edu/projects/iiip/doc/CommonLISP/HyperSpec/Body/var_stprint-b_rint-radixst.html>
you have a couple of examples where hexadecimal printing produces
uppercase ASCII letters and none
where it produces lowercase ASCII letters.

----------------------------------------------------------------------

Comment By: Sam Steingold (sds)
Date: 2010-12-01 14:25

Message:
why do you expect "a" there?
could you please quote the relevant part of the standard?

----------------------------------------------------------------------

Comment By: Sam Steingold (sds)
Date: 2010-12-01 14:25

Message:
This bug report is now marked as "pending"/"invalid".
This means that we think that the problem you report is not a problem with
CLISP.
Unless you - the reporter - act within 2 weeks, the bug will be
permanently closed.
Sorry about the inconvenience - we hope your silence means that you agree
that this is not a bug in CLISP.

----------------------------------------------------------------------

Comment By: Andrew Pennebaker (mcandre)
Date: 2010-12-01 07:59

Message:
Thank you. I got the impression from skimming Practical Common Lisp that ~X
was uppercase and ~x was lowercase. Had I scrolled down, I would have seen
the bit about ~(...~).

----------------------------------------------------------------------

Comment By: Andrew Pennebaker (mcandre)
Date: 2010-12-01 07:59

Message:
This bug report is now marked as "pending"/"works for me".
This means that we think that we cannot reproduce the problem
and cannot do anything about it.
Unless you - the reporter - act within 2 weeks
(e.g., by submitting a self-contained test case
or answering our other recent requests),
the bug will be permanently closed.
Sorry about the inconvenience - 
we hope your silence means that 
you are no longer observing the problem either.


----------------------------------------------------------------------

Comment By: Pascal J. Bourguignon (informatimago)
Date: 2010-12-01 05:48

Message:
(Sorry for the previous comment it was intended for another bug report).

First,  CLHS is clear about directive characters:
http://www.lispworks.com/documentation/HyperSpec/Body/22_c.htm

   The case of the directive character is ignored. 

If you want to force lowercase or upper case, use ~:( or ~:@(


----------------------------------------------------------------------

Comment By: Pascal J. Bourguignon (informatimago)
Date: 2010-12-01 05:42

Message:
You can use *load-pathname* to get the script name.


----------------------------------------------------------------------

You can respond by visiting: 
https://sourceforge.net/tracker/?func=detail&atid=101355&aid=3124235&group_id=1355

clisp-cvs Digest, Vol 56, Issue 5

[<cli...@li...>]

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/doc impbody.xml,1.616,1.617 (Sam Steingold)
   2. clisp/tests ChangeLog,1.672,1.673 path.tst,1.94,1.95
      (Sam Steingold)
   3. clisp/src ChangeLog, 1.7585, 1.7586 NEWS, 1.552, 1.553
      defs1.lisp,	1.82, 1.83 init.lisp, 1.303, 1.304 (Sam Steingold)


----------------------------------------------------------------------

Message: 1
Date: Fri, 10 Dec 2010 20:05:41 +0000
From: Sam Steingold <sd...@us...>
Subject: clisp/doc impbody.xml,1.616,1.617
To: cli...@li...
Message-ID: <E1P...@sf...>

Update of /cvsroot/clisp/clisp/doc
In directory sfp-cvsdas-2.v30.ch3.sourceforge.com:/tmp/cvs-serv20902/doc

Modified Files:
	impbody.xml 
Log Message:
Fix bug#3124200: setting *DEFAULT-PATHNAME-DEFAULTS* breaks REQUIRE
* src/init.lisp (open-for-load): accept ignore-pathname-defaults and
do not call MERGE-PATHNAMES if it is non-NIL;
use PROBE-PATHNAME instead of DIRECTORY to probe for a directory
(load): accept :IGNORE-PATHNAME-DEFAULTS and pass it to OPEN-FOR-LOAD;
pathname merging is done in OPEN-FOR-LOAD
(search-file): call PATHNAME instead of MERGE-PATHNAMES on the
argument to avoid being killed by *DEFAULT-PATHNAME-DEFAULTS*
* src/defs1.lisp (with-augmented-load-path): do not use UNION since
the augmentations must come first in *LOAD-PATHS*
(simple-require): pass :IGNORE-PATHNAME-DEFAULTS T to LOAD


Index: impbody.xml
===================================================================
RCS file: /cvsroot/clisp/clisp/doc/impbody.xml,v
retrieving revision 1.616
retrieving revision 1.617
diff -u -d -r1.616 -r1.617
--- impbody.xml	7 Dec 2010 22:23:44 -0000	1.616
+++ impbody.xml	10 Dec 2010 20:05:39 -0000	1.617
@@ -5327,7 +5327,8 @@
                     ((&print-k; &load-print-var;) &load-print-var;)
                     ((&echo-k; &load-echo;) &load-echo;) &if-does-not-exist;
                     ((&compiling-k; &load-comp;) &load-comp;) &extra-file-types-k;
-                    ((&obsolete-action-k; &load-obs;) &load-obs;))
+                    ((&obsolete-action-k; &load-obs;) &load-obs;)
+                    (ignore-pathname-defaults nil))
 </programlisting>
 
 <variablelist>
@@ -5395,6 +5396,10 @@
      <indexterm id="load-obs" significance="preferred">
       <primary>*LOAD-OBSOLETE-ACTION*</primary></indexterm></firstterm>,
     which is initially &nil;.</para></listitem></varlistentry>
+  <varlistentry><term><constant>:IGNORE-PATHNAME-DEFAULTS</constant></term>
+  <listitem><simpara>Do not merge &default-pathname-defaults-var; to the
+   argument using &merge-pathnames; (as required by &ansi-cl;) and rely
+   on &load-paths; instead.</simpara></listitem></varlistentry>
 </variablelist>
 
 <para>The variables &load-verbose-var;, &load-print-var;,




------------------------------

Message: 2
Date: Fri, 10 Dec 2010 20:05:41 +0000
From: Sam Steingold <sd...@us...>
Subject: clisp/tests ChangeLog,1.672,1.673 path.tst,1.94,1.95
To: cli...@li...
Message-ID: <E1P...@sf...>

Update of /cvsroot/clisp/clisp/tests
In directory sfp-cvsdas-2.v30.ch3.sourceforge.com:/tmp/cvs-serv20902/tests

Modified Files:
	ChangeLog path.tst 
Log Message:
Fix bug#3124200: setting *DEFAULT-PATHNAME-DEFAULTS* breaks REQUIRE
* src/init.lisp (open-for-load): accept ignore-pathname-defaults and
do not call MERGE-PATHNAMES if it is non-NIL;
use PROBE-PATHNAME instead of DIRECTORY to probe for a directory
(load): accept :IGNORE-PATHNAME-DEFAULTS and pass it to OPEN-FOR-LOAD;
pathname merging is done in OPEN-FOR-LOAD
(search-file): call PATHNAME instead of MERGE-PATHNAMES on the
argument to avoid being killed by *DEFAULT-PATHNAME-DEFAULTS*
* src/defs1.lisp (with-augmented-load-path): do not use UNION since
the augmentations must come first in *LOAD-PATHS*
(simple-require): pass :IGNORE-PATHNAME-DEFAULTS T to LOAD


Index: path.tst
===================================================================
RCS file: /cvsroot/clisp/clisp/tests/path.tst,v
retrieving revision 1.94
retrieving revision 1.95
diff -u -d -r1.94 -r1.95
--- path.tst	21 Oct 2010 17:13:55 -0000	1.94
+++ path.tst	10 Dec 2010 20:05:39 -0000	1.95
@@ -1349,6 +1349,32 @@
     (rmrf dir)))
 #+(and clisp unicode) (1234 T)
 
+#+clisp ;; bug#3124200
+(let* ((dir "tmp-dir/")
+       (file (ext:string-concat dir "foo.lisp")))
+  (ext:make-directory dir)
+  (with-open-file (out file :direction :output)
+    (write-line "(defparameter *load-var* 100)" out))
+  (unwind-protect
+       (list (load "foo" :if-does-not-exist nil)
+             (equalp (load file) (truename file)) *load-var*
+             (let ((*load-paths* (list dir)))
+               (setq *load-var* 3) (load "foo") *load-var*)
+             (let ((*load-paths* (list dir))
+                   (*default-pathname-defaults* (ext:cd)))
+               (setq *load-var* 3) (load "foo" :if-does-not-exist nil) *load-var*)
+             (block nil
+               (handler-bind ((file-error (lambda (c) (princ c) (return 'file-error))))
+                 (require "foo")))
+             (let ((*load-paths* (list dir)))
+               (setq *load-var* 3) (require "foo") *load-var*)
+             (let ((*load-paths* (list dir))
+                   (*default-pathname-defaults* (ext:cd)))
+               (setq *load-var* 3) (require "foo") *load-var*))
+    (delete-file file)
+    (ext:delete-directory dir)))
+#+clisp (NIL T 100 100 3 FILE-ERROR 100 100)
+
 (progn
   (symbol-cleanup '*dir*)
   (symbol-cleanup 'a)

Index: ChangeLog
===================================================================
RCS file: /cvsroot/clisp/clisp/tests/ChangeLog,v
retrieving revision 1.672
retrieving revision 1.673
diff -u -d -r1.672 -r1.673
--- ChangeLog	29 Nov 2010 21:42:49 -0000	1.672
+++ ChangeLog	10 Dec 2010 20:05:39 -0000	1.673
@@ -1,3 +1,8 @@
+2010-12-10  Sam Steingold  <sd...@gn...>
+
+	* path.tst: add a test for bug#3124200:
+	setting *DEFAULT-PATHNAME-DEFAULTS* breaks REQUIRE
+
 2010-11-29  Sam Steingold  <sd...@gn...>
 
 	* streams.tst: add a test for bug#3122505: LOAD bad FAS




------------------------------

Message: 3
Date: Fri, 10 Dec 2010 20:05:41 +0000
From: Sam Steingold <sd...@us...>
Subject: clisp/src ChangeLog, 1.7585, 1.7586 NEWS, 1.552, 1.553
	defs1.lisp,	1.82, 1.83 init.lisp, 1.303, 1.304
To: cli...@li...
Message-ID: <E1P...@sf...>

Update of /cvsroot/clisp/clisp/src
In directory sfp-cvsdas-2.v30.ch3.sourceforge.com:/tmp/cvs-serv20902/src

Modified Files:
	ChangeLog NEWS defs1.lisp init.lisp 
Log Message:
Fix bug#3124200: setting *DEFAULT-PATHNAME-DEFAULTS* breaks REQUIRE
* src/init.lisp (open-for-load): accept ignore-pathname-defaults and
do not call MERGE-PATHNAMES if it is non-NIL;
use PROBE-PATHNAME instead of DIRECTORY to probe for a directory
(load): accept :IGNORE-PATHNAME-DEFAULTS and pass it to OPEN-FOR-LOAD;
pathname merging is done in OPEN-FOR-LOAD
(search-file): call PATHNAME instead of MERGE-PATHNAMES on the
argument to avoid being killed by *DEFAULT-PATHNAME-DEFAULTS*
* src/defs1.lisp (with-augmented-load-path): do not use UNION since
the augmentations must come first in *LOAD-PATHS*
(simple-require): pass :IGNORE-PATHNAME-DEFAULTS T to LOAD


Index: NEWS
===================================================================
RCS file: /cvsroot/clisp/clisp/src/NEWS,v
retrieving revision 1.552
retrieving revision 1.553
diff -u -d -r1.552 -r1.553
--- NEWS	25 Nov 2010 17:03:48 -0000	1.552
+++ NEWS	10 Dec 2010 20:05:39 -0000	1.553
@@ -2,8 +2,7 @@
 ---------------
 
 * All .fas files generated by previous CLISP versions are invalid and
-  must be recompiled.  This is because the Just-In-Time Compiled code is
-  kept with the closures.
+  must be recompiled (this was made necessary by the fix to bug#3040648).
   Set CUSTOM:*LOAD-OBSOLETE-ACTION* to :COMPILE to automate this.
   See <http://clisp.cons.org/impnotes/system-dict.html#loadfile> for details.
 
@@ -48,6 +47,8 @@
   + Fix PROBE-PATHNAME behavior on win32 and on open file streams (bug#3087668).
   + Fix handling of huge byte arrays on 64-bit platforms (bug#3088751).
   + Macro LOOP now detects incomplete FOR clauses (bug#3089988).
+  + Fix LOADing corrupt FAS files (bug#3122505).
+  + Fix interaction of *DEFAULT-PATHNAME-DEFAULTS* with REQUIRE (bug#3124200).
 
 
 2.49 (2010-07-07)

Index: init.lisp
===================================================================
RCS file: /cvsroot/clisp/clisp/src/init.lisp,v
retrieving revision 1.303
retrieving revision 1.304
diff -u -d -r1.303 -r1.304
--- init.lisp	2 Dec 2010 00:22:33 -0000	1.303
+++ init.lisp	10 Dec 2010 20:05:39 -0000	1.304
@@ -1584,6 +1584,7 @@
   (sys::%putd 'ext::muffle-cerrors #'identity))
 
 (defun open-for-load (filename extra-file-types external-format
+                      ignore-pathname-defaults
                       &aux stream (present-files t) obj path bad-file)
  (block open-for-load
   (when (and (streamp filename)
@@ -1615,15 +1616,14 @@
                       (bad last-p stream (TEXT "~S: compiled file ~A has a corrupt version marker ~S")))
                   (or (equal (system::version) (eval (second obj)))
                       (bad last-p stream (TEXT "~S: compiled file ~A was created by an older CLISP version and needs to be recompiled"))))))
-    (setq filename (pathname filename)
-          ;; appending "/" to a logical pathname makes it invalid
-          path (if (logical-pathname-p filename)
-                   (translate-logical-pathname filename)
-                   filename))
+    (setq filename (if ignore-pathname-defaults
+                       (pathname filename) (merge-pathnames filename))
+          path filename)
     ;; (OPEN "foo") errors out if we do (LOAD "foo")
     ;; and both "foo.lisp" and "foo/" are present
-    (unless (directory (string-concat (namestring path) "/"))
-      (setq stream (my-open path)))
+    (let ((truename? (probe-pathname path)))
+      (unless (and truename? (null (pathname-name truename?)))
+        (setq stream (my-open path))))
     (tagbody proceed
       (when (and stream
                  (if (compiledp stream)
@@ -1726,9 +1726,11 @@
                   ((:obsolete-action *load-obsolete-action*)
                    *load-obsolete-action*)
                   (extra-file-types '())
+                  (ignore-pathname-defaults nil)
              &aux stream)
   (multiple-value-setq (stream filename)
-    (open-for-load filename extra-file-types external-format))
+    (open-for-load filename extra-file-types external-format
+                   ignore-pathname-defaults))
   (if (null stream)
     (if if-does-not-exist
       (error-of-type 'file-error
@@ -1743,7 +1745,7 @@
            (*load-level* (1+ *load-level*))
            (*load-input-stream* input-stream)
            (*load-pathname*
-            (if (pathnamep filename) (merge-pathnames filename) nil))
+            (if (pathnamep filename) filename nil))
            (*load-truename*
              (if (pathnamep filename) (truename filename) nil))
            (*current-source-file* *load-truename*)
@@ -2176,7 +2178,12 @@
   ;; starting up (unless -norc or -E 1:1 is passed)
   ;; because (DIRECTORY "~/*") fails
   (let* ((already-searched nil) found
-         (path-nonW (merge-pathnames filename))
+         ;; not (merge-pathnames filename) because filename can come
+         ;; from `load-logical-pathname-translations' or `require'
+         ;; and must be searched in "implementation-defined" locations
+         ;; while `*default-pathname-defaults*' may contain a directore
+         ;; which would preclude searching
+         (path-nonW (pathname filename))
          (path-wild (if (pathname-name path-nonW)
                         (merge-pathnames path-nonW '#P"*.*")
                         ;; do not append *.* to directories

Index: ChangeLog
===================================================================
RCS file: /cvsroot/clisp/clisp/src/ChangeLog,v
retrieving revision 1.7585
retrieving revision 1.7586
diff -u -d -r1.7585 -r1.7586
--- ChangeLog	10 Dec 2010 17:01:12 -0000	1.7585
+++ ChangeLog	10 Dec 2010 20:05:39 -0000	1.7586
@@ -1,7 +1,21 @@
 2010-12-10  Sam Steingold  <sd...@gn...>
 
+	Fix bug#3124200: setting *DEFAULT-PATHNAME-DEFAULTS* breaks REQUIRE
+	* init.lisp (open-for-load): accept ignore-pathname-defaults and
+	do not call MERGE-PATHNAMES if it is non-NIL;
+	use PROBE-PATHNAME instead of DIRECTORY to probe for a directory
+	(load): ccept :IGNORE-PATHNAME-DEFAULTS and pass it to OPEN-FOR-LOAD;
+	pathname merging is done in OPEN-FOR-LOAD
+	(search-file): call PATHNAME instead of MERGE-PATHNAMES on the
+	argument to avoid being killed by *DEFAULT-PATHNAME-DEFAULTS*
+	* defs1.lisp (with-augmented-load-path): do not use UNION since
+	the augmentations must come first in *LOAD-PATHS*
+	(simple-require): pass :IGNORE-PATHNAME-DEFAULTS T to LOAD
+
+2010-12-10  Sam Steingold  <sd...@gn...>
+
 	* modules/asdf/asdf.lisp: update to upstream "2.011"
-	* src/gmalloc.c: update to upstream
+	* src/gmalloc.c: update from upstream (emacs)
 
 2010-12-10  Sam Steingold  <sd...@gn...>
 

Index: defs1.lisp
===================================================================
RCS file: /cvsroot/clisp/clisp/src/defs1.lisp,v
retrieving revision 1.82
retrieving revision 1.83
diff -u -d -r1.82 -r1.83
--- defs1.lisp	2 Dec 2010 23:33:49 -0000	1.82
+++ defs1.lisp	10 Dec 2010 20:05:39 -0000	1.83
@@ -169,11 +169,13 @@
                               :defaults *compile-file-pathname*)))))
 
 (defmacro with-augmented-load-path (dirs &body body)
-  `(let ((*load-paths*
-          ;; the name "dynmod/" used here should be in sync with clisp-link
-          (union *load-paths*
-                 ,(if dirs `(list ,@dirs) '(load-path-augmentations "dynmod/"))
-                 :test #+win32 #'equalp #-win32 #'equal)))
+  `(let ((*load-paths* *load-paths*))
+     ;; cannot use UNION because DIRS must come _first_ in *LOAD-PATHS*
+     ;; the name "dynmod/" used here should be in sync with clisp-link
+     (dolist (path ,(if dirs
+                        `(list ,@dirs)
+                        '(load-path-augmentations "dynmod/")))
+          (pushnew path *load-paths* :test #+win32 #'equalp #-win32 #'equal))
      ,@body))
 
 (defvar *module-provider-functions* '()
@@ -181,7 +183,9 @@
 
 (defun simple-require (pathname)
   (with-augmented-load-path ()
-    (if (atom pathname) (load pathname) (mapcar #'load pathname))))
+    (if (atom pathname)
+        (load pathname :ignore-pathname-defaults t)
+        (mapcar (lambda (p) (load p :ignore-pathname-defaults t)) pathname))))
 
 (defun require (module-name &optional (pathname nil p-given))
   (setq module-name (module-name module-name))




------------------------------

------------------------------------------------------------------------------
Oracle to DB2 Conversion Guide: Learn learn about native support for PL/SQL,
new data types, scalar functions, improved concurrency, built-in packages, 
OCI, SQL*Plus, data movement tools, best practices and more.
http://p.sf.net/sfu/oracle-sfdev2dev 

------------------------------

_______________________________________________
clisp-cvs mailing list
cli...@li...
https://lists.sourceforge.net/lists/listinfo/clisp-cvs


End of clisp-cvs Digest, Vol 56, Issue 5
****************************************

clisp-cvs Digest, Vol 56, Issue 3

[<cli...@li...>]

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/doc impbody.xml,1.615,1.616 (Sam Steingold)


----------------------------------------------------------------------

Message: 1
Date: Tue, 07 Dec 2010 22:23:46 +0000
From: Sam Steingold <sd...@us...>
Subject: clisp/doc impbody.xml,1.615,1.616
To: cli...@li...
Message-ID: <E1P...@sf...>

Update of /cvsroot/clisp/clisp/doc
In directory sfp-cvsdas-2.v30.ch3.sourceforge.com:/tmp/cvs-serv11728

Modified Files:
	impbody.xml 
Log Message:
typos


Index: impbody.xml
===================================================================
RCS file: /cvsroot/clisp/clisp/doc/impbody.xml,v
retrieving revision 1.615
retrieving revision 1.616
diff -u -d -r1.615 -r1.616
--- impbody.xml	25 Nov 2010 16:29:44 -0000	1.615
+++ impbody.xml	7 Dec 2010 22:23:44 -0000	1.616
@@ -501,7 +501,7 @@
  was <emphasis>interpreted</emphasis>.
  Whenever <function>ADD-I-10</function> is executed, its definition is
  interpreted all over again.  Before &defvar;, &value-r; is evaluated as
- a lexical (because is is &not-e; declared &special-dec; yet), but after
+ a lexical (because it is &not-e; declared &special-dec; yet), but after
  &defvar;, we see a globally &special-dec; symbol &value-r; which
  can have only a global &symbol-value; (not a local binding), and thus
  we are compelled to evaluate it to <returnvalue>12</returnvalue>.</para>
@@ -4296,7 +4296,7 @@
       </simpara></listitem><listitem><simpara>
         <quote role="format">First line.~%Second line.~%~%</quote>
  </simpara></listitem></orderedlist></listitem></orderedlist></para></listitem>
- <listitem><simpara>Is is possible to optimize away blank lines?
+ <listitem><simpara>Is it possible to optimize away blank lines?
    I.e. is it possible to avoid a blank line even though another piece
    of code uses one of A1 ... C2, without risking that adjacent lines be
    unseparated?</simpara></listitem>
@@ -4503,7 +4503,7 @@
 <warning id="stream-eltype-stdio"><simpara>&clisp; expects to be able to
   do &character-t; i/o on standard streams like &terminal-io-var;,
   &standard-output-var;, &standard-input-var;, &error-output-var;,
-  &query-io-var; et al, thus is is a &very-e; bad idea
+  &query-io-var; et al, thus it is a &very-e; bad idea
   to change their &stream-element-type; even when you can. Use
   &make-stream; instead, see <xref linkend="bin-stdio"/>.</simpara></warning>
 




------------------------------

------------------------------------------------------------------------------
What happens now with your Lotus Notes apps - do you make another costly 
upgrade, or settle for being marooned without product support? Time to move
off Lotus Notes and onto the cloud with Force.com, apps are easier to build,
use, and manage than apps on traditional platforms. Sign up for the Lotus 
Notes Migration Kit to learn more. http://p.sf.net/sfu/salesforce-d2d

------------------------------

_______________________________________________
clisp-cvs mailing list
cli...@li...
https://lists.sourceforge.net/lists/listinfo/clisp-cvs


End of clisp-cvs Digest, Vol 56, Issue 3
****************************************

clisp-cvs Digest, Vol 56, Issue 2

[<cli...@li...>]

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.7581,1.7582 defs1.lisp,1.81,1.82
      (Sam Steingold)


----------------------------------------------------------------------

Message: 1
Date: Thu, 02 Dec 2010 23:33:51 +0000
From: Sam Steingold <sd...@us...>
Subject: clisp/src ChangeLog,1.7581,1.7582 defs1.lisp,1.81,1.82
To: cli...@li...
Message-ID: <E1P...@sf...>

Update of /cvsroot/clisp/clisp/src
In directory sfp-cvsdas-2.v30.ch3.sourceforge.com:/tmp/cvs-serv14165/src

Modified Files:
	ChangeLog defs1.lisp 
Log Message:
* src/defs1.lisp (load-path-augmentations): delete NILs
(augment-load-path): remove
(with-augmented-load-path): use UNION instead of AUGMENT-LOAD-PATH
to avoid modifying the global value of *LOAD-PATHS*


Index: ChangeLog
===================================================================
RCS file: /cvsroot/clisp/clisp/src/ChangeLog,v
retrieving revision 1.7581
retrieving revision 1.7582
diff -u -d -r1.7581 -r1.7582
--- ChangeLog	2 Dec 2010 01:16:04 -0000	1.7581
+++ ChangeLog	2 Dec 2010 23:33:49 -0000	1.7582
@@ -1,3 +1,10 @@
+2010-12-02  Sam Steingold  <sd...@gn...>
+
+	* defs1.lisp (load-path-augmentations): delete NILs
+	(augment-load-path): remove
+	(with-augmented-load-path): use UNION instead of AUGMENT-LOAD-PATH
+	to avoid modifying the global value of *LOAD-PATHS*
+
 2010-12-01  Sam Steingold  <sd...@gn...>
 
 	* pathname.d (SET-LIB-DIRECTORY): call TRUENAME on argument to

Index: defs1.lisp
===================================================================
RCS file: /cvsroot/clisp/clisp/src/defs1.lisp,v
retrieving revision 1.81
retrieving revision 1.82
diff -u -d -r1.81 -r1.82
--- defs1.lisp	14 Nov 2010 16:02:41 -0000	1.81
+++ defs1.lisp	2 Dec 2010 23:33:49 -0000	1.82
@@ -157,25 +157,23 @@
 (defvar *user-lib-directory* nil
   "The location of user-installed modules.")
 
-(defun augment-load-path (paths)
-  (dolist (path paths *load-paths*)
-    (when path (setq *load-paths* (adjoin path *load-paths* :test #'equal)))))
-
 (defun load-path-augmentations (dynmod)
-  (list (merge-pathnames dynmod *lib-directory*)
-        (and *user-lib-directory*
-             (merge-pathnames dynmod *user-lib-directory*))
-        (and *load-pathname* ; not truename to respect symlinks
-             (make-pathname :name nil :type nil :defaults *load-pathname*))
-        (and *compile-file-pathname* ; could be called by eval-when-compile
-             (make-pathname :name nil :type nil
-                            :defaults *compile-file-pathname*))))
+  (delete nil
+    (list (merge-pathnames dynmod *lib-directory*)
+          (and *user-lib-directory*
+               (merge-pathnames dynmod *user-lib-directory*))
+          (and *load-pathname* ; not truename to respect symlinks
+               (make-pathname :name nil :type nil :defaults *load-pathname*))
+          (and *compile-file-pathname* ; could be called by eval-when-compile
+               (make-pathname :name nil :type nil
+                              :defaults *compile-file-pathname*)))))
 
 (defmacro with-augmented-load-path (dirs &body body)
   `(let ((*load-paths*
           ;; the name "dynmod/" used here should be in sync with clisp-link
-          (augment-load-path
-           ,(if dirs `(list ,@dirs) '(load-path-augmentations "dynmod/")))))
+          (union *load-paths*
+                 ,(if dirs `(list ,@dirs) '(load-path-augmentations "dynmod/"))
+                 :test #+win32 #'equalp #-win32 #'equal)))
      ,@body))
 
 (defvar *module-provider-functions* '()




------------------------------

------------------------------------------------------------------------------
Increase Visibility of Your 3D Game App & Earn a Chance To Win $500!
Tap into the largest installed PC base & get more eyes on your game by
optimizing for Intel(R) Graphics Technology. Get started today with the
Intel(R) Software Partner Program. Five $500 cash prizes are up for grabs.
http://p.sf.net/sfu/intelisp-dev2dev

------------------------------

_______________________________________________
clisp-cvs mailing list
cli...@li...
https://lists.sourceforge.net/lists/listinfo/clisp-cvs


End of clisp-cvs Digest, Vol 56, Issue 2
****************************************

clisp-cvs Digest, Vol 56, Issue 1

[<cli...@li...>]

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 init.lisp,1.302,1.303 (Sam Steingold)
   2. clisp/src ChangeLog,1.7580,1.7581 pathname.d,1.526,1.527
      (Sam Steingold)


----------------------------------------------------------------------

Message: 1
Date: Thu, 02 Dec 2010 00:22:35 +0000
From: Sam Steingold <sd...@us...>
Subject: clisp/src init.lisp,1.302,1.303
To: cli...@li...
Message-ID: <E1P...@sf...>

Update of /cvsroot/clisp/clisp/src
In directory sfp-cvsdas-2.v30.ch3.sourceforge.com:/tmp/cvs-serv3850

Modified Files:
	init.lisp 
Log Message:
remove junk mistakenly committed in 1.297


Index: init.lisp
===================================================================
RCS file: /cvsroot/clisp/clisp/src/init.lisp,v
retrieving revision 1.302
retrieving revision 1.303
diff -u -d -r1.302 -r1.303
--- init.lisp	29 Nov 2010 21:42:49 -0000	1.302
+++ init.lisp	2 Dec 2010 00:22:33 -0000	1.303
@@ -1749,8 +1749,6 @@
            (*current-source-file* *load-truename*)
            (*current-source-line-1* nil)
            (*current-source-line-2* nil)
-           ;; allow reference sharing between forms in the file
-           (SYS::*READ-REFERENCE-TABLE* NIL) ; cf. compiler.lisp:compile-file
            #+ffi (ffi::*foreign-language* ffi::*foreign-language*)
            #+ffi (ffi::*foreign-library* ffi::*foreign-library*)
            (*package* *package*) ; bind *PACKAGE*




------------------------------

Message: 2
Date: Thu, 02 Dec 2010 01:16:07 +0000
From: Sam Steingold <sd...@us...>
Subject: clisp/src ChangeLog,1.7580,1.7581 pathname.d,1.526,1.527
To: cli...@li...
Message-ID: <E1P...@sf...>

Update of /cvsroot/clisp/clisp/src
In directory sfp-cvsdas-2.v30.ch3.sourceforge.com:/tmp/cvs-serv14006/src

Modified Files:
	ChangeLog pathname.d 
Log Message:
* src/pathname.d (SET-LIB-DIRECTORY): call TRUENAME on argument to
ensure an existing absolute path


Index: pathname.d
===================================================================
RCS file: /cvsroot/clisp/clisp/src/pathname.d,v
retrieving revision 1.526
retrieving revision 1.527
diff -u -d -r1.526 -r1.527
--- pathname.d	21 Oct 2010 15:35:24 -0000	1.526
+++ pathname.d	2 Dec 2010 01:16:05 -0000	1.527
@@ -9209,9 +9209,8 @@
 LISPFUNN(set_lib_directory,1)
 { /* (SYS::SET-LIB-DIRECTORY path) sets the CLISP's private library directory
   (called $(lisplibdir) in the Makefile) */
-  var object path = popSTACK();
-  if (stringp(path)) path = ensure_last_slash(path);
-  VALUES1(O(lib_dir) = coerce_xpathname(path));
+  if (stringp(STACK_0)) STACK_0 = ensure_last_slash(STACK_0);
+  funcall(L(truename),1); O(lib_dir) = value1;
 }
 
 /* ===================================================================== */

Index: ChangeLog
===================================================================
RCS file: /cvsroot/clisp/clisp/src/ChangeLog,v
retrieving revision 1.7580
retrieving revision 1.7581
diff -u -d -r1.7580 -r1.7581
--- ChangeLog	29 Nov 2010 21:42:49 -0000	1.7580
+++ ChangeLog	2 Dec 2010 01:16:04 -0000	1.7581
@@ -1,3 +1,8 @@
+2010-12-01  Sam Steingold  <sd...@gn...>
+
+	* pathname.d (SET-LIB-DIRECTORY): call TRUENAME on argument to
+	ensure an existing absolute path
+
 2010-11-29  Sam Steingold  <sd...@gn...>
 
 	fix bug#3122505: LOAD does not close FAS files with a bad version marker




------------------------------

------------------------------------------------------------------------------
Increase Visibility of Your 3D Game App & Earn a Chance To Win $500!
Tap into the largest installed PC base & get more eyes on your game by
optimizing for Intel(R) Graphics Technology. Get started today with the
Intel(R) Software Partner Program. Five $500 cash prizes are up for grabs.
http://p.sf.net/sfu/intelisp-dev2dev

------------------------------

_______________________________________________
clisp-cvs mailing list
cli...@li...
https://lists.sourceforge.net/lists/listinfo/clisp-cvs


End of clisp-cvs Digest, Vol 56, Issue 1
****************************************

clisp-cvs Digest, Vol 55, Issue 10

[<cli...@li...>]

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.7579,1.7580 init.lisp,1.301,1.302
      (Sam Steingold)
   2. clisp/tests ChangeLog,1.671,1.672 streams.tst,1.63,1.64
      (Sam Steingold)


----------------------------------------------------------------------

Message: 1
Date: Mon, 29 Nov 2010 21:42:51 +0000
From: Sam Steingold <sd...@us...>
Subject: clisp/src ChangeLog,1.7579,1.7580 init.lisp,1.301,1.302
To: cli...@li...
Message-ID: <E1P...@sf...>

Update of /cvsroot/clisp/clisp/src
In directory sfp-cvsdas-2.v30.ch3.sourceforge.com:/tmp/cvs-serv31947/src

Modified Files:
	ChangeLog init.lisp 
Log Message:
fix bug#3122505: LOAD does not close FAS files with a bad version marker
* src/init.lisp (open-for-load): catch errors when READing the version marker


Index: init.lisp
===================================================================
RCS file: /cvsroot/clisp/clisp/src/init.lisp,v
retrieving revision 1.301
retrieving revision 1.302
diff -u -d -r1.301 -r1.302
--- init.lisp	25 Nov 2010 17:03:48 -0000	1.301
+++ init.lisp	29 Nov 2010 21:42:49 -0000	1.302
@@ -1632,7 +1632,12 @@
                      (or (eq *load-obsolete-action* :error)
                          (eq present-files t)
                          (cdr present-files))
-                     (setq obj (read stream)))
+                     (setq obj
+                           #+compiler ; normal operation; handler-bind works
+                           (block nil
+                             (handler-bind ((error (lambda (c) (return c))))
+                               (read stream)))
+                           #-compiler (read stream))) ; bootstrap
                    #+compiler
                    (if (and bad-file (eq *load-obsolete-action* :compile))
                      ;; assume that BAD-FILE was compiled from STREAM

Index: ChangeLog
===================================================================
RCS file: /cvsroot/clisp/clisp/src/ChangeLog,v
retrieving revision 1.7579
retrieving revision 1.7580
diff -u -d -r1.7579 -r1.7580
--- ChangeLog	26 Nov 2010 17:12:17 -0000	1.7579
+++ ChangeLog	29 Nov 2010 21:42:49 -0000	1.7580
@@ -1,3 +1,9 @@
+2010-11-29  Sam Steingold  <sd...@gn...>
+
+	fix bug#3122505: LOAD does not close FAS files with a bad version marker
+	* init.lisp (open-for-load): catch errors when READing the version
+	marker
+
 2010-11-26  Sam Steingold  <sd...@gn...>
 
 	* constsym.d, subr.d, subrkw.d, stream.d (make_stream, stream_handles):




------------------------------

Message: 2
Date: Mon, 29 Nov 2010 21:42:52 +0000
From: Sam Steingold <sd...@us...>
Subject: clisp/tests ChangeLog,1.671,1.672 streams.tst,1.63,1.64
To: cli...@li...
Message-ID: <E1P...@sf...>

Update of /cvsroot/clisp/clisp/tests
In directory sfp-cvsdas-2.v30.ch3.sourceforge.com:/tmp/cvs-serv31947/tests

Modified Files:
	ChangeLog streams.tst 
Log Message:
fix bug#3122505: LOAD does not close FAS files with a bad version marker
* src/init.lisp (open-for-load): catch errors when READing the version marker


Index: ChangeLog
===================================================================
RCS file: /cvsroot/clisp/clisp/tests/ChangeLog,v
retrieving revision 1.671
retrieving revision 1.672
diff -u -d -r1.671 -r1.672
--- ChangeLog	30 Oct 2010 21:06:19 -0000	1.671
+++ ChangeLog	29 Nov 2010 21:42:49 -0000	1.672
@@ -1,3 +1,7 @@
+2010-11-29  Sam Steingold  <sd...@gn...>
+
+	* streams.tst: add a test for bug#3122505: LOAD bad FAS
+
 2010-10-31  Vladimir Tzankov  <vtz...@gm...>
 
 	* mt.tst: add tests for :TEST and :TIMEOUT arguments of EXEMPTION-WAIT

Index: streams.tst
===================================================================
RCS file: /cvsroot/clisp/clisp/tests/streams.tst,v
retrieving revision 1.63
retrieving revision 1.64
diff -u -d -r1.63 -r1.64
--- streams.tst	20 Sep 2010 20:40:23 -0000	1.63
+++ streams.tst	29 Nov 2010 21:42:49 -0000	1.64
@@ -1246,6 +1246,21 @@
     (assert (load s :verbose nil))))
 "1234"
 
+;; https://sourceforge.net/tracker/?func=detail&atid=101355&aid=3122505&group_id=1355
+(let* ((lisp "tmp.lisp") (fas (compile-file-pathname lisp)))
+  (unwind-protect
+       (progn
+         (with-open-file (s lisp :direction :output)
+           (write-line "1" s))
+         (with-open-file (s fas :direction :output)
+           (write-char #\Null s))
+         (handler-case (load fas)
+           (error (c) (princ-error c)))
+         (handler-case (equalp (compile-file lisp) (truename fas))
+           (error (c) (princ-error c))))
+    (post-compile-file-cleanup lisp)))
+T
+
 (progn
   (symbol-cleanup 's)
   (symbol-cleanup 's1)




------------------------------

------------------------------------------------------------------------------
Increase Visibility of Your 3D Game App & Earn a Chance To Win $500!
Tap into the largest installed PC base & get more eyes on your game by
optimizing for Intel(R) Graphics Technology. Get started today with the
Intel(R) Software Partner Program. Five $500 cash prizes are up for grabs.
http://p.sf.net/sfu/intelisp-dev2dev

------------------------------

_______________________________________________
clisp-cvs mailing list
cli...@li...
https://lists.sourceforge.net/lists/listinfo/clisp-cvs


End of clisp-cvs Digest, Vol 55, Issue 10
*****************************************

clisp-cvs Digest, Vol 55, Issue 9

[<cli...@li...>]

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/unix INSTALL,1.53,1.54 (Sam Steingold)
   2. clisp/src ChangeLog, 1.7578, 1.7579 constsym.d, 1.398, 1.399
      stream.d,	1.692, 1.693 subr.d, 1.280, 1.281 subrkw.d, 1.72, 1.73
      (Sam Steingold)


----------------------------------------------------------------------

Message: 1
Date: Fri, 26 Nov 2010 17:03:20 +0000
From: Sam Steingold <sd...@us...>
Subject: clisp/unix INSTALL,1.53,1.54
To: cli...@li...
Message-ID: <E1P...@sf...>

Update of /cvsroot/clisp/clisp/unix
In directory sfp-cvsdas-2.v30.ch3.sourceforge.com:/tmp/cvs-serv4042

Modified Files:
	INSTALL 
Log Message:
typo


Index: INSTALL
===================================================================
RCS file: /cvsroot/clisp/clisp/unix/INSTALL,v
retrieving revision 1.53
retrieving revision 1.54
diff -u -d -r1.53 -r1.54
--- INSTALL	14 Sep 2010 18:28:42 -0000	1.53
+++ INSTALL	26 Nov 2010 17:03:18 -0000	1.54
@@ -287,7 +287,7 @@
    E. Module selection: we recommend distributing at least asdf, rawsock, and
       wildcard, which have no external dependencies, i.e., modules "clisp-asdf",
       "clisp-rawsock", and "clisp-wildcard" depend only on "clisp".
-      Moreover, they can be bundled with "clisp" into a single module.
+      Moreover, they can be bundled with "clisp" into a single package.
    See also <http://clisp.cons.org/impnotes/modules.html#base-modules>
    and "./configure --help-modules".
 




------------------------------

Message: 2
Date: Fri, 26 Nov 2010 17:12:19 +0000
From: Sam Steingold <sd...@us...>
Subject: clisp/src ChangeLog, 1.7578, 1.7579 constsym.d, 1.398, 1.399
	stream.d,	1.692, 1.693 subr.d, 1.280, 1.281 subrkw.d, 1.72, 1.73
To: cli...@li...
Message-ID: <E1P...@sf...>

Update of /cvsroot/clisp/clisp/src
In directory sfp-cvsdas-2.v30.ch3.sourceforge.com:/tmp/cvs-serv6537/src

Modified Files:
	ChangeLog constsym.d stream.d subr.d subrkw.d 
Log Message:
* src/constsym.d, src/subr.d, src/subrkw.d, src/stream.d
(make_stream, stream_handles): define even when SOCKET_STREAMS is not defined


Index: subrkw.d
===================================================================
RCS file: /cvsroot/clisp/clisp/src/subrkw.d,v
retrieving revision 1.72
retrieving revision 1.73
diff -u -d -r1.72 -r1.73
--- subrkw.d	30 Oct 2010 21:02:59 -0000	1.72
+++ subrkw.d	26 Nov 2010 17:12:17 -0000	1.73
@@ -1,7 +1,7 @@
 /*
  * List of all the SUBRs with Keywords
  * Bruno Haible 1990-2004
- * Sam Steingold 1998-2009
+ * Sam Steingold 1998-2010
  */
 
 v(7, (kw(adjustable),kw(element_type),kw(initial_element),
@@ -201,11 +201,11 @@
 v(4, (kw(element_type),kw(external_format),kw(buffered),kw(timeout)) )
 s(socket_accept)
 s(socket_connect)
-v(4, (kw(direction),kw(element_type),kw(external_format),kw(buffered)) )
-s(make_stream)
 v(2, (kw(backlog),kw(interface)) )
 s(socket_server)
 #endif
+v(4, (kw(direction),kw(element_type),kw(external_format),kw(buffered)) )
+s(make_stream)
 v(1, (kw(abort)) )
 s(built_in_stream_close)
 #ifdef DYNAMIC_FFI

Index: subr.d
===================================================================
RCS file: /cvsroot/clisp/clisp/src/subr.d,v
retrieving revision 1.280
retrieving revision 1.281
diff -u -d -r1.280 -r1.281
--- subr.d	14 Nov 2010 16:02:41 -0000	1.280
+++ subr.d	26 Nov 2010 17:12:17 -0000	1.281
@@ -1,7 +1,7 @@
 /*
  * list of all SUBRs
  * Bruno Haible 1990-2006
- * Sam Steingold 1998-2009
+ * Sam Steingold 1998-2010
 
  A C-compiled LISP-function is defined by a declaration
  LISPFUN(name,seclass,req_count,opt_count,rest_flag,key_flag,key_count,keywords)
@@ -1226,10 +1226,10 @@
 #ifdef HAVE_SHUTDOWN
 LISPFUNN(socket_stream_shutdown,2)
 #endif
+#endif
 LISPFUN(make_stream,seclass_default,1,0,norest,key,4,
         (kw(direction),kw(element_type),kw(external_format),kw(buffered)) )
 LISPFUNN(stream_handles,1)
-#endif
 LISPFUNNR(built_in_stream_open_p,1)
 LISPFUNNR(input_stream_p,1)
 LISPFUNNR(output_stream_p,1)

Index: constsym.d
===================================================================
RCS file: /cvsroot/clisp/clisp/src/constsym.d,v
retrieving revision 1.398
retrieving revision 1.399
diff -u -d -r1.398 -r1.399
--- constsym.d	25 Nov 2010 17:03:48 -0000	1.398
+++ constsym.d	26 Nov 2010 17:12:17 -0000	1.399
@@ -1008,9 +1008,9 @@
 #ifdef HAVE_SHUTDOWN
 LISPSYM(socket_stream_shutdown,"SOCKET-STREAM-SHUTDOWN",socket)
 #endif
+#endif
 LISPSYM(make_stream,"MAKE-STREAM",ext)
 LISPSYM(stream_handles,"STREAM-HANDLES",ext)
-#endif
 LISPSYM(built_in_stream_open_p,"BUILT-IN-STREAM-OPEN-P",system)
 LISPSYM(input_stream_p,"INPUT-STREAM-P",lisp)
 LISPSYM(output_stream_p,"OUTPUT-STREAM-P",lisp)

Index: stream.d
===================================================================
RCS file: /cvsroot/clisp/clisp/src/stream.d,v
retrieving revision 1.692
retrieving revision 1.693
diff -u -d -r1.692 -r1.693
--- stream.d	21 Oct 2010 18:42:17 -0000	1.692
+++ stream.d	26 Nov 2010 17:12:17 -0000	1.693
@@ -14806,14 +14806,6 @@
   publish_host_data (&socket_getlocalname);
 }
 
-LISPFUNN(stream_handles,1)
-{ /* (STREAM-HANDLES stream) */
-  var SOCKET in_sock=INVALID_SOCKET, out_sock=INVALID_SOCKET;
-  stream_handles(popSTACK(),false,NULL,&in_sock,&out_sock);
-  VALUES2(in_sock  == INVALID_SOCKET ? NIL : fixnum(in_sock),
-          out_sock == INVALID_SOCKET ? NIL : fixnum(out_sock));
-}
-
 #ifdef HAVE_SHUTDOWN
 
 /* close a socket stream using shutdown(2)
@@ -15073,6 +15065,14 @@
   return make_file_stream(dir,false,dir == DIRECTION_IO);
 }
 
+LISPFUNN(stream_handles,1)
+{ /* (STREAM-HANDLES stream) */
+  var SOCKET in_sock=INVALID_SOCKET, out_sock=INVALID_SOCKET;
+  stream_handles(popSTACK(),false,NULL,&in_sock,&out_sock);
+  VALUES2(in_sock  == INVALID_SOCKET ? NIL : fixnum(in_sock),
+          out_sock == INVALID_SOCKET ? NIL : fixnum(out_sock));
+}
+
 LISPFUN(make_stream,seclass_default,1,0,norest,key,4,
         (kw(direction),kw(element_type),kw(external_format),kw(buffered)) )
 {

Index: ChangeLog
===================================================================
RCS file: /cvsroot/clisp/clisp/src/ChangeLog,v
retrieving revision 1.7578
retrieving revision 1.7579
diff -u -d -r1.7578 -r1.7579
--- ChangeLog	25 Nov 2010 17:03:48 -0000	1.7578
+++ ChangeLog	26 Nov 2010 17:12:17 -0000	1.7579
@@ -1,3 +1,8 @@
+2010-11-26  Sam Steingold  <sd...@gn...>
+
+	* constsym.d, subr.d, subrkw.d, stream.d (make_stream, stream_handles):
+	define even when SOCKET_STREAMS is not defined
+
 2010-11-25  Sam Steingold  <sd...@gn...>
 
 	* init.lisp, constsym.d (stream-handles): move from SOCKET to EXT




------------------------------

------------------------------------------------------------------------------
Increase Visibility of Your 3D Game App & Earn a Chance To Win $500!
Tap into the largest installed PC base & get more eyes on your game by
optimizing for Intel(R) Graphics Technology. Get started today with the
Intel(R) Software Partner Program. Five $500 cash prizes are up for grabs.
http://p.sf.net/sfu/intelisp-dev2dev

------------------------------

_______________________________________________
clisp-cvs mailing list
cli...@li...
https://lists.sourceforge.net/lists/listinfo/clisp-cvs


End of clisp-cvs Digest, Vol 55, Issue 9
****************************************

clisp-cvs Digest, Vol 55, Issue 8

[<cli...@li...>]

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/berkeley-db berkeley-db.xml,1.64,1.65
      (Sam Steingold)
   2. clisp/doc impbody.xml,1.614,1.615 (Sam Steingold)
   3. clisp/src ChangeLog, 1.7577, 1.7578 NEWS, 1.551, 1.552
      constsym.d,	1.397, 1.398 init.lisp, 1.300, 1.301 (Sam Steingold)


----------------------------------------------------------------------

Message: 1
Date: Thu, 25 Nov 2010 16:23:29 +0000
From: Sam Steingold <sd...@us...>
Subject: clisp/modules/berkeley-db berkeley-db.xml,1.64,1.65
To: cli...@li...
Message-ID: <E1P...@sf...>

Update of /cvsroot/clisp/clisp/modules/berkeley-db
In directory sfp-cvsdas-2.v30.ch3.sourceforge.com:/tmp/cvs-serv6220

Modified Files:
	berkeley-db.xml 
Log Message:
use &file-des;


Index: berkeley-db.xml
===================================================================
RCS file: /cvsroot/clisp/clisp/modules/berkeley-db/berkeley-db.xml,v
retrieving revision 1.64
retrieving revision 1.65
diff -u -d -r1.64 -r1.65
--- berkeley-db.xml	18 May 2010 21:20:32 -0000	1.64
+++ berkeley-db.xml	25 Nov 2010 16:23:27 -0000	1.65
@@ -348,7 +348,7 @@
    (<function role="bdb">DB-&gt;del</function>).
 </simpara></listitem></varlistentry>
 <varlistentry><term><code>(BDB:DB-FD db)</code></term>
- <listitem><simpara>Return a file descriptor from a database
+ <listitem><simpara>Return the &file-des; for the database
    (<function role="bdb">DB-&gt;fd</function>).
 </simpara></listitem></varlistentry>
 <varlistentry><term><code>(BDB:DB-GET db key &key-amp; ACTION AUTO-COMMIT




------------------------------

Message: 2
Date: Thu, 25 Nov 2010 16:29:46 +0000
From: Sam Steingold <sd...@us...>
Subject: clisp/doc impbody.xml,1.614,1.615
To: cli...@li...
Message-ID: <E1P...@sf...>

Update of /cvsroot/clisp/clisp/doc
In directory sfp-cvsdas-2.v30.ch3.sourceforge.com:/tmp/cvs-serv7775

Modified Files:
	impbody.xml 
Log Message:
(stream-handles): add


Index: impbody.xml
===================================================================
RCS file: /cvsroot/clisp/clisp/doc/impbody.xml,v
retrieving revision 1.614
retrieving revision 1.615
diff -u -d -r1.614 -r1.615
--- impbody.xml	5 Nov 2010 13:38:36 -0000	1.614
+++ impbody.xml	25 Nov 2010 16:29:44 -0000	1.615
@@ -4778,6 +4778,19 @@
 </para></formalpara>
 </section>
 
+<section id="stream-handles"><title>Function
+  <function>EXT:STREAM-HANDLES</function></title>
+
+<para>The function <code>(EXT:STREAM-HANDLES &stream-r;)</code> returns
+two values:<orderedlist>
+<listitem><simpara>The OS &file-des; for the &input-s; side of the
+&stream-r;, or &nil; if the &stream-r; is an &output-s;-only &stream-t;
+or if there is no &file-des; associated with it.</simpara></listitem>
+<listitem><simpara>The OS &file-des; for the &output-s; side of the
+&stream-r;, or &nil; if the &stream-r; is an &input-s;-only &stream-t;
+or if there is no &file-des; associated with it.</simpara></listitem>
+</orderedlist></para></section>
+
 </chapter>
 
 




------------------------------

Message: 3
Date: Thu, 25 Nov 2010 17:03:50 +0000
From: Sam Steingold <sd...@us...>
Subject: clisp/src ChangeLog, 1.7577, 1.7578 NEWS, 1.551, 1.552
	constsym.d,	1.397, 1.398 init.lisp, 1.300, 1.301
To: cli...@li...
Message-ID: <E1P...@sf...>

Update of /cvsroot/clisp/clisp/src
In directory sfp-cvsdas-2.v30.ch3.sourceforge.com:/tmp/cvs-serv18424/src

Modified Files:
	ChangeLog NEWS constsym.d init.lisp 
Log Message:
* src/init.lisp, src/constsym.d (stream-handles): move from SOCKET to EXT


Index: init.lisp
===================================================================
RCS file: /cvsroot/clisp/clisp/src/init.lisp,v
retrieving revision 1.300
retrieving revision 1.301
diff -u -d -r1.300 -r1.301
--- init.lisp	20 Sep 2010 20:40:23 -0000	1.300
+++ init.lisp	25 Nov 2010 17:03:48 -0000	1.301
@@ -385,7 +385,7 @@
    #+(or UNIX WIN32) make-pipe-output-stream
    #+(or UNIX WIN32) make-pipe-input-stream
    #+(or UNIX WIN32) make-pipe-io-stream
-   make-buffered-input-stream make-buffered-output-stream
+   make-buffered-input-stream make-buffered-output-stream stream-handles
    get-setf-method preliminary local module-info
    source-program-error source-program-error-form source-program-error-detail
    compiler-let load-time-eval compile-time-value)
@@ -2311,8 +2311,7 @@
 (common-lisp:export
  '(socket-server socket-server-close socket-server-port socket-server-host
    socket-accept socket-wait socket-status socket-connect socket-options
-   socket-stream-host socket-stream-port socket-stream-peer socket-stream-local
-   stream-handles)
+   socket-stream-host socket-stream-port socket-stream-peer socket-stream-local)
  "SOCKET")
 #+sockets
 (ext:re-export "SOCKET" "EXT")

Index: constsym.d
===================================================================
RCS file: /cvsroot/clisp/clisp/src/constsym.d,v
retrieving revision 1.397
retrieving revision 1.398
diff -u -d -r1.397 -r1.398
--- constsym.d	14 Nov 2010 16:02:41 -0000	1.397
+++ constsym.d	25 Nov 2010 17:03:48 -0000	1.398
@@ -1,7 +1,7 @@
 /*
  * List of all symbols known to the C-program ("program constants")
  * Bruno Haible 1990-2006
- * Sam Steingold 1998-2009
+ * Sam Steingold 1998-2010
  */
 
 /* The macro LISPSYM declares a LISP symbol.
@@ -1009,7 +1009,7 @@
 LISPSYM(socket_stream_shutdown,"SOCKET-STREAM-SHUTDOWN",socket)
 #endif
 LISPSYM(make_stream,"MAKE-STREAM",ext)
-LISPSYM(stream_handles,"STREAM-HANDLES",socket)
+LISPSYM(stream_handles,"STREAM-HANDLES",ext)
 #endif
 LISPSYM(built_in_stream_open_p,"BUILT-IN-STREAM-OPEN-P",system)
 LISPSYM(input_stream_p,"INPUT-STREAM-P",lisp)

Index: ChangeLog
===================================================================
RCS file: /cvsroot/clisp/clisp/src/ChangeLog,v
retrieving revision 1.7577
retrieving revision 1.7578
diff -u -d -r1.7577 -r1.7578
--- ChangeLog	22 Nov 2010 00:16:58 -0000	1.7577
+++ ChangeLog	25 Nov 2010 17:03:48 -0000	1.7578
@@ -1,3 +1,7 @@
+2010-11-25  Sam Steingold  <sd...@gn...>
+
+	* init.lisp, constsym.d (stream-handles): move from SOCKET to EXT
+
 2010-11-21  Sam Steingold  <sd...@gn...>
 
 	* makemake.in: use ${MODULESDIR_} instead of ${SRCTOPDIR}modules

Index: NEWS
===================================================================
RCS file: /cvsroot/clisp/clisp/src/NEWS,v
retrieving revision 1.551
retrieving revision 1.552
diff -u -d -r1.551 -r1.552
--- NEWS	20 Oct 2010 18:41:13 -0000	1.551
+++ NEWS	25 Nov 2010 17:03:48 -0000	1.552
@@ -34,6 +34,10 @@
   single value.
   See <http://clisp.cons.org/impnotes/syscalls.html#usage> for details.
 
+* Function EXT:STREAM-HANDLES returns the OS file handles for the stream.
+  It has been present since 2.36 in package SOCKET but was not documented.
+  See <http://clisp.cons.org/impnotes/stream-handles.html> for details.
+
 * FFI now converts REALs to FLOATs automatically as necessary.
 
 * Bug fixes:




------------------------------

------------------------------------------------------------------------------
Increase Visibility of Your 3D Game App & Earn a Chance To Win $500!
Tap into the largest installed PC base & get more eyes on your game by
optimizing for Intel(R) Graphics Technology. Get started today with the
Intel(R) Software Partner Program. Five $500 cash prizes are up for grabs.
http://p.sf.net/sfu/intelisp-dev2dev

------------------------------

_______________________________________________
clisp-cvs mailing list
cli...@li...
https://lists.sourceforge.net/lists/listinfo/clisp-cvs


End of clisp-cvs Digest, Vol 55, Issue 8
****************************************

clisp-cvs Digest, Vol 55, Issue 7

[<cli...@li...>]

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.7576,1.7577 makemake.in,1.961,1.962
      (Sam Steingold)


----------------------------------------------------------------------

Message: 1
Date: Mon, 22 Nov 2010 00:17:04 +0000
From: Sam Steingold <sd...@us...>
Subject: clisp/src ChangeLog,1.7576,1.7577 makemake.in,1.961,1.962
To: cli...@li...
Message-ID: <E1P...@sf...>

Update of /cvsroot/clisp/clisp/src
In directory sfp-cvsdas-2.v30.ch3.sourceforge.com:/tmp/cvs-serv13823/src

Modified Files:
	ChangeLog makemake.in 
Log Message:
* src/makemake.in: use ${MODULESDIR_} instead of ${SRCTOPDIR}modules


Index: makemake.in
===================================================================
RCS file: /cvsroot/clisp/clisp/src/makemake.in,v
retrieving revision 1.961
retrieving revision 1.962
diff -u -d -r1.961 -r1.962
--- makemake.in	21 Oct 2010 08:07:08 -0000	1.961
+++ makemake.in	22 Nov 2010 00:16:59 -0000	1.962
@@ -3149,7 +3149,7 @@
 echol
 
 # scripts in build-aux
-MODULE_CONFIGURES=`find ${SRCTOPDIR}modules -name configure`
+MODULE_CONFIGURES=`find ${MODULESDIR_} -name configure`
 BUILD_AUX_ALL=`grep '$ac_aux_dir/' ${MODULE_CONFIGURES} | sed 's,.*$ac_aux_dir/\([a-z.-]*\).*,\1,' | sort -u`
 BUILD_AUX=''
 test -n "${SRCDIR}" && case "${LN_S}" in
@@ -3168,7 +3168,7 @@
 
 # headers in build-aux
 BUILD_AUX_HEADERS=`cd ${SRCDIR}build-aux; ls *.h`
-MODULE_AM=`find ${SRCTOPDIR}modules -name Makefile.am`
+MODULE_AM=`find ${MODULESDIR_} -name Makefile.am`
 for h in ${BUILD_AUX_HEADERS}; do
   for m in ${MODULE_AM}; do
     if fgrep "BUILT_SOURCES += $h" $m >/dev/null 2>&1; then
@@ -3968,7 +3968,7 @@
 
 # clean-modules remove the copies of modules, do it if you change modprep and such
 clean-modules :
-	-\$(RMRF) \`ls -d ${SRCTOPDIR}modules/*/. | sed -e 's,/\.\$\$,,' -e 's,^.*/,,' | grep -v '^CVS\$\$'\`
+	-\$(RMRF) \`ls -d ${MODULESDIR_}*/. | sed -e 's,/\.\$\$,,' -e 's,^.*/,,' | grep -v '^CVS\$\$'\`
 
 # clean7 lets us go back to the main "configure".
 clean7 : clean6 clean-modules

Index: ChangeLog
===================================================================
RCS file: /cvsroot/clisp/clisp/src/ChangeLog,v
retrieving revision 1.7576
retrieving revision 1.7577
diff -u -d -r1.7576 -r1.7577
--- ChangeLog	14 Nov 2010 16:02:40 -0000	1.7576
+++ ChangeLog	22 Nov 2010 00:16:58 -0000	1.7577
@@ -1,3 +1,7 @@
+2010-11-21  Sam Steingold  <sd...@gn...>
+
+	* makemake.in: use ${MODULESDIR_} instead of ${SRCTOPDIR}modules
+
 2010-11-14  Vladimir Tzankov  <vtz...@gm...>
 
 	[MULTITHREAD]: thread safe GENSYM and GENTEMP




------------------------------

------------------------------------------------------------------------------
Beautiful is writing same markup. Internet Explorer 9 supports
standards for HTML5, CSS3, SVG 1.1,  ECMAScript5, and DOM L2 & L3.
Spend less time writing and  rewriting code and more time creating great
experiences on the web. Be a part of the beta today
http://p.sf.net/sfu/msIE9-sfdev2dev

------------------------------

_______________________________________________
clisp-cvs mailing list
cli...@li...
https://lists.sourceforge.net/lists/listinfo/clisp-cvs


End of clisp-cvs Digest, Vol 55, Issue 7
****************************************

clisp-cvs Digest, Vol 55, Issue 6

[<cli...@li...>]

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
****************************************

clisp-cvs Digest, Vol 55, Issue 5

[<cli...@li...>]

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/rawsock rawsock.xml,1.66,1.67 (Sam Steingold)
   2. clisp/modules/syscalls syscalls.xml,1.139,1.140 (Sam Steingold)
   3. clisp/doc impent.xml,1.385,1.386 impext.xml,1.662,1.663
      (Sam Steingold)
   4. clisp/modules/syscalls calls.c,1.323,1.324 (Sam Steingold)
   5. clisp/doc impext.xml,1.663,1.664 (Sam Steingold)


----------------------------------------------------------------------

Message: 1
Date: Wed, 10 Nov 2010 16:36:42 +0000
From: Sam Steingold <sd...@us...>
Subject: clisp/modules/rawsock rawsock.xml,1.66,1.67
To: cli...@li...
Message-ID: <E1P...@sf...>

Update of /cvsroot/clisp/clisp/modules/rawsock
In directory sfp-cvsdas-2.v30.ch3.sourceforge.com:/tmp/cvs-serv26278/modules/rawsock

Modified Files:
	rawsock.xml 
Log Message:
add &int-t;


Index: rawsock.xml
===================================================================
RCS file: /cvsroot/clisp/clisp/modules/rawsock/rawsock.xml,v
retrieving revision 1.66
retrieving revision 1.67
diff -u -d -r1.66 -r1.67
--- rawsock.xml	8 Nov 2010 17:24:18 -0000	1.66
+++ rawsock.xml	10 Nov 2010 16:36:40 -0000	1.67
@@ -98,28 +98,28 @@
    vector length because Lisp can determine it itself, but, if you want
    to, you can use &end-k; argument for that.
 </simpara></listitem></varlistentry>
-<varlistentry><term><type>int</type> &sock-r;</term>
+<varlistentry><term>&int-t; &sock-r;</term>
  <listitem><simpara>An &integer-t; (returned by &socketpair; or
    &socket;).</simpara></listitem></varlistentry>
-<varlistentry><term><type>int</type> &family-r;</term>
- <term><type>int</type> &dom-r;</term>
+<varlistentry><term>&int-t; &family-r;</term>
+ <term>&int-t; &dom-r;</term>
  <listitem><simpara>A &nil; (stands for <constant>AF_UNSPEC</constant>),
    &integer-t;, or a platform-specific keyword, e.g.,
    <constant>:INET</constant> stands for <constant>AF_INET</constant>.
 </simpara></listitem></varlistentry>
-<varlistentry><term><type>int</type> &type-r;</term>
+<varlistentry><term>&int-t; &type-r;</term>
  <listitem><simpara>A &nil; (stands for 0); &integer-t;; or a
    platform-specific keyword, e.g.,
    <constant>:DGRAM</constant> stands for <constant>SOCK_DGRAM</constant>.
 </simpara></listitem></varlistentry>
-<varlistentry><term><type>int</type> &proto-r;</term>
+<varlistentry><term>&int-t; &proto-r;</term>
  <listitem><simpara>A &nil; (stands for 0); &integer-t;; a
    platform-specific keyword, e.g., <constant>:ETH_P_ARP</constant> stands
    for <constant>ETH_P_ARP</constant>, <constant>:IPPROTO-ICMP</constant>
    stands for <constant>IPPROTO_ICMP</constant>; or a &string-t; (passed
    to <function role="unix">getprotobyname</function>).
 </simpara></listitem></varlistentry>
-<varlistentry><term><type>int</type> <replaceable>flags</replaceable></term>
+<varlistentry><term>&int-t; <replaceable>flags</replaceable></term>
  <listitem><simpara>This &c-lang; argument corresponds to keyword
    arguments to the Lisp functions.  E.g., <function>rawsock:send</function>
    accepts <constant>:OOB</constant> and <constant>EOR</constant> arguments,




------------------------------

Message: 2
Date: Wed, 10 Nov 2010 16:36:42 +0000
From: Sam Steingold <sd...@us...>
Subject: clisp/modules/syscalls syscalls.xml,1.139,1.140
To: cli...@li...
Message-ID: <E1P...@sf...>

Update of /cvsroot/clisp/clisp/modules/syscalls
In directory sfp-cvsdas-2.v30.ch3.sourceforge.com:/tmp/cvs-serv26278/modules/syscalls

Modified Files:
	syscalls.xml 
Log Message:
add &int-t;


Index: syscalls.xml
===================================================================
RCS file: /cvsroot/clisp/clisp/modules/syscalls/syscalls.xml,v
retrieving revision 1.139
retrieving revision 1.140
diff -u -d -r1.139 -r1.140
--- syscalls.xml	8 Nov 2010 17:05:50 -0000	1.139
+++ syscalls.xml	10 Nov 2010 16:36:40 -0000	1.140
@@ -118,7 +118,7 @@
      return <quote>similar</quote> objects (&open;ing a file changes its
      access time though).  This is &not-e; the case on &win32;, where
      <function role="unix">stat</function> works but &fstat; does &not-e;.
-     Specifically, &fstat; requires an <type>int</type> argument of an unknown
+     Specifically, &fstat; requires an &int-t; argument of an unknown
      nature, and it is not clear how do deduce it from the &win32; file handle.
      Therefore, instead of always failing on open &file-stream-t; arguments,
      this function calls




------------------------------

Message: 3
Date: Wed, 10 Nov 2010 16:36:42 +0000
From: Sam Steingold <sd...@us...>
Subject: clisp/doc impent.xml,1.385,1.386 impext.xml,1.662,1.663
To: cli...@li...
Message-ID: <E1P...@sf...>

Update of /cvsroot/clisp/clisp/doc
In directory sfp-cvsdas-2.v30.ch3.sourceforge.com:/tmp/cvs-serv26278/doc

Modified Files:
	impent.xml impext.xml 
Log Message:
add &int-t;


Index: impext.xml
===================================================================
RCS file: /cvsroot/clisp/clisp/doc/impext.xml,v
retrieving revision 1.662
retrieving revision 1.663
diff -u -d -r1.662 -r1.663
--- impext.xml	3 Nov 2010 16:34:53 -0000	1.662
+++ impext.xml	10 Nov 2010 16:36:40 -0000	1.663
@@ -3394,7 +3394,7 @@
 <row><entry>&nil;</entry><entry>&nil;</entry><entry><type>void</type></entry>
    <entry/><entry>as a result type only</entry></row>
 <row><entry>&boolean-t;</entry><entry>&boolean-t;</entry>
-   <entry><type>int</type></entry><entry><type>BOOLEAN</type></entry></row>
+   <entry>&int-t;</entry><entry><type>BOOLEAN</type></entry></row>
 <row><entry>&character-t;</entry><entry>&character-t;</entry>
    <entry><type>char</type></entry>
    <entry><type>SHORT CHARACTER</type></entry></row>
@@ -3406,8 +3406,8 @@
    <entry><type>short</type></entry></row>
 <row><entry><type>ushort</type></entry><entry>&integer-t;</entry>
    <entry><type>unsigned short</type></entry></row>
-<row><entry><type>int</type></entry><entry>&integer-t;</entry>
-   <entry><type>int</type></entry></row>
+<row><entry>&int-t;</entry><entry>&integer-t;</entry>
+   <entry>&int-t;</entry></row>
 <row><entry><type>uint</type></entry><entry>&integer-t;</entry>
    <entry><type>unsigned int</type></entry></row>
 <row><entry><type>long</type></entry><entry>&integer-t;</entry>
@@ -4129,7 +4129,7 @@
 
 <para>The standard &unix; function
  <funcsynopsis id="gethostname-synopsis"><funcprototype>
-   <funcdef><type>int</type> <function>gethostname</function></funcdef>
+   <funcdef>&int-t; <function>gethostname</function></funcdef>
    <paramdef><type>char*</type> <parameter>name</parameter></paramdef>
    <paramdef><type>size_t</type> <parameter>length</parameter></paramdef>
 </funcprototype></funcsynopsis>

Index: impent.xml
===================================================================
RCS file: /cvsroot/clisp/clisp/doc/impent.xml,v
retrieving revision 1.385
retrieving revision 1.386
diff -u -d -r1.385 -r1.386
--- impent.xml	3 Nov 2010 16:47:18 -0000	1.385
+++ impent.xml	10 Nov 2010 16:36:40 -0000	1.386
@@ -1071,6 +1071,7 @@
 <!ENTITY subrkw-d '<link linkend="subrkw-d"><filename>subrkw.d</filename></link>'>
 
 <!-- *** shortcuts *** -->
+<!ENTITY int-t '<type>int</type>'>
 <!ENTITY sbyte-16 '<literal role="type">(&signed-byte-t; 16)</literal>'>
 <!ENTITY sbyte-32 '<literal role="type">(&signed-byte-t; 32)</literal>'>
 <!ENTITY sbyte-8 '<literal role="type">(&signed-byte-t; 8)</literal>'>




------------------------------

Message: 4
Date: Wed, 10 Nov 2010 16:53:45 +0000
From: Sam Steingold <sd...@us...>
Subject: clisp/modules/syscalls calls.c,1.323,1.324
To: cli...@li...
Message-ID: <E1P...@sf...>

Update of /cvsroot/clisp/clisp/modules/syscalls
In directory sfp-cvsdas-2.v30.ch3.sourceforge.com:/tmp/cvs-serv29375

Modified Files:
	calls.c 
Log Message:
add a comment about _open_osfhandle (http://msdn.microsoft.com/en-us/library/bdts1c9x.aspx)


Index: calls.c
===================================================================
RCS file: /cvsroot/clisp/clisp/modules/syscalls/calls.c,v
retrieving revision 1.323
retrieving revision 1.324
diff -u -d -r1.323 -r1.324
--- calls.c	28 Oct 2010 20:36:50 -0000	1.323
+++ calls.c	10 Nov 2010 16:53:43 -0000	1.324
@@ -2049,7 +2049,13 @@
     } else {                    /* file is a stream, fd is valid */
 #    if defined(WIN32_NATIVE)
       /* woe32 does have fstat(), but it does not accept a file handle,
-         only an integer of an unknown nature */
+         only an integer of an unknown nature.
+         FIXME: actually, the integer is an "OS File Hangle"
+         accessibe via int _open_osfhandle (intptr_t osfhandle, int flags);
+         http://msdn.microsoft.com/en-us/library/bdts1c9x.aspx
+         however, it is not clear whether this itroduces a leak:
+         the osfhandle is supposed to be closed by _close, but it also closes
+         the original handle which is no good */
       BY_HANDLE_FILE_INFORMATION fi;
       begin_blocking_system_call();
       error_p = !GetFileInformationByHandle(fd,&fi);




------------------------------

Message: 5
Date: Wed, 10 Nov 2010 19:59:23 +0000
From: Sam Steingold <sd...@us...>
Subject: clisp/doc impext.xml,1.663,1.664
To: cli...@li...
Message-ID: <E1P...@sf...>

Update of /cvsroot/clisp/clisp/doc
In directory sfp-cvsdas-2.v30.ch3.sourceforge.com:/tmp/cvs-serv30789

Modified Files:
	impext.xml 
Log Message:
tweak


Index: impext.xml
===================================================================
RCS file: /cvsroot/clisp/clisp/doc/impext.xml,v
retrieving revision 1.663
retrieving revision 1.664
diff -u -d -r1.663 -r1.664
--- impext.xml	10 Nov 2010 16:36:40 -0000	1.663
+++ impext.xml	10 Nov 2010 19:59:21 -0000	1.664
@@ -4168,7 +4168,7 @@
 <computeroutput>#(97 98 97 122 111 110 107)</computeroutput></programlisting>
 It is a &simple-vector-t;, not a &string-t;, because the &name-r;
 argument is an array of <type>char</type> (an &integer-t; type, see
-<xref linkend="dffi-types"/>), not <type>character</type>.
+<xref linkend="dffi-types"/>), &not-e; <type>character</type>.
 <programlisting language="lisp">
 (&def-call-out; gethostname
   (&arguments-k; (name (&c-ptr; (&c-array-max; character 256))




------------------------------

------------------------------------------------------------------------------
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 5
****************************************

clisp-cvs Digest, Vol 55, Issue 4

[<cli...@li...>]

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 configure,1.148,1.149 (Sam Steingold)
   2. clisp/modules/rawsock rawsock.c,1.135,1.136 (Sam Steingold)
   3. clisp/src ChangeLog,1.7574,1.7575 (Sam Steingold)
   4. clisp/modules/syscalls syscalls.xml,1.138,1.139 (Sam Steingold)
   5. clisp/modules/rawsock rawsock.xml,1.64,1.65 (Sam Steingold)
   6. clisp/modules/rawsock rawsock.xml,1.65,1.66 (Sam Steingold)


----------------------------------------------------------------------

Message: 1
Date: Mon, 08 Nov 2010 15:30:30 +0000
From: Sam Steingold <sd...@us...>
Subject: clisp configure,1.148,1.149
To: cli...@li...
Message-ID: <E1P...@sf...>

Update of /cvsroot/clisp/clisp
In directory sfp-cvsdas-2.v30.ch3.sourceforge.com:/tmp/cvs-serv16463

Modified Files:
	configure 
Log Message:
SIGSEGV: libsigsegv 2.9 has been released


Index: configure
===================================================================
RCS file: /cvsroot/clisp/clisp/configure,v
retrieving revision 1.148
retrieving revision 1.149
diff -u -d -r1.148 -r1.149
--- configure	14 Dec 2009 14:44:32 -0000	1.148
+++ configure	8 Nov 2010 15:30:27 -0000	1.149
@@ -683,7 +683,7 @@
     if [ "$ac_cv_build" = "$ac_cv_host" ]; then host_arg="";
     else host_arg=" --host=$ac_cv_host";
     fi
-    SIGSEGV=libsigsegv-2.8
+    SIGSEGV=libsigsegv-2.9
     cat <<EOF 1>&2
 $0: libsigsegv was not detected, thus some features, such as
   generational garbage collection and




------------------------------

Message: 2
Date: Mon, 08 Nov 2010 16:59:26 +0000
From: Sam Steingold <sd...@us...>
Subject: clisp/modules/rawsock rawsock.c,1.135,1.136
To: cli...@li...
Message-ID: <E1P...@sf...>

Update of /cvsroot/clisp/clisp/modules/rawsock
In directory sfp-cvsdas-2.v30.ch3.sourceforge.com:/tmp/cvs-serv32356/modules/rawsock

Modified Files:
	rawsock.c 
Log Message:
* modules/rawsock/rawsock.c (check_sockopt_name): add
(get_sock_opt, set_sock_opt): use it instead of NOTREACHED


Index: rawsock.c
===================================================================
RCS file: /cvsroot/clisp/clisp/modules/rawsock/rawsock.c,v
retrieving revision 1.135
retrieving revision 1.136
diff -u -d -r1.135 -r1.136
--- rawsock.c	28 Sep 2010 20:27:25 -0000	1.135
+++ rawsock.c	8 Nov 2010 16:59:23 -0000	1.136
@@ -1227,8 +1227,16 @@
     if (status==0) return retform;                                      \
     else return (err_p ? OS_file_error(fixnum(sock)),NIL : S(Kerror));  \
   } while(0)
+static int check_sockopt_name (int name) {
+  pushSTACK(NIL);           /* no PLACE */
+  pushSTACK(fixnum(name));
+  pushSTACK(TheSubr(subr_self)->name);
+  check_value(error_condition,GETTEXT("~S: invalid option ~S"));
+  return sockopt_name(value1);
+}
 /* can trigger GC */
 static object get_sock_opt (rawsock_t sock, int level, int name, int err_p) {
+ get_sock_opt_restart:
   switch (name) {
 #  if defined(SO_DEBUG)
     case SO_DEBUG:
@@ -1289,7 +1297,8 @@
     case SO_SNDTIMEO:
 #  endif
       GET_SOCK_OPT(struct timeval,sec_usec_number(val.tv_sec,val.tv_usec,0));
-    default: NOTREACHED;
+    default: name = check_sockopt_name(name);
+      goto get_sock_opt_restart;
   }
 }
 #undef GET_SOCK_OPT
@@ -1342,6 +1351,7 @@
   } while(0)
 static void set_sock_opt (rawsock_t sock, int level, int name, object value) {
   if (eq(value,S(Kerror))) return;
+ set_sock_opt_restart:
   switch (name) {
 #  if defined(SO_DEBUG)
     case SO_DEBUG:
@@ -1405,7 +1415,8 @@
     case SO_SNDTIMEO:
 #  endif
       SET_SOCK_OPT(struct timeval,sec_usec(value,NIL,&val));
-    default: NOTREACHED;
+    default: name = check_sockopt_name(name);
+      goto set_sock_opt_restart;
   }
 }
 #undef SET_SOCK_OPT




------------------------------

Message: 3
Date: Mon, 08 Nov 2010 16:59:27 +0000
From: Sam Steingold <sd...@us...>
Subject: clisp/src ChangeLog,1.7574,1.7575
To: cli...@li...
Message-ID: <E1P...@sf...>

Update of /cvsroot/clisp/clisp/src
In directory sfp-cvsdas-2.v30.ch3.sourceforge.com:/tmp/cvs-serv32356/src

Modified Files:
	ChangeLog 
Log Message:
* modules/rawsock/rawsock.c (check_sockopt_name): add
(get_sock_opt, set_sock_opt): use it instead of NOTREACHED


Index: ChangeLog
===================================================================
RCS file: /cvsroot/clisp/clisp/src/ChangeLog,v
retrieving revision 1.7574
retrieving revision 1.7575
diff -u -d -r1.7574 -r1.7575
--- ChangeLog	30 Oct 2010 21:02:59 -0000	1.7574
+++ ChangeLog	8 Nov 2010 16:59:24 -0000	1.7575
@@ -1,3 +1,8 @@
+2010-11-08  Sam Steingold  <sd...@gn...>
+
+	* modules/rawsock/rawsock.c (check_sockopt_name): add
+	(get_sock_opt, set_sock_opt): use it instead of NOTREACHED
+
 2010-10-30  Vladimir Tzankov  <vtz...@gm...>
 
 	[MULTITHREAD]: add optional :TEST predicate to MT:EXEMPTION-WAIT




------------------------------

Message: 4
Date: Mon, 08 Nov 2010 17:05:52 +0000
From: Sam Steingold <sd...@us...>
Subject: clisp/modules/syscalls syscalls.xml,1.138,1.139
To: cli...@li...
Message-ID: <E1P...@sf...>

Update of /cvsroot/clisp/clisp/modules/syscalls
In directory sfp-cvsdas-2.v30.ch3.sourceforge.com:/tmp/cvs-serv1532

Modified Files:
	syscalls.xml 
Log Message:
document that stream-options is setfable


Index: syscalls.xml
===================================================================
RCS file: /cvsroot/clisp/clisp/modules/syscalls/syscalls.xml,v
retrieving revision 1.138
retrieving revision 1.139
diff -u -d -r1.138 -r1.139
--- syscalls.xml	20 Oct 2010 18:41:12 -0000	1.138
+++ syscalls.xml	8 Nov 2010 17:05:50 -0000	1.139
@@ -296,7 +296,9 @@
     &stream-r; &command-r; &optional-amp; &value-r;)</code></term>
   <listitem><simpara>Call <function role="unix">fcntl</function>,
     &command-r; can be <constant>:FD</constant> or <constant>:FL</constant>.
- </simpara></listitem></varlistentry>
+ </simpara><simpara>When &value-r; is missing, the option is queried and
+  the value is returned; if &value-r; is supplied, the option is set and
+  no values are returned.</simpara></listitem></varlistentry>
  <varlistentry id="file-size"><term><code>(&file-size; &file-r;)</code></term>
   <term><code>(&setf; (&file-size; &file-r;) &size-r;)</code></term>
   <listitem><simpara>Extend &file-length; to operate on &path-des;s.</simpara>




------------------------------

Message: 5
Date: Mon, 08 Nov 2010 17:21:28 +0000
From: Sam Steingold <sd...@us...>
Subject: clisp/modules/rawsock rawsock.xml,1.64,1.65
To: cli...@li...
Message-ID: <E1P...@sf...>

Update of /cvsroot/clisp/clisp/modules/rawsock
In directory sfp-cvsdas-2.v30.ch3.sourceforge.com:/tmp/cvs-serv4406

Modified Files:
	rawsock.xml 
Log Message:
make-sockaddr: data size is crucial


Index: rawsock.xml
===================================================================
RCS file: /cvsroot/clisp/clisp/modules/rawsock/rawsock.xml,v
retrieving revision 1.64
retrieving revision 1.65
diff -u -d -r1.64 -r1.65
--- rawsock.xml	5 Dec 2009 23:03:57 -0000	1.64
+++ rawsock.xml	8 Nov 2010 17:21:25 -0000	1.65
@@ -130,7 +130,6 @@
  <listitem><simpara>A &structure-object-t; <type>RAWSOCK:SOCKADDR</type>
    returned by
    <link linkend="make-sockaddr"><function>MAKE-SOCKADDR</function></link>.
-   You do not need to supply its length because Lisp can determine it itself.
 </simpara></listitem></varlistentry>
 <varlistentry><term><type>struct msghdr</type> &mesg-r;</term>
  <listitem><para>A &structure-object-t; <type>RAWSOCK:MESSAGE</type>
@@ -282,8 +281,10 @@
  <listitem><simpara>Create a <type>sockaddr</type> object.
    &data-r; should be a sequence of &ubyte-8; or an &integer-t;
    (meaning <code>(&make-list; &data-r; :initial-element 0)</code>).
-   When omitted, the standard platform-specific size is used.
-</simpara></listitem></varlistentry>
+   When omitted, the standard platform-specific size is used.</simpara>
+  <note><simpara>It is critical to use &data-r; of the corrent size (usually
+   <code>sizeof(struct sockaddr)</code>, but may be something depending
+   on the protocol to be used).</simpara></note></listitem></varlistentry>
 <varlistentry><term><code>(RAWSOCK:SOCKADDR-FAMILY &addr-r;)</code></term>
  <listitem><simpara>Return the symbolic &family-r; of the
    <type>sockaddr</type> object.</simpara></listitem></varlistentry>




------------------------------

Message: 6
Date: Mon, 08 Nov 2010 17:24:20 +0000
From: Sam Steingold <sd...@us...>
Subject: clisp/modules/rawsock rawsock.xml,1.65,1.66
To: cli...@li...
Message-ID: <E1P...@sf...>

Update of /cvsroot/clisp/clisp/modules/rawsock
In directory sfp-cvsdas-2.v30.ch3.sourceforge.com:/tmp/cvs-serv4708

Modified Files:
	rawsock.xml 
Log Message:
use &k-r; et al


Index: rawsock.xml
===================================================================
RCS file: /cvsroot/clisp/clisp/modules/rawsock/rawsock.xml,v
retrieving revision 1.65
retrieving revision 1.66
diff -u -d -r1.65 -r1.66
--- rawsock.xml	8 Nov 2010 17:21:25 -0000	1.65
+++ rawsock.xml	8 Nov 2010 17:24:18 -0000	1.66
@@ -253,11 +253,10 @@
    &key-amp; :FLAGS-OR :FLAGS-AND)</code></term>
  <listitem><simpara>Call <function role="bsd">getifaddrs</function>
    and return a &list-t; of <type>ifaddrs</type> objects, optionally
-   filtered using flags, e.g., <code>(ifaddrs :flags-or '(a b)
-    :flags-and '(c d))</code> will return a list of objects which have
-   flags <literal>c</literal> &and-e; <literal>d</literal> &and-e; at
-   least one of <literal>a</literal> &or-e; <literal>b</literal> set.
-</simpara></listitem></varlistentry>
+   filtered using flags, e.g., <code>(ifaddrs :flags-or '(&k-r; &l-r;)
+    :flags-and '(&m-r; &n-r;))</code> will return a list of objects
+   which have &both-e; flags &m-r; &and-e; &n-r; &and-e; at least one of
+   &k-r; &or-e; &l-r; set.</simpara></listitem></varlistentry>
 <varlistentry id="rawsock-sockopt"><term><code>(RAWSOCK:SOCKET-OPTION
    &sock-r; &name-r; &key-amp; :LEVEL)</code></term>
  <term><code>(&setf; (RAWSOCK:SOCKET-OPTION &sock-r; &name-r;




------------------------------

------------------------------------------------------------------------------
The Next 800 Companies to Lead America's Growth: New Video Whitepaper
David G. Thomson, author of the best-selling book "Blueprint to a 
Billion" shares his insights and actions to help propel your 
business during the next growth cycle. Listen Now!
http://p.sf.net/sfu/SAP-dev2dev

------------------------------

_______________________________________________
clisp-cvs mailing list
cli...@li...
https://lists.sourceforge.net/lists/listinfo/clisp-cvs


End of clisp-cvs Digest, Vol 55, Issue 4
****************************************

clisp-cvs Digest, Vol 55, Issue 3

[<cli...@li...>]

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/doc impbody.xml,1.613,1.614 (Sam Steingold)


----------------------------------------------------------------------

Message: 1
Date: Fri, 05 Nov 2010 13:38:39 +0000
From: Sam Steingold <sd...@us...>
Subject: clisp/doc impbody.xml,1.613,1.614
To: cli...@li...
Message-ID: <E1P...@sf...>

Update of /cvsroot/clisp/clisp/doc
In directory sfp-cvsdas-2.v30.ch3.sourceforge.com:/tmp/cvs-serv28777

Modified Files:
	impbody.xml 
Log Message:
avoid 3rd person


Index: impbody.xml
===================================================================
RCS file: /cvsroot/clisp/clisp/doc/impbody.xml,v
retrieving revision 1.613
retrieving revision 1.614
diff -u -d -r1.613 -r1.614
--- impbody.xml	3 Nov 2010 18:05:53 -0000	1.613
+++ impbody.xml	5 Nov 2010 13:38:36 -0000	1.614
@@ -5629,31 +5629,31 @@
   <entry>&inspect-my; the last error object.</entry></row>
  <row><entry><command>Where</command></entry>
   <entry><command>:w</command></entry>
-  <entry>shows the &cur-frame;.</entry></row>
+  <entry>show the &cur-frame;.</entry></row>
  <row><entry><command>Up</command></entry>
   <entry><command>:u</command></entry>
-  <entry>goes up one frame, i.e., to the caller if in mode-5</entry></row>
+  <entry>go up one frame, i.e., to the caller if in mode-5</entry></row>
  <row><entry><command>Down</command></entry>
   <entry><command>:d</command></entry>
-  <entry>does down one frame, i.e., to the callee if in mode-5</entry></row>
+  <entry>do down one frame, i.e., to the callee if in mode-5</entry></row>
  <row><entry><command>Top</command></entry>
   <entry><command>:t</command></entry>
-  <entry>goes to top frame, i.e., to the top-level form if in mode-4
+  <entry>go to top frame, i.e., to the top-level form if in mode-4
  </entry></row>
  <row><entry><command>Bottom</command></entry>
   <entry><command>:b</command></entry>
-  <entry>goes to bottom (most recent) frame, i.e., most probably to the
+  <entry>go to bottom (most recent) frame, i.e., most probably to the
    form or function that caused the debugger to be entered.</entry></row>
  <row><entry><command>Mode</command> &stack-mode;</entry>
   <entry><command>:m</command> &stack-mode;</entry>
-  <entry>sets the current stack printing mode</entry></row>
+  <entry>set the current stack printing mode</entry></row>
  <row id="frame-limit"><entry><command>Frame-limit</command> &l-r;</entry>
   <entry><command>:fl</command></entry>
   <entry>set the &frame-limit;: this many frames will be printed
    by &backtrace; at most.</entry></row>
  <row id="backtrace"><entry>&backtrace; [&stack-mode; [&l-r;]]</entry>
   <entry><command>:bt</command> [&stack-mode; [&l-r;]]</entry>
-  <entry>lists the stack in the given &stack-mode;, bottom frame first,
+  <entry>list the stack in the given &stack-mode;, bottom frame first,
   top frame last; at most &l-r; frames are printed;
   calls &show-stack;.</entry></row>
 </tbody></tgroup></table>
@@ -5667,20 +5667,20 @@
   &cmd-abbrev-oper-header;<tbody>
 <row><entry><command>Break+</command></entry>
  <entry><command>:br+</command></entry>
- <entry>sets a breakpoint in the current frame.  When the corresponding
+ <entry>set a breakpoint in the current frame.  When the corresponding
   form or function will be left, the debugger will be entered again, with
   the variable &trace-val; containing a list of its values.</entry></row>
 <row><entry><command>Break-</command></entry>
  <entry><command>:br-</command></entry>
- <entry>removes a breakpoint from the current frame.</entry></row>
+ <entry>remove a breakpoint from the current frame.</entry></row>
 <row><entry><command>Redo</command></entry>
  <entry><command>:rd</command></entry>
- <entry>re-evaluates the corresponding form or function call. This
+ <entry>re-evaluate the corresponding form or function call. This
   command can be used to restart parts of a computation without
   aborting it entirely.</entry></row>
 <row><entry><command>Return</command> &value-r;</entry>
  <entry><command>:rt</command> &value-r;</entry>
- <entry>leaves the current frame, returning the given value.</entry></row>
+ <entry>leave the current frame, returning the given value.</entry></row>
 </tbody></tgroup></table>
 
 <table id="debugger-deb" frame="all">
@@ -5689,7 +5689,7 @@
   &cmd-abbrev-oper-header;<tbody>
 <row><entry><command>Continue</command></entry>
    <entry><command>:c</command></entry>
-   <entry>continues evaluation of the program.</entry></row>
+   <entry>continue evaluation of the program.</entry></row>
 </tbody></tgroup></table>
 
 <table id="debugger-step" frame="all">




------------------------------

------------------------------------------------------------------------------
The Next 800 Companies to Lead America's Growth: New Video Whitepaper
David G. Thomson, author of the best-selling book "Blueprint to a 
Billion" shares his insights and actions to help propel your 
business during the next growth cycle. Listen Now!
http://p.sf.net/sfu/SAP-dev2dev

------------------------------

_______________________________________________
clisp-cvs mailing list
cli...@li...
https://lists.sourceforge.net/lists/listinfo/clisp-cvs


End of clisp-cvs Digest, Vol 55, Issue 3
****************************************

clisp-cvs Digest, Vol 55, Issue 2

[<cli...@li...>]

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/doc impext.xml,1.661,1.662 (Sam Steingold)
   2. clisp/doc impbody.xml,1.611,1.612 impent.xml,1.384,1.385
      (Sam Steingold)
   3. clisp/doc impbody.xml,1.612,1.613 (Sam Steingold)


----------------------------------------------------------------------

Message: 1
Date: Wed, 03 Nov 2010 16:34:56 +0000
From: Sam Steingold <sd...@us...>
Subject: clisp/doc impext.xml,1.661,1.662
To: cli...@li...
Message-ID: <E1P...@sf...>

Update of /cvsroot/clisp/clisp/doc
In directory sfp-cvsdas-2.v30.ch3.sourceforge.com:/tmp/cvs-serv5374

Modified Files:
	impext.xml 
Log Message:
fix validity


Index: impext.xml
===================================================================
RCS file: /cvsroot/clisp/clisp/doc/impext.xml,v
retrieving revision 1.661
retrieving revision 1.662
diff -u -d -r1.661 -r1.662
--- impext.xml	1 Nov 2010 18:20:43 -0000	1.661
+++ impext.xml	3 Nov 2010 16:34:53 -0000	1.662
@@ -4999,7 +4999,7 @@
     wakeup</ulink>s, i.e., this function may return &t; even though no
    thread called &exemption-broadcast; or &exemption-signal;.
    Therefore, a common idiom for using this function is: <code>(&loop;
-   :until (&pred-r;) :do (&exemption-wait; &exemp-r; &mutex-r;))</code>
+   :until (&pred-r;) :do (&exemption-wait; &exemp-r; &mutex-r;))</code></para>
   <simpara>The &test-k; argument simplifies this. When supplied,
    &exemption-wait; returns when either &test-k; &pred-r; is satisfied
    (always called while &mutex-r; is held) or when &timeout-k; elapses.
@@ -5008,7 +5008,7 @@
    When &test-k; is supplied, &exemption-wait; returns &t; when &exemp-r; was
    signaled and &test-k; &pred-r; is satisfied and &nil; on timeout.
    </simpara><simpara>This is the preferred and most portable way to wait on
-     an exemption.</simpara></para>
+     an exemption.</simpara>
   <simpara>Cf. <function role="unix">pthread_cond_wait</function>.</simpara>
 </listitem></varlistentry>
 <varlistentry id="exemption-broadcast"><term><code>(&exemption-broadcast;




------------------------------

Message: 2
Date: Wed, 03 Nov 2010 16:47:20 +0000
From: Sam Steingold <sd...@us...>
Subject: clisp/doc impbody.xml,1.611,1.612 impent.xml,1.384,1.385
To: cli...@li...
Message-ID: <E1P...@sf...>

Update of /cvsroot/clisp/clisp/doc
In directory sfp-cvsdas-2.v30.ch3.sourceforge.com:/tmp/cvs-serv7587/doc

Modified Files:
	impbody.xml impent.xml 
Log Message:
document show-stack


Index: impbody.xml
===================================================================
RCS file: /cvsroot/clisp/clisp/doc/impbody.xml,v
retrieving revision 1.611
retrieving revision 1.612
diff -u -d -r1.611 -r1.612
--- impbody.xml	20 Sep 2010 20:40:23 -0000	1.611
+++ impbody.xml	3 Nov 2010 16:47:18 -0000	1.612
@@ -1332,7 +1332,7 @@
 
 <formalpara id="err-pr-bt"><title>Variable &err-pr-bt;</title>
 <para>When this variable is non-&nil; the error message printed by
- &abort-on-error; and &exit-on-error; includes the backtrace (stack).
+ &abort-on-error; and &exit-on-error; includes the &backtrace; (stack).
 </para></formalpara>
 
 <formalpara id="global-handler"><title>Function &set-global-handler;</title>
@@ -2131,7 +2131,7 @@
  precision contagion: set it to &t; to have &clisp; &signal; a
  &warning-t; on float precision contagion; set it to &error; to have
  &clisp; &signal; an &error-t; on float precision contagion, so that you
- can look at the stack backtrace.</para></simplesect>
+ can look at the stack &backtrace;.</para></simplesect>
 
 </section>
 
@@ -2163,7 +2163,7 @@
  would be possible: set it to &t; to have &clisp; &signal; a &warning-t;
  in such situations; set it to &error; to have &clisp; &signal; an
  &error-t; in such situations, so that you can look at the stack
- backtrace.</para></simplesect>
+ &backtrace;.</para></simplesect>
 
 <simplesect id="phasecont"><title>Variable &phasecont;</title>
 <para>A similar variable, &phasecont;, controls the return
@@ -5600,9 +5600,10 @@
  below the frame that corresponds to the form or the function call that
  binds that variable.</para>
 
+<formalpara id="stack-mode"><title>Stack Printing Mode</title>
 <para>There is a current <firstterm>stack mode</firstterm> which defines
  in how much detail the stack is shown by the stack-related debugger
- commands:<orderedlist>
+ commands (&backtrace; et al):<orderedlist>
   <listitem><simpara>All the stack elements are considered.
     This mode works fine for debugging compiled functions.</simpara></listitem>
   <listitem><simpara>All the frames are considered.</simpara></listitem>
@@ -5614,7 +5615,7 @@
   <listitem><simpara>Only &apply; frames are considered.
     Every invocation of an interpreted function corresponds to one
     &apply; frame.</simpara></listitem>
-</orderedlist></para>
+</orderedlist></para></formalpara>
 
 <table id="debugger-deb-step-1" frame="all">
  <title>Commands common to the debugger and the stepper</title>
@@ -5643,17 +5644,18 @@
   <entry><command>:b</command></entry>
   <entry>goes to bottom (most recent) frame, i.e., most probably to the
    form or function that caused the debugger to be entered.</entry></row>
- <row><entry><command>Mode</command> &mode-r;</entry>
-  <entry><command>:m</command> &mode-r;</entry>
-  <entry>sets the current stack mode</entry></row>
- <row><entry><command>Frame-limit</command> &l-r;</entry>
+ <row><entry><command>Mode</command> &stack-mode;</entry>
+  <entry><command>:m</command> &stack-mode;</entry>
+  <entry>sets the current stack printing mode</entry></row>
+ <row id="frame-limit"><entry><command>Frame-limit</command> &l-r;</entry>
   <entry><command>:fl</command></entry>
-  <entry>set the frame-limit: this many frames will be printed
-   by <command>Backtrace</command> at most.</entry></row>
- <row><entry><command>Backtrace</command> [&mode-r; [&l-r;]]</entry>
-  <entry><command>:bt</command> [&mode-r; [&l-r;]]</entry>
-  <entry>lists the stack in the given &mode-r;, bottom frame first, top
-   frame last; at most &l-r; frames are printed.</entry></row>
+  <entry>set the &frame-limit;: this many frames will be printed
+   by &backtrace; at most.</entry></row>
+ <row id="backtrace"><entry>&backtrace; [&stack-mode; [&l-r;]]</entry>
+  <entry><command>:bt</command> [&stack-mode; [&l-r;]]</entry>
+  <entry>lists the stack in the given &stack-mode;, bottom frame first,
+  top frame last; at most &l-r; frames are printed;
+  calls &show-stack;.</entry></row>
 </tbody></tgroup></table>
 
 <para>If the &cur-frame; is an &eval; or &apply; frame, the
@@ -5782,6 +5784,14 @@
  and then compiled, back to its interpreted form.</para>
 </section>
 
+<section id="show-stack"><title>Function &show-stack;</title>
+<para>The function &show-stack; is called by the &backtrace; command.</para>
+<para>It accepts 3 optional arguments:<orderedlist>
+<listitem><simpara>&stack-mode;</simpara></listitem>
+<listitem><simpara>&frame-limit;</simpara></listitem>
+<listitem><simpara><replaceable>start-frame</replaceable></simpara></listitem>
+</orderedlist></para></section>
+
 <section id="documentation"><title>Function &documentation;</title>
 <para>No on-line documentation is available for the system functions
  (yet), but see <xref linkend="describe"/>.</para></section>

Index: impent.xml
===================================================================
RCS file: /cvsroot/clisp/clisp/doc/impent.xml,v
retrieving revision 1.384
retrieving revision 1.385
diff -u -d -r1.384 -r1.385
--- impent.xml	18 Oct 2010 21:31:22 -0000	1.384
+++ impent.xml	3 Nov 2010 16:47:18 -0000	1.385
@@ -405,6 +405,9 @@
 <!ENTITY set-global-handler '<olink targetdoc="impnotes" targetptr="global-handler"><function>EXT:SET-GLOBAL-HANDLER</function></olink>'>
 <!ENTITY without-global-handlers '<olink targetdoc="impnotes" targetptr="without-global-handlers"><function>EXT:WITHOUT-GLOBAL-HANDLERS</function></olink>'>
 <!ENTITY shell '<olink targetdoc="impnotes" targetptr="exec"><function>EXT:SHELL</function></olink>'>
+<!ENTITY show-stack '<link linkend="show-stack"><function>EXT:SHOW-STACK</function></link>'>
+<!ENTITY frame-limit '<link linkend="frame-limit"><replaceable>frame-limit</replaceable></link>'>
+<!ENTITY stack-mode '<link linkend="stack-mode"><replaceable>stack-mode</replaceable></link>'>
 <!ENTITY so-accept '<link linkend="so-accept"><function>SOCKET:SOCKET-ACCEPT</function></link>'>
 <!ENTITY so-connect '<link linkend="so-connect"><function>SOCKET:SOCKET-CONNECT</function></link>'>
 <!ENTITY so-opt '<link linkend="so-opt"><function>SOCKET:SOCKET-OPTIONS</function></link>'>
@@ -504,6 +507,7 @@
 <!ENTITY canonicalize '<link linkend="canonicalize"><function>EXT:CANONICALIZE</function></link>'>
 <!ENTITY mod-expt '<link linkend="mod-expt"><function>EXT:MOD-EXPT</function></link>'>
 <!ENTITY compiled-file-p '<link linkend="compiled-file-p"><function>EXT:COMPILED-FILE-P</function></link>'>
+<!ENTITY backtrace '<link linkend="backtrace"><command>backtrace</command></link>'>
 <!ENTITY help '<olink targetdoc="impnotes" targetptr="debugger-main-deb-step"><command>help</command></olink>'>
 <!ENTITY debugger '<link linkend="debugger">debugger</link>'>
 <!ENTITY format-bang '<link linkend="format-bang"><literal>~!</literal></link>'>




------------------------------

Message: 3
Date: Wed, 03 Nov 2010 18:05:57 +0000
From: Sam Steingold <sd...@us...>
Subject: clisp/doc impbody.xml,1.612,1.613
To: cli...@li...
Message-ID: <E1P...@sf...>

Update of /cvsroot/clisp/clisp/doc
In directory sfp-cvsdas-2.v30.ch3.sourceforge.com:/tmp/cvs-serv31195

Modified Files:
	impbody.xml 
Log Message:
show-stack: add an example


Index: impbody.xml
===================================================================
RCS file: /cvsroot/clisp/clisp/doc/impbody.xml,v
retrieving revision 1.612
retrieving revision 1.613
diff -u -d -r1.612 -r1.613
--- impbody.xml	3 Nov 2010 16:47:18 -0000	1.612
+++ impbody.xml	3 Nov 2010 18:05:53 -0000	1.613
@@ -5786,11 +5786,19 @@
 
 <section id="show-stack"><title>Function &show-stack;</title>
 <para>The function &show-stack; is called by the &backtrace; command.</para>
-<para>It accepts 3 optional arguments:<orderedlist>
-<listitem><simpara>&stack-mode;</simpara></listitem>
+<para>It prints to &standard-output-var; and accepts 3 optional
+arguments:<orderedlist><listitem><simpara>&stack-mode;</simpara></listitem>
 <listitem><simpara>&frame-limit;</simpara></listitem>
 <listitem><simpara><replaceable>start-frame</replaceable></simpara></listitem>
-</orderedlist></para></section>
+</orderedlist></para>
+<para>It can used to find out what all the threads are up to:
+<programlisting language="lisp">
+(&loop; :with out = &standard-output-var; :for &thr; :in (&list-threads;) :do
+   (&format; out "===~A===~;" &thr;)
+   (&thread-interrupt; &thr; :function
+     (&lambda-m; () (&let; ((&standard-output-var; out)) (&show-stack; 1 3)))))
+</programlisting>
+</para></section>
 
 <section id="documentation"><title>Function &documentation;</title>
 <para>No on-line documentation is available for the system functions




------------------------------

------------------------------------------------------------------------------
The Next 800 Companies to Lead America's Growth: New Video Whitepaper
David G. Thomson, author of the best-selling book "Blueprint to a 
Billion" shares his insights and actions to help propel your 
business during the next growth cycle. Listen Now!
http://p.sf.net/sfu/SAP-dev2dev

------------------------------

_______________________________________________
clisp-cvs mailing list
cli...@li...
https://lists.sourceforge.net/lists/listinfo/clisp-cvs


End of clisp-cvs Digest, Vol 55, Issue 2
****************************************

clisp-cvs Digest, Vol 55, Issue 1

[<cli...@li...>]

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/doc impext.xml,1.660,1.661 (Sam Steingold)


----------------------------------------------------------------------

Message: 1
Date: Mon, 01 Nov 2010 18:20:46 +0000
From: Sam Steingold <sd...@us...>
Subject: clisp/doc impext.xml,1.660,1.661
To: cli...@li...
Message-ID: <E1P...@sf...>

Update of /cvsroot/clisp/clisp/doc
In directory sfp-cvsdas-2.v30.ch3.sourceforge.com:/tmp/cvs-serv32576

Modified Files:
	impext.xml 
Log Message:
use &pred-r;


Index: impext.xml
===================================================================
RCS file: /cvsroot/clisp/clisp/doc/impext.xml,v
retrieving revision 1.660
retrieving revision 1.661
diff -u -d -r1.660 -r1.661
--- impext.xml	31 Oct 2010 06:10:49 -0000	1.660
+++ impext.xml	1 Nov 2010 18:20:43 -0000	1.661
@@ -4988,7 +4988,7 @@
    &mutex-r; should be locked by the caller; otherwise an &err-sig;.
    The function releases the &mutex-r; and waits for &exemp-r;.
    On return &mutex-r; is acquired again.</simpara>
-  <simpara>When using exemptions there is always a boolean predicate involving
+  <simpara>When using exemptions there is always a boolean &pred-r; involving
    shared variables associated with each exemption wait that is true if the
    thread should proceed.</simpara>
   <simpara>The function waits up to &timeout-k; &seconds;.
@@ -4999,14 +4999,14 @@
     wakeup</ulink>s, i.e., this function may return &t; even though no
    thread called &exemption-broadcast; or &exemption-signal;.
    Therefore, a common idiom for using this function is: <code>(&loop;
-   :until (some-predicate) :do (&exemption-wait; &exemp-r; &mutex-r;))</code>
+   :until (&pred-r;) :do (&exemption-wait; &exemp-r; &mutex-r;))</code>
   <simpara>The &test-k; argument simplifies this. When supplied,
-   &exemption-wait; returns when either &test-k; predicate is satisfied
+   &exemption-wait; returns when either &test-k; &pred-r; is satisfied
    (always called while &mutex-r; is held) or when &timeout-k; elapses.
    The above loop is equivalent to: <code>(&exemption-wait; &exemp-r;
-    &mutex-r; &test-k; #'some-predicate)</code>.
+    &mutex-r; &test-k; #'&pred-r;)</code>.
    When &test-k; is supplied, &exemption-wait; returns &t; when &exemp-r; was
-   signaled and &test-k; predicate is satisfied and &nil; on timeout.
+   signaled and &test-k; &pred-r; is satisfied and &nil; on timeout.
    </simpara><simpara>This is the preferred and most portable way to wait on
      an exemption.</simpara></para>
   <simpara>Cf. <function role="unix">pthread_cond_wait</function>.</simpara>




------------------------------

------------------------------------------------------------------------------
Nokia and AT&T present the 2010 Calling All Innovators-North America contest
Create new apps & games for the Nokia N8 for consumers in  U.S. and Canada
$10 million total in prizes - $4M cash, 500 devices, nearly $6M in marketing
Develop with Nokia Qt SDK, Web Runtime, or Java and Publish to Ovi Store 
http://p.sf.net/sfu/nokia-dev2dev

------------------------------

_______________________________________________
clisp-cvs mailing list
cli...@li...
https://lists.sourceforge.net/lists/listinfo/clisp-cvs


End of clisp-cvs Digest, Vol 55, Issue 1
****************************************

clisp-cvs Digest, Vol 54, Issue 21

[<cli...@li...>]

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.7573, 1.7574 subr.d, 1.278, 1.279
      subrkw.d,	1.71, 1.72 xthread.d, 1.33, 1.34 zthread.d, 1.92, 1.93
      (Vladimir Tzankov)
   2. clisp/tests ChangeLog,1.670,1.671 mt.tst,1.25,1.26
      (Vladimir Tzankov)
   3. clisp/doc impext.xml,1.658,1.659 (Vladimir Tzankov)
   4. clisp/doc impext.xml,1.659,1.660 (Sam Steingold)


----------------------------------------------------------------------

Message: 1
Date: Sat, 30 Oct 2010 21:03:02 +0000
From: Vladimir Tzankov <vt...@us...>
Subject: clisp/src ChangeLog, 1.7573, 1.7574 subr.d, 1.278, 1.279
	subrkw.d,	1.71, 1.72 xthread.d, 1.33, 1.34 zthread.d, 1.92, 1.93
To: cli...@li...
Message-ID: <E1P...@sf...>

Update of /cvsroot/clisp/clisp/src
In directory sfp-cvsdas-2.v30.ch3.sourceforge.com:/tmp/cvs-serv27775/src

Modified Files:
	ChangeLog subr.d subrkw.d xthread.d zthread.d 
Log Message:
[MULTITHREAD]: add optional :TEST predicate to MT:EXEMPTION-WAIT


Index: subrkw.d
===================================================================
RCS file: /cvsroot/clisp/clisp/src/subrkw.d,v
retrieving revision 1.71
retrieving revision 1.72
diff -u -d -r1.71 -r1.72
--- subrkw.d	19 Feb 2010 20:36:06 -0000	1.71
+++ subrkw.d	30 Oct 2010 21:02:59 -0000	1.72
@@ -232,7 +232,7 @@
 s(mutex_lock)
 v(1, (kw(name)))
 s(make_exemption)
-v(1, (kw(timeout)))
+v(2, (kw(test),kw(timeout)))
 s(exemption_wait)
 #endif
 v(7, (kw(name),kw(code),kw(constants),kw(seclass),kw(lambda_list),kw(documentation),kw(jitc_p)) )

Index: zthread.d
===================================================================
RCS file: /cvsroot/clisp/clisp/src/zthread.d,v
retrieving revision 1.92
retrieving revision 1.93
diff -u -d -r1.92 -r1.93
--- zthread.d	21 Oct 2010 18:42:17 -0000	1.92
+++ zthread.d	30 Oct 2010 21:02:59 -0000	1.93
@@ -839,59 +839,95 @@
   VALUES1(TheExemption(obj)->xco_name);
 }
 
-LISPFUN(exemption_wait,seclass_default,2,0,norest,key,1,(kw(timeout)))
-{ /* (EXEMPTION-WAIT exemption mutex) */
+#if defined(POSIX_THREADS)
+/* UP: fills timespec with millis milliseconds form "now"
+   <> r: timespec to be filled
+   > millis: milliseconds */
+local inline struct timespec *get_abs_timeout(struct timespec *r,
+                                              uintL millis) {
+  var struct timeval tv;
+  gettimeofday(&tv, NULL);
+  r->tv_sec = tv.tv_sec + (tv.tv_usec + millis * 1000) / 1000000;
+  r->tv_nsec = 1000 * ((tv.tv_usec + millis*1000) % 1000000);
+  return r;
+}
+#endif
+
+LISPFUN(exemption_wait,seclass_default,2,0,norest,key,1,(kw(test),kw(timeout)))
+{ /* (EXEMPTION-WAIT exemption mutex :test predicate :timeout to) */
   var struct timeval tv;
   var struct timeval *tvp = sec_usec(popSTACK(),unbound,&tv);
-  STACK_0 = check_mutex(STACK_0);
-  STACK_1 = check_exemption(STACK_1);
-  if (!eq(TheMutex(STACK_0)->xmu_owner, current_thread()->_lthread)) {
+  if (!missingp(STACK_0) && !functionp(STACK_0))
+    STACK_0 = check_function_replacement(STACK_0);
+  STACK_1 = check_mutex(STACK_1);
+  STACK_2 = check_exemption(STACK_2);
+  if (!eq(TheMutex(STACK_1)->xmu_owner, current_thread()->_lthread)) {
     /* the mutex should be owned by the calling thread. */
-    var object mx = STACK_0;
+    var object mx = STACK_1;
     pushSTACK(mx); /* CELL-ERROR Slot NAME */
     pushSTACK(current_thread()->_lthread);
     pushSTACK(mx); pushSTACK(S(exemption_wait));
     error(control_error,GETTEXT("~S: mutex ~S should be owned by ~S"));
   }
-  /* we are the owners - let's see how many times we we have locked it */
-  if (TheMutex(STACK_0)->xmu_recurse_count != 1) {
+  /* we are the owners - let's see how many times it is locked */
+  if (TheMutex(STACK_1)->xmu_recurse_count != 1) {
     /* using recursive mutex with condition variables may cause really
        weird errors that are almost impossible to debug.
        Let's check that we have locked it only once. */
-    var object mx = STACK_0;
+    var object mx = STACK_1;
     pushSTACK(mx); /* CELL-ERROR Slot NAME */
     pushSTACK(current_thread()->_lthread);
     pushSTACK(mx); pushSTACK(S(exemption_wait));
     error(control_error,GETTEXT("~S: recursive mutex ~S is locked multiple times by ~S"));
   }
-  /* pthread_cond_wait() will release the OS mutex - so clear the owner. */
-  TheMutex(STACK_0)->xmu_owner = NIL; TheMutex(STACK_0)->xmu_recurse_count = 0;
   /* get the pointer before we allow the GC to run */
-  var xmutex_t *m = TheMutex(STACK_0)->xmu_system;
-  var xcondition_t *c = TheExemption(STACK_1)->xco_system;
-  var gcv_object_t *mxrec = &STACK_0; /*in case of interrupt STACK_0 != mutex*/
-  clisp_thread_t *thr = current_thread();
-  var int res;
-
-  thr->_wait_condition = c;
-  thr->_wait_mutex = m;
-  begin_system_call(); GC_SAFE_REGION_BEGIN();
-  if (tvp)
-    res = xcondition_timedwait(c,m,tvp->tv_sec*1000 + tvp->tv_usec/1000);
-  else
-    res = xcondition_wait(c,m);
-  thr->_wait_mutex = NULL;
-  thr->_wait_condition = NULL;
-  /* do not (possibly) handle pending interrupts here since on non-local exit
-     from interrupt we may leave the mutex object in inconsistent state*/
-  GC_SAFE_REGION_END_WITHOUT_INTERRUPTS(); end_system_call();
-
-  /* set again the owner. even in case of error - this should be fine. */
-  TheMutex(*mxrec)->xmu_owner = current_thread()->_lthread;
-  TheMutex(*mxrec)->xmu_recurse_count = 1;
-  /* handle (if any) interrupts */
-  HANDLE_PENDING_INTERRUPTS(thr);
-  skipSTACK(2);
+  var xmutex_t *m = TheMutex(STACK_1)->xmu_system;
+  var xcondition_t *c = TheExemption(STACK_2)->xco_system;
+  /* in case of interrupt STACK is changed - save pointers to objects needed
+     before handling the interrupt */
+  var gcv_object_t *mxrec = &STACK_1;
+  var gcv_object_t *predicate = &STACK_0;
+  var clisp_thread_t *thr = current_thread();
+  var int res = 0;
+  var bool wait_more = true;
+#ifdef POSIX_THREADS
+  /* absolute time is needed in order to handle properly possible
+     spurious wakeups */
+  var struct timespec _timeout, *timeout = tvp ?
+    get_abs_timeout(&_timeout,tvp->tv_sec*1000 + tvp->tv_usec/1000) : NULL;
+#else /* WIN32_THREADS */
+  var uintL _timeout, *timeout =
+    tvp ? (_timeout = tvp->tv_sec*1000 + tvp->tv_usec/1000, &_timeout) : NULL;
+#endif
+  while (wait_more) {
+    if (!missingp(*predicate)) { /* there is :test predicate */
+      funcall(*predicate,0);
+      if (!nullp(value1)) break;
+    } else
+      wait_more = false; /* on next iteration we will exit */
+    /* pthread_cond_wait() will release the OS mutex - so clear the owner. */
+    TheMutex(*mxrec)->xmu_owner = NIL; TheMutex(*mxrec)->xmu_recurse_count = 0;
+    /* mark on what the thread is waiting */
+    thr->_wait_condition = c;
+    thr->_wait_mutex = m;
+    begin_system_call(); GC_SAFE_REGION_BEGIN();
+    res = xcondition_wait(c,m,timeout);
+#ifdef POSIX_THREADS
+    /* handle possible spurious wakeups */
+    wait_more = (res == 0 && !missingp(*predicate));
+#endif
+    thr->_wait_mutex = NULL;
+    thr->_wait_condition = NULL;
+    /* do not (possibly) handle pending interrupts here since on non-local exit
+       from interrupt we may leave the mutex object in inconsistent state*/
+    GC_SAFE_REGION_END_WITHOUT_INTERRUPTS(); end_system_call();
+    /* set again the owner. even in case of error - this should be fine. */
+    TheMutex(*mxrec)->xmu_owner = current_thread()->_lthread;
+    TheMutex(*mxrec)->xmu_recurse_count = 1;
+    /* handle (if any) interrupts */
+    HANDLE_PENDING_INTERRUPTS(thr);
+  }
+  skipSTACK(3);
   VALUES1(res ? NIL : T);
 }
 
@@ -919,21 +955,7 @@
 /* LOW-LEVEL THREADS STUFF */
 
 /* TODO: not the right place to put these stuff. separate file is better ? */
-#if defined(POSIX_THREADS)
-
-/* UP: fills timespec with millis milliseconds form "now"
-   <> r: timespec to be filled
-   > millis: milliseconds */
-local inline void get_abs_timeout(struct timespec *r, uintL millis) {
-  var struct timeval tv;
-  gettimeofday(&tv, NULL);
-  r->tv_sec = tv.tv_sec + (tv.tv_usec + millis * 1000) / 1000000;
-  r->tv_nsec = 1000 * ((tv.tv_usec + millis*1000) % 1000000);
-}
-
-
-#else /* WIN32_THREADS */
-
+#if defined(WIN32_THREADS)
 /* UP: helper function for waiting on a condition associated with "raw" mutex
  > c: condition object
  > m: xmutex_raw_t object
@@ -946,12 +968,11 @@
   (c)->waiting_count++;
   LeaveCriticalSection(&(c)->cs);
   LeaveCriticalSection(m);
-  var DWORD timeout = millis == THREAD_WAIT_INFINITE ? INFINITE : millis;
+  var DWORD timeout = (millis == THREAD_WAIT_INFINITE) ? INFINITE : millis;
   var DWORD r = WaitForSingleObject((c)->sem,timeout);
   EnterCriticalSection(m);
   return r == WAIT_OBJECT_0 ? 0 : 1;
 }
-
 #endif
 
 /* UP: initializes xlock_t
@@ -1092,24 +1113,22 @@
    signals can be handled if arrive
    > c: the condition variable
    > m: the mutex /xlock_t/
-   > timeout: timeout in milliseconds
+   > timeout: timeout (NULL for infinite). POSIX_THREADS - this is pointer
+              to struct timespec. WIN32_THREADS - ptr to uintL in ms
    < Returns 0 on success, otherwise the error code from pthreads */
-int xcondition_wait_helper(xcondition_t *c,xlock_t *m, uintL timeout)
+int xcondition_wait(xcondition_t *c,xlock_t *m, void *timeout)
 {
   var int r=-1;
   /* mutex is owned by us and it is locked just once.
      our caller assures this */
   xlock_unlock_helper(m,false); /* mark as unlocked */
 #ifdef POSIX_THREADS
-  if (timeout != THREAD_WAIT_INFINITE) {
-    var struct timespec ww;
-    get_abs_timeout(&ww,timeout);
-    r = pthread_cond_timedwait(c,&m->xl_mutex,&ww);
-  } else {
-    r = pthread_cond_wait(c,&m->xl_mutex);
-  }
+  r = timeout ?
+    pthread_cond_timedwait(c,&m->xl_mutex,(struct timespec *)timeout) :
+    pthread_cond_wait(c,&m->xl_mutex);
 #else /* WIN32 */
-  r = win32_xcondition_wait(c,&m->xl_mutex,timeout);
+  r = win32_xcondition_wait(c,&m->xl_mutex,
+                            timeout ? *(uintL*)timeout : THREAD_WAIT_INFINITE);
 #endif
   /* mark again the mutex as ours */
   xlock_lock_helper(m,0,false);

Index: ChangeLog
===================================================================
RCS file: /cvsroot/clisp/clisp/src/ChangeLog,v
retrieving revision 1.7573
retrieving revision 1.7574
diff -u -d -r1.7573 -r1.7574
--- ChangeLog	28 Oct 2010 20:36:50 -0000	1.7573
+++ ChangeLog	30 Oct 2010 21:02:59 -0000	1.7574
@@ -1,3 +1,15 @@
+2010-10-30  Vladimir Tzankov  <vtz...@gm...>
+
+	[MULTITHREAD]: add optional :TEST predicate to MT:EXEMPTION-WAIT
+	* subr.d, subrkw.d (EXEMPTION-WAIT): accept optional :TEST argument
+	* xthread.d (xcondition_wait): accept timeout as void pointer. with
+	POSIX_THREADS it is absolute struct timespec, with WIN32_THREADS it is
+	unsigned integer specifying milliseconds to wait
+	* zthread.d (EXEMPTION-WAIT): loop until :TEST predicate is satisfied
+	thus simplifies EXEMPTION-WAIT usage with POSIX_THREADS where spurious
+	wakeups are possible
+	(xcondition_wait): handle timeout parameter properly
+
 2010-10-28  Sam Steingold  <sd...@gn...>
 
 	* modules/berkeley-db/bdb.c (time_stamp): make "prefix" const to avoid

Index: subr.d
===================================================================
RCS file: /cvsroot/clisp/clisp/src/subr.d,v
retrieving revision 1.278
retrieving revision 1.279
diff -u -d -r1.278 -r1.279
--- subr.d	21 Oct 2010 18:42:17 -0000	1.278
+++ subr.d	30 Oct 2010 21:02:59 -0000	1.279
@@ -1451,7 +1451,7 @@
 LISPFUN(make_exemption,seclass_default,0,0,norest,key,1,(kw(name)))
 LISPFUNNR(exemption_name,1)
 LISPFUNN(exemption_signal,1)
-LISPFUN(exemption_wait,seclass_default,2,0,norest,key,1,
-        (kw(timeout)))
+LISPFUN(exemption_wait,seclass_default,2,0,norest,key,2,
+        (kw(test),kw(timeout)))
 LISPFUNN(exemption_broadcast,1)
 #endif

Index: xthread.d
===================================================================
RCS file: /cvsroot/clisp/clisp/src/xthread.d,v
retrieving revision 1.33
retrieving revision 1.34
diff -u -d -r1.33 -r1.34
--- xthread.d	25 Oct 2009 13:51:35 -0000	1.33
+++ xthread.d	30 Oct 2010 21:02:59 -0000	1.34
@@ -34,7 +34,6 @@
 
  Upon entry to this file, one of these symbols shall be defined:
  POSIX_THREADS       POSIX.1c            pthread_*
- SOLARIS_THREADS     Solaris 2.4, 2.5    thr_*
  WIN32_THREADS       Win32               *Thread
 
  This file defines the following types:
@@ -78,9 +77,6 @@
    - Unlock a mutex.
    extern int            xmutex_unlock (xmutex_t* m);
  - Thread-local storage:
-   - (This is probably not useful at all. The number of thread-local storage
-   - words is limited: 512 on Win32, 128 with LinuxThreads. And it's probably
-   - much slower than my current_thread() function.)
    - Create a word of thread-local storage, and return a key to it.
    extern int            xthread_key_create (xthread_key_t* key);
    - Delete a word of thread-local storage.
@@ -91,8 +87,7 @@
    extern void           xthread_key_set (xthread_key_t key, void* value);
 */
 
-
-#if !(defined(POSIX_THREADS) || defined(SOLARIS_THREADS) || defined(WIN32_THREADS))
+#if !(defined(POSIX_THREADS) || defined(WIN32_THREADS))
   #error Define your flavour of multithreading
 #endif
 
@@ -241,7 +236,7 @@
 int xlock_destroy(xlock_t *l);
 int xlock_lock_helper(xlock_t *l, uintL timeout, bool lock_real);
 int xlock_unlock_helper(xlock_t *l, bool unlock_real);
-int xcondition_wait_helper(xcondition_t *c,xlock_t *m, uintL timeout);
+int xcondition_wait(xcondition_t *c,xlock_t *m, void *timeout);
 
 /* our lisp space mutex */
 #define xmutex_t  xlock_t
@@ -254,11 +249,6 @@
 #define xmutex_trylock(m)  xlock_lock_helper(m,0,true)
 #define xmutex_unlock(m)  xlock_unlock_helper(m,true)
 
-/* and some xcondition_t operations  */
-#define xcondition_wait(c,m)  xcondition_wait_helper(c,m,THREAD_WAIT_INFINITE)
-#define xcondition_timedwait(c,m,millis)  xcondition_wait_helper(c,m,millis)
-
-
 /* ==========================================================================
 
  Spin-locks.




------------------------------

Message: 2
Date: Sat, 30 Oct 2010 21:06:21 +0000
From: Vladimir Tzankov <vt...@us...>
Subject: clisp/tests ChangeLog,1.670,1.671 mt.tst,1.25,1.26
To: cli...@li...
Message-ID: <E1P...@sf...>

Update of /cvsroot/clisp/clisp/tests
In directory sfp-cvsdas-2.v30.ch3.sourceforge.com:/tmp/cvs-serv28655

Modified Files:
	ChangeLog mt.tst 
Log Message:
mt.tst: add tests for :TEST and :TIMEOUT arguments of EXEMPTION-WAIT


Index: mt.tst
===================================================================
RCS file: /cvsroot/clisp/clisp/tests/mt.tst,v
retrieving revision 1.25
retrieving revision 1.26
diff -u -d -r1.25 -r1.26
--- mt.tst	19 Feb 2010 20:36:06 -0000	1.25
+++ mt.tst	30 Oct 2010 21:06:19 -0000	1.26
@@ -182,16 +182,16 @@
 (sleep 0.5) NIL
 (thread-active-p *th3*) T ;; kill is deferred
 
-;; test exemtpion-broadcast and thread-interrupt :override
+;; test exemption-broadcast and thread-interrupt :override
 (with-mutex-lock (*mu1*)
   (thread-interrupt *th3* :function (lambda ()
                                       (with-mutex-lock (*mu1*)
                                         (setf *exemption-state* :broadcasted)
                                         (exemption-broadcast *exemption*)))
                     :override t)
-  (loop until (eq *exemption-state* :broadcasted)
-     do (exemption-wait *exemption* *mu1*)
-     finally (return *exemption-state*)))
+  (exemption-wait *exemption* *mu1*
+                  :test (lambda () (eq *exemption-state* :broadcasted)))
+  *exemption-state*)
 :BROADCASTED
 
 (thread-active-p *th3*) T ;; thread should be still running
@@ -199,6 +199,16 @@
 (thread-join *th3*) NIL
 (thread-active-p *th3*) NIL ;; should be dead
 
+;; exemption-wait with :timeout (and combined with test predicate)
+(let ((m (make-mutex))
+      (e (make-exemption)))
+  (with-timeout (5 t)
+    (with-mutex-lock (m)
+      (list
+       (exemption-wait e m :timeout 1)
+       (exemption-wait e m :timeout 1 :test (constantly nil))))))
+(NIL NIL)
+
 ;; create thread with very tiny lisp stack (thus preserving memory)
 ;; on mac osx lisp heap overlaps lisp stack regions (malloc-ed) when
 ;; the number of thread with big stacks is very high (will be inspected

Index: ChangeLog
===================================================================
RCS file: /cvsroot/clisp/clisp/tests/ChangeLog,v
retrieving revision 1.670
retrieving revision 1.671
diff -u -d -r1.670 -r1.671
--- ChangeLog	18 Oct 2010 22:19:24 -0000	1.670
+++ ChangeLog	30 Oct 2010 21:06:19 -0000	1.671
@@ -1,3 +1,7 @@
+2010-10-31  Vladimir Tzankov  <vtz...@gm...>
+
+	* mt.tst: add tests for :TEST and :TIMEOUT arguments of EXEMPTION-WAIT
+
 2010-10-18  Sam Steingold  <sd...@gn...>
 
 	* loop.tst: add a test for bug#3089988: (loop for x do (print x))




------------------------------

Message: 3
Date: Sat, 30 Oct 2010 21:07:49 +0000
From: Vladimir Tzankov <vt...@us...>
Subject: clisp/doc impext.xml,1.658,1.659
To: cli...@li...
Message-ID: <E1P...@sf...>

Update of /cvsroot/clisp/clisp/doc
In directory sfp-cvsdas-2.v30.ch3.sourceforge.com:/tmp/cvs-serv28908

Modified Files:
	impext.xml 
Log Message:
document :TEST argument of MT:EXEPMTION-WAIT


Index: impext.xml
===================================================================
RCS file: /cvsroot/clisp/clisp/doc/impext.xml,v
retrieving revision 1.658
retrieving revision 1.659
diff -u -d -r1.658 -r1.659
--- impext.xml	27 Oct 2010 18:25:28 -0000	1.658
+++ impext.xml	30 Oct 2010 21:07:47 -0000	1.659
@@ -4982,12 +4982,15 @@
   <simpara>Cf. <function role="unix">pthread_cond_signal</function>.</simpara>
 </listitem></varlistentry>
 <varlistentry id="exemption-wait"><term><code>(&exemption-wait;
-   &exemp-r; &mutex-r; &key-amp; &timeout-k;)</code></term>
+   &exemp-r; &mutex-r; &key-amp; &timeout-k; &test-k;)</code></term>
  <listitem><simpara>Wait for another &thread; to call &exemption-signal;
    or &exemption-broadcast; on &exemp-r;.
    &mutex-r; should be locked by the caller; otherwise an &err-sig;.
    The function releases the &mutex-r; and waits for &exemp-r;.
    On return &mutex-r; is acquired again.</simpara>
+  <simpara>When using exemptions there is always a boolean predicate involving
+   shared variables associated with each exemption wait that is true if the
+   thread should proceed.</simpara>
   <simpara>The function waits up to &timeout-k; &seconds;.
    If timeout is not specified, waits forever.</simpara><simpara>
    Returns &t; if &exemp-r; was signaled and &nil; on timeout.</simpara>
@@ -4995,9 +4998,17 @@
    <ulink url="http://en.wikipedia.org/wiki/Spurious_wakeup">spurious
     wakeup</ulink>s, i.e., this function may return &t; even though no
    thread called &exemption-broadcast; or &exemption-signal;.
-   Therefore, a common idiom for using this function is <code>(&loop;
-    :while (some-condition-is-satisfied) :do (&exemption-wait; &exemp-r;
-    &mutex-r;))</code>.</para>
+   Therefore, a common idiom for using this function is: <simpara><code>(&loop;
+   :until (some-predicate) :do (&exemption-wait; &exemp-r; &mutex-r;))</code>
+   </simpara><simpara>Optional &test-k; argument simplifies this. When supplied
+   &exemption-wait; returns when either &test-k; predicate is satisfied (always
+   called while &mutex-r; is held) or when &timeout-k; elapses. The above loop
+   is equivalent to:<simpara><code>(&exemption-wait; &exemp-r; &mutex-r;
+   &test-k; #'some-predicate)</code></simpara>
+   When &test-k; is supplied &exemption-wait; returns &t; when &exemp-r; was
+     signaled and &test-k; predicate is satisfied and &nil; on timeout.
+   </simpara><simpara>This is the preferred and most portable way to wait on
+     exemption.</simpara></para>
   <simpara>Cf. <function role="unix">pthread_cond_wait</function>.</simpara>
 </listitem></varlistentry>
 <varlistentry id="exemption-broadcast"><term><code>(&exemption-broadcast;




------------------------------

Message: 4
Date: Sun, 31 Oct 2010 06:10:51 +0000
From: Sam Steingold <sd...@us...>
Subject: clisp/doc impext.xml,1.659,1.660
To: cli...@li...
Message-ID: <E1P...@sf...>

Update of /cvsroot/clisp/clisp/doc
In directory sfp-cvsdas-2.v30.ch3.sourceforge.com:/tmp/cvs-serv27196

Modified Files:
	impext.xml 
Log Message:
tweak formatting


Index: impext.xml
===================================================================
RCS file: /cvsroot/clisp/clisp/doc/impext.xml,v
retrieving revision 1.659
retrieving revision 1.660
diff -u -d -r1.659 -r1.660
--- impext.xml	30 Oct 2010 21:07:47 -0000	1.659
+++ impext.xml	31 Oct 2010 06:10:49 -0000	1.660
@@ -4998,17 +4998,17 @@
    <ulink url="http://en.wikipedia.org/wiki/Spurious_wakeup">spurious
     wakeup</ulink>s, i.e., this function may return &t; even though no
    thread called &exemption-broadcast; or &exemption-signal;.
-   Therefore, a common idiom for using this function is: <simpara><code>(&loop;
+   Therefore, a common idiom for using this function is: <code>(&loop;
    :until (some-predicate) :do (&exemption-wait; &exemp-r; &mutex-r;))</code>
-   </simpara><simpara>Optional &test-k; argument simplifies this. When supplied
-   &exemption-wait; returns when either &test-k; predicate is satisfied (always
-   called while &mutex-r; is held) or when &timeout-k; elapses. The above loop
-   is equivalent to:<simpara><code>(&exemption-wait; &exemp-r; &mutex-r;
-   &test-k; #'some-predicate)</code></simpara>
-   When &test-k; is supplied &exemption-wait; returns &t; when &exemp-r; was
-     signaled and &test-k; predicate is satisfied and &nil; on timeout.
+  <simpara>The &test-k; argument simplifies this. When supplied,
+   &exemption-wait; returns when either &test-k; predicate is satisfied
+   (always called while &mutex-r; is held) or when &timeout-k; elapses.
+   The above loop is equivalent to: <code>(&exemption-wait; &exemp-r;
+    &mutex-r; &test-k; #'some-predicate)</code>.
+   When &test-k; is supplied, &exemption-wait; returns &t; when &exemp-r; was
+   signaled and &test-k; predicate is satisfied and &nil; on timeout.
    </simpara><simpara>This is the preferred and most portable way to wait on
-     exemption.</simpara></para>
+     an exemption.</simpara></para>
   <simpara>Cf. <function role="unix">pthread_cond_wait</function>.</simpara>
 </listitem></varlistentry>
 <varlistentry id="exemption-broadcast"><term><code>(&exemption-broadcast;




------------------------------

------------------------------------------------------------------------------
Nokia and AT&T present the 2010 Calling All Innovators-North America contest
Create new apps & games for the Nokia N8 for consumers in  U.S. and Canada
$10 million total in prizes - $4M cash, 500 devices, nearly $6M in marketing
Develop with Nokia Qt SDK, Web Runtime, or Java and Publish to Ovi Store 
http://p.sf.net/sfu/nokia-dev2dev

------------------------------

_______________________________________________
clisp-cvs mailing list
cli...@li...
https://lists.sourceforge.net/lists/listinfo/clisp-cvs


End of clisp-cvs Digest, Vol 54, Issue 21
*****************************************

clisp-cvs Digest, Vol 54, Issue 20

[<cli...@li...>]

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/berkeley-db bdb.c,1.136,1.137 (Sam Steingold)
   2. clisp/src ChangeLog,1.7571,1.7572 (Sam Steingold)
   3. clisp/modules/syscalls calls.c,1.322,1.323 (Sam Steingold)
   4. clisp/src ChangeLog,1.7572,1.7573 (Sam Steingold)


----------------------------------------------------------------------

Message: 1
Date: Thu, 28 Oct 2010 20:36:04 +0000
From: Sam Steingold <sd...@us...>
Subject: clisp/modules/berkeley-db bdb.c,1.136,1.137
To: cli...@li...
Message-ID: <E1P...@sf...>

Update of /cvsroot/clisp/clisp/modules/berkeley-db
In directory sfp-cvsdas-2.v30.ch3.sourceforge.com:/tmp/cvs-serv23505/modules/berkeley-db

Modified Files:
	bdb.c 
Log Message:
* modules/berkeley-db/bdb.c (time_stamp): make "prefix" const to avoid
warning: deprecated conversion from string constant to 'char*'


Index: bdb.c
===================================================================
RCS file: /cvsroot/clisp/clisp/modules/berkeley-db/bdb.c,v
retrieving revision 1.136
retrieving revision 1.137
diff -u -d -r1.136 -r1.137
--- bdb.c	24 May 2010 02:15:30 -0000	1.136
+++ bdb.c	28 Oct 2010 20:36:01 -0000	1.137
@@ -397,7 +397,7 @@
   wrap_finalize(dbe,NIL,`BDB::MKDBE`,``BDB::DBE-CLOSE``);
 }
 
-static void time_stamp (FILE* out, char* prefix) {
+static void time_stamp (FILE* out, const char* prefix) {
   fputs(prefix,out);
 #if defined(HAVE_GETTIMEOFDAY) && defined(HAVE_LOCALTIME) && defined(HAVE_STRFTIME)
   { char str[80]; struct timeval tv; gettimeofday(&tv,NULL);




------------------------------

Message: 2
Date: Thu, 28 Oct 2010 20:36:04 +0000
From: Sam Steingold <sd...@us...>
Subject: clisp/src ChangeLog,1.7571,1.7572
To: cli...@li...
Message-ID: <E1P...@sf...>

Update of /cvsroot/clisp/clisp/src
In directory sfp-cvsdas-2.v30.ch3.sourceforge.com:/tmp/cvs-serv23505/src

Modified Files:
	ChangeLog 
Log Message:
* modules/berkeley-db/bdb.c (time_stamp): make "prefix" const to avoid
warning: deprecated conversion from string constant to 'char*'


Index: ChangeLog
===================================================================
RCS file: /cvsroot/clisp/clisp/src/ChangeLog,v
retrieving revision 1.7571
retrieving revision 1.7572
diff -u -d -r1.7571 -r1.7572
--- ChangeLog	27 Oct 2010 23:56:00 -0000	1.7571
+++ ChangeLog	28 Oct 2010 20:36:02 -0000	1.7572
@@ -1,3 +1,8 @@
+2010-10-28  Sam Steingold  <sd...@gn...>
+
+	* modules/berkeley-db/bdb.c (time_stamp): make "prefix" const to avoid
+	warning: deprecated conversion from string constant to 'char*'
+
 2010-10-27  Bruno Haible  <br...@cl...>
 
 	* clhs.lisp (*browsers*): Add :firefox-window and :firefox-tab.




------------------------------

Message: 3
Date: Thu, 28 Oct 2010 20:36:52 +0000
From: Sam Steingold <sd...@us...>
Subject: clisp/modules/syscalls calls.c,1.322,1.323
To: cli...@li...
Message-ID: <E1P...@sf...>

Update of /cvsroot/clisp/clisp/modules/syscalls
In directory sfp-cvsdas-2.v30.ch3.sourceforge.com:/tmp/cvs-serv23680/modules/syscalls

Modified Files:
	calls.c 
Log Message:
* modules/syscalls/calls.c (POSIX:FILE-TREE-WALK): add a cast to
fix g++ compilation


Index: calls.c
===================================================================
RCS file: /cvsroot/clisp/clisp/modules/syscalls/calls.c,v
retrieving revision 1.322
retrieving revision 1.323
diff -u -d -r1.322 -r1.323
--- calls.c	20 Oct 2010 18:41:12 -0000	1.322
+++ calls.c	28 Oct 2010 20:36:50 -0000	1.323
@@ -2294,7 +2294,7 @@
       ret = nftw(path,nftw_fn,fd_limit,flags);
       end_blocking_system_call();
     });
-  VALUES1(ret ? STACK_1 : NIL); skipSTACK(2);
+  VALUES1(ret ? (object)STACK_1 : NIL); skipSTACK(2);
 }
 #endif  /* HAVE_NFTW */
 




------------------------------

Message: 4
Date: Thu, 28 Oct 2010 20:36:52 +0000
From: Sam Steingold <sd...@us...>
Subject: clisp/src ChangeLog,1.7572,1.7573
To: cli...@li...
Message-ID: <E1P...@sf...>

Update of /cvsroot/clisp/clisp/src
In directory sfp-cvsdas-2.v30.ch3.sourceforge.com:/tmp/cvs-serv23680/src

Modified Files:
	ChangeLog 
Log Message:
* modules/syscalls/calls.c (POSIX:FILE-TREE-WALK): add a cast to
fix g++ compilation


Index: ChangeLog
===================================================================
RCS file: /cvsroot/clisp/clisp/src/ChangeLog,v
retrieving revision 1.7572
retrieving revision 1.7573
diff -u -d -r1.7572 -r1.7573
--- ChangeLog	28 Oct 2010 20:36:02 -0000	1.7572
+++ ChangeLog	28 Oct 2010 20:36:50 -0000	1.7573
@@ -2,6 +2,8 @@
 
 	* modules/berkeley-db/bdb.c (time_stamp): make "prefix" const to avoid
 	warning: deprecated conversion from string constant to 'char*'
+	* modules/syscalls/calls.c (POSIX:FILE-TREE-WALK): add a cast to
+	fix g++ compilation
 
 2010-10-27  Bruno Haible  <br...@cl...>
 




------------------------------

------------------------------------------------------------------------------
Nokia and AT&T present the 2010 Calling All Innovators-North America contest
Create new apps & games for the Nokia N8 for consumers in  U.S. and Canada
$10 million total in prizes - $4M cash, 500 devices, nearly $6M in marketing
Develop with Nokia Qt SDK, Web Runtime, or Java and Publish to Ovi Store 
http://p.sf.net/sfu/nokia-dev2dev

------------------------------

_______________________________________________
clisp-cvs mailing list
cli...@li...
https://lists.sourceforge.net/lists/listinfo/clisp-cvs


End of clisp-cvs Digest, Vol 54, Issue 20
*****************************************

clisp-cvs Digest, Vol 54, Issue 19

[<cli...@li...>]

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/doc impext.xml,1.657,1.658 (Sam Steingold)
   2. clisp/src clhs.lisp,1.63,1.64 ChangeLog,1.7570,1.7571
      (Bruno Haible)


----------------------------------------------------------------------

Message: 1
Date: Wed, 27 Oct 2010 18:25:31 +0000
From: Sam Steingold <sd...@us...>
Subject: clisp/doc impext.xml,1.657,1.658
To: cli...@li...
Message-ID: <E1P...@sf...>

Update of /cvsroot/clisp/clisp/doc
In directory sfp-cvsdas-2.v30.ch3.sourceforge.com:/tmp/cvs-serv2737

Modified Files:
	impext.xml 
Log Message:
fix a typo reported by DonC


Index: impext.xml
===================================================================
RCS file: /cvsroot/clisp/clisp/doc/impext.xml,v
retrieving revision 1.657
retrieving revision 1.658
diff -u -d -r1.657 -r1.658
--- impext.xml	19 Oct 2010 20:59:28 -0000	1.657
+++ impext.xml	27 Oct 2010 18:25:28 -0000	1.658
@@ -4972,7 +4972,7 @@
   <simpara>Cf. <function role="unix">pthread_cond_init</function>.</simpara>
 </listitem></varlistentry>
 <varlistentry id="exemption-name"><term><code>(&exemption-name;
-   &thr;)</code></term>
+   &exemp-r;)</code></term>
  <listitem><simpara>Return the &name-r; of the &exemp-r;.
 </simpara></listitem></varlistentry>
 <varlistentry id="exemption-signal"><term><code>(&exemption-signal;




------------------------------

Message: 2
Date: Wed, 27 Oct 2010 23:56:03 +0000
From: Bruno Haible <ha...@us...>
Subject: clisp/src clhs.lisp,1.63,1.64 ChangeLog,1.7570,1.7571
To: cli...@li...
Message-ID: <E1P...@sf...>

Update of /cvsroot/clisp/clisp/src
In directory sfp-cvsdas-2.v30.ch3.sourceforge.com:/tmp/cvs-serv30332

Modified Files:
	clhs.lisp ChangeLog 
Log Message:
Add two more choices to *browsers*.


Index: clhs.lisp
===================================================================
RCS file: /cvsroot/clisp/clisp/src/clhs.lisp,v
retrieving revision 1.63
retrieving revision 1.64
diff -u -d -r1.63 -r1.64
--- clhs.lisp	15 Jul 2010 15:34:06 -0000	1.63
+++ clhs.lisp	27 Oct 2010 23:56:00 -0000	1.64
@@ -17,6 +17,8 @@
     (:mozilla-window "mozilla" "-remote" "openURL(~a,new-window)")
     (:mozilla-tab "mozilla" "-remote" "openURL(~a,new-tab)")
     (:firefox "firefox" "~a")
+    (:firefox-window "firefox" "-new-window" "~a")
+    (:firefox-tab "firefox" "-new-tab" "~a")
     (:konqueror "kfmclient" "openURL" "~a")
     (:lynx "lynx" "~a")
     #+unix (:lynx-xterm "xterm" "-e" "lynx" "~a")

Index: ChangeLog
===================================================================
RCS file: /cvsroot/clisp/clisp/src/ChangeLog,v
retrieving revision 1.7570
retrieving revision 1.7571
diff -u -d -r1.7570 -r1.7571
--- ChangeLog	21 Oct 2010 21:46:05 -0000	1.7570
+++ ChangeLog	27 Oct 2010 23:56:00 -0000	1.7571
@@ -1,3 +1,7 @@
+2010-10-27  Bruno Haible  <br...@cl...>
+
+	* clhs.lisp (*browsers*): Add :firefox-window and :firefox-tab.
+
 2010-10-22  Vladimir Tzankov  <vtz...@gm...>
 
 	* time.d (get_running_times_helper): fix real time calculation. use




------------------------------

------------------------------------------------------------------------------
Nokia and AT&T present the 2010 Calling All Innovators-North America contest
Create new apps & games for the Nokia N8 for consumers in  U.S. and Canada
$10 million total in prizes - $4M cash, 500 devices, nearly $6M in marketing
Develop with Nokia Qt SDK, Web Runtime, or Java and Publish to Ovi Store 
http://p.sf.net/sfu/nokia-dev2dev

------------------------------

_______________________________________________
clisp-cvs mailing list
cli...@li...
https://lists.sourceforge.net/lists/listinfo/clisp-cvs


End of clisp-cvs Digest, Vol 54, Issue 19
*****************************************

clisp-cvs Digest, Vol 54, Issue 18

[<cli...@li...>]

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.7569,1.7570 time.d,1.79,1.80
      (Vladimir Tzankov)


----------------------------------------------------------------------

Message: 1
Date: Thu, 21 Oct 2010 21:46:09 +0000
From: Vladimir Tzankov <vt...@us...>
Subject: clisp/src ChangeLog,1.7569,1.7570 time.d,1.79,1.80
To: cli...@li...
Message-ID: <E1P...@sf...>

Update of /cvsroot/clisp/clisp/src
In directory sfp-cvsdas-2.v30.ch3.sourceforge.com:/tmp/cvs-serv2314/src

Modified Files:
	ChangeLog time.d 
Log Message:
(get_running_times_helper): fix real time calculation. use the value returned from get_real_time()


Index: ChangeLog
===================================================================
RCS file: /cvsroot/clisp/clisp/src/ChangeLog,v
retrieving revision 1.7569
retrieving revision 1.7570
diff -u -d -r1.7569 -r1.7570
--- ChangeLog	21 Oct 2010 19:10:33 -0000	1.7569
+++ ChangeLog	21 Oct 2010 21:46:05 -0000	1.7570
@@ -1,3 +1,8 @@
+2010-10-22  Vladimir Tzankov  <vtz...@gm...>
+
+	* time.d (get_running_times_helper): fix real time calculation. use
+	the value returned from get_real_time()
+
 2010-10-21  Sam Steingold  <sd...@gn...>
 
 	* time.d (GET-INTERNAL-RUN-TIME): when *ANSI*!=NIL, reject the

Index: time.d
===================================================================
RCS file: /cvsroot/clisp/clisp/src/time.d,v
retrieving revision 1.79
retrieving revision 1.80
diff -u -d -r1.79 -r1.80
--- time.d	21 Oct 2010 19:10:33 -0000	1.79
+++ time.d	21 Oct 2010 21:46:06 -0000	1.80
@@ -242,14 +242,14 @@
     /* Get real time: */
     var internal_time_t real_time;
     get_real_time(&real_time);
-    tm->realtime.tv_sec = real_time.tv_sec - realstart_time.tv_sec;
+    tm->realtime.tv_sec = real_time.tv_sec - real_start.tv_sec;
     tm->realtime.tv_usec = real_time.tv_usec;
 #endif
 #ifdef TIME_WIN32
     /* Get real time: */
     var internal_time_t real_time;
     get_real_time(&real_time);
-    sub_internal_time(real_time,realstart_time, tm->realtime);
+    sub_internal_time(real_time,real_start, tm->realtime);
 #endif
   } else
     ret |= REAL_TIME_INVALID;




------------------------------

------------------------------------------------------------------------------
Nokia and AT&T present the 2010 Calling All Innovators-North America contest
Create new apps & games for the Nokia N8 for consumers in  U.S. and Canada
$10 million total in prizes - $4M cash, 500 devices, nearly $6M in marketing
Develop with Nokia Qt SDK, Web Runtime, or Java and Publish to Ovi Store 
http://p.sf.net/sfu/nokia-dev2dev

------------------------------

_______________________________________________
clisp-cvs mailing list
cli...@li...
https://lists.sourceforge.net/lists/listinfo/clisp-cvs


End of clisp-cvs Digest, Vol 54, Issue 18
*****************************************

clisp-cvs Digest, Vol 54, Issue 17

[<cli...@li...>]

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.7566,1.7567 pathname.d,1.525,1.526
      (Sam Steingold)
   2. clisp/tests path.tst,1.93,1.94 (Sam Steingold)
   3. clisp/src ChangeLog, 1.7567, 1.7568 lispbibl.d, 1.915, 1.916
      spvw.d,	1.542, 1.543 spvw_gcstat.d, 1.9, 1.10 stream.d, 1.691,
      1.692 subr.d, 1.277, 1.278 time.d, 1.77, 1.78 zthread.d, 1.91,
      1.92 (Vladimir Tzankov)
   4. clisp/src ChangeLog,1.7568,1.7569 time.d,1.78,1.79 (Sam Steingold)


----------------------------------------------------------------------

Message: 1
Date: Thu, 21 Oct 2010 15:35:27 +0000
From: Sam Steingold <sd...@us...>
Subject: clisp/src ChangeLog,1.7566,1.7567 pathname.d,1.525,1.526
To: cli...@li...
Message-ID: <E1P...@sf...>

Update of /cvsroot/clisp/clisp/src
In directory sfp-cvsdas-2.v30.ch3.sourceforge.com:/tmp/cvs-serv8831/src

Modified Files:
	ChangeLog pathname.d 
Log Message:
whitespace


Index: pathname.d
===================================================================
RCS file: /cvsroot/clisp/clisp/src/pathname.d,v
retrieving revision 1.525
retrieving revision 1.526
diff -u -d -r1.525 -r1.526
--- pathname.d	21 Oct 2010 03:00:46 -0000	1.525
+++ pathname.d	21 Oct 2010 15:35:24 -0000	1.526
@@ -6004,7 +6004,7 @@
         ? &filedata.ftLastWriteTime : &filedata.ftCreationTime);
       if (fsize) *fsize = off_to_I(
         ((uint64)filedata.nFileSizeHigh<<32)|filedata.nFileSizeLow);
-      if (filedata.dwFileAttributes & FILE_ATTRIBUTE_DIRECTORY) 
+      if (filedata.dwFileAttributes & FILE_ATTRIBUTE_DIRECTORY)
         return NAMESTRING_DIR;
       else return NAMESTRING_FILE;
     } else {
@@ -6043,8 +6043,8 @@
                  namestring_asciz, {
     while (true) {
       classification = classify_namestring(namestring_asciz,resolved,
-                                         &STACK_1/*fwd*/,&STACK_2/*fsize*/);
-      if (classification == NAMESTRING_NONE 
+                                           &STACK_1/*fwd*/,&STACK_2/*fsize*/);
+      if (classification == NAMESTRING_NONE
           && namestring_asciz_bytelen > 1    /* no need to classify "" */
           && cpslashp(namestring_asciz[namestring_asciz_bytelen-1]))
         namestring_asciz[--namestring_asciz_bytelen] = 0; /* strip last slash */

Index: ChangeLog
===================================================================
RCS file: /cvsroot/clisp/clisp/src/ChangeLog,v
retrieving revision 1.7566
retrieving revision 1.7567
diff -u -d -r1.7566 -r1.7567
--- ChangeLog	21 Oct 2010 08:07:08 -0000	1.7566
+++ ChangeLog	21 Oct 2010 15:35:24 -0000	1.7567
@@ -1,6 +1,6 @@
 2010-10-21  Arseny Slobodyuk  <am...@us...>
 
-	* makemake.in (cygwin_finish): use realpath and cygpath to 
+	* makemake.in (cygwin_finish): use realpath and cygpath to
 	avoid cygcheck bug with symbolic links
 
 2010-10-21  Arseny Slobodyuk  <am...@us...>
@@ -8,7 +8,7 @@
 	Fix PROBE-PATHNAME: proper handle of "/" on UNIX,
 	DWIM on WIN32 (broken 10-18) "lisp.exe/" -> "path/lisp.exe"
 	* pathname.d (PROBE-PATHNAME): strip last "/" in a loop
-	(classify_namestring) [UNIX]: handle ENOTDIR 
+	(classify_namestring) [UNIX]: handle ENOTDIR
 	like ERROR_INVALID_NAME is handled on WIN32
 
 2010-10-20  Sam Steingold  <sd...@gn...>




------------------------------

Message: 2
Date: Thu, 21 Oct 2010 17:13:57 +0000
From: Sam Steingold <sd...@us...>
Subject: clisp/tests path.tst,1.93,1.94
To: cli...@li...
Message-ID: <E1P...@sf...>

Update of /cvsroot/clisp/clisp/tests
In directory sfp-cvsdas-2.v30.ch3.sourceforge.com:/tmp/cvs-serv24790

Modified Files:
	path.tst 
Log Message:
yet another win32 ext:probe-pathname test


Index: path.tst
===================================================================
RCS file: /cvsroot/clisp/clisp/tests/path.tst,v
retrieving revision 1.93
retrieving revision 1.94
diff -u -d -r1.93 -r1.94
--- path.tst	15 Oct 2010 18:52:36 -0000	1.93
+++ path.tst	21 Oct 2010 17:13:55 -0000	1.94
@@ -1291,6 +1291,13 @@
   (list (pathname-name p) (pathname-type p)))
 #+(and clisp win32) (NIL NIL)
 
+#+(and clisp win32)
+(equalp (multiple-value-list (ext:probe-pathname "/"))
+        (multiple-value-list (ext:probe-pathname ; default device
+                              (make-pathname :directory '(:absolute) :defaults
+                                             (ext:default-directory)))))
+#+(and clisp win32) T
+
 #+(and clisp unicode)
 (block test-weird-pathnames
   (handler-bind ((parse-error




------------------------------

Message: 3
Date: Thu, 21 Oct 2010 18:42:20 +0000
From: Vladimir Tzankov <vt...@us...>
Subject: clisp/src ChangeLog, 1.7567, 1.7568 lispbibl.d, 1.915, 1.916
	spvw.d,	1.542, 1.543 spvw_gcstat.d, 1.9, 1.10 stream.d, 1.691,	1.692
	subr.d, 1.277, 1.278 time.d, 1.77, 1.78 zthread.d, 1.91, 1.92
To: cli...@li...
Message-ID: <E1P...@sf...>

Update of /cvsroot/clisp/clisp/src
In directory sfp-cvsdas-2.v30.ch3.sourceforge.com:/tmp/cvs-serv27699/src

Modified Files:
	ChangeLog lispbibl.d spvw.d spvw_gcstat.d stream.d subr.d 
	time.d zthread.d 
Log Message:
[MULTITHREAD]: provide real/run time information on individual threads when supported by OS


Index: spvw_gcstat.d
===================================================================
RCS file: /cvsroot/clisp/clisp/src/spvw_gcstat.d,v
retrieving revision 1.9
retrieving revision 1.10
diff -u -d -r1.9 -r1.10
--- spvw_gcstat.d	17 Nov 2008 23:15:18 -0000	1.9
+++ spvw_gcstat.d	21 Oct 2010 18:42:17 -0000	1.10
@@ -48,10 +48,10 @@
 
 #define gc_timer_on()                                                   \
   { var internal_time_t gcstart_time;                                   \
-    get_running_time(gcstart_time); /* get current elapsed time and store */
+  get_run_time(&gcstart_time); /* get current elapsed time and store */
 #define gc_timer_off()                                                \
   { var internal_time_t gcend_time;                                   \
-    get_running_time(gcend_time);                                     \
+    get_run_time(&gcend_time);                                        \
     /* calculate difference between gcend_time and gcstart_time: */   \
     sub_internal_time(gcend_time,gcstart_time, gcend_time);           \
     /* add this difference to gc_time: */                             \

Index: zthread.d
===================================================================
RCS file: /cvsroot/clisp/clisp/src/zthread.d,v
retrieving revision 1.91
retrieving revision 1.92
diff -u -d -r1.91 -r1.92
--- zthread.d	4 Oct 2010 21:52:12 -0000	1.91
+++ zthread.d	21 Oct 2010 18:42:17 -0000	1.92
@@ -15,7 +15,7 @@
 global xmutex_t all_exemptions_lock;
 
 /* signals an error of obj is not thread. returns the thread*/
-local maygc object check_thread(object obj)
+global maygc object check_thread(object obj)
 {
   while (!threadp(obj)) {
     pushSTACK(NIL);             /* no PLACE */
@@ -255,6 +255,7 @@
        error (error xxx) happens in the thread. */
     finish_entry_frame(DRIVER,returner,,{
       skipSTACK(2+3+1);STACK_0=NIL;goto end_of_thread;});
+    init_time(); /* initialize thread time variables */
     /* initialize the low level i/o stuff for this thread*/
     init_reader_low(me);
     /* initialize thread special variables bindings */

Index: stream.d
===================================================================
RCS file: /cvsroot/clisp/clisp/src/stream.d,v
retrieving revision 1.691
retrieving revision 1.692
diff -u -d -r1.691 -r1.692
--- stream.d	28 Sep 2010 14:22:21 -0000	1.691
+++ stream.d	21 Oct 2010 18:42:17 -0000	1.692
@@ -3997,7 +3997,7 @@
 nonreturning_function(extern, error_unencodable, (object encoding, chart ch));
 
 /* Avoid annoying warning caused by a wrongly standardized iconv() prototype. */
-#ifdef GNU_LIBICONV
+#if defined(GNU_LIBICONV) && !defined(UNIX_MACOSX)
   #undef iconv
   #define iconv(cd,inbuf,inbytesleft,outbuf,outbytesleft) \
     libiconv(cd,(ICONV_CONST char **)(inbuf),inbytesleft,outbuf,outbytesleft)
@@ -4758,11 +4758,9 @@
   var uintB b;
   pushSTACK(stream);
   /*restart_it:*/
-  run_time_stop(); /* hold run time clock */
   /* try to read a byte */
   var ssize_t result;
   GC_SAFE_SYSTEM_CALL(result=, full_read(handle,&b,1));
-  run_time_restart(); /* resume run time clock */
   stream=popSTACK();
   if (result<0) {
     #ifdef WIN32_NATIVE
@@ -5035,12 +5033,10 @@
   if ((persev == persev_immediate || persev == persev_bonus)
       && ChannelStream_regular(stream))
     persev = persev_partial;
-  run_time_stop(); /* hold run time clock */
   pushSTACK(stream);
   var ssize_t result;
   GC_SAFE_SYSTEM_CALL(result=, fd_read(handle,byteptr,len,persev));
   stream = popSTACK();
-  run_time_restart(); /* resume run time clock */
   if (result<0) {
    #if !defined(WIN32_NATIVE)
     begin_system_call();
@@ -8768,11 +8764,9 @@
   { /* read a character: */
     var uintB c;
    read_next_char: {
-      run_time_stop(); /* hold run time clock */
       begin_system_call();
       var int result = read(stdin_handle,&c,1); /* try to read a byte */
       end_system_call();
-      run_time_restart(); /* resume run time clock */
       if (result<0) {
         begin_system_call();
         if (errno==EINTR) { /* break (poss. by Ctrl-C) ? */
@@ -8838,11 +8832,9 @@
       pollfd_bag[0].events = POLLIN;
       pollfd_bag[0].revents = 0;
      restart_poll:
-      run_time_stop(); /* hold run time clock */
       begin_system_call();
       var int result = poll(&pollfd_bag[0],1,100); /* 1/10 sec */
       end_system_call();
-      run_time_restart(); /* resume run time clock */
       if (result<0) {
         begin_system_call();
         if (errno==EINTR) {
@@ -8865,12 +8857,10 @@
       FD_ZERO(&handle_set); FD_SET(stdin_handle,&handle_set);
     restart_select:
       small_time.tv_sec = 0; small_time.tv_usec = 1000000/10; /* 1/10 sec */
-      run_time_stop(); /* hold run time clock */
       begin_system_call();
       var int result;
       result = select(FD_SETSIZE,&handle_set,NULL,NULL,&small_time);
       end_system_call();
-      run_time_restart(); /* resume run time clock */
       if (result<0) {
         begin_system_call();
         if (errno==EINTR) {
@@ -8899,7 +8889,6 @@
       var struct termio oldtermio;
       var struct termio newtermio;
      #endif
-      run_time_stop(); /* hold run time clock */
       begin_system_call();
      #ifdef UNIX_TERM_TERMIOS
       if (!( tcgetattr(stdin_handle,&oldtermio) ==0)) {
@@ -8937,7 +8926,6 @@
       }
      #endif
       end_system_call();
-      run_time_restart(); /* resume run time clock */
       if (result<0) {
         begin_system_call();
         if (errno==EINTR) { /* break (poss. by Ctrl-C) ? */
@@ -9733,12 +9721,10 @@
       rl_basic_word_break_characters = "\t\n \"#'(),;`";
       rl_basic_quote_characters = "\"|";
       rl_completer_quote_characters = "\\|";
-      run_time_stop(); /* hold run time clock */
       begin_blocking_system_call();
       rl_already_prompted = true;
       var char* line = strip_white(readline(prompt==NULL ? "" : prompt));
       end_blocking_system_call();
-      run_time_restart(); /* resume run time clock */
       if (line==NULL)
         /* detect EOF (at the start of line) */
         return eof_value;

Index: time.d
===================================================================
RCS file: /cvsroot/clisp/clisp/src/time.d,v
retrieving revision 1.77
retrieving revision 1.78
diff -u -d -r1.77 -r1.78
--- time.d	25 Oct 2009 14:01:16 -0000	1.77
+++ time.d	21 Oct 2010 18:42:17 -0000	1.78
@@ -44,15 +44,48 @@
 #ifdef TIME_WIN32
   /* The unit is 0.1 µsec. */
 #endif
-  /* Running time: */
+  /* Real time: */
+local bool realstart_time_initialized = false;
 local internal_time_t realstart_time; /* real time at start of LISP session */
-#ifndef HAVE_RUN_TIME
-/* Time that the LISP session consumes: */
-local uintL run_time = 0;       /* total runtime up to now */
-local uintL runstop_time;       /* if the stop watch is running:
-                                   the time of the last run-stop change */
-local bool run_flag = false; /* true if the stop watch is running */
+
+/* UP: return thread object from optional argument passed to
+   GET-INTERNAL-RUN-TIME and %%TIME
+   < obj: optional argument passed
+   > thread object (always nullobj w/o threads) */
+local inline object thread_from_arg(object obj) {
+#ifndef MULTITHREAD
+  return nullobj;
+#else
+  return missingp(obj) ? nullobj :
+    ((eq(T,obj)) ? current_thread()->_lthread : check_thread(obj));
+#endif
+}
+
+/* UP: gets thread or process real start time */
+local /*maygc*/ bool real_start_time(object thread, internal_time_t *tp) {
+  var bool ret = true;
+  if (eq(thread, nullobj)) /* always true when ! MT*/
+    *tp = realstart_time;
+  else
+#ifdef MULTITHREAD
+    if (eq(thread, current_thread()->_lthread)) /* we are alive for sure */
+      *tp = current_thread()->thr_realstart_time;
+    else {
+      /* it's another thread - have to be sure it does not exit while we
+         obtain its real start time (xth_globals are released upon termination)*/
+      pushSTACK(thread);
+      WITH_OS_MUTEX_LOCK(1,&allthreads_lock, {
+        var clisp_thread_t *clt = TheThread(STACK_0)->xth_globals;
+        if ((ret = (clt != NULL))) /* still alive */
+          *tp = clt->thr_realstart_time;
+      });
+      skipSTACK(1);
+    }
+#else /* ! MT */
+    ASSERT(0); /* w/o MT thread == nullobj always */
 #endif
+  return ret;
+}
 
 #ifdef TIME_UNIX
 
@@ -79,20 +112,39 @@
 }
 
 /* Returns the run time counter.
- get_run_time(&runtime);
- < internal_time_t runtime: consumed run time since session start (in ticks) */
-global void get_run_time (internal_time_t* runtime)
+ get_thread_run_time(&runtime, thread);
+ > thread: thread for which to obtain info (nullobj for process wide)
+ < internal_time_t runtime: consumed run time since session start (in ticks)
+ < returns true if successful (may fail in MT) */
+global bool get_thread_run_time (internal_time_t* runtime, object thread)
 {
  #if defined(HAVE_GETRUSAGE)
   var struct rusage rusage;
+  var int who = RUSAGE_SELF;
+#ifdef MULTITHREAD
+  if (!eq(thread, nullobj)) {
+  #ifdef RUSAGE_THREAD
+    /* we can obtain info only about current thread */
+    if (!eq(thread, current_thread()->_lthread))
+      return false;
+    who = RUSAGE_THREAD;
+  #else
+    /* TODO: implement for UNIX_MACOSX */
+    return false; /* no RUSAGE_THREAD  */
+  #endif
+  }
+#endif
   begin_system_call();
-  if (!( getrusage(RUSAGE_SELF,&rusage) ==0)) { OS_error(); }
+  if (!( getrusage(who,&rusage) ==0)) { OS_error(); }
   end_system_call();
   /* runtime = user time + system time */
   add_internal_time(rusage.ru_utime,rusage.ru_stime, *runtime);
  #elif defined(HAVE_SYS_TIMES_H)
   var uintL used_time;     /* consumed time, measured in 1/HZ seconds */
   var struct tms tms;
+#ifdef MULTITHREAD
+  if (!eq(thread, nullobj)) return false;
+#endif
   begin_system_call();
   if (times(&tms) == (clock_t)(-1))
     used_time = 0;             /* times() failed -> used_time unknown */
@@ -112,6 +164,7 @@
   runtime->tv_sec = floor(used_time,HZ);
   runtime->tv_usec = (used_time % HZ) * floor(2*1000000+HZ,2*HZ);
  #endif
+  return true;
 }
 
 #endif
@@ -125,72 +178,102 @@
 { GetSystemTimeAsFileTime(it); }
 
 /* Returns the run time counter.
- get_run_time(&runtime);
- < internal_time_t runtime: consumed run time since session start (in ticks) */
-global void get_run_time (internal_time_t* runtime)
+ get_thread_run_time(&runtime, thread);
+ > thread: thread for which to obtain info (nullobj for process wide)
+ < internal_time_t runtime: consumed run time since session start (in ticks)
+ < returns true if successful (may fail in MT) */
+global bool get_thread_run_time (internal_time_t* runtime, object thread)
 {
   var FILETIME creation_time;
   var FILETIME exit_time;
   var FILETIME kernel_time;
   var FILETIME user_time;
-  begin_system_call();
-  if (GetProcessTimes(GetCurrentProcess(),&creation_time,&exit_time,
-                      &kernel_time,&user_time)) {
+  var BOOL time_obtained;
+#ifdef MULTITHREAD
+  if (!eq(thread, nullobj)) {
+    time_obtained = FALSE;
+    var HANDLE hThread = OpenThread(THREAD_QUERY_INFORMATION , FALSE,
+                                    TheThread(thread)->xth_system);
+    if (hThread != NULL) {
+      time_obtained = GetThreadTimes(hThread,&creation_time, &exit_time,
+                                     &kernel_time,&user_time);
+      CloseHandle(hThread);
+    }
+    if (!time_obtained) return false;
+  } else
+#endif
+  {
+    begin_system_call();
+    time_obtained = GetProcessTimes(GetCurrentProcess(),&creation_time,
+                                    &exit_time,&kernel_time,&user_time);
     end_system_call();
+  }
+
+  if (time_obtained) {
     /* runtime = User time + Kernel time */
     add_internal_time(user_time,kernel_time, *runtime);
   } else {
     if (!(GetLastError()==ERROR_CALL_NOT_IMPLEMENTED)) { OS_error(); }
     /* GetProcessTimes() is not implemented on Win95. Use get_real_time()
      instead. This is only a crude approximation, I know.
-     (We keep HAVE_RUN_TIME defined, so that Win95 users will notice
-     that "Run time" and "Real time" are always the same and draw their
-     conclusions from it.) */
-    end_system_call();
+     ( Win95 users will notice that "Run time" and "Real time" are always
+     the same and draw their conclusions from it.) */
     var internal_time_t real_time;
     get_real_time(&real_time);
     sub_internal_time(real_time,realstart_time, *runtime);
   }
+  return true;
 }
-
 #endif
 
-/* Returns the whole set of run time counters.
- get_running_times(&timescore);
- < timescore.runtime:  consumed run time since start of session (in ticks)
- < timescore.realtime: real time since start of session (in ticks)
- < timescore.gctime:   GC time since start of session (in ticks)
- < timescore.gccount:  number of GCs since start of session
- < timescore.gcfreed:  number of reclaimed bytes since start of session */
-global void get_running_times (timescore_t* tm)
-{
- #ifndef HAVE_RUN_TIME
-  var uintL time = get_time();
-  tm->realtime = time - realstart_time;
-  tm->runtime = (run_flag ?
-                 time - runstop_time + run_time : /* stop-watch still running*/
-                 run_time);  /* stop-watched stopped */
- #endif
- #ifdef TIME_UNIX
-  /* Get real time: */
-  var internal_time_t real_time;
-  get_real_time(&real_time);
-  tm->realtime.tv_sec = real_time.tv_sec - realstart_time.tv_sec;
-  tm->realtime.tv_usec = real_time.tv_usec;
-  /* Get run time: */
-  get_run_time(&tm->runtime);
- #endif
- #ifdef TIME_WIN32
-  /* Get real time: */
-  var internal_time_t real_time;
-  get_real_time(&real_time);
-  sub_internal_time(real_time,realstart_time, tm->realtime);
-  /* Get run time: */
-  get_run_time(&tm->runtime);
- #endif
+/* UP: helper function for obtaining timing statistics for thread/process
+   > thread: thread for which we want info. nullobj for process
+   < tm: run time, real time, gc time and gc stat
+   < returns bitmask indicating which fields in tm are valid
+ Failures are possible only in threaded builds. Asking for process info
+ always succeeds and does not GC */
+#define RUN_TIME_INVALID  1
+#define REAL_TIME_INVALID 2
+local uintL /*maygc*/ get_running_times_helper (timescore_t* tm, object thread) {
+  var uintL ret = 0; /* everything valid */
+  var internal_time_t real_start;
+  if (real_start_time(thread, &real_start)) {
+#ifdef TIME_UNIX
+    /* Get real time: */
+    var internal_time_t real_time;
+    get_real_time(&real_time);
+    tm->realtime.tv_sec = real_time.tv_sec - realstart_time.tv_sec;
+    tm->realtime.tv_usec = real_time.tv_usec;
+#endif
+#ifdef TIME_WIN32
+    /* Get real time: */
+    var internal_time_t real_time;
+    get_real_time(&real_time);
+    sub_internal_time(real_time,realstart_time, tm->realtime);
+#endif
+  } else
+    ret |= REAL_TIME_INVALID;
+   /* Get run time: */
+  if (!get_thread_run_time(&tm->runtime, thread))
+    ret |= RUN_TIME_INVALID;
+  /* GC stat */
   tm->gctime = gc_time;
   tm->gccount = gc_count;
   tm->gcfreed = gc_space;
+  return ret;
+}
+
+
+/* Returns the whole set of run time counters.
+ get_running_times(&timescore);
+ < timescore.runtime:  Run-time since LISP-system-start (in Ticks)
+ < timescore.realtime: Real-time since LISP-system-start (in Ticks)
+ < timescore.gctime:   GC-Time since LISP-system-start (in Ticks)
+ < timescore.gccount:  Number of GC's since LISP-system-start
+ < timescore.gcfreed:  Size of the space reclaimed by the GC's so far*/
+global void get_running_times (timescore_t* tm) {
+  /* no failure or GC possible with following call  */
+  get_running_times_helper(tm, nullobj);
 }
 
 /* Converts an internal_time_t to a Lisp integer.
@@ -222,11 +305,14 @@
   VALUES1(internal_time_to_I(&tp)); /* convert to integer */
 }
 
-LISPFUNNR(get_internal_run_time,0)
-{ /* (GET-INTERNAL-RUN-TIME), CLTL p. 446 */
-  var timescore_t tm;
-  get_running_times(&tm); /* get run time since start of session */
-  VALUES1(internal_time_to_I(&tm.runtime)); /* convert to integer */
+LISPFUN(get_internal_run_time,seclass_read,0,1,norest,nokey,0,NIL)
+{ /* (GET-INTERNAL-RUN-TIME), CLTL p. 446
+     extension: optional argument (GET-INTERNAL-RUN-TIME thread) */
+  var internal_time_t tp;
+  if (get_thread_run_time(&tp, thread_from_arg(popSTACK())))
+    VALUES1(internal_time_to_I(&tp)); /* convert to integer */
+  else
+    VALUES1(NIL); /* could not obtain it */
 }
 
 /* ------------------------------------------------------------------------
@@ -378,21 +464,21 @@
   VALUES1(UL_to_I(real_time_sec()));
 }
 
-/* UP: Initialises the time variables at the LISP session start.
+/* UP: Initialises the time variables at the LISP session/thread start.
  init_time(); */
-global void init_time (void)
-{ /* No gc happened -> no time to be added.
-     gc_count=0;
-     gc_time=0;
-     gc_space=0; */
- #ifndef HAVE_RUN_TIME
-  /* run_time = 0; -- no run-time used, */
-  run_flag = false;         /* because system is not yet running. */
-  run_time_restart();       /* start run-time stopwatch */
- #endif
- #if defined(TIME_UNIX) || defined(TIME_WIN32)
-  get_real_time(&realstart_time); /* Current time counter, now at the session start */
- #endif
+void init_time () {
+#ifdef MULTITHREAD
+  get_real_time(&current_thread()->thr_realstart_time);
+  if (!realstart_time_initialized) {
+    realstart_time = current_thread()->thr_realstart_time;
+    realstart_time_initialized = true;
+  }
+#else /* ! MT */
+  if (!realstart_time_initialized) {
+    get_real_time(&realstart_time);
+    realstart_time_initialized = true;
+  }
+#endif
 }
 
 /* ------------------------------------------------------------------------
@@ -573,8 +659,8 @@
 }
 #endif
 
-LISPFUNNR(time,0)
-{ /* (SYSTEM::%%TIME) returns the time/space resource usage,
+LISPFUN(time,seclass_read,0,1,norest,nokey,0,NIL)
+{ /* (SYSTEM::%%TIME thread) returns the time/space resource usage,
      without allocating space by itself and thereby causing a GC.
  9 values:
    Real-Time (system time since system start) in 2 values,
@@ -592,25 +678,32 @@
      in 2 values: (ldb (byte 24 24) Space), (ldb (byte 24 0) Space).
    GC-Count (number of garbage collections in this session so far). */
   var timescore_t tm;
-  get_running_times(&tm);     /* get run-time */
+  var uintL ts = get_running_times_helper(&tm, thread_from_arg(popSTACK()));
  #if defined(TIME_UNIX)
   #define as_2_values(time)                 \
     pushSTACK(fixnum(time.tv_sec));         \
     pushSTACK(fixnum(time.tv_usec));
  #elif defined(TIME_WIN32)
-  #define as_2_values(time)               \
-    { var uintL tv_sec;                       \
-      var uintL tv_usec;                                              \
+  #define as_2_values(time)                 \
+    { var uintL tv_sec;                     \
+      var uintL tv_usec;                    \
       divu_6432_3232(time.dwHighDateTime,time.dwLowDateTime,ticks_per_second, tv_sec=, tv_usec=); \
-      pushSTACK(fixnum(tv_sec));                                      \
-      pushSTACK(fixnum(tv_usec));                                     \
+      pushSTACK(fixnum(tv_sec));            \
+      pushSTACK(fixnum(tv_usec));           \
     }
  #else
   #error SYSTEM::%%TIME: neither TIME_UNIX nor TIME_WIN32
  #endif
-  as_2_values(tm.realtime);   /* first two values: Real-Time */
-  as_2_values(tm.runtime);    /* next two values: Run-Time */
-  as_2_values(tm.gctime);     /* next two values: GC-Time */
+  /* first two values: Real-Time */
+  if (ts & REAL_TIME_INVALID) {
+    pushSTACK(NIL); pushSTACK(NIL);
+  } else { as_2_values(tm.realtime); }
+  /* next two values: Run-Time */
+  if (ts & RUN_TIME_INVALID) {
+    pushSTACK(NIL); pushSTACK(NIL);
+  } else { as_2_values(tm.runtime); }
+   /* next two values: GC-Time */
+  as_2_values(tm.gctime);
   /* next two values: Space
      tm.gcfreed = freed space by the GC */
   {

Index: subr.d
===================================================================
RCS file: /cvsroot/clisp/clisp/src/subr.d,v
retrieving revision 1.277
retrieving revision 1.278
diff -u -d -r1.277 -r1.278
--- subr.d	19 Feb 2010 20:36:06 -0000	1.277
+++ subr.d	21 Oct 2010 18:42:17 -0000	1.278
@@ -739,13 +739,13 @@
 #endif
 /* ---------- TIME ---------- */
 LISPFUNNR(get_internal_real_time,0)
-LISPFUNNR(get_internal_run_time,0)
+LISPFUN(get_internal_run_time,seclass_read,0,1,norest,nokey,0,NIL)
 LISPFUNNR(get_universal_time,0)
 #if defined(UNIX) || defined(WIN32)
 LISPFUNNR(default_time_zone,2)
 #endif
 LISPFUNN(sleep,2)
-LISPFUNNR(time,0)
+LISPFUN(time,seclass_read,0,1,norest,nokey,0,NIL)
 LISPFUNNF(delta4,5)
 /* ---------- PACKAGE ---------- */
 LISPFUNNR(make_symbol,1)

Index: ChangeLog
===================================================================
RCS file: /cvsroot/clisp/clisp/src/ChangeLog,v
retrieving revision 1.7567
retrieving revision 1.7568
diff -u -d -r1.7567 -r1.7568
--- ChangeLog	21 Oct 2010 15:35:24 -0000	1.7567
+++ ChangeLog	21 Oct 2010 18:42:17 -0000	1.7568
@@ -1,3 +1,34 @@
+2010-10-21  Vladimir Tzankov  <vtz...@gm...>
+
+	[MULTITHREAD]: provide real/run time information on individual threads
+	when supported by OS
+	* lispbibl.d: remove HAVE_RUN_TIME and dependencies
+	(get_thread_run_time, get_run_time): obtain thread or process run time
+	(struct clisp_thread_t): add thr_realstart_time - real time at which
+	thread has started
+	(check_thread): make it global (used from time.d)
+	*  spvw_gcstat.d (gc_timer_on, gc_timer_off): use get_run_time()
+	instead	of get_running_time() (which was causing unused C stack area to
+	be overwritten)
+	* stream.d: remove run_time_start()and run_time_restart() calls (anyway
+	these were nop when HAVE_RUN_TIME was not defined i.e. always)
+	* zthread.d (check_thread): make it global
+	(thread_stub): initialize thread real start time
+	* subr.d (GET-INTERNAL-RUN-TIME, SYSTEM::%%TIME): accept optional
+	thread argument
+	* time.d: remove HAVE_RUN_TIME and dependencies
+	(realstart_time_initialized): flag whether process start time was
+	initialized
+	(thread_from_arg): returns thread record from optional argument passed
+	to GET-INTERNAL-RUN-TIME and SYSTEM::%%TIME
+	(real_start_time): return the real start time of a thread or process
+	(get_thread_run_time): was get_run_time(). handle thread argument
+	(get_running_times_helper): was get_running_times(). handle thread
+	argument. never fails and does not GC when called for process wide data
+	(get_running_times): use it
+	(GET-INTERNAL-RUN-TIME, %%TIME): handle optional thread argument
+	(init_time): initialize thread real start time in MT
+
 2010-10-21  Arseny Slobodyuk  <am...@us...>
 
 	* makemake.in (cygwin_finish): use realpath and cygpath to

Index: spvw.d
===================================================================
RCS file: /cvsroot/clisp/clisp/src/spvw.d,v
retrieving revision 1.542
retrieving revision 1.543
diff -u -d -r1.542 -r1.543
--- spvw.d	3 Oct 2010 20:40:58 -0000	1.542
+++ spvw.d	21 Oct 2010 18:42:17 -0000	1.543
@@ -3807,7 +3807,7 @@
  #if defined(HAVE_SIGNALS) && defined(SIGPIPE)
   install_sigpipe_handler();
  #endif
-  /* initialize time variables: */
+  /* initialize global time variables: */
   init_time();
   /* Initialize locale dependent encodings: */
   init_dependent_encodings();

Index: lispbibl.d
===================================================================
RCS file: /cvsroot/clisp/clisp/src/lispbibl.d,v
retrieving revision 1.915
retrieving revision 1.916
diff -u -d -r1.915 -r1.916
--- lispbibl.d	3 Oct 2010 20:40:58 -0000	1.915
+++ lispbibl.d	21 Oct 2010 18:42:17 -0000	1.916
@@ -2219,13 +2219,6 @@
 #endif
 /* When changed: extend time.d */
 
-/* Whether the operating system can give us the run-time, or whether we'll have
- to accumulate it ourselves: */
-#if defined(UNIX) || defined(WIN32_NATIVE)
-  #define HAVE_RUN_TIME
-#endif
-/* When changed: extend time.d */
-
 /* Whether the operating system provides virtual memory. */
 #if (defined(UNIX) || defined(WIN32)) && !defined(NO_VIRTUAL_MEMORY)
   #define VIRTUAL_MEMORY
@@ -8829,22 +8822,6 @@
     } while(0)
 #endif
 
-#ifndef HAVE_RUN_TIME
-/* UP: Stops the run-time timer
-   run_time_stop(); */
-  extern void run_time_stop (void);
-  /* is used by STREAM */
-
-  /* UP: restarts the run-time timer
-   run_time_restart(); */
-  extern void run_time_restart (void);
-  /* is used by STREAM */
-#else
-  /* You don't need a run-time timer */
-  #define run_time_stop()
-  #define run_time_restart()
-#endif
-
 /* UP: yields the real-time
  get_real_time()
  < internal_time_t* result: absolute time */
@@ -8857,7 +8834,7 @@
  < timescore.realtime: Real-time since LISP-system-start (in Ticks)
  < timescore.gctime:   GC-Time since LISP-system-start (in Ticks)
  < timescore.gccount:  Number of GC's since LISP-system-start
- < timescore.gcfreed:  Size of the space reclaimed by the GC's so far */
+ < timescore.gcfreed:  Size of the space reclaimed by the GC's so far*/
 typedef struct {
   internal_time_t runtime;
   internal_time_t realtime;
@@ -8874,18 +8851,12 @@
 /* used by TIME, DEBUG */
 
 /* UP: yields the run-time
- get_running_time(runtime);
- < runtime: Run-time (in Ticks) */
-  #ifndef HAVE_RUN_TIME
-    #define get_running_time(runtime)  runtime = get_time()
-    extern uintL get_time (void);
-  #endif
-  #if defined(TIME_UNIX) || defined(TIME_WIN32)
-    #define get_running_time(runtime)  get_run_time(&runtime)
-    #if defined(TIME_UNIX) || defined(TIME_WIN32)
-      extern void get_run_time (internal_time_t* runtime);
-    #endif
-  #endif
+ get_thread_run_time(&runtime, thread);
+ > thread: thread for which to obtain info (nullobj for process wide)
+ < runtime: Run-time (in Ticks)
+ < returns true if successful (may fail in MT) */
+extern bool get_thread_run_time (internal_time_t* runtime, object thread);
+#define get_run_time(runtime) get_thread_run_time(runtime, nullobj)
 /* is used by SPVW */
 
 /* Time in decoded-time: */
@@ -8957,9 +8928,8 @@
 %%   exportF(void,convert_time_from_universal,(object universal, FILETIME* time));
 %% #endif
 
-/* UP: Initializes the time variables upon the LISP-System-Start.
- init_time(); */
-  extern void init_time (void);
+/* UP: Initializes the thread or global time variables. */
+extern void init_time ();
 /* is used by SPVW */
 
 
@@ -17106,6 +17076,8 @@
     bool _thread_is_dying;
     /* the current thread. NOT GC VISIBLE. */
     gcv_object_t _lthread;
+    /* real time when the thread started */
+    internal_time_t thr_realstart_time;
     /* previous and next thread. all active threads are kept in double
        linked list*/
     struct clisp_thread_t *thr_prev;
@@ -17502,6 +17474,8 @@
 global void release_exemptions(object list);
 /* called at thread exiting. performs cleanup/checks. */
 global maygc void thread_cleanup(void);
+/* signals an error of obj is not thread. returns the thread*/
+global maygc object check_thread(object obj);
 /* add per thread special symbol value - initialized to SYMVALUE_EMPTY.
  symbol: the symbol
  returns: the new index in the _symvalues thread array */




------------------------------

Message: 4
Date: Thu, 21 Oct 2010 19:10:35 +0000
From: Sam Steingold <sd...@us...>
Subject: clisp/src ChangeLog,1.7568,1.7569 time.d,1.78,1.79
To: cli...@li...
Message-ID: <E1P...@sf...>

Update of /cvsroot/clisp/clisp/src
In directory sfp-cvsdas-2.v30.ch3.sourceforge.com:/tmp/cvs-serv712/src

Modified Files:
	ChangeLog time.d 
Log Message:
* src/time.d (GET-INTERNAL-RUN-TIME): when *ANSI*!=NIL, reject the
optional argument (for strict ANSI compliance)


Index: ChangeLog
===================================================================
RCS file: /cvsroot/clisp/clisp/src/ChangeLog,v
retrieving revision 1.7568
retrieving revision 1.7569
diff -u -d -r1.7568 -r1.7569
--- ChangeLog	21 Oct 2010 18:42:17 -0000	1.7568
+++ ChangeLog	21 Oct 2010 19:10:33 -0000	1.7569
@@ -1,3 +1,8 @@
+2010-10-21  Sam Steingold  <sd...@gn...>
+
+	* time.d (GET-INTERNAL-RUN-TIME): when *ANSI*!=NIL, reject the
+	optional argument (for strict ANSI compliance)
+
 2010-10-21  Vladimir Tzankov  <vtz...@gm...>
 
 	[MULTITHREAD]: provide real/run time information on individual threads
@@ -7,9 +12,9 @@
 	(struct clisp_thread_t): add thr_realstart_time - real time at which
 	thread has started
 	(check_thread): make it global (used from time.d)
-	*  spvw_gcstat.d (gc_timer_on, gc_timer_off): use get_run_time()
-	instead	of get_running_time() (which was causing unused C stack area to
-	be overwritten)
+	* spvw_gcstat.d (gc_timer_on, gc_timer_off): use get_run_time()
+	instead	of get_running_time() (which was causing unused C stack
+	area to be overwritten)
 	* stream.d: remove run_time_start()and run_time_restart() calls (anyway
 	these were nop when HAVE_RUN_TIME was not defined i.e. always)
 	* zthread.d (check_thread): make it global

Index: time.d
===================================================================
RCS file: /cvsroot/clisp/clisp/src/time.d,v
retrieving revision 1.78
retrieving revision 1.79
diff -u -d -r1.78 -r1.79
--- time.d	21 Oct 2010 18:42:17 -0000	1.78
+++ time.d	21 Oct 2010 19:10:33 -0000	1.79
@@ -309,6 +309,8 @@
 { /* (GET-INTERNAL-RUN-TIME), CLTL p. 446
      extension: optional argument (GET-INTERNAL-RUN-TIME thread) */
   var internal_time_t tp;
+  if (!nullp(O(ansi)) && !eq(STACK_0,unbound))
+    error_too_many_args(unbound,S(get_internal_run_time),1,0);
   if (get_thread_run_time(&tp, thread_from_arg(popSTACK())))
     VALUES1(internal_time_to_I(&tp)); /* convert to integer */
   else




------------------------------

------------------------------------------------------------------------------
Nokia and AT&T present the 2010 Calling All Innovators-North America contest
Create new apps & games for the Nokia N8 for consumers in  U.S. and Canada
$10 million total in prizes - $4M cash, 500 devices, nearly $6M in marketing
Develop with Nokia Qt SDK, Web Runtime, or Java and Publish to Ovi Store 
http://p.sf.net/sfu/nokia-dev2dev

------------------------------

_______________________________________________
clisp-cvs mailing list
cli...@li...
https://lists.sourceforge.net/lists/listinfo/clisp-cvs


End of clisp-cvs Digest, Vol 54, Issue 17
*****************************************

clisp-cvs Digest, Vol 54, Issue 16

[<cli...@li...>]

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.7563,1.7564 NEWS,1.550,1.551 (Sam Steingold)
   2. clisp/modules/syscalls calls.c, 1.321, 1.322 syscalls.xml,
      1.137,	1.138 test.tst, 1.110, 1.111 (Sam Steingold)
   3. clisp/src pathname.d,1.523,1.524 ChangeLog,1.7564,1.7565
      (Arseny Slobodyuk)
   4. clisp/src pathname.d,1.524,1.525 (Arseny Slobodyuk)
   5. clisp/src makemake.in,1.960,1.961 ChangeLog,1.7565,1.7566
      (Arseny Slobodyuk)


----------------------------------------------------------------------

Message: 1
Date: Wed, 20 Oct 2010 18:41:16 +0000
From: Sam Steingold <sd...@us...>
Subject: clisp/src ChangeLog,1.7563,1.7564 NEWS,1.550,1.551
To: cli...@li...
Message-ID: <E1P...@sf...>

Update of /cvsroot/clisp/clisp/src
In directory sfp-cvsdas-2.v30.ch3.sourceforge.com:/tmp/cvs-serv17121/src

Modified Files:
	ChangeLog NEWS 
Log Message:
* modules/syscalls/calls.c (check_rusage): add
(USAGE): accept `what' argument and return a single value


Index: NEWS
===================================================================
RCS file: /cvsroot/clisp/clisp/src/NEWS,v
retrieving revision 1.550
retrieving revision 1.551
diff -u -d -r1.550 -r1.551
--- NEWS	18 Oct 2010 22:19:24 -0000	1.550
+++ NEWS	20 Oct 2010 18:41:13 -0000	1.551
@@ -28,7 +28,11 @@
   See <http://clisp.cons.org/impnotes/syscalls.html#file-tree-walk> for details.
 
 * New function POSIX:GETDATE calls getdate().
-  See <http://clisp.cons.org/impnotes/syscalls.html#getdate> for details
+  See <http://clisp.cons.org/impnotes/syscalls.html#getdate> for details.
+
+* Function POSIX:USAGE now accept an optional argument and returns a
+  single value.
+  See <http://clisp.cons.org/impnotes/syscalls.html#usage> for details.
 
 * FFI now converts REALs to FLOATs automatically as necessary.
 

Index: ChangeLog
===================================================================
RCS file: /cvsroot/clisp/clisp/src/ChangeLog,v
retrieving revision 1.7563
retrieving revision 1.7564
diff -u -d -r1.7563 -r1.7564
--- ChangeLog	18 Oct 2010 22:19:24 -0000	1.7563
+++ ChangeLog	20 Oct 2010 18:41:13 -0000	1.7564
@@ -1,3 +1,8 @@
+2010-10-20  Sam Steingold  <sd...@gn...>
+
+	* modules/syscalls/calls.c (check_rusage): add
+	(USAGE): accept `what' argument and return a single value
+
 2010-10-18  Sam Steingold  <sd...@gn...>
 
 	fix bug#3089988: (loop for x do (print x)) should barf




------------------------------

Message: 2
Date: Wed, 20 Oct 2010 18:41:15 +0000
From: Sam Steingold <sd...@us...>
Subject: clisp/modules/syscalls calls.c, 1.321, 1.322 syscalls.xml,
	1.137,	1.138 test.tst, 1.110, 1.111
To: cli...@li...
Message-ID: <E1P...@sf...>

Update of /cvsroot/clisp/clisp/modules/syscalls
In directory sfp-cvsdas-2.v30.ch3.sourceforge.com:/tmp/cvs-serv17121/modules/syscalls

Modified Files:
	calls.c syscalls.xml test.tst 
Log Message:
* modules/syscalls/calls.c (check_rusage): add
(USAGE): accept `what' argument and return a single value


Index: calls.c
===================================================================
RCS file: /cvsroot/clisp/clisp/modules/syscalls/calls.c,v
retrieving revision 1.321
retrieving revision 1.322
diff -u -d -r1.321 -r1.322
--- calls.c	4 Oct 2010 22:07:23 -0000	1.321
+++ calls.c	20 Oct 2010 18:41:12 -0000	1.322
@@ -1432,12 +1432,29 @@
 #endif  /* HAVE_SYS_WAIT_H */
 
 #if defined(HAVE_GETRUSAGE)
-DEFUN(POSIX::USAGE,) { /* getrusage(3) */
+DEFCHECKER(check_rusage, prefix=RUSAGE, SELF CHILDREN THREAD LWP)
+DEFUN(POSIX::USAGE, &optional what) { /* getrusage(3) */
   struct rusage ru;
-#define GETRU(who) begin_system_call(); getrusage(who,&ru); end_system_call(); rusage_to_lisp(&ru); pushSTACK(value1)
-  GETRU(RUSAGE_CHILDREN); GETRU(RUSAGE_SELF);
-#undef GETRU
-  VALUES2(STACK_0,STACK_1); skipSTACK(2);
+  object what = popSTACK();
+  if (missingp(what)) {
+    unsigned int pos;
+    for (pos = 0; pos < check_rusage_map.size; pos++) {
+      int status;
+      pushSTACK(*check_rusage_map.table[pos].l_const);
+      begin_system_call();
+      status = getrusage(check_rusage_map.table[pos].c_const,&ru);
+      end_system_call();
+      if (status) pushSTACK(S(Kerror));
+      else { rusage_to_lisp(&ru); pushSTACK(value1); }
+    }
+    VALUES1(listof(2*check_rusage_map.size));
+  } else {
+    int who = check_rusage(what);
+    begin_system_call();
+    if (getrusage(who,&ru)) OS_error();
+    end_system_call();
+    rusage_to_lisp(&ru);
+  }
 }
 #endif /* HAVE_GETRUSAGE */
 #endif /* HAVE_SYS_RESOURCE_H */
@@ -1502,7 +1519,7 @@
 { /* setrlimit(3): 3 ways to call:
    (setf (rlimit what) (values cur max))
    (setf (rlimit what) #S(rlimit :cur cur :max max))
-   (setf (rlimit) rlimit-alist-as-returned-by-rlimit-without-arguments) */
+   (setf (rlimit) rlimit-plist-as-returned-by-rlimit-without-arguments) */
   if (nullp(STACK_2)) {         /* 3rd way */
     if (!nullp(STACK_0)) goto rlimit_bad;
     STACK_0 = STACK_1;

Index: test.tst
===================================================================
RCS file: /cvsroot/clisp/clisp/modules/syscalls/test.tst,v
retrieving revision 1.110
retrieving revision 1.111
diff -u -d -r1.110 -r1.111
--- test.tst	4 Oct 2010 22:16:04 -0000	1.110
+++ test.tst	20 Oct 2010 18:41:12 -0000	1.111
@@ -266,12 +266,10 @@
                         (os:pathconf *tmp1*) '(no os:pathconf)) :pretty t)) T
 
 #+unix
-(listp (show (if (fboundp 'os:usage)
-                 (multiple-value-list (os:usage)) '(no os:usage)) :pretty t))
+(listp (show (if (fboundp 'os:usage) (os:usage) '(no os:usage)) :pretty t))
 T
 #+unix
-(listp (show (if (fboundp 'os:rlimit)
-                 (multiple-value-list (os:rlimit)) '(no os:rlimit)) :pretty t))
+(listp (show (if (fboundp 'os:rlimit) (os:rlimit) '(no os:rlimit)) :pretty t))
 T
 
 (os:uname-p (show (os:uname) :pretty t)) T

Index: syscalls.xml
===================================================================
RCS file: /cvsroot/clisp/clisp/modules/syscalls/syscalls.xml,v
retrieving revision 1.137
retrieving revision 1.138
diff -u -d -r1.137 -r1.138
--- syscalls.xml	4 Oct 2010 22:04:40 -0000	1.137
+++ syscalls.xml	20 Oct 2010 18:41:12 -0000	1.138
@@ -538,7 +538,7 @@
  <varlistentry id="rlimit"><term><code>(&rlimit;
     &optional-amp; &what-r;)</code></term>
   <listitem><simpara>Return the current and the maximal limits as two
-    values when &what-r; is specified or the &alist; of all available
+    values when &what-r; is specified or the &plist; of all available
     limits (as an <type>RLIMIT</type> structure) when &what-r; is
     missing or &nil;, by calling <function role="unix">getrlimit</function>.
  </simpara></listitem></varlistentry>
@@ -548,7 +548,7 @@
   <term><code>(&setf; (&rlimit; &what-r;)
     <replaceable>rlimit</replaceable>)</code></term>
   <term><code>(&setf; (&rlimit;)
-    <replaceable>rlimit-alist</replaceable>)</code></term>
+    <replaceable>rlimit-plist</replaceable>)</code></term>
   <listitem><para>Set the limits using
     <function role="unix">setrlimit</function>.<orderedlist>
      <listitem><simpara>In the first form, <replaceable>cur</replaceable>
@@ -557,13 +557,15 @@
      <listitem><simpara>In the second form, <replaceable>rlimit</replaceable>
        is an <type>RLIMIT</type> structure.</simpara></listitem>
      <listitem><simpara>In the third form,
-       <replaceable>rlimit-alist</replaceable> is an &alist;, as returned by
+       <replaceable>rlimit-plist</replaceable> is a &plist;, as returned by
        <code>(&rlimit;)</code>.</simpara></listitem>
  </orderedlist></para></listitem></varlistentry>
- <varlistentry id="usage"><term><code>(POSIX:USAGE)</code></term>
-  <listitem><simpara>Return 2 structures describing the resource usage
-    by the lisp process and its children, using
-    <function role="unix">getrusage</function>.
+ <varlistentry id="usage"><term><code>(POSIX:USAGE
+   &optional-amp; &what-r;)</code></term>
+  <listitem><simpara>Return the <type>USAGE</type> structure describing the
+   resource usage of the thread, process, or its children, using
+   <function role="unix">getrusage</function>. WHen &what-r; is missing
+   or &nil;, return all available data as a &plist;.
  </simpara></listitem></varlistentry>
  <varlistentry id="bogomips"><term><code>(POSIX:BOGOMIPS)</code></term>
   <listitem><simpara>Compute the




------------------------------

Message: 3
Date: Thu, 21 Oct 2010 02:33:12 +0000
From: Arseny Slobodyuk <am...@us...>
Subject: clisp/src pathname.d,1.523,1.524 ChangeLog,1.7564,1.7565
To: cli...@li...
Message-ID: <E1P...@sf...>

Update of /cvsroot/clisp/clisp/src
In directory sfp-cvsdas-2.v30.ch3.sourceforge.com:/tmp/cvs-serv3171

Modified Files:
	pathname.d ChangeLog 
Log Message:
Fix PROBE-PATHNAME for "/" and "file/" cases.


Index: pathname.d
===================================================================
RCS file: /cvsroot/clisp/clisp/src/pathname.d,v
retrieving revision 1.523
retrieving revision 1.524
diff -u -d -r1.523 -r1.524
--- pathname.d	18 Oct 2010 02:29:18 -0000	1.523
+++ pathname.d	21 Oct 2010 02:33:09 -0000	1.524
@@ -5981,7 +5981,7 @@
   int ret;
   GC_SAFE_SYSTEM_CALL(ret=, stat(namestring,&status));
   if (ret) {
-    if (errno != ENOENT) OS_file_error(STACK_0);
+    if (errno != ENOENT && errno != ENOTDIR) OS_file_error(STACK_0);
     return NAMESTRING_NONE;        /* does not exist */
   } else {                         /* file exists. */
     realpath(namestring,resolved); /* ==> success assured */
@@ -6041,12 +6041,15 @@
   pushSTACK(NIL); pushSTACK(STACK_1); /* space for FWD & FSIZE */
   with_sstring_0(whole_namestring(STACK_0),O(pathname_encoding),
                  namestring_asciz, {
-#if defined(UNIX)
-    if (cpslashp(namestring_asciz[namestring_asciz_bytelen-1]))
-      namestring_asciz[namestring_asciz_bytelen-1] = 0; /* strip last slash */
-#endif
-    classification = classify_namestring(namestring_asciz,resolved,
+    while (true) {
+      classification = classify_namestring(namestring_asciz,resolved,
                                          &STACK_1/*fwd*/,&STACK_2/*fsize*/);
+      if (classification == NAMESTRING_NONE 
+          && namestring_asciz_bytelen > 1    /* no need to classify "" */
+          && cpslashp(namestring_asciz[namestring_asciz_bytelen-1]))
+        namestring_asciz[namestring_asciz_bytelen-1] = 0; /* strip last slash */
+      else break;
+    }
   });
   switch (classification) {
     case NAMESTRING_NONE:       /* does not exist */

Index: ChangeLog
===================================================================
RCS file: /cvsroot/clisp/clisp/src/ChangeLog,v
retrieving revision 1.7564
retrieving revision 1.7565
diff -u -d -r1.7564 -r1.7565
--- ChangeLog	20 Oct 2010 18:41:13 -0000	1.7564
+++ ChangeLog	21 Oct 2010 02:33:10 -0000	1.7565
@@ -1,3 +1,11 @@
+2010-10-21  Arseny Slobodyuk  <am...@us...>
+
+	Fix (PROBE-PATHNAME "/") on UNIX and support DWIM: 
+	(PP "lisp.exe/") -> "path/lisp.exe" broken 10-18
+	* pathname.d (PROBE-PATHNAME): strip last "/" in a loop
+	(classify_namestring) [UNIX]: handle ENOTDIR 
+	like ERROR_INVALID_NAME is handled on WIN32
+
 2010-10-20  Sam Steingold  <sd...@gn...>
 
 	* modules/syscalls/calls.c (check_rusage): add




------------------------------

Message: 4
Date: Thu, 21 Oct 2010 03:00:48 +0000
From: Arseny Slobodyuk <am...@us...>
Subject: clisp/src pathname.d,1.524,1.525
To: cli...@li...
Message-ID: <E1P...@sf...>

Update of /cvsroot/clisp/clisp/src
In directory sfp-cvsdas-2.v30.ch3.sourceforge.com:/tmp/cvs-serv11282

Modified Files:
	pathname.d 
Log Message:
Oops.


Index: pathname.d
===================================================================
RCS file: /cvsroot/clisp/clisp/src/pathname.d,v
retrieving revision 1.524
retrieving revision 1.525
diff -u -d -r1.524 -r1.525
--- pathname.d	21 Oct 2010 02:33:09 -0000	1.524
+++ pathname.d	21 Oct 2010 03:00:46 -0000	1.525
@@ -6047,7 +6047,7 @@
       if (classification == NAMESTRING_NONE 
           && namestring_asciz_bytelen > 1    /* no need to classify "" */
           && cpslashp(namestring_asciz[namestring_asciz_bytelen-1]))
-        namestring_asciz[namestring_asciz_bytelen-1] = 0; /* strip last slash */
+        namestring_asciz[--namestring_asciz_bytelen] = 0; /* strip last slash */
       else break;
     }
   });




------------------------------

Message: 5
Date: Thu, 21 Oct 2010 08:07:10 +0000
From: Arseny Slobodyuk <am...@us...>
Subject: clisp/src makemake.in,1.960,1.961 ChangeLog,1.7565,1.7566
To: cli...@li...
Message-ID: <E1P...@sf...>

Update of /cvsroot/clisp/clisp/src
In directory sfp-cvsdas-2.v30.ch3.sourceforge.com:/tmp/cvs-serv15978

Modified Files:
	makemake.in ChangeLog 
Log Message:
Fix mingw build - resolve symlings for cygcheck


Index: makemake.in
===================================================================
RCS file: /cvsroot/clisp/clisp/src/makemake.in,v
retrieving revision 1.960
retrieving revision 1.961
diff -u -d -r1.960 -r1.961
--- makemake.in	12 Oct 2010 19:29:04 -0000	1.960
+++ makemake.in	21 Oct 2010 08:07:08 -0000	1.961
@@ -3251,8 +3251,9 @@
 cygwin_finish() {
   # make sure no cygwin libraries crept into the mingw distribution
   if [ "$host_os" = cygwin -a "${TSYS}" = win32gcc ]; then
-    echotab "if cygcheck $1/lisp.exe | grep 'cyg[^/\\\\]*\$\$'; then false; else true; fi"
+    # cygcheck can fail with symlinks so resolve them
     # 'cyg[^/\\\\]*\$\$' here should look as 'cyg[^/\]*$' for grep
+    echotab "if cygcheck \`realpath $1/lisp.exe | cygpath --windows -f -\` | grep 'cyg[^/\\\\]*\$\$'; then false; else true; fi"
   fi
   finish_runtime $1/lisp${LEXE}
 }

Index: ChangeLog
===================================================================
RCS file: /cvsroot/clisp/clisp/src/ChangeLog,v
retrieving revision 1.7565
retrieving revision 1.7566
diff -u -d -r1.7565 -r1.7566
--- ChangeLog	21 Oct 2010 02:33:10 -0000	1.7565
+++ ChangeLog	21 Oct 2010 08:07:08 -0000	1.7566
@@ -1,7 +1,12 @@
 2010-10-21  Arseny Slobodyuk  <am...@us...>
 
-	Fix (PROBE-PATHNAME "/") on UNIX and support DWIM: 
-	(PP "lisp.exe/") -> "path/lisp.exe" broken 10-18
+	* makemake.in (cygwin_finish): use realpath and cygpath to 
+	avoid cygcheck bug with symbolic links
+
+2010-10-21  Arseny Slobodyuk  <am...@us...>
+
+	Fix PROBE-PATHNAME: proper handle of "/" on UNIX,
+	DWIM on WIN32 (broken 10-18) "lisp.exe/" -> "path/lisp.exe"
 	* pathname.d (PROBE-PATHNAME): strip last "/" in a loop
 	(classify_namestring) [UNIX]: handle ENOTDIR 
 	like ERROR_INVALID_NAME is handled on WIN32




------------------------------

------------------------------------------------------------------------------
Nokia and AT&T present the 2010 Calling All Innovators-North America contest
Create new apps & games for the Nokia N8 for consumers in  U.S. and Canada
$10 million total in prizes - $4M cash, 500 devices, nearly $6M in marketing
Develop with Nokia Qt SDK, Web Runtime, or Java and Publish to Ovi Store 
http://p.sf.net/sfu/nokia-dev2dev

------------------------------

_______________________________________________
clisp-cvs mailing list
cli...@li...
https://lists.sourceforge.net/lists/listinfo/clisp-cvs


End of clisp-cvs Digest, Vol 54, Issue 16
*****************************************

clisp-cvs Digest, Vol 54, Issue 15

[<cli...@li...>]

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/tests type.tst, 1.57, 1.58 unportable.tst, 1.7, 1.8
      weakhash.tst,	1.4, 1.5 weakhash2.tst, 1.3, 1.4 (Sam Steingold)
   2. clisp/tests restarts.tst, 1.5, 1.6 steele7.tst, 1.7,	1.8
      streamslong.tst, 1.31, 1.32 strings.tst, 1.26,	1.27 symbol10.tst,
      1.14, 1.15 time.tst, 1.7, 1.8 (Sam Steingold)
   3. clisp/doc impext.xml,1.656,1.657 (Sam Steingold)


----------------------------------------------------------------------

Message: 1
Date: Tue, 19 Oct 2010 16:02:20 +0000
From: Sam Steingold <sd...@us...>
Subject: clisp/tests type.tst, 1.57, 1.58 unportable.tst, 1.7, 1.8
	weakhash.tst,	1.4, 1.5 weakhash2.tst, 1.3, 1.4
To: cli...@li...
Message-ID: <E1P...@sf...>

Update of /cvsroot/clisp/clisp/tests
In directory sfp-cvsdas-2.v30.ch3.sourceforge.com:/tmp/cvs-serv22189/tests

Modified Files:
	type.tst unportable.tst weakhash.tst weakhash2.tst 
Log Message:
add cleanup


Index: weakhash.tst
===================================================================
RCS file: /cvsroot/clisp/clisp/tests/weakhash.tst,v
retrieving revision 1.4
retrieving revision 1.5
diff -u -d -r1.4 -r1.5
--- weakhash.tst	30 Sep 2007 05:32:43 -0000	1.4
+++ weakhash.tst	19 Oct 2010 16:02:18 -0000	1.5
@@ -369,3 +369,12 @@
   (list (gethash "foo" tab) (gethash 1 tab) (gethash "zoo" tab)))
 #+(or CLISP LISPWORKS)
 (1 "bar" NIL)
+
+(progn ; cleanup
+  (symbol-cleanup 'weak-ht-fill-initially)
+  (symbol-cleanup 'make-freak-mapping)
+  (symbol-cleanup 'freak-mapping-pair)
+  (symbol-cleanup 'freak-mapping-value)
+  (symbol-cleanup 'test-weak-mapping-chain)
+  (symbol-cleanup 'test-weak-mapping-chain-reverse))
+T

Index: weakhash2.tst
===================================================================
RCS file: /cvsroot/clisp/clisp/tests/weakhash2.tst,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -d -r1.3 -r1.4
--- weakhash2.tst	30 Sep 2007 05:32:43 -0000	1.3
+++ weakhash2.tst	19 Oct 2010 16:02:18 -0000	1.4
@@ -142,3 +142,7 @@
          (simple-vector-p (whal_itable kvt)))))
 #+CLISP
 T
+
+(progn ; cleanup
+  (symbol-cleanup 'tab))
+T

Index: unportable.tst
===================================================================
RCS file: /cvsroot/clisp/clisp/tests/unportable.tst,v
retrieving revision 1.7
retrieving revision 1.8
diff -u -d -r1.7 -r1.8
--- unportable.tst	10 Dec 2008 16:01:28 -0000	1.7
+++ unportable.tst	19 Oct 2010 16:02:18 -0000	1.8
@@ -258,3 +258,8 @@
 
 ;; Paul Dietz' ANSI testsuite (part of gcl) checks some border cases
 ;; http://cvs.savannah.gnu.org/viewcvs/gcl/ansi-tests/beyond-ansi/?root=gcl
+
+(progn ; cleanup
+  (symbol-cleanup 'first-special-then-macro)
+  (symbol-cleanup 'first-macro-then-special))
+T

Index: type.tst
===================================================================
RCS file: /cvsroot/clisp/clisp/tests/type.tst,v
retrieving revision 1.57
retrieving revision 1.58
diff -u -d -r1.57 -r1.58
--- type.tst	22 Jul 2008 03:02:20 -0000	1.57
+++ type.tst	19 Oct 2010 16:02:18 -0000	1.58
@@ -871,3 +871,24 @@
   (eval `(define-condition ,sym (condition) (a b c)))
   (proclaim `(declaration ,sym)))
 error
+
+(progn ; cleanup
+  (symbol-cleanup 'MOD1)
+  (symbol-cleanup 'BELIEBIGER-TEST)
+  (symbol-cleanup 'BELIEBIGER-TYP)
+  (symbol-cleanup 'typeof-typep-subtype)
+  (symbol-cleanup '*DISJOINT-TYPES-LIST*)
+  (symbol-cleanup 'bar)
+  (symbol-cleanup 'foo)
+  (symbol-cleanup 'otherwise)
+  (symbol-cleanup 'foo70)
+  (symbol-cleanup 'foo71)
+  (symbol-cleanup 'foo72)
+  (symbol-cleanup 'foo73)
+  (symbol-cleanup 'foo74)
+  (symbol-cleanup 'foo129a)
+  (symbol-cleanup 'foo129b)
+  (symbol-cleanup 'foo139)
+  (symbol-cleanup 'foo140)
+  (symbol-cleanup 'check-type-error))
+T




------------------------------

Message: 2
Date: Tue, 19 Oct 2010 19:38:22 +0000
From: Sam Steingold <sd...@us...>
Subject: clisp/tests restarts.tst, 1.5, 1.6 steele7.tst, 1.7,	1.8
	streamslong.tst, 1.31, 1.32 strings.tst, 1.26,	1.27 symbol10.tst,
	1.14, 1.15 time.tst, 1.7, 1.8
To: cli...@li...
Message-ID: <E1P...@sf...>

Update of /cvsroot/clisp/clisp/tests
In directory sfp-cvsdas-2.v30.ch3.sourceforge.com:/tmp/cvs-serv3110/tests

Modified Files:
	restarts.tst steele7.tst streamslong.tst strings.tst 
	symbol10.tst time.tst 
Log Message:
more cleanup


Index: steele7.tst
===================================================================
RCS file: /cvsroot/clisp/clisp/tests/steele7.tst,v
retrieving revision 1.7
retrieving revision 1.8
diff -u -d -r1.7 -r1.8
--- steele7.tst	7 Oct 2007 01:00:15 -0000	1.7
+++ steele7.tst	19 Oct 2010 19:38:20 -0000	1.8
@@ -76,7 +76,7 @@
 (setf a 0)
 0
 
-(let ((a 1) (b 2) c )
+(let ((a 1) (b 2) c)
   (declare (integer a b))
   (list a b c))
 (1 2 nil)
@@ -417,3 +417,9 @@
 (labels ((z () (return-from z 4))) (z))
 4
 
+(progn ; cleanup
+  (symbol-cleanup 'plus)
+  (symbol-cleanup 'adder)
+  (symbol-cleanup 'a)
+  (symbol-cleanup 'b))
+T

Index: streamslong.tst
===================================================================
RCS file: /cvsroot/clisp/clisp/tests/streamslong.tst,v
retrieving revision 1.31
retrieving revision 1.32
diff -u -d -r1.31 -r1.32
--- streamslong.tst	4 Jul 2010 18:20:11 -0000	1.31
+++ streamslong.tst	19 Oct 2010 19:38:20 -0000	1.32
@@ -328,3 +328,8 @@
            (loop for i below 1000 do (assert (= i (read in))))))
     (delete-file file)))
 #+(and CLISP UNIX) NIL
+
+(progn ; cleanup
+  (symbol-cleanup '*A*)
+  (symbol-cleanup 'bin-stream-test))
+T

Index: strings.tst
===================================================================
RCS file: /cvsroot/clisp/clisp/tests/strings.tst,v
retrieving revision 1.26
retrieving revision 1.27
diff -u -d -r1.26 -r1.27
--- strings.tst	17 May 2009 05:09:43 -0000	1.26
+++ strings.tst	19 Oct 2010 19:38:20 -0000	1.27
@@ -1201,9 +1201,6 @@
 x
 "edcba"
 
-(makunbound 'x)
-X
-
 (let* ((x (make-array 10 :fill-pointer 4 :element-type 'character
                          :initial-element #\space :adjustable t))
        (y (make-array 10 :fill-pointer 4 :element-type 'character
@@ -1254,3 +1251,7 @@
 
 #+clisp (trim-if #'sys::whitespacep "  asdf 	 ")
 #+clisp "asdf"
+
+(progn ; cleanup
+  (symbol-cleanup 'x))
+T

Index: symbol10.tst
===================================================================
RCS file: /cvsroot/clisp/clisp/tests/symbol10.tst,v
retrieving revision 1.14
retrieving revision 1.15
diff -u -d -r1.14 -r1.15
--- symbol10.tst	26 Nov 2008 20:38:58 -0000	1.14
+++ symbol10.tst	19 Oct 2010 19:38:20 -0000	1.15
@@ -563,3 +563,16 @@
   (mapc #'unintern l)
   (length l))
 4
+
+(progn ; cleanup
+  (symbol-cleanup 'testvar)
+  (symbol-cleanup 'clrvar)
+  (symbol-cleanup 'v1)
+  (symbol-cleanup 'v2)
+  (symbol-cleanup 'v3)
+  (symbol-cleanup 'v4)
+  (symbol-cleanup 'v5)
+  (symbol-cleanup 'v6)
+  (symbol-cleanup 'var3)
+  (symbol-cleanup 'var33))
+T

Index: restarts.tst
===================================================================
RCS file: /cvsroot/clisp/clisp/tests/restarts.tst,v
retrieving revision 1.5
retrieving revision 1.6
diff -u -d -r1.5 -r1.6
--- restarts.tst	28 Jan 2010 15:46:05 -0000	1.5
+++ restarts.tst	19 Oct 2010 19:38:20 -0000	1.6
@@ -158,8 +158,8 @@
 (444 (progv '("foo" :const) '(123 321) (+ foo zz)))
 
 (handler-bind ((type-error #'use-value-read))
-  (multiple-value-setq (a "foo") (values 123 321))
-  (list foo a))
+  (multiple-value-setq (baz "foo") (values 123 321))
+  (list foo baz))
 (321 123)
 
 (handler-bind ((program-error (lambda (c) (princ-error c) (use-value 'zz))))
@@ -371,5 +371,12 @@
   (documentation 'use-value-read 'function))
 "docstring for use-value-read"
 
-(unintern 'check-use-value) T
-(unintern 'use-value-read) T
+(progn ; cleanup
+  (symbol-cleanup 'check-use-value)
+  (symbol-cleanup 'use-value-read)
+  (symbol-cleanup 'zot)
+  (symbol-cleanup 'foo)
+  (symbol-cleanup 'bar)
+  (symbol-cleanup 'baz)
+  (symbol-cleanup 'xyzzy))
+T

Index: time.tst
===================================================================
RCS file: /cvsroot/clisp/clisp/tests/time.tst,v
retrieving revision 1.7
retrieving revision 1.8
diff -u -d -r1.7 -r1.8
--- time.tst	30 Sep 2007 05:32:43 -0000	1.7
+++ time.tst	19 Oct 2010 19:38:20 -0000	1.8
@@ -84,6 +84,7 @@
    (encode-universal-time 12 34 20 23 12 2208))
 3600
 
-;; clean up
-(unintern 'time-loop) T
-(unintern 'check-universal-time) T
+(progn ; clean up
+  (symbol-cleanup 'check-universal-time)
+  (symbol-cleanup 'time-loop))
+T




------------------------------

Message: 3
Date: Tue, 19 Oct 2010 20:59:30 +0000
From: Sam Steingold <sd...@us...>
Subject: clisp/doc impext.xml,1.656,1.657
To: cli...@li...
Message-ID: <E1P...@sf...>

Update of /cvsroot/clisp/clisp/doc
In directory sfp-cvsdas-2.v30.ch3.sourceforge.com:/tmp/cvs-serv18171

Modified Files:
	impext.xml 
Log Message:
presentation


Index: impext.xml
===================================================================
RCS file: /cvsroot/clisp/clisp/doc/impext.xml,v
retrieving revision 1.656
retrieving revision 1.657
diff -u -d -r1.656 -r1.657
--- impext.xml	18 Oct 2010 21:31:22 -0000	1.656
+++ impext.xml	19 Oct 2010 20:59:28 -0000	1.657
@@ -2435,7 +2435,7 @@
    compare <function>RAWSOCK:HTONS</function> (defined
    in <filename role="clisp-cvs">modules/rawsock/rawsock.c</filename>)
    with <programlisting language="lisp">
-(&def-call-out; htons (:name "htons") (&library-k; :default)
+(&def-call-out; htons (&name-k; "htons") (&library-k; :default)
   (&arguments-k; (s ffi:short)) (&ret-type-k; ffi:short) (&lang-k; :stdc))
 </programlisting> and observe that <function>RAWSOCK:HTONS</function> is
    almost 3 times as fast (this really does compare the &ffi-pac;
@@ -2752,17 +2752,17 @@
    Lisp (using &setq; or similar).</simpara></listitem></varlistentry>
 <varlistentry><term><code>(:ALLOC &allocation;)</code></term>
  <listitem><simpara>This option can be either &none-k; or
-   &malloc-free-k; and defaults to &none-k;.  If it is
-   &malloc-free-k;, any values of type &c-string;, &c-ptr;,
+   &malloc-free-k; and defaults to &none-k;.
+   If it is &malloc-free-k;, any values of type &c-string;, &c-ptr;,
    &c-ptr-null;, &c-array-ptr; within the foreign value are assumed
    to be pointers to &malloc;-allocated storage, and when &setq;
    replaces an old value by a new one, the old storage is freed using
-   &free; and the new storage allocated using &malloc;.  If it is
-   &none-k;, &setq; assumes that the pointers point to good storage
-   (not &c-NULL;!) and overwrites the old values by the new ones.
-   This is dangerous (just think of overwriting a string with a
-   longer one or storing some data in a &c-NULL; pointer...)  and
-   deprecated.</simpara></listitem></varlistentry>
+   &free; and the new storage allocated using &malloc;.
+   If it is &none-k;, &setq; assumes that the pointers point to good
+   storage (not &c-NULL;!) and overwrites the old values by the new ones.
+   This is dangerous (just think of overwriting a string with a longer
+   one or storing some data in a &c-NULL; pointer...) and deprecated.
+</simpara></listitem></varlistentry>
 <varlistentry><term><code>(&library-k; &name-r;)</code></term>
  <listitem><simpara>Specifies the (optional) dynamic library
    which contains the variable, the default is set by
@@ -3993,8 +3993,8 @@
 int my_bar (int x) { return bar(x); }~%")
 (&def-c-const; bar)
 (&def-c-const; zot-size (:name "sizeof(struct zot)") (:guard nil))
-(&def-call-out; my-foo (:name "my_foo") (&arguments-k; (x ffi:int)) (&ret-type-k; ffi:int))
-(&def-call-out; my-bar (:name "my_bar") (&arguments-k; (x ffi:int)) (&ret-type-k; ffi:int))
+(&def-call-out; my-foo (&name-k; "my_foo") (&arguments-k; (x ffi:int)) (&ret-type-k; ffi:int))
+(&def-call-out; my-bar (&name-k; "my_bar") (&arguments-k; (x ffi:int)) (&ret-type-k; ffi:int))
 </programlisting></para>
 <para>Compiling this file will produce <filename>my.c</filename>
  and <filename>my.fas</filename> and you have two options:
@@ -4044,19 +4044,19 @@
 <programlisting language="lisp">
 (&defpackage; "FFI-TEST" (:use &cl-pac; &ffi-pac;))
 (&in-package; "FFI-TEST")
-(&eval-when; (compile) (setq &ffi-out-fun; t))
+(&eval-when; (compile) (&setq; &ffi-out-fun; t))
 (&def-call-in; lispsort_begin (&arguments-k; (n int))
   (&ret-type-k; nil)
   (&lang-k; :stdc))
 (&def-c-var; lispsort_function (:type c-pointer))
-(defun lispsort_begin (n)
-  (setf (cast lispsort_function
-              `(c-function
+(&defun; lispsort_begin (n)
+  (&setf; (&cast; lispsort_function
+              `(&c-function;
                  (&arguments-k; (v (c-ptr (c-array double-float ,n))))
                  (&ret-type-k; (c-ptr (c-array double-float ,n))
                                :malloc-free)))
         #'sort2))
-(defun sort2 (v)
+(&defun; sort2 (v)
   (declare (type vector v))
   (sort v #'&lt;))
 </programlisting>
@@ -4066,7 +4066,7 @@
 <programlisting language="lisp">
 (&eval-when; (compile) (setq &ffi-out-fun; t))
 (&def-call-out; sort10
-  (:name "lispsort_double")
+  (&name-k; "lispsort_double")
   (&lang-k; :stdc)
   (&arguments-k; (n int)
               (array (c-ptr (c-array double-float 10)) :in-out)))
@@ -4111,10 +4111,10 @@
   and call it from Lisp:
   <programlisting language="lisp">
 (ffi:def-call-out callout
-  (:name "CallInFunc")
+  (&name-k; "CallInFunc")
   (&library-k; "lispdll.dll")
   (&arguments-k; (function-arg
-               (ffi:c-function (&arguments-k; (number ffi:int))
+               (&c-function; (&arguments-k; (number ffi:int))
                                (&ret-type-k; ffi:int) (&lang-k; :stdc))))
   (&ret-type-k; ffi:int)
   (&lang-k; :stdc))
@@ -4251,7 +4251,7 @@
 (&def-call-out; get-own-c-float
   (&library-k; "libtest.so")
   (&lang-k; :stdc)
-  (:name "test_dll")
+  (&name-k; "test_dll")
   (&arguments-k; (ptr c-pointer :in :alloca))
   (&ret-type-k; double-float))
 
@@ -4325,7 +4325,7 @@
 <screen>&sh-prompt; gcc -shared -o libsum.so sum.c</screen>
 Now you can sum doubles:
 <programlisting language="lisp">
-(&def-call-out; sum (:name "sum") (&library-k; "libsum.so") (&lang-k; :stdc)
+(&def-call-out; sum (&name-k; "sum") (&library-k; "libsum.so") (&lang-k; :stdc)
   (&ret-type-k; ffi:double-float)
   (&arguments-k; (len ffi:int) (vec (&c-array-ptr; ffi:double-float))))
 (sum 3 #(1d0 2d0 3d0))
@@ -5229,8 +5229,8 @@
 
 <section id="quickstart-linux">
  <title>Associating extensions with &clisp; via kernel</title>
- <subtitle><emphasis role="plat-dep">&linux; platforms
-   only.</emphasis></subtitle>
+ <subtitle><emphasis role="plat-dep">&linux; platforms only.
+ </emphasis></subtitle>
 
 <para>You have to build your kernel with
  <option>CONFIG_BINFMT_MISC=y</option> and




------------------------------

------------------------------------------------------------------------------
Download new Adobe(R) Flash(R) Builder(TM) 4
The new Adobe(R) Flex(R) 4 and Flash(R) Builder(TM) 4 (formerly 
Flex(R) Builder(TM)) enable the development of rich applications that run
across multiple browsers and platforms. Download your free trials today!
http://p.sf.net/sfu/adobe-dev2dev

------------------------------

_______________________________________________
clisp-cvs mailing list
cli...@li...
https://lists.sourceforge.net/lists/listinfo/clisp-cvs


End of clisp-cvs Digest, Vol 54, Issue 15
*****************************************

clisp-cvs Digest, Vol 54, Issue 14

[<cli...@li...>]

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.7561,1.7562 (Sam Steingold)
   2. clisp/doc impent.xml,1.383,1.384 impext.xml,1.655,1.656
      (Sam Steingold)
   3. clisp/tests format.tst, 1.25, 1.26 iofkts.tst, 1.53, 1.54
      loop.tst,	1.28, 1.29 (Sam Steingold)
   4. clisp/src ChangeLog, 1.7562, 1.7563 NEWS, 1.549, 1.550
      loop.lisp, 1.44,	1.45 (Sam Steingold)
   5. clisp/tests ChangeLog,1.669,1.670 loop.tst,1.29,1.30
      (Sam Steingold)


----------------------------------------------------------------------

Message: 1
Date: Mon, 18 Oct 2010 13:59:12 +0000
From: Sam Steingold <sd...@us...>
Subject: clisp/src ChangeLog,1.7561,1.7562
To: cli...@li...
Message-ID: <E1P...@sf...>

Update of /cvsroot/clisp/clisp/src
In directory sfp-cvsdas-2.v30.ch3.sourceforge.com:/tmp/cvs-serv31425

Modified Files:
	ChangeLog 
Log Message:
formatting


Index: ChangeLog
===================================================================
RCS file: /cvsroot/clisp/clisp/src/ChangeLog,v
retrieving revision 1.7561
retrieving revision 1.7562
diff -u -d -r1.7561 -r1.7562
--- ChangeLog	18 Oct 2010 02:52:15 -0000	1.7561
+++ ChangeLog	18 Oct 2010 13:59:09 -0000	1.7562
@@ -1,25 +1,24 @@
 2010-10-18  Arseny Slobodyuk  <am...@us...>
 
-	* pathname.d (FIND_DATA_FWD) [WIN32_NATIVE]: fixed condition.
+	* pathname.d (FIND_DATA_FWD) [WIN32_NATIVE]: fixed condition
 
 2010-10-18  Julian Squires  <ju...@ci...>
             Arseny Slobodyuk  <am...@us...>
-            Fix for bug#3087668 - when probe-pathname used for
-            root directories on WIN32.
 
-	* pathname.d (PROBE-PATHNAME) [!UNIX]: do not remove trailing slash.
+        fix bug#3087668: probe-pathname on root directories on WIN32
+	* pathname.d (PROBE-PATHNAME) [!UNIX]: do not remove trailing slash
 	(classify_namestring) [WIN32_NATIVE]: use GetFileAttributesEx instead
-	of FindFirstFile to retrieve size and modify date/time, because
-	GetFileAttributesEx unlike FFF can handle root directories.
+	of FindFirstFile to retrieve size and modification date/time,
+	because GetFileAttributesEx unlike FFF can handle root directories
 
 2010-10-17  Vladimir Tzankov  <vtz...@gm...>
 
 	fix bug#3088751: SIGSEGV on large (unsigned-byte 8) arrays
-	* spvw_typealloc.d (allocate_bit_vector): use uintM. uintL overflows on
-	64 bit builds for large vectors
+	* spvw_typealloc.d (allocate_bit_vector): use uintM;
+	uintL overflows on 64 bit builds for large vectors
 	* spvw_objsize.d (size_sbvector): use uintM instead of uintL
-	* spvw_garcol.d (fill_varobject_heap_holes) [MULTITHREAD]: holes may be
-	larger than 2^32 bytes (uintL). use uintM.
+	* spvw_garcol.d (fill_varobject_heap_holes) [MULTITHREAD]:
+	holes may be larger than 2^32 bytes (uintL); use uintM
 
 2010-10-15  Sam Steingold  <sd...@gn...>
 




------------------------------

Message: 2
Date: Mon, 18 Oct 2010 21:31:24 +0000
From: Sam Steingold <sd...@us...>
Subject: clisp/doc impent.xml,1.383,1.384 impext.xml,1.655,1.656
To: cli...@li...
Message-ID: <E1P...@sf...>

Update of /cvsroot/clisp/clisp/doc
In directory sfp-cvsdas-2.v30.ch3.sourceforge.com:/tmp/cvs-serv30530/doc

Modified Files:
	impent.xml impext.xml 
Log Message:
with-lock --> with-mutex-lock (reported by donc)


Index: impext.xml
===================================================================
RCS file: /cvsroot/clisp/clisp/doc/impext.xml,v
retrieving revision 1.655
retrieving revision 1.656
diff -u -d -r1.655 -r1.656
--- impext.xml	14 Sep 2010 18:28:41 -0000	1.655
+++ impext.xml	18 Oct 2010 21:31:22 -0000	1.656
@@ -4949,7 +4949,7 @@
    &mutex-r;)</code></term>
  <listitem><simpara>Return a indicator whether &mutex-r; is recursive.
 </simpara></listitem></varlistentry>
-<varlistentry id="with-lock"><term><code>(&with-lock; (&mutex-r;)
+<varlistentry id="with-mutex-lock"><term><code>(&with-mutex-lock; (&mutex-r;)
    &body-amp; &body-r;)</code></term>
  <listitem><simpara>Execute &body-r; with &mutex-r; locked.
    Upon exit &mutex-r; is released. Return whatever &body-r; returns.

Index: impent.xml
===================================================================
RCS file: /cvsroot/clisp/clisp/doc/impent.xml,v
retrieving revision 1.383
retrieving revision 1.384
diff -u -d -r1.383 -r1.384
--- impent.xml	14 Sep 2010 18:28:41 -0000	1.383
+++ impent.xml	18 Oct 2010 21:31:22 -0000	1.384
@@ -535,7 +535,7 @@
 <!ENTITY mutex-unlock '<link linkend="mutex-unlock"><function>MT:MUTEX-UNLOCK</function></link>'>
 <!ENTITY mutex-owner '<link linkend="mutex-owner"><function>MT:MUTEX-OWNER</function></link>'>
 <!ENTITY mutex-recursive-p '<link linkend="mutex-recursive-p"><function>MT:MUTEX-RECURSIVE-P</function></link>'>
-<!ENTITY with-lock '<link linkend="with-lock"><function>MT:WITH-LOCK</function></link>'>
+<!ENTITY with-mutex-lock '<link linkend="with-mutex-lock"><function>MT:WITH-MUTEX-LOCK</function></link>'>
 <!ENTITY exemption '<link linkend="exemption"><type>MT:EXEMPTION</type></link>'>
 <!ENTITY exemptionp '<link linkend="exemptionp"><function>MT:EXEMPTIONP</function></link>'>
 <!ENTITY make-exemption '<link linkend="make-exemption"><function>MT:MAKE-EXEMPTION</function></link>'>




------------------------------

Message: 3
Date: Mon, 18 Oct 2010 21:41:12 +0000
From: Sam Steingold <sd...@us...>
Subject: clisp/tests format.tst, 1.25, 1.26 iofkts.tst, 1.53, 1.54
	loop.tst,	1.28, 1.29
To: cli...@li...
Message-ID: <E1P...@sf...>

Update of /cvsroot/clisp/clisp/tests
In directory sfp-cvsdas-2.v30.ch3.sourceforge.com:/tmp/cvs-serv885/tests

Modified Files:
	format.tst iofkts.tst loop.tst 
Log Message:
write-file-functions --> before-save-hook


Index: format.tst
===================================================================
RCS file: /cvsroot/clisp/clisp/tests/format.tst,v
retrieving revision 1.25
retrieving revision 1.26
diff -u -d -r1.25 -r1.26
--- format.tst	13 May 2009 17:30:37 -0000	1.25
+++ format.tst	18 Oct 2010 21:41:10 -0000	1.26
@@ -1274,19 +1274,19 @@
 
 
 (progn
-  (symbol-cleanup 'format-blocksatz) 
+  (symbol-cleanup 'format-blocksatz)
   (symbol-cleanup 'type-clash-error)
-  (symbol-cleanup 'foo) 
+  (symbol-cleanup 'foo)
   (symbol-cleanup 'x)
-  (symbol-cleanup 'y) 
-  (symbol-cleanup 'n) 
-  (symbol-cleanup 'liste) 
-  (symbol-cleanup 'donestr) 
-  (symbol-cleanup 'tellstr) 
+  (symbol-cleanup 'y)
+  (symbol-cleanup 'n)
+  (symbol-cleanup 'liste)
+  (symbol-cleanup 'donestr)
+  (symbol-cleanup 'tellstr)
   (symbol-cleanup 'gray-string-output-stream))
 T
 
 ;; local variables:
-;; eval: (make-local-variable 'write-file-functions)
-;; eval: (remove-hook 'write-file-functions 'delete-trailing-whitespace t)
+;; eval: (make-local-variable 'before-save-hook)
+;; eval: (remove-hook 'before-save-hook 'delete-trailing-whitespace t)
 ;; end:

Index: loop.tst
===================================================================
RCS file: /cvsroot/clisp/clisp/tests/loop.tst,v
retrieving revision 1.28
retrieving revision 1.29
diff -u -d -r1.28 -r1.29
--- loop.tst	30 Sep 2007 05:32:43 -0000	1.28
+++ loop.tst	18 Oct 2010 21:41:10 -0000	1.29
@@ -911,6 +911,6 @@
 
 
 ;; local variables:
-;; eval: (make-local-variable 'write-file-functions)
-;; eval: (remove-hook 'write-file-functions 'delete-trailing-whitespace t)
+;; eval: (make-local-variable 'before-save-hook)
+;; eval: (remove-hook 'before-save-hook 'delete-trailing-whitespace t)
 ;; end:

Index: iofkts.tst
===================================================================
RCS file: /cvsroot/clisp/clisp/tests/iofkts.tst,v
retrieving revision 1.53
retrieving revision 1.54
diff -u -d -r1.53 -r1.54
--- iofkts.tst	26 Nov 2008 20:38:58 -0000	1.53
+++ iofkts.tst	18 Oct 2010 21:41:10 -0000	1.54
@@ -919,6 +919,6 @@
 T
 
 ;; local variables:
-;; eval: (make-local-variable 'write-file-functions)
-;; eval: (remove-hook 'write-file-functions 'delete-trailing-whitespace t)
+;; eval: (make-local-variable 'before-save-hook)
+;; eval: (remove-hook 'before-save-hook 'delete-trailing-whitespace t)
 ;; end:




------------------------------

Message: 4
Date: Mon, 18 Oct 2010 22:19:26 +0000
From: Sam Steingold <sd...@us...>
Subject: clisp/src ChangeLog, 1.7562, 1.7563 NEWS, 1.549, 1.550
	loop.lisp, 1.44,	1.45
To: cli...@li...
Message-ID: <E1P...@sf...>

Update of /cvsroot/clisp/clisp/src
In directory sfp-cvsdas-2.v30.ch3.sourceforge.com:/tmp/cvs-serv12626/src

Modified Files:
	ChangeLog NEWS loop.lisp 
Log Message:
fix bug#3089988: (loop for x do (print x)) should barf
* src/loop.lisp (expand-loop): fail when the FOR clause lacks subclauses


Index: NEWS
===================================================================
RCS file: /cvsroot/clisp/clisp/src/NEWS,v
retrieving revision 1.549
retrieving revision 1.550
diff -u -d -r1.549 -r1.550
--- NEWS	29 Sep 2010 13:24:14 -0000	1.549
+++ NEWS	18 Oct 2010 22:19:24 -0000	1.550
@@ -17,7 +17,7 @@
   for details.
 
 * New user variable CUSTOM:*MODULE-PROVIDER-FUNCTIONS* allows user to
-  influence REQUIRE behavior.
+  influence behavior of REQUIRE.
   See <http://clisp.cons.org/impnotes/require.html#module-providers>
   for details.
 
@@ -37,6 +37,9 @@
   + Fix SCREEN behavior when the window is resized.
   + Pass the top-level configure arguments --build= & --host=
     to the module configures (bug#3076160).
+  + Fix PROBE-PATHNAME behavior on win32 and on open file streams (bug#3087668).
+  + Fix handling of huge byte arrays on 64-bit platforms (bug#3088751).
+  + Macro LOOP now detects incomplete FOR clauses (bug#3089988).
 
 
 2.49 (2010-07-07)

Index: loop.lisp
===================================================================
RCS file: /cvsroot/clisp/clisp/src/loop.lisp,v
retrieving revision 1.44
retrieving revision 1.45
diff -u -d -r1.44 -r1.45
--- loop.lisp	29 Sep 2009 21:59:08 -0000	1.44
+++ loop.lisp	18 Oct 2010 22:19:24 -0000	1.45
@@ -940,7 +940,14 @@
                                                  (TEXT "~S: questionable iteration direction after ~A")
                                                  'loop (symbol-name kw))
                                                'down)
-                                             'up)))
+                                             (if (or step-start-p step-end-p step-by-p)
+                                               'up
+                                               (error-of-type 'source-program-error
+                                                 :form *whole* :detail
+                                                 (list kw pattern preposition)
+                                                 (TEXT "~S: invalid keyword ~A after ~A")
+                                                 'loop (symbol-name preposition)
+                                                 (symbol-name kw))))))
                                      ;; Determine start, unless given:
                                      (unless step-start-p
                                        (when (eq step-direction 'down)

Index: ChangeLog
===================================================================
RCS file: /cvsroot/clisp/clisp/src/ChangeLog,v
retrieving revision 1.7562
retrieving revision 1.7563
diff -u -d -r1.7562 -r1.7563
--- ChangeLog	18 Oct 2010 13:59:09 -0000	1.7562
+++ ChangeLog	18 Oct 2010 22:19:24 -0000	1.7563
@@ -1,3 +1,8 @@
+2010-10-18  Sam Steingold  <sd...@gn...>
+
+	fix bug#3089988: (loop for x do (print x)) should barf
+	* loop.lisp (expand-loop): fail when the FOR clause lacks subclauses
+
 2010-10-18  Arseny Slobodyuk  <am...@us...>
 
 	* pathname.d (FIND_DATA_FWD) [WIN32_NATIVE]: fixed condition




------------------------------

Message: 5
Date: Mon, 18 Oct 2010 22:19:26 +0000
From: Sam Steingold <sd...@us...>
Subject: clisp/tests ChangeLog,1.669,1.670 loop.tst,1.29,1.30
To: cli...@li...
Message-ID: <E1P...@sf...>

Update of /cvsroot/clisp/clisp/tests
In directory sfp-cvsdas-2.v30.ch3.sourceforge.com:/tmp/cvs-serv12626/tests

Modified Files:
	ChangeLog loop.tst 
Log Message:
fix bug#3089988: (loop for x do (print x)) should barf
* src/loop.lisp (expand-loop): fail when the FOR clause lacks subclauses


Index: loop.tst
===================================================================
RCS file: /cvsroot/clisp/clisp/tests/loop.tst,v
retrieving revision 1.29
retrieving revision 1.30
diff -u -d -r1.29 -r1.30
--- loop.tst	18 Oct 2010 21:41:10 -0000	1.29
+++ loop.tst	18 Oct 2010 22:19:24 -0000	1.30
@@ -873,13 +873,17 @@
 NIL
 
 ;; <http://www.lisp.org/HyperSpec/Body/sec_6-1-3.html>
-(handler-case
-    (eval (macroexpand '(loop :for i :from 1 :to 20 :sum i :maximize i)))
+(handler-case (macroexpand '(loop :for i :from 1 :to 20 :sum i :maximize i))
   (program-error (c) (princ c) (values '(correct program-error))))
 (correct program-error)
 
 (handler-case
-    (eval (macroexpand '(loop :for i :from 1 :to 20 :sum i :always (evenp i))))
+    (macroexpand '(loop :for i :from 1 :to 20 :sum i :always (evenp i)))
+  (program-error (c) (princ c) (values '(correct program-error))))
+(correct program-error)
+
+;; https://sourceforge.net/tracker/?func=detail&atid=101355&aid=3089988&group_id=1355
+(handler-case (macroexpand '(loop :for i :do (print i)))
   (program-error (c) (princ c) (values '(correct program-error))))
 (correct program-error)
 

Index: ChangeLog
===================================================================
RCS file: /cvsroot/clisp/clisp/tests/ChangeLog,v
retrieving revision 1.669
retrieving revision 1.670
diff -u -d -r1.669 -r1.670
--- ChangeLog	15 Oct 2010 18:33:33 -0000	1.669
+++ ChangeLog	18 Oct 2010 22:19:24 -0000	1.670
@@ -1,3 +1,7 @@
+2010-10-18  Sam Steingold  <sd...@gn...>
+
+	* loop.tst: add a test for bug#3089988: (loop for x do (print x))
+
 2010-10-15  Sam Steingold  <sd...@gn...>
 
 	* path.tst: more PROBE-PATHNAME tests




------------------------------

------------------------------------------------------------------------------
Download new Adobe(R) Flash(R) Builder(TM) 4
The new Adobe(R) Flex(R) 4 and Flash(R) Builder(TM) 4 (formerly 
Flex(R) Builder(TM)) enable the development of rich applications that run
across multiple browsers and platforms. Download your free trials today!
http://p.sf.net/sfu/adobe-dev2dev

------------------------------

_______________________________________________
clisp-cvs mailing list
cli...@li...
https://lists.sourceforge.net/lists/listinfo/clisp-cvs


End of clisp-cvs Digest, Vol 54, Issue 14
*****************************************

clisp-cvs Digest, Vol 54, Issue 13

[<cli...@li...>]

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.7558,1.7559 pathname.d,1.521,1.522
      (Arseny Slobodyuk)
   2. clisp/src ChangeLog,1.7559,1.7560 pathname.d,1.522,1.523
      (Arseny Slobodyuk)
   3. clisp/src w32shell.c,1.15,1.16 (Arseny Slobodyuk)
   4. clisp/src ChangeLog,1.7560,1.7561 (Arseny Slobodyuk)


----------------------------------------------------------------------

Message: 1
Date: Mon, 18 Oct 2010 02:16:27 +0000
From: Arseny Slobodyuk <am...@us...>
Subject: clisp/src ChangeLog,1.7558,1.7559 pathname.d,1.521,1.522
To: cli...@li...
Message-ID: <E1P...@sf...>

Update of /cvsroot/clisp/clisp/src
In directory sfp-cvsdas-2.v30.ch3.sourceforge.com:/tmp/cvs-serv3219

Modified Files:
	ChangeLog pathname.d 
Log Message:
Fix bug#3087668 with probe-pathname.


Index: pathname.d
===================================================================
RCS file: /cvsroot/clisp/clisp/src/pathname.d,v
retrieving revision 1.521
retrieving revision 1.522
diff -u -d -r1.521 -r1.522
--- pathname.d	15 Oct 2010 18:32:25 -0000	1.521
+++ pathname.d	18 Oct 2010 02:16:24 -0000	1.522
@@ -5994,24 +5994,25 @@
   bool ret;
   begin_blocking_system_call();
   if (real_path(namestring,resolved)) {
-    DWORD fileattr;
-    fileattr = GetFileAttributes(resolved);
+    WIN32_FILE_ATTRIBUTE_DATA filedata;
+    BOOL success = GetFileAttributesEx(resolved, GetFileExInfoStandard, &filedata);
     end_blocking_system_call();
-    if (fileattr == 0xFFFFFFFF) {
+    if (success) {                  /* file exists. */
+      if (fwd) *fwd = convert_time_to_universal(
+        filedata.ftLastWriteTime.dwLowDateTime
+        || filedata.ftLastWriteTime.dwLowDateTime
+        ? &filedata.ftLastWriteTime : &filedata.ftCreationTime);
+      if (fsize) *fsize = off_to_I(
+        ((uint64)filedata.nFileSizeHigh<<32)|filedata.nFileSizeLow);
+      if (filedata.dwFileAttributes & FILE_ATTRIBUTE_DIRECTORY) 
+        return NAMESTRING_DIR;
+      else return NAMESTRING_FILE;
+    } else {
       /* you get ERROR_INVALID_NAME on GetFileAttributes("foo/")
          when file "foo" exists */
       if (!(WIN32_ERROR_NOT_FOUND || GetLastError() == ERROR_INVALID_NAME))
         OS_file_error(STACK_0);
       return NAMESTRING_NONE;   /* does not exist */
-    } else {                                   /* file exists. */
-      if (fwd || fsize) {
-        WIN32_FIND_DATA filedata;
-        find_first_file(resolved,&filedata); /* success is assured */
-        if (fwd) *fwd = convert_time_to_universal(FIND_DATA_FWD(filedata));
-        if (fsize) *fsize = off_to_I(FIND_DATA_FSIZE(filedata));
-      }
-      if (fileattr & FILE_ATTRIBUTE_DIRECTORY) return NAMESTRING_DIR;
-      else return NAMESTRING_FILE;
     }
   } else { end_blocking_system_call(); return NAMESTRING_NONE; }
 #else
@@ -6040,8 +6041,10 @@
   pushSTACK(NIL); pushSTACK(STACK_1); /* space for FWD & FSIZE */
   with_sstring_0(whole_namestring(STACK_0),O(pathname_encoding),
                  namestring_asciz, {
+#if defined(UNIX)
     if (cpslashp(namestring_asciz[namestring_asciz_bytelen-1]))
       namestring_asciz[namestring_asciz_bytelen-1] = 0; /* strip last slash */
+#endif
     classification = classify_namestring(namestring_asciz,resolved,
                                          &STACK_1/*fwd*/,&STACK_2/*fsize*/);
   });

Index: ChangeLog
===================================================================
RCS file: /cvsroot/clisp/clisp/src/ChangeLog,v
retrieving revision 1.7558
retrieving revision 1.7559
diff -u -d -r1.7558 -r1.7559
--- ChangeLog	17 Oct 2010 10:04:23 -0000	1.7558
+++ ChangeLog	18 Oct 2010 02:16:24 -0000	1.7559
@@ -1,3 +1,13 @@
+2010-10-18  Julian Squires  <ju...@ci...>
+            Arseny Slobodyuk  <am...@us...>
+            Fix for bug#3087668 - when probe-pathname used for
+            root directories on WIN32.
+
+	* pathname.d (probe_pathname) [!UNIX]: do not remove trailing slash.
+	(classify_namestring) [WIN32_NATIVE]: use GetFileAttributesEx instead
+	of FindFirstFile to retrieve size and modify date/time, because
+	GetFileAttributesEx unlike FFF can handle root directories.
+
 2010-10-17  Vladimir Tzankov  <vtz...@gm...>
 
 	fix bug#3088751: SIGSEGV on large (unsigned-byte 8) arrays




------------------------------

Message: 2
Date: Mon, 18 Oct 2010 02:29:20 +0000
From: Arseny Slobodyuk <am...@us...>
Subject: clisp/src ChangeLog,1.7559,1.7560 pathname.d,1.522,1.523
To: cli...@li...
Message-ID: <E1P...@sf...>

Update of /cvsroot/clisp/clisp/src
In directory sfp-cvsdas-2.v30.ch3.sourceforge.com:/tmp/cvs-serv6241

Modified Files:
	ChangeLog pathname.d 
Log Message:
Fix condition in FIND_DATA_FWD.


Index: pathname.d
===================================================================
RCS file: /cvsroot/clisp/clisp/src/pathname.d,v
retrieving revision 1.522
retrieving revision 1.523
diff -u -d -r1.522 -r1.523
--- pathname.d	18 Oct 2010 02:16:24 -0000	1.522
+++ pathname.d	18 Oct 2010 02:29:18 -0000	1.523
@@ -5936,7 +5936,7 @@
 #if defined(WIN32_NATIVE)
 #define FIND_DATA_FWD(filedata)                                 \
   ((filedata.ftLastWriteTime.dwLowDateTime == 0                 \
-    && filedata.ftLastWriteTime.dwHighDateTime)                 \
+    && filedata.ftLastWriteTime.dwHighDateTime == 0)            \
    ? &(filedata.ftCreationTime) : &(filedata.ftLastWriteTime))
 #define FIND_DATA_FSIZE(filedata)                               \
   (((uint64)filedata.nFileSizeHigh<<32)|filedata.nFileSizeLow)

Index: ChangeLog
===================================================================
RCS file: /cvsroot/clisp/clisp/src/ChangeLog,v
retrieving revision 1.7559
retrieving revision 1.7560
diff -u -d -r1.7559 -r1.7560
--- ChangeLog	18 Oct 2010 02:16:24 -0000	1.7559
+++ ChangeLog	18 Oct 2010 02:29:18 -0000	1.7560
@@ -1,3 +1,7 @@
+2010-10-18  Arseny Slobodyuk  <am...@us...>
+
+	* pathname.d (FIND_DATA_FWD) [WIN32_NATIVE]: fixed condition.
+
 2010-10-18  Julian Squires  <ju...@ci...>
             Arseny Slobodyuk  <am...@us...>
             Fix for bug#3087668 - when probe-pathname used for




------------------------------

Message: 3
Date: Mon, 18 Oct 2010 02:42:04 +0000
From: Arseny Slobodyuk <am...@us...>
Subject: clisp/src w32shell.c,1.15,1.16
To: cli...@li...
Message-ID: <E1P...@sf...>

Update of /cvsroot/clisp/clisp/src
In directory sfp-cvsdas-2.v30.ch3.sourceforge.com:/tmp/cvs-serv8788

Modified Files:
	w32shell.c 
Log Message:
Added a declaration for BTCoCreateInstance to avoid warning.
This warning is bad because it might mean wrong call agreement. 


Index: w32shell.c
===================================================================
RCS file: /cvsroot/clisp/clisp/src/w32shell.c,v
retrieving revision 1.15
retrieving revision 1.16
diff -u -d -r1.15 -r1.16
--- w32shell.c	5 Aug 2010 07:46:34 -0000	1.15
+++ w32shell.c	18 Oct 2010 02:42:02 -0000	1.16
@@ -122,6 +122,10 @@
 
 HRESULT BTCoCreateInstance (REFCLSID rclsid,  LPUNKNOWN pUnkOuter,
                             DWORD dwClsContext, REFIID riid,
+                            LPVOID * ppv);
+
+HRESULT BTCoCreateInstance (REFCLSID rclsid,  LPUNKNOWN pUnkOuter,
+                            DWORD dwClsContext, REFIID riid,
                             LPVOID * ppv)
 {
   HRESULT result = CoCreateInstance(rclsid, pUnkOuter, dwClsContext, riid, ppv);




------------------------------

Message: 4
Date: Mon, 18 Oct 2010 02:52:17 +0000
From: Arseny Slobodyuk <am...@us...>
Subject: clisp/src ChangeLog,1.7560,1.7561
To: cli...@li...
Message-ID: <E1P...@sf...>

Update of /cvsroot/clisp/clisp/src
In directory sfp-cvsdas-2.v30.ch3.sourceforge.com:/tmp/cvs-serv12256

Modified Files:
	ChangeLog 
Log Message:
Use lisp symbol to refer a function in ChangeLog.


Index: ChangeLog
===================================================================
RCS file: /cvsroot/clisp/clisp/src/ChangeLog,v
retrieving revision 1.7560
retrieving revision 1.7561
diff -u -d -r1.7560 -r1.7561
--- ChangeLog	18 Oct 2010 02:29:18 -0000	1.7560
+++ ChangeLog	18 Oct 2010 02:52:15 -0000	1.7561
@@ -7,7 +7,7 @@
             Fix for bug#3087668 - when probe-pathname used for
             root directories on WIN32.
 
-	* pathname.d (probe_pathname) [!UNIX]: do not remove trailing slash.
+	* pathname.d (PROBE-PATHNAME) [!UNIX]: do not remove trailing slash.
 	(classify_namestring) [WIN32_NATIVE]: use GetFileAttributesEx instead
 	of FindFirstFile to retrieve size and modify date/time, because
 	GetFileAttributesEx unlike FFF can handle root directories.




------------------------------

------------------------------------------------------------------------------
Download new Adobe(R) Flash(R) Builder(TM) 4
The new Adobe(R) Flex(R) 4 and Flash(R) Builder(TM) 4 (formerly 
Flex(R) Builder(TM)) enable the development of rich applications that run
across multiple browsers and platforms. Download your free trials today!
http://p.sf.net/sfu/adobe-dev2dev

------------------------------

_______________________________________________
clisp-cvs mailing list
cli...@li...
https://lists.sourceforge.net/lists/listinfo/clisp-cvs


End of clisp-cvs Digest, Vol 54, Issue 13
*****************************************

clisp-cvs Digest, Vol 54, Issue 12

[<cli...@li...>]

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.7557, 1.7558 spvw_garcol.d, 1.141,
      1.142 spvw_objsize.d, 1.23, 1.24 spvw_typealloc.d, 1.52, 1.53
      (Vladimir Tzankov)


----------------------------------------------------------------------

Message: 1
Date: Sun, 17 Oct 2010 10:04:25 +0000
From: Vladimir Tzankov <vt...@us...>
Subject: clisp/src ChangeLog, 1.7557, 1.7558 spvw_garcol.d, 1.141,
	1.142 spvw_objsize.d, 1.23, 1.24 spvw_typealloc.d, 1.52, 1.53
To: cli...@li...
Message-ID: <E1P...@sf...>

Update of /cvsroot/clisp/clisp/src
In directory sfp-cvsdas-2.v30.ch3.sourceforge.com:/tmp/cvs-serv27763/src

Modified Files:
	ChangeLog spvw_garcol.d spvw_objsize.d spvw_typealloc.d 
Log Message:
fix bug#3088751: SIGSEGV on large (unsigned-byte 8) arrays


Index: spvw_garcol.d
===================================================================
RCS file: /cvsroot/clisp/clisp/src/spvw_garcol.d,v
retrieving revision 1.141
retrieving revision 1.142
diff -u -d -r1.141 -r1.142
--- spvw_garcol.d	27 Feb 2010 18:28:48 -0000	1.141
+++ spvw_garcol.d	17 Oct 2010 10:04:23 -0000	1.142
@@ -1760,7 +1760,7 @@
        elements) - "allocate" few vectors. */
     while (holes->size != 0) {
       var Sbvector ptr=(Sbvector)holes->start;
-      var uintL len = holes->size - offsetofa(sbvector_,data);
+      var uintM len = holes->size - offsetofa(sbvector_,data);
       if (len > arraysize_limit_1) {
         /* In case of very large block (>= arraysize_limit_1) make sure we
            leave space for the next vector header */
@@ -1796,7 +1796,7 @@
       var bool vector=true;
       var Varobject ptr=(Varobject)holes->start;
       var Varobject pinned=(Varobject)(holes->start+holes->size);
-      uintL len = holes->size - sizeof(vrecord_);
+      uintM len = holes->size - sizeof(vrecord_);
       set_GCself(holes->start,mtypecode(pinned->GCself),holes->start);
       switch (typecode_at(holes->start)) {
       case_sbvector: ((Sbvector)ptr)->length = len<<=3; break;

Index: spvw_typealloc.d
===================================================================
RCS file: /cvsroot/clisp/clisp/src/spvw_typealloc.d,v
retrieving revision 1.52
retrieving revision 1.53
diff -u -d -r1.52 -r1.53
--- spvw_typealloc.d	23 Feb 2010 17:39:42 -0000	1.52
+++ spvw_typealloc.d	17 Oct 2010 10:04:23 -0000	1.53
@@ -118,7 +118,7 @@
  < result: fresh simple bit/byte-vector of the given length
  can trigger GC */
 modexp maygc object allocate_bit_vector (uintB atype, uintL len) {
-  var uintL need = size_sbvector(len<<atype); /* needed memory in bytes */
+  var uintM need = size_sbvector((uintM)len<<atype); /* needed memory in bytes */
  #ifdef TYPECODES
   #define SETTFL  ptr->length = len
  #else

Index: spvw_objsize.d
===================================================================
RCS file: /cvsroot/clisp/clisp/src/spvw_objsize.d,v
retrieving revision 1.23
retrieving revision 1.24
diff -u -d -r1.23 -r1.24
--- spvw_objsize.d	2 Oct 2009 10:55:13 -0000	1.23
+++ spvw_objsize.d	17 Oct 2010 10:04:23 -0000	1.24
@@ -58,7 +58,7 @@
       round_up( sizeof(symbol_), varobject_alignment)
 #endif
 #define size_sbvector(length)                  /* simple-bit-vector */ \
-  ( ceiling( (uintL)(length) + 8*offsetofa(sbvector_,data),     \
+  ( ceiling( (uintM)(length) + 8*offsetofa(sbvector_,data),     \
              8*varobject_alignment ) * varobject_alignment )
 #define size_sb2vector(length)                /* simple-2bit-vector */ \
   ( ceiling( (uintL)(length) + 4*offsetofa(sbvector_,data),     \

Index: ChangeLog
===================================================================
RCS file: /cvsroot/clisp/clisp/src/ChangeLog,v
retrieving revision 1.7557
retrieving revision 1.7558
diff -u -d -r1.7557 -r1.7558
--- ChangeLog	15 Oct 2010 18:32:25 -0000	1.7557
+++ ChangeLog	17 Oct 2010 10:04:23 -0000	1.7558
@@ -1,3 +1,12 @@
+2010-10-17  Vladimir Tzankov  <vtz...@gm...>
+
+	fix bug#3088751: SIGSEGV on large (unsigned-byte 8) arrays
+	* spvw_typealloc.d (allocate_bit_vector): use uintM. uintL overflows on
+	64 bit builds for large vectors
+	* spvw_objsize.d (size_sbvector): use uintM instead of uintL
+	* spvw_garcol.d (fill_varobject_heap_holes) [MULTITHREAD]: holes may be
+	larger than 2^32 bytes (uintL). use uintM.
+
 2010-10-15  Sam Steingold  <sd...@gn...>
 
 	* pathname.d (PROBE-PATHNAME): fix open stream handling




------------------------------

------------------------------------------------------------------------------
Download new Adobe(R) Flash(R) Builder(TM) 4
The new Adobe(R) Flex(R) 4 and Flash(R) Builder(TM) 4 (formerly 
Flex(R) Builder(TM)) enable the development of rich applications that run
across multiple browsers and platforms. Download your free trials today!
http://p.sf.net/sfu/adobe-dev2dev

------------------------------

_______________________________________________
clisp-cvs mailing list
cli...@li...
https://lists.sourceforge.net/lists/listinfo/clisp-cvs


End of clisp-cvs Digest, Vol 54, Issue 12
*****************************************