1 ;;; vlf-tune.el --- VLF tuning operations -*- lexical-binding: t -*-
3 ;; Copyright (C) 2014 Free Software Foundation, Inc.
5 ;; Keywords: large files, batch size, performance
6 ;; Author: Andrey Kotlarski <m00naticus@gmail.com>
7 ;; URL: https://github.com/m00natic/vlfi
9 ;; This file is free software; you can redistribute it and/or modify
10 ;; it under the terms of the GNU General Public License as published by
11 ;; the Free Software Foundation; either version 3, or (at your option)
14 ;; This file is distributed in the hope that it will be useful,
15 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
17 ;; GNU General Public License for more details.
19 ;; You should have received a copy of the GNU General Public License
20 ;; along with GNU Emacs; see the file COPYING. If not, write to
21 ;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
22 ;; Boston, MA 02111-1307, USA.
25 ;; This package provides wrappers for basic chunk operations that add
26 ;; profiling and automatic tuning of `vlf-batch-size'.
30 (defgroup vlf nil "View Large Files in Emacs."
31 :prefix "vlf-" :group 'files)
33 (defcustom vlf-batch-size 1000000
34 "Defines how large each batch of file data initially is (in bytes)."
35 :group 'vlf :type 'integer)
36 (put 'vlf-batch-size 'permanent-local t)
38 (defcustom vlf-tune-enabled t
39 "Whether to allow automatic change of batch size.
40 If nil, completely disable. If `stats', maintain measure statistics,
41 but don't change batch size. If t, measure and change."
42 :group 'vlf :type '(choice (const :tag "Enabled" t)
43 (const :tag "Just statistics" stats)
44 (const :tag "Disabled" nil)))
46 (defvar vlf-file-size 0 "Total size in bytes of presented file.")
47 (make-variable-buffer-local 'vlf-file-size)
48 (put 'vlf-file-size 'permanent-local t)
50 (defun vlf-tune-ram-size ()
51 "Try to determine RAM size in bytes."
52 (if (executable-find "free")
53 (let* ((free (shell-command-to-string "free"))
54 (match-from (string-match "[[:digit:]]+" free)))
56 (* 1000 (string-to-number (substring free match-from
59 (defcustom vlf-tune-max (let ((ram-size (vlf-tune-ram-size)))
62 large-file-warning-threshold))
63 "Maximum batch size in bytes when auto tuning."
64 :group 'vlf :type 'integer)
66 (defcustom vlf-tune-step (/ vlf-tune-max 1000)
67 "Step used for tuning in bytes."
68 :group 'vlf :type 'integer)
70 (defcustom vlf-tune-load-time 1.0
71 "How many seconds should batch take to load for best user experience."
72 :group 'vlf :type 'float)
74 (defvar vlf-tune-insert-bps nil
75 "Vector of bytes per second insert measurements.")
76 (make-variable-buffer-local 'vlf-tune-insert-bps)
77 (put 'vlf-tune-insert-bps 'permanent-local t)
79 (defvar vlf-tune-insert-raw-bps nil
80 "Vector of bytes per second non-decode insert measurements.")
81 (make-variable-buffer-local 'vlf-tune-insert-raw-bps)
82 (put 'vlf-tune-insert-raw-bps 'permanent-local t)
84 (defvar vlf-tune-encode-bps nil
85 "Vector of bytes per second encode measurements.")
86 (make-variable-buffer-local 'vlf-tune-encode-bps)
87 (put 'vlf-tune-encode-bps 'permanent-local t)
89 (defvar vlf-tune-write-bps nil
90 "Vector of bytes per second write measurements.")
91 (make-variable-buffer-local 'vlf-tune-write-bps)
92 (put 'vlf-tune-write-bps 'permanent-local t)
94 (defvar vlf-tune-hexl-bps nil
95 "Vector of bytes per second hexlify measurements.")
96 (make-variable-buffer-local 'vlf-tune-hexl-bps)
97 (put 'vlf-tune-hexl-bps 'permanent-local t)
99 (defvar vlf-tune-dehexlify-bps nil
100 "Vector of bytes per second dehexlify measurements.")
101 (make-variable-buffer-local 'vlf-tune-dehexlify-bps)
102 (put 'vlf-tune-dehexlify-bps 'permanent-local t)
104 (defun vlf-tune-closest-index (size)
105 "Get closest measurement index corresponding to SIZE."
106 (let ((step (float vlf-tune-step)))
107 (max 0 (1- (min (round size step) (round vlf-tune-max step))))))
109 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
112 (defun vlf-tune-initialize-measurement ()
113 "Initialize measurement vector."
114 (make-local-variable 'vlf-tune-max)
115 (make-local-variable 'vlf-tune-step)
116 (make-vector (/ vlf-tune-max vlf-tune-step) nil))
118 (defmacro vlf-tune-add-measurement (vec size time)
119 "Add at an appropriate position in VEC new SIZE TIME measurement.
120 VEC is a vector of (mean time . count) elements ordered by size."
121 `(when (and vlf-tune-enabled (not (zerop ,size)))
122 (or ,vec (setq ,vec (vlf-tune-initialize-measurement)))
123 (let* ((idx (vlf-tune-closest-index ,size))
124 (existing (aref ,vec idx)))
125 (aset ,vec idx (if (consp existing)
126 (let ((count (1+ (cdr existing)))) ;recalculate mean
127 (cons (/ (+ (* (1- count) (car existing))
131 (cons (/ ,size ,time) 1))))))
133 (defmacro vlf-time (&rest body)
134 "Get timing consed with result of BODY execution."
135 `(if vlf-tune-enabled
136 (let* ((time (float-time))
137 (result (progn ,@body)))
138 (cons (- (float-time) time) result))
139 (let ((result (progn ,@body)))
142 (defun vlf-tune-insert-file-contents (start end)
143 "Extract decoded file bytes START to END and save time it takes."
144 (let ((result (vlf-time (insert-file-contents buffer-file-name
146 (vlf-tune-add-measurement vlf-tune-insert-bps
147 (- end start) (car result))
150 (defun vlf-tune-insert-file-contents-literally (start end)
151 "Insert raw file bytes START to END and save time it takes."
152 (let ((result (vlf-time (insert-file-contents-literally
153 buffer-file-name nil start end))))
154 (vlf-tune-add-measurement vlf-tune-insert-raw-bps
155 (- end start) (car result))
158 (defun vlf-tune-encode-length (start end)
159 "Get length of encoded region START to END and save time it takes."
160 (let ((result (vlf-time (length (encode-coding-region
162 buffer-file-coding-system t)))))
163 (vlf-tune-add-measurement vlf-tune-encode-bps
164 (cdr result) (car result))
167 (defun vlf-tune-write (start end append visit size)
168 "Save buffer and save time it takes.
169 START, END, APPEND, VISIT have same meaning as in `write-region'.
170 SIZE is number of bytes that are saved."
171 (let ((time (car (vlf-time (write-region start end buffer-file-name
173 (vlf-tune-add-measurement vlf-tune-write-bps size time)))
175 (defun vlf-tune-hexlify ()
176 "Activate `hexl-mode' and save time it takes."
177 (or (derived-mode-p 'hexl-mode)
178 (let ((time (car (vlf-time (hexl-mode)))))
179 (vlf-tune-add-measurement vlf-tune-hexl-bps
180 hexl-max-address time))))
182 (defun vlf-tune-dehexlify ()
183 "Exit `hexl-mode' and save time it takes."
184 (if (derived-mode-p 'hexl-mode)
185 (let ((time (car (vlf-time (hexl-mode-exit)))))
186 (vlf-tune-add-measurement vlf-tune-dehexlify-bps
187 hexl-max-address time))))
189 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
192 (defun vlf-tune-approximate-nearby (vec index)
193 "VEC has value for INDEX, approximate to closest available."
195 (left-idx (1- index))
196 (right-idx (1+ index))
197 (min-idx (max 0 (- index 5)))
198 (max-idx (min (+ index 6)
199 (1- (/ (min vlf-tune-max
200 (/ (1+ vlf-file-size) 2))
202 (while (and (zerop val) (or (<= min-idx left-idx)
203 (< right-idx max-idx)))
204 (if (<= min-idx left-idx)
205 (let ((left (aref vec left-idx)))
206 (cond ((consp left) (setq val (car left)))
207 ((numberp left) (setq val left)))))
208 (if (< right-idx max-idx)
209 (let ((right (aref vec right-idx)))
211 (setq right (car right)))
212 (and (numberp right) (not (zerop right))
213 (setq val (if (zerop val)
215 (/ (+ val right) 2))))))
216 (setq left-idx (1- left-idx)
217 right-idx (1+ right-idx)))
220 (defmacro vlf-tune-get-value (vec index &optional dont-approximate)
221 "Get value from VEC for INDEX.
222 If missing, approximate from nearby measurement,
223 unless DONT-APPROXIMATE is t."
225 (let ((val (aref ,vec ,index)))
226 (cond ((consp val) (car val))
228 ,(if dont-approximate
229 `(aset ,vec ,index 0)
230 `(vlf-tune-approximate-nearby ,vec ,index)))
231 ((zerop val) ;index has been tried before, yet still no value
232 ,(if dont-approximate
234 (vlf-tune-approximate-nearby ,vec ,index))
235 `(vlf-tune-approximate-nearby ,vec ,index)))
238 (defmacro vlf-tune-get-vector (key)
239 "Get vlf-tune vector corresponding to KEY."
240 `(cond ((eq ,key :insert) vlf-tune-insert-bps)
241 ((eq ,key :raw) vlf-tune-insert-raw-bps)
242 ((eq ,key :encode) vlf-tune-encode-bps)
243 ((eq ,key :write) vlf-tune-write-bps)
244 ((eq ,key :hexl) vlf-tune-hexl-bps)
245 ((eq ,key :dehexlify) vlf-tune-dehexlify-bps)))
247 (defun vlf-tune-assess (type coef index &optional approximate)
248 "Get measurement value according to TYPE, COEF and INDEX.
249 If APPROXIMATE is t, do approximation for missing values."
250 (* coef (or (if approximate
251 (vlf-tune-get-value (vlf-tune-get-vector type)
253 (vlf-tune-get-value (vlf-tune-get-vector type)
257 (defun vlf-tune-score (types index &optional approximate time-max)
258 "Calculate cumulative speed over TYPES for INDEX.
259 If APPROXIMATE is t, do approximation for missing values.
260 If TIME-MAX is non nil, return cumulative time instead of speed.
261 If it is number, stop as soon as cumulative time gets equal or above."
264 (size (* (1+ index) vlf-tune-step))
265 (cut-time (numberp time-max)))
266 (dolist (el types (if time-max time
268 (let ((bps (if (consp el)
269 (vlf-tune-assess (car el) (cadr el) index
271 (vlf-tune-assess el 1 index approximate))))
274 (setq time (+ time (/ size bps)))
275 (and cut-time (<= time-max time)
276 (throw 'result nil))))))))
278 (defun vlf-tune-conservative (types &optional index)
279 "Adjust `vlf-batch-size' to best nearby value over TYPES.
280 INDEX if given, specifies search independent of current batch size."
281 (if (eq vlf-tune-enabled t)
282 (let* ((half-max (/ (1+ vlf-file-size) 2))
283 (idx (or index (vlf-tune-closest-index vlf-batch-size)))
284 (curr (if (< half-max (* idx vlf-tune-step)) t
285 (vlf-tune-score types idx))))
287 (let ((prev (if (zerop idx) t
288 (vlf-tune-score types (1- idx)))))
290 (let ((next (if (or (eq curr t)
291 (< half-max (* (1+ idx)
294 (vlf-tune-score types (1+ idx)))))
296 (setq vlf-batch-size (* (+ 2 idx)
301 (* idx vlf-tune-step))))
302 (t (let ((best-idx idx))
303 (and (numberp prev) (< curr prev)
306 (and (numberp next) (< curr next)
307 (setq best-idx (1+ idx)))
311 (setq vlf-batch-size (* idx vlf-tune-step))))
312 (setq vlf-batch-size (* (1+ idx) vlf-tune-step))))))
314 (defun vlf-tune-binary (types min max)
315 "Adjust `vlf-batch-size' to optimal value using binary search, \
316 optimizing over TYPES.
317 MIN and MAX specify interval of indexes to search."
318 (let ((sum (+ min max)))
319 (if (< (- max min) 3)
320 (vlf-tune-conservative types (/ sum 2))
321 (let* ((left-idx (round (+ sum (* 2 min)) 4))
322 (left (vlf-tune-score types left-idx)))
324 (let* ((right-idx (round (+ sum (* 2 max)) 4))
325 (right (vlf-tune-score types right-idx)))
327 (setq vlf-batch-size (* (1+ right-idx)
330 (vlf-tune-binary types (/ (1+ sum) 2) max))
331 (t (vlf-tune-binary types min (/ sum 2)))))
332 (setq vlf-batch-size (* (1+ left-idx) vlf-tune-step)))))))
334 (defun vlf-tune-linear (types max-idx)
335 "Adjust `vlf-batch-size' to optimal value using linear search, \
336 optimizing over TYPES up to MAX-IDX."
341 (while (and none-missing (< idx max-idx))
342 (let ((bps (vlf-tune-score types idx)))
344 (setq vlf-batch-size (* (1+ idx) vlf-tune-step)
346 ((< best-bps bps) (setq best-idx idx
349 (or (not none-missing)
350 (setq vlf-batch-size (* (1+ best-idx) vlf-tune-step)))))
352 (defun vlf-tune-batch (types &optional linear)
353 "Adjust `vlf-batch-size' to optimal value optimizing on TYPES.
354 TYPES is alist of elements that may be of form (type coef) or
355 non list values in which case coeficient is assumed 1.
356 Types can be :insert, :raw, :encode, :write, :hexl or :dehexlify.
357 If LINEAR is non nil, use brute-force. In case requested measurement
358 is missing, stop search and set `vlf-batch-size' to this value.
359 Suitable for multiple batch operations."
360 (if (eq vlf-tune-enabled t)
361 (let ((max-idx (1- (/ (min vlf-tune-max
362 (/ (1+ vlf-file-size) 2))
364 (cond (linear (vlf-tune-linear types max-idx))
365 ((file-remote-p buffer-file-name)
366 (vlf-tune-conservative types))
369 (vlf-tune-conservative types (/ max-idx 2))
370 (vlf-tune-binary types 0 max-idx)))))))
372 (defun vlf-tune-optimal-load (types &optional min-idx max-idx)
373 "Get best batch size according to existing measurements over TYPES.
374 Best considered where primitive operations total is closest to
375 `vlf-tune-load-time'. If MIN-IDX and MAX-IDX are given,
376 confine search to this region."
379 (setq max-idx (min (or max-idx vlf-tune-max)
380 (1- (/ (min vlf-tune-max
381 (/ (1+ vlf-file-size) 2))
383 (let* ((idx (max 0 (or min-idx 0)))
385 (best-time-diff vlf-tune-load-time)
388 (while (and (not (zerop best-time-diff)) (< idx max-idx))
389 (let ((time-diff (vlf-tune-score types idx t
390 (+ vlf-tune-load-time
394 (setq time-diff (if (< vlf-tune-load-time time-diff)
395 (progn (setq all-less nil)
399 (- vlf-tune-load-time time-diff)))
400 (if (< time-diff best-time-diff)
402 best-time-diff time-diff)))
403 (setq all-less nil)))
405 (* vlf-tune-step (1+ (cond ((or (zerop best-time-diff)
406 (eq all-less all-more))
412 (defun vlf-tune-load (types &optional region)
413 "Adjust `vlf-batch-size' slightly to better load time.
414 Optimize on TYPES on the nearby REGION. Use 2 if REGION is nil."
415 (when (eq vlf-tune-enabled t)
416 (or region (setq region 2))
417 (let ((idx (vlf-tune-closest-index vlf-batch-size)))
418 (setq vlf-batch-size (vlf-tune-optimal-load types (- idx region)
419 (+ idx 1 region))))))
423 ;;; vlf-tune.el ends here