Re: [Ecls-list] Building CLX on i386?

Index: dependent.lisp
===================================================================
RCS file: /cvsroot/clocc/clocc/src/gui/clx/dependent.lisp,v
retrieving revision 1.9
diff -u -r1.9 dependent.lisp
--- dependent.lisp	28 Feb 2003 20:27:55 -0000	1.9
+++ dependent.lisp	25 Mar 2004 08:51:16 -0000
@@ -19,7 +19,7 @@
 ;;;
 #+cmu
 (ext:file-comment
- "$Header: /cvsroot/clocc/clocc/src/gui/clx/dependent.lisp,v 1.9 2003/02/28 20:27:55 pvaneynd Exp $")
+ "$Header$")
 
 (in-package :xlib)
 
@@ -472,7 +472,7 @@
 ;;; MAKE-PROCESS-LOCK: Creating a process lock.
 
 (defun make-process-lock (name)
-  #-(or sbcl clisp)
+  #-(or sbcl clisp ecl)
   (port::make-lock :name name))
 
 
@@ -486,6 +486,9 @@
 			      &key timeout)
 			&body body)
   (declare (ignore display whostate timeout))
+  #+ecl
+  `(progn ,@body)
+  #-ecl
   `(port:with-lock (,lock)
      ,@body))
 
@@ -508,6 +511,7 @@
 
 (defun process-block (whostate predicate &rest predicate-args)
   (declare (type function predicate))
+  #-ecl
   (apply #'port:process-wait
          whostate
          predicate
@@ -521,7 +525,7 @@
 
 (defun process-wakeup (process)
   (declare (ignore process))
-  #-(or clisp sbcl)
+  #-(or clisp sbcl ecl)
   (port:process-yield))
 
 ;;; CURRENT-PROCESS: Return the current process object for input locking and
@@ -532,7 +536,7 @@
 ;;; Default return NIL, which is acceptable even if there is a scheduler.
 
 (defun current-process ()
-  #-(or sbcl clisp)
+  #-(or sbcl clisp ecl)
   (port:current-process))
 
 ;;; WITHOUT-INTERRUPTS -- provide for atomic operations.
@@ -602,18 +606,26 @@
              ;;
              ;; clisp doesn't have sockets, but special code for
              ;; X connections:
-             #-clisp
+             #-(or clisp ecl)
              (port::open-unix-socket (format nil
                                              "~A~D"
                                              *X-unix-socket-path*+
                                              display)
                                      :kind :stream
                                      :bin t)
+	     #+ecl
+	     (sys::open-unix-socket-stream (format nil
+						   "~A~D"
+						   *X-unix-socket-path*+
+						   display))
              ;; clisp doesn't have this...
              #+clisp
              (sys::make-socket-stream "" 0)))))
     (if socket
         socket
+	#+ecl
+	(si::open-client-stream host (+ 6000 display))
+	#-ecl
         ;; try to connect by hand
         (let ((host (host-address host)))
           (when host
@@ -703,12 +715,12 @@
     (cond ((null stream))
 	  ((listen stream) nil)
 	  ((eql timeout 0) :timeout)
-          #-(or allegro clisp)
+          #-(or allegro clisp ecl)
 	  (t
 	   (if (port::wait-for-stream stream timeout)
 	       nil
 	       :timeout))
-          #+(or allegro clisp)
+          #+(or allegro clisp ecl)
           ((not (null timeout))
            (multiple-value-bind (npoll fraction)
                (truncate timeout *buffer-read-polling-time*)
@@ -911,7 +923,16 @@
 	     (error "Unknown host ~S" host))
 	   (no-address-error ()
 	     (error "Host ~S has no ~S address" host family)))
-    
+    #+ecl
+    (let ((addr (first (nth-value 3 (si::lookup-host-entry (string host))))))
+      (unless addr
+	(no-host-error))
+      (list :internet
+	    (ldb (byte 8 24) addr)
+	    (ldb (byte 8 16) addr)
+	    (ldb (byte 8  8) addr)
+	    (ldb (byte 8  0) addr)))
+    #-ecl    
     (let ((hostent (port:resolve-host-ipaddr (string host))))
       (when (not (port:hostent-addr-list hostent))
 	(no-host-error))
@@ -961,7 +982,7 @@
 ;;; Utilities 
 
 (defun getenv (name)
-  (port:getenv name))
+  (#-ecl port:getenv #+ecl si:getenv name))
 
 (defun get-host-name ()
   "Return the same hostname as gethostname(3) would"
@@ -970,10 +991,11 @@
   #+(or cmu sbcl) (machine-instance)
   ;; resources-pathname was using short-site-name for this purpose
   #+excl (short-site-name)
-  #-(or excl cmu sbcl) (error "get-host-name not implemented"))
+  #+ecl (si::getenv "HOST")
+  #-(or excl cmu sbcl ecl) (error "get-host-name not implemented"))
 
 (defun homedir-file-pathname (name)
-  (and #-(or unix mach) (search "Unix" (software-type) :test #'char-equal)
+  (and #-(or unix mach ecl) (search "Unix" (software-type) :test #'char-equal)
        (merge-pathnames
         (translate-logical-pathname
          (user-homedir-pathname))