[closure-devel] Openmcl patches
John Q Splittist
splittist at yahoo.com
Thu Aug 25 16:47:39 CEST 2005
Attached are a patch and a dep file to get closure working on OpenMCL.
Well, it worked for me.
JQS
-------------- next part --------------
? resources/.cvsignore
? src/.cvsignore
? src/css/.cvsignore
? src/glisp/.cvsignore
? src/glisp/dep-openmcl.lisp
? src/gui/.cvsignore
? src/html/.cvsignore
? src/imagelib/.cvsignore
? src/net/.cvsignore
? src/parse/.cvsignore
? src/patches/.cvsignore
? src/protocols/.cvsignore
? src/renderer/.cvsignore
? src/util/.cvsignore
? src/xml/.cvsignore
cvs server: Diffing .
Index: closure.asd
===================================================================
RCS file: /project/closure/cvsroot/closure/closure.asd,v
retrieving revision 1.5
diff -u -r1.5 closure.asd
--- closure.asd 13 Jun 2005 10:14:22 -0000 1.5
+++ closure.asd 25 Aug 2005 14:42:17 -0000
@@ -70,7 +70,8 @@
#+(AND ALLEGRO ALLEGRO-V5.0) "dep-acl5"
#+(AND ALLEGRO (NOT ALLEGRO-V5.0)) "dep-acl"
#+GCL "dep-gcl"
- #-(OR sbcl CLISP CMU ALLEGRO GCL) #.(error "Configure!"))
+ #+OPENMCL "dep-openmcl"
+ #-(OR sbcl CLISP CMU ALLEGRO GCL OPENMCL) #.(error "Configure!"))
(:file "package"
:depends-on (dependent))
(:file "runes"
cvs server: Diffing resources
cvs server: Diffing resources/css
cvs server: Diffing resources/dtd
cvs server: Diffing resources/encodings
cvs server: Diffing resources/encodings/apple
cvs server: Diffing resources/icons
cvs server: Diffing resources/patterns
cvs server: Diffing src
cvs server: Diffing src/css
cvs server: Diffing src/glisp
Index: src/glisp/gendep.lisp
===================================================================
RCS file: /project/closure/cvsroot/closure/src/glisp/gendep.lisp,v
retrieving revision 1.2
diff -u -r1.2 gendep.lisp
--- src/glisp/gendep.lisp 13 Mar 2005 18:01:15 -0000 1.2
+++ src/glisp/gendep.lisp 25 Aug 2005 14:42:17 -0000
@@ -337,7 +337,8 @@
#+(AND ALLEGRO ALLEGRO-V5.0) "acl5"
#+(AND ALLEGRO (NOT ALLEGRO-V5.0)) "acl"
#+GCL "gcl"
- #-(OR CLISP CMU ALLEGRO GCL)
+ #+OPENMCL "openmcl"
+ #-(OR CLISP CMU ALLEGRO GCL OPENMCL)
#.(error "Configure!"))
;; all symbols, which are defined by gray streams
@@ -379,6 +380,7 @@
#+:CMU '(:ext)
#+:ALLEGRO '(:excl)
#+:HARLEQUIN-COMMON-LISP '(:stream)
+ #+:OPENMCL '(:ccl)
)
(defun seek-symbol (name packages)
cvs server: Diffing src/gui
Index: src/gui/clim-gui.lisp
===================================================================
RCS file: /project/closure/cvsroot/closure/src/gui/clim-gui.lisp,v
retrieving revision 1.20
diff -u -r1.20 clim-gui.lisp
--- src/gui/clim-gui.lisp 11 Jul 2005 15:58:03 -0000 1.20
+++ src/gui/clim-gui.lisp 25 Aug 2005 14:42:22 -0000
@@ -423,12 +423,6 @@
(defun send-closure-command (command &rest args)
(ensure-closure)
-
- #+openmcl
- (with-closure ()
- (glisp::process-interrupt *closure-process*
- #'(lambda () (apply command args))))
- #-openmcl
(with-closure ()
(clim-sys:process-interrupt *closure-process*
#'(lambda () (apply command args)))))
cvs server: Diffing src/html
cvs server: Diffing src/imagelib
cvs server: Diffing src/net
cvs server: Diffing src/parse
cvs server: Diffing src/patches
Index: src/patches/clx-patch.lisp
===================================================================
RCS file: /project/closure/cvsroot/closure/src/patches/clx-patch.lisp,v
retrieving revision 1.4
diff -u -r1.4 clx-patch.lisp
--- src/patches/clx-patch.lisp 13 Mar 2005 18:02:58 -0000 1.4
+++ src/patches/clx-patch.lisp 25 Aug 2005 14:42:23 -0000
@@ -167,7 +167,7 @@
(get-host-name))
;;; GET-BEST-AUTHORIZATION
-
+ #-openmcl
(defun get-best-authorization (host display protocol)
(labels ((read-short (stream &optional (eof-errorp t))
(let ((high-byte (read-byte stream eof-errorp nil)))
cvs server: Diffing src/protocols
cvs server: Diffing src/renderer
cvs server: Diffing src/util
cvs server: Diffing src/xml
cvs server: Diffing src/xml/sax-tests
-------------- next part --------------
;;; -*- Mode: Lisp; Syntax: Common-Lisp; Package: CL-USER; -*-
;;; ---------------------------------------------------------------------------
;;; Title: OpenMCL dependent stuff + fixups
;;; Created: 2005-08-25 11:50
;;; Author:
;;; License: MIT style (see below)
;;; ---------------------------------------------------------------------------
;;; (c) copyright 1999 by Gilbert Baumann
;;; Permission is hereby granted, free of charge, to any person obtaining
;;; a copy of this software and associated documentation files (the
;;; "Software"), to deal in the Software without restriction, including
;;; without limitation the rights to use, copy, modify, merge, publish,
;;; distribute, sublicense, and/or sell copies of the Software, and to
;;; permit persons to whom the Software is furnished to do so, subject to
;;; the following conditions:
;;;
;;; The above copyright notice and this permission notice shall be
;;; included in all copies or substantial portions of the Software.
;;;
;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
;;; IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY
;;; CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,
;;; TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
;;; SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
(export 'glisp::read-byte-sequence :glisp)
(export 'glisp::read-char-sequence :glisp)
(export 'glisp::run-unix-shell-command :glisp)
(export 'glisp::getenv :glisp)
(export 'glisp::make-server-socket :glisp)
(export 'glisp::close-server-socket :glisp)
(defun glisp::read-byte-sequence (&rest ap)
(apply #'read-sequence ap))
(defun glisp::read-char-sequence (&rest ap)
(apply #'read-sequence ap))
(defmacro glisp::with-timeout ((&rest options) &body body)
(declare (ignore options))
`(progn
, at body))
(defun glisp::open-inet-socket (hostname port)
(values
(ccl::make-socket :address-family :internet
:type :stream
:remote-host hostname
:remote-port port)
:byte))
(defstruct (server-socket (:constructor make-server-socket-struct))
fd
element-type
port)
#||
(defun glisp::make-server-socket (port &key (element-type '(unsigned-byte 8)))
(make-server-socket-struct :fd (ext:create-inet-listener port)
:element-type element-type
:port port))
(defun glisp::accept-connection/low (socket)
(mp:process-wait-until-fd-usable (server-socket-fd socket) :input)
(values
(sys:make-fd-stream (ext:accept-tcp-connection (server-socket-fd socket))
:input t :output t
:element-type (server-socket-element-type socket))
(cond ((subtypep (server-socket-element-type socket) 'integer)
:byte)
(t
:char))))
(defun glisp::close-server-socket (socket)
(unix:unix-close (server-socket-fd socket)))
||#
;;;;;;
(defun glisp::g/make-string (length &rest options)
(apply #'make-array length :element-type 'base-char options))
(defun glisp::run-unix-shell-command (command)
(nth-value 1 (ccl:external-process-status
(ccl:run-program "/bin/sh" (list "-c" command) :wait t :input nil
:output nil))))
(defmacro glisp::defsubst (name args &body body)
`(progn
(declaim (inline ,name))
(defun ,name ,args .,body)))
;;; MP
(export 'glisp::mp/process-yield :glisp)
(export 'glisp::mp/process-wait :glisp)
(export 'glisp::mp/process-run-function :glisp)
(export 'glisp::mp/make-lock :glisp)
(export 'glisp::mp/current-process :glisp)
(export 'glisp::mp/process-kill :glisp)
(defun glisp::mp/make-lock (&key name)
(clim-sys::make-lock name))
(defmacro glisp::mp/with-lock ((lock) &body body)
`(clim-sys:with-lock-held (,lock)
, at body))
(defun glisp::mp/process-yield (&optional process-to-run)
(declare (ignore process-to-run))
(clim-sys:process-yield))
(defun glisp::mp/process-wait (whostate predicate)
(clim-sys:process-wait whostate predicate))
(defun glisp::mp/process-run-function (name fun &rest args)
(clim-sys:make-process
(lambda ()
(apply fun args))
:name name))
(defun glisp::mp/current-process ()
(clim-sys:current-process))
(defun glisp::mp/process-kill (process)
(clim-sys:destroy-process process))
(defun glisp::getenv (string)
(ccl::getenv string))
More information about the closure-devel
mailing list