interpreters/frotz/object.c

   1 /* object.c - Object manipulation opcodes
   2  *        Copyright (c) 1995-1997 Stefan Jokisch
   3  *
   4  * This file is part of Frotz.
   5  *
   6  * Frotz is free software; you can redistribute it and/or modify
   7  * it under the terms of the GNU General Public License as published by
   8  * the Free Software Foundation; either version 2 of the License, or
   9  * (at your option) any later version.
  10  *
  11  * Frotz is distributed in the hope that it will be useful,
  12  * but WITHOUT ANY WARRANTY; without even the implied warranty of
  13  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14  * GNU General Public License for more details.
  15  *
  16  * You should have received a copy of the GNU General Public License
  17  * along with this program; if not, write to the Free Software
  18  * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA
  19  */
  20
  21 #include "frotz.h"
  22
  23 #define MAX_OBJECT 2000
  24
  25 #define O1_PARENT 4
  26 #define O1_SIBLING 5
  27 #define O1_CHILD 6
  28 #define O1_PROPERTY_OFFSET 7
  29 #define O1_SIZE 9
  30
  31 #define O4_PARENT 6
  32 #define O4_SIBLING 8
  33 #define O4_CHILD 10
  34 #define O4_PROPERTY_OFFSET 12
  35 #define O4_SIZE 14
  36
  37 /*
  38  * object_address
  39  *
  40  * Calculate the address of an object.
  41  *
  42  */
  43
  44 static zword object_address (zword obj)
  45 {
  46 /*    zchar obj_num[10]; */
  47
  48     /* Check object number */
  49
  50     if (obj > ((h_version <= V3) ? 255 : MAX_OBJECT)) {
  51         print_string("@Attempt to address illegal object ");
  52         print_num(obj);
  53         print_string(".  This is normally fatal.");
  54         new_line();
  55         runtime_error (ERR_ILL_OBJ);
  56     }
  57
  58     /* Return object address */
  59
  60     if (h_version <= V3)
  61         return h_objects + ((obj - 1) * O1_SIZE + 62);
  62     else
  63         return h_objects + ((obj - 1) * O4_SIZE + 126);
  64
  65 }/* object_address */
  66
  67 /*
  68  * object_name
  69  *
  70  * Return the address of the given object's name.
  71  *
  72  */
  73
  74 zword object_name (zword object)
  75 {
  76     zword obj_addr;
  77     zword name_addr;
  78
  79     obj_addr = object_address (object);
  80
  81     /* The object name address is found at the start of the properties */
  82
  83     if (h_version <= V3)
  84         obj_addr += O1_PROPERTY_OFFSET;
  85     else
  86         obj_addr += O4_PROPERTY_OFFSET;
  87
  88     LOW_WORD (obj_addr, name_addr)
  89
  90     return name_addr;
  91
  92 }/* object_name */
  93
  94 /*
  95  * first_property
  96  *
  97  * Calculate the start address of the property list associated with
  98  * an object.
  99  *
 100  */
 101
 102 static zword first_property (zword obj)
 103 {
 104     zword prop_addr;
 105     zbyte size;
 106
 107     /* Fetch address of object name */
 108
 109     prop_addr = object_name (obj);
 110
 111     /* Get length of object name */
 112
 113     LOW_BYTE (prop_addr, size)
 114
 115     /* Add name length to pointer */
 116
 117     return prop_addr + 1 + 2 * size;
 118
 119 }/* first_property */
 120
 121 /*
 122  * next_property
 123  *
 124  * Calculate the address of the next property in a property list.
 125  *
 126  */
 127
 128 static zword next_property (zword prop_addr)
 129 {
 130     zbyte value;
 131
 132     /* Load the current property id */
 133
 134     LOW_BYTE (prop_addr, value)
 135     prop_addr++;
 136
 137     /* Calculate the length of this property */
 138
 139     if (h_version <= V3)
 140         value >>= 5;
 141     else if (!(value & 0x80))
 142         value >>= 6;
 143     else {
 144
 145         LOW_BYTE (prop_addr, value)
 146         value &= 0x3f;
 147
 148         if (value == 0) value = 64;        /* demanded by Spec 1.0 */
 149
 150     }
 151
 152     /* Add property length to current property pointer */
 153
 154     return prop_addr + value + 1;
 155
 156 }/* next_property */
 157
 158 /*
 159  * unlink_object
 160  *
 161  * Unlink an object from its parent and siblings.
 162  *
 163  */
 164
 165 static void unlink_object (zword object)
 166 {
 167     zword obj_addr;
 168     zword parent_addr;
 169     zword sibling_addr;
 170
 171     if (object == 0) {
 172         runtime_error (ERR_REMOVE_OBJECT_0);
 173         return;
 174     }
 175
 176     obj_addr = object_address (object);
 177
 178     if (h_version <= V3) {
 179
 180         zbyte parent;
 181         zbyte younger_sibling;
 182         zbyte older_sibling;
 183         zbyte zero = 0;
 184
 185         /* Get parent of object, and return if no parent */
 186
 187         obj_addr += O1_PARENT;
 188         LOW_BYTE (obj_addr, parent)
 189         if (!parent)
 190             return;
 191
 192         /* Get (older) sibling of object and set both parent and sibling
 193            pointers to 0 */
 194
 195         SET_BYTE (obj_addr, zero)
 196         obj_addr += O1_SIBLING - O1_PARENT;
 197         LOW_BYTE (obj_addr, older_sibling)
 198         SET_BYTE (obj_addr, zero)
 199
 200         /* Get first child of parent (the youngest sibling of the object) */
 201
 202         parent_addr = object_address (parent) + O1_CHILD;
 203         LOW_BYTE (parent_addr, younger_sibling)
 204
 205         /* Remove object from the list of siblings */
 206
 207         if (younger_sibling == object)
 208             SET_BYTE (parent_addr, older_sibling)
 209         else {
 210             do {
 211                 sibling_addr = object_address (younger_sibling) + O1_SIBLING;
 212                 LOW_BYTE (sibling_addr, younger_sibling)
 213             } while (younger_sibling != object);
 214             SET_BYTE (sibling_addr, older_sibling)
 215         }
 216
 217     } else {
 218
 219         zword parent;
 220         zword younger_sibling;
 221         zword older_sibling;
 222         zword zero = 0;
 223
 224         /* Get parent of object, and return if no parent */
 225
 226         obj_addr += O4_PARENT;
 227         LOW_WORD (obj_addr, parent)
 228         if (!parent)
 229             return;
 230
 231         /* Get (older) sibling of object and set both parent and sibling
 232            pointers to 0 */
 233
 234         SET_WORD (obj_addr, zero)
 235         obj_addr += O4_SIBLING - O4_PARENT;
 236         LOW_WORD (obj_addr, older_sibling)
 237         SET_WORD (obj_addr, zero)
 238
 239         /* Get first child of parent (the youngest sibling of the object) */
 240
 241         parent_addr = object_address (parent) + O4_CHILD;
 242         LOW_WORD (parent_addr, younger_sibling)
 243
 244         /* Remove object from the list of siblings */
 245
 246         if (younger_sibling == object)
 247             SET_WORD (parent_addr, older_sibling)
 248         else {
 249             do {
 250                 sibling_addr = object_address (younger_sibling) + O4_SIBLING;
 251                 LOW_WORD (sibling_addr, younger_sibling)
 252             } while (younger_sibling != object);
 253             SET_WORD (sibling_addr, older_sibling)
 254         }
 255
 256     }
 257
 258 }/* unlink_object */
 259
 260 /*
 261  * z_clear_attr, clear an object attribute.
 262  *
 263  *        zargs[0] = object
 264  *        zargs[1] = number of attribute to be cleared
 265  *
 266  */
 267
 268 void z_clear_attr (void)
 269 {
 270     zword obj_addr;
 271     zbyte value;
 272
 273     if (story_id == SHERLOCK)
 274         if (zargs[1] == 48)
 275             return;
 276
 277     if (zargs[1] > ((h_version <= V3) ? 31 : 47))
 278         runtime_error (ERR_ILL_ATTR);
 279
 280     /* If we are monitoring attribute assignment display a short note */
 281
 282     if (f_setup.attribute_assignment) {
 283         stream_mssg_on ();
 284         print_string ("@clear_attr ");
 285         print_object (zargs[0]);
 286         print_string (" ");
 287         print_num (zargs[1]);
 288         stream_mssg_off ();
 289     }
 290
 291     if (zargs[0] == 0) {
 292         runtime_error (ERR_CLEAR_ATTR_0);
 293         return;
 294     }
 295
 296     /* Get attribute address */
 297
 298     obj_addr = object_address (zargs[0]) + zargs[1] / 8;
 299
 300     /* Clear attribute bit */
 301
 302     LOW_BYTE (obj_addr, value)
 303     value &= ~(0x80 >> (zargs[1] & 7));
 304     SET_BYTE (obj_addr, value)
 305
 306 }/* z_clear_attr */
 307
 308 /*
 309  * z_jin, branch if the first object is inside the second.
 310  *
 311  *        zargs[0] = first object
 312  *        zargs[1] = second object
 313  *
 314  */
 315
 316 void z_jin (void)
 317 {
 318     zword obj_addr;
 319
 320     /* If we are monitoring object locating display a short note */
 321
 322     if (f_setup.object_locating) {
 323         stream_mssg_on ();
 324         print_string ("@jin ");
 325         print_object (zargs[0]);
 326         print_string (" ");
 327         print_object (zargs[1]);
 328         stream_mssg_off ();
 329     }
 330
 331     if (zargs[0] == 0) {
 332         runtime_error (ERR_JIN_0);
 333         branch (0 == zargs[1]);
 334         return;
 335     }
 336
 337     obj_addr = object_address (zargs[0]);
 338
 339     if (h_version <= V3) {
 340
 341         zbyte parent;
 342
 343         /* Get parent id from object */
 344
 345         obj_addr += O1_PARENT;
 346         LOW_BYTE (obj_addr, parent)
 347
 348         /* Branch if the parent is obj2 */
 349
 350         branch (parent == zargs[1]);
 351
 352     } else {
 353
 354         zword parent;
 355
 356         /* Get parent id from object */
 357
 358         obj_addr += O4_PARENT;
 359         LOW_WORD (obj_addr, parent)
 360
 361         /* Branch if the parent is obj2 */
 362
 363         branch (parent == zargs[1]);
 364
 365     }
 366
 367 }/* z_jin */
 368
 369 /*
 370  * z_get_child, store the child of an object.
 371  *
 372  *        zargs[0] = object
 373  *
 374  */
 375
 376 void z_get_child (void)
 377 {
 378     zword obj_addr;
 379
 380     /* If we are monitoring object locating display a short note */
 381
 382     if (f_setup.object_locating) {
 383         stream_mssg_on ();
 384         print_string ("@get_child ");
 385         print_object (zargs[0]);
 386         stream_mssg_off ();
 387     }
 388
 389     if (zargs[0] == 0) {
 390         runtime_error (ERR_GET_CHILD_0);
 391         store (0);
 392         branch (FALSE);
 393         return;
 394     }
 395
 396     obj_addr = object_address (zargs[0]);
 397
 398     if (h_version <= V3) {
 399
 400         zbyte child;
 401
 402         /* Get child id from object */
 403
 404         obj_addr += O1_CHILD;
 405         LOW_BYTE (obj_addr, child)
 406
 407         /* Store child id and branch */
 408
 409         store (child);
 410         branch (child);
 411
 412     } else {
 413
 414         zword child;
 415
 416         /* Get child id from object */
 417
 418         obj_addr += O4_CHILD;
 419         LOW_WORD (obj_addr, child)
 420
 421         /* Store child id and branch */
 422
 423         store (child);
 424         branch (child);
 425
 426     }
 427
 428 }/* z_get_child */
 429
 430 /*
 431  * z_get_next_prop, store the number of the first or next property.
 432  *
 433  *        zargs[0] = object
 434  *        zargs[1] = address of current property (0 gets the first property)
 435  *
 436  */
 437
 438 void z_get_next_prop (void)
 439 {
 440     zword prop_addr;
 441     zbyte value;
 442     zbyte mask;
 443
 444     if (zargs[0] == 0) {
 445         runtime_error (ERR_GET_NEXT_PROP_0);
 446         store (0);
 447         return;
 448     }
 449
 450     /* Property id is in bottom five (six) bits */
 451
 452     mask = (h_version <= V3) ? 0x1f : 0x3f;
 453
 454     /* Load address of first property */
 455
 456     prop_addr = first_property (zargs[0]);
 457
 458     if (zargs[1] != 0) {
 459
 460         /* Scan down the property list */
 461
 462         do {
 463             LOW_BYTE (prop_addr, value)
 464             prop_addr = next_property (prop_addr);
 465         } while ((value & mask) > zargs[1]);
 466
 467         /* Exit if the property does not exist */
 468
 469         if ((value & mask) != zargs[1])
 470             runtime_error (ERR_NO_PROP);
 471
 472     }
 473
 474     /* Return the property id */
 475
 476     LOW_BYTE (prop_addr, value)
 477     store ((zword) (value & mask));
 478
 479 }/* z_get_next_prop */
 480
 481 /*
 482  * z_get_parent, store the parent of an object.
 483  *
 484  *        zargs[0] = object
 485  *
 486  */
 487
 488 void z_get_parent (void)
 489 {
 490     zword obj_addr;
 491
 492     /* If we are monitoring object locating display a short note */
 493
 494     if (f_setup.object_locating) {
 495         stream_mssg_on ();
 496         print_string ("@get_parent ");
 497         print_object (zargs[0]);
 498         stream_mssg_off ();
 499     }
 500
 501     if (zargs[0] == 0) {
 502         runtime_error (ERR_GET_PARENT_0);
 503         store (0);
 504         return;
 505     }
 506
 507     obj_addr = object_address (zargs[0]);
 508
 509     if (h_version <= V3) {
 510
 511         zbyte parent;
 512
 513         /* Get parent id from object */
 514
 515         obj_addr += O1_PARENT;
 516         LOW_BYTE (obj_addr, parent)
 517
 518         /* Store parent */
 519
 520         store (parent);
 521
 522     } else {
 523
 524         zword parent;
 525
 526         /* Get parent id from object */
 527
 528         obj_addr += O4_PARENT;
 529         LOW_WORD (obj_addr, parent)
 530
 531         /* Store parent */
 532
 533         store (parent);
 534
 535     }
 536
 537 }/* z_get_parent */
 538
 539 /*
 540  * z_get_prop, store the value of an object property.
 541  *
 542  *        zargs[0] = object
 543  *        zargs[1] = number of property to be examined
 544  *
 545  */
 546
 547 void z_get_prop (void)
 548 {
 549     zword prop_addr;
 550     zword wprop_val;
 551     zbyte bprop_val;
 552     zbyte value;
 553     zbyte mask;
 554
 555     if (zargs[0] == 0) {
 556         runtime_error (ERR_GET_PROP_0);
 557         store (0);
 558         return;
 559     }
 560
 561     /* Property id is in bottom five (six) bits */
 562
 563     mask = (h_version <= V3) ? 0x1f : 0x3f;
 564
 565     /* Load address of first property */
 566
 567     prop_addr = first_property (zargs[0]);
 568
 569     /* Scan down the property list */
 570
 571     for (;;) {
 572         LOW_BYTE (prop_addr, value)
 573         if ((value & mask) <= zargs[1])
 574             break;
 575         prop_addr = next_property (prop_addr);
 576     }
 577
 578     if ((value & mask) == zargs[1]) {        /* property found */
 579
 580         /* Load property (byte or word sized) */
 581
 582         prop_addr++;
 583
 584         if ((h_version <= V3 && !(value & 0xe0)) || (h_version >= V4 && !(value & 0xc0))) {
 585
 586             LOW_BYTE (prop_addr, bprop_val)
 587             wprop_val = bprop_val;
 588
 589         } else LOW_WORD (prop_addr, wprop_val)
 590
 591     } else {        /* property not found */
 592
 593         /* Load default value */
 594
 595         prop_addr = h_objects + 2 * (zargs[1] - 1);
 596         LOW_WORD (prop_addr, wprop_val)
 597
 598     }
 599
 600     /* Store the property value */
 601
 602     store (wprop_val);
 603
 604 }/* z_get_prop */
 605
 606 /*
 607  * z_get_prop_addr, store the address of an object property.
 608  *
 609  *        zargs[0] = object
 610  *        zargs[1] = number of property to be examined
 611  *
 612  */
 613
 614 void z_get_prop_addr (void)
 615 {
 616     zword prop_addr;
 617     zbyte value;
 618     zbyte mask;
 619
 620     if (zargs[0] == 0) {
 621         runtime_error (ERR_GET_PROP_ADDR_0);
 622         store (0);
 623         return;
 624     }
 625
 626     if (story_id == BEYOND_ZORK)
 627         if (zargs[0] > MAX_OBJECT)
 628             { store (0); return; }
 629
 630     /* Property id is in bottom five (six) bits */
 631
 632     mask = (h_version <= V3) ? 0x1f : 0x3f;
 633
 634     /* Load address of first property */
 635
 636     prop_addr = first_property (zargs[0]);
 637
 638     /* Scan down the property list */
 639
 640     for (;;) {
 641         LOW_BYTE (prop_addr, value)
 642         if ((value & mask) <= zargs[1])
 643             break;
 644         prop_addr = next_property (prop_addr);
 645     }
 646
 647     /* Calculate the property address or return zero */
 648
 649     if ((value & mask) == zargs[1]) {
 650
 651         if (h_version >= V4 && (value & 0x80))
 652             prop_addr++;
 653         store ((zword) (prop_addr + 1));
 654
 655     } else store (0);
 656
 657 }/* z_get_prop_addr */
 658
 659 /*
 660  * z_get_prop_len, store the length of an object property.
 661  *
 662  *         zargs[0] = address of property to be examined
 663  *
 664  */
 665
 666 void z_get_prop_len (void)
 667 {
 668     zword addr;
 669     zbyte value;
 670
 671     /* Back up the property pointer to the property id */
 672
 673     addr = zargs[0] - 1;
 674     LOW_BYTE (addr, value)
 675
 676     /* Calculate length of property */
 677
 678     if (h_version <= V3)
 679         value = (value >> 5) + 1;
 680     else if (!(value & 0x80))
 681         value = (value >> 6) + 1;
 682     else {
 683
 684         value &= 0x3f;
 685
 686         if (value == 0) value = 64;        /* demanded by Spec 1.0 */
 687
 688     }
 689
 690     /* Store length of property */
 691
 692     store (value);
 693
 694 }/* z_get_prop_len */
 695
 696 /*
 697  * z_get_sibling, store the sibling of an object.
 698  *
 699  *        zargs[0] = object
 700  *
 701  */
 702
 703 void z_get_sibling (void)
 704 {
 705     zword obj_addr;
 706
 707     if (zargs[0] == 0) {
 708         runtime_error (ERR_GET_SIBLING_0);
 709         store (0);
 710         branch (FALSE);
 711         return;
 712     }
 713
 714     obj_addr = object_address (zargs[0]);
 715
 716     if (h_version <= V3) {
 717
 718         zbyte sibling;
 719
 720         /* Get sibling id from object */
 721
 722         obj_addr += O1_SIBLING;
 723         LOW_BYTE (obj_addr, sibling)
 724
 725         /* Store sibling and branch */
 726
 727         store (sibling);
 728         branch (sibling);
 729
 730     } else {
 731
 732         zword sibling;
 733
 734         /* Get sibling id from object */
 735
 736         obj_addr += O4_SIBLING;
 737         LOW_WORD (obj_addr, sibling)
 738
 739         /* Store sibling and branch */
 740
 741         store (sibling);
 742         branch (sibling);
 743
 744     }
 745
 746 }/* z_get_sibling */
 747
 748 /*
 749  * z_insert_obj, make an object the first child of another object.
 750  *
 751  *        zargs[0] = object to be moved
 752  *        zargs[1] = destination object
 753  *
 754  */
 755
 756 void z_insert_obj (void)
 757 {
 758     zword obj1 = zargs[0];
 759     zword obj2 = zargs[1];
 760     zword obj1_addr;
 761     zword obj2_addr;
 762
 763     /* If we are monitoring object movements display a short note */
 764
 765     if (f_setup.object_movement) {
 766         stream_mssg_on ();
 767         print_string ("@move_obj ");
 768         print_object (obj1);
 769         print_string (" ");
 770         print_object (obj2);
 771         stream_mssg_off ();
 772     }
 773
 774     if (obj1 == 0) {
 775         runtime_error (ERR_MOVE_OBJECT_0);
 776         return;
 777     }
 778
 779     if (obj2 == 0) {
 780         runtime_error (ERR_MOVE_OBJECT_TO_0);
 781         return;
 782     }
 783
 784     /* Get addresses of both objects */
 785
 786     obj1_addr = object_address (obj1);
 787     obj2_addr = object_address (obj2);
 788
 789     /* Remove object 1 from current parent */
 790
 791     unlink_object (obj1);
 792
 793     /* Make object 1 first child of object 2 */
 794
 795     if (h_version <= V3) {
 796
 797         zbyte child;
 798
 799         obj1_addr += O1_PARENT;
 800         SET_BYTE (obj1_addr, obj2)
 801         obj2_addr += O1_CHILD;
 802         LOW_BYTE (obj2_addr, child)
 803         SET_BYTE (obj2_addr, obj1)
 804         obj1_addr += O1_SIBLING - O1_PARENT;
 805         SET_BYTE (obj1_addr, child)
 806
 807     } else {
 808
 809         zword child;
 810
 811         obj1_addr += O4_PARENT;
 812         SET_WORD (obj1_addr, obj2)
 813         obj2_addr += O4_CHILD;
 814         LOW_WORD (obj2_addr, child)
 815         SET_WORD (obj2_addr, obj1)
 816         obj1_addr += O4_SIBLING - O4_PARENT;
 817         SET_WORD (obj1_addr, child)
 818
 819     }
 820
 821 }/* z_insert_obj */
 822
 823 /*
 824  * z_put_prop, set the value of an object property.
 825  *
 826  *        zargs[0] = object
 827  *        zargs[1] = number of property to set
 828  *        zargs[2] = value to set property to
 829  *
 830  */
 831
 832 void z_put_prop (void)
 833 {
 834     zword prop_addr;
 835     zword value;
 836     zbyte mask;
 837
 838     if (zargs[0] == 0) {
 839         runtime_error (ERR_PUT_PROP_0);
 840         return;
 841     }
 842
 843     /* Property id is in bottom five or six bits */
 844
 845     mask = (h_version <= V3) ? 0x1f : 0x3f;
 846
 847     /* Load address of first property */
 848
 849     prop_addr = first_property (zargs[0]);
 850
 851     /* Scan down the property list */
 852
 853     for (;;) {
 854         LOW_BYTE (prop_addr, value)
 855         if ((value & mask) <= zargs[1])
 856             break;
 857         prop_addr = next_property (prop_addr);
 858     }
 859
 860     /* Exit if the property does not exist */
 861
 862     if ((value & mask) != zargs[1])
 863         runtime_error (ERR_NO_PROP);
 864
 865     /* Store the new property value (byte or word sized) */
 866
 867     prop_addr++;
 868
 869     if ((h_version <= V3 && !(value & 0xe0)) || (h_version >= V4 && !(value & 0xc0))) {
 870         zbyte v = zargs[2];
 871         SET_BYTE (prop_addr, v)
 872     } else {
 873         zword v = zargs[2];
 874         SET_WORD (prop_addr, v)
 875     }
 876
 877 }/* z_put_prop */
 878
 879 /*
 880  * z_remove_obj, unlink an object from its parent and siblings.
 881  *
 882  *        zargs[0] = object
 883  *
 884  */
 885
 886 void z_remove_obj (void)
 887 {
 888
 889     /* If we are monitoring object movements display a short note */
 890
 891     if (f_setup.object_movement) {
 892         stream_mssg_on ();
 893         print_string ("@remove_obj ");
 894         print_object (zargs[0]);
 895         stream_mssg_off ();
 896     }
 897
 898     /* Call unlink_object to do the job */
 899
 900     unlink_object (zargs[0]);
 901
 902 }/* z_remove_obj */
 903
 904 /*
 905  * z_set_attr, set an object attribute.
 906  *
 907  *        zargs[0] = object
 908  *        zargs[1] = number of attribute to set
 909  *
 910  */
 911
 912 void z_set_attr (void)
 913 {
 914     zword obj_addr;
 915     zbyte value;
 916
 917     if (story_id == SHERLOCK)
 918         if (zargs[1] == 48)
 919             return;
 920
 921     if (zargs[1] > ((h_version <= V3) ? 31 : 47))
 922         runtime_error (ERR_ILL_ATTR);
 923
 924     /* If we are monitoring attribute assignment display a short note */
 925
 926     if (f_setup.attribute_assignment) {
 927         stream_mssg_on ();
 928         print_string ("@set_attr ");
 929         print_object (zargs[0]);
 930         print_string (" ");
 931         print_num (zargs[1]);
 932         stream_mssg_off ();
 933     }
 934
 935     if (zargs[0] == 0) {
 936         runtime_error (ERR_SET_ATTR_0);
 937         return;
 938     }
 939
 940     /* Get attribute address */
 941
 942     obj_addr = object_address (zargs[0]) + zargs[1] / 8;
 943
 944     /* Load attribute byte */
 945
 946     LOW_BYTE (obj_addr, value)
 947
 948     /* Set attribute bit */
 949
 950     value |= 0x80 >> (zargs[1] & 7);
 951
 952     /* Store attribute byte */
 953
 954     SET_BYTE (obj_addr, value)
 955
 956 }/* z_set_attr */
 957
 958 /*
 959  * z_test_attr, branch if an object attribute is set.
 960  *
 961  *        zargs[0] = object
 962  *        zargs[1] = number of attribute to test
 963  *
 964  */
 965
 966 void z_test_attr (void)
 967 {
 968     zword obj_addr;
 969     zbyte value;
 970
 971     if (zargs[1] > ((h_version <= V3) ? 31 : 47))
 972         runtime_error (ERR_ILL_ATTR);
 973
 974     /* If we are monitoring attribute testing display a short note */
 975
 976     if (f_setup.attribute_testing) {
 977         stream_mssg_on ();
 978         print_string ("@test_attr ");
 979         print_object (zargs[0]);
 980         print_string (" ");
 981         print_num (zargs[1]);
 982         stream_mssg_off ();
 983     }
 984
 985     if (zargs[0] == 0) {
 986         runtime_error (ERR_TEST_ATTR_0);
 987         branch (FALSE);
 988         return;
 989     }
 990
 991     /* Get attribute address */
 992
 993     obj_addr = object_address (zargs[0]) + zargs[1] / 8;
 994
 995     /* Load attribute byte */
 996
 997     LOW_BYTE (obj_addr, value)
 998
 999     /* Test attribute */
1000
1001     branch (value & (0x80 >> (zargs[1] & 7)));
1002
1003 }/* z_test_attr */