Google
 

Trailing-Edge - PDP-10 Archives - -
Click to see without markup as text/plain
There are no other files named in the archive.
(SETQ IBASE (ADD1 7)) 


(DEFPROP DEBUGFNS 
 (NIL !D%N
      !D%OP
      !D%PT
      !D%FN
      !D%BN
      !D%X
      !D%C
      !D%L
      !BL
      !UBF
      !D%FORM
      !FL
      !BN
      !PT
      BKINIT
      DEBUG
      EDBRK
      UNBREAK
      UNBREAK2
      UNBREAK3
      BRK
      FNBDY
      VRFND
      BREAK3
      GENBRK
      BREAKPT
      BREAKPT1
      BREAKPT2
      BRKDO
      INTERACT
      INTERACT2
      INTERACT3
      PROG1
      KTRANS
      KTRANS2
      KPRIN1
      KPRIN2
      PATOM
      KPRIN3
      KPRINT
      SHOWSTATE
      SHOWVL
      SHOWEVL
      VALSHOW
      SHOWEXPR
      VALPRINT
      VALPRINT1
      VALPRINT2
      D%MVLL
      D%PLEV
      D%SEDPC
      D%FVL
      D%GVL
      D%BKCTR) 
VALUE)

(DEFPROP !D%N 
 (NIL . 0) 
VALUE)

(DEFPROP !D%N 
 T 
SPECIAL)

(DEFPROP !D%OP 
 (NIL) 
VALUE)

(DEFPROP !D%OP 
 T 
SPECIAL)

(DEFPROP !D%PT 
 (NIL . / ) 
VALUE)

(DEFPROP !D%PT 
 T 
SPECIAL)

(DEFPROP !D%FN 
 (NIL . FACT) 
VALUE)

(DEFPROP !D%FN 
 T 
SPECIAL)

(DEFPROP !D%BN 
 (NIL . / ) 
VALUE)

(DEFPROP !D%BN 
 T 
SPECIAL)

(DEFPROP !D%X 
 T 
SPECIAL)

(DEFPROP !D%C 
 (NIL) 
VALUE)

(DEFPROP !D%C 
 T 
SPECIAL)

(DEFPROP !D%L 
 (NIL FACT) 
VALUE)

(DEFPROP !D%L 
 T 
SPECIAL)

(DEFPROP !BL 
 T 
SPECIAL)

(DEFPROP !UBF 
 T 
SPECIAL)

(DEFPROP !D%FORM 
 T 
SPECIAL)

(DEFPROP !FL 
 T 
SPECIAL)

(DEFPROP !BN 
 T 
SPECIAL)

(DEFPROP !PT 
 T 
SPECIAL)

(DEFPROP BKINIT 
 (LAMBDA NIL
  (PROG NIL
	(GETSYM SUBR PATOM)
	(SETQ D%DPF (GET (QUOTE DPINIT) (QUOTE SUBR)))
	(COND
	 (D%DPF (DISPINIT)
		(DPOUT 10 (AIVECT 0 1000))
		(DEFPROP FVL (1 1 76 -1000) FRM)
		(DEFPROP EVL (11 1 76 0) FRM)
		(DEFPROP FB (2 1 76 -1000) FRM)))
	(SETQ D%VL NIL)
	(SETQ D%LL NIL)
	(SETQ !D%BN (QUOTE / ))
	(SETQ D%BRKCHRS (LIST (INTERN (ASCII 12)) (SETQ D%AM (INTERN (ASCII 175)))))
	(SETQ D%IGNCHRS (LIST (INTERN (ASCII 15)) (INTERN (ASCII 12)) (QUOTE / ) D%AM)))) 
EXPR)

(DEFPROP DEBUG 
 (LAMBDA (L) (PROG (V) (BKINIT) (SETQ V (EVAL (CAR L))) (COND (D%DPF (FRMOUT EVL (SHOWEVL)))) (RETURN V))) 
FEXPR)

