/* syscwin.c Copyright (C) 1989-2002 Codemist Ltd */ /* * Windows 95, 98, NT and 2000, XP support, using MFC via the "cwin" package. * Should also be OK for Windows 3.x if "win32s" is used, although I think * I now count Windows 3.x/win32s as "out of date, unsupported". */ /* * This code may be used and modified, and redistributed in binary * or source form, subject to the "CCL Public License", which should * accompany it. This license is a variant on the BSD license, and thus * permits use of code derived from this in either open and commercial * projects: but it does require that updates to this code be made * available back to the originators of the package. * Before merging other code in with this or linking this code * with other packages or libraries please check that the license terms * of the other material are compatible with those of this. */ /* Signature: 4f874860 10-Oct-2002 */ #include #include #include #include #include #ifdef __cplusplus #include #else #include #endif #include "machine.h" #include "tags.h" #include "externs.h" #include "read.h" #include "cslerror.h" #include "sys.h" #include "cwin.h" #ifdef TIMEOUT #include "timeout.h" #endif #ifdef __WATCOMC__ #include #endif #include #include #include #include #include #ifdef _MSC_VER #define strdup(x) _strdup(x) #endif #ifndef SOFTWARE_TICKS void CALLBACK deal_with_tick(UINT idevent, UINT x1, DWORD x2, DWORD x3, DWORD x4) /* * A timer arranges to call me back kere about 5 times per second. * Since this call is not synchronised with anything else all I do is * set flags that will be looked at by other bits of code. */ { if (tick_pending == 0) { if (already_in_gc) tick_on_gc_exit = YES; else { Lisp_Object nil = C_nil; CSLbool xxx = NO; if (exception_pending()) flip_exception(), xxx = YES; tick_pending = YES; saveheaplimit = heaplimit; heaplimit = fringe; savevheaplimit = vheaplimit; vheaplimit = vfringe; savecodelimit = codelimit; codelimit = codefringe; savestacklimit = stacklimit; stacklimit = stackbase; if (xxx) flip_exception(); } } } #endif static CSLbool ticker_active = NO; void add_ticker(void) { if (ticker_active) return; #ifdef SOFTWARE_TICKS countdown = SOFTWARE_TICKS; #else /* * I take an interrupt 5 times per second... */ // my_timer = SetTimer(my_window, (UINT)1, (UINT)200, // (TIMERPROC)deal_with_tick); timeBeginPeriod(200); my_timer = timeSetEvent(200, 200, (LPTIMECALLBACK)deal_with_tick, 0, TIME_PERIODIC); if (my_timer == 0) { alert_box("Failed to start up the timer"); ticker_active = NO; /* Actually a shambles */ } else #endif ticker_active = YES; } void MS_CDECL remove_ticker(void) { if (!ticker_active) return; #ifndef SOFTWARE_TICKS // KillTimer(my_window, my_timer); timeKillEvent(my_timer); timeEndPeriod(200); #endif ticker_active = NO; } /* * void poll_for_attn() * { * kbhit(); // causes ^C to be noticed! * } */ static clock_t prev_clock = 0; #ifdef INITIAL_SOFTWARE_TICKS int32 software_ticks = INITIAL_SOFTWARE_TICKS; int32 software_tick_count = 0, prev_software_tick_count = 0; #endif void accept_tick(void) { /* * This is where I can put things that need to be done regularly. At * In particular I can poll the window manager here. */ /* * Around once per 2 seconds I update the clock display on the menu bar - * the intent of this is to give a bit of feedback to the user that * things are happening. NOTE WELL: I tune all this in terms of CPU time * (measured with clock()) rather than wall-clock time (time()). On * a multi-tasking system this means that a Lisp task running at low * priority in the background will hardly poll at all, and one that is * suspended (if such a possibility can arise) will not do a lot. But * I HOPE that CPU time is not consumed while one is suspended awaiting * keyboard input, and so that sort of delay should not cause messups * in my "learning" of the correct poll rate. */ clock_t t0 = clock(); #ifdef SOFTWARE_TICKS_PER_SECOND software_tick_count++; #endif if (prev_clock == 0 || t0 > prev_clock + 2*CLOCKS_PER_SEC) { long int t, gct; Lisp_Object nil; ensure_screen(); nil = C_nil; if (exception_pending()) return; #ifdef SOFTWARE_TICKS_PER_SECOND if (prev_clock != 0) { double t1 = (double)(t0-prev_clock)/(double)CLOCKS_PER_SEC; double ratio = (double)(software_tick_count - prev_software_tick_count)/t1; int32 w; /* * t1 is how long since I was last here, ratio is the number of * ticks per second over that time-span. */ ratio = ratio / (double)SOFTWARE_TICKS_PER_SECOND; prev_software_tick_count = software_tick_count; /* * Now ratio is the extent by which I was taking ticks too fast. * To dampen out my correction I will scale software_ticks by the * square root of this. */ ratio = sqrt(ratio); w = (int)(1000.0 * ratio); /* * I clamp the correction factor so I never adjust my clock rate by * a factor of more than (about) 3. */ if (w > 3000) w = 3000; else if (w < 300) w = 300; /* * Furthermore I attempt to keep software_ticks within integer range. */ if (software_ticks < (0x7fffffff/3000) && software_ticks > 50) software_ticks = (w*software_ticks)/1000; } #endif t0 = clock(); if (clock_stack == &consolidated_time[0]) { consolidated_time[0] += (double)(t0 - base_time)/(double)CLOCKS_PER_SEC; base_time = t0; } t = (long int)(100.0 * consolidated_time[0]); gct = (long int)(100.0 * gc_time); report_time(t, gct); prev_clock = t0; } cwin_poll_window_manager(0); if (cwin_interrupt_pending != 0) { Lisp_Object nil = C_nil; interrupt_pending = YES; if (exception_pending()) nil = (Lisp_Object)((int32)nil ^ 1); miscflags |= HEADLINE_FLAG | MESSAGES_FLAG; cwin_interrupt_pending = 0; } } void putc_stdout(int c) { if (alternative_stdout != NULL) putc(c, alternative_stdout); else cwin_putchar(c); } void pause_for_user(void) { } int pipes_today = 0; int win32s = 0; void flush_screen(void) { cwin_ensure_screen(); } void start_up_window_manager(int use_wimp) { int32 n = GetVersion(); CSL_IGNORE(use_wimp); /* on this platform ALWAYS use the window system */ switch (n & 0xc0000000) { case 0: win32s = 0; /* NT, 2000, XP */ pipes_today = 1; break; case 0x80000000: default: win32s = 1; /* win32s */ pipes_today = 0; break; case 0xc0000000: win32s = 2; /* Windows 95 */ pipes_today = 1; break; } } int wimpget(char *buf) { int c, n=0; Lisp_Object nil; ensure_screen(); nil = C_nil; if (exception_pending()) return 0; while (n < 255) { c = cwin_getchar(); nil = C_nil; if (exception_pending() || c == EOF) return 0; c = c & 0xff; buf[n++] = (char)c; if (c == '\n') break; }; return n; } /* * Slightly optional jollies re GC statistics... */ static char time_string[32], space_string[32]; void report_time(int32 t, int32 gct) { sprintf(time_string, "%ld.%.2ld+%ld.%.2ld secs ", t/100L, t%100L, gct/100L, gct%100L); if ((window_heading & 1) == 0) cwin_report_left(time_string); } void report_space(int n, double percent) { sprintf(space_string, "[GC %d]:%.2f%%", n, percent); if ((window_heading & 4) == 0) cwin_report_right(space_string); } /* * End of the worst of the window-manager aware code */ #undef exit #define exit(a) my_exit(a) #include "fileops.c" #include "scandir.c" /* * To the extent that I believe that versions of Windows that support long * file names are now readily available, and that compatibility with older * systems is ridiculous, I disable the conversion to 8+3 format shown * here. The particular bit of sample code that convinced me was attempting * to create files with names like xxx.html where each file contained the * names of other files in the set. And truncation to xxx.htm meant that the * cross-references failed. Ugh. */ #ifdef EIGHT_PLUS_THREE /* * Windows 95 can support long file names, but Windows 3.x and DOS do not. * This is in fact a potential cause of big mess. What I do here is to * truncate all file-names to 8+3 format. The effect will be that if files * have been set up for use with Windows 3.x they will still work, and files * created by and used ONLY by this system will be OK. But if a Windows-95 * utility is used to create a file with a long name then I will not be able * to use that name to access it. Users beware! */ static void eight_plus_three(char *s) { int c, i=0; char *p=s; while ((c=*p++)!=0 && c!='.' && c!='\\' && c!=':') i++; if (c==':') return; if (i>8) { char *q=s+8; p--; while ((*q++=*p++)!=0); p=s+9; } if (c!='.') return; i=0; s=p; while ((c=*p++)!=0 && c!='\\') i++; if (i>3) { char *q=s+3; p--; while ((*q++=*p++)!=0); } } #endif #include "filename.c" int change_directory(char *filename, char *old, size_t n) { process_file_name(filename, old, n); if (*filename == 0) return 1; #ifdef _MSC_VER if (_chdir(filename)) #else if (chdir(filename)) #endif { char err_buf[LONGEST_LEGAL_FILENAME+100]; switch (errno) { case ENOENT: sprintf(err_buf,"The directory %s does not exist.",filename); break; default: sprintf(err_buf,"Cannot change directory to %s.",filename); break; } aerror0(err_buf); return 1; } else return 0; } int create_directory(char *filename, char *old, size_t n) { process_file_name(filename, old, n); if (*filename == 0) return 1; #ifdef _MSC_VER return _mkdir(filename); #else return mkdir(filename); #endif } CSLbool file_exists(char *filename, char *old, size_t n, char *tt) { #ifdef _MSC_VER struct _stat statbuff; #else struct stat statbuff; #endif process_file_name(filename, old, n); if (*filename == 0) return NO; #ifdef _MSC_VER if (_stat(filename, &statbuff) != 0) return NO; #else if (stat(filename, &statbuff) != 0) return NO; #endif strcpy(tt, ctime(&(statbuff.st_mtime))); return YES; } static void remove_files(char *name, int dirp, long int size) /* * Remove a file, or a directory and all its contents. This function * can still misbehave if you do not have write access to all the files * involved. */ { size = size; switch (dirp) { case SCAN_ENDDIR: #ifdef _MSC_VER _rmdir(name); return; #else rmdir(name); return; #endif case SCAN_FILE: remove(name); return; } } int delete_file(char *filename, char *old, size_t n) { process_file_name(filename, old, n); if (*filename == 0) return 1; scan_directory(filename, remove_files); return 0; } long file_length(char *filename, char *old, size_t n) { #ifdef _MSC_VER struct _stat buf; #else struct stat buf; #endif process_file_name(filename, old, n); if (*filename == 0) return 0; #ifdef _MSC_VER if (_stat(filename,&buf) == -1) return -1; #else if (stat(filename,&buf) == -1) return -1; #endif return (long)(buf.st_size); } int directoryp(char *filename, char *old, size_t n) { process_file_name(filename, old, n); if (*filename == 0) return 0; return (GetFileAttributes(filename) == FILE_ATTRIBUTE_DIRECTORY); } extern char *get_truename(char *filename, char *old, size_t n) { #ifdef _MSC_VER struct _stat buf; #else struct stat buf; #endif char *temp, *fn, *dir, *pwd; process_file_name(filename, old, n); if (*filename == 0) aerror("truename"); /* Find out whether we have a file or a directory. Be careful in case * the first two characters define a drive. */ if (0 /* strlen(filename) > 2 && *(filename+1) == ':' */) { /* * Again beware the fact that aerror0 does not change the flow of control. */ #ifdef _MSC_VER if (_stat(filename+2,&buf) == -1) aerror0("truename: cannot stat file"); #else if (stat(filename+2,&buf) == -1) aerror0("truename: cannot stat file"); #endif } else { #ifdef _MSC_VER if (_stat(filename,&buf) == -1) aerror0("truename: cannot stat file"); #else if (stat(filename,&buf) == -1) aerror0("truename: cannot stat file"); #endif } /* Store current directory */ #ifdef _MSC_VER if ((pwd = (char *)_getcwd((char *)NULL, LONGEST_LEGAL_FILENAME)) == NULL) #else if ((pwd = (char *)getcwd((char *)NULL, LONGEST_LEGAL_FILENAME)) == NULL) #endif aerror0("truename: cannot get current working directory"); if ((buf.st_mode & S_IFMT) == S_IFDIR) { /* We have a directory */ char *dir = (char*)(*malloc_hook)(LONGEST_LEGAL_FILENAME); #ifdef _MSC_VER if (_chdir(filename) != 0) aerror0("truename: cannot change directory"); if (_getcwd(dir ,LONGEST_LEGAL_FILENAME) == NULL) aerror0("truename: cannot get current working directory"); if (_chdir(pwd) != 0) aerror0("truename: cannot change directory"); #else if (chdir(filename) != 0) aerror0("truename: cannot change directory"); if (getcwd(dir ,LONGEST_LEGAL_FILENAME) == NULL) aerror0("truename: cannot get current working directory"); if (chdir(pwd) != 0) aerror0("truename: cannot change directory"); #endif (*free_hook)(pwd); /* * This is an axiom-specific hack --- it expects that truname * preserves trailing directory characters. */ if (old[n-1] == '\\' || old[n-1] == '/' && dir[strlen(dir)-1] != '\\') { n = strlen(dir); dir[n] = '\\'; dir[n+1] = '\0'; } return dir; } else { /* Assume we have some kind of file */ temp = strrchr(filename,'\\'); if (temp) { /* Found a directory component */ fn = strdup(temp); *temp = '\0'; /* fn is now "\file" and filename is the directory */ #ifdef _MSC_VER if (_chdir(filename) != 0) aerror0("truename: cannot change directory"); if ((temp = (char *)_getcwd((char *)NULL,LONGEST_LEGAL_FILENAME)) == NULL) aerror0("truename: cannot get current working directory"); if (_chdir(pwd) != 0) aerror0("truename: cannot change directory"); #else if (chdir(filename) != 0) aerror0("truename: cannot change directory"); if ((temp = (char *)getcwd((char *)NULL,LONGEST_LEGAL_FILENAME)) == NULL) aerror0("truename: cannot get current working directory"); if (chdir(pwd) != 0) aerror0("truename: cannot change directory"); #endif dir = (char *)(*malloc_hook)((strlen(temp) + strlen(fn) + 1)*sizeof(char)); strcpy(dir,temp); (*free_hook)(temp); strcat(dir, fn); (*free_hook)(pwd); (*free_hook)(fn); return dir; } else { dir = (char *)(*malloc_hook)((strlen(pwd) + strlen(filename) + 2)*sizeof(char)); strcpy(dir, pwd); strcat(dir, "\\"); strcat(dir,filename); (*free_hook)(pwd); return dir; } } } int get_current_directory(char *s, int n) { int n1 = GetCurrentDirectory(n, s); if (n1 == 0) { aerror0("cannot get current directory name"); return 0; } else if (n1 >= n) { aerror("the pathname of the current directory is too long"); return 0; } else return n1; } #ifdef NAG_VERSION #define MAX_NUMBER_OF_FILES 2048 int list_directory_members(char *filename, char *old, char **filelist[], size_t n) { WIN32_FIND_DATA fileData; HANDLE fileHandle; int32 number_of_entries = 1; char **files; process_file_name(filename, old, n); if (*filename == 0) strcpy(filename,"*.*"); else if (filename[strlen(filename)-1] != '\\') filename=strcat(filename,"\\*.*"); else filename=strcat(filename,"*.*"); fileHandle = FindFirstFile(filename,&fileData); if (fileHandle == INVALID_HANDLE_VALUE) return 0; /* * The fixed allocation size here seems unsatisfactory, but I will leave it * like that for the moment because altering things to behave better would * probably involve redesigning the interface to this function. */ files=(char **)(*malloc_hook)(MAX_NUMBER_OF_FILES*sizeof(char *)); files[0]=strdup(fileData.cFileName); while(FindNextFile(fileHandle,&fileData)) { files[number_of_entries] = strdup(fileData.cFileName); number_of_entries++; } FindClose(fileHandle); *filelist = files; return number_of_entries; } #else void list_directory_members(char *filename, char *old, size_t n, directory_callback *fn) { process_file_name(filename, old, n); scan_files(filename, fn); } #endif /* * The following few lines are an attempt to provide compatibility * between Watcom C 11.0 and Microsoft Visual C++ version 5... Both provide * a stat() function but they use different names for the bits that * can be used to test if files are readable or writable. */ #ifndef S_IRUSR #define S_IRUSR _S_IREAD #endif #ifndef S_IWUSR #define S_IWUSR _S_IWRITE #endif int file_readable(char *filename, char *old, size_t n) { #ifdef _MSC_VER struct _stat buf; #else struct stat buf; #endif process_file_name(filename, old, n); if (*filename == 0) return 0; #ifdef _MSC_VER if (_stat(filename,&buf) == -1) #else if (stat(filename,&buf) == -1) #endif return 0; /* File probably does not exist */ else return (buf.st_mode & S_IRUSR); } int file_writeable(char *filename, char *old, size_t n) { #ifdef _MSC_VER struct _stat buf; #else struct stat buf; #endif process_file_name(filename, old, n); if (*filename == 0) return 0; #ifdef _MSC_VER if (_stat(filename,&buf) == -1) #else if (stat(filename,&buf) == -1) #endif return 0; /* Should we check to see if the directory is writeable? */ else return (buf.st_mode & S_IWUSR); } int rename_file(char *from_name, char *from_old, size_t from_size, char *to_name, char *to_old, size_t to_size) { process_file_name(from_name, from_old, from_size); process_file_name(to_name, to_old, to_size); if (*from_name == 0 || *to_name == 0) return 0; return rename(from_name,to_name); } /* * It appears to me that "system" as provided by the Windows NT SDK * libraries is a real mess. This is perhaps because executing a * command might want to generate terminal output, so when one invokes * "system" it first pops up a console window running the command * interpreter, then loads the thing you wanted executed, and then * closes everything down - probably before you have had any real * chance to observe any output that was generated. I might therefore * want to invent a version of my own... as in here using CreateProcess. * The issues about Win32 vs Win32s incompatibilities here are HORRID. */ static HANDLE osRunRedirect(char *cmd, BOOL wait, HANDLE hin, HANDLE hout, HANDLE herr); static HANDLE osMakeReadPipe(char *cmd, HANDLE *); static char *osMangleCommand(char *s); int my_system(char *s) { HANDLE h, hproc; DWORD retCode; char buf[256]; char *os; DWORD nread; BOOL done = FALSE; os = s; s = osMangleCommand(s); h = osMakeReadPipe(s, &hproc); if (s != os) free(s); if (h==NULL) { term_printf("Failed: %d\n", GetLastError()); CloseHandle(hproc); return 0; } while (!done) { DWORD i; BOOL res; res = ReadFile(h, (void*) buf, 256, &nread, NULL); if (res == TRUE && nread == 0 && GetExitCodeProcess(hproc, &retCode) != STILL_ACTIVE) { done = TRUE; } else if (!res) { int err = GetLastError(); if (GetExitCodeProcess(hproc, &retCode) == STILL_ACTIVE) { term_printf("Error: %d\n", err); CloseHandle(hproc); CloseHandle(h); return -1; } return retCode; } else { for (i=0; i_file); */ } /* * The next procedure is responsible for establishing information about * where the main checkpoint image should be recovered from, and where * and fasl files should come from. */ char *find_image_directory(int argc, char *argv[]) { char *w; int i = strlen(cwin_full_program_name), j; strcpy(program_name, programName); CSL_IGNORE(argc); CSL_IGNORE(argv); /* * If the current program is called c:\aaa\xxx.exe, then I look * for a file c:\aaa\xxx.img */ w = (char *)(*malloc_hook)(i+1); if (w == NULL) { fprintf(stderr, "\n+++ Panic - run out of space\n"); my_exit(EXIT_FAILURE); } strcpy(w, cwin_full_program_name); /* * Windows file-names are not case-sensitive when you search, but * I think names look neater in lower case so I force things here. */ for (j=i-4; j>=0; j--) { if (w[j] == '\\' || w[j] == '/') break; w[j] = (char)tolower(w[j]); } w[i-3] = 'i'; w[i-2] = 'm'; w[i-1] = 'g'; return w; } CSLbool sigint_must_longjmp = NO; jmp_buf sigint_buf; void MS_CDECL sigint_handler(int code) { CSL_IGNORE(code); interrupt_pending = 1; if (sigint_must_longjmp) { sigint_must_longjmp = 0; longjmp(sigint_buf, 1); } return; } /* * The following function controls memory allocation policy */ int32 ok_to_grab_memory(int32 current) { MEMORYSTATUS w; memset(&w, 0, sizeof(w)); w.dwLength = sizeof(w); GlobalMemoryStatus(&w); #ifdef NOT_CONFIDENT_ENOUGH_HIDE_THIS_TRASH term_printf("memStats %d %d %d %d %d %d %d %d\n", w.dwLength, w.dwMemoryLoad, w.dwTotalPhys, w.dwAvailPhys, w.dwTotalPageFile, w.dwAvailPageFile, w.dwTotalVirtual, w.dwAvailVirtual); #endif if (w.dwTotalPhys == 0) { #ifdef COMMON return current; #else return 3*current + 2; #endif } else /* * Here we seem to be running under win32 (not win32s) and can measure how * much memory is currently available for this process. I will grab space * until win32 is using all the physical memory there is. After that I will * tend to grow much more cautiously. */ { int32 freemem = w.dwAvailPhys / CSL_PAGE_SIZE; if (freemem == 0) return current / 2 + 1; if (freemem > 3*current + 2) freemem = 3*current + 2; return freemem; } } /* end of syscwin.c */