annotate src/bytecode.c @ 872:79c6ff3eef26

[xemacs-hg @ 2002-06-20 21:18:01 by ben] font changes etc.; some 21.4 changes mule/mule-msw-init-late.el: Specify charset->windows-registry conversion. mule/mule-x-init.el: Delete extra mule font additions here. Put them in faces.c. cl-macs.el: Document better. font-lock.el: Move Lisp function regexp to lisp-mode.el. lisp-mode.el: Various indentation fixes: Handle flet functions better. Handle argument lists in defuns and flets. Handle quoted lists, e.g. property lists -- don't indent like function calls. Distinguish between lambdas and other lists. lisp-mode.el: Handle this form. faces.el, font-menu.el, font.el, gtk-faces.el, msw-faces.el, msw-font-menu.el, x-faces.el, x-init.el: Major overhaul of face-handling code: -- Fix lots of bogus code in msw-faces.el, msw-font-menu.el, font-menu.el that was "truenaming" font specs -- i.e. in the process of frobbing a particular field in a general user-specified font spec with wildcarded fields, sticking in particular values for all the remaining wildcarded fields. This bug was rampant everywhere except in x-faces.el (the oldest and only correctly written code). This also means that we need to work with font names at all times and not font instances, because a font instance is essentially a truenamed font. -- Total rewrite of extremely junky code in msw-faces.el. Work with names as well as font instances, and return names; stop truenaming when canonicalizing and frobbing; fix handling of the combined style field, i.e. weight/slant (also fixed in font.el). -- Totally rewrite the frobbing functions in faces.el. This time, we frob all the instantiators rather than just computing a single instance value and working backwards. That way, e.g., `bold' will work for all charsets that have bold available, rather than only for whatever charset was part of the computed font instance (another example of the truename virus). Also fix up code to look at the fallbacks (all of them) when no global value present, so we don't need to put something in the global value. Intelligently handle a request to frob a buffer locale, rather than signalling an error. When frobbing instantiators, try hard to figure out what device type is associated with them, and frob each according to its own proper device type. Correctly handle inheritance vectors given as instantiators. Preserve existing tags when putting back frobbed instantiators. Extract out general specifier-frobbing code into specifier.el. Document everything cleanly. Do lots of other things better, etc. -- Don't duplicatively set a global specification for the default font -- it's already in the fallback and we no longer need a default global specification present. Delete various code in x-faces.el and msw-faces.el that duplicated the lists of fonts in faces.c. -- init-global-faces was not being called at all under MS Windows! Major bogosity. That caused device-specific values to get stuck into all the fonts, making it very hard to change them -- setting global specs caused nothing to happen. -- Correct weight names in font.el. -- Lots more font fixups in objects*.c. Printer.el: Warning fix. specifier.el: Add more args to map-specifier. Add various "heuristic" specifier functions to aid in creation of specifier-munging code such as in faces.el. subr.el: New functions. lwlib.c: Fix warning. config.inc.samp: Clean up, add args to control fastcall (not yet supported! the changes needed are in another ws of mine), profile support, vc6 support, union-type. xemacs.dsp, xemacs.mak: Semi-major overhaul. Fix bug where dump-id was always getting recomputed, forcing a redump even when nothing changed. Add support for fastcall. Support edit-and-continue (on by default) with vc6. Use incremental linking when doing a debug compilation. Add support for profiling. Consolidate the various debug flags. Partial support for "batch-compiling" -- compiling many files on a single invocation of the compiler. Doesn't seem to help that much for me, so it's not finished or enabled by default. Remove HAVE_MSW_C_DIRED, we always do. Correct some sloppy use of directories. s/cygwin32.h: Allow pdump to work under Cygwin (mmap is broken, so need to undefine HAVE_MMAP). s/win32-common.h, s/windowsnt.h: Support for fastcall. Add WIN32_ANY for identifying all Win32 variants (Cygwin, native, MinGW). Both of these are properly used in another ws. alloc.c, balloon-x.c, buffer.c, bytecode.c, callint.c, cm.c, cmdloop.c, cmds.c, console-gtk.c, console-gtk.h, console-msw.c, console-msw.h, console-stream.c, console-stream.h, console-tty.c, console-tty.h, console-x.c, console-x.h, console.c, console.h, device-gtk.c, device-msw.c, device-tty.c, device-x.c, device.c, device.h, devslots.h, dialog-gtk.c, dialog-msw.c, dialog-x.c, dialog.c, dired-msw.c, editfns.c, emacs.c, event-Xt.c, event-gtk.c, event-msw.c, event-stream.c, event-tty.c, event-unixoid.c, events.c, extents.c, extents.h, faces.c, fileio.c, fns.c, frame-gtk.c, frame-msw.c, frame-tty.c, frame-x.c, frame.c, frame.h, glyphs-eimage.c, glyphs-gtk.c, glyphs-msw.c, glyphs-widget.c, glyphs-x.c, glyphs.c, glyphs.h, gui-gtk.c, gui-msw.c, gui-x.c, gui.c, gutter.c, input-method-xlib.c, intl-encap-win32.c, intl-win32.c, keymap.c, lisp.h, macros.c, menubar-gtk.c, menubar-msw.c, menubar-x.c, menubar.c, menubar.h, minibuf.c, mule-charset.c, nt.c, objects-gtk.c, objects-gtk.h, objects-msw.c, objects-msw.h, objects-tty.c, objects-tty.h, objects-x.c, objects-x.h, objects.c, objects.h, postgresql.c, print.c, process.h, redisplay-gtk.c, redisplay-msw.c, redisplay-output.c, redisplay-tty.c, redisplay-x.c, redisplay.c, redisplay.h, scrollbar-gtk.c, scrollbar-msw.c, scrollbar-x.c, scrollbar.c, select-gtk.c, select-msw.c, select-x.c, select.c, signal.c, sound.c, specifier.c, symbols.c, syntax.c, sysdep.c, syssignal.h, syswindows.h, toolbar-common.c, toolbar-gtk.c, toolbar-msw.c, toolbar-x.c, toolbar.c, unicode.c, window.c, window.h: The following are the major changes made: (1) Separation of various header files into an external and an internal version, similar to the existing separation of process.h and procimpl.h. Eventually this should be done for all Lisp objects. The external version has the same name as currently; the internal adds -impl. The external file has XFOO() macros for objects, but the structure is opaque and defined only in the internal file. It's now reasonable to move all prototypes in lisp.h into the appropriate external file, and this should be done. Currently, separation has been done on extents.h, objects*.h, console.h, device.h, frame.h, and window.h. For c/d/f/w, the most basic properties are available in the external header file, with the macros resolving to functions. In the internal header file, the macros are redefined to directly access the structure. Also, the global MARK_FOO_CHANGED macros have been made into functions so that they can be accessed without needing to include lots of -impl headers -- they are used in almost exclusively in non-time-critical functions, and take up enough time that the function overhead will be negligible. Similarly, the function overhead from making the basic properties mentioned above into functions is negligible, and code that does heavy accessing of c/d/f/w structures inevitably ends up needing the internal header files, anyway. (2) More face changes. -- Major rewrite of objects-msw.c. Now handles wildcard specs properly, rather than "truenaming" (or even worse, signalling an error, which previously happened with some of the fallbacks if you tried to use them in make-font-instance!). -- Split charset matching of fonts into two stages -- one to find a font specifically designed for a particular charset (by examining its registry), the second to find a Unicode font that can support the charset. This needs to proceed as two complete, separate instantiations in order to work properly (otherwise many of the fonts in the HELLO page look wrong). This should also make it easy to support iso10646 (Unicode) fonts under X. -- All default values for fonts are now completely specified in the fallbacks. Stuff from mule-x-init.el has all been moved here, merged with the existing specs, and totally rethought so you get sensible results. (HELLO now looks much better!). -- Generalize the "default X/GTK device" stuff into a per-device-type "default device". -- Add mswindows-{set-}charset-registry. In time, charset<->code-page conversion functions will be removed. -- Wrap protective code around calls to compute device specifier tags, and do this computation before calling the face initialization code because the latter may need these tags to be correctly updated. (3) Other changes. EmacsFrame.c, glyphs-msw.c, eval.c, gui-x.c, intl-encap-win32.c, search.c, signal.c, toolbar-msw.c, unicode.c: Warning fixes. config.h.in: #undefs meant to be frobbed by configure *MUST* go inside of #ifndef WIN32_NO_CONFIGURE, and everything else *MUST* go outside! eval.c: Let detailed backtraces be detailed. specifier.c: Don't override user's print-string-length/print-length settings. glyphs.c: New function image-instance-instantiator. config.h.in, sysdep.c: Changes for fastcall. sysdep.c, nt.c: Fix up a previous botched patch that tried to add support for both EEXIST and EACCES. IF THE BOTCHED PATCH WENT INTO 21.4, THIS FIXUP NEEDS TO GO IN, TOO. search.c: Fix *evil* crash due to incorrect synching of syntax-cache code with 21.1. THIS SHOULD GO INTO 21.4.
author ben
date Thu, 20 Jun 2002 21:19:10 +0000
parents 804517e16990
children c925bacdda60
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1 /* Execution of byte code produced by bytecomp.el.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2 Implementation of compiled-function objects.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3 Copyright (C) 1992, 1993 Free Software Foundation, Inc.
814
a634e3b7acc8 [xemacs-hg @ 2002-04-14 12:41:59 by ben]
ben
parents: 801
diff changeset
4 Copyright (C) 1995, 2002 Ben Wing.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
6 This file is part of XEmacs.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
7
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
8 XEmacs is free software; you can redistribute it and/or modify it
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
9 under the terms of the GNU General Public License as published by the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
10 Free Software Foundation; either version 2, or (at your option) any
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
11 later version.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
12
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
13 XEmacs is distributed in the hope that it will be useful, but WITHOUT
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
14 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
15 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
16 for more details.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
17
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
18 You should have received a copy of the GNU General Public License
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
19 along with XEmacs; see the file COPYING. If not, write to
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
20 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
21 Boston, MA 02111-1307, USA. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
22
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
23 /* Synched up with: Mule 2.0, FSF 19.30. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
24
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
25 /* This file has been Mule-ized. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
26
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
27
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
28 /* Authorship:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
29
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
30 FSF: long ago.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
31
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
32 hacked on by jwz@jwz.org 1991-06
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
33 o added a compile-time switch to turn on simple sanity checking;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
34 o put back the obsolete byte-codes for error-detection;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
35 o added a new instruction, unbind_all, which I will use for
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
36 tail-recursion elimination;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
37 o made temp_output_buffer_show be called with the right number
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
38 of args;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
39 o made the new bytecodes be called with args in the right order;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
40 o added metering support.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
41
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
42 by Hallvard:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
43 o added relative jump instructions;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
44 o all conditionals now only do QUIT if they jump.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
45
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
46 Ben Wing: some changes for Mule, 1995-06.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
47
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
48 Martin Buchholz: performance hacking, 1998-09.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
49 See Internals Manual, Evaluation.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
50 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
51
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
52 #include <config.h>
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
53 #include "lisp.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
54 #include "backtrace.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
55 #include "buffer.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
56 #include "bytecode.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
57 #include "opaque.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
58 #include "syntax.h"
872
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 867
diff changeset
59 #include "window.h"
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
60
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
61 EXFUN (Ffetch_bytecode, 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
62
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
63 Lisp_Object Qbyte_code, Qcompiled_functionp, Qinvalid_byte_code;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
64
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
65 enum Opcode /* Byte codes */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
66 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
67 Bvarref = 010,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
68 Bvarset = 020,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
69 Bvarbind = 030,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
70 Bcall = 040,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
71 Bunbind = 050,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
72
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
73 Bnth = 070,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
74 Bsymbolp = 071,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
75 Bconsp = 072,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
76 Bstringp = 073,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
77 Blistp = 074,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
78 Bold_eq = 075,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
79 Bold_memq = 076,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
80 Bnot = 077,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
81 Bcar = 0100,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
82 Bcdr = 0101,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
83 Bcons = 0102,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
84 Blist1 = 0103,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
85 Blist2 = 0104,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
86 Blist3 = 0105,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
87 Blist4 = 0106,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
88 Blength = 0107,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
89 Baref = 0110,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
90 Baset = 0111,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
91 Bsymbol_value = 0112,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
92 Bsymbol_function = 0113,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
93 Bset = 0114,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
94 Bfset = 0115,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
95 Bget = 0116,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
96 Bsubstring = 0117,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
97 Bconcat2 = 0120,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
98 Bconcat3 = 0121,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
99 Bconcat4 = 0122,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
100 Bsub1 = 0123,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
101 Badd1 = 0124,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
102 Beqlsign = 0125,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
103 Bgtr = 0126,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
104 Blss = 0127,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
105 Bleq = 0130,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
106 Bgeq = 0131,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
107 Bdiff = 0132,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
108 Bnegate = 0133,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
109 Bplus = 0134,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
110 Bmax = 0135,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
111 Bmin = 0136,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
112 Bmult = 0137,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
113
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
114 Bpoint = 0140,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
115 Beq = 0141, /* was Bmark,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
116 but no longer generated as of v18 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
117 Bgoto_char = 0142,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
118 Binsert = 0143,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
119 Bpoint_max = 0144,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
120 Bpoint_min = 0145,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
121 Bchar_after = 0146,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
122 Bfollowing_char = 0147,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
123 Bpreceding_char = 0150,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
124 Bcurrent_column = 0151,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
125 Bindent_to = 0152,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
126 Bequal = 0153, /* was Bscan_buffer,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
127 but no longer generated as of v18 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
128 Beolp = 0154,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
129 Beobp = 0155,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
130 Bbolp = 0156,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
131 Bbobp = 0157,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
132 Bcurrent_buffer = 0160,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
133 Bset_buffer = 0161,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
134 Bsave_current_buffer = 0162, /* was Bread_char,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
135 but no longer generated as of v19 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
136 Bmemq = 0163, /* was Bset_mark,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
137 but no longer generated as of v18 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
138 Binteractive_p = 0164, /* Needed since interactive-p takes
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
139 unevalled args */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
140 Bforward_char = 0165,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
141 Bforward_word = 0166,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
142 Bskip_chars_forward = 0167,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
143 Bskip_chars_backward = 0170,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
144 Bforward_line = 0171,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
145 Bchar_syntax = 0172,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
146 Bbuffer_substring = 0173,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
147 Bdelete_region = 0174,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
148 Bnarrow_to_region = 0175,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
149 Bwiden = 0176,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
150 Bend_of_line = 0177,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
151
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
152 Bconstant2 = 0201,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
153 Bgoto = 0202,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
154 Bgotoifnil = 0203,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
155 Bgotoifnonnil = 0204,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
156 Bgotoifnilelsepop = 0205,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
157 Bgotoifnonnilelsepop = 0206,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
158 Breturn = 0207,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
159 Bdiscard = 0210,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
160 Bdup = 0211,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
161
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
162 Bsave_excursion = 0212,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
163 Bsave_window_excursion= 0213,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
164 Bsave_restriction = 0214,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
165 Bcatch = 0215,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
166
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
167 Bunwind_protect = 0216,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
168 Bcondition_case = 0217,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
169 Btemp_output_buffer_setup = 0220,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
170 Btemp_output_buffer_show = 0221,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
171
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
172 Bunbind_all = 0222,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
173
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
174 Bset_marker = 0223,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
175 Bmatch_beginning = 0224,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
176 Bmatch_end = 0225,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
177 Bupcase = 0226,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
178 Bdowncase = 0227,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
179
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
180 Bstring_equal = 0230,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
181 Bstring_lessp = 0231,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
182 Bold_equal = 0232,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
183 Bnthcdr = 0233,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
184 Belt = 0234,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
185 Bold_member = 0235,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
186 Bold_assq = 0236,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
187 Bnreverse = 0237,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
188 Bsetcar = 0240,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
189 Bsetcdr = 0241,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
190 Bcar_safe = 0242,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
191 Bcdr_safe = 0243,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
192 Bnconc = 0244,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
193 Bquo = 0245,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
194 Brem = 0246,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
195 Bnumberp = 0247,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
196 Bintegerp = 0250,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
197
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
198 BRgoto = 0252,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
199 BRgotoifnil = 0253,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
200 BRgotoifnonnil = 0254,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
201 BRgotoifnilelsepop = 0255,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
202 BRgotoifnonnilelsepop = 0256,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
203
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
204 BlistN = 0257,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
205 BconcatN = 0260,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
206 BinsertN = 0261,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
207 Bmember = 0266, /* new in v20 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
208 Bassq = 0267, /* new in v20 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
209
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
210 Bconstant = 0300
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
211 };
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
212 typedef enum Opcode Opcode;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
213
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
214
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
215 Lisp_Object * execute_rare_opcode (Lisp_Object *stack_ptr,
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
216 const Opbyte *program_ptr,
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
217 Opcode opcode);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
218
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
219 /* Define BYTE_CODE_METER to enable generation of a byte-op usage histogram.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
220 This isn't defined in FSF Emacs and isn't defined in XEmacs v19. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
221 /* #define BYTE_CODE_METER */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
222
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
223
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
224 #ifdef BYTE_CODE_METER
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
225
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
226 Lisp_Object Vbyte_code_meter, Qbyte_code_meter;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
227 int byte_metering_on;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
228
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
229 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
230 meter_code (Opcode prev_opcode, Opcode this_opcode)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
231 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
232 if (byte_metering_on)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
233 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
234 Lisp_Object *p = XVECTOR_DATA (XVECTOR_DATA (Vbyte_code_meter)[this_opcode]);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
235 p[0] = INT_PLUS1 (p[0]);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
236 if (prev_opcode)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
237 p[prev_opcode] = INT_PLUS1 (p[prev_opcode]);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
238 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
239 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
240
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
241 #endif /* BYTE_CODE_METER */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
242
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
243
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
244 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
245 bytecode_negate (Lisp_Object obj)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
246 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
247 retry:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
248
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
249 if (INTP (obj)) return make_int (- XINT (obj));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
250 #ifdef LISP_FLOAT_TYPE
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
251 if (FLOATP (obj)) return make_float (- XFLOAT_DATA (obj));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
252 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
253 if (CHARP (obj)) return make_int (- ((int) XCHAR (obj)));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
254 if (MARKERP (obj)) return make_int (- ((int) marker_position (obj)));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
255
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
256 obj = wrong_type_argument (Qnumber_char_or_marker_p, obj);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
257 goto retry;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
258 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
259
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
260 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
261 bytecode_nreverse (Lisp_Object list)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
262 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
263 REGISTER Lisp_Object prev = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
264 REGISTER Lisp_Object tail = list;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
265
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
266 while (!NILP (tail))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
267 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
268 REGISTER Lisp_Object next;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
269 CHECK_CONS (tail);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
270 next = XCDR (tail);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
271 XCDR (tail) = prev;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
272 prev = tail;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
273 tail = next;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
274 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
275 return prev;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
276 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
277
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
278
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
279 /* We have our own two-argument versions of various arithmetic ops.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
280 Only two-argument arithmetic operations have their own byte codes. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
281 static int
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
282 bytecode_arithcompare (Lisp_Object obj1, Lisp_Object obj2)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
283 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
284 retry:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
285
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
286 #ifdef LISP_FLOAT_TYPE
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
287 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
288 EMACS_INT ival1, ival2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
289
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
290 if (INTP (obj1)) ival1 = XINT (obj1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
291 else if (CHARP (obj1)) ival1 = XCHAR (obj1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
292 else if (MARKERP (obj1)) ival1 = marker_position (obj1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
293 else goto arithcompare_float;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
294
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
295 if (INTP (obj2)) ival2 = XINT (obj2);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
296 else if (CHARP (obj2)) ival2 = XCHAR (obj2);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
297 else if (MARKERP (obj2)) ival2 = marker_position (obj2);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
298 else goto arithcompare_float;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
299
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
300 return ival1 < ival2 ? -1 : ival1 > ival2 ? 1 : 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
301 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
302
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
303 arithcompare_float:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
304
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
305 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
306 double dval1, dval2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
307
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
308 if (FLOATP (obj1)) dval1 = XFLOAT_DATA (obj1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
309 else if (INTP (obj1)) dval1 = (double) XINT (obj1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
310 else if (CHARP (obj1)) dval1 = (double) XCHAR (obj1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
311 else if (MARKERP (obj1)) dval1 = (double) marker_position (obj1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
312 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
313 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
314 obj1 = wrong_type_argument (Qnumber_char_or_marker_p, obj1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
315 goto retry;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
316 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
317
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
318 if (FLOATP (obj2)) dval2 = XFLOAT_DATA (obj2);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
319 else if (INTP (obj2)) dval2 = (double) XINT (obj2);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
320 else if (CHARP (obj2)) dval2 = (double) XCHAR (obj2);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
321 else if (MARKERP (obj2)) dval2 = (double) marker_position (obj2);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
322 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
323 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
324 obj2 = wrong_type_argument (Qnumber_char_or_marker_p, obj2);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
325 goto retry;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
326 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
327
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
328 return dval1 < dval2 ? -1 : dval1 > dval2 ? 1 : 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
329 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
330 #else /* !LISP_FLOAT_TYPE */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
331 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
332 EMACS_INT ival1, ival2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
333
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
334 if (INTP (obj1)) ival1 = XINT (obj1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
335 else if (CHARP (obj1)) ival1 = XCHAR (obj1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
336 else if (MARKERP (obj1)) ival1 = marker_position (obj1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
337 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
338 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
339 obj1 = wrong_type_argument (Qnumber_char_or_marker_p, obj1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
340 goto retry;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
341 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
342
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
343 if (INTP (obj2)) ival2 = XINT (obj2);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
344 else if (CHARP (obj2)) ival2 = XCHAR (obj2);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
345 else if (MARKERP (obj2)) ival2 = marker_position (obj2);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
346 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
347 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
348 obj2 = wrong_type_argument (Qnumber_char_or_marker_p, obj2);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
349 goto retry;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
350 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
351
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
352 return ival1 < ival2 ? -1 : ival1 > ival2 ? 1 : 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
353 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
354 #endif /* !LISP_FLOAT_TYPE */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
355 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
356
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
357 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
358 bytecode_arithop (Lisp_Object obj1, Lisp_Object obj2, Opcode opcode)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
359 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
360 #ifdef LISP_FLOAT_TYPE
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
361 EMACS_INT ival1, ival2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
362 int float_p;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
363
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
364 retry:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
365
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
366 float_p = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
367
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
368 if (INTP (obj1)) ival1 = XINT (obj1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
369 else if (CHARP (obj1)) ival1 = XCHAR (obj1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
370 else if (MARKERP (obj1)) ival1 = marker_position (obj1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
371 else if (FLOATP (obj1)) ival1 = 0, float_p = 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
372 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
373 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
374 obj1 = wrong_type_argument (Qnumber_char_or_marker_p, obj1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
375 goto retry;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
376 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
377
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
378 if (INTP (obj2)) ival2 = XINT (obj2);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
379 else if (CHARP (obj2)) ival2 = XCHAR (obj2);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
380 else if (MARKERP (obj2)) ival2 = marker_position (obj2);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
381 else if (FLOATP (obj2)) ival2 = 0, float_p = 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
382 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
383 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
384 obj2 = wrong_type_argument (Qnumber_char_or_marker_p, obj2);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
385 goto retry;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
386 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
387
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
388 if (!float_p)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
389 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
390 switch (opcode)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
391 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
392 case Bplus: ival1 += ival2; break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
393 case Bdiff: ival1 -= ival2; break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
394 case Bmult: ival1 *= ival2; break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
395 case Bquo:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
396 if (ival2 == 0) Fsignal (Qarith_error, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
397 ival1 /= ival2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
398 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
399 case Bmax: if (ival1 < ival2) ival1 = ival2; break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
400 case Bmin: if (ival1 > ival2) ival1 = ival2; break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
401 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
402 return make_int (ival1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
403 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
404 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
405 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
406 double dval1 = FLOATP (obj1) ? XFLOAT_DATA (obj1) : (double) ival1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
407 double dval2 = FLOATP (obj2) ? XFLOAT_DATA (obj2) : (double) ival2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
408 switch (opcode)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
409 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
410 case Bplus: dval1 += dval2; break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
411 case Bdiff: dval1 -= dval2; break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
412 case Bmult: dval1 *= dval2; break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
413 case Bquo:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
414 if (dval2 == 0) Fsignal (Qarith_error, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
415 dval1 /= dval2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
416 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
417 case Bmax: if (dval1 < dval2) dval1 = dval2; break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
418 case Bmin: if (dval1 > dval2) dval1 = dval2; break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
419 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
420 return make_float (dval1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
421 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
422 #else /* !LISP_FLOAT_TYPE */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
423 EMACS_INT ival1, ival2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
424
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
425 retry:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
426
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
427 if (INTP (obj1)) ival1 = XINT (obj1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
428 else if (CHARP (obj1)) ival1 = XCHAR (obj1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
429 else if (MARKERP (obj1)) ival1 = marker_position (obj1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
430 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
431 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
432 obj1 = wrong_type_argument (Qnumber_char_or_marker_p, obj1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
433 goto retry;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
434 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
435
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
436 if (INTP (obj2)) ival2 = XINT (obj2);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
437 else if (CHARP (obj2)) ival2 = XCHAR (obj2);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
438 else if (MARKERP (obj2)) ival2 = marker_position (obj2);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
439 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
440 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
441 obj2 = wrong_type_argument (Qnumber_char_or_marker_p, obj2);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
442 goto retry;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
443 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
444
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
445 switch (opcode)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
446 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
447 case Bplus: ival1 += ival2; break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
448 case Bdiff: ival1 -= ival2; break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
449 case Bmult: ival1 *= ival2; break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
450 case Bquo:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
451 if (ival2 == 0) Fsignal (Qarith_error, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
452 ival1 /= ival2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
453 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
454 case Bmax: if (ival1 < ival2) ival1 = ival2; break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
455 case Bmin: if (ival1 > ival2) ival1 = ival2; break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
456 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
457 return make_int (ival1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
458 #endif /* !LISP_FLOAT_TYPE */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
459 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
460
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
461
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
462 /* Read next uint8 from the instruction stream. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
463 #define READ_UINT_1 ((unsigned int) (unsigned char) *program_ptr++)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
464
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
465 /* Read next uint16 from the instruction stream. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
466 #define READ_UINT_2 \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
467 (program_ptr += 2, \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
468 (((unsigned int) (unsigned char) program_ptr[-1]) * 256 + \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
469 ((unsigned int) (unsigned char) program_ptr[-2])))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
470
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
471 /* Read next int8 from the instruction stream. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
472 #define READ_INT_1 ((int) (signed char) *program_ptr++)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
473
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
474 /* Read next int16 from the instruction stream. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
475 #define READ_INT_2 \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
476 (program_ptr += 2, \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
477 (((int) ( signed char) program_ptr[-1]) * 256 + \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
478 ((int) (unsigned char) program_ptr[-2])))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
479
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
480 /* Read next int8 from instruction stream; don't advance program_pointer */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
481 #define PEEK_INT_1 ((int) (signed char) program_ptr[0])
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
482
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
483 /* Read next int16 from instruction stream; don't advance program_pointer */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
484 #define PEEK_INT_2 \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
485 ((((int) ( signed char) program_ptr[1]) * 256) | \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
486 ((int) (unsigned char) program_ptr[0]))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
487
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
488 /* Do relative jumps from the current location.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
489 We only do a QUIT if we jump backwards, for efficiency.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
490 No infloops without backward jumps! */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
491 #define JUMP_RELATIVE(jump) do { \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
492 int JR_jump = (jump); \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
493 if (JR_jump < 0) QUIT; \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
494 program_ptr += JR_jump; \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
495 } while (0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
496
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
497 #define JUMP JUMP_RELATIVE (PEEK_INT_2)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
498 #define JUMPR JUMP_RELATIVE (PEEK_INT_1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
499
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
500 #define JUMP_NEXT ((void) (program_ptr += 2))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
501 #define JUMPR_NEXT ((void) (program_ptr += 1))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
502
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
503 /* Push x onto the execution stack. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
504 #define PUSH(x) (*++stack_ptr = (x))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
505
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
506 /* Pop a value off the execution stack. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
507 #define POP (*stack_ptr--)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
508
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
509 /* Discard n values from the execution stack. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
510 #define DISCARD(n) (stack_ptr -= (n))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
511
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
512 /* Get the value which is at the top of the execution stack,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
513 but don't pop it. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
514 #define TOP (*stack_ptr)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
515
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
516 /* The actual interpreter for byte code.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
517 This function has been seriously optimized for performance.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
518 Don't change the constructs unless you are willing to do
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
519 real benchmarking and profiling work -- martin */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
520
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
521
814
a634e3b7acc8 [xemacs-hg @ 2002-04-14 12:41:59 by ben]
ben
parents: 801
diff changeset
522 Lisp_Object
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
523 execute_optimized_program (const Opbyte *program,
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
524 int stack_depth,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
525 Lisp_Object *constants_data)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
526 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
527 /* This function can GC */
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
528 REGISTER const Opbyte *program_ptr = (Opbyte *) program;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
529 REGISTER Lisp_Object *stack_ptr
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
530 = alloca_array (Lisp_Object, stack_depth + 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
531 int speccount = specpdl_depth ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
532 struct gcpro gcpro1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
533
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
534 #ifdef BYTE_CODE_METER
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
535 Opcode this_opcode = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
536 Opcode prev_opcode;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
537 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
538
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
539 #ifdef ERROR_CHECK_BYTE_CODE
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
540 Lisp_Object *stack_beg = stack_ptr;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
541 Lisp_Object *stack_end = stack_beg + stack_depth;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
542 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
543
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
544 /* Initialize all the objects on the stack to Qnil,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
545 so we can GCPRO the whole stack.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
546 The first element of the stack is actually a dummy. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
547 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
548 int i;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
549 Lisp_Object *p;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
550 for (i = stack_depth, p = stack_ptr; i--;)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
551 *++p = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
552 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
553
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
554 GCPRO1 (stack_ptr[1]);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
555 gcpro1.nvars = stack_depth;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
556
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
557 while (1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
558 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
559 REGISTER Opcode opcode = (Opcode) READ_UINT_1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
560 #ifdef ERROR_CHECK_BYTE_CODE
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
561 if (stack_ptr > stack_end)
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 444
diff changeset
562 stack_overflow ("byte code stack overflow", Qunbound);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
563 if (stack_ptr < stack_beg)
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 444
diff changeset
564 stack_overflow ("byte code stack underflow", Qunbound);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
565 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
566
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
567 #ifdef BYTE_CODE_METER
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
568 prev_opcode = this_opcode;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
569 this_opcode = opcode;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
570 meter_code (prev_opcode, this_opcode);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
571 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
572
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
573 switch (opcode)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
574 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
575 REGISTER int n;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
576
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
577 default:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
578 if (opcode >= Bconstant)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
579 PUSH (constants_data[opcode - Bconstant]);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
580 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
581 stack_ptr = execute_rare_opcode (stack_ptr, program_ptr, opcode);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
582 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
583
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
584 case Bvarref:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
585 case Bvarref+1:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
586 case Bvarref+2:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
587 case Bvarref+3:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
588 case Bvarref+4:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
589 case Bvarref+5: n = opcode - Bvarref; goto do_varref;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
590 case Bvarref+7: n = READ_UINT_2; goto do_varref;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
591 case Bvarref+6: n = READ_UINT_1; /* most common */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
592 do_varref:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
593 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
594 Lisp_Object symbol = constants_data[n];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
595 Lisp_Object value = XSYMBOL (symbol)->value;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
596 if (SYMBOL_VALUE_MAGIC_P (value))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
597 value = Fsymbol_value (symbol);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
598 PUSH (value);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
599 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
600 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
601
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
602 case Bvarset:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
603 case Bvarset+1:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
604 case Bvarset+2:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
605 case Bvarset+3:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
606 case Bvarset+4:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
607 case Bvarset+5: n = opcode - Bvarset; goto do_varset;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
608 case Bvarset+7: n = READ_UINT_2; goto do_varset;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
609 case Bvarset+6: n = READ_UINT_1; /* most common */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
610 do_varset:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
611 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
612 Lisp_Object symbol = constants_data[n];
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
613 Lisp_Symbol *symbol_ptr = XSYMBOL (symbol);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
614 Lisp_Object old_value = symbol_ptr->value;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
615 Lisp_Object new_value = POP;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
616 if (!SYMBOL_VALUE_MAGIC_P (old_value) || UNBOUNDP (old_value))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
617 symbol_ptr->value = new_value;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
618 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
619 Fset (symbol, new_value);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
620 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
621 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
622
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
623 case Bvarbind:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
624 case Bvarbind+1:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
625 case Bvarbind+2:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
626 case Bvarbind+3:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
627 case Bvarbind+4:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
628 case Bvarbind+5: n = opcode - Bvarbind; goto do_varbind;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
629 case Bvarbind+7: n = READ_UINT_2; goto do_varbind;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
630 case Bvarbind+6: n = READ_UINT_1; /* most common */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
631 do_varbind:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
632 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
633 Lisp_Object symbol = constants_data[n];
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
634 Lisp_Symbol *symbol_ptr = XSYMBOL (symbol);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
635 Lisp_Object old_value = symbol_ptr->value;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
636 Lisp_Object new_value = POP;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
637 if (!SYMBOL_VALUE_MAGIC_P (old_value) || UNBOUNDP (old_value))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
638 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
639 specpdl_ptr->symbol = symbol;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
640 specpdl_ptr->old_value = old_value;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
641 specpdl_ptr->func = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
642 specpdl_ptr++;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
643 specpdl_depth_counter++;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
644
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
645 symbol_ptr->value = new_value;
853
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 844
diff changeset
646
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 844
diff changeset
647 #ifdef ERROR_CHECK_CATCH
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 844
diff changeset
648 check_specbind_stack_sanity ();
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 844
diff changeset
649 #endif
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
650 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
651 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
652 specbind_magic (symbol, new_value);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
653 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
654 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
655
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
656 case Bcall:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
657 case Bcall+1:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
658 case Bcall+2:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
659 case Bcall+3:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
660 case Bcall+4:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
661 case Bcall+5:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
662 case Bcall+6:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
663 case Bcall+7:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
664 n = (opcode < Bcall+6 ? opcode - Bcall :
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
665 opcode == Bcall+6 ? READ_UINT_1 : READ_UINT_2);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
666 DISCARD (n);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
667 #ifdef BYTE_CODE_METER
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
668 if (byte_metering_on && SYMBOLP (TOP))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
669 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
670 Lisp_Object val = Fget (TOP, Qbyte_code_meter, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
671 if (INTP (val))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
672 Fput (TOP, Qbyte_code_meter, make_int (XINT (val) + 1));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
673 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
674 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
675 TOP = Ffuncall (n + 1, &TOP);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
676 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
677
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
678 case Bunbind:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
679 case Bunbind+1:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
680 case Bunbind+2:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
681 case Bunbind+3:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
682 case Bunbind+4:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
683 case Bunbind+5:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
684 case Bunbind+6:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
685 case Bunbind+7:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
686 UNBIND_TO (specpdl_depth() -
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
687 (opcode < Bunbind+6 ? opcode-Bunbind :
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
688 opcode == Bunbind+6 ? READ_UINT_1 : READ_UINT_2));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
689 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
690
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
691
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
692 case Bgoto:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
693 JUMP;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
694 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
695
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
696 case Bgotoifnil:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
697 if (NILP (POP))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
698 JUMP;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
699 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
700 JUMP_NEXT;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
701 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
702
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
703 case Bgotoifnonnil:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
704 if (!NILP (POP))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
705 JUMP;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
706 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
707 JUMP_NEXT;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
708 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
709
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
710 case Bgotoifnilelsepop:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
711 if (NILP (TOP))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
712 JUMP;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
713 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
714 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
715 DISCARD (1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
716 JUMP_NEXT;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
717 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
718 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
719
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
720 case Bgotoifnonnilelsepop:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
721 if (!NILP (TOP))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
722 JUMP;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
723 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
724 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
725 DISCARD (1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
726 JUMP_NEXT;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
727 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
728 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
729
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
730
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
731 case BRgoto:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
732 JUMPR;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
733 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
734
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
735 case BRgotoifnil:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
736 if (NILP (POP))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
737 JUMPR;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
738 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
739 JUMPR_NEXT;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
740 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
741
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
742 case BRgotoifnonnil:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
743 if (!NILP (POP))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
744 JUMPR;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
745 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
746 JUMPR_NEXT;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
747 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
748
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
749 case BRgotoifnilelsepop:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
750 if (NILP (TOP))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
751 JUMPR;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
752 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
753 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
754 DISCARD (1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
755 JUMPR_NEXT;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
756 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
757 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
758
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
759 case BRgotoifnonnilelsepop:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
760 if (!NILP (TOP))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
761 JUMPR;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
762 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
763 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
764 DISCARD (1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
765 JUMPR_NEXT;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
766 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
767 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
768
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
769 case Breturn:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
770 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
771 #ifdef ERROR_CHECK_BYTE_CODE
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
772 /* Binds and unbinds are supposed to be compiled balanced. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
773 if (specpdl_depth() != speccount)
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 444
diff changeset
774 invalid_byte_code ("unbalanced specbinding stack", Qunbound);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
775 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
776 return TOP;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
777
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
778 case Bdiscard:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
779 DISCARD (1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
780 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
781
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
782 case Bdup:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
783 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
784 Lisp_Object arg = TOP;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
785 PUSH (arg);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
786 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
787 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
788
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
789 case Bconstant2:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
790 PUSH (constants_data[READ_UINT_2]);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
791 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
792
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
793 case Bcar:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
794 TOP = CONSP (TOP) ? XCAR (TOP) : Fcar (TOP);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
795 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
796
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
797 case Bcdr:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
798 TOP = CONSP (TOP) ? XCDR (TOP) : Fcdr (TOP);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
799 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
800
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
801
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
802 case Bunbind_all:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
803 /* To unbind back to the beginning of this frame. Not used yet,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
804 but will be needed for tail-recursion elimination. */
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
805 unbind_to (speccount);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
806 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
807
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
808 case Bnth:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
809 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
810 Lisp_Object arg = POP;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
811 TOP = Fcar (Fnthcdr (TOP, arg));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
812 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
813 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
814
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
815 case Bsymbolp:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
816 TOP = SYMBOLP (TOP) ? Qt : Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
817 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
818
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
819 case Bconsp:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
820 TOP = CONSP (TOP) ? Qt : Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
821 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
822
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
823 case Bstringp:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
824 TOP = STRINGP (TOP) ? Qt : Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
825 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
826
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
827 case Blistp:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
828 TOP = LISTP (TOP) ? Qt : Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
829 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
830
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
831 case Bnumberp:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
832 TOP = INT_OR_FLOATP (TOP) ? Qt : Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
833 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
834
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
835 case Bintegerp:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
836 TOP = INTP (TOP) ? Qt : Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
837 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
838
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
839 case Beq:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
840 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
841 Lisp_Object arg = POP;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
842 TOP = EQ_WITH_EBOLA_NOTICE (TOP, arg) ? Qt : Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
843 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
844 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
845
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
846 case Bnot:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
847 TOP = NILP (TOP) ? Qt : Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
848 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
849
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
850 case Bcons:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
851 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
852 Lisp_Object arg = POP;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
853 TOP = Fcons (TOP, arg);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
854 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
855 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
856
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
857 case Blist1:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
858 TOP = Fcons (TOP, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
859 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
860
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
861
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
862 case BlistN:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
863 n = READ_UINT_1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
864 goto do_list;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
865
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
866 case Blist2:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
867 case Blist3:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
868 case Blist4:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
869 /* common case */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
870 n = opcode - (Blist1 - 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
871 do_list:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
872 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
873 Lisp_Object list = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
874 list_loop:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
875 list = Fcons (TOP, list);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
876 if (--n)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
877 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
878 DISCARD (1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
879 goto list_loop;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
880 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
881 TOP = list;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
882 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
883 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
884
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
885
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
886 case Bconcat2:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
887 case Bconcat3:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
888 case Bconcat4:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
889 n = opcode - (Bconcat2 - 2);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
890 goto do_concat;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
891
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
892 case BconcatN:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
893 /* common case */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
894 n = READ_UINT_1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
895 do_concat:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
896 DISCARD (n - 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
897 TOP = Fconcat (n, &TOP);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
898 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
899
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
900
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
901 case Blength:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
902 TOP = Flength (TOP);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
903 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
904
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
905 case Baset:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
906 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
907 Lisp_Object arg2 = POP;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
908 Lisp_Object arg1 = POP;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
909 TOP = Faset (TOP, arg1, arg2);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
910 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
911 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
912
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
913 case Bsymbol_value:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
914 TOP = Fsymbol_value (TOP);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
915 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
916
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
917 case Bsymbol_function:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
918 TOP = Fsymbol_function (TOP);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
919 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
920
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
921 case Bget:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
922 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
923 Lisp_Object arg = POP;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
924 TOP = Fget (TOP, arg, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
925 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
926 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
927
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
928 case Bsub1:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
929 TOP = INTP (TOP) ? INT_MINUS1 (TOP) : Fsub1 (TOP);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
930 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
931
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
932 case Badd1:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
933 TOP = INTP (TOP) ? INT_PLUS1 (TOP) : Fadd1 (TOP);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
934 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
935
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
936
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
937 case Beqlsign:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
938 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
939 Lisp_Object arg = POP;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
940 TOP = bytecode_arithcompare (TOP, arg) == 0 ? Qt : Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
941 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
942 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
943
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
944 case Bgtr:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
945 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
946 Lisp_Object arg = POP;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
947 TOP = bytecode_arithcompare (TOP, arg) > 0 ? Qt : Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
948 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
949 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
950
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
951 case Blss:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
952 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
953 Lisp_Object arg = POP;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
954 TOP = bytecode_arithcompare (TOP, arg) < 0 ? Qt : Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
955 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
956 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
957
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
958 case Bleq:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
959 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
960 Lisp_Object arg = POP;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
961 TOP = bytecode_arithcompare (TOP, arg) <= 0 ? Qt : Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
962 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
963 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
964
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
965 case Bgeq:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
966 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
967 Lisp_Object arg = POP;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
968 TOP = bytecode_arithcompare (TOP, arg) >= 0 ? Qt : Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
969 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
970 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
971
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
972
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
973 case Bnegate:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
974 TOP = bytecode_negate (TOP);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
975 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
976
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
977 case Bnconc:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
978 DISCARD (1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
979 TOP = bytecode_nconc2 (&TOP);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
980 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
981
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
982 case Bplus:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
983 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
984 Lisp_Object arg2 = POP;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
985 Lisp_Object arg1 = TOP;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
986 TOP = INTP (arg1) && INTP (arg2) ?
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
987 INT_PLUS (arg1, arg2) :
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
988 bytecode_arithop (arg1, arg2, opcode);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
989 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
990 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
991
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
992 case Bdiff:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
993 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
994 Lisp_Object arg2 = POP;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
995 Lisp_Object arg1 = TOP;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
996 TOP = INTP (arg1) && INTP (arg2) ?
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
997 INT_MINUS (arg1, arg2) :
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
998 bytecode_arithop (arg1, arg2, opcode);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
999 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1000 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1001
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1002 case Bmult:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1003 case Bquo:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1004 case Bmax:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1005 case Bmin:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1006 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1007 Lisp_Object arg = POP;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1008 TOP = bytecode_arithop (TOP, arg, opcode);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1009 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1010 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1011
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1012 case Bpoint:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1013 PUSH (make_int (BUF_PT (current_buffer)));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1014 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1015
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1016 case Binsert:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1017 TOP = Finsert (1, &TOP);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1018 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1019
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1020 case BinsertN:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1021 n = READ_UINT_1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1022 DISCARD (n - 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1023 TOP = Finsert (n, &TOP);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1024 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1025
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1026 case Baref:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1027 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1028 Lisp_Object arg = POP;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1029 TOP = Faref (TOP, arg);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1030 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1031 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1032
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1033 case Bmemq:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1034 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1035 Lisp_Object arg = POP;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1036 TOP = Fmemq (TOP, arg);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1037 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1038 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1039
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1040 case Bset:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1041 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1042 Lisp_Object arg = POP;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1043 TOP = Fset (TOP, arg);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1044 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1045 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1046
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1047 case Bequal:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1048 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1049 Lisp_Object arg = POP;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1050 TOP = Fequal (TOP, arg);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1051 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1052 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1053
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1054 case Bnthcdr:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1055 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1056 Lisp_Object arg = POP;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1057 TOP = Fnthcdr (TOP, arg);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1058 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1059 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1060
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1061 case Belt:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1062 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1063 Lisp_Object arg = POP;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1064 TOP = Felt (TOP, arg);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1065 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1066 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1067
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1068 case Bmember:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1069 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1070 Lisp_Object arg = POP;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1071 TOP = Fmember (TOP, arg);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1072 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1073 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1074
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1075 case Bgoto_char:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1076 TOP = Fgoto_char (TOP, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1077 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1078
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1079 case Bcurrent_buffer:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1080 {
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 771
diff changeset
1081 Lisp_Object buffer = wrap_buffer (current_buffer);
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 771
diff changeset
1082
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1083 PUSH (buffer);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1084 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1085 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1086
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1087 case Bset_buffer:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1088 TOP = Fset_buffer (TOP);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1089 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1090
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1091 case Bpoint_max:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1092 PUSH (make_int (BUF_ZV (current_buffer)));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1093 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1094
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1095 case Bpoint_min:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1096 PUSH (make_int (BUF_BEGV (current_buffer)));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1097 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1098
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1099 case Bskip_chars_forward:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1100 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1101 Lisp_Object arg = POP;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1102 TOP = Fskip_chars_forward (TOP, arg, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1103 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1104 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1105
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1106 case Bassq:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1107 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1108 Lisp_Object arg = POP;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1109 TOP = Fassq (TOP, arg);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1110 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1111 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1112
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1113 case Bsetcar:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1114 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1115 Lisp_Object arg = POP;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1116 TOP = Fsetcar (TOP, arg);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1117 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1118 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1119
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1120 case Bsetcdr:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1121 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1122 Lisp_Object arg = POP;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1123 TOP = Fsetcdr (TOP, arg);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1124 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1125 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1126
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1127 case Bnreverse:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1128 TOP = bytecode_nreverse (TOP);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1129 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1130
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1131 case Bcar_safe:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1132 TOP = CONSP (TOP) ? XCAR (TOP) : Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1133 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1134
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1135 case Bcdr_safe:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1136 TOP = CONSP (TOP) ? XCDR (TOP) : Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1137 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1138
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1139 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1140 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1141 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1142
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1143 /* It makes a worthwhile performance difference (5%) to shunt
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1144 lesser-used opcodes off to a subroutine, to keep the switch in
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1145 execute_optimized_program small. If you REALLY care about
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1146 performance, you want to keep your heavily executed code away from
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1147 rarely executed code, to minimize cache misses.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1148
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1149 Don't make this function static, since then the compiler might inline it. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1150 Lisp_Object *
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1151 execute_rare_opcode (Lisp_Object *stack_ptr,
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1152 const Opbyte *program_ptr,
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1153 Opcode opcode)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1154 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1155 switch (opcode)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1156 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1157
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1158 case Bsave_excursion:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1159 record_unwind_protect (save_excursion_restore,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1160 save_excursion_save ());
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1161 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1162
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1163 case Bsave_window_excursion:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1164 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1165 int count = specpdl_depth ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1166 record_unwind_protect (save_window_excursion_unwind,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1167 Fcurrent_window_configuration (Qnil));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1168 TOP = Fprogn (TOP);
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1169 unbind_to (count);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1170 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1171 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1172
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1173 case Bsave_restriction:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1174 record_unwind_protect (save_restriction_restore,
844
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 826
diff changeset
1175 save_restriction_save (current_buffer));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1176 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1177
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1178 case Bcatch:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1179 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1180 Lisp_Object arg = POP;
853
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 844
diff changeset
1181 TOP = internal_catch (TOP, Feval, arg, 0, 0);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1182 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1183 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1184
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1185 case Bskip_chars_backward:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1186 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1187 Lisp_Object arg = POP;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1188 TOP = Fskip_chars_backward (TOP, arg, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1189 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1190 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1191
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1192 case Bunwind_protect:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1193 record_unwind_protect (Fprogn, POP);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1194 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1195
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1196 case Bcondition_case:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1197 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1198 Lisp_Object arg2 = POP; /* handlers */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1199 Lisp_Object arg1 = POP; /* bodyform */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1200 TOP = condition_case_3 (arg1, TOP, arg2);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1201 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1202 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1203
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1204 case Bset_marker:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1205 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1206 Lisp_Object arg2 = POP;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1207 Lisp_Object arg1 = POP;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1208 TOP = Fset_marker (TOP, arg1, arg2);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1209 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1210 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1211
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1212 case Brem:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1213 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1214 Lisp_Object arg = POP;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1215 TOP = Frem (TOP, arg);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1216 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1217 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1218
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1219 case Bmatch_beginning:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1220 TOP = Fmatch_beginning (TOP);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1221 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1222
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1223 case Bmatch_end:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1224 TOP = Fmatch_end (TOP);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1225 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1226
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1227 case Bupcase:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1228 TOP = Fupcase (TOP, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1229 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1230
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1231 case Bdowncase:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1232 TOP = Fdowncase (TOP, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1233 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1234
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1235 case Bfset:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1236 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1237 Lisp_Object arg = POP;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1238 TOP = Ffset (TOP, arg);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1239 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1240 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1241
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1242 case Bstring_equal:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1243 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1244 Lisp_Object arg = POP;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1245 TOP = Fstring_equal (TOP, arg);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1246 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1247 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1248
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1249 case Bstring_lessp:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1250 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1251 Lisp_Object arg = POP;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1252 TOP = Fstring_lessp (TOP, arg);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1253 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1254 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1255
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1256 case Bsubstring:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1257 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1258 Lisp_Object arg2 = POP;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1259 Lisp_Object arg1 = POP;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1260 TOP = Fsubstring (TOP, arg1, arg2);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1261 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1262 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1263
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1264 case Bcurrent_column:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1265 PUSH (make_int (current_column (current_buffer)));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1266 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1267
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1268 case Bchar_after:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1269 TOP = Fchar_after (TOP, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1270 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1271
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1272 case Bindent_to:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1273 TOP = Findent_to (TOP, Qnil, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1274 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1275
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1276 case Bwiden:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1277 PUSH (Fwiden (Qnil));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1278 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1279
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1280 case Bfollowing_char:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1281 PUSH (Ffollowing_char (Qnil));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1282 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1283
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1284 case Bpreceding_char:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1285 PUSH (Fpreceding_char (Qnil));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1286 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1287
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1288 case Beolp:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1289 PUSH (Feolp (Qnil));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1290 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1291
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1292 case Beobp:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1293 PUSH (Feobp (Qnil));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1294 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1295
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1296 case Bbolp:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1297 PUSH (Fbolp (Qnil));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1298 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1299
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1300 case Bbobp:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1301 PUSH (Fbobp (Qnil));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1302 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1303
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1304 case Bsave_current_buffer:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1305 record_unwind_protect (save_current_buffer_restore,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1306 Fcurrent_buffer ());
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1307 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1308
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1309 case Binteractive_p:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1310 PUSH (Finteractive_p ());
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1311 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1312
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1313 case Bforward_char:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1314 TOP = Fforward_char (TOP, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1315 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1316
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1317 case Bforward_word:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1318 TOP = Fforward_word (TOP, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1319 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1320
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1321 case Bforward_line:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1322 TOP = Fforward_line (TOP, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1323 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1324
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1325 case Bchar_syntax:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1326 TOP = Fchar_syntax (TOP, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1327 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1328
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1329 case Bbuffer_substring:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1330 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1331 Lisp_Object arg = POP;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1332 TOP = Fbuffer_substring (TOP, arg, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1333 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1334 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1335
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1336 case Bdelete_region:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1337 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1338 Lisp_Object arg = POP;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1339 TOP = Fdelete_region (TOP, arg, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1340 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1341 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1342
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1343 case Bnarrow_to_region:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1344 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1345 Lisp_Object arg = POP;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1346 TOP = Fnarrow_to_region (TOP, arg, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1347 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1348 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1349
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1350 case Bend_of_line:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1351 TOP = Fend_of_line (TOP, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1352 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1353
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1354 case Btemp_output_buffer_setup:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1355 temp_output_buffer_setup (TOP);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1356 TOP = Vstandard_output;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1357 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1358
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1359 case Btemp_output_buffer_show:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1360 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1361 Lisp_Object arg = POP;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1362 temp_output_buffer_show (TOP, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1363 TOP = arg;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1364 /* GAG ME!! */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1365 /* pop binding of standard-output */
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1366 unbind_to (specpdl_depth() - 1);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1367 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1368 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1369
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1370 case Bold_eq:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1371 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1372 Lisp_Object arg = POP;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1373 TOP = HACKEQ_UNSAFE (TOP, arg) ? Qt : Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1374 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1375 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1376
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1377 case Bold_memq:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1378 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1379 Lisp_Object arg = POP;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1380 TOP = Fold_memq (TOP, arg);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1381 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1382 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1383
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1384 case Bold_equal:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1385 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1386 Lisp_Object arg = POP;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1387 TOP = Fold_equal (TOP, arg);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1388 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1389 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1390
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1391 case Bold_member:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1392 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1393 Lisp_Object arg = POP;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1394 TOP = Fold_member (TOP, arg);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1395 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1396 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1397
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1398 case Bold_assq:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1399 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1400 Lisp_Object arg = POP;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1401 TOP = Fold_assq (TOP, arg);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1402 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1403 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1404
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1405 default:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1406 abort();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1407 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1408 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1409 return stack_ptr;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1410 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1411
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1412
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 444
diff changeset
1413 DOESNT_RETURN
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
1414 invalid_byte_code (const CIbyte *reason, Lisp_Object frob)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1415 {
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 444
diff changeset
1416 signal_error (Qinvalid_byte_code, reason, frob);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1417 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1418
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1419 /* Check for valid opcodes. Change this when adding new opcodes. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1420 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1421 check_opcode (Opcode opcode)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1422 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1423 if ((opcode < Bvarref) ||
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1424 (opcode == 0251) ||
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1425 (opcode > Bassq && opcode < Bconstant))
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 444
diff changeset
1426 invalid_byte_code ("invalid opcode in instruction stream",
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 444
diff changeset
1427 make_int (opcode));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1428 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1429
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1430 /* Check that IDX is a valid offset into the `constants' vector */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1431 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1432 check_constants_index (int idx, Lisp_Object constants)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1433 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1434 if (idx < 0 || idx >= XVECTOR_LENGTH (constants))
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 444
diff changeset
1435 signal_ferror
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 444
diff changeset
1436 (Qinvalid_byte_code,
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 444
diff changeset
1437 "reference %d to constants array out of range 0, %ld",
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1438 idx, XVECTOR_LENGTH (constants) - 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1439 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1440
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1441 /* Get next character from Lisp instructions string. */
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 444
diff changeset
1442 #define READ_INSTRUCTION_CHAR(lvalue) do { \
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
1443 (lvalue) = itext_ichar (ptr); \
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
1444 INC_IBYTEPTR (ptr); \
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 444
diff changeset
1445 *icounts_ptr++ = program_ptr - program; \
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 444
diff changeset
1446 if (lvalue > UCHAR_MAX) \
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 444
diff changeset
1447 invalid_byte_code \
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 444
diff changeset
1448 ("Invalid character in byte code string", make_char (lvalue)); \
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1449 } while (0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1450
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1451 /* Get opcode from Lisp instructions string. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1452 #define READ_OPCODE do { \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1453 unsigned int c; \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1454 READ_INSTRUCTION_CHAR (c); \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1455 opcode = (Opcode) c; \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1456 } while (0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1457
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1458 /* Get next operand, a uint8, from Lisp instructions string. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1459 #define READ_OPERAND_1 do { \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1460 READ_INSTRUCTION_CHAR (arg); \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1461 argsize = 1; \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1462 } while (0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1463
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1464 /* Get next operand, a uint16, from Lisp instructions string. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1465 #define READ_OPERAND_2 do { \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1466 unsigned int arg1, arg2; \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1467 READ_INSTRUCTION_CHAR (arg1); \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1468 READ_INSTRUCTION_CHAR (arg2); \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1469 arg = arg1 + (arg2 << 8); \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1470 argsize = 2; \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1471 } while (0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1472
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1473 /* Write 1 byte to PTR, incrementing PTR */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1474 #define WRITE_INT8(value, ptr) do { \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1475 *((ptr)++) = (value); \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1476 } while (0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1477
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1478 /* Write 2 bytes to PTR, incrementing PTR */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1479 #define WRITE_INT16(value, ptr) do { \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1480 WRITE_INT8 (((unsigned) (value)) & 0x00ff, (ptr)); \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1481 WRITE_INT8 (((unsigned) (value)) >> 8 , (ptr)); \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1482 } while (0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1483
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1484 /* We've changed our minds about the opcode we've already written. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1485 #define REWRITE_OPCODE(new_opcode) ((void) (program_ptr[-1] = new_opcode))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1486
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1487 /* Encode an op arg within the opcode, or as a 1 or 2-byte operand. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1488 #define WRITE_NARGS(base_opcode) do { \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1489 if (arg <= 5) \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1490 { \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1491 REWRITE_OPCODE (base_opcode + arg); \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1492 } \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1493 else if (arg <= UCHAR_MAX) \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1494 { \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1495 REWRITE_OPCODE (base_opcode + 6); \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1496 WRITE_INT8 (arg, program_ptr); \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1497 } \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1498 else \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1499 { \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1500 REWRITE_OPCODE (base_opcode + 7); \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1501 WRITE_INT16 (arg, program_ptr); \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1502 } \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1503 } while (0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1504
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1505 /* Encode a constants reference within the opcode, or as a 2-byte operand. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1506 #define WRITE_CONSTANT do { \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1507 check_constants_index(arg, constants); \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1508 if (arg <= UCHAR_MAX - Bconstant) \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1509 { \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1510 REWRITE_OPCODE (Bconstant + arg); \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1511 } \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1512 else \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1513 { \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1514 REWRITE_OPCODE (Bconstant2); \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1515 WRITE_INT16 (arg, program_ptr); \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1516 } \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1517 } while (0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1518
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1519 #define WRITE_OPCODE WRITE_INT8 (opcode, program_ptr)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1520
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1521 /* Compile byte code instructions into free space provided by caller, with
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1522 size >= (2 * string_char_length (instructions) + 1) * sizeof (Opbyte).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1523 Returns length of compiled code. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1524 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1525 optimize_byte_code (/* in */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1526 Lisp_Object instructions,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1527 Lisp_Object constants,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1528 /* out */
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1529 Opbyte * const program,
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1530 int * const program_length,
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1531 int * const varbind_count)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1532 {
647
b39c14581166 [xemacs-hg @ 2001-08-13 04:45:47 by ben]
ben
parents: 609
diff changeset
1533 Bytecount instructions_length = XSTRING_LENGTH (instructions);
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
1534 Elemcount comfy_size = (Elemcount) (2 * instructions_length);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1535
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1536 int * const icounts = alloca_array (int, comfy_size);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1537 int * icounts_ptr = icounts;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1538
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1539 /* We maintain a table of jumps in the source code. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1540 struct jump
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1541 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1542 int from;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1543 int to;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1544 };
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1545 struct jump * const jumps = alloca_array (struct jump, comfy_size);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1546 struct jump *jumps_ptr = jumps;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1547
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1548 Opbyte *program_ptr = program;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1549
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
1550 const Ibyte *ptr = XSTRING_DATA (instructions);
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
1551 const Ibyte * const end = ptr + instructions_length;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1552
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1553 *varbind_count = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1554
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1555 while (ptr < end)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1556 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1557 Opcode opcode;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1558 int arg;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1559 int argsize = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1560 READ_OPCODE;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1561 WRITE_OPCODE;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1562
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1563 switch (opcode)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1564 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1565 Lisp_Object val;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1566
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1567 case Bvarref+7: READ_OPERAND_2; goto do_varref;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1568 case Bvarref+6: READ_OPERAND_1; goto do_varref;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1569 case Bvarref: case Bvarref+1: case Bvarref+2:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1570 case Bvarref+3: case Bvarref+4: case Bvarref+5:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1571 arg = opcode - Bvarref;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1572 do_varref:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1573 check_constants_index (arg, constants);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1574 val = XVECTOR_DATA (constants) [arg];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1575 if (!SYMBOLP (val))
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 444
diff changeset
1576 invalid_byte_code ("variable reference to non-symbol", val);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1577 if (EQ (val, Qnil) || EQ (val, Qt) || (SYMBOL_IS_KEYWORD (val)))
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 444
diff changeset
1578 invalid_byte_code ("variable reference to constant symbol", val);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1579 WRITE_NARGS (Bvarref);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1580 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1581
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1582 case Bvarset+7: READ_OPERAND_2; goto do_varset;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1583 case Bvarset+6: READ_OPERAND_1; goto do_varset;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1584 case Bvarset: case Bvarset+1: case Bvarset+2:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1585 case Bvarset+3: case Bvarset+4: case Bvarset+5:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1586 arg = opcode - Bvarset;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1587 do_varset:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1588 check_constants_index (arg, constants);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1589 val = XVECTOR_DATA (constants) [arg];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1590 if (!SYMBOLP (val))
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 444
diff changeset
1591 wtaerror ("attempt to set non-symbol", val);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1592 if (EQ (val, Qnil) || EQ (val, Qt))
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 444
diff changeset
1593 signal_error (Qsetting_constant, 0, val);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1594 /* Ignore assignments to keywords by converting to Bdiscard.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1595 For backward compatibility only - we'd like to make this an error. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1596 if (SYMBOL_IS_KEYWORD (val))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1597 REWRITE_OPCODE (Bdiscard);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1598 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1599 WRITE_NARGS (Bvarset);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1600 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1601
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1602 case Bvarbind+7: READ_OPERAND_2; goto do_varbind;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1603 case Bvarbind+6: READ_OPERAND_1; goto do_varbind;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1604 case Bvarbind: case Bvarbind+1: case Bvarbind+2:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1605 case Bvarbind+3: case Bvarbind+4: case Bvarbind+5:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1606 arg = opcode - Bvarbind;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1607 do_varbind:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1608 (*varbind_count)++;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1609 check_constants_index (arg, constants);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1610 val = XVECTOR_DATA (constants) [arg];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1611 if (!SYMBOLP (val))
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 444
diff changeset
1612 wtaerror ("attempt to let-bind non-symbol", val);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1613 if (EQ (val, Qnil) || EQ (val, Qt) || (SYMBOL_IS_KEYWORD (val)))
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 444
diff changeset
1614 signal_error (Qsetting_constant,
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 444
diff changeset
1615 "attempt to let-bind constant symbol", val);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1616 WRITE_NARGS (Bvarbind);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1617 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1618
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1619 case Bcall+7: READ_OPERAND_2; goto do_call;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1620 case Bcall+6: READ_OPERAND_1; goto do_call;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1621 case Bcall: case Bcall+1: case Bcall+2:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1622 case Bcall+3: case Bcall+4: case Bcall+5:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1623 arg = opcode - Bcall;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1624 do_call:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1625 WRITE_NARGS (Bcall);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1626 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1627
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1628 case Bunbind+7: READ_OPERAND_2; goto do_unbind;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1629 case Bunbind+6: READ_OPERAND_1; goto do_unbind;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1630 case Bunbind: case Bunbind+1: case Bunbind+2:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1631 case Bunbind+3: case Bunbind+4: case Bunbind+5:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1632 arg = opcode - Bunbind;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1633 do_unbind:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1634 WRITE_NARGS (Bunbind);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1635 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1636
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1637 case Bgoto:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1638 case Bgotoifnil:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1639 case Bgotoifnonnil:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1640 case Bgotoifnilelsepop:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1641 case Bgotoifnonnilelsepop:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1642 READ_OPERAND_2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1643 /* Make program_ptr-relative */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1644 arg += icounts - (icounts_ptr - argsize);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1645 goto do_jump;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1646
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1647 case BRgoto:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1648 case BRgotoifnil:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1649 case BRgotoifnonnil:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1650 case BRgotoifnilelsepop:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1651 case BRgotoifnonnilelsepop:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1652 READ_OPERAND_1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1653 /* Make program_ptr-relative */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1654 arg -= 127;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1655 do_jump:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1656 /* Record program-relative goto addresses in `jumps' table */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1657 jumps_ptr->from = icounts_ptr - icounts - argsize;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1658 jumps_ptr->to = jumps_ptr->from + arg;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1659 jumps_ptr++;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1660 if (arg >= -1 && arg <= argsize)
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 444
diff changeset
1661 invalid_byte_code ("goto instruction is its own target", Qunbound);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1662 if (arg <= SCHAR_MIN ||
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1663 arg > SCHAR_MAX)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1664 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1665 if (argsize == 1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1666 REWRITE_OPCODE (opcode + Bgoto - BRgoto);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1667 WRITE_INT16 (arg, program_ptr);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1668 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1669 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1670 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1671 if (argsize == 2)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1672 REWRITE_OPCODE (opcode + BRgoto - Bgoto);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1673 WRITE_INT8 (arg, program_ptr);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1674 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1675 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1676
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1677 case Bconstant2:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1678 READ_OPERAND_2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1679 WRITE_CONSTANT;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1680 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1681
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1682 case BlistN:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1683 case BconcatN:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1684 case BinsertN:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1685 READ_OPERAND_1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1686 WRITE_INT8 (arg, program_ptr);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1687 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1688
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1689 default:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1690 if (opcode < Bconstant)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1691 check_opcode (opcode);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1692 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1693 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1694 arg = opcode - Bconstant;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1695 WRITE_CONSTANT;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1696 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1697 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1698 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1699 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1700
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1701 /* Fix up jumps table to refer to NEW offsets. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1702 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1703 struct jump *j;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1704 for (j = jumps; j < jumps_ptr; j++)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1705 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1706 #ifdef ERROR_CHECK_BYTE_CODE
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1707 assert (j->from < icounts_ptr - icounts);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1708 assert (j->to < icounts_ptr - icounts);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1709 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1710 j->from = icounts[j->from];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1711 j->to = icounts[j->to];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1712 #ifdef ERROR_CHECK_BYTE_CODE
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1713 assert (j->from < program_ptr - program);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1714 assert (j->to < program_ptr - program);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1715 check_opcode ((Opcode) (program[j->from-1]));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1716 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1717 check_opcode ((Opcode) (program[j->to]));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1718 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1719 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1720
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1721 /* Fixup jumps in byte-code until no more fixups needed */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1722 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1723 int more_fixups_needed = 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1724
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1725 while (more_fixups_needed)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1726 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1727 struct jump *j;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1728 more_fixups_needed = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1729 for (j = jumps; j < jumps_ptr; j++)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1730 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1731 int from = j->from;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1732 int to = j->to;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1733 int jump = to - from;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1734 Opbyte *p = program + from;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1735 Opcode opcode = (Opcode) p[-1];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1736 if (!more_fixups_needed)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1737 check_opcode ((Opcode) p[jump]);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1738 assert (to >= 0 && program + to < program_ptr);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1739 switch (opcode)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1740 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1741 case Bgoto:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1742 case Bgotoifnil:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1743 case Bgotoifnonnil:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1744 case Bgotoifnilelsepop:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1745 case Bgotoifnonnilelsepop:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1746 WRITE_INT16 (jump, p);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1747 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1748
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1749 case BRgoto:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1750 case BRgotoifnil:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1751 case BRgotoifnonnil:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1752 case BRgotoifnilelsepop:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1753 case BRgotoifnonnilelsepop:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1754 if (jump > SCHAR_MIN &&
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1755 jump <= SCHAR_MAX)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1756 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1757 WRITE_INT8 (jump, p);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1758 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1759 else /* barf */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1760 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1761 struct jump *jj;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1762 for (jj = jumps; jj < jumps_ptr; jj++)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1763 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1764 assert (jj->from < program_ptr - program);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1765 assert (jj->to < program_ptr - program);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1766 if (jj->from > from) jj->from++;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1767 if (jj->to > from) jj->to++;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1768 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1769 p[-1] += Bgoto - BRgoto;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1770 more_fixups_needed = 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1771 memmove (p+1, p, program_ptr++ - p);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1772 WRITE_INT16 (jump, p);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1773 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1774 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1775
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1776 default:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1777 abort();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1778 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1779 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1780 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1781 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1782 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1783
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1784 /* *program_ptr++ = 0; */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1785 *program_length = program_ptr - program;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1786 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1787
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1788 /* Optimize the byte code and store the optimized program, only
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1789 understood by bytecode.c, in an opaque object in the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1790 instructions slot of the Compiled_Function object. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1791 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1792 optimize_compiled_function (Lisp_Object compiled_function)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1793 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1794 Lisp_Compiled_Function *f = XCOMPILED_FUNCTION (compiled_function);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1795 int program_length;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1796 int varbind_count;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1797 Opbyte *program;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1798
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1799 /* If we have not actually read the bytecode string
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1800 and constants vector yet, fetch them from the file. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1801 if (CONSP (f->instructions))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1802 Ffetch_bytecode (compiled_function);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1803
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1804 if (STRINGP (f->instructions))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1805 {
826
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 814
diff changeset
1806 /* XSTRING_LENGTH() is more efficient than string_char_length(),
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1807 which would be slightly more `proper' */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1808 program = alloca_array (Opbyte, 1 + 2 * XSTRING_LENGTH (f->instructions));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1809 optimize_byte_code (f->instructions, f->constants,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1810 program, &program_length, &varbind_count);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1811 f->specpdl_depth = XINT (Flength (f->arglist)) + varbind_count;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1812 f->instructions =
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
1813 make_opaque (program, program_length * sizeof (Opbyte));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1814 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1815
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1816 assert (OPAQUEP (f->instructions));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1817 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1818
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1819 /************************************************************************/
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1820 /* The compiled-function object type */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1821 /************************************************************************/
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1822 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1823 print_compiled_function (Lisp_Object obj, Lisp_Object printcharfun,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1824 int escapeflag)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1825 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1826 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1827 Lisp_Compiled_Function *f =
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1828 XCOMPILED_FUNCTION (obj); /* GC doesn't relocate */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1829 int docp = f->flags.documentationp;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1830 int intp = f->flags.interactivep;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1831 struct gcpro gcpro1, gcpro2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1832 GCPRO2 (obj, printcharfun);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1833
826
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 814
diff changeset
1834 write_c_string (printcharfun, print_readably ? "#[" : "#<compiled-function ");
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1835 #ifdef COMPILED_FUNCTION_ANNOTATION_HACK
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1836 if (!print_readably)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1837 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1838 Lisp_Object ann = compiled_function_annotation (f);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1839 if (!NILP (ann))
800
a5954632b187 [xemacs-hg @ 2002-03-31 08:27:14 by ben]
ben
parents: 793
diff changeset
1840 write_fmt_string_lisp (printcharfun, "(from %S) ", 1, ann);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1841 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1842 #endif /* COMPILED_FUNCTION_ANNOTATION_HACK */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1843 /* COMPILED_ARGLIST = 0 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1844 print_internal (compiled_function_arglist (f), printcharfun, escapeflag);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1845
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1846 /* COMPILED_INSTRUCTIONS = 1 */
826
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 814
diff changeset
1847 write_c_string (printcharfun, " ");
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1848 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1849 struct gcpro ngcpro1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1850 Lisp_Object instructions = compiled_function_instructions (f);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1851 NGCPRO1 (instructions);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1852 if (STRINGP (instructions) && !print_readably)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1853 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1854 /* We don't usually want to see that junk in the bytecode. */
800
a5954632b187 [xemacs-hg @ 2002-03-31 08:27:14 by ben]
ben
parents: 793
diff changeset
1855 write_fmt_string (printcharfun, "\"...(%ld)\"",
826
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 814
diff changeset
1856 (long) string_char_length (instructions));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1857 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1858 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1859 print_internal (instructions, printcharfun, escapeflag);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1860 NUNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1861 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1862
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1863 /* COMPILED_CONSTANTS = 2 */
826
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 814
diff changeset
1864 write_c_string (printcharfun, " ");
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1865 print_internal (compiled_function_constants (f), printcharfun, escapeflag);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1866
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1867 /* COMPILED_STACK_DEPTH = 3 */
800
a5954632b187 [xemacs-hg @ 2002-03-31 08:27:14 by ben]
ben
parents: 793
diff changeset
1868 write_fmt_string (printcharfun, " %d", compiled_function_stack_depth (f));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1869
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1870 /* COMPILED_DOC_STRING = 4 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1871 if (docp || intp)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1872 {
826
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 814
diff changeset
1873 write_c_string (printcharfun, " ");
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1874 print_internal (compiled_function_documentation (f), printcharfun,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1875 escapeflag);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1876 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1877
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1878 /* COMPILED_INTERACTIVE = 5 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1879 if (intp)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1880 {
826
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 814
diff changeset
1881 write_c_string (printcharfun, " ");
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1882 print_internal (compiled_function_interactive (f), printcharfun,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1883 escapeflag);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1884 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1885
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1886 UNGCPRO;
826
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 814
diff changeset
1887 write_c_string (printcharfun, print_readably ? "]" : ">");
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1888 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1889
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1890
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1891 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1892 mark_compiled_function (Lisp_Object obj)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1893 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1894 Lisp_Compiled_Function *f = XCOMPILED_FUNCTION (obj);
814
a634e3b7acc8 [xemacs-hg @ 2002-04-14 12:41:59 by ben]
ben
parents: 801
diff changeset
1895 int i;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1896
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1897 mark_object (f->instructions);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1898 mark_object (f->arglist);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1899 mark_object (f->doc_and_interactive);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1900 #ifdef COMPILED_FUNCTION_ANNOTATION_HACK
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1901 mark_object (f->annotated);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1902 #endif
814
a634e3b7acc8 [xemacs-hg @ 2002-04-14 12:41:59 by ben]
ben
parents: 801
diff changeset
1903 for (i = 0; i < f->args_in_array; i++)
a634e3b7acc8 [xemacs-hg @ 2002-04-14 12:41:59 by ben]
ben
parents: 801
diff changeset
1904 mark_object (f->args[i]);
a634e3b7acc8 [xemacs-hg @ 2002-04-14 12:41:59 by ben]
ben
parents: 801
diff changeset
1905
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1906 /* tail-recurse on constants */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1907 return f->constants;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1908 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1909
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1910 static int
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1911 compiled_function_equal (Lisp_Object obj1, Lisp_Object obj2, int depth)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1912 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1913 Lisp_Compiled_Function *f1 = XCOMPILED_FUNCTION (obj1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1914 Lisp_Compiled_Function *f2 = XCOMPILED_FUNCTION (obj2);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1915 return
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1916 (f1->flags.documentationp == f2->flags.documentationp &&
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1917 f1->flags.interactivep == f2->flags.interactivep &&
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1918 f1->flags.domainp == f2->flags.domainp && /* I18N3 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1919 internal_equal (compiled_function_instructions (f1),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1920 compiled_function_instructions (f2), depth + 1) &&
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1921 internal_equal (f1->constants, f2->constants, depth + 1) &&
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1922 internal_equal (f1->arglist, f2->arglist, depth + 1) &&
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1923 internal_equal (f1->doc_and_interactive,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1924 f2->doc_and_interactive, depth + 1));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1925 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1926
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
1927 static Hashcode
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1928 compiled_function_hash (Lisp_Object obj, int depth)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1929 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1930 Lisp_Compiled_Function *f = XCOMPILED_FUNCTION (obj);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1931 return HASH3 ((f->flags.documentationp << 2) +
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1932 (f->flags.interactivep << 1) +
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1933 f->flags.domainp,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1934 internal_hash (f->instructions, depth + 1),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1935 internal_hash (f->constants, depth + 1));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1936 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1937
814
a634e3b7acc8 [xemacs-hg @ 2002-04-14 12:41:59 by ben]
ben
parents: 801
diff changeset
1938 static const struct lrecord_description lo_description_1[] = {
a634e3b7acc8 [xemacs-hg @ 2002-04-14 12:41:59 by ben]
ben
parents: 801
diff changeset
1939 { XD_LISP_OBJECT, 0 },
a634e3b7acc8 [xemacs-hg @ 2002-04-14 12:41:59 by ben]
ben
parents: 801
diff changeset
1940 { XD_END }
a634e3b7acc8 [xemacs-hg @ 2002-04-14 12:41:59 by ben]
ben
parents: 801
diff changeset
1941 };
a634e3b7acc8 [xemacs-hg @ 2002-04-14 12:41:59 by ben]
ben
parents: 801
diff changeset
1942
a634e3b7acc8 [xemacs-hg @ 2002-04-14 12:41:59 by ben]
ben
parents: 801
diff changeset
1943 static const struct struct_description lo_description = {
a634e3b7acc8 [xemacs-hg @ 2002-04-14 12:41:59 by ben]
ben
parents: 801
diff changeset
1944 sizeof (Lisp_Object),
a634e3b7acc8 [xemacs-hg @ 2002-04-14 12:41:59 by ben]
ben
parents: 801
diff changeset
1945 lo_description_1
a634e3b7acc8 [xemacs-hg @ 2002-04-14 12:41:59 by ben]
ben
parents: 801
diff changeset
1946 };
a634e3b7acc8 [xemacs-hg @ 2002-04-14 12:41:59 by ben]
ben
parents: 801
diff changeset
1947
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1948 static const struct lrecord_description compiled_function_description[] = {
814
a634e3b7acc8 [xemacs-hg @ 2002-04-14 12:41:59 by ben]
ben
parents: 801
diff changeset
1949 { XD_INT, offsetof (Lisp_Compiled_Function, args_in_array) },
a634e3b7acc8 [xemacs-hg @ 2002-04-14 12:41:59 by ben]
ben
parents: 801
diff changeset
1950 { XD_STRUCT_PTR, offsetof (Lisp_Compiled_Function, args),
a634e3b7acc8 [xemacs-hg @ 2002-04-14 12:41:59 by ben]
ben
parents: 801
diff changeset
1951 XD_INDIRECT (0, 0), &lo_description },
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
1952 { XD_LISP_OBJECT, offsetof (Lisp_Compiled_Function, instructions) },
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
1953 { XD_LISP_OBJECT, offsetof (Lisp_Compiled_Function, constants) },
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
1954 { XD_LISP_OBJECT, offsetof (Lisp_Compiled_Function, arglist) },
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
1955 { XD_LISP_OBJECT, offsetof (Lisp_Compiled_Function, doc_and_interactive) },
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1956 #ifdef COMPILED_FUNCTION_ANNOTATION_HACK
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
1957 { XD_LISP_OBJECT, offsetof (Lisp_Compiled_Function, annotated) },
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1958 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1959 { XD_END }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1960 };
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1961
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1962 DEFINE_BASIC_LRECORD_IMPLEMENTATION ("compiled-function", compiled_function,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1963 mark_compiled_function,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1964 print_compiled_function, 0,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1965 compiled_function_equal,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1966 compiled_function_hash,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1967 compiled_function_description,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1968 Lisp_Compiled_Function);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1969
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1970 DEFUN ("compiled-function-p", Fcompiled_function_p, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1971 Return t if OBJECT is a byte-compiled function object.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1972 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1973 (object))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1974 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1975 return COMPILED_FUNCTIONP (object) ? Qt : Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1976 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1977
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1978 /************************************************************************/
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1979 /* compiled-function object accessor functions */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1980 /************************************************************************/
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1981
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1982 Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1983 compiled_function_arglist (Lisp_Compiled_Function *f)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1984 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1985 return f->arglist;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1986 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1987
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1988 Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1989 compiled_function_instructions (Lisp_Compiled_Function *f)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1990 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1991 if (! OPAQUEP (f->instructions))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1992 return f->instructions;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1993
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1994 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1995 /* Invert action performed by optimize_byte_code() */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1996 Lisp_Opaque *opaque = XOPAQUE (f->instructions);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1997
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
1998 Ibyte * const buffer =
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
1999 alloca_array (Ibyte, OPAQUE_SIZE (opaque) * MAX_ICHAR_LEN);
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
2000 Ibyte *bp = buffer;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2001
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2002 const Opbyte * const program = (const Opbyte *) OPAQUE_DATA (opaque);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2003 const Opbyte *program_ptr = program;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2004 const Opbyte * const program_end = program_ptr + OPAQUE_SIZE (opaque);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2005
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2006 while (program_ptr < program_end)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2007 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2008 Opcode opcode = (Opcode) READ_UINT_1;
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
2009 bp += set_itext_ichar (bp, opcode);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2010 switch (opcode)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2011 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2012 case Bvarref+7:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2013 case Bvarset+7:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2014 case Bvarbind+7:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2015 case Bcall+7:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2016 case Bunbind+7:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2017 case Bconstant2:
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
2018 bp += set_itext_ichar (bp, READ_UINT_1);
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
2019 bp += set_itext_ichar (bp, READ_UINT_1);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2020 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2021
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2022 case Bvarref+6:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2023 case Bvarset+6:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2024 case Bvarbind+6:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2025 case Bcall+6:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2026 case Bunbind+6:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2027 case BlistN:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2028 case BconcatN:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2029 case BinsertN:
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
2030 bp += set_itext_ichar (bp, READ_UINT_1);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2031 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2032
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2033 case Bgoto:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2034 case Bgotoifnil:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2035 case Bgotoifnonnil:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2036 case Bgotoifnilelsepop:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2037 case Bgotoifnonnilelsepop:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2038 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2039 int jump = READ_INT_2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2040 Opbyte buf2[2];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2041 Opbyte *buf2p = buf2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2042 /* Convert back to program-relative address */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2043 WRITE_INT16 (jump + (program_ptr - 2 - program), buf2p);
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
2044 bp += set_itext_ichar (bp, buf2[0]);
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
2045 bp += set_itext_ichar (bp, buf2[1]);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2046 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2047 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2048
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2049 case BRgoto:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2050 case BRgotoifnil:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2051 case BRgotoifnonnil:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2052 case BRgotoifnilelsepop:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2053 case BRgotoifnonnilelsepop:
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
2054 bp += set_itext_ichar (bp, READ_INT_1 + 127);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2055 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2056
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2057 default:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2058 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2059 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2060 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2061 return make_string (buffer, bp - buffer);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2062 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2063 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2064
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2065 Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2066 compiled_function_constants (Lisp_Compiled_Function *f)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2067 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2068 return f->constants;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2069 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2070
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2071 int
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2072 compiled_function_stack_depth (Lisp_Compiled_Function *f)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2073 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2074 return f->stack_depth;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2075 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2076
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2077 /* The compiled_function->doc_and_interactive slot uses the minimal
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2078 number of conses, based on compiled_function->flags; it may take
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2079 any of the following forms:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2080
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2081 doc
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2082 interactive
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2083 domain
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2084 (doc . interactive)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2085 (doc . domain)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2086 (interactive . domain)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2087 (doc . (interactive . domain))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2088 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2089
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2090 /* Caller must check flags.interactivep first */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2091 Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2092 compiled_function_interactive (Lisp_Compiled_Function *f)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2093 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2094 assert (f->flags.interactivep);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2095 if (f->flags.documentationp && f->flags.domainp)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2096 return XCAR (XCDR (f->doc_and_interactive));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2097 else if (f->flags.documentationp)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2098 return XCDR (f->doc_and_interactive);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2099 else if (f->flags.domainp)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2100 return XCAR (f->doc_and_interactive);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2101 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2102 return f->doc_and_interactive;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2103 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2104
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2105 /* Caller need not check flags.documentationp first */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2106 Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2107 compiled_function_documentation (Lisp_Compiled_Function *f)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2108 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2109 if (! f->flags.documentationp)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2110 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2111 else if (f->flags.interactivep && f->flags.domainp)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2112 return XCAR (f->doc_and_interactive);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2113 else if (f->flags.interactivep)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2114 return XCAR (f->doc_and_interactive);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2115 else if (f->flags.domainp)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2116 return XCAR (f->doc_and_interactive);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2117 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2118 return f->doc_and_interactive;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2119 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2120
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2121 /* Caller need not check flags.domainp first */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2122 Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2123 compiled_function_domain (Lisp_Compiled_Function *f)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2124 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2125 if (! f->flags.domainp)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2126 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2127 else if (f->flags.documentationp && f->flags.interactivep)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2128 return XCDR (XCDR (f->doc_and_interactive));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2129 else if (f->flags.documentationp)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2130 return XCDR (f->doc_and_interactive);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2131 else if (f->flags.interactivep)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2132 return XCDR (f->doc_and_interactive);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2133 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2134 return f->doc_and_interactive;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2135 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2136
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2137 #ifdef COMPILED_FUNCTION_ANNOTATION_HACK
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2138
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2139 Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2140 compiled_function_annotation (Lisp_Compiled_Function *f)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2141 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2142 return f->annotated;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2143 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2144
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2145 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2146
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2147 /* used only by Snarf-documentation; there must be doc already. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2148 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2149 set_compiled_function_documentation (Lisp_Compiled_Function *f,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2150 Lisp_Object new_doc)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2151 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2152 assert (f->flags.documentationp);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2153 assert (INTP (new_doc) || STRINGP (new_doc));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2154
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2155 if (f->flags.interactivep && f->flags.domainp)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2156 XCAR (f->doc_and_interactive) = new_doc;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2157 else if (f->flags.interactivep)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2158 XCAR (f->doc_and_interactive) = new_doc;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2159 else if (f->flags.domainp)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2160 XCAR (f->doc_and_interactive) = new_doc;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2161 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2162 f->doc_and_interactive = new_doc;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2163 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2164
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2165
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2166 DEFUN ("compiled-function-arglist", Fcompiled_function_arglist, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2167 Return the argument list of the compiled-function object FUNCTION.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2168 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2169 (function))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2170 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2171 CHECK_COMPILED_FUNCTION (function);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2172 return compiled_function_arglist (XCOMPILED_FUNCTION (function));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2173 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2174
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2175 DEFUN ("compiled-function-instructions", Fcompiled_function_instructions, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2176 Return the byte-opcode string of the compiled-function object FUNCTION.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2177 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2178 (function))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2179 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2180 CHECK_COMPILED_FUNCTION (function);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2181 return compiled_function_instructions (XCOMPILED_FUNCTION (function));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2182 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2183
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2184 DEFUN ("compiled-function-constants", Fcompiled_function_constants, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2185 Return the constants vector of the compiled-function object FUNCTION.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2186 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2187 (function))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2188 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2189 CHECK_COMPILED_FUNCTION (function);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2190 return compiled_function_constants (XCOMPILED_FUNCTION (function));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2191 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2192
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2193 DEFUN ("compiled-function-stack-depth", Fcompiled_function_stack_depth, 1, 1, 0, /*
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
2194 Return the maximum stack depth of the compiled-function object FUNCTION.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2195 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2196 (function))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2197 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2198 CHECK_COMPILED_FUNCTION (function);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2199 return make_int (compiled_function_stack_depth (XCOMPILED_FUNCTION (function)));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2200 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2201
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2202 DEFUN ("compiled-function-doc-string", Fcompiled_function_doc_string, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2203 Return the doc string of the compiled-function object FUNCTION, if available.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2204 Functions that had their doc strings snarfed into the DOC file will have
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2205 an integer returned instead of a string.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2206 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2207 (function))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2208 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2209 CHECK_COMPILED_FUNCTION (function);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2210 return compiled_function_documentation (XCOMPILED_FUNCTION (function));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2211 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2212
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2213 DEFUN ("compiled-function-interactive", Fcompiled_function_interactive, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2214 Return the interactive spec of the compiled-function object FUNCTION, or nil.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2215 If non-nil, the return value will be a list whose first element is
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2216 `interactive' and whose second element is the interactive spec.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2217 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2218 (function))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2219 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2220 CHECK_COMPILED_FUNCTION (function);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2221 return XCOMPILED_FUNCTION (function)->flags.interactivep
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2222 ? list2 (Qinteractive,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2223 compiled_function_interactive (XCOMPILED_FUNCTION (function)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2224 : Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2225 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2226
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2227 #ifdef COMPILED_FUNCTION_ANNOTATION_HACK
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2228
826
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 814
diff changeset
2229 DEFUN ("compiled-function-annotation", Fcompiled_function_annotation, 1, 1, 0, /*
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2230 Return the annotation of the compiled-function object FUNCTION, or nil.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2231 The annotation is a piece of information indicating where this
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2232 compiled-function object came from. Generally this will be
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2233 a symbol naming a function; or a string naming a file, if the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2234 compiled-function object was not defined in a function; or nil,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2235 if the compiled-function object was not created as a result of
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2236 a `load'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2237 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2238 (function))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2239 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2240 CHECK_COMPILED_FUNCTION (function);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2241 return compiled_function_annotation (XCOMPILED_FUNCTION (function));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2242 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2243
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2244 #endif /* COMPILED_FUNCTION_ANNOTATION_HACK */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2245
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2246 DEFUN ("compiled-function-domain", Fcompiled_function_domain, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2247 Return the domain of the compiled-function object FUNCTION, or nil.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2248 This is only meaningful if I18N3 was enabled when emacs was compiled.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2249 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2250 (function))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2251 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2252 CHECK_COMPILED_FUNCTION (function);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2253 return XCOMPILED_FUNCTION (function)->flags.domainp
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2254 ? compiled_function_domain (XCOMPILED_FUNCTION (function))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2255 : Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2256 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2257
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2258
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2259
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2260 DEFUN ("fetch-bytecode", Ffetch_bytecode, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2261 If the byte code for compiled function FUNCTION is lazy-loaded, fetch it now.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2262 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2263 (function))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2264 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2265 Lisp_Compiled_Function *f;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2266 CHECK_COMPILED_FUNCTION (function);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2267 f = XCOMPILED_FUNCTION (function);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2268
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2269 if (OPAQUEP (f->instructions) || STRINGP (f->instructions))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2270 return function;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2271
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2272 if (CONSP (f->instructions))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2273 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2274 Lisp_Object tem = read_doc_string (f->instructions);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2275 if (!CONSP (tem))
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 444
diff changeset
2276 signal_error (Qinvalid_byte_code,
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 444
diff changeset
2277 "Invalid lazy-loaded byte code", tem);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2278 /* v18 or v19 bytecode file. Need to Ebolify. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2279 if (f->flags.ebolified && VECTORP (XCDR (tem)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2280 ebolify_bytecode_constants (XCDR (tem));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2281 f->instructions = XCAR (tem);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2282 f->constants = XCDR (tem);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2283 return function;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2284 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2285 abort ();
801
2b676dc88c66 [xemacs-hg @ 2002-04-01 03:58:02 by ben]
ben
parents: 800
diff changeset
2286 return Qnil; /* not (usually) reached */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2287 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2288
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2289 DEFUN ("optimize-compiled-function", Foptimize_compiled_function, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2290 Convert compiled function FUNCTION into an optimized internal form.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2291 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2292 (function))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2293 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2294 Lisp_Compiled_Function *f;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2295 CHECK_COMPILED_FUNCTION (function);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2296 f = XCOMPILED_FUNCTION (function);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2297
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2298 if (OPAQUEP (f->instructions)) /* Already optimized? */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2299 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2300
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2301 optimize_compiled_function (function);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2302 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2303 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2304
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2305 DEFUN ("byte-code", Fbyte_code, 3, 3, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2306 Function used internally in byte-compiled code.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2307 First argument INSTRUCTIONS is a string of byte code.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2308 Second argument CONSTANTS is a vector of constants.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2309 Third argument STACK-DEPTH is the maximum stack depth used in this function.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2310 If STACK-DEPTH is incorrect, Emacs may crash.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2311 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2312 (instructions, constants, stack_depth))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2313 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2314 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2315 int varbind_count;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2316 int program_length;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2317 Opbyte *program;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2318
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2319 CHECK_STRING (instructions);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2320 CHECK_VECTOR (constants);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2321 CHECK_NATNUM (stack_depth);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2322
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2323 /* Optimize the `instructions' string, just like when executing a
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2324 regular compiled function, but don't save it for later since this is
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2325 likely to only be executed once. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2326 program = alloca_array (Opbyte, 1 + 2 * XSTRING_LENGTH (instructions));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2327 optimize_byte_code (instructions, constants, program,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2328 &program_length, &varbind_count);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2329 SPECPDL_RESERVE (varbind_count);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2330 return execute_optimized_program (program,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2331 XINT (stack_depth),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2332 XVECTOR_DATA (constants));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2333 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2334
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2335
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2336 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2337 syms_of_bytecode (void)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2338 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2339 INIT_LRECORD_IMPLEMENTATION (compiled_function);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2340
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2341 DEFERROR_STANDARD (Qinvalid_byte_code, Qinvalid_state);
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 444
diff changeset
2342 DEFSYMBOL (Qbyte_code);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 444
diff changeset
2343 DEFSYMBOL_MULTIWORD_PREDICATE (Qcompiled_functionp);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2344
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2345 DEFSUBR (Fbyte_code);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2346 DEFSUBR (Ffetch_bytecode);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2347 DEFSUBR (Foptimize_compiled_function);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2348
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2349 DEFSUBR (Fcompiled_function_p);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2350 DEFSUBR (Fcompiled_function_instructions);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2351 DEFSUBR (Fcompiled_function_constants);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2352 DEFSUBR (Fcompiled_function_stack_depth);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2353 DEFSUBR (Fcompiled_function_arglist);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2354 DEFSUBR (Fcompiled_function_interactive);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2355 DEFSUBR (Fcompiled_function_doc_string);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2356 DEFSUBR (Fcompiled_function_domain);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2357 #ifdef COMPILED_FUNCTION_ANNOTATION_HACK
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2358 DEFSUBR (Fcompiled_function_annotation);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2359 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2360
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2361 #ifdef BYTE_CODE_METER
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 444
diff changeset
2362 DEFSYMBOL (Qbyte_code_meter);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2363 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2364 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2365
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2366 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2367 vars_of_bytecode (void)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2368 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2369 #ifdef BYTE_CODE_METER
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2370
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2371 DEFVAR_LISP ("byte-code-meter", &Vbyte_code_meter /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2372 A vector of vectors which holds a histogram of byte code usage.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2373 \(aref (aref byte-code-meter 0) CODE) indicates how many times the byte
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2374 opcode CODE has been executed.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2375 \(aref (aref byte-code-meter CODE1) CODE2), where CODE1 is not 0,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2376 indicates how many times the byte opcodes CODE1 and CODE2 have been
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2377 executed in succession.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2378 */ );
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2379 DEFVAR_BOOL ("byte-metering-on", &byte_metering_on /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2380 If non-nil, keep profiling information on byte code usage.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2381 The variable `byte-code-meter' indicates how often each byte opcode is used.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2382 If a symbol has a property named `byte-code-meter' whose value is an
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2383 integer, it is incremented each time that symbol's function is called.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2384 */ );
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2385
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2386 byte_metering_on = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2387 Vbyte_code_meter = make_vector (256, Qzero);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2388 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2389 int i = 256;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2390 while (i--)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2391 XVECTOR_DATA (Vbyte_code_meter)[i] = make_vector (256, Qzero);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2392 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2393 #endif /* BYTE_CODE_METER */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2394 }