XEmacs 21.2.20 "Yoko".
[chise/xemacs-chise.git.1] / src / bytecode.c
index 23f0b9f..8a685ab 100644 (file)
@@ -56,7 +56,6 @@ by Hallvard:
 #include "opaque.h"
 #include "syntax.h"
 
-#include <stddef.h>
 #include <limits.h>
 
 EXFUN (Ffetch_bytecode, 1);
@@ -236,21 +235,17 @@ extern Lisp_Object Qand_rest, Qand_optional;
 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 */
 
@@ -260,12 +255,12 @@ bytecode_negate (Lisp_Object obj)
 {
  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;
@@ -299,7 +294,7 @@ bytecode_arithcompare (Lisp_Object obj1, Lisp_Object obj2)
 
 #ifdef LISP_FLOAT_TYPE
   {
-    int ival1, ival2;
+    EMACS_INT ival1, ival2;
 
     if      (INTP    (obj1)) ival1 = XINT  (obj1);
     else if (CHARP   (obj1)) ival1 = XCHAR (obj1);
@@ -343,7 +338,7 @@ bytecode_arithcompare (Lisp_Object obj1, Lisp_Object obj2)
   }
 #else /* !LISP_FLOAT_TYPE */
   {
-    int ival1, ival2;
+    EMACS_INT ival1, ival2;
 
     if      (INTP    (obj1)) ival1 = XINT  (obj1);
     else if (CHARP   (obj1)) ival1 = XCHAR (obj1);
@@ -372,7 +367,7 @@ static Lisp_Object
 bytecode_arithop (Lisp_Object obj1, Lisp_Object obj2, Opcode opcode)
 {
 #ifdef LISP_FLOAT_TYPE
-  int ival1, ival2;
+  EMACS_INT ival1, ival2;
   int float_p;
 
  retry:
@@ -434,7 +429,7 @@ bytecode_arithop (Lisp_Object obj1, Lisp_Object obj2, Opcode opcode)
       return make_float (dval1);
     }
 #else /* !LISP_FLOAT_TYPE */
-  int ival1, ival2;
+  EMACS_INT ival1, ival2;
 
  retry:
 
@@ -644,7 +639,7 @@ execute_optimized_program (CONST Opbyte *program,
 #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)
@@ -761,6 +756,7 @@ execute_optimized_program (CONST Opbyte *program,
                      opcode == Bunbind+6 ? READ_UINT_1 : READ_UINT_2));
          break;
 
+
        case Bgoto:
          JUMP;
          break;
@@ -998,11 +994,11 @@ execute_optimized_program (CONST Opbyte *program,
          }
 
        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;
 
 
@@ -1056,7 +1052,7 @@ execute_optimized_program (CONST Opbyte *program,
            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;
          }
@@ -1066,7 +1062,7 @@ execute_optimized_program (CONST Opbyte *program,
            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;
          }
@@ -1109,7 +1105,6 @@ execute_optimized_program (CONST Opbyte *program,
            break;
          }
 
-
        case Bset:
          {
            Lisp_Object arg = POP;
@@ -1895,8 +1890,8 @@ optimize_compiled_function (Lisp_Object compiled_function)
                          program, &program_length, &varbind_count);
       f->specpdl_depth = XINT (Flength (f->arglist)) + varbind_count;
       f->instructions =
-       Fpurecopy (make_opaque (program_length * sizeof (Opbyte),
-                               (CONST void *) program));
+       make_opaque (program_length * sizeof (Opbyte),
+                    (CONST void *) program);
     }
 
   assert (OPAQUEP (f->instructions));
@@ -1982,15 +1977,15 @@ print_compiled_function (Lisp_Object obj, Lisp_Object printcharfun,
 
 
 static Lisp_Object
-mark_compiled_function (Lisp_Object obj, void (*markobj) (Lisp_Object))
+mark_compiled_function (Lisp_Object obj)
 {
   Lisp_Compiled_Function *f = XCOMPILED_FUNCTION (obj);
 
-  markobj (f->instructions);
-  markobj (f->arglist);
-  markobj (f->doc_and_interactive);
+  mark_object (f->instructions);
+  mark_object (f->arglist);
+  mark_object (f->doc_and_interactive);
 #ifdef COMPILED_FUNCTION_ANNOTATION_HACK
-  markobj (f->annotated);
+  mark_object (f->annotated);
 #endif
   /* tail-recurse on constants */
   return f->constants;
@@ -2351,10 +2346,8 @@ If the byte code for compiled function FUNCTION is lazy-loaded, fetch it now.
       /* v18 or v19 bytecode file.  Need to Ebolify. */
       if (f->flags.ebolified && VECTORP (XCDR (tem)))
        ebolify_bytecode_constants (XCDR (tem));
-      /* VERY IMPORTANT to purecopy here!!!!!
-        See load_force_doc_string_unwind. */
-      f->instructions = Fpurecopy (XCAR (tem));
-      f->constants    = Fpurecopy (XCDR (tem));
+      f->instructions = XCAR (tem);
+      f->constants    = XCDR (tem);
       return function;
     }
   abort ();