Annotation of OpenXM/src/kan96xx/Kan/var.sm1, Revision 1.2
1.2 ! takayama 1: % $OpenXM$
1.1 maekawa 2: %% start of var.sm1. 1997, 2/27
3: %%(type in initv to initialize the variable stack and type in test.var to start a test) message
4:
1.2 ! takayama 5: (var.sm1 : Version 3/7, 1997) message
! 6: %% Execute debugMode to override pushVariables and popVariables by
! 7: %% localVariables and restroreVariables.
! 8:
1.1 maekawa 9: /sm1.var.Verbose 0 def
10: /@@@.quiet.var 1 def
11: @@@.quiet.var { }
12: { (var.sm1 (module for debugging): Version 3/7, 1997. cf. strictMode, debugMode) message } ifelse
13:
14: /db.initVariableStack {
15: 1000 newstack /db.VariableStack set
16: } def
17:
18:
19: /localVariables {
20: { dup [ 3 1 roll load ] } map /db.arg0 set
21: db.VariableStack setstack db.arg0 stdstack
22: } def
23:
24: /restoreVariables {
25: db.VariableStack setstack
26: % dup print
27: { aload pop def } map pop
28: stdstack
29: } def
30:
31:
32:
33: /db.where {
34: db.VariableStack setstack
35: pstack
36: stdstack
37: } def
38:
39: /db.clear {
40: db.VariableStack setstack
41: /db.arg1 [(StackPointer) ] system_variable 2 sub def
42: %% arg1 print
43: 0 1 db.arg1
44: {
45: pop pop
46: } for
47: stdstack
48: } def
49:
50: /db.restore { %% You cannot use local variable in this function.
51: db.VariableStack setstack
52: /db.arg1 [(StackPointer) ] system_variable 2 sub def
53: 0 1 db.arg1
54: {
55: pop /db.variableArray set
56: sm1.var.Verbose { db.variableArray print } { } ifelse
57: db.variableArray isArray
58: { db.variableArray length 0 gt
59: {
60: db.variableArray { aload pop def } map pop
61: }
62: { } ifelse
63: }
64: %%% Don't call restoreVariables. Otherwise, stack is set to stdstack.
65: { } ifelse
66: } for
67: stdstack
68: } def
69:
70:
71:
72: /db.initDebugStack { 1000 newstack /db.DebugStack set } def
73:
74:
75: /db.where.ds {
76: db.DebugStack setstack
77: pstack
78: stdstack
79: } def
80:
81: /db.clear.ds {
82: db.DebugStack setstack
83: /db.arg1 [(StackPointer) ] system_variable 2 sub def
84: %% arg1 print
85: 0 1 db.arg1
86: {
87: pop pop
88: } for
89: stdstack
90: } def
91:
92:
93: /db.initErrorStack {
94: [(ErrorStack)] system_variable /db.ErrorStack set
95: } def
96:
97: /db.where.es {
98: db.ErrorStack setstack
99: /db.arg1 [(StackPointer) ] system_variable 2 sub def
100: %% db.arg1 print
101: 0 1 db.arg1
102: {
103: pop rc message
104: %% pop rc message %% This caused coredump for %%Warning:The identifier...
105: %% This bug was a mistery. (1997, 3/1)
106: %% Perhaps you do not output dollar sign, you get the core.
107: %% I found the missing "%s" in the function printObject() and fixed the
108: %% bug.
109: } for
110: stdstack
111: } def
112:
113:
114: /db.clear.es {
115: db.ErrorStack setstack
116: /db.arg1 [(StackPointer) ] system_variable 2 sub def
117: %% arg1 print
118: 0 1 db.arg1
119: {
120: pop pop
121: } for
122: stdstack
123: } def
124:
125: %%% Usages.
126:
127: [(db.where)
128: [(db.where shows the db.VariableStack)
129: (cf. localVariables, restoreVariables,)
130: ( db.clear, db.restore, db.where.ds, db.where.es, debugMode)
131: ]
132: ] putUsages
133:
134: [(db.clear)
135: [(db.clear cleans db.VariableStack)
136: (cf. db.restore, db.where, db.clear.ds, db.clear.es, debugMode)
137: ]
138: ] putUsages
139:
140: [(db.restore)
141: [(db.restore recovers bindings of variables by reading db.VariableStack)
142: (cf. localVariables, restoreVariables,)
143: ( db.clear, db.where , debugMode)
144: ]
145: ] putUsages
146:
147: [(db.where.ds)
148: [(db.where.ds shows the db.DebugStack)
149: (db.DebugStack is used by kan/k? to get error lines.)
150: (cf. db.clear.ds, db.where, debugMode)
151: ]
152: ] putUsages
153:
154: [(db.clear.ds)
155: [(db.clear.ds cleans db.DebugStack)
156: (cf. db.where.ds, db.clear, debugMode)
157: ]
158: ] putUsages
159:
160: [(db.where.es)
161: [(db.where.es shows the db.ErrorStack)
162: (Error and warning messages are put in db.ErrorStack when the global)
163: (variables ErrorMessageMode or WarningMessageMode are set to 1 or 2.)
164: (cf. db.where, system_variable)
165: ]
166: ] putUsages
167:
168: [(db.clear.es)
169: [(db.clear.es cleans db.ErrorStack)
170: (cf. db.clear, db.where.es)
171: ]
172: ] putUsages
173:
174: [(localVariables)
175: [(This function is as same as pushVariables, but it pushes the variable to)
176: (db.VariableStack)
177: (cf. db.where, pushVariables, restoreVariables, debugMode)
178: ]
179: ] putUsages
180:
181: [(restoreVariables)
182: [(This function is as same as popVariables, but it pops the variable from)
183: (db.VariableStack)
184: (cf. db.where, popVariables, localVariables, debugMode)
185: ]
186: ] putUsages
187:
188: /initv { db.initVariableStack db.initDebugStack db.initErrorStack } def
189: initv
190: %% (initv is executed.) message
191:
192: /db.pop.es {
193: db.ErrorStack setstack
194: /db.arg1 set
195: stdstack
196: db.arg1
197: } def
198:
199: /db.pop.ds {
200: db.DebugStack setstack
201: /db.arg1 set
202: stdstack
203: db.arg1
204: } def
205:
206: /db.push.ds {
207: /db.arg1 set
208: db.DebugStack setstack
209: db.arg1
210: stdstack
211: } def
212:
213:
214: %%% if you like rigorous naming system execute the following command.
215: /strictMode {
216: [(Strict2) 1] system_variable
217: [(chattrs) 1] extension
218: [(chattr) 0 /arg1] extension
219: [(chattr) 0 /arg2] extension
220: [(chattr) 0 /arg3] extension
221: [(chattr) 0 /v1] extension %% used in join.
222: [(chattr) 0 /v2] extension
223: [(chattr) 0 /@.usages] extension
224: @@@.quiet.var { }
225: { (var.sm1 : Strict control of the name space is enabled. (cf. extension)) message }
226: ifelse
227: } def
228: [(strictMode)
229: [(StrictMode enables the protection for an unexpected redefinition)]
230: ] putUsages
231:
232: /debugMode {
233: /pushVariables { localVariables } def
234: /popVariables { restoreVariables } def
235: } def
236: [(debugMode)
237: [(debugMode overrides on the functions pushVariables and popVariables)
1.2 ! takayama 238: (and enables to use db.where. Never execute debugMode inside a block of)
! 239: (pushVariables and popVariables)
1.1 maekawa 240: ]
241: ] putUsages
242:
243: %%%% Test Codes.
244: /foo1 {
245: /arg1 set
246: [/n /val] localVariables
247: /n arg1 def
248: n 2 le
249: {
250: /val 1 def
251: }
252: {
253: /val n 1 sub foo1 n 2 sub foo1 add def
254: } ifelse
255: /arg1 val def
256: restoreVariables
257: arg1
258: } def
259:
260: /test.var.1 {
261: (Now, we are testing new features ErrorStack of sm1 (1997, 3/1 )...) message
262: (ErrorStack:) message
263: [(ErrorStack)] system_variable /db.ErrorStack set
264: db.ErrorStack message
265: db.ErrorStack lc message
266: db.ErrorStack rc message
267: (ErrorMessageMode:) message
268: [(ErrorMessageMode)] system_variable message
269: [(ErrorMessageMode) 2 ] system_variable
270: [(WarningMessageMode) 2 ] system_variable
271: [(ErrorMessageMode)] system_variable message
272:
273: (Cause an error with the mode 1) message
274: 0 1 get %% The macro breaks here.
275: 0 2 get
276: db.where.es
277: db.clear.es
278: db.where.es
279:
280: [(ErrorMessageMode) 0 ] system_variable
281: [(ErrorMessageMode)] system_variable message
282:
283: (Cause an error with the mode 0) message
284: 0 1 get
285: 0 2 get
286: db.where.es
287: } def
288:
289: /test.var {
290: (Now, we are testing new features <<gb>> of sm1 (1997, 3/1 )...) message
291: [(x,y) ring_of_polynomials ( ) elimination_order 0] define_ring
292: [(isReducible) (x^2 y). (x y).] gb message
293: [(lcm) (x y). (y^2).] gb message
294: [(grade) (x^2 y). ] gb message
295: ( --- 1 , xy^2, 3 OK? ----) message
296: (Computing isReducible for 1000 times.... ) messagen
297: { 1 1 1000 { pop [(isReducible) (x^2 y). (x y).] gb pop } for
298: ( ) message } timer
299: (Done) message
300: } def
301: %%% end of test codes.
302: %% end of var.sm1
303:
304:
305:
306:
307:
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/cvsweb/back.gif){kind=icon}
Return to var.sm1 CVS log ![[TXT]](/icons/cvsweb/text.gif){kind=icon}
![[DIR]](/icons/cvsweb/dir.gif){kind=icon}
Up to [local] / OpenXM / src / kan96xx / Kan