1% This example shows how one can save the values of slang variables to a file 2% and then load those values back in another instance of the program. 3% 4% The following code defines two public functions: 5% 6% save_object (FILE, obj, ...); 7% (obj,...) = load_object (FILE); 8% 9% For example, 10% a = [1:20]; 11% b = 2.4; 12% c = struct { d, e }; c.d = 2.7; c.e = "foobar"; 13% save_object ("foo.save", a, b, c); 14% 15% saves the values of the variables a, b, c to a file called "foo.save". 16% These values may be retrieved later, e.g., by another program instance 17% via: 18% (a,b,c) = load_object ("foo.save"); 19% 20% Caveats: 21% 22% 1. Not all object types are supported. The ones supported include: 23% 24% All integer types (Int_Type, Char_Type, Long_Type, ...) 25% Float_Type, Double_Type 26% String_Type, BString_Type 27% Null_Type 28% 29% as well as the container classes of the above objects: 30% Struct_Type, Array_Type 31% 32% 2. The algorithm for saving Struct_Type is recursive. This allows one to 33% save a linked-list of Struct_Type objects. However, due to the recursive 34% nature of the algorithm and the interpreter's finite stack size, such 35% linked-lists cannot be arbitrarily long. 36% 37% 3. Objects are saved in the native representation. As such, the files are 38% not portable across machine architectures. 39% 40% File Format: 41% 42% Each slang object is written to the file with the following format 43% Data_Type (integer) 44% Length of Data Bytes (unsigned integer) 45% Data Bytes 46% 47% Here, Data Bytes may specify other objects if the parent is a container 48% object. 49 50%_debug_info = 1; 51 52private variable Type_Map = Assoc_Type[Integer_Type, -1]; 53private variable Write_Object_Funs = Assoc_Type[Ref_Type]; 54private variable Read_Object_Funs = Assoc_Type[Ref_Type]; 55 56!if (is_defined ("_Save_Object_Cache_Type")) 57typedef struct 58{ 59 index 60} 61_Save_Object_Cache_Type; 62 63private variable Object_Cache; 64private variable Num_Cached; 65 66private define delete_cache () 67{ 68 Object_Cache = NULL; 69 Num_Cached = 0; 70} 71 72private define create_cache () 73{ 74 delete_cache (); 75} 76 77% If the object does not need cached, return the object. 78% If the object needs cached but does not exist in the cache, cache it and 79% return it. 80% Otherwise, the object is in the cache, to return a _Save_Object_Cache_Type 81% representing the object. 82private define cache_object (obj) 83{ 84 variable t = typeof (obj); 85 86 if ((t != Array_Type) 87 and (0 == is_struct_type (obj)) 88 and (t != BString_Type)) 89 { 90 %vmessage ("not caching %S (type %S)", obj, typeof (obj)); 91 return obj; 92 } 93 94 variable n = Num_Cached; 95 variable c = Object_Cache; 96 while (n) 97 { 98 if (__is_same (c.obj, obj)) 99 { 100 obj = @_Save_Object_Cache_Type; 101 obj.index = n; 102 return obj; 103 } 104 105 c = c.next; 106 n--; 107 } 108 109 c = struct {obj, next}; 110 c.obj = obj; 111 c.next = Object_Cache; 112 Object_Cache = c; 113 Num_Cached++; 114 %vmessage ("%S (type %S) added to cache", c.obj, typeof (c.obj)); 115 116 return obj; 117} 118 119private define get_object_from_cache (index) 120{ 121 variable depth = Num_Cached - index; 122 variable c = Object_Cache; 123 while (depth) 124 { 125 c = c.next; 126 depth--; 127 } 128 return c.obj; 129} 130 131private define get_type_id (type) 132{ 133 variable id; 134 id = Type_Map[string (type)]; 135 if (id == -1) 136 verror ("Object %S is not supported", type); 137 return id; 138} 139 140private define write_not_implemented (fp, object) 141{ 142 () = fprintf (stderr, "write for object %S not implemented\n", typeof (object)); 143 return 0; 144} 145 146private define do_fwrite (a, fp) 147{ 148 %vmessage ("Writing %S", a); 149 variable n = fwrite (a, fp); 150 if (n == -1) 151 verror ("fwrite failed: %s", errno_string (errno)); 152 return n; 153} 154 155private define do_fread (t, n, fp) 156{ 157 variable b; 158 if (n != fread (&b, t, n, fp)) 159 verror ("fread failed: %s", errno_string (errno)); 160 %vmessage ("Read %S", b); 161 return b; 162} 163 164private define do_ftell (fp) 165{ 166 variable pos = ftell (fp); 167 if (-1 == pos) 168 verror ("ftell failed: %s", errno_string (errno)); 169 return pos; 170} 171 172private define do_fseek (fp, ofs, whence) 173{ 174 if (-1 == fseek (fp, ofs, whence)) 175 verror ("fseek failed: %s", errno_string (errno)); 176} 177 178private define sizeof (t) 179{ 180 variable size; 181 182 switch (t) 183 { case Char_Type or case UChar_Type: size = 1; } 184 { case Int16_Type or case UInt16_Type: size = 2; } 185 { case Int32_Type or case UInt32_Type: size = 4; } 186 { case Float_Type: size = 4; } 187 { case Double_Type: size = 8; } 188 { 189 verror ("sizeof (%S) not implemented", t); 190 } 191 192 return size; 193} 194 195private define write_numbers (fp, a) 196{ 197 variable size = sizeof (_typeof (a)); 198 variable num = do_fwrite (a, fp); 199 return num * size; 200} 201 202private define read_numbers (fp, t, nbytes) 203{ 204 variable size = sizeof (t); 205 nbytes /= size; 206 return do_fread (t, nbytes, fp); 207} 208 209private define write_string (fp, a) 210{ 211 return do_fwrite (a, fp); 212} 213 214private define read_string (fp, t, nbytes) 215{ 216 return do_fread (BString_Type, nbytes, fp); 217} 218 219private define start_header (fp, id) 220{ 221 variable len = write_numbers (fp, id); 222 variable pos = do_ftell (fp); 223 len += write_numbers (fp, 0); % temporary 224 225 variable h = struct 226 { 227 pos, len 228 }; 229 h.pos = pos; 230 h.len = len; 231 232 return h; 233} 234 235private define end_header (fp, h, num) 236{ 237 do_fseek (fp, h.pos, SEEK_SET); 238 () = do_fwrite (num, fp); 239 do_fseek (fp, 0, SEEK_END); 240 return h.len + num; 241} 242 243private define id_to_datatype (id) 244{ 245 variable keys, values; 246 247 keys = assoc_get_keys (Type_Map); 248 values = assoc_get_values (Type_Map); 249 variable i = where (values == id); 250 !if (length (i)) 251 verror ("Corrupt file? Unknown type-id (%d)", id); 252 return eval (keys[i][0]); 253} 254 255private define write_scalars (fp, a) 256{ 257 variable id = get_type_id (typeof (a)); 258 variable h = start_header (fp, id); 259 variable len = write_numbers (fp, a); 260 return end_header (fp, h, len); 261} 262 263private define read_null (fp, t, nbytes) 264{ 265 return NULL; 266} 267 268private define write_null (fp, a) 269{ 270 return 0; 271} 272 273private define write_object (); 274private define read_object (); 275 276% Array DataBytes: int num_dims, int dims[num_dims], type, Data... 277private define write_array (fp, a) 278{ 279 variable dims, num_dims, data_type; 280 (dims, num_dims, data_type) = array_info (a); 281 variable len; 282 variable id = get_type_id (data_type); 283 284 len = write_numbers (fp, num_dims) + write_numbers (fp, dims) 285 + write_numbers (fp, id); 286 287 % For now allow numbers or strings 288 if (_typeof(a) == String_Type) 289 { 290 foreach (a) 291 { 292 variable elem = (); 293 len += write_object (fp, elem); 294 } 295 296 return len; 297 } 298 299 len += write_numbers (fp, a); 300 301 return len; 302} 303 304private define read_array (fp, type, nbytes) 305{ 306 variable num_dims = do_fread (Int_Type, 1, fp); 307 variable dims = do_fread (Int_Type, num_dims, fp); 308 type = do_fread (Int_Type, 1, fp); 309 variable len; 310 len = 1; 311 foreach (dims) 312 len *= (); 313 314 type = id_to_datatype (type); 315 316 variable v; 317 318 if (type == String_Type) 319 { 320 v = String_Type [len]; 321 _for (0,len-1,1) 322 { 323 variable i = (); 324 v[i] = read_object (fp, NULL); 325 } 326 } 327 else v = do_fread (type, len, fp); 328 329 reshape (v, dims); 330 return v; 331} 332 333% Data Bytes: int num_fields. String-Object [num_fields], Values[num_fields] 334private define write_struct (fp, a) 335{ 336 variable fields = get_struct_field_names (a); 337 variable len = write_numbers (fp, typecast (length (fields), Int_Type)); 338 foreach (fields) 339 { 340 variable f = (); 341 len += write_object (fp, f); 342 } 343 344 foreach (fields) 345 { 346 f = (); 347 len += write_object (fp, get_struct_field (a, f)); 348 } 349 350 return len; 351} 352 353private define read_struct (fp, type, nbytes) 354{ 355 variable num_fields = do_fread (Int_Type, 1, fp); 356 variable fields = String_Type[num_fields]; 357 variable i; 358 _for (0, num_fields-1, 1) 359 { 360 i = (); 361 fields[i] = read_object (fp, NULL); 362 } 363 364 variable s = @Struct_Type (fields); 365 366 % make sure it is in the cache in case the fields refer to it. 367 if (type != _Save_Object_Cache_Type) 368 () = cache_object (s); 369 370 _for (0, num_fields-1, 1) 371 { 372 i = (); 373 set_struct_field (s, fields[i], read_object (fp, NULL)); 374 } 375 376 return s; 377} 378 379% Data Bytes: int index 380private define write_cached_object (fp, a) 381{ 382 return write_numbers (fp, a.index); 383} 384 385private define read_cached_object (fp, type, nbytes) 386{ 387 variable index = read_numbers (fp, Int_Type, nbytes); 388 return get_object_from_cache (index); 389} 390 391private define add_type (t, w, r, id) 392{ 393 t = string (t); 394 Type_Map[t] = id; 395 Write_Object_Funs[t] = w; 396 Read_Object_Funs [t] = r; 397} 398 399add_type (Char_Type, &write_numbers, &read_numbers, 1); 400add_type (UChar_Type, &write_numbers, &read_numbers, 2); 401add_type (Short_Type, &write_numbers, &read_numbers, 3); 402add_type (UShort_Type, &write_numbers, &read_numbers, 4); 403add_type (Integer_Type, &write_numbers, &read_numbers, 5); 404add_type (UInteger_Type,&write_numbers, &read_numbers, 6); 405add_type (Long_Type, &write_numbers, &read_numbers, 7); 406add_type (ULong_Type, &write_numbers, &read_numbers, 8); 407add_type (Float_Type, &write_numbers, &read_numbers, 9); 408add_type (Double_Type, &write_numbers, &read_numbers, 10); 409add_type (String_Type, &write_string, &read_string, 11); 410add_type (BString_Type, &write_string, &read_string, 12); 411add_type (Struct_Type, &write_struct, &read_struct, 13); 412add_type (Array_Type, &write_array, &read_array, 14); 413add_type (Null_Type, &write_null, &read_null, 15); 414 415add_type (_Save_Object_Cache_Type, &write_cached_object, &read_cached_object, 1000); 416 417private define get_write_function (type) 418{ 419 variable key = string (type); 420 if (assoc_key_exists (Write_Object_Funs, key)) 421 return Write_Object_Funs[key]; 422 verror ("No write method defined for %S", key); 423} 424 425private define get_read_function (type) 426{ 427 variable key = string (type); 428 if (assoc_key_exists (Read_Object_Funs, key)) 429 return Read_Object_Funs[key]; 430 verror ("No read method defined for %S", key); 431} 432 433private define write_object (fp, a) 434{ 435 a = cache_object (a); 436 variable id = get_type_id (typeof (a)); 437 438 variable h = start_header (fp, id); 439 variable f = get_write_function (typeof (a)); 440 variable num = (@f)(fp, a); 441 %vmessage ("Done Writing %S", a); 442 return end_header (fp, h, num); 443} 444 445private define read_object (fp, statusp) 446{ 447 variable type, nbytes; 448 variable status = fread (&type, Integer_Type, 1, fp); 449 if (status == -1) 450 { 451 if (statusp == NULL) 452 verror ("No more objects in file"); 453 454 @statusp = 0; 455 return 0; 456 } 457 458 nbytes = do_fread (Integer_Type, 1, fp); 459 type = id_to_datatype (type); 460 461 variable f = get_read_function (type); 462 variable v = (@f)(fp, type, nbytes); 463 464 % Necessary because String_Type may get written as BString_Type 465 if (type != _Save_Object_Cache_Type) 466 { 467 v = typecast (v, type); 468 () = cache_object (v); 469 } 470 471 %vmessage ("Read %S", v); 472 if (statusp != NULL) 473 @statusp = 1; 474 475 return v; 476} 477 478public define save_object () 479{ 480 if (_NARGS < 2) 481 usage ("save_object (file, obj1, ...)"); 482 483 variable objs = __pop_args (_NARGS - 1); 484 variable file = (); 485 486 variable fp = fopen (file, "w+"); 487 if (fp == NULL) 488 verror ("Unable to open %s: %s", file, errno_string (errno)); 489 490 create_cache (); 491 492 foreach (objs) 493 { 494 variable obj = ().value; 495 () = write_object (fp, obj); 496 } 497 498 delete_cache (); 499} 500 501public define load_object () 502{ 503 if (_NARGS != 1) 504 usage ("(var1,...) = load_object (filename);"); 505 variable file = (); 506 variable fp = fopen (file, "r"); 507 if (fp == NULL) 508 verror ("Unable to open %s: %s", file, errno_string (errno)); 509 510 create_cache (); 511 forever 512 { 513 variable status; 514 variable obj = read_object (fp, &status); 515 if (status == 0) 516 break; 517 obj; 518 } 519 delete_cache (); 520} 521 522#ifntrue 523% Regression test 524private define failed (s, a, b) 525{ 526 vmessage ("Failed: %s: wrote: '%S', read '%S'\n", s, a, b); 527} 528 529private define test_eqs (); 530private define test_eqs (a, b) 531{ 532 if ((typeof (a) != typeof (b)) 533 or (_typeof (a) != _typeof (b))) 534 { 535 failed ("typeof", typeof(a), typeof(b)); 536 verror ("foo"); 537 return 0; 538 } 539 540 if (typeof (a) != Struct_Type) 541 { 542 if (length (a) != length (b)) 543 { 544 failed ("test_eqs length", a, b); 545 return 0; 546 } 547 548 if (length (where (a != b))) 549 { 550 failed ("test_eqs", a, b); 551 return 0; 552 } 553 return 1; 554 } 555 556 variable fa, fb; 557 fa = get_struct_field_names (a); 558 fb = get_struct_field_names (b); 559 560 !if (test_eqs (fa, fb)) 561 { 562 failed ("test_eqs: fa, fb"); 563 return 0; 564 } 565 566 if (length (fa) != length (fb)) 567 return 0; 568 569 foreach (fa) 570 { 571 variable name = (); 572 variable va, vb; 573 va = get_struct_field (a, name); 574 vb = get_struct_field (b, name); 575 if ((typeof (va) == Struct_Type) 576 and (typeof (vb) == Struct_Type)) 577 { 578 % void loop 579 continue; 580 } 581 !if (test_eqs (va, vb)) 582 return 0; 583 } 584 585 return 1; 586} 587 588private define test_save_object () 589{ 590 variable x0 = 1278; 591 variable x1 = 2.3; 592 variable x2 = "foo"; 593 variable x3 = struct 594 { 595 a, b, c, d 596 }; 597 variable x4 = [1:10]; 598 variable x5 = ["a","b","c","d"]; 599 600 x3.a = "foo"; 601 x3.b = PI; 602 x3.c = [1:20]; 603 x3.d = x3; 604 605 variable x6 = typecast ("foo", BString_Type); 606 variable x7 = x6; 607 save_object ("foo.sv", x0,x1,x2,x3,x4,x5,x6,x7); 608 609 variable y0,y1,y2,y3,y4,y5,y6,y7; 610 611 (y0,y1,y2,y3,y4,y5,y6,y7) = load_object ("foo.sv"); 612 613 !if (test_eqs (x0, y0)) 614 failed ("x0", x0, y0); 615 !if (test_eqs (x1, y1)) 616 failed ("x1", x1, y1); 617 !if (test_eqs (x2, y2)) 618 failed ("x2", x2, y2); 619 620 !if (test_eqs (x3, y3)) 621 failed ("x3", x3, y3); 622 623 !if (test_eqs (x4, y4)) 624 failed ("x4", x4, y4); 625 !if (test_eqs (x5, y5)) 626 failed ("x5", x5, y5); 627 628 !if (test_eqs (x6, y6)) 629 failed ("x5", x6, y6); 630 !if (__is_same (y6,y7)) 631 failed ("__is_same(y6,y7)",y6,y7); 632 633 vmessage ("Regression Test Done"); 634} 635 636test_save_object (); 637#endif 638