Return to glocals.fs CVS log

Up to [gforth] / gforth

added code.fs (code, ;code, end-code, assembler)
renamed dostruc to dofield
made index and doc-entries nicer
Only words containing 'e' or 'E' are converted to FP numbers.
added many wordset comments
added flush-icache primitive and FLUSH_ICACHE macro
added +DO, U+DO, -DO, U-DO and -LOOP
added code address labels (`docol:' etc.)
fixed sparc cache_flush

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