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

Diff for /gforth/ec/builttag.fs between versions 1.2 and 1.3

version 1.2, 1998/12/08 22:02:58 version 1.3, 1999/05/20 13:38:28
Line 1 Line 1
 \ builttag.fs  \ builttag.fs
   
 \ Copyright (C) 1998 Free Software Foundation, Inc.  0 [IF]
   
 \ This file is part of Gforth.  This is a cross compiler extension.
   
 \ Gforth is free software; you can redistribute it and/or  [THEN]
 \ modify it under the terms of the GNU General Public License  
 \ as published by the Free Software Foundation; either version 2  base @ decimal
 \ 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.  
   
 variable builtnr  variable builtnr
 create linebuf 200 chars allot  create linebuf 200 chars allot
 create filename 200 chars allot  create filename 200 chars allot
 0 value fd  0 value btfd
   
 : s'  : s'
   [char] ' parse postpone sliteral ; immediate    [char] ' parse postpone sliteral ; immediate
   
   [IFDEF] project-name
   : extractproject ( -- adr len ) project-name ;
   [ELSE]
   
   defined? sourcefilename 0= [IF]
             cr ." I need project-name defined for builttag" abort
   [THEN]
   
   : extractproject ( -- adr len )
     sourcefilename 2dup >r >r
     BEGIN dup WHILE 1-
           2dup + c@ [char] . = IF r> drop r> drop EXIT THEN
     REPEAT 2drop r> r> ;
   
   [THEN]
   
   get-current >MINIMAL
   
 : builttag  : builttag
   sourcefilename filename place    base @ >r decimal
   'n filename count + 1 chars - c!    extractproject filename place
   filename count r/o bin open-file    s" .n" filename +place
     filename count r/o open-file 
   IF   drop 0 builtnr !    IF   drop 0 builtnr !
   ELSE  >r linebuf 100 r@ read-line drop drop    ELSE  >r linebuf 100 r@ read-line drop drop
         linebuf swap 0 -rot 0 -rot >number 2drop drop 1+          linebuf swap 0 -rot 0 -rot >number 2drop drop 1+
         builtnr ! r> close-file throw          builtnr ! r> close-file throw
   THEN    THEN
   filename count r/w bin create-file throw to fd    filename count r/w create-file throw to btfd
   base @ >r decimal    builtnr @ s>d <# #S #> btfd write-file throw
   builtnr @ s>d <# #S #> fd write-file throw    s"  constant built#" btfd write-line throw
   s"  constant built#" fd write-line throw    s' const create builtdate ," ' btfd write-file throw
   s' const create builtdate ," ' fd write-file throw  
   time&date >r >r >r    time&date >r >r >r
   s>d <# ': hold # # #> fd write-file throw    s>d <# [char] : hold # # #> btfd write-file throw
   s>d <# bl hold # # #> fd write-file throw    s>d <# bl hold # # #> btfd write-file throw
   drop    drop
   r> s>d <# '. hold # # #> fd write-file throw    r> s>d <# [char] . hold # # #> btfd write-file throw
   r> s>d <# '. hold # # #> fd write-file throw    r> s>d <# [char] . hold # # #> btfd write-file throw
   r> s>d <# # # # # #> fd write-file throw    r> s>d <# # # # # #> btfd write-file throw
   s' "' fd write-line throw    s' "' btfd write-line throw
   s' : .built cr ." Built #" built# . ." Date " builtdate count type cr ;'    s' : .built cr ." Built #" built# . ." Date " builtdate count type cr ;'
   fd write-line throw    btfd write-line throw
   fd close-file throw    btfd close-file throw
   filename count included     filename count included 
   r> base ! ;    r> base ! ;
   
   set-current
   base !
Removed from v.1.2  
changed lines
  Added in v.1.3

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