diff --git a/bootfiles/19d/boot-2007-11-1.lisp b/bootfiles/19d/boot-2007-11-1.lisp new file mode 100644 index 0000000000000000000000000000000000000000..75a1d63faa7f719fccf13d2d4cefe3b4687ddffa --- /dev/null +++ b/bootfiles/19d/boot-2007-11-1.lisp @@ -0,0 +1,13 @@ +;; Bootstrap file for bref cleanup + +(in-package "EXTENSIONS") +(without-package-locks +(dolist (symbol '(bref buffer-sap endian-swap-value vector-elt-width)) + (unintern symbol))) + +(in-package "KERNEL") +(without-package-locks +(export 'simple-stream-buffer) +(deftype simple-stream-buffer () + '(or sys:system-area-pointer (simple-unboxed-array (*)))) +) diff --git a/code/exports.lisp b/code/exports.lisp index 45bd80e705ab5d2a9f12696a2cf7cb3ee075052d..6c6e73dca503bb07c2d5eac98bfda58f381c38ce 100644 --- a/code/exports.lisp +++ b/code/exports.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/exports.lisp,v 1.261 2007/10/25 15:17:07 rtoy Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/exports.lisp,v 1.262 2007/11/05 15:25:03 rtoy Exp $") ;;; ;;; ********************************************************************** ;;; @@ -615,8 +615,8 @@ "BOOLE-1" "BOOLE-2" "BOOLE-AND" "BOOLE-ANDC1" "BOOLE-ANDC2" "BOOLE-C1" "BOOLE-C2" "BOOLE-CLR" "BOOLE-EQV" "BOOLE-IOR" "BOOLE-NAND" "BOOLE-NOR" "BOOLE-ORC1" "BOOLE-ORC2" "BOOLE-SET" - "BOOLE-XOR" "BOTH-CASE-P" "BOUNDP" "BREAK" - "BROADCAST-STREAM" "BROADCAST-STREAM-STREAMS" + "BOOLE-XOR" "BOTH-CASE-P" "BOUNDP" "BREAK" "BREF" + "BROADCAST-STREAM" "BROADCAST-STREAM-STREAMS" "BUFFER-COPY" "BUFFER-SAP" "BUTLAST" "BYTE" "BYTE-POSITION" "BYTE-SIZE" "CAAAAR" "CAAADR" "CAAAR" "CAADAR" "CAADDR" "CAADR" "CAAR" "CADAAR" "CADADR" "CADAR" "CADDAR" "CADDDR" "CADDR" "CADR" @@ -663,7 +663,7 @@ "ECASE" "ECHO-STREAM" "ECHO-STREAM-INPUT-STREAM" "ECHO-STREAM-OUTPUT-STREAM" "ED" "EIGHTH" "ELT" "ENCODE-UNIVERSAL-TIME" - "END-OF-FILE" "ENDP" "ENOUGH-NAMESTRING" + "END-OF-FILE" "ENDIAN-SWAP-VALUE" "ENDP" "ENOUGH-NAMESTRING" "ENSURE-DIRECTORIES-EXIST" "EQ" "EQL" "EQUAL" "EQUALP" "ERROR" "ETYPECASE" "EVAL" "EVAL-WHEN" "EVENP" "EVERY" "EXP" "EXPORT" "EXPT" "EXTENDED-CHAR" "FBOUNDP" "FCEILING" @@ -824,40 +824,40 @@ "UNUSE-PACKAGE" "UNWIND-PROTECT" "UPGRADED-ARRAY-ELEMENT-TYPE" "UPGRADED-COMPLEX-PART-TYPE" "UPPER-CASE-P" "USE-PACKAGE" "USE-VALUE" "USER-HOMEDIR-PATHNAME" "VALUES" - "VALUES-LIST" "VARIABLE" "VECTOR" "VECTOR-POP" "VECTOR-PUSH" - "VECTOR-PUSH-EXTEND" "VECTORP" "WARN" "WARNING" "WHEN" - "WILD-PATHNAME-P" "WITH-COMPILATION-UNIT" - "WITH-CONDITION-RESTARTS" - "WITH-HASH-TABLE-ITERATOR" "WITH-INPUT-FROM-STRING" - "WITH-OPEN-FILE" "WITH-OPEN-STREAM" "WITH-OUTPUT-TO-STRING" - "WITH-PACKAGE-ITERATOR" "WITH-SIMPLE-RESTART" - "WITH-STANDARD-IO-SYNTAX" "WRITE" "WRITE-BYTE" "WRITE-CHAR" - "WRITE-LINE" "WRITE-STRING" "WRITE-TO-STRING" - "WRITE-SEQUENCE" "Y-OR-N-P" "YES-OR-NO-P" "ZEROP" + "VALUES-LIST" "VARIABLE" "VECTOR" "VECTOR-ELT-WIDTH" "VECTOR-POP" "VECTOR-PUSH" + "VECTOR-PUSH-EXTEND" "VECTORP" "WARN" "WARNING" "WHEN" + "WILD-PATHNAME-P" "WITH-COMPILATION-UNIT" + "WITH-CONDITION-RESTARTS" + "WITH-HASH-TABLE-ITERATOR" "WITH-INPUT-FROM-STRING" + "WITH-OPEN-FILE" "WITH-OPEN-STREAM" "WITH-OUTPUT-TO-STRING" + "WITH-PACKAGE-ITERATOR" "WITH-SIMPLE-RESTART" + "WITH-STANDARD-IO-SYNTAX" "WRITE" "WRITE-BYTE" "WRITE-CHAR" + "WRITE-LINE" "WRITE-STRING" "WRITE-TO-STRING" + "WRITE-SEQUENCE" "Y-OR-N-P" "YES-OR-NO-P" "ZEROP" - "ADD-METHOD" "ALLOCATE-INSTANCE" "CALL-METHOD" - "CALL-NEXT-METHOD" "CHANGE-CLASS" - "COMPUTE-APPLICABLE-METHODS" "DEFCLASS" "DEFGENERIC" - "DEFINE-METHOD-COMBINATION" "DEFMETHOD" "DESCRIBE-OBJECT" - "ENSURE-GENERIC-FUNCTION" - "FIND-METHOD" "FUNCTION-KEYWORDS" - "INITIALIZE-INSTANCE" "INVALID-METHOD-ERROR" - "MAKE-INSTANCE" "MAKE-INSTANCES-OBSOLETE" - "METHOD-COMBINATION-ERROR" "METHOD-QUALIFIERS" "NEXT-METHOD-P" - "NO-APPLICABLE-METHOD" "NO-NEXT-METHOD" "PRINT-OBJECT" - "REINITIALIZE-INSTANCE" "REMOVE-METHOD" "SHARED-INITIALIZE" - "SLOT-BOUNDP" "SLOT-EXISTS-P" "SLOT-MAKUNBOUND" "SLOT-MISSING" - "SLOT-UNBOUND" "SLOT-VALUE" "STANDARD" - "STANDARD-GENERIC-FUNCTION" "STANDARD-METHOD" "STANDARD-OBJECT" - "UPDATE-INSTANCE-FOR-DIFFERENT-CLASS" - "UPDATE-INSTANCE-FOR-REDEFINED-CLASS" "WITH-ACCESSORS" "WITH-SLOTS" - "MAKE-METHOD" "UNBOUND-SLOT" "UNBOUND-SLOT-INSTANCE" - "CELL-ERROR-NAME" - "GET-SETF-EXPANSION" "STYLE-WARNING" - "PRINT-NOT-READABLE-OBJECT" - "DEFINE-SETF-EXPANDER" "PRINT-NOT-READABLE" "METHOD" - "METHOD-COMBINATION" - "MAKE-LOAD-FORM" "MAKE-LOAD-FORM-SAVING-SLOTS")) + "ADD-METHOD" "ALLOCATE-INSTANCE" "CALL-METHOD" + "CALL-NEXT-METHOD" "CHANGE-CLASS" + "COMPUTE-APPLICABLE-METHODS" "DEFCLASS" "DEFGENERIC" + "DEFINE-METHOD-COMBINATION" "DEFMETHOD" "DESCRIBE-OBJECT" + "ENSURE-GENERIC-FUNCTION" + "FIND-METHOD" "FUNCTION-KEYWORDS" + "INITIALIZE-INSTANCE" "INVALID-METHOD-ERROR" + "MAKE-INSTANCE" "MAKE-INSTANCES-OBSOLETE" + "METHOD-COMBINATION-ERROR" "METHOD-QUALIFIERS" "NEXT-METHOD-P" + "NO-APPLICABLE-METHOD" "NO-NEXT-METHOD" "PRINT-OBJECT" + "REINITIALIZE-INSTANCE" "REMOVE-METHOD" "SHARED-INITIALIZE" + "SLOT-BOUNDP" "SLOT-EXISTS-P" "SLOT-MAKUNBOUND" "SLOT-MISSING" + "SLOT-UNBOUND" "SLOT-VALUE" "STANDARD" + "STANDARD-GENERIC-FUNCTION" "STANDARD-METHOD" "STANDARD-OBJECT" + "UPDATE-INSTANCE-FOR-DIFFERENT-CLASS" + "UPDATE-INSTANCE-FOR-REDEFINED-CLASS" "WITH-ACCESSORS" "WITH-SLOTS" + "MAKE-METHOD" "UNBOUND-SLOT" "UNBOUND-SLOT-INSTANCE" + "CELL-ERROR-NAME" + "GET-SETF-EXPANSION" "STYLE-WARNING" + "PRINT-NOT-READABLE-OBJECT" + "DEFINE-SETF-EXPANDER" "PRINT-NOT-READABLE" "METHOD" + "METHOD-COMBINATION" + "MAKE-LOAD-FORM" "MAKE-LOAD-FORM-SAVING-SLOTS")) (defpackage "EVAL" (:export "*EVAL-STACK-TRACE*" "*INTERNAL-APPLY-NODE-TRACE*" @@ -2122,7 +2122,7 @@ "SIMPLE-UNBOXED-ARRAY" "SINGLE-FLOAT-BITS" "SINGLE-FLOAT-EXPONENT" "SINGLE-FLOAT-P" "SINGLE-VALUE-TYPE" "SPECIFIER-TYPE" "STACK-REF" "STD-COMPUTE-CLASS-PRECEDENCE-LIST" - "STREAMLIKE" "STRINGABLE" "STRINGLIKE" + "STREAMLIKE" "SIMPLE-STREAM-BUFFER" "STRINGABLE" "STRINGLIKE" "%INSTANCE-LENGTH" "%INSTANCE-REF" "%INSTANCE-SET" "SYSTEM-AREA-CLEAR" diff --git a/code/fd-stream.lisp b/code/fd-stream.lisp index 21e98038710f47bf2bba82b9622c4a1be72f95fa..535325c8f670cd763b349a6de587fd84cc80895d 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.84 2006/02/27 16:06:34 rtoy Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/fd-stream.lisp,v 1.85 2007/11/05 15:25:03 rtoy Exp $") ;;; ;;; ********************************************************************** ;;; @@ -59,6 +59,83 @@ (pop *available-buffers*) (allocate-system-memory bytes-per-buffer))) +(declaim (inline buffer-sap bref (setf bref) buffer-copy)) + +(defun buffer-sap (thing &optional offset) + (declare (type simple-stream-buffer thing) (type (or fixnum null) offset) + (optimize (speed 3) (space 2) (debug 0) (safety 0) + ;; Suppress the note about having to box up the return: + (ext:inhibit-warnings 3))) + (let ((sap (if (vectorp thing) (sys:vector-sap thing) thing))) + (if offset (sys:sap+ sap offset) sap))) + +(defun bref (buffer index) + (declare (type simple-stream-buffer buffer) + (type (integer 0 #.most-positive-fixnum) index)) + (sys:sap-ref-8 (buffer-sap buffer) index)) + +(defun (setf bref) (octet buffer index) + (declare (type (unsigned-byte 8) octet) + (type simple-stream-buffer buffer) + (type (integer 0 #.most-positive-fixnum) index)) + (setf (sys:sap-ref-8 (buffer-sap buffer) index) octet)) + +(defun buffer-copy (src soff dst doff length) + (declare (type simple-stream-buffer src dst) + (type fixnum soff doff length)) + (sys:without-gcing ;; is this necessary?? + (kernel:system-area-copy (buffer-sap src) (* soff 8) + (buffer-sap dst) (* doff 8) + (* length 8)))) + +#-(or big-endian little-endian) +(eval-when (:compile-toplevel) + (push (c::backend-byte-order c::*target-backend*) *features*)) + +(defun vector-elt-width (vector) + ;; Return octet-width of vector elements + (etypecase vector + ;; (simple-array fixnum (*)) not supported + ;; (simple-array base-char (*)) treated specially; don't call this + ((simple-array bit (*)) 1) + ((simple-array (unsigned-byte 2) (*)) 1) + ((simple-array (unsigned-byte 4) (*)) 1) + ((simple-array (signed-byte 8) (*)) 1) + ((simple-array (unsigned-byte 8) (*)) 1) + ((simple-array (signed-byte 16) (*)) 2) + ((simple-array (unsigned-byte 16) (*)) 2) + ((simple-array (signed-byte 32) (*)) 4) + ((simple-array (unsigned-byte 32) (*)) 4) + ((simple-array single-float (*)) 4) + ((simple-array double-float (*)) 8) + ((simple-array (complex single-float) (*)) 8) + ((simple-array (complex double-float) (*)) 16) + #+long-float + ((simple-array long-float (*)) 10) + #+long-float + ((simple-array (complex long-float) (*)) 20) + #+double-double + ((simple-array double-double-float (*)) 16) + #+double-double + ((simple-array (complex double-double-float) (*)) 32))) + +(defun endian-swap-value (vector endian-swap) + (case endian-swap + (:network-order #+big-endian 0 + #+little-endian (1- (vector-elt-width vector))) + (:byte-8 0) + (:byte-16 1) + (:byte-32 3) + (:byte-64 7) + (:byte-128 15) + ;; additions by Lynn Quam + (:machine-endian 0) + (:big-endian #+big-endian 0 + #+little-endian (1- (vector-elt-width vector))) + (:little-endian #+big-endian (1- (vector-elt-width vector)) + #+little-endian 0) + (otherwise endian-swap))) + ;;;; The FD-STREAM structure. diff --git a/code/stream-vector-io.lisp b/code/stream-vector-io.lisp index c6a5696f07b0db0a9b15556872c47cf4825716df..0294cdd7a49fb23e55898907057d4358d72d15a6 100644 --- a/code/stream-vector-io.lisp +++ b/code/stream-vector-io.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/stream-vector-io.lisp,v 1.2 2005/03/30 15:46:59 rtoy Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/stream-vector-io.lisp,v 1.3 2007/11/05 15:25:03 rtoy Exp $") ;;; ;;; ********************************************************************** ;;; @@ -21,84 +21,12 @@ (declaim (start-block read-vector write-vector)) -;; copied from pcl/simple-streams/internal.lisp - -#-(or big-endian little-endian) -(eval-when (:compile-toplevel) - (push (c::backend-byte-order c::*backend*) *features*)) - -(defun vector-elt-width (vector) - ;; Return octet-width of vector elements - (etypecase vector - ;; (simple-array fixnum (*)) not supported - ;; (simple-array base-char (*)) treated specially; don't call this - (string 1) - ((simple-array bit (*)) 1) - ((simple-array (unsigned-byte 2) (*)) 1) - ((simple-array (unsigned-byte 4) (*)) 1) - ((simple-array (signed-byte 8) (*)) 1) - ((simple-array (unsigned-byte 8) (*)) 1) - ((simple-array (signed-byte 16) (*)) 2) - ((simple-array (unsigned-byte 16) (*)) 2) - ((simple-array (signed-byte 32) (*)) 4) - ((simple-array (unsigned-byte 32) (*)) 4) - ((simple-array single-float (*)) 4) - ((simple-array double-float (*)) 8) - ((simple-array (complex single-float) (*)) 8) - ((simple-array (complex double-float) (*)) 16))) - -;;; I have extended the permitted values of ENDIAN-SWAP to include -;;; :MACHINE-ENDIAN, :BIG-ENDIAN and :LITTLE-ENDIAN, and describe the byte order -;;; in the stream. -;;; :NETWORK-ORDER and :BIG-ENDIAN are the same. -;;; :MACHINE-ENDIAN and :BYTE-8 are the same. -(defun endian-swap-value (vector endian-swap) - (case endian-swap - ((:big-endian :network-order) - #+big-endian 0 - #+little-endian (1- (vector-elt-width vector))) - (:little-endian - #+little-endian 0 - #+big-endian (1- (vector-elt-width vector))) - (:machine-endian 0) - (:byte-8 0) - (:byte-16 1) - (:byte-32 3) - (:byte-64 7) - (:byte-128 15) - (otherwise endian-swap))) - -(declaim (inline buffer-sap bref (setf bref))) - -(deftype simple-stream-buffer () - '(or sys:system-area-pointer (kernel:simple-unboxed-array (*)))) - -(defun buffer-sap (thing &optional offset) - (declare (type simple-stream-buffer thing) (type (or fixnum null) - offset) - (optimize (speed 3) (space 2) (debug 0) (safety 0) - ;; Suppress the note about having to box up the return: - (ext:inhibit-warnings 3))) - (let ((sap (if (vectorp thing) (sys:vector-sap thing) thing))) - (if offset (sys:sap+ sap offset) sap))) - -(defun bref (buffer index) - (declare (type simple-stream-buffer buffer) - (type (integer 0 #.most-positive-fixnum) index)) - (sys:sap-ref-8 (buffer-sap buffer) index)) - -(defun (setf bref) (octet buffer index) - (declare (type (unsigned-byte 8) octet) - (type simple-stream-buffer buffer) - (type (integer 0 #.most-positive-fixnum) index)) - (setf (sys:sap-ref-8 (buffer-sap buffer) index) octet)) - ;;; ENDIAN SWAPPING ;;; Not sure that this is really need, but for completeness ... (defun swap-endians-456 (vector start end endian) (declare (optimize (speed 3)(safety 0))) - (declare (type simple-stream-buffer vector)) + (declare (type kernel:simple-stream-buffer vector)) (declare (fixnum start end endian)) (loop for i fixnum from (* 8 start) below (* 8 end) by 8 for b0 fixnum = (bref vector i) @@ -232,7 +160,3 @@ (declaim (end-block)) ; READ-VECTOR WRITE-VECTOR block - - - - diff --git a/code/type.lisp b/code/type.lisp index 711af784bc5a9b860a81fb02a164a2f676be3378..7733f4e28e7c378a61e4f4c1fec294cca42fabd5 100644 --- a/code/type.lisp +++ b/code/type.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/type.lisp,v 1.74 2006/07/18 18:31:38 rtoy Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/type.lisp,v 1.75 2007/11/05 15:25:03 rtoy Exp $") ;;; ;;; ********************************************************************** ;;; @@ -3564,6 +3564,10 @@ ;;; A valid argument to a stream function... (deftype streamlike () '(or stream (member nil t))) ;;; +;;; A stream buffer, for simple-streams and read/write-vector +(deftype simple-stream-buffer () + '(or sys:system-area-pointer (simple-unboxed-array (*)))) +;;; ;;; A thing that can be passed to funcall & friends. (deftype callable () '(or function symbol)) diff --git a/pcl/simple-streams/classes.lisp b/pcl/simple-streams/classes.lisp index fd69135c390552df5e6d1c5d400c4f895ba12f8f..eab4b67f996f808ff8ed57b085479c63f4833fba 100644 --- a/pcl/simple-streams/classes.lisp +++ b/pcl/simple-streams/classes.lisp @@ -5,7 +5,7 @@ ;;; domain. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/simple-streams/classes.lisp,v 1.5 2005/10/06 13:49:26 rtoy Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/simple-streams/classes.lisp,v 1.6 2007/11/05 15:25:04 rtoy Exp $") ;;; ;;; ********************************************************************** ;;; @@ -20,8 +20,8 @@ ;;;; Types for buffer and strategy functions -(deftype simple-stream-buffer () - '(or sys:system-area-pointer (kernel:simple-unboxed-array (*)))) +;;(deftype simple-stream-buffer () +;; '(or sys:system-area-pointer (kernel:simple-unboxed-array (*)))) (deftype blocking () `(member t nil :bnb)) @@ -80,7 +80,7 @@ :accessor stream-line-column) (record-end :initform nil :type (or null fixnum)) - (buffer :initform nil :type (or simple-stream-buffer null)) + (buffer :initform nil :type (or kernel:simple-stream-buffer null)) (buffpos :initform 0 :type fixnum) (buffer-ptr :initform 0 :type fixnum) (buf-len :initform 0 :type fixnum) @@ -92,7 +92,7 @@ ((mode :initform 0 :type fixnum))) (def-stream-class dual-channel-simple-stream (simple-stream) - ((out-buffer :initform nil :type (or simple-stream-buffer null)) + ((out-buffer :initform nil :type (or kernel:simple-stream-buffer null)) (outpos :initform 0 :type fixnum) (max-out-pos :initform 0 :type fixnum) (mode :initform 0 :type fixnum))) diff --git a/pcl/simple-streams/direct.lisp b/pcl/simple-streams/direct.lisp index 35e25fec894f0db49b78118ec037fa5cbdf5a07c..521637a018e6a7128cbf8db1c79f8958da1a9682 100644 --- a/pcl/simple-streams/direct.lisp +++ b/pcl/simple-streams/direct.lisp @@ -5,7 +5,7 @@ ;;; domain. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/simple-streams/direct.lisp,v 1.2 2003/06/07 17:56:28 toy Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/simple-streams/direct.lisp,v 1.3 2007/11/05 15:25:04 rtoy Rel $") ;;; ;;; ********************************************************************** ;;; @@ -24,7 +24,7 @@ ()) (def-stream-class buffer-output-simple-stream (direct-simple-stream) - ((out-buffer :initform nil :type (or simple-stream-buffer null)) + ((out-buffer :initform nil :type (or kernel:simple-stream-buffer null)) (outpos :initform 0 :type fixnum) (max-out-pos :initform 0 :type fixnum))) diff --git a/pcl/simple-streams/internal.lisp b/pcl/simple-streams/internal.lisp index f90c3f9644fd6879cad5f141ae32f3ccb03b7b6c..d65cc3010e23de57be5d0b8fbdf288a4e8b03423 100644 --- a/pcl/simple-streams/internal.lisp +++ b/pcl/simple-streams/internal.lisp @@ -5,7 +5,7 @@ ;;; domain. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/simple-streams/internal.lisp,v 1.6 2007/10/25 15:17:07 rtoy Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/simple-streams/internal.lisp,v 1.7 2007/11/05 15:25:04 rtoy Exp $") ;;; ;;; ********************************************************************** ;;; @@ -13,35 +13,7 @@ (in-package "STREAM") -(declaim (inline buffer-sap bref (setf bref) buffer-copy - allocate-buffer free-buffer)) - -(defun buffer-sap (thing &optional offset) - (declare (type simple-stream-buffer thing) (type (or fixnum null) offset) - (optimize (speed 3) (space 2) (debug 0) (safety 0) - ;; Suppress the note about having to box up the return: - (ext:inhibit-warnings 3))) - (let ((sap (if (vectorp thing) (sys:vector-sap thing) thing))) - (if offset (sys:sap+ sap offset) sap))) - -(defun bref (buffer index) - (declare (type simple-stream-buffer buffer) - (type (integer 0 #.most-positive-fixnum) index)) - (sys:sap-ref-8 (buffer-sap buffer) index)) - -(defun (setf bref) (octet buffer index) - (declare (type (unsigned-byte 8) octet) - (type simple-stream-buffer buffer) - (type (integer 0 #.most-positive-fixnum) index)) - (setf (sys:sap-ref-8 (buffer-sap buffer) index) octet)) - -(defun buffer-copy (src soff dst doff length) - (declare (type simple-stream-buffer src dst) - (type fixnum soff doff length)) - (sys:without-gcing ;; is this necessary?? - (kernel:system-area-copy (buffer-sap src) (* soff 8) - (buffer-sap dst) (* doff 8) - (* length 8)))) +(declaim (inline allocate-buffer free-buffer)) (defun allocate-buffer (size) (if (= size lisp::bytes-per-buffer) @@ -89,41 +61,6 @@ -#-(or big-endian little-endian) -(eval-when (:compile-toplevel) - (push (c::backend-byte-order c::*target-backend*) *features*)) - -(defun vector-elt-width (vector) - ;; Return octet-width of vector elements - (etypecase vector - ;; (simple-array fixnum (*)) not supported - ;; (simple-array base-char (*)) treated specially; don't call this - ((simple-array bit (*)) 1) - ((simple-array (unsigned-byte 2) (*)) 1) - ((simple-array (unsigned-byte 4) (*)) 1) - ((simple-array (signed-byte 8) (*)) 1) - ((simple-array (unsigned-byte 8) (*)) 1) - ((simple-array (signed-byte 16) (*)) 2) - ((simple-array (unsigned-byte 16) (*)) 2) - ((simple-array (signed-byte 32) (*)) 4) - ((simple-array (unsigned-byte 32) (*)) 4) - ((simple-array single-float (*)) 4) - ((simple-array double-float (*)) 8) - ((simple-array (complex single-float) (*)) 8) - ((simple-array (complex double-float) (*)) 16))) - -(defun endian-swap-value (vector endian-swap) - (case endian-swap - (:network-order #+big-endian 0 - #+little-endian (1- (vector-elt-width vector))) - (:byte-8 0) - (:byte-16 1) - (:byte-32 3) - (:byte-64 7) - (:byte-128 15) - (otherwise endian-swap))) - - #+(or) (defun %read-vector (vector stream start end endian-swap blocking) (declare (type (kernel:simple-unboxed-array (*)) vector) @@ -138,7 +75,7 @@ (defun read-octets (stream buffer start end blocking) (declare (type simple-stream stream) - (type (or null simple-stream-buffer) buffer) + (type (or null kernel:simple-stream-buffer) buffer) (type fixnum start) (type (or null fixnum) end) (optimize (speed 3) (space 2) (safety 0) (debug 0))) @@ -196,7 +133,7 @@ (defun write-octets (stream buffer start end blocking) (declare (type simple-stream stream) - (type simple-stream-buffer buffer) + (type kernel:simple-stream-buffer buffer) (type fixnum start) (type (or null fixnum) end)) (with-stream-class (simple-stream stream) @@ -250,7 +187,7 @@ (start (second list)) (end (third list)) (len (- end start))) - (declare (type simple-stream-buffer buffer) + (declare (type kernel:simple-stream-buffer buffer) (type lisp::index start end len)) (tagbody again (multiple-value-bind (bytes errno) @@ -270,7 +207,7 @@ (defun queue-write (stream buffer start end) ;; Queue a write; return T if buffer needs changing, NIL otherwise (declare (type simple-stream stream) - (type simple-stream-buffer buffer) + (type kernel:simple-stream-buffer buffer) (type lisp::index start end)) (with-stream-class (simple-stream stream) (when (sm handler stream) diff --git a/pcl/simple-streams/string.lisp b/pcl/simple-streams/string.lisp index 4db8be402f83eb63da29a1e7afb05e06be13b4ec..909436057d16210e71862df68795e057ce65ba18 100644 --- a/pcl/simple-streams/string.lisp +++ b/pcl/simple-streams/string.lisp @@ -5,7 +5,7 @@ ;;; domain. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/simple-streams/string.lisp,v 1.3 2003/06/26 13:27:43 toy Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/simple-streams/string.lisp,v 1.4 2007/11/05 15:25:04 rtoy Rel $") ;;; ;;; ********************************************************************** ;;; @@ -21,7 +21,7 @@ ()) (def-stream-class string-output-simple-stream (string-simple-stream) - ((out-buffer :initform nil :type (or simple-stream-buffer null)) + ((out-buffer :initform nil :type (or kernel:simple-stream-buffer null)) (outpos :initform 0 :type fixnum) (max-out-pos :initform 0 :type fixnum)))