<commit_before>-- Copyright 2013 Galois, Inc.
-- This software is distributed under a standard, three-clause BSD license.
-- Please see the file LICENSE, distributed with this software, for specific
-- terms and conditions.
module Hypervisor.Console(
         Console
       , initXenConsole
       , initConsole
       , readConsole
       , writeConsole
       )
 where

import Control.Concurrent
import Control.Exception
import Control.Monad
import Data.Word
import Foreign.C.String
import Foreign.Ptr
import Foreign.Storable
import Hypervisor.DomainInfo
import Hypervisor.ErrorCodes
import Hypervisor.Memory
import Hypervisor.Port

data ConsoleMsg = WriteString String (MVar ())
                | ReadString Int (MVar String)
                | Advance

newtype Console = Console (Chan ConsoleMsg)

-- |Initialize the Xen console associated with this domain at boot time.
initXenConsole :: IO Console
initXenConsole  = do
  conMFN  <- (toMFN . fromIntegral) `fmap` get_console_mfn
  conPort <- toPort `fmap` get_console_evtchn
  initConsole conMFN conPort

-- |Initialize a console built from the given machine frame and event<commit_msg>When initXenConsole is called, automatically setXenPutStr and setXenGetChar so that putStrLn just works.<commit_after>-- Copyright 2013 Galois, Inc.
-- This software is distributed under a standard, three-clause BSD license.
-- Please see the file LICENSE, distributed with this software, for specific
-- terms and conditions.
module Hypervisor.Console(
         Console
       , initXenConsole
       , initConsole
       , readConsole
       , writeConsole
       )
 where

import Control.Concurrent
import Control.Exception
import Control.Monad
import Data.Word
import Foreign.C.String
import Foreign.Ptr
import Foreign.Storable
import Hypervisor.DomainInfo
import Hypervisor.ErrorCodes
import Hypervisor.Memory
import Hypervisor.Port
import System.IO(setXenPutStr, setXenGetChar)

data ConsoleMsg = WriteString String (MVar ())
                | ReadString Int (MVar String)
                | Advance

newtype Console = Console (Chan ConsoleMsg)

-- |Initialize the Xen console associated with this domain at boot time.
-- This has the side effect of rewiring putStr, getChar, and friends to
-- use the Xen console.
initXenConsole :: IO Console
initXenConsole  = do
  conMFN  <- (toMFN . fromIntegral) `fmap` get_console_mfn
  conPort <- toPort `fmap` get_console_evtchn
  con <- initConsole conMFN conPort
  setXenPutStr (writeConsole con)
  setXenGetChar (head `fmap` readConsole con 1)
  return con

-- |Initialize a console built from the given machine frame and event
{'fraction_non_alphanumeric': 0.06228505922812381, 'fraction_numerical': 0.003439052350019106, 'mean_word_length': 3.584938704028021, 'pattern_counts': {'":': 0, '<': 8, '<?xml version=': 0, '>': 3, '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': '654296', 'n_tokens_mistral': 740, 'n_tokens_neox': 710, 'n_words': 268}