Trailing-Edge
-
PDP-10 Archives
-
-
There are no other files named in the archive.
(FILECREATED " 4-Sep-81 12:59:55" <DONC>TRACEIN..12 7694
changes to: StepAction
previous date: " 3-Sep-81 16:39:53" <DONC>TRACEIN..11)
(PRETTYCOMPRINT TRACEINCOMS)
(RPAQQ TRACEINCOMS ((BLOCKS * TRACEINBLOCKS)
(VARS * TRACEINVARS)
(FNS * TRACEINFNS)
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY
COMPILERVARS (ADDVARS (NLAMA TRACEIN)
(NLAML WATCH)
(LAMA)))))
(RPAQQ TRACEINBLOCKS ((TRACEINBLOCK TRACEIN EVL-FIX EVMATCHER EXPAND-EV
EXPAND-EV1 TRACE-CREATE TRACEINX UNWATCH
WATCH (ENTRIES TRACEIN WATCH TRACE-CREATE
EVL-FIX)
(SPECVARS EXP INDENT# NOEMBED WATCHPLEVEL
StepAction))))
[DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY
(BLOCK: TRACEINBLOCK TRACEIN EVL-FIX EVMATCHER EXPAND-EV EXPAND-EV1
TRACE-CREATE TRACEINX UNWATCH WATCH (ENTRIES TRACEIN WATCH TRACE-CREATE
EVL-FIX)
(SPECVARS EXP INDENT# NOEMBED WATCHPLEVEL StepAction))
]
(RPAQQ TRACEINVARS (INDENT# StepAction WATCHPLEVEL))
(RPAQQ INDENT# 0)
(RPAQQ StepAction NIL)
(RPAQQ WATCHPLEVEL (3 . 5))
(RPAQQ TRACEINFNS (EVL-FIX EVMATCHER EXPAND-EV EXPAND-EV1 TRACE-CREATE TRACEIN
TRACEINX UNWATCH WATCH))
(DEFINEQ
(EVL-FIX
(LAMBDA (EXP PUT-IN) (* DD: "24-Aug-81 20:46")
(PROG (Y NOEMBED)
(SETQ EXP (OR (GETHASH EXP CLISPARRAY)
EXP))
(RETURN
(COND
((FMEMB EXP (QUOTE (T NIL)))
EXP)
((NUMBERP EXP)
EXP)
((ATOM EXP)
(COND
((EQ (CAR PUT-IN)
(QUOTE #))
EXP)
(T (APPEND PUT-IN (LIST EXP)))))
((ATOM (CAR EXP))
(SETQ Y (GETPROP (CAR EXP)
(QUOTE EVL-FIX)))
(COND
(Y (EXPAND-EV EXP Y PUT-IN))
((EQ (CAR EXP)
(QUOTE WATCH))
EXP)
(T
(EXPAND-EV
EXP
(COND
((SELECTQ (CAR EXP)
(GO (QUOTE (LISTP)))
((SETQ SETN SAVESETQ)
(QUOTE (NIL T)))
(COND (QUOTE (TAIL (TAIL T))))
((AND
OR PROGN PROG1 RPTQ FRPTQ RESETFORM
ADD1VAR SUB1VAR)
(QUOTE (TAIL T)))
(PROG (CONS (for V in (CADR EXP)
collect (COND
((LISTP V)
(QUOTE (NIL T)))))
(QUOTE (TAIL LISTP))))
((FUNCTION *FUNCTION)
(SETQ NOEMBED T)
(QUOTE (LISTP)))
((NLSETQ ERSETQ)
(QUOTE (T TAIL NIL)))
(SELECTQ (QUOTE (T TAIL (NIL TAIL T)
T)))
((LAMBDA LABEL NLAMBDA)
(SETQ NOEMBED T)
(QUOTE (NIL TAIL T)))
NIL))
(T (SELECTQ (FNTYP (CAR EXP))
((SUBR EXPR CEXPR SUBR* EXPR* CEXPR*)
(QUOTE (TAIL T)))
((FEXPR FSUBR CFEXPR FEXPR* FSUBR* CFEXPR*)
(QUOTE (TAIL NIL)))
(QUOTE (TAIL NIL)))))
PUT-IN))))
(T (EXPAND-EV EXP (QUOTE (TAIL T))
PUT-IN)))))))
(EVMATCHER
(LAMBDA (EXP PAT)
(COND
((ATOM PAT)
(COND
((NULL PAT)
NIL)
((EQ PAT T)
T)
(T (NOT (NOT (APPLY* PAT EXP))))))
((ATOM (CAR PAT))
(SELECTQ (CAR PAT)
(TEST (NOT (NOT (EVAL (CADR PAT)))))
(TAIL (PROG (V)
(PROG NIL
LOOP(COND
((AND (LISTP EXP)
(IGREATERP (LENGTH EXP)
(LENGTH (CDDR PAT))))
(SETQ V (CONS (EVMATCHER (CAR EXP)
(CADR PAT))
V))
(SETQ EXP (CDR EXP))
(GO LOOP))))
(RETURN (NCONC (DREVERSE V)
(EVMATCHER EXP (CDDR PAT))))))
(EVAL (EVAL (CADR PAT)))
(COND
((LISTP EXP)
(CONS (EVMATCHER (CAR EXP)
(CAR PAT))
(EVMATCHER (CDR EXP)
(CDR PAT))))
(T (PRIN1 "Tracein warning: missing arguments detected")
NIL))))
(T (COND
((LISTP EXP)
(CONS (EVMATCHER (CAR EXP)
(CAR PAT))
(EVMATCHER (CDR EXP)
(CDR PAT))))
(T (ERROR "Tracein error: List argument expected")))))))
(EXPAND-EV
(LAMBDA (EXP PAT PUT-IN)
(SETQ PAT (EVMATCHER (CDR EXP)
PAT))
(SETQ EXP (CONS (CAR EXP)
(EXPAND-EV1 (CDR EXP)
PAT PUT-IN)))
(COND
((NOT NOEMBED)
(SETQ EXP (APPEND PUT-IN (LIST EXP)))))
EXP))
(EXPAND-EV1
(LAMBDA (EXP PAT PUT-IN)
(COND
((LISTP PAT)
(COND
((NEQ (LENGTH PAT)
(LENGTH EXP))
(PRIN1 "Tracein warning: extra arguments ignored")))
(for PAT in PAT as EXP in EXP collect (EXPAND-EV1 EXP PAT PUT-IN)))
(PAT (EVL-FIX EXP PUT-IN))
(T EXP))))
(TRACE-CREATE
(LAMBDA NIL
(DWIMIFY BRKEXP T)
(CLISPTRAN (OR (GETHASH BRKEXP CLISPARRAY)
BRKEXP)
(EVL-FIX BRKEXP (QUOTE (WATCH))))))
(TRACEIN
(NLAMBDA X
(SETQ X (MKLIST X)) (* x can be a non list, so watch it!)
(PROG ((FN (CAR X))
WHEN Trace)
(DECLARE (LOCALVARS . T))
(COND
((LISTP FN)
(SETQ WHEN (CADR FN))
(SETQ FN (CAR FN))))
(COND
((EQ T (CADR X))
(SETQ Trace T)
(SETQ X (CDR X))))
(RETURN (COND
((NULL (CDR X))
(TRACEINX FN (QUOTE TTY:)
WHEN Trace))
(T (for LOC in (CDR X) collect (TRACEINX FN LOC WHEN Trace))
))))))
(TRACEINX
(LAMBDA (FN WHERE WHEN Trace)
(APPLY* (QUOTE BREAKIN)
FN
(LIST (QUOTE AROUND)
WHERE)
WHEN
(LIST (LIST (QUOTE PROG)
(COND
(Trace (QUOTE ((StepAction T))))
(T (QUOTE (StepAction))))
(QUOTE (SETQ
BRKVALUE
(CONS (SETQ !VALUE
(EVAL (OR (GETHASH (GETHASH BRKEXP
CLISPARRAY)
CLISPARRAY)
(GETHASH BRKEXP CLISPARRAY)
(TRACE-CREATE))))))))
(QUOTE OK)))))
(UNWATCH
(LAMBDA (XPR)
(COND
((LISTP XPR)
(COND
((EQ (CAR XPR)
(QUOTE WATCH))
(UNWATCH (CADR XPR)))
(T (CONS (UNWATCH (CAR XPR))
(UNWATCH (CDR XPR))))))
(T XPR))))
(WATCH
(NLAMBDA (XPR)
(PROG (ANS (INDENT# (IPLUS INDENT# 2)))
(COND
((EQ StepAction (QUOTE EVAL))
(RETURN (EVAL XPR))))
(DECLARE (LOCALVARS ANS))
(TAB INDENT#)
(PRIN1 (COND
((LISTP XPR)
(CAR XPR))
(T XPR)))
(OR (NLISTP XPR)
(NULL StepAction)
(TERPRI))
L1 (COND
((AND (NULL StepAction)
(LISTP XPR))
(SELECTQ (ASKUSER NIL NIL "->" (QUOTE ((P . "rettyPrint form")
(B . "reak")
(E . "val form")
(T . "race form")
(C . "ontinue Stepping")))
)
(P (PRINTDEF (UNWATCH XPR))
(GO L1))
(B (BREAK1 NIL T)
(GO L1))
(E ((LAMBDA (StepAction)
(SETQ ANS (EVAL XPR)))
(QUOTE EVAL)))
(T ((LAMBDA (StepAction)
(SETQ ANS (EVAL XPR)))
T))
(SETQ ANS (EVAL XPR))))
(T (SETQ ANS (EVAL XPR))))
(OR (NLISTP XPR)
(TAB INDENT#))
(RESETFORM (PRINTLEVEL WATCHPLEVEL)
(OR (NLISTP XPR)
(PRIN1 (CAR XPR)))
(PRIN1 " = ")
(PRIN1 ANS))
L2 (COND
((NULL StepAction)
(SELECTQ (ASKUSER NIL NIL "<-" (QUOTE ((P . "rettyPrint value")
(E . "val the rest")
(B . "reak")
(C . "ontinue Stepping")))
)
(P (PRINTDEF ANS)
(GO L2))
(E (SETQ StepAction (QUOTE EVAL)))
(B (BREAK1 NIL T)
(GO L2))
NIL)))
(AND StepAction (TERPRI))
(RETURN ANS))))
)
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
(ADDTOVAR NLAMA TRACEIN)
(ADDTOVAR NLAML WATCH)
(ADDTOVAR LAMA )
)
(DECLARE: DONTCOPY
(FILEMAP (NIL (1244 7530 (EVL-FIX 1256 . 2886) (EVMATCHER 2890 . 3961) (
EXPAND-EV 3965 . 4215) (EXPAND-EV1 4219 . 4518) (TRACE-CREATE 4522 . 4681) (
TRACEIN 4685 . 5230) (TRACEINX 5234 . 5712) (UNWATCH 5716 . 5932) (WATCH 5936 .
7527)))))
STOP