File:
[gforth] /
gforth /
glocals.fs
Revision
1.2:
download - view:
text,
annotated -
select for diffs
Wed Jun 1 10:05:17 1994 UTC (29 years, 9 months ago) by
pazsan
Branches:
MAIN
CVS tags:
HEAD
added an experimental hash table (search/order.fs)
allowed the user to select caps-stored names or even case-
sensitive search.
Made gforth.texi compilable.
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: \ the locals stack grows downwards (see primitives)
68: \ of the local variables of a group (in braces) the leftmost is on top,
69: \ i.e. by going onto the locals stack the order is reversed.
70: \ there are alignment gaps if necessary.
71: \ lp must have the strictest alignment (usually float) across calls;
72: \ for simplicity we align it strictly for every group.
73:
74: vocabulary locals \ this contains the local variables
75: ' locals >body Constant locals-list \ acts like a variable that contains
76: \ a linear list of locals names
77: : locals-list! ( list -- ) locals-list ! locals-list rehash ;
78:
79: create locals-buffer 1000 allot \ !! limited and unsafe
80: \ here the names of the local variables are stored
81: \ we would have problems storing them at the normal dp
82:
83: variable locals-dp \ so here's the special dp for locals.
84:
85: : alignlp-w ( n1 -- n2 )
86: \ cell-align size and generate the corresponding code for aligning lp
87: dup aligned tuck - compile-lp+!# ;
88:
89: : alignlp-f ( n1 -- n2 )
90: dup faligned tuck - compile-lp+!# ;
91:
92: \ a local declaration group (the braces stuff) is compiled by calling
93: \ the appropriate compile-pushlocal for the locals, starting with the
94: \ righmost local; the names are already created earlier, the
95: \ compile-pushlocal just inserts the offsets from the frame base.
96:
97: : compile-pushlocal-w ( a-addr -- ) ( run-time: w -- )
98: \ compiles a push of a local variable, and adjusts locals-size
99: \ stores the offset of the local variable to a-addr
100: locals-size @ alignlp-w cell+ dup locals-size !
101: swap !
102: postpone >l ;
103:
104: : compile-pushlocal-f ( a-addr -- ) ( run-time: f -- )
105: locals-size @ alignlp-f float+ dup locals-size !
106: swap !
107: postpone f>l ;
108:
109: : compile-pushlocal-d ( a-addr -- ) ( run-time: w1 w2 -- )
110: locals-size @ alignlp-w cell+ cell+ dup locals-size !
111: swap !
112: postpone swap postpone >l postpone >l ;
113:
114: : compile-pushlocal-c ( a-addr -- ) ( run-time: w -- )
115: -1 chars compile-lp+!#
116: locals-size @ swap !
117: postpone lp@ postpone c! ;
118:
119: : create-local ( " name" -- a-addr )
120: \ defines the local "name"; the offset of the local shall be stored in a-addr
121: create
122: immediate
123: here 0 , ( place for the offset ) ;
124:
125: : lp-offset, ( n -- )
126: \ converts the offset from the frame start to an offset from lp and
127: \ adds it as inline argument to a preceding locals primitive
128: \ i.e., the address of the local is lp+locals_size-offset
129: locals-size @ swap - , ;
130:
131: vocabulary locals-types \ this contains all the type specifyers, -- and }
132: locals-types definitions
133:
134: : W:
135: create-local ( "name" -- a-addr xt )
136: \ xt produces the appropriate locals pushing code when executed
137: ['] compile-pushlocal-w
138: does> ( Compilation: -- ) ( Run-time: -- w )
139: \ compiles a local variable access
140: postpone @local# @ lp-offset, ;
141:
142: : W^
143: create-local ( "name" -- a-addr xt )
144: ['] compile-pushlocal-w
145: does> ( Compilation: -- ) ( Run-time: -- w )
146: postpone laddr# @ lp-offset, ;
147:
148: : F:
149: create-local ( "name" -- a-addr xt )
150: ['] compile-pushlocal-f
151: does> ( Compilation: -- ) ( Run-time: -- w )
152: postpone f@local# @ lp-offset, ;
153:
154: : F^
155: create-local ( "name" -- a-addr xt )
156: ['] compile-pushlocal-f
157: does> ( Compilation: -- ) ( Run-time: -- w )
158: postpone laddr# @ lp-offset, ;
159:
160: : D:
161: create-local ( "name" -- a-addr xt )
162: ['] compile-pushlocal-d
163: does> ( Compilation: -- ) ( Run-time: -- w )
164: postpone laddr# @ lp-offset, postpone 2@ ;
165:
166: : D^
167: create-local ( "name" -- a-addr xt )
168: ['] compile-pushlocal-d
169: does> ( Compilation: -- ) ( Run-time: -- w )
170: postpone laddr# @ lp-offset, ;
171:
172: : C:
173: create-local ( "name" -- a-addr xt )
174: ['] compile-pushlocal-c
175: does> ( Compilation: -- ) ( Run-time: -- w )
176: postpone laddr# @ lp-offset, postpone c@ ;
177:
178: : C^
179: create-local ( "name" -- a-addr xt )
180: ['] compile-pushlocal-c
181: does> ( Compilation: -- ) ( Run-time: -- w )
182: postpone laddr# @ lp-offset, ;
183:
184: \ you may want to make comments in a locals definitions group:
185: ' \ alias \ immediate
186: ' ( alias ( immediate
187:
188: forth definitions
189:
190: \ the following gymnastics are for declaring locals without type specifier.
191: \ we exploit a feature of our dictionary: every wordlist
192: \ has it's own methods for finding words etc.
193: \ So we create a vocabulary new-locals, that creates a 'w:' local named x
194: \ when it is asked if it contains x.
195:
196: 0. 2constant last-local \ !! actually a 2value
197:
198: also locals-types
199:
200: : new-locals-find ( caddr u w -- nfa )
201: \ this is the find method of the new-locals vocabulary
202: \ make a new local with name caddr u; w is ignored
203: \ the returned nfa denotes a word that produces what W: produces
204: \ !! do the whole thing without nextname
205: drop nextname W: \ we don't want the thing that W: produces,
206: ['] last-local >body 2! \ but the nfa of a word that produces that value: last-local
207: [ ' last-local >name ] Aliteral ;
208:
209: previous
210:
211: : new-locals-reveal ( -- )
212: true abort" this should not happen: new-locals-reveal" ;
213:
214: create new-locals-map ' new-locals-find A, ' new-locals-reveal A,
215:
216: vocabulary new-locals
217: new-locals-map ' new-locals >body cell+ A! \ !! use special access words
218:
219: variable old-dpp
220:
221: \ and now, finally, the user interface words
222: : { ( -- addr wid 0 )
223: dp old-dpp !
224: locals-dp dpp !
225: also new-locals
226: also get-current locals definitions locals-types
227: 0 TO locals-wordlist
228: 0 postpone [ ; immediate
229:
230: locals-types definitions
231:
232: : } ( addr wid 0 a-addr1 xt1 ... -- )
233: \ ends locals definitions
234: ] old-dpp @ dpp !
235: begin
236: dup
237: while
238: execute
239: repeat
240: drop
241: locals-size @ alignlp-f locals-size ! \ the strictest alignment
242: set-current
243: previous previous
244: locals-list TO locals-wordlist ;
245:
246: : -- ( addr wid 0 ... -- )
247: }
248: [char] } word drop ;
249:
250: forth definitions
251:
252: \ A few thoughts on automatic scopes for locals and how they can be
253: \ implemented:
254:
255: \ We have to combine locals with the control structures. My basic idea
256: \ was to start the life of a local at the declaration point. The life
257: \ would end at any control flow join (THEN, BEGIN etc.) where the local
258: \ is lot live on both input flows (note that the local can still live in
259: \ other, later parts of the control flow). This would make a local live
260: \ as long as you expected and sometimes longer (e.g. a local declared in
261: \ a BEGIN..UNTIL loop would still live after the UNTIL).
262:
263: \ The following example illustrates the problems of this approach:
264:
265: \ { z }
266: \ if
267: \ { x }
268: \ begin
269: \ { y }
270: \ [ 1 cs-roll ] then
271: \ ...
272: \ until
273:
274: \ x lives only until the BEGIN, but the compiler does not know this
275: \ until it compiles the UNTIL (it can deduce it at the THEN, because at
276: \ that point x lives in no thread, but that does not help much). This is
277: \ solved by optimistically assuming at the BEGIN that x lives, but
278: \ warning at the UNTIL that it does not. The user is then responsible
279: \ for checking that x is only used where it lives.
280:
281: \ The produced code might look like this (leaving out alignment code):
282:
283: \ >l ( z )
284: \ ?branch <then>
285: \ >l ( x )
286: \ <begin>:
287: \ >l ( y )
288: \ lp+!# 8 ( RIP: x,y )
289: \ <then>:
290: \ ...
291: \ lp+!# -4 ( adjust lp to <begin> state )
292: \ ?branch <begin>
293: \ lp+!# 4 ( undo adjust )
294:
295: \ The BEGIN problem also has another incarnation:
296:
297: \ AHEAD
298: \ BEGIN
299: \ x
300: \ [ 1 CS-ROLL ] THEN
301: \ { x }
302: \ ...
303: \ UNTIL
304:
305: \ should be legal: The BEGIN is not a control flow join in this case,
306: \ since it cannot be entered from the top; therefore the definition of x
307: \ dominates the use. But the compiler processes the use first, and since
308: \ it does not look ahead to notice the definition, it will complain
309: \ about it. Here's another variation of this problem:
310:
311: \ IF
312: \ { x }
313: \ ELSE
314: \ ...
315: \ AHEAD
316: \ BEGIN
317: \ x
318: \ [ 2 CS-ROLL ] THEN
319: \ ...
320: \ UNTIL
321:
322: \ In this case x is defined before the use, and the definition dominates
323: \ the use, but the compiler does not know this until it processes the
324: \ UNTIL. So what should the compiler assume does live at the BEGIN, if
325: \ the BEGIN is not a control flow join? The safest assumption would be
326: \ the intersection of all locals lists on the control flow
327: \ stack. However, our compiler assumes that the same variables are live
328: \ as on the top of the control flow stack. This covers the following case:
329:
330: \ { x }
331: \ AHEAD
332: \ BEGIN
333: \ x
334: \ [ 1 CS-ROLL ] THEN
335: \ ...
336: \ UNTIL
337:
338: \ If this assumption is too optimistic, the compiler will warn the user.
339:
340: \ Implementation:
341:
342: \ orig, dest and do-sys have the following structure:
343: \ address (of the branch or the instruction to be branched to) (TOS)
344: \ locals-list (valid at address) (second)
345: \ locals-size (at address; this could be computed from locals-list, but so what) (third)
346:
347: 3 constant cs-item-size
348:
349: : CS-PICK ( ... u -- ... destu )
350: 1+ cs-item-size * 1- >r
351: r@ pick r@ pick r@ pick
352: rdrop ;
353:
354: : CS-ROLL ( destu/origu .. dest0/orig0 u -- .. dest0/orig0 destu/origu )
355: 1+ cs-item-size * 1- >r
356: r@ roll r@ roll r@ roll
357: rdrop ;
358:
359: : CS-PUSH ( -- dest/orig )
360: locals-size @
361: locals-list @
362: here ;
363:
364: : BUT sys? 1 cs-roll ; immediate restrict
365: : YET sys? 0 cs-pick ; immediate restrict
366:
367: : common-list ( list1 list2 -- list3 )
368: \ list1 and list2 are lists, where the heads are at higher addresses than
369: \ the tail. list3 is the largest sublist of both lists.
370: begin
371: 2dup u<>
372: while
373: 2dup u>
374: if
375: swap
376: endif
377: @
378: repeat
379: drop ;
380:
381: : sub-list? ( list1 list2 -- f )
382: \ true iff list1 is a sublist of list2
383: begin
384: 2dup u<
385: while
386: @
387: repeat
388: = ;
389:
390: : list-size ( list -- u )
391: \ size of the locals frame represented by list
392: 0 ( list n )
393: begin
394: over 0<>
395: while
396: over
397: cell+ name> >body @ max
398: swap @ swap ( get next )
399: repeat
400: faligned nip ;
401:
402: : x>mark ( -- orig )
403: cs-push 0 , ;
404:
405: variable dead-code \ true if normal code at "here" would be dead
406:
407: : unreachable ( -- )
408: \ declares the current point of execution as unreachable and
409: \ prepares the assumptions for a possible upcoming BEGIN
410: dead-code on
411: dup 0<> if
412: 2 pick 2 pick
413: else
414: 0 0
415: endif
416: locals-list!
417: locals-size ! ;
418:
419: : check-begin ( list -- )
420: \ warn if list is not a sublist of locals-list
421: locals-list @ sub-list? 0= if
422: \ !! print current position
423: ." compiler was overly optimistic about locals at a BEGIN" cr
424: \ !! print assumption and reality
425: endif ;
426:
427: : xahead ( -- orig )
428: POSTPONE branch x>mark unreachable ; immediate
429:
430: : xif ( -- orig )
431: POSTPONE ?branch x>mark ; immediate
432:
433: \ THEN (another control flow from before joins the current one):
434: \ The new locals-list is the intersection of the current locals-list and
435: \ the orig-local-list. The new locals-size is the (alignment-adjusted)
436: \ size of the new locals-list. The following code is generated:
437: \ lp+!# (current-locals-size - orig-locals-size)
438: \ <then>:
439: \ lp+!# (orig-locals-size - new-locals-size)
440:
441: \ Of course "lp+!# 0" is not generated. Still this is admittedly a bit
442: \ inefficient, e.g. if there is a locals declaration between IF and
443: \ ELSE. However, if ELSE generates an appropriate "lp+!#" before the
444: \ branch, there will be none after the target <then>.
445: : xthen ( orig -- )
446: sys? dup @ ?struc
447: dead-code @
448: if
449: >resolve
450: locals-list!
451: locals-size !
452: else
453: locals-size @ 3 roll - compile-lp+!#
454: >resolve
455: locals-list @ common-list locals-list!
456: locals-size @ locals-list @ list-size - compile-lp+!#
457: endif
458: dead-code off ; immediate
459:
460: : scope ( -- dest )
461: cs-push ; immediate
462:
463: : endscope ( dest -- )
464: drop
465: locals-list @ common-list locals-list!
466: locals-size @ locals-list @ list-size - compile-lp+!#
467: drop ; immediate
468:
469: : xexit ( -- )
470: locals-size @ compile-lp+!# POSTPONE exit unreachable ; immediate
471:
472: : x?exit ( -- )
473: POSTPONE xif POSTPONE xexit POSTPONE xthen ; immediate
474:
475: : xelse ( orig1 -- orig2 )
476: sys?
477: POSTPONE xahead
478: 1 cs-roll
479: POSTPONE xthen ; immediate
480:
481: : xbegin ( -- dest )
482: cs-push dead-code off ; immediate
483:
484: : xwhile ( dest -- orig dest )
485: sys?
486: POSTPONE xif
487: 1 cs-roll ; immediate
488:
489: \ AGAIN (the current control flow joins another, earlier one):
490: \ If the dest-locals-list is not a subset of the current locals-list,
491: \ issue a warning (see below). The following code is generated:
492: \ lp+!# (current-local-size - dest-locals-size)
493: \ branch <begin>
494: : xagain ( dest -- )
495: sys?
496: locals-size @ 3 roll - compile-lp+!#
497: POSTPONE branch
498: <resolve
499: check-begin
500: unreachable ; immediate
501:
502: \ UNTIL (the current control flow may join an earlier one or continue):
503: \ Similar to AGAIN. The new locals-list and locals-size are the current
504: \ ones. The following code is generated:
505: \ lp+!# (current-local-size - dest-locals-size)
506: \ ?branch <begin>
507: \ lp+!# (dest-local-size - current-locals-size)
508: \ (Another inefficiency. Maybe we should introduce a ?branch-lp+!#
509: \ primitive. This would also solve the interrupt problem)
510: : until-like ( dest xt -- )
511: >r
512: sys?
513: locals-size @ dup 4 roll - compile-lp+!# ( list dest-addr old-locals-size )
514: r> compile,
515: >r <resolve
516: check-begin
517: locals-size @ r> - compile-lp+!# ;
518:
519: : xuntil ( dest -- )
520: ['] ?branch until-like ; immediate
521:
522: : xrepeat ( orig dest -- )
523: 3 pick 0= ?struc
524: postpone xagain
525: postpone xthen ; immediate
526:
527: \ counted loops
528:
529: \ leave poses a little problem here
530: \ we have to store more than just the address of the branch, so the
531: \ traditional linked list approach is no longer viable.
532: \ This is solved by storing the information about the leavings in a
533: \ special stack. The leavings of different DO-LOOPs are separated
534: \ by a 0 entry
535:
536: \ !! remove the fixed size limit. 'Tis easy.
537: 20 constant leave-stack-size
538: create leave-stack leave-stack-size cs-item-size * cells allot
539: variable leave-sp leave-stack leave-sp !
540:
541: : clear-leave-stack ( -- )
542: leave-stack leave-sp ! ;
543:
544: \ : leave-empty? ( -- f )
545: \ leave-sp @ leave-stack = ;
546:
547: : >leave ( orig -- )
548: \ push on leave-stack
549: leave-sp @
550: dup [ leave-stack leave-stack-size cs-item-size * cells + ] Aliteral >=
551: if
552: abort" leave-stack full"
553: endif
554: tuck ! cell+
555: tuck ! cell+
556: tuck ! cell+
557: leave-sp ! ;
558:
559: : leave> ( -- orig )
560: \ pop from leave-stack
561: leave-sp @
562: dup leave-stack <= if
563: abort" leave-stack empty"
564: endif
565: cell - dup @ swap
566: cell - dup @ swap
567: cell - dup @ swap
568: leave-sp ! ;
569:
570: : done ( -- )
571: \ !! the original done had ( addr -- )
572: begin
573: leave>
574: dup
575: while
576: POSTPONE xthen
577: repeat
578: 2drop drop ; immediate
579:
580: : xleave ( -- )
581: POSTPONE xahead
582: >leave ; immediate
583:
584: : x?leave ( -- )
585: POSTPONE 0= POSTPONE xif
586: >leave ; immediate
587:
588: : xdo ( -- do-sys )
589: POSTPONE (do)
590: POSTPONE xbegin
591: 0 0 0 >leave ; immediate
592:
593: : x?do ( -- do-sys )
594: 0 0 0 >leave
595: POSTPONE (?do)
596: x>mark >leave
597: POSTPONE xbegin ; immediate
598:
599: : xfor ( -- do-sys )
600: POSTPONE (for)
601: POSTPONE xbegin
602: 0 0 0 >leave ; immediate
603:
604: \ LOOP etc. are just like UNTIL
605: \ the generated code for ?DO ... LOOP with locals is inefficient, this
606: \ could be changed by introducing (loop)-lp+!# etc.
607:
608: : loop-like ( do-sys xt -- )
609: until-like POSTPONE done POSTPONE unloop ;
610:
611: : xloop ( do-sys -- )
612: ['] (loop) loop-like ; immediate
613:
614: : x+loop ( do-sys -- )
615: ['] (+loop) loop-like ; immediate
616:
617: : xs+loop ( do-sys -- )
618: ['] (s+loop) loop-like ; immediate
619:
620: : locals-:-hook ( sys -- sys addr xt )
621: DEFERS :-hook
622: last @ lastcfa @
623: clear-leave-stack
624: 0 locals-size !
625: locals-buffer locals-dp !
626: 0 locals-list! ; ( clear locals vocabulary )
627:
628: : locals-;-hook ( sys addr xt -- sys )
629: 0 TO locals-wordlist
630: locals-size @ compile-lp+!#
631: lastcfa ! last !
632: DEFERS ;-hook ;
633:
634: ' locals-:-hook IS :-hook
635: ' locals-;-hook IS ;-hook
636:
637: \ The words in the locals dictionary space are not deleted until the end
638: \ of the current word. This is a bit too conservative, but very simple.
639:
640: \ There are a few cases to consider: (see above)
641:
642: \ after AGAIN, AHEAD, EXIT (the current control flow is dead):
643: \ We have to special-case the above cases against that. In this case the
644: \ things above are not control flow joins. Everything should be taken
645: \ over from the live flow. No lp+!# is generated.
646:
647: \ !! The lp gymnastics for UNTIL are also a real problem: locals cannot be
648: \ used in signal handlers (or anything else that may be called while
649: \ locals live beyond the lp) without changing the locals stack.
650:
651: \ About warning against uses of dead locals. There are several options:
652:
653: \ 1) Do not complain (After all, this is Forth;-)
654:
655: \ 2) Additional restrictions can be imposed so that the situation cannot
656: \ arise; the programmer would have to introduce explicit scoping
657: \ declarations in cases like the above one. I.e., complain if there are
658: \ locals that are live before the BEGIN but not before the corresponding
659: \ AGAIN (replace DO etc. for BEGIN and UNTIL etc. for AGAIN).
660:
661: \ 3) The real thing: i.e. complain, iff a local lives at a BEGIN, is
662: \ used on a path starting at the BEGIN, and does not live at the
663: \ corresponding AGAIN. This is somewhat hard to implement. a) How does
664: \ the compiler know when it is working on a path starting at a BEGIN
665: \ (consider "{ x } if begin [ 1 cs-roll ] else x endif again")? b) How
666: \ is the usage info stored?
667:
668: \ For now I'll resort to alternative 2. When it produces warnings they
669: \ will often be spurious, but warnings should be rare. And better
670: \ spurious warnings now and then than days of bug-searching.
671:
672: \ Explicit scoping of locals is implemented by cs-pushing the current
673: \ locals-list and -size (and an unused cell, to make the size equal to
674: \ the other entries) at the start of the scope, and restoring them at
675: \ the end of the scope to the intersection, like THEN does.
676:
677:
678: \ And here's finally the ANS standard stuff
679:
680: : (local) ( addr u -- )
681: \ a little space-inefficient, but well deserved ;-)
682: \ In exchange, there are no restrictions whatsoever on using (local)
683: dup
684: if
685: nextname POSTPONE { [ also locals-types ] W: } [ previous ]
686: else
687: 2drop
688: endif ;
689:
690: \ \ !! untested
691: \ : TO ( c|w|d|r "name" -- )
692: \ \ !! state smart
693: \ 0 0 0. 0.0e0 { c: clocal w: wlocal d: dlocal f: flocal }
694: \ ' dup >definer
695: \ state @
696: \ if
697: \ case
698: \ [ ' locals-wordlist >definer ] literal \ value
699: \ OF >body POSTPONE Aliteral POSTPONE ! ENDOF
700: \ [ ' clocal >definer ] literal
701: \ OF POSTPONE laddr# >body @ lp-offset, POSTPONE c! ENDOF
702: \ [ ' wlocal >definer ] literal
703: \ OF POSTPONE laddr# >body @ lp-offset, POSTPONE ! ENDOF
704: \ [ ' dlocal >definer ] literal
705: \ OF POSTPONE laddr# >body @ lp-offset, POSTPONE d! ENDOF
706: \ [ ' flocal >definer ] literal
707: \ OF POSTPONE laddr# >body @ lp-offset, POSTPONE f! ENDOF
708: \ abort" can only store TO value or local value"
709: \ endcase
710: \ else
711: \ [ ' locals-wordlist >definer ] literal =
712: \ if
713: \ >body !
714: \ else
715: \ abort" can only store TO value"
716: \ endif
717: \ endif ;
718:
719: \ : locals|
720: \ !! should lie around somewhere
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>