moar functions

4 months ago · e8b321fa78
1 changed files with 109 additions and 7 deletions
--- a/sysdep/unix/main.c
+++ b/sysdep/unix/main.c
@ -961,14 +961,35 @@ clbird_get_table_name(cl_object obj)
 	return ecls(table->name);
 }
 cl_object
-clbird_get_table_routes(cl_object table_obj, cl_object pfx_obj, cl_object len_obj)
+clbird_val_type_name(cl_object val_obj)
+{
+	struct f_val *val = ecl_foreign_data_pointer_safe(val_obj);
+	return eclcs(f_type_name(val->type));
+}
+cl_object
+clbird_get_table_routes_all(cl_object table_obj)
+{
+	rtable *table = ecl_foreign_data_pointer_safe(table_obj);
+	cl_object ret = ECL_NIL;
+	FIB_WALK(&table->fib, net, n)
+	{
+		for (rte *e = n->routes; e; e = e->next) {
+			ret = ecl_cons(ecl_make_pointer(e), ret);
+		}
+	}
+	FIB_WALK_END;
+	return ret;
+}
+cl_object
+clbird_get_table_routes_net(cl_object table_obj, cl_object net_obj)
 {
 	rtable *table = ecl_foreign_data_pointer_safe(table_obj);
-	cl_fixnum prefix = ecl_to_fix(pfx_obj);
-	cl_fixnum len = ecl_to_fix(len_obj);
-	net_addr na = {0};
-	net_fill_ip4(&na, prefix, len);
-	net* net = net_route(table, &na);
+	struct f_val *net_val = ecl_foreign_data_pointer_safe(net_obj);
+	if (net_val->type != T_NET) {
+		FEerror("TABLE-ROUTES-NET needs a prefix, not a ~A", 1, clbird_val_type_name(net_obj));
+	}
+	net_addr* na = net_val->val.net;
+	net* net = net_route(table, na);
 	if (!net) {
 		return ECL_NIL;
 	}
@ -988,6 +1009,80 @@ clbird_dotquad(cl_object o1, cl_object o2, cl_object o3, cl_object o4)
 	ret |= ecl_to_fix(o4);
 	return ecl_make_integer(ret);
 }
