mmap.lisp (2091B)
1 (in-package :cl-grep) 2 3 (defparameter +chunk-size+ 4000) 4 5 (defstruct mfile 6 name 7 ptr fd size 8 offset 9 buf 10 extra) 11 12 (defun init-mfile (path) 13 (let ((mf (make-mfile :name path :buf nil :offset 0 :extra nil))) 14 (multiple-value-bind (addr fd size) (mmap:mmap path 15 :open '(:read :direct) 16 :mmap '(:private :populate)) 17 (setf (mfile-ptr mf) addr) 18 (setf (mfile-fd mf) fd) 19 (setf (mfile-size mf) size)) 20 mf)) 21 22 (defun format-buffer (mf raw) 23 (with-slots (ptr size offset buf extra) mf 24 (setf buf (uiop:split-string raw :separator '(#\Newline))) 25 (when extra 26 (setf (nth 0 buf) (concatenate 'string extra (nth 0 buf))) 27 (lo "Using extra from previous batch: ~a. New starter: ~a" extra (nth 0 buf)) 28 (setf extra nil)) 29 (when (not (eq #\Newline (char raw (- (length raw) 1)))) 30 (lo "Last line is not clean. Marking as extra: ~a" (car (last buf))) 31 (setf extra (car (last buf)))) 32 ;; always pop-off the last entry 33 ;; in normal cases that's the extra 34 ;; in case of newline being at the very end, 35 ;; there is a spurious empty line otherwise 36 (if (> (length buf) 1) 37 (nbutlast buf) 38 (setf buf nil)))) 39 40 (defun update-buffer (mf) 41 (with-slots (ptr size offset buf) mf 42 (when (eq offset size) 43 (setf buf (list :eof)) 44 (return-from update-buffer nil)) 45 (let* ((num (if (> (+ offset +chunk-size+) size) 46 (- size offset) 47 +chunk-size+)) 48 (nptr (cffi:inc-pointer ptr offset)) 49 (data (cffi:foreign-string-to-lisp nptr :count num :encoding :utf-8))) 50 (incf offset num) 51 (format-buffer mf data)))) 52 53 (defun fetch-line (mf) 54 (with-slots (ptr size offset buf) mf 55 ;; in case the line is too long that it doesn't full the buffer immediately 56 (loop while (not buf) 57 do (update-buffer mf)) 58 (lo "Item in buf: ~a" (car buf)) 59 (pop buf))) 60 61 (defun end-mfile (mf) 62 (mmap:munmap (mfile-ptr mf) (mfile-fd mf) (mfile-size mf)))