;;; -*- Mode:Lisp; Readtable:CL; Package:USER; Base:8; Patch-File:T -*-
;;; Patch file for MICRO-COMPILATION-TOOLS version 3.4
;;; Reason:
;;;  Add variable COMPILER:*MICROCOMPILER-VERBOSE* which determines
;;;  whether each step in the micro-compilation should be printed out.
;;;  Defaults to NIL.
;;; Written 6-Aug-86 21:50:04 by dg (Dave Goodine) at site LMI Cambridge
;;; while running on Maurice Ravel from band 1
;;; with System 110.232, Lambda-Diag 7.17, Experimental Local-File 68.7, FILE-Server 18.4, Unix-Interface 9.1, ZMail 65.14, Object Lisp 3.4, Tape 6.39, Site Data Editor 3.3, Tiger 24.0, KERMIT 31.3, Gateway 4.15, TCP-Kernel 39.7, TCP-User 62.7, TCP-Server 45.5, MEDIUM-RESOLUTION-COLOR 3.4, MICRO-COMPILATION-TOOLS 3.3, System Revision Level 3.137, Experimental Window-Maker 2.0, microcode 1563, SDU Boot Tape 3.12, SDU ROM 102, Alpha VII.

; From modified file LAD: RELEASE-3.MICRO-COMPILER; MA.LISP#95 at 6-Aug-86 21:51:19
#8R COMPILER#: #!:ZL
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "COMPILER")))
  (PATCH-SOURCE-FILE "SYS: MICRO-COMPILER; MA  "

(defvar *microcompiler-verbose* nil
  "If non-NIL, will cause info to be printed out when microcompiling.")

))

; From modified file LAD: RELEASE-3.MICRO-COMPILER; MA.LISP#95 at 6-Aug-86 21:51:24
#8R COMPILER#: #!:ZL
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "COMPILER")))
  (PATCH-SOURCE-FILE "SYS: MICRO-COMPILER; MA  "

(DEFUN MICRO-ASSEMBLE (MODE)	;this function called from MICRO-COMPILE in LISPM;MC
  (PROG (TEM FUNCTION-NAME OUTPUT)
	(setq default-cons-area working-storage-area)   ;try to avoid lossage.
	(COND ((NULL *UCADR-STATE-LIST*)
	       (GET-UCADR-STATE-LIST)
	       (MA-INITIALIZE-VARIABLES)))
     L  ;(ma-print-code)
	(when *microcompiler-verbose*
	  (PRINT '(MA-HOOK-UP-STATES)))
	(MA-HOOK-UP-STATES)
	(when *microcompiler-verbose*
	  (PRINT '(MA-HOOK-UP-OPERANDS)))
	(MA-HOOK-UP-OPERANDS)
	(COND (*MA-BRANCH-TENSION*
	       (when *microcompiler-verbose*
		 (PRINT '(MA-BRANCH-TENSION)))
	       (COND ((MA-BRANCH-TENSION)
		      (PRINC "Code improved, recycling")
		      (GO L)))))
       (comment
	(COND (*MA-CHART-TOPOLOGY*
	       (when *microcompiler-verbose*
		 (PRINT '(MA-CHART-TOPOLOGY)))
	       (MA-CHART-TOPOLOGY))) )
       (comment
	(COND ((AND *MA-CHART-TOPOLOGY*
		    *MA-COLAPSE-CUBBYHOLES*
		    (SETQ TEM (MA-FIND-CUBBYHOLES-TO-COLAPSE)))
	       (MA-COLAPSE-CUBBYHOLES TEM)
	       (GO L))) )
	(COND (*MA-OPTIMIZE*
	       (when *microcompiler-verbose*
		 (PRINT '(MA-OPTIMIZE)))
	       (COND ((MA-OPTIMIZE)	;returns T if significant change
		      (GO L)))))
	(when *microcompiler-verbose*
	  (PRINT '(MA-CONVERT)))
	(MA-CONVERT)
	(SETQ FUNCTION-NAME (CADR (ASSQ 'FUNCTION-NAME *MA-PARAM-LIST*)))
	(SETQ OUTPUT (LIST *MA-PARAM-LIST* (MAKE-MCLAP)))
	(SELECTQ MODE
	  (COMPILE-TO-CORE
	   (MA-INSTALL-MCLAP FUNCTION-NAME (SI:COPY-OBJECT-TREE OUTPUT)))  ;SOME STUFF IS PASSED
	;FROM THE COMPILER AND COULD BE IN A TEMPORARY AREA.  Note that the
	;  temporary-areas-only option to COPY-OBJECT-TREE will not do because permanent 
	;area stuff can point to the temporary area stuff.
	  (QFASL
	   (FASD-FORM `(MA-INSTALL-MCLAP ',FUNCTION-NAME ',OUTPUT)))
	  (REL
	   (QFASL-REL:DUMP-FORM `(MA-INSTALL-MCLAP ',FUNCTION-NAME ',OUTPUT)))
	  (OTHERWISE (FERROR NIL "~%Unknown output mode ~s" MODE)))
	(RETURN FUNCTION-NAME)))

))