// Return empty string. PolyWord EmptyString(void) { return (PolyObject*)IoEntry(POLY_SYS_emptystring); }
Handle poly_dispatch_c(TaskData *taskData, Handle args, Handle code) { unsigned c = get_C_unsigned(taskData, DEREFWORDHANDLE(code)); switch (c) { case 1: return exportNative(taskData, args); // Export case 2: raise_syscall(taskData, "C Export has been withdrawn", 0); return 0; case 3: return exportPortable(taskData, args); // Export as portable format case 9: // Return the GIT version if appropriate { return SAVE(C_string_to_Poly(taskData, GitVersion)); } case 10: // Return the RTS version string. { const char *version; switch (machineDependent->MachineArchitecture()) { case MA_Interpreted: version = "Portable-" TextVersion; break; case MA_I386: version = "I386-" TextVersion; break; case MA_X86_64: version = "X86_64-" TextVersion; break; default: version = "Unknown-" TextVersion; break; } return SAVE(C_string_to_Poly(taskData, version)); } case 11: // Return the RTS copyright string return SAVE(C_string_to_Poly(taskData, poly_runtime_system_copyright)); case 12: // Return the architecture { const char *arch; switch (machineDependent->MachineArchitecture()) { case MA_Interpreted: arch = "Interpreted"; break; case MA_I386: arch = "I386"; break; case MA_X86_64: arch = "X86_64"; break; default: arch = "Unknown"; break; } return SAVE(C_string_to_Poly(taskData, arch)); } case 13: // Share common immutable data. { ShareData(taskData, args); return SAVE(TAGGED(0)); } // ObjSize and ShowSize have their own IO vector entries but really they don't // need them. Include them here and add ObjProfile. case 14: return ObjSize(taskData, args); case 15: return ShowSize(taskData, args); case 16: return ObjProfile(taskData, args); /* 17 and 18 are no longer used. */ case 19: // Return the RTS argument help string. return SAVE(C_string_to_Poly(taskData, RTSArgHelp())); case 20: // Write a saved state file. return SaveState(taskData, args); case 21: // Load a saved state file and any ancestors. return LoadState(taskData, false, args); case 22: // Show the hierarchy. return ShowHierarchy(taskData); case 23: // Change the name of the immediate parent stored in a child return RenameParent(taskData, args); case 24: // Return the name of the immediate parent stored in a child return ShowParent(taskData, args); case 25: // Old statistics - now removed case 26: raise_exception_string(taskData, EXC_Fail, "No statistics available"); case 27: // Get number of user statistics available return Make_arbitrary_precision(taskData, N_PS_USER); case 28: // Set an entry in the user stats table. { unsigned index = get_C_unsigned(taskData, DEREFHANDLE(args)->Get(0)); if (index >= N_PS_USER) raise_exception0(taskData, EXC_subscript); POLYSIGNED value = getPolySigned(taskData, DEREFHANDLE(args)->Get(1)); globalStats.setUserCounter(index, value); Make_arbitrary_precision(taskData, 0); } case 29: // Get local statistics. return globalStats.getLocalStatistics(taskData); case 30: // Get remote statistics. The argument is the process ID to get the statistics. return globalStats.getRemoteStatistics(taskData, getPolyUnsigned(taskData, DEREFHANDLE(args))); case 31: // Store a module return StoreModule(taskData, args); case 32: // Load a module return LoadModule(taskData, args); case 33: // Load hierarchy. This provides a complete list of children and parents. return LoadState(taskData, true, args); case 34: // Return the system directory for modules. This is configured differently // in Unix and in Windows. #if (defined(MODULEDIR)) return SAVE(C_string_to_Poly(taskData, Xstr(MODULEDIR))); #elif (defined(_WIN32) && ! defined(__CYGWIN__)) { // 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) { RegCloseKey(hk); // The registry entry should end with a backslash. _tcscat(buff, MODULEDIR); return SAVE(C_string_to_Poly(taskData, buff)); } } RegCloseKey(hk); } return SAVE(C_string_to_Poly(taskData, "")); } #else return SAVE(C_string_to_Poly(taskData, "")); #endif case 50: // GCD return gcd_arbitrary(taskData, SAVE(DEREFHANDLE(args)->Get(0)), SAVE(DEREFHANDLE(args)->Get(1))); case 51: // LCM return lcm_arbitrary(taskData, SAVE(DEREFHANDLE(args)->Get(0)), SAVE(DEREFHANDLE(args)->Get(1))); // These next ones were originally in process_env and have now been moved here, case 100: /* Return the maximum word segment size. */ return taskData->saveVec.push(TAGGED(MAX_OBJECT_SIZE)); case 101: /* Return the maximum string size (in bytes). It is the maximum number of bytes in a segment less one word for the length field. */ return taskData->saveVec.push(TAGGED((MAX_OBJECT_SIZE)*sizeof(PolyWord) - sizeof(PolyWord))); case 102: /* Test whether the supplied address is in the io area. This was previously done by having get_flags return 256 but this was changed so that get_flags simply returns the top byte of the length word. */ { PolyWord *pt = (PolyWord*)DEREFWORDHANDLE(args); if (gMem.IsIOPointer(pt)) return Make_arbitrary_precision(taskData, 1); else return Make_arbitrary_precision(taskData, 0); } case 103: /* Return the register mask for the given function. This is used by the code-generator to find out which registers are modified by the function and so need to be saved if they are used by the caller. */ { PolyObject *pt = DEREFWORDHANDLE(args); if (gMem.IsIOPointer(pt)) { /* IO area. We need to get this from the vector. */ int i; for (i=0; i < POLY_SYS_vecsize; i++) { if (pt == (PolyObject*)IoEntry(i)) { int regMask = taskData->GetIOFunctionRegisterMask(i); POLYUNSIGNED props = rtsProperties(taskData, i); return taskData->saveVec.push(TAGGED(regMask | props)); } } raise_exception_string(taskData, EXC_Fail, "Io pointer not found"); } else { /* We may have a pointer to the code or a pointer to a closure. If it's a closure we have to find the code. */ if (! pt->IsCodeObject() && ! pt->IsByteObject()) pt = pt->Get(0).AsObjPtr(); /* Should now be a code object. */ if (pt->IsCodeObject()) { /* Compiled code. This is the second constant in the constant area. */ PolyWord *codePt = pt->ConstPtrForCode(); PolyWord mask = codePt[1]; // A real mask will be an integer. if (IS_INT(mask)) return SAVE(mask); else raise_exception_string(taskData, EXC_Fail, "Invalid mask"); } else raise_exception_string(taskData, EXC_Fail, "Not a code pointer"); } } case 104: return Make_arbitrary_precision(taskData, POLY_version_number); case 105: /* Get the name of the function. */ { PolyObject *pt = DEREFWORDHANDLE(args); if (gMem.IsIOPointer(pt)) { /* IO area. */ int i; for (i=0; i < POLY_SYS_vecsize; i++) { if (pt == (PolyObject*)IoEntry(i)) { char buff[8]; sprintf(buff, "RTS%d", i); return SAVE(C_string_to_Poly(taskData, buff)); } } raise_syscall(taskData, "Io pointer not found", 0); } else 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 name = codePt[0]; /* May be zero indicating an anonymous segment - return null string. */ if (name == PolyWord::FromUnsigned(0)) return SAVE(C_string_to_Poly(taskData, "")); else return SAVE(name); } else raise_syscall(taskData, "Not a code pointer", 0); } default: { char msg[100]; sprintf(msg, "Unknown poly-specific function: %d", c); raise_exception_string(taskData, EXC_Fail, msg); return 0; } } }