Mercurial > hg > xemacs-beta

comparison lisp/byte-optimize.el @ 280:7df0dd720c89 r21-0b38

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r21-0b38
author cvs
date Mon, 13 Aug 2007 10:32:22 +0200
parents 6330739388db
children a4f53d9b3154
comparison
equal deleted inserted replaced
279:c20b2fb5bb0a 280:7df0dd720c89
1027 (put 'cond 'byte-optimizer 'byte-optimize-cond) 1027 (put 'cond 'byte-optimizer 'byte-optimize-cond)
1028 (put 'if 'byte-optimizer 'byte-optimize-if) 1028 (put 'if 'byte-optimizer 'byte-optimize-if)
1029 (put 'while 'byte-optimizer 'byte-optimize-while) 1029 (put 'while 'byte-optimizer 'byte-optimize-while)
1030 1030
1031 ;; byte-compile-negation-optimizer lives in bytecomp.el 1031 ;; byte-compile-negation-optimizer lives in bytecomp.el
1032 (put '/= 'byte-optimizer 'byte-compile-negation-optimizer) 1032 ;(put '/= 'byte-optimizer 'byte-compile-negation-optimizer)
1033 (put 'atom 'byte-optimizer 'byte-compile-negation-optimizer) 1033 (put 'atom 'byte-optimizer 'byte-compile-negation-optimizer)
1034 (put 'nlistp 'byte-optimizer 'byte-compile-negation-optimizer) 1034 (put 'nlistp 'byte-optimizer 'byte-compile-negation-optimizer)
1035 1035
1036 1036
1037 (defun byte-optimize-funcall (form) 1037 (defun byte-optimize-funcall (form)
1394 ;;; 1394 ;;;
1395 ;;; we break the program, because it will appear that pop-up-windows and 1395 ;;; we break the program, because it will appear that pop-up-windows and
1396 ;;; old-pop-ups are not EQ when really they are. So we have to know what 1396 ;;; old-pop-ups are not EQ when really they are. So we have to know what
1397 ;;; the BOOL variables are, and not perform this optimization on them. 1397 ;;; the BOOL variables are, and not perform this optimization on them.
1398 ;;; 1398 ;;;
1399 (defconst byte-boolean-vars 1399
1400 '(abbrev-all-caps purify-flag find-file-compare-truenames 1400 ;;; This used to hold a large list of boolean variables, which had to
1401 find-file-use-truenames find-file-visit-truename 1401 ;;; be updated every time a new DEFVAR_BOOL is added, making it very
1402 find-file-existing-other-name byte-metering-on 1402 ;;; hard to maintain. Such a list is not necessary under XEmacs,
1403 zmacs-regions zmacs-region-active-p zmacs-region-stays 1403 ;;; where we can use `built-in-variable-type' to query for boolean
1404 atomic-extent-goto-char-p suppress-early-error-handler 1404 ;;; variables.
1405 noninteractive ignore-kernel debug-on-quit debug-on-next-call 1405
1406 modifier-keys-are-sticky x-allow-sendevents vms-stmlf-recfm 1406 ;(defconst byte-boolean-vars
1407 disable-auto-save-when-buffer-shrinks indent-tabs-mode 1407 ; '(abbrev-all-caps purify-flag find-file-compare-truenames
1408 load-in-progress load-warn-when-source-newer load-warn-when-source-only 1408 ; find-file-use-truenames delete-auto-save-files byte-metering-on
1409 load-ignore-elc-files load-force-doc-strings 1409 ; x-seppuku-on-epipe zmacs-regions zmacs-region-active-p
1410 fail-on-bucky-bit-character-escapes popup-menu-titles 1410 ; zmacs-region-stays atomic-extent-goto-char-p
1411 menubar-show-keybindings completion-ignore-case 1411 ; suppress-early-error-handler-backtrace noninteractive
1412 canna-empty-info canna-through-info canna-underline 1412 ; inhibit-early-packages inhibit-autoloads debug-paths
1413 canna-inhibit-hankakukana x-handle-non-fully-specified-fonts 1413 ; inhibit-site-lisp debug-on-quit debug-on-next-call
1414 print-escape-newlines print-readably 1414 ; modifier-keys-are-sticky x-allow-sendevents
1415 delete-exited-processes truncate-partial-width-windows 1415 ; mswindows-dynamic-frame-resize focus-follows-mouse
1416 visible-bell no-redraw-on-reenter cursor-in-echo-area 1416 ; inhibit-input-event-recording enable-multibyte-characters
1417 inhibit-warning-display parse-sexp-ignore-comments words-include-escapes 1417 ; disable-auto-save-when-buffer-shrinks
1418 scroll-on-clipped-lines pop-up-frames pop-up-windows) 1418 ; allow-deletion-of-last-visible-frame indent-tabs-mode
1419 "DEFVAR_BOOL variables. Giving these any non-nil value sets them to t. 1419 ; load-in-progress load-warn-when-source-newer
1420 If this does not enumerate all DEFVAR_BOOL variables, the byte-optimizer 1420 ; load-warn-when-source-only load-ignore-elc-files
1421 may generate incorrect code.") 1421 ; load-force-doc-strings fail-on-bucky-bit-character-escapes
1422 ; popup-menu-titles menubar-show-keybindings completion-ignore-case
1423 ; canna-empty-info canna-through-info canna-underline
1424 ; canna-inhibit-hankakukana enable-multibyte-characters
1425 ; re-short-flag x-handle-non-fully-specified-fonts
1426 ; print-escape-newlines print-readably delete-exited-processes
1427 ; windowed-process-io visible-bell no-redraw-on-reenter
1428 ; cursor-in-echo-area inhibit-warning-display
1429 ; column-number-start-at-one parse-sexp-ignore-comments
1430 ; words-include-escapes scroll-on-clipped-lines)
1431 ; "DEFVAR_BOOL variables. Giving these any non-nil value sets them to t.
1432 ;If this does not enumerate all DEFVAR_BOOL variables, the byte-optimizer
1433 ;may generate incorrect code.")
1422 1434
1423 (defun byte-optimize-lapcode (lap &optional for-effect) 1435 (defun byte-optimize-lapcode (lap &optional for-effect)
1424 "Simple peephole optimizer. LAP is both modified and returned." 1436 "Simple peephole optimizer. LAP is both modified and returned."
1425 (let (lap0 ;; off0 unused 1437 (let (lap0 ;; off0 unused
1426 lap1 ;; off1 1438 lap1 ;; off1
1495 ;; The latter two can enable other optimizations. 1507 ;; The latter two can enable other optimizations.
1496 ;; 1508 ;;
1497 ((and (eq 'byte-varref (car lap2)) 1509 ((and (eq 'byte-varref (car lap2))
1498 (eq (cdr lap1) (cdr lap2)) 1510 (eq (cdr lap1) (cdr lap2))
1499 (memq (car lap1) '(byte-varset byte-varbind))) 1511 (memq (car lap1) '(byte-varset byte-varbind)))
1500 (if (and (setq tmp (memq (car (cdr lap2)) byte-boolean-vars)) 1512 (if (and (setq tmp (eq (built-in-variable-type (car (cdr lap2)))
1513 'boolean))
1501 (not (eq (car lap0) 'byte-constant))) 1514 (not (eq (car lap0) 'byte-constant)))
1502 nil 1515 nil
1503 (setq keep-going t) 1516 (setq keep-going t)
1504 (if (memq (car lap0) '(byte-constant byte-dup)) 1517 (if (memq (car lap0) '(byte-constant byte-dup))
1505 (progn 1518 (progn
1801 (eq (car lap2) 'byte-goto) 1814 (eq (car lap2) 'byte-goto)
1802 (not (memq (cdr lap2) rest)) ;Backwards jump 1815 (not (memq (cdr lap2) rest)) ;Backwards jump
1803 (eq (car (car (setq tmp (cdr (memq (cdr lap2) lap))))) 1816 (eq (car (car (setq tmp (cdr (memq (cdr lap2) lap)))))
1804 'byte-varref) 1817 'byte-varref)
1805 (eq (cdr (car tmp)) (cdr lap1)) 1818 (eq (cdr (car tmp)) (cdr lap1))
1806 (not (memq (car (cdr lap1)) byte-boolean-vars))) 1819 (not (eq (built-in-variable-type (car (cdr lap1)))
1820 'boolean)))
1807 ;;(byte-compile-log-lap " Pulled %s to end of loop" (car tmp)) 1821 ;;(byte-compile-log-lap " Pulled %s to end of loop" (car tmp))
1808 (let ((newtag (byte-compile-make-tag))) 1822 (let ((newtag (byte-compile-make-tag)))
1809 (byte-compile-log-lap 1823 (byte-compile-log-lap
1810 " %s: %s ... %s %s\t-->\t%s: %s %s: ... %s %s %s" 1824 " %s: %s ... %s %s\t-->\t%s: %s %s: ... %s %s %s"
1811 (nth 1 (cdr lap2)) (car tmp) 1825 (nth 1 (cdr lap2)) (car tmp)