Update SHRDLU and MicroPlanner to run on newer Maclisp.

Note: SHRDLU only works with the visual block rendering on pdp10-ka with the
Type 340 display enabled.  Even then, there is some issue that causes the
SLAVE interface to the Type 340 display to fail, with an error indicating that
the 340 is not available.  This is still to be tracked down.

Without the Type 340 display, SHRDLU should work reasonably well.  It fails at
some things that the DEMO apparently succeeded in doing.  It is not clear why,
but likely the demo was created at one point, and the SHRDLU sources were updated
after that point, breaking some things.

SHRDLU can be invoked with :SHRDLU;SHRDLU.

Once you invoke SHRDLU, you'll see output similar to this:

SHRDLU VERSION 1000   LOADED 2024-07-21 IN BLISP 2156

REFER
COMMENTS AND QUESTIONS TO DDM

VERSION
RECONSTRUCTED BY EJS

-IF YOU ARE NEAR A DEC-340
     DO YOU WANT THE DISPLAY (TYPE " Y  " OR " N  " )

If you are running the pdp10-ka emulator, have enabled the DPY device, and want
to see the display, answer "Y". Otherwise, answer "N".

Then, after some more output you will see:

YOU ARE NOW IN A READ-EVAL-PRINT LOOP

TYPE " GO  " TO ENTER READY STATE

>>>

You are now in command mode and can type various commands, such as "SHOW".
You can also type "GO" to enter ready mode.  It is in ready mode that you can
issue commands like "pick up a big red block.", to which SHRDLU should
respond "OK.".  Note that commands should be ended with a period (".").
Questions should be ended with an exclamation mark ("?"). An example question
might be:  "what is in the box?".

MicroPlanner can be invoked with :SHRDLU;PLNR.  As a simple test of MicroPlanner,
you can enter these expressions (marked with "==>" -- don't type that).  If the
(THVAL ...) form results in printing "(FALLIBLE TURING)" then you know that basic
goal reaching works.

>>>  TOPLEVEL
LISTENING  THVAL
==> (THASSERT (HUMAN TURING))
((HUMAN TURING))
==> (DEFPROP THEO1 (THCONSE (X) (FALLIBLE $?X) (THGOAL (HUMAN $?X))) THEOREM)
THEO1
==> (THASSERT THEO1)
THEO1
==> (THVAL (THGOAL (FALLIBLE TURING) (THTBF THTRUE)) NIL)
(FALLIBLE TURING)

build/build.tcl

@@ -180,6 +180,7 @@ if {$env(BASICS)!="yes"} {
     source $build/zork.tcl
     source $build/sail.tcl
     source $build/typeset.tcl
+    source $build/shrdlu.tcl
 }
 
 bootable_tapes

build/shrdlu.tcl

@@ -0,0 +1,26 @@
+log_progress "ENTERING BUILD SCRIPT: SHRDLU"
+
+respond "*" ":cwd shrdlu\r"
+
+respond "*" ":complr\r"
+respond "_" "shrdlu; graphf\r"
+respond "_" "\032"
+type ":kill\r"
+
+respond "*" ":lisp\r"
+respond "Alloc?" "n"
+respond "*" "(load 'loader)"
+respond "T" "(loadshrdlu)"
+respond "|CONSTRUCTION COMPLETED|" "(dump-it)"
+respond "*" ":pdump shrdlu;ts shrdlu\r"
+respond "*" ":kill\r"
+
+respond "*" ":lisp\r"
+respond "Alloc?" "n"
+respond "*" "(load 'loader)"
+respond "T" "(load 'plnrfi)"
+respond "T" "(loadplanner)"
+respond "(THERT TOP LEVEL))" "(dump-planner)"
+respond "*" ":pdump shrdlu;ts plnr\r"
+respond "*" ":kill\r"
+

src/shrdlu/blockl.4 → src/shrdlu/blockl.5

@@ -1,12 +1,11 @@
-(declare (genprefix blockl))
-
 ;;;################################################################
 ;;;
 ;;;          BLOCKL - lisp code for the BLOCKS world
 ;;;
 ;;;################################################################
 
-
+(declare (genprefix blockl)
+	 (*fexpr ert thvsetq thand thsetq thgoal))
 
 (DEFUN ABSVAL (X) (COND ((MINUSP X) (MINUS X)) (X)))
 
@@ -206,15 +205,15 @@
 (declare (*expr fn))
 
 (DEFUN LOCGREATER (X Y FN) ((LAMBDA (XX YY)
-				    (NOT (LESSP (FN (CADR XX))
-						(PLUS (FN (CADR YY))
-						      (FN (CADDR YY))))))
+				    (NOT (LESSP (funcall FN (CADR XX))
+						(PLUS (funcall FN (CADR YY))
+						      (funcall FN (CADDR YY))))))
 			    (LOCG2 (QUOTE $?YY) X)
 			    (LOCG2 (QUOTE $?ZZ) Y)))
 
 
 
-(DEFUN LOCG2 (X Y) (COND ((EQ $?LOC (QUOTE #LOC)) (ATAB Y))
+(DEFUN LOCG2 (X Y) (COND ((EQ $?LOC (QUOTE !LOC)) (ATAB Y))
 			 ((CONS NIL (CONS (EVAL X) (CDDR (ATAB Y)))))))
 
 (DEFUN MEMOREND FEXPR (A) (OR NOMEM (AND (PUTPROP $?EV THTIME (QUOTE END))
@@ -252,7 +251,7 @@
        (OBJ TYPE)
        (PROG (XX)
 	     (MAPC (FUNCTION (LAMBDA (X)
-				     (AND (THVAL (QUOTE (THGOAL (#IS $?X
+				     (AND (THVAL (QUOTE (THGOAL (!IS $?X
 								     $E
 								     TYPE)))
 						 (LIST (LIST (QUOTE X) X)))
@@ -296,9 +295,9 @@
  (DEFPROP EE COMMAND WHY)
  (DEFPROP EE 0 START)
  (DEFPROP EE 0 END)
- (DEFPROP EE #START TYPE)
+ (DEFPROP EE !START TYPE)
  (SETQ EVENTLIST (QUOTE (EE)))
- (THADD (QUOTE (#START EE :DIALOG)) NIL)
+ (THADD (QUOTE (!START EE :DIALOG)) NIL)
  (ERRSET (CLEANOUT E) NIL)
  (MAPC
   (QUOTE
@@ -307,7 +306,7 @@
 	 (PUTPROP (CAR X)
 		  (LIST (LIST 0
 			      (CADR X)
-			      (CADAR (THVAL (QUOTE (THGOAL (#SUPPORT $?X $?Y)))
+			      (CADAR (THVAL (QUOTE (THGOAL (!SUPPORT $?X $?Y)))
 					    (LIST (LIST (QUOTE X)
 							(QUOTE THUNASSIGNED))
 						  (LIST (QUOTE Y) (CAR X)))))))
@@ -345,4 +344,4 @@
 		       (LESSP (OR (END? TIME) 777777)
 			      (GET EV (QUOTE END))))))))
 
-
+