Author: wmb Date: Thu Mar 22 02:13:14 2012 New Revision: 2914 URL: http://tracker.coreboot.org/trac/openfirmware/changeset/2914
Log: 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.
Modified: forth/lib/debug.fth ofw/core/ofwcore.fth
Modified: forth/lib/debug.fth ============================================================================== --- forth/lib/debug.fth Thu Mar 22 01:21:57 2012 (r2913) +++ forth/lib/debug.fth Thu Mar 22 02:13:14 2012 (r2914) @@ -155,8 +155,11 @@ : try ( n acf -- okay? ) catch ?dup if .error drop false else true then ; +defer resolve-method +' noop to resolve-method : executer ( xt -- xt' ) dup ['] execute = over ['] catch = or if drop dup then + resolve-method ; d# 72 constant /#buf /#buf buffer: #buf-save
Modified: ofw/core/ofwcore.fth ============================================================================== --- ofw/core/ofwcore.fth Thu Mar 22 01:21:57 2012 (r2913) +++ ofw/core/ofwcore.fth Thu Mar 22 02:13:14 2012 (r2914) @@ -4789,4 +4789,71 @@ drop false ; ' method-call? to indirect-call? + +create not-colon +: ?not-colon ( false | xt true -- xt ) + 0= if ['] not-colon then +; +: resolve-ih-method ( adr len ihandle -- xt ) + dup 0= if 3drop ['] not-colon exit then ( adr len ihandle ) + package( my-voc $find-word )package ?not-colon ( xt ) +; +: resolve-voc-method ( adr len voc -- xt ) + (search-wordlist) ?not-colon +; +: resolve-ph-method ( adr len ph -- xt ) + phandle>voc resolve-voc-method +; + +: (resolve-method) ( xt -- xt' ) + dup ['] $call-self = if ( [ adr len ] xt ) + drop 2dup my-self ( adr len ih ) + resolve-ih-method exit ( -- xt' ) + then + + dup ['] $call-method = if ( [ adr len ih ] xt ) + drop 3dup ( adr len ih ) + resolve-ih-method exit ( -- xt' ) + then + + dup ['] $call-parent = if ( [ adr len ] xt ) + drop 2dup my-parent ( adr len ih ) + resolve-ih-method exit ( -- xt' ) + then ( xt ) + + dup ['] call-package = if ( [ xt ih ] xt ) + drop over exit ( -- xt' ) + then + + dup ['] $vexecute? = if ( [ adr len voc ] xt ) + drop 3dup ( adr len voc ) + resolve-voc-method exit ( -- xt ) + then + + dup ['] $vexecute = if ( [ adr len voc ] xt ) + drop 3dup ( adr len voc ) + resolve-voc-method exit ( -- xt ) + then + + dup ['] $package-execute? = if ( [ adr len ph ] xt ) + drop 3dup ( adr len voc ) + resolve-ph-method exit ( -- xt ) + then ( xt ) + + dup ['] package-execute = if ( [ adr len ] xt ) + drop 2dup current-device ( adr len voc ) + resolve-ph-method exit ( -- xt ) + then ( xt ) + + dup ['] apply-method = if ( [ adr len ] xt ) + drop 2dup my-voc ( adr len voc ) + resolve-voc-method exit ( -- xt ) + then ( xt ) + + dup ['] (apply-method) = if ( [ adr len ] xt ) + drop 2dup my-voc ( adr len voc ) + resolve-voc-method exit ( -- xt ) + then ( xt ) +; +also bug ' (resolve-method) to resolve-method previous previous