commit: Move #'split-path to subr.el, as was always the intention.
12 years, 11 months
Aidan Kehoe
Aidan Kehoe
changeset: 5504:d3e0482c7899
tag: tip
user: Aidan Kehoe <kehoea(a)parhasard.net>
date: Sat May 07 16:57:17 2011 +0100
files: lisp/ChangeLog lisp/subr.el src/ChangeLog src/fns.c
description:
Move #'split-path to subr.el, as was always the intention.
src/ChangeLog addition:
2011-05-07 Aidan Kehoe <kehoea(a)parhasard.net>
* fns.c (Fsplit_path): Removed.
* fns.c (syms_of_fns):
Move #'split-path to subr.el, as was always the intention.
lisp/ChangeLog addition:
2011-05-07 Aidan Kehoe <kehoea(a)parhasard.net>
* subr.el:
* subr.el (split-path): New.
Moved here from fns.c. There's no need to have this in C, it's no
longer used that early at startup.
diff -r 7b5946dbfb96 -r d3e0482c7899 lisp/ChangeLog
--- a/lisp/ChangeLog Sat May 07 12:26:39 2011 +0100
+++ b/lisp/ChangeLog Sat May 07 16:57:17 2011 +0100
＠＠ -1,3 +1,10 ＠＠
+2011-05-07 Aidan Kehoe <kehoea(a)parhasard.net>
+
+ * subr.el:
+ * subr.el (split-path): New.
+ Moved here from fns.c. There's no need to have this in C, it's no
+ longer used that early at startup.
+
2011-05-07 Aidan Kehoe <kehoea(a)parhasard.net>
* bytecomp.el:
diff -r 7b5946dbfb96 -r d3e0482c7899 lisp/subr.el
--- a/lisp/subr.el Sat May 07 12:26:39 2011 +0100
+++ b/lisp/subr.el Sat May 07 16:57:17 2011 +0100
＠＠ -505,18 +505,20 ＠＠
;; BEGIN SYNCHED WITH FSF 21.2
-;; #### #### #### AAaargh! Must be in C, because it is used insanely
-;; early in the bootstrap process.
-;(defun split-path (path)
+(defun split-path (path)
+ "Explode a search path into a list of strings.
+The path components are separated with the characters specified
+with `path-separator'."
+ (while (or (not (stringp path-separator))
+ (/= (length path-separator) 1))
+ (setq path-separator (signal 'error (list "\
+`path-separator' should be set to a single-character string"
+ path-separator))))
+ (split-string-by-char path (aref path-separator 0)))
+
; "Explode a search path into a list of strings.
;The path components are separated with the characters specified
;with `path-separator'."
-; (while (or (not stringp path-separator)
-; (/= (length path-separator) 1))
-; (setq path-separator (signal 'error (list "\
-;`path-separator' should be set to a single-character string"
-; path-separator))))
-; (split-string-by-char path (aref separator 0)))
(defmacro with-current-buffer (buffer &rest body)
"Temporarily make BUFFER the current buffer and execute the forms in BODY.
diff -r 7b5946dbfb96 -r d3e0482c7899 src/ChangeLog
--- a/src/ChangeLog Sat May 07 12:26:39 2011 +0100
+++ b/src/ChangeLog Sat May 07 16:57:17 2011 +0100
＠＠ -1,3 +1,9 ＠＠
+2011-05-07 Aidan Kehoe <kehoea(a)parhasard.net>
+
+ * fns.c (Fsplit_path): Removed.
+ * fns.c (syms_of_fns):
+ Move #'split-path to subr.el, as was always the intention.
+
2011-05-03 Stephen J. Turnbull <stephen(a)xemacs.org>
* dumper.c (pdump_file_try): Remove static qualifier.
diff -r 7b5946dbfb96 -r d3e0482c7899 src/fns.c
--- a/src/fns.c Sat May 07 12:26:39 2011 +0100
+++ b/src/fns.c Sat May 07 16:57:17 2011 +0100
＠＠ -2260,8 +2260,9 ＠＠
return split_string_by_ichar_1 (path, qxestrlen (path), SEPCHAR, 0, 0);
}
-/* Ben thinks this function should not exist or be exported to Lisp.
- We use it to define split-path-string in subr.el (not!). */
+/* Ben thinks [or thought in 1998] this function should not exist or be
+ exported to Lisp. It's used to define #'split-path in subr.el, and for
+ parsing Carbon font names under that window system. */
DEFUN ("split-string-by-char", Fsplit_string_by_char, 2, 3, 0, /*
Split STRING into a list of substrings originally separated by SEPCHAR.
＠＠ -2286,31 +2287,6 ＠＠
XCHAR (sepchar),
!NILP (escape_char), escape_ichar);
}
-
-/* #### This was supposed to be in subr.el, but is used VERY early in
- the bootstrap process, so it goes here. Damn. */
-
-DEFUN ("split-path", Fsplit_path, 1, 1, 0, /*
-Explode a search path into a list of strings.
-The path components are separated with the characters specified
-with `path-separator'.
-*/
- (path))
-{
- CHECK_STRING (path);
-
- while (!STRINGP (Vpath_separator)
- || (string_char_length (Vpath_separator) != 1))
- Vpath_separator = signal_continuable_error
- (Qinvalid_state,
- "`path-separator' should be set to a single-character string",
- Vpath_separator);
-
- return (split_string_by_ichar_1
- (XSTRING_DATA (path), XSTRING_LENGTH (path),
- itext_ichar (XSTRING_DATA (Vpath_separator)), 0, 0));
-}
-
DEFUN ("nthcdr", Fnthcdr, 2, 2, 0, /*
Take cdr N times on LIST, and return the result.
＠＠ -11955,7 +11931,6 ＠＠
DEFSUBR (Fsubstring_no_properties);
DEFSUBR (Fsplit_string_by_char);
- DEFSUBR (Fsplit_path); /* #### */
}
void
_______________________________________________
XEmacs-Patches mailing list
XEmacs-Patches(a)xemacs.org
http://lists.xemacs.org/mailman/listinfo/xemacs-patches
- 1 participants
- 0 comments
[COMMIT] Drop support for generating code appropriate for Emacs 19, bytecomp.el
12 years, 11 months
Aidan Kehoe
Aidan Kehoe
APPROVE COMMIT
NOTE: This patch has been committed.
# HG changeset patch
# User Aidan Kehoe <kehoea(a)parhasard.net>
# Date 1304767599 -3600
# Node ID 7b5946dbfb9695dfed9ab288d7bd4f6150591ac5
# Parent 5b08be74bb532a6dbdf03caf5f48ca3640e2cae0
Drop support for generating code appropriate for Emacs 19, bytecomp.el
lisp/ChangeLog addition:
2011-05-07 Aidan Kehoe <kehoea(a)parhasard.net>
* bytecomp.el:
* bytecomp.el (byte-compile-two-args-19->20): Removed.
* bytecomp.el (byte-compile-emacs19-compatibility): Removed.
* bytecomp.el (byte-defop-compiler20): Removed.
* bytecomp.el (byte-defop-compiler-rmsfun): Removed.
* bytecomp.el (emacs-lisp-file-regexp):
* bytecomp.el (byte-compile-print-gensym):
* bytecomp.el (byte-compiler-legal-options):
* bytecomp.el (byte-compiler-obsolete-options):
* bytecomp.el (byte-compile-close-variables):
* bytecomp.el (byte-compile-insert-header):
* bytecomp.el (byte-compile-output-file-form):
* bytecomp.el (byte-compile-output-docform):
* bytecomp.el (byte-compile-out-toplevel):
* bytecomp.el (byte-compile-form):
* bytecomp.el (byte-defop-compiler-1):
* bytecomp.el (eq):
* bytecomp.el (equal):
* bytecomp.el (member):
* bytecomp.el (byte-compile-noop):
* bytecomp.el (byte-compile-save-current-buffer):
Remove support for generating code appropriate to Emacs 19.
* bytecomp.el (byte-compile-eval):
Avoid erroring here if the car of some entry in the macro
environment is not a symbol, as is the case for symbol macros.
* bytecomp.el (or):
Use slightly better style when compiling the most important
functions if bytecomp.el has just been loaded interpreted.
diff -r 5b08be74bb53 -r 7b5946dbfb96 lisp/ChangeLog
--- a/lisp/ChangeLog Sat May 07 11:45:20 2011 +0100
+++ b/lisp/ChangeLog Sat May 07 12:26:39 2011 +0100
＠＠ -1,3 +1,35 ＠＠
+2011-05-07 Aidan Kehoe <kehoea(a)parhasard.net>
+
+ * bytecomp.el:
+ * bytecomp.el (byte-compile-two-args-19->20): Removed.
+ * bytecomp.el (byte-compile-emacs19-compatibility): Removed.
+ * bytecomp.el (byte-defop-compiler20): Removed.
+ * bytecomp.el (byte-defop-compiler-rmsfun): Removed.
+ * bytecomp.el (emacs-lisp-file-regexp):
+ * bytecomp.el (byte-compile-print-gensym):
+ * bytecomp.el (byte-compiler-legal-options):
+ * bytecomp.el (byte-compiler-obsolete-options):
+ * bytecomp.el (byte-compile-close-variables):
+ * bytecomp.el (byte-compile-insert-header):
+ * bytecomp.el (byte-compile-output-file-form):
+ * bytecomp.el (byte-compile-output-docform):
+ * bytecomp.el (byte-compile-out-toplevel):
+ * bytecomp.el (byte-compile-form):
+ * bytecomp.el (byte-defop-compiler-1):
+ * bytecomp.el (eq):
+ * bytecomp.el (equal):
+ * bytecomp.el (member):
+ * bytecomp.el (byte-compile-noop):
+ * bytecomp.el (byte-compile-save-current-buffer):
+ Remove support for generating code appropriate to Emacs 19.
+
+ * bytecomp.el (byte-compile-eval):
+ Avoid erroring here if the car of some entry in the macro
+ environment is not a symbol, as is the case for symbol macros.
+ * bytecomp.el (or):
+ Use slightly better style when compiling the most important
+ functions if bytecomp.el has just been loaded interpreted.
+
2011-05-07 Aidan Kehoe <kehoea(a)parhasard.net>
* byte-optimize.el:
diff -r 5b08be74bb53 -r 7b5946dbfb96 lisp/bytecomp.el
--- a/lisp/bytecomp.el Sat May 07 11:45:20 2011 +0100
+++ b/lisp/bytecomp.el Sat May 07 12:26:39 2011 +0100
＠＠ -121,9 +121,6 ＠＠
;;; as data, not as a function,
;;; and using it in a function
;;; context )
-;;; byte-compile-emacs19-compatibility Whether the compiler should
-;;; generate .elc files which can be loaded into
-;;; generic emacs 19.
;;; emacs-lisp-file-regexp Regexp for the extension of source-files;
;;; see also the function `byte-compile-dest-file'.
;;; byte-compile-overwrite-file If nil, delete old .elc files before saving.
＠＠ -218,21 +215,6 ＠＠
;; This really ought to be loaded already!
(load-library "bytecomp-runtime"))
-(eval-when-compile
- (defvar byte-compile-single-version t
- "If this is true, the choice of emacs version (v19 or v20) byte-codes will
-be hard-coded into bytecomp when it compiles itself. If the compiler itself
-is compiled with optimization, this causes a speedup.")
-
- (cond
- (byte-compile-single-version
- (defmacro byte-compile-single-version () t)
- (defmacro byte-compile-version-cond (cond) (list 'quote (eval cond))))
- (t
- (defmacro byte-compile-single-version () nil)
- (defmacro byte-compile-version-cond (cond) cond)))
- )
-
(defvar emacs-lisp-file-regexp "\\.el$"
"*Regexp which matches Emacs Lisp source files.
You may want to redefine `byte-compile-dest-file' if you change this.")
＠＠ -277,20 +259,13 ＠＠
(and (not noninteractive) (> (device-baud-rate) search-slow-speed))
"*Non-nil means print messages describing progress of byte-compiler.")
-(defvar byte-compile-emacs19-compatibility
- (not (emacs-version>= 20))
- "*Non-nil means generate output that can run in Emacs 19.")
-
(defvar byte-compile-print-gensym t
"*Non-nil means generate code that creates unique symbols at run-time.
This is achieved by printing uninterned symbols using the `#:SYMBOL'
notation, so that they will be read uninterned when run.
With this feature, code that uses uninterned symbols in macros will
-not be runnable under pre-21.0 XEmacsen.
-
-When `byte-compile-emacs19-compatibility' is non-nil, this variable is
-ignored and considered to be nil.")
+not be runnable under pre-21.0 XEmacsen.")
(defvar byte-optimize t
"*Enables optimization in the byte compiler.
＠＠ -482,11 +457,15 ＠＠
(defun byte-compile-eval (form)
(let ((save-macro-environment nil))
(unwind-protect
- (loop for (sym . def) in byte-compile-macro-environment do
- (push
- (if (fboundp sym) (cons sym (symbol-function sym)) sym)
- save-macro-environment)
- (fset sym (cons 'macro def))
+ (loop
+ for (sym . def) in byte-compile-macro-environment
+ do (when (symbolp sym)
+ (push
+ (if (fboundp sym)
+ (cons sym (symbol-function sym))
+ sym)
+ save-macro-environment)
+ (fset sym (cons 'macro def)))
finally return (eval form))
(dolist (elt save-macro-environment)
(if (symbolp elt)
＠＠ -1093,7 +1072,7 ＠＠
(defconst byte-compiler-legal-options
'((optimize byte-optimize (t nil source byte) val)
- (file-format byte-compile-emacs19-compatibility (emacs19 emacs20)
+ (file-format byte-compile-emacs19-compatibility (emacs20)
(eq val 'emacs19))
(delete-errors byte-compile-delete-errors (t nil) val)
(verbose byte-compile-verbose (t nil) val)
＠＠ -1105,19 +1084,7 ＠＠
;; XEmacs addition
(defconst byte-compiler-obsolete-options
- '((new-bytecodes t)))
-
-;; Inhibit v19/v20 selectors if the version is hardcoded.
-;; #### This should print a warning if the user tries to change something
-;; than can't be changed because the running compiler doesn't support it.
-(cond
- ((byte-compile-single-version)
- (setcar (cdr (cdr (assq 'file-format byte-compiler-legal-options)))
- (if (byte-compile-version-cond byte-compile-emacs19-compatibility)
- '(emacs19) '(emacs20)))))
-
-;; now we can copy it.
-(setq byte-compiler-legal-options byte-compiler-legal-options)
+ '((new-bytecodes t) (byte-compile-emacs19-compatibility nil)))
(defun byte-compiler-options-handler (&rest args)
(let (key val desc choices)
＠＠ -1422,8 +1389,6 ＠＠
;;
(byte-compile-verbose byte-compile-verbose)
(byte-optimize byte-optimize)
- (byte-compile-emacs19-compatibility
- byte-compile-emacs19-compatibility)
(byte-compile-checks-on-load
byte-compile-checks-on-load)
(byte-compile-dynamic byte-compile-dynamic)
＠＠ -1860,7 +1825,7 ＠＠
;;
(insert
";ELC"
- (if (byte-compile-version-cond byte-compile-emacs19-compatibility) 19 20)
+ 20
"\000\000\000\n")
(when (not (eq (find-coding-system 'raw-text-unix)
(find-coding-system buffer-file-coding-system)))
＠＠ -1974,9 +1939,7 ＠＠
(print-length nil)
(print-level nil)
(print-readably t) ; print #[] for bytecode, 'x for (quote x)
- (print-gensym (if (and byte-compile-print-gensym
- (not byte-compile-emacs19-compatibility))
- '(t) nil))
+ (print-gensym (if byte-compile-print-gensym '(t) nil))
print-gensym-alist)
(when byte-compile-output-preface
(princ "\n(progn " byte-compile-outbuffer)
＠＠ -2026,9 +1989,7 ＠＠
;; Use a cons cell to say that we want
;; print-gensym-alist not to be cleared between calls
;; to print functions.
- (print-gensym (if (and byte-compile-print-gensym
- (not byte-compile-emacs19-compatibility))
- '(t) nil))
+ (print-gensym (if byte-compile-print-gensym '(t) nil))
print-gensym-alist
(index 0))
(when byte-compile-output-preface
＠＠ -2763,15 +2724,7 ＠＠
((and maycall
;; Allow a funcall if at most one atom follows it.
(null (nthcdr 3 rest))
- (setq tmp
- ;; XEmacs change for rms funs
- (or (and
- (byte-compile-version-cond
- byte-compile-emacs19-compatibility)
- (get (car (car rest))
- 'byte-opcode19-invert))
- (get (car (car rest))
- 'byte-opcode-invert)))
+ (setq tmp (get (car (car rest)) 'byte-opcode-invert))
(or (null (cdr rest))
(and (memq output-type '(file progn t))
(cdr (cdr rest))
＠＠ -2828,10 +2781,7 ＠＠
(handler (get fn 'byte-compile)))
(if (memq fn '(t nil))
(byte-compile-warn "%s called as a function" fn))
- (if (and handler
- (or (not (byte-compile-version-cond
- byte-compile-emacs19-compatibility))
- (not (get (get fn 'byte-opcode) 'emacs20-opcode))))
+ (if handler
(funcall handler form)
(if (memq 'callargs byte-compile-warnings)
(byte-compile-callargs-warn form))
＠＠ -3057,49 +3007,6 ＠＠
''byte-opcode-invert (list 'quote function)))
fnform))))
-(defmacro byte-defop-compiler20 (function &optional compile-handler)
- ;; Just like byte-defop-compiler, but defines an opcode that will only
- ;; be used when byte-compile-emacs19-compatibility is false.
- (if (and (byte-compile-single-version)
- byte-compile-emacs19-compatibility)
- ;; #### instead of doing nothing, this should do some remprops,
- ;; #### to protect against the case where a single-version compiler
- ;; #### is loaded into a world that has contained a multi-version one.
- nil
- (list 'progn
- (list 'put
- (list 'quote
- (or (car (cdr-safe function))
- (intern (concat "byte-"
- (symbol-name (or (car-safe function) function))))))
- ''emacs20-opcode t)
- (list 'byte-defop-compiler function compile-handler))))
-
-;; XEmacs addition:
-(defmacro byte-defop-compiler-rmsfun (function &optional compile-handler)
- ;; for functions like `eq' that compile into different opcodes depending
- ;; on the Emacs version: byte-old-eq for v19, byte-eq for v20.
- (let ((opcode (intern (concat "byte-" (symbol-name function))))
- (opcode19 (intern (concat "byte-old-" (symbol-name function))))
- (fnform
- (list 'put (list 'quote function) ''byte-compile
- (list 'quote
- (or (cdr (assq compile-handler
- '((2 . byte-compile-two-args-19->20)
- )))
- compile-handler
- (intern (concat "byte-compile-"
- (symbol-name function))))))))
- (list 'progn fnform
- (list 'put (list 'quote function)
- ''byte-opcode (list 'quote opcode))
- (list 'put (list 'quote function)
- ''byte-opcode19 (list 'quote opcode19))
- (list 'put (list 'quote opcode)
- ''byte-opcode-invert (list 'quote function))
- (list 'put (list 'quote opcode19)
- ''byte-opcode19-invert (list 'quote function)))))
-
(defmacro byte-defop-compiler-1 (function &optional compile-handler)
(list 'byte-defop-compiler (list function nil) compile-handler))
＠＠ -3121,7 +3028,7 ＠＠
;(byte-defop-compiler (dot-max byte-point-max) 0+1)
;(byte-defop-compiler (dot-min byte-point-min) 0+1)
(byte-defop-compiler point 0+1)
-(byte-defop-compiler-rmsfun eq 2)
+(byte-defop-compiler eq 2)
(byte-defop-compiler point-max 0+1)
(byte-defop-compiler point-min 0+1)
(byte-defop-compiler following-char 0+1)
＠＠ -3130,14 +3037,14 ＠＠
;; FSF has special function here; generalized here by the 1+2 stuff.
(byte-defop-compiler (indent-to-column byte-indent-to) 1+2)
(byte-defop-compiler indent-to 1+2)
-(byte-defop-compiler-rmsfun equal 2)
+(byte-defop-compiler equal 2)
(byte-defop-compiler eolp 0+1)
(byte-defop-compiler eobp 0+1)
(byte-defop-compiler bolp 0+1)
(byte-defop-compiler bobp 0+1)
(byte-defop-compiler current-buffer 0)
;;(byte-defop-compiler read-char 0) ;; obsolete
-(byte-defop-compiler-rmsfun memq 2)
+(byte-defop-compiler memq 2)
(byte-defop-compiler interactive-p 0)
(byte-defop-compiler widen 0+1)
(byte-defop-compiler end-of-line 0-1+1)
＠＠ -3170,8 +3077,8 ＠＠
(byte-defop-compiler skip-chars-forward 1-2+1)
(byte-defop-compiler skip-chars-backward 1-2+1)
(byte-defop-compiler eq 2)
-; (byte-defop-compiler20 old-eq 2)
-; (byte-defop-compiler20 old-memq 2)
+; (byte-defop-compiler old-eq 2)
+; (byte-defop-compiler old-memq 2)
(byte-defop-compiler cons 2)
(byte-defop-compiler aref 2)
(byte-defop-compiler get 2+1)
＠＠ -3188,11 +3095,11 ＠＠
(byte-defop-compiler string< 2)
(byte-defop-compiler (string-equal byte-string=) 2)
(byte-defop-compiler (string-lessp byte-string<) 2)
-; (byte-defop-compiler20 old-equal 2)
+; (byte-defop-compiler old-equal 2)
(byte-defop-compiler nthcdr 2)
(byte-defop-compiler elt 2)
-(byte-defop-compiler20 old-member 2)
-(byte-defop-compiler20 old-assq 2)
+(byte-defop-compiler old-member 2)
+(byte-defop-compiler old-assq 2)
(byte-defop-compiler (rplaca byte-setcar) 2)
(byte-defop-compiler (rplacd byte-setcdr) 2)
(byte-defop-compiler setcar 2)
＠＠ -3207,8 +3114,8 ＠＠
(byte-defop-compiler-1 multiple-value-call)
(byte-defop-compiler throw)
-(byte-defop-compiler-rmsfun member 2)
-(byte-defop-compiler-rmsfun assq 2)
+(byte-defop-compiler member 2)
+(byte-defop-compiler assq 2)
;;####(byte-defop-compiler move-to-column 1)
(byte-defop-compiler-1 interactive byte-compile-noop)
＠＠ -3351,17 +3258,6 ＠＠
((2 3) (byte-compile-normal-call form))
(t (byte-compile-subr-wrong-args form "1-3"))))
-;; XEmacs: used for functions that have a different opcode in v19 than v20.
-;; this includes `eq', `equal', and other old-ified functions.
-(defun byte-compile-two-args-19->20 (form)
- (if (not (eql (length form) 3))
- (byte-compile-subr-wrong-args form 2)
- (byte-compile-form (car (cdr form))) ;; Push the arguments
- (byte-compile-form (nth 2 form))
- (if (byte-compile-version-cond byte-compile-emacs19-compatibility)
- (byte-compile-out (get (car form) 'byte-opcode19) 0)
- (byte-compile-out (get (car form) 'byte-opcode) 0))))
-
(defun byte-compile-noop (form)
(byte-compile-constant nil))
＠＠ -4305,17 +4201,9 ＠＠
(byte-compile-out 'byte-unbind 1))
(defun byte-compile-save-current-buffer (form)
- (if (byte-compile-version-cond byte-compile-emacs19-compatibility)
- ;; `save-current-buffer' special operator is not available in XEmacs 19.
- (byte-compile-form
- `(let ((_byte_compiler_save_buffer_emulation_closure_ (current-buffer)))
- (unwind-protect
- (progn ,＠(cdr form))
- (and (buffer-live-p _byte_compiler_save_buffer_emulation_closure_)
- (set-buffer _byte_compiler_save_buffer_emulation_closure_)))))
- (byte-compile-out 'byte-save-current-buffer 0)
- (byte-compile-body-do-effect (cdr form))
- (byte-compile-out 'byte-unbind 1)))
+ (byte-compile-out 'byte-save-current-buffer 0)
+ (byte-compile-body-do-effect (cdr form))
+ (byte-compile-out 'byte-unbind 1))
(defun byte-compile-with-output-to-temp-buffer (form)
(byte-compile-form (car (cdr form)))
＠＠ -4877,22 +4765,23 ＠＠
;;
(eval-when-compile
(or (compiled-function-p (symbol-function 'byte-compile-form))
- (assq 'byte-code (symbol-function 'byte-compile-form))
(let ((byte-optimize nil) ; do it fast
(byte-compile-warnings nil))
- (mapcar #'(lambda (x)
- (or noninteractive (message "compiling %s..." x))
- (byte-compile x)
- (or noninteractive (message "compiling %s...done" x)))
- '(byte-compile-normal-call
- byte-compile-form
- byte-compile-body
- ;; Inserted some more than necessary, to speed it up.
- byte-compile-top-level
- byte-compile-out-toplevel
- byte-compile-constant
- byte-compile-variable-ref))))
- nil)
+ (map nil (if noninteractive
+ #'byte-compile
+ #'(lambda (x)
+ (message "compiling %s..." x)
+ (byte-compile x)
+ (message "compiling %s...done" x)))
+ '(byte-compile-normal-call
+ byte-compile-form
+ byte-compile-body
+ ;; Inserted some more than necessary, to speed it up.
+ byte-compile-top-level
+ byte-compile-out-toplevel
+ byte-compile-constant
+ byte-compile-variable-ref)))))
+
(run-hooks 'bytecomp-load-hook)
--
“Apart from the nine-banded armadillo, man is the only natural host of
Mycobacterium leprae, although it can be grown in the footpads of mice.”
-- Kumar & Clark, Clinical Medicine, summarising improbable leprosy research
_______________________________________________
XEmacs-Patches mailing list
XEmacs-Patches(a)xemacs.org
http://lists.xemacs.org/mailman/listinfo/xemacs-patches
- 1 participants
- 0 comments
commit: Drop support for generating code appropriate for Emacs 19, bytecomp.el
12 years, 11 months
Aidan Kehoe
Aidan Kehoe
changeset: 5503:7b5946dbfb96
tag: tip
user: Aidan Kehoe <kehoea(a)parhasard.net>
date: Sat May 07 12:26:39 2011 +0100
files: lisp/ChangeLog lisp/bytecomp.el
description:
Drop support for generating code appropriate for Emacs 19, bytecomp.el
lisp/ChangeLog addition:
2011-05-07 Aidan Kehoe <kehoea(a)parhasard.net>
* bytecomp.el:
* bytecomp.el (byte-compile-two-args-19->20): Removed.
* bytecomp.el (byte-compile-emacs19-compatibility): Removed.
* bytecomp.el (byte-defop-compiler20): Removed.
* bytecomp.el (byte-defop-compiler-rmsfun): Removed.
* bytecomp.el (emacs-lisp-file-regexp):
* bytecomp.el (byte-compile-print-gensym):
* bytecomp.el (byte-compiler-legal-options):
* bytecomp.el (byte-compiler-obsolete-options):
* bytecomp.el (byte-compile-close-variables):
* bytecomp.el (byte-compile-insert-header):
* bytecomp.el (byte-compile-output-file-form):
* bytecomp.el (byte-compile-output-docform):
* bytecomp.el (byte-compile-out-toplevel):
* bytecomp.el (byte-compile-form):
* bytecomp.el (byte-defop-compiler-1):
* bytecomp.el (eq):
* bytecomp.el (equal):
* bytecomp.el (member):
* bytecomp.el (byte-compile-noop):
* bytecomp.el (byte-compile-save-current-buffer):
Remove support for generating code appropriate to Emacs 19.
* bytecomp.el (byte-compile-eval):
Avoid erroring here if the car of some entry in the macro
environment is not a symbol, as is the case for symbol macros.
* bytecomp.el (or):
Use slightly better style when compiling the most important
functions if bytecomp.el has just been loaded interpreted.
diff -r 5b08be74bb53 -r 7b5946dbfb96 lisp/ChangeLog
--- a/lisp/ChangeLog Sat May 07 11:45:20 2011 +0100
+++ b/lisp/ChangeLog Sat May 07 12:26:39 2011 +0100
＠＠ -1,3 +1,35 ＠＠
+2011-05-07 Aidan Kehoe <kehoea(a)parhasard.net>
+
+ * bytecomp.el:
+ * bytecomp.el (byte-compile-two-args-19->20): Removed.
+ * bytecomp.el (byte-compile-emacs19-compatibility): Removed.
+ * bytecomp.el (byte-defop-compiler20): Removed.
+ * bytecomp.el (byte-defop-compiler-rmsfun): Removed.
+ * bytecomp.el (emacs-lisp-file-regexp):
+ * bytecomp.el (byte-compile-print-gensym):
+ * bytecomp.el (byte-compiler-legal-options):
+ * bytecomp.el (byte-compiler-obsolete-options):
+ * bytecomp.el (byte-compile-close-variables):
+ * bytecomp.el (byte-compile-insert-header):
+ * bytecomp.el (byte-compile-output-file-form):
+ * bytecomp.el (byte-compile-output-docform):
+ * bytecomp.el (byte-compile-out-toplevel):
+ * bytecomp.el (byte-compile-form):
+ * bytecomp.el (byte-defop-compiler-1):
+ * bytecomp.el (eq):
+ * bytecomp.el (equal):
+ * bytecomp.el (member):
+ * bytecomp.el (byte-compile-noop):
+ * bytecomp.el (byte-compile-save-current-buffer):
+ Remove support for generating code appropriate to Emacs 19.
+
+ * bytecomp.el (byte-compile-eval):
+ Avoid erroring here if the car of some entry in the macro
+ environment is not a symbol, as is the case for symbol macros.
+ * bytecomp.el (or):
+ Use slightly better style when compiling the most important
+ functions if bytecomp.el has just been loaded interpreted.
+
2011-05-07 Aidan Kehoe <kehoea(a)parhasard.net>
* byte-optimize.el:
diff -r 5b08be74bb53 -r 7b5946dbfb96 lisp/bytecomp.el
--- a/lisp/bytecomp.el Sat May 07 11:45:20 2011 +0100
+++ b/lisp/bytecomp.el Sat May 07 12:26:39 2011 +0100
＠＠ -121,9 +121,6 ＠＠
;;; as data, not as a function,
;;; and using it in a function
;;; context )
-;;; byte-compile-emacs19-compatibility Whether the compiler should
-;;; generate .elc files which can be loaded into
-;;; generic emacs 19.
;;; emacs-lisp-file-regexp Regexp for the extension of source-files;
;;; see also the function `byte-compile-dest-file'.
;;; byte-compile-overwrite-file If nil, delete old .elc files before saving.
＠＠ -218,21 +215,6 ＠＠
;; This really ought to be loaded already!
(load-library "bytecomp-runtime"))
-(eval-when-compile
- (defvar byte-compile-single-version t
- "If this is true, the choice of emacs version (v19 or v20) byte-codes will
-be hard-coded into bytecomp when it compiles itself. If the compiler itself
-is compiled with optimization, this causes a speedup.")
-
- (cond
- (byte-compile-single-version
- (defmacro byte-compile-single-version () t)
- (defmacro byte-compile-version-cond (cond) (list 'quote (eval cond))))
- (t
- (defmacro byte-compile-single-version () nil)
- (defmacro byte-compile-version-cond (cond) cond)))
- )
-
(defvar emacs-lisp-file-regexp "\\.el$"
"*Regexp which matches Emacs Lisp source files.
You may want to redefine `byte-compile-dest-file' if you change this.")
＠＠ -277,20 +259,13 ＠＠
(and (not noninteractive) (> (device-baud-rate) search-slow-speed))
"*Non-nil means print messages describing progress of byte-compiler.")
-(defvar byte-compile-emacs19-compatibility
- (not (emacs-version>= 20))
- "*Non-nil means generate output that can run in Emacs 19.")
-
(defvar byte-compile-print-gensym t
"*Non-nil means generate code that creates unique symbols at run-time.
This is achieved by printing uninterned symbols using the `#:SYMBOL'
notation, so that they will be read uninterned when run.
With this feature, code that uses uninterned symbols in macros will
-not be runnable under pre-21.0 XEmacsen.
-
-When `byte-compile-emacs19-compatibility' is non-nil, this variable is
-ignored and considered to be nil.")
+not be runnable under pre-21.0 XEmacsen.")
(defvar byte-optimize t
"*Enables optimization in the byte compiler.
＠＠ -482,11 +457,15 ＠＠
(defun byte-compile-eval (form)
(let ((save-macro-environment nil))
(unwind-protect
- (loop for (sym . def) in byte-compile-macro-environment do
- (push
- (if (fboundp sym) (cons sym (symbol-function sym)) sym)
- save-macro-environment)
- (fset sym (cons 'macro def))
+ (loop
+ for (sym . def) in byte-compile-macro-environment
+ do (when (symbolp sym)
+ (push
+ (if (fboundp sym)
+ (cons sym (symbol-function sym))
+ sym)
+ save-macro-environment)
+ (fset sym (cons 'macro def)))
finally return (eval form))
(dolist (elt save-macro-environment)
(if (symbolp elt)
＠＠ -1093,7 +1072,7 ＠＠
(defconst byte-compiler-legal-options
'((optimize byte-optimize (t nil source byte) val)
- (file-format byte-compile-emacs19-compatibility (emacs19 emacs20)
+ (file-format byte-compile-emacs19-compatibility (emacs20)
(eq val 'emacs19))
(delete-errors byte-compile-delete-errors (t nil) val)
(verbose byte-compile-verbose (t nil) val)
＠＠ -1105,19 +1084,7 ＠＠
;; XEmacs addition
(defconst byte-compiler-obsolete-options
- '((new-bytecodes t)))
-
-;; Inhibit v19/v20 selectors if the version is hardcoded.
-;; #### This should print a warning if the user tries to change something
-;; than can't be changed because the running compiler doesn't support it.
-(cond
- ((byte-compile-single-version)
- (setcar (cdr (cdr (assq 'file-format byte-compiler-legal-options)))
- (if (byte-compile-version-cond byte-compile-emacs19-compatibility)
- '(emacs19) '(emacs20)))))
-
-;; now we can copy it.
-(setq byte-compiler-legal-options byte-compiler-legal-options)
+ '((new-bytecodes t) (byte-compile-emacs19-compatibility nil)))
(defun byte-compiler-options-handler (&rest args)
(let (key val desc choices)
＠＠ -1422,8 +1389,6 ＠＠
;;
(byte-compile-verbose byte-compile-verbose)
(byte-optimize byte-optimize)
- (byte-compile-emacs19-compatibility
- byte-compile-emacs19-compatibility)
(byte-compile-checks-on-load
byte-compile-checks-on-load)
(byte-compile-dynamic byte-compile-dynamic)
＠＠ -1860,7 +1825,7 ＠＠
;;
(insert
";ELC"
- (if (byte-compile-version-cond byte-compile-emacs19-compatibility) 19 20)
+ 20
"\000\000\000\n")
(when (not (eq (find-coding-system 'raw-text-unix)
(find-coding-system buffer-file-coding-system)))
＠＠ -1974,9 +1939,7 ＠＠
(print-length nil)
(print-level nil)
(print-readably t) ; print #[] for bytecode, 'x for (quote x)
- (print-gensym (if (and byte-compile-print-gensym
- (not byte-compile-emacs19-compatibility))
- '(t) nil))
+ (print-gensym (if byte-compile-print-gensym '(t) nil))
print-gensym-alist)
(when byte-compile-output-preface
(princ "\n(progn " byte-compile-outbuffer)
＠＠ -2026,9 +1989,7 ＠＠
;; Use a cons cell to say that we want
;; print-gensym-alist not to be cleared between calls
;; to print functions.
- (print-gensym (if (and byte-compile-print-gensym
- (not byte-compile-emacs19-compatibility))
- '(t) nil))
+ (print-gensym (if byte-compile-print-gensym '(t) nil))
print-gensym-alist
(index 0))
(when byte-compile-output-preface
＠＠ -2763,15 +2724,7 ＠＠
((and maycall
;; Allow a funcall if at most one atom follows it.
(null (nthcdr 3 rest))
- (setq tmp
- ;; XEmacs change for rms funs
- (or (and
- (byte-compile-version-cond
- byte-compile-emacs19-compatibility)
- (get (car (car rest))
- 'byte-opcode19-invert))
- (get (car (car rest))
- 'byte-opcode-invert)))
+ (setq tmp (get (car (car rest)) 'byte-opcode-invert))
(or (null (cdr rest))
(and (memq output-type '(file progn t))
(cdr (cdr rest))
＠＠ -2828,10 +2781,7 ＠＠
(handler (get fn 'byte-compile)))
(if (memq fn '(t nil))
(byte-compile-warn "%s called as a function" fn))
- (if (and handler
- (or (not (byte-compile-version-cond
- byte-compile-emacs19-compatibility))
- (not (get (get fn 'byte-opcode) 'emacs20-opcode))))
+ (if handler
(funcall handler form)
(if (memq 'callargs byte-compile-warnings)
(byte-compile-callargs-warn form))
＠＠ -3057,49 +3007,6 ＠＠
''byte-opcode-invert (list 'quote function)))
fnform))))
-(defmacro byte-defop-compiler20 (function &optional compile-handler)
- ;; Just like byte-defop-compiler, but defines an opcode that will only
- ;; be used when byte-compile-emacs19-compatibility is false.
- (if (and (byte-compile-single-version)
- byte-compile-emacs19-compatibility)
- ;; #### instead of doing nothing, this should do some remprops,
- ;; #### to protect against the case where a single-version compiler
- ;; #### is loaded into a world that has contained a multi-version one.
- nil
- (list 'progn
- (list 'put
- (list 'quote
- (or (car (cdr-safe function))
- (intern (concat "byte-"
- (symbol-name (or (car-safe function) function))))))
- ''emacs20-opcode t)
- (list 'byte-defop-compiler function compile-handler))))
-
-;; XEmacs addition:
-(defmacro byte-defop-compiler-rmsfun (function &optional compile-handler)
- ;; for functions like `eq' that compile into different opcodes depending
- ;; on the Emacs version: byte-old-eq for v19, byte-eq for v20.
- (let ((opcode (intern (concat "byte-" (symbol-name function))))
- (opcode19 (intern (concat "byte-old-" (symbol-name function))))
- (fnform
- (list 'put (list 'quote function) ''byte-compile
- (list 'quote
- (or (cdr (assq compile-handler
- '((2 . byte-compile-two-args-19->20)
- )))
- compile-handler
- (intern (concat "byte-compile-"
- (symbol-name function))))))))
- (list 'progn fnform
- (list 'put (list 'quote function)
- ''byte-opcode (list 'quote opcode))
- (list 'put (list 'quote function)
- ''byte-opcode19 (list 'quote opcode19))
- (list 'put (list 'quote opcode)
- ''byte-opcode-invert (list 'quote function))
- (list 'put (list 'quote opcode19)
- ''byte-opcode19-invert (list 'quote function)))))
-
(defmacro byte-defop-compiler-1 (function &optional compile-handler)
(list 'byte-defop-compiler (list function nil) compile-handler))
＠＠ -3121,7 +3028,7 ＠＠
;(byte-defop-compiler (dot-max byte-point-max) 0+1)
;(byte-defop-compiler (dot-min byte-point-min) 0+1)
(byte-defop-compiler point 0+1)
-(byte-defop-compiler-rmsfun eq 2)
+(byte-defop-compiler eq 2)
(byte-defop-compiler point-max 0+1)
(byte-defop-compiler point-min 0+1)
(byte-defop-compiler following-char 0+1)
＠＠ -3130,14 +3037,14 ＠＠
;; FSF has special function here; generalized here by the 1+2 stuff.
(byte-defop-compiler (indent-to-column byte-indent-to) 1+2)
(byte-defop-compiler indent-to 1+2)
-(byte-defop-compiler-rmsfun equal 2)
+(byte-defop-compiler equal 2)
(byte-defop-compiler eolp 0+1)
(byte-defop-compiler eobp 0+1)
(byte-defop-compiler bolp 0+1)
(byte-defop-compiler bobp 0+1)
(byte-defop-compiler current-buffer 0)
;;(byte-defop-compiler read-char 0) ;; obsolete
-(byte-defop-compiler-rmsfun memq 2)
+(byte-defop-compiler memq 2)
(byte-defop-compiler interactive-p 0)
(byte-defop-compiler widen 0+1)
(byte-defop-compiler end-of-line 0-1+1)
＠＠ -3170,8 +3077,8 ＠＠
(byte-defop-compiler skip-chars-forward 1-2+1)
(byte-defop-compiler skip-chars-backward 1-2+1)
(byte-defop-compiler eq 2)
-; (byte-defop-compiler20 old-eq 2)
-; (byte-defop-compiler20 old-memq 2)
+; (byte-defop-compiler old-eq 2)
+; (byte-defop-compiler old-memq 2)
(byte-defop-compiler cons 2)
(byte-defop-compiler aref 2)
(byte-defop-compiler get 2+1)
＠＠ -3188,11 +3095,11 ＠＠
(byte-defop-compiler string< 2)
(byte-defop-compiler (string-equal byte-string=) 2)
(byte-defop-compiler (string-lessp byte-string<) 2)
-; (byte-defop-compiler20 old-equal 2)
+; (byte-defop-compiler old-equal 2)
(byte-defop-compiler nthcdr 2)
(byte-defop-compiler elt 2)
-(byte-defop-compiler20 old-member 2)
-(byte-defop-compiler20 old-assq 2)
+(byte-defop-compiler old-member 2)
+(byte-defop-compiler old-assq 2)
(byte-defop-compiler (rplaca byte-setcar) 2)
(byte-defop-compiler (rplacd byte-setcdr) 2)
(byte-defop-compiler setcar 2)
＠＠ -3207,8 +3114,8 ＠＠
(byte-defop-compiler-1 multiple-value-call)
(byte-defop-compiler throw)
-(byte-defop-compiler-rmsfun member 2)
-(byte-defop-compiler-rmsfun assq 2)
+(byte-defop-compiler member 2)
+(byte-defop-compiler assq 2)
;;####(byte-defop-compiler move-to-column 1)
(byte-defop-compiler-1 interactive byte-compile-noop)
＠＠ -3350,17 +3257,6 ＠＠
(1 (byte-compile-one-arg form))
((2 3) (byte-compile-normal-call form))
(t (byte-compile-subr-wrong-args form "1-3"))))
-
-;; XEmacs: used for functions that have a different opcode in v19 than v20.
-;; this includes `eq', `equal', and other old-ified functions.
-(defun byte-compile-two-args-19->20 (form)
- (if (not (eql (length form) 3))
- (byte-compile-subr-wrong-args form 2)
- (byte-compile-form (car (cdr form))) ;; Push the arguments
- (byte-compile-form (nth 2 form))
- (if (byte-compile-version-cond byte-compile-emacs19-compatibility)
- (byte-compile-out (get (car form) 'byte-opcode19) 0)
- (byte-compile-out (get (car form) 'byte-opcode) 0))))
(defun byte-compile-noop (form)
(byte-compile-constant nil))
＠＠ -4305,17 +4201,9 ＠＠
(byte-compile-out 'byte-unbind 1))
(defun byte-compile-save-current-buffer (form)
- (if (byte-compile-version-cond byte-compile-emacs19-compatibility)
- ;; `save-current-buffer' special operator is not available in XEmacs 19.
- (byte-compile-form
- `(let ((_byte_compiler_save_buffer_emulation_closure_ (current-buffer)))
- (unwind-protect
- (progn ,＠(cdr form))
- (and (buffer-live-p _byte_compiler_save_buffer_emulation_closure_)
- (set-buffer _byte_compiler_save_buffer_emulation_closure_)))))
- (byte-compile-out 'byte-save-current-buffer 0)
- (byte-compile-body-do-effect (cdr form))
- (byte-compile-out 'byte-unbind 1)))
+ (byte-compile-out 'byte-save-current-buffer 0)
+ (byte-compile-body-do-effect (cdr form))
+ (byte-compile-out 'byte-unbind 1))
(defun byte-compile-with-output-to-temp-buffer (form)
(byte-compile-form (car (cdr form)))
＠＠ -4877,22 +4765,23 ＠＠
;;
(eval-when-compile
(or (compiled-function-p (symbol-function 'byte-compile-form))
- (assq 'byte-code (symbol-function 'byte-compile-form))
(let ((byte-optimize nil) ; do it fast
(byte-compile-warnings nil))
- (mapcar #'(lambda (x)
- (or noninteractive (message "compiling %s..." x))
- (byte-compile x)
- (or noninteractive (message "compiling %s...done" x)))
- '(byte-compile-normal-call
- byte-compile-form
- byte-compile-body
- ;; Inserted some more than necessary, to speed it up.
- byte-compile-top-level
- byte-compile-out-toplevel
- byte-compile-constant
- byte-compile-variable-ref))))
- nil)
+ (map nil (if noninteractive
+ #'byte-compile
+ #'(lambda (x)
+ (message "compiling %s..." x)
+ (byte-compile x)
+ (message "compiling %s...done" x)))
+ '(byte-compile-normal-call
+ byte-compile-form
+ byte-compile-body
+ ;; Inserted some more than necessary, to speed it up.
+ byte-compile-top-level
+ byte-compile-out-toplevel
+ byte-compile-constant
+ byte-compile-variable-ref)))))
+
(run-hooks 'bytecomp-load-hook)
_______________________________________________
XEmacs-Patches mailing list
XEmacs-Patches(a)xemacs.org
http://lists.xemacs.org/mailman/listinfo/xemacs-patches
- 1 participants
- 0 comments
[COMMIT] Be better about recognising side-effect-free forms, byte-optimize.el.
12 years, 11 months
Aidan Kehoe
Aidan Kehoe
APPROVE COMMIT
NOTE: This patch has been committed.
# HG changeset patch
# User Aidan Kehoe <kehoea(a)parhasard.net>
# Date 1304765120 -3600
# Node ID 5b08be74bb532a6dbdf03caf5f48ca3640e2cae0
# Parent 4813ff11c6e297815a02fc0601a3b01881f6f6a1
Be better about recognising side-effect-free forms, byte-optimize.el.
2011-05-07 Aidan Kehoe <kehoea(a)parhasard.net>
* byte-optimize.el:
* byte-optimize.el (byte-optimize-form-code-walker):
Call #'byte-optimize-side-effect-free-p on the form, rather than
just checking the plist of the form's car.
* byte-optimize.el (side-effect-free-fns):
Move the CL functions into their alphabetical place in the list.
* byte-optimize.el (function):
* byte-optimize.el (byte-optimize-side-effect-free-p): New.
Function returning non-nil if a funcall has no side-effects, which
handles things like (remove* item list :key 'car) and
(remove-if-not #'integerp list).
diff -r 4813ff11c6e2 -r 5b08be74bb53 lisp/ChangeLog
--- a/lisp/ChangeLog Fri May 06 10:37:14 2011 +0100
+++ b/lisp/ChangeLog Sat May 07 11:45:20 2011 +0100
＠＠ -1,3 +1,17 ＠＠
+2011-05-07 Aidan Kehoe <kehoea(a)parhasard.net>
+
+ * byte-optimize.el:
+ * byte-optimize.el (byte-optimize-form-code-walker):
+ Call #'byte-optimize-side-effect-free-p on the form, rather than
+ just checking the plist of the form's car.
+ * byte-optimize.el (side-effect-free-fns):
+ Move the CL functions into their alphabetical place in the list.
+ * byte-optimize.el (function):
+ * byte-optimize.el (byte-optimize-side-effect-free-p): New.
+ Function returning non-nil if a funcall has no side-effects, which
+ handles things like (remove* item list :key 'car) and
+ (remove-if-not #'integerp list).
+
2011-05-06 Aidan Kehoe <kehoea(a)parhasard.net>
* cl-macs.el (most-positive-fixnum-on-32-bit-machines):
diff -r 4813ff11c6e2 -r 5b08be74bb53 lisp/byte-optimize.el
--- a/lisp/byte-optimize.el Fri May 06 10:37:14 2011 +0100
+++ b/lisp/byte-optimize.el Sat May 07 11:45:20 2011 +0100
＠＠ -524,21 +524,17 ＠＠
byte-compile-macro-environment))))
(byte-optimize-form form for-effect))
+ ((not (symbolp fn))
+ (byte-compile-warn "%s is a malformed function" (prin1-to-string fn))
+ form)
+
;; Support compiler macros as in cl.el.
- ((and (fboundp 'compiler-macroexpand)
- (symbolp (car-safe form))
- (get (car-safe form) 'cl-compiler-macro)
- (not (eq form
- (setq form (compiler-macroexpand form)))))
+ ((and (get fn 'cl-compiler-macro)
+ (not (eq form (setq form (compiler-macroexpand form)))))
(byte-optimize-form form for-effect))
- ((not (symbolp fn))
- (or (eq 'mocklisp (car-safe fn)) ; ha!
- (byte-compile-warn "%s is a malformed function"
- (prin1-to-string fn)))
- form)
-
- ((and for-effect (setq tmp (get fn 'side-effect-free))
+ ((and for-effect
+ (setq tmp (byte-optimize-side-effect-free-p form))
(or byte-compile-delete-errors
(eq tmp 'error-free)
(progn
＠＠ -1260,42 +1256,62 ＠＠
list-length getf
))
(side-effect-and-error-free-fns
- '(arrayp atom
+ '(acons arrayp atom
bigfloatp bignump bobp bolp buffer-end buffer-list buffer-size
buffer-string bufferp
car-safe case-table-p cdr-safe char-or-string-p char-table-p
characterp commandp cons
- consolep console-live-p consp
+ consolep console-live-p consp copy-tree
current-buffer
;; XEmacs: extent functions, frame-live-p, various other stuff
devicep device-live-p
- eobp eolp eq eql equal eventp extentp
+ eobp eolp eq eql equal equalp eventp extentp
extent-live-p fixnump floatingp floatp framep frame-live-p
get-largest-window get-lru-window
hash-table-p
identity ignore integerp integer-or-marker-p interactive-p
invocation-directory invocation-name
- keymapp list listp
+ keymapp list list* listp
make-marker mark mark-marker markerp memory-limit minibuffer-window
;; mouse-movement-p not in XEmacs
natnump nlistp not null number-or-marker-p numberp
one-window-p ;; overlayp not in XEmacs
point point-marker point-min point-max processp
- rationalp ratiop range-table-p realp
+ random-state-p rationalp ratiop range-table-p realp
selected-window sequencep stringp subrp symbolp syntax-table-p
user-full-name user-login-name user-original-login-name
user-real-login-name user-real-uid user-uid
vector vectorp
- window-configuration-p window-live-p windowp
- ;; Functions defined by cl
- eql list* subst acons equalp random-state-p
- copy-tree sublis
- )))
+ window-configuration-p window-live-p windowp)))
(dolist (fn side-effect-free-fns)
(put fn 'side-effect-free t))
(dolist (fn side-effect-and-error-free-fns)
(put fn 'side-effect-free 'error-free)))
+(dolist (function
+ '(adjoin assoc* count find intersection member* mismatch position
+ rassoc* remove* remove-duplicates search set-difference
+ set-exclusive-or stable-intersection stable-sort stable-union
+ sublis subsetp subst substitute tree-equal union))
+ ;; These all throw errors, there's no point implementing an error-free
+ ;; version of the list.
+ (put function 'side-effect-free-if-keywords-are t))
+
+(defun byte-optimize-side-effect-free-p (form)
+ (or (get (car-safe form) 'side-effect-free)
+ (and (get (car-safe form) 'side-effect-free-if-keywords-are)
+ (loop
+ for (key value)
+ on (nthcdr (get (car form) 'byte-compile-keyword-start) form)
+ by #'cddr
+ never (or (and (member* key
+ '(:test :test-not :key :if :if-not))
+ (or (not (byte-compile-constp value))
+ (not (and (consp value)
+ (symbolp (cadr value))
+ (get (cadr value)
+ 'side-effect-free)))))
+ (not (keywordp key)))))))
(defun byte-compile-splice-in-already-compiled-code (form)
;; form is (byte-code "..." [...] n)
--
“Apart from the nine-banded armadillo, man is the only natural host of
Mycobacterium leprae, although it can be grown in the footpads of mice.”
-- Kumar & Clark, Clinical Medicine, summarising improbable leprosy research
_______________________________________________
XEmacs-Patches mailing list
XEmacs-Patches(a)xemacs.org
http://lists.xemacs.org/mailman/listinfo/xemacs-patches
- 1 participants
- 0 comments
commit: Be better about recognising side-effect-free forms, byte-optimize.el.
12 years, 11 months
Aidan Kehoe
Aidan Kehoe
changeset: 5502:5b08be74bb53
tag: tip
user: Aidan Kehoe <kehoea(a)parhasard.net>
date: Sat May 07 11:45:20 2011 +0100
files: lisp/ChangeLog lisp/byte-optimize.el
description:
Be better about recognising side-effect-free forms, byte-optimize.el.
2011-05-07 Aidan Kehoe <kehoea(a)parhasard.net>
* byte-optimize.el:
* byte-optimize.el (byte-optimize-form-code-walker):
Call #'byte-optimize-side-effect-free-p on the form, rather than
just checking the plist of the form's car.
* byte-optimize.el (side-effect-free-fns):
Move the CL functions into their alphabetical place in the list.
* byte-optimize.el (function):
* byte-optimize.el (byte-optimize-side-effect-free-p): New.
Function returning non-nil if a funcall has no side-effects, which
handles things like (remove* item list :key 'car) and
(remove-if-not #'integerp list).
diff -r 4813ff11c6e2 -r 5b08be74bb53 lisp/ChangeLog
--- a/lisp/ChangeLog Fri May 06 10:37:14 2011 +0100
+++ b/lisp/ChangeLog Sat May 07 11:45:20 2011 +0100
＠＠ -1,3 +1,17 ＠＠
+2011-05-07 Aidan Kehoe <kehoea(a)parhasard.net>
+
+ * byte-optimize.el:
+ * byte-optimize.el (byte-optimize-form-code-walker):
+ Call #'byte-optimize-side-effect-free-p on the form, rather than
+ just checking the plist of the form's car.
+ * byte-optimize.el (side-effect-free-fns):
+ Move the CL functions into their alphabetical place in the list.
+ * byte-optimize.el (function):
+ * byte-optimize.el (byte-optimize-side-effect-free-p): New.
+ Function returning non-nil if a funcall has no side-effects, which
+ handles things like (remove* item list :key 'car) and
+ (remove-if-not #'integerp list).
+
2011-05-06 Aidan Kehoe <kehoea(a)parhasard.net>
* cl-macs.el (most-positive-fixnum-on-32-bit-machines):
diff -r 4813ff11c6e2 -r 5b08be74bb53 lisp/byte-optimize.el
--- a/lisp/byte-optimize.el Fri May 06 10:37:14 2011 +0100
+++ b/lisp/byte-optimize.el Sat May 07 11:45:20 2011 +0100
＠＠ -524,21 +524,17 ＠＠
byte-compile-macro-environment))))
(byte-optimize-form form for-effect))
+ ((not (symbolp fn))
+ (byte-compile-warn "%s is a malformed function" (prin1-to-string fn))
+ form)
+
;; Support compiler macros as in cl.el.
- ((and (fboundp 'compiler-macroexpand)
- (symbolp (car-safe form))
- (get (car-safe form) 'cl-compiler-macro)
- (not (eq form
- (setq form (compiler-macroexpand form)))))
+ ((and (get fn 'cl-compiler-macro)
+ (not (eq form (setq form (compiler-macroexpand form)))))
(byte-optimize-form form for-effect))
- ((not (symbolp fn))
- (or (eq 'mocklisp (car-safe fn)) ; ha!
- (byte-compile-warn "%s is a malformed function"
- (prin1-to-string fn)))
- form)
-
- ((and for-effect (setq tmp (get fn 'side-effect-free))
+ ((and for-effect
+ (setq tmp (byte-optimize-side-effect-free-p form))
(or byte-compile-delete-errors
(eq tmp 'error-free)
(progn
＠＠ -1260,42 +1256,62 ＠＠
list-length getf
))
(side-effect-and-error-free-fns
- '(arrayp atom
+ '(acons arrayp atom
bigfloatp bignump bobp bolp buffer-end buffer-list buffer-size
buffer-string bufferp
car-safe case-table-p cdr-safe char-or-string-p char-table-p
characterp commandp cons
- consolep console-live-p consp
+ consolep console-live-p consp copy-tree
current-buffer
;; XEmacs: extent functions, frame-live-p, various other stuff
devicep device-live-p
- eobp eolp eq eql equal eventp extentp
+ eobp eolp eq eql equal equalp eventp extentp
extent-live-p fixnump floatingp floatp framep frame-live-p
get-largest-window get-lru-window
hash-table-p
identity ignore integerp integer-or-marker-p interactive-p
invocation-directory invocation-name
- keymapp list listp
+ keymapp list list* listp
make-marker mark mark-marker markerp memory-limit minibuffer-window
;; mouse-movement-p not in XEmacs
natnump nlistp not null number-or-marker-p numberp
one-window-p ;; overlayp not in XEmacs
point point-marker point-min point-max processp
- rationalp ratiop range-table-p realp
+ random-state-p rationalp ratiop range-table-p realp
selected-window sequencep stringp subrp symbolp syntax-table-p
user-full-name user-login-name user-original-login-name
user-real-login-name user-real-uid user-uid
vector vectorp
- window-configuration-p window-live-p windowp
- ;; Functions defined by cl
- eql list* subst acons equalp random-state-p
- copy-tree sublis
- )))
+ window-configuration-p window-live-p windowp)))
(dolist (fn side-effect-free-fns)
(put fn 'side-effect-free t))
(dolist (fn side-effect-and-error-free-fns)
(put fn 'side-effect-free 'error-free)))
+(dolist (function
+ '(adjoin assoc* count find intersection member* mismatch position
+ rassoc* remove* remove-duplicates search set-difference
+ set-exclusive-or stable-intersection stable-sort stable-union
+ sublis subsetp subst substitute tree-equal union))
+ ;; These all throw errors, there's no point implementing an error-free
+ ;; version of the list.
+ (put function 'side-effect-free-if-keywords-are t))
+
+(defun byte-optimize-side-effect-free-p (form)
+ (or (get (car-safe form) 'side-effect-free)
+ (and (get (car-safe form) 'side-effect-free-if-keywords-are)
+ (loop
+ for (key value)
+ on (nthcdr (get (car form) 'byte-compile-keyword-start) form)
+ by #'cddr
+ never (or (and (member* key
+ '(:test :test-not :key :if :if-not))
+ (or (not (byte-compile-constp value))
+ (not (and (consp value)
+ (symbolp (cadr value))
+ (get (cadr value)
+ 'side-effect-free)))))
+ (not (keywordp key)))))))
(defun byte-compile-splice-in-already-compiled-code (form)
;; form is (byte-code "..." [...] n)
_______________________________________________
XEmacs-Patches mailing list
XEmacs-Patches(a)xemacs.org
http://lists.xemacs.org/mailman/listinfo/xemacs-patches
- 1 participants
- 0 comments
[COMMIT] Correct the definition of #'cl-non-fixnum-number-p on 32-bit machines.
12 years, 11 months
Aidan Kehoe
Aidan Kehoe
Hi Raymond --
[I just sent an incomplete version of this mail to the list, this is the
definitive one.]
Ar an cúigiú lá de mí Bealtaine, scríobh Raymond Toy:
> I just tried building xemacs on sparc using gcc 4.5.2. Everything
> actually compiles ok, but while dumping, I get the following:
>
> Dumping under the name xemacs
> ./xemacs -no-packages -batch -no-autoloads -l update-elc-2.el -f batch-update-elc-2 /net/gondor/Volumes/share2/src/xemacs/hg/xemacs-21.5/src/../lisp
>
> Loading autoload...
> Loading bytecomp...
> Loading cl-macs...
> [...]
> Invalid read syntax: Integer constant overflow in reader, "1073741824", 10gmake[2]: *** [update-elc-2] Error 255
This is my bug, thanks for the report. I’ve just committed the below.
Best,
Aidan
APPROVE COMMIT
NOTE: This patch has been committed.
# HG changeset patch
# User Aidan Kehoe <kehoea(a)parhasard.net>
# Date 1304674634 -3600
# Node ID 4813ff11c6e297815a02fc0601a3b01881f6f6a1
# Parent 01900734203a8d625bb4ec113fd0daad8131d7bb
Correct the definition of #'cl-non-fixnum-number-p on 32-bit machines.
2011-05-06 Aidan Kehoe <kehoea(a)parhasard.net>
* cl-macs.el (most-positive-fixnum-on-32-bit-machines):
Correct this, I had an off-by-one error (because I was developing
on a 64-bit machine). Thanks for the report, Raymond Toy!
diff -r 01900734203a -r 4813ff11c6e2 lisp/ChangeLog
--- a/lisp/ChangeLog Tue May 03 08:13:21 2011 -0400
+++ b/lisp/ChangeLog Fri May 06 10:37:14 2011 +0100
＠＠ -1,3 +1,9 ＠＠
+2011-05-06 Aidan Kehoe <kehoea(a)parhasard.net>
+
+ * cl-macs.el (most-positive-fixnum-on-32-bit-machines):
+ Correct this, I had an off-by-one error (because I was developing
+ on a 64-bit machine). Thanks for the report, Raymond Toy!
+
2011-05-01 Aidan Kehoe <kehoea(a)parhasard.net>
* buff-menu.el (list-buffers-directory):
diff -r 01900734203a -r 4813ff11c6e2 lisp/cl-macs.el
--- a/lisp/cl-macs.el Tue May 03 08:13:21 2011 -0400
+++ b/lisp/cl-macs.el Fri May 06 10:37:14 2011 +0100
＠＠ -3227,8 +3227,9 ＠＠
;; range of fixnums as well as their types. XEmacs doesn't support machines
;; with word size less than 32, so it's OK to have that as the minimum.
(macrolet
- ((most-negative-fixnum-on-32-bit-machines () (lognot (1- (lsh 1 30))))
- (most-positive-fixnum-on-32-bit-machines () (lsh 1 30)))
+ ((most-positive-fixnum-on-32-bit-machines () (1- (lsh 1 30)))
+ (most-negative-fixnum-on-32-bit-machines ()
+ (lognot (most-positive-fixnum-on-32-bit-machines))))
(defun cl-non-fixnum-number-p (object)
"Return t if OBJECT is a number not guaranteed to be immediate."
(and (numberp object)
--
“Apart from the nine-banded armadillo, man is the only natural host of
Mycobacterium leprae, although it can be grown in the footpads of mice.”
-- Kumar & Clark, Clinical Medicine, summarising improbable leprosy research
_______________________________________________
XEmacs-Patches mailing list
XEmacs-Patches(a)xemacs.org
http://lists.xemacs.org/mailman/listinfo/xemacs-patches
- 1 participants
- 0 comments
[COMMIT] Correct the definition of #'cl-non-fixnum-number-p on 32-bit machines.
12 years, 11 months
Aidan Kehoe
Aidan Kehoe
Ar an cúigiú lá de mí Bealtaine, scríobh Raymond Toy:
> I just tried building xemacs on sparc using gcc 4.5.2. Everything
> actually compiles ok, but while dumping, I get the following:
>
> Dumping under the name xemacs
> ./xemacs -no-packages -batch -no-autoloads -l update-elc-2.el -f batch-update-elc-2 /net/gondor/Volumes/share2/src/xemacs/hg/xemacs-21.5/src/../lisp
>
> Loading autoload...
> Loading bytecomp...
> Loading cl-macs...
> [...]
> Invalid read syntax: Integer constant overflow in reader, "1073741824", 10gmake[2]: *** [update-elc-2] Error 255
APPROVE COMMIT
NOTE: This patch has been committed.
# HG changeset patch
# User Aidan Kehoe <kehoea(a)parhasard.net>
# Date 1304674634 -3600
# Node ID 4813ff11c6e297815a02fc0601a3b01881f6f6a1
# Parent 01900734203a8d625bb4ec113fd0daad8131d7bb
Correct the definition of #'cl-non-fixnum-number-p on 32-bit machines.
2011-05-06 Aidan Kehoe <kehoea(a)parhasard.net>
* cl-macs.el (most-positive-fixnum-on-32-bit-machines):
Correct this, I had an off-by-one error (because I was developing
on a 64-bit machine). Thanks for the report, Raymond Toy!
diff -r 01900734203a -r 4813ff11c6e2 lisp/ChangeLog
--- a/lisp/ChangeLog Tue May 03 08:13:21 2011 -0400
+++ b/lisp/ChangeLog Fri May 06 10:37:14 2011 +0100
＠＠ -1,3 +1,9 ＠＠
+2011-05-06 Aidan Kehoe <kehoea(a)parhasard.net>
+
+ * cl-macs.el (most-positive-fixnum-on-32-bit-machines):
+ Correct this, I had an off-by-one error (because I was developing
+ on a 64-bit machine). Thanks for the report, Raymond Toy!
+
2011-05-01 Aidan Kehoe <kehoea(a)parhasard.net>
* buff-menu.el (list-buffers-directory):
diff -r 01900734203a -r 4813ff11c6e2 lisp/cl-macs.el
--- a/lisp/cl-macs.el Tue May 03 08:13:21 2011 -0400
+++ b/lisp/cl-macs.el Fri May 06 10:37:14 2011 +0100
＠＠ -3227,8 +3227,9 ＠＠
;; range of fixnums as well as their types. XEmacs doesn't support machines
;; with word size less than 32, so it's OK to have that as the minimum.
(macrolet
- ((most-negative-fixnum-on-32-bit-machines () (lognot (1- (lsh 1 30))))
- (most-positive-fixnum-on-32-bit-machines () (lsh 1 30)))
+ ((most-positive-fixnum-on-32-bit-machines () (1- (lsh 1 30)))
+ (most-negative-fixnum-on-32-bit-machines ()
+ (lognot (most-positive-fixnum-on-32-bit-machines))))
(defun cl-non-fixnum-number-p (object)
"Return t if OBJECT is a number not guaranteed to be immediate."
(and (numberp object)
--
“Apart from the nine-banded armadillo, man is the only natural host of
Mycobacterium leprae, although it can be grown in the footpads of mice.”
-- Kumar & Clark, Clinical Medicine, summarising improbable leprosy research
_______________________________________________
XEmacs-Patches mailing list
XEmacs-Patches(a)xemacs.org
http://lists.xemacs.org/mailman/listinfo/xemacs-patches
- 1 participants
- 0 comments
commit: Correct the definition of #'cl-non-fixnum-number-p on 32-bit machines.
12 years, 11 months
Aidan Kehoe
Aidan Kehoe
changeset: 5501:4813ff11c6e2
tag: tip
user: Aidan Kehoe <kehoea(a)parhasard.net>
date: Fri May 06 10:37:14 2011 +0100
files: lisp/ChangeLog lisp/cl-macs.el
description:
Correct the definition of #'cl-non-fixnum-number-p on 32-bit machines.
2011-05-06 Aidan Kehoe <kehoea(a)parhasard.net>
* cl-macs.el (most-positive-fixnum-on-32-bit-machines):
Correct this, I had an off-by-one error (because I was developing
on a 64-bit machine). Thanks for the report, Raymond Toy!
diff -r 01900734203a -r 4813ff11c6e2 lisp/ChangeLog
--- a/lisp/ChangeLog Tue May 03 08:13:21 2011 -0400
+++ b/lisp/ChangeLog Fri May 06 10:37:14 2011 +0100
＠＠ -1,3 +1,9 ＠＠
+2011-05-06 Aidan Kehoe <kehoea(a)parhasard.net>
+
+ * cl-macs.el (most-positive-fixnum-on-32-bit-machines):
+ Correct this, I had an off-by-one error (because I was developing
+ on a 64-bit machine). Thanks for the report, Raymond Toy!
+
2011-05-01 Aidan Kehoe <kehoea(a)parhasard.net>
* buff-menu.el (list-buffers-directory):
diff -r 01900734203a -r 4813ff11c6e2 lisp/cl-macs.el
--- a/lisp/cl-macs.el Tue May 03 08:13:21 2011 -0400
+++ b/lisp/cl-macs.el Fri May 06 10:37:14 2011 +0100
＠＠ -3227,8 +3227,9 ＠＠
;; range of fixnums as well as their types. XEmacs doesn't support machines
;; with word size less than 32, so it's OK to have that as the minimum.
(macrolet
- ((most-negative-fixnum-on-32-bit-machines () (lognot (1- (lsh 1 30))))
- (most-positive-fixnum-on-32-bit-machines () (lsh 1 30)))
+ ((most-positive-fixnum-on-32-bit-machines () (1- (lsh 1 30)))
+ (most-negative-fixnum-on-32-bit-machines ()
+ (lognot (most-positive-fixnum-on-32-bit-machines))))
(defun cl-non-fixnum-number-p (object)
"Return t if OBJECT is a number not guaranteed to be immediate."
(and (numberp object)
_______________________________________________
XEmacs-Patches mailing list
XEmacs-Patches(a)xemacs.org
http://lists.xemacs.org/mailman/listinfo/xemacs-patches
- 1 participants
- 0 comments
commit: Auto merge.
12 years, 11 months
Jeff Sparkes
Jeff Sparkes
changeset: 5500:01900734203a
tag: tip
parent: 5499:4b5b7dcc19d6
parent: 5498:eb4eeec50f25
user: Jeff Sparkes <jsparkes(a)gmail.com>
date: Tue May 03 08:13:21 2011 -0400
description:
Auto merge.
_______________________________________________
XEmacs-Patches mailing list
XEmacs-Patches(a)xemacs.org
http://lists.xemacs.org/mailman/listinfo/xemacs-patches
- 1 participants
- 0 comments
commit: Fix for issue745, linking on cygwin 1.7.
12 years, 11 months
Jeff Sparkes
Jeff Sparkes
changeset: 5499:4b5b7dcc19d6
parent: 5497:70af4098e14f
user: Jeff Sparkes <jsparkes(a)gmail.com>
date: Mon May 02 08:51:19 2011 -0400
files: ChangeLog configure.ac
description:
Fix for issue745, linking on cygwin 1.7.
Use /usr/lib/w32api first.
diff -r 70af4098e14f -r 4b5b7dcc19d6 ChangeLog
--- a/ChangeLog Mon May 02 10:51:26 2011 +0100
+++ b/ChangeLog Mon May 02 08:51:19 2011 -0400
＠＠ -1,3 +1,8 ＠＠
+2011-05-02 Jeff Sparkes <jsparkes(a)gmail.com>
+
+ * configure.ac (HAVE_MS_WINDOWS): On cygwin, use the w32api package
+ libraries in /usr/lib/w32api. Fix for tracker issue745.
+
2011-04-29 Stephen J. Turnbull <stephen(a)xemacs.org>
* XEmacs 21.5.31 "ginger" is released.
diff -r 70af4098e14f -r 4b5b7dcc19d6 configure.ac
--- a/configure.ac Mon May 02 10:51:26 2011 +0100
+++ b/configure.ac Mon May 02 08:51:19 2011 -0400
＠＠ -3243,7 +3243,7 ＠＠
fi
install_pp="$srcdir/lib-src/installexe.sh"
- XE_APPEND(-limm32 -lshell32 -lgdi32 -luser32 -lcomdlg32 -lcomctl32 -lole32 -luuid -lwinspool -lmpr, libs_system)
+ XE_APPEND(-L/usr/lib/w32api -limm32 -lshell32 -lgdi32 -luser32 -lcomdlg32 -lcomctl32 -lole32 -luuid -lwinspool -lmpr, libs_system)
if test "$with_dragndrop" != no; then
XE_APPEND(msw, dragndrop_proto)
with_dragndrop=yes
_______________________________________________
XEmacs-Patches mailing list
XEmacs-Patches(a)xemacs.org
http://lists.xemacs.org/mailman/listinfo/xemacs-patches
- 1 participants
- 0 comments