Changeset 2914


Ignore:
Timestamp:
Mar 22, 2012, 2:13:14 AM (3 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.