gforth: gforth/glocals.fs

Diff for /gforth/glocals.fs between version 1.11 and 1.19

-version 1.11, Thu Apr 20 09:42:54 1995 UTC
+version 1.19, Fri Feb  9 17:34:10 1996 UTC
  Line 1
  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
  \ IMO (anton) they are the worst part of the standard. There they are very
  \ restricted and have an ugly interface.
- Line 61
+ Line 85
  Line 61
  Line 85
  \ Currently locals may only be
  \ defined at the outer level and TO is not supported.
- include search-order.fs
+ require search-order.fs
- include float.fs
+ require float.fs
- : compile-@local ( n -- ) \ new compile-fetch-local
+ : compile-@local ( n -- ) \ gforth compile-fetch-local
   case
       of postpone @local0 endof
 cells of postpone @local1 endof
- Line 73
+ Line 97
  Line 73
  Line 97
     ( otherwise ) dup postpone @local# ,
   endcase ;
- : compile-f@local ( n -- ) \ new compile-f-fetch-local
+ : compile-f@local ( n -- ) \ gforth compile-f-fetch-local
   case
        of postpone f@local0 endof
 floats of postpone f@local1 endof
- Line 137
+ Line 161
  Line 137
  Line 161
      \ defines the local "name"; the offset of the local shall be
      \ stored in a-addr
      create
-         immediate
+         immediate restrict
          here 0 , ( place for the offset ) ;
  : lp-offset ( n1 -- n2 )
- Line 153
+ Line 177
  Line 153
  Line 177
  vocabulary locals-types \ this contains all the type specifyers, -- and }
  locals-types definitions
