(FILECREATED " 2-Feb-86 17:13:10" {DSK}<LISPFILES2>DEBUG.LSP;2 11806
changes to: (VARS DEBUGCOMS))
(* Copyright (c) 1986 by Quintus Computer Systems, Inc. All rights reserved.)
(PRETTYCOMPRINT DEBUGCOMS)
(RPAQQ DEBUGCOMS ((FNS QB QP.ENUM QP.enum QP.fetch.A QP.fetch.H QP.fetch.R QP.fetch.Y
QP.init.windows QP.leap QP.listify QP.listify.addr QP.listify.cell
QP.listify.word QP.look QP.spy QP.start.H QP.update.windows QU)
(CONSTANTS QP.cant)
(VARS (QP.menu NIL)
(QP.window.H NIL)
(QP.window.Y NIL)
(QP.window.A NIL)
(QP.window.R NIL)
(QP.spies (QUOTE NIL))
(QP.stop T))
(ADDVARS (GLOBALVARS QP.menu)
(GLOBALVARS QP.window.H)
(GLOBALVARS QP.window.Y)
(GLOBALVARS QP.window.A)
(GLOBALVARS QP.window.R)
(GLOBALVARS QP.spies)
(GLOBALVARS QP.stop))))
(DEFINEQ
(QB
(LAMBDA (BLOCK N)
(RADIX 16)
(if (NOT (SMALLP N))
then (SETQ N 0))
(until (ZEROP N)
(printout T "Tag=" (\GETBASEBYTE BLOCK 0)
", Ptr="
(\GETBASEPTR BLOCK 0)
", Hi="
(\GETBASE BLOCK 0)
", Lo="
(\GETBASE BLOCK 1)
T)
(SETQ BLOCK (\ADDBASE BLOCK 2))
(SETQ N (SUB1 N)))
(RADIX 10)))
(QP.ENUM
(LAMBDA (M N L H)
(SETQ H (CAR M))
(SETQ M (CDR M))
(until (ZEROP N)
(SETQ L (CONS (CONS H M)
L))
(SETQ M (IPLUS M 2))
(if (NOT (SMALLP M))
then (SETQ H (ADD1 H))
(SETQ M 0))
(SETQ N (SUB1 N)))
(DREVERSE L)))
(QP.enum
(LAMBDA (M N L)
(while (IGEQ N M)
(SETQ L (CONS N L))
(SETQ N (SUB1 N)))
L))
(QP.fetch.A
(LAMBDA (X Y)
(SELECTQ Y
(1 (QP.listify.cell (ReadPrologTag A1)
(ReadPrologPtr A1)))
(2 (QP.listify.cell (ReadPrologTag A2)
(ReadPrologPtr A2)))
(3 (QP.listify.cell (ReadPrologTag A3)
(ReadPrologPtr A3)))
(4 (QP.listify.cell (ReadPrologTag A4)
(ReadPrologPtr A4)))
(QP.listify (\ADDBASE2 QP.membot Y)))))
(QP.fetch.H
(LAMBDA (X Y)
(QP.listify (\VAG2 (CAR Y)
(CDR Y)))))
(QP.fetch.R
(LAMBDA (X Y)
(SELECTQ Y
((P CP C R S H HB TR E B B0)
(QP.listify.addr (DynReadPrologPtr Y)))
((T0 T1)
(QP.listify.cell (DynReadPrologTag Y)
(DynReadPrologPtr Y)))
((I N)
(QP.listify.word (DynReadPrologNbr Y)))
((OP)
(CONS OP (LOGAND (get.code P -1)
255)))
"unknown")))
(QP.fetch.Y
(LAMBDA (X Y)
(QP.listify (SELECTQ Y
(CE (add.cell E 0))
(CP (add.cell E 1))
(B0 (add.cell E 2))
(add.cell E (IPLUS Y 2))))))
(QP.init.windows
(LAMBDA NIL
(if (WINDOWP QP.window.R)
then (CLOSEW QP.window.R))
(if (WINDOWP QP.window.A)
then (CLOSEW QP.window.A))
(if (WINDOWP QP.window.Y)
then (CLOSEW QP.window.Y))
(SETQ QP.window.R
(INSPECTW.CREATE NIL
(QUOTE (P CP C R S H HB TR E B B0 T0 T1 I N OP))
(QUOTE QP.fetch.R)
(QUOTE SHOULDNT)
QP.cant NIL NIL "Emulator Regs" (QUOTE QP.start.H)
(QUOTE (580 510 220 210))
NIL))
(SETQ QP.window.A (INSPECTW.CREATE NIL (QP.enum 1 8)
(QUOTE QP.fetch.A)
(QUOTE SHOULDNT)
QP.cant NIL NIL "Arguments" (QUOTE QP.start.H)
(QUOTE (580 395 220 115))
NIL))
(SETQ QP.window.Y (INSPECTW.CREATE NIL (APPEND (QUOTE (CE CP B0))
(QP.enum 1 8))
(QUOTE QP.fetch.Y)
(QUOTE SHOULDNT)
QP.cant NIL NIL "Environment" (QUOTE QP.start.H)
(QUOTE (800 395 220 150))
NIL))
(SETQ QP.menu (create MENU
ITEMS ← (QUOTE ((reset (RESET)
"Crash back to Lisp top level")
(look (QP.look)
"Look at the code for C")
(step (QP.leap T)
"Single-step")
(call (QP.leap (QUOTE call))
"Shut up until next call/execute/depart")
(skip (QP.leap (QUOTE skip))
"Shut up till next call or return")
(break (PROGN (BREAK1 NIL T)
T)
"Enter a Lisp break")
(spy (QP.spy T)
"Set a spy-point on C")
(nospy (QP.spy NIL)
"Remove any spy-point from C")
(leap (QP.leap (QUOTE leap))
"Shut up until the next spy-point")
(fly (QP.leap (QUOTE NIL))
"Stop tracing completely")))
MENUCOLUMNS ← 5
MENUPOSITION ← (QUOTE (800 . 545))
TITLE ← "Action"
CENTERFLG ← T))))
(QP.leap
(LAMBDA (X)
(if (AND (EQ X (QUOTE leap))
(NULL QP.spies))
then (PROMPTPRINT "No spy-points, call used")
(SETQQ QP.stop call)
else (SETQ QP.stop X))
NIL))
(QP.listify
(LAMBDA (Ptr)
(QP.listify.cell (\GETBASEBYTE Ptr 0)
(\GETBASEPTR Ptr 0))))
(QP.listify.addr
(LAMBDA (Ptr)
(if (EQ (TYPENAME Ptr)
(QUOTE QP.PROCEDURE.RECORD))
then (LIST (QUOTE Procedure)
(PROC.NAME Ptr)
(PROC.ARITY Ptr)
(PROC.MODULE Ptr))
elseif (OR (NUMBERP Ptr)
(LITATOM Ptr))
then (LIST (QUOTE Bare)
Ptr)
else (CONS (if (\BASELESSP Ptr QP.init.H)
then (QUOTE Clause?)
elseif (\BASELESSP Ptr (get.24 TR))
then (QUOTE Heap)
elseif (\BASELESSP Ptr QP.init.E)
then (QUOTE Trail)
elseif (\BASELESSP Ptr QP.memtop)
then (QUOTE Stack)
else (QUOTE Strange))
(LOC Ptr)))))
(QP.listify.cell
(LAMBDA (Tag Ptr)
(SELECTC Tag
(ref.tag.8 (if (AND (LITATOM Ptr)
(ILESSP (\LOLOC Ptr)
256))
then (LIST (QUOTE Byte)
(\LOLOC Ptr))
else (QP.listify.addr Ptr)))
(struct.tag.8 (CONS (QUOTE Struct)
(QP.listify.addr Ptr)))
(list.tag.8 (CONS (QUOTE List)
(QP.listify.addr Ptr)))
(boxed.tag.8 (LIST (QUOTE Boxed)
Ptr))
(float.tag.8 (LIST (QUOTE Float)
Ptr))
(immed.tag.8 (LIST (QUOTE Immed)
Ptr))
(symbol.tag.8 (if (ZEROP (\HILOC Ptr))
then (LIST (QUOTE Symbol)
Ptr)
else (LIST (QUOTE Functor)
(\VAG2 0 (\LOLOC Ptr))
(\HILOC Ptr))))
(CONS (QUOTE Strange)
(CONS Tag (QP.listify.addr Ptr))))))
(QP.listify.word
(LAMBDA (N)
(if (SMALLP N)
then (LIST N (QUOTE =)
(if (MINUSP N)
then (QUOTE -)
else (QUOTE +))
(LOGAND (LRSH N 8)
255)
(LOGAND N 255))
else (LIST (QUOTE ?)
N))))
(QP.look
(LAMBDA NIL
(QP.LOOK (get.24 C))
T))
(QP.spy
(LAMBDA (X NAME ARITY MODULE)
(SETQ NAME (if NAME
then (QP.LOCAL.PREDICATE NAME ARITY MODULE)
else (get.24 C)))
(if (NOT (TYPENAMEP NAME (QUOTE QP.PROCEDURE.RECORD)))
then (PROMPTPRINT "C is not a procedure record")
elseif X
then (if (NOT (MEMB NAME QP.spies))
then (SETQ QP.spies (CONS NAME QP.spies)))
else (if (MEMB NAME QP.spies)
then (SETQ QP.spies (REMOVE NAME QP.spies))))
T))
(QP.start.H
(LAMBDA (X Y Z)
(if Y
then (SETQ X (LAST X))
(if (WINDOWP QP.window.H)
then (CLOSEW QP.window.H))
(if (AND (SMALLP (CAR X))
(SMALLP (CDR X)))
then (SETQ QP.window.H (INSPECTW.CREATE NIL (QP.ENUM X 8)
(QUOTE QP.fetch.H)
(QUOTE SHOULDNT)
QP.cant NIL NIL "Data View"
(QUOTE QP.start.H)
(QUOTE (800 605 220 115))
NIL)))
else (if (EQ Z QP.window.A)
then (put.Amem 1 (get.Aval 1))
(put.Amem 2 (get.Aval 2))
(put.Amem 3 (get.Aval 3))
(put.Amem 4 (get.Aval 4)))
(PROMPTPRINT (QP.lispify (if (EQ Z QP.window.R)
then (DynReadPrologPtr X)
elseif (EQ Z QP.window.A)
then (\ADDBASE2 QP.membot X)
elseif (EQ Z QP.window.H)
then (\VAG2 (CAR X)
(CDR X))
else (SETQ Y (ReadPrologPtr E))
(SELECTQ X
(CE Y)
(CP (\ADDBASE Y 2))
(B0 (\ADDBASE Y 4))
(\ADDBASE Y (IPLUS (ITIMES X 2)
4))))
T)))))
(QP.update.windows
(LAMBDA NIL
(if QP.stop
then (SETQ OP (ELT QP.opcode (LRSH (get.code P -1)
8)))
(if (OR (EQ QP.stop T)
(AND (MEMB OP (QUOTE (R.try.me.else R.just.me.else
R.try.index.else
R.just.index.else)))
(OR (EQ QP.stop (QUOTE call))
(EQ QP.stop (QUOTE skip))
(MEMB (get.24 C)
QP.spies)))
(AND (EQ QP.stop (QUOTE skip))
(MEMB OP (QUOTE (R.progress W.progress R.proceed W.proceed
R.fail W.fail)))))
then (if (EQ OP (QUOTE R.extend))
then (SETQ OP (ELT QP.opcode (IPLUS (LOGAND (get.code P -1)
255)
256))))
(if (EQ OP (QUOTE W.extend))
then (SETQ OP (ELT QP.opcode (IPLUS (LOGAND (get.code P -1)
255)
257))))
(INSPECTW.REDISPLAY QP.window.R)
(INSPECTW.REDISPLAY QP.window.A)
(INSPECTW.REDISPLAY QP.window.Y)
(if (WINDOWP QP.window.H)
then (INSPECTW.REDISPLAY QP.window.H))
(if (MENU QP.menu)
then (QP.update.windows))))))
(QU
(LAMBDA NIL
(SETQ OP (ELT QP.opcode (LRSH (get.code P -1)
8)))
(if (EQ OP (QUOTE R.extend))
then (SETQ OP (ELT QP.opcode (IPLUS (LOGAND (get.code P -1)
255)
256))))
(if (EQ OP (QUOTE W.extend))
then (SETQ OP (ELT QP.opcode (IPLUS (LOGAND (get.code P -1)
255)
257))))
(INSPECTW.REDISPLAY QP.window.R)
(INSPECTW.REDISPLAY QP.window.A)
(INSPECTW.REDISPLAY QP.window.Y)
(if (WINDOWP QP.window.H)
then (INSPECTW.REDISPLAY QP.window.H))))
)
(DECLARE: EVAL@COMPILE
(RPAQQ QP.cant "Can't change a register")
(CONSTANTS QP.cant)
)
(RPAQQ QP.menu NIL)
(RPAQQ QP.window.H NIL)
(RPAQQ QP.window.Y NIL)
(RPAQQ QP.window.A NIL)
(RPAQQ QP.window.R NIL)
(RPAQQ QP.spies NIL)
(RPAQQ QP.stop T)
(ADDTOVAR GLOBALVARS QP.menu)
(ADDTOVAR GLOBALVARS QP.window.H)
(ADDTOVAR GLOBALVARS QP.window.Y)
(ADDTOVAR GLOBALVARS QP.window.A)
(ADDTOVAR GLOBALVARS QP.window.R)
(ADDTOVAR GLOBALVARS QP.spies)
(ADDTOVAR GLOBALVARS QP.stop)
(PUTPROPS DEBUG.LSP COPYRIGHT ("Quintus Computer Systems, Inc" 1986))
(DECLARE: DONTCOPY
(FILEMAP (NIL (842 11168 (QB 852 . 1309) (QP.ENUM 1311 . 1674) (QP.enum 1676 . 1811) (QP.fetch.A 1813
. 2271) (QP.fetch.H 2273 . 2369) (QP.fetch.R 2371 . 2772) (QP.fetch.Y 2774 . 2965) (QP.init.windows
2967 . 4984) (QP.leap 4986 . 5220) (QP.listify 5222 . 5339) (QP.listify.addr 5341 . 6100) (
QP.listify.cell 6102 . 7073) (QP.listify.word 7075 . 7392) (QP.look 7394 . 7457) (QP.spy 7459 . 8002)
(QP.start.H 8004 . 9266) (QP.update.windows 9268 . 10536) (QU 10538 . 11166)))))
STOP