Annotation of gforth/glocals.fs, revision 1.4

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: 
1.3       anton      67: : compile-@local ( n -- )
                     68:  case
                     69:     0 of postpone @local0 endof
                     70:     4 of postpone @local4 endof
                     71:     8 of postpone @local8 endof
                     72:    12 of postpone @local12 endof
                     73:    ( otherwise ) dup postpone @local# ,
                     74:  endcase ;
                     75: 
                     76: : compile-f@local ( n -- )
                     77:  case
                     78:     0 of postpone f@local0 endof
                     79:     8 of postpone f@local8 endof
                     80:    ( otherwise ) dup postpone f@local# ,
                     81:  endcase ;
                     82: 
1.1       anton      83: \ the locals stack grows downwards (see primitives)
                     84: \ of the local variables of a group (in braces) the leftmost is on top,
                     85: \ i.e. by going onto the locals stack the order is reversed.
                     86: \ there are alignment gaps if necessary.
                     87: \ lp must have the strictest alignment (usually float) across calls;
                     88: \ for simplicity we align it strictly for every group.
                     89: 
                     90: vocabulary locals \ this contains the local variables
1.3       anton      91: ' locals >body ' locals-list >body !
1.1       anton      92: 
                     93: create locals-buffer 1000 allot \ !! limited and unsafe
                     94:     \ here the names of the local variables are stored
                     95:     \ we would have problems storing them at the normal dp
                     96: 
                     97: variable locals-dp \ so here's the special dp for locals.
                     98: 
                     99: : alignlp-w ( n1 -- n2 )
                    100:     \ cell-align size and generate the corresponding code for aligning lp
1.3       anton     101:     aligned dup adjust-locals-size ;
1.1       anton     102: 
                    103: : alignlp-f ( n1 -- n2 )
1.3       anton     104:     faligned dup adjust-locals-size ;
1.1       anton     105: 
                    106: \ a local declaration group (the braces stuff) is compiled by calling
                    107: \ the appropriate compile-pushlocal for the locals, starting with the
                    108: \ righmost local; the names are already created earlier, the
                    109: \ compile-pushlocal just inserts the offsets from the frame base.
                    110: 
                    111: : compile-pushlocal-w ( a-addr -- ) ( run-time: w -- )
                    112: \ compiles a push of a local variable, and adjusts locals-size
                    113: \ stores the offset of the local variable to a-addr
                    114:     locals-size @ alignlp-w cell+ dup locals-size !
                    115:     swap !
                    116:     postpone >l ;
                    117: 
                    118: : compile-pushlocal-f ( a-addr -- ) ( run-time: f -- )
                    119:     locals-size @ alignlp-f float+ dup locals-size !
                    120:     swap !
                    121:     postpone f>l ;
                    122: 
                    123: : compile-pushlocal-d ( a-addr -- ) ( run-time: w1 w2 -- )
                    124:     locals-size @ alignlp-w cell+ cell+ dup locals-size !
                    125:     swap !
                    126:     postpone swap postpone >l postpone >l ;
                    127: 
                    128: : compile-pushlocal-c ( a-addr -- ) ( run-time: w -- )
1.3       anton     129:     -1 chars compile-lp+!
1.1       anton     130:     locals-size @ swap !
                    131:     postpone lp@ postpone c! ;
                    132: 
                    133: : create-local ( " name" -- a-addr )
                    134:        \ defines the local "name"; the offset of the local shall be stored in a-addr
                    135:     create
                    136:        immediate
                    137:        here 0 , ( place for the offset ) ;
                    138: 
1.3       anton     139: : lp-offset ( n1 -- n2 )
                    140: \ converts the offset from the frame start to an offset from lp and
                    141: \ i.e., the address of the local is lp+locals_size-offset
                    142:   locals-size @ swap - ;
                    143: 
1.1       anton     144: : lp-offset, ( n -- )
                    145: \ converts the offset from the frame start to an offset from lp and
                    146: \ adds it as inline argument to a preceding locals primitive
