Subject: [clisp-list] write-byte-sequence :no-hang

From: [email-masked] (Don Cohen)
Date: Thu Sep 18 16:41:03 2003

Below is current diff.  The build finishes but
 (ext:write-byte-sequence a st :no-hang t)
gives me
 *** - WRITE-BYTE-SEQUENCE: illegal keyword/value pair :NO-HANG, T in argument list.
 The allowed keywords are (:START :END)

Can someone tell me what I've missed?  
I expected the following to cause the new argument to be recognized.
[in sequence.d]
+LISPFUN(write_byte_sequence,seclass_default,2,0,norest,key,3,
+        (kw(start),kw(end),kw(no_hang)) )

In particular, this is the same as for read-byte-sequence
but :no-hang is accepted there.

Feel free to tell me what else I'm doing wrong, of course.

================

# diff -ur . ../src | grep -v ^Only
diff -ur ./genclisph.d ../src/genclisph.d
--- ./genclisph.d	Wed Sep 17 16:48:06 2003
+++ ../src/genclisph.d	Thu Sep 18 12:32:57 2003
@@ -1486,7 +1486,7 @@
   }
   printf("#define VALUES0 do{ value1 = NIL; mv_count = 0; }while(0)\n");
   printf("#define VALUES1(A) do{ value1 = (A); mv_count = 1; }while(0)\n");
-  printf("#define VALUES2(A,B) do{ value1 = (A); value2 = (B); mv_count = 3;}while(0)\n");
+  printf("#define VALUES2(A,B) do{ value1 = (A); value2 = (B); mv_count = 2;}while(0)\n");
   printf("#define VALUES3(A,B,C) do{ value1 = (A); value2 = (B); value3 = (C); mv_count = 3;}while(0)\n");
   printf("#define VALUES_IF(C) do{ value1 = (C) ? T : NIL; mv_count = 1; }while(0)\n");
   printf("#define args_end_pointer  STACK\n");
@@ -1742,7 +1742,7 @@
   printf("extern Handle handle_dup (Handle old_handle, Handle new_handle);\n");
   printf("extern Handle stream_lend_handle (object stream, bool inputp, int * handletype);\n");
   printf("extern uintL read_byte_array (const gcv_object_t* stream_, const gcv_object_t* bytearray_, uintL start, uintL len, bool no_hang);\n");
-  printf("extern void write_byte_array (const gcv_object_t* stream_, const gcv_object_t* bytearray_, uintL start, uintL len);\n");
+  printf("extern uintL write_byte_array (const gcv_object_t* stream_, const gcv_object_t* bytearray_, uintL start, uintL len, bool no_hang);\n");
   printf("extern void builtin_stream_close (const gcv_object_t* stream_);\n");
   printf("extern object file_stream_truename (object s);\n");
   printf("extern object open_file_stream_handle (object stream, Handle *fd);\n");
diff -ur ./lispbibl.d ../src/lispbibl.d
--- ./lispbibl.d	Wed Sep 17 16:48:06 2003
+++ ../src/lispbibl.d	Wed Sep 17 16:39:18 2003
@@ -12791,12 +12791,13 @@
 /* used by SEQUENCE, PATHNAME */
 
 # Function: Writes several bytes to a stream.
-# write_byte_array(&stream,&bytearray,start,len)
+# write_byte_array(&stream,&bytearray,start,len,no_hang)
 # > stream: Stream (on the STACK)
 # > object bytearray: simple-8bit-vector (on the STACK)
 # > uintL start: start index of byte sequence to be written
 # > uintL len: length of byte sequence to be written
-extern void write_byte_array (const gcv_object_t* stream_, const gcv_object_t* bytearray_, uintL start, uintL len);
+# > bool no_hang: don't block, return #bytes written
+extern uintL write_byte_array (const gcv_object_t* stream_, const gcv_object_t* bytearray_, uintL start, uintL len, bool no_hang);
 # is used by SEQUENCE
 
 # Function: Reads several characters from a stream.
diff -ur ./sequence.d ../src/sequence.d
--- ./sequence.d	Wed Sep 17 16:48:06 2003
+++ ../src/sequence.d	Thu Sep 18 13:04:49 2003
@@ -4251,13 +4251,18 @@
   skipSTACK(6);
 }
 
