hacked libcig for the new FFI. most of this is untested
This commit is contained in:
parent
77f21395fd
commit
d050b89038
|
@ -859,10 +859,11 @@
|
||||||
(map (lambda (c-name)
|
(map (lambda (c-name)
|
||||||
(format #f "~% S48_EXPORT_FUNCTION(~a);" c-name))
|
(format #f "~% S48_EXPORT_FUNCTION(~a);" c-name))
|
||||||
c-names))))
|
c-names))))
|
||||||
(format oport s48-init-boilerplate fname register-txt))
|
(format oport s48-init-boilerplate (file-name-nondirectory fname) register-txt))
|
||||||
(lp (append c-names (define-foreign-process-form form oport))))))))))))
|
(lp (append c-names (define-foreign-process-form form oport))))))))))))
|
||||||
; Frank: end
|
; Frank: end
|
||||||
|
|
||||||
|
|
||||||
(define (cig-standalone-toplevel fname) ; ignore your args.
|
(define (cig-standalone-toplevel fname) ; ignore your args.
|
||||||
(process-define-foreign-file fname)
|
(process-define-foreign-file fname)
|
||||||
0)
|
0)
|
||||||
|
|
96
cig/libcig.c
96
cig/libcig.c
|
@ -6,81 +6,93 @@
|
||||||
#include <stdlib.h> /* For malloc. */
|
#include <stdlib.h> /* For malloc. */
|
||||||
#include "libcig.h"
|
#include "libcig.h"
|
||||||
|
|
||||||
scheme_value df_strlen_or_false(long nargs, scheme_value *args)
|
s48_value df_strlen_or_false(s48_value g1)
|
||||||
{
|
{
|
||||||
extern scheme_value strlen_or_false(const char * );
|
extern s48_value strlen_or_false(const char * );
|
||||||
scheme_value ret1;
|
s48_value ret1;
|
||||||
scheme_value r1;
|
s48_value r1;
|
||||||
|
|
||||||
cig_check_nargs(1, nargs, "strlen_or_false");
|
|
||||||
r1 = strlen_or_false((const char * )AlienVal(args[0]));
|
r1 = strlen_or_false((const char * )AlienVal(g1));
|
||||||
ret1 = r1;
|
ret1 = r1;
|
||||||
return ret1;
|
return ret1;
|
||||||
}
|
}
|
||||||
|
|
||||||
scheme_value df_cstring_nullp(long nargs, scheme_value *args)
|
s48_value df_cstring_nullp(s48_value g1)
|
||||||
{
|
{
|
||||||
extern int cstring_nullp(const char * );
|
extern int cstring_nullp(const char * );
|
||||||
scheme_value ret1;
|
s48_value ret1;
|
||||||
int r1;
|
int r1;
|
||||||
|
|
||||||
cig_check_nargs(1, nargs, "cstring_nullp");
|
|
||||||
r1 = cstring_nullp((const char * )AlienVal(args[0]));
|
r1 = cstring_nullp((const char * )AlienVal(g1));
|
||||||
ret1 = ENTER_BOOLEAN(r1);
|
ret1 = ENTER_BOOLEAN(r1);
|
||||||
return ret1;
|
return ret1;
|
||||||
}
|
}
|
||||||
|
|
||||||
scheme_value df_c2scheme_strcpy_free(long nargs, scheme_value *args)
|
s48_value df_c2scheme_strcpy_free(s48_value g1, s48_value g2)
|
||||||
{
|
{
|
||||||
extern int c2scheme_strcpy_free(scheme_value , char* );
|
extern int c2scheme_strcpy_free(s48_value , char* );
|
||||||
scheme_value ret1;
|
s48_value ret1;
|
||||||
int r1;
|
int r1;
|
||||||
|
|
||||||
cig_check_nargs(2, nargs, "c2scheme_strcpy_free");
|
|
||||||
r1 = c2scheme_strcpy_free(args[1], (char* )AlienVal(args[0]));
|
r1 = c2scheme_strcpy_free(g1, (char* )AlienVal(g2));
|
||||||
ret1 = ENTER_BOOLEAN(r1);
|
ret1 = ENTER_BOOLEAN(r1);
|
||||||
return ret1;
|
return ret1;
|
||||||
}
|
}
|
||||||
|
|
||||||
scheme_value df_c2scheme_strcpy(long nargs, scheme_value *args)
|
s48_value df_c2scheme_strcpy(s48_value g1, s48_value g2)
|
||||||
{
|
{
|
||||||
extern int c2scheme_strcpy(scheme_value , char* );
|
extern int c2scheme_strcpy(s48_value , char* );
|
||||||
scheme_value ret1;
|
s48_value ret1;
|
||||||
int r1;
|
int r1;
|
||||||
|
|
||||||
cig_check_nargs(2, nargs, "c2scheme_strcpy");
|
|
||||||
r1 = c2scheme_strcpy(args[1], (char* )AlienVal(args[0]));
|
r1 = c2scheme_strcpy(g1, (char* )AlienVal(g2));
|
||||||
ret1 = ENTER_BOOLEAN(r1);
|
ret1 = ENTER_BOOLEAN(r1);
|
||||||
return ret1;
|
return ret1;
|
||||||
}
|
}
|
||||||
|
|
||||||
scheme_value df_c_veclen(long nargs, scheme_value *args)
|
s48_value df_c_veclen(s48_value g1)
|
||||||
{
|
{
|
||||||
extern scheme_value c_veclen(long* );
|
extern s48_value c_veclen(long* );
|
||||||
scheme_value ret1;
|
s48_value ret1;
|
||||||
scheme_value r1;
|
s48_value r1;
|
||||||
|
|
||||||
cig_check_nargs(1, nargs, "c_veclen");
|
|
||||||
r1 = c_veclen((long* )AlienVal(args[0]));
|
r1 = c_veclen((long* )AlienVal(g1));
|
||||||
ret1 = r1;
|
ret1 = r1;
|
||||||
return ret1;
|
return ret1;
|
||||||
}
|
}
|
||||||
|
|
||||||
scheme_value df_free(long nargs, scheme_value *args)
|
s48_value df_free(s48_value g1)
|
||||||
{
|
{
|
||||||
|
|
||||||
|
|
||||||
cig_check_nargs(1, nargs, "free");
|
|
||||||
free((void* )AlienVal(args[0]));
|
free((void* )AlienVal(g1));
|
||||||
return SCHFALSE;
|
return S48_FALSE;
|
||||||
}
|
}
|
||||||
|
|
||||||
scheme_value df_set_strvec_carriers(long nargs, scheme_value *args)
|
s48_value df_set_strvec_carriers(s48_value g1, s48_value g2)
|
||||||
{
|
{
|
||||||
extern void set_strvec_carriers(scheme_value , char** );
|
extern void set_strvec_carriers(s48_value , char** );
|
||||||
|
|
||||||
cig_check_nargs(2, nargs, "set_strvec_carriers");
|
|
||||||
set_strvec_carriers(args[1], (char** )AlienVal(args[0]));
|
set_strvec_carriers(g1, (char** )AlienVal(g2));
|
||||||
return SCHFALSE;
|
return S48_FALSE;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
s48_value ciginit(void)
|
||||||
|
{
|
||||||
|
S48_EXPORT_FUNCTION(df_strlen_or_false);
|
||||||
|
S48_EXPORT_FUNCTION(df_cstring_nullp);
|
||||||
|
S48_EXPORT_FUNCTION(df_c2scheme_strcpy_free);
|
||||||
|
S48_EXPORT_FUNCTION(df_c2scheme_strcpy);
|
||||||
|
S48_EXPORT_FUNCTION(df_c_veclen);
|
||||||
|
S48_EXPORT_FUNCTION(df_free);
|
||||||
|
S48_EXPORT_FUNCTION(df_set_strvec_carriers);
|
||||||
|
|
||||||
|
return S48_UNSPECIFIC;
|
||||||
|
}
|
||||||
|
|
|
@ -8,9 +8,11 @@
|
||||||
//JMG: untested !!
|
//JMG: untested !!
|
||||||
|
|
||||||
#define StrByte(x, i) ((i) + S48_ADDRESS_AFTER_HEADER((x), char))
|
#define StrByte(x, i) ((i) + S48_ADDRESS_AFTER_HEADER((x), char))
|
||||||
// JMG: #define cig_string_body(x) (S48_ADDRESS_AFTER_HEADER((x), char))
|
#define cig_string_body(x) (S48_ADDRESS_AFTER_HEADER((x), char))
|
||||||
|
|
||||||
#define AlienVal(x) (STOB_REF((x),0))
|
#define AlienVal(x) (S48_STOB_REF((x),0))
|
||||||
|
|
||||||
|
#define ENTER_BOOLEAN(x) (x ? S48_TRUE : S48_FALSE)
|
||||||
|
|
||||||
extern char *scheme2c_strcpy(s48_value sstr);
|
extern char *scheme2c_strcpy(s48_value sstr);
|
||||||
|
|
||||||
|
|
|
@ -17,10 +17,10 @@
|
||||||
** If C string is NULL, do nothing and return #f.
|
** If C string is NULL, do nothing and return #f.
|
||||||
*/
|
*/
|
||||||
|
|
||||||
int c2scheme_strcpy(scheme_value sstr, const char *cstr)
|
int c2scheme_strcpy(s48_value sstr, const char *cstr)
|
||||||
{
|
{
|
||||||
if( cstr ) {
|
if( cstr ) {
|
||||||
strncpy( (char*) StobData(sstr), cstr, STRING_LENGTH(sstr) );
|
strncpy( (char*) StobData(sstr), cstr, S48_STRING_LENGTH(sstr) );
|
||||||
return 1;
|
return 1;
|
||||||
}
|
}
|
||||||
else return 0;
|
else return 0;
|
||||||
|
@ -28,23 +28,23 @@ int c2scheme_strcpy(scheme_value sstr, const char *cstr)
|
||||||
|
|
||||||
|
|
||||||
/* Same as above, but free the C string when we are done. */
|
/* Same as above, but free the C string when we are done. */
|
||||||
int c2scheme_strcpy_free(scheme_value sstr, const char *cstr)
|
int c2scheme_strcpy_free(s48_value sstr, const char *cstr)
|
||||||
{
|
{
|
||||||
if( cstr ) {
|
if( cstr ) {
|
||||||
strncpy( (char*) StobData(sstr), cstr, STRING_LENGTH(sstr) );
|
strncpy( (char*) StobData(sstr), cstr, S48_STRING_LENGTH(sstr) );
|
||||||
Free(cstr);
|
Free(cstr);
|
||||||
return 1;
|
return 1;
|
||||||
}
|
}
|
||||||
else return 0;
|
else return 0;
|
||||||
}
|
}
|
||||||
|
|
||||||
char *scheme2c_strcpy(scheme_value sstr)
|
char *scheme2c_strcpy(s48_value sstr)
|
||||||
{
|
{
|
||||||
char *result;
|
char *result;
|
||||||
int slen;
|
int slen;
|
||||||
extern int errno;
|
extern int errno;
|
||||||
|
|
||||||
slen = STRING_LENGTH(sstr);
|
slen = S48_STRING_LENGTH(sstr);
|
||||||
result = Malloc(char, slen+1);
|
result = Malloc(char, slen+1);
|
||||||
|
|
||||||
if( result == NULL ) {
|
if( result == NULL ) {
|
||||||
|
@ -65,12 +65,12 @@ char *scheme2c_strcpy(scheme_value sstr)
|
||||||
** The terminating null is not counted. Returns #f on NULL.
|
** The terminating null is not counted. Returns #f on NULL.
|
||||||
*/
|
*/
|
||||||
|
|
||||||
scheme_value c_veclen(const long *vec)
|
s48_value c_veclen(const long *vec)
|
||||||
{
|
{
|
||||||
const long *vptr = vec;
|
const long *vptr = vec;
|
||||||
if( !vptr ) return SCHFALSE;
|
if( !vptr ) return S48_FALSE;
|
||||||
while( *vptr ) vptr++;
|
while( *vptr ) vptr++;
|
||||||
return ENTER_FIXNUM(vptr - vec);
|
return s48_enter_fixnum(vptr - vec);
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
|
@ -113,28 +113,34 @@ char *copystring_or_die(const char *str ) /* Note: NULL -> NULL. */
|
||||||
|
|
||||||
int cstring_nullp( const char *s ) { return ! s; }
|
int cstring_nullp( const char *s ) { return ! s; }
|
||||||
|
|
||||||
scheme_value strlen_or_false(const char *s)
|
s48_value strlen_or_false(const char *s)
|
||||||
{ return s ? ENTER_FIXNUM(strlen(s)) : SCHFALSE; }
|
{ return s ? s48_enter_fixnum(strlen(s)) : S48_FALSE; }
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
/* svec is a Scheme vector of C string carriers. Scan over the C strings
|
/* svec is a Scheme vector of C string carriers. Scan over the C strings
|
||||||
** in cvec, and initialise the corresponding string carriers in svec.
|
** in cvec, and initialise the corresponding string carriers in svec.
|
||||||
*/
|
*/
|
||||||
void set_strvec_carriers(scheme_value svec, char const * const * cvec)
|
void set_strvec_carriers(s48_value svec, char const * const * cvec)
|
||||||
{
|
{
|
||||||
int svec_len = VECTOR_LENGTH(svec);
|
int svec_len = S48_VECTOR_LENGTH(svec);
|
||||||
char const * const * cv = cvec;
|
char const * const * cv = cvec;
|
||||||
scheme_value *sv = &VECTOR_REF(svec,0);
|
s48_value s = S48_VECTOR_REF(svec,0);
|
||||||
|
s48_value *sv = &s;
|
||||||
|
|
||||||
|
|
||||||
for(; svec_len > 0; cv++, sv++, svec_len-- ) {
|
for(; svec_len > 0; cv++, sv++, svec_len-- ) {
|
||||||
/* *sv is a (cons (make-alien <c-string>) <string-length>). */
|
/* *sv is a (cons (make-alien <c-string>) <string-length>). */
|
||||||
scheme_value carrier = *sv;
|
s48_value carrier = *sv;
|
||||||
scheme_value alien = CAR(carrier);
|
s48_value alien = S48_CAR(carrier);
|
||||||
CDR(carrier) = ENTER_FIXNUM(strlen(*cv));
|
int strl = strlen(*cv);
|
||||||
AlienVal(alien) = (long) *cv;
|
s48_value cdrinspe = s48_enter_fixnum(strl);
|
||||||
}
|
S48_UNSAFE_SET_CDR(carrier, cdrinspe);
|
||||||
}
|
S48_UNSAFE_SET_CAR(carrier, (long) *cv);
|
||||||
|
//AlienVal(alien) = (long) *cv;
|
||||||
|
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
/* Helper function for arg checking. Why bother, actually? */
|
/* Helper function for arg checking. Why bother, actually? */
|
||||||
void cig_check_nargs(int arity, int nargs, const char *fn)
|
void cig_check_nargs(int arity, int nargs, const char *fn)
|
||||||
|
@ -147,3 +153,12 @@ void cig_check_nargs(int arity, int nargs, const char *fn)
|
||||||
exit(-1);
|
exit(-1);
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
/* void ciginit(){ */
|
||||||
|
/* S48_EXPORT_FUNCTION (df_strlen_or_false); */
|
||||||
|
/* S48_EXPORT_FUNCTION (df_c_veclen); */
|
||||||
|
/* S48_EXPORT_FUNCTION (df_set_strvec_carriers); */
|
||||||
|
/* S48_EXPORT_FUNCTION (df_c2scheme_strcpy_free); */
|
||||||
|
/* S48_EXPORT_FUNCTION (df_cstring_nullp); */
|
||||||
|
/* S48_EXPORT_FUNCTION (df_free); */
|
||||||
|
/* S48_EXPORT_FUNCTION (df_c2scheme_strcpy); */
|
||||||
|
/* } */
|
||||||
|
|
Loading…
Reference in New Issue