#include "opaque.h"
#include "syntax.h"
-#include <stddef.h>
#include <limits.h>
EXFUN (Ffetch_bytecode, 1);
extern Lisp_Object Qand_rest, Qand_optional;
-/* Define ERROR_CHECK_BYTE_CODE to enable some minor sanity checking.
- Useful for debugging the byte compiler. */
-#ifdef DEBUG_XEMACS
-#define ERROR_CHECK_BYTE_CODE
-#endif
-
/* Define BYTE_CODE_METER to enable generation of a byte-op usage histogram.
This isn't defined in FSF Emacs and isn't defined in XEmacs v19. */
/* #define BYTE_CODE_METER */
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 */
{
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;
#ifdef LISP_FLOAT_TYPE
{
- int ival1, ival2;
+ EMACS_INT ival1, ival2;
if (INTP (obj1)) ival1 = XINT (obj1);
else if (CHARP (obj1)) ival1 = XCHAR (obj1);
}
#else /* !LISP_FLOAT_TYPE */
{
- int ival1, ival2;
+ EMACS_INT ival1, ival2;
if (INTP (obj1)) ival1 = XINT (obj1);
else if (CHARP (obj1)) ival1 = XCHAR (obj1);
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:
return make_float (dval1);
}
#else /* !LISP_FLOAT_TYPE */
- int ival1, ival2;
+ EMACS_INT ival1, ival2;
retry:
f->stack_depth,
XVECTOR_DATA (f->constants));
- UNBIND_TO_GCPRO_VARIABLES_ONLY (speccount, value);
+ /* The attempt to optimize this by only unbinding variables failed
+ because using buffer-local variables as function parameters
+ leads to specpdl_ptr->func != 0 */
+ /* UNBIND_TO_GCPRO_VARIABLES_ONLY (speccount, value); */
+ UNBIND_TO_GCPRO (speccount, value);
return value;
}
#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)
opcode == Bunbind+6 ? READ_UINT_1 : READ_UINT_2));
break;
+
case Bgoto:
JUMP;
break;
}
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;
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;
}
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;
}
break;
}
-
case Bset:
{
Lisp_Object arg = POP;
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));
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;
internal_hash (f->constants, depth + 1));
}
+static const struct lrecord_description compiled_function_description[] = {
+ { XD_LISP_OBJECT, offsetof(struct Lisp_Compiled_Function, instructions), 4 },
+#ifdef COMPILED_FUNCTION_ANNOTATION_HACK
+ { XD_LISP_OBJECT, offsetof(struct Lisp_Compiled_Function, annotated), 1 },
+#endif
+ { XD_END }
+};
+
DEFINE_BASIC_LRECORD_IMPLEMENTATION ("compiled-function", compiled_function,
mark_compiled_function,
print_compiled_function, 0,
compiled_function_equal,
compiled_function_hash,
+ compiled_function_description,
Lisp_Compiled_Function);
\f
DEFUN ("compiled-function-p", Fcompiled_function_p, 1, 1, 0, /*
if (OPAQUEP (f->instructions) || STRINGP (f->instructions))
return function;
- if (CONSP (XCOMPILED_FUNCTION (function)->instructions))
+ if (CONSP (f->instructions))
{
Lisp_Object tem = read_doc_string (f->instructions);
if (!CONSP (tem))
/* 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 ();
projects / chise / xemacs-chise.git.1 / blobdiff