(defun buffer-copy (src soff dst doff length)
(declare (type simple-stream-buffer src dst)
(type fixnum soff doff length))
- (sb-sys:without-gcing ;; is this necessary??
+ ;; FIXME: Should probably be with-pinned-objects
+ (sb-sys:without-gcing
(sb-kernel:system-area-ub8-copy (buffer-sap src) soff
(buffer-sap dst) doff
length)))
(defun allocate-buffer (size)
- (if (= size sb-impl::bytes-per-buffer)
- (sb-impl::next-available-buffer)
- (make-array size :element-type '(unsigned-byte 8))))
+ (make-array size :element-type '(unsigned-byte 8)))
(defun free-buffer (buffer)
- (when (sb-sys:system-area-pointer-p buffer)
- (push buffer sb-impl::*available-buffers*))
+ (sb-int:aver (typep buffer '(simple-array (unsigned-byte 8) (*))))
t)
-
(defun make-control-table (&rest inits)
(let ((table (make-array 32 :initial-element nil)))
(do* ((char (pop inits) (pop inits))
(:io (values t t sb-unix:o_rdwr))
(:probe (values t nil sb-unix:o_rdonly)))
(declare (type sb-int:index mask))
- (let ((name (cond ((sb-int:unix-namestring pathname input))
- ((and input (eq if-does-not-exist :create))
- (sb-int:unix-namestring pathname nil))
- ((and (eq direction :io) (not if-does-not-exist-given))
- (sb-int:unix-namestring pathname nil)))))
+ (let* ((phys (sb-int:physicalize-pathname (merge-pathnames pathname)))
+ (true (probe-file phys))
+ (name (cond (true
+ (sb-ext:native-namestring true :as-file t))
+ ((or (not input)
+ (and input (eq if-does-not-exist :create))
+ (and (eq direction :io) (not if-does-not-exist-given)))
+ (sb-ext:native-namestring phys :as-file t)))))
;; Process if-exists argument if we are doing any output.
(cond (output
(unless if-exists-given