Diff for /gforth/glocals.fs between versions 1.3 and 1.9

version 1.3, 1994/06/17 12:35:03 version 1.9, 1995/01/30 18:47:50
Line 61 Line 61
 \ Currently locals may only be  \ Currently locals may only be
 \ defined at the outer level and TO is not supported.  \ defined at the outer level and TO is not supported.
   
 include float.fs  
 include search-order.fs  include search-order.fs
   include float.fs
   
 : compile-@local ( n -- )  : compile-@local ( n -- )
  case   case
     0 of postpone @local0 endof      0       of postpone @local0 endof
     4 of postpone @local4 endof      1 cells of postpone @local1 endof
     8 of postpone @local8 endof      2 cells of postpone @local2 endof
    12 of postpone @local12 endof      3 cells of postpone @local3 endof
    ( otherwise ) dup postpone @local# ,     ( otherwise ) dup postpone @local# ,
  endcase ;   endcase ;
   
 : compile-f@local ( n -- )  : compile-f@local ( n -- )
  case   case
     0 of postpone f@local0 endof      0        of postpone f@local0 endof
     8 of postpone f@local8 endof      1 floats of postpone f@local1 endof
    ( otherwise ) dup postpone f@local# ,     ( otherwise ) dup postpone f@local# ,
  endcase ;   endcase ;
   
Line 87  include search-order.fs Line 87  include search-order.fs
 \ lp must have the strictest alignment (usually float) across calls;  \ lp must have the strictest alignment (usually float) across calls;
 \ for simplicity we align it strictly for every group.  \ for simplicity we align it strictly for every group.
   
   slowvoc @
   slowvoc on \ we want a linked list for the vocabulary locals
 vocabulary locals \ this contains the local variables  vocabulary locals \ this contains the local variables
 ' locals >body ' locals-list >body !  ' locals >body ' locals-list >body !
   slowvoc !
   
 create locals-buffer 1000 allot \ !! limited and unsafe  create locals-buffer 1000 allot \ !! limited and unsafe
     \ here the names of the local variables are stored      \ here the names of the local variables are stored
Line 131  variable locals-dp \ so here's the speci Line 134  variable locals-dp \ so here's the speci
     postpone lp@ postpone c! ;      postpone lp@ postpone c! ;
   
 : create-local ( " name" -- a-addr )  : create-local ( " name" -- a-addr )
         \ defines the local "name"; the offset of the local shall be stored in a-addr      \ defines the local "name"; the offset of the local shall be
       \ stored in a-addr
     create      create
         immediate          immediate
         here 0 , ( place for the offset ) ;          here 0 , ( place for the offset ) ;
Line 260  locals-types definitions Line 264  locals-types definitions
   
 : -- ( addr wid 0 ... -- )  : -- ( addr wid 0 ... -- )
     }      }
     [char] } word drop ;      [char] } parse 2drop ;
   
 forth definitions  forth definitions
   
Line 448  forth definitions Line 452  forth definitions
 : (local) ( addr u -- )  : (local) ( addr u -- )
     \ a little space-inefficient, but well deserved ;-)      \ a little space-inefficient, but well deserved ;-)
     \ In exchange, there are no restrictions whatsoever on using (local)      \ In exchange, there are no restrictions whatsoever on using (local)
       \ as long as you use it in a definition
     dup      dup
     if      if
         nextname POSTPONE { [ also locals-types ] W: } [ previous ]          nextname POSTPONE { [ also locals-types ] W: } [ previous ]
Line 455  forth definitions Line 460  forth definitions
         2drop          2drop
     endif ;      endif ;
   
 \ \ !! untested  : >definer ( xt -- definer )
 \ : TO ( c|w|d|r "name" -- )      \ this gives a unique identifier for the way the xt was defined
 \ \ !! state smart      \ words defined with different does>-codes have different definers
 \  0 0 0. 0.0e0 { c: clocal w: wlocal d: dlocal f: flocal }      \ the definer can be used for comparison and in definer!
 \  ' dup >definer      dup >code-address [ ' bits >code-address ] Literal =
 \  state @       \ !! this definition will not work on some implementations for `bits'
 \  if      if  \ if >code-address delivers the same value for all does>-def'd words
 \    case          >does-code 1 or \ bit 0 marks special treatment for does codes
 \      [ ' locals-wordlist >definer ] literal \ value      else
 \      OF >body POSTPONE Aliteral POSTPONE ! ENDOF          >code-address
 \      [ ' clocal >definer ] literal      then ;
 \      OF POSTPONE laddr# >body @ lp-offset, POSTPONE c! ENDOF  
 \      [ ' wlocal >definer ] literal  : definer! ( definer xt -- )
 \      OF POSTPONE laddr# >body @ lp-offset, POSTPONE ! ENDOF      \ gives the word represented by xt the behaviour associated with definer
 \      [ ' dlocal >definer ] literal      over 1 and if
 \      OF POSTPONE laddr# >body @ lp-offset, POSTPONE d! ENDOF          does-code!
 \      [ ' flocal >definer ] literal      else
 \      OF POSTPONE laddr# >body @ lp-offset, POSTPONE f! ENDOF          code-address!
 \      abort" can only store TO value or local value"      then ;
 \    endcase  
 \  else  
 \    [ ' locals-wordlist >definer ] literal =  
 \    if  
 \      >body !  
 \    else  
 \      abort" can only store TO value"  
 \    endif  
 \  endif ;     
   
 \ : locals|  \ !! untested
 \ !! should lie around somewhere  : TO ( c|w|d|r "name" -- )
   \ !! state smart
    0 0 0. 0.0e0 { c: clocal w: wlocal d: dlocal f: flocal }
    ' dup >definer
    state @ 
    if
      case
        [ ' locals-wordlist >definer ] literal \ value
        OF >body POSTPONE Aliteral POSTPONE ! ENDOF
        [ ' clocal >definer ] literal
        OF POSTPONE laddr# >body @ lp-offset, POSTPONE c! ENDOF
        [ ' wlocal >definer ] literal
        OF POSTPONE laddr# >body @ lp-offset, POSTPONE ! ENDOF
        [ ' dlocal >definer ] literal
        OF POSTPONE laddr# >body @ lp-offset, POSTPONE d! ENDOF
        [ ' flocal >definer ] literal
        OF POSTPONE laddr# >body @ lp-offset, POSTPONE f! ENDOF
        abort" can only store TO value or local value"
      endcase
    else
      [ ' locals-wordlist >definer ] literal =
      if
        >body !
      else
        abort" can only store TO value"
      endif
    endif ; immediate
   
   : locals|
       BEGIN
           name 2dup s" |" compare 0<>
       WHILE
           (local)
       REPEAT
       drop 0 (local) ;  immediate restrict

Removed from v.1.3  
changed lines
  Added in v.1.9


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