Diff for /gforth/fi2c.fs between versions 1.16 and 1.23

version 1.16, 2007/03/04 22:39:37 version 1.23, 2010/01/08 18:54:34
Line 1 Line 1
 \ Convert image to C include file  \ Convert image to C include file
   
 \ Copyright (C) 1998,1999,2002,2003 Free Software Foundation, Inc.  \ Copyright (C) 1998,1999,2002,2003,2007 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.  
   
 require string.fs  require string.fs
   
Line 33  wordlist Constant target-environment Line 32  wordlist Constant target-environment
 \ save information of current dictionary to restore with environ>  \ save information of current dictionary to restore with environ>
 Variable env-current   Variable env-current 
   
 : >ENVIRON get-current env-current ! target-environment set-current ;  : >ENVIRON get-current env-current ! target-environment set-current
 : ENVIRON> env-current @ set-current ;     also target-environment context ! ;
   : ENVIRON> previous env-current @ set-current ; 
   
 : t-env? ( addr len -- [ x ] true | false )  : t-env? ( addr len -- [ x ] true | false )
 \G returns the content of environment variable and true or  \G returns the content of environment variable and true or
Line 48  Variable env-current Line 48  Variable env-current
    t-env? dup IF drop THEN ;     t-env? dup IF drop THEN ;
   
 ' Value Alias DefaultValue  ' Value Alias DefaultValue
   ' Value Alias SetValue
   
 : kb 1024 * ;  : kb 1024 * ;
   
   ' noop alias T
   ' noop alias H
   
   : has?  parse-name 2drop true ;
   
 include machpc.fs  include machpc.fs
 ENVIRON>  ENVIRON>
   
Line 75  s" NULL" groups @ cell+ $! Line 81  s" NULL" groups @ cell+ $!
             IF              IF
                 11 /string $has? 0= IF r@ scan-ifs  THEN                  11 /string $has? 0= IF r@ scan-ifs  THEN
             ELSE  2dup s" #else" prefix?              ELSE  2dup s" #else" prefix?
                 IF  r@ scan-ifs                  IF  2drop r@ scan-ifs
                 ELSE  2dup s" GROUP(" prefix?                  ELSE  2dup s" GROUP(" prefix?
                     IF  2drop drop 1+ 0  ELSE                      IF  2drop drop 1+ 0  ELSE
                         2dup s" INST_ADDR(" prefix?                          2dup s" INST_ADDR(" prefix?
Line 105  Variable au Line 111  Variable au
     THEN      THEN
     dup 1 8 tcell @ * 1- lshift and negate or ;      dup 1 8 tcell @ * 1- lshift and negate or ;
   
 1 cells 4 = [IF]  
 : bswap ( n -- n' )  bswap? @ 0= ?EXIT  0  
     over 24 rshift $FF       and or  
     over  8 rshift $FF00     and or  
     over  8 lshift $FF0000   and or  
     over 24 lshift $FF000000 and or nip ;  
 [THEN]  
   
 1 cells 8 = [IF]  
 : bswap ( n -- n' )  bswap? @ 0= ?EXIT  0  
     over 56 rshift $FF               and or  
     over 40 rshift $FF00             and or  
     over 24 rshift $FF0000           and or  
     over  8 rshift $FF000000         and or  
     over  8 lshift $FF00000000       and or  
     over 24 lshift $FF0000000000     and or  
     over 40 lshift $FF000000000000   and or  
     over 56 lshift $FF00000000000000 and or  
     nip ;  
 [THEN]  
   
 : search-magic ( fd -- )  >r  : search-magic ( fd -- )  >r
     BEGIN  magicbuf 8 r@ read-file throw  8 =  WHILE      BEGIN  magicbuf 8 r@ read-file throw  8 =  WHILE
         magicbuf s" Gforth3" tuck str=  UNTIL          magicbuf s" Gforth3" tuck str=  UNTIL
Line 184  Variable bitmap-chars Line 169  Variable bitmap-chars
                         ." INST_ADDR(" type ." )"                          ." INST_ADDR(" type ." )"
                     THEN                      THEN
                 ELSE                  ELSE
                     dup IF  ." ((void*)image)+"  THEN  .08x                      dup IF  ." ((void*)image)+"  $10 -  THEN  .08x
                 THEN                  THEN
             ELSE              ELSE
                 ." (void*)" .08x                  ." (void*)" .08x
Line 213  Variable bitmap-chars Line 198  Variable bitmap-chars
   
 : fi2c ( addr u -- )  base @ >r hex  : fi2c ( addr u -- )  base @ >r hex
     read-image      read-image
     ." static const void* image[" .imagesize ." ] = {" cr .image ." };" cr      \    .\" const static __attribute__ ((__section__ (\".rodata\"))) void* image[" .imagesize ." ] = {" cr .image ." };" cr
       .\" static void* image[" .imagesize ." ] = {" cr .image ." };" cr
     ." #ifdef USE_RELOC" cr      ." #ifdef USE_RELOC" cr
     ." const char reloc_bits[" .relocsize ." ] = {" cr .reloc ." };" cr      ." const char reloc_bits[" .relocsize ." ] = {" cr .reloc ." };" cr
     ." #endif" cr      ." #endif" cr

Removed from v.1.16  
changed lines
  Added in v.1.23


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