diff --git a/libpolyml/check_objects.cpp b/libpolyml/check_objects.cpp index 5a913e29..e142bc2d 100644 --- a/libpolyml/check_objects.cpp +++ b/libpolyml/check_objects.cpp @@ -1,169 +1,168 @@ /* Title: Validate addresses in objects. - Copyright (c) 2006, 2012, 2017 - David C.J. Matthews + Copyright (c) 2006, 2012, 2017, 2021 David C.J. Matthews This library is free software; you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License as published by the Free Software Foundation; either version 2.1 of the License, or (at your option) any later version. This library is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for more details. You should have received a copy of the GNU Lesser General Public License along with this library; if not, write to the Free Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA */ #ifdef HAVE_CONFIG_H #include "config.h" #elif defined(_WIN32) #include "winconfig.h" #else #error "No configuration file" #endif #ifdef HAVE_ASSERT_H #include #define ASSERT(x) assert(x) #else #define ASSERT(x) #endif #include "globals.h" #include "diagnostics.h" #include "machine_dep.h" #include "scanaddrs.h" #include "memmgr.h" #define INRANGE(val,start,end)\ (start <= val && val < end) static void CheckAddress(PolyWord *pt) { MemSpace *space = gMem.SpaceForAddress(pt-1); if (space == 0) { Log("Check: Bad pointer %p (no space found)\n", pt); ASSERT(space != 0); } if (space->spaceType == ST_STACK) // This may not have valid length words. return; PolyObject *obj = (PolyObject*)pt; ASSERT(obj->ContainsNormalLengthWord()); POLYUNSIGNED length = obj->Length(); if (pt+length > space->top) { Log("Check: Bad pointer %p (space %p) length %" POLYUFMT "\n", pt, space, length); ASSERT(pt+length <= space->top); } if (space->spaceType == ST_LOCAL) { LocalMemSpace *lSpace = (LocalMemSpace*)space; if (!((pt > lSpace->bottom && pt+length <= lSpace->lowerAllocPtr) || (pt > lSpace->upperAllocPtr && pt+length <= space->top))) { Log("Check: Bad pointer %p (space %p) length %" POLYUFMT " outside allocated area\n", pt, space, length); ASSERT((pt > lSpace->bottom && pt+length <= lSpace->lowerAllocPtr) || (pt > lSpace->upperAllocPtr && pt+length <= space->top)); } } } void DoCheck (const PolyWord pt) { if (pt == PolyWord::FromUnsigned(0)) return; if (pt.IsTagged()) return; CheckAddress(pt.AsStackAddr()); } class ScanCheckAddress: public ScanAddress { public: virtual PolyObject *ScanObjectAddress(PolyObject *pt) { CheckAddress((PolyWord*)pt); return pt; } }; void DoCheckObject (const PolyObject *base, POLYUNSIGNED L) { PolyWord *pt = (PolyWord*)base; CheckAddress(pt); MemSpace *space = gMem.SpaceForAddress(pt-1); if (space == 0) Crash ("Bad pointer 0x%08" PRIxPTR " found", (uintptr_t)pt); ASSERT (OBJ_IS_LENGTH(L)); POLYUNSIGNED n = OBJ_OBJECT_LENGTH(L); if (n == 0) return; ASSERT (n > 0); ASSERT(pt-1 >= space->bottom && pt+n <= space->top); byte flags = GetTypeBits(L); /* discards GC flag and mutable bit */ if (flags == F_BYTE_OBJ) /* possibly signed byte object */ return; /* Nothing more to do */ if (flags == F_CODE_OBJ) /* code object */ { ScanCheckAddress checkAddr; /* We flush the instruction cache here in case we change any of the instructions when we update addresses. */ machineDependent->FlushInstructionCache(pt, (n + 1) * sizeof(PolyWord)); machineDependent->ScanConstantsWithinCode((PolyObject *)base, n, &checkAddr); /* Skip to the constants. */ - base->GetConstSegmentForCode(n, pt, n); + machineDependent->GetConstSegmentForCode((PolyObject*)base, n, pt, n); } else if (flags == F_CLOSURE_OBJ) { n -= sizeof(PolyObject*) / sizeof(PolyWord); pt += sizeof(PolyObject*) / sizeof(PolyWord); } else ASSERT (flags == 0); /* ordinary word object */ while (n--) DoCheck (*pt++); } void DoCheckPointer (const PolyWord pt) { if (pt == PolyWord::FromUnsigned(0)) return; if (OBJ_IS_AN_INTEGER(pt)) return; DoCheck (pt); if (pt.IsDataPtr()) { PolyObject *obj = pt.AsObjPtr(); DoCheckObject (obj, obj->LengthWord()); } } // Check all the objects in the memory. Used to check the garbage collector // void DoCheckMemory() { ScanCheckAddress memCheck; // Scan the local areas. for (std::vector::iterator i = gMem.lSpaces.begin(); i < gMem.lSpaces.end(); i++) { LocalMemSpace *space = *i; memCheck.ScanAddressesInRegion(space->bottom, space->lowerAllocPtr); memCheck.ScanAddressesInRegion(space->upperAllocPtr, space->top); } // Scan the permanent mutable areas. for (std::vector::iterator i = gMem.pSpaces.begin(); i < gMem.pSpaces.end(); i++) { PermanentMemSpace *space = *i; if (space->isMutable && ! space->byteOnly) memCheck.ScanAddressesInRegion(space->bottom, space->top); } } diff --git a/libpolyml/elfexport.cpp b/libpolyml/elfexport.cpp index f1035de7..d19251a4 100644 --- a/libpolyml/elfexport.cpp +++ b/libpolyml/elfexport.cpp @@ -1,834 +1,834 @@ /* Title: Write out a database as an ELF object file Author: David Matthews. - Copyright (c) 2006-7, 2011, 2016-18, 2020 David C. J. Matthews + Copyright (c) 2006-7, 2011, 2016-18, 2020-21 David C. J. Matthews This library is free software; you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License version 2.1 as published by the Free Software Foundation. This library is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR H PARTICULAR PURPOSE. See the GNU Lesser General Public License for more details. You should have received a copy of the GNU Lesser General Public License along with this library; if not, write to the Free Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA */ #include "config.h" #ifdef HAVE_STDLIB_H #include #endif #ifdef HAVE_STDIO_H #include #endif #ifdef HAVE_STDDEF_H #include #endif #ifdef HAVE_UNISTD_H #include #endif #ifdef HAVE_ERRNO_H #include #endif #ifdef HAVE_TIME_H #include #endif #ifdef HAVE_ASSERT_H #include #define ASSERT(x) assert(x) #else #define ASSERT(x) #endif #ifdef HAVE_ELF_H #include #elif defined(HAVE_ELF_ABI_H) #include #endif #ifdef HAVE_MACHINE_RELOC_H #include #ifndef EM_X86_64 #define EM_X86_64 EM_AMD64 #endif #if defined(HOSTARCHITECTURE_X86_64) #ifndef R_386_PC32 #define R_386_PC32 R_X86_64_PC32 #endif #ifndef R_386_32 #define R_386_32 R_X86_64_32 #endif #ifndef R_X86_64_64 #define R_X86_64_64 R_X86_64_64 #endif #endif /* HOSTARCHITECTURE_X86_64 */ #endif // Solaris seems to put processor-specific constants in separate files #ifdef HAVE_SYS_ELF_SPARC_H #include #endif #ifdef HAVE_SYS_ELF_386_H #include #endif #ifdef HAVE_SYS_ELF_AMD64_H #include #endif // Android has the ARM relocation symbol here #ifdef HAVE_ASM_ELF_H #include #endif #ifdef HAVE_STRING_H #include #endif #ifdef HAVE_SYS_UTSNAME_H #include #endif #include "globals.h" #include "diagnostics.h" #include "sys.h" #include "machine_dep.h" #include "gc.h" #include "mpoly.h" #include "scanaddrs.h" #include "elfexport.h" #include "run_time.h" #include "version.h" #include "polystring.h" #include "timing.h" #include "memmgr.h" #define sym_last_local_sym sym_data_section #if defined(HOSTARCHITECTURE_X86) # define HOST_E_MACHINE EM_386 # define HOST_DIRECT_DATA_RELOC R_386_32 # define HOST_DIRECT_FPTR_RELOC R_386_32 # define USE_RELA 0 #elif defined(HOSTARCHITECTURE_PPC) # define HOST_E_MACHINE EM_PPC # define HOST_DIRECT_DATA_RELOC R_PPC_ADDR32 # define HOST_DIRECT_FPTR_RELOC R_PPC_ADDR32 # define USE_RELA 1 #elif defined(HOSTARCHITECTURE_PPC64) # define HOST_E_MACHINE EM_PPC64 # define HOST_DIRECT_DATA_RELOC R_PPC64_ADDR64 # define HOST_DIRECT_FPTR_RELOC R_PPC64_ADDR64 # define USE_RELA 1 #elif defined(HOSTARCHITECTURE_S390) # define HOST_E_MACHINE EM_S390 # define HOST_DIRECT_DATA_RELOC R_390_32 # define HOST_DIRECT_FPTR_RELOC R_390_32 # define USE_RELA 1 #elif defined(HOSTARCHITECTURE_S390X) # define HOST_E_MACHINE EM_S390 # define HOST_DIRECT_DATA_RELOC R_390_64 # define HOST_DIRECT_FPTR_RELOC R_390_64 # define USE_RELA 1 #elif defined(HOSTARCHITECTURE_SH) # define HOST_E_MACHINE EM_SH # define HOST_DIRECT_DATA_RELOC R_SH_DIR32 # define HOST_DIRECT_FPTR_RELOC R_SH_DIR32 # define USE_RELA 1 #elif defined(HOSTARCHITECTURE_SPARC) # define HOST_E_MACHINE EM_SPARC # define HOST_DIRECT_DATA_RELOC R_SPARC_32 # define HOST_DIRECT_FPTR_RELOC R_SPARC_32 # define USE_RELA 1 /* Sparc/Solaris, at least 2.8, requires ELF32_Rela relocations. For some reason, though, it adds the value in the location being relocated (as with ELF32_Rel relocations) as well as the addend. To be safe, whenever we use an ELF32_Rela relocation we always zero the location to be relocated. */ #elif defined(HOSTARCHITECTURE_SPARC64) # define HOST_E_MACHINE EM_SPARCV9 # define HOST_DIRECT_DATA_RELOC R_SPARC_64 # define HOST_DIRECT_FPTR_RELOC R_SPARC_64 /* Use the most relaxed memory model. At link time, the most restrictive one is chosen, so it does no harm to be as permissive as possible here. */ # define HOST_E_FLAGS EF_SPARCV9_RMO # define USE_RELA 1 #elif defined(HOSTARCHITECTURE_X86_64) /* It seems Solaris/X86-64 only supports ELF64_Rela relocations. It appears that Linux will support either so we now use Rela on X86-64. */ # define HOST_E_MACHINE EM_X86_64 # define HOST_DIRECT_DATA_RELOC R_X86_64_64 # define HOST_DIRECT_FPTR_RELOC R_X86_64_64 # define USE_RELA 1 #elif defined(HOSTARCHITECTURE_X32) # define HOST_E_MACHINE EM_X86_64 # define HOST_DIRECT_DATA_RELOC R_X86_64_32 # define HOST_DIRECT_FPTR_RELOC R_X86_64_32 # define USE_RELA 1 #elif defined(HOSTARCHITECTURE_ARM) # ifndef EF_ARM_EABI_VER4 # define EF_ARM_EABI_VER4 0x04000000 # endif // When linking ARM binaries the linker checks the ABI version. We // need to set the version to the same as the libraries. // GCC currently uses version 4. # define HOST_E_MACHINE EM_ARM # define HOST_DIRECT_DATA_RELOC R_ARM_ABS32 # define HOST_DIRECT_FPTR_RELOC R_ARM_ABS32 # define USE_RELA 0 # define HOST_E_FLAGS EF_ARM_EABI_VER4 #elif defined(HOSTARCHITECTURE_HPPA) # if defined(__hpux) # define HOST_OSABI ELFOSABI_HPUX # elif defined(__NetBSD__) # define HOST_OSABI ELFOSABI_NETBSD # elif defined(__linux__) # define HOST_OSABI ELFOSABI_GNU # endif # define HOST_E_MACHINE EM_PARISC # define HOST_DIRECT_DATA_RELOC R_PARISC_DIR32 # define HOST_DIRECT_FPTR_RELOC R_PARISC_PLABEL32 # define HOST_E_FLAGS EFA_PARISC_1_0 # define USE_RELA 1 #elif defined(HOSTARCHITECTURE_IA64) # define HOST_E_MACHINE EM_IA_64 # define HOST_DIRECT_DATA_RELOC R_IA64_DIR64LSB # define HOST_DIRECT_FPTR_RELOC R_IA64_FPTR64LSB # define HOST_E_FLAGS EF_IA_64_ABI64 # define USE_RELA 1 #elif defined(HOSTARCHITECTURE_AARCH64) # define HOST_E_MACHINE EM_AARCH64 # define HOST_DIRECT_DATA_RELOC R_AARCH64_ABS64 # define HOST_DIRECT_FPTR_RELOC R_AARCH64_ABS64 # define USE_RELA 1 #elif defined(HOSTARCHITECTURE_M68K) # define HOST_E_MACHINE EM_68K # define HOST_DIRECT_DATA_RELOC R_68K_32 # define HOST_DIRECT_FPTR_RELOC R_68K_32 # define USE_RELA 1 #elif defined(HOSTARCHITECTURE_MIPS) # define HOST_E_MACHINE EM_MIPS # define HOST_DIRECT_DATA_RELOC R_MIPS_32 # define HOST_DIRECT_FPTR_RELOC R_MIPS_32 # ifdef __PIC__ # define HOST_E_FLAGS EF_MIPS_CPIC # endif # define USE_RELA 1 #elif defined(HOSTARCHITECTURE_MIPS64) # define HOST_E_MACHINE EM_MIPS # define HOST_DIRECT_DATA_RELOC R_MIPS_64 # define HOST_DIRECT_FPTR_RELOC R_MIPS_64 # ifdef __PIC__ # define HOST_E_FLAGS (EF_MIPS_ARCH_64 | EF_MIPS_CPIC) # else # define HOST_E_FLAGS EF_MIPS_ARCH_64 # endif # define USE_RELA 1 #elif defined(HOSTARCHITECTURE_ALPHA) # define HOST_E_MACHINE EM_ALPHA # define HOST_DIRECT_DATA_RELOC R_ALPHA_REFQUAD # define HOST_DIRECT_FPTR_RELOC R_ALPHA_REFQUAD # define USE_RELA 1 #elif defined(HOSTARCHITECTURE_RISCV32) || defined(HOSTARCHITECTURE_RISCV64) # define HOST_E_MACHINE EM_RISCV # if defined(HOSTARCHITECTURE_RISCV32) # define HOST_DIRECT_DATA_RELOC R_RISCV_32 # define HOST_DIRECT_FPTR_RELOC R_RISCV_32 # else # define HOST_DIRECT_DATA_RELOC R_RISCV_64 # define HOST_DIRECT_FPTR_RELOC R_RISCV_64 # endif # if defined(__riscv_float_abi_soft) # define HOST_E_FLAGS_FLOAT_ABI EF_RISCV_FLOAT_ABI_SOFT # elif defined(__riscv_float_abi_single) # define HOST_E_FLAGS_FLOAT_ABI EF_RISCV_FLOAT_ABI_SINGLE # elif defined(__riscv_float_abi_double) # define HOST_E_FLAGS_FLOAT_ABI EF_RISCV_FLOAT_ABI_DOUBLE # elif defined(__riscv_float_abi_quad) # define HOST_E_FLAGS_FLOAT_ABI EF_RISCV_FLOAT_ABI_QUAD # else # error "Unknown RISC-V float ABI" # endif # ifdef __riscv_32e # define HOST_E_FLAGS_RVE __riscv_32e # else # define HOST_E_FLAGS_RVE 0 # endif # define HOST_E_FLAGS (HOST_E_FLAGS_FLOAT_ABI | HOST_E_FLAGS_RVE) # define USE_RELA 1 #else # error "No support for exporting on this architecture" #endif // The first two symbols are special: // Zero is always special in ELF // 1 is used for the data section #define EXTRA_SYMBOLS 2 static unsigned AreaToSym(unsigned area) { return area+EXTRA_SYMBOLS; } // Section table entries enum { sect_initial = 0, sect_sectionnametable, sect_stringtable, // Data and relocation entries come in here. sect_data // Finally the symbol table }; // Add an external reference to the RTS void ELFExport::addExternalReference(void *relocAddr, const char *name, bool isFuncPtr) { externTable.makeEntry(name); // The symbol is added after the memory table entries and poly_exports writeRelocation(0, relocAddr, symbolNum++, isFuncPtr); } // Generate the address relative to the start of the segment. void ELFExport::setRelocationAddress(void *p, ElfXX_Addr *reloc) { unsigned area = findArea(p); POLYUNSIGNED offset = (char*)p - (char*)memTable[area].mtOriginalAddr; *reloc = offset; } /* Get the index corresponding to an address. */ PolyWord ELFExport::createRelocation(PolyWord p, void *relocAddr) { void *addr = p.AsAddress(); unsigned addrArea = findArea(addr); POLYUNSIGNED offset = (char*)addr - (char*)memTable[addrArea].mtOriginalAddr; return writeRelocation(offset, relocAddr, AreaToSym(addrArea), false); } PolyWord ELFExport::writeRelocation(POLYUNSIGNED offset, void *relocAddr, unsigned symbolNum, bool isFuncPtr) { #if USE_RELA ElfXX_Rela reloc; reloc.r_addend = offset; offset = 0; #else ElfXX_Rel reloc; #endif // Set the offset within the section we're scanning. setRelocationAddress(relocAddr, &reloc.r_offset); #ifdef HOSTARCHITECTURE_MIPS64 reloc.r_sym = symbolNum; reloc.r_ssym = 0; reloc.r_type = isFuncPtr ? HOST_DIRECT_FPTR_RELOC : HOST_DIRECT_DATA_RELOC; reloc.r_type2 = 0; reloc.r_type3 = 0; #else reloc.r_info = ELFXX_R_INFO(symbolNum, isFuncPtr ? HOST_DIRECT_FPTR_RELOC : HOST_DIRECT_DATA_RELOC); #endif fwrite(&reloc, sizeof(reloc), 1, exportFile); relocationCount++; return PolyWord::FromUnsigned(offset); } /* This is called for each constant within the code. Print a relocation entry for the word and return a value that means that the offset is saved in original word. */ void ELFExport::ScanConstant(PolyObject *base, byte *addr, ScanRelocationKind code, intptr_t displacement) { #ifndef POLYML32IN64 PolyObject *p = GetConstantValue(addr, code, displacement); if (p == 0) return; void *a = p; unsigned aArea = findArea(a); // We don't need a relocation if this is relative to the current segment // since the relative address will already be right. if (code == PROCESS_RELOC_I386RELATIVE && aArea == findArea(addr)) return; // Set the value at the address to the offset relative to the symbol. POLYUNSIGNED offset = (char*)a - (char*)memTable[aArea].mtOriginalAddr; switch (code) { case PROCESS_RELOC_DIRECT: // 32 or 64 bit address of target { PolyWord r = createRelocation(p, addr); POLYUNSIGNED w = r.AsUnsigned(); for (unsigned i = 0; i < sizeof(PolyWord); i++) { addr[i] = (byte)(w & 0xff); w >>= 8; } } break; #if(defined(HOSTARCHITECTURE_X86) || defined(HOSTARCHITECTURE_X86_64) || \ defined(HOSTARCHITECTURE_X32)) #ifdef HOSTARCHITECTURE_X86 #define R_PC_RELATIVE R_386_PC32 #else #define R_PC_RELATIVE R_X86_64_PC32 #endif case PROCESS_RELOC_I386RELATIVE: // 32 bit relative address { // We seem to need to subtract 4 bytes to get the correct offset in ELF offset -= 4; #if USE_RELA ElfXX_Rela reloc; reloc.r_addend = offset; #else ElfXX_Rel reloc; #endif setRelocationAddress(addr, &reloc.r_offset); reloc.r_info = ELFXX_R_INFO(AreaToSym(aArea), R_PC_RELATIVE); byte *writAble = gMem.SpaceForAddress(addr)->writeAble(addr); #if USE_RELA // Clear the field. Even though it's not supposed to be used with Rela the // Linux linker at least seems to add the value in here sometimes. memset(writAble, 0, 4); #else for (unsigned i = 0; i < 4; i++) { writAble[i] = (byte)(offset & 0xff); offset >>= 8; } #endif fwrite(&reloc, sizeof(reloc), 1, exportFile); relocationCount++; } break; #endif default: ASSERT(0); // Wrong type of relocation for this architecture. } #endif } unsigned long ELFExport::makeStringTableEntry(const char *str, ExportStringTable *stab) { if (str == NULL || str[0] == 0) return 0; // First entry is the null string. else return stab->makeEntry(str); } void ELFExport::writeSymbol(const char *symbolName, long value, long size, int binding, int sttype, int section) { ElfXX_Sym symbol; memset(&symbol, 0, sizeof(symbol)); // Zero unused fields symbol.st_name = makeStringTableEntry(symbolName, &symStrings); symbol.st_value = value; symbol.st_size = size; symbol.st_info = ELFXX_ST_INFO(binding, sttype); symbol.st_other = 0; symbol.st_shndx = section; fwrite(&symbol, sizeof(symbol), 1, exportFile); } // Set the file alignment. void ELFExport::alignFile(int align) { char pad[32] = {0}; // Maximum alignment int offset = ftell(exportFile); if ((offset % align) == 0) return; fwrite(&pad, align - (offset % align), 1, exportFile); } void ELFExport::createStructsRelocation(unsigned sym, size_t offset, size_t addend) { #if USE_RELA ElfXX_Rela reloc; reloc.r_addend = addend; #else ElfXX_Rel reloc; #endif reloc.r_offset = offset; #ifdef HOSTARCHITECTURE_MIPS64 reloc.r_sym = sym; reloc.r_ssym = 0; reloc.r_type = HOST_DIRECT_DATA_RELOC; reloc.r_type2 = 0; reloc.r_type3 = 0; #else reloc.r_info = ELFXX_R_INFO(sym, HOST_DIRECT_DATA_RELOC); #endif fwrite(&reloc, sizeof(reloc), 1, exportFile); relocationCount++; } void ELFExport::exportStore(void) { PolyWord *p; ElfXX_Ehdr fhdr; ElfXX_Shdr *sections = 0; #ifdef __linux__ unsigned extraSections = 1; // Extra section for .note.GNU-stack #else unsigned extraSections = 0; #endif unsigned numSections = 0; for (unsigned j = 0; j < memTableEntries; j++) { if ((memTable[j].mtFlags & (MTF_BYTES|MTF_WRITEABLE)) == MTF_BYTES) numSections += 1; else numSections += 2; } // The symbol table comes at the end. unsigned sect_symtab = sect_data + numSections + 2; numSections += 6 + extraSections; // External symbols start after the memory table entries and "poly_exports". symbolNum = EXTRA_SYMBOLS+memTableEntries+1; // Both the string tables have an initial null entry. symStrings.makeEntry(""); sectionStrings.makeEntry(""); // Write out initial values for the headers. These are overwritten at the end. // File header memset(&fhdr, 0, sizeof(fhdr)); fhdr.e_ident[EI_MAG0] = 0x7f; fhdr.e_ident[EI_MAG1] = 'E'; fhdr.e_ident[EI_MAG2] = 'L'; fhdr.e_ident[EI_MAG3] = 'F'; fhdr.e_ident[EI_CLASS] = ELFCLASSXX; // ELFCLASS32 or ELFCLASS64 fhdr.e_ident[EI_VERSION] = EV_CURRENT; #ifdef HOST_OSABI fhdr.e_ident[EI_OSABI] = HOST_OSABI; #endif { union { unsigned long wrd; char chrs[sizeof(unsigned long)]; } endian; endian.wrd = 1; if (endian.chrs[0] == 0) fhdr.e_ident[EI_DATA] = ELFDATA2MSB; // Big endian else fhdr.e_ident[EI_DATA] = ELFDATA2LSB; // Little endian } fhdr.e_type = ET_REL; // The machine needs to match the machine we're compiling for // even if this is actually portable code. fhdr.e_machine = HOST_E_MACHINE; #ifdef HOST_E_FLAGS fhdr.e_flags = HOST_E_FLAGS; #endif fhdr.e_version = EV_CURRENT; fhdr.e_shoff = sizeof(fhdr); // Offset to section header - immediately follows fhdr.e_ehsize = sizeof(fhdr); fhdr.e_shentsize = sizeof(ElfXX_Shdr); fhdr.e_shnum = numSections; fhdr.e_shstrndx = sect_sectionnametable; // Section name table section index; fwrite(&fhdr, sizeof(fhdr), 1, exportFile); // Write it for the moment. sections = new ElfXX_Shdr[numSections]; memset(sections, 0, sizeof(ElfXX_Shdr) * numSections); // Necessary? // Set up the section header but don't write it yet. // Section 0 - all zeros sections[sect_initial].sh_type = SHT_NULL; sections[sect_initial].sh_link = SHN_UNDEF; // Section name table. sections[sect_sectionnametable].sh_name = makeStringTableEntry(".shstrtab", §ionStrings); sections[sect_sectionnametable].sh_type = SHT_STRTAB; sections[sect_sectionnametable].sh_addralign = sizeof(char); // sections[sect_sectionnametable].sh_offset is set later // sections[sect_sectionnametable].sh_size is set later // Symbol name table. sections[sect_stringtable].sh_name = makeStringTableEntry(".strtab", §ionStrings); sections[sect_stringtable].sh_type = SHT_STRTAB; sections[sect_stringtable].sh_addralign = sizeof(char); // sections[sect_stringtable].sh_offset is set later // sections[sect_stringtable].sh_size is set later unsigned long dataName = makeStringTableEntry(".data", §ionStrings); unsigned long dataRelName = makeStringTableEntry(USE_RELA ? ".rela.data" : ".rel.data", §ionStrings); #ifndef CODEISNOTEXECUTABLE unsigned long textName = makeStringTableEntry(".text", §ionStrings); unsigned long textRelName = makeStringTableEntry(USE_RELA ? ".rela.text" : ".rel.text", §ionStrings); #endif // The Linux linker does not like relocations in the .rodata section and marks the executable // as containing text relocations. Putting the data in a .data.rel.ro section seems to work. unsigned long relDataName = makeStringTableEntry(".data.rel.ro", §ionStrings); unsigned long relDataRelName = makeStringTableEntry(USE_RELA ? ".rela.data.rel.ro" : ".rel.data.rel.ro", §ionStrings); // Byte and other leaf data that do not require relocation can go in the .rodata section unsigned long nRelDataName = makeStringTableEntry(".rodata", §ionStrings); // Main data sections. Each one has a relocation section. unsigned s = sect_data; for (unsigned i=0; i < memTableEntries; i++) { sections[s].sh_addralign = 8; // 8-byte alignment sections[s].sh_type = SHT_PROGBITS; if (memTable[i].mtFlags & MTF_WRITEABLE) { // Mutable areas ASSERT(!(memTable[i].mtFlags & MTF_EXECUTABLE)); // Executable areas can't be writable. sections[s].sh_name = dataName; sections[s].sh_flags = SHF_WRITE | SHF_ALLOC; s++; // Mutable byte areas can contain external references so need relocation sections[s].sh_name = dataRelName; // Name of relocation section } #ifndef CODEISNOTEXECUTABLE // Not if we're building the interpreted version. else if (memTable[i].mtFlags & MTF_EXECUTABLE) { // Code areas are marked as executable. sections[s].sh_name = textName; sections[s].sh_flags = SHF_ALLOC | SHF_EXECINSTR; s++; sections[s].sh_name = textRelName; // Name of relocation section } #endif else if (memTable[i].mtFlags & MTF_BYTES) { // Data that does not require relocation. // Non-code immutable areas sections[s].sh_name = nRelDataName; sections[s].sh_flags = SHF_ALLOC; s++; continue; // Skip the relocation section for this } else { // Non-code immutable areas sections[s].sh_name = relDataName; // The .data.rel.ro has to be writable in order to be relocated. // It is set to read-only after relocation. sections[s].sh_flags = SHF_WRITE | SHF_ALLOC; s++; sections[s].sh_name = relDataRelName; // Name of relocation section } // sections[s].sh_size is set later // sections[s].sh_offset is set later. // sections[s].sh_size is set later. // Relocation section sections[s].sh_type = USE_RELA ? SHT_RELA : SHT_REL; // Contains relocation with/out explicit addends (ElfXX_Rel) sections[s].sh_link = sect_symtab; // Index to symbol table sections[s].sh_info = s-1; // Applies to the data section sections[s].sh_addralign = sizeof(long); // Align to a word sections[s].sh_entsize = USE_RELA ? sizeof(ElfXX_Rela) : sizeof(ElfXX_Rel); s++; // sections[s+1].sh_offset is set later. // sections[s+1].sh_size is set later. } // Table data - Poly tables that describe the memory layout. unsigned sect_table_data = s; sections[sect_table_data].sh_name = dataName; sections[sect_table_data].sh_type = SHT_PROGBITS; sections[sect_table_data].sh_flags = SHF_WRITE | SHF_ALLOC; sections[sect_table_data].sh_addralign = 8; // 8-byte alignment // Table relocation sections[sect_table_data+1].sh_name = dataRelName; sections[sect_table_data+1].sh_type = USE_RELA ? SHT_RELA : SHT_REL; // Contains relocation with/out explicit addends (ElfXX_Rel) sections[sect_table_data+1].sh_link = sect_symtab; // Index to symbol table sections[sect_table_data+1].sh_info = sect_table_data; // Applies to table section sections[sect_table_data+1].sh_addralign = sizeof(long); // Align to a word sections[sect_table_data+1].sh_entsize = USE_RELA ? sizeof(ElfXX_Rela) : sizeof(ElfXX_Rel); // Symbol table. sections[sect_symtab].sh_name = makeStringTableEntry(".symtab", §ionStrings); sections[sect_symtab].sh_type = SHT_SYMTAB; sections[sect_symtab].sh_link = sect_stringtable; // String table to use sections[sect_symtab].sh_addralign = sizeof(long); // Align to a word sections[sect_symtab].sh_entsize = sizeof(ElfXX_Sym); // sections[sect_symtab].sh_info is set later // sections[sect_symtab].sh_size is set later // sections[sect_symtab].sh_offset is set later #ifdef __linux__ // Add a .note.GNU-stack section to indicate this does not require executable stack sections[numSections-1].sh_name = makeStringTableEntry(".note.GNU-stack", §ionStrings); sections[numSections - 1].sh_type = SHT_PROGBITS; #endif // Write the relocations. unsigned relocSection = sect_data; for (unsigned i = 0; i < memTableEntries; i++) { relocSection++; if ((memTable[i].mtFlags & (MTF_BYTES|MTF_WRITEABLE)) == MTF_BYTES) continue; alignFile(sections[relocSection].sh_addralign); sections[relocSection].sh_offset = ftell(exportFile); relocationCount = 0; // Create the relocation table and turn all addresses into offsets. char *start = (char*)memTable[i].mtOriginalAddr; 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()) { POLYUNSIGNED constCount; PolyWord* cp; // Get the constant area pointer first because ScanConstantsWithinCode // may alter it. - obj->GetConstSegmentForCode(cp, constCount); + machineDependent->GetConstSegmentForCode(obj, cp, constCount); // Update any constants before processing the object // We need that for relative jumps/calls in X86/64. machineDependent->ScanConstantsWithinCode(obj, this); if (cp > (PolyWord*)obj && cp < ((PolyWord*)obj) + length) { // Process the constants if they're in the area but not if they've been moved. for (POLYUNSIGNED i = 0; i < constCount; i++) relocateValue(&(cp[i])); } } else relocateObject(obj); p += length; } sections[relocSection].sh_size = relocationCount * (USE_RELA ? sizeof(ElfXX_Rela) : sizeof(ElfXX_Rel)); relocSection++; } // Relocations for "exports" and "memTable"; alignFile(sections[sect_table_data+1].sh_addralign); sections[sect_table_data+1].sh_offset = ftell(exportFile); relocationCount = 0; // TODO: This won't be needed if we put these in a separate section. POLYUNSIGNED areaSpace = 0; for (unsigned i = 0; i < memTableEntries; i++) areaSpace += memTable[i].mtLength; // 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. size_t memTableOffset = sizeof(exportDescription); // It follows immediately after this. createStructsRelocation(AreaToSym(memTableEntries), offsetof(exportDescription, memTable), memTableOffset); // Address of "rootFunction" within "exports" unsigned rootAddrArea = findArea(rootFunction); size_t rootOffset = (char*)rootFunction - (char*)memTable[rootAddrArea].mtOriginalAddr; createStructsRelocation(AreaToSym(rootAddrArea), offsetof(exportDescription, rootFunction), rootOffset); // Addresses of the areas within memtable. for (unsigned i = 0; i < memTableEntries; i++) { createStructsRelocation(AreaToSym(i), sizeof(exportDescription) + i * sizeof(memoryTableEntry) + offsetof(memoryTableEntry, mtCurrentAddr), 0 /* No offset relative to base symbol*/); } sections[sect_table_data+1].sh_size = relocationCount * (USE_RELA ? sizeof(ElfXX_Rela) : sizeof(ElfXX_Rel)); // Now the symbol table. alignFile(sections[sect_symtab].sh_addralign); sections[sect_symtab].sh_offset = ftell(exportFile); writeSymbol("", 0, 0, 0, 0, 0); // Initial symbol // Write the local symbols first. writeSymbol("", 0, 0, STB_LOCAL, STT_SECTION, sect_data); // .data section // Create symbols for the address areas. AreaToSym assumes these come first. s = sect_data; for (unsigned i = 0; i < memTableEntries; i++) { char buff[50]; sprintf(buff, "area%1u", i); writeSymbol(buff, 0, 0, STB_LOCAL, STT_OBJECT, s); if ((memTable[i].mtFlags & (MTF_BYTES|MTF_WRITEABLE)) == MTF_BYTES) s += 1; else s += 2; } // Global symbols - Exported symbol for table. writeSymbol("poly_exports", 0, sizeof(exportDescription)+sizeof(memoryTableEntry)*memTableEntries, STB_GLOBAL, STT_OBJECT, sect_table_data); // External references for (unsigned i = 0; i < externTable.stringSize; i += (unsigned)strlen(externTable.strings+i) + 1) writeSymbol(externTable.strings+i, 0, 0, STB_GLOBAL, STT_FUNC, SHN_UNDEF); sections[sect_symtab].sh_info = EXTRA_SYMBOLS+memTableEntries; // One more than last local sym sections[sect_symtab].sh_size = sizeof(ElfXX_Sym) * symbolNum; // Now the binary data. unsigned dataSection = sect_data; for (unsigned i = 0; i < memTableEntries; i++) { sections[dataSection].sh_size = memTable[i].mtLength; alignFile(sections[dataSection].sh_addralign); sections[dataSection].sh_offset = ftell(exportFile); fwrite(memTable[i].mtOriginalAddr, 1, memTable[i].mtLength, exportFile); if ((memTable[i].mtFlags & (MTF_BYTES|MTF_WRITEABLE)) == MTF_BYTES) dataSection += 1; else dataSection += 2; } exportDescription exports; memset(&exports, 0, sizeof(exports)); exports.structLength = sizeof(exportDescription); exports.memTableSize = sizeof(memoryTableEntry); exports.memTableEntries = memTableEntries; exports.memTable = USE_RELA ? 0 : (memoryTableEntry *)memTableOffset; // 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 = USE_RELA ? 0 : (void*)rootOffset; exports.timeStamp = getBuildTime(); exports.architecture = machineDependent->MachineArchitecture(); exports.rtsVersion = POLY_version_number; #ifdef POLYML32IN64 exports.originalBaseAddr = globalHeapBase; #else exports.originalBaseAddr = 0; #endif // Set the address values to zero before we write. They will always // be relative to their base symbol. for (unsigned i = 0; i < memTableEntries; i++) memTable[i].mtCurrentAddr = 0; // Now the binary data. alignFile(sections[sect_table_data].sh_addralign); sections[sect_table_data].sh_offset = ftell(exportFile); sections[sect_table_data].sh_size = sizeof(exportDescription) + memTableEntries*sizeof(memoryTableEntry); fwrite(&exports, sizeof(exports), 1, exportFile); fwrite(memTable, sizeof(memoryTableEntry), memTableEntries, exportFile); // The section name table sections[sect_sectionnametable].sh_offset = ftell(exportFile); fwrite(sectionStrings.strings, sectionStrings.stringSize, 1, exportFile); sections[sect_sectionnametable].sh_size = sectionStrings.stringSize; // The symbol name table sections[sect_stringtable].sh_offset = ftell(exportFile); fwrite(symStrings.strings, symStrings.stringSize, 1, exportFile); sections[sect_stringtable].sh_size = symStrings.stringSize; // Finally the section headers. alignFile(4); fhdr.e_shoff = ftell(exportFile); fwrite(sections, sizeof(ElfXX_Shdr) * numSections, 1, exportFile); // Rewind to rewrite the file header with the offset of the section headers. rewind(exportFile); fwrite(&fhdr, sizeof(fhdr), 1, exportFile); fclose(exportFile); exportFile = NULL; delete[]sections; } diff --git a/libpolyml/exporter.cpp b/libpolyml/exporter.cpp index 35c55f39..2c5a5498 100644 --- a/libpolyml/exporter.cpp +++ b/libpolyml/exporter.cpp @@ -1,988 +1,988 @@ /* Title: exporter.cpp - Export a function as an object or C file Copyright (c) 2006-7, 2015, 2016-21 David C.J. Matthews This library is free software; you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License version 2.1 as published by the Free Software Foundation. This library is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for more details. You should have received a copy of the GNU Lesser General Public License along with this library; if not, write to the Free Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA */ #ifdef HAVE_CONFIG_H #include "config.h" #elif defined(_WIN32) #include "winconfig.h" #else #error "No configuration file" #endif #ifdef HAVE_ASSERT_H #include #define ASSERT(x) assert(x) #else #define ASSERT(x) #endif #ifdef HAVE_STRING_H #include #endif #ifdef HAVE_ERRNO_H #include #endif #ifdef HAVE_SYS_PARAM_H #include #endif #ifdef HAVE_STDLIB_H #include #endif #if (defined(_WIN32)) #include #else #define _T(x) x #define _tcslen strlen #define _tcscmp strcmp #define _tcscat strcat #endif #include "exporter.h" #include "save_vec.h" #include "polystring.h" #include "run_time.h" #include "osmem.h" #include "scanaddrs.h" #include "gc.h" #include "machine_dep.h" #include "diagnostics.h" #include "memmgr.h" #include "processes.h" // For IO_SPACING #include "sys.h" // For EXC_Fail #include "rtsentry.h" #include "pexport.h" #ifdef HAVE_PECOFF #include "pecoffexport.h" #elif defined(HAVE_ELF_H) || defined(HAVE_ELF_ABI_H) #include "elfexport.h" #elif defined(HAVE_MACH_O_RELOC_H) #include "machoexport.h" #endif #if (defined(_WIN32)) #define NOMEMORY ERROR_NOT_ENOUGH_MEMORY #define ERRORNUMBER _doserrno #else #define NOMEMORY ENOMEM #define ERRORNUMBER errno #endif extern "C" { POLYEXTERNALSYMBOL POLYUNSIGNED PolyExport(FirstArgument threadId, PolyWord fileName, PolyWord root); POLYEXTERNALSYMBOL POLYUNSIGNED PolyExportPortable(FirstArgument threadId, PolyWord fileName, PolyWord root); } /* To export the function and everything reachable from it we need to copy all the objects into a new area. We leave tombstones in the original objects by overwriting the length word. That prevents us from copying an object twice and breaks loops. Once we've copied the objects we then have to go back over the memory and turn the tombstones back into length words. */ GraveYard::~GraveYard() { free(graves); } // Used to calculate the space required for the ordinary mutables // and the no-overwrite mutables. They are interspersed in local space. class MutSizes : public ScanAddress { public: MutSizes() : mutSize(0), noOverSize(0) {} virtual PolyObject *ScanObjectAddress(PolyObject *base) { return base; }// No Actually used virtual void ScanAddressesInObject(PolyObject *base, POLYUNSIGNED lengthWord) { const POLYUNSIGNED words = OBJ_OBJECT_LENGTH(lengthWord) + 1; // Include length word if (OBJ_IS_NO_OVERWRITE(lengthWord)) noOverSize += words; else mutSize += words; } POLYUNSIGNED mutSize, noOverSize; }; CopyScan::CopyScan(unsigned h/*=0*/): hierarchy(h) { defaultImmSize = defaultMutSize = defaultCodeSize = defaultNoOverSize = 0; tombs = 0; graveYard = 0; } void CopyScan::initialise(bool isExport/*=true*/) { ASSERT(gMem.eSpaces.size() == 0); // Set the space sizes to a proportion of the space currently in use. // Computing these sizes is not obvious because CopyScan is used both // for export and for saved states. For saved states in particular we // want to use a smaller size because they are retained after we save // the state and if we have many child saved states it's important not // to waste memory. if (hierarchy == 0) { graveYard = new GraveYard[gMem.pSpaces.size()]; if (graveYard == 0) { if (debugOptions & DEBUG_SAVING) Log("SAVE: Unable to allocate graveyard, size: %lu.\n", gMem.pSpaces.size()); throw MemoryException(); } } for (std::vector::iterator i = gMem.pSpaces.begin(); i < gMem.pSpaces.end(); i++) { PermanentMemSpace *space = *i; if (space->hierarchy >= hierarchy) { // Include this if we're exporting (hierarchy=0) or if we're saving a state // and will include this in the new state. size_t size = (space->top-space->bottom)/4; if (space->noOverwrite) defaultNoOverSize += size; else if (space->isMutable) defaultMutSize += size; else if (space->isCode) defaultCodeSize += size; else defaultImmSize += size; if (space->hierarchy == 0 && ! space->isMutable) { // We need a separate area for the tombstones because this is read-only graveYard[tombs].graves = (PolyWord*)calloc(space->spaceSize(), sizeof(PolyWord)); if (graveYard[tombs].graves == 0) { if (debugOptions & DEBUG_SAVING) Log("SAVE: Unable to allocate graveyard for permanent space, size: %lu.\n", space->spaceSize() * sizeof(PolyWord)); throw MemoryException(); } if (debugOptions & DEBUG_SAVING) Log("SAVE: Allocated graveyard for permanent space, %p size: %lu.\n", graveYard[tombs].graves, space->spaceSize() * sizeof(PolyWord)); graveYard[tombs].startAddr = space->bottom; graveYard[tombs].endAddr = space->top; tombs++; } } } for (std::vector::iterator i = gMem.lSpaces.begin(); i < gMem.lSpaces.end(); i++) { LocalMemSpace *space = *i; uintptr_t size = space->allocatedSpace(); // It looks as though the mutable size generally gets // overestimated while the immutable size is correct. if (space->isMutable) { MutSizes sizeMut; sizeMut.ScanAddressesInRegion(space->bottom, space->lowerAllocPtr); sizeMut.ScanAddressesInRegion(space->upperAllocPtr, space->top); defaultNoOverSize += sizeMut.noOverSize / 4; defaultMutSize += sizeMut.mutSize / 4; } else defaultImmSize += size/2; } for (std::vector::iterator i = gMem.cSpaces.begin(); i < gMem.cSpaces.end(); i++) { CodeSpace *space = *i; uintptr_t size = space->spaceSize(); defaultCodeSize += size/2; } if (isExport) { // Minimum 1M words. if (defaultMutSize < 1024*1024) defaultMutSize = 1024*1024; if (defaultImmSize < 1024*1024) defaultImmSize = 1024*1024; if (defaultCodeSize < 1024*1024) defaultCodeSize = 1024*1024; #ifdef MACOSX // Limit the segment size for Mac OS X. The linker has a limit of 2^24 relocations // in a segment so this is a crude way of ensuring the limit isn't exceeded. // It's unlikely to be exceeded by the code itself. // Actually, from trial-and-error, the limit seems to be around 6M. if (defaultMutSize > 6 * 1024 * 1024) defaultMutSize = 6 * 1024 * 1024; if (defaultImmSize > 6 * 1024 * 1024) defaultImmSize = 6 * 1024 * 1024; #endif if (defaultNoOverSize < 4096) defaultNoOverSize = 4096; // Except for the no-overwrite area } else { // Much smaller minimum sizes for saved states. if (defaultMutSize < 1024) defaultMutSize = 1024; if (defaultImmSize < 4096) defaultImmSize = 4096; if (defaultCodeSize < 4096) defaultCodeSize = 4096; if (defaultNoOverSize < 4096) defaultNoOverSize = 4096; // Set maximum sizes as well. We may have insufficient contiguous space for // very large areas. if (defaultMutSize > 1024 * 1024) defaultMutSize = 1024 * 1024; if (defaultImmSize > 1024 * 1024) defaultImmSize = 1024 * 1024; if (defaultCodeSize > 1024 * 1024) defaultCodeSize = 1024 * 1024; if (defaultNoOverSize > 1024 * 1024) defaultNoOverSize = 1024 * 1024; } if (debugOptions & DEBUG_SAVING) Log("SAVE: Copyscan default sizes: Immutable: %" POLYUFMT ", Mutable: %" POLYUFMT ", Code: %" POLYUFMT ", No-overwrite %" POLYUFMT ".\n", defaultImmSize, defaultMutSize, defaultCodeSize, defaultNoOverSize); } CopyScan::~CopyScan() { gMem.DeleteExportSpaces(); if (graveYard) delete[](graveYard); } // This function is called for each address in an object // once it has been copied to its new location. We copy first // then scan to update the addresses. POLYUNSIGNED CopyScan::ScanAddressAt(PolyWord *pt) { PolyWord val = *pt; // Ignore integers. if (IS_INT(val) || val == PolyWord::FromUnsigned(0)) return 0; PolyObject *obj = val.AsObjPtr(); POLYUNSIGNED l = ScanAddress(&obj); *pt = obj; return l; } // This function is called for each address in an object // once it has been copied to its new location. We copy first // then scan to update the addresses. POLYUNSIGNED CopyScan::ScanAddress(PolyObject **pt) { PolyObject *obj = *pt; MemSpace *space = gMem.SpaceForObjectAddress(obj); ASSERT(space != 0); // We may sometimes get addresses that have already been updated // to point to the new area. e.g. (only?) in the case of constants // that have been updated in ScanConstantsWithinCode. if (space->spaceType == ST_EXPORT) return 0; // If this is at a lower level than the hierarchy we are saving // then leave it untouched. if (space->spaceType == ST_PERMANENT) { PermanentMemSpace *pmSpace = (PermanentMemSpace*)space; if (pmSpace->hierarchy < hierarchy) return 0; } // Have we already scanned this? if (obj->ContainsForwardingPtr()) { // Update the address to the new value. #ifdef POLYML32IN64 PolyObject *newAddr; if (space->isCode) newAddr = (PolyObject*)(globalCodeBase + ((obj->LengthWord() & ~_OBJ_TOMBSTONE_BIT) << 1)); else newAddr = obj->GetForwardingPtr(); #else PolyObject *newAddr = obj->GetForwardingPtr(); #endif *pt = newAddr; return 0; // No need to scan it again. } else if (space->spaceType == ST_PERMANENT) { // See if we have this in the grave-yard. for (unsigned i = 0; i < tombs; i++) { GraveYard *g = &graveYard[i]; if ((PolyWord*)obj >= g->startAddr && (PolyWord*)obj < g->endAddr) { PolyWord *tombAddr = g->graves + ((PolyWord*)obj - g->startAddr); PolyObject *tombObject = (PolyObject*)tombAddr; if (tombObject->ContainsForwardingPtr()) { #ifdef POLYML32IN64 PolyObject *newAddr; if (space->isCode) newAddr = (PolyObject*)(globalCodeBase + ((tombObject->LengthWord() & ~_OBJ_TOMBSTONE_BIT) << 1)); else newAddr = tombObject->GetForwardingPtr(); #else PolyObject *newAddr = tombObject->GetForwardingPtr(); #endif *pt = newAddr; return 0; } break; // No need to look further } } } // No, we need to copy it. ASSERT(space->spaceType == ST_LOCAL || space->spaceType == ST_PERMANENT || space->spaceType == ST_CODE); POLYUNSIGNED lengthWord = obj->LengthWord(); POLYUNSIGNED originalLengthWord = lengthWord; POLYUNSIGNED words = OBJ_OBJECT_LENGTH(lengthWord); enum _newAddrType naType; if (obj->IsMutable()) { if (obj->IsNoOverwriteObject()) naType = NANoOverwriteMutable; else naType = NAMutable; } else if (obj->IsCodeObject()) naType = NACode; else if (obj->IsByteObject()) naType = NAByte; else naType = NAWord; PolyObject* newObj; #if(defined(HOSTARCHITECTURE_X86_64) && ! defined(POLYML32IN64)) // Split the constant area off into a separate object. This allows us to create a // position-independent executable. if (obj->IsCodeObject() && hierarchy == 0) { PolyWord* constPtr; POLYUNSIGNED numConsts; - obj->GetConstSegmentForCode(constPtr, numConsts); + machineDependent->GetConstSegmentForCode(obj, constPtr, numConsts); // Newly generated code will have the constants included with the code // but if this is in the executable the constants will have been extracted before. bool constsWereIncluded = constPtr > (PolyWord*)obj && constPtr < ((PolyWord*)obj) + words; POLYUNSIGNED codeAreaSize = words; if (constsWereIncluded) codeAreaSize -= numConsts + 1; newObj = newAddressForObject(codeAreaSize, NACode); PolyObject* writable = gMem.SpaceForObjectAddress(newObj)->writeAble(newObj); writable->SetLengthWord(codeAreaSize, F_CODE_OBJ); // set length word lengthWord = newObj->LengthWord(); // Get the actual length word used memcpy(writable, obj, codeAreaSize * sizeof(PolyWord)); PolyObject* newConsts = newAddressForObject(numConsts, NACodeConst); newConsts->SetLengthWord(numConsts); memcpy(newConsts, constPtr, numConsts * sizeof(PolyWord)); // Set the last word of the new area to the offset of the constants from the end of // the code. int64_t offset = (byte*)newConsts - (byte*)newObj - codeAreaSize * sizeof(PolyWord); ASSERT(offset >= -(int64_t)0x80000000 && offset <= (int64_t)0x7fffffff); ASSERT(offset < ((int64_t)1) << 32 && offset > ((int64_t)(-1)) << 32); writable->Set(codeAreaSize - 1, PolyWord::FromSigned(offset)); } else #endif { newObj = newAddressForObject(words, naType); PolyObject* writAble = gMem.SpaceForObjectAddress(newObj)->writeAble(newObj); writAble->SetLengthWord(lengthWord); // copy length word if (hierarchy == 0 /* Exporting object module */ && obj->IsNoOverwriteObject() && ! obj->IsByteObject()) { // These are not exported. They are used for special values e.g. mutexes // that should be set to 0/nil/NONE at start-up. // Weak+No-overwrite byte objects are used for entry points and volatiles // in the foreign-function interface and have to be treated specially. // Note: this must not be done when exporting a saved state because the // copied version is used as the local data for the rest of the session. for (POLYUNSIGNED i = 0; i < words; i++) writAble->Set(i, TAGGED(0)); } else memcpy(writAble, obj, words * sizeof(PolyWord)); } if (space->spaceType == ST_PERMANENT && !space->isMutable && ((PermanentMemSpace*)space)->hierarchy == 0) { // The immutable permanent areas are read-only. unsigned m; for (m = 0; m < tombs; m++) { GraveYard *g = &graveYard[m]; if ((PolyWord*)obj >= g->startAddr && (PolyWord*)obj < g->endAddr) { PolyWord *tombAddr = g->graves + ((PolyWord*)obj - g->startAddr); PolyObject *tombObject = (PolyObject*)tombAddr; #ifdef POLYML32IN64 if (isCodeObj) { POLYUNSIGNED ll = (POLYUNSIGNED)(((PolyWord*)newObj - globalCodeBase) >> 1 | _OBJ_TOMBSTONE_BIT); tombObject->SetLengthWord(ll); } else tombObject->SetForwardingPtr(newObj); #else tombObject->SetForwardingPtr(newObj); #endif break; // No need to look further } } ASSERT(m < tombs); // Should be there. } else if (naType == NACode) #ifdef POLYML32IN64 // If this is a code address we can't use the usual forwarding pointer format. // Instead we have to compute the offset relative to the base of the code. { POLYUNSIGNED ll = (POLYUNSIGNED)(((PolyWord*)newObj-globalCodeBase) >> 1 | _OBJ_TOMBSTONE_BIT); gMem.SpaceForObjectAddress(obj)->writeAble(obj)->SetLengthWord(ll); } #else gMem.SpaceForObjectAddress(obj)->writeAble(obj)->SetForwardingPtr(newObj); #endif else obj->SetForwardingPtr(newObj); // Put forwarding pointer in old object. if (naType == NACode) { // We should flush the instruction cache here since we will execute the code // at this location if this is a saved state. machineDependent->FlushInstructionCache(newObj, newObj->Length()); // We have to update any relative addresses within the code // to take account of its new position. We have to do that now // even though ScanAddressesInObject will do it again because this // is the only point where we have both the old and the new addresses. PolyWord *oldConstAddr; POLYUNSIGNED count; - obj->GetConstSegmentForCode(OBJ_OBJECT_LENGTH(originalLengthWord), oldConstAddr, count); - PolyWord *newConstAddr = newObj->ConstPtrForCode(); + machineDependent->GetConstSegmentForCode(obj, OBJ_OBJECT_LENGTH(originalLengthWord), oldConstAddr, count); + PolyWord *newConstAddr = machineDependent->ConstPtrForCode(newObj); machineDependent->ScanConstantsWithinCode(newObj, obj, words, newConstAddr, oldConstAddr, count, this); } *pt = newObj; // Update it to the newly copied object. return lengthWord; // This new object needs to be scanned. } PolyObject* CopyScan::newAddressForObject(POLYUNSIGNED words, enum _newAddrType naType) { PolyObject* newObj = 0; // Allocate a new address for the object. for (std::vector::iterator i = gMem.eSpaces.begin(); i < gMem.eSpaces.end(); i++) { PermanentMemSpace* space = *i; bool match = false; switch (naType) { case NAWord: match = !space->isMutable && !space->byteOnly && !space->isCode; case NAMutable: match = space->isMutable && !space->noOverwrite; break; case NANoOverwriteMutable: match = space->isMutable && space->noOverwrite; break; case NAByte: match = !space->isMutable && space->byteOnly; break; case NACode: match = !space->isMutable && space->isCode && !space->constArea; break; case NACodeConst: match = !space->isMutable && space->isCode && space->constArea; break; } if (match) { ASSERT(space->topPointer <= space->top && space->topPointer >= space->bottom); size_t spaceLeft = space->top - space->topPointer; if (spaceLeft > words) { newObj = (PolyObject*)(space->topPointer + 1); space->topPointer += words + 1; #ifdef POLYML32IN64 // Maintain the odd-word alignment of topPointer if ((words & 1) == 0 && space->topPointer < space->top) { *space->writeAble(space->topPointer) = PolyWord::FromUnsigned(0); space->topPointer++; } #endif break; } } } if (newObj == 0) { // Didn't find room in the existing spaces. Create a new space. uintptr_t spaceWords = defaultImmSize; switch (naType) { case NAMutable: spaceWords = defaultMutSize; break; case NANoOverwriteMutable: spaceWords = defaultNoOverSize; break; case NACode: spaceWords = defaultCodeSize; break; case NACodeConst: spaceWords = defaultCodeSize; break; } if (spaceWords <= words) spaceWords = words + 1; // Make sure there's space for this object. PermanentMemSpace* space = gMem.NewExportSpace(spaceWords, naType == NAMutable || naType == NANoOverwriteMutable, naType == NANoOverwriteMutable, naType == NACode || naType == NACodeConst); if (naType == NAByte) space->byteOnly = true; if (naType == NACodeConst) space->constArea = true; if (space == 0) { if (debugOptions & DEBUG_SAVING) Log("SAVE: Unable to allocate export space, size: %lu.\n", spaceWords); // Unable to allocate this. throw MemoryException(); } newObj = (PolyObject*)(space->topPointer + 1); space->topPointer += words + 1; #ifdef POLYML32IN64 // Maintain the odd-word alignment of topPointer if ((words & 1) == 0 && space->topPointer < space->top) { *space->writeAble(space->topPointer) = PolyWord::FromUnsigned(0); space->topPointer++; } #endif ASSERT(space->topPointer <= space->top && space->topPointer >= space->bottom); } return newObj; } // The address of code in the code area. We treat this as a normal heap cell. // We will probably need to copy this and to process addresses within it. POLYUNSIGNED CopyScan::ScanCodeAddressAt(PolyObject **pt) { POLYUNSIGNED lengthWord = ScanAddress(pt); if (lengthWord) ScanAddressesInObject(*pt, lengthWord); return 0; } PolyObject *CopyScan::ScanObjectAddress(PolyObject *base) { PolyWord val = base; // Scan this as an address. POLYUNSIGNED lengthWord = CopyScan::ScanAddressAt(&val); if (lengthWord) ScanAddressesInObject(val.AsObjPtr(), lengthWord); return val.AsObjPtr(); } #define MAX_EXTENSION 4 // The longest extension we may need to add is ".obj" // Convert the forwarding pointers in a region back into length words. // Generally if this object has a forwarding pointer that's // because we've moved it into the export region. We can, // though, get multiple levels of forwarding if there is an object // that has been shifted up by a garbage collection, leaving a forwarding // pointer and then that object has been moved to the export region. // We mustn't turn locally forwarded values back into ordinary objects // because they could contain addresses that are no longer valid. static POLYUNSIGNED GetObjLength(PolyObject *obj) { if (obj->ContainsForwardingPtr()) { PolyObject *forwardedTo; #ifdef POLYML32IN64 { MemSpace *space = gMem.SpaceForObjectAddress(obj); if (space->isCode) forwardedTo = (PolyObject*)(globalCodeBase + ((obj->LengthWord() & ~_OBJ_TOMBSTONE_BIT) << 1)); else forwardedTo = obj->GetForwardingPtr(); } #else forwardedTo = obj->GetForwardingPtr(); #endif POLYUNSIGNED length = GetObjLength(forwardedTo); MemSpace *space = gMem.SpaceForObjectAddress(forwardedTo); if (space->spaceType == ST_EXPORT) { // If this is a code object whose constant area has been split off we // need to add the length of the constant area. if (forwardedTo->IsCodeObject()) { PolyWord* constPtr; POLYUNSIGNED numConsts; - forwardedTo->GetConstSegmentForCode(constPtr, numConsts); + machineDependent->GetConstSegmentForCode(forwardedTo, constPtr, numConsts); if (!(constPtr > (PolyWord*)forwardedTo && constPtr < ((PolyWord*)forwardedTo) + OBJ_OBJECT_LENGTH(length))) length += numConsts + 1; } gMem.SpaceForObjectAddress(obj)->writeAble(obj)->SetLengthWord(length); } return length; } else { ASSERT(obj->ContainsNormalLengthWord()); return obj->LengthWord(); } } static void FixForwarding(PolyWord *pt, size_t space) { while (space) { pt++; PolyObject *obj = (PolyObject*)pt; #ifdef POLYML32IN64 if ((uintptr_t)obj & 4) { // Skip filler words needed to align to an even word space--; continue; // We've added 1 to pt so just loop. } #endif size_t length = OBJ_OBJECT_LENGTH(GetObjLength(obj)); pt += length; ASSERT(space > length); space -= length+1; } } class ExportRequest: public MainThreadRequest { public: ExportRequest(Handle root, Exporter *exp): MainThreadRequest(MTP_EXPORTING), exportRoot(root), exporter(exp) {} virtual void Perform() { exporter->RunExport(exportRoot->WordP()); } Handle exportRoot; Exporter *exporter; }; static void exporter(TaskData *taskData, Handle fileName, Handle root, const TCHAR *extension, Exporter *exports) { size_t extLen = _tcslen(extension); TempString fileNameBuff(Poly_string_to_T_alloc(fileName->Word(), extLen)); if (fileNameBuff == NULL) raise_syscall(taskData, "Insufficient memory", NOMEMORY); size_t length = _tcslen(fileNameBuff); // Does it already have the extension? If not add it on. if (length < extLen || _tcscmp(fileNameBuff + length - extLen, extension) != 0) _tcscat(fileNameBuff, extension); #if (defined(_WIN32) && defined(UNICODE)) exports->exportFile = _wfopen(fileNameBuff, L"wb"); #else exports->exportFile = fopen(fileNameBuff, "wb"); #endif if (exports->exportFile == NULL) raise_syscall(taskData, "Cannot open export file", ERRORNUMBER); // Request a full GC to reduce the size of fix-ups. FullGC(taskData); // Request the main thread to do the export. ExportRequest request(root, exports); processes->MakeRootRequest(taskData, &request); if (exports->errorMessage) raise_fail(taskData, exports->errorMessage); } // This is called by the initial thread to actually do the export. void Exporter::RunExport(PolyObject *rootFunction) { Exporter *exports = this; PolyObject *copiedRoot = 0; CopyScan copyScan(hierarchy); try { copyScan.initialise(); // Copy the root and everything reachable from it into the temporary area. copiedRoot = copyScan.ScanObjectAddress(rootFunction); } catch (MemoryException &) { // If we ran out of memory. copiedRoot = 0; } // Fix the forwarding pointers. for (std::vector::iterator i = gMem.lSpaces.begin(); i < gMem.lSpaces.end(); i++) { LocalMemSpace *space = *i; // Local areas only have objects from the allocation pointer to the top. FixForwarding(space->bottom, space->lowerAllocPtr - space->bottom); FixForwarding(space->upperAllocPtr, space->top - space->upperAllocPtr); } for (std::vector::iterator i = gMem.pSpaces.begin(); i < gMem.pSpaces.end(); i++) { MemSpace *space = *i; // Permanent areas are filled with objects from the bottom. FixForwarding(space->bottom, space->top - space->bottom); } for (std::vector::iterator i = gMem.cSpaces.begin(); i < gMem.cSpaces.end(); i++) { MemSpace *space = *i; // Code areas are filled with objects from the bottom. FixForwarding(space->bottom, space->top - space->bottom); } // Reraise the exception after cleaning up the forwarding pointers. if (copiedRoot == 0) { exports->errorMessage = "Insufficient Memory"; return; } // Copy the areas into the export object. size_t tableEntries = gMem.eSpaces.size(); unsigned memEntry = 0; if (hierarchy != 0) tableEntries += gMem.pSpaces.size(); exports->memTable = new memoryTableEntry[tableEntries]; // If we're constructing a module we need to include the global spaces. if (hierarchy != 0) { // Permanent spaces from the executable. for (std::vector::iterator i = gMem.pSpaces.begin(); i < gMem.pSpaces.end(); i++) { PermanentMemSpace *space = *i; if (space->hierarchy < hierarchy) { memoryTableEntry *entry = &exports->memTable[memEntry++]; entry->mtOriginalAddr = entry->mtCurrentAddr = space->bottom; entry->mtLength = (space->topPointer-space->bottom)*sizeof(PolyWord); entry->mtIndex = space->index; entry->mtFlags = 0; if (space->isMutable) entry->mtFlags |= MTF_WRITEABLE; if (space->isCode) entry->mtFlags |= MTF_EXECUTABLE; } } newAreas = memEntry; } for (std::vector::iterator i = gMem.eSpaces.begin(); i < gMem.eSpaces.end(); i++) { memoryTableEntry *entry = &exports->memTable[memEntry++]; PermanentMemSpace *space = *i; entry->mtOriginalAddr = entry->mtCurrentAddr = space->bottom; entry->mtLength = (space->topPointer-space->bottom)*sizeof(PolyWord); entry->mtIndex = hierarchy == 0 ? memEntry-1 : space->index; entry->mtFlags = 0; if (space->isMutable) { entry->mtFlags = MTF_WRITEABLE; if (space->noOverwrite) entry->mtFlags |= MTF_NO_OVERWRITE; } if (space->isCode && !space->constArea) entry->mtFlags |= MTF_EXECUTABLE; if (space->byteOnly) entry->mtFlags |= MTF_BYTES; } ASSERT(memEntry == tableEntries); exports->memTableEntries = memEntry; exports->rootFunction = copiedRoot; try { // This can raise MemoryException at least in PExport::exportStore. exports->exportStore(); } catch (MemoryException &) { exports->errorMessage = "Insufficient Memory"; } } // Functions called via the RTS call. Handle exportNative(TaskData *taskData, Handle args) { #ifdef HAVE_PECOFF // Windows including Cygwin #if (defined(_WIN32)) const TCHAR *extension = _T(".obj"); // Windows #else const char *extension = ".o"; // Cygwin #endif PECOFFExport exports; exporter(taskData, taskData->saveVec.push(args->WordP()->Get(0)), taskData->saveVec.push(args->WordP()->Get(1)), extension, &exports); #elif defined(HAVE_ELF_H) || defined(HAVE_ELF_ABI_H) // Most Unix including Linux, FreeBSD and Solaris. const char *extension = ".o"; ELFExport exports; exporter(taskData, taskData->saveVec.push(args->WordP()->Get(0)), taskData->saveVec.push(args->WordP()->Get(1)), extension, &exports); #elif defined(HAVE_MACH_O_RELOC_H) // Mac OS-X const char *extension = ".o"; MachoExport exports; exporter(taskData, taskData->saveVec.push(args->WordP()->Get(0)), taskData->saveVec.push(args->WordP()->Get(1)), extension, &exports); #else raise_exception_string (taskData, EXC_Fail, "Native export not available for this platform"); #endif return taskData->saveVec.push(TAGGED(0)); } Handle exportPortable(TaskData *taskData, Handle args) { PExport exports; exporter(taskData, taskData->saveVec.push(args->WordP()->Get(0)), taskData->saveVec.push(args->WordP()->Get(1)), _T(".txt"), &exports); return taskData->saveVec.push(TAGGED(0)); } POLYUNSIGNED PolyExport(FirstArgument threadId, PolyWord fileName, PolyWord root) { TaskData *taskData = TaskData::FindTaskForId(threadId); ASSERT(taskData != 0); taskData->PreRTSCall(); Handle reset = taskData->saveVec.mark(); Handle pushedName = taskData->saveVec.push(fileName); Handle pushedRoot = taskData->saveVec.push(root); try { #ifdef HAVE_PECOFF // Windows including Cygwin #if (defined(_WIN32)) const TCHAR *extension = _T(".obj"); // Windows #else const char *extension = ".o"; // Cygwin #endif PECOFFExport exports; exporter(taskData, pushedName, pushedRoot, extension, &exports); #elif defined(HAVE_ELF_H) || defined(HAVE_ELF_ABI_H) // Most Unix including Linux, FreeBSD and Solaris. const char *extension = ".o"; ELFExport exports; exporter(taskData, pushedName, pushedRoot, extension, &exports); #elif defined(HAVE_MACH_O_RELOC_H) // Mac OS-X const char *extension = ".o"; MachoExport exports; exporter(taskData, pushedName, pushedRoot, extension, &exports); #else raise_exception_string (taskData, EXC_Fail, "Native export not available for this platform"); #endif } catch (...) { } // If an ML exception is raised taskData->saveVec.reset(reset); taskData->PostRTSCall(); return TAGGED(0).AsUnsigned(); // Returns unit } POLYUNSIGNED PolyExportPortable(FirstArgument threadId, PolyWord fileName, PolyWord root) { TaskData *taskData = TaskData::FindTaskForId(threadId); ASSERT(taskData != 0); taskData->PreRTSCall(); Handle reset = taskData->saveVec.mark(); Handle pushedName = taskData->saveVec.push(fileName); Handle pushedRoot = taskData->saveVec.push(root); try { PExport exports; exporter(taskData, pushedName, pushedRoot, _T(".txt"), &exports); } catch (...) { } // If an ML exception is raised taskData->saveVec.reset(reset); taskData->PostRTSCall(); return TAGGED(0).AsUnsigned(); // Returns unit } // Helper functions for exporting. We need to produce relocation information // and this code is common to every method. Exporter::Exporter(unsigned int h): exportFile(NULL), errorMessage(0), hierarchy(h), memTable(0), newAreas(0) { } Exporter::~Exporter() { delete[](memTable); if (exportFile) fclose(exportFile); } void Exporter::relocateValue(PolyWord *pt) { #ifndef POLYML32IN64 PolyWord q = *pt; if (IS_INT(q) || q == PolyWord::FromUnsigned(0)) {} else createRelocation(pt); #endif } void Exporter::createRelocation(PolyWord* pt) { *gMem.SpaceForAddress(pt)->writeAble(pt) = createRelocation(*pt, pt); } // Check through the areas to see where the address is. It must be // in one of them. unsigned Exporter::findArea(void *p) { for (unsigned i = 0; i < memTableEntries; i++) { if (p > memTable[i].mtOriginalAddr && p <= (char*)memTable[i].mtOriginalAddr + memTable[i].mtLength) return i; } { ASSERT(0); } return 0; } void Exporter::relocateObject(PolyObject *p) { if (p->IsByteObject()) { if (p->IsMutable() && p->IsWeakRefObject()) { // Weak mutable byte refs are used for external references and // also in the FFI for non-persistent values. bool isFuncPtr = true; const char *entryName = getEntryPointName(p, &isFuncPtr); if (entryName != 0) addExternalReference(p, entryName, isFuncPtr); // Clear the first word of the data. ASSERT(p->Length() >= sizeof(uintptr_t)/sizeof(PolyWord)); *(uintptr_t*)p = 0; } } else if (p->IsCodeObject()) { POLYUNSIGNED constCount; PolyWord *cp; ASSERT(! p->IsMutable() ); - p->GetConstSegmentForCode(cp, constCount); + machineDependent->GetConstSegmentForCode(p, cp, constCount); /* Now the constants. */ for (POLYUNSIGNED i = 0; i < constCount; i++) relocateValue(&(cp[i])); } else // Closure and ordinary objects { POLYUNSIGNED length = p->Length(); for (POLYUNSIGNED i = 0; i < length; i++) relocateValue(p->Offset(i)); } } ExportStringTable::ExportStringTable(): strings(0), stringSize(0), stringAvailable(0) { } ExportStringTable::~ExportStringTable() { free(strings); } // Add a string to the string table, growing it if necessary. unsigned long ExportStringTable::makeEntry(const char *str) { unsigned len = (unsigned)strlen(str); unsigned long entry = stringSize; if (stringSize + len + 1 > stringAvailable) { stringAvailable = stringAvailable+stringAvailable/2; if (stringAvailable < stringSize + len + 1) stringAvailable = stringSize + len + 1 + 500; char* newStrings = (char*)realloc(strings, stringAvailable); if (newStrings == 0) { if (debugOptions & DEBUG_SAVING) Log("SAVE: Unable to realloc string table, size: %lu.\n", stringAvailable); throw MemoryException(); } else strings = newStrings; } strcpy(strings + stringSize, str); stringSize += len + 1; return entry; } struct _entrypts exporterEPT[] = { { "PolyExport", (polyRTSFunction)&PolyExport}, { "PolyExportPortable", (polyRTSFunction)&PolyExportPortable}, { NULL, NULL} // End of list. }; diff --git a/libpolyml/globals.h b/libpolyml/globals.h index 1a40a756..a634d946 100644 --- a/libpolyml/globals.h +++ b/libpolyml/globals.h @@ -1,433 +1,409 @@ /* Title: Globals for the system. Author: Dave Matthews, Cambridge University Computer Laboratory Copyright David C. J. Matthews 2017-20 Copyright (c) 2000-7 Cambridge University Technical Services Limited This library is free software; you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License version 2.1 as published by the Free Software Foundation. This library is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for more details. You should have received a copy of the GNU Lesser General Public License along with this library; if not, write to the Free Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA */ #ifndef _GLOBALS_H #define _GLOBALS_H /* Poly words, pointers and cells (objects). The garbage collector needs to be able to distinguish different uses of a memory word. We need to be able find which words are pointers to other objects and which are simple integers. The simple distinction is between integers, which are tagged by having the bottom bit set, and Addresses which are word aligned (bottom 2 bits zero on a 32 bit machine, bottom 3 bits on a 64 bit machine, bottom bit in 32-in-64). Addresses always point to the start of cells. The preceding word of a cell is the length word. This contains the length of the cell in words in the low-order 3 (7 in native 64-bits) bytes and a flag byte in the top byte. The flags give information about the type of the object. The length word is also used by the garbage collector and other object processors. */ #if HAVE_STDINT_H # include #endif #if HAVE_INTTYPES_H # ifndef __STDC_FORMAT_MACROS # define __STDC_FORMAT_MACROS # endif # include #elif (defined(_MSC_VER) && (_MSC_VER >= 1900)) // In VS 2015 and later we need to use # include #endif #ifdef HAVE_STDDEF_H # include #endif #define POLY_TAGSHIFT 1 #if (defined(_WIN32)) # include #endif #ifdef POLYML32IN64 typedef int32_t POLYSIGNED; typedef uint32_t POLYUNSIGNED; #define SIZEOF_POLYWORD 4 #else typedef intptr_t POLYSIGNED; typedef uintptr_t POLYUNSIGNED; #define SIZEOF_POLYWORD SIZEOF_VOIDP #endif // libpolyml uses printf-style I/O instead of C++ standard IOstreams, // so we need specifier to format POLYUNSIGNED/POLYSIGNED values. #ifdef POLYML32IN64 #if (defined(PRIu32)) # define POLYUFMT PRIu32 # define POLYSFMT PRId32 #elif (defined(_MSC_VER)) # define POLYUFMT "lu" # define POLYSFMT "ld" #else # define POLYUFMT "u" # define POLYSFMT "d" #endif #elif (defined(PRIuPTR)) # define POLYUFMT PRIuPTR # define POLYSFMT PRIdPTR #elif (defined(_MSC_VER) && (SIZEOF_POLYWORD == 8)) # define POLYUFMT "llu" # define POLYSFMT "lld" #else # define POLYUFMT "lu" // as before. Cross your fingers. # define POLYSFMT "ld" // idem. #endif // We can use the C99 %zu in most cases except MingW since it uses // the old msvcrt and that only supports C89. #if (defined(_WIN32) && (! defined(_MSC_VER) || _MSC_VER < 1800)) # if (SIZEOF_VOIDP == 8) # define PRI_SIZET PRIu64 # else # define PRI_SIZET PRIu32 # endif #else # define PRI_SIZET "zu" #endif typedef unsigned char byte; class PolyObject; typedef PolyObject *POLYOBJPTR; #ifdef POLYML32IN64 class PolyWord; extern PolyWord *globalHeapBase, *globalCodeBase; typedef uint32_t POLYOBJECTPTR; // This is an index into globalHeapBase // If a 64-bit value if in the range of the object pointers. inline bool IsHeapAddress(void *addr) { return (uintptr_t)addr <= 0xffffffff; } #else typedef POLYOBJPTR POLYOBJECTPTR; inline bool IsHeapAddress(void *) { return true; } #endif typedef byte *POLYCODEPTR; class PolyWord { public: // Initialise to TAGGED(0). This is very rarely used. PolyWord() { contents.unsignedInt = 1; } // Integers need to be tagged. static PolyWord TaggedInt(POLYSIGNED s) { return PolyWord((s << POLY_TAGSHIFT) | (POLYSIGNED)0x01); } static PolyWord TaggedUnsigned(POLYUNSIGNED u) { return PolyWord((u << POLY_TAGSHIFT) | 0x01); } static PolyWord FromStackAddr(PolyWord *sp) { return PolyWord(sp); } static PolyWord FromCodePtr(POLYCODEPTR p) { return PolyWord(p); } // Tests for the various cases. bool IsTagged(void) const { return (contents.unsignedInt & 1) != 0; } #ifndef POLYML32IN64 // In native 32-bit and 64-bit addresses are on word boundaries bool IsDataPtr(void) const { return (contents.unsignedInt & (sizeof(PolyWord) - 1)) == 0; } #else // In 32-in-64 addresses are anything that isn't tagged. bool IsDataPtr(void) const { return (contents.unsignedInt & 1) == 0; } #ifdef POLYML32IN64DEBUG static POLYOBJECTPTR AddressToObjectPtr(void *address); #else static POLYOBJECTPTR AddressToObjectPtr(void *address) { return (POLYOBJECTPTR)((PolyWord*)address - globalHeapBase); } #endif #endif // Extract the various cases. POLYSIGNED UnTagged(void) const { return contents.signedInt >> POLY_TAGSHIFT; } POLYUNSIGNED UnTaggedUnsigned(void) const { return contents.unsignedInt >> POLY_TAGSHIFT; } #ifdef POLYML32IN64 PolyWord(POLYOBJPTR p) { contents.objectPtr = AddressToObjectPtr(p); } PolyWord *AsStackAddr(PolyWord *base = globalHeapBase) const { return base + contents.objectPtr; } POLYOBJPTR AsObjPtr(PolyWord *base = globalHeapBase) const { return (POLYOBJPTR)AsStackAddr(base); } #else // An object pointer can become a word directly. PolyWord(POLYOBJPTR p) { contents.objectPtr = p; } POLYOBJPTR AsObjPtr(PolyWord *base = 0) const { return contents.objectPtr; } PolyWord *AsStackAddr(PolyWord *base=0) const { return (PolyWord *)contents.objectPtr; } #endif POLYCODEPTR AsCodePtr(void) const { return (POLYCODEPTR)AsObjPtr(); } void *AsAddress(void)const { return AsCodePtr(); } // There are a few cases where we need to store and extract untagged values static PolyWord FromUnsigned(POLYUNSIGNED u) { return PolyWord(u); } static PolyWord FromSigned(POLYSIGNED s) { return PolyWord(s); } POLYUNSIGNED AsUnsigned(void) const { return contents.unsignedInt; } POLYSIGNED AsSigned(void) const { return contents.signedInt; } protected: PolyWord(POLYSIGNED s) { contents.signedInt = s; } PolyWord(POLYUNSIGNED u) { contents.unsignedInt = u; } public: bool operator == (PolyWord b) const { return contents.unsignedInt == b.contents.unsignedInt; } bool operator != (PolyWord b) const { return contents.unsignedInt != b.contents.unsignedInt; } protected: #ifdef POLYML32IN64 PolyWord(PolyWord *sp) { contents.objectPtr = AddressToObjectPtr(sp); } PolyWord(POLYCODEPTR p) { contents.objectPtr = AddressToObjectPtr(p); } #else PolyWord(PolyWord *sp) { contents.objectPtr = (PolyObject*)sp; } PolyWord(POLYCODEPTR p) { contents.objectPtr = (PolyObject*)p; } #endif union { POLYSIGNED signedInt; // A tagged integer - lowest bit set POLYUNSIGNED unsignedInt; // A tagged integer - lowest bit set POLYOBJECTPTR objectPtr; // Object pointer - lowest bit clear. } contents; }; //typedef PolyWord POLYWORD; inline bool OBJ_IS_AN_INTEGER(const PolyWord & a) { return a.IsTagged(); } inline bool OBJ_IS_DATAPTR(const PolyWord & a) { return a.IsDataPtr(); } // The maximum tagged signed number is one less than 0x80 shifted into the top byte then shifted down // by the tag shift. #define MAXTAGGED (((POLYSIGNED)0x80 << (POLYSIGNED)(8*(sizeof(PolyWord)-1) -POLY_TAGSHIFT)) -1) inline PolyWord TAGGED(POLYSIGNED a) { return PolyWord::TaggedInt(a); } inline POLYSIGNED UNTAGGED(PolyWord a) { return a.UnTagged(); } inline POLYUNSIGNED UNTAGGED_UNSIGNED(PolyWord a) { return a.UnTaggedUnsigned(); } #define IS_INT(x) ((x).IsTagged()) /* length word flags */ #define OBJ_PRIVATE_FLAGS_SHIFT (8 * (sizeof(PolyWord) - 1)) #define _TOP_BYTE(x) ((POLYUNSIGNED)(x) << OBJ_PRIVATE_FLAGS_SHIFT) // Bottom two bits define the content format. // Zero bits mean ordinary word object containing addresses or tagged integers. #define F_BYTE_OBJ 0x01 /* byte object (contains no pointers) */ #define F_CODE_OBJ 0x02 /* code object (mixed bytes and words) */ #define F_CLOSURE_OBJ 0x03 /* closure (32-in-64 only). First word is code addr. */ #define F_GC_MARK 0x04 // Used during the GC marking phase #define F_NO_OVERWRITE 0x08 /* don't overwrite when loading - mutables only. */ // This bit is overloaded and has different meanings depending on what other bits are set. // For byte objects it is the sign bit for arbitrary precision ints. // For other data it indicates either that the object is a profile block or contains // information for allocation profiling. #define F_NEGATIVE_BIT 0x10 // Sign bit for arbitrary precision ints (byte segs only) #define F_PROFILE_BIT 0x10 // Object has a profile pointer (word segs only) #define F_WEAK_BIT 0x20 /* object contains weak references to option values. */ // The Weak bit is only used on mutables. The data sharing (sharedata.cpp) uses this with // immutables to indicate that the length field is being used to store the "depth". #define F_MUTABLE_BIT 0x40 /* object is mutable */ #define F_TOMBSTONE_BIT 0x80 // Object is a forwarding pointer #define F_PRIVATE_FLAGS_MASK 0xFF // Shifted bits #define _OBJ_BYTE_OBJ _TOP_BYTE(F_BYTE_OBJ) /* byte object (contains no pointers) */ #define _OBJ_CODE_OBJ _TOP_BYTE(F_CODE_OBJ) /* code object (mixed bytes and words) */ #define _OBJ_CLOSURE_OBJ _TOP_BYTE(F_CLOSURE_OBJ) // closure (32-in-64 only). First word is code addr. #define _OBJ_GC_MARK _TOP_BYTE(F_GC_MARK) // Mark bit #define _OBJ_NO_OVERWRITE _TOP_BYTE(F_NO_OVERWRITE) /* don't overwrite when loading - mutables only. */ #define _OBJ_NEGATIVE_BIT _TOP_BYTE(F_NEGATIVE_BIT) /* sign bit for arbitrary precision ints */ #define _OBJ_PROFILE_BIT _TOP_BYTE(F_PROFILE_BIT) /* sign bit for arbitrary precision ints */ #define _OBJ_WEAK_BIT _TOP_BYTE(F_WEAK_BIT) #define _OBJ_MUTABLE_BIT _TOP_BYTE(F_MUTABLE_BIT) /* object is mutable */ #define _OBJ_TOMBSTONE_BIT _TOP_BYTE(F_TOMBSTONE_BIT) // object is a tombstone. #define _OBJ_PRIVATE_FLAGS_MASK _TOP_BYTE(F_PRIVATE_FLAGS_MASK) #define _OBJ_PRIVATE_LENGTH_MASK ((-1) ^ _OBJ_PRIVATE_FLAGS_MASK) #define MAX_OBJECT_SIZE _OBJ_PRIVATE_LENGTH_MASK // inline bool OBJ_IS_LENGTH(POLYUNSIGNED L) { return ((L & _OBJ_TOMBSTONE_BIT) == 0); } /* these should only be applied to proper length words */ /* discards GC flag, mutable bit and weak bit. */ inline byte GetTypeBits(POLYUNSIGNED L) { return (byte)(L >> OBJ_PRIVATE_FLAGS_SHIFT) & 0x03; } inline POLYUNSIGNED OBJ_OBJECT_LENGTH(POLYUNSIGNED L) { return L & _OBJ_PRIVATE_LENGTH_MASK; } inline bool OBJ_IS_BYTE_OBJECT(POLYUNSIGNED L) { return (GetTypeBits(L) == F_BYTE_OBJ); } inline bool OBJ_IS_CODE_OBJECT(POLYUNSIGNED L) { return (GetTypeBits(L) == F_CODE_OBJ); } inline bool OBJ_IS_CLOSURE_OBJECT(POLYUNSIGNED L) { return (GetTypeBits(L) == F_CLOSURE_OBJ); } inline bool OBJ_IS_NO_OVERWRITE(POLYUNSIGNED L) { return ((L & _OBJ_NO_OVERWRITE) != 0); } inline bool OBJ_IS_NEGATIVE(POLYUNSIGNED L) { return ((L & _OBJ_NEGATIVE_BIT) != 0); } inline bool OBJ_HAS_PROFILE(POLYUNSIGNED L) { return ((L & _OBJ_PROFILE_BIT) != 0); } inline bool OBJ_IS_MUTABLE_OBJECT(POLYUNSIGNED L) { return ((L & _OBJ_MUTABLE_BIT) != 0); } inline bool OBJ_IS_WEAKREF_OBJECT(POLYUNSIGNED L) { return ((L & _OBJ_WEAK_BIT) != 0); } /* Don't need to worry about whether shift is signed, because OBJ_PRIVATE_USER_FLAGS_MASK removes the sign bit. We don't want the GC bit (which should be 0) anyway. */ #define OBJ_PRIVATE_USER_FLAGS_MASK _TOP_BYTE(0x7F) #define OBJ_IS_WORD_OBJECT(L) (GetTypeBits(L) == 0) /* case 2 - forwarding pointer */ inline bool OBJ_IS_POINTER(POLYUNSIGNED L) { return (L & _OBJ_TOMBSTONE_BIT) != 0; } #ifdef POLYML32IN64 inline PolyObject *OBJ_GET_POINTER(POLYUNSIGNED L) { return (PolyObject*)(globalHeapBase + ((L & ~_OBJ_TOMBSTONE_BIT) << 1)); } inline POLYUNSIGNED OBJ_SET_POINTER(PolyObject *pt) { return PolyWord::AddressToObjectPtr(pt) >> 1 | _OBJ_TOMBSTONE_BIT; } #else inline PolyObject *OBJ_GET_POINTER(POLYUNSIGNED L) { return (PolyObject*)(( L & ~_OBJ_TOMBSTONE_BIT) <<2); } inline POLYUNSIGNED OBJ_SET_POINTER(PolyObject *pt) { return ((POLYUNSIGNED)pt >> 2) | _OBJ_TOMBSTONE_BIT; } #endif // An object i.e. a piece of allocated memory in the heap. In the simplest case this is a // tuple, a list cons cell, a string or a ref. Every object has a length word in the word before // where its address points. The top byte of this contains flags. class PolyObject { public: byte *AsBytePtr(void)const { return (byte*)this; } PolyWord *AsWordPtr(void)const { return (PolyWord*)this; } POLYUNSIGNED LengthWord(void)const { return ((PolyWord*)this)[-1].AsUnsigned(); } POLYUNSIGNED Length(void)const { return OBJ_OBJECT_LENGTH(LengthWord()); } // Get and set a word PolyWord Get(POLYUNSIGNED i) const { return ((PolyWord*)this)[i]; } void Set(POLYUNSIGNED i, PolyWord v) { ((PolyWord*)this)[i] = v; } PolyWord *Offset(POLYUNSIGNED i) const { return ((PolyWord*)this)+i; } // Create a length word from a length and the flags in the top byte. void SetLengthWord(POLYUNSIGNED l, byte f) { ((POLYUNSIGNED*)this)[-1] = l | ((POLYUNSIGNED)f << OBJ_PRIVATE_FLAGS_SHIFT); } void SetLengthWord(POLYUNSIGNED l) { ((PolyWord*)this)[-1] = PolyWord::FromUnsigned(l); } bool IsByteObject(void) const { return OBJ_IS_BYTE_OBJECT(LengthWord()); } bool IsCodeObject(void) const { return OBJ_IS_CODE_OBJECT(LengthWord()); } bool IsClosureObject(void) const { return OBJ_IS_CLOSURE_OBJECT(LengthWord()); } bool IsWordObject(void) const { return OBJ_IS_WORD_OBJECT(LengthWord()); } bool IsMutable(void) const { return OBJ_IS_MUTABLE_OBJECT(LengthWord()); } bool IsWeakRefObject(void) const { return OBJ_IS_WEAKREF_OBJECT(LengthWord()); } bool IsNoOverwriteObject(void) const { return OBJ_IS_NO_OVERWRITE(LengthWord()); } bool ContainsForwardingPtr(void) const { return OBJ_IS_POINTER(LengthWord()); } PolyObject *GetForwardingPtr(void) const { return OBJ_GET_POINTER(LengthWord()); } void SetForwardingPtr(PolyObject *newp) { ((PolyWord*)this)[-1] = PolyWord::FromUnsigned(OBJ_SET_POINTER(newp)); } bool ContainsNormalLengthWord(void) const { return OBJ_IS_LENGTH(LengthWord()); } - // Find the start of the constant section for a piece of code. - void GetConstSegmentForCode(POLYUNSIGNED obj_length, PolyWord * &cp, POLYUNSIGNED &count) const - { - PolyWord *last_word = Offset(obj_length - 1); // Last word in the code -#ifdef HOSTARCHITECTURE_X86_64 - // Only the low order 32-bits are valid since this may be - // set by a 32-bit relative relocation. - int32_t offset = (int32_t)last_word->AsSigned(); -#else - POLYSIGNED offset = last_word->AsSigned(); -#endif - cp = last_word + 1 + offset / sizeof(PolyWord); - count = cp[-1].AsUnsigned(); - } - void GetConstSegmentForCode(PolyWord * &cp, POLYUNSIGNED &count) const - { - GetConstSegmentForCode(Length(), cp, count); - } - PolyWord *ConstPtrForCode(void) const - { - PolyWord *cp; POLYUNSIGNED count; - GetConstSegmentForCode(cp, count); - return cp; - } // Follow a chain of forwarding pointers PolyObject *FollowForwardingChain(void) { if (ContainsForwardingPtr()) return GetForwardingPtr()->FollowForwardingChain(); else return this; } }; // Stacks are native-words size even in 32-in-64. union stackItem { stackItem(PolyWord v) { argValue = v.AsUnsigned(); } stackItem() { argValue = TAGGED(0).AsUnsigned(); } // These return the low order word. PolyWord w()const { return PolyWord::FromUnsigned((POLYUNSIGNED)argValue); } operator PolyWord () { return PolyWord::FromUnsigned((POLYUNSIGNED)argValue); } POLYCODEPTR codeAddr; // Return addresses stackItem* stackAddr; // Stack addresses uintptr_t argValue; // Treat an address as an int }; /* There was a problem with version 2.95 on Sparc/Solaris at least. The PolyObject class has no members so classes derived from it e.g. ML_Cons_Cell should begin at the beginning of the object. Later versions of GCC get this right. */ #if defined(__GNUC__) && (__GNUC__ <= 2) #error Poly/ML requires GCC version 3 or newer #endif inline POLYUNSIGNED GetLengthWord(PolyWord p) { return p.AsObjPtr()->LengthWord(); } // Get the length of an object. inline POLYUNSIGNED OBJECT_LENGTH(PolyWord p) { return OBJ_OBJECT_LENGTH(GetLengthWord(p)); } // A list cell. This can be passed to or returned from certain RTS functions. class ML_Cons_Cell: public PolyObject { public: PolyWord h; PolyWord t; #define ListNull (TAGGED(0)) static bool IsNull(PolyWord p) { return p == ListNull; } }; /* An exception packet. This contains an identifier (either a tagged integer for RTS exceptions or the address of a mutable for those created within ML), a string name for printing and an exception argument value. */ class PolyException: public PolyObject { public: PolyWord ex_id; /* Exc identifier */ PolyWord ex_name;/* Exc name */ PolyWord arg; /* Exc arguments */ PolyWord ex_location; // Location of "raise". Always zero for RTS exceptions. }; typedef PolyException poly_exn; /* Macro to round a number of bytes up to a number of words. */ #define WORDS(s) ((s+sizeof(PolyWord)-1)/sizeof(PolyWord)) /********************************************************************** * * Representation of option type. * **********************************************************************/ #define NONE_VALUE (TAGGED(0)) /* SOME x is represented by a single word cell containing x. */ #if (defined(_WIN32)) /* Windows doesn't include 0x in %p format. */ #define ZERO_X "0x" #else #define ZERO_X "" #endif #endif diff --git a/libpolyml/machine_dep.h b/libpolyml/machine_dep.h index 867e4935..69873678 100644 --- a/libpolyml/machine_dep.h +++ b/libpolyml/machine_dep.h @@ -1,77 +1,102 @@ /* Title: machine_dep.h - exports signature for machine_dep.c Copyright (c) 2000 Cambridge University Technical Services Limited - Further development Copyright 2020 David C. J. Matthews + Further development Copyright 2020-21 David C. J. Matthews This library is free software; you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License version 2.1 as published by the Free Software Foundation. This library is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for more details. You should have received a copy of the GNU Lesser General Public License along with this library; if not, write to the Free Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA */ #ifndef _MACHINE_DEP_H #define _MACHINE_DEP_H class ScanAddress; class TaskData; class SaveVecEntry; typedef SaveVecEntry *Handle; class StackSpace; // Machine architecture values. typedef enum { MA_Interpreted = 0, MA_I386, MA_X86_64, MA_X86_64_32 } Architectures; // Machine-dependent module. class MachineDependent { public: virtual ~MachineDependent() {} // Keep the compiler happy // Create the machine-specific task data object. virtual TaskData *CreateTaskData(void) = 0; virtual unsigned InitialStackSize(void) { return 128; } // Initial size of a stack // Must be > 40 (i.e. 2*min_stack_check) + base area in each stack frame + // Find the start of the constant section for a piece of code. + // This is the default version which uses the whole of the last word as a + // byte offset. + // Normally the constant area is located within the code object and the offset is a small + // negative value. When creating position-independent code we need to put the constants in a + // separate area. We have to use a relative offset to the constants rather than an absolute + // address to ensure that the code is position-independent. + virtual void GetConstSegmentForCode(PolyObject *obj, POLYUNSIGNED obj_length, PolyWord*& cp, POLYUNSIGNED& count) const + { + PolyWord* last_word = obj->Offset(obj_length - 1); // Last word in the code + POLYSIGNED offset = last_word->AsSigned(); + cp = last_word + 1 + offset / sizeof(PolyWord); + count = cp[-1].AsUnsigned(); + } + void GetConstSegmentForCode(PolyObject* obj, PolyWord*& cp, POLYUNSIGNED& count) const + { + GetConstSegmentForCode(obj, obj->Length(), cp, count); + } + PolyWord* ConstPtrForCode(PolyObject* obj) const + { + PolyWord* cp; POLYUNSIGNED count; + GetConstSegmentForCode(obj, cp, count); + return cp; + } + /* ScanConstantsWithinCode - update addresses within a code segment.*/ virtual void ScanConstantsWithinCode(PolyObject* addr, PolyObject* old, POLYUNSIGNED length, PolyWord* newConstAddr, PolyWord* oldConstAddr, POLYUNSIGNED numConsts, ScanAddress* process) {} void ScanConstantsWithinCode(PolyObject* addr, POLYUNSIGNED length, ScanAddress* process) { PolyWord* constAddr; POLYUNSIGNED count; - addr->GetConstSegmentForCode(length, constAddr, count); + GetConstSegmentForCode(addr, length, constAddr, count); ScanConstantsWithinCode(addr, addr, length, constAddr, constAddr, count, process); } void ScanConstantsWithinCode(PolyObject* addr, ScanAddress* process) { ScanConstantsWithinCode(addr, addr->Length(), process); } // Common case virtual void FlushInstructionCache(void *p, POLYUNSIGNED bytes) {} virtual Architectures MachineArchitecture(void) = 0; virtual void SetBootArchitecture(char arch, unsigned wordLength) {} }; extern MachineDependent *machineDependent; extern struct _entrypts machineSpecificEPT[]; #endif /* _MACHINE_DEP_H */ diff --git a/libpolyml/machoexport.cpp b/libpolyml/machoexport.cpp index be6ae677..cc5f92f6 100644 --- a/libpolyml/machoexport.cpp +++ b/libpolyml/machoexport.cpp @@ -1,538 +1,538 @@ /* Title: Write out a database as a Mach object file Author: David Matthews. - Copyright (c) 2006-7, 2011-2, 2016-18, 2020 David C. J. Matthews + Copyright (c) 2006-7, 2011-2, 2016-18, 2020-21 David C. J. Matthews This library is free software; you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License version 2.1 as published by the Free Software Foundation. This library is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR H PARTICULAR PURPOSE. See the GNU Lesser General Public License for more details. You should have received a copy of the GNU Lesser General Public License along with this library; if not, write to the Free Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA */ #include "config.h" #ifdef HAVE_STDLIB_H #include #endif #ifdef HAVE_STDIO_H #include #endif #ifdef HAVE_STDDEF_H #include #endif #ifdef HAVE_UNISTD_H #include #endif #ifdef HAVE_ERRNO_H #include #endif #ifdef HAVE_TIME_H #include #endif #ifdef HAVE_ASSERT_H #include #define ASSERT(x) assert(x) #else #define ASSERT(x) #endif // If we haven't got the Mach header files we shouldn't be building this. #include #include #include #include #ifdef HAVE_STRING_H #include #endif #ifdef HAVE_SYS_UTSNAME_H #include #endif #include "globals.h" #include "diagnostics.h" #include "sys.h" #include "machine_dep.h" #include "gc.h" #include "mpoly.h" #include "scanaddrs.h" #include "machoexport.h" #include "run_time.h" #include "version.h" #include "polystring.h" #include "timing.h" // Mach-O seems to require each section to have a discrete virtual address range // so we have to adjust various offsets to fit. void MachoExport::adjustOffset(unsigned area, size_t &offset) { // Add in the offset. If sect is memTableEntries it's actually the // descriptors so doesn't have any additional offset. if (area != memTableEntries) { offset += sizeof(exportDescription)+sizeof(memoryTableEntry)*memTableEntries; for (unsigned i = 0; i < area; i++) offset += memTable[i].mtLength; } } void MachoExport::addExternalReference(void *relocAddr, const char *name, bool /*isFuncPtr*/) { externTable.makeEntry(name); writeRelocation(0, relocAddr, symbolNum++, true); } // Generate the address relative to the start of the segment. void MachoExport::setRelocationAddress(void *p, int32_t *reloc) { unsigned area = findArea(p); size_t offset = (char*)p - (char*)memTable[area].mtOriginalAddr; *reloc = offset; } /* Get the index corresponding to an address. */ PolyWord MachoExport::createRelocation(PolyWord p, void *relocAddr) { void *addr = p.AsAddress(); unsigned addrArea = findArea(addr); size_t offset = (char*)addr - (char*)memTable[addrArea].mtOriginalAddr; adjustOffset(addrArea, offset); return writeRelocation(offset, relocAddr, addrArea+1 /* Sections count from 1 */, false); } PolyWord MachoExport::writeRelocation(POLYUNSIGNED offset, void *relocAddr, unsigned symbolNumber, bool isExtern) { // It looks as though struct relocation_info entries are only used // with GENERIC_RELOC_VANILLA types. struct relocation_info relInfo; setRelocationAddress(relocAddr, &relInfo.r_address); relInfo.r_symbolnum = symbolNumber; relInfo.r_pcrel = 0; #if (SIZEOF_VOIDP == 8) relInfo.r_length = 3; // 8 bytes relInfo.r_type = X86_64_RELOC_UNSIGNED; #else relInfo.r_length = 2; // 4 bytes relInfo.r_type = GENERIC_RELOC_VANILLA; #endif relInfo.r_extern = isExtern ? 1 : 0; fwrite(&relInfo, sizeof(relInfo), 1, exportFile); relocationCount++; return PolyWord::FromUnsigned(offset); } /* This is called for each constant within the code. Print a relocation entry for the word and return a value that means that the offset is saved in original word. */ void MachoExport::ScanConstant(PolyObject *base, byte *addr, ScanRelocationKind code, intptr_t displacement) { #ifndef POLYML32IN64 PolyObject *p = GetConstantValue(addr, code, displacement); if (p == 0) return; void *a = p; unsigned aArea = findArea(a); // Set the value at the address to the offset relative to the symbol. size_t offset = (char*)a - (char*)memTable[aArea].mtOriginalAddr; adjustOffset(aArea, offset); switch (code) { case PROCESS_RELOC_DIRECT: // 32 bit address of target { struct relocation_info reloc; setRelocationAddress(addr, &reloc.r_address); reloc.r_symbolnum = aArea+1; // Section numbers start at 1 reloc.r_pcrel = 0; #if (defined(HOSTARCHITECTURE_X86_64)) reloc.r_length = 3; // 8 bytes reloc.r_type = X86_64_RELOC_UNSIGNED; #else reloc.r_length = 2; // 4 bytes reloc.r_type = GENERIC_RELOC_VANILLA; #endif reloc.r_extern = 0; // r_symbolnum is a section number. It should be 1 if we make the IO area a common. for (unsigned i = 0; i < sizeof(PolyWord); i++) { addr[i] = (byte)(offset & 0xff); offset >>= 8; } fwrite(&reloc, sizeof(reloc), 1, exportFile); relocationCount++; } break; #if (defined(HOSTARCHITECTURE_X86) || defined(HOSTARCHITECTURE_X86_64)) case PROCESS_RELOC_I386RELATIVE: // 32 bit relative address { unsigned addrArea = findArea(addr); // If it's in the same area we don't need a relocation because the // relative offset will be unchanged. if (addrArea != aArea) { struct relocation_info reloc; setRelocationAddress(addr, &reloc.r_address); reloc.r_symbolnum = aArea+1; // Section numbers start at 1 reloc.r_pcrel = 1; reloc.r_length = 2; // 4 bytes #if (defined(HOSTARCHITECTURE_X86_64)) reloc.r_type = X86_64_RELOC_SIGNED; #else reloc.r_type = GENERIC_RELOC_VANILLA; #endif reloc.r_extern = 0; // r_symbolnum is a section number. fwrite(&reloc, sizeof(reloc), 1, exportFile); relocationCount++; size_t addrOffset = (char*)addr - (char*)memTable[addrArea].mtOriginalAddr; adjustOffset(addrArea, addrOffset); offset -= addrOffset + 4; for (unsigned i = 0; i < 4; i++) { addr[i] = (byte)(offset & 0xff); offset >>= 8; } } } break; #endif default: ASSERT(0); // Wrong type of relocation for this architecture. } #endif } // Set the file alignment. void MachoExport::alignFile(int align) { char pad[32] = {0}; // Maximum alignment int offset = ftell(exportFile); if ((offset % align) == 0) return; fwrite(&pad, align - (offset % align), 1, exportFile); } void MachoExport::createStructsRelocation(unsigned sect, size_t offset) { struct relocation_info reloc; reloc.r_address = offset; reloc.r_symbolnum = sect+1; // Section numbers start at 1 reloc.r_pcrel = 0; #if (SIZEOF_VOIDP == 8) reloc.r_length = 3; // 8 bytes reloc.r_type = X86_64_RELOC_UNSIGNED; #else reloc.r_length = 2; // 4 bytes reloc.r_type = GENERIC_RELOC_VANILLA; #endif reloc.r_extern = 0; // r_symbolnum is a section number. fwrite(&reloc, sizeof(reloc), 1, exportFile); relocationCount++; } 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. symbolNum = 1; // The first symbol is poly_exports // 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; } #ifndef CODEISNOTEXECUTABLE // Not if we're building the interpreted version. 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; } #endif 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 and write out the relocations. for (i = 0; i < memTableEntries; i++) { sections[i].reloff = ftell(exportFile); relocationCount = 0; // Create the relocation table and turn all addresses into offsets. char *start = (char*)memTable[i].mtOriginalAddr; 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()) { POLYUNSIGNED constCount; PolyWord* cp; // Get the constant area pointer first because ScanConstantsWithinCode // may alter it. - obj->GetConstSegmentForCode(cp, constCount); + machineDependent->GetConstSegmentForCode(obj, cp, constCount); // Update any constants before processing the object // We need that for relative jumps/calls in X86/64. machineDependent->ScanConstantsWithinCode(obj, this); if (cp > (PolyWord*)obj && cp < ((PolyWord*)obj) + length) { // Process the constants if they're in the area but not if they've been moved. for (POLYUNSIGNED i = 0; i < constCount; i++) relocateValue(&(cp[i])); } } else 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); size_t rootOffset = (char*)rootFunction - (char*)memTable[rootAddrArea].mtOriginalAddr; 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, mtCurrentAddr)); } sections[memTableEntries].nreloc = relocationCount; // The symbol table. symTab.symoff = ftell(exportFile); // Global symbols: Just one. { #if (SIZEOF_VOIDP == 8) struct nlist_64 symbol; #else struct nlist symbol; #endif memset(&symbol, 0, sizeof(symbol)); // Zero unused fields symbol.n_un.n_strx = stringTable.makeEntry("_poly_exports"); symbol.n_type = N_EXT | N_SECT; symbol.n_sect = memTableEntries+1; // Sections count from 1. symbol.n_desc = REFERENCE_FLAG_DEFINED; fwrite(&symbol, sizeof(symbol), 1, exportFile); } // External references. for (unsigned i = 0; i < externTable.stringSize; i += (unsigned)strlen(externTable.strings+i) + 1) { const char *symbolName = externTable.strings+i; #if (SIZEOF_VOIDP == 8) struct nlist_64 symbol; #else struct nlist symbol; #endif memset(&symbol, 0, sizeof(symbol)); // Zero unused fields // Have to add an underscore to the symbols. TempCString fullSymbol; fullSymbol = (char*)malloc(strlen(symbolName) + 2); if (fullSymbol == 0) throw MemoryException(); sprintf(fullSymbol, "_%s", symbolName); symbol.n_un.n_strx = stringTable.makeEntry(fullSymbol); symbol.n_type = N_EXT | N_UNDF; symbol.n_sect = NO_SECT; symbol.n_desc = REFERENCE_FLAG_UNDEFINED_NON_LAZY; fwrite(&symbol, sizeof(symbol), 1, exportFile); } symTab.nsyms = symbolNum; // 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.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 = getBuildTime(); exports.architecture = machineDependent->MachineArchitecture(); exports.rtsVersion = POLY_version_number; #ifdef POLYML32IN64 exports.originalBaseAddr = globalHeapBase; #else exports.originalBaseAddr = 0; #endif sections[memTableEntries].offset = ftell(exportFile); fwrite(&exports, sizeof(exports), 1, exportFile); size_t addrOffset = sizeof(exports)+sizeof(memoryTableEntry)*memTableEntries; for (i = 0; i < memTableEntries; i++) { void *save = memTable[i].mtCurrentAddr; memTable[i].mtCurrentAddr = (void*)addrOffset; // Set this to the relative address. addrOffset += memTable[i].mtLength; fwrite(&memTable[i], sizeof(memoryTableEntry), 1, exportFile); memTable[i].mtCurrentAddr = save; } // Now the binary data. for (i = 0; i < memTableEntries; i++) { alignFile(4); sections[i].offset = ftell(exportFile); fwrite(memTable[i].mtOriginalAddr, 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); } diff --git a/libpolyml/objsize.cpp b/libpolyml/objsize.cpp index cf95f129..4f2a1023 100644 --- a/libpolyml/objsize.cpp +++ b/libpolyml/objsize.cpp @@ -1,432 +1,432 @@ /* Title: Object size Copyright (c) 2000 Cambridge University Technical Services Limited - Further development David C.J. Matthews 2016, 2017 + Further development David C.J. Matthews 2016, 2017, 2021 This library is free software; you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License version 2.1 as published by the Free Software Foundation. This library is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for more details. You should have received a copy of the GNU Lesser General Public License along with this library; if not, write to the Free Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA */ #ifdef HAVE_CONFIG_H #include "config.h" #elif defined(_WIN32) #include "winconfig.h" #else #error "No configuration file" #endif #ifdef HAVE_STDIO_H #include #endif #ifdef HAVE_SYS_TYPES_H #include #endif #ifdef HAVE_STDLIB_H #include #endif #ifdef HAVE_STRING_H #include #endif #ifdef HAVE_ASSERT_H #include #define ASSERT(x) assert(x) #else #define ASSERT(x) #endif #include "globals.h" #include "arb.h" #include "run_time.h" #include "machine_dep.h" #include "objsize.h" #include "scanaddrs.h" #include "polystring.h" #include "save_vec.h" #include "bitmap.h" #include "memmgr.h" #include "mpoly.h" #include "processes.h" #include "rtsentry.h" extern "C" { POLYEXTERNALSYMBOL POLYUNSIGNED PolyObjSize(FirstArgument threadId, PolyWord obj); POLYEXTERNALSYMBOL POLYUNSIGNED PolyShowSize(FirstArgument threadId, PolyWord obj); POLYEXTERNALSYMBOL POLYUNSIGNED PolyObjProfile(FirstArgument threadId, PolyWord obj); } extern FILE *polyStdout; #define MAX_PROF_LEN 100 // Profile lengths between 1 and this class ProcessVisitAddresses: public ScanAddress { public: virtual POLYUNSIGNED ScanAddressAt(PolyWord *pt) { return ShowWord(*pt); } virtual POLYUNSIGNED ScanCodeAddressAt(PolyObject **pt) { return ShowObject(*pt); } virtual PolyObject *ScanObjectAddress(PolyObject *base); POLYUNSIGNED ShowWord(PolyWord w) { if (w.IsTagged() || w == PolyWord::FromUnsigned(0)) return 0; else return ShowObject(w.AsObjPtr()); } POLYUNSIGNED ShowObject(PolyObject *p); ProcessVisitAddresses(bool show); ~ProcessVisitAddresses(); VisitBitmap *FindBitmap(PolyObject *p); void ShowBytes(PolyObject *start); void ShowCode(PolyObject *start); void ShowWords(PolyObject *start); POLYUNSIGNED total_length; bool show_size; VisitBitmap **bitmaps; unsigned nBitmaps; // Counts of objects of each size for mutable and immutable data. unsigned iprofile[MAX_PROF_LEN+1]; unsigned mprofile[MAX_PROF_LEN+1]; }; ProcessVisitAddresses::ProcessVisitAddresses(bool show) { // Need to get the allocation lock here. Another thread // could allocate new local areas resulting in gMem.nlSpaces // and gMem.lSpaces changing under our feet. PLocker lock(&gMem.allocLock); total_length = 0; show_size = show; // Create a bitmap for each of the areas apart from the IO area nBitmaps = (unsigned)(gMem.lSpaces.size()+gMem.pSpaces.size()+gMem.cSpaces.size()); // bitmaps = new VisitBitmap*[nBitmaps]; unsigned bm = 0; for (std::vector::iterator i = gMem.pSpaces.begin(); i < gMem.pSpaces.end(); i++) { MemSpace *space = *i; // Permanent areas are filled with objects from the bottom. bitmaps[bm++] = new VisitBitmap(space->bottom, space->top); } for (std::vector::iterator i = gMem.lSpaces.begin(); i < gMem.lSpaces.end(); i++) { LocalMemSpace *space = *i; bitmaps[bm++] = new VisitBitmap(space->bottom, space->top); } for (std::vector::iterator i = gMem.cSpaces.begin(); i < gMem.cSpaces.end(); i++) { CodeSpace *space = *i; bitmaps[bm++] = new VisitBitmap(space->bottom, space->top); } ASSERT(bm == nBitmaps); // Clear the profile counts. for (unsigned i = 0; i < MAX_PROF_LEN+1; i++) { iprofile[i] = mprofile[i] = 0; } } ProcessVisitAddresses::~ProcessVisitAddresses() { if (bitmaps) { for (unsigned i = 0; i < nBitmaps; i++) delete(bitmaps[i]); delete[](bitmaps); } } // Return the bitmap corresponding to the address or NULL if it isn't there. VisitBitmap *ProcessVisitAddresses::FindBitmap(PolyObject *p) { for (unsigned i = 0; i < nBitmaps; i++) { VisitBitmap *bm = bitmaps[i]; if (bm->InRange((PolyWord*)p)) return bm; } return 0; } void ProcessVisitAddresses::ShowBytes(PolyObject *start) { POLYUNSIGNED bytes = start->Length() * sizeof(PolyWord); char *array = (char *) start; putc('\n', polyStdout); if (start->IsMutable()) fprintf(polyStdout, "MUTABLE "); fprintf(polyStdout, "BYTES:%p:%" POLYUFMT "\n", array, bytes); POLYUNSIGNED i, n; for (i = 0, n = 0; n < bytes; n++) { fprintf(polyStdout, "%02x ",array[n] & 0xff); i++; if (i == 16) { putc('\n', polyStdout); i = 0; } } if (i != 0) putc('\n', polyStdout); } #define MAXNAME 500 void ProcessVisitAddresses::ShowCode(PolyObject *start) { POLYUNSIGNED length = start->Length(); putc('\n', polyStdout); if (start->IsMutable()) fprintf(polyStdout, "MUTABLE "); char buffer[MAXNAME+1]; - PolyWord *consts = start->ConstPtrForCode(); + PolyWord *consts = machineDependent->ConstPtrForCode(start); PolyWord string = consts[0]; if (string == TAGGED(0)) strcpy(buffer, ""); else (void) Poly_string_to_C(string, buffer, sizeof(buffer)); fprintf(polyStdout, "CODE:%p:%" POLYUFMT " %s\n", start, length, buffer); POLYUNSIGNED i, n; for (i = 0, n = 0; n < length; n++) { if (i != 0) putc('\t', polyStdout); fprintf(polyStdout, "%8p ", start->Get(n).AsObjPtr()); i++; if (i == 4) { putc('\n', polyStdout); i = 0; } } if (i != 0) putc('\n', polyStdout); } void ProcessVisitAddresses::ShowWords(PolyObject *start) { POLYUNSIGNED length = start->Length(); putc('\n', polyStdout); if (start->IsMutable()) fprintf(polyStdout, "MUTABLE "); fprintf(polyStdout, "%s:%p:%" POLYUFMT "\n", start->IsClosureObject() ? "CLOSURE" : "WORDS", start, length); POLYUNSIGNED i, n; for (i = 0, n = 0; n < length; ) { if (i != 0) putc('\t', polyStdout); if (start->IsClosureObject() && n == 0) { fprintf(polyStdout, "%8p ", *(PolyObject**)start); n += sizeof(PolyObject*) / sizeof(PolyWord); } else { PolyWord p = start->Get(n); if (p.IsTagged()) fprintf(polyStdout, "%08" POLYUFMT " ", p.AsUnsigned()); else fprintf(polyStdout, "%8p ", p.AsObjPtr()); n++; } i++; if (i == 4) { putc('\n', polyStdout); i = 0; } } if (i != 0) putc('\n', polyStdout); } // This is called initially to print the top-level object. // Since we don't process stacks it probably doesn't get called elsewhere. PolyObject *ProcessVisitAddresses::ScanObjectAddress(PolyObject *base) { POLYUNSIGNED lengthWord = ShowWord(base); if (lengthWord) ScanAddressesInObject(base, lengthWord); return base; } // Handle the normal case. Print the object at this word and // return true is it must be handled recursively. POLYUNSIGNED ProcessVisitAddresses::ShowObject(PolyObject *p) { VisitBitmap *bm = FindBitmap(p); if (bm == 0) { fprintf(polyStdout, "Bad address " ZERO_X "%p found\n", p); return 0; } /* Have we already visited this object? */ if (bm->AlreadyVisited(p)) return 0; bm->SetVisited(p); POLYUNSIGNED obj_length = p->Length(); // Increment the appropriate size profile count. if (p->IsMutable()) { if (obj_length > MAX_PROF_LEN) mprofile[MAX_PROF_LEN]++; else mprofile[obj_length]++; } else { if (obj_length > MAX_PROF_LEN) iprofile[MAX_PROF_LEN]++; else iprofile[obj_length]++; } total_length += obj_length + 1; /* total space needed for object */ if (p->IsByteObject()) { if (show_size) ShowBytes(p); return 0; } else if (p->IsCodeObject()) { PolyWord *cp; POLYUNSIGNED const_count; - p->GetConstSegmentForCode(cp, const_count); + machineDependent->GetConstSegmentForCode(p, cp, const_count); if (show_size) ShowCode(p); return p->LengthWord(); // Process addresses in it. } else // Word or closure object { if (show_size) ShowWords(p); return p->LengthWord(); // Process addresses in it. } } Handle ObjSize(TaskData *taskData, Handle obj) { ProcessVisitAddresses process(false); process.ScanObjectAddress(obj->WordP()); return Make_arbitrary_precision(taskData, process.total_length); } Handle ShowSize(TaskData *taskData, Handle obj) { ProcessVisitAddresses process(true); process.ScanObjectAddress(obj->WordP()); fflush(polyStdout); /* We need this for Windows at least. */ return Make_arbitrary_precision(taskData, process.total_length); } static void printfprof(unsigned *counts) { for(unsigned i = 0; i < MAX_PROF_LEN+1; i++) { if (counts[i] != 0) { if (i == MAX_PROF_LEN) fprintf(polyStdout, ">%d\t%u\n", MAX_PROF_LEN, counts[i]); else fprintf(polyStdout, "%d\t%u\n", i, counts[i]); } } } POLYUNSIGNED PolyObjSize(FirstArgument threadId, PolyWord obj) { TaskData *taskData = TaskData::FindTaskForId(threadId); ASSERT(taskData != 0); taskData->PreRTSCall(); ProcessVisitAddresses process(false); if (!obj.IsTagged()) process.ScanObjectAddress(obj.AsObjPtr()); Handle result = Make_arbitrary_precision(taskData, process.total_length); taskData->PostRTSCall(); return result->Word().AsUnsigned(); } POLYUNSIGNED PolyShowSize(FirstArgument threadId, PolyWord obj) { TaskData *taskData = TaskData::FindTaskForId(threadId); ASSERT(taskData != 0); taskData->PreRTSCall(); ProcessVisitAddresses process(true); if (!obj.IsTagged()) process.ScanObjectAddress(obj.AsObjPtr()); fflush(polyStdout); /* We need this for Windows at least. */ Handle result = Make_arbitrary_precision(taskData, process.total_length); taskData->PostRTSCall(); return result->Word().AsUnsigned(); } POLYUNSIGNED PolyObjProfile(FirstArgument threadId, PolyWord obj) { TaskData *taskData = TaskData::FindTaskForId(threadId); ASSERT(taskData != 0); taskData->PreRTSCall(); ProcessVisitAddresses process(false); if (!obj.IsTagged()) process.ScanObjectAddress(obj.AsObjPtr()); fprintf(polyStdout, "\nImmutable object sizes and counts\n"); printfprof(process.iprofile); fprintf(polyStdout, "\nMutable object sizes and counts\n"); printfprof(process.mprofile); fflush(polyStdout); /* We need this for Windows at least. */ Handle result = Make_arbitrary_precision(taskData, process.total_length); taskData->PostRTSCall(); return result->Word().AsUnsigned(); } struct _entrypts objSizeEPT[] = { { "PolyObjSize", (polyRTSFunction)&PolyObjSize}, { "PolyShowSize", (polyRTSFunction)&PolyShowSize}, { "PolyObjProfile", (polyRTSFunction)&PolyObjProfile}, { NULL, NULL} // End of list. }; diff --git a/libpolyml/pecoffexport.cpp b/libpolyml/pecoffexport.cpp index 74b92066..6d68f619 100644 --- a/libpolyml/pecoffexport.cpp +++ b/libpolyml/pecoffexport.cpp @@ -1,423 +1,423 @@ /* Title: Export memory as a PE/COFF object Author: David C. J. Matthews. - Copyright (c) 2006, 2011, 2016-18, 2020 David C. J. Matthews + Copyright (c) 2006, 2011, 2016-18, 2020-21 David C. J. Matthews This library is free software; you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License version 2.1 as published by the Free Software Foundation. This library is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR H PARTICULAR PURPOSE. See the GNU Lesser General Public License for more details. You should have received a copy of the GNU Lesser General Public License along with this library; if not, write to the Free Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA */ #ifdef HAVE_CONFIG_H #include "config.h" #elif defined(_WIN32) #include "winconfig.h" #else #error "No configuration file" #endif #include #include #ifdef HAVE_STDDEF_H #include #endif #ifdef HAVE_STRING_H #include #endif #ifdef HAVE_ERRNO_H #include #endif #ifdef HAVE_ASSERT_H #include #endif #include #include "globals.h" #include "pecoffexport.h" #include "machine_dep.h" #include "scanaddrs.h" #include "run_time.h" #include "../polyexports.h" #include "version.h" #include "polystring.h" #include "timing.h" #ifdef _DEBUG /* MS C defines _DEBUG for debug builds. */ #define DEBUG #endif #ifdef DEBUG #define ASSERT(x) assert(x) #else #define ASSERT(x) #endif #if (SIZEOF_VOIDP == 8) #define DIRECT_WORD_RELOCATION IMAGE_REL_AMD64_ADDR64 #define RELATIVE_32BIT_RELOCATION IMAGE_REL_AMD64_REL32 #else #define DIRECT_WORD_RELOCATION IMAGE_REL_I386_DIR32 #define RELATIVE_32BIT_RELOCATION IMAGE_REL_I386_REL32 #endif void PECOFFExport::writeRelocation(const IMAGE_RELOCATION* reloc) { fwrite(reloc, sizeof(*reloc), 1, exportFile); if (relocationCount == 0) firstRelocation = *reloc; relocationCount++; } void PECOFFExport::addExternalReference(void *relocAddr, const char *name, bool/* isFuncPtr*/) { externTable.makeEntry(name); IMAGE_RELOCATION reloc; // Set the offset within the section we're scanning. setRelocationAddress(relocAddr, &reloc.VirtualAddress); reloc.SymbolTableIndex = symbolNum++; reloc.Type = DIRECT_WORD_RELOCATION; writeRelocation(&reloc); } // Generate the address relative to the start of the segment. void PECOFFExport::setRelocationAddress(void *p, DWORD *reloc) { unsigned area = findArea(p); DWORD offset = (DWORD)((char*)p - (char*)memTable[area].mtOriginalAddr); *reloc = offset; } // Create a relocation entry for an address at a given location. PolyWord PECOFFExport::createRelocation(PolyWord p, void *relocAddr) { IMAGE_RELOCATION reloc; // Set the offset within the section we're scanning. setRelocationAddress(relocAddr, &reloc.VirtualAddress); void *addr = p.AsAddress(); unsigned addrArea = findArea(addr); POLYUNSIGNED offset = (POLYUNSIGNED)((char*)addr - (char*)memTable[addrArea].mtOriginalAddr); reloc.SymbolTableIndex = addrArea; reloc.Type = DIRECT_WORD_RELOCATION; writeRelocation(&reloc); return PolyWord::FromUnsigned(offset); } #ifdef SYMBOLS_REQUIRE_UNDERSCORE #define POLY_PREFIX_STRING "_" #else #define POLY_PREFIX_STRING "" #endif void PECOFFExport::writeSymbol(const char *symbolName, __int32 value, int section, bool isExtern, int symType) { // On X86/32 we have to add an underscore to external symbols TempCString fullSymbol; fullSymbol = (char*)malloc(strlen(POLY_PREFIX_STRING) + strlen(symbolName) + 1); if (fullSymbol == 0) throw MemoryException(); sprintf(fullSymbol, "%s%s", POLY_PREFIX_STRING, symbolName); IMAGE_SYMBOL symbol; memset(&symbol, 0, sizeof(symbol)); // Zero the unused part of the string // Short symbol names go in the entry, longer ones go in the string table. if (strlen(fullSymbol) <= 8) strcat((char*)symbol.N.ShortName, fullSymbol); else { symbol.N.Name.Short = 0; // We have to add 4 bytes because the first word written to the file is a length word. symbol.N.Name.Long = stringTable.makeEntry(fullSymbol) + sizeof(unsigned); } symbol.Value = value; symbol.SectionNumber = section; symbol.Type = symType; symbol.StorageClass = isExtern ? IMAGE_SYM_CLASS_EXTERNAL : IMAGE_SYM_CLASS_STATIC; fwrite(&symbol, sizeof(symbol), 1, exportFile); } /* This is called for each constant within the code. Print a relocation entry for the word and return a value that means that the offset is saved in original word. */ void PECOFFExport::ScanConstant(PolyObject *base, byte *addr, ScanRelocationKind code, intptr_t displacement) { #ifndef POLYML32IN64 IMAGE_RELOCATION reloc; PolyObject *p = GetConstantValue(addr, code, displacement); if (p == 0) return; void *a = p; unsigned aArea = findArea(a); // We don't need a relocation if this is relative to the current segment // since the relative address will already be right. if (code == PROCESS_RELOC_I386RELATIVE && aArea == findArea(addr)) return; setRelocationAddress(addr, &reloc.VirtualAddress); // Set the value at the address to the offset relative to the symbol. uintptr_t offset = (char*)a - (char*)memTable[aArea].mtOriginalAddr; reloc.SymbolTableIndex = aArea; // The value we store here is the offset whichever relocation method // we're using. unsigned maxSize = code == PROCESS_RELOC_I386RELATIVE ? 4: sizeof(PolyWord); for (unsigned i = 0; i < maxSize; i++) { addr[i] = (byte)(offset & 0xff); offset >>= 8; } if (code == PROCESS_RELOC_I386RELATIVE) reloc.Type = RELATIVE_32BIT_RELOCATION; else reloc.Type = DIRECT_WORD_RELOCATION; writeRelocation(&reloc); #endif } // Set the file alignment. void PECOFFExport::alignFile(int align) { char pad[32] = {0}; // Maximum alignment int offset = ftell(exportFile); if ((offset % align) == 0) return; fwrite(&pad, align - (offset % align), 1, exportFile); } void PECOFFExport::exportStore(void) { PolyWord *p; IMAGE_FILE_HEADER fhdr; IMAGE_SECTION_HEADER *sections = 0; IMAGE_RELOCATION reloc; unsigned i; // These are written out as the description of the data. exportDescription exports; time_t now = getBuildTime(); sections = new IMAGE_SECTION_HEADER [memTableEntries+1]; // Plus one for the tables. // Write out initial values for the headers. These are overwritten at the end. // File header memset(&fhdr, 0, sizeof(fhdr)); #if (SIZEOF_VOIDP == 8) fhdr.Machine = IMAGE_FILE_MACHINE_AMD64; // x86-64 #else fhdr.Machine = IMAGE_FILE_MACHINE_I386; // i386 #endif fhdr.NumberOfSections = memTableEntries+1; // One for each area plus one for the tables. fhdr.TimeDateStamp = (DWORD)now; //fhdr.NumberOfSymbols = memTableEntries+1; // One for each area plus "poly_exports" fwrite(&fhdr, sizeof(fhdr), 1, exportFile); // Write it for the moment. // External symbols are added after the memory table entries and "poly_exports". symbolNum = memTableEntries+1; // The first external symbol // Section headers. for (i = 0; i < memTableEntries; i++) { memset(§ions[i], 0, sizeof(IMAGE_SECTION_HEADER)); sections[i].SizeOfRawData = (DWORD)memTable[i].mtLength; sections[i].Characteristics = IMAGE_SCN_MEM_READ | IMAGE_SCN_ALIGN_8BYTES; if (memTable[i].mtFlags & MTF_WRITEABLE) { // Mutable data ASSERT(!(memTable[i].mtFlags & MTF_EXECUTABLE)); // Executable areas can't be writable. strcpy((char*)sections[i].Name, ".data"); sections[i].Characteristics |= IMAGE_SCN_MEM_WRITE | IMAGE_SCN_CNT_INITIALIZED_DATA; } #ifndef CODEISNOTEXECUTABLE // Not if we're building the interpreted version. else if (memTable[i].mtFlags & MTF_EXECUTABLE) { // Immutable data areas are marked as executable. strcpy((char*)sections[i].Name, ".text"); sections[i].Characteristics |= IMAGE_SCN_MEM_EXECUTE | IMAGE_SCN_CNT_CODE; } #endif else { // Immutable data areas are marked as executable. strcpy((char*)sections[i].Name, ".rdata"); sections[i].Characteristics |= IMAGE_SCN_CNT_INITIALIZED_DATA; } } // Extra section for the tables. memset(§ions[memTableEntries], 0, sizeof(IMAGE_SECTION_HEADER)); sprintf((char*)sections[memTableEntries].Name, ".data"); sections[memTableEntries].SizeOfRawData = sizeof(exports) + (memTableEntries+1)*sizeof(memoryTableEntry); // Don't need write access here but keep it for consistency with other .data sections sections[memTableEntries].Characteristics = IMAGE_SCN_MEM_READ | IMAGE_SCN_ALIGN_8BYTES | IMAGE_SCN_MEM_WRITE | IMAGE_SCN_CNT_INITIALIZED_DATA; fwrite(sections, sizeof(IMAGE_SECTION_HEADER), memTableEntries+1, exportFile); // Write it for the moment. for (i = 0; i < memTableEntries; i++) { sections[i].PointerToRelocations = ftell(exportFile); relocationCount = 0; // Create the relocation table and turn all addresses into offsets. char *start = (char*)memTable[i].mtOriginalAddr; 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()) { POLYUNSIGNED constCount; PolyWord* cp; // Get the constant area pointer first because ScanConstantsWithinCode // may alter it. - obj->GetConstSegmentForCode(cp, constCount); + machineDependent->GetConstSegmentForCode(obj, cp, constCount); // Update any constants before processing the object // We need that for relative jumps/calls in X86/64. machineDependent->ScanConstantsWithinCode(obj, this); if (cp > (PolyWord*)obj && cp < ((PolyWord*)obj) + length) { // Process the constants if they're in the area but not if they've been moved. for (POLYUNSIGNED i = 0; i < constCount; i++) relocateValue(&(cp[i])); } } else relocateObject(obj); p += length; } // If there are more than 64k relocations set this bit and set the value to 64k-1. if (relocationCount >= 65535) { // We're going to overwrite the first relocation so we have to write the // copy we saved here. writeRelocation(&firstRelocation); // Increments relocationCount sections[i].NumberOfRelocations = 65535; sections[i].Characteristics |= IMAGE_SCN_LNK_NRELOC_OVFL; // We have to go back and patch up the first (dummy) relocation entry // which contains the count. fseek(exportFile, sections[i].PointerToRelocations, SEEK_SET); memset(&reloc, 0, sizeof(reloc)); reloc.RelocCount = relocationCount; fwrite(&reloc, sizeof(reloc), 1, exportFile); fseek(exportFile, 0, SEEK_END); // Return to the end of the file. } else sections[i].NumberOfRelocations = relocationCount; } // We don't need to handle relocation overflow here. sections[memTableEntries].PointerToRelocations = ftell(exportFile); relocationCount = 0; // Relocations for "exports" and "memTable"; // 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. reloc.Type = DIRECT_WORD_RELOCATION; reloc.SymbolTableIndex = memTableEntries; // Relative to poly_exports reloc.VirtualAddress = offsetof(exportDescription, memTable); fwrite(&reloc, sizeof(reloc), 1, exportFile); relocationCount++; // Address of "rootFunction" within "exports" reloc.Type = DIRECT_WORD_RELOCATION; unsigned rootAddrArea = findArea(rootFunction); reloc.SymbolTableIndex = rootAddrArea; reloc.VirtualAddress = offsetof(exportDescription, rootFunction); fwrite(&reloc, sizeof(reloc), 1, exportFile); relocationCount++; for (i = 0; i < memTableEntries; i++) { reloc.Type = DIRECT_WORD_RELOCATION; reloc.SymbolTableIndex = i; // Relative to base symbol reloc.VirtualAddress = sizeof(exportDescription) + i * sizeof(memoryTableEntry) + offsetof(memoryTableEntry, mtCurrentAddr); fwrite(&reloc, sizeof(reloc), 1, exportFile); relocationCount++; } ASSERT(relocationCount < 65535); // Shouldn't get overflow!! sections[memTableEntries].NumberOfRelocations = relocationCount; // Now the binary data. for (i = 0; i < memTableEntries; i++) { sections[i].PointerToRawData = ftell(exportFile); fwrite(memTable[i].mtOriginalAddr, 1, memTable[i].mtLength, exportFile); } sections[memTableEntries].PointerToRawData = ftell(exportFile); memset(&exports, 0, sizeof(exports)); exports.structLength = sizeof(exportDescription); exports.memTableSize = sizeof(memoryTableEntry); exports.memTableEntries = memTableEntries; exports.memTable = (memoryTableEntry *)sizeof(exports); // It follows immediately after this. exports.rootFunction = (void*)((char*)rootFunction - (char*)memTable[rootAddrArea].mtOriginalAddr); exports.timeStamp = now; exports.architecture = machineDependent->MachineArchitecture(); exports.rtsVersion = POLY_version_number; #ifdef POLYML32IN64 exports.originalBaseAddr = globalHeapBase; #else exports.originalBaseAddr = 0; #endif // Set the address values to zero before we write. They will always // be relative to their base symbol. for (i = 0; i < memTableEntries; i++) memTable[i].mtCurrentAddr = 0; fwrite(&exports, sizeof(exports), 1, exportFile); fwrite(memTable, sizeof(memoryTableEntry), memTableEntries, exportFile); // First the symbol table. We have one entry for the exports and an additional // entry for each of the sections. fhdr.PointerToSymbolTable = ftell(exportFile); // The section numbers are one-based. Zero indicates the "common" area. // First write symbols for each section and for poly_exports. for (i = 0; i < memTableEntries; i++) { char buff[50]; sprintf(buff, "area%0d", i); writeSymbol(buff, 0, i+1, false); } // Exported symbol for table. writeSymbol("poly_exports", 0, memTableEntries+1, true); // External references. for (unsigned i = 0; i < externTable.stringSize; i += (unsigned)strlen(externTable.strings+i) + 1) writeSymbol(externTable.strings+i, 0, 0, true, 0x20); fhdr.NumberOfSymbols = symbolNum; // The string table is written immediately after the symbols. // The length is included as the first word. unsigned strSize = stringTable.stringSize + sizeof(unsigned); fwrite(&strSize, sizeof(strSize), 1, exportFile); fwrite(stringTable.strings, stringTable.stringSize, 1, exportFile); // Rewind to rewrite the headers. fseek(exportFile, 0, SEEK_SET); fwrite(&fhdr, sizeof(fhdr), 1, exportFile); fwrite(sections, sizeof(IMAGE_SECTION_HEADER), memTableEntries+1, exportFile); fclose(exportFile); exportFile = NULL; delete[](sections); } diff --git a/libpolyml/pexport.cpp b/libpolyml/pexport.cpp index 8d4ade15..f7f010c9 100644 --- a/libpolyml/pexport.cpp +++ b/libpolyml/pexport.cpp @@ -1,902 +1,902 @@ /* Title: Export and import memory in a portable format Author: David C. J. Matthews. - Copyright (c) 2006-7, 2015-8, 2020 David C. J. Matthews + Copyright (c) 2006-7, 2015-8, 2020-21 David C. J. Matthews This library is free software; you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License version 2.1 as published by the Free Software Foundation. This library is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR H PARTICULAR PURPOSE. See the GNU Lesser General Public License for more details. You should have received a copy of the GNU Lesser General Public License along with this library; if not, write to the Free Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA */ #ifdef HAVE_CONFIG_H #include "config.h" #elif defined(_WIN32) #include "winconfig.h" #else #error "No configuration file" #endif #ifdef HAVE_STDIO_H #include #endif #ifdef HAVE_ERRNO_H #include #endif #ifdef HAVE_ASSERT_H #include #define ASSERT(x) assert(x) #else #define ASSERT(x) #endif #include "globals.h" #include "pexport.h" #include "machine_dep.h" #include "scanaddrs.h" #include "run_time.h" #include "../polyexports.h" #include "version.h" #include "sys.h" #include "polystring.h" #include "memmgr.h" #include "rtsentry.h" #include "mpoly.h" // For polyStderr /* This file contains the code both to export the file and to import it in a new session. */ PExport::PExport() { } PExport::~PExport() { } // Get the index corresponding to an address. size_t PExport::getIndex(PolyObject *p) { // Binary chop to find the index from the address. size_t lower = 0, upper = pMap.size(); while (1) { ASSERT(lower < upper); size_t middle = (lower+upper)/2; ASSERT(middle < pMap.size()); if (p < pMap[middle]) { // Use lower to middle upper = middle; } else if (p > pMap[middle]) { // Use middle+1 to upper lower = middle+1; } else // Found it return middle; } } /* Get the index corresponding to an address. */ void PExport::printAddress(void *p) { fprintf(exportFile, "@%" PRI_SIZET "", getIndex((PolyObject*)p)); } void PExport::printValue(PolyWord q) { if (IS_INT(q) || q == PolyWord::FromUnsigned(0)) fprintf(exportFile, "%" POLYSFMT, UNTAGGED(q)); else printAddress(q.AsAddress()); } void PExport::printObject(PolyObject *p) { POLYUNSIGNED length = p->Length(); POLYUNSIGNED i; size_t myIndex = getIndex(p); fprintf(exportFile, "%" PRI_SIZET ":", myIndex); if (p->IsMutable()) putc('M', exportFile); if (OBJ_IS_NEGATIVE(p->LengthWord())) putc('N', exportFile); if (OBJ_IS_WEAKREF_OBJECT(p->LengthWord())) putc('W', exportFile); if (OBJ_IS_NO_OVERWRITE(p->LengthWord())) putc('V', exportFile); if (p->IsByteObject()) { if (p->IsMutable() && p->IsWeakRefObject() && p->Length() >= sizeof(uintptr_t) / sizeof(PolyWord)) { // This is either an entry point or a weak ref used in the FFI. // Clear the first word if (p->Length() == sizeof(uintptr_t)/sizeof(PolyWord)) putc('K', exportFile); // Weak ref else if (p->Length() > sizeof(uintptr_t) / sizeof(PolyWord)) { // Entry point - C null-terminated string. putc('E', exportFile); const char* name = (char*)p + sizeof(uintptr_t); fprintf(exportFile, "%" PRI_SIZET "|%s", strlen(name), name); *(uintptr_t*)p = 0; // Entry point } } else { /* May be a string, a long format arbitrary precision number or a real number. */ PolyStringObject* ps = (PolyStringObject*)p; /* This is not infallible but it seems to be good enough to detect the strings. */ POLYUNSIGNED bytes = length * sizeof(PolyWord); if (length >= 2 && ps->length <= bytes - sizeof(POLYUNSIGNED) && ps->length > bytes - 2 * sizeof(POLYUNSIGNED)) { /* Looks like a string. */ fprintf(exportFile, "S%" POLYUFMT "|", ps->length); for (unsigned i = 0; i < ps->length; i++) { char ch = ps->chars[i]; fprintf(exportFile, "%02x", ch & 0xff); } } else { /* Not a string. May be an arbitrary precision integer. If the source and destination word lengths differ we could find that some long-format arbitrary precision numbers could be represented in the tagged short form or vice-versa. The former case might give rise to errors because when comparing two arbitrary precision numbers for equality we assume that they are not equal if they have different representation. The latter case could be a problem because we wouldn't know whether to convert the tagged form to long form, which would be correct if the value has type "int" or to truncate it which would be correct for "word". It could also be a real number but that doesn't matter if we recompile everything on the new machine. */ byte* u = (byte*)p; putc('B', exportFile); fprintf(exportFile, "%" PRI_SIZET "|", length * sizeof(PolyWord)); for (unsigned i = 0; i < (unsigned)(length * sizeof(PolyWord)); i++) { fprintf(exportFile, "%02x", u[i]); } } } } else if (p->IsCodeObject()) { POLYUNSIGNED constCount; PolyWord *cp; ASSERT(! p->IsMutable() ); /* Work out the number of bytes in the code and the number of constants. */ - p->GetConstSegmentForCode(cp, constCount); + machineDependent->GetConstSegmentForCode(p, cp, constCount); /* The byte count is the length of the segment minus the number of constants minus one for the constant count. It includes the marker word, byte count, profile count and, on the X86/64 at least, any non-address constants. These are actually word values. */ POLYUNSIGNED byteCount = (length - constCount - 2) * sizeof(PolyWord); fprintf(exportFile, "F%" POLYUFMT ",%" POLYUFMT "|", constCount, byteCount); // First the code. byte *u = (byte*)p; for (POLYUNSIGNED i = 0; i < byteCount; i++) fprintf(exportFile, "%02x", u[i]); putc('|', exportFile); // Now the constants. for (POLYUNSIGNED i = 0; i < constCount; i++) { printValue(cp[i]); if (i < constCount-1) putc(',', exportFile); } putc('|', exportFile); // Finally any constants in the code object. machineDependent->ScanConstantsWithinCode(p, this); } else // Ordinary objects, essentially tuples, or closures. { if (p->IsClosureObject()) { POLYUNSIGNED nItems = length - sizeof(PolyObject*) / sizeof(PolyWord) + 1; fprintf(exportFile, "C%" POLYUFMT "|", nItems); // Number of items } else fprintf(exportFile, "O%" POLYUFMT "|", length); if (p->IsClosureObject()) { // The first word is always a code address. printAddress(*(PolyObject**)p); i = sizeof(PolyObject*)/sizeof(PolyWord); if (i < length) putc(',', exportFile); } else i = 0; while (i < length) { printValue(p->Get(i)); if (i < length-1) putc(',', exportFile); i++; } } fprintf(exportFile, "\n"); } /* This is called for each constant within the code. Print a relocation entry for the word and return a value that means that the offset is saved in original word. */ void PExport::ScanConstant(PolyObject *base, byte *addr, ScanRelocationKind code, intptr_t displacement) { PolyObject *p = GetConstantValue(addr, code, displacement); if (p == 0) return; // Don't put in tagged constants // Put in the byte offset and the relocation type code. POLYUNSIGNED offset = (POLYUNSIGNED)(addr - (byte*)base); ASSERT (offset < base->Length() * sizeof(POLYUNSIGNED)); fprintf(exportFile, "%" POLYUFMT ",%d,", (POLYUNSIGNED)(addr - (byte*)base), code); printAddress(p); // The value to plug in. fprintf(exportFile, " "); } void PExport::exportStore(void) { // We want the entries in pMap to be in ascending // order of address to make searching easy so we need to process the areas // in order of increasing address, which may not be the order in memTable. std::vector indexOrder; indexOrder.reserve(memTableEntries); for (size_t i = 0; i < memTableEntries; i++) { std::vector::iterator it; for (it = indexOrder.begin(); it != indexOrder.end(); it++) { if (memTable[*it].mtOriginalAddr >= memTable[i].mtOriginalAddr) break; } indexOrder.insert(it, i); } // Process the area in order of ascending address. for (std::vector::iterator i = indexOrder.begin(); i != indexOrder.end(); i++) { size_t index = *i; char *start = (char*)memTable[index].mtOriginalAddr; char *end = start + memTable[index].mtLength; for (PolyWord *p = (PolyWord*)start; p < (PolyWord*)end; ) { p++; PolyObject *obj = (PolyObject*)p; POLYUNSIGNED length = obj->Length(); pMap.push_back(obj); p += length; } } /* Start writing the information. */ fprintf(exportFile, "Objects\t%" PRI_SIZET "\n", pMap.size()); char arch = '?'; switch (machineDependent->MachineArchitecture()) { case MA_Interpreted: arch = 'I'; break; case MA_I386: case MA_X86_64: case MA_X86_64_32: arch = 'X'; break; } fprintf(exportFile, "Root\t%" PRI_SIZET " %c %u\n", getIndex(rootFunction), arch, (unsigned)sizeof(PolyWord)); // Generate each of the areas. for (size_t i = 0; i < memTableEntries; i++) { char *start = (char*)memTable[i].mtOriginalAddr; char *end = start + memTable[i].mtLength; for (PolyWord *p = (PolyWord*)start; p < (PolyWord*)end; ) { p++; PolyObject *obj = (PolyObject*)p; POLYUNSIGNED length = obj->Length(); #ifdef POLYML32IN64 // We may have filler cells to get the alignment right. // We mustn't try to print them. if (((uintptr_t)obj & 4) != 0 && length == 0) continue; #endif printObject(obj); p += length; } } fclose(exportFile); exportFile = NULL; } /* Import a portable export file and load it into memory. Creates "permanent" address entries in the global memory table. */ class SpaceAlloc { public: SpaceAlloc(unsigned *indexCtr, unsigned perms, POLYUNSIGNED def); PolyObject *NewObj(POLYUNSIGNED objWords); size_t defaultSize; PermanentMemSpace *memSpace; size_t used; unsigned permissions; unsigned *spaceIndexCtr; }; SpaceAlloc::SpaceAlloc(unsigned *indexCtr, unsigned perms, POLYUNSIGNED def) { permissions = perms; defaultSize = def; memSpace = 0; used = 0; spaceIndexCtr = indexCtr; } // Allocate a new object. May create a new space and add the old one to the permanent // memory table if this is exhausted. #ifndef POLYML32IN64 PolyObject *SpaceAlloc::NewObj(POLYUNSIGNED objWords) { if (memSpace == 0 || memSpace->spaceSize() - used <= objWords) { // Need some more space. size_t size = defaultSize; if (size <= objWords) size = objWords+1; memSpace = gMem.AllocateNewPermanentSpace(size * sizeof(PolyWord), permissions, *spaceIndexCtr); (*spaceIndexCtr)++; // The memory is writable until CompletePermanentSpaceAllocation is called if (memSpace == 0) { fprintf(polyStderr, "Unable to allocate memory\n"); return 0; } used = 0; } ASSERT(memSpace->spaceSize() - used > objWords); PolyObject *newObj = (PolyObject*)(memSpace->bottom + used+1); used += objWords+1; return newObj; } #else // With 32in64 we need to allocate on 8-byte boundaries. PolyObject *SpaceAlloc::NewObj(POLYUNSIGNED objWords) { size_t rounded = objWords; if ((objWords & 1) == 0) rounded++; if (memSpace == 0 || memSpace->spaceSize() - used <= rounded) { // Need some more space. size_t size = defaultSize; if (size <= rounded) size = rounded + 1; memSpace = gMem.AllocateNewPermanentSpace(size * sizeof(PolyWord), permissions, *spaceIndexCtr); (*spaceIndexCtr)++; // The memory is writable until CompletePermanentSpaceAllocation is called if (memSpace == 0) { fprintf(stderr, "Unable to allocate memory\n"); return 0; } memSpace->writeAble(memSpace->bottom)[0] = PolyWord::FromUnsigned(0); used = 1; } PolyObject *newObj = (PolyObject*)(memSpace->bottom + used + 1); if (rounded != objWords) memSpace->writeAble(newObj)->Set(objWords, PolyWord::FromUnsigned(0)); used += rounded + 1; ASSERT(((uintptr_t)newObj & 0x7) == 0); return newObj; } #endif class PImport { public: PImport(); ~PImport(); bool DoImport(void); FILE *f; PolyObject *Root(void) { return objMap[nRoot]; } private: bool ReadValue(PolyObject *p, POLYUNSIGNED i); bool GetValue(PolyWord *result); POLYUNSIGNED nObjects, nRoot; PolyObject **objMap; unsigned spaceIndex; SpaceAlloc mutSpace, immutSpace, codeSpace; }; PImport::PImport(): mutSpace(&spaceIndex, MTF_WRITEABLE, 1024*1024), immutSpace(&spaceIndex, 0, 1024*1024), codeSpace(&spaceIndex, MTF_EXECUTABLE, 1024 * 1024) { f = NULL; objMap = 0; spaceIndex = 1; } PImport::~PImport() { if (f) fclose(f); free(objMap); } bool PImport::GetValue(PolyWord *result) { int ch = getc(f); if (ch == '@') { /* Address of an object. */ POLYUNSIGNED obj; fscanf(f, "%" POLYUFMT, &obj); ASSERT(obj < nObjects); *result = objMap[obj]; } else if ((ch >= '0' && ch <= '9') || ch == '-') { /* Tagged integer. */ POLYSIGNED j; ungetc(ch, f); fscanf(f, "%" POLYSFMT, &j); /* The assertion may be false if we are porting to a machine with a shorter tagged representation. */ ASSERT(j >= -MAXTAGGED-1 && j <= MAXTAGGED); *result = TAGGED(j); } else { fprintf(polyStderr, "Unexpected character in stream"); return false; } return true; } /* Read a value and store it at the specified word. */ bool PImport::ReadValue(PolyObject *p, POLYUNSIGNED i) { PolyWord result = TAGGED(0); if (GetValue(&result)) { p->Set(i, result); return true; } else return false; } bool PImport::DoImport() { int ch; POLYUNSIGNED objNo; ASSERT(gMem.pSpaces.size() == 0); ASSERT(gMem.eSpaces.size() == 0); ch = getc(f); ASSERT(ch == 'O'); /* Number of objects. */ while (getc(f) != '\t') ; fscanf(f, "%" POLYUFMT, &nObjects); /* Create a mapping table. */ objMap = (PolyObject**)calloc(nObjects, sizeof(PolyObject*)); if (objMap == 0) { fprintf(polyStderr, "Unable to allocate memory\n"); return false; } do { ch = getc(f); } while (ch == '\n'); ASSERT(ch == 'R'); /* Root object number. */ while (getc(f) != '\t') ; fscanf(f, "%" POLYUFMT, &nRoot); do { ch = getc(f); } while (ch == ' ' || ch == '\t'); // Older versions did not have the architecture and word length. if (ch != '\r' && ch != '\n') { unsigned wordLength; while (ch == ' ' || ch == '\t') ch = getc(f); char arch = ch; ch = getc(f); fscanf(f, "%u", &wordLength); // If we're booting a native code version from interpreted // code we have to interpret. machineDependent->SetBootArchitecture(arch, wordLength); } /* Now the objects themselves. */ while (1) { unsigned objBits = 0; POLYUNSIGNED nWords, nBytes; do { ch = getc(f); } while (ch == '\r' || ch == '\n'); if (ch == EOF) break; ungetc(ch, f); fscanf(f, "%" POLYUFMT, &objNo); ch = getc(f); ASSERT(ch == ':'); ASSERT(objNo < nObjects); /* Modifiers, MNVW. */ do { ch = getc(f); if (ch == 'M') objBits |= F_MUTABLE_BIT; else if (ch == 'N') objBits |= F_NEGATIVE_BIT; if (ch == 'V') objBits |= F_NO_OVERWRITE; if (ch == 'W') objBits |= F_WEAK_BIT; } while (ch == 'M' || ch == 'N' || ch == 'V' || ch == 'W'); /* Object type. */ switch (ch) { case 'O': /* Simple object. */ fscanf(f, "%" POLYUFMT, &nWords); break; case 'B': /* Byte segment. */ objBits |= F_BYTE_OBJ; fscanf(f, "%" POLYUFMT, &nBytes); /* Round up to appropriate number of words. */ nWords = (nBytes + sizeof(PolyWord) -1) / sizeof(PolyWord); break; case 'S': /* String. */ objBits |= F_BYTE_OBJ; /* The length is the number of characters. */ fscanf(f, "%" POLYUFMT, &nBytes); /* Round up to appropriate number of words. Need to add one PolyWord for the length PolyWord. */ nWords = (nBytes + sizeof(PolyWord) -1) / sizeof(PolyWord) + 1; break; case 'F': objBits |= F_CODE_OBJ; /* Read the number of bytes of code and the number of words for constants. */ fscanf(f, "%" POLYUFMT ",%" POLYUFMT, &nWords, &nBytes); nWords += 2; // Add two words for no of consts + offset. /* Add in the size of the code itself. */ nWords += (nBytes + sizeof(PolyWord) -1) / sizeof(PolyWord); break; case 'C': // Closure objBits |= F_CLOSURE_OBJ; fscanf(f, "%" POLYUFMT, &nWords); // This is the number of items. nWords += sizeof(PolyObject*) / sizeof(PolyWord) - 1; break; case 'L': // Legacy closure objBits |= F_CLOSURE_OBJ; fscanf(f, "%" POLYUFMT, &nWords); // This was the number of words. break; case 'K': // Single weak reference nWords = sizeof(uintptr_t)/sizeof(PolyWord); objBits |= F_BYTE_OBJ; break; case 'E': // Entry point - address followed by string objBits |= F_BYTE_OBJ; // The length is the length of the string but it must be null-terminated fscanf(f, "%" POLYUFMT, &nBytes); // Add one uintptr_t plus one plus padding to an integral number of words. nWords = (nBytes + sizeof(uintptr_t) + sizeof(PolyWord)) / sizeof(PolyWord); break; default: fprintf(polyStderr, "Invalid object type\n"); return false; } SpaceAlloc* alloc; if (objBits & F_MUTABLE_BIT) alloc = &mutSpace; else if ((objBits & 3) == F_CODE_OBJ) alloc = &codeSpace; else alloc = &immutSpace; PolyObject* p = alloc->NewObj(nWords); if (p == 0) return false; objMap[objNo] = p; /* Put in length PolyWord and flag bits. */ alloc->memSpace->writeAble(p)->SetLengthWord(nWords, objBits); /* Skip the object contents. */ while (getc(f) != '\n') ; } /* Second pass - fill in the contents. */ fseek(f, 0, SEEK_SET); /* Skip the information at the start. */ ch = getc(f); ASSERT(ch == 'O'); /* Number of objects. */ while (getc(f) != '\n'); ch = getc(f); ASSERT(ch == 'R'); /* Root object number. */ while (getc(f) != '\n') ; while (1) { if (feof(f)) break; fscanf(f, "%" POLYUFMT, &objNo); if (feof(f)) break; ch = getc(f); ASSERT(ch == ':'); ASSERT(objNo < nObjects); PolyObject * p = objMap[objNo]; /* Modifiers, M or N. */ do { ch = getc(f); } while (ch == 'M' || ch == 'N' || ch == 'V' || ch == 'W'); /* Object type. */ switch (ch) { case 'O': /* Simple object. */ case 'C': // Closure case 'L': // Legacy closure { POLYUNSIGNED nWords; bool isClosure = ch == 'C' || ch == 'L'; fscanf(f, "%" POLYUFMT, &nWords); if (ch == 'C') nWords += sizeof(PolyObject*) / sizeof(PolyWord) - 1; ch = getc(f); ASSERT(ch == '|'); ASSERT(nWords == p->Length()); POLYUNSIGNED i = 0; if (isClosure) { int ch = getc(f); // This should be an address if (ch != '@') return false; POLYUNSIGNED obj; fscanf(f, "%" POLYUFMT, &obj); ASSERT(obj < nObjects); *(PolyObject**)p = objMap[obj]; ch = getc(f); i = sizeof(PolyObject*) / sizeof(PolyWord); } while (i < nWords) { if (!ReadValue(p, i)) return false; ch = getc(f); ASSERT((ch == ',' && i < nWords - 1) || (ch == '\n' && i == nWords - 1)); i++; } break; } case 'B': /* Byte segment. */ { byte *u = (byte*)p; POLYUNSIGNED nBytes; fscanf(f, "%" POLYUFMT, &nBytes); ch = getc(f); ASSERT(ch == '|'); for (POLYUNSIGNED i = 0; i < nBytes; i++) { int n; fscanf(f, "%02x", &n); u[i] = n; } ch = getc(f); ASSERT(ch == '\n'); // Legacy: If this is an entry point object set its value. if (p->IsMutable() && p->IsWeakRefObject() && p->Length() > sizeof(uintptr_t)/sizeof(PolyWord)) { bool loadEntryPt = setEntryPoint(p); ASSERT(loadEntryPt); } break; } case 'S': /* String. */ { PolyStringObject * ps = (PolyStringObject *)p; /* The length is the number of characters. */ POLYUNSIGNED nBytes; fscanf(f, "%" POLYUFMT, &nBytes); ch = getc(f); ASSERT(ch == '|'); ps->length = nBytes; for (POLYUNSIGNED i = 0; i < nBytes; i++) { int n; fscanf(f, "%02x", &n); ps->chars[i] = n; } ch = getc(f); ASSERT(ch == '\n'); break; } case 'D': case 'F': { bool newForm = ch == 'F'; POLYUNSIGNED length = p->Length(); POLYUNSIGNED nWords, nBytes; MemSpace* space = gMem.SpaceForObjectAddress(p); PolyObject *wr = space->writeAble(p); byte* u = (byte*)wr; /* Read the number of bytes of code and the number of words for constants. */ fscanf(f, "%" POLYUFMT ",%" POLYUFMT, &nWords, &nBytes); /* Read the code. */ ch = getc(f); ASSERT(ch == '|'); for (POLYUNSIGNED i = 0; i < nBytes; i++) { int n; fscanf(f, "%02x", &n); u[i] = n; } ch = getc(f); ASSERT(ch == '|'); if (newForm) { wr->Set(length - nWords - 2, PolyWord::FromUnsigned(nWords)); wr->Set(length - 1, PolyWord::FromSigned((0-nWords-1)*sizeof(PolyWord))); } else wr->Set(length-1, PolyWord::FromUnsigned(nWords)); /* Read in the constants. */ for (POLYUNSIGNED i = 0; i < nWords; i++) { if (! ReadValue(wr, i+length-nWords-1)) return false; ch = getc(f); ASSERT((ch == ',' && i < nWords-1) || ((ch == '\n' || ch == '|') && i == nWords-1)); } // Read in any constants in the code. if (ch == '|') { ch = getc(f); while (ch != '\n') { ungetc(ch, f); POLYUNSIGNED offset; int code; fscanf(f, "%" POLYUFMT ",%d", &offset, &code); ch = getc(f); ASSERT(ch == ','); // This should be an address. ch = getc(f); if (ch == '@') { POLYUNSIGNED obj; fscanf(f, "%" POLYUFMT, &obj); ASSERT(obj < nObjects); PolyObject *addr = objMap[obj]; byte *toPatch = (byte*)p + offset; // Pass the execute address here. ScanAddress::SetConstantValue(toPatch, addr, (ScanRelocationKind)code); } else { // Previously we also included tagged constants but they are // already in the code. ungetc(ch, f); PolyWord w; if (!GetValue(&w)) return false; } do ch = getc(f); while (ch == ' '); } } // Clear the mutable bit wr->SetLengthWord(p->Length(), F_CODE_OBJ); break; } case 'K': // Weak reference - must be zeroed *(uintptr_t*)p = 0; break; case 'E': // Entry point - address followed by string { // The length is the number of characters. *(uintptr_t*)p = 0; char* b = (char*)p + sizeof(uintptr_t); POLYUNSIGNED nBytes; fscanf(f, "%" POLYUFMT, &nBytes); ch = getc(f); ASSERT(ch == '|'); for (POLYUNSIGNED i = 0; i < nBytes; i++) { ch = getc(f); *b++ = ch; } *b = 0; ch = getc(f); ASSERT(ch == '\n'); bool loadEntryPt = setEntryPoint(p); ASSERT(loadEntryPt); break; } default: fprintf(polyStderr, "Invalid object type\n"); return false; } } // Now remove write access from immutable spaces. for (std::vector::iterator i = gMem.pSpaces.begin(); i < gMem.pSpaces.end(); i++) gMem.CompletePermanentSpaceAllocation(*i); return true; } // Import a file in the portable format and return a pointer to the root object. PolyObject *ImportPortable(const TCHAR *fileName) { PImport pImport; #if (defined(_WIN32) && defined(UNICODE)) pImport.f = _wfopen(fileName, L"r"); if (pImport.f == 0) { fprintf(polyStderr, "Unable to open file: %S\n", fileName); return 0; } #else pImport.f = fopen(fileName, "r"); if (pImport.f == 0) { fprintf(polyStderr, "Unable to open file: %s\n", fileName); return 0; } #endif if (pImport.DoImport()) return pImport.Root(); else return 0; } diff --git a/libpolyml/process_env.cpp b/libpolyml/process_env.cpp index fa5ea179..145594d1 100644 --- a/libpolyml/process_env.cpp +++ b/libpolyml/process_env.cpp @@ -1,669 +1,669 @@ /* Title: Process environment. Copyright (c) 2000-8, 2016-17, 2020 David C. J. Matthews This library is free software; you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License version 2.1 as published by the Free Software Foundation. This library is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for more details. You should have received a copy of the GNU Lesser General Public License along with this library; if not, write to the Free Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA */ #ifdef HAVE_CONFIG_H #include "config.h" #elif defined(_WIN32) #include "winconfig.h" #else #error "No configuration file" #endif #ifdef HAVE_STDIO_H #include #endif #ifdef HAVE_ERRNO_H #include #endif #ifdef HAVE_STRING_H #include #endif #ifdef HAVE_STDLIB_H #include #endif #ifdef HAVE_SYS_PARAM_H #include #endif #ifdef HAVE_UNISTD_H #include #endif #ifdef HAVE_SYS_WAIT_H #include #endif #if (defined(__CYGWIN__) || defined(_WIN32)) #include #endif #ifdef HAVE_ASSERT_H #include #define ASSERT(x) assert(x) #else #define ASSERT(x) 0 #endif // Include this next before errors.h since in WinCE at least the winsock errors are defined there. #if (defined(_WIN32)) #include #include #define NOMEMORY ERROR_NOT_ENOUGH_MEMORY #undef ENOMEM #else typedef char TCHAR; #define _tgetenv getenv #define NOMEMORY ENOMEM #endif #include "globals.h" #include "sys.h" #include "run_time.h" #include "process_env.h" #include "arb.h" #include "mpoly.h" #include "gc.h" #include "scanaddrs.h" #include "polystring.h" #include "save_vec.h" #include "process_env.h" #include "rts_module.h" #include "machine_dep.h" #include "processes.h" #include "locking.h" #include "errors.h" #include "rtsentry.h" #include "version.h" extern "C" { POLYEXTERNALSYMBOL void PolyFinish(FirstArgument threadId, PolyWord arg); POLYEXTERNALSYMBOL void PolyTerminate(FirstArgument threadId, PolyWord arg); POLYEXTERNALSYMBOL POLYUNSIGNED PolyProcessEnvGeneral(FirstArgument threadId, PolyWord code, PolyWord arg); POLYEXTERNALSYMBOL POLYUNSIGNED PolyProcessEnvErrorName(FirstArgument threadId, PolyWord syserr); POLYEXTERNALSYMBOL POLYUNSIGNED PolyProcessEnvErrorMessage(FirstArgument threadId, PolyWord syserr); POLYEXTERNALSYMBOL POLYUNSIGNED PolyProcessEnvErrorFromString(FirstArgument threadId, PolyWord string); POLYEXTERNALSYMBOL POLYUNSIGNED PolyGetMaxAllocationSize(); POLYEXTERNALSYMBOL POLYUNSIGNED PolyGetMaxStringSize(); POLYEXTERNALSYMBOL POLYUNSIGNED PolyGetPolyVersionNumber(); POLYEXTERNALSYMBOL POLYUNSIGNED PolyGetFunctionName(FirstArgument threadId, PolyWord fnAddr); POLYEXTERNALSYMBOL POLYUNSIGNED PolyGetProcessName(FirstArgument threadId); POLYEXTERNALSYMBOL POLYUNSIGNED PolyGetCommandlineArguments(FirstArgument threadId); POLYEXTERNALSYMBOL POLYUNSIGNED PolyGetEnv(FirstArgument threadId, PolyWord arg); POLYEXTERNALSYMBOL POLYUNSIGNED PolyGetEnvironment(FirstArgument threadId); POLYEXTERNALSYMBOL POLYUNSIGNED PolyProcessEnvSuccessValue(FirstArgument threadId); POLYEXTERNALSYMBOL POLYUNSIGNED PolyProcessEnvFailureValue(FirstArgument threadId); POLYEXTERNALSYMBOL POLYUNSIGNED PolyProcessEnvSystem(FirstArgument threadId, PolyWord arg); } #define SAVE(x) taskData->saveVec.push(x) #define ALLOC(n) alloc_and_save(taskData, n) #if (defined(_WIN32)) #define ISPATHSEPARATOR(c) ((c) == '\\' || (c) == '/') #define DEFAULTSEPARATOR "\\" #else #define ISPATHSEPARATOR(c) ((c) == '/') #define DEFAULTSEPARATOR "/" #endif #ifdef _MSC_VER // Don't tell me about ISO C++ changes. #pragma warning(disable:4996) #endif // "environ" is declared in the headers on some systems but not all. // Oddly, declaring it within process_env_dispatch_c causes problems // on mingw where "environ" is actually a function. #if __APPLE__ // On Mac OS X there may be problems accessing environ directly. #include #define environ (*_NSGetEnviron()) #else extern char **environ; #endif #ifdef __CYGWIN__ // Cygwin requires spawnvp to avoid the significant overhead of vfork // but it doesn't seem to be thread-safe. Run it on the main thread // to be sure. class CygwinSpawnRequest: public MainThreadRequest { public: CygwinSpawnRequest(char **argv): MainThreadRequest(MTP_CYGWINSPAWN), spawnArgv(argv) {} virtual void Perform(); char **spawnArgv; int pid; }; void CygwinSpawnRequest::Perform() { pid = spawnvp(_P_NOWAIT, "/bin/sh", spawnArgv); } #endif // These are now just legacy calls. static Handle process_env_dispatch_c(TaskData *taskData, Handle args, Handle code) { unsigned c = get_C_unsigned(taskData, DEREFWORD(code)); switch (c) { case 1: /* Return the argument list. */ // This is used in the pre-built compilers. return convert_string_list(taskData, userOptions.user_arg_count, userOptions.user_arg_strings); default: { char msg[100]; sprintf(msg, "Unknown environment function: %d", c); raise_exception_string(taskData, EXC_Fail, msg); return 0; } } } // General interface to process-env. Ideally the various cases will be made into // separate functions. POLYUNSIGNED PolyProcessEnvGeneral(FirstArgument threadId, PolyWord code, PolyWord arg) { TaskData *taskData = TaskData::FindTaskForId(threadId); ASSERT(taskData != 0); taskData->PreRTSCall(); Handle reset = taskData->saveVec.mark(); Handle pushedCode = taskData->saveVec.push(code); Handle pushedArg = taskData->saveVec.push(arg); Handle result = 0; try { result = process_env_dispatch_c(taskData, pushedArg, pushedCode); } catch (KillException &) { processes->ThreadExit(taskData); // May test for kill } catch (...) { } // If an ML exception is raised taskData->saveVec.reset(reset); // Ensure the save vec is reset taskData->PostRTSCall(); if (result == 0) return TAGGED(0).AsUnsigned(); else return result->Word().AsUnsigned(); } // Terminate normally with a result code. void PolyFinish(FirstArgument threadId, PolyWord arg) { TaskData *taskData = TaskData::FindTaskForId(threadId); ASSERT(taskData != 0); taskData->PreRTSCall(); int i = get_C_int(taskData, arg); // Cause the other threads to exit and set the result code. processes->RequestProcessExit(i); // Exit this thread processes->ThreadExit(taskData); // Doesn't return. } // Terminate without running the atExit list or flushing buffers void PolyTerminate(FirstArgument threadId, PolyWord arg) { TaskData *taskData = TaskData::FindTaskForId(threadId); ASSERT(taskData != 0); taskData->PreRTSCall(); int i = get_C_int(taskData, arg); _exit(i); // Doesn't return. } // Get the name of a numeric error message. POLYUNSIGNED PolyProcessEnvErrorName(FirstArgument threadId, PolyWord syserr) { TaskData *taskData = TaskData::FindTaskForId(threadId); ASSERT(taskData != 0); taskData->PreRTSCall(); Handle reset = taskData->saveVec.mark(); Handle result = 0; try { int e = (int)syserr.AsObjPtr()->Get(0).AsSigned(); // 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) result = taskData->saveVec.push(C_string_to_Poly(taskData, errorMsg)); else { // If it isn't in the table. char buff[40]; sprintf(buff, "ERROR%0d", e); result = taskData->saveVec.push(C_string_to_Poly(taskData, buff)); } } catch (...) { } // If an ML exception is raised taskData->saveVec.reset(reset); // Ensure the save vec is reset taskData->PostRTSCall(); if (result == 0) return TAGGED(0).AsUnsigned(); else return result->Word().AsUnsigned(); } /* Get the explanatory message for an error. */ POLYUNSIGNED PolyProcessEnvErrorMessage(FirstArgument threadId, PolyWord syserr) { TaskData *taskData = TaskData::FindTaskForId(threadId); ASSERT(taskData != 0); taskData->PreRTSCall(); Handle reset = taskData->saveVec.mark(); Handle result = 0; try { result = errorMsg(taskData, (int)syserr.AsObjPtr()->Get(0).AsSigned()); } catch (...) { } // If an ML exception is raised taskData->saveVec.reset(reset); // Ensure the save vec is reset taskData->PostRTSCall(); if (result == 0) return TAGGED(0).AsUnsigned(); else return result->Word().AsUnsigned(); } // Try to convert an error string to an error number. POLYUNSIGNED PolyProcessEnvErrorFromString(FirstArgument threadId, PolyWord string) { TaskData *taskData = TaskData::FindTaskForId(threadId); ASSERT(taskData != 0); taskData->PreRTSCall(); Handle reset = taskData->saveVec.mark(); Handle result = 0; try { char buff[40]; // Get the string. Poly_string_to_C(string, buff, sizeof(buff)); // Look the string up in the table. int err = 0; if (errorCodeFromString(buff, &err)) result = Make_sysword(taskData, err); else if (strncmp(buff, "ERROR", 5) == 0) // If we don't find it then it may have been a constructed error name. result = Make_sysword(taskData, atoi(buff+5)); else result = Make_sysword(taskData, 0); // Return 0w0 if it isn't there. } catch (...) { } // If an ML exception is raised taskData->saveVec.reset(reset); // Ensure the save vec is reset taskData->PostRTSCall(); if (result == 0) return TAGGED(0).AsUnsigned(); else return result->Word().AsUnsigned(); } // Return the maximum size of a cell that can be allocated on the heap. POLYEXTERNALSYMBOL POLYUNSIGNED PolyGetMaxAllocationSize() { return TAGGED(MAX_OBJECT_SIZE).AsUnsigned(); } // Return the maximum string size (in bytes). // It is the maximum number of bytes in a segment less one word for the length field. POLYEXTERNALSYMBOL POLYUNSIGNED PolyGetMaxStringSize() { return TAGGED((MAX_OBJECT_SIZE) * sizeof(PolyWord) - sizeof(PolyWord)).AsUnsigned(); } POLYEXTERNALSYMBOL POLYUNSIGNED PolyGetPolyVersionNumber() { return TAGGED(POLY_version_number).AsUnsigned(); } // Return the function name associated with a piece of compiled code. POLYEXTERNALSYMBOL POLYUNSIGNED PolyGetFunctionName(FirstArgument threadId, PolyWord fnAddr) { TaskData *taskData = TaskData::FindTaskForId(threadId); ASSERT(taskData != 0); taskData->PreRTSCall(); Handle reset = taskData->saveVec.mark(); Handle result = 0; try { if (fnAddr.IsTagged()) raise_fail(taskData, "Not a code pointer"); PolyObject *pt = fnAddr.AsObjPtr(); // In 32-in-64 this may be a closure and the first word is the absolute address of the code. if (pt->IsClosureObject()) { // It may not be set yet. pt = *(PolyObject**)pt; if (((uintptr_t)pt & 1) == 1) raise_fail(taskData, "Not a code pointer"); } if (pt->IsCodeObject()) /* Should now be a code object. */ { /* Compiled code. This is the first constant in the constant area. */ - PolyWord *codePt = pt->ConstPtrForCode(); + PolyWord *codePt = machineDependent->ConstPtrForCode(pt); PolyWord name = codePt[0]; /* May be zero indicating an anonymous segment - return null string. */ if (name == PolyWord::FromUnsigned(0)) result = taskData->saveVec.push(C_string_to_Poly(taskData, "")); else result = taskData->saveVec.push(name); } else raise_fail(taskData, "Not a code pointer"); } catch (...) {} // If an ML exception is raised taskData->saveVec.reset(reset); // Ensure the save vec is reset taskData->PostRTSCall(); if (result == 0) return TAGGED(0).AsUnsigned(); else return result->Word().AsUnsigned(); } // Get the command line process name. POLYUNSIGNED PolyGetProcessName(FirstArgument threadId) { TaskData* taskData = TaskData::FindTaskForId(threadId); ASSERT(taskData != 0); taskData->PreRTSCall(); Handle reset = taskData->saveVec.mark(); Handle result = 0; try { result = taskData->saveVec.push(C_string_to_Poly(taskData, userOptions.programName)); } catch (...) {} // If an ML exception is raised taskData->saveVec.reset(reset); // Ensure the save vec is reset taskData->PostRTSCall(); if (result == 0) return TAGGED(0).AsUnsigned(); else return result->Word().AsUnsigned(); } // Get the command line arguments. POLYUNSIGNED PolyGetCommandlineArguments(FirstArgument threadId) { TaskData* taskData = TaskData::FindTaskForId(threadId); ASSERT(taskData != 0); taskData->PreRTSCall(); Handle reset = taskData->saveVec.mark(); Handle result = 0; try { result = convert_string_list(taskData, userOptions.user_arg_count, userOptions.user_arg_strings); } catch (KillException&) { processes->ThreadExit(taskData); // May test for kill } catch (...) {} // If an ML exception is raised taskData->saveVec.reset(reset); // Ensure the save vec is reset taskData->PostRTSCall(); if (result == 0) return TAGGED(0).AsUnsigned(); else return result->Word().AsUnsigned(); } /* Return a string from the environment. */ POLYUNSIGNED PolyGetEnv(FirstArgument threadId, PolyWord arg) { TaskData* taskData = TaskData::FindTaskForId(threadId); ASSERT(taskData != 0); taskData->PreRTSCall(); Handle reset = taskData->saveVec.mark(); Handle pushedArg = taskData->saveVec.push(arg); Handle result = 0; try { TempString buff(pushedArg->Word()); if (buff == 0) raise_syscall(taskData, "Insufficient memory", NOMEMORY); TCHAR * res = _tgetenv(buff); if (res == NULL) raise_syscall(taskData, "Not Found", 0); result = taskData->saveVec.push(C_string_to_Poly(taskData, res)); } catch (KillException&) { processes->ThreadExit(taskData); // May test for kill } catch (...) {} // If an ML exception is raised taskData->saveVec.reset(reset); // Ensure the save vec is reset taskData->PostRTSCall(); if (result == 0) return TAGGED(0).AsUnsigned(); else return result->Word().AsUnsigned(); } // Return the whole environment. Only available in Posix.ProcEnv. POLYUNSIGNED PolyGetEnvironment(FirstArgument threadId) { TaskData* taskData = TaskData::FindTaskForId(threadId); ASSERT(taskData != 0); taskData->PreRTSCall(); Handle reset = taskData->saveVec.mark(); Handle result = 0; try { /* Count the environment strings */ int env_count = 0; while (environ[env_count] != NULL) env_count++; result = convert_string_list(taskData, env_count, environ); } catch (KillException&) { processes->ThreadExit(taskData); // May test for kill } catch (...) {} // If an ML exception is raised taskData->saveVec.reset(reset); // Ensure the save vec is reset taskData->PostRTSCall(); if (result == 0) return TAGGED(0).AsUnsigned(); else return result->Word().AsUnsigned(); } /* Return the success value. */ POLYUNSIGNED PolyProcessEnvSuccessValue(FirstArgument threadId) { TaskData* taskData = TaskData::FindTaskForId(threadId); ASSERT(taskData != 0); taskData->PreRTSCall(); Handle reset = taskData->saveVec.mark(); Handle result = 0; try { result = Make_fixed_precision(taskData, EXIT_SUCCESS); } catch (KillException&) { processes->ThreadExit(taskData); // May test for kill } catch (...) {} // If an ML exception is raised taskData->saveVec.reset(reset); // Ensure the save vec is reset taskData->PostRTSCall(); if (result == 0) return TAGGED(0).AsUnsigned(); else return result->Word().AsUnsigned(); } /* Return a failure value. */ POLYUNSIGNED PolyProcessEnvFailureValue(FirstArgument threadId) { TaskData* taskData = TaskData::FindTaskForId(threadId); ASSERT(taskData != 0); taskData->PreRTSCall(); Handle reset = taskData->saveVec.mark(); Handle result = 0; try { result = Make_fixed_precision(taskData, EXIT_FAILURE); } catch (KillException&) { processes->ThreadExit(taskData); // May test for kill } catch (...) {} // If an ML exception is raised taskData->saveVec.reset(reset); // Ensure the save vec is reset taskData->PostRTSCall(); if (result == 0) return TAGGED(0).AsUnsigned(); else return result->Word().AsUnsigned(); } /* Run command. */ POLYUNSIGNED PolyProcessEnvSystem(FirstArgument threadId, PolyWord arg) { TaskData* taskData = TaskData::FindTaskForId(threadId); ASSERT(taskData != 0); taskData->PreRTSCall(); Handle reset = taskData->saveVec.mark(); Handle pushedArg = taskData->saveVec.push(arg); Handle result = 0; try { TempString buff(pushedArg->Word()); if (buff == 0) raise_syscall(taskData, "Insufficient memory", NOMEMORY); 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(taskData, "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(taskData, &request); int pid = request.pid; if (pid < 0) raise_syscall(taskData, "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(taskData, "Function system failed", errno); else if (pid == 0) { // In child sigset_t sigset; sigemptyset(&sigset); sigprocmask(SIG_SETMASK, &sigset, 0); // Reset other signals? execv("/bin/sh", argv); _exit(1); } #endif #endif while (true) { try { // Test to see if the child has returned. #if (defined(_WIN32) && ! defined(__CYGWIN__)) DWORD dwWait = WaitForSingleObject((HANDLE)pid, 0); if (dwWait == WAIT_OBJECT_0) { DWORD dwResult; BOOL fResult = GetExitCodeProcess((HANDLE)pid, &dwResult); if (!fResult) raise_syscall(taskData, "Function system failed", GetLastError()); CloseHandle((HANDLE)pid); result = Make_fixed_precision(taskData, dwResult); break; } else if (dwWait == WAIT_FAILED) raise_syscall(taskData, "Function system failed", GetLastError()); else { // Wait for the process to exit or for the timeout WaitHandle waiter((HANDLE)pid, 1000); processes->ThreadPauseForIO(taskData, &waiter); } #else int wRes = waitpid(pid, &res, WNOHANG); if (wRes > 0) break; else if (wRes < 0) { raise_syscall(taskData, "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. else processes->ThreadPause(taskData); #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; } } result = Make_fixed_precision(taskData, res); } catch (KillException&) { processes->ThreadExit(taskData); // May test for kill } catch (...) {} // If an ML exception is raised taskData->saveVec.reset(reset); // Ensure the save vec is reset taskData->PostRTSCall(); if (result == 0) return TAGGED(0).AsUnsigned(); else return result->Word().AsUnsigned(); } struct _entrypts processEnvEPT[] = { { "PolyFinish", (polyRTSFunction)&PolyFinish}, { "PolyTerminate", (polyRTSFunction)&PolyTerminate}, { "PolyProcessEnvGeneral", (polyRTSFunction)&PolyProcessEnvGeneral}, { "PolyProcessEnvErrorName", (polyRTSFunction)&PolyProcessEnvErrorName}, { "PolyProcessEnvErrorMessage", (polyRTSFunction)&PolyProcessEnvErrorMessage}, { "PolyProcessEnvErrorFromString", (polyRTSFunction)&PolyProcessEnvErrorFromString}, { "PolyGetMaxAllocationSize", (polyRTSFunction)&PolyGetMaxAllocationSize }, { "PolyGetMaxStringSize", (polyRTSFunction)&PolyGetMaxStringSize }, { "PolyGetPolyVersionNumber", (polyRTSFunction)&PolyGetPolyVersionNumber }, { "PolyGetFunctionName", (polyRTSFunction)&PolyGetFunctionName }, { "PolyGetProcessName", (polyRTSFunction)&PolyGetProcessName }, { "PolyGetCommandlineArguments", (polyRTSFunction)&PolyGetCommandlineArguments }, { "PolyGetEnv", (polyRTSFunction)& PolyGetEnv }, { "PolyGetEnvironment", (polyRTSFunction)& PolyGetEnvironment }, { "PolyProcessEnvSuccessValue", (polyRTSFunction)& PolyProcessEnvSuccessValue }, { "PolyProcessEnvFailureValue", (polyRTSFunction)& PolyProcessEnvFailureValue }, { "PolyProcessEnvSystem", (polyRTSFunction)& PolyProcessEnvSystem }, { NULL, NULL} // End of list. }; diff --git a/libpolyml/profiling.cpp b/libpolyml/profiling.cpp index 2881ae55..68425b11 100644 --- a/libpolyml/profiling.cpp +++ b/libpolyml/profiling.cpp @@ -1,621 +1,622 @@ /* Title: Profiling Author: Dave Matthews, Cambridge University Computer Laboratory Copyright (c) 2000-7 Cambridge University Technical Services Limited - Further development copyright (c) David C.J. Matthews 2011, 2015, 2020 + Further development copyright (c) David C.J. Matthews 2011, 2015, 2020-21 This library is free software; you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License version 2.1 as published by the Free Software Foundation. This library is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for more details. You should have received a copy of the GNU Lesser General Public License along with this library; if not, write to the Free Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA */ #ifdef HAVE_CONFIG_H #include "config.h" #elif defined(_WIN32) #include "winconfig.h" #else #error "No configuration file" #endif #ifdef HAVE_STDLIB_H #include #endif #ifdef HAVE_MALLOC_H #include #endif #ifdef HAVE_ASSERT_H #include #define ASSERT(x) assert(x) #else #define ASSERT(x) 0 #endif #include "globals.h" #include "arb.h" #include "processes.h" #include "polystring.h" #include "profiling.h" #include "save_vec.h" #include "rts_module.h" #include "memmgr.h" #include "scanaddrs.h" #include "locking.h" #include "run_time.h" #include "sys.h" #include "rtsentry.h" +#include "machine_dep.h" extern "C" { POLYEXTERNALSYMBOL POLYUNSIGNED PolyProfiling(FirstArgument threadId, PolyWord mode); } static long mainThreadCounts[MTP_MAXENTRY]; static const char* const mainThreadText[MTP_MAXENTRY] = { "UNKNOWN", "GARBAGE COLLECTION (sharing phase)", "GARBAGE COLLECTION (mark phase)", "GARBAGE COLLECTION (copy phase)", "GARBAGE COLLECTION (update phase)", "GARBAGE COLLECTION (minor collection)", "Common data sharing", "Exporting", "Saving state", "Loading saved state", "Profiling", "Setting signal handler", "Cygwin spawn", "Storing module", "Loading module" }; // Entries for store profiling enum _extraStore { EST_CODE = 0, EST_STRING, EST_BYTE, EST_WORD, EST_MUTABLE, EST_MUTABLEBYTE, EST_MAX_ENTRY }; static POLYUNSIGNED extraStoreCounts[EST_MAX_ENTRY]; static const char * const extraStoreText[EST_MAX_ENTRY] = { "Function code", "Strings", "Byte data (long precision ints etc)", "Unidentified word data", "Unidentified mutable data", "Mutable byte data (profiling counts)" }; // Poly strings for "standard" counts. These are generated from the C strings // above the first time profiling is activated. static PolyWord psRTSString[MTP_MAXENTRY], psExtraStrings[EST_MAX_ENTRY], psGCTotal; ProfileMode profileMode; // If we are just profiling a single thread, this is the thread data. static TaskData *singleThreadProfile = 0; // The queue is processed every 400ms and an entry can be // added every ms of CPU time by each thread. #define PCQUEUESIZE 4000 static long queuePtr = 0; static POLYCODEPTR pcQueue[PCQUEUESIZE]; // Increment, returning the original value. static int incrAtomically(long & p) { #if (defined(HAVE_SYNC_FETCH)) return __sync_fetch_and_add(&p, 1); #elif (defined(_WIN32)) long newValue = InterlockedIncrement(&p); return newValue - 1; #else return p++; #endif } // Decrement and return new value. static int decrAtomically(long & p) { #if (defined(HAVE_SYNC_FETCH)) return __sync_sub_and_fetch(&p, 1); #elif (defined(_WIN32)) return InterlockedDecrement(&p); #else return --p; #endif } typedef struct _PROFENTRY { POLYUNSIGNED count; PolyWord functionName; struct _PROFENTRY *nextEntry; } PROFENTRY, *PPROFENTRY; class ProfileRequest: public MainThreadRequest { public: ProfileRequest(unsigned prof, TaskData *pTask): MainThreadRequest(MTP_PROFILING), mode(prof), pCallingThread(pTask), pTab(0), errorMessage(0) {} ~ProfileRequest(); virtual void Perform(); Handle extractAsList(TaskData *taskData); private: void getResults(void); void getProfileResults(PolyWord *bottom, PolyWord *top); PPROFENTRY newProfileEntry(void); private: unsigned mode; TaskData *pCallingThread; PPROFENTRY pTab; public: const char *errorMessage; }; ProfileRequest::~ProfileRequest() { PPROFENTRY p = pTab; while (p != 0) { PPROFENTRY toFree = p; p = p->nextEntry; free(toFree); } } // Lock to serialise updates of counts. Only used during update. // Not required when we print the counts since there's only one thread // running then. static PLock countLock; // Get the profile object associated with a piece of code. Returns null if // there isn't one, in particular if this is in the old format. static PolyObject *getProfileObjectForCode(PolyObject *code) { ASSERT(code->IsCodeObject()); PolyWord *consts; POLYUNSIGNED constCount; - code->GetConstSegmentForCode(consts, constCount); + machineDependent->GetConstSegmentForCode(code, consts, constCount); if (constCount < 2 || consts[1].AsUnsigned() == 0 || ! consts[1].IsDataPtr()) return 0; PolyObject *profObject = consts[1].AsObjPtr(); if (profObject->IsMutable() && profObject->IsByteObject() && profObject->Length() == 1) return profObject; else return 0; } // Adds incr to the profile count for the function pointed at by // pc or by one of its callers. void addSynchronousCount(POLYCODEPTR fpc, POLYUNSIGNED incr) { // Check that the pc value is within the heap. It could be // in the assembly code. PolyObject *codeObj = gMem.FindCodeObject(fpc); if (codeObj) { PolyObject *profObject = getProfileObjectForCode(codeObj); PLocker locker(&countLock); if (profObject) profObject->Set(0, PolyWord::FromUnsigned(profObject->Get(0).AsUnsigned() + incr)); return; } // Didn't find it. { PLocker locker(&countLock); incrAtomically(mainThreadCounts[MTP_USER_CODE]); } } // newProfileEntry - Make a new entry in the list PPROFENTRY ProfileRequest::newProfileEntry(void) { PPROFENTRY newEntry = (PPROFENTRY)malloc(sizeof(PROFENTRY)); if (newEntry == 0) { errorMessage = "Insufficient memory"; return 0; } newEntry->nextEntry = pTab; pTab = newEntry; return newEntry; } // We don't use ScanAddress here because we're only interested in the // objects themselves not the addresses in them. // We have to build the list of results in C memory rather than directly in // ML memory because we can't allocate in ML memory in the root thread. void ProfileRequest::getProfileResults(PolyWord *bottom, PolyWord *top) { PolyWord *ptr = bottom; while (ptr < top) { ptr++; // Skip the length word PolyObject *obj = (PolyObject*)ptr; if (obj->ContainsForwardingPtr()) { // This used to be necessary when code objects were held in the // general heap. Now that we only ever scan code and permanent // areas it's probably not needed. while (obj->ContainsForwardingPtr()) obj = obj->GetForwardingPtr(); ASSERT(obj->ContainsNormalLengthWord()); ptr += obj->Length(); } else { ASSERT(obj->ContainsNormalLengthWord()); if (obj->IsCodeObject()) { - PolyWord *firstConstant = obj->ConstPtrForCode(); + PolyWord *firstConstant = machineDependent->ConstPtrForCode(obj); PolyWord name = firstConstant[0]; PolyObject *profCount = getProfileObjectForCode(obj); if (profCount) { POLYUNSIGNED count = profCount->Get(0).AsUnsigned(); if (count != 0) { if (name != TAGGED(0)) { PPROFENTRY pEnt = newProfileEntry(); if (pEnt == 0) return; pEnt->count = count; pEnt->functionName = name; } profCount->Set(0, PolyWord::FromUnsigned(0)); } } } /* code object */ ptr += obj->Length(); } /* else */ } /* while */ } void ProfileRequest::getResults(void) // Print profiling information and reset profile counts. { for (std::vector::iterator i = gMem.pSpaces.begin(); i < gMem.pSpaces.end(); i++) { MemSpace *space = *i; // Permanent areas are filled with objects from the bottom. getProfileResults(space->bottom, space->top); // Bottom to top } for (std::vector::iterator i = gMem.cSpaces.begin(); i < gMem.cSpaces.end(); i++) { CodeSpace *space = *i; getProfileResults(space->bottom, space->top); } { POLYUNSIGNED gc_count = mainThreadCounts[MTP_GCPHASESHARING]+ mainThreadCounts[MTP_GCPHASEMARK]+ mainThreadCounts[MTP_GCPHASECOMPACT] + mainThreadCounts[MTP_GCPHASEUPDATE] + mainThreadCounts[MTP_GCQUICK]; if (gc_count) { PPROFENTRY pEnt = newProfileEntry(); if (pEnt == 0) return; // Report insufficient memory? pEnt->count = gc_count; pEnt->functionName = psGCTotal; } } for (unsigned k = 0; k < MTP_MAXENTRY; k++) { if (mainThreadCounts[k]) { PPROFENTRY pEnt = newProfileEntry(); if (pEnt == 0) return; // Report insufficient memory? pEnt->count = mainThreadCounts[k]; pEnt->functionName = psRTSString[k]; mainThreadCounts[k] = 0; } } for (unsigned l = 0; l < EST_MAX_ENTRY; l++) { if (extraStoreCounts[l]) { PPROFENTRY pEnt = newProfileEntry(); if (pEnt == 0) return; // Report insufficient memory? pEnt->count = extraStoreCounts[l]; pEnt->functionName = psExtraStrings[l]; extraStoreCounts[l] = 0; } } } // Extract the accumulated results as an ML list of pairs of the count and the string. Handle ProfileRequest::extractAsList(TaskData *taskData) { Handle saved = taskData->saveVec.mark(); Handle list = taskData->saveVec.push(ListNull); for (PPROFENTRY p = pTab; p != 0; p = p->nextEntry) { Handle pair = alloc_and_save(taskData, 2); Handle countValue = Make_arbitrary_precision(taskData, p->count); pair->WordP()->Set(0, countValue->Word()); pair->WordP()->Set(1, p->functionName); Handle next = alloc_and_save(taskData, sizeof(ML_Cons_Cell) / sizeof(PolyWord)); DEREFLISTHANDLE(next)->h = pair->Word(); DEREFLISTHANDLE(next)->t =list->Word(); taskData->saveVec.reset(saved); list = taskData->saveVec.push(next->Word()); } return list; } // We have had an asynchronous interrupt and found a potential PC but // we're in a signal handler. void incrementCountAsynch(POLYCODEPTR pc) { int q = incrAtomically(queuePtr); if (q < PCQUEUESIZE) pcQueue[q] = pc; } // Called by the main thread to process the queue of PC values void processProfileQueue() { if (queuePtr == 0) return; while (1) { int q = queuePtr; if (q >= PCQUEUESIZE) incrAtomically(mainThreadCounts[MTP_USER_CODE]); else addSynchronousCount(pcQueue[q], 1); if (decrAtomically(queuePtr) == 0) break; } } // Handle a SIGVTALRM or the simulated equivalent in Windows. This may be called // at any time so we have to be careful. In particular in Linux this may be // executed by a thread while holding a mutex so we must not do anything, such // calling malloc, that could require locking. void handleProfileTrap(TaskData *taskData, SIGNALCONTEXT *context) { if (singleThreadProfile != 0 && singleThreadProfile != taskData) return; /* If we are in the garbage-collector add the count to "gc_count" otherwise try to find out where we are. */ if (mainThreadPhase == MTP_USER_CODE) { if (taskData == 0 || ! taskData->AddTimeProfileCount(context)) incrAtomically(mainThreadCounts[MTP_USER_CODE]); // On Mac OS X all virtual timer interrupts seem to be directed to the root thread // so all the counts will be "unknown". } else incrAtomically(mainThreadCounts[mainThreadPhase]); } // Called from the GC when allocation profiling is on. void AddObjectProfile(PolyObject *obj) { ASSERT(obj->ContainsNormalLengthWord()); POLYUNSIGNED length = obj->Length(); if (obj->IsWordObject() && OBJ_HAS_PROFILE(obj->LengthWord())) { // It has a profile pointer. The last word should point to the // closure or code of the allocating function. Add the size of this to the count. ASSERT(length != 0); PolyWord profWord = obj->Get(length-1); ASSERT(profWord.IsDataPtr()); PolyObject *profObject = profWord.AsObjPtr(); ASSERT(profObject->IsMutable() && profObject->IsByteObject() && profObject->Length() == 1); profObject->Set(0, PolyWord::FromUnsigned(profObject->Get(0).AsUnsigned() + length + 1)); } // If it doesn't have a profile pointer add it to the appropriate count. else if (obj->IsMutable()) { if (obj->IsByteObject()) extraStoreCounts[EST_MUTABLEBYTE] += length+1; else extraStoreCounts[EST_MUTABLE] += length+1; } else if (obj->IsCodeObject()) extraStoreCounts[EST_CODE] += length+1; else if (obj->IsClosureObject()) { ASSERT(0); } else if (obj->IsByteObject()) { // Try to separate strings from other byte data. This is only // approximate. if (OBJ_IS_NEGATIVE(obj->LengthWord())) extraStoreCounts[EST_BYTE] += length+1; else { PolyStringObject *possString = (PolyStringObject*)obj; POLYUNSIGNED bytes = length * sizeof(PolyWord); // If the length of the string as given in the first word is sufficient // to fit in the exact number of words then it's probably a string. if (length >= 2 && possString->length <= bytes - sizeof(POLYUNSIGNED) && possString->length > bytes - 2 * sizeof(POLYUNSIGNED)) extraStoreCounts[EST_STRING] += length+1; else { extraStoreCounts[EST_BYTE] += length+1; } } } else extraStoreCounts[EST_WORD] += length+1; } // Called from ML to control profiling. static Handle profilerc(TaskData *taskData, Handle mode_handle) /* Profiler - generates statistical profiles of the code. The parameter is an integer which determines the value to be profiled. When profiler is called it always resets the profiling and prints out any values which have been accumulated. If the parameter is 0 this is all it does, if the parameter is 1 then it produces time profiling, if the parameter is 2 it produces store profiling. 3 - arbitrary precision emulation traps. */ { unsigned mode = get_C_unsigned(taskData, mode_handle->Word()); { // Create any strings we need. We only need to do this once but // it must be done by a non-root thread since it needs a taskData object. // Don't bother locking. At worst we'll create some garbage. for (unsigned k = 0; k < MTP_MAXENTRY; k++) { if (psRTSString[k] == TAGGED(0)) psRTSString[k] = C_string_to_Poly(taskData, mainThreadText[k]); } for (unsigned k = 0; k < EST_MAX_ENTRY; k++) { if (psExtraStrings[k] == TAGGED(0)) psExtraStrings[k] = C_string_to_Poly(taskData, extraStoreText[k]); } if (psGCTotal == TAGGED(0)) psGCTotal = C_string_to_Poly(taskData, "GARBAGE COLLECTION (total)"); } // All these actions are performed by the root thread. Only profile // printing needs to be performed with all the threads stopped but it's // simpler to serialise all requests. ProfileRequest request(mode, taskData); processes->MakeRootRequest(taskData, &request); if (request.errorMessage != 0) raise_exception_string(taskData, EXC_Fail, request.errorMessage); return request.extractAsList(taskData); } POLYUNSIGNED PolyProfiling(FirstArgument threadId, PolyWord mode) { TaskData *taskData = TaskData::FindTaskForId(threadId); ASSERT(taskData != 0); taskData->PreRTSCall(); Handle reset = taskData->saveVec.mark(); Handle pushedMode = taskData->saveVec.push(mode); Handle result = 0; try { result = profilerc(taskData, pushedMode); } catch (...) { } // If an ML exception is raised taskData->saveVec.reset(reset); taskData->PostRTSCall(); if (result == 0) return TAGGED(0).AsUnsigned(); else return result->Word().AsUnsigned(); } // This is called from the root thread when all the ML threads have been paused. void ProfileRequest::Perform() { if (mode != kProfileOff && profileMode != kProfileOff) { // Profiling must be stopped first. errorMessage = "Profiling is currently active"; return; } singleThreadProfile = 0; // Unless kProfileTimeThread is given this should be 0 switch (mode) { case kProfileOff: // Turn off old profiling mechanism and print out accumulated results profileMode = kProfileOff; processes->StopProfiling(); getResults(); // Remove all the bitmaps to free up memory gMem.RemoveProfilingBitmaps(); break; case kProfileTimeThread: singleThreadProfile = pCallingThread; // And drop through to kProfileTime case kProfileTime: profileMode = kProfileTime; processes->StartProfiling(); break; case kProfileStoreAllocation: profileMode = kProfileStoreAllocation; break; case kProfileEmulation: profileMode = kProfileEmulation; break; case kProfileLiveData: profileMode = kProfileLiveData; break; case kProfileLiveMutables: profileMode = kProfileLiveMutables; break; case kProfileMutexContention: profileMode = kProfileMutexContention; break; default: /* do nothing */ break; } } struct _entrypts profilingEPT[] = { // Profiling { "PolyProfiling", (polyRTSFunction)&PolyProfiling}, { NULL, NULL} // End of list. }; class Profiling: public RtsModule { public: virtual void Init(void); virtual void GarbageCollect(ScanAddress *process); }; // Declare this. It will be automatically added to the table. static Profiling profileModule; void Profiling::Init(void) { // Reset profiling counts. profileMode = kProfileOff; for (unsigned k = 0; k < MTP_MAXENTRY; k++) mainThreadCounts[k] = 0; } void Profiling::GarbageCollect(ScanAddress *process) { // Process any strings in the table. for (unsigned k = 0; k < MTP_MAXENTRY; k++) process->ScanRuntimeWord(&psRTSString[k]); for (unsigned k = 0; k < EST_MAX_ENTRY; k++) process->ScanRuntimeWord(&psExtraStrings[k]); process->ScanRuntimeWord(&psGCTotal); } diff --git a/libpolyml/savestate.cpp b/libpolyml/savestate.cpp index 163ecb26..d2da7878 100644 --- a/libpolyml/savestate.cpp +++ b/libpolyml/savestate.cpp @@ -1,2234 +1,2234 @@ /* Title: savestate.cpp - Save and Load state - Copyright (c) 2007, 2015, 2017-19 David C.J. Matthews + Copyright (c) 2007, 2015, 2017-19, 2021 David C.J. Matthews This library is free software; you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License version 2.1 as published by the Free Software Foundation. This library is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for more details. You should have received a copy of the GNU Lesser General Public License along with this library; if not, write to the Free Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA */ #ifdef HAVE_CONFIG_H #include "config.h" #elif defined(_WIN32) #include "winconfig.h" #else #error "No configuration file" #endif #ifdef HAVE_STDIO_H #include #endif #ifdef HAVE_WINDOWS_H #include // For MAX_PATH #endif #ifdef HAVE_SYS_PARAM_H #include // For MAX_PATH #endif #ifdef HAVE_ERRNO_H #include #endif #ifdef HAVE_TIME_H #include #endif #ifdef HAVE_SYS_TYPES_H #include #endif #ifdef HAVE_SYS_STAT_H #include #endif #ifdef HAVE_UNISTD_H #include #endif #ifdef HAVE_STRING_H #include #endif #ifdef HAVE_ASSERT_H #include #define ASSERT(x) assert(x) #else #define ASSERT(x) #endif #if (defined(_WIN32)) #include #define ERRORNUMBER _doserrno #define NOMEMORY ERROR_NOT_ENOUGH_MEMORY #else typedef char TCHAR; #define _T(x) x #define _tfopen fopen #define _tcscpy strcpy #define _tcsdup strdup #define _tcslen strlen #define _fputtc fputc #define _fputts fputs #ifndef lstrcmpi #define lstrcmpi strcasecmp #endif #define ERRORNUMBER errno #define NOMEMORY ENOMEM #endif #include "globals.h" #include "savestate.h" #include "processes.h" #include "run_time.h" #include "polystring.h" #include "scanaddrs.h" #include "arb.h" #include "memmgr.h" #include "mpoly.h" // For exportTimeStamp #include "exporter.h" // For CopyScan #include "machine_dep.h" #include "osmem.h" #include "gc.h" // For FullGC. #include "timing.h" #include "rtsentry.h" #include "check_objects.h" #include "rtsentry.h" #include "../polyexports.h" // For InitHeaderFromExport #include "version.h" // For InitHeaderFromExport #ifdef _MSC_VER // Don't tell me about ISO C++ changes. #pragma warning(disable:4996) #endif extern "C" { POLYEXTERNALSYMBOL POLYUNSIGNED PolySaveState(FirstArgument threadId, PolyWord fileName, PolyWord depth); POLYEXTERNALSYMBOL POLYUNSIGNED PolyLoadState(FirstArgument threadId, PolyWord arg); POLYEXTERNALSYMBOL POLYUNSIGNED PolyShowHierarchy(FirstArgument threadId); POLYEXTERNALSYMBOL POLYUNSIGNED PolyRenameParent(FirstArgument threadId, PolyWord childName, PolyWord parentName); POLYEXTERNALSYMBOL POLYUNSIGNED PolyShowParent(FirstArgument threadId, PolyWord arg); POLYEXTERNALSYMBOL POLYUNSIGNED PolyStoreModule(FirstArgument threadId, PolyWord name, PolyWord contents); POLYEXTERNALSYMBOL POLYUNSIGNED PolyLoadModule(FirstArgument threadId, PolyWord arg); POLYEXTERNALSYMBOL POLYUNSIGNED PolyLoadHierarchy(FirstArgument threadId, PolyWord arg); POLYEXTERNALSYMBOL POLYUNSIGNED PolyGetModuleDirectory(FirstArgument threadId); } // Helper class to close files on exit. class AutoClose { public: AutoClose(FILE *f = 0): m_file(f) {} ~AutoClose() { if (m_file) ::fclose(m_file); } operator FILE*() { return m_file; } FILE* operator = (FILE* p) { return (m_file = p); } private: FILE *m_file; }; // This is probably generally useful so may be moved into // a general header file. template class AutoFree { public: AutoFree(BASE p = 0): m_value(p) {} ~AutoFree() { free(m_value); } // Automatic conversions to the base type. operator BASE() { return m_value; } BASE operator = (BASE p) { return (m_value = p); } private: BASE m_value; }; #ifdef HAVE__FTELLI64 // fseek and ftell are only 32-bits in Windows. #define off_t __int64 #define fseek _fseeki64 #define ftell _ftelli64 #endif /* * Structure definitions for the saved state files. */ #define SAVEDSTATESIGNATURE "POLYSAVE" #define SAVEDSTATEVERSION 2 // File header for a saved state file. This appears as the first entry // in the file. typedef struct _savedStateHeader { // These entries are primarily to check that we have a valid // saved state file before we try to interpret anything else. char headerSignature[8]; // Should contain SAVEDSTATESIGNATURE unsigned headerVersion; // Should contain SAVEDSTATEVERSION unsigned headerLength; // Number of bytes in the header unsigned segmentDescrLength; // Number of bytes in a descriptor // These entries contain the real data. off_t segmentDescr; // Position of segment descriptor table unsigned segmentDescrCount; // Number of segment descriptors in the table off_t stringTable; // Pointer to the string table (zero if none) size_t stringTableSize; // Size of string table unsigned parentNameEntry; // Position of parent name in string table (0 if top) time_t timeStamp; // The time stamp for this file. time_t parentTimeStamp; // The time stamp for the parent. void *originalBaseAddr; // Original base address (32-in-64 only) } SavedStateHeader; // Entry for segment table. This describes the segments on the disc that // need to be loaded into memory. typedef struct _savedStateSegmentDescr { off_t segmentData; // Position of the segment data size_t segmentSize; // Size of the segment data off_t relocations; // Position of the relocation table unsigned relocationCount; // Number of entries in relocation table unsigned relocationSize; // Size of a relocation entry unsigned segmentFlags; // Segment flags (see SSF_ values) unsigned segmentIndex; // The index of this segment or the segment it overwrites void *originalAddress; // The base address when the segment was written. } SavedStateSegmentDescr; #define SSF_WRITABLE 1 // The segment contains mutable data #define SSF_OVERWRITE 2 // The segment overwrites the data (mutable) in a parent. #define SSF_NOOVERWRITE 4 // The segment must not be further overwritten #define SSF_BYTES 8 // The segment contains only byte data #define SSF_CODE 16 // The segment contains only code typedef struct _relocationEntry { // Each entry indicates a location that has to be set to an address. // The location to be set is determined by adding "relocAddress" to the base address of // this segment (the one to which these relocations apply) and the value to store // by adding "targetAddress" to the base address of the segment indicated by "targetSegment". POLYUNSIGNED relocAddress; // The (byte) offset in this segment that we will set POLYUNSIGNED targetAddress; // The value to add to the base of the destination segment unsigned targetSegment; // The base segment. 0 is IO segment. ScanRelocationKind relKind; // The kind of relocation (processor dependent). } RelocationEntry; #define SAVE(x) taskData->saveVec.push(x) /* * Hierarchy table: contains information about last loaded or saved state. */ // Pointer to list of files loaded in last load. // There's no need for a lock since the update is only made when all // the ML threads have stopped. class HierarchyTable { public: HierarchyTable(const TCHAR *file, time_t time): fileName(_tcsdup(file)), timeStamp(time) { } AutoFree fileName; time_t timeStamp; }; HierarchyTable **hierarchyTable; static unsigned hierarchyDepth; static bool AddHierarchyEntry(const TCHAR *fileName, time_t timeStamp) { // Add an entry to the hierarchy table for this file. HierarchyTable *newEntry = new HierarchyTable(fileName, timeStamp); if (newEntry == 0) return false; HierarchyTable **newTable = (HierarchyTable **)realloc(hierarchyTable, sizeof(HierarchyTable *)*(hierarchyDepth+1)); if (newTable == 0) return false; hierarchyTable = newTable; hierarchyTable[hierarchyDepth++] = newEntry; return true; } // Test whether we're overwriting a parent of ourself. #if (defined(_WIN32) || defined(__CYGWIN__)) static bool sameFile(const TCHAR *x, const TCHAR *y) { HANDLE hXFile = INVALID_HANDLE_VALUE, hYFile = INVALID_HANDLE_VALUE; bool result = false; hXFile = CreateFile(x, GENERIC_READ, FILE_SHARE_READ, NULL, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, NULL); if (hXFile == INVALID_HANDLE_VALUE) goto closeAndExit; hYFile = CreateFile(y, GENERIC_READ, FILE_SHARE_READ, NULL, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, NULL); if (hYFile == INVALID_HANDLE_VALUE) goto closeAndExit; BY_HANDLE_FILE_INFORMATION fileInfoX, fileInfoY; if (! GetFileInformationByHandle(hXFile, &fileInfoX)) goto closeAndExit; if (! GetFileInformationByHandle(hYFile, &fileInfoY)) goto closeAndExit; result = fileInfoX.dwVolumeSerialNumber == fileInfoY.dwVolumeSerialNumber && fileInfoX.nFileIndexLow == fileInfoY.nFileIndexLow && fileInfoX.nFileIndexHigh == fileInfoY.nFileIndexHigh; closeAndExit: if (hXFile != INVALID_HANDLE_VALUE) CloseHandle(hXFile); if (hYFile != INVALID_HANDLE_VALUE) CloseHandle(hYFile); return result; } #else static bool sameFile(const char *x, const char *y) { struct stat xStat, yStat; // If either file does not exist that's fine. if (stat(x, &xStat) != 0 || stat(y, &yStat) != 0) return false; return (xStat.st_dev == yStat.st_dev && xStat.st_ino == yStat.st_ino); } #endif /* * Saving state. */ // This class is used to create the relocations. It uses Exporter // for this but this may perhaps be too heavyweight. class SaveStateExport: public Exporter, public ScanAddress { public: SaveStateExport(unsigned int h=0): Exporter(h), relocationCount(0) {} public: virtual void exportStore(void) {} // Not used. private: // ScanAddress overrides virtual void ScanConstant(PolyObject *base, byte *addrOfConst, ScanRelocationKind code, intptr_t displacement); // At the moment we should only get calls to ScanConstant. virtual PolyObject *ScanObjectAddress(PolyObject *base) { return base; } protected: void setRelocationAddress(void *p, POLYUNSIGNED *reloc); PolyWord createRelocation(PolyWord p, void *relocAddr); unsigned relocationCount; friend class SaveRequest; }; // Generate the address relative to the start of the segment. void SaveStateExport::setRelocationAddress(void *p, POLYUNSIGNED *reloc) { unsigned area = findArea(p); POLYUNSIGNED offset = (POLYUNSIGNED)((char*)p - (char*)memTable[area].mtOriginalAddr); *reloc = offset; } // Create a relocation entry for an address at a given location. PolyWord SaveStateExport::createRelocation(PolyWord p, void *relocAddr) { RelocationEntry reloc; // Set the offset within the section we're scanning. setRelocationAddress(relocAddr, &reloc.relocAddress); void *addr = p.AsAddress(); unsigned addrArea = findArea(addr); reloc.targetAddress = (POLYUNSIGNED)((char*)addr - (char*)memTable[addrArea].mtOriginalAddr); reloc.targetSegment = (unsigned)memTable[addrArea].mtIndex; reloc.relKind = PROCESS_RELOC_DIRECT; fwrite(&reloc, sizeof(reloc), 1, exportFile); relocationCount++; return p; // Don't change the contents } /* This is called for each constant within the code. Print a relocation entry for the word and return a value that means that the offset is saved in original word. */ void SaveStateExport::ScanConstant(PolyObject *base, byte *addr, ScanRelocationKind code, intptr_t displacement) { PolyObject *p = GetConstantValue(addr, code, displacement); if (p == 0) return; void *a = p; unsigned aArea = findArea(a); // We don't need a relocation if this is relative to the current segment // since the relative address will already be right. if (code == PROCESS_RELOC_I386RELATIVE && aArea == findArea(addr)) return; // Set the value at the address to the offset relative to the symbol. RelocationEntry reloc; setRelocationAddress(addr, &reloc.relocAddress); reloc.targetAddress = (POLYUNSIGNED)((char*)a - (char*)memTable[aArea].mtOriginalAddr); reloc.targetSegment = (unsigned)memTable[aArea].mtIndex; reloc.relKind = code; fwrite(&reloc, sizeof(reloc), 1, exportFile); relocationCount++; } // Request to the main thread to save data. class SaveRequest: public MainThreadRequest { public: SaveRequest(const TCHAR *name, unsigned h): MainThreadRequest(MTP_SAVESTATE), fileName(name), newHierarchy(h), errorMessage(0), errCode(0) {} virtual void Perform(); const TCHAR *fileName; unsigned newHierarchy; const char *errorMessage; int errCode; }; // This class is used to update references to objects that have moved. If // we have copied an object into the area to be exported we may still have references // to it from the stack or from RTS data structures. We have to ensure that these // are updated. // This is very similar to ProcessFixupAddress in sharedata.cpp class SaveFixupAddress: public ScanAddress { protected: virtual POLYUNSIGNED ScanAddressAt(PolyWord *pt); virtual POLYUNSIGNED ScanCodeAddressAt(PolyObject **pt) { *pt = ScanObjectAddress(*pt); return 0; } virtual PolyObject *ScanObjectAddress(PolyObject *base); public: void ScanCodeSpace(CodeSpace *space); }; POLYUNSIGNED SaveFixupAddress::ScanAddressAt(PolyWord *pt) { PolyWord val = *pt; if (val.IsDataPtr() && val != PolyWord::FromUnsigned(0)) *pt = ScanObjectAddress(val.AsObjPtr()); return 0; } // Returns the new address if the argument is the address of an object that // has moved, otherwise returns the original. PolyObject *SaveFixupAddress::ScanObjectAddress(PolyObject *obj) { if (obj->ContainsForwardingPtr()) // tombstone is a pointer to a moved object { #ifdef POLYML32IN64 MemSpace *space = gMem.SpaceForAddress((PolyWord*)obj - 1); PolyObject *newp; if (space->isCode) newp = (PolyObject*)(globalCodeBase + ((obj->LengthWord() & ~_OBJ_TOMBSTONE_BIT) << 1)); else newp = obj->GetForwardingPtr(); #else PolyObject *newp = obj->GetForwardingPtr(); #endif ASSERT (newp->ContainsNormalLengthWord()); return newp; } ASSERT (obj->ContainsNormalLengthWord()); // object is not moved return obj; } // Fix up addresses in the code area. Unlike ScanAddressesInRegion this updates // cells that have been moved. We need to do that because we may still have // return addresses into those cells and we don't move return addresses. We // do want the code to see updated constant addresses. void SaveFixupAddress::ScanCodeSpace(CodeSpace *space) { for (PolyWord *pt = space->bottom; pt < space->top; ) { pt++; PolyObject *obj = (PolyObject*)pt; #ifdef POLYML32IN64 PolyObject *dest = obj; while (dest->ContainsForwardingPtr()) { MemSpace *space = gMem.SpaceForObjectAddress(dest); if (space->isCode) dest = (PolyObject*)(globalCodeBase + ((dest->LengthWord() & ~_OBJ_TOMBSTONE_BIT) << 1)); else dest = dest->GetForwardingPtr(); } #else PolyObject *dest = obj->FollowForwardingChain(); #endif POLYUNSIGNED length = dest->Length(); if (length != 0) ScanAddressesInObject(obj, dest->LengthWord()); pt += length; } } // Called by the root thread to actually save the state and write the file. void SaveRequest::Perform() { if (debugOptions & DEBUG_SAVING) Log("SAVE: Beginning saving state.\n"); // Check that we aren't overwriting our own parent. for (unsigned q = 0; q < newHierarchy-1; q++) { if (sameFile(hierarchyTable[q]->fileName, fileName)) { errorMessage = "File being saved is used as a parent of this file"; errCode = 0; if (debugOptions & DEBUG_SAVING) Log("SAVE: File being saved is used as a parent of this file.\n"); return; } } SaveStateExport exports; // Open the file. This could quite reasonably fail if the path is wrong. exports.exportFile = _tfopen(fileName, _T("wb")); if (exports.exportFile == NULL) { errorMessage = "Cannot open save file"; errCode = ERRORNUMBER; if (debugOptions & DEBUG_SAVING) Log("SAVE: Cannot open save file.\n"); return; } // Scan over the permanent mutable area copying all reachable data that is // not in a lower hierarchy into new permanent segments. CopyScan copyScan(newHierarchy); copyScan.initialise(false); bool success = true; try { for (std::vector::iterator i = gMem.pSpaces.begin(); i < gMem.pSpaces.end(); i++) { PermanentMemSpace *space = *i; if (space->isMutable && !space->noOverwrite && !space->byteOnly) { if (debugOptions & DEBUG_SAVING) Log("SAVE: Scanning permanent mutable area %p allocated at %p size %lu\n", space, space->bottom, space->spaceSize()); copyScan.ScanAddressesInRegion(space->bottom, space->top); } } } catch (MemoryException &) { success = false; if (debugOptions & DEBUG_SAVING) Log("SAVE: Scan of permanent mutable area raised memory exception.\n"); } // Copy the areas into the export object. Make sufficient space for // the largest possible number of entries. exports.memTable = new memoryTableEntry[gMem.eSpaces.size()+gMem.pSpaces.size()+1]; unsigned memTableCount = 0; // Permanent spaces at higher level. These have to have entries although // only the mutable entries will be written. for (std::vector::iterator i = gMem.pSpaces.begin(); i < gMem.pSpaces.end(); i++) { PermanentMemSpace *space = *i; if (space->hierarchy < newHierarchy) { memoryTableEntry *entry = &exports.memTable[memTableCount++]; entry->mtOriginalAddr = entry->mtCurrentAddr = space->bottom; entry->mtLength = (space->topPointer-space->bottom)*sizeof(PolyWord); entry->mtIndex = space->index; entry->mtFlags = 0; if (space->isMutable) { entry->mtFlags |= MTF_WRITEABLE; if (space->noOverwrite) entry->mtFlags |= MTF_NO_OVERWRITE; if (space->byteOnly) entry->mtFlags |= MTF_BYTES; } if (space->isCode) entry->mtFlags |= MTF_EXECUTABLE; } } unsigned permanentEntries = memTableCount; // Remember where new entries start. // Newly created spaces. for (std::vector::iterator i = gMem.eSpaces.begin(); i < gMem.eSpaces.end(); i++) { memoryTableEntry *entry = &exports.memTable[memTableCount++]; PermanentMemSpace *space = *i; entry->mtOriginalAddr = entry->mtCurrentAddr = space->bottom; entry->mtLength = (space->topPointer-space->bottom)*sizeof(PolyWord); entry->mtIndex = space->index; entry->mtFlags = 0; if (space->isMutable) { entry->mtFlags |= MTF_WRITEABLE; if (space->noOverwrite) entry->mtFlags |= MTF_NO_OVERWRITE; if (space->byteOnly) entry->mtFlags |= MTF_BYTES; } if (space->isCode) entry->mtFlags |= MTF_EXECUTABLE; } exports.memTableEntries = memTableCount; if (debugOptions & DEBUG_SAVING) Log("SAVE: Updating references to moved objects.\n"); // Update references to moved objects. SaveFixupAddress fixup; for (std::vector::iterator i = gMem.lSpaces.begin(); i < gMem.lSpaces.end(); i++) { LocalMemSpace *space = *i; fixup.ScanAddressesInRegion(space->bottom, space->lowerAllocPtr); fixup.ScanAddressesInRegion(space->upperAllocPtr, space->top); } for (std::vector::iterator i = gMem.cSpaces.begin(); i < gMem.cSpaces.end(); i++) fixup.ScanCodeSpace(*i); GCModules(&fixup); // Restore the length words in the code areas. // Although we've updated any pointers to the start of the code we could have return addresses // pointing to the original code. GCModules updates the stack but doesn't update return addresses. for (std::vector::iterator i = gMem.cSpaces.begin(); i < gMem.cSpaces.end(); i++) { CodeSpace *space = *i; for (PolyWord *pt = space->bottom; pt < space->top; ) { pt++; PolyObject *obj = (PolyObject*)pt; if (obj->ContainsForwardingPtr()) { #ifdef POLYML32IN64 PolyObject *forwardedTo = obj; while (forwardedTo->ContainsForwardingPtr()) forwardedTo = (PolyObject*)(globalCodeBase + ((forwardedTo->LengthWord() & ~_OBJ_TOMBSTONE_BIT) << 1)); #else PolyObject *forwardedTo = obj->FollowForwardingChain(); #endif POLYUNSIGNED lengthWord = forwardedTo->LengthWord(); space->writeAble(obj)->SetLengthWord(lengthWord); } pt += obj->Length(); } } // Update the global memory space table. Old segments at the same level // or lower are removed. The new segments become permanent. // Try to promote the spaces even if we've had a failure because export // spaces are deleted in ~CopyScan and we may have already copied // some objects there. if (debugOptions & DEBUG_SAVING) Log("SAVE: Promoting export spaces to permanent spaces.\n"); if (! gMem.PromoteExportSpaces(newHierarchy) || ! success) { errorMessage = "Out of Memory"; errCode = NOMEMORY; if (debugOptions & DEBUG_SAVING) Log("SAVE: Unable to promote export spaces.\n"); return; } // Remove any deeper entries from the hierarchy table. while (hierarchyDepth > newHierarchy-1) { hierarchyDepth--; delete(hierarchyTable[hierarchyDepth]); hierarchyTable[hierarchyDepth] = 0; } if (debugOptions & DEBUG_SAVING) Log("SAVE: Writing out data.\n"); // Write out the file header. SavedStateHeader saveHeader; memset(&saveHeader, 0, sizeof(saveHeader)); saveHeader.headerLength = sizeof(saveHeader); memcpy(saveHeader.headerSignature, SAVEDSTATESIGNATURE, sizeof(saveHeader.headerSignature)); saveHeader.headerVersion = SAVEDSTATEVERSION; saveHeader.segmentDescrLength = sizeof(SavedStateSegmentDescr); if (newHierarchy == 1) saveHeader.parentTimeStamp = exportTimeStamp; else { saveHeader.parentTimeStamp = hierarchyTable[newHierarchy-2]->timeStamp; saveHeader.parentNameEntry = sizeof(TCHAR); // Always the first entry. } saveHeader.timeStamp = getBuildTime(); saveHeader.segmentDescrCount = exports.memTableEntries; // One segment for each space. #ifdef POLYML32IN64 saveHeader.originalBaseAddr = globalHeapBase; #endif // Write out the header. fwrite(&saveHeader, sizeof(saveHeader), 1, exports.exportFile); // We need a segment header for each permanent area whether it is // actually in this file or not. SavedStateSegmentDescr *descrs = new SavedStateSegmentDescr [exports.memTableEntries]; for (unsigned j = 0; j < exports.memTableEntries; j++) { memoryTableEntry *entry = &exports.memTable[j]; memset(&descrs[j], 0, sizeof(SavedStateSegmentDescr)); descrs[j].relocationSize = sizeof(RelocationEntry); descrs[j].segmentIndex = (unsigned)entry->mtIndex; descrs[j].segmentSize = entry->mtLength; // Set this even if we don't write it. descrs[j].originalAddress = entry->mtOriginalAddr; if (entry->mtFlags & MTF_WRITEABLE) { descrs[j].segmentFlags |= SSF_WRITABLE; if (entry->mtFlags & MTF_NO_OVERWRITE) descrs[j].segmentFlags |= SSF_NOOVERWRITE; if (j < permanentEntries && (entry->mtFlags & MTF_NO_OVERWRITE) == 0) descrs[j].segmentFlags |= SSF_OVERWRITE; if (entry->mtFlags & MTF_BYTES) descrs[j].segmentFlags |= SSF_BYTES; } if (entry->mtFlags & MTF_EXECUTABLE) descrs[j].segmentFlags |= SSF_CODE; } // Write out temporarily. Will be overwritten at the end. saveHeader.segmentDescr = ftell(exports.exportFile); fwrite(descrs, sizeof(SavedStateSegmentDescr), exports.memTableEntries, exports.exportFile); // Write out the relocations and the data. for (unsigned k = 1 /* Not IO area */; k < exports.memTableEntries; k++) { memoryTableEntry *entry = &exports.memTable[k]; // Write out the contents if this is new or if it is a normal, overwritable // mutable area. if (k >= permanentEntries || (entry->mtFlags & (MTF_WRITEABLE|MTF_NO_OVERWRITE)) == MTF_WRITEABLE) { descrs[k].relocations = ftell(exports.exportFile); // Have to write this out. exports.relocationCount = 0; // Create the relocation table. char *start = (char*)entry->mtOriginalAddr; char *end = start + entry->mtLength; for (PolyWord *p = (PolyWord*)start; p < (PolyWord*)end; ) { p++; PolyObject *obj = (PolyObject*)p; POLYUNSIGNED length = obj->Length(); // Most relocations can be computed when the saved state is // loaded so we only write out the difficult ones: those that // occur within compiled code. // exports.relocateObject(obj); if (length != 0 && obj->IsCodeObject()) machineDependent->ScanConstantsWithinCode(obj, &exports); p += length; } descrs[k].relocationCount = exports.relocationCount; // Write out the data. descrs[k].segmentData = ftell(exports.exportFile); fwrite(entry->mtOriginalAddr, entry->mtLength, 1, exports.exportFile); } } // If this is a child we need to write a string table containing the parent name. if (newHierarchy > 1) { saveHeader.stringTable = ftell(exports.exportFile); _fputtc(0, exports.exportFile); // First byte of string table is zero _fputts(hierarchyTable[newHierarchy-2]->fileName, exports.exportFile); _fputtc(0, exports.exportFile); // A terminating null. saveHeader.stringTableSize = (_tcslen(hierarchyTable[newHierarchy-2]->fileName) + 2)*sizeof(TCHAR); } // Rewrite the header and the segment tables now they're complete. fseek(exports.exportFile, 0, SEEK_SET); fwrite(&saveHeader, sizeof(saveHeader), 1, exports.exportFile); fwrite(descrs, sizeof(SavedStateSegmentDescr), exports.memTableEntries, exports.exportFile); if (debugOptions & DEBUG_SAVING) Log("SAVE: Writing complete.\n"); // Add an entry to the hierarchy table for this file. (void)AddHierarchyEntry(fileName, saveHeader.timeStamp); delete[](descrs); CheckMemory(); } // Write a saved state file. POLYUNSIGNED PolySaveState(FirstArgument threadId, PolyWord fileName, PolyWord depth) { TaskData *taskData = TaskData::FindTaskForId(threadId); ASSERT(taskData != 0); taskData->PreRTSCall(); Handle reset = taskData->saveVec.mark(); try { TempString fileNameBuff(Poly_string_to_T_alloc(fileName)); // The value of depth is zero for top-level save so we need to add one for hierarchy. unsigned newHierarchy = get_C_unsigned(taskData, depth) + 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); } catch (...) {} // If an ML exception is raised taskData->saveVec.reset(reset); taskData->PostRTSCall(); return TAGGED(0).AsUnsigned(); } /* * Loading saved state files. */ class StateLoader: public MainThreadRequest { public: StateLoader(bool isH, Handle files): MainThreadRequest(MTP_LOADSTATE), isHierarchy(isH), fileNameList(files), errorResult(0), errNumber(0) { } virtual void Perform(void); bool LoadFile(bool isInitial, time_t requiredStamp, PolyWord tail); bool isHierarchy; Handle fileNameList; const char *errorResult; // The fileName here is the last file loaded. As well as using it // to load the name can also be printed out at the end to identify the // particular file in the hierarchy that failed. AutoFree fileName; int errNumber; }; // Called by the main thread once all the ML threads have stopped. void StateLoader::Perform(void) { // Copy the first file name into the buffer. if (isHierarchy) { if (ML_Cons_Cell::IsNull(fileNameList->Word())) { errorResult = "Hierarchy list is empty"; return; } ML_Cons_Cell *p = DEREFLISTHANDLE(fileNameList); fileName = Poly_string_to_T_alloc(p->h); if (fileName == NULL) { errorResult = "Insufficient memory"; errNumber = NOMEMORY; return; } (void)LoadFile(true, 0, p->t); } else { fileName = Poly_string_to_T_alloc(fileNameList->Word()); if (fileName == NULL) { errorResult = "Insufficient memory"; errNumber = NOMEMORY; return; } (void)LoadFile(true, 0, TAGGED(0)); } } class ClearVolatile: public ScanAddress { public: ClearVolatile() {} virtual PolyObject *ScanObjectAddress(PolyObject *base) { return base; } virtual void ScanAddressesInObject(PolyObject *base, POLYUNSIGNED lengthWord); }; // Set the values of external references and clear the values of other weak byte refs. void ClearVolatile::ScanAddressesInObject(PolyObject *base, POLYUNSIGNED lengthWord) { if (OBJ_IS_MUTABLE_OBJECT(lengthWord) && OBJ_IS_NO_OVERWRITE(lengthWord)) { if (OBJ_IS_BYTE_OBJECT(lengthWord)) { if (OBJ_IS_WEAKREF_OBJECT(lengthWord)) { POLYUNSIGNED len = OBJ_OBJECT_LENGTH(lengthWord); if (len >= sizeof(uintptr_t) / sizeof(PolyWord)) *((uintptr_t*)base) = 0; setEntryPoint(base); } } else { // Clear volatile refs POLYUNSIGNED len = OBJ_OBJECT_LENGTH(lengthWord); for (POLYUNSIGNED i = 0; i < len; i++) base->Set(i, TAGGED(0)); } } } // This is copied from the B-tree in MemMgr. It probably should be // merged but will do for the moment. It's intended to reduce the // cost of finding the segment for relocation. class SpaceBTree { public: SpaceBTree(bool is, unsigned i = 0) : isLeaf(is), index(i) { } virtual ~SpaceBTree() {} bool isLeaf; unsigned index; // The index if this is a leaf }; // A non-leaf node in the B-tree class SpaceBTreeTree : public SpaceBTree { public: SpaceBTreeTree(); virtual ~SpaceBTreeTree(); SpaceBTree *tree[256]; }; SpaceBTreeTree::SpaceBTreeTree() : SpaceBTree(false) { for (unsigned i = 0; i < 256; i++) tree[i] = 0; } SpaceBTreeTree::~SpaceBTreeTree() { for (unsigned i = 0; i < 256; i++) delete(tree[i]); } // This class is used to relocate addresses in areas that have been loaded. class LoadRelocate: public ScanAddress { public: LoadRelocate(bool pcc = false): processCodeConstants(pcc), originalBaseAddr(0), descrs(0), targetAddresses(0), nDescrs(0), spaceTree(0) {} ~LoadRelocate(); void RelocateObject(PolyObject *p); virtual PolyObject *ScanObjectAddress(PolyObject *base) { ASSERT(0); return base; } // Not used virtual void ScanConstant(PolyObject *base, byte *addressOfConstant, ScanRelocationKind code, intptr_t displacement); void RelocateAddressAt(PolyWord *pt); PolyObject *RelocateAddress(PolyObject *obj); void AddTreeRange(SpaceBTree **t, unsigned index, uintptr_t startS, uintptr_t endS); bool processCodeConstants; PolyWord *originalBaseAddr; SavedStateSegmentDescr *descrs; PolyWord **targetAddresses; unsigned nDescrs; SpaceBTree *spaceTree; intptr_t relativeOffset; }; LoadRelocate::~LoadRelocate() { if (descrs) delete[](descrs); if (targetAddresses) delete[](targetAddresses); delete(spaceTree); } // Add an entry to the space B-tree. void LoadRelocate::AddTreeRange(SpaceBTree **tt, unsigned index, uintptr_t startS, uintptr_t endS) { if (*tt == 0) *tt = new SpaceBTreeTree; ASSERT(!(*tt)->isLeaf); SpaceBTreeTree *t = (SpaceBTreeTree*)*tt; const unsigned shift = (sizeof(void*) - 1) * 8; // Takes the high-order byte uintptr_t r = startS >> shift; ASSERT(r < 256); const uintptr_t s = endS == 0 ? 256 : endS >> shift; ASSERT(s >= r && s <= 256); if (r == s) // Wholly within this entry AddTreeRange(&(t->tree[r]), index, startS << 8, endS << 8); else { // Deal with any remainder at the start. if ((r << shift) != startS) { AddTreeRange(&(t->tree[r]), index, startS << 8, 0 /*End of range*/); r++; } // Whole entries. while (r < s) { ASSERT(t->tree[r] == 0); t->tree[r] = new SpaceBTree(true, index); r++; } // Remainder at the end. if ((s << shift) != endS) AddTreeRange(&(t->tree[r]), index, 0, endS << 8); } } // Update the addresses in a group of words. void LoadRelocate::RelocateAddressAt(PolyWord *pt) { PolyWord val = *pt; if (! val.IsTagged()) *gMem.SpaceForAddress(pt)->writeAble(pt) = RelocateAddress(val.AsObjPtr(originalBaseAddr)); } PolyObject *LoadRelocate::RelocateAddress(PolyObject *obj) { // Which segment is this address in? // N.B. As with SpaceForAddress we need to subtract 1 to point to the length word. uintptr_t t = (uintptr_t)((PolyWord*)obj - 1); SpaceBTree *tr = spaceTree; // Each level of the tree is either a leaf or a vector of trees. unsigned j = sizeof(void *) * 8; for (;;) { if (tr == 0) break; if (tr->isLeaf) { // It's in this segment: relocate it to the current position. unsigned i = tr->index; SavedStateSegmentDescr *descr = &descrs[i]; PolyWord *newAddress = targetAddresses[descr->segmentIndex]; ASSERT((char*)obj > descr->originalAddress && (char*)obj <= (char*)descr->originalAddress + descr->segmentSize); ASSERT(newAddress != 0); byte *setAddress = (byte*)newAddress + ((char*)obj - (char*)descr->originalAddress); return (PolyObject*)setAddress; } j -= 8; tr = ((SpaceBTreeTree*)tr)->tree[(t >> j) & 0xff]; } // This should never happen. ASSERT(0); return 0; } // This is based on Exporter::relocateObject but does the reverse. // It attempts to adjust all the addresses in the object when it has // been read in. void LoadRelocate::RelocateObject(PolyObject *p) { if (p->IsByteObject()) { } else if (p->IsCodeObject()) { POLYUNSIGNED constCount; PolyWord *cp; ASSERT(! p->IsMutable() ); - p->GetConstSegmentForCode(cp, constCount); + machineDependent->GetConstSegmentForCode(p, cp, constCount); /* Now the constant area. */ for (POLYUNSIGNED i = 0; i < constCount; i++) RelocateAddressAt(&(cp[i])); // Saved states and modules have relocation entries for constants in the code. // We can't use them when loading object files in 32-in-64 so have to process the // constants here. if (processCodeConstants) machineDependent->ScanConstantsWithinCode(p, this); } else if (p->IsClosureObject()) { // The first word is the address of the code. POLYUNSIGNED length = p->Length(); *(PolyObject**)p = RelocateAddress(*(PolyObject**)p); for (POLYUNSIGNED i = sizeof(PolyObject*)/sizeof(PolyWord); i < length; i++) RelocateAddressAt(p->Offset(i)); } else /* Ordinary objects, essentially tuples. */ { POLYUNSIGNED length = p->Length(); for (POLYUNSIGNED i = 0; i < length; i++) RelocateAddressAt(p->Offset(i)); } } // Update addresses as constants within the code. void LoadRelocate::ScanConstant(PolyObject *base, byte *addressOfConstant, ScanRelocationKind code, intptr_t displacement) { PolyObject *p = GetConstantValue(addressOfConstant, code, displacement); if (p != 0) { // Relative addresses are computed by adding the CURRENT address. // We have to convert them into addresses in original space before we // can relocate them. if (code == PROCESS_RELOC_I386RELATIVE) p = (PolyObject*)((PolyWord*)p + relativeOffset); PolyObject *newValue = RelocateAddress(p); SetConstantValue(addressOfConstant, newValue, code); } } // Load a saved state file. Calls itself to handle parent files. bool StateLoader::LoadFile(bool isInitial, time_t requiredStamp, PolyWord tail) { LoadRelocate relocate; AutoFree thisFile(_tcsdup(fileName)); AutoClose loadFile(_tfopen(fileName, _T("rb"))); if ((FILE*)loadFile == NULL) { errorResult = "Cannot open load file"; errNumber = ERRORNUMBER; return false; } SavedStateHeader header; // Read the header and check the signature. if (fread(&header, sizeof(SavedStateHeader), 1, loadFile) != 1) { errorResult = "Unable to load header"; return false; } if (strncmp(header.headerSignature, SAVEDSTATESIGNATURE, sizeof(header.headerSignature)) != 0) { errorResult = "File is not a saved state"; return false; } if (header.headerVersion != SAVEDSTATEVERSION || header.headerLength != sizeof(SavedStateHeader) || header.segmentDescrLength != sizeof(SavedStateSegmentDescr)) { errorResult = "Unsupported version of saved state file"; return false; } // Check that we have the required stamp before loading any children. // If a parent has been overwritten we could get a loop. if (! isInitial && header.timeStamp != requiredStamp) { // Time-stamps don't match. errorResult = "The parent for this saved state does not match or has been changed"; return false; } // Have verified that this is a reasonable saved state file. If it isn't a // top-level file we have to load the parents first. if (header.parentNameEntry != 0) { if (isHierarchy) { // Take the file name from the list if (ML_Cons_Cell::IsNull(tail)) { errorResult = "Missing parent name in argument list"; return false; } ML_Cons_Cell *p = (ML_Cons_Cell *)tail.AsObjPtr(); fileName = Poly_string_to_T_alloc(p->h); if (fileName == NULL) { errorResult = "Insufficient memory"; errNumber = NOMEMORY; return false; } if (! LoadFile(false, header.parentTimeStamp, p->t)) return false; } else { size_t toRead = header.stringTableSize-header.parentNameEntry; size_t elems = ((toRead + sizeof(TCHAR) - 1) / sizeof(TCHAR)); // Always allow space for null terminator size_t roundedBytes = (elems + 1) * sizeof(TCHAR); TCHAR *newFileName = (TCHAR *)realloc(fileName, roundedBytes); if (newFileName == NULL) { errorResult = "Insufficient memory"; errNumber = NOMEMORY; return false; } fileName = newFileName; if (header.parentNameEntry >= header.stringTableSize /* Bad entry */ || fseek(loadFile, header.stringTable + header.parentNameEntry, SEEK_SET) != 0 || fread(fileName, 1, toRead, loadFile) != toRead) { errorResult = "Unable to read parent file name"; return false; } fileName[elems] = 0; // Should already be null-terminated, but just in case. if (! LoadFile(false, header.parentTimeStamp, TAGGED(0))) return false; } ASSERT(hierarchyDepth > 0 && hierarchyTable[hierarchyDepth-1] != 0); } else // Top-level file { if (isHierarchy && ! ML_Cons_Cell::IsNull(tail)) { // There should be no further file names if this is really the top. errorResult = "Too many file names in the list"; return false; } if (header.parentTimeStamp != exportTimeStamp) { // Time-stamp does not match executable. errorResult = "Saved state was exported from a different executable or the executable has changed"; return false; } // Any existing spaces at this level or greater must be turned // into local spaces. We may have references from the stack to objects that // have previously been imported but otherwise these spaces are no longer // needed. gMem.DemoteImportSpaces(); // Clean out the hierarchy table. for (unsigned h = 0; h < hierarchyDepth; h++) { delete(hierarchyTable[h]); hierarchyTable[h] = 0; } hierarchyDepth = 0; } // Now have a valid, matching saved state. // Load the segment descriptors. relocate.nDescrs = header.segmentDescrCount; relocate.descrs = new SavedStateSegmentDescr[relocate.nDescrs]; relocate.originalBaseAddr = (PolyWord*)header.originalBaseAddr; if (fseek(loadFile, header.segmentDescr, SEEK_SET) != 0 || fread(relocate.descrs, sizeof(SavedStateSegmentDescr), relocate.nDescrs, loadFile) != relocate.nDescrs) { errorResult = "Unable to read segment descriptors"; return false; } { unsigned maxIndex = 0; for (unsigned i = 0; i < relocate.nDescrs; i++) { if (relocate.descrs[i].segmentIndex > maxIndex) maxIndex = relocate.descrs[i].segmentIndex; relocate.AddTreeRange(&relocate.spaceTree, i, (uintptr_t)relocate.descrs[i].originalAddress, (uintptr_t)((char*)relocate.descrs[i].originalAddress + relocate.descrs[i].segmentSize-1)); } relocate.targetAddresses = new PolyWord*[maxIndex+1]; for (unsigned i = 0; i <= maxIndex; i++) relocate.targetAddresses[i] = 0; } // Read in and create the new segments first. If we have problems, // in particular if we have run out of memory, then it's easier to recover. for (unsigned i = 0; i < relocate.nDescrs; i++) { SavedStateSegmentDescr *descr = &relocate.descrs[i]; MemSpace *space = gMem.SpaceForIndex(descr->segmentIndex); if (space != NULL) relocate.targetAddresses[descr->segmentIndex] = space->bottom; if (descr->segmentData == 0) { // No data - just an entry in the index. if (space == NULL/* || descr->segmentSize != (size_t)((char*)space->top - (char*)space->bottom)*/) { errorResult = "Mismatch for existing memory space"; return false; } } else if ((descr->segmentFlags & SSF_OVERWRITE) == 0) { // New segment. if (space != NULL) { errorResult = "Segment already exists"; return false; } // Allocate memory for the new segment. unsigned mFlags = (descr->segmentFlags & SSF_WRITABLE ? MTF_WRITEABLE : 0) | (descr->segmentFlags & SSF_NOOVERWRITE ? MTF_NO_OVERWRITE : 0) | (descr->segmentFlags & SSF_BYTES ? MTF_BYTES : 0) | (descr->segmentFlags & SSF_CODE ? MTF_EXECUTABLE : 0); PermanentMemSpace *newSpace = gMem.AllocateNewPermanentSpace(descr->segmentSize, mFlags, descr->segmentIndex, hierarchyDepth + 1); if (newSpace == 0) { errorResult = "Unable to allocate memory"; return false; } PolyWord *mem = newSpace->bottom; PolyWord* writeAble = newSpace->writeAble(mem); if (fseek(loadFile, descr->segmentData, SEEK_SET) != 0 || fread(writeAble, descr->segmentSize, 1, loadFile) != 1) { errorResult = "Unable to read segment"; return false; } // Fill unused space to the top of the area. gMem.FillUnusedSpace(writeAble +descr->segmentSize/sizeof(PolyWord), newSpace->spaceSize() - descr->segmentSize/sizeof(PolyWord)); // Leave it writable until we've done the relocations. relocate.targetAddresses[descr->segmentIndex] = mem; if (newSpace->noOverwrite) { ClearVolatile cwbr; cwbr.ScanAddressesInRegion(newSpace->bottom, newSpace->topPointer); } } } // Now read in the mutable overwrites and relocate. for (unsigned j = 0; j < relocate.nDescrs; j++) { SavedStateSegmentDescr *descr = &relocate.descrs[j]; MemSpace *space = gMem.SpaceForIndex(descr->segmentIndex); ASSERT(space != NULL); // We should have created it. if (descr->segmentFlags & SSF_OVERWRITE) { if (fseek(loadFile, descr->segmentData, SEEK_SET) != 0 || fread(space->bottom, descr->segmentSize, 1, loadFile) != 1) { errorResult = "Unable to read segment"; return false; } } // Relocation. if (descr->segmentData != 0) { // Adjust the addresses in the loaded segment. for (PolyWord *p = space->bottom; p < space->top; ) { p++; PolyObject *obj = (PolyObject*)p; POLYUNSIGNED length = obj->Length(); relocate.RelocateObject(obj); p += length; } } // Process explicit relocations. // If we get errors just skip the error and continue rather than leave // everything in an unstable state. if (descr->relocations) { if (fseek(loadFile, descr->relocations, SEEK_SET) != 0) { errorResult = "Unable to read relocation segment"; return false; } for (unsigned k = 0; k < descr->relocationCount; k++) { RelocationEntry reloc; if (fread(&reloc, sizeof(reloc), 1, loadFile) != 1) { errorResult = "Unable to read relocation segment"; return false; } MemSpace *toSpace = gMem.SpaceForIndex(reloc.targetSegment); if (toSpace == NULL) { errorResult = "Unknown space reference in relocation"; continue; } byte *setAddress = (byte*)space->bottom + reloc.relocAddress; byte *targetAddress = (byte*)toSpace->bottom + reloc.targetAddress; if (setAddress >= (byte*)space->top || targetAddress >= (byte*)toSpace->top) { errorResult = "Bad relocation"; continue; } ScanAddress::SetConstantValue(setAddress, (PolyObject*)(targetAddress), reloc.relKind); } } } // Set the final permissions. for (unsigned j = 0; j < relocate.nDescrs; j++) { SavedStateSegmentDescr *descr = &relocate.descrs[j]; if (descr->segmentData != 0) { PermanentMemSpace* space = gMem.SpaceForIndex(descr->segmentIndex); gMem.CompletePermanentSpaceAllocation(space); } } // Add an entry to the hierarchy table for this file. if (! AddHierarchyEntry(thisFile, header.timeStamp)) return false; return true; // Succeeded } static void LoadState(TaskData *taskData, bool isHierarchy, Handle hFileList) // Load a saved state or a hierarchy. // hFileList is a list if this is a hierarchy and a single name if it is not. { StateLoader loader(isHierarchy, hFileList); // 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 { AutoFree buff((char *)malloc(strlen(loader.errorResult) + 2 + _tcslen(loader.fileName) * sizeof(TCHAR) + 1)); #if (defined(_WIN32) && defined(UNICODE)) sprintf(buff, "%s: %S", loader.errorResult, (TCHAR *)loader.fileName); #else sprintf(buff, "%s: %s", loader.errorResult, (TCHAR *)loader.fileName); #endif raise_syscall(taskData, buff, loader.errNumber); } } } // Load a saved state file and any ancestors. POLYUNSIGNED PolyLoadState(FirstArgument threadId, PolyWord arg) { TaskData *taskData = TaskData::FindTaskForId(threadId); ASSERT(taskData != 0); taskData->PreRTSCall(); Handle reset = taskData->saveVec.mark(); Handle pushedArg = taskData->saveVec.push(arg); try { LoadState(taskData, false, pushedArg); } catch (...) {} // If an ML exception is raised taskData->saveVec.reset(reset); taskData->PostRTSCall(); return TAGGED(0).AsUnsigned(); } // Load hierarchy. This provides a complete list of children and parents. POLYUNSIGNED PolyLoadHierarchy(FirstArgument threadId, PolyWord arg) { TaskData *taskData = TaskData::FindTaskForId(threadId); ASSERT(taskData != 0); taskData->PreRTSCall(); Handle reset = taskData->saveVec.mark(); Handle pushedArg = taskData->saveVec.push(arg); try { LoadState(taskData, true, pushedArg); } catch (...) {} // If an ML exception is raised taskData->saveVec.reset(reset); taskData->PostRTSCall(); return TAGGED(0).AsUnsigned(); } /* * Additional functions to provide information or change saved-state files. */ // These functions do not affect the global state so can be executed by // the ML threads directly. static Handle ShowHierarchy(TaskData *taskData) // Return the list of files in the hierarchy. { Handle saved = taskData->saveVec.mark(); Handle list = SAVE(ListNull); // Process this in reverse order. for (unsigned i = hierarchyDepth; i > 0; i--) { Handle value = SAVE(C_string_to_Poly(taskData, hierarchyTable[i-1]->fileName)); Handle next = alloc_and_save(taskData, sizeof(ML_Cons_Cell)/sizeof(PolyWord)); DEREFLISTHANDLE(next)->h = value->Word(); DEREFLISTHANDLE(next)->t = list->Word(); taskData->saveVec.reset(saved); list = SAVE(next->Word()); } return list; } // Show the hierarchy. POLYUNSIGNED PolyShowHierarchy(FirstArgument threadId) { TaskData *taskData = TaskData::FindTaskForId(threadId); ASSERT(taskData != 0); taskData->PreRTSCall(); Handle reset = taskData->saveVec.mark(); Handle result = 0; try { result = ShowHierarchy(taskData); } catch (...) {} // If an ML exception is raised taskData->saveVec.reset(reset); taskData->PostRTSCall(); if (result == 0) return TAGGED(0).AsUnsigned(); else return result->Word().AsUnsigned(); } static void RenameParent(TaskData *taskData, PolyWord childName, PolyWord parentName) // Change the name of the immediate parent stored in a child { // The name of the file to modify. AutoFree fileNameBuff(Poly_string_to_T_alloc(childName)); if (fileNameBuff == NULL) raise_syscall(taskData, "Insufficient memory", NOMEMORY); // The new parent name to insert. AutoFree parentNameBuff(Poly_string_to_T_alloc(parentName)); if (parentNameBuff == NULL) raise_syscall(taskData, "Insufficient memory", NOMEMORY); AutoClose loadFile(_tfopen(fileNameBuff, _T("r+b"))); // Open for reading and writing if ((FILE*)loadFile == NULL) { AutoFree buff((char *)malloc(23 + _tcslen(fileNameBuff) * sizeof(TCHAR) + 1)); #if (defined(_WIN32) && defined(UNICODE)) sprintf(buff, "Cannot open load file: %S", (TCHAR *)fileNameBuff); #else sprintf(buff, "Cannot open load file: %s", (TCHAR *)fileNameBuff); #endif raise_syscall(taskData, buff, ERRORNUMBER); } 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); } POLYUNSIGNED PolyRenameParent(FirstArgument threadId, PolyWord childName, PolyWord parentName) { TaskData *taskData = TaskData::FindTaskForId(threadId); ASSERT(taskData != 0); taskData->PreRTSCall(); Handle reset = taskData->saveVec.mark(); try { RenameParent(taskData, childName, parentName); } catch (...) {} // If an ML exception is raised taskData->saveVec.reset(reset); taskData->PostRTSCall(); return TAGGED(0).AsUnsigned(); } static Handle ShowParent(TaskData *taskData, Handle hFileName) // Return the name of the immediate parent stored in a child { AutoFree fileNameBuff(Poly_string_to_T_alloc(hFileName->Word())); if (fileNameBuff == NULL) raise_syscall(taskData, "Insufficient memory", NOMEMORY); AutoClose loadFile(_tfopen(fileNameBuff, _T("rb"))); if ((FILE*)loadFile == NULL) { AutoFree buff((char *)malloc(23 + _tcslen(fileNameBuff) * sizeof(TCHAR) + 1)); if (buff == NULL) raise_syscall(taskData, "Insufficient memory", NOMEMORY); #if (defined(_WIN32) && defined(UNICODE)) sprintf(buff, "Cannot open load file: %S", (TCHAR *)fileNameBuff); #else sprintf(buff, "Cannot open load file: %s", (TCHAR *)fileNameBuff); #endif raise_syscall(taskData, buff, ERRORNUMBER); } 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) { size_t toRead = header.stringTableSize-header.parentNameEntry; size_t elems = ((toRead + sizeof(TCHAR) - 1) / sizeof(TCHAR)); // Always allow space for null terminator size_t roundedBytes = (elems + 1) * sizeof(TCHAR); AutoFree parentFileName((TCHAR *)malloc(roundedBytes)); if (parentFileName == NULL) raise_syscall(taskData, "Insufficient memory", NOMEMORY); 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[elems] = 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, resVal->Word()); return result; } else return SAVE(NONE_VALUE); } // Return the name of the immediate parent stored in a child POLYUNSIGNED PolyShowParent(FirstArgument threadId, PolyWord arg) { TaskData *taskData = TaskData::FindTaskForId(threadId); ASSERT(taskData != 0); taskData->PreRTSCall(); Handle reset = taskData->saveVec.mark(); Handle pushedArg = taskData->saveVec.push(arg); Handle result = 0; try { result = ShowParent(taskData, pushedArg); } catch (...) {} // If an ML exception is raised taskData->saveVec.reset(reset); taskData->PostRTSCall(); if (result == 0) return TAGGED(0).AsUnsigned(); else return result->Word().AsUnsigned(); } // Module system #define MODULESIGNATURE "POLYMODU" #define MODULEVERSION 2 typedef struct _moduleHeader { // These entries are primarily to check that we have a valid // saved state file before we try to interpret anything else. char headerSignature[8]; // Should contain MODULESIGNATURE unsigned headerVersion; // Should contain MODULEVERSION unsigned headerLength; // Number of bytes in the header unsigned segmentDescrLength; // Number of bytes in a descriptor // These entries contain the real data. off_t segmentDescr; // Position of segment descriptor table unsigned segmentDescrCount; // Number of segment descriptors in the table time_t timeStamp; // The time stamp for this file. time_t executableTimeStamp; // The time stamp for the parent executable. // Root uintptr_t rootSegment; POLYUNSIGNED rootOffset; } ModuleHeader; // Store a module class ModuleStorer: public MainThreadRequest { public: ModuleStorer(const TCHAR *file, Handle r): MainThreadRequest(MTP_STOREMODULE), fileName(file), root(r), errorMessage(0), errCode(0) {} virtual void Perform(); const TCHAR *fileName; Handle root; const char *errorMessage; int errCode; }; class ModuleExport: public SaveStateExport { public: ModuleExport(): SaveStateExport(1/* Everything EXCEPT the executable. */) {} virtual void exportStore(void); // Write the data out. }; void ModuleStorer::Perform() { ModuleExport exporter; #if (defined(_WIN32) && defined(UNICODE)) exporter.exportFile = _wfopen(fileName, L"wb"); #else exporter.exportFile = fopen(fileName, "wb"); #endif if (exporter.exportFile == NULL) { errorMessage = "Cannot open export file"; errCode = ERRORNUMBER; return; } // RunExport copies everything reachable from the root, except data from // the executable because we've set the hierarchy to 1, using CopyScan. // It builds the tables in the export data structure then calls exportStore // to actually write the data. if (! root->Word().IsDataPtr()) { // If we have a completely empty module the list may be null. // This needs to be dealt with at a higher level. errorMessage = "Module root is not an address"; return; } exporter.RunExport(root->WordP()); errorMessage = exporter.errorMessage; // This will be null unless there's been an error. } void ModuleExport::exportStore(void) { // What we need to do here is implement the export in a similar way to e.g. PECOFFExport::exportStore // This is copied from SaveRequest::Perform and should be common code. ModuleHeader modHeader; memset(&modHeader, 0, sizeof(modHeader)); modHeader.headerLength = sizeof(modHeader); memcpy(modHeader.headerSignature, MODULESIGNATURE, sizeof(modHeader.headerSignature)); modHeader.headerVersion = MODULEVERSION; modHeader.segmentDescrLength = sizeof(SavedStateSegmentDescr); modHeader.executableTimeStamp = exportTimeStamp; { unsigned rootArea = findArea(this->rootFunction); struct _memTableEntry *mt = &memTable[rootArea]; modHeader.rootSegment = mt->mtIndex; modHeader.rootOffset = (POLYUNSIGNED)((char*)this->rootFunction - (char*)mt->mtOriginalAddr); } modHeader.timeStamp = getBuildTime(); modHeader.segmentDescrCount = this->memTableEntries; // One segment for each space. // Write out the header. fwrite(&modHeader, sizeof(modHeader), 1, this->exportFile); SavedStateSegmentDescr *descrs = new SavedStateSegmentDescr [this->memTableEntries]; // We need an entry in the descriptor tables for each segment in the executable because // we may have relocations that refer to addresses in it. for (unsigned j = 0; j < this->memTableEntries; j++) { SavedStateSegmentDescr *thisDescr = &descrs[j]; memoryTableEntry *entry = &this->memTable[j]; memset(thisDescr, 0, sizeof(SavedStateSegmentDescr)); thisDescr->relocationSize = sizeof(RelocationEntry); thisDescr->segmentIndex = (unsigned)entry->mtIndex; thisDescr->segmentSize = entry->mtLength; // Set this even if we don't write it. thisDescr->originalAddress = entry->mtOriginalAddr; if (entry->mtFlags & MTF_WRITEABLE) { thisDescr->segmentFlags |= SSF_WRITABLE; if (entry->mtFlags & MTF_NO_OVERWRITE) thisDescr->segmentFlags |= SSF_NOOVERWRITE; if ((entry->mtFlags & MTF_NO_OVERWRITE) == 0) thisDescr->segmentFlags |= SSF_OVERWRITE; if (entry->mtFlags & MTF_BYTES) thisDescr->segmentFlags |= SSF_BYTES; } if (entry->mtFlags & MTF_EXECUTABLE) thisDescr->segmentFlags |= SSF_CODE; } // Write out temporarily. Will be overwritten at the end. modHeader.segmentDescr = ftell(this->exportFile); fwrite(descrs, sizeof(SavedStateSegmentDescr), this->memTableEntries, this->exportFile); // Write out the relocations and the data. for (unsigned k = 0; k < this->memTableEntries; k++) { SavedStateSegmentDescr *thisDescr = &descrs[k]; memoryTableEntry *entry = &this->memTable[k]; if (k >= newAreas) // Not permanent areas { thisDescr->relocations = ftell(this->exportFile); // Have to write this out. this->relocationCount = 0; // Create the relocation table. char *start = (char*)entry->mtOriginalAddr; char *end = start + entry->mtLength; for (PolyWord *p = (PolyWord*)start; p < (PolyWord*)end; ) { p++; PolyObject *obj = (PolyObject*)p; POLYUNSIGNED length = obj->Length(); // For saved states we don't include explicit relocations except // in code but it's easier if we do for modules. if (length != 0 && obj->IsCodeObject()) machineDependent->ScanConstantsWithinCode(obj, this); relocateObject(obj); p += length; } thisDescr->relocationCount = this->relocationCount; // Write out the data. thisDescr->segmentData = ftell(exportFile); fwrite(entry->mtOriginalAddr, entry->mtLength, 1, exportFile); } } // Rewrite the header and the segment tables now they're complete. fseek(exportFile, 0, SEEK_SET); fwrite(&modHeader, sizeof(modHeader), 1, exportFile); fwrite(descrs, sizeof(SavedStateSegmentDescr), this->memTableEntries, exportFile); delete[](descrs); fclose(exportFile); exportFile = NULL; } // Store a module POLYUNSIGNED PolyStoreModule(FirstArgument threadId, PolyWord name, PolyWord contents) { TaskData *taskData = TaskData::FindTaskForId(threadId); ASSERT(taskData != 0); taskData->PreRTSCall(); Handle reset = taskData->saveVec.mark(); Handle pushedContents = taskData->saveVec.push(contents); try { TempString fileName(name); ModuleStorer storer(fileName, pushedContents); processes->MakeRootRequest(taskData, &storer); if (storer.errorMessage) raise_syscall(taskData, storer.errorMessage, storer.errCode); } catch (...) {} // If an ML exception is raised taskData->saveVec.reset(reset); taskData->PostRTSCall(); return TAGGED(0).AsUnsigned(); } // Load a module. class ModuleLoader: public MainThreadRequest { public: ModuleLoader(TaskData *taskData, const TCHAR *file): MainThreadRequest(MTP_LOADMODULE), callerTaskData(taskData), fileName(file), errorResult(NULL), errNumber(0), rootHandle(0) {} virtual void Perform(); TaskData *callerTaskData; const TCHAR *fileName; const char *errorResult; int errNumber; Handle rootHandle; }; void ModuleLoader::Perform() { AutoClose loadFile(_tfopen(fileName, _T("rb"))); if ((FILE*)loadFile == NULL) { errorResult = "Cannot open load file"; errNumber = ERRORNUMBER; return; } ModuleHeader header; // Read the header and check the signature. if (fread(&header, sizeof(ModuleHeader), 1, loadFile) != 1) { errorResult = "Unable to load header"; return; } if (strncmp(header.headerSignature, MODULESIGNATURE, sizeof(header.headerSignature)) != 0) { errorResult = "File is not a Poly/ML module"; return; } if (header.headerVersion != MODULEVERSION || header.headerLength != sizeof(ModuleHeader) || header.segmentDescrLength != sizeof(SavedStateSegmentDescr)) { errorResult = "Unsupported version of module file"; return; } if (header.executableTimeStamp != exportTimeStamp) { // Time-stamp does not match executable. errorResult = "Module was exported from a different executable or the executable has changed"; return; } LoadRelocate relocate; relocate.nDescrs = header.segmentDescrCount; relocate.descrs = new SavedStateSegmentDescr[relocate.nDescrs]; if (fseek(loadFile, header.segmentDescr, SEEK_SET) != 0 || fread(relocate.descrs, sizeof(SavedStateSegmentDescr), relocate.nDescrs, loadFile) != relocate.nDescrs) { errorResult = "Unable to read segment descriptors"; return; } { unsigned maxIndex = 0; for (unsigned i = 0; i < relocate.nDescrs; i++) if (relocate.descrs[i].segmentIndex > maxIndex) maxIndex = relocate.descrs[i].segmentIndex; relocate.targetAddresses = new PolyWord*[maxIndex+1]; for (unsigned i = 0; i <= maxIndex; i++) relocate.targetAddresses[i] = 0; } // Read in and create the new segments first. If we have problems, // in particular if we have run out of memory, then it's easier to recover. for (unsigned i = 0; i < relocate.nDescrs; i++) { SavedStateSegmentDescr *descr = &relocate.descrs[i]; MemSpace *space = gMem.SpaceForIndex(descr->segmentIndex); if (descr->segmentData == 0) { // No data - just an entry in the index. if (space == NULL/* || descr->segmentSize != (size_t)((char*)space->top - (char*)space->bottom)*/) { errorResult = "Mismatch for existing memory space"; return; } else relocate.targetAddresses[descr->segmentIndex] = space->bottom; } else { // New segment. if (space != NULL) { errorResult = "Segment already exists"; return; } // Allocate memory for the new segment. size_t actualSize = descr->segmentSize; MemSpace *space; if (descr->segmentFlags & SSF_CODE) { CodeSpace *cSpace = gMem.NewCodeSpace(actualSize); if (cSpace == 0) { errorResult = "Unable to allocate memory"; return; } space = cSpace; cSpace->firstFree = (PolyWord*)((byte*)space->bottom + descr->segmentSize); if (cSpace->firstFree != cSpace->top) gMem.FillUnusedSpace(cSpace->firstFree, cSpace->top - cSpace->firstFree); } else { LocalMemSpace *lSpace = gMem.NewLocalSpace(actualSize, descr->segmentFlags & SSF_WRITABLE); if (lSpace == 0) { errorResult = "Unable to allocate memory"; return; } space = lSpace; lSpace->lowerAllocPtr = (PolyWord*)((byte*)lSpace->bottom + descr->segmentSize); } if (fseek(loadFile, descr->segmentData, SEEK_SET) != 0 || fread(space->bottom, descr->segmentSize, 1, loadFile) != 1) { errorResult = "Unable to read segment"; return; } relocate.targetAddresses[descr->segmentIndex] = space->bottom; if (space->isMutable && (descr->segmentFlags & SSF_BYTES) != 0) { ClearVolatile cwbr; cwbr.ScanAddressesInRegion(space->bottom, (PolyWord*)((byte*)space->bottom + descr->segmentSize)); } } } // Now deal with relocation. for (unsigned j = 0; j < relocate.nDescrs; j++) { SavedStateSegmentDescr *descr = &relocate.descrs[j]; PolyWord *baseAddr = relocate.targetAddresses[descr->segmentIndex]; ASSERT(baseAddr != NULL); // We should have created it. // Process explicit relocations. // If we get errors just skip the error and continue rather than leave // everything in an unstable state. if (descr->relocations) { if (fseek(loadFile, descr->relocations, SEEK_SET) != 0) errorResult = "Unable to read relocation segment"; for (unsigned k = 0; k < descr->relocationCount; k++) { RelocationEntry reloc; if (fread(&reloc, sizeof(reloc), 1, loadFile) != 1) errorResult = "Unable to read relocation segment"; byte *setAddress = (byte*)baseAddr + reloc.relocAddress; byte *targetAddress = (byte*)relocate.targetAddresses[reloc.targetSegment] + reloc.targetAddress; ScanAddress::SetConstantValue(setAddress, (PolyObject*)(targetAddress), reloc.relKind); } } } // Get the root address. Push this to the caller's save vec. If we put the // newly created areas into local memory we could get a GC as soon as we // complete this root request. { PolyWord *baseAddr = relocate.targetAddresses[header.rootSegment]; rootHandle = callerTaskData->saveVec.push((PolyObject*)((byte*)baseAddr + header.rootOffset)); } } static Handle LoadModule(TaskData *taskData, Handle args) { TempString fileName(args->Word()); ModuleLoader loader(taskData, fileName); processes->MakeRootRequest(taskData, &loader); if (loader.errorResult != 0) { if (loader.errNumber == 0) raise_fail(taskData, loader.errorResult); else { AutoFree buff((char *)malloc(strlen(loader.errorResult) + 2 + _tcslen(loader.fileName) * sizeof(TCHAR) + 1)); #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 loader.rootHandle; } // Load a module POLYUNSIGNED PolyLoadModule(FirstArgument threadId, PolyWord arg) { TaskData *taskData = TaskData::FindTaskForId(threadId); ASSERT(taskData != 0); taskData->PreRTSCall(); Handle reset = taskData->saveVec.mark(); Handle pushedArg = taskData->saveVec.push(arg); Handle result = 0; try { result = LoadModule(taskData, pushedArg); } catch (...) {} // If an ML exception is raised taskData->saveVec.reset(reset); taskData->PostRTSCall(); if (result == 0) return TAGGED(0).AsUnsigned(); else return result->Word().AsUnsigned(); } PolyObject *InitHeaderFromExport(struct _exportDescription *exports) { // Check the structure sizes stored in the export structure match the versions // used in this library. if (exports->structLength != sizeof(exportDescription) || exports->memTableSize != sizeof(memoryTableEntry) || exports->rtsVersion < FIRST_supported_version || exports->rtsVersion > LAST_supported_version) { #if (FIRST_supported_version == LAST_supported_version) Exit("The exported object file has version %0.2f but this library supports %0.2f", ((float)exports->rtsVersion) / 100.0, ((float)FIRST_supported_version) / 100.0); #else Exit("The exported object file has version %0.2f but this library supports %0.2f-%0.2f", ((float)exports->rtsVersion) / 100.0, ((float)FIRST_supported_version) / 100.0, ((float)LAST_supported_version) / 100.0); #endif } // We could also check the RTS version and the architecture. exportTimeStamp = exports->timeStamp; // Needed for load and save. memoryTableEntry *memTable = exports->memTable; #ifdef POLYML32IN64 // We need to copy this into the heap before beginning execution. // This is very like loading a saved state and the code should probably // be merged. LoadRelocate relocate(true); relocate.nDescrs = exports->memTableEntries; relocate.descrs = new SavedStateSegmentDescr[relocate.nDescrs]; relocate.targetAddresses = new PolyWord*[exports->memTableEntries]; relocate.originalBaseAddr = (PolyWord*)exports->originalBaseAddr; PolyObject *root = 0; for (unsigned i = 0; i < exports->memTableEntries; i++) { relocate.descrs[i].segmentIndex = memTable[i].mtIndex; relocate.descrs[i].originalAddress = memTable[i].mtOriginalAddr; relocate.descrs[i].segmentSize = memTable[i].mtLength; PermanentMemSpace *newSpace = gMem.AllocateNewPermanentSpace(memTable[i].mtLength, (unsigned)memTable[i].mtFlags, (unsigned)memTable[i].mtIndex); if (newSpace == 0) Exit("Unable to initialise a permanent memory space"); PolyWord *mem = newSpace->bottom; memcpy(newSpace->writeAble(mem), memTable[i].mtCurrentAddr, memTable[i].mtLength); PolyWord* unused = mem + memTable[i].mtLength / sizeof(PolyWord); gMem.FillUnusedSpace(newSpace->writeAble(unused), newSpace->spaceSize() - memTable[i].mtLength / sizeof(PolyWord)); if (newSpace == 0) Exit("Unable to initialise a permanent memory space"); relocate.targetAddresses[i] = mem; relocate.AddTreeRange(&relocate.spaceTree, i, (uintptr_t)relocate.descrs[i].originalAddress, (uintptr_t)((char*)relocate.descrs[i].originalAddress + relocate.descrs[i].segmentSize - 1)); // Relocate the root function. if (exports->rootFunction >= memTable[i].mtCurrentAddr && exports->rootFunction < (char*)memTable[i].mtCurrentAddr + memTable[i].mtLength) { root = (PolyObject*)((char*)mem + ((char*)exports->rootFunction - (char*)memTable[i].mtCurrentAddr)); } } // Now relocate the addresses for (unsigned j = 0; j < exports->memTableEntries; j++) { SavedStateSegmentDescr *descr = &relocate.descrs[j]; MemSpace *space = gMem.SpaceForIndex(descr->segmentIndex); // Any relative addresses have to be corrected by adding this. relocate.relativeOffset = (PolyWord*)descr->originalAddress - space->bottom; for (PolyWord *p = space->bottom; p < space->top; ) { #ifdef POLYML32IN64 if ((((uintptr_t)p) & 4) == 0) { // Skip any padding. The length word should be on an odd-word boundary. p++; continue; } #endif p++; PolyObject *obj = (PolyObject*)p; POLYUNSIGNED length = obj->Length(); relocate.RelocateObject(obj); p += length; } } // Set the final permissions. for (unsigned j = 0; j < exports->memTableEntries; j++) { PermanentMemSpace *space = gMem.SpaceForIndex(memTable[j].mtIndex); gMem.CompletePermanentSpaceAllocation(space); } return root; #else for (unsigned i = 0; i < exports->memTableEntries; i++) { // Construct a new space for each of the entries. if (gMem.NewPermanentSpace( (PolyWord*)memTable[i].mtCurrentAddr, memTable[i].mtLength / sizeof(PolyWord), (unsigned)memTable[i].mtFlags, (unsigned)memTable[i].mtIndex) == 0) Exit("Unable to initialise a permanent memory space"); } return (PolyObject *)exports->rootFunction; #endif } // Return the system directory for modules. This is configured differently // in Unix and in Windows. POLYUNSIGNED PolyGetModuleDirectory(FirstArgument threadId) { TaskData *taskData = TaskData::FindTaskForId(threadId); ASSERT(taskData != 0); taskData->PreRTSCall(); Handle reset = taskData->saveVec.mark(); Handle result = 0; try { #if (defined(MODULEDIR)) result = SAVE(C_string_to_Poly(taskData, MODULEDIR)); #elif (defined(_WIN32)) { // This registry key is configured when Poly/ML is installed using the installer. // It gives the path to the Poly/ML installation directory. We return the // Modules subdirectory. HKEY hk; if (RegOpenKeyEx(HKEY_LOCAL_MACHINE, _T("SOFTWARE\\Microsoft\\Windows\\CurrentVersion\\App Paths\\PolyML.exe"), 0, KEY_QUERY_VALUE, &hk) == ERROR_SUCCESS) { DWORD valSize; if (RegQueryValueEx(hk, _T("Path"), 0, NULL, NULL, &valSize) == ERROR_SUCCESS) { #define MODULEDIR _T("Modules") TempString buff((TCHAR*)malloc(valSize + (_tcslen(MODULEDIR) + 1) * sizeof(TCHAR))); DWORD dwType; if (RegQueryValueEx(hk, _T("Path"), 0, &dwType, (LPBYTE)(LPTSTR)buff, &valSize) == ERROR_SUCCESS) { // The registry entry should end with a backslash. _tcscat(buff, MODULEDIR); result = SAVE(C_string_to_Poly(taskData, buff)); } } RegCloseKey(hk); } result = SAVE(C_string_to_Poly(taskData, "")); } #else result = SAVE(C_string_to_Poly(taskData, "")); #endif } catch (...) {} // If an ML exception is raised taskData->saveVec.reset(reset); taskData->PostRTSCall(); if (result == 0) return TAGGED(0).AsUnsigned(); else return result->Word().AsUnsigned(); } struct _entrypts savestateEPT[] = { { "PolySaveState", (polyRTSFunction)&PolySaveState }, { "PolyLoadState", (polyRTSFunction)&PolyLoadState }, { "PolyShowHierarchy", (polyRTSFunction)&PolyShowHierarchy }, { "PolyRenameParent", (polyRTSFunction)&PolyRenameParent }, { "PolyShowParent", (polyRTSFunction)&PolyShowParent }, { "PolyStoreModule", (polyRTSFunction)&PolyStoreModule }, { "PolyLoadModule", (polyRTSFunction)&PolyLoadModule }, { "PolyLoadHierarchy", (polyRTSFunction)&PolyLoadHierarchy }, { "PolyGetModuleDirectory", (polyRTSFunction)&PolyGetModuleDirectory }, { NULL, NULL } // End of list. }; diff --git a/libpolyml/scanaddrs.cpp b/libpolyml/scanaddrs.cpp index 2693221a..847ac88d 100644 --- a/libpolyml/scanaddrs.cpp +++ b/libpolyml/scanaddrs.cpp @@ -1,292 +1,292 @@ /* Title: Address scanner - Copyright (c) 2006-8, 2012, 2019 David C.J. Matthews + Copyright (c) 2006-8, 2012, 2019, 2021 David C.J. Matthews This library is free software; you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License as published by the Free Software Foundation; either version 2.1 of the License, or (at your option) any later version. This library is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for more details. You should have received a copy of the GNU Lesser General Public License along with this library; if not, write to the Free Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA */ #ifdef HAVE_CONFIG_H #include "config.h" #elif defined(_WIN32) #include "winconfig.h" #else #error "No configuration file" #endif #ifdef HAVE_ASSERT_H #include #define ASSERT(x) assert(x) #else #define ASSERT(x) 0 #endif #include #include "globals.h" #include "scanaddrs.h" #include "machine_dep.h" #include "diagnostics.h" #include "memmgr.h" // Process the value at a given location and update it as necessary. POLYUNSIGNED ScanAddress::ScanAddressAt(PolyWord *pt) { PolyWord val = *pt; PolyWord newVal = val; if (IS_INT(val) || val == PolyWord::FromUnsigned(0)) { // We can get zeros in the constant area if we garbage collect // while compiling some code. */ } else { ASSERT(OBJ_IS_DATAPTR(val)); // Any sort of address newVal = ScanObjectAddress(val.AsObjPtr()); } if (newVal != val) // Only update if we need to. *pt = newVal; return 0; } // General purpose object processor, Processes all the addresses in an object. // Handles the various kinds of object that may contain addresses. void ScanAddress::ScanAddressesInObject(PolyObject *obj, POLYUNSIGNED lengthWord) { do { ASSERT (OBJ_IS_LENGTH(lengthWord)); if (OBJ_IS_BYTE_OBJECT(lengthWord)) return; /* Nothing more to do */ POLYUNSIGNED length = OBJ_OBJECT_LENGTH(lengthWord); PolyWord *baseAddr = (PolyWord*)obj; if (OBJ_IS_CODE_OBJECT(lengthWord)) { // Scan constants within the code. machineDependent->ScanConstantsWithinCode(obj, length, this); // Skip to the constants and get ready to scan them. - obj->GetConstSegmentForCode(length, baseAddr, length); + machineDependent->GetConstSegmentForCode(obj, length, baseAddr, length); // Adjust to the read-write area if necessary. baseAddr = gMem.SpaceForAddress(baseAddr)->writeAble(baseAddr); } else if (OBJ_IS_CLOSURE_OBJECT(lengthWord)) { // The first word is a code pointer so we need to treat it specially // but it is possible it hasn't yet been set. if ((*(uintptr_t*)baseAddr & 1) == 0) { POLYUNSIGNED lengthWord = ScanCodeAddressAt((PolyObject**)baseAddr); // N.B. This could side-effect *baseAddr if (lengthWord != 0) ScanAddressesInObject(*(PolyObject**)baseAddr, lengthWord); } baseAddr += sizeof(PolyObject*) / sizeof(PolyWord); length -= sizeof(PolyObject*) / sizeof(PolyWord); } PolyWord *endWord = baseAddr + length; // We want to minimise the actual recursion we perform so we try to // use tail recursion if we can. We first scan from the end and // remove any words that don't need recursion. POLYUNSIGNED lastLengthWord = 0; while (endWord != baseAddr) { PolyWord wordAt = endWord[-1]; if (IS_INT(wordAt) || wordAt == PolyWord::FromUnsigned(0)) endWord--; // Don't need to look at this. else if ((lastLengthWord = ScanAddressAt(endWord-1)) != 0) // We need to process this one break; else endWord--; // We're not interested in this. } if (endWord == baseAddr) return; // We've done everything. // There is at least one word that needs to be processed, the // one at endWord-1. // Now process from the beginning forward to see if there are // any words before this that need to be handled. This way we are more // likely to handle the head of a list by recursion and the // tail by looping (tail recursion). while (baseAddr < endWord-1) { PolyWord wordAt = *baseAddr; if (IS_INT(wordAt) || wordAt == PolyWord::FromUnsigned(0)) baseAddr++; // Don't need to look at this. else { POLYUNSIGNED lengthWord = ScanAddressAt(baseAddr); if (lengthWord != 0) { wordAt = *baseAddr; // Reload because it may have been side-effected // We really have to process this recursively. ASSERT(wordAt.IsDataPtr()); ScanAddressesInObject(wordAt.AsObjPtr(), lengthWord); baseAddr++; } else baseAddr++; } } // Finally process the last word we found that has to be processed. // Do this by looping rather than recursion. PolyWord wordAt = *baseAddr; // Last word to do. // This must be an address ASSERT(wordAt.IsDataPtr()); obj = wordAt.AsObjPtr(); lengthWord = lastLengthWord; } while(1); } void ScanAddress::ScanAddressesInRegion(PolyWord *region, PolyWord *end) { PolyWord *pt = region; while (pt < end) { #ifdef POLYML32IN64 if ((((uintptr_t)pt) & 4) == 0) { // Skip any padding. The length word should be on an odd-word boundary. pt++; continue; } #endif pt++; // Skip length word. // pt actually points AT the object here. PolyObject *obj = (PolyObject*)pt; if (obj->ContainsForwardingPtr()) /* skip over moved object */ { // We can now get multiple forwarding pointers as a result // of applying ShareData repeatedly. Perhaps we should // turn the forwarding pointers back into normal words in // an extra pass. obj = obj->FollowForwardingChain(); ASSERT(obj->ContainsNormalLengthWord()); pt += obj->Length(); } else { ASSERT(obj->ContainsNormalLengthWord()); POLYUNSIGNED length = obj->Length(); if (pt+length > end) Crash("Malformed object at %p - length %lu\n", pt, length); if (length != 0) ScanAddressesInObject(obj); pt += length; } } } // Extract a constant from the code. PolyObject *ScanAddress::GetConstantValue(byte *addressOfConstant, ScanRelocationKind code, intptr_t displacement) { switch (code) { case PROCESS_RELOC_DIRECT: // Absolute address { uintptr_t valu; byte *pt = addressOfConstant; if (pt[sizeof(uintptr_t)-1] & 0x80) valu = 0-1; else valu = 0; for (unsigned i = sizeof(uintptr_t); i > 0; i--) valu = (valu << 8) | pt[i-1]; if (valu == 0 || PolyWord::FromUnsigned((POLYUNSIGNED)valu).IsTagged()) return 0; else return (PolyObject*)valu; } case PROCESS_RELOC_I386RELATIVE: // 32 bit relative address { POLYSIGNED disp; byte *pt = addressOfConstant; // Get the displacement. This is signed. if (pt[3] & 0x80) disp = -1; else disp = 0; // Set the sign just in case. for(unsigned i = 4; i > 0; i--) disp = (disp << 8) | pt[i-1]; byte *absAddr = pt + disp + 4 + displacement; // The address is relative to AFTER the constant return (PolyObject*)absAddr; } default: ASSERT(false); return 0; } } // Store a constant value. Also used with a patch table when importing a saved heap which has // been exported using the C exporter. void ScanAddress::SetConstantValue(byte *addressOfConstant, PolyObject *p, ScanRelocationKind code) { MemSpace* space = gMem.SpaceForAddress(addressOfConstant); byte* addressToWrite = space->writeAble(addressOfConstant); switch (code) { case PROCESS_RELOC_DIRECT: // Absolute address { uintptr_t valu = (uintptr_t)p; for (unsigned i = 0; i < sizeof(uintptr_t); i++) { addressToWrite[i] = (byte)(valu & 255); valu >>= 8; } } break; case PROCESS_RELOC_I386RELATIVE: // 32 bit relative address { // This offset may be positive or negative intptr_t newDisp = (byte*)p - addressOfConstant - 4; #if (SIZEOF_VOIDP != 4) ASSERT(newDisp < (intptr_t)0x80000000 && newDisp >= -(intptr_t)0x80000000); #endif for (unsigned i = 0; i < 4; i++) { addressToWrite[i] = (byte)(newDisp & 0xff); newDisp >>= 8; } // When we have shifted it 32-bits the result there should // be no significant bits left. ASSERT(newDisp == 0 || newDisp == -1); } break; } } void ScanAddress::ScanConstant(PolyObject *base, byte *addressOfConstant, ScanRelocationKind code, intptr_t displacement) { PolyObject *p = GetConstantValue(addressOfConstant, code, displacement); if (p != 0) { PolyObject *oldValue = p; // If this was a relative address we must have a code address. if (code == PROCESS_RELOC_I386RELATIVE) ScanCodeAddressAt(&p); else p = ScanObjectAddress(p); if (p != oldValue) // Update it if it has changed. SetConstantValue(addressOfConstant, p, code); } } void ScanAddress::ScanRuntimeWord(PolyWord *w) { if (w->IsTagged()) {} // Don't need to do anything else { ASSERT(w->IsDataPtr()); *w = ScanObjectAddress(w->AsObjPtr()); } } diff --git a/libpolyml/x86_dep.cpp b/libpolyml/x86_dep.cpp index 5788529e..2bba5f1d 100644 --- a/libpolyml/x86_dep.cpp +++ b/libpolyml/x86_dep.cpp @@ -1,1546 +1,1562 @@ /* Title: Machine dependent code for i386 and X64 under Windows and Unix Copyright (c) 2000-7 Cambridge University Technical Services Limited - Further work copyright David C. J. Matthews 2011-20 + Further work copyright David C. J. Matthews 2011-21 This library is free software; you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License version 2.1 as published by the Free Software Foundation. This library is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for more details. You should have received a copy of the GNU Lesser General Public License along with this library; if not, write to the Free Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA */ #ifdef HAVE_CONFIG_H #include "config.h" #elif defined(_WIN32) #include "winconfig.h" #else #error "No configuration file" #endif #ifdef HAVE_STDLIB_H #include #endif #include #ifdef HAVE_SIGNAL_H #include #endif #ifdef HAVE_ASSERT_H #include #define ASSERT(x) assert(x) #else #define ASSERT(x) #endif #ifdef HAVE_STRING_H #include #endif #ifdef HAVE_ERRNO_H #include #endif #if (defined(_WIN32)) #include #include #endif #include "globals.h" #include "run_time.h" #include "diagnostics.h" #include "processes.h" #include "profiling.h" #include "machine_dep.h" #include "scanaddrs.h" #include "memmgr.h" #include "rtsentry.h" #include "bytecode.h" #include "sys.h" // Temporary /********************************************************************** * * Register usage: * * %Reax: First argument to function. Result of function call. * %Rebx: Second argument to function. * %Recx: General register * %Redx: Closure pointer in call. * %Rebp: Points to memory used for extra registers * %Resi: General register. * %Redi: General register. * %Resp: Stack pointer. * The following apply only on the X64 * %R8: Third argument to function * %R9: Fourth argument to function * %R10: Fifth argument to function * %R11: General register * %R12: General register * %R13: General register * %R14: General register * %R15: Memory allocation pointer * **********************************************************************/ #ifdef HOSTARCHITECTURE_X86_64 struct fpSaveArea { double fpregister[7]; // Save area for xmm0-6 }; #else // Structure of floating point save area. // This is dictated by the hardware. typedef byte fpregister[10]; struct fpSaveArea { unsigned short cw; unsigned short _unused0; unsigned short sw; unsigned short _unused1; unsigned short tw; unsigned short _unused2; unsigned fip; unsigned short fcs0; unsigned short _unused3; unsigned foo; unsigned short fcs1; unsigned short _unused4; fpregister registers[8]; }; #endif /* the amount of ML stack space to reserve for registers, C exception handling etc. The compiler requires us to reserve 2 stack-frames worth (2 * 20 words). We actually reserve slightly more than this. */ #if (!defined(_WIN32) && !defined(HAVE_SIGALTSTACK)) // If we can't handle signals on a separate stack make sure there's space // on the Poly stack. #define OVERFLOW_STACK_SIZE (50+1024) #else #define OVERFLOW_STACK_SIZE 50 #endif class X86TaskData; // This is passed as the argument vector to X86AsmSwitchToPoly. // The offsets are built into the assembly code and the code-generator. // localMpointer and stackPtr are updated before control returns to C. typedef struct _AssemblyArgs { public: PolyWord *localMpointer; // Allocation ptr + 1 word stackItem *handlerRegister; // Current exception handler PolyWord *localMbottom; // Base of memory + 1 word stackItem *stackLimit; // Lower limit of stack stackItem exceptionPacket; // Set if there is an exception byte unusedRequestCode; // No longer used. byte unusedFlag; // No longer used byte returnReason; // Reason for returning from ML. byte unusedRestore; // No longer used. uintptr_t saveCStack; // Saved C stack frame. PolyWord threadId; // My thread id. Saves having to call into RTS for it. stackItem *stackPtr; // Current stack pointer byte *enterInterpreter; // These are filled in with the functions. byte *heapOverFlowCall; byte *stackOverFlowCall; byte *stackOverFlowCallEx; byte *trapHandlerEntry; // Saved registers, where applicable. stackItem p_rax; stackItem p_rbx; stackItem p_rcx; stackItem p_rdx; stackItem p_rsi; stackItem p_rdi; #ifdef HOSTARCHITECTURE_X86_64 stackItem p_r8; stackItem p_r9; stackItem p_r10; stackItem p_r11; stackItem p_r12; stackItem p_r13; stackItem p_r14; #endif struct fpSaveArea p_fp; } AssemblyArgs; // These next few are temporarily added for the interpreter // This duplicates some code in reals.cpp but is now updated. #define DOUBLESIZE (sizeof(double)/sizeof(POLYUNSIGNED)) union realdb { double dble; POLYUNSIGNED puns[DOUBLESIZE]; }; #define LGWORDSIZE (sizeof(uintptr_t) / sizeof(PolyWord)) class X86TaskData: public TaskData, ByteCodeInterpreter { public: X86TaskData(); unsigned allocReg; // The register to take the allocated space. POLYUNSIGNED allocWords; // The words to allocate. AssemblyArgs assemblyInterface; int saveRegisterMask; // Registers that need to be updated by a GC. virtual void GarbageCollect(ScanAddress *process); void ScanStackAddress(ScanAddress *process, stackItem &val, StackSpace *stack); virtual void EnterPolyCode(); // Start running ML virtual void InterruptCode(); virtual bool AddTimeProfileCount(SIGNALCONTEXT *context); virtual void InitStackFrame(TaskData *parentTask, Handle proc); virtual void SetException(poly_exn *exc); // Release a mutex in exactly the same way as compiler code virtual POLYUNSIGNED AtomicDecrement(PolyObject* mutexp); // Reset a mutex to one. This needs to be atomic with respect to the // atomic increment and decrement instructions. virtual void AtomicReset(PolyObject* mutexp); // This is actually only used in the interpreter. virtual POLYUNSIGNED AtomicIncrement(PolyObject* mutexp); // Return the minimum space occupied by the stack. Used when setting a limit. // N.B. This is PolyWords not native words. virtual uintptr_t currentStackSpace(void) const { return (this->stack->top - (PolyWord*)assemblyInterface.stackPtr) + OVERFLOW_STACK_SIZE*sizeof(uintptr_t)/sizeof(PolyWord); } // Increment the profile count for an allocation. Also now used for mutex contention. virtual void addProfileCount(POLYUNSIGNED words) { addSynchronousCount(assemblyInterface.stackPtr[0].codeAddr, words); } // PreRTSCall: After calling from ML to the RTS we need to save the current heap pointer virtual void PreRTSCall(void) { TaskData::PreRTSCall(); SaveMemRegisters(); } // PostRTSCall: Before returning we need to restore the heap pointer. // If there has been a GC in the RTS call we need to create a new heap area. virtual void PostRTSCall(void) { SetMemRegisters(); TaskData::PostRTSCall(); } virtual void CopyStackFrame(StackObject *old_stack, uintptr_t old_length, StackObject *new_stack, uintptr_t new_length); void HeapOverflowTrap(byte *pcPtr); void StackOverflowTrap(uintptr_t space); void SetMemRegisters(); void SaveMemRegisters(); void SetRegisterMask(); void HandleTrap(); // ByteCode overrides. The interpreter and native code states need to be in sync. // The interpreter is only used during the initial bootstrap. virtual void ClearExceptionPacket() { assemblyInterface.exceptionPacket = TAGGED(0); } virtual PolyWord GetExceptionPacket() { return assemblyInterface.exceptionPacket; } virtual stackItem* GetHandlerRegister() { return assemblyInterface.handlerRegister; } virtual void SetHandlerRegister(stackItem* hr) { assemblyInterface.handlerRegister = hr; } // Check and grow the stack if necessary. Process any interupts. virtual void HandleStackOverflow(uintptr_t space) { StackOverflowTrap(space); } void Interpret(); void EndBootStrap() { mixedCode = true; } PLock interruptLock; stackItem *get_reg(int n); stackItem *®SP() { return assemblyInterface.stackPtr; } stackItem ®AX() { return assemblyInterface.p_rax; } stackItem ®BX() { return assemblyInterface.p_rbx; } stackItem ®CX() { return assemblyInterface.p_rcx; } stackItem ®DX() { return assemblyInterface.p_rdx; } stackItem ®SI() { return assemblyInterface.p_rsi; } stackItem ®DI() { return assemblyInterface.p_rdi; } #ifdef HOSTARCHITECTURE_X86_64 stackItem ®8() { return assemblyInterface.p_r8; } stackItem ®9() { return assemblyInterface.p_r9; } stackItem ®10() { return assemblyInterface.p_r10; } stackItem ®11() { return assemblyInterface.p_r11; } stackItem ®12() { return assemblyInterface.p_r12; } stackItem ®13() { return assemblyInterface.p_r13; } stackItem ®14() { return assemblyInterface.p_r14; } #endif #if (defined(_WIN32)) DWORD savedErrno; #else int savedErrno; #endif }; class X86Dependent: public MachineDependent { public: X86Dependent(): mustInterpret(false) {} // Create a task data object. virtual TaskData *CreateTaskData(void) { return new X86TaskData(); } // Initial size of stack in PolyWords virtual unsigned InitialStackSize(void) { return (128+OVERFLOW_STACK_SIZE) * sizeof(uintptr_t) / sizeof(PolyWord); } virtual void ScanConstantsWithinCode(PolyObject *addr, PolyObject *oldAddr, POLYUNSIGNED length, PolyWord* newConstAddr, PolyWord* oldConstAddr, POLYUNSIGNED numConsts, ScanAddress *process); virtual void SetBootArchitecture(char arch, unsigned wordLength); virtual Architectures MachineArchitecture(void); // During the first bootstrap phase this is interpreted. bool mustInterpret; + + // Override for X86-64 + // Find the start of the constant section for a piece of code. + virtual void GetConstSegmentForCode(PolyObject* obj, POLYUNSIGNED obj_length, PolyWord*& cp, POLYUNSIGNED& count) const + { + PolyWord* last_word = obj->Offset(obj_length - 1); // Last word in the code +#ifdef HOSTARCHITECTURE_X86_64 + // Only the low order 32-bits are valid since this may be + // set by a 32-bit relative relocation. + int32_t offset = (int32_t)last_word->AsSigned(); +#else + POLYSIGNED offset = last_word->AsSigned(); +#endif + cp = last_word + 1 + offset / sizeof(PolyWord); + count = cp[-1].AsUnsigned(); + } }; static X86Dependent x86Dependent; MachineDependent* machineDependent = &x86Dependent; Architectures X86Dependent::MachineArchitecture(void) { if (mustInterpret) return MA_Interpreted; #ifndef HOSTARCHITECTURE_X86_64 return MA_I386; #elif defined(POLYML32IN64) return MA_X86_64_32; #else return MA_X86_64; #endif } void X86Dependent::SetBootArchitecture(char arch, unsigned wordLength) { if (arch == 'I') mustInterpret = true; else if (arch != 'X') Crash("Boot file has unexpected architecture code: %c", arch); } // Values for the returnReason byte enum RETURN_REASON { RETURN_HEAP_OVERFLOW = 1, RETURN_STACK_OVERFLOW = 2, RETURN_STACK_OVERFLOWEX = 3, RETURN_ENTER_INTERPRETER = 4 }; extern "C" { // These are declared in the assembly code segment. void X86AsmSwitchToPoly(void *); int X86AsmCallExtraRETURN_ENTER_INTERPRETER(void); int X86AsmCallExtraRETURN_HEAP_OVERFLOW(void); int X86AsmCallExtraRETURN_STACK_OVERFLOW(void); int X86AsmCallExtraRETURN_STACK_OVERFLOWEX(void); void X86TrapHandler(PolyWord threadId); }; X86TaskData::X86TaskData(): ByteCodeInterpreter(&assemblyInterface.stackPtr, &assemblyInterface.stackLimit), allocReg(0), allocWords(0), saveRegisterMask(0) { assemblyInterface.enterInterpreter = (byte*)X86AsmCallExtraRETURN_ENTER_INTERPRETER; assemblyInterface.heapOverFlowCall = (byte*)X86AsmCallExtraRETURN_HEAP_OVERFLOW; assemblyInterface.stackOverFlowCall = (byte*)X86AsmCallExtraRETURN_STACK_OVERFLOW; assemblyInterface.stackOverFlowCallEx = (byte*)X86AsmCallExtraRETURN_STACK_OVERFLOWEX; assemblyInterface.trapHandlerEntry = (byte*)X86TrapHandler; savedErrno = 0; interpreterPc = 0; mixedCode = !x86Dependent.mustInterpret; } void X86TaskData::GarbageCollect(ScanAddress *process) { TaskData::GarbageCollect(process); // Process the parent first ByteCodeInterpreter::GarbageCollect(process); assemblyInterface.threadId = threadObject; if (stack != 0) { ASSERT(assemblyInterface.stackPtr >= (stackItem*)stack->bottom && assemblyInterface.stackPtr <= (stackItem*)stack->top); // Now the values on the stack. for (stackItem *q = assemblyInterface.stackPtr; q < (stackItem*)stack->top; q++) ScanStackAddress(process, *q, stack); } // Register mask for (int i = 0; i < 16; i++) { if (saveRegisterMask & (1 << i)) ScanStackAddress(process, *get_reg(i), stack); } } // Process a value within the stack. void X86TaskData::ScanStackAddress(ScanAddress *process, stackItem &stackItem, StackSpace *stack) { // We may have return addresses on the stack which could look like // tagged values. Check whether the value is in the code area before // checking whether it is untagged. #ifdef POLYML32IN64 // In 32-in-64 return addresses always have the top 32 bits non-zero. if (stackItem.argValue < ((uintptr_t)1 << 32)) { // It's either a tagged integer or an object pointer. if (stackItem.w().IsDataPtr()) { PolyWord val = process->ScanObjectAddress(stackItem.w().AsObjPtr()); stackItem = val; } } else { // Could be a code address or a stack address. MemSpace *space = gMem.SpaceForAddress(stackItem.codeAddr - 1); if (space == 0 || space->spaceType != ST_CODE) return; PolyObject *obj = gMem.FindCodeObject(stackItem.codeAddr); ASSERT(obj != 0); // Process the address of the start. Don't update anything. process->ScanObjectAddress(obj); } #else // The -1 here is because we may have a zero-sized cell in the last // word of a space. MemSpace *space = gMem.SpaceForAddress(stackItem.codeAddr-1); if (space == 0) return; // In particular we may have one of the assembly code addresses. if (space->spaceType == ST_CODE) { PolyObject *obj = gMem.FindCodeObject(stackItem.codeAddr); // If it is actually an integer it might be outside a valid code object. if (obj == 0) { ASSERT(stackItem.w().IsTagged()); // It must be an integer } else // Process the address of the start. Don't update anything. process->ScanObjectAddress(obj); } else if (space->spaceType == ST_LOCAL && stackItem.w().IsDataPtr()) // Local values must be word addresses. { PolyWord val = process->ScanObjectAddress(stackItem.w().AsObjPtr()); stackItem = val; } #endif } // Copy a stack void X86TaskData::CopyStackFrame(StackObject *old_stack, uintptr_t old_length, StackObject *new_stack, uintptr_t new_length) { /* Moves a stack, updating all references within the stack */ #ifdef POLYML32IN64 old_length = old_length / 2; new_length = new_length / 2; #endif stackItem *old_base = (stackItem *)old_stack; stackItem *new_base = (stackItem*)new_stack; stackItem *old_top = old_base + old_length; /* Calculate the offset of the new stack from the old. If the frame is being extended objects in the new frame will be further up the stack than in the old one. */ uintptr_t offset = new_base - old_base + new_length - old_length; stackItem *oldStackPtr = assemblyInterface.stackPtr; // Adjust the stack pointer and handler pointer since these point into the stack. assemblyInterface.stackPtr = assemblyInterface.stackPtr + offset; assemblyInterface.handlerRegister = assemblyInterface.handlerRegister + offset; // We need to adjust any values on the stack that are pointers within the stack. // Skip the unused part of the stack. size_t i = oldStackPtr - old_base; ASSERT (i <= old_length); i = old_length - i; stackItem *old = oldStackPtr; stackItem *newp = assemblyInterface.stackPtr; while (i--) { stackItem old_word = *old++; if (old_word.w().IsDataPtr() && old_word.stackAddr >= old_base && old_word.stackAddr <= old_top) old_word.stackAddr = old_word.stackAddr + offset; else if (old_word.w().IsDataPtr() && IsHeapAddress(old_word.stackAddr)) { stackItem *addr = (stackItem*)old_word.w().AsStackAddr(); if (addr >= old_base && addr <= old_top) { addr += offset; old_word = PolyWord::FromStackAddr((PolyWord*)addr); } } *newp++ = old_word; } ASSERT(old == ((stackItem*)old_stack)+old_length); ASSERT(newp == ((stackItem*)new_stack)+new_length); // And change any registers that pointed into the old stack for (int j = 0; j < 16; j++) { if (saveRegisterMask & (1 << j)) { stackItem *regAddr = get_reg(j); stackItem old_word = *regAddr; if (old_word.w().IsDataPtr() && old_word.stackAddr >= old_base && old_word.stackAddr <= old_top) old_word.stackAddr = old_word.stackAddr + offset; else if (old_word.w().IsDataPtr() && IsHeapAddress(old_word.stackAddr)) { stackItem *addr = (stackItem*)old_word.w().AsStackAddr(); if (addr >= old_base && addr <= old_top) { addr += offset; old_word = PolyWord::FromStackAddr((PolyWord*)addr); } } *regAddr = old_word; } } } void X86TaskData::EnterPolyCode() /* Called from "main" to enter the code. */ { if (x86Dependent.mustInterpret) { PolyWord closure = assemblyInterface.p_rdx; *(--assemblyInterface.stackPtr) = closure; /* Closure address */ interpreterPc = *(POLYCODEPTR*)closure.AsObjPtr(); Interpret(); ASSERT(0); // Should never return } SetMemRegisters(); // Enter the ML code. X86AsmSwitchToPoly(&this->assemblyInterface); // This should never return ASSERT(0); } void X86TaskData::Interpret() { while (true) { switch (RunInterpreter(this)) { case ReturnCall: // After the call there will be an enter-int instruction so that when this // returns we will re-enter the interpreter. The number of arguments for // this call is after that. ASSERT(interpreterPc[0] == 0xff); numTailArguments = interpreterPc[3]; case ReturnTailCall: { ClearExceptionPacket(); // Pop the closure. PolyWord closureWord = *assemblyInterface.stackPtr++; PolyObject* closure = closureWord.AsObjPtr(); interpreterPc = *(POLYCODEPTR*)closure; if (interpreterPc[0] == 0xff && interpreterPc[1] == 0x55 && (interpreterPc[2] == 0x48 || interpreterPc[2] == 0x24)) { // If the code we're going to is interpreted push back the closure and // continue. assemblyInterface.stackPtr--; continue; } assemblyInterface.p_rdx = closureWord; // Put closure in the closure reg. // Pop the return address. POLYCODEPTR originalReturn = (assemblyInterface.stackPtr++)->codeAddr; // Because of the way the build process works we only ever call functions with a single argument. ASSERT(numTailArguments == 1); assemblyInterface.p_rax = *(assemblyInterface.stackPtr++); (*(--assemblyInterface.stackPtr)).codeAddr = originalReturn; // Push return address to caller (*(--assemblyInterface.stackPtr)).codeAddr = *(POLYCODEPTR*)closure; // Entry point to callee interpreterPc = 0; // No longer in the interpreter (See SaveMemRegs) return; } case ReturnReturn: { ClearExceptionPacket(); if (interpreterPc[0] == 0xff && interpreterPc[1] == 0x55 && (interpreterPc[2] == 0x48 || interpreterPc[2] == 0x24)) continue; // Get the return value from the stack and replace it by the // address we're going to. assemblyInterface.p_rax = assemblyInterface.stackPtr[0]; assemblyInterface.stackPtr[0].codeAddr = interpreterPc; interpreterPc = 0; // No longer in the interpreter (See SaveMemRegs) return; } } } } // Called from the assembly code as a result of a trap i.e. a request for // a GC or to extend the stack. void X86TrapHandler(PolyWord threadId) { X86TaskData* taskData = (X86TaskData*)TaskData::FindTaskForId(threadId); taskData->HandleTrap(); } void X86TaskData::HandleTrap() { SaveMemRegisters(); // Update globals from the memory registers. switch (this->assemblyInterface.returnReason) { case RETURN_HEAP_OVERFLOW: // The heap has overflowed. SetRegisterMask(); this->HeapOverflowTrap(assemblyInterface.stackPtr[0].codeAddr); // Computes a value for allocWords only break; case RETURN_STACK_OVERFLOW: case RETURN_STACK_OVERFLOWEX: { SetRegisterMask(); uintptr_t min_size; // Size in PolyWords if (assemblyInterface.returnReason == RETURN_STACK_OVERFLOW) { min_size = (this->stack->top - (PolyWord*)assemblyInterface.stackPtr) + OVERFLOW_STACK_SIZE * sizeof(uintptr_t) / sizeof(PolyWord); } else { // Stack limit overflow. If the required stack space is larger than // the fixed overflow size the code will calculate the limit in %EDI. stackItem* stackP = regDI().stackAddr; min_size = (this->stack->top - (PolyWord*)stackP) + OVERFLOW_STACK_SIZE * sizeof(uintptr_t) / sizeof(PolyWord); } StackOverflowTrap(min_size); break; } case RETURN_ENTER_INTERPRETER: { interpreterPc = assemblyInterface.stackPtr[0].codeAddr; assemblyInterface.stackPtr++; // Pop return address. byte reasonCode = *interpreterPc++; // Sort out arguments. assemblyInterface.exceptionPacket = TAGGED(0); if (reasonCode == 0xff) { // Exception handler. ASSERT(0); // Not used assemblyInterface.exceptionPacket = assemblyInterface.p_rax; // Get the exception packet // We're already in the exception handler but we still have to // adjust the stack pointer and pop the current exception handler. assemblyInterface.stackPtr = assemblyInterface.handlerRegister; assemblyInterface.stackPtr++; assemblyInterface.handlerRegister = (assemblyInterface.stackPtr++)[0].stackAddr; } else if (reasonCode >= 128) { // Start of function. unsigned numArgs = reasonCode - 128; // We need the stack to contain: // The closure, the return address, the arguments. // First pop the original return address. POLYCODEPTR returnAddr = (assemblyInterface.stackPtr++)[0].codeAddr; // Push the register args. ASSERT(numArgs == 1); // We only ever call functions with one argument. #ifdef HOSTARCHITECTURE_X86_64 ASSERT(numArgs <= 5); if (numArgs >= 1) *(--assemblyInterface.stackPtr) = assemblyInterface.p_rax; #ifdef POLYML32IN64 if (numArgs >= 2) *(--assemblyInterface.stackPtr) = assemblyInterface.p_rsi; #else if (numArgs >= 2) *(--assemblyInterface.stackPtr) = assemblyInterface.p_rbx; #endif if (numArgs >= 3) *(--assemblyInterface.stackPtr) = assemblyInterface.p_r8; if (numArgs >= 4) *(--assemblyInterface.stackPtr) = assemblyInterface.p_r9; if (numArgs >= 5) *(--assemblyInterface.stackPtr) = assemblyInterface.p_r10; #else ASSERT(numArgs <= 2); if (numArgs >= 1) *(--assemblyInterface.stackPtr) = assemblyInterface.p_rax; if (numArgs >= 2) *(--assemblyInterface.stackPtr) = assemblyInterface.p_rbx; #endif (--assemblyInterface.stackPtr)[0].codeAddr = returnAddr; *(--assemblyInterface.stackPtr) = assemblyInterface.p_rdx; // Closure } else { // Return from call. Push RAX *(--assemblyInterface.stackPtr) = assemblyInterface.p_rax; } Interpret(); break; } default: Crash("Unknown return reason code %u", this->assemblyInterface.returnReason); } SetMemRegisters(); } void X86TaskData::StackOverflowTrap(uintptr_t space) { uintptr_t min_size = (this->stack->top - (PolyWord*)assemblyInterface.stackPtr) + OVERFLOW_STACK_SIZE + space; try { // The stack check has failed. This may either be because we really have // overflowed the stack or because the stack limit value has been adjusted // to result in a call here. CheckAndGrowStack(this, min_size); } catch (IOException&) { // We may get an exception while handling this if we run out of store } { PLocker l(&interruptLock); // Set the stack limit. This clears any interrupt and also sets the // correct value if we've grown the stack. assemblyInterface.stackLimit = (stackItem*)this->stack->bottom + OVERFLOW_STACK_SIZE; } try { processes->ProcessAsynchRequests(this); // Release and re-acquire use of the ML memory to allow another thread // to GC. processes->ThreadReleaseMLMemory(this); processes->ThreadUseMLMemory(this); } catch (IOException&) { } } void X86TaskData::InitStackFrame(TaskData *parentTaskData, Handle proc) /* Initialise stack frame. */ { StackSpace *space = this->stack; StackObject * newStack = space->stack(); uintptr_t stack_size = space->spaceSize() * sizeof(PolyWord) / sizeof(stackItem); // Set the top of the stack inside the stack rather than at the end. This wastes // a word but if sp is actually at the end OpenBSD segfaults because it isn't in // a MAP_STACK area. uintptr_t topStack = stack_size - 1; stackItem* stackTop = (stackItem*)newStack + topStack; *stackTop = TAGGED(0); // Set it to non-zero. assemblyInterface.stackPtr = stackTop; assemblyInterface.stackLimit = (stackItem*)space->bottom + OVERFLOW_STACK_SIZE; assemblyInterface.handlerRegister = stackTop; // Floating point save area. memset(&assemblyInterface.p_fp, 0, sizeof(struct fpSaveArea)); #ifndef HOSTARCHITECTURE_X86_64 // Set the control word for 64-bit precision otherwise we get inconsistent results. assemblyInterface.p_fp.cw = 0x027f ; // Control word assemblyInterface.p_fp.tw = 0xffff; // Tag registers - all unused #endif // Store the argument and the closure. assemblyInterface.p_rdx = proc->Word(); // Closure assemblyInterface.p_rax = TAGGED(0); // Argument // Have to set the register mask in case we get a GC before the thread starts. saveRegisterMask = (1 << 2) | 1; // Rdx and rax #ifdef POLYML32IN64 // In 32-in-64 RBX always contains the heap base address. assemblyInterface.p_rbx.stackAddr = (stackItem*)globalHeapBase; #endif } // In Solaris-x86 the registers are named EIP and ESP. #if (!defined(REG_EIP) && defined(EIP)) #define REG_EIP EIP #endif #if (!defined(REG_ESP) && defined(ESP)) #define REG_ESP ESP #endif // Get the PC and SP(stack) from a signal context. This is needed for profiling. // This version gets the actual sp and pc if we are in ML. // N.B. This must not call malloc since we're in a signal handler. bool X86TaskData::AddTimeProfileCount(SIGNALCONTEXT *context) { stackItem * sp = 0; POLYCODEPTR pc = 0; if (context != 0) { // The tests for HAVE_UCONTEXT_T, HAVE_STRUCT_SIGCONTEXT and HAVE_WINDOWS_H need // to follow the tests in processes.h. #if defined(HAVE_WINDOWS_H) #ifdef _WIN64 sp = (stackItem *)context->Rsp; pc = (POLYCODEPTR)context->Rip; #else // Windows 32 including cygwin. sp = (stackItem *)context->Esp; pc = (POLYCODEPTR)context->Eip; #endif #elif defined(HAVE_UCONTEXT_T) #ifdef HAVE_MCONTEXT_T_GREGS // Linux #ifndef HOSTARCHITECTURE_X86_64 pc = (byte*)context->uc_mcontext.gregs[REG_EIP]; sp = (stackItem*)context->uc_mcontext.gregs[REG_ESP]; #else /* HOSTARCHITECTURE_X86_64 */ pc = (byte*)context->uc_mcontext.gregs[REG_RIP]; sp = (stackItem*)context->uc_mcontext.gregs[REG_RSP]; #endif /* HOSTARCHITECTURE_X86_64 */ #elif defined(HAVE_MCONTEXT_T_MC_ESP) // FreeBSD #ifndef HOSTARCHITECTURE_X86_64 pc = (byte*)context->uc_mcontext.mc_eip; sp = (stackItem*)context->uc_mcontext.mc_esp; #else /* HOSTARCHITECTURE_X86_64 */ pc = (byte*)context->uc_mcontext.mc_rip; sp = (stackItem*)context->uc_mcontext.mc_rsp; #endif /* HOSTARCHITECTURE_X86_64 */ #else // Mac OS X #ifndef HOSTARCHITECTURE_X86_64 #if(defined(HAVE_STRUCT_MCONTEXT_SS)||defined(HAVE_STRUCT___DARWIN_MCONTEXT32_SS)) pc = (byte*)context->uc_mcontext->ss.eip; sp = (stackItem*)context->uc_mcontext->ss.esp; #elif(defined(HAVE_STRUCT___DARWIN_MCONTEXT32___SS)) pc = (byte*)context->uc_mcontext->__ss.__eip; sp = (stackItem*)context->uc_mcontext->__ss.__esp; #endif #else /* HOSTARCHITECTURE_X86_64 */ #if(defined(HAVE_STRUCT_MCONTEXT_SS)||defined(HAVE_STRUCT___DARWIN_MCONTEXT64_SS)) pc = (byte*)context->uc_mcontext->ss.rip; sp = (stackItem*)context->uc_mcontext->ss.rsp; #elif(defined(HAVE_STRUCT___DARWIN_MCONTEXT64___SS)) pc = (byte*)context->uc_mcontext->__ss.__rip; sp = (stackItem*)context->uc_mcontext->__ss.__rsp; #endif #endif /* HOSTARCHITECTURE_X86_64 */ #endif #elif defined(HAVE_STRUCT_SIGCONTEXT) #if defined(HOSTARCHITECTURE_X86_64) && defined(__OpenBSD__) // CPP defines missing in amd64/signal.h in OpenBSD pc = (byte*)context->sc_rip; sp = (stackItem*)context->sc_rsp; #else // !HOSTARCHITEXTURE_X86_64 || !defined(__OpenBSD__) pc = (byte*)context->sc_pc; sp = (stackItem*)context->sc_sp; #endif #endif } if (pc != 0) { // See if the PC we've got is an ML code address. MemSpace *space = gMem.SpaceForAddress(pc); if (space != 0 && (space->spaceType == ST_CODE || space->spaceType == ST_PERMANENT)) { incrementCountAsynch(pc); return true; } } // See if the sp value is in the current stack. if (sp >= (stackItem*)this->stack->bottom && sp < (stackItem*)this->stack->top) { // We may be in the assembly code. The top of the stack will be a return address. pc = sp[0].w().AsCodePtr(); MemSpace *space = gMem.SpaceForAddress(pc); if (space != 0 && (space->spaceType == ST_CODE || space->spaceType == ST_PERMANENT)) { incrementCountAsynch(pc); return true; } } // See if the value of regSP is a valid stack pointer. // This works if we happen to be in an RTS call using a "Full" call. // It doesn't work if we've used a "Fast" call because that doesn't save the SP. sp = assemblyInterface.stackPtr; if (sp >= (stackItem*)this->stack->bottom && sp < (stackItem*)this->stack->top) { // We may be in the run-time system. pc = sp[0].w().AsCodePtr(); MemSpace *space = gMem.SpaceForAddress(pc); if (space != 0 && (space->spaceType == ST_CODE || space->spaceType == ST_PERMANENT)) { incrementCountAsynch(pc); return true; } } // None of those worked return false; } // This is called from a different thread so we have to be careful. void X86TaskData::InterruptCode() { PLocker l(&interruptLock); // Set the stack limit pointer to the top of the stack to cause // a trap when we next check for stack overflow. // We use a lock here to ensure that we always use the current value of the // stack. The thread we're interrupting could be growing the stack at this point. if (this->stack != 0) this->assemblyInterface.stackLimit = (stackItem*)(this->stack->top-1); } // This is called from SwitchToPoly before we enter the ML code. void X86TaskData::SetMemRegisters() { // Copy the current store limits into variables before we go into the assembly code. // If we haven't yet set the allocation area or we don't have enough we need // to create one (or a new one). if (this->allocPointer <= this->allocLimit + this->allocWords) { if (this->allocPointer < this->allocLimit) Crash ("Bad length in heap overflow trap"); // Find some space to allocate in. Updates taskData->allocPointer and // returns a pointer to the newly allocated space (if allocWords != 0) PolyWord *space = processes->FindAllocationSpace(this, this->allocWords, true); if (space == 0) { // We will now raise an exception instead of returning. // Set allocWords to zero so we don't set the allocation register // since that could be holding the exception packet. this->allocWords = 0; } // Undo the allocation just now. this->allocPointer += this->allocWords; } if (this->allocWords != 0) { // If we have had a heap trap we actually do the allocation here. // We will have already garbage collected and recovered sufficient space. // This also happens if we have just trapped because of store profiling. this->allocPointer -= this->allocWords; // Now allocate // Set the allocation register to this area. N.B. This is an absolute address. if (this->allocReg < 15) get_reg(this->allocReg)[0].codeAddr = (POLYCODEPTR)(this->allocPointer + 1); /* remember: it's off-by-one */ this->allocWords = 0; } // If we have run out of store, either just above or while allocating in the RTS, // allocPointer and allocLimit will have been set to zero as part of the GC. We will // now be raising an exception which may free some store but we need to come back here // before we allocate anything. The compiled code uses unsigned arithmetic to check for // heap overflow but only after subtracting the space required. We need to make sure // that the values are still non-negative after substracting any object size. if (this->allocPointer == 0) this->allocPointer += MAX_OBJECT_SIZE; if (this->allocLimit == 0) this->allocLimit += MAX_OBJECT_SIZE; this->assemblyInterface.localMbottom = this->allocLimit + 1; this->assemblyInterface.localMpointer = this->allocPointer + 1; // If we are profiling store allocation we set mem_hl so that a trap // will be generated. if (profileMode == kProfileStoreAllocation) this->assemblyInterface.localMbottom = this->assemblyInterface.localMpointer; this->assemblyInterface.threadId = this->threadObject; } // This is called whenever we have returned from ML to C. void X86TaskData::SaveMemRegisters() { if (interpreterPc == 0) // Not if we're already in the interpreter this->allocPointer = this->assemblyInterface.localMpointer - 1; this->allocWords = 0; this->assemblyInterface.exceptionPacket = TAGGED(0); this->saveRegisterMask = 0; } // Called on a GC or stack overflow trap. The register mask // is in the bytes after the trap call. void X86TaskData::SetRegisterMask() { byte *pc = assemblyInterface.stackPtr[0].codeAddr; if (*pc == 0xcd) // CD - INT n is used for a single byte { pc++; saveRegisterMask = *pc++; } else if (*pc == 0xca) // CA - FAR RETURN is used for a two byte mask { pc++; saveRegisterMask = pc[0] | (pc[1] << 8); pc += 2; } assemblyInterface.stackPtr[0].codeAddr = pc; } stackItem *X86TaskData::get_reg(int n) /* Returns a pointer to the register given by n. */ { switch (n) { case 0: return &assemblyInterface.p_rax; case 1: return &assemblyInterface.p_rcx; case 2: return &assemblyInterface.p_rdx; case 3: return &assemblyInterface.p_rbx; // Should not have rsp or rbp. case 6: return &assemblyInterface.p_rsi; case 7: return &assemblyInterface.p_rdi; #ifdef HOSTARCHITECTURE_X86_64 case 8: return &assemblyInterface.p_r8; case 9: return &assemblyInterface.p_r9; case 10: return &assemblyInterface.p_r10; case 11: return &assemblyInterface.p_r11; case 12: return &assemblyInterface.p_r12; case 13: return &assemblyInterface.p_r13; case 14: return &assemblyInterface.p_r14; // R15 is the heap pointer so shouldn't occur here. #endif /* HOSTARCHITECTURE_X86_64 */ default: Crash("Unknown register %d\n", n); } } // Called as a result of a heap overflow trap void X86TaskData::HeapOverflowTrap(byte *pcPtr) { X86TaskData *mdTask = this; POLYUNSIGNED wordsNeeded = 0; // The next instruction, after any branches round forwarding pointers or pop // instructions, will be a store of register containing the adjusted heap pointer. // We need to find that register and the value in it in order to find out how big // the area we actually wanted is. N.B. The code-generator and assembly code // must generate the correct instruction sequence. // byte *pcPtr = assemblyInterface.programCtr; while (true) { if (pcPtr[0] == 0xeb) { // Forwarding pointer if (pcPtr[1] >= 128) pcPtr += 256 - pcPtr[1] + 2; else pcPtr += pcPtr[1] + 2; } else if ((pcPtr[0] & 0xf8) == 0x58) // Pop instruction. pcPtr++; else if (pcPtr[0] == 0x41 && ((pcPtr[1] & 0xf8) == 0x58)) // Pop with Rex prefix pcPtr += 2; else break; } #ifndef HOSTARCHITECTURE_X86_64 // This should be movl REG,0[%ebp]. ASSERT(pcPtr[0] == 0x89); mdTask->allocReg = (pcPtr[1] >> 3) & 7; // Remember this until we allocate the memory stackItem *reg = get_reg(mdTask->allocReg); stackItem reg_val = *reg; // The space we need is the difference between this register // and the current value of newptr. // The +1 here is because assemblyInterface.localMpointer is A.M.pointer +1. The reason // is that after the allocation we have the register pointing at the address we will // actually use. wordsNeeded = (this->allocPointer - (PolyWord*)reg_val.stackAddr) + 1; *reg = TAGGED(0); // Clear this - it's not a valid address. /* length in words, including length word */ ASSERT (wordsNeeded <= (1<<24)); /* Max object size including length/flag word is 2^24 words. */ #else /* HOSTARCHITECTURE_X86_64 */ ASSERT(pcPtr[1] == 0x89 || pcPtr[1] == 0x8b); if (pcPtr[1] == 0x89) { // New (5.4) format. This should be movq REG,%r15 ASSERT(pcPtr[0] == 0x49 || pcPtr[0] == 0x4d); mdTask->allocReg = (pcPtr[2] >> 3) & 7; // Remember this until we allocate the memory if (pcPtr[0] & 0x4) mdTask->allocReg += 8; } else { // Alternative form of movq REG,%r15 ASSERT(pcPtr[0] == 0x4c || pcPtr[0] == 0x4d); mdTask->allocReg = pcPtr[2] & 7; // Remember this until we allocate the memory if (pcPtr[0] & 0x1) mdTask->allocReg += 8; } stackItem *reg = get_reg(this->allocReg); stackItem reg_val = *reg; wordsNeeded = (POLYUNSIGNED)((this->allocPointer - (PolyWord*)reg_val.stackAddr) + 1); *reg = TAGGED(0); // Clear this - it's not a valid address. #endif /* HOSTARCHITECTURE_X86_64 */ if (profileMode == kProfileStoreAllocation) addProfileCount(wordsNeeded); mdTask->allocWords = wordsNeeded; // The actual allocation is done in SetMemRegisters. } void X86TaskData::SetException(poly_exn *exc) // The RTS wants to raise an exception packet. Normally this is as the // result of an RTS call in which case the caller will check this. It can // also happen in a trap. { assemblyInterface.exceptionPacket = (PolyWord)exc; // Set for direct calls. } // Decode and process an effective address. There may // be a constant address in here but in any case we need // to decode it to work out where the next instruction starts. // If this is an lea instruction any addresses are just constants // so must not be treated as addresses. static void skipea(PolyObject *base, byte *&pt, ScanAddress *process, bool lea, PolyWord* oldConstAddr, POLYUNSIGNED numCodeWords, POLYSIGNED constAdjustment) { unsigned int modrm = *(pt++); unsigned int md = modrm >> 6; unsigned int rm = modrm & 7; if (md == 3) { } /* Register. */ else if (rm == 4) { /* s-i-b present. */ unsigned int sib = *(pt++); if (md == 0) { if ((sib & 7) == 5) { // Absolute address on X86, PC-relative on X64 if (! lea) { #ifdef HOSTARCHITECTURE_X86_64 if (constAdjustment != 0) { POLYSIGNED disp = (pt[3] & 0x80) ? -1 : 0; // Set the sign just in case. for (unsigned i = 4; i > 0; i--) disp = (disp << 8) | pt[i - 1]; if (pt + disp > (byte*)base + numCodeWords * sizeof(PolyWord)) { disp += constAdjustment; byte* wr = gMem.SpaceForAddress(pt)->writeAble(pt); for (unsigned i = 0; i < 4; i++) { wr[i] = (byte)(disp & 0xff); disp >>= 8; } ASSERT(disp == 0 || disp == -1); } } process->RelocateOnly(base, pt, PROCESS_RELOC_I386RELATIVE); #else process->ScanConstant(base, pt, PROCESS_RELOC_DIRECT); #endif /* HOSTARCHITECTURE_X86_64 */ } pt += 4; } } else if (md == 1) pt++; else if (md == 2) pt += 4; } else if (md == 0 && rm == 5) { // Absolute address on X86, PC-relative on X64 if (!lea) { #ifdef HOSTARCHITECTURE_X86_64 if (constAdjustment != 0) { POLYSIGNED disp = (pt[3] & 0x80) ? -1 : 0; // Set the sign just in case. for (unsigned i = 4; i > 0; i--) disp = (disp << 8) | pt[i - 1]; if (pt + disp > (byte*)base + numCodeWords * sizeof(PolyWord)) { disp += constAdjustment; byte* wr = gMem.SpaceForAddress(pt)->writeAble(pt); for (unsigned i = 0; i < 4; i++) { wr[i] = (byte)(disp & 0xff); disp >>= 8; } ASSERT(disp == 0 || disp == -1); } } process->RelocateOnly(base, pt, PROCESS_RELOC_I386RELATIVE); #else process->ScanConstant(base, pt, PROCESS_RELOC_DIRECT); #endif /* HOSTARCHITECTURE_X86_64 */ } pt += 4; } else { if (md == 1) pt += 1; else if (md == 2) pt += 4; } } /* Added to deal with constants within the code rather than in the constant area. The constant area is still needed for the function name. DCJM 2/1/2001 */ void X86Dependent::ScanConstantsWithinCode(PolyObject *addr, PolyObject *old, POLYUNSIGNED length, PolyWord* newConstAddr, PolyWord* oldConstAddr, POLYUNSIGNED numConsts, ScanAddress *process) { byte *pt = (byte*)addr; PolyWord *end = addr->Offset(length - 1); // If we have constants and code in separate areas then we will have to // adjust the offsets of constants in the constant area. // There are also offsets to non-address constants and these must // not be altered. POLYUNSIGNED numCodeWords = length - 1; if (oldConstAddr > (PolyWord*)old && oldConstAddr < ((PolyWord*)old) + length) numCodeWords -= numConsts; POLYSIGNED constAdjustment = (byte*)newConstAddr - (byte*)addr - ((byte*)oldConstAddr - (byte*)old); #ifdef HOSTARCHITECTURE_X86_64 // Put in a relocation for the offset itself if necessary. process->RelocateOnly(addr, (byte*)end, PROCESS_RELOC_I386RELATIVE); // There's a problem if the code and constant areas are allocated too // far apart that the offsets exceeed 32-bits. For testing just // include this assertion. ASSERT(constAdjustment >= -(POLYSIGNED)0x80000000 && constAdjustment <= 0x7fffffff); #endif // If this begins with enter-int it's interpreted code - ignore if (pt[0] == 0xff && pt[1] == 0x55 && (pt[2] == 0x48 || pt[2] == 0x24)) return; while (true) { // Escape prefixes come before any Rex byte if (*pt == 0xf2 || *pt == 0xf3 || *pt == 0x66) pt++; #ifdef HOSTARCHITECTURE_X86_64 // REX prefixes. Set this first. byte lastRex; if (*pt >= 0x40 && *pt <= 0x4f) lastRex = *pt++; else lastRex = 0; //printf("pt=%p *pt=%x\n", pt, *pt); #endif /* HOSTARCHITECTURE_X86_64 */ switch (*pt) { case 0x00: return; // This is actually the first byte of the old "marker" word. case 0xf4: return; // Halt - now used as a marker. case 0x50: case 0x51: case 0x52: case 0x53: case 0x54: case 0x55: case 0x56: case 0x57: /* Push */ case 0x58: case 0x59: case 0x5a: case 0x5b: case 0x5c: case 0x5d: case 0x5e: case 0x5f: /* Pop */ case 0x90: /* nop */ case 0xc3: /* ret */ case 0xf9: /* stc */ case 0xce: /* into */ case 0xf0: /* lock. */ case 0xf3: /* rep/repe */ case 0xa4: case 0xa5: case 0xaa: case 0xab: /* movs/stos */ case 0xa6: /* cmpsb */ case 0x9e: /* sahf */ case 0x99: /* cqo/cdq */ pt++; break; case 0x70: case 0x71: case 0x72: case 0x73: case 0x74: case 0x75: case 0x76: case 0x77: case 0x78: case 0x79: case 0x7a: case 0x7b: case 0x7c: case 0x7d: case 0x7e: case 0x7f: case 0xeb: /* short jumps. */ case 0xcd: /* INT - now used for a register mask */ case 0xa8: /* TEST_ACC8 */ case 0x6a: /* PUSH_8 */ pt += 2; break; case 0xc2: /* RET_16 */ case 0xca: /* FAR RET 16 - used for a register mask */ pt += 3; break; case 0x8d: /* leal. */ pt++; skipea(addr, pt, process, true, oldConstAddr, numCodeWords, constAdjustment); break; case 0x03: case 0x0b: case 0x13: case 0x1b: case 0x23: case 0x2b: case 0x33: case 0x3b: /* Add r,ea etc. */ case 0x88: /* MOVB_R_A */ case 0x89: /* MOVL_R_A */ case 0x8b: /* MOVL_A_R */ case 0x62: /* BOUNDL */ case 0xff: /* Group5 */ case 0xd1: /* Group2_1_A */ case 0x8f: /* POP_A */ case 0xd3: /* Group2_CL_A */ case 0x87: // XCHNG case 0x63: // MOVSXD pt++; skipea(addr, pt, process, false, oldConstAddr, numCodeWords, constAdjustment); break; case 0xf6: /* Group3_a */ { int isTest = 0; pt++; /* The test instruction has an immediate operand. */ if ((*pt & 0x38) == 0) isTest = 1; skipea(addr, pt, process, false, oldConstAddr, numCodeWords, constAdjustment); if (isTest) pt++; break; } case 0xf7: /* Group3_A */ { int isTest = 0; pt++; /* The test instruction has an immediate operand. */ if ((*pt & 0x38) == 0) isTest = 1; skipea(addr, pt, process, false, oldConstAddr, numCodeWords, constAdjustment); if (isTest) pt += 4; break; } case 0xc1: /* Group2_8_A */ case 0xc6: /* MOVB_8_A */ case 0x83: /* Group1_8_A */ case 0x80: /* Group1_8_a */ case 0x6b: // IMUL Ev,Ib pt++; skipea(addr, pt, process, false, oldConstAddr, numCodeWords, constAdjustment); pt++; break; case 0x69: // IMUL Ev,Iv pt++; skipea(addr, pt, process, false, oldConstAddr, numCodeWords, constAdjustment); pt += 4; break; case 0x81: /* Group1_32_A */ { pt ++; #ifndef HOSTARCHITECTURE_X86_64 unsigned opCode = *pt; #endif skipea(addr, pt, process, false, oldConstAddr, numCodeWords, constAdjustment); // Only check the 32 bit constant if this is a comparison. // For other operations this may be untagged and shouldn't be an address. #ifndef HOSTARCHITECTURE_X86_64 if ((opCode & 0x38) == 0x38) process->ScanConstant(addr, pt, PROCESS_RELOC_DIRECT); #endif pt += 4; break; } case 0xe8: case 0xe9: // Long jump and call. These are used to call constant (known) functions // and also long jumps within the function. { pt++; POLYSIGNED disp = (pt[3] & 0x80) ? -1 : 0; // Set the sign just in case. for(unsigned i = 4; i > 0; i--) disp = (disp << 8) | pt[i-1]; byte *absAddr = pt + disp + 4; // The address is relative to AFTER the constant // If the new address is within the current piece of code we don't do anything if (absAddr >= (byte*)addr && absAddr < (byte*)end) {} else process->ScanConstant(addr, pt, PROCESS_RELOC_I386RELATIVE, (byte*)old- (byte*)addr); pt += 4; break; } case 0xc7:/* MOVL_32_A */ { pt++; if ((*pt & 0xc0) == 0x40 /* Byte offset or sib present */ && ((*pt & 7) != 4) /* But not sib present */ && pt[1] == 256-sizeof(PolyWord)) { /* We may use a move instruction to set the length word on a new segment. We mustn't try to treat this as a constant. */ pt += 6; /* Skip the modrm byte, the offset and the constant. */ } else { skipea(addr, pt, process, false, oldConstAddr, numCodeWords, constAdjustment); #ifndef HOSTARCHITECTURE_X86_64 // This isn't used for addresses even in 32-in-64 process->ScanConstant(addr, pt, PROCESS_RELOC_DIRECT); #endif /* HOSTARCHITECTURE_X86_64 */ pt += 4; } break; } case 0xb8: case 0xb9: case 0xba: case 0xbb: case 0xbc: case 0xbd: case 0xbe: case 0xbf: /* MOVL_32_64_R */ pt ++; #ifdef HOSTARCHITECTURE_X86_64 if ((lastRex & 8) == 0) pt += 4; // 32-bit mode on 64-bits else #endif /* HOSTARCHITECTURE_X86_64 */ { // This is used in native 32-bit for constants and in // 32-in-64 for the special case of an absolute address. process->ScanConstant(addr, pt, PROCESS_RELOC_DIRECT); pt += sizeof(uintptr_t); } break; case 0x68: /* PUSH_32 */ pt ++; #if (!defined(HOSTARCHITECTURE_X86_64)) process->ScanConstant(addr, pt, PROCESS_RELOC_DIRECT); #endif pt += 4; break; case 0x0f: /* ESCAPE */ { pt++; switch (*pt) { case 0xb6: /* movzl */ case 0xb7: // movzw case 0xbe: // movsx case 0xbf: // movsx case 0xc1: /* xaddl */ case 0xae: // ldmxcsr/stmxcsr case 0xaf: // imul case 0x40: case 0x41: case 0x42: case 0x43: case 0x44: case 0x45: case 0x46: case 0x47: case 0x48: case 0x49: case 0x4a: case 0x4b: case 0x4c: case 0x4d: case 0x4e: case 0x4f: // cmov pt++; skipea(addr, pt, process, false, oldConstAddr, numCodeWords, constAdjustment); break; case 0x80: case 0x81: case 0x82: case 0x83: case 0x84: case 0x85: case 0x86: case 0x87: case 0x88: case 0x89: case 0x8a: case 0x8b: case 0x8c: case 0x8d: case 0x8e: case 0x8f: /* Conditional branches with 32-bit displacement. */ pt += 5; break; case 0x90: case 0x91: case 0x92: case 0x93: case 0x94: case 0x95: case 0x96: case 0x97: case 0x98: case 0x99: case 0x9a: case 0x9b: case 0x9c: case 0x9d: case 0x9e: case 0x9f: /* SetCC. */ pt++; skipea(addr, pt, process, false, oldConstAddr, numCodeWords, constAdjustment); break; // These are SSE2 instructions case 0x10: case 0x11: case 0x58: case 0x5c: case 0x59: case 0x5e: case 0x2e: case 0x2a: case 0x54: case 0x57: case 0x5a: case 0x6e: case 0x7e: case 0x2c: case 0x2d: pt++; skipea(addr, pt, process, false, oldConstAddr, numCodeWords, constAdjustment); break; case 0x73: // PSRLDQ - EA,imm pt++; skipea(addr, pt, process, false, oldConstAddr, numCodeWords, constAdjustment); pt++; break; default: Crash("Unknown opcode %d at %p\n", *pt, pt); } break; } case 0xd8: case 0xd9: case 0xda: case 0xdb: case 0xdc: case 0xdd: case 0xde: case 0xdf: // Floating point escape instructions { pt++; if ((*pt & 0xe0) == 0xe0) pt++; else skipea(addr, pt, process, false, oldConstAddr, numCodeWords, constAdjustment); break; } default: Crash("Unknown opcode %d at %p\n", *pt, pt); } } } #if defined(_MSC_VER) // This saves having to define it in the MASM assembly code. static POLYUNSIGNED X86AsmAtomicExchangeAndAdd(PolyObject* mutexp, POLYSIGNED addend) { # if (SIZEOF_POLYWORD == 8) return InterlockedExchangeAdd64((LONG64*)mutexp, addend); # else return InterlockedExchangeAdd((LONG*)mutexp, addend); # endif } #else extern "C" { // This is only defined in the GAS assembly code POLYUNSIGNED X86AsmAtomicExchangeAndAdd(PolyObject*, POLYSIGNED); } #endif // Decrement the value contained in the first word of the mutex. // The addend is TAGGED(+/-1) - 1 POLYUNSIGNED X86TaskData::AtomicDecrement(PolyObject *mutexp) { return X86AsmAtomicExchangeAndAdd(mutexp, -2) - 2; } // Increment the value contained in the first word of the mutex. POLYUNSIGNED X86TaskData::AtomicIncrement(PolyObject* mutexp) { return X86AsmAtomicExchangeAndAdd(mutexp, 2) + 2; } // Release a mutex. Because the atomic increment and decrement // use the hardware LOCK prefix we can simply set this to zero. void X86TaskData::AtomicReset(PolyObject* mutexp) { mutexp->Set(0, TAGGED(0)); } extern "C" { POLYEXTERNALSYMBOL void *PolyX86GetThreadData(); POLYEXTERNALSYMBOL POLYUNSIGNED PolyInterpretedEnterIntMode(); POLYEXTERNALSYMBOL POLYUNSIGNED PolyEndBootstrapMode(FirstArgument threadId, PolyWord function); POLYEXTERNALSYMBOL POLYUNSIGNED PolyX86IsLocalCode(PolyObject* destination); } // Return the address of assembly data for the current thread. This is normally in // RBP except if we are in a callback. void *PolyX86GetThreadData() { // We should get the task data for the thread that is running this code. // If this thread has been created by the foreign code we will have to // create a new one here. TaskData* taskData = processes->GetTaskDataForThread(); if (taskData == 0) { try { taskData = processes->CreateNewTaskData(); } catch (std::bad_alloc&) { ::Exit("Unable to create thread data - insufficient memory"); } catch (MemoryException&) { ::Exit("Unable to create thread data - insufficient memory"); } } return &((X86TaskData*)taskData)->assemblyInterface; } // Do we require EnterInt instructions and if so for which architecture? // 0 = > None; 1 => X86_32, 2 => X86_64. 3 => X86_32_in_64. POLYUNSIGNED PolyInterpretedEnterIntMode() { #ifdef POLYML32IN64 return TAGGED(3).AsUnsigned(); #elif defined(HOSTARCHITECTURE_X86_64) return TAGGED(2).AsUnsigned(); #else return TAGGED(1).AsUnsigned(); #endif } // End bootstrap mode and run a new function. POLYUNSIGNED PolyEndBootstrapMode(FirstArgument threadId, PolyWord function) { TaskData* taskData = TaskData::FindTaskForId(threadId); ASSERT(taskData != 0); taskData->PreRTSCall(); Handle pushedFunction = taskData->saveVec.push(function); x86Dependent.mustInterpret = false; ((X86TaskData*)taskData)->EndBootStrap(); taskData->InitStackFrame(taskData, pushedFunction); taskData->EnterPolyCode(); // Should never return. ASSERT(0); return TAGGED(0).AsUnsigned(); } // Test whether the target is within the local code area. This is only used on // native 64-bits. A call/jump to local code can use a 32-bit displacement // whereas a call/jump to a function in the executable will need to use an // indirect reference through the code area. POLYUNSIGNED PolyX86IsLocalCode(PolyObject* destination) { MemSpace* space = gMem.SpaceForObjectAddress(destination); if (space->spaceType == ST_CODE) return TAGGED(1).AsUnsigned(); else return TAGGED(0).AsUnsigned(); } struct _entrypts machineSpecificEPT[] = { { "PolyX86GetThreadData", (polyRTSFunction)&PolyX86GetThreadData }, { "PolyInterpretedEnterIntMode", (polyRTSFunction)&PolyInterpretedEnterIntMode }, { "PolyEndBootstrapMode", (polyRTSFunction)&PolyEndBootstrapMode }, { "PolyX86IsLocalCode", (polyRTSFunction)&PolyX86IsLocalCode }, { NULL, NULL} // End of list. };