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 (max (let ((ram-size (vlf-tune-ram-size)))
  60                                (if ram-size
  61                                    (/ ram-size 20)
  62                                  0))
  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)
  67
  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)
  72
  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)
  76
  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)
  81
  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)
  86
  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)
  91
  92 (defvar vlf-tune-write-bps nil
  93   "Vector of bytes per second write measurements.")
  94
  95 (defvar vlf-tune-hexl-bps nil
  96   "Vector of bytes per second hexlify measurements.")
  97
  98 (defvar vlf-tune-dehexlify-bps nil
  99   "Vector of bytes per second dehexlify measurements.")
 100
 101 (defvar vlf-start-pos)
 102 (defvar hexl-bits)
 103 (defvar hexl-max-address)
 104 (declare-function hexl-line-displen "hexl")
 105 (declare-function dehexlify-buffer "hexl")
 106
 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))
 115     (if to-buffer
 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))))
 123
 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))))))
 128
 129 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 130 ;;; profiling
 131
 132 (defun vlf-tune-initialize-measurement ()
 133   "Initialize measurement vector."
 134   (make-vector (1- (/ vlf-tune-max vlf-tune-step)) nil))
 135
 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))
 146                                         (/ ,size ,time))
 147                                      count)
 148                                   count))
 149                         (cons (/ ,size ,time) 1))))))
 150
 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)))
 158        (cons nil result))))
 159
 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
 163                                                 nil start end))))
 164     (vlf-tune-add-measurement vlf-tune-insert-bps
 165                               (- end start) (car result))
 166     (cdr result)))
 167
 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))
 175     (cdr result)))
 176
 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
 180                                    start end
 181                                    buffer-file-coding-system t)))))
 182     (vlf-tune-add-measurement vlf-tune-encode-bps
 183                               (cdr result) (car result))
 184     (cdr result)))
 185
 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
 193                                             visit)))))
 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))))
 196
 197 (defun vlf-hexl-adjust-addresses ()
 198   "Adjust hexl address indicators according to `vlf-start-pos'."
 199   (let ((pos (point))
 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)))
 205     (goto-char pos)))
 206
 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)
 211                               (or no-adjust
 212                                   (vlf-hexl-adjust-addresses))))))
 213     (setq hexl-max-address (+ (* (/ (1- (buffer-size))
 214                                     (hexl-line-displen)) 16) 15))
 215     (or no-adjust
 216         (vlf-tune-add-measurement vlf-tune-hexl-bps
 217                                   hexl-max-address time))))
 218
 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)))
 224
 225 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 226 ;;; tuning
 227
 228 (defun vlf-tune-approximate-nearby (vec index)
 229   "VEC has value for INDEX, approximate to closest available."
 230   (let ((val 0)
 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))
 237                              vlf-tune-step)))))
 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)))
 246             (if (consp right)
 247                 (setq right (car right)))
 248             (and (numberp right) (not (zerop right))
 249                  (setq val (if (zerop val)
 250                                right
 251                              (/ (+ val right) 2))))))
 252       (setq left-idx (1- left-idx)
 253             right-idx (1+ right-idx)))
 254     val))
 255
 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."
 260   `(if ,vec
 261        (let ((val (aref ,vec ,index)))
 262          (cond ((consp val) (car val))
 263                ((null 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
 269                      `(aset ,vec ,index
 270                             (vlf-tune-approximate-nearby ,vec ,index))
 271                    `(vlf-tune-approximate-nearby ,vec ,index)))
 272                (t val)))
 273      most-positive-fixnum))
 274
 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)))
 283
 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)
 289                                       index)
 290                 (vlf-tune-get-value (vlf-tune-get-vector type)
 291                                     index t))
 292               0)))
 293
 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."
 299   (catch 'result
 300     (let ((time 0)
 301           (size (* (1+ index) vlf-tune-step))
 302           (cut-time (numberp time-max)))
 303       (dolist (el types (if time-max time
 304                           (/ size time)))
 305         (let ((bps (if (consp el)
 306                        (vlf-tune-assess (car el) (cadr el) index
 307                                         approximate)
 308                      (vlf-tune-assess el 1.0 index approximate))))
 309           (if (zerop bps)
 310               (throw 'result nil)
 311             (setq time (+ time (/ size bps)))
 312             (and cut-time (<= time-max time)
 313                  (throw 'result nil))))))))
 314
 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))))
 323         (if curr
 324             (let ((prev (if (zerop idx) t
 325                           (vlf-tune-score types (1- idx)))))
 326               (if prev
 327                   (let ((next (if (or (eq curr t)
 328                                       (< half-max (* (1+ idx)
 329                                                      vlf-tune-step)))
 330                                   t
 331                                 (vlf-tune-score types (1+ idx)))))
 332                     (cond ((null next)
 333                            (setq vlf-batch-size (* (+ 2 idx)
 334                                                    vlf-tune-step)))
 335                           ((eq curr t)
 336                            (or (eq prev t)
 337                                (setq vlf-batch-size
 338                                      (* idx vlf-tune-step))))
 339                           (t (let ((best-idx idx))
 340                                (and (numberp prev) (< curr prev)
 341                                     (setq curr prev
 342                                           best-idx (1- idx)))
 343                                (and (numberp next) (< curr next)
 344                                     (setq best-idx (1+ idx)))
 345                                (setq vlf-batch-size
 346                                      (* (1+ best-idx)
 347                                         vlf-tune-step))))))
 348                 (setq vlf-batch-size (* idx vlf-tune-step))))
 349           (setq vlf-batch-size (* (1+ idx) vlf-tune-step))))))
 350
 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)))
 360         (if left
 361             (let* ((right-idx (round (+ sum (* 2 max)) 4))
 362                    (right (vlf-tune-score types right-idx)))
 363               (cond ((null right)
 364                      (setq vlf-batch-size (* (1+ right-idx)
 365                                              vlf-tune-step)))
 366                     ((< left right)
 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)))))))
 370
 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."
 374   (let ((best-idx 0)
 375         (best-bps 0)
 376         (idx 0))
 377     (while (< idx max-idx)
 378       (let ((bps (vlf-tune-score types idx t)))
 379         (and bps (< best-bps bps)
 380              (setq best-idx idx
 381                    best-bps bps)))
 382       (setq idx (1+ idx)))
 383     (setq vlf-batch-size (* (1+ best-idx) vlf-tune-step))))
 384
 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))
 397                             vlf-tune-step))))
 398         (if linear
 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))
 403                   ((<= 1 max-idx)
 404                    (if (< max-idx 3)
 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)))))))
 409
 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)
 416       (progn
 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))
 421                                   vlf-tune-step))))
 422         (let* ((idx min-idx)
 423                (best-idx idx)
 424                (best-time-diff vlf-tune-load-time)
 425                (all-less t)
 426                (all-more t))
 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
 430                                                 best-time-diff))))
 431               (if time-diff
 432                   (progn
 433                     (setq time-diff (if (< vlf-tune-load-time time-diff)
 434                                         (progn (setq all-less nil)
 435                                                (- time-diff
 436                                                   vlf-tune-load-time))
 437                                       (setq all-more nil)
 438                                       (- vlf-tune-load-time time-diff)))
 439                     (if (< time-diff best-time-diff)
 440                         (setq best-idx idx
 441                               best-time-diff time-diff)))
 442                 (setq all-less nil)))
 443             (setq idx (1+ idx)))
 444           (* vlf-tune-step (1+ (cond ((or (zerop best-time-diff)
 445                                           (eq all-less all-more))
 446                                       best-idx)
 447                                      (all-less max-idx)
 448                                      (t min-idx))))))
 449     vlf-batch-size))
 450
 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))))))
 459
 460 (provide 'vlf-tune)
 461
 462 ;;; vlf-tune.el ends here