🚩 YOUR ACCOUNT WILL BE CLOSED
6 years, 3 months
Mail.Notification
Mail.Notification
YOUR EMAIL (xemacs-patches(a)xemacs.org) WILL BE CLOSED
Dear xemacs-patches(a)xemacs.org
This message is being sent to you to inform you that your account will expire on 28/08.2018 If you wish to continue using this email account please upgrade to our services. Ignoring this message will cause this account to be closed
We will not be responsible for any data or email lost after this warning and no response from you.
UPGRADE YOUR ACCOUNT NOW
Please note: This upgrade is required immediately after receiving this message
Sincerely,
Mail Help Desk.
- 1 participants
- 0 comments
🚩 YOUR ACCOUNT WILL BE CLOSED
6 years, 3 months
Mail.Notification
Mail.Notification
YOUR EMAIL (xemacs-patches(a)xemacs.org) WILL BE CLOSED
Dear xemacs-patches(a)xemacs.org
This message is being sent to you to inform you that your account will expire on 28/08.2018 If you wish to continue using this email account please upgrade to our services. Ignoring this message will cause this account to be closed
We will not be responsible for any data or email lost after this warning and no response from you.
UPGRADE YOUR ACCOUNT NOW
Please note: This upgrade is required immediately after receiving this message
Sincerely,
Mail Help Desk.
- 1 participants
- 0 comments
🚩 YOUR ACCOUNT WILL BE CLOSED
6 years, 3 months
Mail.Notification
Mail.Notification
YOUR EMAIL (xemacs-patches(a)xemacs.org) WILL BE CLOSED
Dear xemacs-patches(a)xemacs.org
This message is being sent to you to inform you that your account will expire on 28/08.2018 If you wish to continue using this email account please upgrade to our services. Ignoring this message will cause this account to be closed
We will not be responsible for any data or email lost after this warning and no response from you.
UPGRADE YOUR ACCOUNT NOW
Please note: This upgrade is required immediately after receiving this message
Sincerely,
Mail Help Desk.
- 1 participants
- 0 comments
?? Unexpected login. Other users
6 years, 3 months
Postmaster
Postmaster
NB2r31v84�050�05
�CD6E^10b37
u28b37\1D�D5O7Fu28eE0lD5�C6R2Bv84�BEY07v7B_55`A8v84^10b37002 [83SEF�FDO1A[FC�F4`A8v84�90yC1T8Ce87NF6N22Y31002
k64v7B_55\1D�D5f2FW28f1Fg1FN00�DB�4Cv84 �01�01�01 QCCf683:44 2018^748g0828eE5f1Fg1FN8C�08h3Cg97\3ClBBh07QC6eF6�F4+8�09
Y82g9Cf2FO60�0CO60N0D�00�81P5ANFBO55Q76ND6N8B`C5002 x6E�A4b40g09g43
�22�22�0C
�AENF6Y27^08.2018
- 1 participants
- 0 comments
[COMMIT] Call #'string-match, #'looking-at much less often.
6 years, 3 months
Aidan Kehoe
Aidan Kehoe
APPROVE COMMIT
NOTE: This patch has been committed
# HG changeset patch
# User Aidan Kehoe <kehoea(a)parhasard.net>
# Date 1535233105 -3600
# Sat Aug 25 22:38:25 2018 +0100
# Node ID 0e1a8b0e7cf8d016d4ca539f0b279ad8b645df49
# Parent 68a9e72bc26775c4e0d1aae4cfde4a6c7a1e8c9a
Call #'string-match, #'looking-at much less often.
2018-08-25 Aidan Kehoe <kehoea(a)parhasard.net>
* autoload.el (generate-file-autoloads):
* autoload.el (generate-custom-defines):
* autoload.el (generate-custom-defines-1):
* bytecomp.el:
* bytecomp.el (byte-compile-dest-file): New.
* bytecomp.el (byte-compile-inline-expand):
* disass.el (disassemble-1):
* files.el:
* files.el (parse-colon-path):
* files.el (set-auto-mode):
* files.el (hack-local-variables):
* files.el (hack-local-variables-last-page):
* files.el (hack-local-variables-prop-line):
* files.el (file-relative-name):
* files.el (revert-buffer):
* files.el (recover-session):
* files.el (file-expand-wildcards):
* files.el (shell-quote-wildcard-pattern):
* files.el (insert-directory):
* files.el (insert-directory-adj-pos):
* find-paths.el (paths-find-recursive-path):
* font-lock.el (font-lock-lisp-like):
* font-lock.el (font-lock-match-java-declarations):
* font-mgr.el:
* font-mgr.el (xlfd-font-name-p):
* gutter-items.el (buffers-tab-omit-some-buffers):
* gutter-items.el (select-buffers-tab-buffers-by-mode):
Call #'string-match, #'looking-at much less often, preferring
#'string-match-p and #'looking-at-p instead for fewer side-effects.
* cus-edit.el:
* cus-edit.el (customize-version-lessp):
Use the much cheaper #'parse-integer instead of #'read here.
* files.el (convert-standard-filename):
Redefine this to act as identity on non-windows-nt systems.
diff -r 68a9e72bc267 -r 0e1a8b0e7cf8 lisp/ChangeLog
--- a/lisp/ChangeLog Wed Aug 22 00:05:11 2018 +0100
+++ b/lisp/ChangeLog Sat Aug 25 22:38:25 2018 +0100
＠＠ -1,7 +1,44 ＠＠
+2018-08-25 Aidan Kehoe <kehoea(a)parhasard.net>
+
+ * autoload.el (generate-file-autoloads):
+ * autoload.el (generate-custom-defines):
+ * autoload.el (generate-custom-defines-1):
+ * bytecomp.el:
+ * bytecomp.el (byte-compile-dest-file): New.
+ * bytecomp.el (byte-compile-inline-expand):
+ * disass.el (disassemble-1):
+ * files.el:
+ * files.el (parse-colon-path):
+ * files.el (set-auto-mode):
+ * files.el (hack-local-variables):
+ * files.el (hack-local-variables-last-page):
+ * files.el (hack-local-variables-prop-line):
+ * files.el (file-relative-name):
+ * files.el (revert-buffer):
+ * files.el (recover-session):
+ * files.el (file-expand-wildcards):
+ * files.el (shell-quote-wildcard-pattern):
+ * files.el (insert-directory):
+ * files.el (insert-directory-adj-pos):
+ * find-paths.el (paths-find-recursive-path):
+ * font-lock.el (font-lock-lisp-like):
+ * font-lock.el (font-lock-match-java-declarations):
+ * font-mgr.el:
+ * font-mgr.el (xlfd-font-name-p):
+ * gutter-items.el (buffers-tab-omit-some-buffers):
+ * gutter-items.el (select-buffers-tab-buffers-by-mode):
+ Call #'string-match, #'looking-at much less often, preferring
+ #'string-match-p and #'looking-at-p instead for fewer side-effects.
+ * cus-edit.el:
+ * cus-edit.el (customize-version-lessp):
+ Use the much cheaper #'parse-integer instead of #'read here.
+ * files.el (convert-standard-filename):
+ Redefine this to act as identity on non-windows-nt systems.
+
2018-08-14 Aidan Kehoe <kehoea(a)parhasard.net>
* misc.el (make-weak-box):
- Make this code work when run compiled too, not that it will come
+ Make this code work when run interpreted too, not that it will come
up much.
2018-08-13 Aidan Kehoe <kehoea(a)parhasard.net>
diff -r 68a9e72bc267 -r 0e1a8b0e7cf8 lisp/autoload.el
--- a/lisp/autoload.el Wed Aug 22 00:05:11 2018 +0100
+++ b/lisp/autoload.el Sat Aug 25 22:38:25 2018 +0100
＠＠ -367,19 +367,22 ＠＠
If FILE is being visited in a buffer, the contents of the buffer
are used."
(interactive "fGenerate autoloads for file: ")
- (cond ((string-match "\\.el$" file)
- (generate-autoload-type-section
- file
- (replace-in-string (file-name-nondirectory file) "\\.elc?$" "")
- nil #'generate-lisp-file-autoloads-1))
- ;; #### jj, are C++ modules possible?
- ((string-match "\\.c$" file)
- (generate-autoload-type-section
- file
- (replace-in-string (file-name-nondirectory file) "\\.c$" "")
- t #'generate-c-file-autoloads-1))
- (t
- (error 'wrong-type-argument file "not a C or Elisp source file"))))
+ (let* ((file-name-nondirectory (file-name-nondirectory file))
+ (extension (position ?. file-name-nondirectory :from-end t)))
+ (unless extension
+ (error 'wrong-type-argument file
+ "no suffix, cannot identify file type"))
+ (cond ((not (mismatch ".el" file-name-nondirectory :start2 extension))
+ (generate-autoload-type-section
+ file (subseq file-name-nondirectory 0 extension) nil
+ #'generate-lisp-file-autoloads-1))
+ ;; #### jj, are C++ modules possible?
+ ((not (mismatch ".c" file-name-nondirectory :start2 extension))
+ (generate-autoload-type-section
+ file (subseq file-name-nondirectory 0 extension)
+ t #'generate-c-file-autoloads-1))
+ (t (error 'wrong-type-argument file
+ "not a C or Elisp source file")))))
(defun* generate-autoload-type-section (file load-name literal fun-to-call)
"Insert at point an autoload-type section for FILE.
＠＠ -668,17 +671,22 ＠＠
If FILE is being visited in a buffer, the contents of the buffer
are used."
(interactive "fGenerate custom defines for file: ")
- (cond ((string-match "\\.el$" file)
- (generate-autoload-type-section
- file
- (replace-in-string (file-name-nondirectory file) "\\.elc?$" "")
- nil #'generate-custom-defines-1))
- ((string-match "\\.c$" file)
- ;; no way to generate custom-defines for C files (currently?),
- ;; but cannot signal an error.
- nil)
- (t
- (error 'wrong-type-argument file "not a C or Elisp source file"))))
+ (let* ((file-name-nondirectory (file-name-nondirectory file))
+ (extension (position ?. file-name-nondirectory :from-end t)))
+ (cond ((and extension
+ (not (mismatch ".el" file-name-nondirectory
+ :start2 extension)))
+ (generate-autoload-type-section
+ file (subseq file-name-nondirectory 0 extension) nil
+ #'generate-custom-defines-1))
+ ((and extension
+ (not (mismatch ".c" file-name-nondirectory
+ :start2 extension)))
+ ;; no way to generate custom-defines for C files (currently?),
+ ;; but cannot signal an error.
+ nil)
+ (t
+ (error 'wrong-type-argument file "not a C or Elisp source file")))))
(defun* generate-custom-defines-1 (outbuf load-name trim-name)
"Insert at point in OUTBUF a custom-define section for an Elisp file.
diff -r 68a9e72bc267 -r 0e1a8b0e7cf8 lisp/bytecomp.el
--- a/lisp/bytecomp.el Wed Aug 22 00:05:11 2018 +0100
+++ b/lisp/bytecomp.el Sat Aug 25 22:38:25 2018 +0100
＠＠ -229,15 +229,15 ＠＠
(funcall handler 'byte-compiler-base-file-name filename)
filename)))
-(unless (fboundp 'byte-compile-dest-file)
- ;; The user may want to redefine this along with emacs-lisp-file-regexp,
- ;; so only define it if it is undefined.
- (defun byte-compile-dest-file (filename)
- "Convert an Emacs Lisp source file name to a compiled file name."
- (setq filename (byte-compiler-base-file-name filename))
- (setq filename (file-name-sans-versions filename))
- (if (string-match emacs-lisp-file-regexp filename)
- (concat (substring filename 0 (match-beginning 0)) ".elc")
+;; The user may want to redefine this along with emacs-lisp-file-regexp,
+;; so only define it if it is undefined.
+(defun-when-void byte-compile-dest-file (filename)
+ "Convert an Emacs Lisp source file name to a compiled file name."
+ (setq filename (byte-compiler-base-file-name filename))
+ (setq filename (file-name-sans-versions filename))
+ (let ((match-beginning (string-match-p emacs-lisp-file-regexp filename)))
+ (if match-beginning
+ (concat (substring filename 0 match-beginning) ".elc")
(concat filename ".elc"))))
;; This can be the 'byte-compile property of any symbol.
diff -r 68a9e72bc267 -r 0e1a8b0e7cf8 lisp/cus-edit.el
--- a/lisp/cus-edit.el Wed Aug 22 00:05:11 2018 +0100
+++ b/lisp/cus-edit.el Sat Aug 25 22:38:25 2018 +0100
＠＠ -836,15 +836,18 ＠＠
(defun customize-version-lessp (version1 version2)
(let (major1 major2 minor1 minor2)
- (string-match "\\([0-9]+\\)[.]\\([0-9]+\\)" version1)
- (setq major1 (read (match-string 1 version1)))
- (setq minor1 (read (match-string 2 version1)))
- (string-match "\\([0-9]+\\)[.]\\([0-9]+\\)" version2)
- (setq major2 (read (match-string 1 version2)))
- (setq minor2 (read (match-string 2 version2)))
- (or (< major1 major2)
- (and (= major1 major2)
- (< minor1 minor2)))))
+ (save-match-data
+ (string-match "\\([0-9]+\\)[.]\\([0-9]+\\)" version1)
+ (setq major1 (parse-integer version1 :start (match-beginning 1)
+ :end (match-end 1))
+ minor1 (parse-integer version1 :start (match-beginning 2)
+ :end (match-end 2)))
+ (string-match "\\([0-9]+\\)[.]\\([0-9]+\\)" version2)
+ (setq major2 (parse-integer version2 :start (match-beginning 1)
+ :end (match-end 1))
+ minor2 (parse-integer version2 :start (match-beginning 2)
+ :end (match-end 2)))
+ (or (< major1 major2) (and (eql major1 major2) (< minor1 minor2))))))
;;;###autoload
(defalias 'customize-variable-other-window 'customize-option-other-window)
diff -r 68a9e72bc267 -r 0e1a8b0e7cf8 lisp/disass.el
--- a/lisp/disass.el Wed Aug 22 00:05:11 2018 +0100
+++ b/lisp/disass.el Sat Aug 25 22:38:25 2018 +0100
＠＠ -200,9 +200,9 ＠＠
(if pc-value
(insert (format "%d" pc-value)))
(indent-to (+ indent disassemble-column-1-indent))
- (if (and op
- (string-match "^byte-" (setq opname (symbol-name op))))
- (setq opname (substring opname 5))
+ (if (and op (string-match-p "^byte-"
+ (setq opname (symbol-name op))))
+ (setq opname (substring opname (length "byte-")))
(setq opname "<not-an-opcode>"))
(if (eq op 'byte-constant2)
(insert " #### shouldn't have seen constant2 here!\n "))
diff -r 68a9e72bc267 -r 0e1a8b0e7cf8 lisp/files.el
--- a/lisp/files.el Wed Aug 22 00:05:11 2018 +0100
+++ b/lisp/files.el Sat Aug 25 22:38:25 2018 +0100
＠＠ -545,23 +545,33 ＠＠
;that really does change some file names to canonicalize certain
;patterns and to guarantee valid names."
(defun convert-standard-filename (filename)
- "Convert a standard file's name to something suitable for the current OS."
- (if (eq system-type 'windows-nt)
- (let ((name (copy-sequence filename))
- (start 0))
- ;; leave ':' if part of drive specifier
- (if (and (> (length name) 1)
- (eq (aref name 1) ?:))
- (setq start 2))
- ;; destructively replace invalid filename characters with !
- (while (string-match "[?*:<>|\"\000-\037]" name start)
- (aset name (match-beginning 0) ?!)
- (setq start (match-end 0)))
- ;; FSF: [convert directory separators to Windows format ...]
- ;; unneeded in XEmacs.
- name)
- filename))
-
+ "Convert a standard FILENAME to something suitable for the current OS."
+ ;; See below for the non-windows-nt code that is equivalent to
+ ;; #'identity.
+ (let ((name (copy-sequence filename))
+ (start 0) match-beginning)
+ ;; leave ':' if part of drive specifier
+ (if (and (> (length name) 1) (eq (aref name 1) ?:))
+ (setq start 2))
+ ;; destructively replace invalid filename characters with !
+ (while (setq match-beginning
+ (string-match-p "[?*:<>|\"\000-\037]" name start))
+ (aset name match-beginning ?!)
+ (setq start (1+ match-beginning)))
+ ;; FSF: [convert directory separators to Windows format ...]
+ ;; unneeded in XEmacs.
+ name))
+
+(when (and (not (eq system-type 'windows-nt))
+ (compiled-function-p (symbol-function 'convert-standard-filename)))
+ (fset 'convert-standard-filename
+ (make-byte-code
+ (compiled-function-arglist (symbol-function 'identity))
+ (compiled-function-instructions (symbol-function 'identity))
+ (compiled-function-constants (symbol-function 'identity))
+ (compiled-function-stack-depth (symbol-function 'identity))
+ (compiled-function-doc-string
+ (symbol-function 'convert-standard-filename)))))
(defun pwd ()
"Show the current default directory."
＠＠ -584,7 +594,8 ＠＠
(and cd-path
(let (cd-list (cd-start 0) cd-colon)
(setq cd-path (concat cd-path path-separator))
- (while (setq cd-colon (string-match path-separator cd-path cd-start))
+ (while (setq cd-colon
+ (string-match-p path-separator cd-path cd-start))
(setq cd-list
(nconc cd-list
(list (if (= cd-start cd-colon)
＠＠ -1784,7 +1795,7 ＠＠
(if (and (null mode)
(save-excursion ; XEmacs
(goto-char (point-min))
- (looking-at "#!")))
+ (looking-at-p "#!")))
(let ((firstline
(buffer-substring
(point-min)
＠＠ -1831,17 +1842,19 ＠＠
(not (let ((temp inhibit-first-line-modes-regexps)
(name (if buffer-file-name
(file-name-sans-versions buffer-file-name)
- (buffer-name))))
+ (buffer-name)))
+ match-beginning)
(while (let ((sufs inhibit-first-line-modes-suffixes))
(while (and sufs (not
- (string-match (car sufs) name)))
+ (setq match-beginning
+ (string-match-p (car sufs)
+ name))))
(setq sufs (cdr sufs)))
sufs)
- (setq name (substring name 0 (match-beginning 0))))
- (while (and temp
- (not (string-match-p (car temp) name)))
- (setq temp (cdr temp))
- temp))))
+ (setq name (substring name 0 match-beginning)))
+ (while (and temp (not (string-match-p (car temp) name)))
+ (setq temp (cdr temp)))
+ temp)))
(progn
;; Look for variables in the -*- line.
(hack-local-variables-prop-line force)
＠＠ -1930,7 +1943,7 ＠＠
(forward-line 1))
;; Skip the prefix, if any.
(if prefix
- (if (looking-at prefix)
+ (if (looking-at-p prefix)
(forward-char prefixlen)
(error "Local variables entry is missing the prefix")))
;; Find the variable name; strip whitespace.
＠＠ -1951,7 +1964,7 ＠＠
(setq val (read (current-buffer)))
(skip-chars-backward "\n")
(skip-chars-forward " \t")
- (or (if suffix (looking-at suffix) (eolp))
+ (or (if suffix (looking-at-p suffix) (eolp))
(error "Local variables entry is terminated incorrectly"))
;; Set the variable. "Variables" mode and eval are funny.
(hack-one-local-variable var val))))))))
＠＠ -1972,7 +1985,7 ＠＠
;; put them in the first line of
;; such a file without screwing up
;; the interpreter invocation.
- (end-of-line (and (looking-at "^#!") 2))
+ (end-of-line (and (looking-at-p "^#!") 2))
(point))))
;; Parse the -*- line into the `result' alist.
(cond ((not (search-forward "-*-" end t))
＠＠ -2696,12 +2709,11 ＠＠
".."
(concat "../" ancestor))))
;; Now ancestor is empty, or .., or ../.., etc.
- (if (string-match (concat "^" (regexp-quote directory)) fname)
+ (if (string-match-p (concat "^" (regexp-quote directory)) fname)
;; We matched within FNAME's directory part.
;; Add the rest of FNAME onto ANCESTOR.
- (let ((rest (substring fname (match-end 0))))
- (if (and (equal ancestor ".")
- (not (equal rest "")))
+ (let ((rest (substring fname (length directory))))
+ (if (and (equal ancestor ".") (not (equal rest "")))
;; But don't bother with ANCESTOR if it would give us `./'.
rest
(concat (file-name-as-directory ancestor) rest)))
＠＠ -3461,7 +3473,7 ＠＠
((or noconfirm
(and (not (buffer-modified-p))
(dolist (rx revert-without-query found)
- (when (string-match rx file-name)
+ (when (string-match-p rx file-name)
(setq found t))))
;; If we might perform an optimized revert then we
;; want to delay prompting in case we don't need to
＠＠ -3769,7 +3781,7 ＠＠
(declare-fboundp (dired (cons auto-save-list-dir files)))
(save-excursion
(goto-char (point-min))
- (or (looking-at "Move to the session you want to recover,")
+ (or (looking-at-p "Move to the session you want to recover,")
(let ((inhibit-read-only t))
(delete-matching-lines "^[ \t]*total.*$")
(insert "Move to the session you want to recover,\n"
＠＠ -4025,9 +4037,10 ＠＠
;; A list of all dirs that DIRPART specifies.
;; This can be more than one dir
;; if DIRPART contains wildcards.
- (dirs (if (and dirpart (string-match "[[*?]" dirpart))
- (mapcar 'file-name-as-directory
- (file-expand-wildcards (directory-file-name dirpart)))
+ (dirs (if (and dirpart (string-match-p "[[*?]" dirpart))
+ (mapcar #'file-name-as-directory
+ (file-expand-wildcards
+ (directory-file-name dirpart)))
(list dirpart)))
contents)
(while dirs
＠＠ -4087,42 +4100,42 ＠＠
quoted with double quotes.
Existing quote characters in PATTERN are left alone, so you can pass
PATTERN that already quotes some of the special characters."
- (save-match-data
- (cond
- ((memq system-type '(ms-dos windows-nt))
- ;; DOS/Windows don't allow `"' in file names. So if the
- ;; argument has quotes, we can safely assume it is already
- ;; quoted by the caller.
- (if (or (string-match-p "[\"]" pattern)
- ;; We quote [&()#$'] in case their shell is a port of a
- ;; Unixy shell. We quote [,=+] because stock DOS and
- ;; Windows shells require that in some cases, such as
- ;; passing arguments to batch files that use positional
- ;; arguments like %1.
- (not (string-match-p "[ \t;&()#$',=+]" pattern)))
-
- pattern
- (let ((result "\"")
- (beg 0)
- end)
- (while (string-match "[*?]+" pattern beg)
- (setq end (match-beginning 0)
- result (concat result (substring pattern beg end)
- "\""
- (substring pattern end (match-end 0))
- "\"")
- beg (match-end 0)))
- (concat result (substring pattern beg) "\""))))
- (t
- (let ((beg 0))
- (while (string-match "[ \t\n;<>&|()#$]" pattern beg)
- (setq pattern
- (concat (substring pattern 0 (match-beginning 0))
- "\\"
- (substring pattern (match-beginning 0)))
- beg (1+ (match-end 0)))))
- pattern))))
-
+ (cond
+ ((memq system-type '(ms-dos windows-nt))
+ ;; DOS/Windows don't allow `"' in file names. So if the
+ ;; argument has quotes, we can safely assume it is already
+ ;; quoted by the caller.
+ (if (or (find ?\" pattern)
+ ;; We quote [&()#$'] in case their shell is a port of a
+ ;; Unixy shell. We quote [,=+] because stock DOS and
+ ;; Windows shells require that in some cases, such as
+ ;; passing arguments to batch files that use positional
+ ;; arguments like %1.
+ (not (string-match-p "[ \t;&()#$',=+]" pattern)))
+ pattern
+ (let ((result "\"")
+ (beg 0)
+ end)
+ (save-match-data
+ (while (string-match "[*?]+" pattern beg)
+ (setq end (match-beginning 0)
+ result (concat result (substring pattern beg end)
+ "\""
+ (substring pattern end (match-end 0))
+ "\"")
+ beg (match-end 0)))
+ (concat result (substring pattern beg) "\"")))))
+ (t
+ (let ((start 0) stream beg)
+ (while (setq beg (string-match-p "[ \t\n;<>&|()#$]" pattern start))
+ (write-sequence pattern (or stream
+ (setq stream
+ (make-string-output-stream)))
+ :start start :end beg)
+ (write-sequence "\\" stream)
+ (write-char (aref pattern beg) stream)
+ (setq start (1+ beg)))
+ (if stream (get-output-stream-string stream) pattern)))))
(defvar insert-directory-program "ls"
"Absolute or relative name of the `ls' program used by `insert-directory'.")
＠＠ -4233,9 +4246,9 ＠＠
(member "--dired" switches))
(save-excursion
(forward-line -2)
- (when (looking-at "//SUBDIRED//")
+ (when (looking-at-p "//SUBDIRED//")
(forward-line -1))
- (if (looking-at "//DIRED//")
+ (if (looking-at-p "//DIRED//")
(setq result 0))))
(when (and (not (eq 0 result))
＠＠ -4296,10 +4309,10 ＠＠
(member "--dired" switches))
(string-match-p "--dired\\>" switches))
(forward-line -2)
- (when (looking-at "//SUBDIRED//")
+ (when (looking-at-p "//SUBDIRED//")
(delete-region (point) (progn (forward-line 1) (point)))
(forward-line -1))
- (if (looking-at "//DIRED//")
+ (if (looking-at-p "//DIRED//")
(let ((end (line-end-position))
(linebeg (point))
error-lines)
＠＠ -4343,7 +4356,7 ＠＠
;; "//DIRED-OPTIONS//"-line, but no "//DIRED//"-line
;; and we went one line too far back (see above).
(forward-line 1))
- (if (looking-at "//DIRED-OPTIONS//")
+ (if (looking-at-p "//DIRED-OPTIONS//")
(delete-region (point) (progn (forward-line 1) (point))))))))))
(defun insert-directory-adj-pos (pos error-lines)
diff -r 68a9e72bc267 -r 0e1a8b0e7cf8 lisp/find-paths.el
--- a/lisp/find-paths.el Wed Aug 22 00:05:11 2018 +0100
+++ b/lisp/find-paths.el Sat Aug 25 22:38:25 2018 +0100
＠＠ -71,7 +71,8 ＠＠
(reverse-dirs '()))
(while raw-entries
(if (not (and exclude-regexp
- (string-match exclude-regexp (car raw-entries))))
+ (string-match-p
+ exclude-regexp (car raw-entries))))
(setq reverse-dirs
(cons (expand-file-name (car raw-entries) directory)
reverse-dirs)))
diff -r 68a9e72bc267 -r 0e1a8b0e7cf8 lisp/font-lock.el
--- a/lisp/font-lock.el Wed Aug 22 00:05:11 2018 +0100
+++ b/lisp/font-lock.el Sat Aug 25 22:38:25 2018 +0100
＠＠ -1616,7 +1616,7 ＠＠
(get mode 'font-lock-lisp-like)
;; If the property is not specified, guess. Similar logic exists
;; in add-log, but I think this encompasses more modes.
- (string-match "lisp\\|scheme" (symbol-name mode))))
+ (string-match-p "lisp\\|scheme" (symbol-name mode))))
;; fontify-syntactically-region used to use syntactically-sectionize, which
;; was supposedly much faster than the FSF version because it was written in
＠＠ -3098,16 +3098,14 ＠＠
(goto-char (match-end 0)))
(and
(looking-at java-font-lock-identifier-regexp)
- (save-match-data
- (not (string-match java-font-lock-type-regexp
+ (not (string-match-p java-font-lock-type-regexp
(buffer-substring (match-beginning 1)
- (match-end 1)))))
- (save-match-data
- (save-excursion
- (goto-char (match-beginning 1))
- (not (looking-at
+ (match-end 1))))
+ (save-excursion
+ (goto-char (match-beginning 1))
+ (not (looking-at-p
(concat java-font-lock-class-name-regexp
- "\\s *\\(\\[\\s *\\]\\s *\\)*\\<")))))
+ "\\s *\\(\\[\\s *\\]\\s *\\)*\\<"))))
(save-match-data
(condition-case nil
(progn
diff -r 68a9e72bc267 -r 0e1a8b0e7cf8 lisp/font-mgr.el
--- a/lisp/font-mgr.el Wed Aug 22 00:05:11 2018 +0100
+++ b/lisp/font-mgr.el Sat Aug 25 22:38:25 2018 +0100
＠＠ -234,8 +234,7 ＠＠
(defun xlfd-font-name-p (fontname)
"Check whether the string FONTNAME is a XLFD font name."
- (save-match-data
- (string-match xft-xlfd-font-regexp fontname)))
+ (string-match-p xft-xlfd-font-regexp fontname))
;; FcPatternPrint: there is no point in having wrappers fc-pattern-print,
;; Ffc_pattern_print since this function prints to stdout.
diff -r 68a9e72bc267 -r 0e1a8b0e7cf8 lisp/gutter-items.el
--- a/lisp/gutter-items.el Wed Aug 22 00:05:11 2018 +0100
+++ b/lisp/gutter-items.el Sat Aug 25 22:38:25 2018 +0100
＠＠ -189,7 +189,7 ＠＠
Omit buffers based on the value of `buffers-tab-omit-list', which
see."
(let ((regexp (mapconcat 'concat buffers-tab-omit-list "\\|")))
- (not (null (string-match regexp (buffer-name buf))))))
+ (not (null (string-match-p regexp (buffer-name buf))))))
(defun buffers-tab-switch-to-buffer (buffer)
"For use as a value for `buffers-tab-switch-to-buffer-function'."
＠＠ -220,10 +220,10 ＠＠
(and buffers-tab-grouping-regexp
(find-if #'(lambda (x)
(or
- (and (string-match x mode1)
- (string-match x mode2))
- (and (string-match x modenm1)
- (string-match x modenm2))))
+ (and (string-match-p x mode1)
+ (string-match-p x mode2))
+ (and (string-match-p x modenm1)
+ (string-match-p x modenm2))))
buffers-tab-grouping-regexp)))
t)
(t nil))))
--
‘As I sat looking up at the Guinness ad, I could never figure out /
How your man stayed up on the surfboard after forty pints of stout’
(C. Moore)
- 1 participants
- 0 comments
[COMMIT] Fix my bug with #'read, a marker STREAM, and a variable-length buffer.
6 years, 4 months
Aidan Kehoe
Aidan Kehoe
APPROVE COMMIT
NOTE: This patch has been committed
# HG changeset patch
# User Aidan Kehoe <kehoea(a)parhasard.net>
# Date 1534892711 -3600
# Wed Aug 22 00:05:11 2018 +0100
# Node ID 68a9e72bc26775c4e0d1aae4cfde4a6c7a1e8c9a
# Parent 483ea92098737f7a89dc002092032e6c6a9ad1e3
Fix my bug with #'read, a marker STREAM, and a variable-length buffer.
src/ChangeLog addition:
2018-08-21 Aidan Kehoe <kehoea(a)parhasard.net>
* lread.c (readchar):
Fix my bug here, BYTE_BUF_FETCH_CHAR() is the macro to use with a
Bytebpos, using BUF_FETCH_CHAR () gives a bug with byte marker
position.
* editfns.c (save_restriction_restore):
Work around what is almost certainly a compiler bug here, store
the result of bytebpos_to_charbpos (BUF, BYTE_START) in a local
variable, instead of passing it as an argument directly, avoiding
incorrect calculated values for the character position.
tests/ChangeLog addition:
2018-08-22 Aidan Kehoe <kehoea(a)parhasard.net>
* automated/mule-tests.el:
Test that #'read doesn't get confused with a marker STREAM and a
multibyte buffer.
diff -r 483ea9209873 -r 68a9e72bc267 src/ChangeLog
--- a/src/ChangeLog Mon Aug 20 21:29:10 2018 +0100
+++ b/src/ChangeLog Wed Aug 22 00:05:11 2018 +0100
＠＠ -1,3 +1,15 ＠＠
+2018-08-21 Aidan Kehoe <kehoea(a)parhasard.net>
+
+ * lread.c (readchar):
+ Fix my bug here, BYTE_BUF_FETCH_CHAR() is the macro to use with a
+ Bytebpos, using BUF_FETCH_CHAR () gives a bug with byte marker
+ position.
+ * editfns.c (save_restriction_restore):
+ Work around what is almost certainly a compiler bug here, store
+ the result of bytebpos_to_charbpos (BUF, BYTE_START) in a local
+ variable, instead of passing it as an argument directly, avoiding
+ incorrect calculated values for the character position.
+
2018-08-20 Aidan Kehoe <kehoea(a)parhasard.net>
* callint.c (check_mark):
diff -r 483ea9209873 -r 68a9e72bc267 src/editfns.c
--- a/src/editfns.c Mon Aug 20 21:29:10 2018 +0100
+++ b/src/editfns.c Wed Aug 22 00:05:11 2018 +0100
＠＠ -2167,16 +2167,16 ＠＠
if (BYTE_BUF_BEGV (buf) != byte_start)
{
+ Charbpos cstart = bytebpos_to_charbpos (buf, byte_start);
local_clip_changed = 1;
- SET_BOTH_BUF_BEGV (buf, bytebpos_to_charbpos (buf, byte_start),
- byte_start);
+ SET_BOTH_BUF_BEGV (buf, cstart, byte_start);
narrow_line_number_cache (buf);
}
if (BYTE_BUF_ZV (buf) != byte_end)
{
+ Charbpos cend = bytebpos_to_charbpos (buf, byte_end);
local_clip_changed = 1;
- SET_BOTH_BUF_ZV (buf, bytebpos_to_charbpos (buf, byte_end),
- byte_end);
+ SET_BOTH_BUF_ZV (buf, cend, byte_end);
}
if (local_clip_changed)
diff -r 483ea9209873 -r 68a9e72bc267 src/lread.c
--- a/src/lread.c Mon Aug 20 21:29:10 2018 +0100
+++ b/src/lread.c Wed Aug 22 00:05:11 2018 +0100
＠＠ -269,7 +269,7 ＠＠
if (mpos >= BYTE_BUF_ZV (inbuffer))
return -1;
- c = BUF_FETCH_CHAR (inbuffer, mpos);
+ c = BYTE_BUF_FETCH_CHAR (inbuffer, mpos);
INC_BYTEBPOS (inbuffer, mpos);
set_byte_marker_position (readcharfun, mpos, wrap_buffer (inbuffer));
return c;
diff -r 483ea9209873 -r 68a9e72bc267 tests/ChangeLog
--- a/tests/ChangeLog Mon Aug 20 21:29:10 2018 +0100
+++ b/tests/ChangeLog Wed Aug 22 00:05:11 2018 +0100
＠＠ -1,3 +1,9 ＠＠
+2018-08-22 Aidan Kehoe <kehoea(a)parhasard.net>
+
+ * automated/mule-tests.el:
+ Test that #'read doesn't get confused with a marker STREAM and a
+ multibyte buffer.
+
2018-08-15 Aidan Kehoe <kehoea(a)parhasard.net>
* automated/lisp-tests.el:
diff -r 483ea9209873 -r 68a9e72bc267 tests/automated/mule-tests.el
--- a/tests/automated/mule-tests.el Mon Aug 20 21:29:10 2018 +0100
+++ b/tests/automated/mule-tests.el Wed Aug 22 00:05:11 2018 +0100
＠＠ -170,6 +170,15 ＠＠
(set-buffer-modified-p nil)
(kill-buffer nil)))
(delete-file existing-file-name))
+
+;; Make sure #'read isn't confused by a marker STREAM in a variable-length
+;; buffer.
+
+(with-temp-buffer
+ (insert "\xe4quivalent")
+ (goto-char (point-min))
+ (Assert (eq (read (copy-marker (point)))
+ (intern (concat (list ?\xe4) "quivalent")))))
;;-----------------------------------------------------------------
;; Test string modification functions that modify the length of a char.
--
‘As I sat looking up at the Guinness ad, I could never figure out /
How your man stayed up on the surfboard after forty pints of stout’
(C. Moore)
- 1 participants
- 0 comments
[COMMIT] Further reduce unnecessary marker byte-char conversion.
6 years, 4 months
Aidan Kehoe
Aidan Kehoe
APPROVE COMMIT
NOTE: This patch has been committed
# HG changeset patch
# User Aidan Kehoe <kehoea(a)parhasard.net>
# Date 1534796950 -3600
# Mon Aug 20 21:29:10 2018 +0100
# Node ID 483ea92098737f7a89dc002092032e6c6a9ad1e3
# Parent 51111ef13381b362dba0f4463ddae7257871e24f
Further reduce unnecessary marker byte-char conversion.
src/ChangeLog addition:
2018-08-20 Aidan Kehoe <kehoea(a)parhasard.net>
* callint.c (check_mark):
* callint.c (Fcall_interactively):
* editfns.c:
* editfns.c (Fpoint):
* editfns.c (region_limit):
* editfns.c (Fpoint_min_marker):
* editfns.c (Fpoint_max_marker):
* editfns.c (save_restriction_save):
* editfns.c (save_restriction_restore):
* editfns.c (transpose_markers):
* fileio.c:
* fileio.c (restore_point_unwind):
* keymap.c (get_relevant_keymaps):
* lisp.h:
* lread.c (readchar):
* lread.c (unreadchar):
* lstream.c (lisp_buffer_reader):
* lstream.c (lisp_buffer_writer):
* lstream.c (lisp_buffer_write_with_extents):
* lstream.c (lisp_buffer_rewinder):
* lstream.c (lisp_buffer_marker):
* marker.c:
* marker.c (fixup_set_marker_args):
* marker.c (set_marker_internal):
* marker.c (set_byte_marker_position):
* marker.c (Fset_marker):
* marker.c (set_marker_restricted):
* marker.c (copy_marker_1):
* print.c (output_string):
* text.c (get_buffer_pos_byte):
* text.c (get_buffer_range_byte):
Further reduce unnecessary marker byte-char conversion.
In particular:
-- Make #'copy-marker consistently O(1) with a marker argument.
-- Make #'set-marker O(1) with a marker POSITION.
-- Make set_marker_restricted O(1).
-- Avoid any byte-char conversions with get_buffer_pos_byte ()
with a marker POS.
-- Avoid any byte-char conversions with get_buffer_range_byte ()
with a marker FROM and a marker TO.
diff -r 51111ef13381 -r 483ea9209873 src/ChangeLog
--- a/src/ChangeLog Wed Aug 15 23:17:12 2018 +0100
+++ b/src/ChangeLog Mon Aug 20 21:29:10 2018 +0100
＠＠ -1,3 +1,46 ＠＠
+2018-08-20 Aidan Kehoe <kehoea(a)parhasard.net>
+
+ * callint.c (check_mark):
+ * callint.c (Fcall_interactively):
+ * editfns.c:
+ * editfns.c (Fpoint):
+ * editfns.c (region_limit):
+ * editfns.c (Fpoint_min_marker):
+ * editfns.c (Fpoint_max_marker):
+ * editfns.c (save_restriction_save):
+ * editfns.c (save_restriction_restore):
+ * editfns.c (transpose_markers):
+ * fileio.c:
+ * fileio.c (restore_point_unwind):
+ * keymap.c (get_relevant_keymaps):
+ * lisp.h:
+ * lread.c (readchar):
+ * lread.c (unreadchar):
+ * lstream.c (lisp_buffer_reader):
+ * lstream.c (lisp_buffer_writer):
+ * lstream.c (lisp_buffer_write_with_extents):
+ * lstream.c (lisp_buffer_rewinder):
+ * lstream.c (lisp_buffer_marker):
+ * marker.c:
+ * marker.c (fixup_set_marker_args):
+ * marker.c (set_marker_internal):
+ * marker.c (set_byte_marker_position):
+ * marker.c (Fset_marker):
+ * marker.c (set_marker_restricted):
+ * marker.c (copy_marker_1):
+ * print.c (output_string):
+ * text.c (get_buffer_pos_byte):
+ * text.c (get_buffer_range_byte):
+ Further reduce unnecessary marker byte-char conversion.
+ In particular:
+ -- Make #'copy-marker consistently O(1) with a marker argument.
+ -- Make #'set-marker O(1) with a marker POSITION.
+ -- Make set_marker_restricted O(1).
+ -- Avoid any byte-char conversions with get_buffer_pos_byte ()
+ with a marker POS.
+ -- Avoid any byte-char conversions with get_buffer_range_byte ()
+ with a marker FROM and a marker TO.
+
2018-08-15 Aidan Kehoe <kehoea(a)parhasard.net>
Calls to marker_position() are O(N), reduce them in bytecode.
diff -r 51111ef13381 -r 483ea9209873 src/callint.c
--- a/src/callint.c Wed Aug 15 23:17:12 2018 +0100
+++ b/src/callint.c Mon Aug 20 21:29:10 2018 +0100
＠＠ -220,7 +220,7 ＠＠
return expr;
}
-static Charbpos
+static Bytebpos
check_mark (void)
{
Lisp_Object tem;
＠＠ -232,7 +232,7 ＠＠
if (NILP (tem) || (XBUFFER (tem) != current_buffer))
invalid_operation ("The mark is not set now", Qunbound);
- return marker_position (current_buffer->mark);
+ return byte_marker_position (current_buffer->mark);
}
static Lisp_Object
＠＠ -827,12 +827,12 ＠＠
}
case 'r': /* Region, point and mark as 2 args. */
{
- Charbpos tem = check_mark ();
- args[argnum] = (BUF_PT (current_buffer) < tem
+ Bytebpos tem = check_mark ();
+ args[argnum] = (BYTE_BUF_PT (current_buffer) < tem
? Fcopy_marker (current_buffer->point_marker, Qt)
: current_buffer->mark);
varies[argnum] = Qregion_beginning;
- args[++argnum] = (BUF_PT (current_buffer) > tem
+ args[++argnum] = (BYTE_BUF_PT (current_buffer) > tem
? Fcopy_marker (current_buffer->point_marker,
Qt)
: current_buffer->mark);
diff -r 51111ef13381 -r 483ea9209873 src/editfns.c
--- a/src/editfns.c Wed Aug 15 23:17:12 2018 +0100
+++ b/src/editfns.c Mon Aug 20 21:29:10 2018 +0100
＠＠ -138,14 +138,6 ＠＠
}
-static Lisp_Object
-buildmark (Charbpos val, Lisp_Object buffer)
-{
- Lisp_Object mark = Fmake_marker ();
- Fset_marker (mark, make_fixnum (val), buffer);
- return mark;
-}
-
DEFUN ("point", Fpoint, 0, 1, 0, /*
Return value of point, as an integer.
Beginning of buffer is position (point-min).
＠＠ -203,19 +195,19 ＠＠
static Lisp_Object
region_limit (int beginningp, struct buffer *b)
{
- Lisp_Object m;
-
#if 0 /* FSFmacs */
if (!NILP (Vtransient_mark_mode) && NILP (Vmark_even_if_inactive)
&& NILP (b->mark_active))
Fsignal (Qmark_inactive, Qnil);
#endif
- m = Fmarker_position (b->mark);
- if (NILP (m)) invalid_operation ("There is no region now", Qunbound);
- if (!!(BUF_PT (b) < XFIXNUM (m)) == !!beginningp)
+ if (XMARKER (b->mark)->buffer == NULL)
+ {
+ invalid_operation ("There is no region now", Qunbound);
+ }
+ if (!!(BYTE_BUF_PT (b) < byte_marker_position (b->mark)) == !!beginningp)
return make_fixnum (BUF_PT (b));
else
- return m;
+ return Fmarker_position (b->mark);
}
DEFUN ("region-beginning", Fregion_beginning, 0, 1, 0, /*
＠＠ -439,7 +431,8 ＠＠
(buffer))
{
struct buffer *b = decode_buffer (buffer, 1);
- return buildmark (BUF_BEGV (b), wrap_buffer (b));
+ return set_byte_marker_position (Fmake_marker (), BYTE_BUF_BEGV (b),
+ wrap_buffer (b));
}
DEFUN ("point-max", Fpoint_max, 0, 1, 0, /*
＠＠ -463,7 +456,8 ＠＠
(buffer))
{
struct buffer *b = decode_buffer (buffer, 1);
- return buildmark (BUF_ZV (b), wrap_buffer (b));
+ return set_byte_marker_position (Fmake_marker (), BYTE_BUF_ZV (b),
+ wrap_buffer (b));
}
DEFUN ("following-char", Ffollowing_char, 0, 1, 0, /*
＠＠ -2149,8 +2143,8 ＠＠
But that was clearly before the advent of marker-insertion-type. --ben */
- Fset_marker (bottom, make_fixnum (BUF_BEGV (buf)), wrap_buffer (buf));
- Fset_marker (top, make_fixnum (BUF_ZV (buf)), wrap_buffer (buf));
+ set_byte_marker_position (bottom, BYTE_BUF_BEGV (buf), wrap_buffer (buf));
+ set_byte_marker_position (top, BYTE_BUF_ZV (buf), wrap_buffer (buf));
Fset_marker_insertion_type (top, Qt);
return noseeum_cons (wrap_buffer (buf), noseeum_cons (bottom, top));
＠＠ -2167,29 +2161,35 ＠＠
/* someone could have killed the buffer in the meantime ... */
if (BUFFER_LIVE_P (buf))
{
- Charbpos start = marker_position (XCAR (markers));
- Charbpos end = marker_position (XCDR (markers));
- Bytebpos byte_start = charbpos_to_bytebpos (buf, start);
- Bytebpos byte_end = charbpos_to_bytebpos (buf, end);
+ Bytebpos byte_start = byte_marker_position (XCAR (markers));
+ Bytebpos byte_end = byte_marker_position (XCDR (markers));
+ Bytebpos clipped;
- if (BUF_BEGV (buf) != start)
+ if (BYTE_BUF_BEGV (buf) != byte_start)
{
local_clip_changed = 1;
- SET_BOTH_BUF_BEGV (buf, start, byte_start);
+ SET_BOTH_BUF_BEGV (buf, bytebpos_to_charbpos (buf, byte_start),
+ byte_start);
narrow_line_number_cache (buf);
}
- if (BUF_ZV (buf) != end)
+ if (BYTE_BUF_ZV (buf) != byte_end)
{
local_clip_changed = 1;
- SET_BOTH_BUF_ZV (buf, end, byte_end);
+ SET_BOTH_BUF_ZV (buf, bytebpos_to_charbpos (buf, byte_end),
+ byte_end);
}
if (local_clip_changed)
MARK_CLIP_CHANGED;
/* If point is outside the new visible range, move it inside. */
- BUF_SET_PT (buf, charbpos_clip_to_bounds (BUF_BEGV (buf), BUF_PT (buf),
- BUF_ZV (buf)));
+ clipped = bytebpos_clip_to_bounds (BYTE_BUF_BEGV (buf),
+ BYTE_BUF_PT (buf),
+ BYTE_BUF_ZV (buf));
+ if (clipped != BYTE_BUF_PT (buf))
+ {
+ BYTE_BUF_SET_PT (buf, clipped);
+ }
}
/* Free all the junk we allocated, so that a `save-restriction' comes
＠＠ -2314,11 +2314,10 ＠＠
mpos += diff;
else
mpos -= amt2;
- set_marker_position (marker, mpos);
+ Fset_marker (marker, make_fixnum (mpos), wrap_buffer (buf));
}
}
}
-
#endif /* 0 */
DEFUN ("transpose-regions", Ftranspose_regions, 4, 5, 0, /*
diff -r 51111ef13381 -r 483ea9209873 src/fileio.c
--- a/src/fileio.c Wed Aug 15 23:17:12 2018 +0100
+++ b/src/fileio.c Mon Aug 20 21:29:10 2018 +0100
＠＠ -195,7 +195,7 ＠＠
static Lisp_Object
restore_point_unwind (Lisp_Object point_marker)
{
- BUF_SET_PT (current_buffer, marker_position (point_marker));
+ BYTE_BUF_SET_PT (current_buffer, byte_marker_position (point_marker));
return Fset_marker (point_marker, Qnil, Qnil);
}
diff -r 51111ef13381 -r 483ea9209873 src/keymap.c
--- a/src/keymap.c Wed Aug 15 23:17:12 2018 +0100
+++ b/src/keymap.c Mon Aug 20 21:29:10 2018 +0100
＠＠ -2678,8 +2678,7 ＠＠
}
else if (MARKERP (position) && !NILP (Fmarker_buffer (position)))
{
- get_relevant_extent_keymaps (Fmarker_position (position),
- Fmarker_buffer (position),
+ get_relevant_extent_keymaps (position, Fmarker_buffer (position),
Qnil, &closure);
}
else if (EVENTP (position))
diff -r 51111ef13381 -r 483ea9209873 src/lisp.h
--- a/src/lisp.h Wed Aug 15 23:17:12 2018 +0100
+++ b/src/lisp.h Mon Aug 20 21:29:10 2018 +0100
＠＠ -5704,8 +5704,17 ＠＠
Bytebpos byte_marker_position (Lisp_Object);
Charbpos marker_position (Lisp_Object);
-void set_byte_marker_position (Lisp_Object, Bytebpos);
-void set_marker_position (Lisp_Object, Charbpos);
+
+/* Set the byte position of MARKER, a marker object, to BYTENO in
+ BUFFER. MARKER must be a marker object, BUFFER must be a valid buffer, and
+ BYTENO must be a valid byte position within BUFFER. MARKER may not be
+ BUFFER's point marker. Values for MARKER, BYTENO, and BUFFER are checked
+ only if ERROR_CHECK_STRUCTURES is defined, and cause an assertion failure
+ if out of range, so callers need to check values themselves. */
+Lisp_Object set_byte_marker_position (Lisp_Object marker, Bytebpos byteno,
+ Lisp_Object buffer);
+/* No set_marker_position (); use Fset_marker (). */
+
void unchain_marker (Lisp_Object);
Lisp_Object noseeum_copy_marker (Lisp_Object, Lisp_Object);
Lisp_Object set_marker_restricted (Lisp_Object, Lisp_Object, Lisp_Object);
diff -r 51111ef13381 -r 483ea9209873 src/lread.c
--- a/src/lread.c Wed Aug 15 23:17:12 2018 +0100
+++ b/src/lread.c Mon Aug 20 21:29:10 2018 +0100
＠＠ -264,13 +264,14 ＠＠
else if (MARKERP (readcharfun))
{
Ichar c;
- Charbpos mpos = marker_position (readcharfun);
+ Bytebpos mpos = byte_marker_position (readcharfun);
struct buffer *inbuffer = XMARKER (readcharfun)->buffer;
- if (mpos >= BUF_ZV (inbuffer))
+ if (mpos >= BYTE_BUF_ZV (inbuffer))
return -1;
c = BUF_FETCH_CHAR (inbuffer, mpos);
- set_marker_position (readcharfun, mpos + 1);
+ INC_BYTEBPOS (inbuffer, mpos);
+ set_byte_marker_position (readcharfun, mpos, wrap_buffer (inbuffer));
return c;
}
else
＠＠ -309,7 +310,19 ＠＠
#endif
}
else if (MARKERP (readcharfun))
- set_marker_position (readcharfun, marker_position (readcharfun) - 1);
+ {
+ Bytebpos mpos = byte_marker_position (readcharfun);
+ struct buffer *buf = XMARKER (readcharfun)->buffer;
+
+ DEC_BYTEBPOS (buf, mpos);
+
+ set_byte_marker_position (readcharfun,
+ /* This is extra-conservative, no code
+ actually unreads without having read
+ anything. */
+ max (mpos, BYTE_BUF_BEG (buf)),
+ wrap_buffer (buf));
+ }
else
call1 (readcharfun, make_char (c));
}
diff -r 51111ef13381 -r 483ea9209873 src/lstream.c
--- a/src/lstream.c Wed Aug 15 23:17:12 2018 +0100
+++ b/src/lstream.c Mon Aug 20 21:29:10 2018 +0100
＠＠ -2090,7 +2090,7 ＠＠
*p = '\n';
}
- set_byte_marker_position (str->start, end);
+ set_byte_marker_position (str->start, end, wrap_buffer (buf));
return size;
}
＠＠ -2107,7 +2107,7 ＠＠
pos = marker_position (str->start);
pos += buffer_insert_raw_string_1 (buf, pos, data, size, 0);
- set_marker_position (str->start, pos);
+ Fset_marker (str->start, make_fixnum (pos), wrap_buffer (buf));
return size;
}
＠＠ -2128,7 +2128,7 ＠＠
position,
len),
0);
- set_marker_position (str->start, pos);
+ Fset_marker (str->start, make_fixnum (pos), wrap_buffer (buf));
return len;
}
＠＠ -2138,16 +2138,16 ＠＠
struct lisp_buffer_stream *str =
LISP_BUFFER_STREAM_DATA (stream);
struct buffer *buf = XBUFFER (str->buffer);
- long pos = marker_position (str->orig_start);
+ Bytebpos pos = byte_marker_position (str->orig_start);
if (!BUFFER_LIVE_P (buf))
return -1; /* Fut. */
- if (pos > BUF_ZV (buf))
- pos = BUF_ZV (buf);
- if (pos < marker_position (str->orig_start))
- pos = marker_position (str->orig_start);
- if (MARKERP (str->end) && pos > marker_position (str->end))
- pos = marker_position (str->end);
- set_marker_position (str->start, pos);
+ if (pos > BYTE_BUF_ZV (buf))
+ pos = BYTE_BUF_ZV (buf);
+ if (pos < byte_marker_position (str->orig_start))
+ pos = byte_marker_position (str->orig_start);
+ if (MARKERP (str->end) && pos > byte_marker_position (str->end))
+ pos = byte_marker_position (str->end);
+ set_byte_marker_position (str->start, pos, wrap_buffer (buf));
return 0;
}
diff -r 51111ef13381 -r 483ea9209873 src/marker.c
--- a/src/marker.c Wed Aug 15 23:17:12 2018 +0100
+++ b/src/marker.c Mon Aug 20 21:29:10 2018 +0100
＠＠ -175,83 +175,154 ＠＠
#endif
-static Lisp_Object
-set_marker_internal (Lisp_Object marker, Lisp_Object position,
- Lisp_Object buffer, int restricted_p)
+static Bytebpos
+fixup_set_marker_args (Lisp_Object marker, Lisp_Object position,
+ Bytebpos byteno, Lisp_Object buffer,
+ Boolint restricted_p, struct buffer **buffer_out,
+ Boolint *pointp_out)
{
+ struct buffer *b;
+ Boolint point_p;
Charbpos charno;
- struct buffer *b;
- Lisp_Marker *m;
- int point_p;
CHECK_MARKER (marker);
-
- point_p = POINT_MARKER_P (marker);
+ point_p = *pointp_out = POINT_MARKER_P (marker);
- /* If position is nil or a marker that points nowhere,
- make this marker point nowhere. */
- if (NILP (position) ||
+ /* If position is nil or a marker that points nowhere, make this marker
+ point nowhere. */
+ if ((NILP (position) && -1 == byteno) ||
(MARKERP (position) && !XMARKER (position)->buffer))
{
if (point_p)
- invalid_operation ("Can't make point-marker point nowhere",
- marker);
- if (XMARKER (marker)->buffer)
- unchain_marker (marker);
- return marker;
+ {
+ invalid_operation ("Can't make point-marker point nowhere",
+ marker);
+ }
+
+ /* This is a signal that the marker should not point anyhere, none of
+ the other _out variables need to be set. */
+ *buffer_out = NULL;
+ return -1;
+ }
+
+ if (NILP (buffer))
+ {
+ b = *buffer_out = current_buffer;
+ }
+ else
+ {
+ CHECK_BUFFER (buffer);
+ b = *buffer_out = XBUFFER (buffer);
+
+ if (!BUFFER_LIVE_P (XBUFFER (buffer)))
+ {
+ if (point_p)
+ {
+ invalid_operation ("Can't move point-marker into killed buffer",
+ marker);
+ }
+
+ *buffer_out = NULL;
+ return -1;
+ }
+ }
+
+ if (point_p && XMARKER (marker)->buffer != b)
+ {
+ invalid_operation ("Can't change buffer of point-marker", marker);
+ }
+
+ if (byteno != -1)
+ {
+ if (restricted_p)
+ {
+ if (byteno < BYTE_BUF_BEGV (b)) byteno = BYTE_BUF_BEGV (b);
+ if (byteno > BYTE_BUF_ZV (b)) byteno = BYTE_BUF_ZV (b);
+ }
+ else
+ {
+ if (byteno < BYTE_BUF_BEG (b)) byteno = BYTE_BUF_BEG (b);
+ if (byteno > BYTE_BUF_Z (b)) byteno = BYTE_BUF_Z (b);
+ }
+
+ return byteno;
+ }
+
+ if (MARKERP (position) && XMARKER (position)->buffer == b)
+ {
+ text_checking_assert (-1 == byteno);
+ byteno = membpos_to_bytebpos (b, XMARKER (position)->membpos);
+
+ if (restricted_p)
+ {
+ if (byteno < BYTE_BUF_BEGV (b)) byteno = BYTE_BUF_BEGV (b);
+ if (byteno > BYTE_BUF_ZV (b)) byteno = BYTE_BUF_ZV (b);
+ }
+
+ /* No need to do the usual restriction to valid buffer positions, since
+ we know POSITION is valid within BUFFER. */
+
+ return byteno;
}
CHECK_FIXNUM_COERCE_MARKER (position);
- if (NILP (buffer))
- b = current_buffer;
- else
- {
- CHECK_BUFFER (buffer);
- b = XBUFFER (buffer);
- /* If buffer is dead, set marker to point nowhere. */
- if (!BUFFER_LIVE_P (XBUFFER (buffer)))
- {
- if (point_p)
- invalid_operation
- ("Can't move point-marker in a killed buffer", marker);
- if (XMARKER (marker)->buffer)
- unchain_marker (marker);
- return marker;
- }
- }
-
charno = XFIXNUM (position);
- m = XMARKER (marker);
-
if (restricted_p)
{
- if (charno < BUF_BEGV (b)) charno = BUF_BEGV (b);
- if (charno > BUF_ZV (b)) charno = BUF_ZV (b);
+ if (charno < BUF_BEGV (b))
+ {
+ return BYTE_BUF_BEGV (b);
+ }
+ if (charno > BUF_ZV (b))
+ {
+ return BYTE_BUF_ZV (b);
+ }
}
else
{
- if (charno < BUF_BEG (b)) charno = BUF_BEG (b);
- if (charno > BUF_Z (b)) charno = BUF_Z (b);
+ if (charno < BUF_BEG (b))
+ {
+ return BYTE_BUF_BEG (b);
+ }
+ if (charno > BUF_Z (b))
+ {
+ return BYTE_BUF_Z (b);
+ }
+ }
+
+ return charbpos_to_bytebpos (b, charno);
+}
+
+static Lisp_Object
+set_marker_internal (Lisp_Object marker, Bytebpos byteno, struct buffer *b,
+ Boolint point_p)
+{
+ Lisp_Marker *m;
+
+ m = XMARKER (marker);
+
+ if (NULL == b)
+ {
+ /* Make this marker point nowhere. */
+ if (m->buffer)
+ {
+ unchain_marker (marker);
+ }
+
+ return marker;
}
if (point_p)
{
-#ifndef moving_point_by_moving_its_marker_is_a_bug
- BUF_SET_PT (b, charno); /* this will move the marker */
-#else /* It's not a feature, so it must be a bug */
- invalid_operation ("DEBUG: attempt to move point via point-marker",
- marker);
-#endif
+ BYTE_BUF_SET_PT (b, byteno); /* this will move the marker */
}
else
{
- m->membpos = charbpos_to_membpos (b, charno);
+ m->membpos = bytebpos_to_membpos (b, byteno);
}
if (m->buffer != b)
{
- if (point_p)
- invalid_operation ("Can't change buffer of point-marker", marker);
if (m->buffer != 0)
unchain_marker (marker);
m->buffer = b;
＠＠ -264,7 +335,31 ＠＠
return marker;
}
+
+/* Set the byte position of MARKER, a marker object, to BYTENO in
+ BUFFER. MARKER must be a marker object, BUFFER must be a valid buffer, and
+ BYTENO must be a valid byte position within BUFFER. MARKER may not be
+ BUFFER's point marker. */
+Lisp_Object
+set_byte_marker_position (Lisp_Object marker, Bytebpos byteno,
+ Lisp_Object buffer)
+{
+#ifdef ERROR_CHECK_STRUCTURES
+ struct buffer *b;
+ Boolint point_p = 0;
+ Bytebpos old_byteno = byteno;
+ /* For the type, range checking. */
+ byteno = fixup_set_marker_args (marker, Qnil, byteno, buffer, 0, &b,
+ &point_p);
+
+ structure_checking_assert (!point_p);
+ structure_checking_assert (byteno == old_byteno);
+ structure_checking_assert (b == XBUFFER (buffer));
+#endif
+
+ return set_marker_internal (marker, byteno, XBUFFER (buffer), 0);
+}
DEFUN ("set-marker", Fset_marker, 2, 3, 0, /*
Move MARKER to position POSITION in BUFFER.
＠＠ -282,20 +377,31 ＠＠
*/
(marker, position, buffer))
{
- return set_marker_internal (marker, position, buffer, 0);
+ struct buffer *b;
+ Bytebpos byteno = -1;
+ Boolint point_p;
+
+ byteno = fixup_set_marker_args (marker, position, -1, buffer, 0, &b,
+ &point_p);
+
+ return set_marker_internal (marker, byteno, b, point_p);
}
-
/* This version of Fset_marker won't let the position
be outside the visible part. */
Lisp_Object
set_marker_restricted (Lisp_Object marker, Lisp_Object position,
Lisp_Object buffer)
{
- return set_marker_internal (marker, position, buffer, 1);
+ struct buffer *b;
+ Bytebpos byteno = -1;
+ Boolint point_p;
+
+ byteno = fixup_set_marker_args (marker, position, -1, buffer, 1, &b,
+ &point_p);
+ return set_marker_internal (marker, byteno, b, point_p);
}
-
/* This is called during garbage collection,
so we must be careful to ignore and preserve mark bits,
including those in chain fields of markers. */
＠＠ -359,29 +465,6 ＠＠
return bytebpos_to_charbpos (buf, byte_marker_position (marker));
}
-void
-set_byte_marker_position (Lisp_Object marker, Bytebpos pos)
-{
- Lisp_Marker *m = XMARKER (marker);
- struct buffer *buf = m->buffer;
-
- if (!buf)
- invalid_argument ("Marker does not point anywhere", Qunbound);
-
- m->membpos = bytebpos_to_membpos (buf, pos);
-}
-
-void
-set_marker_position (Lisp_Object marker, Charbpos pos)
-{
- struct buffer *buf = XMARKER (marker)->buffer;
-
- if (!buf)
- invalid_argument ("Marker does not point anywhere", Qunbound);
-
- set_byte_marker_position (marker, charbpos_to_bytebpos (buf, pos));
-}
-
static Lisp_Object
copy_marker_1 (Lisp_Object marker, Lisp_Object type, int noseeum)
{
diff -r 51111ef13381 -r 483ea9209873 src/print.c
--- a/src/print.c Wed Aug 15 23:17:12 2018 +0100
+++ b/src/print.c Mon Aug 20 21:29:10 2018 +0100
＠＠ -491,7 +491,8 ＠＠
marker_position (function), nonreloc, reloc,
offset, len, -1, 0);
set_byte_marker_position (function,
- byte_marker_position (function) + len);
+ byte_marker_position (function) + len,
+ wrap_buffer (XMARKER (function)->buffer));
UNGCPRO;
return len; /* We will have errored on failure. */
}
diff -r 51111ef13381 -r 483ea9209873 src/text.c
--- a/src/text.c Wed Aug 15 23:17:12 2018 +0100
+++ b/src/text.c Mon Aug 20 21:29:10 2018 +0100
＠＠ -4246,10 +4246,40 ＠＠
Bytebpos
get_buffer_pos_byte (struct buffer *b, Lisp_Object pos, unsigned int flags)
{
- Charbpos bpos = get_buffer_pos_char (b, pos, flags);
- if (bpos < 0) /* could happen with GB_NO_ERROR_IF_BAD */
- return -1;
- return charbpos_to_bytebpos (b, bpos);
+ if (MARKERP (pos) && XMARKER (pos)->buffer == b)
+ {
+ /* Does not GC */
+ Bytebpos ind;
+ Bytebpos min_allowed, max_allowed;
+
+ ind = byte_marker_position (pos);
+ min_allowed
+ = flags & GB_ALLOW_PAST_ACCESSIBLE ? BYTE_BUF_BEG (b)
+ : BYTE_BUF_BEGV (b);
+ max_allowed
+ = flags & GB_ALLOW_PAST_ACCESSIBLE ? BYTE_BUF_Z (b) : BYTE_BUF_ZV (b);
+
+ if (ind < min_allowed || ind > max_allowed)
+ {
+ if (flags & GB_COERCE_RANGE)
+ ind = ind < min_allowed ? min_allowed : max_allowed;
+ else if (flags & GB_NO_ERROR_IF_BAD)
+ ind = -1;
+ else
+ {
+ args_out_of_range (wrap_buffer (b), pos);
+ }
+ }
+
+ return ind;
+ }
+ else
+ {
+ Charbpos bpos = get_buffer_pos_char (b, pos, flags);
+ if (bpos < 0) /* could happen with GB_NO_ERROR_IF_BAD */
+ return -1;
+ return charbpos_to_bytebpos (b, bpos);
+ }
}
/* Return a pair of buffer positions representing a range of text,
＠＠ -4311,17 +4341,58 ＠＠
Bytebpos *from_out, Bytebpos *to_out,
unsigned int flags)
{
- Charbpos s, e;
-
- get_buffer_range_char (b, from, to, &s, &e, flags);
- if (s >= 0)
- *from_out = charbpos_to_bytebpos (b, s);
- else /* could happen with GB_NO_ERROR_IF_BAD */
- *from_out = -1;
- if (e >= 0)
- *to_out = charbpos_to_bytebpos (b, e);
+ if (MARKERP (from) && XMARKER (from)->buffer == b
+ && MARKERP (to) && XMARKER (to)->buffer == b)
+ {
+ /* Does not GC */
+ Bytebpos min_allowed, max_allowed;
+
+ min_allowed = (flags & GB_ALLOW_PAST_ACCESSIBLE) ?
+ BYTE_BUF_BEG (b) : BYTE_BUF_BEGV (b);
+ max_allowed = (flags & GB_ALLOW_PAST_ACCESSIBLE) ?
+ BYTE_BUF_Z (b) : BYTE_BUF_ZV (b);
+
+ if (NILP (from) && (flags & GB_ALLOW_NIL))
+ *from_out = min_allowed;
+ else
+ *from_out = get_buffer_pos_byte (b, from, flags | GB_NO_ERROR_IF_BAD);
+
+ if (NILP (to) && (flags & GB_ALLOW_NIL))
+ *to_out = max_allowed;
+ else
+ *to_out = get_buffer_pos_byte (b, to, flags | GB_NO_ERROR_IF_BAD);
+
+ if ((*from_out < 0 || *to_out < 0) && !(flags & GB_NO_ERROR_IF_BAD))
+ {
+ args_out_of_range_3 (wrap_buffer (b), from, to);
+ }
+
+ if (*from_out >= 0 && *to_out >= 0 && *from_out > *to_out)
+ {
+ if (flags & GB_CHECK_ORDER)
+ invalid_argument_2 ("start greater than end", from, to);
+ else
+ {
+ Bytebpos temp = *from_out;
+ *from_out = *to_out;
+ *to_out = temp;
+ }
+ }
+ }
else
- *to_out = -1;
+ {
+ Charbpos s, e;
+
+ get_buffer_range_char (b, from, to, &s, &e, flags);
+ if (s >= 0)
+ *from_out = charbpos_to_bytebpos (b, s);
+ else /* could happen with GB_NO_ERROR_IF_BAD */
+ *from_out = -1;
+ if (e >= 0)
+ *to_out = charbpos_to_bytebpos (b, e);
+ else
+ *to_out = -1;
+ }
}
static Charcount
--
‘As I sat looking up at the Guinness ad, I could never figure out /
How your man stayed up on the surfboard after forty pints of stout’
(C. Moore)
- 1 participants
- 0 comments
[COMMIT] Reduce calls to marker_position(), bytecode comparisons, #'max, #'min
6 years, 4 months
Aidan Kehoe
Aidan Kehoe
APPROVE COMMIT
NOTE: This patch has been committed
# HG changeset patch
# User Aidan Kehoe <kehoea(a)parhasard.net>
# Date 1534371432 -3600
# Wed Aug 15 23:17:12 2018 +0100
# Node ID 51111ef13381b362dba0f4463ddae7257871e24f
# Parent 99135ed6ffc1217d9082691df80fb3a3471785ce
Reduce calls to marker_position(), bytecode comparisons, #'max, #'min
src/ChangeLog addition:
2018-08-15 Aidan Kehoe <kehoea(a)parhasard.net>
Calls to marker_position() are O(N), reduce them in bytecode.
* buffer.h:
* bytecode.c:
* bytecode.c (bytecode_gtr):
* bytecode.c (bytecode_lss):
* bytecode.c (bytecode_leq):
* bytecode.c (bytecode_geq):
* bytecode.c (bytecode_arithop):
* data.c:
* data.c (Fmax):
* data.c (Fmin):
* insdel.c (init_buffer_text):
* number.h:
* number.h (promote_args_lazy):
1. In bytecode and in interpreted code, if #'max, #'min are
supplied marker arguments, return a marker result if they can be
compared without converting to fixnums.
2. In bytecode, when doing arithmetic comparisons between markers
and fixnums, uses the fact the the byte marker position is always
the inclusive upper bound on the character marker position, and
that (byte_marker_position(OBJ) / MAX_ICHAR_LEN) is the inclusive
lower bound, to convert O(N) operations to O(1) for a decent
proportion of comparisons like (< MARKER (point-max)).
3. Buffer format is actually fixed at compile time, make decisions
regarding that easier for the compiler.
tests/ChangeLog addition:
2018-08-15 Aidan Kehoe <kehoea(a)parhasard.net>
* automated/lisp-tests.el:
1. #'max, #'min can now return markers, accept that.
2. Gross checks of comparison of fixnums and markers for
correctness, now we have made some bytecode changes to help with
that.
man/ChangeLog addition:
2018-08-15 Aidan Kehoe <kehoea(a)parhasard.net>
* lispref/markers.texi (Information from Markers):
Document an important algorithmic consideration with
#'marker-position.
diff -r 99135ed6ffc1 -r 51111ef13381 man/ChangeLog
--- a/man/ChangeLog Tue Aug 14 12:17:35 2018 +0100
+++ b/man/ChangeLog Wed Aug 15 23:17:12 2018 +0100
＠＠ -1,3 +1,9 ＠＠
+2018-08-15 Aidan Kehoe <kehoea(a)parhasard.net>
+
+ * lispref/markers.texi (Information from Markers):
+ Document an important algorithmic consideration with
+ #'marker-position.
+
2017-11-23 Aidan Kehoe <kehoea(a)parhasard.net>
* internals/internals.texi (A Summary of the Various XEmacs Modules):
diff -r 99135ed6ffc1 -r 51111ef13381 man/lispref/markers.texi
--- a/man/lispref/markers.texi Tue Aug 14 12:17:35 2018 +0100
+++ b/man/lispref/markers.texi Wed Aug 15 23:17:12 2018 +0100
＠＠ -348,7 +348,8 ＠＠
＠defun marker-position marker
This function returns the position that ＠var{marker} points to, or
-＠code{nil} if it points nowhere.
+＠code{nil} if it points nowhere. This operation is O(N) where ＠var{N} is
+the number of characters in the buffer; avoid it if you can.
＠end defun
＠defun marker-buffer marker
diff -r 99135ed6ffc1 -r 51111ef13381 src/ChangeLog
--- a/src/ChangeLog Tue Aug 14 12:17:35 2018 +0100
+++ b/src/ChangeLog Wed Aug 15 23:17:12 2018 +0100
＠＠ -1,3 +1,31 ＠＠
+2018-08-15 Aidan Kehoe <kehoea(a)parhasard.net>
+
+ Calls to marker_position() are O(N), reduce them in bytecode.
+ * buffer.h:
+ * bytecode.c:
+ * bytecode.c (bytecode_gtr):
+ * bytecode.c (bytecode_lss):
+ * bytecode.c (bytecode_leq):
+ * bytecode.c (bytecode_geq):
+ * bytecode.c (bytecode_arithop):
+ * data.c:
+ * data.c (Fmax):
+ * data.c (Fmin):
+ * insdel.c (init_buffer_text):
+ * number.h:
+ * number.h (promote_args_lazy):
+ 1. In bytecode and in interpreted code, if #'max, #'min are
+ supplied marker arguments, return a marker result if they can be
+ compared without converting to fixnums.
+ 2. In bytecode, when doing arithmetic comparisons between markers
+ and fixnums, uses the fact the the byte marker position is always
+ the inclusive upper bound on the character marker position, and
+ that (byte_marker_position(OBJ) / MAX_ICHAR_LEN) is the inclusive
+ lower bound, to convert O(N) operations to O(1) for a decent
+ proportion of comparisons like (< MARKER (point-max)).
+ 3. Buffer format is actually fixed at compile time, make decisions
+ regarding that easier for the compiler.
+
2018-08-12 Aidan Kehoe <kehoea(a)parhasard.net>
* fontcolor-x.c (x_font_instance_properties):
diff -r 99135ed6ffc1 -r 51111ef13381 src/buffer.h
--- a/src/buffer.h Tue Aug 14 12:17:35 2018 +0100
+++ b/src/buffer.h Wed Aug 15 23:17:12 2018 +0100
＠＠ -345,9 +345,9 ＠＠
#define BYTE_BUF_PT(buf) ((buf)->pt + 0)
#define BUF_PT(buf) ((buf)->bufpt + 0)
-/* Internal format of buffer. */
+/* Internal format of buffer. Always FORMAT_DEFAULT currently. */
#ifdef MULE
-#define BUF_FORMAT(buf) ((buf)->text->format)
+#define BUF_FORMAT(buf) FORMAT_DEFAULT /* ((buf)->text->format) */
#else
#define BUF_FORMAT(buf) FORMAT_DEFAULT
#endif
diff -r 99135ed6ffc1 -r 51111ef13381 src/bytecode.c
--- a/src/bytecode.c Tue Aug 14 12:17:35 2018 +0100
+++ b/src/bytecode.c Wed Aug 15 23:17:12 2018 +0100
＠＠ -382,6 +382,176 ＠＠
#endif /* WITH_NUMBER_TYPES */
}
+#ifdef MULE
+#define MAX_ICHAR_LEN_FORMAT(fmt) (ichar_len_fmt (CHAR_CODE_LIMIT - 1, fmt))
+#else
+#define MAX_ICHAR_LEN_FORMAT(buf) MAX_ICHAR_LEN
+#endif
+
+/* Given POS, the Bytebpos corresponding to MARKER, return the smallest
+ Charbpos it can represent, which represents the situation where all the
+ characters are of length MAX_ICHAR_LEN. */
+#define LOWER_CHAR_BOUND(marker, pos) \
+ (pos / MAX_ICHAR_LEN_FORMAT (BUF_FORMAT (XMARKER (marker)->buf)))
+
+static Boolint
+bytecode_gtr (Lisp_Object obj1, Lisp_Object obj2)
+{
+ if (MARKERP (obj1) && FIXNUMP (obj2))
+ {
+ const Bytebpos pos1 = byte_marker_position (obj1);
+ const Charbpos cpos1min = LOWER_CHAR_BOUND (obj1, pos1);
+
+ /* (POS1 / MAX_ICHAR_LEN) is a lower bound on OBJ1's character length,
+ we may be able to give a result without an O(N) operation. */
+ if (cpos1min > XREALFIXNUM (obj2))
+ {
+ return 1;
+ }
+ /* Similarly, POS1 is an upper limit on OBJ1's character offset, and if
+ it is less than or equal to OBJ2, OBJ1's character offset cannot be
+ greater than OBJ2. */
+ if (pos1 <= XREALFIXNUM (obj2))
+ {
+ return 0;
+ }
+ }
+ else if (FIXNUMP (obj1) && MARKERP (obj2))
+ {
+ const Bytebpos pos2 = byte_marker_position (obj2);
+ const Charbpos cpos2min = LOWER_CHAR_BOUND (obj2, pos2);
+
+ /* The byte marker position is an upper limit on the character marker
+ position, we may be able to compare without O(N) lossage. */
+ if (XREALFIXNUM (obj1) > pos2)
+ {
+ return 1;
+ }
+ if (XREALFIXNUM (obj2) <= cpos2min)
+ {
+ return 0;
+ }
+ }
+
+ /* It is common to compare a marker to the result of (point) or (point-max),
+ which are both fixnums; the above optimizations have some value given
+ that. In a big buffer, e.g a two-thousand message VM buffer, an O(N)
+ operation becoming an O(1) operation is a significant improvement! A
+ similar optimization would be possible for markers in different buffers,
+ but that is done sufficiently rarely that I don't feel it's worth it. */
+
+ /* FALLTHROUGH */
+ return bytecode_arithcompare (obj1, obj2) > 0;
+}
+
+static Boolint
+bytecode_lss (Lisp_Object obj1, Lisp_Object obj2)
+{
+ /* See bytecode_gtr() for the reasoning for the following. */
+ if (MARKERP (obj1) && FIXNUMP (obj2))
+ {
+ const Bytebpos pos1 = byte_marker_position (obj1);
+ const Charbpos cpos1min = LOWER_CHAR_BOUND (obj1, pos1);
+
+ if (pos1 < XFIXNUM (obj2))
+ {
+ return 1;
+ }
+ if (cpos1min >= XFIXNUM (obj2))
+ {
+ return 0;
+ }
+ }
+ else if (FIXNUMP (obj1) && MARKERP (obj2))
+ {
+ const Bytebpos pos2 = byte_marker_position (obj2);
+ const Charbpos cpos2min = LOWER_CHAR_BOUND (obj2, pos2);
+
+ if (XFIXNUM (obj1) < cpos2min)
+ {
+ return 1;
+ }
+ if (XFIXNUM (obj1) >= pos2)
+ {
+ return 0;
+ }
+ }
+ /* FALLTHROUGH */
+ return bytecode_arithcompare (obj1, obj2) < 0;
+}
+
+static Boolint
+bytecode_leq (Lisp_Object obj1, Lisp_Object obj2)
+{
+ /* See bytecode_gtr() for the reasoning for the following. */
+ if (MARKERP (obj1) && FIXNUMP (obj2))
+ {
+ const Bytebpos pos1 = byte_marker_position (obj1);
+ const Charbpos cpos1min = LOWER_CHAR_BOUND (obj1, pos1);
+
+ if (pos1 <= XREALFIXNUM (obj2))
+ {
+ return 1;
+ }
+ if (cpos1min > XREALFIXNUM (obj2))
+ {
+ return 0;
+ }
+ }
+ else if (FIXNUMP (obj1) && MARKERP (obj2))
+ {
+ const Bytebpos pos2 = byte_marker_position (obj2);
+ const Charbpos cpos2min = LOWER_CHAR_BOUND (obj2, pos2);
+
+ if (XREALFIXNUM (obj1) <= cpos2min)
+ {
+ return 1;
+ }
+ if (XREALFIXNUM (obj1) > pos2)
+ {
+ return 0;
+ }
+ }
+
+ return bytecode_arithcompare (obj1, obj2) <= 0;
+}
+
+static Boolint
+bytecode_geq (Lisp_Object obj1, Lisp_Object obj2)
+{
+ /* See bytecode_gtr() for the reasoning for the following. */
+ if (MARKERP (obj1) && FIXNUMP (obj2))
+ {
+ const Bytebpos pos1 = byte_marker_position (obj1);
+ const Charbpos cpos1min = LOWER_CHAR_BOUND (obj1, pos1);
+
+ if (cpos1min >= XREALFIXNUM (obj2))
+ {
+ return 1;
+ }
+ if (pos1 < XREALFIXNUM (obj2))
+ {
+ return 0;
+ }
+ }
+ else if (FIXNUMP (obj1) && MARKERP (obj2))
+ {
+ const Bytebpos pos2 = byte_marker_position (obj2);
+ const Charbpos cpos2min = LOWER_CHAR_BOUND (obj2, pos2);
+
+ if (XREALFIXNUM (obj1) >= pos2)
+ {
+ return 1;
+ }
+ if (XREALFIXNUM (obj1) < cpos2min)
+ {
+ return 0;
+ }
+ }
+
+ return bytecode_arithcompare (obj1, obj2) >= 0;
+}
+
static Lisp_Object
bytecode_arithop (Lisp_Object obj1, Lisp_Object obj2, Opcode opcode)
{
＠＠ -393,15 +563,11 ＠＠
switch (opcode)
{
case Bmax:
- return make_fixnum (marker_position
- ((byte_marker_position (obj1)
- < byte_marker_position (obj2)) ?
- obj2 : obj1));
+ return byte_marker_position (obj1) < byte_marker_position (obj2)
+ ? obj2 : obj1;
case Bmin:
- return make_fixnum (marker_position
- ((byte_marker_position (obj1)
- > byte_marker_position (obj2)) ?
- obj2 : obj1));
+ return byte_marker_position (obj1) > byte_marker_position (obj2)
+ ? obj2 : obj1;
default:
obj1 = make_fixnum (marker_position (obj1));
obj2 = make_fixnum (marker_position (obj2));
＠＠ -555,7 +721,26 ＠＠
if (FIXNUMP (obj1)) ival1 = XFIXNUM (obj1);
else if (CHARP (obj1)) ival1 = XCHAR (obj1);
- else if (MARKERP (obj1)) ival1 = marker_position (obj1);
+ else if (MARKERP (obj1))
+ {
+ if (MARKERP (obj2)
+ && (XMARKER (obj1)->buffer == XMARKER (obj2)->buffer))
+ {
+ if (opcode == Bmax)
+ {
+ return byte_marker_position (obj1) < byte_marker_position (obj2)
+ ? obj2 : obj1;
+ }
+ else if (opcode == Bmin)
+ {
+ return byte_marker_position (obj1) > byte_marker_position (obj2)
+ ? obj2 : obj1;
+ }
+ /* Otherwise, convert to a fixnum in the normal way. */
+ }
+ ival1 = marker_position (obj1);
+ }
+
else if (FLOATP (obj1)) ival1 = 0, float_p = 1;
else
{
＠＠ -1249,28 +1434,28 ＠＠
case Bgtr:
{
Lisp_Object arg = POP;
- TOP_LVALUE = bytecode_arithcompare (TOP, arg) > 0 ? Qt : Qnil;
+ TOP_LVALUE = bytecode_gtr (TOP, arg) ? Qt : Qnil;
break;
}
case Blss:
{
Lisp_Object arg = POP;
- TOP_LVALUE = bytecode_arithcompare (TOP, arg) < 0 ? Qt : Qnil;
+ TOP_LVALUE = bytecode_lss (TOP, arg) ? Qt : Qnil;
break;
}
case Bleq:
{
Lisp_Object arg = POP;
- TOP_LVALUE = bytecode_arithcompare (TOP, arg) <= 0 ? Qt : Qnil;
+ TOP_LVALUE = bytecode_leq (TOP, arg) ? Qt : Qnil;
break;
}
case Bgeq:
{
Lisp_Object arg = POP;
- TOP_LVALUE = bytecode_arithcompare (TOP, arg) >= 0 ? Qt : Qnil;
+ TOP_LVALUE = bytecode_geq (TOP, arg) ? Qt : Qnil;
break;
}
diff -r 99135ed6ffc1 -r 51111ef13381 src/data.c
--- a/src/data.c Tue Aug 14 12:17:35 2018 +0100
+++ b/src/data.c Wed Aug 15 23:17:12 2018 +0100
＠＠ -2453,8 +2453,10 ＠＠
DEFUN ("max", Fmax, 1, MANY, 0, /*
Return largest of all the arguments.
All arguments must be real numbers, characters or markers.
-The value is always a number; markers and characters are converted
-to numbers.
+
+Markers in distinct buffers will be converted to fixnums, but markers in the
+same buffer will be compared without conversion, and may be returned as the
+value. Characters are always converted to fixnums, and are never returned.
arguments: (FIRST &rest ARGS)
*/
＠＠ -2467,35 +2469,38 ＠＠
args[0] = wrong_type_argument (Qnumber_char_or_marker_p, args[0]);
if (CHARP (args[0]))
args[0] = make_fixnum (XCHAR (args[0]));
- else if (MARKERP (args[0]))
- args[0] = make_fixnum (marker_position (args[0]));
for (i = 1; i < nargs; i++)
{
- switch (promote_args (args + maxindex, args + i))
+ switch (promote_args_lazy (args + maxindex, args + i))
{
- case FIXNUM_T:
+ case LAZY_MARKER_T:
+ if (byte_marker_position (args[maxindex])
+ < byte_marker_position (args[i]))
+ maxindex = i;
+ break;
+ case LAZY_FIXNUM_T:
if (XREALFIXNUM (args[maxindex]) < XREALFIXNUM (args[i]))
maxindex = i;
break;
#ifdef HAVE_BIGNUM
- case BIGNUM_T:
+ case LAZY_BIGNUM_T:
if (bignum_lt (XBIGNUM_DATA (args[maxindex]),
XBIGNUM_DATA (args[i])))
maxindex = i;
break;
#endif
#ifdef HAVE_RATIO
- case RATIO_T:
+ case LAZY_RATIO_T:
if (ratio_lt (XRATIO_DATA (args[maxindex]), XRATIO_DATA (args[i])))
maxindex = i;
break;
#endif
- case FLOAT_T:
+ case LAZY_FLOAT_T:
if (XFLOAT_DATA (args[maxindex]) < XFLOAT_DATA (args[i]))
maxindex = i;
break;
#ifdef HAVE_BIGFLOAT
- case BIGFLOAT_T:
+ case LAZY_BIGFLOAT_T:
if (bigfloat_lt (XBIGFLOAT_DATA (args[maxindex]),
XBIGFLOAT_DATA (args[i])))
maxindex = i;
＠＠ -2505,52 +2510,85 ＠＠
}
return args[maxindex];
#else /* !WITH_NUMBER_TYPES */
- EMACS_INT imax;
- double dmax;
- Lisp_Object *args_end = args + nargs;
- int_or_double iod;
-
- number_char_or_marker_to_int_or_double (*args++, &iod);
- if (iod.int_p)
- imax = iod.c.ival;
- else
+ REGISTER int i, maxindex = 0;
+ Lisp_Object max_so_far;
+
+ while (!(CHARP (args[0]) || MARKERP (args[0]) || REALP (args[0])))
+ args[0] = wrong_type_argument (Qnumber_char_or_marker_p, args[0]);
+ if (CHARP (args[0]))
+ args[0] = make_fixnum (XCHAR (args[0]));
+ max_so_far = args[0];
+ for (i = 1; i < nargs; i++)
{
- dmax = iod.c.dval;
- goto max_floats;
- }
-
- while (args < args_end)
- {
- number_char_or_marker_to_int_or_double (*args++, &iod);
- if (iod.int_p)
- {
- if (imax < iod.c.ival) imax = iod.c.ival;
- }
+ EMACS_INT ival1, ival2;
+ int float_p;
+ Lisp_Object obj2 = args[i];
+
+ retry:
+ float_p = 0;
+
+ if (FIXNUMP (max_so_far)) ival1 = XFIXNUM (max_so_far);
+ else if (CHARP (max_so_far)) ival1 = XCHAR (max_so_far);
+ else if (MARKERP (max_so_far))
+ {
+ if (MARKERP (obj2)
+ && (XMARKER (max_so_far)->buffer == XMARKER (obj2)->buffer))
+ {
+ if (byte_marker_position (max_so_far)
+ < byte_marker_position (obj2))
+ {
+ max_so_far = obj2;
+ }
+ continue;
+ }
+ /* Otherwise, convert to a fixnum in the normal way. */
+ ival1 = marker_position (max_so_far);
+ }
+ else if (FLOATP (max_so_far)) ival1 = 0, float_p = 1;
else
- {
- dmax = (double) imax;
- if (dmax < iod.c.dval) dmax = iod.c.dval;
- goto max_floats;
+ {
+ max_so_far = wrong_type_argument (Qnumber_char_or_marker_p,
+ max_so_far);
+ goto retry;
+ }
+
+ if (FIXNUMP (obj2)) ival2 = XFIXNUM (obj2);
+ else if (CHARP (obj2)) ival2 = XCHAR (obj2);
+ else if (MARKERP (obj2)) ival2 = marker_position (obj2);
+ else if (FLOATP (obj2)) ival2 = 0, float_p = 1;
+ else
+ {
+ obj2 = wrong_type_argument (Qnumber_char_or_marker_p, obj2);
+ goto retry;
+ }
+
+ if (!float_p)
+ {
+ if (ival1 < ival2) max_so_far = make_fixnum (ival2);
+ }
+ else
+ {
+ double dval1 = FLOATP (max_so_far) ? XFLOAT_DATA (max_so_far)
+ : (double) ival1;
+ double dval2 = FLOATP (obj2) ? XFLOAT_DATA (obj2) : (double) ival2;
+ if (dval1 < dval2)
+ {
+ max_so_far = FLOATP (obj2) ? obj2 : make_float (dval2);
+ }
}
}
- return make_fixnum (imax);
-
- max_floats:
- while (args < args_end)
- {
- double dval = number_char_or_marker_to_double (*args++);
- if (dmax < dval) dmax = dval;
- }
- return make_float (dmax);
+ return max_so_far;
#endif /* WITH_NUMBER_TYPES */
}
DEFUN ("min", Fmin, 1, MANY, 0, /*
Return smallest of all the arguments.
All arguments must be numbers, characters or markers.
-The value is always a number; markers and characters are converted
-to numbers.
+
+Markers in distinct buffers will be converted to fixnums, but markers in the
+same buffer will be compared without conversion, and may be returned as the
+value. Characters are always converted to fixnums, and are never returned.
arguments: (FIRST &rest ARGS)
*/
＠＠ -2563,36 +2601,39 ＠＠
args[0] = wrong_type_argument (Qnumber_char_or_marker_p, args[0]);
if (CHARP (args[0]))
args[0] = make_fixnum (XCHAR (args[0]));
- else if (MARKERP (args[0]))
- args[0] = make_fixnum (marker_position (args[0]));
for (i = 1; i < nargs; i++)
{
- switch (promote_args (args + minindex, args + i))
+ switch (promote_args_lazy (args + minindex, args + i))
{
- case FIXNUM_T:
+ case LAZY_MARKER_T:
+ if (byte_marker_position (args[minindex])
+ > byte_marker_position (args[i]))
+ minindex = i;
+ break;
+ case LAZY_FIXNUM_T:
if (XREALFIXNUM (args[minindex]) > XREALFIXNUM (args[i]))
minindex = i;
break;
#ifdef HAVE_BIGNUM
- case BIGNUM_T:
+ case LAZY_BIGNUM_T:
if (bignum_gt (XBIGNUM_DATA (args[minindex]),
XBIGNUM_DATA (args[i])))
minindex = i;
break;
#endif
#ifdef HAVE_RATIO
- case RATIO_T:
+ case LAZY_RATIO_T:
if (ratio_gt (XRATIO_DATA (args[minindex]),
XRATIO_DATA (args[i])))
minindex = i;
break;
#endif
- case FLOAT_T:
+ case LAZY_FLOAT_T:
if (XFLOAT_DATA (args[minindex]) > XFLOAT_DATA (args[i]))
minindex = i;
break;
#ifdef HAVE_BIGFLOAT
- case BIGFLOAT_T:
+ case LAZY_BIGFLOAT_T:
if (bigfloat_gt (XBIGFLOAT_DATA (args[minindex]),
XBIGFLOAT_DATA (args[i])))
minindex = i;
＠＠ -2602,44 +2643,75 ＠＠
}
return args[minindex];
#else /* !WITH_NUMBER_TYPES */
- EMACS_INT imin;
- double dmin;
- Lisp_Object *args_end = args + nargs;
- int_or_double iod;
-
- number_char_or_marker_to_int_or_double (*args++, &iod);
- if (iod.int_p)
- imin = iod.c.ival;
- else
+ REGISTER int i;
+ Lisp_Object min_so_far;
+
+ while (!(CHARP (args[0]) || MARKERP (args[0]) || REALP (args[0])))
+ args[0] = wrong_type_argument (Qnumber_char_or_marker_p, args[0]);
+ if (CHARP (args[0]))
+ args[0] = make_fixnum (XCHAR (args[0]));
+ min_so_far = args[0];
+ for (i = 1; i < nargs; i++)
{
- dmin = iod.c.dval;
- goto min_floats;
- }
-
- while (args < args_end)
- {
- number_char_or_marker_to_int_or_double (*args++, &iod);
- if (iod.int_p)
- {
- if (imin > iod.c.ival) imin = iod.c.ival;
- }
+ EMACS_INT ival1, ival2;
+ int float_p;
+ Lisp_Object obj2 = args[i];
+
+ retry:
+ float_p = 0;
+
+ if (FIXNUMP (min_so_far)) ival1 = XFIXNUM (min_so_far);
+ else if (CHARP (min_so_far)) ival1 = XCHAR (min_so_far);
+ else if (MARKERP (min_so_far))
+ {
+ if (MARKERP (obj2)
+ && (XMARKER (min_so_far)->buffer == XMARKER (obj2)->buffer))
+ {
+ if (byte_marker_position (min_so_far)
+ > byte_marker_position (obj2))
+ {
+ min_so_far = obj2;
+ }
+ continue;
+ }
+ /* Otherwise, convert to a fixnum in the normal way. */
+ ival1 = marker_position (min_so_far);
+ }
+ else if (FLOATP (min_so_far)) ival1 = 0, float_p = 1;
else
- {
- dmin = (double) imin;
- if (dmin > iod.c.dval) dmin = iod.c.dval;
- goto min_floats;
+ {
+ min_so_far = wrong_type_argument (Qnumber_char_or_marker_p,
+ min_so_far);
+ goto retry;
+ }
+
+ if (FIXNUMP (obj2)) ival2 = XFIXNUM (obj2);
+ else if (CHARP (obj2)) ival2 = XCHAR (obj2);
+ else if (MARKERP (obj2)) ival2 = marker_position (obj2);
+ else if (FLOATP (obj2)) ival2 = 0, float_p = 1;
+ else
+ {
+ obj2 = wrong_type_argument (Qnumber_char_or_marker_p, obj2);
+ goto retry;
+ }
+
+ if (!float_p)
+ {
+ if (ival1 > ival2) min_so_far = make_fixnum (ival2);
+ }
+ else
+ {
+ double dval1 = FLOATP (min_so_far) ? XFLOAT_DATA (min_so_far)
+ : (double) ival1;
+ double dval2 = FLOATP (obj2) ? XFLOAT_DATA (obj2) : (double) ival2;
+ if (dval1 > dval2)
+ {
+ min_so_far = FLOATP (obj2) ? obj2 : make_float (dval2);
+ }
}
}
- return make_fixnum (imin);
-
- min_floats:
- while (args < args_end)
- {
- double dval = number_char_or_marker_to_double (*args++);
- if (dmin > dval) dmin = dval;
- }
- return make_float (dmin);
+ return min_so_far;
#endif /* WITH_NUMBER_TYPES */
}
diff -r 99135ed6ffc1 -r 51111ef13381 src/insdel.c
--- a/src/insdel.c Tue Aug 14 12:17:35 2018 +0100
+++ b/src/insdel.c Wed Aug 15 23:17:12 2018 +0100
＠＠ -1801,7 +1801,7 ＠＠
b->text->cached_bytepos = 1;
/* &&#### Set to FORMAT_8_BIT_FIXED when that code is working */
- BUF_FORMAT (b) = FORMAT_DEFAULT;
+ /* BUF_FORMAT (b) = FORMAT_DEFAULT; */
#endif /* MULE */
b->text->line_number_cache = Qnil;
diff -r 99135ed6ffc1 -r 51111ef13381 src/number.h
--- a/src/number.h Tue Aug 14 12:17:35 2018 +0100
+++ b/src/number.h Wed Aug 15 23:17:12 2018 +0100
＠＠ -454,14 +454,12 ＠＠
/* promote_args() *always* converts a marker argument to a fixnum.
Unfortunately, for a marker with byte position N, getting the (character)
- marker position is O(N). Getting the character position isn't necessary
- for bytecode_arithcompare() if two markers being compared are in the same
- buffer, comparing the byte position is enough.
+ marker position is O(N). Getting the character position isn't always
+ necessary for bytecode_arithcompare(), if they are in the same buffer,
+ comparing the byte position is enough.
Similarly, min and max don't necessarily need to have their arguments
- converted from markers, though we have always promised up to this point
- that the result is a fixnum rather than a marker, and that's what we're
- continuing to do. */
+ converted from markers. */
DECLARE_INLINE_HEADER (
enum lazy_number_type
diff -r 99135ed6ffc1 -r 51111ef13381 tests/ChangeLog
--- a/tests/ChangeLog Tue Aug 14 12:17:35 2018 +0100
+++ b/tests/ChangeLog Wed Aug 15 23:17:12 2018 +0100
＠＠ -1,3 +1,11 ＠＠
+2018-08-15 Aidan Kehoe <kehoea(a)parhasard.net>
+
+ * automated/lisp-tests.el:
+ 1. #'max, #'min can now return markers, accept that.
+ 2. Gross checks of comparison of fixnums and markers for
+ correctness, now we have made some bytecode changes to help with
+ that.
+
2018-07-05 Aidan Kehoe <kehoea(a)parhasard.net>
* automated/lisp-tests.el (featurep):
diff -r 99135ed6ffc1 -r 51111ef13381 tests/automated/lisp-tests.el
--- a/tests/automated/lisp-tests.el Tue Aug 14 12:17:35 2018 +0100
+++ b/tests/automated/lisp-tests.el Wed Aug 15 23:17:12 2018 +0100
＠＠ -3308,13 +3308,30 ＠＠
,(concat "checking #'< correct with long arguments list, "
context))
(map-plist #'(lambda (object1 object2)
- (Assert (> object1 object2)
+ (Assert (and (> object1 object2)
+ (not (> object2 object1)))
,(concat
"checking markers correctly ordered, >, "
context))
- (Assert (< object2 object1)
+ (Assert (and (< object2 object1)
+ (not (< object1 object2)))
,(concat
"checking markers correctly ordered, <, "
+ context))
+ (Assert (and (>= object1 object2)
+ (not (>= object2 object1)))
+ ,(concat
+ "checking markers correctly ordered, >=, "
+ context))
+ (Assert (and (<= object2 object1)
+ (not (<= object1 object2)))
+ ,(concat
+ "checking markers correctly ordered, <=, "
+ context))
+ (Assert (and (<= object2 object1)
+ (not (<= object1 object2)))
+ ,(concat
+ "checking markers correctly ordered, <=, "
context)))
markers)
;; OK, so up to this point there has been no need for byte-char
＠＠ -3328,18 +3345,43 ＠＠
(= (min object1 object2) object2)
,(concat
"checking min, correct, two markers, " context))
- ;; It is probably reasonable to change this design
- ;; decision.
+ ;; XEmacs; changed design decision, don't convert
+ ;; markers to fixnums unless absolutely necessary,
+ ;; that is an O(N) operation.
(Assert
- (fixnump (max object1 object2))
+ (markerp (max object1 object2))
+ ,(concat
+ "checking no unnecessary fixnum conversion"
+ ", max, " context))
+ (Assert
+ (markerp (min object1 object2))
,(concat
- "checking fixnum conversion as documented, max, "
- context))
- (Assert
- (fixnump (min object1 object2))
- ,(concat
- "checking fixnum conversion as documented, min, "
- context)))
+ "checking no unnecessary fixnum conversion"
+ ", min, " context))
+ (Assert (and (> object1 (marker-position object2))
+ (not (> (marker-position object2)
+ object1)))
+ ,(concat
+ "checking #'> correct, marker, fixnum "
+ context))
+ (Assert (and (< object2 (marker-position object1))
+ (not (< (marker-position object1)
+ object2)))
+ ,(concat
+ "checking #'< correct, marker, fixnum "
+ context))
+ (Assert (and (>= object1 (marker-position object2))
+ (not (>= (marker-position object2)
+ object1)))
+ ,(concat
+ "checking #'>= correct, marker, fixnum "
+ context))
+ (Assert (and (<= object2 (marker-position object1))
+ (not (<= (marker-position object1)
+ object2)))
+ ,(concat
+ "checking #'<= correct, marker, fixnum "
+ context)))
markers))))
(with-temp-buffer
(loop for ii from 0 to 100
--
‘As I sat looking up at the Guinness ad, I could never figure out /
How your man stayed up on the surfboard after forty pints of stout’
(C. Moore)
- 1 participants
- 0 comments
(3) Important E-mails? Pending [Warning!!]
6 years, 4 months
Mail.Notification
Mail.Notification
Dear user,
You have(3)important emails waiting for trial. Due to server upgrades Follow the link below.
Click Here To Retrieve Your Pending E-mails
Sincerely, Mail service team.
©2001-2018 administrator. ALL RIGHTS RESERVED
- 1 participants
- 0 comments
[COMMIT] Make #'make-weak-box work when running compiled, too.
6 years, 4 months
Aidan Kehoe
Aidan Kehoe
APPROVE COMMIT
NOTE: This patch has been committed
# HG changeset patch
# User Aidan Kehoe <kehoea(a)parhasard.net>
# Date 1534245455 -3600
# Tue Aug 14 12:17:35 2018 +0100
# Node ID 99135ed6ffc1217d9082691df80fb3a3471785ce
# Parent ebbb3bbb899aae849c9c66f4bc16825240be3637
Make #'make-weak-box work when running compiled, too.
lisp/ChangeLog addition:
2018-08-14 Aidan Kehoe <kehoea(a)parhasard.net>
* misc.el (make-weak-box):
Make this code work when run compiled too, not that it will come
up much.
diff -r ebbb3bbb899a -r 99135ed6ffc1 lisp/ChangeLog
--- a/lisp/ChangeLog Mon Aug 13 13:06:14 2018 +0100
+++ b/lisp/ChangeLog Tue Aug 14 12:17:35 2018 +0100
＠＠ -1,3 +1,9 ＠＠
+2018-08-14 Aidan Kehoe <kehoea(a)parhasard.net>
+
+ * misc.el (make-weak-box):
+ Make this code work when run compiled too, not that it will come
+ up much.
+
2018-08-13 Aidan Kehoe <kehoea(a)parhasard.net>
* misc.el (make-weak-box):
diff -r ebbb3bbb899a -r 99135ed6ffc1 lisp/misc.el
--- a/lisp/misc.el Mon Aug 13 13:06:14 2018 +0100
+++ b/lisp/misc.el Tue Aug 14 12:17:35 2018 +0100
＠＠ -96,7 +96,10 ＠＠
#'(lambda (weak-box)
(cdr (assq weak-box
(weak-list-list all-weak-boxes)))))
- (setq all-weak-boxes (make-weak-list 'assoc))))
+ ;; Use defvar so calls to #'make-weak-box when it is
+ ;; interpreted don't reset all-weak-boxes every time.
+ (defvar all-weak-boxes (make-weak-list 'assoc))
+ all-weak-boxes))
(acons (vector 'cl-weak-box nil)
contents (weak-list-list all-weak-boxes))))))
;; The second element of the vector is the eq hash of the vector itself,
--
‘As I sat looking up at the Guinness ad, I could never figure out /
How your man stayed up on the surfboard after forty pints of stout’
(C. Moore)
- 1 participants
- 0 comments