comparison lisp/bytecomp.el @ 398:74fd4e045ea6 r21-2-29

Import from CVS: tag r21-2-29
author cvs
date Mon, 13 Aug 2007 11:13:30 +0200
parents 8626e4521993
children b8cc9ab3f761
comparison
equal deleted inserted replaced
397:f4aeb21a5bad 398:74fd4e045ea6
1 ;;; bytecomp.el --- compilation of Lisp code into byte code. 1 ;;; bytecomp.el --- compilation of Lisp code into byte code.
2 2
3 ;;; Copyright (C) 1985-1987, 1991-1994 Free Software Foundation, Inc. 3 ;;; Copyright (C) 1985-1987, 1991-1994 Free Software Foundation, Inc.
4 ;;; Copyright (C) 1996 Ben Wing. 4 ;;; Copyright (C) 1996 Ben Wing.
5 5
6 ;; Author: Jamie Zawinski <jwz@netscape.com> 6 ;; Author: Jamie Zawinski <jwz@jwz.org>
7 ;; Hallvard Furuseth <hbf@ulrik.uio.no> 7 ;; Hallvard Furuseth <hbf@ulrik.uio.no>
8 ;; Keywords: internal 8 ;; Keywords: internal
9 9
10 ;; Subsequently modified by RMS and others. 10 ;; Subsequently modified by RMS and others.
11 11
430 (defconst byte-compile-arglist-bit 4) 430 (defconst byte-compile-arglist-bit 4)
431 (defconst byte-compile-global-bit 8) 431 (defconst byte-compile-global-bit 8)
432 432
433 (defvar byte-compile-free-references) 433 (defvar byte-compile-free-references)
434 (defvar byte-compile-free-assignments) 434 (defvar byte-compile-free-assignments)
435 (defvar debug-issue-ebola-notices)
436 435
437 (defvar byte-compiler-error-flag) 436 (defvar byte-compiler-error-flag)
438 437
439 (defconst byte-compile-initial-macro-environment 438 (defconst byte-compile-initial-macro-environment
440 (purecopy 439 (purecopy
1296 (byte-compile-dynamic-docstrings 1295 (byte-compile-dynamic-docstrings
1297 byte-compile-dynamic-docstrings) 1296 byte-compile-dynamic-docstrings)
1298 (byte-compile-warnings (if (eq byte-compile-warnings t) 1297 (byte-compile-warnings (if (eq byte-compile-warnings t)
1299 byte-compile-default-warnings 1298 byte-compile-default-warnings
1300 byte-compile-warnings)) 1299 byte-compile-warnings))
1301 (byte-compile-file-domain nil) 1300 (byte-compile-file-domain nil))
1302
1303 ;; We reserve the right to compare ANY objects for equality.
1304 (debug-issue-ebola-notices -42)
1305 )
1306 (prog1 1301 (prog1
1307 (progn ,@body) 1302 (progn ,@body)
1308 (if (memq 'unused-vars byte-compile-warnings) 1303 (if (memq 'unused-vars byte-compile-warnings)
1309 ;; done compiling in this scope, warn now. 1304 ;; done compiling in this scope, warn now.
1310 (byte-compile-warn-about-unused-variables))))) 1305 (byte-compile-warn-about-unused-variables)))))
1525 (insert "\n") ; aaah, unix. 1520 (insert "\n") ; aaah, unix.
1526 (setq target-file (byte-compile-dest-file filename)) 1521 (setq target-file (byte-compile-dest-file filename))
1527 (unless byte-compile-overwrite-file 1522 (unless byte-compile-overwrite-file
1528 (ignore-file-errors (delete-file target-file))) 1523 (ignore-file-errors (delete-file target-file)))
1529 (if (file-writable-p target-file) 1524 (if (file-writable-p target-file)
1530 (progn 1525 (write-region 1 (point-max) target-file)
1531 (when (memq system-type '(ms-dos windows-nt))
1532 (defvar buffer-file-type)
1533 (setq buffer-file-type t))
1534 (write-region 1 (point-max) target-file))
1535 ;; This is just to give a better error message than write-region 1526 ;; This is just to give a better error message than write-region
1536 (signal 'file-error 1527 (signal 'file-error
1537 (list "Opening output file" 1528 (list "Opening output file"
1538 (if (file-exists-p target-file) 1529 (if (file-exists-p target-file)
1539 "cannot overwrite file" 1530 "cannot overwrite file"
1750 1741
1751 ;; back in the inbuffer; determine and set the coding system for the .elc 1742 ;; back in the inbuffer; determine and set the coding system for the .elc
1752 ;; file if under Mule. If there are any extended characters in the 1743 ;; file if under Mule. If there are any extended characters in the
1753 ;; input file, use `escape-quoted' to make sure that both binary and 1744 ;; input file, use `escape-quoted' to make sure that both binary and
1754 ;; extended characters are output properly and distinguished properly. 1745 ;; extended characters are output properly and distinguished properly.
1755 ;; Otherwise, use `no-conversion' for maximum portability with non-Mule 1746 ;; Otherwise, use `raw-text' for maximum portability with non-Mule
1756 ;; Emacsen. 1747 ;; Emacsen.
1757 (when (featurep 'mule) 1748 (when (featurep '(or mule file-coding))
1758 (defvar buffer-file-coding-system) 1749 (defvar buffer-file-coding-system)
1759 (if (save-excursion 1750 (if (or (featurep '(not mule)) ;; Don't scan buffer if we are not muleized
1760 (set-buffer byte-compile-inbuffer) 1751 (save-excursion
1761 (goto-char (point-min)) 1752 (set-buffer byte-compile-inbuffer)
1762 ;; mrb- There must be a better way than skip-chars-forward 1753 (goto-char (point-min))
1763 (skip-chars-forward (concat (char-to-string 0) "-" 1754 ;; mrb- There must be a better way than skip-chars-forward
1764 (char-to-string 255))) 1755 (skip-chars-forward (concat (char-to-string 0) "-"
1765 (eq (point) (point-max))) 1756 (char-to-string 255)))
1766 (setq buffer-file-coding-system 'no-conversion) 1757 (eq (point) (point-max))))
1758 (setq buffer-file-coding-system 'raw-text-unix)
1767 (insert "(require 'mule)\n;;;###coding system: escape-quoted\n") 1759 (insert "(require 'mule)\n;;;###coding system: escape-quoted\n")
1768 (setq buffer-file-coding-system 'escape-quoted) 1760 (setq buffer-file-coding-system 'escape-quoted)
1769 ;; #### Lazy loading not yet implemented for MULE files 1761 ;; #### Lazy loading not yet implemented for MULE files
1770 ;; mrb - Fix this someday. 1762 ;; mrb - Fix this someday.
1771 (save-excursion 1763 (save-excursion
1970 (let ((form form)) 1962 (let ((form form))
1971 ;; all forms are constant 1963 ;; all forms are constant
1972 (while (if (setq form (cdr form)) 1964 (while (if (setq form (cdr form))
1973 (byte-compile-constp (car form)))) 1965 (byte-compile-constp (car form))))
1974 (null form))) 1966 (null form)))
1975 ;; eval the macro autoload into the compilation enviroment 1967 ;; eval the macro autoload into the compilation environment
1976 (eval form)) 1968 (eval form))
1977 1969
1978 (if name 1970 (if name
1979 (let ((old (assq name byte-compile-autoload-environment))) 1971 (let ((old (assq name byte-compile-autoload-environment)))
1980 (cond (old 1972 (cond (old