From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!.POSTED!not-for-mail From: Andy Moreton Newsgroups: gmane.emacs.devel Subject: Re: bignum branch Date: Fri, 03 Aug 2018 01:43:17 +0100 Message-ID: <861sbgz3dm.fsf@gmail.com> References: <87o9fbbw1t.fsf@tromey.com> <86in5jdj49.fsf@gmail.com> <83wotxaiwi.fsf@gnu.org> <86k1pxmvmx.fsf@gmail.com> <87efg4a9xc.fsf@tromey.com> <87a7qr8cz7.fsf@tromey.com> <86tvoy3je9.fsf@gmail.com> <86bmb0vbxf.fsf@gmail.com> <87k1pnfcg1.fsf@tromey.com> <86sh4b1833.fsf@gmail.com> NNTP-Posting-Host: blaine.gmane.org Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" X-Trace: blaine.gmane.org 1533256905 6325 195.159.176.226 (3 Aug 2018 00:41:45 GMT) X-Complaints-To: usenet@blaine.gmane.org NNTP-Posting-Date: Fri, 3 Aug 2018 00:41:45 +0000 (UTC) User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/26.1.50 (windows-nt) To: emacs-devel@gnu.org Original-X-From: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Fri Aug 03 02:41:41 2018 Return-path: Envelope-to: ged-emacs-devel@m.gmane.org Original-Received: from lists.gnu.org ([208.118.235.17]) by blaine.gmane.org with esmtp (Exim 4.84_2) (envelope-from ) id 1flO9z-0001XZ-KL for ged-emacs-devel@m.gmane.org; Fri, 03 Aug 2018 02:41:39 +0200 Original-Received: from localhost ([::1]:48408 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1flOC6-0001kS-9f for ged-emacs-devel@m.gmane.org; Thu, 02 Aug 2018 20:43:50 -0400 Original-Received: from eggs.gnu.org ([2001:4830:134:3::10]:54164) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1flOBt-0001kA-G4 for emacs-devel@gnu.org; Thu, 02 Aug 2018 20:43:39 -0400 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1flOBo-0003mI-Hp for emacs-devel@gnu.org; Thu, 02 Aug 2018 20:43:37 -0400 Original-Received: from [195.159.176.226] (port=36891 helo=blaine.gmane.org) by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_128_CBC_SHA1:16) (Exim 4.71) (envelope-from ) id 1flOBo-0003jl-0K for emacs-devel@gnu.org; Thu, 02 Aug 2018 20:43:32 -0400 Original-Received: from list by blaine.gmane.org with local (Exim 4.84_2) (envelope-from ) id 1flO9c-0001CB-7w for emacs-devel@gnu.org; Fri, 03 Aug 2018 02:41:16 +0200 X-Injected-Via-Gmane: http://gmane.org/ Original-Lines: 587 Original-X-Complaints-To: usenet@blaine.gmane.org Cancel-Lock: sha1:r5qSwI4PwL9fjGQ1Dcx8vjJGS/s= X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.2.x-3.x [generic] [fuzzy] X-Received-From: 195.159.176.226 X-BeenThere: emacs-devel@gnu.org X-Mailman-Version: 2.1.21 Precedence: list List-Id: "Emacs development discussions." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Original-Sender: "Emacs-devel" Xref: news.gmane.org gmane.emacs.devel:228113 Archived-At: --=-=-= Content-Type: text/plain On Sun 22 Jul 2018, Andy Moreton wrote: > On Sun 22 Jul 2018, Tom Tromey wrote: > >>>>>>> "Andy" == Andy Moreton writes: >> >> Andy> I think the following patch fixes the issues in CCL (compiler, >> Andy> interpreter and disassembler). It truncates the compiled CCL code words >> Andy> to 28 bits and then sign extends to ensure that the interpreter sees >> Andy> signed values of constants (stored at the upper end of the code word). >> >> Would you mind pushing this to the bignum branch? >> If it's inconvenient, let me know and I will do it. > > I've done some more testing with the CCl program in the midi-kbd ELPA > package, and that shows that the patch is not correct. > > I'll report back when I get it working on master and on the bignum > branch. The problems I reported with markers make debugging awkward on > the bignum branch. After a lot more testing, I have a somewhat scruffy patch that works in the following emacs builds on unpatched master, and on patched bignum branch: - cygwin 64bit (LP64 model) - mingw64 msys2 32bit - mingw64 msys2 64bit (LLP64 model) The patch contains changes for: - fix CCL to ensure it uses 28biut codewords properly in bignum build - ensure make_number creates fixnums in LLP64 builds - fix bugnumcompare for LLP64 builds - fix arith_driver to handle markers correctly - fix arith_driver operations for LLP64 builds (more testing needed) - fix float_arith_driver to allow bignums - fix ash_lsh_impl to produce correct results in bignum build - fix NUMBERP to remove redundant BIGNUMP test (ensured by INTEGERP) The patch has been tested with the attached ccl-tests.el ERT tests to check that ash/lsh shifts behave properly, and that the CCL machinery uses its 28bit codewords correctly in a bignum build. Please check this works for you, and feel free to commit it to the bignum branch. AndyM --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=bignum-fixes-working.patch Content-Description: Bignum support fixes diff --git a/lisp/international/ccl.el b/lisp/international/ccl.el index d2f490d59c..3529dd9c30 100644 --- a/lisp/international/ccl.el +++ b/lisp/international/ccl.el @@ -184,11 +184,15 @@ ccl-program-vector (defvar ccl-current-ic 0 "The current index for `ccl-program-vector'.") +(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 +200,7 @@ ccl-embed-data (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 +234,8 @@ ccl-embed-current-address `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 +991,8 @@ ccl-dump (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 () diff --git a/src/alloc.c b/src/alloc.c index 1dc1bbb031..4c794048be 100644 --- a/src/alloc.c +++ b/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 diff --git a/src/data.c b/src/data.c index 0deebdca1a..6ca868a938 100644 --- a/src/data.c +++ b/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,18 @@ 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 +2879,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 +2890,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 +2915,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 +2931,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 +2958,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 +3033,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 +3329,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 +3366,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 +3379,19 @@ 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 +3473,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 { diff --git a/src/lisp.h b/src/lisp.h index 4208634fa9..b404f9d89a 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -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) \ --=-=-= Content-Type: application/emacs-lisp Content-Disposition: attachment; filename=ccl-tests.el Content-Transfer-Encoding: quoted-printable Content-Description: Tests for bignum support and CCL fixes (require 'ert) (require 'ccl) (require 'seq) (ert-deftest shift () ;; shift left +ve 5628 #x00000000000015fc (should (=3D (ash 5628 8) 1440768)) ; #x000000000015fc00 (should (=3D (lsh 5628 8) 1440768)) ; #x000000000015fc00 ;; shift left -ve -5628 #x3fffffffffffea04 (should (=3D (ash -5628 8) -1440768)) ; #x3fffffffffea0400 (should (=3D (lsh -5628 8) -1440768)) ; #x3fffffffffea0400 ;; shift right +ve 5628 #x00000000000015fc (should (=3D (ash 5628 -8) 21)) ; #x0000000000000015 (should (=3D (lsh 5628 -8) 21)) ; #x0000000000000015 ;; shift right -ve -5628 #x3fffffffffffea04 (should (=3D (ash -5628 -8) -22)) ; #x3fffffffffffffea ;; shift right -5628 #x3fffffffffffea04 (cond ((fboundp 'bignump) (should (=3D (lsh -5628 -8) -22))) ; #x3fffffffffffffea big= num ((=3D (logb most-negative-fixnum) 61) (should (=3D (lsh -5628 -8) (string-to-number "18014398509481962")))) ; #x003fffffffffffea maste= r (64bit) ((=3D (logb most-negative-fixnum) 29) (should (=3D (lsh -5628 -8) 4194282))) ; #x003fffea mas= ter (32bit) )) ;; CCl program from `pgg-parse-crc24' in lisp/obsolete/pgg-parse.el (defconst prog-pgg-source '(1=20=20=20=20=20 ((loop (read r0) (r1 ^=3D r0) (r2 ^=3D 0) (r5 =3D 0) (loop (r1 <<=3D 1) (r1 +=3D ((r2 >> 15) & 1)) (r2 <<=3D 1) (if (r1 & 256) ((r1 ^=3D 390) (r2 ^=3D 19707))) (if (r5 < 7) ((r5 +=3D 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 ^=3D r0 4:[set-assign-expr-const] r2 ^=3D 0 6:[set-short-const] r5 =3D 0 7:[set-assign-expr-const] r1 <<=3D 1 9:[set-expr-const] r7 =3D r2 >> 15 11:[set-assign-expr-const] r7 &=3D 1 13:[set-assign-expr-register] r1 +=3D r7 14:[set-assign-expr-const] r2 <<=3D 1 16:[jump-cond-expr-const] if !(r1 & 256), jump to 23(+7) 19:[set-assign-expr-const] r1 ^=3D 390 21:[set-assign-expr-const] r2 ^=3D 19707 23:[jump-cond-expr-const] if !(r5 < 7), jump to 29(+6) 26:[set-assign-expr-const] r5 +=3D 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 =3D r0) (r0 =3D r4) (break)) ((r1 =3D r0) (r3 =3D 3) (repeat)) ((r2 =3D r0) (r3 =3D 2) (r0 =3D r4) (break)))) (if (r0 >=3D #xf8) ; real time message (break)) (if (r0 < #xf0) ; channel command ((r4 =3D r0) (if ((r0 & #xe0) =3D=3D #xc0) ;; program change and channel pressure take only 1 argument (r3 =3D 1) (r3 =3D 2)) (repeat))) ;; system common message, we swallow those for now (r3 =3D 0) (repeat)) (if ((r0 & #xf0) =3D=3D #x90) (if (r2 =3D=3D 0) ; Some Midi devices use velocity 0 ; for switching notes off, ; so translate into note-off ; and fall through (r0 -=3D #x10) ((r0 &=3D #xf) (write 0) (write r0 r1 r2) (repeat)))) (if ((r0 & #xf0) =3D=3D #x80) ((r0 &=3D #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=20 11:[jump] jump to 2(-9) 12:[set-register] r1 =3D r0 13:[set-register] r0 =3D r4 14:[jump] jump to 41(+27) 15:[set-register] r1 =3D r0 16:[set-short-const] r3 =3D 3 17:[jump] jump to 2(-15) 18:[set-register] r2 =3D r0 19:[set-short-const] r3 =3D 2 20:[set-register] r0 =3D r4 21:[jump] jump to 41(+20) 22:[jump-cond-expr-const] if !(r0 >=3D 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 =3D r0 30:[set-expr-const] r7 =3D r0 & 224 32:[jump-cond-expr-const] if !(r7 =3D=3D 192), jump to 37(+5) 35:[set-short-const] r3 =3D 1 36:[jump] jump to 38(+2) 37:[set-short-const] r3 =3D 2 38:[jump] jump to 2(-36) 39:[set-short-const] r3 =3D 0 40:[jump] jump to 2(-38) 41:[set-expr-const] r7 =3D r0 & 240 43:[jump-cond-expr-const] if !(r7 =3D=3D 144), jump to 59(+16) 46:[jump-cond-expr-const] if !(r2 =3D=3D 0), jump to 52(+6) 49:[set-assign-expr-const] r0 -=3D 16 51:[jump] jump to 59(+8) 52:[set-assign-expr-const] r0 &=3D 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 =3D r0 & 240 61:[jump-cond-expr-const] if !(r7 =3D=3D 128), jump to 71(+10) 64:[set-assign-expr-const] r0 &=3D 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)))) --=-=-=--