;;; -*- Mode:LISP; Package:USER; Base:10 -*- 

(if (= 102 (si:get-system-version))
    (sstatus feature release-2))

#+(AND LMI (NOT RELEASE-2))
(PROGN 
;; in lmi system (not TI).
(let ((physical-memory (aref #'si:system-communication-area si:%sys-com-memory-size)))
  ;;(virtual-memory si:virtual-memory-size)
  (setf (aref gc:*level-control* 3) (floor (* physical-memory 0.05)))
  (setf (aref gc:*level-control* 2) (floor (* physical-memory 0.15)))
  (setf (aref gc:*level-control* 1) nil)
  (setf (aref gc:*level-control* 0) nil)
  (gc:status))

(when (eq si:local-host (si:parse-host "DJ"))
  (setq fs:*disk-space-warner-threshold* 2000)
  (fs:start-disk-space-warner-process)
  t)

(defun info ()
  (time:print-uptime)
  (gc:status)
  (gc:print-statistics)
  (and (fboundp 'fs:print-server-lossages)
       (fs:print-server-lossages)))

(defun coffe-break ()
  (gc:status)
  (if (y-or-n-p "~&Do you want to flip level 1?")
      (gc:flip :volatility 1))
  "gone for a coffe break")

(defun make-macsyma (&optional (system 'doe-macsyma) &rest args)
  (setq si:*all-free-interpreter-variable-references-special* t)
  (let ((l (listarray gc:*level-control*))
	(r gc:*report-volatility*))
    (unwind-protect
      (let ((physical-memory (aref #'si:system-communication-area si:%sys-com-memory-size)))
	;;(virtual-memory si:virtual-memory-size)
	(setf (aref gc:*level-control* 3) (floor (* physical-memory 0.15)))
	(setf (aref gc:*level-control* 2) (floor (* physical-memory 0.45)))
	(setf (aref gc:*level-control* 1) nil)
	(setf (aref gc:*level-control* 0) nil)
	(setq gc:*report-volatility* 2)
	(gc:status)
	(let ((compiler:*QC-FILE-OUTPUT-SAME-VERSION* nil)
	      (compiler:*QC-FILE-OUTPUT-DRIBBLE-TYPE* "TEXT"))
	  (apply 'make-system system args)))
      (fillarray gc:*level-control* l)
      (setq gc:*report-volatility* r))))


(DEFUN MCL (NAME &OPTIONAL (DIR (OR (GET (INTERN (STRING NAME) "") 'MACSYMA-SOURCE-DIRECTORY)
				    (PROMPT-AND-READ :STRING "~&Directory of macsyma source ~A:" NAME))))
  (PUTPROP (INTERN (STRING NAME) "") DIR 'MACSYMA-SOURCE-DIRECTORY)
  (setq si:*all-free-interpreter-variable-references-special* t)
  (let ((compiler:*QC-FILE-OUTPUT-SAME-VERSION* nil)
	(compiler:*QC-FILE-OUTPUT-DRIBBLE-TYPE* "TEXT"))
    (QC-FILE (FORMAT NIL "MACSYMA-SOURCE:~A;~A LISP >" DIR NAME)
	     (FORMAT NIL "MACSYMA-OBJECT:~A;~A QFASL >" DIR NAME))))


(DEFUN ML (NAME &OPTIONAL (DIR (OR (GET (INTERN (STRING NAME) "") 'MACSYMA-SOURCE-DIRECTORY)
				    (PROMPT-AND-READ :STRING "~&Directory of macsyma source ~A:" NAME))))
  (PUTPROP (INTERN (STRING NAME) "") DIR 'MACSYMA-SOURCE-DIRECTORY)
  (setq si:*all-free-interpreter-variable-references-special* t)  
  (LOAD (FORMAT NIL "MACSYMA-OBJECT:~A;~A" DIR NAME)))


(DEFUN SET-MACSYMA-SOURCE-DIRECTORIES ()
  (DOLIST (F (SI:SYSTEM-SOURCE-FILES 'DOE-MACSYMA))
    (LET ((D (SEND F :DIRECTORY)))
      (PUTPROP (INTERN (STRING (SEND F :NAME)) "")
	       (COND ((ATOM D) D)
		     ((= (LENGTH D) 1) (CAR D))
		     ('ELSE D))
	       'MACSYMA-SOURCE-DIRECTORY))))

)


#+TI
(PROGN

(or (get 'si:parse-host 'losing-definition)
    (putprop 'si:parse-host #'si:parse-host 'losing-definition))

(defun winning-parse-host (host &optional no-error-p (unknown-ok t))
  (funcall (get 'si:parse-host 'losing-definition)
	   host no-error-p unknown-ok))


(fset'si:parse-host 'winning-parse-host)

)

(defvar *macsyma-howfar* nil)

(DEFUN macsyma-howfar ()
  (let ((L (FS:DIRECTORY-LIST "lam3:doe-macsyma.rel3-objects;*.qfasl#>")))
    (format t "~&~A~%" (get (car l) :disk-space-description))
    (setq *macsyma-howfar* 
	  (SORT (cdr l)
		#'(LAMBDA (X Y)
		    (< (GET X :CREATION-DATE)
		       (GET Y :CREATION-DATE)))))
    (DOLIST (E *macsyma-howfar*)
      (FORMAT T "~10A " (SEND (CAR E) :NAME))
      (TIME:PRINT-UNIVERSAL-TIME (GET E :CREATION-DATE))
      (TERPRI))
    (time:print-interval-or-never
      (and *macsyma-howfar*
	   
	   (- (GET (CAR (LAST *MACSYMA-HOWFAR*)) :CREATION-DATE)
	      (GET (CAR *MACSYMA-HOWFAR*) :CREATION-DATE)))
      nil)))