Again, this improves performance on large buffers with characters of varying width, since #'marker-position is O(N). I would like to move to returning markers in #'max, #'min when all arguments are markers that point to the same buffer, but that’s a change in the documented behvaviour, so I don’t want to do it without a look at the code that uses these. (I suspect with an appropriate byte-compile-{max,min} that prints relevant forms only where, e.g. there’s no numeric constant and no (point-min) or so on in the args, and a compilation of the packages, it’ll be clear there won’t be actually many places the question arises.) Note that a with number types build, before 3bfcdeb65578 , interpreted #'max and #'min already returned markers, and we haven’t had any problems with that. See also the comments in the tests. It surprised me strongly that the markers weren’t preserved with changes that should have kept the same relative character count, but it’s a separate issue that needs separate investigation. APPROVE COMMIT SUPERSEDES 529b.1e1d.1fa24.3fa2(a)parhasard.net # HG changeset patch # User Aidan Kehoe <kehoea(a)parhasard.net&gt; # Date 1387103191 0 # Node ID ffc0c5a66ab16ee04acb86c6d26dc4d31fc34913 # Parent 3bfcdeb65578e17883ff14fb2b0463bf1a723d74 Be lazy converting markers to integers, bytecode_{arithcompare,arithop}(). src/ChangeLog addition: 2013-12-15 Aidan Kehoe <kehoea(a)parhasard.net&gt; * bytecode.c (bytecode_arithcompare): * bytecode.c (bytecode_arithop): Call promote_args_lazy () in these two functions, only converting markers to fixnums if absolutely necessary (since that is ON with large, mule buffers). * data.c (BIGNUM_CASE): * data.c (RATIO_CASE): * data.c (BIGFLOAT_CASE): * data.c (ARITHCOMPARE_MANY): Call promote_args_lazy () here too if WITH_NUMBER_TYPES is defined. We're not doing the equivalent with the non-NUMBER_TYPES code, but that's mostly fine, we are doing it in the bytecode. * number.h: * number.h (NUMBER_TYPES): * number.h (promote_args_lazy): Add this, returning LAZY_MARKER_T if both arguments are markers that point to the same buffer. tests/ChangeLog addition: 2013-12-15 Aidan Kehoe <kehoea(a)parhasard.net&gt; * automated/lisp-tests.el: Test arithmetic comparisons with markers, check the type of the returned values for #'min and #'max. diff -r 3bfcdeb65578 -r ffc0c5a66ab1 src/ChangeLog --- a/src/ChangeLog Sun Dec 15 09:57:28 2013 +0000 +++ b/src/ChangeLog Sun Dec 15 10:26:31 2013 +0000 ＠＠ -1,3 +1,25 ＠＠ +2013-12-15 Aidan Kehoe <kehoea(a)parhasard.net&gt; + + * bytecode.c (bytecode_arithcompare): + * bytecode.c (bytecode_arithop): + Call promote_args_lazy () in these two functions, only converting + markers to fixnums if absolutely necessary (since that is ON with + large, mule buffers). + + * data.c (BIGNUM_CASE): + * data.c (RATIO_CASE): + * data.c (BIGFLOAT_CASE): + * data.c (ARITHCOMPARE_MANY): + Call promote_args_lazy () here too if WITH_NUMBER_TYPES is defined. + We're not doing the equivalent with the non-NUMBER_TYPES code, but + that's mostly fine, we are doing it in the bytecode. + + * number.h: + * number.h (NUMBER_TYPES): + * number.h (promote_args_lazy): + Add this, returning LAZY_MARKER_T if both arguments are markers + that point to the same buffer. + 2013-12-15 Aidan Kehoe <kehoea(a)parhasard.net&gt; * data.c (Fmax): diff -r 3bfcdeb65578 -r ffc0c5a66ab1 src/bytecode.c --- a/src/bytecode.c Sun Dec 15 09:57:28 2013 +0000 +++ b/src/bytecode.c Sun Dec 15 10:26:31 2013 +0000 ＠＠ -287,25 +287,32 ＠＠ bytecode_arithcompare (Lisp_Object obj1, Lisp_Object obj2) { #ifdef WITH_NUMBER_TYPES - switch (promote_args (&obj1, &obj2)) + switch (promote_args_lazy (&obj1, &obj2)) { - case FIXNUM_T: + case LAZY_FIXNUM_T: { EMACS_INT ival1 = XREALFIXNUM (obj1), ival2 = XREALFIXNUM (obj2); return ival1 < ival2 ? -1 : ival1 > ival2 ? 1 : 0; } #ifdef HAVE_BIGNUM - case BIGNUM_T: + case LAZY_BIGNUM_T: return bignum_cmp (XBIGNUM_DATA (obj1), XBIGNUM_DATA (obj2)); #endif #ifdef HAVE_RATIO - case RATIO_T: + case LAZY_RATIO_T: return ratio_cmp (XRATIO_DATA (obj1), XRATIO_DATA (obj2)); #endif #ifdef HAVE_BIGFLOAT - case BIGFLOAT_T: + case LAZY_BIGFLOAT_T: return bigfloat_cmp (XBIGFLOAT_DATA (obj1), XBIGFLOAT_DATA (obj2)); #endif + case LAZY_MARKER_T: + { + Bytebpos ival1 = byte_marker_position (obj1); + Bytebpos ival2 = byte_marker_position (obj2); + return ival1 < ival2 ? -1 : ival1 > ival2 ? 1 : 0; + } + default: /* FLOAT_T */ { double dval1 = XFLOAT_DATA (obj1), dval2 = XFLOAT_DATA (obj2); ＠＠ -320,7 +327,19 ＠＠ if (FIXNUMP (obj1)) ival1 = XFIXNUM (obj1); else if (CHARP (obj1)) ival1 = XCHAR (obj1); - else if (MARKERP (obj1)) ival1 = marker_position (obj1); + else if (MARKERP (obj1)) + { + /* Handle markers specially, since #'marker-position can be O(N): */ + if (MARKERP (obj2) + && (XMARKER (obj1)->buffer == XMARKER (obj2)->buffer)) + { + Bytebpos ival1 = byte_marker_position (obj1); + Bytebpos ival2 = byte_marker_position (obj2); + return ival1 < ival2 ? -1 : ival1 > ival2 ? 1 : 0; + } + + ival1 = marker_position (obj1); + } else goto arithcompare_float; if (FIXNUMP (obj2)) ival2 = XFIXNUM (obj2); ＠＠ -365,9 +384,29 ＠＠ bytecode_arithop (Lisp_Object obj1, Lisp_Object obj2, Opcode opcode) { #ifdef WITH_NUMBER_TYPES - switch (promote_args (&obj1, &obj2)) + switch (promote_args_lazy (&obj1, &obj2)) { - case FIXNUM_T: + case LAZY_MARKER_T: + { + switch (opcode) + { + case Bmax: + return make_fixnum (marker_position + ((byte_marker_position (obj1) + < byte_marker_position (obj2)) ? + obj2 : obj1)); + case Bmin: + return make_fixnum (marker_position + ((byte_marker_position (obj1) + > byte_marker_position (obj2)) ? + obj2 : obj1)); + default: + obj1 = make_fixnum (marker_position (obj1)); + obj2 = make_fixnum (marker_position (obj2)); + /* FALLTHROUGH */ + } + } + case LAZY_FIXNUM_T: { EMACS_INT ival1 = XREALFIXNUM (obj1), ival2 = XREALFIXNUM (obj2); switch (opcode) ＠＠ -395,7 +434,7 ＠＠ return make_integer (ival1); } #ifdef HAVE_BIGNUM - case BIGNUM_T: + case LAZY_BIGNUM_T: switch (opcode) { case Bplus: ＠＠ -426,7 +465,7 ＠＠ return Fcanonicalize_number (make_bignum_bg (scratch_bignum)); #endif #ifdef HAVE_RATIO - case RATIO_T: + case LAZY_RATIO_T: switch (opcode) { case Bplus: ＠＠ -453,7 +492,7 ＠＠ return make_ratio_rt (scratch_ratio); #endif #ifdef HAVE_BIGFLOAT - case BIGFLOAT_T: + case LAZY_BIGFLOAT_T: bigfloat_set_prec (scratch_bigfloat, max (XBIGFLOAT_GET_PREC (obj1), XBIGFLOAT_GET_PREC (obj2))); switch (opcode) diff -r 3bfcdeb65578 -r ffc0c5a66ab1 src/data.c --- a/src/data.c Sun Dec 15 09:57:28 2013 +0000 +++ b/src/data.c Sun Dec 15 10:26:31 2013 +0000 ＠＠ -899,7 +899,7 ＠＠ #ifdef HAVE_BIGNUM #define BIGNUM_CASE(op) \ - case BIGNUM_T: \ + case LAZY_BIGNUM_T: \ if (!bignum_##op (XBIGNUM_DATA (obj1), XBIGNUM_DATA (obj2))) \ return Qnil; \ break; ＠＠ -909,7 +909,7 ＠＠ #ifdef HAVE_RATIO #define RATIO_CASE(op) \ - case RATIO_T: \ + case LAZY_RATIO_T: \ if (!ratio_##op (XRATIO_DATA (obj1), XRATIO_DATA (obj2))) \ return Qnil; \ break; ＠＠ -919,7 +919,7 ＠＠ #ifdef HAVE_BIGFLOAT #define BIGFLOAT_CASE(op) \ - case BIGFLOAT_T: \ + case LAZY_BIGFLOAT_T: \ if (!bigfloat_##op (XBIGFLOAT_DATA (obj1), XBIGFLOAT_DATA (obj2))) \ return Qnil; \ break; ＠＠ -936,24 +936,33 ＠＠ { \ obj1 = args[i - 1]; \ obj2 = args[i]; \ - switch (promote_args (&obj1, &obj2)) \ + switch (promote_args_lazy (&obj1, &obj2)) \ { \ - case FIXNUM_T: \ - if (!(XREALFIXNUM (obj1) c_op XREALFIXNUM (obj2))) \ + case LAZY_FIXNUM_T: \ + if (!(XREALFIXNUM (obj1) c_op XREALFIXNUM (obj2))) \ return Qnil; \ break; \ BIGNUM_CASE (op) \ RATIO_CASE (op) \ - case FLOAT_T: \ + case LAZY_FLOAT_T: \ if (!(XFLOAT_DATA (obj1) c_op XFLOAT_DATA (obj2))) \ return Qnil; \ break; \ BIGFLOAT_CASE (op) \ + case LAZY_MARKER_T: \ + if (!(byte_marker_position (obj1) c_op \ + byte_marker_position (obj2))) \ + return Qnil; \ + break; \ } \ } \ return Qt; \ } #else /* !WITH_NUMBER_TYPES */ +/* We don't convert markers lazily here, although we could. It's more + important that we do this lazily in bytecode, which is the case; see + bytecode_arithcompare(). + */ #define ARITHCOMPARE_MANY(c_op,op) \ { \ int_or_double iod1, iod2, *p = &iod1, *q = &iod2; \ diff -r 3bfcdeb65578 -r ffc0c5a66ab1 src/number.h --- a/src/number.h Sun Dec 15 09:57:28 2013 +0000 +++ b/src/number.h Sun Dec 15 10:26:31 2013 +0000 ＠＠ -373,11 +373,42 ＠＠ EXFUN (Fcanonicalize_number, 1); -enum number_type {FIXNUM_T, BIGNUM_T, RATIO_T, FLOAT_T, BIGFLOAT_T}; +#define NUMBER_TYPES(prefix) prefix##FIXNUM_T, prefix##BIGNUM_T, \ + prefix##RATIO_T, prefix##FLOAT_T, prefix##BIGFLOAT_T + +enum number_type { NUMBER_TYPES() }; +enum lazy_number_type { NUMBER_TYPES(LAZY_), LAZY_MARKER_T }; + +#undef NUMBER_TYPES extern enum number_type get_number_type (Lisp_Object); extern enum number_type promote_args (Lisp_Object *, Lisp_Object *); +/* promote_args() *always* converts a marker argument to a fixnum. + + Unfortunately, for a marker with byte position N, getting the (character) + marker position is O(N). Getting the character position isn't necessary + for bytecode_arithcompare() if two markers being compared are in the same + buffer, comparing the byte position is enough. + + Similarly, min and max don't necessarily need to have their arguments + converted from markers, though we have always promised up to this point + that the result is a fixnum rather than a marker, and that's what we're + continuing to do. */ + +DECLARE_INLINE_HEADER ( +enum lazy_number_type +promote_args_lazy (Lisp_Object *obj1, Lisp_Object *obj2)) +{ + if (MARKERP (*obj1) && MARKERP (*obj2) && + XMARKER (*obj1)->buffer == XMARKER (*obj2)->buffer) + { + return LAZY_MARKER_T; + } + + return (enum lazy_number_type) promote_args (obj1, obj2); +} + #ifdef WITH_NUMBER_TYPES DECLARE_INLINE_HEADER ( int diff -r 3bfcdeb65578 -r ffc0c5a66ab1 tests/ChangeLog --- a/tests/ChangeLog Sun Dec 15 09:57:28 2013 +0000 +++ b/tests/ChangeLog Sun Dec 15 10:26:31 2013 +0000 ＠＠ -1,3 +1,9 ＠＠ +2013-12-15 Aidan Kehoe <kehoea(a)parhasard.net&gt; + + * automated/lisp-tests.el: + Test arithmetic comparisons with markers, check the type of the + returned values for #'min and #'max. + 2013-09-15 Mats Lidell <matsl(a)xemacs.org&gt; * automated/files-tests.el: New file. Test new states in diff -r 3bfcdeb65578 -r ffc0c5a66ab1 tests/automated/lisp-tests.el --- a/tests/automated/lisp-tests.el Sun Dec 15 09:57:28 2013 +0000 +++ b/tests/automated/lisp-tests.el Sun Dec 15 10:26:31 2013 +0000 ＠＠ -3041,4 +3041,83 ＠＠ (macroexpand '(with-second-arguments))))) (with-both-arguments (list)))) +;; Test arithmetic comparisons of markers and operations on markers. Most +;; relevant with Mule, but also worth doing on non-Mule. +(let ((character (if (featurep 'mule) (decode-char 'ucs #x20ac) ?\xff)) + (translation (make-char-table 'generic)) + markers fixnums) + (macrolet + ((Assert-arith-equivalences (markers context) + `(progn + (Assert (apply #'> markers) + ,(concat "checking #'> correct with long arguments list, " + context)) + (Assert 0 ,context) + (Assert (apply #'< (reverse markers)) + ,(concat "checking #'< correct with long arguments list, " + context)) + (map-plist #'(lambda (object1 object2) + (Assert (> object1 object2) + ,(concat + "checking markers correctly ordered, >, " + context)) + (Assert (< object2 object1) + ,(concat + "checking markers correctly ordered, <, " + context))) + markers) + ;; OK, so up to this point there has been no need for byte-char + ;; conversion. The following requires it, though: + (map-plist #'(lambda (object1 object2) + (Assert + (= (max object1 object2) object1) + ,(concat + "checking max correct, two markers, " context)) + (Assert + (= (min object1 object2) object2) + ,(concat + "checking min, correct, two markers, " context)) + ;; It is probably reasonable to change this design + ;; decision. + (Assert + (fixnump (max object1 object2)) + ,(concat + "checking fixnum conversion as documented, max, " + context)) + (Assert + (fixnump (min object1 object2)) + ,(concat + "checking fixnum conversion as documented, min, " + context))) + markers)))) + (with-temp-buffer + (princ "hello there, in with-temp-buffer\n" (get-buffer "*scratch*")) + (loop for ii from 0 to 100 + do (progn + (insert " " character " " character " " character " " + character "\n") + (insert character) + (push (copy-marker (1- (point)) t) markers) + (insert ?\x20) + (push (copy-marker (1- (point)) t) markers))) + (Assert-arith-equivalences markers "with Euro sign") + ;; Save the markers as fixnum character positions: + (setq fixnums (mapcar #'marker-position markers)) + ;; Check that the equivalences work with the fixnums, while we + ;; have them: + (Assert-arith-equivalences fixnums "fixnums, with Euro sign") + ;; Now, transform the characters that may be problematic to ASCII, + ;; check our equivalences still hold. + (put-char-table character ?\x7f translation) + (translate-region (point-min) (point-max) translation) + ;; Sigh, restore the markers #### shouldn't the insertion and + ;; deletion code do this?! + (map nil #'set-marker markers fixnums) + (Assert-arith-equivalences markers "without Euro sign") + ;; Restore the problematic character. + (put-char-table ?\x7f character translation) + (translate-region (point-min) (point-max) translation) + (map nil #'set-marker markers fixnums) + (Assert-arith-equivalences markers "with Euro sign restored")))) + ;;; end of lisp-tests.el -- ‘Liston operated so fast that he once accidentally amputated an assistant’s fingers along with a patient’s leg, […] The patient and the assistant both died of sepsis, and a spectator reportedly died of shock, resulting in the only known procedure with a 300% mortality.’ (Atul Gawande, NEJM, 2012) _______________________________________________ XEmacs-Patches mailing list XEmacs-Patches(a)xemacs.org http://lists.xemacs.org/mailman/listinfo/xemacs-patches