Trailing-Edge
-
PDP-10 Archives
-
-
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)