scsh-conservatory
/
scsh-0.6
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

added SetAlienVal. static string and C char** are tested now.

This commit is contained in:
marting 1999-09-17 19:56:52 +00:00
parent dd5c5ebc81
commit d5ed14075c
4 changed files with 21 additions and 16 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
cig/cig.scm
View File

@ -174,12 +174,12 @@
;;; Emit C code to copy a C string into its carrier. ;;; Emit C code to copy a C string into its carrier.
(define (str-and-len->carrier carrier str) (define (str-and-len->carrier carrier str)
(format #f (format #f
"S48_SET_CAR(~a,(long) ~a); S48_SET_CDR(~a,strlen_or_false(~a));" "SetAlienVal(S48_CAR(~a),(long) ~a); S48_SET_CDR(~a,strlen_or_false(~a));//str-and-len"
carrier str carrier str)) carrier str carrier str))
;;; Carrier and assignment-generator for alien values: ;;; Carrier and assignment-generator for alien values:
(define (simple-assign carrier val) (define (simple-assign carrier val)
(format #f "S48_SET_CAR(~a,(long) ~a);" carrier val)) ;;JMG: untested (format #f "SetAlienVal(~a,(long) ~a);//simple-assign" carrier val)) ;;JMG: untested
;;; Note: When MAKE-CARRIER and S-CVTR fields are taken from this table, ;;; Note: When MAKE-CARRIER and S-CVTR fields are taken from this table,
;;; they are symbols that are syntactically closed in the macro expander's ;;; they are symbols that are syntactically closed in the macro expander's
@ -773,6 +773,7 @@
(define cfile-header-boilerplate (define cfile-header-boilerplate
"/* This is an Scheme48/C interface file, "/* This is an Scheme48/C interface file,
** automatically generated by a hacked version of cig 3.0. ** automatically generated by a hacked version of cig 3.0.
step 3
*/ */
#include <stdio.h> #include <stdio.h>

2
cig/libcig.c
View File

@ -84,7 +84,7 @@ s48_value df_set_strvec_carriers(s48_value g1, s48_value g2)
return S48_FALSE; return S48_FALSE;
} }
s48_value ciginit(void) s48_value s48_init_cig(void)
{ {
S48_EXPORT_FUNCTION(df_strlen_or_false); S48_EXPORT_FUNCTION(df_strlen_or_false);
S48_EXPORT_FUNCTION(df_cstring_nullp); S48_EXPORT_FUNCTION(df_cstring_nullp);

2
cig/libcig.h
View File

@ -11,6 +11,8 @@
#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) (S48_STOB_REF((x),0)) #define AlienVal(x) (S48_STOB_REF((x),0))
//JMG: no () around this, because it's a do..while(0)
#define SetAlienVal(x, v) S48_STOB_SET((x), 0, (v))
// JMG: some hacks to leave to old sources untouched // JMG: some hacks to leave to old sources untouched
#define ENTER_BOOLEAN(x) (x ? S48_TRUE : S48_FALSE) #define ENTER_BOOLEAN(x) (x ? S48_TRUE : S48_FALSE)

26
cig/libcig1.c
View File

@ -125,21 +125,23 @@ void set_strvec_carriers(s48_value svec, char const * const * cvec)
{ {
int svec_len = S48_VECTOR_LENGTH(svec); int svec_len = S48_VECTOR_LENGTH(svec);
char const * const * cv = cvec; char const * const * cv = cvec;
int i = 0;
s48_value s = S48_VECTOR_REF(svec,0); s48_value s = S48_VECTOR_REF(svec,0);
s48_value *sv = &s;
// JMG: now using normalarray access, instead of pointer++ an a s48_value
for(; svec_len > 0; cv++, sv++, svec_len-- ) { for(; svec_len > 0; i++, cv++, svec_len-- ) {
s48_value carrier, alien;
int strl;
// fprintf(stderr, "i is %d, svec_len is %d ", i, svec_len);
/* *sv is a (cons (make-alien <c-string>) <string-length>). */ /* *sv is a (cons (make-alien <c-string>) <string-length>). */
s48_value carrier = *sv; carrier = S48_VECTOR_REF(svec,i);
s48_value alien = S48_CAR(carrier); alien = S48_CAR(carrier);
int strl = strlen(*cv); strl = strlen(*cv);
s48_value cdrinspe = s48_enter_fixnum(strl); //fprintf(stderr, "strl is %d\n", strl);
S48_SET_CDR(carrier, cdrinspe); S48_SET_CDR(carrier, s48_enter_fixnum(strl));
S48_SET_CAR(carrier, (long) *cv); SetAlienVal(alien, (long) *cv);
//AlienVal(alien) = (long) *cv; }
}
} }
/* Helper function for arg checking. Why bother, actually? */ /* Helper function for arg checking. Why bother, actually? */