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

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

version 1.36, 2008/06/17 20:18:11 version 1.37, 2008/06/17 20:48:21
Line 464  create gen-wrapped-types Line 464  create gen-wrapped-types
     \ 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
     ['] print-c-prefix-lines swap outfile-execute          lib-handle-addr @ !
     drop free throw ;          ( 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
           drop free throw
       endif ;
   
   : lib-handle ( -- addr )
       lib-handle-addr @ @ ;
   
 : init-c-source-file ( -- )  : init-c-source-file ( -- )
     c-source-file-id @ 0= if      lib-handle 0= if
         here gen-filename c-library-name1          c-source-file-id @ 0= if
               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  create gen-wrapped-types Line 513  create gen-wrapped-types
   
 DEFER compile-wrapper-function ( -- )  DEFER compile-wrapper-function ( -- )
 : compile-wrapper-function1 ( -- )  : compile-wrapper-function1 ( -- )
     c-source-file close-file throw      lib-handle 0= if
     0 c-source-file-id !          c-source-file close-file throw
     [ libtool-command s"  --silent --mode=compile gcc -I " s+          0 c-source-file-id !
     s" includedir" getenv append ] sliteral          [ libtool-command s"  --silent --mode=compile gcc -I " s+
     s"  -O -c " s+ lib-filename 2@ append s" .c -o " append          s" includedir" getenv append ] sliteral
     lib-filename 2@ append s" .lo" append ( c-addr u )          s"  -O -c " s+ lib-filename 2@ append s" .c -o " append
 \    cr 2dup type          lib-filename 2@ append s" .lo" append ( c-addr u )
     2dup system drop free throw $? abort" libtool compile failed"          \    cr 2dup type
     [ libtool-command s"  --silent --mode=link gcc -module -rpath " s+ ] sliteral          2dup system drop free throw $? abort" libtool compile failed"
     tempdir s+ s"  " append          [ libtool-command s"  --silent --mode=link gcc -module -rpath " s+ ] sliteral
     lib-filename 2@ append s" .lo -o " append          tempdir s+ s"  " append
     lib-filename 2@ append s" .la" append ( c-addr u )          lib-filename 2@ append s" .lo -o " append
     c-libs @ ['] append-l list-map          lib-filename 2@ append s" .la" append ( c-addr u )
 \    2dup type cr          c-libs @ ['] append-l list-map
     2dup system drop free throw $? abort" libtool link failed"          \    2dup type cr
     open-wrappers          2dup system drop free throw $? abort" libtool link failed"
     dup 0= if          open-wrappers dup 0= if
         .lib-error true abort" open-lib failed"              .lib-error true abort" open-lib failed"
           endif
           ( lib-handle ) lib-handle-addr @ !
     endif      endif
     ( lib-handle ) lib-handle-addr @ !  
     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  DEFER compile-wrapper-function ( -- ) Line 552  DEFER compile-wrapper-function ( -- )
     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
Removed from v.1.36  
changed lines
  Added in v.1.37

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