Trailing-Edge
-
PDP-10 Archives
-
-
There are no other files named in the archive.
00010
00020
00030 (DEFPROP TRACE
00040 (LAMBDA(L)
00050 (PROG (G1 G2 T1 FN TCTRS OLST)
00060 LP1 (COND ((NULL L) (RETURN OLST)))
00070 (SETQ T1 (SETQ FN (CAR L)))
00080 (SETQ L (CDR L))
00090 LP2 (COND
00100 ((OR (NULL (CDR T1)) (EQ (CADR T1) (QUOTE TRACE)))
00110 (GO LP1))
00120 ((MEMBER (CADR T1) (QUOTE (FEXPR EXPR SUBR FSUBR)))
00130 (GO LP3))
00140 (T (SETQ T1 (CDDR T1)) (GO LP2)))
00150 LP3 (SETQ OLST (NCONC OLST (LIST FN)))
00160 (SETQ G1 (INTERN (GENSYM)))
00170 (RPLACD (CDDR (SETQ G2 (INTERN (GENSYM))))
00180 (LIST (CADR T1) (CADDR T1)))
00190 (RPLACD T1
00200 (NCONC (LIST (QUOTE TRACE)
00210 (CONS G1 G2)
00220 (QUOTE FEXPR)
00230 (LIST (QUOTE LAMBDA)
00240 (QUOTE (/-L))
00250 (LIST
00260 (QUOTE TRACE1)
00270 (QUOTE /-L)
00280 (LIST (QUOTE QUOTE) G1)
00290 (LIST (QUOTE QUOTE) G2)
00300 (LIST (QUOTE QUOTE) FN))))
00310 (CDDDR T1)))
00320 (SET G1 0.)
00330 (SETQ TCTRS (GET (QUOTE TRACE) (QUOTE CNTRS)))
00340 (PUTPROP (QUOTE TRACE) (CONS G1 TCTRS) (QUOTE CNTRS))
00350 (GO LP1)))
00360 FEXPR)
00370
00380 (DEFPROP TRACE1
00390 (LAMBDA(%-ARGS %-CNTR %-FUN %-NAM)
00400 (PROG (%-VAL)
00410 (SET %-CNTR (ADD1 (EVAL %-CNTR)))
00420 (PUTPROP %-NAM
00430 (ADD1 (COND ((GET %-NAM (QUOTE TRACECNT))) (T 0.)))
00440 (QUOTE TRACECNT))
00450 (COND
00460 (TRACEFLAG
00470 (PRINT (LIST (QUOTE ENTERING) (EVAL %-CNTR) %-NAM))))
00480 (COND ((GET %-FUN (QUOTE FEXPR)) (GO L4))
00490 ((GET %-FUN (QUOTE FSUBR)) (GO L4))
00500 (T (SETQ %-ARGS (EVAL (CONS (QUOTE LIST) %-ARGS)))))
00510 (COND (TRACEFLAG (PRIN1 %-ARGS)))
00520 (SETQ %-VAL (APPLY (QUOTE %-FUN) %-ARGS))
00530 (GO L4A)
00540 L4 (COND (TRACEFLAG (PRIN1 %-ARGS)))
00550 (SETQ %-VAL (EVAL (CONS %-FUN %-ARGS)))
00560 L4A (COND
00570 (TRACEFLAG (PRINT
00580 (LIST (QUOTE LEAVING) (EVAL %-CNTR) %-NAM))
00590 (PRIN1 %-VAL)))
00600 (SET %-CNTR (SUB1 (EVAL %-CNTR)))
00610 (RETURN %-VAL)))
00620 EXPR)
00630
00640 (DEFPROP UNTRACE
00650 (LAMBDA(L)
00660 (PROG (FN OLST T1 T2)
00670 LP1 (COND ((NULL L) (RETURN OLST)))
00680 (SETQ T1 (SETQ FN (CAR L)))
00690 (SETQ L (CDR L))
00700 LP2 (COND ((NULL (CDR FN)) (GO LP1))
00710 ((EQ (CADR FN) (QUOTE TRACE)) (GO LP3)))
00720 (SETQ FN (CDDR FN))
00730 (GO LP2)
00740 LP3 (SETQ OLST (NCONC OLST (LIST T1)))
00750 (SETQ T1 (CADDR FN))
00760 (RPLACD FN (NCONC (CDDR (CDDR T1)) (CDDR (CDDDR FN))))
00770 (EVAL (LIST (QUOTE REMOB) (CDR T1)))
00780 (SETQ FN (GET (QUOTE TRACE) (QUOTE CNTRS)))
00790 (SETQ T2 NIL)
00800 LP4 (COND ((NULL FN) (GO LP5))
00810 ((EQ (CAR FN) (CAR T1)) (GO LP6)))
00820 (SETQ T2 (CONS (CAR FN) T2))
00830 (SETQ FN (CDR FN))
00840 (GO LP4)
00850 LP6 (SETQ T2 (NCONC T2 (CDR FN)))
00860 LP5 (PUTPROP (QUOTE TRACE) T2 (QUOTE CNTRS))
00870 (EVAL (LIST (QUOTE REMOB) (CAR T1)))
00880 (GO LP1)))
00890 FEXPR)
00900
00910 (DEFPROP RESET
00920 (LAMBDA NIL
00930 (PROG (T1)
00940 (SETQ T1 (GET (QUOTE TRACE) (QUOTE CNTRS)))
00950 LP1 (COND ((NULL T1) (RETURN NIL)))
00960 (SET (CAR T1) 0.)
00970 (SETQ T1 (CDR T1))
00980 (GO LP1)))
00990 EXPR)
01000
01010 (DEFPROP TRACET
01020 (LAMBDA NIL
01030 (PROG NIL
01040 (PUTPROP (QUOTE %TC1)
01050 (GET (QUOTE SETQ) (QUOTE FSUBR))
01060 (QUOTE FSUBR))
01070 (PUTPROP (QUOTE %TC2)
01080 (GET (QUOTE SET) (QUOTE SUBR))
01090 (QUOTE SUBR))
01100 (DEFPROP SETQ
01110 (LAMBDA(%-L)
01120 (PROG (%-SV)
01130 (%TC1 %-SV (EVAL (CONS (QUOTE %TC1) %-L)))
01140 (COND
01150 ((NOT (MEMBER (CAR %-L) %TCL))
01160 (RETURN %-SV)))
01170 (PRINT (LIST (QUOTE SETQ) (CAR %-L) %-SV))
01180 (TERPRI)
01190 (RETURN %-SV)))
01200 FEXPR)
01210 (%TC1 %TCL NIL)
01220 (DEFPROP SET
01230 (LAMBDA(%-L %-K)
01240 (PROG NIL
01250 (%TC2 %-L %-K)
01260 (COND
01270 ((NOT (MEMBER %-L %TCL)) (RETURN %-K)))
01280 (PRINT (LIST (QUOTE SET) %-L %-K))
01290 (TERPRI)
01300 (RETURN %-K)))
01310 EXPR)))
01320 EXPR)
01330
01340 (DEFPROP SLST
01350 (LAMBDA (L) (%TC1 %TCL (NCONC %TCL L)))
01360 FEXPR)
01370
01380 (DEFPROP USLST
01390 (LAMBDA(L)
01400 (PROG (OLST)
01410 LP1 (COND ((NULL %TCL) (RETURN (%TC1 %TCL OLST)))
01420 ((MEMBER (CAR %TCL) L) (%TC1 %TCL (CDR %TCL)))
01430 (T (%TC1 OLST (CONS (CAR %TCL) OLST))
01440 (%TC1 %TCL (CDR %TCL))))
01450 (GO LP1)))
01460 FEXPR)
01470
01480 (DEFPROP UNTRACET
01490 (LAMBDA NIL
01500 (PROG NIL
01510 (REMPROP (QUOTE SETQ) (QUOTE FEXPR))
01520 (REMPROP (QUOTE SET) (QUOTE EXPR))
01530 (REMOB %TC1)
01540 (REMOB %TC2)
01550 (REMOB %TCL)))
01560 EXPR)
01570
01580 (DEFPROP TRACEZERO
01590 (LAMBDA NIL
01600 (MAPC (FUNCTION
01610 (LAMBDA(A)
01620 (COND
01630 (A
01640 (MAPC (FUNCTION
01650 (LAMBDA (B) (REMPROP B (QUOTE TRACECNT))))
01660 A)))))
01670 OBLIST))
01680 EXPR)
01690
01700 (DEFPROP TRACETALLY
01710 (LAMBDA NIL
01720 (MAPC (FUNCTION
01730 (LAMBDA(A)
01740 (COND
01750 (A
01760 (MAPC (FUNCTION
01770 (LAMBDA(B)
01780 (COND
01790 ((GET B (QUOTE TRACECNT))
01800 (PRINT B)
01810 (TYO 9.)
01820 (TYO 61.)
01830 (PRINC (GET B (QUOTE TRACECNT)))))))
01840 A)))))
01850 OBLIST))
01860 EXPR)
01870
01880
01890 (SETQ TRACEFLAG T) NEEDS TO BE DECLARED SPECIAL, IF COMPILING.