Re: [clisp-list] READ-BYTE-ARRAY now accepts :NO-HANG keyword argument

[Michael K. <kr...@co...>]

Moin Sam Steingold,

> There have been quite a few requests for read(2) interface.
> It is now available in the CVS head.

  thats a reason to stay up, even if i just came back from the pub.
  i needed the following straight forward patch (dont know why its
  missing in cvs current) to compile it :

cvs server: Diffing .
Index: lispbibl.d
===================================================================
RCS file: /cvsroot/clisp/clisp/src/lispbibl.d,v
retrieving revision 1.346
diff -c -r1.346 lispbibl.d
*** lispbibl.d  23 Jan 2003 22:39:30 -0000      1.346
--- lispbibl.d  25 Jan 2003 01:42:31 -0000
***************
*** 12617,12623 ****
  # > uintL len: length of byte sequence to be filled
  # < uintL result: number of bytes that have been filled
  # can trigger GC
! extern uintL read_byte_array (const gcv_object_t* stream_, const gcv_object_t* bytearray_, uintL start, uintL len);
  # is used by SEQUENCE
  
  # Function: Writes several bytes to a stream.
--- 12617,12625 ----
  # > uintL len: length of byte sequence to be filled
  # < uintL result: number of bytes that have been filled
  # can trigger GC
! extern uintL read_byte_array (const gcv_object_t* stream_,
!                               const gcv_object_t* bytearray_,
!                               uintL start, uintL len, bool no_hang);
  # is used by SEQUENCE
  
  # Function: Writes several bytes to a stream.

  and receive the following result on 'make check' installed it anyway,
  as this test did'nt looked like-my-bag ;-)

Test failed:
-rw-r--r--    1 kraehe   staff         571 Jan 25 03:01 strings.erg
To see which tests failed, type
    cat /home/kraehe/AIlang/clisp-cvs/clisp/src/suite/*.erg
make[1]: *** [compare] Error 1
make[1]: Leaving directory
`/bakunin/home/kraehe/AIlang/clisp-cvs/clisp/src/suite'
make: *** [testsuite] Error 2
bakunin:~/AIlang/clisp-cvs/clisp/src $ cat
/home/kraehe/AIlang/clisp-cvs/clisp/src/suite/*.erg

Form: (LET ((S (MAKE-ARRAY 10 :ELEMENT-TYPE 'CHARACTER :INITIAL-ELEMENT
#\a))) (LIST (MULTIPLE-VALUE-LIST (SYSTEM::STRING-INFO S)) (PROGN (SETF
(AREF S 3) (CODE-CHAR 12345)) (MULTIPLE-VALUE-LIST (SYSTEM::STRING-INFO
S))) (PROGN (GC) (MULTIPLE-VALUE-LIST (SYSTEM::STRING-INFO S))) (PROGN
(SETF (AREF S 3) (CODE-CHAR 123456)) (MULTIPLE-VALUE-LIST
(SYSTEM::STRING-INFO S))) (PROGN (GC) (MULTIPLE-VALUE-LIST
(SYSTEM::STRING-INFO S)))))
CORRECT: ((8 NIL NIL) (16 NIL T) (16 NIL NIL) (32 NIL T) (32 NIL NIL))
CLISP  : ((8 NIL NIL) (16 NIL T) (16 NIL T) (32 NIL T) (32 NIL T))
bakunin:~/AIlang/clisp-cvs/clisp/src $ 

> when you call READ-BYTE-ARRAY with :NO-HANG T and the sequence being a
> (VECTOR (UNSIGNED-BYTE 8)), it performs at most one read(2) call and
> returns whatever is available:

  *cheer* this solved the read half of the problem
  *scratch* but not the eof half of the problem

    (defun mucl-test ()
      (format t "waiting for connect~%")
      (unless serv (setq serv (socket-server 5555)))
      (setq sock (socket-accept serv :element-type '(unsigned-byte 8)))
      (setq buff (make-array 256 :element-type '(unsigned-byte 8)))
      (format t "waiting for input~%")
      (dotimes (n 1000)
        (setq stat (socket-status (list serv (cons sock :input)) 0 500000))
        (format t "Status ~A~%" stat)
        (when (eq (cadr stat) :INPUT)
          (setq flag (read-byte-sequence buff sock :no-hang t))
          (format t "Line: (~A) Flag:(~A)~%" buff flag)
          (when (<= flag 0) (return)) )))

  this function works in so far, as now each read-byte-sequence
  is reading exactly the bytes that are there. Normal select()/read()
  polling would give a final select() condition with read()<=0,
  when the client closes its connection. Exactly this condition
  got lost somewhere. I think there must be some select() somewhere,
  that is silently called with the socket. But i walked the code down
  to read_helper in unixaux.d, and i was'nt able to see a select() that
  comes after the read() - so i'm clueless and tired now.

  a virtual beer,

    '~~~~~~~~~~`
    |          |
    |~~~~~~~~~~|
    |  .       |
    |     *    |
    |  .    *  |
    |  Beck's  |
    |    *     |
    \   .      /
    /     .    \
    |__________|

Bye Michael
-- 
  mailto:kr...@co...             UNA:+.? 'CED+2+:::Linux:2.4.18'UNZ+1'
  http://www.xml-edifact.org/           CETERUM CENSEO WINDOWS ESSE DELENDAM