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.

5 files changed, 46 insertions, 46 deletions

diff --git a/lisp/net/dns.el b/lisp/net/dns.el
index 057ae3219ee..b3b430d2ba8 100644
--- a/lisp/net/dns.el
+++ b/lisp/net/dns.el
@@ -117,7 +117,7 @@ updated.  Set this variable to t to disable the check.")
         length)
     (while (not ended)
       (setq length (dns-read-bytes 1))
-      (if (= 192 (logand length (lsh 3 6)))
+      (if (= 192 (logand length (ash 3 6)))
           (let ((offset (+ (* (logand 63 length) 256)
                            (dns-read-bytes 1))))
             (save-excursion
@@ -144,17 +144,17 @@ If TCP-P, the first two bytes of the package with be the length field."
     (dns-write-bytes (dns-get 'id spec) 2)
     (dns-write-bytes
      (logior
-      (lsh (if (dns-get 'response-p spec) 1 0) -7)
-      (lsh
+      (ash (if (dns-get 'response-p spec) 1 0) 7)
+      (ash
        (cond
         ((eq (dns-get 'opcode spec) 'query) 0)
         ((eq (dns-get 'opcode spec) 'inverse-query) 1)
         ((eq (dns-get 'opcode spec) 'status) 2)
         (t (error "No such opcode: %s" (dns-get 'opcode spec))))
-       -3)
-      (lsh (if (dns-get 'authoritative-p spec) 1 0) -2)
-      (lsh (if (dns-get 'truncated-p spec) 1 0) -1)
-      (lsh (if (dns-get 'recursion-desired-p spec) 1 0) 0)))
+       3)
+      (ash (if (dns-get 'authoritative-p spec) 1 0) 2)
+      (ash (if (dns-get 'truncated-p spec) 1 0) 1)
+      (ash (if (dns-get 'recursion-desired-p spec) 1 0) 0)))
     (dns-write-bytes
      (cond
       ((eq (dns-get 'response-code spec) 'no-error) 0)
@@ -198,20 +198,20 @@ If TCP-P, the first two bytes of the package with be the length field."
       (goto-char (point-min))
       (push (list 'id (dns-read-bytes 2)) spec)
       (let ((byte (dns-read-bytes 1)))
-        (push (list 'response-p (if (zerop (logand byte (lsh 1 7))) nil t))
+        (push (list 'response-p (if (zerop (logand byte (ash 1 7))) nil t))
               spec)
-        (let ((opcode (logand byte (lsh 7 3))))
+        (let ((opcode (logand byte (ash 7 3))))
           (push (list 'opcode
                       (cond ((eq opcode 0) 'query)
                             ((eq opcode 1) 'inverse-query)
                             ((eq opcode 2) 'status)))
                 spec))
-        (push (list 'authoritative-p (if (zerop (logand byte (lsh 1 2)))
+        (push (list 'authoritative-p (if (zerop (logand byte (ash 1 2)))
                                          nil t)) spec)
-        (push (list 'truncated-p (if (zerop (logand byte (lsh 1 2))) nil t))
+        (push (list 'truncated-p (if (zerop (logand byte (ash 1 2))) nil t))
               spec)
         (push (list 'recursion-desired-p
-                    (if (zerop (logand byte (lsh 1 0))) nil t)) spec))
+                    (if (zerop (logand byte (ash 1 0))) nil t)) spec))
       (let ((rc (logand (dns-read-bytes 1) 15)))
         (push (list 'response-code
                     (cond
diff --git a/lisp/net/ntlm.el b/lisp/net/ntlm.el
index 8366bc14e95..217f0b859f2 100644
--- a/lisp/net/ntlm.el
+++ b/lisp/net/ntlm.el
@@ -411,9 +411,9 @@ a string KEY of length 8.  FORW is t or nil."
         (key2 (ntlm-smb-str-to-key key))
         (i 0) aa)
     (while (< i 64)
-      (unless (zerop (logand (aref in (/ i 8)) (lsh 1 (- 7 (% i 8)))))
+      (unless (zerop (logand (aref in (/ i 8)) (ash 1 (- 7 (% i 8)))))
         (aset inb i 1))
-      (unless (zerop (logand (aref key2 (/ i 8)) (lsh 1 (- 7 (% i 8)))))
+      (unless (zerop (logand (aref key2 (/ i 8)) (ash 1 (- 7 (% i 8)))))
         (aset keyb i 1))
       (setq i (1+ i)))
     (setq outb (ntlm-smb-dohash inb keyb forw))
@@ -422,7 +422,7 @@ a string KEY of length 8.  FORW is t or nil."
       (unless (zerop (aref outb i))
         (setq aa (aref out (/ i 8)))
         (aset out (/ i 8)
-              (logior aa (lsh 1 (- 7 (% i 8))))))
+              (logior aa (ash 1 (- 7 (% i 8))))))
       (setq i (1+ i)))
     out))
 
@@ -430,28 +430,28 @@ a string KEY of length 8.  FORW is t or nil."
   "Return a string of length 8 for the given string STR of length 7."
   (let ((key (make-string 8 0))
         (i 7))
-    (aset key 0 (lsh (aref str 0) -1))
+    (aset key 0 (ash (aref str 0) -1))
     (aset key 1 (logior
-                 (lsh (logand (aref str 0) 1) 6)
-                 (lsh (aref str 1) -2)))
+                 (ash (logand (aref str 0) 1) 6)
+                 (ash (aref str 1) -2)))
     (aset key 2 (logior
-                 (lsh (logand (aref str 1) 3) 5)
-                 (lsh (aref str 2) -3)))
+                 (ash (logand (aref str 1) 3) 5)
+                 (ash (aref str 2) -3)))
     (aset key 3 (logior
-                 (lsh (logand (aref str 2) 7) 4)
-                 (lsh (aref str 3) -4)))
+                 (ash (logand (aref str 2) 7) 4)
+                 (ash (aref str 3) -4)))
     (aset key 4 (logior
-                 (lsh (logand (aref str 3) 15) 3)
-                 (lsh (aref str 4) -5)))
+                 (ash (logand (aref str 3) 15) 3)
+                 (ash (aref str 4) -5)))
     (aset key 5 (logior
-                 (lsh (logand (aref str 4) 31) 2)
-                 (lsh (aref str 5) -6)))
+                 (ash (logand (aref str 4) 31) 2)
+                 (ash (aref str 5) -6)))
     (aset key 6 (logior
-                 (lsh (logand (aref str 5) 63) 1)
-                 (lsh (aref str 6) -7)))
+                 (ash (logand (aref str 5) 63) 1)
+                 (ash (aref str 6) -7)))
     (aset key 7 (logand (aref str 6) 127))
     (while (>= i 0)
-      (aset key i (lsh (aref key i) 1))
+      (aset key i (ash (aref key i) 1))
       (setq i (1- i)))
     key))
 
@@ -619,16 +619,16 @@ backward."
         (setq j 0)
         (while (< j 8)
           (setq bj (aref b j))
-          (setq m (logior (lsh (aref bj 0) 1) (aref bj 5)))
-          (setq n (logior (lsh (aref bj 1) 3)
-                          (lsh (aref bj 2) 2)
-                          (lsh (aref bj 3) 1)
+          (setq m (logior (ash (aref bj 0) 1) (aref bj 5)))
+          (setq n (logior (ash (aref bj 1) 3)
+                          (ash (aref bj 2) 2)
+                          (ash (aref bj 3) 1)
                           (aref bj 4)))
           (setq k 0)
           (setq sbox-jmn (aref (aref (aref ntlm-smb-sbox j) m) n))
           (while (< k 4)
             (aset bj k
-                  (if (zerop (logand sbox-jmn (lsh 1 (- 3 k))))
+                  (if (zerop (logand sbox-jmn (ash 1 (- 3 k))))
                       0 1))
             (setq k (1+ k)))
           (setq j (1+ j)))
diff --git a/lisp/net/sasl.el b/lisp/net/sasl.el
index b4f0fffc716..ca0b66b2fb6 100644
--- a/lisp/net/sasl.el
+++ b/lisp/net/sasl.el
@@ -183,7 +183,7 @@ It contain at least 64 bits of entropy."
   ;; Don't use microseconds from (current-time), they may be unsupported.
   ;; Instead we use this randomly inited counter.
   (setq sasl-unique-id-char
-        (% (1+ (or sasl-unique-id-char (logand (random) (1- (lsh 1 20)))))
+        (% (1+ (or sasl-unique-id-char (logand (random) (1- (ash 1 20)))))
            ;; (current-time) returns 16-bit ints,
            ;; and 2^16*25 just fits into 4 digits i base 36.
            (* 25 25)))
@@ -191,10 +191,10 @@ It contain at least 64 bits of entropy."
     (concat
      (sasl-unique-id-number-base36
       (+ (car   tm)
-         (lsh (% sasl-unique-id-char 25) 16)) 4)
+         (ash (% sasl-unique-id-char 25) 16)) 4)
      (sasl-unique-id-number-base36
       (+ (nth 1 tm)
-         (lsh (/ sasl-unique-id-char 25) 16)) 4))))
+         (ash (/ sasl-unique-id-char 25) 16)) 4))))
 
 (defun sasl-unique-id-number-base36 (num len)
   (if (if (< len 0)
diff --git a/lisp/net/socks.el b/lisp/net/socks.el
index 4a3b13282cf..5ee6eea933f 100644
--- a/lisp/net/socks.el
+++ b/lisp/net/socks.el
@@ -420,7 +420,7 @@
                      (unibyte-string
                       version             ; version
                       command             ; command
-                      (lsh port -8)       ; port, high byte
+                      (ash port -8)       ; port, high byte
                       (logand port #xff)) ; port, low byte
                      addr                 ; address
                      (user-full-name)     ; username
@@ -434,7 +434,7 @@
                       atype)            ; address type
                      addr               ; address
                      (unibyte-string
-                      (lsh port -8)          ; port, high byte
+                      (ash port -8)          ; port, high byte
                       (logand port #xff))))) ; port, low byte
      (t
       (error "Unknown protocol version: %d" version)))
diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el
index 1af2defd586..8e6c9118509 100644
--- a/lisp/net/tramp.el
+++ b/lisp/net/tramp.el
@@ -4108,13 +4108,13 @@ This is used to map a mode number to a permission string.")
 (defun tramp-file-mode-from-int (mode)
   "Turn an integer representing a file mode into an ls(1)-like string."
   (let ((type   (cdr
-                 (assoc (logand (lsh mode -12) 15) tramp-file-mode-type-map)))
-        (user   (logand (lsh mode -6) 7))
-        (group  (logand (lsh mode -3) 7))
-        (other  (logand (lsh mode -0) 7))
-        (suid   (> (logand (lsh mode -9) 4) 0))
-        (sgid   (> (logand (lsh mode -9) 2) 0))
-        (sticky (> (logand (lsh mode -9) 1) 0)))
+                 (assoc (logand (ash mode -12) 15) tramp-file-mode-type-map)))
+        (user   (logand (ash mode -6) 7))
+        (group  (logand (ash mode -3) 7))
+        (other  (logand (ash mode -0) 7))
+        (suid   (> (logand (ash mode -9) 4) 0))
+        (sgid   (> (logand (ash mode -9) 2) 0))
+        (sticky (> (logand (ash mode -9) 1) 0)))
     (setq user  (tramp-file-mode-permissions user  suid "s"))
     (setq group (tramp-file-mode-permissions group sgid "s"))
     (setq other (tramp-file-mode-permissions other sticky "t"))