Implemented garglk_set_program_name(), garglk_set_program_info(), garglk_set_story_name()
[rodin/chimara.git] / interpreters / glulxe / exec.c
1 /* exec.c: Glulxe code for program execution. The main interpreter loop.
2     Designed by Andrew Plotkin <erkyrath@eblong.com>
3     http://eblong.com/zarf/glulx/index.html
4 */
5
6 #include "glk.h"
7 #include "glulxe.h"
8 #include "opcodes.h"
9
10 /* execute_loop():
11    The main interpreter loop. This repeats until the program is done.
12 */
13 void execute_loop()
14 {
15   int done_executing = FALSE;
16   int ix;
17   glui32 opcode;
18   operandlist_t *oplist;
19   instruction_t inst;
20   glui32 value, addr, val0, val1;
21   glsi32 vals0, vals1;
22   glui32 *arglist;
23   glui32 arglistfix[3];
24
25   while (!done_executing) {
26
27     profile_tick();
28     /* Do OS-specific processing, if appropriate. */
29     glk_tick();
30
31     /* Fetch the opcode number. */
32     opcode = Mem1(pc);
33     pc++;
34     if (opcode & 0x80) {
35       /* More than one-byte opcode. */
36       if (opcode & 0x40) {
37         /* Four-byte opcode */
38         opcode &= 0x3F;
39         opcode = (opcode << 8) | Mem1(pc);
40         pc++;
41         opcode = (opcode << 8) | Mem1(pc);
42         pc++;
43         opcode = (opcode << 8) | Mem1(pc);
44         pc++;
45       }
46       else {
47         /* Two-byte opcode */
48         opcode &= 0x7F;
49         opcode = (opcode << 8) | Mem1(pc);
50         pc++;
51       }
52     }
53
54     /* Now we have an opcode number. */
55     
56     /* Fetch the structure that describes how the operands for this
57        opcode are arranged. This is a pointer to an immutable, 
58        static object. */
59     if (opcode < 0x80)
60       oplist = fast_operandlist[opcode];
61     else
62       oplist = lookup_operandlist(opcode);
63
64     if (!oplist)
65       fatal_error_i("Encountered unknown opcode.", opcode);
66
67     /* Based on the oplist structure, load the actual operand values
68        into inst. This moves the PC up to the end of the instruction. */
69     parse_operands(&inst, oplist);
70
71     /* Perform the opcode. This switch statement is split in two, based
72        on some paranoid suspicions about the ability of compilers to
73        optimize large-range switches. Ignore that. */
74
75     if (opcode < 0x80) {
76
77       switch (opcode) {
78
79       case op_nop:
80         break;
81
82       case op_add:
83         value = inst.value[0] + inst.value[1];
84         store_operand(inst.desttype, inst.value[2], value);
85         break;
86       case op_sub:
87         value = inst.value[0] - inst.value[1];
88         store_operand(inst.desttype, inst.value[2], value);
89         break;
90       case op_mul:
91         value = inst.value[0] * inst.value[1];
92         store_operand(inst.desttype, inst.value[2], value);
93         break;
94       case op_div:
95         vals0 = inst.value[0];
96         vals1 = inst.value[1];
97         if (vals1 == 0)
98           fatal_error("Division by zero.");
99         /* Since C doesn't guarantee the results of division of negative
100            numbers, we carefully convert everything to positive values
101            first. */
102         if (vals1 < 0) {
103           vals0 = (-vals0);
104           vals1 = (-vals1);
105         }
106         if (vals0 >= 0) {
107           value = vals0 / vals1;
108         }
109         else {
110           value = -((-vals0) / vals1);
111         }
112         store_operand(inst.desttype, inst.value[2], value);
113         break;
114       case op_mod:
115         vals0 = inst.value[0];
116         vals1 = inst.value[1];
117         if (vals1 == 0)
118           fatal_error("Division by zero doing remainder.");
119         if (vals1 < 0) {
120           vals1 = (-vals1);
121         }
122         if (vals0 >= 0) {
123           value = vals0 % vals1;
124         }
125         else {
126           value = -((-vals0) % vals1);
127         }
128         store_operand(inst.desttype, inst.value[2], value);
129         break;
130       case op_neg:
131         vals0 = inst.value[0];
132         value = (-vals0);
133         store_operand(inst.desttype, inst.value[1], value);
134         break;
135
136       case op_bitand:
137         value = (inst.value[0] & inst.value[1]);
138         store_operand(inst.desttype, inst.value[2], value);
139         break;
140       case op_bitor:
141         value = (inst.value[0] | inst.value[1]);
142         store_operand(inst.desttype, inst.value[2], value);
143         break;
144       case op_bitxor:
145         value = (inst.value[0] ^ inst.value[1]);
146         store_operand(inst.desttype, inst.value[2], value);
147         break;
148       case op_bitnot:
149         value = ~(inst.value[0]);
150         store_operand(inst.desttype, inst.value[1], value);
151         break;
152
153       case op_shiftl:
154         vals0 = inst.value[1];
155         if (vals0 < 0 || vals0 >= 32)
156           value = 0;
157         else
158           value = ((glui32)(inst.value[0]) << (glui32)vals0);
159         store_operand(inst.desttype, inst.value[2], value);
160         break;
161       case op_ushiftr:
162         vals0 = inst.value[1];
163         if (vals0 < 0 || vals0 >= 32)
164           value = 0;
165         else
166           value = ((glui32)(inst.value[0]) >> (glui32)vals0);
167         store_operand(inst.desttype, inst.value[2], value);
168         break;
169       case op_sshiftr:
170         vals0 = inst.value[1];
171         if (vals0 < 0 || vals0 >= 32) {
172           if (inst.value[0] & 0x80000000)
173             value = 0xFFFFFFFF;
174           else
175             value = 0;
176         }
177         else {
178           /* This is somewhat foolhardy -- C doesn't guarantee that
179              right-shifting a signed value replicates the sign bit.
180              We'll assume it for now. */
181           value = ((glsi32)(inst.value[0]) >> (glsi32)vals0);
182         }
183         store_operand(inst.desttype, inst.value[2], value);
184         break;
185
186       case op_jump:
187         value = inst.value[0];
188         /* fall through to PerformJump label. */
189
190       PerformJump: /* goto label for successful jumping... ironic, no? */
191         if (value == 0 || value == 1) {
192           /* Return from function. This is exactly what happens in
193              return_op, but it's only a few lines of code, so I won't
194              bother with a "goto". */
195           leave_function();
196           if (stackptr == 0) {
197             done_executing = TRUE;
198             break;
199           }
200           pop_callstub(value); /* zero or one */
201         }
202         else {
203           /* Branch to a new PC value. */
204           pc = (pc + value - 2);
205         }
206         break;
207
208       case op_jz:
209         if (inst.value[0] == 0) {
210           value = inst.value[1];
211           goto PerformJump;
212         }
213         break;
214       case op_jnz:
215         if (inst.value[0] != 0) {
216           value = inst.value[1];
217           goto PerformJump;
218         }
219         break;
220       case op_jeq:
221         if (inst.value[0] == inst.value[1]) {
222           value = inst.value[2];
223           goto PerformJump;
224         }
225         break;
226       case op_jne:
227         if (inst.value[0] != inst.value[1]) {
228           value = inst.value[2];
229           goto PerformJump;
230         }
231         break;
232       case op_jlt:
233         vals0 = inst.value[0];
234         vals1 = inst.value[1];
235         if (vals0 < vals1) {
236           value = inst.value[2];
237           goto PerformJump;
238         }
239         break;
240       case op_jgt:
241         vals0 = inst.value[0];
242         vals1 = inst.value[1];
243         if (vals0 > vals1) {
244           value = inst.value[2];
245           goto PerformJump;
246         }
247         break;
248       case op_jle:
249         vals0 = inst.value[0];
250         vals1 = inst.value[1];
251         if (vals0 <= vals1) {
252           value = inst.value[2];
253           goto PerformJump;
254         }
255         break;
256       case op_jge:
257         vals0 = inst.value[0];
258         vals1 = inst.value[1];
259         if (vals0 >= vals1) {
260           value = inst.value[2];
261           goto PerformJump;
262         }
263         break;
264       case op_jltu:
265         val0 = inst.value[0];
266         val1 = inst.value[1];
267         if (val0 < val1) {
268           value = inst.value[2];
269           goto PerformJump;
270         }
271         break;
272       case op_jgtu:
273         val0 = inst.value[0];
274         val1 = inst.value[1];
275         if (val0 > val1) {
276           value = inst.value[2];
277           goto PerformJump;
278         }
279         break;
280       case op_jleu:
281         val0 = inst.value[0];
282         val1 = inst.value[1];
283         if (val0 <= val1) {
284           value = inst.value[2];
285           goto PerformJump;
286         }
287         break;
288       case op_jgeu:
289         val0 = inst.value[0];
290         val1 = inst.value[1];
291         if (val0 >= val1) {
292           value = inst.value[2];
293           goto PerformJump;
294         }
295         break;
296
297       case op_call:
298         value = inst.value[1];
299         arglist = pop_arguments(value, 0);
300         push_callstub(inst.desttype, inst.value[2]);
301         enter_function(inst.value[0], value, arglist);
302         break;
303       case op_return:
304         leave_function();
305         if (stackptr == 0) {
306           done_executing = TRUE;
307           break;
308         }
309         pop_callstub(inst.value[0]);
310         break;
311       case op_tailcall:
312         value = inst.value[1];
313         arglist = pop_arguments(value, 0);
314         leave_function();
315         enter_function(inst.value[0], value, arglist);
316         break;
317
318       case op_catch:
319         push_callstub(inst.desttype, inst.value[0]);
320         value = inst.value[1];
321         val0 = stackptr;
322         store_operand(inst.desttype, inst.value[0], val0);
323         goto PerformJump;
324         break;
325       case op_throw:
326         profile_fail("throw");
327         value = inst.value[0];
328         stackptr = inst.value[1];
329         pop_callstub(value);
330         break;
331
332       case op_copy:
333         value = inst.value[0];
334         store_operand(inst.desttype, inst.value[1], value);
335         break;
336       case op_copys:
337         value = inst.value[0];
338         store_operand_s(inst.desttype, inst.value[1], value);
339         break;
340       case op_copyb:
341         value = inst.value[0];
342         store_operand_b(inst.desttype, inst.value[1], value);
343         break;
344
345       case op_sexs:
346         val0 = inst.value[0];
347         if (val0 & 0x8000)
348           val0 |= 0xFFFF0000;
349         else
350           val0 &= 0x0000FFFF;
351         store_operand(inst.desttype, inst.value[1], val0);
352         break;
353       case op_sexb:
354         val0 = inst.value[0];
355         if (val0 & 0x80)
356           val0 |= 0xFFFFFF00;
357         else
358           val0 &= 0x000000FF;
359         store_operand(inst.desttype, inst.value[1], val0);
360         break;
361
362       case op_aload:
363         value = inst.value[0];
364         value += 4 * inst.value[1];
365         val0 = Mem4(value);
366         store_operand(inst.desttype, inst.value[2], val0);
367         break;
368       case op_aloads:
369         value = inst.value[0];
370         value += 2 * inst.value[1];
371         val0 = Mem2(value);
372         store_operand(inst.desttype, inst.value[2], val0);
373         break;
374       case op_aloadb:
375         value = inst.value[0];
376         value += inst.value[1];
377         val0 = Mem1(value);
378         store_operand(inst.desttype, inst.value[2], val0);
379         break;
380       case op_aloadbit:
381         value = inst.value[0];
382         vals0 = inst.value[1];
383         val1 = (vals0 & 7);
384         if (vals0 >= 0)
385           value += (vals0 >> 3);
386         else
387           value -= ((-1 - vals0) >> 3);
388         if (Mem1(value) & (1 << val1))
389           val0 = 1;
390         else
391           val0 = 0;
392         store_operand(inst.desttype, inst.value[2], val0);
393         break;
394
395       case op_astore:
396         value = inst.value[0];
397         value += 4 * inst.value[1];
398         val0 = inst.value[2];
399         MemW4(value, val0);
400         break;
401       case op_astores:
402         value = inst.value[0];
403         value += 2 * inst.value[1];
404         val0 = inst.value[2];
405         MemW2(value, val0);
406         break;
407       case op_astoreb:
408         value = inst.value[0];
409         value += inst.value[1];
410         val0 = inst.value[2];
411         MemW1(value, val0);
412         break;
413       case op_astorebit:
414         value = inst.value[0];
415         vals0 = inst.value[1];
416         val1 = (vals0 & 7);
417         if (vals0 >= 0)
418           value += (vals0 >> 3);
419         else
420           value -= ((-1 - vals0) >> 3);
421         val0 = Mem1(value);
422         if (inst.value[2])
423           val0 |= (1 << val1);
424         else
425           val0 &= ~((glui32)(1 << val1));
426         MemW1(value, val0);
427         break;
428
429       case op_stkcount:
430         value = (stackptr - valstackbase) / 4;
431         store_operand(inst.desttype, inst.value[0], value);
432         break;
433       case op_stkpeek:
434         vals0 = inst.value[0] * 4;
435         if (vals0 < 0 || vals0 >= (stackptr - valstackbase))
436           fatal_error("Stkpeek outside current stack range.");
437         value = Stk4(stackptr - (vals0+4));
438         store_operand(inst.desttype, inst.value[1], value);
439         break;
440       case op_stkswap:
441         if (stackptr < valstackbase+8) {
442           fatal_error("Stack underflow in stkswap.");
443         }
444         val0 = Stk4(stackptr-4);
445         val1 = Stk4(stackptr-8);
446         StkW4(stackptr-4, val1);
447         StkW4(stackptr-8, val0);
448         break;
449       case op_stkcopy:
450         vals0 = inst.value[0];
451         if (vals0 < 0)
452           fatal_error("Negative operand in stkcopy.");
453         if (vals0 == 0)
454           break;
455         if (stackptr < valstackbase+vals0*4)
456           fatal_error("Stack underflow in stkcopy.");
457         if (stackptr + vals0*4 > stacksize) 
458           fatal_error("Stack overflow in stkcopy.");
459         addr = stackptr - vals0*4;
460         for (ix=0; ix<vals0; ix++) {
461           value = Stk4(addr + ix*4);
462           StkW4(stackptr + ix*4, value);
463         }
464         stackptr += vals0*4;
465         break;
466       case op_stkroll:
467         vals0 = inst.value[0];
468         vals1 = inst.value[1];
469         if (vals0 < 0)
470           fatal_error("Negative operand in stkroll.");
471         if (stackptr < valstackbase+vals0*4)
472           fatal_error("Stack underflow in stkroll.");
473         if (vals0 == 0)
474           break;
475         /* The following is a bit ugly. We want to do vals1 = vals0-vals1,
476            because rolling down is sort of easier than rolling up. But
477            we also want to take the result mod vals0. The % operator is
478            annoying for negative numbers, so we need to do this in two 
479            cases. */
480         if (vals1 > 0) {
481           vals1 = vals1 % vals0;
482           vals1 = (vals0) - vals1;
483         }
484         else {
485           vals1 = (-vals1) % vals0;
486         }
487         if (vals1 == 0)
488           break;
489         addr = stackptr - vals0*4;
490         for (ix=0; ix<vals1; ix++) {
491           value = Stk4(addr + ix*4);
492           StkW4(stackptr + ix*4, value);
493         }
494         for (ix=0; ix<vals0; ix++) {
495           value = Stk4(addr + (vals1+ix)*4);
496           StkW4(addr + ix*4, value);
497         }
498         break;
499
500       case op_streamchar:
501         profile_in(2, FALSE);
502         value = inst.value[0] & 0xFF;
503         (*stream_char_handler)(value);
504         profile_out();
505         break;
506       case op_streamunichar:
507         profile_in(2, FALSE);
508         value = inst.value[0];
509         (*stream_unichar_handler)(value);
510         profile_out();
511         break;
512       case op_streamnum:
513         profile_in(2, FALSE);
514         vals0 = inst.value[0];
515         stream_num(vals0, FALSE, 0);
516         profile_out();
517         break;
518       case op_streamstr:
519         profile_in(2, FALSE);
520         stream_string(inst.value[0], 0, 0);
521         profile_out();
522         break;
523
524       default:
525         fatal_error_i("Executed unknown opcode.", opcode);
526       }
527     }
528     else {
529
530       switch (opcode) {
531
532       case op_gestalt:
533         value = do_gestalt(inst.value[0], inst.value[1]);
534         store_operand(inst.desttype, inst.value[2], value);
535         break;
536
537       case op_debugtrap:
538         fatal_error_i("user debugtrap encountered.", inst.value[0]);
539
540       case op_jumpabs:
541         pc = inst.value[0];
542         break;
543
544       case op_callf:
545         push_callstub(inst.desttype, inst.value[1]);
546         enter_function(inst.value[0], 0, arglistfix);
547         break;
548       case op_callfi:
549         arglistfix[0] = inst.value[1];
550         push_callstub(inst.desttype, inst.value[2]);
551         enter_function(inst.value[0], 1, arglistfix);
552         break;
553       case op_callfii:
554         arglistfix[0] = inst.value[1];
555         arglistfix[1] = inst.value[2];
556         push_callstub(inst.desttype, inst.value[3]);
557         enter_function(inst.value[0], 2, arglistfix);
558         break;
559       case op_callfiii:
560         arglistfix[0] = inst.value[1];
561         arglistfix[1] = inst.value[2];
562         arglistfix[2] = inst.value[3];
563         push_callstub(inst.desttype, inst.value[4]);
564         enter_function(inst.value[0], 3, arglistfix);
565         break;
566
567       case op_getmemsize:
568         store_operand(inst.desttype, inst.value[0], endmem);
569         break;
570       case op_setmemsize:
571         value = change_memsize(inst.value[0], FALSE);
572         store_operand(inst.desttype, inst.value[1], value);
573         break;
574
575       case op_getstringtbl:
576         value = stream_get_table();
577         store_operand(inst.desttype, inst.value[0], value);
578         break;
579       case op_setstringtbl:
580         stream_set_table(inst.value[0]);
581         break;
582
583       case op_getiosys:
584         stream_get_iosys(&val0, &val1);
585         store_operand(inst.desttype, inst.value[0], val0);
586         store_operand(inst.desttype, inst.value[1], val1);
587         break;
588       case op_setiosys:
589         stream_set_iosys(inst.value[0], inst.value[1]);
590         break;
591
592       case op_glk:
593         profile_in(1, FALSE);
594         value = inst.value[1];
595         arglist = pop_arguments(value, 0);
596         val0 = perform_glk(inst.value[0], value, arglist);
597         store_operand(inst.desttype, inst.value[2], val0);
598         profile_out();
599         break;
600
601       case op_random:
602         vals0 = inst.value[0];
603         if (vals0 == 0)
604           value = glulx_random() ^ (glulx_random() << 16);
605         else if (vals0 >= 1)
606           value = glulx_random() % (glui32)(vals0);
607         else 
608           value = -(glulx_random() % (glui32)(-vals0));
609         store_operand(inst.desttype, inst.value[1], value);
610         break;
611       case op_setrandom:
612         glulx_setrandom(inst.value[0]);
613         break;
614
615       case op_verify:
616         value = perform_verify();
617         store_operand(inst.desttype, inst.value[0], value);
618         break;
619
620       case op_restart:
621         profile_fail("restart");
622         vm_restart();
623         break;
624
625       case op_protect:
626         val0 = inst.value[0];
627         val1 = val0 + inst.value[1];
628         if (val0 == val1) {
629           val0 = 0;
630           val1 = 0;
631         }
632         protectstart = val0;
633         protectend = val1;
634         break;
635
636       case op_save:
637         push_callstub(inst.desttype, inst.value[1]);
638         value = perform_save(find_stream_by_id(inst.value[0]));
639         pop_callstub(value);
640         break;
641
642       case op_restore:
643         profile_fail("restore");
644         value = perform_restore(find_stream_by_id(inst.value[0]));
645         if (value == 0) {
646           /* We've succeeded, and the stack now contains the callstub
647              saved during saveundo. Ignore this opcode's operand. */
648           value = -1;
649           pop_callstub(value);
650         }
651         else {
652           /* We've failed, so we must store the failure in this opcode's
653              operand. */
654           store_operand(inst.desttype, inst.value[1], value);
655         }
656         break;
657
658       case op_saveundo:
659         push_callstub(inst.desttype, inst.value[0]);
660         value = perform_saveundo();
661         pop_callstub(value);
662         break;
663
664       case op_restoreundo:
665         profile_fail("restoreundo");
666         value = perform_restoreundo();
667         if (value == 0) {
668           /* We've succeeded, and the stack now contains the callstub
669              saved during saveundo. Ignore this opcode's operand. */
670           value = -1;
671           pop_callstub(value);
672         }
673         else {
674           /* We've failed, so we must store the failure in this opcode's
675              operand. */
676           store_operand(inst.desttype, inst.value[0], value);
677         }
678         break;
679
680       case op_quit:
681         done_executing = TRUE;
682         break;
683
684       case op_linearsearch:
685         value = linear_search(inst.value[0], inst.value[1], inst.value[2], 
686           inst.value[3], inst.value[4], inst.value[5], inst.value[6]);
687         store_operand(inst.desttype, inst.value[7], value);
688         break;
689       case op_binarysearch:
690         value = binary_search(inst.value[0], inst.value[1], inst.value[2], 
691           inst.value[3], inst.value[4], inst.value[5], inst.value[6]);
692         store_operand(inst.desttype, inst.value[7], value);
693         break;
694       case op_linkedsearch:
695         value = linked_search(inst.value[0], inst.value[1], inst.value[2], 
696           inst.value[3], inst.value[4], inst.value[5]);
697         store_operand(inst.desttype, inst.value[6], value);
698         break;
699
700       case op_mzero: {
701         glui32 lx;
702         glui32 count = inst.value[0];
703         addr = inst.value[1];
704         for (lx=0; lx<count; lx++, addr++) {
705           MemW1(addr, 0);
706         }
707         }
708         break;
709       case op_mcopy: {
710         glui32 lx;
711         glui32 count = inst.value[0];
712         glui32 addrsrc = inst.value[1];
713         glui32 addrdest = inst.value[2];
714         if (addrdest < addrsrc) {
715           for (lx=0; lx<count; lx++, addrsrc++, addrdest++) {
716             value = Mem1(addrsrc);
717             MemW1(addrdest, value);
718           }
719         }
720         else {
721           addrsrc += (count-1);
722           addrdest += (count-1);
723           for (lx=0; lx<count; lx++, addrsrc--, addrdest--) {
724             value = Mem1(addrsrc);
725             MemW1(addrdest, value);
726           }
727         }
728         }
729         break;
730       case op_malloc:
731         value = heap_alloc(inst.value[0]);
732         store_operand(inst.desttype, inst.value[1], value);
733         break;
734       case op_mfree:
735         heap_free(inst.value[0]);
736         break;
737
738       case op_accelfunc:
739         accel_set_func(inst.value[0], inst.value[1]);
740         break;
741       case op_accelparam:
742         accel_set_param(inst.value[0], inst.value[1]);
743         break;
744
745       default:
746         fatal_error_i("Executed unknown opcode.", opcode);
747       }
748     }
749   }
750 }