Exemple #1
0
term_t cbif_rand_bytes1(proc_t *proc, term_t *regs)
{
	term_t N = regs[0];
	if (!is_int(N) || int_value(N) < 0)
		badarg(N);
	int len = int_value(N);

	uint8_t *ptr;
	term_t bin = heap_make_bin(&proc->hp, len, &ptr);
	uint8_t *p = ptr;
	while (p <= ptr +len -4)
	{
		uint32_t rnd = mt_lrand();
		PUT_UINT_32(p, rnd);
		p += 4;
	}
	uint32_t last = mt_lrand();
	switch(ptr +len -p)
	{
	case 3:
		*p++ = (uint8_t)(last >> 16);
	case 2:
		*p++ = (uint8_t)(last >> 8);
	case 1:
		*p++ = (uint8_t)last;
	case 0:
		break;
	}

	return bin;
}
Exemple #2
0
LISP_OBJ_PTR mult(LISP_OBJ_PTR args) {
  LISP_OBJ_PTR res = alloc_obj();
  int int_res = 1;
  float float_res = 1;
  BOOLEAN is_float = FALSE;

  while (args != nil_ptr) {
    // check to see if we should be adding floats
    if (is_float(car(args)) && !is_float) {
      float_res = int_res;
      is_float = TRUE;
    }
    // grab the proper number
    if (is_float(car(args))) {
      float_res *= float_value(car(args));
    } else if (!is_float)
      int_res *= int_value(car(args));
    else
      float_res *= int_value(car(args));
    args = cdr(args);
  }

  if (is_float) {
    form(res) = FLOAT_FORM;
    float_value(res) = float_res;
  }
  else {
    form(res) = INT_FORM;
    int_value(res) = int_res;
  }

  return res;
}
Exemple #3
0
LISP_OBJ_PTR divide(LISP_OBJ_PTR args) {
  LISP_OBJ_PTR res = alloc_obj();
  float float_res = 0;
  // for now, this always coerces to a float
  form(res) = FLOAT_FORM;

  if (is_float(car(args))) {
    float_res = float_value(car(args));
  } else
    float_res = int_value(car(args));
  args = cdr(args);

  if (args == nil_ptr)  {
    float_value(res) = 1 / float_res;
    return res;
  }

  // TODO: check for zero division
  while (args != nil_ptr) {
    if (is_float(car(args)))
      float_res /= float_value(car(args));
    else
      float_res /= int_value(car(args));
    args = cdr(args);
  }

  float_value(res) = float_res;
  return res;
}
Exemple #4
0
LISP_OBJ_PTR eq(LISP_OBJ_PTR args) {
  LISP_OBJ_PTR current = car(args);
  LISP_OBJ_PTR to_test;
  BOOLEAN res = TRUE;

  args = cdr(args);
  while (args != nil_ptr) {
    to_test = car(args);
    if (is_int(current) && is_int(to_test))
      res = (int_value(current) == int_value(to_test));
    else if (is_int(current) && is_float(to_test))
      res = (int_value(current) == float_value(to_test));
    else if (is_float(current) && is_int(to_test))
      res = (float_value(current) == int_value(to_test));
    else
      res = (float_value(current) == float_value(to_test));

    if (!res) {
      return false_ptr;
    }
    current = to_test;
    args = cdr(args);
  }

  return true_ptr;
}
Exemple #5
0
apr_array_header_t *source_line_blocks(term_t info, apr_pool_t *pool)
{
	apr_array_header_t *refs = apr_array_make(pool, 64, sizeof(source_ref_t));
	term_t cons = info;
	while (is_cons(cons))
	{
		term_box_t *cb = peel(cons);
		term_t t = cb->cons.head;
		//{F,L,S,E}
		if (is_tuple(t))
		{
			term_box_t *tb = peel(t);
			if (tb->tuple.size == 4)
			{
				source_ref_t *ref = &APR_ARRAY_PUSH(refs, source_ref_t);
				ref->file_index = int_value(tb->tuple.elts[0]);
				ref->source_line = int_value(tb->tuple.elts[1]);
				ref->off_starts = int_value(tb->tuple.elts[2]);
				ref->off_ends = int_value(tb->tuple.elts[3]);
			}
		}
		cons = cb->cons.tail;
	}
	return refs;
}
Exemple #6
0
static int64_t iolist_size2(int depth, term_t l)
{
	if (depth > IOLIST_MAX_DEPTH)
		return -TOO_DEEP;

	if (is_nil(l))
		return 0;

	if (is_cons(l))
	{
		int64_t size = 0;
		do {
			uint32_t *term_data = peel_cons(l);
			term_t e = term_data[0];
			if (is_int(e))
			{
				if (int_value(e) < 0 || int_value(e) > 255)
					return -BAD_ARG;
				size++;
			}
			else
			{
				if (!is_list(e) && (!is_boxed(e) || !is_binary(peel_boxed(e))))
					return -BAD_ARG;
				int64_t s = iolist_size2(depth+1, e);
				if (s < 0)
					return s;
				size += s;
			}
			l = term_data[1];
			if (is_boxed(l) && is_binary(peel_boxed(l)))
			{
				// odd list with binary tail allowed
				int64_t s = iolist_size2(depth+1, l);
				if (s < 0)
					return s;
				return size +s;
			}	
		} while (is_cons(l));

		if (!is_nil(l))
			return -BAD_ARG;

		return size;
	}
	else if (is_boxed_binary(l))
	{
		bits_t bs;
		bits_get_real(peel_boxed(l), &bs);

		int64_t bit_size = bit_size = bs.ends - bs.starts;
		if ((bit_size & 7) != 0)
			return -1;

		return bit_size /8;
	}
	else
		return -BAD_ARG;
}
Exemple #7
0
static int64_t bits_list_size2(int depth, term_t l)
{
	if (depth > BITS_LIST_MAX_DEPTH)
		return -TOO_DEEP;

	if (is_nil(l))
		return 0;

	if (is_cons(l))
	{
		int64_t size = 0;
		do {
			uint32_t *term_data = peel_cons(l);
			term_t e = term_data[0];
			if (is_int(e))
			{
				if (int_value(e) < 0 || int_value(e) > 255)
					return -BAD_ARG;
				size += 8;
			}
			else
			{
				if (!is_list(e) && (!is_boxed(e) || !is_binary(peel_boxed(e))))
					return -BAD_ARG;
				int64_t s = bits_list_size2(depth+1, e);
				if (s < 0)
					return s;
				size += s;
			}
			l = term_data[1];
			if (is_boxed(l) && is_binary(peel_boxed(l)))
			{
				// odd list with binary tail allowed
				int64_t s = bits_list_size2(depth+1, l);
				if (s < 0)
					return s;
				size += s;
				if (size > MAX_BIT_SIZE)
					return -TOO_LONG;
				return size;
			}	
		} while (is_cons(l));

		if (!is_nil(l))
			return -BAD_ARG;
		if (size > MAX_BIT_SIZE)
			return -TOO_LONG;
		return size;
	}
	else // is_binary()
	{
		bits_t bs;
		bits_get_real(peel_boxed(l), &bs);
		if (bs.ends - bs.starts > MAX_BIT_SIZE)
			return -TOO_LONG;
		return bs.ends - bs.starts;
	}
}
Exemple #8
0
static VALUE *docolon(VALUE *sv, VALUE *pv)
{
	enum { NMATCH = 2 };
	VALUE *v;
#if defined(__UC_LIBC__)
	regexp *re_buffer;
    int len;
#else
	regex_t re_buffer;
	regmatch_t re_regs[NMATCH];
#endif

	tostring(sv);
	tostring(pv);

	if (pv->u.s[0] == '^') {
		bb_error_msg(
"warning: '%s': using '^' as the first character\n"
"of a basic regular expression is not portable; it is ignored", pv->u.s);
	}

#if defined(__UC_LIBC__)
	re_buffer = regcomp(pv->u.s);
	if (re_buffer == NULL) {
		regerror("NULL buffer");
		exit(1);
	}
	len = regexec(re_buffer, sv->u.s);
	v = int_value(len);
	free(re_buffer);
#else
	memset(&re_buffer, 0, sizeof(re_buffer));
	memset(re_regs, 0, sizeof(re_regs));
	xregcomp(&re_buffer, pv->u.s, 0);

	/* expr uses an anchored pattern match, so check that there was a
	 * match and that the match starts at offset 0. */
	if (regexec(&re_buffer, sv->u.s, NMATCH, re_regs, 0) != REG_NOMATCH
	 && re_regs[0].rm_so == 0
	) {
		/* Were \(...\) used? */
		if (re_buffer.re_nsub > 0 && re_regs[1].rm_so >= 0) {
			sv->u.s[re_regs[1].rm_eo] = '\0';
			v = str_value(sv->u.s + re_regs[1].rm_so);
		} else {
			v = int_value(re_regs[0].rm_eo);
		}
	} else {
		/* Match failed -- return the right kind of null.  */
		if (re_buffer.re_nsub > 0)
			v = str_value("");
		else
			v = int_value(0);
	}
	regfree(&re_buffer);
#endif
	return v;
}
Exemple #9
0
term_t bif_open0_3(term_t FileName, term_t Mode, term_t Perms, process_t *ctx)
{
	apr_status_t rs;
	apr_pool_t *p;
	apr_file_t *file;
	port_t *port;

	if (!is_binary(FileName) || !is_int(Mode) || !is_int(Perms))
		return A_BADARG;

	apr_pool_create(&p, 0);
	rs = apr_file_open(&file, (char *)bin_data(FileName), (apr_uint32_t)int_value(Mode), (apr_uint32_t)int_value(Perms), p);
	if (rs != 0)
	{
		apr_pool_destroy(p);
		return decipher_status(rs);
	}

	port = port_file_make(file);

	//set initial port owner
	//port->owner_in = port->owner_out = proc_pid(ctx, port->xp);
	port->owner_in = port->owner_out = A_UNDEFINED;

	//put port to polling ring
	port_register(port);

	result(port_id(port, proc_gc_pool(ctx)));
	return AI_OK;
}
Exemple #10
0
//
// Flatten the valid iolist to the buffer of
// appropriate size pointed to by ptr
//
uint8_t *iolist_flatten(term_t l, uint8_t *ptr)
{
	if (is_nil(l))
		return ptr;

	if (is_cons(l))
	{
		do {
			uint32_t *term_data = peel_cons(l);
			term_t e = term_data[0];
			if (is_int(e))
				*ptr++ = int_value(e);
			else
			{
				assert(is_list(e) || (is_boxed(e) && is_binary(peel_boxed(e))));
				ptr = iolist_flatten(e, ptr);
			}
			l = term_data[1];
			if (is_boxed(l) && is_binary(peel_boxed(l)))
				return iolist_flatten(l, ptr);
		} while (is_cons(l));

		assert(is_nil(l));
	}
	else // is_binary()
	{
		bits_t bs, to;
		bits_get_real(peel_boxed(l), &bs);
		bits_init_buf(ptr, (bs.ends +7) /8, &to);
		ptr += (bs.ends - bs.starts) /8;
		bits_copy(&bs, &to);
		assert(bs.starts == bs.ends);
	}
	return ptr;
}
Exemple #11
0
ComplexType chi6_irreducible(int z0,int z1,int z2,int w0, int w0_, int w1, int w1_, int w2, int n0, int n0_, int n1, int n1_, int n2, int n2_, double s)
{
static int wm=2*(int_value("number_of_Matsubara_frequencies_for_Gamma4")/2);
if (w0<0) {return conj(chi6_irreducible(z0, z1, z2, wm-1-w0, wm-1-w0_, wm-1-w1, wm-1-w1_, wm-1-w2, n0, n0_, n1, n1_, n2, n2_, s));}

int w2_=w2+w1+w0-w1_-w0_;
	ComplexType C=chi6_array[z0][z1][z2][w0][w0_][w1][w1_][w2][n0][n0_][n1][n1_][n2][n2_]/s;
   // 9 terms 2-4
   			 C-=chi2_extract(z0,z0,w0,w0_,n0,n0_,s)*chi4_extract(z1,z1,z2,z2,w1,w1_,w2,w2_,n1,n1_,n2,n2_,s);
             C+=chi2_extract(z0,z1,w0,w1_,n0,n1_,s)*chi4_extract(z1,z0,z2,z2,w1,w0_,w2,w2_,n1,n0_,n2,n2_,s);
             C+=chi2_extract(z0,z2,w0,w2_,n0,n2_,s)*chi4_extract(z1,z1,z2,z0,w1,w1_,w2,w0_,n1,n1_,n2,n0_,s);

   			 C-=chi2_extract(z1,z1,w1,w1_,n1,n1_,s)*chi4_extract(z0,z0,z2,z2,w0,w0_,w2,w2_,n0,n0_,n2,n2_,s);
             C+=chi2_extract(z1,z0,w1,w0_,n1,n0_,s)*chi4_extract(z0,z1,z2,z2,w0,w1_,w2,w2_,n0,n1_,n2,n2_,s);
             C+=chi2_extract(z1,z2,w1,w2_,n1,n2_,s)*chi4_extract(z0,z0,z2,z1,w0,w0_,w2,w1_,n0,n0_,n2,n1_,s);



    			 C-=chi2_extract(z2,z2,w2,w2_,n2,n2_,s)*chi4_extract(z0,z0,z1,z1,w0,w0_,w1,w1_,n0,n0_,n1,n1_,s);
             C+=chi2_extract(z2,z0,w2,w0_,n2,n0_,s)*chi4_extract(z0,z2,z1,z1,w0,w2_,w1,w1_,n0,n2_,n1,n1_,s);
             C+=chi2_extract(z2,z1,w2,w1_,n2,n1_,s)*chi4_extract(z0,z0,z1,z2,w0,w0_,w1,w2_,n0,n0_,n1,n2_,s);


   //6 terms 2-2-2
   C-=chi2_extract(z0,z0,w0,w0_,n0,n0_,s)*chi2_extract(z1,z1,w1,w1_,n1,n1_,s)*chi2_extract(z2,z2,w2,w2_,n2,n2_,s);

   C+=chi2_extract(z0,z0,w0,w0_,n0,n0_,s)*chi2_extract(z1,z2,w1,w2_,n1,n2_,s)*chi2_extract(z2,z1,w2,w1_,n2,n1_,s);
   C+=chi2_extract(z0,z1,w0,w1_,n0,n1_,s)*chi2_extract(z1,z0,w1,w0_,n1,n0_,s)*chi2_extract(z2,z2,w2,w2_,n2,n2_,s);
   C+=chi2_extract(z0,z2,w0,w2_,n0,n2_,s)*chi2_extract(z1,z1,w1,w1_,n1,n1_,s)*chi2_extract(z2,z0,w2,w0_,n2,n0_,s);

	C-=chi2_extract(z0,z2,w0,w2_,n0,n2_,s)*chi2_extract(z1,z0,w1,w0_,n1,n1_,s)*chi2_extract(z2,z1,w2,w1_,n2,n1_,s);
   C-=chi2_extract(z0,z1,w0,w1_,n0,n1_,s)*chi2_extract(z1,z2,w1,w2_,n1,n2_,s)*chi2_extract(z2,z0,w2,w0_,n2,n0_,s);

   return C;
;}
Exemple #12
0
term_t bif_rc4_init1(term_t Key, process_t *ctx)
{
	apr_byte_t *s;
	apr_byte_t i, j;
	apr_byte_t key_len;
	apr_byte_t *key_data;

	if (!is_binary(Key))
		return A_BADARG;
	s = xalloc(proc_gc_pool(ctx), 256+2);	//2 for i and j
	key_len = (apr_byte_t)int_value(bin_size(Key));
	key_data = bin_data(Key);

	i = 0;
	do {
		s[i] = i++;
	} while (i != 0);
	
	i = j = 0;
	do {
		apr_byte_t temp;
		j += key_data[i%key_len]+s[i];
		temp = s[i];
		s[i] = s[j];
		s[j] = temp;
		i++;
	} while (i != 0);

	s[256] = 0;
	s[257] = 0;

	result(make_binary(intnum(256+2), s, proc_gc_pool(ctx)));
	return AI_OK;
}
Exemple #13
0
/* Declare variables underneath a declarator tree */
void declare_variables_tac(environment *env, NODE *node, int variable_type, int return_type) {
	value *variable_name = NULL;
	if (env == NULL || node == NULL) {
		return;
	}
	else if (type_of(node) == ',') {
		declare_variables_tac(env, node->left, variable_type, return_type);
		declare_variables_tac(env, node->right, variable_type, return_type);
		return;		
	}
	else if (type_of(node) == '=') { /* Specific assignment */
		variable_name = make_simple(env, node->left, 0, return_type);
	}
	else if (type_of(node) == LEAF) { /* Undefined assignment */
		variable_name = make_simple(env, node->left, 0, return_type);		
	}
	/* Assign variable */
	if (variable_name) {		
		/* Assign a default initialization value for this type */
		switch(variable_type) {	
			case INT:
				assign(env, variable_name, int_value(0), 1);
				break;
			case VOID:	
				assign(env, variable_name, void_value(), 1);						
				break;
			case FUNCTION:
				assign(env, variable_name, null_fn, 1);
				break;
		}
	}
	else {
		fatal("Could not ascertain variable name!");
	}
}
Exemple #14
0
/* Register params in environment */
void register_params(environment *env, value *param_list) {
	value *current_param;
	if (!param_list) return;
	current_param = param_list;
	while (current_param!=NULL) {
		value *param = NULL;
		value *param_name;
		param_name = string_value(current_param->identifier);
		switch(current_param->value_type) {	
			case VT_INTEGR:
				param = assign(env, param_name, int_value(0), 1);
				break;
			case VT_VOID:	
				param = assign(env, param_name, void_value(), 1);						
				break;
			case VT_FUNCTN:
				param = assign(env, param_name, null_fn, 1);
				break;
			default:
				fatal("Could not determine parameter type!");
		}
		append_code(make_quad_value("", param, NULL, NULL, TT_POP_PARAM, 0));
		current_param = current_param->next;
	}
}
Exemple #15
0
void emu_options::update_cached_options()
{
	m_coin_impulse = int_value(OPTION_COIN_IMPULSE);
	m_joystick_contradictory = bool_value(OPTION_JOYSTICK_CONTRADICTORY);
	m_sleep = bool_value(OPTION_SLEEP);
	m_refresh_speed = bool_value(OPTION_REFRESHSPEED);
}
static VALUE *eval2(void)
{
	VALUE *l, *r;
	int op;
	arith_t val;

	l = eval3();
	while (1) {
		op = nextarg("<");
		if (!op) { op = nextarg("<=");
		 if (!op) { op = nextarg("=");
		  if (!op) { op = nextarg("==");
		   if (!op) { op = nextarg("!=");
		    if (!op) { op = nextarg(">=");
		     if (!op) { op = nextarg(">");
		      if (!op) return l;
		}}}}}}
		G.args++;
		r = eval3();
		toarith(l);
		toarith(r);
		val = cmp_common(l, r, op);
		freev(l);
		freev(r);
		l = int_value(val);
	}
}
Exemple #17
0
term_t bif_read0_2(term_t Port, term_t Len, process_t *ctx)
{
	apr_status_t rs;
	apr_size_t size;
	apr_byte_t *buf;
	term_t bin;
	port_t *p;
	if (!is_port(Port) || !is_int(Len))
		return A_BADARG;
	p = port_lookup(prp_serial(Port));
	if (p == 0)
		return A_BADARG;
	size = (apr_size_t)int_value(Len);
	buf = xalloc(proc_gc_pool(ctx), size);
	rs = p->read(p, buf, &size);
	if (size == 0 && APR_STATUS_IS_EOF(rs))
		result(A_EOF);
	else if (size == 0 && rs != 0)
		return decipher_status(rs);
	else
	{
		bin = make_binary(intnum(size), buf, proc_gc_pool(ctx));
		result(bin);
	}
	return AI_OK;
}
Exemple #18
0
term_t bif_poll_ports1(term_t Time, process_t *ctx)
{
	//apr_time_t t1, t2;

	apr_status_t rs;
	apr_interval_time_t micros;

	if (!is_int(Time))
		return A_BADARG;
	micros = int_value(Time);

	//if (micros != 0)
	//	printf("ports_poll for %ld\n", micros);

	// XXX
	//t1 = apr_time_now();

	rs = ports_poll(micros);

	//t2 = apr_time_now();

	//if (t2 - t1 < micros)
	//	printf("ports_poll slept for less then requested: %ld instead of %ld\n",
	//		t2 - t1, micros);

	if (rs && !APR_STATUS_IS_TIMEUP(rs))
		return decipher_status(rs);
	result(A_TRUE);
	return AI_OK;
}
Exemple #19
0
void test_lisp_parse_1()
{
    Value parsed = parse(blob_s("(test 1 2 3)"));
    expect_str(nth(parsed, 0), ":test");
    expect(nth(parsed, 1).raw == int_value(1).raw);
    expect_str(parsed, "[:test, 1, 2, 3]");
    decref(parsed);
}
static int
int_range (int min, int max)
{
  int val = int_value ();
  if (val < min || max < val)
    val = min;
  return val;
}
Exemple #21
0
ComplexType chi4_irreducible(int z1, int z2, int w1, int w2_, int W, int n1, int n1_, int n2, int n2_, double s)
{
	 if (W<0) {static int wm=2*(int_value("number_of_Matsubara_frequencies_for_Gamma4")/2);  return conj(chi4_irreducible(z1,z2,wm-1-w1,wm-1-w2_,-W,n1,n1_,n2,n2_,s));}
    int w1_=w1+W, w2=w2_+W;
    ComplexType C=chi4_array[z1][z2][w1][w2_][W][n1][n1_][n2][n2_]/s;
    C-=chi2_extract(z1, z1, w1, w1_, n1, n1_,s)*chi2_extract(z2, z2, w2, w2_, n2, n2_,s);
    C+=chi2_extract(z1, z2, w1, w2_, n1, n2_,s)*chi2_extract(z2, z1, w2, w1_, n2, n1_,s);
    return C;
;}
Exemple #22
0
		expression_ast unary_op::evaluate(filter_handler handler) const {
			factory::un_op_type impl = factory::get_unary_operator(op);
			value_type type = get_return_type(op, type_invalid);
			if (type_is_int(type)) {
				return impl->evaluate(handler, subject);
			}
			handler->error(_T("Missing operator implementation"));
			return expression_ast(int_value(FALSE));
		}
