File:
[gforth] /
gforth /
glocals.fs
Revision
1.4:
download - view:
text,
annotated -
select for diffs
Fri Jul 8 15:00:43 1994 UTC (29 years, 8 months ago) by
anton
Branches:
MAIN
CVS tags:
HEAD
signals are now translated into THROWs
A number of bug fixes (make a diff of BUGS for details)
added assert.fs and debugging.fs
made .s nicer
keep names of included files (in loadfilename) and print them upon error
1: \ Local variables are quite important for writing readable programs, but
2: \ IMO (anton) they are the worst part of the standard. There they are very
3: \ restricted and have an ugly interface.
4:
5: \ So, we implement the locals wordset, but do not recommend using
6: \ locals-ext (which is a really bad user interface for locals).
7:
8: \ We also have a nice and powerful user-interface for locals: locals are
9: \ defined with
10:
11: \ { local1 local2 ... }
12: \ or
13: \ { local1 local2 ... -- ... }
14: \ (anything after the -- is just a comment)
15:
16: \ Every local in this list consists of an optional type specification
17: \ and a name. If there is only the name, it stands for a cell-sized
18: \ value (i.e., you get the value of the local variable, not it's
19: \ address). The following type specifiers stand before the name:
20:
21: \ Specifier Type Access
22: \ W: Cell value
23: \ W^ Cell address
24: \ D: Double value
25: \ D^ Double address
26: \ F: Float value
27: \ F^ Float address
28: \ C: Char value
29: \ C^ Char address
30:
31: \ The local variables are initialized with values from the appropriate
32: \ stack. In contrast to the examples in the standard document our locals
33: \ take the arguments in the expected way: The last local gets the top of
34: \ stack, the second last gets the second stack item etc. An example:
35:
36: \ : CX* { F: Ar F: Ai F: Br F: Bi -- Cr Ci }
37: \ \ complex multiplication
38: \ Ar Br f* Ai Bi f* f-
39: \ Ar Bi f* Ai Br f* f+ ;
40:
41: \ There will also be a way to add user types, but it is not yet decided,
42: \ how. Ideas are welcome.
43:
44: \ Locals defined in this manner live until (!! see below).
45: \ Their names can be used during this time to get
46: \ their value or address; The addresses produced in this way become
47: \ invalid at the end of the lifetime.
48:
49: \ Values can be changed with TO, but this is not recomended (TO is a
50: \ kludge and words lose the single-assignment property, which makes them
51: \ harder to analyse).
52:
53: \ As for the internals, we use a special locals stack. This eliminates
54: \ the problems and restrictions of reusing the return stack and allows
55: \ to store floats as locals: the return stack is not guaranteed to be
56: \ aligned correctly, but our locals stack must be float-aligned between
57: \ words.
58:
59: \ Other things about the internals are pretty unclear now.
60:
61: \ Currently locals may only be
62: \ defined at the outer level and TO is not supported.
63:
64: include float.fs
65: include search-order.fs
66:
67: : compile-@local ( n -- )
68: case
69: 0 of postpone @local0 endof
70: 4 of postpone @local4 endof
71: 8 of postpone @local8 endof
72: 12 of postpone @local12 endof
73: ( otherwise ) dup postpone @local# ,
74: endcase ;
75:
76: : compile-f@local ( n -- )
77: case
78: 0 of postpone f@local0 endof
79: 8 of postpone f@local8 endof
80: ( otherwise ) dup postpone f@local# ,
81: endcase ;
82:
83: \ the locals stack grows downwards (see primitives)
84: \ of the local variables of a group (in braces) the leftmost is on top,
85: \ i.e. by going onto the locals stack the order is reversed.
86: \ there are alignment gaps if necessary.
87: \ lp must have the strictest alignment (usually float) across calls;
88: \ for simplicity we align it strictly for every group.
89:
90: vocabulary locals \ this contains the local variables
91: ' locals >body ' locals-list >body !
92:
93: create locals-buffer 1000 allot \ !! limited and unsafe
94: \ here the names of the local variables are stored
95: \ we would have problems storing them at the normal dp
96:
97: variable locals-dp \ so here's the special dp for locals.
98:
99: : alignlp-w ( n1 -- n2 )
100: \ cell-align size and generate the corresponding code for aligning lp
101: aligned dup adjust-locals-size ;
102:
103: : alignlp-f ( n1 -- n2 )
104: faligned dup adjust-locals-size ;
105:
106: \ a local declaration group (the braces stuff) is compiled by calling
107: \ the appropriate compile-pushlocal for the locals, starting with the
108: \ righmost local; the names are already created earlier, the
109: \ compile-pushlocal just inserts the offsets from the frame base.
110:
111: : compile-pushlocal-w ( a-addr -- ) ( run-time: w -- )
112: \ compiles a push of a local variable, and adjusts locals-size
113: \ stores the offset of the local variable to a-addr
114: locals-size @ alignlp-w cell+ dup locals-size !
115: swap !
116: postpone >l ;
117:
118: : compile-pushlocal-f ( a-addr -- ) ( run-time: f -- )
119: locals-size @ alignlp-f float+ dup locals-size !
120: swap !
121: postpone f>l ;
122:
123: : compile-pushlocal-d ( a-addr -- ) ( run-time: w1 w2 -- )
124: locals-size @ alignlp-w cell+ cell+ dup locals-size !
125: swap !
126: postpone swap postpone >l postpone >l ;
127:
128: : compile-pushlocal-c ( a-addr -- ) ( run-time: w -- )
129: -1 chars compile-lp+!
130: locals-size @ swap !
131: postpone lp@ postpone c! ;
132:
133: : create-local ( " name" -- a-addr )
134: \ defines the local "name"; the offset of the local shall be stored in a-addr
135: create
136: immediate
137: here 0 , ( place for the offset ) ;
138:
139: : lp-offset ( n1 -- n2 )
140: \ converts the offset from the frame start to an offset from lp and
141: \ i.e., the address of the local is lp+locals_size-offset
142: locals-size @ swap - ;
143:
144: : lp-offset, ( n -- )
145: \ converts the offset from the frame start to an offset from lp and
146: \ adds it as inline argument to a preceding locals primitive
147: lp-offset , ;
148:
149: vocabulary locals-types \ this contains all the type specifyers, -- and }
150: locals-types definitions
151:
152: : W:
153: create-local ( "name" -- a-addr xt )
154: \ xt produces the appropriate locals pushing code when executed
155: ['] compile-pushlocal-w
156: does> ( Compilation: -- ) ( Run-time: -- w )
157: \ compiles a local variable access
158: @ lp-offset compile-@local ;
159:
160: : W^
161: create-local ( "name" -- a-addr xt )
162: ['] compile-pushlocal-w
163: does> ( Compilation: -- ) ( Run-time: -- w )
164: postpone laddr# @ lp-offset, ;
165:
166: : F:
167: create-local ( "name" -- a-addr xt )
168: ['] compile-pushlocal-f
169: does> ( Compilation: -- ) ( Run-time: -- w )
170: @ lp-offset compile-f@local ;
171:
172: : F^
173: create-local ( "name" -- a-addr xt )
174: ['] compile-pushlocal-f
175: does> ( Compilation: -- ) ( Run-time: -- w )
176: postpone laddr# @ lp-offset, ;
177:
178: : D:
179: create-local ( "name" -- a-addr xt )
180: ['] compile-pushlocal-d
181: does> ( Compilation: -- ) ( Run-time: -- w )
182: postpone laddr# @ lp-offset, postpone 2@ ;
183:
184: : D^
185: create-local ( "name" -- a-addr xt )
186: ['] compile-pushlocal-d
187: does> ( Compilation: -- ) ( Run-time: -- w )
188: postpone laddr# @ lp-offset, ;
189:
190: : C:
191: create-local ( "name" -- a-addr xt )
192: ['] compile-pushlocal-c
193: does> ( Compilation: -- ) ( Run-time: -- w )
194: postpone laddr# @ lp-offset, postpone c@ ;
195:
196: : C^
197: create-local ( "name" -- a-addr xt )
198: ['] compile-pushlocal-c
199: does> ( Compilation: -- ) ( Run-time: -- w )
200: postpone laddr# @ lp-offset, ;
201:
202: \ you may want to make comments in a locals definitions group:
203: ' \ alias \ immediate
204: ' ( alias ( immediate
205:
206: forth definitions
207:
208: \ the following gymnastics are for declaring locals without type specifier.
209: \ we exploit a feature of our dictionary: every wordlist
210: \ has it's own methods for finding words etc.
211: \ So we create a vocabulary new-locals, that creates a 'w:' local named x
212: \ when it is asked if it contains x.
213:
214: also locals-types
215:
216: : new-locals-find ( caddr u w -- nfa )
217: \ this is the find method of the new-locals vocabulary
218: \ make a new local with name caddr u; w is ignored
219: \ the returned nfa denotes a word that produces what W: produces
220: \ !! do the whole thing without nextname
221: drop nextname
222: ['] W: >name ;
223:
224: previous
225:
226: : new-locals-reveal ( -- )
227: true abort" this should not happen: new-locals-reveal" ;
228:
229: create new-locals-map ' new-locals-find A, ' new-locals-reveal A,
230:
231: vocabulary new-locals
232: new-locals-map ' new-locals >body cell+ A! \ !! use special access words
233:
234: variable old-dpp
235:
236: \ and now, finally, the user interface words
237: : { ( -- addr wid 0 )
238: dp old-dpp !
239: locals-dp dpp !
240: also new-locals
241: also get-current locals definitions locals-types
242: 0 TO locals-wordlist
243: 0 postpone [ ; immediate
244:
245: locals-types definitions
246:
247: : } ( addr wid 0 a-addr1 xt1 ... -- )
248: \ ends locals definitions
249: ] old-dpp @ dpp !
250: begin
251: dup
252: while
253: execute
254: repeat
255: drop
256: locals-size @ alignlp-f locals-size ! \ the strictest alignment
257: set-current
258: previous previous
259: locals-list TO locals-wordlist ;
260:
261: : -- ( addr wid 0 ... -- )
262: }
263: [char] } word drop ;
264:
265: forth definitions
266:
267: \ A few thoughts on automatic scopes for locals and how they can be
268: \ implemented:
269:
270: \ We have to combine locals with the control structures. My basic idea
271: \ was to start the life of a local at the declaration point. The life
272: \ would end at any control flow join (THEN, BEGIN etc.) where the local
273: \ is lot live on both input flows (note that the local can still live in
274: \ other, later parts of the control flow). This would make a local live
275: \ as long as you expected and sometimes longer (e.g. a local declared in
276: \ a BEGIN..UNTIL loop would still live after the UNTIL).
277:
278: \ The following example illustrates the problems of this approach:
279:
280: \ { z }
281: \ if
282: \ { x }
283: \ begin
284: \ { y }
285: \ [ 1 cs-roll ] then
286: \ ...
287: \ until
288:
289: \ x lives only until the BEGIN, but the compiler does not know this
290: \ until it compiles the UNTIL (it can deduce it at the THEN, because at
291: \ that point x lives in no thread, but that does not help much). This is
292: \ solved by optimistically assuming at the BEGIN that x lives, but
293: \ warning at the UNTIL that it does not. The user is then responsible
294: \ for checking that x is only used where it lives.
295:
296: \ The produced code might look like this (leaving out alignment code):
297:
298: \ >l ( z )
299: \ ?branch <then>
300: \ >l ( x )
301: \ <begin>:
302: \ >l ( y )
303: \ lp+!# 8 ( RIP: x,y )
304: \ <then>:
305: \ ...
306: \ lp+!# -4 ( adjust lp to <begin> state )
307: \ ?branch <begin>
308: \ lp+!# 4 ( undo adjust )
309:
310: \ The BEGIN problem also has another incarnation:
311:
312: \ AHEAD
313: \ BEGIN
314: \ x
315: \ [ 1 CS-ROLL ] THEN
316: \ { x }
317: \ ...
318: \ UNTIL
319:
320: \ should be legal: The BEGIN is not a control flow join in this case,
321: \ since it cannot be entered from the top; therefore the definition of x
322: \ dominates the use. But the compiler processes the use first, and since
323: \ it does not look ahead to notice the definition, it will complain
324: \ about it. Here's another variation of this problem:
325:
326: \ IF
327: \ { x }
328: \ ELSE
329: \ ...
330: \ AHEAD
331: \ BEGIN
332: \ x
333: \ [ 2 CS-ROLL ] THEN
334: \ ...
335: \ UNTIL
336:
337: \ In this case x is defined before the use, and the definition dominates
338: \ the use, but the compiler does not know this until it processes the
339: \ UNTIL. So what should the compiler assume does live at the BEGIN, if
340: \ the BEGIN is not a control flow join? The safest assumption would be
341: \ the intersection of all locals lists on the control flow
342: \ stack. However, our compiler assumes that the same variables are live
343: \ as on the top of the control flow stack. This covers the following case:
344:
345: \ { x }
346: \ AHEAD
347: \ BEGIN
348: \ x
349: \ [ 1 CS-ROLL ] THEN
350: \ ...
351: \ UNTIL
352:
353: \ If this assumption is too optimistic, the compiler will warn the user.
354:
355: \ Implementation: migrated to kernal.fs
356:
357: \ THEN (another control flow from before joins the current one):
358: \ The new locals-list is the intersection of the current locals-list and
359: \ the orig-local-list. The new locals-size is the (alignment-adjusted)
360: \ size of the new locals-list. The following code is generated:
361: \ lp+!# (current-locals-size - orig-locals-size)
362: \ <then>:
363: \ lp+!# (orig-locals-size - new-locals-size)
364:
365: \ Of course "lp+!# 0" is not generated. Still this is admittedly a bit
366: \ inefficient, e.g. if there is a locals declaration between IF and
367: \ ELSE. However, if ELSE generates an appropriate "lp+!#" before the
368: \ branch, there will be none after the target <then>.
369:
370: \ explicit scoping
371:
372: : scope ( -- scope )
373: cs-push-part scopestart ; immediate
374:
375: : endscope ( scope -- )
376: scope?
377: drop
378: locals-list @ common-list
379: dup list-size adjust-locals-size
380: locals-list ! ; immediate
381:
382: \ adapt the hooks
383:
384: : locals-:-hook ( sys -- sys addr xt n )
385: \ addr is the nfa of the defined word, xt its xt
386: DEFERS :-hook
387: last @ lastcfa @
388: clear-leave-stack
389: 0 locals-size !
390: locals-buffer locals-dp !
391: 0 locals-list !
392: dead-code off
393: defstart ;
394:
395: : locals-;-hook ( sys addr xt sys -- sys )
396: def?
397: 0 TO locals-wordlist
398: 0 adjust-locals-size ( not every def ends with an exit )
399: lastcfa ! last !
400: DEFERS ;-hook ;
401:
402: ' locals-:-hook IS :-hook
403: ' locals-;-hook IS ;-hook
404:
405: \ The words in the locals dictionary space are not deleted until the end
406: \ of the current word. This is a bit too conservative, but very simple.
407:
408: \ There are a few cases to consider: (see above)
409:
410: \ after AGAIN, AHEAD, EXIT (the current control flow is dead):
411: \ We have to special-case the above cases against that. In this case the
412: \ things above are not control flow joins. Everything should be taken
413: \ over from the live flow. No lp+!# is generated.
414:
415: \ !! The lp gymnastics for UNTIL are also a real problem: locals cannot be
416: \ used in signal handlers (or anything else that may be called while
417: \ locals live beyond the lp) without changing the locals stack.
418:
419: \ About warning against uses of dead locals. There are several options:
420:
421: \ 1) Do not complain (After all, this is Forth;-)
422:
423: \ 2) Additional restrictions can be imposed so that the situation cannot
424: \ arise; the programmer would have to introduce explicit scoping
425: \ declarations in cases like the above one. I.e., complain if there are
426: \ locals that are live before the BEGIN but not before the corresponding
427: \ AGAIN (replace DO etc. for BEGIN and UNTIL etc. for AGAIN).
428:
429: \ 3) The real thing: i.e. complain, iff a local lives at a BEGIN, is
430: \ used on a path starting at the BEGIN, and does not live at the
431: \ corresponding AGAIN. This is somewhat hard to implement. a) How does
432: \ the compiler know when it is working on a path starting at a BEGIN
433: \ (consider "{ x } if begin [ 1 cs-roll ] else x endif again")? b) How
434: \ is the usage info stored?
435:
436: \ For now I'll resort to alternative 2. When it produces warnings they
437: \ will often be spurious, but warnings should be rare. And better
438: \ spurious warnings now and then than days of bug-searching.
439:
440: \ Explicit scoping of locals is implemented by cs-pushing the current
441: \ locals-list and -size (and an unused cell, to make the size equal to
442: \ the other entries) at the start of the scope, and restoring them at
443: \ the end of the scope to the intersection, like THEN does.
444:
445:
446: \ And here's finally the ANS standard stuff
447:
448: : (local) ( addr u -- )
449: \ a little space-inefficient, but well deserved ;-)
450: \ In exchange, there are no restrictions whatsoever on using (local)
451: \ as long as you use it in a definition
452: dup
453: if
454: nextname POSTPONE { [ also locals-types ] W: } [ previous ]
455: else
456: 2drop
457: endif ;
458:
459: : >definer ( xt -- definer )
460: \ this gives a unique identifier for the way the xt was defined
461: \ words defined with different does>-codes have different definers
462: \ the definer can be used for comparison and in definer!
463: dup >code-address [ ' bits >code-address ] Literal =
464: \ !! this definition will not work on some implementations for `bits'
465: if \ if >code-address delivers the same value for all does>-def'd words
466: >does-code 1 or \ bit 0 marks special treatment for does codes
467: else
468: >code-address
469: then ;
470:
471: : definer! ( definer xt -- )
472: \ gives the word represented by xt the behaviour associated with definer
473: over 1 and if
474: does-code!
475: else
476: code-address!
477: then ;
478:
479: \ !! untested
480: : TO ( c|w|d|r "name" -- )
481: \ !! state smart
482: 0 0 0. 0.0e0 { c: clocal w: wlocal d: dlocal f: flocal }
483: ' dup >definer
484: state @
485: if
486: case
487: [ ' locals-wordlist >definer ] literal \ value
488: OF >body POSTPONE Aliteral POSTPONE ! ENDOF
489: [ ' clocal >definer ] literal
490: OF POSTPONE laddr# >body @ lp-offset, POSTPONE c! ENDOF
491: [ ' wlocal >definer ] literal
492: OF POSTPONE laddr# >body @ lp-offset, POSTPONE ! ENDOF
493: [ ' dlocal >definer ] literal
494: OF POSTPONE laddr# >body @ lp-offset, POSTPONE d! ENDOF
495: [ ' flocal >definer ] literal
496: OF POSTPONE laddr# >body @ lp-offset, POSTPONE f! ENDOF
497: abort" can only store TO value or local value"
498: endcase
499: else
500: [ ' locals-wordlist >definer ] literal =
501: if
502: >body !
503: else
504: abort" can only store TO value"
505: endif
506: endif ; immediate
507:
508: \ : locals|
509: \ !! should lie around somewhere
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>