* lib/cfuns-c.c (oa_spawn): New.

	(oa_allocate_process_argv): Likewise.

6 files changed, 122 insertions, 33 deletions

diff --git a/src/ChangeLog b/src/ChangeLog
index 8c9a8334..cf07ee90 100644
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,4 +1,9 @@
-2009-10-15  Gabriel Dos Reis  <gdr@cse.tamu.edu>
+2009-10-24  Gabriel Dos Reis  <gdr@cs.tamu.edu>
+
+	* lib/cfuns-c.c (oa_spawn): New.
+	(oa_allocate_process_argv): Likewise.
+
+2009-10-15  Gabriel Dos Reis  <gdr@cs.tamu.edu>
 
 	* interp/buildom.boot: Tidy.  
 
diff --git a/src/include/open-axiom.h b/src/include/open-axiom.h
index b27c9ea3..df814476 100644
--- a/src/include/open-axiom.h
+++ b/src/include/open-axiom.h
@@ -1,5 +1,5 @@
 /*
-  Copyright (C) 2007-2008, Gabriel Dos Reis.
+  Copyright (C) 2007-2009, Gabriel Dos Reis.
   All rights reserved.
 
   Redistribution and use in source and binary forms, with or without
@@ -85,8 +85,20 @@ typedef enum openaxiom_byteorder {
 } openaxiom_byteorder;
 
 
-/* Return the address of the data buffer `BUF'.  */
+/* Datatype for packaging information necessary tolaunch a process. */
+typedef struct openaxiom_process {
+   int argc;
+   char** argv;
+   int id;
+} openaxiom_process;
+
+typedef enum openaxiom_spawn_flags {
+   openaxiom_spawn_search_path = 0x01,
+   openaxiom_spawn_replace     = 0x02,
+} openaxiom_spawn_flags;
 
+   
+/* Return the address of the data buffer `BUF'.  */
 #define oa_buffer_address(BUF) ((openaxiom_byte*)&BUF[0])
 
 
@@ -107,6 +119,9 @@ openaxiom_sleep(int n)
 }
 
 
+OPENAXIOM_EXPORT void oa_allocate_process_argv(openaxiom_process*, int);
+OPENAXIOM_EXPORT int oa_spawn(openaxiom_process*, openaxiom_spawn_flags);   
+
 #ifdef __cplusplus
 }
 #endif   
