1/* 2 Title: exporter.cpp - Export a function as an object or C file 3 4 Copyright (c) 2006-7, 2015, 2016-17 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) && ! defined(__CYGWIN__)) 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) && ! defined(__CYGWIN__)) 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(PolyObject *threadId, PolyWord fileName, PolyWord root); 96 POLYEXTERNALSYMBOL POLYUNSIGNED PolyExportPortable(PolyObject *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 POLYUNSIGNED 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 POLYUNSIGNED 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 POLYUNSIGNED 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 // Ignore pointers to the IO area. They will be relocated 271 // when we write out the memory 272 MemSpace *space = gMem.SpaceForAddress(val.AsStackAddr()-1); 273 ASSERT(space != 0); 274 // We may sometimes get addresses that have already been updated 275 // to point to the new area. e.g. (only?) in the case of constants 276 // that have been updated in ScanConstantsWithinCode. 277 if (space->spaceType == ST_EXPORT) 278 return 0; 279 280 // If this is at a lower level than the hierarchy we are saving 281 // then leave it untouched. 282 if (space->spaceType == ST_PERMANENT) 283 { 284 PermanentMemSpace *pmSpace = (PermanentMemSpace*)space; 285 if (pmSpace->hierarchy < hierarchy) 286 return 0; 287 } 288 289 ASSERT(OBJ_IS_DATAPTR(val)); 290 291 // Have we already scanned this? 292 PolyObject *obj = val.AsObjPtr(); 293 if (obj->ContainsForwardingPtr()) 294 { 295 // Update the address to the new value. 296 PolyObject *newAddr = obj->GetForwardingPtr(); 297 *pt = newAddr; 298 return 0; // No need to scan it again. 299 } 300 else if (space->spaceType == ST_PERMANENT) 301 { 302 // See if we have this in the grave-yard. 303 for (unsigned i = 0; i < tombs; i++) 304 { 305 GraveYard *g = &graveYard[i]; 306 if (val.AsStackAddr() >= g->startAddr && val.AsStackAddr() < g->endAddr) 307 { 308 PolyWord *tombAddr = g->graves + (val.AsStackAddr() - g->startAddr); 309 PolyObject *tombObject = (PolyObject*)tombAddr; 310 if (tombObject->ContainsForwardingPtr()) 311 { 312 *pt = tombObject->GetForwardingPtr();; 313 return 0; 314 } 315 break; // No need to look further 316 } 317 } 318 } 319 320 // No, we need to copy it. 321 ASSERT(space->spaceType == ST_LOCAL || space->spaceType == ST_PERMANENT || 322 space->spaceType == ST_CODE); 323 POLYUNSIGNED lengthWord = obj->LengthWord(); 324 POLYUNSIGNED words = OBJ_OBJECT_LENGTH(lengthWord); 325 326 PolyObject *newObj = 0; 327 bool isMutableObj = obj->IsMutable(); 328 bool isNoOverwrite = false; 329 bool isByteObj = false; 330 bool isCodeObj = false; 331 if (isMutableObj) 332 { 333 isNoOverwrite = obj->IsNoOverwriteObject(); 334 isByteObj = obj->IsByteObject(); 335 } 336 else isCodeObj = obj->IsCodeObject(); 337 // Allocate a new address for the object. 338 for (std::vector<PermanentMemSpace *>::iterator i = gMem.eSpaces.begin(); i < gMem.eSpaces.end(); i++) 339 { 340 PermanentMemSpace *space = *i; 341 if (isMutableObj == space->isMutable && 342 isNoOverwrite == space->noOverwrite && 343 isByteObj == space->byteOnly && 344 isCodeObj == space->isCode) 345 { 346 ASSERT(space->topPointer <= space->top && space->topPointer >= space->bottom); 347 POLYUNSIGNED spaceLeft = space->top - space->topPointer; 348 if (spaceLeft > words) 349 { 350 newObj = (PolyObject*)(space->topPointer+1); 351 space->topPointer += words+1; 352 break; 353 } 354 } 355 } 356 if (newObj == 0) 357 { 358 // Didn't find room in the existing spaces. Create a new space. 359 POLYUNSIGNED spaceWords; 360 if (isMutableObj) 361 { 362 if (isNoOverwrite) spaceWords = defaultNoOverSize; 363 else spaceWords = defaultMutSize; 364 } 365 else 366 { 367 if (isCodeObj) spaceWords = defaultCodeSize; 368 else spaceWords = defaultImmSize; 369 } 370 if (spaceWords <= words) 371 spaceWords = words+1; // Make sure there's space for this object. 372 PermanentMemSpace *space = gMem.NewExportSpace(spaceWords, isMutableObj, isNoOverwrite, isCodeObj); 373 if (isByteObj) space->byteOnly = true; 374 if (space == 0) 375 { 376 if (debugOptions & DEBUG_SAVING) 377 Log("SAVE: Unable to allocate export space, size: %lu.\n", spaceWords); 378 // Unable to allocate this. 379 throw MemoryException(); 380 } 381 newObj = (PolyObject*)(space->topPointer+1); 382 space->topPointer += words+1; 383 ASSERT(space->topPointer <= space->top && space->topPointer >= space->bottom); 384 } 385 386 newObj->SetLengthWord(lengthWord); // copy length word 387 388 memcpy(newObj, obj, words*sizeof(PolyWord)); 389 390 if (space->spaceType == ST_PERMANENT && !space->isMutable && ((PermanentMemSpace*)space)->hierarchy == 0) 391 { 392 // The immutable permanent areas are read-only. 393 unsigned m; 394 for (m = 0; m < tombs; m++) 395 { 396 GraveYard *g = &graveYard[m]; 397 if (val.AsStackAddr() >= g->startAddr && val.AsStackAddr() < g->endAddr) 398 { 399 PolyWord *tombAddr = g->graves + (val.AsStackAddr() - g->startAddr); 400 PolyObject *tombObject = (PolyObject*)tombAddr; 401 tombObject->SetForwardingPtr(newObj); 402 break; // No need to look further 403 } 404 } 405 ASSERT(m < tombs); // Should be there. 406 } 407 else obj->SetForwardingPtr(newObj); // Put forwarding pointer in old object. 408 409 if (OBJ_IS_CODE_OBJECT(lengthWord)) 410 { 411 // We don't need to worry about flushing the instruction cache 412 // since we're not going to execute this code here. 413 // We do have to update any relative addresses within the code 414 // to take account of its new position. We have to do that now 415 // even though ScanAddressesInObject will do it again because this 416 // is the only point where we have both the old and the new addresses. 417 machineDependent->ScanConstantsWithinCode(newObj, obj, words, this); 418 } 419 *pt = newObj; // Update it to the newly copied object. 420 return lengthWord; // This new object needs to be scanned. 421} 422 423 424PolyObject *CopyScan::ScanObjectAddress(PolyObject *base) 425{ 426 PolyWord val = base; 427 // Scan this as an address. 428 POLYUNSIGNED lengthWord = CopyScan::ScanAddressAt(&val); 429 if (lengthWord) 430 ScanAddressesInObject(val.AsObjPtr(), lengthWord); 431 return val.AsObjPtr(); 432} 433 434#define MAX_EXTENSION 4 // The longest extension we may need to add is ".obj" 435 436// Convert the forwarding pointers in a region back into length words. 437 438// Generally if this object has a forwarding pointer that's 439// because we've moved it into the export region. We can, 440// though, get multiple levels of forwarding if there is an object 441// that has been shifted up by a garbage collection, leaving a forwarding 442// pointer and then that object has been moved to the export region. 443// We mustn't turn locally forwarded values back into ordinary objects 444// because they could contain addresses that are no longer valid. 445static POLYUNSIGNED GetObjLength(PolyObject *obj) 446{ 447 if (obj->ContainsForwardingPtr()) 448 { 449 PolyObject *forwardedTo = obj->GetForwardingPtr(); 450 POLYUNSIGNED length = GetObjLength(forwardedTo); 451 MemSpace *space = gMem.SpaceForAddress(forwardedTo-1); 452 if (space->spaceType == ST_EXPORT) 453 obj->SetLengthWord(length); 454 return length; 455 } 456 else { 457 ASSERT(obj->ContainsNormalLengthWord()); 458 return obj->LengthWord(); 459 } 460} 461 462static void FixForwarding(PolyWord *pt, POLYUNSIGNED space) 463{ 464 while (space) 465 { 466 pt++; 467 PolyObject *obj = (PolyObject*)pt; 468 POLYUNSIGNED length = OBJ_OBJECT_LENGTH(GetObjLength(obj)); 469 pt += length; 470 ASSERT(space > length); 471 space -= length+1; 472 } 473} 474 475class ExportRequest: public MainThreadRequest 476{ 477public: 478 ExportRequest(Handle root, Exporter *exp): MainThreadRequest(MTP_EXPORTING), 479 exportRoot(root), exporter(exp) {} 480 481 virtual void Perform() { exporter->RunExport(exportRoot->WordP()); } 482 Handle exportRoot; 483 Exporter *exporter; 484}; 485 486static void exporter(TaskData *taskData, Handle fileName, Handle root, const TCHAR *extension, Exporter *exports) 487{ 488 size_t extLen = _tcslen(extension); 489 TempString fileNameBuff(Poly_string_to_T_alloc(fileName->Word(), extLen)); 490 if (fileNameBuff == NULL) 491 raise_syscall(taskData, "Insufficient memory", NOMEMORY); 492 size_t length = _tcslen(fileNameBuff); 493 494 // Does it already have the extension? If not add it on. 495 if (length < extLen || _tcscmp(fileNameBuff + length - extLen, extension) != 0) 496 _tcscat(fileNameBuff, extension); 497#if (defined(_WIN32) && defined(UNICODE)) 498 exports->exportFile = _wfopen(fileNameBuff, L"wb"); 499#else 500 exports->exportFile = fopen(fileNameBuff, "wb"); 501#endif 502 if (exports->exportFile == NULL) 503 raise_syscall(taskData, "Cannot open export file", ERRORNUMBER); 504 505 // Request a full GC to reduce the size of fix-ups. 506 FullGC(taskData); 507 // Request the main thread to do the export. 508 ExportRequest request(root, exports); 509 processes->MakeRootRequest(taskData, &request); 510 if (exports->errorMessage) 511 raise_fail(taskData, exports->errorMessage); 512} 513 514// This is called by the initial thread to actually do the export. 515void Exporter::RunExport(PolyObject *rootFunction) 516{ 517 Exporter *exports = this; 518 519 PolyObject *copiedRoot = 0; 520 CopyScan copyScan(hierarchy); 521 522 try { 523 copyScan.initialise(); 524 // Copy the root and everything reachable from it into the temporary area. 525 copiedRoot = copyScan.ScanObjectAddress(rootFunction); 526 } 527 catch (MemoryException &) 528 { 529 // If we ran out of memory. 530 copiedRoot = 0; 531 } 532 533 // Fix the forwarding pointers. 534 for (std::vector<LocalMemSpace*>::iterator i = gMem.lSpaces.begin(); i < gMem.lSpaces.end(); i++) 535 { 536 LocalMemSpace *space = *i; 537 // Local areas only have objects from the allocation pointer to the top. 538 FixForwarding(space->bottom, space->lowerAllocPtr - space->bottom); 539 FixForwarding(space->upperAllocPtr, space->top - space->upperAllocPtr); 540 } 541 for (std::vector<PermanentMemSpace*>::iterator i = gMem.pSpaces.begin(); i < gMem.pSpaces.end(); i++) 542 { 543 MemSpace *space = *i; 544 // Permanent areas are filled with objects from the bottom. 545 FixForwarding(space->bottom, space->top - space->bottom); 546 } 547 for (std::vector<CodeSpace *>::iterator i = gMem.cSpaces.begin(); i < gMem.cSpaces.end(); i++) 548 { 549 MemSpace *space = *i; 550 // Code areas are filled with objects from the bottom. 551 FixForwarding(space->bottom, space->top - space->bottom); 552 } 553 554 // Reraise the exception after cleaning up the forwarding pointers. 555 if (copiedRoot == 0) 556 { 557 exports->errorMessage = "Insufficient Memory"; 558 return; 559 } 560 561 // Copy the areas into the export object. 562 size_t tableEntries = gMem.eSpaces.size(); 563 unsigned memEntry = 0; 564 if (hierarchy != 0) tableEntries += gMem.pSpaces.size(); 565 exports->memTable = new memoryTableEntry[tableEntries]; 566 567 // If we're constructing a module we need to include the global spaces. 568 if (hierarchy != 0) 569 { 570 // Permanent spaces from the executable. 571 for (std::vector<PermanentMemSpace*>::iterator i = gMem.pSpaces.begin(); i < gMem.pSpaces.end(); i++) 572 { 573 PermanentMemSpace *space = *i; 574 if (space->hierarchy < hierarchy) 575 { 576 memoryTableEntry *entry = &exports->memTable[memEntry++]; 577 entry->mtAddr = space->bottom; 578 entry->mtLength = (space->topPointer-space->bottom)*sizeof(PolyWord); 579 entry->mtIndex = space->index; 580 entry->mtFlags = 0; 581 if (space->isMutable) entry->mtFlags |= MTF_WRITEABLE; 582 if (space->isCode) entry->mtFlags |= MTF_EXECUTABLE; 583 } 584 } 585 newAreas = memEntry; 586 } 587 588 for (std::vector<PermanentMemSpace *>::iterator i = gMem.eSpaces.begin(); i < gMem.eSpaces.end(); i++) 589 { 590 memoryTableEntry *entry = &exports->memTable[memEntry++]; 591 PermanentMemSpace *space = *i; 592 entry->mtAddr = space->bottom; 593 entry->mtLength = (space->topPointer-space->bottom)*sizeof(PolyWord); 594 entry->mtIndex = hierarchy == 0 ? memEntry-1 : space->index; 595 entry->mtFlags = 0; 596 if (space->isMutable) 597 { 598 entry->mtFlags = MTF_WRITEABLE; 599 if (space->noOverwrite) entry->mtFlags |= MTF_NO_OVERWRITE; 600 } 601 if (space->isCode) entry->mtFlags |= MTF_EXECUTABLE; 602 if (space->byteOnly) entry->mtFlags |= MTF_BYTES; 603 } 604 605 ASSERT(memEntry == tableEntries); 606 exports->memTableEntries = memEntry; 607 exports->rootFunction = copiedRoot; 608 exports->exportStore(); 609 return; 610} 611 612// Functions called via the RTS call. 613Handle exportNative(TaskData *taskData, Handle args) 614{ 615#ifdef HAVE_PECOFF 616 // Windows including Cygwin 617#if (defined(_WIN32) && ! defined(__CYGWIN__)) 618 const TCHAR *extension = _T(".obj"); // Windows 619#else 620 const char *extension = ".o"; // Cygwin 621#endif 622 PECOFFExport exports; 623 exporter(taskData, taskData->saveVec.push(args->WordP()->Get(0)), 624 taskData->saveVec.push(args->WordP()->Get(1)), extension, &exports); 625#elif defined(HAVE_ELF_H) || defined(HAVE_ELF_ABI_H) 626 // Most Unix including Linux, FreeBSD and Solaris. 627 const char *extension = ".o"; 628 ELFExport exports; 629 exporter(taskData, taskData->saveVec.push(args->WordP()->Get(0)), 630 taskData->saveVec.push(args->WordP()->Get(1)), extension, &exports); 631#elif defined(HAVE_MACH_O_RELOC_H) 632 // Mac OS-X 633 const char *extension = ".o"; 634 MachoExport exports; 635 exporter(taskData, taskData->saveVec.push(args->WordP()->Get(0)), 636 taskData->saveVec.push(args->WordP()->Get(1)), extension, &exports); 637#else 638 raise_exception_string (taskData, EXC_Fail, "Native export not available for this platform"); 639#endif 640 return taskData->saveVec.push(TAGGED(0)); 641} 642 643Handle exportPortable(TaskData *taskData, Handle args) 644{ 645 PExport exports; 646 exporter(taskData, taskData->saveVec.push(args->WordP()->Get(0)), 647 taskData->saveVec.push(args->WordP()->Get(1)), _T(".txt"), &exports); 648 return taskData->saveVec.push(TAGGED(0)); 649} 650 651POLYUNSIGNED PolyExport(PolyObject *threadId, PolyWord fileName, PolyWord root) 652{ 653 TaskData *taskData = TaskData::FindTaskForId(threadId); 654 ASSERT(taskData != 0); 655 taskData->PreRTSCall(); 656 Handle reset = taskData->saveVec.mark(); 657 Handle pushedName = taskData->saveVec.push(fileName); 658 Handle pushedRoot = taskData->saveVec.push(root); 659 660 try { 661#ifdef HAVE_PECOFF 662 // Windows including Cygwin 663#if (defined(_WIN32) && ! defined(__CYGWIN__)) 664 const TCHAR *extension = _T(".obj"); // Windows 665#else 666 const char *extension = ".o"; // Cygwin 667#endif 668 PECOFFExport exports; 669 exporter(taskData, pushedName, pushedRoot, extension, &exports); 670#elif defined(HAVE_ELF_H) || defined(HAVE_ELF_ABI_H) 671 // Most Unix including Linux, FreeBSD and Solaris. 672 const char *extension = ".o"; 673 ELFExport exports; 674 exporter(taskData, pushedName, pushedRoot, extension, &exports); 675#elif defined(HAVE_MACH_O_RELOC_H) 676 // Mac OS-X 677 const char *extension = ".o"; 678 MachoExport exports; 679 exporter(taskData, pushedName, pushedRoot, extension, &exports); 680#else 681 raise_exception_string (taskData, EXC_Fail, "Native export not available for this platform"); 682#endif 683 } catch (...) { } // If an ML exception is raised 684 685 taskData->saveVec.reset(reset); 686 taskData->PostRTSCall(); 687 return TAGGED(0).AsUnsigned(); // Returns unit 688} 689 690POLYUNSIGNED PolyExportPortable(PolyObject *threadId, PolyWord fileName, PolyWord root) 691{ 692 TaskData *taskData = TaskData::FindTaskForId(threadId); 693 ASSERT(taskData != 0); 694 taskData->PreRTSCall(); 695 Handle reset = taskData->saveVec.mark(); 696 Handle pushedName = taskData->saveVec.push(fileName); 697 Handle pushedRoot = taskData->saveVec.push(root); 698 699 try { 700 PExport exports; 701 exporter(taskData, pushedName, pushedRoot, _T(".txt"), &exports); 702 } catch (...) { } // If an ML exception is raised 703 704 taskData->saveVec.reset(reset); 705 taskData->PostRTSCall(); 706 return TAGGED(0).AsUnsigned(); // Returns unit 707} 708 709 710// Helper functions for exporting. We need to produce relocation information 711// and this code is common to every method. 712Exporter::Exporter(unsigned int h): exportFile(NULL), errorMessage(0), hierarchy(h), memTable(0), newAreas(0) 713{ 714} 715 716Exporter::~Exporter() 717{ 718 delete[](memTable); 719 if (exportFile) 720 fclose(exportFile); 721} 722 723void Exporter::relocateValue(PolyWord *pt) 724{ 725 PolyWord q = *pt; 726 if (IS_INT(q) || q == PolyWord::FromUnsigned(0)) {} 727 else createRelocation(pt); 728} 729 730// Check through the areas to see where the address is. It must be 731// in one of them. 732unsigned Exporter::findArea(void *p) 733{ 734 for (unsigned i = 0; i < memTableEntries; i++) 735 { 736 if (p > memTable[i].mtAddr && 737 p <= (char*)memTable[i].mtAddr + memTable[i].mtLength) 738 return i; 739 } 740 { ASSERT(0); } 741 return 0; 742} 743 744void Exporter::relocateObject(PolyObject *p) 745{ 746 if (p->IsByteObject()) 747 { 748 if (p->IsMutable() && p->IsWeakRefObject()) 749 { 750 // Weak mutable byte refs are used for external references and 751 // also in the FFI for non-persistent values. 752 bool isFuncPtr = true; 753 const char *entryName = getEntryPointName(p, &isFuncPtr); 754 if (entryName != 0) addExternalReference(p, entryName, isFuncPtr); 755 // Clear the first word of the data. 756 ASSERT(p->Length() > 0); 757 p->Set(0, PolyWord::FromSigned(0)); 758 } 759 } 760 else if (p->IsCodeObject()) 761 { 762 POLYUNSIGNED constCount; 763 PolyWord *cp; 764 ASSERT(! p->IsMutable() ); 765 p->GetConstSegmentForCode(cp, constCount); 766 /* Now the constants. */ 767 for (POLYUNSIGNED i = 0; i < constCount; i++) relocateValue(&(cp[i])); 768 769 } 770 else /* Ordinary objects, essentially tuples. */ 771 { 772 POLYUNSIGNED length = p->Length(); 773 for (POLYUNSIGNED i = 0; i < length; i++) relocateValue(p->Offset(i)); 774 } 775} 776 777ExportStringTable::ExportStringTable(): strings(0), stringSize(0), stringAvailable(0) 778{ 779} 780 781ExportStringTable::~ExportStringTable() 782{ 783 free(strings); 784} 785 786// Add a string to the string table, growing it if necessary. 787unsigned long ExportStringTable::makeEntry(const char *str) 788{ 789 unsigned len = (unsigned)strlen(str); 790 unsigned long entry = stringSize; 791 if (stringSize + len + 1 > stringAvailable) 792 { 793 stringAvailable = stringAvailable+stringAvailable/2; 794 if (stringAvailable < stringSize + len + 1) 795 stringAvailable = stringSize + len + 1 + 500; 796 strings = (char*)realloc(strings, stringAvailable); 797 if (strings == 0) 798 { 799 if (debugOptions & DEBUG_SAVING) 800 Log("SAVE: Unable to realloc string table, size: %lu.\n", stringAvailable); 801 throw MemoryException(); 802 } 803 } 804 strcpy(strings + stringSize, str); 805 stringSize += len + 1; 806 return entry; 807} 808 809struct _entrypts exporterEPT[] = 810{ 811 { "PolyExport", (polyRTSFunction)&PolyExport}, 812 { "PolyExportPortable", (polyRTSFunction)&PolyExportPortable}, 813 814 { NULL, NULL} // End of list. 815}; 816