Basically working keyword arguments, though vmparam is unsatisfactory.

Copied from Perforce
 Change: 181545
 ServerID: perforce.ravenbrook.com

11 files changed, 83 insertions, 44 deletions

diff --git a/mps/code/arena.c b/mps/code/arena.c
index 904ed0701ac..e36aa03cea4 100644
--- a/mps/code/arena.c
+++ b/mps/code/arena.c
@@ -207,6 +207,9 @@ failGlobalsInit:
 
 /* ArenaCreate -- create the arena and call initializers */
 
+/* FIXME: SizeCheck?  On x64 it can't be more than 43 bits etc. etc. */
+const KeyStruct _mps_key_arena_size = {KeySig, "ARENA_SIZE", ArgCheckCant};
+
 Res ArenaCreate(Arena *arenaReturn, ArenaClass class, ArgList args)
 {
   Arena arena;
diff --git a/mps/code/arenacl.c b/mps/code/arenacl.c
index bfe640bfc05..4a0824a7abe 100644
--- a/mps/code/arenacl.c
+++ b/mps/code/arenacl.c
@@ -186,6 +186,9 @@ static void ClientChunkFinish(Chunk chunk)
  * .arena.init: Once the arena has been allocated, we call ArenaInit
  * to do the generic part of init.
  */
+
+const KeyStruct _mps_key_arena_cl_addr = {KeySig, "ARENA_CL_ADDR", ArgCheckCant};
+
 static Res ClientArenaInit(Arena *arenaReturn, ArenaClass class, ArgList args)
 {
   Arena arena;
diff --git a/mps/code/arenacv.c b/mps/code/arenacv.c
index 7228ea80ee7..60f482b2a93 100644
--- a/mps/code/arenacv.c
+++ b/mps/code/arenacv.c
@@ -332,16 +332,19 @@ static void testAllocAndIterate(Arena arena, Pool pool,
 }
 
 
-static void testPageTable(ArenaClass class, ...)
+static void testPageTable(ArenaClass class, Size size, Addr addr)
 {
   Arena arena; Pool pool;
   Size pageSize;
   Count tractsPerPage;
-  va_list args;
-
-  va_start(args, class);
+  ArgStruct args[3];
+  
+  args[0].key = MPS_KEY_ARENA_SIZE;
+  args[0].val.size = size;
+  args[1].key = MPS_KEY_ARENA_CL_ADDR;
+  args[1].val.addr = addr;
+  args[2].key = MPS_KEY_ARGS_END;
   die(ArenaCreate(&arena, class, args), "ArenaCreate");
-  va_end(args);
 
   die(PoolCreate(&pool, arena, PoolClassMV(),
                  (Size)65536, (Size)32, (Size)65536),
@@ -364,18 +367,6 @@ static void testPageTable(ArenaClass class, ...)
 }
 
 
-static Res makeArena(Arena *arenaOut, ArenaClass class, ...)
-{
-  va_list args;
-  Res res;
-
-  va_start(args, class);
-  res = ArenaCreateV(arenaOut, class, args);
-  va_end(args);
-  return res;
-}
-
-
 /* testSize -- test arena size overflow
  *
  * Just try allocating larger arenas, doubling the size each time, until
@@ -389,7 +380,11 @@ static void testSize(Size size)
   Res res;
 
   do {
-    res = makeArena(&arena, class, size);
+    ArgStruct args[2];
+    args[0].key = MPS_KEY_ARENA_SIZE;
+    args[0].val.size = size;
+    args[1].key = MPS_KEY_ARGS_END;
+    res = ArenaCreate(&arena, class, args);
     if (res == ResOK)
       ArenaDestroy(arena);
     else
@@ -407,13 +402,12 @@ int main(int argc, char *argv[])
   void *block;
   testlib_unused(argc);
 
-  testPageTable((ArenaClass)mps_arena_class_vm(), TEST_ARENA_SIZE);
-  testPageTable((ArenaClass)mps_arena_class_vmnz(), TEST_ARENA_SIZE);
+  testPageTable((ArenaClass)mps_arena_class_vm(), TEST_ARENA_SIZE, 0);
+  testPageTable((ArenaClass)mps_arena_class_vmnz(), TEST_ARENA_SIZE, 0);
 
   block = malloc(TEST_ARENA_SIZE);
   cdie(block != NULL, "malloc");
-  testPageTable((ArenaClass)mps_arena_class_cl(), TEST_ARENA_SIZE,
-                (Addr)block);
+  testPageTable((ArenaClass)mps_arena_class_cl(), TEST_ARENA_SIZE, block);
 
   testSize(TEST_ARENA_SIZE);
 
diff --git a/mps/code/arenavm.c b/mps/code/arenavm.c
index b0c2d732dc1..614876cfe4e 100644
--- a/mps/code/arenavm.c
+++ b/mps/code/arenavm.c
@@ -73,6 +73,7 @@ typedef struct VMArenaStruct *VMArena;
 typedef struct VMArenaStruct {  /* VM arena structure */
   ArenaStruct arenaStruct;
   VM vm;                        /* VM where the arena itself is stored */
+  char vmParams[VMParamSize];   /* VM parameter block */
   Size spareSize;              /* total size of spare pages */
   ZoneSet blacklist;             /* zones to use last */
   ZoneSet genZoneSet[VMArenaGenCount]; /* .gencount.const */
@@ -190,6 +191,9 @@ static Bool VMArenaCheck(VMArena vmArena)
     /* count of committed, but we don't have all day. */
     CHECKL(VMMapped(primary->vm) <= arena->committed);
   }
+  
+  /* FIXME: Can't check VMParams */
+
   return TRUE;
 }
 
@@ -311,7 +315,7 @@ static Res VMChunkCreate(Chunk *chunkReturn, VMArena vmArena, Size size)
   AVERT(VMArena, vmArena);
   AVER(size > 0);
 
-  res = VMCreate(&vm, size);
+  res = VMCreate(&vm, size, vmArena->vmParams);
   if (res != ResOK)
     goto failVMCreate;
 
@@ -457,6 +461,7 @@ static Res VMArenaInit(Arena *arenaReturn, ArenaClass class, ArgList args)
   VM arenaVM;
   Chunk chunk;
   mps_arg_s arg;
+  char vmParams[VMParamSize];
   
   AVER(arenaReturn != NULL);
   AVER(class == VMArenaClassGet() || class == VMNZArenaClassGet());
@@ -472,10 +477,17 @@ static Res VMArenaInit(Arena *arenaReturn, ArenaClass class, ArgList args)
   }
 
   AVER(userSize > 0);
