From b3d94cb30e9e28e3054ce001926a8f9c530f5bb5 Mon Sep 17 00:00:00 2001 From: sof Date: Sun, 18 May 1997 04:52:18 +0000 Subject: [PATCH] [project @ 1997-05-18 04:50:40 by sof] Made 2.0x bootable --- ghc/compiler/utils/PrimPacked.lhs | 31 ++++++++++++++++---- ghc/compiler/utils/SST.lhs | 7 ++++- ghc/compiler/utils/StringBuffer.lhs | 54 ++++++++++++++++++++++++++--------- 3 files changed, 72 insertions(+), 20 deletions(-) diff --git a/ghc/compiler/utils/PrimPacked.lhs b/ghc/compiler/utils/PrimPacked.lhs index b2b52e6..508c409 100644 --- a/ghc/compiler/utils/PrimPacked.lhs +++ b/ghc/compiler/utils/PrimPacked.lhs @@ -9,6 +9,8 @@ GHC internally, the code generator and the prelude libraries. \begin{code} +#include "HsVersions.h" + module PrimPacked ( strLength, -- :: _Addr -> Int @@ -30,8 +32,17 @@ module PrimPacked indexCharOffFO# -- :: ForeignObj# -> Int# -> Char# ) where +#if __GLASGOW_HASKELL__ <= 201 import PreludeGlaST import PreludeGlaMisc +#else +import GlaExts +import Foreign +import GHC +import ArrBase +import ST +import STBase +#endif \end{code} @@ -159,18 +170,21 @@ new_ps_array :: Int# -> _ST s (_MutableByteArray s Int) write_ps_array :: _MutableByteArray s Int -> Int# -> Char# -> _ST s () freeze_ps_array :: _MutableByteArray s Int -> _ST s (_ByteArray Int) -new_ps_array size (S# s) = +new_ps_array size = + MkST ( \ (S# s) -> case (newCharArray# size s) of { StateAndMutableByteArray# s2# barr# -> - (_MutableByteArray (0,I# (size -# 1#)) barr#, S# s2#)} + (_MutableByteArray (0, max 0 (I# (size -# 1#))) barr#, S# s2#)}) -write_ps_array (_MutableByteArray _ barr#) n ch (S# s#) = +write_ps_array (_MutableByteArray _ barr#) n ch = + MkST ( \ (S# s#) -> case writeCharArray# barr# n ch s# of { s2# -> - ((), S# s2#)} + ((), S# s2#)}) -- same as unsafeFreezeByteArray -freeze_ps_array (_MutableByteArray ixs arr#) (S# s#) = +freeze_ps_array (_MutableByteArray ixs arr#) = + MkST ( \ (S# s#) -> case unsafeFreezeByteArray# arr# s# of { StateAndByteArray# s2# frozen# -> - (_ByteArray ixs frozen#, S# s2#) } + (_ByteArray ixs frozen#, S# s2#) }) \end{code} Compare two equal-length strings for equality: @@ -182,6 +196,7 @@ eqStrPrefix a# barr# len# = _ccall_ strncmp (A# a#) (_ByteArray bottom barr#) (I# len#) `thenPrimIO` \ (I# x#) -> returnPrimIO (x# ==# 0#)) where + bottom :: (Int,Int) bottom = error "eqStrPrefix" eqCharStrPrefix :: Addr# -> Addr# -> Int# -> Bool @@ -190,6 +205,7 @@ eqCharStrPrefix a1# a2# len# = _ccall_ strncmp (A# a1#) (A# a2#) (I# len#) `thenPrimIO` \ (I# x#) -> returnPrimIO (x# ==# 0#)) where + bottom :: (Int,Int) bottom = error "eqStrPrefix" eqStrPrefixBA :: ByteArray# -> ByteArray# -> Int# -> Int# -> Bool @@ -202,6 +218,7 @@ eqStrPrefixBA b1# b2# start# len# = (I# len#) `thenPrimIO` \ (I# x#) -> returnPrimIO (x# ==# 0#)) where + bottom :: (Int,Int) bottom = error "eqStrPrefixBA" eqCharStrPrefixBA :: Addr# -> ByteArray# -> Int# -> Int# -> Bool @@ -214,6 +231,7 @@ eqCharStrPrefixBA a# b2# start# len# = (I# len#) `thenPrimIO` \ (I# x#) -> returnPrimIO (x# ==# 0#)) where + bottom :: (Int,Int) bottom = error "eqCharStrPrefixBA" eqStrPrefixFO :: ForeignObj# -> ByteArray# -> Int# -> Int# -> Bool @@ -226,6 +244,7 @@ eqStrPrefixFO fo# barr# start# len# = (I# len#) `thenPrimIO` \ (I# x#) -> returnPrimIO (x# ==# 0#)) where + bottom :: (Int,Int) bottom = error "eqStrPrefixFO" \end{code} diff --git a/ghc/compiler/utils/SST.lhs b/ghc/compiler/utils/SST.lhs index e574a84..d436384 100644 --- a/ghc/compiler/utils/SST.lhs +++ b/ghc/compiler/utils/SST.lhs @@ -21,8 +21,13 @@ module SST( #endif ) where -#if __GLASGOW_HASKELL__ >= 200 +#if __GLASGOW_HASKELL__ == 201 import GHCbase +#elif __GLASGOW_HASKELL__ >= 202 +import GlaExts +import STBase +import ArrBase +import ST #else import PreludeGlaST ( MutableVar(..), _MutableArray(..), ST(..) ) #endif diff --git a/ghc/compiler/utils/StringBuffer.lhs b/ghc/compiler/utils/StringBuffer.lhs index 0af3dfc..0e27455 100644 --- a/ghc/compiler/utils/StringBuffer.lhs +++ b/ghc/compiler/utils/StringBuffer.lhs @@ -6,6 +6,8 @@ Buffers for scanning string input stored in external arrays. \begin{code} +#include "HsVersions.h" + module StringBuffer ( StringBuffer, @@ -58,8 +60,18 @@ module StringBuffer ) where import Ubiq +#if __GLASGOW_HASKELL__ <= 200 import PreludeGlaST import PreludeGlaMisc +#else +import GlaExts +import Foreign +import IOBase +import IOHandle +import ST +import STBase +import Char (isDigit) +#endif import PrimPacked import FastString import HandleHack @@ -87,29 +99,29 @@ hGetStringBuffer fname = -- Allocate an array for system call to store its bytes into. -- ToDo: make it robust -- _trace (show (len_i::Int)+1) - (_casm_ `` %r=(char *)malloc(sizeof(char)*(int)%0); '' (len_i::Int)) `thenPrimIO` \ arr@(A# a#) -> + (_casm_ `` %r=(char *)malloc(sizeof(char)*(int)%0); '' (len_i::Int)) `CCALL_THEN` \ arr@(A# a#) -> if addr2Int# a# ==# 0# then - failWith (UserError ("hGetStringBuffer: Could not allocate "++show len_i ++ " bytes")) + failWith MkIOError(hndl,UserError,("hGetStringBuffer: Could not allocate "++show len_i ++ " bytes")) else -- _casm_ `` %r=NULL; '' `thenPrimIO` \ free_p -> -- makeForeignObj arr free_p `thenPrimIO` \ fo@(_ForeignObj fo#) -> - _readHandle hndl >>= \ _hndl -> - _writeHandle hndl _hndl >> - let ptr = _filePtr _hndl in - _ccall_ fread arr (1::Int) len_i ptr `thenPrimIO` \ (I# read#) -> + _readHandle hndl >>= \ hndl_ -> + _writeHandle hndl hndl_ >> + let ptr = _filePtr hndl_ in + _ccall_ fread arr (1::Int) len_i ptr `CCALL_THEN` \ (I# read#) -> -- _trace ("DEBUG: opened " ++ fname ++ show (I# read#)) $ hClose hndl >> if read# ==# 0# then -- EOF or other error - failWith (UserError "hGetStringBuffer: EOF reached or some other error") + failWith MkIOError(hndl,UserError,"hGetStringBuffer: EOF reached or some other error") else -- Add a sentinel NUL - _casm_ `` ((char *)%0)[(int)%1]=(char)0; '' arr (I# (read# -# 1#)) `thenPrimIO` \ () -> + _casm_ `` ((char *)%0)[(int)%1]=(char)0; '' arr (I# (read# -# 1#)) `CCALL_THEN` \ () -> return (StringBuffer a# read# 0# 0#) freeStringBuffer :: StringBuffer -> IO () freeStringBuffer (StringBuffer a# _ _ _) = - _casm_ `` free((char *)%0); '' (A# a#) `thenPrimIO` \ () -> + _casm_ `` free((char *)%0); '' (A# a#) `CCALL_THEN` \ () -> return () unsafeWriteBuffer :: StringBuffer -> Int# -> Char# -> StringBuffer @@ -249,8 +261,21 @@ untilEndOfString# (StringBuffer fo l# s# c#) = case indexCharOffAddr# fo c# of '\"'# -> case indexCharOffAddr# fo (c# -# 1#) of - '\\'# -> --escaped, false alarm. - loop (c# +# 1#) + '\\'# -> + -- looks like an escaped something or other to me, + -- better count the number of "\\"s that are immediately + -- preceeding to decide if the " is escaped. + let + odd_slashes flg i# = + case indexCharOffAddr# fo i# of + '\\'# -> odd_slashes (not flg) (i# -# 1#) + _ -> flg + in + if odd_slashes True (c# -# 1#) then + -- odd number, " is ecaped. + loop (c# +# 1#) + else -- a real end of string delimiter after all. + StringBuffer fo l# s# c# _ -> StringBuffer fo l# s# c# _ -> loop (c# +# 1#) @@ -263,8 +288,11 @@ untilEndOfChar# (StringBuffer fo l# s# c#) = case indexCharOffAddr# fo c# of '\''# -> case indexCharOffAddr# fo (c# -# 1#) of - '\\'# -> --escaped, false alarm. - loop (c# +# 1#) + '\\'# -> + case indexCharOffAddr# fo (c# -# 2#) of + '\\'# -> -- end of char + StringBuffer fo l# s# c# + _ -> loop (c# +# 1#) -- false alarm _ -> StringBuffer fo l# s# c# _ -> loop (c# +# 1#) -- 1.7.10.4