mirror of
https://git.savannah.gnu.org/git/emacs.git
synced 2024-12-16 09:50:25 +00:00
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.
This commit is contained in:
Andy Moreton
Tom Tromey
parent
76715f8921
commit
bc8ff54efe
@ -184,11 +184,17 @@
|
||||
(defvar ccl-current-ic 0
|
||||
"The current index for `ccl-program-vector'.")
|
||||
|
||||
;; This is needed because CCL assumes the pre-bigint (wrapping)
|
||||
;; semantics of integer overflow.
|
||||
(defun ccl-fixnum (code)
|
||||
"Convert a CCL code word to a fixnum value."
|
||||
(- (logxor (logand code #x0fffffff) #x08000000) #x08000000))
|
||||
|
||||
(defun ccl-embed-data (data &optional ic)
|
||||
"Embed integer DATA in `ccl-program-vector' at `ccl-current-ic' and
|
||||
increment it. If IC is specified, embed DATA at IC."
|
||||
(if ic
|
||||
(aset ccl-program-vector ic data)
|
||||
(aset ccl-program-vector ic (ccl-fixnum data))
|
||||
(let ((len (length ccl-program-vector)))
|
||||
(if (>= ccl-current-ic len)
|
||||
(let ((new (make-vector (* len 2) nil)))
|
||||
@ -196,7 +202,7 @@ increment it. If IC is specified, embed DATA at IC."
|
||||
(setq len (1- len))
|
||||
(aset new len (aref ccl-program-vector len)))
|
||||
(setq ccl-program-vector new))))
|
||||
(aset ccl-program-vector ccl-current-ic data)
|
||||
(aset ccl-program-vector ccl-current-ic (ccl-fixnum data))
|
||||
(setq ccl-current-ic (1+ ccl-current-ic))))
|
||||
|
||||
(defun ccl-embed-symbol (symbol prop)
|
||||
@ -230,7 +236,8 @@ proper index number for SYMBOL. PROP should be
|
||||
`ccl-program-vector' at IC without altering the other bit field."
|
||||
(let ((relative (- ccl-current-ic (1+ ic))))
|
||||
(aset ccl-program-vector ic
|
||||
(logior (aref ccl-program-vector ic) (ash relative 8)))))
|
||||
(logior (aref ccl-program-vector ic)
|
||||
(ccl-fixnum (ash relative 8))))))
|
||||
|
||||
(defun ccl-embed-code (op reg data &optional reg2)
|
||||
"Embed CCL code for the operation OP and arguments REG and DATA in
|
||||
@ -986,7 +993,8 @@ is a list of CCL-BLOCKs."
|
||||
(defun ccl-get-next-code ()
|
||||
"Return a CCL code in `ccl-code' at `ccl-current-ic'."
|
||||
(prog1
|
||||
(aref ccl-code ccl-current-ic)
|
||||
(let ((code (aref ccl-code ccl-current-ic)))
|
||||
(if (numberp code) (ccl-fixnum code) code))
|
||||
(setq ccl-current-ic (1+ ccl-current-ic))))
|
||||
|
||||
(defun ccl-dump-1 ()
|
||||
|
||||
28
src/alloc.c
28
src/alloc.c
@ -3815,6 +3815,34 @@ make_number (mpz_t value)
|
||||
}
|
||||
}
|
||||
|
||||
/* 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 * GMP_NUMB_BITS));
|
||||
}
|
||||
if (sign < 0)
|
||||
v = -v;
|
||||
|
||||
if (!FIXNUM_OVERFLOW_P (v))
|
||||
{
|
||||
XSETINT (obj, v);
|
||||
return obj;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
obj = allocate_misc (Lisp_Misc_Bignum);
|
||||
b = XBIGNUM (obj);
|
||||
/* We could mpz_init + mpz_swap here, to avoid a copy, but the
|
||||
|
||||
96
src/data.c
96
src/data.c
@ -2409,7 +2409,18 @@ bignumcompare (Lisp_Object num1, Lisp_Object num2,
|
||||
if (FLOATP (num2))
|
||||
cmp = mpz_cmp_d (XBIGNUM (num1)->value, XFLOAT_DATA (num2));
|
||||
else if (FIXNUMP (num2))
|
||||
cmp = mpz_cmp_si (XBIGNUM (num1)->value, XINT (num2));
|
||||
{
|
||||
if (sizeof (EMACS_INT) > sizeof (long) && XINT (num2) > LONG_MAX)
|
||||
{
|
||||
mpz_t tem;
|
||||
mpz_init (tem);
|
||||
mpz_set_intmax (tem, XINT (num2));
|
||||
cmp = mpz_cmp (XBIGNUM (num1)->value, tem);
|
||||
mpz_clear (tem);
|
||||
}
|
||||
else
|
||||
cmp = mpz_cmp_si (XBIGNUM (num1)->value, XINT (num2));
|
||||
}
|
||||
else
|
||||
{
|
||||
eassume (BIGNUMP (num2));
|
||||
@ -2422,10 +2433,19 @@ bignumcompare (Lisp_Object num1, Lisp_Object num2,
|
||||
if (FLOATP (num1))
|
||||
cmp = - mpz_cmp_d (XBIGNUM (num2)->value, XFLOAT_DATA (num1));
|
||||
else
|
||||
{
|
||||
{
|
||||
eassume (FIXNUMP (num1));
|
||||
cmp = - mpz_cmp_si (XBIGNUM (num2)->value, XINT (num1));
|
||||
}
|
||||
if (sizeof (EMACS_INT) > sizeof (long) && XINT (num1) > LONG_MAX)
|
||||
{
|
||||
mpz_t tem;
|
||||
mpz_init (tem);
|
||||
mpz_set_intmax (tem, XINT (num1));
|
||||
cmp = - mpz_cmp (XBIGNUM (num2)->value, tem);
|
||||
mpz_clear (tem);
|
||||
}
|
||||
else
|
||||
cmp = - mpz_cmp_si (XBIGNUM (num2)->value, XINT (num1));
|
||||
}
|
||||
}
|
||||
|
||||
switch (comparison)
|
||||
@ -2860,7 +2880,7 @@ arith_driver (enum arithop code, ptrdiff_t nargs, Lisp_Object *args)
|
||||
{
|
||||
/* Using args[argnum] as argument to CHECK_NUMBER... */
|
||||
val = args[argnum];
|
||||
CHECK_NUMBER (val);
|
||||
CHECK_NUMBER_COERCE_MARKER (val);
|
||||
|
||||
if (FLOATP (val))
|
||||
return unbind_to (count,
|
||||
@ -2871,7 +2891,15 @@ 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 (XINT (val) < 0)
|
||||
else if (sizeof (EMACS_INT) > sizeof (long))
|
||||
{
|
||||
mpz_t tem;
|
||||
mpz_init (tem);
|
||||
mpz_set_intmax (tem, XINT (val));
|
||||
mpz_add (accum, accum, tem);
|
||||
mpz_clear (tem);
|
||||
}
|
||||
else if (XINT (val) < 0)
|
||||
mpz_sub_ui (accum, accum, - XINT (val));
|
||||
else
|
||||
mpz_add_ui (accum, accum, XINT (val));
|
||||
@ -2888,6 +2916,14 @@ 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))
|
||||
{
|
||||
mpz_t tem;
|
||||
mpz_init (tem);
|
||||
mpz_set_intmax (tem, XINT (val));
|
||||
mpz_sub (accum, accum, tem);
|
||||
mpz_clear (tem);
|
||||
}
|
||||
else if (XINT (val) < 0)
|
||||
mpz_add_ui (accum, accum, - XINT (val));
|
||||
else
|
||||
@ -2896,6 +2932,14 @@ arith_driver (enum arithop code, ptrdiff_t nargs, Lisp_Object *args)
|
||||
case Amult:
|
||||
if (BIGNUMP (val))
|
||||
mpz_mul (accum, accum, XBIGNUM (val)->value);
|
||||
else if (sizeof (EMACS_INT) > sizeof (long))
|
||||
{
|
||||
mpz_t tem;
|
||||
mpz_init (tem);
|
||||
mpz_set_intmax (tem, XINT (val));
|
||||
mpz_mul (accum, accum, tem);
|
||||
mpz_clear (tem);
|
||||
}
|
||||
else
|
||||
mpz_mul_si (accum, accum, XINT (val));
|
||||
break;
|
||||
@ -2915,6 +2959,14 @@ arith_driver (enum arithop code, ptrdiff_t nargs, Lisp_Object *args)
|
||||
xsignal0 (Qarith_error);
|
||||
if (BIGNUMP (val))
|
||||
mpz_tdiv_q (accum, accum, XBIGNUM (val)->value);
|
||||
else if (sizeof (EMACS_INT) > sizeof (long))
|
||||
{
|
||||
mpz_t tem;
|
||||
mpz_init (tem);
|
||||
mpz_set_intmax (tem, XINT (val));
|
||||
mpz_tdiv_q (accum, accum, tem);
|
||||
mpz_clear (tem);
|
||||
}
|
||||
else
|
||||
{
|
||||
EMACS_INT value = XINT (val);
|
||||
@ -2982,8 +3034,9 @@ float_arith_driver (double accum, ptrdiff_t argnum, enum arithop code,
|
||||
|
||||
for (; argnum < nargs; argnum++)
|
||||
{
|
||||
val = args[argnum]; /* using args[argnum] as argument to CHECK_FIXNUM_... */
|
||||
CHECK_FIXNUM_OR_FLOAT_COERCE_MARKER (val);
|
||||
/* using args[argnum] as argument to CHECK_NUMBER_... */
|
||||
val = args[argnum];
|
||||
CHECK_NUMBER_COERCE_MARKER (val);
|
||||
|
||||
if (FLOATP (val))
|
||||
{
|
||||
@ -3277,7 +3330,7 @@ representation. */)
|
||||
|
||||
if (BIGNUMP (value))
|
||||
{
|
||||
if (mpz_cmp_si (XBIGNUM (value)->value, 0) >= 0)
|
||||
if (mpz_sgn (XBIGNUM (value)->value) >= 0)
|
||||
return make_fixnum (mpz_popcount (XBIGNUM (value)->value));
|
||||
mpz_t tem;
|
||||
mpz_init (tem);
|
||||
@ -3314,8 +3367,10 @@ ash_lsh_impl (Lisp_Object value, Lisp_Object count, bool lsh)
|
||||
mpz_init (result);
|
||||
if (XINT (count) >= 0)
|
||||
mpz_mul_2exp (result, XBIGNUM (value)->value, XINT (count));
|
||||
else
|
||||
else if (lsh)
|
||||
mpz_tdiv_q_2exp (result, XBIGNUM (value)->value, - XINT (count));
|
||||
else
|
||||
mpz_fdiv_q_2exp (result, XBIGNUM (value)->value, - XINT (count));
|
||||
val = make_number (result);
|
||||
mpz_clear (result);
|
||||
}
|
||||
@ -3325,14 +3380,21 @@ ash_lsh_impl (Lisp_Object value, Lisp_Object count, bool lsh)
|
||||
mpz_t result;
|
||||
eassume (FIXNUMP (value));
|
||||
mpz_init (result);
|
||||
if (lsh)
|
||||
mpz_set_uintmax (result, XUINT (value));
|
||||
else
|
||||
mpz_set_intmax (result, XINT (value));
|
||||
|
||||
mpz_set_intmax (result, XINT (value));
|
||||
|
||||
if (XINT (count) >= 0)
|
||||
mpz_mul_2exp (result, result, XINT (count));
|
||||
else
|
||||
mpz_tdiv_q_2exp (result, result, - XINT (count));
|
||||
else if (lsh)
|
||||
{
|
||||
if (mpz_sgn (result) > 0)
|
||||
mpz_fdiv_q_2exp (result, result, - XINT (count));
|
||||
else
|
||||
mpz_fdiv_q_2exp (result, result, - XINT (count));
|
||||
}
|
||||
else /* ash */
|
||||
mpz_fdiv_q_2exp (result, result, - XINT (count));
|
||||
|
||||
val = make_number (result);
|
||||
mpz_clear (result);
|
||||
}
|
||||
@ -3414,7 +3476,7 @@ Markers are converted to integers. */)
|
||||
else
|
||||
{
|
||||
eassume (FIXNUMP (number));
|
||||
if (XINT (number) > MOST_POSITIVE_FIXNUM)
|
||||
if (XINT (number) > MOST_NEGATIVE_FIXNUM)
|
||||
XSETINT (number, XINT (number) - 1);
|
||||
else
|
||||
{
|
||||
|
||||
@ -2778,7 +2778,7 @@ NATNUMP (Lisp_Object x)
|
||||
INLINE bool
|
||||
NUMBERP (Lisp_Object x)
|
||||
{
|
||||
return INTEGERP (x) || FLOATP (x) || BIGNUMP (x);
|
||||
return INTEGERP (x) || FLOATP (x);
|
||||
}
|
||||
|
||||
INLINE bool
|
||||
@ -2947,7 +2947,7 @@ CHECK_INTEGER (Lisp_Object x)
|
||||
if (MARKERP (x)) \
|
||||
XSETFASTINT (x, marker_position (x)); \
|
||||
else \
|
||||
CHECK_TYPE (FIXED_OR_FLOATP (x), Qnumber_or_marker_p, x); \
|
||||
CHECK_TYPE (FIXED_OR_FLOATP (x), Qnumber_or_marker_p, x); \
|
||||
} while (false)
|
||||
|
||||
#define CHECK_NUMBER_COERCE_MARKER(x) \
|
||||
|
||||
219
test/lisp/international/ccl-tests.el
Normal file
219
test/lisp/international/ccl-tests.el
Normal file
@ -0,0 +1,219 @@
|
||||
(require 'ert)
|
||||
(require 'ccl)
|
||||
(require 'seq)
|
||||
|
||||
|
||||
(ert-deftest shift ()
|
||||
;; shift left +ve 5628 #x00000000000015fc
|
||||
(should (= (ash 5628 8) 1440768)) ; #x000000000015fc00
|
||||
(should (= (lsh 5628 8) 1440768)) ; #x000000000015fc00
|
||||
|
||||
;; shift left -ve -5628 #x3fffffffffffea04
|
||||
(should (= (ash -5628 8) -1440768)) ; #x3fffffffffea0400
|
||||
(should (= (lsh -5628 8) -1440768)) ; #x3fffffffffea0400
|
||||
|
||||
;; shift right +ve 5628 #x00000000000015fc
|
||||
(should (= (ash 5628 -8) 21)) ; #x0000000000000015
|
||||
(should (= (lsh 5628 -8) 21)) ; #x0000000000000015
|
||||
|
||||
;; 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)
|
||||
))
|
||||
|
||||
;; CCl program from `pgg-parse-crc24' in lisp/obsolete/pgg-parse.el
|
||||
(defconst prog-pgg-source
|
||||
'(1
|
||||
((loop
|
||||
(read r0) (r1 ^= r0) (r2 ^= 0)
|
||||
(r5 = 0)
|
||||
(loop
|
||||
(r1 <<= 1)
|
||||
(r1 += ((r2 >> 15) & 1))
|
||||
(r2 <<= 1)
|
||||
(if (r1 & 256)
|
||||
((r1 ^= 390) (r2 ^= 19707)))
|
||||
(if (r5 < 7)
|
||||
((r5 += 1)
|
||||
(repeat))))
|
||||
(repeat)))))
|
||||
|
||||
(defconst prog-pgg-code
|
||||
[1 30 14 114744 114775 0 161 131127 1 148217 15 82167
|
||||
1 1848 131159 1 1595 5 256 114743 390 114775 19707
|
||||
1467 16 7 183 1 -5628 -7164 22])
|
||||
|
||||
(defconst prog-pgg-dump
|
||||
"Out-buffer must be as large as in-buffer.
|
||||
Main-body:
|
||||
2:[read-register] read r0 (0 remaining)
|
||||
3:[set-assign-expr-register] r1 ^= r0
|
||||
4:[set-assign-expr-const] r2 ^= 0
|
||||
6:[set-short-const] r5 = 0
|
||||
7:[set-assign-expr-const] r1 <<= 1
|
||||
9:[set-expr-const] r7 = r2 >> 15
|
||||
11:[set-assign-expr-const] r7 &= 1
|
||||
13:[set-assign-expr-register] r1 += r7
|
||||
14:[set-assign-expr-const] r2 <<= 1
|
||||
16:[jump-cond-expr-const] if !(r1 & 256), jump to 23(+7)
|
||||
19:[set-assign-expr-const] r1 ^= 390
|
||||
21:[set-assign-expr-const] r2 ^= 19707
|
||||
23:[jump-cond-expr-const] if !(r5 < 7), jump to 29(+6)
|
||||
26:[set-assign-expr-const] r5 += 1
|
||||
28:[jump] jump to 7(-21)
|
||||
29:[jump] jump to 2(-27)
|
||||
At EOF:
|
||||
30:[end] end
|
||||
")
|
||||
|
||||
(ert-deftest ccl-compile-pgg ()
|
||||
(should (equal (ccl-compile prog-pgg-source) prog-pgg-code)))
|
||||
|
||||
(ert-deftest ccl-dump-pgg ()
|
||||
(with-temp-buffer
|
||||
(ccl-dump prog-pgg-code)
|
||||
(should (equal (buffer-string) prog-pgg-dump))))
|
||||
|
||||
(ert-deftest pgg-parse-crc24 ()
|
||||
;; Compiler
|
||||
(require 'pgg)
|
||||
(should (equal pgg-parse-crc24 prog-pgg-code))
|
||||
;; Interpreter
|
||||
(should (equal (pgg-parse-crc24-string "foo") (concat [#x4f #xc2 #x55])))
|
||||
(should (equal (pgg-parse-crc24-string "bar") (concat [#x51 #xd9 #x53])))
|
||||
(should (equal (pgg-parse-crc24-string "baz") (concat [#xf0 #x58 #x6a]))))
|
||||
|
||||
(ert-deftest pgg-parse-crc24-dump ()
|
||||
;; Disassembler
|
||||
(require 'pgg)
|
||||
(with-temp-buffer
|
||||
(ccl-dump pgg-parse-crc24)
|
||||
(should (equal (buffer-string) prog-pgg-dump))))
|
||||
|
||||
;;----------------------------------------------------------------------------
|
||||
;; Program from 'midikbd-decoder in midi-kbd-0.2.el GNU ELPA package
|
||||
(defconst prog-midi-source
|
||||
'(2
|
||||
(loop
|
||||
(loop
|
||||
;; central message receiver loop here.
|
||||
;; When it exits, the command to deal with is in r0
|
||||
;; Any arguments are in r1 and r2
|
||||
;; r3 contains: 0 if no arguments are accepted
|
||||
;; 1 if 1 argument can be accepted
|
||||
;; 2 if 2 arguments can be accepted
|
||||
;; 3 if the first of two arguments has been accepted
|
||||
;; Arguments are read into r1 and r2.
|
||||
;; r4 contains the current running status byte if any.
|
||||
(read-if (r0 < #x80)
|
||||
(branch r3
|
||||
(repeat)
|
||||
((r1 = r0) (r0 = r4) (break))
|
||||
((r1 = r0) (r3 = 3) (repeat))
|
||||
((r2 = r0) (r3 = 2) (r0 = r4) (break))))
|
||||
(if (r0 >= #xf8) ; real time message
|
||||
(break))
|
||||
(if (r0 < #xf0) ; channel command
|
||||
((r4 = r0)
|
||||
(if ((r0 & #xe0) == #xc0)
|
||||
;; program change and channel pressure take only 1 argument
|
||||
(r3 = 1)
|
||||
(r3 = 2))
|
||||
(repeat)))
|
||||
;; system common message, we swallow those for now
|
||||
(r3 = 0)
|
||||
(repeat))
|
||||
(if ((r0 & #xf0) == #x90)
|
||||
(if (r2 == 0) ; Some Midi devices use velocity 0
|
||||
; for switching notes off,
|
||||
; so translate into note-off
|
||||
; and fall through
|
||||
(r0 -= #x10)
|
||||
((r0 &= #xf)
|
||||
(write 0)
|
||||
(write r0 r1 r2)
|
||||
(repeat))))
|
||||
(if ((r0 & #xf0) == #x80)
|
||||
((r0 &= #xf)
|
||||
(write 1)
|
||||
(write r0 r1 r2)
|
||||
(repeat)))
|
||||
(repeat))))
|
||||
|
||||
(defconst prog-midi-code
|
||||
[2 72 4893 16 128 1133 5 6 9 12 16 -2556 32 1024 6660 32 865
|
||||
-4092 64 609 1024 4868 795 20 248 3844 3099 16 240 128 82169
|
||||
224 1275 18 192 353 260 609 -9468 97 -9980 82169 240 4091
|
||||
18 144 1371 18 0 16407 16 1796 81943 15 20 529 305 81 -14588
|
||||
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.
|
||||
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:[jump] jump to 2(-9)
|
||||
12:[set-register] r1 = r0
|
||||
13:[set-register] r0 = r4
|
||||
14:[jump] jump to 41(+27)
|
||||
15:[set-register] r1 = r0
|
||||
16:[set-short-const] r3 = 3
|
||||
17:[jump] jump to 2(-15)
|
||||
18:[set-register] r2 = r0
|
||||
19:[set-short-const] r3 = 2
|
||||
20:[set-register] r0 = r4
|
||||
21:[jump] jump to 41(+20)
|
||||
22:[jump-cond-expr-const] if !(r0 >= 248), jump to 26(+4)
|
||||
25:[jump] jump to 41(+16)
|
||||
26:[jump-cond-expr-const] if !(r0 < 240), jump to 39(+13)
|
||||
29:[set-register] r4 = r0
|
||||
30:[set-expr-const] r7 = r0 & 224
|
||||
32:[jump-cond-expr-const] if !(r7 == 192), jump to 37(+5)
|
||||
35:[set-short-const] r3 = 1
|
||||
36:[jump] jump to 38(+2)
|
||||
37:[set-short-const] r3 = 2
|
||||
38:[jump] jump to 2(-36)
|
||||
39:[set-short-const] r3 = 0
|
||||
40:[jump] jump to 2(-38)
|
||||
41:[set-expr-const] r7 = r0 & 240
|
||||
43:[jump-cond-expr-const] if !(r7 == 144), jump to 59(+16)
|
||||
46:[jump-cond-expr-const] if !(r2 == 0), jump to 52(+6)
|
||||
49:[set-assign-expr-const] r0 -= 16
|
||||
51:[jump] jump to 59(+8)
|
||||
52:[set-assign-expr-const] r0 &= 15
|
||||
54:[write-const-string] write char \"\x00\"
|
||||
55:[write-register] write r0 (2 remaining)
|
||||
56:[write-register] write r1 (1 remaining)
|
||||
57:[write-register] write r2 (0 remaining)
|
||||
58:[jump] jump to 2(-56)
|
||||
59:[set-expr-const] r7 = r0 & 240
|
||||
61:[jump-cond-expr-const] if !(r7 == 128), jump to 71(+10)
|
||||
64:[set-assign-expr-const] r0 &= 15
|
||||
66:[write-const-string] write char \"\x01\"
|
||||
67:[write-register] write r0 (2 remaining)
|
||||
68:[write-register] write r1 (1 remaining)
|
||||
69:[write-register] write r2 (0 remaining)
|
||||
70:[jump] jump to 2(-68)
|
||||
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)))
|
||||
|
||||
(ert-deftest ccl-dump-midi ()
|
||||
(with-temp-buffer
|
||||
(ccl-dump prog-midi-code)
|
||||
(should (equal (buffer-string) prog-midi-dump))))
|
||||
Loading…
Reference in New Issue
Block a user