-LISPFUN(write_byte_sequence,seclass_default,2,0,norest,key,2,
-        (kw(start),kw(end)) )
-{ /* (WRITE-BYTE-SEQUENCE sequence stream [:start] [:end]),
+LISPFUN(write_byte_sequence,seclass_default,2,0,norest,key,3,
+        (kw(start),kw(end),kw(no_hang)) )
+{ /* (WRITE-BYTE-SEQUENCE sequence stream [:start] [:end] [:no-hang]),
      it is not clear what this should return when :NO-HANG is T
-     and only a part of the sequence was written!
+     and only a part of the sequence was written! 
+     -- new spec [Don Cohen]
+	- always return sequence as first value (backward compatible)
+	- optional second value is position of first unwritten byte 
+          if not supplied, assumed to be :end (all written)
     cf. dpANS p. 21-27 */
-  /* stack layout: sequence, stream, start, end. */
+  /* stack layout: sequence, stream, start, end, no-hang. */
+  var bool no_hang = !missingp(STACK_0); skipSTACK(1);
   pushSTACK(get_valid_seq_type(STACK_3)); /* sequence check */
   /* stack layout: sequence, stream, start, end, typdescr. */
   if (!streamp(STACK_3)) { fehler_stream(STACK_3); } /* check stream */
@@ -4270,27 +4275,31 @@
     var uintL end = posfixnum_to_L(STACK_1);
     var uintL index = 0;
     STACK_0 = array_displace_check(STACK_4,end,&index);
-    write_byte_array(&STACK_3,&STACK_0,index+start,end-start);
-    goto done;
-  }
-  /* subtract start and end: */
-  STACK_1 = I_I_minus_I(STACK_1,STACK_2); /* (- end start), an integer >=0 */
-  /* stack layout: sequence, item, start, count, typdescr. */
-  /* determine start pointer: */
-  pushSTACK(STACK_4); pushSTACK(STACK_(2+1));
-  funcall(seq_init_start(STACK_(0+2)),2); /* (SEQ-INIT-START sequence start) */
-  STACK_2 = value1; /* =: pointer */
-  /* stack layout: sequence, stream, pointer, count, typdescr. */
-  while (!eq(STACK_1,Fixnum_0)) { /* count (an integer) = 0 -> done */
+   {var uintL result =
+     write_byte_array(&STACK_3,&STACK_0,index+start,end-start,no_hang);
+     skipSTACK(5);
+     VALUES2(popSTACK(),fixnum(start+result));
+   }}
+  else {
+    /* subtract start and end: */
+    STACK_1 = I_I_minus_I(STACK_1,STACK_2); /* (- end start), an integer >=0 */
+    /* stack layout: sequence, item, start, count, typdescr. */
+    /* determine start pointer: */
     pushSTACK(STACK_4); pushSTACK(STACK_(2+1));
-    funcall(seq_access(STACK_(0+2)),2); /* (SEQ-ACCESS sequence pointer) */
-    write_byte(STACK_3,value1); /* output an element  */
-    /* pointer := (SEQ-UPD sequence pointer) : */
-    pointer_update(STACK_2,STACK_4,STACK_0);
-    /* count := (1- count) : */
-    decrement(STACK_1);
+    funcall(seq_init_start(STACK_(0+2)),2); /* (SEQ-INIT-START sequence start) */
+    STACK_2 = value1; /* =: pointer */
+    /* stack layout: sequence, stream, pointer, count, typdescr. */
+    while (!eq(STACK_1,Fixnum_0)) { /* count (an integer) = 0 -> done */
+      pushSTACK(STACK_4); pushSTACK(STACK_(2+1));
+      funcall(seq_access(STACK_(0+2)),2); /* (SEQ-ACCESS sequence pointer) */
+      write_byte(STACK_3,value1); /* output an element  */
+      /* pointer := (SEQ-UPD sequence pointer) : */
+      pointer_update(STACK_2,STACK_4,STACK_0);
+      /* count := (1- count) : */
+      decrement(STACK_1);
+    }
+  done:
+    skipSTACK(4);
+    VALUES1(popSTACK()); /* return sequence */
   }
- done:
-  skipSTACK(4);
-  VALUES1(popSTACK()); /* return sequence */
 }
