/* syscwin.c Copyright (C) 1989-96 Codemist Ltd */ /* * Windows 95 and NT support, using MFC via the "cwin" package. * Should also be OK for Windows 3.x if "win32s" is used. */ /* Signature: 0da77977 07-Mar-2000 */ #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" #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 fator 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(); 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() { } int pipes_today = 0; int win32s = 0; void flush_screen() { cwin_ensure_screen(); } void start_up_window_manager(int use_wimp) { int32 n = GetVersion(); switch (n & 0xc0000000) { case 0: win32s = 0; /* NT */ 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++] = 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; } 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(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(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((strlen(temp) + strlen(fn) + 1)*sizeof(char)); strcpy(dir,temp); free(temp); strcat(dir, fn); free(pwd); free(fn); return dir; } else { dir = (char *)malloc((strlen(pwd) + strlen(filename) + 2)*sizeof(char)); strcpy(dir, pwd); strcat(dir, "\\"); strcat(dir,filename); free(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(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. */ int my_system(char *s) { #ifdef __WATCOMC__ int i = system(s); _fpreset(); return i; #else STARTUPINFO ss; PROCESS_INFORMATION pp; memset(&ss, 0, sizeof(STARTUPINFO)); ss.cb = sizeof(STARTUPINFO); if (!CreateProcess(NULL, s, NULL, NULL, FALSE, 0, NULL, NULL, &ss, &pp)) return 0; CloseHandle(pp.hProcess); CloseHandle(pp.hThread); return 1; #endif } HWND gnuplot_handle = 0; BOOL CALLBACK find_text(HWND h, LPARAM x) { char buffer[24]; GetClassName(h, buffer, 20); if (strcmp(buffer, "wgnuplot_text") != 0) return TRUE; gnuplot_handle = h; return FALSE; } FILE *my_popen(char *command, char *direction) { /* * Here I take a pretty shameless direction and spot the special case of * opening an output pipe to gnuplot... and hook in a behind-the-scenes * way. */ int i = 0, j; for (;;) { char *name = "gnuplot"; j = i; while (*name && tolower(command[j++]) == *name) name++; if (*name == 0) { HWND parent; #ifdef OLD_API if (WinExec(command, SW_SHOWNORMAL) <= 32) return 0; #else /* * Win32 would rather I used the following long-winded version, which provides * a pile of generality that is irrelevant here! */ STARTUPINFO startup; PROCESS_INFORMATION process; clock_t t0, t1; memset(&startup, 0, sizeof(STARTUPINFO)); startup.cb = sizeof(startup); startup.lpReserved = NULL; startup.lpDesktop = NULL; startup.lpTitle = NULL; startup.dwFlags = STARTF_USESHOWWINDOW; startup.wShowWindow = SW_SHOWNORMAL; startup.cbReserved2 = 0; startup.lpReserved2 = NULL; if (!CreateProcess(NULL, command, NULL, NULL, FALSE, 0, NULL, NULL, &startup, &process)) return 0; #endif gnuplot_handle = 0; t0 = clock(); for (i=0; i<25; i++) /* Give it 5 seconds to appear */ { parent = FindWindow((LPSTR)"wgnuplot_parent", (LPSTR)"gnuplot"); if (parent != 0) break; t0 += CLOCKS_PER_SEC/5; while ((t1 = clock()) < t0) cwin_poll_window_manager(); t0 = t1; } if (parent != 0) { for (i=0; i<10; i++) /* 2 more seconds for the child */ { EnumChildWindows(parent, find_text, 0); if (gnuplot_handle != 0) break; t0 += CLOCKS_PER_SEC/5; while ((t1 = clock()) < t0) cwin_poll_window_manager(); t0 = t1; } } return (FILE *)-1; // special handle for the gnuplot pipe } i++; if (command[i] == 0) break; } #ifdef __WATCOMC__ CSL_IGNORE(command); CSL_IGNORE(direction); return 0; #else return _popen(command, direction); #endif } int my_pipe_putc(int c, FILE *f) { if (f == (FILE *)(-1)) { if (gnuplot_handle == 0) return EOF; if (c == '\n') c = '\r'; SendMessage(gnuplot_handle, WM_CHAR, c, 1L); return c; } else return putc(c, f); } int my_pipe_flush(FILE *f) { if (f != (FILE *)(-1)) return fflush(f); return 0; } void my_pclose(FILE *stream) { if (stream == (FILE *)(-1)) { SendMessage(gnuplot_handle, WM_CHAR, 'q', 1L); SendMessage(gnuplot_handle, WM_CHAR, 'u', 1L); SendMessage(gnuplot_handle, WM_CHAR, 'i', 1L); SendMessage(gnuplot_handle, WM_CHAR, 't', 1L); SendMessage(gnuplot_handle, WM_CHAR, '\r', 1L); return; } #ifdef __WATCOMC__ CSL_IGNORE(stream); #else _pclose(stream); #endif } char *my_getenv(char *s) { /* * Case fold for MSDOS */ char uppercase[LONGEST_LEGAL_FILENAME]; int c; char *p = uppercase; while ((c = *s++) != 0) *p++ = toupper(c); *p = 0; s = uppercase; return getenv(s); } /* * MSDOS does not support the idea of home directories for * users, so in case anybody still wants to use the notation "~" that * would indicate a home directory under Unix I implement something * in terms of environment variables. */ int get_home_directory(char *b, int len) { /* * Worry about "len" here... */ char *w = my_getenv("home"); if (w != NULL) strcpy(b, w); else strcpy(b, "."); return strlen(b); } int get_users_home_directory(char *b, int len) { /* * Worry about "len" here... */ char *w, h[LONGEST_LEGAL_FILENAME]; sprintf(h, "home$%s", b); w = my_getenv(h); if (w != NULL) strcpy(b, w); else strcpy(b, "."); return strlen(b); } /* * The next bit of mess is jolly - I just want to see if stdin has been * redirected to come from a file, i.e. whether I am interactive in some * sense. This may be used to decide what to do about error reports etc. * The IDEA seems generic across most systems, but the details vary in * frustrating ways. */ int batchp() { return 0; /* !isatty(stdin->_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(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] = 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 */