
only forth also definitions
needs arm-assembler	extend/arm/assemble.fth
needs entercode		extend/arm/ass_tool.fth

\needs bug		vocabulary bug
only forth also definitions  bug also definitions

create next-instructions also arm-assembler
	' (lit) token,
	pc ip )+ ldr		( normal next )
	' (lit) token,		\ this marks *op as a 'next' literal
	pc up mov
previous


: *inline-next	[ next-instructions 1 cells+ @ ] literal ;
: *jmp-up-next	[ next-instructions 3 cells+ @ ] literal ;

: mask28		( n1 -- n2 )	h# 0fffffff and ;
: not-in-literal?	( addr -- flag)	/token - token@  ['] (lit) <> ;
: change-instruction	( instruction adr -- )
	swap mask28  over @  h# f0000000 and or  swap instruction! ;

: slow-next	( high low -- )
	?do     i @ mask28  *inline-next mask28 =  i not-in-literal?  and
		if *jmp-up-next i change-instruction then
	/cell +loop ;
: fast-next	( high low -- )
	?do     i @ mask28  *jmp-up-next mask28 =  i not-in-literal?  and
		if *inline-next i change-instruction then
	/cell +loop ;
hex
: low-dictionary-adr origin ; \ ['] (lit) /cell - ;

nuser	debug-next	\ points to the debuggers next
nuser	'debug		\ code field for high level trace
nuser	<ip		\ lower limit of ip
nuser	ip>		\ upper limit of ip
nuser	cnt		\ how many times thru debug next

label normal-next    \ debugger installed, fast
	pc 1    ip ia!          ldm end-code

label debnext
		r0      'user <ip	ldr
		ip	r0		cmp
 gt if  	r0      'user ip>	ldr
		r0      ip              cmp
  gt if 	r0      'user cnt	ldr
		r0      1               incr
		r0      'user cnt	str
		r0      2 #             cmp
 eq if  	r0      0 #             mov
		r0      'user cnt	str
		r0      'body normal-next   adr
		r0      'user debug-next str
		pc	'user 'debug	ldr
 then then then
	\ This is slightly different from the normal next
	\ so that it won't be clobbered by slow-next
	pc 1    ip ia!          ldm end-code

: pnext         (s -- ) \ Fix the next routine to use the debug version
	[ also arm-assembler ]
	debnext  up@ put-call [ previous ] ;
: unbug		( -- )	normal-next @  up@ instruction!  ;
unbug
only forth also definitions
