Commit 98bf0c8d authored by Jim Blandy's avatar Jim Blandy
Browse files

*** empty log message ***

parent 55123275
......@@ -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.
......
......@@ -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 jwz@lucid.com 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--)
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment