diff --git a/hemlock/files.lisp b/hemlock/files.lisp index 1f3d1dde8da4b3b60b9c0383d0106491fc6532b1..91e909872e4438cd35f885a39aea96b269aceb2e 100644 --- a/hemlock/files.lisp +++ b/hemlock/files.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/hemlock/files.lisp,v 1.4 1994/10/31 04:50:12 ram Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/hemlock/files.lisp,v 1.5 2009/06/29 21:10:48 rtoy Rel $") ;;; ;;; ********************************************************************** ;;; @@ -48,7 +48,7 @@ (multiple-value-bind (fd err) (unix:unix-open name unix:o_rdonly 0) (when fd (multiple-value-bind (res dev ino mode nlnk uid gid rdev len) - (unix:unix-fstat fd) + (unix:unix-fstat fd) (declare (ignore ino mode nlnk uid gid rdev)) (cond ((null res) (setq err dev)) @@ -56,7 +56,7 @@ (setf sap (system:allocate-system-memory len)) (setf size len) (multiple-value-bind - (bytes err3) + (bytes err3) (unix:unix-read fd sap len) (if (or (null bytes) (not (= len bytes))) (setq err err3) @@ -74,7 +74,7 @@ (modifying-buffer buffer) (let* ((len (or index size)) (chars (make-string len))) - (%primitive byte-blt sap 0 chars 0 len) + (%sp-byte-blt sap 0 chars 0 len) (insert-string mark chars)) (when index (insert-character mark #\newline) @@ -89,7 +89,7 @@ (chars (make-string length)) (line (mark-line mark))) (declare (fixnum length)) - (%primitive byte-blt sap old-index chars 0 length) + (%sp-byte-blt sap old-index chars 0 length) (insert-string mark chars) (setf (line-next previous) line) (setf (line-previous line) previous) @@ -115,7 +115,7 @@ (defun read-buffered-line (line) (let* ((len (line-buffered-p line)) (chars (make-string len))) - (%primitive byte-blt (line-%chars line) 0 chars 0 len) + (%sp-byte-blt (line-%chars line) 0 chars 0 len) (setf (line-buffered-p line) nil) (setf (line-chars line) chars))) @@ -178,10 +178,9 @@ (macrolet ((chars (line) `(if (line-buffered-p ,line) (line-%chars ,line) - (line-chars ,line)))) - (system:%primitive byte-blt - (chars start-line) start-charpos - sap 0 first-length) + (line-chars ,line)))) + (system:%sp-byte-blt (chars start-line) start-charpos + sap 0 first-length) (setf (system:sap-ref-8 sap first-length) (char-code #\newline)) (let ((offset (1+ first-length))) @@ -189,17 +188,15 @@ (line-next line))) ((eq line end-line)) (let ((end (+ offset (line-length line)))) - (system:%primitive byte-blt - (chars line) 0 - sap offset end) + (system:%sp-byte-blt (chars line) 0 + sap offset end) (setf (system:sap-ref-8 sap end) (char-code #\newline)) (setf offset (1+ end)))) (unless (zerop end-charpos) - (system:%primitive byte-blt - (chars end-line) 0 - sap offset - (+ offset end-charpos)))) + (system:%sp-byte-blt (chars end-line) 0 + sap offset + (+ offset end-charpos)))) (multiple-value-bind (okay errno) (unix:unix-write (system:fd-stream-fd file) diff --git a/hemlock/hacks.lisp b/hemlock/hacks.lisp index 40fdf6f4220e72e6e17d9bb1a92122c7f26da944..1d7ce1f859a926830abfa0fd02558e7fd754782f 100644 --- a/hemlock/hacks.lisp +++ b/hemlock/hacks.lisp @@ -4,10 +4,32 @@ #-unicode (%primitive byte-blt src start dest dstart end) #+unicode - (loop for di of-type fixnum from dstart below end - for si of-type fixnum from start - do - (setf (aref dest di) (aref src si)))) + (etypecase src + (system:system-area-pointer + (etypecase dest + (system:system-area-pointer + (loop for di of-type fixnum from dstart below end + for si of-type fixnum from start + do + (setf (sys:sap-ref-8 dest di) (sys:sap-ref-8 src si)))) + (string + (loop for di of-type fixnum from dstart below end + for si of-type fixnum from start + do + (setf (aref dest di) (code-char (sys:sap-ref-8 src si))))))) + (string + (etypecase dest + (system:system-area-pointer + (loop for di of-type fixnum from dstart below end + for si of-type fixnum from start + do + (setf (sys:sap-ref-8 dest di) (logand #xff (char-code (aref src si)))))) + (string + (loop for di of-type fixnum from dstart below end + for si of-type fixnum from start + do + (setf (aref dest di) (aref src si)))))))) + (defun lisp::sap-to-fixnum (x) (sap-int x)) (defun lisp::fixnum-to-sap (x) (int-sap x))