mirrors/emacs
1
Fork 0
mirror of git://git.sv.gnu.org/emacs.git synced 2025-12-24 06:20:43 -08:00
Code Issues Projects Releases Wiki Activity

Audit use of lsh and fix glitches

Browse source 
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.
This commit is contained in:
Paul Eggert 2018-08-21 13:44:03 -07:00
parent 81e7eef822
commit f18af6cd5c
59 changed files with 235 additions and 239 deletions
Download patch file Download diff file Expand all files Collapse all files

10
admin/unidata/unidata-gen.el
View file

@ -401,7 +401,7 @@ Property value is a symbol `o' (Open), `c' (Close), or `n' (None)."
(if (consp range) (if (consp range)
(if val (if val
(set-char-table-range table range 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)) (limit (+ start 127))
first-index last-index) first-index last-index)
(fillarray vec 0) (fillarray vec 0)
@ -548,7 +548,7 @@ Property value is a symbol `o' (Open), `c' (Close), or `n' (None)."
(if (< from (logand to #x1FFF80)) (if (< from (logand to #x1FFF80))
(setq from (logand to #x1FFF80))) (setq from (logand to #x1FFF80)))
(setq prev-range-data (cons (cons from to) val-code))))) (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)) (limit (+ start 127))
str count new-val from to vcode) str count new-val from to vcode)
(fillarray vec (car default-value)) (fillarray vec (car default-value))
@ -761,7 +761,7 @@ Property value is a symbol `o' (Open), `c' (Close), or `n' (None)."
((stringp val) ((stringp val)
(if (> (aref val 0) 0) (if (> (aref val 0) 0)
val 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)) (word-table (aref (char-table-extra-slot table 4) 0))
(i 1) (i 1)
(len (length val)) (len (length val))
@ -865,7 +865,7 @@ Property value is a symbol `o' (Open), `c' (Close), or `n' (None)."
((stringp val) ((stringp val)
(if (> (aref val 0) 0) (if (> (aref val 0) 0)
val 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)) (word-table (char-table-extra-slot table 4))
(i 1) (i 1)
(len (length val)) (len (length val))
@ -982,7 +982,7 @@ Property value is a symbol `o' (Open), `c' (Close), or `n' (None)."
(if slot (if slot
(nconc slot (list range)) (nconc slot (list range))
(push (list val range) block-list)))) (push (list val range) block-list))))
(let* ((start (lsh (lsh range -7) 7)) (let* ((start (ash (ash range -7) 7))
(limit (+ start 127)) (limit (+ start 127))
(first tail) (first tail)
(vec (make-vector 128 nil)) (vec (make-vector 128 nil))

2
admin/unidata/uvs.el
View file

@ -107,7 +107,7 @@ The most significant byte comes first."
(let (result) (let (result)
(dotimes (i size) (dotimes (i size)
(push (logand value #xff) result) (push (logand value #xff) result)
(setq value (lsh value -8))) (setq value (ash value -8)))
result)) result))
(defun uvs-insert-fields-as-bytes (fields &rest values) (defun uvs-insert-fields-as-bytes (fields &rest values)

2
doc/lispref/keymaps.texi
View file

@ -1660,7 +1660,7 @@ to turn the character that follows into a Hyper character:
(defun hyperify (prompt) (defun hyperify (prompt)
(let ((e (read-event))) (let ((e (read-event)))
(vector (if (numberp e) (vector (if (numberp e)
(logior (lsh 1 24) e) (logior (ash 1 24) e)
(if (memq 'hyper (event-modifiers e)) (if (memq 'hyper (event-modifiers e))
e e
(add-event-modifier "H-" e)))))) (add-event-modifier "H-" e))))))

8
doc/lispref/syntax.texi
View file

@ -1014,13 +1014,13 @@ corresponds to each syntax flag.
@item @item
@i{Prefix} @tab @i{Flag} @tab @i{Prefix} @tab @i{Flag} @i{Prefix} @tab @i{Flag} @tab @i{Prefix} @tab @i{Flag}
@item @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 @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 @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 @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 @end multitable
@defun string-to-syntax desc @defun string-to-syntax desc

6
doc/misc/calc.texi
View file

@ -32717,7 +32717,7 @@ create an intermediate set.
(while (> n 0) (while (> n 0)
(if (oddp n) (if (oddp n)
(setq count (1+ count))) (setq count (1+ count)))
(setq n (lsh n -1))) (setq n (ash n -1)))
count)) count))
@end smallexample @end smallexample
@ -32761,7 +32761,7 @@ routines are especially fast when dividing by an integer less than
(let ((count 0)) (let ((count 0))
(while (> n 0) (while (> n 0)
(setq count (+ count (logand n 1)) (setq count (+ count (logand n 1))
n (lsh n -1))) n (ash n -1)))
count)) count))
@end smallexample @end smallexample
@ -32774,7 +32774,7 @@ uses.
The @code{idivmod} function does an integer division, returning both The @code{idivmod} function does an integer division, returning both
the quotient and the remainder at once. Again, note that while it 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}, more efficient ways to split off the bottom nine bits of @code{n},
actually they are less efficient because each operation is really actually they are less efficient because each operation is really
a division by 512 in disguise; @code{idivmod} allows us to do the a division by 512 in disguise; @code{idivmod} allows us to do the

2
doc/misc/cl.texi
View file

@ -784,7 +784,7 @@ default. Some examples:
(cl-deftype null () '(satisfies null)) ; predefined (cl-deftype null () '(satisfies null)) ; predefined
(cl-deftype list () '(or null cons)) ; predefined (cl-deftype list () '(or null cons)) ; predefined
(cl-deftype unsigned-byte (&optional bits) (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 8) @equiv{} (integer 0 255)
(unsigned-byte) @equiv{} (integer 0 *) (unsigned-byte) @equiv{} (integer 0 *)
unsigned-byte @equiv{} (integer 0 *) unsigned-byte @equiv{} (integer 0 *)

2
etc/NEWS.19
View file

@ -4341,7 +4341,7 @@ turn the character that follows into a hyper character:
(defun hyperify (prompt) (defun hyperify (prompt)
(let ((e (read-event))) (let ((e (read-event)))
(vector (if (numberp e) (vector (if (numberp e)
(logior (lsh 1 20) e) (logior (ash 1 20) e)
(if (memq 'hyper (event-modifiers e)) (if (memq 'hyper (event-modifiers e))
e e
(add-event-modifier "H-" e)))))) (add-event-modifier "H-" e))))))

8
lisp/arc-mode.el
View file

@ -583,7 +583,7 @@ the mode is invalid. If ERROR is nil then nil will be returned."
(len (length newmode)) (len (length newmode))
(i 1)) (i 1))
(while (< i len) (while (< i len)
(setq result (+ (lsh result 3) (aref newmode i) (- ?0)) (setq result (+ (ash result 3) (aref newmode i) (- ?0))
i (1+ i))) i (1+ i)))
(logior (logand oldmode 65024) result))) (logior (logand oldmode 65024) result)))
((string-match "^\\([agou]+\\)\\([---+=]\\)\\([rwxst]+\\)$" newmode) ((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)))) (setq newval (funcall newval (archive-l-e (+ p2 ofs) 2))))
(goto-char (+ p2 ofs)) (goto-char (+ p2 ofs))
(delete-char 2) (delete-char 2)
(insert-unibyte (logand newval 255) (lsh newval -8)) (insert-unibyte (logand newval 255) (ash newval -8))
(goto-char (1+ p)) (goto-char (1+ p))
(delete-char 1) (delete-char 1)
(insert-unibyte (archive-lzh-resum (1+ p) hsize))) (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 (cond ((memq creator '(2 3)) ; Unix
(goto-char (+ p 40)) (goto-char (+ p 40))
(delete-char 2) (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. ((memq creator '(0 5 6 7 10 11 15)) ; Dos etc.
(goto-char (+ p 38)) (goto-char (+ p 38))
(insert-unibyte (logior (logand (byte-after (point)) 254) (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)) (delete-char 1))
(t (message "Don't know how to change mode for this member")))) (t (message "Don't know how to change mode for this member"))))
)))) ))))

6
lisp/calc/calc-bin.el
View file

