Return to builttag.fs CVS log

Up to [gforth] / gforth / ec

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

1.1       pazsan      1: \ builttag.fs
                      2: 
1.3     ! jwilke      3: 0 [IF]
1.2       anton       4: 
1.3     ! jwilke      5: This is a cross compiler extension.
1.2       anton       6: 
1.3     ! jwilke      7: [THEN]
        !             8: 
        !             9: base @ decimal
1.2       anton      10: 
1.1       pazsan     11: variable builtnr
                     12: create linebuf 200 chars allot
                     13: create filename 200 chars allot
1.3     ! jwilke     14: 0 value btfd
1.1       pazsan     15: 
                     16: : s'
                     17:   [char] ' parse postpone sliteral ; immediate
                     18: 
1.3     ! jwilke     19: [IFDEF] project-name
        !            20: : extractproject ( -- adr len ) project-name ;
        !            21: [ELSE]
        !            22: 
        !            23: defined? sourcefilename 0= [IF]
        !            24:          cr ." I need project-name defined for builttag" abort
        !            25: [THEN]
        !            26: 
        !            27: : extractproject ( -- adr len )
        !            28:   sourcefilename 2dup >r >r
        !            29:   BEGIN dup WHILE 1-
        !            30:         2dup + c@ [char] . = IF r> drop r> drop EXIT THEN
        !            31:   REPEAT 2drop r> r> ;
        !            32: 
        !            33: [THEN]
        !            34: 
        !            35: get-current >MINIMAL
        !            36: 
1.1       pazsan     37: : builttag
1.3     ! jwilke     38:   base @ >r decimal
        !            39:   extractproject filename place
        !            40:   s" .n" filename +place
        !            41:   filename count r/o open-file 
1.1       pazsan     42:   IF   drop 0 builtnr !
                     43:   ELSE         >r linebuf 100 r@ read-line drop drop
                     44:        linebuf swap 0 -rot 0 -rot >number 2drop drop 1+
                     45:        builtnr ! r> close-file throw
                     46:   THEN
1.3     ! jwilke     47:   filename count r/w create-file throw to btfd
        !            48:   builtnr @ s>d <# #S #> btfd write-file throw
        !            49:   s"  constant built#" btfd write-line throw
        !            50:   s' const create builtdate ," ' btfd write-file throw
1.1       pazsan     51:   time&date >r >r >r
1.3     ! jwilke     52:   s>d <# [char] : hold # # #> btfd write-file throw
        !            53:   s>d <# bl hold # # #> btfd write-file throw
1.1       pazsan     54:   drop
1.3     ! jwilke     55:   r> s>d <# [char] . hold # # #> btfd write-file throw
        !            56:   r> s>d <# [char] . hold # # #> btfd write-file throw
        !            57:   r> s>d <# # # # # #> btfd write-file throw
        !            58:   s' "' btfd write-line throw
1.1       pazsan     59:   s' : .built cr ." Built #" built# . ." Date " builtdate count type cr ;'
1.3     ! jwilke     60:   btfd write-line throw
        !            61:   btfd close-file throw
1.1       pazsan     62:   filename count included 
                     63:   r> base ! ;
1.3     ! jwilke     64: 
        !            65: set-current
        !            66: base !