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.
This commit is contained in:
Paul Eggert
parent
81e7eef822
commit
f18af6cd5c
59 changed files with 235 additions and 239 deletions
|
|
@ -401,7 +401,7 @@ Property value is a symbol `o' (Open), `c' (Close), or `n' (None)."
|
|||
(if (consp range)
|
||||
(if val
|
||||
(set-char-table-range table range val))
|
||||
(let* ((start (lsh (lsh range -7) 7))
|
||||
(let* ((start (ash (ash range -7) 7))
|
||||
(limit (+ start 127))
|
||||
first-index last-index)
|
||||
(fillarray vec 0)
|
||||
|
|
@ -548,7 +548,7 @@ Property value is a symbol `o' (Open), `c' (Close), or `n' (None)."
|
|||
(if (< from (logand to #x1FFF80))
|
||||
(setq from (logand to #x1FFF80)))
|
||||
(setq prev-range-data (cons (cons from to) val-code)))))
|
||||
(let* ((start (lsh (lsh range -7) 7))
|
||||
(let* ((start (ash (ash range -7) 7))
|
||||
(limit (+ start 127))
|
||||
str count new-val from to vcode)
|
||||
(fillarray vec (car default-value))
|
||||
|
|
@ -761,7 +761,7 @@ Property value is a symbol `o' (Open), `c' (Close), or `n' (None)."
|
|||
((stringp val)
|
||||
(if (> (aref val 0) 0)
|
||||
val
|
||||
(let* ((first-char (lsh (lsh char -7) 7))
|
||||
(let* ((first-char (ash (ash char -7) 7))
|
||||
(word-table (aref (char-table-extra-slot table 4) 0))
|
||||
(i 1)
|
||||
(len (length val))
|
||||
|
|
@ -865,7 +865,7 @@ Property value is a symbol `o' (Open), `c' (Close), or `n' (None)."
|
|||
((stringp val)
|
||||
(if (> (aref val 0) 0)
|
||||
val
|
||||
(let* ((first-char (lsh (lsh char -7) 7))
|
||||
(let* ((first-char (ash (ash char -7) 7))
|
||||
(word-table (char-table-extra-slot table 4))
|
||||
(i 1)
|
||||
(len (length val))
|
||||
|
|
@ -982,7 +982,7 @@ Property value is a symbol `o' (Open), `c' (Close), or `n' (None)."
|
|||
(if slot
|
||||
(nconc slot (list range))
|
||||
(push (list val range) block-list))))
|
||||
(let* ((start (lsh (lsh range -7) 7))
|
||||
(let* ((start (ash (ash range -7) 7))
|
||||
(limit (+ start 127))
|
||||
(first tail)
|
||||
(vec (make-vector 128 nil))
|
||||
|
|
|
|||
|
|
@ -107,7 +107,7 @@ The most significant byte comes first."
|
|||
(let (result)
|
||||
(dotimes (i size)
|
||||
(push (logand value #xff) result)
|
||||
(setq value (lsh value -8)))
|
||||
(setq value (ash value -8)))
|
||||
result))
|
||||
|
||||
(defun uvs-insert-fields-as-bytes (fields &rest values)
|
||||
|
|
|
|||
|
|
@ -1660,7 +1660,7 @@ to turn the character that follows into a Hyper character:
|
|||
(defun hyperify (prompt)
|
||||
(let ((e (read-event)))
|
||||
(vector (if (numberp e)
|
||||
(logior (lsh 1 24) e)
|
||||
(logior (ash 1 24) e)
|
||||
(if (memq 'hyper (event-modifiers e))
|
||||
e
|
||||
(add-event-modifier "H-" e))))))
|
||||
|
|
|
|||
|
|
@ -1014,13 +1014,13 @@ corresponds to each syntax flag.
|
|||
@item
|
||||
@i{Prefix} @tab @i{Flag} @tab @i{Prefix} @tab @i{Flag}
|
||||
@item
|
||||
@samp{1} @tab @code{(lsh 1 16)} @tab @samp{p} @tab @code{(lsh 1 20)}
|
||||
@samp{1} @tab @code{(ash 1 16)} @tab @samp{p} @tab @code{(ash 1 20)}
|
||||
@item
|
||||
@samp{2} @tab @code{(lsh 1 17)} @tab @samp{b} @tab @code{(lsh 1 21)}
|
||||
@samp{2} @tab @code{(ash 1 17)} @tab @samp{b} @tab @code{(ash 1 21)}
|
||||
@item
|
||||
@samp{3} @tab @code{(lsh 1 18)} @tab @samp{n} @tab @code{(lsh 1 22)}
|
||||
@samp{3} @tab @code{(ash 1 18)} @tab @samp{n} @tab @code{(ash 1 22)}
|
||||
@item
|
||||
@samp{4} @tab @code{(lsh 1 19)} @tab @samp{c} @tab @code{(lsh 1 23)}
|
||||
@samp{4} @tab @code{(ash 1 19)} @tab @samp{c} @tab @code{(ash 1 23)}
|
||||
@end multitable
|
||||
|
||||
@defun string-to-syntax desc
|
||||
|
|
|
|||
|
|
@ -32717,7 +32717,7 @@ create an intermediate set.
|
|||
(while (> n 0)
|
||||
(if (oddp n)
|
||||
(setq count (1+ count)))
|
||||
(setq n (lsh n -1)))
|
||||
(setq n (ash n -1)))
|
||||
count))
|
||||
@end smallexample
|
||||
|
||||
|
|
@ -32761,7 +32761,7 @@ routines are especially fast when dividing by an integer less than
|
|||
(let ((count 0))
|
||||
(while (> n 0)
|
||||
(setq count (+ count (logand n 1))
|
||||
n (lsh n -1)))
|
||||
n (ash n -1)))
|
||||
count))
|
||||
@end smallexample
|
||||
|
||||
|
|
@ -32774,7 +32774,7 @@ uses.
|
|||
|
||||
The @code{idivmod} function does an integer division, returning both
|
||||
the quotient and the remainder at once. Again, note that while it
|
||||
might seem that @samp{(logand n 511)} and @samp{(lsh n -9)} are
|
||||
might seem that @samp{(logand n 511)} and @samp{(ash n -9)} are
|
||||
more efficient ways to split off the bottom nine bits of @code{n},
|
||||
actually they are less efficient because each operation is really
|
||||
a division by 512 in disguise; @code{idivmod} allows us to do the
|
||||
|
|
|
|||
|
|
@ -784,7 +784,7 @@ default. Some examples:
|
|||
(cl-deftype null () '(satisfies null)) ; predefined
|
||||
(cl-deftype list () '(or null cons)) ; predefined
|
||||
(cl-deftype unsigned-byte (&optional bits)
|
||||
(list 'integer 0 (if (eq bits '*) bits (1- (lsh 1 bits)))))
|
||||
(list 'integer 0 (if (eq bits '*) bits (1- (ash 1 bits)))))
|
||||
(unsigned-byte 8) @equiv{} (integer 0 255)
|
||||
(unsigned-byte) @equiv{} (integer 0 *)
|
||||
unsigned-byte @equiv{} (integer 0 *)
|
||||
|
|
|
|||
|
|
@ -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))))))
|
||||
|
|
|
|||
|
|
@ -583,7 +583,7 @@ the mode is invalid. If ERROR is nil then nil will be returned."
|
|||
(len (length newmode))
|
||||
(i 1))
|
||||
(while (< i len)
|
||||
(setq result (+ (lsh result 3) (aref newmode i) (- ?0))
|
||||
(setq result (+ (ash result 3) (aref newmode i) (- ?0))
|
||||
i (1+ i)))
|
||||
(logior (logand oldmode 65024) result)))
|
||||
((string-match "^\\([agou]+\\)\\([---+=]\\)\\([rwxst]+\\)$" newmode)
|
||||
|
|
@ -1759,7 +1759,7 @@ This doesn't recover lost files, it just undoes changes in the buffer itself."
|
|||
(setq newval (funcall newval (archive-l-e (+ p2 ofs) 2))))
|
||||
(goto-char (+ p2 ofs))
|
||||
(delete-char 2)
|
||||
(insert-unibyte (logand newval 255) (lsh newval -8))
|
||||
(insert-unibyte (logand newval 255) (ash newval -8))
|
||||
(goto-char (1+ p))
|
||||
(delete-char 1)
|
||||
(insert-unibyte (archive-lzh-resum (1+ p) hsize)))
|
||||
|
|
@ -1949,11 +1949,11 @@ This doesn't recover lost files, it just undoes changes in the buffer itself."
|
|||
(cond ((memq creator '(2 3)) ; Unix
|
||||
(goto-char (+ p 40))
|
||||
(delete-char 2)
|
||||
(insert-unibyte (logand newval 255) (lsh newval -8)))
|
||||
(insert-unibyte (logand newval 255) (ash newval -8)))
|
||||
((memq creator '(0 5 6 7 10 11 15)) ; Dos etc.
|
||||
(goto-char (+ p 38))
|
||||
(insert-unibyte (logior (logand (byte-after (point)) 254)
|
||||
(logand (logxor 1 (lsh newval -7)) 1)))
|
||||
(logand (logxor 1 (ash newval -7)) 1)))
|
||||
(delete-char 1))
|
||||
(t (message "Don't know how to change mode for this member"))))
|
||||
))))
|
||||
|
|
|
|||
|
|
@ -420,7 +420,7 @@ the size of a Calc bignum digit.")
|
|||
(let ((q (math-div-bignum-digit a math-bignum-digit-power-of-two)))
|
||||
(if (<= w math-bignum-logb-digit-size)
|
||||
(list (logand (lognot (cdr q))
|
||||
(1- (lsh 1 w))))
|
||||
(1- (ash 1 w))))
|
||||
(math-mul-bignum-digit (math-not-bignum (math-norm-bignum (car q))
|
||||
(- w math-bignum-logb-digit-size))
|
||||
math-bignum-digit-power-of-two
|
||||
|
|
@ -529,7 +529,7 @@ the size of a Calc bignum digit.")
|
|||
((and (integerp a) (< a math-small-integer-size))
|
||||
(if (> w (logb math-small-integer-size))
|
||||
a
|
||||
(logand a (1- (lsh 1 w)))))
|
||||
(logand a (1- (ash 1 w)))))
|
||||
(t
|
||||
(math-normalize
|
||||
(cons 'bigpos
|
||||
|
|
@ -542,7 +542,7 @@ the size of a Calc bignum digit.")
|
|||
(let ((q (math-div-bignum-digit a math-bignum-digit-power-of-two)))
|
||||
(if (<= w math-bignum-logb-digit-size)
|
||||
(list (logand (cdr q)
|
||||
(1- (lsh 1 w))))
|
||||
(1- (ash 1 w))))
|
||||
(math-mul-bignum-digit (math-clip-bignum (math-norm-bignum (car q))
|
||||
(- w math-bignum-logb-digit-size))
|
||||
math-bignum-digit-power-of-two
|
||||
|
|
|
|||
|
|
@ -580,7 +580,7 @@
|
|||
;; deduce a better value for RAND_MAX.
|
||||
(let ((i 0))
|
||||
(while (< (setq i (1+ i)) 30)
|
||||
(if (> (lsh (math-abs (random)) math-random-shift) 4095)
|
||||
(if (> (ash (math-abs (random)) math-random-shift) 4095)
|
||||
(setq math-random-shift (1- math-random-shift))))))
|
||||
(setq math-last-RandSeed var-RandSeed
|
||||
math-gaussian-cache nil))
|
||||
|
|
@ -592,11 +592,11 @@
|
|||
(cdr math-random-table))
|
||||
math-random-ptr2 (or (cdr math-random-ptr2)
|
||||
(cdr math-random-table)))
|
||||
(logand (lsh (setcar math-random-ptr1
|
||||
(logand (ash (setcar math-random-ptr1
|
||||
(logand (- (car math-random-ptr1)
|
||||
(car math-random-ptr2)) 524287))
|
||||
-6) 1023))
|
||||
(logand (lsh (random) math-random-shift) 1023)))
|
||||
(logand (ash (random) math-random-shift) 1023)))
|
||||
|
||||
|
||||
;;; Produce a random digit in the range 0..999.
|
||||
|
|
|
|||
|
|
@ -2294,14 +2294,14 @@ calc-kill calc-kill-region calc-yank))))
|
|||
(let ((a (math-trunc a)))
|
||||
(if (integerp a)
|
||||
a
|
||||
(if (or (Math-lessp (lsh -1 -1) a)
|
||||
(Math-lessp a (- (lsh -1 -1))))
|
||||
(if (or (Math-lessp most-positive-fixnum a)
|
||||
(Math-lessp a (- most-positive-fixnum)))
|
||||
(math-reject-arg a 'fixnump)
|
||||
(math-fixnum a)))))
|
||||
((and allow-inf (equal a '(var inf var-inf)))
|
||||
(lsh -1 -1))
|
||||
most-positive-fixnum)
|
||||
((and allow-inf (equal a '(neg (var inf var-inf))))
|
||||
(- (lsh -1 -1)))
|
||||
(- most-positive-fixnum))
|
||||
(t (math-reject-arg a 'fixnump))))
|
||||
|
||||
;;; Verify that A is an integer >= 0 and return A in integer form. [I N; - x]
|
||||
|
|
|
|||
|
|
@ -1697,7 +1697,7 @@ If this can't be done, return NIL."
|
|||
(while (not (Math-lessp x pow))
|
||||
(setq pows (cons pow pows)
|
||||
pow (math-sqr pow)))
|
||||
(setq n (lsh 1 (1- (length pows)))
|
||||
(setq n (ash 1 (1- (length pows)))
|
||||
sum n
|
||||
pow (car pows))
|
||||
(while (and (setq pows (cdr pows))
|
||||
|
|
|
|||
|
|
@ -142,8 +142,8 @@ If optional LEFT is non-nil insert spaces on left."
|
|||
(defconst wisent-BITS-PER-WORD
|
||||
(let ((i 1)
|
||||
(do-shift (if (boundp 'most-positive-fixnum)
|
||||
(lambda (i) (lsh most-positive-fixnum (- i)))
|
||||
(lambda (i) (lsh 1 i)))))
|
||||
(lambda (i) (ash most-positive-fixnum (- i)))
|
||||
(lambda (i) (ash 1 i)))))
|
||||
(while (not (zerop (funcall do-shift i)))
|
||||
(setq i (1+ i)))
|
||||
i))
|
||||
|
|
@ -156,18 +156,18 @@ If optional LEFT is non-nil insert spaces on left."
|
|||
"X[I/BITS-PER-WORD] |= 1 << (I % BITS-PER-WORD)."
|
||||
(let ((k (/ i wisent-BITS-PER-WORD)))
|
||||
(aset x k (logior (aref x k)
|
||||
(lsh 1 (% i wisent-BITS-PER-WORD))))))
|
||||
(ash 1 (% i wisent-BITS-PER-WORD))))))
|
||||
|
||||
(defsubst wisent-RESETBIT (x i)
|
||||
"X[I/BITS-PER-WORD] &= ~(1 << (I % BITS-PER-WORD))."
|
||||
(let ((k (/ i wisent-BITS-PER-WORD)))
|
||||
(aset x k (logand (aref x k)
|
||||
(lognot (lsh 1 (% i wisent-BITS-PER-WORD)))))))
|
||||
(lognot (ash 1 (% i wisent-BITS-PER-WORD)))))))
|
||||
|
||||
(defsubst wisent-BITISSET (x i)
|
||||
"(X[I/BITS-PER-WORD] & (1 << (I % BITS-PER-WORD))) != 0."
|
||||
(not (zerop (logand (aref x (/ i wisent-BITS-PER-WORD))
|
||||
(lsh 1 (% i wisent-BITS-PER-WORD))))))
|
||||
(ash 1 (% i wisent-BITS-PER-WORD))))))
|
||||
|
||||
(defsubst wisent-noninteractive ()
|
||||
"Return non-nil if running without interactive terminal."
|
||||
|
|
|
|||
|
|
@ -119,7 +119,7 @@ RULE is a cons of global and new reference point symbols
|
|||
(setq nref (cdr (assq nref reference-point-alist))))
|
||||
(or (and (>= gref 0) (< gref 12) (>= nref 0) (< nref 12))
|
||||
(error "Invalid composition rule: %S" rule))
|
||||
(logior (lsh xoff 16) (lsh yoff 8) (+ (* gref 12) nref)))
|
||||
(logior (ash xoff 16) (ash yoff 8) (+ (* gref 12) nref)))
|
||||
(error "Invalid composition rule: %S" rule))))
|
||||
|
||||
;; Decode encoded composition rule RULE-CODE. The value is a cons of
|
||||
|
|
@ -130,8 +130,8 @@ RULE is a cons of global and new reference point symbols
|
|||
(defun decode-composition-rule (rule-code)
|
||||
(or (and (natnump rule-code) (< rule-code #x1000000))
|
||||
(error "Invalid encoded composition rule: %S" rule-code))
|
||||
(let ((xoff (lsh rule-code -16))
|
||||
(yoff (logand (lsh rule-code -8) #xFF))
|
||||
(let ((xoff (ash rule-code -16))
|
||||
(yoff (logand (ash rule-code -8) #xFF))
|
||||
gref nref)
|
||||
(setq rule-code (logand rule-code #xFF)
|
||||
gref (car (rassq (/ rule-code 12) reference-point-alist))
|
||||
|
|
|
|||
|
|
@ -226,7 +226,7 @@ X frame."
|
|||
char
|
||||
(let ((fid (face-id face)))
|
||||
(if (< fid 64) ; we have 32 - 3(LSB) - 1(SIGN) - 22(CHAR) = 6 bits for face id
|
||||
(logior char (lsh fid 22))
|
||||
(logior char (ash fid 22))
|
||||
(cons char fid)))))
|
||||
|
||||
;;;###autoload
|
||||
|
|
@ -239,7 +239,7 @@ X frame."
|
|||
;;;###autoload
|
||||
(defun glyph-face (glyph)
|
||||
"Return the face of glyph code GLYPH, or nil if glyph has default face."
|
||||
(let ((face-id (if (consp glyph) (cdr glyph) (lsh glyph -22))))
|
||||
(let ((face-id (if (consp glyph) (cdr glyph) (ash glyph -22))))
|
||||
(and (> face-id 0)
|
||||
(catch 'face
|
||||
(dolist (face (face-list))
|
||||
|
|
|
|||
|
|
@ -269,7 +269,7 @@ returned unaltered."
|
|||
(car where)
|
||||
(if (zerop (cdr where))
|
||||
(logior (logand tem 65280) value)
|
||||
(logior (logand tem 255) (lsh value 8))))))
|
||||
(logior (logand tem 255) (ash value 8))))))
|
||||
((numberp where)
|
||||
(aset regs where (logand value 65535))))))
|
||||
regs)
|
||||
|
|
|
|||
|
|
@ -547,7 +547,7 @@ doubt, use whitespace."
|
|||
?\M-\^@ ?\s-\^@ ?\S-\^@)
|
||||
when (/= (logand ch bit) 0)
|
||||
concat (format "%c-" pf))
|
||||
(let ((ch2 (logand ch (1- (lsh 1 18)))))
|
||||
(let ((ch2 (logand ch (1- (ash 1 18)))))
|
||||
(cond ((<= ch2 32)
|
||||
(pcase ch2
|
||||
(0 "NUL") (9 "TAB") (10 "LFD")
|
||||
|
|
|
|||
|
|
@ -205,22 +205,22 @@
|
|||
(setq bindat-idx (1+ bindat-idx))))
|
||||
|
||||
(defun bindat--unpack-u16 ()
|
||||
(logior (lsh (bindat--unpack-u8) 8) (bindat--unpack-u8)))
|
||||
(logior (ash (bindat--unpack-u8) 8) (bindat--unpack-u8)))
|
||||
|
||||
(defun bindat--unpack-u24 ()
|
||||
(logior (lsh (bindat--unpack-u16) 8) (bindat--unpack-u8)))
|
||||
(logior (ash (bindat--unpack-u16) 8) (bindat--unpack-u8)))
|
||||
|
||||
(defun bindat--unpack-u32 ()
|
||||
(logior (lsh (bindat--unpack-u16) 16) (bindat--unpack-u16)))
|
||||
(logior (ash (bindat--unpack-u16) 16) (bindat--unpack-u16)))
|
||||
|
||||
(defun bindat--unpack-u16r ()
|
||||
(logior (bindat--unpack-u8) (lsh (bindat--unpack-u8) 8)))
|
||||
(logior (bindat--unpack-u8) (ash (bindat--unpack-u8) 8)))
|
||||
|
||||
(defun bindat--unpack-u24r ()
|
||||
(logior (bindat--unpack-u16r) (lsh (bindat--unpack-u8) 16)))
|
||||
(logior (bindat--unpack-u16r) (ash (bindat--unpack-u8) 16)))
|
||||
|
||||
(defun bindat--unpack-u32r ()
|
||||
(logior (bindat--unpack-u16r) (lsh (bindat--unpack-u16r) 16)))
|
||||
(logior (bindat--unpack-u16r) (ash (bindat--unpack-u16r) 16)))
|
||||
|
||||
(defun bindat--unpack-item (type len &optional vectype)
|
||||
(if (eq type 'ip)
|
||||
|
|
@ -250,7 +250,7 @@
|
|||
(if (/= 0 (logand m j))
|
||||
(setq bits (cons bnum bits)))
|
||||
(setq bnum (1- bnum)
|
||||
j (lsh j -1)))))
|
||||
j (ash j -1)))))
|
||||
bits))
|
||||
((eq type 'str)
|
||||
(let ((s (substring bindat-raw bindat-idx (+ bindat-idx len))))
|
||||
|
|
@ -459,30 +459,30 @@ e.g. corresponding to STRUCT.FIELD1[INDEX2].FIELD3..."
|
|||
(setq bindat-idx (1+ bindat-idx)))
|
||||
|
||||
(defun bindat--pack-u16 (v)
|
||||
(aset bindat-raw bindat-idx (logand (lsh v -8) 255))
|
||||
(aset bindat-raw bindat-idx (logand (ash v -8) 255))
|
||||
(aset bindat-raw (1+ bindat-idx) (logand v 255))
|
||||
(setq bindat-idx (+ bindat-idx 2)))
|
||||
|
||||
(defun bindat--pack-u24 (v)
|
||||
(bindat--pack-u8 (lsh v -16))
|
||||
(bindat--pack-u8 (ash v -16))
|
||||
(bindat--pack-u16 v))
|
||||
|
||||
(defun bindat--pack-u32 (v)
|
||||
(bindat--pack-u16 (lsh v -16))
|
||||
(bindat--pack-u16 (ash v -16))
|
||||
(bindat--pack-u16 v))
|
||||
|
||||
(defun bindat--pack-u16r (v)
|
||||
(aset bindat-raw (1+ bindat-idx) (logand (lsh v -8) 255))
|
||||
(aset bindat-raw (1+ bindat-idx) (logand (ash v -8) 255))
|
||||
(aset bindat-raw bindat-idx (logand v 255))
|
||||
(setq bindat-idx (+ bindat-idx 2)))
|
||||
|
||||
(defun bindat--pack-u24r (v)
|
||||
(bindat--pack-u16r v)
|
||||
(bindat--pack-u8 (lsh v -16)))
|
||||
(bindat--pack-u8 (ash v -16)))
|
||||
|
||||
(defun bindat--pack-u32r (v)
|
||||
(bindat--pack-u16r v)
|
||||
(bindat--pack-u16r (lsh v -16)))
|
||||
(bindat--pack-u16r (ash v -16)))
|
||||
|
||||
(defun bindat--pack-item (v type len &optional vectype)
|
||||
(if (eq type 'ip)
|
||||
|
|
@ -515,7 +515,7 @@ e.g. corresponding to STRUCT.FIELD1[INDEX2].FIELD3..."
|
|||
(if (memq bnum v)
|
||||
(setq m (logior m j)))
|
||||
(setq bnum (1- bnum)
|
||||
j (lsh j -1))))
|
||||
j (ash j -1))))
|
||||
(bindat--pack-u8 m))))
|
||||
((memq type '(str strz))
|
||||
(let ((l (length v)) (i 0))
|
||||
|
|
|
|||
|
|
@ -1283,7 +1283,7 @@
|
|||
(setq bytedecomp-ptr (1+ bytedecomp-ptr))
|
||||
(+ (aref bytes bytedecomp-ptr)
|
||||
(progn (setq bytedecomp-ptr (1+ bytedecomp-ptr))
|
||||
(lsh (aref bytes bytedecomp-ptr) 8))))
|
||||
(ash (aref bytes bytedecomp-ptr) 8))))
|
||||
(t tem)))) ;Offset was in opcode.
|
||||
((>= bytedecomp-op byte-constant)
|
||||
(prog1 (- bytedecomp-op byte-constant) ;Offset in opcode.
|
||||
|
|
@ -1297,7 +1297,7 @@
|
|||
(setq bytedecomp-ptr (1+ bytedecomp-ptr))
|
||||
(+ (aref bytes bytedecomp-ptr)
|
||||
(progn (setq bytedecomp-ptr (1+ bytedecomp-ptr))
|
||||
(lsh (aref bytes bytedecomp-ptr) 8))))
|
||||
(ash (aref bytes bytedecomp-ptr) 8))))
|
||||
((and (>= bytedecomp-op byte-listN)
|
||||
(<= bytedecomp-op byte-discardN))
|
||||
(setq bytedecomp-ptr (1+ bytedecomp-ptr)) ;Offset in next byte.
|
||||
|
|
|
|||
|
|
@ -835,7 +835,7 @@ all the arguments.
|
|||
(defmacro byte-compile-push-bytecode-const2 (opcode const2 bytes pc)
|
||||
"Push OPCODE and the two-byte constant CONST2 onto BYTES, and add 3 to PC.
|
||||
CONST2 may be evaluated multiple times."
|
||||
`(byte-compile-push-bytecodes ,opcode (logand ,const2 255) (lsh ,const2 -8)
|
||||
`(byte-compile-push-bytecodes ,opcode (logand ,const2 255) (ash ,const2 -8)
|
||||
,bytes ,pc))
|
||||
|
||||
(defun byte-compile-lapcode (lap)
|
||||
|
|
@ -925,9 +925,9 @@ CONST2 may be evaluated multiple times."
|
|||
;; Splits PC's value into 2 bytes. The jump address is
|
||||
;; "reconstructed" by the `FETCH2' macro in `bytecode.c'.
|
||||
(setcar (cdr bytes-tail) (logand pc 255))
|
||||
(setcar bytes-tail (lsh pc -8))
|
||||
(setcar bytes-tail (ash pc -8))
|
||||
;; FIXME: Replace this by some workaround.
|
||||
(if (> (car bytes-tail) 255) (error "Bytecode overflow")))
|
||||
(or (<= 0 (car bytes-tail) 255) (error "Bytecode overflow")))
|
||||
|
||||
;; Similarly, replace TAGs in all jump tables with the correct PC index.
|
||||
(dolist (hash-table byte-compile-jump-tables)
|
||||
|
|
@ -2793,8 +2793,8 @@ If FORM is a lambda or a macro, byte-compile it as a function."
|
|||
(if (> mandatory 127)
|
||||
(byte-compile-report-error "Too many (>127) mandatory arguments")
|
||||
(logior mandatory
|
||||
(lsh nonrest 8)
|
||||
(lsh rest 7)))))
|
||||
(ash nonrest 8)
|
||||
(ash rest 7)))))
|
||||
|
||||
|
||||
(defun byte-compile-lambda (fun &optional add-lambda reserved-csts)
|
||||
|
|
@ -3258,7 +3258,7 @@ for symbols generated by the byte compiler itself."
|
|||
(fun (car form))
|
||||
(fargs (aref fun 0))
|
||||
(start-depth byte-compile-depth)
|
||||
(fmax2 (if (numberp fargs) (lsh fargs -7))) ;2*max+rest.
|
||||
(fmax2 (if (numberp fargs) (ash fargs -7))) ;2*max+rest.
|
||||
;; (fmin (if (numberp fargs) (logand fargs 127)))
|
||||
(alen (length (cdr form)))
|
||||
(dynbinds ())
|
||||
|
|
|
|||
|
|
@ -472,7 +472,7 @@ Optional second arg STATE is a random-state object."
|
|||
(n (logand 8388607 (aset vec i (- (aref vec i) (aref vec j))))))
|
||||
(if (integerp lim)
|
||||
(if (<= lim 512) (% n lim)
|
||||
(if (> lim 8388607) (setq n (+ (lsh n 9) (cl-random 512 state))))
|
||||
(if (> lim 8388607) (setq n (+ (ash n 9) (cl-random 512 state))))
|
||||
(let ((mask 1023))
|
||||
(while (< mask (1- lim)) (setq mask (1+ (+ mask mask))))
|
||||
(if (< (setq n (logand n mask)) lim) n (cl-random lim state))))
|
||||
|
|
|
|||
|
|
@ -229,7 +229,7 @@ which is big-endian."
|
|||
"Maximum number of bytes for a fixnum.")
|
||||
|
||||
(defconst erc-most-positive-int-msb
|
||||
(lsh most-positive-fixnum (- 0 (* 8 (1- erc-most-positive-int-bytes))))
|
||||
(ash most-positive-fixnum (- 0 (* 8 (1- erc-most-positive-int-bytes))))
|
||||
"Content of the most significant byte of most-positive-fixnum.")
|
||||
|
||||
(defun erc-unpack-int (str)
|
||||
|
|
@ -251,7 +251,7 @@ which is big-endian."
|
|||
(let ((num 0)
|
||||
(count 0))
|
||||
(while (< count len)
|
||||
(setq num (+ num (lsh (aref str (- len count 1)) (* 8 count))))
|
||||
(setq num (+ num (ash (aref str (- len count 1)) (* 8 count))))
|
||||
(setq count (1+ count)))
|
||||
num)))
|
||||
|
||||
|
|
|
|||
|
|
@ -638,7 +638,7 @@ color. The function should accept a single argument, the color name."
|
|||
(insert " ")
|
||||
(insert (propertize
|
||||
(apply 'format "#%02x%02x%02x"
|
||||
(mapcar (lambda (c) (lsh c -8))
|
||||
(mapcar (lambda (c) (ash c -8))
|
||||
color-values))
|
||||
'mouse-face 'highlight
|
||||
'help-echo
|
||||
|
|
|
|||
|
|
@ -5564,7 +5564,7 @@ In posting styles use `(\"Expires\" (make-expires-date 30))'."
|
|||
;; Instead we use this randomly inited counter.
|
||||
(setq message-unique-id-char
|
||||
(% (1+ (or message-unique-id-char
|
||||
(logand (random most-positive-fixnum) (1- (lsh 1 20)))))
|
||||
(logand (random most-positive-fixnum) (1- (ash 1 20)))))
|
||||
;; (current-time) returns 16-bit ints,
|
||||
;; and 2^16*25 just fits into 4 digits i base 36.
|
||||
(* 25 25)))
|
||||
|
|
@ -5579,9 +5579,9 @@ In posting styles use `(\"Expires\" (make-expires-date 30))'."
|
|||
user)
|
||||
(message-number-base36 (user-uid) -1))
|
||||
(message-number-base36 (+ (car tm)
|
||||
(lsh (% message-unique-id-char 25) 16)) 4)
|
||||
(ash (% message-unique-id-char 25) 16)) 4)
|
||||
(message-number-base36 (+ (nth 1 tm)
|
||||
(lsh (/ message-unique-id-char 25) 16)) 4)
|
||||
(ash (/ message-unique-id-char 25) 16)) 4)
|
||||
;; Append a given name, because while the generated ID is unique
|
||||
;; to this newsreader, other newsreaders might otherwise generate
|
||||
;; the same ID via another algorithm.
|
||||
|
|
|
|||
|
|
@ -769,9 +769,9 @@ from the document.")
|
|||
|
||||
(defun nndoc-read-little-endian ()
|
||||
(+ (prog1 (char-after) (forward-char 1))
|
||||
(lsh (prog1 (char-after) (forward-char 1)) 8)
|
||||
(lsh (prog1 (char-after) (forward-char 1)) 16)
|
||||
(lsh (prog1 (char-after) (forward-char 1)) 24)))
|
||||
(ash (prog1 (char-after) (forward-char 1)) 8)
|
||||
(ash (prog1 (char-after) (forward-char 1)) 16)
|
||||
(ash (prog1 (char-after) (forward-char 1)) 24)))
|
||||
|
||||
(defun nndoc-oe-dbx-decode-block ()
|
||||
(list
|
||||
|
|
|
|||
|
|
@ -651,7 +651,7 @@ This variable is set by `nnmaildir-request-article'.")
|
|||
(funcall func (cdr entry)))))))
|
||||
|
||||
(defun nnmaildir--up2-1 (n)
|
||||
(if (zerop n) 1 (1- (lsh 1 (1+ (logb n))))))
|
||||
(if (zerop n) 1 (1- (ash 1 (1+ (logb n))))))
|
||||
|
||||
(defun nnmaildir--system-name ()
|
||||
(replace-regexp-in-string
|
||||
|
|
|
|||
|
|
@ -261,7 +261,7 @@ We accept the tag Exif because that is the same format."
|
|||
(setq i (1+ i))
|
||||
(when (>= (+ i 2) len)
|
||||
(throw 'jfif nil))
|
||||
(let ((nbytes (+ (lsh (aref data (+ i 1)) 8)
|
||||
(let ((nbytes (+ (ash (aref data (+ i 1)) 8)
|
||||
(aref data (+ i 2))))
|
||||
(code (aref data i)))
|
||||
(when (and (>= code #xe0) (<= code #xef))
|
||||
|
|
|
|||
|
|
@ -1152,9 +1152,9 @@ is a list of CCL-BLOCKs."
|
|||
(progn
|
||||
(insert (logand code #xFFFFFF))
|
||||
(setq i (1+ i)))
|
||||
(insert (format "%c" (lsh code -16)))
|
||||
(insert (format "%c" (ash code -16)))
|
||||
(if (< (1+ i) len)
|
||||
(insert (format "%c" (logand (lsh code -8) 255))))
|
||||
(insert (format "%c" (logand (ash code -8) 255))))
|
||||
(if (< (+ i 2) len)
|
||||
(insert (format "%c" (logand code 255))))
|
||||
(setq i (+ i 3)))))
|
||||
|
|
|
|||
|
|
@ -487,7 +487,7 @@
|
|||
(data (list (vconcat (mapcar 'car cjk))))
|
||||
(i 0))
|
||||
(dolist (elt cjk)
|
||||
(let ((mask (lsh 1 i)))
|
||||
(let ((mask (ash 1 i)))
|
||||
(map-charset-chars
|
||||
#'(lambda (range _arg)
|
||||
(let ((from (car range)) (to (cdr range)))
|
||||
|
|
@ -867,7 +867,7 @@
|
|||
(spec (cdr target-spec)))
|
||||
(if (integerp spec)
|
||||
(dotimes (i (length registries))
|
||||
(if (> (logand spec (lsh 1 i)) 0)
|
||||
(if (> (logand spec (ash 1 i)) 0)
|
||||
(set-fontset-font "fontset-default" target
|
||||
(cons nil (aref registries i))
|
||||
nil 'append)))
|
||||
|
|
|
|||
|
|
@ -451,8 +451,8 @@ non-nil, it is used to sort CODINGS instead."
|
|||
;; E: 1 if not XXX-with-esc
|
||||
;; II: if iso-2022 based, 0..3, else 1.
|
||||
(logior
|
||||
(lsh (if (eq base most-preferred) 1 0) 7)
|
||||
(lsh
|
||||
(ash (if (eq base most-preferred) 1 0) 7)
|
||||
(ash
|
||||
(let ((mime (coding-system-get base :mime-charset)))
|
||||
;; Prefer coding systems corresponding to a
|
||||
;; MIME charset.
|
||||
|
|
@ -468,9 +468,9 @@ non-nil, it is used to sort CODINGS instead."
|
|||
(t 3))
|
||||
0))
|
||||
5)
|
||||
(lsh (if (memq base lang-preferred) 1 0) 4)
|
||||
(lsh (if (memq base from-priority) 1 0) 3)
|
||||
(lsh (if (string-match-p "-with-esc\\'"
|
||||
(ash (if (memq base lang-preferred) 1 0) 4)
|
||||
(ash (if (memq base from-priority) 1 0) 3)
|
||||
(ash (if (string-match-p "-with-esc\\'"
|
||||
(symbol-name base))
|
||||
0 1) 2)
|
||||
(if (eq (coding-system-type base) 'iso-2022)
|
||||
|
|
|
|||
|
|
@ -911,7 +911,7 @@ non-ASCII files. This attribute is meaningful only when
|
|||
(i 0))
|
||||
(dolist (elt coding-system-iso-2022-flags)
|
||||
(if (memq elt flags)
|
||||
(setq bits (logior bits (lsh 1 i))))
|
||||
(setq bits (logior bits (ash 1 i))))
|
||||
(setq i (1+ i)))
|
||||
(setcdr (assq :flags spec-attrs) bits))))
|
||||
|
||||
|
|
|
|||
|
|
@ -370,7 +370,7 @@ representation will be parsed correctly."
|
|||
|
||||
(defun json--decode-utf-16-surrogates (high low)
|
||||
"Return the code point represented by the UTF-16 surrogates HIGH and LOW."
|
||||
(+ (lsh (- high #xD800) 10) (- low #xDC00) #x10000))
|
||||
(+ (ash (- high #xD800) 10) (- low #xDC00) #x10000))
|
||||
|
||||
(defun json-read-escaped-char ()
|
||||
"Read the JSON string escaped character at point."
|
||||
|
|
|
|||
|
|
@ -136,9 +136,9 @@ input and write the converted data to its standard output."
|
|||
(defun binhex-update-crc (crc char &optional count)
|
||||
(if (null count) (setq count 1))
|
||||
(while (> count 0)
|
||||
(setq crc (logxor (logand (lsh crc 8) 65280)
|
||||
(setq crc (logxor (logand (ash crc 8) 65280)
|
||||
(aref binhex-crc-table
|
||||
(logxor (logand (lsh crc -8) 255)
|
||||
(logxor (logand (ash crc -8) 255)
|
||||
char)))
|
||||
count (1- count)))
|
||||
crc)
|
||||
|
|
@ -156,14 +156,14 @@ input and write the converted data to its standard output."
|
|||
(defun binhex-string-big-endian (string)
|
||||
(let ((ret 0) (i 0) (len (length string)))
|
||||
(while (< i len)
|
||||
(setq ret (+ (lsh ret 8) (binhex-char-int (aref string i)))
|
||||
(setq ret (+ (ash ret 8) (binhex-char-int (aref string i)))
|
||||
i (1+ i)))
|
||||
ret))
|
||||
|
||||
(defun binhex-string-little-endian (string)
|
||||
(let ((ret 0) (i 0) (shift 0) (len (length string)))
|
||||
(while (< i len)
|
||||
(setq ret (+ ret (lsh (binhex-char-int (aref string i)) shift))
|
||||
(setq ret (+ ret (ash (binhex-char-int (aref string i)) shift))
|
||||
i (1+ i)
|
||||
shift (+ shift 8)))
|
||||
ret))
|
||||
|
|
@ -239,13 +239,13 @@ If HEADER-ONLY is non-nil only decode header and return filename."
|
|||
counter (1+ counter)
|
||||
inputpos (1+ inputpos))
|
||||
(cond ((= counter 4)
|
||||
(binhex-push-char (lsh bits -16) nil work-buffer)
|
||||
(binhex-push-char (logand (lsh bits -8) 255) nil
|
||||
(binhex-push-char (ash bits -16) nil work-buffer)
|
||||
(binhex-push-char (logand (ash bits -8) 255) nil
|
||||
work-buffer)
|
||||
(binhex-push-char (logand bits 255) nil
|
||||
work-buffer)
|
||||
(setq bits 0 counter 0))
|
||||
(t (setq bits (lsh bits 6)))))
|
||||
(t (setq bits (ash bits 6)))))
|
||||
(if (null file-name-length)
|
||||
(with-current-buffer work-buffer
|
||||
(setq file-name-length (char-after (point-min))
|
||||
|
|
@ -261,12 +261,12 @@ If HEADER-ONLY is non-nil only decode header and return filename."
|
|||
(setq tmp (and tmp (not (eq inputpos end)))))
|
||||
(cond
|
||||
((= counter 3)
|
||||
(binhex-push-char (logand (lsh bits -16) 255) nil
|
||||
(binhex-push-char (logand (ash bits -16) 255) nil
|
||||
work-buffer)
|
||||
(binhex-push-char (logand (lsh bits -8) 255) nil
|
||||
(binhex-push-char (logand (ash bits -8) 255) nil
|
||||
work-buffer))
|
||||
((= counter 2)
|
||||
(binhex-push-char (logand (lsh bits -10) 255) nil
|
||||
(binhex-push-char (logand (ash bits -10) 255) nil
|
||||
work-buffer))))
|
||||
(if header-only nil
|
||||
(binhex-verify-crc work-buffer
|
||||
|
|
|
|||
|
|
@ -4515,7 +4515,7 @@ encoded string (and the same mask) will decode the string."
|
|||
(if (= curmask 0)
|
||||
(setq curmask mask))
|
||||
(setq charmask (% curmask 256))
|
||||
(setq curmask (lsh curmask -8))
|
||||
(setq curmask (ash curmask -8))
|
||||
(aset string-vector i (logxor charmask (aref string-vector i)))
|
||||
(setq i (1+ i)))
|
||||
(concat string-vector)))
|
||||
|
|
|
|||
|
|
@ -171,12 +171,12 @@ If FILE-NAME is non-nil, save the result to FILE-NAME."
|
|||
(cond ((= counter 4)
|
||||
(setq result (cons
|
||||
(concat
|
||||
(char-to-string (lsh bits -16))
|
||||
(char-to-string (logand (lsh bits -8) 255))
|
||||
(char-to-string (ash bits -16))
|
||||
(char-to-string (logand (ash bits -8) 255))
|
||||
(char-to-string (logand bits 255)))
|
||||
result))
|
||||
(setq bits 0 counter 0))
|
||||
(t (setq bits (lsh bits 6)))))))
|
||||
(t (setq bits (ash bits 6)))))))
|
||||
(cond
|
||||
(done)
|
||||
((> 0 remain)
|
||||
|
|
@ -188,12 +188,12 @@ If FILE-NAME is non-nil, save the result to FILE-NAME."
|
|||
((= counter 3)
|
||||
(setq result (cons
|
||||
(concat
|
||||
(char-to-string (logand (lsh bits -16) 255))
|
||||
(char-to-string (logand (lsh bits -8) 255)))
|
||||
(char-to-string (logand (ash bits -16) 255))
|
||||
(char-to-string (logand (ash bits -8) 255)))
|
||||
result)))
|
||||
((= counter 2)
|
||||
(setq result (cons
|
||||
(char-to-string (logand (lsh bits -10) 255))
|
||||
(char-to-string (logand (ash bits -10) 255))
|
||||
result))))
|
||||
(skip-chars-forward non-data-chars end))
|
||||
(if file-name
|
||||
|
|
|
|||
28
lisp/md4.el
28
lisp/md4.el
|
|
@ -91,15 +91,15 @@ strings containing the character 0."
|
|||
(let*
|
||||
((h1 (+ (car a) (,func (car b) (car c) (car d)) (car xk) (car ac)))
|
||||
(l1 (+ (cdr a) (,func (cdr b) (cdr c) (cdr d)) (cdr xk) (cdr ac)))
|
||||
(h2 (logand 65535 (+ h1 (lsh l1 -16))))
|
||||
(h2 (logand 65535 (+ h1 (ash l1 -16))))
|
||||
(l2 (logand 65535 l1))
|
||||
;; cyclic shift of 32 bits integer
|
||||
(h3 (logand 65535 (if (> s 15)
|
||||
(+ (lsh h2 (- s 32)) (lsh l2 (- s 16)))
|
||||
(+ (lsh h2 s) (lsh l2 (- s 16))))))
|
||||
(+ (ash h2 (- s 32)) (ash l2 (- s 16)))
|
||||
(+ (ash h2 s) (ash l2 (- s 16))))))
|
||||
(l3 (logand 65535 (if (> s 15)
|
||||
(+ (lsh l2 (- s 32)) (lsh h2 (- s 16)))
|
||||
(+ (lsh l2 s) (lsh h2 (- s 16)))))))
|
||||
(+ (ash l2 (- s 32)) (ash h2 (- s 16)))
|
||||
(+ (ash l2 s) (ash h2 (- s 16)))))))
|
||||
(cons h3 l3))))
|
||||
|
||||
(md4-make-step md4-round1 md4-F)
|
||||
|
|
@ -110,7 +110,7 @@ strings containing the character 0."
|
|||
"Return 32-bit sum of 32-bit integers X and Y."
|
||||
(let ((h (+ (car x) (car y)))
|
||||
(l (+ (cdr x) (cdr y))))
|
||||
(cons (logand 65535 (+ h (lsh l -16))) (logand 65535 l))))
|
||||
(cons (logand 65535 (+ h (ash l -16))) (logand 65535 l))))
|
||||
|
||||
(defsubst md4-and (x y)
|
||||
(cons (logand (car x) (car y)) (logand (cdr x) (cdr y))))
|
||||
|
|
@ -185,8 +185,8 @@ The resulting MD4 value is placed in `md4-buffer'."
|
|||
(let ((int32s (make-vector 16 0)) (i 0) j)
|
||||
(while (< i 16)
|
||||
(setq j (* i 4))
|
||||
(aset int32s i (cons (+ (aref seq (+ j 2)) (lsh (aref seq (+ j 3)) 8))
|
||||
(+ (aref seq j) (lsh (aref seq (1+ j)) 8))))
|
||||
(aset int32s i (cons (+ (aref seq (+ j 2)) (ash (aref seq (+ j 3)) 8))
|
||||
(+ (aref seq j) (ash (aref seq (1+ j)) 8))))
|
||||
(setq i (1+ i)))
|
||||
int32s))
|
||||
|
||||
|
|
@ -197,7 +197,7 @@ The resulting MD4 value is placed in `md4-buffer'."
|
|||
"Pack 16 bits integer in 2 bytes string as little endian."
|
||||
(let ((str (make-string 2 0)))
|
||||
(aset str 0 (logand int16 255))
|
||||
(aset str 1 (lsh int16 -8))
|
||||
(aset str 1 (ash int16 -8))
|
||||
str))
|
||||
|
||||
(defun md4-pack-int32 (int32)
|
||||
|
|
@ -207,20 +207,20 @@ integers (cons high low)."
|
|||
(let ((str (make-string 4 0))
|
||||
(h (car int32)) (l (cdr int32)))
|
||||
(aset str 0 (logand l 255))
|
||||
(aset str 1 (lsh l -8))
|
||||
(aset str 1 (ash l -8))
|
||||
(aset str 2 (logand h 255))
|
||||
(aset str 3 (lsh h -8))
|
||||
(aset str 3 (ash h -8))
|
||||
str))
|
||||
|
||||
(defun md4-unpack-int16 (str)
|
||||
(if (eq 2 (length str))
|
||||
(+ (lsh (aref str 1) 8) (aref str 0))
|
||||
(+ (ash (aref str 1) 8) (aref str 0))
|
||||
(error "%s is not 2 bytes long" str)))
|
||||
|
||||
(defun md4-unpack-int32 (str)
|
||||
(if (eq 4 (length str))
|
||||
(cons (+ (lsh (aref str 3) 8) (aref str 2))
|
||||
(+ (lsh (aref str 1) 8) (aref str 0)))
|
||||
(cons (+ (ash (aref str 3) 8) (aref str 2))
|
||||
(+ (ash (aref str 1) 8) (aref str 0)))
|
||||
(error "%s is not 4 bytes long" str)))
|
||||
|
||||
(provide 'md4)
|
||||
|
|
|
|||
|
|
@ -117,7 +117,7 @@ updated. Set this variable to t to disable the check.")
|
|||
length)
|
||||
(while (not ended)
|
||||
(setq length (dns-read-bytes 1))
|
||||
(if (= 192 (logand length (lsh 3 6)))
|
||||
(if (= 192 (logand length (ash 3 6)))
|
||||
(let ((offset (+ (* (logand 63 length) 256)
|
||||
(dns-read-bytes 1))))
|
||||
(save-excursion
|
||||
|
|
@ -144,17 +144,17 @@ If TCP-P, the first two bytes of the package with be the length field."
|
|||
(dns-write-bytes (dns-get 'id spec) 2)
|
||||
(dns-write-bytes
|
||||
(logior
|
||||
(lsh (if (dns-get 'response-p spec) 1 0) -7)
|
||||
(lsh
|
||||
(ash (if (dns-get 'response-p spec) 1 0) 7)
|
||||
(ash
|
||||
(cond
|
||||
((eq (dns-get 'opcode spec) 'query) 0)
|
||||
((eq (dns-get 'opcode spec) 'inverse-query) 1)
|
||||
((eq (dns-get 'opcode spec) 'status) 2)
|
||||
(t (error "No such opcode: %s" (dns-get 'opcode spec))))
|
||||
-3)
|
||||
(lsh (if (dns-get 'authoritative-p spec) 1 0) -2)
|
||||
(lsh (if (dns-get 'truncated-p spec) 1 0) -1)
|
||||
(lsh (if (dns-get 'recursion-desired-p spec) 1 0) 0)))
|
||||
3)
|
||||
(ash (if (dns-get 'authoritative-p spec) 1 0) 2)
|
||||
(ash (if (dns-get 'truncated-p spec) 1 0) 1)
|
||||
(ash (if (dns-get 'recursion-desired-p spec) 1 0) 0)))
|
||||
(dns-write-bytes
|
||||
(cond
|
||||
((eq (dns-get 'response-code spec) 'no-error) 0)
|
||||
|
|
@ -198,20 +198,20 @@ If TCP-P, the first two bytes of the package with be the length field."
|
|||
(goto-char (point-min))
|
||||
(push (list 'id (dns-read-bytes 2)) spec)
|
||||
(let ((byte (dns-read-bytes 1)))
|
||||
(push (list 'response-p (if (zerop (logand byte (lsh 1 7))) nil t))
|
||||
(push (list 'response-p (if (zerop (logand byte (ash 1 7))) nil t))
|
||||
spec)
|
||||
(let ((opcode (logand byte (lsh 7 3))))
|
||||
(let ((opcode (logand byte (ash 7 3))))
|
||||
(push (list 'opcode
|
||||
(cond ((eq opcode 0) 'query)
|
||||
((eq opcode 1) 'inverse-query)
|
||||
((eq opcode 2) 'status)))
|
||||
spec))
|
||||
(push (list 'authoritative-p (if (zerop (logand byte (lsh 1 2)))
|
||||
(push (list 'authoritative-p (if (zerop (logand byte (ash 1 2)))
|
||||
nil t)) spec)
|
||||
(push (list 'truncated-p (if (zerop (logand byte (lsh 1 2))) nil t))
|
||||
(push (list 'truncated-p (if (zerop (logand byte (ash 1 2))) nil t))
|
||||
spec)
|
||||
(push (list 'recursion-desired-p
|
||||
(if (zerop (logand byte (lsh 1 0))) nil t)) spec))
|
||||
(if (zerop (logand byte (ash 1 0))) nil t)) spec))
|
||||
(let ((rc (logand (dns-read-bytes 1) 15)))
|
||||
(push (list 'response-code
|
||||
(cond
|
||||
|
|
|
|||
|
|
@ -411,9 +411,9 @@ a string KEY of length 8. FORW is t or nil."
|
|||
(key2 (ntlm-smb-str-to-key key))
|
||||
(i 0) aa)
|
||||
(while (< i 64)
|
||||
(unless (zerop (logand (aref in (/ i 8)) (lsh 1 (- 7 (% i 8)))))
|
||||
(unless (zerop (logand (aref in (/ i 8)) (ash 1 (- 7 (% i 8)))))
|
||||
(aset inb i 1))
|
||||
(unless (zerop (logand (aref key2 (/ i 8)) (lsh 1 (- 7 (% i 8)))))
|
||||
(unless (zerop (logand (aref key2 (/ i 8)) (ash 1 (- 7 (% i 8)))))
|
||||
(aset keyb i 1))
|
||||
(setq i (1+ i)))
|
||||
(setq outb (ntlm-smb-dohash inb keyb forw))
|
||||
|
|
@ -422,7 +422,7 @@ a string KEY of length 8. FORW is t or nil."
|
|||
(unless (zerop (aref outb i))
|
||||
(setq aa (aref out (/ i 8)))
|
||||
(aset out (/ i 8)
|
||||
(logior aa (lsh 1 (- 7 (% i 8))))))
|
||||
(logior aa (ash 1 (- 7 (% i 8))))))
|
||||
(setq i (1+ i)))
|
||||
out))
|
||||
|
||||
|
|
@ -430,28 +430,28 @@ a string KEY of length 8. FORW is t or nil."
|
|||
"Return a string of length 8 for the given string STR of length 7."
|
||||
(let ((key (make-string 8 0))
|
||||
(i 7))
|
||||
(aset key 0 (lsh (aref str 0) -1))
|
||||
(aset key 0 (ash (aref str 0) -1))
|
||||
(aset key 1 (logior
|
||||
(lsh (logand (aref str 0) 1) 6)
|
||||
(lsh (aref str 1) -2)))
|
||||
(ash (logand (aref str 0) 1) 6)
|
||||
(ash (aref str 1) -2)))
|
||||
(aset key 2 (logior
|
||||
(lsh (logand (aref str 1) 3) 5)
|
||||
(lsh (aref str 2) -3)))
|
||||
(ash (logand (aref str 1) 3) 5)
|
||||
(ash (aref str 2) -3)))
|
||||
(aset key 3 (logior
|
||||
(lsh (logand (aref str 2) 7) 4)
|
||||
(lsh (aref str 3) -4)))
|
||||
(ash (logand (aref str 2) 7) 4)
|
||||
(ash (aref str 3) -4)))
|
||||
(aset key 4 (logior
|
||||
(lsh (logand (aref str 3) 15) 3)
|
||||
(lsh (aref str 4) -5)))
|
||||
(ash (logand (aref str 3) 15) 3)
|
||||
(ash (aref str 4) -5)))
|
||||
(aset key 5 (logior
|
||||
(lsh (logand (aref str 4) 31) 2)
|
||||
(lsh (aref str 5) -6)))
|
||||
(ash (logand (aref str 4) 31) 2)
|
||||
(ash (aref str 5) -6)))
|
||||
(aset key 6 (logior
|
||||
(lsh (logand (aref str 5) 63) 1)
|
||||
(lsh (aref str 6) -7)))
|
||||
(ash (logand (aref str 5) 63) 1)
|
||||
(ash (aref str 6) -7)))
|
||||
(aset key 7 (logand (aref str 6) 127))
|
||||
(while (>= i 0)
|
||||
(aset key i (lsh (aref key i) 1))
|
||||
(aset key i (ash (aref key i) 1))
|
||||
(setq i (1- i)))
|
||||
key))
|
||||
|
||||
|
|
@ -619,16 +619,16 @@ backward."
|
|||
(setq j 0)
|
||||
(while (< j 8)
|
||||
(setq bj (aref b j))
|
||||
(setq m (logior (lsh (aref bj 0) 1) (aref bj 5)))
|
||||
(setq n (logior (lsh (aref bj 1) 3)
|
||||
(lsh (aref bj 2) 2)
|
||||
(lsh (aref bj 3) 1)
|
||||
(setq m (logior (ash (aref bj 0) 1) (aref bj 5)))
|
||||
(setq n (logior (ash (aref bj 1) 3)
|
||||
(ash (aref bj 2) 2)
|
||||
(ash (aref bj 3) 1)
|
||||
(aref bj 4)))
|
||||
(setq k 0)
|
||||
(setq sbox-jmn (aref (aref (aref ntlm-smb-sbox j) m) n))
|
||||
(while (< k 4)
|
||||
(aset bj k
|
||||
(if (zerop (logand sbox-jmn (lsh 1 (- 3 k))))
|
||||
(if (zerop (logand sbox-jmn (ash 1 (- 3 k))))
|
||||
0 1))
|
||||
(setq k (1+ k)))
|
||||
(setq j (1+ j)))
|
||||
|
|
|
|||
|
|
@ -183,7 +183,7 @@ It contain at least 64 bits of entropy."
|
|||
;; Don't use microseconds from (current-time), they may be unsupported.
|
||||
;; Instead we use this randomly inited counter.
|
||||
(setq sasl-unique-id-char
|
||||
(% (1+ (or sasl-unique-id-char (logand (random) (1- (lsh 1 20)))))
|
||||
(% (1+ (or sasl-unique-id-char (logand (random) (1- (ash 1 20)))))
|
||||
;; (current-time) returns 16-bit ints,
|
||||
;; and 2^16*25 just fits into 4 digits i base 36.
|
||||
(* 25 25)))
|
||||
|
|
@ -191,10 +191,10 @@ It contain at least 64 bits of entropy."
|
|||
(concat
|
||||
(sasl-unique-id-number-base36
|
||||
(+ (car tm)
|
||||
(lsh (% sasl-unique-id-char 25) 16)) 4)
|
||||
(ash (% sasl-unique-id-char 25) 16)) 4)
|
||||
(sasl-unique-id-number-base36
|
||||
(+ (nth 1 tm)
|
||||
(lsh (/ sasl-unique-id-char 25) 16)) 4))))
|
||||
(ash (/ sasl-unique-id-char 25) 16)) 4))))
|
||||
|
||||
(defun sasl-unique-id-number-base36 (num len)
|
||||
(if (if (< len 0)
|
||||
|
|
|
|||
|
|
@ -420,7 +420,7 @@
|
|||
(unibyte-string
|
||||
version ; version
|
||||
command ; command
|
||||
(lsh port -8) ; port, high byte
|
||||
(ash port -8) ; port, high byte
|
||||
(logand port #xff)) ; port, low byte
|
||||
addr ; address
|
||||
(user-full-name) ; username
|
||||
|
|
@ -434,7 +434,7 @@
|
|||
atype) ; address type
|
||||
addr ; address
|
||||
(unibyte-string
|
||||
(lsh port -8) ; port, high byte
|
||||
(ash port -8) ; port, high byte
|
||||
(logand port #xff))))) ; port, low byte
|
||||
(t
|
||||
(error "Unknown protocol version: %d" version)))
|
||||
|
|
|
|||
|
|
@ -4108,13 +4108,13 @@ This is used to map a mode number to a permission string.")
|
|||
(defun tramp-file-mode-from-int (mode)
|
||||
"Turn an integer representing a file mode into an ls(1)-like string."
|
||||
(let ((type (cdr
|
||||
(assoc (logand (lsh mode -12) 15) tramp-file-mode-type-map)))
|
||||
(user (logand (lsh mode -6) 7))
|
||||
(group (logand (lsh mode -3) 7))
|
||||
(other (logand (lsh mode -0) 7))
|
||||
(suid (> (logand (lsh mode -9) 4) 0))
|
||||
(sgid (> (logand (lsh mode -9) 2) 0))
|
||||
(sticky (> (logand (lsh mode -9) 1) 0)))
|
||||
(assoc (logand (ash mode -12) 15) tramp-file-mode-type-map)))
|
||||
(user (logand (ash mode -6) 7))
|
||||
(group (logand (ash mode -3) 7))
|
||||
(other (logand (ash mode -0) 7))
|
||||
(suid (> (logand (ash mode -9) 4) 0))
|
||||
(sgid (> (logand (ash mode -9) 2) 0))
|
||||
(sticky (> (logand (ash mode -9) 1) 0)))
|
||||
(setq user (tramp-file-mode-permissions user suid "s"))
|
||||
(setq group (tramp-file-mode-permissions group sgid "s"))
|
||||
(setq other (tramp-file-mode-permissions other sticky "t"))
|
||||
|
|
|
|||
|
|
@ -145,7 +145,7 @@ It will be the next event read after all pending events."
|
|||
The value is an ASCII printing character (not upper case) or a symbol."
|
||||
(if (symbolp event)
|
||||
(car (get event 'event-symbol-elements))
|
||||
(let ((base (logand event (1- (lsh 1 18)))))
|
||||
(let ((base (logand event (1- (ash 1 18)))))
|
||||
(downcase (if (< base 32) (logior base 64) base)))))
|
||||
|
||||
(defun event-object (event)
|
||||
|
|
|
|||
|
|
@ -116,9 +116,9 @@
|
|||
)
|
||||
|
||||
(defmacro pgg-parse-time-field (bytes)
|
||||
`(list (logior (lsh (car ,bytes) 8)
|
||||
`(list (logior (ash (car ,bytes) 8)
|
||||
(nth 1 ,bytes))
|
||||
(logior (lsh (nth 2 ,bytes) 8)
|
||||
(logior (ash (nth 2 ,bytes) 8)
|
||||
(nth 3 ,bytes))
|
||||
0))
|
||||
|
||||
|
|
@ -184,21 +184,21 @@
|
|||
(ccl-execute-on-string pgg-parse-crc24 h string)
|
||||
(format "%c%c%c"
|
||||
(logand (aref h 1) 255)
|
||||
(logand (lsh (aref h 2) -8) 255)
|
||||
(logand (ash (aref h 2) -8) 255)
|
||||
(logand (aref h 2) 255)))))
|
||||
|
||||
(defmacro pgg-parse-length-type (c)
|
||||
`(cond
|
||||
((< ,c 192) (cons ,c 1))
|
||||
((< ,c 224)
|
||||
(cons (+ (lsh (- ,c 192) 8)
|
||||
(cons (+ (ash (- ,c 192) 8)
|
||||
(pgg-byte-after (+ 2 (point)))
|
||||
192)
|
||||
2))
|
||||
((= ,c 255)
|
||||
(cons (cons (logior (lsh (pgg-byte-after (+ 2 (point))) 8)
|
||||
(cons (cons (logior (ash (pgg-byte-after (+ 2 (point))) 8)
|
||||
(pgg-byte-after (+ 3 (point))))
|
||||
(logior (lsh (pgg-byte-after (+ 4 (point))) 8)
|
||||
(logior (ash (pgg-byte-after (+ 4 (point))) 8)
|
||||
(pgg-byte-after (+ 5 (point)))))
|
||||
5))
|
||||
(t;partial body length
|
||||
|
|
@ -210,13 +210,13 @@
|
|||
(if (zerop (logand 64 ptag));Old format
|
||||
(progn
|
||||
(setq length-type (logand ptag 3)
|
||||
length-type (if (= 3 length-type) 0 (lsh 1 length-type))
|
||||
content-tag (logand 15 (lsh ptag -2))
|
||||
length-type (if (= 3 length-type) 0 (ash 1 length-type))
|
||||
content-tag (logand 15 (ash ptag -2))
|
||||
packet-bytes 0
|
||||
header-bytes (1+ length-type))
|
||||
(dotimes (i length-type)
|
||||
(setq packet-bytes
|
||||
(logior (lsh packet-bytes 8)
|
||||
(logior (ash packet-bytes 8)
|
||||
(pgg-byte-after (+ 1 i (point)))))))
|
||||
(setq content-tag (logand 63 ptag)
|
||||
length-type (pgg-parse-length-type
|
||||
|
|
@ -317,10 +317,10 @@
|
|||
(let ((name-bytes (pgg-read-bytes 2))
|
||||
(value-bytes (pgg-read-bytes 2)))
|
||||
(cons (pgg-read-bytes-string
|
||||
(logior (lsh (car name-bytes) 8)
|
||||
(logior (ash (car name-bytes) 8)
|
||||
(nth 1 name-bytes)))
|
||||
(pgg-read-bytes-string
|
||||
(logior (lsh (car value-bytes) 8)
|
||||
(logior (ash (car value-bytes) 8)
|
||||
(nth 1 value-bytes)))))))
|
||||
(21 ;preferred hash algorithms
|
||||
(cons 'preferred-hash-algorithm
|
||||
|
|
@ -380,7 +380,7 @@
|
|||
(pgg-set-alist result
|
||||
'hash-algorithm (pgg-read-byte))
|
||||
(when (>= 10000 (setq n (pgg-read-bytes 2)
|
||||
n (logior (lsh (car n) 8)
|
||||
n (logior (ash (car n) 8)
|
||||
(nth 1 n))))
|
||||
(save-restriction
|
||||
(narrow-to-region (point)(+ n (point)))
|
||||
|
|
@ -391,7 +391,7 @@
|
|||
#'pgg-parse-signature-subpacket)))
|
||||
(goto-char (point-max))))
|
||||
(when (>= 10000 (setq n (pgg-read-bytes 2)
|
||||
n (logior (lsh (car n) 8)
|
||||
n (logior (ash (car n) 8)
|
||||
(nth 1 n))))
|
||||
(save-restriction
|
||||
(narrow-to-region (point)(+ n (point)))
|
||||
|
|
|
|||
|
|
@ -10058,7 +10058,7 @@ Note: this function also decodes single byte encodings like
|
|||
(cons 6 128))))
|
||||
(when (>= val 192) (setq eat (car shift-xor)))
|
||||
(setq val (logxor val (cdr shift-xor)))
|
||||
(setq sum (+ (lsh sum (car shift-xor)) val))
|
||||
(setq sum (+ (ash sum (car shift-xor)) val))
|
||||
(when (> eat 0) (setq eat (- eat 1)))
|
||||
(cond
|
||||
((= 0 eat) ;multi byte
|
||||
|
|
|
|||
|
|
@ -794,8 +794,8 @@ Default for SITEMAP-FILENAME is `sitemap.org'."
|
|||
((or `anti-chronologically `chronologically)
|
||||
(let* ((adate (org-publish-find-date a project))
|
||||
(bdate (org-publish-find-date b project))
|
||||
(A (+ (lsh (car adate) 16) (cadr adate)))
|
||||
(B (+ (lsh (car bdate) 16) (cadr bdate))))
|
||||
(A (+ (ash (car adate) 16) (cadr adate)))
|
||||
(B (+ (ash (car bdate) 16) (cadr bdate))))
|
||||
(setq retval
|
||||
(if (eq sort-files 'chronologically)
|
||||
(<= A B)
|
||||
|
|
@ -1348,7 +1348,7 @@ does not exist."
|
|||
(expand-file-name (or (file-symlink-p file) file)
|
||||
(file-name-directory file)))))
|
||||
(if (not attr) (error "No such file: \"%s\"" file)
|
||||
(+ (lsh (car (nth 5 attr)) 16)
|
||||
(+ (ash (car (nth 5 attr)) 16)
|
||||
(cadr (nth 5 attr))))))
|
||||
|
||||
|
||||
|
|
|
|||
|
|
@ -1858,7 +1858,7 @@ non-nil, a caret is prepended to invert the set."
|
|||
(setq entry (get-char-table ?a table)))
|
||||
;; incompatible
|
||||
(t (error "CC Mode is incompatible with this version of Emacs")))
|
||||
(setq list (cons (if (= (logand (lsh entry -16) 255) 255)
|
||||
(setq list (cons (if (= (logand (ash entry -16) 255) 255)
|
||||
'8-bit
|
||||
'1-bit)
|
||||
list)))
|
||||
|
|
|
|||
|
|
@ -5130,7 +5130,7 @@ killed after process termination."
|
|||
(defsubst ebnf-font-background (font) (nth 3 font))
|
||||
(defsubst ebnf-font-list (font) (nthcdr 4 font))
|
||||
(defsubst ebnf-font-attributes (font)
|
||||
(lsh (ps-extension-bit (cdr font)) -2))
|
||||
(ash (ps-extension-bit (cdr font)) -2))
|
||||
|
||||
|
||||
(defconst ebnf-font-name-select
|
||||
|
|
|
|||
|
|
@ -1039,16 +1039,12 @@ preprocessing token"
|
|||
(defun hif-shiftleft (a b)
|
||||
(setq a (hif-mathify a))
|
||||
(setq b (hif-mathify b))
|
||||
(if (< a 0)
|
||||
(ash a b)
|
||||
(lsh a b)))
|
||||
(ash a b))
|
||||
|
||||
(defun hif-shiftright (a b)
|
||||
(setq a (hif-mathify a))
|
||||
(setq b (hif-mathify b))
|
||||
(if (< a 0)
|
||||
(ash a (- b))
|
||||
(lsh a (- b))))
|
||||
(ash a (- b)))
|
||||
|
||||
|
||||
(defalias 'hif-multiply (hif-mathify-binop *))
|
||||
|
|
|
|||
|
|
@ -145,7 +145,7 @@ See the documentation of the function `bdf-read-font-info' for more detail."
|
|||
(if (or (< code (aref code-range 4))
|
||||
(> code (aref code-range 5)))
|
||||
(setq code (aref code-range 6)))
|
||||
(+ (* (- (lsh code -8) (aref code-range 0))
|
||||
(+ (* (- (ash code -8) (aref code-range 0))
|
||||
(1+ (- (aref code-range 3) (aref code-range 2))))
|
||||
(- (logand code 255) (aref code-range 2))))
|
||||
|
||||
|
|
@ -262,7 +262,7 @@ CODE, where N and CODE are in the following relation:
|
|||
(setq code (read (current-buffer)))
|
||||
(if (< code 0)
|
||||
(search-forward "ENDCHAR")
|
||||
(setq code0 (lsh code -8)
|
||||
(setq code0 (ash code -8)
|
||||
code1 (logand code 255)
|
||||
min-code (min min-code code)
|
||||
max-code (max max-code code)
|
||||
|
|
|
|||
|
|
@ -6299,7 +6299,7 @@ If FACE is not a valid face name, use default face."
|
|||
(ps-font-number 'ps-font-for-text
|
||||
(or (aref ps-font-type (logand effect 3))
|
||||
face))
|
||||
fg-color bg-color (lsh effect -2)))))
|
||||
fg-color bg-color (ash effect -2)))))
|
||||
(goto-char to))
|
||||
|
||||
|
||||
|
|
|
|||
|
|
@ -8348,16 +8348,16 @@ PREFIX is the string that represents this modifier in an event type symbol."
|
|||
(cond ((eq symbol 'control)
|
||||
(if (<= 64 (upcase event) 95)
|
||||
(- (upcase event) 64)
|
||||
(logior (lsh 1 lshiftby) event)))
|
||||
(logior (ash 1 lshiftby) event)))
|
||||
((eq symbol 'shift)
|
||||
;; FIXME: Should we also apply this "upcase" behavior of shift
|
||||
;; to non-ascii letters?
|
||||
(if (and (<= (downcase event) ?z)
|
||||
(>= (downcase event) ?a))
|
||||
(upcase event)
|
||||
(logior (lsh 1 lshiftby) event)))
|
||||
(logior (ash 1 lshiftby) event)))
|
||||
(t
|
||||
(logior (lsh 1 lshiftby) event)))
|
||||
(logior (ash 1 lshiftby) event)))
|
||||
(if (memq symbol (event-modifiers event))
|
||||
event
|
||||
(let ((event-type (if (symbolp event) event (car event))))
|
||||
|
|
|
|||
|
|
@ -1279,8 +1279,8 @@ for this to be permanent."
|
|||
;; Format a timestamp as 11 octal digits. Ghod, I hope this works...
|
||||
(let ((hibits (car timeval)) (lobits (car (cdr timeval))))
|
||||
(format "%05o%01o%05o"
|
||||
(lsh hibits -2)
|
||||
(logior (lsh (logand 3 hibits) 1)
|
||||
(ash hibits -2)
|
||||
(logior (ash (logand 3 hibits) 1)
|
||||
(if (> (logand lobits 32768) 0) 1 0))
|
||||
(logand 32767 lobits)
|
||||
)))
|
||||
|
|
|
|||
|
|
@ -59,20 +59,20 @@
|
|||
(setq system-key-alist
|
||||
(list
|
||||
;; These are special "keys" used to pass events from C to lisp.
|
||||
(cons (logior (lsh 0 16) 1) 'ns-power-off)
|
||||
(cons (logior (lsh 0 16) 2) 'ns-open-file)
|
||||
(cons (logior (lsh 0 16) 3) 'ns-open-temp-file)
|
||||
(cons (logior (lsh 0 16) 4) 'ns-drag-file)
|
||||
(cons (logior (lsh 0 16) 5) 'ns-drag-color)
|
||||
(cons (logior (lsh 0 16) 6) 'ns-drag-text)
|
||||
(cons (logior (lsh 0 16) 7) 'ns-change-font)
|
||||
(cons (logior (lsh 0 16) 8) 'ns-open-file-line)
|
||||
;;; (cons (logior (lsh 0 16) 9) 'ns-insert-working-text)
|
||||
;;; (cons (logior (lsh 0 16) 10) 'ns-delete-working-text)
|
||||
(cons (logior (lsh 0 16) 11) 'ns-spi-service-call)
|
||||
(cons (logior (lsh 0 16) 12) 'ns-new-frame)
|
||||
(cons (logior (lsh 0 16) 13) 'ns-toggle-toolbar)
|
||||
(cons (logior (lsh 0 16) 14) 'ns-show-prefs)
|
||||
(cons 1 'ns-power-off)
|
||||
(cons 2 'ns-open-file)
|
||||
(cons 3 'ns-open-temp-file)
|
||||
(cons 4 'ns-drag-file)
|
||||
(cons 5 'ns-drag-color)
|
||||
(cons 6 'ns-drag-text)
|
||||
(cons 7 'ns-change-font)
|
||||
(cons 8 'ns-open-file-line)
|
||||
;;; (cons 9 'ns-insert-working-text)
|
||||
;;; (cons 10 'ns-delete-working-text)
|
||||
(cons 11 'ns-spi-service-call)
|
||||
(cons 12 'ns-new-frame)
|
||||
(cons 13 'ns-toggle-toolbar)
|
||||
(cons 14 'ns-show-prefs)
|
||||
))))
|
||||
(set-terminal-parameter frame 'x-setup-function-keys t)))
|
||||
|
||||
|
|
|
|||
|
|
@ -830,10 +830,10 @@ DISPLAY can be a display name or a frame, and defaults to the
|
|||
selected frame's display.
|
||||
If DISPLAY is not on a 24-but TTY terminal, return nil."
|
||||
(when (and rgb (= (display-color-cells display) 16777216))
|
||||
(let ((r (lsh (car rgb) -8))
|
||||
(g (lsh (cadr rgb) -8))
|
||||
(b (lsh (nth 2 rgb) -8)))
|
||||
(logior (lsh r 16) (lsh g 8) b))))
|
||||
(let ((r (ash (car rgb) -8))
|
||||
(g (ash (cadr rgb) -8))
|
||||
(b (ash (nth 2 rgb) -8)))
|
||||
(logior (ash r 16) (ash g 8) b))))
|
||||
|
||||
(defun tty-color-define (name index &optional rgb frame)
|
||||
"Specify a tty color by its NAME, terminal INDEX and RGB values.
|
||||
|
|
@ -895,9 +895,9 @@ FRAME defaults to the selected frame."
|
|||
;; never consider it for approximating another color.
|
||||
(if try-rgb
|
||||
(progn
|
||||
(setq try-r (lsh (car try-rgb) -8)
|
||||
try-g (lsh (cadr try-rgb) -8)
|
||||
try-b (lsh (nth 2 try-rgb) -8))
|
||||
(setq try-r (ash (car try-rgb) -8)
|
||||
try-g (ash (cadr try-rgb) -8)
|
||||
try-b (ash (nth 2 try-rgb) -8))
|
||||
(setq dif-r (- r try-r)
|
||||
dif-g (- g try-g)
|
||||
dif-b (- b try-b))
|
||||
|
|
@ -938,13 +938,13 @@ should be the same regardless of what display is being used."
|
|||
(i2 (+ i1 ndig))
|
||||
(i3 (+ i2 ndig)))
|
||||
(list
|
||||
(lsh
|
||||
(ash
|
||||
(string-to-number (substring color i1 i2) 16)
|
||||
(* 4 (- 4 ndig)))
|
||||
(lsh
|
||||
(ash
|
||||
(string-to-number (substring color i2 i3) 16)
|
||||
(* 4 (- 4 ndig)))
|
||||
(lsh
|
||||
(ash
|
||||
(string-to-number (substring color i3) 16)
|
||||
(* 4 (- 4 ndig))))))
|
||||
((and (>= len 9) ;; X-style RGB:xx/yy/zz color spec
|
||||
|
|
|
|||
|
|
@ -1009,7 +1009,7 @@ hitting screen's max DCS length."
|
|||
|
||||
(defun xterm-rgb-convert-to-16bit (prim)
|
||||
"Convert an 8-bit primary color value PRIM to a corresponding 16-bit value."
|
||||
(logior prim (lsh prim 8)))
|
||||
(logior prim (ash prim 8)))
|
||||
|
||||
(defun xterm-register-default-colors (colors)
|
||||
"Register the default set of colors for xterm or compatible emulator.
|
||||
|
|
|
|||
|
|
@ -367,8 +367,8 @@ in the order given by 'git status'."
|
|||
|
||||
(defun vc-git-file-type-as-string (old-perm new-perm)
|
||||
"Return a string describing the file type based on its permissions."
|
||||
(let* ((old-type (lsh (or old-perm 0) -9))
|
||||
(new-type (lsh (or new-perm 0) -9))
|
||||
(let* ((old-type (ash (or old-perm 0) -9))
|
||||
(new-type (ash (or new-perm 0) -9))
|
||||
(str (pcase new-type
|
||||
(?\100 ;; File.
|
||||
(pcase old-type
|
||||
|
|
|
|||
|
|
@ -1017,7 +1017,7 @@ hg binary."
|
|||
;; Dirstate too small to be valid
|
||||
(< (nth 7 dirstate-attr) 40)
|
||||
;; We want to store 32-bit unsigned values in fixnums.
|
||||
(zerop (lsh -1 32))
|
||||
(zerop (ash most-positive-fixnum -32))
|
||||
(progn
|
||||
(setf repo-relative-filename
|
||||
(file-relative-name truename repo))
|
||||
|
|
|
|||
|
|
@ -556,18 +556,18 @@ FORMAT is 32 (not used). MESSAGE is the data part of an XClientMessageEvent."
|
|||
|
||||
(defun x-dnd-motif-value-to-list (value size byteorder)
|
||||
(let ((bytes (cond ((eq size 2)
|
||||
(list (logand (lsh value -8) ?\xff)
|
||||
(list (logand (ash value -8) ?\xff)
|
||||
(logand value ?\xff)))
|
||||
|
||||
((eq size 4)
|
||||
(if (consp value)
|
||||
(list (logand (lsh (car value) -8) ?\xff)
|
||||
(list (logand (ash (car value) -8) ?\xff)
|
||||
(logand (car value) ?\xff)
|
||||
(logand (lsh (cdr value) -8) ?\xff)
|
||||
(logand (ash (cdr value) -8) ?\xff)
|
||||
(logand (cdr value) ?\xff))
|
||||
(list (logand (lsh value -24) ?\xff)
|
||||
(logand (lsh value -16) ?\xff)
|
||||
(logand (lsh value -8) ?\xff)
|
||||
(list (logand (ash value -24) ?\xff)
|
||||
(logand (ash value -16) ?\xff)
|
||||
(logand (ash value -8) ?\xff)
|
||||
(logand value ?\xff)))))))
|
||||
(if (eq byteorder ?l)
|
||||
(reverse bytes)
|
||||
|
|
|
|||
|
|
@ -123,7 +123,7 @@ most-positive-fixnum, which is just less than a power of 2.")
|
|||
(setq byte (lognot byte)))
|
||||
(if (zerop byte)
|
||||
0
|
||||
(+ (logand byte 1) (data-tests-popcnt (lsh byte -1)))))
|
||||
(+ (logand byte 1) (data-tests-popcnt (ash byte -1)))))
|
||||
|
||||
(ert-deftest data-tests-logcount ()
|
||||
(should (cl-loop for n in (number-sequence -255 255)
|
||||
|
|
@ -186,17 +186,17 @@ most-positive-fixnum, which is just less than a power of 2.")
|
|||
(dotimes (_ 4)
|
||||
(aset bv i (> (logand 1 n) 0))
|
||||
(cl-incf i)
|
||||
(setf n (lsh n -1)))))
|
||||
(setf n (ash n -1)))))
|
||||
bv))
|
||||
|
||||
(defun test-bool-vector-to-hex-string (bv)
|
||||
(let (nibbles (v (cl-coerce bv 'list)))
|
||||
(while v
|
||||
(push (logior
|
||||
(lsh (if (nth 0 v) 1 0) 0)
|
||||
(lsh (if (nth 1 v) 1 0) 1)
|
||||
(lsh (if (nth 2 v) 1 0) 2)
|
||||
(lsh (if (nth 3 v) 1 0) 3))
|
||||
(ash (if (nth 0 v) 1 0) 0)
|
||||
(ash (if (nth 1 v) 1 0) 1)
|
||||
(ash (if (nth 2 v) 1 0) 2)
|
||||
(ash (if (nth 3 v) 1 0) 3))
|
||||
nibbles)
|
||||
(setf v (nthcdr 4 v)))
|
||||
(mapconcat (lambda (n) (format "%X" n))
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue