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           garglist[gargnum].array = AddressOfArray(varglist[ix]);
 472           gargnum++;
 473           ix++;
 474           garglist[gargnum].uint = varglist[ix];
 475           gargnum++;
 476           cx++;
 477           break;
 478         case 'I':
 479           garglist[gargnum].array = CaptureIArray(varglist[ix], varglist[ix+1], passin);
 480           gargnum++;
 481           ix++;
 482           garglist[gargnum].uint = varglist[ix];
 483           gargnum++;
 484           cx++;
 485           break;
 486         default:
 487           fatal_error("Illegal format string.");
 488           break;
 489         }
 490       }
 491       else {
 492         /* a plain value or a reference to one. */
 493
 494         if (isreturn) {
 495           thisval = 0;
 496         }
 497         else if (depth > 0) {
 498           /* Definitely not isref or isarray. */
 499           if (subpassin)
 500             thisval = ReadStructField(subaddress, ix);
 501           else
 502             thisval = 0;
 503         }
 504         else if (isref) {
 505           if (passin)
 506             thisval = ReadMemory(varglist[ix]);
 507           else
 508             thisval = 0;
 509         }
 510         else {
 511           thisval = varglist[ix];
 512         }
 513
 514         switch (typeclass) {
 515         case 'I':
 516           if (*cx == 'u')
 517             garglist[gargnum].uint = (glui32)(thisval);
 518           else if (*cx == 's')
 519             garglist[gargnum].sint = (glsi32)(thisval);
 520           else
 521             fatal_error("Illegal format string.");
 522           gargnum++;
 523           cx++;
 524           break;
 525         case 'Q':
 526           if (thisval) {
 527             opref = classes_get(*cx-'a', thisval);
 528             if (!opref) {
 529               fatal_error("Reference to nonexistent Glk object.");
 530             }
 531           }
 532           else {
 533             opref = NULL;
 534           }
 535           garglist[gargnum].opaqueref = opref;
 536           gargnum++;
 537           cx++;
 538           break;
 539         case 'C':
 540           if (*cx == 'u')
 541             garglist[gargnum].uch = (unsigned char)(thisval);
 542           else if (*cx == 's')
 543             garglist[gargnum].sch = (signed char)(thisval);
 544           else if (*cx == 'n')
 545             garglist[gargnum].ch = (char)(thisval);
 546           else
 547             fatal_error("Illegal format string.");
 548           gargnum++;
 549           cx++;
 550           break;
 551         case 'S':
 552           garglist[gargnum].charstr = DecodeVMString(thisval);
 553           gargnum++;
 554           break;
 555 #ifdef GLK_MODULE_UNICODE
 556         case 'U':
 557           garglist[gargnum].unicharstr = DecodeVMUstring(thisval);
 558           gargnum++;
 559           break;
 560 #endif /* GLK_MODULE_UNICODE */
 561         default:
 562           fatal_error("Illegal format string.");
 563           break;
 564         }
 565       }
 566     }
 567     else {
 568       /* We got a null reference, so we have to skip the format element. */
 569       if (typeclass == '[') {
 570         int numsubwanted, refdepth;
 571         numsubwanted = 0;
 572         while (*cx >= '0' && *cx <= '9') {
 573           numsubwanted = 10 * numsubwanted + (*cx - '0');
 574           cx++;
 575         }
 576         refdepth = 1;
 577         while (refdepth > 0) {
 578           if (*cx == '[')
 579             refdepth++;
 580           else if (*cx == ']')
 581             refdepth--;
 582           cx++;
 583         }
 584       }
 585       else if (typeclass == 'S' || typeclass == 'U') {
 586         /* leave it */
 587       }
 588       else {
 589         cx++;
 590       }
 591     }
 592   }
 593
 594   if (depth > 0) {
 595     if (*cx != ']')
 596       fatal_error("Illegal format string.");
 597     cx++;
 598   }
 599   else {
 600     if (*cx != ':' && *cx != '\0')
 601       fatal_error("Illegal format string.");
 602   }
 603
 604   *proto = cx;
 605   *argnumptr = gargnum;
 606 }
 607
 608 /* unparse_glk_args():
 609    This is about the reverse of parse_glk_args().
 610 */
 611 static void unparse_glk_args(dispatch_splot_t *splot, char **proto, int depth,
 612   int *argnumptr, glui32 subaddress, int subpassout)
 613 {
 614   char *cx;
 615   int ix, argx;
 616   int gargnum, numwanted;
 617   void *opref;
 618   gluniversal_t *garglist;
 619   glui32 *varglist;
 620
 621   garglist = splot->garglist;
 622   varglist = splot->varglist;
 623   gargnum = *argnumptr;
 624   cx = *proto;
 625
 626   numwanted = 0;
 627   while (*cx >= '0' && *cx <= '9') {
 628     numwanted = 10 * numwanted + (*cx - '0');
 629     cx++;
 630   }
 631
 632   for (argx = 0, ix = 0; argx < numwanted; argx++, ix++) {
 633     char typeclass;
 634     int skipval;
 635     int isref, passin, passout, nullok, isarray, isretained, isreturn;
 636     cx = read_prefix(cx, &isref, &isarray, &passin, &passout, &nullok,
 637       &isretained, &isreturn);
 638
 639     typeclass = *cx;
 640     cx++;
 641
 642     skipval = FALSE;
 643     if (isref) {
 644       if (!isreturn && varglist[ix] == 0) {
 645         if (!nullok)
 646           fatal_error("Zero passed invalidly to Glk function.");
 647         garglist[gargnum].ptrflag = FALSE;
 648         gargnum++;
 649         skipval = TRUE;
 650       }
 651       else {
 652         garglist[gargnum].ptrflag = TRUE;
 653         gargnum++;
 654       }
 655     }
 656     if (!skipval) {
 657       glui32 thisval;
 658
 659       if (typeclass == '[') {
 660
 661         unparse_glk_args(splot, &cx, depth+1, &gargnum, varglist[ix], passout);
 662
 663       }
 664       else if (isarray) {
 665         /* definitely isref */
 666
 667         switch (typeclass) {
 668         case 'C':
 669           gargnum++;
 670           ix++;
 671           gargnum++;
 672           cx++;
 673           break;
 674         case 'I':
 675           ReleaseIArray(garglist[gargnum].array, varglist[ix], varglist[ix+1], passout);
 676           gargnum++;
 677           ix++;
 678           gargnum++;
 679           cx++;
 680           break;
 681         default:
 682           fatal_error("Illegal format string.");
 683           break;
 684         }
 685       }
 686       else {
 687         /* a plain value or a reference to one. */
 688
 689         if (isreturn || (depth > 0 && subpassout) || (isref && passout)) {
 690           skipval = FALSE;
 691         }
 692         else {
 693           skipval = TRUE;
 694         }
 695
 696         switch (typeclass) {
 697         case 'I':
 698           if (!skipval) {
 699             if (*cx == 'u')
 700               thisval = (glui32)garglist[gargnum].uint;
 701             else if (*cx == 's')
 702               thisval = (glui32)garglist[gargnum].sint;
 703             else
 704               fatal_error("Illegal format string.");
 705           }
 706           gargnum++;
 707           cx++;
 708           break;
 709         case 'Q':
 710           if (!skipval) {
 711             opref = garglist[gargnum].opaqueref;
 712             if (opref) {
 713               gidispatch_rock_t objrock =
 714                 gidispatch_get_objrock(opref, *cx-'a');
 715               thisval = ((classref_t *)objrock.ptr)->id;
 716             }
 717             else {
 718               thisval = 0;
 719             }
 720           }
 721           gargnum++;
 722           cx++;
 723           break;
 724         case 'C':
 725           if (!skipval) {
 726             if (*cx == 'u')
 727               thisval = (glui32)garglist[gargnum].uch;
 728             else if (*cx == 's')
 729               thisval = (glui32)garglist[gargnum].sch;
 730             else if (*cx == 'n')
 731               thisval = (glui32)garglist[gargnum].ch;
 732             else
 733               fatal_error("Illegal format string.");
 734           }
 735           gargnum++;
 736           cx++;
 737           break;
 738         case 'S':
 739           if (garglist[gargnum].charstr)
 740             ReleaseVMString(garglist[gargnum].charstr);
 741           gargnum++;
 742           break;
 743 #ifdef GLK_MODULE_UNICODE
 744         case 'U':
 745           if (garglist[gargnum].unicharstr)
 746             ReleaseVMUstring(garglist[gargnum].unicharstr);
 747           gargnum++;
 748           break;
 749 #endif /* GLK_MODULE_UNICODE */
 750         default:
 751           fatal_error("Illegal format string.");
 752           break;
 753         }
 754
 755         if (isreturn) {
 756           *(splot->retval) = thisval;
 757         }
 758         else if (depth > 0) {
 759           /* Definitely not isref or isarray. */
 760           if (subpassout)
 761             WriteStructField(subaddress, ix, thisval);
 762         }
 763         else if (isref) {
 764           if (passout)
 765             WriteMemory(varglist[ix], thisval);
 766         }
 767       }
 768     }
 769     else {
 770       /* We got a null reference, so we have to skip the format element. */
 771       if (typeclass == '[') {
 772         int numsubwanted, refdepth;
 773         numsubwanted = 0;
 774         while (*cx >= '0' && *cx <= '9') {
 775           numsubwanted = 10 * numsubwanted + (*cx - '0');
 776           cx++;
 777         }
 778         refdepth = 1;
 779         while (refdepth > 0) {
 780           if (*cx == '[')
 781             refdepth++;
 782           else if (*cx == ']')
 783             refdepth--;
 784           cx++;
 785         }
 786       }
 787       else if (typeclass == 'S' || typeclass == 'U') {
 788         /* leave it */
 789       }
 790       else {
 791         cx++;
 792       }
 793     }
 794   }
 795
 796   if (depth > 0) {
 797     if (*cx != ']')
 798       fatal_error("Illegal format string.");
 799     cx++;
 800   }
 801   else {
 802     if (*cx != ':' && *cx != '\0')
 803       fatal_error("Illegal format string.");
 804   }
 805
 806   *proto = cx;
 807   *argnumptr = gargnum;
 808 }
 809
 810 /* find_stream_by_id():
 811    This is used by some interpreter code which has to, well, find a Glk
 812    stream given its ID.
 813 */
 814 strid_t find_stream_by_id(glui32 objid)
 815 {
 816   if (!objid)
 817     return NULL;
 818
 819   /* Recall that class 1 ("b") is streams. */
 820   return classes_get(1, objid);
 821 }
 822
 823 /* Build a hash table to hold a set of Glk objects. */
 824 static classtable_t *new_classtable(glui32 firstid)
 825 {
 826   int ix;
 827   classtable_t *ctab = (classtable_t *)glulx_malloc(sizeof(classtable_t));
 828   if (!ctab)
 829     return NULL;
 830
 831   for (ix=0; ix<CLASSHASH_SIZE; ix++)
 832     ctab->bucket[ix] = NULL;
 833
 834   ctab->lastid = firstid;
 835
 836   return ctab;
 837 }
 838
 839 /* Find a Glk object in the appropriate hash table. */
 840 static void *classes_get(int classid, glui32 objid)
 841 {
 842   classtable_t *ctab;
 843   classref_t *cref;
 844   if (classid < 0 || classid >= num_classes)
 845     return NULL;
 846   ctab = classes[classid];
 847   cref = ctab->bucket[objid % CLASSHASH_SIZE];
 848   for (; cref; cref = cref->next) {
 849     if (cref->id == objid)
 850       return cref->obj;
 851   }
 852   return NULL;
 853 }
 854
 855 /* Put a Glk object in the appropriate hash table. */
 856 static classref_t *classes_put(int classid, void *obj)
 857 {
 858   int bucknum;
 859   classtable_t *ctab;
 860   classref_t *cref;
 861   if (classid < 0 || classid >= num_classes)
 862     return NULL;
 863   ctab = classes[classid];
 864   cref = (classref_t *)glulx_malloc(sizeof(classref_t));
 865   if (!cref)
 866     return NULL;
 867   cref->obj = obj;
 868   cref->id = ctab->lastid;
 869   ctab->lastid++;
 870   bucknum = cref->id % CLASSHASH_SIZE;
 871   cref->bucknum = bucknum;
 872   cref->next = ctab->bucket[bucknum];
 873   ctab->bucket[bucknum] = cref;
 874   return cref;
 875 }
 876
 877 /* Delete a Glk object from the appropriate hash table. */
 878 static void classes_remove(int classid, void *obj)
 879 {
 880   classtable_t *ctab;
 881   classref_t *cref;
 882   classref_t **crefp;
 883   gidispatch_rock_t objrock;
 884   if (classid < 0 || classid >= num_classes)
 885     return;
 886   ctab = classes[classid];
 887   objrock = gidispatch_get_objrock(obj, classid);
 888   cref = objrock.ptr;
 889   if (!cref)
 890     return;
 891   crefp = &(ctab->bucket[cref->bucknum]);
 892   for (; *crefp; crefp = &((*crefp)->next)) {
 893     if ((*crefp) == cref) {
 894       *crefp = cref->next;
 895       if (!cref->obj) {
 896         nonfatal_warning("attempt to free NULL object!");
 897       }
 898       cref->obj = NULL;
 899       cref->id = 0;
 900       cref->next = NULL;
 901       glulx_free(cref);
 902       return;
 903     }
 904   }
 905   return;
 906 }
 907
 908 /* The object registration/unregistration callbacks that the library calls
 909     to keep the hash tables up to date. */
 910
 911 static gidispatch_rock_t glulxe_classtable_register(void *obj,
 912   glui32 objclass)
 913 {
 914   classref_t *cref;
 915   gidispatch_rock_t objrock;
 916   cref = classes_put(objclass, obj);
 917   objrock.ptr = cref;
 918   return objrock;
 919 }
 920
 921 static void glulxe_classtable_unregister(void *obj, glui32 objclass,
 922   gidispatch_rock_t objrock)
 923 {
 924   classes_remove(objclass, obj);
 925 }
 926
 927 static glui32 *grab_temp_array(glui32 addr, glui32 len, int passin)
 928 {
 929   arrayref_t *arref = NULL;
 930   glui32 *arr = NULL;
 931   glui32 ix, addr2;
 932
 933   if (len) {
 934     arr = (glui32 *)glulx_malloc(len * sizeof(glui32));
 935     arref = (arrayref_t *)glulx_malloc(sizeof(arrayref_t));
 936     if (!arr || !arref)
 937       fatal_error("Unable to allocate space for array argument to Glk call.");
 938
 939     arref->array = arr;
 940     arref->addr = addr;
 941     arref->elemsize = 4;
 942     arref->retained = FALSE;
 943     arref->len = len;
 944     arref->next = arrays;
 945     arrays = arref;
 946
 947     if (passin) {
 948       for (ix=0, addr2=addr; ix<len; ix++, addr2+=4) {
 949         arr[ix] = Mem4(addr2);
 950       }
 951     }
 952   }
 953
 954   return arr;
 955 }
 956
 957 static void release_temp_array(glui32 *arr, glui32 addr, glui32 len, int passout)
 958 {
 959   arrayref_t *arref = NULL;
 960   arrayref_t **aptr;
 961   glui32 ix, val, addr2;
 962
 963   if (arr) {
 964     for (aptr=(&arrays); (*aptr); aptr=(&((*aptr)->next))) {
 965       if ((*aptr)->array == arr)
 966         break;
 967     }
 968     arref = *aptr;
 969     if (!arref)
 970       fatal_error("Unable to re-find array argument in Glk call.");
 971     if (arref->addr != addr || arref->len != len)
 972       fatal_error("Mismatched array argument in Glk call.");
 973
 974     if (arref->retained) {
 975       return;
 976     }
 977
 978     *aptr = arref->next;
 979     arref->next = NULL;
 980
 981     if (passout) {
 982       for (ix=0, addr2=addr; ix<len; ix++, addr2+=4) {
 983         val = arr[ix];
 984         MemW4(addr2, val);
 985       }
 986     }
 987     glulx_free(arr);
 988     glulx_free(arref);
 989   }
 990 }
 991
 992 gidispatch_rock_t glulxe_retained_register(void *array,
 993   glui32 len, char *typecode)
 994 {
 995   gidispatch_rock_t rock;
 996   arrayref_t *arref = NULL;
 997   arrayref_t **aptr;
 998
 999   if (typecode[4] != 'I' || array == NULL) {
1000     /* We only retain integer arrays. */
1001     rock.ptr = NULL;
1002     return rock;
1003   }
1004
1005   for (aptr=(&arrays); (*aptr); aptr=(&((*aptr)->next))) {
1006     if ((*aptr)->array == array)
1007       break;
1008   }
1009   arref = *aptr;
1010   if (!arref)
1011     fatal_error("Unable to re-find array argument in Glk call.");
1012   if (arref->elemsize != 4 || arref->len != len)
1013     fatal_error("Mismatched array argument in Glk call.");
1014
1015   arref->retained = TRUE;
1016
1017   rock.ptr = arref;
1018   return rock;
1019 }
1020
1021 void glulxe_retained_unregister(void *array, glui32 len,
1022   char *typecode, gidispatch_rock_t objrock)
1023 {
1024   arrayref_t *arref = NULL;
1025   arrayref_t **aptr;
1026   glui32 ix, addr2, val;
1027
1028   if (typecode[4] != 'I' || array == NULL) {
1029     /* We only retain integer arrays. */
1030     return;
1031   }
1032
1033   for (aptr=(&arrays); (*aptr); aptr=(&((*aptr)->next))) {
1034     if ((*aptr)->array == array)
1035       break;
1036   }
1037   arref = *aptr;
1038   if (!arref)
1039     fatal_error("Unable to re-find array argument in Glk call.");
1040   if (arref != objrock.ptr)
1041     fatal_error("Mismatched array reference in Glk call.");
1042   if (!arref->retained)
1043     fatal_error("Unretained array reference in Glk call.");
1044   if (arref->elemsize != 4 || arref->len != len)
1045     fatal_error("Mismatched array argument in Glk call.");
1046
1047   *aptr = arref->next;
1048   arref->next = NULL;
1049
1050   for (ix=0, addr2=arref->addr; ix<arref->len; ix++, addr2+=4) {
1051     val = ((glui32 *)array)[ix];
1052     MemW4(addr2, val);
1053   }
1054   glulx_free(array);
1055   glulx_free(arref);
1056 }
1057