File: Dynamically.xs

package info (click to toggle)
libsyntax-keyword-dynamically-perl 0.14-1
  • links: PTS, VCS
  • area: main
  • in suites: forky, sid, trixie
  • size: 200 kB
  • sloc: perl: 463; makefile: 3
file content (512 lines) | stat: -rw-r--r-- 13,229 bytes parent folder | download
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
/*  You may distribute under the terms of either the GNU General Public License
 *  or the Artistic License (the same terms as Perl itself)
 *
 *  (C) Paul Evans, 2018 -- leonerd@leonerd.org.uk
 */
#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"

#include "AsyncAwait.h"

#include "XSParseKeyword.h"

#ifdef HAVE_DMD_HELPER
#  define WANT_DMD_API_044
#  include "DMD_helper.h"
#endif

#define HAVE_PERL_VERSION(R, V, S) \
    (PERL_REVISION > (R) || (PERL_REVISION == (R) && (PERL_VERSION > (V) || (PERL_VERSION == (V) && (PERL_SUBVERSION >= (S))))))

#include "perl-backcompat.c.inc"
#include "perl-additions.c.inc"
#include "newOP_CUSTOM.c.inc"

static bool is_async = FALSE;

#ifdef MULTIPLICITY
#  define dynamicstack  \
    *((AV **)hv_fetchs(PL_modglobal, "Syntax::Keyword::Dynamically/dynamicstack", GV_ADD))
#else
/* without MULTIPLICITY there's only one, so we might as well just store it
 * in a static
 */
static AV *dynamicstack;
#endif

#define ENSURE_HV(sv)  S_ensure_hv(aTHX_ sv)
static HV *S_ensure_hv(pTHX_ SV *sv)
{
  if(SvTYPE(sv) == SVt_PVHV)
    return (HV *)sv;

  croak("Expected HV, got SvTYPE(sv)=%d", SvTYPE(sv));
}

typedef struct {
  SV *var;    /* is HV * if keysv is set; indicates an HELEM */
  SV *keysv;
  SV *oldval; /* is NULL for HELEMs if we should delete at pop time */
  int saveix;
} DynamicVar;

#define newSVdynamicvar(var, key) S_newSVdynamicvar(aTHX_ var, key)
static SV *S_newSVdynamicvar(pTHX_ SV *var, SV *key)
{
  SV *ret = newSV(sizeof(DynamicVar));

#ifdef HAVE_DMD_HELPER
  if(DMD_IS_ACTIVE()) {
    SV *tmpRV = newRV_inc(ret);
    sv_bless(tmpRV, get_hv("Syntax::Keyword::Dynamically::_DynamicVar::", GV_ADD));
    SvREFCNT_dec(tmpRV);
  }
#endif

  DynamicVar *dyn = (void *)SvPVX((SV *)ret);

  dyn->var    = var;
  dyn->keysv  = key;
  dyn->saveix = PL_savestack_ix;

  if(key) {
    HV *hv = ENSURE_HV(var);
    HE *he = hv_fetch_ent(hv, key, 0, 0);
    dyn->oldval = he ? newSVsv(HeVAL(he)) : NULL;
  }
  else {
    dyn->oldval = newSVsv(var);
  }

  return ret;
}

#ifdef HAVE_DMD_HELPER
static int dmd_help_dynamicvar(pTHX_ DMDContext *ctx, const SV *sv)
{
  int ret = 0;

  DynamicVar *dyn = (void *)SvPVX((SV *)sv);

  if(dyn->keysv) {
    ret += DMD_ANNOTATE_SV(sv, dyn->var,    "the helem HV");
    ret += DMD_ANNOTATE_SV(sv, dyn->keysv,  "the helem key");
  }
  else
    ret += DMD_ANNOTATE_SV(sv, dyn->var,    "the variable slot");

  if(dyn->oldval)
    ret += DMD_ANNOTATE_SV(sv, dyn->oldval, "the old value slot");

  return ret;
}
#endif

typedef struct {
  SV *var;    /* is HV * if keysv is set; indicates an HELEM */
  SV *keysv;
  SV *curval; /* is NULL for HELEMs if we should delete at resume time */
  bool is_outer;
} SuspendedDynamicVar;

