X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=lisp%2Fbyte-optimize.el;h=8ae9d2418659a4ec09ea3c1e8bd796688a6b3e61;hb=8ccf542c980645ba3c02074a8bc67cd4fc8e7a1f;hp=f591e82d5c6710e6aa800aee828cb8932e001ff1;hpb=0c693dc08f0794304711787b2eb47c144ea4bef1;p=chise%2Fxemacs-chise.git.1 diff --git a/lisp/byte-optimize.el b/lisp/byte-optimize.el index f591e82..8ae9d24 100644 --- a/lisp/byte-optimize.el +++ b/lisp/byte-optimize.el @@ -24,7 +24,11 @@ ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, ;; Boston, MA 02111-1307, USA. -;;; Synched up with: FSF 20.7. +;;; Synched up with: FSF 20.7 except where marked. +;;; [[ Synched up with: FSF 20.7. ]] +;;; DO NOT PUT IN AN INVALID SYNC MESSAGE WHEN YOU DO A PARTIAL SYNC. --ben + +;; BEGIN SYNC WITH 20.7. ;;; Commentary: @@ -292,8 +296,10 @@ (compiled-function-constants fn) (compiled-function-stack-depth fn))) (cdr form))) - (if (not (eq (car fn) 'lambda)) (error "%s is not a lambda" name)) - (cons fn (cdr form))))))) + (if (eq (car-safe fn) 'lambda) + (cons fn (cdr form)) + ;; Give up on inlining. + form)))))) ;;; ((lambda ...) ...) ;;; @@ -351,6 +357,9 @@ (byte-compile-warn "attempt to open-code %s with too many arguments" name)) form) + ;; This line, introduced in v1.10, can cause an infinite + ;; recursion when inlining recursive defsubst's +; (setq body (mapcar 'byte-optimize-form body)) (let ((newform (if bindings (cons 'let (cons (nreverse bindings) body)) @@ -520,6 +529,14 @@ byte-compile-macro-environment)))) (byte-optimize-form form for-effect)) + ;; 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))))) + (byte-optimize-form form for-effect)) + ((not (symbolp fn)) (or (eq 'mocklisp (car-safe fn)) ; ha! (byte-compile-warn "%s is a malformed function" @@ -567,7 +584,8 @@ (progn ;; (if (equal form new) (error "bogus optimizer -- %s" opt)) (byte-compile-log " %s\t==>\t%s" form new) - (byte-optimize-form new for-effect)) + (setq new (byte-optimize-form new for-effect)) + new) form))) @@ -699,12 +717,14 @@ (list (apply fun (nreverse constants))))))))) form)) +;; END SYNC WITH 20.7. + ;;; It is not safe to optimize calls to arithmetic ops with one arg ;;; away entirely (actually, it would be safe if we know the sole arg ;;; is not a marker or if it appears in other arithmetic). ;;; But this degree of paranoia is normally unjustified, so optimize unless -;;; the user has done (declaim (safety 3)). Implemented in bytecomp.el. +;;; the user has done (declaim (optimize (safety 3))). See bytecomp.el. (defun byte-optimize-plus (form) (byte-optimize-predicate (byte-optimize-delay-constants-math form 1 '+))) @@ -729,9 +749,15 @@ (decf (nth 1 form) last) (butlast form)) - ;; (- 0 x ...) --> (- (- x) ...) - ((and (eq 0 (nth 1 form)) (>= (length form) 3)) - `(- (- ,(nth 2 form)) ,@(nthcdr 3 form))) + ;; (- 0 ...) --> + ((eq 0 (nth 1 form)) + (case (length form) + ;; (- 0) --> 0 + (2 0) + ;; (- 0 x) --> (- x) + (3 `(- ,(nth 2 form))) + ;; (- 0 x y ...) --> (- (- x) y ...) + (t `(- (- ,(nth 2 form)) ,@(nthcdr 3 form))))) (t (byte-optimize-predicate form))))) @@ -756,6 +782,8 @@ ;; We don't have to check for divide-by-zero because `/' does. (t (byte-optimize-predicate form))))) +;; BEGIN SYNC WITH 20.7. + (defun byte-optimize-logmumble (form) (setq form (byte-optimize-delay-constants-math form 1 (car form))) (byte-optimize-predicate @@ -849,13 +877,13 @@ (put 'max 'byte-optimizer 'byte-optimize-associative-math) (put 'min 'byte-optimizer 'byte-optimize-associative-math) -(put '= 'byte-optimizer 'byte-optimize-binary-predicate) (put 'eq 'byte-optimizer 'byte-optimize-binary-predicate) (put 'eql 'byte-optimizer 'byte-optimize-binary-predicate) (put 'equal 'byte-optimizer 'byte-optimize-binary-predicate) (put 'string= 'byte-optimizer 'byte-optimize-binary-predicate) (put 'string-equal 'byte-optimizer 'byte-optimize-binary-predicate) +(put '= 'byte-optimizer 'byte-optimize-predicate) (put '< 'byte-optimizer 'byte-optimize-predicate) (put '> 'byte-optimizer 'byte-optimize-predicate) (put '<= 'byte-optimizer 'byte-optimize-predicate) @@ -939,6 +967,8 @@ (byte-optimize-predicate form) (nth 1 form)))) +;; END SYNC WITH 20.7. + ;;; For the byte optimizer, `cond' is just overly sweet syntactic sugar. ;;; So we rewrite (cond ...) in terms of `if' and `or', ;;; which are easier to optimize. @@ -957,6 +987,8 @@ (when (cdr clauses) (list (byte-optimize-cond-1 (cdr clauses)))))) (t (error "malformed cond clause %s" (car clauses))))) +;; BEGIN SYNC WITH 20.7. + (defun byte-optimize-if (form) ;; (if ) ==> ;; (if ) ==> (progn ) @@ -1349,7 +1381,9 @@ tags))))))) ((cond ((eq op 'byte-constant2) (setq op 'byte-constant) t) ((memq op byte-constref-ops))) - (setq tmp (aref constvec offset) + (setq tmp (if (>= offset (length constvec)) + (list 'out-of-range offset) + (aref constvec offset)) offset (if (eq op 'byte-constant) (byte-compile-get-constant tmp) (or (assq tmp byte-compile-variables) @@ -1461,33 +1495,7 @@ ;;; variables. ;(defconst byte-boolean-vars -; '(abbrev-all-caps purify-flag find-file-compare-truenames -; find-file-use-truenames delete-auto-save-files byte-metering-on -; x-seppuku-on-epipe zmacs-regions zmacs-region-active-p -; zmacs-region-stays atomic-extent-goto-char-p -; suppress-early-error-handler-backtrace noninteractive -; inhibit-early-packages inhibit-autoloads debug-paths -; inhibit-site-lisp debug-on-quit debug-on-next-call -; modifier-keys-are-sticky x-allow-sendevents -; mswindows-dynamic-frame-resize focus-follows-mouse -; inhibit-input-event-recording enable-multibyte-characters -; disable-auto-save-when-buffer-shrinks -; allow-deletion-of-last-visible-frame indent-tabs-mode -; load-in-progress load-warn-when-source-newer -; load-warn-when-source-only load-ignore-elc-files -; load-force-doc-strings fail-on-bucky-bit-character-escapes -; popup-menu-titles menubar-show-keybindings completion-ignore-case -; canna-empty-info canna-through-info canna-underline -; canna-inhibit-hankakukana enable-multibyte-characters -; re-short-flag x-handle-non-fully-specified-fonts -; print-escape-newlines print-readably delete-exited-processes -; windowed-process-io visible-bell no-redraw-on-reenter -; cursor-in-echo-area inhibit-warning-display -; column-number-start-at-one parse-sexp-ignore-comments -; words-include-escapes scroll-on-clipped-lines) -; "DEFVAR_BOOL variables. Giving these any non-nil value sets them to t. -;If this does not enumerate all DEFVAR_BOOL variables, the byte-optimizer -;may generate incorrect code.") +; ...) (defun byte-optimize-lapcode (lap &optional for-effect) "Simple peephole optimizer. LAP is both modified and returned." @@ -1948,14 +1956,16 @@ (while rest (setq lap0 (car rest) lap1 (nth 1 rest)) - (case (car lap0) - ((byte-varref byte-varset byte-varbind) - (incf (gethash (cdr lap0) variable-frequency 0)) - (unless (memq (cdr lap0) byte-compile-variables) - (push (cdr lap0) byte-compile-variables))) - ((byte-constant) - (unless (memq (cdr lap0) byte-compile-constants) - (push (cdr lap0) byte-compile-constants)))) + (if (memq (car lap0) byte-constref-ops) + (if (not (eq (car lap0) 'byte-constant)) + (progn + (incf (gethash (cdr lap0) variable-frequency 0)) + (or (memq (cdr lap0) byte-compile-variables) + (setq byte-compile-variables + (cons (cdr lap0) byte-compile-variables)))) + (or (memq (cdr lap0) byte-compile-constants) + (setq byte-compile-constants (cons (cdr lap0) + byte-compile-constants))))) (cond (;; ;; const-C varset-X const-C --> const-C dup varset-X ;; const-C varbind-X const-C --> const-C dup varbind-X @@ -2041,4 +2051,6 @@ byte-optimize-lapcode)))) nil) +;; END SYNC WITH 20.7. + ;;; byte-optimize.el ends here