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