#define newSVsuspendeddynamicvar(var, key, is_outer) S_newSVsuspendeddynamicvar(aTHX_ var, key, is_outer)
static SV *S_newSVsuspendeddynamicvar(pTHX_ SV *var, SV *key, bool is_outer)
{
  SV *ret = newSV(sizeof(SuspendedDynamicVar));

#ifdef HAVE_DMD_HELPER
  if(DMD_IS_ACTIVE()) {
    SV *tmpRV = newRV_inc(ret);
    sv_bless(tmpRV, get_hv("Syntax::Keyword::Dynamically::_SuspendedDynamicVar::", GV_ADD));
    SvREFCNT_dec(tmpRV);
  }
#endif

  SuspendedDynamicVar *suspdyn = (void *)SvPVX((SV *)ret);

  suspdyn->var   = var;
  suspdyn->keysv = key;

  if(key) {
      HV *hv = ENSURE_HV(var);
      HE *he = hv_fetch_ent(hv, key, 0, 0);
      suspdyn->curval = he ? newSVsv(HeVAL(he)) : NULL;
  }
  else {
      suspdyn->curval = newSVsv(var);
  }

  suspdyn->is_outer = is_outer;

  return ret;
}

#ifdef HAVE_DMD_HELPER
static int dmd_help_suspendeddynamicvar(pTHX_ DMDContext *ctx, const SV *sv)
{
  int ret = 0;

  SuspendedDynamicVar *suspdyn = (void *)SvPVX((SV *)sv);

  if(suspdyn->keysv) {
    ret += DMD_ANNOTATE_SV(sv, suspdyn->var,    "the helem HV");
    ret += DMD_ANNOTATE_SV(sv, suspdyn->keysv,  "the helem key");
  }
  else
    ret += DMD_ANNOTATE_SV(sv, suspdyn->var,    "the variable slot");

  if(suspdyn->curval)
    ret += DMD_ANNOTATE_SV(sv, suspdyn->curval, "the current value slot");

  return ret;
}
#endif

#ifndef av_top_index
#  define av_top_index(av)  AvFILL(av)
#endif

#ifndef hv_deletes
#  define hv_deletes(hv, key, flags) \
    hv_delete((hv), ("" key ""), (sizeof(key)-1), (flags))
#endif

#define hv_setsv_or_delete(hv, key, val)  S_hv_setsv_or_delete(aTHX_ hv, key, val)
static void S_hv_setsv_or_delete(pTHX_ HV *hv, SV *key, SV *val)
{
  if(!val) {
    hv_delete_ent(hv, key, G_DISCARD, 0);
  }
  else
    sv_setsv(HeVAL(hv_fetch_ent(hv, key, 1, 0)), val);
}

static void S_popdyn(pTHX_ void *_data)
{
  AV *stack = dynamicstack;

  IV ix = av_top_index(stack);
  assert(ix > -1);

  SV *dv = AvARRAY(stack)[ix];
  assert(dv);

  DynamicVar *dyn = (void *)SvPVX(dv);
  assert(dyn);
  if(dyn->var != (SV *)_data)
    croak("ARGH: dynamicstack top mismatch");

  SV *sv = av_pop(stack);

  if(dyn->keysv) {
    HV *hv = ENSURE_HV(dyn->var);

    hv_setsv_or_delete(hv, dyn->keysv, dyn->oldval);

    SvREFCNT_dec(dyn->keysv);
  }
  else {
    sv_setsv_mg(dyn->var, dyn->oldval);
  }

  SvREFCNT_dec(dyn->var); dyn->var = NULL;
  SvREFCNT_dec(dyn->oldval); dyn->oldval = NULL;

  SvREFCNT_dec(sv);
}

static void hook_postsuspend(pTHX_ CV *cv, HV *modhookdata, void *hookdata)
{
  AV *stack = dynamicstack;

  IV i, max = av_top_index(stack);
  SV **avp = AvARRAY(stack);
  int height = PL_savestack_ix;
  AV *suspendedvars = NULL;

  for(i = max; i >= 0; i--) {
    DynamicVar *dyn = (void *)SvPVX(avp[i]);

    if(dyn->saveix < height)
      break;

    /* An inner dynamic variable - capture and restore */

    if(!suspendedvars) {
      suspendedvars = newAV();
      hv_stores(modhookdata, "Syntax::Keyword::Dynamically/suspendedvars", (SV *)suspendedvars);
    }

    av_push(suspendedvars,
      newSVsuspendeddynamicvar(dyn->var, dyn->keysv, false));

    if(dyn->keysv) {
      hv_setsv_or_delete(ENSURE_HV(dyn->var), dyn->keysv, dyn->oldval);
    }
    else {
      sv_setsv_mg(dyn->var, dyn->oldval);
    }
    SvREFCNT_dec(dyn->oldval);
  }

  if(i < max)
    /* truncate */
    av_fill(stack, i);

  for( ; i >= 0; i--) {
    DynamicVar *dyn = (void *)SvPVX(avp[i]);
    /* An outer dynamic variable - capture but do not restore */

    if(!suspendedvars) {
      suspendedvars = newAV();
      hv_stores(modhookdata, "Syntax::Keyword::Dynamically/suspendedvars", (SV *)suspendedvars);
    }

    av_push(suspendedvars,
      newSVsuspendeddynamicvar(SvREFCNT_inc(dyn->var), SvREFCNT_inc(dyn->keysv), true));
  }
}