(DEFPROP EDBRK 
 (LAMBDA(!D%L)
  (PROG (!D%FN !D%PT !D%N !D%C !D%OP)
	(SETQ !D%N 0)
	(SETQ D%LC D%AM)
	(SETQ D%LL NIL)
	(SETQ !D%FN (CAR !D%L))
	(SETQ !D%PT (QUOTE / ))
   L    (ERRSET (INTERACT2 (FNBDY !D%FN)) T)
	(COND ((EQ !D%C (QUOTE F1)) (SETQ !D%C (QUOTE S)) (SETQ !D%N 1) (GO L))
	      ((EQ !D%C (QUOTE P)) (AND D%DPF (KILL D%SEDPC)) (RETURN NIL)))
	(SETQ !D%N 0)
	(GO L))) 
FEXPR)

(DEFPROP UNBREAK 
 (LAMBDA(L)
  (MAPCAR (FUNCTION
	   (LAMBDA(X)
	    (PROG (!UBF !BL)
		  (COND ((NOT (ATOM X)) (SETQ !BL (CDR X)) (SETQ X (CAR X))))
		  (UNBREAK2 (FNBDY X))
		  (RETURN (COND (!UBF X))))))
 	  L)) 
FEXPR)

(DEFPROP UNBREAK2 
 (LAMBDA(X)
  (PROG NIL
   L    (COND ((ATOM X) (RETURN NIL))
	      ((ATOM (CAR X)))
	      ((AND (EQ (CAAR X) (QUOTE BREAKPT)) (OR (NULL !BL) (MEMQ (CADAR X) !BL)))
	       (UNBREAK3 X)
	       (SETQ !UBF T)
	       (GO L))
	      (T (UNBREAK2 (CAR X))))
	(SETQ X (CDR X))
	(GO L))) 
EXPR)

(DEFPROP UNBREAK3 
 (LAMBDA (X) (PROG NIL (EVAL (LIST (QUOTE REMOB) (CADAR X))) (RPLACA X (CADDAR X)))) 
EXPR)

(DEFPROP BRK 
 (LAMBDA (!PT) (BREAK3 !PT !D%FN (VRFND (FNBDY !D%FN) NIL))) 
EXPR)

(DEFPROP FNBDY 
 (LAMBDA (X) (CADR (GETL X (QUOTE (EXPR FEXPR MACRO))))) 
EXPR)

(DEFPROP VRFND 
 (LAMBDA(L VL)
  (COND ((EQ L !PT) VL)
	((ATOM L) NIL)
	((MEMQ (CAR L) (QUOTE (LAMBDA PROG))) (VRFND (CDDR L) (APPEND VL (CADR L))))
	(T (PROG (Z) (SETQ Z (VRFND (CAR L) VL)) (RETURN (COND (Z) (T (VRFND (CDR L) VL)))))))) 
EXPR)

(DEFPROP BREAK3 
 (LAMBDA(X FN VL)
  (PROG (!BN !FL)
	(RPLACA X (LIST (QUOTE BREAKPT) (SETQ !BN (GENBRK (SETQ D%BKCTR (ADD1 D%BKCTR)))) (CAR X)))
	(PUTPROP !BN VL (QUOTE VL))
	(PUTPROP !BN FN (QUOTE FN))
	(RETURN !BN))) 
EXPR)

