;;; vlf-tune.el --- VLF tuning operations -*- lexical-binding: t -*- ;; Copyright (C) 2014 Free Software Foundation, Inc. ;; Keywords: large files, batch size, performance ;; Author: Andrey Kotlarski ;; URL: https://github.com/m00natic/vlfi ;; This file is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation; either version 3, or (at your option) ;; any later version. ;; This file is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs; see the file COPYING. If not, write to ;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330, ;; Boston, MA 02111-1307, USA. ;;; Commentary: ;; This package provides wrappers for basic chunk operations that add ;; time statistics and automatic tuning of `vlf-batch-size' for ;; optimal performance. ;;; Code: (defcustom vlf-tune-enabled t "Whether to allow automatic change of batch size. If nil, completely disable. If `stats', maintain measure statistics, but don't change batch size. If t, measure and change." :group 'vlf :type '(choice (const :tag "Enabled" t) (const :tag "Just statistics" stats) (const :tag "Disabled" nil))) (defvar vlf-file-size 0 "Total size of presented file.") (make-variable-buffer-local 'vlf-file-size) (put 'vlf-file-size 'permanent-local t) (defun vlf-tune-ram-size () "Try to determine RAM size in bytes." (let* ((free-output (shell-command-to-string "free")) (match-from (string-match "[[:digit:]]+" free-output))) (if match-from (* 1000 (string-to-number (substring free-output match-from (match-end 0))))))) (defcustom vlf-tune-max (let ((ram-size (vlf-tune-ram-size))) (if ram-size (/ ram-size 20) large-file-warning-threshold)) "Maximum batch size in bytes when auto tuning." :group 'vlf :type 'integer) (defcustom vlf-tune-step (/ vlf-tune-max 1000) "Step used for tuning in bytes." :group 'vlf :type 'integer) (defvar vlf-tune-insert-bps nil "Vector of bytes per second insert measurements.") (make-variable-buffer-local 'vlf-tune-insert-bps) (put 'vlf-tune-insert-bps 'permanent-local t) (defvar vlf-tune-insert-raw-bps nil "Vector of bytes per second non-decode insert measurements.") (make-variable-buffer-local 'vlf-tune-insert-raw-bps) (put 'vlf-tune-insert-raw-bps 'permanent-local t) (defvar vlf-tune-encode-bps nil "Vector of bytes per second encode measurements.") (make-variable-buffer-local 'vlf-tune-encode-bps) (put 'vlf-tune-encode-bps 'permanent-local t) (defvar vlf-tune-write-bps nil "Vector of bytes per second write measurements.") (make-variable-buffer-local 'vlf-tune-write-bps) (put 'vlf-tune-write-bps 'permanent-local t) (defvar vlf-tune-hexl-bps nil "Vector of bytes per second hexlify measurements.") (make-variable-buffer-local 'vlf-tune-hexl-bps) (put 'vlf-tune-hexl-bps 'permanent-local t) (defvar vlf-tune-dehexlify-bps nil "Vector of bytes per second dehexlify measurements.") (make-variable-buffer-local 'vlf-tune-dehexlify-bps) (put 'vlf-tune-dehexlify-bps 'permanent-local t) (defun vlf-tune-initialize-measurement () "Initialize measurement vector." (make-vector (1- (/ vlf-tune-max vlf-tune-step)) '(0 . 0))) (defun vlf-tune-closest-index (size) "Get closest measurement index corresponding to SIZE." (let ((step (float vlf-tune-step))) (max 0 (1- (min (round size step) (round vlf-tune-max step)))))) (defmacro vlf-tune-add-measurement (vec size time) "Add at an appropriate position in VEC new SIZE TIME measurement. VEC is a vector of (mean time . count) elements ordered by size." `(when (and vlf-tune-enabled (not (zerop ,size))) (or ,vec (setq ,vec (vlf-tune-initialize-measurement))) (let* ((idx (vlf-tune-closest-index ,size)) (existing (aref ,vec idx))) (aset ,vec idx (let ((count (1+ (cdr existing)))) ;recalculate mean (cons (/ (+ (* (1- count) (car existing)) (/ ,size ,time)) count) count)))))) (defmacro vlf-time (&rest body) "Get timing consed with result of BODY execution." `(let ((time (float-time)) (result (progn ,@body))) (cons (- (float-time) time) result))) (defun vlf-tune-insert-file-contents (start end) "Extract decoded file bytes START to END and save time it takes." (let ((result (vlf-time (insert-file-contents buffer-file-name nil start end)))) (vlf-tune-add-measurement vlf-tune-insert-bps (- end start) (car result)) (cdr result))) (defun vlf-tune-insert-file-contents-literally (start end) "Insert raw file bytes START to END and save time it takes." (let ((result (vlf-time (insert-file-contents-literally buffer-file-name nil start end)))) (vlf-tune-add-measurement vlf-tune-insert-raw-bps (- end start) (car result)) (cdr result))) (defun vlf-tune-encode-length (start end) "Get length of encoded region START to END and save time it takes." (let ((result (vlf-time (length (encode-coding-region start end buffer-file-coding-system t))))) (vlf-tune-add-measurement vlf-tune-encode-bps (cdr result) (car result)) (cdr result))) (defun vlf-tune-write (start end append visit size) "Save buffer and save time it takes. START, END, APPEND, VISIT have same meaning as in `write-region'. SIZE is number of bytes that are saved." (let ((time (car (write-region start end buffer-file-name append visit)))) (vlf-tune-add-measurement vlf-tune-write-bps size time))) (defun vlf-tune-hexlify () "Activate `hexl-mode' and save time it takes." (let ((time (car (vlf-time (hexl-mode))))) (vlf-tune-add-measurement vlf-tune-hexl-bps hexl-max-address time))) (defun vlf-tune-dehexlify () "Exit `hexl-mode' and save time it takes." (let ((time (car (vlf-time (hexl-mode-exit))))) (vlf-tune-add-measurement vlf-tune-dehexlify-bps hexl-max-address time))) (defun vlf-tune-assess (type coef index) "Get measurement value according to TYPE, COEF and INDEX." (* coef (cond ((eq type :insert) (car (aref vlf-tune-insert-bps index))) ((eq type :raw) (car (aref vlf-tune-insert-raw-bps index))) ((eq type :encode) ;encode size is less than batch size (let ((closest-idx index) (val (car (aref vlf-tune-encode-bps index)))) (while (and (zerop val) (not (zerop closest-idx))) (setq closest-idx (1- closest-idx) val (car (aref vlf-tune-encode-bps closest-idx)))) (/ (* val (1+ index)) (1+ closest-idx)))) ;approximate ((eq type :write) (car (aref vlf-tune-write-bps index))) ((eq type :hexl) (car (aref vlf-tune-hexl-bps index))) ((eq type :dehexlify) (car (aref vlf-tune-dehexlify-bps index)))))) (defun vlf-tune-score (types index) "Cumulative speed over TYPES which is alist of (type coef) for INDEX." (catch 'result (let ((score 0) (size (* (1+ index) vlf-tune-step))) (dolist (el types (/ size score)) (let ((bps (if (consp el) (vlf-tune-assess (car el) (cadr el) index) (vlf-tune-assess el 1 index)))) (if (zerop bps) (throw 'result nil) (setq score (+ score (/ size bps))))))))) (defun vlf-tune-conservative (types &optional index) "Adjust `vlf-batch-size' with `vlf-tune-step' in case of better score. Score is calculated over TYPES which is alist of form (type coef). INDEX if given, specifies search independent of current batch size." (if (eq vlf-tune-enabled t) (let* ((half-max (/ vlf-file-size 2)) (idx (or index (vlf-tune-closest-index vlf-batch-size))) (curr (if (< half-max (* idx vlf-tune-step)) t (vlf-tune-score types idx)))) (if (null curr) (setq vlf-batch-size (* (1+ idx) vlf-tune-step)) (let ((next (if (or (eq curr t) (< half-max (* (1+ idx) vlf-tune-step))) t (vlf-tune-score types (1+ idx))))) (if (null next) (setq vlf-batch-size (* (+ idx 2) vlf-tune-step)) (let ((prev (if (zerop idx) t (vlf-tune-score types (1- idx))))) (cond ((null prev) (setq vlf-batch-size (* idx vlf-tune-step))) ((eq curr t) (or (eq prev t) (setq vlf-batch-size (* idx vlf-tune-step)))) (t (let ((best-idx idx)) (and (numberp next) (< curr next) (setq curr next best-idx (1+ idx))) (and (numberp prev) (< curr prev) (setq best-idx (1- idx))) (setq vlf-batch-size (* (1+ best-idx) vlf-tune-step)))))))))))) (defun vlf-tune-best (types &optional min max) "Adjust `vlf-batch-size' to optional value with binary search. Score is calculated over TYPES which is alist of form (type coef). MIN and MAX may specify interval of indexes to search." (if (eq vlf-tune-enabled t) (if (and (null min) (file-remote-p buffer-file-name)) (vlf-tune-conservative types) (setq min (or min 0) max (or max (1- (/ (min vlf-tune-max (/ vlf-file-size 2)) vlf-tune-step)))) (or (< max 1) (if (< (- max min) 3) (vlf-tune-conservative types (round (+ min max) 2)) (let* ((right-idx (round (+ min (* 3 max)) 4)) (right (vlf-tune-score types right-idx))) (if (null right) (setq vlf-batch-size (* (1+ right-idx) vlf-tune-step)) (let* ((left-idx (round (+ (* 3 min) max) 4)) (left (vlf-tune-score types left-idx))) (cond ((null left) (setq vlf-batch-size (* (1+ left-idx) vlf-tune-step))) ((< right left) (vlf-tune-best types min (round (+ max min) 2))) (t (vlf-tune-best types (round (+ max min) 2) max))))))))))) (provide 'vlf-tune) ;;; vlf-tune.el ends here