[openfirmware] [commit] r2914 - forth/lib ofw/core
repository service
svn at openfirmware.info
Thu Mar 22 02:13:15 CET 2012
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
More information about the openfirmware
mailing list