;	Wednesday  Nov 18,1981  21:22  FM+7D.7H.1M.49S.  -*- Lisp -*-

(eval-when (eval compile)
  (or (status feature patch-definitions)
      (load (cond ((probef (cons (car (truename infile)) '(patdef fasl))))
		  (t (and (not (get 'lsb1 'ppn))
			  (caseq (status site)
			    ((SCRC-TENEX)
			       (defprop lsb1 (dsk lsb1) ppn))
			    ((MIT-SPEECH XX)
			       (defprop lsb1 (ps lsb) ppn))))
		     '((lsb1) patdef))))))

(defun test-init-file (fn1 default)
  (rplaca (cdr default) fn1)
  (rplaca (car default) (car *patsys-devdir-default))
  (car (errset (open default 'nodefault) nil)))


#-ITS
(defvar *job-startup-jcl
  ())

#+TOPS-20
(defvar *job-startup-ojcl
  ())

(defun get-jcl ()
  #+ITS (status jcl)
  #-ITS (append *job-startup-jcl ()))

#+TENEX
(lap-a-list '(
    (lap +internal-get-jcl subr)
    (args +internal-get-jcl (nil . 0))
	(movei a #o100)		;.priin
	(jsys 0 #o42)		;bkjfn
	 (jrst 0 nojcl)
	(jsys 0 #o73)		;pbin
	(caie a #o40)
	 (jrst 0 nojcl)
	(movei a 't)
	(call 1 (function readline))
	(jcall 1 (function explodec))

    nojcl
	(setz a)
	(popj p)
    nil))

(defun job-startup n
  #+TENEX
    (let ((jcl (+internal-get-jcl))) (and jcl (setq *job-startup-jcl jcl)))
  #+TOPS-20
    (let ((jcl (status jcl)) (word nil))
      (cond ((null jcl))
	    (t (setq *job-startup-ojcl (append jcl ()))
	       (cond ((eq (car jcl) '| |) (setq jcl (cdr jcl)))
		     (t (loop while jcl as ch fixnum = (getcharn (car jcl) 1)
			      do (setq jcl (cdr jcl))
			      until (= ch #\sp)
			      when (lessp #.(1- #/a) ch #.(1+ #/z))
			        do (setq ch (- ch #.(- #/a #/A)))
				do (push ch word))
			(cond ((memq (implode word) '(R RU RUN))
			         (cond ((eq (car jcl) '|(|)
					(loop as c = (car jcl)
					      do (setq jcl (cdr jcl))
					      until (eq c '|)|))
					; Flush final space.
					(setq jcl (cdr jcl))))
				 ;Flush program name.
				 (loop until (memq (car jcl) '(| | /î /
))
				       do (setq jcl (cdr jcl)))
				 ;Flush trailing frobozz.
				 (setq jcl (cdr jcl))))))
	       ; We understand <cr> but neither <lf> nor <crlf>.
	       (and (eq (car (setq jcl (nreverse jcl))) '/
)
		    (setq jcl (cdr jcl)))
	       (and jcl (or (eq (car jcl) '/î) (push '/î jcl)))
	       (setq *job-startup-jcl (nreverse jcl)))))
  (si:update-system-statuses nil)
  (terpri)
  (princ (si:system-version-info))
  (let ((tem (listify (- 2 n)))) (and tem (apply 'load-patches tem)))
  (funcall (if (arg 2) 'include-init-file 'load-init-file) (arg 1)))

(args 'job-startup '(2 . 510.))

#-ITS
(defvar *default-init-pathname
  (list *patsys-devdir-default '* 'ini))

(defun include-init-file (init-file-type
			  &aux (jcl (get-jcl)) tem file fname crockp
			       (who (status useri)) (hdir (status homed))
			       (udir (status udir)))
  (cond ((not (null jcl))
	 (and (memq (car (setq jcl (nreverse jcl))) '(/ / /î))
	      (setq jcl (cdr jcl)))
	 (cond ((null jcl) (setq file '| |))
	       ((setq tem (memq '/ jcl))
		(and (setq tem (reverse (cdr tem))) (setq file (maknam tem))))
	       (t (setq file (maknam (nreverse jcl)))))))
  (and file (samepnamep file '| |) (setq file nil crockp t))
  (cond ((and (not (null file))
	      (eq (cadr (setq file (namelist file))) '*)
	      (eq (caddr file) '*))
	   (cond ((not (eq (cadar file) '*))
		    (setq who (cadar file)
			  hdir (setq udir #+ITS (status hsname who)
					  #-ITS who))))
	   (cond ((not (eq (caar file) '*))
		    (rplaca *patsys-devdir-default (caar file))))
	   (setq file nil)))
  (defaultf (mergef `((,udir) ,init-file-type) *patsys-lisp-default))
  (cond ((or (and file (setq file (open file)))
	     (and (not crockp)
		  (setq file (or (test-init-file
				    who 
				    (setq fname (list (list '* hdir)
						      who init-file-type)))
				 (test-init-file
				    #+ITS '* #-ITS 'default-init fname)
				 #-ITS (car (errset
					     (open
					      (setq fname
						    (mergef
						     `((* ,hdir)
						       ,init-file-type)
						     *default-init-pathname)))
					     nil)))))
	     (and (setq fname (get init-file-type 'default-init-file))
		  (errset (setq file (open fname)) nil)))
	   (?format nil '|~&Including init file ~A~%|
		   (namestring (truename file)))
	   ; Not setting the eoffn to +internal-include-eoffn works
	   ; with the lisp top-level loop, and also adds the "feature"
	   ; that you get a newline-prompt when it is done.  Otherwise
	   ; you never see it because the eof causes that particular
	   ; call to read to (inpush -1) and just keep reading.
	   ; (eoffn file '+internal-include-eoffn)
	   (inpush file)
	   (setq ^q t))))

(defun load-init-file (init-file-type &aux f fname (hdir (status homed)))
  (setq fname `((* ,hdir) * ,init-file-type))
  (cond ((or (setq f (test-init-file (status xuname) fname))
	     (setq f (test-init-file #+ITS '* #-ITS 'default-init fname))
	     #-ITS (setq f (car (errset
				  (open
				   (setq fname
					 (mergef`((,hdir) ,init-file-type)
						*default-init-pathname)))
				  nil)))
	     (and (setq fname (get init-file-type 'default-init-file))
		  (errset (setq f (open fname)) nil)))
	 (?format nil '|~&Loading init file ~A~%|
		  (namestring (setq fname (truename f))))
	 (close f)
	 ;Kludge so that "*" merging doesn't happen on the FN1.
	 (let ((defaultf fname)) (load f)))))

(or (memq 'default-init-file putprop) (push 'default-init-file putprop))

(or (fboundp '?format) (get '?format 'autoload)
    (putprop '?format (get 'format 'autoload) 'autoload))