<commit_before>%
% (c) The GRASP/AQUA Project, Glasgow University, 1995-1996
%
\section[PosixIO]{Haskell 1.3 POSIX Input/Output Primitives}

\begin{code}
module PosixIO (
    FdOption(..),
    FileLock,
    LockRequest(..),

    fdClose,
    createPipe,
    dup,
    dupTo,

    fdRead,
    fdWrite,
    fdSeek,

    queryFdOption,
    setFdOption,

    getLock,  setLock,
    waitToSetLock,

    -- Handle <-> Fd
    handleToFd, fdToHandle,
    ) where

import GlaExts
import ST
import PrelIOBase
import PrelHandle (filePtr, readHandle, writeHandle, newHandle)
import IO
import PackedString ( unpackPS, unsafeByteArrayToPS, psToByteArrayST )
import Addr
import Foreign

import PosixUtil
import PosixFiles ( stdInput, stdOutput, stdError )


createPipe :: IO (Fd, Fd)
createPipe = do
    bytes <- allocChars ``(2*sizeof(int))''
    rc    <- _casm_ ``%r = pipe((int *)%0);'' bytes
    if rc /= -1
       then do
	rd <- _casm_ ``%r = ((int *)%0)[0];'' bytes
	wd <- _casm_ ``%r = ((int *)%0)[1];'' bytes
	return (rd, wd)
       else
	syserr "createPipe"

