annotate src/bytecode.c @ 4407:4ee73bbe4f8e

Always use boyer_moore in ASCII or Latin-1 buffers with ASCII search strings. 2007-12-26 Aidan Kehoe <kehoea@parhasard.net> * casetab.c: Extend and correct some case table documentation. * search.c (search_buffer): Correct a bug where only the first entry for a character in the case equivalence table was examined in determining if the Boyer-Moore search algorithm is appropriate. If there are case mappings outside of the charset and row of the characters specified in the search string, those case mappings can be safely ignored (and Boyer-Moore search can be used) if we know from the buffer statistics that the corresponding characters cannot occur. * search.c (boyer_moore): Assert that we haven't been passed a string with varying characters sets or rows within character sets. That's what simple_search is for. In the very rare event that a character in the search string has a canonical case mapping that is not in the same character set and row, don't try to search for the canonical character, search for some other character that is in the the desired character set and row. Assert that the case table isn't corrupt. Do not search for any character case mappings that cannot possibly occur in the buffer, given the buffer metadata about its contents.
author Aidan Kehoe <kehoea@parhasard.net>
date Wed, 26 Dec 2007 17:30:16 +0100
parents d674024a8674
children 8f1ee2d15784
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1 /* Execution of byte code produced by bytecomp.el.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2 Implementation of compiled-function objects.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3 Copyright (C) 1992, 1993 Free Software Foundation, Inc.
814
a634e3b7acc8 [xemacs-hg @ 2002-04-14 12:41:59 by ben]
ben
parents: 801
diff changeset
4 Copyright (C) 1995, 2002 Ben Wing.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
6 This file is part of XEmacs.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
7
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
8 XEmacs is free software; you can redistribute it and/or modify it
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
9 under the terms of the GNU General Public License as published by the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
10 Free Software Foundation; either version 2, or (at your option) any
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
11 later version.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
12
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
13 XEmacs is distributed in the hope that it will be useful, but WITHOUT
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
14 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
15 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
16 for more details.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
17
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
18 You should have received a copy of the GNU General Public License
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
19 along with XEmacs; see the file COPYING. If not, write to
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
20 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
21 Boston, MA 02111-1307, USA. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
22
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
23 /* Synched up with: Mule 2.0, FSF 19.30. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
24
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
25 /* This file has been Mule-ized. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
26
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
27
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
28 /* Authorship:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
29
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
30 FSF: long ago.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
31
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
32 hacked on by jwz@jwz.org 1991-06
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
33 o added a compile-time switch to turn on simple sanity checking;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
34 o put back the obsolete byte-codes for error-detection;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
35 o added a new instruction, unbind_all, which I will use for
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
36 tail-recursion elimination;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
37 o made temp_output_buffer_show be called with the right number
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
38 of args;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
39 o made the new bytecodes be called with args in the right order;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
40 o added metering support.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
41
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
42 by Hallvard:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
43 o added relative jump instructions;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
44 o all conditionals now only do QUIT if they jump.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
45
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
46 Ben Wing: some changes for Mule, 1995-06.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
47
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
48 Martin Buchholz: performance hacking, 1998-09.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
49 See Internals Manual, Evaluation.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
50 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
51
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
52 #include <config.h>
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
53 #include "lisp.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
54 #include "backtrace.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
55 #include "buffer.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
56 #include "bytecode.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
57 #include "opaque.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
58 #include "syntax.h"
872
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 867
diff changeset
59 #include "window.h"
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
60
3092
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 2720
diff changeset
61 #ifdef NEW_GC
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 2720
diff changeset
62 static Lisp_Object
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 2720
diff changeset
63 make_compiled_function_args (int totalargs)
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 2720
diff changeset
64 {
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 2720
diff changeset
65 Lisp_Compiled_Function_Args *args;
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 2720
diff changeset
66 args = (Lisp_Compiled_Function_Args *)
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 2720
diff changeset
67 alloc_lrecord
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 2720
diff changeset
68 (FLEXIBLE_ARRAY_STRUCT_SIZEOF (Lisp_Compiled_Function_Args,
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 2720
diff changeset
69 Lisp_Object, args, totalargs),
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 2720
diff changeset
70 &lrecord_compiled_function_args);
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 2720
diff changeset
71 args->size = totalargs;
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 2720
diff changeset
72 return wrap_compiled_function_args (args);
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 2720
diff changeset
73 }
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 2720
diff changeset
74
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 2720
diff changeset
75 static Bytecount
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 2720
diff changeset
76 size_compiled_function_args (const void *lheader)
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 2720
diff changeset
77 {
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 2720
diff changeset
78 return FLEXIBLE_ARRAY_STRUCT_SIZEOF (Lisp_Compiled_Function_Args,
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 2720
diff changeset
79 Lisp_Object, args,
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 2720
diff changeset
80 ((Lisp_Compiled_Function_Args *)
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 2720
diff changeset
81 lheader)->size);
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 2720
diff changeset
82 }
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 2720
diff changeset
83
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 2720
diff changeset
84 static const struct memory_description compiled_function_args_description[] = {
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 2720
diff changeset
85 { XD_LONG, offsetof (Lisp_Compiled_Function_Args, size) },
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 2720
diff changeset
86 { XD_LISP_OBJECT_ARRAY, offsetof (Lisp_Compiled_Function_Args, args),
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 2720
diff changeset
87 XD_INDIRECT(0, 0) },
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 2720
diff changeset
88 { XD_END }
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 2720
diff changeset
89 };
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 2720
diff changeset
90
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 2720
diff changeset
91 DEFINE_LRECORD_SEQUENCE_IMPLEMENTATION ("compiled-function-args",
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 2720
diff changeset
92 compiled_function_args,
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 2720
diff changeset
93 1, /*dumpable-flag*/
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 2720
diff changeset
94 0, 0, 0, 0, 0,
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 2720
diff changeset
95 compiled_function_args_description,
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 2720
diff changeset
96 size_compiled_function_args,
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 2720
diff changeset
97 Lisp_Compiled_Function_Args);
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 2720
diff changeset
98 #endif /* NEW_GC */
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 2720
diff changeset
99
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
100 EXFUN (Ffetch_bytecode, 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
101
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
102 Lisp_Object Qbyte_code, Qcompiled_functionp, Qinvalid_byte_code;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
103
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
104 enum Opcode /* Byte codes */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
105 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
106 Bvarref = 010,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
107 Bvarset = 020,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
108 Bvarbind = 030,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
109 Bcall = 040,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
110 Bunbind = 050,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
111
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
112 Bnth = 070,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
113 Bsymbolp = 071,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
114 Bconsp = 072,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
115 Bstringp = 073,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
116 Blistp = 074,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
117 Bold_eq = 075,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
118 Bold_memq = 076,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
119 Bnot = 077,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
120 Bcar = 0100,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
121 Bcdr = 0101,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
122 Bcons = 0102,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
123 Blist1 = 0103,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
124 Blist2 = 0104,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
125 Blist3 = 0105,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
126 Blist4 = 0106,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
127 Blength = 0107,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
128 Baref = 0110,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
129 Baset = 0111,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
130 Bsymbol_value = 0112,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
131 Bsymbol_function = 0113,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
132 Bset = 0114,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
133 Bfset = 0115,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
134 Bget = 0116,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
135 Bsubstring = 0117,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
136 Bconcat2 = 0120,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
137 Bconcat3 = 0121,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
138 Bconcat4 = 0122,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
139 Bsub1 = 0123,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
140 Badd1 = 0124,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
141 Beqlsign = 0125,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
142 Bgtr = 0126,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
143 Blss = 0127,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
144 Bleq = 0130,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
145 Bgeq = 0131,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
146 Bdiff = 0132,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
147 Bnegate = 0133,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
148 Bplus = 0134,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
149 Bmax = 0135,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
150 Bmin = 0136,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
151 Bmult = 0137,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
152
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
153 Bpoint = 0140,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
154 Beq = 0141, /* was Bmark,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
155 but no longer generated as of v18 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
156 Bgoto_char = 0142,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
157 Binsert = 0143,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
158 Bpoint_max = 0144,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
159 Bpoint_min = 0145,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
160 Bchar_after = 0146,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
161 Bfollowing_char = 0147,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
162 Bpreceding_char = 0150,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
163 Bcurrent_column = 0151,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
164 Bindent_to = 0152,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
165 Bequal = 0153, /* was Bscan_buffer,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
166 but no longer generated as of v18 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
167 Beolp = 0154,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
168 Beobp = 0155,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
169 Bbolp = 0156,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
170 Bbobp = 0157,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
171 Bcurrent_buffer = 0160,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
172 Bset_buffer = 0161,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
173 Bsave_current_buffer = 0162, /* was Bread_char,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
174 but no longer generated as of v19 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
175 Bmemq = 0163, /* was Bset_mark,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
176 but no longer generated as of v18 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
177 Binteractive_p = 0164, /* Needed since interactive-p takes
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
178 unevalled args */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
179 Bforward_char = 0165,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
180 Bforward_word = 0166,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
181 Bskip_chars_forward = 0167,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
182 Bskip_chars_backward = 0170,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
183 Bforward_line = 0171,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
184 Bchar_syntax = 0172,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
185 Bbuffer_substring = 0173,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
186 Bdelete_region = 0174,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
187 Bnarrow_to_region = 0175,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
188 Bwiden = 0176,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
189 Bend_of_line = 0177,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
190
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
191 Bconstant2 = 0201,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
192 Bgoto = 0202,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
193 Bgotoifnil = 0203,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
194 Bgotoifnonnil = 0204,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
195 Bgotoifnilelsepop = 0205,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
196 Bgotoifnonnilelsepop = 0206,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
197 Breturn = 0207,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
198 Bdiscard = 0210,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
199 Bdup = 0211,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
200
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
201 Bsave_excursion = 0212,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
202 Bsave_window_excursion= 0213,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
203 Bsave_restriction = 0214,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
204 Bcatch = 0215,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
205
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
206 Bunwind_protect = 0216,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
207 Bcondition_case = 0217,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
208 Btemp_output_buffer_setup = 0220,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
209 Btemp_output_buffer_show = 0221,
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 Bunbind_all = 0222,
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 Bset_marker = 0223,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
214 Bmatch_beginning = 0224,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
215 Bmatch_end = 0225,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
216 Bupcase = 0226,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
217 Bdowncase = 0227,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
218
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
219 Bstring_equal = 0230,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
220 Bstring_lessp = 0231,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
221 Bold_equal = 0232,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
222 Bnthcdr = 0233,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
223 Belt = 0234,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
224 Bold_member = 0235,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
225 Bold_assq = 0236,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
226 Bnreverse = 0237,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
227 Bsetcar = 0240,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
228 Bsetcdr = 0241,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
229 Bcar_safe = 0242,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
230 Bcdr_safe = 0243,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
231 Bnconc = 0244,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
232 Bquo = 0245,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
233 Brem = 0246,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
234 Bnumberp = 0247,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
235 Bintegerp = 0250,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
236
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
237 BRgoto = 0252,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
238 BRgotoifnil = 0253,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
239 BRgotoifnonnil = 0254,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
240 BRgotoifnilelsepop = 0255,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
241 BRgotoifnonnilelsepop = 0256,
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 BlistN = 0257,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
244 BconcatN = 0260,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
245 BinsertN = 0261,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
246 Bmember = 0266, /* new in v20 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
247 Bassq = 0267, /* new in v20 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
248
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
249 Bconstant = 0300
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
250 };
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
251 typedef enum Opcode Opcode;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
252
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
253
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
254 Lisp_Object * execute_rare_opcode (Lisp_Object *stack_ptr,
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
255 const Opbyte *program_ptr,
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
256 Opcode opcode);
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 /* 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
259 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
260 /* #define BYTE_CODE_METER */
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
263 #ifdef BYTE_CODE_METER
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 Lisp_Object Vbyte_code_meter, Qbyte_code_meter;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
266 int byte_metering_on;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
267
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
268 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
269 meter_code (Opcode prev_opcode, Opcode this_opcode)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
270 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
271 if (byte_metering_on)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
272 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
273 Lisp_Object *p = XVECTOR_DATA (XVECTOR_DATA (Vbyte_code_meter)[this_opcode]);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
274 p[0] = INT_PLUS1 (p[0]);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
275 if (prev_opcode)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
276 p[prev_opcode] = INT_PLUS1 (p[prev_opcode]);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
277 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
278 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
279
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
280 #endif /* BYTE_CODE_METER */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
281
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 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
284 bytecode_negate (Lisp_Object obj)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
285 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
286 retry:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
287
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1920
diff changeset
288 if (INTP (obj)) return make_integer (- XINT (obj));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
289 if (FLOATP (obj)) return make_float (- XFLOAT_DATA (obj));
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1920
diff changeset
290 if (CHARP (obj)) return make_integer (- ((int) XCHAR (obj)));
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1920
diff changeset
291 if (MARKERP (obj)) return make_integer (- ((int) marker_position (obj)));
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1920
diff changeset
292 #ifdef HAVE_BIGNUM
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1920
diff changeset
293 if (BIGNUMP (obj)) BIGNUM_ARITH_RETURN (obj, neg);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1920
diff changeset
294 #endif
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1920
diff changeset
295 #ifdef HAVE_RATIO
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1920
diff changeset
296 if (RATIOP (obj)) RATIO_ARITH_RETURN (obj, neg);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1920
diff changeset
297 #endif
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1920
diff changeset
298 #ifdef HAVE_BIG_FLOAT
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1920
diff changeset
299 if (BIGFLOAT_P (obj)) BIGFLOAT_ARITH_RETURN (obj, neg);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1920
diff changeset
300 #endif
428
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 obj = wrong_type_argument (Qnumber_char_or_marker_p, obj);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
303 goto retry;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
304 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
305
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
306 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
307 bytecode_nreverse (Lisp_Object list)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
308 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
309 REGISTER Lisp_Object prev = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
310 REGISTER Lisp_Object tail = list;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
311
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
312 while (!NILP (tail))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
313 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
314 REGISTER Lisp_Object next;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
315 CHECK_CONS (tail);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
316 next = XCDR (tail);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
317 XCDR (tail) = prev;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
318 prev = tail;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
319 tail = next;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
320 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
321 return prev;
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
324
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
325 /* We have our own two-argument versions of various arithmetic ops.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
326 Only two-argument arithmetic operations have their own byte codes. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
327 static int
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
328 bytecode_arithcompare (Lisp_Object obj1, Lisp_Object obj2)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
329 {
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1920
diff changeset
330 #ifdef WITH_NUMBER_TYPES
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1920
diff changeset
331 switch (promote_args (&obj1, &obj2))
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1920
diff changeset
332 {
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1920
diff changeset
333 case FIXNUM_T:
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1920
diff changeset
334 {
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1920
diff changeset
335 EMACS_INT ival1 = XREALINT (obj1), ival2 = XREALINT (obj2);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1920
diff changeset
336 return ival1 < ival2 ? -1 : ival1 > ival2 ? 1 : 0;
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1920
diff changeset
337 }
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1920
diff changeset
338 #ifdef HAVE_BIGNUM
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1920
diff changeset
339 case BIGNUM_T:
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1920
diff changeset
340 return bignum_cmp (XBIGNUM_DATA (obj1), XBIGNUM_DATA (obj2));
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1920
diff changeset
341 #endif
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1920
diff changeset
342 #ifdef HAVE_RATIO
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1920
diff changeset
343 case RATIO_T:
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1920
diff changeset
344 return ratio_cmp (XRATIO_DATA (obj1), XRATIO_DATA (obj2));
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1920
diff changeset
345 #endif
1995
4e6a63799f08 [xemacs-hg @ 2004-04-07 03:48:58 by james]
james
parents: 1983
diff changeset
346 #ifdef HAVE_BIGFLOAT
4e6a63799f08 [xemacs-hg @ 2004-04-07 03:48:58 by james]
james
parents: 1983
diff changeset
347 case BIGFLOAT_T:
4e6a63799f08 [xemacs-hg @ 2004-04-07 03:48:58 by james]
james
parents: 1983
diff changeset
348 return bigfloat_cmp (XBIGFLOAT_DATA (obj1), XBIGFLOAT_DATA (obj2));
4e6a63799f08 [xemacs-hg @ 2004-04-07 03:48:58 by james]
james
parents: 1983
diff changeset
349 #endif
4e6a63799f08 [xemacs-hg @ 2004-04-07 03:48:58 by james]
james
parents: 1983
diff changeset
350 default: /* FLOAT_T */
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1920
diff changeset
351 {
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1920
diff changeset
352 double dval1 = XFLOAT_DATA (obj1), dval2 = XFLOAT_DATA (obj2);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1920
diff changeset
353 return dval1 < dval2 ? -1 : dval1 > dval2 ? 1 : 0;
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1920
diff changeset
354 }
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1920
diff changeset
355 }
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1920
diff changeset
356 #else /* !WITH_NUMBER_TYPES */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
357 retry:
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 {
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
362 if (INTP (obj1)) ival1 = XINT (obj1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
363 else if (CHARP (obj1)) ival1 = XCHAR (obj1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
364 else if (MARKERP (obj1)) ival1 = marker_position (obj1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
365 else goto arithcompare_float;
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 (obj2)) ival2 = XINT (obj2);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
368 else if (CHARP (obj2)) ival2 = XCHAR (obj2);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
369 else if (MARKERP (obj2)) ival2 = marker_position (obj2);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
370 else goto arithcompare_float;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
371
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
372 return ival1 < ival2 ? -1 : ival1 > ival2 ? 1 : 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
373 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
374
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
375 arithcompare_float:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
376
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
377 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
378 double dval1, dval2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
379
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
380 if (FLOATP (obj1)) dval1 = XFLOAT_DATA (obj1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
381 else if (INTP (obj1)) dval1 = (double) XINT (obj1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
382 else if (CHARP (obj1)) dval1 = (double) XCHAR (obj1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
383 else if (MARKERP (obj1)) dval1 = (double) marker_position (obj1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
384 else
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 obj1 = wrong_type_argument (Qnumber_char_or_marker_p, obj1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
387 goto retry;
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
390 if (FLOATP (obj2)) dval2 = XFLOAT_DATA (obj2);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
391 else if (INTP (obj2)) dval2 = (double) XINT (obj2);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
392 else if (CHARP (obj2)) dval2 = (double) XCHAR (obj2);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
393 else if (MARKERP (obj2)) dval2 = (double) marker_position (obj2);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
394 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
395 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
396 obj2 = wrong_type_argument (Qnumber_char_or_marker_p, obj2);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
397 goto retry;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
398 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
399
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
400 return dval1 < dval2 ? -1 : dval1 > dval2 ? 1 : 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
401 }
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1920
diff changeset
402 #endif /* WITH_NUMBER_TYPES */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
403 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
404
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
405 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
406 bytecode_arithop (Lisp_Object obj1, Lisp_Object obj2, Opcode opcode)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
407 {
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1920
diff changeset
408 #ifdef WITH_NUMBER_TYPES
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1920
diff changeset
409 switch (promote_args (&obj1, &obj2))
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1920
diff changeset
410 {
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1920
diff changeset
411 case FIXNUM_T:
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1920
diff changeset
412 {
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1920
diff changeset
413 EMACS_INT ival1 = XREALINT (obj1), ival2 = XREALINT (obj2);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1920
diff changeset
414 switch (opcode)
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1920
diff changeset
415 {
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1920
diff changeset
416 case Bplus: ival1 += ival2; break;
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1920
diff changeset
417 case Bdiff: ival1 -= ival2; break;
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1920
diff changeset
418 case Bmult:
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1920
diff changeset
419 #ifdef HAVE_BIGNUM
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1920
diff changeset
420 /* Due to potential overflow, we compute using bignums */
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1920
diff changeset
421 bignum_set_long (scratch_bignum, ival1);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1920
diff changeset
422 bignum_set_long (scratch_bignum2, ival2);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1920
diff changeset
423 bignum_mul (scratch_bignum, scratch_bignum, scratch_bignum2);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1920
diff changeset
424 return Fcanonicalize_number (make_bignum_bg (scratch_bignum));
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1920
diff changeset
425 #else
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1920
diff changeset
426 ival1 *= ival2; break;
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1920
diff changeset
427 #endif
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1920
diff changeset
428 case Bquo:
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1920
diff changeset
429 if (ival2 == 0) Fsignal (Qarith_error, Qnil);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1920
diff changeset
430 ival1 /= ival2;
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1920
diff changeset
431 break;
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1920
diff changeset
432 case Bmax: if (ival1 < ival2) ival1 = ival2; break;
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1920
diff changeset
433 case Bmin: if (ival1 > ival2) ival1 = ival2; break;
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1920
diff changeset
434 }
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1920
diff changeset
435 return make_integer (ival1);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1920
diff changeset
436 }
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1920
diff changeset
437 #ifdef HAVE_BIGNUM
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1920
diff changeset
438 case BIGNUM_T:
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1920
diff changeset
439 switch (opcode)
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1920
diff changeset
440 {
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1920
diff changeset
441 case Bplus:
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1920
diff changeset
442 bignum_add (scratch_bignum, XBIGNUM_DATA (obj1),
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1920
diff changeset
443 XBIGNUM_DATA (obj2));
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1920
diff changeset
444 break;
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1920
diff changeset
445 case Bdiff:
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1920
diff changeset
446 bignum_sub (scratch_bignum, XBIGNUM_DATA (obj1),
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1920
diff changeset
447 XBIGNUM_DATA (obj2));
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1920
diff changeset
448 break;
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1920
diff changeset
449 case Bmult:
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1920
diff changeset
450 bignum_mul (scratch_bignum, XBIGNUM_DATA (obj1),
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1920
diff changeset
451 XBIGNUM_DATA (obj2));
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1920
diff changeset
452 break;
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1920
diff changeset
453 case Bquo:
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1920
diff changeset
454 if (bignum_sign (XBIGNUM_DATA (obj2)) == 0)
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1920
diff changeset
455 Fsignal (Qarith_error, Qnil);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1920
diff changeset
456 bignum_div (scratch_bignum, XBIGNUM_DATA (obj1),
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1920
diff changeset
457 XBIGNUM_DATA (obj2));
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1920
diff changeset
458 break;
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1920
diff changeset
459 case Bmax:
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1920
diff changeset
460 return bignum_gt (XBIGNUM_DATA (obj1), XBIGNUM_DATA (obj2))
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1920
diff changeset
461 ? obj1 : obj2;
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1920
diff changeset
462 case Bmin:
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1920
diff changeset
463 return bignum_lt (XBIGNUM_DATA (obj1), XBIGNUM_DATA (obj2))
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1920
diff changeset
464 ? obj1 : obj2;
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1920
diff changeset
465 }
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1920
diff changeset
466 return Fcanonicalize_number (make_bignum_bg (scratch_bignum));
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1920
diff changeset
467 #endif
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1920
diff changeset
468 #ifdef HAVE_RATIO
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1920
diff changeset
469 case RATIO_T:
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1920
diff changeset
470 switch (opcode)
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1920
diff changeset
471 {
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1920
diff changeset
472 case Bplus:
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1920
diff changeset
473 ratio_add (scratch_ratio, XRATIO_DATA (obj1), XRATIO_DATA (obj2));
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1920
diff changeset
474 break;
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1920
diff changeset
475 case Bdiff:
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1920
diff changeset
476 ratio_sub (scratch_ratio, XRATIO_DATA (obj1), XRATIO_DATA (obj2));
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1920
diff changeset
477 break;
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1920
diff changeset
478 case Bmult:
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1920
diff changeset
479 ratio_mul (scratch_ratio, XRATIO_DATA (obj1), XRATIO_DATA (obj2));
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1920
diff changeset
480 break;
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1920
diff changeset
481 case Bquo:
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1920
diff changeset
482 if (ratio_sign (XRATIO_DATA (obj2)) == 0)
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1920
diff changeset
483 Fsignal (Qarith_error, Qnil);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1920
diff changeset
484 ratio_div (scratch_ratio, XRATIO_DATA (obj1), XRATIO_DATA (obj2));
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1920
diff changeset
485 break;
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1920
diff changeset
486 case Bmax:
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1920
diff changeset
487 return ratio_gt (XRATIO_DATA (obj1), XRATIO_DATA (obj2))
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1920
diff changeset
488 ? obj1 : obj2;
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1920
diff changeset
489 case Bmin:
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1920
diff changeset
490 return ratio_lt (XRATIO_DATA (obj1), XRATIO_DATA (obj2))
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1920
diff changeset
491 ? obj1 : obj2;
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1920
diff changeset
492 }
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1920
diff changeset
493 return make_ratio_rt (scratch_ratio);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1920
diff changeset
494 #endif
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1920
diff changeset
495 #ifdef HAVE_BIGFLOAT
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1920
diff changeset
496 case BIGFLOAT_T:
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1920
diff changeset
497 bigfloat_set_prec (scratch_bigfloat, max (XBIGFLOAT_GET_PREC (obj1),
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1920
diff changeset
498 XBIGFLOAT_GET_PREC (obj2)));
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1920
diff changeset
499 switch (opcode)
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1920
diff changeset
500 {
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1920
diff changeset
501 case Bplus:
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1920
diff changeset
502 bigfloat_add (scratch_bigfloat, XBIGFLOAT_DATA (obj1),
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1920
diff changeset
503 XBIGFLOAT_DATA (obj2));
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1920
diff changeset
504 break;
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1920
diff changeset
505 case Bdiff:
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1920
diff changeset
506 bigfloat_sub (scratch_bigfloat, XBIGFLOAT_DATA (obj1),
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1920
diff changeset
507 XBIGFLOAT_DATA (obj2));
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1920
diff changeset
508 break;
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1920
diff changeset
509 case Bmult:
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1920
diff changeset
510 bigfloat_mul (scratch_bigfloat, XBIGFLOAT_DATA (obj1),
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1920
diff changeset
511 XBIGFLOAT_DATA (obj2));
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1920
diff changeset
512 break;
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1920
diff changeset
513 case Bquo:
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1920
diff changeset
514 if (bigfloat_sign (XBIGFLOAT_DATA (obj2)) == 0)
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1920
diff changeset
515 Fsignal (Qarith_error, Qnil);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1920
diff changeset
516 bigfloat_div (scratch_bigfloat, XBIGFLOAT_DATA (obj1),
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1920
diff changeset
517 XBIGFLOAT_DATA (obj2));
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1920
diff changeset
518 break;
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1920
diff changeset
519 case Bmax:
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1920
diff changeset
520 return bigfloat_gt (XBIGFLOAT_DATA (obj1), XBIGFLOAT_DATA (obj2))
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1920
diff changeset
521 ? obj1 : obj2;
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1920
diff changeset
522 case Bmin:
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1920
diff changeset
523 return bigfloat_lt (XBIGFLOAT_DATA (obj1), XBIGFLOAT_DATA (obj2))
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1920
diff changeset
524 ? obj1 : obj2;
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1920
diff changeset
525 }
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1920
diff changeset
526 return make_bigfloat_bf (scratch_bigfloat);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1920
diff changeset
527 #endif
1995
4e6a63799f08 [xemacs-hg @ 2004-04-07 03:48:58 by james]
james
parents: 1983
diff changeset
528 default: /* FLOAT_T */
4e6a63799f08 [xemacs-hg @ 2004-04-07 03:48:58 by james]
james
parents: 1983
diff changeset
529 {
4e6a63799f08 [xemacs-hg @ 2004-04-07 03:48:58 by james]
james
parents: 1983
diff changeset
530 double dval1 = XFLOAT_DATA (obj1), dval2 = XFLOAT_DATA (obj2);
4e6a63799f08 [xemacs-hg @ 2004-04-07 03:48:58 by james]
james
parents: 1983
diff changeset
531 switch (opcode)
4e6a63799f08 [xemacs-hg @ 2004-04-07 03:48:58 by james]
james
parents: 1983
diff changeset
532 {
4e6a63799f08 [xemacs-hg @ 2004-04-07 03:48:58 by james]
james
parents: 1983
diff changeset
533 case Bplus: dval1 += dval2; break;
4e6a63799f08 [xemacs-hg @ 2004-04-07 03:48:58 by james]
james
parents: 1983
diff changeset
534 case Bdiff: dval1 -= dval2; break;
4e6a63799f08 [xemacs-hg @ 2004-04-07 03:48:58 by james]
james
parents: 1983
diff changeset
535 case Bmult: dval1 *= dval2; break;
4e6a63799f08 [xemacs-hg @ 2004-04-07 03:48:58 by james]
james
parents: 1983
diff changeset
536 case Bquo:
4e6a63799f08 [xemacs-hg @ 2004-04-07 03:48:58 by james]
james
parents: 1983
diff changeset
537 if (dval2 == 0.0) Fsignal (Qarith_error, Qnil);
4e6a63799f08 [xemacs-hg @ 2004-04-07 03:48:58 by james]
james
parents: 1983
diff changeset
538 dval1 /= dval2;
4e6a63799f08 [xemacs-hg @ 2004-04-07 03:48:58 by james]
james
parents: 1983
diff changeset
539 break;
4e6a63799f08 [xemacs-hg @ 2004-04-07 03:48:58 by james]
james
parents: 1983
diff changeset
540 case Bmax: if (dval1 < dval2) dval1 = dval2; break;
4e6a63799f08 [xemacs-hg @ 2004-04-07 03:48:58 by james]
james
parents: 1983
diff changeset
541 case Bmin: if (dval1 > dval2) dval1 = dval2; break;
4e6a63799f08 [xemacs-hg @ 2004-04-07 03:48:58 by james]
james
parents: 1983
diff changeset
542 }
4e6a63799f08 [xemacs-hg @ 2004-04-07 03:48:58 by james]
james
parents: 1983
diff changeset
543 return make_float (dval1);
4e6a63799f08 [xemacs-hg @ 2004-04-07 03:48:58 by james]
james
parents: 1983
diff changeset
544 }
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1920
diff changeset
545 }
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1920
diff changeset
546 #else /* !WITH_NUMBER_TYPES */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
547 EMACS_INT ival1, ival2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
548 int float_p;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
549
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
550 retry:
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 float_p = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
553
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
554 if (INTP (obj1)) ival1 = XINT (obj1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
555 else if (CHARP (obj1)) ival1 = XCHAR (obj1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
556 else if (MARKERP (obj1)) ival1 = marker_position (obj1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
557 else if (FLOATP (obj1)) ival1 = 0, float_p = 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
558 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
559 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
560 obj1 = wrong_type_argument (Qnumber_char_or_marker_p, obj1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
561 goto retry;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
562 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
563
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
564 if (INTP (obj2)) ival2 = XINT (obj2);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
565 else if (CHARP (obj2)) ival2 = XCHAR (obj2);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
566 else if (MARKERP (obj2)) ival2 = marker_position (obj2);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
567 else if (FLOATP (obj2)) ival2 = 0, float_p = 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
568 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
569 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
570 obj2 = wrong_type_argument (Qnumber_char_or_marker_p, obj2);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
571 goto retry;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
572 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
573
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
574 if (!float_p)
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 switch (opcode)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
577 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
578 case Bplus: ival1 += ival2; break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
579 case Bdiff: ival1 -= ival2; break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
580 case Bmult: ival1 *= ival2; break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
581 case Bquo:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
582 if (ival2 == 0) Fsignal (Qarith_error, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
583 ival1 /= ival2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
584 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
585 case Bmax: if (ival1 < ival2) ival1 = ival2; break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
586 case Bmin: if (ival1 > ival2) ival1 = ival2; break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
587 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
588 return make_int (ival1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
589 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
590 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
591 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
592 double dval1 = FLOATP (obj1) ? XFLOAT_DATA (obj1) : (double) ival1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
593 double dval2 = FLOATP (obj2) ? XFLOAT_DATA (obj2) : (double) ival2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
594 switch (opcode)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
595 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
596 case Bplus: dval1 += dval2; break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
597 case Bdiff: dval1 -= dval2; break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
598 case Bmult: dval1 *= dval2; break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
599 case Bquo:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
600 if (dval2 == 0) Fsignal (Qarith_error, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
601 dval1 /= dval2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
602 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
603 case Bmax: if (dval1 < dval2) dval1 = dval2; break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
604 case Bmin: if (dval1 > dval2) dval1 = dval2; break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
605 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
606 return make_float (dval1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
607 }
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1920
diff changeset
608 #endif /* WITH_NUMBER_TYPES */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
609 }
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
612 /* Read next uint8 from the instruction stream. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
613 #define READ_UINT_1 ((unsigned int) (unsigned char) *program_ptr++)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
614
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
615 /* Read next uint16 from the instruction stream. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
616 #define READ_UINT_2 \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
617 (program_ptr += 2, \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
618 (((unsigned int) (unsigned char) program_ptr[-1]) * 256 + \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
619 ((unsigned int) (unsigned char) program_ptr[-2])))
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 /* Read next int8 from the instruction stream. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
622 #define READ_INT_1 ((int) (signed char) *program_ptr++)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
623
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
624 /* Read next int16 from the instruction stream. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
625 #define READ_INT_2 \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
626 (program_ptr += 2, \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
627 (((int) ( signed char) program_ptr[-1]) * 256 + \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
628 ((int) (unsigned char) program_ptr[-2])))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
629
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
630 /* Read next int8 from instruction stream; don't advance program_pointer */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
631 #define PEEK_INT_1 ((int) (signed char) program_ptr[0])
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
632
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
633 /* Read next int16 from instruction stream; don't advance program_pointer */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
634 #define PEEK_INT_2 \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
635 ((((int) ( signed char) program_ptr[1]) * 256) | \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
636 ((int) (unsigned char) program_ptr[0]))
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 /* Do relative jumps from the current location.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
639 We only do a QUIT if we jump backwards, for efficiency.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
640 No infloops without backward jumps! */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
641 #define JUMP_RELATIVE(jump) do { \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
642 int JR_jump = (jump); \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
643 if (JR_jump < 0) QUIT; \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
644 program_ptr += JR_jump; \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
645 } while (0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
646
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
647 #define JUMP JUMP_RELATIVE (PEEK_INT_2)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
648 #define JUMPR JUMP_RELATIVE (PEEK_INT_1)
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 #define JUMP_NEXT ((void) (program_ptr += 2))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
651 #define JUMPR_NEXT ((void) (program_ptr += 1))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
652
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
653 /* Push x onto the execution stack. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
654 #define PUSH(x) (*++stack_ptr = (x))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
655
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
656 /* Pop a value off the execution stack. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
657 #define POP (*stack_ptr--)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
658
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
659 /* Discard n values from the execution stack. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
660 #define DISCARD(n) (stack_ptr -= (n))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
661
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
662 /* Get the value which is at the top of the execution stack,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
663 but don't pop it. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
664 #define TOP (*stack_ptr)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
665
1920
c66036f59678 [xemacs-hg @ 2004-02-20 07:29:16 by stephent]
stephent
parents: 1884
diff changeset
666 /* See comment before the big switch in execute_optimized_program(). */
1884
3d25fd3d9ac4 [xemacs-hg @ 2004-01-27 13:23:50 by stephent]
stephent
parents: 1758
diff changeset
667 #define GCPRO_STACK (gcpro1.nvars = stack_ptr - stack_beg)
3d25fd3d9ac4 [xemacs-hg @ 2004-01-27 13:23:50 by stephent]
stephent
parents: 1758
diff changeset
668
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
669 /* The actual interpreter for byte code.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
670 This function has been seriously optimized for performance.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
671 Don't change the constructs unless you are willing to do
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
672 real benchmarking and profiling work -- martin */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
673
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
674
814
a634e3b7acc8 [xemacs-hg @ 2002-04-14 12:41:59 by ben]
ben
parents: 801
diff changeset
675 Lisp_Object
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
676 execute_optimized_program (const Opbyte *program,
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
677 int stack_depth,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
678 Lisp_Object *constants_data)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
679 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
680 /* This function can GC */
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
681 REGISTER const Opbyte *program_ptr = (Opbyte *) program;
1884
3d25fd3d9ac4 [xemacs-hg @ 2004-01-27 13:23:50 by stephent]
stephent
parents: 1758
diff changeset
682 Lisp_Object *stack_beg = alloca_array (Lisp_Object, stack_depth + 1);
3d25fd3d9ac4 [xemacs-hg @ 2004-01-27 13:23:50 by stephent]
stephent
parents: 1758
diff changeset
683 REGISTER Lisp_Object *stack_ptr = stack_beg;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
684 int speccount = specpdl_depth ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
685 struct gcpro gcpro1;
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 #ifdef BYTE_CODE_METER
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
688 Opcode this_opcode = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
689 Opcode prev_opcode;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
690 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
691
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
692 #ifdef ERROR_CHECK_BYTE_CODE
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
693 Lisp_Object *stack_end = stack_beg + stack_depth;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
694 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
695
1920
c66036f59678 [xemacs-hg @ 2004-02-20 07:29:16 by stephent]
stephent
parents: 1884
diff changeset
696 /* We used to GCPRO the whole interpreter stack before entering this while
c66036f59678 [xemacs-hg @ 2004-02-20 07:29:16 by stephent]
stephent
parents: 1884
diff changeset
697 loop (21.5.14 and before), but that interferes with collection of weakly
c66036f59678 [xemacs-hg @ 2004-02-20 07:29:16 by stephent]
stephent
parents: 1884
diff changeset
698 referenced objects. Although strictly speaking there's no promise that
c66036f59678 [xemacs-hg @ 2004-02-20 07:29:16 by stephent]
stephent
parents: 1884
diff changeset
699 weak references will disappear by any given point in time, they should
c66036f59678 [xemacs-hg @ 2004-02-20 07:29:16 by stephent]
stephent
parents: 1884
diff changeset
700 be collected at the first opportunity. Waiting until exit from the
c66036f59678 [xemacs-hg @ 2004-02-20 07:29:16 by stephent]
stephent
parents: 1884
diff changeset
701 function caused test failures because "stale" objects "above" the top of
c66036f59678 [xemacs-hg @ 2004-02-20 07:29:16 by stephent]
stephent
parents: 1884
diff changeset
702 the stack were still GCPROed, and they were not getting collected until
c66036f59678 [xemacs-hg @ 2004-02-20 07:29:16 by stephent]
stephent
parents: 1884
diff changeset
703 after exit from the (byte-compiled) test!
c66036f59678 [xemacs-hg @ 2004-02-20 07:29:16 by stephent]
stephent
parents: 1884
diff changeset
704
c66036f59678 [xemacs-hg @ 2004-02-20 07:29:16 by stephent]
stephent
parents: 1884
diff changeset
705 Now the idea is to dynamically adjust the array of GCPROed objects to
c66036f59678 [xemacs-hg @ 2004-02-20 07:29:16 by stephent]
stephent
parents: 1884
diff changeset
706 include only the "active" region of the stack.
c66036f59678 [xemacs-hg @ 2004-02-20 07:29:16 by stephent]
stephent
parents: 1884
diff changeset
707
c66036f59678 [xemacs-hg @ 2004-02-20 07:29:16 by stephent]
stephent
parents: 1884
diff changeset
708 We use the "GCPRO1 the array base and set the nvars member" method. It
c66036f59678 [xemacs-hg @ 2004-02-20 07:29:16 by stephent]
stephent
parents: 1884
diff changeset
709 would be slightly inefficient but correct to use GCPRO1_ARRAY here. It
c66036f59678 [xemacs-hg @ 2004-02-20 07:29:16 by stephent]
stephent
parents: 1884
diff changeset
710 would just redundantly set nvars.
c66036f59678 [xemacs-hg @ 2004-02-20 07:29:16 by stephent]
stephent
parents: 1884
diff changeset
711 #### Maybe it would be clearer to use GCPRO1_ARRAY and do GCPRO_STACK
c66036f59678 [xemacs-hg @ 2004-02-20 07:29:16 by stephent]
stephent
parents: 1884
diff changeset
712 after the switch?
c66036f59678 [xemacs-hg @ 2004-02-20 07:29:16 by stephent]
stephent
parents: 1884
diff changeset
713
c66036f59678 [xemacs-hg @ 2004-02-20 07:29:16 by stephent]
stephent
parents: 1884
diff changeset
714 GCPRO_STACK is something of a misnomer, because it suggests that a
c66036f59678 [xemacs-hg @ 2004-02-20 07:29:16 by stephent]
stephent
parents: 1884
diff changeset
715 struct gcpro is initialized each time. This is false; only the nvars
c66036f59678 [xemacs-hg @ 2004-02-20 07:29:16 by stephent]
stephent
parents: 1884
diff changeset
716 member of a single struct gcpro is being adjusted. This works because
c66036f59678 [xemacs-hg @ 2004-02-20 07:29:16 by stephent]
stephent
parents: 1884
diff changeset
717 each time a new object is assigned to a stack location, the old object
c66036f59678 [xemacs-hg @ 2004-02-20 07:29:16 by stephent]
stephent
parents: 1884
diff changeset
718 loses its reference and is effectively UNGCPROed, and the new object is
c66036f59678 [xemacs-hg @ 2004-02-20 07:29:16 by stephent]
stephent
parents: 1884
diff changeset
719 automatically GCPROed as long as nvars is correct. Only when we
c66036f59678 [xemacs-hg @ 2004-02-20 07:29:16 by stephent]
stephent
parents: 1884
diff changeset
720 return from the interpreter do we need to finalize the struct gcpro
c66036f59678 [xemacs-hg @ 2004-02-20 07:29:16 by stephent]
stephent
parents: 1884
diff changeset
721 itself, and that's done at case Breturn.
c66036f59678 [xemacs-hg @ 2004-02-20 07:29:16 by stephent]
stephent
parents: 1884
diff changeset
722 */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
723 GCPRO1 (stack_ptr[1]);
1758
90502933fb98 [xemacs-hg @ 2003-10-21 08:21:00 by stephent]
stephent
parents: 1737
diff changeset
724
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
725 while (1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
726 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
727 REGISTER Opcode opcode = (Opcode) READ_UINT_1;
1920
c66036f59678 [xemacs-hg @ 2004-02-20 07:29:16 by stephent]
stephent
parents: 1884
diff changeset
728
c66036f59678 [xemacs-hg @ 2004-02-20 07:29:16 by stephent]
stephent
parents: 1884
diff changeset
729 GCPRO_STACK; /* Get nvars right before maybe signaling. */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
730 #ifdef ERROR_CHECK_BYTE_CODE
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
731 if (stack_ptr > stack_end)
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 444
diff changeset
732 stack_overflow ("byte code stack overflow", Qunbound);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
733 if (stack_ptr < stack_beg)
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 444
diff changeset
734 stack_overflow ("byte code stack underflow", Qunbound);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
735 #endif
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 #ifdef BYTE_CODE_METER
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
738 prev_opcode = this_opcode;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
739 this_opcode = opcode;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
740 meter_code (prev_opcode, this_opcode);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
741 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
742
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
743 switch (opcode)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
744 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
745 REGISTER int n;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
746
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
747 default:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
748 if (opcode >= Bconstant)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
749 PUSH (constants_data[opcode - Bconstant]);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
750 else
1884
3d25fd3d9ac4 [xemacs-hg @ 2004-01-27 13:23:50 by stephent]
stephent
parents: 1758
diff changeset
751 {
3d25fd3d9ac4 [xemacs-hg @ 2004-01-27 13:23:50 by stephent]
stephent
parents: 1758
diff changeset
752 /* We're not sure what these do, so better safe than sorry. */
3d25fd3d9ac4 [xemacs-hg @ 2004-01-27 13:23:50 by stephent]
stephent
parents: 1758
diff changeset
753 /* GCPRO_STACK; */
3d25fd3d9ac4 [xemacs-hg @ 2004-01-27 13:23:50 by stephent]
stephent
parents: 1758
diff changeset
754 stack_ptr = execute_rare_opcode (stack_ptr, program_ptr, opcode);
3d25fd3d9ac4 [xemacs-hg @ 2004-01-27 13:23:50 by stephent]
stephent
parents: 1758
diff changeset
755 }
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
756 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
757
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
758 case Bvarref:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
759 case Bvarref+1:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
760 case Bvarref+2:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
761 case Bvarref+3:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
762 case Bvarref+4:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
763 case Bvarref+5: n = opcode - Bvarref; goto do_varref;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
764 case Bvarref+7: n = READ_UINT_2; goto do_varref;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
765 case Bvarref+6: n = READ_UINT_1; /* most common */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
766 do_varref:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
767 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
768 Lisp_Object symbol = constants_data[n];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
769 Lisp_Object value = XSYMBOL (symbol)->value;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
770 if (SYMBOL_VALUE_MAGIC_P (value))
1920
c66036f59678 [xemacs-hg @ 2004-02-20 07:29:16 by stephent]
stephent
parents: 1884
diff changeset
771 /* I GCPRO_STACKed Fsymbol_value elsewhere, but I dunno why. */
c66036f59678 [xemacs-hg @ 2004-02-20 07:29:16 by stephent]
stephent
parents: 1884
diff changeset
772 /* GCPRO_STACK; */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
773 value = Fsymbol_value (symbol);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
774 PUSH (value);
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
778 case Bvarset:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
779 case Bvarset+1:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
780 case Bvarset+2:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
781 case Bvarset+3:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
782 case Bvarset+4:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
783 case Bvarset+5: n = opcode - Bvarset; goto do_varset;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
784 case Bvarset+7: n = READ_UINT_2; goto do_varset;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
785 case Bvarset+6: n = READ_UINT_1; /* most common */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
786 do_varset:
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 Lisp_Object symbol = constants_data[n];
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
789 Lisp_Symbol *symbol_ptr = XSYMBOL (symbol);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
790 Lisp_Object old_value = symbol_ptr->value;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
791 Lisp_Object new_value = POP;
1661
2264738f7ae4 [xemacs-hg @ 2003-09-02 13:18:14 by michaels]
michaels
parents: 1630
diff changeset
792 if (!SYMBOL_VALUE_MAGIC_P (old_value) || UNBOUNDP (old_value))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
793 symbol_ptr->value = new_value;
1884
3d25fd3d9ac4 [xemacs-hg @ 2004-01-27 13:23:50 by stephent]
stephent
parents: 1758
diff changeset
794 else {
3d25fd3d9ac4 [xemacs-hg @ 2004-01-27 13:23:50 by stephent]
stephent
parents: 1758
diff changeset
795 /* Fset may call magic handlers */
3d25fd3d9ac4 [xemacs-hg @ 2004-01-27 13:23:50 by stephent]
stephent
parents: 1758
diff changeset
796 /* GCPRO_STACK; */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
797 Fset (symbol, new_value);
1884
3d25fd3d9ac4 [xemacs-hg @ 2004-01-27 13:23:50 by stephent]
stephent
parents: 1758
diff changeset
798 }
3d25fd3d9ac4 [xemacs-hg @ 2004-01-27 13:23:50 by stephent]
stephent
parents: 1758
diff changeset
799
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
800 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
801 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
802
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
803 case Bvarbind:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
804 case Bvarbind+1:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
805 case Bvarbind+2:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
806 case Bvarbind+3:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
807 case Bvarbind+4:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
808 case Bvarbind+5: n = opcode - Bvarbind; goto do_varbind;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
809 case Bvarbind+7: n = READ_UINT_2; goto do_varbind;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
810 case Bvarbind+6: n = READ_UINT_1; /* most common */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
811 do_varbind:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
812 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
813 Lisp_Object symbol = constants_data[n];
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
814 Lisp_Symbol *symbol_ptr = XSYMBOL (symbol);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
815 Lisp_Object old_value = symbol_ptr->value;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
816 Lisp_Object new_value = POP;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
817 if (!SYMBOL_VALUE_MAGIC_P (old_value) || UNBOUNDP (old_value))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
818 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
819 specpdl_ptr->symbol = symbol;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
820 specpdl_ptr->old_value = old_value;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
821 specpdl_ptr->func = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
822 specpdl_ptr++;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
823 specpdl_depth_counter++;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
824
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
825 symbol_ptr->value = new_value;
853
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 844
diff changeset
826
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 844
diff changeset
827 #ifdef ERROR_CHECK_CATCH
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 844
diff changeset
828 check_specbind_stack_sanity ();
2b6fa2618f76 [xemacs-hg @ 2002-05-28 08:44:22 by ben]
ben
parents: 844
diff changeset
829 #endif
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
830 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
831 else
1884
3d25fd3d9ac4 [xemacs-hg @ 2004-01-27 13:23:50 by stephent]
stephent
parents: 1758
diff changeset
832 {
3d25fd3d9ac4 [xemacs-hg @ 2004-01-27 13:23:50 by stephent]
stephent
parents: 1758
diff changeset
833 /* does an Fset, may call magic handlers */
3d25fd3d9ac4 [xemacs-hg @ 2004-01-27 13:23:50 by stephent]
stephent
parents: 1758
diff changeset
834 /* GCPRO_STACK; */
3d25fd3d9ac4 [xemacs-hg @ 2004-01-27 13:23:50 by stephent]
stephent
parents: 1758
diff changeset
835 specbind_magic (symbol, new_value);
3d25fd3d9ac4 [xemacs-hg @ 2004-01-27 13:23:50 by stephent]
stephent
parents: 1758
diff changeset
836 }
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
837 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
838 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
839
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
840 case Bcall:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
841 case Bcall+1:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
842 case Bcall+2:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
843 case Bcall+3:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
844 case Bcall+4:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
845 case Bcall+5:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
846 case Bcall+6:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
847 case Bcall+7:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
848 n = (opcode < Bcall+6 ? opcode - Bcall :
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
849 opcode == Bcall+6 ? READ_UINT_1 : READ_UINT_2);
1920
c66036f59678 [xemacs-hg @ 2004-02-20 07:29:16 by stephent]
stephent
parents: 1884
diff changeset
850 /* #### Shouldn't this be just before the Ffuncall?
c66036f59678 [xemacs-hg @ 2004-02-20 07:29:16 by stephent]
stephent
parents: 1884
diff changeset
851 Neither Fget nor Fput can GC. */
1884
3d25fd3d9ac4 [xemacs-hg @ 2004-01-27 13:23:50 by stephent]
stephent
parents: 1758
diff changeset
852 /* GCPRO_STACK; */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
853 DISCARD (n);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
854 #ifdef BYTE_CODE_METER
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
855 if (byte_metering_on && SYMBOLP (TOP))
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 Lisp_Object val = Fget (TOP, Qbyte_code_meter, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
858 if (INTP (val))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
859 Fput (TOP, Qbyte_code_meter, make_int (XINT (val) + 1));
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 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
862 TOP = Ffuncall (n + 1, &TOP);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
863 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
864
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
865 case Bunbind:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
866 case Bunbind+1:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
867 case Bunbind+2:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
868 case Bunbind+3:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
869 case Bunbind+4:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
870 case Bunbind+5:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
871 case Bunbind+6:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
872 case Bunbind+7:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
873 UNBIND_TO (specpdl_depth() -
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
874 (opcode < Bunbind+6 ? opcode-Bunbind :
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
875 opcode == Bunbind+6 ? READ_UINT_1 : READ_UINT_2));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
876 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
877
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
878
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
879 case Bgoto:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
880 JUMP;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
881 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
882
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
883 case Bgotoifnil:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
884 if (NILP (POP))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
885 JUMP;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
886 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
887 JUMP_NEXT;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
888 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
889
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
890 case Bgotoifnonnil:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
891 if (!NILP (POP))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
892 JUMP;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
893 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
894 JUMP_NEXT;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
895 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
896
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
897 case Bgotoifnilelsepop:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
898 if (NILP (TOP))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
899 JUMP;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
900 else
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 DISCARD (1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
903 JUMP_NEXT;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
904 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
905 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 case Bgotoifnonnilelsepop:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
908 if (!NILP (TOP))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
909 JUMP;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
910 else
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 DISCARD (1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
913 JUMP_NEXT;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
914 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
915 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
916
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
917
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
918 case BRgoto:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
919 JUMPR;
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 case BRgotoifnil:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
923 if (NILP (POP))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
924 JUMPR;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
925 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
926 JUMPR_NEXT;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
927 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
928
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
929 case BRgotoifnonnil:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
930 if (!NILP (POP))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
931 JUMPR;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
932 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
933 JUMPR_NEXT;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
934 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
935
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
936 case BRgotoifnilelsepop:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
937 if (NILP (TOP))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
938 JUMPR;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
939 else
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 DISCARD (1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
942 JUMPR_NEXT;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
943 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
944 break;
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 BRgotoifnonnilelsepop:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
947 if (!NILP (TOP))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
948 JUMPR;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
949 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
950 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
951 DISCARD (1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
952 JUMPR_NEXT;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
953 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
954 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
955
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
956 case Breturn:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
957 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
958 #ifdef ERROR_CHECK_BYTE_CODE
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
959 /* Binds and unbinds are supposed to be compiled balanced. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
960 if (specpdl_depth() != speccount)
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 444
diff changeset
961 invalid_byte_code ("unbalanced specbinding stack", Qunbound);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
962 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
963 return TOP;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
964
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
965 case Bdiscard:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
966 DISCARD (1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
967 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
968
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
969 case Bdup:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
970 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
971 Lisp_Object arg = TOP;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
972 PUSH (arg);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
973 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
974 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
975
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
976 case Bconstant2:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
977 PUSH (constants_data[READ_UINT_2]);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
978 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
979
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
980 case Bcar:
1920
c66036f59678 [xemacs-hg @ 2004-02-20 07:29:16 by stephent]
stephent
parents: 1884
diff changeset
981 /* Fcar can GC via wrong_type_argument. */
c66036f59678 [xemacs-hg @ 2004-02-20 07:29:16 by stephent]
stephent
parents: 1884
diff changeset
982 /* GCPRO_STACK; */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
983 TOP = CONSP (TOP) ? XCAR (TOP) : Fcar (TOP);
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 case Bcdr:
1920
c66036f59678 [xemacs-hg @ 2004-02-20 07:29:16 by stephent]
stephent
parents: 1884
diff changeset
987 /* Fcdr can GC via wrong_type_argument. */
c66036f59678 [xemacs-hg @ 2004-02-20 07:29:16 by stephent]
stephent
parents: 1884
diff changeset
988 /* GCPRO_STACK; */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
989 TOP = CONSP (TOP) ? XCDR (TOP) : Fcdr (TOP);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
990 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
991
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
992
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
993 case Bunbind_all:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
994 /* To unbind back to the beginning of this frame. Not used yet,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
995 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
996 unbind_to (speccount);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
997 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
998
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
999 case Bnth:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1000 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1001 Lisp_Object arg = POP;
1920
c66036f59678 [xemacs-hg @ 2004-02-20 07:29:16 by stephent]
stephent
parents: 1884
diff changeset
1002 /* Fcar and Fnthcdr can GC via wrong_type_argument. */
c66036f59678 [xemacs-hg @ 2004-02-20 07:29:16 by stephent]
stephent
parents: 1884
diff changeset
1003 /* GCPRO_STACK; */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1004 TOP = Fcar (Fnthcdr (TOP, arg));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1005 break;
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1008 case Bsymbolp:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1009 TOP = SYMBOLP (TOP) ? Qt : Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1010 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1011
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1012 case Bconsp:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1013 TOP = CONSP (TOP) ? Qt : Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1014 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1015
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1016 case Bstringp:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1017 TOP = STRINGP (TOP) ? Qt : Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1018 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1019
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1020 case Blistp:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1021 TOP = LISTP (TOP) ? Qt : Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1022 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1023
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1024 case Bnumberp:
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1920
diff changeset
1025 #ifdef WITH_NUMBER_TYPES
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1920
diff changeset
1026 TOP = NUMBERP (TOP) ? Qt : Qnil;
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1920
diff changeset
1027 #else
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1028 TOP = INT_OR_FLOATP (TOP) ? Qt : Qnil;
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1920
diff changeset
1029 #endif
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1030 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1031
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1032 case Bintegerp:
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1920
diff changeset
1033 #ifdef HAVE_BIGNUM
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1920
diff changeset
1034 TOP = INTEGERP (TOP) ? Qt : Qnil;
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1920
diff changeset
1035 #else
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1036 TOP = INTP (TOP) ? Qt : Qnil;
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1920
diff changeset
1037 #endif
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1038 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1039
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1040 case Beq:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1041 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1042 Lisp_Object arg = POP;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1043 TOP = EQ_WITH_EBOLA_NOTICE (TOP, arg) ? Qt : Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1044 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1045 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1046
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1047 case Bnot:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1048 TOP = NILP (TOP) ? Qt : Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1049 break;
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 case Bcons:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1052 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1053 Lisp_Object arg = POP;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1054 TOP = Fcons (TOP, arg);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1055 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1056 }
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 case Blist1:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1059 TOP = Fcons (TOP, Qnil);
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 BlistN:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1064 n = READ_UINT_1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1065 goto do_list;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1066
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1067 case Blist2:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1068 case Blist3:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1069 case Blist4:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1070 /* common case */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1071 n = opcode - (Blist1 - 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1072 do_list:
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 Lisp_Object list = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1075 list_loop:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1076 list = Fcons (TOP, list);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1077 if (--n)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1078 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1079 DISCARD (1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1080 goto list_loop;
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 TOP = list;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1083 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1084 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1085
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1086
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1087 case Bconcat2:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1088 case Bconcat3:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1089 case Bconcat4:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1090 n = opcode - (Bconcat2 - 2);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1091 goto do_concat;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1092
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1093 case BconcatN:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1094 /* common case */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1095 n = READ_UINT_1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1096 do_concat:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1097 DISCARD (n - 1);
1920
c66036f59678 [xemacs-hg @ 2004-02-20 07:29:16 by stephent]
stephent
parents: 1884
diff changeset
1098 /* Apparently `concat' can GC; Fconcat GCPROs its arguments. */
c66036f59678 [xemacs-hg @ 2004-02-20 07:29:16 by stephent]
stephent
parents: 1884
diff changeset
1099 /* GCPRO_STACK; */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1100 TOP = Fconcat (n, &TOP);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1101 break;
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1104 case Blength:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1105 TOP = Flength (TOP);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1106 break;
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 Baset:
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 arg2 = POP;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1111 Lisp_Object arg1 = POP;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1112 TOP = Faset (TOP, arg1, arg2);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1113 break;
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1116 case Bsymbol_value:
1920
c66036f59678 [xemacs-hg @ 2004-02-20 07:29:16 by stephent]
stephent
parents: 1884
diff changeset
1117 /* Why does this need GCPRO_STACK? If not, remove others, too. */
1884
3d25fd3d9ac4 [xemacs-hg @ 2004-01-27 13:23:50 by stephent]
stephent
parents: 1758
diff changeset
1118 /* GCPRO_STACK; */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1119 TOP = Fsymbol_value (TOP);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1120 break;
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 Bsymbol_function:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1123 TOP = Fsymbol_function (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 Bget:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1127 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1128 Lisp_Object arg = POP;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1129 TOP = Fget (TOP, arg, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1130 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1131 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1132
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1133 case Bsub1:
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1920
diff changeset
1134 #ifdef HAVE_BIGNUM
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1920
diff changeset
1135 TOP = Fsub1 (TOP);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1920
diff changeset
1136 #else
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1137 TOP = INTP (TOP) ? INT_MINUS1 (TOP) : Fsub1 (TOP);
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1920
diff changeset
1138 #endif
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1139 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1140
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1141 case Badd1:
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1920
diff changeset
1142 #ifdef HAVE_BIGNUM
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1920
diff changeset
1143 TOP = Fadd1 (TOP);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1920
diff changeset
1144 #else
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1145 TOP = INTP (TOP) ? INT_PLUS1 (TOP) : Fadd1 (TOP);
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1920
diff changeset
1146 #endif
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1147 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1148
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1149
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1150 case Beqlsign:
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 Lisp_Object arg = POP;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1153 TOP = bytecode_arithcompare (TOP, arg) == 0 ? Qt : Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1154 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1155 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1156
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1157 case Bgtr:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1158 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1159 Lisp_Object arg = POP;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1160 TOP = bytecode_arithcompare (TOP, arg) > 0 ? Qt : Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1161 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1162 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1163
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1164 case Blss:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1165 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1166 Lisp_Object arg = POP;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1167 TOP = bytecode_arithcompare (TOP, arg) < 0 ? Qt : Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1168 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1169 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1170
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1171 case Bleq:
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 Lisp_Object arg = POP;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1174 TOP = bytecode_arithcompare (TOP, arg) <= 0 ? Qt : Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1175 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1176 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1177
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1178 case Bgeq:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1179 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1180 Lisp_Object arg = POP;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1181 TOP = bytecode_arithcompare (TOP, arg) >= 0 ? Qt : Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1182 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1183 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1184
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1185
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1186 case Bnegate:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1187 TOP = bytecode_negate (TOP);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1188 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1189
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1190 case Bnconc:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1191 DISCARD (1);
1920
c66036f59678 [xemacs-hg @ 2004-02-20 07:29:16 by stephent]
stephent
parents: 1884
diff changeset
1192 /* nconc2 GCPROs before calling this. */
c66036f59678 [xemacs-hg @ 2004-02-20 07:29:16 by stephent]
stephent
parents: 1884
diff changeset
1193 /* GCPRO_STACK; */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1194 TOP = bytecode_nconc2 (&TOP);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1195 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1196
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1197 case Bplus:
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 Lisp_Object arg2 = POP;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1200 Lisp_Object arg1 = TOP;
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1920
diff changeset
1201 #ifdef HAVE_BIGNUM
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1920
diff changeset
1202 TOP = bytecode_arithop (arg1, arg2, opcode);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1920
diff changeset
1203 #else
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1204 TOP = INTP (arg1) && INTP (arg2) ?
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1205 INT_PLUS (arg1, arg2) :
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1206 bytecode_arithop (arg1, arg2, opcode);
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1920
diff changeset
1207 #endif
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1208 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1209 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1210
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1211 case Bdiff:
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 Lisp_Object arg2 = POP;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1214 Lisp_Object arg1 = TOP;
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1920
diff changeset
1215 #ifdef HAVE_BIGNUM
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1920
diff changeset
1216 TOP = bytecode_arithop (arg1, arg2, opcode);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1920
diff changeset
1217 #else
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1218 TOP = INTP (arg1) && INTP (arg2) ?
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1219 INT_MINUS (arg1, arg2) :
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1220 bytecode_arithop (arg1, arg2, opcode);
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents: 1920
diff changeset
1221 #endif
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1222 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1223 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1224
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1225 case Bmult:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1226 case Bquo:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1227 case Bmax:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1228 case Bmin:
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 Lisp_Object arg = POP;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1231 TOP = bytecode_arithop (TOP, arg, opcode);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1232 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1233 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1234
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1235 case Bpoint:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1236 PUSH (make_int (BUF_PT (current_buffer)));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1237 break;
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 case Binsert:
1920
c66036f59678 [xemacs-hg @ 2004-02-20 07:29:16 by stephent]
stephent
parents: 1884
diff changeset
1240 /* Says it can GC. */
c66036f59678 [xemacs-hg @ 2004-02-20 07:29:16 by stephent]
stephent
parents: 1884
diff changeset
1241 /* GCPRO_STACK; */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1242 TOP = Finsert (1, &TOP);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1243 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1244
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1245 case BinsertN:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1246 n = READ_UINT_1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1247 DISCARD (n - 1);
1920
c66036f59678 [xemacs-hg @ 2004-02-20 07:29:16 by stephent]
stephent
parents: 1884
diff changeset
1248 /* See Binsert. */
c66036f59678 [xemacs-hg @ 2004-02-20 07:29:16 by stephent]
stephent
parents: 1884
diff changeset
1249 /* GCPRO_STACK; */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1250 TOP = Finsert (n, &TOP);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1251 break;
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 case Baref:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1254 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1255 Lisp_Object arg = POP;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1256 TOP = Faref (TOP, arg);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1257 break;
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1260 case Bmemq:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1261 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1262 Lisp_Object arg = POP;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1263 TOP = Fmemq (TOP, arg);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1264 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1265 }
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 Bset:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1268 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1269 Lisp_Object arg = POP;
1884
3d25fd3d9ac4 [xemacs-hg @ 2004-01-27 13:23:50 by stephent]
stephent
parents: 1758
diff changeset
1270 /* Fset may call magic handlers */
3d25fd3d9ac4 [xemacs-hg @ 2004-01-27 13:23:50 by stephent]
stephent
parents: 1758
diff changeset
1271 /* GCPRO_STACK; */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1272 TOP = Fset (TOP, arg);
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1276 case Bequal:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1277 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1278 Lisp_Object arg = POP;
1920
c66036f59678 [xemacs-hg @ 2004-02-20 07:29:16 by stephent]
stephent
parents: 1884
diff changeset
1279 /* Can QUIT, so can GC, right? */
c66036f59678 [xemacs-hg @ 2004-02-20 07:29:16 by stephent]
stephent
parents: 1884
diff changeset
1280 /* GCPRO_STACK; */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1281 TOP = Fequal (TOP, arg);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1282 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1283 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1284
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1285 case Bnthcdr:
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 Lisp_Object arg = POP;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1288 TOP = Fnthcdr (TOP, arg);
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1292 case Belt:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1293 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1294 Lisp_Object arg = POP;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1295 TOP = Felt (TOP, arg);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1296 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1297 }
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 Bmember:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1300 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1301 Lisp_Object arg = POP;
1920
c66036f59678 [xemacs-hg @ 2004-02-20 07:29:16 by stephent]
stephent
parents: 1884
diff changeset
1302 /* Can QUIT, so can GC, right? */
c66036f59678 [xemacs-hg @ 2004-02-20 07:29:16 by stephent]
stephent
parents: 1884
diff changeset
1303 /* GCPRO_STACK; */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1304 TOP = Fmember (TOP, arg);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1305 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1306 }
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 Bgoto_char:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1309 TOP = Fgoto_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 Bcurrent_buffer:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1313 {
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 771
diff changeset
1314 Lisp_Object buffer = wrap_buffer (current_buffer);
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 771
diff changeset
1315
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1316 PUSH (buffer);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1317 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1318 }
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 Bset_buffer:
1884
3d25fd3d9ac4 [xemacs-hg @ 2004-01-27 13:23:50 by stephent]
stephent
parents: 1758
diff changeset
1321 /* #### WAG: set-buffer may cause Fset's of buffer locals
3d25fd3d9ac4 [xemacs-hg @ 2004-01-27 13:23:50 by stephent]
stephent
parents: 1758
diff changeset
1322 Didn't prevent crash. :-( */
3d25fd3d9ac4 [xemacs-hg @ 2004-01-27 13:23:50 by stephent]
stephent
parents: 1758
diff changeset
1323 /* GCPRO_STACK; */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1324 TOP = Fset_buffer (TOP);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1325 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1326
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1327 case Bpoint_max:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1328 PUSH (make_int (BUF_ZV (current_buffer)));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1329 break;
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 Bpoint_min:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1332 PUSH (make_int (BUF_BEGV (current_buffer)));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1333 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1334
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1335 case Bskip_chars_forward:
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 Lisp_Object arg = POP;
1920
c66036f59678 [xemacs-hg @ 2004-02-20 07:29:16 by stephent]
stephent
parents: 1884
diff changeset
1338 /* Can QUIT, so can GC, right? */
c66036f59678 [xemacs-hg @ 2004-02-20 07:29:16 by stephent]
stephent
parents: 1884
diff changeset
1339 /* GCPRO_STACK; */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1340 TOP = Fskip_chars_forward (TOP, arg, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1341 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1342 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1343
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1344 case Bassq:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1345 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1346 Lisp_Object arg = POP;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1347 TOP = Fassq (TOP, arg);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1348 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1349 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1350
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1351 case Bsetcar:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1352 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1353 Lisp_Object arg = POP;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1354 TOP = Fsetcar (TOP, arg);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1355 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1356 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1357
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1358 case Bsetcdr:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1359 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1360 Lisp_Object arg = POP;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1361 TOP = Fsetcdr (TOP, arg);
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 Bnreverse:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1366 TOP = bytecode_nreverse (TOP);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1367 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1368
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1369 case Bcar_safe:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1370 TOP = CONSP (TOP) ? XCAR (TOP) : Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1371 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1372
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1373 case Bcdr_safe:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1374 TOP = CONSP (TOP) ? XCDR (TOP) : Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1375 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1376
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1377 }
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 }
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 /* It makes a worthwhile performance difference (5%) to shunt
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1382 lesser-used opcodes off to a subroutine, to keep the switch in
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1383 execute_optimized_program small. If you REALLY care about
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1384 performance, you want to keep your heavily executed code away from
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1385 rarely executed code, to minimize cache misses.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1386
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1387 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
1388 Lisp_Object *
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1389 execute_rare_opcode (Lisp_Object *stack_ptr,
2286
04bc9d2f42c7 [xemacs-hg @ 2004-09-20 19:18:55 by james]
james
parents: 1995
diff changeset
1390 const Opbyte *UNUSED (program_ptr),
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1391 Opcode opcode)
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 switch (opcode)
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1396 case Bsave_excursion:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1397 record_unwind_protect (save_excursion_restore,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1398 save_excursion_save ());
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1399 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1400
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1401 case Bsave_window_excursion:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1402 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1403 int count = specpdl_depth ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1404 record_unwind_protect (save_window_excursion_unwind,
1149
a123f88fa975 [xemacs-hg @ 2002-12-08 10:24:33 by michaels]
michaels
parents: 1104
diff changeset
1405 call1 (Qcurrent_window_configuration, Qnil));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1406 TOP = Fprogn (TOP);
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1407 unbind_to (count);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1408 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1409 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1410
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1411 case Bsave_restriction:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1412 record_unwind_protect (save_restriction_restore,
844
047d37eb70d7 [xemacs-hg @ 2002-05-16 13:30:23 by ben]
ben
parents: 826
diff changeset
1413 save_restriction_save (current_buffer));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1414 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1415
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1416 case Bcatch:
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 Lisp_Object arg = POP;
2532
989a7680c221 [xemacs-hg @ 2005-01-29 09:15:55 by ben]
ben
parents: 2500
diff changeset
1419 TOP = internal_catch (TOP, Feval, arg, 0, 0, 0);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1420 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1421 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1422
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1423 case Bskip_chars_backward:
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 Lisp_Object arg = POP;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1426 TOP = Fskip_chars_backward (TOP, arg, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1427 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1428 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1429
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1430 case Bunwind_protect:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1431 record_unwind_protect (Fprogn, POP);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1432 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1433
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1434 case Bcondition_case:
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 Lisp_Object arg2 = POP; /* handlers */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1437 Lisp_Object arg1 = POP; /* bodyform */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1438 TOP = condition_case_3 (arg1, TOP, arg2);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1439 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1440 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1441
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1442 case Bset_marker:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1443 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1444 Lisp_Object arg2 = POP;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1445 Lisp_Object arg1 = POP;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1446 TOP = Fset_marker (TOP, arg1, arg2);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1447 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1448 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1449
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1450 case Brem:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1451 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1452 Lisp_Object arg = POP;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1453 TOP = Frem (TOP, arg);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1454 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1455 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1456
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1457 case Bmatch_beginning:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1458 TOP = Fmatch_beginning (TOP);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1459 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1460
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1461 case Bmatch_end:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1462 TOP = Fmatch_end (TOP);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1463 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1464
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1465 case Bupcase:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1466 TOP = Fupcase (TOP, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1467 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1468
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1469 case Bdowncase:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1470 TOP = Fdowncase (TOP, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1471 break;
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 case Bfset:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1474 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1475 Lisp_Object arg = POP;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1476 TOP = Ffset (TOP, arg);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1477 break;
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1480 case Bstring_equal:
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 Lisp_Object arg = POP;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1483 TOP = Fstring_equal (TOP, arg);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1484 break;
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1487 case Bstring_lessp:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1488 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1489 Lisp_Object arg = POP;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1490 TOP = Fstring_lessp (TOP, arg);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1491 break;
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1494 case Bsubstring:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1495 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1496 Lisp_Object arg2 = POP;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1497 Lisp_Object arg1 = POP;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1498 TOP = Fsubstring (TOP, arg1, arg2);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1499 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1500 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1501
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1502 case Bcurrent_column:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1503 PUSH (make_int (current_column (current_buffer)));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1504 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1505
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1506 case Bchar_after:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1507 TOP = Fchar_after (TOP, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1508 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1509
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1510 case Bindent_to:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1511 TOP = Findent_to (TOP, Qnil, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1512 break;
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 case Bwiden:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1515 PUSH (Fwiden (Qnil));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1516 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1517
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1518 case Bfollowing_char:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1519 PUSH (Ffollowing_char (Qnil));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1520 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1521
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1522 case Bpreceding_char:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1523 PUSH (Fpreceding_char (Qnil));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1524 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1525
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1526 case Beolp:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1527 PUSH (Feolp (Qnil));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1528 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1529
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1530 case Beobp:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1531 PUSH (Feobp (Qnil));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1532 break;
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 case Bbolp:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1535 PUSH (Fbolp (Qnil));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1536 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1537
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1538 case Bbobp:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1539 PUSH (Fbobp (Qnil));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1540 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1541
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1542 case Bsave_current_buffer:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1543 record_unwind_protect (save_current_buffer_restore,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1544 Fcurrent_buffer ());
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1545 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1546
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1547 case Binteractive_p:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1548 PUSH (Finteractive_p ());
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1549 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1550
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1551 case Bforward_char:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1552 TOP = Fforward_char (TOP, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1553 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1554
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1555 case Bforward_word:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1556 TOP = Fforward_word (TOP, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1557 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1558
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1559 case Bforward_line:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1560 TOP = Fforward_line (TOP, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1561 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1562
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1563 case Bchar_syntax:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1564 TOP = Fchar_syntax (TOP, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1565 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1566
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1567 case Bbuffer_substring:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1568 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1569 Lisp_Object arg = POP;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1570 TOP = Fbuffer_substring (TOP, arg, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1571 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1572 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1573
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1574 case Bdelete_region:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1575 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1576 Lisp_Object arg = POP;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1577 TOP = Fdelete_region (TOP, arg, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1578 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1579 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1580
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1581 case Bnarrow_to_region:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1582 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1583 Lisp_Object arg = POP;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1584 TOP = Fnarrow_to_region (TOP, arg, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1585 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1586 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1587
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1588 case Bend_of_line:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1589 TOP = Fend_of_line (TOP, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1590 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1591
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1592 case Btemp_output_buffer_setup:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1593 temp_output_buffer_setup (TOP);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1594 TOP = Vstandard_output;
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 Btemp_output_buffer_show:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1598 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1599 Lisp_Object arg = POP;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1600 temp_output_buffer_show (TOP, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1601 TOP = arg;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1602 /* GAG ME!! */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1603 /* pop binding of standard-output */
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1604 unbind_to (specpdl_depth() - 1);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1605 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1606 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1607
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1608 case Bold_eq:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1609 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1610 Lisp_Object arg = POP;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1611 TOP = HACKEQ_UNSAFE (TOP, arg) ? Qt : Qnil;
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1615 case Bold_memq:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1616 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1617 Lisp_Object arg = POP;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1618 TOP = Fold_memq (TOP, arg);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1619 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1620 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1621
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1622 case Bold_equal:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1623 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1624 Lisp_Object arg = POP;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1625 TOP = Fold_equal (TOP, arg);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1626 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1627 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1628
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1629 case Bold_member:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1630 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1631 Lisp_Object arg = POP;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1632 TOP = Fold_member (TOP, arg);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1633 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1634 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1635
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1636 case Bold_assq:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1637 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1638 Lisp_Object arg = POP;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1639 TOP = Fold_assq (TOP, arg);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1640 break;
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1643 default:
2500
3d8143fc88e1 [xemacs-hg @ 2005-01-24 23:33:30 by ben]
ben
parents: 2367
diff changeset
1644 ABORT();
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1645 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1646 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1647 return stack_ptr;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1648 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1649
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1650
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 444
diff changeset
1651 DOESNT_RETURN
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
1652 invalid_byte_code (const CIbyte *reason, Lisp_Object frob)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1653 {
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 444
diff changeset
1654 signal_error (Qinvalid_byte_code, reason, frob);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1655 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1656
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1657 /* Check for valid opcodes. Change this when adding new opcodes. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1658 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1659 check_opcode (Opcode opcode)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1660 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1661 if ((opcode < Bvarref) ||
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1662 (opcode == 0251) ||
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1663 (opcode > Bassq && opcode < Bconstant))
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 444
diff changeset
1664 invalid_byte_code ("invalid opcode in instruction stream",
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 444
diff changeset
1665 make_int (opcode));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1666 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1667
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1668 /* Check that IDX is a valid offset into the `constants' vector */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1669 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1670 check_constants_index (int idx, Lisp_Object constants)
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 if (idx < 0 || idx >= XVECTOR_LENGTH (constants))
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 444
diff changeset
1673 signal_ferror
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 444
diff changeset
1674 (Qinvalid_byte_code,
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 444
diff changeset
1675 "reference %d to constants array out of range 0, %ld",
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1676 idx, XVECTOR_LENGTH (constants) - 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1677 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1678
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1679 /* Get next character from Lisp instructions string. */
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 444
diff changeset
1680 #define READ_INSTRUCTION_CHAR(lvalue) do { \
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
1681 (lvalue) = itext_ichar (ptr); \
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
1682 INC_IBYTEPTR (ptr); \
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 444
diff changeset
1683 *icounts_ptr++ = program_ptr - program; \
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 444
diff changeset
1684 if (lvalue > UCHAR_MAX) \
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 444
diff changeset
1685 invalid_byte_code \
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 444
diff changeset
1686 ("Invalid character in byte code string", make_char (lvalue)); \
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1687 } while (0)
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 /* Get opcode from Lisp instructions string. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1690 #define READ_OPCODE do { \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1691 unsigned int c; \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1692 READ_INSTRUCTION_CHAR (c); \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1693 opcode = (Opcode) c; \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1694 } while (0)
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 /* Get next operand, a uint8, from Lisp instructions string. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1697 #define READ_OPERAND_1 do { \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1698 READ_INSTRUCTION_CHAR (arg); \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1699 argsize = 1; \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1700 } while (0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1701
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1702 /* Get next operand, a uint16, from Lisp instructions string. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1703 #define READ_OPERAND_2 do { \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1704 unsigned int arg1, arg2; \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1705 READ_INSTRUCTION_CHAR (arg1); \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1706 READ_INSTRUCTION_CHAR (arg2); \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1707 arg = arg1 + (arg2 << 8); \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1708 argsize = 2; \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1709 } while (0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1710
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1711 /* Write 1 byte to PTR, incrementing PTR */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1712 #define WRITE_INT8(value, ptr) do { \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1713 *((ptr)++) = (value); \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1714 } while (0)
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 /* Write 2 bytes to PTR, incrementing PTR */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1717 #define WRITE_INT16(value, ptr) do { \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1718 WRITE_INT8 (((unsigned) (value)) & 0x00ff, (ptr)); \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1719 WRITE_INT8 (((unsigned) (value)) >> 8 , (ptr)); \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1720 } while (0)
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 /* We've changed our minds about the opcode we've already written. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1723 #define REWRITE_OPCODE(new_opcode) ((void) (program_ptr[-1] = new_opcode))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1724
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1725 /* 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
1726 #define WRITE_NARGS(base_opcode) do { \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1727 if (arg <= 5) \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1728 { \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1729 REWRITE_OPCODE (base_opcode + arg); \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1730 } \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1731 else if (arg <= UCHAR_MAX) \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1732 { \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1733 REWRITE_OPCODE (base_opcode + 6); \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1734 WRITE_INT8 (arg, program_ptr); \
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 else \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1737 { \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1738 REWRITE_OPCODE (base_opcode + 7); \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1739 WRITE_INT16 (arg, program_ptr); \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1740 } \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1741 } while (0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1742
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1743 /* 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
1744 #define WRITE_CONSTANT do { \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1745 check_constants_index(arg, constants); \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1746 if (arg <= UCHAR_MAX - Bconstant) \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1747 { \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1748 REWRITE_OPCODE (Bconstant + arg); \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1749 } \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1750 else \
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 REWRITE_OPCODE (Bconstant2); \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1753 WRITE_INT16 (arg, program_ptr); \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1754 } \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1755 } while (0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1756
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1757 #define WRITE_OPCODE WRITE_INT8 (opcode, program_ptr)
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 /* Compile byte code instructions into free space provided by caller, with
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1760 size >= (2 * string_char_length (instructions) + 1) * sizeof (Opbyte).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1761 Returns length of compiled code. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1762 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1763 optimize_byte_code (/* in */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1764 Lisp_Object instructions,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1765 Lisp_Object constants,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1766 /* out */
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1767 Opbyte * const program,
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1768 int * const program_length,
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1769 int * const varbind_count)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1770 {
647
b39c14581166 [xemacs-hg @ 2001-08-13 04:45:47 by ben]
ben
parents: 609
diff changeset
1771 Bytecount instructions_length = XSTRING_LENGTH (instructions);
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
1772 Elemcount comfy_size = (Elemcount) (2 * instructions_length);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1773
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1774 int * const icounts = alloca_array (int, comfy_size);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1775 int * icounts_ptr = icounts;
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 /* We maintain a table of jumps in the source code. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1778 struct jump
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1779 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1780 int from;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1781 int to;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1782 };
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1783 struct jump * const jumps = alloca_array (struct jump, comfy_size);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1784 struct jump *jumps_ptr = jumps;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1785
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1786 Opbyte *program_ptr = program;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1787
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
1788 const Ibyte *ptr = XSTRING_DATA (instructions);
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
1789 const Ibyte * const end = ptr + instructions_length;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1790
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1791 *varbind_count = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1792
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1793 while (ptr < end)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1794 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1795 Opcode opcode;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1796 int arg;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1797 int argsize = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1798 READ_OPCODE;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1799 WRITE_OPCODE;
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 switch (opcode)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1802 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1803 Lisp_Object val;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1804
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1805 case Bvarref+7: READ_OPERAND_2; goto do_varref;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1806 case Bvarref+6: READ_OPERAND_1; goto do_varref;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1807 case Bvarref: case Bvarref+1: case Bvarref+2:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1808 case Bvarref+3: case Bvarref+4: case Bvarref+5:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1809 arg = opcode - Bvarref;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1810 do_varref:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1811 check_constants_index (arg, constants);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1812 val = XVECTOR_DATA (constants) [arg];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1813 if (!SYMBOLP (val))
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 444
diff changeset
1814 invalid_byte_code ("variable reference to non-symbol", val);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1815 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
1816 invalid_byte_code ("variable reference to constant symbol", val);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1817 WRITE_NARGS (Bvarref);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1818 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1819
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1820 case Bvarset+7: READ_OPERAND_2; goto do_varset;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1821 case Bvarset+6: READ_OPERAND_1; goto do_varset;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1822 case Bvarset: case Bvarset+1: case Bvarset+2:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1823 case Bvarset+3: case Bvarset+4: case Bvarset+5:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1824 arg = opcode - Bvarset;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1825 do_varset:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1826 check_constants_index (arg, constants);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1827 val = XVECTOR_DATA (constants) [arg];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1828 if (!SYMBOLP (val))
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 444
diff changeset
1829 wtaerror ("attempt to set non-symbol", val);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1830 if (EQ (val, Qnil) || EQ (val, Qt))
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 444
diff changeset
1831 signal_error (Qsetting_constant, 0, val);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1832 /* Ignore assignments to keywords by converting to Bdiscard.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1833 For backward compatibility only - we'd like to make this an error. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1834 if (SYMBOL_IS_KEYWORD (val))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1835 REWRITE_OPCODE (Bdiscard);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1836 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1837 WRITE_NARGS (Bvarset);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1838 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1839
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1840 case Bvarbind+7: READ_OPERAND_2; goto do_varbind;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1841 case Bvarbind+6: READ_OPERAND_1; goto do_varbind;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1842 case Bvarbind: case Bvarbind+1: case Bvarbind+2:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1843 case Bvarbind+3: case Bvarbind+4: case Bvarbind+5:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1844 arg = opcode - Bvarbind;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1845 do_varbind:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1846 (*varbind_count)++;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1847 check_constants_index (arg, constants);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1848 val = XVECTOR_DATA (constants) [arg];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1849 if (!SYMBOLP (val))
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 444
diff changeset
1850 wtaerror ("attempt to let-bind non-symbol", val);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1851 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
1852 signal_error (Qsetting_constant,
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 444
diff changeset
1853 "attempt to let-bind constant symbol", val);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1854 WRITE_NARGS (Bvarbind);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1855 break;
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 case Bcall+7: READ_OPERAND_2; goto do_call;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1858 case Bcall+6: READ_OPERAND_1; goto do_call;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1859 case Bcall: case Bcall+1: case Bcall+2:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1860 case Bcall+3: case Bcall+4: case Bcall+5:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1861 arg = opcode - Bcall;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1862 do_call:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1863 WRITE_NARGS (Bcall);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1864 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1865
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1866 case Bunbind+7: READ_OPERAND_2; goto do_unbind;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1867 case Bunbind+6: READ_OPERAND_1; goto do_unbind;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1868 case Bunbind: case Bunbind+1: case Bunbind+2:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1869 case Bunbind+3: case Bunbind+4: case Bunbind+5:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1870 arg = opcode - Bunbind;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1871 do_unbind:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1872 WRITE_NARGS (Bunbind);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1873 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1874
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1875 case Bgoto:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1876 case Bgotoifnil:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1877 case Bgotoifnonnil:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1878 case Bgotoifnilelsepop:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1879 case Bgotoifnonnilelsepop:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1880 READ_OPERAND_2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1881 /* Make program_ptr-relative */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1882 arg += icounts - (icounts_ptr - argsize);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1883 goto do_jump;
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 case BRgoto:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1886 case BRgotoifnil:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1887 case BRgotoifnonnil:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1888 case BRgotoifnilelsepop:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1889 case BRgotoifnonnilelsepop:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1890 READ_OPERAND_1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1891 /* Make program_ptr-relative */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1892 arg -= 127;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1893 do_jump:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1894 /* Record program-relative goto addresses in `jumps' table */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1895 jumps_ptr->from = icounts_ptr - icounts - argsize;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1896 jumps_ptr->to = jumps_ptr->from + arg;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1897 jumps_ptr++;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1898 if (arg >= -1 && arg <= argsize)
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 444
diff changeset
1899 invalid_byte_code ("goto instruction is its own target", Qunbound);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1900 if (arg <= SCHAR_MIN ||
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1901 arg > SCHAR_MAX)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1902 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1903 if (argsize == 1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1904 REWRITE_OPCODE (opcode + Bgoto - BRgoto);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1905 WRITE_INT16 (arg, program_ptr);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1906 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1907 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1908 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1909 if (argsize == 2)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1910 REWRITE_OPCODE (opcode + BRgoto - Bgoto);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1911 WRITE_INT8 (arg, program_ptr);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1912 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1913 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1914
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1915 case Bconstant2:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1916 READ_OPERAND_2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1917 WRITE_CONSTANT;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1918 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1919
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1920 case BlistN:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1921 case BconcatN:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1922 case BinsertN:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1923 READ_OPERAND_1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1924 WRITE_INT8 (arg, program_ptr);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1925 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1926
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1927 default:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1928 if (opcode < Bconstant)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1929 check_opcode (opcode);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1930 else
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 arg = opcode - Bconstant;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1933 WRITE_CONSTANT;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1934 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1935 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1936 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1937 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1938
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1939 /* Fix up jumps table to refer to NEW offsets. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1940 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1941 struct jump *j;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1942 for (j = jumps; j < jumps_ptr; j++)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1943 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1944 #ifdef ERROR_CHECK_BYTE_CODE
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1945 assert (j->from < icounts_ptr - icounts);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1946 assert (j->to < icounts_ptr - icounts);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1947 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1948 j->from = icounts[j->from];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1949 j->to = icounts[j->to];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1950 #ifdef ERROR_CHECK_BYTE_CODE
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1951 assert (j->from < program_ptr - program);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1952 assert (j->to < program_ptr - program);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1953 check_opcode ((Opcode) (program[j->from-1]));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1954 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1955 check_opcode ((Opcode) (program[j->to]));
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 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1958
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1959 /* Fixup jumps in byte-code until no more fixups needed */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1960 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1961 int more_fixups_needed = 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1962
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1963 while (more_fixups_needed)
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 struct jump *j;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1966 more_fixups_needed = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1967 for (j = jumps; j < jumps_ptr; j++)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1968 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1969 int from = j->from;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1970 int to = j->to;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1971 int jump = to - from;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1972 Opbyte *p = program + from;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1973 Opcode opcode = (Opcode) p[-1];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1974 if (!more_fixups_needed)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1975 check_opcode ((Opcode) p[jump]);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1976 assert (to >= 0 && program + to < program_ptr);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1977 switch (opcode)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1978 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1979 case Bgoto:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1980 case Bgotoifnil:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1981 case Bgotoifnonnil:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1982 case Bgotoifnilelsepop:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1983 case Bgotoifnonnilelsepop:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1984 WRITE_INT16 (jump, p);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1985 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1986
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1987 case BRgoto:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1988 case BRgotoifnil:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1989 case BRgotoifnonnil:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1990 case BRgotoifnilelsepop:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1991 case BRgotoifnonnilelsepop:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1992 if (jump > SCHAR_MIN &&
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1993 jump <= SCHAR_MAX)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1994 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1995 WRITE_INT8 (jump, p);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1996 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1997 else /* barf */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1998 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1999 struct jump *jj;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2000 for (jj = jumps; jj < jumps_ptr; jj++)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2001 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2002 assert (jj->from < program_ptr - program);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2003 assert (jj->to < program_ptr - program);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2004 if (jj->from > from) jj->from++;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2005 if (jj->to > from) jj->to++;
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 p[-1] += Bgoto - BRgoto;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2008 more_fixups_needed = 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2009 memmove (p+1, p, program_ptr++ - p);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2010 WRITE_INT16 (jump, p);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2011 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2012 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2013
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2014 default:
2500
3d8143fc88e1 [xemacs-hg @ 2005-01-24 23:33:30 by ben]
ben
parents: 2367
diff changeset
2015 ABORT();
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2016 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2017 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2018 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2019 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2020 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2021
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2022 /* *program_ptr++ = 0; */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2023 *program_length = program_ptr - program;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2024 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2025
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2026 /* Optimize the byte code and store the optimized program, only
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2027 understood by bytecode.c, in an opaque object in the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2028 instructions slot of the Compiled_Function object. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2029 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2030 optimize_compiled_function (Lisp_Object compiled_function)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2031 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2032 Lisp_Compiled_Function *f = XCOMPILED_FUNCTION (compiled_function);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2033 int program_length;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2034 int varbind_count;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2035 Opbyte *program;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2036
1737
68ed93de81b7 [xemacs-hg @ 2003-10-10 11:50:56 by stephent]
stephent
parents: 1661
diff changeset
2037 {
68ed93de81b7 [xemacs-hg @ 2003-10-10 11:50:56 by stephent]
stephent
parents: 1661
diff changeset
2038 int minargs = 0, maxargs = 0, totalargs = 0;
68ed93de81b7 [xemacs-hg @ 2003-10-10 11:50:56 by stephent]
stephent
parents: 1661
diff changeset
2039 int optional_p = 0, rest_p = 0, i = 0;
68ed93de81b7 [xemacs-hg @ 2003-10-10 11:50:56 by stephent]
stephent
parents: 1661
diff changeset
2040 {
68ed93de81b7 [xemacs-hg @ 2003-10-10 11:50:56 by stephent]
stephent
parents: 1661
diff changeset
2041 LIST_LOOP_2 (arg, f->arglist)
68ed93de81b7 [xemacs-hg @ 2003-10-10 11:50:56 by stephent]
stephent
parents: 1661
diff changeset
2042 {
68ed93de81b7 [xemacs-hg @ 2003-10-10 11:50:56 by stephent]
stephent
parents: 1661
diff changeset
2043 if (EQ (arg, Qand_optional))
68ed93de81b7 [xemacs-hg @ 2003-10-10 11:50:56 by stephent]
stephent
parents: 1661
diff changeset
2044 optional_p = 1;
68ed93de81b7 [xemacs-hg @ 2003-10-10 11:50:56 by stephent]
stephent
parents: 1661
diff changeset
2045 else if (EQ (arg, Qand_rest))
68ed93de81b7 [xemacs-hg @ 2003-10-10 11:50:56 by stephent]
stephent
parents: 1661
diff changeset
2046 rest_p = 1;
68ed93de81b7 [xemacs-hg @ 2003-10-10 11:50:56 by stephent]
stephent
parents: 1661
diff changeset
2047 else
68ed93de81b7 [xemacs-hg @ 2003-10-10 11:50:56 by stephent]
stephent
parents: 1661
diff changeset
2048 {
68ed93de81b7 [xemacs-hg @ 2003-10-10 11:50:56 by stephent]
stephent
parents: 1661
diff changeset
2049 if (rest_p)
68ed93de81b7 [xemacs-hg @ 2003-10-10 11:50:56 by stephent]
stephent
parents: 1661
diff changeset
2050 {
68ed93de81b7 [xemacs-hg @ 2003-10-10 11:50:56 by stephent]
stephent
parents: 1661
diff changeset
2051 maxargs = MANY;
68ed93de81b7 [xemacs-hg @ 2003-10-10 11:50:56 by stephent]
stephent
parents: 1661
diff changeset
2052 totalargs++;
68ed93de81b7 [xemacs-hg @ 2003-10-10 11:50:56 by stephent]
stephent
parents: 1661
diff changeset
2053 break;
68ed93de81b7 [xemacs-hg @ 2003-10-10 11:50:56 by stephent]
stephent
parents: 1661
diff changeset
2054 }
68ed93de81b7 [xemacs-hg @ 2003-10-10 11:50:56 by stephent]
stephent
parents: 1661
diff changeset
2055 if (!optional_p)
68ed93de81b7 [xemacs-hg @ 2003-10-10 11:50:56 by stephent]
stephent
parents: 1661
diff changeset
2056 minargs++;
68ed93de81b7 [xemacs-hg @ 2003-10-10 11:50:56 by stephent]
stephent
parents: 1661
diff changeset
2057 maxargs++;
68ed93de81b7 [xemacs-hg @ 2003-10-10 11:50:56 by stephent]
stephent
parents: 1661
diff changeset
2058 totalargs++;
68ed93de81b7 [xemacs-hg @ 2003-10-10 11:50:56 by stephent]
stephent
parents: 1661
diff changeset
2059 }
68ed93de81b7 [xemacs-hg @ 2003-10-10 11:50:56 by stephent]
stephent
parents: 1661
diff changeset
2060 }
68ed93de81b7 [xemacs-hg @ 2003-10-10 11:50:56 by stephent]
stephent
parents: 1661
diff changeset
2061 }
68ed93de81b7 [xemacs-hg @ 2003-10-10 11:50:56 by stephent]
stephent
parents: 1661
diff changeset
2062
68ed93de81b7 [xemacs-hg @ 2003-10-10 11:50:56 by stephent]
stephent
parents: 1661
diff changeset
2063 if (totalargs)
3092
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 2720
diff changeset
2064 #ifdef NEW_GC
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 2720
diff changeset
2065 f->arguments = make_compiled_function_args (totalargs);
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 2720
diff changeset
2066 #else /* not NEW_GC */
1737
68ed93de81b7 [xemacs-hg @ 2003-10-10 11:50:56 by stephent]
stephent
parents: 1661
diff changeset
2067 f->args = xnew_array (Lisp_Object, totalargs);
3092
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 2720
diff changeset
2068 #endif /* not NEW_GC */
1737
68ed93de81b7 [xemacs-hg @ 2003-10-10 11:50:56 by stephent]
stephent
parents: 1661
diff changeset
2069
68ed93de81b7 [xemacs-hg @ 2003-10-10 11:50:56 by stephent]
stephent
parents: 1661
diff changeset
2070 {
68ed93de81b7 [xemacs-hg @ 2003-10-10 11:50:56 by stephent]
stephent
parents: 1661
diff changeset
2071 LIST_LOOP_2 (arg, f->arglist)
68ed93de81b7 [xemacs-hg @ 2003-10-10 11:50:56 by stephent]
stephent
parents: 1661
diff changeset
2072 {
68ed93de81b7 [xemacs-hg @ 2003-10-10 11:50:56 by stephent]
stephent
parents: 1661
diff changeset
2073 if (!EQ (arg, Qand_optional) && !EQ (arg, Qand_rest))
3092
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 2720
diff changeset
2074 #ifdef NEW_GC
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 2720
diff changeset
2075 XCOMPILED_FUNCTION_ARGS_DATA (f->arguments)[i++] = arg;
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 2720
diff changeset
2076 #else /* not NEW_GC */
1737
68ed93de81b7 [xemacs-hg @ 2003-10-10 11:50:56 by stephent]
stephent
parents: 1661
diff changeset
2077 f->args[i++] = arg;
3092
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 2720
diff changeset
2078 #endif /* not NEW_GC */
1737
68ed93de81b7 [xemacs-hg @ 2003-10-10 11:50:56 by stephent]
stephent
parents: 1661
diff changeset
2079 }
68ed93de81b7 [xemacs-hg @ 2003-10-10 11:50:56 by stephent]
stephent
parents: 1661
diff changeset
2080 }
68ed93de81b7 [xemacs-hg @ 2003-10-10 11:50:56 by stephent]
stephent
parents: 1661
diff changeset
2081
68ed93de81b7 [xemacs-hg @ 2003-10-10 11:50:56 by stephent]
stephent
parents: 1661
diff changeset
2082 f->max_args = maxargs;
68ed93de81b7 [xemacs-hg @ 2003-10-10 11:50:56 by stephent]
stephent
parents: 1661
diff changeset
2083 f->min_args = minargs;
68ed93de81b7 [xemacs-hg @ 2003-10-10 11:50:56 by stephent]
stephent
parents: 1661
diff changeset
2084 f->args_in_array = totalargs;
68ed93de81b7 [xemacs-hg @ 2003-10-10 11:50:56 by stephent]
stephent
parents: 1661
diff changeset
2085 }
68ed93de81b7 [xemacs-hg @ 2003-10-10 11:50:56 by stephent]
stephent
parents: 1661
diff changeset
2086
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2087 /* If we have not actually read the bytecode string
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2088 and constants vector yet, fetch them from the file. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2089 if (CONSP (f->instructions))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2090 Ffetch_bytecode (compiled_function);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2091
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2092 if (STRINGP (f->instructions))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2093 {
826
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 814
diff changeset
2094 /* XSTRING_LENGTH() is more efficient than string_char_length(),
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2095 which would be slightly more `proper' */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2096 program = alloca_array (Opbyte, 1 + 2 * XSTRING_LENGTH (f->instructions));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2097 optimize_byte_code (f->instructions, f->constants,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2098 program, &program_length, &varbind_count);
2500
3d8143fc88e1 [xemacs-hg @ 2005-01-24 23:33:30 by ben]
ben
parents: 2367
diff changeset
2099 f->specpdl_depth = (unsigned short) (XINT (Flength (f->arglist)) +
3d8143fc88e1 [xemacs-hg @ 2005-01-24 23:33:30 by ben]
ben
parents: 2367
diff changeset
2100 varbind_count);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2101 f->instructions =
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
2102 make_opaque (program, program_length * sizeof (Opbyte));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2103 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2104
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2105 assert (OPAQUEP (f->instructions));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2106 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2107
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2108 /************************************************************************/
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2109 /* The compiled-function object type */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2110 /************************************************************************/
3092
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 2720
diff changeset
2111
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2112 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2113 print_compiled_function (Lisp_Object obj, Lisp_Object printcharfun,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2114 int escapeflag)
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 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2117 Lisp_Compiled_Function *f =
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2118 XCOMPILED_FUNCTION (obj); /* GC doesn't relocate */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2119 int docp = f->flags.documentationp;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2120 int intp = f->flags.interactivep;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2121 struct gcpro gcpro1, gcpro2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2122 GCPRO2 (obj, printcharfun);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2123
826
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 814
diff changeset
2124 write_c_string (printcharfun, print_readably ? "#[" : "#<compiled-function ");
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2125 #ifdef COMPILED_FUNCTION_ANNOTATION_HACK
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2126 if (!print_readably)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2127 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2128 Lisp_Object ann = compiled_function_annotation (f);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2129 if (!NILP (ann))
800
a5954632b187 [xemacs-hg @ 2002-03-31 08:27:14 by ben]
ben
parents: 793
diff changeset
2130 write_fmt_string_lisp (printcharfun, "(from %S) ", 1, ann);
428
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 #endif /* COMPILED_FUNCTION_ANNOTATION_HACK */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2133 /* COMPILED_ARGLIST = 0 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2134 print_internal (compiled_function_arglist (f), printcharfun, escapeflag);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2135
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2136 /* COMPILED_INSTRUCTIONS = 1 */
826
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 814
diff changeset
2137 write_c_string (printcharfun, " ");
428
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 struct gcpro ngcpro1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2140 Lisp_Object instructions = compiled_function_instructions (f);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2141 NGCPRO1 (instructions);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2142 if (STRINGP (instructions) && !print_readably)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2143 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2144 /* 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
2145 write_fmt_string (printcharfun, "\"...(%ld)\"",
826
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 814
diff changeset
2146 (long) string_char_length (instructions));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2147 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2148 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2149 print_internal (instructions, printcharfun, escapeflag);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2150 NUNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2151 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2152
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2153 /* COMPILED_CONSTANTS = 2 */
826
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 814
diff changeset
2154 write_c_string (printcharfun, " ");
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2155 print_internal (compiled_function_constants (f), printcharfun, escapeflag);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2156
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2157 /* COMPILED_STACK_DEPTH = 3 */
800
a5954632b187 [xemacs-hg @ 2002-03-31 08:27:14 by ben]
ben
parents: 793
diff changeset
2158 write_fmt_string (printcharfun, " %d", compiled_function_stack_depth (f));
428
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 /* COMPILED_DOC_STRING = 4 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2161 if (docp || intp)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2162 {
826
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 814
diff changeset
2163 write_c_string (printcharfun, " ");
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2164 print_internal (compiled_function_documentation (f), printcharfun,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2165 escapeflag);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2166 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2167
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2168 /* COMPILED_INTERACTIVE = 5 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2169 if (intp)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2170 {
826
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 814
diff changeset
2171 write_c_string (printcharfun, " ");
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2172 print_internal (compiled_function_interactive (f), printcharfun,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2173 escapeflag);
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2176 UNGCPRO;
826
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 814
diff changeset
2177 write_c_string (printcharfun, print_readably ? "]" : ">");
428
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2180
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2181 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2182 mark_compiled_function (Lisp_Object obj)
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 Lisp_Compiled_Function *f = XCOMPILED_FUNCTION (obj);
814
a634e3b7acc8 [xemacs-hg @ 2002-04-14 12:41:59 by ben]
ben
parents: 801
diff changeset
2185 int i;
428
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 mark_object (f->instructions);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2188 mark_object (f->arglist);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2189 mark_object (f->doc_and_interactive);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2190 #ifdef COMPILED_FUNCTION_ANNOTATION_HACK
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2191 mark_object (f->annotated);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2192 #endif
814
a634e3b7acc8 [xemacs-hg @ 2002-04-14 12:41:59 by ben]
ben
parents: 801
diff changeset
2193 for (i = 0; i < f->args_in_array; i++)
3092
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 2720
diff changeset
2194 #ifdef NEW_GC
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 2720
diff changeset
2195 mark_object (XCOMPILED_FUNCTION_ARGS_DATA (f->arguments)[i]);
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 2720
diff changeset
2196 #else /* not NEW_GC */
814
a634e3b7acc8 [xemacs-hg @ 2002-04-14 12:41:59 by ben]
ben
parents: 801
diff changeset
2197 mark_object (f->args[i]);
3092
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 2720
diff changeset
2198 #endif /* not NEW_GC */
814
a634e3b7acc8 [xemacs-hg @ 2002-04-14 12:41:59 by ben]
ben
parents: 801
diff changeset
2199
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2200 /* tail-recurse on constants */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2201 return f->constants;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2202 }
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 static int
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2205 compiled_function_equal (Lisp_Object obj1, Lisp_Object obj2, int depth)
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 Lisp_Compiled_Function *f1 = XCOMPILED_FUNCTION (obj1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2208 Lisp_Compiled_Function *f2 = XCOMPILED_FUNCTION (obj2);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2209 return
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2210 (f1->flags.documentationp == f2->flags.documentationp &&
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2211 f1->flags.interactivep == f2->flags.interactivep &&
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2212 f1->flags.domainp == f2->flags.domainp && /* I18N3 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2213 internal_equal (compiled_function_instructions (f1),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2214 compiled_function_instructions (f2), depth + 1) &&
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2215 internal_equal (f1->constants, f2->constants, depth + 1) &&
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2216 internal_equal (f1->arglist, f2->arglist, depth + 1) &&
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2217 internal_equal (f1->doc_and_interactive,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2218 f2->doc_and_interactive, depth + 1));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2219 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2220
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
2221 static Hashcode
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2222 compiled_function_hash (Lisp_Object obj, int depth)
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 Lisp_Compiled_Function *f = XCOMPILED_FUNCTION (obj);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2225 return HASH3 ((f->flags.documentationp << 2) +
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2226 (f->flags.interactivep << 1) +
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2227 f->flags.domainp,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2228 internal_hash (f->instructions, depth + 1),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2229 internal_hash (f->constants, depth + 1));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2230 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2231
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 1149
diff changeset
2232 static const struct memory_description compiled_function_description[] = {
814
a634e3b7acc8 [xemacs-hg @ 2002-04-14 12:41:59 by ben]
ben
parents: 801
diff changeset
2233 { XD_INT, offsetof (Lisp_Compiled_Function, args_in_array) },
3092
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 2720
diff changeset
2234 #ifdef NEW_GC
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 2720
diff changeset
2235 { XD_LISP_OBJECT, offsetof (Lisp_Compiled_Function, arguments) },
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 2720
diff changeset
2236 #else /* not NEW_GC */
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 2720
diff changeset
2237 { XD_BLOCK_PTR, offsetof (Lisp_Compiled_Function, args),
2551
9f70af3ac939 [xemacs-hg @ 2005-02-03 16:14:02 by james]
james
parents: 2532
diff changeset
2238 XD_INDIRECT (0, 0), { &lisp_object_description } },
3092
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 2720
diff changeset
2239 #endif /* not NEW_GC */
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
2240 { XD_LISP_OBJECT, offsetof (Lisp_Compiled_Function, instructions) },
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
2241 { XD_LISP_OBJECT, offsetof (Lisp_Compiled_Function, constants) },
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
2242 { XD_LISP_OBJECT, offsetof (Lisp_Compiled_Function, arglist) },
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
2243 { XD_LISP_OBJECT, offsetof (Lisp_Compiled_Function, doc_and_interactive) },
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2244 #ifdef COMPILED_FUNCTION_ANNOTATION_HACK
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 438
diff changeset
2245 { XD_LISP_OBJECT, offsetof (Lisp_Compiled_Function, annotated) },
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2246 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2247 { XD_END }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2248 };
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2249
934
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 872
diff changeset
2250 DEFINE_BASIC_LRECORD_IMPLEMENTATION ("compiled-function", compiled_function,
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 872
diff changeset
2251 1, /*dumpable_flag*/
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 872
diff changeset
2252 mark_compiled_function,
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 872
diff changeset
2253 print_compiled_function, 0,
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 872
diff changeset
2254 compiled_function_equal,
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 872
diff changeset
2255 compiled_function_hash,
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 872
diff changeset
2256 compiled_function_description,
c925bacdda60 [xemacs-hg @ 2002-07-29 09:21:12 by michaels]
michaels
parents: 872
diff changeset
2257 Lisp_Compiled_Function);
3092
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 2720
diff changeset
2258
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2259
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2260 DEFUN ("compiled-function-p", Fcompiled_function_p, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2261 Return t if OBJECT is a byte-compiled function object.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2262 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2263 (object))
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 return COMPILED_FUNCTIONP (object) ? Qt : Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2266 }
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 /************************************************************************/
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2269 /* compiled-function object accessor functions */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2270 /************************************************************************/
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2271
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2272 Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2273 compiled_function_arglist (Lisp_Compiled_Function *f)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2274 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2275 return f->arglist;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2276 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2277
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2278 Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2279 compiled_function_instructions (Lisp_Compiled_Function *f)
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 if (! OPAQUEP (f->instructions))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2282 return f->instructions;
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 /* Invert action performed by optimize_byte_code() */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2286 Lisp_Opaque *opaque = XOPAQUE (f->instructions);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2287
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
2288 Ibyte * const buffer =
2367
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
2289 alloca_ibytes (OPAQUE_SIZE (opaque) * MAX_ICHAR_LEN);
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
2290 Ibyte *bp = buffer;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2291
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2292 const Opbyte * const program = (const Opbyte *) OPAQUE_DATA (opaque);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2293 const Opbyte *program_ptr = program;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2294 const Opbyte * const program_end = program_ptr + OPAQUE_SIZE (opaque);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2295
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2296 while (program_ptr < program_end)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2297 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2298 Opcode opcode = (Opcode) READ_UINT_1;
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
2299 bp += set_itext_ichar (bp, opcode);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2300 switch (opcode)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2301 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2302 case Bvarref+7:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2303 case Bvarset+7:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2304 case Bvarbind+7:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2305 case Bcall+7:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2306 case Bunbind+7:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2307 case Bconstant2:
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
2308 bp += set_itext_ichar (bp, READ_UINT_1);
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
2309 bp += set_itext_ichar (bp, READ_UINT_1);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2310 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2311
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2312 case Bvarref+6:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2313 case Bvarset+6:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2314 case Bvarbind+6:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2315 case Bcall+6:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2316 case Bunbind+6:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2317 case BlistN:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2318 case BconcatN:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2319 case BinsertN:
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
2320 bp += set_itext_ichar (bp, READ_UINT_1);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2321 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2322
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2323 case Bgoto:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2324 case Bgotoifnil:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2325 case Bgotoifnonnil:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2326 case Bgotoifnilelsepop:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2327 case Bgotoifnonnilelsepop:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2328 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2329 int jump = READ_INT_2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2330 Opbyte buf2[2];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2331 Opbyte *buf2p = buf2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2332 /* Convert back to program-relative address */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2333 WRITE_INT16 (jump + (program_ptr - 2 - program), buf2p);
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
2334 bp += set_itext_ichar (bp, buf2[0]);
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
2335 bp += set_itext_ichar (bp, buf2[1]);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2336 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2337 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2338
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2339 case BRgoto:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2340 case BRgotoifnil:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2341 case BRgotoifnonnil:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2342 case BRgotoifnilelsepop:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2343 case BRgotoifnonnilelsepop:
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
2344 bp += set_itext_ichar (bp, READ_INT_1 + 127);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2345 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2346
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2347 default:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2348 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2349 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2350 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2351 return make_string (buffer, bp - buffer);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2352 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2353 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2354
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2355 Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2356 compiled_function_constants (Lisp_Compiled_Function *f)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2357 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2358 return f->constants;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2359 }
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 int
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2362 compiled_function_stack_depth (Lisp_Compiled_Function *f)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2363 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2364 return f->stack_depth;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2365 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2366
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2367 /* The compiled_function->doc_and_interactive slot uses the minimal
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2368 number of conses, based on compiled_function->flags; it may take
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2369 any of the following forms:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2370
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2371 doc
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2372 interactive
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2373 domain
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2374 (doc . interactive)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2375 (doc . domain)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2376 (interactive . domain)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2377 (doc . (interactive . domain))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2378 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2379
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2380 /* Caller must check flags.interactivep first */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2381 Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2382 compiled_function_interactive (Lisp_Compiled_Function *f)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2383 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2384 assert (f->flags.interactivep);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2385 if (f->flags.documentationp && f->flags.domainp)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2386 return XCAR (XCDR (f->doc_and_interactive));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2387 else if (f->flags.documentationp)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2388 return XCDR (f->doc_and_interactive);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2389 else if (f->flags.domainp)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2390 return XCAR (f->doc_and_interactive);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2391 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2392 return f->doc_and_interactive;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2393 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2394
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2395 /* Caller need not check flags.documentationp first */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2396 Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2397 compiled_function_documentation (Lisp_Compiled_Function *f)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2398 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2399 if (! f->flags.documentationp)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2400 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2401 else if (f->flags.interactivep && f->flags.domainp)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2402 return XCAR (f->doc_and_interactive);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2403 else if (f->flags.interactivep)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2404 return XCAR (f->doc_and_interactive);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2405 else if (f->flags.domainp)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2406 return XCAR (f->doc_and_interactive);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2407 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2408 return f->doc_and_interactive;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2409 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2410
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2411 /* Caller need not check flags.domainp first */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2412 Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2413 compiled_function_domain (Lisp_Compiled_Function *f)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2414 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2415 if (! f->flags.domainp)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2416 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2417 else if (f->flags.documentationp && f->flags.interactivep)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2418 return XCDR (XCDR (f->doc_and_interactive));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2419 else if (f->flags.documentationp)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2420 return XCDR (f->doc_and_interactive);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2421 else if (f->flags.interactivep)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2422 return XCDR (f->doc_and_interactive);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2423 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2424 return f->doc_and_interactive;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2425 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2426
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2427 #ifdef COMPILED_FUNCTION_ANNOTATION_HACK
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2429 Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2430 compiled_function_annotation (Lisp_Compiled_Function *f)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2431 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2432 return f->annotated;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2433 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2434
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2435 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2436
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2437 /* used only by Snarf-documentation; there must be doc already. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2438 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2439 set_compiled_function_documentation (Lisp_Compiled_Function *f,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2440 Lisp_Object new_doc)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2441 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2442 assert (f->flags.documentationp);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2443 assert (INTP (new_doc) || STRINGP (new_doc));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2444
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2445 if (f->flags.interactivep && f->flags.domainp)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2446 XCAR (f->doc_and_interactive) = new_doc;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2447 else if (f->flags.interactivep)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2448 XCAR (f->doc_and_interactive) = new_doc;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2449 else if (f->flags.domainp)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2450 XCAR (f->doc_and_interactive) = new_doc;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2451 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2452 f->doc_and_interactive = new_doc;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2453 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2454
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2455
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2456 DEFUN ("compiled-function-arglist", Fcompiled_function_arglist, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2457 Return the argument list of the compiled-function object FUNCTION.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2458 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2459 (function))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2460 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2461 CHECK_COMPILED_FUNCTION (function);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2462 return compiled_function_arglist (XCOMPILED_FUNCTION (function));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2463 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2464
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2465 DEFUN ("compiled-function-instructions", Fcompiled_function_instructions, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2466 Return the byte-opcode string of the compiled-function object FUNCTION.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2467 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2468 (function))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2469 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2470 CHECK_COMPILED_FUNCTION (function);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2471 return compiled_function_instructions (XCOMPILED_FUNCTION (function));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2472 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2473
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2474 DEFUN ("compiled-function-constants", Fcompiled_function_constants, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2475 Return the constants vector of the compiled-function object FUNCTION.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2476 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2477 (function))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2478 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2479 CHECK_COMPILED_FUNCTION (function);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2480 return compiled_function_constants (XCOMPILED_FUNCTION (function));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2481 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2482
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2483 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
2484 Return the maximum stack depth of the compiled-function object FUNCTION.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2485 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2486 (function))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2487 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2488 CHECK_COMPILED_FUNCTION (function);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2489 return make_int (compiled_function_stack_depth (XCOMPILED_FUNCTION (function)));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2490 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2491
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2492 DEFUN ("compiled-function-doc-string", Fcompiled_function_doc_string, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2493 Return the doc string of the compiled-function object FUNCTION, if available.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2494 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
2495 an integer returned instead of a string.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2496 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2497 (function))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2498 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2499 CHECK_COMPILED_FUNCTION (function);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2500 return compiled_function_documentation (XCOMPILED_FUNCTION (function));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2501 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2502
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2503 DEFUN ("compiled-function-interactive", Fcompiled_function_interactive, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2504 Return the interactive spec of the compiled-function object FUNCTION, or nil.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2505 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
2506 `interactive' and whose second element is the interactive spec.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2507 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2508 (function))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2509 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2510 CHECK_COMPILED_FUNCTION (function);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2511 return XCOMPILED_FUNCTION (function)->flags.interactivep
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2512 ? list2 (Qinteractive,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2513 compiled_function_interactive (XCOMPILED_FUNCTION (function)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2514 : Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2515 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2516
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2517 #ifdef COMPILED_FUNCTION_ANNOTATION_HACK
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2518
826
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 814
diff changeset
2519 DEFUN ("compiled-function-annotation", Fcompiled_function_annotation, 1, 1, 0, /*
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2520 Return the annotation of the compiled-function object FUNCTION, or nil.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2521 The annotation is a piece of information indicating where this
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2522 compiled-function object came from. Generally this will be
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2523 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
2524 compiled-function object was not defined in a function; or nil,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2525 if the compiled-function object was not created as a result of
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2526 a `load'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2527 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2528 (function))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2529 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2530 CHECK_COMPILED_FUNCTION (function);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2531 return compiled_function_annotation (XCOMPILED_FUNCTION (function));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2532 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2533
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2534 #endif /* COMPILED_FUNCTION_ANNOTATION_HACK */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2535
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2536 DEFUN ("compiled-function-domain", Fcompiled_function_domain, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2537 Return the domain of the compiled-function object FUNCTION, or nil.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2538 This is only meaningful if I18N3 was enabled when emacs was compiled.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2539 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2540 (function))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2541 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2542 CHECK_COMPILED_FUNCTION (function);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2543 return XCOMPILED_FUNCTION (function)->flags.domainp
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2544 ? compiled_function_domain (XCOMPILED_FUNCTION (function))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2545 : Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2546 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2547
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2548
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2549
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2550 DEFUN ("fetch-bytecode", Ffetch_bytecode, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2551 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
2552 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2553 (function))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2554 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2555 Lisp_Compiled_Function *f;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2556 CHECK_COMPILED_FUNCTION (function);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2557 f = XCOMPILED_FUNCTION (function);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2558
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2559 if (OPAQUEP (f->instructions) || STRINGP (f->instructions))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2560 return function;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2561
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2562 if (CONSP (f->instructions))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2563 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2564 Lisp_Object tem = read_doc_string (f->instructions);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2565 if (!CONSP (tem))
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 444
diff changeset
2566 signal_error (Qinvalid_byte_code,
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 444
diff changeset
2567 "Invalid lazy-loaded byte code", tem);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2568 /* v18 or v19 bytecode file. Need to Ebolify. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2569 if (f->flags.ebolified && VECTORP (XCDR (tem)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2570 ebolify_bytecode_constants (XCDR (tem));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2571 f->instructions = XCAR (tem);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2572 f->constants = XCDR (tem);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2573 return function;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2574 }
2500
3d8143fc88e1 [xemacs-hg @ 2005-01-24 23:33:30 by ben]
ben
parents: 2367
diff changeset
2575 ABORT ();
801
2b676dc88c66 [xemacs-hg @ 2002-04-01 03:58:02 by ben]
ben
parents: 800
diff changeset
2576 return Qnil; /* not (usually) reached */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2577 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2578
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2579 DEFUN ("optimize-compiled-function", Foptimize_compiled_function, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2580 Convert compiled function FUNCTION into an optimized internal form.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2581 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2582 (function))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2583 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2584 Lisp_Compiled_Function *f;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2585 CHECK_COMPILED_FUNCTION (function);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2586 f = XCOMPILED_FUNCTION (function);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2587
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2588 if (OPAQUEP (f->instructions)) /* Already optimized? */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2589 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2590
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2591 optimize_compiled_function (function);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2592 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2593 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2594
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2595 DEFUN ("byte-code", Fbyte_code, 3, 3, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2596 Function used internally in byte-compiled code.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2597 First argument INSTRUCTIONS is a string of byte code.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2598 Second argument CONSTANTS is a vector of constants.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2599 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
2600 If STACK-DEPTH is incorrect, Emacs may crash.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2601 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2602 (instructions, constants, stack_depth))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2603 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2604 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2605 int varbind_count;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2606 int program_length;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2607 Opbyte *program;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2608
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2609 CHECK_STRING (instructions);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2610 CHECK_VECTOR (constants);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2611 CHECK_NATNUM (stack_depth);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2612
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2613 /* Optimize the `instructions' string, just like when executing a
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2614 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
2615 likely to only be executed once. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2616 program = alloca_array (Opbyte, 1 + 2 * XSTRING_LENGTH (instructions));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2617 optimize_byte_code (instructions, constants, program,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2618 &program_length, &varbind_count);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2619 SPECPDL_RESERVE (varbind_count);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2620 return execute_optimized_program (program,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2621 XINT (stack_depth),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2622 XVECTOR_DATA (constants));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2623 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2624
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2625
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2626 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2627 syms_of_bytecode (void)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2628 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2629 INIT_LRECORD_IMPLEMENTATION (compiled_function);
3092
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 2720
diff changeset
2630 #ifdef NEW_GC
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 2720
diff changeset
2631 INIT_LRECORD_IMPLEMENTATION (compiled_function_args);
141c2920ea48 [xemacs-hg @ 2005-11-25 01:41:31 by crestani]
crestani
parents: 2720
diff changeset
2632 #endif /* NEW_GC */
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2633
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
2634 DEFERROR_STANDARD (Qinvalid_byte_code, Qinvalid_state);
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 444
diff changeset
2635 DEFSYMBOL (Qbyte_code);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 444
diff changeset
2636 DEFSYMBOL_MULTIWORD_PREDICATE (Qcompiled_functionp);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2637
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2638 DEFSUBR (Fbyte_code);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2639 DEFSUBR (Ffetch_bytecode);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2640 DEFSUBR (Foptimize_compiled_function);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2641
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2642 DEFSUBR (Fcompiled_function_p);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2643 DEFSUBR (Fcompiled_function_instructions);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2644 DEFSUBR (Fcompiled_function_constants);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2645 DEFSUBR (Fcompiled_function_stack_depth);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2646 DEFSUBR (Fcompiled_function_arglist);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2647 DEFSUBR (Fcompiled_function_interactive);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2648 DEFSUBR (Fcompiled_function_doc_string);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2649 DEFSUBR (Fcompiled_function_domain);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2650 #ifdef COMPILED_FUNCTION_ANNOTATION_HACK
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2651 DEFSUBR (Fcompiled_function_annotation);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2652 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2653
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2654 #ifdef BYTE_CODE_METER
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 444
diff changeset
2655 DEFSYMBOL (Qbyte_code_meter);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2656 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2657 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2658
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2659 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2660 vars_of_bytecode (void)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2661 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2662 #ifdef BYTE_CODE_METER
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2663
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2664 DEFVAR_LISP ("byte-code-meter", &Vbyte_code_meter /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2665 A vector of vectors which holds a histogram of byte code usage.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2666 \(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
2667 opcode CODE has been executed.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2668 \(aref (aref byte-code-meter CODE1) CODE2), where CODE1 is not 0,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2669 indicates how many times the byte opcodes CODE1 and CODE2 have been
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2670 executed in succession.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2671 */ );
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2672 DEFVAR_BOOL ("byte-metering-on", &byte_metering_on /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2673 If non-nil, keep profiling information on byte code usage.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2674 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
2675 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
2676 integer, it is incremented each time that symbol's function is called.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2677 */ );
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2678
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2679 byte_metering_on = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2680 Vbyte_code_meter = make_vector (256, Qzero);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2681 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2682 int i = 256;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2683 while (i--)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2684 XVECTOR_DATA (Vbyte_code_meter)[i] = make_vector (256, Qzero);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2685 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2686 #endif /* BYTE_CODE_METER */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2687 }