aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--src/ChangeLog7
-rw-r--r--src/include/open-axiom.h19
-rw-r--r--src/interp/define.boot28
-rw-r--r--src/interp/functor.boot13
-rw-r--r--src/interp/nruncomp.boot11
-rw-r--r--src/lib/cfuns-c.c77
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
+}