[OpenSPARC-T2-SAM] / obp / obp / fm / lib / breakpt.fth

\ ========== Copyright Header Begin ==========================================
\ 
\ Hypervisor Software File: breakpt.fth
\ 
\ Copyright (c) 2006 Sun Microsystems, Inc. All Rights Reserved.
\ 
\  - Do no alter or remove copyright notices
\ 
\  - Redistribution and use of this software in source and binary forms, with 
\    or without modification, are permitted provided that the following 
\    conditions are met: 
\ 
\  - Redistribution of source code must retain the above copyright notice, 
\    this list of conditions and the following disclaimer.
\ 
\  - Redistribution in binary form must reproduce the above copyright notice,
\    this list of conditions and the following disclaimer in the
\    documentation and/or other materials provided with the distribution. 
\ 
\    Neither the name of Sun Microsystems, Inc. or the names of contributors 
\ may be used to endorse or promote products derived from this software 
\ without specific prior written permission. 
\ 
\     This software is provided "AS IS," without a warranty of any kind. 
\ ALL EXPRESS OR IMPLIED CONDITIONS, REPRESENTATIONS AND WARRANTIES, 
\ INCLUDING ANY IMPLIED WARRANTY OF MERCHANTABILITY, FITNESS FOR A 
\ PARTICULAR PURPOSE OR NON-INFRINGEMENT, ARE HEREBY EXCLUDED. SUN 
\ MICROSYSTEMS, INC. ("SUN") AND ITS LICENSORS SHALL NOT BE LIABLE FOR 
\ ANY DAMAGES SUFFERED BY LICENSEE AS A RESULT OF USING, MODIFYING OR 
\ DISTRIBUTING THIS SOFTWARE OR ITS DERIVATIVES. IN NO EVENT WILL SUN 
\ OR ITS LICENSORS BE LIABLE FOR ANY LOST REVENUE, PROFIT OR DATA, OR 
\ FOR DIRECT, INDIRECT, SPECIAL, CONSEQUENTIAL, INCIDENTAL OR PUNITIVE 
\ DAMAGES, HOWEVER CAUSED AND REGARDLESS OF THE THEORY OF LIABILITY, 
\ ARISING OUT OF THE USE OF OR INABILITY TO USE THIS SOFTWARE, EVEN IF 
\ SUN HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES.
\ 
\ You acknowledge that this software is not designed, licensed or
\ intended for use in the design, construction, operation or maintenance of
\ any nuclear facility. 
\ 
\ ========== Copyright Header End ============================================
\ breakpt.fth 2.15 01/05/18
\ Copyright 1985-1990 Bradley Forthware
\ Copyright 1990-2001 Sun Microsystems, Inc.  All Rights Reserved

\ Assembly language breakpoints
\
\ Files needed:
\
\ objects.fth 		Defining words for multiple code field words
\ registers.fth		Defines the register save area.
\ 				CPU dependent
\ catchexc.fth		Saves the machine state in the register save area.
\ 				CPU & operating system dependent
\ machdep.fth		Defines CPU-dependent words for placing breakpoints
\ 			and finding the next instruction.
\ 				CPU-dependent
\ breakpt.fth		(This file) Manages the list of breakpoints, handles
\			single-stepping.	Machine-independent

needs array array.fth

only forth also hidden also
forth definitions

decimal

\ Moved to cpustate.fth
\ nuser restartable?  restartable? off

defer restart  ( -- )
defer restart-step  ( -- )

hidden definitions

headerless

20 constant max#breakpoints
max#breakpoints array >breakpoint
max#breakpoints array >breakpoint-action
max#breakpoints array >saved-opcode

2 array >step-breakpoint
2 array >step-saved-opcode
variable #breakpoints
variable #steps
variable pc-at-breakpoint
variable pc-at-step
variable breakpoints-installed

: init-breakpoints  ( -- )
   #steps off
   #breakpoints off
   0 >step-breakpoint off
   1 >step-breakpoint off
   breakpoints-installed off
;

\ Search the breakpoint table to see if adr is breakpointed.
\ If it is, return the index into the table, or -1 if it's not there.
: find-breakpoint  ( adr -- breakpoint#|-1 )
   -1 swap
   #breakpoints @  0
   ?do
      dup  i >breakpoint @  =
      if  nip i swap leave  then
   loop  ( breakpoint# | -1 )
   drop
;
\ Enter a breakpoint at addr.  If adr is already breakpointed,
\ don't enter it twice.
: set-breakpoint  ( adr -- )
   dup find-breakpoint  ( adr breakpoint# )
   0<  if
      dup               ( adr adr )
      #breakpoints @ max#breakpoints >=  abort" Too many breakpoints"
      #breakpoints @  1 #breakpoints +!  ( adr breakpoint# )
      >breakpoint !
   then     ( adr )
   \ Set default action to be .breakpoint
   0 swap find-breakpoint >breakpoint-action !
;
\ Display the breakpoint table.
: show-breakpoints ( -- )
   #breakpoints @  0  ?do
      i >breakpoint @ u.
      i >breakpoint-action @  ?dup  if ." { " >name .id ." }  "  then
   loop
;
\ If the breakpoint is installed in memory, take it out.
: repair-breakpoint  ( breakpoint# -- )
   dup >breakpoint @ at-breakpoint?
   if   dup >saved-opcode @   over >breakpoint @  op!   then
   drop
;

\ Remove the breakpoint at adr from the table, if it's there.
: remove-breakpoint  ( adr -- )
   find-breakpoint  ( breakpoint# )
   dup 0<  ( breakpoint# flag )
   if    drop
   else    ( breakpoint# )
      dup repair-breakpoint
      \ Shuffle the remaining breakpoints down to fill the vacated slot
      #breakpoints @  swap 1+  ( last-breakpoint# breakpoint# )
      ?do
	 i >breakpoint  @  i 1- >breakpoint  !
	 i >breakpoint-action  @  i 1- >breakpoint-action  !
      loop
      -1 #breakpoints +!
   then
;

\ When we restart the program, we have to put breakpoints at all the
\ places in the breakpoint list.  If there is a breakpoint at the
\ current PC, we have to temporarily not put one there, because we
\ want to execute it at least once (presumably we just hit it).
\ So we have to single step by putting breakpoints at the next instruction,
\ then when we hit that instruction, we put the breakpoint at the previous
\ place.  In fact, the "next instruction" may actually be 2 instructions
\ because the current instruction could be a branch.

: install-breakpoints  ( -- )
   breakpoints-installed @  if  exit  then
   breakpoints-installed on
   #breakpoints @  0   ?do
      i >breakpoint @              ( breakpoint-adr )
      dup op@ 			( adr opcode )
      over at-breakpoint? 0= if ( adr opcode )
         i >saved-opcode !   ( breakpoint-adr )
         put-breakpoint
      else
         2drop
      then
   loop
;
: repair-breakpoints  ( -- )
   #breakpoints @  0   ?do  i repair-breakpoint  loop
   breakpoints-installed off
;

\ Single stepping:
\ To single step, we have to breakpoint the instruction just after the
\ current instruction.  If that instruction is a conditional branch, we
\ have to breakpoint both the next instruction and the branch target.
\ The machine-dependent next-instruction routine finds the next instruction
\ and the branch target.

variable following-jsrs?
: set-step-breakpoints  ( -- )
   following-jsrs? @   next-instruction  ( next-adr branch-target|0 )
   swap              ( step-breakpoint-adr0 step-breakpoint-adr1 )
   2 0  do
      dup i >step-breakpoint !            ( step-breakpoint-adr )
      ?dup   if                           ( step-breakpoint-adr )
         dup op@  i >step-saved-opcode !  ( step-breakpoint-adr )
         put-breakpoint
      then
   loop
;
: repair-step-breakpoints  ( -- )
   2 0  do
      i >step-breakpoint @  ?dup  if  ( step-breakpoint-adr )
         at-breakpoint?
         if   i >step-saved-opcode @  i >step-breakpoint @  op!  then
         0 i >step-breakpoint !
      then
   loop
;
: remove-all-breakpoints  ( -- )
   repair-breakpoints  repair-step-breakpoints  #breakpoints off
;
: uninstall-breakpoints  ( -- )
   breakpoints-installed @ if
      remove-all-breakpoints
   then
;

: current-address-breakpointed?  ( -- flag )
   rpc  find-breakpoint 0>=
;
: current-address-stepped?  ( -- flag )
   rpc  0 >step-breakpoint @  =
   rpc  1 >step-breakpoint @  =  or
;

: ?restart-ok  ( -- )  restartable? @  0=  abort" No program is active."  ;

: (step  ( -- )  set-step-breakpoints  ?restart-ok  restart-step  ;
headers

forth definitions
chain: go-chain
   \ Put stuff to do before returning to a client in this chain.
;
defer go-hook ' go-chain is go-hook
\ : breakpoint-go  ( -- )  install-breakpoints  restart  ;
: steps  ( n -- )  #steps !  following-jsrs? on  (step  ;
: step  ( -- )  1 steps  ;
: hops  ( n -- )  #steps !  following-jsrs? off  (step  ;
: hop  ( -- )  1 hops  ;
: go  ( -- )
   go-hook  ?restart-ok  #steps off
   current-address-breakpointed?
   if  following-jsrs? on  (step  else  install-breakpoints  restart  then
;

: +bp  ( adr -- )
   uninstall-breakpoints
   dup
   bp-address-valid?  if
      set-breakpoint
   else
      ." Invalid breakpoint address " .x  cr
   then
;

: +bpx  ( adr -- )  \ name
   '  over +bp             ( adr acf )
   swap find-breakpoint    ( acf bp# | -1 )
   dup 0<  if              ( acf -1 )
      2drop                (  )
   else                    ( acf bp# )
      >breakpoint-action ! (  )
   then
;

: till  ( adr -- )  +bp  go  ;
: return  ( -- )  return-adr  till  ;  \ Finish and return from subroutine
: returnl  ( -- )  leaf-return-adr  till  ;  \ Finish and ret. from leaf subr.
: finish-loop  ( -- )  loop-exit-adr  till  ;  \ Finish the enclosing loop

headerless
alias continue go
variable #gos

headers
: gos  ( n -- )  1- #gos !  go  ;

: .pc  ( -- )  rpc  u.  ;
defer .step
defer .breakpoint

headerless
hidden definitions
' .instruction is .step
' .instruction is .breakpoint
: breakpoint-message  ( -- )

   \ If the trap type is inconsistent with a breakpoint, then we
   \ just print the exception type and exit.

   breakpoint-trap?  0=  if  .exception quit  then      \ Exit to interpreter

   \ If we are doing multiple single-steps, then we decrement the
   \ step count and continue stepping until the count reaches 0.

   #steps @  if
      restartable? on
      .step
      -1 #steps +!  #steps @  if  (step  then   \ Exit to program
      quit                                      \ Exit to interpreter
   then

   \ If we are at a single-step location, but the step count variable was 0,
   \ then it was a "hidden step".  A "hidden step" happens when "go" is
   \ executed from a location where there is a breakpoint set.  We had to
   \ step once to execute the breakpointed instruction, and then we replace
   \ the location with a breakpoint insruction and go.

   pc-at-step @  if  restartable? on  go  then  \ Exit to program

   \ If we are at a breakpoint location, then we consult the #gos variable
   \ to determine how many more times to go, and either go or "quit" to
   \ the interactive interpreter.

   pc-at-breakpoint @  if
      restartable? on
      rpc find-breakpoint >breakpoint-action @  ?dup  if
	 execute
      else
	 .breakpoint
      then
      #gos @  if  -1 #gos +!  go  then          \ Exit to program
      quit                                      \ Exit to interpreter
   then

   \ If we get here, a "breakpoint trap" occurred at a location where
   \ we don't think there should have been a breakpoint.  This means
   \ that the location happens to contain an instruction that causes the
   \ same kind of trap that is used for breakpoints (whatever that is for
   \ the particular system).  This could happen if a previous breakpoint
   \ didn't get cleaned up properly, or if memory got overwritten with
   \ breakpoint (or equivalent) instructions, or if the program jumped to
   \ an invalid location that happened to contain breakpoint (or equivalent)
   \ instructions.

   .exception quit                              \ Exit to interpreter
;
headers
: (handle-breakpoint  ( -- )
   current-address-stepped?  pc-at-step !
   current-address-breakpointed?  pc-at-breakpoint !
   repair-step-breakpoints
   repair-breakpoints

   breakpoint-message
;
' (handle-breakpoint is handle-breakpoint

forth definitions

: -bp  ( adr -- )
   uninstall-breakpoints
   remove-breakpoint
;
\ Remove most-recently-set breakpoint
: --bp  ( -- )
   #breakpoints @ if
      #breakpoints @ 1-  repair-breakpoint
      -1 #breakpoints +!
   then
;
: bpon  ( -- )
   uninstall-breakpoints
   install-breakpoints
;
: .bp   ( -- )  show-breakpoints  ;
: bpoff  ( -- )  remove-all-breakpoints  ;
: skip  ( -- )  bumppc go  ;

chain: init  ( -- )  init-breakpoints  ;

init-breakpoints

also keys-forth definitions
: ^t  step  ;
only forth also definitions
Commit	Line	Data
920dae64 AT	1	\ ========== Copyright Header Begin ==========================================
	2	\
	3	\ Hypervisor Software File: breakpt.fth
	4	\
	5	\ Copyright (c) 2006 Sun Microsystems, Inc. All Rights Reserved.
	6	\
	7	\ - Do no alter or remove copyright notices
	8	\
	9	\ - Redistribution and use of this software in source and binary forms, with
	10	\ or without modification, are permitted provided that the following
	11	\ conditions are met:
	12	\
	13	\ - Redistribution of source code must retain the above copyright notice,
	14	\ this list of conditions and the following disclaimer.
	15	\
	16	\ - Redistribution in binary form must reproduce the above copyright notice,
	17	\ this list of conditions and the following disclaimer in the
	18	\ documentation and/or other materials provided with the distribution.
	19	\
	20	\ Neither the name of Sun Microsystems, Inc. or the names of contributors
	21	\ may be used to endorse or promote products derived from this software
	22	\ without specific prior written permission.
	23	\
	24	\ This software is provided "AS IS," without a warranty of any kind.
	25	\ ALL EXPRESS OR IMPLIED CONDITIONS, REPRESENTATIONS AND WARRANTIES,
	26	\ INCLUDING ANY IMPLIED WARRANTY OF MERCHANTABILITY, FITNESS FOR A
	27	\ PARTICULAR PURPOSE OR NON-INFRINGEMENT, ARE HEREBY EXCLUDED. SUN
	28	\ MICROSYSTEMS, INC. ("SUN") AND ITS LICENSORS SHALL NOT BE LIABLE FOR
	29	\ ANY DAMAGES SUFFERED BY LICENSEE AS A RESULT OF USING, MODIFYING OR
	30	\ DISTRIBUTING THIS SOFTWARE OR ITS DERIVATIVES. IN NO EVENT WILL SUN
	31	\ OR ITS LICENSORS BE LIABLE FOR ANY LOST REVENUE, PROFIT OR DATA, OR
	32	\ FOR DIRECT, INDIRECT, SPECIAL, CONSEQUENTIAL, INCIDENTAL OR PUNITIVE
	33	\ DAMAGES, HOWEVER CAUSED AND REGARDLESS OF THE THEORY OF LIABILITY,
	34	\ ARISING OUT OF THE USE OF OR INABILITY TO USE THIS SOFTWARE, EVEN IF
	35	\ SUN HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES.
	36	\
	37	\ You acknowledge that this software is not designed, licensed or
	38	\ intended for use in the design, construction, operation or maintenance of
	39	\ any nuclear facility.
	40	\
	41	\ ========== Copyright Header End ============================================
	42	\ breakpt.fth 2.15 01/05/18
	43	\ Copyright 1985-1990 Bradley Forthware
	44	\ Copyright 1990-2001 Sun Microsystems, Inc. All Rights Reserved
	45
	46	\ Assembly language breakpoints
	47	\
	48	\ Files needed:
	49	\
	50	\ objects.fth Defining words for multiple code field words
	51	\ registers.fth Defines the register save area.
	52	\ CPU dependent
	53	\ catchexc.fth Saves the machine state in the register save area.
	54	\ CPU & operating system dependent
	55	\ machdep.fth Defines CPU-dependent words for placing breakpoints
	56	\ and finding the next instruction.
	57	\ CPU-dependent
	58	\ breakpt.fth (This file) Manages the list of breakpoints, handles
	59	\ single-stepping. Machine-independent
	60
	61	needs array array.fth
	62
	63	only forth also hidden also
	64	forth definitions
65
66	decimal
67
68	\ Moved to cpustate.fth
69	\ nuser restartable? restartable? off
70
71	defer restart ( -- )
72	defer restart-step ( -- )
73
74	hidden definitions
75
76	headerless
77
78	20 constant max#breakpoints
79	max#breakpoints array >breakpoint
80	max#breakpoints array >breakpoint-action
81	max#breakpoints array >saved-opcode
82
83	2 array >step-breakpoint
84	2 array >step-saved-opcode
85	variable #breakpoints
86	variable #steps
87	variable pc-at-breakpoint
88	variable pc-at-step
89	variable breakpoints-installed
90
91	: init-breakpoints ( -- )
92	#steps off
93	#breakpoints off
94	0 >step-breakpoint off
95	1 >step-breakpoint off
96	breakpoints-installed off
97	;
98
99	\ Search the breakpoint table to see if adr is breakpointed.
100	\ If it is, return the index into the table, or -1 if it's not there.
101	: find-breakpoint ( adr -- breakpoint#\|-1 )
102	-1 swap
103	#breakpoints @ 0
104	?do
105	dup i >breakpoint @ =
106	if nip i swap leave then
107	loop ( breakpoint# \| -1 )
108	drop
109	;
110	\ Enter a breakpoint at addr. If adr is already breakpointed,
111	\ don't enter it twice.
112	: set-breakpoint ( adr -- )
113	dup find-breakpoint ( adr breakpoint# )
114	0< if
115	dup ( adr adr )
116	#breakpoints @ max#breakpoints >= abort" Too many breakpoints"
117	#breakpoints @ 1 #breakpoints +! ( adr breakpoint# )
118	>breakpoint !
119	then ( adr )
120	\ Set default action to be .breakpoint
121	0 swap find-breakpoint >breakpoint-action !
122	;
123	\ Display the breakpoint table.
124	: show-breakpoints ( -- )
125	#breakpoints @ 0 ?do
126	i >breakpoint @ u.
127	i >breakpoint-action @ ?dup if ." { " >name .id ." } " then
128	loop
129	;
130	\ If the breakpoint is installed in memory, take it out.
131	: repair-breakpoint ( breakpoint# -- )
132	dup >breakpoint @ at-breakpoint?
133	if dup >saved-opcode @ over >breakpoint @ op! then
134	drop
135	;
136
137	\ Remove the breakpoint at adr from the table, if it's there.
138	: remove-breakpoint ( adr -- )
139	find-breakpoint ( breakpoint# )
140	dup 0< ( breakpoint# flag )
141	if drop
142	else ( breakpoint# )
143	dup repair-breakpoint
144	\ Shuffle the remaining breakpoints down to fill the vacated slot
145	#breakpoints @ swap 1+ ( last-breakpoint# breakpoint# )
146	?do
147	i >breakpoint @ i 1- >breakpoint !
148	i >breakpoint-action @ i 1- >breakpoint-action !
149	loop
150	-1 #breakpoints +!
151	then
152	;
153
154	\ When we restart the program, we have to put breakpoints at all the
155	\ places in the breakpoint list. If there is a breakpoint at the
156	\ current PC, we have to temporarily not put one there, because we
157	\ want to execute it at least once (presumably we just hit it).
158	\ So we have to single step by putting breakpoints at the next instruction,
159	\ then when we hit that instruction, we put the breakpoint at the previous
160	\ place. In fact, the "next instruction" may actually be 2 instructions
161	\ because the current instruction could be a branch.
162
163	: install-breakpoints ( -- )
164	breakpoints-installed @ if exit then
165	breakpoints-installed on
166	#breakpoints @ 0 ?do
167	i >breakpoint @ ( breakpoint-adr )
168	dup op@ ( adr opcode )
169	over at-breakpoint? 0= if ( adr opcode )
170	i >saved-opcode ! ( breakpoint-adr )
171	put-breakpoint
172	else
173	2drop
174	then
175	loop
176	;
177	: repair-breakpoints ( -- )
178	#breakpoints @ 0 ?do i repair-breakpoint loop
179	breakpoints-installed off
180	;
181
182	\ Single stepping:
183	\ To single step, we have to breakpoint the instruction just after the
184	\ current instruction. If that instruction is a conditional branch, we
185	\ have to breakpoint both the next instruction and the branch target.
186	\ The machine-dependent next-instruction routine finds the next instruction
187	\ and the branch target.
188
189	variable following-jsrs?
190	: set-step-breakpoints ( -- )
191	following-jsrs? @ next-instruction ( next-adr branch-target\|0 )
192	swap ( step-breakpoint-adr0 step-breakpoint-adr1 )
193	2 0 do
194	dup i >step-breakpoint ! ( step-breakpoint-adr )
195	?dup if ( step-breakpoint-adr )
196	dup op@ i >step-saved-opcode ! ( step-breakpoint-adr )
197	put-breakpoint
198	then
199	loop
200	;
201	: repair-step-breakpoints ( -- )
202	2 0 do
203	i >step-breakpoint @ ?dup if ( step-breakpoint-adr )
204	at-breakpoint?
205	if i >step-saved-opcode @ i >step-breakpoint @ op! then
206	0 i >step-breakpoint !
207	then
208	loop
209	;
210	: remove-all-breakpoints ( -- )
211	repair-breakpoints repair-step-breakpoints #breakpoints off
212	;
213	: uninstall-breakpoints ( -- )
214	breakpoints-installed @ if
215	remove-all-breakpoints
216	then
217	;
218
219	: current-address-breakpointed? ( -- flag )
220	rpc find-breakpoint 0>=
221	;
222	: current-address-stepped? ( -- flag )
223	rpc 0 >step-breakpoint @ =
224	rpc 1 >step-breakpoint @ = or
225	;
226
227	: ?restart-ok ( -- ) restartable? @ 0= abort" No program is active." ;
228
229	: (step ( -- ) set-step-breakpoints ?restart-ok restart-step ;
230	headers
231
232	forth definitions
233	chain: go-chain
234	\ Put stuff to do before returning to a client in this chain.
235	;
236	defer go-hook ' go-chain is go-hook
237	\ : breakpoint-go ( -- ) install-breakpoints restart ;
238	: steps ( n -- ) #steps ! following-jsrs? on (step ;
239	: step ( -- ) 1 steps ;
240	: hops ( n -- ) #steps ! following-jsrs? off (step ;
241	: hop ( -- ) 1 hops ;
242	: go ( -- )
243	go-hook ?restart-ok #steps off
244	current-address-breakpointed?
245	if following-jsrs? on (step else install-breakpoints restart then
246	;
247
248	: +bp ( adr -- )
249	uninstall-breakpoints
250	dup
251	bp-address-valid? if
252	set-breakpoint
253	else
254	." Invalid breakpoint address " .x cr
255	then
256	;
257
258	: +bpx ( adr -- ) \ name
259	' over +bp ( adr acf )
260	swap find-breakpoint ( acf bp# \| -1 )
261	dup 0< if ( acf -1 )
262	2drop ( )
263	else ( acf bp# )
264	>breakpoint-action ! ( )
265	then
266	;
267
268	: till ( adr -- ) +bp go ;
269	: return ( -- ) return-adr till ; \ Finish and return from subroutine
270	: returnl ( -- ) leaf-return-adr till ; \ Finish and ret. from leaf subr.
271	: finish-loop ( -- ) loop-exit-adr till ; \ Finish the enclosing loop
272
273	headerless
274	alias continue go
275	variable #gos
276
277	headers
278	: gos ( n -- ) 1- #gos ! go ;
279
280	: .pc ( -- ) rpc u. ;
281	defer .step
282	defer .breakpoint
283
284	headerless
285	hidden definitions
286	' .instruction is .step
287	' .instruction is .breakpoint
288	: breakpoint-message ( -- )
289
290	\ If the trap type is inconsistent with a breakpoint, then we
291	\ just print the exception type and exit.
292
293	breakpoint-trap? 0= if .exception quit then \ Exit to interpreter
294
295	\ If we are doing multiple single-steps, then we decrement the
296	\ step count and continue stepping until the count reaches 0.
297
298	#steps @ if
299	restartable? on
300	.step
301	-1 #steps +! #steps @ if (step then \ Exit to program
302	quit \ Exit to interpreter
303	then
304
305	\ If we are at a single-step location, but the step count variable was 0,
306	\ then it was a "hidden step". A "hidden step" happens when "go" is
307	\ executed from a location where there is a breakpoint set. We had to
308	\ step once to execute the breakpointed instruction, and then we replace
309	\ the location with a breakpoint insruction and go.
310
311	pc-at-step @ if restartable? on go then \ Exit to program
312
313	\ If we are at a breakpoint location, then we consult the #gos variable
314	\ to determine how many more times to go, and either go or "quit" to
315	\ the interactive interpreter.
316
317	pc-at-breakpoint @ if
318	restartable? on
319	rpc find-breakpoint >breakpoint-action @ ?dup if
320	execute
321	else
322	.breakpoint
323	then
324	#gos @ if -1 #gos +! go then \ Exit to program
325	quit \ Exit to interpreter
326	then
327
328	\ If we get here, a "breakpoint trap" occurred at a location where
329	\ we don't think there should have been a breakpoint. This means
330	\ that the location happens to contain an instruction that causes the
331	\ same kind of trap that is used for breakpoints (whatever that is for
332	\ the particular system). This could happen if a previous breakpoint
333	\ didn't get cleaned up properly, or if memory got overwritten with
334	\ breakpoint (or equivalent) instructions, or if the program jumped to
335	\ an invalid location that happened to contain breakpoint (or equivalent)
336	\ instructions.
337
338	.exception quit \ Exit to interpreter
339	;
340	headers
341	: (handle-breakpoint ( -- )
342	current-address-stepped? pc-at-step !
343	current-address-breakpointed? pc-at-breakpoint !
344	repair-step-breakpoints
345	repair-breakpoints
346
347	breakpoint-message
348	;
349	' (handle-breakpoint is handle-breakpoint
350
351	forth definitions
352
353	: -bp ( adr -- )
354	uninstall-breakpoints
355	remove-breakpoint
356	;
357	\ Remove most-recently-set breakpoint
358	: --bp ( -- )
359	#breakpoints @ if
360	#breakpoints @ 1- repair-breakpoint
361	-1 #breakpoints +!
362	then
363	;
364	: bpon ( -- )
365	uninstall-breakpoints
366	install-breakpoints
367	;
368	: .bp ( -- ) show-breakpoints ;
369	: bpoff ( -- ) remove-all-breakpoints ;
370	: skip ( -- ) bumppc go ;
371
372	chain: init ( -- ) init-breakpoints ;
373
374	init-breakpoints
375
376	also keys-forth definitions
377	: ^t step ;
378	only forth also definitions