Mercurial > octave

comparison src/load-save.cc @ 1226:2457d4ba0691

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
[project @ 1995-04-10 00:41:14 by jwe]
author jwe
date Mon, 10 Apr 1995 00:41:32 +0000
parents b6360f2d4fa6
children d607adf5af66
comparison
equal deleted inserted replaced
1225:b013cff15746 1226:2457d4ba0691
37 #include "tree-expr.h" 37 #include "tree-expr.h"
38 #include "tree-const.h" 38 #include "tree-const.h"
39 #include "user-prefs.h" 39 #include "user-prefs.h"
40 #include "unwind-prot.h" 40 #include "unwind-prot.h"
41 #include "load-save.h" 41 #include "load-save.h"
42 #include "sysdep.h"
42 #include "symtab.h" 43 #include "symtab.h"
43 #include "pager.h" 44 #include "pager.h"
44 #include "error.h" 45 #include "error.h"
45 #include "gripes.h" 46 #include "gripes.h"
46 #include "defun.h" 47 #include "defun.h"
84 { 85 {
85 LS_ASCII, 86 LS_ASCII,
86 LS_BINARY, 87 LS_BINARY,
87 LS_MAT_BINARY, 88 LS_MAT_BINARY,
88 LS_UNKNOWN, 89 LS_UNKNOWN,
89 };
90
91 enum floating_point_format
92 {
93 LS_IEEE_LITTLE,
94 LS_IEEE_BIG,
95 LS_VAX_D,
96 LS_VAX_G,
97 LS_CRAY,
98 LS_UNKNOWN_FLT_FMT,
99 }; 90 };
100 91
101 // Not all of the following are currently used. 92 // Not all of the following are currently used.
102 93
103 enum save_type 94 enum save_type
109 LS_SHORT, 100 LS_SHORT,
110 LS_INT, 101 LS_INT,
111 LS_FLOAT, 102 LS_FLOAT,
112 LS_DOUBLE, 103 LS_DOUBLE,
113 }; 104 };
114
115 #if defined (IEEE_LITTLE_ENDIAN)
116 #define NATIVE_FLOAT_FORMAT LS_IEEE_LITTLE
117 #elif defined (IEEE_BIG_ENDIAN)
118 #define NATIVE_FLOAT_FORMAT LS_IEEE_BIG
119 #elif defined (VAX_D_FLOAT)
120 #define NATIVE_FLOAT_FORMAT LS_VAX_D
121 #elif defined (VAX_G_FLOAT)
122 #define NATIVE_FLOAT_FORMAT LS_VAX_G
123 #else
124 LOSE! LOSE!
125 #endif
126 105
127 #define swap_1_bytes(x,y) 106 #define swap_1_bytes(x,y)
128 107
129 #define LS_DO_READ(TYPE,swap,data,size,len,stream) \ 108 #define LS_DO_READ(TYPE,swap,data,size,len,stream) \
130 do \ 109 do \
228 207
229 // XXX FIXME XXX -- assumes sizeof (Complex) == 8 208 // XXX FIXME XXX -- assumes sizeof (Complex) == 8
230 // XXX FIXME XXX -- assumes sizeof (double) == 8 209 // XXX FIXME XXX -- assumes sizeof (double) == 8
231 // XXX FIXME XXX -- assumes sizeof (float) == 4 210 // XXX FIXME XXX -- assumes sizeof (float) == 4
232 211
233 #if defined (IEEE_LITTLE_ENDIAN)
234
235 static void 212 static void
236 IEEE_big_double_to_IEEE_little_double (double *d, int len) 213 IEEE_big_double_to_IEEE_little_double (double *d, int len)
237 { 214 {
238 swap_8_bytes ((char *) d, len); 215 swap_8_bytes ((char *) d, len);
239 } 216 }
278 Cray_to_IEEE_little_float (float *d, int len) 255 Cray_to_IEEE_little_float (float *d, int len)
279 { 256 {
280 gripe_data_conversion ("Cray", "IEEE little endian format"); 257 gripe_data_conversion ("Cray", "IEEE little endian format");
281 } 258 }
282 259
283 #elif defined (IEEE_BIG_ENDIAN)
284
285 static void 260 static void
286 IEEE_little_double_to_IEEE_big_double (double *d, int len) 261 IEEE_little_double_to_IEEE_big_double (double *d, int len)
287 { 262 {
288 swap_8_bytes ((char *) d, len); 263 swap_8_bytes ((char *) d, len);
289 } 264 }
328 Cray_to_IEEE_big_float (float *d, int len) 303 Cray_to_IEEE_big_float (float *d, int len)
329 { 304 {
330 gripe_data_conversion ("Cray", "IEEE big endian format"); 305 gripe_data_conversion ("Cray", "IEEE big endian format");
331 } 306 }
332 307
333 #elif defined (VAX_D_FLOAT)
334
335 static void 308 static void
336 IEEE_little_double_to_VAX_D_double (double *d, int len) 309 IEEE_little_double_to_VAX_D_double (double *d, int len)
337 { 310 {
338 gripe_data_conversion ("IEEE little endian", "VAX D"); 311 gripe_data_conversion ("IEEE little endian", "VAX D");
339 } 312 }
378 Cray_to_VAX_D_float (float *d, int len) 351 Cray_to_VAX_D_float (float *d, int len)
379 { 352 {
380 gripe_data_conversion ("Cray", "VAX D"); 353 gripe_data_conversion ("Cray", "VAX D");
381 } 354 }
382 355
383 #elif defined (VAX_G_FLOAT)
384
385 static void 356 static void
386 IEEE_little_double_to_VAX_G_double (double *d, int len) 357 IEEE_little_double_to_VAX_G_double (double *d, int len)
387 { 358 {
388 gripe_data_conversion ("IEEE little endian", "VAX G"); 359 gripe_data_conversion ("IEEE little endian", "VAX G");
389 } 360 }
427 static void 398 static void
428 Cray_to_VAX_G_float (float *d, int len) 399 Cray_to_VAX_G_float (float *d, int len)
429 { 400 {
430 gripe_data_conversion ("VAX G float", "VAX G"); 401 gripe_data_conversion ("VAX G float", "VAX G");
431 } 402 }
432
433 #endif
434 403
435 static void 404 static void
436 do_double_format_conversion (double *data, int len, 405 do_double_format_conversion (double *data, int len,
437 floating_point_format fmt) 406 floating_point_format fmt)
438 { 407 {
439 switch (fmt) 408 switch (native_float_format)
440 { 409 {
441 #if defined (IEEE_LITTLE_ENDIAN) 410 case OCTAVE_IEEE_LITTLE:
442 411 switch (fmt)
443 case LS_IEEE_LITTLE: 412 {
444 break; 413 case OCTAVE_IEEE_LITTLE:
445 414 break;
446 case LS_IEEE_BIG: 415
447 IEEE_big_double_to_IEEE_little_double (data, len); 416 case OCTAVE_IEEE_BIG:
448 break; 417 IEEE_big_double_to_IEEE_little_double (data, len);
449 418 break;
450 case LS_VAX_D: 419
451 VAX_D_double_to_IEEE_little_double (data, len); 420 case OCTAVE_VAX_D:
452 break; 421 VAX_D_double_to_IEEE_little_double (data, len);
453 422 break;
454 case LS_VAX_G: 423
455 VAX_G_double_to_IEEE_little_double (data, len); 424 case OCTAVE_VAX_G:
456 break; 425 VAX_G_double_to_IEEE_little_double (data, len);
457 426 break;
458 case LS_CRAY: 427
459 Cray_to_IEEE_little_double (data, len); 428 case OCTAVE_CRAY:
460 break; 429 Cray_to_IEEE_little_double (data, len);
461 430 break;
462 #elif defined (IEEE_BIG_ENDIAN) 431
463 432 default:
464 case LS_IEEE_LITTLE: 433 gripe_unrecognized_float_fmt ();
465 IEEE_little_double_to_IEEE_big_double (data, len); 434 break;
466 break; 435 }
467 436
468 case LS_IEEE_BIG: 437 case OCTAVE_IEEE_BIG:
469 break; 438 switch (fmt)
470 439 {
471 case LS_VAX_D: 440 case OCTAVE_IEEE_LITTLE:
472 VAX_D_double_to_IEEE_big_double (data, len); 441 IEEE_little_double_to_IEEE_big_double (data, len);
473 break; 442 break;
474 443
475 case LS_VAX_G: 444 case OCTAVE_IEEE_BIG:
476 VAX_G_double_to_IEEE_big_double (data, len); 445 break;
477 break; 446
478 447 case OCTAVE_VAX_D:
479 case LS_CRAY: 448 VAX_D_double_to_IEEE_big_double (data, len);
480 Cray_to_IEEE_big_double (data, len); 449 break;
481 break; 450
482 451 case OCTAVE_VAX_G:
483 #elif defined (VAX_D_FLOAT) 452 VAX_G_double_to_IEEE_big_double (data, len);
484 453 break;
485 case LS_IEEE_LITTLE: 454
486 IEEE_little_double_to_VAX_D_double (data, len); 455 case OCTAVE_CRAY:
487 break; 456 Cray_to_IEEE_big_double (data, len);
488 457 break;
489 case LS_IEEE_BIG: 458
490 IEEE_big_double_to_VAX_D_double (data, len); 459 default:
491 break; 460 gripe_unrecognized_float_fmt ();
492 461 break;
493 case LS_VAX_D: 462 }
494 break; 463
495 464 case OCTAVE_VAX_D:
496 case LS_VAX_G: 465 switch (fmt)
497 VAX_G_double_to_VAX_D_double (data, len); 466 {
498 break; 467 case OCTAVE_IEEE_LITTLE:
499 468 IEEE_little_double_to_VAX_D_double (data, len);
500 case LS_CRAY: 469 break;
501 Cray_to_VAX_D_double (data, len); 470
502 break; 471 case OCTAVE_IEEE_BIG:
503 472 IEEE_big_double_to_VAX_D_double (data, len);
504 #elif defined (VAX_G_FLOAT) 473 break;
505 474
506 case LS_IEEE_LITTLE: 475 case OCTAVE_VAX_D:
507 IEEE_little_double_to_VAX_G_double (data, len); 476 break;
508 break; 477
509 478 case OCTAVE_VAX_G:
510 case LS_IEEE_BIG: 479 VAX_G_double_to_VAX_D_double (data, len);
511 IEEE_big_double_to_VAX_G_double (data, len); 480 break;
512 break; 481
513 482 case OCTAVE_CRAY:
514 case LS_VAX_D: 483 Cray_to_VAX_D_double (data, len);
515 VAX_D_double_to_VAX_G_double (data, len); 484 break;
516 break; 485
517 486 default:
518 case LS_VAX_G: 487 gripe_unrecognized_float_fmt ();
519 break; 488 break;
520 489 }
521 case LS_CRAY: 490
522 Cray_to_VAX_G_double (data, len); 491 case OCTAVE_VAX_G:
523 break; 492 switch (fmt)
524 493 {
525 #else 494 case OCTAVE_IEEE_LITTLE:
526 LOSE! LOSE! 495 IEEE_little_double_to_VAX_G_double (data, len);
527 #endif 496 break;
497
498 case OCTAVE_IEEE_BIG:
499 IEEE_big_double_to_VAX_G_double (data, len);
500 break;
501
502 case OCTAVE_VAX_D:
503 VAX_D_double_to_VAX_G_double (data, len);
504 break;
505
506 case OCTAVE_VAX_G:
507 break;
508
509 case OCTAVE_CRAY:
510 Cray_to_VAX_G_double (data, len);
511 break;
512
513 default:
514 gripe_unrecognized_float_fmt ();
515 break;
516 }
528 517
529 default: 518 default:
530 gripe_unrecognized_float_fmt (); 519 panic_impossible ();
531 break;
532 } 520 }
533 } 521 }
534 522
535 static void 523 static void
536 do_float_format_conversion (float *data, int len, 524 do_float_format_conversion (float *data, int len,
537 floating_point_format fmt) 525 floating_point_format fmt)
538 { 526 {
539 switch (fmt) 527 switch (native_float_format)
540 { 528 {
541 #if defined (IEEE_LITTLE_ENDIAN) 529 case OCTAVE_IEEE_LITTLE:
542 530 switch (fmt)
543 case LS_IEEE_LITTLE: 531 {
544 break; 532 case OCTAVE_IEEE_LITTLE:
545 533 break;
546 case LS_IEEE_BIG: 534
547 IEEE_big_float_to_IEEE_little_float (data, len); 535 case OCTAVE_IEEE_BIG:
548 break; 536 IEEE_big_float_to_IEEE_little_float (data, len);
549 537 break;
550 case LS_VAX_D: 538
551 VAX_D_float_to_IEEE_little_float (data, len); 539 case OCTAVE_VAX_D:
552 break; 540 VAX_D_float_to_IEEE_little_float (data, len);
553 541 break;
554 case LS_VAX_G: 542
555 VAX_G_float_to_IEEE_little_float (data, len); 543 case OCTAVE_VAX_G:
556 break; 544 VAX_G_float_to_IEEE_little_float (data, len);
557 545 break;
558 case LS_CRAY: 546
559 Cray_to_IEEE_little_float (data, len); 547 case OCTAVE_CRAY:
560 break; 548 Cray_to_IEEE_little_float (data, len);
561 549 break;
562 #elif defined (IEEE_BIG_ENDIAN) 550
563 551 default:
564 case LS_IEEE_LITTLE: 552 gripe_unrecognized_float_fmt ();
565 IEEE_little_float_to_IEEE_big_float (data, len); 553 break;
566 break; 554 }
567 555
568 case LS_IEEE_BIG: 556 case OCTAVE_IEEE_BIG:
569 break; 557 switch (fmt)
570 558 {
571 case LS_VAX_D: 559 case OCTAVE_IEEE_LITTLE:
572 VAX_D_float_to_IEEE_big_float (data, len); 560 IEEE_little_float_to_IEEE_big_float (data, len);
573 break; 561 break;
574 562
575 case LS_VAX_G: 563 case OCTAVE_IEEE_BIG:
576 VAX_G_float_to_IEEE_big_float (data, len); 564 break;
577 break; 565
578 566 case OCTAVE_VAX_D:
579 case LS_CRAY: 567 VAX_D_float_to_IEEE_big_float (data, len);
580 Cray_to_IEEE_big_float (data, len); 568 break;
581 break; 569
582 570 case OCTAVE_VAX_G:
583 #elif defined (VAX_D_FLOAT) 571 VAX_G_float_to_IEEE_big_float (data, len);
584 572 break;
585 case LS_IEEE_LITTLE: 573
586 IEEE_little_float_to_VAX_D_float (data, len); 574 case OCTAVE_CRAY:
587 break; 575 Cray_to_IEEE_big_float (data, len);
588 576 break;
589 case LS_IEEE_BIG: 577
590 IEEE_big_float_to_VAX_D_float (data, len); 578 default:
591 break; 579 gripe_unrecognized_float_fmt ();
592 580 break;
593 case LS_VAX_D: 581 }
594 break; 582
595 583 case OCTAVE_VAX_D:
596 case LS_VAX_G: 584 switch (fmt)
597 VAX_G_float_to_VAX_D_float (data, len); 585 {
598 break; 586 case OCTAVE_IEEE_LITTLE:
599 587 IEEE_little_float_to_VAX_D_float (data, len);
600 case LS_CRAY: 588 break;
601 Cray_to_VAX_D_float (data, len); 589
602 break; 590 case OCTAVE_IEEE_BIG:
603 591 IEEE_big_float_to_VAX_D_float (data, len);
604 #elif defined (VAX_G_FLOAT) 592 break;
605 593
606 case LS_IEEE_LITTLE: 594 case OCTAVE_VAX_D:
607 IEEE_little_float_to_VAX_G_float (data, len); 595 break;
608 break; 596
609 597 case OCTAVE_VAX_G:
610 case LS_IEEE_BIG: 598 VAX_G_float_to_VAX_D_float (data, len);
611 IEEE_big_float_to_VAX_G_float (data, len); 599 break;
612 break; 600
613 601 case OCTAVE_CRAY:
614 case LS_VAX_D: 602 Cray_to_VAX_D_float (data, len);
615 VAX_D_float_to_VAX_G_float (data, len); 603 break;
616 break; 604
617 605 default:
618 case LS_VAX_G: 606 gripe_unrecognized_float_fmt ();
619 break; 607 break;
620 608 }
621 case LS_CRAY: 609
622 Cray_to_VAX_G_float (data, len); 610 case OCTAVE_VAX_G:
623 break; 611 switch (fmt)
624 612 {
625 #else 613 case OCTAVE_IEEE_LITTLE:
626 LOSE! LOSE! 614 IEEE_little_float_to_VAX_G_float (data, len);
627 #endif 615 break;
616
617 case OCTAVE_IEEE_BIG:
618 IEEE_big_float_to_VAX_G_float (data, len);
619 break;
620
621 case OCTAVE_VAX_D:
622 VAX_D_float_to_VAX_G_float (data, len);
623 break;
624
625 case OCTAVE_VAX_G:
626 break;
627
628 case OCTAVE_CRAY:
629 Cray_to_VAX_G_float (data, len);
630 break;
631
632 default:
633 gripe_unrecognized_float_fmt ();
634 break;
635 }
628 636
629 default: 637 default:
630 gripe_unrecognized_float_fmt (); 638 panic_impossible ();
631 break;
632 } 639 }
633 } 640 }
634 641
635 static void 642 static void
636 read_doubles (istream& is, double *data, save_type type, int len, 643 read_doubles (istream& is, double *data, save_type type, int len,
1715 // possible errors. 1722 // possible errors.
1716 1723
1717 static floating_point_format 1724 static floating_point_format
1718 get_floating_point_format (int mach) 1725 get_floating_point_format (int mach)
1719 { 1726 {
1720 floating_point_format flt_fmt = LS_UNKNOWN_FLT_FMT; 1727 floating_point_format flt_fmt = OCTAVE_UNKNOWN_FLT_FMT;
1721 1728
1722 switch (mach) 1729 switch (mach)
1723 { 1730 {
1724 case 0: 1731 case 0:
1725 flt_fmt = LS_IEEE_LITTLE; 1732 flt_fmt = OCTAVE_IEEE_LITTLE;
1726 break; 1733 break;
1727 1734
1728 case 1: 1735 case 1:
1729 flt_fmt = LS_IEEE_BIG; 1736 flt_fmt = OCTAVE_IEEE_BIG;
1730 break; 1737 break;
1731 1738
1732 case 2: 1739 case 2:
1733 flt_fmt = LS_VAX_D; 1740 flt_fmt = OCTAVE_VAX_D;
1734 break; 1741 break;
1735 1742
1736 case 3: 1743 case 3:
1737 flt_fmt = LS_VAX_G; 1744 flt_fmt = OCTAVE_VAX_G;
1738 break; 1745 break;
1739 1746
1740 case 4: 1747 case 4:
1741 flt_fmt = LS_CRAY; 1748 flt_fmt = OCTAVE_CRAY;
1742 break; 1749 break;
1743 1750
1744 default: 1751 default:
1745 flt_fmt = LS_UNKNOWN_FLT_FMT; 1752 flt_fmt = OCTAVE_UNKNOWN_FLT_FMT;
1746 break; 1753 break;
1747 } 1754 }
1748 1755
1749 return flt_fmt; 1756 return flt_fmt;
1750 } 1757 }
1766 // These are initialized here instead of closer to where they are 1773 // These are initialized here instead of closer to where they are
1767 // first used to avoid errors from gcc about goto crossing 1774 // first used to avoid errors from gcc about goto crossing
1768 // initialization of variable. 1775 // initialization of variable.
1769 1776
1770 Matrix re; 1777 Matrix re;
1771 floating_point_format flt_fmt = LS_UNKNOWN_FLT_FMT; 1778 floating_point_format flt_fmt = OCTAVE_UNKNOWN_FLT_FMT;
1772 char *name = 0; 1779 char *name = 0;
1773 int swap = 0, type = 0, prec = 0, mach = 0, dlen = 0; 1780 int swap = 0, type = 0, prec = 0, mach = 0, dlen = 0;
1774 1781
1775 FOUR_BYTE_INT mopt, nr, nc, imag, len; 1782 FOUR_BYTE_INT mopt, nr, nc, imag, len;
1776 1783
1788 prec = mopt % 10; // double, float, int, etc. 1795 prec = mopt % 10; // double, float, int, etc.
1789 mopt /= 100; // Skip unused third digit too. 1796 mopt /= 100; // Skip unused third digit too.
1790 mach = mopt % 10; // IEEE, VAX, etc. 1797 mach = mopt % 10; // IEEE, VAX, etc.
1791 1798
1792 flt_fmt = get_floating_point_format (mach); 1799 flt_fmt = get_floating_point_format (mach);
1793 if (flt_fmt == LS_UNKNOWN_FLT_FMT) 1800 if (flt_fmt == OCTAVE_UNKNOWN_FLT_FMT)
1794 { 1801 {
1795 error ("load: unrecognized binary format!"); 1802 error ("load: unrecognized binary format!");
1796 return 0; 1803 return 0;
1797 } 1804 }
1798 1805
1908 1915
1909 char tmp = 0; 1916 char tmp = 0;
1910 is.read (&tmp, 1); 1917 is.read (&tmp, 1);
1911 1918
1912 flt_fmt = get_floating_point_format (tmp); 1919 flt_fmt = get_floating_point_format (tmp);
1913 if (flt_fmt == LS_UNKNOWN_FLT_FMT) 1920 if (flt_fmt == OCTAVE_UNKNOWN_FLT_FMT)
1914 { 1921 {
1915 if (! quiet) 1922 if (! quiet)
1916 error ("load: unrecognized binary format!"); 1923 error ("load: unrecognized binary format!");
1917 return -1; 1924 return -1;
1918 } 1925 }
1932 error ("load: couldn't open input file `%s'", orig_fname); 1939 error ("load: couldn't open input file `%s'", orig_fname);
1933 return retval; 1940 return retval;
1934 } 1941 }
1935 1942
1936 int swap; 1943 int swap;
1937 floating_point_format flt_fmt = LS_UNKNOWN_FLT_FMT; 1944 floating_point_format flt_fmt = OCTAVE_UNKNOWN_FLT_FMT;
1938 1945
1939 if (read_binary_file_header (file, swap, flt_fmt, 1) == 0) 1946 if (read_binary_file_header (file, swap, flt_fmt, 1) == 0)
1940 retval = LS_BINARY; 1947 retval = LS_BINARY;
1941 else 1948 else
1942 { 1949 {
2156 return retval; 2163 return retval;
2157 } 2164 }
2158 2165
2159 char *orig_fname = *argv; 2166 char *orig_fname = *argv;
2160 2167
2161 floating_point_format flt_fmt = LS_UNKNOWN_FLT_FMT; 2168 floating_point_format flt_fmt = OCTAVE_UNKNOWN_FLT_FMT;
2162 2169
2163 int swap = 0; 2170 int swap = 0;
2164 2171
2165 if (strcmp (*argv, "-") == 0) 2172 if (strcmp (*argv, "-") == 0)
2166 { 2173 {
2443 int fail = 0; 2450 int fail = 0;
2444 2451
2445 FOUR_BYTE_INT mopt = 0; 2452 FOUR_BYTE_INT mopt = 0;
2446 2453
2447 mopt += tc.is_string () ? 1 : 0; 2454 mopt += tc.is_string () ? 1 : 0;
2448 mopt += 1000 * get_floating_point_format (NATIVE_FLOAT_FORMAT); 2455 mopt += 1000 * get_floating_point_format (native_float_format);
2449 2456
2450 os.write (&mopt, 4); 2457 os.write (&mopt, 4);
2451 2458
2452 FOUR_BYTE_INT nr = tc.rows (); 2459 FOUR_BYTE_INT nr = tc.rows ();
2453 os.write (&nr, 4); 2460 os.write (&nr, 4);
2843 stream << "Octave-1-B"; 2850 stream << "Octave-1-B";
2844 #else 2851 #else
2845 stream << "Octave-1-L"; 2852 stream << "Octave-1-L";
2846 #endif 2853 #endif
2847 2854
2848 char tmp = (char) NATIVE_FLOAT_FORMAT; 2855 char tmp = (char) native_float_format;
2849 stream.write (&tmp, 1); 2856 stream.write (&tmp, 1);
2850 } 2857 }
2851 } 2858 }
2852 2859
2853 static void 2860 static void