Changeset 15367 for trunk/abcl/contrib/abcl-introspect/util.lisp

Timestamp:

08/13/20 19:24:25 (3 years ago)

Author:

Mark Evenson

Message:

abcl-introspect: EXT:STREAM-UNIX-FD returns integer file descriptor

The integer can be passed meaningfully by passed to syscalls like
fdopen().

TODO: implement in the core application, current strategy needs JSS to

reliably finad access private member fields

File:

• trunk/abcl/contrib/abcl-introspect/util.lisp (modified) (1 diff)

trunk/abcl/contrib/abcl-introspect/util.lisp

@@ -22 +22 @@
       (java:jnew-array-from-array "byte" array))))
   
-  
 (export '(write-class
           read-class)
         :extensions)
 
+;;;  Determining the underlying unix file descriptor depends on
+;;;  navigating private member structures dependent on the hosting
+;;;  JVMs wrapping of native socket. The JAVA package currently does
+;;;  not have a means for such aggressive intropsection, so we add it
+;;;  as a utility here
+;;;
+;;;  TODO test under :msdog
+;;;  TODO Should be in socket.lisp
+(defun stream-unix-fd (stream)
+  "Return the integer of the underlying unix file descriptor for STREAM
+
+Added by ABCL-INTROSPECT."
+  (check-type stream 'system::socket-stream)
+  (flet ((get-java-fields (object fields) ;; Thanks to Cyrus Harmon
+           (reduce (lambda (x y)
+                     (jss:get-java-field x y t))
+                          fields
+                          :initial-value object))
+                (jvm-version ()
+                  (read
+                   (make-string-input-stream
+                    (java:jstatic "getProperty" "java.lang.System"
+                                  "java.specification.version")))))
+           (ignore-errors
+            (get-java-fields (java:jcall "getWrappedInputStream"  ;; TODO: define this as a constant
+                                         (two-way-stream-input-stream stream))
+                             (if (< (jvm-version) 14)
+                                 '("in" "ch" "fdVal")
+                                 '("in" "this$0" "sc" "fd" "fd"))))))
+
+(export '(stream-unix-fd) :extensions)