[BACK]Return to glocals.fs CVS log [TXT] [DIR] Up to [gforth] / gforth

Diff for /gforth/glocals.fs between versions 1.14 and 1.23

version 1.14, 1995/10/16 18:33:10 version 1.23, 1996/07/16 20:57:09
Line 1 Line 1
   \ A powerful locals implementation
   
   \ Copyright (C) 1995 Free Software Foundation, Inc.
   
   \ This file is part of Gforth.
   
   \ Gforth is free software; you can redistribute it and/or
   \ modify it under the terms of the GNU General Public License
   \ as published by the Free Software Foundation; either version 2
   \ of the License, or (at your option) any later version.
   
   \ This program is distributed in the hope that it will be useful,
   \ but WITHOUT ANY WARRANTY; without even the implied warranty of
   \ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
   \ GNU General Public License for more details.
   
   \ You should have received a copy of the GNU General Public License
   \ along with this program; if not, write to the Free Software
   \ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
   
   
   \ More documentation can be found in the manual and in
   \ http://www.complang.tuwien.ac.at/papers/ertl94l.ps.gz
   
 \ Local variables are quite important for writing readable programs, but  \ Local variables are quite important for writing readable programs, but
 \ IMO (anton) they are the worst part of the standard. There they are very  \ IMO (anton) they are the worst part of the standard. There they are very
 \ restricted and have an ugly interface.  \ restricted and have an ugly interface.
Line 230  previous Line 254  previous
 : new-locals-reveal ( -- )  : new-locals-reveal ( -- )
   true abort" this should not happen: new-locals-reveal" ;    true abort" this should not happen: new-locals-reveal" ;
   
 create new-locals-map ' new-locals-find A, ' new-locals-reveal A,  create new-locals-map ( -- wordlist-map )
   ' new-locals-find A, ' new-locals-reveal A,
   
 vocabulary new-locals  vocabulary new-locals
 new-locals-map ' new-locals >body cell+ A! \ !! use special access words  new-locals-map ' new-locals >body cell+ A! \ !! use special access words
Line 464  forth definitions Line 489  forth definitions
     \ this gives a unique identifier for the way the xt was defined      \ this gives a unique identifier for the way the xt was defined
     \ words defined with different does>-codes have different definers      \ words defined with different does>-codes have different definers
     \ the definer can be used for comparison and in definer!      \ the definer can be used for comparison and in definer!
     dup >code-address [ ' bits >code-address ] Literal =      dup >code-address [ ' spaces >code-address ] Literal =
     \ !! this definition will not work on some implementations for `bits'      \ !! this definition will not work on some implementations for `bits'
     if  \ if >code-address delivers the same value for all does>-def'd words      if  \ if >code-address delivers the same value for all does>-def'd words
         >does-code 1 or \ bit 0 marks special treatment for does codes          >does-code 1 or \ bit 0 marks special treatment for does codes
Line 480  forth definitions Line 505  forth definitions
         code-address!          code-address!
     then ;      then ;
   
 \ !! untested  :noname
 : TO ( c|w|d|r "name" -- ) \ core-ext,local      ' dup >definer [ ' locals-wordlist >definer ] literal =
 \ !! state smart      if
  0 0 0. 0.0e0 { c: clocal w: wlocal d: dlocal f: flocal }          >body !
  ' dup >definer      else
  state @           -&32 throw
  if      endif ;
    case  :noname
      [ ' locals-wordlist >definer ] literal \ value      0 0 0. 0.0e0 { c: clocal w: wlocal d: dlocal f: flocal }
      OF >body POSTPONE Aliteral POSTPONE ! ENDOF      ' dup >definer
      [ ' clocal >definer ] literal      case
      OF POSTPONE laddr# >body @ lp-offset, POSTPONE c! ENDOF          [ ' locals-wordlist >definer ] literal \ value
      [ ' wlocal >definer ] literal          OF >body POSTPONE Aliteral POSTPONE ! ENDOF
      OF POSTPONE laddr# >body @ lp-offset, POSTPONE ! ENDOF          [ ' clocal >definer ] literal
      [ ' dlocal >definer ] literal          OF POSTPONE laddr# >body @ lp-offset, POSTPONE c! ENDOF
      OF POSTPONE laddr# >body @ lp-offset, POSTPONE d! ENDOF          [ ' wlocal >definer ] literal
      [ ' flocal >definer ] literal          OF POSTPONE laddr# >body @ lp-offset, POSTPONE ! ENDOF
      OF POSTPONE laddr# >body @ lp-offset, POSTPONE f! ENDOF          [ ' dlocal >definer ] literal
      -&32 throw          OF POSTPONE laddr# >body @ lp-offset, POSTPONE 2! ENDOF
    endcase          [ ' flocal >definer ] literal
  else          OF POSTPONE laddr# >body @ lp-offset, POSTPONE f! ENDOF
    [ ' locals-wordlist >definer ] literal =          -&32 throw
    if      endcase ;
      >body !  special: TO ( c|w|d|r "name" -- ) \ core-ext,local
    else  
      -&32 throw  
    endif  
  endif ; immediate  
   
 : locals|  : locals|
     \ don't use 'locals|'! use '{'! A portable and free '{'      \ don't use 'locals|'! use '{'! A portable and free '{'
     \ implementation is anslocals.fs      \ implementation is compat/anslocals.fs
     BEGIN      BEGIN
         name 2dup s" |" compare 0<>          name 2dup s" |" compare 0<>
     WHILE      WHILE
Removed from v.1.14  
changed lines
  Added in v.1.23

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