(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)
(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))
((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))
((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))
(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))
(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)
(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))))))
@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
(while (> n 0)
(if (oddp n)
(setq count (1+ count)))
- (setq n (lsh n -1)))
+ (setq n (ash n -1)))
count))
@end smallexample
(let ((count 0))
(while (> n 0)
(setq count (+ count (logand n 1))
- n (lsh n -1)))
+ n (ash n -1)))
count))
@end smallexample
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
(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 *)
(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))))))
(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)
(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)))
(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"))))
))))
(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
((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
(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
;; 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))
(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.
(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]
(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))
(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))
"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."
(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
(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))
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
;;;###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))
(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)
?\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")
(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)
(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))))
(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)
(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))
(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.
(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.
(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)
;; 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)
(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)
(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 ())
(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))))
"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)
(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)))
(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
;; 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)))
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.
(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
(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
(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))
(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)))))
(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)))
(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)))
;; 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.
(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)
(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))))
(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."
(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)
(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))
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))
(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
(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)))
(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)
((= 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
(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)
"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))))
(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))
"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)
(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)
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
(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)
(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
(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))
(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))
"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))
(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)))
;; 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)))
(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)
(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
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)))
(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"))
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)
)
(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))
(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
(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
(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
(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)))
#'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)))
(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
((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)
(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))))))
(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)))
(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
(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 *))
(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))))
(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)
(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))
(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))))
;; 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)
)))
(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)))
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.
;; 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))
(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
(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.
(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
;; 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))
(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)
(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)
(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))
projects / emacs.git / commitdiff