[openfirmware] [commit] r3329 - forth/lib ofw/core

[repository service]

Author: wmb
Date: Wed Sep 26 11:15:13 2012
New Revision: 3329
URL: http://tracker.coreboot.org/trac/openfirmware/changeset/3329

Log:
OFW core - extend Forth decompiler and debugger to handle instance defer words.

Modified:
   forth/lib/debug.fth
   forth/lib/decomp.fth
   ofw/core/ofwcore.fth

Modified: forth/lib/debug.fth
==============================================================================
--- forth/lib/debug.fth	Wed Sep 26 06:56:26 2012	(r3328)
+++ forth/lib/debug.fth	Wed Sep 26 11:15:13 2012	(r3329)
@@ -60,8 +60,15 @@
 \ Enter and leave the debugger
 forth definitions
 : defer?  ( acf -- flag )  word-type  ['] key word-type =  ;
-: (debug  ( acf -- )
+
+defer resolve-defers
+: (resolve-defers)  ( xt -- xt' )
    begin  dup defer?  while  behavior  repeat
+;
+' (resolve-defers)  to resolve-defers
+
+: (debug  ( acf -- )
+   resolve-defers
 
    dup colon-cf?  0= abort" Not a colon definition"
    >body dup 'unnest  (debug)

Modified: forth/lib/decomp.fth
==============================================================================
--- forth/lib/decomp.fth	Wed Sep 26 06:56:26 2012	(r3328)
+++ forth/lib/decomp.fth	Wed Sep 26 11:15:13 2012	(r3329)
@@ -588,23 +588,37 @@
 : cf,  \ name  ( -- )  \ Compile name's code field
    ' token,
 ;
-d# 11 tassociative: definition-class
+d# 12 constant #definition-classes
+#definition-classes tassociative: definition-class
    ( 0 )   cf,  :          ( 1 )   cf,  constant
    ( 2 )   cf,  variable   ( 3 )   cf,  user
    ( 4 )   cf,  defer      ( 5 )   cf,  create
    ( 6 )   cf,  vocabulary ( 7 )   cf,  alias
    ( 8 )   cf,  value      ( 9 )   cf,  2constant
-   ( 10)   cf,  code
+   ( 10)   cf,  code       ( 11 )  cf,  dummy
 
-d# 12  case: .definition-class
+#definition-classes 1+ case: .definition-class
    ( 0 )   .:              ( 1 )   .constant
    ( 2 )   .variable       ( 3 )   .user
    ( 4 )   .defer          ( 5 )   .create
    ( 6 )   .vocabulary     ( 7 )   .alias
    ( 8 )   .value          ( 9 )   .2constant
-   ( 10)   .code           ( 11)   .other
+   ( 10)   .code           ( 11)   dummy
+   ( 12)   .other
 ;
 
+headers
+also forth definitions
+: install-decomp-definer  ( definer-acf display-acf -- )
+   ['] dummy ['] .definition-class (patch
+   ['] dummy ['] definition-class >body na1+
+	       dup [ #definition-classes ] literal ta+ tsearch
+   drop token!
+;
+previous definitions
+headerless
+
+
 : does/;code-xt?  ( xt -- flag )
    dup  ['] (does>) =  swap  ['] (;code) =  or
 ;

Modified: ofw/core/ofwcore.fth
==============================================================================
--- ofw/core/ofwcore.fth	Wed Sep 26 06:56:26 2012	(r3328)
+++ ofw/core/ofwcore.fth	Wed Sep 26 11:15:13 2012	(r3329)
@@ -904,17 +904,44 @@
 action:  >instance-data token@  ;
 
 headerless
+: instance-defer  ( -- )
+   create-cf  ['] crash /token  ( value data-size )
+   use-actions  value#,
+;
 : (defer)  ( -- )
    instance?  if
-      create-cf  ['] crash /token  ( value data-size )
-      use-actions  value#,
+      instance-defer
    else
-     defer-cf  ['] crash /token    ( value data-size )
-     user#,
+      defer-cf  ['] crash /token   ( value data-size )
+      user#,
    then                            ( value adr )
    token!
 ; patch (defer) noop defer
 
+\ Extend debugger to handle instance defers
+: (resolve-instance-defers)  ( xt -- xt' )
+   begin
+      dup defer?  if                             ( xt )
+	 behavior                                ( xt' )
+      else                                       ( xt )
+         dup definer ['] instance-defer  =  if   ( xt )
+            2 perform-action                     ( xt' )
+	 else                                    ( xt )
+	    exit
+         then
+      then
+   again
+;
+' (resolve-instance-defers) to resolve-defers
+
+\ Extend decompiler to handle instance defers
+: .instance-defer  ( xt definer -- )
+   .definer  ." is " cr   ( xt )
+   2 perform-action       ( xt' )
+   (see)
+;
+' instance-defer  ' .instance-defer  install-decomp-definer
+
 headers
 \ Instance values that are automatically created for every package instance.