244 lines
5.8 KiB
Plaintext
244 lines
5.8 KiB
Plaintext
|
; File: DEBUG.LSP (c) 08/15/85 Soft Warehouse, Inc.
|
|||
|
|
|
|||
|
|
|
|||
|
|
(LOOP (PRIN1 '*) (EVAL (READ)) ((NULL RDS)) )
|
|||
|
|
|
|||
|
|
|
|||
|
|
(DEFUN TRACE LST
|
|||
|
|
(STUB 'TRACE LST) )
|
|||
|
|
|
|||
|
|
(DEFUN BRK LST
|
|||
|
|
(STUB 'BRK LST) )
|
|||
|
|
|
|||
|
|
(DEFUN CLEAR LST
|
|||
|
|
(UNSTUB LST) )
|
|||
|
|
|
|||
|
|
(DEFUN HISTORY (
|
|||
|
|
LST)
|
|||
|
|
(SETQ! LST (CAR! HISTORY))
|
|||
|
|
(LOOP!
|
|||
|
|
((EQ! LST))
|
|||
|
|
( ((EQ! (CAR! LST)))
|
|||
|
|
(APPLY! (CAR! (CAR! LST)) (CDR! (CAR! LST))) )
|
|||
|
|
(POP! LST) ) )
|
|||
|
|
|
|||
|
|
(SETQ HISTLEN 15)
|
|||
|
|
|
|||
|
|
(DEFUN BACKTRACE (
|
|||
|
|
LST)
|
|||
|
|
(SETQ! LST (REVERSE! BTRLIST))
|
|||
|
|
(LOOP!
|
|||
|
|
((EQ! LST))
|
|||
|
|
(APPLY! PRTCALL! (LIST! (CAR! (CAR! LST)) (CDR! (POP! LST)))) ) )
|
|||
|
|
|
|||
|
|
(DEFUN STUB (FLAG LST NAM
|
|||
|
|
NAM$)
|
|||
|
|
(SET FLAG T)
|
|||
|
|
(SETQ NAM$ T)
|
|||
|
|
(LOOP
|
|||
|
|
((ATOM LST) NAM$)
|
|||
|
|
(SETQ NAM (POP LST))
|
|||
|
|
( ((NOT (GETD NAM T))
|
|||
|
|
(SETQ NAM$)
|
|||
|
|
(PRIN1 NAM) (WRITE-LINE " is undefined") )
|
|||
|
|
(FLAG FLAG NAM)
|
|||
|
|
((TRACED NAM))
|
|||
|
|
(PUT NAM 'DEBUG (CONS! (PACK* NAM '!) (COND
|
|||
|
|
((NUMBERP (GETD NAM)) NIL)
|
|||
|
|
((CADR (GETD NAM))) )))
|
|||
|
|
(MOVD NAM (CAR! (GET NAM 'DEBUG)))
|
|||
|
|
(PUTD NAM (LIST
|
|||
|
|
(IF (EQ (GETD NAM T) 'SPECIAL) 'NLAMBDA (GETD NAM T))
|
|||
|
|
'ARGLST! (LIST 'TRACE! NAM))) ) ) )
|
|||
|
|
|
|||
|
|
(DEFUN TRACED (NAM)
|
|||
|
|
(EQ (CAR (CADDR (GETD NAM))) 'TRACE!) )
|
|||
|
|
|
|||
|
|
(DEFUN UNSTUB (LST NAM)
|
|||
|
|
(SETQ LEVELCOUNT 0)
|
|||
|
|
(RPLACD 'LEVELCOUNT)
|
|||
|
|
(SETQ BTRLIST)
|
|||
|
|
(LOOP
|
|||
|
|
((ATOM LST))
|
|||
|
|
(SETQ NAM (POP LST))
|
|||
|
|
( ((GET NAM 'DEBUG)
|
|||
|
|
(REMFLAG 'BRK NAM)
|
|||
|
|
(REMFLAG 'TRACE NAM)
|
|||
|
|
(MOVD (CAR! (GET NAM 'DEBUG)) NAM)
|
|||
|
|
(REMPROP NAM 'DEBUG) ) ) ) )
|
|||
|
|
|
|||
|
|
|
|||
|
|
(DEFUN TRACE! (NLAMBDA (NAM!
|
|||
|
|
LST!)
|
|||
|
|
( ((AND! (EQ! LEVELCOUNT 0) RATOM)
|
|||
|
|
(SETQ! RATOM)
|
|||
|
|
(SETQ! HISTORY)
|
|||
|
|
(SETQ! CALLCOUNT 0)
|
|||
|
|
(RPLACD! 'CALLCOUNT)
|
|||
|
|
(SETQ! MAXLEVELCOUNT 0)
|
|||
|
|
(RPLACD! 'MAXLEVELCOUNT) ) )
|
|||
|
|
(PUTADD! 'CALLCOUNT NAM!)
|
|||
|
|
(PUTADD! 'LEVELCOUNT NAM!)
|
|||
|
|
( ((<! LEVELCOUNT MAXLEVELCOUNT))
|
|||
|
|
(SETQ! MAXLEVELCOUNT LEVELCOUNT) )
|
|||
|
|
( ((AND! (NUMBERP! (GET! 'MAXLEVELCOUNT NAM!))
|
|||
|
|
(<! (GET! 'LEVELCOUNT NAM!) (GET! 'MAXLEVELCOUNT NAM!))))
|
|||
|
|
(PUT! 'MAXLEVELCOUNT NAM! (GET! 'LEVELCOUNT NAM!)) )
|
|||
|
|
( ((EQ! BACKTRACE))
|
|||
|
|
(PUSH! (CONS! NAM! ARGLST!) BTRLIST) )
|
|||
|
|
(HISTORY! NAM! ARGLST! LEVELCOUNT 'PRTCALL!)
|
|||
|
|
( ((TRACEP! NAM!)
|
|||
|
|
(PRTCALL! NAM! ARGLST! LEVELCOUNT) ) )
|
|||
|
|
( ((AND! BRK
|
|||
|
|
(FLAGP! 'BRK NAM!)
|
|||
|
|
(LEQ! MINCALL CALLCOUNT)
|
|||
|
|
(LEQ! (GET! 'MINCALL NAM!) (GET! 'CALLCOUNT NAM!))
|
|||
|
|
(OR! (EQ! (NUMBERP! BRKLEVEL))
|
|||
|
|
(EQ! LEVELCOUNT BRKLEVEL) )
|
|||
|
|
(OR! (EQ! (NUMBERP! (GET! 'BRKLEVEL NAM!)))
|
|||
|
|
(EQ! (GET! 'LEVELCOUNT NAM!) (GET! 'BRKLEVEL NAM!)))
|
|||
|
|
(OR! (EQ! (SETQ! LST! (GET! 'DEBUGIN NAM!)))
|
|||
|
|
(LOOP!
|
|||
|
|
((ATOM! LST!) NIL)
|
|||
|
|
((ASSOC! (POP! LST!) BTRLIST)) )) )
|
|||
|
|
(TERPRI!)
|
|||
|
|
(PRINC! "Break-point: ")
|
|||
|
|
(PRTCALL! NAM! ARGLST!)
|
|||
|
|
(SETQ! LST! (BREAK!)) ) )
|
|||
|
|
((EQ! (EQ! LST!)))
|
|||
|
|
(SETQ! ARGLST! (APPLY! (CAR! (GET! NAM! 'DEBUG)) ARGLST!))
|
|||
|
|
(HISTORY! NAM! ARGLST! LEVELCOUNT 'PRTRSLT!)
|
|||
|
|
( ((TRACEP! NAM!)
|
|||
|
|
(PRTRSLT! NAM! ARGLST! LEVELCOUNT) ) )
|
|||
|
|
( ((EQ! NAM! (CAR! (CAR! BTRLIST)))
|
|||
|
|
(POP! BTRLIST) ) )
|
|||
|
|
(PUTSUB! 'LEVELCOUNT NAM!)
|
|||
|
|
ARGLST! ))
|
|||
|
|
|
|||
|
|
(DEFUN TRACEP! (NAM!
|
|||
|
|
LST!)
|
|||
|
|
(AND! TRACE
|
|||
|
|
(FLAGP! 'TRACE NAM!)
|
|||
|
|
(LEQ! MINCALL CALLCOUNT)
|
|||
|
|
(LEQ! MINLEVEL LEVELCOUNT)
|
|||
|
|
(LEQ! LEVELCOUNT MAXLEVEL)
|
|||
|
|
(LEQ! (GET! 'MINLEVEL NAM!) (GET! 'LEVELCOUNT NAM!))
|
|||
|
|
(LEQ! (GET! 'LEVELCOUNT NAM!) (GET! 'MAXLEVEL NAM!))
|
|||
|
|
(OR! (EQ! (SETQ! LST! (GET! 'DEBUGIN NAM!)))
|
|||
|
|
(LOOP!
|
|||
|
|
((ATOM! LST!) NIL)
|
|||
|
|
((ASSOC! (POP! LST!) BTRLIST)) ) ) ) )
|
|||
|
|
|
|||
|
|
(DEFUN LEQ! (NUM1 NUM2)
|
|||
|
|
(OR! (EQ! (NUMBERP! NUM1))
|
|||
|
|
(EQ! (NUMBERP! NUM2))
|
|||
|
|
(EQ! NUM1 NUM2)
|
|||
|
|
(<! NUM1 NUM2) ) )
|
|||
|
|
|
|||
|
|
(DEFUN HISTORY! (NAM LST NUM NAM1)
|
|||
|
|
(SETQ! HISTORY (TCONC! HISTORY (LIST! NAM1 NAM LST NUM)))
|
|||
|
|
((<! HISTLEN (LENGTH! (CAR! HISTORY)))
|
|||
|
|
(RPLACA! HISTORY (CDR! (CAR! HISTORY))) ) )
|
|||
|
|
|
|||
|
|
(DEFUN PUTADD! (NAM1 NAM2)
|
|||
|
|
((EQ! (NUMBERP! (CAR! NAM1))))
|
|||
|
|
(SET! NAM1 (+! (CAR! NAM1) 1))
|
|||
|
|
((NUMBERP! (GET! NAM1 NAM2))
|
|||
|
|
(PUT! NAM1 NAM2 (+! (GET! NAM1 NAM2) 1)) )
|
|||
|
|
(PUT! NAM1 NAM2 1) )
|
|||
|
|
|
|||
|
|
(DEFUN PUTSUB! (NAM1 NAM2)
|
|||
|
|
((EQ! (NUMBERP! (CAR! NAM1))))
|
|||
|
|
( ((EQ! (CAR! NAM1) 0))
|
|||
|
|
(SET! NAM1 (+! (CAR! NAM1) -1)) )
|
|||
|
|
((NUMBERP! (GET NAM1 NAM2))
|
|||
|
|
((<! 0 (GET NAM1 NAM2))
|
|||
|
|
((EQ! (GET NAM1 NAM2) 1)
|
|||
|
|
(REMPROP! NAM1 NAM2) )
|
|||
|
|
(PUT! NAM1 NAM2 (+! (GET! NAM1 NAM2) -1)) ) ) )
|
|||
|
|
|
|||
|
|
(DEFUN PRTCALL! (NAM LST NUM)
|
|||
|
|
(PRTNAM!)
|
|||
|
|
(SETQ! NAM (CDR! (GET! NAM 'DEBUG)))
|
|||
|
|
(PRINC! '"[")
|
|||
|
|
( ((EQ! NAM)
|
|||
|
|
((ATOM! LST))
|
|||
|
|
(LOOP!
|
|||
|
|
(PRTEXP! NAM (POP! LST))
|
|||
|
|
((ATOM! LST))
|
|||
|
|
(PRINC! ", ") ) )
|
|||
|
|
((ATOM! NAM)
|
|||
|
|
(PRINC! NAM)
|
|||
|
|
(PRINC! ": ")
|
|||
|
|
(PRTEXP! NAM LST) )
|
|||
|
|
(LOOP!
|
|||
|
|
(PRINC! (CAR! NAM))
|
|||
|
|
(PRINC! ": ")
|
|||
|
|
(PRTEXP! (POP! NAM) (POP! LST))
|
|||
|
|
((ATOM! NAM)
|
|||
|
|
((ATOM! LST))
|
|||
|
|
(LOOP!
|
|||
|
|
(PRTEXP! NAM (POP! LST))
|
|||
|
|
((ATOM! LST))
|
|||
|
|
(PRINC! ", ") ) )
|
|||
|
|
(PRINC! ", ") ) )
|
|||
|
|
(PRINC! '"]")
|
|||
|
|
(TERPRI!) )
|
|||
|
|
|
|||
|
|
(DEFUN PRTRSLT! (NAM LST NUM)
|
|||
|
|
(PRTNAM!)
|
|||
|
|
(PRINC! "= ")
|
|||
|
|
(PRTEXP! NAM LST)
|
|||
|
|
(TERPRI!) )
|
|||
|
|
|
|||
|
|
(DEFUN PRTNAM! ()
|
|||
|
|
( ((NUMBERP! NUM)
|
|||
|
|
(FRESH-LINE)
|
|||
|
|
( ((<! NUM 10)
|
|||
|
|
(SPACES! 1) ) )
|
|||
|
|
(PRINC! NUM)
|
|||
|
|
(PRINC! '"|")
|
|||
|
|
(SPACES! NUM) ) )
|
|||
|
|
(PRINC! NAM)
|
|||
|
|
(SPACES! 1) )
|
|||
|
|
|
|||
|
|
(DEFUN PRTEXP! (NAM EXP)
|
|||
|
|
(PRINC! EXP) )
|
|||
|
|
|
|||
|
|
|
|||
|
|
(MOVD 'CAR 'CAR!)
|
|||
|
|
(MOVD 'CDR 'CDR!)
|
|||
|
|
(MOVD 'ASSOC 'ASSOC!)
|
|||
|
|
(MOVD 'CONS 'CONS!)
|
|||
|
|
(MOVD 'LIST 'LIST!)
|
|||
|
|
(MOVD 'REVERSE 'REVERSE!)
|
|||
|
|
(MOVD 'RPLACA 'RPLACA!)
|
|||
|
|
(MOVD 'RPLACD 'RPLACD!)
|
|||
|
|
(MOVD 'TCONC 'TCONC!)
|
|||
|
|
(MOVD 'GET 'GET!)
|
|||
|
|
(MOVD 'PUT 'PUT!)
|
|||
|
|
(MOVD 'REMPROP 'REMPROP!)
|
|||
|
|
(MOVD 'FLAGP 'FLAGP!)
|
|||
|
|
(MOVD 'ATOM 'ATOM!)
|
|||
|
|
(MOVD 'NUMBERP 'NUMBERP!)
|
|||
|
|
(MOVD 'EQ 'EQ!)
|
|||
|
|
(MOVD '< '<!)
|
|||
|
|
(MOVD 'SET 'SET!)
|
|||
|
|
(MOVD 'SETQ 'SETQ!)
|
|||
|
|
(MOVD '+ '+!)
|
|||
|
|
(MOVD 'LENGTH 'LENGTH!)
|
|||
|
|
(MOVD 'PRINC 'PRINC!)
|
|||
|
|
(MOVD 'TERPRI 'TERPRI!)
|
|||
|
|
(MOVD 'SPACES 'SPACES!)
|
|||
|
|
(MOVD 'APPLY 'APPLY!)
|
|||
|
|
(MOVD 'BREAK 'BREAK!)
|
|||
|
|
(MOVD 'LOOP 'LOOP!)
|
|||
|
|
(MOVD 'AND 'AND!)
|
|||
|
|
(MOVD 'OR 'OR!)
|
|||
|
|
(MOVD 'POP 'POP!)
|
|||
|
|
(MOVD 'PUSH 'PUSH!)
|
|||
|
|
|
|||
|
|
(CLEAR)
|
|||
|
|
|
|||
|
|
(RDS)
|
|||
|
|
|