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 *,
  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 *interpreter,
  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 *interpreter,
  52                          struct PackFile_ConstTable *self)
  53 {
  54     opcode_t i;
  55
  56     for (i = 0; i < self->const_count; i++) {
  57         PIO_printf(interpreter, "    # %ld:\n", (long)i);
  58         PackFile_Constant_dump(interpreter, self->constants[i]);
  59     }
  60 }
  61
  62 /*
  63
  64 =item C<void
  65 PackFile_Constant_dump(Interp *interpreter,
  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 *interpreter,
  76                        struct PackFile_Constant *self)
  77 {
  78     switch (self->type) {
  79
  80     case PFC_NUMBER:
  81         PIO_printf(interpreter, "    [ 'PFC_NUMBER', %g ],\n", self->u.number);
  82         break;
  83
  84     case PFC_STRING:
  85         PIO_printf(interpreter, "    [ 'PFC_STRING', {\n");
  86         PIO_printf(interpreter, "        FLAGS    => 0x%04lx,\n",
  87                    (long)PObj_get_FLAGS(self->u.string));
  88         PIO_printf(interpreter, "        CHARSET  => %ld,\n",
  89                    self->u.string->charset);
  90         PIO_printf(interpreter, "        SIZE     => %ld,\n",
  91                    (long)self->u.string->bufused);
  92         /* TODO: Won't do anything reasonable for most encodings */
  93         PIO_printf(interpreter, "        DATA     => '%.*s'\n",
  94                    (int)self->u.string->bufused,
  95                    (char *)self->u.string->strstart);
  96         PIO_printf(interpreter, "    } ],\n");
  97         break;
  98
  99     case PFC_KEY:
 100         PIO_printf(interpreter, "    [ 'PFC_KEY', {\n");
 101         PIO_printf(interpreter, "    ??? TODO \n");
 102         PIO_printf(interpreter, "    } ],\n");
 103         break;
 104     case PFC_PMC:
 105         PIO_printf(interpreter, "    [ 'PFC_PMC', {\n");
 106         {
 107             PMC *pmc = self->u.key;
 108             parrot_sub_t sub;
 109             STRING *a_key = const_string(interpreter, "(keyed)");
 110             STRING *null = const_string(interpreter, "(null)");
 111             opcode_t *code_start =
 112                 interpreter->code->base.data;
 113             switch (pmc->vtable->base_type) {
 114                 case enum_class_Sub:
 115                 case enum_class_Coroutine:
 116                     sub = PMC_sub(pmc);
 117                     PIO_printf(interpreter,
 118                             "\tclass => %Ss,\n"
 119                             "\tstart_offs => %d,\n"
 120                             "\tend_offs => %d,\n"
 121                             "\tname => '%Ss',\n"
 122                             "\tnamespace => '%Ss'\n",
 123                             pmc->vtable->whoami,
 124                             sub->start_offs,
 125                             sub->end_offs,
 126                             sub->name,
 127                             sub->namespace ?
 128                                 (sub->namespace->vtable->base_type ==
 129                                     enum_class_String ?
 130                                 PMC_str_val(sub->namespace) : a_key) :
 131                                 null
 132                             );
 133                     break;
 134                 default:
 135                     PIO_printf(interpreter, "\tunknown PMC\n");
 136             }
 137         }
 138         PIO_printf(interpreter, "    } ],\n");
 139         break;
 140     default:
 141         PIO_printf(interpreter, "    [ 'PFC_\?\?\?', type '0x%x' ],\n",
 142                 self->type);
 143         break;
 144     }
 145 }
 146
 147 /*
 148
 149 =item C<void
 150 PackFile_Fixup_dump(Interp *interpreter,
 151                     struct PackFile_FixupTable *ft)>
 152
 153 Dumps the fix-up table C<ft>.
 154
 155 =cut
 156
 157 */
 158
 159 void
 160 PackFile_Fixup_dump(Interp *interpreter,
 161                     struct PackFile_FixupTable *ft)
 162 {
 163     opcode_t i;
 164
 165     for (i = 0; i < ft->fixup_count; i++) {
 166         PIO_printf(interpreter,"\t#%d\n", (int) i);
 167         switch (ft->fixups[i]->type) {
 168             case enum_fixup_label:
 169             case enum_fixup_sub:
 170                 PIO_printf(interpreter,
 171                         "\ttype => %d offs => %8d name => '%s',\n",
 172                         (int)ft->fixups[i]->type,
 173                         (int)ft->fixups[i]->offset,
 174                         ft->fixups[i]->name);
 175                     break;
 176             default:
 177                 PIO_printf(interpreter,"\ttype => %d ???,\n",
 178                         (int) ft->fixups[i]->type);
 179                 break;
 180         }
 181     }
 182 }
 183
 184 /*
 185
 186 =back
 187
 188 =head1 SEE ALSO
 189
 190 F<src/pdump.c>.
 191
 192 =cut
 193
 194 */
 195
 196
 197 /*
 198  * Local variables:
 199  *   c-file-style: "parrot"
 200  * End:
 201  * vim: expandtab shiftwidth=4:
 202  */