[openfirmware] r1372 - ofw/core

[svn at openfirmware.info]

Author: wmb
Date: 2009-09-24 08:08:29 +0200 (Thu, 24 Sep 2009)
New Revision: 1372

Modified:
   ofw/core/ofwcore.fth
Log:
OFW core - added instance-specific and package-specific versions of 2value.


Modified: ofw/core/ofwcore.fth
===================================================================
--- ofw/core/ofwcore.fth	2009-09-18 01:30:04 UTC (rev 1371)
+++ ofw/core/ofwcore.fth	2009-09-24 06:08:29 UTC (rev 1372)
@@ -811,6 +811,21 @@
 ;
 resident
 
+headerless
+: 2value  \ name  ( d.initial-value -- )
+   header noop   \  Will patch with (2value)
+;
+
+3 actions
+action:  >instance-data 2@  ;
+action:  >instance-data 2!  ;
+action:  >instance-data     ;
+
+: instance-2value  ( d.initial-value -- )
+   create-cf use-actions  /n 2* value#,  2!
+;
+
+
 headers
 : buffer:  \ name  ( size -- )
    header noop  \ Will patch with (buffer:)
@@ -951,6 +966,24 @@
 ;
 patch (value) noop value
 
+3 actions
+action:  >initial-value 2@  ;
+action:  >initial-value 2!  ;
+action:  >initial-value     ;
+
+: package-2value  ( initial-value -- )
+   create-cf use-actions  2 /n* value#,  2!
+;
+
+: (2value)  ( initial-value -- )
+   instance?  if
+      instance-2value
+   else
+     package?  if  package-2value  else  2value-cf  2 /n* user#, 2!  then
+   then
+;
+patch (2value) noop 2value
+
 headers
 : my-args  ( -- adr len )  my-args-adr my-args-len  ;