code.delx.au - gnu-emacs-elpa/blob - packages/vlf/vlf-tune.el

   1 ;;; vlf-tune.el --- VLF tuning operations  -*- lexical-binding: t -*-
   2
   3 ;; Copyright (C) 2014 Free Software Foundation, Inc.
   4
   5 ;; Keywords: large files, batch size, performance
   6 ;; Author: Andrey Kotlarski <m00naticus@gmail.com>
   7 ;; URL: https://github.com/m00natic/vlfi
   8
   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)
  12 ;; any later version.
  13
  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.
  18
  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.
  23
  24 ;;; Commentary:
  25 ;; This package provides wrappers for basic chunk operations that add
  26 ;; profiling and automatic tuning of `vlf-batch-size'.
  27
  28 ;;; Code:
  29
  30 (defgroup vlf nil "View Large Files in Emacs."
  31   :prefix "vlf-" :group 'files)
  32
  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)
  37
  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)))
  45
  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)
  49
  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)))
  55         (if match-from
  56             (* 1000 (string-to-number (substring free match-from
  57                                                  (match-end 0))))))))
  58
  59 (defcustom vlf-tune-max (let ((ram-size (vlf-tune-ram-size)))
  60                           (if ram-size
  61                               (/ ram-size 20)
  62                             large-file-warning-threshold))
  63   "Maximum batch size in bytes when auto tuning."
  64   :group 'vlf :type 'integer)
  65
  66 (defcustom vlf-tune-step (/ vlf-tune-max 1000)
  67   "Step used for tuning in bytes."
  68   :group 'vlf :type 'integer)
  69
  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)
  73
  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)
  78
  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)
  83
  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)
  88
  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)
  93
  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)
  98
  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)
 103
 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))))))
 108
 109 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 110 ;;; profiling
 111
 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))
 117
 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))
 128                                         (/ ,size ,time))
 129                                      count)
 130                                   count))
 131                         (cons (/ ,size ,time) 1))))))
 132
 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)))
 140        (cons nil result))))
 141
 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
 145                                                 nil start end))))
 146     (vlf-tune-add-measurement vlf-tune-insert-bps
 147                               (- end start) (car result))
 148     (cdr result)))
 149
 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))
 156     (cdr result)))
 157
 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
 161                                    start end
 162                                    buffer-file-coding-system t)))))
 163     (vlf-tune-add-measurement vlf-tune-encode-bps
 164                               (cdr result) (car result))
 165     (cdr result)))
 166
 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
 172                                            append visit)))))
 173     (vlf-tune-add-measurement vlf-tune-write-bps size time)))
 174
 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))))
 181
 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))))
 188
 189 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 190 ;;; tuning
 191
 192 (defun vlf-tune-approximate-nearby (vec index)
 193   "VEC has value for INDEX, approximate to closest available."
 194   (let ((val 0)
 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))
 201                              vlf-tune-step)))))
 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)))
 210             (if (consp right)
 211                 (setq right (car right)))
 212             (and (numberp right) (not (zerop right))
 213                  (setq val (if (zerop val)
 214                                right
 215                              (/ (+ val right) 2))))))
 216       (setq left-idx (1- left-idx)
 217             right-idx (1+ right-idx)))
 218     val))
 219
 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."
 224   `(if ,vec
 225        (let ((val (aref ,vec ,index)))
 226          (cond ((consp val) (car val))
 227                ((null 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
 233                      `(aset ,vec ,index
 234                             (vlf-tune-approximate-nearby ,vec ,index))
 235                    `(vlf-tune-approximate-nearby ,vec ,index)))
 236                (t val)))))
 237
 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)))
 246
 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)
 252                                       index)
 253                 (vlf-tune-get-value (vlf-tune-get-vector type)
 254                                     index t))
 255               0)))
 256
 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."
 262   (catch 'result
 263     (let ((time 0)
 264           (size (* (1+ index) vlf-tune-step))
 265           (cut-time (numberp time-max)))
 266       (dolist (el types (if time-max time
 267                           (/ size time)))
 268         (let ((bps (if (consp el)
 269                        (vlf-tune-assess (car el) (cadr el) index
 270                                         approximate)
 271                      (vlf-tune-assess el 1 index approximate))))
 272           (if (zerop bps)
 273               (throw 'result nil)
 274             (setq time (+ time (/ size bps)))
 275             (and cut-time (<= time-max time)
 276                  (throw 'result nil))))))))
 277
 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))))
 286         (if curr
 287             (let ((prev (if (zerop idx) t
 288                           (vlf-tune-score types (1- idx)))))
 289               (if prev
 290                   (let ((next (if (or (eq curr t)
 291                                       (< half-max (* (1+ idx)
 292                                                      vlf-tune-step)))
 293                                   t
 294                                 (vlf-tune-score types (1+ idx)))))
 295                     (cond ((null next)
 296                            (setq vlf-batch-size (* (+ 2 idx)
 297                                                    vlf-tune-step)))
 298                           ((eq curr t)
 299                            (or (eq prev t)
 300                                (setq vlf-batch-size
 301                                      (* idx vlf-tune-step))))
 302                           (t (let ((best-idx idx))
 303                                (and (numberp prev) (< curr prev)
 304                                     (setq curr prev
 305                                           best-idx (1- idx)))
 306                                (and (numberp next) (< curr next)
 307                                     (setq best-idx (1+ idx)))
 308                                (setq vlf-batch-size
 309                                      (* (1+ best-idx)
 310                                         vlf-tune-step))))))
 311                 (setq vlf-batch-size (* idx vlf-tune-step))))
 312           (setq vlf-batch-size (* (1+ idx) vlf-tune-step))))))
 313
 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)))
 323         (if left
 324             (let* ((right-idx (round (+ sum (* 2 max)) 4))
 325                    (right (vlf-tune-score types right-idx)))
 326               (cond ((null right)
 327                      (setq vlf-batch-size (* (1+ right-idx)
 328                                              vlf-tune-step)))
 329                     ((< left right)
 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)))))))
 333
 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."
 337   (let ((best-idx 0)
 338         (best-bps 0)
 339         (idx 0)
 340         (none-missing t))
 341     (while (and none-missing (< idx max-idx))
 342       (let ((bps (vlf-tune-score types idx)))
 343         (cond ((null bps)
 344                (setq vlf-batch-size (* (1+ idx) vlf-tune-step)
 345                      none-missing nil))
 346               ((< best-bps bps) (setq best-idx idx
 347                                       best-bps bps))))
 348       (setq idx (1+ idx)))
 349     (or (not none-missing)
 350         (setq vlf-batch-size (* (1+ best-idx) vlf-tune-step)))))
 351
 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))
 363                             vlf-tune-step))))
 364         (cond (linear (vlf-tune-linear types max-idx))
 365               ((file-remote-p buffer-file-name)
 366                (vlf-tune-conservative types))
 367               ((<= 1 max-idx)
 368                (if (< max-idx 3)
 369                    (vlf-tune-conservative types (/ max-idx 2))
 370                  (vlf-tune-binary types 0 max-idx)))))))
 371
 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."
 377   (if vlf-tune-enabled
 378       (progn
 379         (setq max-idx (min (or max-idx vlf-tune-max)
 380                            (1- (/ (min vlf-tune-max
 381                                        (/ (1+ vlf-file-size) 2))
 382                                   vlf-tune-step))))
 383         (let* ((idx (max 0 (or min-idx 0)))
 384                (best-idx idx)
 385                (best-time-diff vlf-tune-load-time)
 386                (all-less t)
 387                (all-more t))
 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
 391                                                 best-time-diff))))
 392               (if time-diff
 393                   (progn
 394                     (setq time-diff (if (< vlf-tune-load-time time-diff)
 395                                         (progn (setq all-less nil)
 396                                                (- time-diff
 397                                                   vlf-tune-load-time))
 398                                       (setq all-more nil)
 399                                       (- vlf-tune-load-time time-diff)))
 400                     (if (< time-diff best-time-diff)
 401                         (setq best-idx idx
 402                               best-time-diff time-diff)))
 403                 (setq all-less nil)))
 404             (setq idx (1+ idx)))
 405           (* vlf-tune-step (1+ (cond ((or (zerop best-time-diff)
 406                                           (eq all-less all-more))
 407                                       best-idx)
 408                                      (all-less max-idx)
 409                                      (t min-idx))))))
 410     vlf-batch-size))
 411
 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))))))
 420
 421 (provide 'vlf-tune)
 422
 423 ;;; vlf-tune.el ends here