diff -ur ./spvw_memfile.d ../src/spvw_memfile.d
--- ./spvw_memfile.d	Wed Sep 17 16:48:06 2003
+++ ../src/spvw_memfile.d	Wed Sep 17 14:04:34 2003
@@ -224,7 +224,7 @@
   gar_col();
 #define WRITE(buf,len)                                                  \
   do { begin_system_call();                                             \
-    {var sintL ergebnis = full_write(handle,(RW_BUF_T)buf,len);         \
+    {var sintL ergebnis = full_write(handle,(RW_BUF_T)buf,len,0);         \
       if (ergebnis != (sintL)(len)) {                                   \
         end_system_call();                                              \
         builtin_stream_close(&STACK_0);                                 \
diff -ur ./stream.d ../src/stream.d
--- ./stream.d	Wed Sep 17 16:48:06 2003
+++ ../src/stream.d	Thu Sep 18 12:43:15 2003
@@ -87,7 +87,7 @@
     typedef object (* rd_by_Pseudofun) (object stream);
 
 /* Specification for READ-BYTE-ARRAY - Pseudo-Function:
- fun(&stream,&bytearray,start,len)
+ fun(&stream,&bytearray,start,len,no_hang)
  > stream: stream
  > object bytearray: simple-8bit-vector
  > uintL start: start index of byte sequence to be filled
@@ -105,13 +105,14 @@
     typedef void (* wr_by_Pseudofun) (object stream, object obj);
 
   # Specification for WRITE-BYTE-ARRAY - Pseudo-Function:
-  # fun(&stream,&bytearray,start,len)
+  # fun(&stream,&bytearray,start,len,no_hang)
   # > stream: stream
   # > object bytearray: simple-8bit-vector
   # > uintL start: start index of byte sequence to be written
   # > uintL len: length of byte sequence to be written, >0
+  # > bool no_hang: do not block
   # can trigger GC
-    typedef void (* wr_by_array_Pseudofun) (const gcv_object_t* stream_, const gcv_object_t* bytearray_, uintL start, uintL len);
+    typedef uintL (* wr_by_array_Pseudofun) (const gcv_object_t* stream_, const gcv_object_t* bytearray_, uintL start, uintL len, bool no_hang);
 
   # Specification for READ-CHAR - Pseudo-Function:
   # fun(&stream)
@@ -265,13 +266,14 @@
 
 local void wr_by_array_error (const gcv_object_t* stream_,
                               const gcv_object_t* bytearray_,
-                              uintL start, uintL len) {
+                              uintL start, uintL len, bool no_hang) {
   fehler_illegal_streamop(S(write_byte),*stream_);
 }
 
-local void wr_by_array_dummy (const gcv_object_t* stream_,
+local uintL wr_by_array_dummy (const gcv_object_t* stream_,
                               const gcv_object_t* bytearray_,
-                              uintL start, uintL len) {
+                              uintL start, uintL len, bool no_hang) {
+  /* *** no_hang not supported by default */
   var uintL end = start + len;
   var uintL index = start;
   do {
@@ -279,6 +281,7 @@
     wr_by(stream)(stream,fixnum(TheSbvector(*bytearray_)->data[index]));
     index++;
   } while (index < end);
+  return len;
 }
 
 local object rd_ch_error (const gcv_object_t* stream_) {
@@ -466,11 +469,12 @@
 }
 
 # Function: Reads several bytes from a stream.
-# read_byte_array(&stream,&bytearray,start,len)
+# read_byte_array(&stream,&bytearray,start,len,no_hang)
 # > stream: stream (on the STACK)
 # > object bytearray: simple-8bit-vector (on the STACK)
 # > uintL start: start index of byte sequence to be filled
 # > uintL len: length of byte sequence to be filled
+# > bool no_hang: don't block (return #bytes read)
 # < uintL result: number of bytes that have been filled
 # can trigger GC
 global uintL read_byte_array (const gcv_object_t* stream_,
@@ -517,25 +521,43 @@
 }
 
 # Function: Writes several bytes to a stream.
-# write_byte_array(&stream,&bytearray,start,len)
+# write_byte_array(&stream,&bytearray,start,len,no_hang)
 # > stream: Stream (on the STACK)
 # > object bytearray: simple-8bit-vector (on the STACK)
 # > uintL start: start index of byte sequence to be written
 # > uintL len: length of byte sequence to be written
-global void write_byte_array (const gcv_object_t* stream_,
+# > bool no_hang: don't block, return #bytes written
+global uintL write_byte_array (const gcv_object_t* stream_,
                               const gcv_object_t* bytearray_,
-                              uintL start, uintL len) {
+                              uintL start, uintL len, bool no_hang) {
   if (len==0)
-    return;
+    return 0;
   var object stream = *stream_;
   if (builtin_stream_p(stream)) {
-    wr_by_array(stream)(stream_,bytearray_,start,len);
+    return wr_by_array(stream)(stream_,bytearray_,start,len,no_hang);
   } else {
     # Call the generic function
     # (STREAM-WRITE-BYTE-SEQUENCE stream bytearray start start+len):
     pushSTACK(stream); pushSTACK(*bytearray_);
     pushSTACK(fixnum(start)); pushSTACK(fixnum(start+len));
-    funcall(S(stream_write_byte_sequence),4);
+    pushSTACK(no_hang ? T : NIL);
+    funcall(S(stream_write_byte_sequence),5);
+    if (mv_count >= 2) {
+      /* second return value is index of first unwritten byte
+	 have to change that here into #bytes written */
+      var uintL result;
+      if (!(posfixnump(value2)
+	    && (result = posfixnum_to_L(value2),
+		result >= start && result <= start+len))) {
+	pushSTACK(fixnum(start+len));
+	pushSTACK(fixnum(start));
+	pushSTACK(S(stream_write_byte_sequence));
+	pushSTACK(value2);
+	fehler(error,GETTEXT("Return value ~ of call to ~ should be an integer between ~ and ~."));
+      }
+      return result-start;
+    }
+    return len;
   }
 }
 
@@ -1026,14 +1048,16 @@
 }
 
 # WRITE-BYTE-ARRAY - Pseudo-Function for Synonym-Streams:
-local void wr_by_array_synonym (const gcv_object_t* stream_,
+local uintL wr_by_array_synonym (const gcv_object_t* stream_,
                                 const gcv_object_t* bytearray_,
-                                uintL start, uintL len) {
+                                uintL start, uintL len, bool no_hang) {
+  int result;
   check_SP(); check_STACK();
   var object symbol = TheStream(*stream_)->strm_synonym_symbol;
   pushSTACK(get_synonym_stream(symbol));
-  write_byte_array(&STACK_0,bytearray_,start,len);
+  result = write_byte_array(&STACK_0,bytearray_,start,len,no_hang);
   skipSTACK(1);
+  return result;
 }
 
 # READ-CHAR - Pseudo-Function for Synonym-Streams:
@@ -1266,18 +1290,21 @@
 }
 
 # WRITE-BYTE-ARRAY - Pseudo-Function for Broadcast-Streams:
-local void wr_by_array_broad (const gcv_object_t* stream_, const gcv_object_t* bytearray_,
-                              uintL start, uintL len) {
+local uintL wr_by_array_broad (const gcv_object_t* stream_, const gcv_object_t* bytearray_,
+                              uintL start, uintL len, bool no_hang) {
   check_SP(); check_STACK();
   pushSTACK(TheStream(*stream_)->strm_broad_list); # list of streams
   var object streamlist;
+  /* what happens if different streams write different amounts?
+     no_hang not supported for broadcast streams *** */
   while (streamlist = STACK_0, consp(streamlist)) {
     STACK_0 = Cdr(streamlist);
     pushSTACK(Car(streamlist));
-    write_byte_array(&STACK_0,bytearray_,start,len);
+    write_byte_array(&STACK_0,bytearray_,start,len,0);
     skipSTACK(1);
   }
   skipSTACK(1);
+  return len;
 }
 
 # WRITE-CHAR - Pseudo-Function for Broadcast-Streams:
@@ -1688,13 +1715,15 @@
 }
 
 # WRITE-BYTE-ARRAY - Pseudo-Function for Two-Way- and Echo-Streams:
-local void wr_by_array_twoway (const gcv_object_t* stream_,
+local uintL wr_by_array_twoway (const gcv_object_t* stream_,
                                const gcv_object_t* bytearray_,
-                               uintL start, uintL len) {
+                               uintL start, uintL len, bool no_hang) {
+  int result;
   check_SP(); check_STACK();
   pushSTACK(TheStream(*stream_)->strm_twoway_output);
-  write_byte_array(&STACK_0,bytearray_,start,len);
+  result = write_byte_array(&STACK_0,bytearray_,start,len,no_hang);
   skipSTACK(1);
+  return result;
 }
 
 # WRITE-CHAR - Pseudo-Function for Two-Way- and Echo-Streams:
@@ -1936,7 +1965,8 @@
   pushSTACK(TheStream(*stream_)->strm_twoway_input);
   var uintL result = read_byte_array(&STACK_0,bytearray_,start,len,no_hang);
   STACK_0 = TheStream(*stream_)->strm_twoway_output;
-  write_byte_array(&STACK_0,bytearray_,start,result);
+  write_byte_array(&STACK_0,bytearray_,start,result,0);
+  /* *** no_hang not supported for echo streams */
   skipSTACK(1);
   return result;
 }
@@ -3460,7 +3490,7 @@
   bool ignore_next_LF : 8;             # true after reading a CR
   # Fields used for the output side only:
   void         (* low_write)         (object stream, uintB b);
-  const uintB* (* low_write_array)   (object stream, const uintB* byteptr, uintL len);
+  const uintB* (* low_write_array)   (object stream, const uintB* byteptr, uintL len, bool no_hang);
   void         (* low_finish_output) (object stream);
   void         (* low_force_output)  (object stream);
   void         (* low_clear_output)  (object stream);
@@ -5324,10 +5354,11 @@
 
 local const uintB* low_write_array_unbuffered_handle (object stream,
                                                       const uintB* byteptr,
-                                                      uintL len) {
+                                                      uintL len,
+						      bool no_hang) {
   var Handle handle = TheHandle(TheStream(stream)->strm_ochannel);
   begin_system_call();
-  var sintL result = full_write(handle,byteptr,len);
+  var sintL result = full_write(handle,byteptr,len,no_hang);
   if (result<0) { OS_error(); }
   end_system_call();
   if (!(result==(sintL)len)) # not successful?
@@ -5355,7 +5386,7 @@
 local void wr_by_aux_ia_unbuffered (object stream, uintL bitsize,
                                     uintL bytesize) {
   uintB* bitbufferptr = TheSbvector(TheStream(stream)->strm_bitbuffer)->data;
-  UnbufferedStreamLow_write_array(stream)(stream,bitbufferptr,bytesize);
+  UnbufferedStreamLow_write_array(stream)(stream,bitbufferptr,bytesize,0);
 }
 
 # WRITE-BYTE - Pseudo-Function for File-Streams of Integers, Type au :
@@ -5377,12 +5408,13 @@
 }
 
 # WRITE-BYTE-ARRAY - Pseudo-Function for Handle-Streams, Type au, bitsize = 8 :
-local void wr_by_array_iau8_unbuffered (const gcv_object_t* stream_,
+local uintL wr_by_array_iau8_unbuffered (const gcv_object_t* stream_,
                                         const gcv_object_t* bytearray_,
-                                        uintL start, uintL len) {
+                                        uintL start, uintL len, bool no_hang) {
   var object stream = *stream_;
   UnbufferedStreamLow_write_array(stream)
-    (stream,&TheSbvector(*bytearray_)->data[start],len);
+    (stream,&TheSbvector(*bytearray_)->data[start],len, no_hang);
+  return len;
 }
 
 # Character streams
@@ -5403,7 +5435,7 @@
   Encoding_wcstombs(encoding)
     (encoding,stream,&cptr,cptr+1,&bptr,&buf[max_bytes_per_chart]);
   ASSERT(cptr == &c+1);
-  UnbufferedStreamLow_write_array(stream)(stream,&buf[0],bptr-&buf[0]);
+  UnbufferedStreamLow_write_array(stream)(stream,&buf[0],bptr-&buf[0],0);
   #else
   UnbufferedStreamLow_write(stream)(stream,as_cint(c));
   #endif
@@ -5424,11 +5456,11 @@
   do {
     var uintB* bptr = &tmptmpbuf[0];
     Encoding_wcstombs(encoding)(encoding,stream,&charptr,endptr,&bptr,&tmptmpbuf[tmpbufsize*max_bytes_per_chart]);
-    UnbufferedStreamLow_write_array(stream)(stream,&tmptmpbuf[0],bptr-&tmptmpbuf[0]);
+    UnbufferedStreamLow_write_array(stream)(stream,&tmptmpbuf[0],bptr-&tmptmpbuf[0],0);
   } until (charptr == endptr);
   #undef tmpbufsize
   #else
-  var const chart* endptr = (const chart*)UnbufferedStreamLow_write_array(stream)(stream,(const uintB*)charptr,len);
+  var const chart* endptr = (const chart*)UnbufferedStreamLow_write_array(stream)(stream,(const uintB*)charptr,len,0);
   #endif
   wr_ss_lpos(stream,endptr,len); # update Line-Position
 }
@@ -5447,7 +5479,7 @@
   var uintB* bptr = &buf[0];
   Encoding_wcstombs(encoding)(encoding,stream,&cptr,cptr+1,&bptr,&buf[max_bytes_per_chart]);
   ASSERT(cptr == &c+1);
-  UnbufferedStreamLow_write_array(stream)(stream,&buf[0],bptr-&buf[0]);
+  UnbufferedStreamLow_write_array(stream)(stream,&buf[0],bptr-&buf[0],0);
   #else
   UnbufferedStreamLow_write(stream)(stream,as_cint(c));
   #endif
@@ -5486,9 +5518,9 @@
       var uintB* bptr = &tmptmpbuf[0];
       Encoding_wcstombs(encoding)(encoding,stream,&cptr,tmpptr,&bptr,&tmptmpbuf[tmpbufsize*max_bytes_per_chart]);
       ASSERT(cptr == tmpptr);
-      UnbufferedStreamLow_write_array(stream)(stream,&tmptmpbuf[0],bptr-&tmptmpbuf[0]);
+      UnbufferedStreamLow_write_array(stream)(stream,&tmptmpbuf[0],bptr-&tmptmpbuf[0],0);
       #else
-      UnbufferedStreamLow_write_array(stream)(stream,(const uintB*)tmpbuf,n);
+      UnbufferedStreamLow_write_array(stream)(stream,(const uintB*)tmpbuf,n,0);
       #endif
     }
     remaining -= n;
@@ -5517,10 +5549,10 @@
   var uintB* bptr = &buf[0];
   Encoding_wcstombs(encoding)(encoding,stream,&cptr,cp+n,&bptr,&buf[2*max_bytes_per_chart]);
   ASSERT(cptr == cp+n);
-  UnbufferedStreamLow_write_array(stream)(stream,&buf[0],bptr-&buf[0]);
+  UnbufferedStreamLow_write_array(stream)(stream,&buf[0],bptr-&buf[0],0);
   #else
   if (chareq(c,ascii(NL))) {
-    UnbufferedStreamLow_write_array(stream)(stream,(const uintB*)crlf,2);
+    UnbufferedStreamLow_write_array(stream)(stream,(const uintB*)crlf,2,0);
   } else {
     UnbufferedStreamLow_write(stream)(stream,as_cint(c));
   }
@@ -5562,9 +5594,9 @@
       var uintB* bptr = &tmptmpbuf[0];
       Encoding_wcstombs(encoding)(encoding,stream,&cptr,tmpptr,&bptr,&tmptmpbuf[2*tmpbufsize*max_bytes_per_chart]);
       ASSERT(cptr == tmpptr);
-      UnbufferedStreamLow_write_array(stream)(stream,&tmptmpbuf[0],bptr-&tmptmpbuf[0]);
+      UnbufferedStreamLow_write_array(stream)(stream,&tmptmpbuf[0],bptr-&tmptmpbuf[0],0);
       #else
-      UnbufferedStreamLow_write_array(stream)(stream,(const uintB*)tmpbuf,tmpptr-&tmpbuf[0]);
+      UnbufferedStreamLow_write_array(stream)(stream,(const uintB*)tmpbuf,tmpptr-&tmpbuf[0],0);
       #endif
     }
     remaining -= n;
@@ -5600,7 +5632,7 @@
     end_system_call();
     var uintL outcount = outptr-(char*)tmpbuf;
     if (outcount > 0) {
-      UnbufferedStreamLow_write_array(stream)(stream,&tmpbuf[0],outcount);
+      UnbufferedStreamLow_write_array(stream)(stream,&tmpbuf[0],outcount,0);
     }
     #undef tmpbufsize
   }
