Last active
December 11, 2015 16:58
-
-
Save danlentz/4631003 to your computer and use it in GitHub Desktop.
Paul khong's mmap file as array
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
;; Abuse SBCL's runtime as a portability layer. None of this is portable | |
;; anyway. | |
(define-alien-routine os-allocate (* t) (size unsigned-long)) | |
(define-alien-routine os-map (* t) | |
(fd int) (offset int) (addr (* t)) (size unsigned-long)) | |
(define-alien-routine os-invalidate void (addr (* t)) (size unsigned-long)) | |
(defun map-file (path address size &optional offset) | |
(with-open-file (s path) | |
(assert (sb-sys:fd-stream-p s)) | |
(let* ((fd (sb-sys:fd-stream-fd s)) | |
(address (if (sb-sys:system-area-pointer-p address) | |
address | |
(alien-sap address))) | |
(ret (os-map fd (or offset 0) address size))) | |
(assert (sb-sys:sap= (alien-sap ret) address)) | |
ret))) | |
(defvar *page-size* (ash 1 12)) | |
(defun map-file-as-array (path eltype length &optional offset) | |
(let* ((saetp (or (sb-c::find-saetp eltype) | |
(error "Unknown specialised array element type ~S" eltype))) | |
(n-bits (sb-vm:saetp-n-bits saetp)) | |
(padding (sb-vm:saetp-n-pad-elements saetp)) | |
(typecode (sb-vm:saetp-typecode saetp)) | |
(data-size (* *page-size* (ceiling (* n-bits (+ length padding)) (* 8 *page-size*)))) | |
(space (alien-sap (os-allocate (+ data-size *page-size*)))) | |
(header (sb-sys:sap+ space (- *page-size* (* 2 sb-vm:n-word-bytes))))) | |
(map-file path (sb-sys:sap+ space *page-size*) data-size offset) | |
(setf (sb-sys:sap-ref-word header 0) typecode | |
(sb-sys:sap-ref-word header sb-vm:n-word-bytes) | |
(ash length sb-vm:n-fixnum-tag-bits)) | |
(sb-kernel:%make-lisp-obj (logior sb-vm:other-pointer-lowtag | |
(sb-sys:sap-int header))))) | |
(defun unmap-file-array (array) | |
(check-type array (simple-array * 1)) | |
(let* ((aet (array-element-type array)) | |
(saetp (or (sb-c::find-saetp aet) | |
(error "What's this AET: ~S?" aet))) | |
(length (length array)) | |
(n-bits (sb-vm:saetp-n-bits saetp)) | |
(padding (sb-vm:saetp-n-pad-elements saetp)) | |
(total-size (* *page-size* | |
(1+ (ceiling (* n-bits (+ length padding)) | |
(* 8 *page-size*))))) | |
(base-addr (* *page-size* (truncate (sb-kernel:get-lisp-obj-address array) | |
*page-size*)))) | |
(os-invalidate (sb-sys:int-sap base-addr) | |
total-size))) |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment