aboutsummaryrefslogtreecommitdiffstats
path: root/lisp/obsolete
diff options
context:
space:
mode:
authorPaul Eggert2018-08-21 13:44:03 -0700
committerPaul Eggert2018-08-21 13:44:32 -0700
commitf18af6cd5cb7dbbf7420ec2d3efed4e202c4f0dd (patch)
tree5f42e48e12a0ec77bd5cd5f32255a534635e89bf /lisp/obsolete
parent81e7eef8224c8a99a207b7a7b9dae1d598392ef7 (diff)
downloademacs-f18af6cd5cb7dbbf7420ec2d3efed4e202c4f0dd.tar.gz
emacs-f18af6cd5cb7dbbf7420ec2d3efed4e202c4f0dd.zip
Audit use of lsh and fix glitches
I audited use of lsh in the Lisp source code, and fixed the glitches that I found. While I was at it, I replaced uses of lsh with ash when either will do. Replacement is OK when either argument is known to be nonnegative, or when only the low-order bits of the result matter, and is a (minor) win since ash is a bit more solid than lsh nowadays, and is a bit faster. * lisp/calc/calc-ext.el (math-check-fixnum): Prefer most-positive-fixnum to (lsh -1 -1). * lisp/vc/vc-hg.el (vc-hg-state-fast): When testing fixnum width, prefer (zerop (ash most-positive-fixnum -32)) to (zerop (lsh -1 32)) (Bug#32485#11). * lisp/emacs-lisp/bytecomp.el (byte-compile-lapcode): Tighten sanity-check for bytecode overflow, by checking that the result of (ash pc -8) is nonnegative. Formerly this check was not needed since lsh was used and the number overflowed differently. * lisp/net/dns.el (dns-write): Fix some obvious sign typos in shift counts. Evidently this part of the code has never been exercised. * lisp/progmodes/hideif.el (hif-shiftleft, hif-shiftright): * lisp/term/common-win.el (x-setup-function-keys): Simplify. * admin/unidata/unidata-gen.el, admin/unidata/uvs.el: * doc/lispref/keymaps.texi, doc/lispref/syntax.texi: * doc/misc/calc.texi, doc/misc/cl.texi, etc/NEWS.19: * lisp/arc-mode.el, lisp/calc/calc-bin.el, lisp/calc/calc-comb.el: * lisp/calc/calc-ext.el, lisp/calc/calc-math.el: * lisp/cedet/semantic/wisent/comp.el, lisp/composite.el: * lisp/disp-table.el, lisp/dos-fns.el, lisp/edmacro.el: * lisp/emacs-lisp/bindat.el, lisp/emacs-lisp/byte-opt.el: * lisp/emacs-lisp/bytecomp.el, lisp/emacs-lisp/cl-extra.el: * lisp/erc/erc-dcc.el, lisp/facemenu.el, lisp/gnus/message.el: * lisp/gnus/nndoc.el, lisp/gnus/nnmaildir.el, lisp/image.el: * lisp/international/ccl.el, lisp/international/fontset.el: * lisp/international/mule-cmds.el, lisp/international/mule.el: * lisp/json.el, lisp/mail/binhex.el, lisp/mail/rmail.el: * lisp/mail/uudecode.el, lisp/md4.el, lisp/net/dns.el: * lisp/net/ntlm.el, lisp/net/sasl.el, lisp/net/socks.el: * lisp/net/tramp.el, lisp/obsolete/levents.el: * lisp/obsolete/pgg-parse.el, lisp/org/org.el: * lisp/org/ox-publish.el, lisp/progmodes/cc-defs.el: * lisp/progmodes/ebnf2ps.el, lisp/progmodes/hideif.el: * lisp/ps-bdf.el, lisp/ps-print.el, lisp/simple.el: * lisp/tar-mode.el, lisp/term/common-win.el: * lisp/term/tty-colors.el, lisp/term/xterm.el, lisp/vc/vc-git.el: * lisp/vc/vc-hg.el, lisp/x-dnd.el, test/src/data-tests.el: Prefer ash to lsh when either will do.
Diffstat (limited to 'lisp/obsolete')
-rw-r--r--lisp/obsolete/levents.el2
-rw-r--r--lisp/obsolete/pgg-parse.el26
2 files changed, 14 insertions, 14 deletions
diff --git a/lisp/obsolete/levents.el b/lisp/obsolete/levents.el
index 7fb3be83ee2..48afe7551de 100644
--- a/lisp/obsolete/levents.el
+++ b/lisp/obsolete/levents.el
@@ -145,7 +145,7 @@ It will be the next event read after all pending events."
145The value is an ASCII printing character (not upper case) or a symbol." 145The value is an ASCII printing character (not upper case) or a symbol."
146 (if (symbolp event) 146 (if (symbolp event)
147 (car (get event 'event-symbol-elements)) 147 (car (get event 'event-symbol-elements))
148 (let ((base (logand event (1- (lsh 1 18))))) 148 (let ((base (logand event (1- (ash 1 18)))))
149 (downcase (if (< base 32) (logior base 64) base))))) 149 (downcase (if (< base 32) (logior base 64) base)))))
150 150
151(defun event-object (event) 151(defun event-object (event)
diff --git a/lisp/obsolete/pgg-parse.el b/lisp/obsolete/pgg-parse.el
index 34ec96ec12c..a7470246492 100644
--- a/lisp/obsolete/pgg-parse.el
+++ b/lisp/obsolete/pgg-parse.el
@@ -116,9 +116,9 @@
116 ) 116 )
117 117
118(defmacro pgg-parse-time-field (bytes) 118(defmacro pgg-parse-time-field (bytes)
119 `(list (logior (lsh (car ,bytes) 8) 119 `(list (logior (ash (car ,bytes) 8)
120 (nth 1 ,bytes)) 120 (nth 1 ,bytes))
121 (logior (lsh (nth 2 ,bytes) 8) 121 (logior (ash (nth 2 ,bytes) 8)
122 (nth 3 ,bytes)) 122 (nth 3 ,bytes))
123 0)) 123 0))
124 124
@@ -184,21 +184,21 @@
184 (ccl-execute-on-string pgg-parse-crc24 h string) 184 (ccl-execute-on-string pgg-parse-crc24 h string)
185 (format "%c%c%c" 185 (format "%c%c%c"
186 (logand (aref h 1) 255) 186 (logand (aref h 1) 255)
187 (logand (lsh (aref h 2) -8) 255) 187 (logand (ash (aref h 2) -8) 255)
188 (logand (aref h 2) 255))))) 188 (logand (aref h 2) 255)))))
189 189
190(defmacro pgg-parse-length-type (c) 190(defmacro pgg-parse-length-type (c)
191 `(cond 191 `(cond
192 ((< ,c 192) (cons ,c 1)) 192 ((< ,c 192) (cons ,c 1))
193 ((< ,c 224) 193 ((< ,c 224)
194 (cons (+ (lsh (- ,c 192) 8) 194 (cons (+ (ash (- ,c 192) 8)
195 (pgg-byte-after (+ 2 (point))) 195 (pgg-byte-after (+ 2 (point)))
196 192) 196 192)
197 2)) 197 2))
198 ((= ,c 255) 198 ((= ,c 255)
199 (cons (cons (logior (lsh (pgg-byte-after (+ 2 (point))) 8) 199 (cons (cons (logior (ash (pgg-byte-after (+ 2 (point))) 8)
200 (pgg-byte-after (+ 3 (point)))) 200 (pgg-byte-after (+ 3 (point))))
201 (logior (lsh (pgg-byte-after (+ 4 (point))) 8) 201 (logior (ash (pgg-byte-after (+ 4 (point))) 8)
202 (pgg-byte-after (+ 5 (point))))) 202 (pgg-byte-after (+ 5 (point)))))
203 5)) 203 5))
204 (t;partial body length 204 (t;partial body length
@@ -210,13 +210,13 @@
210 (if (zerop (logand 64 ptag));Old format 210 (if (zerop (logand 64 ptag));Old format
211 (progn 211 (progn
212 (setq length-type (logand ptag 3) 212 (setq length-type (logand ptag 3)
213 length-type (if (= 3 length-type) 0 (lsh 1 length-type)) 213 length-type (if (= 3 length-type) 0 (ash 1 length-type))
214 content-tag (logand 15 (lsh ptag -2)) 214 content-tag (logand 15 (ash ptag -2))
215 packet-bytes 0 215 packet-bytes 0
216 header-bytes (1+ length-type)) 216 header-bytes (1+ length-type))
217 (dotimes (i length-type) 217 (dotimes (i length-type)
218 (setq packet-bytes 218 (setq packet-bytes
219 (logior (lsh packet-bytes 8) 219 (logior (ash packet-bytes 8)
220 (pgg-byte-after (+ 1 i (point))))))) 220 (pgg-byte-after (+ 1 i (point)))))))
221 (setq content-tag (logand 63 ptag) 221 (setq content-tag (logand 63 ptag)
222 length-type (pgg-parse-length-type 222 length-type (pgg-parse-length-type
@@ -317,10 +317,10 @@
317 (let ((name-bytes (pgg-read-bytes 2)) 317 (let ((name-bytes (pgg-read-bytes 2))
318 (value-bytes (pgg-read-bytes 2))) 318 (value-bytes (pgg-read-bytes 2)))
319 (cons (pgg-read-bytes-string 319 (cons (pgg-read-bytes-string
320 (logior (lsh (car name-bytes) 8) 320 (logior (ash (car name-bytes) 8)
321 (nth 1 name-bytes))) 321 (nth 1 name-bytes)))
322 (pgg-read-bytes-string 322 (pgg-read-bytes-string
323 (logior (lsh (car value-bytes) 8) 323 (logior (ash (car value-bytes) 8)
324 (nth 1 value-bytes))))))) 324 (nth 1 value-bytes)))))))
325 (21 ;preferred hash algorithms 325 (21 ;preferred hash algorithms
326 (cons 'preferred-hash-algorithm 326 (cons 'preferred-hash-algorithm
@@ -380,7 +380,7 @@
380 (pgg-set-alist result 380 (pgg-set-alist result
381 'hash-algorithm (pgg-read-byte)) 381 'hash-algorithm (pgg-read-byte))
382 (when (>= 10000 (setq n (pgg-read-bytes 2) 382 (when (>= 10000 (setq n (pgg-read-bytes 2)
383 n (logior (lsh (car n) 8) 383 n (logior (ash (car n) 8)
384 (nth 1 n)))) 384 (nth 1 n))))
385 (save-restriction 385 (save-restriction
386 (narrow-to-region (point)(+ n (point))) 386 (narrow-to-region (point)(+ n (point)))
@@ -391,7 +391,7 @@
391 #'pgg-parse-signature-subpacket))) 391 #'pgg-parse-signature-subpacket)))
392 (goto-char (point-max)))) 392 (goto-char (point-max))))
393 (when (>= 10000 (setq n (pgg-read-bytes 2) 393 (when (>= 10000 (setq n (pgg-read-bytes 2)
394 n (logior (lsh (car n) 8) 394 n (logior (ash (car n) 8)
395 (nth 1 n)))) 395 (nth 1 n))))
396 (save-restriction 396 (save-restriction
397 (narrow-to-region (point)(+ n (point))) 397 (narrow-to-region (point)(+ n (point)))