r497 - trunk/openbios-devel/forth/device

Author: blueswirl
Date: 2009-05-24 13:04:06 +0200 (Sun, 24 May 2009)
New Revision: 497

Modified:
   trunk/openbios-devel/forth/device/package.fs
   trunk/openbios-devel/forth/device/table.fs
Log:
Implement push-package/pop-package (Mark Cave-Ayland)

Modified: trunk/openbios-devel/forth/device/package.fs
===================================================================
--- trunk/openbios-devel/forth/device/package.fs	2009-05-23 16:03:20 UTC (rev 496)
+++ trunk/openbios-devel/forth/device/package.fs	2009-05-24 11:04:06 UTC (rev 497)
@@ -252,3 +252,32 @@
   then
   s" map-out" $call-parent
   ;
+
+
+\ Deprecated functions (required for compatibility with older loaders)
+
+variable package-stack-pos 0 package-stack-pos !
+create package-stack 8 cells allot
+
+: push-package    ( phandle -- )
+  \ Throw an error if we attempt to push a full stack
+  package-stack-pos @ 8 >= if
+    ." cannot push-package onto full stack" cr
+    -99 throw
+  then
+  active-package
+  package-stack-pos @ /n * package-stack + !
+  package-stack-pos @ 1 + package-stack-pos !
+  active-package!
+  ;
+
+: pop-package    ( -- )
+  \ Throw an error if we attempt to pop an empty stack
+  package-stack-pos @ 0 = if
+    ." cannot pop-package from empty stack" cr
+    -99 throw
+  then
+  package-stack-pos @ 1 - package-stack-pos !
+  package-stack-pos @ /n * package-stack + @
+  active-package!
+  ;

Modified: trunk/openbios-devel/forth/device/table.fs
===================================================================
--- trunk/openbios-devel/forth/device/table.fs	2009-05-23 16:03:20 UTC (rev 496)
+++ trunk/openbios-devel/forth/device/table.fs	2009-05-24 11:04:06 UTC (rev 497)
@@ -280,7 +280,8 @@
   ['], ms
   ['], finish-device
   ['], decode-phys           \ 128
-  2 n['], reserved-fcode
+  ['], push-package
+  ['], pop-package
   ['], interpose             \ extension (recommended practice)
   4 n['], reserved-fcode
   ['], map-low