@ -420,7 +420,7 @@ the size of a Calc bignum digit.")
(let ((q (math-div-bignum-digit a math-bignum-digit-power-of-two))) (let ((q (math-div-bignum-digit a math-bignum-digit-power-of-two)))
(if (<= w math-bignum-logb-digit-size) (if (<= w math-bignum-logb-digit-size)
(list (logand (lognot (cdr q)) (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)) (math-mul-bignum-digit (math-not-bignum (math-norm-bignum (car q))
(- w math-bignum-logb-digit-size)) (- w math-bignum-logb-digit-size))
math-bignum-digit-power-of-two 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)) ((and (integerp a) (< a math-small-integer-size))
(if (> w (logb math-small-integer-size)) (if (> w (logb math-small-integer-size))
a a
(logand a (1- (lsh 1 w))))) (logand a (1- (ash 1 w)))))
(t (t
(math-normalize (math-normalize
(cons 'bigpos (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))) (let ((q (math-div-bignum-digit a math-bignum-digit-power-of-two)))
(if (<= w math-bignum-logb-digit-size) (if (<= w math-bignum-logb-digit-size)
(list (logand (cdr q) (list (logand (cdr q)
(1- (lsh 1 w)))) (1- (ash 1 w))))
(math-mul-bignum-digit (math-clip-bignum (math-norm-bignum (car q)) (math-mul-bignum-digit (math-clip-bignum (math-norm-bignum (car q))
(- w math-bignum-logb-digit-size)) (- w math-bignum-logb-digit-size))
math-bignum-digit-power-of-two math-bignum-digit-power-of-two

6
lisp/calc/calc-comb.el
View file

@ -580,7 +580,7 @@
;; deduce a better value for RAND_MAX. ;; deduce a better value for RAND_MAX.
(let ((i 0)) (let ((i 0))
(while (< (setq i (1+ i)) 30) (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-random-shift (1- math-random-shift))))))
(setq math-last-RandSeed var-RandSeed (setq math-last-RandSeed var-RandSeed
math-gaussian-cache nil)) math-gaussian-cache nil))
@ -592,11 +592,11 @@
(cdr math-random-table)) (cdr math-random-table))
math-random-ptr2 (or (cdr math-random-ptr2) math-random-ptr2 (or (cdr math-random-ptr2)
(cdr math-random-table))) (cdr math-random-table)))
(logand (lsh (setcar math-random-ptr1 (logand (ash (setcar math-random-ptr1
(logand (- (car math-random-ptr1) (logand (- (car math-random-ptr1)
(car math-random-ptr2)) 524287)) (car math-random-ptr2)) 524287))
-6) 1023)) -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. ;;; Produce a random digit in the range 0..999.

8
lisp/calc/calc-ext.el
View file

@ -2294,14 +2294,14 @@ calc-kill calc-kill-region calc-yank))))
(let ((a (math-trunc a))) (let ((a (math-trunc a)))
(if (integerp a) (if (integerp a)
a a
(if (or (Math-lessp (lsh -1 -1) a) (if (or (Math-lessp most-positive-fixnum a)
(Math-lessp a (- (lsh -1 -1)))) (Math-lessp a (- most-positive-fixnum)))
(math-reject-arg a 'fixnump) (math-reject-arg a 'fixnump)
(math-fixnum a))))) (math-fixnum a)))))
((and allow-inf (equal a '(var inf var-inf))) ((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)))) ((and allow-inf (equal a '(neg (var inf var-inf))))
(- (lsh -1 -1))) (- most-positive-fixnum))
(t (math-reject-arg a 'fixnump)))) (t (math-reject-arg a 'fixnump))))
;;; Verify that A is an integer >= 0 and return A in integer form. [I N; - x] ;;; Verify that A is an integer >= 0 and return A in integer form. [I N; - x]

2
lisp/calc/calc-math.el
View file

