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