Exemple #23
0
term_t bif_md5_1(term_t Data, process_t *ctx)
{
	apr_byte_t *digest = xalloc(proc_gc_pool(ctx), MD5_DIGESTSIZE);
	if (!is_binary(Data))
		return A_BADARG;
	md5(digest, bin_data(Data), (apr_size_t)int_value(bin_size(Data)));
	result(make_binary(intnum(MD5_DIGESTSIZE), digest, proc_gc_pool(ctx)));
	return AI_OK;
}
Exemple #24
0
term_t bif_sendto4(term_t Sock, term_t RemIP, term_t RemPort, term_t Bin, process_t *ctx)
{
	apr_status_t rs;
	port_t *port;
	apr_socket_t *sock;
	const char *host;
	int udp_port;
	apr_sockaddr_t *sa;
	apr_pool_t *p;

	if (!is_port(Sock))
		return A_BADARG;
	if (!is_binary(RemIP) || !is_int(RemPort))
		return A_BADARG;
	if (!is_binary(Bin))
		return A_BADARG;

	port = port_lookup(prp_serial(Sock));
	if (port == 0)
		return A_CLOSED;
	if (!port->is_socket(port))
		return A_BADARG;
	sock = port->get_socket(port);

	host = (const char *)bin_data(RemIP);
	udp_port = (apr_port_t)int_value(RemPort);

	apr_pool_create(&p, 0);
	rs = apr_sockaddr_info_get(&sa, host, APR_INET, udp_port, 0, p);
	if (rs == 0)
	{
		apr_size_t len = (apr_size_t)int_value(bin_size(Bin));
		rs = apr_socket_sendto(sock, sa, 0, (const char *)bin_data(Bin), &len);
	}

	if (rs != 0)
	{
		apr_pool_destroy(p);
		return decipher_status(rs);
	}

	result(A_OK);
	return AI_OK;
}
Exemple #25
0
/**
 * Transforms an hash in an hexadecimal string into a binary hashs
 * @param str_hash a string (gchar *) that contains the hash in an
 *        hexadecimal form.
 * @returns a hash in a binary form (guint8 *).
 */
