(FILECREATED "17-Dec-86 17:19:15" {ERIS}<TAMARIN>WORK>SIMULATE>TSIMULATE.;70 78809
changes to: (FNS TS.MAINMENUSELECTEDFN)
previous date: "19-Sep-86 16:40:33" {ERIS}<TAMARIN>WORK>SIMULATE>TSIMULATE.;69)
(* Copyright (c) 1986, 1901, 1900 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT TSIMULATECOMS)
(RPAQQ TSIMULATECOMS [(RECORDS TS.ITEMDISP TS.DISPINFO)
(FILES ACTIVEREGIONS)
(* * E (RADIX 8))
(CONSTANTS (TS.MAXINT 536870911)
(TS.MININT -536870912)
(* * Amount to bump a ptr to get to next tamarin word)
(TS.WORDINCR 2)
(TS.RADRSHIFT 1)
(* * Tamarin constants)
(TS.NILCONST 536870912)
(TS.UNBINDCONST 939524096)
(TS.TCONST 536870913)
(* * Type bits to OR with the object to set the Type)
(TS.INTEGERBITS 1073741824)
(TS.USERLISTBITS 134217728)
(TS.LISTBITS 268435456)
(TS.CODEBITS 402653184)
(TS.ATOMBITS 536870912)
(TS.STACKBITS 671088640)
(TS.NUMBERBITS 805306368)
(TS.UNBOUNDBITS 939524096)
(TS.INDIRECTBITS 1006632960)
(* * Major type values)
(TS.INTEGERTYP 1)
(TS.POINTERTYP 0)
(* * Subtype values)
(TS.OBJECTSUBTYP 0)
(TS.USERLISTSUBTYP 8)
(TS.LISTSUBTYP 16)
(TS.CODESUBTYP 24)
(TS.ATOMSUBTYP 32)
(TS.STACKSUBTYP 40)
(TS.NUMBERSUBTYP 48)
(TS.UNBOUNDSUBTYP 56)
(TS.INDIRECTSUBTYP 60)
(TS.MEMMAX 5000))
(* E (RADIX 10))
(FNS TS.RUN TS.MAIN (* * GENERAL SIMULATOR DISPLAY VARIABLE REFERENCING)
TS.GETFRAMEPROP TS.PUTFRAMEPROP TS.GETFUNHDRPROP (* * GENERAL DISPLAY
ROUTINES)
TS.DISPITEM TS.DISPSTACK TS.DISPFUNHDR TS.FINDW TS.REGIONSET TS.FINDPOS
DispVars (* * INITIALIZATION ROUTINES)
TS.INITVARS InitEmulatorWindow TS.HEXTOINT TS.INITDISPLIST TS.MAKEFRAME
TS.MAKEMAINWINDOW TS.DRAWWINDOW TS.STACKW TS.FUNHDRW (* * MENU ACTIVATED
FUNCTIONS)
TS.ITEMSELECT TS.MAINMENUSELECTEDFN TS.SETDISPLAYS TS.FRAMESELECT
TS.SETVARNAMES TS.GETNAMETABLE TS.GETFUNHDRPROP TS.SETFLAGS (* *
EXECUTION
CONTROL
ROUTINES)
TS.EXECUTE TS.SETFNVARS TS.BREAKCONTROL TS.FETCH (* * FUNCTION CALL /
RETURN)
TS.TAMFUNCTIONCALL TS.TAMFUNCTIONRETURN TS.FINDNEXTFRAME TS.PUNTFRAME
TS.PUNTPREVIOUSFRAMES TS.UFNCALL (* * OPCODE SUPPORT ROUTINES)
(* * STACK OPERATIONS)
TS.POP TS.PUSH TS.REFTOS (* * D-MACHINE TO TAMARIN CONVERSION ROUTINES)
TS.NEWTINT TS.NEWTSTACKP TS.NEWTPTR (* * INTERNAL REFERENCING)
TS.VARREF TS.VARSTORE TS.GETOPCODEOFFSET (* * PREDICATES RETURNING
D-MACHINT T OR NIL)
TS.OBJECTP TS.USERLISTP TS.LISTP TS.CODEP TS.ATOMP TS.STACKP TS.NUMBERP
TS.UNBOUNDP TS.INDIRECTP TS.INTEGERP TS.POINTERP TS.FLOATP)
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
(ADDVARS (NLAMA TS.RUN)
(NLAML TS.MAIN)
(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)
(* * E (RADIX 8))
(DECLARE: EVAL@COMPILE
(RPAQQ TS.MAXINT 536870911)
(RPAQQ TS.MININT -536870912)
(RPAQQ TS.WORDINCR 2)
(RPAQQ TS.RADRSHIFT 1)
(RPAQQ TS.NILCONST 536870912)
(RPAQQ TS.UNBINDCONST 939524096)
(RPAQQ TS.TCONST 536870913)
(RPAQQ TS.INTEGERBITS 1073741824)
(RPAQQ TS.USERLISTBITS 134217728)
(RPAQQ TS.LISTBITS 268435456)
(RPAQQ TS.CODEBITS 402653184)
(RPAQQ TS.ATOMBITS 536870912)
(RPAQQ TS.STACKBITS 671088640)
(RPAQQ TS.NUMBERBITS 805306368)
(RPAQQ TS.UNBOUNDBITS 939524096)
(RPAQQ TS.INDIRECTBITS 1006632960)
(RPAQQ TS.INTEGERTYP 1)
(RPAQQ TS.POINTERTYP 0)
(RPAQQ TS.OBJECTSUBTYP 0)
(RPAQQ TS.USERLISTSUBTYP 8)
(RPAQQ TS.LISTSUBTYP 16)
(RPAQQ TS.CODESUBTYP 24)
(RPAQQ TS.ATOMSUBTYP 32)
(RPAQQ TS.STACKSUBTYP 40)
(RPAQQ TS.NUMBERSUBTYP 48)
(RPAQQ TS.UNBOUNDSUBTYP 56)
(RPAQQ TS.INDIRECTSUBTYP 60)
(RPAQQ TS.MEMMAX 5000)
(CONSTANTS (TS.MAXINT 536870911)
(TS.MININT -536870912)
(TS.WORDINCR 2)
(TS.RADRSHIFT 1)
(TS.NILCONST 536870912)
(TS.UNBINDCONST 939524096)
(TS.TCONST 536870913)
(TS.INTEGERBITS 1073741824)
(TS.USERLISTBITS 134217728)
(TS.LISTBITS 268435456)
(TS.CODEBITS 402653184)
(TS.ATOMBITS 536870912)
(TS.STACKBITS 671088640)
(TS.NUMBERBITS 805306368)
(TS.UNBOUNDBITS 939524096)
(TS.INDIRECTBITS 1006632960)
(TS.INTEGERTYP 1)
(TS.POINTERTYP 0)
(TS.OBJECTSUBTYP 0)
(TS.USERLISTSUBTYP 8)
(TS.LISTSUBTYP 16)
(TS.CODESUBTYP 24)
(TS.ATOMSUBTYP 32)
(TS.STACKSUBTYP 40)
(TS.NUMBERSUBTYP 48)
(TS.UNBOUNDSUBTYP 56)
(TS.INDIRECTSUBTYP 60)
(TS.MEMMAX 5000))
)
(* E (RADIX 10))
(DEFINEQ
(TS.RUN
[NLAMBDA FNLIST (* rtk " 7-Apr-86 11:14")
(DEL.PROCESS (QUOTE TS.MAIN))
(if (NOT FNLIST)
then (SETQ FNLIST DT.LASTARG))
(ADD.PROCESS (LIST (QUOTE TS.MAIN)
FNLIST])
(TS.MAIN
[NLAMBDA (FNLIST) (* rtk " 5-May-86 12:32")
(* (* E (RADIX 8)) (SETQ TS.MAXINT 536870911) (SETQ TS.MININT -536870912) (* * Amount to bump a ptr to get to next
tamarin word) (SETQ TS.WORDINCR 2) (SETQ TS.RADRSHIFT 1) (* * Tamarin constants) (SETQ TS.NILCONST 536870912)
(SETQ TS.UNBINDCONST 939524096) (SETQ TS.TCONST 536870913) (* * Type bits to OR with the object to set the Type)
(SETQ TS.INTEGERBITS 1073741824) (SETQ TS.USERLISTBITS 134217728) (SETQ TS.LISTBITS 268435456)
(SETQ TS.CODEBITS 402653184) (SETQ TS.ATOMBITS 536870912) (SETQ TS.STACKBITS 671088640) (SETQ TS.NUMBERBITS
805306368) (SETQ TS.UNBOUNDBITS 939524096) (SETQ TS.INDIRECTBITS 1006632960) (* * Major type values)
(SETQ TS.INTEGERTYP 1) (SETQ TS.POINTERTYP 0) (* * Subtype values) (SETQ TS.OBJECTSUBTYP 0)
(SETQ TS.USERLISTSUBTYP 8) (SETQ TS.LISTSUBTYP 16) (SETQ TS.CODESUBTYP 24) (SETQ TS.ATOMSUBTYP 32)
(SETQ TS.STACKSUBTYP 40) (SETQ TS.NUMBERSUBTYP 48) (SETQ TS.UNBOUNDSUBTYP 56) (SETQ TS.INDIRECTSUBTYP 60)
(* * Other constants) (* E (RADIX 10)))
(* SETQ TS.MEMMAX 5000)
(PROG ((STACKFRAMES (ARRAY 4 (QUOTE POINTER)
NIL 0))
TS.FRAMEFREELIST TS.MEMFREEPTR OPCODES TRACEWINDOW TMEM RTVAL)
(SETQ TMEM (ARRAY TS.MEMMAX (QUOTE (BITS 32))
NIL 0))
(TS.INITVARS)
(SETQ TS.MAINWINDOW (TS.MAKEMAINWINDOW))
(TS.DRAWWINDOW (QUOTE STACKFRAMEWINDOW)
0 TS.STACKDLIST)
(TS.DRAWWINDOW (QUOTE FUNHDRWINDOW)
(CAR FNLIST)
TS.FUNHDRDLIST) (* \MAKETAMOPCODEARRAY)
(SETQ OPCODES \TAMOPCODES)
(SETQ UFNARRAY \TAMOPCODEARRAY)
(SETQ CURRENTEXECFRAME 0)
(COND
((TS.MAKEFRAME (ELT STACKFRAMES 0)
(CAR FNLIST))
[for I from 1 to (LENGTH (CDR FNLIST))
do (TS.PUTFRAMEPROP (ELT STACKFRAMES 0)
(IDIFFERENCE (IPLUS I (fetch (TFRAME OVERHEADCELLS)
of T))
1)
(DTOT (EVAL (CAR (NTH (CDR FNLIST)
I]
[TS.PUTFRAMEPROP (ELT STACKFRAMES 0)
(QUOTE PC)
(IPLUS (TS.GETFRAMEPROP (ELT STACKFRAMES 0)
(QUOTE PC))
(LENGTH (CDR FNLIST]
(SETQ RTVAL (TTOD (TS.EXECUTE 0)))
(TERPRI TS.MAINWINDOW)
(TERPRI TS.MAINWINDOW)
(MOVETO 4 4 TS.MAINWINDOW)
(PRINTOUT TS.MAINWINDOW (CONCAT "RESULT: " RTVAL))
(RETURN RTVAL)))
(CLOSEW TS.MAINWINDOW])
(TS.GETFRAMEPROP
[LAMBDA (FRAME PROP) (* rtk " 1-Apr-86 10:21")
(if (EQ PROP (QUOTE ?))
then NIL
else (if (NUMBERP PROP)
then (TF.GETREGABS FRAME PROP)
else
(* * EVAL (BQUOTE (FETCH (TFRAME , PROP) OF FRAME)))
(SELECTQ PROP
(TRAP.ON.EXIT.P (fetch (TFRAME TRAP.ON.EXIT.P) of FRAME))
(LARGE.FRAME.P (fetch (TFRAME LARGE.FRAME.P) of FRAME))
(TRAP.ON.ENTRY.P (fetch (TFRAME TRAP.ON.ENTRY.P) of FRAME))
(FAST.FRAME.P (fetch (TFRAME FAST.FRAME.P) of FRAME))
(PAD.BITS (fetch (TFRAME PAD.BITS) of FRAME))
(MAXVAR (fetch (TFRAME MAXVAR) of FRAME))
(USECOUNT (fetch (TFRAME USECOUNT) of FRAME))
(SP (fetch (TFRAME SP) of FRAME))
(PC (fetch (TFRAME PC) of FRAME))
(NAMETABLE (fetch (TFRAME NAMETABLE) of FRAME))
(CODEBASE (fetch (TFRAME CODEBASE) of FRAME))
(ALINK (fetch (TFRAME ALINK) of FRAME))
(CLINK (fetch (TFRAME CLINK) of FRAME))
(BREAK1 NIL T (Illegal Property in TS.GETFRAMEPROP)
NIL])
(TS.PUTFRAMEPROP
[LAMBDA (FRAME PROP VAL) (* edited: "19-Sep-86 16:40")
(if (EQ PROP (QUOTE ?))
then TS.NILCONST
else (if (NULL VAL)
then (SETQ VAL TS.NILCONST))
(if (NOT (NUMBERP PROP))
then (SETQ PROP (SELECTQ PROP
(SP (if (OR (LESSP VAL 0)
(GREATERP VAL 39))
then (SETQ VAL 0))
-2)
(TRAP.ON.EXIT.P 0)
(PC 1)
(NAMETABLE 2)
(CODEBASE 3)
(ALINK 4)
(CLINK 5)
-1)))
(if (GREATERP PROP -1)
then (TF.SETREGABS FRAME PROP VAL))
(* * Re-Display if variable is in current display frame)
(if [AND (FMEMB (QUOTE StackFrame)
(WINDOWPROP TS.MAINWINDOW (QUOTE FLAGS)))
(EQ FRAME (ELT (WINDOWPROP TS.MAINWINDOW (QUOTE STACKFRAMES))
(WINDOWPROP TS.MAINWINDOW (QUOTE CURRENTDISPFRAME]
then (PROG [DISPINFO (WINDOW (WINDOWPROP TS.MAINWINDOW (QUOTE
STACKFRAMEWINDOW]
[SETQ DISPINFO (for I in (CADR (WINDOWPROP WINDOW
(QUOTE
DISPLIST)))
thereis (EQ PROP (fetch (TS.ITEMDISP
PROPNAME)
of I]
(if (AND DISPINFO (GREATERP PROP -1))
then (TS.DISPITEM WINDOW DISPINFO VAL))
(if (EQ PROP -2)
then [PROG [(LASTSP (WINDOWPROP WINDOW (QUOTE LASTSP]
(if LASTSP
then (TS.REGIONSET WINDOW
(TS.FINDPOS WINDOW
LASTSP]
[SETQ DISPINFO (for I
in (CADR (WINDOWPROP
WINDOW
(QUOTE DISPLIST)))
thereis (EQ 0 (fetch
(TS.ITEMDISP
PROPNAME)
of I]
(if DISPINFO
then (TS.REGIONSET WINDOW (TS.FINDPOS WINDOW VAL)
))
(WINDOWPROP WINDOW (QUOTE LASTSP)
VAL))
(RETURN NIL)))
VAL])
(TS.GETFUNHDRPROP
[LAMBDA (FRAME PROP) (* edited: "13-Mar-86 10:07")
(if (EQ PROP (QUOTE ?))
then NIL
else (if (NUMBERP PROP)
then (TF.GETREGABS FRAME PROP)
else
(* * fetch (TFRAME (EVAL PROP)) OF FRAME)
(EVAL (BQUOTE (FETCH (TFUNHDR , PROP) OF FRAME])
(TS.DISPITEM
[LAMBDA (WINDOW ITEM VAL) (* edited: "15-Sep-86 16:22")
(PROG [TYPE SUBTYPE PTRVAL DATAVAL X WORKREGION XLEN STARTX CHARW (STR NIL)
(STR1 NIL)
(DISPLIST (WINDOWPROP WINDOW (QUOTE DISPLIST]
(if (NOT ITEM)
then (RETURN NIL))
(with TS.DISPINFO (CAR DISPLIST)
(SETQ CHARW CHARWIDTH)
(with TS.ITEMDISP ITEM (SETQ STARTX
(if (EQ DISPAS (QUOTE HEX32))
then (IPLUS XOFFSET (QUOTIENT (DIFFERENCE
(fetch (TS.DISPINFO XWIDTH)
of (CAR DISPLIST))
(STRINGWIDTH "00000000"
DEFAULTFONT))
2))
else (IPLUS SHOWX 3)))
(SETQ WORKREGION (fetch (ACTIVEREGION REGION) of AREGION))
(BITBLT NIL NIL NIL WINDOW (fetch (REGION LEFT) of WORKREGION)
(fetch (REGION BOTTOM) of WORKREGION)
(fetch (REGION WIDTH) of WORKREGION)
(fetch (REGION HEIGHT) of WORKREGION)
(QUOTE TEXTURE)
(QUOTE (ERASE))
WHITESHADE WORKREGION)
(MOVETO (IPLUS STARTX (if (FMEMB DISPAS (QUOTE (INT3 INT5)))
then (IQUOTIENT CHARW 2)
else 0))
SHOWY WINDOW)
[SETQ X (if VAL
then VAL
else (if (EQ (CAAR DISPLIST)
(QUOTE STACKFRAME))
then (TS.GETFRAMEPROP (WINDOWPROP
WINDOW
(QUOTE DATAPTR))
PROPNAME)
else (TS.GETFUNHDRPROP (WINDOWPROP
WINDOW
(QUOTE DATAPTR))
PROPNAME]
(if [AND (EQ (CAAR DISPLIST)
(QUOTE STACKFRAME))
(GREATERP POSITION (if TamEmulator
then 50Q
else (TS.GETFRAMEPROP
(WINDOWPROP WINDOW
(QUOTE
DATAPTR))
(QUOTE SP]
then (RETURN X))
(COND
((OR X (EQ DISPAS (QUOTE BIT)))
(SELECTQ
DISPAS
(HEX32 (PRINTNUM (QUOTE (FIX 10Q 20Q T))
X WINDOW)
(SETQ XLEN 10Q))
(HEX16 (PRINTNUM (QUOTE (FIX 4 20Q T))
X WINDOW)
(SETQ XLEN 2))
(HEX8 (PRINTNUM (QUOTE (FIX 2 20Q T))
X WINDOW)
(SETQ XLEN 2))
(HEX1 (PRINTNUM (QUOTE (FIX 1 20Q T))
X WINDOW)
(SETQ XLEN 1))
(OCT32 (SETQ STARTX (IPLUS XOFFSET
(QUOTIENT (DIFFERENCE
XWIDTH
(STRINGWIDTH
"00000000000Q"
DEFAULTFONT))
2)))
(MOVETO STARTX SHOWY WINDOW)
(PRINTNUM (QUOTE (FIX 13Q 10Q T))
X WINDOW)
(PRIN1 "Q" WINDOW)
(SETQ XLEN 14Q))
(INT3 (PRINTNUM (QUOTE (FIX 3 12Q T))
(LOGAND X 377Q)
WINDOW)
(SETQ XLEN 3))
(INT5 (PRINTNUM (QUOTE (FIX 5 12Q T))
X WINDOW)
(SETQ XLEN 5))
[BITS32 [COND
((STRINGP X)
(SETQ STR X))
(T (SETQ TYPE (TamarinTypeBits X))
(SETQ SUBTYPE (TamarinType X))
(SETQ PTRVAL (fetch (TCELL PTR) of X))
(SETQ DATAVAL (LOGAND X 7777777777Q))
(COND
[(EQ TYPE (TamTagRep (QUOTE Ptr)))
(COND
((EQ SUBTYPE (TamTagRep (QUOTE Object)))
(SETQ STR (CONCAT "Object: " PTRVAL)))
((EQ SUBTYPE (TamTagRep (QUOTE List)))
(SETQ STR (CONCAT "List: " PTRVAL)))
((EQ SUBTYPE (TamTagRep (QUOTE Code)))
(SETQ STR (CONCAT "Code: " PTRVAL)))
((EQ SUBTYPE (TamTagRep (QUOTE Frame)))
(SETQ STR (CONCAT "Frame: " PTRVAL)))
[(EQ SUBTYPE (TamTagRep (QUOTE Atm)))
(COND
((EQP (TamRep (QUOTE NIL))
X)
(SETQ STR "NIL"))
((EQP (TamRep (QUOTE T))
X)
(SETQ STR "T"))
(T (SETQ STR1 "Atom")
(SETQ X PTRVAL]
((EQ SUBTYPE (TamTagRep (QUOTE Stack)))
(SETQ STR1 "Stack")
(SETQ X PTRVAL))
((EQ SUBTYPE (TamTagRep (QUOTE Unbound)))
(SETQ STR "Unbound"))
((EQ SUBTYPE (TamTagRep (QUOTE Number)))
(SETQ STR1 "Number")
(SETQ X PTRVAL))
(T (if (EQP X 0)
then (SETQ STR NIL)
else (SETQ STR1 "Ptr"]
[(EQ TYPE (TamTagRep (QUOTE Int)))
(SETQ STR (CONCAT (TTOD X]
((EQ TYPE (TamTagRep (QUOTE Float)))
(SETQ STR1 "Float")
(SETQ X DATAVAL))
((EQ TYPE (TamTagRep (QUOTE Xtype)))
(SETQ STR1 "Xtype")
(SETQ X DATAVAL]
(COND
(STR (if VARNAME
then (SETQ STR (CONCAT VARNAME STR)))
(SETQ STARTX
(IPLUS XOFFSET (QUOTIENT (DIFFERENCE
XWIDTH
(STRINGWIDTH
STR DEFAULTFONT))
2)))
(MOVETO STARTX SHOWY WINDOW)
(PRIN1 STR WINDOW)
(SETQ XLEN NIL)
(DRAWLINE STARTX (IDIFFERENCE SHOWY 3)
(IPLUS STARTX (STRINGWIDTH STR
DEFAULTFONT))
(IDIFFERENCE SHOWY 3)
2 NIL WINDOW))
(STR1 (SETQ STARTX
(IPLUS XOFFSET
(QUOTIENT (DIFFERENCE
XWIDTH
(STRINGWIDTH
(CONCAT STR1
": 00000000000Q")
DEFAULTFONT))
2)))
(MOVETO STARTX SHOWY WINDOW)
(PRIN1 (CONCAT STR1 ": ")
WINDOW)
(PRINTNUM (QUOTE (FIX 12Q 10Q T))
X WINDOW)
(PRIN1 "Q" WINDOW)
(SETQ XLEN 24Q))
((AND X (NEQ X 0))
(SETQ STARTX (IPLUS XOFFSET
(QUOTIENT
(DIFFERENCE XWIDTH
(STRINGWIDTH
"00000000000Q"
DEFAULTFONT))
2)))
(MOVETO STARTX SHOWY WINDOW)
(PRINTNUM (QUOTE (FIX 12Q 10Q T))
X WINDOW)
(PRIN1 "Q" WINDOW)
(SETQ XLEN 14Q]
(BIT (PRIN3 (if X
then (QUOTE T)
else (QUOTE F))
WINDOW)
(SETQ XLEN 1))
(PROMPTPRINT "ILLEGAL ITEM")))
(T (SETQ XLEN 1)))
(if XLEN
then (DRAWLINE STARTX (IDIFFERENCE SHOWY 3)
(IPLUS STARTX (ITIMES XLEN CHARW))
(IDIFFERENCE SHOWY 3)
2 NIL WINDOW])
(TS.DISPSTACK
[LAMBDA (WINDOW ITEMINFO) (* rtk "27-Feb-86 09:13")
(* LOOP through all items in the stack & update
values)
(if (NULL ITEMINFO)
then (for I in (CADR (WINDOWPROP WINDOW (QUOTE DISPLIST))) do (TS.DISPITEM WINDOW I)
)
(TS.PUTFRAMEPROP (WINDOWPROP WINDOW (QUOTE DATAPTR))
(QUOTE SP)
(TS.GETFRAMEPROP (WINDOWPROP WINDOW (QUOTE DATAPTR))
(QUOTE SP)))
else (TS.DISPITEM WINDOW ITEMINFO])
(TS.DISPFUNHDR
[LAMBDA (WINDOW FN) (* rtk " 1-Apr-86 11:46")
(* LOOP through all items in the stack
(LAMBDA NIL (* edited: "13-Mar-86 08:53") NIL) update
values)
(WINDOWPROP WINDOW (QUOTE TITLE)
(CONCAT "Function Header: " FN))
(PROG ((SHIFT 16)
(BASEPTR (\ADDBASE (WINDOWPROP WINDOW (QUOTE DATAPTR))
(LLSH (fetch (TFUNHDR OVERHEADCELLS) of T)
TS.RADRSHIFT)))
(FNHEAD (WINDOWPROP WINDOW (QUOTE DATAPTR)))
NTSIZE OFFSETW VARTYPE (CNT1 0))
(SETQ NTSIZE (TS.GETFUNHDRPROP FNHEAD (QUOTE NTSIZE)))
(for I in (CADR (WINDOWPROP WINDOW (QUOTE DISPLIST)))
do (if (NUMBERP (fetch (TS.ITEMDISP PROPNAME) of I))
then (if (LESSP CNT1 (LRSH NTSIZE 1))
then (SETQ CNT1 (IPLUS CNT1 1))
(if (LEQ SHIFT 0)
then (SETQ BASEPTR (\ADDBASE BASEPTR 1))
(SETQ SHIFT 16))
(SETQ OFFSETW (LOGAND (LRSH (\GETBASEFIXP BASEPTR NTSIZE)
SHIFT)
65535))
(SETQ VARTYPE (LOGAND OFFSETW 49152))
(TS.DISPITEM WINDOW I
(CONCAT (\INDEXATOMVAL
(LOGAND (LRSH (\GETBASEFIXP BASEPTR
0)
SHIFT)
65535))
" : "
(LOGAND OFFSETW 255)
" : "
(if (EQ VARTYPE IVARCODE)
then "Ivar"
elseif (EQ VARTYPE PVARCODE)
then "Pvar"
else "Fvar")))
(SETQ SHIFT (IDIFFERENCE SHIFT 16)))
else (TS.DISPITEM WINDOW I)))
NIL])
(TS.FINDW
[LAMBDA (HOW LCHARWIDTH) (* rtk " 2-Apr-86 11:35")
(SELECTQ HOW
(HEX32 (ITIMES LCHARWIDTH 20))
(HEX16 (ITIMES LCHARWIDTH 8))
(HEX8 (ITIMES LCHARWIDTH 2))
(OCT32 (ITIMES LCHARWIDTH 11))
(INT3 (ITIMES LCHARWIDTH 3))
(INT5 (ITIMES LCHARWIDTH 5))
(BITS32 (ITIMES LCHARWIDTH 20))
(BIT LCHARWIDTH)
2])
(TS.REGIONSET
[LAMBDA (WINDOW DINFO) (* rtk "25-Feb-86 12:07")
(PROG ((AREGION (fetch (TS.ITEMDISP OFFSETREGION) of DINFO)))
(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)
(QUOTE TEXTURE)
(QUOTE 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 (QUOTE DISPLIST))) thereis (EQUAL (fetch (TS.ITEMDISP
POSITION)
of I)
POS])
(DispVars
[LAMBDA NIL (* rtk "14-May-86 13:02")
(CLEARW VarsWindow)
(for i in VarsList do (if (LISTP i)
else (PRINTOUT VarsWindow i " - ")
(TAB 15 NIL VarsWindow)
(PRINTNUM (QUOTE (FIX 11 8 T))
(EVAL i)
VarsWindow)
(TERPRI VarsWindow])
(TS.INITVARS
[LAMBDA NIL (* edited: "15-Sep-86 15:23")
(PROG (LOCLIST HEADERLIST)
(SETQ STACKFRAMES (ARRAY 5 (QUOTE POINTER)
NIL 0))
(if (OR (NOT (BOUNDP (QUOTE TMEM)))
(NOT (ARRAYP TMEM)))
then (SETQ TMEM (ARRAY TS.MEMMAX (QUOTE (BITS 40Q))
NIL 0)))
(SETQ TS.FRAMEFREELIST NIL)
(SETQ TS.MEMFREEPTR NIL)
(SETQ OPCODES NIL)
(SETQ TS.TRACEWINDOW NIL)
(SETQ RTVAL NIL)
(SETQ OPCODES \TAMOPCODES)
(SETQ UFNARRAY \TAMOPCODEARRAY)
(SETQ CURRENTEXECFRAME 0)
(SETQ TRACESTR "")
(* * Initialize the Stack Display List)
[SETQ LOCLIST (QUOTE ((POS 0 X 16Q KIND INT3 TITLE "SP" TITLEX 16Q DATA 0)
(POS 1 X 0 KIND BITS32 TITLE "PC" DATA 1)
(POS 2 X 0 KIND BITS32 TITLE "NAMETABLE" DATA 2)
(POS 3 X 0 KIND BITS32 TITLE "CODE Base" DATA 3)
(POS 4 X 0 KIND BITS32 TITLE "ALINK" DATA 4)
(POS 5 X 0 KIND BITS32 TITLE "CLINK" DATA 5)
(POS 6 X 0 KIND BITS32 TITLE "VARS / STACK" DATA 6]
[SETQ LOCLIST (APPEND LOCLIST
(for I from 7 to 47Q
collect (BQUOTE (POS , I X 0 KIND BITS32 DATA , I]
(SETQ TS.STACKDLIST (TS.INITDISPLIST LOCLIST (QUOTE STACKFRAME)))
(for I from 0 to 4
do (SETA STACKFRAMES I (ARRAY 50Q (QUOTE POINTER)
0 0))
(for J from 6 to 47Q do (TF.SETREGABS (ELT STACKFRAMES I)
J TS.NILCONST)))
(* * --- INITIALIZE STACK FREE LIST)
[LET ((INDEX 0)
(LASTINDEX 0))
[for I from 0 to 62Q
do (replace (TMEMFRAME NEXT) of (TS.NEWTSTACKP (LLSH INDEX TS.RADRSHIFT)
)
with (TS.NEWTSTACKP (LLSH LASTINDEX TS.RADRSHIFT)))
(SETQ LASTINDEX INDEX)
(SETQ INDEX (IPLUS INDEX (fetch (TMEMFRAME TMEMWORDFRAMESIZE)
of T]
(SETQ TS.FRAMEFREELIST (TS.NEWTSTACKP (LLSH LASTINDEX TS.RADRSHIFT]
(SETQ TS.MEMFREEPTR (IPLUS (fetch (TCELL PTR) of TS.FRAMEFREELIST)
(LLSH (fetch (TMEMFRAME TMEMWORDFRAMESIZE)
of T)
TS.RADRSHIFT)))
(PUTPROP (QUOTE TS.MEMFREEPTR)
(QUOTE T-GVAL)
(TS.NEWTPTR TS.LISTSUBTYP (IPLUS (fetch (TCELL PTR) of
TS.FRAMEFREELIST)
(LLSH (fetch (TMEMFRAME
TMEMWORDFRAMESIZE)
of T)
TS.RADRSHIFT])
(InitEmulatorWindow
[LAMBDA NIL (* edited: "15-Sep-86 16:25")
(SETQ TamEmulator T)
(SETQ DoSimLog T)
(SETQ DoOpcodeTrace T)
(SETQ DoEmulatorVars T)
(SETQ DoEmulatorLog T)
(if (NOT (BOUNDP (QUOTE PlotWin)))
then (SETQ PlotWin NIL))
(TS.INITVARS)
(if (AND (BOUNDP (QUOTE TS.MAINWINDOW))
(FMEMB TS.MAINWINDOW (OPENWINDOWS)))
then (TS.PUTFRAMEPROP (ELT STACKFRAMES 0)
(QUOTE SP)
0))
(if [NOT (AND (BOUNDP (QUOTE TS.MAINWINDOW))
(FMEMB TS.MAINWINDOW (OPENWINDOWS]
then (SETQ TS.MAINWINDOW (TS.MAKEMAINWINDOW))
(TS.DRAWWINDOW (QUOTE STACKFRAMEWINDOW)
0 TS.STACKDLIST])
(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)
(QUOTE (0 1 2 3 4 5 6 7 8 9)))
then (CHARACTER CH)
else (if (FMEMB (CHARACTER CH)
(QUOTE (A B C D E F)))
then (IPLUS 10 (IDIFFERENCE CH (CHARCODE A)))
else (if (FMEMB (CHARACTER CH)
(QUOTE (a b c d e f)))
then (IPLUS 10 (IDIFFERENCE CH (CHARCODE a)))
0]
(RETURN I])
(TS.INITDISPLIST
[LAMBDA (INFODATA WTYPE) (* rtk " 6-May-86 07:37")
(LET* ((WORKDLIST NIL)
(REGIONLIST NIL)
(INFOLIST NIL)
(BORDER2 4)
(DISPREC (create TS.DISPINFO
DTYPE ← WTYPE))
(LCHARHEIGHT (FONTPROP DEFAULTFONT (QUOTE HEIGHT)))
(LCHARWIDTH (IPLUS [CAR (LAST (SORT (for i from 32 to 127
collect (CHARWIDTH i DEFAULTFONT]
3))
(SHIFTBITS (TIMES LCHARWIDTH 2.5))
(LASTP -1)
(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)
(SELECTQ WTYPE
(STACKFRAME (SETQ WWIDTH 20)
(SETQ WHEIGHT 47))
(FUNHDR (SETQ WWIDTH 20)
(SETQ WHEIGHT 4))
(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 in INFODATA
do (SETQ STITLE (LISTGET I (QUOTE TITLE)))
(SETQ STITLEX (LISTGET I (QUOTE TITLEX)))
(SETQ POS (LISTGET I (QUOTE POS)))
[if (AND (STRINGP STITLE)
(NULL STITLEX))
then [PROG (STRLN)
(SETQ STRLN (STRINGWIDTH STITLE DEFAULTFONT))
(SETQ STITLEX (DIFFERENCE (QUOTIENT WXWIDTH 2)
(QUOTIENT STRLN 2]
else (if STITLEX
then (SETQ STITLEX (TIMES LCHARWIDTH STITLEX]
(if (NULL STITLEX)
then (SETQ STITLEX 0))
(if (NULL POS)
then (SETQ POS (IPLUS LASTP 1)))
[if (GREATERP POS LASTP)
then (SETQ LASTP POS)
(SETQ LASTY (IDIFFERENCE LASTY LCHARHEIGHT))
(if STITLE
then (SETQ LASTY (IDIFFERENCE LASTY LCHARHEIGHT]
(SETQ TEMPX (IPLUS (ITIMES LCHARWIDTH (LISTGET I (QUOTE X)))
SHIFTBITS))
[SETQ INFOLIST
(APPEND INFOLIST
(LIST (SETQ TEMPINFO
(create TS.ITEMDISP
POSITION ← POS
SHOWX ← TEMPX
SHOWY ← LASTY
OFFSETREGION ←(CREATEREGION POSX
(IDIFFERENCE LASTY
1)
POSWIDTH
(IDIFFERENCE
LCHARHEIGHT 2))
DISPAS ←(LISTGET I (QUOTE KIND))
TITLE ← STITLE
TITLEX ←(IPLUS STITLEX 2 SHIFTBITS)
PROPNAME ←(LISTGET I (QUOTE DATA]
[SETQ REGIONLIST (APPEND
REGIONLIST
(LIST (SETQ TEMPREGION (create ACTIVEREGION
REGION ←(CREATEREGION
(IPLUS TEMPX 2)
(IDIFFERENCE LASTY 1)
(IDIFFERENCE
(TS.FINDW (LISTGET I (QUOTE
KIND))
LCHARWIDTH)
(SELECTQ (LISTGET I (QUOTE
KIND))
(BIT 2)
(BITS16 1)
(BITS32 0)
(INT3 2)
(INT5 2)
(OCT32 0)
(HEX1 1)
(HEX16 2)
(HEX32 0)
[LAMBDA NIL 0]))
(IDIFFERENCE LCHARHEIGHT 2))
UPFN ←(QUOTE TS.ITEMSELECT)
DATA ←(LIST (LISTGET I (QUOTE KIND))
(LISTGET I (QUOTE DATA]
(replace (TS.ITEMDISP AREGION) of TEMPINFO with TEMPREGION))
(LIST DISPREC INFOLIST REGIONLIST])
(TS.MAKEFRAME
[LAMBDA (FRAME FN) (* rtk " 7-Apr-86 11:25")
(* rtk "31-Dec-00 20:27")
(LET [(CA (GETPROP FN (QUOTE TCODE]
(if CA
then
(* * Set Stack to Unbind)
(for I from (fetch (TFRAME OVERHEADCELLS) of FRAME) to 39
do (TF.SETREGABS FRAME I TS.UNBINDCONST))
(* * FUNCTION ENTRY, SETUP STACK FRAME DATA FROM FUNCTION HEADER)
(for I from 0 to 15 do (\PUTBASEBYTE FRAME I (ELT CA I)))
(* * Init Ivars to NIL)
(* for I from 0 to 7 do (TF.SETREG FRAME I
TS.NILCONST))
T
else (PROMPTPRINT (CONCAT "NO CODE FOR " FN))
(BREAK1 NIL T (No code for Function)
NIL])
(TS.MAKEMAINWINDOW
[LAMBDA NIL (* rtk " 3-Sep-86 14:57")
(PROG ((MENU1 (create MENU
ITEMS ←(QUOTE (Go Stop Step BrkPts Displays Exit))
TITLE ← "Debug Menu"
MENUROWS ← 1
CENTERFLG ← T
WHENSELECTEDFN ←(QUOTE TS.MAINMENUSELECTEDFN)))
(MENU2 (create MENU
ITEMS ←(QUOTE ("Frame 0" "Frame 1" "Frame 2" "Frame 3" "Global Frame")
)
TITLE ← "Stack Frame Display"
MENUROWS ← 1
CENTERFLG ← T
WHENSELECTEDFN ←(QUOTE TS.MAINMENUSELECTEDFN)))
(MENU3 (create MENU
ITEMS ←(QUOTE (Reset Hold Refresh Interrupt Flags))
TITLE ← "External Pins"
MENUROWS ← 1
CENTERFLG ← T
WHENSELECTEDFN ←(QUOTE 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 (QUOTE BOTTOM)
(QUOTE JUSTIFY))
(ATTACHMENU MENU1 WINDOW (QUOTE BOTTOM)
(QUOTE JUSTIFY))
(ATTACHMENU MENU3 WINDOW (QUOTE BOTTOM)
(QUOTE 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 (QUOTE ON)
TS.TRACEWINDOW)
(DSPSCROLL (QUOTE ON)
logWindow)
(DSPSCROLL (QUOTE ON)
VarsWindow)
(WINDOWPROP TS.TRACEWINDOW (QUOTE PAGEFULLFN)
(QUOTE NILL))
(WINDOWPROP logWindow (QUOTE PAGEFULLFN)
(QUOTE NILL))
(WINDOWPROP VarsWindow (QUOTE PAGEFULLFN)
(QUOTE NILL))
(ATTACHWINDOW TS.TRACEWINDOW WINDOW (QUOTE BOTTOM)
(QUOTE LEFT))
(ATTACHWINDOW logWindow WINDOW (QUOTE BOTTOM)
(QUOTE LEFT))
(ATTACHWINDOW VarsWindow WINDOW (QUOTE BOTTOM)
(QUOTE LEFT))
(WINDOWPROP WINDOW (QUOTE TRACEWINDOW)
TS.TRACEWINDOW)
(WINDOWPROP WINDOW (QUOTE logWindow)
logWindow)
(WINDOWPROP WINDOW (QUOTE VarsWindow)
VarsWindow)
(WINDOWPROP WINDOW (QUOTE DEBUGMENU)
MENU1))
(WINDOWPROP WINDOW (QUOTE FLAGS)
(QUOTE (Stopping OpcodeTrace EmulatorLog EmulatorVars StackFrame SimLog)))
(WINDOWPROP WINDOW (QUOTE PAGEFULLFN)
(QUOTE NILL))
(WINDOWPROP WINDOW (QUOTE STACKFRAMES)
STACKFRAMES)
(WINDOWPROP WINDOW (QUOTE CURRENTDISPFRAME)
3)
(WINDOWPROP WINDOW (QUOTE CURRENTEXECFRAME)
0)
(WINDOWPROP WINDOW (QUOTE FRAMEMENUITEMS)
(fetch (MENU ITEMS) of MENU2))
(WINDOWPROP WINDOW (QUOTE FRAMEMENU)
MENU2)
(WINDOWPROP WINDOW (QUOTE MENU3)
MENU3)
(SETQ Flags 0)
(RETURN WINDOW])
(TS.DRAWWINDOW
[LAMBDA (WPROP FNAME DISPLIST) (* edited: "13-Mar-86 09:07")
(PROG [WHEIGHT WWIDTH TOPLINE STACKW TEMPY LXOFF (PCLOC 0)
(LASTPS -1)
(WORKREGION (CREATEREGION 0 0 0 0))
(MAINREGION (WINDOWPROP TS.MAINWINDOW (QUOTE REGION]
[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
(QUOTE 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 (QUOTE STACKFRAMEWINDOW)
)
then (CONCAT "STACK FRAME # "
FNAME)
else (CONCAT "FUNCTION: " FNAME]
(ATTACHWINDOW STACKW TS.MAINWINDOW (QUOTE BOTTOM)
(if (EQ WPROP (QUOTE STACKFRAMEWINDOW))
then (QUOTE RIGHT)
else (QUOTE LEFT)))
(WINDOWPROP TS.MAINWINDOW WPROP STACKW))
(DRAWLINE (TIMES CHARWIDTH 2.5)
0
(TIMES CHARWIDTH 2.5)
WHEIGHT 2 NIL STACKW)
(for I in (CADR DISPLIST)
do (with TS.ITEMDISP I (SETQ TEMPY (IDIFFERENCE SHOWY 3))
(if (NOT (EQ DISPAS (QUOTE HEX32)))
then (DRAWLINE SHOWX (IDIFFERENCE SHOWY 2)
SHOWX
(IPLUS (IDIFFERENCE SHOWY 2)
CHARHEIGHT)
2 NIL STACKW)
(DRAWLINE (IPLUS SHOWX (TS.FINDW DISPAS CHARWIDTH))
(IDIFFERENCE SHOWY 2)
(IPLUS SHOWX (TS.FINDW DISPAS CHARWIDTH))
(IPLUS (IDIFFERENCE SHOWY 2)
CHARHEIGHT)
2 NIL STACKW))
(if (GREATERP POSITION LASTPS)
then (MOVETO (IQUOTIENT CHARWIDTH 2)
SHOWY STACKW)
(PRIN1 POSITION STACKW)
(DRAWLINE 0 TEMPY WWIDTH TEMPY 2 NIL STACKW))
(SETQ LASTPS POSITION)
(if TITLE
then (MOVETO TITLEX (IPLUS SHOWY CHARHEIGHT)
STACKW)
(PRIN1 TITLE STACKW)
(DRAWLINE 0 (IPLUS TEMPY CHARHEIGHT)
WWIDTH
(IPLUS TEMPY CHARHEIGHT)
2 NIL STACKW]
(SETACTIVEREGIONS STACKW (CADDR DISPLIST))
(WINDOWPROP STACKW (QUOTE WTYPE)
WPROP)
(WINDOWPROP STACKW (QUOTE DISPLIST)
DISPLIST)
(RETURN STACKW])
(TS.STACKW
[LAMBDA (FNUMB) (* rtk " 6-May-86 09:57")
(PROG [WHEIGHT WWIDTH TOPLINE STACKW TEMPY LXOFF (PCLOC 0)
(LASTPS -1)
(WORKREGION (CREATEREGION 0 0 0 0))
(MAINREGION (WINDOWPROP TS.MAINWINDOW (QUOTE REGION]
[with TS.DISPINFO (CAR TS.STACKDLIST)
(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 (QUOTE WIDTH)))
(fetch (REGION WIDTH) of DREGION)))
(replace (REGION BOTTOM) of WORKREGION with (fetch (REGION BOTTOM)
of MAINREGION))
(if (WINDOWPROP TS.MAINWINDOW (QUOTE STACKFRAMEWINDOW))
else (SETQ STACKW (CREATEW WORKREGION (CONCAT "STACK FRAME # " FNUMB)))
(ATTACHWINDOW STACKW TS.MAINWINDOW (QUOTE BOTTOM)
(QUOTE RIGHT))
(WINDOWPROP TS.MAINWINDOW (QUOTE STACKFRAMEWINDOW)
STACKW))
(DRAWLINE (TIMES CHARWIDTH 2.5)
0
(TIMES CHARWIDTH 2.5)
WHEIGHT 2 NIL STACKW)
(for I in (CADR TS.STACKDLIST)
do (with TS.ITEMDISP I (SETQ TEMPY (IDIFFERENCE SHOWY 3))
(if (NOT (EQ DISPAS (QUOTE HEX32)))
then (DRAWLINE SHOWX (IDIFFERENCE SHOWY 2)
SHOWX
(IPLUS (IDIFFERENCE SHOWY 2)
CHARHEIGHT)
2 NIL STACKW)
(DRAWLINE (IPLUS SHOWX (TS.FINDW DISPAS
CHARWIDTH))
(IDIFFERENCE SHOWY 2)
(IPLUS SHOWX (TS.FINDW DISPAS
CHARWIDTH))
(IPLUS (IDIFFERENCE SHOWY 2)
CHARHEIGHT)
2 NIL STACKW))
(if (GREATERP POSITION LASTPS)
then (MOVETO (IQUOTIENT CHARWIDTH 2)
SHOWY STACKW)
(PRIN1 POSITION STACKW)
(DRAWLINE 0 TEMPY WWIDTH TEMPY 2 NIL STACKW))
(SETQ LASTPS POSITION)
(if TITLE
then (MOVETO TITLEX (IPLUS SHOWY CHARHEIGHT)
STACKW)
(PRIN1 TITLE STACKW)
(DRAWLINE 0 (IPLUS TEMPY CHARHEIGHT)
WWIDTH
(IPLUS TEMPY CHARHEIGHT)
2 NIL STACKW]
(SETACTIVEREGIONS STACKW (CADDR TS.STACKDLIST))
(WINDOWPROP STACKW (QUOTE WTYPE)
(QUOTE STACKFRAME))
(WINDOWPROP STACKW (QUOTE DISPLIST)
TS.STACKDLIST)
(SETQ STACKWINDOW STACKW)
(RETURN STACKW])
(TS.FUNHDRW
[LAMBDA (WPROP FNAME DISPLIST) (* edited: "13-Mar-86 08:41")
(PROG [WHEIGHT WWIDTH TOPLINE STACKW TEMPY LXOFF (PCLOC 0)
(LASTPS -1)
(WORKREGION (CREATEREGION 0 0 0 0))
(MAINREGION (WINDOWPROP TS.MAINWINDOW (QUOTE REGION]
[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
(QUOTE WIDTH)))
(fetch (REGION WIDTH)
of DREGION)))
(replace (REGION BOTTOM) of WORKREGION with (fetch (REGION BOTTOM)
of MAINREGION))
(if (WINDOWPROP TS.MAINWINDOW WPROP)
else [SETQ STACKW (CREATEW WORKREGION (IF (EQ WPROP (QUOTE STACKFRAMEWINDOW))
THEN (CONCAT "STACK FRAME # " FNAME)
ELSE (CONCAT "FUNCTION: " FNAME]
(ATTACHWINDOW STACKW TS.MAINWINDOW (QUOTE BOTTOM)
(QUOTE RIGHT))
(WINDOWPROP TS.MAINWINDOW WPROP STACKW))
(DRAWLINE (TIMES CHARWIDTH 2.5)
0
(TIMES CHARWIDTH 2.5)
WHEIGHT 2 NIL STACKW)
(for I in (CADR DISPLIST)
do (with TS.ITEMDISP I (SETQ TEMPY (IDIFFERENCE SHOWY 3))
(if (NOT (EQ DISPAS (QUOTE HEX32)))
then (DRAWLINE SHOWX (IDIFFERENCE SHOWY 2)
SHOWX
(IPLUS (IDIFFERENCE SHOWY 2)
CHARHEIGHT)
2 NIL STACKW)
(DRAWLINE (IPLUS SHOWX (TS.FINDW DISPAS CHARWIDTH))
(IDIFFERENCE SHOWY 2)
(IPLUS SHOWX (TS.FINDW DISPAS CHARWIDTH))
(IPLUS (IDIFFERENCE SHOWY 2)
CHARHEIGHT)
2 NIL STACKW))
(if (GREATERP POSITION LASTPS)
then (MOVETO (IQUOTIENT CHARWIDTH 2)
SHOWY STACKW)
(PRIN1 POSITION STACKW)
(DRAWLINE 0 TEMPY WWIDTH TEMPY 2 NIL STACKW))
(SETQ LASTPS POSITION)
(if TITLE
then (MOVETO TITLEX (IPLUS SHOWY CHARHEIGHT)
STACKW)
(PRIN1 TITLE STACKW)
(DRAWLINE 0 (IPLUS TEMPY CHARHEIGHT)
WWIDTH
(IPLUS TEMPY CHARHEIGHT)
2 NIL STACKW]
(SETACTIVEREGIONS STACKW (CADDR DISPLIST))
(WINDOWPROP STACKW (QUOTE WTYPE)
WPROP)
(WINDOWPROP STACKW (QUOTE DISPLIST)
DISPLIST)
(RETURN STACKW])
(TS.ITEMSELECT
[LAMBDA (WINDOW REGION DATA) (* rtk "14-May-86 13:32")
(PROG ((VALUES (WINDOWPROP WINDOW (QUOTE DATAPTR)))
(MENUVAR NIL)
VALUE IW)
[if (EQ (CAR DATA)
(QUOTE BIT))
then (SETQ MENUVAR (QUOTE Invert))
else (if (EQ (CAR DATA)
(QUOTE HEX1))
else (if (FMEMB (CAR DATA)
(QUOTE (INT3 HEX8)))
then [SETQ MENUVAR (create MENU
ITEMS ←(QUOTE
((Change (QUOTE Change)
"Change Hex Value"]
else (if (AND (FMEMB (CAR DATA)
(QUOTE (HEX32)))
(EQ (CADR DATA)
(QUOTE INDEXED)))
then [SETQ MENUVAR
(create MENU
ITEMS ←(QUOTE ((Change (QUOTE
Change)
"Change Hex Value")
(Inspect
(QUOTE Inspect)
"Inspect with Inspector"]
else (SETQ MENUVAR (create
MENU
ITEMS ←(QUOTE (("Stack Frame" "Stack Frame"
"Display Stack Frame")
(Change (QUOTE Change)
"Change Hex Value")
(Inspect (QUOTE Inspect)
"Inspect with Inspector"]
(COND
[MENUVAR (SETQ VALUE (TS.GETFRAMEPROP VALUES (CADR DATA)))
(if (EQ MENUVAR (QUOTE Invert))
then (SETQ VALUE (NOT 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 (QUOTE Invert)))
(TS.PUTFRAMEPROP VALUES (CADR DATA)
VALUE)
(TS.DISPSTACK WINDOW (for I in (CADR (WINDOWPROP WINDOW
(QUOTE
DISPLIST)))
thereis (EQUAL (fetch (TS.ITEMDISP
PROPNAME)
of I)
(CADR DATA]
(T (SETPICKREGION WINDOW])
(TS.MAINMENUSELECTEDFN
[LAMBDA (ITEMSELECTED MENUUSED MOUSEKEY) (* rtk "17-Dec-86 16:52")
(SELECTQ ITEMSELECTED
(Reset (SETQ Reset (LNOT Reset))
(SHADEITEM (QUOTE Reset)
MENUUSED
(if (EQ Reset 1)
then 12
else 0)))
(Hold (SETQ Hold (LNOT Hold))
(SHADEITEM (QUOTE Hold)
MENUUSED
(if (EQ Hold 1)
then 12
else 0)))
(Refresh (SETQ Refresh (LNOT Refresh))
(SHADEITEM (QUOTE Refresh)
MENUUSED
(if (EQ Refresh 1)
then 12
else 0)))
(Interrupt (SETQ Interrupt (LNOT Interrupt))
(SHADEITEM (QUOTE Interrupt)
MENUUSED
(if (EQ Interrupt 1)
then 12
else 0)))
[Flags (if MOUSEKEY
then (PROG (item)
[SETQ item (MENU (create MENU
ITEMS ←(QUOTE (RefreshEnable
DoIBufSwap
DoTransSim
MakeTestVectors]
(SELECTQ [MENU (create MENU
ITEMS ←(QUOTE (On Off]
(On (SET item T))
(Off (SET item NIL))
NIL]
(Go [WINDOWPROP TS.MAINWINDOW (QUOTE FLAGS)
(UNION (QUOTE (StartStep))
(LDIFFERENCE (WINDOWPROP TS.MAINWINDOW (QUOTE FLAGS))
(QUOTE (Stepping CycleStep UcodeStep
OpcodeStep]
(SHADEITEM (QUOTE Go)
MENUUSED 12)
(SHADEITEM (QUOTE Step)
MENUUSED 0)
(SHADEITEM (QUOTE Stop)
MENUUSED 0)
(SETQ JustReset T))
(Stop [WINDOWPROP TS.MAINWINDOW (QUOTE FLAGS)
(UNION (QUOTE (Stopping))
(WINDOWPROP TS.MAINWINDOW (QUOTE FLAGS]
(SHADEITEM (QUOTE Stop)
MENUUSED 12)
(SHADEITEM (QUOTE Go)
MENUUSED 0)
(SHADEITEM (QUOTE Step)
MENUUSED 0))
(Step (SETQ JustReset T)
[WINDOWPROP
TS.MAINWINDOW
(QUOTE FLAGS)
(UNION (QUOTE (StartStep Stepping))
(if (AND TamEmulator
(OR [NOT (INTERSECTION (QUOTE (CycleStep
UcodeStep
OpcodeStep))
(WINDOWPROP TS.MAINWINDOW
(QUOTE
FLAGS]
(EQUAL (QUOTE MIDDLE)
MOUSEKEY)))
then [UNION (LDIFFERENCE (WINDOWPROP TS.MAINWINDOW
(QUOTE FLAGS))
(QUOTE (Stepping CycleStep
UcodeStep
OpcodeStep)))
(PROG [(s (MENU (create
MENU
ITEMS ←(QUOTE
(CycleStep UcodeStep
OpcodeStep))
TITLE ← "Step Type"]
(if s
then (RETURN (LIST s))
else (RETURN (QUOTE (CycleStep]
else (WINDOWPROP TS.MAINWINDOW (QUOTE FLAGS]
(SHADEITEM (QUOTE Step)
MENUUSED 12)
(SHADEITEM (QUOTE Stop)
MENUUSED 0))
(Displays (TS.SETDISPLAYS))
(Exit [WINDOWPROP TS.MAINWINDOW (QUOTE FLAGS)
(UNION (QUOTE (Stopping Exit))
(WINDOWPROP TS.MAINWINDOW (QUOTE FLAGS]
(SHADEITEM (QUOTE Stop)
MENUUSED 12)
(SHADEITEM (QUOTE Go)
MENUUSED 0)
(SHADEITEM (QUOTE Step)
MENUUSED 0))
(BrkPts (TERPRI TS.MAINWINDOW)
(TERPRI TS.MAINWINDOW)
(MOVETO 4 4 TS.MAINWINDOW)
(PROG [OPNAME (BREAKPOINTS (WINDOWPROP TS.MAINWINDOW (QUOTE BREAKPOINTS]
(CLEARW TS.MAINWINDOW)
(SELECTQ [MENU (create MENU
ITEMS ←(QUOTE (Add Display Clear]
(Add (TTYDISPLAYSTREAM TS.MAINWINDOW)
(PRINTOUT TS.MAINWINDOW "Break on Opcode > ")
(SETQ OPNAME (READ))
(if OPNAME
then (SETQ BREAKPOINTS (CONS OPNAME
BREAKPOINTS)))
(TERPRI TS.MAINWINDOW)
(TERPRI 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 (QUOTE 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 ←(QUOTE (OpcodeTrace EmulatorLog EmulatorVars StackFrame
SimLog AllDisplays))
TITLE ← "Display Toggle")))
state)
(if (NOT s)
then (RETURN))
[SETQ state (MENU (create MENU
ITEMS ←(QUOTE (On Off))
TITLE ←(CONCAT "State of " s " Display"]
(if state
then [WINDOWPROP TS.MAINWINDOW (QUOTE FLAGS)
(if (EQ s (QUOTE AllDisplays))
then [if (EQ state (QUOTE Off))
then (LDIFFERENCE (WINDOWPROP TS.MAINWINDOW
(QUOTE
FLAGS))
(QUOTE (OpcodeTrace
EmulatorLog
EmulatorVars
StackFrame
SimLog)))
else (APPEND (COPY (QUOTE (OpcodeTrace
EmulatorLog
EmulatorVars
StackFrame
SimLog)))
(LDIFFERENCE
(WINDOWPROP TS.MAINWINDOW
(QUOTE FLAGS))
(QUOTE (OpcodeTrace
EmulatorLog
EmulatorVars
StackFrame
SimLog]
else (if (EQ state (QUOTE Off))
then (LDIFFERENCE (WINDOWPROP TS.MAINWINDOW
(QUOTE FLAGS))
(LIST s))
else (CONS s (WINDOWPROP TS.MAINWINDOW
(QUOTE FLAGS]
(TS.SETFLAGS])
(TS.FRAMESELECT
[LAMBDA (MENUUSED ITEM NUMBER MOUSEKEY) (* rtk "17-Sep-86 10:41")
(for I in (WINDOWPROP TS.MAINWINDOW (QUOTE FRAMEMENUITEMS)) do (SHADEITEM I MENUUSED
0))
(SHADEITEM ITEM MENUUSED 14Q)
(WINDOWPROP TS.MAINWINDOW (QUOTE CURRENTDISPFRAME)
NUMBER)
(PROG ((SWINDOW (WINDOWPROP TS.MAINWINDOW (QUOTE STACKFRAMEWINDOW)))
(FNWINDOW (WINDOWPROP TS.MAINWINDOW (QUOTE FUNHDRWINDOW)))
(NEWFRAME (ELT (WINDOWPROP TS.MAINWINDOW (QUOTE STACKFRAMES))
NUMBER))
(FNHEADER NIL))
(WINDOWPROP SWINDOW (QUOTE DATAPTR)
NEWFRAME)
(WINDOWPROP (WINDOWPROP TS.MAINWINDOW (QUOTE TRACEWINDOW))
(QUOTE TITLE)
"Opcode Trace Window")
(* if (AND FNWINDOW (NOT (EQUAL (TS.GETFRAMEPROP NEWFRAME (QUOTE CODEBASE)) 0))) then (SETQ FNHEADER
(\ADDBASE NIL (TS.GETFRAMEPROP NEWFRAME (QUOTE CODEBASE)))) (WINDOWPROP FNWINDOW (QUOTE DATAPTR) FNHEADER)
(WINDOWPROP (WINDOWPROP TS.MAINWINDOW (QUOTE TRACEWINDOW)) (QUOTE TITLE) (CONCAT "Trace of Function: "
(\INDEXATOMVAL (TS.GETFUNHDRPROP FNHEADER (QUOTE FRAMENAME))))) (TS.SETVARNAMES SWINDOW NEWFRAME FNHEADER))
(WINDOWPROP SWINDOW (QUOTE TITLE)
(CONCAT "Stack Frame # " NUMBER))
(if (EQUAL MOUSEKEY (QUOTE MIDDLE))
then [for I from 0 to 47Q
do (TS.PUTFRAMEPROP NEWFRAME I (if (EVENP I)
then (ELT EvenRegFile
(PLUS (RSH I 1)
(TIMES
NUMBER 40Q)))
else (ELT OddRegFile
(PLUS (RSH I 1)
(TIMES NUMBER
40Q]
elseif (FMEMB (QUOTE StackFrame)
(WINDOWPROP TS.MAINWINDOW (QUOTE FLAGS)))
then (TS.DISPSTACK SWINDOW])
(TS.SETVARNAMES
[LAMBDA (WINDOW FRAME FNHEAD) (* rtk " 2-Apr-86 12:29")
(* LOOP through all items in the stack
(LAMBDA NIL (* edited: "13-Mar-86 08:53") NIL) update
values)
(for I in (CADR (WINDOWPROP WINDOW (QUOTE DISPLIST))) do (replace (TS.ITEMDISP VARNAME)
of I with NIL))
(PROG ((SHIFT 16)
NTSIZE OFFSETW VARTYPE (CNT1 0))
(SETQ BASEPTR (\ADDBASE FNHEAD (LLSH (fetch (TFUNHDR OVERHEADCELLS) of T)
TS.RADRSHIFT)))
(SETQ NTSIZE (TS.GETFUNHDRPROP FNHEAD (QUOTE NTSIZE)))
(for I in (TS.GETNAMETABLE BASEPTR NTSIZE)
do (replace (TS.ITEMDISP VARNAME) of (for J in (CADR (WINDOWPROP WINDOW
(QUOTE
DISPLIST)))
thereis (EQ (CADDR I)
(fetch (TS.ITEMDISP
POSITION)
of J)))
with (CONCAT (CAR I)
" : "
(if (EQ (CADR I)
IVARCODE)
then "Ivar"
elseif (EQ (CADR I)
PVARCODE)
then "Pvar"
else "Fvar")
" : "])
(TS.GETNAMETABLE
[LAMBDA (BASEPTR TSIZE) (* edited: "17-Mar-86 10:56")
(* * Returns List Of names in the name table as: (Name Type Offset))
(PROG ((SHIFT 16)
(ATOM# 0)
OFFSETW)
(RETURN (while (GREATERP (SETQ ATOM# (LOGAND (LRSH (\GETBASEFIXP BASEPTR 0)
SHIFT)
65535))
0)
collect (if (LESSP SHIFT 0)
then (SETQ BASEPTR (\ADDBASE BASEPTR 1))
(SETQ SHIFT 16))
(SETQ OFFSETW (LRSH (\GETBASEFIXP BASEPTR TSIZE)
SHIFT))
(SETQ SHIFT (IDIFFERENCE SHIFT 16))
(LIST (\INDEXATOMVAL ATOM#)
(LOGAND OFFSETW 49152)
(IPLUS (LOGAND OFFSETW 255)
(fetch (TFRAME OVERHEADCELLS) of T])
(TS.GETFUNHDRPROP
[LAMBDA (FRAME PROP) (* edited: "13-Mar-86 10:07")
(if (EQ PROP (QUOTE ?))
then NIL
else (if (NUMBERP PROP)
then (TF.GETREGABS FRAME PROP)
else
(* * fetch (TFRAME (EVAL PROP)) OF FRAME)
(EVAL (BQUOTE (FETCH (TFUNHDR , PROP) OF FRAME])
(TS.SETFLAGS
[LAMBDA NIL (* rtk "31-Dec-00 22:09")
[SETQ DoSimLog (FMEMB (QUOTE SimLog)
(WINDOWPROP TS.MAINWINDOW (QUOTE FLAGS]
[SETQ DoOpcodeTrace (FMEMB (QUOTE OpcodeTrace)
(WINDOWPROP TS.MAINWINDOW (QUOTE FLAGS]
[SETQ DoEmulatorVars (FMEMB (QUOTE EmulatorVars)
(WINDOWPROP TS.MAINWINDOW (QUOTE FLAGS]
(SETQ DoEmulatorLog (FMEMB (QUOTE EmulatorLog)
(WINDOWPROP TS.MAINWINDOW (QUOTE FLAGS])
(TS.EXECUTE
[LAMBDA (FRAMENUMBER) (* rtk " 2-Apr-86 16:42")
(LET [STACKFRAME CA FN OP OPNUMBER ARGLIST TRACESTR VAL STACKADJ TEMPSP THEUFN THETSFN
THEOPCODENAME NOTPUSHING RESULT (EXITTIME NIL)
(TRACEWINDOW (WINDOWPROP TS.MAINWINDOW (QUOTE TRACEWINDOW)))
(STACKWINDOW (WINDOWPROP TS.MAINWINDOW (QUOTE STACKFRAMEWINDOW]
(TS.SETFNVARS FRAMENUMBER)
(TS.FRAMESELECT (WINDOWPROP TS.MAINWINDOW (QUOTE FRAMEMENU))
(CAR (NTH (WINDOWPROP TS.MAINWINDOW (QUOTE FRAMEMENUITEMS))
(IPLUS FRAMENUMBER 1)))
FRAMENUMBER)
(while (NULL EXITTIME)
do (SETQ OPNUMBER (TS.FETCH T))
(SETQ OP (ELT UFNARRAY OPNUMBER))
(SETQ THETSFN (fetch (TOPCODE TEFN) of OP))
(SETQ TRACESTR (APPEND TRACESTR (LIST (fetch (TOPCODE OPCODENAME) of OP)
" ")))
(SETQ THEUFN (fetch (TOPCODE UFNFN) of OP))
(SETQ NOTPUSHING (fetch (TOPCODE NOPUSH) of OP))
(SETQ THEOPCODENAME (fetch (TOPCODE OPCODENAME) of OP))
(SETQ ARGLIST NIL)
(* * Pull the required opcode bytes and add them to the list)
[if (AND (NUMBERP (fetch (TOPCODE OPNARGS) of OP))
(GREATERP (fetch (TOPCODE OPNARGS) of OP)
0))
then (PROG ((X 0)
(SHIFTCOUNT 0))
(for I from 1 to (fetch (TOPCODE OPNARGS) of OP)
do (SETQ X (LOGOR (LLSH (TS.FETCH)
SHIFTCOUNT)
X))
(SETQ SHIFTCOUNT (IPLUS SHIFTCOUNT 8)))
(SETQ ARGLIST (CONS X NIL]
(* * Check for Break condition)
(if (FMEMB THEOPCODENAME (WINDOWPROP TS.MAINWINDOW (QUOTE BREAKPOINTS)))
then (TS.MAINMENUSELECTEDFN (QUOTE Stop)
(WINDOWPROP TS.MAINWINDOW (QUOTE DEBUGMENU))
(QUOTE LEFT)))
(if [OR (INTERSECTION (QUOTE (Tracing Stepping StkUpdt Stopping))
(WINDOWPROP TS.MAINWINDOW (QUOTE FLAGS]
then (TS.BREAKCONTROL))
(* * FETCH the Required Operands from the Stack frame and place them into a list)
(SETQ STACKADJ (fetch (TOPCODE LEVADJ) of OP))
(if (NUMBERP STACKADJ)
then (SETQ TEMPSP (TS.GETFRAMEPROP STACKFRAME (QUOTE SP)))
(SETQ STACKADJ (IDIFFERENCE STACKADJ (if (fetch (TOPCODE NOPUSH)
of OP)
then 0
else 1)))
(for I from 0 by -1 until (GEQ STACKADJ I)
do (SETQ ARGLIST (CONS (TS.GETFRAMEPROP STACKFRAME
(IPLUS TEMPSP I))
ARGLIST)))
(TS.PUTFRAMEPROP STACKFRAME (QUOTE SP)
(IPLUS TEMPSP STACKADJ))
elseif (EQ STACKADJ (QUOTE CJUMP))
then (SETQ ARGLIST (CONS (TS.POP)
ARGLIST))
elseif (EQ STACKADJ (QUOTE NCJUMP))
then (SETQ ARGLIST (CONS (TS.REFTOS)
ARGLIST))
elseif [OR (EQ STACKADJ (QUOTE JUMP))
(EQ STACKADJ (QUOTE TUNBIND))
(EQUAL STACKADJ (QUOTE (JUMP 1]
then NIL
else (BREAK1 NIL T (Undefined Levadj In TS.EXECUTE)
NIL))
(* * EXECUTE THE UFN OR OPCODE)
(if THETSFN
then (SETQ RESULT (SELECTQ STACKADJ
(NCJUMP (if (NOT (APPLY THETSFN ARGLIST))
then (TS.POP)))
(APPLY THETSFN ARGLIST)))
(if (NOT NOTPUSHING)
then (TS.PUSH RESULT))
elseif THEUFN
then (TS.UFNCALL)
else (BREAK1 NIL T (Undefined Opcode)
NIL))
(BLOCK))
RESULT])
(TS.SETFNVARS
[LAMBDA (FRNUMB) (* rtk "22-May-86 13:52")
(* * Initialize Variables declared in EXECUTE which are used as free variables by called routines.
These variables must be set for each new function entered or returned to.)
(WINDOWPROP TS.MAINWINDOW (QUOTE CURRENTEXECFRAME)
FRNUMB)
(SETQ FRAMENUMBER FRNUMB)
(SETQ STACKFRAME (ELT STACKFRAMES FRAMENUMBER))
[SETQ FN (\INDEXATOMVAL (fetch (TFUNHDR FUNCTIONNAME) of (\ADDBASE NIL
(TS.GETFRAMEPROP
STACKFRAME
(QUOTE CODEBASE]
(SETQ CA (GETPROP FN (QUOTE TCODE])
(TS.BREAKCONTROL
[LAMBDA NIL (* rtk " 3-Sep-86 14:55")
[if (FMEMB (QUOTE Exit)
(WINDOWPROP TS.MAINWINDOW (QUOTE FLAGS)))
then [WINDOWPROP TS.MAINWINDOW (QUOTE FLAGS)
(LDIFFERENCE (UNION (QUOTE (Stopping Stepping))
(WINDOWPROP TS.MAINWINDOW (QUOTE FLAGS)))
(QUOTE (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))
[RESETFORM (RADIX 8)
(CLEARW TS.MAINWINDOW)
(if (AND (INTERSECTION (QUOTE (Stopping Tracing))
(WINDOWPROP TS.MAINWINDOW (QUOTE FLAGS)))
(NOT TamEmulator))
then (TERPRI TS.TRACEWINDOW)
(for I in TRACESTR do (PRIN1 I TS.TRACEWINDOW)))
(if (INTERSECTION (QUOTE (Stopping Stepping))
(WINDOWPROP TS.MAINWINDOW (QUOTE FLAGS)))
then (DOSELECTEDITEM (WINDOWPROP TS.MAINWINDOW (QUOTE DEBUGMENU))
(QUOTE Stop)
(QUOTE LEFT))
(MOVETO 4 4 TS.MAINWINDOW)
(PRINTOUT TS.MAINWINDOW "Break: ")
(for I in TRACESTR do (PRIN1 I TS.MAINWINDOW))
(RADIX 10)
(while [NULL (INTERSECTION (QUOTE (StartStep Exit))
(WINDOWPROP TS.MAINWINDOW
(QUOTE FLAGS]
do (BLOCK 10))
(if (FMEMB (QUOTE Exit)
(WINDOWPROP TS.MAINWINDOW (QUOTE FLAGS)))
then (TS.BREAKCONTROL]
(WINDOWPROP TS.MAINWINDOW (QUOTE FLAGS)
(LDIFFERENCE (WINDOWPROP TS.MAINWINDOW (QUOTE FLAGS))
(QUOTE (StartStep Stopping])
(TS.FETCH
[LAMBDA (OPCODEBYTE) (* rtk " 2-Apr-86 12:10")
(PROG (OP PC)
(SETQ PC (TS.GETFRAMEPROP STACKFRAME (QUOTE PC)))
(SETQ OP (ELT CA PC))
(if OPCODEBYTE
then (SETQ TRACESTR (LIST PC ": ")))
(SETQ TRACESTR (APPEND TRACESTR (LIST OP " ")))
(TS.PUTFRAMEPROP STACKFRAME (QUOTE PC)
(IPLUS PC 1))
(RETURN OP])
(TS.TAMFUNCTIONCALL
[LAMBDA (FUNCTIONNAME NUMBEROFARGS) (* rtk " 2-Apr-86 15:25")
(if (NOT (LITATOM FUNCTIONNAME))
then (SETQ FUNCTIONNAME (\INDEXATOMVAL FUNCTIONNAME)))
(* * --- GET NEXT STACK FRAME IN MACHINE)
(PROG ((CURRENTFRAMENUMB (WINDOWPROP TS.MAINWINDOW (QUOTE CURRENTEXECFRAME)))
NEXTFRAMENUMB NEXTFRAME OLDFRAME OLDSP RETVAL)
(SETQ OLDFRAME (ELT STACKFRAMES CURRENTFRAMENUMB))
(SETQ OLDSP (fetch (TFRAME SP) of OLDFRAME))
(replace (TFRAME SP) of OLDFRAME with OLDSP)
(SETQ NEXTFRAMENUMB (TS.FINDNEXTFRAME CURRENTFRAMENUMB))
(SETQ NEXTFRAME (ELT STACKFRAMES NEXTFRAMENUMB))
(* * --- INITIALIZE THE NEW STACK FRAME AND COPY IN THE FUNCTION HEADER)
(if (TS.MAKEFRAME NEXTFRAME FUNCTIONNAME)
then
(* * --- COPY OVER THE PARAMETERS FROM THE OLD STACK)
[for I from 1 to NUMBEROFARGS do (TF.SETREG NEXTFRAME (IDIFFERENCE
I 1)
(TF.GETREGABS OLDFRAME
(IPLUS OLDSP I]
(* * --- JUMP TO PC + # ARGUMENTS)
(replace (TFRAME PC) of NEXTFRAME with (IPLUS NUMBEROFARGS
(fetch (TFRAME PC)
of NEXTFRAME)))
(replace (TFRAME CLINK) of NEXTFRAME with CURRENTFRAMENUMB)
(if (FMEMB FUNCTIONNAME (WINDOWPROP TS.MAINWINDOW (QUOTE BREAKPOINTS)))
then (TS.MAINMENUSELECTEDFN (QUOTE Stop)
(WINDOWPROP TS.MAINWINDOW (QUOTE DEBUGMENU))
(QUOTE LEFT)))
(TS.SETFNVARS NEXTFRAMENUMB)
(TS.FRAMESELECT (WINDOWPROP TS.MAINWINDOW (QUOTE FRAMEMENU))
(CAR (NTH (WINDOWPROP TS.MAINWINDOW (QUOTE FRAMEMENUITEMS))
(IPLUS FRAMENUMBER 1)))
FRAMENUMBER)
(SETQ NOTPUSHING T)
else (BREAK1 NIL T (No more Free Frames TS.TAMFUNCTIONCALL)
NIL])
(TS.TAMFUNCTIONRETURN
[LAMBDA NIL (* rtk "26-Mar-86 12:11")
(PROG ((THISFRAMENUMBER (WINDOWPROP TS.MAINWINDOW (QUOTE CURRENTEXECFRAME)))
(THISFRAME STACKFRAME)
PREVFRAMENUMBER PREVFRAME RESULT)
(* * --- RETURN THE RESULT TO THE CALLER)
(SETQ RESULT (TS.POP))
(TS.PUTFRAMEPROP STACKFRAME (QUOTE SP)
0)
(* * --- GET STACK FRAME NUMBER TO USE)
(SETQ PREVFRAMENUMBER (fetch (TFRAME CLINK) of THISFRAME))
(if (TS.STACKP PREVFRAMENUMBER)
then (if (EQP (fetch (TCELL PTR) of PREVFRAMENUMBER)
0)
then (SETQ EXITTIME T)
(SETQ NOTPUSHING T)
(RETURN RESULT))
(SETQ PREVFRAME THISFRAME)
(* * --- REPLACE EXITING FRAME WITH FRAME FROM MEMORY)
[for I from 0 to (IDIFFERENCE (fetch (TFRAME TFRAMEWORDSIZE)
of T)
1)
do (TF.SETREGABS PREVFRAME I (TMF.GETREGABS PREVFRAMENUMBER
(IPLUS I (fetch (TMEMFRAME
TMEMFRAMEWORDOFFSET)
of T]
(replace (TMEMFRAME NEXT) of PREVFRAMENUMBER with TS.FRAMEFREELIST)
(SETQ TS.FRAMEFREELIST PREVFRAMENUMBER)
(SETQ PREVFRAMENUMBER THISFRAMENUMBER)
else (SETQ PREVFRAME (ELT STACKFRAMES PREVFRAMENUMBER)))
(* * --- SET CURRENT FRAME INFO & RETURN)
(TS.SETFNVARS PREVFRAMENUMBER)
(TS.FRAMESELECT (WINDOWPROP TS.MAINWINDOW (QUOTE FRAMEMENU))
(CAR (NTH (WINDOWPROP TS.MAINWINDOW (QUOTE FRAMEMENUITEMS))
(IPLUS PREVFRAMENUMBER 1)))
PREVFRAMENUMBER)
(RETURN RESULT])
(TS.FINDNEXTFRAME
[LAMBDA (CURRENTFRAME) (* rtk " 7-Mar-86 12:55")
(* * FIND THE NEXT STACK FRAME TO USE)
(LET ((LASTINDEX CURRENTFRAME)
(NEXTINDEX CURRENTFRAME))
(* * LOOK FOR A FREE MACHINE STACK FRAME)
(repeatuntil (OR (EQ NEXTINDEX CURRENTFRAME)
(EQ (fetch (TFRAME SP) of (ELT STACKFRAMES NEXTINDEX))
0))
do (SETQ NEXTINDEX (LOGAND (IPLUS NEXTINDEX 1)
3)))
(if (EQ NEXTINDEX CURRENTFRAME)
then
(* * LOOK FOR FRAME TO POINT TO MEMORY)
[repeatuntil (TS.STACKP (fetch (TFRAME CLINK) of (ELT STACKFRAMES
NEXTINDEX)))
do (SETQ LASTINDEX NEXTINDEX)
(SETQ NEXTINDEX (fetch (TFRAME CLINK) of (ELT STACKFRAMES NEXTINDEX]
(* * MOVE FRAME OUT TO MEMORY)
(TS.PUNTFRAME NEXTINDEX LASTINDEX))
NEXTINDEX])
(TS.PUNTFRAME
[LAMBDA (FRAMENUMBER LASTFRAMENUMBER) (* edited: "17-Mar-86 11:18")
(* * PUNT FRAME FRAMENUMBER TO MEMORY, LINK LASTFRAMENUMBER TO THE MEMORY)
(for I from 0 to (IDIFFERENCE (fetch (TFRAME TFRAMEWORDSIZE) of T)
1)
do (TMF.SETREGABS TS.FRAMEFREELIST (IPLUS I (fetch (TMEMFRAME TMEMFRAMEWORDOFFSET)
of T))
(TF.GETREGABS (ELT STACKFRAMES FRAMENUMBER)
I)))
(* * FIX THE LINKS)
(TS.PUTFRAMEPROP (ELT STACKFRAMES LASTFRAMENUMBER)
(QUOTE ALINK)
TS.FRAMEFREELIST)
(TS.PUTFRAMEPROP (ELT STACKFRAMES LASTFRAMENUMBER)
(QUOTE CLINK)
TS.FRAMEFREELIST)
(SETQ TS.FRAMEFREELIST (fetch (TMEMFRAME NEXT) of TS.FRAMEFREELIST])
(TS.PUNTPREVIOUSFRAMES
[LAMBDA (FRAMENUMBER) (* rtk " 7-Mar-86 12:56")
(* * PUNT ALL FRAMES PREVIOUS TO FRAMENUMBER FRAME)
(if [NOT (TS.STACKP (fetch (TFRAME CLINK) of (ELT STACKFRAMES FRAMENUMBER]
then (TS.PUNTPREVIOUSFRAMES (fetch (TFRAME CLINK) of (ELT STACKFRAMES FRAMENUMBER)))
(TS.PUNTFRAME (fetch (TFRAME CLINK) of (ELT STACKFRAMES FRAMENUMBER))
FRAMENUMBER])
(TS.UFNCALL
[LAMBDA NIL (* rtk " 2-Apr-86 16:56")
(* FOR I IN ARGLIST DO (TS.PUSH I))
[if (GREATERP (fetch (TOPCODE OPNARGS) of OP)
0)
then (SETQ ARGLIST (for I in ARGLIST collect (if (EQ I (FLAST ARGLIST))
then (TS.NEWTINT I)
else I]
(TS.TAMFUNCTIONCALL THEUFN (LENGTH ARGLIST])
(TS.POP
[LAMBDA NIL (* edited: "11-Mar-86 16:10")
(PROG ((X (TS.REFTOS)))
(TS.PUTFRAMEPROP STACKFRAME (QUOTE SP)
(IDIFFERENCE (TS.GETFRAMEPROP STACKFRAME (QUOTE SP))
1))
(RETURN X])
(TS.PUSH
[LAMBDA (X) (* rtk "20-Feb-86 15:13")
(TS.PUTFRAMEPROP STACKFRAME (QUOTE SP)
(IPLUS (TS.GETFRAMEPROP STACKFRAME (QUOTE SP))
1))
(TS.PUTFRAMEPROP STACKFRAME (TS.GETFRAMEPROP STACKFRAME (QUOTE SP))
X])
(TS.REFTOS
[LAMBDA NIL (* rtk "20-Feb-86 15:31")
(TS.GETFRAMEPROP STACKFRAME (TS.GETFRAMEPROP STACKFRAME (QUOTE SP])
(TS.NEWTINT
[LAMBDA (I) (* rtk " 4-Mar-86 09:28")
(* Adds T-type bits to a D-integer)
(LOGOR (LLSH TS.INTEGERTYP 30)
(LOGAND I 1073741823])
(TS.NEWTSTACKP
[LAMBDA (VALUE) (* rtk "28-Feb-86 18:05")
(* * TURN D-MACHINE INTEGER INTO TAMARIN STACK POINTER)
(LOGOR VALUE TS.STACKBITS])
(TS.NEWTPTR
[LAMBDA (SUBTYPE ADDR) (* edited: "11-Mar-86 16:21")
(if (EQP (LOGAND ADDR 16777215)
ADDR)
then (LOGOR (LLSH SUBTYPE 24)
(LOGAND ADDR 16777215))
else (BREAK1 NIL T (Illegal Address in TS.NEWTPTR)
NIL])
(TS.VARREF
[LAMBDA (POS) (* rtk "25-Feb-86 14:12")
(* * RETURN VALUE OF VARIABLE WITH OFFSET OF POS)
(TS.GETFRAMEPROP STACKFRAME (IPLUS POS (fetch (TFRAME OVERHEADCELLS) of T])
(TS.VARSTORE
[LAMBDA (POS VALUE) (* rtk "25-Feb-86 14:12")
(* * STORE VALUE AT VARIABLE OFFSET POS)
(TS.PUTFRAMEPROP STACKFRAME (IPLUS POS (FETCH (TFRAME OVERHEADCELLS) OF T))
VALUE])
(TS.GETOPCODEOFFSET
[LAMBDA NIL (* rtk "26-Feb-86 16:19")
(IDIFFERENCE OPNUMBER (CAR (fetch (OPCODE OP#) of OP])
(TS.OBJECTP
[LAMBDA (OBJECT) (* rtk " 4-Mar-86 08:11")
(TAMSUBTYPEP OBJECT TS.OBJECTSUBTYP])
(TS.USERLISTP
[LAMBDA (OBJECT) (* rtk " 7-Mar-86 13:36")
(TAMSUBTYPEP OBJECT TS.USERLISTSUBTYP])
(TS.LISTP
[LAMBDA (OBJECT) (* rtk " 4-Mar-86 08:12")
(TAMSUBTYPEP OBJECT TS.LISTSUBTYP])
(TS.CODEP
[LAMBDA (OBJECT) (* rtk " 4-Mar-86 08:12")
(TAMSUBTYPEP OBJECT TS.CODESUBTYP])
(TS.ATOMP
[LAMBDA (OBJECT) (* rtk " 4-Mar-86 08:13")
(TAMSUBTYPEP OBJECT TS.ATOMSUBTYP])
(TS.STACKP
[LAMBDA (OBJECT) (* rtk " 4-Mar-86 08:13")
(TAMSUBTYPEP OBJECT TS.STACKSUBTYP])
(TS.NUMBERP
[LAMBDA (OBJECT) (* rtk " 4-Mar-86 08:13")
(TAMSUBTYPEP OBJECT TS.NUMBERSUBTYP])
(TS.UNBOUNDP
[LAMBDA (OBJECT) (* rtk " 4-Mar-86 08:14")
(TAMSUBTYPEP OBJECT TS.UNBOUNDSUBTYP])
(TS.INDIRECTP
[LAMBDA (OBJECT) (* rtk " 4-Mar-86 08:14")
(TAMSUBTYPEP OBJECT TS.INDIRECTSUBTYP])
(TS.INTEGERP
[LAMBDA (OBJECT) (* rtk " 4-Mar-86 09:14")
(TAMTYPEP OBJECT TS.INTEGERTYP])
(TS.POINTERP
[LAMBDA (X) (* rtk " 6-Mar-86 12:19")
(TAMTYPEP X TS.POINTERTYP])
(TS.FLOATP
[LAMBDA (OBJECT) (* edited: "12-Mar-86 17:20")
(IF (EQ (LRSH OBJECT 31)
1)
THEN T
ELSE NIL])
)
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
(ADDTOVAR NLAMA TS.RUN)
(ADDTOVAR NLAML TS.MAIN)
(ADDTOVAR LAMA )
)
(PUTPROPS TSIMULATE COPYRIGHT ("Xerox Corporation" 1986 1901 1900))
(DECLARE: DONTCOPY
(FILEMAP (NIL (5033 78574 (TS.RUN 5043 . 5297) (TS.MAIN 5299 . 8033) (TS.GETFRAMEPROP 8035 . 9295) (
TS.PUTFRAMEPROP 9297 . 11511) (TS.GETFUNHDRPROP 11513 . 11893) (TS.DISPITEM 11895 . 19111) (
TS.DISPSTACK 19113 . 19722) (TS.DISPFUNHDR 19724 . 21434) (TS.FINDW 21436 . 21843) (TS.REGIONSET 21845
. 22309) (TS.FINDPOS 22311 . 22661) (DispVars 22663 . 23061) (TS.INITVARS 23063 . 25773) (
InitEmulatorWindow 25775 . 26599) (TS.HEXTOINT 26601 . 27232) (TS.INITDISPLIST 27234 . 31544) (
TS.MAKEFRAME 31546 . 32460) (TS.MAKEMAINWINDOW 32462 . 37606) (TS.DRAWWINDOW 37608 . 40617) (TS.STACKW
40619 . 43668) (TS.FUNHDRW 43670 . 46545) (TS.ITEMSELECT 46547 . 49204) (TS.MAINMENUSELECTEDFN 49206
. 54531) (TS.SETDISPLAYS 54533 . 56195) (TS.FRAMESELECT 56197 . 58148) (TS.SETVARNAMES 58150 . 59412)
(TS.GETNAMETABLE 59414 . 60205) (TS.GETFUNHDRPROP 60207 . 60587) (TS.SETFLAGS 60589 . 61164) (
TS.EXECUTE 61166 . 64786) (TS.SETFNVARS 64788 . 65497) (TS.BREAKCONTROL 65499 . 67481) (TS.FETCH 67483
. 67936) (TS.TAMFUNCTIONCALL 67938 . 69910) (TS.TAMFUNCTIONRETURN 69912 . 71665) (TS.FINDNEXTFRAME
71667 . 72631) (TS.PUNTFRAME 72633 . 73449) (TS.PUNTPREVIOUSFRAMES 73451 . 73948) (TS.UFNCALL 73950 .
74437) (TS.POP 74439 . 74728) (TS.PUSH 74730 . 75046) (TS.REFTOS 75048 . 75233) (TS.NEWTINT 75235 .
75504) (TS.NEWTSTACKP 75506 . 75720) (TS.NEWTPTR 75722 . 76027) (TS.VARREF 76029 . 76293) (TS.VARSTORE
76295 . 76569) (TS.GETOPCODEOFFSET 76571 . 76752) (TS.OBJECTP 76754 . 76902) (TS.USERLISTP 76904 .
77056) (TS.LISTP 77058 . 77202) (TS.CODEP 77204 . 77348) (TS.ATOMP 77350 . 77494) (TS.STACKP 77496 .
77642) (TS.NUMBERP 77644 . 77792) (TS.UNBOUNDP 77794 . 77944) (TS.INDIRECTP 77946 . 78098) (
TS.INTEGERP 78100 . 78244) (TS.POINTERP 78246 . 78385) (TS.FLOATP 78387 . 78572)))))
STOP