src/pmc/eval.pmc

   1 /*
   2 Copyright (C) 2001-2010, Parrot Foundation.
   3 $Id$
   4
   5 =head1 NAME
   6
   7 src/pmc/eval.pmc - Dynamic code evaluation
   8
   9 =head1 DESCRIPTION
  10
  11 C<Eval> extends C<Sub> to provide C<eval>-like dynamic code
  12 evaluation and execution.
  13
  14 =head2 Methods
  15
  16 =over 4
  17
  18 =cut
  19
  20 */
  21
  22 #include "pmc/pmc_sub.h"
  23
  24 /* HEADERIZER HFILE: none */
  25 /* HEADERIZER BEGIN: static */
  26 /* Don't modify between HEADERIZER BEGIN / HEADERIZER END.  Your changes will be lost. */
  27
  28 static void clear_fixups(PARROT_INTERP,
  29     ARGIN(const Parrot_Sub_attributes *sub_data))
  30         __attribute__nonnull__(1)
  31         __attribute__nonnull__(2);
  32
  33 PARROT_WARN_UNUSED_RESULT
  34 PARROT_CAN_RETURN_NULL
  35 static PMC* get_sub(PARROT_INTERP, ARGIN(PMC *self), int idx)
  36         __attribute__nonnull__(1)
  37         __attribute__nonnull__(2);
  38
  39 static void mark_subs(PARROT_INTERP, ARGIN(PMC *self))
  40         __attribute__nonnull__(1)
  41         __attribute__nonnull__(2);
  42
  43 #define ASSERT_ARGS_clear_fixups __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
  44        PARROT_ASSERT_ARG(interp) \
  45     , PARROT_ASSERT_ARG(sub_data))
  46 #define ASSERT_ARGS_get_sub __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
  47        PARROT_ASSERT_ARG(interp) \
  48     , PARROT_ASSERT_ARG(self))
  49 #define ASSERT_ARGS_mark_subs __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
  50        PARROT_ASSERT_ARG(interp) \
  51     , PARROT_ASSERT_ARG(self))
  52 /* Don't modify between HEADERIZER BEGIN / HEADERIZER END.  Your changes will be lost. */
  53 /* HEADERIZER END: static */
  54
  55 static void
  56 clear_fixups(PARROT_INTERP, ARGIN(const Parrot_Sub_attributes *sub_data))
  57 {
  58     ASSERT_ARGS(clear_fixups)
  59
  60     INTVAL               i;
  61     PackFile_ByteCode   * const seg = sub_data->seg;
  62     PackFile_FixupTable *ft;
  63     PackFile_ConstTable *ct;
  64
  65     if (!seg)
  66         return;
  67
  68     ft = seg->fixups;
  69     if (!ft)
  70         return;
  71
  72     ct = seg->const_table;
  73     if (!ct)
  74         return;
  75
  76     for (i = 0; i < ft->fixup_count; ++i) {
  77         PackFile_FixupEntry * const e = ft->fixups + i;
  78
  79         if (e->type == enum_fixup_sub) {
  80             opcode_t  ci             = e->offset;
  81
  82             ct->constants[ci]->u.key = NULL;
  83             e->type                  = 0;
  84         }
  85     }
  86 }
  87
  88 PARROT_WARN_UNUSED_RESULT
  89 PARROT_CAN_RETURN_NULL
  90 static PMC*
  91 get_sub(PARROT_INTERP, ARGIN(PMC *self), int idx)
  92 {
  93     ASSERT_ARGS(get_sub)
  94
  95     INTVAL                 i, n;
  96     Parrot_Sub_attributes *sub;
  97     PackFile_ByteCode     *seg;
  98     PackFile_FixupTable   *ft;
  99     PackFile_ConstTable   *ct;
 100
 101     PMC_get_sub(interp, self, sub);
 102     seg = sub->seg;
 103
 104     if (!seg)
 105         return PMCNULL;
 106
 107     ft = seg->fixups;
 108     if (!ft)
 109         return PMCNULL;
 110
 111     ct = seg->const_table;
 112     if (!ct)
 113         return PMCNULL;
 114
 115     for (i = n = 0; i < ft->fixup_count; ++i) {
 116         const PackFile_FixupEntry * const e = ft->fixups + i;
 117
 118         if (e->type == enum_fixup_sub) {
 119             opcode_t ci = e->offset;
 120
 121             if (n++ == idx)
 122                 return ct->constants[ci]->u.key;
 123         }
 124     }
 125
 126     return PMCNULL;
 127 }
 128
 129 static void
 130 mark_subs(PARROT_INTERP, ARGIN(PMC *self))
 131 {
 132     ASSERT_ARGS(mark_subs)
 133
 134     Parrot_Sub_attributes *sub;
 135     PackFile_ByteCode   *seg;
 136     PackFile_FixupTable *ft;
 137     PackFile_ConstTable *ct;
 138     INTVAL               i;
 139
 140     PMC_get_sub(interp, self, sub);
 141     seg = sub->seg;
 142
 143     if (!seg)
 144         return;
 145
 146     ft = seg->fixups;
 147     if (!ft)
 148         return;
 149
 150     ct = seg->const_table;
 151     if (!ct)
 152         return;
 153
 154     for (i = 0; i < ft->fixup_count; ++i) {
 155         const PackFile_FixupEntry * const e = ft->fixups + i;
 156
 157         if (e->type == enum_fixup_sub) {
 158             opcode_t  ci  = e->offset;
 159             PMC      *sub = ct->constants[ci]->u.key;
 160
 161             Parrot_gc_mark_PMC_alive(interp, sub);
 162         }
 163     }
 164 }
 165
 166 pmclass Eval extends Sub auto_attrs {
 167
 168     VTABLE void init() {
 169         Parrot_Sub_attributes *sub_data;
 170         SUPER();
 171
 172         PMC_get_sub(INTERP, SELF, sub_data);
 173         sub_data->seg = NULL;
 174         PObj_custom_mark_destroy_SETALL(SELF);
 175     }
 176 /*
 177
 178 =item C<opcode_t *invoke(void *next)>
 179
 180 Invokes the first subroutine in the eval code.
 181
 182 =cut
 183
 184 */
 185
 186     VTABLE opcode_t *invoke(void *next) {
 187         PMC *sub = SELF.get_pmc_keyed_int(0);
 188         return VTABLE_invoke(INTERP, sub, next);
 189     }
 190
 191     VTABLE void destroy() {
 192         /*
 193          * If the compiled code contained any .sub (or .pcc.sub)
 194          * subroutines, these subs got installed in the globals
 195          * during compiling this bytecode segment.
 196          *
 197          * These globals still exist, calling them will segfault
 198          * as the segment is destroyed now.
 199          *
 200          * TT # 1230:
 201          * Walk the fixups, locate globals and nullify the Sub PMC
 202          * This probably needs a pointer into the globals.
 203          *
 204          * OTOH - if the global exists - this eval pmc ought
 205          *        to be alive and destroy isn't called.
 206          */
 207         PackFile_Segment  *seg;
 208         PackFile_ByteCode *cur_cs;
 209         Parrot_Sub_attributes *sub_data;
 210
 211         PMC_get_sub(INTERP, SELF, sub_data);
 212
 213         if (!sub_data) {
 214             SUPER();
 215             return;
 216         }
 217
 218         clear_fixups(INTERP, sub_data);
 219         cur_cs = sub_data->seg;
 220
 221         if (!cur_cs) {
 222             SUPER();
 223             return;
 224         }
 225
 226         /* XXX Quick and dirty fix for TT #995 */
 227         if ((struct PackFile *)cur_cs == INTERP->initial_pf
 228                 || cur_cs == INTERP->code) {
 229             SUPER();
 230             return;
 231         }
 232
 233         /* TT #1315 create PF API, move it there */
 234         seg = (PackFile_Segment *)cur_cs->const_table;
 235         if (seg) {
 236             PackFile_Segment_destroy(INTERP, seg);
 237             cur_cs->const_table = NULL;
 238         }
 239
 240         seg = (PackFile_Segment *)cur_cs->debugs;
 241         if (seg) {
 242             PackFile_Segment_destroy(INTERP, seg);
 243             cur_cs->debugs = NULL;
 244         }
 245
 246         seg = (PackFile_Segment *)cur_cs->fixups;
 247         if (seg) {
 248             PackFile_Segment_destroy(INTERP, seg);
 249             cur_cs->fixups = NULL;
 250         }
 251
 252         seg = (PackFile_Segment *)cur_cs;
 253         if (seg)
 254             PackFile_Segment_destroy(INTERP, seg);
 255
 256         sub_data->seg = NULL;
 257
 258         SUPER();
 259     }
 260
 261     VTABLE void mark() {
 262         SUPER();
 263         mark_subs(INTERP, SELF);
 264     }
 265
 266 /*
 267
 268 =item C<STRING *get_string>
 269
 270 Get a STRING representing the bytecode for this code segment, suitable
 271 for writing to disc and later loading via C<load_bytecode>.
 272
 273 =cut
 274
 275 */
 276
 277     VTABLE STRING *get_string() {
 278         Parrot_Sub_attributes *sub;
 279         PackFile          *pf  = PackFile_new(INTERP, 0);
 280         PackFile_ByteCode *seg;
 281         STRING            *res;
 282         size_t             size, aligned_size;
 283
 284         PMC_get_sub(INTERP, SELF, sub);
 285         seg = sub->seg;
 286
 287         PackFile_add_segment(INTERP, &pf->directory, (PackFile_Segment *)seg);
 288
 289         if (seg->const_table)
 290             PackFile_add_segment(INTERP, &pf->directory,
 291                     (PackFile_Segment *)seg->const_table);
 292
 293         if (seg->debugs)
 294             PackFile_add_segment(INTERP, &pf->directory,
 295                     (PackFile_Segment *)seg->debugs);
 296
 297         if (seg->fixups)
 298             PackFile_add_segment(INTERP, &pf->directory,
 299                     (PackFile_Segment *)seg->fixups);
 300
 301         size = PackFile_pack_size(INTERP, pf) * sizeof (opcode_t);
 302
 303         /*
 304          * work around packfile bug:
 305          * as far as I have checked it the story is:
 306          * - PackFile_pack_size() assumes 16 byte alignment but doesn't
 307          *   have the actual start of the code (packed)
 308          * - PackFile_pack() uses 16 bye alignment relative to the start
 309          *   of the code, which isn't really the same
 310          * Therefore align code at 16, which should give the desired
 311          * effect
 312          */
 313         aligned_size = size + 15;
 314         res          = Parrot_str_new_noinit(INTERP, enum_stringrep_one,
 315                                          aligned_size);
 316         res->strlen  = res->bufused = size;
 317
 318         if ((size_t)(res->strstart) & 0xf) {
 319             char *adr     = res->strstart;
 320             adr          += 16 - ((size_t)adr & 0xf);
 321             res->strstart = adr;
 322         }
 323
 324         /* We block GC while doing the packing, since GC run during a pack
 325            has been observed to cause problems. There may be a Better Fix.
 326            See http://rt.perl.org/rt3/Ticket/Display.html?id=40410
 327            for example of the problem (note on line that
 328            segfaults, it is *cursor that is pointing to dealloced memory). */
 329         Parrot_block_GC_mark(INTERP);
 330         PackFile_pack(INTERP, pf, (opcode_t *)res->strstart);
 331         Parrot_unblock_GC_mark(INTERP);
 332
 333         /* now remove all segments from directory again and destroy
 334          * the packfile */
 335         pf->directory.num_segments = 0;
 336         PackFile_destroy(INTERP, pf);
 337
 338         return res;
 339     }
 340
 341 /*
 342
 343 =item C<PMC *get_pmc_keyed_int(INTVAL key)>
 344
 345 Returns the Sub PMC of the element at index C<key> or PMCNULL.
 346
 347 =cut
 348
 349 */
 350
 351     VTABLE PMC *get_pmc_keyed_int(INTVAL key) {
 352         return get_sub(INTERP, SELF, key);
 353     }
 354
 355 /*
 356
 357 =item C<void freeze(PMC *info)>
 358
 359 Archives the evaled code
 360
 361 =item C<void thaw(PMC *info)>
 362
 363 Unarchives the code.
 364
 365 =cut
 366
 367 */
 368
 369     VTABLE void freeze(PMC *info) {
 370         STRING   *packed = SELF.get_string();
 371         VTABLE_push_string(INTERP, info, packed);
 372
 373         SUPER(info);
 374     }
 375
 376     VTABLE void thaw(PMC *info) {
 377         STRING           *packed = VTABLE_shift_string(INTERP, info);
 378         PackFile         *pf;
 379         PackFile_Segment *seg;
 380         Parrot_Sub_attributes *sub;
 381         size_t            i;
 382
 383         SUPER(info);
 384         pf = PackFile_new(INTERP, 0);
 385
 386         if (!PackFile_unpack(INTERP, pf, (opcode_t *)packed->strstart,
 387                 packed->strlen))
 388             Parrot_ex_throw_from_c_args(INTERP, NULL, EXCEPTION_EXTERNAL_ERROR,
 389                 "couldn't unpack packfile");
 390
 391         do_sub_pragmas(INTERP, pf->cur_cs, PBC_PBC, SELF);
 392
 393         for (i = 0; i < pf->directory.num_segments; ++i) {
 394             seg = pf->directory.segments[i];
 395
 396             if (seg->type == PF_BYTEC_SEG) {
 397                 PMC_get_sub(INTERP, SELF, sub);
 398                 sub->seg = (PackFile_ByteCode *)seg;
 399                 break;
 400             }
 401         }
 402
 403         pf->directory.num_segments = 0;
 404
 405         /*
 406          * TT #1292 this isn't ok - it seems that the packfile
 407          *     gets attached to INTERP->code and is
 408          *     destroyed again during interpreter destruction
 409          */
 410         /* PackFile_destroy(INTERP, pf); */
 411     }
 412
 413     VTABLE INTVAL elements() {
 414         INTVAL               i, n;
 415         Parrot_Sub_attributes *sub;
 416         PackFile_ByteCode   *seg;
 417         PackFile_FixupTable *ft;
 418
 419         PMC_get_sub(INTERP, SELF, sub);
 420         seg = sub->seg;
 421
 422         if (!seg)
 423             return 0;
 424
 425         ft = seg->fixups;
 426         if (!ft)
 427             return 0;
 428
 429         for (i = n = 0; i < ft->fixup_count; ++i) {
 430             const PackFile_FixupEntry * const e = ft->fixups + i;
 431
 432             if (e->type == enum_fixup_sub)
 433                 ++n;
 434         }
 435
 436         return n;
 437     }
 438 }
 439
 440 /*
 441
 442 =back
 443
 444 =head1 HISTORY
 445
 446 Initial version by leo 2003/01/16.
 447
 448 =cut
 449
 450 */
 451
 452 /*
 453  * Local variables:
 454  *   c-file-style: "parrot"
 455  * End:
 456  * vim: expandtab shiftwidth=4:
 457  */