guint8 *string_to_hash(gchar *str_hash)
{
    guint8 *string = NULL;
    guint8 octet = 0;
    guint i = 0;

    if (str_hash != NULL)
        {
            string = (guint8 *) g_malloc0(HASH_LEN + 1); /* two char per bytes */

            for(i = 0; i < HASH_LEN * 2; i = i + 2)
                {
                    octet = int_value(str_hash[i])*16 + int_value(str_hash[i+1]);
                    memmove(string + i/2, &octet, 1);
                }
        }

    return string;
}
Exemple #26
0
void ini_chi6_array()
{
	static int f=0; if (f==1) return;
   int wc_max=int_value("number_of_Matsubara_frequencies_for_Gamma4");
   for (int z1=0; z1<n_zone; z1++)
   for (int z2=0; z2<n_zone; z2++)
   for (int z3=0; z3<n_zone; z3++)
   {
   	chi6_array[z1][z2][z3]=new ComplexType **********[2*wc_max/2];
      for (int w0=0; w0<2*wc_max/2; w0++)
      {
        chi6_array[z1][z2][z3][w0]=new ComplexType *********[2*wc_max/2];
        for (int w0_=0; w0_<2*wc_max/2; w0_++)
        {
      	chi6_array[z1][z2][z3][w0][w0_]=new ComplexType ********[2*wc_max/2];
         for (int w1=0; w1<2*wc_max/2; w1++)
         {
	         chi6_array[z1][z2][z3][w0][w0_][w1]=new ComplexType *******[2*wc_max/2];
            for (int w1_=0; w1_<2*wc_max/2; w1_++)
            {
            	chi6_array[z1][z2][z3][w0][w0_][w1][w1_]=new ComplexType ******[2*wc_max/2];
               for (int w2=0; w2<2*wc_max/2; w2++)
               {
                 chi6_array[z1][z2][z3][w0][w0_][w1][w1_][w2]=new ComplexType *****[n_part];
                 for (int n1=0; n1<n_part; n1++)
                 {
                   chi6_array[z1][z2][z3][w0][w0_][w1][w1_][w2][n1]=new ComplexType ****[n_part];
               	 for (int n1_=0; n1_<n_part; n1_++)
                   {
                  	chi6_array[z1][z2][z3][w0][w0_][w1][w1_][w2][n1][n1_]=new ComplexType *** [n_part];
                     for (int n2=0; n2<n_part; n2++)
                     {
                     	chi6_array[z1][z2][z3][w0][w0_][w1][w1_][w2][n1][n1_][n2]=new ComplexType **[n_part];
                        for (int n2_=0; n2_<n_part; n2_++)
                        {
                        	chi6_array[z1][z2][z3][w0][w0_][w1][w1_][w2][n1][n1_][n2][n2_]=new ComplexType *[n_part];
                           for (int n3=0; n3<n_part; n3++)
                           {
                           	chi6_array[z1][z2][z3][w0][w0_][w1][w1_][w2][n1][n1_][n2][n2_][n3]=new ComplexType [n_part];
                        		for (int n3_=0; n3_<n_part; n3_++) 	chi6_array[z1][z2][z3][w0][w0_][w1][w1_][w2][n1][n1_][n2][n2_][n3][n3_]=0;
                           ;}
                        ;}
                     ;}
                   ;}
                 ;}
               ;}
            ;}
         ;}
        ;}
      ;}
   ;}


   f=1;
;}
Exemple #27
0
term_t cbif_experimental2(proc_t *proc, term_t *regs)
{
	term_t What = regs[0];
	UNUSED term_t Arg = regs[1];
	if (!is_atom(What))
		badarg(What);
	
	switch (What)
	{
	// Cloudozer's 2nd anniversary -- remove in 2016
	case A_CLOUDOZER:
		if (Arg == tag_int(2))
			cloudozer2();
		break;
	// Cloudozer's 2nd anniversary
	case A_MODULE_SIZE:
#ifdef EXP_RUNTIME_METRICS
		print_loaded_module_sizes();
#endif // EXP_RUNTIME_METRICS
		break;
	case A_VARIANT_SIZE:
#ifdef EXP_RUNTIME_METRICS
		print_variant_code_sizes();
#endif // EXP_RUNTIME_METRICS
		break;
	case A_COUNT_IOPS:
#ifdef EXP_COUNT_IOPS
		print_iop_counters();
#endif // EXP_COUNT_IOPS
		break;
	case A_PROCESSING_DELAY:
#ifdef EXP_LINC_LATENCY
		if (Arg == A_HELP)
			printk("ping -Q 42 -q -n -c 25000 -f <ip>\n");
		else
			linc_display();
#endif // EXP_LINC_LATENCY
		break;
	case A_LLSTAT:
#ifdef EXP_LINC_LLSTAT
		if (is_int(Arg))
			llstat_restart(int_value(Arg));
		else if (Arg == A_STOP)
			llstat_stop();
		else
			llstat_display();
#endif // EXP_LINC_LLSTAT
		break;
	default:
		badarg(What);
	}

	return A_OK;
}
Exemple #28
0
 IntLiteral (Token _token, std::string _value) : Expression(_token, nullptr, Kind::IntLit, nullptr) {
     // TODO: parse prefix, suffix, set value and type
     toupper(_value);
     bool positive = num_is_positive(_value);
     int base = int_base(_value);
     type = std::unique_ptr<Type>(new BaseType(_token, int_type(_value)));
     value = int_value(base, _value);
     if (!positive) {
         value = -value;
     }
 }
Exemple #29
0
Value gensym(Value str)
{
    check_value(str);

    if (!is_blob(str) && !is_symbol(str))
        str = stringify(str);

    str = append_str_len(str, "#", 1);
    str = stringify_append(str, int_value(g_nextGensymId++));
    str = set_logical_type(str, SYMBOL_TYPE);
    return str;
}
Exemple #30
0
term_t cbif_trace1(proc_t *proc, term_t *regs)
{
	term_t Mask = regs[0];
	if (!is_int(Mask))
		badarg(Mask);

#ifdef TRACE_HARNESS
	trace_mask = int_value(Mask);
	trace_module = noval;
#endif
	return A_OK;
}