Exemplo n.º 1
0
static void *
_guile_main_wrapper (lw6sys_context_t * sys_context, void *data)
{
  lw6sys_log (sys_context, LW6SYS_LOG_NOTICE, _x_ ("entering Guile in %s"), __FUNCTION__);
  _global_sys_context = sys_context;

  if (lw6scm_c_define_gsubr (sys_context, LW6DEF_C_LW6SYS_BUILD_GET_VERSION, 0, 0, 0, (SCM (*)())_scm_lw6sys_build_get_version))
    {
      lw6sys_log (sys_context, LW6SYS_LOG_NOTICE, _x_ ("next you should see a message complaining \"%s\" is not documented"), _TEST_UNEXISTING_FUNC);
      if (lw6scm_c_define_gsubr (sys_context, _TEST_UNEXISTING_FUNC, 0, 0, 0, (SCM (*)())_scm_lw6sys_build_get_version))
	{
	  lw6sys_log (sys_context, LW6SYS_LOG_WARNING, _x_ ("function \"%s\" was defined, should have been refused"), _TEST_UNEXISTING_FUNC);
	  _global_ret = 0;
	}
    }
  else
    {
      _global_ret = 0;
    }

  lw6sys_log (sys_context, LW6SYS_LOG_NOTICE, _x_ ("next you should see a message complaining \"%s\" does not exists"), _TEST_UNEXISTING_FILE);
  lw6scm_c_primitive_load (sys_context, _TEST_UNEXISTING_FILE);
  scm_gc ();
  lw6sys_log (sys_context, LW6SYS_LOG_NOTICE, _("leaving Guile in %s"), __FUNCTION__);

  return NULL;
}
Exemplo n.º 2
0
static Expr* gc(Expr* args) {
	assert(args);

	if(args != EMPTY_LIST) return scm_mk_error("gc expects no arguments");

	scm_gc();

	return EMPTY_LIST;
}
Exemplo n.º 3
0
static void *
entry_point (void *arg)
{
  /* Invoke the GC.  If `THREAD->base' is incorrect, then Guile will just
     segfault somewhere in `scm_mark_locations ()'.  */
  scm_gc ();

  return NULL;
}
Exemplo n.º 4
0
static SCM sched_thread(void *data) {
	SCHED_EVENT *event;
	utime_t next_wake;
	utime_t now, early, late;
	time_t tnow;
	scheduling = 1;
	next_wake = 0;
	pthread_mutex_lock(&qmutex);
	while (scheduling) {
		pthread_cond_timedwait(&qcondvar, &qmutex, sleep_till(next_wake));
		now = now_usec();
		late = now - DISPATCH_WINDOW / 2;
		early = now + DISPATCH_WINDOW / 2;
		event = queue;
		while (event != NULL) {
			if (event->clock < late) {
				log_msg("would drop %1.3f < %1.3f\n",
					event->clock / (double)TIME_RES, late /
					(double)TIME_RES);
		//		queue = event->link;
		//		release_node(event);
		//		event = queue;
		//		continue;
				}
			if (event->clock > early) break;
			queue = event->link;
			if (event->state == STATE_PENDING) {
				scm_spawn_thread(dispatch_event,
							(void *)&(event->action), NULL, NULL);
				}
			release_node(event);
			event = queue;
			}
		queue = sweep_cancellations(queue);
		if (queue != NULL) next_wake = queue->clock;
		else next_wake = 0;
		if (((tnow = time(NULL)) - gc_hit) > GC_HIT_INTERVAL) {
			gc_hit = tnow;
			scm_gc();
			}
		}
	pthread_mutex_unlock(&qmutex);
	return SCM_BOOL_T;
	}
