diff --git a/scsh/bdbmo.c b/scsh/bdbmo.c index 6e41ac8..af97af4 100644 --- a/scsh/bdbmo.c +++ b/scsh/bdbmo.c @@ -19,7 +19,7 @@ int db_check() return 1; } -scheme_value db_open_default(char *file, int flags, int mode, DB **db_ptr) +s48_value db_open_default(char *file, int flags, int mode, DB **db_ptr) { *db_ptr = dbopen(file, flags, mode, DB_BTREE, NULL); if(*db_ptr == NULL) @@ -32,7 +32,7 @@ scheme_value db_open_default(char *file, int flags, int mode, DB **db_ptr) Note: if pass_info is set to zero, all subsequent arguments are ignored, otherwise they are loaded into a BTREEINFO structure and passed to the open routine */ -scheme_value db_open_btree (char *file, int flags, int mode, int pass_info, +s48_value db_open_btree (char *file, int flags, int mode, int pass_info, int access_flags, int cachesize, int maxkeypage, int minkeypage, int psize, int lorder, DB **db_ptr) { @@ -58,7 +58,7 @@ scheme_value db_open_btree (char *file, int flags, int mode, int pass_info, } /* Open a hash type database (same use of pass_info as in btree) */ -scheme_value db_open_hash (char *file, int flags, int mode, int pass_info, +s48_value db_open_hash (char *file, int flags, int mode, int pass_info, int bsize, int ffactor, int nelem, int cachesize, int lorder, DB **db_ptr) { @@ -82,7 +82,7 @@ scheme_value db_open_hash (char *file, int flags, int mode, int pass_info, } /* Open a recno type database (with same use of pass_info again) */ -scheme_value db_open_recno (char *file, int flags, int mode, int pass_info, +s48_value db_open_recno (char *file, int flags, int mode, int pass_info, int access_flags, int cachesize, int psize, int lorder, int reclen, char bval, char *bfname, DB **db_ptr) { diff --git a/scsh/db.c b/scsh/db.c index c41685b..b03bc2a 100644 --- a/scsh/db.c +++ b/scsh/db.c @@ -1,5 +1,5 @@ /* This is an Scheme48/C interface file, -** automatically generated by cig. +** automatically generated by a hacked version of cig 3.0. */ #include @@ -12,19 +12,25 @@ extern int errno; -#define errno_or_false(x) (((x) == -1) ? ENTER_FIXNUM(errno) : SCHFALSE) +#define errno_or_false(x) (((x) == -1) ? s48_enter_fixnum(errno) : S48_FALSE) -scheme_value df_db_open(long nargs, scheme_value *args) +s48_value df_db_open(s48_value g1, s48_value g2, s48_value g3, s48_value g4, s48_value mv_vec) { extern int db_open(const char *, int , int , int , DB** *); - scheme_value ret1; + s48_value ret1; int r1; DB** r2; - cig_check_nargs(5, nargs, "db_open"); - r1 = db_open(cig_string_body(args[4]), EXTRACT_FIXNUM(args[3]), EXTRACT_FIXNUM(args[2]), EXTRACT_FIXNUM(args[1]), &r2); + + r1 = db_open(s48_extract_string(g1), s48_extract_fixnum(g2), s48_extract_fixnum(g3), s48_extract_fixnum(g4), &r2); ret1 = errno_or_false(r1); - AlienVal(VECTOR_REF(*args,0)) = (long) r2; + SetAlienVal(S48_VECTOR_REF(mv_vec,0),(long) r2); return ret1; - } +} +s48_value s48_init_db(void) +{ + S48_EXPORT_FUNCTION(df_db_open); + + return S48_UNSPECIFIC; +} diff --git a/scsh/db.scm b/scsh/db.scm index b4fb839..ac7820b 100644 --- a/scsh/db.scm +++ b/scsh/db.scm @@ -76,7 +76,7 @@ "" "extern int errno;" "" - "#define errno_or_false(x) (((x) == -1) ? ENTER_FIXNUM(errno) : SCHFALSE)" + "#define errno_or_false(x) (((x) == -1) ? s48_enter_fixnum(errno) : S48_FALSE)" "" "") (define-foreign %db-open (db_open (string file) diff --git a/scsh/dbm.c b/scsh/dbm.c index 75c5d87..7fb0386 100644 --- a/scsh/dbm.c +++ b/scsh/dbm.c @@ -13,12 +13,12 @@ extern int errno; -#define errno_or_false(x) (((x) == -1) ? ENTER_FIXNUM(errno) : SCHFALSE) +#define errno_or_false(x) (((x) == -1) ? s48_enter_fixnum(errno) : S48_FALSE) -scheme_value df_db_check(long nargs, scheme_value *args) +s48_value df_db_check(long nargs, s48_value *args) { extern int db_check(void); - scheme_value ret1; + s48_value ret1; int r1; cig_check_nargs(0, nargs, "db_check"); @@ -27,157 +27,157 @@ scheme_value df_db_check(long nargs, scheme_value *args) return ret1; } -scheme_value df_db_open_default(long nargs, scheme_value *args) +s48_value df_db_open_default(long nargs, s48_value *args) { extern int db_open_default(const char *, int , int , DB** *); - scheme_value ret1; + s48_value ret1; int r1; DB** r2; cig_check_nargs(4, nargs, "db_open_default"); - r1 = db_open_default(cig_string_body(args[3]), EXTRACT_FIXNUM(args[2]), EXTRACT_FIXNUM(args[1]), &r2); + r1 = db_open_default(cig_string_body(args[3]), s48_extract_fixnum(args[2]), s48_extract_fixnum(args[1]), &r2); ret1 = errno_or_false(r1); AlienVal(VECTOR_REF(*args,0)) = (long) r2; return ret1; } -scheme_value df_db_open_btree(long nargs, scheme_value *args) +s48_value df_db_open_btree(long nargs, s48_value *args) { extern int db_open_btree(const char *, int , int , int , int , int , int , int , int , int , DB** *); - scheme_value ret1; + s48_value ret1; int r1; DB** r2; cig_check_nargs(11, nargs, "db_open_btree"); - r1 = db_open_btree(cig_string_body(args[10]), EXTRACT_FIXNUM(args[9]), EXTRACT_FIXNUM(args[8]), EXTRACT_FIXNUM(args[7]), EXTRACT_FIXNUM(args[6]), EXTRACT_FIXNUM(args[5]), EXTRACT_FIXNUM(args[4]), EXTRACT_FIXNUM(args[3]), EXTRACT_FIXNUM(args[2]), EXTRACT_FIXNUM(args[1]), &r2); + r1 = db_open_btree(cig_string_body(args[10]), s48_extract_fixnum(args[9]), s48_extract_fixnum(args[8]), s48_extract_fixnum(args[7]), s48_extract_fixnum(args[6]), EXTRACT_FIXNUM(args[5]), EXTRACT_FIXNUM(args[4]), EXTRACT_FIXNUM(args[3]), EXTRACT_FIXNUM(args[2]), EXTRACT_FIXNUM(args[1]), &r2); ret1 = errno_or_false(r1); AlienVal(VECTOR_REF(*args,0)) = (long) r2; return ret1; } -scheme_value df_db_open_hash(long nargs, scheme_value *args) +s48_value df_db_open_hash(long nargs, s48_value *args) { extern int db_open_hash(const char *, int , int , int , int , int , int , int , int , DB** *); - scheme_value ret1; + s48_value ret1; int r1; DB** r2; cig_check_nargs(10, nargs, "db_open_hash"); - r1 = db_open_hash(cig_string_body(args[9]), EXTRACT_FIXNUM(args[8]), EXTRACT_FIXNUM(args[7]), EXTRACT_FIXNUM(args[6]), EXTRACT_FIXNUM(args[5]), EXTRACT_FIXNUM(args[4]), EXTRACT_FIXNUM(args[3]), EXTRACT_FIXNUM(args[2]), EXTRACT_FIXNUM(args[1]), &r2); + r1 = db_open_hash(cig_string_body(args[9]), s48_extract_fixnum(args[8]), s48_extract_fixnum(args[7]), s48_extract_fixnum(args[6]), s48_extract_fixnum(args[5]), EXTRACT_FIXNUM(args[4]), EXTRACT_FIXNUM(args[3]), EXTRACT_FIXNUM(args[2]), EXTRACT_FIXNUM(args[1]), &r2); ret1 = errno_or_false(r1); AlienVal(VECTOR_REF(*args,0)) = (long) r2; return ret1; } -scheme_value df_db_open_recno(long nargs, scheme_value *args) +s48_value df_db_open_recno(long nargs, s48_value *args) { extern int db_open_recno(const char *, int , int , int , int , int , int , int , int , char , const char *, DB** *); - scheme_value ret1; + s48_value ret1; int r1; DB** r2; cig_check_nargs(12, nargs, "db_open_recno"); - r1 = db_open_recno(cig_string_body(args[11]), EXTRACT_FIXNUM(args[10]), EXTRACT_FIXNUM(args[9]), EXTRACT_FIXNUM(args[8]), EXTRACT_FIXNUM(args[7]), EXTRACT_FIXNUM(args[6]), EXTRACT_FIXNUM(args[5]), EXTRACT_FIXNUM(args[4]), EXTRACT_FIXNUM(args[3]), EXTRACT_CHAR(args[2]), cig_string_body(args[1]), &r2); + r1 = db_open_recno(cig_string_body(args[11]), s48_extract_fixnum(args[10]), s48_extract_fixnum(args[9]), s48_extract_fixnum(args[8]), s48_extract_fixnum(args[7]), EXTRACT_FIXNUM(args[6]), EXTRACT_FIXNUM(args[5]), EXTRACT_FIXNUM(args[4]), EXTRACT_FIXNUM(args[3]), s48_extract_char(args[2]), cig_string_body(args[1]), &r2); ret1 = errno_or_false(r1); AlienVal(VECTOR_REF(*args,0)) = (long) r2; return ret1; } -scheme_value df_dbm_close(long nargs, scheme_value *args) +s48_value df_dbm_close(long nargs, s48_value *args) { extern int dbm_close(DBM* ); - scheme_value ret1; + s48_value ret1; int r1; cig_check_nargs(1, nargs, "dbm_close"); r1 = dbm_close((DBM* )AlienVal(args[0])); - ret1 = ENTER_FIXNUM(r1); + ret1 = s48_enter_fixnum(r1); return ret1; } -scheme_value df_dbm_error(long nargs, scheme_value *args) +s48_value df_dbm_error(long nargs, s48_value *args) { extern int dbm_error(DBM* ); - scheme_value ret1; + s48_value ret1; int r1; cig_check_nargs(1, nargs, "dbm_error"); r1 = dbm_error((DBM* )AlienVal(args[0])); - ret1 = ENTER_FIXNUM(r1); + ret1 = s48_enter_fixnum(r1); return ret1; } -scheme_value df_dbm_clearerr(long nargs, scheme_value *args) +s48_value df_dbm_clearerr(long nargs, s48_value *args) { extern int dbm_clearerr(DBM* ); - scheme_value ret1; + s48_value ret1; int r1; cig_check_nargs(1, nargs, "dbm_clearerr"); r1 = dbm_clearerr((DBM* )AlienVal(args[0])); - ret1 = ENTER_FIXNUM(r1); + ret1 = s48_enter_fixnum(r1); return ret1; } -scheme_value df_database_delete(long nargs, scheme_value *args) +s48_value df_database_delete(long nargs, s48_value *args) { - extern int database_delete(DBM* , scheme_value ); - scheme_value ret1; + extern int database_delete(DBM* , s48_value ); + s48_value ret1; int r1; cig_check_nargs(2, nargs, "database_delete"); r1 = database_delete((DBM* )AlienVal(args[1]), args[0]); - ret1 = ENTER_FIXNUM(r1); + ret1 = s48_enter_fixnum(r1); return ret1; } -scheme_value df_database_fetch(long nargs, scheme_value *args) +s48_value df_database_fetch(long nargs, s48_value *args) { - extern const char *database_fetch(DBM* , scheme_value ); - scheme_value ret1; + extern const char *database_fetch(DBM* , s48_value ); + s48_value ret1; const char *r1; cig_check_nargs(3, nargs, "database_fetch"); r1 = database_fetch((DBM* )AlienVal(args[2]), args[1]); - ret1 = VECTOR_REF(*args,0); + ret1 = S48_VECTOR_REF(*args,0); {AlienVal(CAR(ret1)) = (long) r1; CDR(ret1) = strlen_or_false(r1);} return ret1; } -scheme_value df_database_store(long nargs, scheme_value *args) +s48_value df_database_store(long nargs, s48_value *args) { - extern int database_store(DBM* , scheme_value , scheme_value , int ); - scheme_value ret1; + extern int database_store(DBM* , s48_value , s48_value , int ); + s48_value ret1; int r1; cig_check_nargs(4, nargs, "database_store"); - r1 = database_store((DBM* )AlienVal(args[3]), args[2], args[1], EXTRACT_FIXNUM(args[0])); - ret1 = ENTER_FIXNUM(r1); + r1 = database_store((DBM* )AlienVal(args[3]), args[2], args[1], s48_extract_fixnum(args[0])); + ret1 = s48_enter_fixnum(r1); return ret1; } -scheme_value df_database_first(long nargs, scheme_value *args) +s48_value df_database_first(long nargs, s48_value *args) { extern const char *database_first(DBM* ); - scheme_value ret1; + s48_value ret1; const char *r1; cig_check_nargs(2, nargs, "database_first"); r1 = database_first((DBM* )AlienVal(args[1])); - ret1 = VECTOR_REF(*args,0); + ret1 = S48_VECTOR_REF(*args,0); {AlienVal(CAR(ret1)) = (long) r1; CDR(ret1) = strlen_or_false(r1);} return ret1; } -scheme_value df_database_next(long nargs, scheme_value *args) +s48_value df_database_next(long nargs, s48_value *args) { extern const char *database_next(DBM* ); - scheme_value ret1; + s48_value ret1; const char *r1; cig_check_nargs(2, nargs, "database_next"); r1 = database_next((DBM* )AlienVal(args[1])); - ret1 = VECTOR_REF(*args,0); + ret1 = S48_VECTOR_REF(*args,0); {AlienVal(CAR(ret1)) = (long) r1; CDR(ret1) = strlen_or_false(r1);} return ret1; } diff --git a/scsh/dbm.scm b/scsh/dbm.scm index f15cb93..b631856 100644 --- a/scsh/dbm.scm +++ b/scsh/dbm.scm @@ -95,7 +95,7 @@ "" "extern int errno;" "" - "#define errno_or_false(x) (((x) == -1) ? ENTER_FIXNUM(errno) : SCHFALSE)" + "#define errno_or_false(x) (((x) == -1) ? s48_enter_fixnum(errno) : S48_FALSE)" "" "") ;;; This record will hold the pointer the the dbm structure plus diff --git a/scsh/dbm1.c b/scsh/dbm1.c index 854b253..d827c18 100644 --- a/scsh/dbm1.c +++ b/scsh/dbm1.c @@ -13,20 +13,20 @@ extern int errno; -int database_delete(DBM *db, scheme_value key) +int database_delete(DBM *db, s48_value key) { datum work_key; work_key.dptr = ADDRESS_AFTER_HEADER(key, char); - work_key.dsize = STRING_LENGTH(key); + work_key.dsize = S48_STRING_LENGTH(key); return(dbm_delete(db, work_key)); } -char *database_fetch(DBM *db, scheme_value key) +char *database_fetch(DBM *db, s48_value key) { datum work_key, work_data; char *work_string; work_key.dptr = ADDRESS_AFTER_HEADER(key, char); - work_key.dsize = STRING_LENGTH(key); + work_key.dsize = S48_STRING_LENGTH(key); work_data = dbm_fetch(db, work_key); if (work_data.dptr == NULL) { @@ -42,13 +42,13 @@ char *database_fetch(DBM *db, scheme_value key) return(work_string); } -int database_store(DBM *db, scheme_value key, scheme_value data, int flags) +int database_store(DBM *db, s48_value key, s48_value data, int flags) { datum work_key, work_data; work_key.dptr = ADDRESS_AFTER_HEADER(key, char); - work_key.dsize = STRING_LENGTH(key); + work_key.dsize = S48_STRING_LENGTH(key); work_data.dptr = ADDRESS_AFTER_HEADER(data, char); - work_data.dsize = STRING_LENGTH(data); + work_data.dsize = S48_STRING_LENGTH(data); return(dbm_store(db, work_key, work_data, flags)); } diff --git a/scsh/fdports.h b/scsh/fdports.h index 5ebe68b..1d81c02 100644 --- a/scsh/fdports.h +++ b/scsh/fdports.h @@ -1,14 +1,14 @@ /* Macros to access parts of Scheme ports from C. */ /* Copyright (c) 1995 by Olin Shivers. */ -#define PortData_Fd(port_data) (1+(scheme_value*)StobData(port_data)) -#define PortData_Closed(port_data) (2+(scheme_value*)StobData(port_data)) -#define PortData_Peek(port_data) (3+(scheme_value*)StobData(port_data)) -#define PortData_Rev(port_data) (4+(scheme_value*)StobData(port_data)) -#define PortData_OldRev(port_data) (5+(scheme_value*)StobData(port_data)) -/* #define PortData_Mode(port_data) (6+(scheme_value*)StobData(port_data)) */ +#define PortData_Fd(port_data) (1+(s48_value*)StobData(port_data)) +#define PortData_Closed(port_data) (2+(s48_value*)StobData(port_data)) +#define PortData_Peek(port_data) (3+(s48_value*)StobData(port_data)) +#define PortData_Rev(port_data) (4+(s48_value*)StobData(port_data)) +#define PortData_OldRev(port_data) (5+(s48_value*)StobData(port_data)) +/* #define PortData_Mode(port_data) (6+(s48_value*)StobData(port_data)) */ -#define Port_PortData(port) (1+(scheme_value*)StobData(port)) +#define Port_PortData(port) (1+(s48_value*)StobData(port)) #define PortFd(port) (PortData_Fd(*Port_PortData(port))) #define PortClosed(port) (PortData_Closed(*Port_PortData(port))) #define PortRev(port) (PortData_Rev(*Port_PortData(port))) diff --git a/scsh/fdports1.c b/scsh/fdports1.c index cc53bce..10e2e09 100644 --- a/scsh/fdports1.c +++ b/scsh/fdports1.c @@ -51,7 +51,7 @@ static char const *fdes_modestr(int fd) /* The two following routines are for delimited read. */ -scheme_value read_delim(const char *delims, char *buf, +s48_value read_delim(const char *delims, char *buf, int fd, int start, int end, int *nread) { @@ -68,23 +68,23 @@ scheme_value read_delim(const char *delims, char *buf, if( retval == 0 ) { /* Terminal case: EOF. */ *nread = 1 + cptr - buf - start; - return SCHEOF; + return S48_EOF; } else if( retval == -1 ) { /* Terminal case: error. */ *nread = 1 + cptr - buf - start; - return ENTER_FIXNUM(errno); + return s48_enter_fixnum(errno); } else if( delims[c] ) { /* Terminal case: delimiter char. */ - scheme_value ch = ENTER_CHAR(c); + s48_value ch = s48_enter_char(c); *nread = 1 + cptr - buf - start; return ch; } else if( cptr >= bufend ) { /* Terminal case: buffer overflow. */ *nread = end-start; - return SCHFALSE; + return S48_FALSE; } else *++cptr = c; @@ -92,7 +92,7 @@ scheme_value read_delim(const char *delims, char *buf, } -scheme_value skip_chars(const char *skipchars, int fd, int *nread) +s48_value skip_chars(const char *skipchars, int fd, int *nread) { int nr = 0; /* Number of skip chars read. */ @@ -105,17 +105,17 @@ scheme_value skip_chars(const char *skipchars, int fd, int *nread) if( retval == 0 ) { /* Terminal case: EOF. */ *nread = nr; - return SCHFALSE; + return S48_FALSE; } if( retval == -1 ) { /* Terminal case: error. */ *nread = nr; - return ENTER_FIXNUM(errno); + return s48_enter_fixnum(errno); } else if( !skipchars[c] ) { /* Terminal case: non-skip char. */ *nread = nr; - return SCHFALSE; + return S48_FALSE; } nr++; } diff --git a/scsh/fdports1.h b/scsh/fdports1.h index 44432d0..577235b 100644 --- a/scsh/fdports1.h +++ b/scsh/fdports1.h @@ -1,7 +1,7 @@ /* Exports from fdports1.c. */ -scheme_value read_delim(const char *delims, char *buf, +s48_value read_delim(const char *delims, char *buf, int fd, int start, int end, int *nread); -scheme_value skip_chars(const char *skipchars, int fd, int *nread); +s48_value skip_chars(const char *skipchars, int fd, int *nread); diff --git a/scsh/fdports1.old.c b/scsh/fdports1.old.c index 6dc00e5..9be31d7 100644 --- a/scsh/fdports1.old.c +++ b/scsh/fdports1.old.c @@ -39,7 +39,7 @@ extern int errno; static FILE *fstar_cache[NUM_FDPORTS] = {NULL}; /* Maps fd's to ports. */ -static scheme_value fdports[NUM_FDPORTS] = {SCHFALSE}; +static s48_value fdports[NUM_FDPORTS] = {SCHFALSE}; void init_fdports(void) { @@ -51,7 +51,7 @@ void init_fdports(void) remove_bone_from_head_of_linux_libc(); #endif - while( i-- ) fdports[i] = SCHFALSE; + while( i-- ) fdports[i] = S48_FALSE; /* Specially hack stdio. */ fstar_cache[fileno(stdin)] = stdin; @@ -63,10 +63,10 @@ void init_fdports(void) ** Return: the port if there is one allocated; otherwise #f. ** If a port is returned, the revealed count is NOT incremented. */ -scheme_value maybe_fdes2port(int fd) +s48_value maybe_fdes2port(int fd) { if( fd < 0 || fd >= NUM_FDPORTS ) - return SCHFALSE; + return S48_FALSE; return fdports[fd]; } @@ -100,9 +100,9 @@ static char const *fdes_modestr(int fd) } /* Returns a char, #f for EOF, or errno. */ -scheme_value fdport_getchar(scheme_value data) +s48_value fdport_getchar(s48_value data) { - int fd = EXTRACT_FIXNUM(*PortData_Fd(data)); + int fd = s48_extract_fixnum(*PortData_Fd(data)); FILE *f = fstar_cache[fd]; int c; @@ -110,14 +110,14 @@ scheme_value fdport_getchar(scheme_value data) c = getc(f); if( EOF == c ) - return ferror(f) ? ENTER_FIXNUM(errno) : SCHFALSE; + return ferror(f) ? s48_enter_fixnum(errno) : S48_FALSE; else - return ENTER_CHAR(c); + return s48_enter_char(c); } -int fdport_putchar(scheme_value data, char c) +int fdport_putchar(s48_value data, char c) { - int fd = EXTRACT_FIXNUM(*PortData_Fd(data)); + int fd = s48_extract_fixnum(*PortData_Fd(data)); FILE *f = fstar_cache[fd]; int retval = putc(c,f); return (retval == EOF) ? errno : 0; @@ -125,16 +125,16 @@ int fdport_putchar(scheme_value data, char c) /* Not POSIX, so we punt to an OS-specific routine. */ -scheme_value fdport_char_readyp(scheme_value data) +s48_value fdport_char_readyp(s48_value data) { - extern scheme_value stream_char_readyp(FILE *); - return stream_char_readyp(fstar_cache[EXTRACT_FIXNUM(*PortData_Fd(data))]); + extern s48_value stream_char_readyp(FILE *); + return stream_char_readyp(fstar_cache[s48_extract_fixnum(*PortData_Fd(data))]); } -int flush_fdport(scheme_value data) +int flush_fdport(s48_value data) { - FILE *f = fstar_cache[EXTRACT_FIXNUM(*PortData_Fd(data))]; + FILE *f = fstar_cache[s48_extract_fixnum(*PortData_Fd(data))]; return fflush(f) ? errno : 0; } @@ -152,10 +152,10 @@ int flush_all_ports(void) /* return fflush(NULL) ? errno : 0; THE REAL SOLUTION.*/ } -int seek_fdport(scheme_value data, off_t offset, int whence, int *newpos) +int seek_fdport(s48_value data, off_t offset, int whence, int *newpos) { - FILE *f = fstar_cache[EXTRACT_FIXNUM(*PortData_Fd(data))]; - *PortData_Peek(data) = SCHFALSE; /* Flush buffered data. */ + FILE *f = fstar_cache[s48_extract_fixnum(*PortData_Fd(data))]; + *PortData_Peek(data) = S48_FALSE; /* Flush buffered data. */ if( fseek(f, offset, whence) ) /* seek */ { *newpos = 0; return errno; } @@ -165,33 +165,33 @@ int seek_fdport(scheme_value data, off_t offset, int whence, int *newpos) } -int tell_fdport( scheme_value data, int *newpos ) +int tell_fdport( s48_value data, int *newpos ) { - FILE *f = fstar_cache[EXTRACT_FIXNUM(*PortData_Fd(data))]; + FILE *f = fstar_cache[s48_extract_fixnum(*PortData_Fd(data))]; *newpos = ftell(f); return (*newpos < 0) ? errno : 0; } -int set_fdbuf( scheme_value data, int policy, int bufsize ) +int set_fdbuf( s48_value data, int policy, int bufsize ) { - FILE *f = fstar_cache[EXTRACT_FIXNUM(*PortData_Fd(data))]; + FILE *f = fstar_cache[s48_extract_fixnum(*PortData_Fd(data))]; int size = (bufsize < 0) ? BUFSIZ : bufsize; return setvbuf(f, NULL, policy, size) ? errno : 0; } -int close_fdport(scheme_value port_data) +int close_fdport(s48_value port_data) { - if( *PortData_Closed(port_data) == SCHFALSE ) { - int fd = EXTRACT_FIXNUM(*PortData_Fd(port_data)); + if( *PortData_Closed(port_data) == S48_FALSE ) { + int fd = s48_extract_fixnum(*PortData_Fd(port_data)); FILE *f = fstar_cache[fd]; if( fclose(f) ) return errno; - *PortData_Fd(port_data) = SCHFALSE; - fdports[fd] = SCHFALSE; - *PortData_Closed(port_data) = SCHTRUE; - *PortData_Peek(port_data) = SCHFALSE; + *PortData_Fd(port_data) = S48_FALSE; + fdports[fd] = S48_FALSE; + *PortData_Closed(port_data) = S48_TRUE; + *PortData_Peek(port_data) = S48_FALSE; fstar_cache[fd] = NULL; return 0; } @@ -199,21 +199,21 @@ int close_fdport(scheme_value port_data) } -static int cloexec_fdport(scheme_value port_data) +static int cloexec_fdport(s48_value port_data) { - int fd = EXTRACT_FIXNUM(*PortData_Fd(port_data)); + int fd = s48_extract_fixnum(*PortData_Fd(port_data)); return fcntl(fd, F_SETFD, FD_CLOEXEC) ? errno : 0; } -int install_port(int fd, scheme_value port, int revealed) +int install_port(int fd, s48_value port, int revealed) { FILE *stream; const char *modestr; if( fd < 0 || fd >= NUM_FDPORTS ) return -1; - if( fdports[fd] != SCHFALSE ) return -2; + if( fdports[fd] != S48_FALSE ) return -2; if( !(modestr = fdes_modestr(fd)) ) return -3; @@ -257,10 +257,10 @@ static int move_fstar(int fd_from, int fd_to) ** The port's underlying FILE* is also shifted over, so that ** buffered data isn't lost on a shift. Return 0 on success. */ -int move_fdport(int fd, scheme_value port, int new_revealed) +int move_fdport(int fd, s48_value port, int new_revealed) { - scheme_value port_data = *Port_PortData(port); - int old_fd = EXTRACT_FIXNUM(*PortData_Fd(port_data)); + s48_value port_data = *Port_PortData(port); + int old_fd = s48_extract_fixnum(*PortData_Fd(port_data)); if( fd < 0 || fd >= NUM_FDPORTS ) return 1; @@ -268,20 +268,20 @@ int move_fdport(int fd, scheme_value port, int new_revealed) Otherwise, the fd must be unallocated. Kluge. */ if( fdports[fd] != port ) { - if( fdports[fd] != SCHFALSE ) return 1; /* Target already allocated. */ + if( fdports[fd] != S48_FALSE ) return 1; /* Target already allocated. */ if( !move_fstar(old_fd, fd) ) return 1; fdports[fd] = port; - fdports[old_fd] = SCHFALSE; - *PortData_Fd(port_data) = ENTER_FIXNUM(fd); + fdports[old_fd] = S48_FALSE; + *PortData_Fd(port_data) = s48_enter_fixnum(fd); } /* Unreveal the port by shifting the revealed count over to the old-revealed count. */ - *PortData_OldRev(port_data) = ENTER_FIXNUM(EXTRACT_FIXNUM(*PortData_OldRev(port_data))+ - EXTRACT_FIXNUM(*PortData_Rev(port_data))); - *PortData_Rev(port_data) = ENTER_FIXNUM(new_revealed); + *PortData_OldRev(port_data) = s48_enter_fixnum(s48_extract_fixnum(*PortData_OldRev(port_data))+ + s48_extract_fixnum(*PortData_Rev(port_data))); + *PortData_Rev(port_data) = s48_enter_fixnum(new_revealed); if( !new_revealed ) return set_cloexec(fd, 1); return 0; } @@ -301,7 +301,7 @@ void post_gc_fdports(void) #endif for(fd=0; fd 0 ) { char *p = StrByte(buf,start); - *p++ = EXTRACT_CHAR(peek); - *PortData_Peek(data) = SCHFALSE; + *p++ = s48_extract_char(peek); + *PortData_Peek(data) = S48_FALSE; return 1 + fread(p, 1, MIN(len-1, fbufcount(f)), f); } else return 0; @@ -391,9 +391,9 @@ int read_fdport_substring(scheme_value buf, int start, int end, scheme_value dat /* We assume either fileno(f) does blocking i/o or f is unbuffered. */ -int write_fdport_substring(scheme_value buf, int start, int end, scheme_value data) +int write_fdport_substring(s48_value buf, int start, int end, s48_value data) { - FILE *f = fstar_cache[EXTRACT_FIXNUM(*PortData_Fd(data))]; + FILE *f = fstar_cache[s48_extract_fixnum(*PortData_Fd(data))]; int nbytes = end - start; int retval = fwrite(StrByte(buf,start), 1, nbytes, f); return (retval < nbytes) ? -1 : retval; /* -1: error, otw numwritten */ @@ -420,14 +420,14 @@ int write_fdport_substring(scheme_value buf, int start, int end, scheme_value da ** termination. */ -scheme_value read_delim(const char *delims, char *buf, int gobble, - scheme_value port, int start, int end, +s48_value read_delim(const char *delims, char *buf, int gobble, + s48_value port, int start, int end, int *nread) { - scheme_value data = *Port_PortData(port); - scheme_value peekc = *PortData_Peek(data); - int fd = EXTRACT_FIXNUM(*PortData_Fd(data)); + s48_value data = *Port_PortData(port); + s48_value peekc = *PortData_Peek(data); + int fd = s48_extract_fixnum(*PortData_Fd(data)); FILE *f = fstar_cache[fd]; char *cptr = buf+start-1, /* Location of last char deposited. */ *bufend = buf+end-1; /* Last writeable position. */ @@ -437,19 +437,19 @@ scheme_value read_delim(const char *delims, char *buf, int gobble, ** stdio FILE*. Yech. */ if( IsChar(peekc) ) { - char c = EXTRACT_CHAR(peekc); + char c = s48_extract_char(peekc); if( delims[c] ) { /* Is c in cset? */ - if( gobble ) *PortData_Peek(data) = SCHFALSE; + if( gobble ) *PortData_Peek(data) = S48_FALSE; *nread = 0; return peekc; } else if( start >= end ) { *nread = 0; /* Overflow. */ - return SCHFALSE; + return S48_FALSE; } else { *++cptr = c; - *PortData_Peek(data) = SCHFALSE; + *PortData_Peek(data) = S48_FALSE; } } @@ -460,20 +460,20 @@ scheme_value read_delim(const char *delims, char *buf, int gobble, if( EOF == c ) { /* Terminal case: EOF or error. */ *nread = 1 + cptr - buf - start; - return ferror(f) ? ENTER_FIXNUM(errno) : SCHEOF; + return ferror(f) ? s48_enter_fixnum(errno) : S48_EOF; } else if( delims[c] ) { /* Terminal case: delimiter char. */ - scheme_value ch = ENTER_CHAR(c); + s48_value ch = s48_enter_char(c); *nread = 1 + cptr - buf - start; if( !gobble ) *PortData_Peek(data) = ch; return ch; } else if( cptr >= bufend ) { /* Terminal case: buffer overflow. */ - *PortData_Peek(data) = ENTER_CHAR(c); /* Put C back. */ + *PortData_Peek(data) = s48_enter_char(c); /* Put C back. */ *nread = end-start; - return SCHFALSE; + return S48_FALSE; } else *++cptr = c; @@ -481,12 +481,12 @@ scheme_value read_delim(const char *delims, char *buf, int gobble, } -scheme_value skip_chars(const char *skipchars, scheme_value port, int *nread) +s48_value skip_chars(const char *skipchars, s48_value port, int *nread) { - scheme_value data = *Port_PortData(port); - scheme_value peekc = *PortData_Peek(data); - int fd = EXTRACT_FIXNUM(*PortData_Fd(data)); + s48_value data = *Port_PortData(port); + s48_value peekc = *PortData_Peek(data); + int fd = s48_extract_fixnum(*PortData_Fd(data)); FILE *f = fstar_cache[fd]; int nr = 0; /* Number of skip chars read. */ @@ -495,14 +495,14 @@ scheme_value skip_chars(const char *skipchars, scheme_value port, int *nread) ** stdio FILE*. Yech. */ if( IsChar(peekc) ) { - int c = EXTRACT_CHAR(peekc); + int c = s48_extract_char(peekc); if( skipchars[c] ) { /* Is c in cset? */ - *PortData_Peek(data) = SCHFALSE; + *PortData_Peek(data) = S48_FALSE; nr = 1; } else { *nread = 0; - return SCHFALSE; + return S48_FALSE; } } @@ -513,13 +513,13 @@ scheme_value skip_chars(const char *skipchars, scheme_value port, int *nread) if( EOF == c ) { /* Terminal case: EOF or error. */ *nread = nr; - return ferror(f) ? ENTER_FIXNUM(errno) : SCHFALSE; + return ferror(f) ? s48_enter_fixnum(errno) : S48_FALSE; } else if( !skipchars[c] ) { /* Terminal case: non-skip char. */ - *PortData_Peek(data) = ENTER_CHAR(c); + *PortData_Peek(data) = s48_enter_char(c); *nread = nr; - return SCHFALSE; + return S48_FALSE; } nr++; } diff --git a/scsh/flock.c b/scsh/flock.c index 780760f..259ffe7 100644 --- a/scsh/flock.c +++ b/scsh/flock.c @@ -1,5 +1,5 @@ /* This is an Scheme48/C interface file, -** automatically generated by cig. +** automatically generated by a hacked version of cig 3.0. */ #include @@ -15,24 +15,24 @@ extern int errno; /* Make sure foreign-function stubs interface to the C funs correctly: */ #include "flock1.h" -#define errno_or_false(x) (((x) == -1) ? ENTER_FIXNUM(errno) : SCHFALSE) +#define errno_or_false(x) (((x) == -1) ? s48_enter_fixnum(errno) : S48_FALSE) -scheme_value df_set_lock(long nargs, scheme_value *args) +s48_value df_set_lock(s48_value g1, s48_value g2, s48_value g3, s48_value g4, s48_value g5, s48_value g6) { extern int set_lock(int , int , int , int , int , int ); - scheme_value ret1; + s48_value ret1; int r1; - cig_check_nargs(6, nargs, "set_lock"); - r1 = set_lock(EXTRACT_FIXNUM(args[5]), EXTRACT_FIXNUM(args[4]), EXTRACT_FIXNUM(args[3]), EXTRACT_FIXNUM(args[2]), EXTRACT_FIXNUM(args[1]), EXTRACT_FIXNUM(args[0])); + + r1 = set_lock(s48_extract_fixnum(g1), s48_extract_fixnum(g2), s48_extract_fixnum(g3), s48_extract_fixnum(g4), s48_extract_fixnum(g5), s48_extract_fixnum(g6)); ret1 = errno_or_false(r1); return ret1; - } +} -scheme_value df_get_lock(long nargs, scheme_value *args) +s48_value df_get_lock(s48_value g1, s48_value g2, s48_value g3, s48_value g4, s48_value g5, s48_value g6, s48_value mv_vec) { extern int get_lock(int , int , int , int , int , int , int *, int *, int *, int *, int *); - scheme_value ret1; + s48_value ret1; int r1; int r2; int r3; @@ -40,14 +40,21 @@ scheme_value df_get_lock(long nargs, scheme_value *args) int r5; int r6; - cig_check_nargs(7, nargs, "get_lock"); - r1 = get_lock(EXTRACT_FIXNUM(args[6]), EXTRACT_FIXNUM(args[5]), EXTRACT_FIXNUM(args[4]), EXTRACT_FIXNUM(args[3]), EXTRACT_FIXNUM(args[2]), EXTRACT_FIXNUM(args[1]), &r2, &r3, &r4, &r5, &r6); + + r1 = get_lock(s48_extract_fixnum(g1), s48_extract_fixnum(g2), s48_extract_fixnum(g3), s48_extract_fixnum(g4), s48_extract_fixnum(g5), s48_extract_fixnum(g6), &r2, &r3, &r4, &r5, &r6); ret1 = errno_or_false(r1); - VECTOR_REF(*args,0) = ENTER_FIXNUM(r2); - VECTOR_REF(*args,1) = ENTER_FIXNUM(r3); - VECTOR_REF(*args,2) = ENTER_FIXNUM(r4); - VECTOR_REF(*args,3) = ENTER_FIXNUM(r5); - VECTOR_REF(*args,4) = ENTER_FIXNUM(r6); + S48_VECTOR_SET(mv_vec,0,s48_enter_fixnum(r2)); + S48_VECTOR_SET(mv_vec,1,s48_enter_fixnum(r3)); + S48_VECTOR_SET(mv_vec,2,s48_enter_fixnum(r4)); + S48_VECTOR_SET(mv_vec,3,s48_enter_fixnum(r5)); + S48_VECTOR_SET(mv_vec,4,s48_enter_fixnum(r6)); return ret1; - } +} +s48_value s48_init_flock(void) +{ + S48_EXPORT_FUNCTION(df_set_lock); + S48_EXPORT_FUNCTION(df_get_lock); + + return S48_UNSPECIFIC; +} diff --git a/scsh/flock.scm b/scsh/flock.scm index 2f7ac80..5a4eb63 100644 --- a/scsh/flock.scm +++ b/scsh/flock.scm @@ -18,7 +18,7 @@ "/* Make sure foreign-function stubs interface to the C funs correctly: */" "#include \"flock1.h\"" "" - "#define errno_or_false(x) (((x) == -1) ? ENTER_FIXNUM(errno) : SCHFALSE)" + "#define errno_or_false(x) (((x) == -1) ? s48_enter_fixnum(errno) : S48_FALSE)" "" "") (define-foreign %set-lock (set_lock (integer fd) diff --git a/scsh/jcontrol1.c b/scsh/jcontrol1.c index 973f78f..3ee85e6 100644 --- a/scsh/jcontrol1.c +++ b/scsh/jcontrol1.c @@ -46,52 +46,52 @@ long int pending_signals = 0; void scm_handle_sig(int sig) {pending_signals |= (1< +;;; +;;; +;;; +;;; +;;;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=- + +;;; ADDRESS FAMILIES -- +(define address-family/unspecified 0) ; unspecified +(define address-family/unix 1) ; local to host (pipes, portals) +(define address-family/internet 2) ; internetwork: UDP, TCP, etc. + +;;; SOCKET TYPES -- +(define socket-type/stream 1) ; stream socket +(define socket-type/datagram 2) ; datagram socket +(define socket-type/raw 3) ; raw-protocol interface +;;(define socket-type/rdm 4) ; reliably-delivered message +;;(define socket-type/seqpacket 5) ; sequenced packet stream + +;;; PROTOCOL FAMILIES -- +(define protocol-family/unspecified 0) ; unspecified +(define protocol-family/unix 1) ; local to host (pipes, portals) +(define protocol-family/internet 2) ; internetwork: UDP, TCP, etc. + +;;; Well know addresses -- +(define internet-address/any #x00000000) +(define internet-address/loopback #x7f000001) +(define internet-address/broadcast #xffffffff) ; must be masked + +;;; errors from host lookup -- +(define herror/host-not-found 1) ;Authoritative Answer Host not found +(define herror/try-again 2) ;Non-Authoritive Host not found, or SERVERFAIL +(define herror/no-recovery 3) ;Non recoverable errors, FORMERR, REFUSED, NOTIMP +(define herror/no-data 4) ;Valid name, no data record of requested type +(define herror/no-address herror/no-data) ;no address, look for MX record + +;;; flags for send/recv -- +(define message/out-of-band 1) ; process out-of-band data +(define message/peek 2) ; peek at incoming message +(define message/dont-route 4) ; send without using routing tables +(define message/eor 8) ; data completes record +(define message/trunc #x10) ; data discarded before delivery +(define message/ctrunc #x20) ; control data lost before delivery +(define message/wait-all #x40) ; wait for full request or error +(define message/dont-wait #x80) ; this message should be nonblocking + +;;; protocol level for socket options -- +(define level/socket #xffff) ; SOL_SOCKET: options for socket level + +;;; socket options -- +(define socket/debug #x0001) ; turn on debugging info recording +(define socket/accept-connect #x0002) ; socket has had listen() +(define socket/reuse-address #x0004) ; allow local address reuse +(define socket/keep-alive #x0008) ; keep connections alive +(define socket/dont-route #x0010) ; just use interface addresses +(define socket/broadcast #x0020) ; permit sending of broadcast msgs +(define socket/use-loop-back #x0040) ; bypass hardware when possible +(define socket/linger #x0080) ; linger on close if data present +(define socket/oob-inline #x0100) ; leave received OOB data in line +(define socket/reuse-port #x0200) ; allow local address & port reuse +;(define socket/use-privileged #x4000) ; allocate from privileged port area +;(define socket/cant-signal #x8000) ; prevent SIGPIPE on SS_CANTSENDMORE +(define socket/send-buffer #x1001) ; send buffer size +(define socket/receive-buffer #x1002) ; receive buffer size +(define socket/send-low-water #x1003) ; send low-water mark +(define socket/receive-low-water #x1004) ; receive low-water mark +(define socket/send-timeout #x1005) ; send timeout +(define socket/receive-timeout #x1006) ; receive timeout +(define socket/error #x1007) ; get error status and clear +(define socket/type #x1008) ; get socket type + +;;; ip options -- +(define ip/options 1 ) ; buf/ip/opts; set/get ip options +(define ip/header-included 2 ) ; int; header is included with data +(define ip/type-of-service 3 ) ; int; ip type of service and preced. +(define ip/time-to-live 4 ) ; int; ip time to live +(define ip/receive-options 5 ) ; bool; receive all ip opts w/dgram +(define ip/response-options 6 ) ; bool; receive ip opts for response +(define ip/destination-address 7 ) ; bool; receive ip dst addr w/dgram +(define ip/ret-options 8 ) ; ip_opts; set/get ip options +(define ip/multicast-if 9 ) ; u_char; set/get ip multicast i/f +(define ip/multicast-ttl 10 ) ; u_char; set/get ip multicast ttl +(define ip/multicast-loop 11 ) ; u_char; set/get ip multicast loopback +(define ip/add-membership 12 ) ; ip_mreq; add an ip group membership +(define ip/drop-membership 13 ) ; ip_mreq; drop an ip group membership + +;;; tcp options -- +(define tcp/no-delay #x01) ; don't delay send to coalesce packets +(define tcp/max-segment #x02) ; set maximum segment size + +;;; -=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=- +;;; OPTION SETS FOR SOCKET-OPTION AND SET-SOCKET-OPTION + +;;; Boolean Options +(define options/boolean + (list socket/debug + socket/accept-connect + socket/reuse-address + socket/keep-alive + socket/dont-route + socket/broadcast + socket/use-loop-back + socket/oob-inline + socket/reuse-port ;BSD4.4-Lite +; socket/use-privileged +; socket/cant-signal + tcp/no-delay)) + +;;; Integer Options +(define options/value + (list socket/send-buffer + socket/receive-buffer + socket/send-low-water + socket/receive-low-water + socket/error + socket/type + ip/time-to-live + tcp/max-segment)) + +;;; #f or Positive Integer +(define options/linger + (list socket/linger)) + +;;; Real Number +(define options/timeout + (list socket/send-timeout + socket/receive-timeout)) diff --git a/scsh/machine/packages.scm b/scsh/machine/packages.scm new file mode 100644 index 0000000..1749fd1 --- /dev/null +++ b/scsh/machine/packages.scm @@ -0,0 +1,137 @@ +;;; Interfaces and packages for the BSD4.4-Lite specific parts of scsh. +;;; Copyright (c) 1994 by Olin Shivers. +;;; Copyright (c) 1994 by Brian D. Carlstrom. + +(define-interface bsd44lite-fdflags-extras-interface + (export open/shared-lock + open/exclusive-lock + open/async + open/fsync + fcntl/get-owner + fcntl/set-owner)) + +(define-interface bsd44lite-errno-extras-interface + (export errno/notblk + errno/txtbsy + errno/wouldblock + errno/inprogress + errno/already + errno/notsock + errno/destaddrreq + errno/msgsize + errno/prototype + errno/noprotoopt + errno/protonosupport + errno/socktnosupport + errno/opnotsupp + errno/pfnosupport + errno/afnosupport + errno/addrinuse + errno/addrnotavail + errno/netdown + errno/netunreach + errno/netreset + errno/connaborted + errno/connreset + errno/nobufs + errno/isconn + errno/notconn + errno/shutdown + errno/toomanyrefs + errno/timedout + errno/connrefused + errno/loop + errno/hostdown + errno/hostunreach + errno/proclim + errno/users + errno/dquot + errno/stale + errno/remote + errno/badrpc + errno/rpcmismatch + errno/progunavail + errno/progmismatch + errno/ftype + errno/auth + errno/needauth + errno/last)) + +(define-interface bsd44lite-signals-extras-interface + (export signal/trap + signal/emt + signal/bus + signal/sys + signal/urg + signal/cld + signal/io + signal/xcpu + signal/xfsz + signal/vtalrm + signal/prof + signal/winch + signal/info)) + +(define-interface bsd44lite-network-extras-interface + (export socket/debug + socket/accept-connect + socket/reuse-address + socket/keep-alive + socket/dont-route + socket/broadcast + socket/use-loop-back + socket/linger + socket/oob-inline + socket/reuse-port ;bsd44lite +; socket/use-privileged +; socket/cant-signal + socket/send-buffer + socket/receive-buffer + socket/send-low-water + socket/receive-low-water + socket/send-timeout + socket/receive-timeout + socket/error + socket/type +;;; all ip/* but ip/options and ip/time-to-live bsd44lite only + ip/options + ip/header-included + ip/type-of-service + ip/time-to-live + ip/receive-options + ip/response-options + ip/destination-address + ip/ret-options + ip/multicast-if + ip/multicast-ttl + ip/multicast-loop + ip/add-membership + ip/drop-membership + tcp/no-delay + tcp/max-segment + message/eor + message/trunc + message/ctrunc + message/wait-all + message/dont-wait)) + +(define-interface bsd44lite-extras-interface + (compound-interface bsd44lite-errno-extras-interface + bsd44lite-fdflags-extras-interface + bsd44lite-network-extras-interface + bsd44lite-signals-extras-interface)) + +(define-interface bsd44lite-defs-interface + (compound-interface bsd44lite-extras-interface + sockets-network-interface + posix-errno-interface + posix-fdflags-interface + posix-signals-interface + signals-internals-interface)) + +(define-structure bsd44lite-defs bsd44lite-defs-interface + (open scheme bitwise defenum-package) + (files fdflags errno signals netconst)) + +(define-interface os-extras-interface bsd44lite-extras-interface) +(define os-dependent bsd44lite-defs) diff --git a/scsh/machine/signals.scm b/scsh/machine/signals.scm new file mode 100644 index 0000000..6a4b933 --- /dev/null +++ b/scsh/machine/signals.scm @@ -0,0 +1,72 @@ +;;; Signal constant definitions for BSD4.4-Lite +;;; Copyright (c) 1994 by Olin Shivers. +;;; Copyright (c) 1994 by Brian D. Carlstrom. + +(define-enum-constants signal + ;; POSIX + (hup 1) ; hangup + (int 2) ; interrupt + (quit 3) ; quit + (ill 4) ; illegal instruction (not reset when caught) + + ;; BSD4.4-Lite + (trap 5) ; trace trap (not reset when caught) + + ;; POSIX + (iot 6) ; IOT instruction + (abrt 6) ; used by abort, replace SIGIOT in the future + + ;; BSD4.4-Lite + (emt 7) ; EMT instruction + + ;; POSIX + (fpe 8) ; floating point exception + (kill 9) ; kill (cannot be caught or ignored) + + ;; BSD4.4-Lite + (bus 10) ; bus error + + ;; POSIX + (segv 11) ; segmentation violation + + ;; BSD4.4-Lite + (sys 12) ; bad argument to system call + + ;; POSIX + (pipe 13) ; write on a pipe with no one to read it + (alrm 14) ; alarm clock + (term 15) ; software termination signal from kill + + ;; BSD4.4-Lite + (urg 16) ; urgent condition on IO channel + + ;; POSIX + (stop 17) ; sendable stop signal not from tty + (tstp 18) ; stop signal from tty + (cont 19) ; continue a stopped process + (chld 20) ; to parent on child stop or exit + + ;; BSD4.4-Lite + (cld 20) ; System V name for SIGCHLD + + ;; POSIX + (ttin 21) ; to readers pgrp upon background tty read + (ttou 22) ; like TTIN for output if (tp->t_local<OSTOP) + + ;; BSD4.4-Lite + (io 23) ; input/output possible signal + (xcpu 24) ; exceeded CPU time limit + (xfsz 25) ; exceeded file size limit + (vtalrm 26) ; virtual time alarm + (prof 27) ; profiling time alarm + (winch 28) ; window changed + (info 29) ; information request + + ;; User defined + (usr1 30) ; user defined signal 1 + (usr2 31) ; user defined signal 2 + ) + +(define signals-ignored-by-default + (list signal/chld signal/cont ; These are Posix. + signal/info signal/io signal/urg signal/winch)) ; These are BSD. diff --git a/scsh/machine/signals1.c b/scsh/machine/signals1.c new file mode 100644 index 0000000..8f077fd --- /dev/null +++ b/scsh/machine/signals1.c @@ -0,0 +1,129 @@ +/* Need to turn off synchronous error signals (SIGPIPE, SIGSYS). */ + +#include "../scsh_aux.h" + +/* Make sure our exports match up w/the implementation: */ +#include "../signals1.h" + +/* This table converts Unix signal numbers to S48/scsh interrupt numbers. +** If the signal doesn't have an interrupt number, the entry is -1. +** (Only asynchronous signals have interrupt numbers.) +** +** Note that we bake into this table the integer values of the signals -- +** i.e., we assume that SIGHUP=1, SIGALRM=15, etc. So this definition is +** very system-dependent. +*/ +const int sig2int[] = { + -1, /* 0 is not a signal */ + scshint_hup, /* SIGHUP */ + scshint_keyboard, /* SIGINT */ + scshint_quit, /* SIGQUIT */ + -1, /* SIGILL */ + -1, /* SIGTRAP */ + -1, /* SIGABRT & SIGIOT */ + -1, /* SIGEMT */ + -1, /* SIGFPE */ + -1, /* SIGKILL */ + -1, /* SIGBUS */ + -1, /* SIGSEGV */ + -1, /* SIGSYS */ + -1, /* SIGPIPE */ + scshint_alarm, /* SIGALRM */ + scshint_term, /* SIGTERM */ + scshint_urg, /* SIGURG */ + -1, /* SIGSTOP */ + scshint_tstp, /* SIGTSTP */ + scshint_cont, /* SIGCONT */ + scshint_chld, /* SIGCHLD */ + -1, /* scshint_ttyin, /* SIGTTIN */ + -1, /* scshint_ttou, /* SIGTTOU */ + scshint_io, /* SIGIO */ + scshint_xcpu, /* SIGXCPU */ + scshint_xfsz, /* SIGXFSZ */ + scshint_vtalrm, /* SIGVTALRM */ + scshint_prof, /* SIGPROF */ + scshint_winch, /* SIGWINCH */ + scshint_info, /* SIGINFO */ + scshint_usr1, /* SIGUSR1 */ + scshint_usr2 /* SIGUSR2 */ + }; + +const int max_sig = 31; /* SIGUSR2 */ + +/* +scshint_alarm +scshint_keyboard +scshint_memory_shortage +scshint_chld +scshint_cont +scshint_hup +scshint_quit +scshint_term +scshint_tstp +scshint_usr1 +scshint_usr2 +scshint_info +scshint_io +scshint_poll +scshint_prof +scshint_pwr +scshint_urg +scshint_vtalrm +scshint_winch +scshint_xcpu +scshint_xfsz + +SIGALRM +SIGCHLD +SIGCONT +SIGHUP +SIGINFO +SIGINT +SIGIO +SIGPROF +SIGQUIT +SIGTERM +SIGTSTP +SIGTTIN +SIGTTOU +SIGURG +SIGUSR1 +SIGUSR2 +SIGVTALRM +SIGWINCH +SIGXCPU +SIGXFSZ + +SIGHUP 1 +SIGINT 2 +SIGQUIT 3 +SIGILL 4 +SIGTRAP 5 +SIGABRT 6 +SIGIOT SIGABRT +SIGEMT 7 +SIGFPE 8 +SIGKILL 9 +SIGBUS 10 +SIGSEGV 11 +SIGSYS 12 +SIGPIPE 13 +SIGALRM 14 +SIGTERM 15 +SIGURG 16 +SIGSTOP 17 +SIGTSTP 18 +SIGCONT 19 +SIGCHLD 20 +SIGTTIN 21 +SIGTTOU 22 +SIGIO 23 +SIGXCPU 24 +SIGXFSZ 25 +SIGVTALRM 26 +SIGPROF 27 +SIGWINCH 28 +SIGINFO 29 +SIGUSR1 30 +SIGUSR2 31 +*/ diff --git a/scsh/machine/sigset.h b/scsh/machine/sigset.h new file mode 100644 index 0000000..f30fa8c --- /dev/null +++ b/scsh/machine/sigset.h @@ -0,0 +1,10 @@ +/* Convert between a lo24/hi integer-pair bitset and a sigset_t value. +** These macros are OS-dependent, and must be defined per-OS. +*/ + +#define make_sigset(maskp, hi, lo) (*maskp=((hi)<<24)|(lo)) + +/* Not a procedure: */ +#define split_sigset(mask, hip, lop) \ + ((*(hip)=(mask>>24)&0xff), \ + (*(lop)=(mask&0xffffff))) diff --git a/scsh/machine/stdio_dep.c b/scsh/machine/stdio_dep.c new file mode 100644 index 0000000..39b1efe --- /dev/null +++ b/scsh/machine/stdio_dep.c @@ -0,0 +1,83 @@ +/* Copyright (c) 1994 by Olin Shivers. +** Copyright (c) 1994-1995 by Brian D. Carlstrom. +** +** This file implements the char-ready? procedure for file descriptors +** and Scsh's fdports. It is not Posix, so it must be implemented for +** each OS to which scsh is ported. +** +** This version assumes two things: +** - the existence of select to tell if there is data +** available for the file descriptor. +** - the existence of the _cnt field in the stdio FILE struct, telling +** if there is any buffered input in the struct. +** +** Most Unixes have these things, so this file should work for them. +** However, Your Mileage May Vary. +** +** You could also replace the select() with a iotctl(FIONREAD) call, if you +** had one but not the other. +** -Olin&Brian +*/ + +#include +#include +#include +#include +#include "libcig.h" +#include + +#include "stdio_dep.h" /* Make sure the .h interface agrees with the code. */ + +/* These two procs return #t if data ready, #f data not ready, +** and errno if error. +*/ + +s48_value char_ready_fdes(int fd) +{ + fd_set readfds; + struct timeval timeout; + int result; + + FD_ZERO(&readfds); + FD_SET(fd,&readfds); + + timeout.tv_sec=0; + timeout.tv_usec=0; + + result=select(fd+1, &readfds, NULL, NULL, &timeout); + + if(result == -1 ) + return(s48_enter_fixnum(errno)); + if(result) + return(S48_TRUE); + return(S48_FALSE); +} + +s48_value stream_char_readyp(FILE *f) +{ + int fd = fileno(f); + return f->_r > 0 ? S48_TRUE : char_ready_fdes(fd); +} + +void setfileno(FILE *fs, int fd) +{ + fileno(fs) = fd; +} + +int fbufcount(FILE* fs) +{ + return(fs->_r); +} + +/* Returns true if there is no buffered data in stream FS +** (or there is no buffering, period.) +*/ + +int ibuf_empty(FILE *fs) {return fs->_r <= 0;} + + +/* Returns true if the buffer in stream FS is full +** (or there is no buffering, period). +*/ + +int obuf_full(FILE *fs) {return fs->_w <= 0;} diff --git a/scsh/machine/stdio_dep.h b/scsh/machine/stdio_dep.h new file mode 100644 index 0000000..435ebf0 --- /dev/null +++ b/scsh/machine/stdio_dep.h @@ -0,0 +1,13 @@ +/* Exports from stdio_dep.h. */ + +s48_value char_ready_fdes(int fd); + +s48_value stream_char_readyp(FILE *f); + +void setfileno(FILE *fs, int fd); + +int fbufcount(FILE* fs); + +int ibuf_empty(FILE *fs); + +int obuf_full(FILE *fs); diff --git a/scsh/machine/sysdep.h b/scsh/machine/sysdep.h new file mode 100644 index 0000000..e69de29 diff --git a/scsh/machine/time_dep.scm b/scsh/machine/time_dep.scm new file mode 100644 index 0000000..7f8adf4 --- /dev/null +++ b/scsh/machine/time_dep.scm @@ -0,0 +1,8 @@ +;;; OS-dependent time stuff +;;; Copyright (c) 1995 by Olin Shivers. + +;;; This suffices for BSD systems with the gettimeofday() +;;; microsecond-resolution timer. + +(define (ticks/sec) 1000000) ; usec + diff --git a/scsh/machine/time_dep1.c b/scsh/machine/time_dep1.c new file mode 100644 index 0000000..8e799e0 --- /dev/null +++ b/scsh/machine/time_dep1.c @@ -0,0 +1,38 @@ +/* OS-dependent support for fine-grained timer. +** Copyright (c) 1995 by Olin Shivers. +** +** We return the current time in seconds and sub-second "ticks" where the +** number of ticks/second is OS dependent (and is defined in time_dep.scm). +** This definition works on any BSD Unix with the gettimeofday() +** microsecond-resolution timer. +*/ + +#include +#include +#include "scheme48.h" +#include "../time1.h" + +/* Sux because it's dependent on 32-bitness. */ +#define hi8(i) (((i)>>24) & 0xff) +#define lo24(i) ((i) & 0xffffff) +#define comp8_24(hi, lo) (((hi)<<24) + (lo)) + +s48_value time_plus_ticks(int *hi_secs, int *lo_secs, + int *hi_ticks, int *lo_ticks) +{ + struct timeval t; + struct timezone tz; + + if( gettimeofday(&t, &tz) ) return s48_enter_fixnum(errno); + + { long int secs = t.tv_sec; + long int ticks = t.tv_usec; + + *hi_secs = hi8(secs); + *lo_secs = lo24(secs); + *hi_ticks = hi8(ticks); + *lo_ticks = lo24(ticks); + } + + return S48_FALSE; + } diff --git a/scsh/machine/tty-consts.scm b/scsh/machine/tty-consts.scm new file mode 100644 index 0000000..51cf348 --- /dev/null +++ b/scsh/machine/tty-consts.scm @@ -0,0 +1,220 @@ +;;; Constant definitions for tty control code (POSIX termios). +;;; Copyright (c) 1995 by Brian Carlstrom. +;;; Largely rehacked by Olin. +;;; Constants from NetBSD header files substituted by Bill Sommerfeld + +;;; These constants are for NetBSD 1.1 pre-alpha +;;; and are taken from /usr/include/sys/termios.h. These should +;;; work with any BSD4.4-Lite derived system (such as FreeBSD). + +;;; Non-standard (POSIX, SVR4, 4.3+BSD) things: +;;; - Some of the baud rates. + + +;;; Special Control Characters +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Indices into the c_cc[] character array. + +;;; Name Subscript Enabled by +;;; ---- --------- ---------- +;;; POSIX +(define ttychar/eof 0) ; ^d icanon +(define ttychar/eol 1) ; icanon + +(define ttychar/delete-char 3) ; ^? icanon + +(define ttychar/delete-line 5) ; ^u icanon + +(define ttychar/interrupt 8) ; ^c isig +(define ttychar/quit 9) ; ^\ isig +(define ttychar/suspend 10) ; ^z isig + +(define ttychar/start 12) ; ^q ixon, ixoff +(define ttychar/stop 13) ; ^s ixon, ixoff +(define ttychar/min 16) ; !icanon ; Not exported +(define ttychar/time 17) ; !icanon ; Not exported + +;;; SVR4 & 4.3+BSD +(define ttychar/eol2 2) ; icanon +(define ttychar/delete-word 4) ; ^w icanon +(define ttychar/reprint 6) ; ^r icanon +(define ttychar/delayed-suspend 11) ; ^y isig +(define ttychar/literal-next 14) ; ^v iexten +(define ttychar/discard 15) ; ^o iexten + +;;; 4.3+BSD +(define ttychar/status 18) ; ^t icanon + +;;; Length of control-char string -- *Not Exported* +(define num-ttychars 20) + +;;; Magic "disable feature" tty character +(define disable-tty-char (ascii->char #xff)) ; _POSIX_VDISABLE + +;;; Flags controllling input processing +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;;; POSIX +(define ttyin/ignore-break #x00001) ; ignbrk +(define ttyin/interrupt-on-break #x00002) ; brkint +(define ttyin/ignore-bad-parity-chars #x00004) ; ignpar +(define ttyin/mark-parity-errors #x00008) ; parmrk +(define ttyin/check-parity #x00010) ; inpck +(define ttyin/7bits #x00020) ; istrip +(define ttyin/nl->cr #x00040) ; inlcr +(define ttyin/ignore-cr #x00080) ; igncr +(define ttyin/cr->nl #x00100) ; icrnl +(define ttyin/output-flow-ctl #x00200) ; ixon +(define ttyin/input-flow-ctl #x00400) ; ixoff + +;;; SVR4 & 4.3+BSD +(define ttyin/xon-any #x00800) ; ixany: Any char restarts after stop +(define ttyin/beep-on-overflow #x02000) ; imaxbel: queue full => ring bell + +;;; SVR4 +(define ttyin/lowercase #f) ; iuclc: Map upper-case to lower case + + +;;; Flags controlling output processing +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;;; POSIX +(define ttyout/enable #x000001) ; opost: enable output processing + +;;; SVR4 & 4.3+BSD +(define ttyout/nl->crnl #x000002) ; onlcr: map nl to cr-nl + +;;; 4.3+BSD +(define ttyout/discard-eot #x000008) ; onoeot +(define ttyout/expand-tabs #x000004) ; oxtabs (NOT xtabs) + +;;; SVR4 +(define ttyout/cr->nl #f) ; ocrnl +(define ttyout/fill-w/del #f) ; ofdel +(define ttyout/delay-w/fill-char #f) ; ofill +(define ttyout/uppercase #f) ; olcuc +(define ttyout/nl-does-cr #f) ; onlret +(define ttyout/no-col0-cr #f) ; onocr + +;;; Newline delay +(define ttyout/nl-delay #f) ; mask (nldly) +(define ttyout/nl-delay0 #f) +(define ttyout/nl-delay1 #f) ; tty 37 + +;;; Horizontal-tab delay +(define ttyout/tab-delay #f) ; mask (tabdly) +(define ttyout/tab-delay0 #f) +(define ttyout/tab-delay1 #f) ; tty 37 +(define ttyout/tab-delay2 #f) +(define ttyout/tab-delayx #f) ; Expand tabs (xtabs, tab3) + +;;; Carriage-return delay +(define ttyout/cr-delay #f) ; mask (crdly) +(define ttyout/cr-delay0 #f) +(define ttyout/cr-delay1 #f) ; tn 300 +(define ttyout/cr-delay2 #f) ; tty 37 +(define ttyout/cr-delay3 #f) ; concept 100 + +;;; Vertical tab delay +(define ttyout/vtab-delay #f) ; mask (vtdly) +(define ttyout/vtab-delay0 #f) +(define ttyout/vtab-delay1 #f) ; tty 37 + +;;; Backspace delay +(define ttyout/bs-delay #f) ; mask (bsdly) +(define ttyout/bs-delay0 #f) +(define ttyout/bs-delay1 #f) + +;;; Form-feed delay +(define ttyout/ff-delay #f) ; mask (ffdly) +(define ttyout/ff-delay0 #f) +(define ttyout/ff-delay1 #f) + +(define ttyout/all-delay #f) + +;;; Control flags - hacking the serial-line. +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;;; POSIX +(define ttyc/char-size #x00300) ; csize: character size mask +(define ttyc/char-size5 #x00000) ; 5 bits (cs5) +(define ttyc/char-size6 #x00100) ; 6 bits (cs6) +(define ttyc/char-size7 #x00200) ; 7 bits (cs7) +(define ttyc/char-size8 #x00300) ; 8 bits (cs8) +(define ttyc/2-stop-bits #x00400) ; cstopb: Send 2 stop bits. +(define ttyc/enable-read #x00800) ; cread: Enable receiver. +(define ttyc/enable-parity #x01000) ; parenb +(define ttyc/odd-parity #x02000) ; parodd +(define ttyc/hup-on-close #x04000) ; hupcl: Hang up on last close. +(define ttyc/no-modem-sync #x08000) ; clocal: Ignore modem lines. + +;;; 4.3+BSD +(define ttyc/ignore-flags #x00001) ; cignore: ignore control flags +(define ttyc/CTS-output-flow-ctl #x00010000) ; ccts_oflow: CTS flow control of output +(define ttyc/RTS-input-flow-ctl #x00010000) ; crts_iflow: RTS flow control of input +(define ttyc/carrier-flow-ctl #x00100000) ; mdmbuf + +;;; Local flags -- hacking the tty driver / user interface. +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;;; POSIX +(define ttyl/visual-delete #x00000002) ; echoe: Visually erase chars +(define ttyl/echo-delete-line #x00000004) ; echok: Echo nl after line kill +(define ttyl/echo #x00000008) ; echo: Enable echoing +(define ttyl/echo-nl #x00000010) ; echonl: Echo nl even if echo is off +(define ttyl/canonical #x00000100) ; icanon: Canonicalize input +(define ttyl/enable-signals #x00000080) ; isig: Enable ^c, ^z signalling +(define ttyl/extended #x00000400) ; iexten: Enable extensions +(define ttyl/ttou-signal #x00400000) ; tostop: SIGTTOU on background output +(define ttyl/no-flush-on-interrupt #x80000000) ; noflsh + +;;; SVR4 & 4.3+BSD +(define ttyl/visual-delete-line #x00000001); echoke: visually erase a line-kill +(define ttyl/hardcopy-delete #x00000020); echoprt: visual erase for hardcopy +(define ttyl/echo-ctl #x00000040); echoctl: echo control chars as "^X" +(define ttyl/flush-output #x00800000); flusho: output is being flushed +(define ttyl/reprint-unread-chars #x20000000); pendin: retype pending input + +;;; 4.3+BSD +(define ttyl/alt-delete-word #x00000200) ; altwerase +(define ttyl/no-kernel-status #x02000000) ; nokerninfo: no kernel status on ^T + +;;; SVR4 +(define ttyl/case-map #f) ; xcase: canonical upper/lower presentation + +;;; Vector of (speed . code) pairs. + +(define baud-rates '#((0 . 0) (50 . 50) (75 . 75) + (110 . 110) (134 . 134) (150 . 150) + (200 . 200) (300 . 300) (600 . 600) + (1200 . 1200) (1800 . 1800) (2400 . 2400) + (4800 . 4800) (7200 . 7200) (9600 . 9600) + (14400 . 14400) (19200 . 19200) (28800 . 28800) + (38400 . 38400) (19200 . exta) (38400 . extb) + (57600 . 57600) (76800 . 76800) (115200 . 115200) + (230400 . 230400))) + +;;; tcflush() constants +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(define %flush-tty/input 1) ; TCIFLUSH +(define %flush-tty/output 2) ; TCOFLUSH +(define %flush-tty/both 3) ; TCIOFLUSH + + +;;; tcflow() constants +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(define %tcflow/start-out 2) ; TCOON +(define %tcflow/stop-out 1) ; TCOOFF +(define %tcflow/start-in 4) ; TCION +(define %tcflow/stop-in 3) ; TCIOFF + + +;;; tcsetattr() constants +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(define %set-tty-info/now 0) ; TCSANOW Make change immediately. +(define %set-tty-info/drain 1) ; TCSADRAIN Drain output, then change. +(define %set-tty-info/flush 2) ; TCSAFLUSH Drain output, flush input. +(define %set-tty-info/soft #x10) ; flag: don't alter h.w. state diff --git a/scsh/machine/waitcodes.scm b/scsh/machine/waitcodes.scm new file mode 100644 index 0000000..ce370ae --- /dev/null +++ b/scsh/machine/waitcodes.scm @@ -0,0 +1,40 @@ +;;; Scsh routines for analysing exit codes returned by WAIT. +;;; Copyright (c) 1994 by Olin Shivers. +;;; +;;; To port these to a new OS, consult /usr/include/sys/wait.h, +;;; and check the WIFEXITED, WEXITSTATUS, WIFSTOPPED, WSTOPSIG, +;;; WIFSIGNALED, and WTERMSIG macros for the magic fields they use. +;;; These definitions are for BSD4.4-Lite. +;;; +;;; I could have done a portable version by making C calls for this, +;;; but it's such overkill. + + +;;; If process terminated normally, return the exit code, otw #f. + +(define (status:exit-val status) + (and (zero? (bitwise-and #x7F status)) + (arithmetic-shift status -8))) + + + +;;; If the process was suspended, return the suspending signal, otw #f. + +(define (status:stop-sig status) + (and (= #x7F (bitwise-and status #x7F)) + (arithmetic-shift status -8))) + + +;;; If the process terminated abnormally, +;;; return the terminating signal, otw #f. + +(define (status:term-sig status) + (let ((termsig (bitwise-and status #x7F))) + (and (not (zero? termsig)) ; Didn't exit. + (not (= #x7F)) ; Not suspended. + termsig))) + + +;;; Flags. +(define wait/poll 1) ; Don't hang if nothing to wait for. +(define wait/stopped-children 2) ; Report on suspended subprocs, too. diff --git a/scsh/ndbm.c b/scsh/ndbm.c index ed6dec6..f212f8c 100644 --- a/scsh/ndbm.c +++ b/scsh/ndbm.c @@ -10,121 +10,121 @@ extern int errno; -#define errno_or_false(x) (((x) == -1) ? ENTER_FIXNUM(errno) : SCHFALSE) +#define errno_or_false(x) (((x) == -1) ? s48_enter_fixnum(errno) : S48_FALSE) /* stub used to return FALSE when scheme checks for Berkeley dbm */ int db_check() return 1; -scheme_value df_database_open(long nargs, scheme_value *args) +s48_value df_database_open(long nargs, s48_value *args) { extern int database_open(const char *, int , int , DBM** *); - scheme_value ret1; + s48_value ret1; int r1; DBM** r2; cig_check_nargs(4, nargs, "database_open"); - r1 = database_open(cig_string_body(args[3]), EXTRACT_FIXNUM(args[2]), EXTRACT_FIXNUM(args[1]), &r2); + r1 = database_open(cig_string_body(args[3]), s48_extract_fixnum(args[2]), s48_extract_fixnum(args[1]), &r2); ret1 = errno_or_false(r1); AlienVal(VECTOR_REF(*args,0)) = (long) r2; return ret1; } -scheme_value df_database_close(long nargs, scheme_value *args) +s48_value df_database_close(long nargs, s48_value *args) { extern int database_close(DBM* ); - scheme_value ret1; + s48_value ret1; int r1; cig_check_nargs(1, nargs, "database_close"); r1 = database_close((DBM* )AlienVal(args[0])); - ret1 = ENTER_FIXNUM(r1); + ret1 = s48_enter_fixnum(r1); return ret1; } -scheme_value df_database_error(long nargs, scheme_value *args) +s48_value df_database_error(long nargs, s48_value *args) { extern int database_error(DBM* ); - scheme_value ret1; + s48_value ret1; int r1; cig_check_nargs(1, nargs, "database_error"); r1 = database_error((DBM* )AlienVal(args[0])); - ret1 = ENTER_FIXNUM(r1); + ret1 = s48_enter_fixnum(r1); return ret1; } -scheme_value df_database_clearerr(long nargs, scheme_value *args) +s48_value df_database_clearerr(long nargs, s48_value *args) { extern int database_clearerr(DBM* ); - scheme_value ret1; + s48_value ret1; int r1; cig_check_nargs(1, nargs, "database_clearerr"); r1 = database_clearerr((DBM* )AlienVal(args[0])); - ret1 = ENTER_FIXNUM(r1); + ret1 = s48_enter_fixnum(r1); return ret1; } -scheme_value df_database_delete(long nargs, scheme_value *args) +s48_value df_database_delete(long nargs, s48_value *args) { extern int database_delete(DBM* , const char *); - scheme_value ret1; + s48_value ret1; int r1; cig_check_nargs(2, nargs, "database_delete"); r1 = database_delete((DBM* )AlienVal(args[1]), cig_string_body(args[0])); - ret1 = ENTER_FIXNUM(r1); + ret1 = s48_enter_fixnum(r1); return ret1; } -scheme_value df_database_fetch(long nargs, scheme_value *args) +s48_value df_database_fetch(long nargs, s48_value *args) { extern const char *database_fetch(DBM* , const char *); - scheme_value ret1; + s48_value ret1; const char *r1; cig_check_nargs(3, nargs, "database_fetch"); r1 = database_fetch((DBM* )AlienVal(args[2]), cig_string_body(args[1])); - ret1 = VECTOR_REF(*args,0); + ret1 = S48_VECTOR_REF(*args,0); {AlienVal(CAR(ret1)) = (long) r1; CDR(ret1) = strlen_or_false(r1);} return ret1; } -scheme_value df_database_store(long nargs, scheme_value *args) +s48_value df_database_store(long nargs, s48_value *args) { extern int database_store(DBM* , const char *, const char *, int ); - scheme_value ret1; + s48_value ret1; int r1; cig_check_nargs(4, nargs, "database_store"); - r1 = database_store((DBM* )AlienVal(args[3]), cig_string_body(args[2]), cig_string_body(args[1]), EXTRACT_FIXNUM(args[0])); - ret1 = ENTER_FIXNUM(r1); + r1 = database_store((DBM* )AlienVal(args[3]), cig_string_body(args[2]), cig_string_body(args[1]), s48_extract_fixnum(args[0])); + ret1 = s48_enter_fixnum(r1); return ret1; } -scheme_value df_database_first(long nargs, scheme_value *args) +s48_value df_database_first(long nargs, s48_value *args) { extern const char *database_first(DBM* ); - scheme_value ret1; + s48_value ret1; const char *r1; cig_check_nargs(2, nargs, "database_first"); r1 = database_first((DBM* )AlienVal(args[1])); - ret1 = VECTOR_REF(*args,0); + ret1 = S48_VECTOR_REF(*args,0); {AlienVal(CAR(ret1)) = (long) r1; CDR(ret1) = strlen_or_false(r1);} return ret1; } -scheme_value df_database_next(long nargs, scheme_value *args) +s48_value df_database_next(long nargs, s48_value *args) { extern const char *database_next(DBM* ); - scheme_value ret1; + s48_value ret1; const char *r1; cig_check_nargs(2, nargs, "database_next"); r1 = database_next((DBM* )AlienVal(args[1])); - ret1 = VECTOR_REF(*args,0); + ret1 = S48_VECTOR_REF(*args,0); {AlienVal(CAR(ret1)) = (long) r1; CDR(ret1) = strlen_or_false(r1);} return ret1; } diff --git a/scsh/ndbm.scm b/scsh/ndbm.scm index cfeaa40..dbf4fb8 100644 --- a/scsh/ndbm.scm +++ b/scsh/ndbm.scm @@ -70,7 +70,7 @@ "" "extern int errno;" "" - "#define errno_or_false(x) (((x) == -1) ? ENTER_FIXNUM(errno) : SCHFALSE)" + "#define errno_or_false(x) (((x) == -1) ? s48_enter_fixnum(errno) : S48_FALSE)" "" "") (define-foreign %dbm-open (database_open (string file) diff --git a/scsh/ndbmo.c b/scsh/ndbmo.c index 39595ec..faeedc7 100644 --- a/scsh/ndbmo.c +++ b/scsh/ndbmo.c @@ -19,7 +19,7 @@ int db_check() return 0; } -scheme_value db_open_default (char *file, int flags, int mode, DBM **db_ptr) +s48_value db_open_default (char *file, int flags, int mode, DBM **db_ptr) { *db_ptr = dbm_open(file, flags, mode); if(*db_ptr == NULL) diff --git a/scsh/network.c b/scsh/network.c index 1046381..b215c46 100644 --- a/scsh/network.c +++ b/scsh/network.c @@ -1,5 +1,5 @@ /* This is an Scheme48/C interface file, -** automatically generated by cig. +** automatically generated by a hacked version of cig 3.0. */ #include @@ -15,390 +15,422 @@ extern int errno; extern int h_errno; -#define errno_on_zero_or_false(x) ((x) ? SCHFALSE : ENTER_FIXNUM(errno)) -#define errno_or_false(x) (((x) == -1) ? ENTER_FIXNUM(errno) : SCHFALSE) -#define False_on_zero(x) ((x) ? ENTER_FIXNUM(x) : SCHFALSE) -scheme_value df_socket(long nargs, scheme_value *args) +#define errno_on_zero_or_false(x) ((x) ? S48_FALSE : s48_enter_fixnum(errno)) +#define errno_or_false(x) (((x) == -1) ? s48_enter_fixnum(errno) : S48_FALSE) +#define False_on_zero(x) ((x) ? s48_enter_fixnum(x) : S48_FALSE) +s48_value df_socket(s48_value g1, s48_value g2, s48_value g3, s48_value mv_vec) { extern int socket(int , int , int ); - scheme_value ret1; + s48_value ret1; int r1; - cig_check_nargs(4, nargs, "socket"); - r1 = socket(EXTRACT_FIXNUM(args[3]), EXTRACT_FIXNUM(args[2]), EXTRACT_FIXNUM(args[1])); + + r1 = socket(s48_extract_fixnum(g1), s48_extract_fixnum(g2), s48_extract_fixnum(g3)); ret1 = errno_or_false(r1); - VECTOR_REF(*args,0) = ENTER_FIXNUM(r1); + S48_VECTOR_SET(mv_vec,0,s48_enter_fixnum(r1)); return ret1; - } +} -scheme_value df_scheme_bind(long nargs, scheme_value *args) +s48_value df_scheme_bind(s48_value g1, s48_value g2, s48_value g3) { - extern int scheme_bind(int , int , scheme_value ); - scheme_value ret1; + extern int scheme_bind(int , int , s48_value ); + s48_value ret1; int r1; - cig_check_nargs(3, nargs, "scheme_bind"); - r1 = scheme_bind(EXTRACT_FIXNUM(args[2]), EXTRACT_FIXNUM(args[1]), args[0]); + + r1 = scheme_bind(s48_extract_fixnum(g1), s48_extract_fixnum(g2), g3); ret1 = errno_or_false(r1); return ret1; - } +} -scheme_value df_scheme_connect(long nargs, scheme_value *args) +s48_value df_scheme_connect(s48_value g1, s48_value g2, s48_value g3) { - extern int scheme_connect(int , int , scheme_value ); - scheme_value ret1; + extern int scheme_connect(int , int , s48_value ); + s48_value ret1; int r1; - cig_check_nargs(3, nargs, "scheme_connect"); - r1 = scheme_connect(EXTRACT_FIXNUM(args[2]), EXTRACT_FIXNUM(args[1]), args[0]); + + r1 = scheme_connect(s48_extract_fixnum(g1), s48_extract_fixnum(g2), g3); ret1 = errno_or_false(r1); return ret1; - } +} -scheme_value df_listen(long nargs, scheme_value *args) +s48_value df_listen(s48_value g1, s48_value g2) { extern int listen(int , int ); - scheme_value ret1; + s48_value ret1; int r1; - cig_check_nargs(2, nargs, "listen"); - r1 = listen(EXTRACT_FIXNUM(args[1]), EXTRACT_FIXNUM(args[0])); + + r1 = listen(s48_extract_fixnum(g1), s48_extract_fixnum(g2)); ret1 = errno_or_false(r1); return ret1; - } +} -scheme_value df_scheme_accept(long nargs, scheme_value *args) +s48_value df_scheme_accept(s48_value g1, s48_value g2, s48_value g3, s48_value mv_vec) { - extern int scheme_accept(int , int , scheme_value ); - scheme_value ret1; + extern int scheme_accept(int , int , s48_value ); + s48_value ret1; int r1; - cig_check_nargs(4, nargs, "scheme_accept"); - r1 = scheme_accept(EXTRACT_FIXNUM(args[3]), EXTRACT_FIXNUM(args[2]), args[1]); + + r1 = scheme_accept(s48_extract_fixnum(g1), s48_extract_fixnum(g2), g3); ret1 = errno_or_false(r1); - VECTOR_REF(*args,0) = ENTER_FIXNUM(r1); + S48_VECTOR_SET(mv_vec,0,s48_enter_fixnum(r1)); return ret1; - } +} -scheme_value df_scheme_peer_name(long nargs, scheme_value *args) +s48_value df_scheme_peer_name(s48_value g1, s48_value g2, s48_value g3) { - extern int scheme_peer_name(int , int , scheme_value ); - scheme_value ret1; + extern int scheme_peer_name(int , int , s48_value ); + s48_value ret1; int r1; - cig_check_nargs(3, nargs, "scheme_peer_name"); - r1 = scheme_peer_name(EXTRACT_FIXNUM(args[2]), EXTRACT_FIXNUM(args[1]), args[0]); + + r1 = scheme_peer_name(s48_extract_fixnum(g1), s48_extract_fixnum(g2), g3); ret1 = errno_or_false(r1); return ret1; - } +} -scheme_value df_scheme_socket_name(long nargs, scheme_value *args) +s48_value df_scheme_socket_name(s48_value g1, s48_value g2, s48_value g3) { - extern int scheme_socket_name(int , int , scheme_value ); - scheme_value ret1; + extern int scheme_socket_name(int , int , s48_value ); + s48_value ret1; int r1; - cig_check_nargs(3, nargs, "scheme_socket_name"); - r1 = scheme_socket_name(EXTRACT_FIXNUM(args[2]), EXTRACT_FIXNUM(args[1]), args[0]); + + r1 = scheme_socket_name(s48_extract_fixnum(g1), s48_extract_fixnum(g2), g3); ret1 = False_on_zero(r1); return ret1; - } +} -scheme_value df_shutdown(long nargs, scheme_value *args) +s48_value df_shutdown(s48_value g1, s48_value g2) { extern int shutdown(int , int ); - scheme_value ret1; + s48_value ret1; int r1; - cig_check_nargs(2, nargs, "shutdown"); - r1 = shutdown(EXTRACT_FIXNUM(args[1]), EXTRACT_FIXNUM(args[0])); + + r1 = shutdown(s48_extract_fixnum(g1), s48_extract_fixnum(g2)); ret1 = errno_or_false(r1); return ret1; - } +} -scheme_value df_scheme_socket_pair(long nargs, scheme_value *args) +s48_value df_scheme_socket_pair(s48_value g1, s48_value mv_vec) { extern int scheme_socket_pair(int , int *, int *); - scheme_value ret1; + s48_value ret1; int r1; int r2; int r3; - cig_check_nargs(2, nargs, "scheme_socket_pair"); - r1 = scheme_socket_pair(EXTRACT_FIXNUM(args[1]), &r2, &r3); + + r1 = scheme_socket_pair(s48_extract_fixnum(g1), &r2, &r3); ret1 = errno_or_false(r1); - VECTOR_REF(*args,0) = ENTER_FIXNUM(r2); - VECTOR_REF(*args,1) = ENTER_FIXNUM(r3); + S48_VECTOR_SET(mv_vec,0,s48_enter_fixnum(r2)); + S48_VECTOR_SET(mv_vec,1,s48_enter_fixnum(r3)); return ret1; - } +} -scheme_value df_recv_substring(long nargs, scheme_value *args) +s48_value df_recv_substring(s48_value g1, s48_value g2, s48_value g3, s48_value g4, s48_value g5, s48_value g6, s48_value mv_vec) { - extern int recv_substring(int , int , scheme_value , int , int , scheme_value ); - scheme_value ret1; + extern int recv_substring(int , int , s48_value , int , int , s48_value ); + s48_value ret1; int r1; - cig_check_nargs(7, nargs, "recv_substring"); - r1 = recv_substring(EXTRACT_FIXNUM(args[6]), EXTRACT_FIXNUM(args[5]), args[4], EXTRACT_FIXNUM(args[3]), EXTRACT_FIXNUM(args[2]), args[1]); + + r1 = recv_substring(s48_extract_fixnum(g1), s48_extract_fixnum(g2), g3, s48_extract_fixnum(g4), s48_extract_fixnum(g5), g6); ret1 = errno_or_false(r1); - VECTOR_REF(*args,0) = ENTER_FIXNUM(r1); + S48_VECTOR_SET(mv_vec,0,s48_enter_fixnum(r1)); return ret1; - } +} -scheme_value df_send_substring(long nargs, scheme_value *args) +s48_value df_send_substring(s48_value g1, s48_value g2, s48_value g3, s48_value g4, s48_value g5, s48_value g6, s48_value g7, s48_value mv_vec) { - extern int send_substring(int , int , scheme_value , int , int , int , scheme_value ); - scheme_value ret1; + extern int send_substring(int , int , s48_value , int , int , int , s48_value ); + s48_value ret1; int r1; - cig_check_nargs(8, nargs, "send_substring"); - r1 = send_substring(EXTRACT_FIXNUM(args[7]), EXTRACT_FIXNUM(args[6]), args[5], EXTRACT_FIXNUM(args[4]), EXTRACT_FIXNUM(args[3]), EXTRACT_FIXNUM(args[2]), args[1]); + + r1 = send_substring(s48_extract_fixnum(g1), s48_extract_fixnum(g2), g3, s48_extract_fixnum(g4), s48_extract_fixnum(g5), s48_extract_fixnum(g6), g7); ret1 = errno_or_false(r1); - VECTOR_REF(*args,0) = ENTER_FIXNUM(r1); + S48_VECTOR_SET(mv_vec,0,s48_enter_fixnum(r1)); return ret1; - } +} -scheme_value df_scheme_getsockopt(long nargs, scheme_value *args) +s48_value df_scheme_getsockopt(s48_value g1, s48_value g2, s48_value g3, s48_value mv_vec) { extern int scheme_getsockopt(int , int , int ); - scheme_value ret1; + s48_value ret1; int r1; - cig_check_nargs(4, nargs, "scheme_getsockopt"); - r1 = scheme_getsockopt(EXTRACT_FIXNUM(args[3]), EXTRACT_FIXNUM(args[2]), EXTRACT_FIXNUM(args[1])); + + r1 = scheme_getsockopt(s48_extract_fixnum(g1), s48_extract_fixnum(g2), s48_extract_fixnum(g3)); ret1 = errno_or_false(r1); - VECTOR_REF(*args,0) = ENTER_FIXNUM(r1); + S48_VECTOR_SET(mv_vec,0,s48_enter_fixnum(r1)); return ret1; - } +} -scheme_value df_scheme_getsockopt_linger(long nargs, scheme_value *args) +s48_value df_scheme_getsockopt_linger(s48_value g1, s48_value g2, s48_value g3, s48_value mv_vec) { extern int scheme_getsockopt_linger(int , int , int , int *); - scheme_value ret1; + s48_value ret1; int r1; int r2; - cig_check_nargs(4, nargs, "scheme_getsockopt_linger"); - r1 = scheme_getsockopt_linger(EXTRACT_FIXNUM(args[3]), EXTRACT_FIXNUM(args[2]), EXTRACT_FIXNUM(args[1]), &r2); + + r1 = scheme_getsockopt_linger(s48_extract_fixnum(g1), s48_extract_fixnum(g2), s48_extract_fixnum(g3), &r2); ret1 = errno_or_false(r1); - VECTOR_REF(*args,0) = ENTER_FIXNUM(r1); - VECTOR_REF(*args,1) = ENTER_FIXNUM(r2); + S48_VECTOR_SET(mv_vec,0,s48_enter_fixnum(r1)); + S48_VECTOR_SET(mv_vec,1,s48_enter_fixnum(r2)); return ret1; - } +} -scheme_value df_scheme_getsockopt_timeout(long nargs, scheme_value *args) +s48_value df_scheme_getsockopt_timeout(s48_value g1, s48_value g2, s48_value g3, s48_value mv_vec) { extern int scheme_getsockopt_timeout(int , int , int , int *); - scheme_value ret1; + s48_value ret1; int r1; int r2; - cig_check_nargs(4, nargs, "scheme_getsockopt_timeout"); - r1 = scheme_getsockopt_timeout(EXTRACT_FIXNUM(args[3]), EXTRACT_FIXNUM(args[2]), EXTRACT_FIXNUM(args[1]), &r2); + + r1 = scheme_getsockopt_timeout(s48_extract_fixnum(g1), s48_extract_fixnum(g2), s48_extract_fixnum(g3), &r2); ret1 = errno_or_false(r1); - VECTOR_REF(*args,0) = ENTER_FIXNUM(r1); - VECTOR_REF(*args,1) = ENTER_FIXNUM(r2); + S48_VECTOR_SET(mv_vec,0,s48_enter_fixnum(r1)); + S48_VECTOR_SET(mv_vec,1,s48_enter_fixnum(r2)); return ret1; - } +} -scheme_value df_scheme_setsockopt(long nargs, scheme_value *args) +s48_value df_scheme_setsockopt(s48_value g1, s48_value g2, s48_value g3, s48_value g4) { extern int scheme_setsockopt(int , int , int , int ); - scheme_value ret1; + s48_value ret1; int r1; - cig_check_nargs(4, nargs, "scheme_setsockopt"); - r1 = scheme_setsockopt(EXTRACT_FIXNUM(args[3]), EXTRACT_FIXNUM(args[2]), EXTRACT_FIXNUM(args[1]), EXTRACT_FIXNUM(args[0])); + + r1 = scheme_setsockopt(s48_extract_fixnum(g1), s48_extract_fixnum(g2), s48_extract_fixnum(g3), s48_extract_fixnum(g4)); ret1 = errno_or_false(r1); return ret1; - } +} -scheme_value df_scheme_setsockopt_linger(long nargs, scheme_value *args) +s48_value df_scheme_setsockopt_linger(s48_value g1, s48_value g2, s48_value g3, s48_value g4, s48_value g5) { extern int scheme_setsockopt_linger(int , int , int , int , int ); - scheme_value ret1; + s48_value ret1; int r1; - cig_check_nargs(5, nargs, "scheme_setsockopt_linger"); - r1 = scheme_setsockopt_linger(EXTRACT_FIXNUM(args[4]), EXTRACT_FIXNUM(args[3]), EXTRACT_FIXNUM(args[2]), EXTRACT_FIXNUM(args[1]), EXTRACT_FIXNUM(args[0])); + + r1 = scheme_setsockopt_linger(s48_extract_fixnum(g1), s48_extract_fixnum(g2), s48_extract_fixnum(g3), s48_extract_fixnum(g4), s48_extract_fixnum(g5)); ret1 = errno_or_false(r1); return ret1; - } +} -scheme_value df_scheme_setsockopt_timeout(long nargs, scheme_value *args) +s48_value df_scheme_setsockopt_timeout(s48_value g1, s48_value g2, s48_value g3, s48_value g4, s48_value g5) { extern int scheme_setsockopt_timeout(int , int , int , int , int ); - scheme_value ret1; + s48_value ret1; int r1; - cig_check_nargs(5, nargs, "scheme_setsockopt_timeout"); - r1 = scheme_setsockopt_timeout(EXTRACT_FIXNUM(args[4]), EXTRACT_FIXNUM(args[3]), EXTRACT_FIXNUM(args[2]), EXTRACT_FIXNUM(args[1]), EXTRACT_FIXNUM(args[0])); + + r1 = scheme_setsockopt_timeout(s48_extract_fixnum(g1), s48_extract_fixnum(g2), s48_extract_fixnum(g3), s48_extract_fixnum(g4), s48_extract_fixnum(g5)); ret1 = errno_or_false(r1); return ret1; - } +} -scheme_value df_scheme_host_address2host_info(long nargs, scheme_value *args) +s48_value df_scheme_host_address2host_info(s48_value g1, s48_value mv_vec) { - extern int scheme_host_address2host_info(scheme_value , char **, char** *, char** *); - scheme_value ret1; + extern int scheme_host_address2host_info(s48_value , char **, char** *, char** *); + s48_value ret1; int r1; char *r2; char** r3; char** r4; - cig_check_nargs(2, nargs, "scheme_host_address2host_info"); - r1 = scheme_host_address2host_info(args[1], &r2, &r3, &r4); + + r1 = scheme_host_address2host_info(g1, &r2, &r3, &r4); ret1 = False_on_zero(r1); - {AlienVal(CAR(VECTOR_REF(*args,0))) = (long) r2; CDR(VECTOR_REF(*args,0)) = strlen_or_false(r2);} - AlienVal(VECTOR_REF(*args,1)) = (long) r3; - AlienVal(VECTOR_REF(*args,2)) = (long) r4; + S48_SET_CAR(S48_VECTOR_REF(mv_vec,0),(long) r2); S48_SET_CDR(S48_VECTOR_REF(mv_vec,0),strlen_or_false(r2)); + S48_SET_CAR(S48_VECTOR_REF(mv_vec,1),(long) r3); + S48_SET_CAR(S48_VECTOR_REF(mv_vec,2),(long) r4); return ret1; - } +} -scheme_value df_scheme_host_name2host_info(long nargs, scheme_value *args) +s48_value df_scheme_host_name2host_info(s48_value g1, s48_value mv_vec) { extern int scheme_host_name2host_info(const char *, char **, char** *, char** *); - scheme_value ret1; + s48_value ret1; int r1; char *r2; char** r3; char** r4; - cig_check_nargs(2, nargs, "scheme_host_name2host_info"); - r1 = scheme_host_name2host_info(cig_string_body(args[1]), &r2, &r3, &r4); + + r1 = scheme_host_name2host_info(s48_extract_string(g1), &r2, &r3, &r4); ret1 = False_on_zero(r1); - {AlienVal(CAR(VECTOR_REF(*args,0))) = (long) r2; CDR(VECTOR_REF(*args,0)) = strlen_or_false(r2);} - AlienVal(VECTOR_REF(*args,1)) = (long) r3; - AlienVal(VECTOR_REF(*args,2)) = (long) r4; + S48_SET_CAR(S48_VECTOR_REF(mv_vec,0),(long) r2); S48_SET_CDR(S48_VECTOR_REF(mv_vec,0),strlen_or_false(r2)); + S48_SET_CAR(S48_VECTOR_REF(mv_vec,1),(long) r3); + S48_SET_CAR(S48_VECTOR_REF(mv_vec,2),(long) r4); return ret1; - } +} -scheme_value df_scheme_net_address2net_info(long nargs, scheme_value *args) +s48_value df_scheme_net_address2net_info(s48_value g1, s48_value g2, s48_value mv_vec) { - extern int scheme_net_address2net_info(scheme_value , scheme_value , char **, char** *); - scheme_value ret1; + extern int scheme_net_address2net_info(s48_value , s48_value , char **, char** *); + s48_value ret1; int r1; char *r2; char** r3; - cig_check_nargs(3, nargs, "scheme_net_address2net_info"); - r1 = scheme_net_address2net_info(args[2], args[1], &r2, &r3); + + r1 = scheme_net_address2net_info(g1, g2, &r2, &r3); ret1 = False_on_zero(r1); - {AlienVal(CAR(VECTOR_REF(*args,0))) = (long) r2; CDR(VECTOR_REF(*args,0)) = strlen_or_false(r2);} - AlienVal(VECTOR_REF(*args,1)) = (long) r3; + S48_SET_CAR(S48_VECTOR_REF(mv_vec,0),(long) r2); S48_SET_CDR(S48_VECTOR_REF(mv_vec,0),strlen_or_false(r2)); + S48_SET_CAR(S48_VECTOR_REF(mv_vec,1),(long) r3); return ret1; - } +} -scheme_value df_scheme_net_name2net_info(long nargs, scheme_value *args) +s48_value df_scheme_net_name2net_info(s48_value g1, s48_value g2, s48_value mv_vec) { - extern int scheme_net_name2net_info(const char *, scheme_value , char **, char** *); - scheme_value ret1; + extern int scheme_net_name2net_info(const char *, s48_value , char **, char** *); + s48_value ret1; int r1; char *r2; char** r3; - cig_check_nargs(3, nargs, "scheme_net_name2net_info"); - r1 = scheme_net_name2net_info(cig_string_body(args[2]), args[1], &r2, &r3); + + r1 = scheme_net_name2net_info(s48_extract_string(g1), g2, &r2, &r3); ret1 = False_on_zero(r1); - {AlienVal(CAR(VECTOR_REF(*args,0))) = (long) r2; CDR(VECTOR_REF(*args,0)) = strlen_or_false(r2);} - AlienVal(VECTOR_REF(*args,1)) = (long) r3; + S48_SET_CAR(S48_VECTOR_REF(mv_vec,0),(long) r2); S48_SET_CDR(S48_VECTOR_REF(mv_vec,0),strlen_or_false(r2)); + S48_SET_CAR(S48_VECTOR_REF(mv_vec,1),(long) r3); return ret1; - } +} -scheme_value df_scheme_serv_port2serv_info(long nargs, scheme_value *args) +s48_value df_scheme_serv_port2serv_info(s48_value g1, s48_value g2, s48_value mv_vec) { extern int scheme_serv_port2serv_info(int , const char *, char **, char** *, int *, char **); - scheme_value ret1; + s48_value ret1; int r1; char *r2; char** r3; int r4; char *r5; - cig_check_nargs(3, nargs, "scheme_serv_port2serv_info"); - r1 = scheme_serv_port2serv_info(EXTRACT_FIXNUM(args[2]), cig_string_body(args[1]), &r2, &r3, &r4, &r5); + + r1 = scheme_serv_port2serv_info(s48_extract_fixnum(g1), s48_extract_string(g2), &r2, &r3, &r4, &r5); ret1 = False_on_zero(r1); - {AlienVal(CAR(VECTOR_REF(*args,0))) = (long) r2; CDR(VECTOR_REF(*args,0)) = strlen_or_false(r2);} - AlienVal(VECTOR_REF(*args,1)) = (long) r3; - VECTOR_REF(*args,2) = ENTER_FIXNUM(r4); - {AlienVal(CAR(VECTOR_REF(*args,3))) = (long) r5; CDR(VECTOR_REF(*args,3)) = strlen_or_false(r5);} + S48_SET_CAR(S48_VECTOR_REF(mv_vec,0),(long) r2); S48_SET_CDR(S48_VECTOR_REF(mv_vec,0),strlen_or_false(r2)); + S48_SET_CAR(S48_VECTOR_REF(mv_vec,1),(long) r3); + S48_VECTOR_SET(mv_vec,2,s48_enter_fixnum(r4)); + S48_SET_CAR(S48_VECTOR_REF(mv_vec,3),(long) r5); S48_SET_CDR(S48_VECTOR_REF(mv_vec,3),strlen_or_false(r5)); return ret1; - } +} -scheme_value df_scheme_serv_name2serv_info(long nargs, scheme_value *args) +s48_value df_scheme_serv_name2serv_info(s48_value g1, s48_value g2, s48_value mv_vec) { extern int scheme_serv_name2serv_info(const char *, const char *, char **, char** *, int *, char **); - scheme_value ret1; + s48_value ret1; int r1; char *r2; char** r3; int r4; char *r5; - cig_check_nargs(3, nargs, "scheme_serv_name2serv_info"); - r1 = scheme_serv_name2serv_info(cig_string_body(args[2]), cig_string_body(args[1]), &r2, &r3, &r4, &r5); + + r1 = scheme_serv_name2serv_info(s48_extract_string(g1), s48_extract_string(g2), &r2, &r3, &r4, &r5); ret1 = False_on_zero(r1); - {AlienVal(CAR(VECTOR_REF(*args,0))) = (long) r2; CDR(VECTOR_REF(*args,0)) = strlen_or_false(r2);} - AlienVal(VECTOR_REF(*args,1)) = (long) r3; - VECTOR_REF(*args,2) = ENTER_FIXNUM(r4); - {AlienVal(CAR(VECTOR_REF(*args,3))) = (long) r5; CDR(VECTOR_REF(*args,3)) = strlen_or_false(r5);} + S48_SET_CAR(S48_VECTOR_REF(mv_vec,0),(long) r2); S48_SET_CDR(S48_VECTOR_REF(mv_vec,0),strlen_or_false(r2)); + S48_SET_CAR(S48_VECTOR_REF(mv_vec,1),(long) r3); + S48_VECTOR_SET(mv_vec,2,s48_enter_fixnum(r4)); + S48_SET_CAR(S48_VECTOR_REF(mv_vec,3),(long) r5); S48_SET_CDR(S48_VECTOR_REF(mv_vec,3),strlen_or_false(r5)); return ret1; - } +} -scheme_value df_scheme_proto_num2proto_info(long nargs, scheme_value *args) +s48_value df_scheme_proto_num2proto_info(s48_value g1, s48_value mv_vec) { extern int scheme_proto_num2proto_info(int , char **, char** *, int *); - scheme_value ret1; + s48_value ret1; int r1; char *r2; char** r3; int r4; - cig_check_nargs(2, nargs, "scheme_proto_num2proto_info"); - r1 = scheme_proto_num2proto_info(EXTRACT_FIXNUM(args[1]), &r2, &r3, &r4); + + r1 = scheme_proto_num2proto_info(s48_extract_fixnum(g1), &r2, &r3, &r4); ret1 = False_on_zero(r1); - {AlienVal(CAR(VECTOR_REF(*args,0))) = (long) r2; CDR(VECTOR_REF(*args,0)) = strlen_or_false(r2);} - AlienVal(VECTOR_REF(*args,1)) = (long) r3; - VECTOR_REF(*args,2) = ENTER_FIXNUM(r4); + S48_SET_CAR(S48_VECTOR_REF(mv_vec,0),(long) r2); S48_SET_CDR(S48_VECTOR_REF(mv_vec,0),strlen_or_false(r2)); + S48_SET_CAR(S48_VECTOR_REF(mv_vec,1),(long) r3); + S48_VECTOR_SET(mv_vec,2,s48_enter_fixnum(r4)); return ret1; - } +} -scheme_value df_scheme_proto_name2proto_info(long nargs, scheme_value *args) +s48_value df_scheme_proto_name2proto_info(s48_value g1, s48_value mv_vec) { extern int scheme_proto_name2proto_info(const char *, char **, char** *, int *); - scheme_value ret1; + s48_value ret1; int r1; char *r2; char** r3; int r4; - cig_check_nargs(2, nargs, "scheme_proto_name2proto_info"); - r1 = scheme_proto_name2proto_info(cig_string_body(args[1]), &r2, &r3, &r4); + + r1 = scheme_proto_name2proto_info(s48_extract_string(g1), &r2, &r3, &r4); ret1 = False_on_zero(r1); - {AlienVal(CAR(VECTOR_REF(*args,0))) = (long) r2; CDR(VECTOR_REF(*args,0)) = strlen_or_false(r2);} - AlienVal(VECTOR_REF(*args,1)) = (long) r3; - VECTOR_REF(*args,2) = ENTER_FIXNUM(r4); + S48_SET_CAR(S48_VECTOR_REF(mv_vec,0),(long) r2); S48_SET_CDR(S48_VECTOR_REF(mv_vec,0),strlen_or_false(r2)); + S48_SET_CAR(S48_VECTOR_REF(mv_vec,1),(long) r3); + S48_VECTOR_SET(mv_vec,2,s48_enter_fixnum(r4)); return ret1; - } +} -scheme_value df_veclen(long nargs, scheme_value *args) +s48_value df_veclen(s48_value g1) { - extern scheme_value veclen(const long * ); - scheme_value ret1; - scheme_value r1; + extern s48_value veclen(const long * ); + s48_value ret1; + s48_value r1; - cig_check_nargs(1, nargs, "veclen"); - r1 = veclen((const long * )AlienVal(args[0])); + + r1 = veclen((const long * )AlienVal(g1)); ret1 = r1; return ret1; - } +} -scheme_value df_set_longvec_carriers(long nargs, scheme_value *args) +s48_value df_set_longvec_carriers(s48_value g1, s48_value g2) { - extern void set_longvec_carriers(scheme_value , long const * const * ); + extern void set_longvec_carriers(s48_value , long const * const * ); - cig_check_nargs(2, nargs, "set_longvec_carriers"); - set_longvec_carriers(args[1], (long const * const * )AlienVal(args[0])); - return SCHFALSE; - } + + set_longvec_carriers(g1, (long const * const * )AlienVal(g2)); + return S48_FALSE; +} +s48_value s48_init_network(void) +{ + S48_EXPORT_FUNCTION(df_socket); + S48_EXPORT_FUNCTION(df_scheme_bind); + S48_EXPORT_FUNCTION(df_scheme_connect); + S48_EXPORT_FUNCTION(df_listen); + S48_EXPORT_FUNCTION(df_scheme_accept); + S48_EXPORT_FUNCTION(df_scheme_peer_name); + S48_EXPORT_FUNCTION(df_scheme_socket_name); + S48_EXPORT_FUNCTION(df_shutdown); + S48_EXPORT_FUNCTION(df_scheme_socket_pair); + S48_EXPORT_FUNCTION(df_recv_substring); + S48_EXPORT_FUNCTION(df_send_substring); + S48_EXPORT_FUNCTION(df_scheme_getsockopt); + S48_EXPORT_FUNCTION(df_scheme_getsockopt_linger); + S48_EXPORT_FUNCTION(df_scheme_getsockopt_timeout); + S48_EXPORT_FUNCTION(df_scheme_setsockopt); + S48_EXPORT_FUNCTION(df_scheme_setsockopt_linger); + S48_EXPORT_FUNCTION(df_scheme_setsockopt_timeout); + S48_EXPORT_FUNCTION(df_scheme_host_address2host_info); + S48_EXPORT_FUNCTION(df_scheme_host_name2host_info); + S48_EXPORT_FUNCTION(df_scheme_net_address2net_info); + S48_EXPORT_FUNCTION(df_scheme_net_name2net_info); + S48_EXPORT_FUNCTION(df_scheme_serv_port2serv_info); + S48_EXPORT_FUNCTION(df_scheme_serv_name2serv_info); + S48_EXPORT_FUNCTION(df_scheme_proto_num2proto_info); + S48_EXPORT_FUNCTION(df_scheme_proto_name2proto_info); + S48_EXPORT_FUNCTION(df_veclen); + S48_EXPORT_FUNCTION(df_set_longvec_carriers); + + return S48_UNSPECIFIC; +} diff --git a/scsh/network.scm b/scsh/network.scm index 1e22e7b..ae42aa6 100644 --- a/scsh/network.scm +++ b/scsh/network.scm @@ -14,9 +14,9 @@ "extern int errno;" "extern int h_errno;" "" - "#define errno_on_zero_or_false(x) ((x) ? SCHFALSE : ENTER_FIXNUM(errno))" - "#define errno_or_false(x) (((x) == -1) ? ENTER_FIXNUM(errno) : SCHFALSE)" - "#define False_on_zero(x) ((x) ? ENTER_FIXNUM(x) : SCHFALSE)" + "#define errno_on_zero_or_false(x) ((x) ? S48_FALSE : s48_enter_fixnum(errno))" + "#define errno_or_false(x) (((x) == -1) ? s48_enter_fixnum(errno) : S48_FALSE)" + "#define False_on_zero(x) ((x) ? s48_enter_fixnum(x) : S48_FALSE)" "" ) ;;;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=- diff --git a/scsh/network1.c b/scsh/network1.c index ca81115..1db3ad8 100644 --- a/scsh/network1.c +++ b/scsh/network1.c @@ -24,25 +24,25 @@ extern int h_errno; /* to extract a 4 byte long value from a scheme string */ -#define GET_LONG(x,n) (*((u_long *)(ADDRESS_AFTER_HEADER((x),unsigned char)+(n*4)))) +#define GET_LONG(x,n) (*((u_long *)(S48_ADDRESS_AFTER_HEADER((x),unsigned char)+(n*4)))) #define SET_LONG(x,n,v) GET_LONG((x),(n))=(u_long)(v); /*-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-*/ -int scheme_bind(int sockfd, int family, scheme_value scheme_name) +int scheme_bind(int sockfd, int family, s48_value scheme_name) { switch(family) { case AF_UNIX: { struct sockaddr_un name; - int scheme_length=STRING_LENGTH(scheme_name); + int scheme_length=S48_STRING_LENGTH(scheme_name); name.sun_family=AF_UNIX; if (scheme_length>=(108-1)) /* save space for \0 */ return(-1); strncpy(name.sun_path, - ADDRESS_AFTER_HEADER(scheme_name,char), + S48_ADDRESS_AFTER_HEADER(scheme_name,char), scheme_length); /* copy to c string */ name.sun_path[scheme_length]='\0'; /* add null */ return(bind(sockfd,(struct sockaddr *)&name,sizeof(name))); @@ -66,20 +66,20 @@ int scheme_bind(int sockfd, int family, scheme_value scheme_name) } /*-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-*/ -int scheme_connect(int sockfd, int family, scheme_value scheme_name) +int scheme_connect(int sockfd, int family, s48_value scheme_name) { switch(family) { case AF_UNIX: { struct sockaddr_un name; - int scheme_length=STRING_LENGTH(scheme_name); + int scheme_length=S48_STRING_LENGTH(scheme_name); name.sun_family=AF_UNIX; if (scheme_length>=(108-1)) /* save space for \0 */ return(-1); strncpy(name.sun_path, - ADDRESS_AFTER_HEADER(scheme_name,char), + S48_ADDRESS_AFTER_HEADER(scheme_name,char), scheme_length); /* copy to c string */ name.sun_path[scheme_length]='\0'; /* add null */ return(connect(sockfd,(struct sockaddr *)&name,sizeof(name))); @@ -107,7 +107,7 @@ int scheme_connect(int sockfd, int family, scheme_value scheme_name) } /*-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-*/ -int scheme_accept(int sockfd, int family, scheme_value scheme_name) +int scheme_accept(int sockfd, int family, s48_value scheme_name) { switch(family) { @@ -142,7 +142,7 @@ int scheme_accept(int sockfd, int family, scheme_value scheme_name) } /*-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-*/ -int scheme_peer_name(int sockfd, int family, scheme_value scheme_name) +int scheme_peer_name(int sockfd, int family, s48_value scheme_name) { switch(family) { @@ -165,7 +165,7 @@ int scheme_peer_name(int sockfd, int family, scheme_value scheme_name) } /*-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-*/ -int scheme_socket_name(int sockfd, int family, scheme_value scheme_name) +int scheme_socket_name(int sockfd, int family, s48_value scheme_name) { switch(family) { @@ -202,13 +202,13 @@ int scheme_socket_pair(int type, int *s1, int *s2) /*-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-*/ int recv_substring(int s, int flags, - scheme_value buf, + s48_value buf, int start, int end, - scheme_value scheme_name) + s48_value scheme_name) { - switch(STRING_LENGTH(scheme_name)) + switch(S48_STRING_LENGTH(scheme_name)) { #ifdef NOTUSED /* no longer used. always return remote socket info */ @@ -241,11 +241,11 @@ int recv_substring(int s, /*-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-*/ int send_substring(int s, int flags, - scheme_value buf, + s48_value buf, int start, int end, int family, - scheme_value scheme_name) + s48_value scheme_name) { switch(family) @@ -257,13 +257,13 @@ int send_substring(int s, case AF_UNIX: { struct sockaddr_un name; - int scheme_length=STRING_LENGTH(scheme_name); + int scheme_length=S48_STRING_LENGTH(scheme_name); name.sun_family=AF_UNIX; if (scheme_length>=(108-1)) /* save space for \0 */ return(-1); strncpy(name.sun_path, - ADDRESS_AFTER_HEADER(scheme_name,char), + S48_ADDRESS_AFTER_HEADER(scheme_name,char), scheme_length); /* copy to c string */ name.sun_path[scheme_length]='\0'; /* add null */ return(sendto(s, @@ -376,7 +376,7 @@ int scheme_setsockopt_timeout (int s, /*-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-*/ /* Routines for looking up hosts */ /*-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-*/ -int scheme_host_address2host_info(scheme_value scheme_name, +int scheme_host_address2host_info(s48_value scheme_name, char** hostname, char*** aliases, char*** addresses) @@ -433,8 +433,8 @@ int scheme_host_name2host_info(const char* scheme_name, /*-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-*/ /* Routines for looking up networks */ /*-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-*/ -int scheme_net_address2net_info(scheme_value scheme_name, - scheme_value scheme_net, +int scheme_net_address2net_info(s48_value scheme_name, + s48_value scheme_net, char** netname, char*** aliases) { @@ -456,7 +456,7 @@ int scheme_net_address2net_info(scheme_value scheme_name, } int scheme_net_name2net_info(const char* scheme_name, - scheme_value scheme_net, + s48_value scheme_net, char** netname, char*** aliases) { @@ -586,16 +586,17 @@ int scheme_proto_name2proto_info(const char* in_name, /* svec is a Scheme vector of C carriers. Scan over the C longs ** in cvec, and initialise the corresponding carriers in svec. */ -void set_longvec_carriers(scheme_value svec, long const * const * cvec) +void set_longvec_carriers(s48_value svec, long const * const * cvec) { - int svec_len = VECTOR_LENGTH(svec); + int svec_len = S48_VECTOR_LENGTH(svec); long const * const *cv = cvec; - scheme_value *sv = &VECTOR_REF(svec,0); + s48_value s = S48_VECTOR_REF(svec,0); //JMG hack + s48_value *sv = &s; for(; svec_len > 0; cv++, sv++, svec_len-- ) { /* *sv is a (make-string 4) */ - scheme_value carrier = *sv; - (*((u_long *)(ADDRESS_AFTER_HEADER(carrier,unsigned char)))) + s48_value carrier = *sv; + (*((u_long *)(S48_ADDRESS_AFTER_HEADER(carrier,unsigned char)))) =(long)**cv; } } @@ -604,10 +605,10 @@ void set_longvec_carriers(scheme_value svec, long const * const * cvec) ** The terminating null is not counted. Returns #f on NULL. */ -scheme_value veclen(const long *vec) +s48_value 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); } diff --git a/scsh/network1.h b/scsh/network1.h index 88dcfca..729c79f 100644 --- a/scsh/network1.h +++ b/scsh/network1.h @@ -1,22 +1,22 @@ /* Exports from network1.c. */ -int scheme_bind(int sockfd, int family, scheme_value scheme_name); +int scheme_bind(int sockfd, int family, s48_value scheme_name); -int scheme_connect(int sockfd, int family, scheme_value scheme_name); +int scheme_connect(int sockfd, int family, s48_value scheme_name); -int scheme_accept(int sockfd, int family, scheme_value scheme_name); +int scheme_accept(int sockfd, int family, s48_value scheme_name); -int scheme_peer_name(int sockfd, int family, scheme_value scheme_name); +int scheme_peer_name(int sockfd, int family, s48_value scheme_name); -int scheme_socket_name(int sockfd, int family, scheme_value scheme_name); +int scheme_socket_name(int sockfd, int family, s48_value scheme_name); int scheme_socket_pair(int type, int *s1, int *s2); -int recv_substring(int s, int flags, scheme_value buf, - int start, int end, scheme_value scheme_name); +int recv_substring(int s, int flags, s48_value buf, + int start, int end, s48_value scheme_name); -int send_substring(int s, int flags, scheme_value buf, int start, int end, - int family, scheme_value scheme_name); +int send_substring(int s, int flags, s48_value buf, int start, int end, + int family, s48_value scheme_name); int scheme_getsockopt (int s, int level, int optname); @@ -47,7 +47,7 @@ int scheme_setsockopt_timeout (int s, int sec, int usec); -int scheme_host_address2host_info(scheme_value scheme_name, +int scheme_host_address2host_info(s48_value scheme_name, char** hostname, char*** aliases, char*** addresses); @@ -57,13 +57,13 @@ int scheme_host_name2host_info(const char* scheme_name, char*** aliases, char*** addresses); -int scheme_net_address2net_info(scheme_value scheme_name, - scheme_value scheme_net, +int scheme_net_address2net_info(s48_value scheme_name, + s48_value scheme_net, char** netname, char*** aliases); int scheme_net_name2net_info(const char* scheme_name, - scheme_value scheme_net, + s48_value scheme_net, char** netname, char*** aliases); @@ -94,6 +94,6 @@ int scheme_proto_name2proto_info(const char* in_name, char*** out_aliases, int* out_protocol); -void set_longvec_carriers(scheme_value svec, long const * const * cvec); +void set_longvec_carriers(s48_value svec, long const * const * cvec); -scheme_value veclen(const long *vec); +s48_value veclen(const long *vec); diff --git a/scsh/nt2.c b/scsh/nt2.c index 64ccc4f..8e5dccf 100644 --- a/scsh/nt2.c +++ b/scsh/nt2.c @@ -1,13 +1,13 @@ -fillin_date(scheme_value sec0, scheme_value min0, scheme_value hour0, - scheme_value mday0, scheme_value month0, scheme_value year0, - scheme_value tz_name0, scheme_value tz_secs0, scheme_value summer0, - scheme_value wday0, scheme_value yday0, +fillin_date(s48_value sec0, s48_value min0, s48_value hour0, + s48_value mday0, s48_value month0, s48_value year0, + s48_value tz_name0, s48_value tz_secs0, s48_value summer0, + s48_value wday0, s48_value yday0, - scheme_value *sec1, scheme_value *min1, scheme_value *hour1, - scheme_value *mday1, scheme_value *month1, scheme_value *year1, - scheme_value *tz_name1, scheme_value *tz_secs1, - scheme_value *summer1, - scheme_value *wday1, scheme_value *yday1, + s48_value *sec1, s48_value *min1, s48_value *hour1, + s48_value *mday1, s48_value *month1, s48_value *year1, + s48_value *tz_name1, s48_value *tz_secs1, + s48_value *summer1, + s48_value *wday1, s48_value *yday1, ...) { diff --git a/scsh/procobj.scm b/scsh/procobj.scm index 7225585..d810fbe 100644 --- a/scsh/procobj.scm +++ b/scsh/procobj.scm @@ -216,7 +216,7 @@ (if retval (values retval (placeholder-value (proc:status retval))) (values #f #f)) - (values #f #f))))) + (values #f #f))))))) ;;; (wait-process-group [proc-group flags]) => [proc status] ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; diff --git a/scsh/rdelim.c b/scsh/rdelim.c index d783c21..ab3d23c 100644 --- a/scsh/rdelim.c +++ b/scsh/rdelim.c @@ -1,5 +1,5 @@ /* This is an Scheme48/C interface file, -** automatically generated by cig. +** automatically generated by a hacked version of cig 3.0. */ #include @@ -11,31 +11,38 @@ /* Make sure foreign-function stubs interface to the C funs correctly: */ #include "fdports1.h" -scheme_value df_read_delim(long nargs, scheme_value *args) +s48_value df_read_delim(s48_value g1, s48_value g2, s48_value g3, s48_value g4, s48_value g5, s48_value mv_vec) { - extern scheme_value read_delim(const char *, char *, int , int , int , int *); - scheme_value ret1; - scheme_value r1; + extern s48_value read_delim(const char *, char *, int , int , int , int *); + s48_value ret1; + s48_value r1; int r2; - cig_check_nargs(6, nargs, "read_delim"); - r1 = read_delim(cig_string_body(args[5]), cig_string_body(args[4]), EXTRACT_FIXNUM(args[3]), EXTRACT_FIXNUM(args[2]), EXTRACT_FIXNUM(args[1]), &r2); + + r1 = read_delim(s48_extract_string(g1), s48_extract_string(g2), s48_extract_fixnum(g3), s48_extract_fixnum(g4), s48_extract_fixnum(g5), &r2); ret1 = r1; - VECTOR_REF(*args,0) = ENTER_FIXNUM(r2); + S48_VECTOR_SET(mv_vec,0,s48_enter_fixnum(r2)); return ret1; - } +} -scheme_value df_skip_chars(long nargs, scheme_value *args) +s48_value df_skip_chars(s48_value g1, s48_value g2, s48_value mv_vec) { - extern scheme_value skip_chars(const char *, int , int *); - scheme_value ret1; - scheme_value r1; + extern s48_value skip_chars(const char *, int , int *); + s48_value ret1; + s48_value r1; int r2; - cig_check_nargs(3, nargs, "skip_chars"); - r1 = skip_chars(cig_string_body(args[2]), EXTRACT_FIXNUM(args[1]), &r2); + + r1 = skip_chars(s48_extract_string(g1), s48_extract_fixnum(g2), &r2); ret1 = r1; - VECTOR_REF(*args,0) = ENTER_FIXNUM(r2); + S48_VECTOR_SET(mv_vec,0,s48_enter_fixnum(r2)); return ret1; - } +} +s48_value s48_init_rdelim(void) +{ + S48_EXPORT_FUNCTION(df_read_delim); + S48_EXPORT_FUNCTION(df_skip_chars); + + return S48_UNSPECIFIC; +} diff --git a/scsh/re.scm b/scsh/re.scm index 57a0253..7c60ecf 100644 --- a/scsh/re.scm +++ b/scsh/re.scm @@ -57,6 +57,7 @@ static-string) ; Error msg or #f + ;;; Executing compiled regexps ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; diff --git a/scsh/re1.c b/scsh/re1.c index 0ac7ce0..0688f70 100644 --- a/scsh/re1.c +++ b/scsh/re1.c @@ -34,10 +34,10 @@ char *re_byte_len(const char *re, int *len) ** Compile regexp into string described by `cr'. */ -char *re_compile(const char *re, scheme_value cr) +char *re_compile(const char *re, s48_value cr) { - int len = STRING_LENGTH(cr); - regexp *r = (regexp *) &STRING_REF(cr, 0); + int len = S48_STRING_LENGTH(cr); + regexp *r = (regexp *) &S48_STRING_REF(cr, 0); regexp_error = 0; regcomp_comp(re, r, len); @@ -49,16 +49,16 @@ char *re_compile(const char *re, scheme_value cr) ** Returns boolean match/no-match in hit. */ -char *re_exec(scheme_value cr, const char *string, int start, - scheme_value start_vec, scheme_value end_vec, int *hit) +char *re_exec(s48_value cr, const char *string, int start, + s48_value start_vec, s48_value end_vec, int *hit) { - regexp *r = (regexp *) &STRING_REF(cr, 0); + regexp *r = (regexp *) &S48_STRING_REF(cr, 0); *hit = 0; - if( VECTOR_LENGTH(start_vec) != NSUBEXP ) /* These tests should */ + if( S48_VECTOR_LENGTH(start_vec) != NSUBEXP ) /* These tests should */ return "Illegal start vector"; /* never trigger. */ - if( VECTOR_LENGTH(end_vec) != NSUBEXP ) + if( S48_VECTOR_LENGTH(end_vec) != NSUBEXP ) return "Illegal end vector"; regexp_error = 0; @@ -68,8 +68,8 @@ char *re_exec(scheme_value cr, const char *string, int start, for(i=0; istartp[i]; const char *e = r->endp[i]; - VECTOR_REF(start_vec,i) = s ? ENTER_FIXNUM(s - string) : SCHFALSE; - VECTOR_REF(end_vec,i) = e ? ENTER_FIXNUM(e - string) : SCHFALSE; + S48_VECTOR_REF(start_vec,i) = s ? s48_enter_fixnum(s - string) : S48_FALSE; + S48_VECTOR_REF(end_vec,i) = e ? s48_enter_fixnum(e - string) : S48_FALSE; r->startp[i] = 0; /* Why did Sommerfeld */ r->endp[i] = 0; /* put these here? */ } @@ -80,50 +80,50 @@ char *re_exec(scheme_value cr, const char *string, int start, } -char *re_subst(scheme_value cr, const char *match, +char *re_subst(s48_value cr, const char *match, const char *src, int start, - scheme_value start_vec, scheme_value end_vec, - scheme_value outbuf, int *len) + s48_value start_vec, s48_value end_vec, + s48_value outbuf, int *len) { int i; - regexp *r = (regexp *) &STRING_REF(cr, 0); + regexp *r = (regexp *) &S48_STRING_REF(cr, 0); - if( VECTOR_LENGTH(start_vec) != NSUBEXP ) /* These tests should */ + if( S48_VECTOR_LENGTH(start_vec) != NSUBEXP ) /* These tests should */ return "Illegal start vector"; /* never trigger. */ - if( VECTOR_LENGTH(end_vec) != NSUBEXP ) + if( S48_VECTOR_LENGTH(end_vec) != NSUBEXP ) return "Illegal end vector"; for (i=0; istartp[i] = FIXNUMP(se) ? (match + EXTRACT_FIXNUM(se)) : 0; - r->endp[i] = FIXNUMP(ee) ? (match + EXTRACT_FIXNUM(ee)) : 0; + s48_value se = S48_VECTOR_REF(start_vec, i); + s48_value ee = S48_VECTOR_REF(end_vec, i); + r->startp[i] = S48_FIXNUM_P(se) ? (match + s48_extract_fixnum(se)) : 0; + r->endp[i] = S48_FIXNUM_P(ee) ? (match + s48_extract_fixnum(ee)) : 0; } regexp_error = 0; - regnsub(r, src, &STRING_REF(outbuf, 0), STRING_LENGTH(outbuf)); - *len = strlen(&STRING_REF(outbuf, 0)); + regnsub(r, src, &S48_STRING_REF(outbuf, 0), S48_STRING_LENGTH(outbuf)); + *len = strlen(&S48_STRING_REF(outbuf, 0)); return regexp_error; } -char *re_subst_len(scheme_value cr, const char *match, +char *re_subst_len(s48_value cr, const char *match, const char *src, int start, - scheme_value start_vec, scheme_value end_vec, + s48_value start_vec, s48_value end_vec, int *len) { int i; - regexp *r = (regexp *) &STRING_REF(cr, 0); + regexp *r = (regexp *) &S48_STRING_REF(cr, 0); - if( VECTOR_LENGTH(start_vec) != NSUBEXP ) /* These tests should */ + if( S48_VECTOR_LENGTH(start_vec) != NSUBEXP ) /* These tests should */ return "Illegal start vector"; /* never trigger. */ - if( VECTOR_LENGTH(end_vec) != NSUBEXP ) + if( S48_VECTOR_LENGTH(end_vec) != NSUBEXP ) return "Illegal end vector"; for (i=0; istartp[i] = FIXNUMP(se) ? (match + EXTRACT_FIXNUM(se)) : 0; - r->endp[i] = FIXNUMP(ee) ? (match + EXTRACT_FIXNUM(ee)) : 0; + s48_value se = S48_VECTOR_REF(start_vec, i); + s48_value ee = S48_VECTOR_REF(end_vec, i); + r->startp[i] = S48_FIXNUM_P(se) ? (match + s48_extract_fixnum(se)) : 0; + r->endp[i] = S48_FIXNUM_P(ee) ? (match + s48_extract_fixnum(ee)) : 0; } regexp_error = 0; @@ -138,7 +138,7 @@ char *re_subst_len(scheme_value cr, const char *match, */ char *re_match(const char *re, const char *string, int start, - scheme_value start_vec, scheme_value end_vec, int *hit) + s48_value start_vec, s48_value end_vec, int *hit) { regexp *prog; @@ -147,12 +147,12 @@ char *re_match(const char *re, const char *string, int start, prog = regcomp(re); if( !prog ) return regexp_error; - if( VECTOR_LENGTH(start_vec) != NSUBEXP ) { /* These two tests */ + if( S48_VECTOR_LENGTH(start_vec) != NSUBEXP ) { /* These two tests */ Free(prog); return "Illegal start vector"; } - if( VECTOR_LENGTH(end_vec) != NSUBEXP ) { /* should never trigger. */ + if( S48_VECTOR_LENGTH(end_vec) != NSUBEXP ) { /* should never trigger. */ Free(prog); return "Illegal end vector"; } @@ -162,8 +162,8 @@ char *re_match(const char *re, const char *string, int start, for(i=0; istartp[i]; const char *e = prog->endp[i]; - VECTOR_REF(start_vec,i) = s ? ENTER_FIXNUM(s - string) : SCHFALSE; - VECTOR_REF(end_vec,i) = e ? ENTER_FIXNUM(e - string) : SCHFALSE; + S48_VECTOR_REF(start_vec,i) = s ? s48_enter_fixnum(s - string) : S48_FALSE; + S48_VECTOR_REF(end_vec,i) = e ? s48_enter_fixnum(e - string) : S48_FALSE; } *hit = 1; } diff --git a/scsh/re1.h b/scsh/re1.h index 5249ba6..9d1646e 100644 --- a/scsh/re1.h +++ b/scsh/re1.h @@ -1,11 +1,11 @@ /* Exports from re1.c */ char *re_byte_len(const char *re, int *len); -char *re_compile(const char *re, scheme_value target); +char *re_compile(const char *re, s48_value target); -char *re_exec(scheme_value cr, const char *string, int start, - scheme_value start_vec, scheme_value end_vec, int *hit); +char *re_exec(s48_value cr, const char *string, int start, + s48_value start_vec, s48_value end_vec, int *hit); char *re_match(const char *re, const char *string, int start, - scheme_value start_vec, scheme_value end_vec, + s48_value start_vec, s48_value end_vec, int *hit); diff --git a/scsh/scsh-package.scm b/scsh/scsh-package.scm index f4f3d6d..5725fe7 100644 --- a/scsh/scsh-package.scm +++ b/scsh/scsh-package.scm @@ -40,7 +40,7 @@ (export transcribe-extended-process-form) (open receiving ; receive error-package - syntactic ; generated? + names ; generated? by JMG scsh-utilities ; check-arg scheme ) diff --git a/scsh/select.c b/scsh/select.c index c8952b1..0c0ce55 100644 --- a/scsh/select.c +++ b/scsh/select.c @@ -1,5 +1,5 @@ /* This is an Scheme48/C interface file, -** automatically generated by cig. +** automatically generated by a hacked version of cig 3.0. */ #include @@ -9,39 +9,46 @@ /* Make sure foreign-function stubs interface to the C funs correctly: */ #include "select1.h" -scheme_value df_select_copyback(long nargs, scheme_value *args) +s48_value df_select_copyback(s48_value g1, s48_value g2, s48_value g3, s48_value g4, s48_value mv_vec) { - extern scheme_value select_copyback(scheme_value , scheme_value , scheme_value , scheme_value , int *, int *, int *); - scheme_value ret1; - scheme_value r1; + extern s48_value select_copyback(s48_value , s48_value , s48_value , s48_value , int *, int *, int *); + s48_value ret1; + s48_value r1; int r2; int r3; int r4; - cig_check_nargs(5, nargs, "select_copyback"); - r1 = select_copyback(args[4], args[3], args[2], args[1], &r2, &r3, &r4); + + r1 = select_copyback(g1, g2, g3, g4, &r2, &r3, &r4); ret1 = r1; - VECTOR_REF(*args,0) = ENTER_FIXNUM(r2); - VECTOR_REF(*args,1) = ENTER_FIXNUM(r3); - VECTOR_REF(*args,2) = ENTER_FIXNUM(r4); + S48_VECTOR_SET(mv_vec,0,s48_enter_fixnum(r2)); + S48_VECTOR_SET(mv_vec,1,s48_enter_fixnum(r3)); + S48_VECTOR_SET(mv_vec,2,s48_enter_fixnum(r4)); return ret1; - } +} -scheme_value df_select_filter(long nargs, scheme_value *args) +s48_value df_select_filter(s48_value g1, s48_value g2, s48_value g3, s48_value g4, s48_value mv_vec) { - extern scheme_value select_filter(scheme_value , scheme_value , scheme_value , scheme_value , int *, int *, int *); - scheme_value ret1; - scheme_value r1; + extern s48_value select_filter(s48_value , s48_value , s48_value , s48_value , int *, int *, int *); + s48_value ret1; + s48_value r1; int r2; int r3; int r4; - cig_check_nargs(5, nargs, "select_filter"); - r1 = select_filter(args[4], args[3], args[2], args[1], &r2, &r3, &r4); + + r1 = select_filter(g1, g2, g3, g4, &r2, &r3, &r4); ret1 = r1; - VECTOR_REF(*args,0) = ENTER_FIXNUM(r2); - VECTOR_REF(*args,1) = ENTER_FIXNUM(r3); - VECTOR_REF(*args,2) = ENTER_FIXNUM(r4); + S48_VECTOR_SET(mv_vec,0,s48_enter_fixnum(r2)); + S48_VECTOR_SET(mv_vec,1,s48_enter_fixnum(r3)); + S48_VECTOR_SET(mv_vec,2,s48_enter_fixnum(r4)); return ret1; - } +} +s48_value s48_init_select(void) +{ + S48_EXPORT_FUNCTION(df_select_copyback); + S48_EXPORT_FUNCTION(df_select_filter); + + return S48_UNSPECIFIC; +} diff --git a/scsh/select1.c b/scsh/select1.c index 32b51f2..da6a3e1 100644 --- a/scsh/select1.c +++ b/scsh/select1.c @@ -26,7 +26,7 @@ extern int errno; static void or2_fdset(fd_set *x, fd_set *y, int max_elt); -static int copyback_fdvec(scheme_value portvec, fd_set *fdset); +static int copyback_fdvec(s48_value portvec, fd_set *fdset); /* RVEC, WVEC, and EVEC are Scheme vectors of integer file descriptors, ** I/O ports, and #f's. NSECS is an integer timeout value, or #f for @@ -34,8 +34,8 @@ static int copyback_fdvec(scheme_value portvec, fd_set *fdset); ** passed pointers. Return 0 for OK, otherwise error is in errno. */ -int do_select(scheme_value rvec, scheme_value wvec, - scheme_value evec, scheme_value nsecs, +int do_select(s48_value rvec, s48_value wvec, + s48_value evec, s48_value nsecs, fd_set *rset_ans, fd_set *wset_ans, fd_set *eset_ans) { struct timeval timeout, *tptr; @@ -49,36 +49,36 @@ int do_select(scheme_value rvec, scheme_value wvec, FD_ZERO(&rset_bufrdy); FD_ZERO(&wset_bufrdy); FD_ZERO(&eset_bufrdy); /* Scan the readvec elts. */ - nelts = VECTOR_LENGTH(rvec); + nelts = S48_VECTOR_LENGTH(rvec); for(i=nelts; --i >= 0; ) { - scheme_value elt = VECTOR_REF(rvec,i); + s48_value elt = S48_VECTOR_REF(rvec,i); int fd; - fd = EXTRACT_FIXNUM(elt); + fd = s48_extract_fixnum(elt); FD_SET(fd, rset_ans); max_fd = max(max_fd, fd); } /* Scan the writevec elts. */ - nelts = VECTOR_LENGTH(wvec); + nelts = S48_VECTOR_LENGTH(wvec); for(i=nelts; --i >= 0; ) { - scheme_value elt = VECTOR_REF(wvec,i); + s48_value elt = S48_VECTOR_REF(wvec,i); int fd; - fd = EXTRACT_FIXNUM(elt); + fd = s48_extract_fixnum(elt); FD_SET(fd, wset_ans); max_fd = max(max_fd, fd); } /* Scan the exception-vec elts. */ - nelts = VECTOR_LENGTH(evec); + nelts = S48_VECTOR_LENGTH(evec); for(i=nelts; --i >= 0; ) { - scheme_value elt = VECTOR_REF(evec,i); + s48_value elt = S48_VECTOR_REF(evec,i); int fd; - fd = EXTRACT_FIXNUM(elt); + fd = s48_extract_fixnum(elt); FD_SET(fd, eset_ans); max_fd = max(max_fd, fd); @@ -90,15 +90,15 @@ int do_select(scheme_value rvec, scheme_value wvec, timeout.tv_usec = 0; tptr = &timeout; } - else if ( FIXNUMP(nsecs) ) { - timeout.tv_sec = EXTRACT_FIXNUM(nsecs); /* Wait n seconds. */ + else if ( S48_FIXNUM_P(nsecs) ) { + timeout.tv_sec = s48_extract_fixnum(nsecs); /* Wait n seconds. */ timeout.tv_usec = 0; tptr = &timeout; } else tptr = NULL; /* #f => Infinite wait. */ /* select1() is defined in sysdep.h -- bogus compatibility macro. */ - nfound = select1(max_fd+1, rset_ans, wset_ans, eset_ans, tptr); /* Do it.*/ + nfound = select(max_fd+1, rset_ans, wset_ans, eset_ans, tptr); /* Do it.*/ /* EINTR is not an error return if we have hits on buffered ports ** to report. @@ -134,16 +134,17 @@ static void or2_fdset(fd_set *x, fd_set *y, int max_elt) ** Scan over the vector, and copy any elt whose file descriptor is in FDSET ** to the front of the vector. Return the number of elts thus copied. */ -static int copyback_fdvec(scheme_value portvec, fd_set *fdset) +static int copyback_fdvec(s48_value portvec, fd_set *fdset) { - int vlen = VECTOR_LENGTH(portvec); + int vlen = S48_VECTOR_LENGTH(portvec); int i, j=0; for( i = -1; ++i < vlen; ) { - scheme_value elt = VECTOR_REF(portvec, i); - int fd = EXTRACT_FIXNUM((FIXNUMP(elt)) ? elt : *PortFd(elt)); + s48_value elt = S48_VECTOR_REF(portvec, i); + int fd = s48_extract_fixnum((S48_FIXNUM_P(elt)) ? elt : (1 / 0)); + //JMG *PortFd(elt)); if( FD_ISSET(fd,fdset) ) { FD_CLR(fd,fdset); /* In case luser put elt in multiple times. */ - VECTOR_REF(portvec, j) = elt; + S48_VECTOR_SET(portvec, j, elt); j++; } } @@ -155,20 +156,20 @@ static int copyback_fdvec(scheme_value portvec, fd_set *fdset) ** Return count of active elements. */ -static int clobber_inactives(scheme_value portvec, fd_set *fdset) +static int clobber_inactives(s48_value portvec, fd_set *fdset) { int count = 0; - int i = VECTOR_LENGTH(portvec); + int i = S48_VECTOR_LENGTH(portvec); while( --i >= 0 ) { - scheme_value elt = VECTOR_REF(portvec, i); - if( elt != SCHFALSE ) { - int fd = EXTRACT_FIXNUM((FIXNUMP(elt)) ? elt : *PortFd(elt)); + s48_value elt = S48_VECTOR_REF(portvec, i); + if( elt != S48_FALSE ) { + int fd = s48_extract_fixnum((S48_FIXNUM_P(elt)) ? elt : (1/0)); //JMG *PortFd(elt)); if( FD_ISSET(fd,fdset) ) { FD_CLR(fd,fdset); /* In case luser put elt in multiple times. */ ++count; } - else VECTOR_REF(portvec, i) = SCHFALSE; /* Clobber. */ + else S48_VECTOR_SET(portvec, i, S48_FALSE); /* Clobber. */ } } return count; @@ -183,21 +184,21 @@ static int clobber_inactives(scheme_value portvec, fd_set *fdset) ** Return error indicator & number of hits for each vector. */ -scheme_value select_copyback(scheme_value rvec, scheme_value wvec, - scheme_value evec, scheme_value nsecs, +s48_value select_copyback(s48_value rvec, s48_value wvec, + s48_value evec, s48_value nsecs, int *r_numrdy, int *w_numrdy, int *e_numrdy) { fd_set rset, wset, eset; if( do_select(rvec, wvec, evec, nsecs, &rset, &wset, &eset) ) { *r_numrdy = *w_numrdy = *e_numrdy = 0; - return ENTER_FIXNUM(errno); + return s48_enter_fixnum(errno); } *r_numrdy = copyback_fdvec(rvec, &rset); *w_numrdy = copyback_fdvec(wvec, &wset); *e_numrdy = copyback_fdvec(evec, &eset); - return SCHFALSE; + return S48_FALSE; } @@ -205,19 +206,19 @@ scheme_value select_copyback(scheme_value rvec, scheme_value wvec, ** return error indicator & number of hits for each vector. */ -scheme_value select_filter(scheme_value rvec, scheme_value wvec, - scheme_value evec, scheme_value nsecs, +s48_value select_filter(s48_value rvec, s48_value wvec, + s48_value evec, s48_value nsecs, int *r_numrdy, int *w_numrdy, int *e_numrdy) { fd_set rset, wset, eset; if( do_select(rvec, wvec, evec, nsecs, &rset, &wset, &eset) ) { *r_numrdy = *w_numrdy = *e_numrdy = 0; - return ENTER_FIXNUM(errno); + return s48_enter_fixnum(errno); } *r_numrdy = clobber_inactives(rvec, &rset); *w_numrdy = clobber_inactives(wvec, &wset); *e_numrdy = clobber_inactives(evec, &eset); - return SCHFALSE; + return S48_FALSE; } diff --git a/scsh/select1.h b/scsh/select1.h index fde8bfb..1a91028 100644 --- a/scsh/select1.h +++ b/scsh/select1.h @@ -1,9 +1,9 @@ /* Exports from select1.c. */ -scheme_value select_copyback(scheme_value rvec, scheme_value wvec, - scheme_value evec, scheme_value nsecs, +s48_value select_copyback(s48_value rvec, s48_value wvec, + s48_value evec, s48_value nsecs, int *r_numrdy, int *w_numrdy, int *e_numrdy); -scheme_value select_filter(scheme_value rvec, scheme_value wvec, - scheme_value evec, scheme_value nsecs, +s48_value select_filter(s48_value rvec, s48_value wvec, + s48_value evec, s48_value nsecs, int *r_numrdy, int *w_numrdy, int *e_numrdy); diff --git a/scsh/sighandlers.c b/scsh/sighandlers.c index 3724f22..92a89e3 100644 --- a/scsh/sighandlers.c +++ b/scsh/sighandlers.c @@ -1,5 +1,5 @@ /* This is an Scheme48/C interface file, -** automatically generated by cig. +** automatically generated by a hacked version of cig 3.0. */ #include @@ -11,77 +11,88 @@ extern int errno; /* Make sure foreign-function stubs interface to the C funs correctly: */ #include "sighandlers1.h" -scheme_value df_sig2interrupt(long nargs, scheme_value *args) +s48_value df_sig2interrupt(s48_value g1) { extern int sig2interrupt(int ); - scheme_value ret1; + s48_value ret1; int r1; - cig_check_nargs(1, nargs, "sig2interrupt"); - r1 = sig2interrupt(EXTRACT_FIXNUM(args[0])); - ret1 = ENTER_FIXNUM(r1); + + r1 = sig2interrupt(s48_extract_fixnum(g1)); + ret1 = s48_enter_fixnum(r1); return ret1; - } +} -scheme_value df_do_default_sigaction(long nargs, scheme_value *args) +s48_value df_do_default_sigaction(s48_value g1) { extern void do_default_sigaction(int ); - cig_check_nargs(1, nargs, "do_default_sigaction"); - do_default_sigaction(EXTRACT_FIXNUM(args[0])); - return SCHFALSE; - } + + do_default_sigaction(s48_extract_fixnum(g1)); + return S48_FALSE; +} -scheme_value df_scsh_set_sig(long nargs, scheme_value *args) +s48_value df_scsh_set_sig(s48_value g1, s48_value g2, s48_value g3, s48_value mv_vec) { - extern scheme_value scsh_set_sig(int , int , int , int *, int *); - scheme_value ret1; - scheme_value r1; + extern s48_value scsh_set_sig(int , int , int , int *, int *); + s48_value ret1; + s48_value r1; int r2; int r3; - cig_check_nargs(4, nargs, "scsh_set_sig"); - r1 = scsh_set_sig(EXTRACT_FIXNUM(args[3]), EXTRACT_FIXNUM(args[2]), EXTRACT_FIXNUM(args[1]), &r2, &r3); + + r1 = scsh_set_sig(s48_extract_fixnum(g1), s48_extract_fixnum(g2), s48_extract_fixnum(g3), &r2, &r3); ret1 = r1; - VECTOR_REF(*args,0) = ENTER_FIXNUM(r2); - VECTOR_REF(*args,1) = ENTER_FIXNUM(r3); + S48_VECTOR_SET(mv_vec,0,s48_enter_fixnum(r2)); + S48_VECTOR_SET(mv_vec,1,s48_enter_fixnum(r3)); return ret1; - } +} -scheme_value df_scsh_get_sig(long nargs, scheme_value *args) +s48_value df_scsh_get_sig(s48_value g1, s48_value mv_vec) { - extern scheme_value scsh_get_sig(int , int *, int *); - scheme_value ret1; - scheme_value r1; + extern s48_value scsh_get_sig(int , int *, int *); + s48_value ret1; + s48_value r1; int r2; int r3; - cig_check_nargs(2, nargs, "scsh_get_sig"); - r1 = scsh_get_sig(EXTRACT_FIXNUM(args[1]), &r2, &r3); + + r1 = scsh_get_sig(s48_extract_fixnum(g1), &r2, &r3); ret1 = r1; - VECTOR_REF(*args,0) = ENTER_FIXNUM(r2); - VECTOR_REF(*args,1) = ENTER_FIXNUM(r3); + S48_VECTOR_SET(mv_vec,0,s48_enter_fixnum(r2)); + S48_VECTOR_SET(mv_vec,1,s48_enter_fixnum(r3)); return ret1; - } +} -scheme_value df_install_scsh_handlers(long nargs, scheme_value *args) +s48_value df_install_scsh_handlers(void) { extern void install_scsh_handlers(void); - cig_check_nargs(0, nargs, "install_scsh_handlers"); + install_scsh_handlers(); - return SCHFALSE; - } + return S48_FALSE; +} -scheme_value df_get_int_handlers(long nargs, scheme_value *args) +s48_value df_get_int_handlers(void) { - extern scheme_value get_int_handlers(void); - scheme_value ret1; - scheme_value r1; + extern s48_value get_int_handlers(void); + s48_value ret1; + s48_value r1; - cig_check_nargs(0, nargs, "get_int_handlers"); + r1 = get_int_handlers(); ret1 = r1; return ret1; - } +} +s48_value s48_init_sighandlers(void) +{ + S48_EXPORT_FUNCTION(df_sig2interrupt); + S48_EXPORT_FUNCTION(df_do_default_sigaction); + S48_EXPORT_FUNCTION(df_scsh_set_sig); + S48_EXPORT_FUNCTION(df_scsh_get_sig); + S48_EXPORT_FUNCTION(df_install_scsh_handlers); + S48_EXPORT_FUNCTION(df_get_int_handlers); + + return S48_UNSPECIFIC; +} diff --git a/scsh/sighandlers1.c b/scsh/sighandlers1.c index 2a9607e..8601f7e 100644 --- a/scsh/sighandlers1.c +++ b/scsh/sighandlers1.c @@ -8,6 +8,7 @@ #include #include #include "cstuff.h" +#include /* Make sure our exports match up w/the implementation: */ #include "sighandlers1.h" @@ -19,7 +20,7 @@ extern int errno; -extern scheme_value Spending_interruptsS, Sinterrupt_handlersS; +// JMG: extern s48_value Spen ing_interruptsS, Sinterrupt_handlersS; /* Translate Unix signal numbers to S48 interrupt numbers. */ @@ -67,32 +68,33 @@ int get_procmask(int *old_lo_p) static void scm_handle_sig(int sig) { /*fprintf(stderr, "scm_handle_sig(%d) = int %d\n", sig, sig2int[sig]);*/ - Spending_interruptsS |= (1< ignore, 1 => default, 2 => S48 VM */ /* Common code for two functions above. */ -static scheme_value scsh_ret_sig(int retval, struct sigaction *oldsa, +static s48_value scsh_ret_sig(int retval, struct sigaction *oldsa, int *old_hc, int *oflags) { if( retval ) { *old_hc = -1; *oflags = -1; - return ENTER_FIXNUM(errno); + return s48_enter_fixnum(errno); } if( oldsa->sa_handler == SIG_IGN ) *old_hc = 0; else if( oldsa->sa_handler == SIG_DFL ) *old_hc = 1; else if( oldsa->sa_handler == scm_handle_sig ) *old_hc = 2; - else *old_hc = ENTER_FIXNUM(3); /* Unknown signal handler. */ + else *old_hc = s48_enter_fixnum(3); /* Unknown signal handler. */ *oflags = oldsa->sa_flags; - return SCHFALSE; + return S48_FALSE; } -scheme_value scsh_set_sig(int sig, int handler_code, int flags, +s48_value scsh_set_sig(int sig, int handler_code, int flags, int *old_hc, int *oflags) { struct sigaction new, old; @@ -115,7 +117,7 @@ scheme_value scsh_set_sig(int sig, int handler_code, int flags, } -scheme_value scsh_get_sig(int signal, int *old_hc, int *oflags) +s48_value scsh_get_sig(int signal, int *old_hc, int *oflags) { struct sigaction old; return scsh_ret_sig(sigaction(signal, NULL, &old), @@ -191,7 +193,9 @@ void install_scsh_handlers(void) } /* Sneak me the S48 interrupt handlers vector. */ -scheme_value get_int_handlers(void) +s48_value get_int_handlers(void) { - return Sinterrupt_handlersS; + assert (1 == 0); //JMG + //return Sinterrupt_handlersS; + return 1; } diff --git a/scsh/sighandlers1.h b/scsh/sighandlers1.h index c3a5720..d124e57 100644 --- a/scsh/sighandlers1.h +++ b/scsh/sighandlers1.h @@ -5,12 +5,12 @@ int sig2interrupt(int signal); int set_procmask(int hi, int lo, int *old_lo_p); int get_procmask(int *old_lo_p); -scheme_value scsh_set_sig(int sig, int handler_code, int flags, +s48_value scsh_set_sig(int sig, int handler_code, int flags, int *ohc, int *oflags); -scheme_value scsh_get_sig(int signal, int *handler_code, int *flags); +s48_value scsh_get_sig(int signal, int *handler_code, int *flags); void do_default_sigaction(int signal); void install_scsh_handlers(void); -scheme_value get_int_handlers(void); +s48_value get_int_handlers(void); diff --git a/scsh/sleep1.c b/scsh/sleep1.c index 7f2f3e3..3315386 100644 --- a/scsh/sleep1.c +++ b/scsh/sleep1.c @@ -10,7 +10,7 @@ #endif #include #include -#include "../scheme48.h" +#include "../c/scheme48.h" /* Sux because it's dependent on 32-bitness. */ #define hi8(i) (((i)>>24) & 0xff) @@ -28,7 +28,7 @@ ** and is pretty straightforward. */ -scheme_value sleep_until(int hisecs, int losecs) +s48_value sleep_until(int hisecs, int losecs) { time_t when = comp8_24(hisecs, losecs); time_t now = time(0); @@ -41,8 +41,8 @@ scheme_value sleep_until(int hisecs, int losecs) FD_ZERO(&r); FD_ZERO(&w); FD_ZERO(&e); - if( select(0, &r, &w, &e, &tv) ) return SCHFALSE; /* Lose */ + if( select(0, &r, &w, &e, &tv) ) return S48_FALSE; /* Lose */ } - return SCHTRUE; /* Win */ + return S48_TRUE; /* Win */ } diff --git a/scsh/syscalls.c b/scsh/syscalls.c index 21fc855..97de17e 100644 --- a/scsh/syscalls.c +++ b/scsh/syscalls.c @@ -1,5 +1,5 @@ /* This is an Scheme48/C interface file, -** automatically generated by cig. +** automatically generated by a hacked version of cig 3.0. */ #include @@ -18,994 +18,1059 @@ /* Make sure foreign-function stubs interface to the C funs correctly: */ #include "dirstuff1.h" -#include "fdports1.h" #include "select1.h" #include "syscalls1.h" #include "userinfo1.h" extern int errno; -#define errno_on_zero_or_false(x) ((x) ? SCHFALSE : ENTER_FIXNUM(errno)) -#define errno_or_false(x) (((x) == -1) ? ENTER_FIXNUM(errno) : SCHFALSE) -#define False_on_zero(x) ((x) ? ENTER_FIXNUM(x) : SCHFALSE) +#define errno_on_zero_or_false(x) ((x) ? S48_FALSE : s48_enter_fixnum(errno)) +#define errno_or_false(x) (((x) == -1) ? s48_enter_fixnum(errno) : S48_FALSE) +#define False_on_zero(x) ((x) ? s48_enter_fixnum(x) : S48_FALSE) -scheme_value df_scheme_exec(long nargs, scheme_value *args) +s48_value df_scheme_exec(s48_value g1, s48_value g2, s48_value g3) { - extern int scheme_exec(const char *, scheme_value , scheme_value ); - scheme_value ret1; + extern int scheme_exec(const char *, s48_value , s48_value ); + s48_value ret1; int r1; - cig_check_nargs(3, nargs, "scheme_exec"); - r1 = scheme_exec(cig_string_body(args[2]), args[1], args[0]); - ret1 = ENTER_FIXNUM(r1); + + r1 = scheme_exec(s48_extract_string(g1), g2, g3); + ret1 = s48_enter_fixnum(r1); return ret1; - } +} -scheme_value df_exit(long nargs, scheme_value *args) +s48_value df_exit(s48_value g1) { extern void exit(int ); - cig_check_nargs(1, nargs, "exit"); - exit(EXTRACT_FIXNUM(args[0])); - return SCHFALSE; - } + + exit(s48_extract_fixnum(g1)); + return S48_FALSE; +} -scheme_value df__exit(long nargs, scheme_value *args) +s48_value df__exit(s48_value g1) { extern void _exit(int ); - cig_check_nargs(1, nargs, "_exit"); - _exit(EXTRACT_FIXNUM(args[0])); - return SCHFALSE; - } + + _exit(s48_extract_fixnum(g1)); + return S48_FALSE; +} -scheme_value df_fork(long nargs, scheme_value *args) +s48_value df_fork(s48_value mv_vec) { extern pid_t fork(void); - scheme_value ret1; + s48_value ret1; pid_t r1; - cig_check_nargs(1, nargs, "fork"); + r1 = fork(); ret1 = errno_or_false(r1); - VECTOR_REF(*args,0) = ENTER_FIXNUM(r1); + S48_VECTOR_SET(mv_vec,0,s48_enter_fixnum(r1)); return ret1; - } +} -scheme_value df_wait_pid(long nargs, scheme_value *args) +s48_value df_wait_pid(s48_value g1, s48_value g2, s48_value mv_vec) { - extern scheme_value wait_pid(int , int , int *, int *); - scheme_value ret1; - scheme_value r1; + extern s48_value wait_pid(int , int , int *, int *); + s48_value ret1; + s48_value r1; int r2; int r3; - cig_check_nargs(3, nargs, "wait_pid"); - r1 = wait_pid(EXTRACT_FIXNUM(args[2]), EXTRACT_FIXNUM(args[1]), &r2, &r3); + + r1 = wait_pid(s48_extract_fixnum(g1), s48_extract_fixnum(g2), &r2, &r3); ret1 = r1; - VECTOR_REF(*args,0) = ENTER_FIXNUM(r2); - VECTOR_REF(*args,1) = ENTER_FIXNUM(r3); + S48_VECTOR_SET(mv_vec,0,s48_enter_fixnum(r2)); + S48_VECTOR_SET(mv_vec,1,s48_enter_fixnum(r3)); return ret1; - } +} -scheme_value df_chdir(long nargs, scheme_value *args) +s48_value df_chdir(s48_value g1) { extern int chdir(const char *); - scheme_value ret1; + s48_value ret1; int r1; - cig_check_nargs(1, nargs, "chdir"); - r1 = chdir(cig_string_body(args[0])); + + r1 = chdir(s48_extract_string(g1)); ret1 = errno_or_false(r1); return ret1; - } +} -scheme_value df_scheme_cwd(long nargs, scheme_value *args) +s48_value df_scheme_cwd(s48_value mv_vec) { extern int scheme_cwd(const char **); - scheme_value ret1; + s48_value ret1; int r1; const char *r2; - cig_check_nargs(1, nargs, "scheme_cwd"); + r1 = scheme_cwd(&r2); ret1 = False_on_zero(r1); - {AlienVal(CAR(VECTOR_REF(*args,0))) = (long) r2; CDR(VECTOR_REF(*args,0)) = strlen_or_false(r2);} + S48_SET_CAR(S48_VECTOR_REF(mv_vec,0),(long) r2); S48_SET_CDR(S48_VECTOR_REF(mv_vec,0),strlen_or_false(r2)); return ret1; - } +} -scheme_value df_getgid(long nargs, scheme_value *args) +s48_value df_getgid(void) { extern gid_t getgid(void); - scheme_value ret1; + s48_value ret1; gid_t r1; - cig_check_nargs(0, nargs, "getgid"); + r1 = getgid(); - ret1 = ENTER_FIXNUM(r1); + ret1 = s48_enter_fixnum(r1); return ret1; - } +} -scheme_value df_getegid(long nargs, scheme_value *args) +s48_value df_getegid(void) { extern gid_t getegid(void); - scheme_value ret1; + s48_value ret1; gid_t r1; - cig_check_nargs(0, nargs, "getegid"); + r1 = getegid(); - ret1 = ENTER_FIXNUM(r1); + ret1 = s48_enter_fixnum(r1); return ret1; - } +} -scheme_value df_setgid(long nargs, scheme_value *args) +s48_value df_setgid(s48_value g1) { - scheme_value ret1; + s48_value ret1; int r1; - cig_check_nargs(1, nargs, "setgid"); - r1 = setgid(EXTRACT_FIXNUM(args[0])); + + r1 = setgid(s48_extract_fixnum(g1)); ret1 = errno_or_false(r1); return ret1; - } +} -scheme_value df_num_supp_groups(long nargs, scheme_value *args) +s48_value df_num_supp_groups(s48_value mv_vec) { extern int num_supp_groups(void); - scheme_value ret1; + s48_value ret1; int r1; - cig_check_nargs(1, nargs, "num_supp_groups"); + r1 = num_supp_groups(); ret1 = errno_or_false(r1); - VECTOR_REF(*args,0) = ENTER_FIXNUM(r1); + S48_VECTOR_SET(mv_vec,0,s48_enter_fixnum(r1)); return ret1; - } +} -scheme_value df_get_groups(long nargs, scheme_value *args) +s48_value df_get_groups(s48_value g1, s48_value mv_vec) { - extern int get_groups(scheme_value ); - scheme_value ret1; + extern int get_groups(s48_value ); + s48_value ret1; int r1; - cig_check_nargs(2, nargs, "get_groups"); - r1 = get_groups(args[1]); + + r1 = get_groups(g1); ret1 = errno_or_false(r1); - VECTOR_REF(*args,0) = ENTER_FIXNUM(r1); + S48_VECTOR_SET(mv_vec,0,s48_enter_fixnum(r1)); return ret1; - } +} -scheme_value df_getuid(long nargs, scheme_value *args) +s48_value df_getuid(void) { extern uid_t getuid(void); - scheme_value ret1; + s48_value ret1; uid_t r1; - cig_check_nargs(0, nargs, "getuid"); + r1 = getuid(); - ret1 = ENTER_FIXNUM(r1); + ret1 = s48_enter_fixnum(r1); return ret1; - } +} -scheme_value df_geteuid(long nargs, scheme_value *args) +s48_value df_geteuid(void) { extern uid_t geteuid(void); - scheme_value ret1; + s48_value ret1; uid_t r1; - cig_check_nargs(0, nargs, "geteuid"); + r1 = geteuid(); - ret1 = ENTER_FIXNUM(r1); + ret1 = s48_enter_fixnum(r1); return ret1; - } +} -scheme_value df_setuid(long nargs, scheme_value *args) +s48_value df_setuid(s48_value g1) { - scheme_value ret1; + s48_value ret1; int r1; - cig_check_nargs(1, nargs, "setuid"); - r1 = setuid(EXTRACT_FIXNUM(args[0])); + + r1 = setuid(s48_extract_fixnum(g1)); ret1 = errno_or_false(r1); return ret1; - } +} -scheme_value df_my_username(long nargs, scheme_value *args) +s48_value df_my_username(s48_value mv_vec) { extern char *my_username(void); - scheme_value ret1; + s48_value ret1; char *r1; - cig_check_nargs(1, nargs, "my_username"); + r1 = my_username(); - ret1 = VECTOR_REF(*args,0); - {AlienVal(CAR(ret1)) = (long) r1; CDR(ret1) = strlen_or_false(r1);} + ret1 = S48_VECTOR_REF(mv_vec,0); + S48_SET_CAR(ret1,(long) r1); S48_SET_CDR(ret1,strlen_or_false(r1)); return ret1; - } +} -scheme_value df_getpid(long nargs, scheme_value *args) +s48_value df_getpid(void) { extern pid_t getpid(void); - scheme_value ret1; + s48_value ret1; pid_t r1; - cig_check_nargs(0, nargs, "getpid"); + r1 = getpid(); - ret1 = ENTER_FIXNUM(r1); + ret1 = s48_enter_fixnum(r1); return ret1; - } +} -scheme_value df_getppid(long nargs, scheme_value *args) +s48_value df_getppid(void) { extern pid_t getppid(void); - scheme_value ret1; + s48_value ret1; pid_t r1; - cig_check_nargs(0, nargs, "getppid"); + r1 = getppid(); - ret1 = ENTER_FIXNUM(r1); + ret1 = s48_enter_fixnum(r1); return ret1; - } +} -scheme_value df_getpgrp(long nargs, scheme_value *args) +s48_value df_getpgrp(void) { extern pid_t getpgrp(void); - scheme_value ret1; + s48_value ret1; pid_t r1; - cig_check_nargs(0, nargs, "getpgrp"); + r1 = getpgrp(); - ret1 = ENTER_FIXNUM(r1); + ret1 = s48_enter_fixnum(r1); return ret1; - } +} -scheme_value df_setpgid(long nargs, scheme_value *args) +s48_value df_setpgid(s48_value g1, s48_value g2) { extern int setpgid(pid_t , pid_t ); - scheme_value ret1; + s48_value ret1; int r1; - cig_check_nargs(2, nargs, "setpgid"); - r1 = setpgid(EXTRACT_FIXNUM(args[1]), EXTRACT_FIXNUM(args[0])); + + r1 = setpgid(s48_extract_fixnum(g1), s48_extract_fixnum(g2)); ret1 = errno_or_false(r1); return ret1; - } +} -scheme_value df_setsid(long nargs, scheme_value *args) +s48_value df_setsid(s48_value mv_vec) { extern pid_t setsid(void); - scheme_value ret1; + s48_value ret1; pid_t r1; - cig_check_nargs(1, nargs, "setsid"); + r1 = setsid(); ret1 = errno_or_false(r1); - VECTOR_REF(*args,0) = ENTER_FIXNUM(r1); + S48_VECTOR_SET(mv_vec,0,s48_enter_fixnum(r1)); return ret1; - } +} -scheme_value df_umask(long nargs, scheme_value *args) +s48_value df_umask(s48_value g1) { - scheme_value ret1; + s48_value ret1; mode_t r1; - cig_check_nargs(1, nargs, "umask"); - r1 = umask(EXTRACT_FIXNUM(args[0])); - ret1 = ENTER_FIXNUM(r1); + + r1 = umask(s48_extract_fixnum(g1)); + ret1 = s48_enter_fixnum(r1); return ret1; - } +} -scheme_value df_process_times(long nargs, scheme_value *args) +s48_value df_process_times(s48_value mv_vec) { extern int process_times(int *, int *, int *, int *); - scheme_value ret1; + s48_value ret1; int r1; int r2; int r3; int r4; int r5; - cig_check_nargs(1, nargs, "process_times"); + r1 = process_times(&r2, &r3, &r4, &r5); ret1 = errno_or_false(r1); - VECTOR_REF(*args,0) = ENTER_FIXNUM(r2); - VECTOR_REF(*args,1) = ENTER_FIXNUM(r3); - VECTOR_REF(*args,2) = ENTER_FIXNUM(r4); - VECTOR_REF(*args,3) = ENTER_FIXNUM(r5); + S48_VECTOR_SET(mv_vec,0,s48_enter_fixnum(r2)); + S48_VECTOR_SET(mv_vec,1,s48_enter_fixnum(r3)); + S48_VECTOR_SET(mv_vec,2,s48_enter_fixnum(r4)); + S48_VECTOR_SET(mv_vec,3,s48_enter_fixnum(r5)); return ret1; - } +} -scheme_value df_cpu_clock_ticks_per_sec(long nargs, scheme_value *args) +s48_value df_cpu_clock_ticks_per_sec(void) { extern int cpu_clock_ticks_per_sec(void); - scheme_value ret1; + s48_value ret1; int r1; - cig_check_nargs(0, nargs, "cpu_clock_ticks_per_sec"); + r1 = cpu_clock_ticks_per_sec(); - ret1 = ENTER_FIXNUM(r1); + ret1 = s48_enter_fixnum(r1); return ret1; - } +} -scheme_value df_chmod(long nargs, scheme_value *args) +s48_value df_chmod(s48_value g1, s48_value g2) { - scheme_value ret1; + s48_value ret1; int r1; - cig_check_nargs(2, nargs, "chmod"); - r1 = chmod(cig_string_body(args[1]), EXTRACT_FIXNUM(args[0])); + + r1 = chmod(s48_extract_string(g1), s48_extract_fixnum(g2)); ret1 = errno_or_false(r1); return ret1; - } +} -scheme_value df_fchmod(long nargs, scheme_value *args) +s48_value df_fchmod(s48_value g1, s48_value g2) { - scheme_value ret1; + s48_value ret1; int r1; - cig_check_nargs(2, nargs, "fchmod"); - r1 = fchmod(EXTRACT_FIXNUM(args[1]), EXTRACT_FIXNUM(args[0])); + + r1 = fchmod(s48_extract_fixnum(g1), s48_extract_fixnum(g2)); ret1 = errno_or_false(r1); return ret1; - } +} -scheme_value df_chown(long nargs, scheme_value *args) +s48_value df_chown(s48_value g1, s48_value g2, s48_value g3) { - scheme_value ret1; + s48_value ret1; int r1; - cig_check_nargs(3, nargs, "chown"); - r1 = chown(cig_string_body(args[2]), EXTRACT_FIXNUM(args[1]), EXTRACT_FIXNUM(args[0])); + + r1 = chown(s48_extract_string(g1), s48_extract_fixnum(g2), s48_extract_fixnum(g3)); ret1 = errno_or_false(r1); return ret1; - } +} -scheme_value df_fchown(long nargs, scheme_value *args) +s48_value df_fchown(s48_value g1, s48_value g2, s48_value g3) { extern int fchown(int , uid_t , gid_t ); - scheme_value ret1; + s48_value ret1; int r1; - cig_check_nargs(3, nargs, "fchown"); - r1 = fchown(EXTRACT_FIXNUM(args[2]), EXTRACT_FIXNUM(args[1]), EXTRACT_FIXNUM(args[0])); + + r1 = fchown(s48_extract_fixnum(g1), s48_extract_fixnum(g2), s48_extract_fixnum(g3)); ret1 = errno_or_false(r1); return ret1; - } +} -scheme_value df_access(long nargs, scheme_value *args) +s48_value df_access(s48_value g1, s48_value g2) { extern int access(const char *, int ); - scheme_value ret1; + s48_value ret1; int r1; - cig_check_nargs(2, nargs, "access"); - r1 = access(cig_string_body(args[1]), EXTRACT_FIXNUM(args[0])); + + r1 = access(s48_extract_string(g1), s48_extract_fixnum(g2)); ret1 = ENTER_BOOLEAN(r1); return ret1; - } +} -scheme_value df_link(long nargs, scheme_value *args) +s48_value df_link(s48_value g1, s48_value g2) { extern int link(const char *, const char *); - scheme_value ret1; + s48_value ret1; int r1; - cig_check_nargs(2, nargs, "link"); - r1 = link(cig_string_body(args[1]), cig_string_body(args[0])); + + r1 = link(s48_extract_string(g1), s48_extract_string(g2)); ret1 = errno_or_false(r1); return ret1; - } +} -scheme_value df_mkfifo(long nargs, scheme_value *args) +s48_value df_mkfifo(s48_value g1, s48_value g2) { - scheme_value ret1; + s48_value ret1; int r1; - cig_check_nargs(2, nargs, "mkfifo"); - r1 = mkfifo(cig_string_body(args[1]), EXTRACT_FIXNUM(args[0])); + + r1 = mkfifo(s48_extract_string(g1), s48_extract_fixnum(g2)); ret1 = errno_or_false(r1); return ret1; - } +} -scheme_value df_mkdir(long nargs, scheme_value *args) +s48_value df_mkdir(s48_value g1, s48_value g2) { - scheme_value ret1; + s48_value ret1; int r1; - cig_check_nargs(2, nargs, "mkdir"); - r1 = mkdir(cig_string_body(args[1]), EXTRACT_FIXNUM(args[0])); + + r1 = mkdir(s48_extract_string(g1), s48_extract_fixnum(g2)); ret1 = errno_or_false(r1); return ret1; - } +} -scheme_value df_scm_readlink(long nargs, scheme_value *args) +s48_value df_scm_readlink(s48_value g1, s48_value mv_vec) { extern const char *scm_readlink(const char *); - scheme_value ret1; + s48_value ret1; const char *r1; - cig_check_nargs(2, nargs, "scm_readlink"); - r1 = scm_readlink(cig_string_body(args[1])); + + r1 = scm_readlink(s48_extract_string(g1)); ret1 = errno_on_zero_or_false(r1); - {AlienVal(CAR(VECTOR_REF(*args,0))) = (long) r1; CDR(VECTOR_REF(*args,0)) = strlen_or_false(r1);} + S48_SET_CAR(S48_VECTOR_REF(mv_vec,0),(long) r1); S48_SET_CDR(S48_VECTOR_REF(mv_vec,0),strlen_or_false(r1)); return ret1; - } +} -scheme_value df_rename(long nargs, scheme_value *args) +s48_value df_rename(s48_value g1, s48_value g2) { extern int rename(const char *, const char *); - scheme_value ret1; + s48_value ret1; int r1; - cig_check_nargs(2, nargs, "rename"); - r1 = rename(cig_string_body(args[1]), cig_string_body(args[0])); + + r1 = rename(s48_extract_string(g1), s48_extract_string(g2)); ret1 = errno_or_false(r1); return ret1; - } +} -scheme_value df_rmdir(long nargs, scheme_value *args) +s48_value df_rmdir(s48_value g1) { extern int rmdir(const char *); - scheme_value ret1; + s48_value ret1; int r1; - cig_check_nargs(1, nargs, "rmdir"); - r1 = rmdir(cig_string_body(args[0])); + + r1 = rmdir(s48_extract_string(g1)); ret1 = errno_or_false(r1); return ret1; - } +} -scheme_value df_scm_utime(long nargs, scheme_value *args) +s48_value df_scm_utime(s48_value g1, s48_value g2, s48_value g3, s48_value g4, s48_value g5) { extern int scm_utime(const char *, int , int , int , int ); - scheme_value ret1; + s48_value ret1; int r1; - cig_check_nargs(5, nargs, "scm_utime"); - r1 = scm_utime(cig_string_body(args[4]), EXTRACT_FIXNUM(args[3]), EXTRACT_FIXNUM(args[2]), EXTRACT_FIXNUM(args[1]), EXTRACT_FIXNUM(args[0])); + + r1 = scm_utime(s48_extract_string(g1), s48_extract_fixnum(g2), s48_extract_fixnum(g3), s48_extract_fixnum(g4), s48_extract_fixnum(g5)); ret1 = errno_or_false(r1); return ret1; - } +} -scheme_value df_scm_utime_now(long nargs, scheme_value *args) +s48_value df_scm_utime_now(s48_value g1) { extern int scm_utime_now(const char *); - scheme_value ret1; + s48_value ret1; int r1; - cig_check_nargs(1, nargs, "scm_utime_now"); - r1 = scm_utime_now(cig_string_body(args[0])); + + r1 = scm_utime_now(s48_extract_string(g1)); ret1 = errno_or_false(r1); return ret1; - } +} -scheme_value df_scheme_stat(long nargs, scheme_value *args) +s48_value df_scheme_stat(s48_value g1, s48_value g2, s48_value g3) { - extern int scheme_stat(const char *, scheme_value , int ); - scheme_value ret1; + extern int scheme_stat(const char *, s48_value , int ); + s48_value ret1; int r1; - cig_check_nargs(3, nargs, "scheme_stat"); - r1 = scheme_stat(cig_string_body(args[2]), args[1], EXTRACT_BOOLEAN(args[0])); + + r1 = scheme_stat(s48_extract_string(g1), g2, EXTRACT_BOOLEAN(g3)); ret1 = False_on_zero(r1); return ret1; - } +} -scheme_value df_scheme_fstat(long nargs, scheme_value *args) +s48_value df_scheme_fstat(s48_value g1, s48_value g2) { - extern int scheme_fstat(int , scheme_value ); - scheme_value ret1; + extern int scheme_fstat(int , s48_value ); + s48_value ret1; int r1; - cig_check_nargs(2, nargs, "scheme_fstat"); - r1 = scheme_fstat(EXTRACT_FIXNUM(args[1]), args[0]); + + r1 = scheme_fstat(s48_extract_fixnum(g1), g2); ret1 = False_on_zero(r1); return ret1; - } +} -scheme_value df_symlink(long nargs, scheme_value *args) +s48_value df_symlink(s48_value g1, s48_value g2) { - scheme_value ret1; + s48_value ret1; int r1; - cig_check_nargs(2, nargs, "symlink"); - r1 = symlink(cig_string_body(args[1]), cig_string_body(args[0])); + + r1 = symlink(s48_extract_string(g1), s48_extract_string(g2)); ret1 = errno_or_false(r1); return ret1; - } +} -scheme_value df_truncate(long nargs, scheme_value *args) +s48_value df_truncate(s48_value g1, s48_value g2) { - scheme_value ret1; + s48_value ret1; int r1; - cig_check_nargs(2, nargs, "truncate"); - r1 = truncate(cig_string_body(args[1]), EXTRACT_FIXNUM(args[0])); + + r1 = truncate(s48_extract_string(g1), s48_extract_fixnum(g2)); ret1 = errno_or_false(r1); return ret1; - } +} -scheme_value df_ftruncate(long nargs, scheme_value *args) +s48_value df_ftruncate(s48_value g1, s48_value g2) { - scheme_value ret1; + s48_value ret1; int r1; - cig_check_nargs(2, nargs, "ftruncate"); - r1 = ftruncate(EXTRACT_FIXNUM(args[1]), EXTRACT_FIXNUM(args[0])); + + r1 = ftruncate(s48_extract_fixnum(g1), s48_extract_fixnum(g2)); ret1 = errno_or_false(r1); return ret1; - } +} -scheme_value df_unlink(long nargs, scheme_value *args) +s48_value df_unlink(s48_value g1) { extern int unlink(const char *); - scheme_value ret1; + s48_value ret1; int r1; - cig_check_nargs(1, nargs, "unlink"); - r1 = unlink(cig_string_body(args[0])); + + r1 = unlink(s48_extract_string(g1)); ret1 = errno_or_false(r1); return ret1; - } +} -scheme_value df_fsync(long nargs, scheme_value *args) +s48_value df_fsync(s48_value g1) { extern int fsync(int ); - scheme_value ret1; + s48_value ret1; int r1; - cig_check_nargs(1, nargs, "fsync"); - r1 = fsync(EXTRACT_FIXNUM(args[0])); + + r1 = fsync(s48_extract_fixnum(g1)); ret1 = errno_or_false(r1); return ret1; - } +} -scheme_value df_sync(long nargs, scheme_value *args) +s48_value df_sync(void) { - cig_check_nargs(0, nargs, "sync"); + sync(); - return SCHFALSE; - } + return S48_FALSE; +} -scheme_value df_close(long nargs, scheme_value *args) +s48_value df_close(s48_value g1) { extern int close(int ); - scheme_value ret1; + s48_value ret1; int r1; - cig_check_nargs(1, nargs, "close"); - r1 = close(EXTRACT_FIXNUM(args[0])); + + r1 = close(s48_extract_fixnum(g1)); ret1 = errno_or_false(r1); return ret1; - } +} -scheme_value df_dup(long nargs, scheme_value *args) +s48_value df_dup(s48_value g1, s48_value mv_vec) { extern int dup(int ); - scheme_value ret1; + s48_value ret1; int r1; - cig_check_nargs(2, nargs, "dup"); - r1 = dup(EXTRACT_FIXNUM(args[1])); + + r1 = dup(s48_extract_fixnum(g1)); ret1 = errno_or_false(r1); - VECTOR_REF(*args,0) = ENTER_FIXNUM(r1); + S48_VECTOR_SET(mv_vec,0,s48_enter_fixnum(r1)); return ret1; - } +} -scheme_value df_dup2(long nargs, scheme_value *args) +s48_value df_dup2(s48_value g1, s48_value g2, s48_value mv_vec) { extern int dup2(int , int ); - scheme_value ret1; + s48_value ret1; int r1; - cig_check_nargs(3, nargs, "dup2"); - r1 = dup2(EXTRACT_FIXNUM(args[2]), EXTRACT_FIXNUM(args[1])); + + r1 = dup2(s48_extract_fixnum(g1), s48_extract_fixnum(g2)); ret1 = errno_or_false(r1); - VECTOR_REF(*args,0) = ENTER_FIXNUM(r1); + S48_VECTOR_SET(mv_vec,0,s48_enter_fixnum(r1)); return ret1; - } +} -scheme_value df_lseek(long nargs, scheme_value *args) +s48_value df_lseek(s48_value g1, s48_value g2, s48_value g3, s48_value mv_vec) { extern off_t lseek(int , off_t , int ); - scheme_value ret1; + s48_value ret1; off_t r1; - cig_check_nargs(4, nargs, "lseek"); - r1 = lseek(EXTRACT_FIXNUM(args[3]), EXTRACT_FIXNUM(args[2]), EXTRACT_FIXNUM(args[1])); + + r1 = lseek(s48_extract_fixnum(g1), s48_extract_fixnum(g2), s48_extract_fixnum(g3)); ret1 = errno_or_false(r1); - VECTOR_REF(*args,0) = ENTER_FIXNUM(r1); + S48_VECTOR_SET(mv_vec,0,s48_enter_fixnum(r1)); return ret1; - } +} -scheme_value df_char_ready_fdes(long nargs, scheme_value *args) +s48_value df_char_ready_fdes(s48_value g1) { - extern scheme_value char_ready_fdes(int ); - scheme_value ret1; - scheme_value r1; + extern s48_value char_ready_fdes(int ); + s48_value ret1; + s48_value r1; - cig_check_nargs(1, nargs, "char_ready_fdes"); - r1 = char_ready_fdes(EXTRACT_FIXNUM(args[0])); + + r1 = char_ready_fdes(s48_extract_fixnum(g1)); ret1 = r1; return ret1; - } +} -scheme_value df_open(long nargs, scheme_value *args) +s48_value df_open(s48_value g1, s48_value g2, s48_value g3, s48_value mv_vec) { - scheme_value ret1; + s48_value ret1; int r1; - cig_check_nargs(4, nargs, "open"); - r1 = open(cig_string_body(args[3]), EXTRACT_FIXNUM(args[2]), EXTRACT_FIXNUM(args[1])); + + r1 = open(s48_extract_string(g1), s48_extract_fixnum(g2), s48_extract_fixnum(g3)); ret1 = errno_or_false(r1); - VECTOR_REF(*args,0) = ENTER_FIXNUM(r1); + S48_VECTOR_SET(mv_vec,0,s48_enter_fixnum(r1)); return ret1; - } +} -scheme_value df_scheme_pipe(long nargs, scheme_value *args) +s48_value df_scheme_pipe(s48_value mv_vec) { extern int scheme_pipe(int *, int *); - scheme_value ret1; + s48_value ret1; int r1; int r2; int r3; - cig_check_nargs(1, nargs, "scheme_pipe"); + r1 = scheme_pipe(&r2, &r3); ret1 = False_on_zero(r1); - VECTOR_REF(*args,0) = ENTER_FIXNUM(r2); - VECTOR_REF(*args,1) = ENTER_FIXNUM(r3); + S48_VECTOR_SET(mv_vec,0,s48_enter_fixnum(r2)); + S48_VECTOR_SET(mv_vec,1,s48_enter_fixnum(r3)); return ret1; - } +} -scheme_value df_read_fdes_char(long nargs, scheme_value *args) +s48_value df_read_fdes_char(s48_value g1) { - extern scheme_value read_fdes_char(int ); - scheme_value ret1; - scheme_value r1; + extern s48_value read_fdes_char(int ); + s48_value ret1; + s48_value r1; - cig_check_nargs(1, nargs, "read_fdes_char"); - r1 = read_fdes_char(EXTRACT_FIXNUM(args[0])); + + r1 = read_fdes_char(s48_extract_fixnum(g1)); ret1 = r1; return ret1; - } +} -scheme_value df_write_fdes_char(long nargs, scheme_value *args) +s48_value df_write_fdes_char(s48_value g1, s48_value g2) { extern int write_fdes_char(char , int ); - scheme_value ret1; + s48_value ret1; int r1; - cig_check_nargs(2, nargs, "write_fdes_char"); - r1 = write_fdes_char(EXTRACT_CHAR(args[1]), EXTRACT_FIXNUM(args[0])); + + r1 = write_fdes_char(s48_extract_char(g1), s48_extract_fixnum(g2)); ret1 = errno_or_false(r1); return ret1; - } +} -scheme_value df_read_fdes_substring(long nargs, scheme_value *args) +s48_value df_read_fdes_substring(s48_value g1, s48_value g2, s48_value g3, s48_value g4, s48_value mv_vec) { - extern int read_fdes_substring(scheme_value , int , int , int ); - scheme_value ret1; + extern int read_fdes_substring(s48_value , int , int , int ); + s48_value ret1; int r1; - cig_check_nargs(5, nargs, "read_fdes_substring"); - r1 = read_fdes_substring(args[4], EXTRACT_FIXNUM(args[3]), EXTRACT_FIXNUM(args[2]), EXTRACT_FIXNUM(args[1])); + + r1 = read_fdes_substring(g1, s48_extract_fixnum(g2), s48_extract_fixnum(g3), s48_extract_fixnum(g4)); ret1 = errno_or_false(r1); - VECTOR_REF(*args,0) = ENTER_FIXNUM(r1); + S48_VECTOR_SET(mv_vec,0,s48_enter_fixnum(r1)); return ret1; - } +} -scheme_value df_write_fdes_substring(long nargs, scheme_value *args) +s48_value df_write_fdes_substring(s48_value g1, s48_value g2, s48_value g3, s48_value g4, s48_value mv_vec) { - extern int write_fdes_substring(scheme_value , int , int , int ); - scheme_value ret1; + extern int write_fdes_substring(s48_value , int , int , int ); + s48_value ret1; int r1; - cig_check_nargs(5, nargs, "write_fdes_substring"); - r1 = write_fdes_substring(args[4], EXTRACT_FIXNUM(args[3]), EXTRACT_FIXNUM(args[2]), EXTRACT_FIXNUM(args[1])); + + r1 = write_fdes_substring(g1, s48_extract_fixnum(g2), s48_extract_fixnum(g3), s48_extract_fixnum(g4)); ret1 = errno_or_false(r1); - VECTOR_REF(*args,0) = ENTER_FIXNUM(r1); + S48_VECTOR_SET(mv_vec,0,s48_enter_fixnum(r1)); return ret1; - } +} -scheme_value df_kill(long nargs, scheme_value *args) +s48_value df_kill(s48_value g1, s48_value g2) { extern int kill(pid_t , int ); - scheme_value ret1; + s48_value ret1; int r1; - cig_check_nargs(2, nargs, "kill"); - r1 = kill(EXTRACT_FIXNUM(args[1]), EXTRACT_FIXNUM(args[0])); + + r1 = kill(s48_extract_fixnum(g1), s48_extract_fixnum(g2)); ret1 = errno_or_false(r1); return ret1; - } +} -scheme_value df_pause(long nargs, scheme_value *args) +s48_value df_pause(void) { - cig_check_nargs(0, nargs, "pause"); + pause(); - return SCHFALSE; - } + return S48_FALSE; +} -scheme_value df_alarm(long nargs, scheme_value *args) +s48_value df_alarm(s48_value g1) { extern unsigned int alarm(unsigned int ); - scheme_value ret1; + s48_value ret1; unsigned int r1; - cig_check_nargs(1, nargs, "alarm"); - r1 = alarm(EXTRACT_FIXNUM(args[0])); - ret1 = ENTER_FIXNUM(r1); + + r1 = alarm(s48_extract_fixnum(g1)); + ret1 = s48_enter_fixnum(r1); return ret1; - } +} -scheme_value df_user_info_uid(long nargs, scheme_value *args) +s48_value df_user_info_uid(s48_value g1, s48_value mv_vec) { extern int user_info_uid(uid_t , char **, gid_t *, char **, char **); - scheme_value ret1; + s48_value ret1; int r1; char *r2; gid_t r3; char *r4; char *r5; - cig_check_nargs(2, nargs, "user_info_uid"); - r1 = user_info_uid(EXTRACT_FIXNUM(args[1]), &r2, &r3, &r4, &r5); + + r1 = user_info_uid(s48_extract_fixnum(g1), &r2, &r3, &r4, &r5); ret1 = ENTER_BOOLEAN(r1); - {AlienVal(CAR(VECTOR_REF(*args,0))) = (long) r2; CDR(VECTOR_REF(*args,0)) = strlen_or_false(r2);} - VECTOR_REF(*args,1) = ENTER_FIXNUM(r3); - {AlienVal(CAR(VECTOR_REF(*args,2))) = (long) r4; CDR(VECTOR_REF(*args,2)) = strlen_or_false(r4);} - {AlienVal(CAR(VECTOR_REF(*args,3))) = (long) r5; CDR(VECTOR_REF(*args,3)) = strlen_or_false(r5);} + S48_SET_CAR(S48_VECTOR_REF(mv_vec,0),(long) r2); S48_SET_CDR(S48_VECTOR_REF(mv_vec,0),strlen_or_false(r2)); + S48_VECTOR_SET(mv_vec,1,s48_enter_fixnum(r3)); + S48_SET_CAR(S48_VECTOR_REF(mv_vec,2),(long) r4); S48_SET_CDR(S48_VECTOR_REF(mv_vec,2),strlen_or_false(r4)); + S48_SET_CAR(S48_VECTOR_REF(mv_vec,3),(long) r5); S48_SET_CDR(S48_VECTOR_REF(mv_vec,3),strlen_or_false(r5)); return ret1; - } +} -scheme_value df_user_info_name(long nargs, scheme_value *args) +s48_value df_user_info_name(s48_value g1, s48_value mv_vec) { extern int user_info_name(const char *, uid_t *, gid_t *, char **, char **); - scheme_value ret1; + s48_value ret1; int r1; uid_t r2; gid_t r3; char *r4; char *r5; - cig_check_nargs(2, nargs, "user_info_name"); - r1 = user_info_name(cig_string_body(args[1]), &r2, &r3, &r4, &r5); + + r1 = user_info_name(s48_extract_string(g1), &r2, &r3, &r4, &r5); ret1 = ENTER_BOOLEAN(r1); - VECTOR_REF(*args,0) = ENTER_FIXNUM(r2); - VECTOR_REF(*args,1) = ENTER_FIXNUM(r3); - {AlienVal(CAR(VECTOR_REF(*args,2))) = (long) r4; CDR(VECTOR_REF(*args,2)) = strlen_or_false(r4);} - {AlienVal(CAR(VECTOR_REF(*args,3))) = (long) r5; CDR(VECTOR_REF(*args,3)) = strlen_or_false(r5);} + S48_VECTOR_SET(mv_vec,0,s48_enter_fixnum(r2)); + S48_VECTOR_SET(mv_vec,1,s48_enter_fixnum(r3)); + S48_SET_CAR(S48_VECTOR_REF(mv_vec,2),(long) r4); S48_SET_CDR(S48_VECTOR_REF(mv_vec,2),strlen_or_false(r4)); + S48_SET_CAR(S48_VECTOR_REF(mv_vec,3),(long) r5); S48_SET_CDR(S48_VECTOR_REF(mv_vec,3),strlen_or_false(r5)); return ret1; - } +} -scheme_value df_group_info_gid(long nargs, scheme_value *args) +s48_value df_group_info_gid(s48_value g1, s48_value mv_vec) { extern int group_info_gid(int , char **, char** *, int *); - scheme_value ret1; + s48_value ret1; int r1; char *r2; char** r3; int r4; - cig_check_nargs(2, nargs, "group_info_gid"); - r1 = group_info_gid(EXTRACT_FIXNUM(args[1]), &r2, &r3, &r4); + + r1 = group_info_gid(s48_extract_fixnum(g1), &r2, &r3, &r4); ret1 = ENTER_BOOLEAN(r1); - {AlienVal(CAR(VECTOR_REF(*args,0))) = (long) r2; CDR(VECTOR_REF(*args,0)) = strlen_or_false(r2);} - AlienVal(VECTOR_REF(*args,1)) = (long) r3; - VECTOR_REF(*args,2) = ENTER_FIXNUM(r4); + S48_SET_CAR(S48_VECTOR_REF(mv_vec,0),(long) r2); S48_SET_CDR(S48_VECTOR_REF(mv_vec,0),strlen_or_false(r2)); + S48_SET_CAR(S48_VECTOR_REF(mv_vec,1),(long) r3); + S48_VECTOR_SET(mv_vec,2,s48_enter_fixnum(r4)); return ret1; - } +} -scheme_value df_group_info_name(long nargs, scheme_value *args) +s48_value df_group_info_name(s48_value g1, s48_value mv_vec) { extern int group_info_name(const char *, int *, char** *, int *); - scheme_value ret1; + s48_value ret1; int r1; int r2; char** r3; int r4; - cig_check_nargs(2, nargs, "group_info_name"); - r1 = group_info_name(cig_string_body(args[1]), &r2, &r3, &r4); + + r1 = group_info_name(s48_extract_string(g1), &r2, &r3, &r4); ret1 = ENTER_BOOLEAN(r1); - VECTOR_REF(*args,0) = ENTER_FIXNUM(r2); - AlienVal(VECTOR_REF(*args,1)) = (long) r3; - VECTOR_REF(*args,2) = ENTER_FIXNUM(r4); + S48_VECTOR_SET(mv_vec,0,s48_enter_fixnum(r2)); + S48_SET_CAR(S48_VECTOR_REF(mv_vec,1),(long) r3); + S48_VECTOR_SET(mv_vec,2,s48_enter_fixnum(r4)); return ret1; - } +} -scheme_value df_open_dir(long nargs, scheme_value *args) +s48_value df_open_dir(s48_value g1, s48_value mv_vec) { extern int open_dir(const char *, char** *, int *); - scheme_value ret1; + s48_value ret1; int r1; char** r2; int r3; - cig_check_nargs(2, nargs, "open_dir"); - r1 = open_dir(cig_string_body(args[1]), &r2, &r3); + + r1 = open_dir(s48_extract_string(g1), &r2, &r3); ret1 = False_on_zero(r1); - AlienVal(VECTOR_REF(*args,0)) = (long) r2; - VECTOR_REF(*args,1) = ENTER_FIXNUM(r3); + S48_SET_CAR(S48_VECTOR_REF(mv_vec,0),(long) r2); + S48_VECTOR_SET(mv_vec,1,s48_enter_fixnum(r3)); return ret1; - } +} -scheme_value df_scm_sort_filevec(long nargs, scheme_value *args) +s48_value df_scm_sort_filevec(s48_value g1, s48_value g2) { extern void scm_sort_filevec(const char** , int ); - cig_check_nargs(2, nargs, "scm_sort_filevec"); - scm_sort_filevec((const char** )AlienVal(args[1]), EXTRACT_FIXNUM(args[0])); - return SCHFALSE; - } + + scm_sort_filevec((const char** )AlienVal(g1), s48_extract_fixnum(g2)); + return S48_FALSE; +} -scheme_value df_filter_stringvec(long nargs, scheme_value *args) -{ - extern char *filter_stringvec(const char *, char const ** , int *); - scheme_value ret1; - char *r1; - int r2; - - cig_check_nargs(3, nargs, "filter_stringvec"); - r1 = filter_stringvec(cig_string_body(args[2]), (char const ** )AlienVal(args[1]), &r2); - ret1 = VECTOR_REF(*args,0); - {AlienVal(CAR(ret1)) = (long) r1; CDR(ret1) = strlen_or_false(r1);} - VECTOR_REF(*args,1) = ENTER_FIXNUM(r2); - return ret1; - } - -scheme_value df_scm_envvec(long nargs, scheme_value *args) +s48_value df_scm_envvec(s48_value mv_vec) { extern char** scm_envvec(int *); - scheme_value ret1; + s48_value ret1; char** r1; int r2; - cig_check_nargs(1, nargs, "scm_envvec"); + r1 = scm_envvec(&r2); - ret1 = VECTOR_REF(*args,0); - AlienVal(ret1) = (long) r1; - VECTOR_REF(*args,1) = ENTER_FIXNUM(r2); + ret1 = S48_VECTOR_REF(mv_vec,0); + S48_SET_CAR(ret1,(long) r1); + S48_VECTOR_SET(mv_vec,1,s48_enter_fixnum(r2)); return ret1; - } +} -scheme_value df_install_env(long nargs, scheme_value *args) +s48_value df_install_env(s48_value g1) { - extern int install_env(scheme_value ); - scheme_value ret1; + extern int install_env(s48_value ); + s48_value ret1; int r1; - cig_check_nargs(1, nargs, "install_env"); - r1 = install_env(args[0]); + + r1 = install_env(g1); ret1 = errno_or_false(r1); return ret1; - } +} -scheme_value df_getenv(long nargs, scheme_value *args) +s48_value df_getenv(s48_value g1, s48_value mv_vec) { extern char *getenv(const char *); - scheme_value ret1; + s48_value ret1; char *r1; - cig_check_nargs(2, nargs, "getenv"); - r1 = getenv(cig_string_body(args[1])); - ret1 = VECTOR_REF(*args,0); - {AlienVal(CAR(ret1)) = (long) r1; CDR(ret1) = strlen_or_false(r1);} + + r1 = getenv(s48_extract_string(g1)); + ret1 = S48_VECTOR_REF(mv_vec,0); + S48_SET_CAR(ret1,(long) r1); S48_SET_CDR(ret1,strlen_or_false(r1)); return ret1; - } +} -#define errno_on_nonzero_or_false(x) ((x) ? ENTER_FIXNUM(errno) : SCHFALSE) +#define errno_on_nonzero_or_false(x) ((x) ? s48_enter_fixnum(errno) : S48_FALSE) -scheme_value df_putenv(long nargs, scheme_value *args) +s48_value df_putenv(s48_value g1) { - scheme_value ret1; + s48_value ret1; int r1; - cig_check_nargs(1, nargs, "putenv"); - r1 = putenv(scheme2c_strcpy(args[0])); + + r1 = putenv(scheme2c_strcpy(g1)); ret1 = errno_on_nonzero_or_false(r1); return ret1; - } +} -scheme_value df_delete_env(long nargs, scheme_value *args) +s48_value df_delete_env(s48_value g1) { extern void delete_env(const char *); - cig_check_nargs(1, nargs, "delete_env"); - delete_env(cig_string_body(args[0])); - return SCHFALSE; - } + + delete_env(s48_extract_string(g1)); + return S48_FALSE; +} -scheme_value df_set_cloexec(long nargs, scheme_value *args) +s48_value df_set_cloexec(s48_value g1, s48_value g2) { extern int set_cloexec(int , int ); - scheme_value ret1; + s48_value ret1; int r1; - cig_check_nargs(2, nargs, "set_cloexec"); - r1 = set_cloexec(EXTRACT_FIXNUM(args[1]), EXTRACT_BOOLEAN(args[0])); + + r1 = set_cloexec(s48_extract_fixnum(g1), EXTRACT_BOOLEAN(g2)); ret1 = errno_or_false(r1); return ret1; - } +} -scheme_value df_fcntl_read(long nargs, scheme_value *args) +s48_value df_fcntl_read(s48_value g1, s48_value g2, s48_value mv_vec) { extern int fcntl_read(int , int ); - scheme_value ret1; + s48_value ret1; int r1; - cig_check_nargs(3, nargs, "fcntl_read"); - r1 = fcntl_read(EXTRACT_FIXNUM(args[2]), EXTRACT_FIXNUM(args[1])); + + r1 = fcntl_read(s48_extract_fixnum(g1), s48_extract_fixnum(g2)); ret1 = errno_or_false(r1); - VECTOR_REF(*args,0) = ENTER_FIXNUM(r1); + S48_VECTOR_SET(mv_vec,0,s48_enter_fixnum(r1)); return ret1; - } +} -scheme_value df_fcntl_write(long nargs, scheme_value *args) +s48_value df_fcntl_write(s48_value g1, s48_value g2, s48_value g3) { extern int fcntl_write(int , int , int ); - scheme_value ret1; + s48_value ret1; int r1; - cig_check_nargs(3, nargs, "fcntl_write"); - r1 = fcntl_write(EXTRACT_FIXNUM(args[2]), EXTRACT_FIXNUM(args[1]), EXTRACT_FIXNUM(args[0])); + + r1 = fcntl_write(s48_extract_fixnum(g1), s48_extract_fixnum(g2), s48_extract_fixnum(g3)); ret1 = errno_or_false(r1); return ret1; - } +} -scheme_value df_sleep_until(long nargs, scheme_value *args) +s48_value df_sleep_until(s48_value g1, s48_value g2) { - extern scheme_value sleep_until(int , int ); - scheme_value ret1; - scheme_value r1; + extern s48_value sleep_until(int , int ); + s48_value ret1; + s48_value r1; - cig_check_nargs(2, nargs, "sleep_until"); - r1 = sleep_until(EXTRACT_FIXNUM(args[1]), EXTRACT_FIXNUM(args[0])); + + r1 = sleep_until(s48_extract_fixnum(g1), s48_extract_fixnum(g2)); ret1 = r1; return ret1; - } +} -scheme_value df_scm_gethostname(long nargs, scheme_value *args) +s48_value df_scm_gethostname(s48_value mv_vec) { extern char *scm_gethostname(void); - scheme_value ret1; + s48_value ret1; char *r1; - cig_check_nargs(1, nargs, "scm_gethostname"); + r1 = scm_gethostname(); - ret1 = VECTOR_REF(*args,0); - {AlienVal(CAR(ret1)) = (long) r1; CDR(ret1) = strlen_or_false(r1);} + ret1 = S48_VECTOR_REF(mv_vec,0); + S48_SET_CAR(ret1,(long) r1); S48_SET_CDR(ret1,strlen_or_false(r1)); return ret1; - } +} -scheme_value df_errno_msg(long nargs, scheme_value *args) +s48_value df_errno_msg(s48_value g1, s48_value mv_vec) { extern char *errno_msg(int ); - scheme_value ret1; + s48_value ret1; char *r1; - cig_check_nargs(2, nargs, "errno_msg"); - r1 = errno_msg(EXTRACT_FIXNUM(args[1])); - ret1 = VECTOR_REF(*args,0); - {AlienVal(CAR(ret1)) = (long) r1; CDR(ret1) = strlen_or_false(r1);} + + r1 = errno_msg(s48_extract_fixnum(g1)); + ret1 = S48_VECTOR_REF(mv_vec,0); + S48_SET_CAR(ret1,(long) r1); S48_SET_CDR(ret1,strlen_or_false(r1)); return ret1; - } +} +s48_value s48_init_syscalls(void) +{ + S48_EXPORT_FUNCTION(df_scheme_exec); + S48_EXPORT_FUNCTION(df_exit); + S48_EXPORT_FUNCTION(df__exit); + S48_EXPORT_FUNCTION(df_fork); + S48_EXPORT_FUNCTION(df_wait_pid); + S48_EXPORT_FUNCTION(df_chdir); + S48_EXPORT_FUNCTION(df_scheme_cwd); + S48_EXPORT_FUNCTION(df_getgid); + S48_EXPORT_FUNCTION(df_getegid); + S48_EXPORT_FUNCTION(df_setgid); + S48_EXPORT_FUNCTION(df_num_supp_groups); + S48_EXPORT_FUNCTION(df_get_groups); + S48_EXPORT_FUNCTION(df_getuid); + S48_EXPORT_FUNCTION(df_geteuid); + S48_EXPORT_FUNCTION(df_setuid); + S48_EXPORT_FUNCTION(df_my_username); + S48_EXPORT_FUNCTION(df_getpid); + S48_EXPORT_FUNCTION(df_getppid); + S48_EXPORT_FUNCTION(df_getpgrp); + S48_EXPORT_FUNCTION(df_setpgid); + S48_EXPORT_FUNCTION(df_setsid); + S48_EXPORT_FUNCTION(df_umask); + S48_EXPORT_FUNCTION(df_process_times); + S48_EXPORT_FUNCTION(df_cpu_clock_ticks_per_sec); + S48_EXPORT_FUNCTION(df_chmod); + S48_EXPORT_FUNCTION(df_fchmod); + S48_EXPORT_FUNCTION(df_chown); + S48_EXPORT_FUNCTION(df_fchown); + S48_EXPORT_FUNCTION(df_access); + S48_EXPORT_FUNCTION(df_link); + S48_EXPORT_FUNCTION(df_mkfifo); + S48_EXPORT_FUNCTION(df_mkdir); + S48_EXPORT_FUNCTION(df_scm_readlink); + S48_EXPORT_FUNCTION(df_rename); + S48_EXPORT_FUNCTION(df_rmdir); + S48_EXPORT_FUNCTION(df_scm_utime); + S48_EXPORT_FUNCTION(df_scm_utime_now); + S48_EXPORT_FUNCTION(df_scheme_stat); + S48_EXPORT_FUNCTION(df_scheme_fstat); + S48_EXPORT_FUNCTION(df_symlink); + S48_EXPORT_FUNCTION(df_truncate); + S48_EXPORT_FUNCTION(df_ftruncate); + S48_EXPORT_FUNCTION(df_unlink); + S48_EXPORT_FUNCTION(df_fsync); + S48_EXPORT_FUNCTION(df_sync); + S48_EXPORT_FUNCTION(df_close); + S48_EXPORT_FUNCTION(df_dup); + S48_EXPORT_FUNCTION(df_dup2); + S48_EXPORT_FUNCTION(df_lseek); + S48_EXPORT_FUNCTION(df_char_ready_fdes); + S48_EXPORT_FUNCTION(df_open); + S48_EXPORT_FUNCTION(df_scheme_pipe); + S48_EXPORT_FUNCTION(df_read_fdes_char); + S48_EXPORT_FUNCTION(df_write_fdes_char); + S48_EXPORT_FUNCTION(df_read_fdes_substring); + S48_EXPORT_FUNCTION(df_write_fdes_substring); + S48_EXPORT_FUNCTION(df_kill); + S48_EXPORT_FUNCTION(df_pause); + S48_EXPORT_FUNCTION(df_alarm); + S48_EXPORT_FUNCTION(df_user_info_uid); + S48_EXPORT_FUNCTION(df_user_info_name); + S48_EXPORT_FUNCTION(df_group_info_gid); + S48_EXPORT_FUNCTION(df_group_info_name); + S48_EXPORT_FUNCTION(df_open_dir); + S48_EXPORT_FUNCTION(df_scm_sort_filevec); + S48_EXPORT_FUNCTION(df_scm_envvec); + S48_EXPORT_FUNCTION(df_install_env); + S48_EXPORT_FUNCTION(df_getenv); + S48_EXPORT_FUNCTION(df_putenv); + S48_EXPORT_FUNCTION(df_delete_env); + S48_EXPORT_FUNCTION(df_set_cloexec); + S48_EXPORT_FUNCTION(df_fcntl_read); + S48_EXPORT_FUNCTION(df_fcntl_write); + S48_EXPORT_FUNCTION(df_sleep_until); + S48_EXPORT_FUNCTION(df_scm_gethostname); + S48_EXPORT_FUNCTION(df_errno_msg); + + return S48_UNSPECIFIC; +} diff --git a/scsh/syscalls.scm b/scsh/syscalls.scm index 53504b1..9612321 100644 --- a/scsh/syscalls.scm +++ b/scsh/syscalls.scm @@ -18,16 +18,16 @@ "" "/* Make sure foreign-function stubs interface to the C funs correctly: */" "#include \"dirstuff1.h\"" - "#include \"fdports1.h\"" +; "#include \"fdports1.h\"" JMG "#include \"select1.h\"" "#include \"syscalls1.h\"" "#include \"userinfo1.h\"" "" "extern int errno;" "" - "#define errno_on_zero_or_false(x) ((x) ? SCHFALSE : ENTER_FIXNUM(errno))" - "#define errno_or_false(x) (((x) == -1) ? ENTER_FIXNUM(errno) : SCHFALSE)" - "#define False_on_zero(x) ((x) ? ENTER_FIXNUM(x) : SCHFALSE)" ; Not a function. + "#define errno_on_zero_or_false(x) ((x) ? S48_FALSE : s48_enter_fixnum(errno))" + "#define errno_or_false(x) (((x) == -1) ? s48_enter_fixnum(errno) : S48_FALSE)" + "#define False_on_zero(x) ((x) ? s48_enter_fixnum(x) : S48_FALSE)" ; Not a function. "" "") ;;; Macro for converting syscalls that return error codes to ones that @@ -845,24 +845,28 @@ ;;; I do this one in C, I'm not sure why: ;;; It is used by MATCH-FILES. +;;; 99/7: No one is using this function, so I'm commenting it out. +;;; Later, we could tune up the globber or regexp file-matcher to use +;;; it (but should shift it into the rx directory). But I should also go +;;; to a file-at-a-time cursor model for directory fetching. -Olin -(define-foreign %filter-C-strings! - (filter_stringvec (string pattern) ((C "char const ** ~a") cvec)) - static-string ; error message -- #f if no error. - integer) ; number of files that pass the filter. +;(define-foreign %filter-C-strings! +; (filter_stringvec (string pattern) ((C "char const ** ~a") cvec)) +; static-string ; error message -- #f if no error. +; integer) ; number of files that pass the filter. -(define (match-files regexp . maybe-dir) - (let ((dir (:optional maybe-dir "."))) - (check-arg string? dir match-files) - (receive (err cvec numfiles) - (%open-dir (ensure-file-name-is-nondirectory dir)) - (if err (errno-error err match-files regexp dir)) - (receive (err numfiles) (%filter-C-strings! regexp cvec) - (if err (error err match-files)) - (%sort-file-vector cvec numfiles) - (let ((files (C-string-vec->Scheme&free cvec numfiles))) - (vector->list files)))))) +;(define (match-files regexp . maybe-dir) +; (let ((dir (:optional maybe-dir "."))) +; (check-arg string? dir match-files) +; (receive (err cvec numfiles) +; (%open-dir (ensure-file-name-is-nondirectory dir)) +; (if err (errno-error err match-files regexp dir)) +; (receive (err numfiles) (%filter-C-strings! regexp cvec) +; (if err (error err match-files)) +; (%sort-file-vector cvec numfiles) +; (let ((files (C-string-vec->Scheme&free cvec numfiles))) +; (vector->list files)))))) ;;; Environment manipulation @@ -916,7 +920,7 @@ static-string) (foreign-source - "#define errno_on_nonzero_or_false(x) ((x) ? ENTER_FIXNUM(errno) : SCHFALSE)" + "#define errno_on_nonzero_or_false(x) ((x) ? s48_enter_fixnum(errno) : S48_FALSE)" "" "") ;(define-foreign putenv/errno diff --git a/scsh/syscalls1.c b/scsh/syscalls1.c index f587fc2..8d47a58 100644 --- a/scsh/syscalls1.c +++ b/scsh/syscalls1.c @@ -54,10 +54,10 @@ extern char **environ; /* Args: pid, flags; returns [retval, status] */ -scheme_value wait_pid(int pid, int flags, int *result_pid, int *status) +s48_value wait_pid(int pid, int flags, int *result_pid, int *status) { *result_pid = waitpid(pid, status, flags); - return (*result_pid == -1) ? ENTER_FIXNUM(errno) : SCHFALSE; + return (*result_pid == -1) ? s48_enter_fixnum(errno) : S48_FALSE; } @@ -69,10 +69,10 @@ scheme_value wait_pid(int pid, int flags, int *result_pid, int *status) ** on the Scheme side. */ -int scheme_exec(const char *prog, scheme_value argv, scheme_value env) +int scheme_exec(const char *prog, s48_value argv, s48_value env) { int i, j, e; - int argc = VECTOR_LENGTH(argv); + int argc = S48_VECTOR_LENGTH(argv); char **unix_argv = Malloc(char*, argc+1); char **unix_env; @@ -81,25 +81,25 @@ int scheme_exec(const char *prog, scheme_value argv, scheme_value env) /* Scheme->Unix convert the argv parameter. */ for(i=0; iUnix convert the env parameter. */ - if( env == SCHTRUE ) unix_env = environ; + if( env == S48_TRUE ) unix_env = environ; else { - int envlen = VECTOR_LENGTH(env); + int envlen = S48_VECTOR_LENGTH(env); unix_env = Malloc(char*, envlen+1); if( !unix_env ) goto lose; for(j=0; jst_mode; @@ -348,23 +348,23 @@ static int really_stat(int retval, struct stat *s, scheme_value vec) else if( S_ISSOCK(modes) ) typecode = 5; else if( S_ISLNK(modes) ) typecode = 6; - VECTOR_REF(vec,0) = ENTER_FIXNUM(typecode); - VECTOR_REF(vec,1) = ENTER_FIXNUM(s->st_dev); - VECTOR_REF(vec,2) = ENTER_FIXNUM(s->st_ino); - VECTOR_REF(vec,3) = ENTER_FIXNUM(s->st_mode); - VECTOR_REF(vec,4) = ENTER_FIXNUM(s->st_nlink); - VECTOR_REF(vec,5) = ENTER_FIXNUM(s->st_uid); - VECTOR_REF(vec,6) = ENTER_FIXNUM(s->st_gid); - VECTOR_REF(vec,7) = ENTER_FIXNUM(s->st_size); + S48_VECTOR_SET(vec,0,s48_enter_fixnum(typecode)); + S48_VECTOR_SET(vec,1, s48_enter_fixnum(s->st_dev)); + S48_VECTOR_SET(vec,2, s48_enter_fixnum(s->st_ino)); + S48_VECTOR_SET(vec,3, s48_enter_fixnum(s->st_mode)); + S48_VECTOR_SET(vec,4, s48_enter_fixnum(s->st_nlink)); + S48_VECTOR_SET(vec,5, s48_enter_fixnum(s->st_uid)); + S48_VECTOR_SET(vec,6, s48_enter_fixnum(s->st_gid)); + S48_VECTOR_SET(vec,7, s48_enter_fixnum(s->st_size)); - VECTOR_REF(vec,8) = ENTER_FIXNUM( low24(s->st_atime)); - VECTOR_REF(vec,9) = ENTER_FIXNUM(hi_but24(s->st_atime)); + S48_VECTOR_SET(vec,8, s48_enter_fixnum( low24(s->st_atime))); + S48_VECTOR_SET(vec,9, s48_enter_fixnum(hi_but24(s->st_atime))); - VECTOR_REF(vec,10) = ENTER_FIXNUM( low24(s->st_mtime)); - VECTOR_REF(vec,11) = ENTER_FIXNUM(hi_but24(s->st_mtime)); + S48_VECTOR_SET(vec,10, s48_enter_fixnum( low24(s->st_mtime))); + S48_VECTOR_SET(vec,11, s48_enter_fixnum(hi_but24(s->st_mtime))); - VECTOR_REF(vec,12) = ENTER_FIXNUM( low24(s->st_ctime)); - VECTOR_REF(vec,13) = ENTER_FIXNUM(hi_but24(s->st_ctime)); + S48_VECTOR_SET(vec,12, s48_enter_fixnum( low24(s->st_ctime))); + S48_VECTOR_SET(vec,13, s48_enter_fixnum(hi_but24(s->st_ctime))); /* We also used to do st_rdev, st_blksize, and st_blocks. These aren't POSIX, and, e.g., are not around on SGI machines. @@ -373,13 +373,13 @@ static int really_stat(int retval, struct stat *s, scheme_value vec) return 0; } -int scheme_stat(const char *path, scheme_value vec, int chase_p) +int scheme_stat(const char *path, s48_value vec, int chase_p) { struct stat s; return really_stat(chase_p ? stat(path, &s) : lstat(path, &s), &s, vec); } -int scheme_fstat(int fd, scheme_value vec) +int scheme_fstat(int fd, s48_value vec) { struct stat s; return really_stat(fstat(fd,&s), &s, vec); @@ -397,9 +397,9 @@ int num_supp_groups(void) /* Load the supplementary groups into GVEC. */ -int get_groups(scheme_value gvec) +int get_groups(s48_value gvec) { - int veclen = VECTOR_LENGTH(gvec), i, retval; + int veclen = S48_VECTOR_LENGTH(gvec), i, retval; gid_t gvec0[20], *gp = gvec0; if( veclen > 20 ) @@ -409,7 +409,7 @@ int get_groups(scheme_value gvec) if( retval != -1 ) for( i=veclen; i--; ) - VECTOR_REF(gvec,i) = ENTER_FIXNUM(gp[i]); + S48_VECTOR_SET(gvec,i, s48_enter_fixnum(gp[i])); if( veclen > 20 ) Free(gp); @@ -424,11 +424,11 @@ int get_groups(scheme_value gvec) int put_env(const char *s) { char *s1 = Malloc(char, strlen(s)+1); - if( !s1 ) return ENTER_FIXNUM(errno); + if( !s1 ) return s48_enter_fixnum(errno); strcpy(s1, s); - return putenv(s1) ? ENTER_FIXNUM(errno) : SCHFALSE; + return putenv(s1) ? s48_enter_fixnum(errno) : S48_FALSE; } char** scm_envvec(int *len) /* Returns environ c-vector & its length. */ @@ -445,17 +445,17 @@ char** scm_envvec(int *len) /* Returns environ c-vector & its length. */ ** in the old environ -- don't know if it is being shared elsewhere. */ -int install_env(scheme_value vec) +int install_env(s48_value vec) { int i, envsize; char **newenv; - envsize = VECTOR_LENGTH(vec); + envsize = S48_VECTOR_LENGTH(vec); newenv = Malloc(char*, envsize+1); if( !newenv ) return errno; for( i=0; i @@ -7,63 +7,63 @@ #include "libcig.h" #include "time1.h" -scheme_value df_time_plus_ticks(long nargs, scheme_value *args) +s48_value df_time_plus_ticks(s48_value mv_vec) { - extern scheme_value time_plus_ticks(int *, int *, int *, int *); - scheme_value ret1; - scheme_value r1; + extern s48_value time_plus_ticks(int *, int *, int *, int *); + s48_value ret1; + s48_value r1; int r2; int r3; int r4; int r5; - cig_check_nargs(1, nargs, "time_plus_ticks"); + r1 = time_plus_ticks(&r2, &r3, &r4, &r5); ret1 = r1; - VECTOR_REF(*args,0) = ENTER_FIXNUM(r2); - VECTOR_REF(*args,1) = ENTER_FIXNUM(r3); - VECTOR_REF(*args,2) = ENTER_FIXNUM(r4); - VECTOR_REF(*args,3) = ENTER_FIXNUM(r5); + S48_VECTOR_SET(mv_vec,0,s48_enter_fixnum(r2)); + S48_VECTOR_SET(mv_vec,1,s48_enter_fixnum(r3)); + S48_VECTOR_SET(mv_vec,2,s48_enter_fixnum(r4)); + S48_VECTOR_SET(mv_vec,3,s48_enter_fixnum(r5)); return ret1; - } +} -scheme_value df_scheme_time(long nargs, scheme_value *args) +s48_value df_scheme_time(s48_value mv_vec) { - extern scheme_value scheme_time(int *, int *); - scheme_value ret1; - scheme_value r1; + extern s48_value scheme_time(int *, int *); + s48_value ret1; + s48_value r1; int r2; int r3; - cig_check_nargs(1, nargs, "scheme_time"); + r1 = scheme_time(&r2, &r3); ret1 = r1; - VECTOR_REF(*args,0) = ENTER_FIXNUM(r2); - VECTOR_REF(*args,1) = ENTER_FIXNUM(r3); + S48_VECTOR_SET(mv_vec,0,s48_enter_fixnum(r2)); + S48_VECTOR_SET(mv_vec,1,s48_enter_fixnum(r3)); return ret1; - } +} -scheme_value df_date2time(long nargs, scheme_value *args) +s48_value df_date2time(s48_value g1, s48_value g2, s48_value g3, s48_value g4, s48_value g5, s48_value g6, s48_value g7, s48_value g8, s48_value g9, s48_value mv_vec) { - extern scheme_value date2time(int , int , int , int , int , int , scheme_value , scheme_value , int , int *, int *); - scheme_value ret1; - scheme_value r1; + extern s48_value date2time(int , int , int , int , int , int , s48_value , s48_value , int , int *, int *); + s48_value ret1; + s48_value r1; int r2; int r3; - cig_check_nargs(10, nargs, "date2time"); - r1 = date2time(EXTRACT_FIXNUM(args[9]), EXTRACT_FIXNUM(args[8]), EXTRACT_FIXNUM(args[7]), EXTRACT_FIXNUM(args[6]), EXTRACT_FIXNUM(args[5]), EXTRACT_FIXNUM(args[4]), args[3], args[2], EXTRACT_BOOLEAN(args[1]), &r2, &r3); + + r1 = date2time(s48_extract_fixnum(g1), s48_extract_fixnum(g2), s48_extract_fixnum(g3), s48_extract_fixnum(g4), s48_extract_fixnum(g5), s48_extract_fixnum(g6), g7, g8, EXTRACT_BOOLEAN(g9), &r2, &r3); ret1 = r1; - VECTOR_REF(*args,0) = ENTER_FIXNUM(r2); - VECTOR_REF(*args,1) = ENTER_FIXNUM(r3); + S48_VECTOR_SET(mv_vec,0,s48_enter_fixnum(r2)); + S48_VECTOR_SET(mv_vec,1,s48_enter_fixnum(r3)); return ret1; - } +} -scheme_value df_time2date(long nargs, scheme_value *args) +s48_value df_time2date(s48_value g1, s48_value g2, s48_value g3, s48_value mv_vec) { - extern scheme_value time2date(int , int , scheme_value , int *, int *, int *, int *, int *, int *, const char **, int *, int *, int *, int *); - scheme_value ret1; - scheme_value r1; + extern s48_value time2date(int , int , s48_value , int *, int *, int *, int *, int *, int *, const char **, int *, int *, int *, int *); + s48_value ret1; + s48_value r1; int r2; int r3; int r4; @@ -76,34 +76,44 @@ scheme_value df_time2date(long nargs, scheme_value *args) int r11; int r12; - cig_check_nargs(4, nargs, "time2date"); - r1 = time2date(EXTRACT_FIXNUM(args[3]), EXTRACT_FIXNUM(args[2]), args[1], &r2, &r3, &r4, &r5, &r6, &r7, &r8, &r9, &r10, &r11, &r12); + + r1 = time2date(s48_extract_fixnum(g1), s48_extract_fixnum(g2), g3, &r2, &r3, &r4, &r5, &r6, &r7, &r8, &r9, &r10, &r11, &r12); ret1 = r1; - VECTOR_REF(*args,0) = ENTER_FIXNUM(r2); - VECTOR_REF(*args,1) = ENTER_FIXNUM(r3); - VECTOR_REF(*args,2) = ENTER_FIXNUM(r4); - VECTOR_REF(*args,3) = ENTER_FIXNUM(r5); - VECTOR_REF(*args,4) = ENTER_FIXNUM(r6); - VECTOR_REF(*args,5) = ENTER_FIXNUM(r7); - {AlienVal(CAR(VECTOR_REF(*args,6))) = (long) r8; CDR(VECTOR_REF(*args,6)) = strlen_or_false(r8);} - VECTOR_REF(*args,7) = ENTER_FIXNUM(r9); - VECTOR_REF(*args,8) = ENTER_BOOLEAN(r10); - VECTOR_REF(*args,9) = ENTER_FIXNUM(r11); - VECTOR_REF(*args,10) = ENTER_FIXNUM(r12); + S48_VECTOR_SET(mv_vec,0,s48_enter_fixnum(r2)); + S48_VECTOR_SET(mv_vec,1,s48_enter_fixnum(r3)); + S48_VECTOR_SET(mv_vec,2,s48_enter_fixnum(r4)); + S48_VECTOR_SET(mv_vec,3,s48_enter_fixnum(r5)); + S48_VECTOR_SET(mv_vec,4,s48_enter_fixnum(r6)); + S48_VECTOR_SET(mv_vec,5,s48_enter_fixnum(r7)); + S48_SET_CAR(S48_VECTOR_REF(mv_vec,6),(long) r8); S48_SET_CDR(S48_VECTOR_REF(mv_vec,6),strlen_or_false(r8)); + S48_VECTOR_SET(mv_vec,7,s48_enter_fixnum(r9)); + S48_VECTOR_SET(mv_vec,8,ENTER_BOOLEAN(r10)); + S48_VECTOR_SET(mv_vec,9,s48_enter_fixnum(r11)); + S48_VECTOR_SET(mv_vec,10,s48_enter_fixnum(r12)); return ret1; - } +} -scheme_value df_format_date(long nargs, scheme_value *args) +s48_value df_format_date(s48_value g1, s48_value g2, s48_value g3, s48_value g4, s48_value g5, s48_value g6, s48_value g7, s48_value g8, s48_value g9, s48_value g10, s48_value g11, s48_value mv_vec) { - extern scheme_value format_date(const char *, int , int , int , int , int , int , scheme_value , int , int , int , const char **); - scheme_value ret1; - scheme_value r1; + extern s48_value format_date(const char *, int , int , int , int , int , int , s48_value , int , int , int , const char **); + s48_value ret1; + s48_value r1; const char *r2; - cig_check_nargs(12, nargs, "format_date"); - r1 = format_date(cig_string_body(args[11]), EXTRACT_FIXNUM(args[10]), EXTRACT_FIXNUM(args[9]), EXTRACT_FIXNUM(args[8]), EXTRACT_FIXNUM(args[7]), EXTRACT_FIXNUM(args[6]), EXTRACT_FIXNUM(args[5]), args[4], EXTRACT_BOOLEAN(args[3]), EXTRACT_FIXNUM(args[2]), EXTRACT_FIXNUM(args[1]), &r2); + + r1 = format_date(s48_extract_string(g1), s48_extract_fixnum(g2), s48_extract_fixnum(g3), s48_extract_fixnum(g4), s48_extract_fixnum(g5), s48_extract_fixnum(g6), s48_extract_fixnum(g7), g8, EXTRACT_BOOLEAN(g9), s48_extract_fixnum(g10), s48_extract_fixnum(g11), &r2); ret1 = r1; - {AlienVal(CAR(VECTOR_REF(*args,0))) = (long) r2; CDR(VECTOR_REF(*args,0)) = strlen_or_false(r2);} + S48_SET_CAR(S48_VECTOR_REF(mv_vec,0),(long) r2); S48_SET_CDR(S48_VECTOR_REF(mv_vec,0),strlen_or_false(r2)); return ret1; - } +} +s48_value s48_init_time(void) +{ + S48_EXPORT_FUNCTION(df_time_plus_ticks); + S48_EXPORT_FUNCTION(df_scheme_time); + S48_EXPORT_FUNCTION(df_date2time); + S48_EXPORT_FUNCTION(df_time2date); + S48_EXPORT_FUNCTION(df_format_date); + + return S48_UNSPECIFIC; +} diff --git a/scsh/time1.c b/scsh/time1.c index bfc0e7c..a61ee47 100644 --- a/scsh/time1.c +++ b/scsh/time1.c @@ -69,14 +69,16 @@ extern char *tzname[]; /* Why isn't this defined in time.h? */ ** On error, make_newenv returns NULL. */ -static char **make_newenv(scheme_value zone, char *newenv[2]) +static char **make_newenv(s48_value zone, char *newenv[2]) { - int zonelen = STRING_LENGTH(zone); + int zonelen = S48_STRING_LENGTH(zone); char **oldenv = environ, *tz = Malloc(char, 4+zonelen); + s48_value temp; if( !tz ) return NULL; strcpy(tz, "TZ="); - strncpy(tz+3, &STRING_REF(zone,0), zonelen); + temp = S48_UNSAFE_STRING_REF(zone,0); //JMG + strncpy(tz+3, &temp, zonelen); tz[zonelen+3] = '\0'; newenv[0] = tz; newenv[1] = NULL; @@ -100,15 +102,15 @@ static void revert_env(char **old_env) #define lo24(i) ((i) & 0xffffff) #define comp8_24(hi, lo) (((hi)<<24) + (lo)) -scheme_value scheme_time(int *hi_secs, int *lo_secs) +s48_value scheme_time(int *hi_secs, int *lo_secs) { time_t t; errno = 0; t = time(NULL); - if( t == -1 && errno ) return ENTER_FIXNUM(errno); + if( t == -1 && errno ) return s48_enter_fixnum(errno); *hi_secs = hi8(t); *lo_secs = lo24(t); - return SCHFALSE; + return S48_FALSE; } /* Zone: @@ -116,7 +118,7 @@ scheme_value scheme_time(int *hi_secs, int *lo_secs) ** int Offset from GMT in seconds. ** string Time zone understood by OS. */ -scheme_value time2date(int hi_secs, int lo_secs, scheme_value zone, +s48_value time2date(int hi_secs, int lo_secs, s48_value zone, int *sec, int *min, int *hour, int *mday, int *month, int *year, const char **tz_name, int *tz_secs, @@ -126,9 +128,9 @@ scheme_value time2date(int hi_secs, int lo_secs, scheme_value zone, time_t t = comp8_24(hi_secs, lo_secs); struct tm d; - if( FIXNUMP(zone) ) { /* Offset from GMT in secs. */ - int offset = EXTRACT_FIXNUM(zone); - t += EXTRACT_FIXNUM(zone); + if( S48_FIXNUM_P(zone) ) { /* Offset from GMT in secs. */ + int offset = s48_extract_fixnum(zone); + t += s48_extract_fixnum(zone); d = *gmtime(&t); *tz_name = NULL; *tz_secs = offset; @@ -136,9 +138,9 @@ scheme_value time2date(int hi_secs, int lo_secs, scheme_value zone, else { char *newenv[2], **oldenv = NULL; - if( STRINGP(zone) ) { /* Time zone */ + if( S48_STRING_P(zone) ) { /* Time zone */ oldenv = make_newenv(zone, newenv); /* Install new TZ. */ - if( !oldenv ) return ENTER_FIXNUM(errno); /* Error installing. */ + if( !oldenv ) return s48_enter_fixnum(errno); /* Error installing. */ d = *localtime(&t); /* Do it. */ } else /* Local time */ @@ -167,7 +169,7 @@ scheme_value time2date(int hi_secs, int lo_secs, scheme_value zone, if( oldenv ) revert_env(oldenv); /* Revert TZ & env. */ - if( !newzone ) return ENTER_FIXNUM(error); + if( !newzone ) return s48_enter_fixnum(error); } /* Calculate the time-zone offset in seconds from UTC. */ @@ -186,7 +188,7 @@ scheme_value time2date(int hi_secs, int lo_secs, scheme_value zone, *sec = d.tm_sec; *min = d.tm_min; *hour = d.tm_hour; *mday = d.tm_mday; *month = d.tm_mon; *year = d.tm_year; *wday = d.tm_wday; *yday = d.tm_yday; *summer = d.tm_isdst; - return SCHFALSE; + return S48_FALSE; } @@ -202,9 +204,9 @@ scheme_value time2date(int hi_secs, int lo_secs, scheme_value zone, ** Who designed this interface? */ -scheme_value date2time(int sec, int min, int hour, +s48_value date2time(int sec, int min, int hour, int mday, int month, int year, - scheme_value tz_name, scheme_value tz_secs, + s48_value tz_name, s48_value tz_secs, int summer, int *hi_secs, int *lo_secs) { @@ -215,7 +217,7 @@ scheme_value date2time(int sec, int min, int hour, d.tm_mday = mday; d.tm_mon = month; d.tm_year = year; d.tm_wday = 0; d.tm_yday = 0; d.tm_isdst = summer; - if( FIXNUMP(tz_secs) ) { /* Offset from GMT in seconds. */ + if( S48_FIXNUM_P(tz_secs) ) { /* Offset from GMT in seconds. */ char **oldenv = environ; /* Set TZ to UTC */ environ = utc_env; /* time temporarily. */ tzset(); /* NetBSD, SunOS POSIX-noncompliance requires this. */ @@ -223,19 +225,19 @@ scheme_value date2time(int sec, int min, int hour, errno = 0; t = mktime(&d); /* t == -1 => you probably have an error. */ - if( t == -1 ) return ENTER_FIXNUM(errno ? errno : -1); - t -= EXTRACT_FIXNUM(tz_secs); + if( t == -1 ) return s48_enter_fixnum(errno ? errno : -1); + t -= s48_extract_fixnum(tz_secs); environ = oldenv; } - else if( STRINGP(tz_name) ) { /* Time zone */ + else if( S48_STRING_P(tz_name) ) { /* Time zone */ char *newenv[2]; char **oldenv = make_newenv(tz_name, newenv); - if( !oldenv ) return ENTER_FIXNUM(errno); + if( !oldenv ) return s48_enter_fixnum(errno); tzset(); /* NetBSD, SunOS POSIX-noncompliance requires this. */ errno = 0; t = mktime(&d); - if( t == -1 ) return ENTER_FIXNUM(errno ? errno : -1); + if( t == -1 ) return s48_enter_fixnum(errno ? errno : -1); revert_env(oldenv); } @@ -243,12 +245,12 @@ scheme_value date2time(int sec, int min, int hour, tzset(); /* NetBSD, SunOS POSIX-noncompliance requires this. */ errno = 0; t = mktime(&d); - if( t == -1) return ENTER_FIXNUM(errno ? errno : -1); + if( t == -1) return s48_enter_fixnum(errno ? errno : -1); } *hi_secs = hi8(t); *lo_secs = lo24(t); - return SCHFALSE; + return S48_FALSE; } @@ -280,9 +282,9 @@ scheme_value date2time(int sec, int min, int hour, ** Professional programmers sacrifice their pride that others may live. ** Why me? Why Unix? */ -scheme_value format_date(const char *fmt, int sec, int min, int hour, +s48_value format_date(const char *fmt, int sec, int min, int hour, int mday, int month, int year, - scheme_value tz, int summer, + s48_value tz, int summer, int week_day, int year_day, const char **ans) { @@ -297,7 +299,7 @@ scheme_value format_date(const char *fmt, int sec, int min, int hour, int result_len; *ans = NULL; /* In case we error out. */ - if( !fmt2 ) return ENTER_FIXNUM(errno); + if( !fmt2 ) return s48_enter_fixnum(errno); d.tm_sec = sec; d.tm_min = min; d.tm_hour = hour; d.tm_mday = mday; d.tm_mon = month; d.tm_year = year; @@ -318,7 +320,7 @@ scheme_value format_date(const char *fmt, int sec, int min, int hour, char c = *++p; if( ! c ) { Free(fmt2); - return SCHTRUE; /* % has to be followed by something. */ + return S48_TRUE; /* % has to be followed by something. */ } else if( c == '~' ) { *q++ = '~'; @@ -358,12 +360,12 @@ scheme_value format_date(const char *fmt, int sec, int min, int hour, *q++ = 'x'; *q = '\0'; /* Append the guard "x" suffix and nul-terminate. */ /* Fix up the time-zone if it is being used and the user passed one in. */ - if( zone && STRINGP(tz) ) { + if( zone && S48_STRING_P(tz) ) { oldenv = make_newenv(tz, newenv); if( !oldenv ) { int err = errno; Free(fmt); - return ENTER_FIXNUM(err); + return s48_enter_fixnum(err); } } @@ -382,14 +384,14 @@ scheme_value format_date(const char *fmt, int sec, int min, int hour, *ans = target; Free(fmt2); if( oldenv ) revert_env(oldenv); - return SCHFALSE; + return S48_FALSE; lose: /* We lost trying to allocate space for the strftime() target buffer. */ {int err = errno; if( oldenv ) revert_env(oldenv); /* Clean up */ Free(fmt2); - return ENTER_FIXNUM(err); + return s48_enter_fixnum(err); } } diff --git a/scsh/time1.h b/scsh/time1.h index f7706a1..a3338ea 100644 --- a/scsh/time1.h +++ b/scsh/time1.h @@ -1,23 +1,23 @@ -extern scheme_value scheme_time(int *hi_secs, int *lo_secs); +extern s48_value scheme_time(int *hi_secs, int *lo_secs); -extern scheme_value time_plus_ticks(int *hi_secs, int *lo_secs, +extern s48_value time_plus_ticks(int *hi_secs, int *lo_secs, int *hi_ticks, int *lo_ticks); -extern scheme_value time2date(int hi_secs, int lo_secs, scheme_value zone, +extern s48_value time2date(int hi_secs, int lo_secs, s48_value zone, int *sec, int *min, int *hour, int *mday, int *month, int *year, const char **tz_name, int *tz_secs, int *summer, int *wday, int *yday); -extern scheme_value date2time(int sec, int min, int hour, +extern s48_value date2time(int sec, int min, int hour, int mday, int month, int year, - scheme_value tz_name, scheme_value tz_secs, + s48_value tz_name, s48_value tz_secs, int summer, int *hi_secs, int *lo_secs); -extern scheme_value format_date(const char *fmt, int sec, int min, int hour, +extern s48_value format_date(const char *fmt, int sec, int min, int hour, int mday, int month, int year, - scheme_value tz, int summer, + s48_value tz, int summer, int week_day, int year_day, const char **ans); diff --git a/scsh/tty.c b/scsh/tty.c index 205e17c..8f0aae8 100644 --- a/scsh/tty.c +++ b/scsh/tty.c @@ -1,5 +1,5 @@ /* This is an Scheme48/C interface file, -** automatically generated by cig. +** automatically generated by a hacked version of cig 3.0. */ #include @@ -16,12 +16,12 @@ extern int errno; -#define errno_or_false(x) (((x) == -1) ? ENTER_FIXNUM(errno) : SCHFALSE) -#define errno_on_zero_or_false(x) ((x) ? SCHFALSE : ENTER_FIXNUM(errno)) -scheme_value df_scheme_tcgetattr(long nargs, scheme_value *args) +#define errno_or_false(x) (((x) == -1) ? s48_enter_fixnum(errno) : S48_FALSE) +#define errno_on_zero_or_false(x) ((x) ? S48_FALSE : s48_enter_fixnum(errno)) +s48_value df_scheme_tcgetattr(s48_value g1, s48_value g2, s48_value mv_vec) { extern int scheme_tcgetattr(int , char *, int *, int *, int *, int *, int *, int *, int *, int *, int *, int *); - scheme_value ret1; + s48_value ret1; int r1; int r2; int r3; @@ -34,155 +34,172 @@ scheme_value df_scheme_tcgetattr(long nargs, scheme_value *args) int r10; int r11; - cig_check_nargs(3, nargs, "scheme_tcgetattr"); - r1 = scheme_tcgetattr(EXTRACT_FIXNUM(args[2]), cig_string_body(args[1]), &r2, &r3, &r4, &r5, &r6, &r7, &r8, &r9, &r10, &r11); + + r1 = scheme_tcgetattr(s48_extract_fixnum(g1), s48_extract_string(g2), &r2, &r3, &r4, &r5, &r6, &r7, &r8, &r9, &r10, &r11); ret1 = errno_or_false(r1); - VECTOR_REF(*args,0) = ENTER_FIXNUM(r2); - VECTOR_REF(*args,1) = ENTER_FIXNUM(r3); - VECTOR_REF(*args,2) = ENTER_FIXNUM(r4); - VECTOR_REF(*args,3) = ENTER_FIXNUM(r5); - VECTOR_REF(*args,4) = ENTER_FIXNUM(r6); - VECTOR_REF(*args,5) = ENTER_FIXNUM(r7); - VECTOR_REF(*args,6) = ENTER_FIXNUM(r8); - VECTOR_REF(*args,7) = ENTER_FIXNUM(r9); - VECTOR_REF(*args,8) = ENTER_FIXNUM(r10); - VECTOR_REF(*args,9) = ENTER_FIXNUM(r11); + S48_VECTOR_SET(mv_vec,0,s48_enter_fixnum(r2)); + S48_VECTOR_SET(mv_vec,1,s48_enter_fixnum(r3)); + S48_VECTOR_SET(mv_vec,2,s48_enter_fixnum(r4)); + S48_VECTOR_SET(mv_vec,3,s48_enter_fixnum(r5)); + S48_VECTOR_SET(mv_vec,4,s48_enter_fixnum(r6)); + S48_VECTOR_SET(mv_vec,5,s48_enter_fixnum(r7)); + S48_VECTOR_SET(mv_vec,6,s48_enter_fixnum(r8)); + S48_VECTOR_SET(mv_vec,7,s48_enter_fixnum(r9)); + S48_VECTOR_SET(mv_vec,8,s48_enter_fixnum(r10)); + S48_VECTOR_SET(mv_vec,9,s48_enter_fixnum(r11)); return ret1; - } +} -scheme_value df_scheme_tcsetattr(long nargs, scheme_value *args) +s48_value df_scheme_tcsetattr(s48_value g1, s48_value g2, s48_value g3, s48_value g4, s48_value g5, s48_value g6, s48_value g7, s48_value g8, s48_value g9, s48_value g10, s48_value g11, s48_value g12, s48_value g13, s48_value g14, s48_value g15) { extern int scheme_tcsetattr(int , int , const char *, int , int , int , int , int , int , int , int , int , int , int , int ); - scheme_value ret1; + s48_value ret1; int r1; - cig_check_nargs(15, nargs, "scheme_tcsetattr"); - r1 = scheme_tcsetattr(EXTRACT_FIXNUM(args[14]), EXTRACT_FIXNUM(args[13]), cig_string_body(args[12]), EXTRACT_FIXNUM(args[11]), EXTRACT_FIXNUM(args[10]), EXTRACT_FIXNUM(args[9]), EXTRACT_FIXNUM(args[8]), EXTRACT_FIXNUM(args[7]), EXTRACT_FIXNUM(args[6]), EXTRACT_FIXNUM(args[5]), EXTRACT_FIXNUM(args[4]), EXTRACT_FIXNUM(args[3]), EXTRACT_FIXNUM(args[2]), EXTRACT_FIXNUM(args[1]), EXTRACT_FIXNUM(args[0])); + + r1 = scheme_tcsetattr(s48_extract_fixnum(g1), s48_extract_fixnum(g2), s48_extract_string(g3), s48_extract_fixnum(g4), s48_extract_fixnum(g5), s48_extract_fixnum(g6), s48_extract_fixnum(g7), s48_extract_fixnum(g8), s48_extract_fixnum(g9), s48_extract_fixnum(g10), s48_extract_fixnum(g11), s48_extract_fixnum(g12), s48_extract_fixnum(g13), s48_extract_fixnum(g14), s48_extract_fixnum(g15)); ret1 = errno_or_false(r1); return ret1; - } +} -scheme_value df_tcsendbreak(long nargs, scheme_value *args) +s48_value df_tcsendbreak(s48_value g1, s48_value g2) { extern int tcsendbreak(int , int ); - scheme_value ret1; + s48_value ret1; int r1; - cig_check_nargs(2, nargs, "tcsendbreak"); - r1 = tcsendbreak(EXTRACT_FIXNUM(args[1]), EXTRACT_FIXNUM(args[0])); + + r1 = tcsendbreak(s48_extract_fixnum(g1), s48_extract_fixnum(g2)); ret1 = errno_or_false(r1); return ret1; - } +} -scheme_value df_tcdrain(long nargs, scheme_value *args) +s48_value df_tcdrain(s48_value g1) { - scheme_value ret1; + s48_value ret1; int r1; - cig_check_nargs(1, nargs, "tcdrain"); - r1 = tcdrain(EXTRACT_FIXNUM(args[0])); + + r1 = tcdrain(s48_extract_fixnum(g1)); ret1 = errno_or_false(r1); return ret1; - } +} -scheme_value df_tcflush(long nargs, scheme_value *args) +s48_value df_tcflush(s48_value g1, s48_value g2) { - scheme_value ret1; + s48_value ret1; int r1; - cig_check_nargs(2, nargs, "tcflush"); - r1 = tcflush(EXTRACT_FIXNUM(args[1]), EXTRACT_FIXNUM(args[0])); + + r1 = tcflush(s48_extract_fixnum(g1), s48_extract_fixnum(g2)); ret1 = errno_or_false(r1); return ret1; - } +} -scheme_value df_tcflow(long nargs, scheme_value *args) +s48_value df_tcflow(s48_value g1, s48_value g2) { - scheme_value ret1; + s48_value ret1; int r1; - cig_check_nargs(2, nargs, "tcflow"); - r1 = tcflow(EXTRACT_FIXNUM(args[1]), EXTRACT_FIXNUM(args[0])); + + r1 = tcflow(s48_extract_fixnum(g1), s48_extract_fixnum(g2)); ret1 = errno_or_false(r1); return ret1; - } +} -scheme_value df_tcsetpgrp(long nargs, scheme_value *args) +s48_value df_tcsetpgrp(s48_value g1, s48_value g2) { - scheme_value ret1; + s48_value ret1; int r1; - cig_check_nargs(2, nargs, "tcsetpgrp"); - r1 = tcsetpgrp(EXTRACT_FIXNUM(args[1]), EXTRACT_FIXNUM(args[0])); + + r1 = tcsetpgrp(s48_extract_fixnum(g1), s48_extract_fixnum(g2)); ret1 = errno_or_false(r1); return ret1; - } +} -scheme_value df_tcgetpgrp(long nargs, scheme_value *args) +s48_value df_tcgetpgrp(s48_value g1, s48_value mv_vec) { - scheme_value ret1; + s48_value ret1; pid_t r1; - cig_check_nargs(2, nargs, "tcgetpgrp"); - r1 = tcgetpgrp(EXTRACT_FIXNUM(args[1])); + + r1 = tcgetpgrp(s48_extract_fixnum(g1)); ret1 = errno_or_false(r1); - VECTOR_REF(*args,0) = ENTER_FIXNUM(r1); + S48_VECTOR_SET(mv_vec,0,s48_enter_fixnum(r1)); return ret1; - } +} -scheme_value df_open_ctty(long nargs, scheme_value *args) +s48_value df_open_ctty(s48_value g1, s48_value g2, s48_value mv_vec) { extern int open_ctty(const char *, int ); - scheme_value ret1; + s48_value ret1; int r1; - cig_check_nargs(3, nargs, "open_ctty"); - r1 = open_ctty(cig_string_body(args[2]), EXTRACT_FIXNUM(args[1])); + + r1 = open_ctty(s48_extract_string(g1), s48_extract_fixnum(g2)); ret1 = errno_or_false(r1); - VECTOR_REF(*args,0) = ENTER_FIXNUM(r1); + S48_VECTOR_SET(mv_vec,0,s48_enter_fixnum(r1)); return ret1; - } +} -scheme_value df_isatty(long nargs, scheme_value *args) +s48_value df_isatty(s48_value g1) { extern int isatty(int ); - scheme_value ret1; + s48_value ret1; int r1; - cig_check_nargs(1, nargs, "isatty"); - r1 = isatty(EXTRACT_FIXNUM(args[0])); + + r1 = isatty(s48_extract_fixnum(g1)); ret1 = ENTER_BOOLEAN(r1); return ret1; - } +} -scheme_value df_ttyname(long nargs, scheme_value *args) +s48_value df_ttyname(s48_value g1, s48_value mv_vec) { extern char *ttyname(int ); - scheme_value ret1; + s48_value ret1; char *r1; - cig_check_nargs(2, nargs, "ttyname"); - r1 = ttyname(EXTRACT_FIXNUM(args[1])); + + r1 = ttyname(s48_extract_fixnum(g1)); ret1 = errno_on_zero_or_false(r1); - {AlienVal(CAR(VECTOR_REF(*args,0))) = (long) r1; CDR(VECTOR_REF(*args,0)) = strlen_or_false(r1);} + S48_SET_CAR(S48_VECTOR_REF(mv_vec,0),(long) r1); S48_SET_CDR(S48_VECTOR_REF(mv_vec,0),strlen_or_false(r1)); return ret1; - } +} -scheme_value df_scm_ctermid(long nargs, scheme_value *args) +s48_value df_scm_ctermid(s48_value mv_vec) { extern char *scm_ctermid(void); - scheme_value ret1; + s48_value ret1; char *r1; - cig_check_nargs(1, nargs, "scm_ctermid"); + r1 = scm_ctermid(); ret1 = errno_on_zero_or_false(r1); - {AlienVal(CAR(VECTOR_REF(*args,0))) = (long) r1; CDR(VECTOR_REF(*args,0)) = strlen_or_false(r1);} + S48_SET_CAR(S48_VECTOR_REF(mv_vec,0),(long) r1); S48_SET_CDR(S48_VECTOR_REF(mv_vec,0),strlen_or_false(r1)); return ret1; - } +} +s48_value s48_init_tty(void) +{ + S48_EXPORT_FUNCTION(df_scheme_tcgetattr); + S48_EXPORT_FUNCTION(df_scheme_tcsetattr); + S48_EXPORT_FUNCTION(df_tcsendbreak); + S48_EXPORT_FUNCTION(df_tcdrain); + S48_EXPORT_FUNCTION(df_tcflush); + S48_EXPORT_FUNCTION(df_tcflow); + S48_EXPORT_FUNCTION(df_tcsetpgrp); + S48_EXPORT_FUNCTION(df_tcgetpgrp); + S48_EXPORT_FUNCTION(df_open_ctty); + S48_EXPORT_FUNCTION(df_isatty); + S48_EXPORT_FUNCTION(df_ttyname); + S48_EXPORT_FUNCTION(df_scm_ctermid); + + return S48_UNSPECIFIC; +} diff --git a/scsh/tty.scm b/scsh/tty.scm index 3e6bda4..de6cb0f 100644 --- a/scsh/tty.scm +++ b/scsh/tty.scm @@ -24,8 +24,8 @@ "" "extern int errno;" "" - "#define errno_or_false(x) (((x) == -1) ? ENTER_FIXNUM(errno) : SCHFALSE)" - "#define errno_on_zero_or_false(x) ((x) ? SCHFALSE : ENTER_FIXNUM(errno))" + "#define errno_or_false(x) (((x) == -1) ? s48_enter_fixnum(errno) : S48_FALSE)" + "#define errno_on_zero_or_false(x) ((x) ? S48_FALSE : s48_enter_fixnum(errno))" "" )