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