1: \ A powerful locals implementation
2:
3: \ Copyright (C) 1995,1996,1997,1998,2000,2003,2004,2005,2007 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: also locals-types
314:
315: \ these "locals" are used for comparison in TO
316:
317: c: some-clocal 2drop
318: d: some-dlocal 2drop
319: f: some-flocal 2drop
320: w: some-wlocal 2drop
321:
322: \ the following gymnastics are for declaring locals without type specifier.
323: \ we exploit a feature of our dictionary: every wordlist
324: \ has it's own methods for finding words etc.
325: \ So we create a vocabulary new-locals, that creates a 'w:' local named x
326: \ when it is asked if it contains x.
327:
328: : new-locals-find ( caddr u w -- nfa )
329: \ this is the find method of the new-locals vocabulary
330: \ make a new local with name caddr u; w is ignored
331: \ the returned nfa denotes a word that produces what W: produces
332: \ !! do the whole thing without nextname
333: drop nextname
334: ['] W: >head-noprim ;
335:
336: previous
337:
338: : new-locals-reveal ( -- )
339: true abort" this should not happen: new-locals-reveal" ;
340:
341: create new-locals-map ( -- wordlist-map )
342: ' new-locals-find A,
343: ' new-locals-reveal A,
344: ' drop A, \ rehash method
345: ' drop A,
346:
347: new-locals-map mappedwordlist Constant new-locals-wl
348:
349: \ slowvoc @
350: \ slowvoc on
351: \ vocabulary new-locals
352: \ slowvoc !
353: \ new-locals-map ' new-locals >body wordlist-map A! \ !! use special access words
354:
355: variable old-dpp
356:
357: \ and now, finally, the user interface words
358: : { ( -- latestxt wid 0 ) \ gforth open-brace
359: dp old-dpp !
360: locals-dp dpp !
361: latestxt get-current
362: get-order new-locals-wl swap 1+ set-order
363: also locals definitions locals-types
364: 0 TO locals-wordlist
365: 0 postpone [ ; immediate
366:
367: locals-types definitions
368:
369: : } ( latestxt wid 0 a-addr1 xt1 ... -- ) \ gforth close-brace
370: \ ends locals definitions
371: ] old-dpp @ dpp !
372: begin
373: dup
374: while
375: execute
376: repeat
377: drop
378: locals-size @ alignlp-f locals-size ! \ the strictest alignment
379: previous previous
380: set-current lastcfa !
381: locals-list 0 wordlist-id - TO locals-wordlist ;
382:
383: : -- ( addr wid 0 ... -- ) \ gforth dash-dash
384: }
385: [char] } parse 2drop ;
386:
387: forth definitions
388:
389: \ A few thoughts on automatic scopes for locals and how they can be
390: \ implemented:
391:
392: \ We have to combine locals with the control structures. My basic idea
393: \ was to start the life of a local at the declaration point. The life
394: \ would end at any control flow join (THEN, BEGIN etc.) where the local
395: \ is lot live on both input flows (note that the local can still live in
396: \ other, later parts of the control flow). This would make a local live
397: \ as long as you expected and sometimes longer (e.g. a local declared in
398: \ a BEGIN..UNTIL loop would still live after the UNTIL).
399:
400: \ The following example illustrates the problems of this approach:
401:
402: \ { z }
403: \ if
404: \ { x }
405: \ begin
406: \ { y }
407: \ [ 1 cs-roll ] then
408: \ ...
409: \ until
410:
411: \ x lives only until the BEGIN, but the compiler does not know this
412: \ until it compiles the UNTIL (it can deduce it at the THEN, because at
413: \ that point x lives in no thread, but that does not help much). This is
414: \ solved by optimistically assuming at the BEGIN that x lives, but
415: \ warning at the UNTIL that it does not. The user is then responsible
416: \ for checking that x is only used where it lives.
417:
418: \ The produced code might look like this (leaving out alignment code):
419:
420: \ >l ( z )
421: \ ?branch <then>
422: \ >l ( x )
423: \ <begin>:
424: \ >l ( y )
425: \ lp+!# 8 ( RIP: x,y )
426: \ <then>:
427: \ ...
428: \ lp+!# -4 ( adjust lp to <begin> state )
429: \ ?branch <begin>
430: \ lp+!# 4 ( undo adjust )
431:
432: \ The BEGIN problem also has another incarnation:
433:
434: \ AHEAD
435: \ BEGIN
436: \ x
437: \ [ 1 CS-ROLL ] THEN
438: \ { x }
439: \ ...
440: \ UNTIL
441:
442: \ should be legal: The BEGIN is not a control flow join in this case,
443: \ since it cannot be entered from the top; therefore the definition of x
444: \ dominates the use. But the compiler processes the use first, and since
445: \ it does not look ahead to notice the definition, it will complain
446: \ about it. Here's another variation of this problem:
447:
448: \ IF
449: \ { x }
450: \ ELSE
451: \ ...
452: \ AHEAD
453: \ BEGIN
454: \ x
455: \ [ 2 CS-ROLL ] THEN
456: \ ...
457: \ UNTIL
458:
459: \ In this case x is defined before the use, and the definition dominates
460: \ the use, but the compiler does not know this until it processes the
461: \ UNTIL. So what should the compiler assume does live at the BEGIN, if
462: \ the BEGIN is not a control flow join? The safest assumption would be
463: \ the intersection of all locals lists on the control flow
464: \ stack. However, our compiler assumes that the same variables are live
465: \ as on the top of the control flow stack. This covers the following case:
466:
467: \ { x }
468: \ AHEAD
469: \ BEGIN
470: \ x
471: \ [ 1 CS-ROLL ] THEN
472: \ ...
473: \ UNTIL
474:
475: \ If this assumption is too optimistic, the compiler will warn the user.
476:
477: \ Implementation:
478:
479: \ explicit scoping
480:
481: : scope ( compilation -- scope ; run-time -- ) \ gforth
482: cs-push-part scopestart ; immediate
483:
484: : adjust-locals-list ( wid -- )
485: locals-list @ common-list
486: dup list-size adjust-locals-size
487: locals-list ! ;
488:
489: : endscope ( compilation scope -- ; run-time -- ) \ gforth
490: scope?
491: drop adjust-locals-list ; immediate
492:
493: \ adapt the hooks
494:
495: : locals-:-hook ( sys -- sys addr xt n )
496: \ addr is the nfa of the defined word, xt its xt
497: DEFERS :-hook
498: latest latestxt
499: clear-leave-stack
500: 0 locals-size !
501: locals-buffer locals-dp !
502: 0 locals-list !
503: dead-code off
504: defstart ;
505:
506: : locals-;-hook ( sys addr xt sys -- sys )
507: def?
508: 0 TO locals-wordlist
509: 0 adjust-locals-size ( not every def ends with an exit )
510: lastcfa ! last !
511: DEFERS ;-hook ;
512:
513: \ THEN (another control flow from before joins the current one):
514: \ The new locals-list is the intersection of the current locals-list and
515: \ the orig-local-list. The new locals-size is the (alignment-adjusted)
516: \ size of the new locals-list. The following code is generated:
517: \ lp+!# (current-locals-size - orig-locals-size)
518: \ <then>:
519: \ lp+!# (orig-locals-size - new-locals-size)
520:
521: \ Of course "lp+!# 0" is not generated. Still this is admittedly a bit
522: \ inefficient, e.g. if there is a locals declaration between IF and
523: \ ELSE. However, if ELSE generates an appropriate "lp+!#" before the
524: \ branch, there will be none after the target <then>.
525:
526: : (then-like) ( orig -- )
527: dead-orig =
528: if
529: >resolve drop
530: else
531: dead-code @
532: if
533: >resolve set-locals-size-list dead-code off
534: else \ both live
535: over list-size adjust-locals-size
536: >resolve
537: adjust-locals-list
538: then
539: then ;
540:
541: : (begin-like) ( -- )
542: dead-code @ if
543: \ set up an assumption of the locals visible here. if the
544: \ users want something to be visible, they have to declare
545: \ that using ASSUME-LIVE
546: backedge-locals @ set-locals-size-list
547: then
548: dead-code off ;
549:
550: \ AGAIN (the current control flow joins another, earlier one):
551: \ If the dest-locals-list is not a subset of the current locals-list,
552: \ issue a warning (see below). The following code is generated:
553: \ lp+!# (current-local-size - dest-locals-size)
554: \ branch <begin>
555:
556: : (again-like) ( dest -- addr )
557: over list-size adjust-locals-size
558: swap check-begin POSTPONE unreachable ;
559:
560: \ UNTIL (the current control flow may join an earlier one or continue):
561: \ Similar to AGAIN. The new locals-list and locals-size are the current
562: \ ones. The following code is generated:
563: \ ?branch-lp+!# <begin> (current-local-size - dest-locals-size)
564:
565: : (until-like) ( list addr xt1 xt2 -- )
566: \ list and addr are a fragment of a cs-item
567: \ xt1 is the conditional branch without lp adjustment, xt2 is with
568: >r >r
569: locals-size @ 2 pick list-size - dup if ( list dest-addr adjustment )
570: r> drop r> compile,
571: swap <resolve ( list adjustment ) ,
572: else ( list dest-addr adjustment )
573: drop
574: r> compile, <resolve
575: r> drop
576: then ( list )
577: check-begin ;
578:
579: : (exit-like) ( -- )
580: 0 adjust-locals-size ;
581:
582: ' locals-:-hook IS :-hook
583: ' locals-;-hook IS ;-hook
584:
585: ' (then-like) IS then-like
586: ' (begin-like) IS begin-like
587: ' (again-like) IS again-like
588: ' (until-like) IS until-like
589: ' (exit-like) IS exit-like
590:
591: \ The words in the locals dictionary space are not deleted until the end
592: \ of the current word. This is a bit too conservative, but very simple.
593:
594: \ There are a few cases to consider: (see above)
595:
596: \ after AGAIN, AHEAD, EXIT (the current control flow is dead):
597: \ We have to special-case the above cases against that. In this case the
598: \ things above are not control flow joins. Everything should be taken
599: \ over from the live flow. No lp+!# is generated.
600:
601: \ About warning against uses of dead locals. There are several options:
602:
603: \ 1) Do not complain (After all, this is Forth;-)
604:
605: \ 2) Additional restrictions can be imposed so that the situation cannot
606: \ arise; the programmer would have to introduce explicit scoping
607: \ declarations in cases like the above one. I.e., complain if there are
608: \ locals that are live before the BEGIN but not before the corresponding
609: \ AGAIN (replace DO etc. for BEGIN and UNTIL etc. for AGAIN).
610:
611: \ 3) The real thing: i.e. complain, iff a local lives at a BEGIN, is
612: \ used on a path starting at the BEGIN, and does not live at the
613: \ corresponding AGAIN. This is somewhat hard to implement. a) How does
614: \ the compiler know when it is working on a path starting at a BEGIN
615: \ (consider "{ x } if begin [ 1 cs-roll ] else x endif again")? b) How
616: \ is the usage info stored?
617:
618: \ For now I'll resort to alternative 2. When it produces warnings they
619: \ will often be spurious, but warnings should be rare. And better
620: \ spurious warnings now and then than days of bug-searching.
621:
622: \ Explicit scoping of locals is implemented by cs-pushing the current
623: \ locals-list and -size (and an unused cell, to make the size equal to
624: \ the other entries) at the start of the scope, and restoring them at
625: \ the end of the scope to the intersection, like THEN does.
626:
627:
628: \ And here's finally the ANS standard stuff
629:
630: : (local) ( addr u -- ) \ local paren-local-paren
631: \ a little space-inefficient, but well deserved ;-)
632: \ In exchange, there are no restrictions whatsoever on using (local)
633: \ as long as you use it in a definition
634: dup
635: if
636: nextname POSTPONE { [ also locals-types ] W: } [ previous ]
637: else
638: 2drop
639: endif ;
640:
641: : >definer ( xt -- definer ) \ gforth
642: \G @var{Definer} is a unique identifier for the way the @var{xt}
643: \G was defined. Words defined with different @code{does>}-codes
644: \G have different definers. The definer can be used for
645: \G comparison and in @code{definer!}.
646: dup >does-code
647: ?dup-if
648: nip 1 or
649: else
650: >code-address
651: then ;
652:
653: : definer! ( definer xt -- ) \ gforth
654: \G The word represented by @var{xt} changes its behaviour to the
655: \G behaviour associated with @var{definer}.
656: over 1 and if
657: swap [ 1 invert ] literal and does-code!
658: else
659: code-address!
660: then ;
661:
662: :noname
663: ' dup >definer [ ' locals-wordlist ] literal >definer =
664: if
665: >body !
666: else
667: -&32 throw
668: endif ;
669: :noname
670: comp' drop dup >definer
671: case
672: [ ' locals-wordlist ] literal >definer \ value
673: OF >body POSTPONE Aliteral POSTPONE ! ENDOF
674: \ !! dependent on c: etc. being does>-defining words
675: \ this works, because >definer uses >does-code in this case,
676: \ which produces a relocatable address
677: [ comp' some-clocal drop ] literal >definer
678: OF POSTPONE laddr# >body @ lp-offset, POSTPONE c! ENDOF
679: [ comp' some-wlocal drop ] literal >definer
680: OF POSTPONE laddr# >body @ lp-offset, POSTPONE ! ENDOF
681: [ comp' some-dlocal drop ] literal >definer
682: OF POSTPONE laddr# >body @ lp-offset, POSTPONE 2! ENDOF
683: [ comp' some-flocal drop ] literal >definer
684: OF POSTPONE laddr# >body @ lp-offset, POSTPONE f! ENDOF
685: -&32 throw
686: endcase ;
687: interpret/compile: TO ( c|w|d|r "name" -- ) \ core-ext,local
688:
689: : locals| ( ... "name ..." -- ) \ local-ext locals-bar
690: \ don't use 'locals|'! use '{'! A portable and free '{'
691: \ implementation is compat/anslocals.fs
692: BEGIN
693: name 2dup s" |" str= 0=
694: WHILE
695: (local)
696: REPEAT
697: drop 0 (local) ; immediate restrict
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>