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