home *** CD-ROM | disk | FTP | other *** search
/ BMUG PD-ROM 1995 Fall / PD-ROM F95.toast / Programming / Programming Languages / Yerk 3.64 ƒ / Module source / Decompile < prev    next >
Encoding:
Text File  |  1993-07-21  |  17.1 KB  |  588 lines  |  [TEXT/ttxt]
  1. \ Yerk Disassembler
  2. \  1/16/86  cdn Initial version
  3. \  1/20/86  cdn Handle named input parameters and local variables
  4. \  2/24/86  cdn Added detection of Immediate words
  5. \                Added RANGEOF
  6. \  6/01/86  cdn Added (++>), (EX>), (TRAP), (DEFER), (JMP), COMPILE
  7. \  6/02/86  cdn Added deClass, deObj, deModule, etc…
  8. \  8/11/86  cdn Added multiple cfa recognition
  9. \  8/25/86  cdn Added method decompilation
  10. \  6/29/87    rfl Added the first three cases to handle floats
  11. \ 12/17/87    rfl Fixed .num to show signs
  12. \  1/11/90    rfl Fixed ?isobj,?isclass,?ismod,?isvect,.32-bit etc. for protection
  13. \                  against invalid RAM
  14. \  3/14/90    rfl    nhash now wordcol; took out ?isobj since now in Class
  15. \ 10/03/90    rfl    added protection for lit numbers out of app range
  16. \ 10/26/90    rfl changed /module to |module so can decompile words with '/' in them
  17. \ 12/16/90    rfl    added offCol instead of old ordered-col
  18. \  3/29/91    rfl fixed slight bug setting 0 -> #p in decol
  19. \ 10/26/91    rfl    undid a reserve back to allot in name/hash
  20. \  2/25/92    rfl    fixed super/self problem with decompiling a class method
  21. \  5/14/93    rfl    now decompiles vect, value, and sysvec contents too.
  22. \  6/17/93    rfl    fixed another super/self problem when de' a method
  23. \  6/22/93    rfl added support for float named input and local vars
  24. \  7/16/93    rfl    after 3.64 release, redefined 'inapprange?' to use heapbot and top
  25. \  7/21/93    rfl    added inapprange? to 32-bit
  26.  
  27. \ de' will decompile colon definitions and methods of classes; follow with a
  28. \ slash-module name to decompile module code.  Named stack parms and local vars
  29. \ are indicated by a curly bracket syntax like the one used to compile them,
  30. \ however their actual names are no longer known after compilation so symbolic
  31. \ names parmN & varN are shown.  Method selectors are also unavailable after
  32. \ compilation since they are hashed, so the common sequence: meth: obj
  33. \ decompiles as: ???: obj.  Methods bound to ivars within class definitions
  34. \ are shown by the offset of the ivar data within the object.  eg: ???: 12
  35. \ Anything completely unrecognized will display as ¿¿¿
  36. \
  37. \ "deflgs" bits:
  38. \ 0 - print absolute address of each item
  39. \ 1 - print relative address of each item
  40. \ 2 - print offset of each item
  41. \ 3 - display super class data
  42. \ 4 - display nested ivar stuctures
  43. \ 5 - display indexed data
  44.  
  45. :module deMod
  46.  
  47. 0 value tab
  48. : indent tab 4* out - 0 max spaces ;
  49.  
  50. : .bld  1 tFace ;    \ print in bold
  51. : .exp 64 tFace ;    \ print in expanded
  52. : .nor  0 tFace ;    \ revert to normal mode
  53. : .hash .bld ."   hash:" . .nor ;
  54.  
  55. \ : sign rot 0< IF 45 hold THEN ;
  56. \ ( val -- )
  57. : .num dup abs 0 <# #s sign #> type ;
  58.  
  59. 0 value start
  60. \ Print address and/or offset of datum
  61. : .addr { addr -- }
  62.     .bld
  63.     deflgs 01 and IF addr +base   .num ascii : emit THEN
  64.     deflgs 02 and IF addr         .num ascii : emit THEN
  65.     deflgs 04 and IF addr start - .num ascii : emit THEN
  66.     .nor ;
  67.  
  68. : NewL ?pause
  69.     CR dup .addr
  70.     0 -> out indent ;
  71.  
  72. : ?NewL
  73.     out tab 4* - 0> IF NewL THEN ;
  74.  
  75. \ ( addr -- addr' )  print "parmN" or "varN"
  76. : .p/v
  77.     dup @ >name 3+ c@ dup 48 - mp0 <    \ mp0 is a peek at deComp's "#p" var
  78.     IF ." parm" ELSE ." var" THEN
  79.     emit space  4+ ;
  80.  
  81. \ ( addr -- addr' )  print "parmN" or "varN"
  82. : .%p/v
  83.     dup    @ >name  4+ c@ dup 48 - mp0 <    \ mp0 is a peek at deComp's "#p" var
  84.     IF ." %parm" ELSE ." %var" THEN
  85.     emit space  4+ ;
  86.  
  87. 0 value nflgs
  88. \ ( pfa -- )  print name of definition and save name field flags
  89. : .nfa nfa dup id. c@ -> nflgs ;
  90.  
  91. :CLASS  wArray  <Super  Object  2 <Indexed
  92.  
  93.     :M  AT:        ?idx ^Elem  w@             ;M
  94.     :M  TO:        ?idx ^Elem  w!            ;M
  95.  
  96. ;CLASS
  97.  
  98. :CLASS wordCol  <Super wArray
  99.  
  100.     Int        Size    \ # elements in list
  101.  
  102.     \ ( -- curSize )  Return #elements currently in list
  103.     :M  SIZE:  Get: Size  ;M
  104.  
  105.     \ ( val -- )   Add value to end of list
  106.     :M  ADD:  Get: Size  limit  >=
  107.         classErr" 137  Get: size  To: Self
  108.         1 +: Size   ;M
  109.  
  110.     \ ( val -- ind t  OR f)  Find a value in an OC
  111.     :M  INDEXOF:  0 swap Get: Size  0
  112.         DO i  (^elem) w@
  113.             over = IF 2drop  i 1 1 leave THEN
  114.         LOOP  drop  ;M
  115.  
  116. ;CLASS
  117.  
  118. :CLASS OffArray <super wordCol
  119.  
  120.     var    pointer
  121.  
  122.   :M init: ( addr --) put: pointer ;M
  123.   :M at: ( ind -- addr) at: super get: pointer + ;M
  124.   :M add: ( addr --) get: pointer - add: super ;M
  125.  
  126. ;CLASS
  127.  
  128. 370 WordCol nHash
  129. 370 OffArray hName
  130. : name/hash here init: hName
  131.     new: loadFile
  132.     " name/hash" name: topFile
  133.     openReadOnly: topFile IF ." No name/hash table available" exit THEN
  134.     BEGIN
  135.         tib 128 expect: topFile 0=
  136.     WHILE
  137.         bytesRead: topFile 1-
  138.         tib over here >str255 here c@ >uc
  139.         here hash add: nHash
  140.         here add: hName
  141.         1+ allot
  142.     REPEAT
  143.     remove: loadFile
  144. ;
  145. name/hash
  146.  
  147. \ ( val -- )
  148. : .mName
  149.     indexOf: nhash
  150.     IF at: hName count type space
  151.     ELSE ." ???: " THEN ;
  152.  
  153. : inAppRange? ( addr -- addr b) dup heapBot heapTop within ;
  154.  
  155. \ ( pfa #parms -- )  Decompile cfas starting from pfa
  156. : deComp { #p \ ;? cf? -- }    \ #p number of parms, ;? end of defintion flag
  157.     0 -> ;?
  158.     1 ++> tab indent
  159.     BEGIN    ( addr )
  160.         dup @
  161.         CASE    ( addr cfa )
  162.         'c flit            OF  4+ dup print: float 10 +                ENDOF
  163.         'c killfargs    OF    ." KillFargs" 6 +                        ENDOF
  164.         'c !fp(ip)        OF  ." -> "  4+ dup w@ 8 - 4 / $ 30 + ." %parm" emit 2+    space ENDOF
  165.         'c +fp(ip)        OF  ." ++> " 4+ dup w@ 8 - 4 / $ 30 + ." %parm" emit 2+    space ENDOF
  166.         'c lit            OF    4+ dup @
  167.                             over 4+ @ dup 'c trap = swap 'c (fdos) = or
  168.                             IF ." $" .h
  169.                             ELSE inAppRange?
  170.                                 IF ?cfa
  171.                                     IF ." 'c " >name id.
  172.                                     ELSE dup cfa ?cfa
  173.                                         IF drop ." ' " nfa id.
  174.                                         ELSE drop .num space
  175.                                         THEN
  176.                                     THEN
  177.                                 ELSE .
  178.                                 THEN
  179.                             THEN 4+                                    ENDOF
  180.         'c wlit            OF    4+ dup w@
  181.                             over 2+ @ dup 'c trap = swap 'c (fdos) = or
  182.                             IF ." $" .h
  183.                             ELSE dup cfa inAppRange?
  184.                                 IF ?cfa
  185.                                     IF drop ." ' " nfa id.
  186.                                     ELSE drop .num space
  187.                                     THEN
  188.                                 ELSE .
  189.                                 THEN
  190.                             THEN 2+                                    ENDOF
  191.         'c wlitw        OF    4+ ." w" dup w@ . 2+                    ENDOF
  192.         'c (lits)        OF    4+ ?NewL dup w@ ." <[" dup . ." ]> 'cfas "
  193.                             swap 2+ swap 0
  194.                             DO dup @ >name id. 4+ LOOP                ENDOF
  195.         'c (trap)        OF    4+ ascii $ emit
  196.                             base >R hex
  197.                                 dup w@ . ." Trap " 2+
  198.                             R> -> base                                ENDOF
  199.         'c [trap]        OF        4+ ascii $ emit
  200.                             base >R hex
  201.                                 dup w@ . ." Trap " 12 +
  202.                             R> -> base                                ENDOF
  203.         'c (defer)        OF    4+ dup w@ .mName ." [ ] " 2+            ENDOF
  204.         'c (classerr")    OF    4+ ." ClassErr" ascii " emit
  205.                             dup w@ . 2+                                ENDOF
  206.         'c (.rAbort)    OF    4+ ." ?error"
  207.                             dup w@ . 2+                                ENDOF
  208.         'c (.rStr)        OF    4+ ." msg#"
  209.                             dup w@ . 2+                                ENDOF
  210.         'c (.tStr)        OF    4+ ." type#"
  211.                             dup w@ . 2+                                ENDOF
  212.         'c compile        OF    4+ ." Compile " dup @ >name id. 4+        ENDOF
  213.         'c branch        OF    4+ ." Branch:"  dup @ dup .
  214.                             over + .addr 4+        NewL                ENDOF
  215.         'c 0branch        OF    4+ ." 0Branch:" dup @ dup .
  216.                             over + .addr 4+        NewL                ENDOF
  217.         'c (do)            OF    8+ ?NewL ." DO "    1 ++> tab    NewL    ENDOF
  218.         'c (loop)        OF    8+ -1 ++> tab        ?NewL  ." LOOP "    ENDOF
  219.         'c (loop+)        OF    8+ -1 ++> tab        ?NewL ." +LOOP "    ENDOF
  220.         'c (of)            OF    8+ ." OF "                                ENDOF
  221.         'c (rof)        OF    8+ ." RANGEOF "                            ENDOF
  222.         'c (select)        OF    4+ ?NewL ." Select{" NewL
  223.                             @ dup dup dup @ - 4 / 1- 0
  224.                             DO    i . ." is{ " 4- dup @ #p deComp
  225.                                 ." }end"  NewL
  226.                             LOOP ." default{ "
  227.                             4- @ #p deComp
  228.                             ?NewL ." }Select" 4+ NewL                ENDOF
  229.         'c (.")            OF    4+ ascii . emit ascii " emit space
  230.                             count 2dup type ascii " emit space
  231.                             + align                                    ENDOF
  232.         'c (lit")        OF    4+ ascii " emit space
  233.                             count 2dup type ascii " emit space
  234.                             + align                                    ENDOF
  235.         'c (ab")        OF    4+ ." Abort" ascii " emit space
  236.                             count 2dup type ascii " emit space
  237.                             + align                                    ENDOF
  238.         'c (al")        OF    4+ ." Alert" ascii " emit space
  239.                             count 2dup type ascii " emit space
  240.                             + align                                    ENDOF
  241.         'c (disp)        OF    4+ ." Dispose> " dup @ 8- nfa id. 4+    ENDOF
  242.         'c (mdisp)        OF    4+ ." Dispose> " dup w@ dup #p <
  243.                             IF ." parm" ELSE ." var" THEN
  244.                             48 + emit space 2+                        ENDOF
  245.         'c (be)            OF    ." Become " 4+                            ENDOF
  246.         'c (semip)        OF    drop                    1 -> ;?            ENDOF
  247.         'c (jmp)        OF    4+ @ .exp ." ( Forward referenced )"
  248.                                  .nor                        NewL    ENDOF
  249.         'c ;s            OF    drop                    1 -> ;?            ENDOF
  250.         'c (;m)            OF    drop                    1 -> ;?            ENDOF
  251.         'c (;code)        OF    drop CR ." (;CODE) "    1 -> ;?            ENDOF
  252.         'c (,code)        OF    drop CR ." BUILD "        1 -> ;?            ENDOF
  253.         'c header        OF    10 + dup 2- w@ 4 / 0
  254.                             DO  NewL .exp i .num ." cfa: " .nor
  255.                                 NewL dup @ 10 + 0 deComp CR 4+
  256.                             LOOP drop                1 -> ;?            ENDOF
  257.         'c @fp0            OF  .%p/v                                    ENDOF
  258.         'c @fp1            OF  .%p/v                                    ENDOF
  259.         'c @fp2            OF  .%p/v                                    ENDOF
  260.         'c @fp3            OF  .%p/v                                    ENDOF
  261.         'c @fp4            OF  .%p/v                                    ENDOF
  262.         'c @fp5            OF  .%p/v                                    ENDOF
  263.         'c mp0            OF    .p/v                                    ENDOF
  264.         'c mp1            OF    .p/v                                    ENDOF
  265.         'c mp2            OF    .p/v                                    ENDOF
  266.         'c mp3            OF    .p/v                                    ENDOF
  267.         'c mp4            OF    .p/v                                    ENDOF
  268.         'c mp5            OF    .p/v                                    ENDOF
  269.         'c ms0            OF    ." -> " .p/v                            ENDOF
  270.         'c ms1            OF    ." -> " .p/v                            ENDOF
  271.         'c ms2            OF    ." -> " .p/v                            ENDOF
  272.         'c ms3            OF    ." -> " .p/v                            ENDOF
  273.         'c ms4            OF    ." -> " .p/v                            ENDOF
  274.         'c ms5            OF    ." -> " .p/v                            ENDOF
  275.         'c (++>)        OF    4+ dup w@ 8- 4 / dup #p < ." ++> "
  276.                             IF ." parm" ELSE ." var" THEN
  277.                             48 + emit space 2+                        ENDOF
  278.         'c (ex>)        OF    4+ dup w@ 8- 4 / dup #p < ." exec> "
  279.                             IF ." parm" ELSE ." var" THEN
  280.                             48 + emit space 2+                        ENDOF
  281.         \ OTHERWISE
  282.  
  283.             dup >body ?isObj    \ normal early bound method?
  284.             IF    drop    ( addr cfa )
  285.                 over 4+ @ @ ' m0cfa =
  286.                 IF    over 4+ @ 6 - w@ .mName >name id. 8+
  287.                     deflgs 07 and IF dup 4- @ 6 - w@ .hash THEN
  288.                 ELSE >name id. 4+ THEN
  289.  
  290.             ELSE drop    ( addr cfa )
  291.  
  292.                 dup @ ' m1cfa =        \ method bound to a private ivar?
  293.                 IF    10 - w@ .mName 4+
  294.                     dup w@ 65535 over =    \ check for self/super ref
  295.                     IF    drop dup 4- @ start <
  296.                         IF ." super" ELSE ." self" THEN
  297.                     ELSE .num THEN space 2+
  298.                     deflgs 07 and IF dup 6 - @ 10 - w@ .hash THEN
  299.  
  300.                 ELSE    ( addr cfa )
  301.  
  302.                     dup @ ' m0cfa =    \ method bound to a class
  303.                     IF    dup 6 - w@ .mName
  304.                         latest BEGIN 2dup < WHILE pfa lfa @ REPEAT id. drop
  305.                         4+
  306.  
  307.                     ELSE    ( addr cfa )
  308.                         ?cfa                    \ ultimately, this is the usual case
  309.                         IF >name dup id. n>count " INLINE" s=
  310.                             IF 4+ BEGIN dup w@ dup $ 49fa <>
  311.                                WHILE ascii $ emit .h 2+
  312.                                     out 60 > IF NewL THEN
  313.                                REPEAT 
  314.                                 drop 4+     
  315.                             THEN
  316.                         ELSE 1 -> cf? 9 1
  317.                             DO  cfa ?cfa    \ check for nth cfa
  318.                                 IF dup @ >R  valCode R =    vectCode R  = or
  319.                                             fvalCode R = or   svCode R> = or
  320.                                     IF i 1 = IF ." ++> " ELSE ." -> " THEN
  321.                                     ELSE 48 i+ emit 45 emit THEN
  322.                                     >name id. 0 -> cf? leave
  323.                                 THEN
  324.                             LOOP
  325.                             cf? IF drop ." ¿¿¿ " THEN    \ all decomp failed
  326.                         THEN
  327.                         4+
  328.                     THEN
  329.  
  330.                 THEN
  331.             THEN
  332.  
  333.             dup    \ for consumption by endcase
  334.  
  335.         ENDCASE
  336.  
  337.         deflgs 07 and    \ print address and/or offset?
  338.         IF
  339.             NewL    \ new line for every word
  340.         ELSE
  341.             out 60 > IF NewL THEN
  342.         THEN
  343.  
  344.     ;? UNTIL
  345.     nflgs $ 40 and IF ." Immediate" THEN
  346.     -1 ++> tab
  347. ;
  348.  
  349. 0 value floatpos
  350. : isFloatP/V ( pos  --) floatPos and IF ascii % emit THEN ;
  351.  
  352. \ ( pfa -- )  decompile a definition; may have named stack
  353. : deCol { myPfa \ amt #p -- }    \ #p number of parms
  354.     0 -> #p
  355.     myPfa c@                        \ Does definition has named stack or local vars
  356.     IF    ." { "
  357.         myPfa c@ -> amt                \ get the total number of parms and vars
  358.         myPfa 1+ c@ -> floatPos        \ get position of any floats
  359.         amt $ F and -> #p            \ look at parms first
  360.         #p 0 DO i 1+ isFloatP/V ." parm" 48 i+ emit space LOOP
  361.         amt 4 >> -dup
  362.         IF ascii \ emit space 0 DO 1 #p i+ << isFloatP/V ." var" 48 #p + i+ emit space LOOP THEN
  363.         ." -- }" myPfa 2+ -> myPfa
  364.     THEN
  365.     NewL myPfa #p deComp ;
  366.  
  367. : NxtL ?pause
  368.     CR 0 -> out indent ;
  369.  
  370. \ ( pfa -- )  decompile a class definition
  371. : deClass { ^class \ k -- } CR
  372.     0 -> k    1 -> tab
  373.     ^class mfa @    \ get starting addresses of method
  374.     BEGIN dup ^class >
  375.     WHILE 1 ++> k dup 2+ @
  376.     REPEAT drop
  377.     ." :CLASS " ^class nfa id.
  378.     ."  <Super " ^class 22 + @ nfa id.
  379.     ^class 20 + w@ -dup IF . ." <Indexed" THEN CR
  380.     ^class 18 + w@ NxtL .exp ." (" . ." Bytes )" .nor CR
  381.     k 0 DO
  382.         NewL ." :M  " dup w@ .mName 14 + deCol
  383.         NewL ." ;M" CR
  384.     LOOP
  385.     CR ." ;CLASS"
  386. ;
  387.  
  388. 0 value odata
  389. : .) ascii ) emit ;
  390. : .( .addr ascii ( emit ;
  391.  
  392. : .32-bit
  393.     dup . inAppRange?
  394.     IF ?cfa
  395.         IF >name id. ELSE drop THEN
  396.     ELSE drop
  397.     THEN ;
  398.  
  399. \ ( length -- )  display a fundamental datum from the object
  400. : .odata { w -- }
  401.     odata .(
  402.     w CASE
  403.         1 OF odata c@ .       ENDOF
  404.         2 OF odata w@ .       ENDOF
  405.         4 OF odata  @ .32-bit ENDOF
  406.     \ OTHERWISE
  407.     w . ." Bytes "    \ if not 1, 2 or 3; just tell how many bytes there are
  408.     ENDCASE
  409.     .)
  410.     w ++> odata
  411. ;
  412.  
  413. \ display indexed data cells with their indices
  414. : .idata { \ width -- }
  415.     odata w@ -> width 4 ++> odata    \ get width and skip indexed header
  416.     odata 2- w@ 0
  417.     DO    NxtL
  418.         i . width .odata            \ print the contents of each element
  419.     LOOP
  420. ;
  421.  
  422. Forward .struct
  423.  
  424. \ display contents of ivar
  425. : .ivars { lastNFA 1stNFA dlen \ inc -- }
  426.     lastNFA 12 + 1stNFA
  427.     DO    12 -> inc            \ usual length of an ivar
  428.         NxtL
  429.         i 6 + @                \ get ivars class pointer
  430.         dup ' Object =
  431.         IF    ." DATA " drop     \ This ivar is DATA
  432.             i lastNFA =        \ If last ivar, can't subtract from next ivar
  433.             IF dlen            \ computes # bytes
  434.             ELSE i 22 + w@ THEN
  435.                  i 10 + w@ - .odata
  436.         ELSE
  437.             dup nfa     id.                \ This ivar may be nested
  438.             dup @width                     \ indexed?
  439.             dup IF 14 -> inc
  440.                    4 ++> odata THEN        \ (get past indexed overhead)
  441.             over ifa @ 3 pick 26 + > or    \ nest?
  442.             deflgs 16 and lAnd            \ supposed to be displaying nested?
  443.             IF 1 ++> tab .struct -1 ++> tab
  444.             ELSE dfa w@ .odata THEN
  445.         THEN
  446.     inc +LOOP
  447. ;
  448.  
  449. 0 value snest
  450.  
  451. \ ( ^class -- )  print ivar data & indexed data (recursive from .ivars & self)
  452. :f .struct 
  453.     1 ++> snest
  454.     dup dfa w@            \ total length of object data
  455.     over sfa @ dfa w@    \ length of super class data
  456.     tab 0= over lAnd deflgs 08 and lAnd
  457.     IF  3 pick dup sfa @ dup nfa CR ." --" id. CR    \ display super data
  458.         .struct              nfa CR ." ==" id. CR
  459.     ELSE dup ++> odata THEN        \ skip super data
  460.     - -dup                \ total data minus super data
  461.     IF over ifa @                    \ pointer to last ivar
  462.         3 pick 26 +                    \ pointer to first ivar
  463.         rot .ivars                    \ print ivar data
  464.     ELSE tab 0= IF .exp ." ( No ivars )" .nor CR THEN THEN
  465.     @width                            \ print indexed data if any
  466.     IF deflgs 32 and snest 0= lAnd
  467.         IF    NxtL .exp ." --Indexed Data--" .nor
  468.             .idata
  469.         THEN
  470.     THEN
  471.     -1 ++> snest 
  472. ;f
  473.  
  474. \ ( pfa -- )  display the data of an object
  475. : deObj CR
  476.     dup here >
  477.     IF ." HEAP-OBJECT "
  478.     ELSE dup nfa id. THEN        \ otherwise print object name
  479.     dup -> odata                \ set start of data
  480.     .exp ." is an Object of Class: " .nor
  481.     cfa @ dup nfa id.            \ print superclass name
  482.      -1 -> snest  0 -> tab
  483.     .struct                        \ print ivar data & indexed data
  484. ;
  485.  
  486. \ ( pfa -- )  decompile a module definition
  487. : deModule { \ #imps -- }
  488.     ." From " dup nfa id. ." Import{ "
  489.     dup 16 + w@ -> #imps 12 + @
  490.     #imps 1- 0 DO        \ gather export words
  491.         dup pfa lfa @
  492.     LOOP
  493.     #imps 0 DO            \ print export word names
  494.         id.
  495.     LOOP
  496.     ." }"
  497. ;
  498.  
  499. 0 constant con
  500. 0 variable vare
  501.  
  502. \ ( pfa -- pfa bool )
  503. : ?isMod modCode over cfa (@) drop = ;
  504. ' does> 20 + constant doesCode
  505.  
  506. \ ( pfa -- )  setup for one of the decompilers: Colon, Class, Object, etc…
  507. : (de) ?pause
  508.     dup -> start    0 -> nflgs    0 -> tab
  509.     dup cfa @ over = IF nfa id. .exp ." is a Code word" .nor CR exit THEN
  510.     ?isObj   IF deObj CR exit THEN
  511.     ?isClass IF deClass CR exit THEN
  512.     ?isMod   IF deModule CR exit THEN
  513.     dup cfa @    ( pfa code )
  514.     dup colCode = over ' colP = or
  515.     IF drop CR ." : " dup .nfa deCol CR ." ; " CR exit THEN
  516.  
  517.     CASE
  518.     over .nfa .exp    ( pfa code )
  519.  
  520.     valCode   OF .bld ." is a Value " .nor 8+ dup .( @ dup .32-bit .) cr
  521.                     ?isobj IF (de) ELSE drop THEN             ENDOF
  522.     fvalCode  OF ." is an fValue" .nor drop                  ENDOF
  523.     impCFA    OF ." is an Import word " .nor dup .( space @ >name id. .)
  524.                  nflgs $ 40 and IF CR ." Immediate" THEN    ENDOF
  525.     'code con OF ." is a Constant " .nor dup .( @ .32-bit .) ENDOF
  526.     'code vare OF ." is a Variable " .nor dup .( @ .32-bit .) ENDOF
  527.     vectCode  OF .bld ." is a Vect " .nor 8+ dup .( @ -dup IF 4+ dup nfa space id. .) cr (de)
  528.                                     ELSE 0 . .) THEN        ENDOF
  529.     svCode    OF ." is a sysVect " .nor 8+ dup 4+
  530.                  begin-dp @ rot @ + dup @ 0= IF drop dup THEN
  531.                  dup .( @ 4+ dup nfa space id. ." ) … default "
  532.                  swap dup .( @ >name space id. .)    cr (de)            ENDOF
  533.     doesCode  OF @ latest BEGIN 2dup < WHILE pfa lfa @ REPEAT
  534.                 ." is a " id. ." definition" .nor drop        ENDOF
  535.  
  536.     \ OTHERWISE    ( pfa code )
  537.  
  538.         ' (dodo) over 2+ @ =
  539.         IF    0 >R latest BEGIN 2dup < WHILE R> drop dup >R pfa lfa @ REPEAT
  540.             ." is a " R> id. ." definition" .nor 2drop
  541.         ELSE
  542.             dup 4- @ over =
  543.             IF     ." is an alias of " .nor nfa id.
  544.             ELSE ." is a MYSTERY" .nor drop THEN
  545.         THEN
  546.  
  547.     ENDCASE
  548.     CR
  549. ;
  550.  
  551. \ ( str255 chr -- offs t OR f )
  552. : charOf { adr chr -- }
  553.     0    \ bool
  554.     adr c@ 1+ 1
  555.     DO
  556.         adr i+ c@ chr = IF drop i 1- 1 leave THEN
  557.     LOOP
  558. ;
  559.  
  560. \ ( str -- nfa )  lookup module vocabulary if specified; else main dictionary
  561. : dvoc { str -- }
  562.     str ascii | charOf
  563.     IF    str over 1+ over c@ over - str rot + c! c!    \ double string
  564.         str count + latest (find) 0= Abort" not found" drop
  565.         ?isMod 0= Abort" not a module"
  566.         dup cfa execute        \ get module into memory
  567.         8+ @ $ ffffff and
  568.            @ $ ffffff and    \ get nfa of last word in module
  569.     ELSE latest THEN ;
  570.  
  571. \ decompile any yerk word or method
  572. \ de' word[|module]
  573. \ de' meth: class[|module]
  574. : de'
  575.     @word dup c@ over + c@ ascii : =
  576.     IF    dup count str255 drop hash        \ method of a class
  577.         @word dup
  578.         dvoc (find) 0= Abort" not found" drop
  579.         ?isClass 0= Abort" not a class"
  580.         dup -> start (findm) ." :M  " buf255 count type 4+ deCol
  581.         CR ." ;M" CR
  582.     ELSE                                \ normal word
  583.         dup dvoc (find) 0= Abort" not found" drop
  584.         (de)
  585.     THEN ;
  586.  
  587. ;Module
  588.