apr_status_t port_socket_close0(port_t *self)
{
port_socket_data_t *data = self->data;
process_t *proc = proc_lookup(pid_serial(self->owner_in));
if (proc)
{
xpool_t *tmp = xpool_make(self->pool);
int len = buffer_len(data->in_buf);
term_t msg;
if (len > 0)
{
term_t bin = make_binary(intnum(len), buffer_ptr(data->in_buf), tmp);
msg = make_tuple3(A_TCP, port_id(self, tmp), bin, tmp);
proc_new_mail(proc, msg);
buffer_clear(data->in_buf);
}
msg = make_tuple2(A_TCP_CLOSED, port_id(self, tmp), tmp);
proc_new_mail(proc, msg);
xpool_destroy(tmp);
}
return apr_socket_close(data->sock);
}
term_t bif_run_slice2(term_t Pid, term_t Reductions, process_t *ctx)
{
process_t *proc;
term_t retval, retval1;
term_t res;
if (!is_pid(Pid) || !is_int(Reductions))
return A_BADARG;
proc = proc_lookup(pid_serial(Pid));
res = proc_main(proc, int_value2(Reductions), &retval);
if (res == AI_DONE)
{
//proc_destroy(proc);
//- process should not be destroyed now
//- as we may need to notify links first
retval1 = marshal_term(retval, proc_gc_pool(ctx));
result(make_tuple2(AI_DONE, retval1, proc_gc_pool(ctx)));
}
else
{
if (res == AI_YIELD)
result(res);
else
{
retval1 = marshal_term(retval, proc_gc_pool(ctx));
result(make_tuple2(res, retval1, proc_gc_pool(ctx)));
}
}
return AI_OK;
}
apr_status_t port_socket_do_writable(port_t *self)
{
port_socket_data_t *data = self->data;
if (data->is_connecting)
{
process_t *proc = proc_lookup(pid_serial(self->owner_in)); // owner_in
if (proc)
{
xpool_t *tmp = xpool_make(self->pool);
term_t msg = make_tuple2(A_TCP_CONNECTED, port_id(self, tmp), tmp);
proc_new_mail(proc, msg);
xpool_destroy(tmp);
}
data->is_connecting = 0;
}
if (buffer_len(data->out_buf) > 0)
{
apr_status_t rs;
rs = buffer_socket_send(data->out_buf, data->sock);
if (rs != 0)
return rs;
}
if (data->is_closing && buffer_len(data->out_buf) == 0)
return APR_EOF; //make poll close0 the socket
if (data->space_required && buffer_available(data->out_buf) >= data->required_size)
{
xpool_t *tmp = xpool_make(self->pool);
int avail = buffer_available(data->out_buf);
term_t msg = make_tuple3(A_TCP_SPACE, port_id(self, tmp), intnum(avail), tmp);
process_t *proc = proc_lookup(pid_serial(self->owner_out));
//TODO: insure that only owner can send to socket
proc_new_mail(proc, msg);
xpool_destroy(tmp);
data->space_required = 0;
}
return APR_SUCCESS;
}
term_t bif_destroy_process1(term_t Pid, process_t *ctx)
{
process_t *proc;
if (!is_pid(Pid))
return A_BADARG;
proc = proc_lookup(pid_serial(Pid));
if (proc)
proc_destroy(proc);
result(A_TRUE);
return AI_OK;
}
apr_status_t ol_listener_close0(outlet_t *self)
{
ol_listener_data_t *data = self->data;
if (data->is_accepting)
{
proc_t *proc = scheduler_lookup(data->teevm->scheduler, pid_serial(data->reply_to_pid));
term_t msg = heap_tuple2(proc->heap, A_TCP_CLOSED, outlet_id(self));
scheduler_new_local_mail(data->teevm->scheduler, proc, msg);
data->is_accepting = 0;
}
apr_socket_close(data->sock);
outlet_mall_kick_out(data->teevm->mall, self);
apr_pool_destroy(self->pool);
return APR_SUCCESS;
}
apr_status_t ol_listener_do_readable(outlet_t *self)
{
apr_status_t rs;
ol_listener_data_t *data = self->data;
proc_t *proc;
proc = scheduler_lookup(data->teevm->scheduler, pid_serial(data->reply_to_pid));
if (proc)
{
apr_socket_t *new_sock;
outlet_t *new_outlet;
term_t msg;
apr_pool_t *p;
apr_pool_create(&p, 0);
rs = apr_socket_accept(&new_sock, data->sock, p);
if (rs == 0)
rs = apr_socket_opt_set(new_sock, APR_SO_NONBLOCK, 1);
if (rs != 0)
{
apr_pool_destroy(p);
return rs;
}
new_outlet = ol_socket_make(new_sock, 0);
//put to poll ring
outlet_mall_allot(data->teevm->mall, new_outlet);
//messages delivered to caller of accept
new_outlet->owner_in = new_outlet->owner_out = proc;
msg = heap_tuple3(proc->heap, A_TCP_ACCEPTED, outlet_id(self), outlet_id(new_outlet));
scheduler_new_local_mail(data->teevm->scheduler, proc, msg);
}
data->is_accepting = 0;
return APR_SUCCESS;
}
apr_status_t port_socket_do_readable(port_t *self)
{
apr_status_t rs;
port_socket_data_t *data = self->data;
rs = buffer_socket_recv(data->in_buf, data->sock);
if (rs == 0)
{
if (data->packet_expected)
{
process_t *proc;
int len = buffer_len(data->in_buf);
if (data->expected_size == 0 ||
data->expected_size > 0 && len >= data->expected_size)
{
if (data->expected_size > 0)
len = data->expected_size;
proc = proc_lookup(pid_serial(self->owner_in));
if (proc)
{
xpool_t *tmp = xpool_make(self->pool);
term_t bin = make_binary(intnum(len), buffer_ptr(data->in_buf), tmp);
term_t msg = make_tuple3(A_TCP, port_id(self, tmp), bin, tmp);
proc_new_mail(proc, msg);
buffer_consume(data->in_buf, len);
xpool_destroy(tmp);
}
data->packet_expected = 0;
data->expected_size = 0;
}
}
}
return rs;
}
static int
pdisplay1(fmtfn_t to, void *to_arg, Process* p, Eterm obj)
{
int i, k;
Eterm* nobj;
if (dcount-- <= 0)
return(1);
if (is_CP(obj)) {
erts_print(to, to_arg, "<cp/header:%0*lX",PTR_SIZE,obj);
return 0;
}
switch (tag_val_def(obj)) {
case NIL_DEF:
erts_print(to, to_arg, "[]");
break;
case ATOM_DEF:
erts_print(to, to_arg, "%T", obj);
break;
case SMALL_DEF:
erts_print(to, to_arg, "%ld", signed_val(obj));
break;
case BIG_DEF:
nobj = big_val(obj);
if (!IN_HEAP(p, nobj)) {
erts_print(to, to_arg, "#<bad big %X>#", obj);
return 1;
}
i = BIG_SIZE(nobj);
if (BIG_SIGN(nobj))
erts_print(to, to_arg, "-#integer(%d) = {", i);
else
erts_print(to, to_arg, "#integer(%d) = {", i);
erts_print(to, to_arg, "%d", BIG_DIGIT(nobj, 0));
for (k = 1; k < i; k++)
erts_print(to, to_arg, ",%d", BIG_DIGIT(nobj, k));
erts_putc(to, to_arg, '}');
break;
case REF_DEF:
case EXTERNAL_REF_DEF: {
Uint32 *ref_num;
erts_print(to, to_arg, "#Ref<%lu", ref_channel_no(obj));
ref_num = ref_numbers(obj);
for (i = ref_no_numbers(obj)-1; i >= 0; i--)
erts_print(to, to_arg, ",%lu", ref_num[i]);
erts_print(to, to_arg, ">");
break;
}
case PID_DEF:
case EXTERNAL_PID_DEF:
erts_print(to, to_arg, "<%lu.%lu.%lu>",
pid_channel_no(obj),
pid_number(obj),
pid_serial(obj));
break;
case PORT_DEF:
case EXTERNAL_PORT_DEF:
erts_print(to, to_arg, "#Port<%lu.%lu>",
port_channel_no(obj),
port_number(obj));
break;
case LIST_DEF:
erts_putc(to, to_arg, '[');
nobj = list_val(obj);
while (1) {
if (!IN_HEAP(p, nobj)) {
erts_print(to, to_arg, "#<bad list %X>", obj);
return 1;
}
if (pdisplay1(to, to_arg, p, *nobj++) != 0)
return(1);
if (is_not_list(*nobj))
break;
erts_putc(to, to_arg, ',');
nobj = list_val(*nobj);
}
if (is_not_nil(*nobj)) {
erts_putc(to, to_arg, '|');
if (pdisplay1(to, to_arg, p, *nobj) != 0)
return(1);
}
erts_putc(to, to_arg, ']');
break;
case TUPLE_DEF:
nobj = tuple_val(obj); /* pointer to arity */
i = arityval(*nobj); /* arity */
erts_putc(to, to_arg, '{');
while (i--) {
if (pdisplay1(to, to_arg, p, *++nobj) != 0) return(1);
if (i >= 1) erts_putc(to, to_arg, ',');
}
erts_putc(to, to_arg, '}');
break;
case FLOAT_DEF: {
FloatDef ff;
GET_DOUBLE(obj, ff);
erts_print(to, to_arg, "%.20e", ff.fd);
}
break;
case BINARY_DEF:
erts_print(to, to_arg, "#Bin");
break;
case MATCHSTATE_DEF:
erts_print(to, to_arg, "#Matchstate");
break;
default:
erts_print(to, to_arg, "unknown object %x", obj);
}
return(0);
}
static void dump_memory_map_to_stream(FILE *fp)
{
ErtsAlcType_t n;
MapStatBlock_t *bp;
int lock = !ERTS_IS_CRASH_DUMPING;
if (lock) {
ASSERT(!erts_is_allctr_wrapper_prelocked());
erts_mtx_lock(&instr_mutex);
}
/* Write header */
fprintf(fp,
"{instr_hdr,\n"
" %lu,\n"
" %lu,\n"
" {",
(unsigned long) ERTS_INSTR_VSN,
(unsigned long) MAP_STAT_BLOCK_HEADER_SIZE);
#if ERTS_ALC_N_MIN != 1
#error ERTS_ALC_N_MIN is not 1
#endif
for (n = ERTS_ALC_N_MIN; n <= ERTS_ALC_N_MAX; n++) {
ErtsAlcType_t t = ERTS_ALC_N2T(n);
ErtsAlcType_t a = ERTS_ALC_T2A(t);
ErtsAlcType_t c = ERTS_ALC_T2C(t);
const char *astr;
if (erts_allctrs_info[a].enabled)
astr = ERTS_ALC_A2AD(a);
else
astr = ERTS_ALC_A2AD(ERTS_ALC_A_SYSTEM);
fprintf(fp,
"%s{%s,%s,%s}%s",
(n == ERTS_ALC_N_MIN) ? "" : " ",
ERTS_ALC_N2TD(n),
astr,
ERTS_ALC_C2CD(c),
(n == ERTS_ALC_N_MAX) ? "" : ",\n");
}
fprintf(fp, "}}.\n");
/* Write memory data */
for (bp = mem_anchor; bp; bp = bp->next) {
if (is_internal_pid(bp->pid))
fprintf(fp,
"{%lu, %lu, %lu, {%lu,%lu,%lu}}.\n",
(UWord) bp->type_no,
(UWord) bp->mem,
(UWord) bp->size,
(UWord) pid_channel_no(bp->pid),
(UWord) pid_number(bp->pid),
(UWord) pid_serial(bp->pid));
else
fprintf(fp,
"{%lu, %lu, %lu, undefined}.\n",
(UWord) bp->type_no,
(UWord) bp->mem,
(UWord) bp->size);
}
if (lock)
erts_mtx_unlock(&instr_mutex);
}
apr_status_t port_socket_set_option(port_t *self, term_t opt, term_t value)
{
port_socket_data_t *data = self->data;
if (opt == A_EXPECT)
{
if (!is_int(value))
return APR_BADARG;
data->expected_size = int_value2(value);
if (data->expected_size < 0)
return APR_BADARG;
if (!is_pid(self->owner_in))
return APR_ENOPROC;
//enough data may already be there
if (data->expected_size == 0 && buffer_len(data->in_buf) > 0 ||
data->expected_size > 0 && buffer_len(data->in_buf) >= data->expected_size)
{
int len = (data->expected_size == 0)
?buffer_len(data->in_buf)
:data->expected_size;
xpool_t *tmp = xpool_make(self->pool);
term_t bin = make_binary(intnum(len), buffer_ptr(data->in_buf), tmp);
term_t msg = make_tuple3(A_TCP, port_id(self, tmp), bin, tmp);
process_t *proc = proc_lookup(pid_serial(self->owner_in));
proc_new_mail(proc, msg);
buffer_consume(data->in_buf, len);
xpool_destroy(tmp);
}
else
data->packet_expected = 1;
}
else if (opt == A_REQUIRE)
{
int size;
if (!is_int(value))
return APR_BADARG;
size = int_value2(value);
if (size < 0 || size > SOCK_OUTBUF_LEN)
return APR_BADARG;
data->required_size = size;
if (buffer_available(data->out_buf) >= size)
{
xpool_t *tmp = xpool_make(self->pool);
int avail = buffer_available(data->out_buf);
term_t msg = make_tuple3(A_TCP_SPACE, port_id(self, tmp), intnum(avail), tmp);
process_t *proc = proc_lookup(pid_serial(self->owner_out));
//TODO: insure that only owner can send to socket
proc_new_mail(proc, msg);
xpool_destroy(tmp);
data->space_required = 0;
}
else
data->space_required = 1;
}
else
return APR_BADARG;
return APR_SUCCESS;
}
