1 /* Nitfol - z-machine interpreter using Glk for output.
2 Copyright (C) 1999 Evin Robertson
4 This program is free software; you can redistribute it and/or modify
5 it under the terms of the GNU General Public License as published by
6 the Free Software Foundation; either version 2 of the License, or
7 (at your option) any later version.
9 This program is distributed in the hope that it will be useful,
10 but WITHOUT ANY WARRANTY; without even the implied warranty of
11 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12 GNU General Public License for more details.
14 You should have received a copy of the GNU General Public License
15 along with this program; if not, write to the Free Software
16 Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111, USA.
18 The author can be reached at nitfol@deja.com
22 /* attribute/8 will be the byte offset into the object entry for attribute */
23 #define ATTRIBUTE(n, a) z_memory[z_objecttable + n * OBJSIZE + a / 8]
25 #define OBJ_ADDR(n) (z_objecttable + (n) * OBJSIZE)
27 #define PARENTP(n) (OBJ_ADDR(n) + oPARENT)
28 #define SIBLINGP(n) (OBJ_ADDR(n) + oSIBLING)
29 #define CHILDP(n) (OBJ_ADDR(n) + oCHILD)
30 #define PROPSP(n) (OBJ_ADDR(n) + oPROPS)
32 #define PARENT(n) LOWO(PARENTP(n))
33 #define SIBLING(n) LOWO(SIBLINGP(n))
34 #define CHILD(n) LOWO(CHILDP(n))
35 #define PROPS(n) LOWORD(PROPSP(n))
39 static zword oPARENT, oSIBLING, oCHILD, oPROPS;
40 static zword PROP_NUM_MASK, ATTR_COUNT;
42 static BOOL object_property_loop(zword object, zword *propnum,
43 zword *location, zword *len);
53 void LOWOcopy(zword a, zword b)
62 void LOWOwrite(zword p, zword n)
73 #define check_obj_valid(obj) TRUE
74 #define check_attr_valid(attr) TRUE
76 static BOOL check_obj_valid(zword object)
78 if(object > object_count) { /* Object past the first property table entry */
79 if(object > maxobjs) { /* Object past the end of dynamic memory */
80 n_show_error(E_OBJECT, "object number too large", object);
83 n_show_warn(E_OBJECT, "object number probably too large", object);
86 n_show_error(E_OBJECT, "vile object 0 error from hell", object);
92 static BOOL check_attr_valid(zword attr)
94 if(attr > ATTR_COUNT) {
95 n_show_error(E_OBJECT, "attempt to access illegal attribute", attr);
104 void objects_init(void)
114 PROP_NUM_MASK = 0x3f;
122 PROP_NUM_MASK = 0x1f;
126 /* Address of objects; we want this to be one before the first object
127 because there's no object 0 */
128 z_objecttable = z_propdefaults + PROP_NUM_MASK * ZWORD_SIZE - OBJSIZE;
129 maxobjs = (dynamic_size - z_objecttable) / OBJSIZE;
131 obj_first_prop_addr = ZWORD_MASK;
132 obj_last_prop_addr = 0;
134 prop_table_start = ZWORD_MASK;
137 /* Count objects in tree, assuming objects end where proptables begin */
138 for(object = 1; OBJ_ADDR(object) < prop_table_start; object++) {
139 zword propnum, location, len;
141 if(PROPS(object) < prop_table_start)
142 prop_table_start = PROPS(object);
145 while(object_property_loop(object, &propnum, &location, &len)) {
146 if(location < obj_first_prop_addr)
147 obj_first_prop_addr = location;
148 if(location > obj_last_prop_addr)
149 obj_last_prop_addr = location;
151 if(location + len > prop_table_end)
152 prop_table_end = location + len;
156 object_count = object - 1;
158 if(object_count > maxobjs)
159 object_count = maxobjs;
165 void op_get_child(void)
168 if(!check_obj_valid(operand[0])) {
174 debug_object(operand[0], OBJ_GET_INFO);
176 child = CHILD(operand[0]);
177 mop_store_result(child);
178 mop_cond_branch(child != 0);
182 void op_get_parent(void)
185 if(!check_obj_valid(operand[0])) {
190 debug_object(operand[0], OBJ_GET_INFO);
192 parent = PARENT(operand[0]);
193 mop_store_result(parent);
197 void op_get_sibling(void)
200 if(!check_obj_valid(operand[0])) {
206 debug_object(operand[0], OBJ_GET_INFO);
208 sibling = SIBLING(operand[0]);
209 mop_store_result(sibling);
210 mop_cond_branch(sibling != 0);
215 void op_insert_obj(void)
217 zword object = operand[0], dest = operand[1];
219 if(!check_obj_valid(object) || !check_obj_valid(dest))
224 zword child = object;
228 n_show_error(E_OBJECT, "attempt to place an object inside itself", object);
231 child = CHILD(child);
233 if(depth > maxobjs) {
234 n_show_error(E_OBJECT, "found objects inside themselves", child);
242 op_remove_obj(); /* Remove object operand[0] from object tree */
244 debug_object(operand[1], OBJ_RECEIVE);
246 LOWOwrite(PARENTP(object), dest);
247 LOWOcopy(SIBLINGP(object), CHILDP(dest));
248 LOWOwrite(CHILDP(dest), object);
254 if(!check_obj_valid(operand[0])) {
259 debug_object(operand[0], OBJ_GET_INFO);
260 debug_object(operand[1], OBJ_GET_INFO);
262 mop_cond_branch(PARENT(operand[0]) == operand[1]);
266 void op_remove_obj(void)
268 zword parent, sibling, nextsibling;
269 zword object = operand[0];
271 if(!check_obj_valid(object))
273 parent = PARENT(object);
275 if(!parent) /* If no parent, do nothing with no error message */
277 if(!check_obj_valid(parent))
280 debug_object(operand[0], OBJ_MOVE);
282 nextsibling = CHILD(parent);
284 if(nextsibling == object) { /* if it's the first child */
285 LOWOcopy(CHILDP(parent), SIBLINGP(object));
288 do { /* Loops until the SIBLING(sibling)==object so we can skip over it */
289 sibling = nextsibling;
291 if(!check_obj_valid(sibling))
294 nextsibling = SIBLING(sibling);
297 if(width++ > maxobjs) { /* If we've looped more times than reasonable */
298 n_show_error(E_OBJECT, "looped sibling list", parent);
302 } while(nextsibling != object);
304 LOWOcopy(SIBLINGP(sibling), SIBLINGP(object));/*make the list skip object*/
307 LOWOwrite(PARENTP(object), 0);
308 LOWOwrite(SIBLINGP(object), 0);
311 offset object_name(zword object)
313 if(LOBYTE(PROPS(object)))
314 return PROPS(object) + 1;
320 void op_print_obj(void)
322 offset short_name_off = object_name(operand[0]);
324 decodezscii(short_name_off, output_char);
326 n_show_error(E_OBJECT, "attempt to print name of nameless object", operand[0]);
330 /* attribute opcodes: */
332 void op_clear_attr(void)
334 if(!check_obj_valid(operand[0]) || !check_attr_valid(operand[1]))
336 debug_attrib(operand[1], operand[0]);
338 ATTRIBUTE(operand[0], operand[1]) &= ~(b10000000 >> (operand[1] & b0111));
339 /* shift top bit right to select the appropriate bit and make
340 a mask from the complement */
344 void op_set_attr(void)
346 if(!check_obj_valid(operand[0]) || !check_attr_valid(operand[1]))
348 debug_attrib(operand[1], operand[0]);
349 /* select the bit to be set */
350 ATTRIBUTE(operand[0], operand[1]) |= (b10000000 >> (operand[1] & b0111));
354 void op_test_attr(void)
356 if(!check_obj_valid(operand[0]) || !check_attr_valid(operand[1])) {
360 debug_attrib(operand[1], operand[0]);
361 /* select the bit to be tested */
362 if(ATTRIBUTE(operand[0], operand[1]) & (b10000000 >> (operand[1] & b0111)))
369 /* property table opcodes: */
371 /* Helper functions */
374 * Given the location of the sizebyte, returns the length of the following
375 * property and sets *size_length to the size of the sizebyte
377 static zword get_prop_length(zword propoffset, int *size_length)
381 zbyte size_byte = LOBYTE(propoffset);
383 if(size_byte & b10000000) { /* top bit set means two bytes of size info */
385 prop_length = LOBYTE(propoffset + 1) & b00111111;
388 } else { /* one byte of size info */
390 if(size_byte & b01000000)
396 prop_length = (size_byte >> 5) + 1;
404 * Loops over all properties of an object, returning FALSE if no more
405 * Before first call, set *location = 0;
407 static BOOL object_property_loop(zword object, zword *propnum,
408 zword *location, zword *len)
411 int size_byte, size_length;
414 *location = proptable = PROPS(object);
415 *len = LOBYTE(proptable) * 2 + 1; /* skip the header */
418 proptable = *location;
421 size_byte = LOBYTE(proptable);
422 *propnum = size_byte & PROP_NUM_MASK;
424 *len = get_prop_length(proptable, &size_length);
425 proptable += size_length;
427 *location = proptable;
435 static zword get_prop_offset(zword object, zword property, zword *length)
437 zword propnum, location;
439 while(object_property_loop(object, &propnum, &location, length)) {
440 if(propnum == property)
447 void op_get_next_prop(void)
453 if(!check_obj_valid(operand[0])) {
458 if(operand[1] == 0) {
459 if(object_property_loop(operand[0], &prop_num, &proptable, &prop_len))
460 mop_store_result(prop_num);
466 while(object_property_loop(operand[0], &prop_num, &proptable, &prop_len)) {
467 if(prop_num == operand[1]) {
468 if(object_property_loop(operand[0], &prop_num, &proptable, &prop_len))
469 mop_store_result(prop_num);
476 n_show_error(E_OBJECT, "get_next_prop on nonexistent property", operand[1]);
482 void op_get_prop_addr(void)
486 if(!check_obj_valid(operand[0])) {
491 proptable = get_prop_offset(operand[0], operand[1], &prop_len);
493 mop_store_result(proptable);
497 void op_get_prop_len(void)
503 if(operand[0] < obj_first_prop_addr ||
504 operand[0] > obj_last_prop_addr) {
505 if(operand[0] < 64) {
506 n_show_error(E_OBJECT, "get property length in header", operand[0]);
510 n_show_warn(E_OBJECT, "get property length at probably bad address", operand[0]);
514 operand[0]--; /* Skip back a byte for the size byte */
517 if(LOBYTE(operand[0]) & 0x80) { /* test top bit - two bytes of size info */
518 operand[0]--; /* Skip back another byte */
521 prop_length = get_prop_length(operand[0], &size_length);
523 mop_store_result(prop_length);
527 void op_get_prop(void)
531 if(!check_obj_valid(operand[0])) {
536 proptable = get_prop_offset(operand[0], operand[1], &prop_length);
538 if(proptable == 0) { /* property not provided; use property default */
539 mop_store_result(LOWORD(z_propdefaults + (operand[1]-1) * ZWORD_SIZE));
543 switch(prop_length) {
545 mop_store_result(LOBYTE(proptable)); break;
548 n_show_port(E_OBJECT, "get_prop on property with bad length", operand[1]);
551 mop_store_result(LOWORD(proptable));
556 void op_put_prop(void)
560 if(!check_obj_valid(operand[0])) {
565 proptable = get_prop_offset(operand[0], operand[1], &prop_length);
569 n_show_error(E_OBJECT, "attempt to write to nonexistent property", operand[1]);
574 switch(prop_length) {
576 LOBYTEwrite(proptable, operand[2]); break;
579 n_show_port(E_OBJECT, "put_prop on property with bad length", operand[1]);
582 LOWORDwrite(proptable, operand[2]); break;
591 BOOL infix_property_loop(zword object, zword *propnum, zword *location, zword *len, zword *nonindivloc, zword *nonindivlen)
595 if(*location && *propnum > PROP_NUM_MASK) {
597 *propnum = LOWORD(*location);
598 *location += ZWORD_SIZE;
599 *len = LOBYTE(*location);
606 *location = *nonindivloc;
612 status = object_property_loop(object, propnum, location, len);
616 if(*propnum == 3) { /* Individual property table */
617 zword iproptable = LOWORD(*location);
620 *propnum = LOWORD(iproptable);
621 iproptable += ZWORD_SIZE;
622 ilen = LOBYTE(iproptable);
625 return infix_property_loop(object, propnum, location, len, nonindivloc, nonindivlen);
627 *nonindivloc = *location;
629 *location = iproptable;
637 void infix_move(zword dest, zword object)
639 zword to1 = operand[0], to2 = operand[1];
640 operand[0] = object; operand[1] = dest;
642 operand[0] = to1; operand[1] = to2;
645 void infix_remove(zword object)
647 zword to1 = operand[0];
653 zword infix_parent(zword object)
655 return PARENT(object);
658 zword infix_child(zword object)
660 return CHILD(object);
663 zword infix_sibling(zword object)
665 return SIBLING(object);
668 void infix_set_attrib(zword object, zword attrib)
670 zword to1 = operand[0], to2 = operand[1];
671 operand[0] = object; operand[1] = attrib;
673 operand[0] = to1; operand[1] = to2;
676 void infix_clear_attrib(zword object, zword attrib)
678 zword to1 = operand[0], to2 = operand[1];
679 operand[0] = object; operand[1] = attrib;
681 operand[0] = to1; operand[1] = to2;
686 static void infix_property_display(unsigned prop,
687 offset proptable, unsigned prop_length)
689 BOOL do_number = TRUE;
694 /* things we know to be objects/strings/routines */
695 static const char *decode_me_names[] = {
696 "n_to", "nw_to", "w_to", "sw_to", "s_to", "se_to", "e_to", "ne_to",
697 "in_to", "out_to", "u_to", "d_to",
698 "add_to_scope", "after", "article", "articles", "before", "cant_go",
699 "daemon", "describe", "door_dir", "door_to", "each_turn", "found_in",
700 "grammar", "initial", "inside_description", "invent", "life", "orders",
701 "parse_name", "plural", "react_after", "react_before",
702 "short_name", "short_name_indef", "time_out", "when_closed", "when_open",
703 "when_on", "when_off", "with_key",
709 /* things we know to be just plain numbers */
710 static const char *dont_decode_names[] = {
711 "capacity", "number", "time_left"
715 const char *propname;
717 p.v = prop; p.t = Z_PROP;
718 propname = infix_get_name(p);
721 propname = "ofclass";
723 infix_print_string(", ");
726 infix_print_string(propname);
728 infix_print_string("P");
729 infix_print_number(prop);
731 infix_print_string(" =");
734 for(i = 0; i < prop_length; i+=ZWORD_SIZE) {
735 offset short_name_off = object_name(LOWORD(proptable + i));
737 infix_print_char(' ');
738 decodezscii(short_name_off, infix_print_char);
740 infix_print_string(" <badclass>");
747 if(n_strcmp(propname, "name") == 0) {
748 for(i = 0; i < prop_length; i+=ZWORD_SIZE) {
749 infix_print_string(" '");
750 decodezscii(LOWORD(proptable + i), infix_print_char);
751 infix_print_char('\'');
756 for(i = 0; i < sizeof(decode_me_names) / sizeof(*decode_me_names); i++)
757 if(n_strcmp(decode_me_names[i], propname) == 0)
760 for(i = 0; i < sizeof(dont_decode_names) / sizeof(*dont_decode_names); i++)
761 if(n_strcmp(dont_decode_names[i], propname) == 0)
765 if(prop_length % ZWORD_SIZE || LOWORD(proptable) == 0) {
771 switch(prop_length) {
773 infix_print_char(' ');
774 infix_print_znumber(LOBYTE(proptable));
777 infix_print_char(' ');
778 infix_print_znumber(LOWORD(proptable));
781 for(i = 0; i < prop_length; i++) {
782 infix_print_char(' ');
783 infix_print_znumber(LOBYTE(proptable + i));
789 for(i = 0; i < prop_length; i += ZWORD_SIZE) {
790 zword val = LOWORD(proptable + i);
791 const char *name = debug_decode_number(val);
794 infix_print_char(' ');
796 infix_print_char('(');
797 infix_print_string(name);
799 infix_print_char(')');
802 infix_print_char(' ');
803 infix_print_znumber(val);
805 if(val <= object_count) {
806 offset short_name_off = object_name(val);
808 infix_print_char(' ');
809 infix_print_char('(');
810 decodezscii(short_name_off, infix_print_char);
811 infix_print_char(')');
820 static void infix_show_object(zword object)
824 infix_print_string("0");
826 offset short_name_off;
828 o.t = Z_OBJECT; o.v = object;
829 name = infix_get_name(o);
831 infix_print_string(name);
833 infix_print_number(object);
836 short_name_off = object_name(object);
838 infix_print_string(" \"");
839 decodezscii(short_name_off, infix_print_char);
840 infix_print_char('"');
842 infix_print_string(" <nameless>");
847 zword infix_get_proptable(zword object, zword prop, zword *length)
849 zword propnum, location, nloc, nlen;
852 while(infix_property_loop(object, &propnum, &location, length, &nloc, &nlen)) {
861 zword infix_get_prop(zword object, zword prop)
864 zword proptable = infix_get_proptable(object, prop, &prop_length);
867 if(prop < PROP_NUM_MASK) { /* property defaults */
868 proptable = z_propdefaults + (prop - 1) * ZWORD_SIZE;
869 prop_length = ZWORD_SIZE;
875 switch(prop_length) {
877 return LOBYTE(proptable);
880 return LOWORD(proptable);
885 void infix_put_prop(zword object, zword prop, zword val)
888 zword proptable = infix_get_proptable(object, prop, &prop_length);
893 switch(prop_length) {
895 LOBYTEwrite(proptable, val);
898 LOWORDwrite(proptable, val);
903 BOOL infix_test_attrib(zword object, zword attrib)
905 if(!check_obj_valid(object) || !check_attr_valid(attrib)) {
909 /* select the bit to be tested */
910 if(ATTRIBUTE(object, attrib) & (b10000000 >> (attrib & b0111)))
917 static char *trunk = NULL;
918 static int trunksize = 128;
920 static void infix_draw_trunk(int depth)
923 for(i = 1; i < depth; i++) {
925 infix_print_fixed_string(" | ");
927 infix_print_fixed_string(" ");
931 static void infix_draw_branch(int depth)
933 infix_draw_trunk(depth);
935 infix_print_fixed_string(" +->");
939 static void infix_draw_object(zword object, int depth)
944 if(depth >= trunksize) {
946 trunk = (char *) n_realloc(trunk, trunksize);
949 infix_draw_branch(depth);
950 infix_show_object(object);
951 infix_print_char(10);
953 /* Do a sanity check before we print anything to avoid screenfulls of junk */
955 for(c = CHILD(object); c; c = SIBLING(c)) {
956 if(width++ > maxobjs) {
957 infix_print_string("looped sibling list.\n");
962 for(c = CHILD(object); c; c = SIBLING(c)) {
963 if(PARENT(c) != object) { /* Section 12.5 (b) */
964 infix_print_string("object ");
965 infix_print_number(c);
966 infix_print_string(" is a child of object ");
967 infix_print_number(object);
968 infix_print_string(" but has ");
969 infix_print_number(PARENT(c));
970 infix_print_string(" listed as its parent.\n");
974 trunk[depth+1] = (SIBLING(c) != 0);
976 infix_draw_object(c, depth+1);
980 void infix_object_tree(zword object)
982 trunk = (char *) n_malloc(trunksize);
985 infix_draw_object(object, 0);
990 for(object = 1; object <= object_count; object++) {
991 if(!PARENT(object)) {
992 if(SIBLING(object)) { /* Section 12.5 (a) */
993 infix_print_string("Object ");
994 infix_print_number(object);
995 infix_print_string(" has no parent, but has sibling ");
996 infix_print_number(SIBLING(object));
997 infix_print_string(".\n");
1000 infix_draw_object(object, 0);
1009 /* Contrary to the zspec, short names may be arbitrarily long because of
1010 abbreviations, so use realloc */
1012 static char *short_name;
1013 static unsigned short_name_length;
1014 static unsigned short_name_i;
1016 static void infix_copy_short_name(int ch)
1018 if(short_name_i + 1 >= short_name_length ) {
1020 short_name_length *= 2;
1021 p = (char *) n_realloc(short_name, short_name_length);
1024 short_name[short_name_i++] = ch;
1027 void infix_object_find(const char *description)
1030 char *desc = n_strdup(description);
1032 for(object = 1; object <= object_count; object++) {
1033 offset short_name_off = object_name(object);
1034 if(short_name_off) {
1035 short_name_length = 512;
1036 short_name = (char *) n_malloc(short_name_length);
1038 decodezscii(short_name_off, infix_copy_short_name);
1039 short_name[short_name_i] = 0;
1040 n_strlower(short_name);
1041 if(n_strstr(short_name, desc)) {
1042 infix_show_object(object);
1043 if(PARENT(object)) {
1044 infix_print_string(" in ");
1045 infix_show_object(PARENT(object));
1047 infix_print_char(10);
1055 void infix_object_display(zword object)
1057 offset short_name_off;
1058 zword propnum, location, length, nloc, nlen;
1063 infix_print_string("nothing");
1067 if(!check_obj_valid(object)) {
1068 infix_print_string("invalid object");
1072 infix_print_char('{');
1074 short_name_off = object_name(object);
1075 if(short_name_off) {
1076 infix_print_string("short_name = \"");
1077 decodezscii(short_name_off, infix_print_char);
1078 infix_print_string("\", attrib =");
1082 for(n = 0; n < ATTR_COUNT; n++) {
1083 if(infix_test_attrib(object, n)) {
1085 const char *attrname;
1086 a.t = Z_ATTR; a.v = n;
1087 attrname = infix_get_name(a);
1088 infix_print_char(' ');
1090 infix_print_string(attrname);
1092 infix_print_number(n);
1097 infix_print_string(" <none>");
1099 infix_print_string(", parent = ");
1100 infix_show_object(PARENT(object));
1102 infix_print_string(", sibling = ");
1103 infix_show_object(SIBLING(object));
1105 infix_print_string(", child = ");
1106 infix_show_object(CHILD(object));
1110 while(infix_property_loop(object, &propnum, &location, &length, &nloc, &nlen)) {
1111 infix_property_display(propnum, location, length);
1114 infix_print_char('}');
1117 #endif /* DEBUGGING */