@@ -6002,7 +6034,7 @@
   var sintL result = # write Buffer
     full_write(TheHandle(BufferedStream_channel(stream)),
                BufferedStream_buffer_address(stream,0),
-               bufflen);
+               bufflen, 0);
   if (result==bufflen) { # everything written correctly
     end_system_call(); BufferedStream_modified(stream) = false;
   } else { # not everything written
@@ -6264,15 +6296,17 @@
 
 # UP: Writes an Array of Bytes to an (open) Byte-based
 # File-Stream.
-# write_byte_array_buffered(stream,byteptr,len)
+# write_byte_array_buffered(stream,byteptr,len,no_hang)
 # > stream : (open) Byte-based File-Stream.
 # > byteptr[0..len-1] : Bytes to be written.
 # > len : > 0
+# > no_hang : don't block
 # < result: &byteptr[len]
 # changed in stream: index, endvalid, buffstart
 local const uintB* write_byte_array_buffered (object stream,
                                               const uintB* byteptr,
-                                              uintL len) {
+                                              uintL len, bool no_hang) {
+  /* *** no_hang not yet supported here */
   var uintL remaining = len;
   var uintB* ptr;
   do { # still remaining>0 Bytes to be filed.
@@ -6609,7 +6643,7 @@
   Encoding_wcstombs(encoding)(encoding,stream,&cptr,cptr+1,&bptr,&buf[max_bytes_per_chart]);
   ASSERT(cptr == &c+1);
   var uintL buflen = bptr-&buf[0];
-  write_byte_array_buffered(stream,&buf[0],buflen);
+  write_byte_array_buffered(stream,&buf[0],buflen,0);
   # increment position
   BufferedStream_position(stream) += buflen;
  #else
@@ -6633,13 +6667,13 @@
     var uintB* bptr = &tmptmpbuf[0];
     Encoding_wcstombs(encoding)(encoding,stream,&charptr,endptr,&bptr,&tmptmpbuf[tmpbufsize*max_bytes_per_chart]);
     var uintL tmptmpbuflen = bptr-&tmptmpbuf[0];
-    write_byte_array_buffered(stream,&tmptmpbuf[0],tmptmpbuflen);
+    write_byte_array_buffered(stream,&tmptmpbuf[0],tmptmpbuflen,0);
     # increment position
     BufferedStream_position(stream) += tmptmpbuflen;
   } until (charptr == endptr);
   #undef tmpbufsize
  #else
-  write_byte_array_buffered(stream,(const uintB*)charptr,len);
+  write_byte_array_buffered(stream,(const uintB*)charptr,len,0);
   # increment position
   BufferedStream_position(stream) += len;
  #endif
@@ -6661,7 +6695,7 @@
   Encoding_wcstombs(encoding)(encoding,stream,&cptr,cptr+1,&bptr,&buf[max_bytes_per_chart]);
   ASSERT(cptr == &c+1);
   var uintL buflen = bptr-&buf[0];
-  write_byte_array_buffered(stream,&buf[0],buflen);
+  write_byte_array_buffered(stream,&buf[0],buflen,0);
   # increment position
   BufferedStream_position(stream) += buflen;
  #else
@@ -6701,7 +6735,7 @@
       Encoding_wcstombs(encoding)(encoding,stream,&cptr,tmpptr,&bptr,&tmptmpbuf[tmpbufsize*max_bytes_per_chart]);
       ASSERT(cptr == tmpptr);
       var uintL tmptmpbuflen = bptr-&tmptmpbuf[0];
-      write_byte_array_buffered(stream,&tmptmpbuf[0],tmptmpbuflen);
+      write_byte_array_buffered(stream,&tmptmpbuf[0],tmptmpbuflen,0);
       # increment position
       BufferedStream_position(stream) += tmptmpbuflen;
     }
@@ -6742,7 +6776,7 @@
   Encoding_wcstombs(encoding)(encoding,stream,&cptr,cp+n,&bptr,&buf[2*max_bytes_per_chart]);
   ASSERT(cptr == cp+n);
   var uintL buflen = bptr-&buf[0];
-  write_byte_array_buffered(stream,&buf[0],buflen);
+  write_byte_array_buffered(stream,&buf[0],buflen,0);
   # increment position
   BufferedStream_position(stream) += buflen;
  #else
@@ -6788,7 +6822,7 @@
       Encoding_wcstombs(encoding)(encoding,stream,&cptr,tmpptr,&bptr,&tmptmpbuf[2*tmpbufsize*max_bytes_per_chart]);
       ASSERT(cptr == tmpptr);
       var uintL tmptmpbuflen = bptr-&tmptmpbuf[0];
-      write_byte_array_buffered(stream,&tmptmpbuf[0],tmptmpbuflen);
+      write_byte_array_buffered(stream,&tmptmpbuf[0],tmptmpbuflen,0);
       # increment position
       BufferedStream_position(stream) += tmptmpbuflen;
     }
@@ -6837,7 +6871,7 @@
    end_system_call();
    var uintL outcount = outptr-(char*)tmpbuf;
    if (outcount > 0) {
-     write_byte_array_buffered(stream,&tmpbuf[0],outcount);
+     write_byte_array_buffered(stream,&tmpbuf[0],outcount,0);
      # increment position
      BufferedStream_position(stream) += outcount;
    }
@@ -7114,7 +7148,7 @@
     buffered_writebyte(stream,*bitbufferptr++);
   });
   #else
-  write_byte_array_buffered(stream,bitbufferptr,bytesize);
+  write_byte_array_buffered(stream,bitbufferptr,bytesize,0);
   #endif
   # increment position:
   BufferedStream_position(stream) += 1;
@@ -7230,12 +7264,14 @@
 }
 
 # WRITE-BYTE-SEQUENCE for File-Streams of Integers, Type au, bitsize = 8 :
-local void wr_by_array_iau8_buffered (const gcv_object_t* stream_,
+local uintL wr_by_array_iau8_buffered (const gcv_object_t* stream_,
                                       const gcv_object_t* bytearray_,
-                                      uintL start, uintL len) {
-  write_byte_array_buffered(*stream_,TheSbvector(*bytearray_)->data+start,len);
+                                      uintL start, uintL len, bool no_hang) {
+  /* no_hang not supported here *** */
+  write_byte_array_buffered(*stream_,TheSbvector(*bytearray_)->data+start,len,no_hang);
   # increment position:
   BufferedStream_position(*stream_) += len;
+  return len;
 }
 
 # File-Stream in general
@@ -13424,7 +13460,7 @@
   var sintL result = # flush Buffer
     full_write(TheHandle(BufferedStream_channel(stream)),
                BufferedStream_buffer_address(stream,0),
-               bufflen);
+               bufflen,0);
   writing_to_subprocess = false;
   if (result == bufflen) { # everything was written correctly
     end_system_call(); BufferedStream_modified(stream) = false;
@@ -13635,15 +13671,15 @@
     fehler_unwritable(TheSubr(subr_self)->name,stream);
 }
 
