(FILECREATED " 8-Feb-84 19:17:22" {PHYLUM}<LISPCORE>SOURCES>WBREAK.;48 29916
changes to: (FNS \WINDOWBREAK1A GETBREAKWINDOW SETBREAKTTY)
previous date: " 4-NOV-83 09:58:40" {PHYLUM}<LISPCORE>SOURCES>WBREAK.;45)
(* Copyright (c) 1982, 1983, 1984 by Xerox Corporation)
(PRETTYCOMPRINT WBREAKCOMS)
(RPAQQ WBREAKCOMS [(FNS WBREAK \WINDOWBREAK1A GETBREAKWINDOW \BREAKTITLEABBREV \NEARBYREGION
SETBREAKTTY RELEASEBREAKWINDOW BREAKWCLOSEOTHERS)
(FNS BACKTRACEITEMWINDOW BREAKWINDOWEVENTFN BKITEMSELECTEDFN BTWCLOSEFN BREAKWCLOSEFN
DISPBAKTRACE DISPBAKTRACE1 REGIONNEXTTO)
[DECLARE: DOCOPY DONTEVAL@LOAD
(INITVARS (BTPRINTLEVEL 3)
(WIZARDFLG)
(BREAKREGIONSPEC (create REGION LEFT ← 17 BOTTOM ← -120 WIDTH ← 400
HEIGHT ← 120))
(TRACEREGION (create REGION LEFT ← 8 BOTTOM ← 3 WIDTH ← 547 HEIGHT ← 310))
[BREAKMENUITEMS (QUOTE ((!EVAL (QUOTE !EVAL)
"Evaluates the break expression without recursive breaks")
(EVAL (QUOTE EVAL)
"Evaluates the break expression")
(EDIT (QUOTE EDIT)
"Calls the editor on the selected frame form")
(revert (QUOTE revert)
"Unwinds the stack to the selected frame")
(↑ (QUOTE ↑)
"Exits to the next higher break via (ERROR!)")
(OK (QUOTE OK)
"Leaves the break, returning the value of the break expression")
(BT (QUOTE BT)
"Back trace of important functions in a menu")
(BT! (QUOTE BT!)
"Back trace of all functions in a menu")
(?= (QUOTE ?=)
"Prints the variables bound in the selected frame"]
(MaxBkMenuWidth 125)
(MaxBkMenuHeight 300)
(AUTOBACKTRACEFLG NIL)
(CLOSEBREAKWINDOWFLG T)
(TRACEWINDOW)
(BACKTRACEFONT)
(BreakMenu))
(* set incase process mechanism isn't loaded.)
(ADDVARS (BREAKRESETFORMS (CURSOR T]
(GLOBALVARS BREAKMENUITEMS BreakMenu BTPRINTLEVEL MaxBkMenuWidth MaxBkMenuHeight TRACEWINDOW
TRACEREGION BREAKREGIONSPEC)
(DECLARE: DOEVAL@COMPILE DONTCOPY (RECORDS BKMENUITEM))
(ADDVARS (WINDOWUSERFORMS (WBREAK T))
(ENDOFWINDOWUSERFORMS (WBREAK NIL)))
(DECLARE: DONTEVAL@LOAD DOCOPY (P (WBREAK T))
(ADDVARS (BREAKMACROS [DBT (DISPBAKTRACE (WINDOWPROP (TTYDISPLAYSTREAM)
(QUOTE BREAKPOS))
NIL
(QUOTE (DUMMYFRAMEP]
(DBT! (DISPBAKTRACE (WINDOWPROP (TTYDISPLAYSTREAM)
(QUOTE BREAKPOS))
NIL NIL)))
(RESETFORMS (TTYDISPLAYSTREAM \TopLevelTtyWindow])
(DEFINEQ
(WBREAK
[LAMBDA (ONFLG) (* rrb "29-JUL-83 11:08")
(* starts and stops the window break package.
Returns the previous setting.)
(COND
[ONFLG (OR (MEMBER (QUOTE (SETBREAKTTY TTYSTREAMS))
BREAKRESETFORMS)
(/SET (QUOTE BREAKRESETFORMS)
(CONS (QUOTE (SETBREAKTTY TTYSTREAMS))
BREAKRESETFORMS)))
(OR (type? FONTDESCRIPTOR BACKTRACEFONT)
(SETQ BACKTRACEFONT (FONTCREATE (QUOTE GACHA)
8)))
(OR (type? MENU BreakMenu)
(SETQ BreakMenu (create MENU
ITEMS ← BREAKMENUITEMS)))
(NOT (CHANGENAME (QUOTE BREAK1)
(QUOTE BREAK1A)
(QUOTE \WINDOWBREAK1A]
(T (AND (MEMBER (QUOTE (SETBREAKTTY TTYSTREAMS))
BREAKRESETFORMS)
(/SET (QUOTE BREAKRESETFORMS)
(REMOVE (QUOTE (SETBREAKTTY TTYSTREAMS))
BREAKRESETFORMS)))
(AND (CHANGENAME (QUOTE BREAK1)
(QUOTE \WINDOWBREAK1A)
(QUOTE BREAK1A))
T])
(\WINDOWBREAK1A
[LAMBDA (NBREAKS) (* rrb " 8-Feb-84 19:17")
(* binds the variables which hold the new and old tty display streams and process handles for the window break
package and sets up the break window.)
(* must be implemented as changename in BREAK1 because
the break package expects variables such as LASTPOS to
be bound at BREAK1A.)
(* must have the argument NBREAKS so that functions called by it are taken to be inside of the break code not the
user code.)
(COND
[(ILESSP NBREAKS 0)
(PROG ((BRKWINDOW (GETBREAKWINDOW BRKFN (IMINUS NBREAKS)))
TTYSTREAMS)
(DECLARE (SPECVARS BRKWINDOW TTYSTREAMS TtyDisplayStream))
[COND
[(WINDOWP BRKWINDOW) (* if there was not array space for a new window, none
was created.)
(SETQ TTYSTREAMS (CONS (TTYDISPLAYSTREAM)
(WINDOWPROP BRKWINDOW (QUOTE DSP]
(T (printout PROMPTWINDOW T "Ran out of array space " "running in process '"
(PROCESSPROP (THIS.PROCESS)
(QUOTE NAME))
"' ")
(COND
((NOT (HASTTYWINDOWP))
(* if this process doesn't have a tty then it is a background process that ran out of array space.
Switch its tty to the PROMPT window because it should not have a process associated with it yet.)
(WINDOWPROP PROMPTWINDOW (QUOTE PAGEFULLFN)
NIL)
(* clobber PAGEFULLFN so that when user does BT it doesn't just scroll off screen. This changes PROMPTWINDOW but
with arrays full they shouldn't be in this sysout long anyway.)
(printout PROMPTWINDOW "which does not have a TTY window."
"Using PROMPTWINDOW as TTY window."
T)
(TTYDISPLAYSTREAM PROMPTWINDOW]
(RETURN (BREAK1A NBREAKS]
(T (* called from break within a break.)
(BREAK1A NBREAKS])
(GETBREAKWINDOW
[LAMBDA (BRKFN NBRKS) (* rrb " 8-Feb-84 18:04")
(* returns the window that this break should use. If this is a trace break, it is the trace window.
If the global break window is available, it should be used, otherwise one is created.)
(COND
[(AND (EQ BRKTYPE NIL)
(EQ (CAR BRKCOMS)
(QUOTE TRACE))) (* tracing.)
(COND
((AND TRACEWINDOW (OPENP TRACEWINDOW))
TRACEWINDOW)
(T (SETQ TRACEWINDOW (CREATEW TRACEREGION " TRACE WINDOW"]
(T (PROG (WINDOW ERRN) (* generate a new window close to the tty window.)
(COND
((EQ (CAR (LISTP ERRORN))
21) (* arrays full, don't try creating a break window.)
(RETURN NIL)))
(SETQ WINDOW (UNINTERRUPTABLY
(CREATEW (COND
((HASTTYWINDOWP)
(\NEARBYREGION (WINDOWPROP (WFROMDS (TTYDISPLAYSTREAM))
(QUOTE REGION))
BREAKREGIONSPEC NBRKS))
(T (* in the case of break in a process that doesn't have a
real tty yet. create one)
DEFAULTTTYREGION))
"BREAK WINDOW")))
(WINDOWPROP WINDOW (QUOTE BRKFN)
BRKFN) (* set title for this break.)
[WINDOWPROP WINDOW (QUOTE TITLE)
(SELECTQ BRKTYPE
[NIL (* user break)
(COND
((AND (EQ BRKFN (QUOTE HELP))
(LISTP ERRORN))
(* user called HELP)
(CONCAT "HELP: " (\BREAKTITLEABBREV (CAR (SETQ ERRN
ERRORN)))
" "
(\BREAKTITLEABBREV (CADR ERRN))
" break:" NBRKS))
(T (CONCAT (\BREAKTITLEABBREV BRKFN)
" break: " NBRKS]
(INTERRUPT (CONCAT "keyboard interrupt - " (\BREAKTITLEABBREV
BRKFN)
" break: " NBRKS))
(COND
((EQ BRKFN (QUOTE HELP))
(* HELP doesn't set the error number because there isn't any error number for help. so this special mechanism of
using ERRORN arg from BREAK1 is necessary)
(* if the brktype is ERRORX this call came from HELP so
use that in title.)
(CONCAT "SHOULDNT " ": " (\BREAKTITLEABBREV (CADR ERRORN))
" break:" NBRKS))
((EQ (CAR (SETQ ERRN (ERRORN)))
17) (* ERROR break)
(CONCAT [\BREAKTITLEABBREV (CAR (SETQ ERRN (CADR ERRN]
": "
(\BREAKTITLEABBREV (CDR ERRN))
" ERROR break:" NBRKS))
(T (CONCAT (\BREAKTITLEABBREV (CADR ERRN))
" - "
(ERRORSTRING (CAR ERRN))
" break: " NBRKS]
(WINDOWPROP WINDOW (QUOTE BUTTONEVENTFN)
(FUNCTION BREAKWINDOWEVENTFN))
(WINDOWPROP WINDOW (QUOTE CLOSEFN)
(FUNCTION BREAKWCLOSEFN))
(WINDOWPROP WINDOW (QUOTE PROCESS)
(THIS.PROCESS))
(RETURN WINDOW])
(\BREAKTITLEABBREV
[LAMBDA (BFN) (* rrb "14-SEP-83 16:42")
(* returns a small thing which can be CONCATed into a title for a break window. This keeps CONCAT from going into
an infinite loop if BRKFN happens to be a circular structure.)
(COND
((NLISTP BFN)
BFN)
(T (CONS (COND
((LISTP (CAR BFN))
(QUOTE &))
(T (CAR BFN)))
(COND
((SETQ BFN (CDR BFN))
(CONS (COND
((LISTP (CAR BFN))
(QUOTE &))
(T (CAR BFN)))
(COND
((SETQ BFN (CDR BFN))
(QUOTE (...])
(\NEARBYREGION
[LAMBDA (REGION REGIONTEMPLATE N) (* rrb " 4-NOV-83 09:58")
(* returns a region that is close to the given region on
the screen.)
(PROG (X WIDTH HEIGHT)
(RETURN (create REGION
LEFT ←(COND
((OR (IGREATERP (IPLUS (SETQ X (IPLUS (fetch LEFT of REGION)
(ITIMES (fetch LEFT of
REGIONTEMPLATE)
N)))
(SETQ WIDTH (fetch WIDTH of REGIONTEMPLATE)))
SCREENWIDTH)
(ILESSP X 0)) (* if it runs into the right or left edge, move it
back.)
(IMOD X (IDIFFERENCE SCREENWIDTH WIDTH)))
(T X))
BOTTOM ←(COND
((OR (IGREATERP (IPLUS (SETQ X (IPLUS (fetch BOTTOM of REGION)
(ITIMES (fetch BOTTOM of
REGIONTEMPLATE)
N)))
(SETQ HEIGHT (fetch HEIGHT of REGIONTEMPLATE)))
SCREENHEIGHT)
(ILESSP X 0)) (* if it runs into the bottom or top edge, move it
back.)
(IMOD X (IDIFFERENCE SCREENHEIGHT HEIGHT)))
(T X))
WIDTH ← WIDTH
HEIGHT ← HEIGHT])
(SETBREAKTTY
[LAMBDA (STREAMPAIR) (* rrb " 8-Feb-84 17:56")
(* switches the TTYDISPLAYSTREAM to the break window on entry and to the previous tty displaystream on exit.
STREAMPAIR is a CONS of the old stream and break stream.)
(COND
(STREAMPAIR (* if STREAMPAIR is NIL, a break window was not created
because the system ran out of space so don't futz with
ttydisplaystream.)
(PROG ((OLDTTY (CAR STREAMPAIR))
(BREAKTTY (CDR STREAMPAIR))
X)
(SELECTQ BREAKSTATE
(ENTERING
(* associate pointer to break frame with the break window This is used so that the backtrace menu commands can set
LASTPOS in the context of the break)
[RELSTK (WINDOWPROP (WFROMDS BREAKTTY)
(QUOTE BREAKPOS)
(STKPOS (QUOTE BREAK1A]
(* Have to be sure to release any old value that might
have been there. BREAK can set ENTERING more than once)
[COND
((AND BRKTYPE AUTOBACKTRACEFLG)
(* do auto backtrace unless this is a user break)
(SETQ BRKCOMS (CONS (SELECTQ AUTOBACKTRACEFLG
(BT! (QUOTE DBT!))
(QUOTE DBT))
BRKCOMS]
(TTYDISPLAYSTREAM BREAKTTY))
[REENTERING (* check for the case of the expression that was
evaluated having changed the ttydisplaystream.)
(COND
([AND (NEQ (SETQ X (TTYDISPLAYSTREAM BREAKTTY))
OLDTTY)
(NOT (AND (EQ OLDTTY \DEFAULTTTYDISPLAYSTREAM)
(NEQ X BREAKTTY]
(* return the TTYDISPLAYSTREAM as returned from the
evaluation if it is different from what it was set to by
the EVALUATING breakstate.)
(RETURN (CONS (TTYDISPLAYSTREAM BREAKTTY)
BREAKTTY]
((LEAVING REVERTING RESTORE)
(RELEASEBREAKWINDOW BREAKTTY OLDTTY)
(TTYDISPLAYSTREAM OLDTTY))
(EVALUATING (* if the old tty is the default, this process doesn't
have any T stream yet; use the break window.)
(OR (EQ OLDTTY \DEFAULTTTYDISPLAYSTREAM)
(TTYDISPLAYSTREAM OLDTTY)))
(SHOULDNT))
(RETURN STREAMPAIR])
(RELEASEBREAKWINDOW
[LAMBDA (BRKDS PREVIOUSDS) (* edited: " 1-AUG-83 19:50")
(* releases a break window)
(PROG ((WINDOW (WFROMDS BRKDS))) (* close backtrace window if there is one.)
(COND
((EQ WINDOW TRACEWINDOW)
(RETURN WINDOW))
((AND (NOT CLOSEBREAKWINDOWFLG)
(OPENWP WINDOW))
(WINDOWPROP WINDOW (QUOTE TITLE)
" BREAK WINDOW") (* remove process link before calling close fn.)
))
(WINDOWPROP WINDOW (QUOTE PROCESS)
NIL)
(BREAKWCLOSEOTHERS WINDOW) (* clobber the previously set fields.)
(WINDOWPROP WINDOW (QUOTE CLOSEFN)
NIL)
(WINDOWPROP WINDOW (QUOTE BUTTONEVENTFN)
NIL)
(COND
(CLOSEBREAKWINDOWFLG (CLOSEW WINDOW)))
(RETURN])
(BREAKWCLOSEOTHERS
[LAMBDA (W) (* edited: " 1-AUG-83 20:08")
(* close function for break windows.
closes the associated backtrace windows if any and
releases the windows BREAKPOS)
(* break links between windows as precaution against
circular structures.)
(AND (WINDOWPROP W (QUOTE BACKTRACE/WINDOW))
(CLOSEW (WINDOWPROP W (QUOTE BACKTRACE/WINDOW)
NIL)))
(AND (WINDOWPROP W (QUOTE BACKTRACEITEMWINDOW))
(CLOSEW (WINDOWPROP W (QUOTE BACKTRACEITEMWINDOW)
NIL)))
(RELSTK (WINDOWPROP W (QUOTE BREAKPOS)
NIL))
(WINDOWPROP W (QUOTE CLOSEFN)
NIL])
)
(DEFINEQ
(BACKTRACEITEMWINDOW
[LAMBDA (TTYWINDOW) (* rrb " 1-SEP-83 14:20")
(* returns a backtrace frame window)
(PROG (TTYREGION BTWINDOW)
[COND
((SETQ BTWINDOW (WINDOWPROP TTYWINDOW (QUOTE BACKTRACEITEMWINDOW)))
(\RELEASEWINDOWSTKDATUM BTWINDOW))
(T (SETQ TTYREGION (WINDOWPROP TTYWINDOW (QUOTE REGION)))
(* create frame window and set its fixed properties.)
(SETQ BTWINDOW (CREATEW (REGIONNEXTTO TTYREGION NIL 150 (QUOTE TOP))
"Back Trace Frame Window"))
(* save backtrace window with window.)
(WINDOWPROP TTYWINDOW (QUOTE BACKTRACEITEMWINDOW)
BTWINDOW)
(WINDOWPROP BTWINDOW (QUOTE CLOSEFN)
(FUNCTION BTITEMWINDOWCLOSEFN]
(RETURN BTWINDOW])
(BREAKWINDOWEVENTFN
[LAMBDA (WINDOW) (* rrb " 9-SEP-83 11:49")
(* handles a button in a break window)
(AND (LASTMOUSESTATE MIDDLE)
(SELECTQ [MENU (COND
((type? MENU BreakMenu)
BreakMenu)
(T (SETQ BreakMenu (create MENU
ITEMS ← BREAKMENUITEMS]
(!EVAL (CLEARBUF T)
(BKSYSBUF "!EVAL
!VALUE
"))
(EVAL (CLEARBUF T)
(BKSYSBUF "EVAL
"))
(EDIT (CLEARBUF T)
(BKSYSBUF "EDIT
"))
(revert (CLEARBUF T)
(BKSYSBUF "REVERT @
"))
(↑ (CLEARBUF T)
(BKSYSBUF "↑
"))
(OK (CLEARBUF T)
(BKSYSBUF "OK
"))
(BT (DISPBAKTRACE (WINDOWPROP WINDOW (QUOTE BREAKPOS))
NIL
(QUOTE (DUMMYFRAMEP))
WINDOW))
(BT! (DISPBAKTRACE (WINDOWPROP WINDOW (QUOTE BREAKPOS))
NIL NIL WINDOW))
(?= (CLEARBUF T)
(BKSYSBUF "?=
"))
NIL])
(BKITEMSELECTEDFN
[LAMBDA (ITEM MENU BUTTON) (* rrb "31-AUG-83 16:28")
(* selection function for back trace window.
It grays the selected frame, sets LASTPOS to it and
prints it in a window.)
(PROG (OLDITEM TTYWINDOW BKPOS POS POSITIONS (FRAMESPECN (fetch (BKMENUITEM BKMENUINFO)
of ITEM)))
(COND
((SETQ OLDITEM (fetch (MENU MENUUSERDATA) of MENU))
(MENUDESELECT OLDITEM MENU)))
(MENUSELECT ITEM MENU)
(SETQ BKPOS (WINDOWPROP (SETQ TTYWINDOW (WINDOWPROP (WFROMMENU MENU)
(QUOTE BTFORWINDOW)))
(QUOTE BREAKPOS))) (* FRAMESPECN is a number offset from BKPOS of the frame
or a dotted pair of two such numbers for a group of
frames.)
(INSPECTW.CREATE [COND
((NUMBERP FRAMESPECN)
(SETQ POS (STKNTH FRAMESPECN BKPOS)))
(T (* multiple frame stack name.)
(SETQ POS (STKNTH (CAR FRAMESPECN)
BKPOS)) (* set title and save first frame pointer for LASTPOS.)
(for I from (CAR FRAMESPECN) to (CDR FRAMESPECN) by -1
collect (* collect the frame pointer)
(STKNTH I BKPOS]
(COND
((EQ BUTTON (QUOTE MIDDLE))
(FUNCTION PROPERTIES.FROM.FRAMESPEC.LOTS))
(T (FUNCTION PROPERTIES.FROM.FRAMESPEC)))
(FUNCTION FETCHSTKARG)
(FUNCTION REPLACESTKARG)
NIL
(FUNCTION STACKFRAMEVALUECOMMANDFN)
NIL
(CONCAT (STKNAME POS)
" Frame")
NIL
(BACKTRACEITEMWINDOW TTYWINDOW)
(FUNCTION STACKFRAMEPROPPRINTFN))
[COND
((NEQ POS (EVALV (QUOTE LASTPOS)
BKPOS)) (* smash the value of LASTPOS in the break window
position to point to selected frame)
(STKNTH 0 POS (EVALV (QUOTE LASTPOS)
BKPOS]
(RETURN])
(BTWCLOSEFN
[LAMBDA (W) (* rrb "14-JUL-83 08:51")
(* close fn for a backtrace menu window.)
(* snap circular pointer to break window.)
(WINDOWPROP W (QUOTE BTFORWINDOW)
NIL])
(BREAKWCLOSEFN
[LAMBDA (W) (* edited: " 1-AUG-83 20:08")
(* close function for break windows.
closes the associated backtrace windows if any and
releases the windows BREAKPOS)
(* break links between windows as precaution against
circular structures.)
(BREAKWCLOSEOTHERS W)
(COND
((PROCESSP (WINDOWPROP W (QUOTE PROCESS)))
(PROCESS.EVAL (WINDOWPROP W (QUOTE PROCESS)
NIL)
(QUOTE (\BREAKSTOP])
(DISPBAKTRACE
[LAMBDA (IPOS EPOS SKIPFNS TTYWINDOW) (* rrb "14-JUL-83 08:31")
(* version of BAKTRACE that builds a display data
structure and sets up a backtrace window.)
(PROG [BTW BKMENU BTWIDTH BTHEIGHT BTWLEFT BTWBOTTOM (TTYWINDOW (OR TTYWINDOW (WFROMDS (
TTYDISPLAYSTREAM]
(COND
((SETQ BTW (WINDOWPROP TTYWINDOW (QUOTE BACKTRACE/WINDOW)))
(* if there is already a window, kill it.
WOULD BE MORE EFFICIENT TO REUSE IT.)
(CLOSEW BTW)
(WINDOWPROP TTYWINDOW (QUOTE BACKTRACE/WINDOW)
NIL)))
[SETQ BKMENU (create MENU
ITEMS ←(DISPBAKTRACE1 IPOS EPOS SKIPFNS)
WHENSELECTEDFN ←(FUNCTION BKITEMSELECTEDFN)
MENUOUTLINESIZE ← 0
MENUFONT ←(COND
((type? FONTDESCRIPTOR BACKTRACEFONT)
BACKTRACEFONT)
((SETQ BACKTRACEFONT (FONTCREATE (QUOTE GACHA)
8]
(* put bt window at left of TTY window unless ttywindow
is near left edge. (REGIONNEXTTO REG WID HGT WH))
[SETQ BTW (CREATEW (REGIONNEXTTO (WINDOWPROP TTYWINDOW (QUOTE REGION))
(WIDTHIFWINDOW (SETQ BTWIDTH (IMIN (fetch (MENU IMAGEWIDTH)
of BKMENU)
MaxBkMenuWidth)))
(HEIGHTIFWINDOW (SETQ BTHEIGHT (IMIN (fetch (MENU
IMAGEHEIGHT)
of BKMENU)
MaxBkMenuHeight)))
(QUOTE LEFT]
(ADDMENU BKMENU BTW (create POSITION
XCOORD ← 0
YCOORD ←(IDIFFERENCE BTHEIGHT (fetch (MENU IMAGEHEIGHT)
of BKMENU)))
(OR (IGREATERP (fetch (MENU IMAGEHEIGHT) of BKMENU)
BTHEIGHT)
(IGREATERP (fetch (MENU IMAGEWIDTH) of BKMENU)
BTWIDTH))) (* link backtrace window to break window so menu will
have access to LASTPOS)
(WINDOWPROP BTW (QUOTE BTFORWINDOW)
TTYWINDOW)
(WINDOWPROP BTW (QUOTE CLOSEFN)
(FUNCTION BTWCLOSEFN))
(WINDOWPROP TTYWINDOW (QUOTE BACKTRACE/WINDOW)
BTW])
(DISPBAKTRACE1
[LAMBDA (IPOS EPOS SKIPFNS) (* bvm: " 9-MAY-82 00:00")
(* version of BAKTRACE that builds a display data
structure.)
(PROG ((POS (STKNTH 0 IPOS))
(N 0)
FN X Y Z DISPBAKTRACELIST)
(AND (NEQ CLEARSTKLST T)
(SETQ CLEARSTKLST (CONS POS CLEARSTKLST)))
(* POS is used as a scratch-position. N is an offset from FROM. whenever baktrace needs to look at a stkname or
stack position, it (re) uses POS and computes (STKNTH N IPOS POS).)
SKIPLP
(COND
((MEMB (STKNAME POS)
(QUOTE (BREAK1A \WINDOWBREAK1A BREAK1)))
(* pop BREAK1A entry off stack. It is needed because it is the binding frame for LASTPOS but it should not appear
in the back trace)
(STKNTH (SETQ N (SUB1 N))
IPOS POS)
(GO SKIPLP)))
(COND
((AND (EQ (STKNAME POS)
(QUOTE \EVALFORM))
(EQ (CAR (LISTP (STKARG 1 POS)))
(QUOTE BREAK1))) (* Interpreter frame for BREAK1 entry)
(STKNTH (SETQ N (SUB1 N))
IPOS POS)))
SKIP2LP
(COND
((MEMB (STKNAME POS)
(QUOTE (\EVALA EVALA))) (* Skip funny EVALA entry to break)
(STKNTH (SETQ N (SUB1 N))
IPOS POS)
(GO SKIP2LP)))
LP (SETQ FN (STKNAME POS))
[COND
([AND (SETQ X (FASSOC FN BAKTRACELST))
(COND
((ATOM (SETQ Z (CADR X)))
(SETQ Y (BAKTRACE1 (CDDR X)
N IPOS POS)))
(T (SOME (CDR X)
(FUNCTION (LAMBDA (X)
(SETQ Z (CAR X))
(SETQ Y (BAKTRACE1 (CDR X)
N IPOS POS]
(* BAKTRACELST allows grouping of many function frames
under a single heading.)
(* HITTOKEN is either the fn offset or a dotted pair of
first and last.)
[COND
(Z (push DISPBAKTRACELIST (create BKMENUITEM
LABEL ← Z
BKMENUINFO ←(CONS N Y]
(SETQ N Y))
[(AND SKIPFNS (SOME SKIPFNS (FUNCTION (LAMBDA (SKIPFN)
(APPLY* SKIPFN POS]
(T (push DISPBAKTRACELIST (create BKMENUITEM
LABEL ←(COND
((LISTP FN)
(* LAMBDA expression is sometimes returned as STKNAME)
(CAR FN))
(T FN))
BKMENUINFO ← N]
(COND
((AND (SETQ POS (STKNTH (SETQ N (SUB1 N))
IPOS POS))
(NOT (EQP POS EPOS)))
(GO LP)))
(RELSTK POS)
(RETURN (DREVERSE DISPBAKTRACELIST])
(REGIONNEXTTO
[LAMBDA (REGION WIDTH HEIGHT WHERE INTERNALFLG) (* rrb "13-JUL-83 18:05")
(* returns the region that is next to REGION and has a width of WIDTH and a height of HEIGHT.
WHERE can be TOP BOTTOM LEFT or RIGHT. If the region would not fit on the screen it is put on the opposite of
WHERE.)
(PROG (NLFT NBTM (RLEFT (fetch (REGION LEFT) of REGION))
(RBOTTOM (fetch (REGION BOTTOM) of REGION))
(RWIDTH (fetch (REGION WIDTH) of REGION))
(RHEIGHT (fetch (REGION HEIGHT) of REGION)))
(OR WIDTH (SETQ WIDTH RWIDTH))
(OR HEIGHT (SETQ HEIGHT RHEIGHT))
[SELECTQ WHERE
(TOP [COND
[(IGREATERP (IPLUS (SETQ NBTM (fetch (REGION TOP) of REGION))
HEIGHT)
SCREENHEIGHT)
(COND
(INTERNALFLG (* top was tried since bottom wouldn't fit)
(SETQ NBTM 0))
(T (* try BOTTOM)
(RETURN (REGIONNEXTTO REGION WIDTH HEIGHT (QUOTE BOTTOM)
T]
(T (SETQ NBTM (ADD1 NBTM]
(SETQ NLFT RLEFT))
(BOTTOM [COND
((ILESSP (SETQ NBTM (IDIFFERENCE RBOTTOM HEIGHT))
0)
(COND
(INTERNALFLG (* doesn't fit either place, put it down from top.)
(SETQ NBTM (IDIFFERENCE SCREENHEIGHT HEIGHT)))
(T (* try BOTTOM)
(RETURN (REGIONNEXTTO REGION WIDTH HEIGHT (QUOTE TOP)
T]
(SETQ NLFT RLEFT))
(LEFT [COND
((ILESSP (SETQ NLFT (IDIFFERENCE RLEFT WIDTH))
0)
(COND
(INTERNALFLG (* doesn't fit either place put at right of screen)
(SETQ NLFT (IDIFFERENCE SCREENWIDTH WIDTH)))
(T (* try BOTTOM)
(RETURN (REGIONNEXTTO REGION WIDTH HEIGHT (QUOTE RIGHT)
T]
(SETQ NBTM (IMAX (IPLUS RBOTTOM (IDIFFERENCE RHEIGHT HEIGHT))
0)))
(PROGN [COND
((IGREATERP (IPLUS (SETQ NLFT (IPLUS RLEFT RWIDTH))
(SUB1 WIDTH))
SCREENWIDTH)
(COND
(INTERNALFLG (* doesn't fit either place put at left of screen)
(SETQ NLFT 0))
(T (* try BOTTOM)
(RETURN (REGIONNEXTTO REGION WIDTH HEIGHT (QUOTE LEFT)
T]
(SETQ NBTM (IMAX (IPLUS RBOTTOM (IDIFFERENCE RHEIGHT HEIGHT))
0]
(RETURN (CREATEREGION NLFT NBTM WIDTH HEIGHT])
)
(DECLARE: DOCOPY DONTEVAL@LOAD
(RPAQ? BTPRINTLEVEL 3)
(RPAQ? WIZARDFLG )
(RPAQ? BREAKREGIONSPEC (create REGION LEFT ← 17 BOTTOM ← -120 WIDTH ← 400 HEIGHT ← 120))
(RPAQ? TRACEREGION (create REGION LEFT ← 8 BOTTOM ← 3 WIDTH ← 547 HEIGHT ← 310))
(RPAQ? BREAKMENUITEMS (QUOTE ((!EVAL (QUOTE !EVAL)
"Evaluates the break expression without recursive breaks")
(EVAL (QUOTE EVAL)
"Evaluates the break expression")
(EDIT (QUOTE EDIT)
"Calls the editor on the selected frame form")
(revert (QUOTE revert)
"Unwinds the stack to the selected frame")
(↑ (QUOTE ↑)
"Exits to the next higher break via (ERROR!)")
(OK (QUOTE OK)
"Leaves the break, returning the value of the break expression")
(BT (QUOTE BT)
"Back trace of important functions in a menu")
(BT! (QUOTE BT!)
"Back trace of all functions in a menu")
(?= (QUOTE ?=)
"Prints the variables bound in the selected frame"))))
(RPAQ? MaxBkMenuWidth 125)
(RPAQ? MaxBkMenuHeight 300)
(RPAQ? AUTOBACKTRACEFLG NIL)
(RPAQ? CLOSEBREAKWINDOWFLG T)
(RPAQ? TRACEWINDOW )
(RPAQ? BACKTRACEFONT )
(RPAQ? BreakMenu )
(* set incase process mechanism isn't loaded.)
(ADDTOVAR BREAKRESETFORMS (CURSOR T))
)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(ADDTOVAR GLOBALVARS BREAKMENUITEMS BreakMenu BTPRINTLEVEL MaxBkMenuWidth MaxBkMenuHeight TRACEWINDOW
TRACEREGION BREAKREGIONSPEC)
)
(DECLARE: DOEVAL@COMPILE DONTCOPY
[DECLARE: EVAL@COMPILE
(RECORD BKMENUITEM (LABEL BKMENUINFO))
]
)
(ADDTOVAR WINDOWUSERFORMS (WBREAK T))
(ADDTOVAR ENDOFWINDOWUSERFORMS (WBREAK NIL))
(DECLARE: DONTEVAL@LOAD DOCOPY
(WBREAK T)
(ADDTOVAR BREAKMACROS [DBT (DISPBAKTRACE (WINDOWPROP (TTYDISPLAYSTREAM)
(QUOTE BREAKPOS))
NIL
(QUOTE (DUMMYFRAMEP]
(DBT! (DISPBAKTRACE (WINDOWPROP (TTYDISPLAYSTREAM)
(QUOTE BREAKPOS))
NIL NIL)))
(ADDTOVAR RESETFORMS (TTYDISPLAYSTREAM \TopLevelTtyWindow))
)
(PUTPROPS WBREAK COPYRIGHT ("Xerox Corporation" 1982 1983 1984))
(DECLARE: DONTCOPY
(FILEMAP (NIL (2596 15123 (WBREAK 2606 . 3676) (\WINDOWBREAK1A 3678 . 5773) (GETBREAKWINDOW 5775 .
8931) (\BREAKTITLEABBREV 8933 . 9542) (\NEARBYREGION 9544 . 10805) (SETBREAKTTY 10807 . 13341) (
RELEASEBREAKWINDOW 13343 . 14302) (BREAKWCLOSEOTHERS 14304 . 15121)) (15124 27751 (BACKTRACEITEMWINDOW
15134 . 16104) (BREAKWINDOWEVENTFN 16106 . 17069) (BKITEMSELECTEDFN 17071 . 19140) (BTWCLOSEFN 19142
. 19509) (BREAKWCLOSEFN 19511 . 20172) (DISPBAKTRACE 20174 . 22469) (DISPBAKTRACE1 22471 . 25225) (
REGIONNEXTTO 25227 . 27749)))))
STOP