src/packout.c

   1 /*
   2 Copyright (C) 2001-2006, 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/packout.c - Functions for writing out packfiles
  10
  11 =head1 DESCRIPTION
  12
  13 =head2 Functions
  14
  15 =over 4
  16
  17 =cut
  18
  19 */
  20
  21 #include "parrot/parrot.h"
  22 #include "parrot/packfile.h"
  23 #include <assert.h>
  24
  25 /***************************************
  26 Determine the size of the buffer needed in order to pack the PackFile into a
  27 contiguous region of memory.
  28 ***************************************/
  29
  30 #define TRACE_PACKFILE_PMC 0
  31
  32 /* XXX This should be in an external file */
  33 extern struct PackFile_Directory *directory_new(Interp*, struct PackFile *pf);
  34
  35 /*
  36
  37 =item C<opcode_t
  38 PackFile_pack_size(Interp*, struct PackFile *self)>
  39
  40 Description.
  41
  42 =cut
  43
  44 */
  45
  46 opcode_t
  47 PackFile_pack_size(Interp *interp, struct PackFile *self)
  48 {
  49     opcode_t size;
  50     struct PackFile_Directory * const dir = &self->directory;
  51
  52     size = PACKFILE_HEADER_BYTES / sizeof (opcode_t);
  53
  54     size += 4; /* magic + opcode type + directory type + pad */
  55
  56     dir->base.file_offset = size;
  57     size += PackFile_Segment_packed_size(interp,
  58             (struct PackFile_Segment *) dir);
  59
  60     return size;
  61 }
  62
  63 /*
  64
  65 =item C<void
  66 PackFile_pack(Interp*, struct PackFile *self, opcode_t *cursor)>
  67
  68 Pack the PackFile into a contiguous region of memory.
  69
  70 Note that the memory block had better have at least the amount of memory
  71 indicated by C<PackFile_pack_size()>.
  72
  73 This means that you MUST call C<PackFile_pack_size()> before
  74 C<PackFile_pack()>
  75
  76 Other pack routines are in F<src/packfile.c>.
  77
  78 =cut
  79
  80 */
  81
  82 void
  83 PackFile_pack(Interp *interp, struct PackFile *self, opcode_t *cursor)
  84 {
  85     opcode_t *ret;
  86
  87     size_t size;
  88     struct PackFile_Directory * const dir = &self->directory;
  89     struct PackFile_Segment *seg;
  90
  91     self->src = cursor;
  92
  93     /* Pack the header */
  94     mem_sys_memcopy(cursor, self->header, PACKFILE_HEADER_BYTES);
  95     cursor += PACKFILE_HEADER_BYTES / sizeof (opcode_t);
  96     *cursor++ = PARROT_MAGIC;           /* Pack the magic */
  97     *cursor++ = OPCODE_TYPE_PERL;       /* Pack opcode type */
  98     *cursor++ = PF_DIR_FORMAT;          /* dir format */
  99     *cursor++ = 0;                      /* pad */
 100
 101     /* pack the directory */
 102     seg = (struct PackFile_Segment *) dir;
 103     /* dir size */
 104     size = seg->op_count;
 105     ret = PackFile_Segment_pack(interp, seg, cursor);
 106     if ((size_t)(ret - cursor) != size) {
 107         fprintf(stderr, "PackFile_pack segment '%s' used size %d "
 108                 "but reported %d\n", seg->name, (int)(ret-cursor), (int)size);
 109     }
 110 }
 111
 112 /*
 113
 114 =item C<size_t
 115 PackFile_ConstTable_pack_size(struct PackFile_Segment *seg)>
 116
 117 Determine the size of the buffer needed in order to pack the PackFile
 118 constant table into a contiguous region of memory.
 119
 120 =cut
 121
 122 */
 123
 124 size_t
 125 PackFile_ConstTable_pack_size(Interp *interp, struct PackFile_Segment *seg)
 126 {
 127     opcode_t i;
 128     struct PackFile_ConstTable* const self = (struct PackFile_ConstTable *) seg;
 129     size_t size = 1;    /* const_count */
 130
 131     for (i = 0; i < self->const_count; i++)
 132         size += PackFile_Constant_pack_size(interp, self->constants[i]);
 133     return size;
 134 }
 135
 136 /*
 137
 138 =item C<opcode_t *PackFile_ConstTable_pack(Interp *,
 139                                            struct PackFile_Segment *seg,
 140                                            opcode_t *cursor)>
 141
 142 Pack the PackFile ConstTable into a contiguous region of memory.
 143
 144 Note that the memory block had better have at least the amount of memory
 145 indicated by C<PackFile_pack_size()>.
 146
 147 This means that you MUST call C<PackFile_pack_size()> before
 148 C<PackFile_ConstTable_pack()>
 149
 150 =cut
 151
 152 */
 153
 154 opcode_t *
 155 PackFile_ConstTable_pack(Interp *interp,
 156         struct PackFile_Segment *seg, opcode_t *cursor)
 157 {
 158     struct PackFile_ConstTable * const self = (struct PackFile_ConstTable *)seg;
 159     opcode_t i;
 160
 161     *cursor++ = self->const_count;
 162
 163     for (i = 0; i < self->const_count; i++) {
 164         cursor = PackFile_Constant_pack(interp, self, self->constants[i], cursor);
 165     }
 166
 167     return cursor;
 168 }
 169
 170 /*
 171
 172 =item C<static int
 173 find_in_const(Interp *interp, PMC *key, int type)>
 174
 175 This is really ugly, we don't know where our C<PARROT_ARG_SC> key
 176 constant is in constant table, so we have to search for it.
 177
 178 =cut
 179
 180 */
 181
 182 int
 183 PackFile_find_in_const(Interp *interp, struct PackFile_ConstTable *ct, PMC *key, int type)
 184 {
 185     int i;
 186     for (i = 0; i < ct->const_count; i++)
 187         if (type == PFC_STRING && ct->constants[i]->u.string ==
 188             PMC_str_val(key))
 189             return i;
 190         else if (type == PFC_NUMBER && ct->constants[i]->u.number ==
 191                  PMC_num_val(key))
 192             return i;
 193     PIO_eprintf(NULL, "find_in_const: couldn't find const for key\n");
 194     Parrot_exit(interp, 1);
 195     return 0;
 196 }
 197
 198 /*
 199
 200 =item C<opcode_t *
 201 PackFile_Constant_pack(Interp*, struct PackFile_ConstTable * const_table,
 202                        struct PackFile_Constant *self, opcode_t *cursor)>
 203
 204 Pack a PackFile Constant into a contiguous region of memory.
 205
 206 Note that the memory block had better have at least the amount of memory
 207 indicated by C<PackFile_pack_size()>.
 208
 209 This means that you MUST call C<PackFile_pack_size()> before
 210 C<PackFile_Constant_pack()>
 211
 212 The data is zero-padded to an opcode_t-boundary, so pad bytes may be added.
 213 (Note this padding is not yet implemented for FLOATVALs.)
 214
 215 =cut
 216
 217 */
 218
 219 opcode_t *
 220 PackFile_Constant_pack(Interp* interp, struct PackFile_ConstTable * const_table,
 221         struct PackFile_Constant *self, opcode_t *cursor)
 222 {
 223     struct PMC *key;
 224     size_t i;
 225     opcode_t slice_bits;
 226     STRING *image;
 227
 228     *cursor++ = self->type;
 229
 230     switch (self->type) {
 231
 232     case PFC_NUMBER:
 233         cursor = PF_store_number(cursor, &self->u.number);
 234         break;
 235
 236     case PFC_STRING:
 237         cursor = PF_store_string(cursor, self->u.string);
 238         break;
 239
 240     case PFC_PMC:
 241         key = self->u.key;      /* the (Sub) PMC */
 242         image = Parrot_freeze(interp, key);
 243         cursor = PF_store_string(cursor, image);
 244         break;
 245
 246     case PFC_KEY:
 247         for (i = 0, key = self->u.key; key; key = PMC_data(key), i++)
 248             ;
 249         /* number of key components */
 250         *cursor++ = i;
 251         /* and now type / value per component */
 252         for (key = self->u.key; key; key = PMC_data(key)) {
 253             opcode_t type = PObj_get_FLAGS(key);
 254             slice_bits = 0;
 255             if ((type & (KEY_start_slice_FLAG|KEY_inf_slice_FLAG)) ==
 256                     (KEY_start_slice_FLAG|KEY_inf_slice_FLAG))
 257                 slice_bits |= PF_VT_END_INF;
 258             if ((type & (KEY_end_slice_FLAG|KEY_inf_slice_FLAG)) ==
 259                     (KEY_end_slice_FLAG|KEY_inf_slice_FLAG))
 260                 slice_bits |= PF_VT_START_ZERO;
 261             if (type & KEY_start_slice_FLAG)
 262                 slice_bits |= PF_VT_START_SLICE;
 263             if (type & KEY_end_slice_FLAG)
 264                 slice_bits |= PF_VT_END_SLICE;
 265
 266             type &= KEY_type_FLAGS;
 267             switch (type) {
 268                 case KEY_integer_FLAG:
 269                     *cursor++ = PARROT_ARG_IC | slice_bits;
 270                     *cursor++ = PMC_int_val(key);
 271                     break;
 272                 case KEY_number_FLAG:
 273                     *cursor++ = PARROT_ARG_NC | slice_bits;
 274                     /* Argh */
 275                     *cursor++ = PackFile_find_in_const(interp, const_table, key, PFC_NUMBER);
 276                     break;
 277                 case KEY_string_FLAG:
 278                     *cursor++ = PARROT_ARG_SC | slice_bits;
 279                     /* Argh */
 280                     *cursor++ = PackFile_find_in_const(interp, const_table, key, PFC_STRING);
 281                     break;
 282
 283                 case KEY_integer_FLAG | KEY_register_FLAG:
 284                     *cursor++ = PARROT_ARG_I | slice_bits;
 285                     *cursor++ = PMC_int_val(key);
 286                     break;
 287                 case KEY_number_FLAG | KEY_register_FLAG:
 288                     *cursor++ = PARROT_ARG_N | slice_bits;
 289                     *cursor++ = PMC_int_val(key);
 290                     break;
 291                 case KEY_string_FLAG | KEY_register_FLAG:
 292                     *cursor++ = PARROT_ARG_S | slice_bits;
 293                     *cursor++ = PMC_int_val(key);
 294                     break;
 295                 case KEY_pmc_FLAG | KEY_register_FLAG:
 296                     *cursor++ = PARROT_ARG_P | slice_bits;
 297                     *cursor++ = PMC_int_val(key);
 298                     break;
 299                 default:
 300                     PIO_eprintf(NULL, "PackFile_Constant_pack: "
 301                             "unsupported constant type\n");
 302                     Parrot_exit(interp, 1);
 303             }
 304         }
 305
 306         break;
 307
 308     default:
 309         PIO_eprintf(NULL, "PackFile_Constant_pack: unsupported constant\n");
 310         Parrot_exit(interp, 1);
 311         break;
 312     }
 313     return cursor;
 314 }
 315
 316 /*
 317
 318 =back
 319
 320 =head1 HISTORY
 321
 322 Rework by Melvin; new bytecode format, make bytecode portable. (Do
 323 endian conversion and wordsize transforms on the fly.)
 324
 325 leo: rewrite to use new directory-based format.
 326
 327 =cut
 328
 329 */
 330
 331
 332 /*
 333  * Local variables:
 334  *   c-file-style: "parrot"
 335  * End:
 336  * vim: expandtab shiftwidth=4:
 337  */