Пример #1
0
/* _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);
			}
		}
	}
Пример #2
0
/* <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);} } } } } 
}
Пример #3
0
/*=======================================
  R5RS : 6.4 Control Features
=======================================*/
SCM_EXPORT ScmObj
scm_p_procedurep(ScmObj obj)
{
    DECLARE_FUNCTION("procedure?", procedure_fixed_1);

    return MAKE_BOOL(PROCEDUREP(obj));
}
Пример #4
0
/*---------------------------------------------------------------------*/
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;
}
Пример #5
0
/* _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);
			}
		}
	}
Пример #6
0
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;
}
Пример #7
0
/*---------------------------------------------------------------------*/
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;
   }
}
Пример #8
0
/* 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);} } } 
}
Пример #9
0
/* _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);} } 
}
Пример #10
0
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;
}
Пример #11
0
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);
}
Пример #12
0
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);
}
Пример #13
0
/* 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))));
		}}}}
	}
Пример #14
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);
					}
			}
		}
	}
Пример #15
0
/* 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);
					}
			}
		}
	}