Making XEmacs a little faster
Unfortunately, I noticed in the gcc docs that gcc supports computed
gotos in C. It goes on to say this:
Another use of label values is in an interpreter for threaded code.
The labels within the interpreter function can be stored in the
threaded code for super-fast dispatching.
So, of course I had to try using it in bytecode.c. It does make
XEmacs faster, but not enough that it would be worth the annoyance of
severely obfuscating the code. So this experiment was mostly a waste
of time, albeit an instructive one.
On the way, I did find a couple of small optimizations that speed up
these lisp operations:
(+ x y)
(- x y)
(1+ x)
(1- x)
(- x)
1999-09-16 Martin Buchholz <martin(a)xemacs.org>
* lisp-union.h:
* lisp-disunion.h:
Define new, potentially faster INT arithmetic macros
INT_PLUS, INT_MINUS, INT_PLUS1, INT_MINUS1
* bytecode.c (execute_optimized_function):
Use new macros.
* (meter_code) Fix bitrotted metering code.
* bytecode.c (bytecode_negate):
Optimize for integer case.
Index: bytecode.c
===================================================================
RCS file: /usr/CVSroot/XEmacs/xemacs/src/bytecode.c,v
retrieving revision 1.13.2.7
diff -u -r1.13.2.7 bytecode.c
--- bytecode.c 1999/07/05 05:56:40 1.13.2.7
+++ bytecode.c 1999/09/17 01:52:55
＠＠ -235,21 +235,17 ＠＠
Lisp_Object Vbyte_code_meter, Qbyte_code_meter;
int byte_metering_on;
-#define METER_2(code1, code2) \
- XINT (XVECTOR_DATA (XVECTOR_DATA (Vbyte_code_meter)[(code1)])[(code2)])
-
-#define METER_1(code) METER_2 (0, (code))
-
-#define METER_CODE(last_code, this_code) do { \
- if (byte_metering_on) \
- { \
- if (METER_1 (this_code) != ((1<<VALBITS)-1)) \
- METER_1 (this_code)++; \
- if (last_code \
- && METER_2 (last_code, this_code) != ((1<<VALBITS)-1)) \
- METER_2 (last_code, this_code)++; \
- } \
-} while (0)
+static void
+meter_code (Opcode prev_opcode, Opcode this_opcode)
+{
+ if (byte_metering_on)
+ {
+ Lisp_Object *p = XVECTOR_DATA (XVECTOR_DATA (Vbyte_code_meter)[this_opcode]);
+ p[0] = INT_PLUS1 (p[0]);
+ if (prev_opcode)
+ p[prev_opcode] = INT_PLUS1 (p[prev_opcode]);
+ }
+}
#endif /* BYTE_CODE_METER */
＠＠ -259,12 +255,12 ＠＠
{
retry:
+ if (INTP (obj)) return make_int (- XINT (obj));
#ifdef LISP_FLOAT_TYPE
if (FLOATP (obj)) return make_float (- XFLOAT_DATA (obj));
#endif
if (CHARP (obj)) return make_int (- ((int) XCHAR (obj)));
if (MARKERP (obj)) return make_int (- ((int) marker_position (obj)));
- if (INTP (obj)) return make_int (- XINT (obj));
obj = wrong_type_argument (Qnumber_char_or_marker_p, obj);
goto retry;
＠＠ -643,7 +639,7 ＠＠
#ifdef BYTE_CODE_METER
prev_opcode = this_opcode;
this_opcode = opcode;
- METER_CODE (prev_opcode, this_opcode);
+ meter_code (prev_opcode, this_opcode);
#endif
switch (opcode)
＠＠ -760,6 +756,7 ＠＠
opcode == Bunbind+6 ? READ_UINT_1 : READ_UINT_2));
break;
+
case Bgoto:
JUMP;
break;
＠＠ -997,11 +994,11 ＠＠
}
case Bsub1:
- TOP = INTP (TOP) ? make_int (XINT (TOP) - 1) : Fsub1 (TOP);
+ TOP = INTP (TOP) ? INT_MINUS1 (TOP) : Fsub1 (TOP);
break;
case Badd1:
- TOP = INTP (TOP) ? make_int (XINT (TOP) + 1) : Fadd1 (TOP);
+ TOP = INTP (TOP) ? INT_PLUS1 (TOP) : Fadd1 (TOP);
break;
＠＠ -1055,7 +1052,7 ＠＠
Lisp_Object arg2 = POP;
Lisp_Object arg1 = TOP;
TOP = INTP (arg1) && INTP (arg2) ?
- make_int (XINT (arg1) + XINT (arg2)) :
+ INT_PLUS (arg1, arg2) :
bytecode_arithop (arg1, arg2, opcode);
break;
}
＠＠ -1065,7 +1062,7 ＠＠
Lisp_Object arg2 = POP;
Lisp_Object arg1 = TOP;
TOP = INTP (arg1) && INTP (arg2) ?
- make_int (XINT (arg1) - XINT (arg2)) :
+ INT_MINUS (arg1, arg2) :
bytecode_arithop (arg1, arg2, opcode);
break;
}
＠＠ -1107,7 +1104,6 ＠＠
TOP = Fmemq (TOP, arg);
break;
}
-
case Bset:
{
Index: lisp-disunion.h
===================================================================
RCS file: /usr/CVSroot/XEmacs/xemacs/src/lisp-disunion.h,v
retrieving revision 1.9.2.2
diff -u -r1.9.2.2 lisp-disunion.h
--- lisp-disunion.h 1999/04/22 07:27:23 1.9.2.2
+++ lisp-disunion.h 1999/09/17 01:52:55
＠＠ -87,6 +87,10 ＠＠
#define XREALINT(x) ((x) >> INT_GCBITS)
#define XUINT(x) ((EMACS_UINT)(x) >> INT_GCBITS)
#define INTP(x) ((EMACS_UINT)(x) & Lisp_Type_Int_Bit)
+#define INT_PLUS(x,y) ((x)+(y)-Lisp_Type_Int_Bit)
+#define INT_MINUS(x,y) ((x)-(y)+Lisp_Type_Int_Bit)
+#define INT_PLUS1(x) INT_PLUS (x, make_int (1))
+#define INT_MINUS1(x) INT_MINUS (x, make_int (1))
#define Qzero make_int (0)
#define Qnull_pointer ((Lisp_Object) 0)
Index: lisp-union.h
===================================================================
RCS file: /usr/CVSroot/XEmacs/xemacs/src/lisp-union.h,v
retrieving revision 1.8.2.2
diff -u -r1.8.2.2 lisp-union.h
--- lisp-union.h 1999/04/22 07:27:23 1.8.2.2
+++ lisp-union.h 1999/09/17 01:52:55
＠＠ -127,6 +127,11 ＠＠
#define EQ(x,y) ((x).v == (y).v)
#define INTP(x) ((x).s.bits)
+#define INT_PLUS(x,y) make_int (XINT (x) + XINT (y))
+#define INT_MINUS(x,y) make_int (XINT (x) - XINT (y))
+#define INT_PLUS1(x) make_int (XINT (x) + 1)
+#define INT_MINUS1(x) make_int (XINT (x) - 1)
+
#define GC_EQ(x,y) EQ (x, y)
/* Convert between a (void *) and a Lisp_Object, as when the