[gforth] / gforth / libcc.fs  

gforth: gforth/libcc.fs

Diff for /gforth/libcc.fs between version 1.36 and 1.37

version 1.36, Tue Jun 17 20:18:11 2008 UTC version 1.37, Tue Jun 17 20:48:21 2008 UTC
Line 464 
Line 464 
     \ the library      \ the library
     assert( c-source-file-id @ 0= )      assert( c-source-file-id @ 0= )
     prepend-dirname { d: filename }      prepend-dirname { d: filename }
     here 0 , lib-handle-addr ! filename 2dup lib-filename 2!      here 0 , lib-handle-addr ! filename lib-filename 2!
     2dup tempdir nip 1+ /string lib-modulename 2!      filename tempdir nip 1+ /string lib-modulename 2!
     s" .c" s+ 2dup w/o create-file throw dup c-source-file-id !      open-wrappers dup if
           lib-handle-addr @ !
           ( 0 c-source-file-id ! ) \ already set
       else
           drop
           filename s" .c" s+ 2dup w/o create-file throw dup c-source-file-id !
     ['] print-c-prefix-lines swap outfile-execute      ['] print-c-prefix-lines swap outfile-execute
     drop free throw ;          drop free throw
       endif ;
   
   : lib-handle ( -- addr )
       lib-handle-addr @ @ ;
   
 : init-c-source-file ( -- )  : init-c-source-file ( -- )
       lib-handle 0= if
     c-source-file-id @ 0= if      c-source-file-id @ 0= if
         here gen-filename c-library-name1          here gen-filename c-library-name1
           endif
     endif ;      endif ;
   
 : c-source-file ( -- file-id )  : c-source-file ( -- file-id )
     c-source-file-id @ assert( dup ) ;      c-source-file-id @ assert( dup ) ;
   
   : notype-execute ( ... xt -- ... )
       what's type { oldtype } try
           ['] 2drop is type execute 0
       restore
           oldtype is type
       endtry
       throw ;
   
   : c-source-file-execute ( ... xt -- ... )
       \ direct the output of xt to c-source-file, or nothing
       lib-handle if
           notype-execute
       else
           c-source-file outfile-execute
       endif ;
   
 : .lib-error ( -- )  : .lib-error ( -- )
     [ifdef] lib-error      [ifdef] lib-error
         ['] cr stderr outfile-execute          ['] cr stderr outfile-execute
Line 486 
Line 513 
   
 DEFER compile-wrapper-function ( -- )  DEFER compile-wrapper-function ( -- )
 : compile-wrapper-function1 ( -- )  : compile-wrapper-function1 ( -- )
       lib-handle 0= if
     c-source-file close-file throw      c-source-file close-file throw
     0 c-source-file-id !      0 c-source-file-id !
     [ libtool-command s"  --silent --mode=compile gcc -I " s+      [ libtool-command s"  --silent --mode=compile gcc -I " s+
Line 501 
Line 529 
     c-libs @ ['] append-l list-map      c-libs @ ['] append-l list-map
 \    2dup type cr  \    2dup type cr
     2dup system drop free throw $? abort" libtool link failed"      2dup system drop free throw $? abort" libtool link failed"
     open-wrappers          open-wrappers dup 0= if
     dup 0= if  
         .lib-error true abort" open-lib failed"          .lib-error true abort" open-lib failed"
     endif      endif
     ( lib-handle ) lib-handle-addr @ !      ( lib-handle ) lib-handle-addr @ !
       endif
     lib-filename 2@ drop free throw 0 0 lib-filename 2! ;      lib-filename 2@ drop free throw 0 0 lib-filename 2! ;
 ' compile-wrapper-function1 IS compile-wrapper-function  ' compile-wrapper-function1 IS compile-wrapper-function
 \    s" ar rcs xxx.a xxx.o" system  \    s" ar rcs xxx.a xxx.o" system
Line 524 
Line 552 
     noname create 2, lib-handle-addr @ ,      noname create 2, lib-handle-addr @ ,
     parse-name { d: c-name }      parse-name { d: c-name }
     here parse-function-types c-name string,      here parse-function-types c-name string,
     ['] gen-wrapper-function c-source-file outfile-execute      ['] gen-wrapper-function c-source-file-execute
   does> ( ... -- ... )    does> ( ... -- ... )
     dup 2@ { xt-defer xt-cfr }      dup 2@ { xt-defer xt-cfr }
     dup cff-lha @ @ 0= if      dup cff-lha @ @ 0= if


Generate output suitable for use with a patch program
Legend:
Removed from v.1.36  
changed lines
  Added in v.1.37

CVS Admin

Powered by ViewCVS 1.0-dev
(Powered by ViewCVS)

ViewCVS and CVS Help