/* _call-with-values */
obj_t BGl__callzd2withzd2valuesz00zz__r5_control_features_6_4z00(obj_t
BgL_envz00_913, obj_t BgL_producerz00_914, obj_t BgL_consumerz00_915)
{
AN_OBJECT;
{ /* Ieee/control5.scm 117 */
{ /* Ieee/control5.scm 278 */
obj_t BgL_auxz00_1420;
obj_t BgL_auxz00_1413;
if (PROCEDUREP(BgL_consumerz00_915))
{ /* Ieee/control5.scm 278 */
BgL_auxz00_1420 = BgL_consumerz00_915;
}
else
{
obj_t BgL_auxz00_1423;
BgL_auxz00_1423 =
BGl_typezd2errorzd2zz__errorz00
(BGl_string1520z00zz__r5_control_features_6_4z00,
BINT(((long) 8393)),
BGl_string1525z00zz__r5_control_features_6_4z00,
BGl_string1526z00zz__r5_control_features_6_4z00,
BgL_consumerz00_915);
FAILURE(BgL_auxz00_1423, BFALSE, BFALSE);
}
if (PROCEDUREP(BgL_producerz00_914))
{ /* Ieee/control5.scm 278 */
BgL_auxz00_1413 = BgL_producerz00_914;
}
else
{
obj_t BgL_auxz00_1416;
BgL_auxz00_1416 =
BGl_typezd2errorzd2zz__errorz00
(BGl_string1520z00zz__r5_control_features_6_4z00,
BINT(((long) 8393)),
BGl_string1525z00zz__r5_control_features_6_4z00,
BGl_string1526z00zz__r5_control_features_6_4z00,
BgL_producerz00_914);
FAILURE(BgL_auxz00_1416, BFALSE, BFALSE);
}
return
BGl_callzd2withzd2valuesz00zz__r5_control_features_6_4z00
(BgL_auxz00_1413, BgL_auxz00_1420);
}
}
}
/* <anonymous:1883> */
obj_t BGl_zc3anonymousza31883ze3z83zz__modulez00(obj_t BgL_envz00_1642)
{ AN_OBJECT;
{ /* Llib/module.scm 94 */
{ /* Llib/module.scm 95 */
obj_t BgL_resolvez00_1643;
BgL_resolvez00_1643 =
PROCEDURE_REF(BgL_envz00_1642,
(int)(((long)0)));
{
{ /* Llib/module.scm 95 */
bool_t BgL_testz00_1821;
if(
PROCEDUREP(BgL_resolvez00_1643))
{ /* Llib/module.scm 95 */
BgL_testz00_1821 =
PROCEDURE_CORRECT_ARITYP(BgL_resolvez00_1643,
(int)(((long)2)))
; } else
{ /* Llib/module.scm 95 */
BgL_testz00_1821 = ((bool_t)0)
; }
if(BgL_testz00_1821)
{ /* Llib/module.scm 95 */
return (
BGl_z52bigloozd2modulezd2resolverz52zz__modulez00 = BgL_resolvez00_1643, BUNSPEC) ;} else
{ /* Llib/module.scm 95 */
return
BGl_errorz00zz__errorz00(BGl_symbol2334z00zz__modulez00, BGl_string2336z00zz__modulez00, BgL_resolvez00_1643);} } } } }
}
/*=======================================
R5RS : 6.4 Control Features
=======================================*/
SCM_EXPORT ScmObj
scm_p_procedurep(ScmObj obj)
{
DECLARE_FUNCTION("procedure?", procedure_fixed_1);
return MAKE_BOOL(PROCEDUREP(obj));
}
/*---------------------------------------------------------------------*/
obj_t
bgl_signal( int sig, obj_t obj ) {
BGL_MUTEX_LOCK( signal_mutex );
/* store the obj in the signal table */
BGL_SIG_HANDLERS()[ sig ] = obj;
if( PROCEDUREP( obj ) ) {
#if HAVE_SIGACTION
{
struct sigaction sigact;
sigemptyset( &(sigact.sa_mask) );
sigact.sa_handler = (void (*)( int ))signal_handler;
sigact.sa_flags = SA_RESTART;
/* #if HAVE_SIGPROCMASK */
/* sigset_t mask; */
/* */
/* sigemptyset( &mask ); */
/* sigaddset( &mask, sig ); */
/* bgl_sigprocmask( SIG_UNBLOCK, &mask, 0 ); */
/* #endif */
if( sig == SIGSEGV ) {
/* create an alternate stack for SEGV */
sigact.sa_flags |= SA_ONSTACK;
stack_t ss;
ss.ss_flags = 0L;
ss.ss_sp = malloc( SIGSTKSZ );
ss.ss_size = SIGSTKSZ;
sigaltstack( &ss, 0L );
}
sigaction( sig, &sigact, NULL );
}
#else
signal( (int)sig, (void (*)( int ))signal_handler );
#endif
} else {
if( obj == BTRUE ) {
signal( (int)sig, SIG_IGN );
} else {
if( obj == BFALSE ) {
signal( (int)sig, SIG_DFL );
}
}
}
BGL_MUTEX_UNLOCK( signal_mutex );
return BUNSPEC;
}
/* _declare-tvector! */
obj_t BGl__declarezd2tvectorz12zc0zz__tvectorz00(obj_t BgL_envz00_1640,
obj_t BgL_idz00_1641, obj_t BgL_allocatez00_1642, obj_t BgL_refz00_1643,
obj_t BgL_setz00_1644)
{
AN_OBJECT;
{ /* Llib/tvector.scm 139 */
{ /* Llib/tvector.scm 140 */
obj_t BgL_auxz00_1782;
char *BgL_auxz00_1773;
if (PROCEDUREP(BgL_allocatez00_1642))
{ /* Llib/tvector.scm 140 */
BgL_auxz00_1782 = BgL_allocatez00_1642;
}
else
{
obj_t BgL_auxz00_1785;
BgL_auxz00_1785 =
BGl_typezd2errorzd2zz__errorz00(BGl_string2198z00zz__tvectorz00,
BINT(((long) 5745)), BGl_string2210z00zz__tvectorz00,
BGl_string2212z00zz__tvectorz00, BgL_allocatez00_1642);
FAILURE(BgL_auxz00_1785, BFALSE, BFALSE);
}
{ /* Llib/tvector.scm 140 */
obj_t BgL_auxz00_1774;
if (STRINGP(BgL_idz00_1641))
{ /* Llib/tvector.scm 140 */
BgL_auxz00_1774 = BgL_idz00_1641;
}
else
{
obj_t BgL_auxz00_1777;
BgL_auxz00_1777 =
BGl_typezd2errorzd2zz__errorz00(BGl_string2198z00zz__tvectorz00,
BINT(((long) 5745)), BGl_string2210z00zz__tvectorz00,
BGl_string2211z00zz__tvectorz00, BgL_idz00_1641);
FAILURE(BgL_auxz00_1777, BFALSE, BFALSE);
}
BgL_auxz00_1773 = BSTRING_TO_STRING(BgL_auxz00_1774);
}
return
BGl_declarezd2tvectorz12zc0zz__tvectorz00(BgL_auxz00_1773,
BgL_auxz00_1782, BgL_refz00_1643, BgL_setz00_1644);
}
}
}
lref_t liset_trap_handler(lref_t trap_id, lref_t new_handler)
{
if (!PROCEDUREP(new_handler))
vmerror_wrong_type_n(2, new_handler);
size_t tid = get_trap_id(trap_id);
interp.trap_handlers[tid] = new_handler;
dscwritef(DF_SHOW_TRAPS,
(_T("; DEBUG: set-trap-handler : ~cS := ~s\n"),
trap_type_name((enum trap_type_t)tid), new_handler));
return new_handler;
}
/*---------------------------------------------------------------------*/
static obj_t
signal_handler( int num ) {
obj_t handler = BGL_SIG_HANDLERS()[ num ];
/* Re-install the signal handler because some OS (such as Solaris) */
/* de-install it when the signal is raised. */
#if !HAVE_SIGACTION
signal( num, (void (*)(int))(signal_handler) );
#endif
if( PROCEDUREP( handler ) ) {
return ((obj_t (*)())PROCEDURE_ENTRY(handler))( handler, BINT( num ), BEOA );
} else {
return BUNSPEC;
}
}
/* bigloo-module-resolver */
BGL_EXPORTED_DEF obj_t BGl_bigloozd2modulezd2resolverz00zz__modulez00()
{ AN_OBJECT;
{ /* Llib/module.scm 89 */
{ /* Llib/module.scm 89 */
obj_t BgL_aux2261z00_1673;
BgL_aux2261z00_1673 = BGl_z52bigloozd2modulezd2resolverz52zz__modulez00;
if(
PROCEDUREP(BgL_aux2261z00_1673))
{ /* Llib/module.scm 89 */
return BgL_aux2261z00_1673;} else
{
obj_t BgL_auxz00_1800;
BgL_auxz00_1800 =
BGl_typezd2errorzd2zz__errorz00(BGl_string2330z00zz__modulez00,
BINT(((long)3397)), BGl_string2331z00zz__modulez00, BGl_string2332z00zz__modulez00, BgL_aux2261z00_1673);
FAILURE(BgL_auxz00_1800,BFALSE,BFALSE);} } }
}
/* _bigloo-module-resolver-set! */
obj_t BGl__bigloozd2modulezd2resolverzd2setz12zc0zz__modulez00(obj_t BgL_envz00_1640, obj_t BgL_resolvez00_1641)
{ AN_OBJECT;
{ /* Llib/module.scm 92 */
{ /* Llib/module.scm 95 */
obj_t BgL_auxz00_1811;
if(
PROCEDUREP(BgL_resolvez00_1641))
{ /* Llib/module.scm 95 */
BgL_auxz00_1811 = BgL_resolvez00_1641
; } else
{
obj_t BgL_auxz00_1814;
BgL_auxz00_1814 =
BGl_typezd2errorzd2zz__errorz00(BGl_string2330z00zz__modulez00,
BINT(((long)3552)), BGl_string2333z00zz__modulez00, BGl_string2332z00zz__modulez00, BgL_resolvez00_1641);
FAILURE(BgL_auxz00_1814,BFALSE,BFALSE);}
return
BGl_bigloozd2modulezd2resolverzd2setz12zc0zz__modulez00(BgL_auxz00_1811);} }
}
lref_t vmtrap(enum trap_type_t trap, enum vmt_options_t options, size_t argc, ...)
{
assert((trap > 0) && (trap <= TRAP_LAST));
assert(argc < ARG_BUF_LEN);
dscwritef(DF_SHOW_TRAPS, (_T("; DEBUG: trap : ~cS\n"),
trap_type_name(trap)));
lref_t handler = interp.trap_handlers[trap];
if (!PROCEDUREP(handler))
{
if(!NULLP(handler))
vmtrap_panic(trap, "bad trap handler");
if (!(options & VMT_OPTIONAL_TRAP))
vmtrap_panic(trap, "missing trap handler");
return NIL;
}
lref_t retval = NIL;
va_list args;
va_start(args, argc);
lref_t argv[ARG_BUF_LEN];
argv[0] = fixcons(trap);
argv[1] = fixcons((fixnum_t)CURRENT_TIB()->frame);
for (size_t ii = 2; ii < argc + 2; ii++)
argv[ii] = va_arg(args, lref_t);
va_end(args);
retval = apply1(handler, argc + 2, argv);
if (options & VMT_HANDLER_MUST_ESCAPE)
vmtrap_panic(trap, "trap handler must escape");
return retval;
}
lref_t lapply(size_t argc, lref_t argv[])
{
size_t fn_argc = 0;
lref_t fn_argv[ARG_BUF_LEN];
lref_t fn = (argc > 0) ? argv[0] : NIL;
if (!PROCEDUREP(fn))
vmerror_wrong_type_n(1, fn);
for (size_t ii = 1; ii < argc - 1; ii++)
{
if (fn_argc >= ARG_BUF_LEN)
break;
fn_argv[fn_argc] = argv[ii];
fn_argc++;
}
lref_t args = (argc > 1) ? argv[argc - 1] : NIL;
while (CONSP(args))
{
if (fn_argc >= ARG_BUF_LEN)
break;
fn_argv[fn_argc] = CAR(args);
fn_argc++;
args = CDR(args);
}
if (fn_argc >= ARG_BUF_LEN)
vmerror_unsupported(_T("too many actual arguments in call to apply"));
if (!NULLP(args))
vmerror_arg_out_of_range(args, _T("bad formal argument list"));
return apply1(fn, fn_argc, fn_argv);
}
lref_t ltime_apply0(lref_t fn)
{
if (!PROCEDUREP(fn))
vmerror_wrong_type_n(1, fn);
flonum_t t = sys_runtime();
flonum_t gc_t = interp.gc_total_run_time;
size_t cells = interp.gc_total_cells_allocated;
size_t fops = CURRENT_TIB()->count_fop;
size_t frames = CURRENT_TIB()->count_enter_frame;
lref_t argv[6];
argv[0] = apply1(fn, 0, NULL);
argv[1] = flocons(sys_runtime() - t);
argv[2] = flocons(interp.gc_total_run_time - gc_t);
argv[3] = fixcons(interp.gc_total_cells_allocated - cells);
argv[4] = fixcons(CURRENT_TIB()->count_fop - fops);
argv[5] = fixcons(CURRENT_TIB()->count_enter_frame - frames);
return lvector(6, argv);
}
/* tvector->vector */
BGL_EXPORTED_DEF obj_t BGl_tvectorzd2ze3vectorz31zz__tvectorz00(obj_t
BgL_tvz00_32)
{
AN_OBJECT;
{ /* Llib/tvector.scm 208 */
{ /* Llib/tvector.scm 209 */
obj_t BgL_descrz00_828;
BgL_descrz00_828 = TVECTOR_DESCR(BgL_tvz00_32);
{ /* Llib/tvector.scm 210 */
obj_t BgL_refz00_830;
BgL_refz00_830 = STRUCT_REF(BgL_descrz00_828, (int) (((long) 2)));
if (PROCEDUREP(BgL_refz00_830))
{ /* Llib/tvector.scm 216 */
int BgL_lenz00_832;
BgL_lenz00_832 = TVECTOR_LENGTH(BgL_tvz00_32);
{ /* Llib/tvector.scm 216 */
obj_t BgL_vecz00_833;
BgL_vecz00_833 = create_vector(BgL_lenz00_832);
{ /* Llib/tvector.scm 217 */
{ /* Llib/tvector.scm 218 */
long BgL_g1826z00_834;
BgL_g1826z00_834 = ((long) (BgL_lenz00_832) - ((long) 1));
{
long BgL_iz00_836;
BgL_iz00_836 = BgL_g1826z00_834;
BgL_zc3anonymousza31917ze3z83_837:
if ((BgL_iz00_836 == ((long) -1)))
{ /* Llib/tvector.scm 219 */
return BgL_vecz00_833;
}
else
{ /* Llib/tvector.scm 219 */
{ /* Llib/tvector.scm 222 */
obj_t BgL_arg1919z00_839;
BgL_arg1919z00_839 =
PROCEDURE_ENTRY(BgL_refz00_830) (BgL_refz00_830,
BgL_tvz00_32, BINT(BgL_iz00_836), BEOA);
VECTOR_SET(BgL_vecz00_833, (int) (BgL_iz00_836),
BgL_arg1919z00_839);
}
{
long BgL_iz00_1910;
BgL_iz00_1910 = (BgL_iz00_836 - ((long) 1));
BgL_iz00_836 = BgL_iz00_1910;
goto BgL_zc3anonymousza31917ze3z83_837;
}
}
}
}
}
}
}
else
{ /* Llib/tvector.scm 212 */
return
BGl_errorz00zz__errorz00(BGl_string2222z00zz__tvectorz00,
BGl_string2215z00zz__tvectorz00, STRUCT_REF(BgL_descrz00_828,
(int) (((long) 0))));
}}}}
}
/* vector->tvector */
BGL_EXPORTED_DEF obj_t BGl_vectorzd2ze3tvectorz31zz__tvectorz00(obj_t
BgL_idz00_30, obj_t BgL_vz00_31)
{
AN_OBJECT;
{ /* Llib/tvector.scm 186 */
{ /* Llib/tvector.scm 187 */
obj_t BgL_descrz00_814;
if (PAIRP(BGl_za2tvectorzd2tableza2zd2zz__tvectorz00))
{ /* Llib/tvector.scm 187 */
obj_t BgL_cellz00_1428;
BgL_cellz00_1428 =
BGl_assqz00zz__r4_pairs_and_lists_6_3z00(BgL_idz00_30,
BGl_za2tvectorzd2tableza2zd2zz__tvectorz00);
if (PAIRP(BgL_cellz00_1428))
{ /* Llib/tvector.scm 187 */
BgL_descrz00_814 = CDR(BgL_cellz00_1428);
}
else
{ /* Llib/tvector.scm 187 */
BgL_descrz00_814 = BFALSE;
}
}
else
{ /* Llib/tvector.scm 187 */
BgL_descrz00_814 = BFALSE;
}
if (CBOOL(BgL_descrz00_814))
{ /* Llib/tvector.scm 190 */
obj_t BgL_allocatez00_815;
obj_t BgL_setz00_816;
BgL_allocatez00_815 =
STRUCT_REF(BgL_descrz00_814, (int) (((long) 1)));
BgL_setz00_816 = STRUCT_REF(BgL_descrz00_814, (int) (((long) 3)));
if (PROCEDUREP(BgL_setz00_816))
{ /* Llib/tvector.scm 196 */
int BgL_lenz00_818;
BgL_lenz00_818 = VECTOR_LENGTH(BgL_vz00_31);
{ /* Llib/tvector.scm 196 */
obj_t BgL_tvecz00_819;
BgL_tvecz00_819 =
PROCEDURE_ENTRY(BgL_allocatez00_815) (BgL_allocatez00_815,
BINT(BgL_lenz00_818), BEOA);
{ /* Llib/tvector.scm 197 */
{ /* Llib/tvector.scm 198 */
long BgL_g1825z00_820;
BgL_g1825z00_820 = ((long) (BgL_lenz00_818) - ((long) 1));
{
long BgL_iz00_822;
BgL_iz00_822 = BgL_g1825z00_820;
BgL_zc3anonymousza31911ze3z83_823:
if ((BgL_iz00_822 == ((long) -1)))
{ /* Llib/tvector.scm 199 */
return BgL_tvecz00_819;
}
else
{ /* Llib/tvector.scm 199 */
{ /* Llib/tvector.scm 202 */
obj_t BgL_arg1914z00_825;
BgL_arg1914z00_825 =
VECTOR_REF(BgL_vz00_31, (int) (BgL_iz00_822));
PROCEDURE_ENTRY(BgL_setz00_816) (BgL_setz00_816,
BgL_tvecz00_819, BINT(BgL_iz00_822),
BgL_arg1914z00_825, BEOA);
}
{
long BgL_iz00_1875;
BgL_iz00_1875 = (BgL_iz00_822 - ((long) 1));
BgL_iz00_822 = BgL_iz00_1875;
goto BgL_zc3anonymousza31911ze3z83_823;
}
}
}
}
}
}
}
else
{ /* Llib/tvector.scm 192 */
return
BGl_errorz00zz__errorz00(BGl_string2219z00zz__tvectorz00,
BGl_string2215z00zz__tvectorz00, BgL_idz00_30);
}
}
else
{ /* Llib/tvector.scm 188 */
return
BGl_errorz00zz__errorz00(BGl_string2219z00zz__tvectorz00,
BGl_string2216z00zz__tvectorz00, BgL_idz00_30);
}
}
}
}
/* list->tvector */
BGL_EXPORTED_DEF obj_t BGl_listzd2ze3tvectorz31zz__tvectorz00(obj_t
BgL_idz00_28, obj_t BgL_lz00_29)
{
AN_OBJECT;
{ /* Llib/tvector.scm 163 */
{ /* Llib/tvector.scm 164 */
obj_t BgL_descrz00_799;
if (PAIRP(BGl_za2tvectorzd2tableza2zd2zz__tvectorz00))
{ /* Llib/tvector.scm 164 */
obj_t BgL_cellz00_1378;
BgL_cellz00_1378 =
BGl_assqz00zz__r4_pairs_and_lists_6_3z00(BgL_idz00_28,
BGl_za2tvectorzd2tableza2zd2zz__tvectorz00);
if (PAIRP(BgL_cellz00_1378))
{ /* Llib/tvector.scm 164 */
BgL_descrz00_799 = CDR(BgL_cellz00_1378);
}
else
{ /* Llib/tvector.scm 164 */
BgL_descrz00_799 = BFALSE;
}
}
else
{ /* Llib/tvector.scm 164 */
BgL_descrz00_799 = BFALSE;
}
if (CBOOL(BgL_descrz00_799))
{ /* Llib/tvector.scm 167 */
obj_t BgL_allocatez00_800;
obj_t BgL_setz00_801;
BgL_allocatez00_800 =
STRUCT_REF(BgL_descrz00_799, (int) (((long) 1)));
BgL_setz00_801 = STRUCT_REF(BgL_descrz00_799, (int) (((long) 3)));
if (PROCEDUREP(BgL_setz00_801))
{ /* Llib/tvector.scm 173 */
long BgL_lenz00_803;
BgL_lenz00_803 = bgl_list_length(BgL_lz00_29);
{ /* Llib/tvector.scm 173 */
obj_t BgL_tvecz00_804;
BgL_tvecz00_804 =
PROCEDURE_ENTRY(BgL_allocatez00_800) (BgL_allocatez00_800,
BINT(BgL_lenz00_803), BEOA);
{ /* Llib/tvector.scm 174 */
{
obj_t BgL_lz00_1391;
long BgL_iz00_1392;
BgL_lz00_1391 = BgL_lz00_29;
BgL_iz00_1392 = ((long) 0);
BgL_loopz00_1390:
if (NULLP(BgL_lz00_1391))
{ /* Llib/tvector.scm 175 */
return BgL_tvecz00_804;
}
else
{ /* Llib/tvector.scm 175 */
{ /* Llib/tvector.scm 175 */
obj_t BgL_arg1907z00_1398;
BgL_arg1907z00_1398 = CAR(BgL_lz00_1391);
PROCEDURE_ENTRY(BgL_setz00_801) (BgL_setz00_801,
BgL_tvecz00_804, BINT(BgL_iz00_1392),
BgL_arg1907z00_1398, BEOA);
}
{
long BgL_iz00_1827;
obj_t BgL_lz00_1825;
BgL_lz00_1825 = CDR(BgL_lz00_1391);
BgL_iz00_1827 = (BgL_iz00_1392 + ((long) 1));
BgL_iz00_1392 = BgL_iz00_1827;
BgL_lz00_1391 = BgL_lz00_1825;
goto BgL_loopz00_1390;
}
}
}
}
}
}
else
{ /* Llib/tvector.scm 169 */
return
BGl_errorz00zz__errorz00(BGl_string2214z00zz__tvectorz00,
BGl_string2215z00zz__tvectorz00, BgL_idz00_28);
}
}
else
{ /* Llib/tvector.scm 165 */
return
BGl_errorz00zz__errorz00(BGl_string2214z00zz__tvectorz00,
BGl_string2216z00zz__tvectorz00, BgL_idz00_28);
}
}
}
}