;;;-*-Mode: common-Lisp; Package: SI; Base: 10.-*-

;;;                           RESTRICTED RIGHTS LEGEND

;;;Use, duplication, or disclosure by the Government is subject to
;;;restrictions as set forth in subdivision (c)(1)(ii) of the Rights in
;;;Technical Data and Computer Software clause at 52.227-7013.
;;;
;;;                     TEXAS INSTRUMENTS INCORPORATED.
;;;                              P.O. BOX 2909
;;;                           AUSTIN, TEXAS 78769
;;;                                 MS 2151
;;;
;;; Copyright (C) 1985-1989 Texas Instruments Incorporated. All rights reserved.


;;; Macros relating to warnings (compiler, etc).


;Variables bound by the macros.

(PROCLAIM
  (QUOTE
    (SPECIAL OBJECT-WARNINGS-DATUM OBJECT-WARNINGS-LOCATION-FUNCTION OBJECT-WARNINGS-OBJECT-NAME
	     OBJECT-WARNINGS-PUSHING-LOCATION
	     FILE-WARNINGS-DATUM FILE-WARNINGS-PATHNAME FILE-WARNINGS-PUSHING-LOCATION
	     PREMATURE-WARNINGS PREMATURE-WARNINGS-THIS-OBJECT)))

;Use this around an operation that goes through some or all the objects in a file.
;WHOLE-FILE-P should evaluate to T if we are doing the entire file.

(DEFMACRO FILE-OPERATION-WITH-WARNINGS ((GENERIC-PATHNAME OPERATION-TYPE WHOLE-FILE-P) &BODY BODY)
  "Execute BODY, recording warnings for performing OPERATION-TYPE on file GENERIC-PATHNAME.
WHOLE-FILE-P should evaluate to non-NIL if the body will process all of the file.
OPERATION-TYPE is most frequently ':COMPILE, in the compiler."
  `(LET* ((FILE-WARNINGS-DATUM FILE-WARNINGS-DATUM)
	  (FILE-WARNINGS-PATHNAME FILE-WARNINGS-PATHNAME)
	  (FILE-WARNINGS-PUSHING-LOCATION FILE-WARNINGS-PUSHING-LOCATION)
	  (PREMATURE-WARNINGS PREMATURE-WARNINGS)
	  (PREMATURE-WARNINGS-THIS-OBJECT PREMATURE-WARNINGS-THIS-OBJECT)
	  (NEW-FILE-THIS-LEVEL (BEGIN-FILE-OPERATION ,GENERIC-PATHNAME ,OPERATION-TYPE)))
     (PROG1
       (PROGN
	 . ,BODY)
       (DISPOSE-OF-WARNINGS-AFTER-LAST-OBJECT)
       (AND ,WHOLE-FILE-P NEW-FILE-THIS-LEVEL (END-FILE-OPERATION))))) 

;Use this around operating on an individual object,
;inside (dynamically) a use of the preceding macro.

(DEFMACRO OBJECT-OPERATION-WITH-WARNINGS ((OBJECT-NAME LOCATION-FUNCTION INCREMENTAL) &BODY BODY)
  "Execute BODY, recording warnings for OBJECT-NAME.
If INCREMENTAL evaluates to NIL, all previous warnings about that object
are discarded when the body is finished.  OBJECT-NAME is the name
of an object in the file set up with FILE-OPERATION-WITH-WARNINGS;
each file is its own space of object names, for recording warnings.
This macro's expansion must be executed inside the body of a
FILE-OPERATION-WITH-WARNINGS.  LOCATION-FUNCTION's value tells the editor
how to find this object's definition in the file; usually it is NIL."
  `(LET-IF (AND (NOT (EQUAL ,OBJECT-NAME OBJECT-WARNINGS-OBJECT-NAME))
		,OBJECT-NAME)
      ((OBJECT-WARNINGS-DATUM OBJECT-WARNINGS-DATUM)
       (OBJECT-WARNINGS-LOCATION-FUNCTION OBJECT-WARNINGS-LOCATION-FUNCTION)
       (OBJECT-WARNINGS-OBJECT-NAME OBJECT-WARNINGS-OBJECT-NAME)
       (OBJECT-WARNINGS-PUSHING-LOCATION OBJECT-WARNINGS-PUSHING-LOCATION))
      (LET ((NEW-OBJECT-THIS-LEVEL (BEGIN-OBJECT-OPERATION ,OBJECT-NAME ,LOCATION-FUNCTION)))
	(PROG1
	  (PROGN
	    . ,BODY)
	  (AND ,(NOT INCREMENTAL) NEW-OBJECT-THIS-LEVEL (END-OBJECT-OPERATION)))))) 

;;; ---------
;;; The following temporary kludges are because OBJECT-OPERATION-WITH-WARNINGS is shadowed
;;; in the COMPILER2 package under release 2.	-- DNG 10/4/86

#+Elroy
(unless (eq 'compiler2:OBJECT-OPERATION-WITH-WARNINGS 'OBJECT-OPERATION-WITH-WARNINGS)
  (deff-macro compiler2:OBJECT-OPERATION-WITH-WARNINGS #'OBJECT-OPERATION-WITH-WARNINGS))

#+Elroy
(unless (eq 'compiler2:BEGIN-OBJECT-OPERATION 'BEGIN-OBJECT-OPERATION)
  (deff compiler2:BEGIN-OBJECT-OPERATION 'BEGIN-OBJECT-OPERATION))
;;; ---------