\ This program can help you find relocation problems in your applications.
\ It should be loaded before you load your application.  It will display
\ a warning message if your application does something that might result
\ in a relocation problem.  After you have fixed the relocation problems,
\ you can load your application without first loading this program.

warning @
warning off

only forth also hidden also definitions

: dictionary-adr?	( adr -- flag )
	origin here 2 cells+ between  ;
: .word-name		( adr -- )
	dup  last token@  name>  u>=
	if	drop  last token@ .id	exit then
	dup  origin  u<
	if	drop ." <unknown> "	exit then
	begin	dup probably-cfa? 0=
	while	#align -
	repeat .name ;
: .loc			( adr -- )
	push-hex dup . ." [ " .word-name ." ]" pop-base ;
: ?relocation-problem	( data adr -- data adr )
	over dictionary-adr?  over dictionary-adr?  and
	if	." Possible relocation problem: " cr
		."    Storing "  over .loc  ."  at " dup .loc  cr
		."    "  where
	then ;
: ?-relocation-problem	( adr -- adr )
	dup dictionary-adr? 0=
	if	." Possible relocation problem: " cr
		." Relocatable reference adr used with non-dictionary address" cr
		."  at " dup .loc  cr
		."    "  where
	then ;

forth definitions

: !		( data adr -- )	?relocation-problem !   ;
: unaligned-!	( data adr -- )	?relocation-problem unaligned-!   ;
: ,		( data -- )	here ?relocation-problem  drop ,  ;

assembler definitions

: adr		( reg adr -- )	?-relocation-problem  adr   ;

only forth also definitions
warning !
