module NHC.Binary
  ( directPut
  ) where

import NHC.GreenCard
import BinHandle ({-type-}BinHandle(..))
import SizedBin  ({-type-}Size(..))
import BinPtr    ({-type-}BinPtr(..))

%-#include "cLowBinary.h"
    -- %-#include <stdio.h>


%fun directPut :: BinHandle -> Size -> BinHandle -> BinPtr -> IO ()
%call (binHandle dbh) (Size (int size)) (binHandle sbh) (binPtr p)
%code  /* The Bin component in a SizedBin is assumed always aligned to a */
%      /* byte boundary (at both ends) */
%  int bytes = (size%8 ? (size/8)+1 : (size/8));
%  int dest  = vtell(dbh);
%  if ((dest+size) > dbh->highwater) dbh->highwater = dest+size;
%  sbh->cptr = p - forceCacheTo(sbh,p)*8;
%  closecache(sbh);
%  closecache(dbh);
%  if (sbh->file) {
%    vsync(sbh);
%    if (dbh->file) {
%      /*FILE->FILE*/
%      char buf[BUFSIZ];
%      vsync(dbh);
%      while (bytes>BUFSIZ) {
%        read(sbh->loc.fd,buf,BUFSIZ);
%        write(dbh->loc.fd,buf,BUFSIZ);
%        bytes -= BUFSIZ;
%      }
%      if (bytes) {
%        read(sbh->loc.fd,buf,bytes);
%        write(dbh->loc.fd,buf,bytes);
%      }
%    } else {
%      /*FILE->MEM*/
%      memcheck(dbh,bytes);
%      read(sbh->loc.fd,
%           (void*)(stableRef(dbh->loc.sp)+1+EXTRA)+dbh->adjust.here, bytes);
%      if (dbh->adjust.here+bytes > dbh->attrib.size)
%        dbh->attrib.size = dbh->adjust.here+bytes;
%      /*fprintf(stderr,"directPut: %d bytes from file to mem at 0x%x\n", bytes,
%           (void*)(stableRef(dbh->loc.sp)+1+EXTRA)+dbh->adjust.here);*/
%    }
%  } else {
%    if (dbh->file) {
%      /*MEM->FILE*/
%      vsync(dbh);
%      write(dbh->loc.fd,
%            (void*)(stableRef(sbh->loc.sp)+1+EXTRA)+sbh->adjust.here, bytes);
%      /*fprintf(stderr,"directPut: %d bytes from mem at 0x%x to file\n", bytes,
%            (void*)(stableRef(sbh->loc.sp)+1+EXTRA)+sbh->adjust.here);*/
%    } else {
%      /*MEM->MEM*/
%      memcheck(dbh,bytes);
%      memcpy((void*)(stableRef(dbh->loc.sp)+1+EXTRA)+dbh->adjust.here,
%             (void*)(stableRef(sbh->loc.sp)+1+EXTRA)+sbh->adjust.here, bytes);
%      if (dbh->adjust.here+bytes > dbh->attrib.size)
%        dbh->attrib.size = dbh->adjust.here+bytes;
%    }
%  }
%  opencache(sbh);
%  opencache(dbh);
%result ()