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

replaced all the macros and definitions that have changed in c/scheme48.h. Sometimes changes were necessary, if stuff is no longer a l-value. Some things are just commented out to be able to compile

This commit is contained in:
marting 1999-09-16 00:20:37 +00:00
parent 45d3aa911c
commit d2fc94c2da
60 changed files with 2612 additions and 1344 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
scsh/bdbmo.c
View File

@ -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)
{

22
scsh/db.c
View File

@ -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 <stdio.h>
@ -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;
}

2
scsh/db.scm
View File

@ -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)

86
scsh/dbm.c
View File

@ -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;
}

2
scsh/dbm.scm
View File

@ -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

14
scsh/dbm1.c
View File

@ -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));
}

14
scsh/fdports.h
View File

@ -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)))

18
scsh/fdports1.c
View File

@ -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++;
}

4
scsh/fdports1.h
View File

@ -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);

152
scsh/fdports1.old.c
View File

@ -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<NUM_FDPORTS; fd++) {
scheme_value port = fdports[fd];
s48_value port = fdports[fd];
if(STOBP(port)) {
long header = STOB_HEADER(port);
if(STOBP(header)) {
@ -317,7 +317,7 @@ void post_gc_fdports(void)
else {
/* Port wasn't copied -- is garbage.
If fd unrevealed, close it. */
int rev = EXTRACT_FIXNUM(*PortRev(port));
int rev = s48_extract_fixnum(*PortRev(port));
#ifdef NOISY_FDGC
fprintf(stderr, "GC'ing %srevealed port[fd] %d[%d]\n",
rev == 0 ? "un" : "",
@ -328,7 +328,7 @@ void post_gc_fdports(void)
/* Close, even if interrupted -- GC's must be atomic. */
while( EINTR == close_fdport(*Port_PortData(port)) );
fdports[fd] = SCHFALSE; /* Drop the port. */
fdports[fd] = S48_FALSE; /* Drop the port. */
}
}
}
@ -345,7 +345,7 @@ void post_gc_fdports(void)
** to POSIX spec, so we have to explicitly hack this case.
*/
static int read_stream_substring(scheme_value buf, int start, int end, FILE *f)
static int read_stream_substring(s48_value buf, int start, int end, FILE *f)
{
char *p = StrByte(buf,start);
int len = end-start;
@ -363,10 +363,10 @@ static int read_stream_substring(scheme_value buf, int start, int end, FILE *f)
#define MIN(a,b) (((a) < (b)) ? (a) : (b)) /* Not a function. */
int read_fdport_substring(scheme_value buf, int start, int end, scheme_value data)
int read_fdport_substring(s48_value buf, int start, int end, s48_value data)
{
scheme_value peek = *PortData_Peek(data);
FILE *f = fstar_cache[EXTRACT_FIXNUM(*PortData_Fd(data))];
s48_value peek = *PortData_Peek(data);
FILE *f = fstar_cache[s48_extract_fixnum(*PortData_Fd(data))];
clearerr(f); /* SunOS sux. */
@ -377,8 +377,8 @@ int read_fdport_substring(scheme_value buf, int start, int end, scheme_value dat
int len = end-start;
if( len > 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++;
}

41
scsh/flock.c
View File

@ -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 <stdio.h>
@ -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;
}

2
scsh/flock.scm
View File

@ -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)

38
scsh/jcontrol1.c
View File

@ -46,52 +46,52 @@ long int pending_signals = 0;
void scm_handle_sig(int sig) {pending_signals |= (1<<sig);}
scheme_value set_int_handler(int sig, scheme_value handler, int flags,
scheme_value *ohandler, int *oflags)
s48_value set_int_handler(int sig, s48_value handler, int flags,
s48_value *ohandler, int *oflags)
{
struct sigaction new, old;
sigemptyset(&new.sa_mask); /* WTF */
new.sa_flags = flags;
if( handler == SCHFALSE ) new.sa_handler = SIG_IGN;
else if( handler == SCHTRUE ) new.sa_handler = SIG_DFL;
if( handler == S48_FALSE ) new.sa_handler = SIG_IGN;
else if( handler == S48_TRUE ) new.sa_handler = SIG_DFL;
else {
new.sa_handler = scm_handle_sig;
/* Do other stuff. */
}
if( sigaction(sig, &new, &old) ) {
*ohandler = SCHFALSE;
return ENTER_FIXNUM(errno);
*ohandler = S48_FALSE;
return s48_enter_fixnum(errno);
}
*oflags = old.sa_flags;
/* if( old.sa_handler == SIG_IGN ) *ohandler = SCHFALSE;
else if( old.sa_handler == SIG_DFL ) *ohandler = SCHTRUE;
/* if( old.sa_handler == SIG_IGN ) *ohandler = S48_FALSE;
else if( old.sa_handler == SIG_DFL ) *ohandler = S48_TRUE;
else if( old.sa_handler == scm_handle_sig ) {
*ohandler = ENTER_FIXNUM(0); /* Fix later. */
*ohandler = s48_enter_fixnum(0); /* Fix later. */
}
else *ohandler = ENTER_FIXNUM(-1); /* Unknown signal handler. */
return SCHFALSE;
else *ohandler = s48_enter_fixnum(-1); /* Unknown signal handler. */
return S48_FALSE;
}
scheme_value get_int_handler(int signal, scheme_value *handler, int *flags)
s48_value get_int_handler(int signal, s48_value *handler, int *flags)
{
struct sigaction old;
if( sigaction(signal, NULL, &old) ) {
*handler = SCHFALSE;
return ENTER_FIXNUM(errno);
*handler = S48_FALSE;
return s48_enter_fixnum(errno);
}
*flags = old.sa_flags;
if( old.sa_handler == SIG_IGN ) *handler = SCHFALSE;
else if( old.sa_handler == SIG_DFL ) *handler = SCHTRUE;
if( old.sa_handler == SIG_IGN ) *handler = S48_FALSE;
else if( old.sa_handler == SIG_DFL ) *handler = S48_TRUE;
else if( old.sa_handler == scm_handle_sig ) {
*handler = ENTER_FIXNUM(0); /* Fix later. */
*handler = s48_enter_fixnum(0); /* Fix later. */
}
else *handler = ENTER_FIXNUM(-1); /* Unknown signal handler. */
return SCHFALSE;
else *handler = s48_enter_fixnum(-1); /* Unknown signal handler. */
return S48_FALSE;
}

2
scsh/jcontrol2.scm
View File

@ -9,7 +9,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)"
"" "")
;;; Fork off a process that runs in its own process group. The process is

