[gforth] / gforth / kernel / comp.fs  

gforth: gforth/kernel/comp.fs

Diff for /gforth/kernel/comp.fs between version 1.91 and 1.100

version 1.91, Sat Sep 29 22:20:02 2007 UTC version 1.100, Mon Apr 5 22:17:56 2010 UTC
Line 1 
Line 1 
 \ compiler definitions                                          14sep97jaw  \ compiler definitions                                          14sep97jaw
   
 \ Copyright (C) 1995,1996,1997,1998,2000,2003,2004,2005,2006 Free Software Foundation, Inc.  \ Copyright (C) 1995,1996,1997,1998,2000,2003,2004,2005,2006,2007,2008,2009 Free Software Foundation, Inc.
   
 \ This file is part of Gforth.  \ This file is part of Gforth.
   
 \ Gforth is free software; you can redistribute it and/or  \ Gforth is free software; you can redistribute it and/or
 \ modify it under the terms of the GNU General Public License  \ modify it under the terms of the GNU General Public License
 \ as published by the Free Software Foundation; either version 2  \ as published by the Free Software Foundation, either version 3
 \ of the License, or (at your option) any later version.  \ of the License, or (at your option) any later version.
   
 \ This program is distributed in the hope that it will be useful,  \ This program is distributed in the hope that it will be useful,
Line 15 
Line 15 
 \ GNU General Public License for more details.  \ GNU General Public License for more details.
   
 \ You should have received a copy of the GNU General Public License  \ You should have received a copy of the GNU General Public License
 \ along with this program; if not, write to the Free Software  \ along with this program. If not, see http://www.gnu.org/licenses/.
 \ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111, USA.  
   
 \ \ Revisions-Log  \ \ Revisions-Log
   
Line 117 
Line 116 
     \G puts down string as longcstring      \G puts down string as longcstring
     dup , here swap chars dup allot move ;      dup , here swap chars dup allot move ;
   
   [IFDEF] prelude-mask
   variable next-prelude
   
   : prelude, ( -- )
       next-prelude @ if
           align next-prelude @ ,
       then ;
   [THEN]
   
 : header, ( c-addr u -- ) \ gforth  : header, ( c-addr u -- ) \ gforth
     name-too-long?      name-too-long?
     dup max-name-length @ max max-name-length !      dup max-name-length @ max max-name-length !
       [ [IFDEF] prelude-mask ] prelude, [ [THEN] ]
     align here last !      align here last !
 [ has? flash [IF] ]  [ has? ec [IF] ]
     -1 A,      -1 A,
 [ [ELSE] ]  [ [ELSE] ]
     current @ 1 or A,   \ link field; before revealing, it contains the      current @ 1 or A,   \ link field; before revealing, it contains the
Line 131 
Line 140 
         string,          string,
 [ [ELSE] ]  [ [ELSE] ]
         longstring, alias-mask lastflags cset          longstring, alias-mask lastflags cset
           next-prelude @ 0<> prelude-mask and lastflags cset
           next-prelude off
 [ [THEN] ]  [ [THEN] ]
     cfalign ;      cfalign ;
   
Line 250 
Line 261 
 is basic-block-end  is basic-block-end
 [THEN]  [THEN]
   
   has? primcentric [IF]
 has? peephole [IF]  has? peephole [IF]
   
 \ dynamic only  \ dynamic only
 : peephole-compile, ( xt -- )  : peephole-compile, ( xt -- )
     \ compile xt, appending its code to the current dynamic superinstruction      \ compile xt, appending its code to the current dynamic superinstruction
     here swap , compile-prim1 ;      here swap , compile-prim1 ;
       [ELSE]
           : peephole-compile, ( xt -- addr ) @ , ;
       [THEN]
   
 : compile-to-prims, ( xt -- )  : compile-to-prims, ( xt -- )
     \G compile xt to use primitives (and their peephole optimization)      \G compile xt to use primitives (and their peephole optimization)
Line 275 
Line 289 
         douser:  OF >body @ ['] useraddr peephole-compile, , EXIT ENDOF          douser:  OF >body @ ['] useraddr peephole-compile, , EXIT ENDOF
         dodefer: OF >body ['] lit-perform peephole-compile, , EXIT ENDOF          dodefer: OF >body ['] lit-perform peephole-compile, , EXIT ENDOF
         dofield: OF >body @ ['] lit+ peephole-compile, , EXIT ENDOF          dofield: OF >body @ ['] lit+ peephole-compile, , EXIT ENDOF
           doabicode: OF >body ['] abi-call peephole-compile, , EXIT ENDOF
         \ dofield: OF >body @ POSTPONE literal ['] + peephole-compile, EXIT ENDOF          \ dofield: OF >body @ POSTPONE literal ['] + peephole-compile, EXIT ENDOF
         \ code words and ;code-defined words (code words could be optimized):          \ code words and ;code-defined words (code words could be optimized):
         dup in-dictionary? IF drop POSTPONE literal ['] execute peephole-compile, EXIT THEN          dup in-dictionary? IF drop POSTPONE literal ['] execute peephole-compile, EXIT THEN
Line 353 
Line 368 
 \ \ compiler loop  \ \ compiler loop
   
 : compiler1 ( c-addr u -- ... xt )  : compiler1 ( c-addr u -- ... xt )
     2dup find-name dup      2dup find-name [ [IFDEF] prelude-mask ] run-prelude [ [THEN] ] dup
     if ( c-addr u nt )      if ( c-addr u nt )
         nip nip name>comp          nip nip name>comp
     else      else

Generate output suitable for use with a patch program
Legend:
Removed from v.1.91  
changed lines
  Added in v.1.100
CVS Admin

Powered by ViewCVS 1.0-dev 		(Powered by ViewCVS)

ViewCVS and CVS Help