* bug#32485: 27.0.50; Problem with zerop on 32-bit platforms
2018-08-20 18:12 bug#32485: 27.0.50; Problem with zerop on 32-bit platforms Ken Brown
2018-08-20 18:46 ` Andy Moreton
@ 2018-08-21 20:54 ` Paul Eggert
1 sibling, 0 replies; 5+ messages in thread
From: Paul Eggert @ 2018-08-21 20:54 UTC (permalink / raw)
To: Ken Brown; +Cc: 32485-done, Andy Moreton
[-- Attachment #1: Type: text/plain, Size: 600 bytes --]
> vc-hg-state-fast might still need
> attention. Currently (zerop (lsh -1 32)) returns nil on all platforms,
> so it's useless; but that might change
This prompted me to audit the uses of lsh in the Emacs source code. I found and
fixed a few glitches by installing the attached patch; in particular it fixes
vg-hg-state-fast by using ash instead, as ash's semantics are clear and not
subject to change. This patch goes further in this direction by replacing lsh
with ash when either will do.
As this fixes the remaining problems mentioned in this bug report, I'm boldly
closing the report.
[-- Attachment #2: 0001-Audit-use-of-lsh-and-fix-glitches.patch --]
[-- Type: text/x-patch, Size: 66537 bytes --]
From 69b809bf40d02dc499fa8fbc7e3e2804dfbd319f Mon Sep 17 00:00:00 2001
From: Paul Eggert <eggert@cs.ucla.edu>
Date: Tue, 21 Aug 2018 13:44:03 -0700
Subject: [PATCH] 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.
---
admin/unidata/unidata-gen.el | 10 +++----
admin/unidata/uvs.el | 2 +-
doc/lispref/keymaps.texi | 2 +-
doc/lispref/syntax.texi | 8 +++---
doc/misc/calc.texi | 6 ++--
doc/misc/cl.texi | 2 +-
etc/NEWS.19 | 2 +-
lisp/arc-mode.el | 8 +++---
lisp/calc/calc-bin.el | 6 ++--
lisp/calc/calc-comb.el | 6 ++--
lisp/calc/calc-ext.el | 8 +++---
lisp/calc/calc-math.el | 2 +-
lisp/cedet/semantic/wisent/comp.el | 10 +++----
lisp/composite.el | 6 ++--
lisp/disp-table.el | 4 +--
lisp/dos-fns.el | 2 +-
lisp/edmacro.el | 2 +-
lisp/emacs-lisp/bindat.el | 28 +++++++++----------
lisp/emacs-lisp/byte-opt.el | 4 +--
lisp/emacs-lisp/bytecomp.el | 12 ++++----
| 2 +-
lisp/erc/erc-dcc.el | 4 +--
| 2 +-
lisp/gnus/message.el | 6 ++--
lisp/gnus/nndoc.el | 6 ++--
lisp/gnus/nnmaildir.el | 2 +-
lisp/image.el | 2 +-
lisp/international/ccl.el | 4 +--
lisp/international/fontset.el | 4 +--
lisp/international/mule-cmds.el | 10 +++----
lisp/international/mule.el | 2 +-
lisp/json.el | 2 +-
lisp/mail/binhex.el | 20 +++++++-------
lisp/mail/rmail.el | 2 +-
lisp/mail/uudecode.el | 12 ++++----
lisp/md4.el | 28 +++++++++----------
lisp/net/dns.el | 24 ++++++++--------
lisp/net/ntlm.el | 44 +++++++++++++++---------------
lisp/net/sasl.el | 6 ++--
lisp/net/socks.el | 4 +--
lisp/net/tramp.el | 14 +++++-----
lisp/obsolete/levents.el | 2 +-
lisp/obsolete/pgg-parse.el | 26 +++++++++---------
lisp/org/org.el | 2 +-
lisp/org/ox-publish.el | 6 ++--
lisp/progmodes/cc-defs.el | 2 +-
lisp/progmodes/ebnf2ps.el | 2 +-
lisp/progmodes/hideif.el | 8 ++----
lisp/ps-bdf.el | 4 +--
lisp/ps-print.el | 2 +-
lisp/simple.el | 6 ++--
lisp/tar-mode.el | 4 +--
lisp/term/common-win.el | 28 +++++++++----------
lisp/term/tty-colors.el | 20 +++++++-------
lisp/term/xterm.el | 2 +-
lisp/vc/vc-git.el | 4 +--
lisp/vc/vc-hg.el | 2 +-
lisp/x-dnd.el | 12 ++++----
test/src/data-tests.el | 12 ++++----
59 files changed, 235 insertions(+), 239 deletions(-)
diff --git a/admin/unidata/unidata-gen.el b/admin/unidata/unidata-gen.el
index 8cc1893adb..e520d18909 100644
--- a/admin/unidata/unidata-gen.el
+++ b/admin/unidata/unidata-gen.el
@@ -401,7 +401,7 @@ unidata-gen-table-character
(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 @@ unidata-gen-table
(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 @@ unidata-get-name
((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 @@ unidata-get-decomposition
((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 @@ unidata-gen-table-word-list
(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 6bb6a2ab76..31840fb182 100644
--- a/admin/unidata/uvs.el
+++ b/admin/unidata/uvs.el
@@ -107,7 +107,7 @@ uvs-int-to-bytes
(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 cc2e11e0b6..38e89c6cfd 100644
--- a/doc/lispref/keymaps.texi
+++ b/doc/lispref/keymaps.texi
@@ -1660,7 +1660,7 @@ Translation Keymaps
(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 71c97fdae8..dcfade3f67 100644
--- a/doc/lispref/syntax.texi
+++ b/doc/lispref/syntax.texi
@@ -1014,13 +1014,13 @@ Syntax Table Internals
@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 b1b38620ff..98ef6daa2c 100644
--- a/doc/misc/calc.texi
+++ b/doc/misc/calc.texi
@@ -32717,7 +32717,7 @@ Bit Counting Example
(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 @@ Bit Counting Example
(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 @@ Bit Counting Example
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 77105d3364..6985f19421 100644
--- a/doc/misc/cl.texi
+++ b/doc/misc/cl.texi
@@ -784,7 +784,7 @@ Type Predicates
(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 efe0f0e7f7..1f84e87cef 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 4ddb29dcbb..e45c6004b9 100644
--- a/lisp/arc-mode.el
+++ b/lisp/arc-mode.el
@@ -583,7 +583,7 @@ archive-calc-mode
(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 @@ archive-lzh-ogm
(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 @@ archive-zip-chmod-entry
(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 c05a71a2d7..a61cecf357 100644
--- a/lisp/calc/calc-bin.el
+++ b/lisp/calc/calc-bin.el
@@ -420,7 +420,7 @@ math-not-bignum
(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 @@ math-clip
((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 @@ math-clip-bignum
(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 7c88230f86..f1d3daeed9 100644
--- a/lisp/calc/calc-comb.el
+++ b/lisp/calc/calc-comb.el
@@ -580,7 +580,7 @@ math-init-random-base
;; 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 @@ math-random-base
(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 5feff23f72..f983ebe414 100644
--- a/lisp/calc/calc-ext.el
+++ b/lisp/calc/calc-ext.el
@@ -2294,14 +2294,14 @@ math-check-fixnum
(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 4b8abbf4f8..483907a325 100644
--- a/lisp/calc/calc-math.el
+++ b/lisp/calc/calc-math.el
@@ -1697,7 +1697,7 @@ math-integer-log
(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 837222ad4b..74ca4f4a43 100644
--- a/lisp/cedet/semantic/wisent/comp.el
+++ b/lisp/cedet/semantic/wisent/comp.el
@@ -142,8 +142,8 @@ wisent-pad-string
(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 @@ wisent-SETBIT
"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 7daea54c9e..3d4805e8fa 100644
--- a/lisp/composite.el
+++ b/lisp/composite.el
@@ -119,7 +119,7 @@ encode-composition-rule
(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 @@ encode-composition-rule
(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 13d73a98d0..95224f2b2a 100644
--- a/lisp/disp-table.el
+++ b/lisp/disp-table.el
@@ -226,7 +226,7 @@ make-glyph-code
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 @@ glyph-char
;;;###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 ebb8acb860..aeb8da4d48 100644
--- a/lisp/dos-fns.el
+++ b/lisp/dos-fns.el
@@ -269,7 +269,7 @@ dos-set-register-value
(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 7818062795..c3d9bc5a98 100644
--- a/lisp/edmacro.el
+++ b/lisp/edmacro.el
@@ -547,7 +547,7 @@ edmacro-format-keys
?\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 c134376590..3124217303 100644
--- a/lisp/emacs-lisp/bindat.el
+++ b/lisp/emacs-lisp/bindat.el
@@ -205,22 +205,22 @@ bindat--unpack-u8
(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 @@ bindat--unpack-item
(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 @@ bindat--pack-u8
(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 @@ bindat--pack-item
(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 1920503b8c..4854808fd0 100644
--- a/lisp/emacs-lisp/byte-opt.el
+++ b/lisp/emacs-lisp/byte-opt.el
@@ -1283,7 +1283,7 @@ disassemble-offset
(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 @@ disassemble-offset
(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 ee28e61800..0b8f8824b4 100644
--- a/lisp/emacs-lisp/bytecomp.el
+++ b/lisp/emacs-lisp/bytecomp.el
@@ -835,7 +835,7 @@ byte-compile-push-bytecodes
(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 @@ byte-compile-lapcode
;; 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 @@ byte-compile-make-args-desc
(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 @@ byte-compile-unfold-bcf
(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 ())
--git a/lisp/emacs-lisp/cl-extra.el b/lisp/emacs-lisp/cl-extra.el
index 36b65f97b0..bea38a0509 100644
--- a/lisp/emacs-lisp/cl-extra.el
+++ b/lisp/emacs-lisp/cl-extra.el
@@ -472,7 +472,7 @@ cl-random
(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 fdc209991a..8bf4c3e166 100644
--- a/lisp/erc/erc-dcc.el
+++ b/lisp/erc/erc-dcc.el
@@ -229,7 +229,7 @@ erc-most-positive-int-bytes
"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 @@ erc-unpack-int
(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)))
--git a/lisp/facemenu.el b/lisp/facemenu.el
index a4f675b8c1..7c10d6097c 100644
--- a/lisp/facemenu.el
+++ b/lisp/facemenu.el
@@ -638,7 +638,7 @@ list-colors-print
(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 dde9c28656..0bd9442afc 100644
--- a/lisp/gnus/message.el
+++ b/lisp/gnus/message.el
@@ -5564,7 +5564,7 @@ message-unique-id
;; 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 @@ message-unique-id
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 149406a9a2..76e785d2ad 100644
--- a/lisp/gnus/nndoc.el
+++ b/lisp/gnus/nndoc.el
@@ -769,9 +769,9 @@ nndoc-oe-dbx-type-p
(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 d5cfa27c21..c8480ddda4 100644
--- a/lisp/gnus/nnmaildir.el
+++ b/lisp/gnus/nnmaildir.el
@@ -651,7 +651,7 @@ nnmaildir--nlist-iterate
(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 8d12b680ea..74a23046e9 100644
--- a/lisp/image.el
+++ b/lisp/image.el
@@ -261,7 +261,7 @@ image-jpeg-p
(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 58083f05d9..a80452f742 100644
--- a/lisp/international/ccl.el
+++ b/lisp/international/ccl.el
@@ -1152,9 +1152,9 @@ ccl-dump-write-const-string
(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 9bd05ceb4a..529262a1e7 100644
--- a/lisp/international/fontset.el
+++ b/lisp/international/fontset.el
@@ -487,7 +487,7 @@ build-default-fontset-data
(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 @@ setup-default-fontset
(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 2bde83f4ea..817a26b1fe 100644
--- a/lisp/international/mule-cmds.el
+++ b/lisp/international/mule-cmds.el
@@ -451,8 +451,8 @@ sort-coding-systems
;; 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 @@ sort-coding-systems
(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 0267b15440..a4f344192c 100644
--- a/lisp/international/mule.el
+++ b/lisp/international/mule.el
@@ -911,7 +911,7 @@ define-coding-system
(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 cd95ec2832..112f26944b 100644
--- a/lisp/json.el
+++ b/lisp/json.el
@@ -370,7 +370,7 @@ json-special-chars
(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 299fc0b234..fa2ea3d847 100644
--- a/lisp/mail/binhex.el
+++ b/lisp/mail/binhex.el
@@ -136,9 +136,9 @@ binhex-crc-table
(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 @@ binhex-verify-crc
(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 @@ binhex-decode-region-internal
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 @@ binhex-decode-region-internal
(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 12a58b293d..9416d04902 100644
--- a/lisp/mail/rmail.el
+++ b/lisp/mail/rmail.el
@@ -4515,7 +4515,7 @@ rmail-encode-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 0cdceca6ff..b8f74e3a83 100644
--- a/lisp/mail/uudecode.el
+++ b/lisp/mail/uudecode.el
@@ -171,12 +171,12 @@ uudecode-decode-region-internal
(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 @@ uudecode-decode-region-internal
((= 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 09b54fc9a7..788846ab35 100644
--- a/lisp/md4.el
+++ b/lisp/md4.el
@@ -91,15 +91,15 @@ md4-make-step
(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 @@ md4-add
"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 @@ md4-copy64
(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 @@ md4-pack-int16
"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 @@ md4-pack-int32
(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 057ae3219e..b3b430d2ba 100644
--- a/lisp/net/dns.el
+++ b/lisp/net/dns.el
@@ -117,7 +117,7 @@ dns-read-name
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 @@ dns-write
(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 @@ dns-read
(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 8366bc14e9..217f0b859f 100644
--- a/lisp/net/ntlm.el
+++ b/lisp/net/ntlm.el
@@ -411,9 +411,9 @@ ntlm-smb-hash
(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 @@ ntlm-smb-hash
(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 @@ ntlm-smb-str-to-key
"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 @@ ntlm-smb-dohash
(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 b4f0fffc71..ca0b66b2fb 100644
--- a/lisp/net/sasl.el
+++ b/lisp/net/sasl.el
@@ -183,7 +183,7 @@ sasl-unique-id-function
;; 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 @@ sasl-unique-id-function
(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 4a3b13282c..5ee6eea933 100644
--- a/lisp/net/socks.el
+++ b/lisp/net/socks.el
@@ -420,7 +420,7 @@ socks-send-command
(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 @@ socks-send-command
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 1af2defd58..8e6c911850 100644
--- a/lisp/net/tramp.el
+++ b/lisp/net/tramp.el
@@ -4108,13 +4108,13 @@ tramp-file-mode-type-map
(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 7fb3be83ee..48afe7551d 100644
--- a/lisp/obsolete/levents.el
+++ b/lisp/obsolete/levents.el
@@ -145,7 +145,7 @@ event-key
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 34ec96ec12..a747024649 100644
--- a/lisp/obsolete/pgg-parse.el
+++ b/lisp/obsolete/pgg-parse.el
@@ -116,9 +116,9 @@ pgg-format-key-identifier
)
(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 @@ pgg-set-alist
(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 @@ pgg-parse-packet-header
(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 @@ pgg-parse-signature-subpacket
(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-parse-signature-packet
(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-packet
#'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 e45bc55b24..21d9cd8785 100644
--- a/lisp/org/org.el
+++ b/lisp/org/org.el
@@ -10058,7 +10058,7 @@ org-link-unescape-compound
(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 8901dba34c..ba5a0232e4 100644
--- a/lisp/org/ox-publish.el
+++ b/lisp/org/ox-publish.el
@@ -794,8 +794,8 @@ org-publish-sitemap
((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 @@ org-publish-cache-ctime-of-src
(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 53d665477c..f41a7cf028 100644
--- a/lisp/progmodes/cc-defs.el
+++ b/lisp/progmodes/cc-defs.el
@@ -1858,7 +1858,7 @@ c-emacs-features
(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 74ec569214..e29eb74a05 100644
--- a/lisp/progmodes/ebnf2ps.el
+++ b/lisp/progmodes/ebnf2ps.el
@@ -5130,7 +5130,7 @@ ebnf-font-foreground
(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 24ad2ff6c7..62e8c45338 100644
--- a/lisp/progmodes/hideif.el
+++ b/lisp/progmodes/hideif.el
@@ -1039,16 +1039,12 @@ hif-mathify-binop
(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 c8f88234a0..301142ed48 100644
--- a/lisp/ps-bdf.el
+++ b/lisp/ps-bdf.el
@@ -145,7 +145,7 @@ bdf-compact-code
(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 @@ bdf-read-font-info
(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 28f93f4e20..7dd1103c2e 100644
--- a/lisp/ps-print.el
+++ b/lisp/ps-print.el
@@ -6299,7 +6299,7 @@ ps-plot-with-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 6040d48a99..0ccf2f1d22 100644
--- a/lisp/simple.el
+++ b/lisp/simple.el
@@ -8348,16 +8348,16 @@ event-apply-modifier
(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 9860c8b30c..19e5159816 100644
--- a/lisp/tar-mode.el
+++ b/lisp/tar-mode.el
@@ -1279,8 +1279,8 @@ tar-octal-time
;; 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 6ef686a996..a482067ef3 100644
--- a/lisp/term/common-win.el
+++ b/lisp/term/common-win.el
@@ -59,20 +59,20 @@ x-setup-function-keys
(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 a776c830a2..d9b272693b 100644
--- a/lisp/term/tty-colors.el
+++ b/lisp/term/tty-colors.el
@@ -830,10 +830,10 @@ tty-color-24bit
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 @@ tty-color-approximate
;; 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 @@ tty-color-standard-values
(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 ce4e18efff..00747afbdc 100644
--- a/lisp/term/xterm.el
+++ b/lisp/term/xterm.el
@@ -1009,7 +1009,7 @@ xterm--selection-char
(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 75f458233e..96c2f38af4 100644
--- a/lisp/vc/vc-git.el
+++ b/lisp/vc/vc-git.el
@@ -367,8 +367,8 @@ vc-git-escape-file-name
(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 14df9d8b67..da4fc2bdf7 100644
--- a/lisp/vc/vc-hg.el
+++ b/lisp/vc/vc-hg.el
@@ -1017,7 +1017,7 @@ vc-hg-state-fast
;; 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 5f8578444a..080cd4d13f 100644
--- a/lisp/x-dnd.el
+++ b/lisp/x-dnd.el
@@ -556,18 +556,18 @@ x-dnd-get-motif-value
(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 688c32d6ee..701e579ae2 100644
--- a/test/src/data-tests.el
+++ b/test/src/data-tests.el
@@ -123,7 +123,7 @@ data-tests-popcnt
(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 @@ test-bool-vector-bv-from-hex-string
(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))
--
2.17.1
^ permalink raw reply related [flat|nested] 5+ messages in thread