/* run a regular md
* teql steps for equilibration, tmax steps for production
* tp: the real temperature, tps: thermostat temperature */
INLINE int cago_mdrun(cago_t *go, real mddt, real thermdt,
real tps, real tp, av_t *avep, av_t *avrmsd,
int teql, int tmax, int trep)
{
int t;
real fs = tps/tp, rmsd;
tmax = (tmax < 0) ? -1 : (tmax + teql);
av_clear(avep);
av_clear(avrmsd);
for (t = 1; tmax < 0 || t <= tmax; t++) {
cago_vv(go, fs, mddt);
cago_rmcom(go, go->x, go->v);
cago_vrescale(go, (real) tps, thermdt, &go->ekin, &go->tkin);
rmsd = cago_rmsd(go, go->x, NULL);
if (t > teql) {
av_add(avep, go->epot);
av_add(avrmsd, rmsd);
}
if (trep > 0 && t % trep == 0) {
printf("%9d: tp %.4f, tps %.4f, rmsd %7.4f, K %.2f, U %.2f\n",
t, tp, tps, rmsd, go->ekin, go->epot);
}
}
return 0;
}
static void rlm_perl_clear_handles(pTHX)
{
AV *librefs = get_av(dl_librefs, false);
if (librefs) {
av_clear(librefs);
}
}
/* Handles the row, adding it into the internal structure */
static void
invoke_row(AV *req, SV *reqrv, SV *rowsrv)
{
SV *meth;
dSP;
ENTER;
SAVETMPS;
PUSHMARK(SP);
/* First arg */
XPUSHs(reqrv);
meth = *av_fetch(req, PLCB_VHIDX_PRIVCB, 0);
if (rowsrv) {
XPUSHs(rowsrv);
}
PUTBACK;
call_sv(meth, G_DISCARD|G_EVAL);
SPAGAIN;
if (SvTRUE(ERRSV)) {
warn("Got error in %s", SvPV_nolen(ERRSV));
}
if (rowsrv) {
av_clear((AV *)SvRV(rowsrv));
}
FREETMPS;
LEAVE;
}
USER_OBJECT_
RS_PerlClear(USER_OBJECT_ obj)
{
SV *sv;
int n;
USER_OBJECT_ ans;
dTHX;
ans = NEW_LOGICAL(1);
sv = RS_PerlGetSV(obj);
if(sv == NULL)
return(ans);
switch(SvTYPE(sv)) {
case SVt_PVHV:
hv_clear((HV*) sv);
break;
case SVt_PVAV:
av_clear((AV*) sv);
break;
default:
n = 1;
break;
}
LOGICAL_DATA(ans)[0] = TRUE;
return(ans);
}
void modperl_xs_dl_handles_clear(pTHX)
{
AV *librefs = get_av(dl_librefs, FALSE);
if (librefs) {
av_clear(librefs);
}
}
static SV *
ForceScalarLvalue(pTHX_ SV *sv)
{
if (SvTYPE(sv) == SVt_PVAV)
{
AV *av = (AV *) sv;
SV *newsv = newSVpv("",0);
av_clear(av);
av_store(av,0,newsv);
return newsv;
}
else
{
return sv;
}
}
SRL_STATIC_INLINE void
srl_clear_decoder(pTHX_ srl_decoder_t *dec)
{
if (dec->buf_start == dec->buf_end)
return;
SRL_DEC_RESET_VOLATILE_FLAGS(dec);
dec->buf_start = dec->buf_end = dec->pos = dec->save_pos = NULL;
if (dec->weakref_av)
av_clear(dec->weakref_av);
PTABLE_clear(dec->ref_seenhash);
if (dec->ref_stashes) {
PTABLE_clear(dec->ref_stashes);
PTABLE_clear(dec->ref_bless_av);
}
dec->recursion_depth = 0;
}
static SV *
ForceScalar(pTHX_ SV *sv)
{
if (SvGMAGICAL(sv))
mg_get(sv);
if (SvTYPE(sv) == SVt_PVAV)
{
AV *av = (AV *) sv;
SV *newsv = newSVpv("",0);
Scalarize(aTHX_ newsv, (AV *) av);
av_clear(av);
av_store(av,0,newsv);
return newsv;
}
else
{
if (SvROK(sv) && !SvOBJECT(SvRV(sv)) && SvTYPE(SvRV(sv)) == SVt_PVAV)
{
/* Callbacks and lists often get stringified by mistake due to
Tcl/Tk's string fixation - don't change the real value
*/
SV *newsv = newSVpv("",0);
Scalarize(aTHX_ newsv, (AV *) SvRV(sv));
return sv_2mortal(newsv);
}
else if (!SvOK(sv))
{
/* Map undef to null string */
if (SvREADONLY(sv))
{
SV *newsv = newSVpv("",0);
return sv_2mortal(newsv);
}
else
sv_setpvn(sv,"",0);
}
return sv;
}
}
void perl_signal_args_to_c(
void (*callback)(void *, void **), void *cb_arg,
int signal_id, SV **args, size_t n_args)
{
union {
int v_int;
unsigned long v_ulong;
GSList *v_gslist;
GList *v_glist;
} saved_args[SIGNAL_MAX_ARGUMENTS];
void *p[SIGNAL_MAX_ARGUMENTS];
PERL_SIGNAL_ARGS_REC *rec;
size_t n;
if (!(rec = perl_signal_args_find(signal_id))) {
const char *name = signal_get_id_str(signal_id);
if (!name) {
croak("%d is not a known signal id", signal_id);
}
croak("\"%s\" is not a registered signal", name);
}
for (n = 0; n < SIGNAL_MAX_ARGUMENTS && n < n_args && rec->args[n] != NULL; ++n) {
void *c_arg;
SV *arg = args[n];
if (!SvOK(arg)) {
c_arg = NULL;
} else if (strcmp(rec->args[n], "string") == 0) {
c_arg = SvPV_nolen(arg);
} else if (strcmp(rec->args[n], "int") == 0) {
c_arg = (void *)SvIV(arg);
} else if (strcmp(rec->args[n], "ulongptr") == 0) {
saved_args[n].v_ulong = SvUV(arg);
c_arg = &saved_args[n].v_ulong;
} else if (strcmp(rec->args[n], "intptr") == 0) {
saved_args[n].v_int = SvIV(SvRV(arg));
c_arg = &saved_args[n].v_int;
} else if (strncmp(rec->args[n], "glistptr_", 9) == 0) {
GList *gl;
int is_str;
AV *av;
SV *t;
int count;
t = SvRV(arg);
if (SvTYPE(t) != SVt_PVAV) {
croak("Not an ARRAY reference");
}
av = (AV *)t;
is_str = strcmp(rec->args[n]+9, "char*") == 0;
gl = NULL;
count = av_len(av) + 1;
while (count-- > 0) {
SV **px = av_fetch(av, count, 0);
SV *x = px ? *px : NULL;
gl = g_list_prepend(
gl,
x == NULL ? NULL :
is_str ? g_strdup(SvPV_nolen(x)) :
irssi_ref_object(x)
);
}
saved_args[n].v_glist = gl;
c_arg = &saved_args[n].v_glist;
} else if (strncmp(rec->args[n], "gslist_", 7) == 0) {
GSList *gsl;
AV *av;
SV *t;
int count;
t = SvRV(arg);
if (SvTYPE(t) != SVt_PVAV) {
croak("Not an ARRAY reference");
}
av = (AV *)t;
gsl = NULL;
count = av_len(av) + 1;
while (count-- > 0) {
SV **x = av_fetch(av, count, 0);
gsl = g_slist_prepend(
gsl,
x == NULL ? NULL :
irssi_ref_object(*x)
);
}
c_arg = saved_args[n].v_gslist = gsl;
} else {
c_arg = irssi_ref_object(arg);
}
p[n] = c_arg;
}
for (; n < SIGNAL_MAX_ARGUMENTS; ++n) {
p[n] = NULL;
}
callback(cb_arg, p);
for (n = 0; n < SIGNAL_MAX_ARGUMENTS && n < n_args && rec->args[n] != NULL; ++n) {
SV *arg = args[n];
if (!SvOK(arg)) {
continue;
}
if (strcmp(rec->args[n], "intptr") == 0) {
SV *t = SvRV(arg);
SvIOK_only(t);
SvIV_set(t, saved_args[n].v_int);
} else if (strncmp(rec->args[n], "gslist_", 7) == 0) {
g_slist_free(saved_args[n].v_gslist);
} else if (strncmp(rec->args[n], "glistptr_", 9) == 0) {
int is_iobject, is_str;
AV *av;
GList *gl, *tmp;
is_iobject = strcmp(rec->args[n]+9, "iobject") == 0;
is_str = strcmp(rec->args[n]+9, "char*") == 0;
av = (AV *)SvRV(arg);
av_clear(av);
gl = saved_args[n].v_glist;
for (tmp = gl; tmp != NULL; tmp = tmp->next) {
av_push(av,
is_iobject ? iobject_bless((SERVER_REC *)tmp->data) :
is_str ? new_pv(tmp->data) :
irssi_bless_plain(rec->args[n]+9, tmp->data)
);
}
if (is_str) {
g_list_foreach(gl, (GFunc)g_free, NULL);
}
g_list_free(gl);
}
}
}
void clear() {
av_clear(impl());
}
void p5_av_clear(PerlInterpreter *my_perl, AV *av) {
PERL_SET_CONTEXT(my_perl);
av_clear(av);
}
static void read_from_child(struct context *ctx, int cur)
{
ssize_t len;
DebugIn(DEBUG_MAVIS);
len = Read(ctx->fd_in, ctx->b_in + ctx->b_in_len, sizeof(ctx->b_in) - ctx->b_in_len - 1);
if (len > 0) {
char *t;
int matchlevel = 0;
Debug((DEBUG_PROC, "%s:%d %s\n", __FILE__, __LINE__, ctx->mcx->path));
ctx->b_in_len += len;
ctx->b_in[ctx->b_in_len] = 0;
for (t = ctx->b_in + ctx->b_in_len - 1; t > ctx->b_in; t--)
switch (matchlevel) {
case 0:
if (*t != '\n') {
DebugOut(DEBUG_MAVIS);
return;
}
matchlevel++;
break;
case 1:
if (!isdigit((int) *t)) {
DebugOut(DEBUG_MAVIS);
return;
}
matchlevel++;
break;
case 2:
if (!isdigit((int) *t) && *t != '-' && *t != '=') {
DebugOut(DEBUG_MAVIS);
return;
}
if (*t == '=')
matchlevel++;
break;
case 3:
if (*t == '\n') {
rb_node_t *r;
struct query *q;
char *serial = av_get(ctx->ac, AV_A_SERIAL);
char *serial_old = alloca(strlen(serial) + 1);
int result;
strcpy(serial_old, serial);
io_clr_i(ctx->mcx->io, ctx->fd_in);
av_clear(ctx->ac);
*++t = 0;
av_char_to_array(ctx->ac, ctx->b_in, NULL);
result = atoi(++t);
ctx->in_use = 0;
ctx->mcx->usage--;
serial = av_get(ctx->ac, AV_A_SERIAL);
if (!serial || strcmp(serial, serial_old)) {
if (serial)
logmsg("%s: %lu: out of sync: " "got %s, expected %s. Terminating.", ctx->mcx->argv[0], (u_long) ctx->pid, serial, serial_old);
else
logmsg("%s: %lu: missing serial. Terminating.", ctx->mcx->argv[0], (u_long) ctx->pid);
av_free(ctx->ac);
ctx->ac = NULL;
kill(ctx->pid, SIGTERM);
child_died(ctx, ctx->fd_in);
DebugOut(DEBUG_MAVIS);
return;
}
q = Xcalloc(1, sizeof(struct context));
q->ac = ctx->ac;
ctx->ac = NULL;
q->result = result;
q->canceled = ctx->canceled;
ctx->canceled = 0;
RB_insert(ctx->mcx->outgoing, q);
#ifdef DEBUG_RB
fprintf(stderr, "EXT insert outgoing %p\n", q);
#endif
if (ctx->mcx->io_context_parent) {
if (!RB_empty(ctx->mcx->backlog_fifo)) {
rb_node_t *rbn = RB_first(ctx->mcx->backlog_fifo);
struct query *qp = RB_payload(rbn, struct query *);
Debug((DEBUG_PROC, "%s:%d\n", __FILE__, __LINE__));
RB_search_and_delete(ctx->mcx->backlog_app_ctx, qp);
RB_search_and_delete(ctx->mcx->backlog_serial, qp);
ctx->ac = qp->ac;
qp->ac = NULL;
RB_delete(ctx->mcx->backlog_fifo, rbn);
#ifdef DEBUG_RB
fprintf(stderr, "EXT remove backlog_fifo %p\n", RB_payload(rbn, void *));
#endif
ctx->mcx->backlog_cur--;
ctx->mcx->usage++;
ctx->mcx->cx_stat[ctx->index].counter++;
ctx->mcx->cx_stat[ctx->index].counter_p++;
start_query(ctx);
}
while ((r = RB_first(ctx->mcx->outgoing))) {
struct query *qp = RB_payload(r, struct query *);
if (ctx->mcx->ac_bak)
av_free(ctx->mcx->ac_bak);
ctx->mcx->ac_bak = qp->ac_bak;
qp->ac_bak = NULL;
if (q->canceled) {
av_free(ctx->mcx->ac_bak);
ctx->mcx->ac_bak = NULL;
RB_delete(ctx->mcx->outgoing, r);
} else
((void (*)(void *)) qp->ac->app_cb) (qp->ac->app_ctx);
}
}
DebugOut(DEBUG_MAVIS);
return;
}
