Skip to content
Snippets Groups Projects
Commit 591c2634 authored by ram's avatar ram
Browse files

Merged non-descriptor changes:

 revision 1.4.1.2
 date: 90/04/13 12:33:44;  author: ram;  state: Exp;  lines added/del: 2/0
 Actually call SELECT-REPRESENTATIONS.
 ----------------------------
 revision 1.4.1.1
 date: 90/03/27 12:24:31;  author: ram;  state: Exp;  lines added/del: 84/64
 Added new generalized UNDEFINED-WARNING support in place of the old
 UNKNOWN-FUNCTION mechanism.  This is now also used for undefined type
 warnings.
 CHanged control analysis to be called after LTN so that it can
 know which calls are TR.
 Added support for the new FILE-COMMENT macro (really magically
 recognized by PROCESS-FORM.)
 In SUB-COMPILE-FILE, changed the WITH-COMPILATION-UNIT to be inside
 the LET of *PACKAGE* so that the right package is current when
 printing the undefined warnings.
parent e030f803
No related branches found
No related tags found
No related merge requests found
...@@ -11,7 +11,7 @@ ...@@ -11,7 +11,7 @@
;;; ;;;
;;; Written by Rob MacLachlan ;;; Written by Rob MacLachlan
;;; ;;;
(in-package 'c) (in-package "C")
(proclaim '(special *constants* *free-variables* *compile-component* (proclaim '(special *constants* *free-variables* *compile-component*
*code-vector* *next-location* *result-fixups* *code-vector* *next-location* *result-fixups*
...@@ -20,7 +20,7 @@ ...@@ -20,7 +20,7 @@
*continuation-number* *continuation-numbers* *continuation-number* *continuation-numbers*
*number-continuations* *tn-id* *tn-ids* *id-tns* *number-continuations* *tn-id* *tn-ids* *id-tns*
*label-ids* *label-id* *id-labels* *sb-list* *label-ids* *label-id* *id-labels* *sb-list*
*unknown-functions* *compiler-error-count* *undefined-warnings* *compiler-error-count*
*compiler-warning-count* *compiler-note-count* *compiler-warning-count* *compiler-note-count*
*compiler-error-output* *compiler-error-bailout* *compiler-error-output* *compiler-error-bailout*
*compiler-trace-output* *compiler-trace-output*
...@@ -166,15 +166,18 @@ ...@@ -166,15 +166,18 @@
(environment-analyze component) (environment-analyze component)
(maybe-mumble "GTN ") (maybe-mumble "GTN ")
(gtn-analyze component) (gtn-analyze component)
(maybe-mumble "Control ")
(control-analyze component)
(maybe-mumble "LTN ") (maybe-mumble "LTN ")
(ltn-analyze component) (ltn-analyze component)
(maybe-mumble "Control ")
(control-analyze component)
(when (ir2-component-values-receivers (component-info component)) (when (ir2-component-values-receivers (component-info component))
(maybe-mumble "Stack ") (maybe-mumble "Stack ")
(stack-analyze component)) (stack-analyze component))
;; Assign BLOCK-NUMBER for any cleanup blocks introduced by environment
;; or stack analysis. There shouldn't be any unreachable code after
;; control, so this won't delete anything.
(when (component-reanalyze component) (when (component-reanalyze component)
(find-dfo component)) (find-dfo component))
...@@ -183,6 +186,8 @@ ...@@ -183,6 +186,8 @@
(entry-analyze component) (entry-analyze component)
(ir2-convert component) (ir2-convert component)
(select-representations component)
(when *check-consistency* (when *check-consistency*
(maybe-mumble "Check2 ") (maybe-mumble "Check2 ")
(check-ir2-consistency component)) (check-ir2-consistency component))
...@@ -317,25 +322,26 @@ ...@@ -317,25 +322,26 @@
;;; ;;;
(defun print-summary (abort-p abort-count) (defun print-summary (abort-p abort-count)
(unless abort-p (unless abort-p
(let ((funs (sort *unknown-functions* #'string< (let ((funs (sort *undefined-warnings* #'string<
:key #'(lambda (x) :key #'(lambda (x)
(let ((x (unknown-function-name x))) (let ((x (undefined-warning-name x)))
(if (symbolp x) (if (symbolp x)
(symbol-name x) (symbol-name x)
(symbol-name (cadr x)))))))) (prin1-to-string x)))))))
(dolist (fun funs) (dolist (fun funs)
(let ((name (unknown-function-name fun)) (let ((name (undefined-warning-name fun))
(warnings (unknown-function-warnings fun)) (kind (undefined-warning-kind fun))
(count (unknown-function-count fun))) (warnings (undefined-warning-warnings fun))
(count (undefined-warning-count fun)))
(dolist (*compiler-error-context* warnings) (dolist (*compiler-error-context* warnings)
(compiler-warning "Call to unknown function.")) (compiler-warning "Undefined ~(~A~): ~S" kind name))
(let ((warn-count (length warnings))) (let ((warn-count (length warnings)))
(when (> count warn-count) (when (> count warn-count)
(let ((more (- count warn-count))) (let ((more (- count warn-count)))
(compiler-warning (compiler-warning
"~D ~:[~;more ~]call~P to unknown function ~S." "~D ~:[~;more ~]use~P of undefined ~(~A~) ~S."
more warnings more name)))))))) more warnings more kind name))))))))
(compiler-mumble (compiler-mumble
"~2&Compilation unit ~:[finished~;aborted~].~ "~2&Compilation unit ~:[finished~;aborted~].~
...@@ -443,6 +449,9 @@ ...@@ -443,6 +449,9 @@
;; The file's write date (if relevant.) ;; The file's write date (if relevant.)
(write-date nil :type (or unsigned-byte null)) (write-date nil :type (or unsigned-byte null))
;; ;;
;; This file's FILE-COMMENT, or NIL if none.
(comment nil :type (or simple-string null))
;;
;; The source path root number of the first form in this file (i.e. the ;; The source path root number of the first form in this file (i.e. the
;; total number of forms converted previously in this compilation.) ;; total number of forms converted previously in this compilation.)
(source-root 0 :type unsigned-byte) (source-root 0 :type unsigned-byte)
...@@ -754,8 +763,10 @@ ...@@ -754,8 +763,10 @@
;;; PROCESS-FORM -- Internal ;;; PROCESS-FORM -- Internal
;;; ;;;
;;; Process a top-level Form with the specified source Path and output to ;;; Process a top-level Form with the specified source Path and output to
;;; Object. If this is a magic top-level form, then do stuff, otherwise just ;;; Object.
;;; compile it. ;;; -- If this is a magic top-level form, then do stuff.
;;; -- If it is a macro expand it.
;;; -- Otherwise, just compile it.
;;; ;;;
;;; ### At least for now, always dump package frobbing as interpreted cold load ;;; ### At least for now, always dump package frobbing as interpreted cold load
;;; forms. This might want to be on a switch someday. ;;; forms. This might want to be on a switch someday.
...@@ -769,8 +780,7 @@ ...@@ -769,8 +780,7 @@
`(error "Execution of a form compiled with errors:~% ~S" `(error "Execution of a form compiled with errors:~% ~S"
',form) ',form)
tlf-num object) tlf-num object)
(throw 'process-form-error-abort nil))) (throw 'process-form-error-abort nil))))
(form (preprocessor-macroexpand form)))
(if (atom form) (if (atom form)
(convert-and-maybe-compile form tlf-num object) (convert-and-maybe-compile form tlf-num object)
(case (car form) (case (car form)
...@@ -795,8 +805,20 @@ ...@@ -795,8 +805,20 @@
#'(lambda () #'(lambda ()
(process-progn (cddr form) tlf-num object)))) (process-progn (cddr form) tlf-num object))))
(progn (process-progn (cdr form) tlf-num object)) (progn (process-progn (cdr form) tlf-num object))
(file-comment
(unless (and (= (length form) 2) (stringp (second form)))
(compiler-error "Bad FILE-COMMENT form: ~S." form))
(let ((file (first (source-info-current-file *source-info*))))
(if (file-info-comment file)
(compiler-warning "Ignoring extra file comment:~% ~S."
form)
(setf (file-info-comment file)
(coerce (second form) 'simple-string)))))
(t (t
(convert-and-maybe-compile form tlf-num object)))))) (let ((exp (preprocessor-macroexpand form)))
(if (eq exp form)
(convert-and-maybe-compile form tlf-num object)
(process-form exp tlf-num object))))))))
(undefined-value)) (undefined-value))
...@@ -813,52 +835,52 @@ ...@@ -813,52 +835,52 @@
;;; ;;;
(defun sub-compile-file (info object) (defun sub-compile-file (info object)
(declare (type source-info info) (type object object)) (declare (type source-info info) (type object object))
(with-compilation-unit () (with-ir1-namespace
(let ((start-errors *compiler-error-count*) (clear-stuff)
(start-warnings *compiler-warning-count*) (let* ((start-errors *compiler-error-count*)
(start-notes *compiler-note-count*)) (start-warnings *compiler-warning-count*)
(with-ir1-namespace (start-notes *compiler-note-count*)
(clear-stuff) (*package* *package*)
(let* ((*package* *package*) (*initial-package* *package*)
(*initial-package* *package*) (*initial-cookie* *default-cookie*)
(*initial-cookie* *default-cookie*) (*default-cookie* (copy-cookie *initial-cookie*))
(*default-cookie* (copy-cookie *initial-cookie*)) (*current-cookie* (make-cookie))
(*current-cookie* (make-cookie)) (*fenv* ())
(*fenv* ()) (*source-info* info)
(*source-info* info) (*top-level-lambdas* ())
(*top-level-lambdas* ()) (*compiler-error-bailout*
(*compiler-error-bailout* #'(lambda ()
#'(lambda () (compiler-mumble
(compiler-mumble "~2&Fatal error, aborting compilation...~%")
"~2&Fatal error, aborting compilation...~%") (return-from sub-compile-file :error)))
(return-from sub-compile-file :error))) (*last-source-context* nil)
(*last-source-context* nil) (*last-original-source* nil)
(*last-original-source* nil) (*last-source-form* nil)
(*last-source-form* nil) (*last-format-string* nil)
(*last-format-string* nil) (*last-format-args* nil)
(*last-format-args* nil) (*last-message-count* 0))
(*last-message-count* 0)) (with-compilation-unit ()
(loop (loop
(multiple-value-bind (form tlf eof-p) (multiple-value-bind (form tlf eof-p)
(read-source-form info) (read-source-form info)
(when eof-p (return)) (when eof-p (return))
(clrhash *source-paths*) (clrhash *source-paths*)
(find-source-paths form tlf) (find-source-paths form tlf)
(process-form form tlf object))) (process-form form tlf object)))
(when *block-compile* (when *block-compile*
(compile-top-level (nreverse *top-level-lambdas*) object) (compile-top-level (nreverse *top-level-lambdas*) object)
(clear-stuff)) (clear-stuff))
(etypecase object (etypecase object
(fasl-file (fasl-dump-source-info info object)) (fasl-file (fasl-dump-source-info info object))
(core-object (fix-core-source-info info object)) (core-object (fix-core-source-info info object))
(null)))) (null))
(cond ((> *compiler-error-count* start-errors) :error) (cond ((> *compiler-error-count* start-errors) :error)
((> *compiler-warning-count* start-warnings) :warning) ((> *compiler-warning-count* start-warnings) :warning)
((> *compiler-note-count* start-notes) :note) ((> *compiler-note-count* start-notes) :note)
(t nil))))) (t nil))))))
;;; Verify-Source-Files -- Internal ;;; Verify-Source-Files -- Internal
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment