annotate src/bytecode.c @ 814:a634e3b7acc8

[xemacs-hg @ 2002-04-14 12:41:59 by ben] latest changes TODO.ben-mule-21-5: Update. make-docfile.c: Add basic support for handling ISO 2022 doc strings -- we parse the basic charset designation sequences so we know whether we're in ASCII and have to pay attention to end quotes and such. Reformat code according to coding standards. abbrev.el: Add `global-abbrev-mode', which turns on or off abbrev-mode in all buffers. Added `defining-abbrev-turns-on-abbrev-mode' -- if non-nil, defining an abbrev through an interactive function will automatically turn on abbrev-mode, either globally or locally depending on the command. This is the "what you'd expect" behavior. indent.el: general function for indenting a balanced expression in a mode-correct way. Works similar to indent-region in that a mode can specify a specific command to do the whole operation; if not, figure out the region using forward-sexp and indent each line using indent-according-to-mode. keydefs.el: Removed. Modify M-C-backslash to do indent-region-or-balanced-expression. Make S-Tab just insert a TAB char, like it's meant to do. make-docfile.el: Now that we're using the call-process-in-lisp, we need to load an extra file win32-native.el because we're running a bare temacs. menubar-items.el: Totally redo the Cmds menu so that most used commands appear directly on the menu and less used commands appear in submenus. The old way may have been very pretty, but rather impractical. process.el: Under Windows, don't ever use old-call-process-internal, even in batch mode. We can do processes in batch mode. subr.el: Someone recoded truncate-string-to-width, saying "the FSF version is too complicated and does lots of hard-to-understand stuff" but the resulting recoded version was *totally* wrong! it misunderstood the basic point of this function, which is work in *columns* not chars. i dumped ours and copied the version from FSF 21.1. Also added truncate-string-with-continuation-dots, since this idiom is used often. config.inc.samp, xemacs.mak: Separate out debug and optimize flags. Remove all vestiges of USE_MINIMAL_TAGBITS, USE_INDEXED_LRECORD_IMPLEMENTATION, and GUNG_HO, since those ifdefs have long been removed. Make error-checking support actually work. Some rearrangement of config.inc.samp to make it more logical. Remove callproc.c and ntproc.c from xemacs.mak, no longer used. Make pdump the default. lisp.h: Add support for strong type-checking of Bytecount, Bytebpos, Charcount, Charbpos, and others, by making them classes, overloading the operators to provide integer-like operation and carefully controlling what operations are allowed. Not currently enabled in C++ builds because there are still a number of compile errors, and it won't really work till we merge in my "8-bit-Mule" workspace, in which I make use of the new types Charxpos, Bytexpos, Memxpos, representing a "position" either in a buffer or a string. (This is especially important in the extent code.) abbrev.c, alloc.c, eval.c, buffer.c, buffer.h, editfns.c, fns.c, text.h: Warning fixes, some of them related to new C++ strict type checking of Bytecount, Charbpos, etc. dired.c: Caught an actual error due to strong type checking -- char len being passed when should be byte len. alloc.c, backtrace.h, bytecode.c, bytecode.h, eval.c, sysdep.c: Further optimize Ffuncall: -- process arg list at compiled-function creation time, converting into an array for extra-quick access at funcall time. -- rewrite funcall_compiled_function to use it, and inline this function. -- change the order of check for magic stuff in SPECBIND_FAST_UNSAFE to be faster. -- move the check for need to garbage collect into the allocation code, so only a single flag needs to be checked in funcall. buffer.c, symbols.c: add debug funs to check on mule optimization info in buffers and strings. eval.c, emacs.c, text.c, regex.c, scrollbar-msw.c, search.c: Fix evil crashes due to eistrings not properly reinitialized under pdump. Redo a bit some of the init routines; convert some complex_vars_of() into simple vars_of(), because they didn't need complex processing. callproc.c, emacs.c, event-stream.c, nt.c, process.c, process.h, sysdep.c, sysdep.h, syssignal.h, syswindows.h, ntproc.c: Delete. Hallelujah, praise the Lord, there is no god but Allah!!! fix so that processes can be invoked in bare temacs -- thereby eliminating any need for callproc.c. (currently only eliminated under NT.) remove all crufty and unnecessary old process code in ntproc.c and elsewhere. move non-callproc-specific stuff (mostly environment) into process.c, so callproc.c can be left out under NT. console-tty.c, doc.c, file-coding.c, file-coding.h, lstream.c, lstream.h: fix doc string handling so it works with Japanese, etc docs. change handling of "character mode" so callers don't have to manually set it (quite error-prone). event-msw.c: spacing fixes. lread.c: eliminate unused crufty vintage-19 "FSF defun hack" code. lrecord.h: improve pdump description docs. buffer.c, ntheap.c, unexnt.c, win32.c, emacs.c: Mule-ize some unexec and startup code. It was pseudo-Mule-ized before by simply always calling the ...A versions of functions, but that won't cut it -- eventually we want to be able to run properly even if XEmacs has been installed in a Japanese directory. (The current problem is the timing of the loading of the Unicode tables; this will eventually be fixed.) Go through and fix various other places where the code was not Mule-clean. Provide a function mswindows_get_module_file_name() to get our own name without resort to PATH_MAX and such. Add a big comment in main() about the problem with Unicode table load timing that I just alluded to. emacs.c: When error-checking is enabled (interpreted as "user is developing XEmacs"), don't ask user to "pause to read messages" when a fatal error has occurred, because it will wedge if we are in an inner modal loop (typically when a menu is popped up) and make us unable to get a useful stack trace in the debugger. text.c: Correct update_entirely_ascii_p_flag to actually work. lisp.h, symsinit.h: declarations for above changes.
author ben
date Sun, 14 Apr 2002 12:43:31 +0000
parents 2b676dc88c66
children 6728e641994e
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"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
59
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
60 EXFUN (Ffetch_bytecode, 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
61
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
62 Lisp_Object Qbyte_code, Qcompiled_functionp, Qinvalid_byte_code;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
63
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
64 enum Opcode /* Byte codes */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
65 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
66 Bvarref = 010,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
67 Bvarset = 020,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
68 Bvarbind = 030,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
69 Bcall = 040,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
70 Bunbind = 050,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
71
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
72 Bnth = 070,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
73 Bsymbolp = 071,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
74 Bconsp = 072,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
75 Bstringp = 073,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
76 Blistp = 074,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
77 Bold_eq = 075,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
78 Bold_memq = 076,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
79 Bnot = 077,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
80 Bcar = 0100,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
81 Bcdr = 0101,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
82 Bcons = 0102,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
83 Blist1 = 0103,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
84 Blist2 = 0104,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
85 Blist3 = 0105,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
86 Blist4 = 0106,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
87 Blength = 0107,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
88 Baref = 0110,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
89 Baset = 0111,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
90 Bsymbol_value = 0112,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
91 Bsymbol_function = 0113,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
92 Bset = 0114,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
93 Bfset = 0115,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
94 Bget = 0116,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
95 Bsubstring = 0117,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
96 Bconcat2 = 0120,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
97 Bconcat3 = 0121,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
98 Bconcat4 = 0122,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
99 Bsub1 = 0123,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
100 Badd1 = 0124,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
101 Beqlsign = 0125,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
102 Bgtr = 0126,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
103 Blss = 0127,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
104 Bleq = 0130,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
105 Bgeq = 0131,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
106 Bdiff = 0132,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
107 Bnegate = 0133,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
108 Bplus = 0134,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
109 Bmax = 0135,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
110 Bmin = 0136,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
111 Bmult = 0137,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
112
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
113 Bpoint = 0140,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
114 Beq = 0141, /* was Bmark,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
115 but no longer generated as of v18 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
116 Bgoto_char = 0142,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
117 Binsert = 0143,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
118 Bpoint_max = 0144,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
119 Bpoint_min = 0145,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
120 Bchar_after = 0146,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
121 Bfollowing_char = 0147,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
122 Bpreceding_char = 0150,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
123 Bcurrent_column = 0151,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
124 Bindent_to = 0152,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
125 Bequal = 0153, /* was Bscan_buffer,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
126 but no longer generated as of v18 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
127 Beolp = 0154,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
128 Beobp = 0155,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
129 Bbolp = 0156,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
130 Bbobp = 0157,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
131 Bcurrent_buffer = 0160,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
132 Bset_buffer = 0161,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
133 Bsave_current_buffer = 0162, /* was Bread_char,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
134 but no longer generated as of v19 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
135 Bmemq = 0163, /* was Bset_mark,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
136 but no longer generated as of v18 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
137 Binteractive_p = 0164, /* Needed since interactive-p takes
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
138 unevalled args */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
139 Bforward_char = 0165,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
140 Bforward_word = 0166,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
141 Bskip_chars_forward = 0167,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
142 Bskip_chars_backward = 0170,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
143 Bforward_line = 0171,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
144 Bchar_syntax = 0172,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
145 Bbuffer_substring = 0173,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
146 Bdelete_region = 0174,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
147 Bnarrow_to_region = 0175,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
148 Bwiden = 0176,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
149 Bend_of_line = 0177,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
150
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
151 Bconstant2 = 0201,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
152 Bgoto = 0202,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
153 Bgotoifnil = 0203,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
154 Bgotoifnonnil = 0204,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
155 Bgotoifnilelsepop = 0205,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
156 Bgotoifnonnilelsepop = 0206,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
157 Breturn = 0207,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
158 Bdiscard = 0210,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
159 Bdup = 0211,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
160
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
161 Bsave_excursion = 0212,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
162 Bsave_window_excursion= 0213,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
163 Bsave_restriction = 0214,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
164 Bcatch = 0215,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
165
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
166 Bunwind_protect = 0216,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
167 Bcondition_case = 0217,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
168 Btemp_output_buffer_setup = 0220,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
169 Btemp_output_buffer_show = 0221,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
170
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
171 Bunbind_all = 0222,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
172
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
173 Bset_marker = 0223,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
174 Bmatch_beginning = 0224,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
175 Bmatch_end = 0225,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
176 Bupcase = 0226,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
177 Bdowncase = 0227,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
178
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
179 Bstring_equal = 0230,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
180 Bstring_lessp = 0231,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
181 Bold_equal = 0232,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
182 Bnthcdr = 0233,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
183 Belt = 0234,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
184 Bold_member = 0235,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
185 Bold_assq = 0236,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
186 Bnreverse = 0237,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
187 Bsetcar = 0240,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
188 Bsetcdr = 0241,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
189 Bcar_safe = 0242,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
190 Bcdr_safe = 0243,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
191 Bnconc = 0244,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
192 Bquo = 0245,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
193 Brem = 0246,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
194 Bnumberp = 0247,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
195 Bintegerp = 0250,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
196
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
197 BRgoto = 0252,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
198 BRgotoifnil = 0253,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
199 BRgotoifnonnil = 0254,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
200 BRgotoifnilelsepop = 0255,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
201 BRgotoifnonnilelsepop = 0256,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
202
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
203 BlistN = 0257,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
204 BconcatN = 0260,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
205 BinsertN = 0261,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
206 Bmember = 0266, /* new in v20 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
207 Bassq = 0267, /* new in v20 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
208
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
209 Bconstant = 0300
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
210 };
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
211 typedef enum Opcode Opcode;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
212
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 Lisp_Object * execute_rare_opcode (Lisp_Object *stack_ptr,
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
215 const Opbyte *program_ptr,
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
216 Opcode opcode);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
217
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
218 /* 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
219 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
220 /* #define BYTE_CODE_METER */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
221
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 #ifdef BYTE_CODE_METER
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
224
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
225 Lisp_Object Vbyte_code_meter, Qbyte_code_meter;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
226 int byte_metering_on;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
227
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
228 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
229 meter_code (Opcode prev_opcode, Opcode this_opcode)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
230 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
231 if (byte_metering_on)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
232 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
233 Lisp_Object *p = XVECTOR_DATA (XVECTOR_DATA (Vbyte_code_meter)[this_opcode]);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
234 p[0] = INT_PLUS1 (p[0]);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
235 if (prev_opcode)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
236 p[prev_opcode] = INT_PLUS1 (p[prev_opcode]);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
237 }
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 #endif /* BYTE_CODE_METER */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
241
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 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
244 bytecode_negate (Lisp_Object obj)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
245 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
246 retry:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
247
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
248 if (INTP (obj)) return make_int (- XINT (obj));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
249 #ifdef LISP_FLOAT_TYPE
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
250 if (FLOATP (obj)) return make_float (- XFLOAT_DATA (obj));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
251 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
252 if (CHARP (obj)) return make_int (- ((int) XCHAR (obj)));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
253 if (MARKERP (obj)) return make_int (- ((int) marker_position (obj)));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
254
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
255 obj = wrong_type_argument (Qnumber_char_or_marker_p, obj);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
256 goto retry;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
257 }
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 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
260 bytecode_nreverse (Lisp_Object list)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
261 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
262 REGISTER Lisp_Object prev = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
263 REGISTER Lisp_Object tail = list;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
264
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
265 while (!NILP (tail))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
266 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
267 REGISTER Lisp_Object next;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
268 CHECK_CONS (tail);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
269 next = XCDR (tail);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
270 XCDR (tail) = prev;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
271 prev = tail;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
272 tail = next;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
273 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
274 return prev;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
275 }
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 /* We have our own two-argument versions of various arithmetic ops.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
279 Only two-argument arithmetic operations have their own byte codes. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
280 static int
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
281 bytecode_arithcompare (Lisp_Object obj1, Lisp_Object obj2)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
282 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
283 retry:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
284
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
285 #ifdef LISP_FLOAT_TYPE
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
286 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
287 EMACS_INT ival1, ival2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
288
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
289 if (INTP (obj1)) ival1 = XINT (obj1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
290 else if (CHARP (obj1)) ival1 = XCHAR (obj1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
291 else if (MARKERP (obj1)) ival1 = marker_position (obj1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
292 else goto arithcompare_float;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
293
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
294 if (INTP (obj2)) ival2 = XINT (obj2);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
295 else if (CHARP (obj2)) ival2 = XCHAR (obj2);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
296 else if (MARKERP (obj2)) ival2 = marker_position (obj2);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
297 else goto arithcompare_float;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
298
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
299 return ival1 < ival2 ? -1 : ival1 > ival2 ? 1 : 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
300 }
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 arithcompare_float:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
303
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 double dval1, dval2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
306
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
307 if (FLOATP (obj1)) dval1 = XFLOAT_DATA (obj1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
308 else if (INTP (obj1)) dval1 = (double) XINT (obj1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
309 else if (CHARP (obj1)) dval1 = (double) XCHAR (obj1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
310 else if (MARKERP (obj1)) dval1 = (double) marker_position (obj1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
311 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
312 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
313 obj1 = wrong_type_argument (Qnumber_char_or_marker_p, obj1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
314 goto retry;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
315 }
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 if (FLOATP (obj2)) dval2 = XFLOAT_DATA (obj2);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
318 else if (INTP (obj2)) dval2 = (double) XINT (obj2);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
319 else if (CHARP (obj2)) dval2 = (double) XCHAR (obj2);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
320 else if (MARKERP (obj2)) dval2 = (double) marker_position (obj2);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
321 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
322 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
323 obj2 = wrong_type_argument (Qnumber_char_or_marker_p, obj2);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
324 goto retry;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
325 }
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 return dval1 < dval2 ? -1 : dval1 > dval2 ? 1 : 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
328 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
329 #else /* !LISP_FLOAT_TYPE */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
330 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
331 EMACS_INT ival1, ival2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
332
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
333 if (INTP (obj1)) ival1 = XINT (obj1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
334 else if (CHARP (obj1)) ival1 = XCHAR (obj1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
335 else if (MARKERP (obj1)) ival1 = marker_position (obj1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
336 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
337 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
338 obj1 = wrong_type_argument (Qnumber_char_or_marker_p, obj1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
339 goto retry;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
340 }
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 if (INTP (obj2)) ival2 = XINT (obj2);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
343 else if (CHARP (obj2)) ival2 = XCHAR (obj2);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
344 else if (MARKERP (obj2)) ival2 = marker_position (obj2);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
345 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
346 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
347 obj2 = wrong_type_argument (Qnumber_char_or_marker_p, obj2);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
348 goto retry;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
349 }
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 return ival1 < ival2 ? -1 : ival1 > ival2 ? 1 : 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
352 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
353 #endif /* !LISP_FLOAT_TYPE */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
354 }
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 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
357 bytecode_arithop (Lisp_Object obj1, Lisp_Object obj2, Opcode opcode)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
358 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
359 #ifdef LISP_FLOAT_TYPE
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
360 EMACS_INT ival1, ival2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
361 int float_p;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
362
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
363 retry:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
364
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
365 float_p = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
366
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
367 if (INTP (obj1)) ival1 = XINT (obj1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
368 else if (CHARP (obj1)) ival1 = XCHAR (obj1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
369 else if (MARKERP (obj1)) ival1 = marker_position (obj1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
370 else if (FLOATP (obj1)) ival1 = 0, float_p = 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
371 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
372 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
373 obj1 = wrong_type_argument (Qnumber_char_or_marker_p, obj1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
374 goto retry;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
375 }
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 if (INTP (obj2)) ival2 = XINT (obj2);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
378 else if (CHARP (obj2)) ival2 = XCHAR (obj2);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
379 else if (MARKERP (obj2)) ival2 = marker_position (obj2);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
380 else if (FLOATP (obj2)) ival2 = 0, float_p = 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
381 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
382 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
383 obj2 = wrong_type_argument (Qnumber_char_or_marker_p, obj2);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
384 goto retry;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
385 }
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 if (!float_p)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
388 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
389 switch (opcode)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
390 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
391 case Bplus: ival1 += ival2; break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
392 case Bdiff: ival1 -= ival2; break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
393 case Bmult: ival1 *= ival2; break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
394 case Bquo:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
395 if (ival2 == 0) Fsignal (Qarith_error, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
396 ival1 /= ival2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
397 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
398 case Bmax: if (ival1 < ival2) ival1 = ival2; break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
399 case Bmin: if (ival1 > ival2) ival1 = ival2; break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
400 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
401 return make_int (ival1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
402 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
403 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
404 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
405 double dval1 = FLOATP (obj1) ? XFLOAT_DATA (obj1) : (double) ival1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
406 double dval2 = FLOATP (obj2) ? XFLOAT_DATA (obj2) : (double) ival2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
407 switch (opcode)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
408 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
409 case Bplus: dval1 += dval2; break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
410 case Bdiff: dval1 -= dval2; break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
411 case Bmult: dval1 *= dval2; break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
412 case Bquo:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
413 if (dval2 == 0) Fsignal (Qarith_error, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
414 dval1 /= dval2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
415 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
416 case Bmax: if (dval1 < dval2) dval1 = dval2; break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
417 case Bmin: if (dval1 > dval2) dval1 = dval2; break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
418 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
419 return make_float (dval1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
420 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
421 #else /* !LISP_FLOAT_TYPE */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
422 EMACS_INT ival1, ival2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
423
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
424 retry:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
425
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
426 if (INTP (obj1)) ival1 = XINT (obj1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
427 else if (CHARP (obj1)) ival1 = XCHAR (obj1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
428 else if (MARKERP (obj1)) ival1 = marker_position (obj1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
429 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
430 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
431 obj1 = wrong_type_argument (Qnumber_char_or_marker_p, obj1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
432 goto retry;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
433 }
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 if (INTP (obj2)) ival2 = XINT (obj2);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
436 else if (CHARP (obj2)) ival2 = XCHAR (obj2);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
437 else if (MARKERP (obj2)) ival2 = marker_position (obj2);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
438 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
439 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
440 obj2 = wrong_type_argument (Qnumber_char_or_marker_p, obj2);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
441 goto retry;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
442 }
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 switch (opcode)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
445 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
446 case Bplus: ival1 += ival2; break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
447 case Bdiff: ival1 -= ival2; break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
448 case Bmult: ival1 *= ival2; break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
449 case Bquo:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
450 if (ival2 == 0) Fsignal (Qarith_error, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
451 ival1 /= ival2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
452 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
453 case Bmax: if (ival1 < ival2) ival1 = ival2; break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
454 case Bmin: if (ival1 > ival2) ival1 = ival2; break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
455 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
456 return make_int (ival1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
457 #endif /* !LISP_FLOAT_TYPE */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
458 }
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 /* Read next uint8 from the instruction stream. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
462 #define READ_UINT_1 ((unsigned int) (unsigned char) *program_ptr++)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
463
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
464 /* Read next uint16 from the instruction stream. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
465 #define READ_UINT_2 \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
466 (program_ptr += 2, \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
467 (((unsigned int) (unsigned char) program_ptr[-1]) * 256 + \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
468 ((unsigned int) (unsigned char) program_ptr[-2])))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
469
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
470 /* Read next int8 from the instruction stream. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
471 #define READ_INT_1 ((int) (signed char) *program_ptr++)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
472
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
473 /* Read next int16 from the instruction stream. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
474 #define READ_INT_2 \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
475 (program_ptr += 2, \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
476 (((int) ( signed char) program_ptr[-1]) * 256 + \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
477 ((int) (unsigned char) program_ptr[-2])))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
478
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
479 /* Read next int8 from instruction stream; don't advance program_pointer */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
480 #define PEEK_INT_1 ((int) (signed char) program_ptr[0])
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
481
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
482 /* Read next int16 from instruction stream; don't advance program_pointer */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
483 #define PEEK_INT_2 \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
484 ((((int) ( signed char) program_ptr[1]) * 256) | \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
485 ((int) (unsigned char) program_ptr[0]))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
486
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
487 /* Do relative jumps from the current location.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
488 We only do a QUIT if we jump backwards, for efficiency.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
489 No infloops without backward jumps! */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
490 #define JUMP_RELATIVE(jump) do { \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
491 int JR_jump = (jump); \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
492 if (JR_jump < 0) QUIT; \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
493 program_ptr += JR_jump; \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
494 } while (0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
495
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
496 #define JUMP JUMP_RELATIVE (PEEK_INT_2)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
497 #define JUMPR JUMP_RELATIVE (PEEK_INT_1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
498
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
499 #define JUMP_NEXT ((void) (program_ptr += 2))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
500 #define JUMPR_NEXT ((void) (program_ptr += 1))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
501
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
502 /* Push x onto the execution stack. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
503 #define PUSH(x) (*++stack_ptr = (x))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
504
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
505 /* Pop a value off the execution stack. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
506 #define POP (*stack_ptr--)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
507
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
508 /* Discard n values from the execution stack. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
509 #define DISCARD(n) (stack_ptr -= (n))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
510
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
511 /* Get the value which is at the top of the execution stack,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
512 but don't pop it. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
513 #define TOP (*stack_ptr)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
514
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
515 /* The actual interpreter for byte code.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
516 This function has been seriously optimized for performance.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
517 Don't change the constructs unless you are willing to do
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
518 real benchmarking and profiling work -- martin */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
519
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
520
814
a634e3b7acc8 [xemacs-hg @ 2002-04-14 12:41:59 by ben]
ben
parents: 801
diff changeset
521 Lisp_Object
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
522 execute_optimized_program (const Opbyte *program,
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
523 int stack_depth,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
524 Lisp_Object *constants_data)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
525 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
526 /* This function can GC */
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
527 REGISTER const Opbyte *program_ptr = (Opbyte *) program;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
528 REGISTER Lisp_Object *stack_ptr
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
529 = alloca_array (Lisp_Object, stack_depth + 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
530 int speccount = specpdl_depth ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
531 struct gcpro gcpro1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
532
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
533 #ifdef BYTE_CODE_METER
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
534 Opcode this_opcode = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
535 Opcode prev_opcode;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
536 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
537
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
538 #ifdef ERROR_CHECK_BYTE_CODE
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
539 Lisp_Object *stack_beg = stack_ptr;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
540 Lisp_Object *stack_end = stack_beg + stack_depth;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
541 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
542
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
543 /* Initialize all the objects on the stack to Qnil,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
544 so we can GCPRO the whole stack.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
545 The first element of the stack is actually a dummy. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
546 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
547 int i;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
548 Lisp_Object *p;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
549 for (i = stack_depth, p = stack_ptr; i--;)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
550 *++p = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
551 }
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 GCPRO1 (stack_ptr[1]);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
554 gcpro1.nvars = stack_depth;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
555
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
556 while (1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
557 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
558 REGISTER Opcode opcode = (Opcode) READ_UINT_1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
559 #ifdef ERROR_CHECK_BYTE_CODE
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
560 if (stack_ptr > stack_end)
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 444
diff changeset
561 stack_overflow ("byte code stack overflow", Qunbound);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
562 if (stack_ptr < stack_beg)
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 444
diff changeset
563 stack_overflow ("byte code stack underflow", Qunbound);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
564 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
565
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
566 #ifdef BYTE_CODE_METER
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
567 prev_opcode = this_opcode;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
568 this_opcode = opcode;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
569 meter_code (prev_opcode, this_opcode);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
570 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
571
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
572 switch (opcode)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
573 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
574 REGISTER int n;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
575
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
576 default:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
577 if (opcode >= Bconstant)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
578 PUSH (constants_data[opcode - Bconstant]);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
579 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
580 stack_ptr = execute_rare_opcode (stack_ptr, program_ptr, opcode);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
581 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
582
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
583 case Bvarref:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
584 case Bvarref+1:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
585 case Bvarref+2:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
586 case Bvarref+3:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
587 case Bvarref+4:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
588 case Bvarref+5: n = opcode - Bvarref; goto do_varref;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
589 case Bvarref+7: n = READ_UINT_2; goto do_varref;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
590 case Bvarref+6: n = READ_UINT_1; /* most common */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
591 do_varref:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
592 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
593 Lisp_Object symbol = constants_data[n];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
594 Lisp_Object value = XSYMBOL (symbol)->value;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
595 if (SYMBOL_VALUE_MAGIC_P (value))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
596 value = Fsymbol_value (symbol);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
597 PUSH (value);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
598 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
599 }
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 case Bvarset:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
602 case Bvarset+1:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
603 case Bvarset+2:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
604 case Bvarset+3:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
605 case Bvarset+4:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
606 case Bvarset+5: n = opcode - Bvarset; goto do_varset;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
607 case Bvarset+7: n = READ_UINT_2; goto do_varset;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
608 case Bvarset+6: n = READ_UINT_1; /* most common */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
609 do_varset:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
610 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
611 Lisp_Object symbol = constants_data[n];
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
612 Lisp_Symbol *symbol_ptr = XSYMBOL (symbol);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
613 Lisp_Object old_value = symbol_ptr->value;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
614 Lisp_Object new_value = POP;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
615 if (!SYMBOL_VALUE_MAGIC_P (old_value) || UNBOUNDP (old_value))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
616 symbol_ptr->value = new_value;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
617 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
618 Fset (symbol, new_value);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
619 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
620 }
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 case Bvarbind:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
623 case Bvarbind+1:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
624 case Bvarbind+2:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
625 case Bvarbind+3:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
626 case Bvarbind+4:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
627 case Bvarbind+5: n = opcode - Bvarbind; goto do_varbind;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
628 case Bvarbind+7: n = READ_UINT_2; goto do_varbind;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
629 case Bvarbind+6: n = READ_UINT_1; /* most common */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
630 do_varbind:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
631 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
632 Lisp_Object symbol = constants_data[n];
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
633 Lisp_Symbol *symbol_ptr = XSYMBOL (symbol);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
634 Lisp_Object old_value = symbol_ptr->value;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
635 Lisp_Object new_value = POP;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
636 if (!SYMBOL_VALUE_MAGIC_P (old_value) || UNBOUNDP (old_value))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
637 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
638 specpdl_ptr->symbol = symbol;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
639 specpdl_ptr->old_value = old_value;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
640 specpdl_ptr->func = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
641 specpdl_ptr++;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
642 specpdl_depth_counter++;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
643
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
644 symbol_ptr->value = new_value;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
645 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
646 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
647 specbind_magic (symbol, new_value);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
648 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
649 }
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 case Bcall:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
652 case Bcall+1:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
653 case Bcall+2:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
654 case Bcall+3:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
655 case Bcall+4:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
656 case Bcall+5:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
657 case Bcall+6:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
658 case Bcall+7:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
659 n = (opcode < Bcall+6 ? opcode - Bcall :
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
660 opcode == Bcall+6 ? READ_UINT_1 : READ_UINT_2);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
661 DISCARD (n);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
662 #ifdef BYTE_CODE_METER
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
663 if (byte_metering_on && SYMBOLP (TOP))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
664 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
665 Lisp_Object val = Fget (TOP, Qbyte_code_meter, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
666 if (INTP (val))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
667 Fput (TOP, Qbyte_code_meter, make_int (XINT (val) + 1));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
668 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
669 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
670 TOP = Ffuncall (n + 1, &TOP);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
671 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
672
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
673 case Bunbind:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
674 case Bunbind+1:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
675 case Bunbind+2:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
676 case Bunbind+3:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
677 case Bunbind+4:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
678 case Bunbind+5:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
679 case Bunbind+6:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
680 case Bunbind+7:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
681 UNBIND_TO (specpdl_depth() -
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
682 (opcode < Bunbind+6 ? opcode-Bunbind :
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
683 opcode == Bunbind+6 ? READ_UINT_1 : READ_UINT_2));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
684 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
685
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
686
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
687 case Bgoto:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
688 JUMP;
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 case Bgotoifnil:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
692 if (NILP (POP))
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 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
695 JUMP_NEXT;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
696 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
697
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
698 case Bgotoifnonnil:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
699 if (!NILP (POP))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
700 JUMP;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
701 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
702 JUMP_NEXT;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
703 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
704
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
705 case Bgotoifnilelsepop:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
706 if (NILP (TOP))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
707 JUMP;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
708 else
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 DISCARD (1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
711 JUMP_NEXT;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
712 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
713 break;
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 case Bgotoifnonnilelsepop:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
716 if (!NILP (TOP))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
717 JUMP;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
718 else
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 DISCARD (1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
721 JUMP_NEXT;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
722 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
723 break;
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
726 case BRgoto:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
727 JUMPR;
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 case BRgotoifnil:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
731 if (NILP (POP))
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 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
734 JUMPR_NEXT;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
735 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
736
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
737 case BRgotoifnonnil:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
738 if (!NILP (POP))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
739 JUMPR;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
740 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
741 JUMPR_NEXT;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
742 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
743
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
744 case BRgotoifnilelsepop:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
745 if (NILP (TOP))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
746 JUMPR;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
747 else
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 DISCARD (1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
750 JUMPR_NEXT;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
751 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
752 break;
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 case BRgotoifnonnilelsepop:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
755 if (!NILP (TOP))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
756 JUMPR;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
757 else
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 DISCARD (1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
760 JUMPR_NEXT;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
761 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
762 break;
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 case Breturn:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
765 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
766 #ifdef ERROR_CHECK_BYTE_CODE
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
767 /* Binds and unbinds are supposed to be compiled balanced. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
768 if (specpdl_depth() != speccount)
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 444
diff changeset
769 invalid_byte_code ("unbalanced specbinding stack", Qunbound);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
770 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
771 return TOP;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
772
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
773 case Bdiscard:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
774 DISCARD (1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
775 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
776
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
777 case Bdup:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
778 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
779 Lisp_Object arg = TOP;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
780 PUSH (arg);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
781 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
782 }
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 case Bconstant2:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
785 PUSH (constants_data[READ_UINT_2]);
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 case Bcar:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
789 TOP = CONSP (TOP) ? XCAR (TOP) : Fcar (TOP);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
790 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
791
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
792 case Bcdr:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
793 TOP = CONSP (TOP) ? XCDR (TOP) : Fcdr (TOP);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
794 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
795
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 Bunbind_all:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
798 /* To unbind back to the beginning of this frame. Not used yet,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
799 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
800 unbind_to (speccount);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
801 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
802
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
803 case Bnth:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
804 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
805 Lisp_Object arg = POP;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
806 TOP = Fcar (Fnthcdr (TOP, arg));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
807 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
808 }
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 case Bsymbolp:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
811 TOP = SYMBOLP (TOP) ? Qt : Qnil;
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 case Bconsp:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
815 TOP = CONSP (TOP) ? Qt : Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
816 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
817
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
818 case Bstringp:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
819 TOP = STRINGP (TOP) ? Qt : Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
820 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
821
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
822 case Blistp:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
823 TOP = LISTP (TOP) ? Qt : Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
824 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
825
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
826 case Bnumberp:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
827 TOP = INT_OR_FLOATP (TOP) ? Qt : Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
828 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
829
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
830 case Bintegerp:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
831 TOP = INTP (TOP) ? Qt : Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
832 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
833
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
834 case Beq:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
835 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
836 Lisp_Object arg = POP;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
837 TOP = EQ_WITH_EBOLA_NOTICE (TOP, arg) ? Qt : Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
838 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
839 }
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 case Bnot:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
842 TOP = NILP (TOP) ? 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 case Bcons:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
846 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
847 Lisp_Object arg = POP;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
848 TOP = Fcons (TOP, arg);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
849 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
850 }
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 case Blist1:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
853 TOP = Fcons (TOP, Qnil);
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 BlistN:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
858 n = READ_UINT_1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
859 goto do_list;
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 case Blist2:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
862 case Blist3:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
863 case Blist4:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
864 /* common case */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
865 n = opcode - (Blist1 - 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
866 do_list:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
867 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
868 Lisp_Object list = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
869 list_loop:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
870 list = Fcons (TOP, list);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
871 if (--n)
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 DISCARD (1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
874 goto list_loop;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
875 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
876 TOP = list;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
877 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
878 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
879
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 case Bconcat2:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
882 case Bconcat3:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
883 case Bconcat4:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
884 n = opcode - (Bconcat2 - 2);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
885 goto do_concat;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
886
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
887 case BconcatN:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
888 /* common case */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
889 n = READ_UINT_1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
890 do_concat:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
891 DISCARD (n - 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
892 TOP = Fconcat (n, &TOP);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
893 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
894
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
895
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
896 case Blength:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
897 TOP = Flength (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 case Baset:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
901 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
902 Lisp_Object arg2 = POP;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
903 Lisp_Object arg1 = POP;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
904 TOP = Faset (TOP, arg1, arg2);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
905 break;
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
908 case Bsymbol_value:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
909 TOP = Fsymbol_value (TOP);
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 case Bsymbol_function:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
913 TOP = Fsymbol_function (TOP);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
914 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
915
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
916 case Bget:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
917 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
918 Lisp_Object arg = POP;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
919 TOP = Fget (TOP, arg, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
920 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
921 }
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 case Bsub1:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
924 TOP = INTP (TOP) ? INT_MINUS1 (TOP) : Fsub1 (TOP);
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 case Badd1:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
928 TOP = INTP (TOP) ? INT_PLUS1 (TOP) : Fadd1 (TOP);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
929 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
930
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 Beqlsign:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
933 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
934 Lisp_Object arg = POP;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
935 TOP = bytecode_arithcompare (TOP, arg) == 0 ? Qt : Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
936 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
937 }
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 case Bgtr:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
940 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
941 Lisp_Object arg = POP;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
942 TOP = bytecode_arithcompare (TOP, arg) > 0 ? Qt : Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
943 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
944 }
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 case Blss:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
947 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
948 Lisp_Object arg = POP;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
949 TOP = bytecode_arithcompare (TOP, arg) < 0 ? Qt : Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
950 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
951 }
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 case Bleq:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
954 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
955 Lisp_Object arg = POP;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
956 TOP = bytecode_arithcompare (TOP, arg) <= 0 ? Qt : Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
957 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
958 }
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 case Bgeq:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
961 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
962 Lisp_Object arg = POP;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
963 TOP = bytecode_arithcompare (TOP, arg) >= 0 ? Qt : Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
964 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
965 }
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
968 case Bnegate:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
969 TOP = bytecode_negate (TOP);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
970 break;
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 case Bnconc:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
973 DISCARD (1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
974 TOP = bytecode_nconc2 (&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 Bplus:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
978 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
979 Lisp_Object arg2 = POP;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
980 Lisp_Object arg1 = TOP;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
981 TOP = INTP (arg1) && INTP (arg2) ?
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
982 INT_PLUS (arg1, arg2) :
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
983 bytecode_arithop (arg1, arg2, opcode);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
984 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
985 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
986
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
987 case Bdiff:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
988 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
989 Lisp_Object arg2 = POP;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
990 Lisp_Object arg1 = TOP;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
991 TOP = INTP (arg1) && INTP (arg2) ?
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
992 INT_MINUS (arg1, arg2) :
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
993 bytecode_arithop (arg1, arg2, opcode);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
994 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
995 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
996
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
997 case Bmult:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
998 case Bquo:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
999 case Bmax:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1000 case Bmin:
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 Lisp_Object arg = POP;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1003 TOP = bytecode_arithop (TOP, arg, opcode);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1004 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1005 }
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 case Bpoint:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1008 PUSH (make_int (BUF_PT (current_buffer)));
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 case Binsert:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1012 TOP = Finsert (1, &TOP);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1013 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1014
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1015 case BinsertN:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1016 n = READ_UINT_1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1017 DISCARD (n - 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1018 TOP = Finsert (n, &TOP);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1019 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1020
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1021 case Baref:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1022 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1023 Lisp_Object arg = POP;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1024 TOP = Faref (TOP, arg);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1025 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1026 }
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 case Bmemq:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1029 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1030 Lisp_Object arg = POP;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1031 TOP = Fmemq (TOP, arg);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1032 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1033 }
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 case Bset:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1036 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1037 Lisp_Object arg = POP;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1038 TOP = Fset (TOP, arg);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1039 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1040 }
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 case Bequal:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1043 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1044 Lisp_Object arg = POP;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1045 TOP = Fequal (TOP, arg);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1046 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1047 }
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 case Bnthcdr:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1050 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1051 Lisp_Object arg = POP;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1052 TOP = Fnthcdr (TOP, arg);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1053 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1054 }
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 case Belt:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1057 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1058 Lisp_Object arg = POP;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1059 TOP = Felt (TOP, arg);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1060 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1061 }
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 case Bmember:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1064 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1065 Lisp_Object arg = POP;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1066 TOP = Fmember (TOP, arg);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1067 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1068 }
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 case Bgoto_char:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1071 TOP = Fgoto_char (TOP, Qnil);
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 case Bcurrent_buffer:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1075 {
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 771
diff changeset
1076 Lisp_Object buffer = wrap_buffer (current_buffer);
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 771
diff changeset
1077
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1078 PUSH (buffer);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1079 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1080 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1081
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1082 case Bset_buffer:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1083 TOP = Fset_buffer (TOP);
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 case Bpoint_max:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1087 PUSH (make_int (BUF_ZV (current_buffer)));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1088 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1089
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1090 case Bpoint_min:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1091 PUSH (make_int (BUF_BEGV (current_buffer)));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1092 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1093
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1094 case Bskip_chars_forward:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1095 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1096 Lisp_Object arg = POP;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1097 TOP = Fskip_chars_forward (TOP, arg, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1098 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1099 }
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 case Bassq:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1102 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1103 Lisp_Object arg = POP;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1104 TOP = Fassq (TOP, arg);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1105 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1106 }
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 case Bsetcar:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1109 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1110 Lisp_Object arg = POP;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1111 TOP = Fsetcar (TOP, arg);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1112 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1113 }
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 case Bsetcdr:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1116 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1117 Lisp_Object arg = POP;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1118 TOP = Fsetcdr (TOP, arg);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1119 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1120 }
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 case Bnreverse:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1123 TOP = bytecode_nreverse (TOP);
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 case Bcar_safe:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1127 TOP = CONSP (TOP) ? XCAR (TOP) : Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1128 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1129
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1130 case Bcdr_safe:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1131 TOP = CONSP (TOP) ? XCDR (TOP) : Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1132 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1133
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 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1136 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1137
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1138 /* It makes a worthwhile performance difference (5%) to shunt
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1139 lesser-used opcodes off to a subroutine, to keep the switch in
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1140 execute_optimized_program small. If you REALLY care about
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1141 performance, you want to keep your heavily executed code away from
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1142 rarely executed code, to minimize cache misses.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1143
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1144 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
1145 Lisp_Object *
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1146 execute_rare_opcode (Lisp_Object *stack_ptr,
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1147 const Opbyte *program_ptr,
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1148 Opcode opcode)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1149 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1150 switch (opcode)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1151 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1152
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1153 case Bsave_excursion:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1154 record_unwind_protect (save_excursion_restore,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1155 save_excursion_save ());
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1156 break;
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_window_excursion:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1159 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1160 int count = specpdl_depth ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1161 record_unwind_protect (save_window_excursion_unwind,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1162 Fcurrent_window_configuration (Qnil));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1163 TOP = Fprogn (TOP);
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1164 unbind_to (count);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1165 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1166 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1167
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1168 case Bsave_restriction:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1169 record_unwind_protect (save_restriction_restore,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1170 save_restriction_save ());
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1171 break;
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 Bcatch:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1174 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1175 Lisp_Object arg = POP;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1176 TOP = internal_catch (TOP, Feval, arg, 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1177 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1178 }
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 case Bskip_chars_backward:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1181 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1182 Lisp_Object arg = POP;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1183 TOP = Fskip_chars_backward (TOP, arg, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1184 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1185 }
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 case Bunwind_protect:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1188 record_unwind_protect (Fprogn, POP);
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 case Bcondition_case:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1192 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1193 Lisp_Object arg2 = POP; /* handlers */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1194 Lisp_Object arg1 = POP; /* bodyform */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1195 TOP = condition_case_3 (arg1, TOP, arg2);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1196 break;
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1199 case Bset_marker:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1200 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1201 Lisp_Object arg2 = POP;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1202 Lisp_Object arg1 = POP;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1203 TOP = Fset_marker (TOP, arg1, arg2);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1204 break;
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1207 case Brem:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1208 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1209 Lisp_Object arg = POP;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1210 TOP = Frem (TOP, arg);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1211 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1212 }
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 case Bmatch_beginning:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1215 TOP = Fmatch_beginning (TOP);
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 case Bmatch_end:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1219 TOP = Fmatch_end (TOP);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1220 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1221
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1222 case Bupcase:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1223 TOP = Fupcase (TOP, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1224 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1225
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1226 case Bdowncase:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1227 TOP = Fdowncase (TOP, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1228 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1229
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1230 case Bfset:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1231 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1232 Lisp_Object arg = POP;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1233 TOP = Ffset (TOP, arg);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1234 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1235 }
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 case Bstring_equal:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1238 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1239 Lisp_Object arg = POP;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1240 TOP = Fstring_equal (TOP, arg);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1241 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1242 }
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 case Bstring_lessp:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1245 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1246 Lisp_Object arg = POP;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1247 TOP = Fstring_lessp (TOP, arg);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1248 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1249 }
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 case Bsubstring:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1252 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1253 Lisp_Object arg2 = POP;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1254 Lisp_Object arg1 = POP;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1255 TOP = Fsubstring (TOP, arg1, arg2);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1256 break;
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1259 case Bcurrent_column:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1260 PUSH (make_int (current_column (current_buffer)));
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 case Bchar_after:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1264 TOP = Fchar_after (TOP, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1265 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1266
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1267 case Bindent_to:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1268 TOP = Findent_to (TOP, Qnil, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1269 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1270
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1271 case Bwiden:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1272 PUSH (Fwiden (Qnil));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1273 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1274
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1275 case Bfollowing_char:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1276 PUSH (Ffollowing_char (Qnil));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1277 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1278
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1279 case Bpreceding_char:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1280 PUSH (Fpreceding_char (Qnil));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1281 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1282
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1283 case Beolp:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1284 PUSH (Feolp (Qnil));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1285 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1286
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1287 case Beobp:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1288 PUSH (Feobp (Qnil));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1289 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1290
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1291 case Bbolp:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1292 PUSH (Fbolp (Qnil));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1293 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1294
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1295 case Bbobp:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1296 PUSH (Fbobp (Qnil));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1297 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1298
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1299 case Bsave_current_buffer:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1300 record_unwind_protect (save_current_buffer_restore,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1301 Fcurrent_buffer ());
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 Binteractive_p:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1305 PUSH (Finteractive_p ());
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1306 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1307
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1308 case Bforward_char:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1309 TOP = Fforward_char (TOP, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1310 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1311
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1312 case Bforward_word:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1313 TOP = Fforward_word (TOP, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1314 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1315
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1316 case Bforward_line:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1317 TOP = Fforward_line (TOP, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1318 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1319
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1320 case Bchar_syntax:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1321 TOP = Fchar_syntax (TOP, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1322 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1323
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1324 case Bbuffer_substring:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1325 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1326 Lisp_Object arg = POP;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1327 TOP = Fbuffer_substring (TOP, arg, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1328 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1329 }
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 case Bdelete_region:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1332 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1333 Lisp_Object arg = POP;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1334 TOP = Fdelete_region (TOP, arg, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1335 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1336 }
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 case Bnarrow_to_region:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1339 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1340 Lisp_Object arg = POP;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1341 TOP = Fnarrow_to_region (TOP, arg, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1342 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1343 }
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 case Bend_of_line:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1346 TOP = Fend_of_line (TOP, 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 case Btemp_output_buffer_setup:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1350 temp_output_buffer_setup (TOP);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1351 TOP = Vstandard_output;
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_show:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1355 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1356 Lisp_Object arg = POP;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1357 temp_output_buffer_show (TOP, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1358 TOP = arg;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1359 /* GAG ME!! */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1360 /* pop binding of standard-output */
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1361 unbind_to (specpdl_depth() - 1);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1362 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1363 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1364
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1365 case Bold_eq:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1366 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1367 Lisp_Object arg = POP;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1368 TOP = HACKEQ_UNSAFE (TOP, arg) ? Qt : Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1369 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1370 }
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 case Bold_memq:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1373 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1374 Lisp_Object arg = POP;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1375 TOP = Fold_memq (TOP, arg);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1376 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1377 }
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 case Bold_equal:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1380 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1381 Lisp_Object arg = POP;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1382 TOP = Fold_equal (TOP, arg);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1383 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1384 }
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 case Bold_member:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1387 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1388 Lisp_Object arg = POP;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1389 TOP = Fold_member (TOP, arg);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1390 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1391 }
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 case Bold_assq:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1394 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1395 Lisp_Object arg = POP;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1396 TOP = Fold_assq (TOP, arg);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1397 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1398 }
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 default:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1401 abort();
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 return stack_ptr;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1405 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1406
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1407
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 444
diff changeset
1408 DOESNT_RETURN
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
1409 invalid_byte_code (const CIntbyte *reason, Lisp_Object frob)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1410 {
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 444
diff changeset
1411 signal_error (Qinvalid_byte_code, reason, frob);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1412 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1413
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1414 /* Check for valid opcodes. Change this when adding new opcodes. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1415 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1416 check_opcode (Opcode opcode)
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 if ((opcode < Bvarref) ||
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1419 (opcode == 0251) ||
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1420 (opcode > Bassq && opcode < Bconstant))
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 444
diff changeset
1421 invalid_byte_code ("invalid opcode in instruction stream",
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 444
diff changeset
1422 make_int (opcode));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1423 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1424
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1425 /* Check that IDX is a valid offset into the `constants' vector */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1426 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1427 check_constants_index (int idx, Lisp_Object constants)
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 if (idx < 0 || idx >= XVECTOR_LENGTH (constants))
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 444
diff changeset
1430 signal_ferror
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 444
diff changeset
1431 (Qinvalid_byte_code,
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 444
diff changeset
1432 "reference %d to constants array out of range 0, %ld",
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1433 idx, XVECTOR_LENGTH (constants) - 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1434 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1435
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1436 /* Get next character from Lisp instructions string. */
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 444
diff changeset
1437 #define READ_INSTRUCTION_CHAR(lvalue) do { \
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 444
diff changeset
1438 (lvalue) = charptr_emchar (ptr); \
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 444
diff changeset
1439 INC_CHARPTR (ptr); \
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 444
diff changeset
1440 *icounts_ptr++ = program_ptr - program; \
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 444
diff changeset
1441 if (lvalue > UCHAR_MAX) \
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 444
diff changeset
1442 invalid_byte_code \
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 444
diff changeset
1443 ("Invalid character in byte code string", make_char (lvalue)); \
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1444 } while (0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1445
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1446 /* Get opcode from Lisp instructions string. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1447 #define READ_OPCODE do { \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1448 unsigned int c; \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1449 READ_INSTRUCTION_CHAR (c); \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1450 opcode = (Opcode) c; \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1451 } while (0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1452
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1453 /* Get next operand, a uint8, from Lisp instructions string. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1454 #define READ_OPERAND_1 do { \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1455 READ_INSTRUCTION_CHAR (arg); \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1456 argsize = 1; \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1457 } while (0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1458
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1459 /* Get next operand, a uint16, from Lisp instructions string. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1460 #define READ_OPERAND_2 do { \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1461 unsigned int arg1, arg2; \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1462 READ_INSTRUCTION_CHAR (arg1); \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1463 READ_INSTRUCTION_CHAR (arg2); \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1464 arg = arg1 + (arg2 << 8); \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1465 argsize = 2; \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1466 } while (0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1467
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1468 /* Write 1 byte to PTR, incrementing PTR */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1469 #define WRITE_INT8(value, ptr) do { \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1470 *((ptr)++) = (value); \
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 2 bytes to PTR, incrementing PTR */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1474 #define WRITE_INT16(value, ptr) do { \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1475 WRITE_INT8 (((unsigned) (value)) & 0x00ff, (ptr)); \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1476 WRITE_INT8 (((unsigned) (value)) >> 8 , (ptr)); \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1477 } while (0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1478
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1479 /* We've changed our minds about the opcode we've already written. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1480 #define REWRITE_OPCODE(new_opcode) ((void) (program_ptr[-1] = new_opcode))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1481
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1482 /* 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
1483 #define WRITE_NARGS(base_opcode) do { \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1484 if (arg <= 5) \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1485 { \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1486 REWRITE_OPCODE (base_opcode + arg); \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1487 } \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1488 else if (arg <= UCHAR_MAX) \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1489 { \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1490 REWRITE_OPCODE (base_opcode + 6); \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1491 WRITE_INT8 (arg, program_ptr); \
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 \
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 + 7); \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1496 WRITE_INT16 (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 } while (0)
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 /* 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
1501 #define WRITE_CONSTANT do { \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1502 check_constants_index(arg, constants); \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1503 if (arg <= UCHAR_MAX - Bconstant) \
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 REWRITE_OPCODE (Bconstant + arg); \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1506 } \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1507 else \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1508 { \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1509 REWRITE_OPCODE (Bconstant2); \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1510 WRITE_INT16 (arg, program_ptr); \
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 } while (0)
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 #define WRITE_OPCODE WRITE_INT8 (opcode, program_ptr)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1515
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1516 /* Compile byte code instructions into free space provided by caller, with
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1517 size >= (2 * string_char_length (instructions) + 1) * sizeof (Opbyte).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1518 Returns length of compiled code. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1519 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1520 optimize_byte_code (/* in */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1521 Lisp_Object instructions,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1522 Lisp_Object constants,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1523 /* out */
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1524 Opbyte * const program,
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1525 int * const program_length,
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1526 int * const varbind_count)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1527 {
647
b39c14581166 [xemacs-hg @ 2001-08-13 04:45:47 by ben]
ben
parents: 609
diff changeset
1528 Bytecount instructions_length = XSTRING_LENGTH (instructions);
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
1529 Elemcount comfy_size = (Elemcount) (2 * instructions_length);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1530
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1531 int * const icounts = alloca_array (int, comfy_size);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1532 int * icounts_ptr = icounts;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1533
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1534 /* We maintain a table of jumps in the source code. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1535 struct jump
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1536 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1537 int from;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1538 int to;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1539 };
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1540 struct jump * const jumps = alloca_array (struct jump, comfy_size);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1541 struct jump *jumps_ptr = jumps;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1542
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1543 Opbyte *program_ptr = program;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1544
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
1545 const Intbyte *ptr = XSTRING_DATA (instructions);
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
1546 const Intbyte * const end = ptr + instructions_length;
428
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 *varbind_count = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1549
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1550 while (ptr < end)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1551 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1552 Opcode opcode;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1553 int arg;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1554 int argsize = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1555 READ_OPCODE;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1556 WRITE_OPCODE;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1557
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1558 switch (opcode)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1559 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1560 Lisp_Object val;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1561
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1562 case Bvarref+7: READ_OPERAND_2; goto do_varref;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1563 case Bvarref+6: READ_OPERAND_1; goto do_varref;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1564 case Bvarref: case Bvarref+1: case Bvarref+2:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1565 case Bvarref+3: case Bvarref+4: case Bvarref+5:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1566 arg = opcode - Bvarref;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1567 do_varref:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1568 check_constants_index (arg, constants);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1569 val = XVECTOR_DATA (constants) [arg];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1570 if (!SYMBOLP (val))
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 444
diff changeset
1571 invalid_byte_code ("variable reference to non-symbol", val);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1572 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
1573 invalid_byte_code ("variable reference to constant symbol", val);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1574 WRITE_NARGS (Bvarref);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1575 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1576
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1577 case Bvarset+7: READ_OPERAND_2; goto do_varset;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1578 case Bvarset+6: READ_OPERAND_1; goto do_varset;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1579 case Bvarset: case Bvarset+1: case Bvarset+2:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1580 case Bvarset+3: case Bvarset+4: case Bvarset+5:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1581 arg = opcode - Bvarset;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1582 do_varset:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1583 check_constants_index (arg, constants);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1584 val = XVECTOR_DATA (constants) [arg];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1585 if (!SYMBOLP (val))
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 444
diff changeset
1586 wtaerror ("attempt to set non-symbol", val);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1587 if (EQ (val, Qnil) || EQ (val, Qt))
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 444
diff changeset
1588 signal_error (Qsetting_constant, 0, val);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1589 /* Ignore assignments to keywords by converting to Bdiscard.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1590 For backward compatibility only - we'd like to make this an error. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1591 if (SYMBOL_IS_KEYWORD (val))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1592 REWRITE_OPCODE (Bdiscard);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1593 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1594 WRITE_NARGS (Bvarset);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1595 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1596
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1597 case Bvarbind+7: READ_OPERAND_2; goto do_varbind;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1598 case Bvarbind+6: READ_OPERAND_1; goto do_varbind;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1599 case Bvarbind: case Bvarbind+1: case Bvarbind+2:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1600 case Bvarbind+3: case Bvarbind+4: case Bvarbind+5:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1601 arg = opcode - Bvarbind;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1602 do_varbind:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1603 (*varbind_count)++;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1604 check_constants_index (arg, constants);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1605 val = XVECTOR_DATA (constants) [arg];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1606 if (!SYMBOLP (val))
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 444
diff changeset
1607 wtaerror ("attempt to let-bind non-symbol", val);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1608 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
1609 signal_error (Qsetting_constant,
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 444
diff changeset
1610 "attempt to let-bind constant symbol", val);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1611 WRITE_NARGS (Bvarbind);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1612 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1613
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1614 case Bcall+7: READ_OPERAND_2; goto do_call;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1615 case Bcall+6: READ_OPERAND_1; goto do_call;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1616 case Bcall: case Bcall+1: case Bcall+2:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1617 case Bcall+3: case Bcall+4: case Bcall+5:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1618 arg = opcode - Bcall;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1619 do_call:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1620 WRITE_NARGS (Bcall);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1621 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1622
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1623 case Bunbind+7: READ_OPERAND_2; goto do_unbind;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1624 case Bunbind+6: READ_OPERAND_1; goto do_unbind;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1625 case Bunbind: case Bunbind+1: case Bunbind+2:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1626 case Bunbind+3: case Bunbind+4: case Bunbind+5:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1627 arg = opcode - Bunbind;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1628 do_unbind:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1629 WRITE_NARGS (Bunbind);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1630 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1631
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1632 case Bgoto:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1633 case Bgotoifnil:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1634 case Bgotoifnonnil:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1635 case Bgotoifnilelsepop:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1636 case Bgotoifnonnilelsepop:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1637 READ_OPERAND_2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1638 /* Make program_ptr-relative */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1639 arg += icounts - (icounts_ptr - argsize);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1640 goto do_jump;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1641
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1642 case BRgoto:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1643 case BRgotoifnil:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1644 case BRgotoifnonnil:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1645 case BRgotoifnilelsepop:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1646 case BRgotoifnonnilelsepop:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1647 READ_OPERAND_1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1648 /* Make program_ptr-relative */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1649 arg -= 127;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1650 do_jump:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1651 /* Record program-relative goto addresses in `jumps' table */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1652 jumps_ptr->from = icounts_ptr - icounts - argsize;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1653 jumps_ptr->to = jumps_ptr->from + arg;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1654 jumps_ptr++;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1655 if (arg >= -1 && arg <= argsize)
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 444
diff changeset
1656 invalid_byte_code ("goto instruction is its own target", Qunbound);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1657 if (arg <= SCHAR_MIN ||
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1658 arg > SCHAR_MAX)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1659 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1660 if (argsize == 1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1661 REWRITE_OPCODE (opcode + Bgoto - BRgoto);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1662 WRITE_INT16 (arg, program_ptr);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1663 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1664 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1665 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1666 if (argsize == 2)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1667 REWRITE_OPCODE (opcode + BRgoto - Bgoto);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1668 WRITE_INT8 (arg, program_ptr);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1669 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1670 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1671
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1672 case Bconstant2:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1673 READ_OPERAND_2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1674 WRITE_CONSTANT;
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 BlistN:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1678 case BconcatN:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1679 case BinsertN:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1680 READ_OPERAND_1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1681 WRITE_INT8 (arg, program_ptr);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1682 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1683
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1684 default:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1685 if (opcode < Bconstant)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1686 check_opcode (opcode);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1687 else
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 arg = opcode - Bconstant;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1690 WRITE_CONSTANT;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1691 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1692 break;
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 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1695
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1696 /* Fix up jumps table to refer to NEW offsets. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1697 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1698 struct jump *j;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1699 for (j = jumps; j < jumps_ptr; j++)
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 #ifdef ERROR_CHECK_BYTE_CODE
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1702 assert (j->from < icounts_ptr - icounts);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1703 assert (j->to < icounts_ptr - icounts);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1704 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1705 j->from = icounts[j->from];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1706 j->to = icounts[j->to];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1707 #ifdef ERROR_CHECK_BYTE_CODE
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1708 assert (j->from < program_ptr - program);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1709 assert (j->to < program_ptr - program);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1710 check_opcode ((Opcode) (program[j->from-1]));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1711 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1712 check_opcode ((Opcode) (program[j->to]));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1713 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1714 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1715
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1716 /* Fixup jumps in byte-code until no more fixups needed */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1717 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1718 int more_fixups_needed = 1;
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 while (more_fixups_needed)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1721 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1722 struct jump *j;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1723 more_fixups_needed = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1724 for (j = jumps; j < jumps_ptr; j++)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1725 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1726 int from = j->from;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1727 int to = j->to;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1728 int jump = to - from;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1729 Opbyte *p = program + from;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1730 Opcode opcode = (Opcode) p[-1];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1731 if (!more_fixups_needed)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1732 check_opcode ((Opcode) p[jump]);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1733 assert (to >= 0 && program + to < program_ptr);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1734 switch (opcode)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1735 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1736 case Bgoto:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1737 case Bgotoifnil:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1738 case Bgotoifnonnil:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1739 case Bgotoifnilelsepop:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1740 case Bgotoifnonnilelsepop:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1741 WRITE_INT16 (jump, p);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1742 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1743
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1744 case BRgoto:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1745 case BRgotoifnil:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1746 case BRgotoifnonnil:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1747 case BRgotoifnilelsepop:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1748 case BRgotoifnonnilelsepop:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1749 if (jump > SCHAR_MIN &&
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1750 jump <= SCHAR_MAX)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1751 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1752 WRITE_INT8 (jump, p);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1753 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1754 else /* barf */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1755 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1756 struct jump *jj;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1757 for (jj = jumps; jj < jumps_ptr; jj++)
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 assert (jj->from < program_ptr - program);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1760 assert (jj->to < program_ptr - program);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1761 if (jj->from > from) jj->from++;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1762 if (jj->to > from) jj->to++;
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 p[-1] += Bgoto - BRgoto;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1765 more_fixups_needed = 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1766 memmove (p+1, p, program_ptr++ - p);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1767 WRITE_INT16 (jump, p);
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 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1770
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1771 default:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1772 abort();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1773 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1774 }
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 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1777 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1778
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1779 /* *program_ptr++ = 0; */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1780 *program_length = program_ptr - program;
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 /* Optimize the byte code and store the optimized program, only
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1784 understood by bytecode.c, in an opaque object in the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1785 instructions slot of the Compiled_Function object. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1786 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1787 optimize_compiled_function (Lisp_Object compiled_function)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1788 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1789 Lisp_Compiled_Function *f = XCOMPILED_FUNCTION (compiled_function);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1790 int program_length;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1791 int varbind_count;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1792 Opbyte *program;
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 /* If we have not actually read the bytecode string
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1795 and constants vector yet, fetch them from the file. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1796 if (CONSP (f->instructions))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1797 Ffetch_bytecode (compiled_function);
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 (STRINGP (f->instructions))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1800 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1801 /* XSTRING_LENGTH() is more efficient than XSTRING_CHAR_LENGTH(),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1802 which would be slightly more `proper' */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1803 program = alloca_array (Opbyte, 1 + 2 * XSTRING_LENGTH (f->instructions));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1804 optimize_byte_code (f->instructions, f->constants,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1805 program, &program_length, &varbind_count);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1806 f->specpdl_depth = XINT (Flength (f->arglist)) + varbind_count;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1807 f->instructions =
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
1808 make_opaque (program, program_length * sizeof (Opbyte));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1809 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1810
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1811 assert (OPAQUEP (f->instructions));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1812 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1813
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 /* The compiled-function object type */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1816 /************************************************************************/
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1817 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1818 print_compiled_function (Lisp_Object obj, Lisp_Object printcharfun,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1819 int escapeflag)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1820 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1821 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1822 Lisp_Compiled_Function *f =
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1823 XCOMPILED_FUNCTION (obj); /* GC doesn't relocate */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1824 int docp = f->flags.documentationp;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1825 int intp = f->flags.interactivep;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1826 struct gcpro gcpro1, gcpro2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1827 GCPRO2 (obj, printcharfun);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1828
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1829 write_c_string (print_readably ? "#[" : "#<compiled-function ", printcharfun);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1830 #ifdef COMPILED_FUNCTION_ANNOTATION_HACK
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1831 if (!print_readably)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1832 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1833 Lisp_Object ann = compiled_function_annotation (f);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1834 if (!NILP (ann))
800
a5954632b187 [xemacs-hg @ 2002-03-31 08:27:14 by ben]
ben
parents: 793
diff changeset
1835 write_fmt_string_lisp (printcharfun, "(from %S) ", 1, ann);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1836 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1837 #endif /* COMPILED_FUNCTION_ANNOTATION_HACK */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1838 /* COMPILED_ARGLIST = 0 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1839 print_internal (compiled_function_arglist (f), printcharfun, escapeflag);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1840
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1841 /* COMPILED_INSTRUCTIONS = 1 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1842 write_c_string (" ", printcharfun);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1843 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1844 struct gcpro ngcpro1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1845 Lisp_Object instructions = compiled_function_instructions (f);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1846 NGCPRO1 (instructions);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1847 if (STRINGP (instructions) && !print_readably)
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 /* 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
1850 write_fmt_string (printcharfun, "\"...(%ld)\"",
a5954632b187 [xemacs-hg @ 2002-03-31 08:27:14 by ben]
ben
parents: 793
diff changeset
1851 (long) XSTRING_CHAR_LENGTH (instructions));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1852 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1853 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1854 print_internal (instructions, printcharfun, escapeflag);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1855 NUNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1856 }
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 /* COMPILED_CONSTANTS = 2 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1859 write_c_string (" ", printcharfun);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1860 print_internal (compiled_function_constants (f), printcharfun, escapeflag);
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 /* COMPILED_STACK_DEPTH = 3 */
800
a5954632b187 [xemacs-hg @ 2002-03-31 08:27:14 by ben]
ben
parents: 793
diff changeset
1863 write_fmt_string (printcharfun, " %d", compiled_function_stack_depth (f));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1864
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1865 /* COMPILED_DOC_STRING = 4 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1866 if (docp || intp)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1867 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1868 write_c_string (" ", printcharfun);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1869 print_internal (compiled_function_documentation (f), printcharfun,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1870 escapeflag);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1871 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1872
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1873 /* COMPILED_INTERACTIVE = 5 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1874 if (intp)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1875 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1876 write_c_string (" ", printcharfun);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1877 print_internal (compiled_function_interactive (f), printcharfun,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1878 escapeflag);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1879 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1880
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1881 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1882 write_c_string (print_readably ? "]" : ">", printcharfun);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1883 }
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 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1887 mark_compiled_function (Lisp_Object obj)
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 Lisp_Compiled_Function *f = XCOMPILED_FUNCTION (obj);
814
a634e3b7acc8 [xemacs-hg @ 2002-04-14 12:41:59 by ben]
ben
parents: 801
diff changeset
1890 int i;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1891
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1892 mark_object (f->instructions);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1893 mark_object (f->arglist);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1894 mark_object (f->doc_and_interactive);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1895 #ifdef COMPILED_FUNCTION_ANNOTATION_HACK
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1896 mark_object (f->annotated);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1897 #endif
814
a634e3b7acc8 [xemacs-hg @ 2002-04-14 12:41:59 by ben]
ben
parents: 801
diff changeset
1898 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
1899 mark_object (f->args[i]);
a634e3b7acc8 [xemacs-hg @ 2002-04-14 12:41:59 by ben]
ben
parents: 801
diff changeset
1900
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1901 /* tail-recurse on constants */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1902 return f->constants;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1903 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1904
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1905 static int
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1906 compiled_function_equal (Lisp_Object obj1, Lisp_Object obj2, int depth)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1907 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1908 Lisp_Compiled_Function *f1 = XCOMPILED_FUNCTION (obj1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1909 Lisp_Compiled_Function *f2 = XCOMPILED_FUNCTION (obj2);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1910 return
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1911 (f1->flags.documentationp == f2->flags.documentationp &&
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1912 f1->flags.interactivep == f2->flags.interactivep &&
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1913 f1->flags.domainp == f2->flags.domainp && /* I18N3 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1914 internal_equal (compiled_function_instructions (f1),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1915 compiled_function_instructions (f2), depth + 1) &&
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1916 internal_equal (f1->constants, f2->constants, depth + 1) &&
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1917 internal_equal (f1->arglist, f2->arglist, depth + 1) &&
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1918 internal_equal (f1->doc_and_interactive,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1919 f2->doc_and_interactive, depth + 1));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1920 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1921
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
1922 static Hashcode
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1923 compiled_function_hash (Lisp_Object obj, int depth)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1924 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1925 Lisp_Compiled_Function *f = XCOMPILED_FUNCTION (obj);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1926 return HASH3 ((f->flags.documentationp << 2) +
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1927 (f->flags.interactivep << 1) +
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1928 f->flags.domainp,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1929 internal_hash (f->instructions, depth + 1),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1930 internal_hash (f->constants, depth + 1));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1931 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1932
814
a634e3b7acc8 [xemacs-hg @ 2002-04-14 12:41:59 by ben]
ben
parents: 801
diff changeset
1933 static const struct lrecord_description lo_description_1[] = {
a634e3b7acc8 [xemacs-hg @ 2002-04-14 12:41:59 by ben]
ben
parents: 801
diff changeset
1934 { XD_LISP_OBJECT, 0 },
a634e3b7acc8 [xemacs-hg @ 2002-04-14 12:41:59 by ben]
ben
parents: 801
diff changeset
1935 { XD_END }
a634e3b7acc8 [xemacs-hg @ 2002-04-14 12:41:59 by ben]
ben
parents: 801
diff changeset
1936 };
a634e3b7acc8 [xemacs-hg @ 2002-04-14 12:41:59 by ben]
ben
parents: 801
diff changeset
1937
a634e3b7acc8 [xemacs-hg @ 2002-04-14 12:41:59 by ben]
ben
parents: 801
diff changeset
1938 static const struct struct_description lo_description = {
a634e3b7acc8 [xemacs-hg @ 2002-04-14 12:41:59 by ben]
ben
parents: 801
diff changeset
1939 sizeof (Lisp_Object),
a634e3b7acc8 [xemacs-hg @ 2002-04-14 12:41:59 by ben]
ben
parents: 801
diff changeset
1940 lo_description_1
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
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1943 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
1944 { 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
1945 { XD_STRUCT_PTR, offsetof (Lisp_Compiled_Function, args),
a634e3b7acc8 [xemacs-hg @ 2002-04-14 12:41:59 by ben]
ben
parents: 801
diff changeset
1946 XD_INDIRECT (0, 0), &lo_description },
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
1947 { XD_LISP_OBJECT, offsetof (Lisp_Compiled_Function, instructions) },
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
1948 { XD_LISP_OBJECT, offsetof (Lisp_Compiled_Function, constants) },
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
1949 { XD_LISP_OBJECT, offsetof (Lisp_Compiled_Function, arglist) },
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
1950 { XD_LISP_OBJECT, offsetof (Lisp_Compiled_Function, doc_and_interactive) },
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1951 #ifdef COMPILED_FUNCTION_ANNOTATION_HACK
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
1952 { XD_LISP_OBJECT, offsetof (Lisp_Compiled_Function, annotated) },
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1953 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1954 { XD_END }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1955 };
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1956
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1957 DEFINE_BASIC_LRECORD_IMPLEMENTATION ("compiled-function", compiled_function,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1958 mark_compiled_function,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1959 print_compiled_function, 0,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1960 compiled_function_equal,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1961 compiled_function_hash,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1962 compiled_function_description,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1963 Lisp_Compiled_Function);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1964
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1965 DEFUN ("compiled-function-p", Fcompiled_function_p, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1966 Return t if OBJECT is a byte-compiled function object.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1967 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1968 (object))
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 return COMPILED_FUNCTIONP (object) ? Qt : Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1971 }
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 /************************************************************************/
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1974 /* compiled-function object accessor functions */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1975 /************************************************************************/
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 Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1978 compiled_function_arglist (Lisp_Compiled_Function *f)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1979 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1980 return f->arglist;
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1983 Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1984 compiled_function_instructions (Lisp_Compiled_Function *f)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1985 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1986 if (! OPAQUEP (f->instructions))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1987 return f->instructions;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1988
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1989 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1990 /* Invert action performed by optimize_byte_code() */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1991 Lisp_Opaque *opaque = XOPAQUE (f->instructions);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1992
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
1993 Intbyte * const buffer =
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
1994 alloca_array (Intbyte, OPAQUE_SIZE (opaque) * MAX_EMCHAR_LEN);
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
1995 Intbyte *bp = buffer;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1996
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1997 const Opbyte * const program = (const Opbyte *) OPAQUE_DATA (opaque);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1998 const Opbyte *program_ptr = program;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1999 const Opbyte * const program_end = program_ptr + OPAQUE_SIZE (opaque);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2000
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2001 while (program_ptr < program_end)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2002 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2003 Opcode opcode = (Opcode) READ_UINT_1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2004 bp += set_charptr_emchar (bp, opcode);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2005 switch (opcode)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2006 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2007 case Bvarref+7:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2008 case Bvarset+7:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2009 case Bvarbind+7:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2010 case Bcall+7:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2011 case Bunbind+7:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2012 case Bconstant2:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2013 bp += set_charptr_emchar (bp, READ_UINT_1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2014 bp += set_charptr_emchar (bp, READ_UINT_1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2015 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2016
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2017 case Bvarref+6:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2018 case Bvarset+6:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2019 case Bvarbind+6:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2020 case Bcall+6:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2021 case Bunbind+6:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2022 case BlistN:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2023 case BconcatN:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2024 case BinsertN:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2025 bp += set_charptr_emchar (bp, READ_UINT_1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2026 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2027
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2028 case Bgoto:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2029 case Bgotoifnil:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2030 case Bgotoifnonnil:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2031 case Bgotoifnilelsepop:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2032 case Bgotoifnonnilelsepop:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2033 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2034 int jump = READ_INT_2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2035 Opbyte buf2[2];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2036 Opbyte *buf2p = buf2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2037 /* Convert back to program-relative address */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2038 WRITE_INT16 (jump + (program_ptr - 2 - program), buf2p);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2039 bp += set_charptr_emchar (bp, buf2[0]);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2040 bp += set_charptr_emchar (bp, buf2[1]);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2041 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2042 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2043
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2044 case BRgoto:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2045 case BRgotoifnil:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2046 case BRgotoifnonnil:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2047 case BRgotoifnilelsepop:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2048 case BRgotoifnonnilelsepop:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2049 bp += set_charptr_emchar (bp, READ_INT_1 + 127);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2050 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2051
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2052 default:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2053 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2054 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2055 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2056 return make_string (buffer, bp - buffer);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2057 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2058 }
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 Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2061 compiled_function_constants (Lisp_Compiled_Function *f)
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 return f->constants;
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2066 int
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2067 compiled_function_stack_depth (Lisp_Compiled_Function *f)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2068 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2069 return f->stack_depth;
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2072 /* The compiled_function->doc_and_interactive slot uses the minimal
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2073 number of conses, based on compiled_function->flags; it may take
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2074 any of the following forms:
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 doc
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2077 interactive
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2078 domain
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2079 (doc . interactive)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2080 (doc . domain)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2081 (interactive . domain)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2082 (doc . (interactive . domain))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2083 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2084
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2085 /* Caller must check flags.interactivep first */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2086 Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2087 compiled_function_interactive (Lisp_Compiled_Function *f)
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 assert (f->flags.interactivep);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2090 if (f->flags.documentationp && f->flags.domainp)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2091 return XCAR (XCDR (f->doc_and_interactive));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2092 else if (f->flags.documentationp)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2093 return XCDR (f->doc_and_interactive);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2094 else if (f->flags.domainp)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2095 return XCAR (f->doc_and_interactive);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2096 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2097 return f->doc_and_interactive;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2098 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2099
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2100 /* Caller need not check flags.documentationp first */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2101 Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2102 compiled_function_documentation (Lisp_Compiled_Function *f)
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 if (! f->flags.documentationp)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2105 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2106 else if (f->flags.interactivep && f->flags.domainp)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2107 return XCAR (f->doc_and_interactive);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2108 else if (f->flags.interactivep)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2109 return XCAR (f->doc_and_interactive);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2110 else if (f->flags.domainp)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2111 return XCAR (f->doc_and_interactive);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2112 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2113 return f->doc_and_interactive;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2114 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2115
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2116 /* Caller need not check flags.domainp first */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2117 Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2118 compiled_function_domain (Lisp_Compiled_Function *f)
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 if (! f->flags.domainp)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2121 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2122 else if (f->flags.documentationp && f->flags.interactivep)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2123 return XCDR (XCDR (f->doc_and_interactive));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2124 else if (f->flags.documentationp)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2125 return XCDR (f->doc_and_interactive);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2126 else if (f->flags.interactivep)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2127 return XCDR (f->doc_and_interactive);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2128 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2129 return f->doc_and_interactive;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2130 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2131
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2132 #ifdef COMPILED_FUNCTION_ANNOTATION_HACK
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2133
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2134 Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2135 compiled_function_annotation (Lisp_Compiled_Function *f)
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 return f->annotated;
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2140 #endif
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 /* used only by Snarf-documentation; there must be doc already. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2143 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2144 set_compiled_function_documentation (Lisp_Compiled_Function *f,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2145 Lisp_Object new_doc)
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 assert (f->flags.documentationp);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2148 assert (INTP (new_doc) || STRINGP (new_doc));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2149
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2150 if (f->flags.interactivep && f->flags.domainp)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2151 XCAR (f->doc_and_interactive) = new_doc;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2152 else if (f->flags.interactivep)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2153 XCAR (f->doc_and_interactive) = new_doc;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2154 else if (f->flags.domainp)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2155 XCAR (f->doc_and_interactive) = new_doc;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2156 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2157 f->doc_and_interactive = new_doc;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2158 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2159
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2160
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2161 DEFUN ("compiled-function-arglist", Fcompiled_function_arglist, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2162 Return the argument list of the compiled-function object FUNCTION.
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 (function))
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 CHECK_COMPILED_FUNCTION (function);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2167 return compiled_function_arglist (XCOMPILED_FUNCTION (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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2170 DEFUN ("compiled-function-instructions", Fcompiled_function_instructions, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2171 Return the byte-opcode string of the compiled-function object FUNCTION.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2172 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2173 (function))
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 CHECK_COMPILED_FUNCTION (function);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2176 return compiled_function_instructions (XCOMPILED_FUNCTION (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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2179 DEFUN ("compiled-function-constants", Fcompiled_function_constants, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2180 Return the constants vector of the compiled-function object FUNCTION.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2181 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2182 (function))
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 CHECK_COMPILED_FUNCTION (function);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2185 return compiled_function_constants (XCOMPILED_FUNCTION (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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2188 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
2189 Return the maximum stack depth of the compiled-function object FUNCTION.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2190 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2191 (function))
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 CHECK_COMPILED_FUNCTION (function);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2194 return make_int (compiled_function_stack_depth (XCOMPILED_FUNCTION (function)));
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2197 DEFUN ("compiled-function-doc-string", Fcompiled_function_doc_string, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2198 Return the doc string of the compiled-function object FUNCTION, if available.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2199 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
2200 an integer returned instead of a string.
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 (function))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2203 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2204 CHECK_COMPILED_FUNCTION (function);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2205 return compiled_function_documentation (XCOMPILED_FUNCTION (function));
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2208 DEFUN ("compiled-function-interactive", Fcompiled_function_interactive, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2209 Return the interactive spec of the compiled-function object FUNCTION, or nil.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2210 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
2211 `interactive' and whose second element is the interactive spec.
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 (function))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2214 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2215 CHECK_COMPILED_FUNCTION (function);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2216 return XCOMPILED_FUNCTION (function)->flags.interactivep
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2217 ? list2 (Qinteractive,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2218 compiled_function_interactive (XCOMPILED_FUNCTION (function)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2219 : Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2220 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2221
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2222 #ifdef COMPILED_FUNCTION_ANNOTATION_HACK
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2223
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2224 /* Remove the `xx' if you wish to restore this feature */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2225 xxDEFUN ("compiled-function-annotation", Fcompiled_function_annotation, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2226 Return the annotation of the compiled-function object FUNCTION, or nil.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2227 The annotation is a piece of information indicating where this
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2228 compiled-function object came from. Generally this will be
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2229 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
2230 compiled-function object was not defined in a function; or nil,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2231 if the compiled-function object was not created as a result of
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2232 a `load'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2233 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2234 (function))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2235 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2236 CHECK_COMPILED_FUNCTION (function);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2237 return compiled_function_annotation (XCOMPILED_FUNCTION (function));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2238 }
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 #endif /* COMPILED_FUNCTION_ANNOTATION_HACK */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2241
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2242 DEFUN ("compiled-function-domain", Fcompiled_function_domain, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2243 Return the domain of the compiled-function object FUNCTION, or nil.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2244 This is only meaningful if I18N3 was enabled when emacs was compiled.
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 (function))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2247 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2248 CHECK_COMPILED_FUNCTION (function);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2249 return XCOMPILED_FUNCTION (function)->flags.domainp
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2250 ? compiled_function_domain (XCOMPILED_FUNCTION (function))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2251 : Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2252 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2253
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2254
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2255
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2256 DEFUN ("fetch-bytecode", Ffetch_bytecode, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2257 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
2258 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2259 (function))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2260 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2261 Lisp_Compiled_Function *f;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2262 CHECK_COMPILED_FUNCTION (function);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2263 f = XCOMPILED_FUNCTION (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 if (OPAQUEP (f->instructions) || STRINGP (f->instructions))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2266 return function;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2267
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2268 if (CONSP (f->instructions))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2269 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2270 Lisp_Object tem = read_doc_string (f->instructions);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2271 if (!CONSP (tem))
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 444
diff changeset
2272 signal_error (Qinvalid_byte_code,
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 444
diff changeset
2273 "Invalid lazy-loaded byte code", tem);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2274 /* v18 or v19 bytecode file. Need to Ebolify. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2275 if (f->flags.ebolified && VECTORP (XCDR (tem)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2276 ebolify_bytecode_constants (XCDR (tem));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2277 f->instructions = XCAR (tem);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2278 f->constants = XCDR (tem);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2279 return function;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2280 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2281 abort ();
801
2b676dc88c66 [xemacs-hg @ 2002-04-01 03:58:02 by ben]
ben
parents: 800
diff changeset
2282 return Qnil; /* not (usually) reached */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2283 }
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 DEFUN ("optimize-compiled-function", Foptimize_compiled_function, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2286 Convert compiled function FUNCTION into an optimized internal form.
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 (function))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2289 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2290 Lisp_Compiled_Function *f;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2291 CHECK_COMPILED_FUNCTION (function);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2292 f = XCOMPILED_FUNCTION (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 if (OPAQUEP (f->instructions)) /* Already optimized? */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2295 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2296
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2297 optimize_compiled_function (function);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2298 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2299 }
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 DEFUN ("byte-code", Fbyte_code, 3, 3, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2302 Function used internally in byte-compiled code.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2303 First argument INSTRUCTIONS is a string of byte code.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2304 Second argument CONSTANTS is a vector of constants.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2305 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
2306 If STACK-DEPTH is incorrect, Emacs may crash.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2307 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2308 (instructions, constants, stack_depth))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2309 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2310 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2311 int varbind_count;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2312 int program_length;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2313 Opbyte *program;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2314
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2315 CHECK_STRING (instructions);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2316 CHECK_VECTOR (constants);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2317 CHECK_NATNUM (stack_depth);
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 /* Optimize the `instructions' string, just like when executing a
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2320 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
2321 likely to only be executed once. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2322 program = alloca_array (Opbyte, 1 + 2 * XSTRING_LENGTH (instructions));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2323 optimize_byte_code (instructions, constants, program,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2324 &program_length, &varbind_count);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2325 SPECPDL_RESERVE (varbind_count);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2326 return execute_optimized_program (program,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2327 XINT (stack_depth),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2328 XVECTOR_DATA (constants));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2329 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2330
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2331
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2332 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2333 syms_of_bytecode (void)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2334 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2335 INIT_LRECORD_IMPLEMENTATION (compiled_function);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2336
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2337 DEFERROR_STANDARD (Qinvalid_byte_code, Qinvalid_state);
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 444
diff changeset
2338 DEFSYMBOL (Qbyte_code);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 444
diff changeset
2339 DEFSYMBOL_MULTIWORD_PREDICATE (Qcompiled_functionp);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2340
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2341 DEFSUBR (Fbyte_code);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2342 DEFSUBR (Ffetch_bytecode);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2343 DEFSUBR (Foptimize_compiled_function);
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 (Fcompiled_function_p);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2346 DEFSUBR (Fcompiled_function_instructions);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2347 DEFSUBR (Fcompiled_function_constants);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2348 DEFSUBR (Fcompiled_function_stack_depth);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2349 DEFSUBR (Fcompiled_function_arglist);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2350 DEFSUBR (Fcompiled_function_interactive);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2351 DEFSUBR (Fcompiled_function_doc_string);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2352 DEFSUBR (Fcompiled_function_domain);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2353 #ifdef COMPILED_FUNCTION_ANNOTATION_HACK
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2354 DEFSUBR (Fcompiled_function_annotation);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2355 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2356
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2357 #ifdef BYTE_CODE_METER
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 444
diff changeset
2358 DEFSYMBOL (Qbyte_code_meter);
428
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2362 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2363 vars_of_bytecode (void)
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 #ifdef BYTE_CODE_METER
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2366
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2367 DEFVAR_LISP ("byte-code-meter", &Vbyte_code_meter /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2368 A vector of vectors which holds a histogram of byte code usage.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2369 \(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
2370 opcode CODE has been executed.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2371 \(aref (aref byte-code-meter CODE1) CODE2), where CODE1 is not 0,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2372 indicates how many times the byte opcodes CODE1 and CODE2 have been
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2373 executed in succession.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2374 */ );
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2375 DEFVAR_BOOL ("byte-metering-on", &byte_metering_on /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2376 If non-nil, keep profiling information on byte code usage.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2377 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
2378 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
2379 integer, it is incremented each time that symbol's function is called.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2380 */ );
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2381
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2382 byte_metering_on = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2383 Vbyte_code_meter = make_vector (256, Qzero);
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 int i = 256;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2386 while (i--)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2387 XVECTOR_DATA (Vbyte_code_meter)[i] = 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 #endif /* BYTE_CODE_METER */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2390 }