/[emacs]/emacs/lisp/emacs-lisp/byte-opt.el
ViewVC logotype

Diff of /emacs/lisp/emacs-lisp/byte-opt.el

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.64.2.6 by miles, Tue Nov 19 16:44:46 2002 UTC revision 1.64.2.7 by miles, Fri Apr 4 06:20:16 2003 UTC
# Line 1  Line 1 
1  ;;; byte-opt.el --- the optimization passes of the emacs-lisp byte compiler  ;;; byte-opt.el --- the optimization passes of the emacs-lisp byte compiler
2    
3  ;;; Copyright (c) 1991, 1994, 2000, 2001, 2002 Free Software Foundation, Inc.  ;;; Copyright (c) 1991, 1994, 2000, 2001, 2002, 2003 Free Software Foundation, Inc.
4    
5  ;; Author: Jamie Zawinski <jwz@lucid.com>  ;; Author: Jamie Zawinski <jwz@lucid.com>
6  ;;      Hallvard Furuseth <hbf@ulrik.uio.no>  ;;      Hallvard Furuseth <hbf@ulrik.uio.no>
# Line 31  Line 31 
31  ;; You can, however, make a faster pig."  ;; You can, however, make a faster pig."
32  ;;  ;;
33  ;; Or, to put it another way, the emacs byte compiler is a VW Bug.  This code  ;; Or, to put it another way, the emacs byte compiler is a VW Bug.  This code
34  ;; makes it be a VW Bug with fuel injection and a turbocharger...  You're  ;; makes it be a VW Bug with fuel injection and a turbocharger...  You're
35  ;; still not going to make it go faster than 70 mph, but it might be easier  ;; still not going to make it go faster than 70 mph, but it might be easier
36  ;; to get it there.  ;; to get it there.
37  ;;  ;;
# Line 62  Line 62 
62  ;; Simple defsubsts often produce forms like  ;; Simple defsubsts often produce forms like
63  ;;    (let ((v1 (f1)) (v2 (f2)) ...)  ;;    (let ((v1 (f1)) (v2 (f2)) ...)
64  ;;       (FN v1 v2 ...))  ;;       (FN v1 v2 ...))
65  ;; It would be nice if we could optimize this to  ;; It would be nice if we could optimize this to
66  ;;    (FN (f1) (f2) ...)  ;;    (FN (f1) (f2) ...)
67  ;; but we can't unless FN is dynamically-safe (it might be dynamically  ;; but we can't unless FN is dynamically-safe (it might be dynamically
68  ;; referring to the bindings that the lambda arglist established.)  ;; referring to the bindings that the lambda arglist established.)
69  ;; One of the uncountable lossages introduced by dynamic scope...  ;; One of the uncountable lossages introduced by dynamic scope...
70  ;;  ;;
71  ;; Maybe there should be a control-structure that says "turn on  ;; Maybe there should be a control-structure that says "turn on
72  ;; fast-and-loose type-assumptive optimizations here."  Then when  ;; fast-and-loose type-assumptive optimizations here."  Then when
73  ;; we see a form like (car foo) we can from then on assume that  ;; we see a form like (car foo) we can from then on assume that
74  ;; the variable foo is of type cons, and optimize based on that.  ;; the variable foo is of type cons, and optimize based on that.
75  ;; But, this won't win much because of (you guessed it) dynamic  ;; But, this won't win much because of (you guessed it) dynamic
76  ;; scope.  Anything down the stack could change the value.  ;; scope.  Anything down the stack could change the value.
77  ;; (Another reason it doesn't work is that it is perfectly valid  ;; (Another reason it doesn't work is that it is perfectly valid
78  ;; to call car with a null argument.)  A better approach might  ;; to call car with a null argument.)  A better approach might
# Line 107  Line 107 
107  ;;  ;;
108  ;; However, if there was even a single let-binding around the COND,  ;; However, if there was even a single let-binding around the COND,
109  ;; it could not be byte-compiled, because there would be an "unbind"  ;; it could not be byte-compiled, because there would be an "unbind"
110  ;; byte-op between the final "call" and "return."  Adding a  ;; byte-op between the final "call" and "return."  Adding a
111  ;; Bunbind_all byteop would fix this.  ;; Bunbind_all byteop would fix this.
112  ;;  ;;
113  ;;   (defun foo (x y z) ... (foo a b c))  ;;   (defun foo (x y z) ... (foo a b c))
# Line 129  Line 129 
129  ;;  ;;
130  ;; Wouldn't it be nice if Emacs Lisp had lexical scope.  ;; Wouldn't it be nice if Emacs Lisp had lexical scope.
131  ;;  ;;
132  ;; Idea: the form (lexical-scope) in a file means that the file may be  ;; Idea: the form (lexical-scope) in a file means that the file may be
133  ;; compiled lexically.  This proclamation is file-local.  Then, within  ;; compiled lexically.  This proclamation is file-local.  Then, within
134  ;; that file, "let" would establish lexical bindings, and "let-dynamic"  ;; that file, "let" would establish lexical bindings, and "let-dynamic"
135  ;; would do things the old way.  (Or we could use CL "declare" forms.)  ;; would do things the old way.  (Or we could use CL "declare" forms.)
136  ;; We'd have to notice defvars and defconsts, since those variables should  ;; We'd have to notice defvars and defconsts, since those variables should
# Line 140  Line 140 
140  ;; in the file being compiled (doing a boundp check isn't good enough.)  ;; in the file being compiled (doing a boundp check isn't good enough.)
141  ;; Fdefvar() would have to be modified to add something to the plist.  ;; Fdefvar() would have to be modified to add something to the plist.
142  ;;  ;;
143  ;; A major disadvantage of this scheme is that the interpreter and compiler  ;; A major disadvantage of this scheme is that the interpreter and compiler
144  ;; would have different semantics for files compiled with (dynamic-scope).    ;; would have different semantics for files compiled with (dynamic-scope).
145  ;; Since this would be a file-local optimization, there would be no way to  ;; Since this would be a file-local optimization, there would be no way to
146  ;; modify the interpreter to obey this (unless the loader was hacked  ;; modify the interpreter to obey this (unless the loader was hacked
147  ;; in some grody way, but that's a really bad idea.)  ;; in some grody way, but that's a really bad idea.)
148    
149  ;; Other things to consider:  ;; Other things to consider:
# Line 157  Line 157 
157  ;;;;; error free also they may act as true-constants.  ;;;;; error free also they may act as true-constants.
158    
159  ;;;(disassemble (lambda (x) (and (point) (foo))))  ;;;(disassemble (lambda (x) (and (point) (foo))))
160  ;;;;; When  ;;;;; When
161  ;;;;;   - all but one arguments to a function are constant  ;;;;;   - all but one arguments to a function are constant
162  ;;;;;   - the non-constant argument is an if-expression (cond-expression?)  ;;;;;   - the non-constant argument is an if-expression (cond-expression?)
163  ;;;;; then the outer function can be distributed.  If the guarding  ;;;;; then the outer function can be distributed.  If the guarding
# Line 252  Line 252 
252  (defun byte-inline-lapcode (lap)  (defun byte-inline-lapcode (lap)
253    (setq byte-compile-output (nconc (nreverse lap) byte-compile-output)))    (setq byte-compile-output (nconc (nreverse lap) byte-compile-output)))
254    
   
255  (defun byte-compile-inline-expand (form)  (defun byte-compile-inline-expand (form)
256    (let* ((name (car form))    (let* ((name (car form))
257           (fn (or (cdr (assq name byte-compile-function-environment))           (fn (or (cdr (assq name byte-compile-function-environment))
# Line 287  Line 286 
286              form))))))              form))))))
287    
288  ;;; ((lambda ...) ...)  ;;; ((lambda ...) ...)
289  ;;;  ;;;
290  (defun byte-compile-unfold-lambda (form &optional name)  (defun byte-compile-unfold-lambda (form &optional name)
291    (or name (setq name "anonymous lambda"))    (or name (setq name "anonymous lambda"))
292    (let ((lambda (car form))    (let ((lambda (car form))
# Line 340  Line 339 
339                  (byte-compile-warn                  (byte-compile-warn
340                   "attempt to open-code `%s' with too many arguments" name))                   "attempt to open-code `%s' with too many arguments" name))
341              form)              form)
342            
343          ;; The following leads to infinite recursion when loading a          ;; The following leads to infinite recursion when loading a
344          ;; file containing `(defsubst f () (f))', and then trying to          ;; file containing `(defsubst f () (f))', and then trying to
345          ;; byte-compile that file.          ;; byte-compile that file.
346          ;(setq body (mapcar 'byte-optimize-form body)))          ;(setq body (mapcar 'byte-optimize-form body)))
347            
348          (let ((newform          (let ((newform
349                 (if bindings                 (if bindings
350                     (cons 'let (cons (nreverse bindings) body))                     (cons 'let (cons (nreverse bindings) body))
351                   (cons 'progn body))))                   (cons 'progn body))))
# Line 429  Line 428 
428               (cons (byte-optimize-form (nth 1 form) t)               (cons (byte-optimize-form (nth 1 form) t)
429                 (cons (byte-optimize-form (nth 2 form) for-effect)                 (cons (byte-optimize-form (nth 2 form) for-effect)
430                       (byte-optimize-body (cdr (cdr (cdr form))) t)))))                       (byte-optimize-body (cdr (cdr (cdr form))) t)))))
431              
432            ((memq fn '(save-excursion save-restriction save-current-buffer))            ((memq fn '(save-excursion save-restriction save-current-buffer))
433             ;; those subrs which have an implicit progn; it's not quite good             ;; those subrs which have an implicit progn; it's not quite good
434             ;; enough to treat these like normal function calls.             ;; enough to treat these like normal function calls.
435             ;; This can turn (save-excursion ...) into (save-excursion) which             ;; This can turn (save-excursion ...) into (save-excursion) which
436             ;; will be optimized away in the lap-optimize pass.             ;; will be optimized away in the lap-optimize pass.
437             (cons fn (byte-optimize-body (cdr form) for-effect)))             (cons fn (byte-optimize-body (cdr form) for-effect)))
438              
439            ((eq fn 'with-output-to-temp-buffer)            ((eq fn 'with-output-to-temp-buffer)
440             ;; this is just like the above, except for the first argument.             ;; this is just like the above, except for the first argument.
441             (cons fn             (cons fn
442               (cons               (cons
443                (byte-optimize-form (nth 1 form) nil)                (byte-optimize-form (nth 1 form) nil)
444                (byte-optimize-body (cdr (cdr form)) for-effect))))                (byte-optimize-body (cdr (cdr form)) for-effect))))
445              
446            ((eq fn 'if)            ((eq fn 'if)
447             (when (< (length form) 3)             (when (< (length form) 3)
448               (byte-compile-warn "too few arguments for `if'"))               (byte-compile-warn "too few arguments for `if'"))
# Line 452  Line 451 
451                 (cons                 (cons
452                  (byte-optimize-form (nth 2 form) for-effect)                  (byte-optimize-form (nth 2 form) for-effect)
453                  (byte-optimize-body (nthcdr 3 form) for-effect)))))                  (byte-optimize-body (nthcdr 3 form) for-effect)))))
454              
455            ((memq fn '(and or))  ; remember, and/or are control structures.            ((memq fn '(and or))  ; remember, and/or are control structures.
456             ;; take forms off the back until we can't any more.             ;; take forms off the back until we can't any more.
457             ;; In the future it could conceivably be a problem that the             ;; In the future it could conceivably be a problem that the
# Line 469  Line 468 
468                       (byte-compile-log                       (byte-compile-log
469                        "  all subforms of %s called for effect; deleted" form))                        "  all subforms of %s called for effect; deleted" form))
470                   (and backwards                   (and backwards
471                        (cons fn (nreverse backwards))))                        (cons fn (nreverse (mapcar 'byte-optimize-form backwards)))))
472               (cons fn (mapcar 'byte-optimize-form (cdr form)))))               (cons fn (mapcar 'byte-optimize-form (cdr form)))))
473    
474            ((eq fn 'interactive)            ((eq fn 'interactive)
475             (byte-compile-warn "misplaced interactive spec: `%s'"             (byte-compile-warn "misplaced interactive spec: `%s'"
476                                (prin1-to-string form))                                (prin1-to-string form))
477             nil)             nil)
478              
479            ((memq fn '(defun defmacro function            ((memq fn '(defun defmacro function
480                        condition-case save-window-excursion))                        condition-case save-window-excursion))
481             ;; These forms are compiled as constants or by breaking out             ;; These forms are compiled as constants or by breaking out
# Line 492  Line 491 
491             (cons fn             (cons fn
492                   (cons (byte-optimize-form (nth 1 form) for-effect)                   (cons (byte-optimize-form (nth 1 form) for-effect)
493                         (cdr (cdr form)))))                         (cdr (cdr form)))))
494              
495            ((eq fn 'catch)            ((eq fn 'catch)
496             ;; the body of a catch is compiled (and thus optimized) as a             ;; the body of a catch is compiled (and thus optimized) as a
497             ;; top-level form, so don't do it here.  The tag is never             ;; top-level form, so don't do it here.  The tag is never
# Line 502  Line 501 
501                   (cons (byte-optimize-form (nth 1 form) nil)                   (cons (byte-optimize-form (nth 1 form) nil)
502                         (cdr (cdr form)))))                         (cdr (cdr form)))))
503    
504              ((eq fn 'ignore)
505               ;; Don't treat the args to `ignore' as being
506               ;; computed for effect.  We want to avoid the warnings
507               ;; that might occur if they were treated that way.
508               ;; However, don't actually bother calling `ignore'.
509               `(prog1 nil . ,(mapcar 'byte-optimize-form (cdr form))))
510    
511              ;; If optimization is on, this is the only place that macros are
512              ;; expanded.  If optimization is off, then macroexpansion happens
513              ;; in byte-compile-form.  Otherwise, the macros are already expanded
514              ;; by the time that is reached.
515              ((not (eq form
516                        (setq form (macroexpand form
517                                                byte-compile-macro-environment))))
518               (byte-optimize-form form for-effect))
519    
520            ;; Support compiler macros as in cl.el.            ;; Support compiler macros as in cl.el.
521            ((and (fboundp 'compiler-macroexpand)            ((and (fboundp 'compiler-macroexpand)
522                  (symbolp (car-safe form))                  (symbolp (car-safe form))
# Line 509  Line 524 
524                  (not (eq form                  (not (eq form
525                           (setq form (compiler-macroexpand form)))))                           (setq form (compiler-macroexpand form)))))
526             (byte-optimize-form form for-effect))             (byte-optimize-form form for-effect))
527              
528            ((not (symbolp fn))            ((not (symbolp fn))
529             (byte-compile-warn "`%s' is a malformed function"             (byte-compile-warn "`%s' is a malformed function"
530                                (prin1-to-string fn))                                (prin1-to-string fn))
# Line 518  Line 533 
533            ((and for-effect (setq tmp (get fn 'side-effect-free))            ((and for-effect (setq tmp (get fn 'side-effect-free))
534                  (or byte-compile-delete-errors                  (or byte-compile-delete-errors
535                      (eq tmp 'error-free)                      (eq tmp 'error-free)
536                        ;; Detect the expansion of (pop foo).
537                        ;; There is no need to compile the call to `car' there.
538                        (and (eq fn 'car)
539                             (eq (car-safe (cadr form)) 'prog1)
540                             (let ((var (cadr (cadr form)))
541                                   (last (nth 2 (cadr form))))
542                               (and (symbolp var)
543                                    (null (nthcdr 3 (cadr form)))
544                                    (eq (car-safe last) 'setq)
545                                    (eq (cadr last) var)
546                                    (eq (car-safe (nth 2 last)) 'cdr)
547                                    (eq (cadr (nth 2 last)) var))))
548                      (progn                      (progn
549                        (byte-compile-warn "`%s' called for effect"                        (byte-compile-warn "`%s' called for effect"
550                                           (prin1-to-string form))                                           (prin1-to-string (car form)))
551                        nil)))                        nil)))
552             (byte-compile-log "  %s called for effect; deleted" fn)             (byte-compile-log "  %s called for effect; deleted" fn)
553             ;; appending a nil here might not be necessary, but it can't hurt.             ;; appending a nil here might not be necessary, but it can't hurt.
554             (byte-optimize-form             (byte-optimize-form
555              (cons 'progn (append (cdr form) '(nil))) t))              (cons 'progn (append (cdr form) '(nil))) t))
556              
557            (t            (t
558             ;; Otherwise, no args can be considered to be for-effect,             ;; Otherwise, no args can be considered to be for-effect,
559             ;; even if the called function is for-effect, because we             ;; even if the called function is for-effect, because we
# Line 596  Line 623 
623           ((keywordp ,form))))           ((keywordp ,form))))
624    
625  ;; If the function is being called with constant numeric args,  ;; If the function is being called with constant numeric args,
626  ;; evaluate as much as possible at compile-time.  This optimizer  ;; evaluate as much as possible at compile-time.  This optimizer
627  ;; assumes that the function is associative, like + or *.  ;; assumes that the function is associative, like + or *.
628  (defun byte-optimize-associative-math (form)  (defun byte-optimize-associative-math (form)
629    (let ((args nil)    (let ((args nil)
# Line 790  Line 817 
817                                  (cons (/ (nth 1 form) last)                                  (cons (/ (nth 1 form) last)
818                                        (byte-compile-butlast (cdr (cdr form)))))                                        (byte-compile-butlast (cdr (cdr form)))))
819                       last nil))))                       last nil))))
820      (cond      (cond
821  ;;;       ((null (cdr (cdr form)))  ;;;       ((null (cdr (cdr form)))
822  ;;;        (nth 1 form))  ;;;        (nth 1 form))
823            ((eq (nth 1 form) 0)            ((eq (nth 1 form) 0)
# Line 886  Line 913 
913  (put 'cdr-safe 'byte-optimizer 'byte-optimize-predicate)  (put 'cdr-safe 'byte-optimizer 'byte-optimize-predicate)
914    
915    
916  ;; I'm not convinced that this is necessary.  Doesn't the optimizer loop  ;; I'm not convinced that this is necessary.  Doesn't the optimizer loop
917  ;; take care of this? - Jamie  ;; take care of this? - Jamie
918  ;; I think this may some times be necessary to reduce ie (quote 5) to 5,  ;; I think this may some times be necessary to reduce ie (quote 5) to 5,
919  ;; so arithmetic optimizers recognize the numeric constant.  - Hallvard  ;; so arithmetic optimizers recognize the numeric constant.  - Hallvard
# Line 1071  Line 1098 
1098    
1099  (put 'nth 'byte-optimizer 'byte-optimize-nth)  (put 'nth 'byte-optimizer 'byte-optimize-nth)
1100  (defun byte-optimize-nth (form)  (defun byte-optimize-nth (form)
1101    (if (and (= (safe-length form) 3) (memq (nth 1 form) '(0 1)))    (if (= (safe-length form) 3)
1102        (list 'car (if (zerop (nth 1 form))        (if (memq (nth 1 form) '(0 1))
1103                       (nth 2 form)            (list 'car (if (zerop (nth 1 form))
1104                     (list 'cdr (nth 2 form))))                           (nth 2 form)
1105      (byte-optimize-predicate form)))                         (list 'cdr (nth 2 form))))
1106            (byte-optimize-predicate form))
1107        form))
1108    
1109  (put 'nthcdr 'byte-optimizer 'byte-optimize-nthcdr)  (put 'nthcdr 'byte-optimizer 'byte-optimize-nthcdr)
1110  (defun byte-optimize-nthcdr (form)  (defun byte-optimize-nthcdr (form)
1111    (if (and (= (safe-length form) 3) (not (memq (nth 1 form) '(0 1 2))))    (if (= (safe-length form) 3)
1112        (byte-optimize-predicate form)        (if (memq (nth 1 form) '(0 1 2))
1113      (let ((count (nth 1 form)))            (let ((count (nth 1 form)))
1114        (setq form (nth 2 form))              (setq form (nth 2 form))
1115        (while (>= (setq count (1- count)) 0)              (while (>= (setq count (1- count)) 0)
1116          (setq form (list 'cdr form)))                (setq form (list 'cdr form)))
1117        form)))              form)
1118            (byte-optimize-predicate form))
1119        form))
1120    
1121  (put 'concat 'byte-optimizer 'byte-optimize-concat)  (put 'concat 'byte-optimizer 'byte-optimize-concat)
1122  (defun byte-optimize-concat (form)  (defun byte-optimize-concat (form)
# Line 1100  Line 1131 
1131        form)))        form)))
1132    
1133  ;; Avoid having to write forward-... with a negative arg for speed.  ;; Avoid having to write forward-... with a negative arg for speed.
1134    ;; Fixme: don't be limited to constant args.
1135  (put 'backward-char 'byte-optimizer 'byte-optimize-backward-char)  (put 'backward-char 'byte-optimizer 'byte-optimize-backward-char)
1136  (defun byte-optimize-backward-char (form)  (defun byte-optimize-backward-char (form)
1137    (cond ((and (= 2 (safe-length form))    (cond ((and (= 2 (safe-length form))
# Line 1125  Line 1157 
1157          ((= 1 (safe-length form))          ((= 1 (safe-length form))
1158           '(char-after (1- (point))))           '(char-after (1- (point))))
1159          (t form)))          (t form)))
1160    
1161    ;; Fixme: delete-char -> delete-region (byte-coded)
1162    ;; optimize string-as-unibyte, string-as-multibyte, string-make-unibyte,
1163    ;; string-make-multibyte for constant args.
1164    
1165    (put 'featurep 'byte-optimizer 'byte-optimize-featurep)
1166    (defun byte-optimize-featurep (form)
1167      ;; Emacs-21's byte-code doesn't run under XEmacs anyway, so we can
1168      ;; safely optimize away this test.
1169      (if (equal '((quote xemacs)) (cdr-safe form))
1170          nil
1171        form))
1172    
1173    (put 'set 'byte-optimizer 'byte-optimize-set)
1174    (defun byte-optimize-set (form)
1175      (let ((var (car-safe (cdr-safe form))))
1176        (cond
1177         ((and (eq (car-safe var) 'quote) (consp (cdr var)))
1178          `(setq ,(cadr var) ,@(cddr form)))
1179         ((and (eq (car-safe var) 'make-local-variable)
1180               (eq (car-safe (setq var (car-safe (cdr var)))) 'quote)
1181               (consp (cdr var)))
1182          `(progn ,(cadr form) (setq ,(cadr var) ,@(cddr form))))
1183         (t form))))
1184    
1185  ;;; enumerating those functions which need not be called if the returned  ;;; enumerating those functions which need not be called if the returned
1186  ;;; value is not used.  That is, something like  ;;; value is not used.  That is, something like
1187  ;;;    (progn (list (something-with-side-effects) (yow))  ;;;    (progn (list (something-with-side-effects) (yow))
1188  ;;;           (foo))  ;;;           (foo))
# Line 1143  Line 1199 
1199  ;;; state, so that constant folding them would be wrong,  ;;; state, so that constant folding them would be wrong,
1200  ;;; but we don't do constant folding based on this list.  ;;; but we don't do constant folding based on this list.
1201    
1202    ;;; However, at present the only optimization we normally do
1203    ;;; is delete calls that need not occur, and we only do that
1204    ;;; with the error-free functions.
1205    
1206  ;;; I wonder if I missed any :-\)  ;;; I wonder if I missed any :-\)
1207  (let ((side-effect-free-fns  (let ((side-effect-free-fns
1208         '(% * + - / /= 1+ 1- < <= = > >= abs acos append aref ash asin atan         '(% * + - / /= 1+ 1- < <= = > >= abs acos append aref ash asin atan
# Line 1167  Line 1227 
1227           length local-variable-if-set-p local-variable-p log log10 logand           length local-variable-if-set-p local-variable-p log log10 logand
1228           logb logior lognot logxor lsh           logb logior lognot logxor lsh
1229           make-list make-string make-symbol           make-list make-string make-symbol
1230           marker-buffer max member memq min mod           marker-buffer max member memq min mod multibyte-char-to-unibyte
1231           next-window nth nthcdr number-to-string           next-window nth nthcdr number-to-string
1232           parse-colon-path plist-get plist-member           parse-colon-path plist-get plist-member
1233           prefix-numeric-value previous-window prin1-to-string propertize           prefix-numeric-value previous-window prin1-to-string propertize
# Line 1175  Line 1235 
1235           region-beginning region-end reverse round           region-beginning region-end reverse round
1236           sin sqrt string string< string= string-equal string-lessp string-to-char           sin sqrt string string< string= string-equal string-lessp string-to-char
1237           string-to-int string-to-number substring sxhash symbol-function           string-to-int string-to-number substring sxhash symbol-function
1238           symbol-name symbol-plist symbol-value           symbol-name symbol-plist symbol-value string-make-unibyte
1239             string-make-multibyte string-as-multibyte string-as-unibyte
1240           tan truncate           tan truncate
1241           unibyte-char-to-multibyte upcase user-full-name           unibyte-char-to-multibyte upcase user-full-name
1242           user-login-name user-original-login-name user-variable-p           user-login-name user-original-login-name user-variable-p
# Line 1185  Line 1246 
1246           zerop))           zerop))
1247        (side-effect-and-error-free-fns        (side-effect-and-error-free-fns
1248         '(arrayp atom         '(arrayp atom
1249           bobp bolp bool-vector-p           bobp bolp bool-vector-p
1250           buffer-end buffer-list buffer-size buffer-string bufferp           buffer-end buffer-list buffer-size buffer-string bufferp
1251           car-safe case-table-p cdr-safe char-or-string-p commandp cons consp           car-safe case-table-p cdr-safe char-or-string-p commandp cons consp
1252           current-buffer current-global-map current-indentation           current-buffer current-global-map current-indentation
# Line 1402  Line 1463 
1463      byte-current-buffer byte-interactive-p byte-stack-ref))      byte-current-buffer byte-interactive-p byte-stack-ref))
1464    
1465  (defconst byte-compile-side-effect-free-ops  (defconst byte-compile-side-effect-free-ops
1466    (nconc    (nconc
1467     '(byte-varref byte-nth byte-memq byte-car byte-cdr byte-length byte-aref     '(byte-varref byte-nth byte-memq byte-car byte-cdr byte-length byte-aref
1468       byte-symbol-value byte-get byte-concat2 byte-concat3 byte-sub1 byte-add1       byte-symbol-value byte-get byte-concat2 byte-concat3 byte-sub1 byte-add1
1469       byte-eqlsign byte-gtr byte-lss byte-leq byte-geq byte-diff byte-negate       byte-eqlsign byte-gtr byte-lss byte-leq byte-geq byte-diff byte-negate
# Line 1434  Line 1495 
1495  ;;;     varbind pop-up-windows  ;;;     varbind pop-up-windows
1496  ;;;     not  ;;;     not
1497  ;;;  ;;;
1498  ;;; we break the program, because it will appear that pop-up-windows and  ;;; we break the program, because it will appear that pop-up-windows and
1499  ;;; old-pop-ups are not EQ when really they are.  So we have to know what  ;;; old-pop-ups are not EQ when really they are.  So we have to know what
1500  ;;; the BOOL variables are, and not perform this optimization on them.  ;;; the BOOL variables are, and not perform this optimization on them.
1501    
# Line 1628  Line 1689 
1689                ;; goto-X-if-non-nil goto-Y X:  -->  goto-Y-if-nil     X:                ;; goto-X-if-non-nil goto-Y X:  -->  goto-Y-if-nil     X:
1690                ;;                ;;
1691                ;; it is wrong to do the same thing for the -else-pop variants.                ;; it is wrong to do the same thing for the -else-pop variants.
1692                ;;                ;;
1693                ((and (or (eq 'byte-goto-if-nil (car lap0))                ((and (or (eq 'byte-goto-if-nil (car lap0))
1694                          (eq 'byte-goto-if-not-nil (car lap0)))  ; gotoX                          (eq 'byte-goto-if-not-nil (car lap0)))  ; gotoX
1695                      (eq 'byte-goto (car lap1))                  ; gotoY                      (eq 'byte-goto (car lap1))                  ; gotoY
# Line 1732  Line 1793 
1793                                     str (concat str " %s")                                     str (concat str " %s")
1794                                     i (1+ i))))                                     i (1+ i))))
1795                   (if opt-p                   (if opt-p
1796                       (let ((tagstr                       (let ((tagstr
1797                              (if (eq 'TAG (car (car tmp)))                              (if (eq 'TAG (car (car tmp)))
1798                                  (format "%d:" (car (cdr (car tmp))))                                  (format "%d:" (car (cdr (car tmp))))
1799                                (or (car tmp) ""))))                                (or (car tmp) ""))))
# Line 1924  Line 1985 
1985                                       (byte-goto-if-not-nil-else-pop .                                       (byte-goto-if-not-nil-else-pop .
1986                                        byte-goto-if-nil-else-pop))))                                        byte-goto-if-nil-else-pop))))
1987                          newtag)                          newtag)
1988                      
1989                    (nth 1 newtag)                    (nth 1 newtag)
1990                    )                    )
1991                   (setcdr tmp (cons (setcdr lap0 newtag) (cdr tmp)))                   (setcdr tmp (cons (setcdr lap0 newtag) (cdr tmp)))

Legend:
Removed from v.1.64.2.6  
changed lines
  Added in v.1.64.2.7

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26