Mercurial > hg > xemacs-beta

diff src/bytecode.c @ 563:183866b06e0b

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
[xemacs-hg @ 2001-05-24 07:50:48 by ben] Makefile.in.in, abbrev.c, alloc.c, buffer.c, bytecode.c, callint.c, callproc.c, casetab.c, chartab.c, cmdloop.c, cmds.c, console-msw.c, console-msw.h, console-stream.c, console-tty.c, console-x.c, console.c, data.c, database.c, debug.c, device-gtk.c, device-msw.c, device-tty.c, device-x.c, device.c, dialog-gtk.c, dialog-msw.c, dialog-x.c, dialog.c, dired-msw.c, dired.c, doc.c, doprnt.c, dragdrop.c, editfns.c, eldap.c, eldap.h, elhash.c, emacs-widget-accessors.c, emacs.c, emodules.c, esd.c, eval.c, event-Xt.c, event-gtk.c, event-msw.c, event-stream.c, events.c, extents.c, faces.c, file-coding.c, fileio.c, filelock.c, floatfns.c, fns.c, font-lock.c, frame-gtk.c, frame-x.c, frame.c, general-slots.h, glade.c, glyphs-gtk.c, glyphs-msw.c, glyphs-widget.c, glyphs-x.c, glyphs.c, glyphs.h, gpmevent.c, gui-gtk.c, gui-x.c, gui.c, gutter.c, hpplay.c, indent.c, input-method-xlib.c, insdel.c, intl.c, keymap.c, libsst.c, libsst.h, linuxplay.c, lisp.h, lread.c, lstream.c, lstream.h, macros.c, marker.c, md5.c, menubar-gtk.c, menubar-msw.c, menubar-x.c, menubar.c, minibuf.c, miscplay.c, miscplay.h, mule-ccl.c, mule-charset.c, mule-wnnfns.c, mule.c, nas.c, ntplay.c, ntproc.c, objects-gtk.c, objects-msw.c, objects-x.c, objects.c, postgresql.c, print.c, process-nt.c, process-unix.c, process.c, ralloc.c, rangetab.c, redisplay.c, scrollbar.c, search.c, select-gtk.c, select-x.c, select.c, sgiplay.c, sheap.c, sound.c, specifier.c, sunplay.c, symbols.c, symeval.h, symsinit.h, syntax.c, sysdep.c, toolbar-msw.c, toolbar.c, tooltalk.c, ui-byhand.c, ui-gtk.c, undo.c, unexaix.c, unexapollo.c, unexconvex.c, unexec.c, widget.c, win32.c, window.c: -- defsymbol -> DEFSYMBOL. -- add an error type to all errors. -- eliminate the error functions in eval.c that let you just use Qerror as the type. -- redo the error API to be more consistent, sensibly named, and easier to use. -- redo the error hierarchy somewhat. create new errors: structure-formation-error, gui-error, invalid-constant, stack-overflow, out-of-memory, process-error, network-error, sound-error, printing-unreadable-object, base64-conversion- error; coding-system-error renamed to text-conversion error; some others. -- fix Mule problems in error strings in emodules.c, tooltalk.c. -- fix error handling in mswin open-network-stream. -- Mule-ize all sound files and clean up the headers. -- nativesound.h -> sound.h and used for all sound files. -- move some shared stuff into glyphs-shared.c: first attempt at eliminating some of the massive GTK code duplication. xemacs.mak: add glyphs-shared.c. xemacs-faq.texi: document how to debug X errors subr.el: fix doc string to reflect reality
author ben
date Thu, 24 May 2001 07:51:33 +0000
parents 576fb035e263
children 13e3d7ae7155
line wrap: on
line diff
--- a/src/bytecode.c	Thu May 24 06:30:21 2001 +0000
+++ b/src/bytecode.c	Thu May 24 07:51:33 2001 +0000
@@ -211,8 +211,6 @@
 typedef unsigned char Opbyte;
 
 
