projects
/
sbcl.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
don't stack-allocate specialized vectors on non-conservtive control stacks
[sbcl.git]
/
src
/
code
/
octets.lisp
diff --git
a/src/code/octets.lisp
b/src/code/octets.lisp
index
0d155f1
..
4a98d80
100644
(file)
--- a/
src/code/octets.lisp
+++ b/
src/code/octets.lisp
@@
-38,12
+38,6
@@
one-past-the-end"
(octets-encoding-error-position c)))
(octets-encoding-error-external-format c)))))
(octets-encoding-error-position c)))
(octets-encoding-error-external-format c)))))
-(defun read-replacement-character ()
- (format *query-io*
- "Replacement byte, bytes, character, or string (evaluated): ")
- (finish-output *query-io*)
- (list (eval (read *query-io*))))
-
(defun encoding-error (external-format string pos)
(restart-case
(error 'octets-encoding-error
(defun encoding-error (external-format string pos)
(restart-case
(error 'octets-encoding-error
@@
-52,7
+46,10
@@
one-past-the-end"
:position pos)
(use-value (replacement)
:report "Supply a set of bytes to use in place of the invalid one."
:position pos)
(use-value (replacement)
:report "Supply a set of bytes to use in place of the invalid one."
- :interactive read-replacement-character
+ :interactive
+ (lambda ()
+ (read-evaluated-form
+ "Replacement byte, bytes, character, or string (evaluated): "))
(typecase replacement
((unsigned-byte 8)
(make-array 1 :element-type '(unsigned-byte 8) :initial-element replacement))
(typecase replacement
((unsigned-byte 8)
(make-array 1 :element-type '(unsigned-byte 8) :initial-element replacement))
@@
-103,11
+100,6
@@
one-past-the-end"
(define-condition malformed-ascii (octet-decoding-error) ())
(define-condition malformed-ascii (octet-decoding-error) ())
-(defun read-replacement-string ()
- (format *query-io* "Enter a replacement string designator (evaluated): ")
- (finish-output *query-io*)
- (list (eval (read *query-io*))))
-
(defun decoding-error (array start end external-format reason pos)
(restart-case
(error reason
(defun decoding-error (array start end external-format reason pos)
(restart-case
(error reason
@@
-118,7
+110,10
@@
one-past-the-end"
:pos pos)
(use-value (s)
:report "Supply a replacement string designator."
:pos pos)
(use-value (s)
:report "Supply a replacement string designator."
- :interactive read-replacement-string
+ :interactive
+ (lambda ()
+ (read-evaluated-form
+ "Enter a replacement string designator (evaluated): "))
(string s))))
;;; Utilities used in both to-string and to-octet conversions
(string s))))
;;; Utilities used in both to-string and to-octet conversions
@@
-183,9
+178,8
@@
one-past-the-end"
finally (return elements)))
;; Find the smallest character code such that the corresponding
;; byte is != to the code.
finally (return elements)))
;; Find the smallest character code such that the corresponding
;; byte is != to the code.
- (lowest-non-equivalent-code (position-if-not #'(lambda (pair)
- (apply #'= pair))
- pairs))
+ (lowest-non-equivalent-code
+ (caar (sort (copy-seq exceptions) #'< :key #'car)))
;; Sort them for our lookup table.
(sorted-pairs (sort (subseq pairs lowest-non-equivalent-code)
#'< :key #'car))
;; Sort them for our lookup table.
(sorted-pairs (sort (subseq pairs lowest-non-equivalent-code)
#'< :key #'car))
@@
-199,9
+193,9
@@
one-past-the-end"
,(make-array 256 :element-type t #+nil 'char-code
:initial-contents (loop for byte below 256
collect
,(make-array 256 :element-type t #+nil 'char-code
:initial-contents (loop for byte below 256
collect
- (let ((exception (cadr (assoc byte exceptions))))
+ (let ((exception (cdr (assoc byte exceptions))))
(if exception
(if exception
- exception
+ (car exception)
byte)))))
(code-to-byte-table
,(make-array (length sorted-lookup-table)
byte)))))
(code-to-byte-table
,(make-array (length sorted-lookup-table)
@@
-392,8
+386,7
@@
one-past-the-end"
:check-fill-pointer t)
(declare (type (simple-array (unsigned-byte 8) (*)) vector))
(let ((ef (maybe-defaulted-external-format external-format)))
:check-fill-pointer t)
(declare (type (simple-array (unsigned-byte 8) (*)) vector))
(let ((ef (maybe-defaulted-external-format external-format)))
- (funcall (symbol-function (sb!impl::ef-octets-to-string-sym ef))
- vector start end))))
+ (funcall (sb!impl::ef-octets-to-string-fun ef) vector start end))))
(defun string-to-octets (string &key (external-format :default)
(start 0) end null-terminate)
(defun string-to-octets (string &key (external-format :default)
(start 0) end null-terminate)
@@
-404,8
+397,8
@@
one-past-the-end"
:check-fill-pointer t)
(declare (type simple-string string))
(let ((ef (maybe-defaulted-external-format external-format)))
:check-fill-pointer t)
(declare (type simple-string string))
(let ((ef (maybe-defaulted-external-format external-format)))
- (funcall (symbol-function (sb!impl::ef-string-to-octets-sym ef))
- string start end (if null-terminate 1 0)))))
+ (funcall (sb!impl::ef-string-to-octets-fun ef) string start end
+ (if null-terminate 1 0)))))
#!+sb-unicode
(defvar +unicode-replacement-character+ (string (code-char #xfffd)))
#!+sb-unicode
(defvar +unicode-replacement-character+ (string (code-char #xfffd)))