[PATCH] [gforth] libcc.fs: added c-value and c-variable
Josh Grams
one of you gforth maintainers can tell me if this is a reasonable
approach?
Since you can use it for things that aren't constant, I wasn't
comfortable calling the word `c-constant`, so I named it `c-value`
instead.
Hmm...I wonder if I should tackle callbacks while I'm at it?
--Josh
------------------------------------------------------------------------
Index: libcc.fs
===================================================================
RCS file: /nfs/unsafe/cvs-repository/src-master/gforth/libcc.fs,v
retrieving revision 1.61
diff -u -r1.61 libcc.fs
--- libcc.fs 18 Oct 2009 17:52:50 -0000 1.61
+++ libcc.fs 31 Oct 2009 01:20:42 -0000
@@ -67,11 +67,6 @@
\ The files are built in .../lib/gforth/$VERSION/libcc/ or
\ ~/.gforth/libcc/$HOST/.
-\ other things to do:
-
-\ c-variable forth-name c-name
-\ c-constant forth-name c-name
-
\ Todo: conversion between function pointers and xts (both directions)
\ taking an xt and turning it into a function pointer:
@@ -143,6 +138,7 @@
cell% field cff-deferred \ xt of c-function deferred word
cell% field cff-lha \ address of the lib-handle for the lib that
\ contains the wrapper function of the word
+ char% field cff-ctype \ call type (function=1, value=0)
char% field cff-rtype \ return type
char% field cff-np \ number of parameters
1 0 field cff-ptypes \ #npar parameter types
@@ -292,16 +288,38 @@
set-current
-: parse-libcc-type ( "libcc-type" -- u )
- parse-name libcc-types search-wordlist 0= -13 and throw execute ;
+\ call types
+0
+const+ c-func
+const+ c-val
+const+ c-var
+drop
+
+: libcc-type ( c-addr u -- u2 )
+ libcc-types search-wordlist 0= -13 and throw execute ;
+
+: parse-libcc-type ( "libcc-type" -- u ) parse-name libcc-type ;
-: parse-function-types ( "{libcc-type}" "--" "libcc-type" -- )
- here 2 chars allot here begin
+: parse-return-type ( "libcc-type" -- u )
+ parse-libcc-type dup 0< -32 and throw ;
+
+: parse-function-types ( "{libcc-type}" "--" "libcc-type" -- addr )
+ c-func c, here
+ dup 2 chars allot here begin
parse-libcc-type dup 0>= while
c,
repeat
drop here swap - over char+ c!
- parse-libcc-type dup 0< -32 and throw swap c! ;
+ parse-return-type swap c! ;
+
+: parse-value-type ( "{--}" "libcc-type" -- addr )
+ c-val c, here
+ parse-libcc-type dup 0< if drop parse-return-type then
+ c, 0 c, ;
+
+: parse-variable-type ( -- addr )
+ c-var c, here
+ s" a" libcc-type c, 0 c, ;
: type-letter ( n -- c )
chars s" nadrfv" drop + c@ ;
@@ -373,7 +391,7 @@
\ the call itself
-: gen-wrapped-call { d: pars d: c-name fp-change1 sp-change1 -- }
+: gen-wrapped-func { d: pars d: c-name fp-change1 sp-change1 -- }
c-name type ." ("
fp-change1 sp-change1 pars over + swap u+do
i c@ gen-par
@@ -383,6 +401,20 @@
loop
2drop ." )" ;
+: gen-wrapped-const { d: pars d: c-name fp-change1 sp-change1 -- }
+ ." (" c-name type ." )" ;
+
+: gen-wrapped-var { d: pars d: c-name fp-change1 sp-change1 -- }
+ ." &(" c-name type ." )" ;
+
+create gen-call-types
+' gen-wrapped-func ,
+' gen-wrapped-const ,
+' gen-wrapped-var ,
+
+: gen-wrapped-call ( pars c-name fp-change1 sp-change1 -- )
+ 5 pick 3 chars - c@ cells gen-call-types + @ execute ;
+
\ calls for various kinds of return values
: gen-wrapped-void ( pars c-name fp-change1 sp-change1 -- fp-change sp-change )
@@ -594,12 +626,12 @@
endif
wrapper-name drop free throw ;
-: c-function-ft ( xt-defr xt-cfr "c-name" "{libcc-type}" "--" "libcc-type" -- )
+: c-function-ft ( xt-defr xt-cfr xt-parse "c-name" "type signature" -- )
\ build time/first time action for c-function
- init-c-source-file
+ { xt-parse-types } init-c-source-file
noname create 2, lib-handle-addr @ ,
parse-name { d: c-name }
- here parse-function-types c-name string,
+ xt-parse-types execute c-name string,
['] gen-wrapper-function c-source-file-execute
does> ( ... -- ... )
dup 2@ { xt-defer xt-cfr }
@@ -617,11 +649,26 @@
does> ( ... -- ... )
@ call-c ;
-: c-function ( "forth-name" "c-name" "@{type@}" "--" "type" -- ) \ gforth
+: (c-function) ( xt-parse "forth-name" "c-name" "{stack effect}" -- )
+ { xt-parse-types } defer lastxt dup c-function-rt
+ lastxt xt-parse-types c-function-ft
+ lastxt swap defer! ;
+
+: c-function ( "forth-name" "c-name" "@{type@}" "---" "type" -- ) \ gforth
\G Define a Forth word @i{forth-name}. @i{Forth-name} has the
\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! ;
+ ['] parse-function-types (c-function) ;
+
+: c-value ( "forth-name" "c-name" "[---]" "type" -- ) \ gforth
+ \G Define a Forth word @i{forth-name}. @i{Forth-name} has the
+ \G specified stack effect and gives the C value of @code{c-name}.
+ ['] parse-value-type (c-function) ;
+
+: c-variable ( "forth-name" "c-name" -- ) \ gforth
+ \G Define a Forth word @i{forth-name}. @i{Forth-name} returns the
+ \G address of @code{c-name}.
+ ['] parse-variable-type (c-function) ;
+
: clear-libs ( -- ) \ gforth
\G Clear the list of libs
Index: doc/gforth.ds
===================================================================
RCS file: /nfs/unsafe/cvs-repository/src-master/gforth/doc/gforth.ds,v
retrieving revision 1.204
diff -u -r1.204 gforth.ds
--- doc/gforth.ds 22 Apr 2009 10:38:30 -0000 1.204
+++ doc/gforth.ds 31 Oct 2009 01:20:52 -0000
@@ -12251,6 +12251,8 @@
doc-\c
doc-c-function
+doc-c-value
+doc-c-variable
In order to work, this C interface invokes GCC at run-time and uses
dynamic linking. If these features are not available, there are
Josh Grams
------------------------------------------------------------------------
Index: fflib.fs
===================================================================
RCS file: /nfs/unsafe/cvs-repository/src-master/gforth/fflib.fs,v
retrieving revision 1.27
diff -u -r1.27 fflib.fs
--- fflib.fs 24 Feb 2009 22:57:48 -0000 1.27
+++ fflib.fs 31 Oct 2009 00:15:04 -0000
@@ -43,7 +43,7 @@
\c void **gforth_pointers = saved_gforth_pointers;
\c #endif
\c {
-\c /* save global valiables */
+\c /* save global variables */
\c Cell *rp = gforth_RP;
\c Cell *sp = gforth_SP;
\c Float *fp = gforth_FP;
Index: doc/gforth.ds
===================================================================
RCS file: /nfs/unsafe/cvs-repository/src-master/gforth/doc/gforth.ds,v
retrieving revision 1.204
diff -u -r1.204 gforth.ds
--- doc/gforth.ds 22 Apr 2009 10:38:30 -0000 1.204
+++ doc/gforth.ds 31 Oct 2009 00:15:13 -0000
@@ -1306,7 +1306,7 @@
5!a
@end example
-A frequent beginner's error is to leave away necessary white space,
+A frequent beginner's error is to leave out necessary white space,
resulting in an error like @samp{Undefined word}; so if you see such an
error, check if you have put spaces wherever necessary.
@@ -1347,7 +1347,7 @@
@cindex stack tutorial
The most obvious feature of Forth is the stack. When you type in a
-number, it is pushed on the stack. You can display the content of the
+number, it is pushed on the stack. You can display the contents of the
stack with @code{.s}.
@example
@@ -1358,7 +1358,7 @@
@code{.s} displays the top-of-stack to the right, i.e., the numbers
appear in @code{.s} output as they appeared in the input.
-You can print the top of stack element with @code{.}.
+You can print the top element of the stack with @code{.}.
@example
1 2 3 . . .
Index: kernel/toolsext.fs
===================================================================
RCS file: /nfs/unsafe/cvs-repository/src-master/gforth/kernel/toolsext.fs,v
retrieving revision 1.23
diff -u -r1.23 toolsext.fs
--- kernel/toolsext.fs 31 Dec 2007 19:02:25 -0000 1.23
+++ kernel/toolsext.fs 31 Oct 2009 00:15:13 -0000
@@ -165,4 +165,4 @@
0= IF postpone [ELSE] true rdrop 1 countif +! THEN ;
immediate
-\ Warnings on
\ No newline at end of file
+\ Warnings on
pliz
> Hmm...I wonder if I should tackle callbacks while I'm at it?
If you want my vote - you have it!
--
Sergey
Anton Ertl
>I'm posting this here since the gforth list seems to be gone... Maybe
>one of you gforth maintainers can tell me if this is a reasonable
>approach?
It would be easier to answer this question if you told us what you are
trying to achieve and why. Especially since libcc.fs is not the most
beautiful code around, rather the contrary.
>+: c-value ( "forth-name" "c-name" "[---]" "type" -- ) \ gforth
>+ \G Define a Forth word @i{forth-name}. @i{Forth-name} has the
>+ \G specified stack effect and gives the C value of @code{c-name}.
>+ ['] parse-value-type (c-function) ;
>+
>+: c-variable ( "forth-name" "c-name" -- ) \ gforth
>+ \G Define a Forth word @i{forth-name}. @i{Forth-name} returns the
>+ \G address of @code{c-name}.
>+ ['] parse-variable-type (c-function) ;
Hmm, ok, why not. Concerning reasonable approach, sometimes I think
that libcc.fs would benefit a lot from a major rewrite, but where do I
find the time (and I am not sure how to do it well).
- anton
--
M. Anton Ertl http://www.complang.tuwien.ac.at/anton/home.html
comp.lang.forth FAQs: http://www.complang.tuwien.ac.at/forth/faq/toc.html
New standard: http://www.forth200x.org/forth200x.html
EuroForth 2009: http://www.euroforth.org/ef09/
Anton Ertl
Josh Grams
> Josh Grams <jo...@qualdan.com> writes:
>>I'm posting this here since the gforth list seems to be gone... Maybe
>>one of you gforth maintainers can tell me if this is a reasonable
>>approach?
>
> It would be easier to answer this question if you told us what you are
> trying to achieve and why. Especially since libcc.fs is not the most
> beautiful code around, rather the contrary.
Oh, I thought it was obvious. Sorry about that. I wanted to grab some
constants from C. I could have worked around this easily enough by
using \c to define a wrapper macro that took parentheses even though it
didn't need parameters. But since libcc.fs said that c-constant and
c-variable were on the todo list, I thought I'd take a shot at it.
> Concerning reasonable approach, sometimes I think that libcc.fs would
> benefit a lot from a major rewrite, but where do I find the time (and
> I am not sure how to do it well).
Heh. That's pretty much what I was thinking. And it occurred to me
that I could provide an alternate implementation as part of my program:
for my purposes it doesn't actually have to be built into gforth. So I
might try it, if I can find the time.
--Josh