--- gforth/ec/builttag.fs	1998/12/08 22:02:58	1.2
+++ gforth/ec/builttag.fs	1999/05/20 13:38:28	1.3
@@ -1,55 +1,66 @@
 \ 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
-\ modify it under the terms of the GNU General Public License
-\ as published by the Free Software Foundation; either version 2
-\ 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.
+[THEN]
+
+base @ decimal
 
 variable builtnr
 create linebuf 200 chars allot
 create filename 200 chars allot
-0 value fd
+0 value btfd
 
 : s'
   [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
-  sourcefilename filename place
-  'n filename count + 1 chars - c!
-  filename count r/o bin open-file
+  base @ >r decimal
+  extractproject filename place
+  s" .n" filename +place
+  filename count r/o open-file 
   IF   drop 0 builtnr !
   ELSE 	>r linebuf 100 r@ read-line drop drop
 	linebuf swap 0 -rot 0 -rot >number 2drop drop 1+
 	builtnr ! r> close-file throw
   THEN
-  filename count r/w bin create-file throw to fd
-  base @ >r decimal
-  builtnr @ s>d <# #S #> fd write-file throw
-  s"  constant built#" fd write-line throw
-  s' const create builtdate ," ' fd write-file throw
+  filename count r/w create-file throw to btfd
+  builtnr @ s>d <# #S #> btfd write-file throw
+  s"  constant built#" btfd write-line throw
+  s' const create builtdate ," ' btfd write-file throw
   time&date >r >r >r
-  s>d <# ': hold # # #> fd write-file throw
-  s>d <# bl hold # # #> fd write-file throw
+  s>d <# [char] : hold # # #> btfd write-file throw
+  s>d <# bl hold # # #> btfd write-file throw
   drop
-  r> s>d <# '. hold # # #> fd write-file throw
-  r> s>d <# '. hold # # #> fd write-file throw
-  r> s>d <# # # # # #> fd write-file throw
-  s' "' fd write-line throw
+  r> s>d <# [char] . hold # # #> btfd write-file throw
+  r> s>d <# [char] . hold # # #> btfd write-file throw
+  r> s>d <# # # # # #> btfd write-file throw
+  s' "' btfd write-line throw
   s' : .built cr ." Built #" built# . ." Date " builtdate count type cr ;'
-  fd write-line throw
-  fd close-file throw
+  btfd write-line throw
+  btfd close-file throw
   filename count included 
   r> base ! ;
+
+set-current
+base !