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