-local const uintB* low_write_array_unbuffered_pipe (object stream, const uintB* byteptr, uintL len) {
+local const uintB* low_write_array_unbuffered_pipe (object stream, const uintB* byteptr, uintL len, bool no_hang) {
   var Handle handle = TheHandle(TheStream(stream)->strm_ochannel);
   begin_system_call();
   writing_to_subprocess = true;
-  var sintL result = full_write(handle,byteptr,len);
+  var sintL result = full_write(handle,byteptr,len,no_hang);
   writing_to_subprocess = false;
   if (result<0) { OS_error(); }
   end_system_call();
-  if (!(result==(sintL)len)) # not successful?
+  if (!no_hang && !(result==(sintL)len)) # not successful?
     fehler_unwritable(TheSubr(subr_self)->name,stream);
   return byteptr+result;
 }
@@ -14273,15 +14309,15 @@
 local void low_write_unbuffered_socket (object stream, uintB b) {
   var SOCKET handle = TheSocket(TheStream(stream)->strm_ochannel);
   var int result;
-  SYSCALL(result,sock_write(handle,&b,1)); # Try to output the byte.
+  SYSCALL(result,sock_write(handle,&b,1,0)); # Try to output the byte.
   if (result==0) # not successful?
     fehler_unwritable(TheSubr(subr_self)->name,stream);
 }
 
-local const uintB* low_write_array_unbuffered_socket (object stream, const uintB* byteptr, uintL len) {
+local const uintB* low_write_array_unbuffered_socket (object stream, const uintB* byteptr, uintL len, bool no_hang) {
   var SOCKET handle = TheSocket(TheStream(stream)->strm_ochannel);
-  var int result; SYSCALL(result,sock_write(handle,byteptr,len));
-  if (result != (sintL)len) # not successful?
+  var int result; SYSCALL(result,sock_write(handle,byteptr,len,no_hang));
+  if (result < 0) # not successful? - formerly != (sintL)len
     fehler_unwritable(TheSubr(subr_self)->name,stream);
   return byteptr+result;
 }
@@ -14455,7 +14491,7 @@
   var uintL totalcount;
   test_n_bytes_args(&startindex,&totalcount);
   if (!(totalcount==0)) {
-    write_byte_array(&STACK_1,&STACK_0,startindex,totalcount);
+    write_byte_array(&STACK_1,&STACK_0,startindex,totalcount,0);
   }
   skipSTACK(2);
   VALUES1(T);
@@ -14507,7 +14543,7 @@
   var sintL result = # flush Buffer
     sock_write(TheSocket(BufferedStream_channel(stream)),
                BufferedStream_buffer_address(stream,0),
-               bufflen);
+               bufflen,0);
  #if defined(HAVE_SIGNALS) && defined(SIGPIPE)
   writing_to_subprocess = false;
  #endif
@@ -17440,7 +17476,7 @@
   if (endianness) /* byte swap */
     elt_nreverse(bitbuffer,0,bytesize);
   # Write the data.
-  write_byte_array(&STACK_3,&STACK_0,0,bytesize);
+  write_byte_array(&STACK_3,&STACK_0,0,bytesize,0);
   FREE_DYNAMIC_8BIT_VECTOR(STACK_0);
   VALUES1(STACK_4); /* return obj */
   skipSTACK(5);
@@ -17511,7 +17547,7 @@
   if (BIG_ENDIAN_P ? !endianness : endianness) /* byte swap */
     elt_nreverse(bitbuffer,0,bytesize);
   # Write the data.
-  write_byte_array(&STACK_3,&STACK_0,0,bytesize);
+  write_byte_array(&STACK_3,&STACK_0,0,bytesize,0);
   FREE_DYNAMIC_8BIT_VECTOR(STACK_0);
   VALUES1(STACK_4); /* return obj */
   skipSTACK(5);
diff -ur ./unix.d ../src/unix.d
--- ./unix.d	Wed Sep 17 16:48:06 2003
+++ ../src/unix.d	Wed Sep 17 13:56:56 2003
@@ -511,7 +511,7 @@
 extern RETRWTYPE read_helper (int fd, RW_BUF_T buf, RW_SIZE_T nbyte, bool partial_p);
 #define safe_read(f,b,n)  read_helper(f,b,n,true)
 #define full_read(f,b,n)  read_helper(f,b,n,false)
-extern RETRWTYPE full_write (int fd, WRITE_CONST RW_BUF_T buf, RW_SIZE_T nbyte);
+extern RETRWTYPE full_write (int fd, WRITE_CONST RW_BUF_T buf, RW_SIZE_T nbyte, bool no_hang);
 /* used by STREAM, PATHNAME, SPVW, MISC, UNIXAUX */
 
 /* inquire the terminal, window size: */
diff -ur ./unixaux.d ../src/unixaux.d
--- ./unixaux.d	Wed Sep 17 16:48:06 2003
+++ ../src/unixaux.d	Thu Sep 18 11:33:35 2003
@@ -286,11 +286,12 @@
 }
 
 # Ein Wrapper um die write-Funktion.