13
scsh/machine/bufpol.scm Normal file
View File

@ -0,0 +1,13 @@
;;; Flags that control buffering policy.
;;; Copyright (c) 1993 by Olin Shivers.
;;; Copyright (c) 1995 by Brian D. Carlstrom.
;;; These are for the SET-PORT-BUFFERING procedure, essentially a Scheme
;;; analog of the setbuf(3S) stdio call. We use the actual stdio values.
;;; These constants are not likely to change from stdio lib to stdio lib,
;;; but you need to check when you do a port.
(define-enum-constants bufpol
(block 0) ; _IOFBF
(line 1) ; _IOLBF
(none 2)) ; _IONBF

133
scsh/machine/errno.scm Normal file
View File

@ -0,0 +1,133 @@
;;; Errno constant definitions.
;;; Copyright (c) 1993 by Olin Shivers.
;;; Copyright (c) 1994 by Brian D. Carlstrom.
;;; These are the correct values for BSD4.4-Lite-based systems
;;; such as NetBSD 1.0 and FreeBSD 2.0.
(define errno/2big 7) ; 2big is not a legit Scheme symbol. Lose, lose.
(define-enum-constants errno
;; POSIX:
(perm 1) ; Operation not permitted
(noent 2) ; No such file or directory
(srch 3) ; No such process
(intr 4) ; Interrupted function call
(io 5) ; Input/output error
(nxio 6) ; No such device or address
; (2big 7) ; Arg list too long
(noexec 8) ; Exec format error
(badf 9) ; Bad file descriptor
(child 10) ; No child processes
;; BSD4.4-Lite
(deadlk 11) ; Resource deadlock avoided
;; POSIX:
(nomem 12) ; Not enough space
(acces 13) ; Permission denied
(fault 14) ; Bad address
;; BSD4.4-Lite
(notblk 15) ; Block device required
;; POSIX
(busy 16) ; Resource busy
(exist 17) ; File exists
(xdev 18) ; Improper link
(nodev 19) ; No such device
(notdir 20) ; Not a directory
(isdir 21) ; Is a directory
(inval 22) ; Invalid argument
(nfile 23) ; Too many open files in system
(mfile 24) ; Too many open files
(notty 25) ; Inappropriate I/O control operation
;; BSD4.4-Lite
(txtbsy 26) ; Text file busy
;; POSIX
(fbig 27) ; File too large
(nospc 28) ; No space left on device
(spipe 29) ; Invalid seek
(rofs 30) ; Read-only file system
(mlink 31) ; Too many links
(pipe 32) ; Broken pipe
;; Strict ANSI
;; math software
(dom 33) ; Domain error
(range 34) ; Result too large
;; POSIX
(again 35) ; Resource temporarily unavaile (note overlap)
;; BSD4.4-Lite
;; non-blocking and interrupt i/o
(wouldblock 35) ; Operation would block
(inprogress 36) ; Operation now in progress
(already 37) ; Operation already in progress
;; ipc/network software
;; argument errors
(notsock 38) ; Socket operation on non-socket
(destaddrreq 39) ; Destination address required
(msgsize 40) ; Message too long
(prototype 41) ; Protocol wrong type for socket
(noprotoopt 42) ; Protocol not available
(protonosupport 43) ; Protocol not supported
(socktnosupport 44) ; Socket type not supported
(opnotsupp 45) ; Operation not supported on socket
(pfnosupport 46) ; Protocol family not supported
(afnosupport 47) ; Address family not supported by protocol family
(addrinuse 48) ; Address already in use
(addrnotavail 49) ; Can't assign requested address
;; operational errors
(netdown 50) ; Network is down
(netunreach 51) ; Network is unreachable
(netreset 52) ; Network dropped connection on reset
(connaborted 53) ; Software caused connection abort
(connreset 54) ; Connection reset by peer
(nobufs 55) ; No buffer space available
(isconn 56) ; Socket is already connected
(notconn 57) ; Socket is not connected
(shutdown 58) ; Can't send after socket shutdown
(toomanyrefs 59) ; Too many references: can't splice
(timedout 60) ; Connection timed out
(connrefused 61) ; Connection refused
(loop 62) ; Too many levels of symbolic links
;; POSIX:
(nametoolong 63) ; File name too long
;; BSD4.4-Lite
(hostdown 64) ; Host is down
(hostunreach 65) ; No route to host
;; POSIX:
(notempty 66) ; Directory not empty
;; BSD4.4-Lite
;; quotas & mush
(proclim 67) ; Too many processes
(users 68) ; Too many users
(dquot 69) ; Disc quota exceeded
;; Network File System
(stale 70) ; Stale NFS file handle
(remote 71) ; Too many levels of remote in path
(badrpc 72) ; RPC struct is bad
(rpcmismatch 73) ; RPC version wrong
(progunavail 74) ; RPC prog. not avail
(progmismatch 75) ; Program version wrong
(procunavail 76) ; Bad procedure for program
;; SystemV Record Locking
(nolck 77) ; No locks available
;; POSIX
(nosys 78) ; Function not implemented
;; BSD4.4-Lite
(ftype 79) ; Inappropriate file type or format
(auth 80) ; Authentication error
(needauth 81) ; Need authenticator
(last 81)) ; Must be equal largest errno