+cl_object
+clbird_cidr4(cl_object o1, cl_object o2, cl_object o3, cl_object o4, cl_object len)
+{
+	cl_fixnum ret = 0;
+	ret |= ecl_to_fix(o1) << 24;
+	ret |= ecl_to_fix(o2) << 16;
+	ret |= ecl_to_fix(o3) << 8;
+	ret |= ecl_to_fix(o4);
+	net_addr *na = cfg_alloc(sizeof(net_addr));
+	net_fill_ip4(na, ret, ecl_to_fix(len));
+	struct f_val *res = cfg_alloc(sizeof(struct f_val));
+	res->type = T_NET;
+	res->val.net = na;
+	return ecl_make_pointer(res);
+}
+cl_object
+clbird_val_compare(cl_object val1_obj, cl_object val2_obj)
+{
+	struct f_val *val1 = ecl_foreign_data_pointer_safe(val1_obj);
+	struct f_val *val2 = ecl_foreign_data_pointer_safe(val2_obj);
+	cl_fixnum ret = val_compare(val1, val2);
+	if (ret == F_CMP_ERROR) {
+		FEerror("Comparison of raw BIRD values ~A (~A) and ~A (~A) failed.", 4, val1_obj, eclcs(f_type_name(val1->type)), val2_obj, eclcs(f_type_name(val2->type)));
+	}
+	return ecl_make_integer(ret);
+}
+cl_object
+clbird_val_same(cl_object val1_obj, cl_object val2_obj)
+{
+	struct f_val *val1 = ecl_foreign_data_pointer_safe(val1_obj);
+	struct f_val *val2 = ecl_foreign_data_pointer_safe(val2_obj);
+	return val_same(val1, val2) ? ECL_T : ECL_NIL;
+}
+cl_object
+clbird_val_in_range(cl_object val1_obj, cl_object val2_obj)
+{
+	struct f_val *val1 = ecl_foreign_data_pointer_safe(val1_obj);
+	struct f_val *val2 = ecl_foreign_data_pointer_safe(val2_obj);
+	cl_fixnum ret = val_in_range(val1, val2);
+	if (ret == F_CMP_ERROR) {
+		FEerror("Comparison of raw BIRD values ~A (~A) and ~A (~A) failed.", 4, val1_obj, eclcs(f_type_name(val1->type)), val2_obj, eclcs(f_type_name(val2->type)));
+	}
+	return ret ? ECL_T : ECL_NIL;
+}
+cl_object
+clbird_make_val(cl_object from)
+{
+	struct f_val *res = cfg_alloc(sizeof(struct f_val));
+	if (ECL_FIXNUMP(from)) {
+		res->type = T_INT;
+		res->val.i = ecl_to_fix(from);
+	}
+	else if (ECL_STRINGP(from)) {
+		cl_object base = si_coerce_to_base_string(from);
+		res->type = T_STRING;
+		res->val.s = base->base_string.self;
+	}
+	else if (from == ECL_NIL || from == ECL_T) {
+		res->type = T_BOOL;
+		res->val.i = from == ECL_T ? 1 : 0;
+	}
+	else if (ECL_CONSP(from) && ECL_FIXNUMP(ECL_CONS_CAR(from)) && ECL_FIXNUMP(ECL_CONS_CDR(from))) {
+		res->type = T_PAIR;
+		res->val.i = ecl_to_fix(ECL_CONS_CAR(from)) << 16 | ecl_to_fix(ECL_CONS_CDR(from));
+	}
+	else if (ECL_LISTP(from) && ecl_length(from) == 4) {
+		res->type = T_QUAD;
+		res->val.i = ecl_to_fix(ecl_elt(from, 0)) << 24 | ecl_to_fix(ecl_elt(from, 1)) << 16 | ecl_to_fix(ecl_elt(from, 2)) << 8 | ecl_to_fix(ecl_elt(from, 3));
+	}
+	else {
+		FEerror("Don't know how to convert to BIRD value: ~A", 1, from);
+	}
+	return ecl_make_pointer(res);
+}

 void
 init_ecl_functions()
@ -1001,8 +1096,15 @@ init_ecl_functions()
 	ecl_def_c_function(_ecl_intern("GET-VAL", package), clbird_get_val, 2);
 	ecl_def_c_function(_ecl_intern("ROUTING-TABLES", package), clbird_get_routing_tables, 0);
 	ecl_def_c_function(_ecl_intern("TABLE-NAME", package), clbird_get_table_name, 1);
-	ecl_def_c_function(_ecl_intern("TABLE-ROUTES", package), clbird_get_table_routes, 3);
+	ecl_def_c_function(_ecl_intern("TABLE-ROUTES", package), clbird_get_table_routes_all, 1);
+	ecl_def_c_function(_ecl_intern("TABLE-ROUTES-NET", package), clbird_get_table_routes_net, 2);
 	ecl_def_c_function(_ecl_intern("DOTQUAD", package), clbird_dotquad, 4);
+	ecl_def_c_function(_ecl_intern("CIDR4", package), clbird_cidr4, 5);
+	ecl_def_c_function(_ecl_intern("MAKE-VAL", package), clbird_make_val, 1);
+	ecl_def_c_function(_ecl_intern("VAL-TYPE-NAME", package), clbird_val_type_name, 1);
+	ecl_def_c_function(_ecl_intern("VAL-COMPARE", package), clbird_val_compare, 2);
+	ecl_def_c_function(_ecl_intern("VAL-SAME", package), clbird_val_same, 2);
+	ecl_def_c_function(_ecl_intern("VAL-IN-RANGE", package), clbird_val_in_range, 2);
 }

 /*