marshal.c

   1 /**********************************************************************
   2
   3   marshal.c -
   4
   5   $Author$
   6   created at: Thu Apr 27 16:30:01 JST 1995
   7
   8   Copyright (C) 1993-2007 Yukihiro Matsumoto
   9
  10 **********************************************************************/
  11
  12 #include "ruby/ruby.h"
  13 #include "ruby/io.h"
  14 #include "ruby/st.h"
  15 #include "ruby/util.h"
  16 #include "ruby/encoding.h"
  17
  18 #include <math.h>
  19 #ifdef HAVE_FLOAT_H
  20 #include <float.h>
  21 #endif
  22 #ifdef HAVE_IEEEFP_H
  23 #include <ieeefp.h>
  24 #endif
  25
  26 #define BITSPERSHORT (2*CHAR_BIT)
  27 #define SHORTMASK ((1<<BITSPERSHORT)-1)
  28 #define SHORTDN(x) RSHIFT(x,BITSPERSHORT)
  29
  30 #if SIZEOF_SHORT == SIZEOF_BDIGITS
  31 #define SHORTLEN(x) (x)
  32 #else
  33 static int
  34 shortlen(long len, BDIGIT *ds)
  35 {
  36     BDIGIT num;
  37     int offset = 0;
  38
  39     num = ds[len-1];
  40     while (num) {
  41         num = SHORTDN(num);
  42         offset++;
  43     }
  44     return (len - 1)*sizeof(BDIGIT)/2 + offset;
  45 }
  46 #define SHORTLEN(x) shortlen((x),d)
  47 #endif
  48
  49 #define MARSHAL_MAJOR   4
  50 #define MARSHAL_MINOR   8
  51
  52 #define TYPE_NIL        '0'
  53 #define TYPE_TRUE       'T'
  54 #define TYPE_FALSE      'F'
  55 #define TYPE_FIXNUM     'i'
  56
  57 #define TYPE_EXTENDED   'e'
  58 #define TYPE_UCLASS     'C'
  59 #define TYPE_OBJECT     'o'
  60 #define TYPE_DATA       'd'
  61 #define TYPE_USERDEF    'u'
  62 #define TYPE_USRMARSHAL 'U'
  63 #define TYPE_FLOAT      'f'
  64 #define TYPE_BIGNUM     'l'
  65 #define TYPE_STRING     '"'
  66 #define TYPE_REGEXP     '/'
  67 #define TYPE_ARRAY      '['
  68 #define TYPE_HASH       '{'
  69 #define TYPE_HASH_DEF   '}'
  70 #define TYPE_STRUCT     'S'
  71 #define TYPE_MODULE_OLD 'M'
  72 #define TYPE_CLASS      'c'
  73 #define TYPE_MODULE     'm'
  74
  75 #define TYPE_SYMBOL     ':'
  76 #define TYPE_SYMLINK    ';'
  77
  78 #define TYPE_IVAR       'I'
  79 #define TYPE_LINK       '@'
  80
  81 static ID s_dump, s_load, s_mdump, s_mload;
  82 static ID s_dump_data, s_load_data, s_alloc;
  83 static ID s_getbyte, s_read, s_write, s_binmode;
  84
  85 ID rb_id_encoding(void);
  86
  87 typedef struct {
  88     VALUE newclass;
  89     VALUE oldclass;
  90     VALUE (*dumper)(VALUE);
  91     VALUE (*loader)(VALUE, VALUE);
  92 } marshal_compat_t;
  93
  94 static st_table *compat_allocator_tbl;
  95 static VALUE compat_allocator_tbl_wrapper;
  96
  97 static int
  98 mark_marshal_compat_i(st_data_t key, st_data_t value)
  99 {
 100     marshal_compat_t *p = (marshal_compat_t *)value;
 101     rb_gc_mark(p->newclass);
 102     rb_gc_mark(p->oldclass);
 103     return ST_CONTINUE;
 104 }
 105
 106 static void
 107 mark_marshal_compat_t(void *tbl)
 108 {
 109     if (!tbl) return;
 110     st_foreach(tbl, mark_marshal_compat_i, 0);
 111 }
 112
 113 void
 114 rb_marshal_define_compat(VALUE newclass, VALUE oldclass, VALUE (*dumper)(VALUE), VALUE (*loader)(VALUE, VALUE))
 115 {
 116     marshal_compat_t *compat;
 117     rb_alloc_func_t allocator = rb_get_alloc_func(newclass);
 118
 119     if (!allocator) {
 120         rb_raise(rb_eTypeError, "no allocator");
 121     }
 122
 123     compat = ALLOC(marshal_compat_t);
 124     compat->newclass = Qnil;
 125     compat->oldclass = Qnil;
 126     compat->newclass = newclass;
 127     compat->oldclass = oldclass;
 128     compat->dumper = dumper;
 129     compat->loader = loader;
 130
 131     st_insert(compat_allocator_tbl, (st_data_t)allocator, (st_data_t)compat);
 132 }
 133
 134 struct dump_arg {
 135     VALUE obj;
 136     VALUE str, dest;
 137     st_table *symbols;
 138     st_table *data;
 139     int taint;
 140     st_table *compat_tbl;
 141     VALUE wrapper;
 142     st_table *encodings;
 143 };
 144
 145 struct dump_call_arg {
 146     VALUE obj;
 147     struct dump_arg *arg;
 148     int limit;
 149 };
 150
 151 static void
 152 check_dump_arg(struct dump_arg *arg)
 153 {
 154     if (!DATA_PTR(arg->wrapper)) {
 155         rb_raise(rb_eRuntimeError, "Marshal.dump reentered");
 156     }
 157 }
 158
 159 static void
 160 mark_dump_arg(void *ptr)
 161 {
 162     struct dump_arg *p = ptr;
 163     if (!ptr)
 164         return;
 165     rb_mark_set(p->data);
 166     rb_mark_hash(p->compat_tbl);
 167 }
 168
 169 static VALUE
 170 class2path(VALUE klass)
 171 {
 172     VALUE path = rb_class_path(klass);
 173     char *n = RSTRING_PTR(path);
 174
 175     if (n[0] == '#') {
 176         rb_raise(rb_eTypeError, "can't dump anonymous %s %s",
 177                  (TYPE(klass) == T_CLASS ? "class" : "module"),
 178                  n);
 179     }
 180     if (rb_path2class(n) != rb_class_real(klass)) {
 181         rb_raise(rb_eTypeError, "%s can't be referred", n);
 182     }
 183     return path;
 184 }
 185
 186 static void w_long(long, struct dump_arg*);
 187
 188 static void
 189 w_nbyte(const char *s, int n, struct dump_arg *arg)
 190 {
 191     VALUE buf = arg->str;
 192     rb_str_buf_cat(buf, s, n);
 193     if (arg->dest && RSTRING_LEN(buf) >= BUFSIZ) {
 194         if (arg->taint) OBJ_TAINT(buf);
 195         rb_io_write(arg->dest, buf);
 196         rb_str_resize(buf, 0);
 197     }
 198 }
 199
 200 static void
 201 w_byte(char c, struct dump_arg *arg)
 202 {
 203     w_nbyte(&c, 1, arg);
 204 }
 205
 206 static void
 207 w_bytes(const char *s, int n, struct dump_arg *arg)
 208 {
 209     w_long(n, arg);
 210     w_nbyte(s, n, arg);
 211 }
 212
 213 static void
 214 w_short(int x, struct dump_arg *arg)
 215 {
 216     w_byte((char)((x >> 0) & 0xff), arg);
 217     w_byte((char)((x >> 8) & 0xff), arg);
 218 }
 219
 220 static void
 221 w_long(long x, struct dump_arg *arg)
 222 {
 223     char buf[sizeof(long)+1];
 224     int i, len = 0;
 225
 226 #if SIZEOF_LONG > 4
 227     if (!(RSHIFT(x, 31) == 0 || RSHIFT(x, 31) == -1)) {
 228         /* big long does not fit in 4 bytes */
 229         rb_raise(rb_eTypeError, "long too big to dump");
 230     }
 231 #endif
 232
 233     if (x == 0) {
 234         w_byte(0, arg);
 235         return;
 236     }
 237     if (0 < x && x < 123) {
 238         w_byte((char)(x + 5), arg);
 239         return;
 240     }
 241     if (-124 < x && x < 0) {
 242         w_byte((char)((x - 5)&0xff), arg);
 243         return;
 244     }
 245     for (i=1;i<sizeof(long)+1;i++) {
 246         buf[i] = x & 0xff;
 247         x = RSHIFT(x,8);
 248         if (x == 0) {
 249             buf[0] = i;
 250             break;
 251         }
 252         if (x == -1) {
 253             buf[0] = -i;
 254             break;
 255         }
 256     }
 257     len = i;
 258     for (i=0;i<=len;i++) {
 259         w_byte(buf[i], arg);
 260     }
 261 }
 262
 263 #ifdef DBL_MANT_DIG
 264 #define DECIMAL_MANT (53-16)    /* from IEEE754 double precision */
 265
 266 #if DBL_MANT_DIG > 32
 267 #define MANT_BITS 32
 268 #elif DBL_MANT_DIG > 24
 269 #define MANT_BITS 24
 270 #elif DBL_MANT_DIG > 16
 271 #define MANT_BITS 16
 272 #else
 273 #define MANT_BITS 8
 274 #endif
 275
 276 static int
 277 save_mantissa(double d, char *buf)
 278 {
 279     int e, i = 0;
 280     unsigned long m;
 281     double n;
 282
 283     d = modf(ldexp(frexp(fabs(d), &e), DECIMAL_MANT), &d);
 284     if (d > 0) {
 285         buf[i++] = 0;
 286         do {
 287             d = modf(ldexp(d, MANT_BITS), &n);
 288             m = (unsigned long)n;
 289 #if MANT_BITS > 24
 290             buf[i++] = m >> 24;
 291 #endif
 292 #if MANT_BITS > 16
 293             buf[i++] = m >> 16;
 294 #endif
 295 #if MANT_BITS > 8
 296             buf[i++] = m >> 8;
 297 #endif
 298             buf[i++] = m;
 299         } while (d > 0);
 300         while (!buf[i - 1]) --i;
 301     }
 302     return i;
 303 }
 304
 305 static double
 306 load_mantissa(double d, const char *buf, int len)
 307 {
 308     if (--len > 0 && !*buf++) { /* binary mantissa mark */
 309         int e, s = d < 0, dig = 0;
 310         unsigned long m;
 311
 312         modf(ldexp(frexp(fabs(d), &e), DECIMAL_MANT), &d);
 313         do {
 314             m = 0;
 315             switch (len) {
 316               default: m = *buf++ & 0xff;
 317 #if MANT_BITS > 24
 318               case 3: m = (m << 8) | (*buf++ & 0xff);
 319 #endif
 320 #if MANT_BITS > 16
 321               case 2: m = (m << 8) | (*buf++ & 0xff);
 322 #endif
 323 #if MANT_BITS > 8
 324               case 1: m = (m << 8) | (*buf++ & 0xff);
 325 #endif
 326             }
 327             dig -= len < MANT_BITS / 8 ? 8 * (unsigned)len : MANT_BITS;
 328             d += ldexp((double)m, dig);
 329         } while ((len -= MANT_BITS / 8) > 0);
 330         d = ldexp(d, e - DECIMAL_MANT);
 331         if (s) d = -d;
 332     }
 333     return d;
 334 }
 335 #else
 336 #define load_mantissa(d, buf, len) (d)
 337 #define save_mantissa(d, buf) 0
 338 #endif
 339
 340 #ifdef DBL_DIG
 341 #define FLOAT_DIG (DBL_DIG+2)
 342 #else
 343 #define FLOAT_DIG 17
 344 #endif
 345
 346 static void
 347 w_float(double d, struct dump_arg *arg)
 348 {
 349     char buf[FLOAT_DIG + (DECIMAL_MANT + 7) / 8 + 10];
 350
 351     if (isinf(d)) {
 352         if (d < 0) strcpy(buf, "-inf");
 353         else       strcpy(buf, "inf");
 354     }
 355     else if (isnan(d)) {
 356         strcpy(buf, "nan");
 357     }
 358     else if (d == 0.0) {
 359         if (1.0/d < 0) strcpy(buf, "-0");
 360         else           strcpy(buf, "0");
 361     }
 362     else {
 363         int len;
 364
 365         /* xxx: should not use system's sprintf(3) */
 366         snprintf(buf, sizeof(buf), "%.*g", FLOAT_DIG, d);
 367         len = strlen(buf);
 368         w_bytes(buf, len + save_mantissa(d, buf + len), arg);
 369         return;
 370     }
 371     w_bytes(buf, strlen(buf), arg);
 372 }
 373
 374 static void
 375 w_symbol(ID id, struct dump_arg *arg)
 376 {
 377     const char *sym;
 378     st_data_t num;
 379
 380     if (st_lookup(arg->symbols, id, &num)) {
 381         w_byte(TYPE_SYMLINK, arg);
 382         w_long((long)num, arg);
 383     }
 384     else {
 385         sym = rb_id2name(id);
 386         if (!sym) {
 387             rb_raise(rb_eTypeError, "can't dump anonymous ID %ld", id);
 388         }
 389         w_byte(TYPE_SYMBOL, arg);
 390         w_bytes(sym, strlen(sym), arg);
 391         st_add_direct(arg->symbols, id, arg->symbols->num_entries);
 392     }
 393 }
 394
 395 static void
 396 w_unique(const char *s, struct dump_arg *arg)
 397 {
 398     if (s[0] == '#') {
 399         rb_raise(rb_eTypeError, "can't dump anonymous class %s", s);
 400     }
 401     w_symbol(rb_intern(s), arg);
 402 }
 403
 404 static void w_object(VALUE,struct dump_arg*,int);
 405
 406 static int
 407 hash_each(VALUE key, VALUE value, struct dump_call_arg *arg)
 408 {
 409     w_object(key, arg->arg, arg->limit);
 410     w_object(value, arg->arg, arg->limit);
 411     return ST_CONTINUE;
 412 }
 413
 414 static void
 415 w_extended(VALUE klass, struct dump_arg *arg, int check)
 416 {
 417     char *path;
 418
 419     if (check && FL_TEST(klass, FL_SINGLETON)) {
 420         if (RCLASS_M_TBL(klass)->num_entries ||
 421             (RCLASS_IV_TBL(klass) && RCLASS_IV_TBL(klass)->num_entries > 1)) {
 422             rb_raise(rb_eTypeError, "singleton can't be dumped");
 423         }
 424         klass = RCLASS_SUPER(klass);
 425     }
 426     while (BUILTIN_TYPE(klass) == T_ICLASS) {
 427         path = rb_class2name(RBASIC(klass)->klass);
 428         w_byte(TYPE_EXTENDED, arg);
 429         w_unique(path, arg);
 430         klass = RCLASS_SUPER(klass);
 431     }
 432 }
 433
 434 static void
 435 w_class(char type, VALUE obj, struct dump_arg *arg, int check)
 436 {
 437     volatile VALUE p;
 438     char *path;
 439     st_data_t real_obj;
 440     VALUE klass;
 441
 442     if (st_lookup(arg->compat_tbl, (st_data_t)obj, &real_obj)) {
 443         obj = (VALUE)real_obj;
 444     }
 445     klass = CLASS_OF(obj);
 446     w_extended(klass, arg, check);
 447     w_byte(type, arg);
 448     p = class2path(rb_class_real(klass));
 449     path = RSTRING_PTR(p);
 450     w_unique(path, arg);
 451 }
 452
 453 static void
 454 w_uclass(VALUE obj, VALUE super, struct dump_arg *arg)
 455 {
 456     VALUE klass = CLASS_OF(obj);
 457
 458     w_extended(klass, arg, Qtrue);
 459     klass = rb_class_real(klass);
 460     if (klass != super) {
 461         w_byte(TYPE_UCLASS, arg);
 462         w_unique(RSTRING_PTR(class2path(klass)), arg);
 463     }
 464 }
 465
 466 static int
 467 w_obj_each(ID id, VALUE value, struct dump_call_arg *arg)
 468 {
 469     if (id == rb_id_encoding()) return ST_CONTINUE;
 470     w_symbol(id, arg->arg);
 471     w_object(value, arg->arg, arg->limit);
 472     return ST_CONTINUE;
 473 }
 474
 475 static void
 476 w_encoding(VALUE obj, long num, struct dump_call_arg *arg)
 477 {
 478     int encidx = rb_enc_get_index(obj);
 479     rb_encoding *enc = 0;
 480     st_data_t name;
 481
 482     if (encidx <= 0 || !(enc = rb_enc_from_index(encidx))) {
 483         w_long(num, arg->arg);
 484         return;
 485     }
 486     w_long(num + 1, arg->arg);
 487     w_symbol(rb_id_encoding(), arg->arg);
 488     do {
 489         if (!arg->arg->encodings)
 490             arg->arg->encodings = st_init_strcasetable();
 491         else if (st_lookup(arg->arg->encodings, (st_data_t)rb_enc_name(enc), &name))
 492             break;
 493         name = (st_data_t)rb_str_new2(rb_enc_name(enc));
 494         st_insert(arg->arg->encodings, (st_data_t)rb_enc_name(enc), name);
 495     } while (0);
 496     w_object(name, arg->arg, arg->limit);
 497 }
 498
 499 static void
 500 w_ivar(VALUE obj, st_table *tbl, struct dump_call_arg *arg)
 501 {
 502     long num = tbl ? tbl->num_entries : 0;
 503
 504     w_encoding(obj, num, arg);
 505     if (tbl) {
 506         st_foreach_safe(tbl, w_obj_each, (st_data_t)arg);
 507     }
 508 }
 509
 510 static void
 511 w_objivar(VALUE obj, struct dump_call_arg *arg)
 512 {
 513     VALUE *ptr;
 514     long i, len, num;
 515
 516     len = ROBJECT_NUMIV(obj);
 517     ptr = ROBJECT_IVPTR(obj);
 518     num = 0;
 519     for (i = 0; i < len; i++)
 520         if (ptr[i] != Qundef)
 521             num += 1;
 522
 523     w_encoding(obj, num, arg);
 524     if (num != 0) {
 525         rb_ivar_foreach(obj, w_obj_each, (st_data_t)arg);
 526     }
 527 }
 528
 529 static void
 530 w_object(VALUE obj, struct dump_arg *arg, int limit)
 531 {
 532     struct dump_call_arg c_arg;
 533     st_table *ivtbl = 0;
 534     st_data_t num;
 535     int hasiv = 0;
 536 #define has_ivars(obj, ivtbl) ((ivtbl = rb_generic_ivar_table(obj)) != 0 || \
 537                                (!SPECIAL_CONST_P(obj) && !ENCODING_IS_ASCII8BIT(obj)))
 538
 539     if (limit == 0) {
 540         rb_raise(rb_eArgError, "exceed depth limit");
 541     }
 542
 543     limit--;
 544     c_arg.limit = limit;
 545     c_arg.arg = arg;
 546
 547     if (st_lookup(arg->data, obj, &num)) {
 548         w_byte(TYPE_LINK, arg);
 549         w_long((long)num, arg);
 550         return;
 551     }
 552
 553     if ((hasiv = has_ivars(obj, ivtbl)) != 0) {
 554         w_byte(TYPE_IVAR, arg);
 555     }
 556     if (obj == Qnil) {
 557         w_byte(TYPE_NIL, arg);
 558     }
 559     else if (obj == Qtrue) {
 560         w_byte(TYPE_TRUE, arg);
 561     }
 562     else if (obj == Qfalse) {
 563         w_byte(TYPE_FALSE, arg);
 564     }
 565     else if (FIXNUM_P(obj)) {
 566 #if SIZEOF_LONG <= 4
 567         w_byte(TYPE_FIXNUM, arg);
 568         w_long(FIX2INT(obj), arg);
 569 #else
 570         if (RSHIFT((long)obj, 31) == 0 || RSHIFT((long)obj, 31) == -1) {
 571             w_byte(TYPE_FIXNUM, arg);
 572             w_long(FIX2LONG(obj), arg);
 573         }
 574         else {
 575             w_object(rb_int2big(FIX2LONG(obj)), arg, limit);
 576         }
 577 #endif
 578     }
 579     else if (SYMBOL_P(obj)) {
 580         w_symbol(SYM2ID(obj), arg);
 581     }
 582     else {
 583         if (OBJ_TAINTED(obj)) arg->taint = Qtrue;
 584
 585         if (rb_obj_respond_to(obj, s_mdump, Qtrue)) {
 586             volatile VALUE v;
 587
 588             st_add_direct(arg->data, obj, arg->data->num_entries);
 589
 590             v = rb_funcall(obj, s_mdump, 0, 0);
 591             check_dump_arg(arg);
 592             w_class(TYPE_USRMARSHAL, obj, arg, Qfalse);
 593             w_object(v, arg, limit);
 594             if (hasiv) w_ivar(obj, 0, &c_arg);
 595             return;
 596         }
 597         if (rb_obj_respond_to(obj, s_dump, Qtrue)) {
 598             VALUE v;
 599             st_table *ivtbl2 = 0;
 600             int hasiv2;
 601
 602             v = rb_funcall(obj, s_dump, 1, INT2NUM(limit));
 603             check_dump_arg(arg);
 604             if (TYPE(v) != T_STRING) {
 605                 rb_raise(rb_eTypeError, "_dump() must return string");
 606             }
 607             if ((hasiv2 = has_ivars(v, ivtbl2)) != 0 && !hasiv) {
 608                 w_byte(TYPE_IVAR, arg);
 609             }
 610             w_class(TYPE_USERDEF, obj, arg, Qfalse);
 611             w_bytes(RSTRING_PTR(v), RSTRING_LEN(v), arg);
 612             if (hasiv2) {
 613                 w_ivar(v, ivtbl2, &c_arg);
 614             }
 615             else if (hasiv) {
 616                 w_ivar(obj, ivtbl, &c_arg);
 617             }
 618             st_add_direct(arg->data, obj, arg->data->num_entries);
 619             return;
 620         }
 621
 622         st_add_direct(arg->data, obj, arg->data->num_entries);
 623
 624         {
 625             st_data_t compat_data;
 626             rb_alloc_func_t allocator = rb_get_alloc_func(RBASIC(obj)->klass);
 627             if (st_lookup(compat_allocator_tbl,
 628                           (st_data_t)allocator,
 629                           &compat_data)) {
 630                 marshal_compat_t *compat = (marshal_compat_t*)compat_data;
 631                 VALUE real_obj = obj;
 632                 obj = compat->dumper(real_obj);
 633                 st_insert(arg->compat_tbl, (st_data_t)obj, (st_data_t)real_obj);
 634             }
 635         }
 636
 637         switch (BUILTIN_TYPE(obj)) {
 638           case T_CLASS:
 639             if (FL_TEST(obj, FL_SINGLETON)) {
 640                 rb_raise(rb_eTypeError, "singleton class can't be dumped");
 641             }
 642             w_byte(TYPE_CLASS, arg);
 643             {
 644                 volatile VALUE path = class2path(obj);
 645                 w_bytes(RSTRING_PTR(path), RSTRING_LEN(path), arg);
 646             }
 647             break;
 648
 649           case T_MODULE:
 650             w_byte(TYPE_MODULE, arg);
 651             {
 652                 VALUE path = class2path(obj);
 653                 w_bytes(RSTRING_PTR(path), RSTRING_LEN(path), arg);
 654             }
 655             break;
 656
 657           case T_FLOAT:
 658             w_byte(TYPE_FLOAT, arg);
 659             w_float(RFLOAT_VALUE(obj), arg);
 660             break;
 661
 662           case T_BIGNUM:
 663             w_byte(TYPE_BIGNUM, arg);
 664             {
 665                 char sign = RBIGNUM_SIGN(obj) ? '+' : '-';
 666                 long len = RBIGNUM_LEN(obj);
 667                 BDIGIT *d = RBIGNUM_DIGITS(obj);
 668
 669                 w_byte(sign, arg);
 670                 w_long(SHORTLEN(len), arg); /* w_short? */
 671                 while (len--) {
 672 #if SIZEOF_BDIGITS > SIZEOF_SHORT
 673                     BDIGIT num = *d;
 674                     int i;
 675
 676                     for (i=0; i<SIZEOF_BDIGITS; i+=SIZEOF_SHORT) {
 677                         w_short(num & SHORTMASK, arg);
 678                         num = SHORTDN(num);
 679                         if (len == 0 && num == 0) break;
 680                     }
 681 #else
 682                     w_short(*d, arg);
 683 #endif
 684                     d++;
 685                 }
 686             }
 687             break;
 688
 689           case T_STRING:
 690             w_uclass(obj, rb_cString, arg);
 691             w_byte(TYPE_STRING, arg);
 692             w_bytes(RSTRING_PTR(obj), RSTRING_LEN(obj), arg);
 693             break;
 694
 695           case T_REGEXP:
 696             w_uclass(obj, rb_cRegexp, arg);
 697             w_byte(TYPE_REGEXP, arg);
 698             w_bytes(RREGEXP(obj)->str, RREGEXP(obj)->len, arg);
 699             w_byte((char)rb_reg_options(obj), arg);
 700             break;
 701
 702           case T_ARRAY:
 703             w_uclass(obj, rb_cArray, arg);
 704             w_byte(TYPE_ARRAY, arg);
 705             {
 706                 long len = RARRAY_LEN(obj);
 707                 VALUE *ptr = RARRAY_PTR(obj);
 708
 709                 w_long(len, arg);
 710                 while (len--) {
 711                     w_object(*ptr, arg, limit);
 712                     ptr++;
 713                 }
 714             }
 715             break;
 716
 717           case T_HASH:
 718             w_uclass(obj, rb_cHash, arg);
 719             if (NIL_P(RHASH(obj)->ifnone)) {
 720                 w_byte(TYPE_HASH, arg);
 721             }
 722             else if (FL_TEST(obj, FL_USER2)) {
 723                 /* FL_USER2 means HASH_PROC_DEFAULT (see hash.c) */
 724                 rb_raise(rb_eTypeError, "can't dump hash with default proc");
 725             }
 726             else {
 727                 w_byte(TYPE_HASH_DEF, arg);
 728             }
 729             w_long(RHASH_SIZE(obj), arg);
 730             rb_hash_foreach(obj, hash_each, (st_data_t)&c_arg);
 731             if (!NIL_P(RHASH(obj)->ifnone)) {
 732                 w_object(RHASH(obj)->ifnone, arg, limit);
 733             }
 734             break;
 735
 736           case T_STRUCT:
 737             w_class(TYPE_STRUCT, obj, arg, Qtrue);
 738             {
 739                 long len = RSTRUCT_LEN(obj);
 740                 VALUE mem;
 741                 long i;
 742
 743                 w_long(len, arg);
 744                 mem = rb_struct_members(obj);
 745                 for (i=0; i<len; i++) {
 746                     w_symbol(SYM2ID(RARRAY_PTR(mem)[i]), arg);
 747                     w_object(RSTRUCT_PTR(obj)[i], arg, limit);
 748                 }
 749             }
 750             break;
 751
 752           case T_OBJECT:
 753             w_class(TYPE_OBJECT, obj, arg, Qtrue);
 754             w_objivar(obj, &c_arg);
 755             break;
 756
 757           case T_DATA:
 758             {
 759                 VALUE v;
 760
 761                 if (!rb_obj_respond_to(obj, s_dump_data, Qtrue)) {
 762                     rb_raise(rb_eTypeError,
 763                              "no marshal_dump is defined for class %s",
 764                              rb_obj_classname(obj));
 765                 }
 766                 v = rb_funcall(obj, s_dump_data, 0);
 767                 check_dump_arg(arg);
 768                 w_class(TYPE_DATA, obj, arg, Qtrue);
 769                 w_object(v, arg, limit);
 770             }
 771             break;
 772
 773           default:
 774             rb_raise(rb_eTypeError, "can't dump %s",
 775                      rb_obj_classname(obj));
 776             break;
 777         }
 778     }
 779     if (hasiv) {
 780         w_ivar(obj, ivtbl, &c_arg);
 781     }
 782 }
 783
 784 static VALUE
 785 dump(struct dump_call_arg *arg)
 786 {
 787     w_object(arg->obj, arg->arg, arg->limit);
 788     if (arg->arg->dest) {
 789         rb_io_write(arg->arg->dest, arg->arg->str);
 790         rb_str_resize(arg->arg->str, 0);
 791     }
 792     return 0;
 793 }
 794
 795 static VALUE
 796 dump_ensure(struct dump_arg *arg)
 797 {
 798     if (!DATA_PTR(arg->wrapper)) return 0;
 799     st_free_table(arg->symbols);
 800     st_free_table(arg->data);
 801     st_free_table(arg->compat_tbl);
 802     DATA_PTR(arg->wrapper) = 0;
 803     arg->wrapper = 0;
 804     if (arg->taint) {
 805         OBJ_TAINT(arg->str);
 806     }
 807     return 0;
 808 }
 809
 810 /*
 811  * call-seq:
 812  *      dump( obj [, anIO] , limit=--1 ) => anIO
 813  *
 814  * Serializes obj and all descendent objects. If anIO is
 815  * specified, the serialized data will be written to it, otherwise the
 816  * data will be returned as a String. If limit is specified, the
 817  * traversal of subobjects will be limited to that depth. If limit is
 818  * negative, no checking of depth will be performed.
 819  *
 820  *     class Klass
 821  *       def initialize(str)
 822  *         @str = str
 823  *       end
 824  *       def sayHello
 825  *         @str
 826  *       end
 827  *     end
 828  *
 829  * (produces no output)
 830  *
 831  *     o = Klass.new("hello\n")
 832  *     data = Marshal.dump(o)
 833  *     obj = Marshal.load(data)
 834  *     obj.sayHello   #=> "hello\n"
 835  */
 836 static VALUE
 837 marshal_dump(int argc, VALUE *argv)
 838 {
 839     VALUE obj, port, a1, a2;
 840     int limit = -1;
 841     struct dump_arg arg;
 842     struct dump_call_arg c_arg;
 843
 844     port = Qnil;
 845     rb_scan_args(argc, argv, "12", &obj, &a1, &a2);
 846     if (argc == 3) {
 847         if (!NIL_P(a2)) limit = NUM2INT(a2);
 848         if (NIL_P(a1)) goto type_error;
 849         port = a1;
 850     }
 851     else if (argc == 2) {
 852         if (FIXNUM_P(a1)) limit = FIX2INT(a1);
 853         else if (NIL_P(a1)) goto type_error;
 854         else port = a1;
 855     }
 856     arg.dest = 0;
 857     if (!NIL_P(port)) {
 858         if (!rb_obj_respond_to(port, s_write, Qtrue)) {
 859           type_error:
 860             rb_raise(rb_eTypeError, "instance of IO needed");
 861         }
 862         arg.str = rb_str_buf_new(0);
 863         arg.dest = port;
 864         if (rb_obj_respond_to(port, s_binmode, Qtrue)) {
 865             rb_funcall2(port, s_binmode, 0, 0);
 866         }
 867     }
 868     else {
 869         port = rb_str_buf_new(0);
 870         arg.str = port;
 871     }
 872
 873     arg.symbols = st_init_numtable();
 874     arg.data    = st_init_numtable();
 875     arg.taint   = Qfalse;
 876     arg.compat_tbl = st_init_numtable();
 877     arg.wrapper = Data_Wrap_Struct(rb_cData, mark_dump_arg, 0, &arg);
 878     arg.encodings = 0;
 879     c_arg.obj   = obj;
 880     c_arg.arg   = &arg;
 881     c_arg.limit = limit;
 882
 883     w_byte(MARSHAL_MAJOR, &arg);
 884     w_byte(MARSHAL_MINOR, &arg);
 885
 886     rb_ensure(dump, (VALUE)&c_arg, dump_ensure, (VALUE)&arg);
 887
 888     return port;
 889 }
 890
 891 struct load_arg {
 892     VALUE src;
 893     long offset;
 894     st_table *symbols;
 895     VALUE data;
 896     VALUE proc;
 897     int taint;
 898     st_table *compat_tbl;
 899     VALUE compat_tbl_wrapper;
 900 };
 901
 902 static void
 903 check_load_arg(struct load_arg *arg)
 904 {
 905     if (!DATA_PTR(arg->compat_tbl_wrapper)) {
 906         rb_raise(rb_eRuntimeError, "Marshal.load reentered");
 907     }
 908 }
 909
 910 static VALUE r_entry(VALUE v, struct load_arg *arg);
 911 static VALUE r_object(struct load_arg *arg);
 912 static VALUE path2class(const char *path);
 913
 914 static int
 915 r_byte(struct load_arg *arg)
 916 {
 917     int c;
 918
 919     if (TYPE(arg->src) == T_STRING) {
 920         if (RSTRING_LEN(arg->src) > arg->offset) {
 921             c = (unsigned char)RSTRING_PTR(arg->src)[arg->offset++];
 922         }
 923         else {
 924             rb_raise(rb_eArgError, "marshal data too short");
 925         }
 926     }
 927     else {
 928         VALUE src = arg->src;
 929         VALUE v = rb_funcall2(src, s_getbyte, 0, 0);
 930         check_load_arg(arg);
 931         if (NIL_P(v)) rb_eof_error();
 932         c = (unsigned char)NUM2CHR(v);
 933     }
 934     return c;
 935 }
 936
 937 static void
 938 long_toobig(int size)
 939 {
 940     rb_raise(rb_eTypeError, "long too big for this architecture (size %d, given %d)",
 941              sizeof(long), size);
 942 }
 943
 944 #undef SIGN_EXTEND_CHAR
 945 #if __STDC__
 946 # define SIGN_EXTEND_CHAR(c) ((signed char)(c))
 947 #else  /* not __STDC__ */
 948 /* As in Harbison and Steele.  */
 949 # define SIGN_EXTEND_CHAR(c) ((((unsigned char)(c)) ^ 128) - 128)
 950 #endif
 951
 952 static long
 953 r_long(struct load_arg *arg)
 954 {
 955     register long x;
 956     int c = SIGN_EXTEND_CHAR(r_byte(arg));
 957     long i;
 958
 959     if (c == 0) return 0;
 960     if (c > 0) {
 961         if (4 < c && c < 128) {
 962             return c - 5;
 963         }
 964         if (c > sizeof(long)) long_toobig(c);
 965         x = 0;
 966         for (i=0;i<c;i++) {
 967             x |= (long)r_byte(arg) << (8*i);
 968         }
 969     }
 970     else {
 971         if (-129 < c && c < -4) {
 972             return c + 5;
 973         }
 974         c = -c;
 975         if (c > sizeof(long)) long_toobig(c);
 976         x = -1;
 977         for (i=0;i<c;i++) {
 978             x &= ~((long)0xff << (8*i));
 979             x |= (long)r_byte(arg) << (8*i);
 980         }
 981     }
 982     return x;
 983 }
 984
 985 #define r_bytes(arg) r_bytes0(r_long(arg), (arg))
 986
 987 static VALUE
 988 r_bytes0(long len, struct load_arg *arg)
 989 {
 990     VALUE str;
 991
 992     if (len == 0) return rb_str_new(0, 0);
 993     if (TYPE(arg->src) == T_STRING) {
 994         if (RSTRING_LEN(arg->src) - arg->offset >= len) {
 995             str = rb_str_new(RSTRING_PTR(arg->src)+arg->offset, len);
 996             arg->offset += len;
 997         }
 998         else {
 999           too_short:
1000             rb_raise(rb_eArgError, "marshal data too short");
1001         }
1002     }
1003     else {
1004         VALUE src = arg->src;
1005         VALUE n = LONG2NUM(len);
1006         str = rb_funcall2(src, s_read, 1, &n);
1007         check_load_arg(arg);
1008         if (NIL_P(str)) goto too_short;
1009         StringValue(str);
1010         if (RSTRING_LEN(str) != len) goto too_short;
1011         if (OBJ_TAINTED(str)) arg->taint = Qtrue;
1012     }
1013     return str;
1014 }
1015
1016 static ID
1017 r_symlink(struct load_arg *arg)
1018 {
1019     ID id;
1020     long num = r_long(arg);
1021
1022     if (st_lookup(arg->symbols, num, &id)) {
1023         return id;
1024     }
1025     rb_raise(rb_eArgError, "bad symbol");
1026 }
1027
1028 static ID
1029 r_symreal(struct load_arg *arg)
1030 {
1031     volatile VALUE s = r_bytes(arg);
1032     ID id = rb_intern(RSTRING_PTR(s));
1033
1034     st_insert(arg->symbols, arg->symbols->num_entries, id);
1035
1036     return id;
1037 }
1038
1039 static ID
1040 r_symbol(struct load_arg *arg)
1041 {
1042     int type;
1043
1044     switch ((type = r_byte(arg))) {
1045       case TYPE_SYMBOL:
1046         return r_symreal(arg);
1047       case TYPE_SYMLINK:
1048         return r_symlink(arg);
1049       default:
1050         rb_raise(rb_eArgError, "dump format error(0x%x)", type);
1051         break;
1052     }
1053 }
1054
1055 static const char*
1056 r_unique(struct load_arg *arg)
1057 {
1058     return rb_id2name(r_symbol(arg));
1059 }
1060
1061 static VALUE
1062 r_string(struct load_arg *arg)
1063 {
1064     return r_bytes(arg);
1065 }
1066
1067 static VALUE
1068 r_entry(VALUE v, struct load_arg *arg)
1069 {
1070     st_data_t real_obj = (VALUE)Qundef;
1071     if (st_lookup(arg->compat_tbl, v, &real_obj)) {
1072         rb_hash_aset(arg->data, INT2FIX(RHASH_SIZE(arg->data)), (VALUE)real_obj);
1073     }
1074     else {
1075         rb_hash_aset(arg->data, INT2FIX(RHASH_SIZE(arg->data)), v);
1076     }
1077     if (arg->taint) {
1078         OBJ_TAINT(v);
1079         if ((VALUE)real_obj != Qundef)
1080             OBJ_TAINT((VALUE)real_obj);
1081     }
1082     return v;
1083 }
1084
1085 static VALUE
1086 r_leave(VALUE v, struct load_arg *arg)
1087 {
1088     st_data_t data;
1089     if (st_lookup(arg->compat_tbl, v, &data)) {
1090         VALUE real_obj = (VALUE)data;
1091         rb_alloc_func_t allocator = rb_get_alloc_func(CLASS_OF(real_obj));
1092         st_data_t key = v;
1093         if (st_lookup(compat_allocator_tbl, (st_data_t)allocator, &data)) {
1094             marshal_compat_t *compat = (marshal_compat_t*)data;
1095             compat->loader(real_obj, v);
1096         }
1097         st_delete(arg->compat_tbl, &key, 0);
1098         v = real_obj;
1099     }
1100     if (arg->proc) {
1101         v = rb_funcall(arg->proc, rb_intern("call"), 1, v);
1102         check_load_arg(arg);
1103     }
1104     return v;
1105 }
1106
1107 static void
1108 r_ivar(VALUE obj, struct load_arg *arg)
1109 {
1110     long len;
1111
1112     len = r_long(arg);
1113     if (len > 0) {
1114         while (len--) {
1115             ID id = r_symbol(arg);
1116             VALUE val = r_object(arg);
1117             if (id == rb_id_encoding()) {
1118                 int idx = rb_enc_find_index(StringValueCStr(val));
1119                 if (idx > 0) rb_enc_associate_index(obj, idx);
1120             }
1121             else {
1122                 rb_ivar_set(obj, id, val);
1123             }
1124         }
1125     }
1126 }
1127
1128 static VALUE
1129 path2class(const char *path)
1130 {
1131     VALUE v = rb_path2class(path);
1132
1133     if (TYPE(v) != T_CLASS) {
1134         rb_raise(rb_eArgError, "%s does not refer class", path);
1135     }
1136     return v;
1137 }
1138
1139 static VALUE
1140 path2module(const char *path)
1141 {
1142     VALUE v = rb_path2class(path);
1143
1144     if (TYPE(v) != T_MODULE) {
1145         rb_raise(rb_eArgError, "%s does not refer module", path);
1146     }
1147     return v;
1148 }
1149
1150 static VALUE
1151 obj_alloc_by_path(const char *path, struct load_arg *arg)
1152 {
1153     VALUE klass;
1154     st_data_t data;
1155     rb_alloc_func_t allocator;
1156
1157     klass = path2class(path);
1158
1159     allocator = rb_get_alloc_func(klass);
1160     if (st_lookup(compat_allocator_tbl, (st_data_t)allocator, &data)) {
1161         marshal_compat_t *compat = (marshal_compat_t*)data;
1162         VALUE real_obj = rb_obj_alloc(klass);
1163         VALUE obj = rb_obj_alloc(compat->oldclass);
1164         st_insert(arg->compat_tbl, (st_data_t)obj, (st_data_t)real_obj);
1165         return obj;
1166     }
1167
1168     return rb_obj_alloc(klass);
1169 }
1170
1171 static VALUE
1172 r_object0(struct load_arg *arg, int *ivp, VALUE extmod)
1173 {
1174     VALUE v = Qnil;
1175     int type = r_byte(arg);
1176     long id;
1177
1178     switch (type) {
1179       case TYPE_LINK:
1180         id = r_long(arg);
1181         v = rb_hash_aref(arg->data, LONG2FIX(id));
1182         check_load_arg(arg);
1183         if (NIL_P(v)) {
1184             rb_raise(rb_eArgError, "dump format error (unlinked)");
1185         }
1186         if (arg->proc) {
1187             v = rb_funcall(arg->proc, rb_intern("call"), 1, v);
1188             check_load_arg(arg);
1189         }
1190         break;
1191
1192       case TYPE_IVAR:
1193         {
1194             int ivar = Qtrue;
1195
1196             v = r_object0(arg, &ivar, extmod);
1197             if (ivar) r_ivar(v, arg);
1198         }
1199         break;
1200
1201       case TYPE_EXTENDED:
1202         {
1203             VALUE m = path2module(r_unique(arg));
1204
1205             if (NIL_P(extmod)) extmod = rb_ary_new2(0);
1206             rb_ary_push(extmod, m);
1207
1208             v = r_object0(arg, 0, extmod);
1209             while (RARRAY_LEN(extmod) > 0) {
1210                 m = rb_ary_pop(extmod);
1211                 rb_extend_object(v, m);
1212             }
1213         }
1214         break;
1215
1216       case TYPE_UCLASS:
1217         {
1218             VALUE c = path2class(r_unique(arg));
1219
1220             if (FL_TEST(c, FL_SINGLETON)) {
1221                 rb_raise(rb_eTypeError, "singleton can't be loaded");
1222             }
1223             v = r_object0(arg, 0, extmod);
1224             if (rb_special_const_p(v) || TYPE(v) == T_OBJECT || TYPE(v) == T_CLASS) {
1225               format_error:
1226                 rb_raise(rb_eArgError, "dump format error (user class)");
1227             }
1228             if (TYPE(v) == T_MODULE || !RTEST(rb_class_inherited_p(c, RBASIC(v)->klass))) {
1229                 VALUE tmp = rb_obj_alloc(c);
1230
1231                 if (TYPE(v) != TYPE(tmp)) goto format_error;
1232             }
1233             RBASIC(v)->klass = c;
1234         }
1235         break;
1236
1237       case TYPE_NIL:
1238         v = Qnil;
1239         v = r_leave(v, arg);
1240         break;
1241
1242       case TYPE_TRUE:
1243         v = Qtrue;
1244         v = r_leave(v, arg);
1245         break;
1246
1247       case TYPE_FALSE:
1248         v = Qfalse;
1249         v = r_leave(v, arg);
1250         break;
1251
1252       case TYPE_FIXNUM:
1253         {
1254             long i = r_long(arg);
1255             v = LONG2FIX(i);
1256         }
1257         v = r_leave(v, arg);
1258         break;
1259
1260       case TYPE_FLOAT:
1261         {
1262             double d, t = 0.0;
1263             VALUE str = r_bytes(arg);
1264             const char *ptr = RSTRING_PTR(str);
1265
1266             if (strcmp(ptr, "nan") == 0) {
1267                 d = t / t;
1268             }
1269             else if (strcmp(ptr, "inf") == 0) {
1270                 d = 1.0 / t;
1271             }
1272             else if (strcmp(ptr, "-inf") == 0) {
1273                 d = -1.0 / t;
1274             }
1275             else {
1276                 char *e;
1277                 d = strtod(ptr, &e);
1278                 d = load_mantissa(d, e, RSTRING_LEN(str) - (e - ptr));
1279             }
1280             v = DOUBLE2NUM(d);
1281             v = r_entry(v, arg);
1282             v = r_leave(v, arg);
1283         }
1284         break;
1285
1286       case TYPE_BIGNUM:
1287         {
1288             long len;
1289             BDIGIT *digits;
1290             volatile VALUE data;
1291
1292             NEWOBJ(big, struct RBignum);
1293             OBJSETUP(big, rb_cBignum, T_BIGNUM);
1294             RBIGNUM_SET_SIGN(big, (r_byte(arg) == '+'));
1295             len = r_long(arg);
1296             data = r_bytes0(len * 2, arg);
1297 #if SIZEOF_BDIGITS == SIZEOF_SHORT
1298             rb_big_resize((VALUE)big, len);
1299 #else
1300             rb_big_resize((VALUE)big, (len + 1) * 2 / sizeof(BDIGIT));
1301 #endif
1302             digits = RBIGNUM_DIGITS(big);
1303             MEMCPY(digits, RSTRING_PTR(data), char, len * 2);
1304 #if SIZEOF_BDIGITS > SIZEOF_SHORT
1305             MEMZERO((char *)digits + len * 2, char,
1306                     RBIGNUM_LEN(big) * sizeof(BDIGIT) - len * 2);
1307 #endif
1308             len = RBIGNUM_LEN(big);
1309             while (len > 0) {
1310                 unsigned char *p = (unsigned char *)digits;
1311                 BDIGIT num = 0;
1312 #if SIZEOF_BDIGITS > SIZEOF_SHORT
1313                 int shift = 0;
1314                 int i;
1315
1316                 for (i=0; i<SIZEOF_BDIGITS; i++) {
1317                     num |= (int)p[i] << shift;
1318                     shift += 8;
1319                 }
1320 #else
1321                 num = p[0] | (p[1] << 8);
1322 #endif
1323                 *digits++ = num;
1324                 len--;
1325             }
1326             v = rb_big_norm((VALUE)big);
1327             v = r_entry(v, arg);
1328             v = r_leave(v, arg);
1329         }
1330         break;
1331
1332       case TYPE_STRING:
1333         v = r_entry(r_string(arg), arg);
1334         v = r_leave(v, arg);
1335         break;
1336
1337       case TYPE_REGEXP:
1338         {
1339             volatile VALUE str = r_bytes(arg);
1340             int options = r_byte(arg);
1341             v = r_entry(rb_reg_new_str(str, options), arg);
1342             v = r_leave(v, arg);
1343         }
1344         break;
1345
1346       case TYPE_ARRAY:
1347         {
1348             volatile long len = r_long(arg); /* gcc 2.7.2.3 -O2 bug?? */
1349
1350             v = rb_ary_new2(len);
1351             v = r_entry(v, arg);
1352             while (len--) {
1353                 rb_ary_push(v, r_object(arg));
1354             }
1355             v = r_leave(v, arg);
1356         }
1357         break;
1358
1359       case TYPE_HASH:
1360       case TYPE_HASH_DEF:
1361         {
1362             long len = r_long(arg);
1363
1364             v = rb_hash_new();
1365             v = r_entry(v, arg);
1366             while (len--) {
1367                 VALUE key = r_object(arg);
1368                 VALUE value = r_object(arg);
1369                 rb_hash_aset(v, key, value);
1370             }
1371             if (type == TYPE_HASH_DEF) {
1372                 RHASH(v)->ifnone = r_object(arg);
1373             }
1374             v = r_leave(v, arg);
1375         }
1376         break;
1377
1378       case TYPE_STRUCT:
1379         {
1380             VALUE klass, mem;
1381             VALUE values;
1382             volatile long i;    /* gcc 2.7.2.3 -O2 bug?? */
1383             long len;
1384             ID slot;
1385
1386             klass = path2class(r_unique(arg));
1387             len = r_long(arg);
1388
1389             v = rb_obj_alloc(klass);
1390             if (TYPE(v) != T_STRUCT) {
1391                 rb_raise(rb_eTypeError, "class %s not a struct", rb_class2name(klass));
1392             }
1393             mem = rb_struct_s_members(klass);
1394             if (RARRAY_LEN(mem) != len) {
1395                 rb_raise(rb_eTypeError, "struct %s not compatible (struct size differs)",
1396                          rb_class2name(klass));
1397             }
1398
1399             v = r_entry(v, arg);
1400             values = rb_ary_new2(len);
1401             for (i=0; i<len; i++) {
1402                 slot = r_symbol(arg);
1403
1404                 if (RARRAY_PTR(mem)[i] != ID2SYM(slot)) {
1405                     rb_raise(rb_eTypeError, "struct %s not compatible (:%s for :%s)",
1406                              rb_class2name(klass),
1407                              rb_id2name(slot),
1408                              rb_id2name(SYM2ID(RARRAY_PTR(mem)[i])));
1409                 }
1410                 rb_ary_push(values, r_object(arg));
1411             }
1412             rb_struct_initialize(v, values);
1413             v = r_leave(v, arg);
1414         }
1415         break;
1416
1417       case TYPE_USERDEF:
1418         {
1419             VALUE klass = path2class(r_unique(arg));
1420             VALUE data;
1421
1422             if (!rb_obj_respond_to(klass, s_load, Qtrue)) {
1423                 rb_raise(rb_eTypeError, "class %s needs to have method `_load'",
1424                          rb_class2name(klass));
1425             }
1426             data = r_string(arg);
1427             if (ivp) {
1428                 r_ivar(data, arg);
1429                 *ivp = Qfalse;
1430             }
1431             v = rb_funcall(klass, s_load, 1, data);
1432             check_load_arg(arg);
1433             v = r_entry(v, arg);
1434             v = r_leave(v, arg);
1435         }
1436         break;
1437
1438       case TYPE_USRMARSHAL:
1439         {
1440             VALUE klass = path2class(r_unique(arg));
1441             VALUE data;
1442
1443             v = rb_obj_alloc(klass);
1444             if (!NIL_P(extmod)) {
1445                 while (RARRAY_LEN(extmod) > 0) {
1446                     VALUE m = rb_ary_pop(extmod);
1447                     rb_extend_object(v, m);
1448                 }
1449             }
1450             if (!rb_obj_respond_to(v, s_mload, Qtrue)) {
1451                 rb_raise(rb_eTypeError, "instance of %s needs to have method `marshal_load'",
1452                          rb_class2name(klass));
1453             }
1454             v = r_entry(v, arg);
1455             data = r_object(arg);
1456             rb_funcall(v, s_mload, 1, data);
1457             check_load_arg(arg);
1458             v = r_leave(v, arg);
1459         }
1460         break;
1461
1462       case TYPE_OBJECT:
1463         {
1464             v = obj_alloc_by_path(r_unique(arg), arg);
1465             if (TYPE(v) != T_OBJECT) {
1466                 rb_raise(rb_eArgError, "dump format error");
1467             }
1468             v = r_entry(v, arg);
1469             r_ivar(v, arg);
1470             v = r_leave(v, arg);
1471         }
1472         break;
1473
1474       case TYPE_DATA:
1475        {
1476            VALUE klass = path2class(r_unique(arg));
1477            if (rb_obj_respond_to(klass, s_alloc, Qtrue)) {
1478                static int warn = Qtrue;
1479                if (warn) {
1480                    rb_warn("define `allocate' instead of `_alloc'");
1481                    warn = Qfalse;
1482                }
1483                v = rb_funcall(klass, s_alloc, 0);
1484                check_load_arg(arg);
1485            }
1486            else {
1487                v = rb_obj_alloc(klass);
1488            }
1489            if (TYPE(v) != T_DATA) {
1490                rb_raise(rb_eArgError, "dump format error");
1491            }
1492            v = r_entry(v, arg);
1493            if (!rb_obj_respond_to(v, s_load_data, Qtrue)) {
1494                rb_raise(rb_eTypeError,
1495                         "class %s needs to have instance method `_load_data'",
1496                         rb_class2name(klass));
1497            }
1498            rb_funcall(v, s_load_data, 1, r_object0(arg, 0, extmod));
1499            check_load_arg(arg);
1500            v = r_leave(v, arg);
1501        }
1502        break;
1503
1504       case TYPE_MODULE_OLD:
1505         {
1506             volatile VALUE str = r_bytes(arg);
1507
1508             v = rb_path2class(RSTRING_PTR(str));
1509             v = r_entry(v, arg);
1510             v = r_leave(v, arg);
1511         }
1512         break;
1513
1514       case TYPE_CLASS:
1515         {
1516             volatile VALUE str = r_bytes(arg);
1517
1518             v = path2class(RSTRING_PTR(str));
1519             v = r_entry(v, arg);
1520             v = r_leave(v, arg);
1521         }
1522         break;
1523
1524       case TYPE_MODULE:
1525         {
1526             volatile VALUE str = r_bytes(arg);
1527
1528             v = path2module(RSTRING_PTR(str));
1529             v = r_entry(v, arg);
1530             v = r_leave(v, arg);
1531         }
1532         break;
1533
1534       case TYPE_SYMBOL:
1535         v = ID2SYM(r_symreal(arg));
1536         v = r_leave(v, arg);
1537         break;
1538
1539       case TYPE_SYMLINK:
1540         v = ID2SYM(r_symlink(arg));
1541         break;
1542
1543       default:
1544         rb_raise(rb_eArgError, "dump format error(0x%x)", type);
1545         break;
1546     }
1547     return v;
1548 }
1549
1550 static VALUE
1551 r_object(struct load_arg *arg)
1552 {
1553     return r_object0(arg, 0, Qnil);
1554 }
1555
1556 static VALUE
1557 load(struct load_arg *arg)
1558 {
1559     return r_object(arg);
1560 }
1561
1562 static VALUE
1563 load_ensure(struct load_arg *arg)
1564 {
1565     if (!DATA_PTR(arg->compat_tbl_wrapper)) return 0;
1566     st_free_table(arg->symbols);
1567     st_free_table(arg->compat_tbl);
1568     DATA_PTR(arg->compat_tbl_wrapper) = 0;
1569     arg->compat_tbl_wrapper = 0;
1570     return 0;
1571 }
1572
1573 /*
1574  * call-seq:
1575  *     load( source [, proc] ) => obj
1576  *     restore( source [, proc] ) => obj
1577  *
1578  * Returns the result of converting the serialized data in source into a
1579  * Ruby object (possibly with associated subordinate objects). source
1580  * may be either an instance of IO or an object that responds to
1581  * to_str. If proc is specified, it will be passed each object as it
1582  * is deserialized.
1583  */
1584 static VALUE
1585 marshal_load(int argc, VALUE *argv)
1586 {
1587     VALUE port, proc;
1588     int major, minor;
1589     VALUE v;
1590     struct load_arg arg;
1591
1592     rb_scan_args(argc, argv, "11", &port, &proc);
1593     v = rb_check_string_type(port);
1594     if (!NIL_P(v)) {
1595         arg.taint = OBJ_TAINTED(port); /* original taintedness */
1596         port = v;
1597     }
1598     else if (rb_obj_respond_to(port, s_getbyte, Qtrue) && rb_obj_respond_to(port, s_read, Qtrue)) {
1599         if (rb_obj_respond_to(port, s_binmode, Qtrue)) {
1600             rb_funcall2(port, s_binmode, 0, 0);
1601         }
1602         arg.taint = Qtrue;
1603     }
1604     else {
1605         rb_raise(rb_eTypeError, "instance of IO needed");
1606     }
1607     arg.src = port;
1608     arg.offset = 0;
1609     arg.compat_tbl = st_init_numtable();
1610     arg.compat_tbl_wrapper = Data_Wrap_Struct(rb_cData, rb_mark_tbl, 0, arg.compat_tbl);
1611
1612     major = r_byte(&arg);
1613     minor = r_byte(&arg);
1614     if (major != MARSHAL_MAJOR || minor > MARSHAL_MINOR) {
1615         rb_raise(rb_eTypeError, "incompatible marshal file format (can't be read)\n\
1616 \tformat version %d.%d required; %d.%d given",
1617                  MARSHAL_MAJOR, MARSHAL_MINOR, major, minor);
1618     }
1619     if (RTEST(ruby_verbose) && minor != MARSHAL_MINOR) {
1620         rb_warn("incompatible marshal file format (can be read)\n\
1621 \tformat version %d.%d required; %d.%d given",
1622                 MARSHAL_MAJOR, MARSHAL_MINOR, major, minor);
1623     }
1624
1625     arg.symbols = st_init_numtable();
1626     arg.data   = rb_hash_new();
1627     RBASIC(arg.data)->klass = 0;
1628     if (NIL_P(proc)) arg.proc = 0;
1629     else             arg.proc = proc;
1630     v = rb_ensure(load, (VALUE)&arg, load_ensure, (VALUE)&arg);
1631
1632     return v;
1633 }
1634
1635 /*
1636  * The marshaling library converts collections of Ruby objects into a
1637  * byte stream, allowing them to be stored outside the currently
1638  * active script. This data may subsequently be read and the original
1639  * objects reconstituted.
1640  * Marshaled data has major and minor version numbers stored along
1641  * with the object information. In normal use, marshaling can only
1642  * load data written with the same major version number and an equal
1643  * or lower minor version number. If Ruby's ``verbose'' flag is set
1644  * (normally using -d, -v, -w, or --verbose) the major and minor
1645  * numbers must match exactly. Marshal versioning is independent of
1646  * Ruby's version numbers. You can extract the version by reading the
1647  * first two bytes of marshaled data.
1648  *
1649  *     str = Marshal.dump("thing")
1650  *     RUBY_VERSION   #=> "1.9.0"
1651  *     str[0].ord     #=> 4
1652  *     str[1].ord     #=> 8
1653  *
1654  * Some objects cannot be dumped: if the objects to be dumped include
1655  * bindings, procedure or method objects, instances of class IO, or
1656  * singleton objects, a TypeError will be raised.
1657  * If your class has special serialization needs (for example, if you
1658  * want to serialize in some specific format), or if it contains
1659  * objects that would otherwise not be serializable, you can implement
1660  * your own serialization strategy by defining two methods, _dump and
1661  * _load:
1662  * The instance method _dump should return a String object containing
1663  * all the information necessary to reconstitute objects of this class
1664  * and all referenced objects up to a maximum depth given as an integer
1665  * parameter (a value of -1 implies that you should disable depth checking).
1666  * The class method _load should take a String and return an object of this class.
1667  */
1668 void
1669 Init_marshal(void)
1670 {
1671     VALUE rb_mMarshal = rb_define_module("Marshal");
1672
1673     s_dump = rb_intern("_dump");
1674     s_load = rb_intern("_load");
1675     s_mdump = rb_intern("marshal_dump");
1676     s_mload = rb_intern("marshal_load");
1677     s_dump_data = rb_intern("_dump_data");
1678     s_load_data = rb_intern("_load_data");
1679     s_alloc = rb_intern("_alloc");
1680     s_getbyte = rb_intern("getbyte");
1681     s_read = rb_intern("read");
1682     s_write = rb_intern("write");
1683     s_binmode = rb_intern("binmode");
1684
1685     rb_define_module_function(rb_mMarshal, "dump", marshal_dump, -1);
1686     rb_define_module_function(rb_mMarshal, "load", marshal_load, -1);
1687     rb_define_module_function(rb_mMarshal, "restore", marshal_load, -1);
1688
1689     rb_define_const(rb_mMarshal, "MAJOR_VERSION", INT2FIX(MARSHAL_MAJOR));
1690     rb_define_const(rb_mMarshal, "MINOR_VERSION", INT2FIX(MARSHAL_MINOR));
1691
1692     compat_allocator_tbl = st_init_numtable();
1693     rb_gc_register_address(&compat_allocator_tbl_wrapper);
1694     compat_allocator_tbl_wrapper =
1695         Data_Wrap_Struct(rb_cData, mark_marshal_compat_t, 0, compat_allocator_tbl);
1696 }
1697
1698 VALUE
1699 rb_marshal_dump(VALUE obj, VALUE port)
1700 {
1701     int argc = 1;
1702     VALUE argv[2];
1703
1704     argv[0] = obj;
1705     argv[1] = port;
1706     if (!NIL_P(port)) argc = 2;
1707     return marshal_dump(argc, argv);
1708 }
1709
1710 VALUE
1711 rb_marshal_load(VALUE port)
1712 {
1713     return marshal_load(1, &port);
1714 }