home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 5 Edit / 05-Edit.zip / e20313sr.zip / emacs / 20.3.1 / src / bytecode.c < prev    next >
C/C++ Source or Header  |  1999-07-31  |  25KB  |  1,194 lines
  1. /* Execution of byte code produced by bytecomp.el.
  2.    Copyright (C) 1985, 1986, 1987, 1988, 1993 Free Software Foundation, Inc.
  3.  
  4. This file is part of GNU Emacs.
  5.  
  6. GNU Emacs is free software; you can redistribute it and/or modify
  7. it under the terms of the GNU General Public License as published by
  8. the Free Software Foundation; either version 2, or (at your option)
  9. any later version.
  10.  
  11. GNU Emacs is distributed in the hope that it will be useful,
  12. but WITHOUT ANY WARRANTY; without even the implied warranty of
  13. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14. GNU General Public License for more details.
  15.  
  16. You should have received a copy of the GNU General Public License
  17. along with GNU Emacs; see the file COPYING.  If not, write to
  18. the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  19. Boston, MA 02111-1307, USA.
  20.  
  21. hacked on by jwz@lucid.com 17-jun-91
  22.   o  added a compile-time switch to turn on simple sanity checking;
  23.   o  put back the obsolete byte-codes for error-detection;
  24.   o  added a new instruction, unbind_all, which I will use for 
  25.      tail-recursion elimination;
  26.   o  made temp_output_buffer_show be called with the right number
  27.      of args;
  28.   o  made the new bytecodes be called with args in the right order;
  29.   o  added metering support.
  30.  
  31. by Hallvard:
  32.   o  added relative jump instructions;
  33.   o  all conditionals now only do QUIT if they jump.
  34.  */
  35.  
  36. #include <config.h>
  37. #include "lisp.h"
  38. #include "buffer.h"
  39. #include "syntax.h"
  40.  
  41. /*
  42.  * define BYTE_CODE_SAFE to enable some minor sanity checking (useful for 
  43.  * debugging the byte compiler...)
  44.  *
  45.  * define BYTE_CODE_METER to enable generation of a byte-op usage histogram. 
  46.  */
  47. /* #define BYTE_CODE_SAFE */
  48. /* #define BYTE_CODE_METER */
  49.  
  50.  
  51. #ifdef BYTE_CODE_METER
  52.  
  53. Lisp_Object Vbyte_code_meter, Qbyte_code_meter;
  54. int byte_metering_on;
  55.  
  56. #define METER_2(code1, code2) \
  57.   XFASTINT (XVECTOR (XVECTOR (Vbyte_code_meter)->contents[(code1)]) \
  58.         ->contents[(code2)])
  59.  
  60. #define METER_1(code) METER_2 (0, (code))
  61.  
  62. #define METER_CODE(last_code, this_code)            \
  63. {                                \
  64.   if (byte_metering_on)                        \
  65.     {                                \
  66.       if (METER_1 (this_code) != ((1<<VALBITS)-1))        \
  67.         METER_1 (this_code)++;                    \
  68.       if (last_code                        \
  69.       && METER_2 (last_code, this_code) != ((1<<VALBITS)-1))\
  70.         METER_2 (last_code, this_code)++;            \
  71.     }                                \
  72. }
  73.  
  74. #else /* no BYTE_CODE_METER */
  75.  
  76. #define METER_CODE(last_code, this_code)
  77.  
  78. #endif /* no BYTE_CODE_METER */
  79.  
  80.  
  81. Lisp_Object Qbytecode;
  82.  
  83. /*  Byte codes: */
  84.  
  85. #define Bvarref 010
  86. #define Bvarset 020
  87. #define Bvarbind 030
  88. #define Bcall 040
  89. #define Bunbind 050
  90.  
  91. #define Bnth 070
  92. #define Bsymbolp 071
  93. #define Bconsp 072
  94. #define Bstringp 073
  95. #define Blistp 074
  96. #define Beq 075
  97. #define Bmemq 076
  98. #define Bnot 077
  99. #define Bcar 0100
  100. #define Bcdr 0101
  101. #define Bcons 0102
  102. #define Blist1 0103
  103. #define Blist2 0104
  104. #define Blist3 0105
  105. #define Blist4 0106
  106. #define Blength 0107
  107. #define Baref 0110
  108. #define Baset 0111
  109. #define Bsymbol_value 0112
  110. #define Bsymbol_function 0113
  111. #define Bset 0114
  112. #define Bfset 0115
  113. #define Bget 0116
  114. #define Bsubstring 0117
  115. #define Bconcat2 0120
  116. #define Bconcat3 0121
  117. #define Bconcat4 0122
  118. #define Bsub1 0123
  119. #define Badd1 0124
  120. #define Beqlsign 0125
  121. #define Bgtr 0126
  122. #define Blss 0127
  123. #define Bleq 0130
  124. #define Bgeq 0131
  125. #define Bdiff 0132
  126. #define Bnegate 0133
  127. #define Bplus 0134
  128. #define Bmax 0135
  129. #define Bmin 0136
  130. #define Bmult 0137
  131.  
  132. #define Bpoint 0140
  133. /* Was Bmark in v17.  */
  134. #define Bsave_current_buffer 0141
  135. #define Bgoto_char 0142
  136. #define Binsert 0143
  137. #define Bpoint_max 0144
  138. #define Bpoint_min 0145
  139. #define Bchar_after 0146
  140. #define Bfollowing_char 0147
  141. #define Bpreceding_char 0150
  142. #define Bcurrent_column 0151
  143. #define Bindent_to 0152
  144. #define Bscan_buffer 0153 /* No longer generated as of v18 */
  145. #define Beolp 0154
  146. #define Beobp 0155
  147. #define Bbolp 0156
  148. #define Bbobp 0157
  149. #define Bcurrent_buffer 0160
  150. #define Bset_buffer 0161
  151. #define Bsave_current_buffer_1 0162 /* Replacing Bsave_current_buffer.  */
  152. #define Bread_char 0162 /* No longer generated as of v19 */
  153. #define Bset_mark 0163 /* this loser is no longer generated as of v18 */
  154. #define Binteractive_p 0164 /* Needed since interactive-p takes unevalled args */
  155.  
  156. #define Bforward_char 0165
  157. #define Bforward_word 0166
  158. #define Bskip_chars_forward 0167
  159. #define Bskip_chars_backward 0170
  160. #define Bforward_line 0171
  161. #define Bchar_syntax 0172
  162. #define Bbuffer_substring 0173
  163. #define Bdelete_region 0174
  164. #define Bnarrow_to_region 0175
  165. #define Bwiden 0176
  166. #define Bend_of_line 0177
  167.  
  168. #define Bconstant2 0201
  169. #define Bgoto 0202
  170. #define Bgotoifnil 0203
  171. #define Bgotoifnonnil 0204
  172. #define Bgotoifnilelsepop 0205
  173. #define Bgotoifnonnilelsepop 0206
  174. #define Breturn 0207
  175. #define Bdiscard 0210
  176. #define Bdup 0211
  177.  
  178. #define Bsave_excursion 0212
  179. #define Bsave_window_excursion 0213
  180. #define Bsave_restriction 0214
  181. #define Bcatch 0215
  182.  
  183. #define Bunwind_protect 0216
  184. #define Bcondition_case 0217
  185. #define Btemp_output_buffer_setup 0220
  186. #define Btemp_output_buffer_show 0221
  187.  
  188. #define Bunbind_all 0222
  189.  
  190. #define Bset_marker 0223
  191. #define Bmatch_beginning 0224
  192. #define Bmatch_end 0225
  193. #define Bupcase 0226
  194. #define Bdowncase 0227
  195.  
  196. #define Bstringeqlsign 0230
  197. #define Bstringlss 0231
  198. #define Bequal 0232
  199. #define Bnthcdr 0233
  200. #define Belt 0234
  201. #define Bmember 0235
  202. #define Bassq 0236
  203. #define Bnreverse 0237
  204. #define Bsetcar 0240
  205. #define Bsetcdr 0241
  206. #define Bcar_safe 0242
  207. #define Bcdr_safe 0243
  208. #define Bnconc 0244
  209. #define Bquo 0245
  210. #define Brem 0246
  211. #define Bnumberp 0247
  212. #define Bintegerp 0250
  213.  
  214. #define BRgoto 0252
  215. #define BRgotoifnil 0253
  216. #define BRgotoifnonnil 0254
  217. #define BRgotoifnilelsepop 0255
  218. #define BRgotoifnonnilelsepop 0256
  219.  
  220. #define BlistN 0257
  221. #define BconcatN 0260
  222. #define BinsertN 0261
  223.  
  224. #define Bconstant 0300
  225. #define CONSTANTLIM 0100
  226.  
  227. /* Fetch the next byte from the bytecode stream */
  228.  
  229. #define FETCH *pc++
  230.  
  231. /* Fetch two bytes from the bytecode stream
  232.  and make a 16-bit number out of them */
  233.  
  234. #define FETCH2 (op = FETCH, op + (FETCH << 8))
  235.  
  236. /* Push x onto the execution stack. */
  237.  
  238. /* This used to be #define PUSH(x) (*++stackp = (x))
  239.    This oddity is necessary because Alliant can't be bothered to
  240.    compile the preincrement operator properly, as of 4/91.  -JimB  */
  241. #define PUSH(x) (stackp++, *stackp = (x))
  242.  
  243. /* Pop a value off the execution stack.  */
  244.  
  245. #define POP (*stackp--)
  246.  
  247. /* Discard n values from the execution stack.  */
  248.  
  249. #define DISCARD(n) (stackp -= (n))
  250.  
  251. /* Get the value which is at the top of the execution stack, but don't pop it. */
  252.  
  253. #define TOP (*stackp)
  254.  
  255. /* Garbage collect if we have consed enough since the last time.
  256.    We do this at every branch, to avoid loops that never GC.  */
  257.  
  258. #define MAYBE_GC()                \
  259.   if (consing_since_gc > gc_cons_threshold)    \
  260.     {                        \
  261.       Fgarbage_collect ();            \
  262.       HANDLE_RELOCATION ();            \
  263.     }                        \
  264.   else
  265.  
  266. /* Relocate BYTESTR if there has been a GC recently.  */
  267. #define HANDLE_RELOCATION()                        \
  268.   if (! EQ (string_saved, bytestr))                    \
  269.     {                                    \
  270.       pc = pc - XSTRING (string_saved)->data + XSTRING (bytestr)->data;    \
  271.       string_saved = bytestr;                        \
  272.     }                                    \
  273.   else
  274.  
  275. /* Check for jumping out of range.  */
  276. #define CHECK_RANGE(ARG)            \
  277.   if (ARG >= bytestr_length) abort ()
  278.  
  279. DEFUN ("byte-code", Fbyte_code, Sbyte_code, 3, 3, 0,
  280.   "Function used internally in byte-compiled code.\n\
  281. The first argument, BYTESTR, is a string of byte code;\n\
  282. the second, VECTOR, a vector of constants;\n\
  283. the third, MAXDEPTH, the maximum stack depth used in this function.\n\
  284. If the third argument is incorrect, Emacs may crash.")
  285.   (bytestr, vector, maxdepth)
  286.      Lisp_Object bytestr, vector, maxdepth;
  287. {
  288.   struct gcpro gcpro1, gcpro2, gcpro3;
  289.   int count = specpdl_ptr - specpdl;
  290. #ifdef BYTE_CODE_METER
  291.   int this_op = 0;
  292.   int prev_op;
  293. #endif
  294.   register int op;
  295.   unsigned char *pc;
  296.   Lisp_Object *stack;
  297.   register Lisp_Object *stackp;
  298.   Lisp_Object *stacke;
  299.   register Lisp_Object v1, v2;
  300.   register Lisp_Object *vectorp = XVECTOR (vector)->contents;
  301. #ifdef BYTE_CODE_SAFE
  302.   register int const_length = XVECTOR (vector)->size;
  303. #endif
  304.   /* Copy of BYTESTR, saved so we can tell if BYTESTR was relocated.  */
  305.   Lisp_Object string_saved;
  306.   /* Cached address of beginning of string,
  307.      valid if BYTESTR equals STRING_SAVED.  */
  308.   register unsigned char *strbeg;
  309.   int bytestr_length = STRING_BYTES (XSTRING (bytestr));
  310.  
  311.   CHECK_STRING (bytestr, 0);
  312.   if (!VECTORP (vector))
  313.     vector = wrong_type_argument (Qvectorp, vector);
  314.   CHECK_NUMBER (maxdepth, 2);
  315.  
  316.   stackp = (Lisp_Object *) alloca (XFASTINT (maxdepth) * sizeof (Lisp_Object));
  317.   bzero (stackp, XFASTINT (maxdepth) * sizeof (Lisp_Object));
  318.   GCPRO3 (bytestr, vector, *stackp);
  319.   gcpro3.nvars = XFASTINT (maxdepth);
  320.  
  321.   --stackp;
  322.   stack = stackp;
  323.   stacke = stackp + XFASTINT (maxdepth);
  324.  
  325.   /* Initialize the saved pc-pointer for fetching from the string.  */
  326.   string_saved = bytestr;
  327.   pc = XSTRING (string_saved)->data;
  328.  
  329.   while (1)
  330.     {
  331. #ifdef BYTE_CODE_SAFE
  332.       if (stackp > stacke)
  333.     error ("Byte code stack overflow (byte compiler bug), pc %d, depth %d",
  334.            pc - XSTRING (string_saved)->data, stacke - stackp);
  335.       if (stackp < stack)
  336.     error ("Byte code stack underflow (byte compiler bug), pc %d",
  337.            pc - XSTRING (string_saved)->data);
  338. #endif
  339.  
  340.       /* Update BYTESTR if we had a garbage collection.  */
  341.       HANDLE_RELOCATION ();
  342.  
  343. #ifdef BYTE_CODE_METER
  344.       prev_op = this_op;
  345.       this_op = op = FETCH;
  346.       METER_CODE (prev_op, op);
  347.       switch (op)
  348. #else
  349.       switch (op = FETCH)
  350. #endif
  351.     {
  352.     case Bvarref+6:
  353.       op = FETCH;
  354.       goto varref;
  355.  
  356.     case Bvarref+7:
  357.       op = FETCH2;
  358.       goto varref;
  359.  
  360.     case Bvarref: case Bvarref+1: case Bvarref+2: case Bvarref+3:
  361.     case Bvarref+4: case Bvarref+5:
  362.       op = op - Bvarref;
  363.     varref:
  364.       v1 = vectorp[op];
  365.       if (!SYMBOLP (v1))
  366.         v2 = Fsymbol_value (v1);
  367.       else
  368.         {
  369.           v2 = XSYMBOL (v1)->value;
  370.           if (MISCP (v2) || EQ (v2, Qunbound))
  371.         v2 = Fsymbol_value (v1);
  372.         }
  373.       PUSH (v2);
  374.       break;
  375.  
  376.     case Bvarset+6:
  377.       op = FETCH;
  378.       goto varset;
  379.  
  380.     case Bvarset+7:
  381.       op = FETCH2;
  382.       goto varset;
  383.  
  384.     case Bvarset: case Bvarset+1: case Bvarset+2: case Bvarset+3:
  385.     case Bvarset+4: case Bvarset+5:
  386.       op -= Bvarset;
  387.     varset:
  388.       Fset (vectorp[op], POP);
  389.       break;
  390.  
  391.     case Bvarbind+6:
  392.       op = FETCH;
  393.       goto varbind;
  394.  
  395.     case Bvarbind+7:
  396.       op = FETCH2;
  397.       goto varbind;
  398.  
  399.     case Bvarbind: case Bvarbind+1: case Bvarbind+2: case Bvarbind+3:
  400.     case Bvarbind+4: case Bvarbind+5:
  401.       op -= Bvarbind;
  402.     varbind:
  403.       specbind (vectorp[op], POP);
  404.       break;
  405.  
  406.     case Bcall+6:
  407.       op = FETCH;
  408.       goto docall;
  409.  
  410.     case Bcall+7:
  411.       op = FETCH2;
  412.       goto docall;
  413.  
  414.     case Bcall: case Bcall+1: case Bcall+2: case Bcall+3:
  415.     case Bcall+4: case Bcall+5:
  416.       op -= Bcall;
  417.     docall:
  418.       DISCARD (op);
  419. #ifdef BYTE_CODE_METER
  420.       if (byte_metering_on && SYMBOLP (TOP))
  421.         {
  422.           v1 = TOP;
  423.           v2 = Fget (v1, Qbyte_code_meter);
  424.           if (INTEGERP (v2)
  425.           && XINT (v2) != ((1<<VALBITS)-1))
  426.         {
  427.           XSETINT (v2, XINT (v2) + 1);
  428.           Fput (v1, Qbyte_code_meter, v2);
  429.         }
  430.         }
  431. #endif
  432.       TOP = Ffuncall (op + 1, &TOP);
  433.       break;
  434.  
  435.     case Bunbind+6:
  436.       op = FETCH;
  437.       goto dounbind;
  438.  
  439.     case Bunbind+7:
  440.       op = FETCH2;
  441.       goto dounbind;
  442.  
  443.     case Bunbind: case Bunbind+1: case Bunbind+2: case Bunbind+3:
  444.     case Bunbind+4: case Bunbind+5:
  445.       op -= Bunbind;
  446.     dounbind:
  447.       unbind_to (specpdl_ptr - specpdl - op, Qnil);
  448.       break;
  449.  
  450.     case Bunbind_all:
  451.       /* To unbind back to the beginning of this frame.  Not used yet,
  452.          but will be needed for tail-recursion elimination.  */
  453.       unbind_to (count, Qnil);
  454.       break;
  455.  
  456.     case Bgoto:
  457.       MAYBE_GC ();
  458.       QUIT;
  459.       op = FETCH2;    /* pc = FETCH2 loses since FETCH2 contains pc++ */
  460.       CHECK_RANGE (op);
  461.       pc = XSTRING (string_saved)->data + op;
  462.       break;
  463.  
  464.     case Bgotoifnil:
  465.       MAYBE_GC ();
  466.       op = FETCH2;
  467.       if (NILP (POP))
  468.         {
  469.           QUIT;
  470.           CHECK_RANGE (op);
  471.           pc = XSTRING (string_saved)->data + op;
  472.         }
  473.       break;
  474.  
  475.     case Bgotoifnonnil:
  476.       MAYBE_GC ();
  477.       op = FETCH2;
  478.       if (!NILP (POP))
  479.         {
  480.           QUIT;
  481.           CHECK_RANGE (op);
  482.           pc = XSTRING (string_saved)->data + op;
  483.         }
  484.       break;
  485.  
  486.     case Bgotoifnilelsepop:
  487.       MAYBE_GC ();
  488.       op = FETCH2;
  489.       if (NILP (TOP))
  490.         {
  491.           QUIT;
  492.           CHECK_RANGE (op);
  493.           pc = XSTRING (string_saved)->data + op;
  494.         }
  495.       else DISCARD (1);
  496.       break;
  497.  
  498.     case Bgotoifnonnilelsepop:
  499.       MAYBE_GC ();
  500.       op = FETCH2;
  501.       if (!NILP (TOP))
  502.         {
  503.           QUIT;
  504.           CHECK_RANGE (op);
  505.           pc = XSTRING (string_saved)->data + op;
  506.         }
  507.       else DISCARD (1);
  508.       break;
  509.  
  510.     case BRgoto:
  511.       MAYBE_GC ();
  512.       QUIT;
  513.       pc += (int) *pc - 127;
  514.       break;
  515.  
  516.     case BRgotoifnil:
  517.       MAYBE_GC ();
  518.       if (NILP (POP))
  519.         {
  520.           QUIT;
  521.           pc += (int) *pc - 128;
  522.         }
  523.       pc++;
  524.       break;
  525.  
  526.     case BRgotoifnonnil:
  527.       MAYBE_GC ();
  528.       if (!NILP (POP))
  529.         {
  530.           QUIT;
  531.           pc += (int) *pc - 128;
  532.         }
  533.       pc++;
  534.       break;
  535.  
  536.     case BRgotoifnilelsepop:
  537.       MAYBE_GC ();
  538.       op = *pc++;
  539.       if (NILP (TOP))
  540.         {
  541.           QUIT;
  542.           pc += op - 128;
  543.         }
  544.       else DISCARD (1);
  545.       break;
  546.  
  547.     case BRgotoifnonnilelsepop:
  548.       MAYBE_GC ();
  549.       op = *pc++;
  550.       if (!NILP (TOP))
  551.         {
  552.           QUIT;
  553.           pc += op - 128;
  554.         }
  555.       else DISCARD (1);
  556.       break;
  557.  
  558.     case Breturn:
  559.       v1 = POP;
  560.       goto exit;
  561.  
  562.     case Bdiscard:
  563.       DISCARD (1);
  564.       break;
  565.  
  566.     case Bdup:
  567.       v1 = TOP;
  568.       PUSH (v1);
  569.       break;
  570.  
  571.     case Bconstant2:
  572.       PUSH (vectorp[FETCH2]);
  573.       break;
  574.  
  575.     case Bsave_excursion:
  576.       record_unwind_protect (save_excursion_restore, save_excursion_save ());
  577.       break;
  578.  
  579.     case Bsave_current_buffer:
  580.     case Bsave_current_buffer_1:
  581.       record_unwind_protect (set_buffer_if_live, Fcurrent_buffer ());
  582.       break;
  583.  
  584.     case Bsave_window_excursion:
  585.       TOP = Fsave_window_excursion (TOP);
  586.       break;
  587.  
  588.     case Bsave_restriction:
  589.       record_unwind_protect (save_restriction_restore, save_restriction_save ());
  590.       break;
  591.  
  592.     case Bcatch:
  593.       v1 = POP;
  594.       TOP = internal_catch (TOP, Feval, v1);
  595.       break;
  596.  
  597.     case Bunwind_protect:
  598.       record_unwind_protect (0, POP);
  599.       (specpdl_ptr - 1)->symbol = Qnil;
  600.       break;
  601.  
  602.     case Bcondition_case:
  603.       v1 = POP;
  604.       v1 = Fcons (POP, v1);
  605.       TOP = Fcondition_case (Fcons (TOP, v1));
  606.       break;
  607.  
  608.     case Btemp_output_buffer_setup:
  609.       temp_output_buffer_setup (XSTRING (TOP)->data);
  610.       TOP = Vstandard_output;
  611.       break;
  612.  
  613.     case Btemp_output_buffer_show:
  614.       v1 = POP;
  615.       temp_output_buffer_show (TOP);
  616.       TOP = v1;
  617.       /* pop binding of standard-output */
  618.       unbind_to (specpdl_ptr - specpdl - 1, Qnil);
  619.       break;
  620.  
  621.     case Bnth:
  622.       v1 = POP;
  623.       v2 = TOP;
  624.     nth_entry:
  625.       CHECK_NUMBER (v2, 0);
  626.       op = XINT (v2);
  627.       immediate_quit = 1;
  628.       while (--op >= 0)
  629.         {
  630.           if (CONSP (v1))
  631.         v1 = XCONS (v1)->cdr;
  632.           else if (!NILP (v1))
  633.         {
  634.           immediate_quit = 0;
  635.           v1 = wrong_type_argument (Qlistp, v1);
  636.           immediate_quit = 1;
  637.           op++;
  638.         }
  639.         }
  640.       immediate_quit = 0;
  641.       goto docar;
  642.  
  643.     case Bsymbolp:
  644.       TOP = SYMBOLP (TOP) ? Qt : Qnil;
  645.       break;
  646.  
  647.     case Bconsp:
  648.       TOP = CONSP (TOP) ? Qt : Qnil;
  649.       break;
  650.  
  651.     case Bstringp:
  652.       TOP = STRINGP (TOP) ? Qt : Qnil;
  653.       break;
  654.  
  655.     case Blistp:
  656.       TOP = CONSP (TOP) || NILP (TOP) ? Qt : Qnil;
  657.       break;
  658.  
  659.     case Beq:
  660.       v1 = POP;
  661.       TOP = EQ (v1, TOP) ? Qt : Qnil;
  662.       break;
  663.  
  664.     case Bmemq:
  665.       v1 = POP;
  666.       TOP = Fmemq (TOP, v1);
  667.       break;
  668.  
  669.     case Bnot:
  670.       TOP = NILP (TOP) ? Qt : Qnil;
  671.       break;
  672.  
  673.     case Bcar:
  674.       v1 = TOP;
  675.     docar:
  676.       if (CONSP (v1)) TOP = XCONS (v1)->car;
  677.       else if (NILP (v1)) TOP = Qnil;
  678.       else Fcar (wrong_type_argument (Qlistp, v1));
  679.       break;
  680.  
  681.     case Bcdr:
  682.       v1 = TOP;
  683.       if (CONSP (v1)) TOP = XCONS (v1)->cdr;
  684.       else if (NILP (v1)) TOP = Qnil;
  685.       else Fcdr (wrong_type_argument (Qlistp, v1));
  686.       break;
  687.  
  688.     case Bcons:
  689.       v1 = POP;
  690.       TOP = Fcons (TOP, v1);
  691.       break;
  692.  
  693.     case Blist1:
  694.       TOP = Fcons (TOP, Qnil);
  695.       break;
  696.  
  697.     case Blist2:
  698.       v1 = POP;
  699.       TOP = Fcons (TOP, Fcons (v1, Qnil));
  700.       break;
  701.  
  702.     case Blist3:
  703.       DISCARD (2);
  704.       TOP = Flist (3, &TOP);
  705.       break;
  706.  
  707.     case Blist4:
  708.       DISCARD (3);
  709.       TOP = Flist (4, &TOP);
  710.       break;
  711.  
  712.     case BlistN:
  713.       op = FETCH;
  714.       DISCARD (op - 1);
  715.       TOP = Flist (op, &TOP);
  716.       break;
  717.  
  718.     case Blength:
  719.       TOP = Flength (TOP);
  720.       break;
  721.  
  722.     case Baref:
  723.           v1 = POP;
  724.       TOP = Faref (TOP, v1);
  725.       break;
  726.  
  727.     case Baset:
  728.       v2 = POP; v1 = POP;
  729.       TOP = Faset (TOP, v1, v2);
  730.       break;
  731.  
  732.     case Bsymbol_value:
  733.       TOP = Fsymbol_value (TOP);
  734.       break;
  735.  
  736.     case Bsymbol_function:
  737.       TOP = Fsymbol_function (TOP);
  738.       break;
  739.  
  740.     case Bset:
  741.       v1 = POP;
  742.       TOP = Fset (TOP, v1);
  743.       break;
  744.  
  745.     case Bfset:
  746.       v1 = POP;
  747.       TOP = Ffset (TOP, v1);
  748.       break;
  749.  
  750.     case Bget:
  751.       v1 = POP;
  752.       TOP = Fget (TOP, v1);
  753.       break;
  754.  
  755.     case Bsubstring:
  756.       v2 = POP; v1 = POP;
  757.       TOP = Fsubstring (TOP, v1, v2);
  758.       break;
  759.  
  760.     case Bconcat2:
  761.       DISCARD (1);
  762.       TOP = Fconcat (2, &TOP);
  763.       break;
  764.  
  765.     case Bconcat3:
  766.       DISCARD (2);
  767.       TOP = Fconcat (3, &TOP);
  768.       break;
  769.  
  770.     case Bconcat4:
  771.       DISCARD (3);
  772.       TOP = Fconcat (4, &TOP);
  773.       break;
  774.  
  775.     case BconcatN:
  776.       op = FETCH;
  777.       DISCARD (op - 1);
  778.       TOP = Fconcat (op, &TOP);
  779.       break;
  780.  
  781.     case Bsub1:
  782.       v1 = TOP;
  783.       if (INTEGERP (v1))
  784.         {
  785.           XSETINT (v1, XINT (v1) - 1);
  786.           TOP = v1;
  787.         }
  788.       else
  789.         TOP = Fsub1 (v1);
  790.       break;
  791.  
  792.     case Badd1:
  793.       v1 = TOP;
  794.       if (INTEGERP (v1))
  795.         {
  796.           XSETINT (v1, XINT (v1) + 1);
  797.           TOP = v1;
  798.         }
  799.       else
  800.         TOP = Fadd1 (v1);
  801.       break;
  802.  
  803.     case Beqlsign:
  804.       v2 = POP; v1 = TOP;
  805.       CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (v1, 0);
  806.       CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (v2, 0);
  807. #ifdef LISP_FLOAT_TYPE
  808.       if (FLOATP (v1) || FLOATP (v2))
  809.         {
  810.           double f1, f2;
  811.  
  812.           f1 = (FLOATP (v1) ? XFLOAT (v1)->data : XINT (v1));
  813.           f2 = (FLOATP (v2) ? XFLOAT (v2)->data : XINT (v2));
  814.           TOP = (f1 == f2 ? Qt : Qnil);
  815.         }
  816.       else
  817. #endif
  818.         TOP = (XINT (v1) == XINT (v2) ? Qt : Qnil);
  819.       break;
  820.  
  821.     case Bgtr:
  822.       v1 = POP;
  823.       TOP = Fgtr (TOP, v1);
  824.       break;
  825.  
  826.     case Blss:
  827.       v1 = POP;
  828.       TOP = Flss (TOP, v1);
  829.       break;
  830.  
  831.     case Bleq:
  832.       v1 = POP;
  833.       TOP = Fleq (TOP, v1);
  834.       break;
  835.  
  836.     case Bgeq:
  837.       v1 = POP;
  838.       TOP = Fgeq (TOP, v1);
  839.       break;
  840.  
  841.     case Bdiff:
  842.       DISCARD (1);
  843.       TOP = Fminus (2, &TOP);
  844.       break;
  845.  
  846.     case Bnegate:
  847.       v1 = TOP;
  848.       if (INTEGERP (v1))
  849.         {
  850.           XSETINT (v1, - XINT (v1));
  851.           TOP = v1;
  852.         }
  853.       else
  854.         TOP = Fminus (1, &TOP);
  855.       break;
  856.  
  857.     case Bplus:
  858.       DISCARD (1);
  859.       TOP = Fplus (2, &TOP);
  860.       break;
  861.  
  862.     case Bmax:
  863.       DISCARD (1);
  864.       TOP = Fmax (2, &TOP);
  865.       break;
  866.  
  867.     case Bmin:
  868.       DISCARD (1);
  869.       TOP = Fmin (2, &TOP);
  870.       break;
  871.  
  872.     case Bmult:
  873.       DISCARD (1);
  874.       TOP = Ftimes (2, &TOP);
  875.       break;
  876.  
  877.     case Bquo:
  878.       DISCARD (1);
  879.       TOP = Fquo (2, &TOP);
  880.       break;
  881.  
  882.     case Brem:
  883.       v1 = POP;
  884.       TOP = Frem (TOP, v1);
  885.       break;
  886.  
  887.     case Bpoint:
  888.       XSETFASTINT (v1, PT);
  889.       PUSH (v1);
  890.       break;
  891.  
  892.     case Bgoto_char:
  893.       TOP = Fgoto_char (TOP);
  894.       break;
  895.  
  896.     case Binsert:
  897.       TOP = Finsert (1, &TOP);
  898.       break;
  899.  
  900.     case BinsertN:
  901.       op = FETCH;
  902.       DISCARD (op - 1);
  903.       TOP = Finsert (op, &TOP);
  904.       break;
  905.  
  906.     case Bpoint_max:
  907.       XSETFASTINT (v1, ZV);
  908.       PUSH (v1);
  909.       break;
  910.  
  911.     case Bpoint_min:
  912.       XSETFASTINT (v1, BEGV);
  913.       PUSH (v1);
  914.       break;
  915.  
  916.     case Bchar_after:
  917.       TOP = Fchar_after (TOP);
  918.       break;
  919.  
  920.     case Bfollowing_char:
  921.       v1 = Ffollowing_char ();
  922.       PUSH (v1);
  923.       break;
  924.  
  925.     case Bpreceding_char:
  926.       v1 = Fprevious_char ();
  927.       PUSH (v1);
  928.       break;
  929.  
  930.     case Bcurrent_column:
  931.       XSETFASTINT (v1, current_column ());
  932.       PUSH (v1);
  933.       break;
  934.  
  935.     case Bindent_to:
  936.       TOP = Findent_to (TOP, Qnil);
  937.       break;
  938.  
  939.     case Beolp:
  940.       PUSH (Feolp ());
  941.       break;
  942.  
  943.     case Beobp:
  944.       PUSH (Feobp ());
  945.       break;
  946.  
  947.     case Bbolp:
  948.       PUSH (Fbolp ());
  949.       break;
  950.  
  951.     case Bbobp:
  952.       PUSH (Fbobp ());
  953.       break;
  954.  
  955.     case Bcurrent_buffer:
  956.       PUSH (Fcurrent_buffer ());
  957.       break;
  958.  
  959.     case Bset_buffer:
  960.       TOP = Fset_buffer (TOP);
  961.       break;
  962.  
  963.     case Binteractive_p:
  964.       PUSH (Finteractive_p ());
  965.       break;
  966.  
  967.     case Bforward_char:
  968.       TOP = Fforward_char (TOP);
  969.       break;
  970.  
  971.     case Bforward_word:
  972.       TOP = Fforward_word (TOP);
  973.       break;
  974.  
  975.     case Bskip_chars_forward:
  976.       v1 = POP;
  977.       TOP = Fskip_chars_forward (TOP, v1);
  978.       break;
  979.  
  980.     case Bskip_chars_backward:
  981.       v1 = POP;
  982.       TOP = Fskip_chars_backward (TOP, v1);
  983.       break;
  984.  
  985.     case Bforward_line:
  986.       TOP = Fforward_line (TOP);
  987.       break;
  988.  
  989.     case Bchar_syntax:
  990.       CHECK_NUMBER (TOP, 0);
  991.       XSETFASTINT (TOP,
  992.                syntax_code_spec[(int) SYNTAX (XINT (TOP))]);
  993.       break;
  994.  
  995.     case Bbuffer_substring:
  996.       v1 = POP;
  997.       TOP = Fbuffer_substring (TOP, v1);
  998.       break;
  999.  
  1000.     case Bdelete_region:
  1001.       v1 = POP;
  1002.       TOP = Fdelete_region (TOP, v1);
  1003.       break;
  1004.  
  1005.     case Bnarrow_to_region:
  1006.       v1 = POP;
  1007.       TOP = Fnarrow_to_region (TOP, v1);
  1008.       break;
  1009.  
  1010.     case Bwiden:
  1011.       PUSH (Fwiden ());
  1012.       break;
  1013.  
  1014.     case Bend_of_line:
  1015.       TOP = Fend_of_line (TOP);
  1016.       break;
  1017.  
  1018.     case Bset_marker:
  1019.       v1 = POP;
  1020.       v2 = POP;
  1021.       TOP = Fset_marker (TOP, v2, v1);
  1022.       break;
  1023.  
  1024.     case Bmatch_beginning:
  1025.       TOP = Fmatch_beginning (TOP);
  1026.       break;
  1027.  
  1028.     case Bmatch_end:
  1029.       TOP = Fmatch_end (TOP);
  1030.       break;
  1031.  
  1032.     case Bupcase:
  1033.       TOP = Fupcase (TOP);
  1034.       break;
  1035.  
  1036.     case Bdowncase:
  1037.       TOP = Fdowncase (TOP);
  1038.     break;
  1039.  
  1040.     case Bstringeqlsign:
  1041.       v1 = POP;
  1042.       TOP = Fstring_equal (TOP, v1);
  1043.       break;
  1044.  
  1045.     case Bstringlss:
  1046.       v1 = POP;
  1047.       TOP = Fstring_lessp (TOP, v1);
  1048.       break;
  1049.  
  1050.     case Bequal:
  1051.       v1 = POP;
  1052.       TOP = Fequal (TOP, v1);
  1053.       break;
  1054.  
  1055.     case Bnthcdr:
  1056.       v1 = POP;
  1057.       TOP = Fnthcdr (TOP, v1);
  1058.       break;
  1059.  
  1060.     case Belt:
  1061.       if (CONSP (TOP))
  1062.         {
  1063.           /* Exchange args and then do nth.  */
  1064.           v2 = POP;
  1065.           v1 = TOP;
  1066.           goto nth_entry;
  1067.         }
  1068.       v1 = POP;
  1069.       TOP = Felt (TOP, v1);
  1070.       break;
  1071.  
  1072.     case Bmember:
  1073.       v1 = POP;
  1074.       TOP = Fmember (TOP, v1);
  1075.       break;
  1076.  
  1077.     case Bassq:
  1078.       v1 = POP;
  1079.       TOP = Fassq (TOP, v1);
  1080.       break;
  1081.  
  1082.     case Bnreverse:
  1083.       TOP = Fnreverse (TOP);
  1084.       break;
  1085.  
  1086.     case Bsetcar:
  1087.       v1 = POP;
  1088.       TOP = Fsetcar (TOP, v1);
  1089.       break;
  1090.  
  1091.     case Bsetcdr:
  1092.       v1 = POP;
  1093.       TOP = Fsetcdr (TOP, v1);
  1094.       break;
  1095.  
  1096.     case Bcar_safe:
  1097.       v1 = TOP;
  1098.       if (CONSP (v1))
  1099.         TOP = XCONS (v1)->car;
  1100.       else
  1101.         TOP = Qnil;
  1102.       break;
  1103.  
  1104.     case Bcdr_safe:
  1105.       v1 = TOP;
  1106.       if (CONSP (v1))
  1107.         TOP = XCONS (v1)->cdr;
  1108.       else
  1109.         TOP = Qnil;
  1110.       break;
  1111.  
  1112.     case Bnconc:
  1113.       DISCARD (1);
  1114.       TOP = Fnconc (2, &TOP);
  1115.       break;
  1116.  
  1117.     case Bnumberp:
  1118.       TOP = (NUMBERP (TOP) ? Qt : Qnil);
  1119.       break;
  1120.  
  1121.     case Bintegerp:
  1122.       TOP = INTEGERP (TOP) ? Qt : Qnil;
  1123.       break;
  1124.  
  1125. #ifdef BYTE_CODE_SAFE
  1126.     case Bset_mark:
  1127.       error ("set-mark is an obsolete bytecode");
  1128.       break;
  1129.     case Bscan_buffer:
  1130.       error ("scan-buffer is an obsolete bytecode");
  1131.       break;
  1132. #endif
  1133.  
  1134.     default:
  1135. #ifdef BYTE_CODE_SAFE
  1136.       if (op < Bconstant)
  1137.         error ("unknown bytecode %d (byte compiler bug)", op);
  1138.       if ((op -= Bconstant) >= const_length)
  1139.         error ("no constant number %d (byte compiler bug)", op);
  1140.       PUSH (vectorp[op]);
  1141. #else
  1142.       PUSH (vectorp[op - Bconstant]);
  1143. #endif
  1144.     }
  1145.     }
  1146.  
  1147.  exit:
  1148.   UNGCPRO;
  1149.   /* Binds and unbinds are supposed to be compiled balanced.  */
  1150.   if (specpdl_ptr - specpdl != count)
  1151. #ifdef BYTE_CODE_SAFE
  1152.     error ("binding stack not balanced (serious byte compiler bug)");
  1153. #else
  1154.     abort ();
  1155. #endif
  1156.   return v1;
  1157. }
  1158.  
  1159. void
  1160. syms_of_bytecode ()
  1161. {
  1162.   Qbytecode = intern ("byte-code");
  1163.   staticpro (&Qbytecode);
  1164.  
  1165.   defsubr (&Sbyte_code);
  1166.  
  1167. #ifdef BYTE_CODE_METER
  1168.  
  1169.   DEFVAR_LISP ("byte-code-meter", &Vbyte_code_meter,
  1170.    "A vector of vectors which holds a histogram of byte-code usage.\n\
  1171. (aref (aref byte-code-meter 0) CODE) indicates how many times the byte\n\
  1172. opcode CODE has been executed.\n\
  1173. (aref (aref byte-code-meter CODE1) CODE2), where CODE1 is not 0,\n\
  1174. indicates how many times the byte opcodes CODE1 and CODE2 have been\n\
  1175. executed in succession.");
  1176.   DEFVAR_BOOL ("byte-metering-on", &byte_metering_on,
  1177.    "If non-nil, keep profiling information on byte code usage.\n\
  1178. The variable byte-code-meter indicates how often each byte opcode is used.\n\
  1179. If a symbol has a property named `byte-code-meter' whose value is an\n\
  1180. integer, it is incremented each time that symbol's function is called.");
  1181.  
  1182.   byte_metering_on = 0;
  1183.   Vbyte_code_meter = Fmake_vector (make_number (256), make_number (0));
  1184.   Qbyte_code_meter = intern ("byte-code-meter");
  1185.   staticpro (&Qbyte_code_meter);
  1186.   {
  1187.     int i = 256;
  1188.     while (i--)
  1189.       XVECTOR (Vbyte_code_meter)->contents[i] =
  1190.     Fmake_vector (make_number (256), make_number (0));
  1191.   }
  1192. #endif
  1193. }
  1194.