dup :: Fd -> IO Fd
dup fd =
    _ccall_ dup fd	>>= \ fd2@(I# fd2#) ->
    if fd2 /= -1 then
	return (FD# fd2#)
    else
	syserr "dup"

dupTo :: Fd -> Fd -> IO ()
dupTo fd1 fd2 = minusone_error (_ccall_ dup2 fd1 fd2) "dupTo"

fdClose :: Fd -> IO ()
fdClose fd = minusone_error (_ccall_ close fd) "fdClose"

handleToFd :: Handle -> IO Fd
handleToFd h = do
 h_ <- readHandle h
 case h_ of
   ErrorHandle ioError ->  writeHandle h h_  >> fail ioError
   ClosedHandle	       ->  writeHandle h h_  >>
                           fail (IOError Nothing IllegalOperation
					 "handle is closed")
   SemiClosedHandle _ _ -> writeHandle h h_  >>
			   fail (IOError Nothing IllegalOperation
					 "handle is semi-closed")
   other ->
    let file = filePtr h_ in
    _casm_ `` %r=fileno((FILE *)%0); '' file   >>= \ fd@(FD# fd#) ->
    writeHandle h h_  >>
    if fd# /=# (negateInt# 1#) then
       return fd
    else
       syserr "handleToFd"

-- default is no buffering.
fdToHandle :: Fd -> IO Handle
fdToHandle fd@(FD# fd#) =
    _ccall_ fcntl fd (``F_GETFL''::Int) 0	   >>= \ flags@(I# flags#) ->
    if flags /= -1 then
      let
       wH  = (int2Word# flags# `and#` (case ``O_WRONLY'' of { W# x -> x}))
			`neWord#` int2Word# 0#
       aH  = (int2Word# flags# `and#` (case ``O_APPEND'' of { W# x -> x}))
			`neWord#` int2Word# 0#
       rwH = (int2Word# flags# `and#` (case ``O_RDWR'' of { W# x -> x }))
			`neWord#` int2Word# 0#
       (ft,handle_t) =
        if wH then
	  if aH
	  then ("a",AppendHandle)
	  else ("w",WriteHandle)
	else if rwH then
          ("r+",ReadWriteHandle)
	else
	  ("r",ReadHandle)
      in
      _ccall_ fdopen fd ft >>= \ file_struct@(A# ptr#) ->
      if file_struct /= (``NULL''::Addr) then
	 {-
	   A distinction is made here between std{Input,Output,Error} Fds
	   and all others. The standard descriptors have a finaliser
	   that will not close the underlying fd, the others have one
	   that will. Or rather, the closing of the standard descriptors is
	   delayed until the process exits.
	 -}<commit_msg>[project @ 1998-05-12 17:04:11 by sof] fdToHandle: use openFd<commit_after>%
% (c) The GRASP/AQUA Project, Glasgow University, 1995-1996
%
\section[PosixIO]{Haskell 1.3 POSIX Input/Output Primitives}

\begin{code}
{-# OPTIONS -#include "../std/cbits/stgio.h" #-}
module PosixIO (
    FdOption(..),
    FileLock,
    LockRequest(..),

    fdClose,
    createPipe,
    dup,
    dupTo,

    fdRead,
    fdWrite,
    fdSeek,

    queryFdOption,
    setFdOption,

    getLock,  setLock,
    waitToSetLock,

    -- Handle <-> Fd
    handleToFd, fdToHandle,
    ) where

import GlaExts
import ST
import PrelIOBase
import PrelHandle (filePtr, readHandle, writeHandle, newHandle)
import IO
import PackedString ( unpackPS, unsafeByteArrayToPS, psToByteArrayST )
import Addr
import Foreign

import PosixUtil
import PosixFiles ( stdInput, stdOutput, stdError )


createPipe :: IO (Fd, Fd)
createPipe = do
    bytes <- allocChars ``(2*sizeof(int))''
    rc    <- _casm_ ``%r = pipe((int *)%0);'' bytes
    if rc /= -1
       then do
	rd <- _casm_ ``%r = ((int *)%0)[0];'' bytes
	wd <- _casm_ ``%r = ((int *)%0)[1];'' bytes
	return (rd, wd)
       else
	syserr "createPipe"

dup :: Fd -> IO Fd
dup fd =
    _ccall_ dup fd	>>= \ fd2@(I# fd2#) ->
    if fd2 /= -1 then
	return (FD# fd2#)
    else
	syserr "dup"

dupTo :: Fd -> Fd -> IO ()
dupTo fd1 fd2 = minusone_error (_ccall_ dup2 fd1 fd2) "dupTo"

fdClose :: Fd -> IO ()
fdClose fd = minusone_error (_ccall_ close fd) "fdClose"

handleToFd :: Handle -> IO Fd
handleToFd h = do
 h_ <- readHandle h
 case h_ of
   ErrorHandle ioError ->  writeHandle h h_  >> fail ioError
   ClosedHandle	       ->  writeHandle h h_  >>
                           fail (IOError Nothing IllegalOperation
					 "handle is closed")
   SemiClosedHandle _ _ -> writeHandle h h_  >>
			   fail (IOError Nothing IllegalOperation
					 "handle is semi-closed")
   other ->
    let file = filePtr h_ in
    _casm_ `` %r=fileno((FILE *)%0); '' file   >>= \ fd@(FD# fd#) ->
    writeHandle h h_  >>
    if fd# /=# (negateInt# 1#) then
       return fd
    else
       syserr "handleToFd"

-- default is no buffering.
fdToHandle :: Fd -> IO Handle
fdToHandle fd@(FD# fd#) =
    _ccall_ fcntl fd (``F_GETFL''::Int) 0	   >>= \ flags@(I# flags#) ->
    if flags /= -1 then
      let
       wH  = (int2Word# flags# `and#` (case ``O_WRONLY'' of { W# x -> x}))
			`neWord#` int2Word# 0#
       aH  = (int2Word# flags# `and#` (case ``O_APPEND'' of { W# x -> x}))
			`neWord#` int2Word# 0#
       rwH = (int2Word# flags# `and#` (case ``O_RDWR'' of { W# x -> x }))
			`neWord#` int2Word# 0#
       (ft,handle_t) =
        if wH then
	  if aH
	  then ("a",AppendHandle)
	  else ("w",WriteHandle)
	else if rwH then
          ("r+",ReadWriteHandle)
	else
	  ("r",ReadHandle)
      in
      _ccall_ openFd fd ft >>= \ file_struct@(A# ptr#) ->
      if file_struct /= (``NULL''::Addr) then
	 {-
	   A distinction is made here between std{Input,Output,Error} Fds
	   and all others. The standard descriptors have a finaliser
	   that will not close the underlying fd, the others have one
	   that will. 

	   Delaying the closing of the standard descriptors until the process
	   exits is necessary since the RTS is likely to require these after
	   (or as a result of) program termination.
	 -}
{'fraction_non_alphanumeric': 0.1365203761755486, 'fraction_numerical': 0.014733542319749215, 'mean_word_length': 2.6255681818181817, 'pattern_counts': {'":': 0, '<': 15, '<?xml version=': 0, '>': 71, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 0, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '5905998', 'n_tokens_mistral': 2501, 'n_tokens_neox': 2340, 'n_words': 723}