-  global RETRWTYPE full_write (int fd, WRITE_CONST RW_BUF_T bufarea, RW_SIZE_T nbyte);
-  global RETRWTYPE full_write (fd,bufarea,nbyte)
+  global RETRWTYPE full_write (int fd, WRITE_CONST RW_BUF_T bufarea, RW_SIZE_T nbyte, bool no_hang);
+  global RETRWTYPE full_write (fd,bufarea,nbyte,no_hang)
     var int fd;
     var WRITE_CONST RW_BUF_T bufarea;
     var RW_SIZE_T nbyte;
+    var bool no_hang;
     {
       var WRITE_CONST char* buf = (WRITE_CONST char*) bufarea;
       var RETRWTYPE retval;
@@ -299,18 +300,41 @@
       # Must adjust the memory permissions before calling write().
       handle_fault_range(PROT_READ,(aint)buf,(aint)buf+nbyte);
       #endif
-      until (nbyte==0) {
-        retval = write(fd,buf,nbyte);
-        if (retval == 0)
-          break;
-        elif (retval < 0) {
-          #ifdef EINTR
-          if (!(errno == EINTR))
-          #endif
-            return retval;
-        } else {
-          buf += retval; done += (RW_SIZE_T)retval; nbyte -= (RW_SIZE_T)retval;
-        }
+      {
+	var int fcntl_flags = 0;
+	if (no_hang){
+	  /* put it in nonblocking mode, (code stolen from stream.d) */
+	  if (( fcntl_flags = fcntl(fd,F_GETFL,0) )<0) {
+	    OS_error();
+	  }
+#ifdef O_NONBLOCK
+	  if ( fcntl(fd,F_SETFL,fcntl_flags|O_NONBLOCK) <0) {
+	    OS_error();
+	  }
+#else # older Unices called it O_NDELAY
+	  if ( fcntl(fd,F_SETFL,fcntl_flags|O_NDELAY) <0) {
+	    OS_error();
+	  }
+#endif
+	}
+	until (nbyte==0) {
+	  retval = write(fd,buf,nbyte);
+	  if (retval < 0) {
+	    if (no_hang && (errno == EAGAIN)) goto end;
+            #ifdef EINTR
+	    /* no way to interrupt a large write? *** */
+	    if (!(errno == EINTR))
+            #endif
+	      {done = retval; /* -1 */ goto end;}
+	  } else {
+	    buf += retval; done += (RW_SIZE_T)retval; nbyte -= (RW_SIZE_T)retval;
+	  }
+	}
+      end:
+
+	/* restore previous blocking mode */
+	if (no_hang)
+	  if ( fcntl(fd,F_SETFL,fcntl_flags) <0) { OS_error(); }
       }
       return done;
     }
@@ -350,9 +374,9 @@
       return done;
     }
 