+  
+  /* Parse the arguments into VM parameters, if any.  We must do this into
+     some stack-allocated memory for the moment, since we don't have anywhere
+     else to put it.  It gets copied later. */
+  res = VMParamFromArgs(vmParams, sizeof(vmParams), args);
+  if (res != ResOK)
+    goto failVMCreate;
 
   /* Create a VM to hold the arena and map it. */
   vmArenaSize = SizeAlignUp(sizeof(VMArenaStruct), MPS_PF_ALIGN);
-  res = VMCreate(&arenaVM, vmArenaSize, args);
+  res = VMCreate(&arenaVM, vmArenaSize, vmParams);
   if (res != ResOK)
     goto failVMCreate;
   res = VMMap(arenaVM, VMBase(arenaVM), VMLimit(arenaVM));
@@ -493,6 +505,10 @@ static Res VMArenaInit(Arena *arenaReturn, ArenaClass class, ArgList args)
   vmArena->vm = arenaVM;
   vmArena->spareSize = 0;
 
+  /* Copy the stack-allocated VM parmeters into their home in the VMArena. */
+  AVER(sizeof(vmArena->vmParams) == sizeof(vmParams));
+  memcpy(vmArena->vmParams, vmParams, sizeof(vmArena->vmParams));
+
   /* .blacklist: We blacklist the zones that could be referenced by small
      integers misinterpreted as references.  This isn't a perfect simulation,
      but it should catch the common cases. */
diff --git a/mps/code/arg.c b/mps/code/arg.c
index 425bbf6c496..3528dcce136 100644
--- a/mps/code/arg.c
+++ b/mps/code/arg.c
@@ -10,19 +10,19 @@
 
 SRCID(arg, "$Id$");
 
-#define KeySig          ((Sig)0x519CE333) /* SIGnature KEYyy */
-typedef struct mps_key_s {
-  Sig sig;
-  const char *name;
-  Bool (*check)(Arg arg);
-} KeyStruct;
 
+/* ArgCheckCant -- default argument checker
+ *
+ * This is a default value for the KeyStruct check field for keywords
+ * that don't have any meaningful checking they can do.
+ */
 
-static Bool ArgCheckCant(Arg arg) {
+Bool ArgCheckCant(Arg arg) {
   UNUSED(arg);
   return TRUE;
 }
 
+
 const KeyStruct _mps_key_varargs = {KeySig, "VARARGS", ArgCheckCant};
 
 
@@ -59,11 +59,11 @@ Bool ArgListCheck(ArgList args)
 }
 
 
