\ Перехват всех видов компиляции в кодофайл

\ Опеределяется болванка DP-HOOK куда можно записать
\ желаемые действия по проверке идущей компиляции.

\ Хаковатая штука. И то спасибо надо сказать что в SPF
\ DP -- не переменная, а "умное" определение, которое
\ ещё можно подменить "на лету".

REQUIRE /TEST ~profit/lib/testing.f
REQUIRE R@ENTER, ~profit/lib/bac4th.f
REQUIRE REPLACE-WORD lib/ext/patch.f

\ Выдрано из lib/ext/disasm.f
REQUIRE NextNFA lib\ext\vocs.f

: FIND-REST-END ( xt -- addr | 0)
    DUP NextNFA DUP
    IF 
      NIP
      NAME>C 1- \ Skip CFA field
    ELSE
      DROP
      DP @ - ABS 100 > IF 0 EXIT THEN \ no applicable end found
      DP @ 1-
    THEN

    BEGIN \ Skip alignment
      DUP C@ 0= WHILE 1- 
    REPEAT ;


\ Относительные переходы в командах jmp и call ломаются
: DUPLICATE HEADER ' DUP FIND-REST-END OVER - HERE SWAP DUP ALLOT RET, CMOVE ;
\ Берёт из потока два имени. С первым создаёт новое
\ определение. У второго имени находит содержимое
\ его кода и _копирует_ его в новое слово.

DUPLICATE DP1 DP \ копируем содержимое DP в DP1 , так как DP мы сейчас сломаем
\ SEE DP1

' NOOP ->VARIABLE /DP-HOOK \ переменная хранит адрес кода обработчика компиляции
: DP-HOOK /DP-HOOK @ EXECUTE ;
\ перехватчик компиляции, в нём можно делать всякие проверки/оптимизации

\ использовать перекрываемое определение (scattered colon)
\ технически много сложнее, поэтому сделано так. Хотя можно 
\ было бы и векторное определение, но схема 
\ переменная-хранилище/вызывающее-слово удобнее для bac4th'а
\ (см. ~profit/lib/compile2Heap.f)
:NONAME /DP-HOOK @ >R ['] NOOP /DP-HOOK ! [ R@ENTER, ]  R> /DP-HOOK ! DP1 ; ' DP REPLACE-WORD
\ Обратите внимания что во время запуска обработчика перехват
\ снимается. Это сделано для того чтобы можно было безболезненно
\ использовать HERE и прочее в DP-HOOK

/TEST
:NONAME ." ." ; /DP-HOOK !

$> 1 ,
$> : r DUP ;

:NONAME HERE . ; /DP-HOOK !


$> 1 ,
$> : r1 DUP ;