diff options
| -rw-r--r-- | src/ChangeLog | 7 | ||||
| -rw-r--r-- | src/include/open-axiom.h | 19 | ||||
| -rw-r--r-- | src/interp/define.boot | 28 | ||||
| -rw-r--r-- | src/interp/functor.boot | 13 | ||||
| -rw-r--r-- | src/interp/nruncomp.boot | 11 | ||||
| -rw-r--r-- | src/lib/cfuns-c.c | 77 |
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 +} |