From f18af6cd5cb7dbbf7420ec2d3efed4e202c4f0dd Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Tue, 21 Aug 2018 13:44:03 -0700 Subject: 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. --- lisp/emacs-lisp/bindat.el | 28 ++++++++++++++-------------- lisp/emacs-lisp/byte-opt.el | 4 ++-- lisp/emacs-lisp/bytecomp.el | 12 ++++++------ lisp/emacs-lisp/cl-extra.el | 2 +- 4 files changed, 23 insertions(+), 23 deletions(-) (limited to 'lisp/emacs-lisp') diff --git a/lisp/emacs-lisp/bindat.el b/lisp/emacs-lisp/bindat.el index c1343765901..3124217303f 100644 --- a/lisp/emacs-lisp/bindat.el +++ b/lisp/emacs-lisp/bindat.el @@ -205,22 +205,22 @@ (setq bindat-idx (1+ bindat-idx)))) (defun bindat--unpack-u16 () - (logior (lsh (bindat--unpack-u8) 8) (bindat--unpack-u8))) + (logior (ash (bindat--unpack-u8) 8) (bindat--unpack-u8))) (defun bindat--unpack-u24 () - (logior (lsh (bindat--unpack-u16) 8) (bindat--unpack-u8))) + (logior (ash (bindat--unpack-u16) 8) (bindat--unpack-u8))) (defun bindat--unpack-u32 () - (logior (lsh (bindat--unpack-u16) 16) (bindat--unpack-u16))) + (logior (ash (bindat--unpack-u16) 16) (bindat--unpack-u16))) (defun bindat--unpack-u16r () - (logior (bindat--unpack-u8) (lsh (bindat--unpack-u8) 8))) + (logior (bindat--unpack-u8) (ash (bindat--unpack-u8) 8))) (defun bindat--unpack-u24r () - (logior (bindat--unpack-u16r) (lsh (bindat--unpack-u8) 16))) + (logior (bindat--unpack-u16r) (ash (bindat--unpack-u8) 16))) (defun bindat--unpack-u32r () - (logior (bindat--unpack-u16r) (lsh (bindat--unpack-u16r) 16))) + (logior (bindat--unpack-u16r) (ash (bindat--unpack-u16r) 16))) (defun bindat--unpack-item (type len &optional vectype) (if (eq type 'ip) @@ -250,7 +250,7 @@ (if (/= 0 (logand m j)) (setq bits (cons bnum bits))) (setq bnum (1- bnum) - j (lsh j -1))))) + j (ash j -1))))) bits)) ((eq type 'str) (let ((s (substring bindat-raw bindat-idx (+ bindat-idx len)))) @@ -459,30 +459,30 @@ e.g. corresponding to STRUCT.FIELD1[INDEX2].FIELD3..." (setq bindat-idx (1+ bindat-idx))) (defun bindat--pack-u16 (v) - (aset bindat-raw bindat-idx (logand (lsh v -8) 255)) + (aset bindat-raw bindat-idx (logand (ash v -8) 255)) (aset bindat-raw (1+ bindat-idx) (logand v 255)) (setq bindat-idx (+ bindat-idx 2))) (defun bindat--pack-u24 (v) - (bindat--pack-u8 (lsh v -16)) + (bindat--pack-u8 (ash v -16)) (bindat--pack-u16 v)) (defun bindat--pack-u32 (v) - (bindat--pack-u16 (lsh v -16)) + (bindat--pack-u16 (ash v -16)) (bindat--pack-u16 v)) (defun bindat--pack-u16r (v) - (aset bindat-raw (1+ bindat-idx) (logand (lsh v -8) 255)) + (aset bindat-raw (1+ bindat-idx) (logand (ash v -8) 255)) (aset bindat-raw bindat-idx (logand v 255)) (setq bindat-idx (+ bindat-idx 2))) (defun bindat--pack-u24r (v) (bindat--pack-u16r v) - (bindat--pack-u8 (lsh v -16))) + (bindat--pack-u8 (ash v -16))) (defun bindat--pack-u32r (v) (bindat--pack-u16r v) - (bindat--pack-u16r (lsh v -16))) + (bindat--pack-u16r (ash v -16))) (defun bindat--pack-item (v type len &optional vectype) (if (eq type 'ip) @@ -515,7 +515,7 @@ e.g. corresponding to STRUCT.FIELD1[INDEX2].FIELD3..." (if (memq bnum v) (setq m (logior m j))) (setq bnum (1- bnum) - j (lsh j -1)))) + j (ash j -1)))) (bindat--pack-u8 m)))) ((memq type '(str strz)) (let ((l (length v)) (i 0)) diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el index 1920503b8c4..4854808fd02 100644 --- a/lisp/emacs-lisp/byte-opt.el +++ b/lisp/emacs-lisp/byte-opt.el @@ -1283,7 +1283,7 @@ (setq bytedecomp-ptr (1+ bytedecomp-ptr)) (+ (aref bytes bytedecomp-ptr) (progn (setq bytedecomp-ptr (1+ bytedecomp-ptr)) - (lsh (aref bytes bytedecomp-ptr) 8)))) + (ash (aref bytes bytedecomp-ptr) 8)))) (t tem)))) ;Offset was in opcode. ((>= bytedecomp-op byte-constant) (prog1 (- bytedecomp-op byte-constant) ;Offset in opcode. @@ -1297,7 +1297,7 @@ (setq bytedecomp-ptr (1+ bytedecomp-ptr)) (+ (aref bytes bytedecomp-ptr) (progn (setq bytedecomp-ptr (1+ bytedecomp-ptr)) - (lsh (aref bytes bytedecomp-ptr) 8)))) + (ash (aref bytes bytedecomp-ptr) 8)))) ((and (>= bytedecomp-op byte-listN) (<= bytedecomp-op byte-discardN)) (setq bytedecomp-ptr (1+ bytedecomp-ptr)) ;Offset in next byte. diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index ee28e61800d..0b8f8824b4c 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -835,7 +835,7 @@ all the arguments. (defmacro byte-compile-push-bytecode-const2 (opcode const2 bytes pc) "Push OPCODE and the two-byte constant CONST2 onto BYTES, and add 3 to PC. CONST2 may be evaluated multiple times." - `(byte-compile-push-bytecodes ,opcode (logand ,const2 255) (lsh ,const2 -8) + `(byte-compile-push-bytecodes ,opcode (logand ,const2 255) (ash ,const2 -8) ,bytes ,pc)) (defun byte-compile-lapcode (lap) @@ -925,9 +925,9 @@ CONST2 may be evaluated multiple times." ;; Splits PC's value into 2 bytes. The jump address is ;; "reconstructed" by the `FETCH2' macro in `bytecode.c'. (setcar (cdr bytes-tail) (logand pc 255)) - (setcar bytes-tail (lsh pc -8)) + (setcar bytes-tail (ash pc -8)) ;; FIXME: Replace this by some workaround. - (if (> (car bytes-tail) 255) (error "Bytecode overflow"))) + (or (<= 0 (car bytes-tail) 255) (error "Bytecode overflow"))) ;; Similarly, replace TAGs in all jump tables with the correct PC index. (dolist (hash-table byte-compile-jump-tables) @@ -2793,8 +2793,8 @@ If FORM is a lambda or a macro, byte-compile it as a function." (if (> mandatory 127) (byte-compile-report-error "Too many (>127) mandatory arguments") (logior mandatory - (lsh nonrest 8) - (lsh rest 7))))) + (ash nonrest 8) + (ash rest 7))))) (defun byte-compile-lambda (fun &optional add-lambda reserved-csts) @@ -3258,7 +3258,7 @@ for symbols generated by the byte compiler itself." (fun (car form)) (fargs (aref fun 0)) (start-depth byte-compile-depth) - (fmax2 (if (numberp fargs) (lsh fargs -7))) ;2*max+rest. + (fmax2 (if (numberp fargs) (ash fargs -7))) ;2*max+rest. ;; (fmin (if (numberp fargs) (logand fargs 127))) (alen (length (cdr form))) (dynbinds ()) diff --git a/lisp/emacs-lisp/cl-extra.el b/lisp/emacs-lisp/cl-extra.el index 36b65f97b07..bea38a05096 100644 --- a/lisp/emacs-lisp/cl-extra.el +++ b/lisp/emacs-lisp/cl-extra.el @@ -472,7 +472,7 @@ Optional second arg STATE is a random-state object." (n (logand 8388607 (aset vec i (- (aref vec i) (aref vec j)))))) (if (integerp lim) (if (<= lim 512) (% n lim) - (if (> lim 8388607) (setq n (+ (lsh n 9) (cl-random 512 state)))) + (if (> lim 8388607) (setq n (+ (ash n 9) (cl-random 512 state)))) (let ((mask 1023)) (while (< mask (1- lim)) (setq mask (1+ (+ mask mask)))) (if (< (setq n (logand n mask)) lim) n (cl-random lim state)))) -- cgit v1.2.3