perm filename SYLOAD.LSP[SCH,LSP] blob sn#688848 filedate 1982-11-14 generic text, type C, neo UTF8
COMMENT āŠ—   VALID 00003 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	(setq ibase 10. base 10.)
C00004 00003	)
C00008 ENDMK
CāŠ—;
(setq ibase 10. base 10.)
	   
(or (boundp 'load-version-alist)
    ;; set this variable before loading SYSLOADER to
    ;; cause the loading of specific versions of the modules
    ;; otherwise the newest versions of the FASL's will be
    ;; loaded.
    (setq load-version-alist ()))
;; this next statement is for dumping in an old lisp.
(progn
 (or (boundp 'file-exit-functions)
     (setq file-exit-functions ()))
 (defun file-exit-functions-check ()
   (cond ((null file-exit-functions))
	 ((y? "There are file-exit-functions. Run them?")
	  (mapc '(lambda (x) (funcall x ()))
		(prog1 file-exit-functions
		       (setq file-exit-functions ()))))))
(defun y? (message)
  (do ((c))
      (nil)
    (cursorpos 'a tyo)
    (princ message)
    (setq c (readch tyi))
    (cond ((eq c '/
)
	   (cursorpos 'c tyo))
	  ((member c '(/y /Y))
	   (princ "es." tyo)
	   (return t))
	  ((member c '(/n /N))
	   (princ "o." tyo)
	   (return nil))
	  (t
	   (princ " please reply Y or N." tyo)))))
 )

(defun load-version n
  (do ((module (arg 1))
       (fname (cond ((= n 1) (arg 1)) (t (mergef (arg 2) (arg 1))))))
      ('once
       (cond ((not (get module 'version))
	      (setq fname (mergef fname "<ls.scheme>"))
	      (setq fname
		    (mergef fname
			    (list '(* *)
				  '* 'fasl
				  (or (cdr (assq module
						 load-version-alist))
				      "0"))))
	      (print (list 'loading fname '= (probef fname)) msgfiles)
	      (load fname)
	      (file-exit-functions-check)
	      )))))

(cond ((alphalessp (status lispv) '|2035|)
       (do ((*pure t))
	   (t
	    (load-version 'turd))))
      (t
;;;    (defprop lisp (* |maclisp.new|) ppn)    nmaclisp is new.
       ))

;; this GC-overflow setting will be overwritten when Scheme does
;; its SETUP.
(defun gc-overflow-for-loading (space)
  (terpri msgfiles)
  (princ ";allocating " msgfiles)
  (princ space msgfiles)
  (princ " space." msgfiles)
  (terpri msgfiles)
  '(t))
(setq gc-overflow 'gc-overflow-for-loading)
;; Static properties.
(setq putprop (append '
	       (FORMAT-CTL-ONE-ARG
		FORMAT-CTL-MULTI-ARG FORMAT-CTL-NO-ARG
		FORMAT-CTL-REPEAT-CHAR
		DEFSTRUCT-DESCRIPTION
		DEFSTRUCT-NAME GRUBOUT-TTY-OP
		DEFSTRUCT-SLOT FETCH ASSIGN SAVE RESTORE
		GET-STATE SET-STATE RACK-NUMBER RACK-TYPE
		GRINDMACRO SYNTAX-PROCESSOR PROCEDURE-CLASS
		VERSION EXPRESSION-CLASS UNSYNTAX-PROCESSOR
		MACROEXPANDED MACRO AUTOLOAD)
	       putprop))

(do ((*pure t))
    (t
     ;;(load-version 'debug '((lisp)))
     (load-version 'format '((lisp)))
     (load-version 'scheme 'newsys)
     (load-version 'grub 'gjc-reader)
     (remprop grubout-tty-plist 5.)
     (load-version 'schedit)
     (load-version 'gcdemn '((lisp)))
     (load-version 'sysdebug)
     (file-exit-functions-check)))

(setq monitor-continue-string "")
(setq *editor-job-name* 'emacs)