Skip to content

Instantly share code, notes, and snippets.

@danlentz
Last active December 11, 2015 16:58
Show Gist options
  • Save danlentz/4631003 to your computer and use it in GitHub Desktop.
Save danlentz/4631003 to your computer and use it in GitHub Desktop.
Paul khong's mmap file as array
;; 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