diff options
| author | Andy Moreton | 2018-08-04 10:28:13 -0600 |
|---|---|---|
| committer | Tom Tromey | 2018-08-04 10:28:13 -0600 |
| commit | bc8ff54efee05f4a2769be32046866ed1e152b41 (patch) | |
| tree | c6dac43f3b9abfc6bde54a9d245c04e5dbb360d5 /lisp | |
| parent | 76715f8921dca740880cd22c644a6328cd810846 (diff) | |
| download | emacs-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.el | 16 |
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 |
| 189 | increment it. If IC is specified, embed DATA at IC." | 195 | increment 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 () |