This is sysdep.c in view mode; [Download] [Up]
/***********************************************************************
*
* System specific implementation module.
*
* This module contains implementations of various operating system
* specific routines. This module should encapsulate most of these OS
* specific calls so that the rest of the code is portable.
*
* $Revision: 1.6 $
* $Date: 1995/09/17 10:49:48 $
* $Author: sbb $
*
***********************************************************************/
/***********************************************************************
*
* Copyright (C) 1990, 1991, 1992, 1994, 1995 Free Software Foundation, Inc.
* Written by Steve Byrne.
*
* This file is part of GNU Smalltalk.
*
* GNU Smalltalk is free software; you can redistribute it and/or modify it
* under the terms of the GNU General Public License as published by the Free
* Software Foundation; either version 1, or (at your option) any later
* version.
*
* GNU Smalltalk is distributed in the hope that it will be useful, but WITHOUT
* ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
* FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for
* more details.
*
* You should have received a copy of the GNU General Public License along with
* GNU Smalltalk; see the file COPYING. If not, write to the Free Software
* Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
*
***********************************************************************/
/*
* Change Log
* ============================================================================
* Author Date Change
* sbb 10 Sep 95 Added fileIsReadable, also setSignalHandler, and
* initSysdep.
*
* sbb 26 Aug 95 Fixed to have the __cursigmask definition be
* conditional on HAVE_SIGHOLD.
*
* sbb 6 Jun 95 Switched to new file naming scheme.
*
* sbb 28 May 95 Fixed getCurDirName to selectively use getwd or
* getcwd depending on what is supported.
*
* sbb 28 May 95 Added getdtablesize for those systems such as HP
* which do not have this useful function.
*
* sbb 28 Nov 91 Added getCurDirName() for allowing compiler to record
* the full file name that is used.
*
* sbb 5 Jan 91 Added getMilliTime().
*
* sbyrne 17 May 90 Added enableInterrupts and disableInterrupts. System
* V.3 code signal support from Doug McCallum (thanks,
* Doug!).
*
* sbyrne 16 May 90 Created.
*
*/
#include "gst.h"
#include "sysdep.h"
#ifdef sgi
# define _BSD_SIGNALS
#endif
#include <signal.h>
#include <sys/types.h>
#include <sys/stat.h>
#if STDC_HEADERS
#include <string.h>
#include <stdlib.h>
#endif /* STDC_HEADERS */
#if defined(TIME_WITH_SYS_TIME)
#include <sys/time.h>
#endif
#if !defined(__OS2__) && !defined(_WIN32) /* this should be more generic !!! */
#include <sys/param.h>
#endif
#if defined(USG)
#include <sys/times.h>
#endif
#include <stdio.h>
#if defined(__OS2__) || defined(_WIN32) /* !!! make this more generic */
#include <direct.h>
#include <time.h>
#endif
#if defined(HAVE_IO_H)
#include <io.h>
#endif
#if !defined(R_OK)
# if defined(S_IREAD)
# define R_OK S_IREAD
# else
# define R_OK 4
# endif
#endif
#if defined(_WIN32)
/* Under Visual C++, the forward declaration of semIntHandler() & friends is
* interpreted as semIntHandler(void), not semIntHandler(I'm K&R C compatible)
* so we use this trick (hack) to shut the retentive compiler up
*/
#define SIG_ARG_TYPE int
#else
#define SIG_ARG_TYPE /* empty */
#endif
#ifndef MAXPATHLEN
#define MAXPATHLEN 1024 /* max length of a file and path */
#endif
#if defined(HAVE_SIGHOLD) && !defined(HAVE_SIGSETMASK)
static unsigned long __cursigmask; /* keep track of signal mask status */
#endif
/*
* IntState disableInterrupts()
*
* Description
*
* Saves and returns the current state of the software interrupt system.
* Disables all interrupts.
*
* Outputs
*
* The old state of the interrupt system (presumably for saving for a
* later call to enableInterrupts).
*/
IntState disableInterrupts()
{
#ifdef HAVE_SIGSETMASK
return (sigsetmask(-1));
#else
# ifdef HAVE_SIGHOLD
unsigned long oldmask = __cursigmask;
register int i;
__cursigmask = -1;
for (i=1; i <= 32; i++) {
sighold(i); /* want it blocked - ok if it already is */
}
return oldmask;
# else
return 0; /* no recognized interrupt mechanism */
# endif
#endif
}
/*
* void enableInterrupts(mask)
*
* Description
*
* Restores the state of the interrupt system to that which it had when
* "mask" was created.
*
* Inputs
*
* mask : An interrupt state...should have been returned at some point
* from a call to disableInterrupts.
*
*/
void enableInterrupts(mask)
IntState mask;
{
#ifdef HAVE_SIGSETMASK
sigsetmask(mask);
#else
# ifdef HAVE_SIGHOLD /* !!! at some point, maybe have config check for sigrelse too */
unsigned long oldmask = __cursigmask;
register int i;
__cursigmask = mask;
for (i=1; mask != 0; i++, mask >>= 1) {
if (oldmask & (0x1 << (i-1))) {
sigrelse(i); /* want it unblocked and it is blocked */
}
}
# else
; /* do nothing -- we don't know what to do */
# endif
#endif
}
/*
* unsigned long getMilliTime()
*
* Description
*
* Returns the local time in milliseconds
*
*/
unsigned long getMilliTime()
{
/* #if !defined(USG) && !defined(__OS2__) && !defined(_WIN32) */
#if defined(HAVE_GETTIMEOFDAY)
struct timeval t;
gettimeofday(&t, nil);
return (t.tv_sec * 1000 + t.tv_usec / 1000);
#else
#if defined(__OS2__) || defined(_WIN32)
time_t t;
t = time(NULL);
return (t * 1000 / CLOCKS_PER_SEC);
#else
time_t t;
struct tms dummy;
t = times(&dummy);
return (t * 1000 / gethz());
#endif
#endif
}
/*
* unsigned long getTime()
*
* Description
*
* Returns the time in seconds since midnight Jan 1, 1970 (standard UNIX
* type time). There should be a better (more generic) way to get this
* information, but there doesn't seem to be. Once things are POSIX
* compliant, life will be much better :-)
*
* Outputs
*
* As described above.
*/
unsigned long getTime()
{
#if defined(HAVE_GETTIMEOFDAY)
struct timeval t;
gettimeofday(&t, nil);
return (t.tv_sec);
#else
time_t t;
time(&t);
return ((unsigned long) t);
#endif
}
/*
* void signalAfter(deltaMilli, func)
*
* Description
*
* Set up func as a signal handler to be called after deltaMilli
* milliseconds.
*
* Inputs
*
* deltaMilli:
* Time in milliseconds before the function is invoked. Rounded
* up to nearest second for machines without higher precision
* timers.
* func : Signal handling function invoked when interval expires
*
* Outputs
*
* None.
*/
void signalAfter(deltaMilli, func)
int deltaMilli;
RETSIGTYPE (*func)();
{
/* Please feel free to make this more accurate for your operating system
* and send me the changes.
*/
#ifdef ITIMER_REAL
struct itimerval value;
value.it_interval.tv_sec = value.it_interval.tv_usec = 0;
if (deltaMilli <= 0) {
/* If we have a negative delta time, we should signal the interrupt NOW.
* We could do this by just invoking FUNC by hand, but FUNC may expect to
* be called in the contect of an interrupt handler, and it would be
* tricky to fake that. We therefore just make the interrupt handler
* be called as soon as possible.
*/
value.it_value.tv_sec = 0;
value.it_value.tv_usec = 1; /* smallest possible */
} else {
value.it_value.tv_sec = deltaMilli/1000;
value.it_value.tv_usec = (deltaMilli%1000) * 1000;
}
signal(SIGALRM, func);
setitimer(ITIMER_REAL, &value, (struct itimerval *)0);
#else
# if defined(HAVE_ALARM)
int timeSecs;
if (deltaMilli < 0) {
timeSecs = 1;
} else {
timeSecs = (deltaMilli + 999)/ 1000; /* round up to nearest second */
}
signal(SIGALRM, func);
alarm(timeSecs);
# endif
#endif
}
void setSignalHandler(signum, handlerFunc)
int signum;
RETSIGTYPE (*handlerFunc)(SIG_ARG_TYPE);
{
#if defined(_POSIX_VERSION)
/* If we are running on a posix-compliant system, then do
things the Posix way. */
struct sigaction act;
act.sa_handler = handlerFunc;
act.sa_flags = 0;
sigemptyset (&act.sa_mask);
sigaction (signum, &act, (struct sigaction *)NULL);
#else
signal(signum, handlerFunc);
#endif
}
/*
* char *getCurDirName()
*
* Description
*
* Returns the path name for the current directory, without trailing
* delimiter (?).
*
* Outputs
*
* Pointer to allocated string for current path name. Caller has
* responsibility for freeing the returned value when through.
*/
char *getCurDirName()
{
char name[MAXPATHLEN];
extern char *strdup();
#ifdef HAVE_GETWD
getwd(name);
#else
getcwd(name, MAXPATHLEN);
#endif
return (strdup(name));
}
/*
* char *getFullFileName(fileName)
*
* Description
*
* Returns the full path name for a given file.
*
* Inputs
*
* fileName:
* Pointer to file name, can be relative or absolute
*
* Outputs
*
* Full path name string. Caller has the responsibility for freeing the
* returned string.
*/
char *getFullFileName(fileName)
char *fileName;
{
char *fullFileName;
static char *fullPath = NULL;
extern char *strdup();
if (fileName[0] == '/') { /* absolute, so don't need to change */
return (strdup(fileName));
}
if (fullPath == NULL) {
/* Only need to do this once, then cache the result */
fullPath = getCurDirName();
}
/*
* ### canonicalize filename and full path here in the future (remove any
* extraneous .. or . directories, etc.)
*/
fullFileName = (char *)malloc(strlen(fullPath) + strlen(fileName)
+ 1 /* slash */
+ 1 /* trailing nul */);
sprintf(fullFileName, "%s/%s", fullPath, fileName);
return (fullFileName);
}
/*
* unsigned long getFileModifyTime(fileName)
*
* Description
*
* Returns the time the file "fileName" was last modified. On UNIX
* machines, this is the number of seconds since midnight Jan 1 1970 GMT.
* On other platforms/environments, it's probably not important exactly
* what it returns as long as it's unites consistent with other accesses
* that client code may do to the file system.
*
* Inputs
*
* fileName:
* Name of the file to be checked.
*
* Outputs
*
* Time the file was last modified, in some reasonable units for the local
* operating system.
*/
unsigned long getFileModifyTime(fileName)
char *fileName;
{
struct stat st;
if (stat(fileName, &st) < 0) {
return ((unsigned long)0);
} else {
return (st.st_mtime);
}
}
/*
* mst_Boolean fileIsReadable(fileName)
*
* Description
*
* Returns true if the file named "fileName" exists and is readable by the
* current process. Returns false otherwise.
*
* Inputs
*
* fileName:
* The name of the file to check on.
*
* Outputs
*
* True if the file exists and is readable, false otherwise.
*/
mst_Boolean fileIsReadable(fileName)
char *fileName;
{
return (access(fileName, R_OK) == 0);
}
OOP getOpenFileSize(fd)
int fd;
{
struct stat statBuf;
if (fstat(fd, &statBuf) < 0) {
return nilOOP;
} else {
return fromInt(statBuf.st_size);
}
}
FILE *openPipe(fileName, fileMode)
char *fileName, *fileMode;
{
#if defined(HAVE_POPEN)
return (popen(fileName, fileMode));
#else
return (NULL); /* primitive OS's have no popen! */
#endif
}
/*
* int closePipe(file)
*
* Description
*
* Closes the given pipe (if it is a pipe).
*
* Inputs
*
* file : A stdio type FILE pointer.
*
* Outputs
*
* Returns -1 on error.
*/
int closePipe(file)
FILE *file;
{
#if defined(HAVE_POPEN)
return (pclose(file));
#else
return (-1);
#endif
}
#if !defined(HAVE_GETDTABLESIZE)
int
getdtablesize()
{
return (20); /* a safe >>>hack<<< value */
}
#endif /* ! HAVE_GETDTABLESIZE */
/*
* void initSysdep()
*
* Description
*
* Perform any system dependent initializations that are required.
*
*/
void initSysdep()
{
#if defined(USG)
tzset();
#endif
}
#ifdef WANT_DPRINTF
#include <varargs.h>
dprintf(va_alist)
va_dcl
{
va_list args;
char *fmt;
static FILE *debFile = NULL;
if (debFile == NULL) {
debFile = fopen("mst.deb", "w");
}
va_start(args);
fmt = va_arg(args, char *);
(void) vfprintf(debFile, fmt, args);
fflush(debFile);
va_end(args);
}
#endif
These are the contents of the former NiCE NeXT User Group NeXTSTEP/OpenStep software archive, currently hosted by Netfuture.ch.