-static void invalid_byte_code_error (char *error_message, ...);
-
 Lisp_Object * execute_rare_opcode (Lisp_Object *stack_ptr,
 				   const Opbyte *program_ptr,
 				   Opcode opcode);
@@ -634,9 +632,9 @@
       REGISTER Opcode opcode = (Opcode) READ_UINT_1;
 #ifdef ERROR_CHECK_BYTE_CODE
       if (stack_ptr > stack_end)
-	invalid_byte_code_error ("byte code stack overflow");
+	stack_overflow ("byte code stack overflow", Qunbound);
       if (stack_ptr < stack_beg)
-	invalid_byte_code_error ("byte code stack underflow");
+	stack_overflow ("byte code stack underflow", Qunbound);
 #endif
 
 #ifdef BYTE_CODE_METER
@@ -842,7 +840,7 @@
 #ifdef ERROR_CHECK_BYTE_CODE
 	  /* Binds and unbinds are supposed to be compiled balanced.  */
 	  if (specpdl_depth() != speccount)
-	    invalid_byte_code_error ("unbalanced specbinding stack");
+	    invalid_byte_code ("unbalanced specbinding stack", Qunbound);
 #endif
 	  return TOP;
 
@@ -1481,20 +1479,10 @@
 }
 
 
-static void
-invalid_byte_code_error (char *error_message, ...)
+DOESNT_RETURN
+invalid_byte_code (const char *reason, Lisp_Object frob)
 {
-  Lisp_Object obj;
-  va_list args;
-  char *buf = alloca_array (char, strlen (error_message) + 128);
-
-  sprintf (buf, "%s", error_message);
-  va_start (args, error_message);
-  obj = emacs_doprnt_string_va ((const Bufbyte *) GETTEXT (buf), Qnil, -1,
-				args);
-  va_end (args);
-
-  signal_error (Qinvalid_byte_code, list1 (obj));
+  signal_error (Qinvalid_byte_code, reason, frob);
 }
 
 /* Check for valid opcodes.  Change this when adding new opcodes.  */
@@ -1504,8 +1492,8 @@
   if ((opcode < Bvarref) ||
       (opcode == 0251)   ||
       (opcode > Bassq && opcode < Bconstant))
-    invalid_byte_code_error
-      ("invalid opcode %d in instruction stream", opcode);
+    invalid_byte_code ("invalid opcode in instruction stream",
+		       make_int (opcode));
 }
 
 /* Check that IDX is a valid offset into the `constants' vector */
@@ -1513,19 +1501,20 @@
 check_constants_index (int idx, Lisp_Object constants)
 {
   if (idx < 0 || idx >= XVECTOR_LENGTH (constants))
-    invalid_byte_code_error
-      ("reference %d to constants array out of range 0, %d",
+    signal_ferror
+      (Qinvalid_byte_code,
+       "reference %d to constants array out of range 0, %ld",
        idx, XVECTOR_LENGTH (constants) - 1);
 }
 
 /* Get next character from Lisp instructions string. */
-#define READ_INSTRUCTION_CHAR(lvalue) do {		\
-  (lvalue) = charptr_emchar (ptr);			\
-  INC_CHARPTR (ptr);					\
-  *icounts_ptr++ = program_ptr - program;		\
-  if (lvalue > UCHAR_MAX)				\
-    invalid_byte_code_error				\
-      ("Invalid character %c in byte code string");	\
+#define READ_INSTRUCTION_CHAR(lvalue) do {				\
+  (lvalue) = charptr_emchar (ptr);					\
+  INC_CHARPTR (ptr);							\
+  *icounts_ptr++ = program_ptr - program;				\
+  if (lvalue > UCHAR_MAX)						\
+    invalid_byte_code							\
+      ("Invalid character in byte code string", make_char (lvalue));	\
 } while (0)
 
 /* Get opcode from Lisp instructions string. */
@@ -1653,10 +1642,9 @@
 	  check_constants_index (arg, constants);
 	   val = XVECTOR_DATA (constants) [arg];
 	   if (!SYMBOLP (val))
