vm/profiler.c

   1 #include "master.h"
   2
   3 /* Allocates memory */
   4 F_COMPILED *compile_profiling_stub(F_WORD *word)
   5 {
   6         CELL literals = allot_array_1(tag_object(word));
   7         REGISTER_ROOT(literals);
   8
   9         F_ARRAY *quadruple = untag_object(userenv[JIT_PROFILING]);
  10
  11         CELL code = array_nth(quadruple,0);
  12         REGISTER_ROOT(code);
  13
  14         F_REL rel;
  15         rel.type = to_fixnum(array_nth(quadruple,2)) | (to_fixnum(array_nth(quadruple,1)) << 8);
  16         rel.offset = to_fixnum(array_nth(quadruple,3)) * compiled_code_format();
  17
  18         F_BYTE_ARRAY *relocation = allot_byte_array(sizeof(F_REL));
  19         memcpy((void *)BREF(relocation,0),&rel,sizeof(F_REL));
  20
  21         UNREGISTER_ROOT(code);
  22         UNREGISTER_ROOT(literals);
  23
  24         return add_compiled_block(
  25                 WORD_TYPE,
  26                 untag_object(code),
  27                 NULL, /* no labels */
  28                 tag_object(relocation),
  29                 untag_object(literals));
  30 }
  31
  32 /* Allocates memory */
  33 void update_word_xt(F_WORD *word)
  34 {
  35         if(profiling_p)
  36         {
  37                 if(!word->profiling)
  38                 {
  39                         REGISTER_UNTAGGED(word);
  40                         F_COMPILED *profiling = compile_profiling_stub(word);
  41                         UNREGISTER_UNTAGGED(word);
  42                         word->profiling = profiling;
  43                 }
  44
  45                 word->xt = (XT)(word->profiling + 1);
  46         }
  47         else
  48                 word->xt = (XT)(word->code + 1);
  49 }
  50
  51 void set_profiling(bool profiling)
  52 {
  53         if(profiling == profiling_p)
  54                 return;
  55
  56         profiling_p = profiling;
  57
  58         /* Push everything to tenured space so that we can heap scan
  59         and allocate profiling blocks if necessary */
  60         gc();
  61
  62         CELL words = find_all_words();
  63
  64         REGISTER_ROOT(words);
  65
  66         CELL i;
  67         CELL length = array_capacity(untag_object(words));
  68         for(i = 0; i < length; i++)
  69         {
  70                 F_WORD *word = untag_word(array_nth(untag_array(words),i));
  71                 if(profiling)
  72                         word->counter = tag_fixnum(0);
  73                 update_word_xt(word);
  74         }
  75
  76         UNREGISTER_ROOT(words);
  77
  78         /* Update XTs in code heap */
  79         iterate_code_heap(relocate_code_block);
  80 }
  81
  82 void primitive_profiling(void)
  83 {
  84         set_profiling(to_boolean(dpop()));
  85 }