(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "16-Oct-87 15:26:50" {PHYLUM}<CTAMARIN>EMULATOR>TSIMULATE.;17 35833
changes to%: (FNS TS.MAINMENUSELECTEDFN TS.MAKEMAINWINDOW)
(VARS TSIMULATECOMS)
previous date%: "30-Sep-87 13:01:40" {PHYLUM}<CTAMARIN>EMULATOR>TSIMULATE.;15)
(* "
Copyright (c) 1986, 1901, 1900, 1987 by Xerox Corporation. All rights reserved.
")
(PRETTYCOMPRINT TSIMULATECOMS)
(RPAQQ TSIMULATECOMS [(RECORDS TS.ITEMDISP TS.DISPINFO)
(FILES ACTIVEREGIONS)
(* * GENERAL DISPLAY ROUTINES)
(FNS TS.DISPITEM TS.DISPSTACK TS.REGIONSET TS.FINDPOS DispVars TS.INITVARS
InitEmulatorWindow TS.HEXTOINT)
(* * INITIALIZATION ROUTINES)
(FNS TS.INITDISPLIST TS.MAKEMAINWINDOW TS.DRAWWINDOW)
(* * MENU ACTIVATED FUNCTIONS)
(FNS TS.ITEMSELECT TS.MAINMENUSELECTEDFN TS.SETDISPLAYS TS.FRAMESELECT
TS.SETFLAGS)
(* * EXECUTION CONTROL ROUTINES)
(FNS TS.BREAKCONTROL)
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA)
(NLAML)
(LAMA])
(DECLARE%: EVAL@COMPILE
(RECORD TS.ITEMDISP (POSITION SHOWX SHOWY DISPAS TITLE TITLEX PROPNAME OFFSETREGION AREGION VARNAME))
(RECORD TS.DISPINFO (DTYPE DREGION XOFFSET XWIDTH CHARWIDTH CHARHEIGHT))
)
(FILESLOAD ACTIVEREGIONS)
(* * GENERAL DISPLAY ROUTINES)
(DEFINEQ
(TS.DISPITEM
[LAMBDA (WINDOW index VAL) (* rtk "26-Nov-86 14:19")
(PROG [X WORKREGION STARTX SHOWY (DISPLIST (WINDOWPROP WINDOW 'DISPLIST]
(if (NOT index)
then (RETURN NIL))
(with TS.DISPINFO (CAR DISPLIST)
[SETQ WORKREGION (CAADDR (ELT (CADR DISPLIST)
(LOGAND 63 index]
(BITBLT NIL NIL NIL WINDOW (fetch (REGION LEFT) of WORKREGION)
(fetch (REGION BOTTOM) of WORKREGION)
(fetch (REGION WIDTH) of WORKREGION)
(SUB1 (fetch (REGION HEIGHT) of WORKREGION))
'TEXTURE
'(ERASE) WHITESHADE WORKREGION)
(SETQ STARTX (PLUS (TIMES CHARWIDTH 3)
(fetch (REGION LEFT) of WORKREGION)))
(SETQ SHOWY (fetch (REGION BOTTOM) of WORKREGION))
(MOVETO STARTX SHOWY WINDOW)
(SETQ X (if VAL
then VAL
else (RegGet index)))
(PrintData X WINDOW)
(DRAWLINE STARTX (DIFFERENCE SHOWY 3)
(IPLUS STARTX (fetch (REGION WIDTH) of WORKREGION))
(DIFFERENCE SHOWY 3)
2 NIL WINDOW])
(TS.DISPSTACK
[LAMBDA (WINDOW index) (* ; "Edited 5-May-87 09:56 by rtk")
(* LOOP through all items in the stack & update values)
(if (NULL index)
then [for I from 0 to STACK-FRAME-MAX do (DisplayReg (PLUS I (TIMES 64 (WINDOWPROP
TS.MAINWINDOW
'CURRENTDISPFRAME]
(DisplayReg 'SP (WINDOWPROP StackFrameWindow 'LASTSP))
else (DisplayReg index])
(TS.REGIONSET
[LAMBDA (WINDOW AREGION) (* rtk "26-Nov-86 14:01")
(BITBLT NIL NIL NIL WINDOW (fetch (REGION LEFT) of AREGION)
(fetch (REGION BOTTOM) of AREGION)
(fetch (REGION WIDTH) of AREGION)
(fetch (REGION HEIGHT) of AREGION)
'TEXTURE
'INVERT BLACKSHADE AREGION])
(TS.FINDPOS
[LAMBDA (WINDOW POS) (* rtk "25-Feb-86 12:16")
(* * Return the Active Region associated with POS)
(for I in (CADR (WINDOWPROP WINDOW 'DISPLIST)) thereis (EQUAL (fetch (TS.ITEMDISP POSITION)
of I)
POS])
(DispVars
[LAMBDA NIL (* ; "Edited 8-May-87 12:16 by rtk")
(CLEARW VarsWindow)
(LET (val)
(for i in VarsList do (if (SETQ val (EvalEltSim i))
then (PRINTOUT VarsWindow i " - ")
(TAB 20 NIL VarsWindow)
(PRINTNUM '(FIX 10 16 T) val VarsWindow)
(PRINTOUT VarsWindow "H" T])
(TS.INITVARS
[LAMBDA NIL (* rtk "26-Nov-86 16:42")
(PROG (LOCLIST HEADERLIST)
(SETQ STACKFRAMES (ARRAY 9 'POINTER NIL 0))
(SETQ OPCODES NIL)
(SETQ TS.TRACEWINDOW NIL)
(SETQ OPCODES \TAMOPCODES)
(SETQ UFNARRAY \TAMOPCODEARRAY)
(SETQ CURRENTEXECFRAME 0)
(SETQ TRACESTR "")
(* * Initialize the Stack Display List)
[SETQ LOCLIST '((POS 0 TITLE "Ivars")
(POS 8 TITLE "Pvars")
(POS 16 TITLE "Header & Code")
(POS 18 TITLE "Vars / Stack"]
(SETQ TS.STACKDLIST (TS.INITDISPLIST LOCLIST 'STACKFRAME))
(for I from 0 to 8 do (SETA STACKFRAMES I (ARRAY 64 'POINTER 0 0))
(for J from 0 to 63 do (SETA (ELT STACKFRAMES I)
J
(TamRep 'NIL])
(InitEmulatorWindow
[LAMBDA NIL (* rtk "26-Nov-86 16:40")
(SETQ TamEmulator T)
(SETQ DoSimLog T)
(SETQ DoOpcodeTrace T)
(SETQ DoEmulatorVars T)
(SETQ DoEmulatorLog T)
(if (NOT (BOUNDP 'PlotWin))
then (SETQ PlotWin NIL))
(TS.INITVARS)
(if [NOT (AND (BOUNDP 'TS.MAINWINDOW)
(FMEMB TS.MAINWINDOW (OPENWINDOWS]
then (SETQ TS.MAINWINDOW (TS.MAKEMAINWINDOW))
(TS.DRAWWINDOW 'STACKFRAMEWINDOW 0 TS.STACKDLIST))
(WINDOWPROP StackFrameWindow 'DATAPTR (ELT STACKFRAMES 0])
(TS.HEXTOINT
[LAMBDA (S) (* rtk "21-Feb-86 14:16")
(PROG ((I 0)
(STR (CHCON S)))
[for CH in STR
do (SETQ I
(IPLUS (LLSH I 4)
(if (FMEMB (CHARACTER CH)
'(0 1 2 3 4 5 6 7 8 9))
then (CHARACTER CH)
else (if (FMEMB (CHARACTER CH)
'(A B C D E F))
then (IPLUS 10 (IDIFFERENCE CH (CHARCODE A)))
else (if (FMEMB (CHARACTER CH)
'(a b c d e f))
then (IPLUS 10 (IDIFFERENCE CH (CHARCODE a)))
0]
(RETURN I])
)
(* * INITIALIZATION ROUTINES)
(DEFINEQ
(TS.INITDISPLIST
[LAMBDA (INFODATA WTYPE) (* rtk "26-Nov-86 14:17")
(LET* ((WORKDLIST NIL)
(REGIONLIST NIL)
(INFOLIST NIL)
(BORDER2 4)
(LCHARHEIGHT (FONTPROP DEFAULTFONT 'HEIGHT))
(LCHARWIDTH (IPLUS [CAR (LAST (SORT (for i from 32 to 127 collect (CHARWIDTH i DEFAULTFONT
]
3))
(SHIFTBITS (TIMES LCHARWIDTH 2.5))
(LASTP 0)
(LASTY 0)
(DISPREC (create TS.DISPINFO
DTYPE ← WTYPE
CHARWIDTH ← LCHARWIDTH
CHARHEIGHT ← LCHARHEIGHT))
POS STITLE STITLEX TEMPX NEXTX POSX POSWIDTH WHEIGHT WWIDTH WXWIDTH WYHEIGHT TEMPINFO
TEMPREGION X titlespace displayinfo bigregion)
(SETQ titlespace (ARRAY 64 'POINTER NIL 0))
(SETQ displayinfo (ARRAY 64 'POINTER 0 0))
(for i in INFODATA do (if (LISTGET i 'TITLE)
then (SETA titlespace (LISTGET i 'POS)
i)))
(SELECTQ WTYPE
(STACKFRAME (SETQ WWIDTH 20)
(SETQ WHEIGHT (PLUS STACK-FRAME-MAX 5))
(SETQ MAXLINES STACK-FRAME-MAX))
(FUNHDR (SETQ WWIDTH 20)
(SETQ WHEIGHT 4)
(SETQ MAXLINES 10))
(PROMPTPRINT "ILLEGAL WINDOW TYPE"))
(SETQ WXWIDTH (IPLUS (ITIMES LCHARWIDTH WWIDTH)
BORDER2
(IQUOTIENT LCHARWIDTH 2)))
(SETQ WYHEIGHT (IPLUS (ITIMES LCHARHEIGHT WHEIGHT)
BORDER2))
(SETQ LASTY (ITIMES LCHARHEIGHT WHEIGHT))
(SETQ POSX (IDIFFERENCE (IQUOTIENT LCHARWIDTH 2)
2))
(SETQ POSWIDTH (ITIMES LCHARWIDTH 2))
(replace (TS.DISPINFO XWIDTH) of DISPREC with WXWIDTH)
(replace (TS.DISPINFO DREGION) of DISPREC with (CREATEREGION 0 0 (IPLUS WXWIDTH SHIFTBITS)
(IPLUS WYHEIGHT LCHARHEIGHT)))
(replace (TS.DISPINFO XOFFSET) of DISPREC with SHIFTBITS)
[for I from 0 to MAXLINES do (if (ELT titlespace I)
then (SETQ LASTY (IDIFFERENCE LASTY LCHARHEIGHT)))
(SETQ LASTY (IDIFFERENCE LASTY LCHARHEIGHT))
(SETQ bigregion (create ACTIVEREGION
REGION ← (CREATEREGION (IPLUS SHIFTBITS
2)
(IDIFFERENCE LASTY 1)
(ITIMES LCHARWIDTH 20)
(IDIFFERENCE
LCHARHEIGHT 2))
UPFN ← 'TS.ITEMSELECT
DATA ← I))
(SETA displayinfo I (LIST NIL (CREATEREGION POSX
(IDIFFERENCE LASTY 1)
POSWIDTH
(IDIFFERENCE LCHARHEIGHT
2))
bigregion))
(SETQ REGIONLIST (APPEND REGIONLIST (LIST bigregion]
(LIST DISPREC displayinfo REGIONLIST titlespace])
(TS.MAKEMAINWINDOW
[LAMBDA NIL (* ; "Edited 16-Oct-87 10:36 by Krivacic")
(PROG ((MENU1 (create MENU
ITEMS ← '(Go Stop Step BrkPts Displays Exit)
TITLE ← "Debug Menu"
MENUROWS ← 1
CENTERFLG ← T
WHENSELECTEDFN ← 'TS.MAINMENUSELECTEDFN))
(MENU2 (create MENU
ITEMS ← '("Frame 0" "Frame 1" "Frame 2" "Frame 3" "Global Frame")
TITLE ← "Stack Frame Display"
MENUROWS ← 1
CENTERFLG ← T
WHENSELECTEDFN ← 'TS.MAINMENUSELECTEDFN))
(MENU3 (create MENU
ITEMS ← '(Reset Hold Irq1 Irq2 Flags)
TITLE ← "External Pins"
MENUROWS ← 1
CENTERFLG ← T
WHENSELECTEDFN ← 'TS.MAINMENUSELECTEDFN))
WINDOW WPOSITION FRAMEHEIGHT FRAMEWIDTH FULLHEIGHT FULLWIDTH TRACEWIDTH TRACEHEIGHT)
(with TS.DISPINFO (CAR TS.STACKDLIST)
(SETQ FRAMEHEIGHT (fetch (REGION HEIGHT) of DREGION))
(SETQ FRAMEWIDTH (fetch (REGION WIDTH) of DREGION))
(SETQ FULLHEIGHT (IPLUS FRAMEHEIGHT (ITIMES CHARHEIGHT 9)))
(SETQ FULLWIDTH (MAX (ITIMES FRAMEWIDTH 2)
(ITIMES 50 CHARWIDTH)))
(SETQ TRACEWIDTH (IDIFFERENCE FULLWIDTH FRAMEWIDTH))
(SETQ TRACEHEIGHT (ITIMES CHARHEIGHT 20))
(SETQ LOGHEIGHT (ITIMES CHARHEIGHT 5))
(SETQ VARSHEIGHT (ITIMES CHARHEIGHT 20))
(SETQ WPOSITION (GETBOXPOSITION FULLWIDTH FULLHEIGHT 200 5 NIL
"Position Main Simulator Window"))
(SETQ WINDOW (CREATEW (CREATEREGION (fetch (POSITION XCOORD) of WPOSITION)
(IPLUS (fetch (POSITION YCOORD) of WPOSITION)
FRAMEHEIGHT
(ITIMES CHARHEIGHT 4))
FULLWIDTH
(ITIMES CHARHEIGHT 4))
"Tamarin Simulator"))
(ATTACHMENU MENU2 WINDOW 'BOTTOM 'JUSTIFY)
(ATTACHMENU MENU1 WINDOW 'BOTTOM 'JUSTIFY)
(ATTACHMENU MENU3 WINDOW 'BOTTOM 'JUSTIFY)
(SETQ TS.TRACEWINDOW (CREATEW (CREATEREGION (fetch (POSITION XCOORD) of WPOSITION)
(IDIFFERENCE (IPLUS (fetch (POSITION YCOORD)
of WPOSITION)
FRAMEHEIGHT)
TRACEHEIGHT)
(IDIFFERENCE FULLWIDTH FRAMEWIDTH)
TRACEHEIGHT)
"Trace Window"))
(SETQ logWindow (CREATEW (CREATEREGION (fetch (POSITION XCOORD) of WPOSITION)
(IDIFFERENCE (IPLUS (fetch (POSITION YCOORD)
of WPOSITION)
FRAMEHEIGHT)
(IPLUS LOGHEIGHT TRACEHEIGHT))
(IDIFFERENCE FULLWIDTH FRAMEWIDTH)
LOGHEIGHT)
"Tamarin Emulator Log"))
(SETQ VarsWindow (CREATEW (CREATEREGION (fetch (POSITION XCOORD) of WPOSITION)
(IDIFFERENCE (IPLUS (fetch (POSITION YCOORD)
of WPOSITION)
FRAMEHEIGHT)
(IPLUS LOGHEIGHT TRACEHEIGHT VARSHEIGHT))
(IDIFFERENCE FULLWIDTH FRAMEWIDTH)
VARSHEIGHT)
"Emulator Vars"))
(DSPSCROLL 'ON TS.TRACEWINDOW)
(DSPSCROLL 'ON logWindow)
(DSPSCROLL 'ON VarsWindow)
(WINDOWPROP TS.TRACEWINDOW 'PAGEFULLFN 'NILL)
(WINDOWPROP logWindow 'PAGEFULLFN 'NILL)
(WINDOWPROP VarsWindow 'PAGEFULLFN 'NILL)
(ATTACHWINDOW TS.TRACEWINDOW WINDOW 'BOTTOM 'LEFT)
(ATTACHWINDOW logWindow WINDOW 'BOTTOM 'LEFT)
(ATTACHWINDOW VarsWindow WINDOW 'BOTTOM 'LEFT)
(WINDOWPROP WINDOW 'TRACEWINDOW TS.TRACEWINDOW)
(WINDOWPROP WINDOW 'logWindow logWindow)
(WINDOWPROP WINDOW 'VarsWindow VarsWindow)
(WINDOWPROP WINDOW 'DEBUGMENU MENU1))
(WINDOWPROP WINDOW 'FLAGS '(Stopping OpcodeTrace EmulatorLog EmulatorVars StackFrame SimLog
))
(WINDOWPROP WINDOW 'PAGEFULLFN 'NILL)
(WINDOWPROP WINDOW 'STACKFRAMES STACKFRAMES)
(WINDOWPROP WINDOW 'CURRENTDISPFRAME 3)
(WINDOWPROP WINDOW 'CURRENTEXECFRAME 0)
(WINDOWPROP WINDOW 'FRAMEMENUITEMS (fetch (MENU ITEMS) of MENU2))
(WINDOWPROP WINDOW 'FRAMEMENU MENU2)
(WINDOWPROP WINDOW 'MENU3 MENU3)
(SETQ Flags 0)
(RETURN WINDOW])
(TS.DRAWWINDOW
[LAMBDA (WPROP FNAME DISPLIST) (* ; "Edited 7-May-87 14:40 by rtk")
(PROG [WHEIGHT WWIDTH TOPLINE STACKW TEMPY TITLEX LXOFF disparray titlearray (PCLOC 0)
POSITION PRINTY (LASTPS -1)
(WORKREGION (CREATEREGION 0 0 0 0))
(MAINREGION (WINDOWPROP TS.MAINWINDOW 'REGION]
(SETQ titlearray (CADDDR DISPLIST))
(SETQ disparray (CADR DISPLIST))
[with TS.DISPINFO (CAR DISPLIST)
(SETQ WHEIGHT (fetch (REGION HEIGHT) of DREGION))
(SETQ WWIDTH (fetch (REGION WIDTH) of DREGION))
(SETQ LXOFF XOFFSET)
(replace (REGION WIDTH) of WORKREGION with (fetch (REGION WIDTH) of DREGION))
(replace (REGION HEIGHT) of WORKREGION with (fetch (REGION HEIGHT) of DREGION))
(replace (REGION LEFT) of WORKREGION with (IDIFFERENCE (IPLUS (fetch (REGION LEFT)
of MAINREGION)
(WINDOWPROP
TS.MAINWINDOW
'WIDTH))
(fetch (REGION WIDTH) of DREGION)))
(replace (REGION BOTTOM) of WORKREGION with (fetch (REGION BOTTOM) of MAINREGION))
(if (NOT (WINDOWPROP TS.MAINWINDOW WPROP))
then [SETQ STACKW (CREATEW WORKREGION (if (EQ WPROP 'STACKFRAMEWINDOW)
then (CONCAT "STACK FRAME # " FNAME)
else (CONCAT "FUNCTION: " FNAME]
(SETQ StackFrameWindow STACKW)
(ATTACHWINDOW STACKW TS.MAINWINDOW 'BOTTOM (if (EQ WPROP 'STACKFRAMEWINDOW)
then 'RIGHT
else 'LEFT))
(WINDOWPROP TS.MAINWINDOW WPROP STACKW))
(DRAWLINE (TIMES CHARWIDTH 2.5)
0
(TIMES CHARWIDTH 2.5)
WHEIGHT 2 NIL STACKW)
[SETQ POSITION (DIFFERENCE WHEIGHT (PLUS (TIMES CHARHEIGHT 2)
(IQUOTIENT CHARHEIGHT 2]
(SETQ TITLEX (IQUOTIENT (DIFFERENCE WWIDTH (TIMES CHARWIDTH 2.5))
2))
(WithRadix 10 (for i from 0 to STACK-FRAME-MAX
do [SETQ PRINTY (fetch (REGION BOTTOM)
of (CADR (ELT disparray i]
(if (ELT titlearray i)
then (MOVETO TITLEX (PLUS PRINTY CHARHEIGHT)
STACKW)
(PRIN1 (LISTGET (ELT titlearray i)
'TITLE)
STACKW)
(DRAWLINE 0 (DIFFERENCE (PLUS PRINTY CHARHEIGHT)
3)
WWIDTH
(DIFFERENCE (PLUS PRINTY CHARHEIGHT)
3)
2 NIL STACKW))
(MOVETO (IQUOTIENT CHARWIDTH 2)
PRINTY STACKW)
(PRIN1 i STACKW)
(DRAWLINE 0 (DIFFERENCE PRINTY 3)
WWIDTH
(DIFFERENCE PRINTY 3)
2 NIL STACKW]
(SETACTIVEREGIONS STACKW (CADDR DISPLIST))
(WINDOWPROP STACKW 'WTYPE WPROP)
(WINDOWPROP STACKW 'DISPLIST DISPLIST)
(RETURN STACKW])
)
(* * MENU ACTIVATED FUNCTIONS)
(DEFINEQ
(TS.ITEMSELECT
[LAMBDA (WINDOW REGION DATA) (* rtk "26-Nov-86 12:31")
(PROG ([index (PLUS DATA (TIMES 64 (WINDOWPROP TS.MAINWINDOW 'CURRENTDISPFRAME]
(MENUVAR NIL)
VALUE IW)
[SETQ MENUVAR (create MENU
ITEMS ← '((Change 'Change "Change Hex Value")
(Inspect 'Inspect "Inspect with Inspector"]
(COND
[MENUVAR (SETQ VALUE (RegGet index))
(if (EQ MENUVAR 'Invert)
then (SETQ VALUE (LOGNOT VALUE))
else (CLEARW TS.MAINWINDOW)
(SELECTQ (MENU MENUVAR)
(Inspect (SETQ IW (INSPECT VALUE))
(while (FMEMB IW (OPENWINDOWS)) do (BLOCK))
(SETQ VALUE NIL))
(Change (TTYDISPLAYSTREAM TS.MAINWINDOW)
(MOVETO 4 4)
(PRINTOUT TS.MAINWINDOW "Enter new Hex Value >")
(SETQ VALUE (TS.HEXTOINT (READ)))
(TERPRI TS.MAINWINDOW)
(TERPRI TS.MAINWINDOW)
(TTYDISPLAYSTREAM))
(PROMPTPRINT "No Selection")))
(SETPICKREGION WINDOW)
(COND
((OR VALUE (EQ MENUVAR 'Invert))
(RegSet index VALUE]
(T (SETPICKREGION WINDOW])
(TS.MAINMENUSELECTEDFN
[LAMBDA (ITEMSELECTED MENUUSED MOUSEKEY) (* ; "Edited 16-Oct-87 14:39 by Krivacic")
(SELECTQ ITEMSELECTED
(Reset (SETQ Reset (LNOT Reset))
(SHADEITEM 'Reset MENUUSED (if (TF Reset)
then 12
else 0)))
(Hold (SETQ Hold (LNOT Hold))
(SHADEITEM 'Hold MENUUSED (if (TF Hold)
then 12
else 0)))
(Irq1 (SETQ Irq1 (LNOT Irq1))
(SHADEITEM 'Irq1 MENUUSED (if (TF Irq1)
then 12
else 0)))
(Irq2 (SETQ Irq2 (LNOT Irq2))
(SHADEITEM 'Irq2 MENUUSED (if (TF Irq2)
then 12
else 0)))
(Flags (if MOUSEKEY
then (PROG (item)
[SETQ item (MENU (create MENU
ITEMS ← '(DoTransSim]
(SELECTQ [MENU (create MENU
ITEMS ← '(On Off]
(On (SET item T))
(Off (SET item NIL))
NIL))))
(Go [WINDOWPROP TS.MAINWINDOW 'FLAGS (UNION '(StartStep) (LDIFFERENCE (WINDOWPROP
TS.MAINWINDOW
'FLAGS)
'(Stepping CycleStep
UcodeStep OpcodeStep]
(SHADEITEM 'Go MENUUSED 12)
(SHADEITEM 'Step MENUUSED 0)
(SHADEITEM 'Stop MENUUSED 0)
(SETQ JustReset T))
(Stop [WINDOWPROP TS.MAINWINDOW 'FLAGS (UNION '(Stopping) (WINDOWPROP TS.MAINWINDOW
'FLAGS]
(SHADEITEM 'Stop MENUUSED 12)
(SHADEITEM 'Go MENUUSED 0)
(SHADEITEM 'Step MENUUSED 0))
(Step (SETQ JustReset T)
[WINDOWPROP
TS.MAINWINDOW
'FLAGS
(UNION '(StartStep Stepping)
(if (AND TamEmulator (OR [NOT (INTERSECTION '(CycleStep UcodeStep OpcodeStep)
(WINDOWPROP TS.MAINWINDOW 'FLAGS]
(EQUAL 'MIDDLE MOUSEKEY)))
then [UNION (LDIFFERENCE (WINDOWPROP TS.MAINWINDOW 'FLAGS)
'(Stepping CycleStep UcodeStep OpcodeStep))
(PROG [(s (MENU (create MENU
ITEMS ← '(CycleStep UcodeStep OpcodeStep
)
TITLE ← "Step Type"]
(if s
then (RETURN (LIST s))
else (RETURN '(CycleStep]
else (WINDOWPROP TS.MAINWINDOW 'FLAGS]
(SHADEITEM 'Step MENUUSED 12)
(SHADEITEM 'Stop MENUUSED 0))
(Displays (TS.SETDISPLAYS))
(Exit [WINDOWPROP TS.MAINWINDOW 'FLAGS (UNION '(Stopping Exit) (WINDOWPROP TS.MAINWINDOW
'FLAGS]
(SHADEITEM 'Stop MENUUSED 12)
(SHADEITEM 'Go MENUUSED 0)
(SHADEITEM 'Step MENUUSED 0))
(BrkPts (CLEARW TS.MAINWINDOW)
(MOVETO 4 4 TS.MAINWINDOW)
(PROG [OPNAME (BREAKPOINTS (WINDOWPROP TS.MAINWINDOW 'BREAKPOINTS]
(CLEARW TS.MAINWINDOW)
(SELECTQ [MENU (create MENU
ITEMS ← '(Add Display Clear]
(Add (TTYDISPLAYSTREAM TS.MAINWINDOW)
(PRINTOUT TS.MAINWINDOW "Break on Opcode > ")
(SETQ OPNAME (READ))
(if OPNAME
then (SETQ BREAKPOINTS (CONS OPNAME BREAKPOINTS)))
(CLEARW TS.MAINWINDOW)
(MOVETO 4 4 TS.MAINWINDOW)
(PRINTOUT TS.MAINWINDOW BREAKPOINTS)
(TTYDISPLAYSTREAM))
(Display (PRINTOUT TS.MAINWINDOW BREAKPOINTS))
(Clear (SETQ BREAKPOINTS NIL)
(PRINTOUT TS.MAINWINDOW "Breakpoints Cleared"))
(PRINTOUT TS.MAINWINDOW "NO SELECTION"))
(WINDOWPROP TS.MAINWINDOW 'BREAKPOINTS BREAKPOINTS)))
(if (EQUAL ITEMSELECTED "Frame 0")
then (TS.FRAMESELECT MENUUSED ITEMSELECTED 0 MOUSEKEY)
elseif (EQUAL ITEMSELECTED "Frame 1")
then (TS.FRAMESELECT MENUUSED ITEMSELECTED 1 MOUSEKEY)
elseif (EQUAL ITEMSELECTED "Frame 2")
then (TS.FRAMESELECT MENUUSED ITEMSELECTED 2 MOUSEKEY)
elseif (EQUAL ITEMSELECTED "Frame 3")
then (TS.FRAMESELECT MENUUSED ITEMSELECTED 3 MOUSEKEY)
elseif (EQUAL ITEMSELECTED "Global Frame")
then (TS.FRAMESELECT MENUUSED ITEMSELECTED 4 MOUSEKEY)
else])
(TS.SETDISPLAYS
[LAMBDA NIL (* rtk "31-Dec-00 22:08")
(PROG ((s (MENU (create MENU
ITEMS ← '(OpcodeTrace EmulatorLog EmulatorVars StackFrame SimLog
AllDisplays)
TITLE ← "Display Toggle")))
state)
(if (NOT s)
then (RETURN))
[SETQ state (MENU (create MENU
ITEMS ← '(On Off)
TITLE ← (CONCAT "State of " s " Display"]
(if state
then [WINDOWPROP TS.MAINWINDOW 'FLAGS
(if (EQ s 'AllDisplays)
then [if (EQ state 'Off)
then (LDIFFERENCE (WINDOWPROP TS.MAINWINDOW 'FLAGS)
'(OpcodeTrace EmulatorLog EmulatorVars StackFrame
SimLog))
else (APPEND (COPY '(OpcodeTrace EmulatorLog EmulatorVars
StackFrame SimLog))
(LDIFFERENCE (WINDOWPROP TS.MAINWINDOW 'FLAGS)
'(OpcodeTrace EmulatorLog EmulatorVars
StackFrame SimLog]
else (if (EQ state 'Off)
then (LDIFFERENCE (WINDOWPROP TS.MAINWINDOW 'FLAGS)
(LIST s))
else (CONS s (WINDOWPROP TS.MAINWINDOW 'FLAGS]
(TS.SETFLAGS])
(TS.FRAMESELECT
[LAMBDA (MENUUSED ITEM NUMBER MOUSEKEY) (* rtk "26-Nov-86 16:59")
(for I in (WINDOWPROP TS.MAINWINDOW 'FRAMEMENUITEMS) do (SHADEITEM I MENUUSED 0))
(SHADEITEM ITEM MENUUSED 12)
(WINDOWPROP TS.MAINWINDOW 'CURRENTDISPFRAME NUMBER)
(PROG [(SWINDOW (WINDOWPROP TS.MAINWINDOW 'STACKFRAMEWINDOW]
(SETQ StackFrameWindow SWINDOW)
(WINDOWPROP (WINDOWPROP TS.MAINWINDOW 'TRACEWINDOW)
'TITLE "Opcode Trace Window")
(WINDOWPROP SWINDOW 'TITLE (CONCAT "Stack Frame # " NUMBER))
(TS.DISPSTACK SWINDOW])
(TS.SETFLAGS
[LAMBDA NIL (* rtk "31-Dec-00 22:09")
[SETQ DoSimLog (FMEMB 'SimLog (WINDOWPROP TS.MAINWINDOW 'FLAGS]
[SETQ DoOpcodeTrace (FMEMB 'OpcodeTrace (WINDOWPROP TS.MAINWINDOW 'FLAGS]
[SETQ DoEmulatorVars (FMEMB 'EmulatorVars (WINDOWPROP TS.MAINWINDOW 'FLAGS]
(SETQ DoEmulatorLog (FMEMB 'EmulatorLog (WINDOWPROP TS.MAINWINDOW 'FLAGS])
)
(* * EXECUTION CONTROL ROUTINES)
(DEFINEQ
(TS.BREAKCONTROL
[LAMBDA NIL (* ; "Edited 7-May-87 14:42 by rtk")
[if (FMEMB 'Exit (WINDOWPROP TS.MAINWINDOW 'FLAGS))
then [WINDOWPROP TS.MAINWINDOW 'FLAGS (LDIFFERENCE (UNION '(Stopping Stepping)
(WINDOWPROP TS.MAINWINDOW
'FLAGS))
'(Exit]
(if TamEmulator
then (BREAK1 NIL T (Emulator Stopped)
NIL)
else (DEL.PROCESS (THIS.PROCESS] (* if (INTERSECTION (QUOTE
(Stopping StkUpdt)) (WINDOWPROP
TS.MAINWINDOW (QUOTE FLAGS))) then
(TS.DISPSTACK STACKWINDOW))
[WithRadix 8 (CLEARW TS.MAINWINDOW)
(if (AND (INTERSECTION '(Stopping Tracing) (WINDOWPROP TS.MAINWINDOW 'FLAGS))
(NOT TamEmulator))
then (TERPRI TS.TRACEWINDOW)
(for I in TRACESTR do (PRIN1 I TS.TRACEWINDOW)))
(if (INTERSECTION '(Stopping Stepping) (WINDOWPROP TS.MAINWINDOW 'FLAGS))
then (DOSELECTEDITEM (WINDOWPROP TS.MAINWINDOW 'DEBUGMENU)
'Stop
'LEFT)
(MOVETO 4 4 TS.MAINWINDOW)
(PRINTOUT TS.MAINWINDOW "Break: ")
(for I in TRACESTR do (PRIN1 I TS.MAINWINDOW))
(while [NULL (INTERSECTION '(StartStep Exit) (WINDOWPROP TS.MAINWINDOW
'FLAGS]
do (BLOCK 10))
(if (FMEMB 'Exit (WINDOWPROP TS.MAINWINDOW 'FLAGS))
then (TS.BREAKCONTROL]
(WINDOWPROP TS.MAINWINDOW 'FLAGS (LDIFFERENCE (WINDOWPROP TS.MAINWINDOW 'FLAGS)
'(StartStep Stopping])
)
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
(ADDTOVAR NLAMA )
(ADDTOVAR NLAML )
(ADDTOVAR LAMA )
)
(PUTPROPS TSIMULATE COPYRIGHT ("Xerox Corporation" 1986 1901 1900 1987))
(DECLARE%: DONTCOPY
(FILEMAP (NIL (1780 7922 (TS.DISPITEM 1790 . 3246) (TS.DISPSTACK 3248 . 3886) (TS.REGIONSET 3888 .
4293) (TS.FINDPOS 4295 . 4745) (DispVars 4747 . 5272) (TS.INITVARS 5274 . 6356) (InitEmulatorWindow
6358 . 6992) (TS.HEXTOINT 6994 . 7920)) (7959 22683 (TS.INITDISPLIST 7969 . 12184) (TS.MAKEMAINWINDOW
12186 . 18140) (TS.DRAWWINDOW 18142 . 22681)) (22721 33310 (TS.ITEMSELECT 22731 . 24418) (
TS.MAINMENUSELECTEDFN 24420 . 30395) (TS.SETDISPLAYS 30397 . 32262) (TS.FRAMESELECT 32264 . 32890) (
TS.SETFLAGS 32892 . 33308)) (33350 35604 (TS.BREAKCONTROL 33360 . 35602)))))
STOP