(DEFPROP GENBRK 
 (LAMBDA (N) (COND ((EQ N 1) !D%BN) (T (SETQ !D%BN (READLIST (APPEND (QUOTE (B #)) (EXPLODE N))))))) 
EXPR)

(DEFPROP BREAKPT 
 (LAMBDA (!D%L) (BREAKPT1 (BREAKPT2))) 
FEXPR)

(DEFPROP BREAKPT1 
 (LAMBDA (!D%FORM) (VALPRINT1 !D%FORM (EVAL !D%FORM))) 
EXPR)

(DEFPROP BREAKPT2 
 (LAMBDA NIL
  (PROG (!D%X !D%BN !D%FORM)
	(SETQ !D%BN (CAR !D%L))
	(SETQ !D%FORM (CADR !D%L))
	(SETQ !D%X
	      (ERRSET (COND ((AND (SETQ !D%X (GET !D%BN (QUOTE CONDITION))) (NOT (EVAL !D%X))))
			    (T (BRKDO (GET !D%BN (QUOTE ACTION)))))
 		      T))
	(SETQ D%PRF (COND ((ATOM !D%X) (INTERACT) T)))
	(RETURN !D%FORM))) 
EXPR)

(DEFPROP BRKDO 
 (LAMBDA(D%ACTION)
  (PROG NIL
   L0   (COND ((NULL D%ACTION) (ERR)) ((EQ (CAR D%ACTION) (QUOTE OK)) (RETURN NIL)))
	(EVAL (CAR D%ACTION))
	(SETQ D%ACTION (CDR D%ACTION))
	(GO L0))) 
EXPR)

(DEFPROP INTERACT 
 (LAMBDA NIL
  (PROG (!D%FN !D%C !D%PT !D%OP !D%N D%ICH D%OCH)
	(SETQ D%ICH (INC NIL NIL))
	(SETQ D%OCH (OUTC NIL NIL))
	(SETQ D%LC D%AM)
	(SETQ D%LL NIL)
	(TERPRI)
	(SETQ !D%PT (CAR !D%L))
	(SETQ !D%FN (GET !D%BN (QUOTE FN)))
	(COND ((NOT D%DPF) (PRINC (QUOTE "***YOU ARE IN ")) (PRIN1 !D%FN)))
	(ERRSET (SHOWSTATE) T)
   L2   (SETQ !D%C (QUOTE S))
	(SETQ !D%N 1)
   L    (SETQ !D%N (ERRSET (INTERACT2 (FNBDY !D%FN)) T))
	(COND ((EQ !D%C (QUOTE F1)) (GO L2))
	      ((MEMQ !D%C (QUOTE (P R))) (OUTC D%OCH NIL) (INC D%ICH NIL) (RETURN !D%FORM))
	      ((NUMBERP !D%N))
	      (T (SETQ !D%N 0)))
	(GO L))) 
EXPR)

(DEFPROP INTERACT2 
 (LAMBDA(D%L)
  (PROG (D%M)
	(SETQ D%M D%L)
   L2   (COND ((LESSP !D%N 1) (GO L0))
	      ((EQ !D%C (QUOTE S))
	       (COND ((ATOM D%L) (RETURN 2))
		     ((EQUAL (CAR D%L) !D%PT) (RETURN 1))
		     (T (SETQ !D%N 1)
			(SETQ !D%N (INTERACT2 (CAR D%L)))
			(COND ((EQ !D%N 2) (SETQ D%L (CDR D%L)))
			      ((AND (EQ !D%C (QUOTE S)) (EQ !D%OP (QUOTE K))) (UNBREAK3 D%L) (GO L0))))))
	      ((AND (MEMQ !D%C (QUOTE ( /]))) (NOT (ATOM (CAR D%L)))) (SETQ !D%N (SUB1 !D%N))
								       (SETQ !D%N (INTERACT2 (CAR D%L))))
	      ((AND (EQ !D%C (QUOTE >)) (NOT (ATOM D%L)) (CDR D%L)) (SETQ D%L (CDR D%L)))
	      ((MEMQ !D%C (QUOTE ( ^))) (RETURN !D%N))
	      ((AND (EQ !D%C (QUOTE <)) !D%PT)
	       (COND ((EQ (CDR !D%PT) D%L) (SETQ D%L !D%PT)
					   (SETQ !D%PT D%M)
					   (COND ((EQ !D%OP (QUOTE D)) (RPLACD D%L (CDDR D%L)))))
		     (T (SETQ !D%PT (CDR !D%PT)) (GO L2))))
	      ((AND (CDR D%L) (EQ !D%C (QUOTE D))) (RPLACA D%L (CADR D%L))
						   (RPLACD D%L (CDDR D%L))
						   (SETQ D%LL NIL))
	      ((EQ !D%C (QUOTE D)) (SETQ !D%OP (QUOTE D)) (SETQ !D%C (QUOTE <)) (SETQ !D%N 2) (SETQ !D%PT D%M))
	      ((EQ !D%C (QUOTE X)) (RPLACD D%L (SETQ D%L (CONS (READ) (CDR D%L))))
				   (SETQ D%LL NIL)
				   (SETQ D%LC D%AM))
	      (T (INTERACT3 D%L) (SETQ !D%N 1)))
	(SETQ !D%N (SUB1 !D%N))
	(GO L2)
   L0   (SETQ !D%N 0)
   L1   (COND
	 ((AND (NOT (EQUAL D%L D%LL)) (MEMQ D%LC D%BRKCHRS)) (SETQ D%LL D%L)
							     (COND (D%DPF (SETQ D%GL D%L)
									  (SETQ D%GM D%M)
									  (FRMOUT FB (SHOWEXPR D%GL D%GM)))
								   (T (KPRINT (CAR D%L))))))
	(SETQ !D%OP NIL)
	(SETQ !D%C (SETQ D%LC (READCH)))
	(COND ((NUMBERP !D%C) (SETQ !D%N (PLUS !D%C (TIMES !D%N IBASE))) (GO L1))
	      ((EQ !D%C (QUOTE <)) (SETQ !D%PT D%M))
	      ((EQ !D%C (QUOTE S)) (SETQ !D%PT (READ))
				   (SETQ !D%OP (QUOTE S))
				   (SETQ D%LC D%AM)
				   (SETQ D%LL NIL)))
	(COND ((ZEROP !D%N) (SETQ !D%N 1)))
	(GO L2))) 
EXPR)

(DEFPROP INTERACT3 
 (LAMBDA(D%L)
  (COND ((EQ !D%C (QUOTE P)) (ERR))
	((AND (EQ !D%C (QUOTE B)) (NOT (ATOM (CAR D%L)))) (BRK D%L) (SETQ D%LL NIL))
	((EQ !D%C (QUOTE E)) (ERRSET (VALPRINT (READ)) T) (COND (D%DPF (SHOWSTATE))))
	((EQ !D%C (QUOTE K)) (SETQ !D%PT (GENBRK !D%N))
			     (SETQ D%LL NIL)
			     (SETQ !D%OP (QUOTE K))
			     (SETQ !D%C (QUOTE F1))
			     (SETQ D%LL NIL)
			     (ERR))
	((EQ !D%C (QUOTE R)) (RPLACA D%L (READ)) (SETQ D%LL NIL) (SETQ D%LC D%AM))
	((EQ !D%C (QUOTE I)) (RPLACD D%L (CONS (CAR D%L) (CDR D%L)))
			     (RPLACA D%L (READ))
			     (SETQ D%LL NIL)
			     (SETQ D%LC D%AM))
	((EQ !D%C (QUOTE C)) (PUTPROP (GENBRK !D%N) (READ) (QUOTE CONDITION)))
	((EQ !D%C (QUOTE V)) (PUTPROP (GENBRK !D%N) (READ) (QUOTE VL)))
	((EQ !D%C (QUOTE W)) (SETQ D%LL NIL))
	((MEMQ !D%C D%IGNCHRS))
	(T (PRINT (QUOTE ?))))) 
EXPR)

(DEFPROP PROG1 
 (LAMBDA (X Y) X) 
EXPR)

(DEFPROP KTRANS 
 (LAMBDA (L N) (COND ((ATOM L) L) ((ZEROP N) (QUOTE &)) (T (KTRANS2 L (SUB1 N))))) 
EXPR)

(DEFPROP KTRANS2 
 (LAMBDA (L N) (COND ((ATOM L) L) (T (CONS (KTRANS (CAR L) N) (KTRANS2 (CDR L) N))))) 
EXPR)

(DEFPROP KPRIN1 
 (LAMBDA (L) (KPRIN2 L D%PLEV)) 
EXPR)

(DEFPROP KPRIN2 
 (LAMBDA(L N)
  (COND ((PATOM L) (PRIN1 L))
	((ZEROP N) (PRIN1 (QUOTE &)))
	(T (PRINC (QUOTE "(")) (KPRIN3 L (SUB1 N)) (PRINC (QUOTE ")"))))) 
EXPR)

(DEFPROP PATOM 
 (LAMBDA (X) (ATOM X)) 
EXPR)

(DEFPROP KPRIN3 
 (LAMBDA(L N)
  (COND ((ATOM L) (PRINC (QUOTE ". ")) (PRIN1 L))
	(T (KPRIN2 (CAR L) N) (COND ((CDR L) (PRINC (QUOTE " ")) (KPRIN3 (CDR L) N)))))) 
EXPR)

(DEFPROP KPRINT 
 (LAMBDA (L) (PROG2 (TERPRI) (KPRIN1 L) (TERPRI))) 
EXPR)

(DEFPROP SHOWSTATE 
 (LAMBDA NIL (COND (D%DPF (FRMOUT FVL (SHOWVL)) (FRMOUT EVL (SHOWEVL))) (T (SHOWVL)))) 
EXPR)

(DEFPROP SHOWVL 
 (LAMBDA NIL (PROG2 (MAPC (FUNCTION VALSHOW) D%GVL) (MAPC (FUNCTION VALSHOW) (GET !D%BN (QUOTE VL))))) 
EXPR)

(DEFPROP SHOWEVL 
 (LAMBDA NIL (MAPC (FUNCTION VALSHOW) D%VL)) 
EXPR)

(DEFPROP VALSHOW 
 (LAMBDA(D%X)
  (PROG (D%Y)
	(COND ((ATOM D%X) (SETQ D%Y (EVAL D%X))) (T (SETQ D%Y (CDR D%X)) (SETQ D%X (CAR D%X))))
	(COND (D%DPF (TERPRI)))
	(TERPRI)
	(KPRIN1 D%X)
	(PRINC (QUOTE " = "))
	(KPRIN1 D%Y))) 
EXPR)

(DEFPROP SHOWEXPR 
 (LAMBDA(L M)
  (PROG NIL
	(PRINC (QUOTE "

***YOU ARE AT "))
	(PRIN1 !D%FN)
	(PRINC (QUOTE " "))
	(PRINC !D%BN)
	(PRINC (QUOTE "

(  ")) L
	(COND ((EQ M L) (TYO 15) (PRINC (QUOTE "  "))))
	(COND ((ATOM M) (PRINC (QUOTE /.)) (KPRIN1 M) (PRINC (QUOTE /))))
	      ((NULL (CDR M)) (KPRIN1 (CAR M)) (PRINC (QUOTE /))))
	      (T (KPRIN1 (CAR M))))
	(COND ((OR (ATOM M) (NULL (SETQ M (CDR M)))) (RETURN NIL)))
	(PRINC (QUOTE "
   "))  (GO L))) 
EXPR)

(DEFPROP VALPRINT 
 (LAMBDA (D%X) (COND (D%DPF (VALPRINT2 D%X (EVAL D%X))) (T (KPRINT (EVAL D%X))))) 
EXPR)

(DEFPROP VALPRINT1 
 (LAMBDA(D%X D%Y)
  (PROG2 (COND ((NOT D%PRF))
	       (D%DPF (VALPRINT2 D%X D%Y) (KILL D%FVL) (KILL D%SEDPC))
	       (T (VALSHOW (CONS D%X D%Y))))
 	 D%Y)) 
EXPR)

(DEFPROP VALPRINT2 
 (LAMBDA(D%X D%Y)
  (PROG NIL
	(SETQ D%VL (NCONC D%VL (LIST (CONS D%X D%Y))))
   L    (COND ((GREATERP (LENGTH D%VL) D%MVLL) (SETQ D%VL (CDR D%VL)) (GO L)))
	(RETURN D%Y))) 
EXPR)

(DEFPROP D%MVLL 
 (NIL . 3) 
VALUE)

(DEFPROP D%PLEV 
 (NIL . 3) 
VALUE)

(DEFPROP D%SEDPC 
 (NIL . 2) 
VALUE)

(DEFPROP D%FVL 
 (NIL . 1) 
VALUE)

(DEFPROP D%GVL 
 (NIL) 
VALUE)

(DEFPROP D%BKCTR 
 (NIL . 2) 
VALUE)