Changeset 3329

Timestamp:

Sep 26, 2012 11:15:13 AM (8 months ago)

Author:

wmb

Message:

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

Files:

• forth/lib/debug.fth (modified) (1 diff)
• forth/lib/decomp.fth (modified) (3 diffs)
• ofw/core/ofwcore.fth (modified) (1 diff)

forth/lib/debug.fth

@@ -61 +61 @@
 forth definitions
 : defer?  ( acf -- flag )  word-type  ['] key word-type =  ;
+
+defer resolve-defers
+: (resolve-defers)  ( xt -- xt' )
+   begin  dup defer?  while  behavior  repeat
+;
+' (resolve-defers)  to resolve-defers
+
 : (debug  ( acf -- )
-   begin  dup defer?  while  behavior  repeat
+   resolve-defers
 
    dup colon-cf?  0= abort" Not a colon definition"

forth/lib/decomp.fth

@@ -589 +589 @@
    ' 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
@@ -595 +596 @@
    ( 6 )   cf,  vocabulary ( 7 )   cf,  alias
    ( 8 )   cf,  value      ( 9 )   cf,  2constant
-   ( 10)   cf,  code
-
-d# 12  case: .definition-class
+   ( 10)   cf,  code       ( 11 )  cf,  dummy
+
+#definition-classes 1+ case: .definition-class
    ( 0 )   .:              ( 1 )   .constant
    ( 2 )   .variable       ( 3 )   .user
@@ -603 +604 @@
    ( 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 )

ofw/core/ofwcore.fth

@@ -905 +905 @@
 
 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