static void hook_preresume(pTHX_ CV *cv, HV *modhookdata, void *hookdata)
{
  AV *suspendedvars = (AV *)hv_deletes(modhookdata, "Syntax::Keyword::Dynamically/suspendedvars", 0);
  if(!suspendedvars)
    return;

  SV **avp = AvARRAY(suspendedvars);
  IV i, max = av_top_index(suspendedvars);

  for(i = max; i >= 0; i--) {
    SuspendedDynamicVar *suspdyn = (void *)SvPVX(avp[i]);

    SV *var = suspdyn->var;
    av_push(dynamicstack,
      newSVdynamicvar(var, suspdyn->keysv));

    if(suspdyn->keysv) {
      hv_setsv_or_delete((HV *)var, suspdyn->keysv, suspdyn->curval);
    }
    else {
      sv_setsv_mg(var, suspdyn->curval);
    }
    SvREFCNT_dec(suspdyn->curval);

    if(suspdyn->is_outer) {
      SAVEDESTRUCTOR_X(&S_popdyn, suspdyn->var);
    }
    else {
      /* Don't SAVEDESTRUCTOR_X a second time because F-AA restored it */
    }
  }
}

static const struct AsyncAwaitHookFuncs faa_hooks = {
  .post_suspend = &hook_postsuspend,
  .pre_resume   = &hook_preresume,
};

/* STARTDYN is the primary op that makes this work. It is used in two ways:
 *   With OPf_STACKED it takes an optree, which pushes an SV to the stack.
 *   Without OPf_STACKED it uses op->op_targ to select a lexical
 * Either way, it saves the current value of the SV and arranges for that
 * value to be assigned back in on scope exit
 *
 * This op is _not_ used for dynamic assignments to hash elements; for that
 * see HELEMDYN
 */

static XOP xop_startdyn;

static OP *pp_startdyn(pTHX)
{
  dSP;
  SV *var = (PL_op->op_flags & OPf_STACKED) ? TOPs : PAD_SV(PL_op->op_targ);

  if(is_async) {
    av_push(dynamicstack,
      newSVdynamicvar(SvREFCNT_inc(var), NULL));
    SAVEDESTRUCTOR_X(&S_popdyn, var);
  }
  else {
    save_freesv(SvREFCNT_inc(var));
    /* When save_item() is restored it won't reset the SvPADMY flag properly.
     * This upsets -DDEBUGGING perls, so we'll have to save the flags too */
    if(SvFLAGS(var) & SVs_PADMY)
      save_set_svflags(var, SvFLAGS(var), SvFLAGS(var));
    save_item(var);
  }

  return cUNOP->op_next;
}

/* HELEMDYN is a variant of core's HELEM op which arranges for the existing
 * value (or absence of) the key in the hash to be restored again on scope
 * exit. It copes with missing keys by deleting them again to "restore".
 */

static void S_restore(pTHX_ void *_data)
{
  DynamicVar *dyn = _data;

  if(dyn->keysv) {
    hv_setsv_or_delete(ENSURE_HV(dyn->var), dyn->keysv, dyn->oldval);

    SvREFCNT_dec(dyn->var);
    SvREFCNT_dec(dyn->keysv);
    SvREFCNT_dec(dyn->oldval);
  }
  else
    croak("ARGH: Expected a keysv");

  Safefree(dyn);
}

static XOP xop_helemdyn;

static OP *pp_helemdyn(pTHX)
{
  /* Contents inspired by core's pp_helem */
  dSP;
  SV * keysv = POPs;
  HV * const hv = MUTABLE_HV(POPs);

  /* Take a long-lived copy of keysv */
  keysv = newSVsv(keysv);

  bool preexisting = hv_exists_ent(hv, keysv, 0);
  HE *he;

  if(is_async) {
    SvREFCNT_inc((SV *)hv);

    av_push(dynamicstack,
      newSVdynamicvar((SV *)hv, keysv));
    SAVEDESTRUCTOR_X(&S_popdyn, (SV *)hv);

    /* must fetch -after- calling newSVdynamicvar() */
    he = hv_fetch_ent(hv, keysv, 1, 0);
  }
  else {
    DynamicVar *dyn;
    Newx(dyn, 1, DynamicVar);

    he = hv_fetch_ent(hv, keysv, 1, 0);

    dyn->var   = SvREFCNT_inc(hv);
    dyn->keysv = SvREFCNT_inc(keysv);
    dyn->oldval = preexisting ? newSVsv(HeVAL(he)) : NULL;
    SAVEDESTRUCTOR_X(&S_restore, dyn);
  }

  PUSHs(HeVAL(he));

  RETURN;
}