-Bool ArgPick(mps_arg_s *argOut, mps_arg_s args[], Key key) {
+Bool ArgPick(ArgStruct *argOut, ArgList args, Key key) {
   Index i;
   
   AVER(argOut != NULL);
-  AVERT(Arg, args);
+  AVER(ArgListCheck(args));
   AVERT(Key, key);
 
   for (i = 0; args[i].key != MPS_KEY_ARGS_END; ++i)
diff --git a/mps/code/config.h b/mps/code/config.h
index 5eb8ee50e13..33ce96951ec 100644
--- a/mps/code/config.h
+++ b/mps/code/config.h
@@ -294,6 +294,8 @@
 
 #define VMANPageALIGNMENT ((Align)4096)
 #define VMJunkBYTE ((unsigned char)0xA9)
+#define VMParamSize (sizeof(Word))
+
 
 /* Protection Configuration see <code/prot*.c>
 
diff --git a/mps/code/mpm.h b/mps/code/mpm.h
index 98e35b54189..db4e2415045 100644
--- a/mps/code/mpm.h
+++ b/mps/code/mpm.h
@@ -136,6 +136,7 @@ extern Bool KeyCheck(Key key);
 extern Bool ArgCheck(Arg arg);
 extern Bool ArgListCheck(ArgList args);
 extern Bool ArgPick(ArgStruct *argOut, ArgList args, Key key);
+extern Bool ArgCheckCant(Arg arg);
 
 
 /* Logs and Powers
@@ -974,7 +975,8 @@ extern Res RootsIterate(Globals arena, RootIterateFn f, void *p);
 
 extern Align VMAlign(VM vm);
 extern Bool VMCheck(VM vm);
-extern Res VMCreate(VM *VMReturn, Size size, mps_arg_s args[]);
+extern Res VMParamFromArgs(void *params, size_t paramSize, ArgList args);
+extern Res VMCreate(VM *VMReturn, Size size, void *params);
 extern void VMDestroy(VM vm);
 extern Addr VMBase(VM vm);
 extern Addr VMLimit(VM vm);
diff --git a/mps/code/mpmst.h b/mps/code/mpmst.h
index d67d6a54ffd..5c5ca542074 100644
--- a/mps/code/mpmst.h
+++ b/mps/code/mpmst.h
@@ -698,6 +698,16 @@ typedef struct AllocPatternStruct {
 } AllocPatternStruct;
 
 
+/* KeyStruct -- keyword argument structure */
+
+#define KeySig          ((Sig)0x519CE333) /* SIGnature KEYyy */
+typedef struct mps_key_s {
+  Sig sig;
+  const char *name;
+  Bool (*check)(Arg arg);
+} KeyStruct;
+
+
 #endif /* mpmst_h */
 
 
diff --git a/mps/code/poolmfs.c b/mps/code/poolmfs.c
index ad4140a4479..b39b283fbe9 100644
--- a/mps/code/poolmfs.c
+++ b/mps/code/poolmfs.c
@@ -31,8 +31,8 @@
  * is a shame.
  */
 
-
 #include "mpscmfs.h"
+#include "dbgpool.h"
 #include "poolmfs.h"
 #include "mpm.h"
 
diff --git a/mps/code/poolncv.c b/mps/code/poolncv.c
index 2f4be79d562..cbbda34d78b 100644
--- a/mps/code/poolncv.c
+++ b/mps/code/poolncv.c
@@ -10,17 +10,14 @@
 #include "testlib.h"
 
 
-static void testit(ArenaClass class, ...)
+static void testit(ArenaClass class, ArgList args)
 {
   Arena arena;
   Pool pool;
   Res res;
   Addr p;
-  va_list args;
 
-  va_start(args, class);
-  die(ArenaCreateV(&arena, class, args), "ArenaCreate");
-  va_end(args);
+  die(ArenaCreate(&arena, class, args), "ArenaCreate");
 
   die(PoolCreate(&pool, arena, PoolClassN()), "PoolNCreate");
   res = PoolAlloc(&p, pool, 1, /* withReservoirPermit */ FALSE);
@@ -35,8 +32,12 @@ static void testit(ArenaClass class, ...)
 
 int main(int argc, char *argv[])
 {
+  mps_arg_s args[2];
   testlib_unused(argc);
-  testit((ArenaClass)mps_arena_class_vm(), (Size)600000);
+  args[0].key = MPS_KEY_ARENA_SIZE;
+  args[0].val.size = (Size)600000;
+  args[1].key = MPS_KEY_ARGS_END;
+  testit((ArenaClass)mps_arena_class_vm(), args);
   printf("%s: Conclusion: Failed to find any defects.\n", argv[0]);
   return 0;
 }
diff --git a/mps/code/vmix.c b/mps/code/vmix.c
index 30a2cc672fc..2b7afb514c2 100644
--- a/mps/code/vmix.c
+++ b/mps/code/vmix.c
@@ -98,9 +98,18 @@ Bool VMCheck(VM vm)
 }
 
 
+Res VMParamFromArgs(void *params, size_t paramSize, ArgList args)
+{
+  AVER(params != NULL);
+  AVERT(ArgList, args);
+  UNUSED(paramSize);
+  return ResOK;
+}
+
+
 /* VMCreate -- reserve some virtual address space, and create a VM structure */
 
-Res VMCreate(VM *vmReturn, Size size, mps_arg_s args[])
+Res VMCreate(VM *vmReturn, Size size, void *params)
 {
   Align align;
   VM vm;
@@ -109,8 +118,7 @@ Res VMCreate(VM *vmReturn, Size size, mps_arg_s args[])
   Res res;
 
   AVER(vmReturn != NULL);
-  AVERT(Arg, args);
-  UNUSED(args);
+  AVER(params != NULL);
 
   /* Find out the page size from the OS */
   pagesize = getpagesize();