(FILECREATED " 8-Feb-86 16:11:11" {DSK}<LISPFILES2>IMPROVEDDCOMS>DEBUG.;1
 8389   

      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 COPYRIGHT ("Quintus Computer Systems, Inc" 1986))
(DECLARE: DONTCOPY
  (FILEMAP (NIL (785 7755 (QB 795 . 1082) (QP.ENUM 1084 . 1307) (QP.enum 1309 . 1398) (QP.fetch.A 1400
 . 1723) (QP.fetch.H 1725 . 1793) (QP.fetch.R 1795 . 2082) (QP.fetch.Y 2084 . 2226) (QP.init.windows 
2228 . 3659) (QP.leap 3661 . 3828) (QP.listify 3830 . 3920) (QP.listify.addr 3922 . 4421) (
QP.listify.cell 4423 . 5033) (QP.listify.word 5035 . 5219) (QP.look 5221 . 5270) (QP.spy 5272 . 5670) 
(QP.start.H 5672 . 6467) (QP.update.windows 6469 . 7307) (QU 7309 . 7753)))))
STOP