interpreters/git/glkop.c

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