Skip to content
Snippets Groups Projects
Commit 3ea96a14 authored by sof's avatar sof
Browse files

[project @ 1997-05-19 06:08:13 by sof]

ghc-2-03-p1 merged onto main trunk
parent 2b08eff4
No related merge requests found
...@@ -697,9 +697,9 @@ A small word of warning: \tr{-cpp} is not friendly to ...@@ -697,9 +697,9 @@ A small word of warning: \tr{-cpp} is not friendly to
%************************************************************************ %************************************************************************
%* * %* *
\subsection[options-C-compiler]{Options affecting the C compiler (if applicable)} \subsection[options-C-compiler]{Options affecting the C compiler (if applicable)}
\index{include-file-option}
\index{C compiler options} \index{C compiler options}
\index{GCC options} \index{GCC options}
\index{include file option}
%* * %* *
%************************************************************************ %************************************************************************
...@@ -1202,11 +1202,11 @@ trademark of Peyton Jones Enterprises, plc.) ...@@ -1202,11 +1202,11 @@ trademark of Peyton Jones Enterprises, plc.)
Sometimes it is useful to make the connection between a source file Sometimes it is useful to make the connection between a source file
and the command-line options it requires, quite tight. For instance, and the command-line options it requires, quite tight. For instance,
if a (Glasgow) Haskell source file uses \tr{casm}s, the C back-end if a (Glasgow) Haskell source file uses \tr{casm}s, the C back-end
often needs to be told about header files to use, often needs to be told about header files to use. Rather than
\ref{include file option}. Rather than maintaining the list of maintaining the list of files the source depends on in a
files the source depends on in a \tr{Makefile}, it is possible to \tr{Makefile} (using \tr{-#include} option), it is possible to do this
do this directly in the source file using the \tr{OPTIONS} pragma directly in the source file using the \tr{OPTIONS} pragma
\index{OPTIONS pragma}: \index{OPTIONS pragma}:
\begin{verbatim} \begin{verbatim}
{-# OPTIONS -#include "foo.h" #-} {-# OPTIONS -#include "foo.h" #-}
...@@ -1274,11 +1274,10 @@ _declarations_ ...@@ -1274,11 +1274,10 @@ _declarations_
To make sure you get the syntax right, tailoring an existing interface To make sure you get the syntax right, tailoring an existing interface
file is a Good Idea. file is a Good Idea.
\bf{Note:} This is all a temporary solution, a version of the compiler {\bf Note:} This is all a temporary solution, a version of the compiler
that handles mutually recursive properly without the manual that handles mutually recursive properly without the manual
construction of interface file, is in the works. construction of interface file, is in the works.
%---------------------------------------------------------------------- %----------------------------------------------------------------------
%\subsubsection[arity-checking]{Options to insert arity-checking code} %\subsubsection[arity-checking]{Options to insert arity-checking code}
%\index{arity checking} %\index{arity checking}
......
...@@ -209,7 +209,7 @@ chr# :: Int# -> Char# ...@@ -209,7 +209,7 @@ chr# :: Int# -> Char#
negateInt# :: Int# -> Int# negateInt# :: Int# -> Int#
\end{verbatim} \end{verbatim}
\bf{Note:} No error/overflow checking! {\bf Note:} No error/overflow checking!
\subsubsubsection{Unboxed-@Double@ and @Float@ operations} \subsubsubsection{Unboxed-@Double@ and @Float@ operations}
\begin{verbatim} \begin{verbatim}
...@@ -259,7 +259,7 @@ decodeDouble# :: Double# -> PrelNum.ReturnIntAndGMP ...@@ -259,7 +259,7 @@ decodeDouble# :: Double# -> PrelNum.ReturnIntAndGMP
We implement @Integers@ (arbitrary-precision integers) using the GNU We implement @Integers@ (arbitrary-precision integers) using the GNU
multiple-precision (GMP) package (version 1.3.2). multiple-precision (GMP) package (version 1.3.2).
\bf{Note:} some of this might change when we upgrade to using GMP~2.x. {\bf Note:} some of this might change when we upgrade to using GMP~2.x.
The data type for @Integer@ must mirror that for @MP_INT@ in @gmp.h@ The data type for @Integer@ must mirror that for @MP_INT@ in @gmp.h@
(see @gmp.info@ in \tr{ghc/includes/runtime/gmp}). It comes out as: (see @gmp.info@ in \tr{ghc/includes/runtime/gmp}). It comes out as:
...@@ -604,7 +604,7 @@ deRefStablePointer# :: StablePtr# a -> State# RealWorld -> StateAndPtr RealWorld ...@@ -604,7 +604,7 @@ deRefStablePointer# :: StablePtr# a -> State# RealWorld -> StateAndPtr RealWorld
There is also a C procedure @FreeStablePtr@ which frees a stable pointer. There is also a C procedure @FreeStablePtr@ which frees a stable pointer.
%{\em Andy's comment.} \bf{Errors:} The following is not strictly true: the current %{\em Andy's comment.} {\bf Errors:} The following is not strictly true: the current
%implementation is not as polymorphic as claimed. The reason for this %implementation is not as polymorphic as claimed. The reason for this
%is that the C programmer will have to use a different entry-routine %is that the C programmer will have to use a different entry-routine
%for each type of stable pointer. At present, we only supply a very %for each type of stable pointer. At present, we only supply a very
...@@ -614,7 +614,6 @@ There is also a C procedure @FreeStablePtr@ which frees a stable pointer. ...@@ -614,7 +614,6 @@ There is also a C procedure @FreeStablePtr@ which frees a stable pointer.
%arguments and to enter (stable pointers to) boxed primitive values. %arguments and to enter (stable pointers to) boxed primitive values.
%{\em End of Andy's comment.} %{\em End of Andy's comment.}
% %
% Rewritten and updated for MallocPtr++ -- 4/96 SOF % Rewritten and updated for MallocPtr++ -- 4/96 SOF
% %
...@@ -674,7 +673,7 @@ makeForeignObj# :: Addr# -- foreign reference ...@@ -674,7 +673,7 @@ makeForeignObj# :: Addr# -- foreign reference
-> StateAndForeignObj# RealWorld ForeignObj# -> StateAndForeignObj# RealWorld ForeignObj#
\end{verbatim} \end{verbatim}
\bf{Note:} the foreign object value and its finaliser are contained {\bf Note:} the foreign object value and its finaliser are contained
in the primitive value @ForeignObj#@, so there's no danger of an in the primitive value @ForeignObj#@, so there's no danger of an
aggressive optimiser somehow separating the two. (with the result aggressive optimiser somehow separating the two. (with the result
that the foreign reference would not be freed). that the foreign reference would not be freed).
...@@ -722,6 +721,22 @@ putMVar# :: SynchVar# s elt -> State# s -> State# s ...@@ -722,6 +721,22 @@ putMVar# :: SynchVar# s elt -> State# s -> State# s
%a GC too? Is there any need for a function that provides finer %a GC too? Is there any need for a function that provides finer
%control over GC: argument = amount of space required; result = amount %control over GC: argument = amount of space required; result = amount
%of space recovered. %of space recovered.
=======
The C function {\tt PerformGC\/}, allows the C world to force Haskell
to do a garbage collection. It can only be called while Haskell is
performing a C Call.
Note that this function can be used to define a Haskell IO operation
with the same effect:
\begin{verbatim}
> performGCIO :: PrimIO ()
> performGCIO = _ccall_gc_ PerformGC
\end{verbatim}
{\bf ToDo:} Is there any need for abnormal/normal termination to force
a GC too? Is there any need for a function that provides finer
control over GC: argument = amount of space required; result = amount
of space recovered.
\subsection{@spark#@ primitive operation (for parallel execution)} \subsection{@spark#@ primitive operation (for parallel execution)}
...@@ -740,7 +755,7 @@ errorIO# :: (State RealWorld -> ((), State RealWorld)) -> a ...@@ -740,7 +755,7 @@ errorIO# :: (State RealWorld -> ((), State RealWorld)) -> a
\subsection{C Calls} \subsection{C Calls}
\bf{ToDo:} current implementation has state variable as second {\bf ToDo:} current implementation has state variable as second
argument not last argument. argument not last argument.
The @ccall#@ primitive can't be given an ordinary type, because it has The @ccall#@ primitive can't be given an ordinary type, because it has
...@@ -895,7 +910,7 @@ mapAndUnzipST f ls = mapAndUnzipM f ls ...@@ -895,7 +910,7 @@ mapAndUnzipST f ls = mapAndUnzipM f ls
\end{verbatim} \end{verbatim}
\bf{Note:} all the derived operators over @ST@ are implemented using {\bf Note:} all the derived operators over @ST@ are implemented using
the {\em strict} @ST@ instance of @Monad@. the {\em strict} @ST@ instance of @Monad@.
\subsubsection{The @PrimIO@ monad} \subsubsection{The @PrimIO@ monad}
...@@ -1098,7 +1113,7 @@ makeForeignObj :: Addr -- object to be boxed up as a ForeignObj ...@@ -1098,7 +1113,7 @@ makeForeignObj :: Addr -- object to be boxed up as a ForeignObj
Everything in this section goes for @_casm_@ too. Everything in this section goes for @_casm_@ too.
\bf{ToDo:} {\em mention @_ccall_gc_@ and @_casm_gc_@...} {\bf ToDo:} {\em mention @_ccall_gc_@ and @_casm_gc_@...}
The @_ccall_@ construct has the following form: The @_ccall_@ construct has the following form:
$$@_ccall_@~croutine~a_1~\ldots~a_n$$ $$@_ccall_@~croutine~a_1~\ldots~a_n$$
...@@ -1158,10 +1173,10 @@ All of the above are {\em C-returnable} except: ...@@ -1158,10 +1173,10 @@ All of the above are {\em C-returnable} except:
Array, ByteArray, MutableArray, MutableByteArray, ForeignObj Array, ByteArray, MutableArray, MutableByteArray, ForeignObj
\end{verbatim} \end{verbatim}
\bf{ToDo:} I'm pretty wary of @Array@ and @MutableArray@ being in {\bf ToDo:} I'm pretty wary of @Array@ and @MutableArray@ being in
this list, and not too happy about @State@ [WDP]. this list, and not too happy about @State@ [WDP].
\bf{ToDo:} Can code generator pass all the primitive types? Should this be {\bf ToDo:} Can code generator pass all the primitive types? Should this be
extended to include {\tt Bool\/} (or any enumeration type?) extended to include {\tt Bool\/} (or any enumeration type?)
The type checker must be able to figure out just which of the C-callable/returnable The type checker must be able to figure out just which of the C-callable/returnable
......
...@@ -177,8 +177,9 @@ Finally, there are operations to delay a concurrent thread, and to ...@@ -177,8 +177,9 @@ Finally, there are operations to delay a concurrent thread, and to
make one wait:\index{delay a concurrent thread} make one wait:\index{delay a concurrent thread}
\index{wait for a file descriptor} \index{wait for a file descriptor}
\begin{verbatim} \begin{verbatim}
threadDelay :: Int -> IO () -- delay rescheduling for N microseconds threadDelay :: Int -> IO () -- delay rescheduling for N microseconds
threadWait :: Int -> IO () -- wait for input on specified file descriptor threadWaitRead :: Int -> IO () -- wait for input on specified file descriptor
threadWaitWrite :: Int -> IO () -- (read and write, respectively).
\end{verbatim} \end{verbatim}
%************************************************************************ %************************************************************************
......
...@@ -14,9 +14,9 @@ At the moment, there four different collections of system libraries: ...@@ -14,9 +14,9 @@ At the moment, there four different collections of system libraries:
\item The GHC system library - collection of interfaces that mainly \item The GHC system library - collection of interfaces that mainly
have grown out of abstractions used to implement GHC itself. have grown out of abstractions used to implement GHC itself.
\item Parts of the HBC libraries. \item Parts of the HBC libraries.
\item The Posix interface - a quality interface to OS functionality as \item The Posix interface - a mostly complete interface to OS functionality as
specified by {\tt POSIX 1003.1}. Sadly, this library hasn't made it specified by {\tt POSIX 1003.1}. Sadly, this library isn't a standard
into a standard Haskell library. Haskell library...yet.
\item The contrib libraries - oodles of numeric codes.. \item The contrib libraries - oodles of numeric codes..
\end{itemize} \end{itemize}
...@@ -266,8 +266,8 @@ accumulating any errors that occur. ...@@ -266,8 +266,8 @@ accumulating any errors that occur.
%* * %* *
%************************************************************************ %************************************************************************
You need to \tr{import PackedString} and heave in your \tr{-syslib You need to \tr{import PackedString} and heave in your
ghc} to use \tr{PackedString}s. \tr{-syslib ghc} to use \tr{PackedString}s.
The basic type and functions available are: The basic type and functions available are:
\begin{verbatim} \begin{verbatim}
...@@ -774,7 +774,7 @@ type Hostname = String ...@@ -774,7 +774,7 @@ type Hostname = String
\end{verbatim} \end{verbatim}
Various examples of networking Haskell code are provided in Various examples of networking Haskell code are provided in
\tr{ghc/misc/examples/}, notably the \tr{net???/Main.hs} programs. %\tr{ghc/misc/examples/}, notably the \tr{net???/Main.hs} programs.
%************************************************************************ %************************************************************************
%* * %* *
...@@ -787,10 +787,10 @@ Various examples of networking Haskell code are provided in ...@@ -787,10 +787,10 @@ Various examples of networking Haskell code are provided in
The @Posix@ interface gives you access to the set of OS services The @Posix@ interface gives you access to the set of OS services
standardised by POSIX 1003.1b (or the {\em IEEE Portable Operating System standardised by POSIX 1003.1b (or the {\em IEEE Portable Operating System
Interface for Computing Environments} - IEEE Std. 1003.1). The Interface for Computing Environments} - IEEE Std. 1003.1). The
interface is accessed by \tr{import Posix} and adding \tr{-syslib interface is accessed by \tr{import Posix} and adding
posix} on your command-line. \tr{-syslib posix} on your command-line.
\subsubsection[Posix-data-types]{Posix data types} \subsubsection[Posix data types]{Posix data types}
\index{Posix, data types} \index{Posix, data types}
...@@ -818,7 +818,7 @@ A \tr{DeviceID} is a primitive of type \tr{dev_t}. It must ...@@ -818,7 +818,7 @@ A \tr{DeviceID} is a primitive of type \tr{dev_t}. It must
be an arithmetic type. be an arithmetic type.
\begin{verbatim} \begin{verbatim}
> data EpochTime -- instances of : Eq Ord Num Real Integral Ix Enum Show data EpochTime -- instances of : Eq Ord Num Real Integral Ix Enum Show
\end{verbatim} \end{verbatim}
A \tr{EpochTime} is a primitive of type \tr{time_t}, which is A \tr{EpochTime} is a primitive of type \tr{time_t}, which is
...@@ -1019,14 +1019,14 @@ data ProcessStatus = Exited ExitCode ...@@ -1019,14 +1019,14 @@ data ProcessStatus = Exited ExitCode
deriving (Eq, Show) deriving (Eq, Show)
\end{verbatim} \end{verbatim}
\subsubsection{posix-process-env}{Posix Process Primitives} \subsubsection[Process Primitives]{Posix Process Primitives}
\begin{verbatim} \begin{verbatim}
forkProcess :: IO (Maybe ProcessID) forkProcess :: IO (Maybe ProcessID)
\end{verbatim} \end{verbatim}
\tr{forkProcess} calls \tr{fork}, returning \tr{forkProcess} calls \tr{fork}, returning
\tr{Just pid} to the parent, where <var>pid</var> is the \tr{Just pid} to the parent, where \tr{pid} is the
ProcessID of the child, and returning \tr{Nothing} to the ProcessID of the child, and returning \tr{Nothing} to the
child. child.
...@@ -1266,8 +1266,8 @@ installHandler :: Signal ...@@ -1266,8 +1266,8 @@ installHandler :: Signal
\tr{installHandler int handler iset} calls \tr{sigaction} to install \tr{installHandler int handler iset} calls \tr{sigaction} to install
an interrupt handler for signal \tr{int}. If \tr{handler} is an interrupt handler for signal \tr{int}. If \tr{handler} is
\tr{Default}, \tr{SIG_DFL} is installed; if \tr{handler} is \tr{Default}, \tr{SIG_DFL} is installed; if \tr{handler} is
\tr{Ignore}, \tr{SIG_IGN} is installed; if \tr{handler} is \tr{Catch \tr{Ignore}, \tr{SIG_IGN} is installed; if \tr{handler} is
action}, a handler is installed which will invoke \tr{action} as a \tr{Catch action}, a handler is installed which will invoke \tr{action} as a
replacement for \tr{main}. If \tr{iset} is \tr{Just s}, then the replacement for \tr{main}. If \tr{iset} is \tr{Just s}, then the
\tr{sa_mask} of the \tr{sigaction} structure is set to \tr{s}; \tr{sa_mask} of the \tr{sigaction} structure is set to \tr{s};
otherwise it is cleared. The previously installed signal handler for otherwise it is cleared. The previously installed signal handler for
...@@ -1336,7 +1336,7 @@ sleep :: Int -> IO () ...@@ -1336,7 +1336,7 @@ sleep :: Int -> IO ()
program until at least \tr{i} seconds have elapsed or a signal is program until at least \tr{i} seconds have elapsed or a signal is
received. received.
\subsubsection[posix-proc-env]{Posix Process Environment} \subsubsection[Process Environment]{Posix Process Environment}
\index{Posix, process environment} \index{Posix, process environment}
\begin{verbatim} \begin{verbatim}
...@@ -1547,7 +1547,7 @@ The operation may fail with: ...@@ -1547,7 +1547,7 @@ The operation may fail with:
The requested system limit or option is undefined. The requested system limit or option is undefined.
\end{itemize} \end{itemize}
\subsubsection[posix-files-dir]{Files and Directories} \subsubsection[Files and Directories]{Posix operations on files and directories}
\index{Posix, files and directories} \index{Posix, files and directories}
\begin{verbatim} \begin{verbatim}
...@@ -1838,7 +1838,7 @@ The requested file limit or option is undefined. ...@@ -1838,7 +1838,7 @@ The requested file limit or option is undefined.
Various other causes. Various other causes.
\end{itemize} \end{itemize}
\subsubsection[posix-input-output]{Posix Input and Output Primitives} \subsubsection[Inut Output]{Posix Input and Output Primitives}
\index{Posix, input/output} \index{Posix, input/output}
\begin{verbatim} \begin{verbatim}
...@@ -1951,7 +1951,7 @@ seekChannel :: Channel -> SeekMode -> FileOffset -> IO FileOffset ...@@ -1951,7 +1951,7 @@ seekChannel :: Channel -> SeekMode -> FileOffset -> IO FileOffset
indicated by \tr{whence}. It returns the resulting offset from the indicated by \tr{whence}. It returns the resulting offset from the
start of the file in bytes. start of the file in bytes.
\subsubsection[posix-device-class]{Posix, Device- and Class-Specific Functions} \subsubsection[Device Specific Functions]{Posix, Device- and Class-Specific Functions}
\index{Posix, device and class-specific functions} \index{Posix, device and class-specific functions}
\begin{verbatim} \begin{verbatim}
...@@ -2049,7 +2049,7 @@ set the \tr{ProcessGroupID} of the foreground process group ...@@ -2049,7 +2049,7 @@ set the \tr{ProcessGroupID} of the foreground process group
associated with the terminal attached to \tr{Channel} associated with the terminal attached to \tr{Channel}
\tr{fd} to \tr{pgid}. \tr{fd} to \tr{pgid}.
\subsubsection[posix-system-db]{Posix System Databases} \subsubsection[System Database]{Posix System Databases}
\index{Posix, system databases} \index{Posix, system databases}
\begin{verbatim} \begin{verbatim}
...@@ -2121,7 +2121,7 @@ The operation may fail with: ...@@ -2121,7 +2121,7 @@ The operation may fail with:
There is no user entry for the name. There is no user entry for the name.
\end{itemize} \end{itemize}
\subsubsection[posix-errors]{POSIX Errors} \subsubsection[Error reporting and handling]{POSIX Errors}
\index{Posix, errors} \index{Posix, errors}
\begin{verbatim} \begin{verbatim}
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment