From 301838f48dcc7aa414a6cd04c6570f4fed42479e Mon Sep 17 00:00:00 2001 From: rtoy <rtoy> Date: Wed, 9 Sep 2009 15:51:28 +0000 Subject: [PATCH] Merge changes from 20a-pre1 (tag release-20a-pre1) to trunk. --- bootfiles/19f/boot-20a.lisp | 67 +++++++++++++ code/array.lisp | 4 +- code/extfmts.lisp | 99 ++++++++++++++++--- code/fd-stream.lisp | 89 ++++++++++------- code/misc.lisp | 5 +- compiler/byte-comp.lisp | 4 +- contrib/contrib.lisp | 4 +- contrib/embedded-c/embedded-c.lisp | 2 + contrib/games/feebs/feebs.lisp | 4 +- contrib/hist/hist.lisp | 2 + contrib/ops/compile-ops.lisp | 2 + contrib/psgraph/psgraph.lisp | 2 + contrib/sprof/sprof.lisp | 1 + docs/cmu-user/aliens.tex | 21 +++- docs/cmu-user/cmu-user.tex | 2 +- docs/cmu-user/unicode.tex | 55 ++++++++++- general-info/release-20a.txt | 50 +++++----- pcl/simple-streams/external-formats/cr.lisp | 22 +++++ pcl/simple-streams/external-formats/crlf.lisp | 20 ++-- .../external-formats/utf-16.lisp | 8 +- .../external-formats/utf-32.lisp | 14 ++- tools/build.sh | 2 +- tools/cross-build-world.sh | 21 ++-- 23 files changed, 388 insertions(+), 112 deletions(-) create mode 100644 bootfiles/19f/boot-20a.lisp create mode 100644 pcl/simple-streams/external-formats/cr.lisp diff --git a/bootfiles/19f/boot-20a.lisp b/bootfiles/19f/boot-20a.lisp new file mode 100644 index 000000000..8e985ee10 --- /dev/null +++ b/bootfiles/19f/boot-20a.lisp @@ -0,0 +1,67 @@ +;;;; +;;;; Boot file for changing the fasl file version numbers to 20a. +;;;; + +(in-package :c) + +(setf lisp::*enable-package-locked-errors* nil) + +;;; +;;; Note that BYTE-FASL-FILE-VERSION is a constant. +;;; +;;; (Be sure to change BYTE-FASL-FILE-VERSION in +;;; compiler/byte-comp.lisp to the correct value too!) +;;; +#-cmu20a +(setf (symbol-value 'byte-fasl-file-version) #x20a) +#-cmu20a +(setf (backend-fasl-file-version *target-backend*) #x20a) + +;;; +;;; Don't check fasl versions in the compiling Lisp because we'll +;;; load files compiled with the new version numbers. +;;; +#-cmu20a +(setq lisp::*skip-fasl-file-version-check* t) + +;;; +;;; This is here because BYTE-FASL-FILE-VERSION is constant-folded in +;;; OPEN-FASL-FILE. To make the new version number take effect, we +;;; have to redefine the function. +;;; +#-cmu20a +(defun open-fasl-file (name where &optional byte-p) + (declare (type pathname name)) + (let* ((stream (open name :direction :output + :if-exists :new-version + :element-type '(unsigned-byte 8))) + (res (make-fasl-file :stream stream))) + (multiple-value-bind + (version f-vers f-imp) + (if byte-p + (values "Byte code" + byte-fasl-file-version + (backend-byte-fasl-file-implementation *backend*)) + (values (backend-version *backend*) + (backend-fasl-file-version *backend*) + (backend-fasl-file-implementation *backend*))) + (format stream + "FASL FILE output from ~A.~@ + Compiled ~A on ~A~@ + Compiler ~A, Lisp ~A~@ + Targeted for ~A, FASL version ~X~%" + where + (ext:format-universal-time nil (get-universal-time)) + (machine-instance) compiler-version + (lisp-implementation-version) + version f-vers) + ;; + ;; Terminate header. + (dump-byte 255 res) + ;; + ;; Specify code format. + (dump-fop 'lisp::fop-long-code-format res) + (dump-byte f-imp res) + (dump-unsigned-32 f-vers res)) + res)) + diff --git a/code/array.lisp b/code/array.lisp index 86ba408aa..36f23bb70 100644 --- a/code/array.lisp +++ b/code/array.lisp @@ -5,7 +5,7 @@ ;;; Carnegie Mellon University, and has been placed in the public domain. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/array.lisp,v 1.44 2009/06/11 16:03:57 rtoy Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/array.lisp,v 1.45 2009/09/09 15:51:27 rtoy Rel $") ;;; ;;; ********************************************************************** ;;; @@ -676,7 +676,7 @@ (let ((fill-pointer (fill-pointer array))) (declare (fixnum fill-pointer)) (when (= fill-pointer (%array-available-elements array)) - (adjust-array array (+ fill-pointer extension))) + (setf array (adjust-array array (+ fill-pointer extension)))) (setf (aref array fill-pointer) new-el) (setf (%array-fill-pointer array) (1+ fill-pointer)) fill-pointer)) diff --git a/code/extfmts.lisp b/code/extfmts.lisp index 3040de967..1c971b589 100644 --- a/code/extfmts.lisp +++ b/code/extfmts.lisp @@ -5,7 +5,7 @@ ;;; domain. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/extfmts.lisp,v 1.15 2009/08/26 16:25:41 rtoy Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/extfmts.lisp,v 1.16 2009/09/09 15:51:27 rtoy Exp $") ;;; ;;; ********************************************************************** ;;; @@ -63,6 +63,10 @@ ;; flushed to the output stream. A NIL value means the external ;; format does not need to do anything special. (flush-state nil :type (or null function) :read-only t) + ;; + ;; Function to copy the state of the external-format. If NIL, then + ;; there is no state to be copied. + (copy-state nil :type (or null function) :read-only t) (cache nil :type (or null simple-vector)) ;; ;; Minimum number of octets needed to form a codepoint @@ -90,7 +94,7 @@ (defun %intern-ef (ef) (setf (gethash (ef-name ef) *external-formats*) ef)) -(declaim (inline ef-octets-to-code ef-code-to-octets ef-flush-state +(declaim (inline ef-octets-to-code ef-code-to-octets ef-flush-state ef-copy-state ef-cache ef-min-octets ef-max-octets)) (defun ef-octets-to-code (ef) @@ -102,6 +106,9 @@ (defun ef-flush-state (ef) (efx-flush-state (ef-efx ef))) +(defun ef-copy-state (ef) + (efx-copy-state (ef-efx ef))) + (defun ef-cache (ef) (efx-cache (ef-efx ef))) @@ -127,7 +134,9 @@ ;;; DEFINE-EXTERNAL-FORMAT -- Public ;;; -;;; name (&key min max size) (&rest slots) octets-to-code code-to-octets flush-state +;;; name (&key min max size) (&rest slots) octets-to-code code-to-octets +;;; flush-state copy-state +;;; ;;; Define a new external format. Min/Max/Size are the minimum and ;;; maximum number of octets that make up a character (:size N is just ;;; shorthand for :min N :max N). Slots is a list of slot descriptions @@ -140,11 +149,11 @@ ;;; octets-to-code (state input unput &rest vars) ;;; Defines a form to be used by the external format to convert ;;; octets to a code point. State is a form that can be used by the -;;; body to access the state variable of the stream. Input is a -;;; form that can be used to read one more octets from the input -;;; strema. Similarly, Unput is a form to put back one octet to the -;;; input stream. Vars is a list of vars that need to be defined -;;; for any symbols used within the form. +;;; body to access the state of the stream. Input is a form that +;;; can be used to read one octet from the input stream. (It can be +;;; called as many times as needed.) Similarly, Unput is a form to +;;; put back one octet to the input stream. Vars is a list of vars +;;; that need to be defined for any symbols used within the form. ;;; ;;; This should return two values: the code and the number of octets ;;; read to form the code. @@ -161,6 +170,11 @@ ;;; any state when an output stream is closed. Similar to ;;; CODE-TO-OCTETS, but there is no code. ;;; +;;; copy-state (state &rest vars) +;;; Defines a form to copy any state needed by the external format. +;;; This should probably be a deep copy so that if the original +;;; state is modified, the copy is not. +;;; ;;; Note: external-formats work on code-points, not ;;; characters, so that the entire 31 bit ISO-10646 range can be ;;; used internally regardless of the size of a character recognized @@ -169,7 +183,8 @@ ;;; CODEPOINT-TO-OCTETS, OCTETS-TO-CODEPOINT) ;;; (defmacro define-external-format (name (&rest args) (&rest slots) - &optional octets-to-code code-to-octets flush-state) + &optional octets-to-code code-to-octets + flush-state copy-state) (when (and (oddp (length args)) (not (= (length args) 1))) (warn "Nonsensical argument (~S) to DEFINE-EXTERNAL-FORMAT." args)) (let* ((tmp (gensym)) @@ -204,12 +219,18 @@ (let (,@',slotb (,code ',code) ,@(loop for var in vars collect `(,var (gensym)))) - `(let ((,',code (the (unsigned-byte 21) ,,',tmp))) + `(let ((,',code (the lisp:codepoint ,,',tmp))) (declare (ignorable ,',code)) ,,body)))) (flush-state ((state output &rest vars) body) `(lambda (,state ,output) (declare (ignorable ,state ,output)) + (let (,@',slotb + ,@(loop for var in vars collect `(,var (gensym)))) + ,body))) + (copy-state ((state &rest vars) body) + `(lambda (,state) + (declare (ignorable ,state)) (let (,@',slotb ,@(loop for var in vars collect `(,var (gensym)))) ,body)))) @@ -218,7 +239,8 @@ `(ef-efx (find-external-format ,(ef-name base))) `(make-efx :octets-to-code ,octets-to-code :code-to-octets ,code-to-octets - :flush-state ,flush-state + :flush-state ,flush-state + :copy-state ,copy-state :cache (make-array +ef-max+ :initial-element nil) :min ,(min min max) :max ,(max min max))) @@ -236,6 +258,36 @@ ;;; octets. They have to be composed with a non-composing external-format ;;; to be of any use. ;;; +;;; +;;; name (&key min max size) input output +;;; Defines a new composing external format. The parameters Min, +;;; Max, and Size are the same as for defining an external format. +;;; The parameters input and output are forms to handle input and +;;; output. +;;; +;;; input (state input unput &rest vars) +;;; Defines a form to be used by the composing external format when +;;; reading input to transform a codepoint (or sequence of +;;; codepoints) to another. State is a form that can be used by the +;;; body to access the state of the external format. Input is a +;;; form that can be used to read one code point from the input +;;; stream. (Input returns two values, the codepoint and the number +;;; of octets read.) It may be called as many times as needed. +;;; This returns two values: the codepoint of the character (or NIL) +;;; and the number of octets read. Similarly, Unput is a form to +;;; put back one octet to the input stream. Vars is a list of vars +;;; that need to be defined for any symbols used within the form. +;;; +;;; This should return two values: the code and the number of octets +;;; read to form the code. +;;; +;;; output (code state output &rest vars) +;;; Defines a form to be used by the composing external format to +;;; convert a code point to octets for output. Code is the code +;;; point to be converted. State is a form to access the current +;;; value of the stream's state variable. Output is a form that +;;; writes one octet to the output stream. + (defmacro define-composing-external-format (name (&key min max size) input output) (let ((tmp (gensym)) @@ -245,7 +297,7 @@ `(lambda (,state ,input ,unput) (declare (ignorable ,state ,input ,unput) (optimize (ext:inhibit-warnings 3))) - (let ((,input `(the (values (or (unsigned-byte 21) null) + (let ((,input `(the (values (or lisp:codepoint null) kernel:index) ,,input)) ,@(loop for var in vars collect `(,var (gensym)))) @@ -256,7 +308,7 @@ (optimize (ext:inhibit-warnings 3))) (let ((,code ',code) ,@(loop for var in vars collect `(,var (gensym)))) - `(let ((,',code (the (unsigned-byte 21) ,,',tmp))) + `(let ((,',code (the lisp:codepoint ,,',tmp))) (declare (ignorable ,',code)) ,,body))))) (%intern-ef (make-external-format ,name @@ -479,7 +531,7 @@ `(multiple-value-bind (,tmp1 ,tmp2) ,(funcall (ef-octets-to-code ef) state input unput) (setf ,count (the kernel:index ,tmp2)) - (the (or (unsigned-byte 21) null) ,tmp1)))) + (the (or lisp:codepoint null) ,tmp1)))) (defmacro codepoint-to-octets (external-format code state output) (let ((ef (find-external-format external-format))) @@ -555,10 +607,10 @@ (setf (car ,nstate) nil ,count 0)) (let ((code (octets-to-codepoint ,external-format (cdr ,nstate) ,count ,input ,unput))) - (declare (type (unsigned-byte 21) code)) + (declare (type lisp:codepoint code)) ;;@@ on non-Unicode builds, limit to 8-bit chars ;;@@ if unicode-bootstrap, can't use #\u+fffd - (cond ((or (<= #xD800 code #xDFFF) (> code #x10FFFF)) + (cond ((or (lisp::surrogatep code) (> code #x10FFFF)) #-(and unicode (not unicode-bootstrap)) #\? #+(and unicode (not unicode-bootstrap)) #\U+FFFD) #+unicode @@ -602,6 +654,12 @@ (when f (funcall f state output)))) +(defmacro copy-state (external-format state) + (let* ((ef (find-external-format external-format)) + (f (ef-copy-state ef))) + (when f + (funcall f state)))) + (def-ef-macro ef-string-to-octets (extfmt lisp::lisp +ef-max+ +ef-so+) `(lambda (string start end buffer &aux (ptr 0) (state nil)) (declare #|(optimize (speed 3) (safety 0) (space 0) (debug 0))|# @@ -619,6 +677,10 @@ (defun string-to-octets (string &key (start 0) end (external-format :default) (buffer nil bufferp)) + "Convert String to octets using the specified External-format. The + string is bounded by Start (defaulting to 0) and End (defaulting to + the end of the string. If Buffer is given, the octets are stored + there. If not, a new buffer is created." (declare (type string string) (type kernel:index start) (type (or kernel:index null) end) @@ -650,6 +712,11 @@ (defun octets-to-string (octets &key (start 0) end (external-format :default) (string nil stringp)) + "Octets-to-string converts an array of octets in Octets to a string + according to the specified External-format. The array of octets is + bounded by Start (defaulting ot 0) and End (defaulting to the end of + the array. If String is given, the string is stored there; + otherwise a new string is created." (declare (type (simple-array (unsigned-byte 8) (*)) octets) (type kernel:index start) (type (or kernel:index null) end) diff --git a/code/fd-stream.lisp b/code/fd-stream.lisp index f9e685f03..36177639c 100644 --- a/code/fd-stream.lisp +++ b/code/fd-stream.lisp @@ -5,7 +5,7 @@ ;;; Carnegie Mellon University, and has been placed in the public domain. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/fd-stream.lisp,v 1.90 2009/08/26 16:25:41 rtoy Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/fd-stream.lisp,v 1.91 2009/09/09 15:51:27 rtoy Rel $") ;;; ;;; ********************************************************************** ;;; @@ -382,7 +382,7 @@ (let* ((tail (fd-stream-obuf-tail stream))) (declare (type index tail)) (cond - ((stream::ef-flush-state (stream::find-external-format ,extfmt)) + ((stream::ef-flush-state ,(stream::find-external-format extfmt)) (stream::flush-state ,extfmt (fd-stream-co-state stream) (lambda (byte) @@ -1372,12 +1372,21 @@ ;; Support for n-byte operations on 8-, 16-, and 32-bit streams (setf (fd-stream-n-bin stream) #'fd-stream-read-n-bytes) (when (and buffer-p (eql size 1) - (or (eq type 'unsigned-byte) - (eq type :default))) + (or + ;; FIXME: Do this better. We want to check for + ;; (unsigned-byte 8). The 8 is unnecessary + ;; since we already have size = 1. + (or (eq 'unsigned-byte (and (consp type) (car type))) + (eq type :default)) + ;; Character streams with :iso8859-1 + (and (eq type 'character) + #+unicode + (eql :iso8859-1 (fd-stream-external-format stream))))) ;; We only create this buffer for streams of type - ;; (unsigned-byte 8). Because there's no buffer, the + ;; (unsigned-byte 8) or character streams with an external + ;; format of :iso8859-1. Because there's no buffer, the ;; other element-types will dispatch to the appropriate - ;; input (output) routine in fast-read-byte. + ;; input (output) routine in fast-read-byte/fast-read-char. (setf (lisp-stream-in-buffer stream) (make-array in-buffer-length :element-type '(unsigned-byte 8))))) @@ -1405,12 +1414,7 @@ #'ill-out) (fd-stream-bout stream) routine)) (setf (fd-stream-sout stream) - ;;#-unicode - (if (eql size 1) #'fd-sout #'ill-out) - #|#+unicode - (if (eql size 1) - #'fd-sout-each-character - #'ill-out)|#) + (if (eql size 1) #'fd-sout #'ill-out)) (setf (fd-stream-char-pos stream) 0) (setf output-size size) (setf output-type type))) @@ -1741,9 +1745,17 @@ :pathname pathname :buffering buffering :timeout timeout)))) + ;; FIXME: setting the external format here should be better + ;; integrated into set-routines. We do it before so that + ;; set-routines can create an in-buffer if appropriate. But we + ;; need to do it after to put the correct input routines for the + ;; external format. + ;; + ;;#-unicode-bootstrap ; fails in stream-reinit otherwise + #+(and unicode (not unicode-bootstrap)) + (setf (stream-external-format stream) external-format) (set-routines stream element-type input output input-buffer-p :binary-stream-p binary-stream-p) - ;;#-unicode-bootstrap ; fails in stream-reinit otherwise #+(and unicode (not unicode-bootstrap)) (setf (stream-external-format stream) external-format) (when (and auto-close (fboundp 'finalize)) @@ -2059,6 +2071,7 @@ class mapped input-handle output-handle &allow-other-keys &aux ; Squelch assignment warning. + (options options) (direction direction) (if-does-not-exist if-does-not-exist) (if-exists if-exists)) @@ -2230,31 +2243,33 @@ #+unicode (stream::def-ef-macro ef-strlen (extfmt lisp stream::+ef-max+ stream::+ef-str+) - (if (= (stream::ef-min-octets (stream::find-external-format extfmt)) - (stream::ef-max-octets (stream::find-external-format extfmt))) - `(lambda (stream object) - (declare (ignore stream) - (type (or character string) object) - (optimize (speed 3) (space 0) (safety 0))) + ;; While it would be nice not to have to call CHAR-TO-OCTETS to + ;; figure out the length when the external format has fixed size + ;; outputs, we can't. For example, utf16 will output a BOM, which + ;; wouldn't be reflected in the count if we don't call + ;; CHAR-TO-OCTETS. + `(lambda (stream object &aux (count 0)) + (declare (type fd-stream stream) + (type (or character string) object) + (type (and fixnum unsigned-byte) count) + #|(optimize (speed 3) (space 0) (debug 0) (safety 0))|#) + (labels ((efstate (state) + (stream::copy-state ,extfmt state)) + (eflen (char) + (stream::char-to-octets ,extfmt char + (fd-stream-co-state stream) + (lambda (byte) + (declare (ignore byte)) + (incf count))))) + (let* ((co-state (fd-stream-co-state stream)) + (old-ef-state (efstate (cdr (fd-stream-co-state stream)))) + (old-state (cons (car co-state) old-ef-state))) (etypecase object - (character ,(stream::ef-min-octets (stream::find-external-format extfmt))) - (string (* ,(stream::ef-min-octets (stream::find-external-format extfmt)) - (length object))))) - `(lambda (stream object &aux (count 0)) - (declare (type fd-stream stream) - (type (or character string) object) - #|(optimize (speed 3) (space 0) (debug 0) (safety 0))|#) - `(labels ((eflen (char) - (stream::char-to-octets ,extfmt char - ;;@@ FIXME: don't alter state! - (fd-stream-co-state stream) - (lambda (byte) - (declare (ignore byte)) - (incf count))))) - (etypecase object - (character (eflen object)) - (string (dovector (ch object) (eflen ch)))) - count)))) + (character (eflen object)) + (string (dovector (ch object) (eflen ch)))) + ;; Restore state + (setf (fd-stream-co-state stream) old-state) + count)))) (defun file-string-length (stream object) diff --git a/code/misc.lisp b/code/misc.lisp index 2a0bafd50..397b34382 100644 --- a/code/misc.lisp +++ b/code/misc.lisp @@ -5,7 +5,7 @@ ;;; Carnegie Mellon University, and has been placed in the public domain. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/misc.lisp,v 1.37 2009/06/11 16:03:58 rtoy Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/misc.lisp,v 1.38 2009/09/09 15:51:27 rtoy Rel $") ;;; ;;; ********************************************************************** ;;; @@ -160,7 +160,8 @@ (defun lisp-implementation-version () "Returns a string describing the implementation version." - (format nil "~A (~X)" *lisp-implementation-version* c:byte-fasl-file-version)) + (format nil "~A (~X~A)" *lisp-implementation-version* c:byte-fasl-file-version + #+unicode " Unicode" #-unicode "")) (defun machine-instance () "Returns a string giving the name of the local machine." diff --git a/compiler/byte-comp.lisp b/compiler/byte-comp.lisp index c8b175b1e..08f04461b 100644 --- a/compiler/byte-comp.lisp +++ b/compiler/byte-comp.lisp @@ -5,7 +5,7 @@ ;;; Carnegie Mellon University, and has been placed in the public domain. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/byte-comp.lisp,v 1.48 2009/06/11 16:03:59 rtoy Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/byte-comp.lisp,v 1.49 2009/09/09 15:51:27 rtoy Rel $") ;;; ;;; ********************************************************************** ;;; @@ -32,7 +32,7 @@ ;;;; Fasl file format: -(defconstant byte-fasl-file-version #-unicode #x19f #+unicode #x20a) +(defconstant byte-fasl-file-version #x20a) (let* ((version-string (format nil "~X" byte-fasl-file-version))) (sys:register-lisp-feature (intern (concatenate 'string "CMU" version-string) :keyword)) diff --git a/contrib/contrib.lisp b/contrib/contrib.lisp index 334cf41c3..d848a2e68 100644 --- a/contrib/contrib.lisp +++ b/contrib/contrib.lisp @@ -5,7 +5,7 @@ ;;; Carnegie Mellon University, and has been placed in the public domain. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/contrib/contrib.lisp,v 1.3 2009/08/18 15:20:21 rtoy Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/contrib/contrib.lisp,v 1.4 2009/09/09 15:51:27 rtoy Rel $") ;;; Define the various contrib modules. We use defmodule for now ;;; because it's easy for the contribs. @@ -39,3 +39,5 @@ ;; Sprof really needs to be compiled, so make this module compile sprof. (defmodule "contrib-sprof" "modules:sprof/compile-sprof") + +(provide "cmu-contribs") diff --git a/contrib/embedded-c/embedded-c.lisp b/contrib/embedded-c/embedded-c.lisp index a98e6ef95..8ff12644e 100644 --- a/contrib/embedded-c/embedded-c.lisp +++ b/contrib/embedded-c/embedded-c.lisp @@ -269,3 +269,5 @@ (defstub coredumpp ((status :int) => :int) "return WCOREDUMP(status);")) + +(provide "contrib-embedded-c") diff --git a/contrib/games/feebs/feebs.lisp b/contrib/games/feebs/feebs.lisp index 2a729be47..fffd75dd1 100644 --- a/contrib/games/feebs/feebs.lisp +++ b/contrib/games/feebs/feebs.lisp @@ -16,7 +16,7 @@ ;;; ;;; To see a demo, compile and load feebs.lisp then type (feebs:feebs). ;;; -;;; $Id: feebs.lisp,v 1.6 2007/08/14 16:49:44 fgilham Exp $ +;;; $Id: feebs.lisp,v 1.7 2009/09/09 15:51:27 rtoy Rel $ ;;; (cl:in-package "COMMON-LISP") @@ -1981,3 +1981,5 @@ :turn-right) (t :turn-around)))) + +(provide "contrib-games-feebs") diff --git a/contrib/hist/hist.lisp b/contrib/hist/hist.lisp index 40f212416..a995ef1cf 100644 --- a/contrib/hist/hist.lisp +++ b/contrib/hist/hist.lisp @@ -87,3 +87,5 @@ (incf (svref *hist-array* (- *hist-nbuckets* 2)))) (t (incf (svref *hist-array* (floor (- value *hist-lower-limit*) *hist-bucket-size*)))))) + +(provide "contrib-hist") diff --git a/contrib/ops/compile-ops.lisp b/contrib/ops/compile-ops.lisp index e4ef985dd..0ad80d53e 100644 --- a/contrib/ops/compile-ops.lisp +++ b/contrib/ops/compile-ops.lisp @@ -10,3 +10,5 @@ "library:contrib/ops/ops-io.lisp" "library:contrib/ops/ops.lisp") :output-file "library:contrib/ops/ops.fasl") + +(provide "contrib-ops") diff --git a/contrib/psgraph/psgraph.lisp b/contrib/psgraph/psgraph.lisp index 057464aad..1abf0f773 100644 --- a/contrib/psgraph/psgraph.lisp +++ b/contrib/psgraph/psgraph.lisp @@ -567,3 +567,5 @@ (psnode-children (aref *narray* x))))) (setf (gethash (list x y) *ancestor-cache*) (list cached-value)) cached-value)))) + +(provide "contrib-psgraph") diff --git a/contrib/sprof/sprof.lisp b/contrib/sprof/sprof.lisp index 346219614..b0e4da876 100644 --- a/contrib/sprof/sprof.lisp +++ b/contrib/sprof/sprof.lisp @@ -1342,4 +1342,5 @@ :verbose nil :print nil :progress nil)))) +(provide "contrib-sprof") ;;; End of file. diff --git a/docs/cmu-user/aliens.tex b/docs/cmu-user/aliens.tex index db9f3e45b..8b26030d2 100644 --- a/docs/cmu-user/aliens.tex +++ b/docs/cmu-user/aliens.tex @@ -253,6 +253,19 @@ exports these types: string when accessed. If the pointer is C \code{NULL} (or 0), then accessing gives Lisp \false. + With Unicode, a Lisp string is not the same as a C string since a + Lisp string uses two bytes for each character. In this case, a + C string is converted to a Lisp string by taking each byte of the + C-string and applying \code{code-char} to create each character of + the Lisp string. + + Similarly, a Lisp string is converted to a C string by taking the + low 8 bits of the \code{char-code} of each character and assigning + that to each byte of the C string. + + In either case, \code{string-encode} and \code{string-decode} may be + useful to convert Unicode Lisp strings to or from C strings. + Assigning a Lisp string to a \code{c-string} structure field or variable stores the contents of the string to the memory already pointed to by that variable. When an Alien of type \code{(* char)} @@ -263,9 +276,11 @@ exports these types: \begin{lisp} (def-alien-type nil (struct foo (str c-string))) - (defun make-foo (str) (let ((my-foo (make-alien (struct foo)))) - (setf (slot my-foo 'str) (make-alien char (length str))) (setf (slot - my-foo 'str) str) my-foo)) + (defun make-foo (str) + (let ((my-foo (make-alien (struct foo)))) + (setf (slot my-foo 'str) (make-alien char (length str))) + (setf (slot my-foo 'str) str) + my-foo)) \end{lisp} Storing Lisp \false{} writes C \code{NULL} to the \code{c-string} diff --git a/docs/cmu-user/cmu-user.tex b/docs/cmu-user/cmu-user.tex index c4a2f6d29..3bcd8ce07 100644 --- a/docs/cmu-user/cmu-user.tex +++ b/docs/cmu-user/cmu-user.tex @@ -47,7 +47,7 @@ \newcommand{\keywords}{lisp, Common Lisp, manual, compiler, programming language implementation, programming environment} -\date{Mar 2009 \\ Release 19f} +\date{Sep 2009 \\ Release 20a} \begin{document} diff --git a/docs/cmu-user/unicode.tex b/docs/cmu-user/unicode.tex index e42c2321f..2276abe38 100644 --- a/docs/cmu-user/unicode.tex +++ b/docs/cmu-user/unicode.tex @@ -508,8 +508,32 @@ utility functions are provided to make access easier. less than 256. \end{defun} +\begin{defun}{}{string-to-octets}{\args \var{string} \keys{\kwd{start} + \kwd{end} \kwd{external-format} \kwd{buffer}}} + \code{string-to-octets} converts \var{string} to a sequence of + octets according to the external format specified by + \var{external-format}. The string to be converted is bounded by + \var{start}, which defaults to 0, and \var{end}, which defaults to + the length of the string. If \var{buffer} is specified, the octets + are placed in \var{buffer}. If \var{buffer} is not specified, a new + array is allocated to hold the octets. In all cases the buffer is + returned. +\end{defun} + +\begin{defun}{}{octets-to-string}{\args \var{octets} \keys{\kwd{start} + \kwd{end} \kwd{external-format} \kwd{buffer}}} + \code{octets-to-string} converts the sequence of octets in + \var{octets} is converted to a string. \var{octets} must be a + \code{(simple-array (unsigned-byte 8) (*))}. The octets to be + converted are bounded by \var{start} and \var{end}, which default to + 0 and the length of the array, respectively. The conversion is + performed according to the external format specified by + \var{external-format}. +\end{defun} + \section{Writing External Formats} +\subsection{External Formats} Users may write their own external formats. It is probably easiest to look at existing external formats to see how do this. @@ -521,7 +545,8 @@ external format is defined using the macro \begin{defmac}[base]{stream:}{define-external-format}{\args \var{name} (\keys{\var{min} \var{max} \var{size}}) (\amprest{} \var{slots}) - \morekeys{\var{octets-to-code} \var{code-to-octets}}} + \morekeys{\var{octets-to-code} \var{code-to-octets} + \var{flush-state} \var{copy-state}}} \defmacx[stream:]{define-external-format}{\args \var{name} (\var{base}) (\amprest{} \var{slots})} @@ -547,7 +572,7 @@ external format is defined using the macro \end{defmac} -\begin{defmac}{stream:}{octets-to-code}{\args \var{state} \var{input} +\begin{defmac}{}{octets-to-code}{\args \var{state} \var{input} \var{unput} \amprest{} \var{args}} This defines a form to be used by an external format to convert octets to a code point. \var{state} is a form that can be used by @@ -559,7 +584,7 @@ external format is defined using the macro body of the macro. \end{defmac} -\begin{defmac}{stream:}{code-to-octets}{\args \var{code} \var{state} +\begin{defmac}{}{code-to-octets}{\args \var{code} \var{state} \var{output} \amprest{} \var{args}} Defines a form to be used by the external format to convert a code point to octets for output. \var{code} is the code point to be @@ -568,6 +593,30 @@ external format is defined using the macro octet to the output stream. \end{defmac} +\begin{defmac}{}{flush-state}{\args \var{state} + \var{output} \amprest{} \var{args}} + Defines a form to be used by the external format to flush out + any state when an output stream is closed. Similar to + \code{code-to-octets}, but there is no code point to be output. + + If \false, then nothing special is needed to flush the state to the + output. + + This is called only when an output character stream is being closed. +\end{defmac} + +\begin{defmac}{}{copy-state}{\args \var{state} \amprest{} \var{args}} + Defines a form to copy any state needed by the external format. + This should probably be a deep copy so that if the original + state is modified, the copy is not. + + If not given, then nothing special is needed to copy the state + either because there is no state for the external format or that no + special copier is needed. +\end{defmac} + +\subsection{Composing External Formats} + \begin{defmac}{stream:}{define-composing-external-format}{\args \var{name} (\keys{\var{min} \var{max} \var{size}}) \var{input} \var{output}} diff --git a/general-info/release-20a.txt b/general-info/release-20a.txt index b2934f3b7..6993ca7b5 100644 --- a/general-info/release-20a.txt +++ b/general-info/release-20a.txt @@ -1,23 +1,28 @@ ========================== C M U C L 20 a ============================= -[--- WORK IN PROGRESS ---] - The CMUCL project is pleased to announce the release of CMUCL 20a. This is a major release which contains numerous enhancements and -bugfixes from the 19f release. +bug fixes from the 19f release. CMUCL is a free, high performance implementation of the Common Lisp programming language which runs on most major Unix platforms. It mainly conforms to the ANSI Common Lisp standard. CMUCL provides a sophisticated native code compiler; a powerful foreign function interface; an implementation of CLOS, the Common Lisp Object System, -which includes multimethods and a metaobject protocol; a source-level +which includes multi-methods and a meta-object protocol; a source-level debugger and code profiler; and an Emacs-like editor implemented in Common Lisp. CMUCL is maintained by a team of volunteers collaborating over the Internet, and is mostly in the public domain. New in this release: + * Known issues: + - On Linux and FreeBSD, it may not be possible call SAVE-LISP and + create executables. This seems to be broken on FreeBSD. On + Linux, it seems to depend on what version of Linux is used to + create the executable. Redhat Enterprise Linux appears to be + ok, but Open SuSE 10.x is not. + * Feature enhancements: - Support for Unicode has been added. You have Unicode support if *FEATURES* includes :UNICODE. @@ -36,18 +41,18 @@ New in this release: to specify the format. + The special variable STREAM:*DEFAULT-EXTERNAL-FORMAT* specifies the default format to be used for all streams. - The default value is :iso8859-1. - + The standard streams, *standard-input*, *standard-output*, - and *standard-error* all default to - *default-external-format* (which itself defaults to - :iso8859-1). You can change the encoding used for these + The default value is :ISO8859-1. + + The standard streams, *STANDARD-INPUT*, *STANDARD-OUTPUT*, + and *STANDARD-ERROR* all default to + *DEFAULT-EXTERNAL-FORMAT* (which itself defaults to + :ISO8859-1). You can change the encoding used for these streams by calling STREAM:SET-SYSTEM-EXTERNAL-FORMAT to set the encoding for all three streams. Alternatively, you can - use (setf external-format) to change the format for each + use (SETF EXTERNAL-FORMAT) to change the format for each stream. + Many external formats are supported. The complete list is in aliases, but we support at least :ISO-8859-1, :UTF-8, - :UTF-16, :UTF-32, :CRLF. + :UTF-16, :UTF-32, and the composing external format :CRLF. o CHAR-LESSP and friends perform case-folding by converting to lowercase. (The non-Unicode version converted to uppercase.) o STRING<, STRING>, and friends compare strings in codepoint order. @@ -55,10 +60,11 @@ New in this release: codepoint order after doing a case-folding operation on each codepoint. The case-folding operation converts each codepoint to the corresponding lowercase codepoint. - o UTF16-STRING-P checks to see if a string is a valid UTF-16 - encoded string. - o Unicode normalization forms are supported via STRING-TO-NFC, - STRING-TO-NFKC, STRING-TO-NFD, and STRING-TO-NFKD. + o LISP:UTF16-STRING-P checks to see if a string is a valid + UTF-16 encoded string. + o Unicode normalization forms are supported via + LISP:STRING-TO-NFC, LISP:STRING-TO-NFKC, LISP:STRING-TO-NFD, + and LISP:STRING-TO-NFKD. o Symbols are always normalized to NFC form. - WRITE-VECTOR and READ-VECTOR support vectors of with element @@ -78,7 +84,7 @@ New in this release: numeric types. Previously, we handled the case of integer types. Extend this to handle floats as well. - SXHASH was computing the same hash code for upper and lower case - characters by upcasing the character. This isn't necessary + characters by up-casing the character. This isn't necessary since the characters are not EQUAL, so make SXHASH return different values for upper and lower case letter. - WRITE-VECTOR was not writing out enough data when no @@ -89,7 +95,7 @@ New in this release: - The stream created by WITH-INPUT-FROM-STREAM was not properly closed. - SXHASH was returning different values for -0f0 and -0d0 for - compiled and interpreted code. The both return the same value + compiled and interpreted code. They both return the same value now. - Some issues with potential spurious floating-point exceptions with complex arithmetic on x86 with SSE2 have been fixed. @@ -146,14 +152,14 @@ New in this release: * Improvements to the PCL implementation of CLOS: * Changes to building procedure: - - The sparc config fils are now named sparc_gcc and sparc_sunc, + - The sparc config files are now named sparc_gcc and sparc_sunc, which use gcc and Sun C, respectively, for the C compiler. Only Solaris is supported. The old sun4_solaris_gcc and sun4_solaris_sunc configs are deprecated. - - * Known issues: - - The :executable feature, while enabled for FreeBSD and Linux, - may not be working. + - The Linux config file is x86_linux, which supports gencgc. The + old cgc config is no longer supported. + - The FreeBSD config file is x86_freebsd, which supports gencgc. The + old cgc config is no longer supported. This release is not binary compatible with code compiled using CMUCL 19f; you will need to recompile FASL files. diff --git a/pcl/simple-streams/external-formats/cr.lisp b/pcl/simple-streams/external-formats/cr.lisp new file mode 100644 index 000000000..790d12d09 --- /dev/null +++ b/pcl/simple-streams/external-formats/cr.lisp @@ -0,0 +1,22 @@ +;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Package: STREAM -*- +;;; +;;; ********************************************************************** +;;; This code was written by Raymond Toy and has been placed in the public +;;; domain. +;;; +(ext:file-comment "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/simple-streams/external-formats/cr.lisp,v 1.2 2009/09/09 15:51:28 rtoy Rel $") + +(in-package "STREAM") + +;; Convert CR to/from #\newline. +(define-composing-external-format :cr (:size 1) + (input (state input unput tmp1 tmp2) + `(multiple-value-bind (,tmp1 ,tmp2) + ,input + (if (= ,tmp1 (char-code #\return)) + (values (char-code #\newline) ,tmp2) + (values ,tmp1 ,tmp2)))) + (output (code state output) + `(if (= ,code (char-code #\newline)) + (,output (char-code #\return)) + (,output ,code)))) diff --git a/pcl/simple-streams/external-formats/crlf.lisp b/pcl/simple-streams/external-formats/crlf.lisp index 1d5ccc53d..1d4245127 100644 --- a/pcl/simple-streams/external-formats/crlf.lisp +++ b/pcl/simple-streams/external-formats/crlf.lisp @@ -4,22 +4,26 @@ ;;; This code was written by Paul Foley and has been placed in the public ;;; domain. ;;; -(ext:file-comment "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/simple-streams/external-formats/crlf.lisp,v 1.2 2009/06/11 16:04:02 rtoy Exp $") +(ext:file-comment "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/simple-streams/external-formats/crlf.lisp,v 1.3 2009/09/09 15:51:28 rtoy Rel $") (in-package "STREAM") +;; Convert DOS cr/lf end-of-line sequence to/from #\newline (define-composing-external-format :crlf (:max 2) (input (state input unput tmp1 tmp2 tmp3 tmp4) - `(multiple-value-bind (,tmp1 ,tmp2) ,input - (when (= ,tmp1 #x000D) - (multiple-value-bind (,tmp3 ,tmp4) ,input + `(multiple-value-bind (,tmp1 ,tmp2) + ,input + (when (= ,tmp1 (char-code #\return)) + (multiple-value-bind (,tmp3 ,tmp4) + ,input ;; @@ tmp3 may be NIL, if file ends in LF - (if (= ,tmp3 #x000A) - (setq ,tmp1 ,tmp3 ,tmp2 (+ ,tmp2 ,tmp4)) + (if (= ,tmp3 (char-code #\newline)) + (setq ,tmp1 ,tmp3 + ,tmp2 (+ ,tmp2 ,tmp4)) (,unput ,tmp4)))) (values ,tmp1 ,tmp2))) (output (code state output) `(progn - (when (= ,code #x000A) - (,output #x000D)) + (when (= ,code (char-code #\newline)) + (,output (char-code #\return))) (,output ,code)))) diff --git a/pcl/simple-streams/external-formats/utf-16.lisp b/pcl/simple-streams/external-formats/utf-16.lisp index dfc2d2bf3..6119051f5 100644 --- a/pcl/simple-streams/external-formats/utf-16.lisp +++ b/pcl/simple-streams/external-formats/utf-16.lisp @@ -1,7 +1,7 @@ ;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Package: STREAM -*- ;;; ;;; ********************************************************************** -(ext:file-comment "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/simple-streams/external-formats/utf-16.lisp,v 1.2 2009/06/11 16:04:02 rtoy Exp $") +(ext:file-comment "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/simple-streams/external-formats/utf-16.lisp,v 1.3 2009/09/09 15:51:28 rtoy Rel $") (in-package "STREAM") @@ -88,4 +88,8 @@ (output (logior ,c1 #xD800)) (output (logior ,c2 #xDC00)))) (t - (output +replacement-character-code+)))))) + (output +replacement-character-code+))))) + nil + (copy-state (state) + ;; The state is either NIL or T, so we can just return that. + state)) diff --git a/pcl/simple-streams/external-formats/utf-32.lisp b/pcl/simple-streams/external-formats/utf-32.lisp index 9d66bfe70..f34c4f11b 100644 --- a/pcl/simple-streams/external-formats/utf-32.lisp +++ b/pcl/simple-streams/external-formats/utf-32.lisp @@ -4,7 +4,7 @@ ;;; This code was written by Raymond Toy and has been placed in the public ;;; domain. ;;; -(ext:file-comment "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/simple-streams/external-formats/utf-32.lisp,v 1.2 2009/06/11 16:04:02 rtoy Exp $") +(ext:file-comment "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/simple-streams/external-formats/utf-32.lisp,v 1.3 2009/09/09 15:51:28 rtoy Rel $") (in-package "STREAM") @@ -70,11 +70,15 @@ (code-to-octets (code state output i c) `(flet ((out (,c) - ;; Big-endian output - (dotimes (,i 4) - (,output (ldb (byte 8 (* 8 (- 3 ,i))) ,c))))) + ;; Big-endian output + (dotimes (,i 4) + (,output (ldb (byte 8 (* 8 (- 3 ,i))) ,c))))) ;; Write BOM (unless ,state (out #xFEFF) (setf ,state t)) - (out code)))) + (out code))) + nil + (copy-state (state) + ;; The state is either NIL or T, so we can just return that. + state)) diff --git a/tools/build.sh b/tools/build.sh index 1a1effc9e..99668e34d 100755 --- a/tools/build.sh +++ b/tools/build.sh @@ -118,7 +118,7 @@ buildit () $MAKE -C $TARGET/lisp || { echo "Failed: $MAKE -C $TARGET/lisp"; exit 1; } if [ "$BUILD_WORLD2" = "yes" ]; then - $TOOLDIR/build-world.sh $TARGET $OLDLISP || { echo "Failed: $TOOLDIR/build-world.sh"; exit 1; } + $TOOLDIR/build-world.sh $TARGET $OLDLISP $BOOT || { echo "Failed: $TOOLDIR/build-world.sh"; exit 1; } fi $TOOLDIR/load-world.sh $TARGET "$VERSION" || { echo "Failed: $TOOLDIR/load-world.sh"; exit 1; } diff --git a/tools/cross-build-world.sh b/tools/cross-build-world.sh index 4aa9ddd7e..1feb4b3c5 100755 --- a/tools/cross-build-world.sh +++ b/tools/cross-build-world.sh @@ -2,17 +2,19 @@ usage() { echo "cross-build-world.sh [-crl] target-dir cross-dir cross-compiler-script [build-binary [flags]]" - echo " -c Clean target and cross directories before compiling" - echo " -r Recompile lisp runtime" - echo " -l Load cross-compiled kernel to make a new lisp kernel" + echo " -c Clean target and cross directories before compiling" + echo " -r Recompile lisp runtime" + echo " -l Load cross-compiled kernel to make a new lisp kernel" + echo " -B file Use this as the cross bootstrap file." } -while getopts "crl" arg +while getopts "crlB:" arg do case $arg in c) CLEAN_DIR=yes ;; r) BUILD_RUNTIME=yes ;; l) LOAD_KERNEL=yes ;; + B) BOOTSTRAP=$OPTARG ;; h | \?) usage; exit 1 ;; esac done @@ -47,6 +49,12 @@ CROSS="`echo $2 | sed 's:/*$::'`" SCRIPT="$3" LISP="${4:-lisp}" +if [ -z "$BOOTSTRAP" ]; then + CROSSBOOT="$TARGET/cross-boootstrap.lisp" +else + CROSSBOOT=$BOOTSTRAP +fi + if [ $# -ge 4 ] then shift 4 @@ -66,6 +74,7 @@ then sed "s:^src:$CROSS:g" | xargs mkdir fi +echo cross boot = $CROSSBOOT $LISP "$@" -noinit -nositeinit <<EOF (in-package :cl-user) @@ -74,8 +83,8 @@ $LISP "$@" -noinit -nositeinit <<EOF (setf (ext:search-list "target:") '("$CROSS/" "src/")) -(when (probe-file "$TARGET/cross-bootstrap.lisp") - (load "$TARGET/cross-bootstrap.lisp")) +(print "$CROSSBOOT") +(load "$CROSSBOOT" :if-does-not-exist nil) (load "target:code/exports") (load "target:tools/setup" :if-source-newer :load-source) -- GitLab