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