Exemplo n.º 5
0
/*
  
  Assert that the given object is a valid reference to a valid cell.  This
  test involves to determine whether the object is a cell pointer, whether
  this pointer actually points into a heap segment and whether the cell
  pointed to is not a free cell.  Further, additional garbage collections may
  get executed after a user defined number of cell accesses.  This helps to
  find places in the C code where references are dropped for extremely short
  periods.

*/
void
scm_i_expensive_validation_check (SCM cell)
{
  /* If desired, perform additional garbage collections after a user
   * defined number of cell accesses.
   */
  if (scm_debug_cells_gc_interval)
    {
      static unsigned int counter = 0;

      if (counter != 0)
	{
	  --counter;
	}
      else
	{
	  counter = scm_debug_cells_gc_interval;
	  scm_gc ();
	}
    }
}
Exemplo n.º 6
0
static void *
_guile_main_utils (lw6sys_context_t * sys_context, void *data)
{
  SCM _test_string = SCM_UNDEFINED;
  char *c_test_string = NULL;
  SCM _test_list = SCM_UNDEFINED;
  lw6sys_list_t *c_test_list_1 = NULL;
  lw6sys_list_t *c_test_list_2 = NULL;
  int c_test_list_1_length = 0;
  int c_test_list_2_length = 0;
  SCM _test_assoc = SCM_UNDEFINED;
  lw6sys_assoc_t *c_test_assoc_1 = NULL;
  lw6sys_assoc_t *c_test_assoc_2 = NULL;
  const char *c_test_assoc_1_value_1 = 0;
  const char *c_test_assoc_2_value_1 = 0;

  lw6sys_log (sys_context, LW6SYS_LOG_NOTICE, _x_ ("entering Guile in %s"), __FUNCTION__);

  _test_string = scm_from_locale_string (_TEST_UTILS_STRING);
  c_test_string = lw6scm_utils_to_0str (sys_context, _test_string);
  if (c_test_string)
    {
      if (lw6sys_str_is_same (sys_context, c_test_string, _TEST_UTILS_STRING))
	{
	  lw6sys_log (sys_context, LW6SYS_LOG_NOTICE, _x_ ("was able to transfer string \"%s\" from C to Guile to C"), c_test_string);
	}
      LW6SYS_FREE (sys_context, c_test_string);
    }
  else
    {
      _global_ret = 0;
    }

  c_test_list_1 = lw6sys_list_new (sys_context, NULL);
  if (c_test_list_1)
    {
      lw6sys_list_push_front (sys_context, &c_test_list_1, _TEST_UTILS_LIST_1);
      lw6sys_list_push_front (sys_context, &c_test_list_1, _TEST_UTILS_LIST_2);
      lw6sys_list_push_front (sys_context, &c_test_list_1, _TEST_UTILS_LIST_3);
      if (c_test_list_1)
	{
	  _test_list = lw6scm_utils_to_scm_str_list (sys_context, c_test_list_1);
	  c_test_list_2 = lw6scm_utils_to_sys_str_list (sys_context, _test_list);
	  if (c_test_list_2)
	    {
	      c_test_list_1_length = lw6sys_list_length (sys_context, c_test_list_1);
	      c_test_list_2_length = lw6sys_list_length (sys_context, c_test_list_2);
	      if (c_test_list_1_length == c_test_list_2_length)
		{
		  lw6sys_log (sys_context, LW6SYS_LOG_NOTICE, _x_ ("was able to transfer list of length %d from C to Guile to C"), c_test_list_2_length);
		}
	      else
		{
		  lw6sys_log (sys_context, LW6SYS_LOG_WARNING,
			      _x_ ("size mismatch c_test_list_1_lenght=%d c_test_list_2_length=%d"), c_test_list_1_length, c_test_list_2_length);
		  _global_ret = 0;
		}
	      lw6sys_list_free (sys_context, c_test_list_2);
	    }
	  else
	    {
	      lw6sys_log (sys_context, LW6SYS_LOG_WARNING, _x_ ("unable to create C list from SCM object"));
	      _global_ret = 0;
	    }
	}
      else
	{
	  lw6sys_log (sys_context, LW6SYS_LOG_WARNING, _x_ ("problem setting list values"));
	  _global_ret = 0;
	}
      lw6sys_list_free (sys_context, c_test_list_1);
    }
  else
    {
      lw6sys_log (sys_context, LW6SYS_LOG_WARNING, _x_ ("unable to create C list"));
      _global_ret = 0;
    }

  c_test_assoc_1 = lw6sys_assoc_new (sys_context, NULL);
  if (c_test_assoc_1)
    {
      lw6sys_assoc_set (sys_context, &c_test_assoc_1, _TEST_UTILS_ASSOC_KEY_1, _TEST_UTILS_ASSOC_VALUE_1);
      lw6sys_assoc_set (sys_context, &c_test_assoc_1, _TEST_UTILS_ASSOC_KEY_2, _TEST_UTILS_ASSOC_VALUE_2);
      lw6sys_assoc_set (sys_context, &c_test_assoc_1, _TEST_UTILS_ASSOC_KEY_3, _TEST_UTILS_ASSOC_VALUE_3);
      if (c_test_assoc_1)
	{
	  _test_assoc = lw6scm_utils_to_scm_str_assoc (sys_context, c_test_assoc_1);
	  c_test_assoc_2 = lw6scm_utils_to_sys_str_assoc (sys_context, _test_assoc);
	  if (c_test_assoc_2)
	    {
	      c_test_assoc_1_value_1 =
		lw6sys_str_empty_if_null (sys_context, (char *) lw6sys_assoc_get (sys_context, c_test_assoc_1, _TEST_UTILS_ASSOC_KEY_1));
	      c_test_assoc_2_value_1 =
		lw6sys_str_empty_if_null (sys_context, (char *) lw6sys_assoc_get (sys_context, c_test_assoc_2, _TEST_UTILS_ASSOC_KEY_1));
	      if (lw6sys_str_is_same (sys_context, c_test_assoc_1_value_1, c_test_assoc_2_value_1))
		{
		  lw6sys_log (sys_context, LW6SYS_LOG_NOTICE,
			      _x_
			      ("was able to transfer assoc from C to Guile to C, value for key \"%s\" is \"%s\""),
			      _TEST_UTILS_ASSOC_KEY_1, c_test_assoc_2_value_1);
		}
	      else
		{
		  lw6sys_log (sys_context, LW6SYS_LOG_WARNING,
			      _x_
			      ("content mismatch between assoc for key \"%s\" assoc_1 contains \"%s\" while assoc_2 contains \"%s\""),
			      _TEST_UTILS_ASSOC_KEY_1, c_test_assoc_1_value_1, c_test_assoc_2_value_1);
		  _global_ret = 0;
		}
	      lw6sys_assoc_free (sys_context, c_test_assoc_2);
	    }
	  else
	    {
	      lw6sys_log (sys_context, LW6SYS_LOG_WARNING, _x_ ("unable to create C assoc from SCM object"));
	      _global_ret = 0;
	    }
	}
      else
	{
	  lw6sys_log (sys_context, LW6SYS_LOG_WARNING, _x_ ("problem setting assoc values"));
	  _global_ret = 0;
	}
      lw6sys_assoc_free (sys_context, c_test_assoc_1);
    }
  else
    {
      lw6sys_log (sys_context, LW6SYS_LOG_WARNING, _x_ ("unable to create C assoc"));
      _global_ret = 0;
    }

  scm_gc ();
  lw6sys_log (sys_context, LW6SYS_LOG_NOTICE, _("leaving Guile in %s"), __FUNCTION__);

  return NULL;
}