-	     invalid_byte_code_error ("variable reference to non-symbol %S", val);
+	     invalid_byte_code ("variable reference to non-symbol", val);
 	   if (EQ (val, Qnil) || EQ (val, Qt) || (SYMBOL_IS_KEYWORD (val)))
-	     invalid_byte_code_error ("variable reference to constant symbol %s",
-				      string_data (XSYMBOL (val)->name));
+	     invalid_byte_code ("variable reference to constant symbol", val);
 	   WRITE_NARGS (Bvarref);
 	   break;
 
@@ -1669,10 +1657,9 @@
 	  check_constants_index (arg, constants);
 	  val = XVECTOR_DATA (constants) [arg];
 	  if (!SYMBOLP (val))
-	    invalid_byte_code_error ("attempt to set non-symbol %S", val);
+	    wtaerror ("attempt to set non-symbol", val);
 	  if (EQ (val, Qnil) || EQ (val, Qt))
-	    invalid_byte_code_error ("attempt to set constant symbol %s",
-				     string_data (XSYMBOL (val)->name));
+	    signal_error (Qsetting_constant, 0, val);
 	  /* Ignore assignments to keywords by converting to Bdiscard.
 	     For backward compatibility only - we'd like to make this an error.  */
 	  if (SYMBOL_IS_KEYWORD (val))
@@ -1691,10 +1678,10 @@
 	  check_constants_index (arg, constants);
 	  val = XVECTOR_DATA (constants) [arg];
 	  if (!SYMBOLP (val))
-	    invalid_byte_code_error ("attempt to let-bind non-symbol %S", val);
+	    wtaerror ("attempt to let-bind non-symbol", val);
 	  if (EQ (val, Qnil) || EQ (val, Qt) || (SYMBOL_IS_KEYWORD (val)))
-	    invalid_byte_code_error ("attempt to let-bind constant symbol %s",
-				     string_data (XSYMBOL (val)->name));
+	    signal_error (Qsetting_constant,
+			  "attempt to let-bind constant symbol", val);
 	  WRITE_NARGS (Bvarbind);
 	  break;
 
@@ -1740,8 +1727,7 @@
 	  jumps_ptr->to   = jumps_ptr->from + arg;
 	  jumps_ptr++;
 	  if (arg >= -1 && arg <= argsize)
-	    invalid_byte_code_error
-	      ("goto instruction is its own target");
+	    invalid_byte_code ("goto instruction is its own target", Qunbound);
 	  if (arg <= SCHAR_MIN ||
 	      arg >  SCHAR_MAX)
 	    {
@@ -2347,7 +2333,8 @@
     {
       Lisp_Object tem = read_doc_string (f->instructions);
       if (!CONSP (tem))
-	signal_simple_error ("Invalid lazy-loaded byte code", tem);
+	signal_error (Qinvalid_byte_code,
+			   "Invalid lazy-loaded byte code", tem);
       /* v18 or v19 bytecode file.  Need to Ebolify. */
       if (f->flags.ebolified && VECTORP (XCDR (tem)))
 	ebolify_bytecode_constants (XCDR (tem));
@@ -2412,8 +2399,8 @@
   INIT_LRECORD_IMPLEMENTATION (compiled_function);
 
   DEFERROR_STANDARD (Qinvalid_byte_code, Qinvalid_state);
-  defsymbol (&Qbyte_code, "byte-code");
-  defsymbol (&Qcompiled_functionp, "compiled-function-p");
+  DEFSYMBOL (Qbyte_code);
+  DEFSYMBOL_MULTIWORD_PREDICATE (Qcompiled_functionp);
 
   DEFSUBR (Fbyte_code);
   DEFSUBR (Ffetch_bytecode);
@@ -2432,7 +2419,7 @@
 #endif
 
 #ifdef BYTE_CODE_METER
-  defsymbol (&Qbyte_code_meter, "byte-code-meter");
+  DEFSYMBOL (Qbyte_code_meter);
 #endif
 }