Changeset 3050

Timestamp:

Jul 11, 2012 4:00:56 AM (11 months ago)

Author:

wmb

Message:

OFW core - another fix to the "relative phandles" suite, this one affecting the rarely used function "delete-package".

File:

• ofw/core/ofwcore.fth (modified) (5 diffs)

ofw/core/ofwcore.fth

@@ -746 +746 @@
 ;
 : pop-package  ( -- )  (pop-package) definitions  ;
-: push-device  ( acf -- )  to current-device  ;
+: push-device  ( phandle -- )  to current-device  ;
 
 : pop-device  ( -- )
@@ -1293 +1293 @@
    pop-device                      (                    R: phandle )
    'child   begin                  ( link               R: phandle )
-      dup link@                    ( link phandle'      R: phandle )
-      dup r@ <>                    ( link phandle' flag R: phandle )
+      dup link@                    ( link voc'          R: phandle )
+      dup r@ phandle>voc <>        ( link voc'          flag R: phandle )
    while                           ( link phandle'      R: phandle )
-      push-device drop  'peer      ( link               R: phandle)
+      voc>phandle push-device      ( link               R: phandle)
+      drop  'peer                  ( link'              R: phandle)
    repeat                          ( link phandle'      R: phandle )
    r> 2drop                        ( link )
-   pop-package
+   pop-package                     ( link )
 ;
 : delete-package  ( phandle -- )
@@ -1949 +1950 @@
 : ls  ( -- )
    device-context?  if
-      'child token@                   ( first-node )
-      begin  non-null?  while         ( node )
+      'child token@                   ( first-node-voc )
+      begin  non-null?  while         ( node-voc )
          voc>phandle push-device      ( )
          .nodeid                      ( )
-         'peer token@                 ( node' )
-         pop-device
+         'peer token@                 ( node-voc' )
+         pop-device                   ( )
       repeat                          ( )
    else
@@ -1962 +1963 @@
 : delete-my-children  ( -- )
    device-context?  if
-      'child token@                   ( first-node )
-      begin  non-null?  while         ( node )
-         dup push-device              ( node )
-         'peer token@                 ( node peer )
-         pop-device                   ( node peer )
-         swap delete-package          ( peer )
+      'child token@                   ( first-node-voc )
+      begin  non-null?  while         ( node-voc )
+         voc>phandle dup push-device  ( node-phandle )
+         'peer token@                 ( node-phandle peer-voc )
+         pop-device                   ( node-phandle peer-voc )
+         swap delete-package          ( peer-voc )
       repeat                          ( )
    then
@@ -2163 +2164 @@
 ;
 
+\ XXX - I think this could be implemented by   (push-package) (property) (pop-package)
 : set-package-property  ( value$ name$ phandle -- )
    current token@ >r  context token@ >r   (select-package)  ( value$ name$ )