home *** CD-ROM | disk | FTP | other *** search
/ Dream 52 / Amiga_Dream_52.iso / RiscOS / APP / DEVS / FORTH / WIMPFO.ZIP / !WimpForth / classdebug < prev    next >
Text File  |  1996-01-15  |  2KB  |  59 lines
  1. \ classdbg.f
  2.  
  3. cr .( Loading Object Debugging support...)
  4.  
  5. : methods       ( object-address -- )  [ classes ]
  6.                 depth 0=
  7.                 if      ' execute
  8.                 then
  9.                 cr >class  MFA
  10.                 begin   @ ?dup
  11.                 while   dup cell+ @ unhash
  12.                         type 14 #tab space 14 ?cr
  13.                 repeat  ;
  14.  
  15. : ivars         ( object-address -- )  [ classes ]
  16.                 depth 0=
  17.                 if      ' execute
  18.                 then
  19.                 cr >class IFA
  20.                 begin   @ ?dup
  21.                 while   dup cell+ @ unhash
  22.                         type 10 #tab ."  (" dup 3 cells+ @ 1 .r ." )"
  23.                         10 #tab space 20 ?cr
  24.                 repeat ;
  25.  
  26.  
  27. : privates      ( class-cfa -- )
  28.                 context @
  29.                 swap >class context !  words
  30.                 context ! ;
  31.  
  32. classes also hidden also bug also
  33.  
  34. : GetMethod     ( -<method object>- m0cfa )
  35.                 @word dup count + 1- c@ ':' <> \ allow windows messages too
  36.                 if      anyfind 0= abort" Undefined Method"
  37.                         execute
  38.                 else    count hash
  39.                 then    ' execute find-method swap to obj-save ;
  40.  
  41. : msee          ( -<method object>- )
  42.                 GetMethod cr ." :M " dup .m0name 2 spaces
  43.                 3 cells+                        \ step to the PFA
  44.                 .pfa ;                          \ decompile the definition
  45.  
  46. : mdebug        ( -<method object>- )
  47.                 unbug
  48.                 false to ?dbg-cont              \ turn off contuous step
  49.                 base @ to debug-base
  50.                 GetMethod 3 cells+ dup ip0 ! ip !
  51.                 ['] trace patch
  52.                 nesting off ;
  53.  
  54. : mdbg          ( -<method object>- )    \ debug a method now
  55.                 >in @ mdebug >in ! ;
  56.  
  57. only forth also definitions
  58.  
  59.