1: \ A powerful locals implementation
2:
3: \ Copyright (C) 1995,1996,1997,1998,2000 Free Software Foundation, Inc.
4:
5: \ This file is part of Gforth.
6:
7: \ Gforth is free software; you can redistribute it and/or
8: \ modify it under the terms of the GNU General Public License
9: \ as published by the Free Software Foundation; either version 2
10: \ of the License, or (at your option) any later version.
11:
12: \ This program is distributed in the hope that it will be useful,
13: \ but WITHOUT ANY WARRANTY; without even the implied warranty of
14: \ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15: \ GNU General Public License for more details.
16:
17: \ You should have received a copy of the GNU General Public License
18: \ along with this program; if not, write to the Free Software
19: \ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111, USA.
20:
21:
22: \ More documentation can be found in the manual and in
23: \ http://www.complang.tuwien.ac.at/papers/ertl94l.ps.gz
24:
25: \ Local variables are quite important for writing readable programs, but
26: \ IMO (anton) they are the worst part of the standard. There they are very
27: \ restricted and have an ugly interface.
28:
29: \ So, we implement the locals wordset, but do not recommend using
30: \ locals-ext (which is a really bad user interface for locals).
31:
32: \ We also have a nice and powerful user-interface for locals: locals are
33: \ defined with
34:
35: \ { local1 local2 ... }
36: \ or
37: \ { local1 local2 ... -- ... }
38: \ (anything after the -- is just a comment)
39:
40: \ Every local in this list consists of an optional type specification
41: \ and a name. If there is only the name, it stands for a cell-sized
42: \ value (i.e., you get the value of the local variable, not it's
43: \ address). The following type specifiers stand before the name:
44:
45: \ Specifier Type Access
46: \ W: Cell value
47: \ W^ Cell address
48: \ D: Double value
49: \ D^ Double address
50: \ F: Float value
51: \ F^ Float address
52: \ C: Char value
53: \ C^ Char address
54:
55: \ The local variables are initialized with values from the appropriate
56: \ stack. In contrast to the examples in the standard document our locals
57: \ take the arguments in the expected way: The last local gets the top of
58: \ stack, the second last gets the second stack item etc. An example:
59:
60: \ : CX* { F: Ar F: Ai F: Br F: Bi -- Cr Ci }
61: \ \ complex multiplication
62: \ Ar Br f* Ai Bi f* f-
63: \ Ar Bi f* Ai Br f* f+ ;
64:
65: \ There will also be a way to add user types, but it is not yet decided,
66: \ how. Ideas are welcome.
67:
68: \ Locals defined in this manner live until (!! see below).
69: \ Their names can be used during this time to get
70: \ their value or address; The addresses produced in this way become
71: \ invalid at the end of the lifetime.
72:
73: \ Values can be changed with TO, but this is not recomended (TO is a
74: \ kludge and words lose the single-assignment property, which makes them
75: \ harder to analyse).
76:
77: \ As for the internals, we use a special locals stack. This eliminates
78: \ the problems and restrictions of reusing the return stack and allows
79: \ to store floats as locals: the return stack is not guaranteed to be
80: \ aligned correctly, but our locals stack must be float-aligned between
81: \ words.
82:
83: \ Other things about the internals are pretty unclear now.
84:
85: \ Currently locals may only be
86: \ defined at the outer level and TO is not supported.
87:
88: require search.fs
89: require float.fs
90: require extend.fs \ for case
91:
92: : compile-@local ( n -- ) \ gforth compile-fetch-local
93: case
94: 0 of postpone @local0 endof
95: 1 cells of postpone @local1 endof
96: 2 cells of postpone @local2 endof
97: 3 cells of postpone @local3 endof
98: ( otherwise ) dup postpone @local# ,
99: endcase ;
100:
101: : compile-f@local ( n -- ) \ gforth compile-f-fetch-local
102: case
103: 0 of postpone f@local0 endof
104: 1 floats of postpone f@local1 endof
105: ( otherwise ) dup postpone f@local# ,
106: endcase ;
107:
108: \ locals stuff needed for control structures
109:
110: : compile-lp+! ( n -- ) \ gforth compile-l-p-plus-store
111: dup negate locals-size +!
112: 0 over = if
113: else -1 cells over = if postpone lp-
114: else 1 floats over = if postpone lp+
115: else 2 floats over = if postpone lp+2
116: else postpone lp+!# dup ,
117: then then then then drop ;
118:
119: : adjust-locals-size ( n -- ) \ gforth
120: \ sets locals-size to n and generates an appropriate lp+!
121: locals-size @ swap - compile-lp+! ;
122:
123: \ the locals stack grows downwards (see primitives)
124: \ of the local variables of a group (in braces) the leftmost is on top,
125: \ i.e. by going onto the locals stack the order is reversed.
126: \ there are alignment gaps if necessary.
127: \ lp must have the strictest alignment (usually float) across calls;
128: \ for simplicity we align it strictly for every group.
129:
130: slowvoc @
131: slowvoc on \ we want a linked list for the vocabulary locals
132: vocabulary locals \ this contains the local variables
133: ' locals >body wordlist-id ' locals-list >body !
134: slowvoc !
135:
136: create locals-buffer 1000 allot \ !! limited and unsafe
137: \ here the names of the local variables are stored
138: \ we would have problems storing them at the normal dp
139:
140: variable locals-dp \ so here's the special dp for locals.
141:
142: : alignlp-w ( n1 -- n2 )
143: \ cell-align size and generate the corresponding code for aligning lp
144: aligned dup adjust-locals-size ;
145:
146: : alignlp-f ( n1 -- n2 )
147: faligned dup adjust-locals-size ;
148:
149: \ a local declaration group (the braces stuff) is compiled by calling
150: \ the appropriate compile-pushlocal for the locals, starting with the
151: \ righmost local; the names are already created earlier, the
152: \ compile-pushlocal just inserts the offsets from the frame base.
153:
154: : compile-pushlocal-w ( a-addr -- ) ( run-time: w -- )
155: \ compiles a push of a local variable, and adjusts locals-size
156: \ stores the offset of the local variable to a-addr
157: locals-size @ alignlp-w cell+ dup locals-size !
158: swap !
159: postpone >l ;
160:
161: \ locals list operations
162:
163: : common-list ( list1 list2 -- list3 ) \ gforth-internal
164: \ list1 and list2 are lists, where the heads are at higher addresses than
165: \ the tail. list3 is the largest sublist of both lists.
166: begin
167: 2dup u<>
168: while
169: 2dup u>
170: if
171: swap
172: then
173: @
174: repeat
175: drop ;
176:
177: : sub-list? ( list1 list2 -- f ) \ gforth-internal
178: \ true iff list1 is a sublist of list2
179: begin
180: 2dup u<
181: while
182: @
183: repeat
184: = ;
185:
186: : list-size ( list -- u ) \ gforth-internal
187: \ size of the locals frame represented by list
188: 0 ( list n )
189: begin
190: over 0<>
191: while
192: over
193: ((name>)) >body @ max
194: swap @ swap ( get next )
195: repeat
196: faligned nip ;
197:
198: : set-locals-size-list ( list -- )
199: dup locals-list !
200: list-size locals-size ! ;
201:
202: : check-begin ( list -- )
203: \ warn if list is not a sublist of locals-list
204: locals-list @ sub-list? 0= if
205: \ !! print current position
206: ." compiler was overly optimistic about locals at a BEGIN" cr
207: \ !! print assumption and reality
208: then ;
209:
210: : compile-pushlocal-f ( a-addr -- ) ( run-time: f -- )
211: locals-size @ alignlp-f float+ dup locals-size !
212: swap !
213: postpone f>l ;
214:
215: : compile-pushlocal-d ( a-addr -- ) ( run-time: w1 w2 -- )
216: locals-size @ alignlp-w cell+ cell+ dup locals-size !
217: swap !
218: postpone swap postpone >l postpone >l ;
219:
220: : compile-pushlocal-c ( a-addr -- ) ( run-time: w -- )
221: -1 chars compile-lp+!
222: locals-size @ swap !
223: postpone lp@ postpone c! ;
224:
225: : create-local ( " name" -- a-addr )
226: \ defines the local "name"; the offset of the local shall be
227: \ stored in a-addr
228: create
229: immediate restrict
230: here 0 , ( place for the offset ) ;
231:
232: : lp-offset ( n1 -- n2 )
233: \ converts the offset from the frame start to an offset from lp and
234: \ i.e., the address of the local is lp+locals_size-offset
235: locals-size @ swap - ;
236:
237: : lp-offset, ( n -- )
238: \ converts the offset from the frame start to an offset from lp and
239: \ adds it as inline argument to a preceding locals primitive
240: lp-offset , ;
241:
242: vocabulary locals-types \ this contains all the type specifyers, -- and }
243: locals-types definitions
244:
245: : W: ( "name" -- a-addr xt ) \ gforth w-colon
246: create-local
247: \ xt produces the appropriate locals pushing code when executed
248: ['] compile-pushlocal-w
249: does> ( Compilation: -- ) ( Run-time: -- w )
250: \ compiles a local variable access
251: @ lp-offset compile-@local ;
252:
253: : W^ ( "name" -- a-addr xt ) \ gforth w-caret
254: create-local
255: ['] compile-pushlocal-w
256: does> ( Compilation: -- ) ( Run-time: -- w )
257: postpone laddr# @ lp-offset, ;
258:
259: : F: ( "name" -- a-addr xt ) \ gforth f-colon
260: create-local
261: ['] compile-pushlocal-f
262: does> ( Compilation: -- ) ( Run-time: -- w )
263: @ lp-offset compile-f@local ;
264:
265: : F^ ( "name" -- a-addr xt ) \ gforth f-caret
266: create-local
267: ['] compile-pushlocal-f
268: does> ( Compilation: -- ) ( Run-time: -- w )
269: postpone laddr# @ lp-offset, ;
270:
271: : D: ( "name" -- a-addr xt ) \ gforth d-colon
272: create-local
273: ['] compile-pushlocal-d
274: does> ( Compilation: -- ) ( Run-time: -- w )
275: postpone laddr# @ lp-offset, postpone 2@ ;
276:
277: : D^ ( "name" -- a-addr xt ) \ gforth d-caret
278: create-local
279: ['] compile-pushlocal-d
280: does> ( Compilation: -- ) ( Run-time: -- w )
281: postpone laddr# @ lp-offset, ;
282:
283: : C: ( "name" -- a-addr xt ) \ gforth c-colon
284: create-local
285: ['] compile-pushlocal-c
286: does> ( Compilation: -- ) ( Run-time: -- w )
287: postpone laddr# @ lp-offset, postpone c@ ;
288:
289: : C^ ( "name" -- a-addr xt ) \ gforth c-caret
290: create-local
291: ['] compile-pushlocal-c
292: does> ( Compilation: -- ) ( Run-time: -- w )
293: postpone laddr# @ lp-offset, ;
294:
295: \ you may want to make comments in a locals definitions group:
296: ' \ alias \ ( compilation 'ccc<newline>' -- ; run-time -- ) \ core-ext,block-ext backslash
297: \G Comment till the end of the line if @code{BLK} contains 0 (i.e.,
298: \G while not loading a block), parse and discard the remainder of the
299: \G parse area. Otherwise, parse and discard all subsequent characters
300: \G in the parse area corresponding to the current line.
301: immediate
302:
303: ' ( alias ( ( compilation 'ccc<close-paren>' -- ; run-time -- ) \ core,file paren
304: \G Comment, usually till the next @code{)}: parse and discard all
305: \G subsequent characters in the parse area until ")" is
306: \G encountered. During interactive input, an end-of-line also acts as
307: \G a comment terminator. For file input, it does not; if the
308: \G end-of-file is encountered whilst parsing for the ")" delimiter,
309: \G Gforth will generate a warning.
310: immediate
311:
312: forth definitions
313:
314: \ the following gymnastics are for declaring locals without type specifier.
315: \ we exploit a feature of our dictionary: every wordlist
316: \ has it's own methods for finding words etc.
317: \ So we create a vocabulary new-locals, that creates a 'w:' local named x
318: \ when it is asked if it contains x.
319:
320: also locals-types
321:
322: : new-locals-find ( caddr u w -- nfa )
323: \ this is the find method of the new-locals vocabulary
324: \ make a new local with name caddr u; w is ignored
325: \ the returned nfa denotes a word that produces what W: produces
326: \ !! do the whole thing without nextname
327: drop nextname
328: ['] W: >head-noprim ;
329:
330: previous
331:
332: : new-locals-reveal ( -- )
333: true abort" this should not happen: new-locals-reveal" ;
334:
335: create new-locals-map ( -- wordlist-map )
336: ' new-locals-find A,
337: ' new-locals-reveal A,
338: ' drop A, \ rehash method
339: ' drop A,
340:
341: new-locals-map mappedwordlist Constant new-locals-wl
342:
343: \ slowvoc @
344: \ slowvoc on
345: \ vocabulary new-locals
346: \ slowvoc !
347: \ new-locals-map ' new-locals >body wordlist-map A! \ !! use special access words
348:
349: variable old-dpp
350:
351: \ and now, finally, the user interface words
352: : { ( -- lastxt wid 0 ) \ gforth open-brace
353: dp old-dpp !
354: locals-dp dpp !
355: lastxt get-current
356: get-order new-locals-wl swap 1+ set-order
357: also locals definitions locals-types
358: 0 TO locals-wordlist
359: 0 postpone [ ; immediate
360:
361: locals-types definitions
362:
363: : } ( lastxt wid 0 a-addr1 xt1 ... -- ) \ gforth close-brace
364: \ ends locals definitions
365: ] old-dpp @ dpp !
366: begin
367: dup
368: while
369: execute
370: repeat
371: drop
372: locals-size @ alignlp-f locals-size ! \ the strictest alignment
373: previous previous
374: set-current lastcfa !
375: locals-list 0 wordlist-id - TO locals-wordlist ;
376:
377: : -- ( addr wid 0 ... -- ) \ gforth dash-dash
378: }
379: [char] } parse 2drop ;
380:
381: forth definitions
382:
383: \ A few thoughts on automatic scopes for locals and how they can be
384: \ implemented:
385:
386: \ We have to combine locals with the control structures. My basic idea
387: \ was to start the life of a local at the declaration point. The life
388: \ would end at any control flow join (THEN, BEGIN etc.) where the local
389: \ is lot live on both input flows (note that the local can still live in
390: \ other, later parts of the control flow). This would make a local live
391: \ as long as you expected and sometimes longer (e.g. a local declared in
392: \ a BEGIN..UNTIL loop would still live after the UNTIL).
393:
394: \ The following example illustrates the problems of this approach:
395:
396: \ { z }
397: \ if
398: \ { x }
399: \ begin
400: \ { y }
401: \ [ 1 cs-roll ] then
402: \ ...
403: \ until
404:
405: \ x lives only until the BEGIN, but the compiler does not know this
406: \ until it compiles the UNTIL (it can deduce it at the THEN, because at
407: \ that point x lives in no thread, but that does not help much). This is
408: \ solved by optimistically assuming at the BEGIN that x lives, but
409: \ warning at the UNTIL that it does not. The user is then responsible
410: \ for checking that x is only used where it lives.
411:
412: \ The produced code might look like this (leaving out alignment code):
413:
414: \ >l ( z )
415: \ ?branch <then>
416: \ >l ( x )
417: \ <begin>:
418: \ >l ( y )
419: \ lp+!# 8 ( RIP: x,y )
420: \ <then>:
421: \ ...
422: \ lp+!# -4 ( adjust lp to <begin> state )
423: \ ?branch <begin>
424: \ lp+!# 4 ( undo adjust )
425:
426: \ The BEGIN problem also has another incarnation:
427:
428: \ AHEAD
429: \ BEGIN
430: \ x
431: \ [ 1 CS-ROLL ] THEN
432: \ { x }
433: \ ...
434: \ UNTIL
435:
436: \ should be legal: The BEGIN is not a control flow join in this case,
437: \ since it cannot be entered from the top; therefore the definition of x
438: \ dominates the use. But the compiler processes the use first, and since
439: \ it does not look ahead to notice the definition, it will complain
440: \ about it. Here's another variation of this problem:
441:
442: \ IF
443: \ { x }
444: \ ELSE
445: \ ...
446: \ AHEAD
447: \ BEGIN
448: \ x
449: \ [ 2 CS-ROLL ] THEN
450: \ ...
451: \ UNTIL
452:
453: \ In this case x is defined before the use, and the definition dominates
454: \ the use, but the compiler does not know this until it processes the
455: \ UNTIL. So what should the compiler assume does live at the BEGIN, if
456: \ the BEGIN is not a control flow join? The safest assumption would be
457: \ the intersection of all locals lists on the control flow
458: \ stack. However, our compiler assumes that the same variables are live
459: \ as on the top of the control flow stack. This covers the following case:
460:
461: \ { x }
462: \ AHEAD
463: \ BEGIN
464: \ x
465: \ [ 1 CS-ROLL ] THEN
466: \ ...
467: \ UNTIL
468:
469: \ If this assumption is too optimistic, the compiler will warn the user.
470:
471: \ Implementation:
472:
473: \ explicit scoping
474:
475: : scope ( compilation -- scope ; run-time -- ) \ gforth
476: cs-push-part scopestart ; immediate
477:
478: : adjust-locals-list ( wid -- )
479: locals-list @ common-list
480: dup list-size adjust-locals-size
481: locals-list ! ;
482:
483: : endscope ( compilation scope -- ; run-time -- ) \ gforth
484: scope?
485: drop adjust-locals-list ; immediate
486:
487: \ adapt the hooks
488:
489: : locals-:-hook ( sys -- sys addr xt n )
490: \ addr is the nfa of the defined word, xt its xt
491: DEFERS :-hook
492: last @ lastcfa @
493: clear-leave-stack
494: 0 locals-size !
495: locals-buffer locals-dp !
496: 0 locals-list !
497: dead-code off
498: defstart ;
499:
500: : locals-;-hook ( sys addr xt sys -- sys )
501: def?
502: 0 TO locals-wordlist
503: 0 adjust-locals-size ( not every def ends with an exit )
504: lastcfa ! last !
505: DEFERS ;-hook ;
506:
507: \ THEN (another control flow from before joins the current one):
508: \ The new locals-list is the intersection of the current locals-list and
509: \ the orig-local-list. The new locals-size is the (alignment-adjusted)
510: \ size of the new locals-list. The following code is generated:
511: \ lp+!# (current-locals-size - orig-locals-size)
512: \ <then>:
513: \ lp+!# (orig-locals-size - new-locals-size)
514:
515: \ Of course "lp+!# 0" is not generated. Still this is admittedly a bit
516: \ inefficient, e.g. if there is a locals declaration between IF and
517: \ ELSE. However, if ELSE generates an appropriate "lp+!#" before the
518: \ branch, there will be none after the target <then>.
519:
520: : (then-like) ( orig -- )
521: dead-orig =
522: if
523: >resolve drop
524: else
525: dead-code @
526: if
527: >resolve set-locals-size-list dead-code off
528: else \ both live
529: over list-size adjust-locals-size
530: >resolve
531: adjust-locals-list
532: then
533: then ;
534:
535: : (begin-like) ( -- )
536: dead-code @ if
537: \ set up an assumption of the locals visible here. if the
538: \ users want something to be visible, they have to declare
539: \ that using ASSUME-LIVE
540: backedge-locals @ set-locals-size-list
541: then
542: dead-code off ;
543:
544: \ AGAIN (the current control flow joins another, earlier one):
545: \ If the dest-locals-list is not a subset of the current locals-list,
546: \ issue a warning (see below). The following code is generated:
547: \ lp+!# (current-local-size - dest-locals-size)
548: \ branch <begin>
549:
550: : (again-like) ( dest -- addr )
551: over list-size adjust-locals-size
552: swap check-begin POSTPONE unreachable ;
553:
554: \ UNTIL (the current control flow may join an earlier one or continue):
555: \ Similar to AGAIN. The new locals-list and locals-size are the current
556: \ ones. The following code is generated:
557: \ ?branch-lp+!# <begin> (current-local-size - dest-locals-size)
558:
559: : (until-like) ( list addr xt1 xt2 -- )
560: \ list and addr are a fragment of a cs-item
561: \ xt1 is the conditional branch without lp adjustment, xt2 is with
562: >r >r
563: locals-size @ 2 pick list-size - dup if ( list dest-addr adjustment )
564: r> drop r> compile,
565: swap <resolve ( list adjustment ) ,
566: else ( list dest-addr adjustment )
567: drop
568: r> compile, <resolve
569: r> drop
570: then ( list )
571: check-begin ;
572:
573: : (exit-like) ( -- )
574: 0 adjust-locals-size ;
575:
576: ' locals-:-hook IS :-hook
577: ' locals-;-hook IS ;-hook
578:
579: ' (then-like) IS then-like
580: ' (begin-like) IS begin-like
581: ' (again-like) IS again-like
582: ' (until-like) IS until-like
583: ' (exit-like) IS exit-like
584:
585: \ The words in the locals dictionary space are not deleted until the end
586: \ of the current word. This is a bit too conservative, but very simple.
587:
588: \ There are a few cases to consider: (see above)
589:
590: \ after AGAIN, AHEAD, EXIT (the current control flow is dead):
591: \ We have to special-case the above cases against that. In this case the
592: \ things above are not control flow joins. Everything should be taken
593: \ over from the live flow. No lp+!# is generated.
594:
595: \ About warning against uses of dead locals. There are several options:
596:
597: \ 1) Do not complain (After all, this is Forth;-)
598:
599: \ 2) Additional restrictions can be imposed so that the situation cannot
600: \ arise; the programmer would have to introduce explicit scoping
601: \ declarations in cases like the above one. I.e., complain if there are
602: \ locals that are live before the BEGIN but not before the corresponding
603: \ AGAIN (replace DO etc. for BEGIN and UNTIL etc. for AGAIN).
604:
605: \ 3) The real thing: i.e. complain, iff a local lives at a BEGIN, is
606: \ used on a path starting at the BEGIN, and does not live at the
607: \ corresponding AGAIN. This is somewhat hard to implement. a) How does
608: \ the compiler know when it is working on a path starting at a BEGIN
609: \ (consider "{ x } if begin [ 1 cs-roll ] else x endif again")? b) How
610: \ is the usage info stored?
611:
612: \ For now I'll resort to alternative 2. When it produces warnings they
613: \ will often be spurious, but warnings should be rare. And better
614: \ spurious warnings now and then than days of bug-searching.
615:
616: \ Explicit scoping of locals is implemented by cs-pushing the current
617: \ locals-list and -size (and an unused cell, to make the size equal to
618: \ the other entries) at the start of the scope, and restoring them at
619: \ the end of the scope to the intersection, like THEN does.
620:
621:
622: \ And here's finally the ANS standard stuff
623:
624: : (local) ( addr u -- ) \ local paren-local-paren
625: \ a little space-inefficient, but well deserved ;-)
626: \ In exchange, there are no restrictions whatsoever on using (local)
627: \ as long as you use it in a definition
628: dup
629: if
630: nextname POSTPONE { [ also locals-types ] W: } [ previous ]
631: else
632: 2drop
633: endif ;
634:
635: : >definer ( xt -- definer )
636: \G @var{Definer} is a unique identifier for the way the @var{xt}
637: \G was defined. Words defined with different @code{does>}-codes
638: \G have different definers. The definer can be used for
639: \G comparison and in @code{definer!}.
640: dup >does-code
641: ?dup-if
642: nip 1 or
643: else
644: >code-address
645: then ;
646:
647: : definer! ( definer xt -- )
648: \G The word represented by @var{xt} changes its behaviour to the
649: \G behaviour associated with @var{definer}.
650: over 1 and if
651: swap [ 1 invert ] literal and does-code!
652: else
653: code-address!
654: then ;
655:
656: :noname
657: ' dup >definer [ ' locals-wordlist ] literal >definer =
658: if
659: >body !
660: else
661: -&32 throw
662: endif ;
663: :noname
664: 0 0 0. 0.0e0 { c: clocal w: wlocal d: dlocal f: flocal }
665: comp' drop dup >definer
666: case
667: [ ' locals-wordlist ] literal >definer \ value
668: OF >body POSTPONE Aliteral POSTPONE ! ENDOF
669: \ !! dependent on c: etc. being does>-defining words
670: \ this works, because >definer uses >does-code in this case,
671: \ which produces a relocatable address
672: [ comp' clocal drop >definer ] literal
673: OF POSTPONE laddr# >body @ lp-offset, POSTPONE c! ENDOF
674: [ comp' wlocal drop >definer ] literal
675: OF POSTPONE laddr# >body @ lp-offset, POSTPONE ! ENDOF
676: [ comp' dlocal drop >definer ] literal
677: OF POSTPONE laddr# >body @ lp-offset, POSTPONE 2! ENDOF
678: [ comp' flocal drop >definer ] literal
679: OF POSTPONE laddr# >body @ lp-offset, POSTPONE f! ENDOF
680: -&32 throw
681: endcase ;
682: interpret/compile: TO ( c|w|d|r "name" -- ) \ core-ext,local
683:
684: : locals|
685: \ don't use 'locals|'! use '{'! A portable and free '{'
686: \ implementation is compat/anslocals.fs
687: BEGIN
688: name 2dup s" |" compare 0<>
689: WHILE
690: (local)
691: REPEAT
692: drop 0 (local) ; immediate restrict
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>