;;;   THIS IS A PACKAGE FOR LOADING SHRDLUS INTO CORE FROM THE DISK FILES.
;;;    THE PROCEDURE IS TO FIRST LOAD A LISP (IGNORE ALLOCATIONS, THE 
;;;    PROGRAMS DO THEIR OWN), THEN TO LOAD THIS FILE. EXECUTING 
;;;    (load-shrdlu-interpreted) WILL GENERATE (AFTER SOME TIME) A FULLY
;;;    INTERPRETED VERSION.   Once SHRDLU is loaded, invoking
;;;    (dump-shrdlu) will generate a PDUMPable image.
;;;
;;;    (load-shrdlu-compiled) can be used instead of
;;;    (load-shrdlu-interpreted) to load a compiled version of PLNR and
;;;    SHRDLU.  (dump-shrdlu) can then be used to generate a PDUMPable
;;;    image.
;;;
;;;    THE VARIABLE "VERSION-FILES" KEEPS A RUNNING TAB OF THE FILES
;;;    LOADER VIA "new-loader". IF ANY ERRORS OCCUR DURING READIN THEY
;;;    ARE PROTECTED BY AN "ERRSET" AND LOADING CONTINUES. (NOTE !! IF AN
;;;    UNBOUND PAREN CAUSES THE FILE TO BE TERMINATED TOO SOON, YOU'LL
;;;    NEVER NOTICE)
;;;

(SETQ GC-OVERFLOW '(LAMBDA (X) T)) 
(defun makoblist (x)
  (cond ((null x)
         (listarray obarray (- (cadr (arraydims 'obarray)) 129.)))
        (t 
         (*array x 'obarray))))
                        
(defun ioc fexpr (x)
  (cond 
        ((eq (car x) 'c) (setq ^d nil))
	((eq (car x) 'd) (setq ^d t))
	((eq (car x) 'q) (setq ^q t))
	((eq (car x) 's) (setq ^q nil))
        ((eq (car x) 't) (setq ^r nil))
        ((eq (car x) 'v) (setq ^w nil))
        ((eq (car x) 'r) (setq ^r t))
        ((eq (car x) 'w) (progn (setq ^w t) (clear-output t)))
	((eq (car x) 'g) (tyo 7)) 		; ring the bell
	(t (break (eval (car x))))))

(SETQ *RSET T) 

(defun new-loader (filename)
  (let ((file (probef `(,filename > dsk shrdlu))))
    (if file
        (progn
         (print 'reading)
         (princ filename)
         (setq version-files (cons file version-files))
         (or 
          (errset (progn (load file) t))
          (progn
           (print filename)
           (princ 'error-in-file)
           nil)))
        (progn
         (print filename)
         (princ 'not-found)
         nil))))

(defun fload2 (x)
  (fload (cons x '(fasl dsk shrdlu))))

(DEFUN FLOAD (SPECS)
   (TERPRI)
   (PRINC (CAR SPECS))
   (princ '/ )
   (PRINC (CADR SPECS))
   (OR (ERRSET (APPLY 'FASLOAD SPECS))
       (ERT lossage in loading - try again ?))
   )
 
(SETQ VERSION-FILES NIL) 

(defun load-planner-interpreted ()
       (ALLOC '(LIST 320000
                FIXNUM 15000
                SYMBOL 15000
                array 500
                flonum 4000))
       (SETQ PURE NIL)
       (SETQ THINF NIL THTREE NIL THLEVEL NIL)
       (new-loader 'plnrfi)
       (MAPC 'new-LOADER '(PLNR THTRAC))
       (THINIT))

(defun load-planner-compiled ()
       (ALLOC '(LIST 320000
                FIXNUM 15000
                SYMBOL 15000
                array 500
                flonum 4000))
       (SETQ PURE NIL)
       (SETQ THINF NIL THTREE NIL THLEVEL NIL)
       (new-loader 'plnrfi)
       (MAPC 'fload2 '(PLNR THTRAC))
       (THINIT))

(DEFUN load-shrdlu-interpreted ()
       (ALLOC '(LIST 320000
                FIXNUM 15000
		SYMBOL 15000
                array 500
                flonum 3000))
       (SETQ PURE NIL)
       (SETQ THINF NIL THTREE NIL THLEVEL NIL NOSTOP NIL)
       (load '((lisp) slave fasl))
       (load '((lisp) format fasl))
       (load '((lisp) umlmac fasl))
       (load '(macros >))
       (MAPC 'new-LOADER '(PLNR THTRAC))
       (thinit)
       (setq errlist nil)   ;removes micro-planner's fangs
       (MAPC 'new-LOADER '(SYSCOM MORPHO SHOW))
       (MAPC 'new-LOADER '(PROGMR PROGGO GINTER GRAMAR DICTIO))
       (MAPC 'new-LOADER '(SMSPEC SMASS SMUTIL))
       (new-loader 'NEWANS)
       (new-loader 'blockp)
       (new-loader 'data2)
       (new-loader 'blockl)
       (new-loader 'SETUP)
       (new-loader 'data)
       (load '((lisp) trace fasl))
;       (let ((x nil)) nil)	; forces let to get loaded
       (load '((shrdlu) graphf fasl))
       (load '((lisp) grinde fasl))
       'CONSTRUCTION/ COMPLETED) 

(DEFUN load-shrdlu-compiled ()
       (ALLOC '(LIST 320000
                FIXNUM 15000
		SYMBOL 15000
                array 500
                flonum 3000))
       (SETQ PURE NIL)
       (SETQ THINF NIL THTREE NIL THLEVEL NIL NOSTOP NIL)
       (load '((lisp) slave fasl))
       (mapc 'fload2 '(plnr thtrac))
       (thinit)
       (setq errlist nil)   ;removes micro-planner's fangs
       (mapc 'fload2 '(syscom morpho show))
       (mapc 'fload2 '(progmr proggo ginter gramar dictio))
       (mapc 'fload2 '(smspec smass smutil))
       (mapc 'fload2 '(newans blockp))
       (load 'data2)
       (fload2 'blockl)
       (new-LOADER 'SETUP)
       (load 'data)
       (load '((lisp) trace fasl))
       (let ((x nil)) nil)	; forces let to get loaded
       (load '((shrdlu) graphf fasl))
       (load '((lisp) grinde fasl))
       (load '((lisp) mlsub fasl))
       'COMPLETED)

(defun load-parser-interpreted ()
	(mapc 'loader '(syscom morpho show))
	(mapc 'loader '(progmr proggo ginter gramar dictio))
	(new-loader 'setup)
        (new-loader 'parser)
	'complete-call-setup-num-date)

(DEFUN load-parser-compiled ()
	(SETQ PURE NIL)
        (mapc 'fload2 '(syscom morpho show))
        (mapc 'fload2 '(progmr proggo ginter gramar dictio))
        (load '((lisp) trace fasl))
        (new-loader 'setup)
        (new-loader 'parser)
	'PARSER-LOADED)