Annotation of gforth/ec/builttag.fs, revision 1.7

1.1       pazsan      1: \ builttag.fs
                      2: 
1.7     ! anton       3: \ Copyright (C) 1998,2000,2003,2004,2007 Free Software Foundation, Inc.
1.4       pazsan      4: 
                      5: \ This file is part of Gforth.
                      6: 
                      7: \ Gforth is free software; you can redistribute it and/or
                      8: \ modify it under the terms of the GNU General Public License
1.6       anton       9: \ as published by the Free Software Foundation, either version 3
1.4       pazsan     10: \ of the License, or (at your option) any later version.
                     11: 
                     12: \ This program is distributed in the hope that it will be useful,
                     13: \ but WITHOUT ANY WARRANTY; without even the implied warranty of
                     14: \ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
                     15: \ GNU General Public License for more details.
                     16: 
                     17: \ You should have received a copy of the GNU General Public License
1.6       anton      18: \ along with this program. If not, see http://www.gnu.org/licenses/.
1.4       pazsan     19: 
1.3       jwilke     20: 0 [IF]
1.2       anton      21: 
1.3       jwilke     22: This is a cross compiler extension.
1.2       anton      23: 
1.3       jwilke     24: [THEN]
                     25: 
                     26: base @ decimal
1.2       anton      27: 
1.1       pazsan     28: variable builtnr
                     29: create linebuf 200 chars allot
                     30: create filename 200 chars allot
1.3       jwilke     31: 0 value btfd
1.1       pazsan     32: 
                     33: : s'
                     34:   [char] ' parse postpone sliteral ; immediate
                     35: 
1.3       jwilke     36: [IFDEF] project-name
                     37: : extractproject ( -- adr len ) project-name ;
                     38: [ELSE]
                     39: 
                     40: defined? sourcefilename 0= [IF]
                     41:          cr ." I need project-name defined for builttag" abort
                     42: [THEN]
                     43: 
                     44: : extractproject ( -- adr len )
                     45:   sourcefilename 2dup >r >r
                     46:   BEGIN dup WHILE 1-
                     47:         2dup + c@ [char] . = IF r> drop r> drop EXIT THEN
                     48:   REPEAT 2drop r> r> ;
                     49: 
                     50: [THEN]
                     51: 
                     52: get-current >MINIMAL
                     53: 
1.1       pazsan     54: : builttag
1.3       jwilke     55:   base @ >r decimal
                     56:   extractproject filename place
                     57:   s" .n" filename +place
                     58:   filename count r/o open-file 
1.1       pazsan     59:   IF   drop 0 builtnr !
                     60:   ELSE         >r linebuf 100 r@ read-line drop drop
                     61:        linebuf swap 0 -rot 0 -rot >number 2drop drop 1+
                     62:        builtnr ! r> close-file throw
                     63:   THEN
1.3       jwilke     64:   filename count r/w create-file throw to btfd
                     65:   builtnr @ s>d <# #S #> btfd write-file throw
                     66:   s"  constant built#" btfd write-line throw
                     67:   s' const create builtdate ," ' btfd write-file throw
1.1       pazsan     68:   time&date >r >r >r
1.3       jwilke     69:   s>d <# [char] : hold # # #> btfd write-file throw
                     70:   s>d <# bl hold # # #> btfd write-file throw
1.1       pazsan     71:   drop
1.3       jwilke     72:   r> s>d <# [char] . hold # # #> btfd write-file throw
                     73:   r> s>d <# [char] . hold # # #> btfd write-file throw
                     74:   r> s>d <# # # # # #> btfd write-file throw
                     75:   s' "' btfd write-line throw
1.1       pazsan     76:   s' : .built cr ." Built #" built# . ." Date " builtdate count type cr ;'
1.3       jwilke     77:   btfd write-line throw
                     78:   btfd close-file throw
1.1       pazsan     79:   filename count included 
                     80:   r> base ! ;
1.3       jwilke     81: 
                     82: set-current
                     83: base !

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