aboutsummaryrefslogtreecommitdiffstats
path: root/lisp
diff options
context:
space:
mode:
authorAndy Moreton2018-08-04 10:28:13 -0600
committerTom Tromey2018-08-04 10:28:13 -0600
commitbc8ff54efee05f4a2769be32046866ed1e152b41 (patch)
treec6dac43f3b9abfc6bde54a9d245c04e5dbb360d5 /lisp
parent76715f8921dca740880cd22c644a6328cd810846 (diff)
downloademacs-bc8ff54efee05f4a2769be32046866ed1e152b41.tar.gz
emacs-bc8ff54efee05f4a2769be32046866ed1e152b41.zip
Make bignums work better when EMACS_INT is larger than long
* lisp/international/ccl.el (ccl-fixnum): New function. (ccl-embed-data, ccl-embed-current-address, ccl-dump): Use it. * src/alloc.c (make_number): Handle case where EMACS_INT is larger than long. * src/data.c (bignumcompare): Handle case where EMACS_INT is larger than long. (arith_driver): Likewise. Coerce markers. (float_arith_driver): Coerce markers. (Flogcount): Use mpz_sgn. (ash_lsh_impl): Fix bugs. (Fsub1): Fix underflow check. * src/lisp.h (NUMBERP): Don't check BIGNUMP. (CHECK_FIXNUM_OR_FLOAT_COERCE_MARKER): Fix indentation. * test/lisp/international/ccl-tests.el: New file.
Diffstat (limited to 'lisp')
-rw-r--r--lisp/international/ccl.el16
1 files changed, 12 insertions, 4 deletions
diff --git a/lisp/international/ccl.el b/lisp/international/ccl.el
index d2f490d59cd..d1b82ceb9ce 100644
--- a/lisp/international/ccl.el
+++ b/lisp/international/ccl.el
@@ -184,11 +184,17 @@
184(defvar ccl-current-ic 0 184(defvar ccl-current-ic 0
185 "The current index for `ccl-program-vector'.") 185 "The current index for `ccl-program-vector'.")
186 186
187;; This is needed because CCL assumes the pre-bigint (wrapping)
188;; semantics of integer overflow.
189(defun ccl-fixnum (code)
190 "Convert a CCL code word to a fixnum value."
191 (- (logxor (logand code #x0fffffff) #x08000000) #x08000000))
192
187(defun ccl-embed-data (data &optional ic) 193(defun ccl-embed-data (data &optional ic)
188 "Embed integer DATA in `ccl-program-vector' at `ccl-current-ic' and 194 "Embed integer DATA in `ccl-program-vector' at `ccl-current-ic' and
189increment it. If IC is specified, embed DATA at IC." 195increment it. If IC is specified, embed DATA at IC."
190 (if ic 196 (if ic
191 (aset ccl-program-vector ic data) 197 (aset ccl-program-vector ic (ccl-fixnum data))
192 (let ((len (length ccl-program-vector))) 198 (let ((len (length ccl-program-vector)))
193 (if (>= ccl-current-ic len) 199 (if (>= ccl-current-ic len)
194 (let ((new (make-vector (* len 2) nil))) 200 (let ((new (make-vector (* len 2) nil)))
@@ -196,7 +202,7 @@ increment it. If IC is specified, embed DATA at IC."
196 (setq len (1- len)) 202 (setq len (1- len))
197 (aset new len (aref ccl-program-vector len))) 203 (aset new len (aref ccl-program-vector len)))
198 (setq ccl-program-vector new)))) 204 (setq ccl-program-vector new))))
199 (aset ccl-program-vector ccl-current-ic data) 205 (aset ccl-program-vector ccl-current-ic (ccl-fixnum data))
200 (setq ccl-current-ic (1+ ccl-current-ic)))) 206 (setq ccl-current-ic (1+ ccl-current-ic))))
201 207
202(defun ccl-embed-symbol (symbol prop) 208(defun ccl-embed-symbol (symbol prop)
@@ -230,7 +236,8 @@ proper index number for SYMBOL. PROP should be
230`ccl-program-vector' at IC without altering the other bit field." 236`ccl-program-vector' at IC without altering the other bit field."
231 (let ((relative (- ccl-current-ic (1+ ic)))) 237 (let ((relative (- ccl-current-ic (1+ ic))))
232 (aset ccl-program-vector ic 238 (aset ccl-program-vector ic
233 (logior (aref ccl-program-vector ic) (ash relative 8))))) 239 (logior (aref ccl-program-vector ic)
240 (ccl-fixnum (ash relative 8))))))
234 241
235(defun ccl-embed-code (op reg data &optional reg2) 242(defun ccl-embed-code (op reg data &optional reg2)
236 "Embed CCL code for the operation OP and arguments REG and DATA in 243 "Embed CCL code for the operation OP and arguments REG and DATA in
@@ -986,7 +993,8 @@ is a list of CCL-BLOCKs."
986(defun ccl-get-next-code () 993(defun ccl-get-next-code ()
987 "Return a CCL code in `ccl-code' at `ccl-current-ic'." 994 "Return a CCL code in `ccl-code' at `ccl-current-ic'."
988 (prog1 995 (prog1
989 (aref ccl-code ccl-current-ic) 996 (let ((code (aref ccl-code ccl-current-ic)))
997 (if (numberp code) (ccl-fixnum code) code))
990 (setq ccl-current-ic (1+ ccl-current-ic)))) 998 (setq ccl-current-ic (1+ ccl-current-ic))))
991 999
992(defun ccl-dump-1 () 1000(defun ccl-dump-1 ()