Changeset 2914


Ignore:
Timestamp:
Mar 22, 2012, 2:13:14 AM (2 years ago)
Author:
wmb
Message:

Debugger - improved the "down" command so it will skip past the method call machinery to find the callee that the user cares about. You can now use 'd' on $call-method, $call-parent, etc.

Files:
2 edited

Legend:

Unmodified
Added
Removed
  • forth/lib/debug.fth

    r2913 r2914  
    156156   catch  ?dup if  .error drop false  else  true  then 
    157157; 
     158defer resolve-method 
     159' noop to resolve-method 
    158160: executer  ( xt -- xt' ) 
    159161   dup ['] execute =  over ['] catch =  or  if  drop dup  then 
     162   resolve-method 
    160163; 
    161164d# 72 constant /#buf 
  • ofw/core/ofwcore.fth

    r2913 r2914  
    47904790; 
    47914791' method-call? to indirect-call? 
     4792 
     4793create not-colon 
     4794: ?not-colon  ( false | xt true -- xt )  
     4795   0=  if  ['] not-colon  then 
     4796; 
     4797: resolve-ih-method  ( adr len ihandle -- xt ) 
     4798   dup 0=  if  3drop ['] not-colon exit  then         ( adr len ihandle ) 
     4799   package(  my-voc $find-word  )package  ?not-colon  ( xt ) 
     4800; 
     4801: resolve-voc-method  ( adr len voc -- xt ) 
     4802   (search-wordlist)  ?not-colon 
     4803; 
     4804: resolve-ph-method  ( adr len ph -- xt ) 
     4805   phandle>voc resolve-voc-method 
     4806; 
     4807    
     4808: (resolve-method) ( xt -- xt' ) 
     4809   dup ['] $call-self =  if     ( [ adr len ] xt ) 
     4810      drop  2dup my-self        ( adr len ih ) 
     4811      resolve-ih-method exit    ( -- xt' ) 
     4812   then 
     4813 
     4814   dup ['] $call-method =  if   ( [ adr len ih ] xt ) 
     4815      drop  3dup                ( adr len ih ) 
     4816      resolve-ih-method exit    ( -- xt' ) 
     4817   then 
     4818 
     4819   dup ['] $call-parent =  if   ( [ adr len ] xt ) 
     4820      drop  2dup my-parent      ( adr len ih ) 
     4821      resolve-ih-method exit    ( -- xt' ) 
     4822   then                         ( xt ) 
     4823 
     4824   dup ['] call-package =  if   ( [ xt ih ] xt ) 
     4825      drop over exit            ( -- xt' ) 
     4826   then 
     4827 
     4828   dup ['] $vexecute? =  if     ( [ adr len voc ] xt ) 
     4829      drop  3dup                ( adr len voc ) 
     4830      resolve-voc-method exit   ( -- xt ) 
     4831   then 
     4832 
     4833   dup ['] $vexecute =  if      ( [ adr len voc ] xt ) 
     4834      drop  3dup                ( adr len voc ) 
     4835      resolve-voc-method exit   ( -- xt ) 
     4836   then 
     4837 
     4838   dup ['] $package-execute? =  if  ( [ adr len ph ] xt ) 
     4839      drop  3dup                    ( adr len voc ) 
     4840      resolve-ph-method exit        ( -- xt ) 
     4841   then                             ( xt ) 
     4842 
     4843   dup ['] package-execute =  if  ( [ adr len ] xt ) 
     4844      drop  2dup current-device   ( adr len voc ) 
     4845      resolve-ph-method exit      ( -- xt ) 
     4846   then                           ( xt ) 
     4847 
     4848   dup ['] apply-method =  if     ( [ adr len ] xt ) 
     4849      drop  2dup my-voc           ( adr len voc ) 
     4850      resolve-voc-method exit     ( -- xt ) 
     4851   then                           ( xt ) 
     4852 
     4853   dup ['] (apply-method) =  if   ( [ adr len ] xt ) 
     4854      drop  2dup my-voc           ( adr len voc ) 
     4855      resolve-voc-method exit     ( -- xt ) 
     4856   then                           ( xt ) 
     4857; 
     4858also bug  ' (resolve-method) to resolve-method  previous 
    47924859previous 
Note: See TracChangeset for help on using the changeset viewer.