Author: stepan Date: 2006-10-30 10:50:41 +0100 (Mon, 30 Oct 2006) New Revision: 102
Added: fcode-utils/localvalues/ fcode-utils/localvalues/GlobalLocalValues.fth fcode-utils/localvalues/GlobalLocalValuesDevel.fth fcode-utils/localvalues/LocalValuesDevelSupport.fth fcode-utils/localvalues/LocalValuesSupport.fth fcode-utils/localvalues/TotalLocalValuesSupport.fth Log: localvalues support, contributed by David Paktor dlpaktor@netscape.net
Added: fcode-utils/localvalues/GlobalLocalValues.fth =================================================================== --- fcode-utils/localvalues/GlobalLocalValues.fth (rev 0) +++ fcode-utils/localvalues/GlobalLocalValues.fth 2006-10-30 09:50:41 UTC (rev 102) @@ -0,0 +1,27 @@ +\ (C) Copyright 2005 IBM Corporation. All Rights Reserved. +\ Licensed under the Common Public License (CPL) version 1.0 +\ for full details see: +\ http://www.opensource.org/licenses/cpl1.0.php +\ +\ Module Author: David L. Paktor dlpaktor@us.ibm.com + +\ Load Locals Support under Global-Definitions. Bypass Instance warning + +\ Make sure this option is turned on. +[flag] Local-Values + +global-definitions + +\ Bypass warning about Instance without altering LocalValuesSupport file +alias generic-instance instance +[macro] bypass-instance f[ noop .( Bypassed instance!) f] + +overload alias instance bypass-instance + +fload LocalValuesSupport.fth + +\ Replace normal meaning of Instance, still in Global scope. +overload alias instance generic-instance + +\ Restore Device-Definitions scope. +device-definitions
Added: fcode-utils/localvalues/GlobalLocalValuesDevel.fth =================================================================== --- fcode-utils/localvalues/GlobalLocalValuesDevel.fth (rev 0) +++ fcode-utils/localvalues/GlobalLocalValuesDevel.fth 2006-10-30 09:50:41 UTC (rev 102) @@ -0,0 +1,30 @@ +\ (C) Copyright 2005 IBM Corporation. All Rights Reserved. +\ Licensed under the Common Public License (CPL) version 1.0 +\ for full details see: +\ http://www.opensource.org/licenses/cpl1.0.php +\ +\ Module Author: David L. Paktor dlpaktor@us.ibm.com + +\ Load Support file for development of FCode that uses Local Values +\ under Global-Definitions. Bypass Instance warning. +\ Replace this with GlobalLocalValues.fth in your final product. + +\ Make sure this option is turned on. +[flag] Local-Values + +global-definitions + +\ Bypass warning about Instance without altering LocalValuesSupport file +alias generic-instance instance +[macro] bypass-instance f[ noop .( Bypassed instance!) f] + +overload alias instance bypass-instance + +fload LocalValuesSupport.fth +fload LocalValuesDevelSupport.fth + +\ Replace normal meaning of Instance, still in Global scope. +overload alias instance generic-instance + +\ Restore Device-Definitions scope. +device-definitions
Added: fcode-utils/localvalues/LocalValuesDevelSupport.fth =================================================================== --- fcode-utils/localvalues/LocalValuesDevelSupport.fth (rev 0) +++ fcode-utils/localvalues/LocalValuesDevelSupport.fth 2006-10-30 09:50:41 UTC (rev 102) @@ -0,0 +1,45 @@ +\ (C) Copyright 2005 IBM Corporation. All Rights Reserved. +\ Licensed under the Common Public License (CPL) version 1.0 +\ for full details see: +\ http://www.opensource.org/licenses/cpl1.0.php +\ +\ Module Author: David L. Paktor dlpaktor@us.ibm.com + +\ Support file for development of FCode that uses Local Values +\ FLoad this right after LocalValuesSupport.fth +\ Remove it from your final product. + +\ Exported Function: max-local-storage-size ( -- n ) +\ Returns the measured maximum size of storage for Local Values +\ used by any given test run. This number can be used to guide +\ the declaration of _local-storage-size_ +\ +\ (C) Copyright 2005 IBM Corporation. All Rights Reserved. +\ Module Author: David L. Paktor dlpaktor@us.ibm.com + +\ Count the current depth on a per-instance basis, +\ but collect the maximum depth over all instances. + +headers +0 instance value local-storage-depth + +external +0 value max-local-storage-size +headers + +\ Overload the {push-locals} and {pop-locals} routines to do this. +\ Do not suppress the overload warnings; they'll serve as a reminder. +: {pop-locals} ( #locals -- ) + local-storage-depth over - to local-storage-depth + {pop-locals} +; + +: {push-locals} ( #ilocals #ulocals -- ) + 2dup + local-storage-depth + + dup to local-storage-depth + max-local-storage-size max + to max-local-storage-size + {push-locals} +; + +
Added: fcode-utils/localvalues/LocalValuesSupport.fth =================================================================== --- fcode-utils/localvalues/LocalValuesSupport.fth (rev 0) +++ fcode-utils/localvalues/LocalValuesSupport.fth 2006-10-30 09:50:41 UTC (rev 102) @@ -0,0 +1,133 @@ +\ (C) Copyright 2005 IBM Corporation. All Rights Reserved. +\ Licensed under the Common Public License (CPL) version 1.0 +\ for full details see: +\ http://www.opensource.org/licenses/cpl1.0.php +\ +\ Module Author: David L. Paktor dlpaktor@us.ibm.com + +\ The support routines for Local Values in FCode. + +\ Function imported +\ _local-storage-size_ \ Size, in cells, of backing store for locals +\ \ A constant. If not supplied, default value of d# 64 will be used. +\ +\ Functions exported: +\ {push-locals} ( #ilocals #ulocals -- ) +\ {pop-locals} ( #locals -- ) +\ _{local} ( local-var# -- addr ) +\ +\ Additional overloaded function: +\ catch \ Restore Locals after a throw + +\ The user is responsible for declaring the maximum depth of the +\ run-time Locals stack, in storage units, by defining the +\ constant _local-storage-size_ before floading this file. +\ The definition may be created either by defining it as a constant +\ in the startup-file that FLOADs this and other files in the +\ source program, or via a command-line user-symbol definition +\ of a form resembling: -d '_local-storage-size_=d# 42' +\ (be sure to enclose it within quotes so that the shell treats +\ it as a single string, and, of course, replace the "42" with +\ the actual number you need...) +\ If both forms are present, the command-line user-symbol value will +\ be used to create a duplicate definition of the named constant, +\ which will prevail over the earlier definition, and will remain +\ available for examination during development and testing. The +\ duplicate-name warning, which will not be suppressed, will also +\ act to alert the developer of this condition. +\ To measure the actual usage (in a test run), use the separate tool +\ found in the file LocalValuesDevelSupport.fth . +\ If the user omits defining _local-storage-size_ the following +\ ten-line sequence will supply a default: + +[ifdef] _local-storage-size_ + f[ [defined] _local-storage-size_ true ]f +[else] + [ifexist] _local-storage-size_ + f[ false ]f + [else] + f[ d# 64 true ]f + [then] +[then] ( Compile-time: size true | false ) +[if] fliteral constant _local-storage-size_ [then] + +_local-storage-size_ \ The number of storage units to allocate + cells \ Convert to address units + dup \ Keep a copy around... + ( n ) instance buffer: locals-storage \ Use one of the copies + +\ The Locals Pointer, added to the base address of locals-storage +\ points to the base-address of the currently active set of Locals. +\ Locals will be accessed as a positive offset from there. +\ Start the Locals Pointer at end of the buffer. +\ A copy of ( N ), the number of address units that were allocated +\ for the buffer, is still on the stack. Use it here. + ( n ) instance value locals-pointer + +\ Support for {push-locals} + +\ Error-check. +: not-enough-locals? ( #ilocals #ulocals -- error? ) + + cells locals-pointer swap - 0< +; + +\ Error message. +: .not-enough-locals ( -- ) + cr ." FATAL ERROR: Local Values Usage exceeds allocation." cr +; + +\ Detect, announce and handle error. +: check-enough-locals ( #ilocals #ulocals -- | <ABORT> ) + not-enough-locals? if + .not-enough-locals + abort + then +; + +\ The uninitialized locals can be allocated in a single batch +: push-uninitted-locals ( #ulocals -- ) + cells locals-pointer swap - to locals-pointer +; + +\ The Initialized locals are initted from the items on top of the stack +\ at the start of the routine. If we allocate them one at a time, +\ we get them into the right order. I.e., the last-one named gets +\ the top item, the earlier ones get successively lower items. +: push-one-initted-local ( pstack-item -- ) + locals-pointer 1 cells - + dup to locals-pointer + locals-storage + ! +; + +\ Push all the Initialized locals. +: push-initted-locals ( N_#ilocals-1 ... N_0 #ilocals -- ) + 0 ?do push-one-initted-local loop +; + +: {push-locals} ( N_#ilocals ... N_1 #ilocals #ulocals -- ) + 2dup check-enough-locals + push-uninitted-locals ( ..... #i ) + push-initted-locals ( ) +; + +\ Pop all the locals. +\ The param is the number to pop. +: {pop-locals} ( total#locals -- ) + cells locals-pointer + to locals-pointer +; + +\ The address from/to which values will be moved, given the local-var# +: _{local} ( local-var# -- addr ) + cells locals-pointer + locals-storage + +; + +\ We need to overload catch such that the state of the Locals Pointer +\ will be preserved and restored after a throw . +overload : catch ( ??? xt -- ???' false | ???'' throw-code ) + locals-pointer >r ( ??? xt ) ( R: old-locals-ptr ) + catch ( ???' false | ???'' throw-code ) ( R: old-locals-ptr ) + \ No need to inspect the throw-code. + \ If catch returned a zero, the Locals Pointer + \ is valid anyway, so restoring it is harmless. + r> to locals-pointer +;
Added: fcode-utils/localvalues/TotalLocalValuesSupport.fth =================================================================== --- fcode-utils/localvalues/TotalLocalValuesSupport.fth (rev 0) +++ fcode-utils/localvalues/TotalLocalValuesSupport.fth 2006-10-30 09:50:41 UTC (rev 102) @@ -0,0 +1,51 @@ +\ (C) Copyright 2005-2006 IBM Corporation. All Rights Reserved. +\ Licensed under the Common Public License (CPL) version 1.0 +\ for full details see: +\ http://www.opensource.org/licenses/cpl1.0.php +\ +\ Module Author: David L. Paktor dlpaktor@us.ibm.com + +\ Control file for loading of Local Values Support file with variants. +\ Command-line Symbol-definitions select whether the support will +\ be under Global-Definitions, and whether to include the extra +\ Development-time support features. +\ +\ The command-line symbols are: +\ Global-Locals +\ and +\ Locals-Release +\ +\ The default is device-node-specific support in a Development-time setting. +\ +\ If Global-Locals is defined, support will be under Global-Definitions +\ If Locals-Release is defined, this is a final production release run, +\ and the Development-time support features will be removed. + +\ Make sure this option is turned on. +[flag] Local-Values + +[ifdef] Global-Locals + \ Load Support file under Global-Definitions. + global-definitions + + \ Bypass warning about Instance without altering LocalValuesSupport file + alias generic-instance instance + [macro] bypass-instance f[ noop .( Bypassed instance!) f] + + overload alias instance bypass-instance +[endif] \ Global-Locals + +fload LocalValuesSupport.fth + +[ifndef] Locals-Release + \ Load Development-time support features + fload LocalValuesDevelSupport.fth +[endif] \ not Locals-Release + +[ifdef] Global-Locals + \ Replace normal meaning of Instance, still in Global scope. + overload alias instance generic-instance + + \ Restore Device-Definitions scope. + device-definitions +[endif] \ Global-Locals