Implemented garglk_set_program_name(), garglk_set_program_info(), garglk_set_story_name()
[rodin/chimara.git] / interpreters / git / glkop.c
1 // $Id: glkop.c,v 1.4 2004/12/22 14:33:40 iain Exp $
2
3 // glkop.c: Glulxe code for Glk API dispatching.
4 //  Designed by Andrew Plotkin <erkyrath@eblong.com>
5 //  http://www.eblong.com/zarf/glulx/index.html
6
7 /* This code is actually very general; it could work for almost any
8    32-bit VM which remotely resembles Glulxe or the Z-machine in design.
9    
10    To be precise, we make the following assumptions:
11
12    - An argument list is an array of 32-bit values, which can represent
13      either integers or addresses.
14    - We can read or write to a 32-bit integer in VM memory using the macros
15      ReadMemory(addr) and WriteMemory(addr), where addr is an address
16      taken from the argument list.
17    - A character array is an actual array of bytes somewhere in terp
18      memory, whose actual address can be computed by the macro
19      AddressOfArray(addr). Again, addr is a VM address from the argument
20      list.
21    - An integer array is a sequence of integers somewhere in VM memory.
22      The array can be turned into a C integer array by the macro
23      CaptureIArray(addr, len), and released by ReleaseIArray().
24      These macros are responsible for fixing byte-order and alignment
25      (if the C ABI does not match the VM's). The passin, passout hints
26      may be used to avoid unnecessary copying.
27    - A Glk structure (such as event_t) is a set of integers somewhere
28      in VM memory, which can be read and written with the macros
29      ReadStructField(addr, fieldnum) and WriteStructField(addr, fieldnum).
30      The fieldnum is an integer (from 0 to 3, for event_t.)
31    - A VM string can be turned into a C-style string with the macro
32      ptr = DecodeVMString(addr). After the string is used, this code
33      calls ReleaseVMString(ptr), which should free any memory that
34      DecodeVMString allocates.
35    - A VM Unicode string can be turned into a zero-terminated array
36      of 32-bit integers, in the same way, with DecodeVMUstring
37      and ReleaseVMUstring.
38
39      To work this code over for a new VM, just diddle the macros.
40 */
41
42 #define Stk1(sp)   \
43   (*((unsigned char *)(sp)))
44 #define Stk2(sp)   \
45   (*((glui16 *)(sp)))
46 #define Stk4(sp)   \
47   (*((glui32 *)(sp)))
48
49 #define StkW1(sp, vl)   \
50   (*((unsigned char *)(sp)) = (unsigned char)(vl))
51 #define StkW2(sp, vl)   \
52   (*((glui16 *)(sp)) = (glui16)(vl))
53 #define StkW4(sp, vl)   \
54   (*((glui32 *)(sp)) = (glui32)(vl))
55
56
57 #define ReadMemory(addr)  \
58     (((addr) == 0xffffffff) \
59       ? (gStackPointer -= 1, Stk4(gStackPointer)) \
60       : (memRead32(addr)))
61 #define WriteMemory(addr, val)  \
62     if ((addr) == 0xffffffff) \
63     { StkW4(gStackPointer, (val)); gStackPointer += 1;} \
64         else memWrite32((addr), (val))
65 #define AddressOfArray(addr)  \
66         ((addr) < gRamStart ? (gRom + (addr)) : (gRam + (addr)))
67 #define AddressOfIArray(addr)  \
68         ((addr) < gRamStart ? (gRom + (addr)) : (gRam + (addr)))
69 #define CaptureIArray(addr, len, passin)  \
70     (grab_temp_array(addr, len, passin))
71 #define ReleaseIArray(ptr, addr, len, passout)  \
72     (release_temp_array(ptr, addr, len, passout))
73 #define ReadStructField(addr, fieldnum)  \
74     (((addr) == 0xffffffff) \
75       ? (gStackPointer -= 1, Stk4(gStackPointer)) \
76       : (memRead32((addr)+(fieldnum)*4)))
77 #define WriteStructField(addr, fieldnum, val)  \
78     if ((addr) == 0xffffffff) \
79     { StkW4(gStackPointer, (val)); gStackPointer += 1;} \
80         else memWrite32((addr)+(fieldnum)*4, (val))
81
82 #define glulx_malloc malloc
83 #define glulx_free free
84 #define glulx_random rand
85
86 #ifndef TRUE
87 #define TRUE 1
88 #endif
89 #ifndef FALSE
90 #define FALSE 0
91 #endif
92
93 #include "glk.h"
94 #include "git.h"
95 #include "gi_dispa.h"
96
97 static char * DecodeVMString (git_uint32 addr)
98 {
99     glui32 end;
100     char * data;
101     char * c;
102     
103     // The string must be a C string.
104     if (memRead8(addr) != 0xE0)
105     {
106         fatalError ("Illegal string type passed to Glk function");
107     }
108     addr += 1;
109     
110     end = addr;
111     while (memRead8(end) != 0)
112         ++end;
113     
114     data = glulx_malloc (end - addr + 1);
115     if (data == NULL)
116         fatalError ("Couldn't allocate string");
117
118     c = data;
119     while (addr < end)
120         *c++ = memRead8(addr++);
121     *c = 0;
122     
123     return data;
124 }
125
126 static glui32 * DecodeVMUstring (git_uint32 addr)
127 {
128     glui32 end;
129     glui32 * data;
130     glui32 * c;
131     
132     // The string must be a Unicode string.
133     if (memRead8(addr) != 0xE2)
134     {
135         fatalError ("Illegal string type passed to Glk function");
136     }
137     addr += 4;
138     
139     end = addr;
140     while (memRead32(end) != 0)
141         end += 4;
142     
143     data = glulx_malloc (end - addr + 4);
144     if (data == NULL)
145         fatalError ("Couldn't allocate string");
146
147     c = data;
148     while (addr < end)
149     {
150         *c++ = memRead32(addr);
151         addr += 4;
152     }
153     *c = 0;
154     
155     return data;
156 }
157
158 static void ReleaseVMString (char * ptr)
159 {
160     glulx_free (ptr);
161 }
162
163 static void ReleaseVMUstring (glui32 * ptr)
164 {
165     glulx_free (ptr);
166 }
167
168 typedef struct dispatch_splot_struct {
169   int numwanted;
170   int maxargs;
171   gluniversal_t *garglist;
172   glui32 *varglist;
173   int numvargs;
174   glui32 *retval;
175 } dispatch_splot_t;
176
177 /* We maintain a linked list of arrays being used for Glk calls. It is
178    only used for integer (glui32) arrays -- char arrays are handled in
179    place. It's not worth bothering with a hash table, since most
180    arrays appear here only momentarily. */
181
182 typedef struct arrayref_struct arrayref_t;
183 struct arrayref_struct {
184   void *array;
185   glui32 addr;
186   glui32 elemsize;
187   glui32 len; /* elements */
188   int retained;
189   arrayref_t *next;
190 };
191
192 static arrayref_t *arrays = NULL;
193
194 /* We maintain a hash table for each opaque Glk class. classref_t are the
195     nodes of the table, and classtable_t are the tables themselves. */
196
197 typedef struct classref_struct classref_t;
198 struct classref_struct {
199   void *obj;
200   glui32 id;
201   int bucknum;
202   classref_t *next;
203 };
204
205 #define CLASSHASH_SIZE (31)
206 typedef struct classtable_struct {
207   glui32 lastid;
208   classref_t *bucket[CLASSHASH_SIZE];
209 } classtable_t;
210
211 /* The list of hash tables, for the git_classes. */
212 static int num_classes = 0;
213 classtable_t **git_classes = NULL;
214
215 static classtable_t *new_classtable(glui32 firstid);
216 static void *classes_get(int classid, glui32 objid);
217 static classref_t *classes_put(int classid, void *obj);
218 static void classes_remove(int classid, void *obj);
219
220 static gidispatch_rock_t glulxe_classtable_register(void *obj, 
221   glui32 objclass);
222 static void glulxe_classtable_unregister(void *obj, glui32 objclass, 
223   gidispatch_rock_t objrock);
224 static gidispatch_rock_t glulxe_retained_register(void *array,
225   glui32 len, char *typecode);
226 static void glulxe_retained_unregister(void *array, glui32 len, 
227   char *typecode, gidispatch_rock_t objrock);
228
229 static glui32 *grab_temp_array(glui32 addr, glui32 len, int passin);
230 static void release_temp_array(glui32 *arr, glui32 addr, glui32 len, int passout);
231
232 static void prepare_glk_args(char *proto, dispatch_splot_t *splot);
233 static void parse_glk_args(dispatch_splot_t *splot, char **proto, int depth,
234   int *argnumptr, glui32 subaddress, int subpassin);
235 static void unparse_glk_args(dispatch_splot_t *splot, char **proto, int depth,
236   int *argnumptr, glui32 subaddress, int subpassout);
237
238 /* init_dispatch():
239    Set up the class hash tables and other startup-time stuff. 
240 */
241 int git_init_dispatch()
242 {
243   int ix;
244     
245   /* Allocate the class hash tables. */
246   num_classes = gidispatch_count_classes();
247   git_classes = (classtable_t **)glulx_malloc(num_classes 
248     * sizeof(classtable_t *));
249   if (!git_classes)
250     return FALSE;
251     
252   for (ix=0; ix<num_classes; ix++) {
253     git_classes[ix] = new_classtable((glulx_random() % (glui32)(101)) + 1);
254     if (!git_classes[ix])
255       return FALSE;
256   }
257     
258   /* Set up the two callbacks. */
259   gidispatch_set_object_registry(&glulxe_classtable_register, 
260     &glulxe_classtable_unregister);
261   gidispatch_set_retained_registry(&glulxe_retained_register, 
262     &glulxe_retained_unregister);
263     
264   return TRUE;
265 }
266
267 /* perform_glk():
268    Turn a list of Glulx arguments into a list of Glk arguments,
269    dispatch the function call, and return the result. 
270 */
271 glui32 git_perform_glk(glui32 funcnum, glui32 numargs, glui32 *arglist)
272 {
273   glui32 retval = 0;
274
275   switch (funcnum) {
276     /* To speed life up, we implement commonly-used Glk functions
277        directly -- instead of bothering with the whole prototype 
278        mess. */
279
280   case 0x0080: /* put_char */
281     if (numargs != 1)
282       goto WrongArgNum;
283     glk_put_char(arglist[0] & 0xFF);
284     break;
285   case 0x0081: /* put_char_stream */
286     if (numargs != 2)
287       goto WrongArgNum;
288     glk_put_char_stream(git_find_stream_by_id(arglist[0]), arglist[1] & 0xFF);
289     break;
290   case 0x00A0: /* char_to_lower */
291     if (numargs != 1)
292       goto WrongArgNum;
293     retval = glk_char_to_lower(arglist[0] & 0xFF);
294     break;
295   case 0x00A1: /* char_to_upper */
296     if (numargs != 1)
297       goto WrongArgNum;
298     retval = glk_char_to_upper(arglist[0] & 0xFF);
299     break;
300
301   WrongArgNum:
302     fatalError("Wrong number of arguments to Glk function.");
303     break;
304
305   default: {
306     /* Go through the full dispatcher prototype foo. */
307     char *proto, *cx;
308     dispatch_splot_t splot;
309     int argnum;
310
311     /* Grab the string. */
312     proto = gidispatch_prototype(funcnum);
313     if (!proto)
314       fatalError("Unknown Glk function.");
315
316     splot.varglist = arglist;
317     splot.numvargs = numargs;
318     splot.retval = &retval;
319
320     /* The work goes in four phases. First, we figure out how many
321        arguments we want, and allocate space for the Glk argument
322        list. Then we go through the Glulxe arguments and load them 
323        into the Glk list. Then we call. Then we go through the 
324        arguments again, unloading the data back into Glulx memory. */
325
326     /* Phase 0. */
327     prepare_glk_args(proto, &splot);
328
329     /* Phase 1. */
330     argnum = 0;
331     cx = proto;
332     parse_glk_args(&splot, &cx, 0, &argnum, 0, 0);
333
334     /* Phase 2. */
335     gidispatch_call(funcnum, argnum, splot.garglist);
336
337     /* Phase 3. */
338     argnum = 0;
339     cx = proto;
340     unparse_glk_args(&splot, &cx, 0, &argnum, 0, 0);
341
342     break;
343   }
344   }
345
346   return retval;
347 }
348
349 /* read_prefix():
350    Read the prefixes of an argument string -- the "<>&+:#!" chars. 
351 */
352 static char *read_prefix(char *cx, int *isref, int *isarray,
353   int *passin, int *passout, int *nullok, int *isretained, 
354   int *isreturn)
355 {
356   *isref = FALSE;
357   *passin = FALSE;
358   *passout = FALSE;
359   *nullok = TRUE;
360   *isarray = FALSE;
361   *isretained = FALSE;
362   *isreturn = FALSE;
363   while (1) {
364     if (*cx == '<') {
365       *isref = TRUE;
366       *passout = TRUE;
367     }
368     else if (*cx == '>') {
369       *isref = TRUE;
370       *passin = TRUE;
371     }
372     else if (*cx == '&') {
373       *isref = TRUE;
374       *passout = TRUE;
375       *passin = TRUE;
376     }
377     else if (*cx == '+') {
378       *nullok = FALSE;
379     }
380     else if (*cx == ':') {
381       *isref = TRUE;
382       *passout = TRUE;
383       *nullok = FALSE;
384       *isreturn = TRUE;
385     }
386     else if (*cx == '#') {
387       *isarray = TRUE;
388     }
389     else if (*cx == '!') {
390       *isretained = TRUE;
391     }
392     else {
393       break;
394     }
395     cx++;
396   }
397   return cx;
398 }
399
400 /* prepare_glk_args():
401    This reads through the prototype string, and pulls Floo objects off the
402    stack. It also works out the maximal number of gluniversal_t objects
403    which could be used by the Glk call in question. It then allocates
404    space for them.
405 */
406 static void prepare_glk_args(char *proto, dispatch_splot_t *splot)
407 {
408   static gluniversal_t *garglist = NULL;
409   static int garglist_size = 0;
410
411   int ix;
412   int numwanted, numvargswanted, maxargs;
413   char *cx;
414
415   cx = proto;
416   numwanted = 0;
417   while (*cx >= '0' && *cx <= '9') {
418     numwanted = 10 * numwanted + (*cx - '0');
419     cx++;
420   }
421   splot->numwanted = numwanted;
422
423   maxargs = 0; 
424   numvargswanted = 0; 
425   for (ix = 0; ix < numwanted; ix++) {
426     int isref, passin, passout, nullok, isarray, isretained, isreturn;
427     cx = read_prefix(cx, &isref, &isarray, &passin, &passout, &nullok,
428       &isretained, &isreturn);
429     if (isref) {
430       maxargs += 2;
431     }
432     else {
433       maxargs += 1;
434     }
435     if (!isreturn) {
436       if (isarray) {
437         numvargswanted += 2;
438       }
439       else {
440         numvargswanted += 1;
441       }
442     }
443         
444     if (*cx == 'I' || *cx == 'C') {
445       cx += 2;
446     }
447     else if (*cx == 'Q') {
448       cx += 2;
449     }
450     else if (*cx == 'S' || *cx == 'U') {
451       cx += 1;
452     }
453     else if (*cx == '[') {
454       int refdepth, nwx;
455       cx++;
456       nwx = 0;
457       while (*cx >= '0' && *cx <= '9') {
458         nwx = 10 * nwx + (*cx - '0');
459         cx++;
460       }
461       maxargs += nwx; /* This is *only* correct because all structs contain
462                          plain values. */
463       refdepth = 1;
464       while (refdepth > 0) {
465         if (*cx == '[')
466           refdepth++;
467         else if (*cx == ']')
468           refdepth--;
469         cx++;
470       }
471     }
472     else {
473       fatalError("Illegal format string.");
474     }
475   }
476
477   if (*cx != ':' && *cx != '\0')
478     fatalError("Illegal format string.");
479
480   splot->maxargs = maxargs;
481
482   if (splot->numvargs != numvargswanted)
483     fatalError("Wrong number of arguments to Glk function.");
484
485   if (garglist && garglist_size < maxargs) {
486     glulx_free(garglist);
487     garglist = NULL;
488     garglist_size = 0;
489   }
490   if (!garglist) {
491     garglist_size = maxargs + 16;
492     garglist = (gluniversal_t *)glulx_malloc(garglist_size 
493       * sizeof(gluniversal_t));
494   }
495   if (!garglist)
496     fatalError("Unable to allocate storage for Glk arguments.");
497
498   splot->garglist = garglist;
499 }
500
501 /* parse_glk_args():
502    This long and unpleasant function translates a set of Floo objects into
503    a gluniversal_t array. It's recursive, too, to deal with structures.
504 */
505 static void parse_glk_args(dispatch_splot_t *splot, char **proto, int depth,
506   int *argnumptr, glui32 subaddress, int subpassin)
507 {
508   char *cx;
509   int ix, argx;
510   int gargnum, numwanted;
511   void *opref;
512   gluniversal_t *garglist;
513   glui32 *varglist;
514   
515   garglist = splot->garglist;
516   varglist = splot->varglist;
517   gargnum = *argnumptr;
518   cx = *proto;
519
520   numwanted = 0;
521   while (*cx >= '0' && *cx <= '9') {
522     numwanted = 10 * numwanted + (*cx - '0');
523     cx++;
524   }
525
526   for (argx = 0, ix = 0; argx < numwanted; argx++, ix++) {
527     char typeclass;
528     int skipval;
529     int isref, passin, passout, nullok, isarray, isretained, isreturn;
530     cx = read_prefix(cx, &isref, &isarray, &passin, &passout, &nullok,
531       &isretained, &isreturn);
532     
533     typeclass = *cx;
534     cx++;
535
536     skipval = FALSE;
537     if (isref) {
538       if (!isreturn && varglist[ix] == 0) {
539         if (!nullok)
540           fatalError("Zero passed invalidly to Glk function.");
541         garglist[gargnum].ptrflag = FALSE;
542         gargnum++;
543         skipval = TRUE;
544       }
545       else {
546         garglist[gargnum].ptrflag = TRUE;
547         gargnum++;
548       }
549     }
550     if (!skipval) {
551       glui32 thisval;
552
553       if (typeclass == '[') {
554
555         parse_glk_args(splot, &cx, depth+1, &gargnum, varglist[ix], passin);
556
557       }
558       else if (isarray) {
559         /* definitely isref */
560
561         switch (typeclass) {
562         case 'C':
563           garglist[gargnum].array = (void*) AddressOfArray(varglist[ix]);
564           gargnum++;
565           ix++;
566           garglist[gargnum].uint = varglist[ix];
567           gargnum++;
568           cx++;
569           break;
570         case 'I':
571           garglist[gargnum].array = CaptureIArray(varglist[ix], varglist[ix+1], passin);
572           gargnum++;
573           ix++;
574           garglist[gargnum].uint = varglist[ix];
575           gargnum++;
576           cx++;
577           break;
578         default:
579           fatalError("Illegal format string.");
580           break;
581         }
582       }
583       else {
584         /* a plain value or a reference to one. */
585
586         if (isreturn) {
587           thisval = 0;
588         }
589         else if (depth > 0) {
590           /* Definitely not isref or isarray. */
591           if (subpassin)
592             thisval = ReadStructField(subaddress, ix);
593           else
594             thisval = 0;
595         }
596         else if (isref) {
597           if (passin)
598             thisval = ReadMemory(varglist[ix]);
599           else
600             thisval = 0;
601         }
602         else {
603           thisval = varglist[ix];
604         }
605
606         switch (typeclass) {
607         case 'I':
608           if (*cx == 'u')
609             garglist[gargnum].uint = (glui32)(thisval);
610           else if (*cx == 's')
611             garglist[gargnum].sint = (glsi32)(thisval);
612           else
613             fatalError("Illegal format string.");
614           gargnum++;
615           cx++;
616           break;
617         case 'Q':
618           if (thisval) {
619             opref = classes_get(*cx-'a', thisval);
620             if (!opref) {
621               fatalError("Reference to nonexistent Glk object.");
622             }
623           }
624           else {
625             opref = NULL;
626           }
627           garglist[gargnum].opaqueref = opref;
628           gargnum++;
629           cx++;
630           break;
631         case 'C':
632           if (*cx == 'u') 
633             garglist[gargnum].uch = (unsigned char)(thisval);
634           else if (*cx == 's')
635             garglist[gargnum].sch = (signed char)(thisval);
636           else if (*cx == 'n')
637             garglist[gargnum].ch = (char)(thisval);
638           else
639             fatalError("Illegal format string.");
640           gargnum++;
641           cx++;
642           break;
643         case 'S':
644           garglist[gargnum].charstr = DecodeVMString(thisval);
645           gargnum++;
646           break;
647 #ifdef GLK_MODULE_UNICODE
648         case 'U':
649           garglist[gargnum].unicharstr = DecodeVMUstring(thisval);
650               gargnum++;
651           break;
652 #endif
653         default:
654           fatalError("Illegal format string.");
655           break;
656         }
657       }
658     }
659     else {
660       /* We got a null reference, so we have to skip the format element. */
661       if (typeclass == '[') {
662         int numsubwanted, refdepth;
663         numsubwanted = 0;
664         while (*cx >= '0' && *cx <= '9') {
665           numsubwanted = 10 * numsubwanted + (*cx - '0');
666           cx++;
667         }
668         refdepth = 1;
669         while (refdepth > 0) {
670           if (*cx == '[')
671             refdepth++;
672           else if (*cx == ']')
673             refdepth--;
674           cx++;
675         }
676       }
677       else if (typeclass == 'S' || typeclass == 'U') {
678         /* leave it */
679       }
680       else {
681         cx++;
682       }
683     }    
684   }
685
686   if (depth > 0) {
687     if (*cx != ']')
688       fatalError("Illegal format string.");
689     cx++;
690   }
691   else {
692     if (*cx != ':' && *cx != '\0')
693       fatalError("Illegal format string.");
694   }
695   
696   *proto = cx;
697   *argnumptr = gargnum;
698 }
699
700 /* unparse_glk_args():
701    This is about the reverse of parse_glk_args(). 
702 */
703 static void unparse_glk_args(dispatch_splot_t *splot, char **proto, int depth,
704   int *argnumptr, glui32 subaddress, int subpassout)
705 {
706   char *cx;
707   int ix, argx;
708   int gargnum, numwanted;
709   void *opref;
710   gluniversal_t *garglist;
711   glui32 *varglist;
712   
713   garglist = splot->garglist;
714   varglist = splot->varglist;
715   gargnum = *argnumptr;
716   cx = *proto;
717
718   numwanted = 0;
719   while (*cx >= '0' && *cx <= '9') {
720     numwanted = 10 * numwanted + (*cx - '0');
721     cx++;
722   }
723
724   for (argx = 0, ix = 0; argx < numwanted; argx++, ix++) {
725     char typeclass;
726     int skipval;
727     int isref, passin, passout, nullok, isarray, isretained, isreturn;
728     cx = read_prefix(cx, &isref, &isarray, &passin, &passout, &nullok,
729       &isretained, &isreturn);
730     
731     typeclass = *cx;
732     cx++;
733
734     skipval = FALSE;
735     if (isref) {
736       if (!isreturn && varglist[ix] == 0) {
737         if (!nullok)
738           fatalError("Zero passed invalidly to Glk function.");
739         garglist[gargnum].ptrflag = FALSE;
740         gargnum++;
741         skipval = TRUE;
742       }
743       else {
744         garglist[gargnum].ptrflag = TRUE;
745         gargnum++;
746       }
747     }
748     if (!skipval) {
749       glui32 thisval = 0;
750
751       if (typeclass == '[') {
752
753         unparse_glk_args(splot, &cx, depth+1, &gargnum, varglist[ix], passout);
754
755       }
756       else if (isarray) {
757         /* definitely isref */
758
759         switch (typeclass) {
760         case 'C':
761           gargnum++;
762           ix++;
763           gargnum++;
764           cx++;
765           break;
766         case 'I':
767           ReleaseIArray(garglist[gargnum].array, varglist[ix], varglist[ix+1], passout);
768           gargnum++;
769           ix++;
770           gargnum++;
771           cx++;
772           break;
773         default:
774           fatalError("Illegal format string.");
775           break;
776         }
777       }
778       else {
779         /* a plain value or a reference to one. */
780
781         if (isreturn || (depth > 0 && subpassout) || (isref && passout)) {
782           skipval = FALSE;
783         }
784         else {
785           skipval = TRUE;
786         }
787
788         switch (typeclass) {
789         case 'I':
790           if (!skipval) {
791             if (*cx == 'u')
792               thisval = (glui32)garglist[gargnum].uint;
793             else if (*cx == 's')
794               thisval = (glui32)garglist[gargnum].sint;
795             else
796               fatalError("Illegal format string.");
797           }
798           gargnum++;
799           cx++;
800           break;
801         case 'Q':
802           if (!skipval) {
803             opref = garglist[gargnum].opaqueref;
804             if (opref) {
805               gidispatch_rock_t objrock = 
806                 gidispatch_get_objrock(opref, *cx-'a');
807               thisval = ((classref_t *)objrock.ptr)->id;
808             }
809             else {
810               thisval = 0;
811             }
812           }
813           gargnum++;
814           cx++;
815           break;
816         case 'C':
817           if (!skipval) {
818             if (*cx == 'u') 
819               thisval = (glui32)garglist[gargnum].uch;
820             else if (*cx == 's')
821               thisval = (glui32)garglist[gargnum].sch;
822             else if (*cx == 'n')
823               thisval = (glui32)garglist[gargnum].ch;
824             else
825               fatalError("Illegal format string.");
826           }
827           gargnum++;
828           cx++;
829           break;
830         case 'S':
831           if (garglist[gargnum].charstr)
832             ReleaseVMString(garglist[gargnum].charstr);
833           gargnum++;
834           break;
835 #ifdef GLK_MODULE_UNICODE
836         case 'U':
837           if (garglist[gargnum].unicharstr)
838             ReleaseVMUstring(garglist[gargnum].unicharstr);
839           gargnum++;
840           break;
841 #endif
842         default:
843           fatalError("Illegal format string.");
844           break;
845         }
846
847         if (isreturn) {
848           *(splot->retval) = thisval;
849         }
850         else if (depth > 0) {
851           /* Definitely not isref or isarray. */
852           if (subpassout)
853           {
854             WriteStructField(subaddress, ix, thisval);
855           }
856         }
857         else if (isref) {
858           if (passout)
859           {
860             WriteMemory(varglist[ix], thisval);
861           }
862         }
863       }
864     }
865     else {
866       /* We got a null reference, so we have to skip the format element. */
867       if (typeclass == '[') {
868         int numsubwanted, refdepth;
869         numsubwanted = 0;
870         while (*cx >= '0' && *cx <= '9') {
871           numsubwanted = 10 * numsubwanted + (*cx - '0');
872           cx++;
873         }
874         refdepth = 1;
875         while (refdepth > 0) {
876           if (*cx == '[')
877             refdepth++;
878           else if (*cx == ']')
879             refdepth--;
880           cx++;
881         }
882       }
883       else if (typeclass == 'S' || typeclass == 'U') {
884         /* leave it */
885       }
886       else {
887         cx++;
888       }
889     }    
890   }
891
892   if (depth > 0) {
893     if (*cx != ']')
894       fatalError("Illegal format string.");
895     cx++;
896   }
897   else {
898     if (*cx != ':' && *cx != '\0')
899       fatalError("Illegal format string.");
900   }
901   
902   *proto = cx;
903   *argnumptr = gargnum;
904 }
905
906 /* find_stream_by_id():
907    This is used by some interpreter code which has to, well, find a Glk
908    stream given its ID. 
909 */
910 strid_t git_find_stream_by_id(glui32 objid)
911 {
912   if (!objid)
913     return NULL;
914
915   /* Recall that class 1 ("b") is streams. */
916   return classes_get(1, objid);
917 }
918
919 /* Build a hash table to hold a set of Glk objects. */
920 static classtable_t *new_classtable(glui32 firstid)
921 {
922   int ix;
923   classtable_t *ctab = (classtable_t *)glulx_malloc(sizeof(classtable_t));
924   if (!ctab)
925     return NULL;
926     
927   for (ix=0; ix<CLASSHASH_SIZE; ix++)
928     ctab->bucket[ix] = NULL;
929     
930   ctab->lastid = firstid;
931     
932   return ctab;
933 }
934
935 /* Find a Glk object in the appropriate hash table. */
936 static void *classes_get(int classid, glui32 objid)
937 {
938   classtable_t *ctab;
939   classref_t *cref;
940   if (classid < 0 || classid >= num_classes)
941     return NULL;
942   ctab = git_classes[classid];
943   cref = ctab->bucket[objid % CLASSHASH_SIZE];
944   for (; cref; cref = cref->next) {
945     if (cref->id == objid)
946       return cref->obj;
947   }
948   return NULL;
949 }
950
951 /* Put a Glk object in the appropriate hash table. */
952 static classref_t *classes_put(int classid, void *obj)
953 {
954   int bucknum;
955   classtable_t *ctab;
956   classref_t *cref;
957   if (classid < 0 || classid >= num_classes)
958     return NULL;
959   ctab = git_classes[classid];
960   cref = (classref_t *)glulx_malloc(sizeof(classref_t));
961   if (!cref)
962     return NULL;
963   cref->obj = obj;
964   cref->id = ctab->lastid;
965   ctab->lastid++;
966   bucknum = cref->id % CLASSHASH_SIZE;
967   cref->bucknum = bucknum;
968   cref->next = ctab->bucket[bucknum];
969   ctab->bucket[bucknum] = cref;
970   return cref;
971 }
972
973 /* Delete a Glk object from the appropriate hash table. */
974 static void classes_remove(int classid, void *obj)
975 {
976   classtable_t *ctab;
977   classref_t *cref;
978   classref_t **crefp;
979   gidispatch_rock_t objrock;
980   if (classid < 0 || classid >= num_classes)
981     return;
982   ctab = git_classes[classid];
983   objrock = gidispatch_get_objrock(obj, classid);
984   cref = objrock.ptr;
985   if (!cref)
986     return;
987   crefp = &(ctab->bucket[cref->bucknum]);
988   for (; *crefp; crefp = &((*crefp)->next)) {
989     if ((*crefp) == cref) {
990       *crefp = cref->next;
991       if (!cref->obj) {
992         fprintf(stderr, "attempt to free NULL object!\n");
993       }
994       cref->obj = NULL;
995       cref->id = 0;
996       cref->next = NULL;
997       glulx_free(cref);
998       return;
999     }
1000   }
1001   return;
1002 }
1003
1004 /* The object registration/unregistration callbacks that the library calls
1005     to keep the hash tables up to date. */
1006     
1007 static gidispatch_rock_t glulxe_classtable_register(void *obj, 
1008   glui32 objclass)
1009 {
1010   classref_t *cref;
1011   gidispatch_rock_t objrock;
1012   cref = classes_put(objclass, obj);
1013   objrock.ptr = cref;
1014   return objrock;
1015 }
1016
1017 static void glulxe_classtable_unregister(void *obj, glui32 objclass, 
1018   gidispatch_rock_t objrock)
1019 {
1020   classes_remove(objclass, obj);
1021 }
1022
1023 static glui32 *grab_temp_array(glui32 addr, glui32 len, int passin)
1024 {
1025   arrayref_t *arref = NULL;
1026   glui32 *arr = NULL;
1027   glui32 ix, addr2;
1028
1029   if (len) {
1030     arr = (glui32 *)glulx_malloc(len * sizeof(glui32));
1031     arref = (arrayref_t *)glulx_malloc(sizeof(arrayref_t));
1032     if (!arr || !arref) 
1033       fatalError("Unable to allocate space for array argument to Glk call.");
1034
1035     arref->array = arr;
1036     arref->addr = addr;
1037     arref->elemsize = 4;
1038     arref->retained = FALSE;
1039     arref->len = len;
1040     arref->next = arrays;
1041     arrays = arref;
1042
1043     if (passin) {
1044       for (ix=0, addr2=addr; ix<len; ix++, addr2+=4) {
1045         arr[ix] = memRead32(addr2);
1046       }
1047     }
1048   }
1049
1050   return arr;
1051 }
1052
1053 static void release_temp_array(glui32 *arr, glui32 addr, glui32 len, int passout)
1054 {
1055   arrayref_t *arref = NULL;
1056   arrayref_t **aptr;
1057   glui32 ix, val, addr2;
1058
1059   if (arr) {
1060     for (aptr=(&arrays); (*aptr); aptr=(&((*aptr)->next))) {
1061       if ((*aptr)->array == arr)
1062         break;
1063     }
1064     arref = *aptr;
1065     if (!arref)
1066       fatalError("Unable to re-find array argument in Glk call.");
1067     if (arref->addr != addr || arref->len != len)
1068       fatalError("Mismatched array argument in Glk call.");
1069
1070     if (arref->retained) {
1071       return;
1072     }
1073
1074     *aptr = arref->next;
1075     arref->next = NULL;
1076
1077     if (passout) {
1078       for (ix=0, addr2=addr; ix<len; ix++, addr2+=4) {
1079         val = arr[ix];
1080         memWrite32(addr2, val);
1081       }
1082     }
1083     glulx_free(arr);
1084     glulx_free(arref);
1085   }
1086 }
1087
1088 gidispatch_rock_t glulxe_retained_register(void *array,
1089   glui32 len, char *typecode)
1090 {
1091   gidispatch_rock_t rock;
1092   arrayref_t *arref = NULL;
1093   arrayref_t **aptr;
1094
1095   if (typecode[4] != 'I' || array == NULL) {
1096     /* We only retain integer arrays. */
1097     rock.ptr = NULL;
1098     return rock;
1099   }
1100
1101   for (aptr=(&arrays); (*aptr); aptr=(&((*aptr)->next))) {
1102     if ((*aptr)->array == array)
1103       break;
1104   }
1105   arref = *aptr;
1106   if (!arref)
1107     fatalError("Unable to re-find array argument in Glk call.");
1108   if (arref->elemsize != 4 || arref->len != len)
1109     fatalError("Mismatched array argument in Glk call.");
1110
1111   arref->retained = TRUE;
1112
1113   rock.ptr = arref;
1114   return rock;
1115 }
1116
1117 void glulxe_retained_unregister(void *array, glui32 len, 
1118   char *typecode, gidispatch_rock_t objrock)
1119 {
1120   arrayref_t *arref = NULL;
1121   arrayref_t **aptr;
1122   glui32 ix, addr2, val;
1123
1124   if (typecode[4] != 'I' || array == NULL) {
1125     /* We only retain integer arrays. */
1126     return;
1127   }
1128
1129   for (aptr=(&arrays); (*aptr); aptr=(&((*aptr)->next))) {
1130     if ((*aptr)->array == array)
1131       break;
1132   }
1133   arref = *aptr;
1134   if (!arref)
1135     fatalError("Unable to re-find array argument in Glk call.");
1136   if (arref != objrock.ptr)
1137     fatalError("Mismatched array reference in Glk call.");
1138   if (!arref->retained)
1139     fatalError("Unretained array reference in Glk call.");
1140   if (arref->elemsize != 4 || arref->len != len)
1141     fatalError("Mismatched array argument in Glk call.");
1142
1143   for (ix=0, addr2=arref->addr; ix<arref->len; ix++, addr2+=4) {
1144     val = ((glui32 *)array)[ix];
1145     memWrite32(addr2, val);
1146   }
1147   glulx_free(array);
1148   glulx_free(arref);
1149 }
1150