Enter your search terms Submit search form
	Web pdp-10.trailing-edge.com

(DEFPROP BREAKF
 (BREAKF (NOCALL SAVEDEF ATOMLISTP BREAKIN0 UNBREAKIN BREAK0A CHNGNM CHNM1 RESTORE PACK-IN)
	 BREAK0
	 SAVEDEF
	 ATOMLISTP
	 BRKAPPLY
	 BREAK
	 TRACE
	 BREAKIN
	 BREAKIN0
	 UNBREAKIN
	 BREAK0A
	 CHNGNM
	 UNBREAK
	 UNTRACE
	 UNBREAK0
	 RESTORE
	 PACK-IN
	 BROKENFNS
	 TRACEDFNS
	 BKFNLIST
	 UNBREAKABLEFNS)
VALUE)

(NOCALL SAVEDEF ATOMLISTP BREAKIN0 UNBREAKIN BREAK0A CHNGNM CHNM1 RESTORE PACK-IN)

(DEFPROP BREAK0
 (LAMBDA(FN WHEN COM)
  (PROG	(FN1 FN2)
	(COND ((CONSP FN)
	       (RETURN
		(COND ((NOT (EQ (CADR FN) (QUOTE IN)))
		       (PROG NIL L1 (COND (FN (BREAK0 (CAR FN) WHEN COM) (SETQ FN (CDR FN)) (GO L1)))))
		      ((ATOM (SETQ FN1 (CAR FN)))
		       (COND ((ATOM (SETQ FN2 (CADDR FN))) (BREAK0A FN1 FN2 WHEN COM))
			     (T
			      (PROG NIL
			       L1   (COND
				     (FN2 (BREAK0A FN1 (CAR FN2) WHEN COM) (SETQ FN2 (CDR FN2)) (GO L1)))))))
		      ((ATOM (SETQ FN2 (CADDR FN)))
		       (PROG NIL L1 (COND (FN1 (BREAK0A (CAR FN1) FN2 WHEN COM) (SETQ FN1 (CDR FN1)) (GO L1)))))
		      (T
		       (PROG NIL
			L1   (COND
			      (FN1 (PROG NIL
					 (SETQ FN FN2)
				    L1	 (COND
					  (FN (BREAK0A (CAR FN1) (CAR FN) WHEN COM)
					      (SETQ FN (CDR FN))
					      (GO L1))))
				   (SETQ FN1 (CDR FN1))
				   (GO L1))))))))
	      ((NULL (SETQ FN2 (GETL FN (QUOTE (EXPR FEXPR SUBR FSUBR LSUBR MACRO)))))
	       (PRINT FN)
	       (PRINC (QUOTE NOT/ BREAKABLE/ FUNCTION))
	       (RETURN NIL))
	      ((GET FN (QUOTE TRACE))
	       (SETQ BROKENFNS (REMOVE FN BROKENFNS))
	       (SETQ TRACEDFNS (REMOVE FN TRACEDFNS))
	       (COND ((EQ (CAR (SETQ FN1 (CAR (CDDADR FN2)))) (QUOTE BREAK1))
		      (RPLACA (CDDR FN1) WHEN)
		      (RPLACA
		       (CDDDDR FN1)
		       (AND# COM
			     (LIST (QUOTE QUOTE)
				   (COND ((EQ (CADR COM) (QUOTE //BREAK1))
					  (RPLACA
					   (CDR COM)
					   (CONS (QUOTE ?=) (COND ((CONSP (SETQ FN2 (CADADR FN2))) FN2))))
					  COM)
					 (COM)))))
		      (GO END))
		     (T (APPLY# (QUOTE UNBREAK) (LIST FN)) (RETURN (BREAK0 FN WHEN COM))))))
	(COND
	 ((MEMQ FN UNBREAKABLEFNS)
	  (PRINT FN)
	  (PRINC (QUOTE UNBREAKABLE/ UNLESS/ 'IN'/ SOMETHING))
	  (RETURN (QUOTE ?))))
	(SETQ FN1 (SAVEDEF FN FN2))
	(REMPROP FN (CAR FN1))
	(PUTPROP
	 FN
	 (LIST (CAADR FN1)
	       (CADADR FN1)
	       (LIST (QUOTE BREAK1)
		     (CONS (QUOTE QUOTE) (CDDADR FN1))
		     WHEN
		     (LIST (QUOTE QUOTE) FN)
		     (AND# COM
			   (LIST (QUOTE QUOTE)
				 (COND ((EQ (CADR COM) (QUOTE //BREAK1))
					(RPLACA (CDR COM)
						(CONS (QUOTE ?=) (COND ((CONSP (SETQ FN2 (CADADR FN1))) FN2))))
					COM)
				       (COM))))
		     NIL))
	 (CAR FN1))
   END	(SET BKFNLIST (CONS FN (EVAL BKFNLIST)))
	(RETURN FN)))
EXPR)

(DEFPROP SAVEDEF
 (LAMBDA(FN DEF)
  (PROG	(GS ARGS)
   L0	(COND ((CDDDR (SETQ GS (INTERN (GENSYM)))) (GO L0)))
	(NCONC (CDR GS) (LIST (COND ((EQ (CAR DEF) (QUOTE MACRO)) (QUOTE FEXPR)) ((CAR DEF))) (CADR DEF)))
	(PUTPROP GS (CONS FN (CAR DEF)) (QUOTE FUNTYPE))
	(PUTPROP GS (QUOTE (T T NIL NIL)) (QUOTE ERXACTION))
	(PUTPROP FN (QUOTE (NIL NIL T T)) (QUOTE ERXACTION))
   L1	(COND ((MEMQ (CAR DEF) (QUOTE (FSUBR SUBR)))
	       (TERPRI)
	       (PRINC (LIST FN (QUOTE ARGUMENT/ LIST?)))
	       (COND ((AND (SETQ ARGS (READ)) (ATOM ARGS)) (TERPRI) (PRINC (QUOTE SHOULD/ BE/ LIST)) (GO L1))
		     ((NOT (ATOMLISTP ARGS))
		      (TERPRI)
		      (PRINC (QUOTE SHOULD/ BE/ LIST/ OF/ ATOMIC/ ARGUMENTS))
		      (GO L1))
		     ((AND (EQ (CAR DEF) (QUOTE FSUBR)) (CDR ARGS))
		      (TERPRI)
		      (PRINC (QUOTE FSUBR/ --/ TAKES/ ONLY/ ONE/ ARGUMENT))
		      (GO L1))))
	      ((EQ (CAR DEF) (QUOTE LSUBR)) (SETQ ARGS (QUOTE N?)))
	      ((AND (ATOM (SETQ ARGS (CADADR DEF)))
		    ARGS
		    (RPLACA (CDADR DEF) (NCONS (CADADR DEF)))
		    (PUTPROP GS T (QUOTE LEXPR)))))
	(PUTPROP FN (CONS NIL GS) (QUOTE TRACE))
	(RETURN
	 (LIST (COND ((MEMQ (CAR DEF) (QUOTE (SUBR EXPR LSUBR))) (QUOTE EXPR))
		     ((EQ (CAR DEF) (QUOTE MACRO)) (QUOTE MACRO))
		     ((QUOTE FEXPR)))
	       (LIST (QUOTE LAMBDA)
		     ARGS
		     (LIST (QUOTE BRKAPPLY)
			   (LIST (QUOTE QUOTE) GS)
			   (COND ((EQ (CAR DEF) (QUOTE LSUBR)) (LIST (QUOTE LXPD) (QUOTE N?)))
				 ((AND ARGS (ATOM ARGS)) (LIST (QUOTE QUOTE) (NCONS ARGS)))
				 ((MEMQ (CAR DEF) (QUOTE (SUBR EXPR))) (LIST (QUOTE QUOTE) ARGS))
				 (T (CAR ARGS)))))))))
EXPR)

(DEFPROP ATOMLISTP
 (LAMBDA (LL) (PROG NIL LP (COND ((NULL LL) (RETURN T)) ((ATOM (CAR LL)) (SETQ LL (CDR LL)) (GO LP)))))
EXPR)

(DEFPROP BRKAPPLY
 (LAMBDA (#%FN%# #%ARGS%#) (BKEVAL (CONS #%FN%# #%ARGS%#)))
EXPR)

(DEFPROP BREAK
 (LAMBDA(FNS)
  (PROG	(VAL FN)
   LP	(SETQ VAL
	      (CONS (COND ((NULL FNS) (RETURN VAL))
			  ((ATOM (SETQ FN (CAR FNS))) (BREAK0 FN T NIL))
			  ((EQ (CADR FN) (QUOTE IN)) (BREAK0 FN T NIL))
			  ((CDR FN) (BREAK0 (CAR FN) (CADR FN) (CDDR FN)))
			  ((QUOTE ?)))
		    VAL))
	(SETQ FNS (CDR FNS))
	(GO LP)))
FEXPR)

(DEFPROP TRACE
 (LAMBDA(FNS)
  (PROG	(VAL FN BKFNLIST)
	(SETQ BKFNLIST (QUOTE TRACEDFNS))
   LP	(SETQ VAL
	      (CONS (COND ((NULL FNS) (RETURN VAL))
			  ((ATOM (SETQ FN (CAR FNS)))
			   (BREAK0 FN T (LIST (QUOTE (TRACE)) (QUOTE //BREAK1) (QUOTE (UNTRACE)))))
			  ((EQ (CADR FN) (QUOTE IN))
			   (BREAK0 FN T (LIST (QUOTE (TRACE)) (QUOTE //BREAK1) (QUOTE (UNTRACE)))))
			  ((BREAK0 (CAR FN)
				   T
				   (LIST (QUOTE (TRACE)) (CONS (QUOTE ?=) (CDR FN)) (QUOTE (UNTRACE))))))
		    VAL))
	(SETQ FNS (CDR FNS))
	(GO LP)))
FEXPR)

(DEFPROP BREAKIN
 (LAMBDA(X)
  (BREAKIN0 (CAR X)
	    (COND ((SETQ X (CDR X)) (CAR X)) ((QUOTE (BEFORE TTY:))))
	    (COND ((AND X (SETQ X (CDR X))) (CAR X)) (T))
	    (AND# X (LIST (QUOTE QUOTE) (CDR X)))))
FEXPR)

(DEFPROP BREAKIN0
 (LAMBDA(FN WHERE WHEN BKINCOMS)
  (PROG	(FNDEF W MESS)
	(COND ((SETQ FNDEF
		     (GETL (COND ((SETQ W (GET FN (QUOTE TRACE))) (CDR W)) (FN)) (QUOTE (EXPR FEXPR MACRO))))
	       (SETQ FNDEF (CADR FNDEF)))
	      ((PRINT (CONS FN (QUOTE (NOT FUNCTION)))) (ERR)))
	(SETQ BROKENFNS (CONS FN (REMOVE FN BROKENFNS)))
	(COND ((CONSP (CAR WHERE)) (SETQ W (CDR WHERE)) (SETQ WHERE (CAR WHERE))))
   LOOP	(OR (MEMQ (CAR WHERE) (QUOTE (AROUND BEFORE AFTER))) (RETURN (CONS (CAR WHERE) (QUOTE ?))))
	(SETQ MESS
	      (LIST (QUOTE BREAK1)
		    (COND ((EQ (CAR WHERE) (QUOTE AROUND)) (QUOTE (QUOTE *))))
		    WHEN
		    (LIST (QUOTE QUOTE) (LIST FN WHERE))
		    BKINCOMS
		    NIL))
	(COND ((ATOM
		(ERRSET	(EDITE FNDEF
			       (LIST (CONS (QUOTE LC) (CDR WHERE))
				     (LIST (SELECTQ (CAR WHERE)
						    (AFTER (QUOTE A))
						    (BEFORE (QUOTE B))
						    (AROUND (QUOTE MBD))
						    (CAR WHERE))
					   MESS))
			       NIL)
			(QUOTE ERRORX)))
	       (PRINT (QUOTE (NOT FOUND))))
	      ((PUTPROP FN T (QUOTE BROKEN-IN))))
	(TERPRI)
	(COND (W (SETQ WHERE (CAR W)) (SETQ W (CDR W)) (GO LOOP)))
	(RETURN FN)))
EXPR)

(DEFPROP UNBREAKIN
 (LAMBDA(FN)
  (PROG	(W UPFINDFLG)
	(SETQ UPFINDFLG T)
	(COND ((SETQ W (GET FN (QUOTE TRACE))) (SETQ W (CDR W))) ((SETQ W FN)))
	(COND ((SETQ W (GETL W (QUOTE (EXPR FEXPR MACRO)))) (SETQ W (CADR W))) ((RETURN (CONS FN (QUOTE ?)))))
	(EDITE W
	       (QUOTE
		((LPQ F
		      BREAK1
		      (COMS
		       (SELECTQ (## 4 2 2 1) (AROUND (QUOTE (XTR 2 2))) ((AFTER BEFORE) (QUOTE DELETE)) NIL)))))
	       NIL)
	(RETURN FN)))
EXPR)

(DEFPROP BREAK0A
 (LAMBDA(BFN INFN WHEN COMS)
  (COND ((ATOM (SETQ BFN (CHNGNM INFN BFN NIL))) (BREAK0 BFN WHEN COMS)) ((LIST BFN))))
EXPR)

(DEFPROP CHNGNM
 (LAMBDA(FN OLDN FLG)
  (PROG	(DEF NEWN X Y Z)
	(COND
	 ((NULL (SETQ DEF (GETL (COND ((SETQ Z (GET FN (QUOTE TRACE))) (CDR Z)) (FN)) (QUOTE (EXPR FEXPR)))))
	  (RETURN (APPEND (QUOTE (CAN'T BREAK INSIDE)) (LIST FN)))))
	(SETQ NEWN (PACK-IN (LIST OLDN (QUOTE IN) FN)))
	(COND (FLG (REMPROP NEWN (CAR DEF))
		   (COND ((SETQ Z (REMOVE OLDN (GET FN (QUOTE NAMESCHANGED))))
			  (PUTPROP FN Z (QUOTE NAMESCHANGED)))
			 ((REMPROP FN (QUOTE NAMESCHANGED))))
		   (REMPROP NEWN (QUOTE ALIAS))
		   (SETQ Y OLDN)
		   (SETQ X NEWN))
	      (T (SETQ Y NEWN) (SETQ X (COND ((MEMQ OLDN (GET FN (QUOTE NAMESCHANGED))) NEWN) (T OLDN)))))
	(COND ((NULL (CHNM1 (CADR DEF) X Y)) (RETURN (CONS X (APPEND (QUOTE (NOT FOUND IN)) (LIST FN))))))
	(COND
	 ((NULL FLG)
	  (PUTPROP NEWN (CADR (SETQ Z (GETL OLDN (QUOTE (EXPR FEXPR SUBR FSUBR LSUBR MACRO))))) (CAR Z))
	  (COND
	   ((NOT (MEMQ OLDN (SETQ Z (GET FN (QUOTE NAMESCHANGED)))))
	    (PUTPROP FN (CONS OLDN Z) (QUOTE NAMESCHANGED))))
	  (PUTPROP NEWN (CONS FN OLDN) (QUOTE ALIAS))))
	(RETURN Y)))
EXPR)

(DEFPROP UNBREAK
 (LAMBDA(X)
  (PROG	(Y)
	(COND ((NULL X) (SETQ X (EVAL BKFNLIST)) (SET BKFNLIST NIL))
	      ((AND (SETQ Y (EVAL BKFNLIST)) (EQ (CAR X) T)) (RPLACA X (CAR Y)) (SET BKFNLIST (CDR Y))))
	(RETURN (MAPCAR (FUNCTION UNBREAK0) X))))
FEXPR)

(DEFPROP UNTRACE
 (LAMBDA (X) (PROG (BKFNLIST) (SETQ BKFNLIST (QUOTE TRACEDFNS)) (RETURN (APPLY# (QUOTE UNBREAK) X))))
FEXPR)

(DEFPROP UNBREAK0
 (LAMBDA(FN)
  (PROG	(X ALIAS)
	(SETQ BROKENFNS (DREMOVE (SETQ FN (PACK-IN FN)) BROKENFNS))
	(SETQ TRACEDFNS (DREMOVE FN TRACEDFNS))
	(SETQ X (RESTORE FN (QUOTE TRACE)))
	(COND ((GET FN (QUOTE BROKEN-IN)) (UNBREAKIN FN) (REMPROP FN (QUOTE BROKEN-IN)) (SETQ X FN)))
	(AND (SETQ ALIAS (GET FN (QUOTE ALIAS))) (CHNGNM (CAR ALIAS) (CDR ALIAS) T))
	(RETURN X)))
EXPR)

(DEFPROP RESTORE
 (LAMBDA(FN P)
  (PROG	(Y Z TYPE)
	(RETURN
	 (COND ((SETQ Y (GET FN P))
		(SETQ Y (CDR Y))
		(COND
		 ((AND (SETQ Z
			     (GET FN
				  (SELECTQ (SETQ TYPE (CDR (GET Y (QUOTE FUNTYPE))))
					   ((EXPR SUBR LSUBR) (QUOTE EXPR))
					   ((FEXPR FSUBR) (QUOTE FEXPR))
					   (QUOTE MACRO))))
		       (EQ (CAADDR Z) (QUOTE BREAK1)))
		  (PUTPROP FN (SETQ Z (GET Y (SELECTQ TYPE (MACRO (QUOTE FEXPR)) TYPE))) TYPE)
		  (COND	((GET Y (QUOTE LEXPR)) (RPLACA (CDR Z) (CAADR Z)))
			((MEMQ TYPE (QUOTE (LSUBR SUBR))) (REMPROP FN (QUOTE EXPR)))
			((MEMQ TYPE (QUOTE (FSUBR MACRO))) (REMPROP FN (QUOTE FEXPR))))))
		(EVAL (LIST (QUOTE REMOB) Y))
		(REMPROP FN (QUOTE ERXACTION))
		(REMPROP FN P)
		FN)
	       ((CONS FN (QUOTE (NOT BROKEN))))))))
EXPR)

(DEFPROP PACK-IN
 (LAMBDA(X)
  (COND	((ATOM X) X)
	((EQ (CADR X) (QUOTE IN))
	 (READLIST (NCONC (EXPLODE (CAR X)) (NCONC (EXPLODE (QUOTE -IN-)) (EXPLODE (CADDR X))))))
	((PRINT (CONS X (QUOTE ?))) (ERR))))
EXPR)

(DEFPROP BROKENFNS
 (NIL)
VALUE)

(DEFPROP TRACEDFNS
 (NIL)
VALUE)

(DEFPROP BKFNLIST
 (NIL . BROKENFNS)
VALUE)

(DEFPROP UNBREAKABLEFNS
 (NIL BREAK1 CONS APPEND RETURN PRIN1 PRINC ASSOC TERPRI *RSETERX LENGTH *GREAT ERR ATOM ADD1 *DIF)
VALUE)