Commit a586fca9 authored by simonm's avatar simonm

[project @ 1998-04-10 11:33:12 by simonm]

clean up the mess.
parent 70563d29
/*
* (c) The GRASP/AQUA Project, Glasgow University, 1994-1998
*
* $Id: closeFile.c,v 1.1 1998/04/10 10:54:14 simonm Exp $
*
* hClose Runtime Support
*/
#include "Rts.h"
%
% (c) The GRASP/AQUA Project, Glasgow University, 1994
%
\subsection[closeFile.lc]{hClose Runtime Support}
\begin{code}
#include "rtsdefs.h"
#include "stgio.h"
StgInt
closeFile(StgAddr fp)
closeFile(fp)
StgForeignObj fp;
{
int rc;
......@@ -29,5 +29,7 @@ closeFile(StgAddr fp)
return 0;
}
\end{code}
/*
* (c) The GRASP/AQUA Project, Glasgow University, 1994-1998
*
* $Id: createDirectory.c,v 1.1 1998/04/10 10:54:16 simonm Exp $
*
* createDirectory Runtime Support}
*/
%
% (c) The GRASP/AQUA Project, Glasgow University, 1995
%
\subsection[createDirectory.lc]{createDirectory Runtime Support}
#include "Rts.h"
\begin{code}
#include "rtsdefs.h"
#include "stgio.h"
#ifdef HAVE_SYS_TYPES_H
......@@ -18,7 +17,8 @@
#endif
StgInt
createDirectory(StgByteArray path)
createDirectory(path)
StgByteArray path;
{
int rc;
struct stat sb;
......@@ -54,3 +54,5 @@ createDirectory(StgByteArray path)
}
return 0;
}
\end{code}
/*
* (c) The GRASP/AQUA Project, Glasgow University, 1994-1998
*
* $Id: errno.c,v 1.1 1998/04/10 10:54:18 simonm Exp $
*
* GHC Error Number Conversion
*/
%
% (c) The GRASP/AQUA Project, Glasgow University, 1994
%
\subsection[errno.lc]{GHC Error Number Conversion}
\begin{code}
#include "Rts.h"
#include "rtsdefs.h"
#include "stgio.h"
int ghc_errno = 0;
......@@ -16,7 +15,7 @@ char *ghc_errstr = NULL;
/* Collect all of the grotty #ifdef's in one place. */
void cvtErrno(void)
void cvtErrno(STG_NO_ARGS)
{
switch(errno) {
#ifdef E2BIG
......@@ -527,7 +526,7 @@ void cvtErrno(void)
}
void
stdErrno(void)
stdErrno(STG_NO_ARGS)
{
switch(ghc_errno) {
default:
......@@ -931,3 +930,5 @@ stdErrno(void)
break;
}
}
\end{code}
/*
* (c) The GRASP/AQUA Project, Glasgow University, 1994-1998
*
* $Id: error.h,v 1.1 1998/04/10 10:54:20 simonm Exp $
*
* Error codes used by the IO subsystem.
*/
#if !defined(COMPILING_NCG) && !defined(__GLASGOW_HASKELL__)
extern int ghc_errno;
extern int ghc_errtype;
extern char *ghc_errstr;
void cvtErrno (void);
void stdErrno (void);
#endif
#define ERR_ALREADYEXISTS 1
#define ERR_HARDWAREFAULT 2
#define ERR_ILLEGALOPERATION 3
#define ERR_INAPPROPRIATETYPE 4
#define ERR_INTERRUPTED 5
#define ERR_INVALIDARGUMENT 6
#define ERR_NOSUCHTHING 7
#define ERR_OTHERERROR 8
#define ERR_PERMISSIONDENIED 9
#define ERR_PROTOCOLERROR 10
#define ERR_RESOURCEBUSY 11
#define ERR_RESOURCEEXHAUSTED 12
#define ERR_RESOURCEVANISHED 13
#define ERR_SYSTEMERROR 14
#define ERR_TIMEEXPIRED 15
#define ERR_UNSATISFIEDCONSTRAINTS 16
#define ERR_UNSUPPORTEDOPERATION 17
#define ERR_USERERROR 18
#define ERR_EOF 19
#define GHC_E2BIG -1
#define GHC_EACCES -2
#define GHC_EADDRINUSE -3
#define GHC_EADDRNOTAVAIL -4
#define GHC_EADV -5
#define GHC_EAFNOSUPPORT -6
#define GHC_EAGAIN -7
#define GHC_EAIO -8
#define GHC_EALREADY -9
#define GHC_EBADF -10
#define GHC_EBADMSG -11
#define GHC_EBADRPC -12
#define GHC_EBUSY -13
#define GHC_ECANCELED -14
#define GHC_ECHILD -15
#define GHC_ECLONEME -16
#define GHC_ECOMM -17
#define GHC_ECONNABORTED -18
#define GHC_ECONNREFUSED -19
#define GHC_ECONNRESET -20
#define GHC_EDEADLK -21
#define GHC_EDESTADDRREQ -22
#define GHC_EDIRTY -23
#define GHC_EDOM -24
#define GHC_EDOTDOT -25
#define GHC_EDQUOT -26
#define GHC_EDUPPKG -27
#define GHC_EEXIST -28
#define GHC_EFAIL -29
#define GHC_EFAULT -30
#define GHC_EFBIG -31
#define GHC_EFTYPE -32
#define GHC_EHOSTDOWN -33
#define GHC_EHOSTUNREACH -34
#define GHC_EIDRM -35
#define GHC_EILSEQ -36
#define GHC_EINPROG -37
#define GHC_EINPROGRESS -38
#define GHC_EINTR -39
#define GHC_EINVAL -40
#define GHC_EIO -41
#define GHC_EISCONN -42
#define GHC_EISDIR -43
#define GHC_ELOOP -44
#define GHC_EMEDIA -45
#define GHC_EMFILE -46
#define GHC_EMLINK -47
#define GHC_EMSGSIZE -48
#define GHC_EMTIMERS -49
#define GHC_EMULTIHOP -50
#define GHC_ENAMETOOLONG -51
#define GHC_ENETDOWN -52
#define GHC_ENETRESET -53
#define GHC_ENETUNREACH -54
#define GHC_ENFILE -55
#define GHC_ENOBUFS -56
#define GHC_ENODATA -57
#define GHC_ENODEV -58
#define GHC_ENOENT -59
#define GHC_ENOEXEC -60
#define GHC_ENOLCK -61
#define GHC_ENOLINK -62
#define GHC_ENOMEM -63
#define GHC_ENOMSG -64
#define GHC_ENONET -65
#define GHC_ENOPKG -66
#define GHC_ENOPROTOOPT -67
#define GHC_ENOSPC -68
#define GHC_ENOSR -69
#define GHC_ENOSTR -70
#define GHC_ENOSYM -71
#define GHC_ENOSYS -72
#define GHC_ENOTBLK -73
#define GHC_ENOTCONN -74
#define GHC_ENOTDIR -75
#define GHC_ENOTEMPTY -76
#define GHC_ENOTSOCK -77
#define GHC_ENOTSUP -78
#define GHC_ENOTTY -79
#define GHC_ENXIO -80
#define GHC_EOPNOTSUPP -81
#define GHC_EPERM -82
#define GHC_EPFNOSUPPORT -83
#define GHC_EPIPE -84
#define GHC_EPROCLIM -85
#define GHC_EPROCUNAVAIL -86
#define GHC_EPROGMISMATCH -87
#define GHC_EPROGUNAVAIL -88
#define GHC_EPROTO -89
#define GHC_EPROTONOSUPPORT -90
#define GHC_EPROTOTYPE -91
#define GHC_ERANGE -92
#define GHC_ERELOCATED -93
#define GHC_EREMCHG -94
#define GHC_EREMOTE -95
#define GHC_EROFS -96
#define GHC_ERPCMISMATCH -97
#define GHC_ERREMOTE -98
#define GHC_ESHUTDOWN -99
#define GHC_ESOCKTNOSUPPORT -100
#define GHC_ESOFT -101
#define GHC_ESPIPE -102
#define GHC_ESRCH -103
#define GHC_ESRMNT -104
#define GHC_ESTALE -105
#define GHC_ETIME -106
#define GHC_ETIMEDOUT -107
#define GHC_ETOOMANYREFS -108
#define GHC_ETXTBSY -109
#define GHC_EUSERS -110
#define GHC_EVERSION -111
#define GHC_EWOULDBLOCK -112
#define GHC_EXDEV -113
/*
* (c) The GRASP/AQUA Project, Glasgow University, 1994-1998
*
* $Id: fileEOF.c,v 1.1 1998/04/10 10:54:21 simonm Exp $
*
* hIsEOF Runtime Support
*/
%
% (c) The GRASP/AQUA Project, Glasgow University, 1994
%
\subsection[fileEOF.lc]{hIsEOF Runtime Support}
#include "Rts.h"
\begin{code}
#include "rtsdefs.h"
#include "stgio.h"
StgInt
fileEOF(StgAddr fp)
fileEOF(fp)
StgForeignObj fp;
{
if (fileLookAhead(fp) != EOF)
return 0;
......@@ -19,3 +19,5 @@ fileEOF(StgAddr fp)
else
return -1;
}
\end{code}
/*
* (c) The GRASP/AQUA Project, Glasgow University, 1994-1998
*
* $Id: fileGetc.c,v 1.1 1998/04/10 10:54:22 simonm Exp $
*
* hGetChar Runtime Support
*/
%
% (c) The GRASP/AQUA Project, Glasgow University, 1994
%
\subsection[fileGetc.lc]{hGetChar Runtime Support}
#include "Rts.h"
\begin{code}
#include "rtsdefs.h"
#include "stgio.h"
#include "error.h"
StgInt
fileGetc(StgAddr fp)
fileGetc(fp)
StgForeignObj fp;
{
int c;
if (feof((FILE *)fp)) {
if (feof((FILE *) fp)) {
ghc_errtype = ERR_EOF;
ghc_errstr = "";
return EOF;
}
/* Try to read a character */
while ((c = getc((FILE *)fp)) == EOF && errno == EINTR)
clearerr((FILE *)fp);
while ((c = getc((FILE *) fp)) == EOF && errno == EINTR)
clearerr((FILE *) fp);
if (feof((FILE *)fp)) {
if (feof((FILE *) fp)) {
ghc_errtype = ERR_EOF;
ghc_errstr = "";
} else if (c == EOF) {
......@@ -34,3 +34,5 @@ fileGetc(StgAddr fp)
}
return c;
}
\end{code}
/*
* (c) The GRASP/AQUA Project, Glasgow University, 1994-1998
*
* $Id: fileLookAhead.c,v 1.1 1998/04/10 10:54:24 simonm Exp $
*
* hLookAhead Runtime Support
*/
#include "Rts.h"
#include "stgio.h"
StgInt
fileLookAhead(StgAddr fp)
{
int c;
if ((c = fileGetc((FILE *)fp)) == EOF) {
return c;
} else if (ungetc(c, (FILE *)fp) == EOF) {
cvtErrno();
stdErrno();
return EOF;
} else
return c;
}
%
% (c) The GRASP/AQUA Project, Glasgow University, 1994
%
\subsection[fileLookAhead.lc]{hLookAhead Runtime Support}
\begin{code}
#include "rtsdefs.h"
#include "stgio.h"
StgInt
fileLookAhead(fp)
StgForeignObj fp;
{
int c;
if ((c = fileGetc(fp)) == EOF) {
return c;
} else if (ungetc(c, (FILE *) fp) == EOF) {
cvtErrno();
stdErrno();
return EOF;
} else
return c;
}
\end{code}
/*
* (c) The GRASP/AQUA Project, Glasgow University, 1994-1998
*
* $Id: filePosn.c,v 1.1 1998/04/10 10:54:25 simonm Exp $
*
* hGetPosn and hSetPosn Runtime Support
*/
#include "Rts.h"
%
% (c) The GRASP/AQUA Project, Glasgow University, 1994
%
\subsection[filePosn.lc]{hGetPosn and hSetPosn Runtime Support}
\begin{code}
#include "rtsdefs.h"
#include "stgio.h"
StgInt
getFilePosn(StgAddr fp)
getFilePosn(fp)
StgForeignObj fp;
{
StgInt posn;
......@@ -28,7 +28,9 @@ getFilePosn(StgAddr fp)
/* The following is only called with a position that we've already visited */
StgInt
setFilePosn(StgAddr fp, I_ posn)
setFilePosn(fp, posn)
StgForeignObj fp;
StgInt posn;
{
while (fseek((FILE *) fp, posn, SEEK_SET) != 0) {
if (errno != EINTR) {
......@@ -40,4 +42,7 @@ setFilePosn(StgAddr fp, I_ posn)
return 0;
}
\end{code}
/*
* (c) The GRASP/AQUA Project, Glasgow University, 1994-1998
*
* $Id: filePutc.c,v 1.1 1998/04/10 10:54:26 simonm Exp $
*
* hPutChar Runtime Support
*/
%
% (c) The GRASP/AQUA Project, Glasgow University, 1994
%
\subsection[filePut.lc]{hPutChar Runtime Support}
#include "Rts.h"
\begin{code}
#include "rtsdefs.h"
#include "stgio.h"
#include "error.h"
StgInt
filePutc(StgAddr fp, I_ c)
filePutc(fp, c)
StgForeignObj fp;
StgInt c;
{
int rc;
......@@ -27,3 +28,5 @@ filePutc(StgAddr fp, I_ c)
return 0;
}
\end{code}
/*
* (c) The GRASP/AQUA Project, Glasgow University, 1994-1998
*
* $Id: fileSize.c,v 1.1 1998/04/10 10:54:27 simonm Exp $
*
* hClose Runtime Support
*/
%
% (c) The GRASP/AQUA Project, Glasgow University, 1994
%
\subsection[fileSize.lc]{hfileSize Runtime Support}
#include "Rts.h"
\begin{code}
#include "rtsdefs.h"
#include "stgio.h"
#ifdef HAVE_SYS_TYPES_H
......@@ -18,7 +17,9 @@
#endif
StgInt
fileSize(StgAddr fp, StgByteArray result)
fileSize(fp, result)
StgForeignObj fp;
StgByteArray result;
{
struct stat sb;
......@@ -40,3 +41,5 @@ fileSize(StgAddr fp, StgByteArray result)
return -1;
}
}
\end{code}
/*
* (c) The GRASP/AQUA Project, Glasgow University, 1994-1998
*
* $Id: floatExtreme.c,v 1.1 1998/04/10 10:54:28 simonm Exp $
*
* Stubs to check for extremities of (IEEE) floats,
* the tests have been (artfully) lifted from the hbc-0.9999.3 (lib/fltcode.c)
* source.
*/
/*
%
%
%
Stubs to check for extremities of (IEEE) floats,
the tests have been (artfully) lifted from the hbc-0.9999.3 (lib/fltcode.c)
source.
ToDo:
- avoid hard-wiring the fact that on an
Alpha we repr. a StgFloat as a double.
(introduce int equivalent of {ASSIGN,PK}_FLT? )
*/
#include "Rts.h"
\begin{code}
#include "rtsdefs.h"
#include "ieee-flpt.h"
#include "floatExtreme.h"
......@@ -30,7 +28,8 @@ ToDo:
#ifdef IEEE_FLOATING_POINT
StgInt
isDoubleNaN(StgDouble d)
isDoubleNaN(d)
StgDouble d;
{
union { double d; int i[2]; } u;
int hx,lx;
......@@ -47,7 +46,8 @@ isDoubleNaN(StgDouble d)
}
StgInt
isDoubleInfinite(StgDouble d)
isDoubleInfinite(d)
StgDouble d;
{
union { double d; int i[2]; } u;
int hx,lx;
......@@ -62,7 +62,8 @@ isDoubleInfinite(StgDouble d)
}
StgInt
isDoubleDenormalized(StgDouble d)
isDoubleDenormalized(d)
StgDouble d;
{
union { double d; int i[2]; } u;
int high, iexp;
......@@ -74,7 +75,8 @@ isDoubleDenormalized(StgDouble d)
}
StgInt
isDoubleNegativeZero(StgDouble d)
isDoubleNegativeZero(d)
StgDouble d;
{
union { double d; int i[2]; } u;
int high, iexp;
......@@ -86,7 +88,8 @@ isDoubleNegativeZero(StgDouble d)
/* Same tests, this time for StgFloats. */
StgInt
isFloatNaN(StgFloat f)
isFloatNaN(f)
StgFloat f;
{
#if !defined(alpha_TARGET_OS)
/* StgFloat = double on alphas */
......@@ -104,7 +107,8 @@ isFloatNaN(StgFloat f)
}
StgInt
isFloatInfinite(StgFloat f)
isFloatInfinite(f)
StgFloat f;
{
#if !defined(alpha_TARGET_OS)
/* StgFloat = double on alphas */
......@@ -121,7 +125,8 @@ isFloatInfinite(StgFloat f)
}
StgInt
isFloatDenormalized(StgFloat f)
isFloatDenormalized(f)
StgFloat f;
{
#if !defined(alpha_TARGET_OS)
/* StgFloat = double on alphas */
......@@ -137,7 +142,8 @@ isFloatDenormalized(StgFloat f)
}
StgInt
isFloatNegativeZero(StgFloat f)
isFloatNegativeZero(f)
StgFloat f;
{
#if !defined(alpha_TARGET_OS)
/* StgFloat = double on alphas */
......@@ -163,3 +169,6 @@ StgInt isFloatDenormalized(f) StgFloat f; { return 0; }
StgInt isFloatNegativeZero(f) StgFloat f; { return 0; }
#endif
\end{code}
/*
* (c) The GRASP/AQUA Project, Glasgow University, 1994-1998
*
* $Id: flushFile.c,v 1.1 1998/04/10 10:54:30 simonm Exp $
*
* hFlush Runtime Support
*/
#include "Rts.h"
%
% (c) The GRASP/AQUA Project, Glasgow University, 1994
%
\subsection[flushFile.lc]{hFlush Runtime Support}