Commit 3cf6fd93 authored by Bas Lijnse's avatar Bas Lijnse

Synced Windows and Mac versions of Time and File libraries, made CommandLine...

Synced Windows and Mac versions of Time and File libraries, made CommandLine compatible with Mac and added extra utility functions to _Pointer module

git-svn-id: https://svn.cs.ru.nl/repos/clean-platform/trunk@157 2afc29ad-3112-4e41-907a-9359c7e6e986
parent f92f3769
implementation module CommandLine
import StdInt, StdList, StdEnum
import _Pointer
import _Pointer, OS
getCommandLine :: *World -> ([String],*World)
getCommandLine world
......@@ -9,29 +9,34 @@ getCommandLine world
# argv = derefInt global_argv
= ([derefString (readInt argv (i << (IF_INT_64_OR_32 3 2)) ) \\ i <- [0..argc - 1]], world)
where
//The pushLc ABC instruction should work on all platforms / architectures
//Since it does not always work properly we use a fallback to pushL in some cases
//Fallback currently neccessary on:
// - 64 bit windows
//Global argc pointer
global_argc :: Pointer
global_argc = IF_INT_64_OR_32 global_argc64 global_argc32
global_argc = IF_POSIX_OR_WINDOWS global_argclc (IF_INT_64_OR_32 global_argcl global_argclc)
global_argc32 :: Pointer
global_argc32 = code {
global_argclc :: Pointer
global_argclc = code {
pushLc global_argc
}
global_argc64 :: Pointer
global_argc64 = code {
global_argcl :: Pointer
global_argcl = code {
pushL global_argc
}
//Global argv pointer
global_argv :: Pointer
global_argv = IF_INT_64_OR_32 global_argv64 global_argv32
global_argv = IF_POSIX_OR_WINDOWS global_argvlc (IF_INT_64_OR_32 global_argvl global_argvlc)
global_argv32 :: Pointer
global_argv32 = code {
global_argvlc :: Pointer
global_argvlc = code {
pushLc global_argv
}
global_argv64 :: Pointer
global_argv64 = code {
global_argvl :: Pointer
global_argvl = code {
pushL global_argv
}
......@@ -114,11 +114,34 @@ packInt :: !Int -> {#Int}
* a pointer to a ccall using the C conventions.
*/
packString :: !String -> {#Char}
/**
* Unpacks a NULL-terminated C-string into a Clean-string.
*/
unpackString :: !{#Char} -> String
/**
* Unpacks a 16-bit integer from a byte array (zero extended on 32-bit and 64-bit)
*/
unpackInt2Z :: !{#Char} !Offset -> Int
/*
* Unpacks a 16-bit integer from a byte array (sign extended on 32-bit and 64-bit)
*/
unpackInt2S :: !{#Char} !Offset -> Int
/**
* Unpacks a 32-bit integer from a byte array (zero extended on 64-bit)
*/
unpackInt4Z :: !{#Char} !Offset -> Int
/**
* Unpacks a 32-bit integer from a byte array (sign extended on 64-bit)
*/
unpackInt4S :: !{#Char} !Offset -> Int
/**
* Unpacks a 64-bit integer from a byte array
*/
unpackInt8 :: !{#Char} !Offset -> Int
/**
* Unpacks a boolean from a byte array
*/
unpackBool :: !{#Char} !Offset -> Bool
forceEval :: !a !*env -> *env
forceEvalPointer :: !Pointer !*env -> *env
\ No newline at end of file
forceEvalPointer :: !Pointer !*env -> *env
......@@ -556,6 +556,38 @@ where
unpack off | s.[off] == '\0' = s % (0, off - 1)
| otherwise = unpack (off + 1)
unpackInt2Z :: !{#Char} !Offset -> Int
unpackInt2Z s off
= (toInt s.[off])
bitor (toInt s.[off + 1] << 8)
unpackInt2S :: !{#Char} !Offset -> Int
unpackInt2S s off = IF_INT_64_OR_32 (((unpackInt2Z s off) << 48) >> 48) (((unpackInt2Z s off) << 16) >> 16)
unpackInt4Z :: !{#Char} !Offset -> Int
unpackInt4Z s off
= (toInt s.[off])
bitor (toInt s.[off + 1] << 8)
bitor (toInt s.[off + 2] << 16)
bitor (toInt s.[off + 3] << 24)
unpackInt4S :: !{#Char} !Offset -> Int
unpackInt4S s off = IF_INT_64_OR_32 (((unpackInt4Z s off) << 32) >> 32) (unpackInt4S s off)
unpackInt8 :: !{#Char} !Offset -> Int
unpackInt8 s off
= (toInt s.[off])
bitor (toInt s.[off + 1] << 8)
bitor (toInt s.[off + 2] << 16)
bitor (toInt s.[off + 3] << 24)
bitor (toInt s.[off + 4] << 32)
bitor (toInt s.[off + 5] << 40)
bitor (toInt s.[off + 6] << 48)
bitor (toInt s.[off + 7] << 56)
unpackBool :: !{#Char} !Offset -> Bool
unpackBool s off = unpackInt4Z s off <> 0
forceEval :: !a !*env -> *env
forceEval _ world = world
......
definition module _Posix
from _Pointer import :: Pointer
from Time import :: Tm
WNOHANG :== 0x00000001
WUNTRACED :== 0x00000002
......@@ -8,6 +9,16 @@ MAXPATHLEN :== 1024
DIRENT_D_NAME_OFFSET :== 8
S_IFMT :== 0170000
S_IFIFO :== 0010000
S_IFCHR :== 0020000
S_IFDIR :== 0040000
S_IFBLK :== 0060000
S_IFREG :== 0100000
S_IFLNK :== 0120000
S_IFSOCK :== 0140000
S_IFWHT :== 0160000
//Posix API calls
errno :: !*World -> (!Int,!*World)
strerr :: !Int -> Pointer
......@@ -30,3 +41,26 @@ readdir :: !Pointer !*World -> (!Pointer,!*World)
malloc :: !Int -> Pointer
free :: !Pointer -> Int
memcpy_string_to_pointer :: !Pointer !{#Char} !Int -> Pointer
//Posix datastructures
:: Stat =
{ st_dev :: !Int
, st_ino :: !Int
, st_mode :: !Int
, st_nlink :: !Int
, st_uid :: !Int
, st_gid :: !Int
, st_rdev :: !Int
, st_atimespec :: !Int
, st_mtimespec :: !Int
, st_ctimespec :: !Int
, st_birthtimespec :: !Int
, st_size :: !Int
, st_blocks :: !Int
, st_blksize :: !Int
, st_flags :: !Int
, st_gen :: !Int
}
//Mapping to/from byte arrays
unpackStat :: !{#Char} -> Stat
sizeOfStat :: Int
implementation module _Posix
import _Pointer
import _Pointer, Time
import StdInt
errno :: !*World -> (!Int,!*World)
errno world = (getErrno,world)
......@@ -20,7 +21,7 @@ strerr world = code {
stat :: !{#Char} !{#Char} !*World -> (!Int,!*World)
stat path buf world = code {
ccall stat "ss:I:A"
ccall stat$INODE64 "ss:I:A"
}
unlink :: !{#Char} !*World -> (!Int,!*World)
......@@ -88,3 +89,27 @@ memcpy_string_to_pointer :: !Pointer !{#Char} !Int -> Pointer
memcpy_string_to_pointer p s n = code {
ccall memcpy "psp:p"
}
//Mapping to/from byte arrays
unpackStat :: !{#Char} -> Stat
unpackStat s =
{ st_dev = unpackInt4S s 0
, st_ino = unpackInt8 s 8
, st_mode = unpackInt2S s 4
, st_nlink = unpackInt2S s 6
, st_uid = unpackInt4S s 16
, st_gid = unpackInt4S s 20
, st_rdev = unpackInt8 s 24
, st_atimespec = unpackInt8 s 32
, st_mtimespec = unpackInt8 s 48
, st_ctimespec = unpackInt8 s 64
, st_birthtimespec = unpackInt8 s 80
, st_size = unpackInt8 s 96
, st_blocks = unpackInt8 s 104
, st_blksize = unpackInt4S s 112
, st_flags = unpackInt4S s 116
, st_gen = unpackInt4S s 120
}
sizeOfStat :: Int
sizeOfStat = 144
......@@ -3,9 +3,10 @@ definition module File
from StdFile import class FileSystem
from StdClass import class toString
import Error
import Void
import OSError
from Time import ::Tm
from Error import ::MaybeError
from Void import ::Void
from OSError import ::MaybeOSError, ::OSError, ::OSErrorCode, ::OSErrorMessage
:: FileError = CannotOpen | CannotClose | IOError
......@@ -16,7 +17,7 @@ instance toString FileError
* @param Path to the file to read
* @return contents of the file
*/
readFile :: !String *env -> (MaybeError FileError String, *env) | FileSystem env
readFile :: !String !*env -> (!MaybeError FileError String, !*env) | FileSystem env
/**
* Read all contents of a *File to a String.
......@@ -24,14 +25,14 @@ readFile :: !String *env -> (MaybeError FileError String, *env) | FileSystem env
* @param Path to the file to read
* @return contents of the file
*/
readAll :: *File -> (MaybeError FileError String, *File)
readAll :: !*File -> (!MaybeError FileError String, !*File)
/**
* writes a string to a file
* Writes a string to a file
* @param Path to the file to read
* @param contents of the file
*/
writeFile :: !String !String *env -> (MaybeError FileError Void, *env) | FileSystem env
writeFile :: !String !String !*env -> (!MaybeError FileError Void, !*env) | FileSystem env
/**
* Performs a file operation on a given filename.
......@@ -40,22 +41,38 @@ writeFile :: !String !String *env -> (MaybeError FileError Void, *env) | FileSys
* @param file operation function
* @return file operation result
*/
withFile :: !String Int (*File -> (MaybeError FileError a,*File)) *env
-> (MaybeError FileError a, *env) | FileSystem env
withFile :: !String Int (*File -> (!MaybeError FileError a,!*File)) !*env
-> (!MaybeError FileError a, !*env) | FileSystem env
/**
* checks if a file exists
* Checks if a file exists
* @param Path to the file
* @return file exists
*/
fileExists :: !String *World -> (Bool, *World)
fileExists :: !String !*World -> (!Bool, !*World)
/**
* deletes a file from disk
* Deletes a file from disk
* @param Path to the file
* @return delete succeeded
*/
deleteFile :: !String *World -> (MaybeOSError Void, *World)
deleteFile :: !String !*World -> (!MaybeOSError Void, !*World)
:: FileInfo =
{ directory :: !Bool
, creationTime :: !Tm
, lastModifiedTime :: !Tm
, lastAccessedTime :: !Tm
, sizeHigh :: !Int
, sizeLow :: !Int
}
/**
* Retrieves file information
* @param Path to the file
* @return FileInfo structure
*/
getFileInfo :: !String !*World -> (!MaybeOSError FileInfo, !*World)
/**
* Moves or renames a file
......
......@@ -6,11 +6,13 @@ import StdFile
import StdList
import StdString
import Time
import Error
import Void
import OSError
import _Pointer
from _Posix import qualified stat, unlink, rename
from _Posix import qualified stat, unlink, rename, sizeOfStat, unpackStat, S_IFDIR, S_IFMT
from _Posix import :: Stat(..)
CHUNK_SIZE :== 1024
......@@ -20,10 +22,10 @@ where
toString CannotClose = "Cannot close"
toString IOError = "I/O error"
readFile :: !String *env -> (MaybeError FileError String, *env) | FileSystem env
readFile :: !String !*env -> (!MaybeError FileError String, !*env) | FileSystem env
readFile filename env = withFile filename FReadData readAll env
readAll :: *File -> (MaybeError FileError String, *File)
readAll :: !*File -> (!MaybeError FileError String, !*File)
readAll file
# (result, file) = readAcc file []
= case result of
......@@ -39,12 +41,12 @@ where
| eof = (Ok [str:acc],file)
| otherwise = readAcc file [str:acc]
writeFile :: !String !String *env -> (MaybeError FileError Void, *env) | FileSystem env
writeFile :: !String !String !*env -> (!MaybeError FileError Void, !*env) | FileSystem env
writeFile filename contents env =
withFile filename FWriteData (\file -> (Ok Void, fwrites contents file)) env
withFile :: !String Int (*File -> (MaybeError FileError a,*File)) *env
-> (MaybeError FileError a, *env) | FileSystem env
withFile :: !String Int (*File -> (!MaybeError FileError a,!*File)) !*env
-> (!MaybeError FileError a, !*env) | FileSystem env
withFile filename filemode operation env
# (ok,file,env) = fopen filename filemode env
| not ok = (Error CannotOpen, env)
......@@ -54,19 +56,36 @@ withFile filename filemode operation env
| not ok = (Error CannotClose, env)
= (Ok (fromOk result), env)
fileExists :: !String *World -> (Bool, *World)
fileExists :: !String !*World -> (!Bool, !*World)
fileExists path world
# buf = createArray (IF_INT_64_OR_32 144 88) '\0'
# buf = createArray '_Posix'.sizeOfStat '\0'
# (ok,world) = '_Posix'.stat (packString path) buf world
| ok == 0 = (True, world)
= (False, world)
deleteFile :: !String *World -> (MaybeOSError Void, *World)
deleteFile :: !String !*World -> (!MaybeOSError Void, !*World)
deleteFile path world
# (ok,world) = '_Posix'.unlink (packString path) world
| ok <> 0 = getLastOSError world
= (Ok Void, world)
getFileInfo :: !String !*World -> (!MaybeOSError FileInfo, !*World)
getFileInfo path world
# buf = createArray '_Posix'.sizeOfStat '\0'
# (ok,world) = '_Posix'.stat (packString path) buf world
| ok <> 0 = getLastOSError world
# stat = '_Posix'.unpackStat buf
# (ctime,world) = toLocalTime (Timestamp stat.st_ctimespec) world //NOT RELIABLE ctime is actually inode change time
# (mtime,world) = toLocalTime (Timestamp stat.st_mtimespec) world
# (atime,world) = toLocalTime (Timestamp stat.st_atimespec) world
= (Ok { directory = (stat.st_mode bitand '_Posix'.S_IFMT) == '_Posix'.S_IFDIR
, creationTime = ctime
, lastModifiedTime = mtime
, lastAccessedTime = atime
, sizeHigh = stat.st_blocks * stat.st_blksize
, sizeLow = stat.st_size
}, world)
moveFile :: !String !String !*World -> (!MaybeOSError Void, !*World)
moveFile oldpath newpath world
# (ret,world) = '_Posix'.rename (packString oldpath) (packString newpath) world
......
......@@ -5,6 +5,7 @@ definition module Time
*/
from StdString import class toString
import StdOverloaded
/**
* The resolution of the system clock ticks
......@@ -15,7 +16,7 @@ CLK_PER_SEC :== 100
* The Tm record structure contains date and time information
* in a broken down format.
*/
:: Tm = { sec :: Int // Seconds (0-60)
:: Tm = { sec :: Int // Seconds (0-61) (generally 0-59. Extra range to accommodate for leap seconds in certain systems.)
, min :: Int // Minutes (0-59)
, hour :: Int // Hour (0-23)
, mday :: Int // Day of the month (1-31)
......@@ -35,9 +36,12 @@ CLK_PER_SEC :== 100
*/
:: Clock = Clock !Int
instance toString Tm
instance toString Timestamp
instance toString Clock
instance toString Tm
instance toString Clock
instance toString Timestamp
instance == Timestamp
instance < Timestamp
instance toInt Timestamp
/**
* Get the number of clock ticks since the process start
......@@ -56,7 +60,7 @@ gmTime :: !*World -> (!Tm, !*World)
*/
localTime :: !*World -> (!Tm, !*World)
/**
* Convert a Tm record (local time) to a Time value
* Convert a Tm record (local time) to a Timestamp value
*/
mkTime :: !Tm -> Timestamp
/**
......@@ -67,3 +71,11 @@ diffTime :: !Timestamp !Timestamp -> Int
* Format the time structure using the format defined by C's time.h
*/
strfTime :: !String !Tm -> String
/**
* Convert a timestamp to a Tm record (local time)
*/
toLocalTime :: !Timestamp !*World -> (!Tm,!*World)
/**
* Convert a timestamp to a Tm record (GMT time)
*/
toGmTime :: !Timestamp -> Tm
......@@ -6,6 +6,14 @@ import _Pointer
//String buffer size
MAXBUF :== 256
instance == Timestamp
where
(==) (Timestamp t1) (Timestamp t2) = t1 == t2
instance < Timestamp
where
(<) (Timestamp t1) (Timestamp t2) = t1 < t2
instance toString Tm
where
toString tm = derefString (toStringTmC (packTm tm))
......@@ -25,6 +33,9 @@ where
instance toString Clock
where
toString (Clock c) = toString c
instance toInt Timestamp
where
toInt (Timestamp i) = i
clock :: !*World -> (!Clock, !*World)
clock world
......@@ -92,32 +103,62 @@ strfTime format tm
ccall strftime "sIsA:I:A"
}
//Custom deref and pack for the Tm structure
derefTm :: !Int -> Tm
derefTm tm = { sec = readInt4Z tm 0
, min = readInt4Z tm 4
, hour = readInt4Z tm 8
, mday = readInt4Z tm 12
, mon = readInt4Z tm 16
, year = readInt4Z tm 20
, wday = readInt4Z tm 24
, yday = readInt4Z tm 28
, isdst = readInt4Z tm 32 <> 0
}
toLocalTime :: !Timestamp !*World -> (!Tm,!*World)
toLocalTime (Timestamp t) world
# (tm,world) = localTimeC (packInt t) world
= (derefTm tm, world)
toGmTime :: !Timestamp -> Tm
toGmTime (Timestamp t) = derefTm (gmTimeC (packInt t))
gmTimeC :: !{#Int} -> Pointer
gmTimeC tm = code {
ccall gmtime "A:p"
}
localTimeC :: !{#Int} !*World -> (!Pointer, !*World)
localTimeC tm world = code {
ccall localtime "A:p:p"
}
derefTm :: !Pointer-> Tm
derefTm ptr = unpackTm (derefCharArray ptr sizeOfTm) 0
packTm :: !Tm -> {#Int}
packTm tm = IF_INT_64_OR_32
//64-bit
{ ((tm.min << 32) bitor (tm.sec bitand 0xFFFFFFFF))
, ((tm.mday << 32) bitor (tm.hour bitand 0xFFFFFFFF))
, ((tm.year << 32) bitor (tm.mon bitand 0xFFFFFFFF))
, ((tm.yday << 32) bitor (tm.wday bitand 0xFFFFFFFF))
, (if tm.isdst 1 0) bitand 0xFFFFFFFF
}
//32-bit
{ tm.sec, tm.min
, tm.hour, tm.mday
, tm.mon, tm.year
, tm.wday, tm.yday
, if tm.isdst 1 0
packTm tm = (IF_INT_64_OR_32 packTm64 packTm32) tm
packTm64 :: !Tm -> {#Int}
packTm64 tm = { tm.sec + tm.min << 32
, tm.hour + tm.mday << 32
, tm.mon + tm.year << 32
, tm.wday + tm.yday << 32
, if tm.isdst 1 0
}
packTm32 :: !Tm -> {#Int}
packTm32 tm = { tm.sec
, tm.min
, tm.hour
, tm.mday
, tm.mon
, tm.year
, tm.wday
, tm.yday
, if tm.isdst 1 0
}
unpackTm :: !{#Char} !Int -> Tm
unpackTm buf off =
{ sec = unpackInt4S buf (off + 0)
, min = unpackInt4S buf (off + 4)
, hour = unpackInt4S buf (off + 8)
, mday = unpackInt4S buf (off + 12)
, mon = unpackInt4S buf (off + 16)
, year = unpackInt4S buf (off + 20)
, wday = unpackInt4S buf (off + 24)
, yday = unpackInt4S buf (off + 28)
, isdst = unpackBool buf (off + 32)
}
sizeOfTm :: Int
sizeOfTm = 36
......@@ -17,7 +17,7 @@ instance toString FileError
* @param Path to the file to read
* @return contents of the file
*/
readFile :: !String !*env -> (!MaybeError FileError String , !*env) | FileSystem env
readFile :: !String !*env -> (!MaybeError FileError String, !*env) | FileSystem env
/**
* Read all contents of a *File to a String.
......@@ -25,7 +25,7 @@ readFile :: !String !*env -> (!MaybeError FileError String , !*env) | FileSystem
* @param Path to the file to read
* @return contents of the file
*/
readAll :: !*File -> (!MaybeError FileError String,! *File)
readAll :: !*File -> (!MaybeError FileError String, !*File)
/**
* Writes a string to a file
......@@ -74,7 +74,6 @@ deleteFile :: !String !*World -> (!MaybeOSError Void, !*World)
*/
getFileInfo :: !String !*World -> (!MaybeOSError FileInfo, !*World)
/**
* Moves or renames a file
* @param Path to the current file
......
......@@ -39,7 +39,7 @@ instance toString Tm
instance toString Clock
instance toString Timestamp
instance == Timestamp
instance < Timestamp
instance < Timestamp
instance toInt Timestamp
/**
......@@ -81,4 +81,4 @@ toGmTime :: !Timestamp -> Tm