static Handle setRegistryKey(TaskData *taskData, Handle args, HKEY hkey)
{
TCHAR valName[MAX_PATH];
LONG lRes;
PolyWord str = args->WordP()->Get(3);
POLYUNSIGNED length = Poly_string_to_C(args->WordP()->Get(1), valName, MAX_PATH);
DWORD dwType = get_C_unsigned(taskData, DEREFWORDHANDLE(args)->Get(2));
if (length > MAX_PATH)
raise_syscall(taskData, "Value name too long", ENAMETOOLONG);
// The value is binary. Strings will already have had a null added.
if (IS_INT(str))
{
byte b = (byte)UNTAGGED(str);
// Single byte value.
lRes = RegSetValueEx(hkey, valName, 0, dwType, &b, 1);
}
else
{
PolyStringObject *ps = (PolyStringObject*)str.AsObjPtr();
lRes = RegSetValueEx(hkey, valName, 0, dwType,
(CONST BYTE *)ps->chars, (DWORD)ps->length);
}
if (lRes != ERROR_SUCCESS)
raise_syscall(taskData, "RegSetValue failed", -lRes);
return Make_arbitrary_precision(taskData, 0);
}
Handle LoadState(TaskData *taskData, Handle hFileName)
// Load a saved state file and any ancestors.
{
// Open the load file
TCHAR fileNameBuff[MAXPATHLEN];
POLYUNSIGNED length =
Poly_string_to_C(DEREFHANDLE(hFileName), fileNameBuff, MAXPATHLEN);
if (length > MAXPATHLEN)
raise_syscall(taskData, "File name too long", ENAMETOOLONG);
StateLoader loader(fileNameBuff);
// Request the main thread to do the load. This may set the error string if it failed.
processes->MakeRootRequest(taskData, &loader);
if (loader.errorResult != 0)
{
if (loader.errNumber == 0)
raise_fail(taskData, loader.errorResult);
else
{
char buff[MAXPATHLEN+100];
#if (defined(_WIN32) && defined(UNICODE))
sprintf(buff, "%s: %S", loader.errorResult, loader.fileName);
#else
sprintf(buff, "%s: %s", loader.errorResult, loader.fileName);
#endif
raise_syscall(taskData, buff, loader.errNumber);
}
}
return SAVE(TAGGED(0));
}
// Create a registry key and make an entry in the table for it.
static Handle createRegistryKey(TaskData *taskData, Handle args, HKEY hkParent)
{
TCHAR keyName[MAX_PATH];
LONG lRes;
Handle keyResult, dispRes, pair;
PHANDLETAB pTab;
HKEY hkey;
DWORD dwDisp;
REGSAM sam = get_C_unsigned(taskData, DEREFWORDHANDLE(args)->Get(3));
unsigned opt = get_C_unsigned(taskData, DEREFWORDHANDLE(args)->Get(2));
POLYUNSIGNED length = Poly_string_to_C(args->WordP()->Get(1), keyName, MAX_PATH);
if (length > MAX_PATH)
raise_syscall(taskData, "Key name too long", ENAMETOOLONG);
// Try opening the key.
lRes = RegCreateKeyEx(hkParent, keyName, 0, NULL,
opt ? REG_OPTION_NON_VOLATILE : REG_OPTION_VOLATILE,
sam, NULL, &hkey, &dwDisp);
if (lRes != ERROR_SUCCESS)
raise_syscall(taskData, "RegCreateKeyEx failed", -lRes);
// Make an entry in the table.
keyResult = make_handle_entry(taskData);
pTab = &handleTable[STREAMID(keyResult)];
pTab->entryType = HE_REGISTRY;
pTab->entry.hKey = hkey;
// Record whether this was new or old.
dispRes = Make_arbitrary_precision(taskData, dwDisp == REG_CREATED_NEW_KEY ? 0: 1);
/* Return a pair of the disposition and the token. */
pair = alloc_and_save(taskData, 2);
DEREFHANDLE(pair)->Set(0, DEREFWORDHANDLE(dispRes));
DEREFHANDLE(pair)->Set(1, DEREFWORDHANDLE(keyResult));
return pair;
}
Handle ShowParent(TaskData *taskData, Handle hFileName)
// Return the name of the immediate parent stored in a child
{
TCHAR fileNameBuff[MAXPATHLEN+1];
POLYUNSIGNED length =
Poly_string_to_C(DEREFHANDLE(hFileName), fileNameBuff, MAXPATHLEN);
if (length > MAXPATHLEN)
raise_syscall(taskData, "File name too long", ENAMETOOLONG);
AutoClose loadFile(_tfopen(fileNameBuff, _T("rb")));
if ((FILE*)loadFile == NULL)
{
char buff[MAXPATHLEN+1+23];
#if (defined(_WIN32) && defined(UNICODE))
sprintf(buff, "Cannot open load file: %S", fileNameBuff);
#else
sprintf(buff, "Cannot open load file: %s", fileNameBuff);
#endif
raise_syscall(taskData, buff, errno);
}
SavedStateHeader header;
// Read the header and check the signature.
if (fread(&header, sizeof(SavedStateHeader), 1, loadFile) != 1)
raise_fail(taskData, "Unable to load header");
if (strncmp(header.headerSignature, SAVEDSTATESIGNATURE, sizeof(header.headerSignature)) != 0)
raise_fail(taskData, "File is not a saved state");
if (header.headerVersion != SAVEDSTATEVERSION ||
header.headerLength != sizeof(SavedStateHeader) ||
header.segmentDescrLength != sizeof(SavedStateSegmentDescr))
{
raise_fail(taskData, "Unsupported version of saved state file");
}
// Does this have a parent?
if (header.parentNameEntry != 0)
{
TCHAR parentFileName[MAXPATHLEN+1];
size_t toRead = header.stringTableSize-header.parentNameEntry;
if (MAXPATHLEN < toRead) toRead = MAXPATHLEN;
if (header.parentNameEntry >= header.stringTableSize /* Bad entry */ ||
fseek(loadFile, header.stringTable + header.parentNameEntry, SEEK_SET) != 0 ||
fread(parentFileName, 1, toRead, loadFile) != toRead)
{
raise_fail(taskData, "Unable to read parent file name");
}
parentFileName[toRead] = 0; // Should already be null-terminated, but just in case.
// Convert the name into a Poly string and then build a "Some" value.
// It's possible, although silly, to have the empty string as a parent name.
Handle resVal = SAVE(C_string_to_Poly(taskData, parentFileName));
Handle result = alloc_and_save(taskData, 1);
DEREFHANDLE(result)->Set(0, DEREFWORDHANDLE(resVal));
return result;
}
else return SAVE(NONE_VALUE);
}
static Handle queryRegistryKey(TaskData *taskData, Handle args, HKEY hkey)
{
TCHAR valName[MAX_PATH];
byte *keyValue = 0;
LONG lRes;
DWORD valSize;
Handle result, resVal, resType;
DWORD dwType;
POLYUNSIGNED length = Poly_string_to_C(args->WordP()->Get(1), valName, MAX_PATH);
if (length > MAX_PATH)
raise_syscall(taskData, "Value name too long", ENAMETOOLONG);
// How long is the entry?
lRes = RegQueryValueEx(hkey, valName, 0, NULL, NULL, &valSize);
// When opening HKEY_PERFORMANCE_DATA we don't get a sensible
// answer here.
if (lRes == ERROR_MORE_DATA) valSize = 1024; // Guess
else if (lRes != ERROR_SUCCESS)
raise_syscall(taskData, "RegQueryValueEx failed", -lRes);
// Allocate that much store and get the value. We could
// try reading directly into ML store to save copying but
// it hardly seems worthwhile.
// Note: It seems that valSize can be zero for some items.
if (valSize == 0) resVal = SAVE(C_string_to_Poly(taskData, "", 0));
else
{
do {
byte *newAlloc = (byte*)realloc(keyValue, valSize);
if (newAlloc == 0)
{
free(keyValue);
raise_syscall(taskData, "Insufficient memory", ENOMEM);
}
keyValue = newAlloc;
lRes = RegQueryValueEx(hkey, valName, 0, &dwType, keyValue, &valSize);
// In the special case of HKEY_PERFORMANCE_DATA we may need to keep
// growing the buffer.
if (lRes == ERROR_MORE_DATA) valSize = valSize + 1024;
} while (lRes == ERROR_MORE_DATA);
if (lRes != ERROR_SUCCESS)
{
free(keyValue);
raise_syscall(taskData, "RegQueryValue failed", -lRes);
}
// If we have a string we have to convert this to ANSI/utf-8.
if (dwType == REG_SZ || dwType == REG_MULTI_SZ || dwType == REG_EXPAND_SZ)
resVal = SAVE(C_string_to_Poly(taskData, (TCHAR*)keyValue, valSize / sizeof(TCHAR)));
else resVal = SAVE(C_string_to_Poly(taskData, (char*)keyValue, valSize));
free(keyValue);
}
/* Create a pair containing the type and the value. */
resType = Make_arbitrary_precision(taskData, dwType);
result = alloc_and_save(taskData, 2);
DEREFHANDLE(result)->Set(0, DEREFWORDHANDLE(resType));
DEREFHANDLE(result)->Set(1, DEREFWORDHANDLE(resVal));
return result;
}
// Delete a key. Note that in Windows NT (but not 95) this will fail if
// the key has subkeys.
static Handle deleteRegistryKey(TaskData *taskData, Handle args, HKEY hkParent)
{
TCHAR keyName[MAX_PATH];
LONG lRes;
POLYUNSIGNED length = Poly_string_to_C(args->WordP()->Get(1), keyName, MAX_PATH);
if (length > MAX_PATH)
raise_syscall(taskData, "Key name too long", ENAMETOOLONG);
// Try deleting the key.
lRes = RegDeleteKey(hkParent, keyName);
if (lRes != ERROR_SUCCESS)
/* Return the error. */
raise_syscall(taskData, "RegDeleteKey failed", -lRes);
return Make_arbitrary_precision(taskData, 0);
}
Handle SaveState(TaskData *taskData, Handle args)
{
TCHAR fileNameBuff[MAXPATHLEN];
POLYUNSIGNED length =
Poly_string_to_C(DEREFHANDLE(args)->Get(0), fileNameBuff, MAXPATHLEN);
if (length > MAXPATHLEN)
raise_syscall(taskData, "File name too long", ENAMETOOLONG);
// The value of depth is zero for top-level save so we need to add one for hierarchy.
unsigned newHierarchy = get_C_unsigned(taskData, DEREFHANDLE(args)->Get(1)) + 1;
if (newHierarchy > hierarchyDepth+1)
raise_fail(taskData, "Depth must be no more than the current hierarchy plus one");
// Request a full GC first. The main reason is to avoid running out of memory as a
// result of repeated saves. Old export spaces are turned into local spaces and
// the GC will delete them if they are completely empty
FullGC(taskData);
SaveRequest request(fileNameBuff, newHierarchy);
processes->MakeRootRequest(taskData, &request);
if (request.errorMessage)
raise_syscall(taskData, request.errorMessage, request.errCode);
return SAVE(TAGGED(0));
}
// Open a registry key and make an entry in the table for it.
static Handle openRegistryKey(TaskData *taskData, Handle args, HKEY hkParent)
{
TCHAR keyName[MAX_PATH];
LONG lRes;
Handle result;
PHANDLETAB pTab;
HKEY hkey;
REGSAM sam = get_C_unsigned(taskData, DEREFWORDHANDLE(args)->Get(2));
POLYUNSIGNED length = Poly_string_to_C(args->WordP()->Get(1), keyName, MAX_PATH);
if (length > MAX_PATH)
raise_syscall(taskData, "Key name too long", ENAMETOOLONG);
// Try opening the key.
lRes = RegOpenKeyEx(hkParent, keyName, 0, sam, &hkey);
if (lRes != ERROR_SUCCESS)
raise_syscall(taskData, "RegOpenKeyEx failed", -lRes);
// Make an entry in the table.
result = make_handle_entry(taskData);
pTab = &handleTable[STREAMID(result)];
pTab->entryType = HE_REGISTRY;
pTab->entry.hKey = hkey;
return result;
}
Handle RenameParent(TaskData *taskData, Handle args)
// Change the name of the immediate parent stored in a child
{
TCHAR fileNameBuff[MAXPATHLEN], parentNameBuff[MAXPATHLEN];
// The name of the file to modify.
POLYUNSIGNED fileLength =
Poly_string_to_C(DEREFHANDLE(args)->Get(0), fileNameBuff, MAXPATHLEN);
if (fileLength > MAXPATHLEN)
raise_syscall(taskData, "File name too long", ENAMETOOLONG);
// The new parent name to insert.
POLYUNSIGNED parentLength =
Poly_string_to_C(DEREFHANDLE(args)->Get(1), parentNameBuff, MAXPATHLEN);
if (parentLength > MAXPATHLEN)
raise_syscall(taskData, "Parent name too long", ENAMETOOLONG);
AutoClose loadFile(_tfopen(fileNameBuff, _T("r+b"))); // Open for reading and writing
if ((FILE*)loadFile == NULL)
{
char buff[MAXPATHLEN+1+23];
#if (defined(_WIN32) && defined(UNICODE))
sprintf(buff, "Cannot open load file: %S", fileNameBuff);
#else
sprintf(buff, "Cannot open load file: %s", fileNameBuff);
#endif
raise_syscall(taskData, buff, errno);
}
SavedStateHeader header;
// Read the header and check the signature.
if (fread(&header, sizeof(SavedStateHeader), 1, loadFile) != 1)
raise_fail(taskData, "Unable to load header");
if (strncmp(header.headerSignature, SAVEDSTATESIGNATURE, sizeof(header.headerSignature)) != 0)
raise_fail(taskData, "File is not a saved state");
if (header.headerVersion != SAVEDSTATEVERSION ||
header.headerLength != sizeof(SavedStateHeader) ||
header.segmentDescrLength != sizeof(SavedStateSegmentDescr))
{
raise_fail(taskData, "Unsupported version of saved state file");
}
// Does this actually have a parent?
if (header.parentNameEntry == 0)
raise_fail(taskData, "File does not have a parent");
// At the moment the only entry in the string table is the parent
// name so we can simply write a new one on the end of the file.
// This makes the file grow slightly each time but it shouldn't be
// significant.
fseek(loadFile, 0, SEEK_END);
header.stringTable = ftell(loadFile); // Remember where this is
_fputtc(0, loadFile); // First byte of string table is zero
_fputts(parentNameBuff, loadFile);
_fputtc(0, loadFile); // A terminating null.
header.stringTableSize = (_tcslen(parentNameBuff) + 2)*sizeof(TCHAR);
// Now rewind and write the header with the revised string table.
fseek(loadFile, 0, SEEK_SET);
fwrite(&header, sizeof(header), 1, loadFile);
return SAVE(TAGGED(0));
}
void MachoExport::exportStore(void)
{
PolyWord *p;
#if (SIZEOF_VOIDP == 8)
struct mach_header_64 fhdr;
struct segment_command_64 sHdr;
struct section_64 *sections = new section_64[memTableEntries+1];
size_t sectionSize = sizeof(section_64);
#else
struct mach_header fhdr;
struct segment_command sHdr;
struct section *sections = new section[memTableEntries+1];
size_t sectionSize = sizeof(section);
#endif
struct symtab_command symTab;
unsigned i;
// Write out initial values for the headers. These are overwritten at the end.
// File header
memset(&fhdr, 0, sizeof(fhdr));
fhdr.filetype = MH_OBJECT;
fhdr.ncmds = 2; // One for the segment and one for the symbol table.
fhdr.sizeofcmds = sizeof(sHdr) + sectionSize * (memTableEntries+1) + sizeof(symTab);
fhdr.flags = 0;
// The machine needs to match the machine we're compiling for
// even if this is actually portable code.
#if (SIZEOF_VOIDP == 8)
fhdr.magic = MH_MAGIC_64; // (0xfeedfacf) 64-bit magic number
#else
fhdr.magic = MH_MAGIC; // Feed Face (0xfeedface)
#endif
#if defined(HOSTARCHITECTURE_X86)
fhdr.cputype = CPU_TYPE_I386;
fhdr.cpusubtype = CPU_SUBTYPE_I386_ALL;
#elif defined(HOSTARCHITECTURE_PPC)
fhdr.cputype = CPU_TYPE_POWERPC;
fhdr.cpusubtype = CPU_SUBTYPE_POWERPC_ALL;
#elif defined(HOSTARCHITECTURE_X86_64)
fhdr.cputype = CPU_TYPE_X86_64;
fhdr.cpusubtype = CPU_SUBTYPE_X86_64_ALL;
#else
#error "No support for exporting on this architecture"
#endif
fwrite(&fhdr, sizeof(fhdr), 1, exportFile); // Write it for the moment.
// Segment header.
memset(&sHdr, 0, sizeof(sHdr));
#if (SIZEOF_VOIDP == 8)
sHdr.cmd = LC_SEGMENT_64;
#else
sHdr.cmd = LC_SEGMENT;
#endif
sHdr.nsects = memTableEntries+1; // One for each entry plus one for the tables.
sHdr.cmdsize = sizeof(sHdr) + sectionSize * sHdr.nsects;
// Add up the sections to give the file size
sHdr.filesize = 0;
for (i = 0; i < memTableEntries; i++)
sHdr.filesize += memTable[i].mtLength; // Do we need any alignment?
sHdr.filesize += sizeof(exportDescription) + memTableEntries * sizeof(memoryTableEntry);
sHdr.vmsize = sHdr.filesize; // Set them the same since we don't have any "common" area.
// sHdr.fileOff is set later.
sHdr.maxprot = VM_PROT_READ|VM_PROT_WRITE|VM_PROT_EXECUTE;
sHdr.initprot = VM_PROT_READ|VM_PROT_WRITE|VM_PROT_EXECUTE;
sHdr.flags = 0;
// Write it initially.
fwrite(&sHdr, sizeof(sHdr), 1, exportFile);
// Section header for each entry in the table
POLYUNSIGNED sectAddr = sizeof(exportDescription)+sizeof(memoryTableEntry)*memTableEntries;
for (i = 0; i < memTableEntries; i++)
{
memset(&(sections[i]), 0, sectionSize);
if (memTable[i].mtFlags & MTF_WRITEABLE)
{
// Mutable areas
ASSERT(!(memTable[i].mtFlags & MTF_EXECUTABLE)); // Executable areas can't be writable.
sprintf(sections[i].sectname, "__data");
sprintf(sections[i].segname, "__DATA");
sections[i].flags = S_ATTR_LOC_RELOC | S_REGULAR;
}
else if (memTable[i].mtFlags & MTF_EXECUTABLE)
{
sprintf(sections[i].sectname, "__text");
sprintf(sections[i].segname, "__TEXT");
sections[i].flags = S_ATTR_LOC_RELOC | S_ATTR_SOME_INSTRUCTIONS | S_REGULAR;
}
else
{
sprintf(sections[i].sectname, "__const");
sprintf(sections[i].segname, "__DATA");
sections[i].flags = S_ATTR_LOC_RELOC | S_REGULAR;
}
sections[i].addr = sectAddr;
sections[i].size = memTable[i].mtLength;
sectAddr += memTable[i].mtLength;
//sections[i].offset is set later
//sections[i].reloff is set later
//sections[i].nreloc is set later
sections[i].align = 3; // 8 byte alignment
// theSection.size is set later
}
// For the tables.
memset(&(sections[memTableEntries]), 0, sectionSize);
sprintf(sections[memTableEntries].sectname, "__const");
sprintf(sections[memTableEntries].segname, "__DATA");
sections[memTableEntries].addr = 0;
sections[memTableEntries].size = sizeof(exportDescription)+sizeof(memoryTableEntry)*memTableEntries;
sections[memTableEntries].align = 3; // 8 byte alignment
// theSection.size is set later
sections[memTableEntries].flags = S_ATTR_LOC_RELOC | S_ATTR_SOME_INSTRUCTIONS | S_REGULAR;
// Write them out for the moment.
fwrite(sections, sectionSize * (memTableEntries+1), 1, exportFile);
// Symbol table header.
memset(&symTab, 0, sizeof(symTab));
symTab.cmd = LC_SYMTAB;
symTab.cmdsize = sizeof(symTab);
//symTab.symoff is set later
//symTab.nsyms is set later
//symTab.stroff is set later
//symTab.strsize is set later
fwrite(&symTab, sizeof(symTab), 1, exportFile);
// Create the symbol table first before we mess up the addresses by turning them
// into relocations.
symTab.symoff = ftell(exportFile);
// Global symbols: Just one. Mach prefixes symbols with an underscore.
writeSymbol("_poly_exports", N_EXT | N_SECT, memTableEntries, 0); // The export table comes first
// We create local symbols because they make debugging easier. They may also
// mean that we can use the usual Unix profiling tools.
writeSymbol("memTable", N_SECT, memTableEntries, sizeof(exportDescription)); // Then the memTable.
for (i = 0; i < memTableEntries; i++)
{
if (i == ioMemEntry)
writeSymbol("ioarea", N_SECT, i, 0);
else {
char buff[50];
sprintf(buff, "area%0d", i);
writeSymbol(buff, N_SECT, i, 0);
#if (SIZEOF_VOIDP == 8)
// See if we can find the names of any functions.
// This seems to break on 32-bit Mac OS X. It seems to align
// some relocations onto an 8-byte boundary so we just disable it.
char *start = (char*)memTable[i].mtAddr;
char *end = start + memTable[i].mtLength;
for (p = (PolyWord*)start; p < (PolyWord*)end; )
{
p++;
PolyObject *obj = (PolyObject*)p;
POLYUNSIGNED length = obj->Length();
if (length != 0 && obj->IsCodeObject())
{
PolyWord *name = obj->ConstPtrForCode();
// Copy as much of the name as will fit and ignore any extra.
// Do we need to worry about duplicates?
(void)Poly_string_to_C(*name, buff, sizeof(buff));
writeSymbol(buff, N_SECT, i, (char*)p - start);
}
p += length;
}
#endif
}
}
symTab.nsyms = symbolCount;
// Create and write out the relocations.
for (i = 0; i < memTableEntries; i++)
{
sections[i].reloff = ftell(exportFile);
relocationCount = 0;
if (i != ioMemEntry) // Don't relocate the IO area
{
// Create the relocation table and turn all addresses into offsets.
char *start = (char*)memTable[i].mtAddr;
char *end = start + memTable[i].mtLength;
for (p = (PolyWord*)start; p < (PolyWord*)end; )
{
p++;
PolyObject *obj = (PolyObject*)p;
POLYUNSIGNED length = obj->Length();
if (length != 0 && obj->IsCodeObject())
machineDependent->ScanConstantsWithinCode(obj, this);
relocateObject(obj);
p += length;
}
}
sections[i].nreloc = relocationCount;
}
// Additional relocations for the descriptors.
sections[memTableEntries].reloff = ftell(exportFile);
relocationCount = 0;
// Address of "memTable" within "exports". We can't use createRelocation because
// the position of the relocation is not in either the mutable or the immutable area.
createStructsRelocation(memTableEntries, offsetof(exportDescription, memTable));
// Address of "rootFunction" within "exports"
unsigned rootAddrArea = findArea(rootFunction);
POLYUNSIGNED rootOffset = (char*)rootFunction - (char*)memTable[rootAddrArea].mtAddr;
adjustOffset(rootAddrArea, rootOffset);
createStructsRelocation(rootAddrArea, offsetof(exportDescription, rootFunction));
// Addresses of the areas within memtable.
for (i = 0; i < memTableEntries; i++)
{
createStructsRelocation(i,
sizeof(exportDescription) + i * sizeof(memoryTableEntry) + offsetof(memoryTableEntry, mtAddr));
}
sections[memTableEntries].nreloc = relocationCount;
// The symbol name table
symTab.stroff = ftell(exportFile);
fwrite(stringTable.strings, stringTable.stringSize, 1, exportFile);
symTab.strsize = stringTable.stringSize;
alignFile(4);
exportDescription exports;
memset(&exports, 0, sizeof(exports));
exports.structLength = sizeof(exportDescription);
exports.memTableSize = sizeof(memoryTableEntry);
exports.memTableEntries = memTableEntries;
exports.ioIndex = 0; // The io entry is the first in the memory table
exports.memTable = (memoryTableEntry *)sizeof(exportDescription); // It follows immediately after this.
// Set the value to be the offset relative to the base of the area. We have set a relocation
// already which will add the base of the area.
exports.rootFunction = (void*)rootOffset;
exports.timeStamp = time(NULL);
exports.ioSpacing = ioSpacing;
exports.architecture = machineDependent->MachineArchitecture();
exports.rtsVersion = POLY_version_number;
sections[memTableEntries].offset = ftell(exportFile);
fwrite(&exports, sizeof(exports), 1, exportFile);
POLYUNSIGNED addrOffset = sizeof(exports)+sizeof(memoryTableEntry)*memTableEntries;
for (i = 0; i < memTableEntries; i++)
{
void *save = memTable[i].mtAddr;
memTable[i].mtAddr = (void*)addrOffset; // Set this to the relative address.
addrOffset += memTable[i].mtLength;
fwrite(&memTable[i], sizeof(memoryTableEntry), 1, exportFile);
memTable[i].mtAddr = save;
}
// Now the binary data.
for (i = 0; i < memTableEntries; i++)
{
alignFile(4);
sections[i].offset = ftell(exportFile);
fwrite(memTable[i].mtAddr, 1, memTable[i].mtLength, exportFile);
}
// Rewind to rewrite the headers with the actual offsets.
rewind(exportFile);
fwrite(&fhdr, sizeof(fhdr), 1, exportFile); // File header
fwrite(&sHdr, sizeof(sHdr), 1, exportFile); // Segment header
fwrite(sections, sectionSize * (memTableEntries+1), 1, exportFile); // Section headers
fwrite(&symTab, sizeof(symTab), 1, exportFile); // Symbol table header
fclose(exportFile); exportFile = NULL;
delete[](sections);
}
Handle OS_spec_dispatch_c(TaskData *taskData, Handle args, Handle code)
{
unsigned c = get_C_unsigned(taskData, DEREFWORD(code));
switch (c)
{
case 0: /* Return our OS type. Not in any structure. */
return Make_arbitrary_precision(taskData, 1); /* 1 for Windows. */
/* Windows-specific functions. */
case 1000: /* execute */
return execute(taskData, args);
case 1001: /* Get input stream as text. */
return openProcessHandle(taskData, args, TRUE, TRUE);
case 1002: /* Get output stream as text. */
return openProcessHandle(taskData, args, FALSE, TRUE);
case 1003: /* Get input stream as binary. */
return openProcessHandle(taskData, args, TRUE, FALSE);
case 1004: /* Get output stream as binary. */
return openProcessHandle(taskData, args, FALSE, FALSE);
case 1005: /* Get result of process. */
{
PHANDLETAB hnd = get_handle(DEREFWORD(args), HE_PROCESS);
if (hnd == 0)
raise_syscall(taskData, "Process is closed", EINVAL);
// Close the streams. Either of them may have been
// passed to the stream package.
if (hnd->entry.process.hInput != INVALID_HANDLE_VALUE)
CloseHandle(hnd->entry.process.hInput);
hnd->entry.process.hInput = INVALID_HANDLE_VALUE;
if (hnd->entry.process.hEvent)
CloseHandle(hnd->entry.process.hEvent);
hnd->entry.process.hEvent = NULL;
if (hnd->entry.process.readToken)
{
PIOSTRUCT strm =
get_stream(hnd->entry.process.readToken);
if (strm != NULL) close_stream(strm);
}
hnd->entry.process.readToken = 0;
if (hnd->entry.process.hOutput != INVALID_HANDLE_VALUE)
CloseHandle(hnd->entry.process.hOutput);
hnd->entry.process.hOutput = INVALID_HANDLE_VALUE;
if (hnd->entry.process.writeToken)
{
PIOSTRUCT strm =
get_stream(hnd->entry.process.writeToken);
if (strm != NULL) close_stream(strm);
}
hnd->entry.process.writeToken = 0;
// See if it's finished.
while (true) {
DWORD dwResult;
if (GetExitCodeProcess(hnd->entry.process.hProcess, &dwResult) == 0)
raise_syscall(taskData, "GetExitCodeProcess failed",
-(int)GetLastError());
if (dwResult != STILL_ACTIVE) {
/* Finished - return the result. */
/* Note: we haven't closed the handle because we might want to ask
for the result again. We only close it when we've garbage-collected
the token. Doing this runs the risk of running out of handles.
Maybe change it and remember the result in ML. */
return Make_arbitrary_precision(taskData, dwResult);
}
// Block and try again.
WaitHandle waiter(hnd->entry.process.hProcess);
processes->ThreadPauseForIO(taskData, &waiter);
}
}
case 1006: /* Return a constant. */
{
unsigned i = get_C_unsigned(taskData, DEREFWORD(args));
if (i >= sizeof(winConstVec)/sizeof(winConstVec[0]))
raise_syscall(taskData, "Invalid index", 0);
return Make_arbitrary_precision(taskData, winConstVec[i]);
}
/* Registry functions. */
case 1007: // Open a key within one of the roots.
{
unsigned keyIndex = get_C_unsigned(taskData, DEREFWORDHANDLE(args)->Get(0));
// This should only ever happen as a result of a fault in
// the Windows structure.
if (keyIndex >= sizeof(hkPredefinedKeyTab)/sizeof(hkPredefinedKeyTab[0]))
raise_syscall(taskData, "Invalid index", 0);
return openRegistryKey(taskData, args, hkPredefinedKeyTab[keyIndex]);
}
case 1008: // Open a subkey of an opened key.
{
PHANDLETAB hnd =
get_handle(DEREFHANDLE(args)->Get(0), HE_REGISTRY);
if (hnd == 0)
raise_syscall(taskData, "Handle is closed", -ERROR_INVALID_HANDLE);
return openRegistryKey(taskData, args, hnd->entry.hKey);
}
case 1009: // Create a subkey within one of the roots.
{
unsigned keyIndex = get_C_unsigned(taskData, DEREFWORDHANDLE(args)->Get(0));
// This should only ever happen as a result of a fault in
// the Windows structure.
if (keyIndex >= sizeof(hkPredefinedKeyTab)/sizeof(hkPredefinedKeyTab[0]))
raise_syscall(taskData, "Invalid index", 0);
return createRegistryKey(taskData, args, hkPredefinedKeyTab[keyIndex]);
}
case 1010: // Create a subkey within an opened key.
{
PHANDLETAB hnd =
get_handle(DEREFHANDLE(args)->Get(0), HE_REGISTRY);
if (hnd == 0)
raise_syscall(taskData, "Handle is closed", -ERROR_INVALID_HANDLE);
return createRegistryKey(taskData, args, hnd->entry.hKey);
}
case 1011: // Close a registry handle.
{
PHANDLETAB hnd = get_handle(DEREFWORD(args), HE_REGISTRY);
if (hnd != 0) close_handle(hnd);
return Make_arbitrary_precision(taskData, 0);
}
case 1012: // Get a value
{
unsigned keyIndex = get_C_unsigned(taskData, DEREFWORDHANDLE(args)->Get(0));
// This should only ever happen as a result of a fault in
// the Windows structure.
if (keyIndex >= sizeof(hkPredefinedKeyTab)/sizeof(hkPredefinedKeyTab[0]))
raise_syscall(taskData, "Invalid index", 0);
return queryRegistryKey(taskData, args, hkPredefinedKeyTab[keyIndex]);
}
case 1013: // Get a value
{
PHANDLETAB hnd =
get_handle(DEREFHANDLE(args)->Get(0), HE_REGISTRY);
if (hnd == 0)
raise_syscall(taskData, "Handle is closed", -ERROR_INVALID_HANDLE);
return queryRegistryKey(taskData, args, hnd->entry.hKey);
}
case 1014: // Delete a subkey
{
unsigned keyIndex = get_C_unsigned(taskData, DEREFWORDHANDLE(args)->Get(0));
// This should only ever happen as a result of a fault in
// the Windows structure.
if (keyIndex >= sizeof(hkPredefinedKeyTab)/sizeof(hkPredefinedKeyTab[0]))
raise_syscall(taskData, "Invalid index", 0);
return deleteRegistryKey(taskData, args, hkPredefinedKeyTab[keyIndex]);
}
case 1015: // Delete a subkey
{
PHANDLETAB hnd =
get_handle(DEREFHANDLE(args)->Get(0), HE_REGISTRY);
if (hnd == 0)
raise_syscall(taskData, "Handle is closed", -ERROR_INVALID_HANDLE);
return deleteRegistryKey(taskData, args, hnd->entry.hKey);
}
case 1016: // Set a value
{
unsigned keyIndex = get_C_unsigned(taskData, DEREFWORDHANDLE(args)->Get(0));
// This should only ever happen as a result of a fault in
// the Windows structure.
if (keyIndex >= sizeof(hkPredefinedKeyTab)/sizeof(hkPredefinedKeyTab[0]))
raise_syscall(taskData, "Invalid index", 0);
return setRegistryKey(taskData, args, hkPredefinedKeyTab[keyIndex]);
}
case 1017: // Set a value
{
PHANDLETAB hnd =
get_handle(DEREFHANDLE(args)->Get(0), HE_REGISTRY);
if (hnd == 0)
raise_syscall(taskData, "Handle is closed", -ERROR_INVALID_HANDLE);
return setRegistryKey(taskData, args, hnd->entry.hKey);
}
case 1018: // Enumerate a key in the predefined keys
{
unsigned keyIndex = get_C_unsigned(taskData, DEREFWORDHANDLE(args)->Get(0));
if (keyIndex >= sizeof(hkPredefinedKeyTab)/sizeof(hkPredefinedKeyTab[0]))
raise_syscall(taskData, "Invalid index", 0);
return enumerateRegistry(taskData, args, hkPredefinedKeyTab[keyIndex], TRUE);
}
case 1019: // Enumerate a key in an opened key
{
PHANDLETAB hnd =
get_handle(DEREFHANDLE(args)->Get(0), HE_REGISTRY);
if (hnd == 0)
raise_syscall(taskData, "Handle is closed", -ERROR_INVALID_HANDLE);
return enumerateRegistry(taskData, args, hnd->entry.hKey, TRUE);
}
case 1020: // Enumerate a value in the predefined keys
{
unsigned keyIndex = get_C_unsigned(taskData, DEREFWORDHANDLE(args)->Get(0));
if (keyIndex >= sizeof(hkPredefinedKeyTab)/sizeof(hkPredefinedKeyTab[0]))
raise_syscall(taskData, "Invalid index", 0);
return enumerateRegistry(taskData, args, hkPredefinedKeyTab[keyIndex], FALSE);
}
case 1021: // Enumerate a value in an opened key
{
PHANDLETAB hnd =
get_handle(DEREFHANDLE(args)->Get(0), HE_REGISTRY);
if (hnd == 0)
raise_syscall(taskData, "Handle is closed", -ERROR_INVALID_HANDLE);
return enumerateRegistry(taskData, args, hnd->entry.hKey, FALSE);
}
case 1022: // Delete a value
{
unsigned keyIndex = get_C_unsigned(taskData, DEREFWORDHANDLE(args)->Get(0));
// This should only ever happen as a result of a fault in
// the Windows structure.
if (keyIndex >= sizeof(hkPredefinedKeyTab)/sizeof(hkPredefinedKeyTab[0]))
raise_syscall(taskData, "Invalid index", 0);
return deleteRegistryValue(taskData, args, hkPredefinedKeyTab[keyIndex]);
}
case 1023: // Delete a value
{
PHANDLETAB hnd =
get_handle(DEREFHANDLE(args)->Get(0), HE_REGISTRY);
if (hnd == 0)
raise_syscall(taskData, "Handle is closed", -ERROR_INVALID_HANDLE);
return deleteRegistryValue(taskData, args, hnd->entry.hKey);
}
case 1030: // Convert UTC time values to local time. -- No longer used??
{
FILETIME ftUTC, ftLocal;
/* Get the file time. */
getFileTimeFromArb(taskData, args, &ftUTC);
if (! FileTimeToLocalFileTime(&ftUTC, &ftLocal))
raise_syscall(taskData, "FileTimeToLocalFileTime failed",
-(int)GetLastError());
return Make_arb_from_Filetime(taskData, ftLocal);
}
case 1031: // Convert local time values to UTC. -- No longer used??
{
FILETIME ftUTC, ftLocal;
/* Get the file time. */
getFileTimeFromArb(taskData, args, &ftLocal);
if (! LocalFileTimeToFileTime(&ftLocal, &ftUTC))
raise_syscall(taskData, "LocalFileTimeToFileTime failed",
-(int)GetLastError());
return Make_arb_from_Filetime(taskData, ftUTC);
}
case 1032: // Get volume information.
{
TCHAR rootName[MAX_PATH], volName[MAX_PATH], sysName[MAX_PATH];
DWORD dwVolSerial, dwMaxComponentLen, dwFlags;
Handle volHandle, sysHandle, serialHandle, maxCompHandle;
Handle resultHandle;
POLYUNSIGNED length = Poly_string_to_C(DEREFWORD(args), rootName, MAX_PATH);
if (length > MAX_PATH)
raise_syscall(taskData, "Root name too long", ENAMETOOLONG);
if (!GetVolumeInformation(rootName, volName, MAX_PATH,
&dwVolSerial, &dwMaxComponentLen, &dwFlags,
sysName, MAX_PATH))
raise_syscall(taskData, "GetVolumeInformation failed",
-(int)GetLastError());
volHandle = SAVE(C_string_to_Poly(taskData, volName));
sysHandle = SAVE(C_string_to_Poly(taskData, sysName));
serialHandle = Make_arbitrary_precision(taskData, dwVolSerial);
maxCompHandle = Make_arbitrary_precision(taskData, dwMaxComponentLen);
resultHandle = alloc_and_save(taskData, 4);
DEREFHANDLE(resultHandle)->Set(0, DEREFWORDHANDLE(volHandle));
DEREFHANDLE(resultHandle)->Set(1, DEREFWORDHANDLE(sysHandle));
DEREFHANDLE(resultHandle)->Set(2, DEREFWORDHANDLE(serialHandle));
DEREFHANDLE(resultHandle)->Set(3, DEREFWORDHANDLE(maxCompHandle));
return resultHandle;
}
case 1033:
{
TCHAR fileName[MAX_PATH], execName[MAX_PATH];
POLYUNSIGNED length = Poly_string_to_C(DEREFWORD(args), fileName, MAX_PATH);
HINSTANCE hInst;
if (length > MAX_PATH)
raise_syscall(taskData, "File name too long", ENAMETOOLONG);
hInst = FindExecutable(fileName, NULL, execName);
if ((POLYUNSIGNED)hInst <= 32)
{
raise_syscall(taskData, "FindExecutable failed", -(int)(POLYUNSIGNED)hInst);
}
return SAVE(C_string_to_Poly(taskData, execName));
}
case 1034: // Open a document
{
SHELLEXECUTEINFO shellEx;
memset(&shellEx, 0, sizeof(shellEx));
shellEx.cbSize = sizeof(shellEx);
shellEx.lpVerb = _T("open");
shellEx.lpFile = Poly_string_to_T_alloc(DEREFWORD(args));
shellEx.hwnd = hMainWindow;
shellEx.nShow = SW_SHOWNORMAL;
BOOL fRes = ShellExecuteEx(&shellEx);
free((void*)shellEx.lpFile);
if (! fRes)
raise_syscall(taskData, "ShellExecuteEx failed", 0-GetLastError());
return Make_arbitrary_precision(taskData, 0);
}
case 1035: // Launch an application.
{
SHELLEXECUTEINFO shellEx;
memset(&shellEx, 0, sizeof(shellEx));
shellEx.cbSize = sizeof(shellEx);
shellEx.lpVerb = _T("open");
shellEx.lpFile = Poly_string_to_T_alloc(args->WordP()->Get(0));
shellEx.lpParameters = Poly_string_to_T_alloc(args->WordP()->Get(1));
shellEx.nShow = SW_SHOWNORMAL;
BOOL fRes = ShellExecuteEx(&shellEx);
free((void*)shellEx.lpFile);
free((void*)shellEx.lpParameters);
if (! fRes)
raise_syscall(taskData, "ShellExecuteEx failed", 0-GetLastError());
return Make_arbitrary_precision(taskData, 0);
}
case 1036: // Does the process have its own console?
return Make_arbitrary_precision(taskData, hMainWindow != NULL ? 1: 0);
case 1037: // Simple execute.
return simpleExecute(taskData, args);
// DDE
case 1038: // Start DDE dialogue.
{
Handle handToken;
PHANDLETAB pTab;
HCONV hcDDEConv;
TCHAR *serviceName = Poly_string_to_T_alloc(args->WordP()->Get(0));
TCHAR *topicName = Poly_string_to_T_alloc(args->WordP()->Get(1));
/* Send a request to the main thread to do the work. */
hcDDEConv = StartDDEConversation(serviceName, topicName);
free(serviceName); free(topicName);
if (hcDDEConv == 0) raise_syscall(taskData, "DdeConnect failed", 0);
// Create an entry to return the conversation.
handToken = make_handle_entry(taskData);
pTab = &handleTable[STREAMID(handToken)];
pTab->entryType = HE_DDECONVERSATION;
pTab->entry.hcDDEConv = hcDDEConv;
return handToken;
}
case 1039: // Send DDE execute request.
{
PHANDLETAB hnd =
get_handle(DEREFHANDLE(args)->Get(0), HE_DDECONVERSATION);
LRESULT res;
char *command;
if (hnd == NULL)
{
raise_syscall(taskData, "DDE Conversation is closed", 0);
}
command = Poly_string_to_C_alloc(args->WordP()->Get(1));
/* Send a request to the main thread to do the work. */
res = ExecuteDDE(command, hnd->entry.hcDDEConv);
free(command);
if (res == -1) raise_syscall(taskData, "DdeClientTransaction failed", 0);
else return Make_arbitrary_precision(taskData, res);
}
case 1040: // Close a DDE conversation.
{
PHANDLETAB hnd = get_handle(args->Word(), HE_DDECONVERSATION);
if (hnd != 0) close_handle(hnd);
return Make_arbitrary_precision(taskData, 0);
}
// Configuration functions.
case 1050: // Get version data
{
OSVERSIONINFO osver;
ZeroMemory(&osver, sizeof(OSVERSIONINFO));
osver.dwOSVersionInfoSize = sizeof(OSVERSIONINFO);
// GetVersionEx is deprecated in Windows 8.1
if (! GetVersionEx(&osver))
raise_syscall(taskData, "GetVersionEx failed", -(int)GetLastError());
Handle major = Make_arbitrary_precision(taskData, osver.dwMajorVersion);
Handle minor = Make_arbitrary_precision(taskData, osver.dwMinorVersion);
Handle build = Make_arbitrary_precision(taskData, osver.dwBuildNumber);
Handle platform = Make_arbitrary_precision(taskData, osver.dwPlatformId);
Handle version = SAVE(C_string_to_Poly(taskData, osver.szCSDVersion));
Handle resVal = alloc_and_save(taskData, 5);
DEREFHANDLE(resVal)->Set(0, DEREFWORDHANDLE(major));
DEREFHANDLE(resVal)->Set(1, DEREFWORDHANDLE(minor));
DEREFHANDLE(resVal)->Set(2, DEREFWORDHANDLE(build));
DEREFHANDLE(resVal)->Set(3, DEREFWORDHANDLE(platform));
DEREFHANDLE(resVal)->Set(4, DEREFWORDHANDLE(version));
return resVal;
}
case 1051: // Get windows directory
{
TCHAR path[MAX_PATH+1];
if (GetWindowsDirectory(path, sizeof(path)/sizeof(TCHAR)) == 0)
raise_syscall(taskData, "GetWindowsDirectory failed", -(int)GetLastError());
return SAVE(C_string_to_Poly(taskData, path));
}
case 1052: // Get system directory
{
TCHAR path[MAX_PATH+1];
if (GetSystemDirectory(path, sizeof(path)/sizeof(TCHAR)) == 0)
raise_syscall(taskData, "GetSystemDirectory failed", -(int)GetLastError());
return SAVE(C_string_to_Poly(taskData, path));
}
case 1053: // Get computer name
{
TCHAR name[MAX_COMPUTERNAME_LENGTH +1];
DWORD dwSize = MAX_COMPUTERNAME_LENGTH +1;
if (GetComputerName(name, &dwSize) == 0)
raise_syscall(taskData, "GetComputerName failed", -(int)GetLastError());
return SAVE(C_string_to_Poly(taskData, name));
}
case 1054: // Get user name
{
TCHAR name[UNLEN +1];
DWORD dwSize = UNLEN +1;
if (GetUserName(name, &dwSize) == 0)
raise_syscall(taskData, "GetUserName failed", -(int)GetLastError());
return SAVE(C_string_to_Poly(taskData, name));
}
case 1100: // Get the error result from the last call.
// This is saved when we make a call to a foreign function.
{
return(SAVE(TAGGED(taskData->lastError)));
}
case 1101: // Wait for a message.
{
HWND hwnd = *(HWND*)(DEREFWORDHANDLE(args)->Get(0).AsCodePtr());
UINT wMsgFilterMin = get_C_unsigned(taskData, DEREFWORDHANDLE(args)->Get(1));
UINT wMsgFilterMax = get_C_unsigned(taskData, DEREFWORDHANDLE(args)->Get(2));
while (1)
{
MSG msg;
processes->ThreadReleaseMLMemory(taskData);
// N.B. PeekMessage may directly call the window proc resulting in a
// callback to ML. For this to work a callback must not overwrite "args".
BOOL result = PeekMessage(&msg, hwnd, wMsgFilterMin, wMsgFilterMax, PM_NOREMOVE);
processes->ThreadUseMLMemory(taskData);
if (result) return Make_arbitrary_precision(taskData, 0);
// Pause until a message arrives.
processes->ThreadPause(taskData);
}
}
// case 1102: // Return the address of the window callback function.
case 1103: // Return the application instance.
{
Handle result = alloc_and_save(taskData, 1, F_BYTE_OBJ);
*(HINSTANCE*)(result->Word().AsCodePtr()) = hApplicationInstance;
return result;
}
case 1104: // Return the main window handle
{
Handle result = alloc_and_save(taskData, 1, F_BYTE_OBJ);
*(HWND*)(result->Word().AsCodePtr()) = hMainWindow;
return result;
}
// case 1105: // Set the callback function
default:
{
char msg[100];
sprintf(msg, "Unknown windows-specific function: %d", c);
raise_exception_string(taskData, EXC_Fail, msg);
return 0;
}
}
}
Handle process_env_dispatch_c(TaskData *mdTaskData, Handle args, Handle code)
{
unsigned c = get_C_unsigned(mdTaskData, DEREFWORDHANDLE(code));
switch (c)
{
case 0: /* Return the program name. */
return SAVE(C_string_to_Poly(mdTaskData, userOptions.programName));
case 1: /* Return the argument list. */
return convert_string_list(mdTaskData, userOptions.user_arg_count, userOptions.user_arg_strings);
case 14: /* Return a string from the environment. */
{
TempString buff(args->Word());
if (buff == 0) raise_syscall(mdTaskData, "Insufficient memory", ENOMEM);
TCHAR *res = _tgetenv(buff);
if (res == NULL) raise_syscall(mdTaskData, "Not Found", 0);
else return SAVE(C_string_to_Poly(mdTaskData, res));
}
case 21: // Return the whole environment. Only available in Posix.ProcEnv.
{
/* Count the environment strings */
int env_count = 0;
while (environ[env_count] != NULL) env_count++;
return convert_string_list(mdTaskData, env_count, environ);
}
case 15: /* Return the success value. */
return Make_arbitrary_precision(mdTaskData, EXIT_SUCCESS);
case 16: /* Return a failure value. */
return Make_arbitrary_precision(mdTaskData, EXIT_FAILURE);
case 17: /* Run command. */
{
TempString buff(args->Word());
if (buff == 0) raise_syscall(mdTaskData, "Insufficient memory", ENOMEM);
int res = -1;
#if (defined(_WIN32) && ! defined(__CYGWIN__))
// Windows.
TCHAR *argv[4];
argv[0] = _tgetenv(_T("COMSPEC")); // Default CLI.
if (argv[0] == 0) argv[0] = (TCHAR*)_T("cmd.exe"); // Win NT etc.
argv[1] = (TCHAR*)_T("/c");
argv[2] = buff;
argv[3] = NULL;
// If _P_NOWAIT is given the result is the process handle.
// spawnvp does any necessary path searching if argv[0]
// does not contain a full path.
intptr_t pid = _tspawnvp(_P_NOWAIT, argv[0], argv);
if (pid == -1)
raise_syscall(mdTaskData, "Function system failed", errno);
#else
// Cygwin and Unix
char *argv[4];
argv[0] = (char*)"sh";
argv[1] = (char*)"-c";
argv[2] = buff;
argv[3] = NULL;
#if (defined(__CYGWIN__))
CygwinSpawnRequest request(argv);
processes->MakeRootRequest(mdTaskData, &request);
int pid = request.pid;
if (pid < 0)
raise_syscall(mdTaskData, "Function system failed", errno);
#else
// We need to break this down so that we can unblock signals in the
// child process.
// The Unix "system" function seems to set SIGINT and SIGQUIT to
// SIG_IGN in the parent so that the wait will not be interrupted.
// That may make sense in a single-threaded application but is
// that right here?
int pid = vfork();
if (pid == -1)
raise_syscall(mdTaskData, "Function system failed", errno);
else if (pid == 0)
{ // In child
sigset_t sigset;
sigemptyset(&sigset);
sigprocmask(SIG_SETMASK, &sigset, 0);
// Reset other signals?
execve("/bin/sh", argv, environ);
_exit(1);
}
#endif
#endif
while (true)
{
try
{
// Test to see if the child has returned.
#if (defined(_WIN32) && ! defined(__CYGWIN__))
switch (WaitForSingleObject((HANDLE)pid, 0))
{
case WAIT_OBJECT_0:
{
DWORD result;
BOOL fResult = GetExitCodeProcess((HANDLE)pid, &result);
if (! fResult)
raise_syscall(mdTaskData, "Function system failed", -(int)GetLastError());
CloseHandle((HANDLE)pid);
return Make_arbitrary_precision(mdTaskData, result);
}
case WAIT_FAILED:
raise_syscall(mdTaskData, "Function system failed", -(int)GetLastError());
}
// Wait for the process to exit or for the timeout
WaitHandle waiter((HANDLE)pid);
processes->ThreadPauseForIO(mdTaskData, &waiter);
#else
int wRes = waitpid(pid, &res, WNOHANG);
if (wRes > 0)
break;
else if (wRes < 0)
{
raise_syscall(mdTaskData, "Function system failed", errno);
}
// In Unix the best we can do is wait. This may be interrupted
// by SIGCHLD depending on where signals are processed.
// One possibility is for the main thread to somehow wake-up
// the thread when it processes a SIGCHLD.
processes->ThreadPause(mdTaskData);
#endif
}
catch (...)
{
// Either IOException or KillException.
// We're abandoning the wait. This will leave
// a zombie in Unix.
#if (defined(_WIN32) && ! defined(__CYGWIN__))
CloseHandle((HANDLE)pid);
#endif
throw;
}
}
return Make_arbitrary_precision(mdTaskData, res);
}
case 18: /* Register function to run at exit. */
{
PLocker locker(&atExitLock);
if (! exiting)
{
PolyObject *cell = alloc(mdTaskData, 2);
cell->Set(0, at_exit_list);
cell->Set(1, DEREFWORD(args));
at_exit_list = cell;
}
return Make_arbitrary_precision(mdTaskData, 0);
}
case 19: /* Return the next function in the atExit list and set the
"exiting" flag to true. */
{
PLocker locker(&atExitLock);
Handle res;
exiting = true; /* Ignore further calls to atExit. */
if (at_exit_list == TAGGED(0))
raise_syscall(mdTaskData, "List is empty", 0);
PolyObject *cell = at_exit_list.AsObjPtr();
res = SAVE(cell->Get(1));
at_exit_list = cell->Get(0);
return res;
}
case 20: /* Terminate without running the atExit list or flushing buffers. */
{
/* I don't like terminating without some sort of clean up
but we'll do it this way for the moment. */
int i = get_C_int(mdTaskData, DEREFWORDHANDLE(args));
_exit(i);
}
/************ Error codes **************/
case 2: /* Get the name of a numeric error message. */
{
char buff[40];
int e = get_C_int(mdTaskData, DEREFWORDHANDLE(args));
Handle res;
/* First look to see if we have the name in
the error table. They should generally all be
there. */
const char *errorMsg = stringFromErrorCode(e);
if (errorMsg != NULL)
return SAVE(C_string_to_Poly(mdTaskData, errorMsg));
/* We get here if there's an error which isn't in the table. */
#if (defined(_WIN32) && ! defined(__CYGWIN__))
/* In the Windows version we may have both errno values
and also GetLastError values. We convert the latter into
negative values before returning them. */
if (e < 0)
{
sprintf(buff, "WINERROR%0d", -e);
res = SAVE(C_string_to_Poly(mdTaskData, buff));
return res;
}
else
#endif
{
sprintf(buff, "ERROR%0d", e);
res = SAVE(C_string_to_Poly(mdTaskData, buff));
}
return res;
}
case 3: /* Get the explanatory message for an error. */
{
return errorMsg(mdTaskData, get_C_int(mdTaskData, DEREFWORDHANDLE(args)));
}
case 4: /* Try to convert an error string to an error number. */
{
char buff[40];
/* Get the string. */
Poly_string_to_C(DEREFWORD(args), buff, sizeof(buff));
/* Look the string up in the table. */
int err = 0;
if (errorCodeFromString(buff, &err))
return Make_arbitrary_precision(mdTaskData, err);
/* If we don't find it then it may have been a constructed
error name. */
if (strncmp(buff, "ERROR", 5) == 0)
{
int i = atoi(buff+5);
if (i > 0) return Make_arbitrary_precision(mdTaskData, i);
}
#if (defined(_WIN32) && ! defined(__CYGWIN__))
if (strncmp(buff, "WINERROR", 8) == 0)
{
int i = atoi(buff+8);
if (i > 0) return Make_arbitrary_precision(mdTaskData, -i);
}
#endif
return Make_arbitrary_precision(mdTaskData, 0);
}
/************ Directory/file paths **************/
case 5: /* Return the string representing the current arc. */
return SAVE(C_string_to_Poly(mdTaskData, "."));
case 6: /* Return the string representing the parent arc. */
/* I don't know that this exists in MacOS. */
return SAVE(C_string_to_Poly(mdTaskData, ".."));
case 7: /* Return the string representing the directory separator. */
return SAVE(C_string_to_Poly(mdTaskData, DEFAULTSEPARATOR));
case 8: /* Test the character to see if it matches a separator. */
{
int e = get_C_int(mdTaskData, DEREFWORDHANDLE(args));
if (ISPATHSEPARATOR(e))
return Make_arbitrary_precision(mdTaskData, 1);
else return Make_arbitrary_precision(mdTaskData, 0);
}
case 9: /* Are names case-sensitive? */
#if (defined(_WIN32) && ! defined(__CYGWIN__))
/* Windows - no. */
return Make_arbitrary_precision(mdTaskData, 0);
#else
/* Unix - yes. */
return Make_arbitrary_precision(mdTaskData, 1);
#endif
// These are no longer used. The code is handled entirely in ML.
case 10: /* Are empty arcs redundant? */
/* Unix and Windows - yes. */
return Make_arbitrary_precision(mdTaskData, 1);
case 11: /* Match the volume name part of a path. */
{
const TCHAR *volName = NULL;
int isAbs = 0;
int toRemove = 0;
PolyWord path = DEREFHANDLE(args);
/* This examines the start of a string and determines
how much of it represents the volume name and returns
the number of characters to remove, the volume name
and whether it is absolute.
One would assume that if there is a volume name then it
is absolute but there is a peculiar form in Windows/DOS
(e.g. A:b\c) which means the file b\c relative to the
currently selected directory on the volume A.
*/
#if (defined(_WIN32) && ! defined(__CYGWIN__))
TempString buff(path);
if (buff == 0) raise_syscall(mdTaskData, "Insufficient memory", ENOMEM);
size_t length = _tcslen(buff);
if (length >= 2 && buff[1] == ':')
{ /* Volume name? */
if (length >= 3 && ISPATHSEPARATOR(buff[2]))
{
/* Absolute path. */
toRemove = 3; isAbs = 1;
}
else { toRemove = 2; isAbs = 0; }
volName = buff; buff[2] = '\0';
}
else if (length > 3 &&
ISPATHSEPARATOR(buff[0]) &&
ISPATHSEPARATOR(buff[1]) &&
! ISPATHSEPARATOR(buff[2]))
{ /* UNC name? */
int i;
/* Skip the server name. */
for (i = 3; buff[i] != 0 && !ISPATHSEPARATOR(buff[i]); i++);
if (ISPATHSEPARATOR(buff[i]))
{
i++;
/* Skip the share name. */
for (; buff[i] != 0 && !ISPATHSEPARATOR(buff[i]); i++);
toRemove = i;
if (buff[i] != 0) toRemove++;
isAbs = 1;
volName = buff;
buff[i] = '\0';
}
}
else if (ISPATHSEPARATOR(buff[0]))
/* \a\b strictly speaking is relative to the
current drive. It's much easier to treat it
as absolute. */
{ toRemove = 1; isAbs = 1; volName = _T(""); }
#else
/* Unix - much simpler. */
char toTest = 0;
if (IS_INT(path)) toTest = UNTAGGED(path);
else {
PolyStringObject * ps = (PolyStringObject *)path.AsObjPtr();
if (ps->length > 1) toTest = ps->chars[0];
}
if (ISPATHSEPARATOR(toTest))
{ toRemove = 1; isAbs = 1; volName = ""; }
#endif
/* Construct the result. */
{
Handle sVol = SAVE(C_string_to_Poly(mdTaskData, volName));
Handle sRes = ALLOC(3);
DEREFWORDHANDLE(sRes)->Set(0, TAGGED(toRemove));
DEREFHANDLE(sRes)->Set(1, DEREFWORDHANDLE(sVol));
DEREFWORDHANDLE(sRes)->Set(2, TAGGED(isAbs));
return sRes;
}
}
case 12: /* Construct a name from a volume and whether it is
absolute. */
{
unsigned isAbs = get_C_unsigned(mdTaskData, DEREFHANDLE(args)->Get(1));
PolyWord volName = DEREFHANDLE(args)->Get(0);
/* In Unix the volume name will always be empty. */
if (isAbs == 0)
return SAVE(volName);
/* N.B. The arguments to strconcatc are in reverse. */
else return strconcatc(mdTaskData,
SAVE(C_string_to_Poly(mdTaskData, DEFAULTSEPARATOR)),
SAVE(volName));
}
case 13: /* Is the string a valid file name? */
{
PolyWord volName = DEREFWORD(args);
// First check for NULL. This is not allowed in either Unix or Windows.
if (IS_INT(volName))
{
if (volName == TAGGED(0))
return Make_arbitrary_precision(mdTaskData, 0);
}
else
{
PolyStringObject * volume = (PolyStringObject *)(volName.AsObjPtr());
for (POLYUNSIGNED i = 0; i < volume->length; i++)
{
if (volume->chars[i] == '\0')
return Make_arbitrary_precision(mdTaskData, 0);
}
}
#if (defined(_WIN32) && ! defined(__CYGWIN__))
// We need to look for certain invalid characters but only after
// we've converted it to Unicode if necessary.
TempString name(volName);
for (const TCHAR *p = name; *p != 0; p++)
{
switch (*p)
{
case '<': case '>': case ':': case '"':
case '\\': case '|': case '?': case '*': case '\0':
#if (0)
// This currently breaks the build.
case '/':
#endif
return Make_arbitrary_precision(mdTaskData, 0);
}
if (*p >= 0 && *p <= 31) return Make_arbitrary_precision(mdTaskData, 0);
}
// Should we check for special names such as aux, con, prn ??
return Make_arbitrary_precision(mdTaskData, 1);
#else
// That's all we need for Unix.
// TODO: Check for /. It's invalid in a file name arc.
return Make_arbitrary_precision(mdTaskData, 1);
#endif
}
// A group of calls have now been moved to poly_specific.
// This entry is returned for backwards compatibility.
case 100: case 101: case 102: case 103: case 104: case 105:
return poly_dispatch_c(mdTaskData, args, code);
default:
{
char msg[100];
sprintf(msg, "Unknown environment function: %d", c);
raise_exception_string(mdTaskData, EXC_Fail, msg);
return 0;
}
}
}
