File: [local] / OpenXM / src / kan96xx / Kan / var.sm1 (download)
Revision 1.4, Thu Sep 16 23:53:44 2004 UTC (20 years ago) by takayama
Branch: MAIN
CVS Tags: R_1_3_1-2, RELEASE_1_3_1_13b, RELEASE_1_2_3_12, RELEASE_1_2_3, KNOPPIX_2006, HEAD, DEB_REL_1_2_3-9 Changes since 1.3: +2 -2
lines
Several small changes.
1. Changed an algorithm of oxGenPass.
2. The operator "." is equivalent to "exec" when the argument is an executable
array. Example. { 1 2 add }. message
3. The function [(or_attrs) literal] extension is added.
In strictMode in var.sm1, or_attrs is called instead of chattrs to
protect all pre-defined symbols. The function strictMode is called
from k0 when it starts.
|
% $OpenXM: OpenXM/src/kan96xx/Kan/var.sm1,v 1.4 2004/09/16 23:53:44 takayama Exp $
%% start of var.sm1. 1997, 2/27
%%(type in initv to initialize the variable stack and type in test.var to start a test) message
(var.sm1 : Version 3/7, 1997) message
%% Execute debugMode to override pushVariables and popVariables by
%% localVariables and restroreVariables.
/sm1.var.Verbose 0 def
/@@@.quiet.var 1 def
@@@.quiet.var { }
{ (var.sm1 (module for debugging): Version 3/7, 1997. cf. strictMode, debugMode) message } ifelse
/db.initVariableStack {
1000 newstack /db.VariableStack set
} def
/localVariables {
{ dup [ 3 1 roll load ] } map /db.arg0 set
db.VariableStack setstack db.arg0 stdstack
} def
/restoreVariables {
db.VariableStack setstack
% dup print
{ aload pop def } map pop
stdstack
} def
/db.where {
db.VariableStack setstack
pstack
stdstack
} def
/db.clear {
db.VariableStack setstack
/db.arg1 [(StackPointer) ] system_variable 2 sub def
%% arg1 print
0 1 db.arg1
{
pop pop
} for
stdstack
} def
/db.restore { %% You cannot use local variable in this function.
db.VariableStack setstack
/db.arg1 [(StackPointer) ] system_variable 2 sub def
0 1 db.arg1
{
pop /db.variableArray set
sm1.var.Verbose { db.variableArray print } { } ifelse
db.variableArray isArray
{ db.variableArray length 0 gt
{
db.variableArray { aload pop def } map pop
}
{ } ifelse
}
%%% Don't call restoreVariables. Otherwise, stack is set to stdstack.
{ } ifelse
} for
stdstack
} def
/db.initDebugStack { 1000 newstack /db.DebugStack set } def
/db.where.ds {
db.DebugStack setstack
pstack
stdstack
} def
/db.clear.ds {
db.DebugStack setstack
/db.arg1 [(StackPointer) ] system_variable 2 sub def
%% arg1 print
0 1 db.arg1
{
pop pop
} for
stdstack
} def
/db.initErrorStack {
[(ErrorStack)] system_variable /db.ErrorStack set
} def
/db.where.es {
db.ErrorStack setstack
/db.arg1 [(StackPointer) ] system_variable 2 sub def
%% db.arg1 print
0 1 db.arg1
{
pop rc message
%% pop rc message %% This caused coredump for %%Warning:The identifier...
%% This bug was a mistery. (1997, 3/1)
%% Perhaps you do not output dollar sign, you get the core.
%% I found the missing "%s" in the function printObject() and fixed the
%% bug.
} for
stdstack
} def
/db.clear.es {
db.ErrorStack setstack
/db.arg1 [(StackPointer) ] system_variable 2 sub def
%% arg1 print
0 1 db.arg1
{
pop pop
} for
stdstack
} def
%%% Usages.
[(db.where)
[(db.where shows the db.VariableStack)
(cf. localVariables, restoreVariables,)
( db.clear, db.restore, db.where.ds, db.where.es, debugMode)
]
] putUsages
[(db.clear)
[(db.clear cleans db.VariableStack)
(cf. db.restore, db.where, db.clear.ds, db.clear.es, debugMode)
]
] putUsages
[(db.restore)
[(db.restore recovers bindings of variables by reading db.VariableStack)
(cf. localVariables, restoreVariables,)
( db.clear, db.where , debugMode)
]
] putUsages
[(db.where.ds)
[(db.where.ds shows the db.DebugStack)
(db.DebugStack is used by kan/k? to get error lines.)
(cf. db.clear.ds, db.where, debugMode)
]
] putUsages
[(db.clear.ds)
[(db.clear.ds cleans db.DebugStack)
(cf. db.where.ds, db.clear, debugMode)
]
] putUsages
[(db.where.es)
[(db.where.es shows the db.ErrorStack)
(Error and warning messages are put in db.ErrorStack when the global)
(variables ErrorMessageMode or WarningMessageMode are set to 1 or 2.)
(cf. db.where, system_variable)
]
] putUsages
[(db.clear.es)
[(db.clear.es cleans db.ErrorStack)
(cf. db.clear, db.where.es)
]
] putUsages
[(localVariables)
[(This function is as same as pushVariables, but it pushes the variable to)
(db.VariableStack)
(cf. db.where, pushVariables, restoreVariables, debugMode)
]
] putUsages
[(restoreVariables)
[(This function is as same as popVariables, but it pops the variable from)
(db.VariableStack)
(cf. db.where, popVariables, localVariables, debugMode)
]
] putUsages
/initv { db.initVariableStack db.initDebugStack db.initErrorStack } def
initv
%% (initv is executed.) message
/db.pop.es {
db.ErrorStack setstack
/db.arg1 set
stdstack
db.arg1
} def
/db.pop.ds {
db.DebugStack setstack
/db.arg1 set
stdstack
db.arg1
} def
/db.push.ds {
/db.arg1 set
db.DebugStack setstack
db.arg1
stdstack
} def
%%% if you like rigorous naming system execute the following command.
/strictMode {
[(Strict2) 1] system_variable
[(or_attrs) 1] extension
[(chattr) 0 /arg1] extension
[(chattr) 0 /arg2] extension
[(chattr) 0 /arg3] extension
[(chattr) 0 /v1] extension %% used in join.
[(chattr) 0 /v2] extension
[(chattr) 0 /@.usages] extension
[(chattr) 0 /@@@expand.arg1] extension
[(chattr) 0 /f-expand] extension
[(chattr) 0 /f-ans] extension
[(chattr) 0 /in-expand] extension
@@@.quiet.var { }
{ (var.sm1 : Strict control of the name space is enabled. (cf. extension)) message }
ifelse
} def
[(strictMode)
[(StrictMode enables the protection for an unexpected redefinition)]
] putUsages
/debugMode {
/pushVariables { localVariables } def
/popVariables { restoreVariables } def
} def
[(debugMode)
[(debugMode overrides on the functions pushVariables and popVariables)
(and enables to use db.where. Never execute debugMode inside a block of)
(pushVariables and popVariables)
]
] putUsages
%%%% Test Codes.
/foo1 {
/arg1 set
[/n /val] localVariables
/n arg1 def
n 2 le
{
/val 1 def
}
{
/val n 1 sub foo1 n 2 sub foo1 add def
} ifelse
/arg1 val def
restoreVariables
arg1
} def
/test.var.1 {
(Now, we are testing new features ErrorStack of sm1 (1997, 3/1 )...) message
(ErrorStack:) message
[(ErrorStack)] system_variable /db.ErrorStack set
db.ErrorStack message
db.ErrorStack lc message
db.ErrorStack rc message
(ErrorMessageMode:) message
[(ErrorMessageMode)] system_variable message
[(ErrorMessageMode) 2 ] system_variable
[(WarningMessageMode) 2 ] system_variable
[(ErrorMessageMode)] system_variable message
(Cause an error with the mode 1) message
0 1 get %% The macro breaks here.
0 2 get
db.where.es
db.clear.es
db.where.es
[(ErrorMessageMode) 0 ] system_variable
[(ErrorMessageMode)] system_variable message
(Cause an error with the mode 0) message
0 1 get
0 2 get
db.where.es
} def
/test.var {
(Now, we are testing new features <<gb>> of sm1 (1997, 3/1 )...) message
[(x,y) ring_of_polynomials ( ) elimination_order 0] define_ring
[(isReducible) (x^2 y). (x y).] gb message
[(lcm) (x y). (y^2).] gb message
[(grade) (x^2 y). ] gb message
( --- 1 , xy^2, 3 OK? ----) message
(Computing isReducible for 1000 times.... ) messagen
{ 1 1 1000 { pop [(isReducible) (x^2 y). (x y).] gb pop } for
( ) message } timer
(Done) message
} def
%%% end of test codes.
%% end of var.sm1