source file: see.fts
\ 28.06.2009 ~mOleg
\ Copyright [C] 2009-2013 mOleg mOlegg@ya.ru
\ декомпиляция подпрограммного шитого кода

  math/   useful.fts
  util/   ufl.fts
  memory/ dump.fts
  string/ print.fts
  branch/ handlers.fts
  vocs/   deref.fts
  vocs/   unit.fts

ALSO HIDDEN DEFINITIONS

     VECT STARE    \ раннее объявление

Unit: disForth

  20 VALUE lines#  \ количество линий для отображения
     USER Lines    \ сколько линий уже показано

\ после отображения lines# линий ожидать нажатия клавиши
\ в случае нажатия ESC вернуть false, по нажатию любой другой клавиши true
: ?lines ( --> )
         Lines @ IF -1 Lines +!
                  ELSE lines# Lines !
                       KEY 0x1B = IF FALSE ;THEN
                 THEN TRUE ;

\ ловим либо определения, либо данные
: ~box ( addr --> # )
       >L TOKEN L+  L@ @ TOKEN +
       CELL L+

       \ если call то считаем, что <: встретился
       L@ B@ 0xE8 = IF ." <: "
                       L> OVER TOKEN CELL + - STARE ." ;> "
                    ;THEN

       L@ SCNT@ DROP OVER > IF ." (BOX) " L> OVER ELSE L> COUNT THEN
       <| [CHAR] " KEEP KEEPS [CHAR] " KEEP |> PTYPE ;

\ отобразить литеральные данные
: ~LIT ( n --> )
       DUP BODY> *IF SWAP ." ( " H. ." ) " ID>ASC
                     <| [CHAR] ' KEEP Bl_ KEEP KEEPS |> TYPE
                 ;THEN DROP
       DUP N. ."  ( " H. ." )" ;

\ отобразить имя по адресу внутри CFA+PFA определения
: ~name ( addr --> )
        BODY>
        *IF ID>ASC <| KEEPS Bl_ KEEP |> TYPE
          ELSE ." ???" H.
         THEN ;

\ отобразить содержимое
: ~NAME ( addr --> # )
        DUP TOKEN@
         DUP ['] (LIT)    = IF DROP TOKEN + @ ~LIT TOKEN CELL + ;THEN
         DUP ['] (DLIT)   = IF DROP TOKEN + D@ D. TOKEN 2 CELLS + ;THEN
         DUP ['] BRANCH   = IF DROP TOKEN + ." BRANCH " DUP @ + H. TOKEN REF + ;THEN
         DUP ['] ?BRANCH  = IF DROP TOKEN + ." ?BRANCH " DUP @ + H. TOKEN REF + ;THEN
         DUP ['] N?BRANCH = IF DROP TOKEN + ." N?BRANCH " DUP @ + H. TOKEN REF + ;THEN
         DUP ['] -BRANCH  = IF DROP TOKEN + ." -BRANCH " DUP @ + H. TOKEN REF + ;THEN
         DUP ['] *BRANCH  = IF DROP TOKEN + ." *BRANCH " DUP @ + H. TOKEN REF + ;THEN
         DUP ['] COMPILE  = IF DROP TOKEN + ." COMPILE " TOKEN@ ~name TOKEN TOKEN + ;THEN
         DUP ['] (BOX)    = IF DROP ~box ;THEN
        NIP ~name  TOKEN ;

\ по указанному адресу находится токен?
: ?TOKEN ( addr --> flag )
         DUP TOKEN@ IMAGE-BASE HERE BETWEEN
         IF B@ 0xE8 = ;THEN
         DROP FALSE ;

\ декодирование одного токена ШК
: DECODE ( addr --> asc # )
         DUP CR H. ." \t"
         DUP ?TOKEN IF ~NAME ;THEN
         DUP B@ 0xE9 = IF ." JUMP " DUP 1 + @ + ~LIT  TOKEN ;THEN
         DUP B@ 0x90 = IF DROP ." nop"          1 ;THEN
         DUP B@ 0xC3 = IF DROP ." EXIT "        1 ;THEN
         DUP B@ 0x68 = IF ." RLIT " 1 + @ ~LIT  TOKEN ;THEN
         DUP B@ 0x05 = IF ." off_" 1 + @ ~LIT   TOKEN ;THEN
         @ ~LIT                                 CELL ;

\ дизФорт куска кода длиной в # байт с адреса addr
: (STARE) ( addr # --> ) OVER +
          <: BEGIN DDUP < WHILE
                   OVER DECODE *WHILE
                   ROT + SWAP
                   ?lines WHILE
             REPEAT THEN THEN -2 THROW \ тут просто ошибка нужна
           ;> CATCH TDROP ;

\ дизФорт слова, начинающегося с адреса addr
F: (DIS) ( addr --> )
         lines# Lines !
         BODY>
               DUP &PRI GET-ATTR IF THROW THEN
               ABORT" заданное слово является примитивом!"
         DUP LINK>C SWAP to_flag off_eow W@ STARE ;F

' (STARE) IS STARE

EndUnit

ALSO ROOT DEFINITIONS

\ дизФорт слова, которому принадлежит addr
: DIS ( addr --> ) BODY>  disForth (DIS) ;

\ дизФорт слова с именем name
: SEE ( / name --> ) ' disForth (DIS) ;

RECENT RECENT

?ABSENT test{ \EOF -- тестовая секция ------------------------------------------
test{

}test

FORTH(0)>SEE <:

0x005CF317      COMPILE (BOX)
0x005CF321      HERE
0x005CF326      nil
0x005CF32B      ,
0x005CF330      536870946 ( 0x20000022 )
0x005CF339      EXIT  Ok
FORTH(0)> Ok