;;;   GGLOAD 						  -*-LISP-*-
;;;   **************************************************************
;;;   ***** Maclisp ****** Load-up EXPR Compiler - a GreenGiant ****
;;;   **************************************************************
;;;   ** (c) Copyright 1981 Massachusetts Institute of Technology **
;;;   ****** this is a read-only file! (all writes reserved) *******
;;;   **************************************************************


(COMMENT FLPDL 64. REGPDL 2560. SPECPDL 2048.)

;;; Following code must come before everything else, so that only the 
;;;   important symbols get on the copy of the initial OBARRAY.
;;;   PURCOPYs the buckets of the initial OBARRAY copy.



(DEFUN CC:subload MACRO (x)
   (subst (cadr x) 'X '(OR (GET 'x 'VERSION) (FASLOAD (LISP) x))))

;;;; pure ATOM list for OBARRAY


(PROG (N READTABLE)
	 (SETQ *RSET () NOUUO () NORET 'T USERATOMS-HOOKS () ) 
	 (SETQ CCLOAD:PUTPROP PUTPROP 
	       CCLOAD:INITIAL-PROPS () )
	 (SETQ READTABLE (ARRAY () READTABLE 'T)
	       N (- (CADR (ARRAYDIMS 'OBARRAY)) 129.))
	 (COMMENT   ;Put on both obarrays
		   IGNORE COMPLRVERNO BITS PAIR CHARACTER TYPE-OF 
		   VECTORP STRINGP BITSP TYPECASEQ PTR-TYPEP *:TRUTH 
    ;		   MAKE-VECTOR VREF VSET VECTOR-LENGTH  
    ;		   BITS BIT RPLACBIT NIBBLE SET-NIBBLE 
    ;		   MAKE-STRING CHAR RPLACHAR CHAR-N RPLACHAR-N  
    ; 		   EXTEND SI:EXTENDP VECTOR STRING +INTERNAL-STRING-MARKER
    ;		   VERSION  PAIRP
		   +INTERNAL-TEMP-MARKER :LOCAL-VAR  CL:CL SOURCE-TRANS  ACS 
	           *EXPR *FEXPR *LEXPR **LEXPR @DEFINE ARRAY*  RUNTIME-LIMIT 
		   CHOMP CHOMPHOOK CMSGFILES COBARRAY COMPILE COMPLR
		   STRUCT-LET  EVONCE  EVAL-ONCE  EVAL-ORDERED EVAL-ORDERED* 
		   GRIND-MACROEXPANDED  GENVALS  GENSYMS  |DEFUN&-CHECK-ARGS| 
		   |DEFUN&-ERROR| CERROR  FERROR  CERROR-PRINTER  ERROR-OUTPUT 
		   COUTPUT  CREADTABLE  EOC-EVAL  EOF-COMPILE-QUEUE &BODY
		   GENPREFIX  ALLOC-MARK-RATIO  GOFOO MACRO-EXPAND  MACROLIST 
		   MAKLAP  MSDEV  MSDIR  NCOMPLR  NO-EXTRA-OBARRAY  NOTYPE  
		   NUMFUN  NUMVAR  ONMLS  OWN-SYMBOL  RECOMPL  SETVST   DISOWN 
		   SKIP-WARNING  LODBYT  SI:PICK-A-MASK  TTYNOTES-FUNCTION
		   SOBARRAY  SPECIAL  SPLITFILE  SPLITFILE-HOOK  SQUID 
		   SREADTABLE  SWITCHTABLE  TOPLEVEL  UNDFUNS  UNSPECIAL 
		   PRATTSTACK  USERATOMS-HOOKS  USER-STRING-MARK-IN-FASL
		   QUERY-IO  Y-OR-N-P  YES-OR-NO-P  SI:LOST-MESSAGE-HANDLER 
		   SETF  +INTERNAL-SETF-X  SETF-SIMPLEP-SCAN  STRUCT-SETF 
		   SETF-STRUCT SETF-X  CONS-A-SETF  SETF-CLASS    

		   USER-SLOT SETF-USER-SLOT  GENSYMS SETF-GENSYMS 
		   GENVALS SETF-GENVALS  INVERT SETF-INVERT 
		   ACCESS SETF-ACCESS  RET-OK SETF-RET-OK  
		   SIDE-EFFECTS SETF-SIDE-EFFECTS  I-COMPUTE SETF-I-COMPUTE 
		   COMPUTE SETF-COMPUTE 

		   LEXPR-SEND LEXPR-SEND-AS SEND-AS :SEND 
		   EXTSFA DEFSFA  SFA-UNCLAIMED-MESSAGE SI:DEFSFA-ACCESSOR 
		   SI:DEFSFA-CREATOR  SI:INIT-SFA DEFSFA-NAME DEFSFA-INITP 
		   DEFSFA-SIZE DEFSFA-HANDLER DEFSFA-INITS DEFSFA-IDX
		   WHICH-OPERATIONS  SI:WHICH-OPERATIONS-INTERNAL :INIT 
		   SFA-UNCLAIMED-MESSAGE   )
	 (ALLOC '(FIXNUM (2048. 10240. .25) FLONUM (256. 4096. .10) 
		  BIGNUM (256. 4096. .10) SYMBOL (1536. 8192. .25) 
		  ARRAY (64. 1024. 64.) ))
	 (AND (STATUS FEATURE ITS) (ALLOC '(LIST (14336. 40960. .35))))
	 (cond 
	   ((status feature SHARABLE) (setq PUTPROP PURE-PUTPROP))
	   ('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 PUTPROP (purcopy (append '(CARCDR FUNTYP-INFO ARGS) PUTPROP)))
	  ;; THESE ARE "BOOTSTRAP" VERSIONS - WILL BE REDEFINED BY MAKLAP FILE
	 ((lambda (pure *pure)
		  (DEFUN CCLOAD:BOOTMACS (Y Z)
			  ;; CCLOAD:INITIAL-PROPS is a list of items like 
			  ;;  (<name> <prop1> <prop2> ... <propn>), where each
			  ;;  'prop' is to be preserved over INITIALIZE-ation.
		     ((LAMBDA (W) 
			 (COND (W (RPLACD W (CONS Z (CDR W))))
			       ((SETQ CCLOAD:INITIAL-PROPS 
				      (CONS (LIST Y Z)
					    CCLOAD:INITIAL-PROPS)))))
		      (ASSQ Y CCLOAD:INITIAL-PROPS))
		     () )
		  (DEFUN SPECIAL MACRO (L) 
			 (MAPC '(LAMBDA (X) 
				   (PUTPROP X (LIST 'SPECIAL X) 'SPECIAL)
				   (CCLOAD:BOOTMACS X 'SPECIAL))
			       (CDR L))
			 ''SPECIAL)
		  (DEFUN *LEXPR MACRO (L) 
			 (MAPC '(LAMBDA (X) 
				   (PUTPROP X 'T '*LEXPR)
				   (CCLOAD:BOOTMACS X '*LEXPR))
			       (CDR L))
			 ''*LEXPR)
		  (DEFUN *EXPR MACRO (L) 
			 (MAPC '(LAMBDA (X) 
				   (PUTPROP X 'T '*EXPR)
				   (CCLOAD:BOOTMACS X '*EXPR))
			       (CDR L))
			 ''*EXPR)
		  )
	    () () )
	 (SETQ CCLOAD:BOOTMACS '(SPECIAL *EXPR *LEXPR))
	 (and (status feature ITS) 
	      (SETQ CCLOAD:DUMPFILE () CCLOAD:DUMPVERNO '/0))
	 (SETQ CCLOAD:PURE PURE 
	       *PURE (STATUS FEATURE PAGING) 
	       PURE (COND ((STATUS FEATURE PAGING)
			    1)
			  ((status nofeature SAIL) -1) 
			  ('T (COND ((STATUS FEATURE NCOMPLR) 
				     (SETQ CCLOAD:PURESEG T) -1)
				    ((STATUS FEATURE BCOMPLR) 
				     (SETQ CCLOAD:PURESEG ()) 1)
				    ('T (TERPRI) (PRINT 'PURE) (PRINT '| |) 
					(PRINT '=) (PRINT '| |)  (PRINT '?)
					(TERPRI) (BREAK NCOMPLR))) )))
	 (and (status FEATURE SAIL) (SETQ CCLOAD:PURESEG (EQUAL PURE -1)))
	 (SSTATUS FEATURE COMPLR)
	 ((LAMBDA (PUTPROP)
		  (CC:subload DEFMAX)
		  (CC:subload MACAID)
		  (CC:subload EXTSTR)
		  (CC:subload EXTHUK)
		  (CC:subload DEFVSY)
		  (CC:subload MLMAC)
		  (CC:subload MLSUB)
		  (OR (FBOUNDP (CAR (STATUS MACRO /#)))
		      (CC:subload SHARPM))
		  (OR (FBOUNDP (CAR (STATUS MACRO /`)))
		      (CC:subload BACKQ))
		  (CC:subload BS))
	   (CONS 'MACRO (APPEND CCLOAD:BOOTMACS PUTPROP)))
	 (progn  ;;Patch-up declarations
		(or (memq 'EXTSTR-USERATOMS-HOOK USERATOMS-HOOKS)
		    (push 'EXTSTR-USERATOMS-HOOK USERATOMS-HOOKS))
		(mapc '(lambda (x) 
			       (or (get x '*LEXPR)
				   (eq (car (get x 'FUNTYP-INFO)) 'LSUBR)
				   (eval (list '*LEXPR x))))
		      '(GENTEMP SETSYNTAX-SHARP-MACRO SI:LOST-MESSAGE-HANDLER 
			CERROR SEND SEND-AS LEXPR-SEND LEXPR-SEND-AS))
		(mapc '(lambda (x) 
			       (or (get x 'SPECIAL) (eval (list 'SPECIAL x))))
		      '(GENTEMP SI:CLASS-MARKER  SI:SKELETAL-CLASSES 
			CLASS-CLASS OBJECT-CLASS SEQUENCE-CLASS 
			VECTOR-CLASS STRUCT-CLASS STRUCT=INFO-CLASS 
			SI:CHECK-MULTIPLICITIES BACKQUOTE-EXPAND-WHEN 
			/#-MACRO-DATALIST ERROR-OUTPUT CERROR-PRINTER ))

		)
	 (REMOB 'CC:subload)
	 (SETQ SAIL-MORE-SYSFUNS () )
	 (and (status FEATURE SAIL)
	      (FASLOAD (DSK (MAC LSP)) MATCH FAS))
	 (MAPC '(LAMBDA (X) (CCLOAD:BOOTMACS X 'MACRO))
	       '(LET LET* DESETQ DEFMACRO DEFMACRO-DISPLACE DEFUN/& MACRO 
		 WITHOUT-INTERRUPTS WITH-INTERRUPTS WITHOUT-TTY-INTERRUPTS 
		 SETF DEFSETF EVAL-ORDERED SI:PICK-A-MASK))
	 (load (cond ((status feature ITS)   '((DSK COMLAP) CDMACS FASL))
		     (T '((LISP) CDMACS FASL))))
	 (MAPATOMS '(LAMBDA (X) (AND (GET X 'MACRO)
				      (CCLOAD:BOOTMACS X 'MACRO))))
	 (SSTATUS FEATURE NOLDMSG)
	 (SETQ IREADTABLE READTABLE)
	 (SETQ IOBARRAY (ARRAY () OBARRAY '() ))	;Make pure copy of 
	 (DO I 0 (1+ I) (= I N) 			; original obarray
	     (STORE (ARRAYCALL T IOBARRAY I) (PURCOPY (OBARRAY I))))
	 (COND ((STATUS FEATURE SHARABLE) 
		(MAPC 'DEPURIFY-SYMBOL DEPURIFY-SYMBOL)
		(MAPC '(LAMBDA (X) 
			 (MAPC 'DEPURIFY-SYMBOL (APPEND (CAR X) (CDR X))))
		      *SHARING-FILE-LIST*)
		(MAPC 'DEPURIFY-SYMBOL (CONS (STATUS UDIR)
					     '(AI ML MC DSK LSPDMP LISP)))))
	 (RETURN '*))


(PROGN 
 (SETQ PUTPROP (PURCOPY 
		(APPEND '(STATUS SSTATUS INST INSTN IMMED ARITHP 
			  NUMBERP NOTNUMP CONTAGIOUS COMMU BOTH CONV 
			  ACS MINUS FLOATI P1BOOL1ABLE )
			PUTPROP)))
 (LET ((PUTPROP (CONS 'AUTOLOAD PUTPROP)))
   (MAPC '(LAMBDA (L)
	    (MAPC '(LAMBDA (X) (OR (GETL X '(SUBR LSUBR MACRO AUTOLOAD))
				   (PUTPROP X `((LISP) ,X FASL) 'AUTOLOAD)))
		  (CDR L)))
	 '(((CERROR) CERROR FERROR SI:LOST-MESSAGE-HANDLER 
		     SI:ERROR-OUTPUT-HANDLER +INTERNAL-LOSSAGE)
	   ((DEFSETF) DEFSETF)
	   ((ERRCK) CHECK-TYPE CHECK-SUBSEQUENCE CHECK-ARG ERROR-RESTART 
		    SI:CHECK-TYPER SI:CHECK-SUBSEQUENCER))))
 (LET ((DEFMACRO-DISPLACE-CALL T) 
       (DEFMACRO-CHECK-ARGS T)
       (PUTPROP (APPEND '(EXPR FEXPR MACRO) PUTPROP))
       DEFMACRO-FOR-COMPILING *RSET NOUUO ) 
    (SETQ MACROMEMO (LIST 509.) MACRO-EXPANSION-USE 'MACROMEMO)
    (EVAL (PROG2 () 
		 (READ)				    ;Gets PROG below
		 (AND (NOT (STATUS FASLOAD)) (INPUSH -1)) ;Closes INIT file
		 (AND (FILEP UREAD) (CLOSE UREAD)))))
  (SSTATUS FLUSH 'T)
  (SETQ PUTPROP CCLOAD:PUTPROP PURE CCLOAD:PURE  *PURE () )
  (MAPC 'REMOB 
	(MAPCAR 'MAKUNBOUND 
		'( #+ITS CCLOAD:CLOCK-SLOWDOWN #+ITS CCLOAD:CLOCK-INTERVAL 
		   #+ITS CCLOAD:CLOCK-EPSILON  #+ITS CCLOAD:TIME-TEMP 
		   #+ITS CCLOAD:OTIME-TEMP 
		   CCLOAD:DEV-DIR  CCLOAD:FLUSH-TTY CCLOAD:PUTPROP CCLOAD:BOOTMACS )))
  (GCTWA)
  (NORET () )
  (cond ((not (status FEATURE PAGING)) )
	(pure (PAGEBPORG) (PURIFY 0 0 'BPORG)))
  (SETQ PURE CCLOAD:PURE  *PURE () )
  (COND ((STATUS FEATURE ITS) (CDUMP 0 '|DSK:COMLAP;TS GG|))
	('T (PRINC '|/îReady to SSAVE a GG |)
	    (CDUMP)))
)



(PROG (GL LVRL TIME RUNTIME ALARMCLOCK SLOTX REGACS  FLPDL 
	 NUMACS MODELIST FASLOAD UNSFLST FXPDL REGPDL NLNVTHTBP 
	 #+ITS CCLOAD:CLOCK-SLOWDOWN  #+ITS CCLOAD:CLOCK-INTERVAL 
	 #+ITS CCLOAD:CLOCK-EPSILON  #+ITS CCLOAD:TIME-TEMP 
	 #+ITS CCLOAD:OTIME-TEMP 
	 CCLOAD:FLUSH-TTY CCLOAD:DEV-DIR  
	 )
	(SETQ RUNTIME (RUNTIME) TIME (TIME))
	(COMMENT 
		;SLOTX holds either NUMACS or REGACS, to hac the ALARMCLOCK
		;	(NUMACS) turns ALARMCLOCK feature on
		;	(REGACS) turns it off
		;RUNTIME is the RUNTIME before beginning
		;TIME is the realTIME before beginning
		;CCLOAD:CLOCK-INTERVAL is the interval between alarm rings, 
		;CCLOAD:CLOCK-EPSILON is the epsilonics - two tics within a 
		;    realtime of less than CCLOAD:CLOCK-EPSILON cause the 
		;    second to be ignored.
		;CCLOAD:CLOCK-SLOWDOWN is the time at which the interval should
		;     be slowed, [i.e., doubled] we want alarms less often as 
		;     time goes by 
		;CCLOAD:TIME-TEMP is a temporary time holder
		;CCLOAD:FLUSH-TTY causes a veto on message printers
	 )
  #+ITS (COND ((STATUS FEATURE ITS)
	       (SETQ CCLOAD:CLOCK-EPSILON 3.0)
	       (SETQ NUMACS '(LAMBDA () 		;TURNS ALARM OFF
			      (ALARMCLOCK 'TIME -1)
			      (PRINC '|/
Clock-OFF | TYO)
			      (SETQ ALARMCLOCK () ^W 'T CCLOAD:FLUSH-TTY 'T 
				    SLOTX REGACS))
		     REGACS '(LAMBDA () 		;TURNS ALARM ON
			      (SETQ ALARMCLOCK MODELIST ^W () SLOTX NUMACS  
				    CCLOAD:FLUSH-TTY () CCLOAD:CLOCK-SLOWDOWN 40.0 
				    CCLOAD:CLOCK-INTERVAL 10.) 
			      (PRINC '|/
Clock-ON | TYO)
			      (ALARMCLOCK 'TIME 1.))
		     MODELIST '(LAMBDA (VGO) 
				(COND (CCLOAD:FLUSH-TTY (ALARMCLOCK 'TIME -1))
				      ('T (SETQ CCLOAD:TIME-TEMP (TIME))
					  (COND ((AND (NOT CCLOAD:FLUSH-TTY)
						      (> (-$ CCLOAD:TIME-TEMP 
							     CCLOAD:OTIME-TEMP) 
							 CCLOAD:CLOCK-EPSILON))
						 (TERPRI TYO)
						 (PRINC '|Using | TYO) 
						 (SETQ CCLOAD:TIME-TEMP 
						       (*QUO (- (RUNTIME) RUNTIME) 
							     1.0E5) )
						 (PRINC (*QUO (FIX CCLOAD:TIME-TEMP) 
							      10.0) 
							TYO)
						 (PRINC '| secs so far, out of | TYO)
						 (PRINC (*QUO (FIX (*$ (-$ (TIME) TIME) 10.0))
							      10.0) 
							TYO)
						 (PRINC '| |  TYO)
						 (SETQ CCLOAD:TIME-TEMP (TIME))))
					  (COND ((> (-$ (SETQ CCLOAD:OTIME-TEMP CCLOAD:TIME-TEMP) TIME)
						    CCLOAD:CLOCK-SLOWDOWN) 
						 (SETQ CCLOAD:CLOCK-SLOWDOWN 
						       (*$ 2.0 CCLOAD:CLOCK-SLOWDOWN) 
						       CCLOAD:CLOCK-INTERVAL 
						       (* 2 CCLOAD:CLOCK-INTERVAL))))
					  (ALARMCLOCK 'TIME CCLOAD:CLOCK-INTERVAL))) ))
		(SSTATUS TTYIN 30. '(LAMBDA (VGO VGOL) (FUNCALL SLOTX)))
		(FUNCALL REGACS)))						;Sets up SLOTX, and starts ALARMCLOCK

	(SETQ EDIBLE ())
	(DEFUN EDIBLE FEXPR (L) 
		       (SETQ L 
			     (MAPCAN 
			      '(LAMBDA (X) 
				       ((LAMBDA (Y) 
						(COND ((GET X 'RECAN) ())
						      (Y (REMPROP X (CAR Y))
							 (PUTPROP X (LIST (CAR Y) (CADR Y)) 'RECAN)
							 (SETQ EDIBLE (CONS X EDIBLE))
							 (PUTPROP X (SUBST () () (CADR Y)) (CAR Y))
							 (LIST X))))
					(GETL X '(EXPR FEXPR MACRO))))
			      L))
		       (PRINT L)
		       (APPLY 'EDIT L))
	(DEFUN RECAN FEXPR (L)
		       (MAPCAN 
			'(LAMBDA (X) 
				 ((LAMBDA (Y) 
					  (AND Y 
					       (REMPROP X 'RECAN)
					       (PUTPROP X 
							(COND ((ATOM (CAR L)) (CADR Y)) 
							      ((EQ (CAAR L) 'PURE) 
							       (PURCOPY (GET X (CAR Y))))
							      ((GET X (CAR Y)))
							      ((CADR Y)))
							(CAR Y)) 
					       (PROG2 (SETQ EDIBLE (DELQ X EDIBLE))
						      (LIST X))))
				  (GET X 'RECAN)))
     			(COND ((ATOM (CAR L)) L) ((CDR L)))))

	(SETQ ^Q () )


    B	#+ITS (SETQ CCLOAD:OTIME-TEMP (TIME))
	(AND (NOT CCLOAD:FLUSH-TTY)
	     (PRINC '|/
  (In LISP version | TYO)
	     (PRINC (STATUS LISPV) TYO)
	     (PRINC '|)|) TYO)
  #+ITS	(OR (NOT (STATUS HACTR))
	    (VALRET '|//:JCL/îGGJ:VP |))
	(SETQ CCLOAD:DEV-DIR 
	       #+ITS '(DSK COMLAP) 
	       #+SAIL '(DSK (MAC LSP))
	       #-(or ITS SAIL) 
		  (COND #+DEC20 ((PROBEF '((PS MACLISP) COMPLR LSP))
				 '(PS MACLISP))
				((LIST 'DSK (STATUS UDIR)))))
      C (SETQ FXPDL (COND ((STATUS FEATURE ITS) '>)
			  ('T 'LSP)))
	(SETQ NLNVTHTBP `(,ccload:dev-dir * ,fxpdl))
  #-ITS	(AND (NOT (PROBEF (mergef NLNVTHTBP '(COMPLR))))
	     (PROG2 (PRINC '|/
;Please set up "CCLOAD:DEV-DIR" to a list of the device and directory /
;names to use for the loading the EXPR version of COMPLR files/
| TYO)
		    (BREAK ULUZ)
		    (GO C)))
;;; (comment AUTOLOADING SOME FILES)

	(SETQ 
	  LVRL 
	  '(LAMBDA (REGPDL)
	    (COND ((GET (CAR REGPDL) (CADR REGPDL))) 
		  ((OR (AND (SETQ GL (GET (CAR REGPDL) 'AUTOLOAD)) (PROBEF GL))
		       (PROBEF (SETQ GL (LIST '(LISP) (CADDR REGPDL) FXPDL)))
		       (AND (SETQ GL (MERGEF NLNVTHTBP (CADDR REGPDL)))
			    (PROBEF GL)))
		   (COND ((NOT CCLOAD:FLUSH-TTY) 
			  (TERPRI TYO)
			  (PRINC '|;Autoloading | TYO)
			  (PRINC (CADR GL) TYO) 
			  (PRINC '| | TYO)
			  (PRINC (CADDR GL) TYO)
			  (PRINC '| for | TYO)
			  (PRIN1 (CAR REGPDL) TYO)))
		   (LOAD GL))
		  ('T (PROG (^Q ^R ^W)
			    (TERPRI)
			    (PRINC '/;)
			    (PRINC (CAR REGPDL))
			    (PRINC '| has not been defined.  Please load |)
			    (PRINC (CADDR REGPDL))
			    (PRINC '| file, and resume by <altmode>P |)
			    (BREAK WAIT-FOR-LOADING)) ))))

    #+SAIL (PROGN (HELP)
		  (FUNCALL LVRL '(GC-OVERFLOW-DAEMON SUBR DEMON))
		  (SETQ GC-OVERFLOW 'GC-OVERFLOW-DAEMON)
		  (DEFUN SAVE-COMPILER (GL)
			 (CDUMP (MAKNAM (APPEND (EXPLODEN '|SAVE |)
						(EXPLODEN GL))))))
    #-SAIL (FUNCALL LVRL '(GC-DAEMON SUBR GCDEMN))

	(MAPC LVRL '( (LET MACRO LET)
		      (DEFMACRO MACRO DEFMACRO) 
		      (GETMIDASOP SUBR GETMIDASOP)
		      (+INTERNAL-SETF-X SUBR SETF)))

;;; (comment LOADING MAIN COMPLR FILES)

	(SETQ LVRL '(LAMBDA (REGPDL)
		     (SETQ GL (CONS CCLOAD:DEV-DIR 
				    (COND ((ATOM REGPDL) (LIST REGPDL FXPDL))
					  (REGPDL))))
		     (COND ((PROBEF GL)
			    (COND ((NOT CCLOAD:FLUSH-TTY) 
				   (TERPRI TYO)
				   (PRINC '|	  Loading |)
				   (PRINC REGPDL TYO)
				   (PRINC '| > | TYO)))
			    (LOAD GL)
			    (COND ((AND (NOT CCLOAD:FLUSH-TTY) 
					(SETQ GL (COND ((EQ REGPDL 'FASLAP)
							'FASLVERNO) 
						       ((IMPLODE 
							 (NCONC 
							  (EXPLODEC REGPDL)
							  '(V E R N O))))))
					(BOUNDP GL)
					(SETQ GL (SYMEVAL GL)))
				   (TERPRI TYO)
				   (PRINC '|	       (|)
				   (PRINC REGPDL TYO)
				   (PRINC '| version number | TYO)
				   (PRINC GL TYO)
				   (PRINC '|) | TYO) )))
			   ('T (PROG (^Q ^R ^W)
				 (TERPRI)
				 (PRINC '/;)
				 (PRINC REGPDL)
				 (PRINC '|  has not been found.  Please load it, and resume by <altmode>P |)
				 (BREAK ULUZ-BUNKIE))))))

	(AND FLPDL (FUNCALL LVRL 'FASLAP))

    #+SAIL (PROGN 
	       (PROG (PURE)
		(FUNCALL LVRL (COND ((AND (EQ GL 'DIRECT) (STATUS FEATURE DDT))
				     '(DIRECT DFA))
				    ('DIRECT))))
	       (MAPC LVRL '(EREAD MACROD NCOREQ LOADED))
	       (SETQ SAIL-MORE-SYSFUNS 
		     (APPEND '(EREAD EOPEN ELOAD UGREAT1 REQUIRE EDIT CODE 
				MACRODEF MACROBIND TRANS TRANSDEF MAIL %MATCH 
				%CONTINUE %CONTINUE-MATCH %CHAR1 %MATCH-LOOKUP 
				%%EXPAND%% %%EXPAND1%% %%%STRING%%% )
			     SAIL-MORE-SYSFUNS))
	       (MAPC '(LAMBDA (X) 
			(COND ((GET (CAR X) 'AUTOLOAD)
			       (AND (CDDR X) (ARGS (CAR X) (CDDR X)))
			       (AND (CDR X) (PUTPROP (CAR X) (CDR X) 'FUNTYP-INFO))))) 
		     '((EREAD FSUBR) (EOPEN LSUBR 0 . 4) (ELOAD SUBR () . 1)
			(UGREAT1 SUBR  () . 1) (REQUIRE FSUBR) (EDIT FSUBR) 
			(CODE FSUBR) (MAIL FSUBR))) )

;;;; INITIALIZEing

  	(COND ((NOT CCLOAD:FLUSH-TTY) 
	       (TERPRI TYO)
	       (PRINC '|Initializing | TYO)))
	(AND |carcdrp/|| 
	     (MAPC '(LAMBDA (X) (|carcdrp/|| X)) 	;Make CARCDR props
		   '(CAR   CDR  CDDR  CDDDR  CDDDDR  	; exist for a few
		     CDAR CADR CADDR CADDDR))) 
	(MAPC #'(LAMBDA (X) (REMPROP X 'MACRO)) CCLOAD:BOOTMACS)
	(REMPROP 'CCLOAD:BOOTMACS 'EXPR)
	(INITIALIZE)
  #+ITS (ALARMCLOCK 'TIME -1)
  #-ITS (SSTATUS LINMO 'T)
	(COND ((NOT CCLOAD:FLUSH-TTY) 
	       (TERPRI TYO)
	       (PRINC '|/îTotal Time = | TYO)
	       (PRINC (*QUO (FIX (*QUO (- (RUNTIME) RUNTIME) 1.0E5)) 10.0) TYO)
	       (PRINC '| secs out of | TYO)
	       (PRINC (*QUO (FIX (*$ (-$ (TIME) TIME) 10.0)) 10.0) TYO)
	       (TERPRI TYO)))
         (SETQ ALARMCLOCK () ^Q () ^W () ))