Menu
▾
▴
[Sbcl-commits] CVS: sbcl/src/compiler assem.lisp,1.25,1.25.4.1 dump.lisp,1.41,1.41.4.1 seqtran.lisp,1.53,1.53.4.1
|
From: Christophe R. <cr...@us...> - 2004-08-25 20:26:34
|
Update of /cvsroot/sbcl/sbcl/src/compiler In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv21620/src/compiler Modified Files: Tag: character_branch assem.lisp dump.lisp seqtran.lisp Log Message: 0.8.13.77.character.4 "Nothing like the bracing sea air" Implement separation of BASE-CHAR (= ASCII) and CHARACTER. ... CHAR-CODE-LIMIT is still 255 ... BASE-CHAR is (CHARACTER-SET '((0 . 127))) ... new widetags COMPLEX-CHARACTER-STRING and SIMPLE-CHARACTER-STRING (including runtime support, compiler/x86/array.lisp, etc.) ... a whole slew of BASE-STRING/(VECTOR CHARACTER) fixes, including but not limited to * packages * pathnames * sb-unix (and clients) * sb-alien * streams * fasl dumper/loader (some of these might want to be cherry-picked to HEAD, depending on how long this branch lives) ... minor tweak to sb-simple-streams so that all contribs pass This has not yet been tested either against sbcl's own test suite or against Paul Dietz' gcl/ansi-tests Index: assem.lisp =================================================================== RCS file: /cvsroot/sbcl/sbcl/src/compiler/assem.lisp,v retrieving revision 1.25 retrieving revision 1.25.4.1 diff -u -d -r1.25 -r1.25.4.1 --- assem.lisp 14 Jul 2004 20:29:51 -0000 1.25 +++ assem.lisp 25 Aug 2004 20:26:25 -0000 1.25.4.1 @@ -27,7 +27,7 @@ ;;; This structure holds the state of the assembler. (defstruct (segment (:copier nil)) ;; the name of this segment (for debugging output and stuff) - (name "unnamed" :type simple-base-string) + (name "unnamed" :type simple-string) ;; Ordinarily this is a vector where instructions are written. If ;; the segment is made invalid (e.g. by APPEND-SEGMENT) then the ;; vector can be replaced by NIL. Index: dump.lisp =================================================================== RCS file: /cvsroot/sbcl/sbcl/src/compiler/dump.lisp,v retrieving revision 1.41 retrieving revision 1.41.4.1 diff -u -d -r1.41 -r1.41.4.1 --- dump.lisp 13 May 2004 12:35:46 -0000 1.41 +++ dump.lisp 25 Aug 2004 20:26:25 -0000 1.41.4.1 @@ -585,7 +585,9 @@ (t (unless *cold-load-dump* (dump-fop 'fop-normal-load file)) - (dump-simple-string (package-name pkg) file) + (dump-simple-character-string + (coerce (package-name pkg) '(simple-array character (*))) + file) (dump-fop 'fop-package file) (unless *cold-load-dump* (dump-fop 'fop-maybe-cold-load file)) @@ -717,8 +719,15 @@ x))) (typecase simple-version (simple-base-string + ;; FIXME: these EQUAL-CHECK-TABLE things are broken, because + ;; strings compare as EQUAL even if they have different + ;; ARRAY-ELEMENT-TYPEs (unless (equal-check-table x file) - (dump-simple-string simple-version file) + (dump-simple-base-string simple-version file) + (equal-save-object x file))) + ((simple-array character (*)) + (unless (equal-check-table x file) + (dump-simple-character-string simple-version file) (equal-save-object x file))) (simple-vector (dump-simple-vector simple-version file) @@ -875,18 +884,30 @@ (dump-fop 'fop-short-character file) (dump-byte (char-code ch) file)) -;;; a helper function shared by DUMP-SIMPLE-STRING and DUMP-SYMBOL -(defun dump-characters-of-string (s fasl-output) - (declare (type string s) (type fasl-output fasl-output)) +(defun dump-base-chars-of-string (s fasl-output) + (declare (type base-string s) (type fasl-output fasl-output)) (dovector (c s) (dump-byte (char-code c) fasl-output)) (values)) ;;; Dump a SIMPLE-BASE-STRING. -;;; FIXME: should be called DUMP-SIMPLE-BASE-STRING then -(defun dump-simple-string (s file) +(defun dump-simple-base-string (s file) (declare (type simple-base-string s)) - (dump-fop* (length s) fop-small-string fop-string file) + (dump-fop* (length s) fop-small-base-string fop-base-string file) + (dump-base-chars-of-string s file) + (values)) + +;;; a helper function shared by DUMP-SIMPLE-CHARACTER-STRING and DUMP-SYMBOL +(defun dump-characters-of-string (s fasl-output) + (declare (type string s) (type fasl-output fasl-output)) + (dovector (c s) + ;; DUMP-UNSIGNED-32 soon + (dump-byte (char-code c) fasl-output)) + (values)) + +(defun dump-simple-character-string (s file) + (declare (type (simple-array character (*)) s)) + (dump-fop* (length s) fop-small-character-string fop-character-string file) (dump-characters-of-string s file) (values)) Index: seqtran.lisp =================================================================== RCS file: /cvsroot/sbcl/sbcl/src/compiler/seqtran.lisp,v retrieving revision 1.53 retrieving revision 1.53.4.1 diff -u -d -r1.53 -r1.53.4.1 --- seqtran.lisp 16 Jun 2004 13:21:37 -0000 1.53 +++ seqtran.lisp 25 Aug 2004 20:26:25 -0000 1.53.4.1 @@ -712,6 +712,39 @@ sb!vm:n-byte-bits))) string1)) +(deftransform replace ((string1 string2 &key (start1 0) (start2 0) + end1 end2) + ((simple-array character (*)) + (simple-array character (*)) + &rest t) + * + ;; FIXME: consider replacing this policy test + ;; with some tests for the STARTx and ENDx + ;; indices being valid, conditional on high + ;; SAFETY code. + ;; + ;; FIXME: It turns out that this transform is + ;; critical for the performance of string + ;; streams. Make this more explicit. + :policy (< (max safety space) 3)) + `(locally + (declare (optimize (safety 0))) + (bit-bash-copy string2 + (the index + (+ (the index (* start2 sb!vm:n-byte-bits)) + ,vector-data-bit-offset)) + string1 + (the index + (+ (the index (* start1 sb!vm:n-byte-bits)) + ,vector-data-bit-offset)) + (the index + (* (min (the index (- (or end1 (length string1)) + start1)) + (the index (- (or end2 (length string2)) + start2))) + sb!vm:n-byte-bits))) + string1)) + ;;; FIXME: this would be a valid transform for certain excluded cases: ;;; * :TEST 'CHAR= or :TEST #'CHAR= ;;; * :TEST 'EQL or :TEST #'EQL @@ -745,9 +778,10 @@ ;;; ;;; FIXME: currently KLUDGEed because of bug 188 (deftransform concatenate ((rtype &rest sequences) - (t &rest (or simple-base-string + (t &rest (or (simple-array character (*)) + simple-base-string (simple-array nil (*)))) - simple-base-string + (simple-array character (*)) :policy (< safety 3)) (loop for rest-seqs on sequences for n-seq = (gensym "N-SEQ") |