static int build_dynamically(pTHX_ OP **out, XSParseKeywordPiece *arg0, void *hookdata)
{
  OP *aop = arg0->op;
  OP *lvalop = NULL, *rvalop = NULL;

  /* While most scalar assignments become OP_SASSIGN, some cases of assignment
   * from a binary operator into a pad lexical instead set OPpTARGET_MY and use
   * op->op_targ instead.
   */
  if((PL_opargs[aop->op_type] & OA_TARGLEX) && (aop->op_private & OPpTARGET_MY)) {
    /* dynamically LEXVAR = EXPR */

    /* Since LEXVAR is a pad lexical we can generate a non-stacked STARTDYN
     * and set the same targ on it, then perform that just before the
     * otherwise-unmodified op
     */
    OP *dynop = newUNOP_CUSTOM(&pp_startdyn, 0, newOP(OP_NULL, 0));
    dynop->op_targ = aop->op_targ;

    *out = op_prepend_elem(OP_LINESEQ,
      dynop, aop);

    return KEYWORD_PLUGIN_EXPR;
  }

  if(aop->op_type != OP_SASSIGN)
    croak("Expected scalar assignment for 'dynamically'");

  rvalop = cBINOPx(aop)->op_first;
  lvalop = cBINOPx(aop)->op_last;

  if(lvalop->op_type == OP_HELEM) {
    /* dynamically $h{key} = EXPR */

    /* In order to handle with the added complexities around delete $h{key}
     * we need to use our special version of OP_HELEM here instead of simply
     * calling STARTDYN on the fetched SV
     */

    /* Change the OP_HELEM into our custom one.
     * To ensure the peephole optimiser doesn't turn this into multideref we
     * have to change the op_type too */
    lvalop->op_type = OP_CUSTOM;
    lvalop->op_ppaddr = &pp_helemdyn;
    *out = aop;
  }
  else {
    /* dynamimcally LEXPR = EXPR */

    /* Rather than splicing in STARTDYN op, we'll just make a new optree */
    *out = newBINOP(aop->op_type, aop->op_flags,
      rvalop,
      newUNOP_CUSTOM(&pp_startdyn, aop->op_flags & OPf_STACKED, lvalop));

    /* op_free will destroy the entire optree so replace the child ops first */
    cBINOPx(aop)->op_first = NULL;
    cBINOPx(aop)->op_last = NULL;
    aop->op_flags &= ~OPf_KIDS;
    op_free(aop);
  }

  return KEYWORD_PLUGIN_EXPR;
}

static const struct XSParseKeywordHooks hooks_dynamically = {
  .permit_hintkey = "Syntax::Keyword::Dynamically/dynamically",
  .piece1 = XPK_TERMEXPR,
  .build1 = &build_dynamically,
};

static void enable_async_mode(pTHX_ void *_unused)
{
  if(is_async)
    return;

  is_async = TRUE;
  AV *stack = dynamicstack = newAV();
  av_extend(stack, 50);

  boot_future_asyncawait(0.60);
  register_future_asyncawait_hook(&faa_hooks, NULL);
}

MODULE = Syntax::Keyword::Dynamically    PACKAGE = Syntax::Keyword::Dynamically

void
_enable_async_mode()
  CODE:
    enable_async_mode(aTHX_ NULL);

BOOT:
  XopENTRY_set(&xop_startdyn, xop_name, "startdyn");
  XopENTRY_set(&xop_startdyn, xop_desc,
    "starts a dynamic variable scope");
  XopENTRY_set(&xop_startdyn, xop_class, OA_UNOP);
  Perl_custom_op_register(aTHX_ &pp_startdyn, &xop_startdyn);

  boot_xs_parse_keyword(0.13);

  register_xs_parse_keyword("dynamically", &hooks_dynamically, NULL);
#ifdef HAVE_DMD_HELPER
  DMD_SET_PACKAGE_HELPER("Syntax::Keyword::Dynamically::_DynamicVar", &dmd_help_dynamicvar);
  DMD_SET_PACKAGE_HELPER("Syntax::Keyword::Dynamically::_SuspendedDynamicVar", &dmd_help_suspendeddynamicvar);
#endif

  future_asyncawait_on_activate(&enable_async_mode, NULL);