55
scsh/machine/fdflags.scm Normal file
View File

@ -0,0 +1,55 @@
;;; Flags for open(2) and fcntl(2).
;;; Copyright (c) 1993 by Olin Shivers.
;;; Copyright (c) 1994 by Brian D. Carlstrom
(define-enum-constants open
;; POSIX
(read #x0000)
(write #x0001)
(read+write #x0002)
(non-blocking #x0004) ; no delay
(append #x0008) ; set append mode
;; BSD4.4-Lite
(shared-lock #x0010) ; open with shared file lock
(exclusive-lock #x0020) ; open with exclusive file lock
(async #x0040) ; signal pgrep when data ready
(fsync #x0080) ; synchronus writes
;; POSIX
(create #x0200) ; create if nonexistant
(truncate #x0400) ; truncate to zero length
(exclusive #x0800) ; error if already exists
(no-control-tty #x0000)) ; don't assign controlling terminal
(define open/access-mask
(bitwise-ior open/read
(bitwise-ior open/write open/read+write)))
;;; fcntl() commands
(define-enum-constants fcntl
(dup-fdes 0) ; F_DUPFD
(get-fdes-flags 1) ; F_GETFD
(set-fdes-flags 2) ; F_SETFD
(get-status-flags 3) ; F_GETFL
(set-status-flags 4) ; F_SETFL
(get-owner 5) ; F_GETOWN (Not POSIX)
(set-owner 6) ; F_SETOWN (Not POSIX)
(get-record-lock 7) ; F_GETLK
(set-record-lock-no-block 8) ; F_SETLK
(set-record-lock 9)) ; F_SETLKW
;;; fcntl fdes-flags (F_GETFD)
(define fdflags/close-on-exec 1)
;;; fcntl status-flags (F_GETFL)
;;; Mostly, these are OPEN/... flags, like OPEN/APPEND.
;;; (define fdstatus/... ...)
;;; fcntl lock values.
(define-enum-constants lock
(read 1) ; F_RDLCK
(release 2) ; F_UNLCK
(write 3)) ; F_WRLCK

3
scsh/machine/libansi.c Normal file
View File

@ -0,0 +1,3 @@
/* OS-dependent support for what is supposed to be the standard ANSI C Library.
** Copyright (c) 1996 by Brian D. Carlstrom.
*/

139
scsh/machine/netconst.scm Normal file
View File

@ -0,0 +1,139 @@
;;; Magic Numbers for Networking
;;; Copyright (c) 1994 by Brian D. Carlstrom.
;;; magic numbers not from header file
;;; but from man page
;;; why can't unix make up its mind
(define shutdown/receives 0)
(define shutdown/sends 1)
(define shutdown/sends+receives 2)
;;;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
;;; BELOW THIS POINT ARE BITS FROM:
;;; <sys/socket.h>
;;; <sys/un.h>
;;; <netinet/in.h>
;;; <netinet/tcp.h>
;;; <netdb.h>
;;;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
;;; ADDRESS FAMILIES -- <sys/socket.h>
(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 -- <sys/socket.h>
(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 -- <sys/socket.h>
(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 -- <netinet/in.h>
(define internet-address/any #x00000000)
(define internet-address/loopback #x7f000001)
(define internet-address/broadcast #xffffffff) ; must be masked
;;; errors from host lookup -- <netdb.h>
(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 -- <sys/socket.h>
(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 -- <sys/socket.h>
(define level/socket #xffff) ; SOL_SOCKET: options for socket level
;;; socket options -- <sys/socket.h>
(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 -- <netinet/in.h>
(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 -- <netinet/tcp.h>
(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))

137
scsh/machine/packages.scm Normal file
View File

@ -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)

72
scsh/machine/signals.scm Normal file
View File

@ -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&LTOSTOP)
;; 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.

129
scsh/machine/signals1.c Normal file
View File

@ -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
*/

10
scsh/machine/sigset.h Normal file
View File

@ -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)))

83
scsh/machine/stdio_dep.c Normal file
View File

@ -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 <sys/types.h>
#include <sys/time.h>
#include <stdio.h>
#include <unistd.h>
#include "libcig.h"
#include <errno.h>
#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;}

13
scsh/machine/stdio_dep.h Normal file
View File

@ -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);

0
scsh/machine/sysdep.h Normal file
View File

8
scsh/machine/time_dep.scm Normal file
View File

@ -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

38
scsh/machine/time_dep1.c Normal file
View File

@ -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 <errno.h>
#include <sys/time.h>
#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;
}

220
scsh/machine/tty-consts.scm Normal file
View File

@ -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

40
scsh/machine/waitcodes.scm Normal file
View File

@ -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.

58
scsh/ndbm.c
View File

@ -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;
}

2
scsh/ndbm.scm
View File

@ -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)

2
scsh/ndbmo.c
View File

@ -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)

406
scsh/network.c
View File

@ -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 <stdio.h>
@ -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;
}

6
scsh/network.scm
View File

@ -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)"
"" )
;;;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-

59
scsh/network1.c
View File

@ -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);
}

30
scsh/network1.h
View File

@ -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);

18
scsh/nt2.c
View File

@ -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,
...)
{

2
scsh/procobj.scm
View File

@ -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]
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

41
scsh/rdelim.c
View File

@ -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 <stdio.h>
@ -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;
}

1
scsh/re.scm
View File

@ -57,6 +57,7 @@
static-string) ; Error msg or #f
;;; Executing compiled regexps
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

72
scsh/re1.c
View File

@ -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; i<NSUBEXP; i++) {
const char *s = r->startp[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; i<NSUBEXP; i++) {
scheme_value se = VECTOR_REF(start_vec, i);
scheme_value ee = VECTOR_REF(end_vec, i);
r->startp[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; i<NSUBEXP; i++) {
scheme_value se = VECTOR_REF(start_vec, i);
scheme_value ee = VECTOR_REF(end_vec, i);
r->startp[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; i<NSUBEXP; i++) {
const char *s = prog->startp[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;
}

8
scsh/re1.h
View File

@ -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);

2
scsh/scsh-package.scm
View File

@ -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
)

49
scsh/select.c
View File

@ -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 <stdio.h>
@ -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;
}

69
scsh/select1.c
View File

@ -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;
}

8
scsh/select1.h
View File

@ -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);

91
scsh/sighandlers.c
View File

@ -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 <stdio.h>
@ -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;
}

24
scsh/sighandlers1.c
View File

@ -8,6 +8,7 @@
#include <signal.h>
#include <stdio.h>
#include "cstuff.h"
#include <assert.h>
/* 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<<sig2int[sig]);
//JMG: Spending_interruptsS |= (1<<sig2int[sig]);
assert(1 == 0);
}
/* handler_code: 0 => 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;
}

6
scsh/sighandlers1.h
View File

@ -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);

8
scsh/sleep1.c
View File

@ -10,7 +10,7 @@
#endif
#include <unistd.h>
#include <time.h>
#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 */
}

977
scsh/syscalls.c
View File

File diff suppressed because it is too large Load Diff

44
scsh/syscalls.scm
View File

@ -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

82
scsh/syscalls1.c
View File

@ -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; i<argc; i++)
unix_argv[i] = cig_string_body(VECTOR_REF(argv,i));
unix_argv[i] = cig_string_body(S48_VECTOR_REF(argv,i));
unix_argv[argc] = NULL;
/* Scheme->Unix 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; j<envlen; j++)
unix_env[j] = cig_string_body(VECTOR_REF(env,j));
unix_env[j] = cig_string_body(S48_VECTOR_REF(env,j));
unix_env[envlen] = NULL;
}
execve(prog, unix_argv, unix_env); /* Do it. */
if( env != SCHTRUE ) {
if( env != S48_TRUE ) {
e = errno;
Free(unix_env);
errno = e;
@ -281,23 +281,23 @@ int cpu_clock_ticks_per_sec()
*/
/* Return a char, #f (EOF), or errno. */
scheme_value read_fdes_char(int fd)
s48_value read_fdes_char(int fd)
{
int i; char c;
if( (i=read(fd, &c, 1)) < 0 ) return ENTER_FIXNUM(errno);
if(i==0) return SCHFALSE;
return ENTER_CHAR(c);
if( (i=read(fd, &c, 1)) < 0 ) return s48_enter_fixnum(errno);
if(i==0) return S48_FALSE;
return s48_enter_char(c);
}
int write_fdes_char(char c, int fd) {return write(fd, &c, 1);}
int read_fdes_substring(scheme_value buf, int start, int end, int fd)
int read_fdes_substring(s48_value buf, int start, int end, int fd)
{
return read(fd, StrByte(buf,start), end-start);
}
int write_fdes_substring(scheme_value buf, int start, int end, int fd)
int write_fdes_substring(s48_value buf, int start, int end, int fd)
{
return write(fd, StrByte(buf,start), end-start);
}
@ -332,11 +332,11 @@ int write_fdes_substring(scheme_value buf, int start, int end, int fd)
*/
/* Internal aux function -- loads stat values into Scheme vector: */
static int really_stat(int retval, struct stat *s, scheme_value vec)
static int really_stat(int retval, struct stat *s, s48_value vec)
{
int modes, typecode = -1;
if( 14 != VECTOR_LENGTH(vec) ) return -1;
if( 14 != S48_VECTOR_LENGTH(vec) ) return -1;
if( retval < 0 ) return errno;
modes = s->st_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<envsize; i++ ) {
char *s = scheme2c_strcpy(VECTOR_REF(vec,i));
char *s = scheme2c_strcpy(S48_VECTOR_REF(vec,i));
if (!s) {
/* Return all the memory and bail out. */
int e = errno;

22
scsh/syscalls1.h
View File

@ -1,8 +1,8 @@
/* Exports from syscalls1.c. */
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);
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 scheme_pipe(int *r, int *w);
@ -18,31 +18,31 @@ int process_times(int *utime, int *stime, int *cutime, int *cstime);
int cpu_clock_ticks_per_sec();
scheme_value read_fdes_char(int fd);
s48_value read_fdes_char(int fd);
int write_fdes_char(char c, int fd);
int read_fdes_substring(scheme_value buf, int start, int end, int fd);
int read_fdes_substring(s48_value buf, int start, int end, int fd);
int read_stream_substring(scheme_value buf, int start, int end, FILE *f);
int read_stream_substring(s48_value buf, int start, int end, FILE *f);
int write_fdes_substring(scheme_value buf, int start, int end, int fd);
int write_fdes_substring(s48_value buf, int start, int end, int fd);
int write_stream_substring(scheme_value buf, int start, int end, FILE *f);
int write_stream_substring(s48_value buf, int start, int end, FILE *f);
int scheme_stat(const char *path, scheme_value vec, int chase_p);
int scheme_stat(const char *path, s48_value vec, int chase_p);
int scheme_fstat(int fd, scheme_value vec);
int scheme_fstat(int fd, s48_value vec);
int num_supp_groups(void);
int get_groups(scheme_value gvec);
int get_groups(s48_value gvec);
int put_env(const char *s);
char** scm_envvec(int *len);
int install_env(scheme_value vec);
int install_env(s48_value vec);
void delete_env(const char *var);

118
scsh/time.c
View File

@ -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 <stdio.h>
@ -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;
}

66
scsh/time1.c
View File

@ -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);
}
}

14
scsh/time1.h
View File

@ -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);

169
scsh/tty.c
View File

@ -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 <stdio.h>
@ -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;
}

4
scsh/tty.scm
View File

@ -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))"
"" )