/***********************************************************************/ /* */ /* Objective Caml */ /* */ /* Developed by Jacob Navia. */ /* Copyright 2001 Institut National de Recherche en Informatique et */ /* en Automatique. All rights reserved. This file is distributed */ /* under the terms of the GNU Library General Public License, with */ /* the special exception on linking described in file ../LICENSE. */ /* */ /***********************************************************************/ /***********************************************************************/ /* Changes made by Chris Watford to enhance the source editor */ /* Began 14 Sept 2003 - watford@uiuc.edu */ /***********************************************************************/ /* $Id$ */ #include #include #include #include #include "inria.h" PROCESS_INFORMATION pi; #define BUFSIZE 4096 STARTUPINFO startInfo; /*------------------------------------------------------------------------ Procedure: ShowDbgMsg ID:1 Purpose: Puts up a dialog box with a message, forcing it to the foreground. Input: Output: Errors: ------------------------------------------------------------------------*/ void ShowDbgMsg(char *str) { HWND hWnd; char p[20], message[255]; hWnd = hwndMain; if (IsIconic(hWnd)){ ShowWindow(hWnd,SW_RESTORE); } strncpy(message, str, 254); message[254] = 0; strcpy(p, "Error"); MessageBox(hWnd, message, p, MB_OK | MB_ICONHAND|MB_TASKMODAL|MB_SETFOREGROUND); } int AskYesOrNo(char *msg) { HWND hwnd; int r; hwnd = hwndMain; r = MessageBox(hwnd, msg, "Ocaml", MB_YESNO | MB_SETFOREGROUND); if (r == IDYES) return (TRUE); return (FALSE); } static DWORD OcamlStatus; static int RegistryError(void) { char buf[512]; wsprintf(buf,"Error %d writing to the registry",GetLastError()); ShowDbgMsg(buf); return 0; } static int ReadRegistry(HKEY hroot, char * p1, char * p2, char * p3, char dest[1024]) { HKEY h1, h2; DWORD dwType; unsigned long size; LONG ret; if (RegOpenKeyExA(hroot, p1, 0, KEY_QUERY_VALUE, &h1) != ERROR_SUCCESS) return 0; if (RegOpenKeyExA(h1, p2, 0, KEY_QUERY_VALUE, &h2) != ERROR_SUCCESS) { RegCloseKey(h1); return 0; } dwType = REG_SZ; size = 1024; ret = RegQueryValueExA(h2, p3, 0, &dwType, dest, &size); RegCloseKey(h2); RegCloseKey(h1); return ret == ERROR_SUCCESS; } static int WriteRegistry(HKEY hroot, char * p1, char * p2, char * p3, char data[1024]) { HKEY h1, h2; DWORD disp; LONG ret; if (RegOpenKeyExA(hroot, p1, 0, KEY_QUERY_VALUE, &h1) != ERROR_SUCCESS) return 0; if (RegCreateKeyExA(h1, p2, 0, NULL, 0, KEY_ALL_ACCESS, NULL, &h2, &disp) != ERROR_SUCCESS) { RegCloseKey(h1); return 0; } ret = RegSetValueEx(h2, p3, 0, REG_SZ, data, strlen(data) + 1); RegCloseKey(h2); RegCloseKey(h1); return ret == ERROR_SUCCESS; } /*------------------------------------------------------------------------ Procedure: GetOcamlPath ID:1 Purpose: Read the registry key HKEY_LOCAL_MACHINE\Software\Objective Caml or HKEY_CURRENT_USER\Software\Objective Caml, and creates it if it doesn't exists. If any error occurs, i.e. the given path doesn't exist, or the key didn't exist, it will put up a browse dialog box to allow the user to enter the path. The path will be verified that it points to a file that exists. If that file is in a directory called 'bin', it will look for another directory in the same level called lib' and set the Lib path to that. Input: None explicit Output: 1 means sucess, zero failure Errors: Almost all system calls will be verified ------------------------------------------------------------------------*/ int GetOcamlPath(void) { char path[1024], *p; while (( !ReadRegistry(HKEY_CURRENT_USER, "Software", "Objective Caml", "InterpreterPath", path) && !ReadRegistry(HKEY_LOCAL_MACHINE, "Software", "Objective Caml", "InterpreterPath", path)) || _access(path, 0) != 0) { /* Registry key doesn't exist or contains invalid path */ /* Ask user */ if (!BrowseForFile("Ocaml interpreter|ocaml.exe", path)) { ShowDbgMsg("Impossible to find ocaml.exe. I quit"); exit(0); } WriteRegistry(HKEY_CURRENT_USER, "Software", "Objective Caml", "InterpreterPath", path); /* Iterate to validate again */ } strcpy(OcamlPath, path); p = strrchr(OcamlPath,'\\'); if (p) { *p = 0; strcpy(LibDir,OcamlPath); *p = '\\'; p = strrchr(LibDir,'\\'); if (p && !stricmp(p,"\\bin")) { *p = 0; strcat(LibDir,"\\lib"); } } return 1; } static HANDLE hChildStdinRd, hChildStdinWr,hChildStdoutRd, hChildStdoutWr; /*------------------------------------------------------------------------ Procedure: IsWindowsNT ID:1 Purpose: Returns 1 if we are running under windows NT, zero otherwise. Input: None Output: 1 or zero Errors: ------------------------------------------------------------------------*/ int IsWindowsNT(void) { OSVERSIONINFO osv; osv.dwOSVersionInfoSize = sizeof(osv); GetVersionEx(&osv); return(osv.dwPlatformId == VER_PLATFORM_WIN32_NT); } /*------------------------------------------------------------------------ Procedure: DoStartOcaml ID:1 Purpose: Starts the ocaml interpreter ocaml.exe. The standard input of the interpreter will be connected to a pipe, and the standard output and standard error to another pipe. The interpreter starts as a hidden process, showing only in the task list. Since this is in an own thread, its workings are independent of the rest of the program. After starting the interpreter, the thread waits in case the interpreter exits, for instance if the user or some program types #quit;;. In this case, the waiting thread awakens and exits the user interface. Input: Not used. It uses the OcamlPath global variable, that is supposed to be correct, no test for its validity are done here. Output: None visible Errors: If any system call for whatever reason fails, the thread will exit. No error message is shown. ------------------------------------------------------------------------*/ DWORD WINAPI DoStartOcaml(LPVOID param) { HWND hwndParent = (HWND) param; char *cmdline; int processStarted; LPSECURITY_ATTRIBUTES lpsa=NULL; SECURITY_ATTRIBUTES sa; SECURITY_DESCRIPTOR sd; sa.nLength = sizeof(SECURITY_ATTRIBUTES); // Under windows NT/2000/Whistler we have to initialize the security descriptors // This is not necessary under windows 98/95. if (IsWindowsNT()) { InitializeSecurityDescriptor(&sd,SECURITY_DESCRIPTOR_REVISION); SetSecurityDescriptorDacl(&sd,TRUE,NULL,FALSE); sa.bInheritHandle = TRUE; sa.lpSecurityDescriptor = &sd; lpsa = &sa; } memset(&startInfo,0,sizeof(STARTUPINFO)); startInfo.cb = sizeof(STARTUPINFO); // Create a pipe for the child process's STDOUT. if (! CreatePipe(&hChildStdoutRd, &hChildStdoutWr, &sa, 0)) return 0; // Create a pipe for the child process's STDIN. if (! CreatePipe(&hChildStdinRd, &hChildStdinWr, &sa, 0)) return 0; // Setup the start info structure startInfo.dwFlags = STARTF_USESTDHANDLES|STARTF_USESHOWWINDOW; startInfo.wShowWindow = SW_HIDE; startInfo.hStdOutput = hChildStdoutWr; startInfo.hStdError = hChildStdoutWr; startInfo.hStdInput = hChildStdinRd; cmdline = OcamlPath; // Set the OCAMLLIB environment variable SetEnvironmentVariable("OCAMLLIB", LibDir); // Let's go: start the ocaml interpreter processStarted = CreateProcess(NULL,cmdline,lpsa,lpsa,1, CREATE_NEW_PROCESS_GROUP|NORMAL_PRIORITY_CLASS, NULL,ProgramParams.CurrentWorkingDir,&startInfo,&pi); if (processStarted) { WaitForSingleObject(pi.hProcess,INFINITE); GetExitCodeProcess(pi.hProcess,(unsigned long *)&OcamlStatus); CloseHandle(pi.hProcess); PostMessage(hwndMain,WM_QUITOCAML,0,0); } else { char *msg = malloc(1024); wsprintf(msg,"Impossible to start ocaml.exe in:\n%s",cmdline); ShowDbgMsg(msg); free(msg); } return 0; } /*------------------------------------------------------------------------ Procedure: WriteToPipe ID:1 Purpose: Writes the given character string to the standard input of the interpreter Input: The character string (zero terminated) to be written Output: The number of characters written or zero if an error occurs Errors: None ------------------------------------------------------------------------*/ int WriteToPipe(char *data) { DWORD dwWritten; if (! WriteFile(hChildStdinWr, data, strlen(data), &dwWritten, NULL)) return 0; return dwWritten; } /*------------------------------------------------------------------------ Procedure: ReadFromPipe ID:1 Purpose: Reads from the standard output of the interpreter and stores the data in the given buffer up to the given length. This is done in a non-blocking manner, i.e. it is safe to call this even if there is no data available. Input: The buffer to be used and its length. Output: Returns the number of characters read from the pipe. Errors: None explicit ------------------------------------------------------------------------*/ int ReadFromPipe(char *data,int len) { DWORD dwRead; PeekNamedPipe(hChildStdoutRd,data,len,NULL,&dwRead,NULL); if (dwRead == 0) return 0; // Read output from the child process, and write to parent's STDOUT. if( !ReadFile( hChildStdoutRd, data, len, &dwRead, NULL) || dwRead == 0) return 0; return dwRead; } static DWORD tid; /*------------------------------------------------------------------------ Procedure: StartOcaml ID:1 Purpose: Starts the thread that will call the ocaml.exe program. Input: Output: Errors: ------------------------------------------------------------------------*/ int StartOcaml(void) { getcwd(ProgramParams.CurrentWorkingDir,sizeof(ProgramParams.CurrentWorkingDir)); CreateThread(NULL,0,DoStartOcaml,hwndMain,0,&tid); return 1; } void *SafeMalloc(int size) { void *result; if (size < 0) { char message[1024]; error: sprintf(message,"Can't allocate %d bytes",size); MessageBox(NULL, message, "Ocaml", MB_OK); exit(-1); } result = malloc(size); if (result == NULL) goto error; return result; } void InterruptOcaml(void) { if (!GenerateConsoleCtrlEvent(CTRL_BREAK_EVENT, pi.dwProcessId)) { char message[1024]; sprintf(message, "GenerateConsole failed: %lu\n", GetLastError()); MessageBox(NULL, message, "Ocaml", MB_OK); } WriteToPipe(" "); }