diff options
| author | Paul Eggert <eggert@cs.ucla.edu> | 2018-08-21 13:44:03 -0700 |
|---|---|---|
| committer | Paul Eggert <eggert@cs.ucla.edu> | 2018-08-21 13:44:32 -0700 |
| commit | f18af6cd5cb7dbbf7420ec2d3efed4e202c4f0dd (patch) | |
| tree | 5f42e48e12a0ec77bd5cd5f32255a534635e89bf | |
| parent | 81e7eef8224c8a99a207b7a7b9dae1d598392ef7 (diff) | |
| download | emacs-f18af6cd5cb7dbbf7420ec2d3efed4e202c4f0dd.tar.gz | |
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.
59 files changed, 235 insertions, 239 deletions
diff --git a/admin/unidata/unidata-gen.el b/admin/unidata/unidata-gen.el index 8cc1893adbb..e520d189090 100644 --- a/admin/unidata/unidata-gen.el +++ b/admin/unidata/unidata-gen.el @@ -401,7 +401,7 @@ Property value is a symbol `o' (Open), `c' (Close), or `n' (None)." (if (consp range) (if val (set-char-table-range table range val)) - (let* ((start (lsh (lsh range -7) 7)) + (let* ((start (ash (ash range -7) 7)) (limit (+ start 127)) first-index last-index) (fillarray vec 0) @@ -548,7 +548,7 @@ Property value is a symbol `o' (Open), `c' (Close), or `n' (None)." (if (< from (logand to #x1FFF80)) (setq from (logand to #x1FFF80))) (setq prev-range-data (cons (cons from to) val-code))))) - (let* ((start (lsh (lsh range -7) 7)) + (let* ((start (ash (ash range -7) 7)) (limit (+ start 127)) str count new-val from to vcode) (fillarray vec (car default-value)) @@ -761,7 +761,7 @@ Property value is a symbol `o' (Open), `c' (Close), or `n' (None)." ((stringp val) (if (> (aref val 0) 0) val - (let* ((first-char (lsh (lsh char -7) 7)) + (let* ((first-char (ash (ash char -7) 7)) (word-table (aref (char-table-extra-slot table 4) 0)) (i 1) (len (length val)) @@ -865,7 +865,7 @@ Property value is a symbol `o' (Open), `c' (Close), or `n' (None)." ((stringp val) (if (> (aref val 0) 0) val - (let* ((first-char (lsh (lsh char -7) 7)) + (let* ((first-char (ash (ash char -7) 7)) (word-table (char-table-extra-slot table 4)) (i 1) (len (length val)) @@ -982,7 +982,7 @@ Property value is a symbol `o' (Open), `c' (Close), or `n' (None)." (if slot (nconc slot (list range)) (push (list val range) block-list)))) - (let* ((start (lsh (lsh range -7) 7)) + (let* ((start (ash (ash range -7) 7)) (limit (+ start 127)) (first tail) (vec (make-vector 128 nil)) diff --git a/admin/unidata/uvs.el b/admin/unidata/uvs.el index 6bb6a2ab763..31840fb1822 100644 --- a/admin/unidata/uvs.el +++ b/admin/unidata/uvs.el @@ -107,7 +107,7 @@ The most significant byte comes first." (let (result) (dotimes (i size) (push (logand value #xff) result) - (setq value (lsh value -8))) + (setq value (ash value -8))) result)) (defun uvs-insert-fields-as-bytes (fields &rest values) diff --git a/doc/lispref/keymaps.texi b/doc/lispref/keymaps.texi index cc2e11e0b6d..38e89c6cfdd 100644 --- a/doc/lispref/keymaps.texi +++ b/doc/lispref/keymaps.texi @@ -1660,7 +1660,7 @@ to turn the character that follows into a Hyper character: (defun hyperify (prompt) (let ((e (read-event))) (vector (if (numberp e) - (logior (lsh 1 24) e) + (logior (ash 1 24) e) (if (memq 'hyper (event-modifiers e)) e (add-event-modifier "H-" e)))))) diff --git a/doc/lispref/syntax.texi b/doc/lispref/syntax.texi index 71c97fdae8c..dcfade3f67d 100644 --- a/doc/lispref/syntax.texi +++ b/doc/lispref/syntax.texi @@ -1014,13 +1014,13 @@ corresponds to each syntax flag. @item @i{Prefix} @tab @i{Flag} @tab @i{Prefix} @tab @i{Flag} @item -@samp{1} @tab @code{(lsh 1 16)} @tab @samp{p} @tab @code{(lsh 1 20)} +@samp{1} @tab @code{(ash 1 16)} @tab @samp{p} @tab @code{(ash 1 20)} @item -@samp{2} @tab @code{(lsh 1 17)} @tab @samp{b} @tab @code{(lsh 1 21)} +@samp{2} @tab @code{(ash 1 17)} @tab @samp{b} @tab @code{(ash 1 21)} @item -@samp{3} @tab @code{(lsh 1 18)} @tab @samp{n} @tab @code{(lsh 1 22)} +@samp{3} @tab @code{(ash 1 18)} @tab @samp{n} @tab @code{(ash 1 22)} @item -@samp{4} @tab @code{(lsh 1 19)} @tab @samp{c} @tab @code{(lsh 1 23)} +@samp{4} @tab @code{(ash 1 19)} @tab @samp{c} @tab @code{(ash 1 23)} @end multitable @defun string-to-syntax desc diff --git a/doc/misc/calc.texi b/doc/misc/calc.texi index b1b38620fff..98ef6daa2c1 100644 --- a/doc/misc/calc.texi +++ b/doc/misc/calc.texi @@ -32717,7 +32717,7 @@ create an intermediate set. (while (> n 0) (if (oddp n) (setq count (1+ count))) - (setq n (lsh n -1))) + (setq n (ash n -1))) count)) @end smallexample @@ -32761,7 +32761,7 @@ routines are especially fast when dividing by an integer less than (let ((count 0)) (while (> n 0) (setq count (+ count (logand n 1)) - n (lsh n -1))) + n (ash n -1))) count)) @end smallexample @@ -32774,7 +32774,7 @@ uses. The @code{idivmod} function does an integer division, returning both the quotient and the remainder at once. Again, note that while it -might seem that @samp{(logand n 511)} and @samp{(lsh n -9)} are +might seem that @samp{(logand n 511)} and @samp{(ash n -9)} are more efficient ways to split off the bottom nine bits of @code{n}, actually they are less efficient because each operation is really a division by 512 in disguise; @code{idivmod} allows us to do the diff --git a/doc/misc/cl.texi b/doc/misc/cl.texi index 77105d3364e..6985f194213 100644 --- a/doc/misc/cl.texi +++ b/doc/misc/cl.texi @@ -784,7 +784,7 @@ default. Some examples: (cl-deftype null () '(satisfies null)) ; predefined (cl-deftype list () '(or null cons)) ; predefined (cl-deftype unsigned-byte (&optional bits) - (list 'integer 0 (if (eq bits '*) bits (1- (lsh 1 bits))))) + (list 'integer 0 (if (eq bits '*) bits (1- (ash 1 bits))))) (unsigned-byte 8) @equiv{} (integer 0 255) (unsigned-byte) @equiv{} (integer 0 *) unsigned-byte @equiv{} (integer 0 *) diff --git a/etc/NEWS.19 b/etc/NEWS.19 index efe0f0e7f7a..1f84e87cefc 100644 --- a/etc/NEWS.19 +++ b/etc/NEWS.19 @@ -4341,7 +4341,7 @@ turn the character that follows into a hyper character: (defun hyperify (prompt) (let ((e (read-event))) (vector (if (numberp e) - (logior (lsh 1 20) e) + (logior (ash 1 20) e) (if (memq 'hyper (event-modifiers e)) e (add-event-modifier "H-" e)))))) diff --git a/lisp/arc-mode.el b/lisp/arc-mode.el index 4ddb29dcbb5..e45c6004b9a 100644 --- a/lisp/arc-mode.el +++ b/lisp/arc-mode.el @@ -583,7 +583,7 @@ the mode is invalid. If ERROR is nil then nil will be returned." (len (length newmode)) (i 1)) (while (< i len) - (setq result (+ (lsh result 3) (aref newmode i) (- ?0)) + (setq result (+ (ash result 3) (aref newmode i) (- ?0)) i (1+ i))) (logior (logand oldmode 65024) result))) ((string-match "^\\([agou]+\\)\\([---+=]\\)\\([rwxst]+\\)$" newmode) @@ -1759,7 +1759,7 @@ This doesn't recover lost files, it just undoes changes in the buffer itself." (setq newval (funcall newval (archive-l-e (+ p2 ofs) 2)))) (goto-char (+ p2 ofs)) (delete-char 2) - (insert-unibyte (logand newval 255) (lsh newval -8)) + (insert-unibyte (logand newval 255) (ash newval -8)) (goto-char (1+ p)) (delete-char 1) (insert-unibyte (archive-lzh-resum (1+ p) hsize))) @@ -1949,11 +1949,11 @@ This doesn't recover lost files, it just undoes changes in the buffer itself." (cond ((memq creator '(2 3)) ; Unix (goto-char (+ p 40)) (delete-char 2) - (insert-unibyte (logand newval 255) (lsh newval -8))) + (insert-unibyte (logand newval 255) (ash newval -8))) ((memq creator '(0 5 6 7 10 11 15)) ; Dos etc. (goto-char (+ p 38)) (insert-unibyte (logior (logand (byte-after (point)) 254) - (logand (logxor 1 (lsh newval -7)) 1))) + (logand (logxor 1 (ash newval -7)) 1))) (delete-char 1)) (t (message "Don't know how to change mode for this member")))) )))) diff --git a/lisp/calc/calc-bin.el b/lisp/calc/calc-bin.el index c05a71a2d7f..a61cecf357c 100644 --- a/lisp/calc/calc-bin.el +++ b/lisp/calc/calc-bin.el @@ -420,7 +420,7 @@ the size of a Calc bignum digit.") (let ((q (math-div-bignum-digit a math-bignum-digit-power-of-two))) (if (<= w math-bignum-logb-digit-size) (list (logand (lognot (cdr q)) - (1- (lsh 1 w)))) + (1- (ash 1 w)))) (math-mul-bignum-digit (math-not-bignum (math-norm-bignum (car q)) (- w math-bignum-logb-digit-size)) math-bignum-digit-power-of-two @@ -529,7 +529,7 @@ the size of a Calc bignum digit.") ((and (integerp a) (< a math-small-integer-size)) (if (> w (logb math-small-integer-size)) a - (logand a (1- (lsh 1 w))))) + (logand a (1- (ash 1 w))))) (t (math-normalize (cons 'bigpos @@ -542,7 +542,7 @@ the size of a Calc bignum digit.") (let ((q (math-div-bignum-digit a math-bignum-digit-power-of-two))) (if (<= w math-bignum-logb-digit-size) (list (logand (cdr q) - (1- (lsh 1 w)))) + (1- (ash 1 w)))) (math-mul-bignum-digit (math-clip-bignum (math-norm-bignum (car q)) (- w math-bignum-logb-digit-size)) math-bignum-digit-power-of-two diff --git a/lisp/calc/calc-comb.el b/lisp/calc/calc-comb.el index 7c88230f86a..f1d3daeed93 100644 --- a/lisp/calc/calc-comb.el +++ b/lisp/calc/calc-comb.el @@ -580,7 +580,7 @@ ;; deduce a better value for RAND_MAX. (let ((i 0)) (while (< (setq i (1+ i)) 30) - (if (> (lsh (math-abs (random)) math-random-shift) 4095) + (if (> (ash (math-abs (random)) math-random-shift) 4095) (setq math-random-shift (1- math-random-shift)))))) (setq math-last-RandSeed var-RandSeed math-gaussian-cache nil)) @@ -592,11 +592,11 @@ (cdr math-random-table)) math-random-ptr2 (or (cdr math-random-ptr2) (cdr math-random-table))) - (logand (lsh (setcar math-random-ptr1 + (logand (ash (setcar math-random-ptr1 (logand (- (car math-random-ptr1) (car math-random-ptr2)) 524287)) -6) 1023)) - (logand (lsh (random) math-random-shift) 1023))) + (logand (ash (random) math-random-shift) 1023))) ;;; Produce a random digit in the range 0..999. diff --git a/lisp/calc/calc-ext.el b/lisp/calc/calc-ext.el index 5feff23f72d..f983ebe414d 100644 --- a/lisp/calc/calc-ext.el +++ b/lisp/calc/calc-ext.el @@ -2294,14 +2294,14 @@ calc-kill calc-kill-region calc-yank)))) (let ((a (math-trunc a))) (if (integerp a) a - (if (or (Math-lessp (lsh -1 -1) a) - (Math-lessp a (- (lsh -1 -1)))) + (if (or (Math-lessp most-positive-fixnum a) + (Math-lessp a (- most-positive-fixnum))) (math-reject-arg a 'fixnump) (math-fixnum a))))) ((and allow-inf (equal a '(var inf var-inf))) - (lsh -1 -1)) + most-positive-fixnum) ((and allow-inf (equal a '(neg (var inf var-inf)))) - (- (lsh -1 -1))) + (- most-positive-fixnum)) (t (math-reject-arg a 'fixnump)))) ;;; Verify that A is an integer >= 0 and return A in integer form. [I N; - x] diff --git a/lisp/calc/calc-math.el b/lisp/calc/calc-math.el index 4b8abbf4f85..483907a325d 100644 --- a/lisp/calc/calc-math.el +++ b/lisp/calc/calc-math.el @@ -1697,7 +1697,7 @@ If this can't be done, return NIL." (while (not (Math-lessp x pow)) (setq pows (cons pow pows) pow (math-sqr pow))) - (setq n (lsh 1 (1- (length pows))) + (setq n (ash 1 (1- (length pows))) sum n pow (car pows)) (while (and (setq pows (cdr pows)) diff --git a/lisp/cedet/semantic/wisent/comp.el b/lisp/cedet/semantic/wisent/comp.el index 837222ad4b1..74ca4f4a437 100644 --- a/lisp/cedet/semantic/wisent/comp.el +++ b/lisp/cedet/semantic/wisent/comp.el @@ -142,8 +142,8 @@ If optional LEFT is non-nil insert spaces on left." (defconst wisent-BITS-PER-WORD (let ((i 1) (do-shift (if (boundp 'most-positive-fixnum) - (lambda (i) (lsh most-positive-fixnum (- i))) - (lambda (i) (lsh 1 i))))) + (lambda (i) (ash most-positive-fixnum (- i))) + (lambda (i) (ash 1 i))))) (while (not (zerop (funcall do-shift i))) (setq i (1+ i))) i)) @@ -156,18 +156,18 @@ If optional LEFT is non-nil insert spaces on left." "X[I/BITS-PER-WORD] |= 1 << (I % BITS-PER-WORD)." (let ((k (/ i wisent-BITS-PER-WORD))) (aset x k (logior (aref x k) - (lsh 1 (% i wisent-BITS-PER-WORD)))))) + (ash 1 (% i wisent-BITS-PER-WORD)))))) (defsubst wisent-RESETBIT (x i) "X[I/BITS-PER-WORD] &= ~(1 << (I % BITS-PER-WORD))." (let ((k (/ i wisent-BITS-PER-WORD))) (aset x k (logand (aref x k) - (lognot (lsh 1 (% i wisent-BITS-PER-WORD))))))) + (lognot (ash 1 (% i wisent-BITS-PER-WORD))))))) (defsubst wisent-BITISSET (x i) "(X[I/BITS-PER-WORD] & (1 << (I % BITS-PER-WORD))) != 0." (not (zerop (logand (aref x (/ i wisent-BITS-PER-WORD)) - (lsh 1 (% i wisent-BITS-PER-WORD)))))) + (ash 1 (% i wisent-BITS-PER-WORD)))))) (defsubst wisent-noninteractive () "Return non-nil if running without interactive terminal." diff --git a/lisp/composite.el b/lisp/composite.el index 7daea54c9e9..3d4805e8fa0 100644 --- a/lisp/composite.el +++ b/lisp/composite.el @@ -119,7 +119,7 @@ RULE is a cons of global and new reference point symbols (setq nref (cdr (assq nref reference-point-alist)))) (or (and (>= gref 0) (< gref 12) (>= nref 0) (< nref 12)) (error "Invalid composition rule: %S" rule)) - (logior (lsh xoff 16) (lsh yoff 8) (+ (* gref 12) nref))) + (logior (ash xoff 16) (ash yoff 8) (+ (* gref 12) nref))) (error "Invalid composition rule: %S" rule)))) ;; Decode encoded composition rule RULE-CODE. The value is a cons of @@ -130,8 +130,8 @@ RULE is a cons of global and new reference point symbols (defun decode-composition-rule (rule-code) (or (and (natnump rule-code) (< rule-code #x1000000)) (error "Invalid encoded composition rule: %S" rule-code)) - (let ((xoff (lsh rule-code -16)) - (yoff (logand (lsh rule-code -8) #xFF)) + (let ((xoff (ash rule-code -16)) + (yoff (logand (ash rule-code -8) #xFF)) gref nref) (setq rule-code (logand rule-code #xFF) gref (car (rassq (/ rule-code 12) reference-point-alist)) diff --git a/lisp/disp-table.el b/lisp/disp-table.el index 13d73a98d0b..95224f2b2a4 100644 --- a/lisp/disp-table.el +++ b/lisp/disp-table.el @@ -226,7 +226,7 @@ X frame." char (let ((fid (face-id face))) (if (< fid 64) ; we have 32 - 3(LSB) - 1(SIGN) - 22(CHAR) = 6 bits for face id - (logior char (lsh fid 22)) + (logior char (ash fid 22)) (cons char fid))))) ;;;###autoload @@ -239,7 +239,7 @@ X frame." ;;;###autoload (defun glyph-face (glyph) "Return the face of glyph code GLYPH, or nil if glyph has default face." - (let ((face-id (if (consp glyph) (cdr glyph) (lsh glyph -22)))) + (let ((face-id (if (consp glyph) (cdr glyph) (ash glyph -22)))) (and (> face-id 0) (catch 'face (dolist (face (face-list)) diff --git a/lisp/dos-fns.el b/lisp/dos-fns.el index ebb8acb8608..aeb8da4d480 100644 --- a/lisp/dos-fns.el +++ b/lisp/dos-fns.el @@ -269,7 +269,7 @@ returned unaltered." (car where) (if (zerop (cdr where)) (logior (logand tem 65280) value) - (logior (logand tem 255) (lsh value 8)))))) + (logior (logand tem 255) (ash value 8)))))) ((numberp where) (aset regs where (logand value 65535)))))) regs) diff --git a/lisp/edmacro.el b/lisp/edmacro.el index 78180627950..c3d9bc5a980 100644 --- a/lisp/edmacro.el +++ b/lisp/edmacro.el @@ -547,7 +547,7 @@ doubt, use whitespace." ?\M-\^@ ?\s-\^@ ?\S-\^@) when (/= (logand ch bit) 0) concat (format "%c-" pf)) - (let ((ch2 (logand ch (1- (lsh 1 18))))) + (let ((ch2 (logand ch (1- (ash 1 18))))) (cond ((<= ch2 32) (pcase ch2 (0 "NUL") (9 "TAB") (10 "LFD") 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)))) diff --git a/lisp/erc/erc-dcc.el b/lisp/erc/erc-dcc.el index fdc209991aa..8bf4c3e1666 100644 --- a/lisp/erc/erc-dcc.el +++ b/lisp/erc/erc-dcc.el @@ -229,7 +229,7 @@ which is big-endian." "Maximum number of bytes for a fixnum.") (defconst erc-most-positive-int-msb - (lsh most-positive-fixnum (- 0 (* 8 (1- erc-most-positive-int-bytes)))) + (ash most-positive-fixnum (- 0 (* 8 (1- erc-most-positive-int-bytes)))) "Content of the most significant byte of most-positive-fixnum.") (defun erc-unpack-int (str) @@ -251,7 +251,7 @@ which is big-endian." (let ((num 0) (count 0)) (while (< count len) - (setq num (+ num (lsh (aref str (- len count 1)) (* 8 count)))) + (setq num (+ num (ash (aref str (- len count 1)) (* 8 count)))) (setq count (1+ count))) num))) diff --git a/lisp/facemenu.el b/lisp/facemenu.el index a4f675b8c11..7c10d6097c5 100644 --- a/lisp/facemenu.el +++ b/lisp/facemenu.el @@ -638,7 +638,7 @@ color. The function should accept a single argument, the color name." (insert " ") (insert (propertize (apply 'format "#%02x%02x%02x" - (mapcar (lambda (c) (lsh c -8)) + (mapcar (lambda (c) (ash c -8)) color-values)) 'mouse-face 'highlight 'help-echo diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el index dde9c28656c..0bd9442afc9 100644 --- a/lisp/gnus/message.el +++ b/lisp/gnus/message.el @@ -5564,7 +5564,7 @@ In posting styles use `(\"Expires\" (make-expires-date 30))'." ;; Instead we use this randomly inited counter. (setq message-unique-id-char (% (1+ (or message-unique-id-char - (logand (random most-positive-fixnum) (1- (lsh 1 20))))) + (logand (random most-positive-fixnum) (1- (ash 1 20))))) ;; (current-time) returns 16-bit ints, ;; and 2^16*25 just fits into 4 digits i base 36. (* 25 25))) @@ -5579,9 +5579,9 @@ In posting styles use `(\"Expires\" (make-expires-date 30))'." user) (message-number-base36 (user-uid) -1)) (message-number-base36 (+ (car tm) - (lsh (% message-unique-id-char 25) 16)) 4) + (ash (% message-unique-id-char 25) 16)) 4) (message-number-base36 (+ (nth 1 tm) - (lsh (/ message-unique-id-char 25) 16)) 4) + (ash (/ message-unique-id-char 25) 16)) 4) ;; Append a given name, because while the generated ID is unique ;; to this newsreader, other newsreaders might otherwise generate ;; the same ID via another algorithm. diff --git a/lisp/gnus/nndoc.el b/lisp/gnus/nndoc.el index 149406a9a21..76e785d2ad6 100644 --- a/lisp/gnus/nndoc.el +++ b/lisp/gnus/nndoc.el @@ -769,9 +769,9 @@ from the document.") (defun nndoc-read-little-endian () (+ (prog1 (char-after) (forward-char 1)) - (lsh (prog1 (char-after) (forward-char 1)) 8) - (lsh (prog1 (char-after) (forward-char 1)) 16) - (lsh (prog1 (char-after) (forward-char 1)) 24))) + (ash (prog1 (char-after) (forward-char 1)) 8) + (ash (prog1 (char-after) (forward-char 1)) 16) + (ash (prog1 (char-after) (forward-char 1)) 24))) (defun nndoc-oe-dbx-decode-block () (list diff --git a/lisp/gnus/nnmaildir.el b/lisp/gnus/nnmaildir.el index d5cfa27c21a..c8480ddda4c 100644 --- a/lisp/gnus/nnmaildir.el +++ b/lisp/gnus/nnmaildir.el @@ -651,7 +651,7 @@ This variable is set by `nnmaildir-request-article'.") (funcall func (cdr entry))))))) (defun nnmaildir--up2-1 (n) - (if (zerop n) 1 (1- (lsh 1 (1+ (logb n)))))) + (if (zerop n) 1 (1- (ash 1 (1+ (logb n)))))) (defun nnmaildir--system-name () (replace-regexp-in-string diff --git a/lisp/image.el b/lisp/image.el index 8d12b680ea9..74a23046e94 100644 --- a/lisp/image.el +++ b/lisp/image.el @@ -261,7 +261,7 @@ We accept the tag Exif because that is the same format." (setq i (1+ i)) (when (>= (+ i 2) len) (throw 'jfif nil)) - (let ((nbytes (+ (lsh (aref data (+ i 1)) 8) + (let ((nbytes (+ (ash (aref data (+ i 1)) 8) (aref data (+ i 2)))) (code (aref data i))) (when (and (>= code #xe0) (<= code #xef)) diff --git a/lisp/international/ccl.el b/lisp/international/ccl.el index 58083f05d92..a80452f742f 100644 --- a/lisp/international/ccl.el +++ b/lisp/international/ccl.el @@ -1152,9 +1152,9 @@ is a list of CCL-BLOCKs." (progn (insert (logand code #xFFFFFF)) (setq i (1+ i))) - (insert (format "%c" (lsh code -16))) + (insert (format "%c" (ash code -16))) (if (< (1+ i) len) - (insert (format "%c" (logand (lsh code -8) 255)))) + (insert (format "%c" (logand (ash code -8) 255)))) (if (< (+ i 2) len) (insert (format "%c" (logand code 255)))) (setq i (+ i 3))))) diff --git a/lisp/international/fontset.el b/lisp/international/fontset.el index 9bd05ceb4a2..529262a1e7d 100644 --- a/lisp/international/fontset.el +++ b/lisp/international/fontset.el @@ -487,7 +487,7 @@ (data (list (vconcat (mapcar 'car cjk)))) (i 0)) (dolist (elt cjk) - (let ((mask (lsh 1 i))) + (let ((mask (ash 1 i))) (map-charset-chars #'(lambda (range _arg) (let ((from (car range)) (to (cdr range))) @@ -867,7 +867,7 @@ (spec (cdr target-spec))) (if (integerp spec) (dotimes (i (length registries)) - (if (> (logand spec (lsh 1 i)) 0) + (if (> (logand spec (ash 1 i)) 0) (set-fontset-font "fontset-default" target (cons nil (aref registries i)) nil 'append))) diff --git a/lisp/international/mule-cmds.el b/lisp/international/mule-cmds.el index 2bde83f4eab..817a26b1feb 100644 --- a/lisp/international/mule-cmds.el +++ b/lisp/international/mule-cmds.el @@ -451,8 +451,8 @@ non-nil, it is used to sort CODINGS instead." ;; E: 1 if not XXX-with-esc ;; II: if iso-2022 based, 0..3, else 1. (logior - (lsh (if (eq base most-preferred) 1 0) 7) - (lsh + (ash (if (eq base most-preferred) 1 0) 7) + (ash (let ((mime (coding-system-get base :mime-charset))) ;; Prefer coding systems corresponding to a ;; MIME charset. @@ -468,9 +468,9 @@ non-nil, it is used to sort CODINGS instead." (t 3)) 0)) 5) - (lsh (if (memq base lang-preferred) 1 0) 4) - (lsh (if (memq base from-priority) 1 0) 3) - (lsh (if (string-match-p "-with-esc\\'" + (ash (if (memq base lang-preferred) 1 0) 4) + (ash (if (memq base from-priority) 1 0) 3) + (ash (if (string-match-p "-with-esc\\'" (symbol-name base)) 0 1) 2) (if (eq (coding-system-type base) 'iso-2022) diff --git a/lisp/international/mule.el b/lisp/international/mule.el index 0267b154409..a4f344192cd 100644 --- a/lisp/international/mule.el +++ b/lisp/international/mule.el @@ -911,7 +911,7 @@ non-ASCII files. This attribute is meaningful only when (i 0)) (dolist (elt coding-system-iso-2022-flags) (if (memq elt flags) - (setq bits (logior bits (lsh 1 i)))) + (setq bits (logior bits (ash 1 i)))) (setq i (1+ i))) (setcdr (assq :flags spec-attrs) bits)))) diff --git a/lisp/json.el b/lisp/json.el index cd95ec28327..112f26944bf 100644 --- a/lisp/json.el +++ b/lisp/json.el @@ -370,7 +370,7 @@ representation will be parsed correctly." (defun json--decode-utf-16-surrogates (high low) "Return the code point represented by the UTF-16 surrogates HIGH and LOW." - (+ (lsh (- high #xD800) 10) (- low #xDC00) #x10000)) + (+ (ash (- high #xD800) 10) (- low #xDC00) #x10000)) (defun json-read-escaped-char () "Read the JSON string escaped character at point." diff --git a/lisp/mail/binhex.el b/lisp/mail/binhex.el index 299fc0b2341..fa2ea3d8471 100644 --- a/lisp/mail/binhex.el +++ b/lisp/mail/binhex.el @@ -136,9 +136,9 @@ input and write the converted data to its standard output." (defun binhex-update-crc (crc char &optional count) (if (null count) (setq count 1)) (while (> count 0) - (setq crc (logxor (logand (lsh crc 8) 65280) + (setq crc (logxor (logand (ash crc 8) 65280) (aref binhex-crc-table - (logxor (logand (lsh crc -8) 255) + (logxor (logand (ash crc -8) 255) char))) count (1- count))) crc) @@ -156,14 +156,14 @@ input and write the converted data to its standard output." (defun binhex-string-big-endian (string) (let ((ret 0) (i 0) (len (length string))) (while (< i len) - (setq ret (+ (lsh ret 8) (binhex-char-int (aref string i))) + (setq ret (+ (ash ret 8) (binhex-char-int (aref string i))) i (1+ i))) ret)) (defun binhex-string-little-endian (string) (let ((ret 0) (i 0) (shift 0) (len (length string))) (while (< i len) - (setq ret (+ ret (lsh (binhex-char-int (aref string i)) shift)) + (setq ret (+ ret (ash (binhex-char-int (aref string i)) shift)) i (1+ i) shift (+ shift 8))) ret)) @@ -239,13 +239,13 @@ If HEADER-ONLY is non-nil only decode header and return filename." counter (1+ counter) inputpos (1+ inputpos)) (cond ((= counter 4) - (binhex-push-char (lsh bits -16) nil work-buffer) - (binhex-push-char (logand (lsh bits -8) 255) nil + (binhex-push-char (ash bits -16) nil work-buffer) + (binhex-push-char (logand (ash bits -8) 255) nil work-buffer) (binhex-push-char (logand bits 255) nil work-buffer) (setq bits 0 counter 0)) - (t (setq bits (lsh bits 6))))) + (t (setq bits (ash bits 6))))) (if (null file-name-length) (with-current-buffer work-buffer (setq file-name-length (char-after (point-min)) @@ -261,12 +261,12 @@ If HEADER-ONLY is non-nil only decode header and return filename." (setq tmp (and tmp (not (eq inputpos end))))) (cond ((= counter 3) - (binhex-push-char (logand (lsh bits -16) 255) nil + (binhex-push-char (logand (ash bits -16) 255) nil work-buffer) - (binhex-push-char (logand (lsh bits -8) 255) nil + (binhex-push-char (logand (ash bits -8) 255) nil work-buffer)) ((= counter 2) - (binhex-push-char (logand (lsh bits -10) 255) nil + (binhex-push-char (logand (ash bits -10) 255) nil work-buffer)))) (if header-only nil (binhex-verify-crc work-buffer diff --git a/lisp/mail/rmail.el b/lisp/mail/rmail.el index 12a58b293d0..9416d049028 100644 --- a/lisp/mail/rmail.el +++ b/lisp/mail/rmail.el @@ -4515,7 +4515,7 @@ encoded string (and the same mask) will decode the string." (if (= curmask 0) (setq curmask mask)) (setq charmask (% curmask 256)) - (setq curmask (lsh curmask -8)) + (setq curmask (ash curmask -8)) (aset string-vector i (logxor charmask (aref string-vector i))) (setq i (1+ i))) (concat string-vector))) diff --git a/lisp/mail/uudecode.el b/lisp/mail/uudecode.el index 0cdceca6ff5..b8f74e3a839 100644 --- a/lisp/mail/uudecode.el +++ b/lisp/mail/uudecode.el @@ -171,12 +171,12 @@ If FILE-NAME is non-nil, save the result to FILE-NAME." (cond ((= counter 4) (setq result (cons (concat - (char-to-string (lsh bits -16)) - (char-to-string (logand (lsh bits -8) 255)) + (char-to-string (ash bits -16)) + (char-to-string (logand (ash bits -8) 255)) (char-to-string (logand bits 255))) result)) (setq bits 0 counter 0)) - (t (setq bits (lsh bits 6))))))) + (t (setq bits (ash bits 6))))))) (cond (done) ((> 0 remain) @@ -188,12 +188,12 @@ If FILE-NAME is non-nil, save the result to FILE-NAME." ((= counter 3) (setq result (cons (concat - (char-to-string (logand (lsh bits -16) 255)) - (char-to-string (logand (lsh bits -8) 255))) + (char-to-string (logand (ash bits -16) 255)) + (char-to-string (logand (ash bits -8) 255))) result))) ((= counter 2) (setq result (cons - (char-to-string (logand (lsh bits -10) 255)) + (char-to-string (logand (ash bits -10) 255)) result)))) (skip-chars-forward non-data-chars end)) (if file-name diff --git a/lisp/md4.el b/lisp/md4.el index 09b54fc9a7f..788846ab35a 100644 --- a/lisp/md4.el +++ b/lisp/md4.el @@ -91,15 +91,15 @@ strings containing the character 0." (let* ((h1 (+ (car a) (,func (car b) (car c) (car d)) (car xk) (car ac))) (l1 (+ (cdr a) (,func (cdr b) (cdr c) (cdr d)) (cdr xk) (cdr ac))) - (h2 (logand 65535 (+ h1 (lsh l1 -16)))) + (h2 (logand 65535 (+ h1 (ash l1 -16)))) (l2 (logand 65535 l1)) ;; cyclic shift of 32 bits integer (h3 (logand 65535 (if (> s 15) - (+ (lsh h2 (- s 32)) (lsh l2 (- s 16))) - (+ (lsh h2 s) (lsh l2 (- s 16)))))) + (+ (ash h2 (- s 32)) (ash l2 (- s 16))) + (+ (ash h2 s) (ash l2 (- s 16)))))) (l3 (logand 65535 (if (> s 15) - (+ (lsh l2 (- s 32)) (lsh h2 (- s 16))) - (+ (lsh l2 s) (lsh h2 (- s 16))))))) + (+ (ash l2 (- s 32)) (ash h2 (- s 16))) + (+ (ash l2 s) (ash h2 (- s 16))))))) (cons h3 l3)))) (md4-make-step md4-round1 md4-F) @@ -110,7 +110,7 @@ strings containing the character 0." "Return 32-bit sum of 32-bit integers X and Y." (let ((h (+ (car x) (car y))) (l (+ (cdr x) (cdr y)))) - (cons (logand 65535 (+ h (lsh l -16))) (logand 65535 l)))) + (cons (logand 65535 (+ h (ash l -16))) (logand 65535 l)))) (defsubst md4-and (x y) (cons (logand (car x) (car y)) (logand (cdr x) (cdr y)))) @@ -185,8 +185,8 @@ The resulting MD4 value is placed in `md4-buffer'." (let ((int32s (make-vector 16 0)) (i 0) j) (while (< i 16) (setq j (* i 4)) - (aset int32s i (cons (+ (aref seq (+ j 2)) (lsh (aref seq (+ j 3)) 8)) - (+ (aref seq j) (lsh (aref seq (1+ j)) 8)))) + (aset int32s i (cons (+ (aref seq (+ j 2)) (ash (aref seq (+ j 3)) 8)) + (+ (aref seq j) (ash (aref seq (1+ j)) 8)))) (setq i (1+ i))) int32s)) @@ -197,7 +197,7 @@ The resulting MD4 value is placed in `md4-buffer'." "Pack 16 bits integer in 2 bytes string as little endian." (let ((str (make-string 2 0))) (aset str 0 (logand int16 255)) - (aset str 1 (lsh int16 -8)) + (aset str 1 (ash int16 -8)) str)) (defun md4-pack-int32 (int32) @@ -207,20 +207,20 @@ integers (cons high low)." (let ((str (make-string 4 0)) (h (car int32)) (l (cdr int32))) (aset str 0 (logand l 255)) - (aset str 1 (lsh l -8)) + (aset str 1 (ash l -8)) (aset str 2 (logand h 255)) - (aset str 3 (lsh h -8)) + (aset str 3 (ash h -8)) str)) (defun md4-unpack-int16 (str) (if (eq 2 (length str)) - (+ (lsh (aref str 1) 8) (aref str 0)) + (+ (ash (aref str 1) 8) (aref str 0)) (error "%s is not 2 bytes long" str))) (defun md4-unpack-int32 (str) (if (eq 4 (length str)) - (cons (+ (lsh (aref str 3) 8) (aref str 2)) - (+ (lsh (aref str 1) 8) (aref str 0))) + (cons (+ (ash (aref str 3) 8) (aref str 2)) + (+ (ash (aref str 1) 8) (aref str 0))) (error "%s is not 4 bytes long" str))) (provide 'md4) diff --git a/lisp/net/dns.el b/lisp/net/dns.el index 057ae3219ee..b3b430d2ba8 100644 --- a/lisp/net/dns.el +++ b/lisp/net/dns.el @@ -117,7 +117,7 @@ updated. Set this variable to t to disable the check.") length) (while (not ended) (setq length (dns-read-bytes 1)) - (if (= 192 (logand length (lsh 3 6))) + (if (= 192 (logand length (ash 3 6))) (let ((offset (+ (* (logand 63 length) 256) (dns-read-bytes 1)))) (save-excursion @@ -144,17 +144,17 @@ If TCP-P, the first two bytes of the package with be the length field." (dns-write-bytes (dns-get 'id spec) 2) (dns-write-bytes (logior - (lsh (if (dns-get 'response-p spec) 1 0) -7) - (lsh + (ash (if (dns-get 'response-p spec) 1 0) 7) + (ash (cond ((eq (dns-get 'opcode spec) 'query) 0) ((eq (dns-get 'opcode spec) 'inverse-query) 1) ((eq (dns-get 'opcode spec) 'status) 2) (t (error "No such opcode: %s" (dns-get 'opcode spec)))) - -3) - (lsh (if (dns-get 'authoritative-p spec) 1 0) -2) - (lsh (if (dns-get 'truncated-p spec) 1 0) -1) - (lsh (if (dns-get 'recursion-desired-p spec) 1 0) 0))) + 3) + (ash (if (dns-get 'authoritative-p spec) 1 0) 2) + (ash (if (dns-get 'truncated-p spec) 1 0) 1) + (ash (if (dns-get 'recursion-desired-p spec) 1 0) 0))) (dns-write-bytes (cond ((eq (dns-get 'response-code spec) 'no-error) 0) @@ -198,20 +198,20 @@ If TCP-P, the first two bytes of the package with be the length field." (goto-char (point-min)) (push (list 'id (dns-read-bytes 2)) spec) (let ((byte (dns-read-bytes 1))) - (push (list 'response-p (if (zerop (logand byte (lsh 1 7))) nil t)) + (push (list 'response-p (if (zerop (logand byte (ash 1 7))) nil t)) spec) - (let ((opcode (logand byte (lsh 7 3)))) + (let ((opcode (logand byte (ash 7 3)))) (push (list 'opcode (cond ((eq opcode 0) 'query) ((eq opcode 1) 'inverse-query) ((eq opcode 2) 'status))) spec)) - (push (list 'authoritative-p (if (zerop (logand byte (lsh 1 2))) + (push (list 'authoritative-p (if (zerop (logand byte (ash 1 2))) nil t)) spec) - (push (list 'truncated-p (if (zerop (logand byte (lsh 1 2))) nil t)) + (push (list 'truncated-p (if (zerop (logand byte (ash 1 2))) nil t)) spec) (push (list 'recursion-desired-p - (if (zerop (logand byte (lsh 1 0))) nil t)) spec)) + (if (zerop (logand byte (ash 1 0))) nil t)) spec)) (let ((rc (logand (dns-read-bytes 1) 15))) (push (list 'response-code (cond diff --git a/lisp/net/ntlm.el b/lisp/net/ntlm.el index 8366bc14e95..217f0b859f2 100644 --- a/lisp/net/ntlm.el +++ b/lisp/net/ntlm.el @@ -411,9 +411,9 @@ a string KEY of length 8. FORW is t or nil." (key2 (ntlm-smb-str-to-key key)) (i 0) aa) (while (< i 64) - (unless (zerop (logand (aref in (/ i 8)) (lsh 1 (- 7 (% i 8))))) + (unless (zerop (logand (aref in (/ i 8)) (ash 1 (- 7 (% i 8))))) (aset inb i 1)) - (unless (zerop (logand (aref key2 (/ i 8)) (lsh 1 (- 7 (% i 8))))) + (unless (zerop (logand (aref key2 (/ i 8)) (ash 1 (- 7 (% i 8))))) (aset keyb i 1)) (setq i (1+ i))) (setq outb (ntlm-smb-dohash inb keyb forw)) @@ -422,7 +422,7 @@ a string KEY of length 8. FORW is t or nil." (unless (zerop (aref outb i)) (setq aa (aref out (/ i 8))) (aset out (/ i 8) - (logior aa (lsh 1 (- 7 (% i 8)))))) + (logior aa (ash 1 (- 7 (% i 8)))))) (setq i (1+ i))) out)) @@ -430,28 +430,28 @@ a string KEY of length 8. FORW is t or nil." "Return a string of length 8 for the given string STR of length 7." (let ((key (make-string 8 0)) (i 7)) - (aset key 0 (lsh (aref str 0) -1)) + (aset key 0 (ash (aref str 0) -1)) (aset key 1 (logior - (lsh (logand (aref str 0) 1) 6) - (lsh (aref str 1) -2))) + (ash (logand (aref str 0) 1) 6) + (ash (aref str 1) -2))) (aset key 2 (logior - (lsh (logand (aref str 1) 3) 5) - (lsh (aref str 2) -3))) + (ash (logand (aref str 1) 3) 5) + (ash (aref str 2) -3))) (aset key 3 (logior - (lsh (logand (aref str 2) 7) 4) - (lsh (aref str 3) -4))) + (ash (logand (aref str 2) 7) 4) + (ash (aref str 3) -4))) (aset key 4 (logior - (lsh (logand (aref str 3) 15) 3) - (lsh (aref str 4) -5))) + (ash (logand (aref str 3) 15) 3) + (ash (aref str 4) -5))) (aset key 5 (logior - (lsh (logand (aref str 4) 31) 2) - (lsh (aref str 5) -6))) + (ash (logand (aref str 4) 31) 2) + (ash (aref str 5) -6))) (aset key 6 (logior - (lsh (logand (aref str 5) 63) 1) - (lsh (aref str 6) -7))) + (ash (logand (aref str 5) 63) 1) + (ash (aref str 6) -7))) (aset key 7 (logand (aref str 6) 127)) (while (>= i 0) - (aset key i (lsh (aref key i) 1)) + (aset key i (ash (aref key i) 1)) (setq i (1- i))) key)) @@ -619,16 +619,16 @@ backward." (setq j 0) (while (< j 8) (setq bj (aref b j)) - (setq m (logior (lsh (aref bj 0) 1) (aref bj 5))) - (setq n (logior (lsh (aref bj 1) 3) - (lsh (aref bj 2) 2) - (lsh (aref bj 3) 1) + (setq m (logior (ash (aref bj 0) 1) (aref bj 5))) + (setq n (logior (ash (aref bj 1) 3) + (ash (aref bj 2) 2) + (ash (aref bj 3) 1) (aref bj 4))) (setq k 0) (setq sbox-jmn (aref (aref (aref ntlm-smb-sbox j) m) n)) (while (< k 4) (aset bj k - (if (zerop (logand sbox-jmn (lsh 1 (- 3 k)))) + (if (zerop (logand sbox-jmn (ash 1 (- 3 k)))) 0 1)) (setq k (1+ k))) (setq j (1+ j))) diff --git a/lisp/net/sasl.el b/lisp/net/sasl.el index b4f0fffc716..ca0b66b2fb6 100644 --- a/lisp/net/sasl.el +++ b/lisp/net/sasl.el @@ -183,7 +183,7 @@ It contain at least 64 bits of entropy." ;; Don't use microseconds from (current-time), they may be unsupported. ;; Instead we use this randomly inited counter. (setq sasl-unique-id-char - (% (1+ (or sasl-unique-id-char (logand (random) (1- (lsh 1 20))))) + (% (1+ (or sasl-unique-id-char (logand (random) (1- (ash 1 20))))) ;; (current-time) returns 16-bit ints, ;; and 2^16*25 just fits into 4 digits i base 36. (* 25 25))) @@ -191,10 +191,10 @@ It contain at least 64 bits of entropy." (concat (sasl-unique-id-number-base36 (+ (car tm) - (lsh (% sasl-unique-id-char 25) 16)) 4) + (ash (% sasl-unique-id-char 25) 16)) 4) (sasl-unique-id-number-base36 (+ (nth 1 tm) - (lsh (/ sasl-unique-id-char 25) 16)) 4)))) + (ash (/ sasl-unique-id-char 25) 16)) 4)))) (defun sasl-unique-id-number-base36 (num len) (if (if (< len 0) diff --git a/lisp/net/socks.el b/lisp/net/socks.el index 4a3b13282cf..5ee6eea933f 100644 --- a/lisp/net/socks.el +++ b/lisp/net/socks.el @@ -420,7 +420,7 @@ (unibyte-string version ; version command ; command - (lsh port -8) ; port, high byte + (ash port -8) ; port, high byte (logand port #xff)) ; port, low byte addr ; address (user-full-name) ; username @@ -434,7 +434,7 @@ atype) ; address type addr ; address (unibyte-string - (lsh port -8) ; port, high byte + (ash port -8) ; port, high byte (logand port #xff))))) ; port, low byte (t (error "Unknown protocol version: %d" version))) diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 1af2defd586..8e6c9118509 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -4108,13 +4108,13 @@ This is used to map a mode number to a permission string.") (defun tramp-file-mode-from-int (mode) "Turn an integer representing a file mode into an ls(1)-like string." (let ((type (cdr - (assoc (logand (lsh mode -12) 15) tramp-file-mode-type-map))) - (user (logand (lsh mode -6) 7)) - (group (logand (lsh mode -3) 7)) - (other (logand (lsh mode -0) 7)) - (suid (> (logand (lsh mode -9) 4) 0)) - (sgid (> (logand (lsh mode -9) 2) 0)) - (sticky (> (logand (lsh mode -9) 1) 0))) + (assoc (logand (ash mode -12) 15) tramp-file-mode-type-map))) + (user (logand (ash mode -6) 7)) + (group (logand (ash mode -3) 7)) + (other (logand (ash mode -0) 7)) + (suid (> (logand (ash mode -9) 4) 0)) + (sgid (> (logand (ash mode -9) 2) 0)) + (sticky (> (logand (ash mode -9) 1) 0))) (setq user (tramp-file-mode-permissions user suid "s")) (setq group (tramp-file-mode-permissions group sgid "s")) (setq other (tramp-file-mode-permissions other sticky "t")) 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." The value is an ASCII printing character (not upper case) or a symbol." (if (symbolp event) (car (get event 'event-symbol-elements)) - (let ((base (logand event (1- (lsh 1 18))))) + (let ((base (logand event (1- (ash 1 18))))) (downcase (if (< base 32) (logior base 64) base))))) (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 @@ ) (defmacro pgg-parse-time-field (bytes) - `(list (logior (lsh (car ,bytes) 8) + `(list (logior (ash (car ,bytes) 8) (nth 1 ,bytes)) - (logior (lsh (nth 2 ,bytes) 8) + (logior (ash (nth 2 ,bytes) 8) (nth 3 ,bytes)) 0)) @@ -184,21 +184,21 @@ (ccl-execute-on-string pgg-parse-crc24 h string) (format "%c%c%c" (logand (aref h 1) 255) - (logand (lsh (aref h 2) -8) 255) + (logand (ash (aref h 2) -8) 255) (logand (aref h 2) 255))))) (defmacro pgg-parse-length-type (c) `(cond ((< ,c 192) (cons ,c 1)) ((< ,c 224) - (cons (+ (lsh (- ,c 192) 8) + (cons (+ (ash (- ,c 192) 8) (pgg-byte-after (+ 2 (point))) 192) 2)) ((= ,c 255) - (cons (cons (logior (lsh (pgg-byte-after (+ 2 (point))) 8) + (cons (cons (logior (ash (pgg-byte-after (+ 2 (point))) 8) (pgg-byte-after (+ 3 (point)))) - (logior (lsh (pgg-byte-after (+ 4 (point))) 8) + (logior (ash (pgg-byte-after (+ 4 (point))) 8) (pgg-byte-after (+ 5 (point))))) 5)) (t;partial body length @@ -210,13 +210,13 @@ (if (zerop (logand 64 ptag));Old format (progn (setq length-type (logand ptag 3) - length-type (if (= 3 length-type) 0 (lsh 1 length-type)) - content-tag (logand 15 (lsh ptag -2)) + length-type (if (= 3 length-type) 0 (ash 1 length-type)) + content-tag (logand 15 (ash ptag -2)) packet-bytes 0 header-bytes (1+ length-type)) (dotimes (i length-type) (setq packet-bytes - (logior (lsh packet-bytes 8) + (logior (ash packet-bytes 8) (pgg-byte-after (+ 1 i (point))))))) (setq content-tag (logand 63 ptag) length-type (pgg-parse-length-type @@ -317,10 +317,10 @@ (let ((name-bytes (pgg-read-bytes 2)) (value-bytes (pgg-read-bytes 2))) (cons (pgg-read-bytes-string - (logior (lsh (car name-bytes) 8) + (logior (ash (car name-bytes) 8) (nth 1 name-bytes))) (pgg-read-bytes-string - (logior (lsh (car value-bytes) 8) + (logior (ash (car value-bytes) 8) (nth 1 value-bytes))))))) (21 ;preferred hash algorithms (cons 'preferred-hash-algorithm @@ -380,7 +380,7 @@ (pgg-set-alist result 'hash-algorithm (pgg-read-byte)) (when (>= 10000 (setq n (pgg-read-bytes 2) - n (logior (lsh (car n) 8) + n (logior (ash (car n) 8) (nth 1 n)))) (save-restriction (narrow-to-region (point)(+ n (point))) @@ -391,7 +391,7 @@ #'pgg-parse-signature-subpacket))) (goto-char (point-max)))) (when (>= 10000 (setq n (pgg-read-bytes 2) - n (logior (lsh (car n) 8) + n (logior (ash (car n) 8) (nth 1 n)))) (save-restriction (narrow-to-region (point)(+ n (point))) diff --git a/lisp/org/org.el b/lisp/org/org.el index e45bc55b244..21d9cd8785d 100644 --- a/lisp/org/org.el +++ b/lisp/org/org.el @@ -10058,7 +10058,7 @@ Note: this function also decodes single byte encodings like (cons 6 128)))) (when (>= val 192) (setq eat (car shift-xor))) (setq val (logxor val (cdr shift-xor))) - (setq sum (+ (lsh sum (car shift-xor)) val)) + (setq sum (+ (ash sum (car shift-xor)) val)) (when (> eat 0) (setq eat (- eat 1))) (cond ((= 0 eat) ;multi byte diff --git a/lisp/org/ox-publish.el b/lisp/org/ox-publish.el index 8901dba34cf..ba5a0232e42 100644 --- a/lisp/org/ox-publish.el +++ b/lisp/org/ox-publish.el @@ -794,8 +794,8 @@ Default for SITEMAP-FILENAME is `sitemap.org'." ((or `anti-chronologically `chronologically) (let* ((adate (org-publish-find-date a project)) (bdate (org-publish-find-date b project)) - (A (+ (lsh (car adate) 16) (cadr adate))) - (B (+ (lsh (car bdate) 16) (cadr bdate)))) + (A (+ (ash (car adate) 16) (cadr adate))) + (B (+ (ash (car bdate) 16) (cadr bdate)))) (setq retval (if (eq sort-files 'chronologically) (<= A B) @@ -1348,7 +1348,7 @@ does not exist." (expand-file-name (or (file-symlink-p file) file) (file-name-directory file))))) (if (not attr) (error "No such file: \"%s\"" file) - (+ (lsh (car (nth 5 attr)) 16) + (+ (ash (car (nth 5 attr)) 16) (cadr (nth 5 attr)))))) diff --git a/lisp/progmodes/cc-defs.el b/lisp/progmodes/cc-defs.el index 53d665477c1..f41a7cf028c 100644 --- a/lisp/progmodes/cc-defs.el +++ b/lisp/progmodes/cc-defs.el @@ -1858,7 +1858,7 @@ non-nil, a caret is prepended to invert the set." (setq entry (get-char-table ?a table))) ;; incompatible (t (error "CC Mode is incompatible with this version of Emacs"))) - (setq list (cons (if (= (logand (lsh entry -16) 255) 255) + (setq list (cons (if (= (logand (ash entry -16) 255) 255) '8-bit '1-bit) list))) diff --git a/lisp/progmodes/ebnf2ps.el b/lisp/progmodes/ebnf2ps.el index 74ec569214e..e29eb74a05b 100644 --- a/lisp/progmodes/ebnf2ps.el +++ b/lisp/progmodes/ebnf2ps.el @@ -5130,7 +5130,7 @@ killed after process termination." (defsubst ebnf-font-background (font) (nth 3 font)) (defsubst ebnf-font-list (font) (nthcdr 4 font)) (defsubst ebnf-font-attributes (font) - (lsh (ps-extension-bit (cdr font)) -2)) + (ash (ps-extension-bit (cdr font)) -2)) (defconst ebnf-font-name-select diff --git a/lisp/progmodes/hideif.el b/lisp/progmodes/hideif.el index 24ad2ff6c75..62e8c453389 100644 --- a/lisp/progmodes/hideif.el +++ b/lisp/progmodes/hideif.el @@ -1039,16 +1039,12 @@ preprocessing token" (defun hif-shiftleft (a b) (setq a (hif-mathify a)) (setq b (hif-mathify b)) - (if (< a 0) - (ash a b) - (lsh a b))) + (ash a b)) (defun hif-shiftright (a b) (setq a (hif-mathify a)) (setq b (hif-mathify b)) - (if (< a 0) - (ash a (- b)) - (lsh a (- b)))) + (ash a (- b))) (defalias 'hif-multiply (hif-mathify-binop *)) diff --git a/lisp/ps-bdf.el b/lisp/ps-bdf.el index c8f88234a03..301142ed489 100644 --- a/lisp/ps-bdf.el +++ b/lisp/ps-bdf.el @@ -145,7 +145,7 @@ See the documentation of the function `bdf-read-font-info' for more detail." (if (or (< code (aref code-range 4)) (> code (aref code-range 5))) (setq code (aref code-range 6))) - (+ (* (- (lsh code -8) (aref code-range 0)) + (+ (* (- (ash code -8) (aref code-range 0)) (1+ (- (aref code-range 3) (aref code-range 2)))) (- (logand code 255) (aref code-range 2)))) @@ -262,7 +262,7 @@ CODE, where N and CODE are in the following relation: (setq code (read (current-buffer))) (if (< code 0) (search-forward "ENDCHAR") - (setq code0 (lsh code -8) + (setq code0 (ash code -8) code1 (logand code 255) min-code (min min-code code) max-code (max max-code code) diff --git a/lisp/ps-print.el b/lisp/ps-print.el index 28f93f4e203..7dd1103c2e3 100644 --- a/lisp/ps-print.el +++ b/lisp/ps-print.el @@ -6299,7 +6299,7 @@ If FACE is not a valid face name, use default face." (ps-font-number 'ps-font-for-text (or (aref ps-font-type (logand effect 3)) face)) - fg-color bg-color (lsh effect -2))))) + fg-color bg-color (ash effect -2))))) (goto-char to)) diff --git a/lisp/simple.el b/lisp/simple.el index 6040d48a991..0ccf2f1d22e 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -8348,16 +8348,16 @@ PREFIX is the string that represents this modifier in an event type symbol." (cond ((eq symbol 'control) (if (<= 64 (upcase event) 95) (- (upcase event) 64) - (logior (lsh 1 lshiftby) event))) + (logior (ash 1 lshiftby) event))) ((eq symbol 'shift) ;; FIXME: Should we also apply this "upcase" behavior of shift ;; to non-ascii letters? (if (and (<= (downcase event) ?z) (>= (downcase event) ?a)) (upcase event) - (logior (lsh 1 lshiftby) event))) + (logior (ash 1 lshiftby) event))) (t - (logior (lsh 1 lshiftby) event))) + (logior (ash 1 lshiftby) event))) (if (memq symbol (event-modifiers event)) event (let ((event-type (if (symbolp event) event (car event)))) diff --git a/lisp/tar-mode.el b/lisp/tar-mode.el index 9860c8b30cf..19e5159816a 100644 --- a/lisp/tar-mode.el +++ b/lisp/tar-mode.el @@ -1279,8 +1279,8 @@ for this to be permanent." ;; Format a timestamp as 11 octal digits. Ghod, I hope this works... (let ((hibits (car timeval)) (lobits (car (cdr timeval)))) (format "%05o%01o%05o" - (lsh hibits -2) - (logior (lsh (logand 3 hibits) 1) + (ash hibits -2) + (logior (ash (logand 3 hibits) 1) (if (> (logand lobits 32768) 0) 1 0)) (logand 32767 lobits) ))) diff --git a/lisp/term/common-win.el b/lisp/term/common-win.el index 6ef686a996f..a482067ef39 100644 --- a/lisp/term/common-win.el +++ b/lisp/term/common-win.el @@ -59,20 +59,20 @@ (setq system-key-alist (list ;; These are special "keys" used to pass events from C to lisp. - (cons (logior (lsh 0 16) 1) 'ns-power-off) - (cons (logior (lsh 0 16) 2) 'ns-open-file) - (cons (logior (lsh 0 16) 3) 'ns-open-temp-file) - (cons (logior (lsh 0 16) 4) 'ns-drag-file) - (cons (logior (lsh 0 16) 5) 'ns-drag-color) - (cons (logior (lsh 0 16) 6) 'ns-drag-text) - (cons (logior (lsh 0 16) 7) 'ns-change-font) - (cons (logior (lsh 0 16) 8) 'ns-open-file-line) -;;; (cons (logior (lsh 0 16) 9) 'ns-insert-working-text) -;;; (cons (logior (lsh 0 16) 10) 'ns-delete-working-text) - (cons (logior (lsh 0 16) 11) 'ns-spi-service-call) - (cons (logior (lsh 0 16) 12) 'ns-new-frame) - (cons (logior (lsh 0 16) 13) 'ns-toggle-toolbar) - (cons (logior (lsh 0 16) 14) 'ns-show-prefs) + (cons 1 'ns-power-off) + (cons 2 'ns-open-file) + (cons 3 'ns-open-temp-file) + (cons 4 'ns-drag-file) + (cons 5 'ns-drag-color) + (cons 6 'ns-drag-text) + (cons 7 'ns-change-font) + (cons 8 'ns-open-file-line) +;;; (cons 9 'ns-insert-working-text) +;;; (cons 10 'ns-delete-working-text) + (cons 11 'ns-spi-service-call) + (cons 12 'ns-new-frame) + (cons 13 'ns-toggle-toolbar) + (cons 14 'ns-show-prefs) )))) (set-terminal-parameter frame 'x-setup-function-keys t))) diff --git a/lisp/term/tty-colors.el b/lisp/term/tty-colors.el index a776c830a25..d9b272693b0 100644 --- a/lisp/term/tty-colors.el +++ b/lisp/term/tty-colors.el @@ -830,10 +830,10 @@ DISPLAY can be a display name or a frame, and defaults to the selected frame's display. If DISPLAY is not on a 24-but TTY terminal, return nil." (when (and rgb (= (display-color-cells display) 16777216)) - (let ((r (lsh (car rgb) -8)) - (g (lsh (cadr rgb) -8)) - (b (lsh (nth 2 rgb) -8))) - (logior (lsh r 16) (lsh g 8) b)))) + (let ((r (ash (car rgb) -8)) + (g (ash (cadr rgb) -8)) + (b (ash (nth 2 rgb) -8))) + (logior (ash r 16) (ash g 8) b)))) (defun tty-color-define (name index &optional rgb frame) "Specify a tty color by its NAME, terminal INDEX and RGB values. @@ -895,9 +895,9 @@ FRAME defaults to the selected frame." ;; never consider it for approximating another color. (if try-rgb (progn - (setq try-r (lsh (car try-rgb) -8) - try-g (lsh (cadr try-rgb) -8) - try-b (lsh (nth 2 try-rgb) -8)) + (setq try-r (ash (car try-rgb) -8) + try-g (ash (cadr try-rgb) -8) + try-b (ash (nth 2 try-rgb) -8)) (setq dif-r (- r try-r) dif-g (- g try-g) dif-b (- b try-b)) @@ -938,13 +938,13 @@ should be the same regardless of what display is being used." (i2 (+ i1 ndig)) (i3 (+ i2 ndig))) (list - (lsh + (ash (string-to-number (substring color i1 i2) 16) (* 4 (- 4 ndig))) - (lsh + (ash (string-to-number (substring color i2 i3) 16) (* 4 (- 4 ndig))) - (lsh + (ash (string-to-number (substring color i3) 16) (* 4 (- 4 ndig)))))) ((and (>= len 9) ;; X-style RGB:xx/yy/zz color spec diff --git a/lisp/term/xterm.el b/lisp/term/xterm.el index ce4e18efff8..00747afbdce 100644 --- a/lisp/term/xterm.el +++ b/lisp/term/xterm.el @@ -1009,7 +1009,7 @@ hitting screen's max DCS length." (defun xterm-rgb-convert-to-16bit (prim) "Convert an 8-bit primary color value PRIM to a corresponding 16-bit value." - (logior prim (lsh prim 8))) + (logior prim (ash prim 8))) (defun xterm-register-default-colors (colors) "Register the default set of colors for xterm or compatible emulator. diff --git a/lisp/vc/vc-git.el b/lisp/vc/vc-git.el index 75f458233ee..96c2f38af42 100644 --- a/lisp/vc/vc-git.el +++ b/lisp/vc/vc-git.el @@ -367,8 +367,8 @@ in the order given by 'git status'." (defun vc-git-file-type-as-string (old-perm new-perm) "Return a string describing the file type based on its permissions." - (let* ((old-type (lsh (or old-perm 0) -9)) - (new-type (lsh (or new-perm 0) -9)) + (let* ((old-type (ash (or old-perm 0) -9)) + (new-type (ash (or new-perm 0) -9)) (str (pcase new-type (?\100 ;; File. (pcase old-type diff --git a/lisp/vc/vc-hg.el b/lisp/vc/vc-hg.el index 14df9d8b673..da4fc2bdf70 100644 --- a/lisp/vc/vc-hg.el +++ b/lisp/vc/vc-hg.el @@ -1017,7 +1017,7 @@ hg binary." ;; Dirstate too small to be valid (< (nth 7 dirstate-attr) 40) ;; We want to store 32-bit unsigned values in fixnums. - (zerop (lsh -1 32)) + (zerop (ash most-positive-fixnum -32)) (progn (setf repo-relative-filename (file-relative-name truename repo)) diff --git a/lisp/x-dnd.el b/lisp/x-dnd.el index 5f8578444a0..080cd4d13f3 100644 --- a/lisp/x-dnd.el +++ b/lisp/x-dnd.el @@ -556,18 +556,18 @@ FORMAT is 32 (not used). MESSAGE is the data part of an XClientMessageEvent." (defun x-dnd-motif-value-to-list (value size byteorder) (let ((bytes (cond ((eq size 2) - (list (logand (lsh value -8) ?\xff) + (list (logand (ash value -8) ?\xff) (logand value ?\xff))) ((eq size 4) (if (consp value) - (list (logand (lsh (car value) -8) ?\xff) + (list (logand (ash (car value) -8) ?\xff) (logand (car value) ?\xff) - (logand (lsh (cdr value) -8) ?\xff) + (logand (ash (cdr value) -8) ?\xff) (logand (cdr value) ?\xff)) - (list (logand (lsh value -24) ?\xff) - (logand (lsh value -16) ?\xff) - (logand (lsh value -8) ?\xff) + (list (logand (ash value -24) ?\xff) + (logand (ash value -16) ?\xff) + (logand (ash value -8) ?\xff) (logand value ?\xff))))))) (if (eq byteorder ?l) (reverse bytes) diff --git a/test/src/data-tests.el b/test/src/data-tests.el index 688c32d6eeb..701e579ae2e 100644 --- a/test/src/data-tests.el +++ b/test/src/data-tests.el @@ -123,7 +123,7 @@ most-positive-fixnum, which is just less than a power of 2.") (setq byte (lognot byte))) (if (zerop byte) 0 - (+ (logand byte 1) (data-tests-popcnt (lsh byte -1))))) + (+ (logand byte 1) (data-tests-popcnt (ash byte -1))))) (ert-deftest data-tests-logcount () (should (cl-loop for n in (number-sequence -255 255) @@ -186,17 +186,17 @@ most-positive-fixnum, which is just less than a power of 2.") (dotimes (_ 4) (aset bv i (> (logand 1 n) 0)) (cl-incf i) - (setf n (lsh n -1))))) + (setf n (ash n -1))))) bv)) (defun test-bool-vector-to-hex-string (bv) (let (nibbles (v (cl-coerce bv 'list))) (while v (push (logior - (lsh (if (nth 0 v) 1 0) 0) - (lsh (if (nth 1 v) 1 0) 1) - (lsh (if (nth 2 v) 1 0) 2) - (lsh (if (nth 3 v) 1 0) 3)) + (ash (if (nth 0 v) 1 0) 0) + (ash (if (nth 1 v) 1 0) 1) + (ash (if (nth 2 v) 1 0) 2) + (ash (if (nth 3 v) 1 0) 3)) nibbles) (setf v (nthcdr 4 v))) (mapconcat (lambda (n) (format "%X" n)) |