interpreters/glulxe/glkop.c

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