Changeset 14094
- Timestamp:
- 08/15/12 21:38:12 (8 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/abcl/src/org/armedbear/lisp/compile-file.lisp
r14067 r14094 697 697 (defvar *fasl-stream* nil) 698 698 699 (defun compile-file (input-file 700 &key 701 output-file 702 ((:verbose *compile-verbose*) *compile-verbose*) 703 ((:print *compile-print*) *compile-print*) 704 (extract-toplevel-funcs-and-macros nil) 705 external-format) 706 (declare (ignore external-format)) ; FIXME 707 (unless (or (and (probe-file input-file) (not (file-directory-p input-file))) 708 (pathname-type input-file)) 709 (let ((pathname (merge-pathnames (make-pathname :type "lisp") input-file))) 710 (when (probe-file pathname) 711 (setf input-file pathname)))) 712 (setf output-file (make-pathname 713 :defaults (if output-file 714 (merge-pathnames output-file 715 *default-pathname-defaults*) 716 (compile-file-pathname input-file)) 717 :version nil)) 718 (let* ((*output-file-pathname* output-file) 719 (type (pathname-type output-file)) 720 (temp-file (merge-pathnames (make-pathname :type (concatenate 'string type "-tmp")) 721 output-file)) 722 (temp-file2 (merge-pathnames (make-pathname :type (concatenate 'string type "-tmp2")) 723 output-file)) 724 (functions-file (merge-pathnames (make-pathname :type "funcs") output-file)) 725 (macros-file (merge-pathnames (make-pathname :type "macs") output-file)) 726 *toplevel-functions* 727 *toplevel-macros* 728 (warnings-p nil) 729 (failure-p nil)) 730 (with-open-file (in input-file :direction :input) 731 (let* ((*compile-file-pathname* (make-pathname :defaults (pathname in) 732 :version nil)) 733 (*compile-file-truename* (make-pathname :defaults (truename in) 734 :version nil)) 735 (*source* *compile-file-truename*) 736 (*class-number* 0) 737 (namestring (namestring *compile-file-truename*)) 738 (start (get-internal-real-time)) 739 *fasl-uninterned-symbols*) 740 (when *compile-verbose* 741 (format t "; Compiling ~A ...~%" namestring)) 742 (with-compilation-unit () 743 (with-open-file (out temp-file 744 :direction :output :if-exists :supersede 745 :external-format *fasl-external-format*) 746 (let ((*readtable* *readtable*) 747 (*read-default-float-format* *read-default-float-format*) 748 (*read-base* *read-base*) 749 (*package* *package*) 750 (jvm::*functions-defined-in-current-file* '()) 751 (*fbound-names* '()) 752 (*fasl-stream* out) 753 *forms-for-output*) 754 (jvm::with-saved-compiler-policy 755 (jvm::with-file-compilation 756 (handler-bind 757 ((style-warning 758 #'(lambda (c) 759 (setf warnings-p t) 760 ;; let outer handlers do their thing 761 (signal c) 762 ;; prevent the next handler 763 ;; from running: we're a 764 ;; WARNING subclass 765 (continue))) 766 ((or warning compiler-error) 767 #'(lambda (c) 768 (declare (ignore c)) 769 (setf warnings-p t 770 failure-p t)))) 771 (loop 772 (let* ((*source-position* (file-position in)) 773 (jvm::*source-line-number* (stream-line-number in)) 774 (form (read in nil in)) 775 (*compiler-error-context* form)) 776 (when (eq form in) 777 (return)) 778 (process-toplevel-form form out nil)))) 699 (defun compile-from-stream (in output-file temp-file temp-file2 700 extract-toplevel-funcs-and-macros 701 functions-file macros-file) 702 (let* ((*compile-file-pathname* (make-pathname :defaults (pathname in) 703 :version nil)) 704 (*compile-file-truename* (make-pathname :defaults (truename in) 705 :version nil)) 706 (*source* *compile-file-truename*) 707 (*class-number* 0) 708 (namestring (namestring *compile-file-truename*)) 709 (start (get-internal-real-time)) 710 *fasl-uninterned-symbols*) 711 (when *compile-verbose* 712 (format t "; Compiling ~A ...~%" namestring)) 713 (with-compilation-unit () 714 (with-open-file (out temp-file 715 :direction :output :if-exists :supersede 716 :external-format *fasl-external-format*) 717 (let ((*readtable* *readtable*) 718 (*read-default-float-format* *read-default-float-format*) 719 (*read-base* *read-base*) 720 (*package* *package*) 721 (jvm::*functions-defined-in-current-file* '()) 722 (*fbound-names* '()) 723 (*fasl-stream* out) 724 *forms-for-output*) 725 (jvm::with-saved-compiler-policy 726 (jvm::with-file-compilation 727 (handler-bind 728 ((style-warning 729 #'(lambda (c) 730 (setf warnings-p t) 731 ;; let outer handlers do their thing 732 (signal c) 733 ;; prevent the next handler 734 ;; from running: we're a 735 ;; WARNING subclass 736 (continue))) 737 ((or warning compiler-error) 738 #'(lambda (c) 739 (declare (ignore c)) 740 (setf warnings-p t 741 failure-p t)))) 742 (loop 743 (let* ((*source-position* (file-position in)) 744 (jvm::*source-line-number* (stream-line-number in)) 745 (form (read in nil in)) 746 (*compiler-error-context* form)) 747 (when (eq form in) 748 (return)) 749 (process-toplevel-form form out nil)))) 779 750 (finalize-fasl-output) 780 751 (dolist (name *fbound-names*) … … 860 831 (format t "~&; Wrote ~A (~A seconds)~%" 861 832 (namestring output-file) 862 (/ (- (get-internal-real-time) start) 1000.0))))) 863 (values (truename output-file) warnings-p failure-p))) 833 (/ (- (get-internal-real-time) start) 1000.0)))) ) 834 835 (defun compile-file (input-file 836 &key 837 output-file 838 ((:verbose *compile-verbose*) *compile-verbose*) 839 ((:print *compile-print*) *compile-print*) 840 (extract-toplevel-funcs-and-macros nil) 841 external-format) 842 (declare (ignore external-format)) ; FIXME 843 (flet ((pathname-with-type (pathname type &optional suffix) 844 (when suffix 845 (setq type (concatenate 'string type suffix))) 846 (merge-pathnames (make-pathname :type type) 847 pathname))) 848 (unless (or (and (probe-file input-file) 849 (not (file-directory-p input-file))) 850 (pathname-type input-file)) 851 (let ((pathname (pathname-with-type input-file "lisp"))) 852 (when (probe-file pathname) 853 (setf input-file pathname)))) 854 (setf output-file 855 (make-pathname :defaults 856 (if output-file 857 (merge-pathnames output-file 858 *default-pathname-defaults*) 859 (compile-file-pathname input-file)) 860 :version nil)) 861 (let* ((*output-file-pathname* output-file) 862 (type (pathname-type output-file)) 863 (temp-file (pathname-with-type output-file type "-tmp")) 864 (temp-file2 (pathname-with-type output-file type "-tmp2")) 865 (functions-file (pathname-with-type output-file "funcs")) 866 (macros-file (pathname-with-type output-file "macs")) 867 *toplevel-functions* 868 *toplevel-macros* 869 (warnings-p nil) 870 (failure-p nil)) 871 (with-open-file (in input-file :direction :input) 872 (compile-from-stream in output-file temp-file temp-file2 873 extract-toplevel-funcs-and-macros 874 functions-file macros-file)) 875 (values (truename output-file) warnings-p failure-p)))) 864 876 865 877 (defun compile-file-if-needed (input-file &rest allargs &key force-compile
Note: See TracChangeset
for help on using the changeset viewer.