1/* 2 Title: exporter.cpp - Export a function as an object or C file 3 4 Copyright (c) 2006-7, 2015, 2016-20 David C.J. Matthews 5 6 This library is free software; you can redistribute it and/or 7 modify it under the terms of the GNU Lesser General Public 8 License version 2.1 as published by the Free Software Foundation. 9 10 This library is distributed in the hope that it will be useful, 11 but WITHOUT ANY WARRANTY; without even the implied warranty of 12 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 13 Lesser General Public License for more details. 14 15 You should have received a copy of the GNU Lesser General Public 16 License along with this library; if not, write to the Free Software 17 Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA 18 19*/ 20 21#ifdef HAVE_CONFIG_H 22#include "config.h" 23#elif defined(_WIN32) 24#include "winconfig.h" 25#else 26#error "No configuration file" 27#endif 28 29#ifdef HAVE_ASSERT_H 30#include <assert.h> 31#define ASSERT(x) assert(x) 32 33#else 34#define ASSERT(x) 35#endif 36 37#ifdef HAVE_STRING_H 38#include <string.h> 39#endif 40 41#ifdef HAVE_ERRNO_H 42#include <errno.h> 43#endif 44 45#ifdef HAVE_SYS_PARAM_H 46#include <sys/param.h> 47#endif 48 49#ifdef HAVE_STDLIB_H 50#include <stdlib.h> 51#endif 52 53#if (defined(_WIN32)) 54#include <tchar.h> 55#else 56#define _T(x) x 57#define _tcslen strlen 58#define _tcscmp strcmp 59#define _tcscat strcat 60#endif 61 62#include "exporter.h" 63#include "save_vec.h" 64#include "polystring.h" 65#include "run_time.h" 66#include "osmem.h" 67#include "scanaddrs.h" 68#include "gc.h" 69#include "machine_dep.h" 70#include "diagnostics.h" 71#include "memmgr.h" 72#include "processes.h" // For IO_SPACING 73#include "sys.h" // For EXC_Fail 74#include "rtsentry.h" 75 76#include "pexport.h" 77 78#ifdef HAVE_PECOFF 79#include "pecoffexport.h" 80#elif defined(HAVE_ELF_H) || defined(HAVE_ELF_ABI_H) 81#include "elfexport.h" 82#elif defined(HAVE_MACH_O_RELOC_H) 83#include "machoexport.h" 84#endif 85 86#if (defined(_WIN32)) 87#define NOMEMORY ERROR_NOT_ENOUGH_MEMORY 88#define ERRORNUMBER _doserrno 89#else 90#define NOMEMORY ENOMEM 91#define ERRORNUMBER errno 92#endif 93 94extern "C" { 95 POLYEXTERNALSYMBOL POLYUNSIGNED PolyExport(FirstArgument threadId, PolyWord fileName, PolyWord root); 96 POLYEXTERNALSYMBOL POLYUNSIGNED PolyExportPortable(FirstArgument threadId, PolyWord fileName, PolyWord root); 97} 98 99/* 100To export the function and everything reachable from it we need to copy 101all the objects into a new area. We leave tombstones in the original 102objects by overwriting the length word. That prevents us from copying an 103object twice and breaks loops. Once we've copied the objects we then 104have to go back over the memory and turn the tombstones back into length 105words. 106*/ 107 108GraveYard::~GraveYard() 109{ 110 free(graves); 111} 112 113// Used to calculate the space required for the ordinary mutables 114// and the no-overwrite mutables. They are interspersed in local space. 115class MutSizes : public ScanAddress 116{ 117public: 118 MutSizes() : mutSize(0), noOverSize(0) {} 119 120 virtual PolyObject *ScanObjectAddress(PolyObject *base) { return base; }// No Actually used 121 122 virtual void ScanAddressesInObject(PolyObject *base, POLYUNSIGNED lengthWord) 123 { 124 const POLYUNSIGNED words = OBJ_OBJECT_LENGTH(lengthWord) + 1; // Include length word 125 if (OBJ_IS_NO_OVERWRITE(lengthWord)) 126 noOverSize += words; 127 else mutSize += words; 128 } 129 130 POLYUNSIGNED mutSize, noOverSize; 131}; 132 133CopyScan::CopyScan(unsigned h/*=0*/): hierarchy(h) 134{ 135 defaultImmSize = defaultMutSize = defaultCodeSize = defaultNoOverSize = 0; 136 tombs = 0; 137 graveYard = 0; 138} 139 140void CopyScan::initialise(bool isExport/*=true*/) 141{ 142 ASSERT(gMem.eSpaces.size() == 0); 143 // Set the space sizes to a proportion of the space currently in use. 144 // Computing these sizes is not obvious because CopyScan is used both 145 // for export and for saved states. For saved states in particular we 146 // want to use a smaller size because they are retained after we save 147 // the state and if we have many child saved states it's important not 148 // to waste memory. 149 if (hierarchy == 0) 150 { 151 graveYard = new GraveYard[gMem.pSpaces.size()]; 152 if (graveYard == 0) 153 { 154 if (debugOptions & DEBUG_SAVING) 155 Log("SAVE: Unable to allocate graveyard, size: %lu.\n", gMem.pSpaces.size()); 156 throw MemoryException(); 157 } 158 } 159 160 for (std::vector<PermanentMemSpace*>::iterator i = gMem.pSpaces.begin(); i < gMem.pSpaces.end(); i++) 161 { 162 PermanentMemSpace *space = *i; 163 if (space->hierarchy >= hierarchy) { 164 // Include this if we're exporting (hierarchy=0) or if we're saving a state 165 // and will include this in the new state. 166 size_t size = (space->top-space->bottom)/4; 167 if (space->noOverwrite) 168 defaultNoOverSize += size; 169 else if (space->isMutable) 170 defaultMutSize += size; 171 else if (space->isCode) 172 defaultCodeSize += size; 173 else 174 defaultImmSize += size; 175 if (space->hierarchy == 0 && ! space->isMutable) 176 { 177 // We need a separate area for the tombstones because this is read-only 178 graveYard[tombs].graves = (PolyWord*)calloc(space->spaceSize(), sizeof(PolyWord)); 179 if (graveYard[tombs].graves == 0) 180 { 181 if (debugOptions & DEBUG_SAVING) 182 Log("SAVE: Unable to allocate graveyard for permanent space, size: %lu.\n", 183 space->spaceSize() * sizeof(PolyWord)); 184 throw MemoryException(); 185 } 186 if (debugOptions & DEBUG_SAVING) 187 Log("SAVE: Allocated graveyard for permanent space, %p size: %lu.\n", 188 graveYard[tombs].graves, space->spaceSize() * sizeof(PolyWord)); 189 graveYard[tombs].startAddr = space->bottom; 190 graveYard[tombs].endAddr = space->top; 191 tombs++; 192 } 193 } 194 } 195 for (std::vector<LocalMemSpace*>::iterator i = gMem.lSpaces.begin(); i < gMem.lSpaces.end(); i++) 196 { 197 LocalMemSpace *space = *i; 198 uintptr_t size = space->allocatedSpace(); 199 // It looks as though the mutable size generally gets 200 // overestimated while the immutable size is correct. 201 if (space->isMutable) 202 { 203 MutSizes sizeMut; 204 sizeMut.ScanAddressesInRegion(space->bottom, space->lowerAllocPtr); 205 sizeMut.ScanAddressesInRegion(space->upperAllocPtr, space->top); 206 defaultNoOverSize += sizeMut.noOverSize / 4; 207 defaultMutSize += sizeMut.mutSize / 4; 208 } 209 else 210 defaultImmSize += size/2; 211 } 212 for (std::vector<CodeSpace *>::iterator i = gMem.cSpaces.begin(); i < gMem.cSpaces.end(); i++) 213 { 214 CodeSpace *space = *i; 215 uintptr_t size = space->spaceSize(); 216 defaultCodeSize += size/2; 217 } 218 if (isExport) 219 { 220 // Minimum 1M words. 221 if (defaultMutSize < 1024*1024) defaultMutSize = 1024*1024; 222 if (defaultImmSize < 1024*1024) defaultImmSize = 1024*1024; 223 if (defaultCodeSize < 1024*1024) defaultCodeSize = 1024*1024; 224#ifdef MACOSX 225 // Limit the segment size for Mac OS X. The linker has a limit of 2^24 relocations 226 // in a segment so this is a crude way of ensuring the limit isn't exceeded. 227 // It's unlikely to be exceeded by the code itself. 228 // Actually, from trial-and-error, the limit seems to be around 6M. 229 if (defaultMutSize > 6 * 1024 * 1024) defaultMutSize = 6 * 1024 * 1024; 230 if (defaultImmSize > 6 * 1024 * 1024) defaultImmSize = 6 * 1024 * 1024; 231#endif 232 if (defaultNoOverSize < 4096) defaultNoOverSize = 4096; // Except for the no-overwrite area 233 } 234 else 235 { 236 // Much smaller minimum sizes for saved states. 237 if (defaultMutSize < 1024) defaultMutSize = 1024; 238 if (defaultImmSize < 4096) defaultImmSize = 4096; 239 if (defaultCodeSize < 4096) defaultCodeSize = 4096; 240 if (defaultNoOverSize < 4096) defaultNoOverSize = 4096; 241 // Set maximum sizes as well. We may have insufficient contiguous space for 242 // very large areas. 243 if (defaultMutSize > 1024 * 1024) defaultMutSize = 1024 * 1024; 244 if (defaultImmSize > 1024 * 1024) defaultImmSize = 1024 * 1024; 245 if (defaultCodeSize > 1024 * 1024) defaultCodeSize = 1024 * 1024; 246 if (defaultNoOverSize > 1024 * 1024) defaultNoOverSize = 1024 * 1024; 247 } 248 if (debugOptions & DEBUG_SAVING) 249 Log("SAVE: Copyscan default sizes: Immutable: %" POLYUFMT ", Mutable: %" POLYUFMT ", Code: %" POLYUFMT ", No-overwrite %" POLYUFMT ".\n", 250 defaultImmSize, defaultMutSize, defaultCodeSize, defaultNoOverSize); 251} 252 253CopyScan::~CopyScan() 254{ 255 gMem.DeleteExportSpaces(); 256 if (graveYard) 257 delete[](graveYard); 258} 259 260 261// This function is called for each address in an object 262// once it has been copied to its new location. We copy first 263// then scan to update the addresses. 264POLYUNSIGNED CopyScan::ScanAddressAt(PolyWord *pt) 265{ 266 PolyWord val = *pt; 267 // Ignore integers. 268 if (IS_INT(val) || val == PolyWord::FromUnsigned(0)) 269 return 0; 270 271 PolyObject *obj = val.AsObjPtr(); 272 POLYUNSIGNED l = ScanAddress(&obj); 273 *pt = obj; 274 return l; 275} 276 277// This function is called for each address in an object 278// once it has been copied to its new location. We copy first 279// then scan to update the addresses. 280POLYUNSIGNED CopyScan::ScanAddress(PolyObject **pt) 281{ 282 PolyObject *obj = *pt; 283 MemSpace *space = gMem.SpaceForObjectAddress(obj); 284 ASSERT(space != 0); 285 // We may sometimes get addresses that have already been updated 286 // to point to the new area. e.g. (only?) in the case of constants 287 // that have been updated in ScanConstantsWithinCode. 288 if (space->spaceType == ST_EXPORT) 289 return 0; 290 291 // If this is at a lower level than the hierarchy we are saving 292 // then leave it untouched. 293 if (space->spaceType == ST_PERMANENT) 294 { 295 PermanentMemSpace *pmSpace = (PermanentMemSpace*)space; 296 if (pmSpace->hierarchy < hierarchy) 297 return 0; 298 } 299 300 // Have we already scanned this? 301 if (obj->ContainsForwardingPtr()) 302 { 303 // Update the address to the new value. 304#ifdef POLYML32IN64 305 PolyObject *newAddr; 306 if (space->isCode) 307 newAddr = (PolyObject*)(globalCodeBase + ((obj->LengthWord() & ~_OBJ_TOMBSTONE_BIT) << 1)); 308 else newAddr = obj->GetForwardingPtr(); 309#else 310 PolyObject *newAddr = obj->GetForwardingPtr(); 311#endif 312 *pt = newAddr; 313 return 0; // No need to scan it again. 314 } 315 else if (space->spaceType == ST_PERMANENT) 316 { 317 // See if we have this in the grave-yard. 318 for (unsigned i = 0; i < tombs; i++) 319 { 320 GraveYard *g = &graveYard[i]; 321 if ((PolyWord*)obj >= g->startAddr && (PolyWord*)obj < g->endAddr) 322 { 323 PolyWord *tombAddr = g->graves + ((PolyWord*)obj - g->startAddr); 324 PolyObject *tombObject = (PolyObject*)tombAddr; 325 if (tombObject->ContainsForwardingPtr()) 326 { 327#ifdef POLYML32IN64 328 PolyObject *newAddr; 329 if (space->isCode) 330 newAddr = (PolyObject*)(globalCodeBase + ((tombObject->LengthWord() & ~_OBJ_TOMBSTONE_BIT) << 1)); 331 else newAddr = tombObject->GetForwardingPtr(); 332#else 333 PolyObject *newAddr = tombObject->GetForwardingPtr(); 334#endif 335 *pt = newAddr; 336 return 0; 337 } 338 break; // No need to look further 339 } 340 } 341 } 342 343 // No, we need to copy it. 344 ASSERT(space->spaceType == ST_LOCAL || space->spaceType == ST_PERMANENT || 345 space->spaceType == ST_CODE); 346 POLYUNSIGNED lengthWord = obj->LengthWord(); 347 POLYUNSIGNED words = OBJ_OBJECT_LENGTH(lengthWord); 348 349 PolyObject *newObj = 0; 350 PolyObject* writAble = 0; 351 bool isMutableObj = obj->IsMutable(); 352 bool isNoOverwrite = false; 353 bool isByteObj = obj->IsByteObject(); 354 bool isCodeObj = false; 355 if (isMutableObj) 356 isNoOverwrite = obj->IsNoOverwriteObject(); 357 else isCodeObj = obj->IsCodeObject(); 358 // Allocate a new address for the object. 359 for (std::vector<PermanentMemSpace *>::iterator i = gMem.eSpaces.begin(); i < gMem.eSpaces.end(); i++) 360 { 361 PermanentMemSpace *space = *i; 362 if (isMutableObj == space->isMutable && 363 isNoOverwrite == space->noOverwrite && 364 isByteObj == space->byteOnly && 365 isCodeObj == space->isCode) 366 { 367 ASSERT(space->topPointer <= space->top && space->topPointer >= space->bottom); 368 size_t spaceLeft = space->top - space->topPointer; 369 if (spaceLeft > words) 370 { 371 newObj = (PolyObject*)(space->topPointer + 1); 372 writAble = space->writeAble(newObj); 373 space->topPointer += words + 1; 374#ifdef POLYML32IN64 375 // Maintain the odd-word alignment of topPointer 376 if ((words & 1) == 0 && space->topPointer < space->top) 377 { 378 *space->writeAble(space->topPointer) = PolyWord::FromUnsigned(0); 379 space->topPointer++; 380 } 381#endif 382 break; 383 } 384 } 385 } 386 if (newObj == 0) 387 { 388 // Didn't find room in the existing spaces. Create a new space. 389 uintptr_t spaceWords; 390 if (isMutableObj) 391 { 392 if (isNoOverwrite) spaceWords = defaultNoOverSize; 393 else spaceWords = defaultMutSize; 394 } 395 else 396 { 397 if (isCodeObj) spaceWords = defaultCodeSize; 398 else spaceWords = defaultImmSize; 399 } 400 if (spaceWords <= words) 401 spaceWords = words + 1; // Make sure there's space for this object. 402 PermanentMemSpace *space = gMem.NewExportSpace(spaceWords, isMutableObj, isNoOverwrite, isCodeObj); 403 if (isByteObj) space->byteOnly = true; 404 if (space == 0) 405 { 406 if (debugOptions & DEBUG_SAVING) 407 Log("SAVE: Unable to allocate export space, size: %lu.\n", spaceWords); 408 // Unable to allocate this. 409 throw MemoryException(); 410 } 411 newObj = (PolyObject*)(space->topPointer + 1); 412 writAble = space->writeAble(newObj); 413 space->topPointer += words + 1; 414#ifdef POLYML32IN64 415 // Maintain the odd-word alignment of topPointer 416 if ((words & 1) == 0 && space->topPointer < space->top) 417 { 418 *space->writeAble(space->topPointer) = PolyWord::FromUnsigned(0); 419 space->topPointer++; 420 } 421#endif 422 ASSERT(space->topPointer <= space->top && space->topPointer >= space->bottom); 423 } 424 425 writAble->SetLengthWord(lengthWord); // copy length word 426 427 if (hierarchy == 0 /* Exporting object module */ && isNoOverwrite && isMutableObj && !isByteObj) 428 { 429 // These are not exported. They are used for special values e.g. mutexes 430 // that should be set to 0/nil/NONE at start-up. 431 // Weak+No-overwrite byte objects are used for entry points and volatiles 432 // in the foreign-function interface and have to be treated specially. 433 434 // Note: this must not be done when exporting a saved state because the 435 // copied version is used as the local data for the rest of the session. 436 for (POLYUNSIGNED i = 0; i < words; i++) 437 writAble->Set(i, TAGGED(0)); 438 } 439 else memcpy(writAble, obj, words * sizeof(PolyWord)); 440 441 if (space->spaceType == ST_PERMANENT && !space->isMutable && ((PermanentMemSpace*)space)->hierarchy == 0) 442 { 443 // The immutable permanent areas are read-only. 444 unsigned m; 445 for (m = 0; m < tombs; m++) 446 { 447 GraveYard *g = &graveYard[m]; 448 if ((PolyWord*)obj >= g->startAddr && (PolyWord*)obj < g->endAddr) 449 { 450 PolyWord *tombAddr = g->graves + ((PolyWord*)obj - g->startAddr); 451 PolyObject *tombObject = (PolyObject*)tombAddr; 452#ifdef POLYML32IN64 453 if (isCodeObj) 454 { 455 POLYUNSIGNED ll = (POLYUNSIGNED)(((PolyWord*)newObj - globalCodeBase) >> 1 | _OBJ_TOMBSTONE_BIT); 456 tombObject->SetLengthWord(ll); 457 } 458 else tombObject->SetForwardingPtr(newObj); 459#else 460 tombObject->SetForwardingPtr(newObj); 461#endif 462 break; // No need to look further 463 } 464 } 465 ASSERT(m < tombs); // Should be there. 466 } 467 else if (isCodeObj) 468#ifdef POLYML32IN64 469 // If this is a code address we can't use the usual forwarding pointer format. 470 // Instead we have to compute the offset relative to the base of the code. 471 { 472 POLYUNSIGNED ll = (POLYUNSIGNED)(((PolyWord*)newObj-globalCodeBase) >> 1 | _OBJ_TOMBSTONE_BIT); 473 gMem.SpaceForObjectAddress(obj)->writeAble(obj)->SetLengthWord(ll); 474 } 475#else 476 gMem.SpaceForObjectAddress(obj)->writeAble(obj)->SetForwardingPtr(newObj); 477#endif 478 else obj->SetForwardingPtr(newObj); // Put forwarding pointer in old object. 479 480 if (OBJ_IS_CODE_OBJECT(lengthWord)) 481 { 482 // We don't need to worry about flushing the instruction cache 483 // since we're not going to execute this code here. 484 // We do have to update any relative addresses within the code 485 // to take account of its new position. We have to do that now 486 // even though ScanAddressesInObject will do it again because this 487 // is the only point where we have both the old and the new addresses. 488 machineDependent->ScanConstantsWithinCode(newObj, obj, words, this); 489 } 490 *pt = newObj; // Update it to the newly copied object. 491 return lengthWord; // This new object needs to be scanned. 492} 493 494// The address of code in the code area. We treat this as a normal heap cell. 495// We will probably need to copy this and to process addresses within it. 496POLYUNSIGNED CopyScan::ScanCodeAddressAt(PolyObject **pt) 497{ 498 POLYUNSIGNED lengthWord = ScanAddress(pt); 499 if (lengthWord) 500 ScanAddressesInObject(*pt, lengthWord); 501 return 0; 502} 503 504PolyObject *CopyScan::ScanObjectAddress(PolyObject *base) 505{ 506 PolyWord val = base; 507 // Scan this as an address. 508 POLYUNSIGNED lengthWord = CopyScan::ScanAddressAt(&val); 509 if (lengthWord) 510 ScanAddressesInObject(val.AsObjPtr(), lengthWord); 511 return val.AsObjPtr(); 512} 513 514#define MAX_EXTENSION 4 // The longest extension we may need to add is ".obj" 515 516// Convert the forwarding pointers in a region back into length words. 517 518// Generally if this object has a forwarding pointer that's 519// because we've moved it into the export region. We can, 520// though, get multiple levels of forwarding if there is an object 521// that has been shifted up by a garbage collection, leaving a forwarding 522// pointer and then that object has been moved to the export region. 523// We mustn't turn locally forwarded values back into ordinary objects 524// because they could contain addresses that are no longer valid. 525static POLYUNSIGNED GetObjLength(PolyObject *obj) 526{ 527 if (obj->ContainsForwardingPtr()) 528 { 529 PolyObject *forwardedTo; 530#ifdef POLYML32IN64 531 { 532 MemSpace *space = gMem.SpaceForObjectAddress(obj); 533 if (space->isCode) 534 forwardedTo = (PolyObject*)(globalCodeBase + ((obj->LengthWord() & ~_OBJ_TOMBSTONE_BIT) << 1)); 535 else forwardedTo = obj->GetForwardingPtr(); 536 } 537#else 538 forwardedTo = obj->GetForwardingPtr(); 539#endif 540 POLYUNSIGNED length = GetObjLength(forwardedTo); 541 MemSpace *space = gMem.SpaceForObjectAddress(forwardedTo); 542 if (space->spaceType == ST_EXPORT) 543 gMem.SpaceForObjectAddress(obj)->writeAble(obj)->SetLengthWord(length); 544 return length; 545 } 546 else { 547 ASSERT(obj->ContainsNormalLengthWord()); 548 return obj->LengthWord(); 549 } 550} 551 552static void FixForwarding(PolyWord *pt, size_t space) 553{ 554 while (space) 555 { 556 pt++; 557 PolyObject *obj = (PolyObject*)pt; 558#ifdef POLYML32IN64 559 if ((uintptr_t)obj & 4) 560 { 561 // Skip filler words needed to align to an even word 562 space--; 563 continue; // We've added 1 to pt so just loop. 564 } 565#endif 566 size_t length = OBJ_OBJECT_LENGTH(GetObjLength(obj)); 567 pt += length; 568 ASSERT(space > length); 569 space -= length+1; 570 } 571} 572 573class ExportRequest: public MainThreadRequest 574{ 575public: 576 ExportRequest(Handle root, Exporter *exp): MainThreadRequest(MTP_EXPORTING), 577 exportRoot(root), exporter(exp) {} 578 579 virtual void Perform() { exporter->RunExport(exportRoot->WordP()); } 580 Handle exportRoot; 581 Exporter *exporter; 582}; 583 584static void exporter(TaskData *taskData, Handle fileName, Handle root, const TCHAR *extension, Exporter *exports) 585{ 586 size_t extLen = _tcslen(extension); 587 TempString fileNameBuff(Poly_string_to_T_alloc(fileName->Word(), extLen)); 588 if (fileNameBuff == NULL) 589 raise_syscall(taskData, "Insufficient memory", NOMEMORY); 590 size_t length = _tcslen(fileNameBuff); 591 592 // Does it already have the extension? If not add it on. 593 if (length < extLen || _tcscmp(fileNameBuff + length - extLen, extension) != 0) 594 _tcscat(fileNameBuff, extension); 595#if (defined(_WIN32) && defined(UNICODE)) 596 exports->exportFile = _wfopen(fileNameBuff, L"wb"); 597#else 598 exports->exportFile = fopen(fileNameBuff, "wb"); 599#endif 600 if (exports->exportFile == NULL) 601 raise_syscall(taskData, "Cannot open export file", ERRORNUMBER); 602 603 // Request a full GC to reduce the size of fix-ups. 604 FullGC(taskData); 605 // Request the main thread to do the export. 606 ExportRequest request(root, exports); 607 processes->MakeRootRequest(taskData, &request); 608 if (exports->errorMessage) 609 raise_fail(taskData, exports->errorMessage); 610} 611 612// This is called by the initial thread to actually do the export. 613void Exporter::RunExport(PolyObject *rootFunction) 614{ 615 Exporter *exports = this; 616 617 PolyObject *copiedRoot = 0; 618 CopyScan copyScan(hierarchy); 619 620 try { 621 copyScan.initialise(); 622 // Copy the root and everything reachable from it into the temporary area. 623 copiedRoot = copyScan.ScanObjectAddress(rootFunction); 624 } 625 catch (MemoryException &) 626 { 627 // If we ran out of memory. 628 copiedRoot = 0; 629 } 630 631 // Fix the forwarding pointers. 632 for (std::vector<LocalMemSpace*>::iterator i = gMem.lSpaces.begin(); i < gMem.lSpaces.end(); i++) 633 { 634 LocalMemSpace *space = *i; 635 // Local areas only have objects from the allocation pointer to the top. 636 FixForwarding(space->bottom, space->lowerAllocPtr - space->bottom); 637 FixForwarding(space->upperAllocPtr, space->top - space->upperAllocPtr); 638 } 639 for (std::vector<PermanentMemSpace*>::iterator i = gMem.pSpaces.begin(); i < gMem.pSpaces.end(); i++) 640 { 641 MemSpace *space = *i; 642 // Permanent areas are filled with objects from the bottom. 643 FixForwarding(space->bottom, space->top - space->bottom); 644 } 645 for (std::vector<CodeSpace *>::iterator i = gMem.cSpaces.begin(); i < gMem.cSpaces.end(); i++) 646 { 647 MemSpace *space = *i; 648 // Code areas are filled with objects from the bottom. 649 FixForwarding(space->bottom, space->top - space->bottom); 650 } 651 652 // Reraise the exception after cleaning up the forwarding pointers. 653 if (copiedRoot == 0) 654 { 655 exports->errorMessage = "Insufficient Memory"; 656 return; 657 } 658 659 // Copy the areas into the export object. 660 size_t tableEntries = gMem.eSpaces.size(); 661 unsigned memEntry = 0; 662 if (hierarchy != 0) tableEntries += gMem.pSpaces.size(); 663 exports->memTable = new memoryTableEntry[tableEntries]; 664 665 // If we're constructing a module we need to include the global spaces. 666 if (hierarchy != 0) 667 { 668 // Permanent spaces from the executable. 669 for (std::vector<PermanentMemSpace*>::iterator i = gMem.pSpaces.begin(); i < gMem.pSpaces.end(); i++) 670 { 671 PermanentMemSpace *space = *i; 672 if (space->hierarchy < hierarchy) 673 { 674 memoryTableEntry *entry = &exports->memTable[memEntry++]; 675 entry->mtOriginalAddr = entry->mtCurrentAddr = space->bottom; 676 entry->mtLength = (space->topPointer-space->bottom)*sizeof(PolyWord); 677 entry->mtIndex = space->index; 678 entry->mtFlags = 0; 679 if (space->isMutable) entry->mtFlags |= MTF_WRITEABLE; 680 if (space->isCode) entry->mtFlags |= MTF_EXECUTABLE; 681 } 682 } 683 newAreas = memEntry; 684 } 685 686 for (std::vector<PermanentMemSpace *>::iterator i = gMem.eSpaces.begin(); i < gMem.eSpaces.end(); i++) 687 { 688 memoryTableEntry *entry = &exports->memTable[memEntry++]; 689 PermanentMemSpace *space = *i; 690 entry->mtOriginalAddr = entry->mtCurrentAddr = space->bottom; 691 entry->mtLength = (space->topPointer-space->bottom)*sizeof(PolyWord); 692 entry->mtIndex = hierarchy == 0 ? memEntry-1 : space->index; 693 entry->mtFlags = 0; 694 if (space->isMutable) 695 { 696 entry->mtFlags = MTF_WRITEABLE; 697 if (space->noOverwrite) entry->mtFlags |= MTF_NO_OVERWRITE; 698 } 699 if (space->isCode) entry->mtFlags |= MTF_EXECUTABLE; 700 if (space->byteOnly) entry->mtFlags |= MTF_BYTES; 701 } 702 703 ASSERT(memEntry == tableEntries); 704 exports->memTableEntries = memEntry; 705 exports->rootFunction = copiedRoot; 706 try { 707 // This can raise MemoryException at least in PExport::exportStore. 708 exports->exportStore(); 709 } 710 catch (MemoryException &) { 711 exports->errorMessage = "Insufficient Memory"; 712 } 713} 714 715// Functions called via the RTS call. 716Handle exportNative(TaskData *taskData, Handle args) 717{ 718#ifdef HAVE_PECOFF 719 // Windows including Cygwin 720#if (defined(_WIN32)) 721 const TCHAR *extension = _T(".obj"); // Windows 722#else 723 const char *extension = ".o"; // Cygwin 724#endif 725 PECOFFExport exports; 726 exporter(taskData, taskData->saveVec.push(args->WordP()->Get(0)), 727 taskData->saveVec.push(args->WordP()->Get(1)), extension, &exports); 728#elif defined(HAVE_ELF_H) || defined(HAVE_ELF_ABI_H) 729 // Most Unix including Linux, FreeBSD and Solaris. 730 const char *extension = ".o"; 731 ELFExport exports; 732 exporter(taskData, taskData->saveVec.push(args->WordP()->Get(0)), 733 taskData->saveVec.push(args->WordP()->Get(1)), extension, &exports); 734#elif defined(HAVE_MACH_O_RELOC_H) 735 // Mac OS-X 736 const char *extension = ".o"; 737 MachoExport exports; 738 exporter(taskData, taskData->saveVec.push(args->WordP()->Get(0)), 739 taskData->saveVec.push(args->WordP()->Get(1)), extension, &exports); 740#else 741 raise_exception_string (taskData, EXC_Fail, "Native export not available for this platform"); 742#endif 743 return taskData->saveVec.push(TAGGED(0)); 744} 745 746Handle exportPortable(TaskData *taskData, Handle args) 747{ 748 PExport exports; 749 exporter(taskData, taskData->saveVec.push(args->WordP()->Get(0)), 750 taskData->saveVec.push(args->WordP()->Get(1)), _T(".txt"), &exports); 751 return taskData->saveVec.push(TAGGED(0)); 752} 753 754POLYUNSIGNED PolyExport(FirstArgument threadId, PolyWord fileName, PolyWord root) 755{ 756 TaskData *taskData = TaskData::FindTaskForId(threadId); 757 ASSERT(taskData != 0); 758 taskData->PreRTSCall(); 759 Handle reset = taskData->saveVec.mark(); 760 Handle pushedName = taskData->saveVec.push(fileName); 761 Handle pushedRoot = taskData->saveVec.push(root); 762 763 try { 764#ifdef HAVE_PECOFF 765 // Windows including Cygwin 766#if (defined(_WIN32)) 767 const TCHAR *extension = _T(".obj"); // Windows 768#else 769 const char *extension = ".o"; // Cygwin 770#endif 771 PECOFFExport exports; 772 exporter(taskData, pushedName, pushedRoot, extension, &exports); 773#elif defined(HAVE_ELF_H) || defined(HAVE_ELF_ABI_H) 774 // Most Unix including Linux, FreeBSD and Solaris. 775 const char *extension = ".o"; 776 ELFExport exports; 777 exporter(taskData, pushedName, pushedRoot, extension, &exports); 778#elif defined(HAVE_MACH_O_RELOC_H) 779 // Mac OS-X 780 const char *extension = ".o"; 781 MachoExport exports; 782 exporter(taskData, pushedName, pushedRoot, extension, &exports); 783#else 784 raise_exception_string (taskData, EXC_Fail, "Native export not available for this platform"); 785#endif 786 } catch (...) { } // If an ML exception is raised 787 788 taskData->saveVec.reset(reset); 789 taskData->PostRTSCall(); 790 return TAGGED(0).AsUnsigned(); // Returns unit 791} 792 793POLYUNSIGNED PolyExportPortable(FirstArgument threadId, PolyWord fileName, PolyWord root) 794{ 795 TaskData *taskData = TaskData::FindTaskForId(threadId); 796 ASSERT(taskData != 0); 797 taskData->PreRTSCall(); 798 Handle reset = taskData->saveVec.mark(); 799 Handle pushedName = taskData->saveVec.push(fileName); 800 Handle pushedRoot = taskData->saveVec.push(root); 801 802 try { 803 PExport exports; 804 exporter(taskData, pushedName, pushedRoot, _T(".txt"), &exports); 805 } catch (...) { } // If an ML exception is raised 806 807 taskData->saveVec.reset(reset); 808 taskData->PostRTSCall(); 809 return TAGGED(0).AsUnsigned(); // Returns unit 810} 811 812 813// Helper functions for exporting. We need to produce relocation information 814// and this code is common to every method. 815Exporter::Exporter(unsigned int h): exportFile(NULL), errorMessage(0), hierarchy(h), memTable(0), newAreas(0) 816{ 817} 818 819Exporter::~Exporter() 820{ 821 delete[](memTable); 822 if (exportFile) 823 fclose(exportFile); 824} 825 826void Exporter::relocateValue(PolyWord *pt) 827{ 828#ifndef POLYML32IN64 829 PolyWord q = *pt; 830 if (IS_INT(q) || q == PolyWord::FromUnsigned(0)) {} 831 else createRelocation(pt); 832#endif 833} 834 835void Exporter::createRelocation(PolyWord* pt) 836{ 837 *gMem.SpaceForAddress(pt)->writeAble(pt) = createRelocation(*pt, pt); 838} 839 840// Check through the areas to see where the address is. It must be 841// in one of them. 842unsigned Exporter::findArea(void *p) 843{ 844 for (unsigned i = 0; i < memTableEntries; i++) 845 { 846 if (p > memTable[i].mtOriginalAddr && 847 p <= (char*)memTable[i].mtOriginalAddr + memTable[i].mtLength) 848 return i; 849 } 850 { ASSERT(0); } 851 return 0; 852} 853 854void Exporter::relocateObject(PolyObject *p) 855{ 856 if (p->IsByteObject()) 857 { 858 if (p->IsMutable() && p->IsWeakRefObject()) 859 { 860 // Weak mutable byte refs are used for external references and 861 // also in the FFI for non-persistent values. 862 bool isFuncPtr = true; 863 const char *entryName = getEntryPointName(p, &isFuncPtr); 864 if (entryName != 0) addExternalReference(p, entryName, isFuncPtr); 865 // Clear the first word of the data. 866 ASSERT(p->Length() >= sizeof(uintptr_t)/sizeof(PolyWord)); 867 *(uintptr_t*)p = 0; 868 } 869 } 870 else if (p->IsCodeObject()) 871 { 872 POLYUNSIGNED constCount; 873 PolyWord *cp; 874 ASSERT(! p->IsMutable() ); 875 p->GetConstSegmentForCode(cp, constCount); 876 /* Now the constants. */ 877 for (POLYUNSIGNED i = 0; i < constCount; i++) relocateValue(&(cp[i])); 878 879 } 880 else // Closure and ordinary objects 881 { 882 POLYUNSIGNED length = p->Length(); 883 for (POLYUNSIGNED i = 0; i < length; i++) relocateValue(p->Offset(i)); 884 } 885} 886 887ExportStringTable::ExportStringTable(): strings(0), stringSize(0), stringAvailable(0) 888{ 889} 890 891ExportStringTable::~ExportStringTable() 892{ 893 free(strings); 894} 895 896// Add a string to the string table, growing it if necessary. 897unsigned long ExportStringTable::makeEntry(const char *str) 898{ 899 unsigned len = (unsigned)strlen(str); 900 unsigned long entry = stringSize; 901 if (stringSize + len + 1 > stringAvailable) 902 { 903 stringAvailable = stringAvailable+stringAvailable/2; 904 if (stringAvailable < stringSize + len + 1) 905 stringAvailable = stringSize + len + 1 + 500; 906 char* newStrings = (char*)realloc(strings, stringAvailable); 907 if (newStrings == 0) 908 { 909 if (debugOptions & DEBUG_SAVING) 910 Log("SAVE: Unable to realloc string table, size: %lu.\n", stringAvailable); 911 throw MemoryException(); 912 } 913 else strings = newStrings; 914 } 915 strcpy(strings + stringSize, str); 916 stringSize += len + 1; 917 return entry; 918} 919 920struct _entrypts exporterEPT[] = 921{ 922 { "PolyExport", (polyRTSFunction)&PolyExport}, 923 { "PolyExportPortable", (polyRTSFunction)&PolyExportPortable}, 924 925 { NULL, NULL} // End of list. 926}; 927