void larceny_call( word proc, int argc, word *argv, word *result )
{
int i, fresh_stack;
word *p;
/* Allocate and setup a stack frame */
if ((globals[ G_STKP ]-SCE_BUFFER)-FRAMESIZE < globals[ G_ETOP ]) {
hardconsolemsg( "Callback failed -- stack overflow." );
/* Fixme: need to indicate error */
/* Fixme: in general, we must recover from this problem! */
*result = UNDEFINED_CONST;
return;
}
fresh_stack = globals[ G_STKP ] == globals[ G_STKBOT ];
globals[ G_STKP ] -= FRAMESIZE;
p = (word*)globals[ G_STKP ];
p[STK_CONTSIZE] = 5*sizeof(word); /* size in bytes */
p[STK_RETADDR] = 0; /* return address -- set by scheme_start() */
if (fresh_stack)
p[STK_DYNLINK] = globals[ G_CONT ]; /* dynamic link */
else
p[STK_DYNLINK] = 0; /* random */
p[STK_PROC] = 0; /* procedure pointer (fixed) */
p[4] = globals[ G_REG0 ];
p[5] = globals[ G_RETADDR ];
/* Setup arguments in registers -- this gcprotects them */
globals[ G_REG0 ] = proc;
for ( i=0 ; i < argc ; i++ ) /* FIXME: guard against argc > #regs */
globals[ G_REG1+i ] = argv[i];
globals[ G_RESULT ] = fixnum(argc);
/* Check the type and invoke the procedure */
if (tagof( globals[ G_REG0 ] ) != PROC_TAG) {
hardconsolemsg( "Callback failed -- not a procedure." );
/* Fixme: need to indicate error */
*result = UNDEFINED_CONST;
return;
}
scheme_start( globals );
*result = globals[ G_RESULT ];
/* Pop the frame */
p = (word*)globals[ G_STKP ];
globals[ G_REG0 ] = p[4];
globals[ G_RETADDR ] = p[5];
globals[ G_STKP ] += FRAMESIZE;
}
word
osdep_dlopen( char *path )
{
#ifdef DYNAMIC_LOADING
HINSTANCE dll;
dll = LoadLibrary(path);
if (dll == 0)
hardconsolemsg( "dlopen error" );
return (word)dll;
#else
hardconsolemsg( "Larceny configured without DYNAMIC_LOADING" );
return 0;
#endif
}
/* 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;
}
word
osdep_dlopen( char *path )
{
#ifndef DYNAMIC_LOADING
hardconsolemsg( "Larceny configured without DYNAMIC_LOADING" );
#endif
return 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;
}
