mirror of
https://github.com/PDP-10/its.git
synced 2026-03-02 18:04:38 +00:00
b26050f9d2
The old Maclisp used when SHRDLU was created allowed one to take the CAR and CDR of atoms. The former returned internal bits associated wih the symbol, and the latter returned the property list of the symbol. This was disabled in later verisons of MacLISP, but allowed to be enabled by setting the value of CAR to T (and the value of CDR to T). However, doing this masked coding errors that resulted from unintentionally taking the CAR or CDR of a symbol, when a list or NUL was actually expected. This commit removes the hack of setting CAR and CDR to T, and adds macros to replace the use of CAR and CDR in this cases in PLNR and associated PLNR logic. These macros are found in the MACROS module. Making this change, and removing the duplicated $ reader macro from PLNR (it is already in MACROS for the benefit of other files), required making changes to the loader of SHRDLU and PLNR. I removed the obsolete use of UREAD to load interpreted files, and replaced with a new NEW-LOAD function. UREAD was unable to handle the (status macro $ 'thread) code that needed to be included.
170 lines
5.2 KiB
Plaintext
170 lines
5.2 KiB
Plaintext
;;; 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)
|