-# A wrapper around the send() function.
-  global ssize_t sock_write (int fd, const void* bufarea, size_t nbyte);
-  global ssize_t sock_write (fd,bufarea,nbyte)
+# A wrapper around the send() function.  *** no_hang case totally untested !
+  global ssize_t sock_write (int fd, const void* bufarea, size_t nbyte, bool no_hang);
+  global ssize_t sock_write (fd,bufarea,nbyte,no_hang)
     var int fd;
     var const void* bufarea;
     var size_t nbyte;
@@ -364,18 +388,40 @@
       # Must adjust the memory permissions before calling send().
       handle_fault_range(PROT_READ,(aint)buf,(aint)buf+nbyte);
       #endif
-      until (nbyte==0) {
-        retval = send(fd,buf,nbyte,0);
-        if (retval == 0)
-          break;
-        elif (retval < 0) {
+      {
+	var int fcntl_flags;
+	if (no_hang){
+	  /* put it in nonblocking mode, (code stolen from stream.d) */
+	  if (( fcntl_flags = fcntl(fd,F_GETFL,0) )<0) {
+	    OS_error();
+	  }
+#ifdef O_NONBLOCK
+	  if ( fcntl(fd,F_SETFL,fcntl_flags|O_NONBLOCK) <0) {
+	    OS_error();
+	  }
+#else # older Unices called it O_NDELAY
+	  if ( fcntl(fd,F_SETFL,fcntl_flags|O_NDELAY) <0) {
+	    OS_error();
+	  }
+#endif
+	}
+	until (nbyte==0) {
+	  retval = send(fd,buf,nbyte,0);
+	  if (retval < 0) {
+	    if (errno == EWOULDBLOCK) goto end;
           #ifdef EINTR
-          if (!(errno == EINTR))
+	    if (!(errno == EINTR))
           #endif
-            return retval;
-        } else {
-          buf += retval; done += retval; nbyte -= retval;
-        }
+	      {done = retval; goto end;}
+	  } else {
+	    buf += retval; done += retval; nbyte -= retval;
+	  }
+	}
+      end:
+
+	/* restore previous blocking mode */
+	if (no_hang)
+	  if ( fcntl(fd,F_SETFL,fcntl_flags) <0) { OS_error(); }
       }
       return done;
     }

---

From: Sam Steingold <[email-masked]>
Date: Wed Sep 24 13:49:14 2003

> * Don Cohen <[email-masked]> [2003-09-18 16:36:46 -0700]:
>

"make check-sources" in your build directory should give you a tip.
read <http://clisp.cons.org/impnotes/extend.html#add-fun>.
if you still have a problem, please do not hesitate to ask again!

> +++ ../src/genclisph.d	Thu Sep 18 12:32:57 2003

please work against the CVS head.

> +	  if ( fcntl(fd,F_SETFL,fcntl_flags|O_NDELAY) <0) {

please try to indent CPP directives like it is done in the CLISP code.

--
Sam Steingold (http://www.podval.org/~sds) running w2k
<http://www.camera.org> <http://www.iris.org.il> <http://www.memri.org/>
<http://www.mideasttruth.com/> <http://www.honestreporting.com>
You think Oedipus had a problem -- Adam was Eve's mother.