1.3       anton     147:   lp-offset , ;
1.1       anton     148: 
                    149: vocabulary locals-types \ this contains all the type specifyers, -- and }
                    150: locals-types definitions
                    151: 
                    152: : W:
                    153:     create-local ( "name" -- a-addr xt )
                    154:        \ xt produces the appropriate locals pushing code when executed
                    155:        ['] compile-pushlocal-w
                    156:     does> ( Compilation: -- ) ( Run-time: -- w )
                    157:         \ compiles a local variable access
1.3       anton     158:        @ lp-offset compile-@local ;
1.1       anton     159: 
                    160: : W^
                    161:     create-local ( "name" -- a-addr xt )
                    162:        ['] compile-pushlocal-w
                    163:     does> ( Compilation: -- ) ( Run-time: -- w )
                    164:        postpone laddr# @ lp-offset, ;
                    165: 
                    166: : F:
                    167:     create-local ( "name" -- a-addr xt )
                    168:        ['] compile-pushlocal-f
                    169:     does> ( Compilation: -- ) ( Run-time: -- w )
1.3       anton     170:        @ lp-offset compile-f@local ;
1.1       anton     171: 
                    172: : F^
                    173:     create-local ( "name" -- a-addr xt )
                    174:        ['] compile-pushlocal-f
                    175:     does> ( Compilation: -- ) ( Run-time: -- w )
                    176:        postpone laddr# @ lp-offset, ;
                    177: 
                    178: : D:
                    179:     create-local ( "name" -- a-addr xt )
                    180:        ['] compile-pushlocal-d
                    181:     does> ( Compilation: -- ) ( Run-time: -- w )
                    182:        postpone laddr# @ lp-offset, postpone 2@ ;
                    183: 
                    184: : D^
                    185:     create-local ( "name" -- a-addr xt )
                    186:        ['] compile-pushlocal-d
                    187:     does> ( Compilation: -- ) ( Run-time: -- w )
                    188:        postpone laddr# @ lp-offset, ;
                    189: 
                    190: : C:
                    191:     create-local ( "name" -- a-addr xt )
                    192:        ['] compile-pushlocal-c
                    193:     does> ( Compilation: -- ) ( Run-time: -- w )
                    194:        postpone laddr# @ lp-offset, postpone c@ ;
                    195: 
                    196: : C^
                    197:     create-local ( "name" -- a-addr xt )
                    198:        ['] compile-pushlocal-c
                    199:     does> ( Compilation: -- ) ( Run-time: -- w )
                    200:        postpone laddr# @ lp-offset, ;
                    201: 
                    202: \ you may want to make comments in a locals definitions group:
                    203: ' \ alias \ immediate
                    204: ' ( alias ( immediate
                    205: 
                    206: forth definitions
                    207: 
                    208: \ the following gymnastics are for declaring locals without type specifier.
                    209: \ we exploit a feature of our dictionary: every wordlist
                    210: \ has it's own methods for finding words etc.
                    211: \ So we create a vocabulary new-locals, that creates a 'w:' local named x
                    212: \ when it is asked if it contains x.
                    213: 
                    214: also locals-types
                    215: 
                    216: : new-locals-find ( caddr u w -- nfa )
                    217: \ this is the find method of the new-locals vocabulary
                    218: \ make a new local with name caddr u; w is ignored
                    219: \ the returned nfa denotes a word that produces what W: produces
                    220: \ !! do the whole thing without nextname
1.3       anton     221:     drop nextname
                    222:     ['] W: >name ;
1.1       anton     223: 
                    224: previous
                    225: 
                    226: : new-locals-reveal ( -- )
                    227:   true abort" this should not happen: new-locals-reveal" ;
                    228: 
                    229: create new-locals-map ' new-locals-find A, ' new-locals-reveal A,
                    230: 
                    231: vocabulary new-locals
                    232: new-locals-map ' new-locals >body cell+ A! \ !! use special access words
                    233: 
                    234: variable old-dpp
                    235: 
                    236: \ and now, finally, the user interface words
                    237: : { ( -- addr wid 0 )
                    238:     dp old-dpp !
                    239:     locals-dp dpp !
                    240:     also new-locals
                    241:     also get-current locals definitions  locals-types
                    242:     0 TO locals-wordlist
                    243:     0 postpone [ ; immediate
                    244: 
                    245: locals-types definitions
                    246: 
                    247: : } ( addr wid 0 a-addr1 xt1 ... -- )
                    248:     \ ends locals definitions
                    249:     ] old-dpp @ dpp !
                    250:     begin
                    251:        dup
                    252:     while
                    253:        execute
                    254:     repeat
                    255:     drop
                    256:     locals-size @ alignlp-f locals-size ! \ the strictest alignment
                    257:     set-current
                    258:     previous previous
                    259:     locals-list TO locals-wordlist ;
                    260: 
                    261: : -- ( addr wid 0 ... -- )
                    262:     }
                    263:     [char] } word drop ;
                    264: 
                    265: forth definitions
                    266: 
                    267: \ A few thoughts on automatic scopes for locals and how they can be
                    268: \ implemented:
                    269: 
                    270: \ We have to combine locals with the control structures. My basic idea
                    271: \ was to start the life of a local at the declaration point. The life
                    272: \ would end at any control flow join (THEN, BEGIN etc.) where the local
                    273: \ is lot live on both input flows (note that the local can still live in
                    274: \ other, later parts of the control flow). This would make a local live
                    275: \ as long as you expected and sometimes longer (e.g. a local declared in
                    276: \ a BEGIN..UNTIL loop would still live after the UNTIL).
                    277: 
                    278: \ The following example illustrates the problems of this approach:
                    279: 
                    280: \ { z }
                    281: \ if
                    282: \   { x }
                    283: \ begin
                    284: \   { y }
                    285: \ [ 1 cs-roll ] then
                    286: \   ...
                    287: \ until
                    288: 
                    289: \ x lives only until the BEGIN, but the compiler does not know this
                    290: \ until it compiles the UNTIL (it can deduce it at the THEN, because at
                    291: \ that point x lives in no thread, but that does not help much). This is
                    292: \ solved by optimistically assuming at the BEGIN that x lives, but
                    293: \ warning at the UNTIL that it does not. The user is then responsible
                    294: \ for checking that x is only used where it lives.
                    295: 
                    296: \ The produced code might look like this (leaving out alignment code):
                    297: 
                    298: \ >l ( z )
                    299: \ ?branch <then>
                    300: \ >l ( x )
                    301: \ <begin>:
                    302: \ >l ( y )
                    303: \ lp+!# 8 ( RIP: x,y )
                    304: \ <then>:
                    305: \ ...
                    306: \ lp+!# -4 ( adjust lp to <begin> state )
                    307: \ ?branch <begin>
                    308: \ lp+!# 4 ( undo adjust )
                    309: 
                    310: \ The BEGIN problem also has another incarnation:
                    311: 
                    312: \ AHEAD
                    313: \ BEGIN
                    314: \   x
                    315: \ [ 1 CS-ROLL ] THEN
                    316: \   { x }
                    317: \   ...
                    318: \ UNTIL
                    319: 
                    320: \ should be legal: The BEGIN is not a control flow join in this case,
                    321: \ since it cannot be entered from the top; therefore the definition of x
                    322: \ dominates the use. But the compiler processes the use first, and since
                    323: \ it does not look ahead to notice the definition, it will complain
                    324: \ about it. Here's another variation of this problem:
                    325: 
                    326: \ IF
                    327: \   { x }
                    328: \ ELSE
                    329: \   ...
                    330: \ AHEAD
                    331: \ BEGIN
                    332: \   x
                    333: \ [ 2 CS-ROLL ] THEN
                    334: \   ...
                    335: \ UNTIL
                    336: 
                    337: \ In this case x is defined before the use, and the definition dominates
                    338: \ the use, but the compiler does not know this until it processes the
                    339: \ UNTIL. So what should the compiler assume does live at the BEGIN, if
                    340: \ the BEGIN is not a control flow join? The safest assumption would be
                    341: \ the intersection of all locals lists on the control flow
                    342: \ stack. However, our compiler assumes that the same variables are live
                    343: \ as on the top of the control flow stack. This covers the following case:
                    344: 
                    345: \ { x }
                    346: \ AHEAD
                    347: \ BEGIN
                    348: \   x
                    349: \ [ 1 CS-ROLL ] THEN
                    350: \   ...
                    351: \ UNTIL
                    352: 
                    353: \ If this assumption is too optimistic, the compiler will warn the user.
                    354: 
1.3       anton     355: \ Implementation: migrated to kernal.fs
1.1       anton     356: 
                    357: \ THEN (another control flow from before joins the current one):
                    358: \ The new locals-list is the intersection of the current locals-list and
                    359: \ the orig-local-list. The new locals-size is the (alignment-adjusted)
                    360: \ size of the new locals-list. The following code is generated:
                    361: \ lp+!# (current-locals-size - orig-locals-size)
                    362: \ <then>:
                    363: \ lp+!# (orig-locals-size - new-locals-size)
                    364: 
                    365: \ Of course "lp+!# 0" is not generated. Still this is admittedly a bit
                    366: \ inefficient, e.g. if there is a locals declaration between IF and
                    367: \ ELSE. However, if ELSE generates an appropriate "lp+!#" before the
                    368: \ branch, there will be none after the target <then>.
                    369: 
1.3       anton     370: \ explicit scoping
1.1       anton     371: 
1.3       anton     372: : scope ( -- scope )
                    373:  cs-push-part scopestart ; immediate
                    374: 
                    375: : endscope ( scope -- )
                    376:  scope?
1.1       anton     377:  drop
1.3       anton     378:  locals-list @ common-list
                    379:  dup list-size adjust-locals-size
                    380:  locals-list ! ; immediate
1.1       anton     381: 
1.3       anton     382: \ adapt the hooks
1.1       anton     383: 
1.3       anton     384: : locals-:-hook ( sys -- sys addr xt n )
                    385:     \ addr is the nfa of the defined word, xt its xt
1.1       anton     386:     DEFERS :-hook
                    387:     last @ lastcfa @
                    388:     clear-leave-stack
                    389:     0 locals-size !
                    390:     locals-buffer locals-dp !
1.3       anton     391:     0 locals-list !
                    392:     dead-code off
                    393:     defstart ;
1.1       anton     394: 
1.3       anton     395: : locals-;-hook ( sys addr xt sys -- sys )
                    396:     def?
1.1       anton     397:     0 TO locals-wordlist
1.3       anton     398:     0 adjust-locals-size ( not every def ends with an exit )
1.1       anton     399:     lastcfa ! last !
                    400:     DEFERS ;-hook ;
                    401: 
                    402: ' locals-:-hook IS :-hook
                    403: ' locals-;-hook IS ;-hook
                    404: 
                    405: \ The words in the locals dictionary space are not deleted until the end
                    406: \ of the current word. This is a bit too conservative, but very simple.
                    407: 
                    408: \ There are a few cases to consider: (see above)
                    409: 
                    410: \ after AGAIN, AHEAD, EXIT (the current control flow is dead):
                    411: \ We have to special-case the above cases against that. In this case the
                    412: \ things above are not control flow joins. Everything should be taken
                    413: \ over from the live flow. No lp+!# is generated.
                    414: 
                    415: \ !! The lp gymnastics for UNTIL are also a real problem: locals cannot be
                    416: \ used in signal handlers (or anything else that may be called while
                    417: \ locals live beyond the lp) without changing the locals stack.
                    418: 
                    419: \ About warning against uses of dead locals. There are several options:
                    420: 
                    421: \ 1) Do not complain (After all, this is Forth;-)
                    422: 
                    423: \ 2) Additional restrictions can be imposed so that the situation cannot
                    424: \ arise; the programmer would have to introduce explicit scoping
                    425: \ declarations in cases like the above one. I.e., complain if there are
                    426: \ locals that are live before the BEGIN but not before the corresponding
                    427: \ AGAIN (replace DO etc. for BEGIN and UNTIL etc. for AGAIN).
                    428: 
                    429: \ 3) The real thing: i.e. complain, iff a local lives at a BEGIN, is
                    430: \ used on a path starting at the BEGIN, and does not live at the
                    431: \ corresponding AGAIN. This is somewhat hard to implement. a) How does
                    432: \ the compiler know when it is working on a path starting at a BEGIN
                    433: \ (consider "{ x } if begin [ 1 cs-roll ] else x endif again")? b) How
                    434: \ is the usage info stored?
                    435: 
                    436: \ For now I'll resort to alternative 2. When it produces warnings they
                    437: \ will often be spurious, but warnings should be rare. And better
                    438: \ spurious warnings now and then than days of bug-searching.
                    439: 
                    440: \ Explicit scoping of locals is implemented by cs-pushing the current
                    441: \ locals-list and -size (and an unused cell, to make the size equal to
                    442: \ the other entries) at the start of the scope, and restoring them at
                    443: \ the end of the scope to the intersection, like THEN does.
                    444: 
                    445: 
                    446: \ And here's finally the ANS standard stuff
                    447: 
                    448: : (local) ( addr u -- )
1.3       anton     449:     \ a little space-inefficient, but well deserved ;-)
                    450:     \ In exchange, there are no restrictions whatsoever on using (local)
1.4     ! anton     451:     \ as long as you use it in a definition
1.3       anton     452:     dup
                    453:     if
                    454:        nextname POSTPONE { [ also locals-types ] W: } [ previous ]
                    455:     else
                    456:        2drop
                    457:     endif ;
1.1       anton     458: 
1.4     ! anton     459: : >definer ( xt -- definer )
        !           460:     \ this gives a unique identifier for the way the xt was defined
        !           461:     \ words defined with different does>-codes have different definers
        !           462:     \ the definer can be used for comparison and in definer!
        !           463:     dup >code-address [ ' bits >code-address ] Literal =
        !           464:     \ !! this definition will not work on some implementations for `bits'
        !           465:     if  \ if >code-address delivers the same value for all does>-def'd words
        !           466:        >does-code 1 or \ bit 0 marks special treatment for does codes
        !           467:     else
        !           468:        >code-address
        !           469:     then ;
        !           470: 
        !           471: : definer! ( definer xt -- )
        !           472:     \ gives the word represented by xt the behaviour associated with definer
        !           473:     over 1 and if
        !           474:        does-code!
        !           475:     else
        !           476:        code-address!
        !           477:     then ;
        !           478: 
        !           479: \ !! untested
        !           480: : TO ( c|w|d|r "name" -- )
        !           481: \ !! state smart
        !           482:  0 0 0. 0.0e0 { c: clocal w: wlocal d: dlocal f: flocal }
        !           483:  ' dup >definer
        !           484:  state @ 
        !           485:  if
        !           486:    case
        !           487:      [ ' locals-wordlist >definer ] literal \ value
        !           488:      OF >body POSTPONE Aliteral POSTPONE ! ENDOF
        !           489:      [ ' clocal >definer ] literal
        !           490:      OF POSTPONE laddr# >body @ lp-offset, POSTPONE c! ENDOF
        !           491:      [ ' wlocal >definer ] literal
        !           492:      OF POSTPONE laddr# >body @ lp-offset, POSTPONE ! ENDOF
        !           493:      [ ' dlocal >definer ] literal
        !           494:      OF POSTPONE laddr# >body @ lp-offset, POSTPONE d! ENDOF
        !           495:      [ ' flocal >definer ] literal
        !           496:      OF POSTPONE laddr# >body @ lp-offset, POSTPONE f! ENDOF
        !           497:      abort" can only store TO value or local value"
        !           498:    endcase
        !           499:  else
        !           500:    [ ' locals-wordlist >definer ] literal =
        !           501:    if
        !           502:      >body !
        !           503:    else
        !           504:      abort" can only store TO value"
        !           505:    endif
        !           506:  endif ; immediate
1.1       anton     507: 
                    508: \ : locals|
                    509: \ !! should lie around somewhere

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>