diff --git a/cig/cig.scm b/cig/cig.scm index a0a00d2..7ef900c 100644 --- a/cig/cig.scm +++ b/cig/cig.scm @@ -859,10 +859,11 @@ (map (lambda (c-name) (format #f "~% S48_EXPORT_FUNCTION(~a);" c-name)) 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)))))))))))) ; Frank: end + (define (cig-standalone-toplevel fname) ; ignore your args. (process-define-foreign-file fname) 0) diff --git a/cig/libcig.c b/cig/libcig.c index f8f0f4f..65e4dd8 100644 --- a/cig/libcig.c +++ b/cig/libcig.c @@ -6,81 +6,93 @@ #include /* For malloc. */ #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 * ); - scheme_value ret1; - scheme_value r1; + extern s48_value strlen_or_false(const char * ); + s48_value ret1; + 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; 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 * ); - scheme_value ret1; + s48_value ret1; 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); 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* ); - scheme_value ret1; + extern int c2scheme_strcpy_free(s48_value , char* ); + s48_value ret1; 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); 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* ); - scheme_value ret1; + extern int c2scheme_strcpy(s48_value , char* ); + s48_value ret1; 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); 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* ); - scheme_value ret1; - scheme_value r1; + extern s48_value c_veclen(long* ); + s48_value ret1; + 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; 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])); - return SCHFALSE; - } + + free((void* )AlienVal(g1)); + 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])); - return SCHFALSE; - } + + set_strvec_carriers(g1, (char** )AlienVal(g2)); + 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; +} diff --git a/cig/libcig.h b/cig/libcig.h index 57899f6..7fa4f90 100644 --- a/cig/libcig.h +++ b/cig/libcig.h @@ -8,9 +8,11 @@ //JMG: untested !! #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); diff --git a/cig/libcig1.c b/cig/libcig1.c index e58989f..1b4e24a 100644 --- a/cig/libcig1.c +++ b/cig/libcig1.c @@ -17,10 +17,10 @@ ** 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 ) { - strncpy( (char*) StobData(sstr), cstr, STRING_LENGTH(sstr) ); + strncpy( (char*) StobData(sstr), cstr, S48_STRING_LENGTH(sstr) ); return 1; } 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. */ -int c2scheme_strcpy_free(scheme_value sstr, const char *cstr) +int c2scheme_strcpy_free(s48_value sstr, const char *cstr) { if( cstr ) { - strncpy( (char*) StobData(sstr), cstr, STRING_LENGTH(sstr) ); + strncpy( (char*) StobData(sstr), cstr, S48_STRING_LENGTH(sstr) ); Free(cstr); return 1; } else return 0; } -char *scheme2c_strcpy(scheme_value sstr) +char *scheme2c_strcpy(s48_value sstr) { char *result; int slen; extern int errno; - slen = STRING_LENGTH(sstr); + slen = S48_STRING_LENGTH(sstr); result = Malloc(char, slen+1); if( result == NULL ) { @@ -65,12 +65,12 @@ char *scheme2c_strcpy(scheme_value sstr) ** 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; - if( !vptr ) return SCHFALSE; + if( !vptr ) return S48_FALSE; 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; } -scheme_value strlen_or_false(const char *s) -{ return s ? ENTER_FIXNUM(strlen(s)) : SCHFALSE; } +s48_value strlen_or_false(const char *s) +{ return s ? s48_enter_fixnum(strlen(s)) : S48_FALSE; } /* svec is a Scheme vector of C string carriers. Scan over the C strings ** 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; - 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-- ) { /* *sv is a (cons (make-alien ) ). */ - scheme_value carrier = *sv; - scheme_value alien = CAR(carrier); - CDR(carrier) = ENTER_FIXNUM(strlen(*cv)); - AlienVal(alien) = (long) *cv; - } - } + s48_value carrier = *sv; + s48_value alien = S48_CAR(carrier); + int strl = strlen(*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? */ 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); } } +/* 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); */ +/* } */