aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorJim Blandy <[email protected]>1991-08-16 04:13:50 +0000
committerJim Blandy <[email protected]>1991-08-16 04:13:50 +0000
commit98bf0c8d691fd9ce43f3839780395a61e65d6f8d (patch)
treef238af142c09cf41b6f4115b99b729e4c497e74f
parent55123275af99c850f18e9474872620c31661f986 (diff)
*** empty log message ***
-rw-r--r--lisp/term/x-win.el168
-rw-r--r--src/bytecode.c149
2 files changed, 134 insertions, 183 deletions
diff --git a/lisp/term/x-win.el b/lisp/term/x-win.el
index f9dd7fceb1..58bc29174b 100644
--- a/lisp/term/x-win.el
+++ b/lisp/term/x-win.el
@@ -420,163 +420,21 @@ This returns ARGS with the arguments that have been processed removed."
(and (x-defined-color this-color)
(setq defined-colors (cons this-color defined-colors))))
defined-colors))
-
-;;
-;; Function key processing under X. Function keys are received through
-;; in the input stream as Lisp symbols.
-;;
-
-(defun define-function-key (map sym definition)
- (let ((exist (assq sym (cdr map))))
- (if exist
- (setcdr exist definition)
- (setcdr map
- (cons (cons sym definition)
- (cdr map))))))
-
-;; For unused keysyms. If this happens, it's probably a server or
-;; Xlib bug.
-
-(defun weird-x-keysym ()
- (interactive)
- (error "Bizarre X keysym received."))
-(define-function-key global-function-map 'xk-not-serious 'weird-x-keysym)
-
-;; Keypad type things
-
-(define-function-key global-function-map 'xk-home 'beginning-of-line)
-(define-function-key global-function-map 'xk-left 'backward-char)
-(define-function-key global-function-map 'xk-up 'previous-line)
-(define-function-key global-function-map 'xk-right 'forward-char)
-(define-function-key global-function-map 'xk-down 'next-line)
-(define-function-key global-function-map 'xk-prior 'previous-line)
-(define-function-key global-function-map 'xk-next 'next-line)
-(define-function-key global-function-map 'xk-end 'end-of-line)
-(define-function-key global-function-map 'xk-begin 'beginning-of-line)
-
- ;; IsMiscFunctionKey
-
-(define-function-key global-function-map 'xk-select nil)
-(define-function-key global-function-map 'xk-print nil)
-(define-function-key global-function-map 'xk-execute nil)
-(define-function-key global-function-map 'xk-insert nil)
-(define-function-key global-function-map 'xk-undo nil)
-(define-function-key global-function-map 'xk-redo nil)
-(define-function-key global-function-map 'xk-menu nil)
-(define-function-key global-function-map 'xk-find nil)
-(define-function-key global-function-map 'xk-cancel nil)
-(define-function-key global-function-map 'xk-help nil)
-(define-function-key global-function-map 'xk-break nil)
-
- ;; IsKeypadKey
-
-(define-function-key global-function-map 'xk-kp-space
- '(lambda nil (interactive)
- (insert " ")))
-(define-function-key global-function-map 'xk-kp-tab
- '(lambda nil (interactive)
- (insert "\t")))
-(define-function-key global-function-map 'xk-kp-enter
- '(lambda nil (interactive)
- (insert "\n")))
-
-(define-function-key global-function-map 'xk-kp-f1 nil)
-(define-function-key global-function-map 'xk-kp-f2 nil)
-(define-function-key global-function-map 'xk-kp-f3 nil)
-(define-function-key global-function-map 'xk-kp-f4 nil)
-
-(define-function-key global-function-map 'xk-kp-equal
- '(lambda nil (interactive)
- (insert "=")))
-(define-function-key global-function-map 'xk-kp-multiply
- '(lambda nil (interactive)
- (insert "*")))
-(define-function-key global-function-map 'xk-kp-add
- '(lambda nil (interactive)
- (insert "+")))
-(define-function-key global-function-map 'xk-kp-separator
- '(lambda nil (interactive)
- (insert ";")))
-(define-function-key global-function-map 'xk-kp-subtract
- '(lambda nil (interactive)
- (insert "-")))
-(define-function-key global-function-map 'xk-kp-decimal
- '(lambda nil (interactive)
- (insert ".")))
-(define-function-key global-function-map 'xk-kp-divide
- '(lambda nil (interactive)
- (insert "/")))
-
-(define-function-key global-function-map 'xk-kp-0
- '(lambda nil (interactive)
- (insert "0")))
-(define-function-key global-function-map 'xk-kp-1
- '(lambda nil (interactive)
- (insert "1")))
-(define-function-key global-function-map 'xk-kp-2
- '(lambda nil (interactive)
- (insert "2")))
-(define-function-key global-function-map 'xk-kp-3
- '(lambda nil (interactive)
- (insert "3")))
-(define-function-key global-function-map 'xk-kp-4
- '(lambda nil (interactive)
- (insert "4")))
-(define-function-key global-function-map 'xk-kp-5
- '(lambda nil (interactive)
- (insert "5")))
-(define-function-key global-function-map 'xk-kp-6
- '(lambda nil (interactive)
- (insert "6")))
-(define-function-key global-function-map 'xk-kp-7
- '(lambda nil (interactive)
- (insert "7")))
-(define-function-key global-function-map 'xk-kp-8
- '(lambda nil (interactive)
- (insert "8")))
-(define-function-key global-function-map 'xk-kp-9
- '(lambda nil (interactive)
- (insert "9")))
-
- ;; IsFunctionKey
-
-(define-function-key global-function-map 'xk-f1 'rmail)
-(define-function-key global-function-map 'xk-f2 nil)
-(define-function-key global-function-map 'xk-f3 nil)
-(define-function-key global-function-map 'xk-f4 nil)
-(define-function-key global-function-map 'xk-f5 nil)
-(define-function-key global-function-map 'xk-f6 nil)
-(define-function-key global-function-map 'xk-f7 nil)
-(define-function-key global-function-map 'xk-f8 nil)
-(define-function-key global-function-map 'xk-f9 nil)
-(define-function-key global-function-map 'xk-f10 nil)
-(define-function-key global-function-map 'xk-f11 nil)
-(define-function-key global-function-map 'xk-f12 nil)
-(define-function-key global-function-map 'xk-f13 nil)
-(define-function-key global-function-map 'xk-f14 nil)
-(define-function-key global-function-map 'xk-f15 nil)
-(define-function-key global-function-map 'xk-f16 nil)
-(define-function-key global-function-map 'xk-f17 nil)
-(define-function-key global-function-map 'xk-f18 nil)
-(define-function-key global-function-map 'xk-f19 nil)
-(define-function-key global-function-map 'xk-f20 nil)
-(define-function-key global-function-map 'xk-f21 nil)
-(define-function-key global-function-map 'xk-f22 nil)
-(define-function-key global-function-map 'xk-f23 nil)
-(define-function-key global-function-map 'xk-f24 nil)
-(define-function-key global-function-map 'xk-f25 nil)
-(define-function-key global-function-map 'xk-f26 nil)
-(define-function-key global-function-map 'xk-f27 nil)
-(define-function-key global-function-map 'xk-f28 nil)
-(define-function-key global-function-map 'xk-f29 nil)
-(define-function-key global-function-map 'xk-f30 nil)
-(define-function-key global-function-map 'xk-f31 nil)
-(define-function-key global-function-map 'xk-f32 nil)
-(define-function-key global-function-map 'xk-f33 nil)
-(define-function-key global-function-map 'xk-f34 nil)
-(define-function-key global-function-map 'xk-f35 nil)
+;;;; Function keys
+
+;;; Give some common function keys reasonable definitions.
+(define-key global-map [home] 'beginning-of-line)
+(define-key global-map [left] 'backward-char)
+(define-key global-map [up] 'previous-line)
+(define-key global-map [right] 'forward-char)
+(define-key global-map [down] 'next-line)
+(define-key global-map [prior] 'scroll-down)
+(define-key global-map [next] 'scroll-up)
+(define-key global-map [begin] 'beginning-of-buffer)
+(define-key global-map [end] 'end-of-buffer)
+
;;; Do the actual X Windows setup here; the above code just defines
;;; functions and variables that we use now.
diff --git a/src/bytecode.c b/src/bytecode.c
index f888a68b7f..249cb119fc 100644
--- a/src/bytecode.c
+++ b/src/bytecode.c
@@ -17,7 +17,7 @@ You should have received a copy of the GNU General Public License
along with GNU Emacs; see the file COPYING. If not, write to
the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
-hacked on by jwz 17-jun-91
+hacked on by [email protected] 17-jun-91
o added a compile-time switch to turn on simple sanity checking;
o put back the obsolete byte-codes for error-detection;
o put back fset, symbol-function, and read-char because I don't
@@ -30,7 +30,7 @@ hacked on by jwz 17-jun-91
o added metering support.
by Hallvard:
- o added relative jump instructions;
+ o added relative jump instructions.
o all conditionals now only do QUIT if they jump.
*/
@@ -40,19 +40,19 @@ by Hallvard:
#include "buffer.h"
#include "syntax.h"
-/* Define this to enable some minor sanity checking
- (useful for debugging the byte compiler...)
+/*
+ * define BYTE_CODE_SAFE to enable some minor sanity checking (useful for
+ * debugging the byte compiler...)
+ *
+ * define BYTE_CODE_METER to enable generation of a byte-op usage histogram.
*/
#define BYTE_CODE_SAFE
-
-/* Define this to enable generation of a histogram of byte-op usage.
- */
#define BYTE_CODE_METER
#ifdef BYTE_CODE_METER
-Lisp_Object Vbyte_code_meter;
+Lisp_Object Vbyte_code_meter, Qbyte_code_meter;
int byte_metering_on;
# define METER_2(code1,code2) \
@@ -107,9 +107,9 @@ Lisp_Object Qbytecode;
#define Baref 0110
#define Baset 0111
#define Bsymbol_value 0112
-#define Bsymbol_function 0113 /* no longer generated as of v19 */
+#define Bsymbol_function 0113
#define Bset 0114
-#define Bfset 0115 /* no longer generated as of v19 */
+#define Bfset 0115
#define Bget 0116
#define Bsubstring 0117
#define Bconcat2 0120
@@ -147,7 +147,7 @@ Lisp_Object Qbytecode;
#define Bbobp 0157
#define Bcurrent_buffer 0160
#define Bset_buffer 0161
-#define Bread_char 0162
+#define Bread_char 0162 /* No longer generated as of v19 */
#define Bset_mark 0163 /* this loser is no longer generated as of v18 */
#define Binteractive_p 0164 /* Needed since interactive-p takes unevalled args */
@@ -161,6 +161,7 @@ Lisp_Object Qbytecode;
#define Bdelete_region 0174
#define Bnarrow_to_region 0175
#define Bwiden 0176
+#define Bend_of_line 0177
#define Bconstant2 0201
#define Bgoto 0202
@@ -184,6 +185,12 @@ Lisp_Object Qbytecode;
#define Bunbind_all 0222
+#define Bset_marker 0223
+#define Bmatch_beginning 0224
+#define Bmatch_end 0225
+#define Bupcase 0226
+#define Bdowncase 0227
+
#define Bstringeqlsign 0230
#define Bstringlss 0231
#define Bequal 0232
@@ -202,6 +209,15 @@ Lisp_Object Qbytecode;
#define Bnumberp 0247
#define Bintegerp 0250
+#define BRgoto 0252
+#define BRgotoifnil 0253
+#define BRgotoifnonnil 0254
+#define BRgotoifnilelsepop 0255
+#define BRgotoifnonnilelsepop 0256
+
+#define BlistN 0257
+#define BconcatN 0260
+
#define Bconstant 0300
#define CONSTANTLIM 0100
@@ -391,6 +407,18 @@ If the third argument is incorrect, Emacs may crash.")
op -= Bcall;
docall:
DISCARD(op);
+#ifdef BYTE_CODE_METER
+ if (byte_metering_on && XTYPE (TOP) == Lisp_Symbol)
+ {
+ v1 = TOP;
+ v2 = Fget (v1, Qbyte_code_meter);
+ if (XTYPE (v2) == Lisp_Int)
+ {
+ XSETINT (v2, XINT (v2) + 1);
+ Fput (v1, Qbyte_code_meter, v2);
+ }
+ }
+#endif
TOP = Ffuncall (op + 1, &TOP);
break;
@@ -460,6 +488,49 @@ If the third argument is incorrect, Emacs may crash.")
else DISCARD(1);
break;
+ case BRgoto:
+ QUIT;
+ pc += *pc - 127;
+ break;
+
+ case BRgotoifnil:
+ if (NULL (POP))
+ {
+ QUIT;
+ pc += *pc - 128;
+ }
+ pc++;
+ break;
+
+ case BRgotoifnonnil:
+ if (!NULL (POP))
+ {
+ QUIT;
+ pc += *pc - 128;
+ }
+ pc++;
+ break;
+
+ case BRgotoifnilelsepop:
+ op = *pc++;
+ if (NULL (TOP))
+ {
+ QUIT;
+ pc += op - 128;
+ }
+ else DISCARD(1);
+ break;
+
+ case BRgotoifnonnilelsepop:
+ op = *pc++;
+ if (!NULL (TOP))
+ {
+ QUIT;
+ pc += op - 128;
+ }
+ else DISCARD(1);
+ break;
+
case Breturn:
v1 = POP;
goto exit;
@@ -609,6 +680,12 @@ If the third argument is incorrect, Emacs may crash.")
TOP = Flist (4, &TOP);
break;
+ case BlistN:
+ op = FETCH;
+ DISCARD (op - 1);
+ TOP = Flist (op, &TOP);
+ break;
+
case Blength:
TOP = Flength (TOP);
break;
@@ -666,6 +743,12 @@ If the third argument is incorrect, Emacs may crash.")
TOP = Fconcat (4, &TOP);
break;
+ case BconcatN:
+ op = FETCH;
+ DISCARD (op - 1);
+ TOP = Fconcat (op, &TOP);
+ break;
+
case Bsub1:
v1 = TOP;
if (XTYPE (v1) == Lisp_Int)
@@ -758,7 +841,6 @@ If the third argument is incorrect, Emacs may crash.")
case Brem:
v1 = POP;
- /* This had args in the wrong order. -- jwz */
TOP = Frem (TOP, v1);
break;
@@ -842,29 +924,24 @@ If the third argument is incorrect, Emacs may crash.")
break;
case Bforward_char:
- /* This was wrong! --jwz */
TOP = Fforward_char (TOP);
break;
case Bforward_word:
- /* This was wrong! --jwz */
TOP = Fforward_word (TOP);
break;
case Bskip_chars_forward:
- /* This was wrong! --jwz */
v1 = POP;
TOP = Fskip_chars_forward (TOP, v1);
break;
case Bskip_chars_backward:
- /* This was wrong! --jwz */
v1 = POP;
TOP = Fskip_chars_backward (TOP, v1);
break;
case Bforward_line:
- /* This was wrong! --jwz */
TOP = Fforward_line (TOP);
break;
@@ -880,13 +957,11 @@ If the third argument is incorrect, Emacs may crash.")
case Bdelete_region:
v1 = POP;
- /* This had args in the wrong order. -- jwz */
TOP = Fdelete_region (TOP, v1);
break;
case Bnarrow_to_region:
v1 = POP;
- /* This had args in the wrong order. -- jwz */
TOP = Fnarrow_to_region (TOP, v1);
break;
@@ -894,27 +969,49 @@ If the third argument is incorrect, Emacs may crash.")
PUSH (Fwiden ());
break;
+ case Bend_of_line:
+ TOP = Fend_of_line (TOP);
+ break;
+
+ case Bset_marker:
+ v1 = POP;
+ v2 = POP;
+ TOP = Fset_marker (TOP, v2, v1);
+ break;
+
+ case Bmatch_beginning:
+ TOP = Fmatch_beginning (TOP);
+ break;
+
+ case Bmatch_end:
+ TOP = Fmatch_end (TOP);
+ break;
+
+ case Bupcase:
+ TOP = Fupcase (TOP);
+ break;
+
+ case Bdowncase:
+ TOP = Fdowncase (TOP);
+ break;
+
case Bstringeqlsign:
v1 = POP;
- /* This had args in the wrong order. -- jwz */
TOP = Fstring_equal (TOP, v1);
break;
case Bstringlss:
v1 = POP;
- /* This had args in the wrong order. -- jwz */
TOP = Fstring_lessp (TOP, v1);
break;
case Bequal:
v1 = POP;
- /* This had args in the wrong order. -- jwz */
TOP = Fequal (TOP, v1);
break;
case Bnthcdr:
v1 = POP;
- /* This had args in the wrong order. -- jwz */
TOP = Fnthcdr (TOP, v1);
break;
@@ -932,13 +1029,11 @@ If the third argument is incorrect, Emacs may crash.")
case Bmember:
v1 = POP;
- /* This had args in the wrong order. -- jwz */
TOP = Fmember (TOP, v1);
break;
case Bassq:
v1 = POP;
- /* This had args in the wrong order. -- jwz */
TOP = Fassq (TOP, v1);
break;
@@ -948,13 +1043,11 @@ If the third argument is incorrect, Emacs may crash.")
case Bsetcar:
v1 = POP;
- /* This had args in the wrong order. -- jwz */
TOP = Fsetcar (TOP, v1);
break;
case Bsetcdr:
v1 = POP;
- /* This had args in the wrong order. -- jwz */
TOP = Fsetcdr (TOP, v1);
break;
@@ -1040,7 +1133,7 @@ syms_of_bytecode ()
byte_metering_on = 0;
Vbyte_code_meter = Fmake_vector(make_number(256), make_number(0));
-
+ staticpro (&Qbyte_code_meter);
{
int i = 256;
while (i--)