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 (max (let ((ram-size (vlf-tune-ram-size)))
63 large-file-warning-threshold)
64 "Maximum batch size in bytes when auto tuning.
65 Avoid increasing this after opening file with VLF."
66 :group 'vlf :type 'integer)
68 (defcustom vlf-tune-step (/ vlf-tune-max 10000)
69 "Step used for tuning in bytes.
70 Avoid decreasing this after opening file with VLF."
71 :group 'vlf :type 'integer)
73 (defcustom vlf-tune-load-time 1.0
74 "How many seconds should batch take to load for best user experience."
75 :group 'vlf :type 'float)
77 (defvar vlf-tune-insert-bps nil
78 "Vector of bytes per second insert measurements.")
79 (make-variable-buffer-local 'vlf-tune-insert-bps)
80 (put 'vlf-tune-insert-bps 'permanent-local t)
82 (defvar vlf-tune-insert-raw-bps nil
83 "Vector of bytes per second non-decode insert measurements.")
84 (make-variable-buffer-local 'vlf-tune-insert-raw-bps)
85 (put 'vlf-tune-insert-raw-bps 'permanent-local t)
87 (defvar vlf-tune-encode-bps nil
88 "Vector of bytes per second encode measurements.")
89 (make-variable-buffer-local 'vlf-tune-encode-bps)
90 (put 'vlf-tune-encode-bps 'permanent-local t)
92 (defvar vlf-tune-write-bps nil
93 "Vector of bytes per second write measurements.")
95 (defvar vlf-tune-hexl-bps nil
96 "Vector of bytes per second hexlify measurements.")
98 (defvar vlf-tune-dehexlify-bps nil
99 "Vector of bytes per second dehexlify measurements.")
101 (defvar vlf-start-pos)
103 (defvar hexl-max-address)
104 (declare-function hexl-line-displen "hexl")
105 (declare-function dehexlify-buffer "hexl")
107 (defun vlf-tune-copy-profile (from-buffer &optional to-buffer)
108 "Copy specific profile vectors of FROM-BUFFER to TO-BUFFER.
109 If TO-BUFFER is nil, copy to current buffer."
110 (let (insert-bps insert-raw-bps encode-bps)
111 (with-current-buffer from-buffer
112 (setq insert-bps vlf-tune-insert-bps
113 insert-raw-bps vlf-tune-insert-raw-bps
114 encode-bps vlf-tune-encode-bps))
116 (with-current-buffer to-buffer
117 (setq vlf-tune-insert-bps insert-bps
118 vlf-tune-insert-raw-bps insert-raw-bps
119 vlf-tune-encode-bps encode-bps))
120 (setq vlf-tune-insert-bps insert-bps
121 vlf-tune-insert-raw-bps insert-raw-bps
122 vlf-tune-encode-bps encode-bps))))
124 (defun vlf-tune-closest-index (size)
125 "Get closest measurement index corresponding to SIZE."
126 (let ((step (float vlf-tune-step)))
127 (max 0 (1- (min (round size step) (round vlf-tune-max step))))))
129 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
132 (defun vlf-tune-initialize-measurement ()
133 "Initialize measurement vector."
134 (make-vector (1- (/ vlf-tune-max vlf-tune-step)) nil))
136 (defmacro vlf-tune-add-measurement (vec size time)
137 "Add at an appropriate position in VEC new SIZE TIME measurement.
138 VEC is a vector of (mean time . count) elements ordered by size."
139 `(when (and vlf-tune-enabled (not (zerop ,size)))
140 (or ,vec (setq ,vec (vlf-tune-initialize-measurement)))
141 (let* ((idx (vlf-tune-closest-index ,size))
142 (existing (aref ,vec idx)))
143 (aset ,vec idx (if (consp existing)
144 (let ((count (1+ (cdr existing)))) ;recalculate mean
145 (cons (/ (+ (* (1- count) (car existing))
149 (cons (/ ,size ,time) 1))))))
151 (defmacro vlf-time (&rest body)
152 "Get timing consed with result of BODY execution."
153 `(if vlf-tune-enabled
154 (let* ((time (float-time))
155 (result (progn ,@body)))
156 (cons (- (float-time) time) result))
157 (let ((result (progn ,@body)))
160 (defun vlf-tune-insert-file-contents (start end)
161 "Extract decoded file bytes START to END and save time it takes."
162 (let ((result (vlf-time (insert-file-contents buffer-file-name
164 (vlf-tune-add-measurement vlf-tune-insert-bps
165 (- end start) (car result))
168 (defun vlf-tune-insert-file-contents-literally (start end &optional file)
169 "Insert raw file bytes START to END and save time it takes.
170 FILE if given is filename to be used, otherwise `buffer-file-name'."
171 (let ((result (vlf-time (insert-file-contents-literally
172 (or file buffer-file-name) nil start end))))
173 (vlf-tune-add-measurement vlf-tune-insert-raw-bps
174 (- end start) (car result))
177 (defun vlf-tune-encode-length (start end)
178 "Get length of encoded region START to END and save time it takes."
179 (let ((result (vlf-time (length (encode-coding-region
181 buffer-file-coding-system t)))))
182 (vlf-tune-add-measurement vlf-tune-encode-bps
183 (cdr result) (car result))
186 (defun vlf-tune-write (start end append visit size &optional file-name)
187 "Save buffer and save time it takes.
188 START, END, APPEND, VISIT have same meaning as in `write-region'.
189 SIZE is number of bytes that are saved.
190 FILE-NAME if given is to be used instead of `buffer-file-name'."
191 (let* ((file (or file-name buffer-file-name))
192 (time (car (vlf-time (write-region start end file append
194 (or (file-remote-p file) ;writing to remote files can include network copying
195 (vlf-tune-add-measurement vlf-tune-write-bps size time))))
197 (defun vlf-hexl-adjust-addresses ()
198 "Adjust hexl address indicators according to `vlf-start-pos'."
200 (address vlf-start-pos))
201 (goto-char (point-min))
202 (while (re-search-forward "^[[:xdigit:]]+" nil t)
203 (replace-match (format "%08x" address))
204 (setq address (+ address hexl-bits)))
207 (defun vlf-tune-hexlify ()
208 "Activate `hexl-mode' and save time it takes."
209 (let* ((no-adjust (zerop vlf-start-pos))
210 (time (car (vlf-time (hexlify-buffer)
212 (vlf-hexl-adjust-addresses))))))
213 (setq hexl-max-address (+ (* (/ (1- (buffer-size))
214 (hexl-line-displen)) 16) 15))
216 (vlf-tune-add-measurement vlf-tune-hexl-bps
217 hexl-max-address time))))
219 (defun vlf-tune-dehexlify ()
220 "Exit `hexl-mode' and save time it takes."
221 (let ((time (car (vlf-time (dehexlify-buffer)))))
222 (vlf-tune-add-measurement vlf-tune-dehexlify-bps
223 hexl-max-address time)))
225 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
228 (defun vlf-tune-approximate-nearby (vec index)
229 "VEC has value for INDEX, approximate to closest available."
231 (left-idx (1- index))
232 (right-idx (1+ index))
233 (min-idx (max 0 (- index 5)))
234 (max-idx (min (+ index 6)
235 (1- (/ (min vlf-tune-max
236 (/ (1+ vlf-file-size) 2))
238 (while (and (zerop val) (or (<= min-idx left-idx)
239 (< right-idx max-idx)))
240 (if (<= min-idx left-idx)
241 (let ((left (aref vec left-idx)))
242 (cond ((consp left) (setq val (car left)))
243 ((numberp left) (setq val left)))))
244 (if (< right-idx max-idx)
245 (let ((right (aref vec right-idx)))
247 (setq right (car right)))
248 (and (numberp right) (not (zerop right))
249 (setq val (if (zerop val)
251 (/ (+ val right) 2))))))
252 (setq left-idx (1- left-idx)
253 right-idx (1+ right-idx)))
256 (defmacro vlf-tune-get-value (vec index &optional dont-approximate)
257 "Get value from VEC for INDEX.
258 If missing, approximate from nearby measurement,
259 unless DONT-APPROXIMATE is t."
261 (let ((val (aref ,vec ,index)))
262 (cond ((consp val) (car val))
264 ,(if dont-approximate
265 `(aset ,vec ,index 0)
266 `(vlf-tune-approximate-nearby ,vec ,index)))
267 ((zerop val) ;index has been tried before, yet still no value
268 ,(if dont-approximate
270 (vlf-tune-approximate-nearby ,vec ,index))
271 `(vlf-tune-approximate-nearby ,vec ,index)))
273 most-positive-fixnum))
275 (defmacro vlf-tune-get-vector (key)
276 "Get vlf-tune vector corresponding to KEY."
277 `(cond ((eq ,key :insert) vlf-tune-insert-bps)
278 ((eq ,key :raw) vlf-tune-insert-raw-bps)
279 ((eq ,key :encode) vlf-tune-encode-bps)
280 ((eq ,key :write) vlf-tune-write-bps)
281 ((eq ,key :hexl) vlf-tune-hexl-bps)
282 ((eq ,key :dehexlify) vlf-tune-dehexlify-bps)))
284 (defun vlf-tune-assess (type coef index &optional approximate)
285 "Get measurement value according to TYPE, COEF and INDEX.
286 If APPROXIMATE is t, do approximation for missing values."
287 (* coef (or (if approximate
288 (vlf-tune-get-value (vlf-tune-get-vector type)
290 (vlf-tune-get-value (vlf-tune-get-vector type)
294 (defun vlf-tune-score (types index &optional approximate time-max)
295 "Calculate cumulative speed over TYPES for INDEX.
296 If APPROXIMATE is t, do approximation for missing values.
297 If TIME-MAX is non nil, return cumulative time instead of speed.
298 If it is number, stop as soon as cumulative time gets equal or above."
301 (size (* (1+ index) vlf-tune-step))
302 (cut-time (numberp time-max)))
303 (dolist (el types (if time-max time
305 (let ((bps (if (consp el)
306 (vlf-tune-assess (car el) (cadr el) index
308 (vlf-tune-assess el 1.0 index approximate))))
311 (setq time (+ time (/ size bps)))
312 (and cut-time (<= time-max time)
313 (throw 'result nil))))))))
315 (defun vlf-tune-conservative (types &optional index)
316 "Adjust `vlf-batch-size' to best nearby value over TYPES.
317 INDEX if given, specifies search independent of current batch size."
318 (if (eq vlf-tune-enabled t)
319 (let* ((half-max (/ (1+ vlf-file-size) 2))
320 (idx (or index (vlf-tune-closest-index vlf-batch-size)))
321 (curr (if (< half-max (* idx vlf-tune-step)) t
322 (vlf-tune-score types idx))))
324 (let ((prev (if (zerop idx) t
325 (vlf-tune-score types (1- idx)))))
327 (let ((next (if (or (eq curr t)
328 (< half-max (* (1+ idx)
331 (vlf-tune-score types (1+ idx)))))
333 (setq vlf-batch-size (* (+ 2 idx)
338 (* idx vlf-tune-step))))
339 (t (let ((best-idx idx))
340 (and (numberp prev) (< curr prev)
343 (and (numberp next) (< curr next)
344 (setq best-idx (1+ idx)))
348 (setq vlf-batch-size (* idx vlf-tune-step))))
349 (setq vlf-batch-size (* (1+ idx) vlf-tune-step))))))
351 (defun vlf-tune-binary (types min max)
352 "Adjust `vlf-batch-size' to optimal value using binary search, \
353 optimizing over TYPES.
354 MIN and MAX specify interval of indexes to search."
355 (let ((sum (+ min max)))
356 (if (< (- max min) 3)
357 (vlf-tune-conservative types (/ sum 2))
358 (let* ((left-idx (round (+ sum (* 2 min)) 4))
359 (left (vlf-tune-score types left-idx)))
361 (let* ((right-idx (round (+ sum (* 2 max)) 4))
362 (right (vlf-tune-score types right-idx)))
364 (setq vlf-batch-size (* (1+ right-idx)
367 (vlf-tune-binary types (/ (1+ sum) 2) max))
368 (t (vlf-tune-binary types min (/ sum 2)))))
369 (setq vlf-batch-size (* (1+ left-idx) vlf-tune-step)))))))
371 (defun vlf-tune-linear (types max-idx)
372 "Adjust `vlf-batch-size' to optimal known value using linear search.
373 Optimize over TYPES up to MAX-IDX."
377 (while (< idx max-idx)
378 (let ((bps (vlf-tune-score types idx t)))
379 (and bps (< best-bps bps)
383 (setq vlf-batch-size (* (1+ best-idx) vlf-tune-step))))
385 (defun vlf-tune-batch (types &optional linear file)
386 "Adjust `vlf-batch-size' to optimal value optimizing on TYPES.
387 TYPES is alist of elements that may be of form (type coef) or
388 non list values in which case coeficient is assumed 1.
389 Types can be :insert, :raw, :encode, :write, :hexl or :dehexlify.
390 If LINEAR is non nil, use brute-force. In case requested measurement
391 is missing, stop search and set `vlf-batch-size' to this value.
392 FILE if given is filename to be used, otherwise `buffer-file-name'.
393 Suitable for multiple batch operations."
394 (if (eq vlf-tune-enabled t)
395 (let ((max-idx (1- (/ (min vlf-tune-max
396 (/ (1+ vlf-file-size) 2))
399 (vlf-tune-linear types max-idx)
400 (let ((batch-size vlf-batch-size))
401 (cond ((file-remote-p (or file buffer-file-name))
402 (vlf-tune-conservative types))
405 (vlf-tune-conservative types (/ max-idx 2))
406 (vlf-tune-binary types 0 max-idx))))
407 (if (= batch-size vlf-batch-size) ;local maxima?
408 (vlf-tune-linear types max-idx)))))))
410 (defun vlf-tune-optimal-load (types &optional min-idx max-idx)
411 "Get best batch size according to existing measurements over TYPES.
412 Best considered where primitive operations total is closest to
413 `vlf-tune-load-time'. If MIN-IDX and MAX-IDX are given,
414 confine search to this region."
415 (if (eq vlf-tune-enabled t)
417 (setq min-idx (max 0 (or min-idx 0))
418 max-idx (min (or max-idx vlf-tune-max)
419 (1- (/ (min vlf-tune-max
420 (/ (1+ vlf-file-size) 2))
424 (best-time-diff vlf-tune-load-time)
427 (while (and (not (zerop best-time-diff)) (< idx max-idx))
428 (let ((time-diff (vlf-tune-score types idx t
429 (+ vlf-tune-load-time
433 (setq time-diff (if (< vlf-tune-load-time time-diff)
434 (progn (setq all-less nil)
438 (- vlf-tune-load-time time-diff)))
439 (if (< time-diff best-time-diff)
441 best-time-diff time-diff)))
442 (setq all-less nil)))
444 (* vlf-tune-step (1+ (cond ((or (zerop best-time-diff)
445 (eq all-less all-more))
451 (defun vlf-tune-load (types &optional region)
452 "Adjust `vlf-batch-size' slightly to better load time.
453 Optimize on TYPES on the nearby REGION. Use 2 if REGION is nil."
454 (when (eq vlf-tune-enabled t)
455 (or region (setq region 2))
456 (let ((idx (vlf-tune-closest-index vlf-batch-size)))
457 (setq vlf-batch-size (vlf-tune-optimal-load types (- idx region)
458 (+ idx 1 region))))))
462 ;;; vlf-tune.el ends here