--- gforth/libcc.fs 2008/06/17 18:46:04 1.35 +++ gforth/libcc.fs 2008/07/05 20:09:42 1.39 @@ -155,6 +155,7 @@ variable c-source-file-id \ contains the variable lib-handle-addr \ points to the library handle of the current batch. \ the library handle is 0 if the current \ batch is not yet compiled. + here 0 , lib-handle-addr ! \ just make sure LIB-HANDLE always works 2variable lib-filename \ filename without extension 2variable lib-modulename \ basename of the file without extension @@ -440,6 +441,11 @@ create gen-wrapped-types endif .\" }\n" ; +: open-wrappers ( -- addr ) + lib-filename 2@ s" .la" s+ + 2dup open-lib >r + drop free throw r> ; + : tempdir ( -- c-addr u ) s" TMPDIR" getenv dup 0= if 2drop s" /tmp" @@ -454,25 +460,62 @@ create gen-wrapped-types tempdir s" /" s+ 2over append 2swap drop free throw ; -: c-library-name1 ( c-addr u -- ) - \ set up filenames for a new library; c-addr u is the basename of - \ the library +: c-library-name-setup ( c-addr u -- ) assert( c-source-file-id @ 0= ) prepend-dirname { d: filename } - here 0 , lib-handle-addr ! filename 2dup lib-filename 2! - 2dup tempdir nip 1+ /string lib-modulename 2! - s" .c" s+ 2dup w/o create-file throw dup c-source-file-id ! + here 0 , lib-handle-addr ! filename lib-filename 2! + filename tempdir nip 1+ /string lib-modulename 2! ; + +: c-library-name-create ( -- ) + lib-filename 2@ s" .c" s+ 2dup w/o create-file throw + dup c-source-file-id ! ['] print-c-prefix-lines swap outfile-execute drop free throw ; +: c-library-name1 ( c-addr u -- ) + \ set up filenames for a (possibly new) library; c-addr u is the + \ basename of the library + c-library-name-setup + open-wrappers dup if + lib-handle-addr @ ! + else + drop c-library-name-create + endif ; + +: c-library-name2 ( c-addr u -- ) + \ set up filenames for a new library; c-addr u is the basename of + \ the library + c-library-name-setup c-library-name-create ; + +: lib-handle ( -- addr ) + lib-handle-addr @ @ ; + : init-c-source-file ( -- ) - c-source-file-id @ 0= if - here gen-filename c-library-name1 + lib-handle 0= if + c-source-file-id @ 0= if + here gen-filename c-library-name2 + endif endif ; : c-source-file ( -- file-id ) 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 ( -- ) [ifdef] lib-error ['] cr stderr outfile-execute @@ -481,29 +524,27 @@ create gen-wrapped-types DEFER compile-wrapper-function ( -- ) : compile-wrapper-function1 ( -- ) - c-source-file close-file throw - 0 c-source-file-id ! - [ libtool-command s" --silent --mode=compile gcc -I " s+ - s" includedir" getenv append ] sliteral - s" -O -c " s+ lib-filename 2@ append s" .c -o " append - lib-filename 2@ append s" .lo" append ( c-addr u ) -\ cr 2dup type - 2dup system drop free throw $? abort" libtool compile failed" - [ libtool-command s" --silent --mode=link gcc -module -rpath " s+ ] sliteral - tempdir s+ s" " append - lib-filename 2@ append s" .lo -o " append - lib-filename 2@ append s" .la" append ( c-addr u ) - c-libs @ ['] append-l list-map -\ 2dup type cr - 2dup system drop free throw $? abort" libtool link failed" - lib-filename 2@ s" .la" s+ -\ 2dup type cr - 2dup open-lib dup 0= if - .lib-error true abort" open-lib failed" + lib-handle 0= if + c-source-file close-file throw + 0 c-source-file-id ! + [ libtool-command s" --silent --mode=compile gcc -I " s+ + s" includedir" getenv append ] sliteral + s" -O -c " s+ lib-filename 2@ append s" .c -o " append + lib-filename 2@ append s" .lo" append ( c-addr u ) + \ cr 2dup type + 2dup system drop free throw $? abort" libtool compile failed" + [ libtool-command s" --silent --mode=link gcc -module -rpath " s+ ] sliteral + tempdir s+ s" " append + lib-filename 2@ append s" .lo -o " append + lib-filename 2@ append s" .la" append ( c-addr u ) + c-libs @ ['] append-l list-map + \ 2dup type cr + 2dup system drop free throw $? abort" libtool link failed" + open-wrappers dup 0= if + .lib-error true abort" open-lib failed" + endif + ( lib-handle ) lib-handle-addr @ ! endif - ( lib-handle ) lib-handle-addr @ ! - 2dup delete-file throw drop free throw - lib-filename 2@ s" .c" s+ 2dup delete-file throw drop free throw lib-filename 2@ drop free throw 0 0 lib-filename 2! ; ' compile-wrapper-function1 IS compile-wrapper-function \ s" ar rcs xxx.a xxx.o" system @@ -522,7 +563,7 @@ DEFER compile-wrapper-function ( -- ) noname create 2, lib-handle-addr @ , parse-name { d: c-name } here parse-function-types c-name string, - ['] gen-wrapper-function c-source-file outfile-execute + ['] gen-wrapper-function c-source-file-execute does> ( ... -- ... ) dup 2@ { xt-defer xt-cfr } dup cff-lha @ @ 0= if @@ -557,15 +598,16 @@ clear-libs true abort" Called function of unfinished named C library" ; : c-library-name ( c-addr u -- ) \ gforth -\G Start a C library with name @i{c-addr u}. +\G Start a C library interface with name @i{c-addr u}. clear-libs ['] c-library-incomplete is compile-wrapper-function c-library-name1 ; : c-library ( "name" -- ) \ gforth \G Parsing version of @code{c-library-name} - name save-mem c-library-name ; + parse-name save-mem c-library-name ; -: end-c-library ( -- ) +: end-c-library ( -- ) \ gforth +\G Finish and (if necessary) build the latest C library interface. ['] compile-wrapper-function1 is compile-wrapper-function compile-wrapper-function1 ;