void osdep_lseekfile( word w_fd, word w_offset, word w_whence )
{
int fd = nativeint( w_fd );
off_t offset = nativeint( w_offset );
int whence_code = nativeint( w_whence );
off_t whence;
FILE *fp;
int res;
if ( whence_code == 0 )
whence = SEEK_SET;
else if ( whence_code == 1 )
whence = SEEK_CUR;
else if ( whence_code == 2 )
whence = SEEK_END;
else assert( 0 );
#ifdef USE_STDIO
check_standard_filedes();
#endif
assert( fd >= 0 && fd < num_fds );
if (fdarray[fd].fp == 0) {
globals[ G_RESULT ] = fixnum(-1);
return;
}
fp = fdarray[fd].fp;
res = fseek( fp, offset, whence );
globals[G_RESULT]= fixnum(res);
}
void osdep_readfile( word w_fd, word w_buf, word w_cnt )
{
int fd = nativeint( w_fd );
FILE *fp;
char *buf, *resp;
size_t nbytes, res;
#ifdef USE_STDIO
check_standard_filedes();
#endif
assert( fd >= 0 && fd < num_fds );
if (fdarray[fd].fp == 0) {
globals[ G_RESULT ] = fixnum(-1);
return;
}
fp = fdarray[fd].fp;
buf = string_data(w_buf);
nbytes = nativeint(w_cnt);
if ((fdarray[fd].mode & (MODE_TEXT|MODE_INTERMITTENT)) == (MODE_TEXT|MODE_INTERMITTENT))
{
// On some platforms, certainly Win32, fread() is not line buffered on stdin.
resp = fgets( buf, nbytes, fp );
res = (resp == 0 ? 0 : strlen(buf));
}
else
res = fread( buf, 1, nbytes, fp );
if (res == 0 && ferror(fp))
globals[G_RESULT] = fixnum(-1);
else
globals[G_RESULT]= fixnum(res);
}
void osdep_writefile( word w_fd, word w_buf, word w_cnt, word w_offset )
{
int fd = nativeint( w_fd );
FILE *fp;
char *buf;
size_t nbytes, res, offset;
#ifdef USE_STDIO
check_standard_filedes();
#endif
assert( fd >= 0 && fd < num_fds );
if (fdarray[fd].fp == 0) {
globals[ G_RESULT ] = fixnum(-1);
return;
}
fp = fdarray[fd].fp;
buf = string_data(w_buf);
nbytes = nativeint(w_cnt);
offset = nativeint(w_offset);
res = fwrite( buf+offset, 1, nbytes, fp );
if (res < nbytes && ferror(fp))
globals[G_RESULT] = fixnum(-1);
else
globals[G_RESULT] = fixnum(res);
fflush(fp); /* Larceny does its own buffering. */
}
/* Syscall primitive.
*
* RESULT has number of arguments.
* R1 has index of primitive to call.
* Arguments are in R2 .. R31.
*/
void C_syscall( void )
{
int nargs, nproc;
/* Do not set in_noninterruptible_syscall here because that is
taken care of by the machinery in larceny_syscall.
*/
nargs = nativeint( globals[ G_RESULT ] )-1;
nproc = nativeint( globals[ G_REG1 ] );
larceny_syscall( nargs, nproc, &globals[ G_REG2 ] );
}
/* C-language exception handler (called from exception.s)
* This code is called *only* when a Scheme exception handler is not present.
*/
void C_exception( word i, word pc )
{
hardconsolemsg( "Larceny exception at PC=0x%08x: %d.", pc, nativeint(i) );
in_noninterruptible_syscall = 1;
localdebugger();
in_noninterruptible_syscall = 0;
}
void osdep_openfile( word w_fn, word w_flags, word w_mode )
{
char *fn = string2asciiz( w_fn );
int i, flags = nativeint( w_flags );
char newflags[5];
char *p = newflags;
int mode = 0;
FILE *fp;
#ifdef USE_STDIO
check_standard_filedes();
#endif
/* This is a real thin pipe for the semantics ... */
if (flags & 0x01) { *p++ = 'r'; mode |= MODE_READ; }
if (flags & 0x02) { *p++ = 'w'; mode |= MODE_WRITE; }
if (flags & 0x04) *p++ = '+';
if (flags & 0x20) { *p++ = 'b'; mode |= MODE_BINARY; }
*p = '\0';
if (!(mode & MODE_BINARY))
mode |= MODE_TEXT;
if (fn == 0) {
globals[ G_RESULT ] = fixnum( -1 );
return;
}
fp = fopen( fn, newflags );
if (fp == NULL) {
globals[ G_RESULT ] = fixnum( -1 );
return;
}
/* Now register the file and return the table index. */
for ( i=0 ; i < num_fds && fdarray[i].fp != 0 ; i++ )
;
if (i == num_fds) {
int n = max(2*num_fds,5);
struct finfo *narray = (struct finfo*)must_malloc( sizeof(struct finfo)*n );
if (fdarray != 0)
memcpy( narray, fdarray, sizeof(struct finfo)*num_fds );
for ( i=num_fds ; i < n ; i++ )
{
narray[i].fp = 0;
narray[i].mode = 0;
}
i = num_fds;
num_fds = n;
if (fdarray != 0)
free( fdarray );
fdarray = narray;
}
fdarray[i].fp = fp;
fdarray[i].mode = mode;
globals[ G_RESULT ] = fixnum(i);
}
/* C_allocate: allocate heap memory */
void C_allocate( word request_words )
{
supremely_annoyingmsg( "Allocation call-out from millicode." );
/* The assignment to G_RESULT violates the VM invariants because an
untagged pointer to memory is being stored in a root. That's OK,
because the millicode will fix the problem before anyone gets to
see the pointer.
*/
in_noninterruptible_syscall = 1;
globals[ G_RESULT ] =
(word)alloc_from_heap( nativeint( request_words )*sizeof(word) );
in_noninterruptible_syscall = 0;
}
int stk_size_for_top_stack_frame( word *globals )
{
#if OLD_GC_CODE
return
nativeint( *(word*)globals[ G_STKP ] )*sizeof( word ) + STACK_BASE_SIZE;
#else
int frame_size;
if (globals[ G_STKP ] == globals[ G_STKBOT])
frame_size = sizefield( *ptrof( globals[ G_CONT ] ) );
else
frame_size = *((word*)globals[ G_STKP ] + STK_CONTSIZE);
return roundup8( frame_size + 4 ) + STACK_BASE_SIZE;
#endif
}
void osdep_closefile( word w_fd )
{
int fd = nativeint( w_fd );
#ifdef USE_STDIO
check_standard_filedes();
#endif
assert( fd >= 0 && fd < num_fds );
if (fdarray[fd].fp == 0)
globals[ G_RESULT ] = fixnum(-1);
else if (fclose( fdarray[fd].fp ) == EOF)
globals[ G_RESULT ] = fixnum(-1);
else
globals[ G_RESULT ] = fixnum(0);
fdarray[fd].fp = 0;
fdarray[fd].mode = 0;
}
/* Single stepping. Takes a fixnum argument which is the constant vector
* index at which to find a string. G_REG0 must be valid.
*/
void C_singlestep( word cidx )
{
char buf[ 300 ];
int l;
word s;
word constvec;
in_noninterruptible_syscall = 1;
constvec = *( ptrof( globals[G_REG0] ) + 2 );
s = *( ptrof( constvec ) + VEC_HEADER_WORDS + nativeint(cidx) );
if (tagof( s ) != BVEC_TAG)
panic_exit( "Internal: Bad arg to C_singlestep().\n" );
l = string_length( s );
strncpy( buf, string_data( s ), min( l, sizeof( buf )-1 ) );
buf[ l ] = 0;
hardconsolemsg( "Step: %s", buf );
localdebugger();
in_noninterruptible_syscall = 0;
}
void C_varargs( void )
{
word j = nativeint( globals[ G_RESULT ] );
word n = nativeint( globals[ G_ARGREG2 ] );
word r = 31; /* Highest register # */
word *p, *first, *prev, t;
word k, limit;
word bytes;
#if !defined(BDW_GC)
word *allocptr;
#endif
in_noninterruptible_syscall = 1;
bytes = sizeof(word)*(2*(j-n));
if (bytes == 0) {
globals[ G_REG0 + n + 1 ] = NIL_CONST;
in_noninterruptible_syscall = 0;
return;
}
/* At least one vararg to cons up. */
/* Optimized allocation for precise GC; conservative GC calls
allocator each time.
*/
#if !defined(BDW_GC)
allocptr = (word*)alloc_from_heap( bytes );
# define alloc_one_pair(p) (p = allocptr, allocptr+=2)
#else
# define alloc_one_pair(p) (p = (word*)alloc_from_heap(2*sizeof(word)) )
#endif
first = prev = 0;
k = n+1;
limit = min( j, r-1 );
while (k <= limit ) {
alloc_one_pair(p);
*p = globals[ G_REG0 + k ];
if (prev)
*(prev+1) = tagptr( p, PAIR_TAG );
else
first = p;
prev = p;
k++;
}
/* Copy the list in t into the memory pointed to by p. */
if (j >= r) {
t = globals[ G_REG0 + r ];
while (t != NIL_CONST) {
alloc_one_pair(p);
*p = pair_car( t );
if (prev)
*(prev+1) = tagptr( p, PAIR_TAG );
else
first = p;
prev = p;
t = pair_cdr( t );
}
}
*(prev+1) = NIL_CONST;
globals[ G_REG0+n+1 ] = tagptr( first, PAIR_TAG );
in_noninterruptible_syscall = 0;
}
