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