All pastes #366401 Raw Edit

DP-HOOK

public text v1 · immutable
#366401 ·published 2007-02-21 17:34 UTC
rendered paste body
\ Ïåðåõâàò âñåõ âèäîâ êîìïèëÿöèè â êîäîôàéë

\ Îïåðåäåëÿåòñÿ áîëâàíêà 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 ;