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