Permalink
Browse files

see ChangeLog for Wed Oct 01 17:56:10 1997 Tom McClure <tomj@falcon>

  • Loading branch information...
1 parent 3a11e3a commit 27931a09bd67dcdfdc5bc5543bac955b9809465f tomj committed Oct 2, 1997
Showing with 97 additions and 17 deletions.
  1. +6 −0 ChangeLog
  2. +17 −1 README
  3. +31 −11 dependent.cl
  4. +14 −5 excldep.cl
  5. +29 −0 makeclx.cl
View
@@ -1,3 +1,9 @@
+Wed Oct 01 17:56:10 1997 Tom McClure <tomj@falcon>
+
+ * new file makeclx.cl to build on NT
+ * new instructions in README for building on NT
+
+*******************************************************************************
Wed May 14 21:56:57 1997 Kevin Layer <layer@ultra>
* Makefile: fixes for ACL 5
View
18 README
@@ -1,6 +1,8 @@
This file contains instructions on how to make CLX work with Franz
Allegro Common Lisp. CLX should work on any machine that supports
-ACL version 3.1.10 or greater.
+ACL version 3.1.10 or greater. For running on Windows NT with X display
+software such as Hummingbird's Exceed or StarNet's XWin32, skip to the
+bottom.
******************************************************************************
NOTE: Normally you will not need to follow the instructions in this file.
@@ -66,3 +68,17 @@ Please report Franz specific CLX bugs to:
bugs@Franz.COM
or
ucbvax!franz!bugs
+
+
+
+Building and running on Windows NT
+
+(1) With ACL 4.3.2 or later, :cd to the directory containing the clx
+sources.
+
+(2) :ld makeclx.cl - this should create winclx.fasl in that
+directory. Feel free to move winclx.fasl to a convenient location.
+
+(3) In a fresh lisp, :ld winclx.fasl. You should now be able to
+open your display, assuming your X display software is running and
+tcp/ip is installed, with: (xlib:open-display "localhost")
View
@@ -1290,7 +1290,17 @@
stream
(error "Cannot connect to server: ~A:~D" host display))))
-#+excl
+#+(and excl mswindows)
+(defun open-x-stream (host display protocol)
+ (declare (ignore protocol)) ;; assume TCP
+ (let ((stream (socket:make-socket :remote-host (string host)
+ :remote-port (+ *x-tcp-port* display)
+ :format :binary)))
+ (if (streamp stream)
+ stream
+ (error "Cannot connect to server: ~A:~D" host display))))
+
+#+(and excl (not mswindows))
;;
;; Note that since we don't use the CL i/o facilities to do i/o, the display
;; input and output "stream" is really a file descriptor (fixnum).
@@ -1346,7 +1356,7 @@
(let* ((howmany (- end start))
(fd (display-input-stream display)))
(declare (type array-index howmany)
- (fixnum fd))
+ #-mswindows (fixnum fd))
(or (cond ((fd-char-avail-p fd) nil)
((eql timeout 0) :timeout)
@@ -1457,6 +1467,11 @@
(type display display)
(type array-index start end))
#.(declare-buffun)
+ #+mswindows
+ (let ((stream (display-output-stream display)))
+ (unless (null stream)
+ (stream:stream-write-sequence stream vector start end)))
+ #-mswindows
(excl::filesys-write-bytes (display-output-stream display) vector start
(- end start)
display))
@@ -1519,12 +1534,12 @@
;;; buffer-force-output-default - force output to the X stream
-#+excl
+#+(and excl (not mswindows))
(defun buffer-force-output-default (display)
;; buffer-write-default does the actual writing.
(declare (ignore display)))
-#-excl
+#-(and excl (not mswindows))
(defun buffer-force-output-default (display)
;; The default buffer force-output function for use with common-lisp streams
(declare (type display display))
@@ -1535,15 +1550,15 @@
;;; BUFFER-CLOSE-DEFAULT - close the X stream
-#+excl
+#+(and excl (not mswindows))
(defun buffer-close-default (display &key abort)
;; The default buffer close function for use with common-lisp streams
(declare (type display display)
(ignore abort))
#.(declare-buffun)
(excl::filesys-checking-close (display-output-stream display)))
-#-excl
+#-(and excl (not mswindows))
(defun buffer-close-default (display &key abort)
;; The default buffer close function for use with common-lisp streams
(declare (type display display))
@@ -1643,8 +1658,9 @@
(type (or null number) timeout))
(declare (values timeout))
(let ((fd (display-input-stream display)))
- (declare (fixnum fd))
- (when (>= fd 0)
+ #-mswindows (declare (fixnum fd))
+ (when #-mswindows (>= fd 0)
+ #+mswindows (streamp fd)
(cond ((fd-char-avail-p fd)
nil)
@@ -1669,6 +1685,9 @@
;; to block until input is available. Note we don't really handle
;; the interaction of interrupts and (numberp timeout) here. XX
(t
+ #+mswindows
+ (error "scheduler must be running to use CLX on MS Windows")
+ #-mswindows
(let ((res 0))
(declare (fixnum res))
(with-interrupt-checking-on
@@ -1711,7 +1730,7 @@
;;; buffer. This should never block, so it can be called from the scheduler.
;;; The default implementation is to just use listen.
-#-excl
+#-(and excl (not mswindows))
(defun buffer-listen-default (display)
(declare (type display display))
(let ((stream (display-input-stream display)))
@@ -1720,7 +1739,7 @@
t
(listen stream))))
-#+excl
+#+(and excl (not mswindows))
(defun buffer-listen-default (display)
(declare (type display display))
(let ((fd (display-input-stream display)))
@@ -2537,7 +2556,8 @@
#+excl
(defmacro with-underlying-simple-vector
((variable element-type pixarray) &body body)
- `(let ((,variable (cdr (excl::ah_data ,pixarray))))
+ `(let ((,variable (cdr (#+mswindows excl::ah-data
+ #-mswindows excl::ah_data ,pixarray))))
(declare (type (simple-array ,element-type (*)) ,variable))
,@body))
View
@@ -16,7 +16,7 @@
(in-package :xlib)
(eval-when (compile load eval)
- (require :foreign)
+ #-mswindows (require :foreign)
(require :process) ; Needed even if scheduler is not
; running. (Must be able to make
; a process-lock.)
@@ -55,18 +55,22 @@
;; Return t if there is a character available for reading or on error,
;; otherwise return nil.
-#-(version>= 4 2)
+#-(or (version>= 4 2) mswindows)
(defun fd-char-avail-p (fd)
(multiple-value-bind (available-p errcode)
(comp::.primcall-sargs 'sys::filesys #.excl::fs-char-avail fd)
(excl:if* errcode
then t
else available-p)))
-#+(version>= 4 2)
+#+(and (version>= 4 2) (not mswindows))
(defun fd-char-avail-p (fd)
(excl::filesys-character-available-p fd))
+#+mswindows
+(defun fd-char-avail-p (socket-stream)
+ (listen socket-stream))
+
(defmacro with-interrupt-checking-on (&body body)
`(locally (declare (optimize (safety 1)))
,@body))
@@ -75,7 +79,7 @@
;; Start storing at index 'start-index' and read exactly 'length' bytes.
;; Return t if an error or eof occurred, nil otherwise.
(defun fd-read-bytes (fd vector start-index length)
- (declare (fixnum fd start-index length)
+ (declare (fixnum #-mswindows fd start-index length)
(type (simple-array (unsigned-byte 8) (*)) vector))
(with-interrupt-checking-on
(do ((rest length))
@@ -86,7 +90,9 @@
(comp::.primcall-sargs 'sys::filesys #.excl::fs-read-bytes fd vector
start-index rest)
#+(version>= 4 2)
- (excl::fill-read-buffer fd vector start-index rest)
+ (excl::fill-read-buffer #-mswindows fd
+ #+mswindows (excl::stream-input-fn fd)
+ vector start-index rest)
(declare (fixnum numread))
(excl:if* errcode
then (if (not (eq errcode
@@ -97,18 +103,21 @@
else (decf rest numread)
(incf start-index numread))))))
+#-mswindows
(unless (ff:get-entry-point (ff:convert-to-lang "fd_wait_for_input"))
(ff:remove-entry-point (ff:convert-to-lang "fd_wait_for_input"))
#+dlfcn (load "clx:excldep.so")
#+dlhp (load "clx:excldep.sl")
#-dynload (load "clx:excldep.o"))
+#-mswindows
(unless (ff:get-entry-point (ff:convert-to-lang "connect_to_server"))
(ff:remove-entry-point (ff:convert-to-lang "connect_to_server" :language :c))
#+dlfcn (load "clx:socket.so")
#+dlhp (load "clx:socket.sl")
#-dynload (load "clx:socket.o"))
+#-mswindows
(ff:defforeign-list `((connect-to-server
:entry-point
,(ff:convert-to-lang "connect_to_server")
View
@@ -0,0 +1,29 @@
+(in-package :user)
+
+(pushnew :clx-ansi-common-lisp *features*)
+(load "defsystem")
+(load "package")
+(setq xlib::*def-clx-class-use-defclass* t)
+(let ((*compile-verbose* t)
+ (*compile-print* nil))
+ (compile-system :clx)
+ (compile-system :clx-debug))
+
+;; how to concatenate the fasls?
+(let ((fasls '("package" "excldep" "depdefs" "clx" "dependent"
+ "exclcmac" "buffer" "display" "gcontext"
+ "requests" "input" "fonts" "graphics" "text"
+ "attributes" "translate" "keysyms" "manager"
+ "image" "resource")))
+ (with-open-file (bigfasl "clxwin.fasl"
+ :element-type '(unsigned-byte 8)
+ :direction :output
+ :if-exists :error :if-does-not-exist :create)
+ (let ((buf (make-array 2048 :element-type '(unsigned-byte 8))))
+ (dolist (file-to-cat fasls)
+ (let ((faslname (concatenate 'string file-to-cat ".fasl")))
+ (with-open-file (in faslname :element-type '(unsigned-byte 8))
+ (loop as x = (read-sequence buf in)
+ until (= x 0)
+ do (write-sequence buf bigfasl :end x))))))
+ bigfasl))

0 comments on commit 27931a0

Please sign in to comment.