- : W:
+ : W: ( "name" -- a-addr xt ) \ gforth w-colon
-     create-local ( "name" -- a-addr xt )
+     create-local
          \ xt produces the appropriate locals pushing code when executed
          ['] compile-pushlocal-w
      does> ( Compilation: -- ) ( Run-time: -- w )
          \ compiles a local variable access
          @ lp-offset compile-@local ;
- : W^
+ : W^ ( "name" -- a-addr xt ) \ gforth w-caret
-     create-local ( "name" -- a-addr xt )
+     create-local
          ['] compile-pushlocal-w
      does> ( Compilation: -- ) ( Run-time: -- w )
          postpone laddr# @ lp-offset, ;
- : F:
+ : F: ( "name" -- a-addr xt ) \ gforth f-colon
-     create-local ( "name" -- a-addr xt )
+     create-local
          ['] compile-pushlocal-f
      does> ( Compilation: -- ) ( Run-time: -- w )
          @ lp-offset compile-f@local ;
- : F^
+ : F^ ( "name" -- a-addr xt ) \ gforth f-caret
-     create-local ( "name" -- a-addr xt )
+     create-local
          ['] compile-pushlocal-f
      does> ( Compilation: -- ) ( Run-time: -- w )
          postpone laddr# @ lp-offset, ;
- : D:
+ : D: ( "name" -- a-addr xt ) \ gforth d-colon
-     create-local ( "name" -- a-addr xt )
+     create-local
          ['] compile-pushlocal-d
      does> ( Compilation: -- ) ( Run-time: -- w )
          postpone laddr# @ lp-offset, postpone 2@ ;
- : D^
+ : D^ ( "name" -- a-addr xt ) \ gforth d-caret
-     create-local ( "name" -- a-addr xt )
+     create-local
          ['] compile-pushlocal-d
      does> ( Compilation: -- ) ( Run-time: -- w )
          postpone laddr# @ lp-offset, ;
- : C:
+ : C: ( "name" -- a-addr xt ) \ gforth c-colon
-     create-local ( "name" -- a-addr xt )
+     create-local
          ['] compile-pushlocal-c
      does> ( Compilation: -- ) ( Run-time: -- w )
          postpone laddr# @ lp-offset, postpone c@ ;
- : C^
+ : C^ ( "name" -- a-addr xt ) \ gforth c-caret
-     create-local ( "name" -- a-addr xt )
+     create-local
          ['] compile-pushlocal-c
      does> ( Compilation: -- ) ( Run-time: -- w )
          postpone laddr# @ lp-offset, ;
- Line 238
+ Line 262
  Line 238
  Line 262
  variable old-dpp
  \ and now, finally, the user interface words
- : { ( -- addr wid 0 )
+ : { ( -- addr wid 0 ) \ gforth open-brace
      dp old-dpp !
      locals-dp dpp !
      also new-locals
- Line 248
+ Line 272
  Line 248
  Line 272
  locals-types definitions
- : } ( addr wid 0 a-addr1 xt1 ... -- )
+ : } ( addr wid 0 a-addr1 xt1 ... -- ) \ gforth close-brace
      \ ends locals definitions
      ] old-dpp @ dpp !
      begin
- Line 262
+ Line 286
  Line 262
  Line 286
      previous previous
      locals-list TO locals-wordlist ;
- : -- ( addr wid 0 ... -- )
+ : -- ( addr wid 0 ... -- ) \ gforth dash-dash
      }
      [char] } parse 2drop ;
- Line 373
+ Line 397
  Line 373
  Line 397
  \ explicit scoping
- : scope ( -- scope )
+ : scope ( compilation  -- scope ; run-time  -- ) \ gforth
   cs-push-part scopestart ; immediate
- : endscope ( scope -- )
+ : endscope ( compilation scope -- ; run-time  -- ) \ gforth
   scope?
   drop
   locals-list @ common-list
- Line 449
+ Line 473
  Line 449
  Line 473
  \ And here's finally the ANS standard stuff
- : (local) ( addr u -- )
+ : (local) ( addr u -- ) \ local paren-local-paren
      \ a little space-inefficient, but well deserved ;-)
      \ In exchange, there are no restrictions whatsoever on using (local)
      \ as long as you use it in a definition
- Line 464
+ Line 488
  Line 464
  Line 488
      \ this gives a unique identifier for the way the xt was defined
      \ words defined with different does>-codes have different definers
      \ 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'
      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
- Line 475
+ Line 499
  Line 475
  Line 499
  : definer! ( definer xt -- )
      \ gives the word represented by xt the behaviour associated with definer
      over 1 and if
-         does-code!
+         swap [ 1 invert ] literal and does-code!
      else
          code-address!
      then ;
- \ !! untested
+ : TO ( c|w|d|r "name" -- ) \ core-ext,local
- : TO ( c|w|d|r "name" -- )
  \ !! state smart
 0 0. 0.0e0 { c: clocal w: wlocal d: dlocal f: flocal }
   ' dup >definer
- Line 495
+ Line 518
  Line 495
  Line 518
       [ ' wlocal >definer ] literal
       OF POSTPONE laddr# >body @ lp-offset, POSTPONE ! ENDOF
       [ ' dlocal >definer ] literal
-      OF POSTPONE laddr# >body @ lp-offset, POSTPONE d! ENDOF
+      OF POSTPONE laddr# >body @ lp-offset, POSTPONE 2! ENDOF
       [ ' flocal >definer ] literal
       OF POSTPONE laddr# >body @ lp-offset, POSTPONE f! ENDOF
       -&32 throw
- Line 510
+ Line 533
  Line 510
  Line 533
   endif ; immediate
  : locals|
+     \ don't use 'locals|'! use '{'! A portable and free '{'
+     \ implementation is anslocals.fs
      BEGIN
          name 2dup s" |" compare 0<>
      WHILE

-Generate output suitable for use with a patch program
+Legend:



Removed from v.1.11
 


changed lines


 
Added in v.1.19
 Legend:



Removed from v.1.11
 


changed lines


 
Added in v.1.19
-Removed from v.1.11
+Added in v.1.19

CVS Admin

gforth: gforth/glocals.fs

Diff for /gforth/glocals.fs between version 1.11 and 1.19

ViewCVS and CVS Help