Send clisp-cvs mailing list submissions to
clisp-cvs@...
To subscribe or unsubscribe via the World Wide Web, visit
https://lists.sourceforge.net/lists/listinfo/clisp-cvs
or, via email, send a message with subject or body 'help' to
clisp-cvs-request@...
You can reach the person managing the list at
clisp-cvs-owner@...
When replying, please edit your Subject line so it is more specific
than "Re: Contents of clisp-cvs digest..."
CLISP CVS commits for today
Today's Topics:
1. clisp/modules/clx/new-clx clx.f,2.62,2.63 (Sam Steingold)
2. clisp/src ChangeLog,1.5502,1.5503 (Sam Steingold)
3. clisp/src ChangeLog, 1.5503, 1.5504 lispbibl.d, 1.716, 1.717
pathname.d, 1.395, 1.396 stream.d, 1.576, 1.577 (Sam Steingold)
----------------------------------------------------------------------
Message: 1
Date: Thu, 22 Feb 2007 19:05:05 +0000
From: Sam Steingold <sds@...>
Subject: clisp/modules/clx/new-clx clx.f,2.62,2.63
To: clisp-cvs@...
Message-ID: <E1HKJFb-0008EJ-HC@...>
Update of /cvsroot/clisp/clisp/modules/clx/new-clx
In directory sc8-pr-cvs4.sourceforge.net:/tmp/cvs-serv582/modules/clx/new-clx
Modified Files:
clx.f
Log Message:
fix new-clx "--with-debug" compilation
Index: clx.f
===================================================================
RCS file: /cvsroot/clisp/clisp/modules/clx/new-clx/clx.f,v
retrieving revision 2.62
retrieving revision 2.63
diff -u -d -r2.62 -r2.63
--- clx.f 23 Jan 2007 03:36:45 -0000 2.62
+++ clx.f 22 Feb 2007 19:05:02 -0000 2.63
@@ -1494,8 +1494,8 @@
return listof (cnt);
}
-static int get_client_message_data (XClientMessageEvent *event, uint32 format,
- object data)
+static void get_client_message_data (XClientMessageEvent *event, uint32 format,
+ object data)
{
int i;
if (consp (data)) {
@@ -6056,7 +6056,7 @@
#undef ESLOT5
/* pop event_key off the stack. */
- popSTACK();
+ skipSTACK(1);
}
/* (queue-event display event-key &rest args &key append-p send-event-p
@@ -7479,7 +7479,7 @@
funcall (L(aref), 2);
pushSTACK(value1); /* error code */
- pushSTACK(`:ASYNCHRONOUS`); pushSTACK(make_bool(T));
+ pushSTACK(`:ASYNCHRONOUS`); pushSTACK(T);
pushSTACK(`:CURRENT-SEQUENCE`); pushSTACK(make_uint16(NextRequest(display)));
pushSTACK(`:SEQUENCE`); pushSTACK(make_uint16(event->serial));
pushSTACK(`:MAJOR`); pushSTACK(make_uint8 (event->request_code));
------------------------------
Message: 2
Date: Thu, 22 Feb 2007 19:05:05 +0000
From: Sam Steingold <sds@...>
Subject: clisp/src ChangeLog,1.5502,1.5503
To: clisp-cvs@...
Message-ID: <E1HKJFf-0004JM-2f@...>
Update of /cvsroot/clisp/clisp/src
In directory sc8-pr-cvs4.sourceforge.net:/tmp/cvs-serv582/src
Modified Files:
ChangeLog
Log Message:
fix new-clx "--with-debug" compilation
Index: ChangeLog
===================================================================
RCS file: /cvsroot/clisp/clisp/src/ChangeLog,v
retrieving revision 1.5502
retrieving revision 1.5503
diff -u -d -r1.5502 -r1.5503
--- ChangeLog 15 Feb 2007 15:42:18 -0000 1.5502
+++ ChangeLog 22 Feb 2007 19:05:02 -0000 1.5503
@@ -1,3 +1,10 @@
+2007-02-22 Sam Steingold <sds@...>
+
+ fix new-clx "--with-debug" compilation
+ * modules/clx/new-clx/clx.f (get_client_message_data): declare void
+ (encode_event): use skipSTACK instead of popSTACK to avoid a warning
+ (xlib_error_handler): make_bool() accept an int, not an object
+
2007-02-15 Sam Steingold <sds@...>
* modules/clx/mit-clx/dependent.lisp (buffer-input-wait-default):
------------------------------
Message: 3
Date: Thu, 22 Feb 2007 20:12:09 +0000
From: Sam Steingold <sds@...>
Subject: clisp/src ChangeLog, 1.5503, 1.5504 lispbibl.d, 1.716, 1.717
pathname.d, 1.395, 1.396 stream.d, 1.576, 1.577
To: clisp-cvs@...
Message-ID: <E1HKKIZ-0007KK-9b@...>
Update of /cvsroot/clisp/clisp/src
In directory sc8-pr-cvs4.sourceforge.net:/tmp/cvs-serv26523/src
Modified Files:
ChangeLog lispbibl.d pathname.d stream.d
Log Message:
fix bug #[ 1666470 ]: EXT::LAUNCH crash
Index: pathname.d
===================================================================
RCS file: /cvsroot/clisp/clisp/src/pathname.d,v
retrieving revision 1.395
retrieving revision 1.396
diff -u -d -r1.395 -r1.396
--- pathname.d 10 Sep 2006 23:38:02 -0000 1.395
+++ pathname.d 22 Feb 2007 20:12:02 -0000 1.396
@@ -8482,18 +8482,16 @@
return (*h != INVALID_HANDLE);
}
-local maygc void make_launch_pipe (int istack, bool parent_inputp,
+local maygc void make_launch_pipe (gcv_object_t *ret, bool parent_inputp,
Handle hparent_pipe, int childpid)
{
if (hparent_pipe != INVALID_HANDLE) {
pushSTACK(STACK_7); /* encoding */
pushSTACK(STACK_(8+1)); /* element-type */
pushSTACK(STACK_(6+2)); /* buffered */
- (parent_inputp?mkips_from_handles:mkops_from_handles)
- (hparent_pipe,childpid); /* pufff */
+ *ret = (parent_inputp?mkips_from_handles:mkops_from_handles)
+ (hparent_pipe,childpid); /* replace :PIPE with PIPE-x-STREAM */
/* stack has been cleaned by callee */
- STACK_(istack+1) = STACK_0;/* replace :pipe with PIPE-x-STREAM */
- skipSTACK(1);
}
}
@@ -8740,15 +8738,15 @@
#endif
/* make pipe-streams */
/* child's input stream, pipe-output from our side */
- make_launch_pipe (3, false, hparent_out, child_id);
+ make_launch_pipe (&(STACK_3), false, hparent_out, child_id);
/* child's output stream, pipe-input from our side
double analysis of buffered, eltype,encoding
drawback: slow; advantage: simple iface with stream.d */
- make_launch_pipe (2, true, hparent_in, child_id);
+ make_launch_pipe (&(STACK_2), true, hparent_in, child_id);
/* child's error stream, pipe-input from our side */
- make_launch_pipe (1, true, hparent_errin, child_id);
+ make_launch_pipe (&(STACK_1), true, hparent_errin, child_id);
- value1 = wait_p ? fixnum(exit_code) : fixnum(child_id);
+ value1 = wait_p ? fixnum(exit_code) : L_to_I(child_id);
value2 = (hparent_out != INVALID_HANDLE) ? (object)STACK_3 : NIL; /* INPUT */
value3 = (hparent_in != INVALID_HANDLE) ? (object)STACK_2 : NIL; /* OUTPUT */
value4 = (hparent_errin != INVALID_HANDLE) ? (object)STACK_1 : NIL; /* ERROR */
Index: lispbibl.d
===================================================================
RCS file: /cvsroot/clisp/clisp/src/lispbibl.d,v
retrieving revision 1.716
retrieving revision 1.717
diff -u -d -r1.716 -r1.717
--- lispbibl.d 2 Jan 2007 21:32:18 -0000 1.716
+++ lispbibl.d 22 Feb 2007 20:12:02 -0000 1.717
@@ -15762,27 +15762,27 @@
#ifdef PIPES
/* mkops_from_handles(pipe,process_id)
- Make a PIPE-OUTPUT-STREAM from pipe handle and a process-id
- > STACK_0: buffered
- > STACK_1: element-type
- > STACK_2: encoding
- < STACK_0: result - a PIPE-OUTPUT-STREAM
- Used in LAUNCH
- Can trigger GC */
-extern maygc void mkops_from_handles (Handle opipe, int process_id);
+ Make a PIPE-OUTPUT-STREAM from pipe handle and a process-id
+ > STACK_0: buffered
+ > STACK_1: element-type
+ > STACK_2: encoding
+ < result - a PIPE-OUTPUT-STREAM
+ Used in LAUNCH
+ can trigger GC */
+extern maygc object mkops_from_handles (Handle opipe, int process_id);
# is used by PATHNAME
#endif
#ifdef PIPES
/* mkips_from_handles(pipe,process_id)
- Make a PIPE-INPUT-STREAM from pipe handle and a process-id
- > STACK_0: buffered
- > STACK_1: element-type
- > STACK_2: encoding
- < STACK_0: result - a PIPE-INPUT-STREAM
- Used in LAUNCH
- Can trigger GC */
-extern maygc void mkips_from_handles (Handle ipipe, int process_id);
+ Make a PIPE-INPUT-STREAM from pipe handle and a process-id
+ > STACK_0: buffered
+ > STACK_1: element-type
+ > STACK_2: encoding
+ < result - a PIPE-INPUT-STREAM
+ Used in LAUNCH
+ can trigger GC */
+extern maygc object mkips_from_handles (Handle ipipe, int process_id);
# is used by PATHNAME
#endif
Index: stream.d
===================================================================
RCS file: /cvsroot/clisp/clisp/src/stream.d,v
retrieving revision 1.576
retrieving revision 1.577
diff -u -d -r1.576 -r1.577
--- stream.d 6 Feb 2007 03:24:48 -0000 1.576
+++ stream.d 22 Feb 2007 20:12:04 -0000 1.577
@@ -12774,6 +12774,28 @@
pushSTACK(allocate_handle(handles[0]));
}
+/* make, init, and reguster pipe stream object
+ > buffered
+ > direction
+ > eltype
+ < stream object
+ can trigger GC */
+local maygc object make_pipe (signean buffered, direction_t direction,
+ decoded_el_t *eltype) {
+ var object stream;
+ var uintB type = (direction == DIRECTION_INPUT
+ ? strmtype_pipe_in : strmtype_pipe_out);
+ if (buffered < 0) {
+ stream = make_unbuffered_stream(type,direction,eltype,false,false);
+ UnbufferedPipeStream_input_init(stream);
+ } else {
+ stream = make_buffered_stream(type,direction,eltype,false,false);
+ BufferedPipeStream_init(stream);
+ }
+ ChannelStreamLow_close(stream) = &low_close_pipe;
+ return add_to_open_streams(stream);
+}
+
# (MAKE-PIPE-INPUT-STREAM command [:element-type] [:external-format] [:buffered])
# calls a shell, that executes command, whereby its Standard-Output
# is directed into our pipe.
@@ -12797,20 +12819,10 @@
create_input_pipe(command_asciz);
});
# allocate Stream:
- var object stream;
- if (buffered < 0) {
- stream = make_unbuffered_stream(strmtype_pipe_in,DIRECTION_INPUT,
- &eltype,false,false);
- UnbufferedPipeStream_input_init(stream);
- } else {
- stream = make_buffered_stream(strmtype_pipe_in,DIRECTION_INPUT,
- &eltype,false,false);
- BufferedPipeStream_init(stream);
- }
- ChannelStreamLow_close(stream) = &low_close_pipe;
+ var object stream = make_pipe(buffered,DIRECTION_INPUT,&eltype);
TheStream(stream)->strm_pipe_pid = popSTACK(); # Child-Pid
skipSTACK(4);
- VALUES1(add_to_open_streams(stream)); /* return stream */
+ VALUES1(stream); /* return stream */
}
@@ -13007,31 +13019,21 @@
create_output_pipe(command_asciz);
});
# allocate Stream:
- var object stream;
- if (buffered <= 0) {
- stream = make_unbuffered_stream(strmtype_pipe_out,DIRECTION_OUTPUT,
- &eltype,false,false);
- UnbufferedPipeStream_output_init(stream);
- } else {
- stream = make_buffered_stream(strmtype_pipe_out,DIRECTION_OUTPUT,
- &eltype,false,false);
- BufferedPipeStream_init(stream);
- }
- ChannelStreamLow_close(stream) = &low_close_pipe;
+ var object stream = make_pipe(buffered,DIRECTION_OUTPUT,&eltype);
TheStream(stream)->strm_pipe_pid = popSTACK(); # Child-Pid
skipSTACK(4);
- VALUES1(add_to_open_streams(stream)); /* return stream */
+ VALUES1(stream); /* return stream */
}
/* mkops_from_handles(pipe,process_id)
- Make a PIPE-OUTPUT-STREAM from pipe handle and a process-id
- > STACK_0: buffered
- > STACK_1: element-type
- > STACK_2: encoding
- < STACK_0: result - a PIPE-OUTPUT-STREAM
- Used in LAUNCH
- Can trigger GC */
-global maygc void mkops_from_handles (Handle opipe, int process_id) {
+ Make a PIPE-OUTPUT-STREAM from pipe handle and a process-id
+ > STACK_0: buffered
+ > STACK_1: element-type
+ > STACK_2: encoding
+ < result - a PIPE-OUTPUT-STREAM
+ Used in LAUNCH
+ can trigger GC */
+global maygc object mkops_from_handles (Handle opipe, int process_id) {
var decoded_el_t eltype;
var signean buffered;
# Check and canonicalize the :BUFFERED argument:
@@ -13043,29 +13045,21 @@
# Check and canonicalize the :EXTERNAL-FORMAT argument:
STACK_2 = test_external_format_arg(STACK_2);
STACK_0 = allocate_handle(opipe);
- if (buffered > 0) {
- pushSTACK(make_buffered_stream(strmtype_pipe_out,DIRECTION_OUTPUT,
- &eltype,false,false));
- BufferedPipeStream_init(STACK_0);
- } else {
- pushSTACK(make_unbuffered_stream(strmtype_pipe_out,DIRECTION_OUTPUT,
- &eltype,false,false));
- UnbufferedPipeStream_output_init(STACK_0);
- }
- ChannelStreamLow_close(STACK_0) = &low_close_pipe;
+ var object stream = make_pipe(buffered,DIRECTION_OUTPUT,&eltype);
+ pushSTACK(stream);
TheStream(STACK_0)->strm_pipe_pid = UL_to_I(process_id);
- add_to_open_streams(STACK_0); /* return stream */
+ return popSTACK(); /* return stream */
}
/* mkips_from_handles(pipe,process_id)
- Make a PIPE-INPUT-STREAM from pipe handle and a process-id
- > STACK_0: buffered
- > STACK_1: element-type
- > STACK_2: encoding
- < STACK_0: result - a PIPE-INPUT-STREAM
- Used in LAUNCH
- Can trigger GC */
-global maygc void mkips_from_handles (Handle ipipe, int process_id) {
+ Make a PIPE-INPUT-STREAM from pipe handle and a process-id
+ > STACK_0: buffered
+ > STACK_1: element-type
+ > STACK_2: encoding
+ < result - a PIPE-INPUT-STREAM
+ Used in LAUNCH
+ can trigger GC */
+global maygc object mkips_from_handles (Handle ipipe, int process_id) {
var decoded_el_t eltype;
var signean buffered;
# Check and canonicalize the :BUFFERED argument:
@@ -13077,18 +13071,10 @@
# Check and canonicalize the :EXTERNAL-FORMAT argument:
STACK_2 = test_external_format_arg(STACK_2);
STACK_0 = allocate_handle(ipipe);
- if (buffered >= 0) {
- pushSTACK(make_buffered_stream(strmtype_pipe_in,DIRECTION_INPUT,
- &eltype,false,false));
- BufferedPipeStream_init(STACK_0);
- } else {
- pushSTACK(make_unbuffered_stream(strmtype_pipe_in,DIRECTION_INPUT,
- &eltype,false,false));
- UnbufferedPipeStream_input_init(STACK_0);
- }
- ChannelStreamLow_close(STACK_0) = &low_close_pipe;
+ var object stream = make_pipe(buffered,DIRECTION_INPUT,&eltype);
+ pushSTACK(stream);
TheStream(STACK_0)->strm_pipe_pid = UL_to_I(process_id);
- add_to_open_streams(STACK_0); /* return stream */
+ return popSTACK(); /* return stream */
}
@@ -13259,38 +13245,18 @@
pushSTACK(STACK_(1+3)); # encoding
pushSTACK(STACK_(2+3+1)); # eltype
pushSTACK(STACK_(1+2));
- var object stream;
- if (buffered < 0) {
- stream = make_unbuffered_stream(strmtype_pipe_in,DIRECTION_INPUT,
- &eltype,false,false);
- UnbufferedPipeStream_input_init(stream);
- } else {
- stream = make_buffered_stream(strmtype_pipe_in,DIRECTION_INPUT,
- &eltype,false,false);
- BufferedPipeStream_init(stream);
- }
- ChannelStreamLow_close(stream) = &low_close_pipe;
+ var object stream = make_pipe(buffered,DIRECTION_INPUT,&eltype);
TheStream(stream)->strm_pipe_pid = STACK_2; # Child-Pid
- STACK_1 = add_to_open_streams(stream);
+ STACK_1 = stream;
}
# allocate Output-Stream:
{
pushSTACK(STACK_(1+3)); # encoding
pushSTACK(STACK_(2+3+1)); # eltype
pushSTACK(STACK_(0+2));
- var object stream;
- if (buffered <= 0) {
- stream = make_unbuffered_stream(strmtype_pipe_out,DIRECTION_OUTPUT,
- &eltype,false,false);
- UnbufferedPipeStream_output_init(stream);
- } else {
- stream = make_buffered_stream(strmtype_pipe_out,DIRECTION_OUTPUT,
- &eltype,false,false);
- BufferedPipeStream_init(stream);
- }
- ChannelStreamLow_close(stream) = &low_close_pipe;
+ var object stream = make_pipe(buffered,DIRECTION_OUTPUT,&eltype);
TheStream(stream)->strm_pipe_pid = STACK_2; # Child-Pid
- STACK_0 = add_to_open_streams(stream);
+ STACK_0 = stream;
}
# 3 values:
# (make-two-way-stream input-stream output-stream), input-stream, output-stream.
Index: ChangeLog
===================================================================
RCS file: /cvsroot/clisp/clisp/src/ChangeLog,v
retrieving revision 1.5503
retrieving revision 1.5504
diff -u -d -r1.5503 -r1.5504
--- ChangeLog 22 Feb 2007 19:05:02 -0000 1.5503
+++ ChangeLog 22 Feb 2007 20:11:57 -0000 1.5504
@@ -1,5 +1,18 @@
2007-02-22 Sam Steingold <sds@...>
+ fix bug #[ 1666470 ]: EXT::LAUNCH crash
+ again: cannot do pushSTACK(foo()) if foo() manipulates STACK
+ * stream.d (make_pipe): new function
+ (MAKE-PIPE-INPUT-STREAM, MAKE-PIPE-OUTPUT-STREAM, MAKE-PIPE-IO-STREAM)
+ (mkops_from_handles, mkips_from_handles): use it
+ (mkops_from_handles, mkips_from_handles): return value without STACK
+ * lispbibl.d (mkops_from_handles, mkips_from_handles): update prototypes
+ * pathname.d (make_launch_pipe): pass stack location instead of
+ index as the first argument
+ (LAUNCH): use L_to_I() for PID, not fixnum()
+
+2007-02-22 Sam Steingold <sds@...>
+
fix new-clx "--with-debug" compilation
* modules/clx/new-clx/clx.f (get_client_message_data): declare void
(encode_event): use skipSTACK instead of popSTACK to avoid a warning
@@ -193,7 +206,7 @@
2006-12-28 Sam Steingold <sds@...>
- fix bug [ 1208124 ]: hashcode_bignum weakness
+ fix bug #[ 1208124 ]: hashcode_bignum weakness
* hashtabl.d (hashcode_bignum): use all digits
2006-12-27 Sam Steingold <sds@...>
@@ -229,7 +242,7 @@
2006-12-27 Sam Steingold <sds@...>
- fix bug [ 1412454 ]: format/*print-pretty* interaction: extra newlines
+ fix bug #[ 1412454 ]: format/*print-pretty* interaction: extra newlines
* io.d (pr_enter_1): respect *PPRINT-FIRST-NEWLINE* in all cases
2006-12-27 Sam Steingold <sds@...>
------------------------------
-------------------------------------------------------------------------
Take Surveys. Earn Cash. Influence the Future of IT
Join SourceForge.net's Techsay panel and you'll get the chance to share your
opinions on IT & business topics through brief surveys-and earn cash
http://www.techsay.com/default.php?page=join.php&p=sourceforge&CID=DEVDEV
------------------------------
_______________________________________________
clisp-cvs mailing list
clisp-cvs@...
https://lists.sourceforge.net/lists/listinfo/clisp-cvs
End of clisp-cvs Digest, Vol 10, Issue 6
****************************************
|