[gforth] / gforth / kernel / comp.fs  

gforth: gforth/kernel/comp.fs

Diff for /gforth/kernel/comp.fs between version 1.86 and 1.99

version 1.86, Sun Mar 5 20:57:41 2006 UTC version 1.99, Fri Jan 8 18:54:34 2010 UTC
Line 1 
Line 1 
 \ compiler definitions                                          14sep97jaw  \ compiler definitions                                          14sep97jaw
   
 \ Copyright (C) 1995,1996,1997,1998,2000,2003,2004,2005 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 217 
Line 228 
 : char   ( '<spaces>ccc' -- c ) \ core  : char   ( '<spaces>ccc' -- c ) \ core
     \G Skip leading spaces. Parse the string @i{ccc} and return @i{c}, the      \G Skip leading spaces. Parse the string @i{ccc} and return @i{c}, the
     \G display code representing the first character of @i{ccc}.      \G display code representing the first character of @i{ccc}.
     bl word count char@ 2drop ;      parse-name char@ 2drop ;
   
 : [char] ( compilation '<spaces>ccc' -- ; run-time -- c ) \ core bracket-char  : [char] ( compilation '<spaces>ccc' -- ; run-time -- c ) \ core bracket-char
     \G Compilation: skip leading spaces. Parse the string      \G Compilation: skip leading spaces. Parse the string
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 266 
Line 280 
         \ dup >body POSTPONE literal ['] call peephole-compile, >does-code , EXIT          \ dup >body POSTPONE literal ['] call peephole-compile, >does-code , EXIT
     then      then
     dup >code-address CASE      dup >code-address CASE
         docon:   OF >body ['] lit@ peephole-compile, , EXIT ENDOF          dovalue: OF >body ['] lit@ peephole-compile, , EXIT ENDOF
           docon:   OF >body @ ['] lit peephole-compile, , EXIT ENDOF
         \ docon:   OF >body POSTPONE literal ['] @ peephole-compile, EXIT ENDOF          \ docon:   OF >body POSTPONE literal ['] @ peephole-compile, EXIT ENDOF
         \ docon is also used by VALUEs, so don't @ at compile time          \ docon is also used by VALUEs, so don't @ at compile time
         docol:   OF >body ['] call peephole-compile, , EXIT ENDOF          docol:   OF >body ['] call peephole-compile, , EXIT ENDOF
Line 303 
Line 318 
   
 \ \ ticks  \ \ ticks
   
 : name>comp ( nt -- w xt ) \ gforth  : name>comp ( nt -- w xt ) \ gforth name-to-comp
     \G @i{w xt} is the compilation token for the word @i{nt}.      \G @i{w xt} is the compilation token for the word @i{nt}.
     (name>comp)      (name>comp)
     1 = if      1 = if
Line 352 
Line 367 
 \ \ 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
Line 459 
Line 474 
 [THEN]  [THEN]
   
 has? flash [IF]  has? flash [IF]
     : (variable) dpp @ normal-dp = IF  Create      : (variable) dpp @ normal-dp = IF  Create dpp @
         ELSE  normal-dp @ Constant dpp @ ram  THEN ;          ELSE  normal-dp @ Constant dpp @ ram  THEN ;
 : Variable ( "name" -- ) \ core  : Variable ( "name" -- ) \ core
     (Variable) 0 , dpp ! ;      (Variable) 0 , dpp ! ;
Line 694 
Line 709 
     if \ the last word has a header      if \ the last word has a header
         dup ( name>link ) @ -1 =          dup ( name>link ) @ -1 =
         if \ it is still hidden          if \ it is still hidden
             current @ dup >r @ over              forth-wordlist dup >r @ over
             [ has? flash [IF] ] flash! [ [ELSE] ] ! [  [THEN] ] r> !              [ has? flash [IF] ] flash! [ [ELSE] ] ! [  [THEN] ] r> !
         else          else
             drop              drop

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

Powered by ViewCVS 1.0-dev 		(Powered by ViewCVS)

ViewCVS and CVS Help