diff --git a/src/interp/define.boot b/src/interp/define.boot
index eb08520f..b21cdb7e 100644
--- a/src/interp/define.boot
+++ b/src/interp/define.boot
@@ -588,7 +588,7 @@ compDefineFunctor(df,m,e,prefix,fal) ==
  
 compDefineFunctor1(df is ['DEF,form,signature,nils,body],
   m,$e,$prefix,$formalArgList) ==
---  1. bind global variables
+    --  1. bind global variables
     $addForm: local := nil
     $subdomain: local := false
     $functionStats: local:= [0,0]
@@ -602,8 +602,7 @@ compDefineFunctor1(df is ['DEF,form,signature,nils,body],
     $functorForm: local := nil
     $functorLocalParameters: local := nil
     $CheckVectorList: local := nil
-                  --prevents CheckVector from printing out same message twice
-    $getDomainCode: local -- code for getting views
+    $getDomainCode: local := nil -- code for getting views
     $insideFunctorIfTrue: local:= true
     $setelt: local := "setShellEntry"
     $genSDVar: local:= 0
@@ -629,9 +628,7 @@ compDefineFunctor1(df is ['DEF,form,signature,nils,body],
        stackAndThrow('"   cannot produce category object: %1pb",[target])
     $compileExportsOnly => compDefineExports(form, ds.1, signature',$e)
     $domainShell:= COPY_-SEQ ds
---+ copy needed since slot1 is reset; compMake.. can return a cached vector
     attributeList := ds.2 --see below under "loadTimeAlist"
---+ 7 lines for $NRT follow
     $condAlist: local := nil
     $uncondAlist: local := nil
     $NRTslot1PredicateList: local := predicatesFromAttributes attributeList
@@ -653,14 +650,14 @@ compDefineFunctor1(df is ['DEF,form,signature,nils,body],
     parSignature:= SUBLIS($pairlis,signature')
     parForm:= SUBLIS($pairlis,form)
  
---  (3.1) now make a list of the functor's local parameters; for
---  domain D in argl,check its signature: if domain, its type is Join(A1,..,An);
---  in this case, D is replaced by D1,..,Dn (gensyms) which are set
---  to the A1,..,An view of D
+    --  (3.1) now make a list of the functor's local parameters; for
+    --  domain D in argl,check its signature: if domain, its type is Join(A1,..,An);
+    --  in this case, D is replaced by D1,..,Dn (gensyms) which are set
+    --  to the A1,..,An view of D
     makeFunctorArgumentParameters(argl,rest signature',first signature')
     $functorLocalParameters := argl
 
---  4. compile body in environment of %type declarations for arguments
+    --  4. compile body in environment of %type declarations for arguments
     op':= $op
     rettype:= signature'.target
     -- If this functor is defined as instantiation of a functor
@@ -686,7 +683,7 @@ compDefineFunctor1(df is ['DEF,form,signature,nils,body],
       augmentLisplibModemapsFromFunctor(parForm,operationAlist,parSignature)
     reportOnFunctorCompilation()
  
---  5. give operator a 'modemap property
+    --  5. give operator a 'modemap property
     if $LISPLIB then
       modemap:= [[parForm,:parSignature],[true,op']]
       $lisplibModemap:= modemap
@@ -771,12 +768,11 @@ reportOnFunctorCompilation() ==
  
 displayMissingFunctions() ==
   null $CheckVectorList => nil
-  loc := nil
-  exp := nil
+  loc := nil              -- list of local operation signatures
+  exp := nil              -- list of exported operation signatures
   for [[op,sig,:.],:pred] in $CheckVectorList  | null pred repeat
-    null member(op,$formalArgList) and
-      getmode(op,$e) is ['Mapping,:.] =>
-        loc := [[op,sig],:loc]
+    not member(op,$formalArgList) and getmode(op,$e) is ['Mapping,:.] =>
+      loc := [[op,sig],:loc]
     exp := [[op,sig],:exp]
   if loc then
     sayBrightly ['%l,:bright '"  Missing Local Functions:"]
diff --git a/src/interp/functor.boot b/src/interp/functor.boot
index f023faab..06b14c50 100644
--- a/src/interp/functor.boot
+++ b/src/interp/functor.boot
@@ -744,21 +744,18 @@ CheckVector(vec,name,catvecListMaker) ==
   for i in 6..MAXINDEX vec repeat
     v:= vec.i
     v=true => nil
-    null v => nil
-            --a domain, which setVector4part3 will fill in
+    null v => nil        --a domain, which setVector4part3 will fill in
     atom v => systemErrorHere ["CheckVector",v]
     atom first v =>
-                  --It's a secondary view of a domain, which we
-                  --must generate code to fill in
+      --It's a secondary view of a domain, which we
+      --must generate code to fill in
       for x in $catNames for y in catvecListMaker repeat
-        if y=v then code:=
-          [["setShellEntry",name,i,x],:code]
+        if y=v then
+          code := [["setShellEntry",name,i,x],:code]
     if name='$ then
       assoc(first v,$CheckVectorList) => nil
       $CheckVectorList:=
         [[first v,:makeMissingFunctionEntry(condAlist,i)],:$CheckVectorList]
---  member(first v,$CheckVectorList) => nil
---  $CheckVectorList:= [first v,:$CheckVectorList]
   code
  
 makeMissingFunctionEntry(alist,i) ==
diff --git a/src/interp/nruncomp.boot b/src/interp/nruncomp.boot
index f74d2afb..79aa917a 100644
--- a/src/interp/nruncomp.boot
+++ b/src/interp/nruncomp.boot
@@ -465,7 +465,7 @@ buildFunctor($definition is [name,:args],sig,code,$locals,$e) ==
        :predBitVectorCode2,storeOperationCode]
 
   $CheckVectorList := NRTcheckVector domainShell
---CODE: part 1
+  --CODE: part 1
   codePart1:= [:devaluateCode,createDomainCode,
                 createViewCode,setVector0Code, slot3Code,:slamCode] where
     devaluateCode:= [["%LET",b,['devaluate,a]] for [a,:b] in $devaluateList]
@@ -478,7 +478,7 @@ buildFunctor($definition is [name,:args],sig,code,$locals,$e) ==
       isCategoryPackageName opOf $definition => nil
       [NRTaddToSlam($definition,'$)]
 
---CODE: part 3
+  --CODE: part 3
   $ConstantAssignments :=
       [NRTputInLocalReferences code for code in $ConstantAssignments]
   codePart3:= [:constantCode1,
@@ -489,7 +489,7 @@ buildFunctor($definition is [name,:args],sig,code,$locals,$e) ==
                       -- The above line is needed to get the recursion
                       -- Integer => FontTable => NonNegativeInteger  => Integer
                       -- right.  Otherwise NNI has 'unset' for 0 and 1
---  setVector4c:= setVector4part3($catNames,$catvecList)
+  --  setVector4c:= setVector4part3($catNames,$catvecList)
                       -- In particular, setVector4part3 and setVector5,
                       -- which generate calls to local domain-instantiators,
                       -- must come after operations are set in the vector.
@@ -516,14 +516,13 @@ NRTcheckVector domainShell ==
 -- (b) NIL         -- item is a domain; will be filled in by setVector4part3
 -- (c) categoryForm-- it was a domain view; now irrelevant
 -- (d) op-signature-- store missing function info in $CheckVectorList
-    v:= domainShell.i
+    v := domainShell.i
     v=true => nil  --item is marked; ignore
     v=nil => nil  --a domain, which setVector4part3 will fill in
     atom v => systemErrorHere '"CheckVector"
     atom first v => nil  --category form; ignore
     assoc(first v,alist) => nil
-    alist:=
-      [[first v,:$SetFunctions.i],:alist]
+    alist := [[first v,:$SetFunctions.i],:alist]
   alist
 
 mkDomainCatName id == INTERN STRCONC(id,";CAT")
diff --git a/src/lib/cfuns-c.c b/src/lib/cfuns-c.c
index 7562874a..60cb4e3a 100644
--- a/src/lib/cfuns-c.c
+++ b/src/lib/cfuns-c.c
@@ -716,3 +716,80 @@ oa_get_host_byteorder(void)
    return oa_little_endian;
 #endif   
 }
+
+
+OPENAXIOM_EXPORT void
+oa_allocate_process_argv(openaxiom_process* proc, int argc)
+{
+   proc->argc = argc;
+   proc->argv = (char**) malloc((1 + argc) * sizeof (char*));
+   proc->argv[argc] = NULL;
+}
+
+OPENAXIOM_EXPORT int
+oa_spawn(openaxiom_process* proc, openaxiom_spawn_flags flags)
+{
+#ifdef __WIN32__
+   cons char* path = NULL;
+   char* cmd_line = NULL;
+   int curpos = strlen(proc->argv[0]);
+   int cmd_line_length = curpos;
+   int i;
+   PROCESS_INFORMATION proc_info;
+   STARTUPINFO startup_info = { 0 };
+   DWORD status;
+
+   for (i = 0; i < proc->argc; ++i)
+      cmd_line_length += 1 + strlen(proc->argv[i]);
+
+   cmd_line = (char*) malloc(cmd_line_length + 1);
+   strcpy(cmd_line, proc->argv[0]);
+   for (i = 0; i < proc->argc; ++i) {
+      cmd_line[curpos++] = ' ';
+      strcpy(cmd_line + curpos, proc->argv[i]);
+      curpos += strlen(proc->argv[i]);
+   }
+   cmd_line[curpos] = '\0';
+
+   if (flags & openaxiom_spawn_search_path == 0)
+      path = proc->argv[0];
+
+   if(CreateProcess(/* lpApplicationName */ path,
+                    /* lpCommandLine */ cmd_line,
+                    /* lpProcessAttributes */ NULL,
+                    /* lpThreadAttributes */ NULL,
+                    /* bInheritHandles */ TRUE,
+                    /* dwCreationFlags */ 0,
+                    /* lpEnvironment */ NULL,
+                    /* lpCurrentDirectory */ NULL,
+                    /* lpstartupInfo */ &startup_info,
+                    /* lpProcessInformation */ &proc_info) == 0) {
+      fprintf(stderr, "oa_spawn: error %d\n", GetLastError());
+      return proc->id = -1;
+   }
+   proc->id = proc_info.dwProcessId;
+   if (flags & openaxiom_spawn_replace == 0)
+      return proc->id;
+   WaitForSingleObject(proc_info.hProcess, INFINITE);
+   GetExitCodeProcess(proc_info.hProcess, &status);
+   CloseHandle(proc_info.hThread);
+   CloseHandle(proc_info.hProcess);
+   return 0;
+
+#else
+   proc->id = 0;
+   if ((flags & openaxiom_spawn_replace) == 0)
+      proc->id = fork();
+   if (proc->id == 0) {
+      if (flags & openaxiom_spawn_search_path)
+         execvp(proc->argv[0], proc->argv);
+      else
+         execv(proc->argv[0], proc->argv);
+      perror(strerror(errno));
+      /* Don't keep useless clones around.  */
+      if ((flags & openaxiom_spawn_replace) == 0)
+         exit(-1);
+   }
+   return proc->id;
+#endif   
+}