diff options
| author | Richard M. Stallman | 1994-08-04 21:47:55 +0000 |
|---|---|---|
| committer | Richard M. Stallman | 1994-08-04 21:47:55 +0000 |
| commit | 285cdf4e20fa56fd72d972d37e78bba397bf0ba3 (patch) | |
| tree | aa788d6c68acaf735b1db3b396427c243ee05657 /lisp | |
| parent | fabaa9b58e200675bff5ea3c904c3ec7fea54f40 (diff) | |
| download | emacs-285cdf4e20fa56fd72d972d37e78bba397bf0ba3.tar.gz emacs-285cdf4e20fa56fd72d972d37e78bba397bf0ba3.zip | |
(byte-compile-protect-from-advice): Macro deleted.
(byte-compile-from-buffer, byte-compile-top-level): Don't use it.
Diffstat (limited to 'lisp')
| -rw-r--r-- | lisp/emacs-lisp/bytecomp.el | 151 |
1 files changed, 60 insertions, 91 deletions
diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index b63fe995798..fa2ef9f3331 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el | |||
| @@ -1250,92 +1250,62 @@ With argument, insert value in current buffer after the form." | |||
| 1250 | ((message "%s" (prin1-to-string value))))))) | 1250 | ((message "%s" (prin1-to-string value))))))) |
| 1251 | 1251 | ||
| 1252 | 1252 | ||
| 1253 | (defmacro byte-compile-protect-from-advice (&rest body) | ||
| 1254 | ;; Temporarily deactivates advice of `defun/defmacro' while BODY is run. | ||
| 1255 | ;; After completion of BODY the initial advice state is reinstated. | ||
| 1256 | ;; If `defun/defmacro' are actively advised during compilation then the | ||
| 1257 | ;; compilation of nested `defun/defmacro's produces incorrect code which | ||
| 1258 | ;; is the motivation for this macro. It calls the functions `ad-is-active', | ||
| 1259 | ;; `ad-activate' and `ad-deactivate' which will be reported as undefined | ||
| 1260 | ;; functions during the compilation of the compiler. | ||
| 1261 | (` (let (;; make sure no `require' activates them by | ||
| 1262 | ;; accident via a call to `ad-start-advice': | ||
| 1263 | (ad-advised-definers '(fset defalias define-function)) | ||
| 1264 | defun-active-p defmacro-active-p) | ||
| 1265 | (cond (;; check whether Advice is loaded: | ||
| 1266 | (fboundp 'ad-scan-byte-code-for-fsets) | ||
| 1267 | ;; save activation state of `defun/defmacro' and | ||
| 1268 | ;; deactivate them if their advice is active: | ||
| 1269 | (if (setq defun-active-p (ad-is-active 'defun)) | ||
| 1270 | (ad-deactivate 'defun)) | ||
| 1271 | (if (setq defmacro-active-p (ad-is-active 'defmacro)) | ||
| 1272 | (ad-deactivate 'defmacro)))) | ||
| 1273 | (unwind-protect | ||
| 1274 | (progn | ||
| 1275 | (,@ body)) | ||
| 1276 | ;; reactivate what was active before: | ||
| 1277 | (if defun-active-p | ||
| 1278 | (ad-activate 'defun)) | ||
| 1279 | (if defmacro-active-p | ||
| 1280 | (ad-activate 'defmacro)))))) | ||
| 1281 | |||
| 1282 | (defun byte-compile-from-buffer (inbuffer &optional filename) | 1253 | (defun byte-compile-from-buffer (inbuffer &optional filename) |
| 1283 | ;; Filename is used for the loading-into-Emacs-18 error message. | 1254 | ;; Filename is used for the loading-into-Emacs-18 error message. |
| 1284 | (byte-compile-protect-from-advice | 1255 | (let (outbuffer) |
| 1285 | (let (outbuffer) | 1256 | (let (;; Prevent truncation of flonums and lists as we read and print them |
| 1286 | (let (;; Prevent truncation of flonums and lists as we read and print them | 1257 | (float-output-format nil) |
| 1287 | (float-output-format nil) | 1258 | (case-fold-search nil) |
| 1288 | (case-fold-search nil) | 1259 | (print-length nil) |
| 1289 | (print-length nil) | 1260 | ;; Simulate entry to byte-compile-top-level |
| 1290 | ;; Simulate entry to byte-compile-top-level | 1261 | (byte-compile-constants nil) |
| 1291 | (byte-compile-constants nil) | 1262 | (byte-compile-variables nil) |
| 1292 | (byte-compile-variables nil) | 1263 | (byte-compile-tag-number 0) |
| 1293 | (byte-compile-tag-number 0) | 1264 | (byte-compile-depth 0) |
| 1294 | (byte-compile-depth 0) | 1265 | (byte-compile-maxdepth 0) |
| 1295 | (byte-compile-maxdepth 0) | 1266 | (byte-compile-output nil) |
| 1296 | (byte-compile-output nil) | 1267 | ;; #### This is bound in b-c-close-variables. |
| 1297 | ;; #### This is bound in b-c-close-variables. | 1268 | ;; (byte-compile-warnings (if (eq byte-compile-warnings t) |
| 1298 | ;; (byte-compile-warnings (if (eq byte-compile-warnings t) | 1269 | ;; byte-compile-warning-types |
| 1299 | ;; byte-compile-warning-types | 1270 | ;; byte-compile-warnings)) |
| 1300 | ;; byte-compile-warnings)) | 1271 | ) |
| 1301 | ) | 1272 | (byte-compile-close-variables |
| 1302 | (byte-compile-close-variables | 1273 | (save-excursion |
| 1303 | (save-excursion | 1274 | (setq outbuffer |
| 1304 | (setq outbuffer | 1275 | (set-buffer (get-buffer-create " *Compiler Output*"))) |
| 1305 | (set-buffer (get-buffer-create " *Compiler Output*"))) | 1276 | (erase-buffer) |
| 1306 | (erase-buffer) | 1277 | ;; (emacs-lisp-mode) |
| 1307 | ;; (emacs-lisp-mode) | 1278 | (setq case-fold-search nil) |
| 1308 | (setq case-fold-search nil) | 1279 | |
| 1309 | 1280 | ;; This is a kludge. Some operating systems (OS/2, DOS) need to | |
| 1310 | ;; This is a kludge. Some operating systems (OS/2, DOS) need to | 1281 | ;; write files containing binary information specially. |
| 1311 | ;; write files containing binary information specially. | 1282 | ;; Under most circumstances, such files will be in binary |
| 1312 | ;; Under most circumstances, such files will be in binary | 1283 | ;; overwrite mode, so those OS's use that flag to guess how |
| 1313 | ;; overwrite mode, so those OS's use that flag to guess how | 1284 | ;; they should write their data. Advise them that .elc files |
| 1314 | ;; they should write their data. Advise them that .elc files | 1285 | ;; need to be written carefully. |
| 1315 | ;; need to be written carefully. | 1286 | (setq overwrite-mode 'overwrite-mode-binary)) |
| 1316 | (setq overwrite-mode 'overwrite-mode-binary)) | 1287 | (displaying-byte-compile-warnings |
| 1317 | (displaying-byte-compile-warnings | ||
| 1318 | (save-excursion | ||
| 1319 | (set-buffer inbuffer) | ||
| 1320 | (goto-char 1) | ||
| 1321 | (while (progn | ||
| 1322 | (while (progn (skip-chars-forward " \t\n\^l") | ||
| 1323 | (looking-at ";")) | ||
| 1324 | (forward-line 1)) | ||
| 1325 | (not (eobp))) | ||
| 1326 | (byte-compile-file-form (read inbuffer))) | ||
| 1327 | ;; Compile pending forms at end of file. | ||
| 1328 | (byte-compile-flush-pending) | ||
| 1329 | (and filename (byte-compile-insert-header filename)) | ||
| 1330 | (byte-compile-warn-about-unresolved-functions) | ||
| 1331 | ;; always do this? When calling multiple files, it | ||
| 1332 | ;; would be useful to delay this warning until all have | ||
| 1333 | ;; been compiled. | ||
| 1334 | (setq byte-compile-unresolved-functions nil))) | ||
| 1335 | (save-excursion | 1288 | (save-excursion |
| 1336 | (set-buffer outbuffer) | 1289 | (set-buffer inbuffer) |
| 1337 | (goto-char (point-min))))) | 1290 | (goto-char 1) |
| 1338 | outbuffer))) | 1291 | (while (progn |
| 1292 | (while (progn (skip-chars-forward " \t\n\^l") | ||
| 1293 | (looking-at ";")) | ||
| 1294 | (forward-line 1)) | ||
| 1295 | (not (eobp))) | ||
| 1296 | (byte-compile-file-form (read inbuffer))) | ||
| 1297 | ;; Compile pending forms at end of file. | ||
| 1298 | (byte-compile-flush-pending) | ||
| 1299 | (and filename (byte-compile-insert-header filename)) | ||
| 1300 | (byte-compile-warn-about-unresolved-functions) | ||
| 1301 | ;; always do this? When calling multiple files, it | ||
| 1302 | ;; would be useful to delay this warning until all have | ||
| 1303 | ;; been compiled. | ||
| 1304 | (setq byte-compile-unresolved-functions nil))) | ||
| 1305 | (save-excursion | ||
| 1306 | (set-buffer outbuffer) | ||
| 1307 | (goto-char (point-min))))) | ||
| 1308 | outbuffer)) | ||
| 1339 | ;;; (if (not eval) | 1309 | ;;; (if (not eval) |
| 1340 | ;;; outbuffer | 1310 | ;;; outbuffer |
| 1341 | ;;; (while (condition-case nil | 1311 | ;;; (while (condition-case nil |
| @@ -1821,13 +1791,12 @@ If FORM is a lambda or a macro, byte-compile it as a function." | |||
| 1821 | ;; 'progn or t -> a list of forms, | 1791 | ;; 'progn or t -> a list of forms, |
| 1822 | ;; 'lambda -> body of a lambda, | 1792 | ;; 'lambda -> body of a lambda, |
| 1823 | ;; 'file -> used at file-level. | 1793 | ;; 'file -> used at file-level. |
| 1824 | (byte-compile-protect-from-advice | 1794 | (let ((byte-compile-constants nil) |
| 1825 | (let ((byte-compile-constants nil) | 1795 | (byte-compile-variables nil) |
| 1826 | (byte-compile-variables nil) | 1796 | (byte-compile-tag-number 0) |
| 1827 | (byte-compile-tag-number 0) | 1797 | (byte-compile-depth 0) |
| 1828 | (byte-compile-depth 0) | 1798 | (byte-compile-maxdepth 0) |
| 1829 | (byte-compile-maxdepth 0) | 1799 | (byte-compile-output nil)) |
| 1830 | (byte-compile-output nil)) | ||
| 1831 | (if (memq byte-optimize '(t source)) | 1800 | (if (memq byte-optimize '(t source)) |
| 1832 | (setq form (byte-optimize-form form for-effect))) | 1801 | (setq form (byte-optimize-form form for-effect))) |
| 1833 | (while (and (eq (car-safe form) 'progn) (null (cdr (cdr form)))) | 1802 | (while (and (eq (car-safe form) 'progn) (null (cdr (cdr form)))) |
| @@ -1838,7 +1807,7 @@ If FORM is a lambda or a macro, byte-compile it as a function." | |||
| 1838 | (natnump (nth 3 form))) | 1807 | (natnump (nth 3 form))) |
| 1839 | form | 1808 | form |
| 1840 | (byte-compile-form form for-effect) | 1809 | (byte-compile-form form for-effect) |
| 1841 | (byte-compile-out-toplevel for-effect output-type))))) | 1810 | (byte-compile-out-toplevel for-effect output-type)))) |
| 1842 | 1811 | ||
| 1843 | (defun byte-compile-out-toplevel (&optional for-effect output-type) | 1812 | (defun byte-compile-out-toplevel (&optional for-effect output-type) |
| 1844 | (if for-effect | 1813 | (if for-effect |