(in-package 'compiler)
(defun make-user-init (files outn)

  (let* ((c (pathname outn))
	 (c (merge-pathnames c (make-pathname :directory '(:current))))
	 (o (merge-pathnames (make-pathname :type "o") c))
	 (c (merge-pathnames (make-pathname :type "c") c)))
  
  (with-open-file (st c :direction :output)
		  (format st "#include ~a~%~%" *cmpinclude*)

		  (format st "#define load2(a) do {")
		  (format st "printf(\"Loading %s...\\n\",(a));")
		  (format st "load(a);")
		  (format st "printf(\"Finished %s...\\n\",(a));} while(0)~%~%")

		  (let ((p nil))
		    (dolist (tem files)
		      (when (equal (pathname-type tem) "o")
			(let ((tem (namestring tem)))
			  (push (list (si::find-init-name tem) tem) p))))

		    (setq p (nreverse p))

		    (dolist (tem p)
		      (format st "extern void ~a(void);~%" (car tem)))
		    (format st "~%")

		    (format st "typedef struct {void (*fn)(void);char *s;} Fnlst;~%")
		    (format st "#define NF ~a~%" (length p))
		    (format st "static Fnlst my_fnlst[NF]={")
		    (dolist (tem p)
		      (when (not (eq tem (car p)))
			(format st ",~%"))
		      (format st "{~a,\"~a\"}" (car tem) (cadr tem)))
		    (format st "};~%~%")
		    
		    (format st "static int user_init_run;~%")
		    (format st "#define my_load(a_,b_) {if (!user_init_run && (a_) && (b_)) gcl_init_or_load1((a_),(b_));(a_)=0;(b_)=0;}~%~%")
                    
		    (format st "object user_init(void) {~%")
		    (format st "user_init_run=1;~%")
		    (dolist (tem files)
		      (let ((tem (namestring tem)))
			    (cond ((equal (cadr (car p)) tem)
				   (format st "gcl_init_or_load1(~a,\"~a\");~%"
					   (car (car p)) tem)
				   (setq p (cdr p)))
				  (t 
				   (format st "load2(\"~a\");~%" tem)))))
		    (format st "return Cnil;}~%~%")

		    (format st "int user_match(const char *s,int n) {~%")
		    (format st "  Fnlst *f;~%")
		    (format st "  for (f=my_fnlst;f<my_fnlst+NF;f++){~%")
		    (format st "     if (f->s && !strncmp(s,f->s,n)) {~%")
		    (format st "        my_load(f->fn,f->s);~%")
		    (format st "        return 1;~%")
		    (format st "     }~%")
		    (format st "  }~%")
		    (format st "  return 0;~%")
		    (format st "}~%~%")))
		    
  (compiler-cc c o)
  (delete-file c)

  o))
(in-package 'user)
(let ((si::*collect-binary-modules* t) ;; Collect a list of names of each object file loaded 
      si::*binary-modules*
      (compiler::*default-system-p* t));; .o files to be linked in via ld
		                       ;; must be compiled with :system-p t
		       
  
  (let ((com (quote    ;; This is a command to build acl2 which will be run twice --
	               ;; once in stock gcl, compiling files, loading and recording same
	               ;; once in an image which is linked via ld from the results of the above
	               ;;   redirecting each load to an initialization of the .o file already
	               ;;   linked into the image by ld
	      (progn
		(load "init.lisp")
		(let* ((la (find-symbol "LOAD-ACL2" "ACL2"))  ;; acl2::load-acl2 doesn't exist at read-time
		       (olf (symbol-function la))
		       (si::*collect-binary-modules* t))      ;; make sure the second pass watches for
		                                              ;; .o loads, for the purpose of triggering an error
		  (unless (probe-file "axioms.o")             ;; no sense to compile twice
		    (funcall (symbol-function (find-symbol "COMPILE-ACL2" "ACL2")))
		    (delete-package "ACL2-PC"))               ;; prevent package error when loading after compiling 
		  (funcall olf)                               ;; must load-acl2 to establish the symbols below 
                  (defparameter user::*fast-acl2-gcl-build* t)
                  (defparameter user::*acl2-keep-tmp-files* :no-pid)
		  (let ((sa (find-symbol "SAVE-ACL2" "ACL2"))
			(ia (find-symbol "INITIALIZE-ACL2" "ACL2"))
			(ib (find-symbol "INCLUDE-BOOK" "ACL2"))
			(ap2f (find-symbol "*ACL2-PASS-2-FILES*" "ACL2"))
			(ocf (symbol-function 'compiler::compile))
			(osf (symbol-function 'si::save-system)))
		    (setf (symbol-function 'compiler::compile)     ;; For now, run closures interpreted
			  (lambda (x) (symbol-function x)))        ;; At some point, could compile saved
		                                                   ;; gazonk files without loading (i.e.
		                                                   ;; returning interpreted code) on first pass
		                                                   ;; then don't compile by load -> initialize
		                                                   ;; on second pass.  Cannot load via dlopen
		                                                   ;; more than 1024 files at once, and this is
		                                                   ;; the only relocation mechanism currently
		                                                   ;; available on ia64,alpha,mips,hppa
		                                                   ;; On first attempt, failure on initizlization of
		                                                   ;; acl2_gazonk3558.o
		    (setf (symbol-function la) (lambda () nil))    ;; save-acl2 calls load-acl2, but we can't load
		                                                   ;; twice when initializing in reality.
		    (setf (symbol-function 'si::save-system)       ;; Restore all moved functions on save-system
			  (lambda (x)
			    (setf (symbol-function 'compiler::compile) ocf)
			    (setf (symbol-function la) olf)
			    (setf (symbol-function 'si::save-system) osf)
			    (when si::*binary-modules*             ;; Saving when a .o has been loaded is a no-no
			      (error "Loading binary modules prior to image save in dlopen image: ~S~%"
				     si::*binary-modules*))
			    (funcall osf x)))
		    (let* ((no-save si::*binary-modules*))         ;; Don't call save-system on first pass
		      (funcall (symbol-function sa)
			       (list ia (list 'quote ib) ap2f (concatenate 'string (namestring (truename "")) "books/")) ;; save-acl2
			       nil
			       no-save))))))))
    
    (eval com)                                                       ;; first evaluate the command in gcl
    (compiler::link                                                  ;; link in the .o files with ld
     (remove-duplicates si::*binary-modules* :test (function equal)) ;; collected here
     "saved_acl2"                                                    ;; new image
     (format nil "~S" com)                                           ;; run the build sequence again in this image
                                                                     ;; with load redirected to initialize
     ""        
     nil)))
(good-bye)

