Skip to content
Snippets Groups Projects
Commit b120f0fc authored by wlott's avatar wlott
Browse files

Deleted defuns of allocate-storage and deallocate-storage and replaced

their uses with system:{allocate,deallocate}-system-memory.
parent 2f3d7e8d
No related branches found
No related tags found
No related merge requests found
...@@ -278,7 +278,7 @@ ...@@ -278,7 +278,7 @@
(multiple-value-bind (data byte-count mode) (multiple-value-bind (data byte-count mode)
(read-file fd ses-name1) (read-file fd ses-name1)
(unwind-protect (write-file ses-name2 data byte-count mode) (unwind-protect (write-file ses-name2 data byte-count mode)
(dispose-storage data byte-count))) (system:deallocate-system-memory data byte-count)))
(close-file fd))) (close-file fd)))
(set-write-date ses-name2 secs1) (set-write-date ses-name2 secs1)
(funcall *report-function* "~&~S ==>~% ~S~%" ses-name1 ses-name2)) (funcall *report-function* "~&~S ==>~% ~S~%" ses-name1 ses-name2))
...@@ -576,23 +576,15 @@ ...@@ -576,23 +576,15 @@
(declare (ignore ino nlink uid gid rdev)) (declare (ignore ino nlink uid gid rdev))
(unless winp (funcall *error-function* (unless winp (funcall *error-function*
"Opening ~S failed: ~A." ses-name dev-or-err)) "Opening ~S failed: ~A." ses-name dev-or-err))
(let ((storage (lisp::fixnum-to-sap (allocate-storage size)))) (let ((storage (system:allocate-system-memory size)))
(multiple-value-bind (read-bytes err) (multiple-value-bind (read-bytes err)
(mach:unix-read fd storage size) (mach:unix-read fd storage size)
(when (or (null read-bytes) (not (= size read-bytes))) (when (or (null read-bytes) (not (= size read-bytes)))
(dispose-storage storage size) (system:deallocate-system-memory storage size)
(funcall *error-function* (funcall *error-function*
"Reading file ~S failed: ~A." ses-name err))) "Reading file ~S failed: ~A." ses-name err)))
(values storage size mode)))) (values storage size mode))))
(defun dispose-storage (storage size)
(mach::vm_deallocate lisp::*task-self*
(lisp::sap-to-fixnum storage)
size))
(defun allocate-storage (size)
(lisp::do-validate 0 size -1))
(defun write-file (ses-name data byte-count mode) (defun write-file (ses-name data byte-count mode)
(multiple-value-bind (fd err) (mach:unix-creat ses-name #o644) (multiple-value-bind (fd err) (mach:unix-creat ses-name #o644)
(unless fd (unless fd
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment