PDP-10.its/src/maxtul/mcl.59

;;;-*-LISP-*-

;;; Utilities for compiling and installing Macsyma.
;;; GJC - 7:21pm  Monday, 27 October 1980
(HERALD MCL)
(OR (GET 'USER-QUERY 'VERSION) (LOAD '((maxtul)QUERY)))
(or (get 'mailer 'version) (load '((maxtul)mailer)))
(OR (GET 'BREAKLEVEL 'VERSION)
    (LOAD "LIBLSP;BREAK"))
(PUSH 'TTY-RETURN BREAK-VARS)
(PUSH '(LAMBDA (IGNORE) (FORMAT MSGFILES "~&;Still inside break level~%"))
      BREAK-VALS)
(SSTATUS BREAKLEVEL '(BREAKLEVEL))
(DEFVAR TEST-COMPILATION-P NIL)

(DEFUN TEST-JNAME-P ()
       (LET ((JNAME (STATUS JNAME)))
	    (AND (> (FLATC JNAME) 3.)
		 (= (GETCHARN JNAME 1) #/T)
		 (= (GETCHARN JNAME 2) #/M)
		 (= (GETCHARN JNAME 3) #/C)
		 (= (GETCHARN JNAME 4) #/L))))

(DEFUN ERRSET-BREAK (IGNORE-WHO-KNOWS-WHAT)
      (*BREAK T "ERRSET-BREAK. P to continue lossage."))

(DEFVAR MCL-BEFORE-PROC NIL)
(DEFVAR MCL-AFTER-PROC NIL)

;;; The first time this function gets called with (STATUS JCL)
;;; the rest of the time with NIL.

(DECLARE (SPECIAL MSDIR ; From COMPLR, tells what DIR to put UNFASL.
		  TTYNOTES ; T if output junk to TTY.
		  ))

(DEFUN *MAKLAP-DRIVER* (JCLP)
       (DO () (NIL)
	   (OR JCLP (CURSORPOS 'A TYO))
	   (AND (TEST-JNAME-P)
		(SETQ TEST-COMPILATION-P T))
	   (OR JCLP (SETQ TTYNOTES T))
	   (let ((FILENAME (namelist (cond (jclp (implode jclp))
					   (t (read-file-name ))))))
		(MCL-FILE FILENAME JCLP))
	   (AND JCLP (QUIT))))


(DEFUN MCL-FILE (NAME JCLP)
       (LET ((((DEV DIR) FN1 FN2) NAME))
	    (LET ((FASL-DIR (GET FN1 'FASL-DIR))
		  (UNFASL-DIR (GET FN1 'UNFASL-DIR))
		  PRESENT-VERSION PRESENT-NAME)
		 (SETQ PRESENT-NAME
		       (PROBEF (MERGEF NAME
					   `((DSK ,(GET FN1 'DIR)) ,FN1 >)))
		       PRESENT-VERSION (CADDR PRESENT-NAME))
		 (COND ((NOT FASL-DIR)
			(FORMAT MSGFILES
				"~
				~&; ~A is not a known Macsyma system source."
				(NAMESTRING NAME))
			(COND ((Y-OR-N-OR-?-P
				"Do you want to compile anyway"
				"Output will go to the MACSYM directory.")
			       (FORMAT MSGFILES
				       "~&; Please update MAXDOC;FILES >")
			       (MAIL-REMINDER NAME)
			       (SETQ FASL-DIR 'MACSYM)
			       (SETQ UNFASL-DIR 'MAXOUT)
			       (MCL-SUB FN1 FN2 DEV DIR
					UNFASL-DIR FASL-DIR PRESENT-VERSION
					PRESENT-NAME JCLP))))
		       (T
			(MCL-SUB FN1 FN2 DEV DIR  UNFASL-DIR FASL-DIR PRESENT-VERSION
				 PRESENT-NAME JCLP))))))


(DEFUN MCL-SUB (FN1 FN2 DEV DIR  UNFASL-DIR FASL-DIR PRESENT-VERSION PRESENT-NAME
		    JCLP)
       (IF (EQ DIR '*)
	   ;; So a user could type :MCL SIMP
	   ;; for example
	   (SETQ DIR (OR (GET FN1 'DIR) '*)))
       (SSTATUS FEATURE MACSYMA-COMPLR)
       (COND (TEST-COMPILATION-P
	      (MAKE-LAP FN1 FN2 DEV DIR DIR DIR JCLP))
	     (t
	      (COND ((COND ((SAMEPNAMEP (INSTALLED-VERSION FN1)
					PRESENT-VERSION)
			    (FORMAT MSGFILES
				    "~&; ~A has alread been compiled."
				    (NAMESTRING PRESENT-NAME))
			    (Y-OR-N-OR-?-P "Compile anyway."
					   (NAMESTRING PRESENT-NAME)))
			   (T T))
		     (MAKE-LAP FN1 FN2 DEV DIR UNFASL-DIR FASL-DIR JCLP))))))

(DEFUN MAKE-LAP (FN1 FN2 DEV DIR MSDIR FASL-DIR PROCEDE?) ; historical name.
       (UNWIND-PROTECT
	(PROGN
	 (MAPC #'EVAL MCL-BEFORE-PROC)
	 (COND (PROCEDE?
		(APPLY #'MAKLAP
		       ;; awful, have to fake it out to think it was
		       ;; passed via JCL from the COMPLR top-level init
		       ;; function!
		       (EXPLODEN (FORMAT NIL
					 "DSK:~A;~A FASL_~A:~A;~A ~A"
					 FASL-DIR FN1
					 DEV DIR FN1 FN2))))
	       (T
		(APPLY #'MAKLAP
		       ;; of course its an FSUBR which takes OLD-IO filespec
		       ;; in MIDAS style.
		       `((,FN1 FASL DSK ,FASL-DIR)  
			 (,FN1 ,FN2 ,DEV ,DIR))))))
	;; unwind protected
	(MAPC #'EVAL MCL-AFTER-PROC)))

(DEFUN MAIL-REMINDER (FILE)
       (FORMAT-MAIL (LIST "GJC MC" (STATUS UNAME))
		    "~
		      ~%The file ~A was compiled and installed into the macsyma~
		      ~%system, but was not a known source file.~
		      ~%Please update MAXDOC;FILES and//or give me more information.~
		      ~%~
		      ~%          - yours truly,~
		      ~%             The Macsyma Compiler.~%"
		    (NAMESTRING FILE)))

(DEFUN INSTALLED-VERSION (FN1 &AUX INSTREAM
			      (NAME `((DSK ,(GET FN1 'UNFASL-DIR)) ,FN1 UNFASL)))
       ; duplicates functionality in DOCGEN, although not by much,
       ; SET-CODESIZE reads the whole UNFASL file, so we don't want to
       ; use that.
       (IF (PROBEF NAME)
	   (UNWIND-PROTECT
	    (PROGN
	     (SETQ INSTREAM (OPEN NAME 'IN))
	     ; (QUOTE (THIS IS THE UNFASL FOR ((DSK FOO) BAR N)))
	     (CADDR (CAR (LAST (CADR (READ INSTREAM))))))
	    (IF INSTREAM (CLOSE INSTREAM)))
	   (FORMAT MSGFILES
		   "~&; Unfasl file ~A not found.~%"
		   NAME)))

(sstatus ttyint #^N #'ttynotes-toggle)

(defun ttynotes-toggle (stream char)
  (if (= char (tyipeek () stream -1))
      (tyi stream))
  (FORMAT T "~&; Setting TTYNOTES to ~S~%"
	  (setq ttynotes (not ttynotes))))

(defun present-version (f)
  (caddr (probef `((dsk ,(get f 'dir)) ,f >))))

(defun todo () (setq todo
  (mapcan #'(lambda (f)
	      (if (get f 'macro-file) nil
		  (if (samepnamep (present-version f)
				  (installed-version f))
		      nil
		      (list f))))
	  macsyma-file-names)))
(defun todoi () (setq todoi (mapcan #'(lambda (u) (if (get u 'in-core)
						      (list u)))
				    todo)))

(defun doit (f) (mcl-file `((* *) ,f *) nil))

(if (probef "dsk:maxtul;files todo")
    (load "dsk:maxtul;files todo"))

(defun findout (&aux s)
  (unwind-protect
    (let ((msgfiles
	   (setq s (open "dsk:maxtul;files _todo_" 'out))))
      (todo)
      (todoi)
      (print `(setq when ,(time:print-current-date nil)) s)
      (print `(setq todo ',todo) s)
      (print `(setq todoi ',todoi) s)
      (renamef s "dsk:maxtul;files todo"))
    (if s (close s))))