@ -1697,7 +1697,7 @@ If this can't be done, return NIL."
(while (not (Math-lessp x pow)) (while (not (Math-lessp x pow))
(setq pows (cons pow pows) (setq pows (cons pow pows)
pow (math-sqr pow))) pow (math-sqr pow)))
(setq n (lsh 1 (1- (length pows))) (setq n (ash 1 (1- (length pows)))
sum n sum n
pow (car pows)) pow (car pows))
(while (and (setq pows (cdr pows)) (while (and (setq pows (cdr pows))

10
lisp/cedet/semantic/wisent/comp.el
View file

@ -142,8 +142,8 @@ If optional LEFT is non-nil insert spaces on left."
(defconst wisent-BITS-PER-WORD (defconst wisent-BITS-PER-WORD
(let ((i 1) (let ((i 1)
(do-shift (if (boundp 'most-positive-fixnum) (do-shift (if (boundp 'most-positive-fixnum)
(lambda (i) (lsh most-positive-fixnum (- i))) (lambda (i) (ash most-positive-fixnum (- i)))
(lambda (i) (lsh 1 i))))) (lambda (i) (ash 1 i)))))
(while (not (zerop (funcall do-shift i))) (while (not (zerop (funcall do-shift i)))
(setq i (1+ i))) (setq i (1+ i)))
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)." "X[I/BITS-PER-WORD] |= 1 << (I % BITS-PER-WORD)."
(let ((k (/ i wisent-BITS-PER-WORD))) (let ((k (/ i wisent-BITS-PER-WORD)))
(aset x k (logior (aref x k) (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) (defsubst wisent-RESETBIT (x i)
"X[I/BITS-PER-WORD] &= ~(1 << (I % BITS-PER-WORD))." "X[I/BITS-PER-WORD] &= ~(1 << (I % BITS-PER-WORD))."
(let ((k (/ i wisent-BITS-PER-WORD))) (let ((k (/ i wisent-BITS-PER-WORD)))
(aset x k (logand (aref x k) (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) (defsubst wisent-BITISSET (x i)
"(X[I/BITS-PER-WORD] & (1 << (I % BITS-PER-WORD))) != 0." "(X[I/BITS-PER-WORD] & (1 << (I % BITS-PER-WORD))) != 0."
(not (zerop (logand (aref x (/ i wisent-BITS-PER-WORD)) (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 () (defsubst wisent-noninteractive ()
"Return non-nil if running without interactive terminal." "Return non-nil if running without interactive terminal."

6
lisp/composite.el
View file

@ -119,7 +119,7 @@ RULE is a cons of global and new reference point symbols
(setq nref (cdr (assq nref reference-point-alist)))) (setq nref (cdr (assq nref reference-point-alist))))
(or (and (>= gref 0) (< gref 12) (>= nref 0) (< nref 12)) (or (and (>= gref 0) (< gref 12) (>= nref 0) (< nref 12))
(error "Invalid composition rule: %S" rule)) (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)))) (error "Invalid composition rule: %S" rule))))
;; Decode encoded composition rule RULE-CODE. The value is a cons of ;; 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) (defun decode-composition-rule (rule-code)
(or (and (natnump rule-code) (< rule-code #x1000000)) (or (and (natnump rule-code) (< rule-code #x1000000))
(error "Invalid encoded composition rule: %S" rule-code)) (error "Invalid encoded composition rule: %S" rule-code))
(let ((xoff (lsh rule-code -16)) (let ((xoff (ash rule-code -16))
(yoff (logand (lsh rule-code -8) #xFF)) (yoff (logand (ash rule-code -8) #xFF))
gref nref) gref nref)
(setq rule-code (logand rule-code #xFF) (setq rule-code (logand rule-code #xFF)
gref (car (rassq (/ rule-code 12) reference-point-alist)) gref (car (rassq (/ rule-code 12) reference-point-alist))

4
lisp/disp-table.el
View file

@ -226,7 +226,7 @@ X frame."
char char
(let ((fid (face-id face))) (let ((fid (face-id face)))
(if (< fid 64) ; we have 32 - 3(LSB) - 1(SIGN) - 22(CHAR) = 6 bits for face id (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))))) (cons char fid)))))
;;;###autoload ;;;###autoload
@ -239,7 +239,7 @@ X frame."
;;;###autoload ;;;###autoload
(defun glyph-face (glyph) (defun glyph-face (glyph)
"Return the face of glyph code GLYPH, or nil if glyph has default face." "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) (and (> face-id 0)
(catch 'face (catch 'face
(dolist (face (face-list)) (dolist (face (face-list))

2
lisp/dos-fns.el
View file

@ -269,7 +269,7 @@ returned unaltered."
(car where) (car where)
(if (zerop (cdr where)) (if (zerop (cdr where))
(logior (logand tem 65280) value) (logior (logand tem 65280) value)
(logior (logand tem 255) (lsh value 8)))))) (logior (logand tem 255) (ash value 8))))))
((numberp where) ((numberp where)
(aset regs where (logand value 65535)))))) (aset regs where (logand value 65535))))))
regs) regs)

2
lisp/edmacro.el
View file

@ -547,7 +547,7 @@ doubt, use whitespace."
?\M-\^@ ?\s-\^@ ?\S-\^@) ?\M-\^@ ?\s-\^@ ?\S-\^@)
when (/= (logand ch bit) 0) when (/= (logand ch bit) 0)
concat (format "%c-" pf)) concat (format "%c-" pf))
(let ((ch2 (logand ch (1- (lsh 1 18))))) (let ((ch2 (logand ch (1- (ash 1 18)))))
(cond ((<= ch2 32) (cond ((<= ch2 32)
(pcase ch2 (pcase ch2
(0 "NUL") (9 "TAB") (10 "LFD") (0 "NUL") (9 "TAB") (10 "LFD")

28
lisp/emacs-lisp/bindat.el
View file

@ -205,22 +205,22 @@
(setq bindat-idx (1+ bindat-idx)))) (setq bindat-idx (1+ bindat-idx))))
(defun bindat--unpack-u16 () (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 () (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 () (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 () (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 () (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 () (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) (defun bindat--unpack-item (type len &optional vectype)
(if (eq type 'ip) (if (eq type 'ip)
@ -250,7 +250,7 @@
(if (/= 0 (logand m j)) (if (/= 0 (logand m j))
(setq bits (cons bnum bits))) (setq bits (cons bnum bits)))
(setq bnum (1- bnum) (setq bnum (1- bnum)
j (lsh j -1))))) j (ash j -1)))))
bits)) bits))
((eq type 'str) ((eq type 'str)
(let ((s (substring bindat-raw bindat-idx (+ bindat-idx len)))) (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))) (setq bindat-idx (1+ bindat-idx)))
(defun bindat--pack-u16 (v) (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)) (aset bindat-raw (1+ bindat-idx) (logand v 255))
(setq bindat-idx (+ bindat-idx 2))) (setq bindat-idx (+ bindat-idx 2)))
(defun bindat--pack-u24 (v) (defun bindat--pack-u24 (v)
(bindat--pack-u8 (lsh v -16)) (bindat--pack-u8 (ash v -16))
(bindat--pack-u16 v)) (bindat--pack-u16 v))
(defun bindat--pack-u32 (v) (defun bindat--pack-u32 (v)
(bindat--pack-u16 (lsh v -16)) (bindat--pack-u16 (ash v -16))
(bindat--pack-u16 v)) (bindat--pack-u16 v))
(defun bindat--pack-u16r (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)) (aset bindat-raw bindat-idx (logand v 255))
(setq bindat-idx (+ bindat-idx 2))) (setq bindat-idx (+ bindat-idx 2)))
(defun bindat--pack-u24r (v) (defun bindat--pack-u24r (v)
(bindat--pack-u16r v) (bindat--pack-u16r v)
(bindat--pack-u8 (lsh v -16))) (bindat--pack-u8 (ash v -16)))
(defun bindat--pack-u32r (v) (defun bindat--pack-u32r (v)
(bindat--pack-u16r 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) (defun bindat--pack-item (v type len &optional vectype)
(if (eq type 'ip) (if (eq type 'ip)
@ -515,7 +515,7 @@ e.g. corresponding to STRUCT.FIELD1[INDEX2].FIELD3..."
(if (memq bnum v) (if (memq bnum v)
(setq m (logior m j))) (setq m (logior m j)))
(setq bnum (1- bnum) (setq bnum (1- bnum)
j (lsh j -1)))) j (ash j -1))))
(bindat--pack-u8 m)))) (bindat--pack-u8 m))))
((memq type '(str strz)) ((memq type '(str strz))
(let ((l (length v)) (i 0)) (let ((l (length v)) (i 0))

4
lisp/emacs-lisp/byte-opt.el
View file

@ -1283,7 +1283,7 @@
(setq bytedecomp-ptr (1+ bytedecomp-ptr)) (setq bytedecomp-ptr (1+ bytedecomp-ptr))
(+ (aref bytes bytedecomp-ptr) (+ (aref bytes bytedecomp-ptr)
(progn (setq bytedecomp-ptr (1+ 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. (t tem)))) ;Offset was in opcode.
((>= bytedecomp-op byte-constant) ((>= bytedecomp-op byte-constant)
(prog1 (- bytedecomp-op byte-constant) ;Offset in opcode. (prog1 (- bytedecomp-op byte-constant) ;Offset in opcode.
@ -1297,7 +1297,7 @@
(setq bytedecomp-ptr (1+ bytedecomp-ptr)) (setq bytedecomp-ptr (1+ bytedecomp-ptr))
(+ (aref bytes bytedecomp-ptr) (+ (aref bytes bytedecomp-ptr)
(progn (setq bytedecomp-ptr (1+ 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) ((and (>= bytedecomp-op byte-listN)
(<= bytedecomp-op byte-discardN)) (<= bytedecomp-op byte-discardN))
(setq bytedecomp-ptr (1+ bytedecomp-ptr)) ;Offset in next byte. (setq bytedecomp-ptr (1+ bytedecomp-ptr)) ;Offset in next byte.

12
lisp/emacs-lisp/bytecomp.el
View file

@ -835,7 +835,7 @@ all the arguments.
(defmacro byte-compile-push-bytecode-const2 (opcode const2 bytes pc) (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. "Push OPCODE and the two-byte constant CONST2 onto BYTES, and add 3 to PC.
CONST2 may be evaluated multiple times." 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)) ,bytes ,pc))
(defun byte-compile-lapcode (lap) (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 ;; Splits PC's value into 2 bytes. The jump address is
;; "reconstructed" by the `FETCH2' macro in `bytecode.c'. ;; "reconstructed" by the `FETCH2' macro in `bytecode.c'.
(setcar (cdr bytes-tail) (logand pc 255)) (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. ;; 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. ;; Similarly, replace TAGs in all jump tables with the correct PC index.
(dolist (hash-table byte-compile-jump-tables) (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) (if (> mandatory 127)
(byte-compile-report-error "Too many (>127) mandatory arguments") (byte-compile-report-error "Too many (>127) mandatory arguments")
(logior mandatory (logior mandatory
(lsh nonrest 8) (ash nonrest 8)
(lsh rest 7))))) (ash rest 7)))))
(defun byte-compile-lambda (fun &optional add-lambda reserved-csts) (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)) (fun (car form))
(fargs (aref fun 0)) (fargs (aref fun 0))
(start-depth byte-compile-depth) (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))) ;; (fmin (if (numberp fargs) (logand fargs 127)))
(alen (length (cdr form))) (alen (length (cdr form)))
(dynbinds ()) (dynbinds ())

2
lisp/emacs-lisp/cl-extra.el
View file

@ -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)))))) (n (logand 8388607 (aset vec i (- (aref vec i) (aref vec j))))))
(if (integerp lim) (if (integerp lim)
(if (<= lim 512) (% n 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)) (let ((mask 1023))
(while (< mask (1- lim)) (setq mask (1+ (+ mask mask)))) (while (< mask (1- lim)) (setq mask (1+ (+ mask mask))))
(if (< (setq n (logand n mask)) lim) n (cl-random lim state)))) (if (< (setq n (logand n mask)) lim) n (cl-random lim state))))

4
lisp/erc/erc-dcc.el
View file

@ -229,7 +229,7 @@ which is big-endian."
"Maximum number of bytes for a fixnum.") "Maximum number of bytes for a fixnum.")
(defconst erc-most-positive-int-msb (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.") "Content of the most significant byte of most-positive-fixnum.")
(defun erc-unpack-int (str) (defun erc-unpack-int (str)
@ -251,7 +251,7 @@ which is big-endian."
(let ((num 0) (let ((num 0)
(count 0)) (count 0))
(while (< count len) (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))) (setq count (1+ count)))
num))) num)))

2
lisp/facemenu.el
View file

@ -638,7 +638,7 @@ color. The function should accept a single argument, the color name."
(insert " ") (insert " ")
(insert (propertize (insert (propertize
(apply 'format "#%02x%02x%02x" (apply 'format "#%02x%02x%02x"
(mapcar (lambda (c) (lsh c -8)) (mapcar (lambda (c) (ash c -8))
color-values)) color-values))
'mouse-face 'highlight 'mouse-face 'highlight
'help-echo 'help-echo

6
lisp/gnus/message.el
View file

@ -5564,7 +5564,7 @@ In posting styles use `(\"Expires\" (make-expires-date 30))'."
;; Instead we use this randomly inited counter. ;; Instead we use this randomly inited counter.
(setq message-unique-id-char (setq message-unique-id-char
(% (1+ (or 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, ;; (current-time) returns 16-bit ints,
;; and 2^16*25 just fits into 4 digits i base 36. ;; and 2^16*25 just fits into 4 digits i base 36.
(* 25 25))) (* 25 25)))
@ -5579,9 +5579,9 @@ In posting styles use `(\"Expires\" (make-expires-date 30))'."
user) user)
(message-number-base36 (user-uid) -1)) (message-number-base36 (user-uid) -1))
(message-number-base36 (+ (car tm) (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) (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 ;; Append a given name, because while the generated ID is unique
;; to this newsreader, other newsreaders might otherwise generate ;; to this newsreader, other newsreaders might otherwise generate
;; the same ID via another algorithm. ;; the same ID via another algorithm.

6
lisp/gnus/nndoc.el
View file

@ -769,9 +769,9 @@ from the document.")
(defun nndoc-read-little-endian () (defun nndoc-read-little-endian ()
(+ (prog1 (char-after) (forward-char 1)) (+ (prog1 (char-after) (forward-char 1))
(lsh (prog1 (char-after) (forward-char 1)) 8) (ash (prog1 (char-after) (forward-char 1)) 8)
(lsh (prog1 (char-after) (forward-char 1)) 16) (ash (prog1 (char-after) (forward-char 1)) 16)
(lsh (prog1 (char-after) (forward-char 1)) 24))) (ash (prog1 (char-after) (forward-char 1)) 24)))
(defun nndoc-oe-dbx-decode-block () (defun nndoc-oe-dbx-decode-block ()
(list (list

2
lisp/gnus/nnmaildir.el
View file

@ -651,7 +651,7 @@ This variable is set by `nnmaildir-request-article'.")
(funcall func (cdr entry))))))) (funcall func (cdr entry)))))))
(defun nnmaildir--up2-1 (n) (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 () (defun nnmaildir--system-name ()
(replace-regexp-in-string (replace-regexp-in-string

2
lisp/image.el
View file

@ -261,7 +261,7 @@ We accept the tag Exif because that is the same format."
(setq i (1+ i)) (setq i (1+ i))
(when (>= (+ i 2) len) (when (>= (+ i 2) len)
(throw 'jfif nil)) (throw 'jfif nil))
(let ((nbytes (+ (lsh (aref data (+ i 1)) 8) (let ((nbytes (+ (ash (aref data (+ i 1)) 8)
(aref data (+ i 2)))) (aref data (+ i 2))))
(code (aref data i))) (code (aref data i)))
(when (and (>= code #xe0) (<= code #xef)) (when (and (>= code #xe0) (<= code #xef))

4
lisp/international/ccl.el
View file

@ -1152,9 +1152,9 @@ is a list of CCL-BLOCKs."
(progn (progn
(insert (logand code #xFFFFFF)) (insert (logand code #xFFFFFF))
(setq i (1+ i))) (setq i (1+ i)))
(insert (format "%c" (lsh code -16))) (insert (format "%c" (ash code -16)))
(if (< (1+ i) len) (if (< (1+ i) len)
(insert (format "%c" (logand (lsh code -8) 255)))) (insert (format "%c" (logand (ash code -8) 255))))
(if (< (+ i 2) len) (if (< (+ i 2) len)
(insert (format "%c" (logand code 255)))) (insert (format "%c" (logand code 255))))
(setq i (+ i 3))))) (setq i (+ i 3)))))

4
lisp/international/fontset.el
View file

@ -487,7 +487,7 @@
(data (list (vconcat (mapcar 'car cjk)))) (data (list (vconcat (mapcar 'car cjk))))
(i 0)) (i 0))
(dolist (elt cjk) (dolist (elt cjk)
(let ((mask (lsh 1 i))) (let ((mask (ash 1 i)))
(map-charset-chars (map-charset-chars
#'(lambda (range _arg) #'(lambda (range _arg)
(let ((from (car range)) (to (cdr range))) (let ((from (car range)) (to (cdr range)))
@ -867,7 +867,7 @@
(spec (cdr target-spec))) (spec (cdr target-spec)))
(if (integerp spec) (if (integerp spec)
(dotimes (i (length registries)) (dotimes (i (length registries))
(if (> (logand spec (lsh 1 i)) 0) (if (> (logand spec (ash 1 i)) 0)
(set-fontset-font "fontset-default" target (set-fontset-font "fontset-default" target
(cons nil (aref registries i)) (cons nil (aref registries i))
nil 'append))) nil 'append)))

10
lisp/international/mule-cmds.el
View file

@ -451,8 +451,8 @@ non-nil, it is used to sort CODINGS instead."
;; E: 1 if not XXX-with-esc ;; E: 1 if not XXX-with-esc
;; II: if iso-2022 based, 0..3, else 1. ;; II: if iso-2022 based, 0..3, else 1.
(logior (logior
(lsh (if (eq base most-preferred) 1 0) 7) (ash (if (eq base most-preferred) 1 0) 7)
(lsh (ash
(let ((mime (coding-system-get base :mime-charset))) (let ((mime (coding-system-get base :mime-charset)))
;; Prefer coding systems corresponding to a ;; Prefer coding systems corresponding to a
;; MIME charset. ;; MIME charset.
@ -468,9 +468,9 @@ non-nil, it is used to sort CODINGS instead."
(t 3)) (t 3))
0)) 0))
5) 5)
(lsh (if (memq base lang-preferred) 1 0) 4) (ash (if (memq base lang-preferred) 1 0) 4)
(lsh (if (memq base from-priority) 1 0) 3) (ash (if (memq base from-priority) 1 0) 3)
(lsh (if (string-match-p "-with-esc\\'" (ash (if (string-match-p "-with-esc\\'"
(symbol-name base)) (symbol-name base))
0 1) 2) 0 1) 2)
(if (eq (coding-system-type base) 'iso-2022) (if (eq (coding-system-type base) 'iso-2022)

2
lisp/international/mule.el
View file

@ -911,7 +911,7 @@ non-ASCII files. This attribute is meaningful only when
(i 0)) (i 0))
(dolist (elt coding-system-iso-2022-flags) (dolist (elt coding-system-iso-2022-flags)
(if (memq elt flags) (if (memq elt flags)
(setq bits (logior bits (lsh 1 i)))) (setq bits (logior bits (ash 1 i))))
(setq i (1+ i))) (setq i (1+ i)))
(setcdr (assq :flags spec-attrs) bits)))) (setcdr (assq :flags spec-attrs) bits))))

2
lisp/json.el
View file

@ -370,7 +370,7 @@ representation will be parsed correctly."
(defun json--decode-utf-16-surrogates (high low) (defun json--decode-utf-16-surrogates (high low)
"Return the code point represented by the UTF-16 surrogates HIGH and 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 () (defun json-read-escaped-char ()
"Read the JSON string escaped character at point." "Read the JSON string escaped character at point."

20
lisp/mail/binhex.el
View file

@ -136,9 +136,9 @@ input and write the converted data to its standard output."
(defun binhex-update-crc (crc char &optional count) (defun binhex-update-crc (crc char &optional count)
(if (null count) (setq count 1)) (if (null count) (setq count 1))
(while (> count 0) (while (> count 0)
(setq crc (logxor (logand (lsh crc 8) 65280) (setq crc (logxor (logand (ash crc 8) 65280)
(aref binhex-crc-table (aref binhex-crc-table
(logxor (logand (lsh crc -8) 255) (logxor (logand (ash crc -8) 255)
char))) char)))
count (1- count))) count (1- count)))
crc) crc)
@ -156,14 +156,14 @@ input and write the converted data to its standard output."
(defun binhex-string-big-endian (string) (defun binhex-string-big-endian (string)
(let ((ret 0) (i 0) (len (length string))) (let ((ret 0) (i 0) (len (length string)))
(while (< i len) (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))) i (1+ i)))
ret)) ret))
(defun binhex-string-little-endian (string) (defun binhex-string-little-endian (string)
(let ((ret 0) (i 0) (shift 0) (len (length string))) (let ((ret 0) (i 0) (shift 0) (len (length string)))
(while (< i len) (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) i (1+ i)
shift (+ shift 8))) shift (+ shift 8)))
ret)) ret))
@ -239,13 +239,13 @@ If HEADER-ONLY is non-nil only decode header and return filename."
counter (1+ counter) counter (1+ counter)
inputpos (1+ inputpos)) inputpos (1+ inputpos))
(cond ((= counter 4) (cond ((= counter 4)
(binhex-push-char (lsh bits -16) nil work-buffer) (binhex-push-char (ash bits -16) nil work-buffer)
(binhex-push-char (logand (lsh bits -8) 255) nil (binhex-push-char (logand (ash bits -8) 255) nil
work-buffer) work-buffer)
(binhex-push-char (logand bits 255) nil (binhex-push-char (logand bits 255) nil
work-buffer) work-buffer)
(setq bits 0 counter 0)) (setq bits 0 counter 0))
(t (setq bits (lsh bits 6))))) (t (setq bits (ash bits 6)))))
(if (null file-name-length) (if (null file-name-length)
(with-current-buffer work-buffer (with-current-buffer work-buffer
(setq file-name-length (char-after (point-min)) (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))))) (setq tmp (and tmp (not (eq inputpos end)))))
(cond (cond
((= counter 3) ((= counter 3)
(binhex-push-char (logand (lsh bits -16) 255) nil (binhex-push-char (logand (ash bits -16) 255) nil
work-buffer) work-buffer)
(binhex-push-char (logand (lsh bits -8) 255) nil (binhex-push-char (logand (ash bits -8) 255) nil
work-buffer)) work-buffer))
((= counter 2) ((= counter 2)
(binhex-push-char (logand (lsh bits -10) 255) nil (binhex-push-char (logand (ash bits -10) 255) nil
work-buffer)))) work-buffer))))
(if header-only nil (if header-only nil
(binhex-verify-crc work-buffer (binhex-verify-crc work-buffer

2
lisp/mail/rmail.el
View file

@ -4515,7 +4515,7 @@ encoded string (and the same mask) will decode the string."
(if (= curmask 0) (if (= curmask 0)
(setq curmask mask)) (setq curmask mask))
(setq charmask (% curmask 256)) (setq charmask (% curmask 256))
(setq curmask (lsh curmask -8)) (setq curmask (ash curmask -8))
(aset string-vector i (logxor charmask (aref string-vector i))) (aset string-vector i (logxor charmask (aref string-vector i)))
(setq i (1+ i))) (setq i (1+ i)))
(concat string-vector))) (concat string-vector)))

12
lisp/mail/uudecode.el
View file

@ -171,12 +171,12 @@ If FILE-NAME is non-nil, save the result to FILE-NAME."
(cond ((= counter 4) (cond ((= counter 4)
(setq result (cons (setq result (cons
(concat (concat
(char-to-string (lsh bits -16)) (char-to-string (ash bits -16))
(char-to-string (logand (lsh bits -8) 255)) (char-to-string (logand (ash bits -8) 255))
(char-to-string (logand bits 255))) (char-to-string (logand bits 255)))
result)) result))
(setq bits 0 counter 0)) (setq bits 0 counter 0))
(t (setq bits (lsh bits 6))))))) (t (setq bits (ash bits 6)))))))
(cond (cond
(done) (done)
((> 0 remain) ((> 0 remain)
@ -188,12 +188,12 @@ If FILE-NAME is non-nil, save the result to FILE-NAME."
((= counter 3) ((= counter 3)
(setq result (cons (setq result (cons
(concat (concat
(char-to-string (logand (lsh bits -16) 255)) (char-to-string (logand (ash bits -16) 255))
(char-to-string (logand (lsh bits -8) 255))) (char-to-string (logand (ash bits -8) 255)))
result))) result)))
((= counter 2) ((= counter 2)
(setq result (cons (setq result (cons
(char-to-string (logand (lsh bits -10) 255)) (char-to-string (logand (ash bits -10) 255))
result)))) result))))
(skip-chars-forward non-data-chars end)) (skip-chars-forward non-data-chars end))
(if file-name (if file-name

28
lisp/md4.el
View file

@ -91,15 +91,15 @@ strings containing the character 0."
(let* (let*
((h1 (+ (car a) (,func (car b) (car c) (car d)) (car xk) (car ac))) ((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))) (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)) (l2 (logand 65535 l1))
;; cyclic shift of 32 bits integer ;; cyclic shift of 32 bits integer
(h3 (logand 65535 (if (> s 15) (h3 (logand 65535 (if (> s 15)
(+ (lsh h2 (- s 32)) (lsh l2 (- s 16))) (+ (ash h2 (- s 32)) (ash l2 (- s 16)))
(+ (lsh h2 s) (lsh l2 (- s 16)))))) (+ (ash h2 s) (ash l2 (- s 16))))))
(l3 (logand 65535 (if (> s 15) (l3 (logand 65535 (if (> s 15)
(+ (lsh l2 (- s 32)) (lsh h2 (- s 16))) (+ (ash l2 (- s 32)) (ash h2 (- s 16)))
(+ (lsh l2 s) (lsh h2 (- s 16))))))) (+ (ash l2 s) (ash h2 (- s 16)))))))
(cons h3 l3)))) (cons h3 l3))))
(md4-make-step md4-round1 md4-F) (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." "Return 32-bit sum of 32-bit integers X and Y."
(let ((h (+ (car x) (car y))) (let ((h (+ (car x) (car y)))
(l (+ (cdr x) (cdr 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) (defsubst md4-and (x y)
(cons (logand (car x) (car y)) (logand (cdr x) (cdr 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) (let ((int32s (make-vector 16 0)) (i 0) j)
(while (< i 16) (while (< i 16)
(setq j (* i 4)) (setq j (* i 4))
(aset int32s i (cons (+ (aref seq (+ j 2)) (lsh (aref seq (+ j 3)) 8)) (aset int32s i (cons (+ (aref seq (+ j 2)) (ash (aref seq (+ j 3)) 8))
(+ (aref seq j) (lsh (aref seq (1+ j)) 8)))) (+ (aref seq j) (ash (aref seq (1+ j)) 8))))
(setq i (1+ i))) (setq i (1+ i)))
int32s)) 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." "Pack 16 bits integer in 2 bytes string as little endian."
(let ((str (make-string 2 0))) (let ((str (make-string 2 0)))
(aset str 0 (logand int16 255)) (aset str 0 (logand int16 255))
(aset str 1 (lsh int16 -8)) (aset str 1 (ash int16 -8))
str)) str))
(defun md4-pack-int32 (int32) (defun md4-pack-int32 (int32)
@ -207,20 +207,20 @@ integers (cons high low)."
(let ((str (make-string 4 0)) (let ((str (make-string 4 0))
(h (car int32)) (l (cdr int32))) (h (car int32)) (l (cdr int32)))
(aset str 0 (logand l 255)) (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 2 (logand h 255))
(aset str 3 (lsh h -8)) (aset str 3 (ash h -8))
str)) str))
(defun md4-unpack-int16 (str) (defun md4-unpack-int16 (str)
(if (eq 2 (length 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))) (error "%s is not 2 bytes long" str)))
(defun md4-unpack-int32 (str) (defun md4-unpack-int32 (str)
(if (eq 4 (length str)) (if (eq 4 (length str))
(cons (+ (lsh (aref str 3) 8) (aref str 2)) (cons (+ (ash (aref str 3) 8) (aref str 2))
(+ (lsh (aref str 1) 8) (aref str 0))) (+ (ash (aref str 1) 8) (aref str 0)))
(error "%s is not 4 bytes long" str))) (error "%s is not 4 bytes long" str)))
(provide 'md4) (provide 'md4)

24
lisp/net/dns.el
View file

@ -117,7 +117,7 @@ updated. Set this variable to t to disable the check.")
length) length)
(while (not ended) (while (not ended)
(setq length (dns-read-bytes 1)) (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) (let ((offset (+ (* (logand 63 length) 256)
(dns-read-bytes 1)))) (dns-read-bytes 1))))
(save-excursion (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 (dns-get 'id spec) 2)
(dns-write-bytes (dns-write-bytes
(logior (logior
(lsh (if (dns-get 'response-p spec) 1 0) -7) (ash (if (dns-get 'response-p spec) 1 0) 7)
(lsh (ash
(cond (cond
((eq (dns-get 'opcode spec) 'query) 0) ((eq (dns-get 'opcode spec) 'query) 0)
((eq (dns-get 'opcode spec) 'inverse-query) 1) ((eq (dns-get 'opcode spec) 'inverse-query) 1)
((eq (dns-get 'opcode spec) 'status) 2) ((eq (dns-get 'opcode spec) 'status) 2)
(t (error "No such opcode: %s" (dns-get 'opcode spec)))) (t (error "No such opcode: %s" (dns-get 'opcode spec))))
-3) 3)
(lsh (if (dns-get 'authoritative-p spec) 1 0) -2) (ash (if (dns-get 'authoritative-p spec) 1 0) 2)
(lsh (if (dns-get 'truncated-p spec) 1 0) -1) (ash (if (dns-get 'truncated-p spec) 1 0) 1)
(lsh (if (dns-get 'recursion-desired-p spec) 1 0) 0))) (ash (if (dns-get 'recursion-desired-p spec) 1 0) 0)))
(dns-write-bytes (dns-write-bytes
(cond (cond
((eq (dns-get 'response-code spec) 'no-error) 0) ((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)) (goto-char (point-min))
(push (list 'id (dns-read-bytes 2)) spec) (push (list 'id (dns-read-bytes 2)) spec)
(let ((byte (dns-read-bytes 1))) (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) spec)
(let ((opcode (logand byte (lsh 7 3)))) (let ((opcode (logand byte (ash 7 3))))
(push (list 'opcode (push (list 'opcode
(cond ((eq opcode 0) 'query) (cond ((eq opcode 0) 'query)
((eq opcode 1) 'inverse-query) ((eq opcode 1) 'inverse-query)
((eq opcode 2) 'status))) ((eq opcode 2) 'status)))
spec)) 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) 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) spec)
(push (list 'recursion-desired-p (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))) (let ((rc (logand (dns-read-bytes 1) 15)))
(push (list 'response-code (push (list 'response-code
(cond (cond

44
lisp/net/ntlm.el
View file

@ -411,9 +411,9 @@ a string KEY of length 8. FORW is t or nil."
(key2 (ntlm-smb-str-to-key key)) (key2 (ntlm-smb-str-to-key key))
(i 0) aa) (i 0) aa)
(while (< i 64) (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)) (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)) (aset keyb i 1))
(setq i (1+ i))) (setq i (1+ i)))
(setq outb (ntlm-smb-dohash inb keyb forw)) (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)) (unless (zerop (aref outb i))
(setq aa (aref out (/ i 8))) (setq aa (aref out (/ i 8)))
(aset 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))) (setq i (1+ i)))
out)) 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." "Return a string of length 8 for the given string STR of length 7."
(let ((key (make-string 8 0)) (let ((key (make-string 8 0))
(i 7)) (i 7))
(aset key 0 (lsh (aref str 0) -1)) (aset key 0 (ash (aref str 0) -1))
(aset key 1 (logior (aset key 1 (logior
(lsh (logand (aref str 0) 1) 6) (ash (logand (aref str 0) 1) 6)
(lsh (aref str 1) -2))) (ash (aref str 1) -2)))
(aset key 2 (logior (aset key 2 (logior
(lsh (logand (aref str 1) 3) 5) (ash (logand (aref str 1) 3) 5)
(lsh (aref str 2) -3))) (ash (aref str 2) -3)))
(aset key 3 (logior (aset key 3 (logior
(lsh (logand (aref str 2) 7) 4) (ash (logand (aref str 2) 7) 4)
(lsh (aref str 3) -4))) (ash (aref str 3) -4)))
(aset key 4 (logior (aset key 4 (logior
(lsh (logand (aref str 3) 15) 3) (ash (logand (aref str 3) 15) 3)
(lsh (aref str 4) -5))) (ash (aref str 4) -5)))
(aset key 5 (logior (aset key 5 (logior
(lsh (logand (aref str 4) 31) 2) (ash (logand (aref str 4) 31) 2)
(lsh (aref str 5) -6))) (ash (aref str 5) -6)))
(aset key 6 (logior (aset key 6 (logior
(lsh (logand (aref str 5) 63) 1) (ash (logand (aref str 5) 63) 1)
(lsh (aref str 6) -7))) (ash (aref str 6) -7)))
(aset key 7 (logand (aref str 6) 127)) (aset key 7 (logand (aref str 6) 127))
(while (>= i 0) (while (>= i 0)
(aset key i (lsh (aref key i) 1)) (aset key i (ash (aref key i) 1))
(setq i (1- i))) (setq i (1- i)))
key)) key))
@ -619,16 +619,16 @@ backward."
(setq j 0) (setq j 0)
(while (< j 8) (while (< j 8)
(setq bj (aref b j)) (setq bj (aref b j))
(setq m (logior (lsh (aref bj 0) 1) (aref bj 5))) (setq m (logior (ash (aref bj 0) 1) (aref bj 5)))
(setq n (logior (lsh (aref bj 1) 3) (setq n (logior (ash (aref bj 1) 3)
(lsh (aref bj 2) 2) (ash (aref bj 2) 2)
(lsh (aref bj 3) 1) (ash (aref bj 3) 1)
(aref bj 4))) (aref bj 4)))
(setq k 0) (setq k 0)
(setq sbox-jmn (aref (aref (aref ntlm-smb-sbox j) m) n)) (setq sbox-jmn (aref (aref (aref ntlm-smb-sbox j) m) n))
(while (< k 4) (while (< k 4)
(aset bj k (aset bj k
(if (zerop (logand sbox-jmn (lsh 1 (- 3 k)))) (if (zerop (logand sbox-jmn (ash 1 (- 3 k))))
0 1)) 0 1))
(setq k (1+ k))) (setq k (1+ k)))
(setq j (1+ j))) (setq j (1+ j)))

6
lisp/net/sasl.el
View file

@ -183,7 +183,7 @@ It contain at least 64 bits of entropy."
;; Don't use microseconds from (current-time), they may be unsupported. ;; Don't use microseconds from (current-time), they may be unsupported.
;; Instead we use this randomly inited counter. ;; Instead we use this randomly inited counter.
(setq sasl-unique-id-char (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, ;; (current-time) returns 16-bit ints,
;; and 2^16*25 just fits into 4 digits i base 36. ;; and 2^16*25 just fits into 4 digits i base 36.
(* 25 25))) (* 25 25)))
@ -191,10 +191,10 @@ It contain at least 64 bits of entropy."
(concat (concat
(sasl-unique-id-number-base36 (sasl-unique-id-number-base36
(+ (car tm) (+ (car tm)
(lsh (% sasl-unique-id-char 25) 16)) 4) (ash (% sasl-unique-id-char 25) 16)) 4)
(sasl-unique-id-number-base36 (sasl-unique-id-number-base36
(+ (nth 1 tm) (+ (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) (defun sasl-unique-id-number-base36 (num len)
(if (if (< len 0) (if (if (< len 0)

4
lisp/net/socks.el
View file

@ -420,7 +420,7 @@
(unibyte-string (unibyte-string
version ; version version ; version
command ; command command ; command
(lsh port -8) ; port, high byte (ash port -8) ; port, high byte
(logand port #xff)) ; port, low byte (logand port #xff)) ; port, low byte
addr ; address addr ; address
(user-full-name) ; username (user-full-name) ; username
@ -434,7 +434,7 @@
atype) ; address type atype) ; address type
addr ; address addr ; address
(unibyte-string (unibyte-string
(lsh port -8) ; port, high byte (ash port -8) ; port, high byte
(logand port #xff))))) ; port, low byte (logand port #xff))))) ; port, low byte
(t (t
(error "Unknown protocol version: %d" version))) (error "Unknown protocol version: %d" version)))

14
lisp/net/tramp.el
View file

@ -4108,13 +4108,13 @@ This is used to map a mode number to a permission string.")
(defun tramp-file-mode-from-int (mode) (defun tramp-file-mode-from-int (mode)
"Turn an integer representing a file mode into an ls(1)-like string." "Turn an integer representing a file mode into an ls(1)-like string."
(let ((type (cdr (let ((type (cdr
(assoc (logand (lsh mode -12) 15) tramp-file-mode-type-map))) (assoc (logand (ash mode -12) 15) tramp-file-mode-type-map)))
(user (logand (lsh mode -6) 7)) (user (logand (ash mode -6) 7))
(group (logand (lsh mode -3) 7)) (group (logand (ash mode -3) 7))
(other (logand (lsh mode -0) 7)) (other (logand (ash mode -0) 7))
(suid (> (logand (lsh mode -9) 4) 0)) (suid (> (logand (ash mode -9) 4) 0))
(sgid (> (logand (lsh mode -9) 2) 0)) (sgid (> (logand (ash mode -9) 2) 0))
(sticky (> (logand (lsh mode -9) 1) 0))) (sticky (> (logand (ash mode -9) 1) 0)))
(setq user (tramp-file-mode-permissions user suid "s")) (setq user (tramp-file-mode-permissions user suid "s"))
(setq group (tramp-file-mode-permissions group sgid "s")) (setq group (tramp-file-mode-permissions group sgid "s"))
(setq other (tramp-file-mode-permissions other sticky "t")) (setq other (tramp-file-mode-permissions other sticky "t"))

2
lisp/obsolete/levents.el
View file

@ -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." The value is an ASCII printing character (not upper case) or a symbol."
(if (symbolp event) (if (symbolp event)
(car (get event 'event-symbol-elements)) (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))))) (downcase (if (< base 32) (logior base 64) base)))))
(defun event-object (event) (defun event-object (event)

26
lisp/obsolete/pgg-parse.el
View file

@ -116,9 +116,9 @@
) )
(defmacro pgg-parse-time-field (bytes) (defmacro pgg-parse-time-field (bytes)
`(list (logior (lsh (car ,bytes) 8) `(list (logior (ash (car ,bytes) 8)
(nth 1 ,bytes)) (nth 1 ,bytes))
(logior (lsh (nth 2 ,bytes) 8) (logior (ash (nth 2 ,bytes) 8)
(nth 3 ,bytes)) (nth 3 ,bytes))
0)) 0))
@ -184,21 +184,21 @@
(ccl-execute-on-string pgg-parse-crc24 h string) (ccl-execute-on-string pgg-parse-crc24 h string)
(format "%c%c%c" (format "%c%c%c"
(logand (aref h 1) 255) (logand (aref h 1) 255)
(logand (lsh (aref h 2) -8) 255) (logand (ash (aref h 2) -8) 255)
(logand (aref h 2) 255))))) (logand (aref h 2) 255)))))
(defmacro pgg-parse-length-type (c) (defmacro pgg-parse-length-type (c)
`(cond `(cond
((< ,c 192) (cons ,c 1)) ((< ,c 192) (cons ,c 1))
((< ,c 224) ((< ,c 224)
(cons (+ (lsh (- ,c 192) 8) (cons (+ (ash (- ,c 192) 8)
(pgg-byte-after (+ 2 (point))) (pgg-byte-after (+ 2 (point)))
192) 192)
2)) 2))
((= ,c 255) ((= ,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)))) (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))))) (pgg-byte-after (+ 5 (point)))))
5)) 5))
(t;partial body length (t;partial body length
@ -210,13 +210,13 @@
(if (zerop (logand 64 ptag));Old format (if (zerop (logand 64 ptag));Old format
(progn (progn
(setq length-type (logand ptag 3) (setq length-type (logand ptag 3)
length-type (if (= 3 length-type) 0 (lsh 1 length-type)) length-type (if (= 3 length-type) 0 (ash 1 length-type))
content-tag (logand 15 (lsh ptag -2)) content-tag (logand 15 (ash ptag -2))
packet-bytes 0 packet-bytes 0
header-bytes (1+ length-type)) header-bytes (1+ length-type))
(dotimes (i length-type) (dotimes (i length-type)
(setq packet-bytes (setq packet-bytes
(logior (lsh packet-bytes 8) (logior (ash packet-bytes 8)
(pgg-byte-after (+ 1 i (point))))))) (pgg-byte-after (+ 1 i (point)))))))
(setq content-tag (logand 63 ptag) (setq content-tag (logand 63 ptag)
length-type (pgg-parse-length-type length-type (pgg-parse-length-type
@ -317,10 +317,10 @@
(let ((name-bytes (pgg-read-bytes 2)) (let ((name-bytes (pgg-read-bytes 2))
(value-bytes (pgg-read-bytes 2))) (value-bytes (pgg-read-bytes 2)))
(cons (pgg-read-bytes-string (cons (pgg-read-bytes-string
(logior (lsh (car name-bytes) 8) (logior (ash (car name-bytes) 8)
(nth 1 name-bytes))) (nth 1 name-bytes)))
(pgg-read-bytes-string (pgg-read-bytes-string
(logior (lsh (car value-bytes) 8) (logior (ash (car value-bytes) 8)
(nth 1 value-bytes))))))) (nth 1 value-bytes)))))))
(21 ;preferred hash algorithms (21 ;preferred hash algorithms
(cons 'preferred-hash-algorithm (cons 'preferred-hash-algorithm
@ -380,7 +380,7 @@
(pgg-set-alist result (pgg-set-alist result
'hash-algorithm (pgg-read-byte)) 'hash-algorithm (pgg-read-byte))
(when (>= 10000 (setq n (pgg-read-bytes 2) (when (>= 10000 (setq n (pgg-read-bytes 2)
n (logior (lsh (car n) 8) n (logior (ash (car n) 8)
(nth 1 n)))) (nth 1 n))))
(save-restriction (save-restriction
(narrow-to-region (point)(+ n (point))) (narrow-to-region (point)(+ n (point)))
@ -391,7 +391,7 @@
#'pgg-parse-signature-subpacket))) #'pgg-parse-signature-subpacket)))
(goto-char (point-max)))) (goto-char (point-max))))
(when (>= 10000 (setq n (pgg-read-bytes 2) (when (>= 10000 (setq n (pgg-read-bytes 2)
n (logior (lsh (car n) 8) n (logior (ash (car n) 8)
(nth 1 n)))) (nth 1 n))))
(save-restriction (save-restriction
(narrow-to-region (point)(+ n (point))) (narrow-to-region (point)(+ n (point)))

2
lisp/org/org.el
View file

@ -10058,7 +10058,7 @@ Note: this function also decodes single byte encodings like
(cons 6 128)))) (cons 6 128))))
(when (>= val 192) (setq eat (car shift-xor))) (when (>= val 192) (setq eat (car shift-xor)))
(setq val (logxor val (cdr 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))) (when (> eat 0) (setq eat (- eat 1)))
(cond (cond
((= 0 eat) ;multi byte ((= 0 eat) ;multi byte

6
lisp/org/ox-publish.el
View file

@ -794,8 +794,8 @@ Default for SITEMAP-FILENAME is `sitemap.org'."
((or `anti-chronologically `chronologically) ((or `anti-chronologically `chronologically)
(let* ((adate (org-publish-find-date a project)) (let* ((adate (org-publish-find-date a project))
(bdate (org-publish-find-date b project)) (bdate (org-publish-find-date b project))
(A (+ (lsh (car adate) 16) (cadr adate))) (A (+ (ash (car adate) 16) (cadr adate)))
(B (+ (lsh (car bdate) 16) (cadr bdate)))) (B (+ (ash (car bdate) 16) (cadr bdate))))
(setq retval (setq retval
(if (eq sort-files 'chronologically) (if (eq sort-files 'chronologically)
(<= A B) (<= A B)
@ -1348,7 +1348,7 @@ does not exist."
(expand-file-name (or (file-symlink-p file) file) (expand-file-name (or (file-symlink-p file) file)
(file-name-directory file))))) (file-name-directory file)))))
(if (not attr) (error "No such file: \"%s\"" 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)))))) (cadr (nth 5 attr))))))

2
lisp/progmodes/cc-defs.el
View file

@ -1858,7 +1858,7 @@ non-nil, a caret is prepended to invert the set."
(setq entry (get-char-table ?a table))) (setq entry (get-char-table ?a table)))
;; incompatible ;; incompatible
(t (error "CC Mode is incompatible with this version of Emacs"))) (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 '8-bit
'1-bit) '1-bit)
list))) list)))

2
lisp/progmodes/ebnf2ps.el
View file

@ -5130,7 +5130,7 @@ killed after process termination."
(defsubst ebnf-font-background (font) (nth 3 font)) (defsubst ebnf-font-background (font) (nth 3 font))
(defsubst ebnf-font-list (font) (nthcdr 4 font)) (defsubst ebnf-font-list (font) (nthcdr 4 font))
(defsubst ebnf-font-attributes (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 (defconst ebnf-font-name-select

8
lisp/progmodes/hideif.el
View file

@ -1039,16 +1039,12 @@ preprocessing token"
(defun hif-shiftleft (a b) (defun hif-shiftleft (a b)
(setq a (hif-mathify a)) (setq a (hif-mathify a))
(setq b (hif-mathify b)) (setq b (hif-mathify b))
(if (< a 0) (ash a b))
(ash a b)
(lsh a b)))
(defun hif-shiftright (a b) (defun hif-shiftright (a b)
(setq a (hif-mathify a)) (setq a (hif-mathify a))
(setq b (hif-mathify b)) (setq b (hif-mathify b))
(if (< a 0) (ash a (- b)))
(ash a (- b))
(lsh a (- b))))
(defalias 'hif-multiply (hif-mathify-binop *)) (defalias 'hif-multiply (hif-mathify-binop *))

4
lisp/ps-bdf.el
View file

@ -145,7 +145,7 @@ See the documentation of the function `bdf-read-font-info' for more detail."
(if (or (< code (aref code-range 4)) (if (or (< code (aref code-range 4))
(> code (aref code-range 5))) (> code (aref code-range 5)))
(setq code (aref code-range 6))) (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)))) (1+ (- (aref code-range 3) (aref code-range 2))))
(- (logand code 255) (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))) (setq code (read (current-buffer)))
(if (< code 0) (if (< code 0)
(search-forward "ENDCHAR") (search-forward "ENDCHAR")
(setq code0 (lsh code -8) (setq code0 (ash code -8)
code1 (logand code 255) code1 (logand code 255)
min-code (min min-code code) min-code (min min-code code)
max-code (max max-code code) max-code (max max-code code)

2
lisp/ps-print.el
View file

@ -6299,7 +6299,7 @@ If FACE is not a valid face name, use default face."
(ps-font-number 'ps-font-for-text (ps-font-number 'ps-font-for-text
(or (aref ps-font-type (logand effect 3)) (or (aref ps-font-type (logand effect 3))
face)) face))
fg-color bg-color (lsh effect -2))))) fg-color bg-color (ash effect -2)))))
(goto-char to)) (goto-char to))

6
lisp/simple.el
View file

@ -8348,16 +8348,16 @@ PREFIX is the string that represents this modifier in an event type symbol."
(cond ((eq symbol 'control) (cond ((eq symbol 'control)
(if (<= 64 (upcase event) 95) (if (<= 64 (upcase event) 95)
(- (upcase event) 64) (- (upcase event) 64)
(logior (lsh 1 lshiftby) event))) (logior (ash 1 lshiftby) event)))
((eq symbol 'shift) ((eq symbol 'shift)
;; FIXME: Should we also apply this "upcase" behavior of shift ;; FIXME: Should we also apply this "upcase" behavior of shift
;; to non-ascii letters? ;; to non-ascii letters?
(if (and (<= (downcase event) ?z) (if (and (<= (downcase event) ?z)
(>= (downcase event) ?a)) (>= (downcase event) ?a))
(upcase event) (upcase event)
(logior (lsh 1 lshiftby) event))) (logior (ash 1 lshiftby) event)))
(t (t
(logior (lsh 1 lshiftby) event))) (logior (ash 1 lshiftby) event)))
(if (memq symbol (event-modifiers event)) (if (memq symbol (event-modifiers event))
event event
(let ((event-type (if (symbolp event) event (car event)))) (let ((event-type (if (symbolp event) event (car event))))

4
lisp/tar-mode.el
View file

@ -1279,8 +1279,8 @@ for this to be permanent."
;; Format a timestamp as 11 octal digits. Ghod, I hope this works... ;; Format a timestamp as 11 octal digits. Ghod, I hope this works...
(let ((hibits (car timeval)) (lobits (car (cdr timeval)))) (let ((hibits (car timeval)) (lobits (car (cdr timeval))))
(format "%05o%01o%05o" (format "%05o%01o%05o"
(lsh hibits -2) (ash hibits -2)
(logior (lsh (logand 3 hibits) 1) (logior (ash (logand 3 hibits) 1)
(if (> (logand lobits 32768) 0) 1 0)) (if (> (logand lobits 32768) 0) 1 0))
(logand 32767 lobits) (logand 32767 lobits)
))) )))

28
lisp/term/common-win.el
View file

@ -59,20 +59,20 @@
(setq system-key-alist (setq system-key-alist
(list (list
;; These are special "keys" used to pass events from C to lisp. ;; These are special "keys" used to pass events from C to lisp.
(cons (logior (lsh 0 16) 1) 'ns-power-off) (cons 1 'ns-power-off)
(cons (logior (lsh 0 16) 2) 'ns-open-file) (cons 2 'ns-open-file)
(cons (logior (lsh 0 16) 3) 'ns-open-temp-file) (cons 3 'ns-open-temp-file)
(cons (logior (lsh 0 16) 4) 'ns-drag-file) (cons 4 'ns-drag-file)
(cons (logior (lsh 0 16) 5) 'ns-drag-color) (cons 5 'ns-drag-color)
(cons (logior (lsh 0 16) 6) 'ns-drag-text) (cons 6 'ns-drag-text)
(cons (logior (lsh 0 16) 7) 'ns-change-font) (cons 7 'ns-change-font)
(cons (logior (lsh 0 16) 8) 'ns-open-file-line) (cons 8 'ns-open-file-line)
;;; (cons (logior (lsh 0 16) 9) 'ns-insert-working-text) ;;; (cons 9 'ns-insert-working-text)
;;; (cons (logior (lsh 0 16) 10) 'ns-delete-working-text) ;;; (cons 10 'ns-delete-working-text)
(cons (logior (lsh 0 16) 11) 'ns-spi-service-call) (cons 11 'ns-spi-service-call)
(cons (logior (lsh 0 16) 12) 'ns-new-frame) (cons 12 'ns-new-frame)
(cons (logior (lsh 0 16) 13) 'ns-toggle-toolbar) (cons 13 'ns-toggle-toolbar)
(cons (logior (lsh 0 16) 14) 'ns-show-prefs) (cons 14 'ns-show-prefs)
)))) ))))
(set-terminal-parameter frame 'x-setup-function-keys t))) (set-terminal-parameter frame 'x-setup-function-keys t)))

20
lisp/term/tty-colors.el
View file

@ -830,10 +830,10 @@ DISPLAY can be a display name or a frame, and defaults to the
selected frame's display. selected frame's display.
If DISPLAY is not on a 24-but TTY terminal, return nil." If DISPLAY is not on a 24-but TTY terminal, return nil."
(when (and rgb (= (display-color-cells display) 16777216)) (when (and rgb (= (display-color-cells display) 16777216))
(let ((r (lsh (car rgb) -8)) (let ((r (ash (car rgb) -8))
(g (lsh (cadr rgb) -8)) (g (ash (cadr rgb) -8))
(b (lsh (nth 2 rgb) -8))) (b (ash (nth 2 rgb) -8)))
(logior (lsh r 16) (lsh g 8) b)))) (logior (ash r 16) (ash g 8) b))))
(defun tty-color-define (name index &optional rgb frame) (defun tty-color-define (name index &optional rgb frame)
"Specify a tty color by its NAME, terminal INDEX and RGB values. "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. ;; never consider it for approximating another color.
(if try-rgb (if try-rgb
(progn (progn
(setq try-r (lsh (car try-rgb) -8) (setq try-r (ash (car try-rgb) -8)
try-g (lsh (cadr try-rgb) -8) try-g (ash (cadr try-rgb) -8)
try-b (lsh (nth 2 try-rgb) -8)) try-b (ash (nth 2 try-rgb) -8))
(setq dif-r (- r try-r) (setq dif-r (- r try-r)
dif-g (- g try-g) dif-g (- g try-g)
dif-b (- b try-b)) dif-b (- b try-b))
@ -938,13 +938,13 @@ should be the same regardless of what display is being used."
(i2 (+ i1 ndig)) (i2 (+ i1 ndig))
(i3 (+ i2 ndig))) (i3 (+ i2 ndig)))
(list (list
(lsh (ash
(string-to-number (substring color i1 i2) 16) (string-to-number (substring color i1 i2) 16)
(* 4 (- 4 ndig))) (* 4 (- 4 ndig)))
(lsh (ash
(string-to-number (substring color i2 i3) 16) (string-to-number (substring color i2 i3) 16)
(* 4 (- 4 ndig))) (* 4 (- 4 ndig)))
(lsh (ash
(string-to-number (substring color i3) 16) (string-to-number (substring color i3) 16)
(* 4 (- 4 ndig)))))) (* 4 (- 4 ndig))))))
((and (>= len 9) ;; X-style RGB:xx/yy/zz color spec ((and (>= len 9) ;; X-style RGB:xx/yy/zz color spec

2
lisp/term/xterm.el
View file

@ -1009,7 +1009,7 @@ hitting screen's max DCS length."
(defun xterm-rgb-convert-to-16bit (prim) (defun xterm-rgb-convert-to-16bit (prim)
"Convert an 8-bit primary color value PRIM to a corresponding 16-bit value." "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) (defun xterm-register-default-colors (colors)
"Register the default set of colors for xterm or compatible emulator. "Register the default set of colors for xterm or compatible emulator.

4
lisp/vc/vc-git.el
View file

@ -367,8 +367,8 @@ in the order given by 'git status'."
(defun vc-git-file-type-as-string (old-perm new-perm) (defun vc-git-file-type-as-string (old-perm new-perm)
"Return a string describing the file type based on its permissions." "Return a string describing the file type based on its permissions."
(let* ((old-type (lsh (or old-perm 0) -9)) (let* ((old-type (ash (or old-perm 0) -9))
(new-type (lsh (or new-perm 0) -9)) (new-type (ash (or new-perm 0) -9))
(str (pcase new-type (str (pcase new-type
(?\100 ;; File. (?\100 ;; File.
(pcase old-type (pcase old-type

2
lisp/vc/vc-hg.el
View file

@ -1017,7 +1017,7 @@ hg binary."
;; Dirstate too small to be valid ;; Dirstate too small to be valid
(< (nth 7 dirstate-attr) 40) (< (nth 7 dirstate-attr) 40)
;; We want to store 32-bit unsigned values in fixnums. ;; We want to store 32-bit unsigned values in fixnums.
(zerop (lsh -1 32)) (zerop (ash most-positive-fixnum -32))
(progn (progn
(setf repo-relative-filename (setf repo-relative-filename
(file-relative-name truename repo)) (file-relative-name truename repo))

12
lisp/x-dnd.el
View file

@ -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) (defun x-dnd-motif-value-to-list (value size byteorder)
(let ((bytes (cond ((eq size 2) (let ((bytes (cond ((eq size 2)
(list (logand (lsh value -8) ?\xff) (list (logand (ash value -8) ?\xff)
(logand value ?\xff))) (logand value ?\xff)))
((eq size 4) ((eq size 4)
(if (consp value) (if (consp value)
(list (logand (lsh (car value) -8) ?\xff) (list (logand (ash (car value) -8) ?\xff)
(logand (car value) ?\xff) (logand (car value) ?\xff)
(logand (lsh (cdr value) -8) ?\xff) (logand (ash (cdr value) -8) ?\xff)
(logand (cdr value) ?\xff)) (logand (cdr value) ?\xff))
(list (logand (lsh value -24) ?\xff) (list (logand (ash value -24) ?\xff)
(logand (lsh value -16) ?\xff) (logand (ash value -16) ?\xff)
(logand (lsh value -8) ?\xff) (logand (ash value -8) ?\xff)
(logand value ?\xff))))))) (logand value ?\xff)))))))
(if (eq byteorder ?l) (if (eq byteorder ?l)
(reverse bytes) (reverse bytes)

12
test/src/data-tests.el
View file

@ -123,7 +123,7 @@ most-positive-fixnum, which is just less than a power of 2.")
(setq byte (lognot byte))) (setq byte (lognot byte)))
(if (zerop byte) (if (zerop byte)
0 0
(+ (logand byte 1) (data-tests-popcnt (lsh byte -1))))) (+ (logand byte 1) (data-tests-popcnt (ash byte -1)))))
(ert-deftest data-tests-logcount () (ert-deftest data-tests-logcount ()
(should (cl-loop for n in (number-sequence -255 255) (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) (dotimes (_ 4)
(aset bv i (> (logand 1 n) 0)) (aset bv i (> (logand 1 n) 0))
(cl-incf i) (cl-incf i)
(setf n (lsh n -1))))) (setf n (ash n -1)))))
bv)) bv))
(defun test-bool-vector-to-hex-string (bv) (defun test-bool-vector-to-hex-string (bv)
(let (nibbles (v (cl-coerce bv 'list))) (let (nibbles (v (cl-coerce bv 'list)))
(while v (while v
(push (logior (push (logior
(lsh (if (nth 0 v) 1 0) 0) (ash (if (nth 0 v) 1 0) 0)
(lsh (if (nth 1 v) 1 0) 1) (ash (if (nth 1 v) 1 0) 1)
(lsh (if (nth 2 v) 1 0) 2) (ash (if (nth 2 v) 1 0) 2)
(lsh (if (nth 3 v) 1 0) 3)) (ash (if (nth 3 v) 1 0) 3))
nibbles) nibbles)
(setf v (nthcdr 4 v))) (setf v (nthcdr 4 v)))
(mapconcat (lambda (n) (format "%X" n)) (mapconcat (lambda (n) (format "%X" n))