Commit 3f9b5688 authored by simonm's avatar simonm

[project @ 1998-04-10 10:54:14 by simonm]

New Run-Time System Support, includes:

	- New code generator
	- Modifications to the mangler
	- Unboxed Tuple support
	- Various other minor changes.
parent 1be6e009
%
% (c) The GRASP/AQUA Project, Glasgow University, 1994
%
\subsection[closeFile.lc]{hClose Runtime Support}
\begin{code}
#include "rtsdefs.h"
/*
* (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"
#include "stgio.h"
StgInt
closeFile(fp)
StgForeignObj fp;
closeFile(StgAddr fp)
{
int rc;
......@@ -29,7 +29,5 @@ StgForeignObj fp;
return 0;
}
\end{code}
%
% (c) The GRASP/AQUA Project, Glasgow University, 1995
%
\subsection[createDirectory.lc]{createDirectory Runtime Support}
/*
* (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}
*/
\begin{code}
#include "rtsdefs.h"
#include "Rts.h"
#include "stgio.h"
#ifdef HAVE_SYS_TYPES_H
......@@ -17,8 +18,7 @@
#endif
StgInt
createDirectory(path)
StgByteArray path;
createDirectory(StgByteArray path)
{
int rc;
struct stat sb;
......@@ -54,5 +54,3 @@ StgByteArray path;
}
return 0;
}
\end{code}
%
% (c) The GRASP/AQUA Project, Glasgow University, 1994
%
\subsection[errno.lc]{GHC Error Number Conversion}
\begin{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
*/
#include "rtsdefs.h"
#include "Rts.h"
#include "stgio.h"
int ghc_errno = 0;
......@@ -15,7 +16,7 @@ char *ghc_errstr = NULL;
/* Collect all of the grotty #ifdef's in one place. */
void cvtErrno(STG_NO_ARGS)
void cvtErrno(void)
{
switch(errno) {
#ifdef E2BIG
......@@ -526,7 +527,7 @@ void cvtErrno(STG_NO_ARGS)
}
void
stdErrno(STG_NO_ARGS)
stdErrno(void)
{
switch(ghc_errno) {
default:
......@@ -930,5 +931,3 @@ stdErrno(STG_NO_ARGS)
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
%
\subsection[fileEOF.lc]{hIsEOF Runtime Support}
/*
* (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
*/
\begin{code}
#include "rtsdefs.h"
#include "Rts.h"
#include "stgio.h"
StgInt
fileEOF(fp)
StgForeignObj fp;
fileEOF(StgAddr fp)
{
if (fileLookAhead(fp) != EOF)
return 0;
......@@ -19,5 +19,3 @@ StgForeignObj fp;
else
return -1;
}
\end{code}
%
% (c) The GRASP/AQUA Project, Glasgow University, 1994
%
\subsection[fileGetc.lc]{hGetChar Runtime Support}
/*
* (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
*/
\begin{code}
#include "rtsdefs.h"
#include "Rts.h"
#include "stgio.h"
#include "error.h"
StgInt
fileGetc(fp)
StgForeignObj fp;
fileGetc(StgAddr 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,5 +34,3 @@ StgForeignObj 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
%
\subsection[filePosn.lc]{hGetPosn and hSetPosn Runtime Support}
\begin{code}
#include "rtsdefs.h"
/*
* (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"
#include "stgio.h"
StgInt
getFilePosn(fp)
StgForeignObj fp;
getFilePosn(StgAddr fp)
{
StgInt posn;
......@@ -28,9 +28,7 @@ StgForeignObj fp;
/* The following is only called with a position that we've already visited */
StgInt
setFilePosn(fp, posn)
StgForeignObj fp;
StgInt posn;
setFilePosn(StgAddr fp, I_ posn)
{
while (fseek((FILE *) fp, posn, SEEK_SET) != 0) {
if (errno != EINTR) {
......@@ -42,7 +40,4 @@ StgInt posn;
return 0;
}
\end{code}
%
% (c) The GRASP/AQUA Project, Glasgow University, 1994
%
\subsection[filePut.lc]{hPutChar Runtime Support}
/*
* (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
*/
\begin{code}
#include "rtsdefs.h"
#include "Rts.h"
#include "stgio.h"
#include "error.h"
StgInt
filePutc(fp, c)
StgForeignObj fp;
StgInt c;
filePutc(StgAddr fp, I_ c)
{
int rc;
......@@ -28,5 +27,3 @@ StgInt c;
return 0;
}
\end{code}
%
% (c) The GRASP/AQUA Project, Glasgow University, 1994
%
\subsection[fileSize.lc]{hfileSize Runtime Support}
/*
* (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
*/
\begin{code}
#include "rtsdefs.h"
#include "Rts.h"
#include "stgio.h"
#ifdef HAVE_SYS_TYPES_H
......@@ -17,9 +18,7 @@
#endif
StgInt
fileSize(fp, result)
StgForeignObj fp;
StgByteArray result;
fileSize(StgAddr fp, StgByteArray result)
{
struct stat sb;
......@@ -41,5 +40,3 @@ StgByteArray result;
return -1;
}
}
\end{code}
%
%
%
Stubs to check for extremities of (IEEE) floats,
the tests have been (artfully) lifted from the hbc-0.9999.3 (lib/fltcode.c)
source.
/*
* (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.
*/
/*
ToDo:
- avoid hard-wiring the fact that on an
Alpha we repr. a StgFloat as a double.
(introduce int equivalent of {ASSIGN,PK}_FLT? )
*/
\begin{code}
#include "rtsdefs.h"
#include "Rts.h"
#include "ieee-flpt.h"
#include "floatExtreme.h"
......@@ -28,8 +30,7 @@ ToDo:
#ifdef IEEE_FLOATING_POINT
StgInt
isDoubleNaN(d)
StgDouble d;
isDoubleNaN(StgDouble d)
{
union { double d; int i[2]; } u;
int hx,lx;
......@@ -46,8 +47,7 @@ StgDouble d;
}
StgInt
isDoubleInfinite(d)
StgDouble d;
isDoubleInfinite(StgDouble d)
{
union { double d; int i[2]; } u;
int hx,lx;
......@@ -62,8 +62,7 @@ StgDouble d;
}
StgInt
isDoubleDenormalized(d)
StgDouble d;
isDoubleDenormalized(StgDouble d)
{
union { double d; int i[2]; } u;
int high, iexp;
......@@ -75,8 +74,7 @@ StgDouble d;
}
StgInt
isDoubleNegativeZero(d)
StgDouble d;
isDoubleNegativeZero(StgDouble d)
{
union { double d; int i[2]; } u;
int high, iexp;
......@@ -88,8 +86,7 @@ StgDouble d;
/* Same tests, this time for StgFloats. */
StgInt
isFloatNaN(f)
StgFloat f;
isFloatNaN(StgFloat f)
{
#if !defined(alpha_TARGET_OS)
/* StgFloat = double on alphas */
......@@ -107,8 +104,7 @@ StgFloat f;
}
StgInt
isFloatInfinite(f)
StgFloat f;
isFloatInfinite(StgFloat f)
{
#if !defined(alpha_TARGET_OS)
/* StgFloat = double on alphas */
......@@ -125,8 +121,7 @@ StgFloat f;
}
StgInt
isFloatDenormalized(f)
StgFloat f;
isFloatDenormalized(StgFloat f)
{
#if !defined(alpha_TARGET_OS)
/* StgFloat = double on alphas */
......@@ -142,8 +137,7 @@ StgFloat f;
}
StgInt
isFloatNegativeZero(f)
StgFloat f;
isFloatNegativeZero(StgFloat f)
{
#if !defined(alpha_TARGET_OS)
/* StgFloat = double on alphas */
......@@ -169,6 +163,3 @@ 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
%
\subsection[flushFile.lc]{hFlush Runtime Support}
\begin{code}
#include "rtsdefs.h"
/*