[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Emacs-diffs] feature/tramp-thread-safe 06a2f82 1/2: Merge branch 'maste
|
From: |
Michael Albinus |
|
Subject: |
[Emacs-diffs] feature/tramp-thread-safe 06a2f82 1/2: Merge branch 'master' into feature/tramp-thread-safe |
|
Date: |
Wed, 29 Aug 2018 04:57:43 -0400 (EDT) |
branch: feature/tramp-thread-safe
commit 06a2f822a299867e956e38b9210ec2d86e37cf00
Merge: a692095 c252cd9
Author: Michael Albinus <address@hidden>
Commit: Michael Albinus <address@hidden>
Merge branch 'master' into feature/tramp-thread-safe
---
admin/unidata/unidata-gen.el | 10 +-
admin/unidata/uvs.el | 2 +-
build-aux/config.sub | 804 ++++++++++++++++++-----------------
configure.ac | 18 +-
doc/emacs/trouble.texi | 10 +-
doc/lispref/errors.texi | 8 +-
doc/lispref/files.texi | 26 +-
doc/lispref/hash.texi | 4 +-
doc/lispref/keymaps.texi | 2 +-
doc/lispref/nonascii.texi | 12 +-
doc/lispref/numbers.texi | 333 +++++++--------
doc/lispref/objects.texi | 7 +-
doc/lispref/os.texi | 9 -
doc/lispref/processes.texi | 2 -
doc/lispref/syntax.texi | 8 +-
doc/misc/calc.texi | 19 +-
doc/misc/cl.texi | 2 +-
doc/misc/eww.texi | 10 +
etc/NEWS | 75 +++-
etc/NEWS.19 | 2 +-
etc/NEWS.26 | 61 ++-
etc/PROBLEMS | 2 +-
lib/gettimeofday.c | 4 +
lib/gnulib.mk.in | 6 +
lib/intprops.h | 16 +-
lib/regex_internal.c | 4 +-
lib/regex_internal.h | 3 +
lib/unistd.in.h | 30 ++
lisp/arc-mode.el | 78 ++--
lisp/calc/calc-bin.el | 6 +-
lisp/calc/calc-comb.el | 6 +-
lisp/calc/calc-ext.el | 8 +-
lisp/calc/calc-math.el | 2 +-
lisp/calc/calc.el | 7 -
lisp/calendar/parse-time.el | 6 +-
lisp/calendar/time-date.el | 8 +-
lisp/cedet/semantic/wisent/comp.el | 15 +-
lisp/comint.el | 5 +-
lisp/composite.el | 6 +-
lisp/disp-table.el | 4 +-
lisp/dos-fns.el | 2 +-
lisp/edmacro.el | 2 +-
lisp/emacs-lisp/autoload.el | 2 +-
lisp/emacs-lisp/backtrace.el | 12 +-
lisp/emacs-lisp/bindat.el | 28 +-
lisp/emacs-lisp/byte-opt.el | 4 +-
lisp/emacs-lisp/bytecomp.el | 12 +-
lisp/emacs-lisp/cl-extra.el | 2 +-
lisp/emacs-lisp/cl-lib.el | 5 +-
lisp/emacs-lisp/edebug.el | 5 +-
lisp/emacs-lisp/package.el | 5 +-
lisp/erc/erc-dcc.el | 15 +-
lisp/eshell/esh-mode.el | 3 +-
lisp/facemenu.el | 2 +-
lisp/files-x.el | 4 +-
lisp/gnus/message.el | 6 +-
lisp/gnus/nndoc.el | 6 +-
lisp/gnus/nnfolder.el | 24 +-
lisp/gnus/nnmaildir.el | 2 +-
lisp/image.el | 2 +-
lisp/international/ccl.el | 4 +-
lisp/international/fontset.el | 4 +-
lisp/international/mule-cmds.el | 10 +-
lisp/international/mule-conf.el | 5 +
lisp/international/mule-util.el | 6 +-
lisp/international/mule.el | 2 +-
lisp/json.el | 2 +-
lisp/mail/binhex.el | 20 +-
lisp/mail/emacsbug.el | 38 +-
lisp/mail/rmail.el | 2 +-
lisp/mail/rmailsum.el | 11 +-
lisp/mail/uudecode.el | 12 +-
lisp/md4.el | 28 +-
lisp/menu-bar.el | 8 +-
lisp/net/dns.el | 24 +-
lisp/net/imap.el | 12 -
lisp/net/ntlm.el | 44 +-
lisp/net/rcirc.el | 5 +-
lisp/net/sasl.el | 6 +-
lisp/net/shr.el | 11 +-
lisp/net/socks.el | 4 +-
lisp/net/tramp-adb.el | 8 +-
lisp/net/tramp-gvfs.el | 7 +-
lisp/net/tramp-sh.el | 39 +-
lisp/net/tramp-smb.el | 11 +-
lisp/net/tramp.el | 18 +-
lisp/net/trampver.el | 8 +-
lisp/obsolete/levents.el | 2 +-
lisp/obsolete/pgg-parse.el | 26 +-
lisp/org/org-agenda.el | 6 +-
lisp/org/org-element.el | 2 +-
lisp/org/org-footnote.el | 2 +-
lisp/org/org.el | 2 +-
lisp/org/ox-publish.el | 6 +-
lisp/progmodes/cc-cmds.el | 95 ++---
lisp/progmodes/cc-defs.el | 2 +-
lisp/progmodes/cc-engine.el | 13 +-
lisp/progmodes/cc-mode.el | 2 +
lisp/progmodes/ebnf2ps.el | 2 +-
lisp/progmodes/hideif.el | 8 +-
lisp/ps-bdf.el | 4 +-
lisp/ps-print.el | 2 +-
lisp/simple.el | 6 +-
lisp/subr.el | 21 +
lisp/tar-mode.el | 4 +-
lisp/term/common-win.el | 28 +-
lisp/term/tty-colors.el | 20 +-
lisp/term/xterm.el | 2 +-
lisp/textmodes/bibtex.el | 24 +-
lisp/vc/vc-git.el | 4 +-
lisp/vc/vc-hg.el | 17 +-
lisp/window.el | 10 +-
lisp/x-dnd.el | 12 +-
m4/limits-h.m4 | 8 +
m4/stdint.m4 | 5 +-
m4/unistd_h.m4 | 7 +-
nt/addpm.c | 7 +-
src/Makefile.in | 2 +-
src/alloc.c | 111 ++---
src/bignum.c | 256 +++++++++++
src/bignum.h | 70 +++
src/buffer.h | 22 -
src/bytecode.c | 39 +-
src/charset.c | 13 +-
src/coding.c | 2 +-
src/composite.h | 2 +-
src/conf_post.h | 1 +
src/data.c | 565 ++++++++++++------------
src/dbusbind.c | 44 +-
src/decompress.c | 1 +
src/dired.c | 17 +-
src/dispnew.c | 9 +
src/dosfns.c | 12 +-
src/dynlib.c | 5 +-
src/editfns.c | 122 +++---
src/emacs-module.c | 26 +-
src/emacs.c | 35 +-
src/fileio.c | 13 +-
src/floatfns.c | 187 ++++----
src/fns.c | 105 ++++-
src/font.c | 36 +-
src/frame.c | 14 +-
src/frame.h | 10 +-
src/fringe.c | 2 +-
src/gnutls.c | 5 +-
src/image.c | 28 +-
src/inotify.c | 10 +-
src/json.c | 15 +-
src/keyboard.c | 4 +-
src/lcms.c | 19 +-
src/lisp.h | 149 +++----
src/lread.c | 31 +-
src/nsfns.m | 4 +-
src/nsimage.m | 12 +-
src/nsmenu.m | 14 +-
src/nsterm.m | 2 +-
src/print.c | 9 +-
src/process.c | 17 +-
src/syntax.c | 2 +-
src/sysdep.c | 102 ++---
src/w32.c | 239 +++++------
src/w32.h | 13 -
src/w32common.h | 30 ++
src/w32console.c | 30 +-
src/w32fns.c | 67 ++-
src/w32font.c | 9 +-
src/w32heap.c | 6 +-
src/w32inevt.c | 4 +-
src/w32menu.c | 12 +-
src/w32proc.c | 17 +-
src/w32uniscribe.c | 7 +-
src/window.c | 19 +-
src/xdisp.c | 41 +-
src/xfaces.c | 2 +-
src/xfns.c | 4 +-
src/xml.c | 1 +
src/xselect.c | 40 +-
src/xterm.c | 4 +-
test/Makefile.in | 4 +-
test/data/emacs-module/mod-test.c | 19 +
test/lisp/comint-tests.el | 3 +-
test/lisp/international/ccl-tests.el | 21 +-
test/lisp/net/tramp-tests.el | 5 +-
test/src/data-tests.el | 33 +-
test/src/emacs-module-tests.el | 3 +
test/src/floatfns-tests.el | 51 ++-
test/src/fns-tests.el | 21 +
test/src/lread-tests.el | 9 +
188 files changed, 2940 insertions(+), 2399 deletions(-)
diff --git a/admin/unidata/unidata-gen.el b/admin/unidata/unidata-gen.el
index 8cc1893..e520d18 100644
--- a/admin/unidata/unidata-gen.el
+++ b/admin/unidata/unidata-gen.el
@@ -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))
diff --git a/admin/unidata/uvs.el b/admin/unidata/uvs.el
index 6bb6a2a..31840fb 100644
--- a/admin/unidata/uvs.el
+++ b/admin/unidata/uvs.el
@@ -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)
diff --git a/build-aux/config.sub b/build-aux/config.sub
index 97d38aa..49b1673 100755
--- a/build-aux/config.sub
+++ b/build-aux/config.sub
@@ -2,7 +2,7 @@
# Configuration validation subroutine script.
# Copyright 1992-2018 Free Software Foundation, Inc.
-timestamp='2018-07-25'
+timestamp='2018-08-24'
# This file is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by
@@ -149,29 +149,39 @@ case $1 in
esac
;;
*-*)
- # Second component is usually, but not always the OS
- case $field2 in
- # Prevent following clause from handling this valid os
- sun*os*)
- basic_machine=$field1
- os=$field2
- ;;
- # Manufacturers
- dec* | mips* | sequent* | encore* | pc532* | sgi* |
sony* \
- | att* | 7300* | 3300* | delta* | motorola* | sun[234]*
\
- | unicom* | ibm* | next | hp | isi* | apollo | altos* \
- | convergent* | ncr* | news | 32* | 3600* | 3100* |
hitachi* \
- | c[123]* | convex* | sun | crds | omron* | dg | ultra
| tti* \
- | harris | dolphin | highlevel | gould | cbm | ns |
masscomp \
- | apple | axis | knuth | cray | microblaze* \
- | sim | cisco | oki | wec | wrs | winbond)
- basic_machine=$field1-$field2
+ # A lone config we happen to match not fitting any patern
+ case $field1-$field2 in
+ decstation-3100)
+ basic_machine=mips-dec
os=
;;
- *)
- basic_machine=$field1
- os=$field2
- ;;
+ *-*)
+ # Second component is usually, but not always
the OS
+ case $field2 in
+ # Prevent following clause from
handling this valid os
+ sun*os*)
+ basic_machine=$field1
+ os=$field2
+ ;;
+ # Manufacturers
+ dec* | mips* | sequent* | encore* |
pc533* | sgi* | sony* \
+ | att* | 7300* | 3300* | delta* |
motorola* | sun[234]* \
+ | unicom* | ibm* | next | hp | isi* |
apollo | altos* \
+ | convergent* | ncr* | news | 32* |
3600* | 3100* \
+ | hitachi* | c[123]* | convex* | sun |
crds | omron* | dg \
+ | ultra | tti* | harris | dolphin |
highlevel | gould \
+ | cbm | ns | masscomp | apple | axis |
knuth | cray \
+ | microblaze* | sim | cisco \
+ | oki | wec | wrs | winbond)
+ basic_machine=$field1-$field2
+ os=
+ ;;
+ *)
+ basic_machine=$field1
+ os=$field2
+ ;;
+ esac
+ ;;
esac
;;
*)
@@ -190,6 +200,14 @@ case $1 in
basic_machine=m68010-adobe
os=scout
;;
+ alliant)
+ basic_machine=fx80-alliant
+ os=
+ ;;
+ altos | altos3068)
+ basic_machine=m68k-altos
+ os=
+ ;;
am29k)
basic_machine=a29k-none
os=bsd
@@ -198,6 +216,10 @@ case $1 in
basic_machine=580-amdahl
os=sysv
;;
+ amiga)
+ basic_machine=m68k-unknown
+ os=
+ ;;
amigaos | amigados)
basic_machine=m68k-unknown
os=amigaos
@@ -234,13 +256,41 @@ case $1 in
basic_machine=arm-unknown
os=cegcc
;;
+ convex-c1)
+ basic_machine=c1-convex
+ os=bsd
+ ;;
+ convex-c2)
+ basic_machine=c2-convex
+ os=bsd
+ ;;
+ convex-c32)
+ basic_machine=c32-convex
+ os=bsd
+ ;;
+ convex-c34)
+ basic_machine=c34-convex
+ os=bsd
+ ;;
+ convex-c38)
+ basic_machine=c38-convex
+ os=bsd
+ ;;
cray)
basic_machine=j90-cray
os=unicos
;;
- craynv)
- basic_machine=craynv-cray
- os=unicosmp
+ crds | unos)
+ basic_machine=m68k-crds
+ os=
+ ;;
+ da30)
+ basic_machine=m68k-da30
+ os=
+ ;;
+ decstation | pmax | pmin | dec3100 | decstatn)
+ basic_machine=mips-dec
+ os=
;;
delta88)
basic_machine=m88k-motorola
@@ -286,6 +336,9 @@ case $1 in
basic_machine=m88k-harris
os=sysv3
;;
+ hp300)
+ basic_machine=m68k-hp
+ ;;
hp300bsd)
basic_machine=m68k-hp
os=bsd
@@ -454,14 +507,26 @@ case $1 in
basic_machine=mips-sei
os=seiux
;;
+ sequent)
+ basic_machine=i386-sequent
+ os=
+ ;;
sps7)
basic_machine=m68k-bull
os=sysv2
;;
+ st2000)
+ basic_machine=m68k-tandem
+ os=
+ ;;
stratus)
basic_machine=i860-stratus
os=sysv4
;;
+ sun2)
+ basic_machine=m68000-sun
+ os=
+ ;;
sun2os3)
basic_machine=m68000-sun
os=sunos3
@@ -470,6 +535,10 @@ case $1 in
basic_machine=m68000-sun
os=sunos4
;;
+ sun3)
+ basic_machine=m68k-sun
+ os=
+ ;;
sun3os3)
basic_machine=m68k-sun
os=sunos3
@@ -478,6 +547,10 @@ case $1 in
basic_machine=m68k-sun
os=sunos4
;;
+ sun4)
+ basic_machine=sparc-sun
+ os=
+ ;;
sun4os3)
basic_machine=sparc-sun
os=sunos3
@@ -490,6 +563,10 @@ case $1 in
basic_machine=sparc-sun
os=solaris2
;;
+ sun386 | sun386i | roadrunner)
+ basic_machine=i386-sun
+ os=
+ ;;
sv1)
basic_machine=sv1-cray
os=unicos
@@ -564,234 +641,67 @@ esac
# Decode aliases for certain CPU-COMPANY combinations.
case $basic_machine in
- # Recognize the basic CPU types without company name.
- # Some are omitted here because they have special meanings below.
- 1750a | 580 \
- | a29k \
- | aarch64 | aarch64_be \
- | abacus \
- | alpha | alphaev[4-8] | alphaev56 | alphaev6[78] | alphapca5[67] \
- | alpha64 | alpha64ev[4-8] | alpha64ev56 | alpha64ev6[78] |
alpha64pca5[67] \
- | am33_2.0 \
- | arc | arceb \
- | arm | arm[bl]e | arme[lb] | armv[2-8] | armv[3-8][lb] | armv6m |
armv[78][arm] \
- | avr | avr32 \
- | asmjs \
- | ba \
- | be32 | be64 \
- | bfin \
- | c4x | c8051 | clipper | csky \
- | d10v | d30v | dlx | dsp16xx \
- | e2k | epiphany \
- | fido | fr30 | frv | ft32 \
- | h8300 | h8500 | hppa | hppa1.[01] | hppa2.0 | hppa2.0[nw] | hppa64 \
- | hexagon \
- | i370 | i860 | i960 | ia16 | ia64 \
- | ip2k | iq2000 \
- | k1om \
- | le32 | le64 \
- | lm32 \
- | m32c | m32r | m32rle | m68000 | m68k | m88k \
- | maxq | mb | microblaze | microblazeel | mcore | mep | metag \
- | mips | mipsbe | mipseb | mipsel | mipsle \
- | mips16 \
- | mips64 | mips64el \
- | mips64octeon | mips64octeonel \
- | mips64orion | mips64orionel \
- | mips64r5900 | mips64r5900el \
- | mips64vr | mips64vrel \
- | mips64vr4100 | mips64vr4100el \
- | mips64vr4300 | mips64vr4300el \
- | mips64vr5000 | mips64vr5000el \
- | mips64vr5900 | mips64vr5900el \
- | mipsisa32 | mipsisa32el \
- | mipsisa32r2 | mipsisa32r2el \
- | mipsisa32r6 | mipsisa32r6el \
- | mipsisa64 | mipsisa64el \
- | mipsisa64r2 | mipsisa64r2el \
- | mipsisa64r6 | mipsisa64r6el \
- | mipsisa64sb1 | mipsisa64sb1el \
- | mipsisa64sr71k | mipsisa64sr71kel \
- | mipsr5900 | mipsr5900el \
- | mipstx39 | mipstx39el \
- | mn10200 | mn10300 \
- | moxie \
- | mt \
- | msp430 \
- | nds32 | nds32le | nds32be \
- | nfp \
- | nios | nios2 | nios2eb | nios2el \
- | ns16k | ns32k \
- | open8 | or1k | or1knd | or32 \
- | pdp10 | pj | pjl \
- | powerpc | powerpc64 | powerpc64le | powerpcle \
- | pru \
- | pyramid \
- | riscv | riscv32 | riscv64 \
- | rl78 | rx \
- | score \
- | sh | sh[1234] | sh[24]a | sh[24]aeb | sh[23]e | sh[234]eb | sheb |
shbe | shle | sh[1234]le | sh[23]ele \
- | sh64 | sh64le \
- | sparc | sparc64 | sparc64b | sparc64v | sparc86x | sparclet |
sparclite \
- | sparcv8 | sparcv9 | sparcv9b | sparcv9v \
- | spu \
- | tahoe | tic4x | tic54x | tic55x | tic6x | tic80 | tron \
- | ubicom32 \
- | v850 | v850e | v850e1 | v850e2 | v850es | v850e2v3 \
- | visium \
- | wasm32 \
- | x86 | xc16x | xstormy16 | xtensa \
- | z8k | z80)
- basic_machine=$basic_machine-unknown
+ # Here we handle the default manufacturer of certain CPU types. It is
in
+ # some cases the only manufacturer, in others, it is the most popular.
+ craynv)
+ basic_machine=craynv-cray
+ os=${os:-unicosmp}
;;
- c54x)
- basic_machine=tic54x-unknown
+ fx80)
+ basic_machine=fx80-alliant
;;
- c55x)
- basic_machine=tic55x-unknown
+ w89k)
+ basic_machine=hppa1.1-winbond
;;
- c6x)
- basic_machine=tic6x-unknown
+ op50n)
+ basic_machine=hppa1.1-oki
;;
- leon|leon[3-9])
- basic_machine=sparc-$basic_machine
+ op60c)
+ basic_machine=hppa1.1-oki
;;
- m6811-* | m68hc11-* | m6812-* | m68hc12-* | m68hcs12x-* | nvptx-* |
picochip-*)
+ romp)
+ basic_machine=romp-ibm
;;
- m6811 | m68hc11 | m6812 | m68hc12 | m68hcs12x | nvptx | picochip)
- basic_machine=$basic_machine-unknown
+ mmix)
+ basic_machine=mmix-knuth
;;
- m88110 | m680[12346]0 | m683?2 | m68360 | m5200 | v70 | w65)
+ rs6000)
+ basic_machine=rs6000-ibm
;;
- m9s12z | m68hcs12z | hcs12z | s12z)
- basic_machine=s12z-unknown
+ vax)
+ basic_machine=vax-dec
;;
- m9s12z-* | m68hcs12z-* | hcs12z-* | s12z-*)
- basic_machine=s12z-`echo "$basic_machine" | sed 's/^[^-]*-//'`
+ pdp11)
+ basic_machine=pdp11-dec
;;
- ms1)
- basic_machine=mt-unknown
+ we32k)
+ basic_machine=we32k-att
;;
- strongarm | thumb | xscale)
- basic_machine=arm-unknown
+ cydra)
+ basic_machine=cydra-cydrome
;;
- xgate)
- basic_machine=$basic_machine-unknown
+ i370-ibm* | ibm*)
+ basic_machine=i370-ibm
;;
- xgate-*)
+ orion)
+ basic_machine=orion-highlevel
;;
- xscaleeb)
- basic_machine=armeb-unknown
+ orion105)
+ basic_machine=clipper-highlevel
;;
-
- xscaleel)
- basic_machine=armel-unknown
+ mac | mpw | mac-mpw)
+ basic_machine=m68k-apple
+ ;;
+ microblaze | microblazeel)
+ basic_machine=$basic_machine-xilinx
+ ;;
+ pmac | pmac-mpw)
+ basic_machine=powerpc-apple
+ ;;
+ xps | xps100)
+ basic_machine=xps100-honeywell
;;
- # We use `pc' rather than `unknown'
- # because (1) that's what they normally are, and
- # (2) the word "unknown" tends to confuse beginning users.
- i*86 | x86_64)
- basic_machine=$basic_machine-pc
- ;;
- # Recognize the basic CPU types with company name.
- 1750a-* | 580-* \
- | a29k-* \
- | aarch64-* | aarch64_be-* \
- | abacus-* \
- | alpha-* | alphaev[4-8]-* | alphaev56-* | alphaev6[78]-* \
- | alpha64-* | alpha64ev[4-8]-* | alpha64ev56-* | alpha64ev6[78]-* \
- | alphapca5[67]-* | alpha64pca5[67]-* \
- | am33_2.0-* \
- | arc-* | arceb-* \
- | arm-* | arm[lb]e-* | arme[lb]-* | armv*-* \
- | avr-* | avr32-* \
- | asmjs-* \
- | ba-* \
- | be32-* | be64-* \
- | bfin-* | bs2000-* \
- | c[123]* | c30-* | [cjt]90-* | c4x-* \
- | c8051-* | clipper-* | craynv-* | csky-* | cydra-* \
- | d10v-* | d30v-* | dlx-* | dsp16xx-* \
- | e2k-* | elxsi-* | epiphany-* \
- | f30[01]-* | f700-* | fido-* | fr30-* | frv-* | ft32-* | fx80-* \
- | h8300-* | h8500-* \
- | hppa-* | hppa1.[01]-* | hppa2.0-* | hppa2.0[nw]-* | hppa64-* \
- | hexagon-* \
- | i*86-* | i860-* | i960-* | ia16-* | ia64-* \
- | ip2k-* | iq2000-* \
- | k1om-* \
- | le32-* | le64-* \
- | lm32-* \
- | m32c-* | m32r-* | m32rle-* \
- | m5200-* | m68000-* | m680[012346]0-* | m68360-* | m683?2-* | m68k-* |
v70-* | w65-* \
- | m88110-* | m88k-* | maxq-* | mb-* | mcore-* | mep-* | metag-* \
- | microblaze-* | microblazeel-* \
- | mips-* | mipsbe-* | mipseb-* | mipsel-* | mipsle-* \
- | mips16-* \
- | mips64-* | mips64el-* \
- | mips64octeon-* | mips64octeonel-* \
- | mips64orion-* | mips64orionel-* \
- | mips64r5900-* | mips64r5900el-* \
- | mips64vr-* | mips64vrel-* \
- | mips64vr4100-* | mips64vr4100el-* \
- | mips64vr4300-* | mips64vr4300el-* \
- | mips64vr5000-* | mips64vr5000el-* \
- | mips64vr5900-* | mips64vr5900el-* \
- | mipsisa32-* | mipsisa32el-* \
- | mipsisa32r2-* | mipsisa32r2el-* \
- | mipsisa32r6-* | mipsisa32r6el-* \
- | mipsisa64-* | mipsisa64el-* \
- | mipsisa64r2-* | mipsisa64r2el-* \
- | mipsisa64r6-* | mipsisa64r6el-* \
- | mipsisa64sb1-* | mipsisa64sb1el-* \
- | mipsisa64sr71k-* | mipsisa64sr71kel-* \
- | mipsr5900-* | mipsr5900el-* \
- | mipstx39-* | mipstx39el-* \
- | mmix-* \
- | mn10200-* | mn10300-* \
- | moxie-* \
- | mt-* \
- | msp430-* \
- | nds32-* | nds32le-* | nds32be-* \
- | nfp-* \
- | nios-* | nios2-* | nios2eb-* | nios2el-* \
- | none-* | np1-* | ns16k-* | ns32k-* \
- | open8-* \
- | or1k*-* \
- | or32-* \
- | orion-* \
- | pdp10-* | pdp11-* | pj-* | pjl-* | pn-* | power-* \
- | powerpc-* | powerpc64-* | powerpc64le-* | powerpcle-* \
- | pru-* \
- | pyramid-* \
- | riscv-* | riscv32-* | riscv64-* \
- | rl78-* | romp-* | rs6000-* | rx-* \
- | score-* \
- | sh-* | sh[1234]-* | sh[24]a-* | sh[24]ae[lb]-* | sh[23]e-* |
she[lb]-* | sh[lb]e-* \
- | sh[1234]e[lb]-* | sh[12345][lb]e-* | sh[23]ele-* | sh64-* | sh64le-*
\
- | sparc-* | sparc64-* | sparc64b-* | sparc64v-* | sparc86x-* |
sparclet-* \
- | sparclite-* \
- | sparcv8-* | sparcv9-* | sparcv9b-* | sparcv9v-* | sv1-* | sx*-* \
- | spu-* \
- | tahoe-* \
- | tic30-* | tic4x-* | tic54x-* | tic55x-* | tic6x-* | tic80-* \
- | tron-* \
- | ubicom32-* \
- | v850-* | v850e-* | v850e1-* | v850es-* | v850e2-* | v850e2v3-* \
- | vax-* \
- | visium-* \
- | wasm32-* \
- | we32k-* \
- | x86-* | x86_64-* | xc16x-* | xps100-* \
- | xstormy16-* | xtensa*-* \
- | ymp-* \
- | z8k-* | z80-*)
- ;;
- # Recognize the basic CPU types without company name, with glob match.
- xtensa*)
- basic_machine=$basic_machine-unknown
- ;;
# Recognize the various machine names and aliases which stand
# for a CPU type and a company and sometimes even an OS.
3b1 | 7300 | 7300-att | att-7300 | pc7300 | safari | unixpc)
@@ -800,21 +710,6 @@ case $basic_machine in
3b*)
basic_machine=we32k-att
;;
- alliant | fx80)
- basic_machine=fx80-alliant
- ;;
- altos | altos3068)
- basic_machine=m68k-altos
- ;;
- amd64)
- basic_machine=x86_64-pc
- ;;
- amd64-*)
- basic_machine=x86_64-`echo "$basic_machine" | sed 's/^[^-]*-//'`
- ;;
- amiga | amiga-*)
- basic_machine=m68k-unknown
- ;;
blackfin-*)
basic_machine=bfin-`echo "$basic_machine" | sed 's/^[^-]*-//'`
os=linux
@@ -836,49 +731,6 @@ case $basic_machine in
basic_machine=c90-cray
os=${os:-unicos}
;;
- convex-c1)
- basic_machine=c1-convex
- os=bsd
- ;;
- convex-c2)
- basic_machine=c2-convex
- os=bsd
- ;;
- convex-c32)
- basic_machine=c32-convex
- os=bsd
- ;;
- convex-c34)
- basic_machine=c34-convex
- os=bsd
- ;;
- convex-c38)
- basic_machine=c38-convex
- os=bsd
- ;;
- cr16 | cr16-*)
- basic_machine=cr16-unknown
- os=${os:-elf}
- ;;
- crds | unos)
- basic_machine=m68k-crds
- ;;
- crisv32 | crisv32-* | etraxfs*)
- basic_machine=crisv32-axis
- ;;
- cris | cris-* | etrax*)
- basic_machine=cris-axis
- ;;
- crx)
- basic_machine=crx-unknown
- os=${os:-elf}
- ;;
- da30 | da30-*)
- basic_machine=m68k-da30
- ;;
- decstation | decstation-3100 | pmax | pmax-* | pmin | dec3100 |
decstatn)
- basic_machine=mips-dec
- ;;
decsystem10* | dec10*)
basic_machine=pdp10-dec
os=tops10
@@ -924,9 +776,6 @@ case $basic_machine in
basic_machine=hppa1.1-hitachi
os=hiuxwe2
;;
- hp300-*)
- basic_machine=m68k-hp
- ;;
hp3k9[0-9][0-9] | hp9[0-9][0-9])
basic_machine=hppa1.0-hp
;;
@@ -956,9 +805,6 @@ case $basic_machine in
hp9k8[0-9][0-9] | hp8[0-9][0-9])
basic_machine=hppa1.0-hp
;;
- i370-ibm* | ibm*)
- basic_machine=i370-ibm
- ;;
i*86v32)
basic_machine=`echo "$1" | sed -e 's/86.*/86-pc/'`
os=sysv32
@@ -996,9 +842,6 @@ case $basic_machine in
basic_machine=m68k-`echo "$basic_machine" | sed 's/^[^-]*-//'`
os=linux
;;
- microblaze*)
- basic_machine=microblaze-xilinx
- ;;
miniframe)
basic_machine=m68000-convergent
;;
@@ -1035,21 +878,6 @@ case $basic_machine in
np1)
basic_machine=np1-gould
;;
- neo-tandem)
- basic_machine=neo-tandem
- ;;
- nse-tandem)
- basic_machine=nse-tandem
- ;;
- nsr-tandem)
- basic_machine=nsr-tandem
- ;;
- nsv-tandem)
- basic_machine=nsv-tandem
- ;;
- nsx-tandem)
- basic_machine=nsx-tandem
- ;;
op50n-* | op60c-*)
basic_machine=hppa1.1-oki
os=proelf
@@ -1074,9 +902,6 @@ case $basic_machine in
pc532 | pc532-*)
basic_machine=ns32k-pc532
;;
- pc98)
- basic_machine=i386-pc
- ;;
pc98-*)
basic_machine=i386-`echo "$basic_machine" | sed 's/^[^-]*-//'`
;;
@@ -1139,12 +964,6 @@ case $basic_machine in
rtpc | rtpc-*)
basic_machine=romp-ibm
;;
- s390 | s390-*)
- basic_machine=s390-ibm
- ;;
- s390x | s390x-*)
- basic_machine=s390x-ibm
- ;;
sb1)
basic_machine=mipsisa64sb1-unknown
;;
@@ -1155,9 +974,6 @@ case $basic_machine in
basic_machine=mipsisa32-sde
os=${os:-elf}
;;
- sequent)
- basic_machine=i386-sequent
- ;;
sh5el)
basic_machine=sh5le-unknown
;;
@@ -1171,30 +987,9 @@ case $basic_machine in
spur)
basic_machine=spur-unknown
;;
- st2000)
- basic_machine=m68k-tandem
- ;;
strongarm-* | thumb-*)
basic_machine=arm-`echo "$basic_machine" | sed 's/^[^-]*-//'`
;;
- sun2)
- basic_machine=m68000-sun
- ;;
- sun3 | sun3-*)
- basic_machine=m68k-sun
- ;;
- sun4)
- basic_machine=sparc-sun
- ;;
- sun386 | sun386i | roadrunner)
- basic_machine=i386-sun
- ;;
- tile*-*)
- ;;
- tile*)
- basic_machine=$basic_machine-unknown
- os=${os:-linux-gnu}
- ;;
tx39)
basic_machine=mipstx39-unknown
;;
@@ -1207,20 +1002,13 @@ case $basic_machine in
vpp*|vx|vx-*)
basic_machine=f301-fujitsu
;;
- w65*)
+ w65)
basic_machine=w65-wdc
- os=none
;;
w89k-*)
basic_machine=hppa1.1-winbond
os=proelf
;;
- x64)
- basic_machine=x86_64-pc
- ;;
- xps | xps100)
- basic_machine=xps100-honeywell
- ;;
xscale-* | xscalee[bl]-*)
basic_machine=`echo "$basic_machine" | sed 's/^xscale/arm/'`
;;
@@ -1228,50 +1016,288 @@ case $basic_machine in
basic_machine=none-none
;;
-# Here we handle the default manufacturer of certain CPU types. It is in
-# some cases the only manufacturer, in others, it is the most popular.
- w89k)
- basic_machine=hppa1.1-winbond
+ c54x)
+ basic_machine=tic54x-unknown
;;
- op50n)
- basic_machine=hppa1.1-oki
+ c55x)
+ basic_machine=tic55x-unknown
;;
- op60c)
- basic_machine=hppa1.1-oki
+ c6x)
+ basic_machine=tic6x-unknown
;;
- romp)
- basic_machine=romp-ibm
+ leon | leon[3-9])
+ basic_machine=sparc-$basic_machine
;;
- mmix)
- basic_machine=mmix-knuth
+ m88110 | m680[12346]0 | m683?2 | m68360 | m5200 | v70)
;;
- rs6000)
- basic_machine=rs6000-ibm
+ ms1)
+ basic_machine=mt-unknown
;;
- vax)
- basic_machine=vax-dec
+ strongarm | thumb | xscale)
+ basic_machine=arm-unknown
;;
- pdp11)
- basic_machine=pdp11-dec
+ xscaleeb)
+ basic_machine=armeb-unknown
;;
- we32k)
- basic_machine=we32k-att
+
+ xscaleel)
+ basic_machine=armel-unknown
;;
- cydra)
- basic_machine=cydra-cydrome
+
+ # We use `pc' rather than `unknown'
+ # because (1) that's what they normally are, and
+ # (2) the word "unknown" tends to confuse beginning users.
+ i*86 | x86_64)
+ basic_machine=$basic_machine-pc
;;
- orion)
- basic_machine=orion-highlevel
+ # These rules are duplicated from below for sake of the special case
above;
+ # i.e. things that normalized to x86 arches should also default to "pc"
+ pc98)
+ basic_machine=i386-pc
;;
- orion105)
- basic_machine=clipper-highlevel
+ x64 | amd64)
+ basic_machine=x86_64-pc
;;
- mac | mpw | mac-mpw)
- basic_machine=m68k-apple
+
+ # Recognize the cannonical CPU Types that limit and/or modify the
+ # company names they are paired with.
+ amd64-*)
+ basic_machine=x86_64-`echo "$basic_machine" | sed 's/^[^-]*-//'`
;;
- pmac | pmac-mpw)
- basic_machine=powerpc-apple
+ cr16)
+ basic_machine=cr16-unknown
+ os=${os:-elf}
+ ;;
+ cr16-*)
+ os=${os:-elf}
+ ;;
+ crisv32 | crisv32-* | etraxfs*)
+ basic_machine=crisv32-axis
+ ;;
+ cris | cris-* | etrax*)
+ basic_machine=cris-axis
+ ;;
+ crx-*)
+ os=${os:-elf}
+ ;;
+ crx)
+ basic_machine=crx-unknown
+ os=${os:-elf}
+ ;;
+ m9s12z | m68hcs12z | hcs12z | s12z)
+ basic_machine=s12z-unknown
+ ;;
+ m9s12z-* | m68hcs12z-* | hcs12z-* | s12z-*)
+ basic_machine=s12z-`echo "$basic_machine" | sed 's/^[^-]*-//'`
+ ;;
+ neo-tandem)
+ basic_machine=neo-tandem
+ ;;
+ nse-tandem)
+ basic_machine=nse-tandem
+ ;;
+ nsr-tandem)
+ basic_machine=nsr-tandem
;;
+ nsv-tandem)
+ basic_machine=nsv-tandem
+ ;;
+ nsx-tandem)
+ basic_machine=nsx-tandem
+ ;;
+ s390 | s390-*)
+ basic_machine=s390-ibm
+ ;;
+ s390x | s390x-*)
+ basic_machine=s390x-ibm
+ ;;
+ tile*-*)
+ os=${os:-linux-gnu}
+ ;;
+ tile*)
+ basic_machine=$basic_machine-unknown
+ os=${os:-linux-gnu}
+ ;;
+
+ # Recognize the cannonical CPU types that are allowed with any
+ # company name.
+ 1750a-* | 580-* \
+ | a29k-* \
+ | aarch64-* | aarch64_be-* \
+ | abacus-* \
+ | alpha-* | alphaev[4-8]-* | alphaev56-* | alphaev6[78]-* \
+ | alpha64-* | alpha64ev[4-8]-* | alpha64ev56-* | alpha64ev6[78]-* \
+ | alphapca5[67]-* | alpha64pca5[67]-* \
+ | am33_2.0-* \
+ | arc-* | arceb-* \
+ | arm-* | arm[lb]e-* | arme[lb]-* | armv*-* \
+ | avr-* | avr32-* \
+ | asmjs-* \
+ | ba-* \
+ | be32-* | be64-* \
+ | bfin-* | bs2000-* \
+ | c[123]* | c30-* | [cjt]90-* | c4x-* \
+ | c8051-* | clipper-* | craynv-* | csky-* | cydra-* \
+ | d10v-* | d30v-* | dlx-* | dsp16xx-* \
+ | e2k-* | elxsi-* | epiphany-* \
+ | f30[01]-* | f700-* | fido-* | fr30-* | frv-* | ft32-* | fx80-* \
+ | h8300-* | h8500-* \
+ | hppa-* | hppa1.[01]-* | hppa2.0-* | hppa2.0[nw]-* | hppa64-* \
+ | hexagon-* \
+ | i370-* | i*86-* | i860-* | i960-* | ia16-* | ia64-* \
+ | ip2k-* | iq2000-* \
+ | k1om-* \
+ | le32-* | le64-* \
+ | lm32-* \
+ | m32c-* | m32r-* | m32rle-* \
+ | m5200-* | m68000-* | m680[012346]0-* | m68360-* | m683?2-* | m68k-* |
v70-* | w65-* \
+ | m6811-* | m68hc11-* | m6812-* | m68hc12-* | m68hcs12x-* | nvptx-* |
picochip-* \
+ | m88110-* | m88k-* | maxq-* | mb-* | mcore-* | mep-* | metag-* \
+ | microblaze-* | microblazeel-* \
+ | mips-* | mipsbe-* | mipseb-* | mipsel-* | mipsle-* \
+ | mips16-* \
+ | mips64-* | mips64el-* \
+ | mips64octeon-* | mips64octeonel-* \
+ | mips64orion-* | mips64orionel-* \
+ | mips64r5900-* | mips64r5900el-* \
+ | mips64vr-* | mips64vrel-* \
+ | mips64vr4100-* | mips64vr4100el-* \
+ | mips64vr4300-* | mips64vr4300el-* \
+ | mips64vr5000-* | mips64vr5000el-* \
+ | mips64vr5900-* | mips64vr5900el-* \
+ | mipsisa32-* | mipsisa32el-* \
+ | mipsisa32r2-* | mipsisa32r2el-* \
+ | mipsisa32r6-* | mipsisa32r6el-* \
+ | mipsisa64-* | mipsisa64el-* \
+ | mipsisa64r2-* | mipsisa64r2el-* \
+ | mipsisa64r6-* | mipsisa64r6el-* \
+ | mipsisa64sb1-* | mipsisa64sb1el-* \
+ | mipsisa64sr71k-* | mipsisa64sr71kel-* \
+ | mipsr5900-* | mipsr5900el-* \
+ | mipstx39-* | mipstx39el-* \
+ | mmix-* \
+ | mn10200-* | mn10300-* \
+ | moxie-* \
+ | mt-* \
+ | msp430-* \
+ | nds32-* | nds32le-* | nds32be-* \
+ | nfp-* \
+ | nios-* | nios2-* | nios2eb-* | nios2el-* \
+ | none-* | np1-* | ns16k-* | ns32k-* \
+ | open8-* \
+ | or1k*-* \
+ | or32-* \
+ | orion-* \
+ | pdp10-* | pdp11-* | pj-* | pjl-* | pn-* | power-* \
+ | powerpc-* | powerpc64-* | powerpc64le-* | powerpcle-* | powerpcspe-* \
+ | pru-* \
+ | pyramid-* \
+ | riscv-* | riscv32-* | riscv64-* \
+ | rl78-* | romp-* | rs6000-* | rx-* \
+ | score-* \
+ | sh-* | sh[1234]-* | sh[24]a-* | sh[24]ae[lb]-* | sh[23]e-* |
she[lb]-* | sh[lb]e-* \
+ | sh[1234]e[lb]-* | sh[12345][lb]e-* | sh[23]ele-* | sh64-* | sh64le-*
\
+ | sparc-* | sparc64-* | sparc64b-* | sparc64v-* | sparc86x-* |
sparclet-* \
+ | sparclite-* \
+ | sparcv8-* | sparcv9-* | sparcv9b-* | sparcv9v-* | sv1-* | sx*-* \
+ | spu-* \
+ | tahoe-* \
+ | tic30-* | tic4x-* | tic54x-* | tic55x-* | tic6x-* | tic80-* \
+ | tron-* \
+ | ubicom32-* \
+ | v850-* | v850e-* | v850e1-* | v850es-* | v850e2-* | v850e2v3-* \
+ | vax-* \
+ | visium-* \
+ | wasm32-* \
+ | we32k-* \
+ | x86-* | x86_64-* | xc16x-* | xgate-* | xps100-* \
+ | xstormy16-* | xtensa*-* \
+ | ymp-* \
+ | z8k-* | z80-*)
+ ;;
+
+ # Recognize the basic CPU types without company name.
+ # Some are omitted here because they have special meanings below.
+ 1750a | 580 \
+ | a29k \
+ | aarch64 | aarch64_be \
+ | abacus \
+ | alpha | alphaev[4-8] | alphaev56 | alphaev6[78] | alphapca5[67] \
+ | alpha64 | alpha64ev[4-8] | alpha64ev56 | alpha64ev6[78] |
alpha64pca5[67] \
+ | am33_2.0 \
+ | arc | arceb \
+ | arm | arm[bl]e | arme[lb] | armv[2-8] | armv[3-8][lb] | armv6m |
armv[78][arm] \
+ | avr | avr32 \
+ | asmjs \
+ | ba \
+ | be32 | be64 \
+ | bfin \
+ | c4x | c8051 | clipper | csky \
+ | d10v | d30v | dlx | dsp16xx \
+ | e2k | epiphany \
+ | fido | fr30 | frv | ft32 \
+ | h8300 | h8500 | hppa | hppa1.[01] | hppa2.0 | hppa2.0[nw] | hppa64 \
+ | hexagon \
+ | i370 | i860 | i960 | ia16 | ia64 \
+ | ip2k | iq2000 \
+ | k1om \
+ | le32 | le64 \
+ | lm32 \
+ | m32c | m32r | m32rle | m68000 | m68k | m88k \
+ | m6811 | m68hc11 | m6812 | m68hc12 | m68hcs12x | nvptx | picochip \
+ | maxq | mb | mcore | mep | metag \
+ | mips | mipsbe | mipseb | mipsel | mipsle \
+ | mips16 \
+ | mips64 | mips64el \
+ | mips64octeon | mips64octeonel \
+ | mips64orion | mips64orionel \
+ | mips64r5900 | mips64r5900el \
+ | mips64vr | mips64vrel \
+ | mips64vr4100 | mips64vr4100el \
+ | mips64vr4300 | mips64vr4300el \
+ | mips64vr5000 | mips64vr5000el \
+ | mips64vr5900 | mips64vr5900el \
+ | mipsisa32 | mipsisa32el \
+ | mipsisa32r2 | mipsisa32r2el \
+ | mipsisa32r6 | mipsisa32r6el \
+ | mipsisa64 | mipsisa64el \
+ | mipsisa64r2 | mipsisa64r2el \
+ | mipsisa64r6 | mipsisa64r6el \
+ | mipsisa64sb1 | mipsisa64sb1el \
+ | mipsisa64sr71k | mipsisa64sr71kel \
+ | mipsr5900 | mipsr5900el \
+ | mipstx39 | mipstx39el \
+ | mn10200 | mn10300 \
+ | moxie \
+ | mt \
+ | msp430 \
+ | nds32 | nds32le | nds32be \
+ | nfp \
+ | nios | nios2 | nios2eb | nios2el \
+ | ns16k | ns32k \
+ | open8 | or1k | or1knd | or32 \
+ | pdp10 | pj | pjl \
+ | powerpc | powerpc64 | powerpc64le | powerpcle | powerpcspe \
+ | pru \
+ | pyramid \
+ | riscv | riscv32 | riscv64 \
+ | rl78 | rx \
+ | score \
+ | sh | sh[1234] | sh[24]a | sh[24]aeb | sh[23]e | sh[234]eb | sheb |
shbe | shle | sh[1234]le | sh[23]ele \
+ | sh64 | sh64le \
+ | sparc | sparc64 | sparc64b | sparc64v | sparc86x | sparclet |
sparclite \
+ | sparcv8 | sparcv9 | sparcv9b | sparcv9v \
+ | spu \
+ | tahoe | tic4x | tic54x | tic55x | tic6x | tic80 | tron \
+ | ubicom32 \
+ | v850 | v850e | v850e1 | v850e2 | v850es | v850e2v3 \
+ | visium \
+ | wasm32 \
+ | x86 | xc16x | xstormy16 | xgate | xtensa* \
+ | z8k | z80)
+ basic_machine=$basic_machine-unknown
+ ;;
+
*)
echo Invalid configuration \`"$1"\': machine
\`"$basic_machine"\' not recognized 1>&2
exit 1
diff --git a/configure.ac b/configure.ac
index e5d094c..31750ef 100644
--- a/configure.ac
+++ b/configure.ac
@@ -2516,11 +2516,15 @@ if test "${HAVE_X11}" = "yes" || test "${HAVE_NS}" =
"yes" || test "${HAVE_W32}"
export PKG_CONFIG_PATH="$PKG_CONFIG_PATH$PATH_SEPARATOR`$BREW --prefix
address@hidden 2>/dev/null`/lib/pkgconfig"
fi
- ## 6.3.5 is the earliest version known to work; see Bug#17339.
- ## 6.8.2 makes Emacs crash; see Bug#13867.
- ## 7 and later have not been ported to; See Bug#25967.
- IMAGEMAGICK_MODULE="Wand >= 6.3.5 Wand != 6.8.2 Wand < 7"
- EMACS_CHECK_MODULES([IMAGEMAGICK], [$IMAGEMAGICK_MODULE])
+ EMACS_CHECK_MODULES([IMAGEMAGICK7], [MagickWand >= 7])
+ if test $HAVE_IMAGEMAGICK7 = yes; then
+ AC_DEFINE([HAVE_IMAGEMAGICK7], 1, [Define to 1 if using ImageMagick7.])
+ HAVE_IMAGEMAGICK = yes
+ else
+ ## 6.3.5 is the earliest version known to work; see Bug#17339.
+ ## 6.8.2 makes Emacs crash; see Bug#13867.
+ EMACS_CHECK_MODULES([IMAGEMAGICK], [Wand >= 6.3.5 Wand != 6.8.2])
+ fi
if test $HAVE_IMAGEMAGICK = yes; then
OLD_CFLAGS=$CFLAGS
@@ -2540,6 +2544,8 @@ if test "${HAVE_X11}" = "yes" || test "${HAVE_NS}" =
"yes" || test "${HAVE_W32}"
fi
if test $HAVE_IMAGEMAGICK = yes; then
AC_DEFINE([HAVE_IMAGEMAGICK], 1, [Define to 1 if using ImageMagick.])
+ AC_DEFINE_UNQUOTED([IMAGEMAGICK_MAJOR], [$IMAGEMAGICK_MAJOR],
+ [ImageMagick major version number (from configure).])
else
IMAGEMAGICK_CFLAGS=
IMAGEMAGICK_LIBS=
@@ -5460,7 +5466,7 @@ AS_ECHO([" Does Emacs use -lXaw3d?
${HAVE_XAW3D
Does Emacs use -lrsvg-2? ${HAVE_RSVG}
Does Emacs use cairo? ${HAVE_CAIRO}
Does Emacs use -llcms2? ${HAVE_LCMS2}
- Does Emacs use imagemagick (version 6)? ${HAVE_IMAGEMAGICK}
+ Does Emacs use imagemagick? ${HAVE_IMAGEMAGICK}
Does Emacs support sound? ${HAVE_SOUND}
Does Emacs use -lgpm? ${HAVE_GPM}
Does Emacs use -ldbus? ${HAVE_DBUS}
diff --git a/doc/emacs/trouble.texi b/doc/emacs/trouble.texi
index 37a7304..bb05378 100644
--- a/doc/emacs/trouble.texi
+++ b/doc/emacs/trouble.texi
@@ -1162,11 +1162,11 @@ name that indicates whether it is the old version or
your new changed
one.
@item
-Write the change log entries for your changes. This is both to save us
+Write the commit log entries for your changes. This is both to save us
the extra work of writing them, and to help explain your changes so we
can understand them.
-The purpose of the change log is to show people where to find what was
+The purpose of the commit log is to show people where to find what was
changed. So you need to be specific about what functions you changed;
in large functions, it's often helpful to indicate where within the
function the change was.
@@ -1177,9 +1177,9 @@ new function, all you need to say about it is that it is
new. If you
feel that the purpose needs explaining, it probably does---but put the
explanation in comments in the code. It will be more useful there.
-Please look at the change log entries of recent commits to see what
-sorts of information to put in, and to learn the style that we use. Note that,
-unlike some other projects, we do require change logs for
+Please look at the commit log entries of recent commits to see what
+sorts of information to put in, and to learn the style that we use.
+Note that, unlike some other projects, we do require commit logs for
documentation, i.e., Texinfo files.
@xref{Change Log},
@ifset WWW_GNU_ORG
diff --git a/doc/lispref/errors.texi b/doc/lispref/errors.texi
index a0e32c5..e61ea98 100644
--- a/doc/lispref/errors.texi
+++ b/doc/lispref/errors.texi
@@ -159,6 +159,11 @@ The message is @samp{No catch for tag}. @xref{Catch and
Throw}.
The message is @samp{Attempt to modify a protected file}.
@end ignore
address@hidden range-error
+The message is @code{Arithmetic range error}.
+This can happen with integers exceeding the @code{integer-width} limit.
address@hidden Basics}.
+
@item scan-error
The message is @samp{Scan error}. This happens when certain
syntax-parsing functions find invalid syntax or mismatched
@@ -223,9 +228,6 @@ The message is @samp{Arithmetic domain error}.
The message is @samp{Arithmetic overflow error}. This is a subcategory
of @code{domain-error}.
address@hidden range-error
-The message is @code{Arithmetic range error}.
-
@item singularity-error
The message is @samp{Arithmetic singularity error}. This is a
subcategory of @code{domain-error}.
diff --git a/doc/lispref/files.texi b/doc/lispref/files.texi
index 200e7ab..674ac82 100644
--- a/doc/lispref/files.texi
+++ b/doc/lispref/files.texi
@@ -1347,8 +1347,7 @@ other information recorded in the filesystem for the
file, beyond the
file's contents.
@item
-The size of the file in bytes (@code{file-attribute-size}). This is
-floating point if the size is too large to fit in a Lisp integer.
+The size of the file in bytes (@code{file-attribute-size}).
@item
The file's modes, as a string of ten letters or dashes, as in
@@ -1358,21 +1357,12 @@ The file's modes, as a string of ten letters or dashes,
as in
An unspecified value, present for backward compatibility.
@item
-The file's inode number (@code{file-attribute-inode-number}). If
-possible, this is an integer. If the inode number is too large to be
-represented as an integer in Emacs Lisp but dividing it by
address@hidden yields a representable integer, then the value has the
-form @code{(@var{high} . @var{low})}, where @var{low} holds the low 16
-bits. If the inode number is too wide for even that, the value is of
-the form @code{(@var{high} @var{middle} . @var{low})}, where
address@hidden holds the high bits, @var{middle} the middle 24 bits, and
address@hidden the low 16 bits.
+The file's inode number (@code{file-attribute-inode-number}).
@item
The filesystem number of the device that the file is on
address@hidden). Depending on the magnitude of
-the value, this can be either an integer or a cons cell, in the same
-manner as the inode number. This element and the file's inode number
address@hidden).
+This element and the file's inode number
together give enough information to distinguish any two files on the
system---no two files can have the same values for both of these
numbers.
@@ -1388,8 +1378,8 @@ For example, here are the file attributes for
@file{files.texi}:
(20000 23 0 0)
(20614 64555 902289 872000)
122295 "-rw-rw-rw-"
- t (5888 2 . 43978)
- (15479 . 46724))
+ t 6473924464520138
+ 1014478468)
@end group
@end example
@@ -1430,10 +1420,10 @@ has a mode of read and write access for the owner,
group, and world.
@item t
is merely a placeholder; it carries no information.
address@hidden (5888 2 . 43978)
address@hidden 6473924464520138
has an inode number of 6473924464520138.
address@hidden (15479 . 46724)
address@hidden 1014478468
is on the file-system device whose number is 1014478468.
@end table
@end defun
diff --git a/doc/lispref/hash.texi b/doc/lispref/hash.texi
index f7d33ea..9c4b56d 100644
--- a/doc/lispref/hash.texi
+++ b/doc/lispref/hash.texi
@@ -300,8 +300,8 @@ the same integer.
@defun sxhash-eql obj
This function returns a hash code for Lisp object @var{obj} suitable
for @code{eql} comparison. I.e. it reflects identity of @var{obj}
-except for the case where the object is a float number, in which case
-hash code is generated for the value.
+except for the case where the object is a bignum or a float number,
+in which case a hash code is generated for the value.
If two objects @var{obj1} and @var{obj2} are @code{eql}, then
@code{(sxhash-eql @var{obj1})} and @code{(sxhash-eql @var{obj2})} are
diff --git a/doc/lispref/keymaps.texi b/doc/lispref/keymaps.texi
index cc2e11e..38e89c6 100644
--- a/doc/lispref/keymaps.texi
+++ b/doc/lispref/keymaps.texi
@@ -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))))))
diff --git a/doc/lispref/nonascii.texi b/doc/lispref/nonascii.texi
index 4d75d6a..9fb5587 100644
--- a/doc/lispref/nonascii.texi
+++ b/doc/lispref/nonascii.texi
@@ -829,18 +829,18 @@ two functions support these conversions.
This function decodes a character that is assigned a @var{code-point}
in @var{charset}, to the corresponding Emacs character, and returns
it. If @var{charset} doesn't contain a character of that code point,
-the value is @code{nil}. If @var{code-point} doesn't fit in a Lisp
-integer (@pxref{Integer Basics, most-positive-fixnum}), it can be
+the value is @code{nil}.
+
+For backward compatibility, if @var{code-point} doesn't fit in a Lisp
+fixnum (@pxref{Integer Basics, most-positive-fixnum}), it can be
specified as a cons cell @code{(@var{high} . @var{low})}, where
@var{low} are the lower 16 bits of the value and @var{high} are the
-high 16 bits.
+high 16 bits. This usage is obsolescent.
@end defun
@defun encode-char char charset
This function returns the code point assigned to the character
address@hidden in @var{charset}. If the result does not fit in a Lisp
-integer, it is returned as a cons cell @code{(@var{high} . @var{low})}
-that fits the second argument of @code{decode-char} above. If
address@hidden in @var{charset}. If
@var{charset} doesn't have a codepoint for @var{char}, the value is
@code{nil}.
@end defun
diff --git a/doc/lispref/numbers.texi b/doc/lispref/numbers.texi
index bd633b7..d031136 100644
--- a/doc/lispref/numbers.texi
+++ b/doc/lispref/numbers.texi
@@ -34,13 +34,21 @@ numbers have a fixed amount of precision.
@node Integer Basics
@section Integer Basics
- Integers in Emacs Lisp can have arbitrary precision.
+ Integers in Emacs Lisp are not limited to the machine word size.
Under the hood, though, there are two kinds of integers: smaller
-ones, called @dfn{fixnums}, and larger ones, called @dfn{bignums}
-Some functions in Emacs only accept fixnums. Also, while fixnums can
-always be compared for equality with @code{eq}, bignums require the
-use of @code{eql}.
+ones, called @dfn{fixnums}, and larger ones, called @dfn{bignums}.
+Some functions in Emacs accept only fixnums. Also, while fixnums can
+always be compared for numeric equality with @code{eq}, bignums
+require more-heavyweight equality predicates like @code{eql}.
+
+ The range of values for bignums is limited by the amount of main
+memory, by machine characteristics such as the size of the word used
+to represent a bignum's exponent, and by the @code{integer-width}
+variable. These limits are typically much more generous than the
+limits for fixnums. A bignum is never numerically equal to a fixnum;
+if Emacs computes an integer in fixnum range, it represents the
+integer as a fixnum, not a bignum.
The range of values for a fixnum depends on the machine. The
minimum range is @minus{}536,870,912 to 536,870,911 (30 bits; i.e.,
@@ -97,33 +105,30 @@ For example:
#24r1k @result{} 44
@end example
- An integer is read as a fixnum if it is in the correct range.
-Otherwise, it will be read as a bignum.
-
To understand how various functions work on integers, especially the
bitwise operators (@pxref{Bitwise Operations}), it is often helpful to
view the numbers in their binary form.
- In 30-bit binary, the decimal integer 5 looks like this:
+ In binary, the decimal integer 5 looks like this:
@example
-0000...000101 (30 bits total)
address@hidden
@end example
@noindent
-(The @samp{...} stands for enough bits to fill out a 30-bit word; in
-this case, @samp{...} stands for twenty 0 bits. Later examples also
-use the @samp{...} notation to make binary integers easier to read.)
+(The ellipsis @address@hidden stands for a conceptually infinite number
+of bits that match the leading bit; here, an infinite number of 0
+bits. Later examples also use this @address@hidden notation.)
The integer @minus{}1 looks like this:
@example
-1111...111111 (30 bits total)
address@hidden
@end example
@noindent
@cindex two's complement
address@hidden is represented as 30 ones. (This is called @dfn{two's
address@hidden is represented as all ones. (This is called @dfn{two's
complement} notation.)
Subtracting 4 from @minus{}1 returns the negative integer @minus{}5.
@@ -131,14 +136,7 @@ In binary, the decimal integer 4 is 100. Consequently,
@minus{}5 looks like this:
@example
-1111...111011 (30 bits total)
address@hidden example
-
- In this implementation, the largest 30-bit binary integer is
-536,870,911 in decimal. In binary, it looks like this:
-
address@hidden
-0111...111111 (30 bits total)
address@hidden
@end example
Many of the functions described in this chapter accept markers for
@@ -147,10 +145,10 @@ arguments to such functions may be either numbers or
markers, we often
give these arguments the name @var{number-or-marker}. When the argument
value is a marker, its position value is used and its buffer is ignored.
address@hidden largest Lisp integer
address@hidden maximum Lisp integer
address@hidden largest fixnum
address@hidden maximum fixnum
@defvar most-positive-fixnum
-The value of this variable is the largest ``small'' integer that Emacs
+The value of this variable is the greatest ``small'' integer that Emacs
Lisp can handle. Typical values are
@ifnottex
2**29 @minus{} 1
@@ -168,11 +166,11 @@ on 32-bit and
on 64-bit platforms.
@end defvar
address@hidden smallest Lisp integer
address@hidden minimum Lisp integer
address@hidden smallest fixnum
address@hidden minimum fixnum
@defvar most-negative-fixnum
-The value of this variable is the smallest small integer that Emacs
-Lisp can handle. It is negative. Typical values are
+The value of this variable is the numerically least ``small'' integer
+that Emacs Lisp can handle. It is negative. Typical values are
@ifnottex
@minus{}2**29
@end ifnottex
@@ -189,6 +187,26 @@ on 32-bit and
on 64-bit platforms.
@end defvar
address@hidden bignum range
address@hidden integer range
address@hidden number of bignum bits, limit on
address@hidden integer-width
+The value of this variable is a nonnegative integer that is an upper
+bound on the number of bits in a bignum. Integers outside the fixnum
+range are limited to absolute values less than
address@hidden
address@hidden,
address@hidden ifnottex
address@hidden
address@hidden,
address@hidden tex
+where @var{n} is this variable's value. Attempts to create bignums outside
+this range signal a range error. Setting this variable
+to zero disables creation of bignums; setting it to a large number can
+cause Emacs to consume large quantities of memory if a computation
+creates huge integers.
address@hidden defvar
+
In Emacs Lisp, text characters are represented by integers. Any
integer between zero and the value of @code{(max-char)}, inclusive, is
considered to be valid as a character. @xref{Character Codes}.
@@ -378,17 +396,17 @@ comparison, and sometimes returns @code{t} when a
non-numeric
comparison would return @code{nil} and vice versa. @xref{Float
Basics}.
- In Emacs Lisp, each small integer is a unique Lisp object.
-Therefore, @code{eq} is equivalent to @code{=} where small integers are
-concerned. It is sometimes convenient to use @code{eq} for comparing
-an unknown value with an integer, because @code{eq} does not report an
+ In Emacs Lisp, if two fixnums are numerically equal, they are the
+same Lisp object. That is, @code{eq} is equivalent to @code{=} on
+fixnums. It is sometimes convenient to use @code{eq} for comparing
+an unknown value with a fixnum, because @code{eq} does not report an
error if the unknown value is not a number---it accepts arguments of
any type. By contrast, @code{=} signals an error if the arguments are
not numbers or markers. However, it is better programming practice to
use @code{=} if you can, even for comparing integers.
- Sometimes it is useful to compare numbers with @code{equal}, which
-treats two numbers as equal if they have the same data type (both
+ Sometimes it is useful to compare numbers with @code{eql} or @code{equal},
+which treat two numbers as equal if they have the same data type (both
integers, or both floating point) and the same value. By contrast,
@code{=} can treat an integer and a floating-point number as equal.
@xref{Equality Predicates}.
@@ -830,139 +848,119 @@ Rounding a value equidistant between two integers
returns the even integer.
@cindex logical arithmetic
In a computer, an integer is represented as a binary number, a
-sequence of @dfn{bits} (digits which are either zero or one). A bitwise
+sequence of @dfn{bits} (digits which are either zero or one).
+Conceptually the bit sequence is infinite on the left, with the
+most-significant bits being all zeros or all ones. A bitwise
operation acts on the individual bits of such a sequence. For example,
@dfn{shifting} moves the whole sequence left or right one or more places,
reproducing the same pattern moved over.
The bitwise operations in Emacs Lisp apply only to integers.
address@hidden lsh integer1 count
address@hidden logical shift
address@hidden, which is an abbreviation for @dfn{logical shift}, shifts the
-bits in @var{integer1} to the left @var{count} places, or to the right
-if @var{count} is negative, bringing zeros into the vacated bits. If
address@hidden is negative, @code{lsh} shifts zeros into the leftmost
-(most-significant) bit, producing a nonnegative result even if
address@hidden is negative. Contrast this with @code{ash}, below.
address@hidden ash integer1 count
address@hidden arithmetic shift
address@hidden (@dfn{arithmetic shift}) shifts the bits in @var{integer1}
+to the left @var{count} places, or to the right if @var{count} is
+negative. Left shifts introduce zero bits on the right; right shifts
+discard the rightmost bits. Considered as an integer operation,
address@hidden multiplies @var{integer1} by
address@hidden
address@hidden,
address@hidden ifnottex
address@hidden
address@hidden,
address@hidden tex
+and then converts the result to an integer by rounding downward, toward
+minus infinity.
-Here are two examples of @code{lsh}, shifting a pattern of bits one
-place to the left. We show only the low-order eight bits of the binary
-pattern; the rest are all zero.
+Here are examples of @code{ash}, shifting a pattern of bits one place
+to the left and to the right. These examples show only the low-order
+bits of the binary pattern; leading bits all agree with the
+highest-order bit shown. As you can see, shifting left by one is
+equivalent to multiplying by two, whereas shifting right by one is
+equivalent to dividing by two and then rounding toward minus infinity.
@example
@group
-(lsh 5 1)
- @result{} 10
-;; @r{Decimal 5 becomes decimal 10.}
-00000101 @result{} 00001010
-
-(lsh 7 1)
- @result{} 14
+(ash 7 1) @result{} 14
;; @r{Decimal 7 becomes decimal 14.}
-00000111 @result{} 00001110
address@hidden
+ @result{}
address@hidden
@end group
address@hidden example
address@hidden
-As the examples illustrate, shifting the pattern of bits one place to
-the left produces a number that is twice the value of the previous
-number.
-
-Shifting a pattern of bits two places to the left produces results
-like this (with 8-bit binary numbers):
-
address@hidden
@group
-(lsh 3 2)
- @result{} 12
-;; @r{Decimal 3 becomes decimal 12.}
-00000011 @result{} 00001100
address@hidden group
address@hidden example
-
-On the other hand, shifting one place to the right looks like this:
-
address@hidden
address@hidden
-(lsh 6 -1)
- @result{} 3
-;; @r{Decimal 6 becomes decimal 3.}
-00000110 @result{} 00000011
+(ash 7 -1) @result{} 3
address@hidden
+ @result{}
address@hidden
@end group
@group
-(lsh 5 -1)
- @result{} 2
-;; @r{Decimal 5 becomes decimal 2.}
-00000101 @result{} 00000010
+(ash -7 1) @result{} -14
address@hidden
+ @result{}
address@hidden
@end group
address@hidden example
-
address@hidden
-As the example illustrates, shifting one place to the right divides the
-value of a positive integer by two, rounding downward.
address@hidden defun
-
address@hidden ash integer1 count
address@hidden arithmetic shift
address@hidden (@dfn{arithmetic shift}) shifts the bits in @var{integer1}
-to the left @var{count} places, or to the right if @var{count}
-is negative.
address@hidden gives the same results as @code{lsh} except when
address@hidden and @var{count} are both negative. In that case,
address@hidden puts ones in the empty bit positions on the left, while
address@hidden puts zeros in those bit positions.
-
-Thus, with @code{ash}, shifting the pattern of bits one place to the right
-looks like this:
-
address@hidden
@group
-(ash -6 -1) @result{} -3
-;; @r{Decimal @minus{}6 becomes decimal @minus{}3.}
-1111...111010 (30 bits total)
+(ash -7 -1) @result{} -4
address@hidden
@result{}
-1111...111101 (30 bits total)
address@hidden
@end group
@end example
-Here are other examples:
+Here are examples of shifting left or right by two bits:
address@hidden !!! Check if lined up in smallbook format! XDVI shows problem
address@hidden with smallbook but not with regular book! --rjc 16mar92
@smallexample
@group
- ; @r{ 30-bit binary values}
-
-(lsh 5 2) ; 5 = @r{0000...000101}
- @result{} 20 ; = @r{0000...010100}
+ ; @r{ binary values}
+(ash 5 2) ; 5 = @address@hidden
+ @result{} 20 ; = @address@hidden
+(ash -5 2) ; -5 = @address@hidden
+ @result{} -20 ; = @address@hidden
@end group
@group
-(ash 5 2)
- @result{} 20
-(lsh -5 2) ; -5 = @r{1111...111011}
- @result{} -20 ; = @r{1111...101100}
-(ash -5 2)
- @result{} -20
+(ash 5 -2)
+ @result{} 1 ; = @address@hidden
@end group
@group
-(lsh 5 -2) ; 5 = @r{0000...000101}
- @result{} 1 ; = @r{0000...000001}
address@hidden group
address@hidden
-(ash 5 -2)
- @result{} 1
+(ash -5 -2)
+ @result{} -2 ; = @address@hidden
@end group
address@hidden smallexample
address@hidden defun
+
address@hidden lsh integer1 count
address@hidden logical shift
address@hidden, which is an abbreviation for @dfn{logical shift}, shifts the
+bits in @var{integer1} to the left @var{count} places, or to the right
+if @var{count} is negative, bringing zeros into the vacated bits. If
address@hidden is negative, then @var{integer1} must be either a fixnum
+or a positive bignum, and @code{lsh} treats a negative fixnum as if it
+were unsigned by subtracting twice @code{most-negative-fixnum} before
+shifting, producing a nonnegative result. This quirky behavior dates
+back to when Emacs supported only fixnums; nowadays @code{ash} is a
+better choice.
+
+As @code{lsh} behaves like @code{ash} except when @var{integer1} and
address@hidden are both negative, the following examples focus on these
+exceptional cases. These examples assume 30-bit fixnums.
+
address@hidden
@group
-(lsh -5 -2) ; -5 = @r{1111...111011}
- @result{} 268435454
- ; = @r{0011...111110}
+ ; @r{ binary values}
+(ash -7 -1) ; -7 = @address@hidden
+ @result{} -4 ; = @address@hidden
+(lsh -7 -1)
+ @result{} 536870908 ; = @address@hidden
@end group
@group
-(ash -5 -2) ; -5 = @r{1111...111011}
- @result{} -2 ; = @r{1111...111110}
+(ash -5 -2) ; -5 = @address@hidden
+ @result{} -2 ; = @address@hidden
+(lsh -5 -2)
+ @result{} 268435454 ; = @address@hidden
@end group
@end smallexample
@end defun
@@ -996,23 +994,23 @@ because its binary representation consists entirely of
ones. If
@smallexample
@group
- ; @r{ 30-bit binary values}
+ ; @r{ binary values}
-(logand 14 13) ; 14 = @r{0000...001110}
- ; 13 = @r{0000...001101}
- @result{} 12 ; 12 = @r{0000...001100}
+(logand 14 13) ; 14 = @address@hidden
+ ; 13 = @address@hidden
+ @result{} 12 ; 12 = @address@hidden
@end group
@group
-(logand 14 13 4) ; 14 = @r{0000...001110}
- ; 13 = @r{0000...001101}
- ; 4 = @r{0000...000100}
- @result{} 4 ; 4 = @r{0000...000100}
+(logand 14 13 4) ; 14 = @address@hidden
+ ; 13 = @address@hidden
+ ; 4 = @address@hidden
+ @result{} 4 ; 4 = @address@hidden
@end group
@group
(logand)
- @result{} -1 ; -1 = @r{1111...111111}
+ @result{} -1 ; -1 = @address@hidden
@end group
@end smallexample
@end defun
@@ -1026,18 +1024,18 @@ passed just one argument, it returns that argument.
@smallexample
@group
- ; @r{ 30-bit binary values}
+ ; @r{ binary values}
-(logior 12 5) ; 12 = @r{0000...001100}
- ; 5 = @r{0000...000101}
- @result{} 13 ; 13 = @r{0000...001101}
+(logior 12 5) ; 12 = @address@hidden
+ ; 5 = @address@hidden
+ @result{} 13 ; 13 = @address@hidden
@end group
@group
-(logior 12 5 7) ; 12 = @r{0000...001100}
- ; 5 = @r{0000...000101}
- ; 7 = @r{0000...000111}
- @result{} 15 ; 15 = @r{0000...001111}
+(logior 12 5 7) ; 12 = @address@hidden
+ ; 5 = @address@hidden
+ ; 7 = @address@hidden
+ @result{} 15 ; 15 = @address@hidden
@end group
@end smallexample
@end defun
@@ -1051,18 +1049,18 @@ result is 0, which is an identity element for this
operation. If
@smallexample
@group
- ; @r{ 30-bit binary values}
+ ; @r{ binary values}
-(logxor 12 5) ; 12 = @r{0000...001100}
- ; 5 = @r{0000...000101}
- @result{} 9 ; 9 = @r{0000...001001}
+(logxor 12 5) ; 12 = @address@hidden
+ ; 5 = @address@hidden
+ @result{} 9 ; 9 = @address@hidden
@end group
@group
-(logxor 12 5 7) ; 12 = @r{0000...001100}
- ; 5 = @r{0000...000101}
- ; 7 = @r{0000...000111}
- @result{} 14 ; 14 = @r{0000...001110}
+(logxor 12 5 7) ; 12 = @address@hidden
+ ; 5 = @address@hidden
+ ; 7 = @address@hidden
+ @result{} 14 ; 14 = @address@hidden
@end group
@end smallexample
@end defun
@@ -1075,9 +1073,9 @@ bit is one in the result if, and only if, the @var{n}th
bit is zero in
@example
(lognot 5)
@result{} -6
-;; 5 = @r{0000...000101} (30 bits total)
+;; 5 = @address@hidden
;; @r{becomes}
-;; -6 = @r{1111...111010} (30 bits total)
+;; -6 = @address@hidden
@end example
@end defun
@@ -1092,9 +1090,9 @@ its two's complement binary representation. The result
is always
nonnegative.
@example
-(logcount 43) ; 43 = #b101011
+(logcount 43) ; 43 = @address@hidden
@result{} 4
-(logcount -43) ; -43 = #b111...1010101
+(logcount -43) ; -43 = @address@hidden
@result{} 3
@end example
@end defun
@@ -1182,7 +1180,7 @@ returns a NaN.
@defun expt x y
This function returns @var{x} raised to power @var{y}. If both
arguments are integers and @var{y} is nonnegative, the result is an
-integer; in this case, overflow causes truncation, so watch out.
+integer; in this case, overflow signals an error, so watch out.
If @var{x} is a finite negative number and @var{y} is a finite
non-integer, @code{expt} returns a NaN.
@end defun
@@ -1233,11 +1231,10 @@ other strings to choose various seed values.
This function returns a pseudo-random integer. Repeated calls return a
series of pseudo-random integers.
-If @var{limit} is a positive integer, the value is chosen to be
+If @var{limit} is a positive fixnum, the value is chosen to be
nonnegative and less than @var{limit}. Otherwise, the value might be
-any integer representable in Lisp, i.e., an integer between
address@hidden and @code{most-positive-fixnum}
-(@pxref{Integer Basics}).
+any fixnum, i.e., any integer from @code{most-negative-fixnum} through
address@hidden (@pxref{Integer Basics}).
If @var{limit} is @code{t}, it means to choose a new seed as if Emacs
were restarting, typically from the system entropy. On systems
diff --git a/doc/lispref/objects.texi b/doc/lispref/objects.texi
index 8c92de1..a094003 100644
--- a/doc/lispref/objects.texi
+++ b/doc/lispref/objects.texi
@@ -190,9 +190,10 @@ but many machines provide a wider range.
fixnum will return a bignum instead.
Fixnums can be compared with @code{eq}, but bignums require
address@hidden or @code{=}. The @code{fixnump} predicate can be used to
-detect such small integers, and @code{bignump} can be used to detect
-large integers.
address@hidden or @code{=}. To test whether an integer is a fixnum or a
+bignum, you can compare it to @code{most-negative-fixnum} and
address@hidden, or you can use the convenience predicates
address@hidden and @code{bignump} on any object.
The read syntax for integers is a sequence of (base ten) digits with an
optional sign at the beginning and an optional period at the end. The
diff --git a/doc/lispref/os.texi b/doc/lispref/os.texi
index adf554e..0b9dd1c 100644
--- a/doc/lispref/os.texi
+++ b/doc/lispref/os.texi
@@ -1197,24 +1197,19 @@ Titles}).
@cindex UID
@defun user-real-uid
This function returns the real @acronym{UID} of the user.
-The value may be floating point, in the (unlikely) event that
-the UID is too large to fit in a Lisp integer.
@end defun
@defun user-uid
This function returns the effective @acronym{UID} of the user.
-The value may be floating point.
@end defun
@cindex GID
@defun group-gid
This function returns the effective @acronym{GID} of the Emacs process.
-The value may be floating point.
@end defun
@defun group-real-gid
This function returns the real @acronym{GID} of the Emacs process.
-The value may be floating point.
@end defun
@defun system-users
@@ -1681,10 +1676,6 @@ You can also specify the field width by following the
@samp{%} with a
number; shorter numbers will be padded with blanks. An optional
period before the width requests zero-padding instead. For example,
@code{"%.3Y"} might produce @code{"004 years"}.
-
address@hidden:} This function works only with values of @var{seconds}
-that don't exceed @code{most-positive-fixnum} (@pxref{Integer Basics,
-most-positive-fixnum}).
@end defun
@node Processor Run Time
diff --git a/doc/lispref/processes.texi b/doc/lispref/processes.texi
index 4476440..f9ba703 100644
--- a/doc/lispref/processes.texi
+++ b/doc/lispref/processes.texi
@@ -2075,8 +2075,6 @@ attribute and @var{value} is the value of that attribute.
The various
attribute @var{key}s that this function can return are listed below.
Not all platforms support all of these attributes; if an attribute is
not supported, its association will not appear in the returned alist.
-Values that are numbers can be either integer or floating point,
-depending on the magnitude of the value.
@table @code
@item euid
diff --git a/doc/lispref/syntax.texi b/doc/lispref/syntax.texi
index 71c97fd..dcfade3 100644
--- a/doc/lispref/syntax.texi
+++ b/doc/lispref/syntax.texi
@@ -1014,13 +1014,13 @@ corresponds to each syntax flag.
@item
@i{Prefix} @tab @i{Flag} @tab @i{Prefix} @tab @i{Flag}
@item
address@hidden @tab @code{(lsh 1 16)} @tab @samp{p} @tab @code{(lsh 1 20)}
address@hidden @tab @code{(ash 1 16)} @tab @samp{p} @tab @code{(ash 1 20)}
@item
address@hidden @tab @code{(lsh 1 17)} @tab @samp{b} @tab @code{(lsh 1 21)}
address@hidden @tab @code{(ash 1 17)} @tab @samp{b} @tab @code{(ash 1 21)}
@item
address@hidden @tab @code{(lsh 1 18)} @tab @samp{n} @tab @code{(lsh 1 22)}
address@hidden @tab @code{(ash 1 18)} @tab @samp{n} @tab @code{(ash 1 22)}
@item
address@hidden @tab @code{(lsh 1 19)} @tab @samp{c} @tab @code{(lsh 1 23)}
address@hidden @tab @code{(ash 1 19)} @tab @samp{c} @tab @code{(ash 1 23)}
@end multitable
@defun string-to-syntax desc
diff --git a/doc/misc/calc.texi b/doc/misc/calc.texi
index b1b3862..02deee9 100644
--- a/doc/misc/calc.texi
+++ b/doc/misc/calc.texi
@@ -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
@@ -33275,19 +33275,18 @@ prefer them, or if you are calling these functions
from regular Lisp.
The functions described here are scattered throughout the various
Calc component files. Note that @file{calc.el} includes @code{autoload}s
-for only a few component files; when Calc wants to call an advanced
-function it calls @samp{(calc-extensions)} first; this function
-autoloads @file{calc-ext.el}, which in turn autoloads all the functions
-in the remaining component files.
+for only a few component files; to get autoloads of the more advanced
+function, one needs to load @file{calc-ext.el}, which in turn
+autoloads all the functions in the remaining component files.
Because @code{defmath} itself uses the extensions, user-written code
generally always executes with the extensions already loaded, so
normally you can use any Calc function and be confident that it will
be autoloaded for you when necessary. If you are doing something
special, check carefully to make sure each function you are using is
-from @file{calc.el} or its components, and call @samp{(calc-extensions)}
-before using any function based in @file{calc-ext.el} if you can't
-prove this file will already be loaded.
+from @file{calc.el} or its components, and use @address@hidden(require
+'calc-ext)}} before using any function based in @file{calc-ext.el} if
+you can't prove this file will already be loaded.
@menu
* Data Type Formats::
diff --git a/doc/misc/cl.texi b/doc/misc/cl.texi
index 77105d3..6985f19 100644
--- a/doc/misc/cl.texi
+++ b/doc/misc/cl.texi
@@ -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 *)
diff --git a/doc/misc/eww.texi b/doc/misc/eww.texi
index 43adc2e..aa17eee 100644
--- a/doc/misc/eww.texi
+++ b/doc/misc/eww.texi
@@ -262,6 +262,16 @@ contrast. If that is still too low for you, you can
customize the
variables @code{shr-color-visible-distance-min} and
@code{shr-color-visible-luminance-min} to get a better contrast.
address@hidden shr-discard-aria-hidden
address@hidden @code{aria-hidden}, HTML attribute
+ The HTML attribute @code{aria-hidden} is meant to tell screen
+readers to ignore a tag's contents. You can customize the variable
address@hidden to tell @code{shr} to ignore such tags.
+This can be useful when using a screen reader on the output of
address@hidden (e.g., on EWW buffer text). It can be useful even when not
+using a screen reader, since web authors often put this attribute on
+non-essential decorative elements.
+
@cindex Desktop Support
@cindex Saving Sessions
In addition to maintaining the history at run-time, EWW will also
diff --git a/etc/NEWS b/etc/NEWS
index ae418fc..733bd1d 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -265,6 +265,12 @@ Visiting" in the user manual for the supported commands.
* Changes in Specialized Modes and Packages in Emacs 27.1
+---
+** bibtex
+*** New commands 'bibtex-next-entry' and 'bibtex-previous-entry'.
+In bibtex-mode-map, forward-paragraph and backward-paragraph are
+remapped to these, respectively.
+
+++
** Dired
@@ -282,10 +288,10 @@ previous behavior of always creating a buffer that visits
a ChangeLog
file.
** diff-mode
-*** Hunks are now automatically refined by default
+*** Hunks are now automatically refined by default.
To disable it, set the new defcustom 'diff-font-lock-refine' to nil.
-*** File headers can be shortened, mimicking Magit's diff format
+*** File headers can be shortened, mimicking Magit's diff format.
To enable it, set the new defcustom 'diff-font-lock-prettify to t.
** Browse-url
@@ -297,7 +303,7 @@ shown in the currently selected window.
** Comint
+++
-*** 'send-invisible' is now an obsolete alias for `comint-send-invisible'
+*** 'send-invisible' is now an obsolete alias for `comint-send-invisible'.
Also, 'shell-strip-ctrl-m' is declared obsolete.
+++
@@ -325,20 +331,20 @@ end.
** Flymake
+++
-*** The variable 'flymake-diagnostic-types-alist' is obsolete
+*** The variable 'flymake-diagnostic-types-alist' is obsolete.
You should instead set properties on known diagnostic symbols, like
':error' and ':warning', as demonstrated in the Flymake manual.
-*** New customizable variable 'flymake-start-on-save-buffer'
+*** New customizable variable 'flymake-start-on-save-buffer'.
Control whether Flymake starts checking the buffer on save.
-*** Flymake and backend functions may exchange hints about buffer changes
+*** Flymake and backend functions may exchange hints about buffer changes.
This enables more efficient backends. See the docstring of
'flymake-diagnostic-functions' or the Flymake manual for details.
** Package
-*** New 'package-quickstart' feature
+*** New 'package-quickstart' feature.
When 'package-quickstart' is non-nil, package.el precomputes a big autoloads
file so that activation of packages can be done much faster, which can speed up
your startup significantly.
@@ -369,13 +375,13 @@ mouse click event, and is intended to be bound to a mouse
event.
*** The ecomplete sorting has changed to a decay-based algorithm.
This can be controlled by the new 'ecomplete-sort-predicate' variable.
-*** The 'ecompleterc' file is now placed in ~/.emacs.d/ecompleterc by default
+*** The 'ecompleterc' file is now placed in ~/.emacs.d/ecompleterc by default.
Of course it will still find it if you have it in ~/.ecompleterc
** Gnus
+++
-*** A prefix argument to 'gnus-summary-limit-to-score' will limit reverse
+*** A prefix argument to 'gnus-summary-limit-to-score' will limit reverse.
Limit to articles with score at below.
*** The function 'gnus-score-find-favorite-words' has been renamed
@@ -386,8 +392,8 @@ from 'gnus-score-find-favourite-words'.
has a search engine.
+++
-*** Splitting mail on common mailing list headers has been added. See
-the concept index in the Gnus manual for the 'match-list' entry.
+*** Splitting mail on common mailing list headers has been added.
+See the concept index in the Gnus manual for the 'match-list' entry.
+++
*** nil is no longer an allowed value for 'mm-text-html-renderer'.
@@ -415,6 +421,11 @@ and its value has been changed to Duck Duck Go.
'shr-selected-link' face to give the user feedback that the command
has been executed.
++++
+*** New option 'shr-discard-aria-hidden'.
+If set, shr will not render tags with attribute 'aria-hidden="true"'.
+This attribute is meant to tell screen readers to ignore a tag.
+
** Htmlfontify
*** The functions 'hfy-color', 'hfy-color-vals' and
@@ -431,6 +442,7 @@ saved with the charset properties, and those properties
will be
restored when the file is visited.
** Smtpmail
+
Authentication mechanisms can be added via external packages, by
defining new cl-defmethod of smtpmail-try-auth-method.
@@ -785,6 +797,7 @@ The variable 'custom--inhibit-theme-enable' controls this
behavior;
its default value changed in Emacs 27.1.
** The 'repetitions' argument of 'benchmark-run' can now also be a variable.
+
** The FILENAME argument to 'file-name-base' is now mandatory and no
longer defaults to 'buffer-file-name'.
@@ -795,9 +808,10 @@ them through 'format' first. Even that is discouraged:
for ElDoc
support, you should set 'eldoc-documentation-function' instead of
calling 'eldoc-message' directly.
-** Old-style backquotes now generate an error. They have been
-generating warnings for a decade. To interpret old-style backquotes
-as new-style, bind the new variable 'force-new-style-backquotes' to t.
+** Old-style backquotes now generate an error.
+They have been generating warnings for a decade. To interpret
+old-style backquotes as new-style, bind the new variable
+'force-new-style-backquotes' to t.
** Defining a Common Lisp structure using 'cl-defstruct' or
'cl-struct-define' whose name clashes with a builtin type (e.g.,
@@ -871,11 +885,34 @@ otherwise, it returns nil. 'format-proper-list-p' is now
an obsolete
alias for the new function.
+++
-** Emacs Lisp integers can be of arbitrary precision. The new
-predicates 'bignump' and 'fixnump' can be used to distinguish between
-the types of integers.
-
-** define-minor-mode automatically documents the meaning of ARG
+** Emacs Lisp integers can now be of arbitrary size.
+Emacs uses the GNU Multiple Precision (GMP) library to support
+integers whose size is too large to support natively. The integers
+supported natively are known as "fixnums", while the larger ones are
+"bignums". The new predicates 'bignump' and 'fixnump' can be used to
+distinguish between these two types of integers.
+
+All the arithmetic, comparison, and logical (a.k.a. "bitwise")
+operations where bignums make sense now support both fixnums and
+bignums. However, note that unlike fixnums, bignums will not compare
+equal with 'eq', you must use 'eql' instead. (Numerical comparison
+with '=' works on both, of course.)
+
+Since large bignums consume a lot of memory, Emacs limits the size of
+the largest bignum a Lisp program is allowed to create. The
+nonnegative value of the new variable 'integer-width' specifies the
+maximum number of bits allowed in a bignum. Emacs signals an integer
+overflow error if this limit is exceeded.
+
+Several primitive functions formerly returned floats or lists of
+integers to represent integers that did not fit into fixnums. These
+functions now simply return integers instead. Affected functions
+include functions like encode-char that compute code-points, functions
+like file-attributes that compute file sizes and other attributes,
+functions like process-id that compute process IDs, and functions like
+user-uid and group-gid that compute user and group IDs.
+
+** define-minor-mode automatically documents the meaning of ARG.
+++
** The function 'recenter' now accepts an additional optional argument.
diff --git a/etc/NEWS.19 b/etc/NEWS.19
index efe0f0e..1f84e87 100644
--- a/etc/NEWS.19
+++ b/etc/NEWS.19
@@ -4341,7 +4341,7 @@ turn the character that follows into a hyper character:
(defun hyperify (prompt)
(let ((e (read-event)))
(vector (if (numberp e)
- (logior (lsh 1 20) e)
+ (logior (ash 1 20) e)
(if (memq 'hyper (event-modifiers e))
e
(add-event-modifier "H-" e))))))
diff --git a/etc/NEWS.26 b/etc/NEWS.26
index a766e96..e94bda5 100644
--- a/etc/NEWS.26
+++ b/etc/NEWS.26
@@ -19,7 +19,7 @@ with a prefix argument or by typing C-u C-h C-n.
* Installation Changes in Emacs 26.2
---
-** Building Emacs with the '--with-xwidgets' option now requires WebKit2
+** Building Emacs with the '--with-xwidgets' option now requires WebKit2.
To build Emacs with xwidgets support, you will need to install the
webkit2gtk-4.0 package; version 2.12 or later is required.
(This change was actually made in Emacs 26.1, but was not called out
@@ -132,17 +132,17 @@ now the default in developer builds. As before, use
** When GCC warnings are enabled, '--enable-check-lisp-object-type' is
now enabled by default when configuring.
-** The Emacs server now has socket-launching support. This allows
-socket based activation, where an external process like systemd can
-invoke the Emacs server process upon a socket connection event and
-hand the socket over to Emacs. Emacs uses this socket to service
-emacsclient commands. This new functionality can be disabled with the
-configure option '--disable-libsystemd'.
+** The Emacs server now has socket-launching support.
+This allows socket based activation, where an external process like
+systemd can invoke the Emacs server process upon a socket connection
+event and hand the socket over to Emacs. Emacs uses this socket to
+service emacsclient commands. This new functionality can be disabled
+with the configure option '--disable-libsystemd'.
-** A systemd user unit file is provided. Use it in the standard way:
-'systemctl --user enable emacs'.
-(If your Emacs is installed in a non-standard location, you may
-need to copy the emacs.service file to eg ~/.config/systemd/user/)
+** A systemd user unit file is provided.
+Use it in the standard way: 'systemctl --user enable emacs'. (If your
+Emacs is installed in a non-standard location, you may need to copy
+the emacs.service file to eg ~/.config/systemd/user/)
** New configure option '--disable-build-details' attempts to build an
Emacs that is more likely to be reproducible; that is, if you build
@@ -153,7 +153,6 @@ following variables nil: 'emacs-build-system',
'emacs-build-time',
'erc-emacs-build-time'.
** Emacs can now be built with support for Little CMS.
-
If the lcms2 library is installed, Emacs will enable features built on
top of that library. The new configure option '--without-lcms2' can
be used to build without lcms2 support even if it is installed. Emacs
@@ -196,9 +195,9 @@ The effect is similar to that of "toolBar" resource on the
tool bar.
* Changes in Emacs 26.1
-** Option 'buffer-offer-save' can be set to new value, 'always'. When
-set to 'always', the command 'save-some-buffers' will always offer
-this buffer for saving.
+** Option 'buffer-offer-save' can be set to new value, 'always'.
+When set to 'always', the command 'save-some-buffers' will always
+offer this buffer for saving.
** Security vulnerability related to Enriched Text mode is removed.
@@ -684,7 +683,7 @@ This can be customized via the 'info-menu' category in
A new option 'ediff-show-ancestor' and a new toggle
'ediff-toggle-show-ancestor'.
-** TeX: Add luatex and xetex as alternatives to pdftex
+** TeX: Add luatex and xetex as alternatives to pdftex.
** Electric-Buffer-menu
@@ -1088,7 +1087,6 @@ to a format suitable for reverse lookup zone files.
** Ispell
*** Enchant is now supported as a spell-checker.
-
Enchant is a meta-spell-checker that uses providers such as Hunspell
to do the actual checking. With it, users can use spell-checkers not
directly supported by Emacs, such as Voikko, Hspell and AppleSpell,
@@ -1098,8 +1096,7 @@ configure different spelling-checkers for different
languages.
** Flymake
-*** Flymake has been completely redesigned
-
+*** Flymake has been completely redesigned.
Flymake now annotates arbitrary buffer regions, not just lines. It
supports arbitrary diagnostic types, not just errors and warnings (see
variable 'flymake-diagnostic-types-alist').
@@ -1115,7 +1112,6 @@ backend", which has been updated to benefit from the new
UI features.
** Term
*** 'term-char-mode' now makes its buffer read-only.
-
The buffer is made read-only to prevent changes from being made by
anything other than the process filter; and movements of point away
from the process mark are counter-acted so that the cursor is in the
@@ -1131,7 +1127,6 @@ the previous behavior.
** Xref
*** When an *xref* buffer is needed, 'TAB' quits and jumps to an xref.
-
A new command 'xref-quit-and-goto-xref', bound to 'TAB' in *xref*
buffers, quits the window before jumping to the destination. In many
situations, the intended window configuration is restored, just as if
@@ -1227,11 +1222,11 @@ change FOO, respectively. The exhaustive list of
removed variables is:
*** Many variables obsoleted in 22.1 referring to face symbols.
-** The variable 'text-quoting-style' is now a customizable option. It
-controls whether to and how to translate ASCII quotes in messages and
-help output. Its possible values and their semantics remain unchanged
-from Emacs 25. In particular, when this variable's value is 'grave',
-all quotes in formats are output as-is.
+** The variable 'text-quoting-style' is now a customizable option.
+It controls whether to and how to translate ASCII quotes in messages
+and help output. Its possible values and their semantics remain
+unchanged from Emacs 25. In particular, when this variable's value is
+'grave', all quotes in formats are output as-is.
** Functions like 'check-declare-file' and 'check-declare-directory'
now generate less chatter and more-compact diagnostics. The auxiliary
@@ -1495,10 +1490,11 @@ to provide region boundaries (for rectangular regions
more than one)
to an interactively callable function as a single argument instead of
two separate arguments 'region-beginning' and 'region-end'.
-** 'parse-partial-sexp' state has a new element. Element 10 is
-non-nil when the last character scanned might be the first character
-of a two character construct, i.e., a comment delimiter or escaped
-character. Its value is the syntax of that last character.
+** 'parse-partial-sexp' state has a new element.
+Element 10 is non-nil when the last character scanned might be the
+first character of a two character construct, i.e., a comment
+delimiter or escaped character. Its value is the syntax of that last
+character.
** 'parse-partial-sexp's state, element 9, has now been confirmed as
permanent and documented, and may be used by Lisp programs. Its value
@@ -1762,8 +1758,9 @@ the ELisp manual.
*** 'select-frame-by-name' now may return a frame on another display
if it does not find a suitable one on the current display.
-** 'tcl-auto-fill-mode' is now declared obsolete. Its functionality
-can be replicated simply by setting 'comment-auto-fill-only-comments'.
+** 'tcl-auto-fill-mode' is now declared obsolete.
+Its functionality can be replicated simply by setting
+'comment-auto-fill-only-comments'.
** New pcase pattern 'rx' to match against an rx-style regular expression.
For details, see the doc string of 'rx--pcase-macroexpander'.
diff --git a/etc/PROBLEMS b/etc/PROBLEMS
index fe59b52..a1fae22 100644
--- a/etc/PROBLEMS
+++ b/etc/PROBLEMS
@@ -1135,7 +1135,7 @@ is running. If gnome-settings-daemon is not running,
Emacs receives
input through XIM without any problem. Furthermore, this seems only
to happen in *.UTF-8 locales; zh_CN.GB2312 and zh_CN.GBK locales, for
example, work fine. A bug report has been filed in the Gnome
-bugzilla: http://bugzilla.gnome.org/show_bug.cgi?id=357032
+bugzilla: https://bugzilla.gnome.org/show_bug.cgi?id=357032
*** Gnome: GPaste clipboard manager causes erratic behavior of 'yank'
diff --git a/lib/gettimeofday.c b/lib/gettimeofday.c
index fd44f45..1bd50fa 100644
--- a/lib/gettimeofday.c
+++ b/lib/gettimeofday.c
@@ -33,6 +33,10 @@
#ifdef WINDOWS_NATIVE
+/* Avoid warnings from gcc -Wcast-function-type. */
+# define GetProcAddress \
+ (void *) GetProcAddress
+
/* GetSystemTimePreciseAsFileTime was introduced only in Windows 8. */
typedef void (WINAPI * GetSystemTimePreciseAsFileTimeFuncType) (FILETIME
*lpTime);
static GetSystemTimePreciseAsFileTimeFuncType
GetSystemTimePreciseAsFileTimeFunc = NULL;
diff --git a/lib/gnulib.mk.in b/lib/gnulib.mk.in
index 666105b..2e265b3 100644
--- a/lib/gnulib.mk.in
+++ b/lib/gnulib.mk.in
@@ -303,6 +303,7 @@ GNULIB_GETLOADAVG = @GNULIB_GETLOADAVG@
GNULIB_GETLOGIN = @GNULIB_GETLOGIN@
GNULIB_GETLOGIN_R = @GNULIB_GETLOGIN_R@
GNULIB_GETPAGESIZE = @GNULIB_GETPAGESIZE@
+GNULIB_GETPASS = @GNULIB_GETPASS@
GNULIB_GETSUBOPT = @GNULIB_GETSUBOPT@
GNULIB_GETTIMEOFDAY = @GNULIB_GETTIMEOFDAY@
GNULIB_GETUSERSHELL = @GNULIB_GETUSERSHELL@
@@ -548,6 +549,7 @@ HAVE_GETHOSTNAME = @HAVE_GETHOSTNAME@
HAVE_GETLOGIN = @HAVE_GETLOGIN@
HAVE_GETOPT_H = @HAVE_GETOPT_H@
HAVE_GETPAGESIZE = @HAVE_GETPAGESIZE@
+HAVE_GETPASS = @HAVE_GETPASS@
HAVE_GETSUBOPT = @HAVE_GETSUBOPT@
HAVE_GETTIMEOFDAY = @HAVE_GETTIMEOFDAY@
HAVE_GRANTPT = @HAVE_GRANTPT@
@@ -854,6 +856,7 @@ REPLACE_GETGROUPS = @REPLACE_GETGROUPS@
REPLACE_GETLINE = @REPLACE_GETLINE@
REPLACE_GETLOGIN_R = @REPLACE_GETLOGIN_R@
REPLACE_GETPAGESIZE = @REPLACE_GETPAGESIZE@
+REPLACE_GETPASS = @REPLACE_GETPASS@
REPLACE_GETTIMEOFDAY = @REPLACE_GETTIMEOFDAY@
REPLACE_GMTIME = @REPLACE_GMTIME@
REPLACE_ISATTY = @REPLACE_ISATTY@
@@ -3098,6 +3101,7 @@ unistd.h: unistd.in.h $(top_builddir)/config.status
$(CXXDEFS_H) $(ARG_NONNULL_H
-e 's/@''GNULIB_GETLOGIN''@/$(GNULIB_GETLOGIN)/g' \
-e 's/@''GNULIB_GETLOGIN_R''@/$(GNULIB_GETLOGIN_R)/g' \
-e 's/@''GNULIB_GETPAGESIZE''@/$(GNULIB_GETPAGESIZE)/g' \
+ -e 's/@''GNULIB_GETPASS''@/$(GNULIB_GETPASS)/g' \
-e 's/@''GNULIB_GETUSERSHELL''@/$(GNULIB_GETUSERSHELL)/g' \
-e 's/@''GNULIB_GROUP_MEMBER''@/$(GNULIB_GROUP_MEMBER)/g' \
-e 's/@''GNULIB_ISATTY''@/$(GNULIB_ISATTY)/g' \
@@ -3141,6 +3145,7 @@ unistd.h: unistd.in.h $(top_builddir)/config.status
$(CXXDEFS_H) $(ARG_NONNULL_H
-e 's|@''HAVE_GETGROUPS''@|$(HAVE_GETGROUPS)|g' \
-e 's|@''HAVE_GETHOSTNAME''@|$(HAVE_GETHOSTNAME)|g' \
-e 's|@''HAVE_GETPAGESIZE''@|$(HAVE_GETPAGESIZE)|g' \
+ -e 's|@''HAVE_GETPASS''@|$(HAVE_GETPASS)|g' \
-e 's|@''HAVE_GROUP_MEMBER''@|$(HAVE_GROUP_MEMBER)|g' \
-e 's|@''HAVE_LCHOWN''@|$(HAVE_LCHOWN)|g' \
-e 's|@''HAVE_LINK''@|$(HAVE_LINK)|g' \
@@ -3184,6 +3189,7 @@ unistd.h: unistd.in.h $(top_builddir)/config.status
$(CXXDEFS_H) $(ARG_NONNULL_H
-e 's|@''REPLACE_GETLOGIN_R''@|$(REPLACE_GETLOGIN_R)|g' \
-e 's|@''REPLACE_GETGROUPS''@|$(REPLACE_GETGROUPS)|g' \
-e 's|@''REPLACE_GETPAGESIZE''@|$(REPLACE_GETPAGESIZE)|g' \
+ -e 's|@''REPLACE_GETPASS''@|$(REPLACE_GETPASS)|g' \
-e 's|@''REPLACE_ISATTY''@|$(REPLACE_ISATTY)|g' \
-e 's|@''REPLACE_LCHOWN''@|$(REPLACE_LCHOWN)|g' \
-e 's|@''REPLACE_LINK''@|$(REPLACE_LINK)|g' \
diff --git a/lib/intprops.h b/lib/intprops.h
index 15e470c..3d6b3cf4 100644
--- a/lib/intprops.h
+++ b/lib/intprops.h
@@ -22,12 +22,13 @@
#include <limits.h>
-/* Return a value with the common real type of E and V and the value of V. */
-#define _GL_INT_CONVERT(e, v) (0 * (e) + (v))
+/* Return a value with the common real type of E and V and the value of V.
+ Do not evaluate E. */
+#define _GL_INT_CONVERT(e, v) ((1 ? 0 : (e)) + (v))
/* Act like _GL_INT_CONVERT (E, -V) but work around a bug in IRIX 6.5 cc; see
<https://lists.gnu.org/r/bug-gnulib/2011-05/msg00406.html>. */
-#define _GL_INT_NEGATE_CONVERT(e, v) (0 * (e) - (v))
+#define _GL_INT_NEGATE_CONVERT(e, v) ((1 ? 0 : (e)) - (v))
/* The extra casts in the following macros work around compiler bugs,
e.g., in Cray C 5.0.3.0. */
@@ -40,13 +41,14 @@
#define TYPE_SIGNED(t) (! ((t) 0 < (t) -1))
/* Return 1 if the real expression E, after promotion, has a
- signed or floating type. */
+ signed or floating type. Do not evaluate E. */
#define EXPR_SIGNED(e) (_GL_INT_NEGATE_CONVERT (e, 1) < 0)
/* Minimum and maximum values for integer types and expressions. */
/* The width in bits of the integer type or expression T.
+ Do not evaluate T.
Padding bits are not supported; this is checked at compile-time below. */
#define TYPE_WIDTH(t) (sizeof (t) * CHAR_BIT)
@@ -58,7 +60,7 @@
: ((((t) 1 << (TYPE_WIDTH (t) - 2)) - 1) * 2 + 1)))
/* The maximum and minimum values for the type of the expression E,
- after integer promotion. E should not have side effects. */
+ after integer promotion. E is not evaluated. */
#define _GL_INT_MINIMUM(e) \
(EXPR_SIGNED (e) \
? ~ _GL_SIGNED_INT_MAXIMUM (e) \
@@ -340,8 +342,8 @@
Arguments should be free of side effects. */
#define _GL_BINARY_OP_OVERFLOW(a, b, op_result_overflow) \
op_result_overflow (a, b, \
- _GL_INT_MINIMUM (0 * (b) + (a)), \
- _GL_INT_MAXIMUM (0 * (b) + (a)))
+ _GL_INT_MINIMUM ((1 ? 0 : (b)) + (a)), \
+ _GL_INT_MAXIMUM ((1 ? 0 : (b)) + (a)))
/* Store the low-order bits of A + B, A - B, A * B, respectively, into *R.
Return 1 if the result overflows. See above for restrictions. */
diff --git a/lib/regex_internal.c b/lib/regex_internal.c
index 3237356..e3ce4ab 100644
--- a/lib/regex_internal.c
+++ b/lib/regex_internal.c
@@ -317,7 +317,7 @@ build_wcs_upper_buffer (re_string_t *pstr)
mbclen = __mbrtowc (&wc,
((const char *) pstr->raw_mbs + pstr->raw_mbs_idx
+ byte_idx), remain_len, &pstr->cur_state);
- if (BE (mbclen < (size_t) -2, 1))
+ if (BE (0 < mbclen && mbclen < (size_t) -2, 1))
{
wchar_t wcu = __towupper (wc);
if (wcu != wc)
@@ -386,7 +386,7 @@ build_wcs_upper_buffer (re_string_t *pstr)
else
p = (const char *) pstr->raw_mbs + pstr->raw_mbs_idx + src_idx;
mbclen = __mbrtowc (&wc, p, remain_len, &pstr->cur_state);
- if (BE (mbclen < (size_t) -2, 1))
+ if (BE (0 < mbclen && mbclen < (size_t) -2, 1))
{
wchar_t wcu = __towupper (wc);
if (wcu != wc)
diff --git a/lib/regex_internal.h b/lib/regex_internal.h
index 7bbe802..dd0900b 100644
--- a/lib/regex_internal.h
+++ b/lib/regex_internal.h
@@ -149,7 +149,10 @@
/* Rename to standard API for using out of glibc. */
#ifndef _LIBC
# undef __wctype
+# undef __iswalnum
# undef __iswctype
+# undef __towlower
+# undef __towupper
# define __wctype wctype
# define __iswalnum iswalnum
# define __iswctype iswctype
diff --git a/lib/unistd.in.h b/lib/unistd.in.h
index 55bbb6c..66f254d 100644
--- a/lib/unistd.in.h
+++ b/lib/unistd.in.h
@@ -935,6 +935,36 @@ _GL_WARN_ON_USE (getpagesize, "getpagesize is unportable -
"
#endif
+#if @GNULIB_GETPASS@
+/* Function getpass() from module 'getpass':
+ Read a password from /dev/tty or stdin.
+ Function getpass() from module 'getpass-gnu':
+ Read a password of arbitrary length from /dev/tty or stdin. */
+# if @REPLACE_GETPASS@
+# if !(defined __cplusplus && defined GNULIB_NAMESPACE)
+# undef getpass
+# define getpass rpl_getpass
+# endif
+_GL_FUNCDECL_RPL (getpass, char *, (const char *prompt)
+ _GL_ARG_NONNULL ((1)));
+_GL_CXXALIAS_RPL (getpass, char *, (const char *prompt));
+# else
+# if address@hidden@
+_GL_FUNCDECL_SYS (getpass, char *, (const char *prompt)
+ _GL_ARG_NONNULL ((1)));
+# endif
+_GL_CXXALIAS_SYS (getpass, char *, (const char *prompt));
+# endif
+_GL_CXXALIASWARN (getpass);
+#elif defined GNULIB_POSIXCHECK
+# undef getpass
+# if HAVE_RAW_DECL_GETPASS
+_GL_WARN_ON_USE (getpass, "getpass is unportable - "
+ "use gnulib module getpass or getpass-gnu for portability");
+# endif
+#endif
+
+
#if @GNULIB_GETUSERSHELL@
/* Return the next valid login shell on the system, or NULL when the end of
the list has been reached. */
diff --git a/lisp/arc-mode.el b/lisp/arc-mode.el
index 4ddb29d..50048c0 100644
--- a/lisp/arc-mode.el
+++ b/lisp/arc-mode.el
@@ -531,12 +531,10 @@ Each descriptor is a vector of the form
(defsubst archive-name (suffix)
(intern (concat "archive-" (symbol-name archive-subtype) "-" suffix)))
-(defun archive-l-e (str &optional len float)
+(defun archive-l-e (str &optional len)
"Convert little endian string/vector STR to integer.
Alternatively, STR may be a buffer position in the current buffer
-in which case a second argument, length LEN, should be supplied.
-FLOAT, if non-nil, means generate and return a float instead of an integer
-\(use this for numbers that can overflow the Emacs integer)."
+in which case a second argument, length LEN, should be supplied."
(if (stringp str)
(setq len (length str))
(setq str (buffer-substring str (+ str len))))
@@ -545,7 +543,7 @@ FLOAT, if non-nil, means generate and return a float
instead of an integer
(i 0))
(while (< i len)
(setq i (1+ i)
- result (+ (if float (* result 256.0) (ash result 8))
+ result (+ (ash result 8)
(aref str (- len i)))))
result))
@@ -583,7 +581,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)
@@ -1501,14 +1499,13 @@ This doesn't recover lost files, it just undoes changes
in the buffer itself."
(fnlen (or (string-match "\0" namefld) 13))
(efnname (decode-coding-string (substring namefld 0 fnlen)
archive-file-name-coding-system))
- ;; Convert to float to avoid overflow for very large files.
- (csize (archive-l-e (+ p 15) 4 'float))
+ (csize (archive-l-e (+ p 15) 4))
(moddate (archive-l-e (+ p 19) 2))
(modtime (archive-l-e (+ p 21) 2))
- (ucsize (archive-l-e (+ p 25) 4 'float))
+ (ucsize (archive-l-e (+ p 25) 4))
(fiddle (string= efnname (upcase efnname)))
(ifnname (if fiddle (downcase efnname) efnname))
- (text (format " %8.0f %-11s %-8s %s"
+ (text (format " %8d %-11s %-8s %s"
ucsize
(archive-dosdate moddate)
(archive-dostime modtime)
@@ -1521,11 +1518,7 @@ This doesn't recover lost files, it just undoes changes
in the buffer itself."
visual)
files (cons (vector efnname ifnname fiddle nil (1- p))
files)
- ;; p needs to stay an integer, since we use it in char-after
- ;; above. Passing through `round' limits the compressed size
- ;; to most-positive-fixnum, but if the compressed size exceeds
- ;; that, we cannot visit the archive anyway.
- p (+ p 29 (round csize)))))
+ p (+ p 29 csize))))
(goto-char (point-min))
(let ((dash (concat "- -------- ----------- -------- "
(make-string maxlen ?-)
@@ -1534,7 +1527,7 @@ This doesn't recover lost files, it just undoes changes
in the buffer itself."
dash)
(archive-summarize-files (nreverse visual))
(insert dash
- (format " %8.0f %d file%s"
+ (format " %8d %d file%s"
totalsize
(length files)
(if (= 1 (length files)) "" "s"))
@@ -1567,10 +1560,9 @@ This doesn't recover lost files, it just undoes changes
in the buffer itself."
(while (progn (goto-char p) ;beginning of a base header.
(looking-at "\\(.\\|\n\\)\\(.\\|\n\\)-l[hz][0-9ds]-"))
(let* ((hsize (byte-after p)) ;size of the base header (level 0 and 1)
- ;; Convert to float to avoid overflow for very large files.
- (csize (archive-l-e (+ p 7) 4 'float)) ;size of a compressed
file to follow (level 0 and 2),
+ (csize (archive-l-e (+ p 7) 4)) ;size of a compressed file to
follow (level 0 and 2),
;size of extended headers + the
compressed file to follow (level 1).
- (ucsize (archive-l-e (+ p 11) 4 'float)) ;size of an
uncompressed file.
+ (ucsize (archive-l-e (+ p 11) 4)) ;size of an
uncompressed file.
(time1 (archive-l-e (+ p 15) 2)) ;date/time (MSDOS format in
level 0, 1 headers
(time2 (archive-l-e (+ p 17) 2)) ;and UNIX format in level 2
header.)
(hdrlvl (byte-after (+ p 20))) ;header level
@@ -1660,12 +1652,12 @@ This doesn't recover lost files, it just undoes changes
in the buffer itself."
(archive-unixtime time1 time2)
(archive-dostime time1)))
(setq text (if archive-alternate-display
- (format " %8.0f %5S %5S %s"
+ (format " %8d %5S %5S %s"
ucsize
(or uid "?")
(or gid "?")
ifnname)
- (format " %10s %8.0f %-11s %-8s %s"
+ (format " %10s %8d %-11s %-8s %s"
modestr
ucsize
moddate
@@ -1680,13 +1672,9 @@ This doesn't recover lost files, it just undoes changes
in the buffer itself."
files (cons (vector prname ifnname fiddle mode (1- p))
files))
(cond ((= hdrlvl 1)
- ;; p needs to stay an integer, since we use it in goto-char
- ;; above. Passing through `round' limits the compressed size
- ;; to most-positive-fixnum, but if the compressed size exceeds
- ;; that, we cannot visit the archive anyway.
- (setq p (+ p hsize 2 (round csize))))
+ (setq p (+ p hsize 2 csize)))
((or (= hdrlvl 2) (= hdrlvl 0))
- (setq p (+ p thsize 2 (round csize)))))
+ (setq p (+ p thsize 2 csize))))
))
(goto-char (point-min))
(let ((dash (concat (if archive-alternate-display
@@ -1759,7 +1747,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)))
@@ -1824,32 +1812,21 @@ This doesn't recover lost files, it just undoes changes
in the buffer itself."
;;
;; First, find the Zip64 end-of-central-directory locator.
(search-backward "PK\006\007")
- ;; Pay attention: the offset of Zip64 end-of-central-directory
- ;; is a 64-bit field, so it could overflow the Emacs integer
- ;; even on a 64-bit host, let alone 32-bit one. But since we've
- ;; already read the zip file into a buffer, and this is a byte
- ;; offset into the file we've read, it must be short enough, so
- ;; such an overflow can never happen, and we can safely read
- ;; these 8 bytes into an Emacs integer. Moreover, on host with
- ;; 32-bit Emacs integer we can only read 4 bytes, since they are
- ;; stored in little-endian byte order.
- (setq emacs-int-has-32bits (<= most-positive-fixnum #x1fffffff))
(setq p (+ (point-min)
- (archive-l-e (+ (point) 8) (if emacs-int-has-32bits 4 8))))
+ (archive-l-e (+ (point) 8) 8)))
(goto-char p)
;; We should be at Zip64 end-of-central-directory record now.
(or (string= "PK\006\006" (buffer-substring p (+ p 4)))
(error "Unrecognized ZIP file format"))
;; Offset to central directory:
- (setq p (archive-l-e (+ p 48) (if emacs-int-has-32bits 4 8))))
+ (setq p (archive-l-e (+ p 48) 8)))
(setq p (+ p (point-min)))
(while (string= "PK\001\002" (buffer-substring p (+ p 4)))
(let* ((creator (byte-after (+ p 5)))
;; (method (archive-l-e (+ p 10) 2))
(modtime (archive-l-e (+ p 12) 2))
(moddate (archive-l-e (+ p 14) 2))
- ;; Convert to float to avoid overflow for very large files.
- (ucsize (archive-l-e (+ p 24) 4 'float))
+ (ucsize (archive-l-e (+ p 24) 4))
(fnlen (archive-l-e (+ p 28) 2))
(exlen (archive-l-e (+ p 30) 2))
(fclen (archive-l-e (+ p 32) 2))
@@ -1874,7 +1851,7 @@ This doesn't recover lost files, it just undoes changes
in the buffer itself."
(string= (upcase efnname) efnname)))
(ifnname (if fiddle (downcase efnname) efnname))
(width (string-width ifnname))
- (text (format " %10s %8.0f %-11s %-8s %s"
+ (text (format " %10s %8d %-11s %-8s %s"
modestr
ucsize
(archive-dosdate moddate)
@@ -1900,7 +1877,7 @@ This doesn't recover lost files, it just undoes changes
in the buffer itself."
dash)
(archive-summarize-files (nreverse visual))
(insert dash
- (format " %8.0f %d file%s"
+ (format " %8d %d file%s"
totalsize
(length files)
(if (= 1 (length files)) "" "s"))
@@ -1949,11 +1926,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"))))
))))
@@ -1971,8 +1948,7 @@ This doesn't recover lost files, it just undoes changes
in the buffer itself."
(let* ((next (1+ (archive-l-e (+ p 6) 4)))
(moddate (archive-l-e (+ p 14) 2))
(modtime (archive-l-e (+ p 16) 2))
- ;; Convert to float to avoid overflow for very large files.
- (ucsize (archive-l-e (+ p 20) 4 'float))
+ (ucsize (archive-l-e (+ p 20) 4))
(namefld (buffer-substring (+ p 38) (+ p 38 13)))
(dirtype (byte-after (+ p 4)))
(lfnlen (if (= dirtype 2) (byte-after (+ p 56)) 0))
@@ -1995,7 +1971,7 @@ This doesn't recover lost files, it just undoes changes
in the buffer itself."
(fiddle (and (= lfnlen 0) (string= efnname (upcase efnname))))
(ifnname (if fiddle (downcase efnname) efnname))
(width (string-width ifnname))
- (text (format " %8.0f %-11s %-8s %s"
+ (text (format " %8d %-11s %-8s %s"
ucsize
(archive-dosdate moddate)
(archive-dostime modtime)
@@ -2017,7 +1993,7 @@ This doesn't recover lost files, it just undoes changes
in the buffer itself."
dash)
(archive-summarize-files (nreverse visual))
(insert dash
- (format " %8.0f %d file%s"
+ (format " %8d %d file%s"
totalsize
(length files)
(if (= 1 (length files)) "" "s"))
@@ -2211,8 +2187,6 @@ This doesn't recover lost files, it just undoes changes
in the buffer itself."
(while (looking-at archive-ar-file-header-re)
(let ((name (match-string 1))
extname
- ;; Emacs will automatically use float here because those
- ;; timestamps don't fit in our ints.
(time (string-to-number (match-string 2)))
(user (match-string 3))
(group (match-string 4))
diff --git a/lisp/calc/calc-bin.el b/lisp/calc/calc-bin.el
index c05a71a..a61cecf 100644
--- a/lisp/calc/calc-bin.el
+++ b/lisp/calc/calc-bin.el
@@ -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
diff --git a/lisp/calc/calc-comb.el b/lisp/calc/calc-comb.el
index 7c88230..f1d3dae 100644
--- a/lisp/calc/calc-comb.el
+++ b/lisp/calc/calc-comb.el
@@ -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.
diff --git a/lisp/calc/calc-ext.el b/lisp/calc/calc-ext.el
index 5feff23..f983ebe 100644
--- a/lisp/calc/calc-ext.el
+++ b/lisp/calc/calc-ext.el
@@ -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]
diff --git a/lisp/calc/calc-math.el b/lisp/calc/calc-math.el
index 4b8abbf..483907a 100644
--- a/lisp/calc/calc-math.el
+++ b/lisp/calc/calc-math.el
@@ -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))
diff --git a/lisp/calc/calc.el b/lisp/calc/calc.el
index 4bebd5f..364b44b 100644
--- a/lisp/calc/calc.el
+++ b/lisp/calc/calc.el
@@ -2781,13 +2781,6 @@ largest Emacs integer.")
(cond
((>= a 0)
(cons 'bigpos (math-bignum-big a)))
- ((= a most-negative-fixnum)
- ;; Note: cannot get the negation directly because
- ;; (- most-negative-fixnum) is most-negative-fixnum.
- ;;
- ;; most-negative-fixnum := -most-positive-fixnum - 1
- (math-sub (cons 'bigneg (math-bignum-big most-positive-fixnum))
- 1))
(t
(cons 'bigneg (math-bignum-big (- a))))))
diff --git a/lisp/calendar/parse-time.el b/lisp/calendar/parse-time.el
index c472733..2f9e557 100644
--- a/lisp/calendar/parse-time.el
+++ b/lisp/calendar/parse-time.el
@@ -98,7 +98,7 @@ letters, digits, plus or minus signs or colons."
`(((6) parse-time-weekdays)
((3) (1 31))
((4) parse-time-months)
- ((5) (100 ,most-positive-fixnum))
+ ((5) (100))
((2 1 0)
,#'(lambda () (and (stringp parse-time-elt)
(= (length parse-time-elt) 8)
@@ -170,7 +170,9 @@ any values that are unknown are returned as nil."
'lambda)))
(and (numberp parse-time-elt)
(<= (car predicate) parse-time-elt)
- (<= parse-time-elt (cadr predicate))
+ (or (not (cdr predicate))
+ (<= parse-time-elt
+ (cadr predicate)))
parse-time-elt))
((symbolp predicate)
(cdr (assoc parse-time-elt
diff --git a/lisp/calendar/time-date.el b/lisp/calendar/time-date.el
index e266dd6..74c607c 100644
--- a/lisp/calendar/time-date.el
+++ b/lisp/calendar/time-date.el
@@ -175,8 +175,7 @@ If DATE lacks timezone information, GMT is assumed."
;;;###autoload
(defun days-to-time (days)
"Convert DAYS into a time value."
- (let ((time (condition-case nil (seconds-to-time (* 86400.0 days))
- (range-error (list most-positive-fixnum 65535)))))
+ (let ((time (seconds-to-time (* 86400 days))))
(if (integerp days)
(setcdr (cdr time) nil))
time))
@@ -277,9 +276,7 @@ return something of the form \"001 year\".
The \"%z\" specifier does not print anything. When it is used, specifiers
must be given in order of decreasing size. To the left of \"%z\", nothing
-is output until the first non-zero unit is encountered.
-
-This function does not work for SECONDS greater than `most-positive-fixnum'."
+is output until the first non-zero unit is encountered."
(let ((start 0)
(units '(("y" "year" 31536000)
("d" "day" 86400)
@@ -306,6 +303,7 @@ This function does not work for SECONDS greater than
`most-positive-fixnum'."
(push match usedunits)))
(and zeroflag larger
(error "Units are not in decreasing order of size"))
+ (setq seconds (floor seconds))
(dolist (u units)
(setq spec (car u)
name (cadr u)
diff --git a/lisp/cedet/semantic/wisent/comp.el
b/lisp/cedet/semantic/wisent/comp.el
index 837222a..21ea7ed 100644
--- a/lisp/cedet/semantic/wisent/comp.el
+++ b/lisp/cedet/semantic/wisent/comp.el
@@ -139,14 +139,7 @@ If optional LEFT is non-nil insert spaces on left."
;;;; Environment dependencies
;;;; ------------------------
-(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)))))
- (while (not (zerop (funcall do-shift i)))
- (setq i (1+ i)))
- i))
+(defconst wisent-BITS-PER-WORD (logcount most-positive-fixnum))
(defsubst wisent-WORDSIZE (n)
"(N + BITS-PER-WORD - 1) / BITS-PER-WORD."
@@ -156,18 +149,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."
diff --git a/lisp/comint.el b/lisp/comint.el
index a9c3e47..5928804 100644
--- a/lisp/comint.el
+++ b/lisp/comint.el
@@ -360,11 +360,12 @@ This variable is buffer-local."
"Kerberos" "CVS" "UNIX" " SMB" "LDAP" "PEM" "SUDO"
"[sudo]" "Repeat" "Bad" "Retype")
t)
- " +\\)"
+ ;; Allow for user name to precede password equivalent (Bug#31075).
+ " +.*\\)"
"\\(?:" (regexp-opt password-word-equivalents) "\\|Response\\)"
"\\(?:\\(?:, try\\)? *again\\| (empty for no passphrase)\\| (again)\\)?"
;; "[[:alpha:]]" used to be "for", which fails to match non-English.
- "\\(?: [[:alpha:]]+ .+\\)?[\\s ]*[:：៖][\\s ]*\\'")
+ "\\(?: [[:alpha:]]+ .+\\)?[[:blank:]]*[:：៖][[:blank:]]*\\'")
"Regexp matching prompts for passwords in the inferior process.
This is used by `comint-watch-for-password-prompt'."
:version "27.1"
diff --git a/lisp/composite.el b/lisp/composite.el
index 7daea54..3d4805e 100644
--- a/lisp/composite.el
+++ b/lisp/composite.el
@@ -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))
diff --git a/lisp/disp-table.el b/lisp/disp-table.el
index 13d73a9..95224f2 100644
--- a/lisp/disp-table.el
+++ b/lisp/disp-table.el
@@ -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))
diff --git a/lisp/dos-fns.el b/lisp/dos-fns.el
index ebb8acb..aeb8da4 100644
--- a/lisp/dos-fns.el
+++ b/lisp/dos-fns.el
@@ -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)
diff --git a/lisp/edmacro.el b/lisp/edmacro.el
index 7818062..c3d9bc5 100644
--- a/lisp/edmacro.el
+++ b/lisp/edmacro.el
@@ -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")
diff --git a/lisp/emacs-lisp/autoload.el b/lisp/emacs-lisp/autoload.el
index c458e7b..efeb056 100644
--- a/lisp/emacs-lisp/autoload.el
+++ b/lisp/emacs-lisp/autoload.el
@@ -768,7 +768,7 @@ FILE's modification time."
"define-erc-module"
"define-erc-response-handler"
"defun-rcirc-command"))))
- (push (match-string 2) defs))
+ (push (match-string-no-properties 2) defs))
(forward-sexp 1)
(forward-line 1)))))))
diff --git a/lisp/emacs-lisp/backtrace.el b/lisp/emacs-lisp/backtrace.el
index f13b43b..e82d4f5 100644
--- a/lisp/emacs-lisp/backtrace.el
+++ b/lisp/emacs-lisp/backtrace.el
@@ -34,6 +34,7 @@
(eval-when-compile (require 'cl-lib))
(eval-when-compile (require 'pcase))
(eval-when-compile (require 'subr-x)) ; if-let
+(require 'find-func)
(require 'help-mode) ; Define `help-function-def' button type.
(require 'lisp-mode)
@@ -735,11 +736,11 @@ Format it according to VIEW."
(evald (backtrace-frame-evald frame))
(fun (backtrace-frame-fun frame))
(args (backtrace-frame-args frame))
- (def (and (symbolp fun) (fboundp fun) (symbol-function fun)))
+ (def (find-function-advised-original fun))
(fun-file (or (symbol-file fun 'defun)
- (and (subrp def)
- (not (eq 'unevalled (cdr (subr-arity def))))
- (find-lisp-object-file-name fun def))))
+ (and (subrp def)
+ (not (eq 'unevalled (cdr (subr-arity def))))
+ (find-lisp-object-file-name fun def))))
(fun-pt (point)))
(cond
((and evald (not debugger-stack-frame-as-list))
@@ -762,7 +763,8 @@ Format it according to VIEW."
(insert (backtrace--print-to-string fun-and-args)))
(cl-incf fun-pt)))
(when fun-file
- (make-text-button fun-pt (+ fun-pt (length (symbol-name fun)))
+ (make-text-button fun-pt (+ fun-pt
+ (length (backtrace--print-to-string fun)))
:type 'help-function-def
'help-args (list fun fun-file)))
;; After any frame that uses eval-buffer, insert a comment that
diff --git a/lisp/emacs-lisp/bindat.el b/lisp/emacs-lisp/bindat.el
index c134376..3124217 100644
--- a/lisp/emacs-lisp/bindat.el
+++ b/lisp/emacs-lisp/bindat.el
@@ -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))
diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el
index 1920503..4854808 100644
--- a/lisp/emacs-lisp/byte-opt.el
+++ b/lisp/emacs-lisp/byte-opt.el
@@ -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.
diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el
index ee28e61..0b8f882 100644
--- a/lisp/emacs-lisp/bytecomp.el
+++ b/lisp/emacs-lisp/bytecomp.el
@@ -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 ())
diff --git a/lisp/emacs-lisp/cl-extra.el b/lisp/emacs-lisp/cl-extra.el
index 36b65f9..bea38a0 100644
--- a/lisp/emacs-lisp/cl-extra.el
+++ b/lisp/emacs-lisp/cl-extra.el
@@ -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))))
diff --git a/lisp/emacs-lisp/cl-lib.el b/lisp/emacs-lisp/cl-lib.el
index d7e72ce..592235d 100644
--- a/lisp/emacs-lisp/cl-lib.el
+++ b/lisp/emacs-lisp/cl-lib.el
@@ -531,8 +531,9 @@ If ALIST is non-nil, the new pairs are prepended to it."
;; Some more Emacs-related place types.
(gv-define-simple-setter buffer-file-name set-visited-file-name t)
(gv-define-setter buffer-modified-p (flag &optional buf)
- `(with-current-buffer ,buf
- (set-buffer-modified-p ,flag)))
+ (macroexp-let2 nil buffer `(or ,buf (current-buffer))
+ `(with-current-buffer ,buffer
+ (set-buffer-modified-p ,flag))))
(gv-define-simple-setter buffer-name rename-buffer t)
(gv-define-setter buffer-string (store)
`(insert (prog1 ,store (erase-buffer))))
diff --git a/lisp/emacs-lisp/edebug.el b/lisp/emacs-lisp/edebug.el
index fa418c6..fb567c9 100644
--- a/lisp/emacs-lisp/edebug.el
+++ b/lisp/emacs-lisp/edebug.el
@@ -894,8 +894,7 @@ circular objects. Let `read' read everything else."
(while (and (>= (following-char) ?0) (<= (following-char) ?9))
(forward-char 1))
(let ((n (string-to-number (buffer-substring start (point)))))
- (when (and read-circle
- (<= n most-positive-fixnum))
+ (when read-circle
(cond
((eq ?= (following-char))
;; Make a placeholder for #n# to use temporarily.
@@ -910,7 +909,7 @@ circular objects. Let `read' read everything else."
(throw 'return (setf (cdr elem) obj)))))
((eq ?# (following-char))
;; #n# returns a previously read object.
- (let ((elem (assq n edebug-read-objects)))
+ (let ((elem (assoc n edebug-read-objects)))
(when (consp elem)
(forward-char 1)
(throw 'return (cdr elem))))))))))
diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el
index cacc8b0..2ddab65 100644
--- a/lisp/emacs-lisp/package.el
+++ b/lisp/emacs-lisp/package.el
@@ -2673,12 +2673,11 @@ to their archives."
((not package-menu-hide-low-priority)
pkg-list)
((eq package-menu-hide-low-priority 'archive)
- (let* ((max-priority most-negative-fixnum)
- (out))
+ (let (max-priority out)
(while pkg-list
(let ((p (pop pkg-list)))
(let ((priority (package-desc-priority p)))
- (if (< priority max-priority)
+ (if (and max-priority (< priority max-priority))
(setq pkg-list nil)
(push p out)
(setq max-priority priority)))))
diff --git a/lisp/erc/erc-dcc.el b/lisp/erc/erc-dcc.el
index fdc2099..8de0007 100644
--- a/lisp/erc/erc-dcc.el
+++ b/lisp/erc/erc-dcc.el
@@ -224,14 +224,6 @@ which is big-endian."
(setq i (1- i)))
str))
-(defconst erc-most-positive-int-bytes
- (ceiling (/ (ceiling (/ (log most-positive-fixnum) (log 2))) 8.0))
- "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))))
- "Content of the most significant byte of most-positive-fixnum.")
-
(defun erc-unpack-int (str)
"Unpack a packed string into an integer."
(let ((len (length str)))
@@ -242,16 +234,11 @@ which is big-endian."
(when (> start 0)
(setq str (substring str start))
(setq len (- len start))))
- ;; make sure size is not larger than Emacs can handle
- (when (or (> len (min 4 erc-most-positive-int-bytes))
- (and (eq len erc-most-positive-int-bytes)
- (> (aref str 0) erc-most-positive-int-msb)))
- (error "ERC-DCC (erc-unpack-int): packet to send is too large"))
;; unpack
(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)))
diff --git a/lisp/eshell/esh-mode.el b/lisp/eshell/esh-mode.el
index 9f854c7..0c25f41 100644
--- a/lisp/eshell/esh-mode.el
+++ b/lisp/eshell/esh-mode.el
@@ -182,10 +182,11 @@ inserted. They return the string as it should be
inserted."
:group 'eshell-mode)
(defcustom eshell-password-prompt-regexp
- (format "\\(%s\\).*:\\s *\\'" (regexp-opt password-word-equivalents))
+ (format "\\(%s\\)[^:：៖]*[:：៖]\\s *\\'" (regexp-opt
password-word-equivalents))
"Regexp matching prompts for passwords in the inferior process.
This is used by `eshell-watch-for-password-prompt'."
:type 'regexp
+ :version "27.1"
:group 'eshell-mode)
(defcustom eshell-skip-prompt-function nil
diff --git a/lisp/facemenu.el b/lisp/facemenu.el
index a4f675b..7c10d60 100644
--- a/lisp/facemenu.el
+++ b/lisp/facemenu.el
@@ -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
diff --git a/lisp/files-x.el b/lisp/files-x.el
index 2a52792..92532e8 100644
--- a/lisp/files-x.el
+++ b/lisp/files-x.el
@@ -377,7 +377,9 @@ from the -*- line ignoring the input argument VALUE."
((eq variable 'mode) (goto-char beg))
((null replaced-pos) (goto-char end))
(replaced-pos (goto-char replaced-pos)))
- (if (and (not (eq (char-before) ?\;))
+ (if (and (save-excursion
+ (skip-chars-backward " \t")
+ (not (eq (char-before) ?\;)))
(not (equal (point) (marker-position beg)))
;; When existing `-*- -*-' is empty, beg > end.
(not (> (marker-position beg) (marker-position end))))
diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el
index dde9c28..66356b6 100644
--- a/lisp/gnus/message.el
+++ b/lisp/gnus/message.el
@@ -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)))))
+ (random (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.
diff --git a/lisp/gnus/nndoc.el b/lisp/gnus/nndoc.el
index 149406a..76e785d 100644
--- a/lisp/gnus/nndoc.el
+++ b/lisp/gnus/nndoc.el
@@ -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
diff --git a/lisp/gnus/nnfolder.el b/lisp/gnus/nnfolder.el
index 826fd8d..11a3986 100644
--- a/lisp/gnus/nnfolder.el
+++ b/lisp/gnus/nnfolder.el
@@ -877,17 +877,17 @@ deleted. Point is left where the deleted region was."
(delete-char 1))
(nnmail-activate 'nnfolder)
;; Read in the file.
- (let ((delim "^From ")
- (marker (concat "\n" nnfolder-article-marker))
- (number "[0-9]+")
- (active (or (cadr (assoc group nnfolder-group-alist))
- (cons 1 0)))
- (scantime (assoc group nnfolder-scantime-alist))
- (minid most-positive-fixnum)
- maxid start end newscantime
- novbuf articles newnum
- buffer-read-only)
- (setq maxid (cdr active))
+ (let* ((delim "^From ")
+ (marker (concat "\n" nnfolder-article-marker))
+ (number "[0-9]+")
+ (active (or (cadr (assoc group nnfolder-group-alist))
+ (cons 1 0)))
+ (scantime (assoc group nnfolder-scantime-alist))
+ (minid (cdr active))
+ maxid start end newscantime
+ novbuf articles newnum
+ buffer-read-only)
+ (setq maxid minid)
(unless (or gnus-nov-is-evil nnfolder-nov-is-evil
(and (file-exists-p nov)
@@ -958,7 +958,7 @@ deleted. Point is left where the deleted region was."
(while (not (= end (point-max)))
(setq start (marker-position end))
(goto-char end)
- ;; There may be more than one "From " line, so we skip past
+ ;; There may be more than one "From " line, so we skip past
;; them.
(while (looking-at delim)
(forward-line 1))
diff --git a/lisp/gnus/nnmaildir.el b/lisp/gnus/nnmaildir.el
index d5cfa27..c8480dd 100644
--- a/lisp/gnus/nnmaildir.el
+++ b/lisp/gnus/nnmaildir.el
@@ -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
diff --git a/lisp/image.el b/lisp/image.el
index 8d12b68..74a2304 100644
--- a/lisp/image.el
+++ b/lisp/image.el
@@ -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))
diff --git a/lisp/international/ccl.el b/lisp/international/ccl.el
index 58083f0..a80452f 100644
--- a/lisp/international/ccl.el
+++ b/lisp/international/ccl.el
@@ -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)))))
diff --git a/lisp/international/fontset.el b/lisp/international/fontset.el
index 9bd05ce..529262a 100644
--- a/lisp/international/fontset.el
+++ b/lisp/international/fontset.el
@@ -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)))
diff --git a/lisp/international/mule-cmds.el b/lisp/international/mule-cmds.el
index 2bde83f..817a26b 100644
--- a/lisp/international/mule-cmds.el
+++ b/lisp/international/mule-cmds.el
@@ -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)
diff --git a/lisp/international/mule-conf.el b/lisp/international/mule-conf.el
index 3affeec..b08150a 100644
--- a/lisp/international/mule-conf.el
+++ b/lisp/international/mule-conf.el
@@ -1304,6 +1304,11 @@ is treated as a character."
:bom '(utf-8-with-signature . utf-8))
(define-coding-system-alias 'mule-utf-8 'utf-8)
+;; See this page:
+;; https://docs.microsoft.com/en-us/windows/desktop/intl/code-page-identifiers
+;; Starting with Windows 10, people are trying to set their systems to
+;; use UTF-8 , so we had better recognized this alias:
+(define-coding-system-alias 'cp65001 'utf-8)
(define-coding-system 'utf-8-emacs
"Support for all Emacs characters (including non-Unicode characters)."
diff --git a/lisp/international/mule-util.el b/lisp/international/mule-util.el
index 661001a..cf2b29c 100644
--- a/lisp/international/mule-util.el
+++ b/lisp/international/mule-util.el
@@ -342,7 +342,7 @@ per-character basis, this may not be accurate."
(let ((eol-offset 0)
;; Make sure we terminate, even if BYTE falls right in the middle
;; of a CRLF or some other weird corner case.
- (omin 0) (omax most-positive-fixnum)
+ (omin 0) omax
pos lines)
(while
(progn
@@ -355,9 +355,9 @@ per-character basis, this may not be accurate."
(setq pos (point-max))))
;; Adjust POS for DOS EOL format.
(setq lines (1- (line-number-at-pos pos)))
- (and (not (= lines eol-offset)) (> omax omin)))
+ (and (not (= lines eol-offset)) (or (not omax) (> omax omin))))
(if (> lines eol-offset)
- (setq omax (min (1- omax) lines)
+ (setq omax (if omax (min (1- omax) lines) lines)
eol-offset omax)
(setq omin (max (1+ omin) lines)
eol-offset omin)))
diff --git a/lisp/international/mule.el b/lisp/international/mule.el
index 0267b15..a4f3441 100644
--- a/lisp/international/mule.el
+++ b/lisp/international/mule.el
@@ -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))))
diff --git a/lisp/json.el b/lisp/json.el
index cd95ec2..112f269 100644
--- a/lisp/json.el
+++ b/lisp/json.el
@@ -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."
diff --git a/lisp/mail/binhex.el b/lisp/mail/binhex.el
index 299fc0b..fa2ea3d 100644
--- a/lisp/mail/binhex.el
+++ b/lisp/mail/binhex.el
@@ -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
diff --git a/lisp/mail/emacsbug.el b/lisp/mail/emacsbug.el
index d4caeed..92b005d 100644
--- a/lisp/mail/emacsbug.el
+++ b/lisp/mail/emacsbug.el
@@ -116,6 +116,9 @@ This requires either the macOS \"open\" command, or the
freedesktop
(concat "mailto:"; to)))
(error "Subject, To or body not found")))))
+(defvar report-emacs-bug--os-description nil
+ "Cached value of operating system description.")
+
(defun report-emacs-bug--os-description ()
"Return a string describing the operating system, or nil."
(cond ((eq system-type 'darwin)
@@ -129,9 +132,38 @@ This requires either the macOS \"open\" command, or the
freedesktop
nil t)
(setq os (concat os " " (match-string 1)))))))
os))
- ;; TODO include other branches here.
- ;; MS Windows: systeminfo ?
- ;; Cygwin, *BSD, etc: ?
+ ((eq system-type 'windows-nt)
+ (or report-emacs-bug--os-description
+ (setq
+ report-emacs-bug--os-description
+ (let (os)
+ (with-temp-buffer
+ ;; Seems like this command can be slow, because it
+ ;; unconditionally queries a bunch of other stuff
+ ;; we don't care about.
+ (when (eq 0 (ignore-errors
+ (call-process "systeminfo" nil '(t nil) nil)))
+ (dolist (s '("OS Name" "OS Version"))
+ (goto-char (point-min))
+ (if (re-search-forward
+ (format "^%s\\s-*:\\s-+\\(.*\\)$" s)
+ nil t)
+ (setq os (concat os " " (match-string 1)))))))
+ os))))
+ ((eq system-type 'berkeley-unix)
+ (with-temp-buffer
+ (when
+ (or (eq 0 (ignore-errors (call-process "freebsd-version" nil
+ '(t nil) nil "-u")))
+ (progn (erase-buffer)
+ (eq 0 (ignore-errors
+ (call-process "uname" nil
+ '(t nil) nil "-a")))))
+ (unless (zerop (buffer-size))
+ (goto-char (point-min))
+ (buffer-substring (line-beginning-position)
+ (line-end-position))))))
+ ;; TODO Cygwin, Solaris (usg-unix-v).
(t
(or (let ((file "/etc/os-release"))
(and (file-readable-p file)
diff --git a/lisp/mail/rmail.el b/lisp/mail/rmail.el
index 12a58b2..9416d04 100644
--- a/lisp/mail/rmail.el
+++ b/lisp/mail/rmail.el
@@ -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)))
diff --git a/lisp/mail/rmailsum.el b/lisp/mail/rmailsum.el
index e5363d2..10345b6 100644
--- a/lisp/mail/rmailsum.el
+++ b/lisp/mail/rmailsum.el
@@ -1315,11 +1315,7 @@ advance to the next message."
(select-window rmail-buffer-window)
(prog1
;; Is EOB visible in the buffer?
- (save-excursion
- (let ((ht (window-height)))
- (move-to-window-line (- ht 2))
- (end-of-line)
- (eobp)))
+ (pos-visible-in-window-p (point-max))
(select-window rmail-summary-window)))
(if (not rmail-summary-scroll-between-messages)
(error "End of buffer")
@@ -1342,10 +1338,7 @@ move to the previous message."
(select-window rmail-buffer-window)
(prog1
;; Is BOB visible in the buffer?
- (save-excursion
- (move-to-window-line 0)
- (beginning-of-line)
- (bobp))
+ (pos-visible-in-window-p (point-min))
(select-window rmail-summary-window)))
(if (not rmail-summary-scroll-between-messages)
(error "Beginning of buffer")
diff --git a/lisp/mail/uudecode.el b/lisp/mail/uudecode.el
index 0cdceca..b8f74e3 100644
--- a/lisp/mail/uudecode.el
+++ b/lisp/mail/uudecode.el
@@ -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
diff --git a/lisp/md4.el b/lisp/md4.el
index 09b54fc..788846a 100644
--- a/lisp/md4.el
+++ b/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)
diff --git a/lisp/menu-bar.el b/lisp/menu-bar.el
index ad59533..20d5ad9 100644
--- a/lisp/menu-bar.el
+++ b/lisp/menu-bar.el
@@ -2135,9 +2135,9 @@ It must accept a buffer as its only required argument.")
;; Make the menu of buffers proper.
(setq buffers-menu
(let ((i 0)
- (limit (if (and (integerp buffers-menu-max-size)
- (> buffers-menu-max-size 1))
- buffers-menu-max-size most-positive-fixnum))
+ (limit (and (integerp buffers-menu-max-size)
+ (> buffers-menu-max-size 1)
+ buffers-menu-max-size))
alist)
;; Put into each element of buffer-list
;; the name for actual display,
@@ -2161,7 +2161,7 @@ It must accept a buffer as its only required argument.")
alist)
;; If requested, list only the N most recently
;; selected buffers.
- (when (= limit (setq i (1+ i)))
+ (when (eql limit (setq i (1+ i)))
(setq buffers nil)))))
(list (menu-bar-buffer-vector alist))))
diff --git a/lisp/net/dns.el b/lisp/net/dns.el
index 057ae32..b3b430d 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/imap.el b/lisp/net/imap.el
index 2a2ce8b..042b0f9 100644
--- a/lisp/net/imap.el
+++ b/lisp/net/imap.el
@@ -1696,18 +1696,6 @@ MAILBOX specifies a mailbox on the server in BUFFER."
(concat "UID STORE " articles
" +FLAGS" (if silent ".SILENT") " (" flags ")"))))))
-;; Cf. http://thread.gmane.org/gmane.emacs.gnus.general/65317/focus=65343
-;; Signal an error if we'd get an integer overflow.
-;;
-;; FIXME: Identify relevant calls to `string-to-number' and replace them with
-;; `imap-string-to-integer'.
-(defun imap-string-to-integer (string &optional base)
- (let ((number (string-to-number string base)))
- (if (> number most-positive-fixnum)
- (error
- (format "String %s cannot be converted to a Lisp integer" number))
- number)))
-
(defun imap-fetch-safe (uids props &optional receive nouidfetch buffer)
"Like `imap-fetch', but DTRT with Exchange 2007 bug.
However, UIDS here is a cons, where the car is the canonical form
diff --git a/lisp/net/ntlm.el b/lisp/net/ntlm.el
index 8366bc1..217f0b8 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/rcirc.el b/lisp/net/rcirc.el
index 108e368..fe9c71a 100644
--- a/lisp/net/rcirc.el
+++ b/lisp/net/rcirc.el
@@ -2787,10 +2787,7 @@ the only argument."
"RPL_WHOISIDLE"
(let* ((nick (nth 1 args))
(idle-secs (string-to-number (nth 2 args)))
- (idle-string
- (if (< idle-secs most-positive-fixnum)
- (format-seconds "%yy %dd %hh %mm %z%ss" idle-secs)
- "a very long time"))
+ (idle-string (format-seconds "%yy %dd %hh %mm %z%ss" idle-secs))
(signon-time (seconds-to-time (string-to-number (nth 3 args))))
(signon-string (format-time-string "%c" signon-time))
(message (format "%s idle for %s, signed on %s"
diff --git a/lisp/net/sasl.el b/lisp/net/sasl.el
index b4f0fff..ca0b66b 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/shr.el b/lisp/net/shr.el
index edea7cb..bc86fe5 100644
--- a/lisp/net/shr.el
+++ b/lisp/net/shr.el
@@ -68,6 +68,13 @@ fit these criteria."
:group 'shr
:type 'boolean)
+(defcustom shr-discard-aria-hidden nil
+ "If non-nil, don't render tags with `aria-hidden=\"true\"'.
+This attribute is meant to tell screen readers to ignore a tag."
+ :version "27.1"
+ :group 'shr
+ :type 'boolean)
+
(defcustom shr-use-colors t
"If non-nil, respect color specifications in the HTML."
:version "26.1"
@@ -509,7 +516,9 @@ size, and full-buffer size."
shr-stylesheet))
(setq style nil)))
;; If we have a display:none, then just ignore this part of the DOM.
- (unless (equal (cdr (assq 'display shr-stylesheet)) "none")
+ (unless (or (equal (cdr (assq 'display shr-stylesheet)) "none")
+ (and shr-discard-aria-hidden
+ (equal (dom-attr dom 'aria-hidden) "true")))
;; We don't use shr-indirect-call here, since shr-descend is
;; the central bit of shr.el, and should be as fast as
;; possible. Having one more level of indirection with its
diff --git a/lisp/net/socks.el b/lisp/net/socks.el
index 4a3b132..5ee6eea 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-adb.el b/lisp/net/tramp-adb.el
index 297bdd7..35b0fdd 100644
--- a/lisp/net/tramp-adb.el
+++ b/lisp/net/tramp-adb.el
@@ -265,12 +265,12 @@ pass to the OPERATION."
"[[:space:]]+\\([[:digit:]]+\\)"))
;; The values are given as 1k numbers, so we must change
;; them to number of bytes.
- (list (* 1024 (string-to-number (concat (match-string 1) "e0")))
+ (list (* 1024 (string-to-number (match-string 1)))
;; The second value is the used size. We need the
;; free size.
- (* 1024 (- (string-to-number (concat (match-string 1) "e0"))
- (string-to-number (concat (match-string 2) "e0"))))
- (* 1024 (string-to-number (concat (match-string 3) "e0")))))))))
+ (* 1024 (- (string-to-number (match-string 1))
+ (string-to-number (match-string 2))))
+ (* 1024 (string-to-number (match-string 3)))))))))
;; This is derived from `tramp-sh-handle-file-truename'. Maybe the
;; code could be shared?
diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el
index 84af410..f46ddc6 100644
--- a/lisp/net/tramp-gvfs.el
+++ b/lisp/net/tramp-gvfs.el
@@ -1273,10 +1273,9 @@ file-notify events."
(used (cdr (assoc "filesystem::used" attr)))
(free (cdr (assoc "filesystem::free" attr))))
(when (and (stringp size) (stringp used) (stringp free))
- (list (string-to-number (concat size "e0"))
- (- (string-to-number (concat size "e0"))
- (string-to-number (concat used "e0")))
- (string-to-number (concat free "e0")))))))
+ (list (string-to-number size)
+ (- (string-to-number size) (string-to-number used))
+ (string-to-number free))))))
(defun tramp-gvfs-handle-file-writable-p (filename)
"Like `file-writable-p' for Tramp files."
diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el
index 86e82d4..64d2081 100644
--- a/lisp/net/tramp-sh.el
+++ b/lisp/net/tramp-sh.el
@@ -694,7 +694,7 @@ else
$uid = ($ARGV[1] eq \"integer\") ? $stat[4] : \"\\\"\" . getpwuid($stat[4]) .
\"\\\"\";
$gid = ($ARGV[1] eq \"integer\") ? $stat[5] : \"\\\"\" . getgrgid($stat[5]) .
\"\\\"\";
printf(
- \"(%%s %%u %%s %%s (%%u %%u) (%%u %%u) (%%u %%u) %%u.0 %%u t (%%u . %%u)
-1)\\n\",
+ \"(%%s %%u %%s %%s (%%u %%u) (%%u %%u) (%%u %%u) %%u %%u t %%u -1)\\n\",
$type,
$stat[3],
$uid,
@@ -707,8 +707,7 @@ printf(
$stat[10] & 0xffff,
$stat[7],
$stat[2],
- $stat[1] >> 16 & 0xffff,
- $stat[1] & 0xffff
+ $stat[1]
);' \"$1\" \"$2\" 2>/dev/null"
"Perl script to produce output suitable for use with `file-attributes'
on the remote file system.
@@ -1393,7 +1392,7 @@ component is used as the target of the symlink."
;; `tramp-stat-marker', in order to make a proper shell escape of
;; them in file names.
"( (%s %s || %s -h %s) && (%s -c "
- "'((%s%%N%s) %%h %s %s %%Xe0 %%Ye0 %%Ze0 %%se0 %s%%A%s t %%ie0 -1)' "
+ "'((%s%%N%s) %%h %s %s %%X %%Y %%Z %%s %s%%A%s t %%i -1)' "
"%s | sed -e 's/\"/\\\\\"/g' -e 's/%s/\"/g') || echo nil)")
(tramp-get-file-exists-command vec)
(tramp-shell-quote-argument localname)
@@ -1402,9 +1401,9 @@ component is used as the target of the symlink."
(tramp-get-remote-stat vec)
tramp-stat-marker tramp-stat-marker
(if (eq id-format 'integer)
- "%ue0" (concat tramp-stat-marker "%U" tramp-stat-marker))
+ "%u" (concat tramp-stat-marker "%U" tramp-stat-marker))
(if (eq id-format 'integer)
- "%ge0" (concat tramp-stat-marker "%G" tramp-stat-marker))
+ "%g" (concat tramp-stat-marker "%G" tramp-stat-marker))
tramp-stat-marker tramp-stat-marker
(tramp-shell-quote-argument localname)
tramp-stat-quoted-marker)))
@@ -1825,7 +1824,7 @@ be non-negative integers."
;; make a proper shell escape of them in file names.
"cd %s && echo \"(\"; (%s %s -a | "
"xargs %s -c "
- "'(%s%%n%s (%s%%N%s) %%h %s %s %%Xe0 %%Ye0 %%Ze0 %%se0 %s%%A%s t %%ie0
-1)' "
+ "'(%s%%n%s (%s%%N%s) %%h %s %s %%X %%Y %%Z %%s %s%%A%s t %%i -1)' "
"-- 2>/dev/null | sed -e 's/\"/\\\\\"/g' -e 's/%s/\"/g'); echo \")\"")
(tramp-shell-quote-argument localname)
(tramp-get-ls-command vec)
@@ -1836,9 +1835,9 @@ be non-negative integers."
tramp-stat-marker tramp-stat-marker
tramp-stat-marker tramp-stat-marker
(if (eq id-format 'integer)
- "%ue0" (concat tramp-stat-marker "%U" tramp-stat-marker))
+ "%u" (concat tramp-stat-marker "%U" tramp-stat-marker))
(if (eq id-format 'integer)
- "%ge0" (concat tramp-stat-marker "%G" tramp-stat-marker))
+ "%g" (concat tramp-stat-marker "%G" tramp-stat-marker))
tramp-stat-marker tramp-stat-marker
tramp-stat-quoted-marker)))
@@ -3806,12 +3805,12 @@ file-notify events."
(concat "[[:space:]]*\\([[:digit:]]+\\)"
"[[:space:]]+\\([[:digit:]]+\\)"
"[[:space:]]+\\([[:digit:]]+\\)"))
- (list (string-to-number (concat (match-string 1) "e0"))
+ (list (string-to-number (match-string 1))
;; The second value is the used size. We need the
;; free size.
- (- (string-to-number (concat (match-string 1) "e0"))
- (string-to-number (concat (match-string 2) "e0")))
- (string-to-number (concat (match-string 3) "e0")))))))))
+ (- (string-to-number (match-string 1))
+ (string-to-number (match-string 2)))
+ (string-to-number (match-string 3)))))))))
;;; Internal Functions:
@@ -5117,19 +5116,13 @@ Return ATTR."
(setcar (nthcdr 3 attr) (round (nth 3 attr))))
;; Convert last access time.
(unless (listp (nth 4 attr))
- (setcar (nthcdr 4 attr)
- (list (floor (nth 4 attr) 65536)
- (floor (mod (nth 4 attr) 65536)))))
+ (setcar (nthcdr 4 attr) (seconds-to-time (nth 4 attr))))
;; Convert last modification time.
(unless (listp (nth 5 attr))
- (setcar (nthcdr 5 attr)
- (list (floor (nth 5 attr) 65536)
- (floor (mod (nth 5 attr) 65536)))))
+ (setcar (nthcdr 5 attr) (seconds-to-time (nth 5 attr))))
;; Convert last status change time.
(unless (listp (nth 6 attr))
- (setcar (nthcdr 6 attr)
- (list (floor (nth 6 attr) 65536)
- (floor (mod (nth 6 attr) 65536)))))
+ (setcar (nthcdr 6 attr) (seconds-to-time (nth 6 attr))))
;; Convert file size.
(when (< (nth 7 attr) 0)
(setcar (nthcdr 7 attr) -1))
@@ -5160,7 +5153,7 @@ Return ATTR."
(nth 3 attr)
(tramp-get-remote-gid vec 'string)))))
;; Convert inode.
- (unless (listp (nth 10 attr))
+ (when (floatp (nth 10 attr))
(setcar (nthcdr 10 attr)
(condition-case nil
(let ((high (nth 10 attr))
diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el
index 335f05c..583acbd 100644
--- a/lisp/net/tramp-smb.el
+++ b/lisp/net/tramp-smb.el
@@ -959,18 +959,15 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are
completely ignored."
(concat "[[:space:]]*\\([[:digit:]]+\\)"
" blocks of size \\([[:digit:]]+\\)"
"\\. \\([[:digit:]]+\\) blocks available"))
- (setq blocksize (string-to-number (concat (match-string 2) "e0"))
- total (* blocksize
- (string-to-number (concat (match-string 1) "e0")))
- avail (* blocksize
- (string-to-number (concat (match-string 3) "e0")))))
+ (setq blocksize (string-to-number (match-string 2))
+ total (* blocksize (string-to-number (match-string 1)))
+ avail (* blocksize (string-to-number (match-string 3)))))
(forward-line)
(when (looking-at "Total number of bytes: \\([[:digit:]]+\\)")
;; The used number of bytes is not part of the result. As
;; side effect, we store it as file property.
(tramp-set-file-property
- v localname "used-bytes"
- (string-to-number (concat (match-string 1) "e0"))))
+ v localname "used-bytes" (string-to-number (match-string 1))))
;; Result.
(when (and total avail)
(list total (- total avail) avail)))))))
diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el
index 5429cdf..62c9f9a 100644
--- a/lisp/net/tramp.el
+++ b/lisp/net/tramp.el
@@ -7,6 +7,8 @@
;; Maintainer: Michael Albinus <address@hidden>
;; Keywords: comm, processes
;; Package: tramp
+;; Version: 2.4.1-pre
+;; Package-Requires: ((emacs "24.1"))
;; This file is part of GNU Emacs.
@@ -35,8 +37,6 @@
;; Notes:
;; -----
;;
-;; This package only works for Emacs 24.1 and higher.
-;;
;; Also see the todo list at the bottom of this file.
;;
;; The current version of Tramp can be retrieved from the following URL:
@@ -4150,13 +4150,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"))
diff --git a/lisp/net/trampver.el b/lisp/net/trampver.el
index 2bccdf0..7b2079b 100644
--- a/lisp/net/trampver.el
+++ b/lisp/net/trampver.el
@@ -53,10 +53,10 @@
(replace-regexp-in-string "\n" "" (buffer-string))))))))
;; Check for Emacs version.
-(let ((x (if (>= emacs-major-version 24)
- "ok"
- (format "Tramp 2.4.1-pre is not fit for %s"
- (replace-regexp-in-string "\n" "" (emacs-version))))))
+(let ((x (if (not (string-lessp emacs-version "24.1"))
+ "ok"
+ (format "Tramp 2.4.1-pre is not fit for %s"
+ (replace-regexp-in-string "\n" "" (emacs-version))))))
(unless (string-equal "ok" x) (error "%s" x)))
;; Tramp versions integrated into Emacs.
diff --git a/lisp/obsolete/levents.el b/lisp/obsolete/levents.el
index 7fb3be8..48afe75 100644
--- a/lisp/obsolete/levents.el
+++ b/lisp/obsolete/levents.el
@@ -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)
diff --git a/lisp/obsolete/pgg-parse.el b/lisp/obsolete/pgg-parse.el
index 34ec96e..a747024 100644
--- a/lisp/obsolete/pgg-parse.el
+++ b/lisp/obsolete/pgg-parse.el
@@ -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)))
diff --git a/lisp/org/org-agenda.el b/lisp/org/org-agenda.el
index cbfaf88..98e89eb 100644
--- a/lisp/org/org-agenda.el
+++ b/lisp/org/org-agenda.el
@@ -7009,15 +7009,15 @@ When TYPE is \"scheduled\", \"deadline\", \"timestamp\"
or
\"timestamp_ia\", compare within each of these type. When TYPE
is the empty string, compare all timestamps without respect of
their type."
- (let* ((def (if org-sort-agenda-notime-is-late most-positive-fixnum -1))
+ (let* ((def (and (not org-sort-agenda-notime-is-late) -1))
(ta (or (and (string-match type (or (get-text-property 1 'type a) ""))
(get-text-property 1 'ts-date a))
def))
(tb (or (and (string-match type (or (get-text-property 1 'type b) ""))
(get-text-property 1 'ts-date b))
def)))
- (cond ((< ta tb) -1)
- ((< tb ta) +1))))
+ (cond ((if ta (and tb (< ta tb)) tb) -1)
+ ((if tb (and ta (< tb ta)) ta) +1))))
(defsubst org-cmp-habit-p (a b)
"Compare the todo states of strings A and B."
diff --git a/lisp/org/org-element.el b/lisp/org/org-element.el
index b32f852..b8f1467 100644
--- a/lisp/org/org-element.el
+++ b/lisp/org/org-element.el
@@ -4856,7 +4856,7 @@ table is cleared once the synchronization is complete."
(defun org-element--cache-generate-key (lower upper)
"Generate a key between LOWER and UPPER.
-LOWER and UPPER are integers or lists, possibly empty.
+LOWER and UPPER are fixnums or lists of same, possibly empty.
If LOWER and UPPER are equals, return LOWER. Otherwise, return
a unique key, as an integer or a list of integers, according to
diff --git a/lisp/org/org-footnote.el b/lisp/org/org-footnote.el
index c6376ca..5d472bd 100644
--- a/lisp/org/org-footnote.el
+++ b/lisp/org/org-footnote.el
@@ -636,7 +636,7 @@ or new, let the user edit the definition of the footnote."
(let* ((all (org-footnote-all-labels))
(label
(if (eq org-footnote-auto-label 'random)
- (format "%x" (random most-positive-fixnum))
+ (format "%x" (abs (random)))
(org-footnote-normalize-label
(let ((propose (org-footnote-unique-label all)))
(if (eq org-footnote-auto-label t) propose
diff --git a/lisp/org/org.el b/lisp/org/org.el
index e45bc55..21d9cd8 100644
--- a/lisp/org/org.el
+++ b/lisp/org/org.el
@@ -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
diff --git a/lisp/org/ox-publish.el b/lisp/org/ox-publish.el
index 8901dba..ba5a023 100644
--- a/lisp/org/ox-publish.el
+++ b/lisp/org/ox-publish.el
@@ -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))))))
diff --git a/lisp/progmodes/cc-cmds.el b/lisp/progmodes/cc-cmds.el
index 31cf0b1..4f256e1 100644
--- a/lisp/progmodes/cc-cmds.el
+++ b/lisp/progmodes/cc-cmds.el
@@ -1383,7 +1383,7 @@ No indentation or other \"electric\" behavior is
performed."
(let ((eo-block (point))
bod)
(and (eq (char-before) ?\})
- (eq (car (c-beginning-of-decl-1 lim)) 'previous)
+ (memq (car (c-beginning-of-decl-1 lim)) '(same previous))
(setq bod (point))
;; Look for struct or union or ... If we find one, it might
;; be the return type of a function, or the like. Exclude
@@ -1441,14 +1441,23 @@ No indentation or other \"electric\" behavior is
performed."
'in-block)
((c-in-function-trailer-p)
'in-trailer)
- ((and (not least-enclosing)
- (consp paren-state)
- (consp (car paren-state))
- (eq start (cdar paren-state))
- (not
- (progn
- (c-forward-syntactic-ws)
- (looking-at c-symbol-start))))
+ ((or (and (eq (char-before) ?\;)
+ (save-excursion
+ (backward-char)
+ (c-in-function-trailer-p)))
+ (and (not least-enclosing)
+ (consp paren-state)
+ (consp (car paren-state))
+ (eq start (cdar paren-state))
+ (or
+ (save-excursion
+ (c-forward-syntactic-ws)
+ (or (not (looking-at c-symbol-start))
+ (looking-at c-keywords-regexp)))
+ (save-excursion
+ (goto-char (caar paren-state))
+ (c-beginning-of-decl-1)
+ (not (looking-at c-defun-type-name-decl-key))))))
'at-function-end)
(t
;; Find the start of the current declaration. NOTE: If we're in the
@@ -1841,7 +1850,7 @@ or NIL if there isn't one. \"Defun\" here means a
function, or
other top level construct with a brace block."
(c-save-buffer-state
(beginning-of-defun-function end-of-defun-function
- where pos decl name-start name-end case-fold-search)
+ where pos decl0 decl type-pos tag-pos case-fold-search)
(save-excursion
;; Move back out of any macro/comment/string we happen to be in.
@@ -1861,31 +1870,10 @@ other top level construct with a brace block."
(when (looking-at c-typedef-key)
(goto-char (match-end 0))
(c-forward-syntactic-ws))
+ (setq type-pos (point))
;; Pick out the defun name, according to the type of defun.
(cond
- ;; struct, union, enum, or similar:
- ((save-excursion
- (and
- (looking-at c-defun-type-name-decl-key)
- (consp (c-forward-decl-or-cast-1 (c-point 'bosws) 'top nil))
- (or (not (or (eq (char-after) ?{)
- (and c-recognize-knr-p
- (c-in-knr-argdecl))))
- (progn (c-backward-syntactic-ws)
- (not (eq (char-before) ?\)))))))
- (let ((key-pos (point)))
- (c-forward-over-token-and-ws) ; over "struct ".
- (cond
- ((looking-at c-symbol-key) ; "struct foo { ..."
- (buffer-substring-no-properties key-pos (match-end 0)))
- ((eq (char-after) ?{) ; "struct { ... } foo"
- (when (c-go-list-forward)
- (c-forward-syntactic-ws)
- (when (looking-at c-symbol-key) ; a bit bogus - there might
- ; be several identifiers.
- (match-string-no-properties 0)))))))
-
((looking-at "DEFUN\\s-*(") ;"DEFUN\\_>") think of XEmacs!
;; DEFUN ("file-name-directory", Ffile_name_directory,
Sfile_name_directory, ...) ==> Ffile_name_directory
;; DEFUN(POSIX::STREAM-LOCK, stream lockp &key BLOCK SHARED START
LENGTH) ==> POSIX::STREAM-LOCK
@@ -1901,32 +1889,23 @@ other top level construct with a brace block."
(c-backward-syntactic-ws)
(point))))
- (t
- ;; Normal function or initializer.
- (when
- (and
- (consp
- (setq decl
- (c-forward-decl-or-cast-1 (c-point 'bosws) 'top nil)))
- (setq name-start (car decl))
- (progn (if (and (looking-at c-after-suffixed-type-decl-key)
- (match-beginning 1))
- (c-forward-keyword-clause 1))
- t)
- (or (eq (char-after) ?{)
- (and c-recognize-knr-p
- (c-in-knr-argdecl)))
- (goto-char name-start)
- (c-forward-name)
- (eq (char-after) ?\())
- (c-backward-syntactic-ws)
- (when (eq (char-before) ?\=) ; struct foo bar = {0, 0} ;
- (c-backward-token-2)
- (c-backward-syntactic-ws))
- (setq name-end (point))
- (c-back-over-compound-identifier)
- (and (looking-at c-symbol-start)
- (buffer-substring-no-properties (point) name-end)))))))))
+ (t ; Normal function or initializer.
+ (when (looking-at c-defun-type-name-decl-key) ; struct, etc.
+ (goto-char (match-end 0))
+ (c-forward-syntactic-ws)
+ (setq tag-pos (point))
+ (goto-char type-pos))
+ (setq decl0 (c-forward-decl-or-cast-1 (c-point 'bosws) 'top nil))
+ (when (consp decl0)
+ (goto-char (car decl0))
+ (setq decl (c-forward-declarator)))
+ (and decl
+ (car decl) (cadr decl)
+ (buffer-substring-no-properties
+ (if (eq (car decl) tag-pos)
+ type-pos
+ (car decl))
+ (cadr decl)))))))))
(defun c-defun-name ()
"Return the name of the current defun, or NIL if there isn't one.
diff --git a/lisp/progmodes/cc-defs.el b/lisp/progmodes/cc-defs.el
index 53d6654..f41a7cf 100644
--- a/lisp/progmodes/cc-defs.el
+++ b/lisp/progmodes/cc-defs.el
@@ -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)))
diff --git a/lisp/progmodes/cc-engine.el b/lisp/progmodes/cc-engine.el
index d1eb3c3..278ade0 100644
--- a/lisp/progmodes/cc-engine.el
+++ b/lisp/progmodes/cc-engine.el
@@ -12280,7 +12280,18 @@ comment at the start of cc-engine.el for more info."
;; The '}' is unbalanced.
nil
(c-end-of-decl-1)
- (>= (point) indent-point))))))
+ (>= (point) indent-point))))
+ ;; Check that we only have one brace block here, i.e. that we
+ ;; don't have something like a function with a struct
+ ;; declaration as its type.
+ (save-excursion
+ (or (not (and state-cache (consp (car state-cache))))
+ ;; The above probably can't happen.
+ (progn
+ (goto-char placeholder)
+ (and (c-syntactic-re-search-forward
+ "{" indent-point t)
+ (eq (1- (point)) (caar state-cache))))))))
(goto-char placeholder)
(c-add-stmt-syntax 'topmost-intro-cont nil nil
containing-sexp paren-state))
diff --git a/lisp/progmodes/cc-mode.el b/lisp/progmodes/cc-mode.el
index f09ca04..09c30e2 100644
--- a/lisp/progmodes/cc-mode.el
+++ b/lisp/progmodes/cc-mode.el
@@ -11,6 +11,8 @@
;; Maintainer: address@hidden
;; Created: a long, long, time ago. adapted from the original c-mode.el
;; Keywords: c languages
+;; The version header below is used for ELPA packaging.
+;; Version: 5.33.1
;; This file is part of GNU Emacs.
diff --git a/lisp/progmodes/ebnf2ps.el b/lisp/progmodes/ebnf2ps.el
index 74ec569..e29eb74 100644
--- a/lisp/progmodes/ebnf2ps.el
+++ b/lisp/progmodes/ebnf2ps.el
@@ -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
diff --git a/lisp/progmodes/hideif.el b/lisp/progmodes/hideif.el
index 24ad2ff..62e8c45 100644
--- a/lisp/progmodes/hideif.el
+++ b/lisp/progmodes/hideif.el
@@ -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 *))
diff --git a/lisp/ps-bdf.el b/lisp/ps-bdf.el
index c8f8823..301142e 100644
--- a/lisp/ps-bdf.el
+++ b/lisp/ps-bdf.el
@@ -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)
diff --git a/lisp/ps-print.el b/lisp/ps-print.el
index 28f93f4..7dd1103 100644
--- a/lisp/ps-print.el
+++ b/lisp/ps-print.el
@@ -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))
diff --git a/lisp/simple.el b/lisp/simple.el
index 277c141..60fdfd4 100644
--- a/lisp/simple.el
+++ b/lisp/simple.el
@@ -8395,16 +8395,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))))
diff --git a/lisp/subr.el b/lisp/subr.el
index 7313d3b..8d04da8 100644
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -366,6 +366,27 @@ was called."
(declare (compiler-macro (lambda (_) `(= 0 ,number))))
(= 0 number))
+(defun fixnump (object)
+ "Return t if OBJECT is a fixnum."
+ (and (integerp object)
+ (<= most-negative-fixnum object most-positive-fixnum)))
+
+(defun bignump (object)
+ "Return t if OBJECT is a bignum."
+ (and (integerp object) (not (fixnump object))))
+
+(defun lsh (value count)
+ "Return VALUE with its bits shifted left by COUNT.
+If COUNT is negative, shifting is actually to the right.
+In this case, if VALUE is a negative fixnum treat it as unsigned,
+i.e., subtract 2 * most-negative-fixnum from VALUE before shifting it."
+ (when (and (< value 0) (< count 0))
+ (when (< value most-negative-fixnum)
+ (signal 'args-out-of-range (list value count)))
+ (setq value (logand (ash value -1) most-positive-fixnum))
+ (setq count (1+ count)))
+ (ash value count))
+
(defun xor (pred1 pred2)
"Return the logical exclusive or of predicates PRED1 and PRED2."
(and (or pred1 pred2)
diff --git a/lisp/tar-mode.el b/lisp/tar-mode.el
index 9860c8b..19e5159 100644
--- a/lisp/tar-mode.el
+++ b/lisp/tar-mode.el
@@ -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)
)))
diff --git a/lisp/term/common-win.el b/lisp/term/common-win.el
index 6ef686a..a482067 100644
--- a/lisp/term/common-win.el
+++ b/lisp/term/common-win.el
@@ -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)))
diff --git a/lisp/term/tty-colors.el b/lisp/term/tty-colors.el
index a776c83..d9b2726 100644
--- a/lisp/term/tty-colors.el
+++ b/lisp/term/tty-colors.el
@@ -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
diff --git a/lisp/term/xterm.el b/lisp/term/xterm.el
index ce4e18e..00747af 100644
--- a/lisp/term/xterm.el
+++ b/lisp/term/xterm.el
@@ -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.
diff --git a/lisp/textmodes/bibtex.el b/lisp/textmodes/bibtex.el
index 50a30cf..57e5ef8 100644
--- a/lisp/textmodes/bibtex.el
+++ b/lisp/textmodes/bibtex.el
@@ -457,7 +457,7 @@ INIT is either the initial content of the field or a
function,
which is called to determine the initial content of the field.
ALTERNATIVE if non-nil is an integer that numbers sets of
alternatives, starting from zero."
- :group 'BibTeX
+ :group 'bibtex
:version "26.1" ; add Conference
:type 'bibtex-entry-alist)
(put 'bibtex-BibTeX-entry-alist 'risky-local-variable t)
@@ -1356,6 +1356,8 @@ Set this variable before loading BibTeX mode."
;; The Key `C-c&' is reserved for reftex.el
(define-key km "\t" 'bibtex-find-text)
(define-key km "\n" 'bibtex-next-field)
+ (define-key km [remap forward-paragraph] 'bibtex-next-entry)
+ (define-key km [remap backward-paragraph] 'bibtex-previous-entry)
(define-key km "\M-\t" 'completion-at-point)
(define-key km "\C-c\"" 'bibtex-remove-delimiters)
(define-key km "\C-c{" 'bibtex-remove-delimiters)
@@ -1415,6 +1417,8 @@ Set this variable before loading BibTeX mode."
("Moving inside an Entry"
["End of Field" bibtex-find-text t]
["Next Field" bibtex-next-field t]
+ ["Next entry" bibtex-next-entry t]
+ ["Previous entry" bibtex-previous-entry t]
["Beginning of Entry" bibtex-beginning-of-entry t]
["End of Entry" bibtex-end-of-entry t]
"--"
@@ -4452,6 +4456,24 @@ is as in `bibtex-enclosing-field'. It is t for
interactive calls."
(goto-char (match-beginning 0)))
(bibtex-find-text begin nil bibtex-help-message)))
+(defun bibtex-next-entry (&optional arg)
+ "Move point ARG entries forward.
+ARG defaults to one. Called interactively, ARG is the prefix
+argument."
+ (interactive "p")
+ (bibtex-end-of-entry)
+ (when (re-search-forward bibtex-entry-maybe-empty-head nil t (or arg 1))
+ (goto-char (match-beginning 0))))
+
+(defun bibtex-previous-entry (&optional arg)
+ "Move point ARG entries backward.
+ARG defaults to one. Called interactively, ARG is the prefix
+argument."
+ (interactive "p")
+ (bibtex-beginning-of-entry)
+ (when (re-search-backward bibtex-entry-maybe-empty-head nil t (or arg 1))
+ (goto-char (match-beginning 0))))
+
(defun bibtex-find-text (&optional begin noerror help comma)
"Move point to end of text of current BibTeX field or entry head.
With optional prefix BEGIN non-nil, move point to its beginning.
diff --git a/lisp/vc/vc-git.el b/lisp/vc/vc-git.el
index 75f4582..96c2f38 100644
--- a/lisp/vc/vc-git.el
+++ b/lisp/vc/vc-git.el
@@ -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
diff --git a/lisp/vc/vc-hg.el b/lisp/vc/vc-hg.el
index 14df9d8..76eec88 100644
--- a/lisp/vc/vc-hg.el
+++ b/lisp/vc/vc-hg.el
@@ -583,15 +583,14 @@ back to running Mercurial directly."
(defsubst vc-hg--read-u8 ()
"Read and advance over an unsigned byte.
-Return a fixnum."
+Return the byte's value as an integer."
(prog1 (char-after)
(forward-char)))
(defsubst vc-hg--read-u32-be ()
- "Read and advance over a big-endian unsigned 32-bit integer.
-Return a fixnum; on overflow, result is undefined."
+ "Read and advance over a big-endian unsigned 32-bit integer."
;; Because elisp bytecode has an instruction for multiply and
- ;; doesn't have one for lsh, it's somewhat counter-intuitively
+ ;; doesn't have one for shift, it's somewhat counter-intuitively
;; faster to multiply than to shift.
(+ (* (vc-hg--read-u8) (* 256 256 256))
(* (vc-hg--read-u8) (* 256 256))
@@ -627,9 +626,7 @@ Return a fixnum; on overflow, result is undefined."
;; hundreds of thousands of times, so performance is important
;; here
(while (< (point) search-limit)
- ;; 1+4*4 is the length of the dirstate item header, which we
- ;; spell as a literal for performance, since the elisp
- ;; compiler lacks constant propagation
+ ;; 1+4*4 is the length of the dirstate item header.
(forward-char (1+ (* 3 4)))
(let ((this-flen (vc-hg--read-u32-be)))
(if (and (or (eq this-flen flen)
@@ -917,7 +914,7 @@ FILENAME must be the file's true absolute name."
(setf ignored (string-match (pop patterns) filename)))
ignored))
-(defun vc-hg--time-to-fixnum (ts)
+(defun vc-hg--time-to-integer (ts)
(+ (* 65536 (car ts)) (cadr ts)))
(defvar vc-hg--cached-ignore-patterns nil
@@ -1016,8 +1013,6 @@ hg binary."
(not (vc-hg--requirements-understood-p repo))
;; 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))
(progn
(setf repo-relative-filename
(file-relative-name truename repo))
@@ -1042,7 +1037,7 @@ hg binary."
(let ((vc-hg-size (nth 2 dirstate-entry))
(vc-hg-mtime (nth 3 dirstate-entry))
(fs-size (nth 7 stat))
- (fs-mtime (vc-hg--time-to-fixnum (nth 5 stat))))
+ (fs-mtime (vc-hg--time-to-integer (nth 5 stat))))
(if (and (eql vc-hg-size fs-size) (eql vc-hg-mtime fs-mtime))
'up-to-date
'edited)))
diff --git a/lisp/window.el b/lisp/window.el
index d56bed6..76de420 100644
--- a/lisp/window.el
+++ b/lisp/window.el
@@ -3084,11 +3084,12 @@ already set by this routine."
(while (and best-window (not (zerop delta)))
(setq sub last)
(setq best-window nil)
- (setq best-value most-negative-fixnum)
+ (setq best-value nil)
(while sub
(when (and (consp (window-new-normal sub))
(not (<= (car (window-new-normal sub)) 0))
- (> (cdr (window-new-normal sub)) best-value))
+ (or (not best-value)
+ (> (cdr (window-new-normal sub)) best-value)))
(setq best-window sub)
(setq best-value (cdr (window-new-normal sub))))
@@ -3113,10 +3114,11 @@ already set by this routine."
(while (and best-window (not (zerop delta)))
(setq sub last)
(setq best-window nil)
- (setq best-value most-positive-fixnum)
+ (setq best-value nil)
(while sub
(when (and (numberp (window-new-normal sub))
- (< (window-new-normal sub) best-value))
+ (or (not best-value)
+ (< (window-new-normal sub) best-value)))
(setq best-window sub)
(setq best-value (window-new-normal sub)))
diff --git a/lisp/x-dnd.el b/lisp/x-dnd.el
index 5f85784..080cd4d 100644
--- a/lisp/x-dnd.el
+++ b/lisp/x-dnd.el
@@ -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)
diff --git a/m4/limits-h.m4 b/m4/limits-h.m4
index 511dcef..8388663 100644
--- a/m4/limits-h.m4
+++ b/m4/limits-h.m4
@@ -29,3 +29,11 @@ AC_DEFUN_ONCE([gl_LIMITS_H],
AC_SUBST([LIMITS_H])
AM_CONDITIONAL([GL_GENERATE_LIMITS_H], [test -n "$LIMITS_H"])
])
+
+dnl Unconditionally enables the replacement of <limits.h>.
+AC_DEFUN([gl_REPLACE_LIMITS_H],
+[
+ AC_REQUIRE([gl_LIMITS_H])
+ LIMITS_H='limits.h'
+ AM_CONDITIONAL([GL_GENERATE_LIMITS_H], [test -n "$LIMITS_H"])
+])
diff --git a/m4/stdint.m4 b/m4/stdint.m4
index b86184c..38dbbed 100644
--- a/m4/stdint.m4
+++ b/m4/stdint.m4
@@ -1,4 +1,4 @@
-# stdint.m4 serial 51
+# stdint.m4 serial 52
dnl Copyright (C) 2001-2018 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
@@ -364,8 +364,7 @@ int32_t i32 = INT32_C (0x7fffffff);
esac
dnl The substitute stdint.h needs the substitute limit.h's _GL_INTEGER_WIDTH.
- LIMITS_H=limits.h
- AM_CONDITIONAL([GL_GENERATE_LIMITS_H], [test -n "$LIMITS_H"])
+ gl_REPLACE_LIMITS_H
AC_SUBST([HAVE_C99_STDINT_H])
AC_SUBST([HAVE_SYS_BITYPES_H])
diff --git a/m4/unistd_h.m4 b/m4/unistd_h.m4
index 159c48a..3ba64da 100644
--- a/m4/unistd_h.m4
+++ b/m4/unistd_h.m4
@@ -1,4 +1,4 @@
-# unistd_h.m4 serial 73
+# unistd_h.m4 serial 74
dnl Copyright (C) 2006-2018 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
@@ -43,7 +43,7 @@ AC_DEFUN([gl_UNISTD_H],
#endif
]], [chdir chown dup dup2 dup3 environ euidaccess faccessat fchdir fchownat
fdatasync fsync ftruncate getcwd getdomainname getdtablesize getgroups
- gethostname getlogin getlogin_r getpagesize
+ gethostname getlogin getlogin_r getpagesize getpass
getusershell setusershell endusershell
group_member isatty lchown link linkat lseek pipe pipe2 pread pwrite
readlink readlinkat rmdir sethostname sleep symlink symlinkat
@@ -83,6 +83,7 @@ AC_DEFUN([gl_UNISTD_H_DEFAULTS],
GNULIB_GETLOGIN=0; AC_SUBST([GNULIB_GETLOGIN])
GNULIB_GETLOGIN_R=0; AC_SUBST([GNULIB_GETLOGIN_R])
GNULIB_GETPAGESIZE=0; AC_SUBST([GNULIB_GETPAGESIZE])
+ GNULIB_GETPASS=0; AC_SUBST([GNULIB_GETPASS])
GNULIB_GETUSERSHELL=0; AC_SUBST([GNULIB_GETUSERSHELL])
GNULIB_GROUP_MEMBER=0; AC_SUBST([GNULIB_GROUP_MEMBER])
GNULIB_ISATTY=0; AC_SUBST([GNULIB_ISATTY])
@@ -126,6 +127,7 @@ AC_DEFUN([gl_UNISTD_H_DEFAULTS],
HAVE_GETHOSTNAME=1; AC_SUBST([HAVE_GETHOSTNAME])
HAVE_GETLOGIN=1; AC_SUBST([HAVE_GETLOGIN])
HAVE_GETPAGESIZE=1; AC_SUBST([HAVE_GETPAGESIZE])
+ HAVE_GETPASS=1; AC_SUBST([HAVE_GETPASS])
HAVE_GROUP_MEMBER=1; AC_SUBST([HAVE_GROUP_MEMBER])
HAVE_LCHOWN=1; AC_SUBST([HAVE_LCHOWN])
HAVE_LINK=1; AC_SUBST([HAVE_LINK])
@@ -168,6 +170,7 @@ AC_DEFUN([gl_UNISTD_H_DEFAULTS],
REPLACE_GETLOGIN_R=0; AC_SUBST([REPLACE_GETLOGIN_R])
REPLACE_GETGROUPS=0; AC_SUBST([REPLACE_GETGROUPS])
REPLACE_GETPAGESIZE=0; AC_SUBST([REPLACE_GETPAGESIZE])
+ REPLACE_GETPASS=0; AC_SUBST([REPLACE_GETPASS])
REPLACE_ISATTY=0; AC_SUBST([REPLACE_ISATTY])
REPLACE_LCHOWN=0; AC_SUBST([REPLACE_LCHOWN])
REPLACE_LINK=0; AC_SUBST([REPLACE_LINK])
diff --git a/nt/addpm.c b/nt/addpm.c
index ec7d7ff..2132020 100644
--- a/nt/addpm.c
+++ b/nt/addpm.c
@@ -38,9 +38,12 @@ along with GNU Emacs. If not, see
<https://www.gnu.org/licenses/>. */
#include <stdio.h>
#include <malloc.h>
-/* MinGW64 barfs if _WIN32_IE is defined to anything below 0x500. */
+/* MinGW64 barfs if _WIN32_IE is defined to anything below 0x0500. */
#ifndef MINGW_W64
-#define _WIN32_IE 0x400
+# ifdef _WIN32_IE
+# undef _WIN32_IE
+# endif
+#define _WIN32_IE 0x0400
#endif
/* Request C Object macros for COM interfaces. */
#define COBJMACROS 1
diff --git a/src/Makefile.in b/src/Makefile.in
index 52ce760..7d9c236 100644
--- a/src/Makefile.in
+++ b/src/Makefile.in
@@ -392,7 +392,7 @@ base_obj = dispnew.o frame.o scroll.o xdisp.o menu.o
$(XMENU_OBJ) window.o \
charset.o coding.o category.o ccl.o character.o chartab.o bidi.o \
$(CM_OBJ) term.o terminal.o xfaces.o $(XOBJ) $(GTK_OBJ) $(DBUS_OBJ) \
emacs.o keyboard.o macros.o keymap.o sysdep.o \
- buffer.o filelock.o insdel.o marker.o \
+ bignum.o buffer.o filelock.o insdel.o marker.o \
minibuf.o fileio.o dired.o \
cmds.o casetab.o casefiddle.o indent.o search.o regex-emacs.o undo.o \
alloc.o data.o doc.o editfns.o callint.o \
diff --git a/src/alloc.c b/src/alloc.c
index 0cd3f0c..350b668 100644
--- a/src/alloc.c
+++ b/src/alloc.c
@@ -31,6 +31,7 @@ along with GNU Emacs. If not, see
<https://www.gnu.org/licenses/>. */
#endif
#include "lisp.h"
+#include "bignum.h"
#include "dispextern.h"
#include "intervals.h"
#include "ptr-bounds.h"
@@ -3728,85 +3729,6 @@ build_marker (struct buffer *buf, ptrdiff_t charpos,
ptrdiff_t bytepos)
}
-
-Lisp_Object
-make_bignum_str (const char *num, int base)
-{
- struct Lisp_Bignum *b = ALLOCATE_PSEUDOVECTOR (struct Lisp_Bignum, value,
- PVEC_BIGNUM);
- mpz_init (b->value);
- int check = mpz_set_str (b->value, num, base);
- eassert (check == 0);
- return make_lisp_ptr (b, Lisp_Vectorlike);
-}
-
-/* Given an mpz_t, make a number. This may return a bignum or a
- fixnum depending on VALUE. */
-
-Lisp_Object
-make_number (mpz_t value)
-{
- if (mpz_fits_slong_p (value))
- {
- long l = mpz_get_si (value);
- if (!FIXNUM_OVERFLOW_P (l))
- return make_fixnum (l);
- }
-
- /* Check if fixnum can be larger than long. */
- if (sizeof (EMACS_INT) > sizeof (long))
- {
- size_t bits = mpz_sizeinbase (value, 2);
- int sign = mpz_sgn (value);
-
- if (bits < FIXNUM_BITS + (sign < 0))
- {
- EMACS_INT v = 0;
- size_t limbs = mpz_size (value);
- mp_size_t i;
-
- for (i = 0; i < limbs; i++)
- {
- mp_limb_t limb = mpz_getlimbn (value, i);
- v |= (EMACS_INT) ((EMACS_UINT) limb << (i * mp_bits_per_limb));
- }
- if (sign < 0)
- v = -v;
-
- if (!FIXNUM_OVERFLOW_P (v))
- return make_fixnum (v);
- }
- }
-
- struct Lisp_Bignum *b = ALLOCATE_PSEUDOVECTOR (struct Lisp_Bignum, value,
- PVEC_BIGNUM);
- /* We could mpz_init + mpz_swap here, to avoid a copy, but the
- resulting API seemed possibly confusing. */
- mpz_init_set (b->value, value);
-
- return make_lisp_ptr (b, Lisp_Vectorlike);
-}
-
-void
-mpz_set_intmax_slow (mpz_t result, intmax_t v)
-{
- /* If long is larger then a faster path is taken. */
- eassert (sizeof (intmax_t) > sizeof (long));
-
- bool complement = v < 0;
- if (complement)
- v = -1 - v;
-
- /* COUNT = 1 means just a single word of the given size. ORDER = -1
- is arbitrary since there's only a single word. ENDIAN = 0 means
- use the native endian-ness. NAILS = 0 means use the whole
- word. */
- mpz_import (result, 1, -1, sizeof v, 0, 0, &v);
- if (complement)
- mpz_com (result, result);
-}
-
-
/* Return a newly created vector or string with specified arguments as
elements. If all the arguments are characters that can fit
in a string of events, make a string; otherwise, make a vector.
@@ -7019,7 +6941,7 @@ Frames, windows, buffers, and subprocesses count as
vectors
(but the contents of a buffer's text do not count here). */)
(void)
{
- return listn (CONSTYPE_HEAP, 8,
+ return listn (CONSTYPE_HEAP, 7,
bounded_number (cons_cells_consed),
bounded_number (floats_consed),
bounded_number (vector_cells_consed),
@@ -7202,6 +7124,26 @@ verify_alloca (void)
#endif /* ENABLE_CHECKING && USE_STACK_LISP_OBJECTS */
+/* Memory allocation for GMP. */
+
+void
+range_error (void)
+{
+ xsignal0 (Qrange_error);
+}
+
+static void *
+xrealloc_for_gmp (void *ptr, size_t ignore, size_t size)
+{
+ return xrealloc (ptr, size);
+}
+
+static void
+xfree_for_gmp (void *ptr, size_t ignore)
+{
+ xfree (ptr);
+}
+
/* Initialization. */
void
@@ -7235,6 +7177,10 @@ init_alloc_once (void)
void
init_alloc (void)
{
+ eassert (mp_bits_per_limb == GMP_NUMB_BITS);
+ integer_width = 1 << 16;
+ mp_set_memory_functions (xmalloc, xrealloc_for_gmp, xfree_for_gmp);
+
Vgc_elapsed = make_float (0.0);
gcs_done = 0;
@@ -7337,6 +7283,11 @@ The time is in seconds as a floating point value. */);
DEFVAR_INT ("gcs-done", gcs_done,
doc: /* Accumulated number of garbage collections done. */);
+ DEFVAR_INT ("integer-width", integer_width,
+ doc: /* Maximum number of bits in bignums.
+Integers outside the fixnum range are limited to absolute values less
+than 2**N, where N is this variable's value. N should be nonnegative. */);
+
defsubr (&Scons);
defsubr (&Slist);
defsubr (&Svector);
diff --git a/src/bignum.c b/src/bignum.c
new file mode 100644
index 0000000..5dbfdb9
--- /dev/null
+++ b/src/bignum.c
@@ -0,0 +1,256 @@
+/* Big numbers for Emacs.
+
+Copyright 2018 Free Software Foundation, Inc.
+
+This file is part of GNU Emacs.
+
+GNU Emacs is free software: you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation, either version 3 of the License, or (at
+your option) any later version.
+
+GNU Emacs is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
+
+#include <config.h>
+
+#include "bignum.h"
+
+#include "lisp.h"
+
+/* Return the value of the Lisp bignum N, as a double. */
+double
+bignum_to_double (Lisp_Object n)
+{
+ return mpz_get_d (XBIGNUM (n)->value);
+}
+
+/* Return D, converted to a bignum. Discard any fraction. */
+Lisp_Object
+double_to_bignum (double d)
+{
+ mpz_t z;
+ mpz_init_set_d (z, d);
+ Lisp_Object result = make_integer (z);
+ mpz_clear (z);
+ return result;
+}
+
+/* Return a Lisp integer equal to OP, which has BITS bits and which
+ must not be in fixnum range. */
+static Lisp_Object
+make_bignum_bits (mpz_t const op, size_t bits)
+{
+ /* The documentation says integer-width should be nonnegative, so
+ a single comparison suffices even though 'bits' is unsigned. */
+ if (integer_width < bits)
+ range_error ();
+
+ struct Lisp_Bignum *b = ALLOCATE_PSEUDOVECTOR (struct Lisp_Bignum, value,
+ PVEC_BIGNUM);
+ /* We could mpz_init + mpz_swap here, to avoid a copy, but the
+ resulting API seemed possibly confusing. */
+ mpz_init_set (b->value, op);
+
+ return make_lisp_ptr (b, Lisp_Vectorlike);
+}
+
+/* Return a Lisp integer equal to OP, which must not be in fixnum range. */
+static Lisp_Object
+make_bignum (mpz_t const op)
+{
+ return make_bignum_bits (op, mpz_sizeinbase (op, 2));
+}
+
+static void mpz_set_uintmax_slow (mpz_t, uintmax_t);
+
+/* Set RESULT to V. */
+static void
+mpz_set_uintmax (mpz_t result, uintmax_t v)
+{
+ if (v <= ULONG_MAX)
+ mpz_set_ui (result, v);
+ else
+ mpz_set_uintmax_slow (result, v);
+}
+
+/* Return a Lisp integer equal to N, which must not be in fixnum range. */
+Lisp_Object
+make_bigint (intmax_t n)
+{
+ eassert (FIXNUM_OVERFLOW_P (n));
+ mpz_t z;
+ mpz_init (z);
+ mpz_set_intmax (z, n);
+ Lisp_Object result = make_bignum (z);
+ mpz_clear (z);
+ return result;
+}
+Lisp_Object
+make_biguint (uintmax_t n)
+{
+ eassert (FIXNUM_OVERFLOW_P (n));
+ mpz_t z;
+ mpz_init (z);
+ mpz_set_uintmax (z, n);
+ Lisp_Object result = make_bignum (z);
+ mpz_clear (z);
+ return result;
+}
+
+/* Return a Lisp integer with value taken from OP. */
+Lisp_Object
+make_integer (mpz_t const op)
+{
+ size_t bits = mpz_sizeinbase (op, 2);
+
+ if (bits <= FIXNUM_BITS)
+ {
+ EMACS_INT v = 0;
+ int i = 0, shift = 0;
+
+ do
+ {
+ EMACS_INT limb = mpz_getlimbn (op, i++);
+ v += limb << shift;
+ shift += GMP_NUMB_BITS;
+ }
+ while (shift < bits);
+
+ if (mpz_sgn (op) < 0)
+ v = -v;
+
+ if (!FIXNUM_OVERFLOW_P (v))
+ return make_fixnum (v);
+ }
+
+ return make_bignum_bits (op, bits);
+}
+
+/* Set RESULT to V. This code is for when intmax_t is wider than long. */
+void
+mpz_set_intmax_slow (mpz_t result, intmax_t v)
+{
+ int maxlimbs = (INTMAX_WIDTH + GMP_NUMB_BITS - 1) / GMP_NUMB_BITS;
+ mp_limb_t *limb = mpz_limbs_write (result, maxlimbs);
+ int n = 0;
+ uintmax_t u = v;
+ bool negative = v < 0;
+ if (negative)
+ {
+ uintmax_t two = 2;
+ u = -u & ((two << (UINTMAX_WIDTH - 1)) - 1);
+ }
+
+ do
+ {
+ limb[n++] = u;
+ u = GMP_NUMB_BITS < UINTMAX_WIDTH ? u >> GMP_NUMB_BITS : 0;
+ }
+ while (u != 0);
+
+ mpz_limbs_finish (result, negative ? -n : n);
+}
+static void
+mpz_set_uintmax_slow (mpz_t result, uintmax_t v)
+{
+ int maxlimbs = (UINTMAX_WIDTH + GMP_NUMB_BITS - 1) / GMP_NUMB_BITS;
+ mp_limb_t *limb = mpz_limbs_write (result, maxlimbs);
+ int n = 0;
+
+ do
+ {
+ limb[n++] = v;
+ v = GMP_NUMB_BITS < INTMAX_WIDTH ? v >> GMP_NUMB_BITS : 0;
+ }
+ while (v != 0);
+
+ mpz_limbs_finish (result, n);
+}
+
+/* Return the value of the bignum X if it fits, 0 otherwise.
+ A bignum cannot be zero, so 0 indicates failure reliably. */
+intmax_t
+bignum_to_intmax (Lisp_Object x)
+{
+ ptrdiff_t bits = mpz_sizeinbase (XBIGNUM (x)->value, 2);
+ bool negative = mpz_sgn (XBIGNUM (x)->value) < 0;
+
+ if (bits < INTMAX_WIDTH)
+ {
+ intmax_t v = 0;
+ int i = 0, shift = 0;
+
+ do
+ {
+ intmax_t limb = mpz_getlimbn (XBIGNUM (x)->value, i++);
+ v += limb << shift;
+ shift += GMP_NUMB_BITS;
+ }
+ while (shift < bits);
+
+ return negative ? -v : v;
+ }
+ return ((bits == INTMAX_WIDTH && INTMAX_MIN < -INTMAX_MAX && negative
+ && mpz_scan1 (XBIGNUM (x)->value, 0) == INTMAX_WIDTH - 1)
+ ? INTMAX_MIN : 0);
+}
+uintmax_t
+bignum_to_uintmax (Lisp_Object x)
+{
+ uintmax_t v = 0;
+ if (0 <= mpz_sgn (XBIGNUM (x)->value))
+ {
+ ptrdiff_t bits = mpz_sizeinbase (XBIGNUM (x)->value, 2);
+ if (bits <= UINTMAX_WIDTH)
+ {
+ int i = 0, shift = 0;
+
+ do
+ {
+ uintmax_t limb = mpz_getlimbn (XBIGNUM (x)->value, i++);
+ v += limb << shift;
+ shift += GMP_NUMB_BITS;
+ }
+ while (shift < bits);
+ }
+ }
+ return v;
+}
+
+/* Convert NUM to a base-BASE Lisp string. */
+
+Lisp_Object
+bignum_to_string (Lisp_Object num, int base)
+{
+ ptrdiff_t n = mpz_sizeinbase (XBIGNUM (num)->value, base) - 1;
+ USE_SAFE_ALLOCA;
+ char *str = SAFE_ALLOCA (n + 3);
+ mpz_get_str (str, base, XBIGNUM (num)->value);
+ while (str[n])
+ n++;
+ Lisp_Object result = make_unibyte_string (str, n);
+ SAFE_FREE ();
+ return result;
+}
+
+/* Create a bignum by scanning NUM, with digits in BASE.
+ NUM must consist of an optional '-', a nonempty sequence
+ of base-BASE digits, and a terminating null byte, and
+ the represented number must not be in fixnum range. */
+
+Lisp_Object
+make_bignum_str (char const *num, int base)
+{
+ struct Lisp_Bignum *b = ALLOCATE_PSEUDOVECTOR (struct Lisp_Bignum, value,
+ PVEC_BIGNUM);
+ mpz_init (b->value);
+ int check = mpz_set_str (b->value, num, base);
+ eassert (check == 0);
+ return make_lisp_ptr (b, Lisp_Vectorlike);
+}
diff --git a/src/bignum.h b/src/bignum.h
new file mode 100644
index 0000000..a368333
--- /dev/null
+++ b/src/bignum.h
@@ -0,0 +1,70 @@
+/* Big numbers for Emacs.
+
+Copyright 2018 Free Software Foundation, Inc.
+
+This file is part of GNU Emacs.
+
+GNU Emacs is free software: you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation, either version 3 of the License, or (at
+your option) any later version.
+
+GNU Emacs is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
+
+/* Include this header only if access to bignum internals is needed. */
+
+#ifndef BIGNUM_H
+#define BIGNUM_H
+
+#ifdef HAVE_GMP
+# include <gmp.h>
+#else
+# include "mini-gmp.h"
+#endif
+
+#include "lisp.h"
+
+/* Number of data bits in a limb. */
+#ifndef GMP_NUMB_BITS
+enum { GMP_NUMB_BITS = TYPE_WIDTH (mp_limb_t) };
+#endif
+
+struct Lisp_Bignum
+{
+ union vectorlike_header header;
+ mpz_t value;
+};
+
+extern Lisp_Object make_integer (mpz_t const) ARG_NONNULL ((1));
+extern void mpz_set_intmax_slow (mpz_t, intmax_t) ARG_NONNULL ((1));
+
+INLINE_HEADER_BEGIN
+
+INLINE struct Lisp_Bignum *
+XBIGNUM (Lisp_Object a)
+{
+ eassert (BIGNUMP (a));
+ return XUNTAG (a, Lisp_Vectorlike, struct Lisp_Bignum);
+}
+
+INLINE void ARG_NONNULL ((1))
+mpz_set_intmax (mpz_t result, intmax_t v)
+{
+ /* mpz_set_si works in terms of long, but Emacs may use a wider
+ integer type, and so sometimes will have to construct the mpz_t
+ by hand. */
+ if (LONG_MIN <= v && v <= LONG_MAX)
+ mpz_set_si (result, v);
+ else
+ mpz_set_intmax_slow (result, v);
+}
+
+INLINE_HEADER_END
+
+#endif /* BIGNUM_H */
diff --git a/src/buffer.h b/src/buffer.h
index c624750..4ea7fa6 100644
--- a/src/buffer.h
+++ b/src/buffer.h
@@ -288,28 +288,6 @@ extern void enlarge_buffer_text (struct buffer *,
ptrdiff_t);
or convert between a byte position and an address.
These macros do not check that the position is in range. */
-/* Access a Lisp position value in POS,
- and store the charpos in CHARPOS and the bytepos in BYTEPOS. */
-
-#define DECODE_POSITION(charpos, bytepos, pos) \
- do \
- { \
- Lisp_Object __pos = (pos); \
- if (FIXED_OR_FLOATP (__pos))
\
- { \
- charpos = __pos; \
- bytepos = buf_charpos_to_bytepos (current_buffer, __pos); \
- } \
- else if (MARKERP (__pos))
\
- { \
- charpos = marker_position (__pos); \
- bytepos = marker_byte_position (__pos); \
- } \
- else \
- wrong_type_argument (Qinteger_or_marker_p, __pos); \
- } \
- while (false)
-
/* Maximum number of bytes in a buffer.
A buffer cannot contain more bytes than a 1-origin fixnum can represent,
nor can it be so large that C pointer arithmetic stops working.
diff --git a/src/bytecode.c b/src/bytecode.c
index b27fa7c..17457fc 100644
--- a/src/bytecode.c
+++ b/src/bytecode.c
@@ -832,13 +832,14 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector,
Lisp_Object maxdepth,
CASE (Bnth):
{
Lisp_Object v2 = POP, v1 = TOP;
- CHECK_FIXNUM (v1);
- for (EMACS_INT n = XFIXNUM (v1); 0 < n && CONSP (v2); n--)
+ if (RANGED_FIXNUMP (0, v1, SMALL_LIST_LEN_MAX))
{
- v2 = XCDR (v2);
- rarely_quit (n);
+ for (EMACS_INT n = XFIXNUM (v1); 0 < n && CONSP (v2); n--)
+ v2 = XCDR (v2);
+ TOP = CAR (v2);
}
- TOP = CAR (v2);
+ else
+ TOP = Fnth (v1, v2);
NEXT;
}
@@ -985,15 +986,8 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector,
Lisp_Object maxdepth,
CASE (Beqlsign):
{
- Lisp_Object v2 = POP, v1 = TOP;
- if (FLOATP (v1) || FLOATP (v2))
- TOP = arithcompare (v1, v2, ARITH_EQUAL);
- else
- {
- CHECK_FIXNUM_OR_FLOAT_COERCE_MARKER (v1);
- CHECK_FIXNUM_OR_FLOAT_COERCE_MARKER (v2);
- TOP = EQ (v1, v2) ? Qt : Qnil;
- }
+ Lisp_Object v1 = POP;
+ TOP = arithcompare (TOP, v1, ARITH_EQUAL);
NEXT;
}
@@ -1264,23 +1258,16 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object
vector, Lisp_Object maxdepth,
CASE (Belt):
{
- if (CONSP (TOP))
+ Lisp_Object v2 = POP, v1 = TOP;
+ if (CONSP (v1) && RANGED_FIXNUMP (0, v2, SMALL_LIST_LEN_MAX))
{
- /* Exchange args and then do nth. */
- Lisp_Object v2 = POP, v1 = TOP;
- CHECK_FIXNUM (v2);
+ /* Like the fast case for Bnth, but with args reversed. */
for (EMACS_INT n = XFIXNUM (v2); 0 < n && CONSP (v1); n--)
- {
- v1 = XCDR (v1);
- rarely_quit (n);
- }
+ v1 = XCDR (v1);
TOP = CAR (v1);
}
else
- {
- Lisp_Object v1 = POP;
- TOP = Felt (TOP, v1);
- }
+ TOP = Felt (v1, v2);
NEXT;
}
diff --git a/src/charset.c b/src/charset.c
index e77a390..7b272a2 100644
--- a/src/charset.c
+++ b/src/charset.c
@@ -929,8 +929,8 @@ usage: (define-charset-internal ...) */)
if (code < charset.min_code
|| code > charset.max_code)
- args_out_of_range_3 (make_fixnum_or_float (charset.min_code),
- make_fixnum_or_float (charset.max_code), val);
+ args_out_of_range_3 (INT_TO_INTEGER (charset.min_code),
+ INT_TO_INTEGER (charset.max_code), val);
charset.char_index_offset = CODE_POINT_TO_INDEX (&charset, code);
charset.min_code = code;
}
@@ -942,8 +942,8 @@ usage: (define-charset-internal ...) */)
if (code < charset.min_code
|| code > charset.max_code)
- args_out_of_range_3 (make_fixnum_or_float (charset.min_code),
- make_fixnum_or_float (charset.max_code), val);
+ args_out_of_range_3 (INT_TO_INTEGER (charset.min_code),
+ INT_TO_INTEGER (charset.max_code), val);
charset.max_code = code;
}
@@ -1852,7 +1852,8 @@ DEFUN ("decode-char", Fdecode_char, Sdecode_char, 2, 2, 0,
doc: /* Decode the pair of CHARSET and CODE-POINT into a character.
Return nil if CODE-POINT is not valid in CHARSET.
-CODE-POINT may be a cons (HIGHER-16-BIT-VALUE . LOWER-16-BIT-VALUE). */)
+CODE-POINT may be a cons (HIGHER-16-BIT-VALUE . LOWER-16-BIT-VALUE),
+although this usage is obsolescent. */)
(Lisp_Object charset, Lisp_Object code_point)
{
int c, id;
@@ -1883,7 +1884,7 @@ Return nil if CHARSET doesn't include CH. */)
code = ENCODE_CHAR (charsetp, c);
if (code == CHARSET_INVALID_CODE (charsetp))
return Qnil;
- return INTEGER_TO_CONS (code);
+ return INT_TO_INTEGER (code);
}
diff --git a/src/coding.c b/src/coding.c
index 53e98f8..966492a 100644
--- a/src/coding.c
+++ b/src/coding.c
@@ -10214,7 +10214,7 @@ usage: (define-coding-system-internal ...) */)
tmp = AREF (val, i);
if (NILP (tmp))
tmp = XCAR (tail);
- else if (FIXED_OR_FLOATP (tmp))
+ else if (FIXNATP (tmp))
{
dim2 = CHARSET_DIMENSION (CHARSET_FROM_ID (XFIXNAT (tmp)));
if (dim < dim2)
diff --git a/src/composite.h b/src/composite.h
index 2d03e48..8039113 100644
--- a/src/composite.h
+++ b/src/composite.h
@@ -294,7 +294,7 @@ enum lglyph_indices
/* Callers must assure that VAL is not negative! */
#define LGLYPH_SET_CODE(g, val)
\
ASET (g, LGLYPH_IX_CODE, \
- val == FONT_INVALID_CODE ? Qnil : INTEGER_TO_CONS (val))
+ val == FONT_INVALID_CODE ? Qnil : INT_TO_INTEGER (val))
#define LGLYPH_SET_WIDTH(g, val) ASET ((g), LGLYPH_IX_WIDTH, make_fixnum (val))
#define LGLYPH_SET_LBEARING(g, val) ASET ((g), LGLYPH_IX_LBEARING, make_fixnum
(val))
diff --git a/src/conf_post.h b/src/conf_post.h
index f9838bc..683a96f 100644
--- a/src/conf_post.h
+++ b/src/conf_post.h
@@ -277,6 +277,7 @@ extern int emacs_setenv_TZ (char const *);
#define ATTRIBUTE_FORMAT_PRINTF(string_index, first_to_check) \
ATTRIBUTE_FORMAT ((PRINTF_ARCHETYPE, string_index, first_to_check))
+#define ARG_NONNULL _GL_ARG_NONNULL
#define ATTRIBUTE_CONST _GL_ATTRIBUTE_CONST
#define ATTRIBUTE_UNUSED _GL_UNUSED
diff --git a/src/data.c b/src/data.c
index 5a355d9..6afda1e 100644
--- a/src/data.c
+++ b/src/data.c
@@ -29,6 +29,7 @@ along with GNU Emacs. If not, see
<https://www.gnu.org/licenses/>. */
#include <intprops.h>
#include "lisp.h"
+#include "bignum.h"
#include "puresize.h"
#include "character.h"
#include "buffer.h"
@@ -511,16 +512,6 @@ DEFUN ("integerp", Fintegerp, Sintegerp, 1, 1, 0,
return Qnil;
}
-DEFUN ("fixnump", Ffixnump, Sfixnump, 1, 1, 0,
- doc: /* Return t if OBJECT is an fixnum. */
- attributes: const)
- (Lisp_Object object)
-{
- if (FIXNUMP (object))
- return Qt;
- return Qnil;
-}
-
DEFUN ("integer-or-marker-p", Finteger_or_marker_p, Sinteger_or_marker_p, 1,
1, 0,
doc: /* Return t if OBJECT is an integer or a marker (editor pointer).
*/)
(register Lisp_Object object)
@@ -535,9 +526,9 @@ DEFUN ("natnump", Fnatnump, Snatnump, 1, 1, 0,
attributes: const)
(Lisp_Object object)
{
- if (NATNUMP (object))
- return Qt;
- return Qnil;
+ return ((FIXNUMP (object) ? 0 <= XFIXNUM (object)
+ : BIGNUMP (object) && 0 <= mpz_sgn (XBIGNUM (object)->value))
+ ? Qt : Qnil);
}
DEFUN ("numberp", Fnumberp, Snumberp, 1, 1, 0,
@@ -598,15 +589,6 @@ DEFUN ("condition-variable-p", Fcondition_variable_p,
Scondition_variable_p,
return Qt;
return Qnil;
}
-
-DEFUN ("bignump", Fbignump, Sbignump, 1, 1, 0,
- doc: /* Return t if OBJECT is a bignum. */)
- (Lisp_Object object)
-{
- if (BIGNUMP (object))
- return Qt;
- return Qnil;
-}
/* Extract and set components of lists. */
@@ -1150,7 +1132,7 @@ store_symval_forwarding (union Lisp_Fwd *valcontents,
register Lisp_Object newva
else if ((prop = Fget (predicate, Qrange), !NILP (prop)))
{
Lisp_Object min = XCAR (prop), max = XCDR (prop);
- if (! FIXED_OR_FLOATP (newval)
+ if (! NUMBERP (newval)
|| NILP (CALLN (Fleq, min, newval, max)))
wrong_range (min, max, newval);
}
@@ -2384,142 +2366,113 @@ bool-vector. IDX starts at 0. */)
return newelt;
}
-/* Arithmetic functions */
-
-#ifndef isnan
-# define isnan(x) ((x) != (x))
-#endif
+/* GMP tests for this value and aborts (!) if it is exceeded.
+ This is as of GMP 6.1.2 (2016); perhaps future versions will differ. */
+enum { GMP_NLIMBS_MAX = min (INT_MAX, ULONG_MAX / GMP_NUMB_BITS) };
+
+/* An upper bound on limb counts, needed to prevent libgmp and/or
+ Emacs from aborting or otherwise misbehaving. This bound applies
+ to estimates of mpz_t sizes before the mpz_t objects are created,
+ as opposed to integer-width which operates on mpz_t values after
+ creation and before conversion to Lisp bignums. */
+enum
+ {
+ NLIMBS_LIMIT = min (min (/* libgmp needs to store limb counts. */
+ GMP_NLIMBS_MAX,
-static Lisp_Object
-bignumcompare (Lisp_Object num1, Lisp_Object num2,
- enum Arith_Comparison comparison)
-{
- int cmp;
- bool test;
+ /* Size calculations need to work. */
+ min (PTRDIFF_MAX, SIZE_MAX) / sizeof (mp_limb_t)),
- if (BIGNUMP (num1))
- {
- if (FLOATP (num2))
- {
- /* Note that GMP doesn't define comparisons against NaN, so
- we need to handle them specially. */
- if (isnan (XFLOAT_DATA (num2)))
- return Qnil;
- cmp = mpz_cmp_d (XBIGNUM (num1)->value, XFLOAT_DATA (num2));
- }
- else if (FIXNUMP (num2))
- {
- if (sizeof (EMACS_INT) > sizeof (long) && XFIXNUM (num2) > LONG_MAX)
- {
- mpz_t tem;
- mpz_init (tem);
- mpz_set_intmax (tem, XFIXNUM (num2));
- cmp = mpz_cmp (XBIGNUM (num1)->value, tem);
- mpz_clear (tem);
- }
- else
- cmp = mpz_cmp_si (XBIGNUM (num1)->value, XFIXNUM (num2));
- }
- else
- {
- eassume (BIGNUMP (num2));
- cmp = mpz_cmp (XBIGNUM (num1)->value, XBIGNUM (num2)->value);
- }
- }
- else
- {
- eassume (BIGNUMP (num2));
- if (FLOATP (num1))
- {
- /* Note that GMP doesn't define comparisons against NaN, so
- we need to handle them specially. */
- if (isnan (XFLOAT_DATA (num1)))
- return Qnil;
- cmp = - mpz_cmp_d (XBIGNUM (num2)->value, XFLOAT_DATA (num1));
- }
- else
- {
- eassume (FIXNUMP (num1));
- if (sizeof (EMACS_INT) > sizeof (long) && XFIXNUM (num1) > LONG_MAX)
- {
- mpz_t tem;
- mpz_init (tem);
- mpz_set_intmax (tem, XFIXNUM (num1));
- cmp = - mpz_cmp (XBIGNUM (num2)->value, tem);
- mpz_clear (tem);
- }
- else
- cmp = - mpz_cmp_si (XBIGNUM (num2)->value, XFIXNUM (num1));
- }
- }
+ /* Emacs puts bit counts into fixnums. */
+ MOST_POSITIVE_FIXNUM / GMP_NUMB_BITS)
+ };
- switch (comparison)
- {
- case ARITH_EQUAL:
- test = cmp == 0;
- break;
+/* Like mpz_size, but tell the compiler the result is a nonnegative int. */
- case ARITH_NOTEQUAL:
- test = cmp != 0;
- break;
+static int
+emacs_mpz_size (mpz_t const op)
+{
+ mp_size_t size = mpz_size (op);
+ eassume (0 <= size && size <= INT_MAX);
+ return size;
+}
- case ARITH_LESS:
- test = cmp < 0;
- break;
+/* Wrappers to work around GMP limitations. As of GMP 6.1.2 (2016),
+ the library code aborts when a number is too large. These wrappers
+ avoid the problem for functions that can return numbers much larger
+ than their arguments. For slowly-growing numbers, the integer
+ width checks in bignum.c should suffice. */
- case ARITH_LESS_OR_EQUAL:
- test = cmp <= 0;
- break;
+static void
+emacs_mpz_mul (mpz_t rop, mpz_t const op1, mpz_t const op2)
+{
+ if (NLIMBS_LIMIT - emacs_mpz_size (op1) < emacs_mpz_size (op2))
+ range_error ();
+ mpz_mul (rop, op1, op2);
+}
- case ARITH_GRTR:
- test = cmp > 0;
- break;
+static void
+emacs_mpz_mul_2exp (mpz_t rop, mpz_t const op1, mp_bitcnt_t op2)
+{
+ /* Fudge factor derived from GMP 6.1.2, to avoid an abort in
+ mpz_mul_2exp (look for the '+ 1' in its source code). */
+ enum { mul_2exp_extra_limbs = 1 };
+ enum { lim = min (NLIMBS_LIMIT, GMP_NLIMBS_MAX - mul_2exp_extra_limbs) };
- case ARITH_GRTR_OR_EQUAL:
- test = cmp >= 0;
- break;
+ mp_bitcnt_t op2limbs = op2 / GMP_NUMB_BITS;
+ if (lim - emacs_mpz_size (op1) < op2limbs)
+ range_error ();
+ mpz_mul_2exp (rop, op1, op2);
+}
- default:
- eassume (false);
- }
+static void
+emacs_mpz_pow_ui (mpz_t rop, mpz_t const base, unsigned long exp)
+{
+ /* This fudge factor is derived from GMP 6.1.2, to avoid an abort in
+ mpz_n_pow_ui (look for the '5' in its source code). */
+ enum { pow_ui_extra_limbs = 5 };
+ enum { lim = min (NLIMBS_LIMIT, GMP_NLIMBS_MAX - pow_ui_extra_limbs) };
- return test ? Qt : Qnil;
+ int nbase = emacs_mpz_size (base), n;
+ if (INT_MULTIPLY_WRAPV (nbase, exp, &n) || lim < n)
+ range_error ();
+ mpz_pow_ui (rop, base, exp);
}
+
+/* Arithmetic functions */
+
Lisp_Object
arithcompare (Lisp_Object num1, Lisp_Object num2,
enum Arith_Comparison comparison)
{
- double f1, f2;
- EMACS_INT i1, i2;
- bool lt, eq, gt;
+ EMACS_INT i1 = 0, i2 = 0;
+ bool lt, eq = true, gt;
bool test;
CHECK_NUMBER_COERCE_MARKER (num1);
CHECK_NUMBER_COERCE_MARKER (num2);
- if (BIGNUMP (num1) || BIGNUMP (num2))
- return bignumcompare (num1, num2, comparison);
-
- /* If either arg is floating point, set F1 and F2 to the 'double'
- approximations of the two arguments, and set LT, EQ, and GT to
- the <, ==, > floating-point comparisons of F1 and F2
+ /* If the comparison is mostly done by comparing two doubles,
+ set LT, EQ, and GT to the <, ==, > results of that comparison,
respectively, taking care to avoid problems if either is a NaN,
and trying to avoid problems on platforms where variables (in
violation of the C standard) can contain excess precision.
Regardless, set I1 and I2 to integers that break ties if the
- floating-point comparison is either not done or reports
+ two-double comparison is either not done or reports
equality. */
if (FLOATP (num1))
{
- f1 = XFLOAT_DATA (num1);
+ double f1 = XFLOAT_DATA (num1);
if (FLOATP (num2))
{
- i1 = i2 = 0;
- f2 = XFLOAT_DATA (num2);
+ double f2 = XFLOAT_DATA (num2);
+ lt = f1 < f2;
+ eq = f1 == f2;
+ gt = f1 > f2;
}
- else
+ else if (FIXNUMP (num2))
{
/* Compare a float NUM1 to an integer NUM2 by converting the
integer I2 (i.e., NUM2) to the double F2 (a conversion that
@@ -2529,35 +2482,56 @@ arithcompare (Lisp_Object num1, Lisp_Object num2,
floating-point comparison reports a tie, NUM1 = F1 = F2 = I1
(exactly) so I1 - I2 = NUM1 - NUM2 (exactly), so comparing I1
to I2 will break the tie correctly. */
- i1 = f2 = i2 = XFIXNUM (num2);
+ double f2 = XFIXNUM (num2);
+ lt = f1 < f2;
+ eq = f1 == f2;
+ gt = f1 > f2;
+ i1 = f2;
+ i2 = XFIXNUM (num2);
}
- lt = f1 < f2;
- eq = f1 == f2;
- gt = f1 > f2;
+ else if (isnan (f1))
+ lt = eq = gt = false;
+ else
+ i2 = mpz_cmp_d (XBIGNUM (num2)->value, f1);
}
- else
+ else if (FIXNUMP (num1))
{
- i1 = XFIXNUM (num1);
if (FLOATP (num2))
{
/* Compare an integer NUM1 to a float NUM2. This is the
converse of comparing float to integer (see above). */
- i2 = f1 = i1;
- f2 = XFLOAT_DATA (num2);
+ double f1 = XFIXNUM (num1), f2 = XFLOAT_DATA (num2);
lt = f1 < f2;
eq = f1 == f2;
gt = f1 > f2;
+ i1 = XFIXNUM (num1);
+ i2 = f1;
}
- else
+ else if (FIXNUMP (num2))
{
+ i1 = XFIXNUM (num1);
i2 = XFIXNUM (num2);
- eq = true;
}
+ else
+ i2 = mpz_sgn (XBIGNUM (num2)->value);
+ }
+ else if (FLOATP (num2))
+ {
+ double f2 = XFLOAT_DATA (num2);
+ if (isnan (f2))
+ lt = eq = gt = false;
+ else
+ i1 = mpz_cmp_d (XBIGNUM (num1)->value, f2);
}
+ else if (FIXNUMP (num2))
+ i1 = mpz_sgn (XBIGNUM (num1)->value);
+ else
+ i1 = mpz_cmp (XBIGNUM (num1)->value, XBIGNUM (num2)->value);
if (eq)
{
- /* Break a floating-point tie by comparing the integers. */
+ /* The two-double comparison either reported equality, or was not done.
+ Break the tie by comparing the integers. */
lt = i1 < i2;
eq = i1 == i2;
gt = i1 > i2;
@@ -2653,48 +2627,21 @@ DEFUN ("/=", Fneq, Sneq, 2, 2, 0,
return arithcompare (num1, num2, ARITH_NOTEQUAL);
}
-/* Convert the integer I to a cons-of-integers, where I is not in
- fixnum range. */
-
-#define INTBIG_TO_LISP(i, extremum) \
- (eassert (FIXNUM_OVERFLOW_P (i)), \
- (! (FIXNUM_OVERFLOW_P ((extremum) >> 16) \
- && FIXNUM_OVERFLOW_P ((i) >> 16)) \
- ? Fcons (make_fixnum ((i) >> 16), make_fixnum ((i) & 0xffff)) \
- : ! (FIXNUM_OVERFLOW_P ((extremum) >> 16 >> 24) \
- && FIXNUM_OVERFLOW_P ((i) >> 16 >> 24)) \
- ? Fcons (make_fixnum ((i) >> 16 >> 24), \
- Fcons (make_fixnum ((i) >> 16 & 0xffffff), \
- make_fixnum ((i) & 0xffff))) \
- : make_float (i)))
-
-Lisp_Object
-intbig_to_lisp (intmax_t i)
-{
- return INTBIG_TO_LISP (i, INTMAX_MIN);
-}
-
-Lisp_Object
-uintbig_to_lisp (uintmax_t i)
-{
- return INTBIG_TO_LISP (i, UINTMAX_MAX);
-}
-
/* Convert the cons-of-integers, integer, or float value C to an
unsigned value with maximum value MAX, where MAX is one less than a
power of 2. Signal an error if C does not have a valid format or
- is out of range. */
+ is out of range.
+
+ Although Emacs represents large integers with bignums instead of
+ cons-of-integers or floats, for now this function still accepts the
+ obsolete forms in case some old Lisp code still generates them. */
uintmax_t
cons_to_unsigned (Lisp_Object c, uintmax_t max)
{
bool valid = false;
uintmax_t val UNINIT;
- if (FIXNUMP (c))
- {
- valid = XFIXNUM (c) >= 0;
- val = XFIXNUM (c);
- }
- else if (FLOATP (c))
+
+ if (FLOATP (c))
{
double d = XFLOAT_DATA (c);
if (d >= 0 && d < 1.0 + max)
@@ -2703,27 +2650,44 @@ cons_to_unsigned (Lisp_Object c, uintmax_t max)
valid = val == d;
}
}
- else if (CONSP (c) && FIXNATP (XCAR (c)))
+ else
{
- uintmax_t top = XFIXNAT (XCAR (c));
- Lisp_Object rest = XCDR (c);
- if (top <= UINTMAX_MAX >> 24 >> 16
- && CONSP (rest)
- && FIXNATP (XCAR (rest)) && XFIXNAT (XCAR (rest)) < 1 << 24
- && FIXNATP (XCDR (rest)) && XFIXNAT (XCDR (rest)) < 1 << 16)
+ Lisp_Object hi = CONSP (c) ? XCAR (c) : c;
+
+ if (FIXNUMP (hi))
{
- uintmax_t mid = XFIXNAT (XCAR (rest));
- val = top << 24 << 16 | mid << 16 | XFIXNAT (XCDR (rest));
- valid = true;
+ val = XFIXNUM (hi);
+ valid = 0 <= val;
+ }
+ else
+ {
+ val = bignum_to_uintmax (hi);
+ valid = val != 0;
}
- else if (top <= UINTMAX_MAX >> 16)
+
+ if (valid && CONSP (c))
{
- if (CONSP (rest))
- rest = XCAR (rest);
- if (FIXNATP (rest) && XFIXNAT (rest) < 1 << 16)
+ uintmax_t top = val;
+ Lisp_Object rest = XCDR (c);
+ if (top <= UINTMAX_MAX >> 24 >> 16
+ && CONSP (rest)
+ && FIXNATP (XCAR (rest)) && XFIXNAT (XCAR (rest)) < 1 << 24
+ && FIXNATP (XCDR (rest)) && XFIXNAT (XCDR (rest)) < 1 << 16)
{
- val = top << 16 | XFIXNAT (rest);
- valid = true;
+ uintmax_t mid = XFIXNAT (XCAR (rest));
+ val = top << 24 << 16 | mid << 16 | XFIXNAT (XCDR (rest));
+ }
+ else
+ {
+ valid = top <= UINTMAX_MAX >> 16;
+ if (valid)
+ {
+ if (CONSP (rest))
+ rest = XCAR (rest);
+ valid = FIXNATP (rest) && XFIXNAT (rest) < 1 << 16;
+ if (valid)
+ val = top << 16 | XFIXNAT (rest);
+ }
}
}
}
@@ -2737,18 +2701,18 @@ cons_to_unsigned (Lisp_Object c, uintmax_t max)
value with extrema MIN and MAX. MAX should be one less than a
power of 2, and MIN should be zero or the negative of a power of 2.
Signal an error if C does not have a valid format or is out of
- range. */
+ range.
+
+ Although Emacs represents large integers with bignums instead of
+ cons-of-integers or floats, for now this function still accepts the
+ obsolete forms in case some old Lisp code still generates them. */
intmax_t
cons_to_signed (Lisp_Object c, intmax_t min, intmax_t max)
{
bool valid = false;
intmax_t val UNINIT;
- if (FIXNUMP (c))
- {
- val = XFIXNUM (c);
- valid = true;
- }
- else if (FLOATP (c))
+
+ if (FLOATP (c))
{
double d = XFLOAT_DATA (c);
if (d >= min && d < 1.0 + max)
@@ -2757,27 +2721,44 @@ cons_to_signed (Lisp_Object c, intmax_t min, intmax_t
max)
valid = val == d;
}
}
- else if (CONSP (c) && FIXNUMP (XCAR (c)))
+ else
{
- intmax_t top = XFIXNUM (XCAR (c));
- Lisp_Object rest = XCDR (c);
- if (top >= INTMAX_MIN >> 24 >> 16 && top <= INTMAX_MAX >> 24 >> 16
- && CONSP (rest)
- && FIXNATP (XCAR (rest)) && XFIXNAT (XCAR (rest)) < 1 << 24
- && FIXNATP (XCDR (rest)) && XFIXNAT (XCDR (rest)) < 1 << 16)
+ Lisp_Object hi = CONSP (c) ? XCAR (c) : c;
+
+ if (FIXNUMP (hi))
{
- intmax_t mid = XFIXNAT (XCAR (rest));
- val = top << 24 << 16 | mid << 16 | XFIXNAT (XCDR (rest));
+ val = XFIXNUM (hi);
valid = true;
}
- else if (top >= INTMAX_MIN >> 16 && top <= INTMAX_MAX >> 16)
+ else if (BIGNUMP (hi))
{
- if (CONSP (rest))
- rest = XCAR (rest);
- if (FIXNATP (rest) && XFIXNAT (rest) < 1 << 16)
+ val = bignum_to_intmax (hi);
+ valid = val != 0;
+ }
+
+ if (valid && CONSP (c))
+ {
+ intmax_t top = val;
+ Lisp_Object rest = XCDR (c);
+ if (top >= INTMAX_MIN >> 24 >> 16 && top <= INTMAX_MAX >> 24 >> 16
+ && CONSP (rest)
+ && FIXNATP (XCAR (rest)) && XFIXNAT (XCAR (rest)) < 1 << 24
+ && FIXNATP (XCDR (rest)) && XFIXNAT (XCDR (rest)) < 1 << 16)
{
- val = top << 16 | XFIXNAT (rest);
- valid = true;
+ intmax_t mid = XFIXNAT (XCAR (rest));
+ val = top << 24 << 16 | mid << 16 | XFIXNAT (XCDR (rest));
+ }
+ else
+ {
+ valid = INTMAX_MIN >> 16 <= top && top <= INTMAX_MAX >> 16;
+ if (valid)
+ {
+ if (CONSP (rest))
+ rest = XCAR (rest);
+ valid = FIXNATP (rest) && XFIXNAT (rest) < 1 << 16;
+ if (valid)
+ val = top << 16 | XFIXNAT (rest);
+ }
}
}
}
@@ -2796,15 +2777,10 @@ NUMBER may be an integer or a floating point number.
*/)
char buffer[max (FLOAT_TO_STRING_BUFSIZE, INT_BUFSIZE_BOUND (EMACS_INT))];
int len;
- if (BIGNUMP (number))
- {
- ptrdiff_t count = SPECPDL_INDEX ();
- char *str = mpz_get_str (NULL, 10, XBIGNUM (number)->value);
- record_unwind_protect_ptr (xfree, str);
- return unbind_to (count, make_unibyte_string (str, strlen (str)));
- }
+ CHECK_NUMBER (number);
- CHECK_FIXNUM_OR_FLOAT (number);
+ if (BIGNUMP (number))
+ return bignum_to_string (number, 10);
if (FLOATP (number))
len = float_to_string (buffer, XFLOAT_DATA (number));
@@ -2857,6 +2833,9 @@ enum arithop
Alogxor
};
+enum { FIXNUMS_FIT_IN_LONG = (LONG_MIN <= MOST_NEGATIVE_FIXNUM
+ && MOST_POSITIVE_FIXNUM <= LONG_MAX) };
+
static void
free_mpz_value (void *value_ptr)
{
@@ -2911,7 +2890,7 @@ arith_driver (enum arithop code, ptrdiff_t nargs,
Lisp_Object *args)
case Aadd:
if (BIGNUMP (val))
mpz_add (accum, accum, XBIGNUM (val)->value);
- else if (sizeof (EMACS_INT) > sizeof (long))
+ else if (! FIXNUMS_FIT_IN_LONG)
{
mpz_t tem;
mpz_init (tem);
@@ -2936,7 +2915,7 @@ arith_driver (enum arithop code, ptrdiff_t nargs,
Lisp_Object *args)
}
else if (BIGNUMP (val))
mpz_sub (accum, accum, XBIGNUM (val)->value);
- else if (sizeof (EMACS_INT) > sizeof (long))
+ else if (! FIXNUMS_FIT_IN_LONG)
{
mpz_t tem;
mpz_init (tem);
@@ -2951,13 +2930,13 @@ arith_driver (enum arithop code, ptrdiff_t nargs,
Lisp_Object *args)
break;
case Amult:
if (BIGNUMP (val))
- mpz_mul (accum, accum, XBIGNUM (val)->value);
- else if (sizeof (EMACS_INT) > sizeof (long))
+ emacs_mpz_mul (accum, accum, XBIGNUM (val)->value);
+ else if (! FIXNUMS_FIT_IN_LONG)
{
mpz_t tem;
mpz_init (tem);
mpz_set_intmax (tem, XFIXNUM (val));
- mpz_mul (accum, accum, tem);
+ emacs_mpz_mul (accum, accum, tem);
mpz_clear (tem);
}
else
@@ -2975,11 +2954,11 @@ arith_driver (enum arithop code, ptrdiff_t nargs,
Lisp_Object *args)
{
/* Note that a bignum can never be 0, so we don't need
to check that case. */
- if (FIXNUMP (val) && XFIXNUM (val) == 0)
- xsignal0 (Qarith_error);
if (BIGNUMP (val))
mpz_tdiv_q (accum, accum, XBIGNUM (val)->value);
- else if (sizeof (EMACS_INT) > sizeof (long))
+ else if (XFIXNUM (val) == 0)
+ xsignal0 (Qarith_error);
+ else if (ULONG_MAX < -MOST_NEGATIVE_FIXNUM)
{
mpz_t tem;
mpz_init (tem);
@@ -2990,11 +2969,8 @@ arith_driver (enum arithop code, ptrdiff_t nargs,
Lisp_Object *args)
else
{
EMACS_INT value = XFIXNUM (val);
- bool negate = value < 0;
- if (negate)
- value = -value;
- mpz_tdiv_q_ui (accum, accum, value);
- if (negate)
+ mpz_tdiv_q_ui (accum, accum, eabs (value));
+ if (value < 0)
mpz_neg (accum, accum);
}
}
@@ -3038,33 +3014,21 @@ arith_driver (enum arithop code, ptrdiff_t nargs,
Lisp_Object *args)
}
}
- return unbind_to (count, make_number (accum));
+ return unbind_to (count, make_integer (accum));
}
static Lisp_Object
float_arith_driver (double accum, ptrdiff_t argnum, enum arithop code,
ptrdiff_t nargs, Lisp_Object *args)
{
- register Lisp_Object val;
- double next;
-
for (; argnum < nargs; argnum++)
{
- /* using args[argnum] as argument to CHECK_NUMBER_... */
- val = args[argnum];
+ Lisp_Object val = args[argnum];
CHECK_NUMBER_COERCE_MARKER (val);
+ double next = (FIXNUMP (val) ? XFIXNUM (val)
+ : FLOATP (val) ? XFLOAT_DATA (val)
+ : mpz_get_d (XBIGNUM (val)->value));
- if (FLOATP (val))
- {
- next = XFLOAT_DATA (val);
- }
- else if (BIGNUMP (val))
- next = mpz_get_d (XBIGNUM (val)->value);
- else
- {
- args[argnum] = val; /* runs into a compiler bug. */
- next = XFIXNUM (args[argnum]);
- }
switch (code)
{
case Aadd:
@@ -3180,7 +3144,7 @@ Both must be integers or markers. */)
mpz_init (result);
mpz_tdiv_r (result, *xmp, *ymp);
- val = make_number (result);
+ val = make_integer (result);
mpz_clear (result);
if (xmp == &xm)
@@ -3260,7 +3224,7 @@ Both X and Y must be numbers or markers. */)
if (cmpy < 0 ? cmpr > 0 : cmpr < 0)
mpz_add (result, result, *ymp);
- val = make_number (result);
+ val = make_integer (result);
mpz_clear (result);
if (xmp == &xm)
@@ -3365,30 +3329,44 @@ representation. */)
: count_one_bits_ll (v));
}
-static Lisp_Object
-ash_lsh_impl (Lisp_Object value, Lisp_Object count, bool lsh)
+DEFUN ("ash", Fash, Sash, 2, 2, 0,
+ doc: /* Return VALUE with its bits shifted left by COUNT.
+If COUNT is negative, shifting is actually to the right.
+In this case, the sign bit is duplicated. */)
+ (Lisp_Object value, Lisp_Object count)
{
- /* This code assumes that signed right shifts are arithmetic. */
- verify ((EMACS_INT) -1 >> 1 == -1);
-
Lisp_Object val;
+ /* The negative of the minimum value of COUNT that fits into a fixnum,
+ such that mpz_fdiv_q_exp supports -COUNT. */
+ EMACS_INT minus_count_min = min (-MOST_NEGATIVE_FIXNUM,
+ TYPE_MAXIMUM (mp_bitcnt_t));
CHECK_INTEGER (value);
- CHECK_FIXNUM (count);
+ CHECK_RANGED_INTEGER (count, - minus_count_min, TYPE_MAXIMUM (mp_bitcnt_t));
if (BIGNUMP (value))
{
+ if (XFIXNUM (count) == 0)
+ return value;
mpz_t result;
mpz_init (result);
- if (XFIXNUM (count) >= 0)
- mpz_mul_2exp (result, XBIGNUM (value)->value, XFIXNUM (count));
- else if (lsh)
- mpz_tdiv_q_2exp (result, XBIGNUM (value)->value, - XFIXNUM (count));
+ if (XFIXNUM (count) > 0)
+ emacs_mpz_mul_2exp (result, XBIGNUM (value)->value, XFIXNUM (count));
else
mpz_fdiv_q_2exp (result, XBIGNUM (value)->value, - XFIXNUM (count));
- val = make_number (result);
+ val = make_integer (result);
mpz_clear (result);
}
+ else if (XFIXNUM (count) <= 0)
+ {
+ /* This code assumes that signed right shifts are arithmetic. */
+ verify ((EMACS_INT) -1 >> 1 == -1);
+
+ EMACS_INT shift = -XFIXNUM (count);
+ EMACS_INT result = (shift < EMACS_INT_WIDTH ? XFIXNUM (value) >> shift
+ : XFIXNUM (value) < 0 ? -1 : 0);
+ val = make_fixnum (result);
+ }
else
{
/* Just do the work as bignums to make the code simpler. */
@@ -3399,40 +3377,42 @@ ash_lsh_impl (Lisp_Object value, Lisp_Object count,
bool lsh)
mpz_set_intmax (result, XFIXNUM (value));
if (XFIXNUM (count) >= 0)
- mpz_mul_2exp (result, result, XFIXNUM (count));
- else if (lsh)
- {
- if (mpz_sgn (result) > 0)
- mpz_fdiv_q_2exp (result, result, - XFIXNUM (count));
- else
- mpz_fdiv_q_2exp (result, result, - XFIXNUM (count));
- }
- else /* ash */
+ emacs_mpz_mul_2exp (result, result, XFIXNUM (count));
+ else
mpz_fdiv_q_2exp (result, result, - XFIXNUM (count));
- val = make_number (result);
+ val = make_integer (result);
mpz_clear (result);
}
return val;
}
-DEFUN ("ash", Fash, Sash, 2, 2, 0,
- doc: /* Return VALUE with its bits shifted left by COUNT.
-If COUNT is negative, shifting is actually to the right.
-In this case, the sign bit is duplicated. */)
- (register Lisp_Object value, Lisp_Object count)
-{
- return ash_lsh_impl (value, count, false);
-}
+/* Return X ** Y as an integer. X and Y must be integers, and Y must
+ be nonnegative. */
-DEFUN ("lsh", Flsh, Slsh, 2, 2, 0,
- doc: /* Return VALUE with its bits shifted left by COUNT.
-If COUNT is negative, shifting is actually to the right.
-In this case, zeros are shifted in on the left. */)
- (register Lisp_Object value, Lisp_Object count)
-{
- return ash_lsh_impl (value, count, true);
+Lisp_Object
+expt_integer (Lisp_Object x, Lisp_Object y)
+{
+ unsigned long exp;
+ if (TYPE_RANGED_FIXNUMP (unsigned long, y))
+ exp = XFIXNUM (y);
+ else if (MOST_POSITIVE_FIXNUM < ULONG_MAX && BIGNUMP (y)
+ && mpz_fits_ulong_p (XBIGNUM (y)->value))
+ exp = mpz_get_ui (XBIGNUM (y)->value);
+ else
+ range_error ();
+
+ mpz_t val;
+ mpz_init (val);
+ emacs_mpz_pow_ui (val,
+ (FIXNUMP (x)
+ ? (mpz_set_intmax (val, XFIXNUM (x)), val)
+ : XBIGNUM (x)->value),
+ exp);
+ Lisp_Object res = make_integer (val);
+ mpz_clear (val);
+ return res;
}
DEFUN ("1+", Fadd1, Sadd1, 1, 1, 0,
@@ -3450,7 +3430,7 @@ Markers are converted to integers. */)
mpz_t num;
mpz_init (num);
mpz_add_ui (num, XBIGNUM (number)->value, 1);
- number = make_number (num);
+ number = make_integer (num);
mpz_clear (num);
}
else
@@ -3463,7 +3443,7 @@ Markers are converted to integers. */)
mpz_t num;
mpz_init (num);
mpz_set_intmax (num, XFIXNUM (number) + 1);
- number = make_number (num);
+ number = make_integer (num);
mpz_clear (num);
}
}
@@ -3485,7 +3465,7 @@ Markers are converted to integers. */)
mpz_t num;
mpz_init (num);
mpz_sub_ui (num, XBIGNUM (number)->value, 1);
- number = make_number (num);
+ number = make_integer (num);
mpz_clear (num);
}
else
@@ -3498,7 +3478,7 @@ Markers are converted to integers. */)
mpz_t num;
mpz_init (num);
mpz_set_intmax (num, XFIXNUM (number) - 1);
- number = make_number (num);
+ number = make_integer (num);
mpz_clear (num);
}
}
@@ -3515,7 +3495,7 @@ DEFUN ("lognot", Flognot, Slognot, 1, 1, 0,
mpz_t value;
mpz_init (value);
mpz_com (value, XBIGNUM (number)->value);
- number = make_number (value);
+ number = make_integer (value);
mpz_clear (value);
}
else
@@ -4157,7 +4137,6 @@ syms_of_data (void)
defsubr (&Sconsp);
defsubr (&Satom);
defsubr (&Sintegerp);
- defsubr (&Sfixnump);
defsubr (&Sinteger_or_marker_p);
defsubr (&Snumberp);
defsubr (&Snumber_or_marker_p);
@@ -4183,7 +4162,6 @@ syms_of_data (void)
defsubr (&Sthreadp);
defsubr (&Smutexp);
defsubr (&Scondition_variable_p);
- defsubr (&Sbignump);
defsubr (&Scar);
defsubr (&Scdr);
defsubr (&Scar_safe);
@@ -4235,7 +4213,6 @@ syms_of_data (void)
defsubr (&Slogior);
defsubr (&Slogxor);
defsubr (&Slogcount);
- defsubr (&Slsh);
defsubr (&Sash);
defsubr (&Sadd1);
defsubr (&Ssub1);
diff --git a/src/dbusbind.c b/src/dbusbind.c
index fe92d39..47346a7 100644
--- a/src/dbusbind.c
+++ b/src/dbusbind.c
@@ -378,7 +378,7 @@ xd_signature (char *signature, int dtype, int parent_type,
Lisp_Object object)
case DBUS_TYPE_INT32:
case DBUS_TYPE_INT64:
case DBUS_TYPE_DOUBLE:
- CHECK_FIXNUM_OR_FLOAT (object);
+ CHECK_NUMBER (object);
sprintf (signature, "%c", dtype);
break;
@@ -519,13 +519,13 @@ xd_signature (char *signature, int dtype, int
parent_type, Lisp_Object object)
static intmax_t
xd_extract_signed (Lisp_Object x, intmax_t lo, intmax_t hi)
{
- CHECK_FIXNUM_OR_FLOAT (x);
+ CHECK_NUMBER (x);
if (FIXNUMP (x))
{
if (lo <= XFIXNUM (x) && XFIXNUM (x) <= hi)
return XFIXNUM (x);
}
- else
+ else if (FLOATP (x))
{
double d = XFLOAT_DATA (x);
if (lo <= d && d < 1.0 + hi)
@@ -535,25 +535,30 @@ xd_extract_signed (Lisp_Object x, intmax_t lo, intmax_t
hi)
return n;
}
}
+ else if (! (MOST_NEGATIVE_FIXNUM <= lo && hi <= MOST_POSITIVE_FIXNUM))
+ {
+ intmax_t i = bignum_to_intmax (x);
+ if (i != 0 && lo <= i && i <= hi)
+ return i;
+ }
+
if (xd_in_read_queued_messages)
Fthrow (Qdbus_error, Qnil);
else
- args_out_of_range_3 (x,
- make_fixnum_or_float (lo),
- make_fixnum_or_float (hi));
+ args_out_of_range_3 (x, INT_TO_INTEGER (lo), INT_TO_INTEGER (hi));
}
/* Convert X to an unsigned integer with bounds 0 and HI. */
static uintmax_t
xd_extract_unsigned (Lisp_Object x, uintmax_t hi)
{
- CHECK_FIXNUM_OR_FLOAT (x);
+ CHECK_NUMBER (x);
if (FIXNUMP (x))
{
if (0 <= XFIXNUM (x) && XFIXNUM (x) <= hi)
return XFIXNUM (x);
}
- else
+ else if (FLOATP (x))
{
double d = XFLOAT_DATA (x);
if (0 <= d && d < 1.0 + hi)
@@ -563,10 +568,17 @@ xd_extract_unsigned (Lisp_Object x, uintmax_t hi)
return n;
}
}
+ else if (! (hi <= MOST_POSITIVE_FIXNUM))
+ {
+ uintmax_t i = bignum_to_uintmax (x);
+ if (i != 0 && i <= hi)
+ return i;
+ }
+
if (xd_in_read_queued_messages)
Fthrow (Qdbus_error, Qnil);
else
- args_out_of_range_3 (x, make_fixnum (0), make_fixnum_or_float (hi));
+ args_out_of_range_3 (x, make_fixnum (0), INT_TO_INTEGER (hi));
}
/* Append C value, extracted from Lisp OBJECT, to iteration ITER.
@@ -848,7 +860,7 @@ xd_retrieve_arg (int dtype, DBusMessageIter *iter)
dbus_message_iter_get_basic (iter, &val);
pval = val;
XD_DEBUG_MESSAGE ("%c %d", dtype, pval);
- return make_fixnum_or_float (val);
+ return INT_TO_INTEGER (val);
}
case DBUS_TYPE_UINT32:
@@ -861,7 +873,7 @@ xd_retrieve_arg (int dtype, DBusMessageIter *iter)
dbus_message_iter_get_basic (iter, &val);
pval = val;
XD_DEBUG_MESSAGE ("%c %u", dtype, pval);
- return make_fixnum_or_float (val);
+ return INT_TO_INTEGER (val);
}
case DBUS_TYPE_INT64:
@@ -871,7 +883,7 @@ xd_retrieve_arg (int dtype, DBusMessageIter *iter)
dbus_message_iter_get_basic (iter, &val);
pval = val;
XD_DEBUG_MESSAGE ("%c %"pMd, dtype, pval);
- return make_fixnum_or_float (val);
+ return INT_TO_INTEGER (val);
}
case DBUS_TYPE_UINT64:
@@ -881,7 +893,7 @@ xd_retrieve_arg (int dtype, DBusMessageIter *iter)
dbus_message_iter_get_basic (iter, &val);
pval = val;
XD_DEBUG_MESSAGE ("%c %"pMu, dtype, pval);
- return make_fixnum_or_float (val);
+ return INT_TO_INTEGER (val);
}
case DBUS_TYPE_DOUBLE:
@@ -1454,7 +1466,7 @@ usage: (dbus-message-internal &rest REST) */)
/* The result is the key in Vdbus_registered_objects_table. */
serial = dbus_message_get_serial (dmessage);
- result = list3 (QCserial, bus, make_fixnum_or_float (serial));
+ result = list3 (QCserial, bus, INT_TO_INTEGER (serial));
/* Create a hash table entry. */
Fputhash (result, handler, Vdbus_registered_objects_table);
@@ -1541,7 +1553,7 @@ xd_read_message_1 (DBusConnection *connection,
Lisp_Object bus)
|| (mtype == DBUS_MESSAGE_TYPE_ERROR))
{
/* Search for a registered function of the message. */
- key = list3 (QCserial, bus, make_fixnum_or_float (serial));
+ key = list3 (QCserial, bus, INT_TO_INTEGER (serial));
value = Fgethash (key, Vdbus_registered_objects_table, Qnil);
/* There shall be exactly one entry. Construct an event. */
@@ -1608,7 +1620,7 @@ xd_read_message_1 (DBusConnection *connection,
Lisp_Object bus)
event.arg);
event.arg = Fcons ((uname == NULL ? Qnil : build_string (uname)),
event.arg);
- event.arg = Fcons (make_fixnum_or_float (serial), event.arg);
+ event.arg = Fcons (INT_TO_INTEGER (serial), event.arg);
event.arg = Fcons (make_fixnum (mtype), event.arg);
/* Add the bus symbol to the event. */
diff --git a/src/decompress.c b/src/decompress.c
index 9f7fbe4..2836338 100644
--- a/src/decompress.c
+++ b/src/decompress.c
@@ -30,6 +30,7 @@ along with GNU Emacs. If not, see
<https://www.gnu.org/licenses/>. */
#ifdef WINDOWSNT
# include <windows.h>
+# include "w32common.h"
# include "w32.h"
DEF_DLL_FN (int, inflateInit2_,
diff --git a/src/dired.c b/src/dired.c
index b92cd2b..c4cda40 100644
--- a/src/dired.c
+++ b/src/dired.c
@@ -867,7 +867,7 @@ Elements of the attribute list are:
0. t for directory, string (name linked to) for symbolic link, or nil.
1. Number of links to file.
2. File uid as a string or a number. If a string value cannot be
- looked up, a numeric value, either an integer or a float, is returned.
+ looked up, an integer value is returned.
3. File gid, likewise.
4. Last access time, as a list of integers (HIGH LOW USEC PSEC) in the
same style as (current-time).
@@ -877,7 +877,6 @@ Elements of the attribute list are:
6. Last status change time, likewise. This is the time of last change
to the file's attributes: owner and group, access mode bits, etc.
7. Size in bytes.
- This is a floating point number if the size is too large for an integer.
8. File modes, as a string of ten letters or dashes as in ls -l.
9. An unspecified value, present only for backward compatibility.
10. inode number. If it is larger than what an Emacs integer can hold,
@@ -1012,10 +1011,10 @@ file_attributes (int fd, char const *name,
make_fixnum (s.st_nlink),
(uname
? DECODE_SYSTEM (build_unibyte_string (uname))
- : make_fixnum_or_float (s.st_uid)),
+ : INT_TO_INTEGER (s.st_uid)),
(gname
? DECODE_SYSTEM (build_unibyte_string (gname))
- : make_fixnum_or_float (s.st_gid)),
+ : INT_TO_INTEGER (s.st_gid)),
make_lisp_time (get_stat_atime (&s)),
make_lisp_time (get_stat_mtime (&s)),
make_lisp_time (get_stat_ctime (&s)),
@@ -1024,14 +1023,14 @@ file_attributes (int fd, char const *name,
files of sizes in the 2-4 GiB range wrap around to
negative values, as this is a common bug on older
32-bit platforms. */
- make_fixnum_or_float (sizeof (s.st_size) == 4
- ? s.st_size & 0xffffffffu
- : s.st_size),
+ INT_TO_INTEGER (sizeof (s.st_size) == 4
+ ? s.st_size & 0xffffffffu
+ : s.st_size),
make_string (modes, 10),
Qt,
- INTEGER_TO_CONS (s.st_ino),
- INTEGER_TO_CONS (s.st_dev));
+ INT_TO_INTEGER (s.st_ino),
+ INT_TO_INTEGER (s.st_dev));
}
DEFUN ("file-attributes-lessp", Ffile_attributes_lessp,
Sfile_attributes_lessp, 2, 2, 0,
diff --git a/src/dispnew.c b/src/dispnew.c
index b54ae88..61ca717 100644
--- a/src/dispnew.c
+++ b/src/dispnew.c
@@ -5773,6 +5773,15 @@ sit_for (Lisp_Object timeout, bool reading, int
display_option)
return Qt;
nsec = 0;
}
+ else if (BIGNUMP (timeout))
+ {
+ if (NILP (Fnatnump (timeout)))
+ return Qt;
+ sec = bignum_to_intmax (timeout);
+ if (sec == 0)
+ sec = WAIT_READING_MAX;
+ nsec = 0;
+ }
else if (FLOATP (timeout))
{
double seconds = XFLOAT_DATA (timeout);
diff --git a/src/dosfns.c b/src/dosfns.c
index 25932ff..c159b26 100644
--- a/src/dosfns.c
+++ b/src/dosfns.c
@@ -509,7 +509,7 @@ list_system_processes (void)
{
Lisp_Object proclist = Qnil;
- proclist = Fcons (make_fixnum_or_float (getpid ()), proclist);
+ proclist = Fcons (INT_TO_INTEGER (getpid ()), proclist);
return proclist;
}
@@ -520,8 +520,8 @@ system_process_attributes (Lisp_Object pid)
int proc_id;
Lisp_Object attrs = Qnil;
- CHECK_FIXNUM_OR_FLOAT (pid);
- proc_id = FLOATP (pid) ? XFLOAT_DATA (pid) : XFIXNUM (pid);
+ CHECK_NUMBER (pid);
+ proc_id = XFLOATINT (pid);
if (proc_id == getpid ())
{
@@ -539,12 +539,12 @@ system_process_attributes (Lisp_Object pid)
#endif
uid = getuid ();
- attrs = Fcons (Fcons (Qeuid, make_fixnum_or_float (uid)), attrs);
+ attrs = Fcons (Fcons (Qeuid, INT_TO_INTEGER (uid)), attrs);
usr = getlogin ();
if (usr)
attrs = Fcons (Fcons (Quser, build_string (usr)), attrs);
gid = getgid ();
- attrs = Fcons (Fcons (Qegid, make_fixnum_or_float (gid)), attrs);
+ attrs = Fcons (Fcons (Qegid, INT_TO_INTEGER (gid)), attrs);
gr = getgrgid (gid);
if (gr)
attrs = Fcons (Fcons (Qgroup, build_string (gr->gr_name)), attrs);
@@ -566,7 +566,7 @@ system_process_attributes (Lisp_Object pid)
Fsymbol_value (intern ("before-init-time"))),
attrs);
attrs = Fcons (Fcons (Qvsize,
- make_fixnum_or_float ((unsigned long)sbrk
(0)/1024)),
+ INT_TO_INTEGER ((unsigned long) sbrk (0) / 1024)),
attrs);
attrs = Fcons (Fcons (Qetime, tem), attrs);
#ifndef SYSTEM_MALLOC
diff --git a/src/dynlib.c b/src/dynlib.c
index 53afdaf..d40aa67 100644
--- a/src/dynlib.c
+++ b/src/dynlib.c
@@ -156,9 +156,8 @@ dynlib_addr (void *addr, const char **fname, const char
**symname)
address we pass to it is not an address of a string, but
an address of a function. So we don't care about the
Unicode version. */
- s_pfn_Get_Module_HandleExA =
- (GetModuleHandleExA_Proc) GetProcAddress (hm_kernel32,
- "GetModuleHandleExA");
+ s_pfn_Get_Module_HandleExA = (GetModuleHandleExA_Proc)
+ get_proc_addr (hm_kernel32, "GetModuleHandleExA");
}
if (s_pfn_Get_Module_HandleExA)
{
diff --git a/src/editfns.c b/src/editfns.c
index d2281d7..b4c597f 100644
--- a/src/editfns.c
+++ b/src/editfns.c
@@ -329,7 +329,7 @@ init_editfns (bool dumping)
else
{
uid_t euid = geteuid ();
- tem = make_fixnum_or_float (euid);
+ tem = INT_TO_INTEGER (euid);
}
Vuser_full_name = Fuser_full_name (tem);
@@ -1338,7 +1338,7 @@ This is based on the effective uid, not the real uid.
Also, if the environment variables LOGNAME or USER are set,
that determines the value of this function.
-If optional argument UID is an integer or a float, return the login name
+If optional argument UID is an integer, return the login name
of the user with that uid, or nil if there is no such user. */)
(Lisp_Object uid)
{
@@ -1377,39 +1377,35 @@ This ignores the environment variables LOGNAME and
USER, so it differs from
}
DEFUN ("user-uid", Fuser_uid, Suser_uid, 0, 0, 0,
- doc: /* Return the effective uid of Emacs.
-Value is an integer or a float, depending on the value. */)
+ doc: /* Return the effective uid of Emacs. */)
(void)
{
uid_t euid = geteuid ();
- return make_fixnum_or_float (euid);
+ return INT_TO_INTEGER (euid);
}
DEFUN ("user-real-uid", Fuser_real_uid, Suser_real_uid, 0, 0, 0,
- doc: /* Return the real uid of Emacs.
-Value is an integer or a float, depending on the value. */)
+ doc: /* Return the real uid of Emacs. */)
(void)
{
uid_t uid = getuid ();
- return make_fixnum_or_float (uid);
+ return INT_TO_INTEGER (uid);
}
DEFUN ("group-gid", Fgroup_gid, Sgroup_gid, 0, 0, 0,
- doc: /* Return the effective gid of Emacs.
-Value is an integer or a float, depending on the value. */)
+ doc: /* Return the effective gid of Emacs. */)
(void)
{
gid_t egid = getegid ();
- return make_fixnum_or_float (egid);
+ return INT_TO_INTEGER (egid);
}
DEFUN ("group-real-gid", Fgroup_real_gid, Sgroup_real_gid, 0, 0, 0,
- doc: /* Return the real gid of Emacs.
-Value is an integer or a float, depending on the value. */)
+ doc: /* Return the real gid of Emacs. */)
(void)
{
gid_t gid = getgid ();
- return make_fixnum_or_float (gid);
+ return INT_TO_INTEGER (gid);
}
DEFUN ("user-full-name", Fuser_full_name, Suser_full_name, 0, 1, 0,
@@ -1417,7 +1413,7 @@ DEFUN ("user-full-name", Fuser_full_name,
Suser_full_name, 0, 1, 0,
If the full name corresponding to Emacs's userid is not known,
return "unknown".
-If optional argument UID is an integer or float, return the full name
+If optional argument UID is an integer, return the full name
of the user with that uid, or nil if there is no such user.
If UID is a string, return the full name of the user with that login
name, or nil if there is no such user. */)
@@ -1429,7 +1425,7 @@ name, or nil if there is no such user. */)
if (NILP (uid))
return Vuser_full_name;
- else if (FIXED_OR_FLOATP (uid))
+ else if (NUMBERP (uid))
{
uid_t u;
CONS_TO_INTEGER (uid, uid_t, u);
@@ -1489,7 +1485,7 @@ DEFUN ("emacs-pid", Femacs_pid, Semacs_pid, 0, 0, 0,
(void)
{
pid_t pid = getpid ();
- return make_fixnum_or_float (pid);
+ return INT_TO_INTEGER (pid);
}
@@ -4491,9 +4487,7 @@ styled_format (ptrdiff_t nargs, Lisp_Object *args, bool
message)
else if (conversion == 'X')
base = -16;
- char *str = mpz_get_str (NULL, base, XBIGNUM (arg)->value);
- arg = make_unibyte_string (str, strlen (str));
- xfree (str);
+ arg = bignum_to_string (arg, base);
conversion = 's';
}
@@ -4614,17 +4608,6 @@ styled_format (ptrdiff_t nargs, Lisp_Object *args, bool
message)
{
enum
{
- /* Lower bound on the number of bits per
- base-FLT_RADIX digit. */
- DIG_BITS_LBOUND = FLT_RADIX < 16 ? 1 : 4,
-
- /* 1 if integers should be formatted as long doubles,
- because they may be so large that there is a rounding
- error when converting them to double, and long doubles
- are wider than doubles. */
- INT_AS_LDBL = (DIG_BITS_LBOUND * DBL_MANT_DIG < FIXNUM_BITS - 1
- && DBL_MANT_DIG < LDBL_MANT_DIG),
-
/* Maximum precision for a %f conversion such that the
trailing output digit might be nonzero. Any precision
larger than this will not yield useful information. */
@@ -4655,7 +4638,7 @@ styled_format (ptrdiff_t nargs, Lisp_Object *args, bool
message)
with "L" possibly inserted for floating-point formats,
and with pM inserted for integer formats.
At most two flags F can be specified at once. */
- char convspec[sizeof "%FF.*d" + max (INT_AS_LDBL, pMlen)];
+ char convspec[sizeof "%FF.*d" + max (sizeof "L" - 1, pMlen)];
char *f = convspec;
*f++ = '%';
/* MINUS_FLAG and ZERO_FLAG are dealt with later. */
@@ -4664,15 +4647,7 @@ styled_format (ptrdiff_t nargs, Lisp_Object *args, bool
message)
*f = '#'; f += sharp_flag;
*f++ = '.';
*f++ = '*';
- if (float_conversion)
- {
- if (INT_AS_LDBL)
- {
- *f = 'L';
- f += FIXNUMP (arg);
- }
- }
- else if (conversion != 'c')
+ if (! (float_conversion || conversion == 'c'))
{
memcpy (f, pMd, pMlen);
f += pMlen;
@@ -4700,17 +4675,66 @@ styled_format (ptrdiff_t nargs, Lisp_Object *args, bool
message)
ptrdiff_t sprintf_bytes;
if (float_conversion)
{
- if (INT_AS_LDBL && FIXNUMP (arg))
+ /* Format as a long double if the arg is an integer
+ that would lose less information than when formatting
+ it as a double. Otherwise, format as a double;
+ this is likely to be faster and better-tested. */
+
+ bool format_as_long_double = false;
+ double darg;
+ long double ldarg;
+
+ if (FLOATP (arg))
+ darg = XFLOAT_DATA (arg);
+ else
{
- /* Although long double may have a rounding error if
- DIG_BITS_LBOUND * LDBL_MANT_DIG < FIXNUM_BITS - 1,
- it is more accurate than plain 'double'. */
- long double x = XFIXNUM (arg);
- sprintf_bytes = sprintf (sprintf_buf, convspec, prec, x);
+ bool format_bignum_as_double = false;
+ if (LDBL_MANT_DIG <= DBL_MANT_DIG)
+ {
+ if (FIXNUMP (arg))
+ darg = XFIXNUM (arg);
+ else
+ format_bignum_as_double = true;
+ }
+ else
+ {
+ if (FIXNUMP (arg))
+ ldarg = XFIXNUM (arg);
+ else
+ {
+ intmax_t iarg = bignum_to_intmax (arg);
+ if (iarg != 0)
+ ldarg = iarg;
+ else
+ {
+ uintmax_t uarg = bignum_to_uintmax (arg);
+ if (uarg != 0)
+ ldarg = uarg;
+ else
+ format_bignum_as_double = true;
+ }
+ }
+ if (!format_bignum_as_double)
+ {
+ darg = ldarg;
+ format_as_long_double = darg != ldarg;
+ }
+ }
+ if (format_bignum_as_double)
+ darg = bignum_to_double (arg);
+ }
+
+ if (format_as_long_double)
+ {
+ f[-1] = 'L';
+ *f++ = conversion;
+ *f = '\0';
+ sprintf_bytes = sprintf (sprintf_buf, convspec, prec,
+ ldarg);
}
else
sprintf_bytes = sprintf (sprintf_buf, convspec, prec,
- XFLOATINT (arg));
+ darg);
}
else if (conversion == 'c')
{
@@ -4746,7 +4770,7 @@ styled_format (ptrdiff_t nargs, Lisp_Object *args, bool
message)
{
uprintmax_t x;
bool negative;
- if (INTEGERP (arg))
+ if (FIXNUMP (arg))
{
if (binary_as_unsigned)
{
diff --git a/src/emacs-module.c b/src/emacs-module.c
index e7ba174..cf92b0f 100644
--- a/src/emacs-module.c
+++ b/src/emacs-module.c
@@ -27,6 +27,7 @@ along with GNU Emacs. If not, see
<https://www.gnu.org/licenses/>. */
#include <stdio.h>
#include "lisp.h"
+#include "bignum.h"
#include "dynlib.h"
#include "coding.h"
#include "keyboard.h"
@@ -344,20 +345,20 @@ module_free_global_ref (emacs_env *env, emacs_value ref)
Lisp_Object globals = global_env_private.values;
Lisp_Object prev = Qnil;
ptrdiff_t count = 0;
- for (Lisp_Object tail = global_env_private.values; CONSP (tail);
+ for (Lisp_Object tail = globals; CONSP (tail);
tail = XCDR (tail))
{
- emacs_value global = xmint_pointer (XCAR (globals));
+ emacs_value global = xmint_pointer (XCAR (tail));
if (global == ref)
{
if (NILP (prev))
global_env_private.values = XCDR (globals);
else
- XSETCDR (prev, XCDR (globals));
+ XSETCDR (prev, XCDR (tail));
return;
}
++count;
- prev = globals;
+ prev = tail;
}
module_abort ("Global value was not found in list of %"pD"d globals",
count);
@@ -521,6 +522,8 @@ module_extract_integer (emacs_env *env, emacs_value n)
CHECK_INTEGER (l);
if (BIGNUMP (l))
{
+ /* FIXME: This can incorrectly signal overflow on platforms
+ where long is narrower than intmax_t. */
if (!mpz_fits_slong_p (XBIGNUM (l)->value))
xsignal1 (Qoverflow_error, l);
return mpz_get_si (XBIGNUM (l)->value);
@@ -531,19 +534,8 @@ module_extract_integer (emacs_env *env, emacs_value n)
static emacs_value
module_make_integer (emacs_env *env, intmax_t n)
{
- Lisp_Object obj;
MODULE_FUNCTION_BEGIN (module_nil);
- if (FIXNUM_OVERFLOW_P (n))
- {
- mpz_t val;
- mpz_init (val);
- mpz_set_intmax (val, n);
- obj = make_number (val);
- mpz_clear (val);
- }
- else
- obj = make_fixnum (n);
- return lisp_to_value (env, obj);
+ return lisp_to_value (env, make_int (n));
}
static double
@@ -654,7 +646,7 @@ check_vec_index (Lisp_Object lvec, ptrdiff_t i)
{
CHECK_VECTOR (lvec);
if (! (0 <= i && i < ASIZE (lvec)))
- args_out_of_range_3 (make_fixnum_or_float (i),
+ args_out_of_range_3 (INT_TO_INTEGER (i),
make_fixnum (0), make_fixnum (ASIZE (lvec) - 1));
}
diff --git a/src/emacs.c b/src/emacs.c
index 11ee0b8..07a1aff 100644
--- a/src/emacs.c
+++ b/src/emacs.c
@@ -66,6 +66,7 @@ along with GNU Emacs. If not, see
<https://www.gnu.org/licenses/>. */
#include TERM_HEADER
#endif /* HAVE_WINDOW_SYSTEM */
+#include "bignum.h"
#include "intervals.h"
#include "character.h"
#include "buffer.h"
@@ -673,38 +674,6 @@ close_output_streams (void)
_exit (EXIT_FAILURE);
}
-/* Memory allocation functions for GMP. */
-
-static void
-check_bignum_size (size_t size)
-{
- /* Do not create a bignum whose log base 2 could exceed fixnum range.
- This way, functions like mpz_popcount return values in fixnum range.
- It may also help to avoid other problems with outlandish bignums. */
- if (MOST_POSITIVE_FIXNUM / CHAR_BIT < size)
- error ("Integer too large to be represented");
-}
-
-static void * ATTRIBUTE_MALLOC
-xmalloc_for_gmp (size_t size)
-{
- check_bignum_size (size);
- return xmalloc (size);
-}
-
-static void *
-xrealloc_for_gmp (void *ptr, size_t ignore, size_t size)
-{
- check_bignum_size (size);
- return xrealloc (ptr, size);
-}
-
-static void
-xfree_for_gmp (void *ptr, size_t ignore)
-{
- xfree (ptr);
-}
-
/* ARGSUSED */
int
main (int argc, char **argv)
@@ -803,8 +772,6 @@ main (int argc, char **argv)
init_standard_fds ();
atexit (close_output_streams);
- mp_set_memory_functions (xmalloc_for_gmp, xrealloc_for_gmp, xfree_for_gmp);
-
sort_args (argc, argv);
argc = 0;
while (argv[argc]) argc++;
diff --git a/src/fileio.c b/src/fileio.c
index 04e763f..a91bdaa 100644
--- a/src/fileio.c
+++ b/src/fileio.c
@@ -3427,6 +3427,13 @@ file_offset (Lisp_Object val)
if (RANGED_FIXNUMP (0, val, TYPE_MAXIMUM (off_t)))
return XFIXNUM (val);
+ if (BIGNUMP (val))
+ {
+ intmax_t v = bignum_to_intmax (val);
+ if (0 < v && v <= TYPE_MAXIMUM (off_t))
+ return v;
+ }
+
if (FLOATP (val))
{
double v = XFLOAT_DATA (val);
@@ -4946,7 +4953,7 @@ write_region (Lisp_Object start, Lisp_Object end,
Lisp_Object filename,
fn = SSDATA (encoded_filename);
open_flags = O_WRONLY | O_CREAT;
open_flags |= EQ (mustbenew, Qexcl) ? O_EXCL : !NILP (append) ? 0 : O_TRUNC;
- if (FIXED_OR_FLOATP (append))
+ if (NUMBERP (append))
offset = file_offset (append);
else if (!NILP (append))
open_flags |= O_APPEND;
@@ -4971,7 +4978,7 @@ write_region (Lisp_Object start, Lisp_Object end,
Lisp_Object filename,
record_unwind_protect_int (close_file_unwind, desc);
}
- if (FIXED_OR_FLOATP (append))
+ if (NUMBERP (append))
{
off_t ret = lseek (desc, offset, SEEK_SET);
if (ret < 0)
@@ -5154,7 +5161,7 @@ write_region (Lisp_Object start, Lisp_Object end,
Lisp_Object filename,
}
if (!auto_saving && !noninteractive)
- message_with_string ((FIXED_OR_FLOATP (append)
+ message_with_string ((NUMBERP (append)
? "Updated %s"
: ! NILP (append)
? "Added to %s"
diff --git a/src/floatfns.c b/src/floatfns.c
index bbf7df4..77e20d56 100644
--- a/src/floatfns.c
+++ b/src/floatfns.c
@@ -42,6 +42,7 @@ along with GNU Emacs. If not, see
<https://www.gnu.org/licenses/>. */
#include <config.h>
#include "lisp.h"
+#include "bignum.h"
#include <math.h>
@@ -204,29 +205,14 @@ DEFUN ("expt", Fexpt, Sexpt, 2, 2, 0,
doc: /* Return the exponential ARG1 ** ARG2. */)
(Lisp_Object arg1, Lisp_Object arg2)
{
- CHECK_FIXNUM_OR_FLOAT (arg1);
- CHECK_FIXNUM_OR_FLOAT (arg2);
- if (FIXNUMP (arg1) /* common lisp spec */
- && FIXNUMP (arg2) /* don't promote, if both are ints, and */
- && XFIXNUM (arg2) >= 0) /* we are sure the result is not fractional */
- { /* this can be improved by pre-calculating */
- EMACS_INT y; /* some binary powers of x then accumulating */
- EMACS_UINT acc, x; /* Unsigned so that overflow is well defined. */
- Lisp_Object val;
-
- x = XFIXNUM (arg1);
- y = XFIXNUM (arg2);
- acc = (y & 1 ? x : 1);
-
- while ((y >>= 1) != 0)
- {
- x *= x;
- if (y & 1)
- acc *= x;
- }
- XSETINT (val, acc);
- return val;
- }
+ CHECK_NUMBER (arg1);
+ CHECK_NUMBER (arg2);
+
+ /* Common Lisp spec: don't promote if both are integers, and if the
+ result is not fractional. */
+ if (INTEGERP (arg1) && !NILP (Fnatnump (arg2)))
+ return expt_integer (arg1, arg2);
+
return make_float (pow (XFLOATINT (arg1), XFLOATINT (arg2)));
}
@@ -266,30 +252,31 @@ DEFUN ("sqrt", Fsqrt, Ssqrt, 1, 1, 0,
DEFUN ("abs", Fabs, Sabs, 1, 1, 0,
doc: /* Return the absolute value of ARG. */)
- (register Lisp_Object arg)
+ (Lisp_Object arg)
{
CHECK_NUMBER (arg);
- if (BIGNUMP (arg))
+ if (FIXNUMP (arg))
+ {
+ if (XFIXNUM (arg) < 0)
+ arg = make_int (-XFIXNUM (arg));
+ }
+ else if (FLOATP (arg))
{
- mpz_t val;
- mpz_init (val);
- mpz_abs (val, XBIGNUM (arg)->value);
- arg = make_number (val);
- mpz_clear (val);
+ if (signbit (XFLOAT_DATA (arg)))
+ arg = make_float (- XFLOAT_DATA (arg));
}
- else if (FIXNUMP (arg) && XFIXNUM (arg) == MOST_NEGATIVE_FIXNUM)
+ else
{
- mpz_t val;
- mpz_init (val);
- mpz_set_intmax (val, - MOST_NEGATIVE_FIXNUM);
- arg = make_number (val);
- mpz_clear (val);
+ if (mpz_sgn (XBIGNUM (arg)->value) < 0)
+ {
+ mpz_t val;
+ mpz_init (val);
+ mpz_neg (val, XBIGNUM (arg)->value);
+ arg = make_integer (val);
+ mpz_clear (val);
+ }
}
- else if (FLOATP (arg))
- arg = make_float (fabs (XFLOAT_DATA (arg)));
- else if (XFIXNUM (arg) < 0)
- XSETINT (arg, - XFIXNUM (arg));
return arg;
}
@@ -299,13 +286,8 @@ DEFUN ("float", Ffloat, Sfloat, 1, 1, 0,
(register Lisp_Object arg)
{
CHECK_NUMBER (arg);
-
- if (BIGNUMP (arg))
- return make_float (mpz_get_d (XBIGNUM (arg)->value));
- if (FIXNUMP (arg))
- return make_float ((double) XFIXNUM (arg));
- else /* give 'em the same float back */
- return arg;
+ /* If ARG is a float, give 'em the same float back. */
+ return FLOATP (arg) ? arg : make_float (XFLOATINT (arg));
}
static int
@@ -359,10 +341,10 @@ This is the same as the exponent of a float. */)
static Lisp_Object
rounding_driver (Lisp_Object arg, Lisp_Object divisor,
double (*double_round) (double),
- EMACS_INT (*int_round2) (EMACS_INT, EMACS_INT),
+ void (*int_divide) (mpz_t, mpz_t const, mpz_t const),
const char *name)
{
- CHECK_FIXNUM_OR_FLOAT (arg);
+ CHECK_NUMBER (arg);
double d;
if (NILP (divisor))
@@ -373,12 +355,25 @@ rounding_driver (Lisp_Object arg, Lisp_Object divisor,
}
else
{
- CHECK_FIXNUM_OR_FLOAT (divisor);
+ CHECK_NUMBER (divisor);
if (!FLOATP (arg) && !FLOATP (divisor))
{
- if (XFIXNUM (divisor) == 0)
+ if (EQ (divisor, make_fixnum (0)))
xsignal0 (Qarith_error);
- return make_fixnum (int_round2 (XFIXNUM (arg), XFIXNUM (divisor)));
+ mpz_t d, q;
+ mpz_init (d);
+ mpz_init (q);
+ int_divide (q,
+ (FIXNUMP (arg)
+ ? (mpz_set_intmax (q, XFIXNUM (arg)), q)
+ : XBIGNUM (arg)->value),
+ (FIXNUMP (divisor)
+ ? (mpz_set_intmax (d, XFIXNUM (divisor)), d)
+ : XBIGNUM (divisor)->value));
+ Lisp_Object result = make_integer (q);
+ mpz_clear (d);
+ mpz_clear (q);
+ return result;
}
double f1 = FLOATP (arg) ? XFLOAT_DATA (arg) : XFIXNUM (arg);
@@ -399,40 +394,43 @@ rounding_driver (Lisp_Object arg, Lisp_Object divisor,
if (! FIXNUM_OVERFLOW_P (ir))
return make_fixnum (ir);
}
- xsignal2 (Qrange_error, build_string (name), arg);
+ return double_to_bignum (dr);
}
-static EMACS_INT
-ceiling2 (EMACS_INT i1, EMACS_INT i2)
-{
- return i1 / i2 + ((i1 % i2 != 0) & ((i1 < 0) == (i2 < 0)));
-}
-
-static EMACS_INT
-floor2 (EMACS_INT i1, EMACS_INT i2)
-{
- return i1 / i2 - ((i1 % i2 != 0) & ((i1 < 0) != (i2 < 0)));
-}
-
-static EMACS_INT
-truncate2 (EMACS_INT i1, EMACS_INT i2)
-{
- return i1 / i2;
-}
-
-static EMACS_INT
-round2 (EMACS_INT i1, EMACS_INT i2)
-{
- /* The C language's division operator gives us one remainder R, but
- we want the remainder R1 on the other side of 0 if R1 is closer
- to 0 than R is; because we want to round to even, we also want R1
- if R and R1 are the same distance from 0 and if C's quotient is
- odd. */
- EMACS_INT q = i1 / i2;
- EMACS_INT r = i1 % i2;
- EMACS_INT abs_r = eabs (r);
- EMACS_INT abs_r1 = eabs (i2) - abs_r;
- return q + (abs_r + (q & 1) <= abs_r1 ? 0 : (i2 ^ r) < 0 ? -1 : 1);
+static void
+rounddiv_q (mpz_t q, mpz_t const n, mpz_t const d)
+{
+ /* mpz_tdiv_qr gives us one remainder R, but we want the remainder
+ R1 on the other side of 0 if R1 is closer to 0 than R is; because
+ we want to round to even, we also want R1 if R and R1 are the
+ same distance from 0 and if the quotient is odd.
+
+ If we were using EMACS_INT arithmetic instead of bignums,
+ the following code could look something like this:
+
+ q = n / d;
+ r = n % d;
+ neg_d = d < 0;
+ neg_r = r < 0;
+ abs_r = eabs (r);
+ abs_r1 = eabs (d) - abs_r;
+ if (abs_r1 < abs_r + (q & 1))
+ q += neg_d == neg_r ? 1 : -1; */
+
+ mpz_t r, abs_r1;
+ mpz_init (r);
+ mpz_init (abs_r1);
+ mpz_tdiv_qr (q, r, n, d);
+ bool neg_d = mpz_sgn (d) < 0;
+ bool neg_r = mpz_sgn (r) < 0;
+ mpz_t *abs_r = &r;
+ mpz_abs (*abs_r, r);
+ mpz_abs (abs_r1, d);
+ mpz_sub (abs_r1, abs_r1, *abs_r);
+ if (mpz_cmp (abs_r1, *abs_r) < (mpz_odd_p (q) != 0))
+ (neg_d == neg_r ? mpz_add_ui : mpz_sub_ui) (q, q, 1);
+ mpz_clear (r);
+ mpz_clear (abs_r1);
}
/* The code uses emacs_rint, so that it works to undefine HAVE_RINT
@@ -463,7 +461,7 @@ This rounds the value towards +inf.
With optional DIVISOR, return the smallest integer no less than ARG/DIVISOR.
*/)
(Lisp_Object arg, Lisp_Object divisor)
{
- return rounding_driver (arg, divisor, ceil, ceiling2, "ceiling");
+ return rounding_driver (arg, divisor, ceil, mpz_cdiv_q, "ceiling");
}
DEFUN ("floor", Ffloor, Sfloor, 1, 2, 0,
@@ -472,7 +470,7 @@ This rounds the value towards -inf.
With optional DIVISOR, return the largest integer no greater than ARG/DIVISOR.
*/)
(Lisp_Object arg, Lisp_Object divisor)
{
- return rounding_driver (arg, divisor, floor, floor2, "floor");
+ return rounding_driver (arg, divisor, floor, mpz_fdiv_q, "floor");
}
DEFUN ("round", Fround, Sround, 1, 2, 0,
@@ -485,7 +483,14 @@ your machine. For example, (round 2.5) can return 3 on
some
systems, but 2 on others. */)
(Lisp_Object arg, Lisp_Object divisor)
{
- return rounding_driver (arg, divisor, emacs_rint, round2, "round");
+ return rounding_driver (arg, divisor, emacs_rint, rounddiv_q, "round");
+}
+
+/* Since rounding_driver truncates anyway, no need to call 'trunc'. */
+static double
+identity (double x)
+{
+ return x;
}
DEFUN ("truncate", Ftruncate, Struncate, 1, 2, 0,
@@ -494,17 +499,15 @@ Rounds ARG toward zero.
With optional DIVISOR, truncate ARG/DIVISOR. */)
(Lisp_Object arg, Lisp_Object divisor)
{
- return rounding_driver (arg, divisor, trunc, truncate2, "truncate");
+ return rounding_driver (arg, divisor, identity, mpz_tdiv_q, "truncate");
}
Lisp_Object
fmod_float (Lisp_Object x, Lisp_Object y)
{
- double f1, f2;
-
- f1 = FLOATP (x) ? XFLOAT_DATA (x) : XFIXNUM (x);
- f2 = FLOATP (y) ? XFLOAT_DATA (y) : XFIXNUM (y);
+ double f1 = XFLOATINT (x);
+ double f2 = XFLOATINT (y);
f1 = fmod (f1, f2);
diff --git a/src/fns.c b/src/fns.c
index f6e6803..17a869e 100644
--- a/src/fns.c
+++ b/src/fns.c
@@ -28,6 +28,7 @@ along with GNU Emacs. If not, see
<https://www.gnu.org/licenses/>. */
#include <errno.h>
#include "lisp.h"
+#include "bignum.h"
#include "character.h"
#include "coding.h"
#include "composite.h"
@@ -56,15 +57,12 @@ DEFUN ("identity", Fidentity, Sidentity, 1, 1, 0,
}
DEFUN ("random", Frandom, Srandom, 0, 1, 0,
- doc: /* Return a pseudo-random number.
-All integers representable in Lisp, i.e. between `most-negative-fixnum'
-and `most-positive-fixnum', inclusive, are equally likely.
-
-With positive integer LIMIT, return random number in interval [0,LIMIT).
+ doc: /* Return a pseudo-random integer.
+By default, return a fixnum; all fixnums are equally likely.
+With positive fixnum LIMIT, return random integer in interval [0,LIMIT).
With argument t, set the random number seed from the system's entropy
pool if available, otherwise from less-random volatile data such as the time.
With a string argument, set the seed based on the string's contents.
-Other values of LIMIT are ignored.
See Info node `(elisp)Random Numbers' for more details. */)
(Lisp_Object limit)
@@ -134,14 +132,14 @@ To get the number of bytes, use `string-bytes'. */)
DEFUN ("safe-length", Fsafe_length, Ssafe_length, 1, 1, 0,
doc: /* Return the length of a list, but avoid error or infinite loop.
This function never gets an error. If LIST is not really a list,
-it returns 0. If LIST is circular, it returns a finite value
-which is at least the number of distinct elements. */)
+it returns 0. If LIST is circular, it returns an integer that is at
+least the number of distinct elements. */)
(Lisp_Object list)
{
intptr_t len = 0;
FOR_EACH_TAIL_SAFE (list)
len++;
- return make_fixnum_or_float (len);
+ return INT_TO_INTEGER (len);
}
DEFUN ("proper-list-p", Fproper_list_p, Sproper_list_p, 1, 1, 0,
@@ -1405,15 +1403,91 @@ DEFUN ("nthcdr", Fnthcdr, Snthcdr, 2, 2, 0,
doc: /* Take cdr N times on LIST, return the result. */)
(Lisp_Object n, Lisp_Object list)
{
- CHECK_FIXNUM (n);
Lisp_Object tail = list;
- for (EMACS_INT num = XFIXNUM (n); 0 < num; num--)
+
+ CHECK_INTEGER (n);
+
+ /* A huge but in-range EMACS_INT that can be substituted for a
+ positive bignum while counting down. It does not introduce
+ miscounts because a list or cycle cannot possibly be this long,
+ and any counting error is fixed up later. */
+ EMACS_INT large_num = EMACS_INT_MAX;
+
+ EMACS_INT num;
+ if (FIXNUMP (n))
{
- if (! CONSP (tail))
+ num = XFIXNUM (n);
+
+ /* Speed up small lists by omitting circularity and quit checking. */
+ if (num <= SMALL_LIST_LEN_MAX)
{
- CHECK_LIST_END (tail, list);
- return Qnil;
+ for (; 0 < num; num--, tail = XCDR (tail))
+ if (! CONSP (tail))
+ {
+ CHECK_LIST_END (tail, list);
+ return Qnil;
+ }
+ return tail;
}
+ }
+ else
+ {
+ if (mpz_sgn (XBIGNUM (n)->value) < 0)
+ return tail;
+ num = large_num;
+ }
+
+ EMACS_INT tortoise_num = num;
+ Lisp_Object saved_tail = tail;
+ FOR_EACH_TAIL_SAFE (tail)
+ {
+ /* If the tortoise just jumped (which is rare),
+ update TORTOISE_NUM accordingly. */
+ if (EQ (tail, li.tortoise))
+ tortoise_num = num;
+
+ saved_tail = XCDR (tail);
+ num--;
+ if (num == 0)
+ return saved_tail;
+ rarely_quit (num);
+ }
+
+ tail = saved_tail;
+ if (! CONSP (tail))
+ {
+ CHECK_LIST_END (tail, list);
+ return Qnil;
+ }
+
+ /* TAIL is part of a cycle. Reduce NUM modulo the cycle length to
+ avoid going around this cycle repeatedly. */
+ intptr_t cycle_length = tortoise_num - num;
+ if (! FIXNUMP (n))
+ {
+ /* Undo any error introduced when LARGE_NUM was substituted for
+ N, by adding N - LARGE_NUM to NUM, using arithmetic modulo
+ CYCLE_LENGTH. */
+ mpz_t z; /* N mod CYCLE_LENGTH. */
+ mpz_init (z);
+ if (cycle_length <= ULONG_MAX)
+ num += mpz_mod_ui (z, XBIGNUM (n)->value, cycle_length);
+ else
+ {
+ mpz_set_intmax (z, cycle_length);
+ mpz_mod (z, XBIGNUM (n)->value, z);
+ intptr_t iz;
+ mpz_export (&iz, NULL, -1, sizeof iz, 0, 0, z);
+ num += iz;
+ }
+ mpz_clear (z);
+ num += cycle_length - large_num % cycle_length;
+ }
+ num %= cycle_length;
+
+ /* One last time through the cycle. */
+ for (; 0 < num; num--)
+ {
tail = XCDR (tail);
rarely_quit (num);
}
@@ -1430,9 +1504,8 @@ N counts from zero. If LIST is not that long, nil is
returned. */)
DEFUN ("elt", Felt, Selt, 2, 2, 0,
doc: /* Return element of SEQUENCE at index N. */)
- (register Lisp_Object sequence, Lisp_Object n)
+ (Lisp_Object sequence, Lisp_Object n)
{
- CHECK_FIXNUM (n);
if (CONSP (sequence) || NILP (sequence))
return Fcar (Fnthcdr (n, sequence));
diff --git a/src/font.c b/src/font.c
index 920ec1e..4a63700 100644
--- a/src/font.c
+++ b/src/font.c
@@ -1283,19 +1283,20 @@ font_unparse_xlfd (Lisp_Object font, int pixel_size,
char *name, int nbytes)
}
val = AREF (font, FONT_SIZE_INDEX);
- eassert (FIXED_OR_FLOATP (val) || NILP (val));
+ eassert (NUMBERP (val) || NILP (val));
char font_size_index_buf[sizeof "-*"
+ max (INT_STRLEN_BOUND (EMACS_INT),
1 + DBL_MAX_10_EXP + 1)];
- if (FIXNUMP (val))
+ if (INTEGERP (val))
{
- EMACS_INT v = XFIXNUM (val);
- if (v <= 0)
+ intmax_t v = FIXNUMP (val) ? XFIXNUM (val) : bignum_to_intmax (val);
+ if (! (0 <= v && v <= TYPE_MAXIMUM (uprintmax_t)))
v = pixel_size;
if (v > 0)
{
+ uprintmax_t u = v;
f[XLFD_PIXEL_INDEX] = p = font_size_index_buf;
- sprintf (p, "%"pI"d-*", v);
+ sprintf (p, "%"pMu"-*", u);
}
else
f[XLFD_PIXEL_INDEX] = "*-*";
@@ -3324,8 +3325,9 @@ font_open_for_lface (struct frame *f, Lisp_Object entity,
Lisp_Object *attrs, Li
if (size == 0)
{
Lisp_Object ffsize = get_frame_param (f, Qfontsize);
- size = (FIXED_OR_FLOATP (ffsize)
- ? POINT_TO_PIXEL (XFIXNUM (ffsize), FRAME_RES_Y (f)) : 0);
+ size = (NUMBERP (ffsize)
+ ? POINT_TO_PIXEL (XFLOATINT (ffsize), FRAME_RES_Y (f))
+ : 0);
}
#endif
}
@@ -4503,7 +4505,7 @@ where
if (variations[i])
{
int vs = (i < 16 ? 0xFE00 + i : 0xE0100 + (i - 16));
- Lisp_Object code = INTEGER_TO_CONS (variations[i]);
+ Lisp_Object code = INT_TO_INTEGER (variations[i]);
val = Fcons (Fcons (make_fixnum (vs), code), val);
}
return val;
@@ -4606,7 +4608,7 @@ DEFUN ("internal-char-font", Finternal_char_font,
Sinternal_char_font, 1, 2, 0,
return Qnil;
Lisp_Object font_object;
XSETFONT (font_object, face->font);
- return Fcons (font_object, INTEGER_TO_CONS (code));
+ return Fcons (font_object, INT_TO_INTEGER (code));
}
#if 0
@@ -4735,7 +4737,7 @@ DEFUN ("open-font", Fopen_font, Sopen_font, 1, 3, 0,
doc: /* Open FONT-ENTITY. */)
(Lisp_Object font_entity, Lisp_Object size, Lisp_Object frame)
{
- EMACS_INT isize;
+ intmax_t isize;
struct frame *f = decode_live_frame (frame);
CHECK_FONT_ENTITY (font_entity);
@@ -4744,11 +4746,17 @@ DEFUN ("open-font", Fopen_font, Sopen_font, 1, 3, 0,
isize = XFIXNUM (AREF (font_entity, FONT_SIZE_INDEX));
else
{
- CHECK_FIXNUM_OR_FLOAT (size);
- if (FLOATP (size))
- isize = POINT_TO_PIXEL (XFLOAT_DATA (size), FRAME_RES_Y (f));
+ CHECK_NUMBER (size);
+ if (BIGNUMP (size))
+ {
+ isize = bignum_to_intmax (size);
+ if (isize == 0)
+ args_out_of_range (font_entity, size);
+ }
else
- isize = XFIXNUM (size);
+ isize = (FLOATP (size)
+ ? POINT_TO_PIXEL (XFLOAT_DATA (size), FRAME_RES_Y (f))
+ : XFIXNUM (size));
if (! (INT_MIN <= isize && isize <= INT_MAX))
args_out_of_range (font_entity, size);
if (isize == 0)
diff --git a/src/frame.c b/src/frame.c
index ece8971..4371ef7 100644
--- a/src/frame.c
+++ b/src/frame.c
@@ -350,9 +350,13 @@ frame_windows_min_size (Lisp_Object frame, Lisp_Object
horizontal,
int retval;
if ((!NILP (horizontal)
- && FIXED_OR_FLOATP (par_size = get_frame_param (f, Qmin_width)))
+ && RANGED_FIXNUMP (INT_MIN,
+ par_size = get_frame_param (f, Qmin_width),
+ INT_MAX))
|| (NILP (horizontal)
- && FIXED_OR_FLOATP (par_size = get_frame_param (f, Qmin_height))))
+ && RANGED_FIXNUMP (INT_MIN,
+ par_size = get_frame_param (f, Qmin_height),
+ INT_MAX)))
{
int min_size = XFIXNUM (par_size);
@@ -3974,8 +3978,8 @@ x_set_frame_parameters (struct frame *f, Lisp_Object
alist)
if ((!NILP (left) || !NILP (top))
&& ! (left_no_change && top_no_change)
- && ! (FIXED_OR_FLOATP (left) && XFIXNUM (left) == f->left_pos
- && FIXED_OR_FLOATP (top) && XFIXNUM (top) == f->top_pos))
+ && ! (FIXNUMP (left) && XFIXNUM (left) == f->left_pos
+ && FIXNUMP (top) && XFIXNUM (top) == f->top_pos))
{
int leftpos = 0;
int toppos = 0;
@@ -4208,7 +4212,7 @@ x_set_screen_gamma (struct frame *f, Lisp_Object
new_value, Lisp_Object old_valu
if (NILP (new_value))
f->gamma = 0;
- else if (FIXED_OR_FLOATP (new_value) && XFLOATINT (new_value) > 0)
+ else if (NUMBERP (new_value) && XFLOATINT (new_value) > 0)
/* The value 0.4545 is the normal viewing gamma. */
f->gamma = 1.0 / (0.4545 * XFLOATINT (new_value));
else
diff --git a/src/frame.h b/src/frame.h
index 87d0d5a..a3bb633 100644
--- a/src/frame.h
+++ b/src/frame.h
@@ -699,7 +699,7 @@ fset_desired_tool_bar_string (struct frame *f, Lisp_Object
val)
INLINE double
NUMVAL (Lisp_Object x)
{
- return FIXED_OR_FLOATP (x) ? XFLOATINT (x) : -1;
+ return NUMBERP (x) ? XFLOATINT (x) : -1;
}
INLINE double
@@ -1360,17 +1360,13 @@ FRAME_BOTTOM_DIVIDER_WIDTH (struct frame *f)
canonical char width is to be used. X must be a Lisp integer or
float. Value is a C integer. */
#define FRAME_PIXEL_X_FROM_CANON_X(F, X) \
- (FIXNUMP (X) \
- ? XFIXNUM (X) * FRAME_COLUMN_WIDTH (F) \
- : (int) (XFLOAT_DATA (X) * FRAME_COLUMN_WIDTH (F)))
+ ((int) (XFLOATINT (X) * FRAME_COLUMN_WIDTH (F)))
/* Convert canonical value Y to pixels. F is the frame whose
canonical character height is to be used. X must be a Lisp integer
or float. Value is a C integer. */
#define FRAME_PIXEL_Y_FROM_CANON_Y(F, Y) \
- (FIXNUMP (Y) \
- ? XFIXNUM (Y) * FRAME_LINE_HEIGHT (F) \
- : (int) (XFLOAT_DATA (Y) * FRAME_LINE_HEIGHT (F)))
+ ((int) (XFLOATINT (Y) * FRAME_LINE_HEIGHT (F)))
/* Convert pixel-value X to canonical units. F is the frame whose
canonical character width is to be used. X is a C integer. Result
diff --git a/src/fringe.c b/src/fringe.c
index 583bba4..6a44de1 100644
--- a/src/fringe.c
+++ b/src/fringe.c
@@ -1605,7 +1605,7 @@ If BITMAP already exists, the existing definition is
replaced. */)
for (i = 0; i < h && j < fb.height; i++)
{
Lisp_Object elt = Faref (bits, make_fixnum (i));
- b[j++] = FIXED_OR_FLOATP (elt) ? XFIXNUM (elt) : 0;
+ b[j++] = FIXNUMP (elt) ? XFIXNUM (elt) : 0;
}
for (i = 0; i < fill2 && j < fb.height; i++)
b[j++] = 0;
diff --git a/src/gnutls.c b/src/gnutls.c
index 2d455ea..a48d998 100644
--- a/src/gnutls.c
+++ b/src/gnutls.c
@@ -58,6 +58,7 @@ along with GNU Emacs. If not, see
<https://www.gnu.org/licenses/>. */
# ifdef WINDOWSNT
# include <windows.h>
+# include "w32common.h"
# include "w32.h"
# endif
@@ -923,7 +924,7 @@ Usage: (gnutls-error-fatalp ERROR) */)
if (SYMBOLP (err))
{
code = Fget (err, Qgnutls_code);
- if (FIXED_OR_FLOATP (code))
+ if (NUMBERP (code))
{
err = code;
}
@@ -955,7 +956,7 @@ usage: (gnutls-error-string ERROR) */)
if (SYMBOLP (err))
{
code = Fget (err, Qgnutls_code);
- if (FIXED_OR_FLOATP (code))
+ if (NUMBERP (code))
{
err = code;
}
diff --git a/src/image.c b/src/image.c
index 499c1b6..69aeab5 100644
--- a/src/image.c
+++ b/src/image.c
@@ -77,6 +77,7 @@ typedef struct x_bitmap_record Bitmap_Record;
/* We need (or want) w32.h only when we're _not_ compiling for Cygwin. */
#ifdef WINDOWSNT
+# include "w32common.h"
# include "w32.h"
#endif
@@ -799,7 +800,7 @@ parse_image_spec (Lisp_Object spec, struct image_keyword
*keywords,
return 0;
case IMAGE_NUMBER_VALUE:
- if (! FIXED_OR_FLOATP (value))
+ if (! NUMBERP (value))
return 0;
break;
@@ -4928,20 +4929,20 @@ x_edge_detection (struct frame *f, struct image *img,
Lisp_Object matrix,
if (CONSP (matrix))
{
for (i = 0;
- i < 9 && CONSP (matrix) && FIXED_OR_FLOATP (XCAR (matrix));
+ i < 9 && CONSP (matrix) && NUMBERP (XCAR (matrix));
++i, matrix = XCDR (matrix))
trans[i] = XFLOATINT (XCAR (matrix));
}
else if (VECTORP (matrix) && ASIZE (matrix) >= 9)
{
- for (i = 0; i < 9 && FIXED_OR_FLOATP (AREF (matrix, i)); ++i)
+ for (i = 0; i < 9 && NUMBERP (AREF (matrix, i)); ++i)
trans[i] = XFLOATINT (AREF (matrix, i));
}
if (NILP (color_adjust))
color_adjust = make_fixnum (0xffff / 2);
- if (i == 9 && FIXED_OR_FLOATP (color_adjust))
+ if (i == 9 && NUMBERP (color_adjust))
x_detect_edges (f, img, trans, XFLOATINT (color_adjust));
}
@@ -5734,7 +5735,7 @@ DEF_DLL_FN (void, png_read_end, (png_structp, png_infop));
DEF_DLL_FN (void, png_error, (png_structp, png_const_charp));
# if (PNG_LIBPNG_VER >= 10500)
-DEF_DLL_FN (void, png_longjmp, (png_structp, int)) PNG_NORETURN;
+DEF_DLL_FN (void, png_longjmp, (png_structp, int) PNG_NORETURN);
DEF_DLL_FN (jmp_buf *, png_set_longjmp_fn,
(png_structp, png_longjmp_ptr, size_t));
# endif /* libpng version >= 1.5 */
@@ -8102,7 +8103,7 @@ compute_image_size (size_t width, size_t height,
double scale = 1;
value = image_spec_value (spec, QCscale, NULL);
- if (FIXED_OR_FLOATP (value))
+ if (NUMBERP (value))
scale = XFLOATINT (value);
value = image_spec_value (spec, QCmax_width, NULL);
@@ -8272,11 +8273,20 @@ imagemagick_image_p (Lisp_Object object)
/* The GIF library also defines DrawRectangle, but its never used in Emacs.
Therefore rename the function so it doesn't collide with ImageMagick. */
#define DrawRectangle DrawRectangleGif
-#include <wand/MagickWand.h>
+
+#ifdef HAVE_IMAGEMAGICK7
+# include <MagickWand/MagickWand.h>
+# include <MagickCore/version.h>
+/* ImageMagick 7 compatibility definitions. */
+# define PixelSetMagickColor PixelSetPixelColor
+typedef PixelInfo MagickPixelPacket;
+#else
+# include <wand/MagickWand.h>
+# include <magick/version.h>
+#endif
/* ImageMagick 6.5.3 through 6.6.5 hid PixelGetMagickColor for some reason.
Emacs seems to work fine with the hidden version, so unhide it. */
-#include <magick/version.h>
#if 0x653 <= MagickLibVersion && MagickLibVersion <= 0x665
extern WandExport void PixelGetMagickColor (const PixelWand *,
MagickPixelPacket *);
@@ -8814,7 +8824,7 @@ imagemagick_load_image (struct frame *f, struct image
*img,
#endif /* HAVE_MAGICKEXPORTIMAGEPIXELS */
{
size_t image_height;
- MagickRealType color_scale = 65535.0 / QuantumRange;
+ MagickRealType color_scale = 65535.0 / (MagickRealType) QuantumRange;
#ifdef USE_CAIRO
data = xmalloc (width * height * 4);
color_scale /= 256;
diff --git a/src/inotify.c b/src/inotify.c
index 9e76060..6e54c18 100644
--- a/src/inotify.c
+++ b/src/inotify.c
@@ -190,10 +190,10 @@ inotifyevent_to_event (Lisp_Object watch, struct
inotify_event const *ev)
else
name = XCAR (XCDR (watch));
- return list2 (list4 (Fcons (INTEGER_TO_CONS (ev->wd), XCAR (watch)),
+ return list2 (list4 (Fcons (INT_TO_INTEGER (ev->wd), XCAR (watch)),
mask_to_aspects (ev->mask),
name,
- INTEGER_TO_CONS (ev->cookie)),
+ INT_TO_INTEGER (ev->cookie)),
Fnth (make_fixnum (2), watch));
}
@@ -204,10 +204,10 @@ static Lisp_Object
add_watch (int wd, Lisp_Object filename,
uint32_t imask, Lisp_Object callback)
{
- Lisp_Object descriptor = INTEGER_TO_CONS (wd);
+ Lisp_Object descriptor = INT_TO_INTEGER (wd);
Lisp_Object tail = assoc_no_quit (descriptor, watch_list);
Lisp_Object watch, watch_id;
- Lisp_Object mask = INTEGER_TO_CONS (imask);
+ Lisp_Object mask = INT_TO_INTEGER (imask);
EMACS_INT id = 0;
if (NILP (tail))
@@ -332,7 +332,7 @@ inotify_callback (int fd, void *_)
for (ssize_t i = 0; i < n; )
{
struct inotify_event *ev = (struct inotify_event *) &buffer[i];
- Lisp_Object descriptor = INTEGER_TO_CONS (ev->wd);
+ Lisp_Object descriptor = INT_TO_INTEGER (ev->wd);
Lisp_Object prevtail = find_descriptor (descriptor);
if (! NILP (prevtail))
diff --git a/src/json.c b/src/json.c
index 4e413a2..976783d 100644
--- a/src/json.c
+++ b/src/json.c
@@ -34,6 +34,7 @@ along with GNU Emacs. If not, see
<https://www.gnu.org/licenses/>. */
#ifdef WINDOWSNT
# include <windows.h>
+# include "w32common.h"
# include "w32.h"
DEF_DLL_FN (void, json_set_alloc_funcs,
@@ -708,7 +709,7 @@ usage: (json-insert OBJECT &rest ARGS) */)
/* Convert a JSON object to a Lisp object. */
-static _GL_ARG_NONNULL ((1)) Lisp_Object
+static Lisp_Object ARG_NONNULL ((1))
json_to_lisp (json_t *json, struct json_configuration *conf)
{
switch (json_typeof (json))
@@ -720,14 +721,10 @@ json_to_lisp (json_t *json, struct json_configuration
*conf)
case JSON_TRUE:
return Qt;
case JSON_INTEGER:
- /* Return an integer if possible, a floating-point number
- otherwise. This loses precision for integers with large
- magnitude; however, such integers tend to be nonportable
- anyway because many JSON implementations use only 64-bit
- floating-point numbers with 53 mantissa bits. See
- https://tools.ietf.org/html/rfc7159#section-6 for some
- discussion. */
- return make_fixnum_or_float (json_integer_value (json));
+ {
+ json_int_t i = json_integer_value (json);
+ return INT_TO_INTEGER (i);
+ }
case JSON_REAL:
return make_float (json_real_value (json));
case JSON_STRING:
diff --git a/src/keyboard.c b/src/keyboard.c
index 0b38e09..7fafb41 100644
--- a/src/keyboard.c
+++ b/src/keyboard.c
@@ -1298,7 +1298,7 @@ command_loop_1 (void)
if (minibuf_level
&& !NILP (echo_area_buffer[0])
&& EQ (minibuf_window, echo_area_window)
- && FIXED_OR_FLOATP (Vminibuffer_message_timeout))
+ && NUMBERP (Vminibuffer_message_timeout))
{
/* Bind inhibit-quit to t so that C-g gets read in
rather than quitting back to the minibuffer. */
@@ -5834,7 +5834,7 @@ make_lispy_event (struct input_event *event)
ASIZE (wheel_syms));
}
- if (FIXED_OR_FLOATP (event->arg))
+ if (NUMBERP (event->arg))
return list4 (head, position, make_fixnum (double_click_count),
event->arg);
else if (event->modifiers & (double_modifier | triple_modifier))
diff --git a/src/lcms.c b/src/lcms.c
index a3a9822..d5cfafa 100644
--- a/src/lcms.c
+++ b/src/lcms.c
@@ -34,6 +34,7 @@ typedef struct
#ifdef WINDOWSNT
# include <windows.h>
+# include "w32common.h"
# include "w32.h"
DEF_DLL_FN (cmsFloat64Number, cmsCIE2000DeltaE,
@@ -92,7 +93,7 @@ static bool
parse_lab_list (Lisp_Object lab_list, cmsCIELab *color)
{
#define PARSE_LAB_LIST_FIELD(field) \
- if (CONSP (lab_list) && FIXED_OR_FLOATP (XCAR (lab_list)))
\
+ if (CONSP (lab_list) && NUMBERP (XCAR (lab_list))) \
{ \
color->field = XFLOATINT (XCAR (lab_list)); \
lab_list = XCDR (lab_list); \
@@ -137,15 +138,15 @@ chroma, and hue, respectively. The parameters each
default to 1. */)
signal_error ("Invalid color", color1);
if (NILP (kL))
Kl = 1.0f;
- else if (!(FIXED_OR_FLOATP (kL) && (Kl = XFLOATINT(kL))))
+ else if (!(NUMBERP (kL) && (Kl = XFLOATINT(kL))))
wrong_type_argument(Qnumberp, kL);
if (NILP (kC))
Kc = 1.0f;
- else if (!(FIXED_OR_FLOATP (kC) && (Kc = XFLOATINT(kC))))
+ else if (!(NUMBERP (kC) && (Kc = XFLOATINT(kC))))
wrong_type_argument(Qnumberp, kC);
if (NILP (kL))
Kh = 1.0f;
- else if (!(FIXED_OR_FLOATP (kH) && (Kh = XFLOATINT(kH))))
+ else if (!(NUMBERP (kH) && (Kh = XFLOATINT(kH))))
wrong_type_argument(Qnumberp, kH);
return make_float (cmsCIE2000DeltaE (&Lab1, &Lab2, Kl, Kc, Kh));
@@ -183,7 +184,7 @@ static bool
parse_xyz_list (Lisp_Object xyz_list, cmsCIEXYZ *color)
{
#define PARSE_XYZ_LIST_FIELD(field) \
- if (CONSP (xyz_list) && FIXED_OR_FLOATP (XCAR (xyz_list)))
\
+ if (CONSP (xyz_list) && NUMBERP (XCAR (xyz_list))) \
{ \
color->field = 100.0 * XFLOATINT (XCAR (xyz_list)); \
xyz_list = XCDR (xyz_list); \
@@ -202,7 +203,7 @@ static bool
parse_jch_list (Lisp_Object jch_list, cmsJCh *color)
{
#define PARSE_JCH_LIST_FIELD(field) \
- if (CONSP (jch_list) && FIXED_OR_FLOATP (XCAR (jch_list)))
\
+ if (CONSP (jch_list) && NUMBERP (XCAR (jch_list))) \
{ \
color->field = XFLOATINT (XCAR (jch_list)); \
jch_list = XCDR (jch_list); \
@@ -223,7 +224,7 @@ static bool
parse_jab_list (Lisp_Object jab_list, lcmsJab_t *color)
{
#define PARSE_JAB_LIST_FIELD(field) \
- if (CONSP (jab_list) && FIXED_OR_FLOATP (XCAR (jab_list)))
\
+ if (CONSP (jab_list) && NUMBERP (XCAR (jab_list))) \
{ \
color->field = XFLOATINT (XCAR (jab_list)); \
jab_list = XCDR (jab_list); \
@@ -243,7 +244,7 @@ parse_viewing_conditions (Lisp_Object view, const cmsCIEXYZ
*wp,
cmsViewingConditions *vc)
{
#define PARSE_VIEW_CONDITION_FLOAT(field) \
- if (CONSP (view) && FIXED_OR_FLOATP (XCAR (view)))
\
+ if (CONSP (view) && NUMBERP (XCAR (view))) \
{ \
vc->field = XFLOATINT (XCAR (view)); \
view = XCDR (view); \
@@ -554,7 +555,7 @@ Valid range of TEMPERATURE is from 4000K to 25000K. */)
}
#endif
- CHECK_FIXNUM_OR_FLOAT (temperature);
+ CHECK_NUMBER (temperature);
tempK = XFLOATINT (temperature);
if (!(cmsWhitePointFromTemp (&whitepoint, tempK)))
diff --git a/src/lisp.h b/src/lisp.h
index f2cfe81..c5b51ba 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -30,11 +30,6 @@ along with GNU Emacs. If not, see
<https://www.gnu.org/licenses/>. */
#include <float.h>
#include <inttypes.h>
#include <limits.h>
-#ifdef HAVE_GMP
-#include <gmp.h>
-#else
-#include "mini-gmp.h"
-#endif
#include <intprops.h>
#include <verify.h>
@@ -361,10 +356,13 @@ typedef EMACS_INT Lisp_Word;
#define lisp_h_CHECK_SYMBOL(x) CHECK_TYPE (SYMBOLP (x), Qsymbolp, x)
#define lisp_h_CHECK_TYPE(ok, predicate, x) \
((ok) ? (void) 0 : wrong_type_argument (predicate, x))
-#define lisp_h_CONSP(x) (XTYPE (x) == Lisp_Cons)
+#define lisp_h_CONSP(x) TAGGEDP (x, Lisp_Cons)
#define lisp_h_EQ(x, y) (XLI (x) == XLI (y))
-#define lisp_h_FLOATP(x) (XTYPE (x) == Lisp_Float)
-#define lisp_h_FIXNUMP(x) ((XTYPE (x) & (Lisp_Int0 | ~Lisp_Int1)) == Lisp_Int0)
+#define lisp_h_FIXNUMP(x) \
+ (! (((unsigned) (XLI (x) >> (USE_LSB_TAG ? 0 : FIXNUM_BITS)) \
+ - (unsigned) (Lisp_Int0 >> !USE_LSB_TAG)) \
+ & ((1 << INTTYPEBITS) - 1)))
+#define lisp_h_FLOATP(x) TAGGEDP (x, Lisp_Float)
#define lisp_h_NILP(x) EQ (x, Qnil)
#define lisp_h_SET_SYMBOL_VAL(sym, v) \
(eassert ((sym)->u.s.redirect == SYMBOL_PLAINVAL), \
@@ -374,8 +372,12 @@ typedef EMACS_INT Lisp_Word;
#define lisp_h_SYMBOL_TRAPPED_WRITE_P(sym) (XSYMBOL (sym)->u.s.trapped_write)
#define lisp_h_SYMBOL_VAL(sym) \
(eassert ((sym)->u.s.redirect == SYMBOL_PLAINVAL), (sym)->u.s.val.value)
-#define lisp_h_SYMBOLP(x) (XTYPE (x) == Lisp_Symbol)
-#define lisp_h_VECTORLIKEP(x) (XTYPE (x) == Lisp_Vectorlike)
+#define lisp_h_SYMBOLP(x) TAGGEDP (x, Lisp_Symbol)
+#define lisp_h_TAGGEDP(a, tag) \
+ (! (((unsigned) (XLI (a) >> (USE_LSB_TAG ? 0 : VALBITS)) \
+ - (unsigned) (tag)) \
+ & ((1 << GCTYPEBITS) - 1)))
+#define lisp_h_VECTORLIKEP(x) TAGGEDP (x, Lisp_Vectorlike)
#define lisp_h_XCAR(c) XCONS (c)->u.s.car
#define lisp_h_XCDR(c) XCONS (c)->u.s.u.cdr
#define lisp_h_XCONS(a) \
@@ -434,6 +436,7 @@ typedef EMACS_INT Lisp_Word;
# define SYMBOL_TRAPPED_WRITE_P(sym) lisp_h_SYMBOL_TRAPPED_WRITE_P (sym)
# define SYMBOL_VAL(sym) lisp_h_SYMBOL_VAL (sym)
# define SYMBOLP(x) lisp_h_SYMBOLP (x)
+# define TAGGEDP(a, tag) lisp_h_TAGGEDP (a, tag)
# define VECTORLIKEP(x) lisp_h_VECTORLIKEP (x)
# define XCAR(c) lisp_h_XCAR (c)
# define XCDR(c) lisp_h_XCDR (c)
@@ -580,6 +583,11 @@ enum CHECK_LISP_OBJECT_TYPE { CHECK_LISP_OBJECT_TYPE =
false };
INLINE void set_sub_char_table_contents (Lisp_Object, ptrdiff_t,
Lisp_Object);
+/* Defined in bignum.c. */
+extern double bignum_to_double (Lisp_Object);
+extern Lisp_Object make_bigint (intmax_t);
+extern Lisp_Object make_biguint (uintmax_t);
+
/* Defined in chartab.c. */
extern Lisp_Object char_table_ref (Lisp_Object, int);
extern void char_table_set (Lisp_Object, int, Lisp_Object);
@@ -646,6 +654,15 @@ INLINE enum Lisp_Type
#endif
}
+/* True if A has type tag TAG.
+ Equivalent to XTYPE (a) == TAG, but often faster. */
+
+INLINE bool
+(TAGGEDP) (Lisp_Object a, enum Lisp_Type tag)
+{
+ return lisp_h_TAGGEDP (a, tag);
+}
+
INLINE void
(CHECK_TYPE) (int ok, Lisp_Object predicate, Lisp_Object x)
{
@@ -1122,7 +1139,7 @@ INLINE Lisp_Object
make_lisp_ptr (void *ptr, enum Lisp_Type type)
{
Lisp_Object a = TAG_PTR (type, ptr);
- eassert (XTYPE (a) == type && XUNTAG (a, type, char) == ptr);
+ eassert (TAGGEDP (a, type) && XUNTAG (a, type, char) == ptr);
return a;
}
@@ -1355,7 +1372,7 @@ verify (alignof (struct Lisp_String) % GCALIGNMENT == 0);
INLINE bool
STRINGP (Lisp_Object x)
{
- return XTYPE (x) == Lisp_String;
+ return TAGGEDP (x, Lisp_String);
}
INLINE void
@@ -2434,31 +2451,34 @@ XUSER_PTR (Lisp_Object a)
}
#endif
-struct Lisp_Bignum
-{
- union vectorlike_header header;
- mpz_t value;
-};
-
INLINE bool
BIGNUMP (Lisp_Object x)
{
return PSEUDOVECTORP (x, PVEC_BIGNUM);
}
-INLINE struct Lisp_Bignum *
-XBIGNUM (Lisp_Object a)
-{
- eassert (BIGNUMP (a));
- return XUNTAG (a, Lisp_Vectorlike, struct Lisp_Bignum);
-}
-
INLINE bool
INTEGERP (Lisp_Object x)
{
return FIXNUMP (x) || BIGNUMP (x);
}
+/* Return a Lisp integer with value taken from n. */
+INLINE Lisp_Object
+make_int (intmax_t n)
+{
+ return FIXNUM_OVERFLOW_P (n) ? make_bigint (n) : make_fixnum (n);
+}
+INLINE Lisp_Object
+make_uint (uintmax_t n)
+{
+ return FIXNUM_OVERFLOW_P (n) ? make_biguint (n) : make_fixnum (n);
+}
+
+/* Return a Lisp integer equal to the value of the C integer EXPR. */
+#define INT_TO_INTEGER(expr) \
+ (EXPR_SIGNED (expr) ? make_int (expr) : make_uint (expr))
+
/* Forwarding pointer to an int variable.
This is allowed only in the value cell of a symbol,
@@ -2662,23 +2682,11 @@ enum char_bits
/* Data type checking. */
INLINE bool
-FIXED_OR_FLOATP (Lisp_Object x)
-{
- return FIXNUMP (x) || FLOATP (x);
-}
-INLINE bool
FIXNATP (Lisp_Object x)
{
return FIXNUMP (x) && 0 <= XFIXNUM (x);
}
INLINE bool
-NATNUMP (Lisp_Object x)
-{
- if (BIGNUMP (x))
- return mpz_sgn (XBIGNUM (x)->value) >= 0;
- return FIXNUMP (x) && 0 <= XFIXNUM (x);
-}
-INLINE bool
NUMBERP (Lisp_Object x)
{
return INTEGERP (x) || FLOATP (x);
@@ -2822,15 +2830,9 @@ CHECK_FIXNAT (Lisp_Object x)
INLINE double
XFLOATINT (Lisp_Object n)
{
- if (BIGNUMP (n))
- return mpz_get_d (XBIGNUM (n)->value);
- return FLOATP (n) ? XFLOAT_DATA (n) : XFIXNUM (n);
-}
-
-INLINE void
-CHECK_FIXNUM_OR_FLOAT (Lisp_Object x)
-{
- CHECK_TYPE (FIXED_OR_FLOATP (x), Qnumberp, x);
+ return (FIXNUMP (n) ? XFIXNUM (n)
+ : FLOATP (n) ? XFLOAT_DATA (n)
+ : bignum_to_double (n));
}
INLINE void
@@ -2845,14 +2847,6 @@ CHECK_INTEGER (Lisp_Object x)
CHECK_TYPE (INTEGERP (x), Qnumberp, x);
}
-#define CHECK_FIXNUM_OR_FLOAT_COERCE_MARKER(x) \
- do { \
- if (MARKERP (x)) \
- XSETFASTINT (x, marker_position (x)); \
- else \
- CHECK_TYPE (FIXED_OR_FLOATP (x), Qnumber_or_marker_p, x);
\
- } while (false)
-
#define CHECK_NUMBER_COERCE_MARKER(x) \
do { \
if (MARKERP (x)) \
@@ -3284,6 +3278,13 @@ set_sub_char_table_contents (Lisp_Object table,
ptrdiff_t idx, Lisp_Object val)
XSUB_CHAR_TABLE (table)->contents[idx] = val;
}
+/* Defined in bignum.c. */
+extern intmax_t bignum_to_intmax (Lisp_Object);
+extern uintmax_t bignum_to_uintmax (Lisp_Object);
+extern Lisp_Object bignum_to_string (Lisp_Object, int);
+extern Lisp_Object make_bignum_str (char const *, int);
+extern Lisp_Object double_to_bignum (double);
+
/* Defined in data.c. */
extern _Noreturn void wrong_choice (Lisp_Object, Lisp_Object);
extern void notify_variable_watchers (Lisp_Object, Lisp_Object,
@@ -3301,16 +3302,6 @@ enum Arith_Comparison {
extern Lisp_Object arithcompare (Lisp_Object num1, Lisp_Object num2,
enum Arith_Comparison comparison);
-/* Convert the integer I to an Emacs representation, either the integer
- itself, or a cons of two or three integers, or if all else fails a float.
- I should not have side effects. */
-#define INTEGER_TO_CONS(i) \
- (! FIXNUM_OVERFLOW_P (i) \
- ? make_fixnum (i) \
- : EXPR_SIGNED (i) ? intbig_to_lisp (i) : uintbig_to_lisp (i))
-extern Lisp_Object intbig_to_lisp (intmax_t);
-extern Lisp_Object uintbig_to_lisp (uintmax_t);
-
/* Convert the Emacs representation CONS back to an integer of type
TYPE, storing the result the variable VAR. Signal an error if CONS
is not a valid representation or is out of range for TYPE. */
@@ -3337,7 +3328,7 @@ extern void set_internal (Lisp_Object, Lisp_Object,
Lisp_Object,
enum Set_Internal_Bind);
extern void set_default_internal (Lisp_Object, Lisp_Object,
enum Set_Internal_Bind bindflag);
-
+extern Lisp_Object expt_integer (Lisp_Object, Lisp_Object);
extern void syms_of_data (void);
extern void swap_in_global_binding (struct Lisp_Symbol *);
@@ -3556,22 +3547,6 @@ extern Lisp_Object list5 (Lisp_Object, Lisp_Object,
Lisp_Object, Lisp_Object,
enum constype {CONSTYPE_HEAP, CONSTYPE_PURE};
extern Lisp_Object listn (enum constype, ptrdiff_t, Lisp_Object, ...);
-extern Lisp_Object make_bignum_str (const char *num, int base);
-extern Lisp_Object make_number (mpz_t value);
-extern void mpz_set_intmax_slow (mpz_t result, intmax_t v);
-
-INLINE void
-mpz_set_intmax (mpz_t result, intmax_t v)
-{
- /* mpz_set_si works in terms of long, but Emacs may use a wider
- integer type, and so sometimes will have to construct the mpz_t
- by hand. */
- if (sizeof (intmax_t) > sizeof (long) && (long) v != v)
- mpz_set_intmax_slow (result, v);
- else
- mpz_set_si (result, v);
-}
-
/* Build a frequently used 2/3/4-integer lists. */
INLINE Lisp_Object
@@ -3699,6 +3674,7 @@ extern void display_malloc_warning (void);
extern ptrdiff_t inhibit_garbage_collection (void);
extern Lisp_Object build_overlay (Lisp_Object, Lisp_Object, Lisp_Object);
extern void free_cons (struct Lisp_Cons *);
+extern _Noreturn void range_error (void);
extern void init_alloc_once (void);
extern void init_alloc (void);
extern void syms_of_alloc (void);
@@ -4480,12 +4456,6 @@ extern void init_system_name (void);
because 'abs' is reserved by the C standard. */
#define eabs(x) ((x) < 0 ? -(x) : (x))
-/* Return a fixnum or float, depending on whether the integer VAL fits
- in a Lisp fixnum. */
-
-#define make_fixnum_or_float(val) \
- (FIXNUM_OVERFLOW_P (val) ? make_float (val) : make_fixnum (val))
-
/* SAFE_ALLOCA normally allocates memory on the stack, but if size is
larger than MAX_ALLOCA, use xmalloc to avoid overflowing the stack. */
@@ -4684,6 +4654,11 @@ enum
Lisp_String)) \
: make_unibyte_string (str, len))
+/* The maximum length of "small" lists, as a heuristic. These lists
+ are so short that code need not check for cycles or quits while
+ traversing. */
+enum { SMALL_LIST_LEN_MAX = 127 };
+
/* Loop over conses of the list TAIL, signaling if a cycle is found,
and possibly quitting after each loop iteration. In the loop body,
set TAIL to the current cons. If the loop exits normally,
diff --git a/src/lread.c b/src/lread.c
index df2fe58..a7c5b0b 100644
--- a/src/lread.c
+++ b/src/lread.c
@@ -665,7 +665,7 @@ read_filtered_event (bool no_switch_frame, bool
ascii_required,
delayed_switch_frame = Qnil;
/* Compute timeout. */
- if (FIXED_OR_FLOATP (seconds))
+ if (NUMBERP (seconds))
{
double duration = XFLOATINT (seconds);
struct timespec wait_time = dtotimespec (duration);
@@ -676,7 +676,7 @@ read_filtered_event (bool no_switch_frame, bool
ascii_required,
retry:
do
val = read_char (0, Qnil, (input_method ? Qnil : Qt), 0,
- FIXED_OR_FLOATP (seconds) ? &end_time : NULL);
+ NUMBERP (seconds) ? &end_time : NULL);
while (FIXNUMP (val) && XFIXNUM (val) == -2); /* wrong_kboard_jmpbuf */
if (BUFFERP (val))
@@ -695,7 +695,7 @@ read_filtered_event (bool no_switch_frame, bool
ascii_required,
goto retry;
}
- if (ascii_required && !(FIXED_OR_FLOATP (seconds) && NILP (val)))
+ if (ascii_required && !(NUMBERP (seconds) && NILP (val)))
{
/* Convert certain symbols to their ASCII equivalents. */
if (SYMBOLP (val))
@@ -3161,7 +3161,7 @@ read1 (Lisp_Object readcharfun, int *pch, bool
first_in_list)
/* If it can be recursive, remember it for
future substitutions. */
if (! SYMBOLP (tem)
- && ! FIXED_OR_FLOATP (tem)
+ && ! NUMBERP (tem)
&& ! (STRINGP (tem) && !string_intervals (tem)))
{
struct Lisp_Hash_Table *h2
@@ -3616,7 +3616,7 @@ substitute_object_recurse (struct subst *subst,
Lisp_Object subtree)
bother looking them up; we're done. */
if (SYMBOLP (subtree)
|| (STRINGP (subtree) && !string_intervals (subtree))
- || FIXED_OR_FLOATP (subtree))
+ || NUMBERP (subtree))
return subtree;
/* If we've been to this node before, don't explore it again. */
@@ -3710,8 +3710,9 @@ string_to_number (char const *string, int base, int flags)
IEEE floating point hosts, and works around a formerly-common bug where
atof ("-0.0") drops the sign. */
bool negative = *cp == '-';
+ bool positive = *cp == '+';
- bool signedp = negative || *cp == '+';
+ bool signedp = negative | positive;
cp += signedp;
enum { INTOVERFLOW = 1, LEAD_INT = 2, DOT_CHAR = 4, TRAIL_INT = 8,
@@ -3732,6 +3733,7 @@ string_to_number (char const *string, int base, int flags)
n += digit;
}
}
+ char const *after_digits = cp;
if (*cp == '.')
{
state |= DOT_CHAR;
@@ -3807,10 +3809,19 @@ string_to_number (char const *string, int base, int
flags)
return make_fixnum (negative ? -signed_n : signed_n);
}
- /* Skip a leading "+". */
- if (signedp && !negative)
- ++string;
- return make_bignum_str (string, base);
+ /* Trim any leading "+" and trailing nondigits, then convert to
+ bignum. */
+ string += positive;
+ if (!*after_digits)
+ return make_bignum_str (string, base);
+ ptrdiff_t trimmed_len = after_digits - string;
+ USE_SAFE_ALLOCA;
+ char *trimmed = SAFE_ALLOCA (trimmed_len + 1);
+ memcpy (trimmed, string, trimmed_len);
+ trimmed[trimmed_len] = '\0';
+ Lisp_Object result = make_bignum_str (trimmed, base);
+ SAFE_FREE ();
+ return result;
}
/* Either the number uses float syntax, or it does not fit into a fixnum.
diff --git a/src/nsfns.m b/src/nsfns.m
index ece21c6..659bce8 100644
--- a/src/nsfns.m
+++ b/src/nsfns.m
@@ -1226,10 +1226,10 @@ DEFUN ("x-create-frame", Fx_create_frame,
Sx_create_frame,
/* Read comment about this code in corresponding place in xfns.c. */
tem = x_get_arg (dpyinfo, parms, Qmin_width, NULL, NULL, RES_TYPE_NUMBER);
- if (FIXED_OR_FLOATP (tem))
+ if (FIXNUMP (tem))
store_frame_param (f, Qmin_width, tem);
tem = x_get_arg (dpyinfo, parms, Qmin_height, NULL, NULL, RES_TYPE_NUMBER);
- if (FIXED_OR_FLOATP (tem))
+ if (FIXNUMP (tem))
store_frame_param (f, Qmin_height, tem);
adjust_frame_size (f, FRAME_COLS (f) * FRAME_COLUMN_WIDTH (f),
FRAME_LINES (f) * FRAME_LINE_HEIGHT (f), 5, 1,
diff --git a/src/nsimage.m b/src/nsimage.m
index f657c49..0ae1b88 100644
--- a/src/nsimage.m
+++ b/src/nsimage.m
@@ -88,7 +88,7 @@ ns_load_image (struct frame *f, struct image *img,
index = FIXNUMP (lisp_index) ? XFIXNAT (lisp_index) : 0;
lisp_rotation = Fplist_get (XCDR (img->spec), QCrotation);
- rotation = FIXED_OR_FLOATP (lisp_rotation) ? XFLOATINT (lisp_rotation) : 0;
+ rotation = NUMBERP (lisp_rotation) ? XFLOATINT (lisp_rotation) : 0;
if (STRINGP (spec_file))
{
@@ -532,19 +532,19 @@ ns_set_alpha (void *img, int x, int y, unsigned char a)
double width = -1, height = -1, max_width = -1, max_height = -1;
value = Fplist_get (spec, QCscale);
- if (FIXED_OR_FLOATP (value))
+ if (NUMBERP (value))
scale = XFLOATINT (value) ;
value = Fplist_get (spec, QCmax_width);
- if (FIXED_OR_FLOATP (value))
+ if (NUMBERP (value))
max_width = XFLOATINT (value);
value = Fplist_get (spec, QCmax_height);
- if (FIXED_OR_FLOATP (value))
+ if (NUMBERP (value))
max_height = XFLOATINT (value);
value = Fplist_get (spec, QCwidth);
- if (FIXED_OR_FLOATP (value))
+ if (NUMBERP (value))
{
width = XFLOATINT (value) * scale;
/* :width overrides :max-width. */
@@ -552,7 +552,7 @@ ns_set_alpha (void *img, int x, int y, unsigned char a)
}
value = Fplist_get (spec, QCheight);
- if (FIXED_OR_FLOATP (value))
+ if (NUMBERP (value))
{
height = XFLOATINT (value) * scale;
/* :height overrides :max-height. */
diff --git a/src/nsmenu.m b/src/nsmenu.m
index 7010b77..983e777 100644
--- a/src/nsmenu.m
+++ b/src/nsmenu.m
@@ -1632,24 +1632,24 @@ ns_popup_dialog (struct frame *f, Lisp_Object header,
Lisp_Object contents)
int row = 0;
int buttons = 0, btnnr = 0;
- for (; XTYPE (lst) == Lisp_Cons; lst = XCDR (lst))
+ for (; CONSP (lst); lst = XCDR (lst))
{
item = XCAR (list);
- if (XTYPE (item) == Lisp_Cons)
+ if (CONSP (item))
++buttons;
}
if (buttons > 0)
button_values = xmalloc (buttons * sizeof *button_values);
- for (; XTYPE (list) == Lisp_Cons; list = XCDR (list))
+ for (; CONSP (list); list = XCDR (list))
{
item = XCAR (list);
- if (XTYPE (item) == Lisp_String)
+ if (STRINGP (item))
{
[self addString: SSDATA (item) row: row++];
}
- else if (XTYPE (item) == Lisp_Cons)
+ else if (CONSP (item))
{
button_values[btnnr] = XCDR (item);
[self addButton: SSDATA (XCAR (item)) value: btnnr row: row++];
@@ -1726,7 +1726,7 @@ ns_popup_dialog (struct frame *f, Lisp_Object header,
Lisp_Object contents)
Lisp_Object head;
[super init];
- if (XTYPE (contents) == Lisp_Cons)
+ if (CONSP (contents))
{
head = Fcar (contents);
[self process_dialog: Fcdr (contents)];
@@ -1734,7 +1734,7 @@ ns_popup_dialog (struct frame *f, Lisp_Object header,
Lisp_Object contents)
else
head = contents;
- if (XTYPE (head) == Lisp_String)
+ if (STRINGP (head))
[title setStringValue:
[NSString stringWithUTF8String: SSDATA (head)]];
else if (isQ == YES)
diff --git a/src/nsterm.m b/src/nsterm.m
index 90758d1..961271f 100644
--- a/src/nsterm.m
+++ b/src/nsterm.m
@@ -6684,7 +6684,7 @@ not_in_argv (NSString *arg)
static int totalDeltaX, totalDeltaY;
int lineHeight;
- if (FIXED_OR_FLOATP (ns_mwheel_line_height))
+ if (FIXNUMP (ns_mwheel_line_height))
lineHeight = XFIXNUM (ns_mwheel_line_height);
else
{
diff --git a/src/print.c b/src/print.c
index 824f8d7..49d9e38 100644
--- a/src/print.c
+++ b/src/print.c
@@ -23,6 +23,7 @@ along with GNU Emacs. If not, see
<https://www.gnu.org/licenses/>. */
#include "sysstdio.h"
#include "lisp.h"
+#include "bignum.h"
#include "character.h"
#include "coding.h"
#include "buffer.h"
@@ -1369,10 +1370,12 @@ print_vectorlike (Lisp_Object obj, Lisp_Object
printcharfun, bool escapeflag,
{
case PVEC_BIGNUM:
{
- struct Lisp_Bignum *b = XBIGNUM (obj);
- char *str = mpz_get_str (NULL, 10, b->value);
- record_unwind_protect_ptr (xfree, str);
+ USE_SAFE_ALLOCA;
+ char *str = SAFE_ALLOCA (mpz_sizeinbase (XBIGNUM (obj)->value, 10)
+ + 2);
+ mpz_get_str (str, 10, XBIGNUM (obj)->value);
print_c_string (str, printcharfun);
+ SAFE_FREE ();
}
break;
diff --git a/src/process.c b/src/process.c
index a266da1..29cedd7 100644
--- a/src/process.c
+++ b/src/process.c
@@ -1025,7 +1025,7 @@ static Lisp_Object deleted_pid_list;
void
record_deleted_pid (pid_t pid, Lisp_Object filename)
{
- deleted_pid_list = Fcons (Fcons (make_fixnum_or_float (pid), filename),
+ deleted_pid_list = Fcons (Fcons (INT_TO_INTEGER (pid), filename),
/* GC treated elements set to nil. */
Fdelq (Qnil, deleted_pid_list));
@@ -1164,7 +1164,7 @@ For a network, serial, and pipe connections, this value
is nil. */)
CHECK_PROCESS (process);
pid = XPROCESS (process)->pid;
- return (pid ? make_fixnum_or_float (pid) : Qnil);
+ return pid ? INT_TO_INTEGER (pid) : Qnil;
}
DEFUN ("process-name", Fprocess_name, Sprocess_name, 1, 1, 0,
@@ -6850,13 +6850,13 @@ SIGCODE may be an integer, or a symbol whose name is a
signal name. */)
tem = string_to_number (SSDATA (process), 10, 0);
process = tem;
}
- else if (!FIXED_OR_FLOATP (process))
+ else if (!NUMBERP (process))
process = get_process (process);
if (NILP (process))
return process;
- if (FIXED_OR_FLOATP (process))
+ if (NUMBERP (process))
CONS_TO_INTEGER (process, pid_t, pid);
else
{
@@ -7053,13 +7053,10 @@ handle_child_signal (int sig)
if (! CONSP (head))
continue;
xpid = XCAR (head);
- if (all_pids_are_fixnums ? FIXNUMP (xpid) : FIXED_OR_FLOATP (xpid))
+ if (all_pids_are_fixnums ? FIXNUMP (xpid) : INTEGERP (xpid))
{
- pid_t deleted_pid;
- if (FIXNUMP (xpid))
- deleted_pid = XFIXNUM (xpid);
- else
- deleted_pid = XFLOAT_DATA (xpid);
+ pid_t deleted_pid = (FIXNUMP (xpid) ? XFIXNUM (xpid)
+ : bignum_to_intmax (xpid));
if (child_status_changed (deleted_pid, 0, 0))
{
if (STRINGP (XCDR (head)))
diff --git a/src/syntax.c b/src/syntax.c
index a9bc36a..432d82c 100644
--- a/src/syntax.c
+++ b/src/syntax.c
@@ -614,7 +614,7 @@ find_defun_start (ptrdiff_t pos, ptrdiff_t pos_byte)
error ("syntax-ppss modified the buffer!");
TEMP_SET_PT_BOTH (opoint, opoint_byte);
Lisp_Object boc = Fnth (make_fixnum (8), ppss);
- if (FIXED_OR_FLOATP (boc))
+ if (FIXNUMP (boc))
{
find_start_value = XFIXNUM (boc);
find_start_value_byte = CHAR_TO_BYTE (find_start_value);
diff --git a/src/sysdep.c b/src/sysdep.c
index 889ad6b..52afa2f 100644
--- a/src/sysdep.c
+++ b/src/sysdep.c
@@ -3045,9 +3045,9 @@ list_system_processes (void)
for (i = 0; i < len; i++)
{
#ifdef DARWIN_OS
- proclist = Fcons (make_fixnum_or_float (procs[i].kp_proc.p_pid),
proclist);
+ proclist = Fcons (INT_TO_INTEGER (procs[i].kp_proc.p_pid), proclist);
#else
- proclist = Fcons (make_fixnum_or_float (procs[i].ki_pid), proclist);
+ proclist = Fcons (INT_TO_INTEGER (procs[i].ki_pid), proclist);
#endif
}
@@ -3261,7 +3261,7 @@ system_process_attributes (Lisp_Object pid)
Lisp_Object decoded_cmd;
ptrdiff_t count;
- CHECK_FIXNUM_OR_FLOAT (pid);
+ CHECK_NUMBER (pid);
CONS_TO_INTEGER (pid, pid_t, proc_id);
sprintf (procfn, "/proc/%"pMd, proc_id);
if (stat (procfn, &st) < 0)
@@ -3269,7 +3269,7 @@ system_process_attributes (Lisp_Object pid)
/* euid egid */
uid = st.st_uid;
- attrs = Fcons (Fcons (Qeuid, make_fixnum_or_float (uid)), attrs);
+ attrs = Fcons (Fcons (Qeuid, INT_TO_INTEGER (uid)), attrs);
block_input ();
pw = getpwuid (uid);
unblock_input ();
@@ -3277,7 +3277,7 @@ system_process_attributes (Lisp_Object pid)
attrs = Fcons (Fcons (Quser, build_string (pw->pw_name)), attrs);
gid = st.st_gid;
- attrs = Fcons (Fcons (Qegid, make_fixnum_or_float (gid)), attrs);
+ attrs = Fcons (Fcons (Qegid, INT_TO_INTEGER (gid)), attrs);
block_input ();
gr = getgrgid (gid);
unblock_input ();
@@ -3335,17 +3335,15 @@ system_process_attributes (Lisp_Object pid)
state_str[0] = c;
state_str[1] = '\0';
attrs = Fcons (Fcons (Qstate, build_string (state_str)), attrs);
- attrs = Fcons (Fcons (Qppid, make_fixnum_or_float (ppid)), attrs);
- attrs = Fcons (Fcons (Qpgrp, make_fixnum_or_float (pgrp)), attrs);
- attrs = Fcons (Fcons (Qsess, make_fixnum_or_float (sess)), attrs);
+ attrs = Fcons (Fcons (Qppid, INT_TO_INTEGER (ppid)), attrs);
+ attrs = Fcons (Fcons (Qpgrp, INT_TO_INTEGER (pgrp)), attrs);
+ attrs = Fcons (Fcons (Qsess, INT_TO_INTEGER (sess)), attrs);
attrs = Fcons (Fcons (Qttname, procfs_ttyname (tty)), attrs);
- attrs = Fcons (Fcons (Qtpgid, make_fixnum_or_float (tpgid)), attrs);
- attrs = Fcons (Fcons (Qminflt, make_fixnum_or_float (minflt)), attrs);
- attrs = Fcons (Fcons (Qmajflt, make_fixnum_or_float (majflt)), attrs);
- attrs = Fcons (Fcons (Qcminflt, make_fixnum_or_float (cminflt)),
- attrs);
- attrs = Fcons (Fcons (Qcmajflt, make_fixnum_or_float (cmajflt)),
- attrs);
+ attrs = Fcons (Fcons (Qtpgid, INT_TO_INTEGER (tpgid)), attrs);
+ attrs = Fcons (Fcons (Qminflt, INT_TO_INTEGER (minflt)), attrs);
+ attrs = Fcons (Fcons (Qmajflt, INT_TO_INTEGER (majflt)), attrs);
+ attrs = Fcons (Fcons (Qcminflt, INT_TO_INTEGER (cminflt)), attrs);
+ attrs = Fcons (Fcons (Qcmajflt, INT_TO_INTEGER (cmajflt)), attrs);
clocks_per_sec = sysconf (_SC_CLK_TCK);
if (clocks_per_sec < 0)
clocks_per_sec = 100;
@@ -3371,17 +3369,15 @@ system_process_attributes (Lisp_Object pid)
attrs);
attrs = Fcons (Fcons (Qpri, make_fixnum (priority)), attrs);
attrs = Fcons (Fcons (Qnice, make_fixnum (niceness)), attrs);
- attrs = Fcons (Fcons (Qthcount, make_fixnum_or_float (thcount)),
- attrs);
+ attrs = Fcons (Fcons (Qthcount, INT_TO_INTEGER (thcount)), attrs);
tnow = current_timespec ();
telapsed = get_up_time ();
tboot = timespec_sub (tnow, telapsed);
tstart = time_from_jiffies (start, clocks_per_sec);
tstart = timespec_add (tboot, tstart);
attrs = Fcons (Fcons (Qstart, make_lisp_time (tstart)), attrs);
- attrs = Fcons (Fcons (Qvsize, make_fixnum_or_float (vsize / 1024)),
- attrs);
- attrs = Fcons (Fcons (Qrss, make_fixnum_or_float (4 * rss)), attrs);
+ attrs = Fcons (Fcons (Qvsize, INT_TO_INTEGER (vsize / 1024)), attrs);
+ attrs = Fcons (Fcons (Qrss, INT_TO_INTEGER (4 * rss)), attrs);
telapsed = timespec_sub (tnow, tstart);
attrs = Fcons (Fcons (Qetime, make_lisp_time (telapsed)), attrs);
us_time = time_from_jiffies (u_time + s_time, clocks_per_sec);
@@ -3495,7 +3491,7 @@ system_process_attributes (Lisp_Object pid)
Lisp_Object decoded_cmd;
ptrdiff_t count;
- CHECK_FIXNUM_OR_FLOAT (pid);
+ CHECK_NUMBER (pid);
CONS_TO_INTEGER (pid, pid_t, proc_id);
sprintf (procfn, "/proc/%"pMd, proc_id);
if (stat (procfn, &st) < 0)
@@ -3503,7 +3499,7 @@ system_process_attributes (Lisp_Object pid)
/* euid egid */
uid = st.st_uid;
- attrs = Fcons (Fcons (Qeuid, make_fixnum_or_float (uid)), attrs);
+ attrs = Fcons (Fcons (Qeuid, INT_TO_INTEGER (uid)), attrs);
block_input ();
pw = getpwuid (uid);
unblock_input ();
@@ -3511,7 +3507,7 @@ system_process_attributes (Lisp_Object pid)
attrs = Fcons (Fcons (Quser, build_string (pw->pw_name)), attrs);
gid = st.st_gid;
- attrs = Fcons (Fcons (Qegid, make_fixnum_or_float (gid)), attrs);
+ attrs = Fcons (Fcons (Qegid, INT_TO_INTEGER (gid)), attrs);
block_input ();
gr = getgrgid (gid);
unblock_input ();
@@ -3533,9 +3529,9 @@ system_process_attributes (Lisp_Object pid)
if (nread == sizeof pinfo)
{
- attrs = Fcons (Fcons (Qppid, make_fixnum_or_float (pinfo.pr_ppid)),
attrs);
- attrs = Fcons (Fcons (Qpgrp, make_fixnum_or_float (pinfo.pr_pgid)),
attrs);
- attrs = Fcons (Fcons (Qsess, make_fixnum_or_float (pinfo.pr_sid)),
attrs);
+ attrs = Fcons (Fcons (Qppid, INT_TO_INTEGER (pinfo.pr_ppid)), attrs);
+ attrs = Fcons (Fcons (Qpgrp, INT_TO_INTEGER (pinfo.pr_pgid)), attrs);
+ attrs = Fcons (Fcons (Qsess, INT_TO_INTEGER (pinfo.pr_sid)), attrs);
{
char state_str[2];
@@ -3565,14 +3561,11 @@ system_process_attributes (Lisp_Object pid)
attrs = Fcons (Fcons (Qctime, make_lisp_time (pinfo.pr_ctime)), attrs);
attrs = Fcons (Fcons (Qpri, make_fixnum (pinfo.pr_lwp.pr_pri)), attrs);
attrs = Fcons (Fcons (Qnice, make_fixnum (pinfo.pr_lwp.pr_nice)), attrs);
- attrs = Fcons (Fcons (Qthcount, make_fixnum_or_float (pinfo.pr_nlwp)),
- attrs);
+ attrs = Fcons (Fcons (Qthcount, INT_TO_INTEGER (pinfo.pr_nlwp)), attrs);
attrs = Fcons (Fcons (Qstart, make_lisp_time (pinfo.pr_start)), attrs);
- attrs = Fcons (Fcons (Qvsize, make_fixnum_or_float (pinfo.pr_size)),
- attrs);
- attrs = Fcons (Fcons (Qrss, make_fixnum_or_float (pinfo.pr_rssize)),
- attrs);
+ attrs = Fcons (Fcons (Qvsize, INT_TO_INTEGER (pinfo.pr_size)), attrs);
+ attrs = Fcons (Fcons (Qrss, INT_TO_INTEGER (pinfo.pr_rssize)), attrs);
/* pr_pctcpu and pr_pctmem are unsigned integers in the
range 0 .. 2**15, representing 0.0 .. 1.0. */
@@ -3630,14 +3623,14 @@ system_process_attributes (Lisp_Object pid)
Lisp_Object attrs = Qnil;
Lisp_Object decoded_comm;
- CHECK_FIXNUM_OR_FLOAT (pid);
+ CHECK_NUMBER (pid);
CONS_TO_INTEGER (pid, int, proc_id);
mib[3] = proc_id;
if (sysctl (mib, 4, &proc, &proclen, NULL, 0) != 0)
return attrs;
- attrs = Fcons (Fcons (Qeuid, make_fixnum_or_float (proc.ki_uid)), attrs);
+ attrs = Fcons (Fcons (Qeuid, INT_TO_INTEGER (proc.ki_uid)), attrs);
block_input ();
pw = getpwuid (proc.ki_uid);
@@ -3645,7 +3638,7 @@ system_process_attributes (Lisp_Object pid)
if (pw)
attrs = Fcons (Fcons (Quser, build_string (pw->pw_name)), attrs);
- attrs = Fcons (Fcons (Qegid, make_fixnum_or_float (proc.ki_svgid)), attrs);
+ attrs = Fcons (Fcons (Qegid, INT_TO_INTEGER (proc.ki_svgid)), attrs);
block_input ();
gr = getgrgid (proc.ki_svgid);
@@ -3684,9 +3677,9 @@ system_process_attributes (Lisp_Object pid)
attrs = Fcons (Fcons (Qstate, build_string (state)), attrs);
}
- attrs = Fcons (Fcons (Qppid, make_fixnum_or_float (proc.ki_ppid)), attrs);
- attrs = Fcons (Fcons (Qpgrp, make_fixnum_or_float (proc.ki_pgid)), attrs);
- attrs = Fcons (Fcons (Qsess, make_fixnum_or_float (proc.ki_sid)), attrs);
+ attrs = Fcons (Fcons (Qppid, INT_TO_INTEGER (proc.ki_ppid)), attrs);
+ attrs = Fcons (Fcons (Qpgrp, INT_TO_INTEGER (proc.ki_pgid)), attrs);
+ attrs = Fcons (Fcons (Qsess, INT_TO_INTEGER (proc.ki_sid)), attrs);
block_input ();
ttyname = proc.ki_tdev == NODEV ? NULL : devname (proc.ki_tdev, S_IFCHR);
@@ -3694,9 +3687,11 @@ system_process_attributes (Lisp_Object pid)
if (ttyname)
attrs = Fcons (Fcons (Qtty, build_string (ttyname)), attrs);
- attrs = Fcons (Fcons (Qtpgid, make_fixnum_or_float (proc.ki_tpgid)),
attrs);
- attrs = Fcons (Fcons (Qminflt, make_fixnum_or_float
(proc.ki_rusage.ru_minflt)), attrs);
- attrs = Fcons (Fcons (Qmajflt, make_fixnum_or_float
(proc.ki_rusage.ru_majflt)), attrs);
+ attrs = Fcons (Fcons (Qtpgid, INT_TO_INTEGER (proc.ki_tpgid)), attrs);
+ attrs = Fcons (Fcons (Qminflt, INT_TO_INTEGER (proc.ki_rusage.ru_minflt)),
+ attrs);
+ attrs = Fcons (Fcons (Qmajflt, INT_TO_INTEGER (proc.ki_rusage.ru_majflt)),
+ attrs);
attrs = Fcons (Fcons (Qcminflt, make_fixnum (proc.ki_rusage_ch.ru_minflt)),
attrs);
attrs = Fcons (Fcons (Qcmajflt, make_fixnum (proc.ki_rusage_ch.ru_majflt)),
attrs);
@@ -3718,8 +3713,7 @@ system_process_attributes (Lisp_Object pid)
timeval_to_timespec (proc.ki_rusage_ch.ru_stime));
attrs = Fcons (Fcons (Qctime, make_lisp_time (t)), attrs);
- attrs = Fcons (Fcons (Qthcount, make_fixnum_or_float (proc.ki_numthreads)),
- attrs);
+ attrs = Fcons (Fcons (Qthcount, INT_TO_INTEGER (proc.ki_numthreads)), attrs);
attrs = Fcons (Fcons (Qpri, make_fixnum (proc.ki_pri.pri_native)), attrs);
attrs = Fcons (Fcons (Qnice, make_fixnum (proc.ki_nice)), attrs);
attrs = Fcons (Fcons (Qstart, make_lisp_timeval (proc.ki_start)), attrs);
@@ -3741,7 +3735,7 @@ system_process_attributes (Lisp_Object pid)
{
pcpu = (100.0 * proc.ki_pctcpu / fscale
/ (1 - exp (proc.ki_swtime * log ((double) ccpu / fscale))));
- attrs = Fcons (Fcons (Qpcpu, make_fixnum_or_float (pcpu)), attrs);
+ attrs = Fcons (Fcons (Qpcpu, INT_TO_INTEGER (pcpu)), attrs);
}
}
@@ -3751,7 +3745,7 @@ system_process_attributes (Lisp_Object pid)
double pmem = (proc.ki_flag & P_INMEM
? 100.0 * proc.ki_rssize / npages
: 0);
- attrs = Fcons (Fcons (Qpmem, make_fixnum_or_float (pmem)), attrs);
+ attrs = Fcons (Fcons (Qpmem, INT_TO_INTEGER (pmem)), attrs);
}
mib[2] = KERN_PROC_ARGS;
@@ -3810,7 +3804,7 @@ system_process_attributes (Lisp_Object pid)
Lisp_Object attrs = Qnil;
Lisp_Object decoded_comm;
- CHECK_FIXNUM_OR_FLOAT (pid);
+ CHECK_NUMBER (pid);
CONS_TO_INTEGER (pid, int, proc_id);
mib[3] = proc_id;
@@ -3818,7 +3812,7 @@ system_process_attributes (Lisp_Object pid)
return attrs;
uid = proc.kp_eproc.e_ucred.cr_uid;
- attrs = Fcons (Fcons (Qeuid, make_fixnum_or_float (uid)), attrs);
+ attrs = Fcons (Fcons (Qeuid, INT_TO_INTEGER (uid)), attrs);
block_input ();
pw = getpwuid (uid);
@@ -3827,7 +3821,7 @@ system_process_attributes (Lisp_Object pid)
attrs = Fcons (Fcons (Quser, build_string (pw->pw_name)), attrs);
gid = proc.kp_eproc.e_pcred.p_svgid;
- attrs = Fcons (Fcons (Qegid, make_fixnum_or_float (gid)), attrs);
+ attrs = Fcons (Fcons (Qegid, INT_TO_INTEGER (gid)), attrs);
block_input ();
gr = getgrgid (gid);
@@ -3867,10 +3861,8 @@ system_process_attributes (Lisp_Object pid)
attrs = Fcons (Fcons (Qstate, build_string (state)), attrs);
}
- attrs = Fcons (Fcons (Qppid, make_fixnum_or_float (proc.kp_eproc.e_ppid)),
- attrs);
- attrs = Fcons (Fcons (Qpgrp, make_fixnum_or_float (proc.kp_eproc.e_pgid)),
- attrs);
+ attrs = Fcons (Fcons (Qppid, INT_TO_INTEGER (proc.kp_eproc.e_ppid)), attrs);
+ attrs = Fcons (Fcons (Qpgrp, INT_TO_INTEGER (proc.kp_eproc.e_pgid)), attrs);
tdev = proc.kp_eproc.e_tdev;
block_input ();
@@ -3879,15 +3871,15 @@ system_process_attributes (Lisp_Object pid)
if (ttyname)
attrs = Fcons (Fcons (Qtty, build_string (ttyname)), attrs);
- attrs = Fcons (Fcons (Qtpgid, make_fixnum_or_float
(proc.kp_eproc.e_tpgid)),
+ attrs = Fcons (Fcons (Qtpgid, INT_TO_INTEGER (proc.kp_eproc.e_tpgid)),
attrs);
rusage = proc.kp_proc.p_ru;
if (rusage)
{
- attrs = Fcons (Fcons (Qminflt, make_fixnum_or_float
(rusage->ru_minflt)),
+ attrs = Fcons (Fcons (Qminflt, INT_TO_INTEGER (rusage->ru_minflt)),
attrs);
- attrs = Fcons (Fcons (Qmajflt, make_fixnum_or_float
(rusage->ru_majflt)),
+ attrs = Fcons (Fcons (Qmajflt, INT_TO_INTEGER (rusage->ru_majflt)),
attrs);
attrs = Fcons (Fcons (Qutime, make_lisp_timeval (rusage->ru_utime)),
diff --git a/src/w32.c b/src/w32.c
index ef60475..4b57d91 100644
--- a/src/w32.c
+++ b/src/w32.c
@@ -576,8 +576,8 @@ open_process_token (HANDLE ProcessHandle,
{
g_b_init_open_process_token = 1;
hm_advapi32 = LoadLibrary ("Advapi32.dll");
- s_pfn_Open_Process_Token =
- (OpenProcessToken_Proc) GetProcAddress (hm_advapi32,
"OpenProcessToken");
+ s_pfn_Open_Process_Token = (OpenProcessToken_Proc)
+ get_proc_addr (hm_advapi32, "OpenProcessToken");
}
if (s_pfn_Open_Process_Token == NULL)
{
@@ -608,8 +608,8 @@ get_token_information (HANDLE TokenHandle,
{
g_b_init_get_token_information = 1;
hm_advapi32 = LoadLibrary ("Advapi32.dll");
- s_pfn_Get_Token_Information =
- (GetTokenInformation_Proc) GetProcAddress (hm_advapi32,
"GetTokenInformation");
+ s_pfn_Get_Token_Information = (GetTokenInformation_Proc)
+ get_proc_addr (hm_advapi32, "GetTokenInformation");
}
if (s_pfn_Get_Token_Information == NULL)
{
@@ -644,8 +644,8 @@ lookup_account_sid (LPCTSTR lpSystemName,
{
g_b_init_lookup_account_sid = 1;
hm_advapi32 = LoadLibrary ("Advapi32.dll");
- s_pfn_Lookup_Account_Sid =
- (LookupAccountSid_Proc) GetProcAddress (hm_advapi32,
LookupAccountSid_Name);
+ s_pfn_Lookup_Account_Sid = (LookupAccountSid_Proc)
+ get_proc_addr (hm_advapi32, LookupAccountSid_Name);
}
if (s_pfn_Lookup_Account_Sid == NULL)
{
@@ -677,9 +677,8 @@ get_sid_sub_authority (PSID pSid, DWORD n)
{
g_b_init_get_sid_sub_authority = 1;
hm_advapi32 = LoadLibrary ("Advapi32.dll");
- s_pfn_Get_Sid_Sub_Authority =
- (GetSidSubAuthority_Proc) GetProcAddress (
- hm_advapi32, "GetSidSubAuthority");
+ s_pfn_Get_Sid_Sub_Authority = (GetSidSubAuthority_Proc)
+ get_proc_addr (hm_advapi32, "GetSidSubAuthority");
}
if (s_pfn_Get_Sid_Sub_Authority == NULL)
{
@@ -702,9 +701,8 @@ get_sid_sub_authority_count (PSID pSid)
{
g_b_init_get_sid_sub_authority_count = 1;
hm_advapi32 = LoadLibrary ("Advapi32.dll");
- s_pfn_Get_Sid_Sub_Authority_Count =
- (GetSidSubAuthorityCount_Proc) GetProcAddress (
- hm_advapi32, "GetSidSubAuthorityCount");
+ s_pfn_Get_Sid_Sub_Authority_Count = (GetSidSubAuthorityCount_Proc)
+ get_proc_addr (hm_advapi32, "GetSidSubAuthorityCount");
}
if (s_pfn_Get_Sid_Sub_Authority_Count == NULL)
{
@@ -733,9 +731,8 @@ get_security_info (HANDLE handle,
{
g_b_init_get_security_info = 1;
hm_advapi32 = LoadLibrary ("Advapi32.dll");
- s_pfn_Get_Security_Info =
- (GetSecurityInfo_Proc) GetProcAddress (
- hm_advapi32, "GetSecurityInfo");
+ s_pfn_Get_Security_Info = (GetSecurityInfo_Proc)
+ get_proc_addr (hm_advapi32, "GetSecurityInfo");
}
if (s_pfn_Get_Security_Info == NULL)
{
@@ -769,9 +766,8 @@ get_file_security (const char *lpFileName,
{
g_b_init_get_file_security_w = 1;
hm_advapi32 = LoadLibrary ("Advapi32.dll");
- s_pfn_Get_File_SecurityW =
- (GetFileSecurityW_Proc) GetProcAddress (hm_advapi32,
- "GetFileSecurityW");
+ s_pfn_Get_File_SecurityW = (GetFileSecurityW_Proc)
+ get_proc_addr (hm_advapi32, "GetFileSecurityW");
}
if (s_pfn_Get_File_SecurityW == NULL)
{
@@ -791,9 +787,8 @@ get_file_security (const char *lpFileName,
{
g_b_init_get_file_security_a = 1;
hm_advapi32 = LoadLibrary ("Advapi32.dll");
- s_pfn_Get_File_SecurityA =
- (GetFileSecurityA_Proc) GetProcAddress (hm_advapi32,
- "GetFileSecurityA");
+ s_pfn_Get_File_SecurityA = (GetFileSecurityA_Proc)
+ get_proc_addr (hm_advapi32, "GetFileSecurityA");
}
if (s_pfn_Get_File_SecurityA == NULL)
{
@@ -828,9 +823,8 @@ set_file_security (const char *lpFileName,
{
g_b_init_set_file_security_w = 1;
hm_advapi32 = LoadLibrary ("Advapi32.dll");
- s_pfn_Set_File_SecurityW =
- (SetFileSecurityW_Proc) GetProcAddress (hm_advapi32,
- "SetFileSecurityW");
+ s_pfn_Set_File_SecurityW = (SetFileSecurityW_Proc)
+ get_proc_addr (hm_advapi32, "SetFileSecurityW");
}
if (s_pfn_Set_File_SecurityW == NULL)
{
@@ -849,9 +843,8 @@ set_file_security (const char *lpFileName,
{
g_b_init_set_file_security_a = 1;
hm_advapi32 = LoadLibrary ("Advapi32.dll");
- s_pfn_Set_File_SecurityA =
- (SetFileSecurityA_Proc) GetProcAddress (hm_advapi32,
- "SetFileSecurityA");
+ s_pfn_Set_File_SecurityA = (SetFileSecurityA_Proc)
+ get_proc_addr (hm_advapi32, "SetFileSecurityA");
}
if (s_pfn_Set_File_SecurityA == NULL)
{
@@ -889,9 +882,8 @@ set_named_security_info (LPCTSTR lpObjectName,
{
g_b_init_set_named_security_info_w = 1;
hm_advapi32 = LoadLibrary ("Advapi32.dll");
- s_pfn_Set_Named_Security_InfoW =
- (SetNamedSecurityInfoW_Proc) GetProcAddress (hm_advapi32,
-
"SetNamedSecurityInfoW");
+ s_pfn_Set_Named_Security_InfoW = (SetNamedSecurityInfoW_Proc)
+ get_proc_addr (hm_advapi32, "SetNamedSecurityInfoW");
}
if (s_pfn_Set_Named_Security_InfoW == NULL)
{
@@ -911,9 +903,8 @@ set_named_security_info (LPCTSTR lpObjectName,
{
g_b_init_set_named_security_info_a = 1;
hm_advapi32 = LoadLibrary ("Advapi32.dll");
- s_pfn_Set_Named_Security_InfoA =
- (SetNamedSecurityInfoA_Proc) GetProcAddress (hm_advapi32,
-
"SetNamedSecurityInfoA");
+ s_pfn_Set_Named_Security_InfoA = (SetNamedSecurityInfoA_Proc)
+ get_proc_addr (hm_advapi32, "SetNamedSecurityInfoA");
}
if (s_pfn_Set_Named_Security_InfoA == NULL)
{
@@ -943,9 +934,8 @@ get_security_descriptor_owner (PSECURITY_DESCRIPTOR
pSecurityDescriptor,
{
g_b_init_get_security_descriptor_owner = 1;
hm_advapi32 = LoadLibrary ("Advapi32.dll");
- s_pfn_Get_Security_Descriptor_Owner =
- (GetSecurityDescriptorOwner_Proc) GetProcAddress (
- hm_advapi32, "GetSecurityDescriptorOwner");
+ s_pfn_Get_Security_Descriptor_Owner = (GetSecurityDescriptorOwner_Proc)
+ get_proc_addr (hm_advapi32, "GetSecurityDescriptorOwner");
}
if (s_pfn_Get_Security_Descriptor_Owner == NULL)
{
@@ -972,9 +962,8 @@ get_security_descriptor_group (PSECURITY_DESCRIPTOR
pSecurityDescriptor,
{
g_b_init_get_security_descriptor_group = 1;
hm_advapi32 = LoadLibrary ("Advapi32.dll");
- s_pfn_Get_Security_Descriptor_Group =
- (GetSecurityDescriptorGroup_Proc) GetProcAddress (
- hm_advapi32, "GetSecurityDescriptorGroup");
+ s_pfn_Get_Security_Descriptor_Group = (GetSecurityDescriptorGroup_Proc)
+ get_proc_addr (hm_advapi32, "GetSecurityDescriptorGroup");
}
if (s_pfn_Get_Security_Descriptor_Group == NULL)
{
@@ -1002,9 +991,8 @@ get_security_descriptor_dacl (PSECURITY_DESCRIPTOR
pSecurityDescriptor,
{
g_b_init_get_security_descriptor_dacl = 1;
hm_advapi32 = LoadLibrary ("Advapi32.dll");
- s_pfn_Get_Security_Descriptor_Dacl =
- (GetSecurityDescriptorDacl_Proc) GetProcAddress (
- hm_advapi32, "GetSecurityDescriptorDacl");
+ s_pfn_Get_Security_Descriptor_Dacl = (GetSecurityDescriptorDacl_Proc)
+ get_proc_addr (hm_advapi32, "GetSecurityDescriptorDacl");
}
if (s_pfn_Get_Security_Descriptor_Dacl == NULL)
{
@@ -1029,9 +1017,8 @@ is_valid_sid (PSID sid)
{
g_b_init_is_valid_sid = 1;
hm_advapi32 = LoadLibrary ("Advapi32.dll");
- s_pfn_Is_Valid_Sid =
- (IsValidSid_Proc) GetProcAddress (
- hm_advapi32, "IsValidSid");
+ s_pfn_Is_Valid_Sid = (IsValidSid_Proc)
+ get_proc_addr (hm_advapi32, "IsValidSid");
}
if (s_pfn_Is_Valid_Sid == NULL)
{
@@ -1053,9 +1040,8 @@ equal_sid (PSID sid1, PSID sid2)
{
g_b_init_equal_sid = 1;
hm_advapi32 = LoadLibrary ("Advapi32.dll");
- s_pfn_Equal_Sid =
- (EqualSid_Proc) GetProcAddress (
- hm_advapi32, "EqualSid");
+ s_pfn_Equal_Sid = (EqualSid_Proc)
+ get_proc_addr (hm_advapi32, "EqualSid");
}
if (s_pfn_Equal_Sid == NULL)
{
@@ -1077,9 +1063,8 @@ get_length_sid (PSID sid)
{
g_b_init_get_length_sid = 1;
hm_advapi32 = LoadLibrary ("Advapi32.dll");
- s_pfn_Get_Length_Sid =
- (GetLengthSid_Proc) GetProcAddress (
- hm_advapi32, "GetLengthSid");
+ s_pfn_Get_Length_Sid = (GetLengthSid_Proc)
+ get_proc_addr (hm_advapi32, "GetLengthSid");
}
if (s_pfn_Get_Length_Sid == NULL)
{
@@ -1101,9 +1086,8 @@ copy_sid (DWORD destlen, PSID dest, PSID src)
{
g_b_init_copy_sid = 1;
hm_advapi32 = LoadLibrary ("Advapi32.dll");
- s_pfn_Copy_Sid =
- (CopySid_Proc) GetProcAddress (
- hm_advapi32, "CopySid");
+ s_pfn_Copy_Sid = (CopySid_Proc)
+ get_proc_addr (hm_advapi32, "CopySid");
}
if (s_pfn_Copy_Sid == NULL)
{
@@ -1127,9 +1111,9 @@ get_native_system_info (LPSYSTEM_INFO lpSystemInfo)
if (g_b_init_get_native_system_info == 0)
{
g_b_init_get_native_system_info = 1;
- s_pfn_Get_Native_System_Info =
- (GetNativeSystemInfo_Proc)GetProcAddress (GetModuleHandle
("kernel32.dll"),
- "GetNativeSystemInfo");
+ s_pfn_Get_Native_System_Info = (GetNativeSystemInfo_Proc)
+ get_proc_addr (GetModuleHandle ("kernel32.dll"),
+ "GetNativeSystemInfo");
}
if (s_pfn_Get_Native_System_Info != NULL)
s_pfn_Get_Native_System_Info (lpSystemInfo);
@@ -1151,9 +1135,9 @@ get_system_times (LPFILETIME lpIdleTime,
if (g_b_init_get_system_times == 0)
{
g_b_init_get_system_times = 1;
- s_pfn_Get_System_times =
- (GetSystemTimes_Proc)GetProcAddress (GetModuleHandle ("kernel32.dll"),
- "GetSystemTimes");
+ s_pfn_Get_System_times = (GetSystemTimes_Proc)
+ get_proc_addr (GetModuleHandle ("kernel32.dll"),
+ "GetSystemTimes");
}
if (s_pfn_Get_System_times == NULL)
return FALSE;
@@ -1181,9 +1165,9 @@ create_symbolic_link (LPCSTR lpSymlinkFilename,
if (g_b_init_create_symbolic_link_w == 0)
{
g_b_init_create_symbolic_link_w = 1;
- s_pfn_Create_Symbolic_LinkW =
- (CreateSymbolicLinkW_Proc)GetProcAddress (GetModuleHandle
("kernel32.dll"),
- "CreateSymbolicLinkW");
+ s_pfn_Create_Symbolic_LinkW = (CreateSymbolicLinkW_Proc)
+ get_proc_addr (GetModuleHandle ("kernel32.dll"),
+ "CreateSymbolicLinkW");
}
if (s_pfn_Create_Symbolic_LinkW == NULL)
{
@@ -1216,9 +1200,9 @@ create_symbolic_link (LPCSTR lpSymlinkFilename,
if (g_b_init_create_symbolic_link_a == 0)
{
g_b_init_create_symbolic_link_a = 1;
- s_pfn_Create_Symbolic_LinkA =
- (CreateSymbolicLinkA_Proc)GetProcAddress (GetModuleHandle
("kernel32.dll"),
- "CreateSymbolicLinkA");
+ s_pfn_Create_Symbolic_LinkA = (CreateSymbolicLinkA_Proc)
+ get_proc_addr (GetModuleHandle ("kernel32.dll"),
+ "CreateSymbolicLinkA");
}
if (s_pfn_Create_Symbolic_LinkA == NULL)
{
@@ -1261,9 +1245,9 @@ is_valid_security_descriptor (PSECURITY_DESCRIPTOR
pSecurityDescriptor)
if (g_b_init_is_valid_security_descriptor == 0)
{
g_b_init_is_valid_security_descriptor = 1;
- s_pfn_Is_Valid_Security_Descriptor_Proc =
- (IsValidSecurityDescriptor_Proc)GetProcAddress (GetModuleHandle
("Advapi32.dll"),
-
"IsValidSecurityDescriptor");
+ s_pfn_Is_Valid_Security_Descriptor_Proc =
(IsValidSecurityDescriptor_Proc)
+ get_proc_addr (GetModuleHandle ("Advapi32.dll"),
+ "IsValidSecurityDescriptor");
}
if (s_pfn_Is_Valid_Security_Descriptor_Proc == NULL)
{
@@ -1295,12 +1279,14 @@ convert_sd_to_sddl (PSECURITY_DESCRIPTOR
SecurityDescriptor,
g_b_init_convert_sd_to_sddl = 1;
#ifdef _UNICODE
s_pfn_Convert_SD_To_SDDL =
-
(ConvertSecurityDescriptorToStringSecurityDescriptor_Proc)GetProcAddress
(GetModuleHandle ("Advapi32.dll"),
-
"ConvertSecurityDescriptorToStringSecurityDescriptorW");
+ (ConvertSecurityDescriptorToStringSecurityDescriptor_Proc)
+ get_proc_addr (GetModuleHandle ("Advapi32.dll"),
+
"ConvertSecurityDescriptorToStringSecurityDescriptorW");
#else
s_pfn_Convert_SD_To_SDDL =
-
(ConvertSecurityDescriptorToStringSecurityDescriptor_Proc)GetProcAddress
(GetModuleHandle ("Advapi32.dll"),
-
"ConvertSecurityDescriptorToStringSecurityDescriptorA");
+ (ConvertSecurityDescriptorToStringSecurityDescriptor_Proc)
+ get_proc_addr (GetModuleHandle ("Advapi32.dll"),
+
"ConvertSecurityDescriptorToStringSecurityDescriptorA");
#endif
}
if (s_pfn_Convert_SD_To_SDDL == NULL)
@@ -1338,12 +1324,14 @@ convert_sddl_to_sd (LPCTSTR StringSecurityDescriptor,
g_b_init_convert_sddl_to_sd = 1;
#ifdef _UNICODE
s_pfn_Convert_SDDL_To_SD =
-
(ConvertStringSecurityDescriptorToSecurityDescriptor_Proc)GetProcAddress
(GetModuleHandle ("Advapi32.dll"),
-
"ConvertStringSecurityDescriptorToSecurityDescriptorW");
+ (ConvertStringSecurityDescriptorToSecurityDescriptor_Proc)
+ get_proc_addr (GetModuleHandle ("Advapi32.dll"),
+
"ConvertStringSecurityDescriptorToSecurityDescriptorW");
#else
s_pfn_Convert_SDDL_To_SD =
-
(ConvertStringSecurityDescriptorToSecurityDescriptor_Proc)GetProcAddress
(GetModuleHandle ("Advapi32.dll"),
-
"ConvertStringSecurityDescriptorToSecurityDescriptorA");
+ (ConvertStringSecurityDescriptorToSecurityDescriptor_Proc)
+ get_proc_addr (GetModuleHandle ("Advapi32.dll"),
+
"ConvertStringSecurityDescriptorToSecurityDescriptorA");
#endif
}
if (s_pfn_Convert_SDDL_To_SD == NULL)
@@ -1375,7 +1363,7 @@ get_adapters_info (PIP_ADAPTER_INFO pAdapterInfo, PULONG
pOutBufLen)
hm_iphlpapi = LoadLibrary ("Iphlpapi.dll");
if (hm_iphlpapi)
s_pfn_Get_Adapters_Info = (GetAdaptersInfo_Proc)
- GetProcAddress (hm_iphlpapi, "GetAdaptersInfo");
+ get_proc_addr (hm_iphlpapi, "GetAdaptersInfo");
}
if (s_pfn_Get_Adapters_Info == NULL)
return ERROR_NOT_SUPPORTED;
@@ -1398,7 +1386,7 @@ reg_open_key_ex_w (HKEY hkey, LPCWSTR lpSubKey, DWORD
ulOptions,
hm_advapi32 = LoadLibrary ("Advapi32.dll");
if (hm_advapi32)
s_pfn_Reg_Open_Key_Ex_w = (RegOpenKeyExW_Proc)
- GetProcAddress (hm_advapi32, "RegOpenKeyExW");
+ get_proc_addr (hm_advapi32, "RegOpenKeyExW");
}
if (s_pfn_Reg_Open_Key_Ex_w == NULL)
return ERROR_NOT_SUPPORTED;
@@ -1422,7 +1410,7 @@ reg_query_value_ex_w (HKEY hkey, LPCWSTR lpValueName,
LPDWORD lpReserved,
hm_advapi32 = LoadLibrary ("Advapi32.dll");
if (hm_advapi32)
s_pfn_Reg_Query_Value_Ex_w = (RegQueryValueExW_Proc)
- GetProcAddress (hm_advapi32, "RegQueryValueExW");
+ get_proc_addr (hm_advapi32, "RegQueryValueExW");
}
if (s_pfn_Reg_Query_Value_Ex_w == NULL)
return ERROR_NOT_SUPPORTED;
@@ -1445,7 +1433,7 @@ expand_environment_strings_w (LPCWSTR lpSrc, LPWSTR
lpDst, DWORD nSize)
hm_kernel32 = LoadLibrary ("Kernel32.dll");
if (hm_kernel32)
s_pfn_Expand_Environment_Strings_w = (ExpandEnvironmentStringsW_Proc)
- GetProcAddress (hm_kernel32, "ExpandEnvironmentStringsW");
+ get_proc_addr (hm_kernel32, "ExpandEnvironmentStringsW");
}
if (s_pfn_Expand_Environment_Strings_w == NULL)
{
@@ -2807,7 +2795,8 @@ init_environment (char ** argv)
MSIE 5. */
ShGetFolderPath_fn get_folder_path;
get_folder_path = (ShGetFolderPath_fn)
- GetProcAddress (GetModuleHandle ("shell32.dll"), "SHGetFolderPathA");
+ get_proc_addr (GetModuleHandle ("shell32.dll"),
+ "SHGetFolderPathA");
if (get_folder_path != NULL)
{
@@ -6639,8 +6628,8 @@ create_toolhelp32_snapshot (DWORD Flags, DWORD Ignored)
{
g_b_init_create_toolhelp32_snapshot = 1;
s_pfn_Create_Toolhelp32_Snapshot = (CreateToolhelp32Snapshot_Proc)
- GetProcAddress (GetModuleHandle ("kernel32.dll"),
- "CreateToolhelp32Snapshot");
+ get_proc_addr (GetModuleHandle ("kernel32.dll"),
+ "CreateToolhelp32Snapshot");
}
if (s_pfn_Create_Toolhelp32_Snapshot == NULL)
{
@@ -6658,8 +6647,8 @@ process32_first (HANDLE hSnapshot, LPPROCESSENTRY32 lppe)
{
g_b_init_process32_first = 1;
s_pfn_Process32_First = (Process32First_Proc)
- GetProcAddress (GetModuleHandle ("kernel32.dll"),
- "Process32First");
+ get_proc_addr (GetModuleHandle ("kernel32.dll"),
+ "Process32First");
}
if (s_pfn_Process32_First == NULL)
{
@@ -6677,8 +6666,8 @@ process32_next (HANDLE hSnapshot, LPPROCESSENTRY32 lppe)
{
g_b_init_process32_next = 1;
s_pfn_Process32_Next = (Process32Next_Proc)
- GetProcAddress (GetModuleHandle ("kernel32.dll"),
- "Process32Next");
+ get_proc_addr (GetModuleHandle ("kernel32.dll"),
+ "Process32Next");
}
if (s_pfn_Process32_Next == NULL)
{
@@ -6704,8 +6693,8 @@ open_thread_token (HANDLE ThreadHandle,
{
g_b_init_open_thread_token = 1;
hm_advapi32 = LoadLibrary ("Advapi32.dll");
- s_pfn_Open_Thread_Token =
- (OpenThreadToken_Proc) GetProcAddress (hm_advapi32, "OpenThreadToken");
+ s_pfn_Open_Thread_Token = (OpenThreadToken_Proc)
+ get_proc_addr (hm_advapi32, "OpenThreadToken");
}
if (s_pfn_Open_Thread_Token == NULL)
{
@@ -6734,8 +6723,8 @@ impersonate_self (SECURITY_IMPERSONATION_LEVEL
ImpersonationLevel)
{
g_b_init_impersonate_self = 1;
hm_advapi32 = LoadLibrary ("Advapi32.dll");
- s_pfn_Impersonate_Self =
- (ImpersonateSelf_Proc) GetProcAddress (hm_advapi32, "ImpersonateSelf");
+ s_pfn_Impersonate_Self = (ImpersonateSelf_Proc)
+ get_proc_addr (hm_advapi32, "ImpersonateSelf");
}
if (s_pfn_Impersonate_Self == NULL)
{
@@ -6757,8 +6746,8 @@ revert_to_self (void)
{
g_b_init_revert_to_self = 1;
hm_advapi32 = LoadLibrary ("Advapi32.dll");
- s_pfn_Revert_To_Self =
- (RevertToSelf_Proc) GetProcAddress (hm_advapi32, "RevertToSelf");
+ s_pfn_Revert_To_Self = (RevertToSelf_Proc)
+ get_proc_addr (hm_advapi32, "RevertToSelf");
}
if (s_pfn_Revert_To_Self == NULL)
{
@@ -6784,7 +6773,7 @@ get_process_memory_info (HANDLE h_proc,
hm_psapi = LoadLibrary ("Psapi.dll");
if (hm_psapi)
s_pfn_Get_Process_Memory_Info = (GetProcessMemoryInfo_Proc)
- GetProcAddress (hm_psapi, "GetProcessMemoryInfo");
+ get_proc_addr (hm_psapi, "GetProcessMemoryInfo");
}
if (s_pfn_Get_Process_Memory_Info == NULL)
{
@@ -6809,8 +6798,8 @@ get_process_working_set_size (HANDLE h_proc,
{
g_b_init_get_process_working_set_size = 1;
s_pfn_Get_Process_Working_Set_Size = (GetProcessWorkingSetSize_Proc)
- GetProcAddress (GetModuleHandle ("kernel32.dll"),
- "GetProcessWorkingSetSize");
+ get_proc_addr (GetModuleHandle ("kernel32.dll"),
+ "GetProcessWorkingSetSize");
}
if (s_pfn_Get_Process_Working_Set_Size == NULL)
{
@@ -6832,8 +6821,8 @@ global_memory_status (MEMORYSTATUS *buf)
{
g_b_init_global_memory_status = 1;
s_pfn_Global_Memory_Status = (GlobalMemoryStatus_Proc)
- GetProcAddress (GetModuleHandle ("kernel32.dll"),
- "GlobalMemoryStatus");
+ get_proc_addr (GetModuleHandle ("kernel32.dll"),
+ "GlobalMemoryStatus");
}
if (s_pfn_Global_Memory_Status == NULL)
{
@@ -6855,8 +6844,8 @@ global_memory_status_ex (MEMORY_STATUS_EX *buf)
{
g_b_init_global_memory_status_ex = 1;
s_pfn_Global_Memory_Status_Ex = (GlobalMemoryStatusEx_Proc)
- GetProcAddress (GetModuleHandle ("kernel32.dll"),
- "GlobalMemoryStatusEx");
+ get_proc_addr (GetModuleHandle ("kernel32.dll"),
+ "GlobalMemoryStatusEx");
}
if (s_pfn_Global_Memory_Status_Ex == NULL)
{
@@ -6884,7 +6873,7 @@ list_system_processes (void)
res = process32_next (h_snapshot, &proc_entry))
{
proc_id = proc_entry.th32ProcessID;
- proclist = Fcons (make_fixnum_or_float (proc_id), proclist);
+ proclist = Fcons (INT_TO_INTEGER (proc_id), proclist);
}
CloseHandle (h_snapshot);
@@ -7042,7 +7031,7 @@ system_process_attributes (Lisp_Object pid)
double pcpu;
BOOL result = FALSE;
- CHECK_FIXNUM_OR_FLOAT (pid);
+ CHECK_NUMBER (pid);
proc_id = FLOATP (pid) ? XFLOAT_DATA (pid) : XFIXNUM (pid);
h_snapshot = create_toolhelp32_snapshot (TH32CS_SNAPPROCESS, 0);
@@ -7072,12 +7061,12 @@ system_process_attributes (Lisp_Object pid)
}
attrs = Fcons (Fcons (Qcomm, decoded_cmd), attrs);
attrs = Fcons (Fcons (Qppid,
- make_fixnum_or_float
(pe.th32ParentProcessID)),
+ INT_TO_INTEGER (pe.th32ParentProcessID)),
attrs);
attrs = Fcons (Fcons (Qpri, make_fixnum (pe.pcPriClassBase)),
attrs);
attrs = Fcons (Fcons (Qthcount,
- make_fixnum_or_float (pe.cntThreads)),
+ INT_TO_INTEGER (pe.cntThreads)),
attrs);
found_proc = 1;
break;
@@ -7225,12 +7214,12 @@ system_process_attributes (Lisp_Object pid)
CloseHandle (token);
}
- attrs = Fcons (Fcons (Qeuid, make_fixnum_or_float (euid)), attrs);
+ attrs = Fcons (Fcons (Qeuid, INT_TO_INTEGER (euid)), attrs);
tem = make_unibyte_string (uname, ulength);
attrs = Fcons (Fcons (Quser,
code_convert_string_norecord (tem,
Vlocale_coding_system, 0)),
attrs);
- attrs = Fcons (Fcons (Qegid, make_fixnum_or_float (egid)), attrs);
+ attrs = Fcons (Fcons (Qegid, INT_TO_INTEGER (egid)), attrs);
tem = make_unibyte_string (gname, glength);
attrs = Fcons (Fcons (Qgroup,
code_convert_string_norecord (tem,
Vlocale_coding_system, 0)),
@@ -7260,12 +7249,12 @@ system_process_attributes (Lisp_Object pid)
SIZE_T rss = mem_ex.WorkingSetSize / 1024;
attrs = Fcons (Fcons (Qmajflt,
- make_fixnum_or_float (mem_ex.PageFaultCount)),
+ INT_TO_INTEGER (mem_ex.PageFaultCount)),
attrs);
attrs = Fcons (Fcons (Qvsize,
- make_fixnum_or_float (mem_ex.PrivateUsage / 1024)),
+ INT_TO_INTEGER (mem_ex.PrivateUsage / 1024)),
attrs);
- attrs = Fcons (Fcons (Qrss, make_fixnum_or_float (rss)), attrs);
+ attrs = Fcons (Fcons (Qrss, INT_TO_INTEGER (rss)), attrs);
if (totphys)
attrs = Fcons (Fcons (Qpmem, make_float (100. * rss / totphys)), attrs);
}
@@ -7275,9 +7264,9 @@ system_process_attributes (Lisp_Object pid)
SIZE_T rss = mem_ex.WorkingSetSize / 1024;
attrs = Fcons (Fcons (Qmajflt,
- make_fixnum_or_float (mem.PageFaultCount)),
+ INT_TO_INTEGER (mem.PageFaultCount)),
attrs);
- attrs = Fcons (Fcons (Qrss, make_fixnum_or_float (rss)), attrs);
+ attrs = Fcons (Fcons (Qrss, INT_TO_INTEGER (rss)), attrs);
if (totphys)
attrs = Fcons (Fcons (Qpmem, make_float (100. * rss / totphys)), attrs);
}
@@ -7286,7 +7275,7 @@ system_process_attributes (Lisp_Object pid)
{
DWORD rss = maxrss / 1024;
- attrs = Fcons (Fcons (Qrss, make_fixnum_or_float (maxrss / 1024)),
attrs);
+ attrs = Fcons (Fcons (Qrss, INT_TO_INTEGER (maxrss / 1024)), attrs);
if (totphys)
attrs = Fcons (Fcons (Qpmem, make_float (100. * rss / totphys)), attrs);
}
@@ -7428,8 +7417,8 @@ init_winsock (int load_now)
return TRUE;
pfn_SetHandleInformation
- = (void *) GetProcAddress (GetModuleHandle ("kernel32.dll"),
- "SetHandleInformation");
+ = (void *) get_proc_addr (GetModuleHandle ("kernel32.dll"),
+ "SetHandleInformation");
winsock_lib = LoadLibrary ("Ws2_32.dll");
@@ -7438,7 +7427,7 @@ init_winsock (int load_now)
/* dynamically link to socket functions */
#define LOAD_PROC(fn) \
- if ((pfn_##fn = (void *) GetProcAddress (winsock_lib, #fn)) == NULL) \
+ if ((pfn_##fn = (void *) get_proc_addr (winsock_lib, #fn)) == NULL) \
goto fail;
LOAD_PROC (WSAStartup);
@@ -7473,8 +7462,8 @@ init_winsock (int load_now)
#undef LOAD_PROC
/* Try loading functions not available before XP. */
- pfn_getaddrinfo = (void *) GetProcAddress (winsock_lib, "getaddrinfo");
- pfn_freeaddrinfo = (void *) GetProcAddress (winsock_lib, "freeaddrinfo");
+ pfn_getaddrinfo = (void *) get_proc_addr (winsock_lib, "getaddrinfo");
+ pfn_freeaddrinfo = (void *) get_proc_addr (winsock_lib, "freeaddrinfo");
/* Paranoia: these two functions should go together, so if one
is absent, we cannot use the other. */
if (pfn_getaddrinfo == NULL)
@@ -9444,10 +9433,10 @@ w32_read_registry (HKEY rootkey, Lisp_Object lkey,
Lisp_Object lname)
retval = Qt;
break;
case REG_DWORD:
- retval = INTEGER_TO_CONS (*((DWORD *)pvalue));
+ retval = INT_TO_INTEGER (*((DWORD *)pvalue));
break;
case REG_QWORD:
- retval = INTEGER_TO_CONS (*((long long *)pvalue));
+ retval = INT_TO_INTEGER (*((long long *)pvalue));
break;
case REG_BINARY:
{
@@ -9892,10 +9881,10 @@ maybe_load_unicows_dll (void)
pointers, and assign the correct addresses to these
pointers at program startup (see emacs.c, which calls
this function early on). */
- pMultiByteToWideChar =
- (MultiByteToWideChar_Proc)GetProcAddress (ret,
"MultiByteToWideChar");
- pWideCharToMultiByte =
- (WideCharToMultiByte_Proc)GetProcAddress (ret,
"WideCharToMultiByte");
+ pMultiByteToWideChar = (MultiByteToWideChar_Proc)
+ get_proc_addr (ret, "MultiByteToWideChar");
+ pWideCharToMultiByte = (WideCharToMultiByte_Proc)
+ get_proc_addr (ret, "WideCharToMultiByte");
multiByteToWideCharFlags = MB_ERR_INVALID_CHARS;
return ret;
}
@@ -9946,7 +9935,7 @@ globals_of_w32 (void)
HMODULE kernel32 = GetModuleHandle ("kernel32.dll");
get_process_times_fn = (GetProcessTimes_Proc)
- GetProcAddress (kernel32, "GetProcessTimes");
+ get_proc_addr (kernel32, "GetProcessTimes");
DEFSYM (QCloaded_from, ":loaded-from");
diff --git a/src/w32.h b/src/w32.h
index fe8689a..9c219cd 100644
--- a/src/w32.h
+++ b/src/w32.h
@@ -241,17 +241,4 @@ extern ssize_t emacs_gnutls_push (gnutls_transport_ptr_t p,
const void* buf, size_t sz);
#endif /* HAVE_GNUTLS */
-/* Definine a function that will be loaded from a DLL. */
-#define DEF_DLL_FN(type, func, args) static type (FAR CDECL *fn_##func) args
-
-/* Load a function from the DLL. */
-#define LOAD_DLL_FN(lib, func) \
- do \
- { \
- fn_##func = (void *) GetProcAddress (lib, #func);
\
- if (!fn_##func) \
- return false; \
- } \
- while (false)
-
#endif /* EMACS_W32_H */
diff --git a/src/w32common.h b/src/w32common.h
index af548dd..4981bdf 100644
--- a/src/w32common.h
+++ b/src/w32common.h
@@ -50,4 +50,34 @@ extern int os_subtype;
/* Cache system info, e.g., the NT page size. */
extern void cache_system_info (void);
+typedef void (* VOIDFNPTR) (void);
+
+/* Load a function address from a DLL. Cast the result via VOIDFNPTR
+ to pacify -Wcast-function-type in GCC 8.1. The return value must
+ be cast to the correct function pointer type. */
+INLINE VOIDFNPTR
+get_proc_addr (HINSTANCE handle, LPCSTR fname)
+{
+ return (VOIDFNPTR) GetProcAddress (handle, fname);
+}
+
+/* Define a function that will be loaded from a DLL. The variable
+ arguments should contain the argument list for the function, and
+ optionally be followed by function attributes. For example:
+ DEF_DLL_FN (void, png_longjmp, (png_structp, int) PNG_NORETURN);
+ */
+#define DEF_DLL_FN(type, func, ...) \
+ typedef type (CDECL *W32_PFN_##func) __VA_ARGS__; \
+ static W32_PFN_##func fn_##func
+
+/* Load a function from the DLL. */
+#define LOAD_DLL_FN(lib, func) \
+ do \
+ { \
+ fn_##func = (W32_PFN_##func) get_proc_addr (lib, #func); \
+ if (!fn_##func) \
+ return false; \
+ } \
+ while (false)
+
#endif /* W32COMMON_H */
diff --git a/src/w32console.c b/src/w32console.c
index 6c3cf06..9f9db68 100644
--- a/src/w32console.c
+++ b/src/w32console.c
@@ -140,23 +140,36 @@ w32con_clear_frame (struct frame *f)
}
-static struct glyph glyph_base[256];
+static struct glyph glyph_base[80];
+static struct glyph *glyphs = glyph_base;
+static size_t glyphs_len = ARRAYELTS (glyph_base);
static BOOL ceol_initialized = FALSE;
/* Clear from Cursor to end (what's "standout marker"?). */
static void
w32con_clear_end_of_line (struct frame *f, int end)
{
+ /* Time to reallocate our "empty row"? With today's large screens,
+ it is not unthinkable to see TTY frames well in excess of
+ 80-character width. */
+ if (end - cursor_coords.X > glyphs_len)
+ {
+ if (glyphs == glyph_base)
+ glyphs = NULL;
+ glyphs = xrealloc (glyphs, FRAME_COLS (f) * sizeof (struct glyph));
+ glyphs_len = FRAME_COLS (f);
+ ceol_initialized = FALSE;
+ }
if (!ceol_initialized)
{
int i;
- for (i = 0; i < 256; i++)
+ for (i = 0; i < glyphs_len; i++)
{
- memcpy (&glyph_base[i], &space_glyph, sizeof (struct glyph));
+ memcpy (&glyphs[i], &space_glyph, sizeof (struct glyph));
}
ceol_initialized = TRUE;
}
- w32con_write_glyphs (f, glyph_base, end - cursor_coords.X); /* fencepost ?
*/
+ w32con_write_glyphs (f, glyphs, end - cursor_coords.X);
}
/* Insert n lines at vpos. if n is negative delete -n lines. */
@@ -772,6 +785,15 @@ initialize_w32_display (struct terminal *term, int *width,
int *height)
*width = 1 + info.srWindow.Right - info.srWindow.Left;
}
+ /* Force reinitialization of the "empty row" buffer, in case they
+ dumped from a running session. */
+ if (glyphs != glyph_base)
+ {
+ glyphs = NULL;
+ glyphs_len = 0;
+ ceol_initialized = FALSE;
+ }
+
if (os_subtype == OS_NT)
w32_console_unicode_input = 1;
else
diff --git a/src/w32fns.c b/src/w32fns.c
index 8d5293c..153cba9 100644
--- a/src/w32fns.c
+++ b/src/w32fns.c
@@ -2027,7 +2027,7 @@ x_set_undecorated (struct frame *f, Lisp_Object
new_value, Lisp_Object old_value
if (!NILP (new_value) && !FRAME_UNDECORATED (f))
{
dwStyle = ((dwStyle & ~WS_THICKFRAME & ~WS_CAPTION)
- | ((FIXED_OR_FLOATP (border_width) && (XFIXNUM (border_width)
> 0))
+ | ((FIXNUMP (border_width) && (XFIXNUM (border_width) > 0))
? WS_BORDER : false));
SetWindowLong (hwnd, GWL_STYLE, dwStyle);
SetWindowPos (hwnd, HWND_TOP, 0, 0, 0, 0,
@@ -2334,7 +2334,7 @@ w32_createwindow (struct frame *f, int *coords)
if (FRAME_UNDECORATED (f))
{
/* If we want a thin border, specify it here. */
- if (FIXED_OR_FLOATP (border_width) && (XFIXNUM (border_width) > 0))
+ if (FIXNUMP (border_width) && (XFIXNUM (border_width) > 0))
f->output_data.w32->dwStyle |= WS_BORDER;
}
else
@@ -2350,7 +2350,7 @@ w32_createwindow (struct frame *f, int *coords)
f->output_data.w32->dwStyle = WS_POPUP;
/* If we want a thin border, specify it here. */
- if (FIXED_OR_FLOATP (border_width) && (XFIXNUM (border_width) > 0))
+ if (FIXNUMP (border_width) && (XFIXNUM (border_width) > 0))
f->output_data.w32->dwStyle |= WS_BORDER;
}
else
@@ -2640,7 +2640,7 @@ setup_w32_kbdhook (void)
if (w32_kbdhook_active)
{
IsDebuggerPresent_Proc is_debugger_present = (IsDebuggerPresent_Proc)
- GetProcAddress (GetModuleHandle ("kernel32.dll"), "IsDebuggerPresent");
+ get_proc_addr (GetModuleHandle ("kernel32.dll"), "IsDebuggerPresent");
if (is_debugger_present && is_debugger_present ())
return;
}
@@ -2655,7 +2655,7 @@ setup_w32_kbdhook (void)
(https://support.microsoft.com/en-us/kb/124103) is used for
NT 4 systems. */
GetConsoleWindow_Proc get_console = (GetConsoleWindow_Proc)
- GetProcAddress (GetModuleHandle ("kernel32.dll"), "GetConsoleWindow");
+ get_proc_addr (GetModuleHandle ("kernel32.dll"), "GetConsoleWindow");
if (get_console != NULL)
kbdhook.console = get_console ();
@@ -4199,7 +4199,7 @@ w32_wnd_proc (HWND hwnd, UINT msg, WPARAM wParam, LPARAM
lParam)
press of Space which we will ignore. */
if (GetAsyncKeyState (wParam) & 1)
{
- if (FIXED_OR_FLOATP (Vw32_phantom_key_code))
+ if (FIXNUMP (Vw32_phantom_key_code))
key = XUFIXNUM (Vw32_phantom_key_code) & 255;
else
key = VK_SPACE;
@@ -4215,7 +4215,7 @@ w32_wnd_proc (HWND hwnd, UINT msg, WPARAM wParam, LPARAM
lParam)
{
if (GetAsyncKeyState (wParam) & 1)
{
- if (FIXED_OR_FLOATP (Vw32_phantom_key_code))
+ if (FIXNUMP (Vw32_phantom_key_code))
key = XUFIXNUM (Vw32_phantom_key_code) & 255;
else
key = VK_SPACE;
@@ -5921,11 +5921,11 @@ DEFUN ("x-create-frame", Fx_create_frame,
Sx_create_frame,
because `frame-windows-min-size' needs them. */
tem = x_get_arg (dpyinfo, parameters, Qmin_width, NULL, NULL,
RES_TYPE_NUMBER);
- if (FIXED_OR_FLOATP (tem))
+ if (FIXNUMP (tem))
store_frame_param (f, Qmin_width, tem);
tem = x_get_arg (dpyinfo, parameters, Qmin_height, NULL, NULL,
RES_TYPE_NUMBER);
- if (FIXED_OR_FLOATP (tem))
+ if (FIXNUMP (tem))
store_frame_param (f, Qmin_height, tem);
adjust_frame_size (f, FRAME_COLS (f) * FRAME_COLUMN_WIDTH (f),
FRAME_LINES (f) * FRAME_LINE_HEIGHT (f), 5, true,
@@ -7430,7 +7430,7 @@ DEFUN ("x-show-tip", Fx_show_tip, Sx_show_tip, 1, 6, 0,
/* Show tooltip frame. */
{
RECT rect;
- int pad = (FIXED_OR_FLOATP (Vw32_tooltip_extra_pixels)
+ int pad = (FIXNUMP (Vw32_tooltip_extra_pixels)
? max (0, XFIXNUM (Vw32_tooltip_extra_pixels))
: FRAME_COLUMN_WIDTH (tip_f));
@@ -9117,9 +9117,9 @@ DEFUN ("file-system-info", Ffile_system_info,
Sfile_system_info, 1, 1, 0,
{
HMODULE hKernel = GetModuleHandle ("kernel32");
GetDiskFreeSpaceExW_Proc pfn_GetDiskFreeSpaceExW =
- (GetDiskFreeSpaceExW_Proc) GetProcAddress (hKernel,
"GetDiskFreeSpaceExW");
+ (GetDiskFreeSpaceExW_Proc) get_proc_addr (hKernel,
"GetDiskFreeSpaceExW");
GetDiskFreeSpaceExA_Proc pfn_GetDiskFreeSpaceExA =
- (GetDiskFreeSpaceExA_Proc) GetProcAddress (hKernel,
"GetDiskFreeSpaceExA");
+ (GetDiskFreeSpaceExA_Proc) get_proc_addr (hKernel,
"GetDiskFreeSpaceExA");
bool have_pfn_GetDiskFreeSpaceEx =
((w32_unicode_filenames && pfn_GetDiskFreeSpaceExW)
|| (!w32_unicode_filenames && pfn_GetDiskFreeSpaceExA));
@@ -9431,7 +9431,7 @@ w32_console_toggle_lock_key (int vk_code, Lisp_Object
new_state)
int cur_state = (GetKeyState (vk_code) & 1);
if (NILP (new_state)
- || (FIXED_OR_FLOATP (new_state)
+ || (FIXNUMP (new_state)
&& ((XUFIXNUM (new_state)) & 1) != cur_state))
{
#ifdef WINDOWSNT
@@ -9694,8 +9694,8 @@ get_dll_version (const char *dll_name)
if (hdll)
{
- DLLGETVERSIONPROC pDllGetVersion
- = (DLLGETVERSIONPROC) GetProcAddress (hdll, "DllGetVersion");
+ DLLGETVERSIONPROC pDllGetVersion = (DLLGETVERSIONPROC)
+ get_proc_addr (hdll, "DllGetVersion");
if (pDllGetVersion)
{
@@ -10125,7 +10125,7 @@ to be converted to forward slashes by the caller. */)
CHECK_STRING (key);
CHECK_STRING (name);
- HKEY rootkey;
+ HKEY rootkey = HKEY_CURRENT_USER;
if (EQ (root, QHKCR))
rootkey = HKEY_CLASSES_ROOT;
else if (EQ (root, QHKCU))
@@ -10139,10 +10139,7 @@ to be converted to forward slashes by the caller. */)
else if (!NILP (root))
error ("unknown root key: %s", SDATA (SYMBOL_NAME (root)));
- Lisp_Object val = w32_read_registry (NILP (root)
- ? HKEY_CURRENT_USER
- : rootkey,
- key, name);
+ Lisp_Object val = w32_read_registry (rootkey, key, name);
if (NILP (val) && NILP (root))
val = w32_read_registry (HKEY_LOCAL_MACHINE, key, name);
@@ -10662,9 +10659,8 @@ void
w32_reset_stack_overflow_guard (void)
{
if (resetstkoflw == NULL)
- resetstkoflw =
- (_resetstkoflw_proc)GetProcAddress (GetModuleHandle ("msvcrt.dll"),
- "_resetstkoflw");
+ resetstkoflw = (_resetstkoflw_proc)
+ get_proc_addr (GetModuleHandle ("msvcrt.dll"), "_resetstkoflw");
/* We ignore the return value. If _resetstkoflw fails, the next
stack overflow will crash the program. */
if (resetstkoflw != NULL)
@@ -10738,9 +10734,8 @@ w32_backtrace (void **buffer, int limit)
if (!s_pfn_CaptureStackBackTrace)
{
hm_kernel32 = LoadLibrary ("Kernel32.dll");
- s_pfn_CaptureStackBackTrace =
- (CaptureStackBackTrace_proc) GetProcAddress (hm_kernel32,
-
"RtlCaptureStackBackTrace");
+ s_pfn_CaptureStackBackTrace = (CaptureStackBackTrace_proc)
+ get_proc_addr (hm_kernel32, "RtlCaptureStackBackTrace");
}
if (s_pfn_CaptureStackBackTrace)
return s_pfn_CaptureStackBackTrace (0, min (BACKTRACE_LIMIT_MAX, limit),
@@ -10873,29 +10868,29 @@ globals_of_w32fns (void)
it dynamically. Do it once, here, instead of every time it is used.
*/
track_mouse_event_fn = (TrackMouseEvent_Proc)
- GetProcAddress (user32_lib, "TrackMouseEvent");
+ get_proc_addr (user32_lib, "TrackMouseEvent");
monitor_from_point_fn = (MonitorFromPoint_Proc)
- GetProcAddress (user32_lib, "MonitorFromPoint");
+ get_proc_addr (user32_lib, "MonitorFromPoint");
get_monitor_info_fn = (GetMonitorInfo_Proc)
- GetProcAddress (user32_lib, "GetMonitorInfoA");
+ get_proc_addr (user32_lib, "GetMonitorInfoA");
monitor_from_window_fn = (MonitorFromWindow_Proc)
- GetProcAddress (user32_lib, "MonitorFromWindow");
+ get_proc_addr (user32_lib, "MonitorFromWindow");
enum_display_monitors_fn = (EnumDisplayMonitors_Proc)
- GetProcAddress (user32_lib, "EnumDisplayMonitors");
+ get_proc_addr (user32_lib, "EnumDisplayMonitors");
get_title_bar_info_fn = (GetTitleBarInfo_Proc)
- GetProcAddress (user32_lib, "GetTitleBarInfo");
+ get_proc_addr (user32_lib, "GetTitleBarInfo");
{
HMODULE imm32_lib = GetModuleHandle ("imm32.dll");
get_composition_string_fn = (ImmGetCompositionString_Proc)
- GetProcAddress (imm32_lib, "ImmGetCompositionStringW");
+ get_proc_addr (imm32_lib, "ImmGetCompositionStringW");
get_ime_context_fn = (ImmGetContext_Proc)
- GetProcAddress (imm32_lib, "ImmGetContext");
+ get_proc_addr (imm32_lib, "ImmGetContext");
release_ime_context_fn = (ImmReleaseContext_Proc)
- GetProcAddress (imm32_lib, "ImmReleaseContext");
+ get_proc_addr (imm32_lib, "ImmReleaseContext");
set_ime_composition_window_fn = (ImmSetCompositionWindow_Proc)
- GetProcAddress (imm32_lib, "ImmSetCompositionWindow");
+ get_proc_addr (imm32_lib, "ImmSetCompositionWindow");
}
except_code = 0;
diff --git a/src/w32font.c b/src/w32font.c
index c2f5dc3..798869b 100644
--- a/src/w32font.c
+++ b/src/w32font.c
@@ -29,6 +29,7 @@ along with GNU Emacs. If not, see
<https://www.gnu.org/licenses/>. */
#include "coding.h" /* for ENCODE_SYSTEM, DECODE_SYSTEM */
#include "w32font.h"
#ifdef WINDOWSNT
+#include "w32common.h"
#include "w32.h"
#endif
@@ -153,7 +154,7 @@ get_outline_metrics_w(HDC hdc, UINT cbData,
LPOUTLINETEXTMETRICW lpotmw)
hm_unicows = w32_load_unicows_or_gdi32 ();
if (hm_unicows)
s_pfn_Get_Outline_Text_MetricsW = (GetOutlineTextMetricsW_Proc)
- GetProcAddress (hm_unicows, "GetOutlineTextMetricsW");
+ get_proc_addr (hm_unicows, "GetOutlineTextMetricsW");
}
eassert (s_pfn_Get_Outline_Text_MetricsW != NULL);
return s_pfn_Get_Outline_Text_MetricsW (hdc, cbData, lpotmw);
@@ -170,7 +171,7 @@ get_text_metrics_w(HDC hdc, LPTEXTMETRICW lptmw)
hm_unicows = w32_load_unicows_or_gdi32 ();
if (hm_unicows)
s_pfn_Get_Text_MetricsW = (GetTextMetricsW_Proc)
- GetProcAddress (hm_unicows, "GetTextMetricsW");
+ get_proc_addr (hm_unicows, "GetTextMetricsW");
}
eassert (s_pfn_Get_Text_MetricsW != NULL);
return s_pfn_Get_Text_MetricsW (hdc, lptmw);
@@ -188,7 +189,7 @@ get_glyph_outline_w (HDC hdc, UINT uChar, UINT uFormat,
LPGLYPHMETRICS lpgm,
hm_unicows = w32_load_unicows_or_gdi32 ();
if (hm_unicows)
s_pfn_Get_Glyph_OutlineW = (GetGlyphOutlineW_Proc)
- GetProcAddress (hm_unicows, "GetGlyphOutlineW");
+ get_proc_addr (hm_unicows, "GetGlyphOutlineW");
}
eassert (s_pfn_Get_Glyph_OutlineW != NULL);
return s_pfn_Get_Glyph_OutlineW (hdc, uChar, uFormat, lpgm, cbBuffer,
@@ -206,7 +207,7 @@ get_char_width_32_w (HDC hdc, UINT uFirstChar, UINT
uLastChar, LPINT lpBuffer)
hm_unicows = w32_load_unicows_or_gdi32 ();
if (hm_unicows)
s_pfn_Get_Char_Width_32W = (GetCharWidth32W_Proc)
- GetProcAddress (hm_unicows, "GetCharWidth32W");
+ get_proc_addr (hm_unicows, "GetCharWidth32W");
}
eassert (s_pfn_Get_Char_Width_32W != NULL);
return s_pfn_Get_Char_Width_32W (hdc, uFirstChar, uLastChar, lpBuffer);
diff --git a/src/w32heap.c b/src/w32heap.c
index df79f8c..8c94682 100644
--- a/src/w32heap.c
+++ b/src/w32heap.c
@@ -250,7 +250,9 @@ init_heap (void)
#ifndef MINGW_W64
/* Set the low-fragmentation heap for OS before Vista. */
HMODULE hm_kernel32dll = LoadLibrary ("kernel32.dll");
- HeapSetInformation_Proc s_pfn_Heap_Set_Information =
(HeapSetInformation_Proc) GetProcAddress (hm_kernel32dll, "HeapSetInformation");
+ HeapSetInformation_Proc s_pfn_Heap_Set_Information =
+ (HeapSetInformation_Proc) get_proc_addr (hm_kernel32dll,
+ "HeapSetInformation");
if (s_pfn_Heap_Set_Information != NULL)
{
if (s_pfn_Heap_Set_Information ((PVOID) heap,
@@ -281,7 +283,7 @@ init_heap (void)
in ntdll.dll since XP. */
HMODULE hm_ntdll = LoadLibrary ("ntdll.dll");
RtlCreateHeap_Proc s_pfn_Rtl_Create_Heap
- = (RtlCreateHeap_Proc) GetProcAddress (hm_ntdll, "RtlCreateHeap");
+ = (RtlCreateHeap_Proc) get_proc_addr (hm_ntdll, "RtlCreateHeap");
/* Specific parameters for the private heap. */
RTL_HEAP_PARAMETERS params;
ZeroMemory (¶ms, sizeof(params));
diff --git a/src/w32inevt.c b/src/w32inevt.c
index e8494c8..f5558bb 100644
--- a/src/w32inevt.c
+++ b/src/w32inevt.c
@@ -181,7 +181,7 @@ key_event (KEY_EVENT_RECORD *event, struct input_event
*emacs_ev, int *isdead)
Space which we will ignore. */
if ((mod_key_state & LEFT_WIN_PRESSED) == 0)
{
- if (FIXED_OR_FLOATP (Vw32_phantom_key_code))
+ if (FIXNUMP (Vw32_phantom_key_code))
faked_key = XUFIXNUM (Vw32_phantom_key_code) & 255;
else
faked_key = VK_SPACE;
@@ -198,7 +198,7 @@ key_event (KEY_EVENT_RECORD *event, struct input_event
*emacs_ev, int *isdead)
{
if ((mod_key_state & RIGHT_WIN_PRESSED) == 0)
{
- if (FIXED_OR_FLOATP (Vw32_phantom_key_code))
+ if (FIXNUMP (Vw32_phantom_key_code))
faked_key = XUFIXNUM (Vw32_phantom_key_code) & 255;
else
faked_key = VK_SPACE;
diff --git a/src/w32menu.c b/src/w32menu.c
index ece5836..a2d39c5 100644
--- a/src/w32menu.c
+++ b/src/w32menu.c
@@ -1607,9 +1607,13 @@ globals_of_w32menu (void)
#ifndef NTGUI_UNICODE
/* See if Get/SetMenuItemInfo functions are available. */
HMODULE user32 = GetModuleHandle ("user32.dll");
- get_menu_item_info = (GetMenuItemInfoA_Proc) GetProcAddress (user32,
"GetMenuItemInfoA");
- set_menu_item_info = (SetMenuItemInfoA_Proc) GetProcAddress (user32,
"SetMenuItemInfoA");
- unicode_append_menu = (AppendMenuW_Proc) GetProcAddress (user32,
"AppendMenuW");
- unicode_message_box = (MessageBoxW_Proc) GetProcAddress (user32,
"MessageBoxW");
+ get_menu_item_info = (GetMenuItemInfoA_Proc)
+ get_proc_addr (user32, "GetMenuItemInfoA");
+ set_menu_item_info = (SetMenuItemInfoA_Proc)
+ get_proc_addr (user32, "SetMenuItemInfoA");
+ unicode_append_menu = (AppendMenuW_Proc)
+ get_proc_addr (user32, "AppendMenuW");
+ unicode_message_box = (MessageBoxW_Proc)
+ get_proc_addr (user32, "MessageBoxW");
#endif /* !NTGUI_UNICODE */
}
diff --git a/src/w32proc.c b/src/w32proc.c
index 61ce157..cb02ba6 100644
--- a/src/w32proc.c
+++ b/src/w32proc.c
@@ -548,9 +548,8 @@ init_timers (void)
through a pointer. */
s_pfn_Get_Thread_Times = NULL; /* in case dumped Emacs comes with a value */
if (os_subtype != OS_9X)
- s_pfn_Get_Thread_Times =
- (GetThreadTimes_Proc)GetProcAddress (GetModuleHandle ("kernel32.dll"),
- "GetThreadTimes");
+ s_pfn_Get_Thread_Times = (GetThreadTimes_Proc)
+ get_proc_addr (GetModuleHandle ("kernel32.dll"), "GetThreadTimes");
/* Make sure we start with zeroed out itimer structures, since
dumping may have left there traces of threads long dead. */
@@ -2691,8 +2690,8 @@ sys_kill (pid_t pid, int sig)
{
g_b_init_debug_break_process = 1;
s_pfn_Debug_Break_Process = (DebugBreakProcess_Proc)
- GetProcAddress (GetModuleHandle ("kernel32.dll"),
- "DebugBreakProcess");
+ get_proc_addr (GetModuleHandle ("kernel32.dll"),
+ "DebugBreakProcess");
}
if (s_pfn_Debug_Break_Process == NULL)
@@ -3207,7 +3206,7 @@ If LCID (a 16-bit number) is not a valid locale, the
result is nil. */)
if (got_full)
return DECODE_SYSTEM (build_string (full_name));
}
- else if (FIXED_OR_FLOATP (longform))
+ else if (FIXNUMP (longform))
{
got_full = GetLocaleInfo (XFIXNUM (lcid),
XFIXNUM (longform),
@@ -3608,9 +3607,9 @@ w32_compare_strings (const char *s1, const char *s2, char
*locname,
{
if (os_subtype == OS_9X)
{
- pCompareStringW =
- (CompareStringW_Proc) GetProcAddress (LoadLibrary ("Unicows.dll"),
- "CompareStringW");
+ pCompareStringW = (CompareStringW_Proc)
+ get_proc_addr (LoadLibrary ("Unicows.dll"),
+ "CompareStringW");
if (!pCompareStringW)
{
errno = EINVAL;
diff --git a/src/w32uniscribe.c b/src/w32uniscribe.c
index 11bfa54..29c9c7a 100644
--- a/src/w32uniscribe.c
+++ b/src/w32uniscribe.c
@@ -36,6 +36,7 @@ along with GNU Emacs. If not, see
<https://www.gnu.org/licenses/>. */
#include "composite.h"
#include "font.h"
#include "w32font.h"
+#include "w32common.h"
struct uniscribe_font_info
{
@@ -1194,11 +1195,11 @@ syms_of_w32uniscribe (void)
register_font_driver (&uniscribe_font_driver, NULL);
script_get_font_scripts_fn = (ScriptGetFontScriptTags_Proc)
- GetProcAddress (uniscribe, "ScriptGetFontScriptTags");
+ get_proc_addr (uniscribe, "ScriptGetFontScriptTags");
script_get_font_languages_fn = (ScriptGetFontLanguageTags_Proc)
- GetProcAddress (uniscribe, "ScriptGetFontLanguageTags");
+ get_proc_addr (uniscribe, "ScriptGetFontLanguageTags");
script_get_font_features_fn = (ScriptGetFontFeatureTags_Proc)
- GetProcAddress (uniscribe, "ScriptGetFontFeatureTags");
+ get_proc_addr (uniscribe, "ScriptGetFontFeatureTags");
if (script_get_font_scripts_fn
&& script_get_font_languages_fn
&& script_get_font_features_fn)
diff --git a/src/window.c b/src/window.c
index 67cfdc1..d4fc556 100644
--- a/src/window.c
+++ b/src/window.c
@@ -1383,8 +1383,8 @@ If they are in the windows's left or right marginal
areas, `left-margin'\n\
CHECK_CONS (coordinates);
lx = Fcar (coordinates);
ly = Fcdr (coordinates);
- CHECK_FIXNUM_OR_FLOAT (lx);
- CHECK_FIXNUM_OR_FLOAT (ly);
+ CHECK_NUMBER (lx);
+ CHECK_NUMBER (ly);
x = FRAME_PIXEL_X_FROM_CANON_X (f, lx) + FRAME_INTERNAL_BORDER_WIDTH (f);
y = FRAME_PIXEL_Y_FROM_CANON_Y (f, ly) + FRAME_INTERNAL_BORDER_WIDTH (f);
@@ -1533,9 +1533,8 @@ column 0. */)
{
struct frame *f = decode_live_frame (frame);
- /* Check that arguments are integers or floats. */
- CHECK_FIXNUM_OR_FLOAT (x);
- CHECK_FIXNUM_OR_FLOAT (y);
+ CHECK_NUMBER (x);
+ CHECK_NUMBER (y);
return window_from_coordinates (f,
(FRAME_PIXEL_X_FROM_CANON_X (f, x)
@@ -1972,7 +1971,7 @@ though when run from an idle timer with a delay of zero
seconds. */)
row = (NILP (body)
? MATRIX_ROW (w->current_matrix, 0)
: MATRIX_FIRST_TEXT_ROW (w->current_matrix));
- else if (FIXED_OR_FLOATP (first))
+ else if (FIXNUMP (first))
{
CHECK_RANGED_INTEGER (first, 0, w->current_matrix->nrows);
row = MATRIX_ROW (w->current_matrix, XFIXNUM (first));
@@ -1985,7 +1984,7 @@ though when run from an idle timer with a delay of zero
seconds. */)
end_row = (NILP (body)
? MATRIX_ROW (w->current_matrix, w->current_matrix->nrows)
: MATRIX_BOTTOM_TEXT_ROW (w->current_matrix, w));
- else if (FIXED_OR_FLOATP (last))
+ else if (FIXNUMP (last))
{
CHECK_RANGED_INTEGER (last, 0, w->current_matrix->nrows);
end_row = MATRIX_ROW (w->current_matrix, XFIXNUM (last));
@@ -3994,7 +3993,7 @@ window_resize_apply (struct window *w, bool horflag)
{
w->pixel_width = XFIXNAT (w->new_pixel);
w->total_cols = w->pixel_width / unit;
- if (FIXED_OR_FLOATP (w->new_normal))
+ if (NUMBERP (w->new_normal))
wset_normal_cols (w, w->new_normal);
edge = w->pixel_left;
@@ -4003,7 +4002,7 @@ window_resize_apply (struct window *w, bool horflag)
{
w->pixel_height = XFIXNAT (w->new_pixel);
w->total_lines = w->pixel_height / unit;
- if (FIXED_OR_FLOATP (w->new_normal))
+ if (NUMBERP (w->new_normal))
wset_normal_lines (w, w->new_normal);
edge = w->pixel_top;
@@ -7360,7 +7359,7 @@ If PIXELS-P is non-nil, the return value is VSCROLL. */)
struct window *w = decode_live_window (window);
struct frame *f = XFRAME (w->frame);
- CHECK_FIXNUM_OR_FLOAT (vscroll);
+ CHECK_NUMBER (vscroll);
if (FRAME_WINDOW_P (f))
{
diff --git a/src/xdisp.c b/src/xdisp.c
index 0835cca..11b14e2 100644
--- a/src/xdisp.c
+++ b/src/xdisp.c
@@ -4978,10 +4978,10 @@ handle_single_display_spec (struct it *it, Lisp_Object
spec, Lisp_Object object,
Lisp_Object height;
height = safe_call1 (it->font_height,
face->lface[LFACE_HEIGHT_INDEX]);
- if (FIXED_OR_FLOATP (height))
+ if (NUMBERP (height))
new_height = XFLOATINT (height);
}
- else if (FIXED_OR_FLOATP (it->font_height))
+ else if (NUMBERP (it->font_height))
{
/* Value is a multiple of the canonical char height. */
struct face *f;
@@ -5002,7 +5002,7 @@ handle_single_display_spec (struct it *it, Lisp_Object
spec, Lisp_Object object,
value = safe_eval (it->font_height);
value = unbind_to (count, value);
- if (FIXED_OR_FLOATP (value))
+ if (NUMBERP (value))
new_height = XFLOATINT (value);
}
@@ -5025,7 +5025,7 @@ handle_single_display_spec (struct it *it, Lisp_Object
spec, Lisp_Object object,
return 0;
value = XCAR (XCDR (spec));
- if (FIXED_OR_FLOATP (value) && XFLOATINT (value) > 0)
+ if (NUMBERP (value) && XFLOATINT (value) > 0)
it->space_width = value;
}
@@ -5074,7 +5074,7 @@ handle_single_display_spec (struct it *it, Lisp_Object
spec, Lisp_Object object,
#ifdef HAVE_WINDOW_SYSTEM
value = XCAR (XCDR (spec));
- if (FIXED_OR_FLOATP (value))
+ if (NUMBERP (value))
{
struct face *face = FACE_FROM_ID (it->f, it->face_id);
it->voffset = - (XFLOATINT (value)
@@ -15729,8 +15729,8 @@ try_scrolling (Lisp_Object window, bool just_this_one_p,
scroll_max = (max (scroll_step,
max (arg_scroll_conservatively, temp_scroll_step))
* frame_line_height);
- else if (FIXED_OR_FLOATP (BVAR (current_buffer, scroll_down_aggressively))
- || FIXED_OR_FLOATP (BVAR (current_buffer, scroll_up_aggressively)))
+ else if (NUMBERP (BVAR (current_buffer, scroll_down_aggressively))
+ || NUMBERP (BVAR (current_buffer, scroll_up_aggressively)))
/* We're trying to scroll because of aggressive scrolling but no
scroll_step is set. Choose an arbitrary one. */
scroll_max = 10 * frame_line_height;
@@ -15830,7 +15830,7 @@ try_scrolling (Lisp_Object window, bool just_this_one_p,
{
aggressive = BVAR (current_buffer, scroll_up_aggressively);
height = WINDOW_BOX_TEXT_HEIGHT (w);
- if (FIXED_OR_FLOATP (aggressive))
+ if (NUMBERP (aggressive))
{
double float_amount = XFLOATINT (aggressive) * height;
int aggressive_scroll = float_amount;
@@ -15946,7 +15946,7 @@ try_scrolling (Lisp_Object window, bool just_this_one_p,
{
aggressive = BVAR (current_buffer, scroll_down_aggressively);
height = WINDOW_BOX_TEXT_HEIGHT (w);
- if (FIXED_OR_FLOATP (aggressive))
+ if (NUMBERP (aggressive))
{
double float_amount = XFLOATINT (aggressive) * height;
int aggressive_scroll = float_amount;
@@ -17223,8 +17223,8 @@ redisplay_window (Lisp_Object window, bool
just_this_one_p)
if ((scroll_conservatively
|| emacs_scroll_step
|| temp_scroll_step
- || FIXED_OR_FLOATP (BVAR (current_buffer, scroll_up_aggressively))
- || FIXED_OR_FLOATP (BVAR (current_buffer, scroll_down_aggressively)))
+ || NUMBERP (BVAR (current_buffer, scroll_up_aggressively))
+ || NUMBERP (BVAR (current_buffer, scroll_down_aggressively)))
&& CHARPOS (startp) >= BEGV
&& CHARPOS (startp) <= ZV)
{
@@ -17299,13 +17299,13 @@ redisplay_window (Lisp_Object window, bool
just_this_one_p)
: BVAR (current_buffer, scroll_down_aggressively);
if (!MINI_WINDOW_P (w)
- && (scroll_conservatively > SCROLL_LIMIT || FIXED_OR_FLOATP
(aggressive)))
+ && (scroll_conservatively > SCROLL_LIMIT || NUMBERP (aggressive)))
{
int pt_offset = 0;
/* Setting scroll-conservatively overrides
scroll-*-aggressively. */
- if (!scroll_conservatively && FIXED_OR_FLOATP (aggressive))
+ if (!scroll_conservatively && NUMBERP (aggressive))
{
double float_amount = XFLOATINT (aggressive);
@@ -25520,7 +25520,7 @@ calc_pixel_width_or_height (double *res, struct it *it,
Lisp_Object prop,
prop = Qnil;
}
- if (FIXED_OR_FLOATP (prop))
+ if (NUMBERP (prop))
{
int base_unit = (width_p
? FRAME_COLUMN_WIDTH (it->f)
@@ -25584,8 +25584,8 @@ calc_pixel_width_or_height (double *res, struct it *it,
Lisp_Object prop,
}
/* '(NUM)': absolute number of pixels. */
- if (FIXED_OR_FLOATP (car))
- {
+ if (NUMBERP (car))
+{
double fact;
int offset =
width_p && align_to && *align_to < 0 ? it->lnum_pixel_width : 0;
@@ -27852,14 +27852,14 @@ calc_line_height_property (struct it *it, Lisp_Object
val, struct font *font,
Lisp_Object face_name = Qnil;
int ascent, descent, height;
- if (NILP (val) || FIXNUMP (val) || (override && EQ (val, Qt)))
+ if (NILP (val) || INTEGERP (val) || (override && EQ (val, Qt)))
return val;
if (CONSP (val))
{
face_name = XCAR (val);
val = XCDR (val);
- if (!FIXED_OR_FLOATP (val))
+ if (!NUMBERP (val))
val = make_fixnum (1);
if (NILP (face_name))
{
@@ -27903,10 +27903,13 @@ calc_line_height_property (struct it *it, Lisp_Object
val, struct font *font,
height = ascent + descent;
scale:
+ /* FIXME: Check for overflow in multiplication or conversion. */
if (FLOATP (val))
height = (int)(XFLOAT_DATA (val) * height);
else if (FIXNUMP (val))
height *= XFIXNUM (val);
+ else
+ height *= bignum_to_intmax (val);
return make_fixnum (height);
}
@@ -30770,7 +30773,7 @@ on_hot_spot_p (Lisp_Object hot_spot, int x, int y)
Lisp_Object lr, lx0, ly0;
if (CONSP (circ)
&& CONSP (XCAR (circ))
- && (lr = XCDR (circ), FIXED_OR_FLOATP (lr))
+ && (lr = XCDR (circ), NUMBERP (lr))
&& (lx0 = XCAR (XCAR (circ)), FIXNUMP (lx0))
&& (ly0 = XCDR (XCAR (circ)), FIXNUMP (ly0)))
{
diff --git a/src/xfaces.c b/src/xfaces.c
index 23822b1..50593f6 100644
--- a/src/xfaces.c
+++ b/src/xfaces.c
@@ -1659,7 +1659,7 @@ check_lface_attrs (Lisp_Object attrs[LFACE_VECTOR_SIZE])
|| SYMBOLP (attrs[LFACE_SWIDTH_INDEX]));
eassert (UNSPECIFIEDP (attrs[LFACE_HEIGHT_INDEX])
|| IGNORE_DEFFACE_P (attrs[LFACE_HEIGHT_INDEX])
- || FIXED_OR_FLOATP (attrs[LFACE_HEIGHT_INDEX])
+ || NUMBERP (attrs[LFACE_HEIGHT_INDEX])
|| FUNCTIONP (attrs[LFACE_HEIGHT_INDEX]));
eassert (UNSPECIFIEDP (attrs[LFACE_WEIGHT_INDEX])
|| IGNORE_DEFFACE_P (attrs[LFACE_WEIGHT_INDEX])
diff --git a/src/xfns.c b/src/xfns.c
index f365241..e19fcff 100644
--- a/src/xfns.c
+++ b/src/xfns.c
@@ -3866,10 +3866,10 @@ This function is an internal primitive--use
`make-frame' instead. */)
Also process `min-width' and `min-height' parameters right here
because `frame-windows-min-size' needs them. */
tem = x_get_arg (dpyinfo, parms, Qmin_width, NULL, NULL, RES_TYPE_NUMBER);
- if (FIXED_OR_FLOATP (tem))
+ if (FIXNUMP (tem))
store_frame_param (f, Qmin_width, tem);
tem = x_get_arg (dpyinfo, parms, Qmin_height, NULL, NULL, RES_TYPE_NUMBER);
- if (FIXED_OR_FLOATP (tem))
+ if (FIXNUMP (tem))
store_frame_param (f, Qmin_height, tem);
adjust_frame_size (f, FRAME_COLS (f) * FRAME_COLUMN_WIDTH (f),
FRAME_LINES (f) * FRAME_LINE_HEIGHT (f), 5, true,
diff --git a/src/xml.c b/src/xml.c
index 5f3ccc8..e85891d 100644
--- a/src/xml.c
+++ b/src/xml.c
@@ -31,6 +31,7 @@ along with GNU Emacs. If not, see
<https://www.gnu.org/licenses/>. */
#ifdef WINDOWSNT
# include <windows.h>
+# include "w32common.h"
# include "w32.h"
DEF_DLL_FN (htmlDocPtr, htmlReadMemory,
diff --git a/src/xselect.c b/src/xselect.c
index dd3da8e..53e7885 100644
--- a/src/xselect.c
+++ b/src/xselect.c
@@ -321,7 +321,7 @@ x_own_selection (Lisp_Object selection_name, Lisp_Object
selection_value,
Lisp_Object prev_value;
selection_data = list4 (selection_name, selection_value,
- INTEGER_TO_CONS (timestamp), frame);
+ INT_TO_INTEGER (timestamp), frame);
prev_value = LOCAL_SELECTION (selection_name, dpyinfo);
tset_selection_alist
@@ -401,16 +401,16 @@ x_get_local_selection (Lisp_Object selection_symbol,
Lisp_Object target_type,
if (STRINGP (check)
|| VECTORP (check)
|| SYMBOLP (check)
- || FIXNUMP (check)
+ || INTEGERP (check)
|| NILP (value))
return value;
/* Check for a value that CONS_TO_INTEGER could handle. */
else if (CONSP (check)
- && FIXNUMP (XCAR (check))
- && (FIXNUMP (XCDR (check))
+ && INTEGERP (XCAR (check))
+ && (INTEGERP (XCDR (check))
||
(CONSP (XCDR (check))
- && FIXNUMP (XCAR (XCDR (check)))
+ && INTEGERP (XCAR (XCDR (check)))
&& NILP (XCDR (XCDR (check))))))
return value;
@@ -1620,9 +1620,9 @@ selection_data_to_lisp_data (struct x_display_info
*dpyinfo,
else if (format == 32 && size == sizeof (int))
{
if (type == XA_INTEGER)
- return INTEGER_TO_CONS (((int *) data) [0]);
+ return INT_TO_INTEGER (((int *) data) [0]);
else
- return INTEGER_TO_CONS (((unsigned int *) data) [0]);
+ return INT_TO_INTEGER (((unsigned int *) data) [0]);
}
else if (format == 16 && size == sizeof (short))
{
@@ -1668,7 +1668,7 @@ selection_data_to_lisp_data (struct x_display_info
*dpyinfo,
for (i = 0; i < size / X_LONG_SIZE; i++)
{
int j = ((int *) data) [i];
- ASET (v, i, INTEGER_TO_CONS (j));
+ ASET (v, i, INT_TO_INTEGER (j));
}
}
else
@@ -1676,7 +1676,7 @@ selection_data_to_lisp_data (struct x_display_info
*dpyinfo,
for (i = 0; i < size / X_LONG_SIZE; i++)
{
unsigned int j = ((unsigned int *) data) [i];
- ASET (v, i, INTEGER_TO_CONS (j));
+ ASET (v, i, INT_TO_INTEGER (j));
}
}
return v;
@@ -1693,7 +1693,7 @@ static unsigned long
cons_to_x_long (Lisp_Object obj)
{
if (X_ULONG_MAX <= INTMAX_MAX
- || XFIXNUM (FIXNUMP (obj) ? obj : XCAR (obj)) < 0)
+ || NILP (Fnatnump (CONSP (obj) ? XCAR (obj) : obj)))
return cons_to_signed (obj, X_LONG_MIN, min (X_ULONG_MAX, INTMAX_MAX));
else
return cons_to_unsigned (obj, X_ULONG_MAX);
@@ -1759,8 +1759,8 @@ lisp_data_to_selection_data (struct x_display_info
*dpyinfo,
*short_ptr = XFIXNUM (obj);
if (NILP (type)) type = QINTEGER;
}
- else if (FIXNUMP (obj)
- || (CONSP (obj) && FIXNUMP (XCAR (obj))
+ else if (INTEGERP (obj)
+ || (CONSP (obj) && INTEGERP (XCAR (obj))
&& (FIXNUMP (XCDR (obj))
|| (CONSP (XCDR (obj))
&& FIXNUMP (XCAR (XCDR (obj)))))))
@@ -1846,19 +1846,19 @@ static Lisp_Object
clean_local_selection_data (Lisp_Object obj)
{
if (CONSP (obj)
- && FIXNUMP (XCAR (obj))
+ && INTEGERP (XCAR (obj))
&& CONSP (XCDR (obj))
&& FIXNUMP (XCAR (XCDR (obj)))
&& NILP (XCDR (XCDR (obj))))
obj = Fcons (XCAR (obj), XCDR (obj));
if (CONSP (obj)
- && FIXNUMP (XCAR (obj))
+ && INTEGERP (XCAR (obj))
&& FIXNUMP (XCDR (obj)))
{
- if (XFIXNUM (XCAR (obj)) == 0)
+ if (EQ (XCAR (obj), make_fixnum (0)))
return XCDR (obj);
- if (XFIXNUM (XCAR (obj)) == -1)
+ if (EQ (XCAR (obj), make_fixnum (-1)))
return make_fixnum (- XFIXNUM (XCDR (obj)));
}
if (VECTORP (obj))
@@ -2264,10 +2264,10 @@ x_check_property_data (Lisp_Object data)
{
Lisp_Object o = XCAR (iter);
- if (! FIXED_OR_FLOATP (o) && ! STRINGP (o) && ! CONSP (o))
+ if (! NUMBERP (o) && ! STRINGP (o) && ! CONSP (o))
return -1;
else if (CONSP (o) &&
- (! FIXED_OR_FLOATP (XCAR (o)) || ! FIXED_OR_FLOATP (XCDR (o))))
+ (! NUMBERP (XCAR (o)) || ! NUMBERP (XCDR (o))))
return -1;
if (size == INT_MAX)
return -1;
@@ -2303,7 +2303,7 @@ x_fill_property_data (Display *dpy, Lisp_Object data,
void *ret, int format)
{
Lisp_Object o = XCAR (iter);
- if (FIXED_OR_FLOATP (o) || CONSP (o))
+ if (NUMBERP (o) || CONSP (o))
{
if (CONSP (o)
&& RANGED_FIXNUMP (X_LONG_MIN >> 16, XCAR (o), X_LONG_MAX >> 16)
@@ -2580,7 +2580,7 @@ x_send_client_event (Lisp_Object display, Lisp_Object
dest, Lisp_Object from,
else
error ("DEST as a string must be one of PointerWindow or InputFocus");
}
- else if (FIXED_OR_FLOATP (dest) || CONSP (dest))
+ else if (NUMBERP (dest) || CONSP (dest))
CONS_TO_INTEGER (dest, Window, wdest);
else
error ("DEST must be a frame, nil, string, number or cons");
diff --git a/src/xterm.c b/src/xterm.c
index 06c8446..f8ea787 100644
--- a/src/xterm.c
+++ b/src/xterm.c
@@ -10507,9 +10507,9 @@ set_wm_state (Lisp_Object frame, bool add, Atom atom,
Atom value)
Fcons
(make_fixnum (add),
Fcons
- (make_fixnum_or_float (atom),
+ (INT_TO_INTEGER (atom),
(value != 0
- ? list1 (make_fixnum_or_float (value))
+ ? list1 (INT_TO_INTEGER (value))
: Qnil))));
}
diff --git a/test/Makefile.in b/test/Makefile.in
index 0bc893b..a1f4388 100644
--- a/test/Makefile.in
+++ b/test/Makefile.in
@@ -246,12 +246,14 @@ else
FPIC_CFLAGS = -fPIC
endif
+# Note: emacs-module.h is generated from emacs-module.h.in, hence we
+# look in ../src, not $(srcdir)/../src.
MODULE_CFLAGS = -I../src $(FPIC_CFLAGS) $(PROFILING_CFLAGS) \
$(WARN_CFLAGS) $(WERROR_CFLAGS) $(CFLAGS)
test_module = $(test_module_dir)/mod-test${SO}
src/emacs-module-tests.log: $(test_module)
-$(test_module): $(test_module:${SO}=.c) $(srcdir)/../src/emacs-module.h
+$(test_module): $(test_module:${SO}=.c) ../src/emacs-module.h
$(AM_V_at)${MKDIR_P} $(dir $@)
$(AM_V_CCLD)$(CC) -shared $(CPPFLAGS) $(MODULE_CFLAGS) $(LDFLAGS) \
-o $@ $<
diff --git a/test/data/emacs-module/mod-test.c
b/test/data/emacs-module/mod-test.c
index db05e90..a9b459b 100644
--- a/test/data/emacs-module/mod-test.c
+++ b/test/data/emacs-module/mod-test.c
@@ -156,6 +156,24 @@ Fmod_test_globref_make (emacs_env *env, ptrdiff_t nargs,
emacs_value args[],
return env->make_global_ref (env, lisp_str);
}
+/* Create a few global references from arguments and free them. */
+static emacs_value
+Fmod_test_globref_free (emacs_env *env, ptrdiff_t nargs, emacs_value args[],
+ void *data)
+{
+ emacs_value refs[10];
+ for (int i = 0; i < 10; i++)
+ {
+ refs[i] = env->make_global_ref (env, args[i % nargs]);
+ }
+ for (int i = 0; i < 10; i++)
+ {
+ env->free_global_ref (env, refs[i]);
+ }
+ return env->intern (env, "ok");
+}
+
+
/* Return a copy of the argument string where every 'a' is replaced
with 'b'. */
@@ -339,6 +357,7 @@ emacs_module_init (struct emacs_runtime *ert)
DEFUN ("mod-test-non-local-exit-funcall", Fmod_test_non_local_exit_funcall,
1, 1, NULL, NULL);
DEFUN ("mod-test-globref-make", Fmod_test_globref_make, 0, 0, NULL, NULL);
+ DEFUN ("mod-test-globref-free", Fmod_test_globref_free, 4, 4, NULL, NULL);
DEFUN ("mod-test-string-a-to-b", Fmod_test_string_a_to_b, 1, 1, NULL, NULL);
DEFUN ("mod-test-userptr-make", Fmod_test_userptr_make, 1, 1, NULL, NULL);
DEFUN ("mod-test-userptr-get", Fmod_test_userptr_get, 1, 1, NULL, NULL);
diff --git a/test/lisp/comint-tests.el b/test/lisp/comint-tests.el
index 6489888..eab2709 100644
--- a/test/lisp/comint-tests.el
+++ b/test/lisp/comint-tests.el
@@ -36,9 +36,10 @@
"Enter same passphrase again: " ; ssh-keygen
"Passphrase for key address@hidden: " ; plink
"[sudo] password for user:" ; Ubuntu sudo
+ "[sudo] user 的密码：" ; localized
"Password (again):"
"Enter password:"
- "Mot de Passe:" ; localized
+ "Mot de Passe :" ; localized (Bug#29729)
"Passwort:") ; localized
"List of strings that should match `comint-password-prompt-regexp'.")
diff --git a/test/lisp/international/ccl-tests.el
b/test/lisp/international/ccl-tests.el
index b41b8c1..7dd7224 100644
--- a/test/lisp/international/ccl-tests.el
+++ b/test/lisp/international/ccl-tests.el
@@ -37,18 +37,9 @@
;; shift right -ve -5628 #x3fffffffffffea04
(should (= (ash -5628 -8) -22)) ; #x3fffffffffffffea
-
- ;; shift right -5628 #x3fffffffffffea04
- (cond
- ((fboundp 'bignump)
- (should (= (lsh -5628 -8) -22))) ; #x3fffffffffffffea bignum
- ((= (logb most-negative-fixnum) 61)
- (should (= (lsh -5628 -8)
- (string-to-number
- "18014398509481962")))) ; #x003fffffffffffea master
(64bit)
- ((= (logb most-negative-fixnum) 29)
- (should (= (lsh -5628 -8) 4194282))) ; #x003fffea master
(32bit)
- ))
+ (should (= (lsh -5628 -8)
+ (ash (- -5628 (ash most-negative-fixnum 1)) -8)
+ (ash (logand (ash -5628 -1) most-positive-fixnum) -7))))
;; CCl program from `pgg-parse-crc24' in lisp/obsolete/pgg-parse.el
(defconst prog-pgg-source
@@ -177,11 +168,11 @@ At EOF:
82169 240 2555 18 128 81943 15 276 529 305 81 -17660 -17916 22])
(defconst prog-midi-dump
-"Out-buffer must be 2 times bigger than in-buffer.
+(concat "Out-buffer must be 2 times bigger than in-buffer.
Main-body:
2:[read-jump-cond-expr-const] read r0, if !(r0 < 128), jump to 22(+20)
5:[branch] jump to array[r3] of length 4
- 11 12 15 18 22
+ 11 12 15 18 22 ""
11:[jump] jump to 2(-9)
12:[set-register] r1 = r0
13:[set-register] r0 = r4
@@ -227,7 +218,7 @@ Main-body:
71:[jump] jump to 2(-69)
At EOF:
72:[end] end
-")
+"))
(ert-deftest ccl-compile-midi ()
(should (equal (ccl-compile prog-midi-source) prog-midi-code)))
diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el
index e1838d1..81c021d 100644
--- a/test/lisp/net/tramp-tests.el
+++ b/test/lisp/net/tramp-tests.el
@@ -3219,11 +3219,12 @@ This tests also `make-symbolic-link', `file-truename'
and `add-name-to-file'."
;; `current-time'. Therefore, we use '(0 1). We skip the
;; test, if the remote handler is not able to set the
;; correct time.
- (skip-unless (set-file-times tmp-name1 '(0 1)))
+ (skip-unless (set-file-times tmp-name1 (seconds-to-time 1)))
;; Dumb remote shells without perl(1) or stat(1) are not
;; able to return the date correctly. They say "don't know".
(unless (equal (nth 5 (file-attributes tmp-name1)) '(0 0))
- (should (equal (nth 5 (file-attributes tmp-name1)) '(0 1)))
+ (should
+ (equal (nth 5 (file-attributes tmp-name1)) (seconds-to-time 1)))
(write-region "bla" nil tmp-name2)
(should (file-exists-p tmp-name2))
(should (file-newer-than-file-p tmp-name2 tmp-name1))
diff --git a/test/src/data-tests.el b/test/src/data-tests.el
index a4c6b0e..701e579 100644
--- a/test/src/data-tests.el
+++ b/test/src/data-tests.el
@@ -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))
@@ -551,7 +551,10 @@ comparing the subr with a much slower lisp implementation."
(should (= b0 b0))
(should (/= b0 f-1))
- (should (/= b0 b-1))))
+ (should (/= b0 b-1))
+
+ (should (/= b0 0.0e+NaN))
+ (should (/= b-1 0.0e+NaN))))
(ert-deftest data-tests-+ ()
(should-not (fixnump (+ most-positive-fixnum most-positive-fixnum)))
@@ -598,7 +601,9 @@ comparing the subr with a much slower lisp implementation."
(should (fixnump (1- (1+ most-positive-fixnum)))))
(ert-deftest data-tests-logand ()
- (should (= -1 (logand -1)))
+ (should (= -1 (logand) (logand -1) (logand -1 -1)))
+ (let ((n (1+ most-positive-fixnum)))
+ (should (= (logand -1 n) n)))
(let ((n (* 2 most-negative-fixnum)))
(should (= (logand -1 n) n))))
@@ -606,11 +611,11 @@ comparing the subr with a much slower lisp
implementation."
(should (= (logcount (read "#xffffffffffffffffffffffffffffffff")) 128)))
(ert-deftest data-tests-logior ()
- (should (= -1 (logior -1)))
+ (should (= -1 (logior -1) (logior -1 -1)))
(should (= -1 (logior most-positive-fixnum most-negative-fixnum))))
(ert-deftest data-tests-logxor ()
- (should (= -1 (logxor -1)))
+ (should (= -1 (logxor -1) (logxor -1 -1 -1)))
(let ((n (1+ most-positive-fixnum)))
(should (= (logxor -1 n) (lognot n)))))
@@ -642,6 +647,12 @@ comparing the subr with a much slower lisp implementation."
(should (= (ash most-negative-fixnum 1)
(* most-negative-fixnum 2)))
(should (= (lsh most-negative-fixnum 1)
- (* most-negative-fixnum 2))))
+ (* most-negative-fixnum 2)))
+ (should (= (ash (* 2 most-negative-fixnum) -1)
+ most-negative-fixnum))
+ (should (= (lsh most-positive-fixnum -1) (/ most-positive-fixnum 2)))
+ (should (= (lsh most-negative-fixnum -1) (lsh (- most-negative-fixnum) -1)))
+ (should (= (lsh -1 -1) most-positive-fixnum))
+ (should-error (lsh (1- most-negative-fixnum) -1)))
;;; data-tests.el ends here
diff --git a/test/src/emacs-module-tests.el b/test/src/emacs-module-tests.el
index 90cd37a..c67190b 100644
--- a/test/src/emacs-module-tests.el
+++ b/test/src/emacs-module-tests.el
@@ -148,6 +148,9 @@ changes."
(garbage-collect) ;; XXX: not enough to really test but it's something..
(should (string= ref-str mod-str))))
+(ert-deftest mod-test-globref-free-test ()
+ (should (eq (mod-test-globref-free 1 'a "test" 'b) 'ok)))
+
(ert-deftest mod-test-string-a-to-b-test ()
(should (string= (mod-test-string-a-to-b "aaa") "bbb")))
diff --git a/test/src/floatfns-tests.el b/test/src/floatfns-tests.el
index 7714c05..d41b08f 100644
--- a/test/src/floatfns-tests.el
+++ b/test/src/floatfns-tests.el
@@ -20,10 +20,10 @@
(require 'ert)
(ert-deftest divide-extreme-sign ()
- (should-error (ceiling most-negative-fixnum -1.0))
- (should-error (floor most-negative-fixnum -1.0))
- (should-error (round most-negative-fixnum -1.0))
- (should-error (truncate most-negative-fixnum -1.0)))
+ (should (= (ceiling most-negative-fixnum -1.0) (- most-negative-fixnum)))
+ (should (= (floor most-negative-fixnum -1.0) (- most-negative-fixnum)))
+ (should (= (round most-negative-fixnum -1.0) (- most-negative-fixnum)))
+ (should (= (truncate most-negative-fixnum -1.0) (- most-negative-fixnum))))
(ert-deftest logb-extreme-fixnum ()
(should (= (logb most-negative-fixnum) (1+ (logb most-positive-fixnum)))))
@@ -42,8 +42,51 @@
(should (= most-positive-fixnum
(- (abs most-negative-fixnum) 1))))
+(ert-deftest bignum-expt ()
+ (dolist (n (list most-positive-fixnum (1+ most-positive-fixnum)
+ most-negative-fixnum (1- most-negative-fixnum)
+ -2 -1 0 1 2))
+ (should (= (expt n 0) 1))
+ (should (= (expt n 1) n))
+ (should (= (expt n 2) (* n n)))
+ (should (= (expt n 3) (* n n n)))))
+
(ert-deftest bignum-logb ()
(should (= (+ (logb most-positive-fixnum) 1)
(logb (+ most-positive-fixnum 1)))))
+(ert-deftest bignum-mod ()
+ (should (= 0 (mod (1+ most-positive-fixnum) 2.0))))
+
+(ert-deftest bignum-round ()
+ (let ((ns (list (* most-positive-fixnum most-negative-fixnum)
+ (1- most-negative-fixnum) most-negative-fixnum
+ (1+ most-negative-fixnum) -2 1 1 2
+ (1- most-positive-fixnum) most-positive-fixnum
+ (1+ most-positive-fixnum)
+ (* most-positive-fixnum most-positive-fixnum))))
+ (dolist (n ns)
+ (should (= n (ceiling n)))
+ (should (= n (floor n)))
+ (should (= n (round n)))
+ (should (= n (truncate n)))
+ (dolist (d ns)
+ (let ((q (/ n d))
+ (r (% n d))
+ (same-sign (eq (< n 0) (< d 0))))
+ (should (= (ceiling n d)
+ (+ q (if (and same-sign (not (zerop r))) 1 0))))
+ (should (= (floor n d)
+ (- q (if (and (not same-sign) (not (zerop r))) 1 0))))
+ (should (= (truncate n d) q))
+ (let ((cdelta (abs (- n (* d (ceiling n d)))))
+ (fdelta (abs (- n (* d (floor n d)))))
+ (rdelta (abs (- n (* d (round n d))))))
+ (should (<= rdelta cdelta))
+ (should (<= rdelta fdelta))
+ (should (if (zerop r)
+ (= 0 cdelta fdelta rdelta)
+ (or (/= cdelta fdelta)
+ (zerop (% (round n d) 2)))))))))))
+
(provide 'floatfns-tests)
diff --git a/test/src/fns-tests.el b/test/src/fns-tests.el
index f722ed6..b180f30 100644
--- a/test/src/fns-tests.el
+++ b/test/src/fns-tests.el
@@ -624,4 +624,25 @@
(should (eq (gethash b2 hash)
(funcall test b1 b2)))))))
+(ert-deftest test-nthcdr-simple ()
+ (should (eq (nthcdr 0 'x) 'x))
+ (should (eq (nthcdr 1 '(x . y)) 'y))
+ (should (eq (nthcdr 2 '(x y . z)) 'z)))
+
+(ert-deftest test-nthcdr-circular ()
+ (dolist (len '(1 2 5 37 120 997 1024))
+ (let ((cycle (make-list len nil)))
+ (setcdr (last cycle) cycle)
+ (dolist (n (list (1- most-negative-fixnum) most-negative-fixnum
+ -1 0 1
+ (1- len) len (1+ len)
+ most-positive-fixnum (1+ most-positive-fixnum)
+ (* 2 most-positive-fixnum)
+ (* most-positive-fixnum most-positive-fixnum)
+ (ash 1 12345)))
+ (let ((a (nthcdr n cycle))
+ (b (if (<= n 0) cycle (nthcdr (mod n len) cycle))))
+ (should (equal (list (eq a b) n len)
+ (list t n len))))))))
+
(provide 'fns-tests)
diff --git a/test/src/lread-tests.el b/test/src/lread-tests.el
index 1738134..f19d983 100644
--- a/test/src/lread-tests.el
+++ b/test/src/lread-tests.el
@@ -209,4 +209,13 @@ literals (Bug#20852)."
(should-error
(let ((load-force-doc-strings t)) (read "#[0 \"\"]"))))
+(ert-deftest lread-string-to-number-trailing-dot ()
+ (dolist (n (list (* most-negative-fixnum most-negative-fixnum)
+ (1- most-negative-fixnum) most-negative-fixnum
+ (1+ most-negative-fixnum) -1 0 1
+ (1- most-positive-fixnum) most-positive-fixnum
+ (1+ most-positive-fixnum)
+ (* most-positive-fixnum most-positive-fixnum)))
+ (should (= n (string-to-number (format "%d." n))))))
+
;;; lread-tests.el ends here