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