Mercurial > hg > xemacs-beta

changeset 5769:ffc0c5a66ab1

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Be lazy converting markers to integers, bytecode_{arithcompare,arithop}(). src/ChangeLog addition: 2013-12-15 Aidan Kehoe <kehoea@parhasard.net> * 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@parhasard.net> * automated/lisp-tests.el: Test arithmetic comparisons with markers, check the type of the returned values for #'min and #'max.
author Aidan Kehoe <kehoea@parhasard.net>
date Sun, 15 Dec 2013 10:26:31 +0000
parents 3bfcdeb65578
children f22989bb7632
files src/ChangeLog src/bytecode.c src/data.c src/number.h tests/ChangeLog tests/automated/lisp-tests.el
diffstat 6 files changed, 205 insertions(+), 19 deletions(-) [+]
line wrap: on
line diff
--- 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@parhasard.net>
+
+	* 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@parhasard.net>
 
 	* data.c (Fmax):
--- 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)
--- 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;		\
--- 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
--- 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@parhasard.net>
+
+	* 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@xemacs.org>
 
 	* automated/files-tests.el: New file. Test new states in
--- 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