1 /* ScummVM - Graphic Adventure Engine
2 *
3 * ScummVM is the legal property of its developers, whose names
4 * are too numerous to list here. Please refer to the COPYRIGHT
5 * file distributed with this source distribution.
6 *
7 * This program is free software; you can redistribute it and/or
8 * modify it under the terms of the GNU General Public License
9 * as published by the Free Software Foundation; either version 2
10 * of the License, or (at your option) any later version.
11 *
12 * This program is distributed in the hope that it will be useful,
13 * but WITHOUT ANY WARRANTY; without even the implied warranty of
14 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 * GNU General Public License for more details.
16 *
17 * You should have received a copy of the GNU General Public License
18 * along with this program; if not, write to the Free Software
19 * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
20 *
21 */
22
23 #include "glk/glulx/glulx.h"
24
25 namespace Glk {
26 namespace Glulx {
27
28 /**
29 * Git passes along function arguments in reverse order. To make our lives more interesting
30 */
31 #ifdef ARGS_REVERSED
32 #define ARG(argv, argc, ix) (argv[(argc-1)-ix])
33 #else
34 #define ARG(argv, argc, ix) (argv[ix])
35 #endif
36
37 /**
38 * Any function can be called with any number of arguments. This macro lets us snarf a given argument,
39 * or zero if it wasn't supplied.
40 */
41 #define ARG_IF_GIVEN(argv, argc, ix) ((argc > ix) ? (ARG(argv, argc, ix)) : 0)
42
accel_find_func(uint index)43 acceleration_func Glulx::accel_find_func(uint index) {
44 switch (index) {
45 case 0:
46 return nullptr; // 0 always means no acceleration
47 case 1:
48 return &Glulx::func_1_z__region;
49 case 2:
50 return &Glulx::func_2_cp__tab;
51 case 3:
52 return &Glulx::func_3_ra__pr;
53 case 4:
54 return &Glulx::func_4_rl__pr;
55 case 5:
56 return &Glulx::func_5_oc__cl;
57 case 6:
58 return &Glulx::func_6_rv__pr;
59 case 7:
60 return &Glulx::func_7_op__pr;
61 case 8:
62 return &Glulx::func_8_cp__tab;
63 case 9:
64 return &Glulx::func_9_ra__pr;
65 case 10:
66 return &Glulx::func_10_rl__pr;
67 case 11:
68 return &Glulx::func_11_oc__cl;
69 case 12:
70 return &Glulx::func_12_rv__pr;
71 case 13:
72 return &Glulx::func_13_op__pr;
73 }
74 return nullptr;
75 }
76
accel_get_func(uint addr)77 acceleration_func Glulx::accel_get_func(uint addr) {
78 int bucknum;
79 accelentry_t *ptr;
80
81 if (!accelentries)
82 return nullptr;
83
84 bucknum = (addr % ACCEL_HASH_SIZE);
85 for (ptr = accelentries[bucknum]; ptr; ptr = ptr->next) {
86 if (ptr->addr == addr)
87 return ptr->func;
88 }
89 return nullptr;
90 }
91
accel_iterate_funcs(void (* func)(uint index,uint addr))92 void Glulx::accel_iterate_funcs(void (*func)(uint index, uint addr)) {
93 int bucknum;
94 accelentry_t *ptr;
95
96 if (!accelentries)
97 return;
98
99 for (bucknum = 0; bucknum < ACCEL_HASH_SIZE; bucknum++) {
100 for (ptr = accelentries[bucknum]; ptr; ptr = ptr->next) {
101 if (ptr->func) {
102 func(ptr->index, ptr->addr);
103 }
104 }
105 }
106 }
107
accel_set_func(uint index,uint addr)108 void Glulx::accel_set_func(uint index, uint addr) {
109 int bucknum;
110 accelentry_t *ptr;
111 int functype;
112 acceleration_func new_func = nullptr;
113
114 /* Check the Glulx type identifier byte. */
115 functype = Mem1(addr);
116 if (functype != 0xC0 && functype != 0xC1) {
117 fatal_error_i("Attempt to accelerate non-function.", addr);
118 }
119
120 if (!accelentries) {
121 accelentries = (accelentry_t **)glulx_malloc(ACCEL_HASH_SIZE
122 * sizeof(accelentry_t *));
123 if (!accelentries)
124 fatal_error("Cannot malloc acceleration table.");
125 for (bucknum = 0; bucknum < ACCEL_HASH_SIZE; bucknum++)
126 accelentries[bucknum] = nullptr;
127 }
128
129 new_func = accel_find_func(index);
130 /* Might be nullptr, if the index is zero or not recognized. */
131
132 bucknum = (addr % ACCEL_HASH_SIZE);
133 for (ptr = accelentries[bucknum]; ptr; ptr = ptr->next) {
134 if (ptr->addr == addr)
135 break;
136 }
137 if (!ptr) {
138 if (!new_func) {
139 return; /* no need for a new entry */
140 }
141 ptr = (accelentry_t *)glulx_malloc(sizeof(accelentry_t));
142 if (!ptr)
143 fatal_error("Cannot malloc acceleration entry.");
144 ptr->addr = addr;
145 ptr->index = 0;
146 ptr->func = nullptr;
147 ptr->next = accelentries[bucknum];
148 accelentries[bucknum] = ptr;
149 }
150
151 ptr->index = index;
152 ptr->func = new_func;
153 }
154
accel_set_param(uint index,uint val)155 void Glulx::accel_set_param(uint index, uint val) {
156 switch (index) {
157 case 0:
158 classes_table = val;
159 break;
160 case 1:
161 indiv_prop_start = val;
162 break;
163 case 2:
164 class_metaclass = val;
165 break;
166 case 3:
167 object_metaclass = val;
168 break;
169 case 4:
170 routine_metaclass = val;
171 break;
172 case 5:
173 string_metaclass = val;
174 break;
175 case 6:
176 self = val;
177 break;
178 case 7:
179 num_attr_bytes = val;
180 break;
181 case 8:
182 cpv__start = val;
183 break;
184 }
185 }
186
accel_get_param_count() const187 uint Glulx::accel_get_param_count() const {
188 return 9;
189 }
190
accel_get_param(uint index) const191 uint Glulx::accel_get_param(uint index) const {
192 switch (index) {
193 case 0:
194 return classes_table;
195 case 1:
196 return indiv_prop_start;
197 case 2:
198 return class_metaclass;
199 case 3:
200 return object_metaclass;
201 case 4:
202 return routine_metaclass;
203 case 5:
204 return string_metaclass;
205 case 6:
206 return self;
207 case 7:
208 return num_attr_bytes;
209 case 8:
210 return cpv__start;
211 default:
212 return 0;
213 }
214 }
215
accel_error(const char * msg)216 void Glulx::accel_error(const char *msg) {
217 glk_put_char('\n');
218 glk_put_string(msg);
219 glk_put_char('\n');
220 }
221
obj_in_class(uint obj)222 int Glulx::obj_in_class(uint obj) {
223 // This checks whether obj is contained in Class, not whether it is a member of Class
224 return (Mem4(obj + 13 + num_attr_bytes) == class_metaclass);
225 }
226
get_prop(uint obj,uint id)227 uint Glulx::get_prop(uint obj, uint id) {
228 uint cla = 0;
229 uint prop;
230 uint call_argv[2];
231
232 if (id & 0xFFFF0000) {
233 cla = Mem4(classes_table + ((id & 0xFFFF) * 4));
234 ARG(call_argv, 2, 0) = obj;
235 ARG(call_argv, 2, 1) = cla;
236 if (func_5_oc__cl(2, call_argv) == 0)
237 return 0;
238
239 id >>= 16;
240 obj = cla;
241 }
242
243 ARG(call_argv, 2, 0) = obj;
244 ARG(call_argv, 2, 1) = id;
245 prop = func_2_cp__tab(2, call_argv);
246 if (prop == 0)
247 return 0;
248
249 if (obj_in_class(obj) && (cla == 0)) {
250 if ((id < indiv_prop_start) || (id >= indiv_prop_start + 8))
251 return 0;
252 }
253
254 if (Mem4(self) != obj) {
255 if (Mem1(prop + 9) & 1)
256 return 0;
257 }
258 return prop;
259 }
260
get_prop_new(uint obj,uint id)261 uint Glulx::get_prop_new(uint obj, uint id) {
262 uint cla = 0;
263 uint prop;
264 uint call_argv[2];
265
266 if (id & 0xFFFF0000) {
267 cla = Mem4(classes_table + ((id & 0xFFFF) * 4));
268 ARG(call_argv, 2, 0) = obj;
269 ARG(call_argv, 2, 1) = cla;
270 if (func_11_oc__cl(2, call_argv) == 0)
271 return 0;
272
273 id >>= 16;
274 obj = cla;
275 }
276
277 ARG(call_argv, 2, 0) = obj;
278 ARG(call_argv, 2, 1) = id;
279 prop = func_8_cp__tab(2, call_argv);
280 if (prop == 0)
281 return 0;
282
283 if (obj_in_class(obj) && (cla == 0)) {
284 if ((id < indiv_prop_start) || (id >= indiv_prop_start + 8))
285 return 0;
286 }
287
288 if (Mem4(self) != obj) {
289 if (Mem1(prop + 9) & 1)
290 return 0;
291 }
292 return prop;
293 }
294
func_1_z__region(uint argc,uint * argv)295 uint Glulx::func_1_z__region(uint argc, uint *argv) {
296 uint addr;
297 uint tb;
298
299 if (argc < 1)
300 return 0;
301
302 addr = ARG(argv, argc, 0);
303 if (addr < 36)
304 return 0;
305 if (addr >= endmem)
306 return 0;
307
308 tb = Mem1(addr);
309 if (tb >= 0xE0) {
310 return 3;
311 }
312 if (tb >= 0xC0) {
313 return 2;
314 }
315 if (tb >= 0x70 && tb <= 0x7F && addr >= ramstart) {
316 return 1;
317 }
318 return 0;
319 }
320
func_2_cp__tab(uint argc,uint * argv)321 uint Glulx::func_2_cp__tab(uint argc, uint *argv) {
322 uint obj;
323 uint id;
324 uint otab, max;
325
326 obj = ARG_IF_GIVEN(argv, argc, 0);
327 id = ARG_IF_GIVEN(argv, argc, 1);
328
329 if (func_1_z__region(1, &obj) != 1) {
330 accel_error("[** Programming error: tried to find the \".\" of (something) **]");
331 return 0;
332 }
333
334 otab = Mem4(obj + 16);
335 if (!otab)
336 return 0;
337
338 max = Mem4(otab);
339 otab += 4;
340 /* @binarysearch id 2 otab 10 max 0 0 res; */
341 return binary_search(id, 2, otab, 10, max, 0, 0);
342 }
343
func_3_ra__pr(uint argc,uint * argv)344 uint Glulx::func_3_ra__pr(uint argc, uint *argv) {
345 uint obj;
346 uint id;
347 uint prop;
348
349 obj = ARG_IF_GIVEN(argv, argc, 0);
350 id = ARG_IF_GIVEN(argv, argc, 1);
351
352 prop = get_prop(obj, id);
353 if (prop == 0)
354 return 0;
355
356 return Mem4(prop + 4);
357 }
358
func_4_rl__pr(uint argc,uint * argv)359 uint Glulx::func_4_rl__pr(uint argc, uint *argv) {
360 uint obj;
361 uint id;
362 uint prop;
363
364 obj = ARG_IF_GIVEN(argv, argc, 0);
365 id = ARG_IF_GIVEN(argv, argc, 1);
366
367 prop = get_prop(obj, id);
368 if (prop == 0)
369 return 0;
370
371 return 4 * Mem2(prop + 2);
372 }
373
func_5_oc__cl(uint argc,uint * argv)374 uint Glulx::func_5_oc__cl(uint argc, uint *argv) {
375 uint obj;
376 uint cla;
377 uint zr, prop, inlist, inlistlen, jx;
378
379 obj = ARG_IF_GIVEN(argv, argc, 0);
380 cla = ARG_IF_GIVEN(argv, argc, 1);
381
382 zr = func_1_z__region(1, &obj);
383 if (zr == 3)
384 return (cla == string_metaclass) ? 1 : 0;
385 if (zr == 2)
386 return (cla == routine_metaclass) ? 1 : 0;
387 if (zr != 1)
388 return 0;
389
390 if (cla == class_metaclass) {
391 if (obj_in_class(obj))
392 return 1;
393 if (obj == class_metaclass)
394 return 1;
395 if (obj == string_metaclass)
396 return 1;
397 if (obj == routine_metaclass)
398 return 1;
399 if (obj == object_metaclass)
400 return 1;
401 return 0;
402 }
403 if (cla == object_metaclass) {
404 if (obj_in_class(obj))
405 return 0;
406 if (obj == class_metaclass)
407 return 0;
408 if (obj == string_metaclass)
409 return 0;
410 if (obj == routine_metaclass)
411 return 0;
412 if (obj == object_metaclass)
413 return 0;
414 return 1;
415 }
416 if ((cla == string_metaclass) || (cla == routine_metaclass))
417 return 0;
418
419 if (!obj_in_class(cla)) {
420 accel_error("[** Programming error: tried to apply 'ofclass' with non-class **]");
421 return 0;
422 }
423
424 prop = get_prop(obj, 2);
425 if (prop == 0)
426 return 0;
427
428 inlist = Mem4(prop + 4);
429 if (inlist == 0)
430 return 0;
431
432 inlistlen = Mem2(prop + 2);
433 for (jx = 0; jx < inlistlen; jx++) {
434 if (Mem4(inlist + (4 * jx)) == cla)
435 return 1;
436 }
437 return 0;
438 }
439
func_6_rv__pr(uint argc,uint * argv)440 uint Glulx::func_6_rv__pr(uint argc, uint *argv) {
441 uint id;
442 uint addr;
443
444 id = ARG_IF_GIVEN(argv, argc, 1);
445
446 addr = func_3_ra__pr(argc, argv);
447
448 if (addr == 0) {
449 if ((id > 0) && (id < indiv_prop_start))
450 return Mem4(cpv__start + (4 * id));
451
452 accel_error("[** Programming error: tried to read (something) **]");
453 return 0;
454 }
455
456 return Mem4(addr);
457 }
458
func_7_op__pr(uint argc,uint * argv)459 uint Glulx::func_7_op__pr(uint argc, uint *argv) {
460 uint obj;
461 uint id;
462 uint zr;
463
464 obj = ARG_IF_GIVEN(argv, argc, 0);
465 id = ARG_IF_GIVEN(argv, argc, 1);
466
467 zr = func_1_z__region(1, &obj);
468 if (zr == 3) {
469 /* print is INDIV_PROP_START+6 */
470 if (id == indiv_prop_start + 6)
471 return 1;
472 /* print_to_array is INDIV_PROP_START+7 */
473 if (id == indiv_prop_start + 7)
474 return 1;
475 return 0;
476 }
477 if (zr == 2) {
478 /* call is INDIV_PROP_START+5 */
479 return ((id == indiv_prop_start + 5) ? 1 : 0);
480 }
481 if (zr != 1)
482 return 0;
483
484 if ((id >= indiv_prop_start) && (id < indiv_prop_start + 8)) {
485 if (obj_in_class(obj))
486 return 1;
487 }
488
489 return ((func_3_ra__pr(argc, argv)) ? 1 : 0);
490 }
491
func_8_cp__tab(uint argc,uint * argv)492 uint Glulx::func_8_cp__tab(uint argc, uint *argv) {
493 uint obj;
494 uint id;
495 uint otab, max;
496
497 obj = ARG_IF_GIVEN(argv, argc, 0);
498 id = ARG_IF_GIVEN(argv, argc, 1);
499
500 if (func_1_z__region(1, &obj) != 1) {
501 accel_error("[** Programming error: tried to find the \".\" of (something) **]");
502 return 0;
503 }
504
505 otab = Mem4(obj + 4 * (3 + (int)(num_attr_bytes / 4)));
506 if (!otab)
507 return 0;
508
509 max = Mem4(otab);
510 otab += 4;
511 /* @binarysearch id 2 otab 10 max 0 0 res; */
512 return binary_search(id, 2, otab, 10, max, 0, 0);
513 }
514
func_9_ra__pr(uint argc,uint * argv)515 uint Glulx::func_9_ra__pr(uint argc, uint *argv) {
516 uint obj;
517 uint id;
518 uint prop;
519
520 obj = ARG_IF_GIVEN(argv, argc, 0);
521 id = ARG_IF_GIVEN(argv, argc, 1);
522
523 prop = get_prop_new(obj, id);
524 if (prop == 0)
525 return 0;
526
527 return Mem4(prop + 4);
528 }
529
func_10_rl__pr(uint argc,uint * argv)530 uint Glulx::func_10_rl__pr(uint argc, uint *argv) {
531 uint obj;
532 uint id;
533 uint prop;
534
535 obj = ARG_IF_GIVEN(argv, argc, 0);
536 id = ARG_IF_GIVEN(argv, argc, 1);
537
538 prop = get_prop_new(obj, id);
539 if (prop == 0)
540 return 0;
541
542 return 4 * Mem2(prop + 2);
543 }
544
func_11_oc__cl(uint argc,uint * argv)545 uint Glulx::func_11_oc__cl(uint argc, uint *argv) {
546 uint obj;
547 uint cla;
548 uint zr, prop, inlist, inlistlen, jx;
549
550 obj = ARG_IF_GIVEN(argv, argc, 0);
551 cla = ARG_IF_GIVEN(argv, argc, 1);
552
553 zr = func_1_z__region(1, &obj);
554 if (zr == 3)
555 return (cla == string_metaclass) ? 1 : 0;
556 if (zr == 2)
557 return (cla == routine_metaclass) ? 1 : 0;
558 if (zr != 1)
559 return 0;
560
561 if (cla == class_metaclass) {
562 if (obj_in_class(obj))
563 return 1;
564 if (obj == class_metaclass)
565 return 1;
566 if (obj == string_metaclass)
567 return 1;
568 if (obj == routine_metaclass)
569 return 1;
570 if (obj == object_metaclass)
571 return 1;
572 return 0;
573 }
574 if (cla == object_metaclass) {
575 if (obj_in_class(obj))
576 return 0;
577 if (obj == class_metaclass)
578 return 0;
579 if (obj == string_metaclass)
580 return 0;
581 if (obj == routine_metaclass)
582 return 0;
583 if (obj == object_metaclass)
584 return 0;
585 return 1;
586 }
587 if ((cla == string_metaclass) || (cla == routine_metaclass))
588 return 0;
589
590 if (!obj_in_class(cla)) {
591 accel_error("[** Programming error: tried to apply 'ofclass' with non-class **]");
592 return 0;
593 }
594
595 prop = get_prop_new(obj, 2);
596 if (prop == 0)
597 return 0;
598
599 inlist = Mem4(prop + 4);
600 if (inlist == 0)
601 return 0;
602
603 inlistlen = Mem2(prop + 2);
604 for (jx = 0; jx < inlistlen; jx++) {
605 if (Mem4(inlist + (4 * jx)) == cla)
606 return 1;
607 }
608 return 0;
609 }
610
func_12_rv__pr(uint argc,uint * argv)611 uint Glulx::func_12_rv__pr(uint argc, uint *argv) {
612 uint id;
613 uint addr;
614
615 id = ARG_IF_GIVEN(argv, argc, 1);
616
617 addr = func_9_ra__pr(argc, argv);
618
619 if (addr == 0) {
620 if ((id > 0) && (id < indiv_prop_start))
621 return Mem4(cpv__start + (4 * id));
622
623 accel_error("[** Programming error: tried to read (something) **]");
624 return 0;
625 }
626
627 return Mem4(addr);
628 }
629
func_13_op__pr(uint argc,uint * argv)630 uint Glulx::func_13_op__pr(uint argc, uint *argv) {
631 uint obj;
632 uint id;
633 uint zr;
634
635 obj = ARG_IF_GIVEN(argv, argc, 0);
636 id = ARG_IF_GIVEN(argv, argc, 1);
637
638 zr = func_1_z__region(1, &obj);
639 if (zr == 3) {
640 /* print is INDIV_PROP_START+6 */
641 if (id == indiv_prop_start + 6)
642 return 1;
643 /* print_to_array is INDIV_PROP_START+7 */
644 if (id == indiv_prop_start + 7)
645 return 1;
646 return 0;
647 }
648 if (zr == 2) {
649 /* call is INDIV_PROP_START+5 */
650 return ((id == indiv_prop_start + 5) ? 1 : 0);
651 }
652 if (zr != 1)
653 return 0;
654
655 if ((id >= indiv_prop_start) && (id < indiv_prop_start + 8)) {
656 if (obj_in_class(obj))
657 return 1;
658 }
659
660 return ((func_9_ra__pr(argc, argv)) ? 1 : 0);
661 }
662
663 } // End of namespace Glulx
664 } // End of namespace Glk
665