(comment ) ;;; -*-LISP-*- (progn ;Closes INIT file, if any, or else LOAD file (and (filep uread) (close uread)) (and (filep infile) (not (eq infile tyi)) (close infile)) (setq infile 'T) (and (status feature ITS) (or (get 'SHARABLE 'VERSION) ((lambda (PURE *PURE) (load '((LIBLSP) SHARABLE)) (fasload (LISP) DEFMAX) (or (status FEATURE SHARABLE) (sstatus FEATURE SHARABLE))) T () ))) (setq PUTPROP (purcopy (append '(STRUCT=INFO SELECTOR CONSTRUCTOR AUTOLOAD VERSION CARCDR |side-effectsp/|| SETF-X GRINDFN GRINDPREDICT GRINDMACRO GRINDFLATSIZE) PUTPROP)) PURE-PUTPROP PUTPROP) (setq PURE 1 *PURE T *RSET T) ((lambda (PURE *PURE PUTPROP DEFAULTF) (mapc '(lambda (x) (cond ((get x 'VERSION) (error x "Howcum this is already loaded?")) (T (load x)))) '(BACKQ SHARPM MACAID LET MLMAC MLSUB CNVD DEFMACRO EXTSTR DEFVSY SETF EVONCE QUERIO YESNOP ERRCK CERROR GRINDEF FORMAT))) T T PURE-PUTPROP '((LISP) * FASL)) (pagebporg) ;;Just get version number now, and directory name (setq MACDMP (cond ((status feature ITS) (setq MACFIX (nth 2 (probef '((DSK LSPDMP) MACDMP >)))) '(DSK LSPDMP)) ((status feature DEC20) (setq MACFIX (nth 3 (probef ((LISP) MACDMP EXE /0)))) '(LISP)) (T (error "Can't be done on DEC10 systems yet")))) ;;Increment the dumped-out version number (setq MACFIX (cond ((null MACFIX) '/1000) (((lambda (BASE IBASE *NOPOINT) (implode (exploden (1+ (readlist (exploden macfix)))))) 10. 10. T)))) (putprop 'MACLISP MACFIX 'VERSION) (setq MACFIX (list MACFIX)) (if (status feature DEC20) (setq MACFIX (cons 'EXE MACFIX))) (psetq MACDMP (list* MACDMP 'MACDMP MACFIX) MACFIX (list* MACDMP 'MACFIX MACFIX)) (SETQ *PURE () ) (sstatus TOPLEVEL '((lambda () (sstatus TOPLEVEL () ) (setq - () + () ) (gctwa) (gc) (cond ((and (fboundp 'PURE-SUSPEND) (fboundp 'ANNOUNCE-&-LOAD-INIT-FILE)) (pure-suspend "MACLISPJ:VP " MACDMP) (announce-&-load-init-file 'MACLISP (status JCL) MACFIX)) ('T (suspend) (setq infile 'T) (format msgfiles "~&MACLISP ~A~%" (get 'MACLISP 'VERSION)) (setq defaultf (list (cond ((eq (status FILESYSTEM-TYPE) 'DEC20) '(PS *)) ((list 'DSK (status UDIR)))) '* (cond ((status FEATURE ITS) '>) ((status FEATURE SAIL) '|___|) ('T 'LSP)))) (let ((x (status USERID)) y) ;;Use only last part of USERID, since it might be ;; like G.JONL, and we'd have to do something about ;; the "." in a file extension name. (prog () (if (do ((i (flatc x) (1- i))) ((= i 0) 'T) (and (= (getcharn x i) 46.) (return () ))) ;;Just exit, if no "."'s present (return () )) (setq x (exploden x)) A (or (setq y (cdr (member 46. x))) (return (setq x (maknam x)))) (setq x y) (go A)) (setq y (status jcl)) ;; x will be USERID, y will be JCL (setq x (if y (probef (mergef (maknam (nreverse (cdr (reverse y)))) '(* NILAID))) (probef (list x 'MACLISP)))) (cond (x (format T "~%Loading /"~A/" (MACLISP.init file)~%" (namestring x) ) (and (atom (errset (load x))) (princ '| **** Errors while loading|)))) (gctwa)) '*))))) (*throw () () ))