/*
* misc_helpers.sli
*
* This file is part of NEST.
*
* Copyright (C) 2004 The NEST Initiative
*
* NEST is free software: you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation, either version 2 of the License, or
* (at your option) any later version.
*
* NEST is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with NEST. If not, see <http://www.gnu.org/licenses/>.
*
*/
/*
A library of handy SLI-routines
*/
%----------------------------------------------------------------------------
/* BeginDocumentation
Name: message - Display an information message
Synopsis:
(Message) Priority message -> -
Priority (From) (Message) message ->
where "Priority" may be any positive integer, or one of the following:
M_DEBUG, M_STATUS, M_INFO, M_WARNING, M_ERROR, M_FATAL
Description:
Display a message, if priority is higher than current verbosity-level.
message uses the message mechanism which is provided
by the SLIInterpreter class.
The output consists of a time-stamp (date and time), the name of the
calling function, the priority level and the message text.
% month dd hh:mm::ss from[pl] messagetext
Where
month - abbreviated month (Jan-Dec)
dd - day in month (01-31)
hh - hour (00-23)
mm - minute (00-61)
ss - seconds (00-61)
from - name of the caller, defaults to (SLI) in the short form
pl - priority level of the message
The time-stamp is useful during long-running simulations.
All output is sent to the stream defined in M_OUT which is
set to cout by default.
The verbosity level can be controlled by the functions
verbosity and setverbosity. For compatibility, the function
shutupto is still supported as alias to setverbosity.
Parameters:
In : (MyMessage: Message to display
Priority : Priority level of message (integer).
Opt: (From) : Name of the caller of class of message.
Examples: Short form:
1. (Still alive) M_DEBUG message
issues something like
% Jul 21 16:23:12 SLI[5] Still alive
1. (Something happened) M_STATUS message
issues something like
% Jul 21 16:23:12 SLI[5] Still alive
3. (Your last action had no effect) M_INFO message
issues something like
% Jul 21 16:24:12 SLI[10] Your last action had no effect
4. (Result may be invalid) M_WARNING message
issues something like
% Jul 21 16:24:24 SLI[20] Result may be invalid
5. (This should never happen!) M_ERROR message
issues something like
% Jul 21 16:24:36 SLI[30] This should never happen!
6. (It's all broken, let's go home.) M_FATAL message
issues something like
% Jul 21 16:24:36 SLI[40] It's all broken, let's go home.
Long form:
1. M_DEBUG (DEBUGMESSAGE) (This should never happen!) message
issues something like
% Jul 21 16:24:36 DEBUGMESSAGE[30] This should never happen!
Depending on the verbosity-level, the output may be suppressed.
Bugs:
Author: R Kupper,
M.O. Gewaltig,
FirstVersion: Apr 9 1999
Remarks:
M_* values are defined in system dictionary.
You may introduce new priority levels in the user dictionary if convenient.
Standard values are: M_ALL = 0
M_DEBUG = 5
M_STATUS = 7
M_INFO = 10
M_WARNING = 20
M_ERROR = 30
M_FATAL = 40
M_QUIET = 100
Standard output: M_OUT = cout
SeeAlso: setverbosity
*/
% Define constants and variables used by message/shutupto
systemdict begin %this is unnessessary, if misc_helpers.sli is called from sli-init.sli
% but that's not sure, and it won't harm anyway...
%Define error levels:
/M_ALL 0 def
/M_DEBUG 5 def
/M_STATUS 7 def
/M_INFO 10 def
/M_WARNING 20 def
/M_ERROR 30 def
/M_FATAL 40 def
/M_QUIET 100 def
end %systemdict
/message trie
[/stringtype /integertype]
{
exch (SLI) exch message_
} bind addtotrie
[ /integertype /stringtype /stringtype]
{
message_
} bind addtotrie
def
%----------------------------------------------------------------------------
/* BeginDocumentation
Name: setverbosity - Set verbosity level for message
shutupto - Set quiet level for message
Synopsis:
VerbosityLevel setverbosity -> -
M_DEBUG setverbosity -> -
M_STATUS setverbosity -> -
M_INFO setverbosity -> -
M_WARNING setverbosity -> -
M_ERROR setverbosity -> -
M_FATAL setverbosity -> -
Description:
Set verbosity level for message.
Only messages of priority equal to or greater than the specified
level will be issued by the "message" command.
Parameters:
VerbosityLevel:
The new verbosity-level for message-display (see "message").
You may use any poitive integer here. For conveniency,
there exist five predifined error levels in systemdict:
M_ALL=0, display all messages
M_DEBUG=5, display debugging messages and above
M_STATUS=7, display status messages and above
M_INFO=10, display information messages and above
M_WARNING=20, display warning messages and above
M_ERROR=30, display error messages and above
M_FATAL=40, display failure messages and above
M_QUIET=100, suppress all messages
Thus, by calling "M_WARNING=20 setverbosity" you
indicate that you are interested in seeing error messages and
more important messages only.
Side Effects: Change verbosity level of the SLI interpreter.
Examples:
1. M_INFO setverbosity
% Don't display any debugging- or status-messages, only informational and
% above.
2. M_ERROR setverbosity
% Do inform me about severe errors only.
Bugs:
Author: R Kupper
FirstVersion: Apr 9 1999,
Modified by Marc-Oliver Gewaltig, July 21 1999
Modified by Ruediger Kupper, March 19 2003
Remarks:
M_* values are defined in system dictionary.
You may introduce new priority levels in the user dictionary if convenient.
Standard values are: M_ALL = 0
M_DEBUG = 5
M_STATUS = 7
M_INFO = 10
M_WARNING = 20
M_ERROR = 30
M_FATAL = 40
M_QUIET = 100
Standard output: M_OUT = cout
SeeAlso: message, verbosity
*/
/shutupto trie
[/integertype] /setverbosity_i load addtotrie
def
/*
%----------------------------------------------------------------------------
/* BeginDocumentation
Name: trim - Delete leading/trailing elements in a container.
Synopsis: MyStr Character Flag={0|1|2} trim -> TrimmedStr
MyArr Element Flag={0|1|2} trim -> TrimmedArr
Description: The trim function returns a copy of MyStr (MyArr) with
leading and/or trailing Characters (Elements) removed.
Parameters: In : MyStr(string): The String to be strimmed
MyArr(array): The array to be trimmed
Optional In: Character(string): The character to remove
Element(any) : The element to remove
Flag(int) : A value that controls the action
of trim. If Flag is zero,
trailing elements are removed.
Leading elements are removed if it is
equal to 1. Both are removed if it is
equal to 2.
Out: TrimmedStr(string)/TrimmedArr(array):
a copy of MyStr (MyArr) with
leading and/or trailing Characters (Elements) removed.
Examples: (--hello-you---) (-) 0 trim -> (hello-you---)
(--hello-you---) (-) 1 trim -> (--hello-you)
(--hello-you---) (-) 2 trim -> (hello-you)
Bugs: array-type-trie doesn't work (why?)
Author: R Kupper
FirstVersion: Apr 10 1999
Remarks: Inspired by IDL's STRTRIM-Function.
If Flag doesn't equal 0, 1 or 2, it defaults to 0 and
a warning message is issued
If trim is called on an empty container, a debugging message is issued
Set shutup-level to hide messages! (see shutup)
Procedure: a. Flag=0: Scan string for first non-occurance of character,
then delete string up to this position.
b. Flag=1 executes a. on the reversed string
c. Flag=3 executes a. and b.
SeeAlso: reverse, message
*/
% This function will work for strings AND for arrays, as search does:
/trim_sa
{% stack: str char flag
dup dup 0 lt exch 2 gt or {(trim: WARNING - Flag not 0,1,2. Assuming 0.) M_WARNING message pop 0} if
%stack: str char flag
2 index size 0 eq %stack: str char flag str {true|false}
%check for empty str:
{% str is the empty string
%stack: str char flag str
(trim: DEBUG-INFO - Trim was called on an empty container. No action.) M_DEBUG message 3 npop
%stack: str
}
{% str is not empty
% stack: str char flag str
pop
% stack: str char flag
dup 0 eq % stack: str char flag {true|false}
{%flag=0, stack: str char 0
pop %stack: str char
exch dup %stack: char str str
size exch %stack: char str size str
size 1 sub %stack: char str size str (size-1)
0 exch 1 exch %stack: char str size str 0 1 (size-1)
{
%loop entry - stack: char str size str i
exch 1 index %stack: char str size i str i
get %stack: char str size i str[i]
4 index %stack: char str size i str[i] char
eq %stack: char str size i {true|false}
{ %str[i] equals char. Do nothing.
%stack: char str size i
pop 1 index %stack: char str size str
}
{ %str[i] is first character unequal to char:
%leave i on the stack and exit for-loop
%stack: char str size i
exch pop 1 index %stack: char str i str
exit % exit for-loop.
}
ifelse
}
for
%at this point, the stack will be
% char str i str, if no-char was found at position i
% char str size str, if no-char was NOT found at all (i.e. str is a string of chars)
% so all we have to do, is erase up to the given position:
pop 0 exch %stack: char str 0 {i|size}
erase %stack: char resultstr ,where resultstr may be the empty string.
exch pop %stack: resultstr
% READY!
}%end: flag=0
{
1 eq % stack: str char {true|false}
{%flag=1, stack: str char
exch
reverse
exch
0 trim_sa % execute trim 0 on reversed string
reverse
}%end: flag=1
{%flag=2, stack: str char
exch 1 index %stack: char str char
0 trim_sa %stack: char newstr
exch 1 trim_sa % 2 is a combination of 0 and 1
}%end: flag=2
ifelse
}
ifelse
} % end: str was not the empty string
ifelse
}
bind def
/trim trie
[/stringtype /stringtype /integertype] { exch 0 get exch trim_sa } bind addtotrie %if character is given as string, change to ASCII-code
[/stringtype /integertype /integertype] /trim_sa load addtotrie %string, ASCII-code, flag
[/arraytype /anytype /integertype] /trim_sa load addtotrie
def
%----------------------------------------------------------------------------
/* BeginDocumentation
Name: breakup - Break a string or an array at given Substrings or SubArrays, or to given lengths.
Synopsis: MyStr BreakStr breakup -> StrArr
MyArr BreakArr breakup -> ArrArr
MyStr SecLen breakup -> StrArr
MyArr SecLen breakup -> ArrArr
Description: Break a string or an array at given Substrings or SubArrays, or to sections
of given length. In the latter case, the last section may be shorter, if
the section length does not evenly divide the string/array length.
Parameters: In : MyStr(string)/MyArr(array): String/Array to break up.
BreakStr(string)/BreakArr(array): Substring/Subarray defining break points.
SecLen(int): Length of sections to form
Out: StrArr(array of strings)/ArrArr(array of arrays): array of partial strings/arrays (see example below)
Examples: 1. (home/kupper/synod) (/) breakup -> [(home) (kupper) (synod)]
2. (Theresnospaceinhere) ( ) breakup -> [(Theresnospaceinhere)]
3. [23 5 0 17 0] [0] breakup -> [ [23 5] [17] [] ]
4. [23 5 0 17 0] [5 0] breakup -> [ [23] [17 0] ]
5. (abcdef) 3 breakup -> [(abc) (def)]
6. (abcdef) 4 breakup -> [(abcd) (ef)]
7 [1 2 3 4] 2 breakup -> [[1 2] [3 4]]
Bugs:
Author: R Kupper, H E Plesser
FirstVersion: Apr 10 1999
Remarks: Inspired by IDL's STRBREAK-function
Procedure: Recursive call of "search"
SeeAlso: trim
*/
% This function will work for strings AND for arrays, as search does:
/breakup_sa
{
% stack: str be array
3 1 roll % stack: array str be
search % break at first occurence of breaking element
% stack: array strend be {strbegin true|false}
{
% element found
4 -1 roll exch % stack: strend be array strbegi
append %stack: strend be array
breakup_sa % RECURSION!
}
{
%element not found
append %that's it!
}
ifelse
}
bind def
/breakup_sa_i
{
/seclen Set
empty
{
1 arraystore
}
{
/strarr Set
[ 0 strarr length 1 sub seclen ] { seclen strarr rollu getinterval } Table
} ifelse
} bind def
/breakup trie
[/stringtype /stringtype] { [] breakup_sa } addtotrie
[/arraytype /arraytype ] { [] breakup_sa } addtotrie
[/stringtype /integertype] { breakup_sa_i } addtotrie
[/arraytype /integertype] { breakup_sa_i } addtotrie
def
%----------------------------------------------------------------------------
/* BeginDocumentation
Name: reverse - Reverse a string or array.
Synopsis: MyStr reverse -> rtSyM
MyArr reverse -> rrAyM
Description: Reverse a string or array.
Parameters: In : MyStr(string)/MyArr(array)
Out: rtSyM(string)/rrAyM(array): The reverse of MyStr/MyArr
Examples: (Madam I'm Adam) reverse -> (madA m'I madaM)
(Lagerregal) reverse -> (lagerregaL)
(Aide-moi o media) reverse -> (aidem o iom-ediA)
[1 2 3] reverse -> [3 2 1]
Bugs:
Author: R Kupper
FirstVersion: Apr 11 1999
Remarks: There is no "forallindexed" for strings. why?
Apr 13 1999:
-Name changed from "revert" to "reverse" on Apr 13 1999.-
-Name "revert" will still be valid, but will issue a warning message.-
String-Handling has been changed to a call to the C++-coded function "Revert".
The command "Reverse" can also be used for arrays.
SeeAlso: trim
*/
% This function will work for strings AND for arrays, as search does:
/reverse_sa
{
%stack: str / arr
container %stack: str () / arr []
1 index %stack: str () str
size exch pop %stack: str () size
reserve %reserve enough space in new container
%stack: str ()
exch %stack: () str
{
%stack: () str[i]
prepend
}
forall
}
bind def
/reverse trie
[/stringtype] /reverse_sa load addtotrie
%There already is a C++-coded version called "Reverse" for Arrays:
%[/arraytype] /reverse_sa load addtotrie
[/arraytype] /Reverse load addtotrie
def
%----------------------------------------------------------------------------
/revert
{
(WARNING: "revert"-function has been ranamed to "reverse" on Apr 13 1999.\n Change call to "reverse" to avoid this warning message!)
M_WARNING message
reverse
}
def
/* BeginDocumentation
Name: searchif - check wether a substring is contained within a string
Synopsis: string1 string2 searchif -> bool
array1 array2 searchif -> bool
Description:
calls search and removes the substrings/-arrays generated
thereby. Neither string/array will be conserved (!),
bool contains success or failure.
Parameters: string1/array1: The object where to search into.
string2/array2: The subobject to look for.
bool is true on success, otherwise false
Examples: (Hello world!) (Hello) searchif -> true
[1 3 2 5 2] [3 2] searchif -> true
Bugs: Does not have optimal performance; search creates subobjects
which are not needed for serachif.
Author: Hehl
FirstVersion: April 15, 1999
Remarks:
SeeAlso: search
*/
/searchif_sa
{
exch dup 3 -1 roll % save string1
search % search
{
4 npop true % success: do some clean up
}
{
pop pop false % failure: somewhat less to cleanup
} ifelse
} bind def
/searchif trie
[/stringtype /stringtype] /searchif_sa load addtotrie
[/arraytype /arraytype] /searchif_sa load addtotrie
def
/*
BeginDocumentation
Name: oldgetline - "old", ignorant version of getline
Synopsis: istream getline -> istream string
Description:
Reads a string from the supplied stream. If an error occured
during the read process, an empty string is returned.
This function is for compatibility. Eventually, all
occurences of oldgetline should convert to the new,
more save version of getline.
Diagnostics: NO ERRORS are raised!
Author: Marc-Oliver Gewaltig
FirstVersion: July 9 1999
Remarks:
SeeAlso: getline, readline
*/
/oldgetline
{
getline
not
{ () } if
} bind def
%----------------------------------------------------------------------------
/* BeginDocumentation
Name: ignore - ignore any waiting data on an istream
Synopsis: istream ignore -> istream
Description: "ignore" reads input form the given istream line by line
and discards it.
Parameters: In : istream: the stream to ignore data in.
Out: istream: " " " " " "
Diagnostics:
Examples: cin ignore
myfifo ignore
Bugs: -
Author: R Kupper
FirstVersion: 1999. New version using setNONBLOCK: Oct 22 1999
Remarks: After a call to "ignore", the state of the stream is always "good", and
blocking I/O is selected for that stream (O_NONBLOCK==false).
SeeAlso: available
*/
/ignore trie
[/istreamtype]
{
true setNONBLOCK % select non-blocking I/O
{% read until EOF
getline not {exit} if % read it
pop % forget it
} loop
iclear % reset streamstate to good
false setNONBLOCK % select blocking I/O
} bind
addtotrie
def
%----------------------------------------------------------------------------
/* BeginDocumentation
Name: CyclicValue - project a cyclic value onto it's norm interval (e.g. angle on [0,360))
Synopsis:
value [b1 b2] CyclicValue -> normvalue
value b1 b2 CyclicValue -> normvalue
See below for the meaning of b1, b2!
Description:
For a given value and a given norm interval, "CyclicValue" returns
the value's norm equivalent. This is useful for all values with a
cyclic definition, such as angles.
The output is always of type double, regardless of the input type.
Alternatives: Function CyclicValue_d_d_d if you use it with three doubles
(interval = double1 - double2), CyclicValue_d_a if you use it with
double and array (both undocumented) -> behaviour and synopsis are the same.
Parameters:
In : value: value in (-oo, oo)
b1, b2: norm interval.
This interval is half-open: [.), or (.], depending on
the following rules:
b1 must not equal b2.
b1 always denotes the closed end of the interval.
b2 always denotes the open end of the interval.
If b1<b2, the norm interval used is [b1,b2).
If b1>b2, the norm interval used is (b2,b1].
See below for examples.
Out: The value's norm equivalent in the interval [b1, b2).
The output is always of type double, regardless of the input
type.
Diagnostics:
b1 must not equal b2. This is not checked for efficency reasons!
If b1=b2, code will break with /DivisionByZero during execution.
Examples:
%% project angle in degrees onto [0,360):
-3601 [0 360] CyclicValue -> 359.0
%% project angle in radians onto [-pi,pi):
23.0 [Pi -1 mul Pi] CyclicValue -> -2.13274
%% this demonstrates the handling of open/closed interval ends:
%% project number onto [1,4):
1 [1 4] CyclicValue -> 1
2 [1 4] CyclicValue -> 2
3 [1 4] CyclicValue -> 3
4 [1 4] CyclicValue -> 1
%% project number onto (1,4]:
1 [4 1] CyclicValue -> 4
2 [4 1] CyclicValue -> 2
3 [4 1] CyclicValue -> 3
4 [4 1] CyclicValue -> 4
Author: Ruediger Kupper
FirstVersion: 13.3.2003
Remarks:
Variant *_d_d_d is fastest. Prefer this variant over *_d_a in time
critical applications.
Inspired by IDL/NASE commandfunction cyclic_value().
SeeAlso: mod, floor
*/
%% Shall be equivalent to the following IDL code:
%%
%%Function Cyclic_Value, val, int
%% min = int[0]
%% max = int[1]
%% interval = double(max-min)
%% return, val - floor(double(val-min)/interval)*interval
%%End
/CyclicValue_d_d_d
{
%stack: value min max
1 pick sub_dd
%stack: value min interval %%interval=max-min
dup_ rolld
%stack: value interval interval min
3 pick
%stack: value interval interval min value
exch sub_dd exch_ div_dd floor_d mul_dd sub_dd
} bind def
/CyclicValue_d_a
{
%stack: value_d [min max]
{double} Map arrayload pop
%stack: value_d min_d max_d
CyclicValue_d_d_d
} bind def
/CyclicValue [/doubletype /doubletype /doubletype] /CyclicValue_d_d_d load def
/CyclicValue [/doubletype /doubletype /integertype] {double_i CyclicValue_d_d_d} bind def
/CyclicValue [/doubletype /integertype /doubletype] {rollu double_i rolld CyclicValue_d_d_d} bind def
/CyclicValue [/integertype /doubletype /doubletype] {rolld double_i rollu CyclicValue_d_d_d} bind def
/CyclicValue [/doubletype /integertype /integertype] {double_i rollu double_i rolld CyclicValue_d_d_d} bind def
/CyclicValue [/integertype /integertype /doubletype] {rolld double_i rolld double_i rolld CyclicValue_d_d_d} bind def
/CyclicValue [/integertype /doubletype /integertype] {double_i rolld double_i rollu CyclicValue_d_d_d} bind def
/CyclicValue [/integertype /integertype /integertype] {double_i rolld double_i rolld double_i rolld CyclicValue_d_d_d} bind def
/CyclicValue [/integertype /arraytype] {exch_ double_i exch CyclicValue_d_a} bind def
/CyclicValue [/doubletype /arraytype] /CyclicValue_d_a load def
/* BeginDocumentation
Name: SLIFunctionWrapper - Define a SLI function with lots of comfort.
Synopsis:
/funcname [/trietypes] [/variablenames] {procedure} SLIFunctionWrapper -> FunctionResult
/funcname [/trietypes /variablenames] {procedure} SLIFunctionWrapper -> FunctionResult
Description:
SLIFunctionWrapper provides a very convenient way to define and manage
a SLI function. Much like the command "def", it has a way to
define the parameter list of the function. In addition, before the
actual routine is called, its parameters will be popped from the
stack and assigned to names, which then are provided to the
routine in a local dictionary. Furthermore, SLIFunctionWrapper
rids the user from the need to restore the operand stack before
raising an error, the routine will take care of that.
All this is achieved by putting the actual user routine inside a
wrapper routine, which is assigned to the given name. The wrapper
routine will perform all sorts of bureaucracy, then call the
actual routine, and clean up the stack if necessary afterwards.
The function's definition resembles the ones in C++.
Please see examples below for demonstrations.
IMPORTANT:
Please see remarks below for a SET OF RULES THE USER ROUTINE MUST
ADHERE TO!
Parameters:
/funcname - The function name (will be assigned to the
wrpper function).
[/trietypes
/variablenames] - List of parameters and their names. This may
either be two separate arrays of literals, the first one defining
the variable types, the second one their names, or
a single array of literals, consisting of pairs of
type and name. See examples below. The resulting call looks pretty
much like a function definition in C++.
{procedure} - The actual procedure to be called from the wrapper.
Examples:
The following defines a function called "myfunc", taking two arguments
of type integer and double. The function will have a type trie for
parameter typechacking, as well as a local dictionary. The arguments
will be known as "x" and "y" inside the local dictionary of the
function.
/myfunc [/integertype /x /doubletype /y]
{
(see how my local dictionary looks like:) = who
} SLIFunctionWrapper
The parameterlist could have also been specified like this:
/myfunc [/integertype /doubletype] [/x /y] {...} SLIFunctionWrapper
This defines functions expecting no parameters:
/f [] {...} SLIFunctionWrapper
/f2 [] [] {...} SLIFunctionWrapper
The routine can litter is local dictionary as it likes. The dictionary
will automatically be closed when the routine ends:
/f []
{
/this 23 def
/will 0.0 def
/be 1 def
/forgotten -3 def
} SLIFunctionWrapper
If the routine raises an error, the local dictionary is closed, and
the stack will be automatically restored to the condition it was
before the function call:
/f []
{
/myvar 0.0 def
% push rubbish on the stack:
1 2 3 4 5 6 7
% now raise an error:
funcname /Error raiseerror
} SLIFunctionWrapper
SLI ] (a) (b) f
Error: /Error in f
SLI [2] pstack
(b)
(a)
If a nested routine causes an error, the stack is NOT restored, and
the local dictionary is NOT closed:
/f []
{
/myvar 0.0 def
% push rubbish on the stack:
1 2 3 4 5 6 7
% now cause an error:
0 0 div
} SLIFunctionWrapper
SLI ] (a) (b) f
Error: /DivisionByZero in div_ii
SLI [12] who
--------------------------------------------------
Name Type Value
--------------------------------------------------
myvar doubletype 0
--------------------------------------------------
Total number of entries: 1
Diagnostics:
Several messages of priority M_DEBUG are issued to let the programmer
know what happens. They may be turned off using "setverbosity".
Author:
Ruediger Kupper
FirstVersion:
21.3.2003
Remarks:
Rules the user routine MUST adhere to:
The user routine must not leave any "mark" on the stack if it fails.
The user routine must not make any assumptions on the contents of the
stack, that lie deeper than the level at which it took control
The user routine must not modify any contents of the operand stack,
that lie deeper than the level at which it took control.
The user routine must restore the dictionary stack to the state it was
when it took control, before it ends or fails.
The user routine must not re-define the variable /funcname.
When raising an error, /funcname must be specified as the routine name
(i.e., the name that was specified in the call to SLIFunctionWrapper).
No "bind" is performed on the procedure. If namebinding is wanted, the
user has to call "bind" explicitely before passing the procedure.
The type-specifyer-array(s) may be empty, indicating that the routine
does not expect any parameters.
The following names are known by the user routine, being defined in an
enclosing dictionary (not the routine's local dictionary):
/funcname - The wrapper's name, as specified in the call to
SLIFunctionWrapper.
/localdict - The user routine's local dictionary.
It is already open when the routine takes control,
and shall not be closed by the user rotuine.
/n_params - Number of parameters to the user routine.
/rvarnames - Array containing the names of the local variables defined
in the local dictionary, in reversed order.
/function - The user routine object.
Convenience comes at a cost. The wrapper routine causes considerable
overhead. Do not use this technique for routines that will be used at
time-critical positions, e.g. inside loops.
Availability:
SLI2.0
References:
[1] Ruediger Kupper, SLI library management,
HRI-EU Report 06/05, Honda Research Institute Europe GmbH, 2006.
SeeAlso: def, raiseerror, setverbosity, SFWdumpparameters
*/
%% this is the version that takes separate arrays for variable types and names:
/SLIFunctionWrapper [/literaltype /arraytype /arraytype /proceduretype]
{
%stack: /functionname [trietypes] [variablenames] {procedure}
<< >> begin %use local variables for SLIFunctionWrapper
/function Set
reverse /rvarnames Set %% we need them in reversed order.
/trietypes Set
/funcname Set
trietypes length /n_params Set
%consistency check (length):
rvarnames length n_params neq
{
M_ERROR (SLIFunctionWrapper) (Trietype array and variable name array must be of same size.) message
end %use local variables for SLIFunctionWrapper
/SLIFunctionWrapper /DimensionMismatch raiseerror
} if
%consistency check (types)
trietypes {
type /literaltype neq
{
M_ERROR (SLIFunctionWrapper) (Trietype array must contain literals only.) message
end %use local variables for SLIFunctionWrapper
/SLIFunctionWrapper /TypeMismatch raiseerror
} if
} forall
rvarnames {
type /literaltype neq
{
M_ERROR (SLIFunctionWrapper) (Variable name array must contain literals only.) message
end %use local variables for SLIFunctionWrapper
/SLIFunctionWrapper /TypeMismatch raiseerror
} if
} forall
%end consistency checks
% we now will define the wrapper routine that
% actually calls the user routine
M_DEBUG (SLIFunctionWrapper) (Defining wrapper ') funcname cvs join ('.) join message
funcname trietypes
%stack: funcname trietypes
% The following will be the function that is actually bound
% to the given name. We need a way to "hard code"
% the parameters that need to be know inside this procedure, but
% which are only known here, in SLIFunctionWrapper.
% The way to do this is to use "append" in order to construct the
% procedure.
{
%stack: var1 .. varn
% we use local variables in the wrapper:
<< >> begin
}
% now the trick to hard-code the parameters:
/funcname load append {/funcname Set} join
/n_params load append {/n_params Set} join
/rvarnames load append {/rvarnames Set} join
/function load cvlit append {cvx /function Set} join
% now the rest of the routine, which will be joined afterwards. It
% can now use the parameters "n_params", "rvarnames" and "function".
{
%stack: var1 .. varn
% we store the parameters in "our" dictionary,
% in order to have the originals in case of an error:
n_params arraystore /params Set
% we push a mark
mark
% we push the parameters again
params arrayload pop
%stack: mark var1 .. varn
% we give the user routine a "private" dictionary
% it will be known in the wrapper's dictionary by the name /localdict
/localdict << >> def
localdict begin
% in this private dictionary,
% we read the variables off the stack:
% (rvarnames contains the desired variable names in reverse order)
rvarnames {Set} forall
%stack: mark
% now call the user function, in a stopped context:
/function load stopped
{ % the function stopped!
%stack: mark lots-of-rubbish /name-of-routine-that-caused-error
% each error handler has to do this:
errordict /newerror false put
% There are two possibilities:
% 1. The error was raised by "our" routine.
% In this case, we need to restore the stack.
% 2. The error was unexpectedly raised in a routine
% that was called from "our" routine.
% In this case, the current state of the stack,
% as well as the local variables should stay as
% they are, to be inspected by the user.
%stack: mark lots-of-rubbish /name-of-routine-that-caused-error
funcname eq
{% error was raised by "our" routine:
% close its private dictionary
end
M_DEBUG (SLIFunctionWrapper) (User routine ') funcname cvs join (' stopped.) join message
M_DEBUG (SLIFunctionWrapper) (Reason: The routine raised an error.) message
M_DEBUG (SLIFunctionWrapper) (Action: Restoring the stack.) message
%stack: mark lots-of-rubbish
% throw away all the rubbish it left, including our mark.
counttomark 1 add_ii npop
%stack:
% restores the stack to the state before calling the
% function.
params arrayload pop
%stack: var1 .. varn
% close local variable dict of wrapper:
end
% "It is now safe to turn off the computer."
M_DEBUG (SLIFunctionWrapper) (Stack restored. Re-raising the error.) message
raiseagain
}
{ % error was raised by another routine:
M_WARNING (SLIFunctionWrapper) (User routine ') funcname cvs join (' stopped.) join message
M_WARNING (SLIFunctionWrapper) (Reason: A nested routine raised an error.) message
M_WARNING (SLIFunctionWrapper) (Action: Leaving stack and variable context unchanged for inspection.) message
M_DEBUG (SLIFunctionWrapper) (Re-raising the error.) message
M_ERROR (SLIFunctionWrapper) (In function ') funcname cvs join (':) join message
raiseagain
} ifelse
}
{
% the function operated normally.
%stack: mark valuable-results
% close its private dictionary
end
M_DEBUG (SLIFunctionWrapper) (User routine ') funcname cvs join (' exited normally.) join message
%stack: mark valuable-results
% remove the mark from the stack
counttomark 1 add_ii -1 roll pop
%stack: valuable-results
% close local variable dict of wrapper:
end
% "It is now safe to turn off the computer."
} ifelse
} join
%stack: functionname typetries {wrapperroutine}
end %local variables for SLIFunctionWrapper,
%because function shall be defined in the outer dict.
bind def
%okay, we defined the wrapper routine, that's it.
} bind def
%% this is the version that takes one array of combined variable types and names:
/SLIFunctionWrapper [/literaltype /arraytype /proceduretype]
{%stack: /functionname [type1 name1 ... typen namen] {procedure}
% first handle the special case of an empty array:
1 index length 0 eq
{ % parameter list is empty
[] exch % stack: /functionname [] [] {procedure}
SLIFunctionWrapper
}
{ % parameter list is not empty:
%stack: /functionname [type1 name1 ... typen namen] {procedure}
rollu
%stack: {procedure} /functionname [/type1 /name1 ... /typen /namen]
%consistency check (number of elements)
size dup 2 div 2 mul neq
{
M_ERROR (SLIFunctionWrapper) (Single variable array must consist of pairs: /variabletype /variablename.) message
/SLIFunctionWrapper /DimensionMismatch raiseerror
} if
%stack: {procedure} /functionname [/type1 /name1 ... /typen /namen]
%consistency check (types)
dup {
type /literaltype neq
{
M_ERROR (SLIFunctionWrapper) (Variable names and types must be literals only.) message
/SLIFunctionWrapper /TypeMismatch raiseerror
} if
} forall
%stack: {procedure} /functionname [/type1 /name1 .. /typen /namen]
% end consistency checks
% form separate name/type-arrays from the combined one and call the other form of SLIFunctionWrapper:
%stack: {procedure} /functionname [/type1 /name1 .. /typen /namen]
dup size 1 sub [ 0 rolld 2 ]
%stack: {procedure} /functionname [/type1 /name1 .. /typen /namen] [/type1 /name1 .. /typen /namen] [0 size-1 2]
Range get
%stack: {procedure} /functionname [/type1 /name1 .. /typen /namen] [/type1 .. /typen]
exch size 1 sub [ 1 rolld 2 ]
%stack: {procedure} /functionname [/type1 .. /typen] [/type1 /name1 .. /typen /namen] [1 size-1 2]
Range get
%stack: {procedure} /functionname [/type1 .. /typen] [/var1 .. /varn]
4 -1 roll
%stack: /functionname [/type1 .. /typen] [/var1 .. /varn] {procedure}
SLIFunctionWrapper
} ifelse
} bind def
/* BeginDocumentation
Name: SFWdumpparameters - Dump parameters of a SLIFunctionWrapper routine.
Synopsis: SWFdumpparameters -> -
Description:
Debugging aid for SLIFunctionWrapper. This routine can be called from
any routine defined using SLIFunctionWrapper. It
dumps all parameters and their values to the
standard output.
Examples:
/myfunc [/integertype /doubletype] [/x /y]
{ (hello) =
SFW_dumpparameters
(hello) =
} SLIFunctionWrapper
SLI ] 1 1.0 myfunc
hello
Dumping parameters for SLIFunctionWrapper routine /myfunc
y = 1.000000e+00
x = 1
hello
Diagnostics:
Issues a warning, if no enclosing SLIFunctionWrapper was found.
Author: R. Kupper
FirstVersion: 6-Dec-2006
References:
[1] Ruediger Kupper, SLI library management,
HRI-EU Report 06/05, Honda Research Institute Europe GmbH, 2006.
SeeAlso: SLIFunctionWrapper
*/
/SFWdumpparameters
{
/funcname lookup not
{
M_WARNING (SFWdumpparameters) (No enclosing SLIFunctionWrapper was found.) message
}
{
pop
(Dumping parameters for SLIFunctionWrapper routine ) =only funcname ==
rvarnames {dup ( ) =only =only ( = ) =only load ==} forall
} ifelse
} def
/* BeginDocumentation
Name: pageoutput - Display the output of a procedure through "page".
Synopsis: {procedure} pageoutput -> result_of_procedure
Description:
"pageoutput" executes the procedure that is passed as an argument. It
captures any printed output that the procedure generates and
displays it via the "page" command (see documentation of "page").
"pageoutput" redirects SLI's standard output at the level of the
file descriptor. This is a very low-level operation, and captures
*all* output that the SLI process sends to stdout. This includes any
output from SLI commands, from the simulation kernel, and all error
messages that go to stdout.
If the procedure raises an error, the error message is included in
the paged output, and the file descriptors are restored, so that
subsequent output goes to the SLI prompt again.
Examples:
{(This is my output.) =} pageoutput
{MemoryInfo} pageoutput
{whos} pageoutput
{mydir info} pageoutput
Bugs:
"pageoutput" creates a temporary file that is passed to the "page"
command. The pager may be executed in a subprocess of SLI. Since we
do not know how long it takes the pager process to open the file, we
cannot delete it right after calling "page". Hence, the temporary
file remains forever. Currently it is unclear how the temporary file
can be removed at a later time. This bug is filed as ticket #262.
Diagnostics:
Any error messages that the procedure raises go to the paged output.
In case of errors, the file descriptors are correctly restored.
Author: R Kupper
FirstVersion: 22-jul-2008
SeeAlso: page
*/
/pageoutput[/proceduretype /p]
{
% create two temporary files for writing:
/fname tmpnam def /f fname (w) file def
/gname tmpnam def /g gname (w) file def
% f will be the temporary storage for the cout file descriptor.
% duplicate systemdict::cout to f.
% (Subsequent writes to f would write to standard output, but we will not do this).
systemdict /cout get f dup2
% now duplicate g to systemdict::cout.
% Subsequent writes to standard output (even from the C-level) will go to file g.
g systemdict /cout get dup2
% now call the procedure. We catch all errors to restore the standard output in any case!
{p exec} stopped {handleerror} if % if there was an error, call the normal handler
f systemdict /cout get dup2 % restore previous destination of systemdict::cout
f close % close file f
fname DeleteFile pop % we don't need it any more
g close % close file g
gname page % show its contents
%gname DeleteFile pop
} SLIFunctionWrapper
/*
%% NOTE: There must be a carriage return after the last line in each file, i.e., here:
*/