;; 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:
(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 ...) ...)
;;;
(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))
(if (and (cdr form) (null backwards))
(byte-compile-log
" all subforms of %s called for effect; deleted" form))
- (and backwards
- ;; Now optimize the rest of the forms. We need the return
- ;; values. We already did the car.
- (setcdr backwards
- (mapcar 'byte-optimize-form (cdr backwards)))
- (cons fn (nreverse backwards))))
+ (when backwards
+ ;; Now optimize the rest of the forms. We need the return
+ ;; values. We already did the car.
+ (setcdr backwards
+ (mapcar 'byte-optimize-form (cdr backwards))))
+ (cons fn (nreverse backwards)))
(cons fn (mapcar 'byte-optimize-form (cdr form)))))
((eq fn 'interactive)
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"
(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)))
(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 '+)))
(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)))))
;; 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
(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)
(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.
(defun byte-optimize-cond (form)
- ;; if any clauses have a literal nil as their test, throw them away.
- ;; if any clause has a literal non-nil constant as its test, throw
- ;; away all following clauses.
- (let (rest)
- ;; This must be first, to reduce (cond (t ...) (nil)) to (progn t ...)
- (while (setq rest (assq nil (cdr form)))
- (setq form (delq rest (copy-sequence form))))
- (if (memq nil (cdr form))
- (setq form (delq nil (copy-sequence form))))
- (setq rest form)
- (while (setq rest (cdr rest))
- (cond ((byte-compile-trueconstp (car-safe (car rest)))
- (cond ((eq rest (cdr form))
- (setq form
- (if (cdr (car rest))
- (if (cdr (cdr (car rest)))
- (cons 'progn (cdr (car rest)))
- (nth 1 (car rest)))
- (car (car rest)))))
- ((cdr rest)
- (setq form (copy-sequence form))
- (setcdr (memq (car rest) form) nil)))
- (setq rest nil)))))
- ;;
- ;; Turn (cond (( <x> )) ... ) into (or <x> (cond ... ))
- (if (eq 'cond (car-safe form))
- (let ((clauses (cdr form)))
- (if (and (consp (car clauses))
- (null (cdr (car clauses))))
- (list 'or (car (car clauses))
- (byte-optimize-cond
- (cons (car form) (cdr (cdr form)))))
- form))
- form))
+ (byte-optimize-cond-1 (cdr form)))
+
+(defun byte-optimize-cond-1 (clauses)
+ (cond
+ ((null clauses) nil)
+ ((consp (car clauses))
+ (nconc
+ (case (length (car clauses))
+ (1 `(or ,(nth 0 (car clauses))))
+ (2 `(if ,(nth 0 (car clauses)) ,(nth 1 (car clauses))))
+ (t `(if ,(nth 0 (car clauses)) (progn ,@(cdr (car clauses))))))
+ (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 <true-constant> <then> <else...>) ==> <then>
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)
;;; 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."
(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
byte-optimize-lapcode))))
nil)
+;; END SYNC WITH 20.7.
+
;;; byte-optimize.el ends here
projects / chise / xemacs-chise.git.1 / blobdiff