Mercurial > emacs
comparison lisp/emacs-lisp/bytecomp.el @ 8446:0199ece40d91
(byte-compile-protect-from-advice): Macro deleted.
(byte-compile-from-buffer, byte-compile-top-level): Don't use it.
author | Richard M. Stallman <rms@gnu.org> |
---|---|
date | Thu, 04 Aug 1994 21:47:55 +0000 |
parents | e45d541e55cf |
children | fae44b2323fe |
comparison
equal
deleted
inserted
replaced
8445:81f7b5d9b990 | 8446:0199ece40d91 |
---|---|
1248 (prin1 value (current-buffer)) | 1248 (prin1 value (current-buffer)) |
1249 (insert "\n")) | 1249 (insert "\n")) |
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 |
1274 (setq outbuffer | |
1275 (set-buffer (get-buffer-create " *Compiler Output*"))) | |
1276 (erase-buffer) | |
1277 ;; (emacs-lisp-mode) | |
1278 (setq case-fold-search nil) | |
1279 | |
1280 ;; This is a kludge. Some operating systems (OS/2, DOS) need to | |
1281 ;; write files containing binary information specially. | |
1282 ;; Under most circumstances, such files will be in binary | |
1283 ;; overwrite mode, so those OS's use that flag to guess how | |
1284 ;; they should write their data. Advise them that .elc files | |
1285 ;; need to be written carefully. | |
1286 (setq overwrite-mode 'overwrite-mode-binary)) | |
1287 (displaying-byte-compile-warnings | |
1303 (save-excursion | 1288 (save-excursion |
1304 (setq outbuffer | 1289 (set-buffer inbuffer) |
1305 (set-buffer (get-buffer-create " *Compiler Output*"))) | 1290 (goto-char 1) |
1306 (erase-buffer) | 1291 (while (progn |
1307 ;; (emacs-lisp-mode) | 1292 (while (progn (skip-chars-forward " \t\n\^l") |
1308 (setq case-fold-search nil) | 1293 (looking-at ";")) |
1309 | 1294 (forward-line 1)) |
1310 ;; This is a kludge. Some operating systems (OS/2, DOS) need to | 1295 (not (eobp))) |
1311 ;; write files containing binary information specially. | 1296 (byte-compile-file-form (read inbuffer))) |
1312 ;; Under most circumstances, such files will be in binary | 1297 ;; Compile pending forms at end of file. |
1313 ;; overwrite mode, so those OS's use that flag to guess how | 1298 (byte-compile-flush-pending) |
1314 ;; they should write their data. Advise them that .elc files | 1299 (and filename (byte-compile-insert-header filename)) |
1315 ;; need to be written carefully. | 1300 (byte-compile-warn-about-unresolved-functions) |
1316 (setq overwrite-mode 'overwrite-mode-binary)) | 1301 ;; always do this? When calling multiple files, it |
1317 (displaying-byte-compile-warnings | 1302 ;; would be useful to delay this warning until all have |
1318 (save-excursion | 1303 ;; been compiled. |
1319 (set-buffer inbuffer) | 1304 (setq byte-compile-unresolved-functions nil))) |
1320 (goto-char 1) | 1305 (save-excursion |
1321 (while (progn | 1306 (set-buffer outbuffer) |
1322 (while (progn (skip-chars-forward " \t\n\^l") | 1307 (goto-char (point-min))))) |
1323 (looking-at ";")) | 1308 outbuffer)) |
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 | |
1336 (set-buffer outbuffer) | |
1337 (goto-char (point-min))))) | |
1338 outbuffer))) | |
1339 ;;; (if (not eval) | 1309 ;;; (if (not eval) |
1340 ;;; outbuffer | 1310 ;;; outbuffer |
1341 ;;; (while (condition-case nil | 1311 ;;; (while (condition-case nil |
1342 ;;; (progn (setq form (read outbuffer)) | 1312 ;;; (progn (setq form (read outbuffer)) |
1343 ;;; t) | 1313 ;;; t) |
1819 ;; OUTPUT-TYPE advises about how form is expected to be used: | 1789 ;; OUTPUT-TYPE advises about how form is expected to be used: |
1820 ;; 'eval or nil -> a single form, | 1790 ;; 'eval or nil -> a single form, |
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)))) |
1834 (setq form (nth 1 form))) | 1803 (setq form (nth 1 form))) |
1835 (if (and (eq 'byte-code (car-safe form)) | 1804 (if (and (eq 'byte-code (car-safe form)) |
1836 (not (memq byte-optimize '(t byte))) | 1805 (not (memq byte-optimize '(t byte))) |
1837 (stringp (nth 1 form)) (vectorp (nth 2 form)) | 1806 (stringp (nth 1 form)) (vectorp (nth 2 form)) |
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 |
1845 ;; The stack is empty. Push a value to be returned from (byte-code ..). | 1814 ;; The stack is empty. Push a value to be returned from (byte-code ..). |
1846 (if (eq (car (car byte-compile-output)) 'byte-discard) | 1815 (if (eq (car (car byte-compile-output)) 'byte-discard) |