src/packdump.c

   1 /*
   2 Copyright (C) 2001-2005, The Perl Foundation.
   3 This program is free software. It is subject to the same license as
   4 Parrot itself.
   5 $Id$
   6
   7 =head1 NAME
   8
   9 src/packdump.c - Functions for dumping packfile structures
  10
  11 =head1 DESCRIPTION
  12
  13 This is only used by the PBC dumper C<pdump>.
  14
  15 =head2 Functions
  16
  17 =over 4
  18
  19 =cut
  20
  21 */
  22
  23 #include "parrot/parrot.h"
  24 #include "parrot/packfile.h"
  25
  26 /*
  27 ** FIXME: this should also be segmentized.
  28 ** For now just remove some warnings
  29 */
  30
  31 void PackFile_ConstTable_dump(Interp *,
  32                                      struct PackFile_ConstTable *);
  33 static void PackFile_Constant_dump(Interp *, struct PackFile_ConstTable *ct,
  34                                    struct PackFile_Constant *);
  35 void PackFile_Fixup_dump(Interp *,
  36                          struct PackFile_FixupTable *ft);
  37
  38 /*
  39
  40 =item C<void
  41 PackFile_ConstTable_dump(Interp *interp,
  42                          struct PackFile_ConstTable *self)>
  43
  44 Dumps the constant table C<self>.
  45
  46 =cut
  47
  48 */
  49
  50 void
  51 PackFile_ConstTable_dump(Interp *interp,
  52                          struct PackFile_ConstTable *self)
  53 {
  54     opcode_t i;
  55
  56     for (i = 0; i < self->const_count; i++) {
  57         PIO_printf(interp, "    # %ld:\n", (long)i);
  58         PackFile_Constant_dump(interp, self, self->constants[i]);
  59     }
  60 }
  61
  62 /*
  63
  64 =item C<void
  65 PackFile_Constant_dump(Interp *interp, struct PackFile_ConstTable *ct
  66                        struct PackFile_Constant *self)>
  67
  68 Dumps the constant C<self>.
  69
  70 =cut
  71
  72 */
  73
  74 void
  75 PackFile_Constant_dump(Interp *interp, struct PackFile_ConstTable *ct,
  76                        struct PackFile_Constant *self)
  77 {
  78     struct PMC *key;
  79     size_t i;
  80     size_t ct_index;
  81     opcode_t slice_bits;
  82     struct PackFile_Constant *detail;
  83
  84     switch (self->type) {
  85
  86     case PFC_NUMBER:
  87         PIO_printf(interp, "    [ 'PFC_NUMBER', %g ],\n", self->u.number);
  88         break;
  89
  90     case PFC_STRING:
  91         PIO_printf(interp, "    [ 'PFC_STRING', {\n");
  92         PIO_printf(interp, "        FLAGS    => 0x%04lx,\n",
  93                    (long)PObj_get_FLAGS(self->u.string));
  94         PIO_printf(interp, "        CHARSET  => %ld,\n",
  95                    self->u.string->charset);
  96         PIO_printf(interp, "        SIZE     => %ld,\n",
  97                    (long)self->u.string->bufused);
  98         /* TODO: Won't do anything reasonable for most encodings */
  99         PIO_printf(interp, "        DATA     => '%.*s'\n",
 100                    (int)self->u.string->bufused,
 101                    (char *)self->u.string->strstart);
 102         PIO_printf(interp, "    } ],\n");
 103         break;
 104
 105     case PFC_KEY:
 106         PIO_printf(interp, "    [ 'PFC_KEY");
 107         for (i = 0, key = self->u.key; key; key = PMC_data(key), i++)
 108             ;
 109         /* number of key components */
 110         PIO_printf(interp, " %ld items\n", i);
 111         /* and now type / value per component */
 112         for (key = self->u.key; key; key = PMC_data(key)) {
 113             opcode_t type = PObj_get_FLAGS(key);
 114             PIO_printf(interp, "       {\n");
 115             slice_bits = 0;
 116             if ((type & (KEY_start_slice_FLAG|KEY_inf_slice_FLAG)) ==
 117                 (KEY_start_slice_FLAG|KEY_inf_slice_FLAG))
 118                 PIO_printf(interp, "        SLICE_BITS  => PF_VT_END_INF\n");
 119             if ((type & (KEY_end_slice_FLAG|KEY_inf_slice_FLAG)) ==
 120                 (KEY_end_slice_FLAG|KEY_inf_slice_FLAG))
 121                 slice_bits |= PF_VT_START_ZERO;
 122                 PIO_printf(interp, "        SLICE_BITS  => PF_VT_START_ZERO\n");
 123             if (type & KEY_start_slice_FLAG)
 124                 slice_bits |= PF_VT_START_SLICE;
 125                 PIO_printf(interp, "        SLICE_BITS  => PF_VT_START_SLICE\n");
 126             if (type & KEY_end_slice_FLAG)
 127                 slice_bits |= PF_VT_END_SLICE;
 128                 PIO_printf(interp, "        SLICE_BITS  => PF_VT_END_SLICE\n");
 129
 130             type &= KEY_type_FLAGS;
 131             PIO_printf(interp, "        FLAGS       => 0x%04lx,\n", (long)PObj_get_FLAGS(key));
 132             switch (type) {
 133                 case KEY_integer_FLAG:
 134                     PIO_printf(interp, "        TYPE        => INTEGER\n");
 135                     PIO_printf(interp, "        DATA        => %ld\n", PMC_int_val(key));
 136                     PIO_printf(interp, "       },\n");
 137                     break;
 138                 case KEY_number_FLAG:
 139                     PIO_printf(interp, "        TYPE        => NUMBER\n");
 140                     ct_index = PackFile_find_in_const(interp, ct, key, PFC_NUMBER);
 141                     PIO_printf(interp, "        PFC_OFFSET  => %ld\n", ct_index);
 142                     detail = ct->constants[ct_index];
 143                     PIO_printf(interp, "        DATA        => %ld\n", detail->u.number);
 144                     PIO_printf(interp, "       },\n");
 145                     break;
 146                 case KEY_string_FLAG:
 147                     PIO_printf(interp, "        TYPE        => STRING\n");
 148                     ct_index = PackFile_find_in_const(interp, ct, key, PFC_STRING);
 149                     PIO_printf(interp, "        PFC_OFFSET  => %ld\n", ct_index);
 150                     detail = ct->constants[ct_index];
 151                     PIO_printf(interp, "        DATA        => '%.*s'\n",
 152                               (int)detail->u.string->bufused,
 153                               (char *)detail->u.string->strstart);
 154                     PIO_printf(interp, "       },\n");
 155                     break;
 156                 case KEY_integer_FLAG | KEY_register_FLAG:
 157                     PIO_printf(interp, "        TYPE        => I REGISTER\n");
 158                     PIO_printf(interp, "        DATA        => %ld\n", PMC_int_val(key));
 159                     PIO_printf(interp, "       },\n");
 160                     break;
 161                 case KEY_number_FLAG | KEY_register_FLAG:
 162                     PIO_printf(interp, "        TYPE        => N REGISTER\n");
 163                     PIO_printf(interp, "        DATA        => %ld\n", PMC_int_val(key));
 164                     PIO_printf(interp, "       },\n");
 165                     break;
 166                 case KEY_string_FLAG | KEY_register_FLAG:
 167                     PIO_printf(interp, "        TYPE        => S REGISTER\n");
 168                     PIO_printf(interp, "        DATA        => %ld\n", PMC_int_val(key));
 169                     PIO_printf(interp, "       },\n");
 170                     break;
 171                 case KEY_pmc_FLAG | KEY_register_FLAG:
 172                     PIO_printf(interp, "        TYPE        => P REGISTER\n");
 173                     PIO_printf(interp, "        DATA        => %ld\n", PMC_int_val(key));
 174                     PIO_printf(interp, "       },\n");
 175                     break;
 176                 default:
 177                     PIO_eprintf(NULL, "PackFile_Constant_pack: "
 178                             "unsupported constant type\n");
 179                     Parrot_exit(interp, 1);
 180             }
 181         }
 182         PIO_printf(interp, "    ],\n");
 183         break;
 184     case PFC_PMC:
 185         PIO_printf(interp, "    [ 'PFC_PMC', {\n");
 186         {
 187             PMC *pmc = self->u.key;
 188             parrot_sub_t sub;
 189             STRING *a_key = const_string(interp, "(keyed)");
 190             STRING *null = const_string(interp, "(null)");
 191             STRING *namespace_description;
 192             opcode_t *code_start =
 193                 interp->code->base.data;
 194             switch (pmc->vtable->base_type) {
 195                 case enum_class_FixedBooleanArray:
 196                 case enum_class_FixedFloatArray:
 197                 case enum_class_FixedPMCArray:
 198                 case enum_class_FixedStringArray:
 199                 case enum_class_ResizableBooleanArray:
 200                 case enum_class_ResizableIntegerArray:
 201                 case enum_class_ResizableFloatArray:
 202                 case enum_class_ResizablePMCArray:
 203                 case enum_class_ResizableStringArray:
 204                     {
 205                     int n = VTABLE_get_integer(interp, pmc);
 206                     STRING* out_buffer = VTABLE_get_repr(interp, pmc);
 207                     PIO_printf(interp,
 208                             "\tclass => %Ss,\n"
 209                             "\telement count => %d,\n"
 210                             "\telements => %Ss,\n",
 211                             pmc->vtable->whoami,
 212                             n,
 213                             out_buffer
 214                             );
 215                     }
 216                     break;
 217                 case enum_class_Sub:
 218                 case enum_class_Coroutine:
 219                     sub = PMC_sub(pmc);
 220                     if (sub->namespace) {
 221                         switch (sub->namespace->vtable->base_type) {
 222                             case enum_class_String:
 223                                 namespace_description = string_from_cstring(interp, "'", 1);
 224                                 namespace_description = string_append(interp, namespace_description, PMC_str_val(sub->namespace));
 225                                 namespace_description = string_append(interp, namespace_description, string_from_cstring(interp, "'", 1));
 226                                 break;
 227                             case enum_class_Key:
 228                                 namespace_description = key_set_to_string(interp, sub->namespace);
 229                                 break;
 230                             default:
 231                                 namespace_description = sub->namespace->vtable->whoami;
 232                         }
 233                     }
 234                     else {
 235                         namespace_description = null;
 236                     }
 237                     PIO_printf(interp,
 238                             "\tclass => %Ss,\n"
 239                             "\tstart_offs => %d,\n"
 240                             "\tend_offs => %d,\n"
 241                             "\tname => '%Ss',\n"
 242                             "\tnamespace => %Ss\n"
 243                             "\tHLL_id => %d,\n",
 244                             pmc->vtable->whoami,
 245                             sub->start_offs,
 246                             sub->end_offs,
 247                             sub->name,
 248                             namespace_description,
 249                             sub->HLL_id
 250                             );
 251                     break;
 252                 case enum_class_FixedIntegerArray:
 253                     PIO_printf(interp,
 254                             "\tclass => %Ss,\n"
 255                             "\trepr => '%Ss'\n",
 256                             pmc->vtable->whoami,
 257                             VTABLE_get_repr(interp, pmc)
 258                             );
 259                     break;
 260                 default:
 261                     PIO_printf(interp, "\tno dump info for PMC %ld %Ss\n", pmc->vtable->base_type, pmc->vtable->whoami);
 262                     PIO_printf(interp, "\tclass => %Ss,\n", pmc->vtable->whoami);
 263             }
 264         }
 265         PIO_printf(interp, "    } ],\n");
 266         break;
 267     default:
 268         PIO_printf(interp, "    [ 'PFC_\?\?\?', type '0x%x' ],\n",
 269                 self->type);
 270         break;
 271     }
 272 }
 273
 274 /*
 275
 276 =item C<void
 277 PackFile_Fixup_dump(Interp *interp,
 278                     struct PackFile_FixupTable *ft)>
 279
 280 Dumps the fix-up table C<ft>.
 281
 282 =cut
 283
 284 */
 285
 286 void
 287 PackFile_Fixup_dump(Interp *interp,
 288                     struct PackFile_FixupTable *ft)
 289 {
 290     opcode_t i;
 291
 292     for (i = 0; i < ft->fixup_count; i++) {
 293         PIO_printf(interp,"\t#%d\n", (int) i);
 294         switch (ft->fixups[i]->type) {
 295             case enum_fixup_label:
 296             case enum_fixup_sub:
 297                 PIO_printf(interp,
 298                         "\ttype => %d offs => %8d name => '%s',\n",
 299                         (int)ft->fixups[i]->type,
 300                         (int)ft->fixups[i]->offset,
 301                         ft->fixups[i]->name);
 302                     break;
 303             default:
 304                 PIO_printf(interp,"\ttype => %d ???,\n",
 305                         (int) ft->fixups[i]->type);
 306                 break;
 307         }
 308     }
 309 }
 310
 311 /*
 312
 313 =back
 314
 315 =head1 SEE ALSO
 316
 317 F<src/pdump.c>.
 318
 319 =cut
 320
 321 */
 322
 323
 324 /*
 325  * Local variables:
 326  *   c-file-style: "parrot"
 327  * End:
 328  * vim: expandtab shiftwidth=4:
 329  */