--- gforth/libcc.fs 2008/04/25 22:17:17 1.32 +++ gforth/libcc.fs 2008/06/17 20:18:11 1.36 @@ -158,6 +158,8 @@ variable lib-handle-addr \ points to the 2variable lib-filename \ filename without extension 2variable lib-modulename \ basename of the file without extension +: delete-file 2drop 0 ; + : .nb ( n -- ) 0 .r ; @@ -214,6 +216,25 @@ end-struct list% node list-next @ repeat ; +\ linked libraries + +list% + cell% 2* field c-lib-string +end-struct c-lib% + +variable c-libs \ linked list of library names (without "lib") + +: add-lib ( c-addr u -- ) +\G Add library lib@i{string} to the list of libraries, where +\G @i{string} is represented by @i{c-addr u}. + c-lib% %size allocate throw dup >r + c-lib-string 2! + r> c-libs list-insert ; + +: append-l ( c-addr1 u1 node -- c-addr2 u2 ) + \ append " -l" to string1 + >r s" -l" append r> c-lib-string 2@ append ; + \ C prefix lines \ linked list of longcstrings: [ link | count-cell | characters ] @@ -419,23 +440,39 @@ 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" then ; : gen-filename ( x -- c-addr u ) - \ generates a filename without extension for lib-handle-addr X + \ generates a file basename for lib-handle-addr X 0 <<# ['] #s $10 base-execute #> - tempdir s" /gforth_c_" s+ 2swap append #>> ; + s" gforth_c_" 2swap s+ #>> ; + +: prepend-dirname ( c-addr1 u1 -- c-addr2 u2 ) + 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 + 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 ! + ['] print-c-prefix-lines swap outfile-execute + drop free throw ; : init-c-source-file ( -- ) c-source-file-id @ 0= if - here 0 , dup lib-handle-addr ! gen-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 ! - ['] print-c-prefix-lines swap outfile-execute - drop free throw + here gen-filename c-library-name1 endif ; : c-source-file ( -- file-id ) @@ -447,8 +484,8 @@ create gen-wrapped-types lib-error ['] type stderr outfile-execute [then] ; -DEFER compile-wrapper-function -:NONAME ( -- ) +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+ @@ -461,16 +498,16 @@ DEFER compile-wrapper-function tempdir s+ s" " append lib-filename 2@ append s" .lo -o " append lib-filename 2@ append s" .la" append ( c-addr u ) - 2dup system drop free throw $? abort" libtool link failed" - lib-filename 2@ s" .la" s+ + c-libs @ ['] append-l list-map \ 2dup type cr - 2dup open-lib dup 0= if - .lib-error true abort" open-lib failed" + 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 @ ! - 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! ; IS compile-wrapper-function + 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 \ $? abort" ar generated error" ; @@ -509,3 +546,28 @@ DEFER compile-wrapper-function \G specified stack effect and calls the C function @code{c-name}. defer lastxt dup c-function-rt lastxt c-function-ft lastxt swap defer! ; + +: clear-libs ( -- ) +\G Clear the list of libs + c-source-file-id @ if + compile-wrapper-function + endif + 0 c-libs ! ; +clear-libs + +: c-library-incomplete ( -- ) + 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}. + 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 ; + +: end-c-library ( -- ) + ['] compile-wrapper-function1 is compile-wrapper-function + compile-wrapper-function1 ;