Commit ed359f63 authored by Mart Lubbers's avatar Mart Lubbers

Merge branch 'master' of gitlab.science.ru.nl:clean-and-itasks/clean-platform

parents b1cfd066 78810d32
Pipeline #9139 passed with stage
in 1 minute and 47 seconds
......@@ -4,6 +4,7 @@ Environments
EnvironmentName: Clean Platform
EnvironmentPaths
Path: {Application}\Libraries\StdEnv
Path: {Application}\Platform\src\libaries\Platform-x86
Path: {Application}\Platform\src\libraries\OS-Independent
Path: {Application}\Platform\src\libraries\OS-Independent\Data
Path: {Application}\Platform\src\libraries\OS-Independent\Database
......
......@@ -4,6 +4,7 @@
Path: {Application}/lib/StdEnv
Path: {Application}/lib/Generics
Path: {Application}/lib/StdLib
Path: {Application}/lib/clean-platform/Platform-x86
Path: {Application}/lib/clean-platform/OS-Independent
Path: {Application}/lib/clean-platform/OS-Independent/Data
Path: {Application}/lib/clean-platform/OS-Independent/Database
......
......@@ -4,6 +4,7 @@
Path: {Application}/lib/StdEnv
Path: {Application}/lib/Generics
Path: {Application}/lib/StdLib
Path: {Application}/lib/clean-platform/Platform-x86
Path: {Application}/lib/clean-platform/OS-Independent
Path: {Application}/lib/clean-platform/OS-Independent/Data
Path: {Application}/lib/clean-platform/OS-Independent/Database
......
definition module System.OS
OS_NAME :== "Android (32-bit)"
OS_PATH_SEPARATOR :== '/'
OS_NEWLINE :== "\n"
IF_POSIX_OR_WINDOWS posix windows :== posix
IF_WINDOWS win other :== other
IF_WINDOWS32 win other :== other
IF_WINDOWS64 win other :== other
IF_POSIX posix other :== posix
IF_LINUX linux other :== linux
IF_LINUX32 linux other :== linux
IF_LINUX64 linux other :== other
IF_MAC mac other :== other
IF_ANDROID android other :== android
implementation module System.OS
definition module System._Platform
import System.Platform
CURRENT_PLATFORM :== Android32
implementation module System._Platform
definition module System.OS
OS_NAME :== "Android (64-bit)"
OS_PATH_SEPARATOR :== '/'
OS_NEWLINE :== "\n"
IF_POSIX_OR_WINDOWS posix windows :== posix
IF_WINDOWS win other :== other
IF_WINDOWS32 win other :== other
IF_WINDOWS64 win other :== other
IF_POSIX posix other :== posix
IF_LINUX linux other :== linux
IF_LINUX32 linux other :== other
IF_LINUX64 linux other :== linux
IF_MAC mac other :== other
IF_ANDROID android other :== android
implementation module System.OS
definition module System._Platform
import System.Platform
CURRENT_PLATFORM :== Android64
implementation module System._Platform
definition module System._Posix
from System._Pointer import :: Pointer
from StdInt import IF_INT_64_OR_32
from System.Time import :: Tm
WNOHANG :== 0x00000001
WUNTRACED :== 0x00000002
MAXPATHLEN :== 1024
DIRENT_D_NAME_OFFSET :== 19
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
STDIN_FILENO :== 0
STDOUT_FILENO :== 1
STDERR_FILENO :== 2
FIONREAD :== 0x541B
F_SETFD :== 2
O_CLOEXEC :== 02000000
//Posix API calls
errno :: !*w -> (!Int,!*w)
strerr :: !Int -> Pointer
stat :: !{#Char} !{#Char} !*w -> (!Int,!*w)
unlink :: !{#Char} !*w -> (!Int,!*w)
fork :: !*w -> (!Int,!*w)
execvp :: !{#Char} !{#Pointer} !*w -> (!Int,!*w)
waitpid :: !Int !{#Int} !Int !*w -> (!Int,!*w)
exit :: !Int !*w -> (!.a,!*w)
getcwd :: !{#Char} !Int !*w -> (!Pointer,!*w)
chdir :: !{#Char} !*w -> (!Int,!*w)
mkdir :: !{#Char} !Int !*w -> (!Int,!*w)
rmdir :: !{#Char} !*w -> (!Int,!*w)
rename :: !{#Char} !{#Char} !*w -> (!Int,!*w)
opendir :: !{#Char} !*w -> (!Pointer,!*w)
closedir :: !Pointer !*w -> (!Int,!*w)
readdir :: !Pointer !*w -> (!Pointer,!*w)
pipe :: !Pointer !*w -> (!Int, !*w)
dup2 :: !Int !Int !*w -> (!Int, !*w)
close :: !Int !*w -> (!Int, !*w)
ioctl :: !Int !Int !Pointer !*w -> (!Int, !*w)
// variant requiring an argument as third parameter
fcntlArg :: !Int !Int !Int !*w -> (!Int, !*w)
read :: !Int !Pointer !Int !*w -> (!Int, !*w)
write :: !Int !{#Char} !Int !*w -> (!Int, !*w)
select_ :: !Int !Pointer !Pointer !Pointer !Pointer !*w -> (!Int, !*w)
kill :: !Int !Int !*w -> (!Int, !*w)
//Memory (impure)
malloc :: !Int -> Pointer
free :: !Pointer -> Int
freeSt :: !Pointer !*w -> *w
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_size :: !Int
, st_blocks :: !Int
, st_blksize :: !Int
, st_ctimespec :: !Int
, st_mtimespec :: !Int
, st_atimespec :: !Int
}
//Mapping to/from byte arrays
unpackStat :: !{#Char} -> Stat
sizeOfStat :: Int
implementation module System._Posix
import System._Pointer, System.Time
import StdInt
errno :: !*w -> (!Int,!*w)
errno world = (getErrno,world)
where
getErrno :: Int
getErrno = readInt4S errnoAddr 0
errnoAddr :: Pointer
errnoAddr = code {
ccall __errno ":p"
}
strerr :: !Int -> Pointer
strerr world = code {
ccall strerror "I:p"
}
stat :: !{#Char} !{#Char} !*w -> (!Int,!*w)
stat path buf world = code {
ccall stat "ss:I:A"
}
unlink :: !{#Char} !*w -> (!Int,!*w)
unlink path world = code {
ccall unlink "s:I:A"
}
fork :: !*w -> (!Int,!*w)
fork world = code {
ccall fork ":I:A"
}
execvp :: !{#Char} !{#Pointer} !*w -> (!Int,!*w)
execvp name argv world = code {
ccall execvp "sA:I:A"
}
waitpid :: !Int !{#Int} !Int !*w -> (!Int,!*w)
waitpid pid status_p options world = code {
ccall waitpid "IAI:I:A"
}
exit :: !Int !*w -> (!.a,!*w)
exit num world = code {
ccall exit "I:p:A"
}
getcwd :: !{#Char} !Int !*w -> (!Pointer,!*w)
getcwd buf size_t world = code {
ccall getcwd "sI:p:A"
}
chdir :: !{#Char} !*w -> (!Int,!*w)
chdir name world = code {
ccall chdir "s:I:A"
}
mkdir :: !{#Char} !Int !*w -> (!Int,!*w)
mkdir name mode world = code {
ccall mkdir "sI:I:A"
}
rmdir :: !{#Char} !*w -> (!Int,!*w)
rmdir name world = code {
ccall rmdir "s:I:A"
}
rename :: !{#Char} !{#Char} !*w -> (!Int,!*w)
rename old new world = code {
ccall rename "ss:I:A"
}
opendir :: !{#Char} !*w -> (!Pointer,!*w)
opendir path world = code {
ccall opendir "s:p:A"
}
closedir :: !Pointer !*w -> (!Int,!*w)
closedir dir world = code {
ccall closedir "p:I:A"
}
readdir :: !Pointer !*w -> (!Pointer,!*w)
readdir dir world = code {
ccall readdir "p:p:A"
}
pipe :: !Pointer !*w -> (!Int, !*w)
pipe arr world = code {
ccall pipe "p:I:A"
}
dup2 :: !Int !Int !*w -> (!Int, !*w)
dup2 old new world = code {
ccall dup2 "II:I:A"
}
close :: !Int !*w -> (!Int, !*w)
close fd world = code {
ccall close "I:I:A"
}
ioctl :: !Int !Int !Pointer !*w -> (!Int, !*w)
ioctl fd op ptr world = code {
ccall ioctl "IIp:I:A"
}
fcntlArg :: !Int !Int !Int !*w -> (!Int, !*w)
fcntlArg fd op arg world = code {
ccall fcntl "III:I:A"
}
read :: !Int !Pointer !Int !*w -> (!Int, !*w)
read fd buffer nBuffer world = code {
ccall read "IpI:I:A"
}
write :: !Int !{#Char} !Int !*w -> (!Int, !*w)
write fd buffer nBuffer world = code {
ccall write "IsI:I:A"
}
select_ :: !Int !Pointer !Pointer !Pointer !Pointer !*w -> (!Int, !*w)
select_ nfds readfds writefds exceptfds timeout world = code {
ccall select "Ipppp:I:A"
}
kill :: !Int !Int !*w -> (!Int, !*w)
kill pid sig world = code {
ccall kill "II:I:A"
}
malloc :: !Int -> Pointer
malloc num = code {
ccall malloc "p:p"
}
free :: !Pointer -> Int
free ptr = code {
ccall free "p:I"
}
freeSt :: !Pointer !*w -> *w
freeSt ptr world = code {
ccall free "p:V:A"
}
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 = IF_INT_64_OR_32 (unpackInt8 s 0) (unpackInt4S s 0 /*8 bytes*/)
, st_ino = IF_INT_64_OR_32 (unpackInt8 s 8) (unpackInt4S s 96)
, st_mode = IF_INT_64_OR_32 (unpackInt4S s 24) (unpackInt4S s 16)
, st_nlink = IF_INT_64_OR_32 (unpackInt8 s 16) (unpackInt4S s 20)
, st_uid = IF_INT_64_OR_32 (unpackInt4S s 28) (unpackInt4S s 24)
, st_gid = IF_INT_64_OR_32 (unpackInt4S s 32) (unpackInt4S s 28)
, st_rdev = IF_INT_64_OR_32 (unpackInt8 s 40) (unpackInt4S s 32 /*8 bytes*/)
, st_size = IF_INT_64_OR_32 (unpackInt8 s 48) (unpackInt4S s 44)
, st_blocks = IF_INT_64_OR_32 (unpackInt8 s 64) (unpackInt4S s 64)
, st_blksize = IF_INT_64_OR_32 (unpackInt8 s 56) (unpackInt4S s 56)
, st_atimespec = IF_INT_64_OR_32 (unpackInt8 s 72 /*16 bytes*/) (unpackInt4S s 72 /*8 bytes*/)
, st_mtimespec = IF_INT_64_OR_32 (unpackInt8 s 88 /*16 bytes*/) (unpackInt4S s 80 /*8 bytes*/)
, st_ctimespec = IF_INT_64_OR_32 (unpackInt8 s 104 /*16 bytes*/) (unpackInt4S s 88 /*8 bytes*/)
}
sizeOfStat :: Int
sizeOfStat = 104
......@@ -3,7 +3,9 @@ definition module System.Platform
import System._Platform
:: Platform
= Linux32
= Android32
| Android64
| Linux32
| Linux64
| Mac
| Windows32
......
GCC=gcc -m32 -c
CC=gcc -m32 -c
all: clean unicode
......@@ -8,7 +8,7 @@ clean:
rm -f *.o
bsearch.o:
$(GCC) -c bsearch.c
$(CC) $(CFLAGS) -c bsearch.c
WCsubst.o:
$(GCC) -c WCsubst.c
$(CC) $(CFLAGS) -c WCsubst.c
GCC=gcc -m64 -c
CC=gcc -m64 -c
all: clean unicode
......@@ -8,7 +8,7 @@ clean:
rm -f *.o
bsearch.o:
$(GCC) -c bsearch.c
$(CC) $(CFLAGS) -c bsearch.c
WCsubst.o:
$(GCC) -c WCsubst.c
$(CC) $(CFLAGS) -c WCsubst.c
......@@ -14,3 +14,4 @@ IF_LINUX linux other :== linux
IF_LINUX32 linux other :== linux
IF_LINUX64 linux other :== other
IF_MAC mac other :== other
IF_ANDROID android other :== other
......@@ -14,3 +14,4 @@ IF_LINUX linux other :== linux
IF_LINUX32 linux other :== other
IF_LINUX64 linux other :== linux
IF_MAC mac other :== other
IF_ANDROID android other :== other
......@@ -14,3 +14,4 @@ IF_LINUX linux other :== other
IF_LINUX32 linux other :== other
IF_LINUX64 linux other :== other
IF_MAC mac other :== mac
IF_ANDROID android other :== other
implementation module System.Time
import StdString, StdArray, StdClass, StdOverloaded, StdInt, StdMisc
import System.OS
import System._Pointer, System._Posix
import Text
......@@ -165,7 +166,7 @@ unpackTm buf off =
}
sizeOfTm :: Int
sizeOfTm = 36
sizeOfTm = IF_ANDROID 44 36
nsTime :: !*World -> (!Timespec, !*World)
nsTime w
......
......@@ -14,3 +14,4 @@ IF_LINUX linux other :== other
IF_LINUX32 linux other :== other
IF_LINUX64 linux other :== other
IF_MAC mac other :== other
IF_ANDROID android other :== other
......@@ -14,3 +14,4 @@ IF_LINUX linux other :== other
IF_LINUX32 linux other :== other
IF_LINUX64 linux other :== other
IF_MAC mac other :== other
IF_ANDROID android other :== other
implementation module System._Pointer
import StdOverloaded, StdClass, StdArray, StdInt, StdChar, StdString
readInt :: !Pointer !Offset -> Int
readInt pointer offset = code {
pop_b 1
| ldr r4, [r3, r4]
instruction 0xe7934004
}
readIntP :: !Pointer !Offset -> (!Int,!Pointer)
readIntP pointer offset = code {
| mov r2, r3
instruction 0xe1a02003
| ldr r3, [r3, r4]
instruction 0xe7933004
| mov r4, r2
instruction 0xe1a04002
}
readIntElemOffset :: !Pointer !Offset -> Int
readIntElemOffset pointer offset = code {
pop_b 1
| ldr r4, [r3, r4, lsl #2]
instruction 0xe7934104
}
readIntElemOffsetP :: !Pointer !Offset -> (!Int,!Pointer)
readIntElemOffsetP pointer offset = code {
| mov r2, r3
instruction 0xe1a02003
| ldr r3, [r3, r4, lsl #2]
instruction 0xe7933104
| mov r4, r2
instruction 0xe1a04002
}
readInt4Z :: !Pointer !Offset -> Int
readInt4Z pointer offset = code {
pop_b 1
| ldr r4, [r3, r4]
instruction 0xe7934004
}
readInt4S :: !Pointer !Offset -> Int
readInt4S pointer offset = code {
pop_b 1
| ldr r4, [r3, r4]
instruction 0xe7934004
}
readInt2Z :: !Pointer !Offset -> Int
readInt2Z pointer offset = code {
pop_b 1
| ldrh r4, [r3, r4]
instruction 0xe19340b4
}
readInt2S :: !Pointer !Offset -> Int
readInt2S pointer offset = code {
pop_b 1
| ldrsh r4, [r3, r4]
instruction 0xe19340f4
}
readInt1Z :: !Pointer !Offset -> Int
readInt1Z pointer offset = code {
pop_b 1
| ldrb r4, [r3, r4]
instruction 0xe7d34004
}
readInt1S :: !Pointer !Offset -> Int
readInt1S pointer offset = code {
pop_b 1
| ldrsb r4, [r3, r4]
instruction 0xe19340d4
}
readChar :: !Pointer !Offset -> Char
readChar pointer offset = code {
pop_b 1
| ldrb r4, [r3, r4]
instruction 0xe7d34004
}
readReal8 :: !Pointer !Offset -> Real
readReal8 pointer offset = code {
pushR 0.0
update_b 1 3
updatepop_b 0 2
jmp read_f8_p_32
:read_f8_p_32
| add r4, r3, r4
instruction 0xe0834004
| vldr d0, [r4]
instruction 0xed940b00
}
readReal4 :: !Pointer !Offset -> Real
readReal4 pointer offset = code {
pushR 0.0
update_b 1 3
updatepop_b 0 2
jmp read_f4_p_32
:read_f4_p_32
| add r4, r3, r4
instruction 0xe0834004
| vldr s0, [r4]
instruction 0xed940a00
| vcvt.f64.f32 d0, s0
instruction 0xeeb70ac0
}
writeInt :: !Pointer !Offset !Int -> Pointer
writeInt pointer offset i = code {
| str r4, [r2, r3]
instruction 0xe7824003
updatepop_b 0 2
}
writeIntElemOffset :: !Pointer !Offset !Int -> Pointer
writeIntElemOffset pointer offset i = code {
| str r4, [r2, r3, lsl #2]
instruction 0xe7824103
updatepop_b 0 2
}
writeInt4 :: !Pointer !Offset !Int -> Pointer
writeInt4 pointer offset i = code {
| str r4, [r2, r3]
instruction 0xe7824003
updatepop_b 0 2
}
writeInt2 :: !Pointer !Offset !Int -> Pointer
writeInt2 pointer offset i = code {
| strh r4, [r2, r3]
instruction 0xe18240b3
updatepop_b 0 2
}
writeInt1 :: !Pointer !Offset !Int -> Pointer
writeInt1 pointer offset i = code {
| strb r4, [r2, r3]
instruction 0xe7c24003
updatepop_b 0 2
}
writeChar :: !Pointer !Offset !Char -> Pointer
writeChar pointer offset i = code {
| strb r4, [r2, r3]
instruction 0xe7c24003
updatepop_b 0 2
}
writeReal8 :: !Pointer !Offset !Real -> Pointer
writeReal8 pointer offset double = code {
| add r4, r3, r4
instruction 0xe0834004
| vstr d0, [r4]
instruction 0xed840b00
updatepop_b 0 3
}
writeReal4 :: !Pointer !Offset !Real -> Pointer
writeReal4 pointer offset double = code {
| add r4, r3, r4
instruction 0xe0834004
| vcvt.f32.f64 s0, d0
instruction 0xeeb70bc0
| vstr s0, [r4]
instruction 0xed840a00
updatepop_b 0 3
}
derefInt :: !Pointer -> Int
derefInt ptr = code {
load_i 0
}
derefString :: !Pointer -> String
derefString ptr = copy ptr 0 (createArray len '\0')
where
len = skip_to_zero ptr - ptr
skip_to_zero ptr
| load_char ptr <> '\0' = skip_to_zero (ptr+1)
= ptr
copy :: !Pointer !Offset *{#Char} -> *{#Char}
copy ptr off arr
# char = load_char (ptr+off)
| char <> '\0' = copy ptr (off + 1) {arr & [off] = char}
= arr
derefCharArray :: !Pointer !Int -> {#Char}
derefCharArray ptr len = copy 0 (createArray len '\0')
where
copy :: !Offset *{#Char} -> *{#Char}
copy off arr
# char = load_char (ptr+off)
| off < len = copy (inc off) {arr & [off] = char}
= arr
load_char :: !Pointer -> Char
load_char ptr = code inline {
load_ui8 0
}
writeCharArray :: !Pointer !{#Char} -> Pointer
writeCharArray ptr array = copy ptr 0
where
len = size array
copy :: !Pointer !Offset -> Pointer
copy ptr off
# char = array.[off]
| off < len = copy (writeChar ptr off char) (inc off)
= ptr
packInt :: !Int -> {#Int}
packInt i = {i}
packString :: !String -> {#Char}
packString s = s +++ "\0"
unpackString :: !{#Char} -> String
unpackString s = unpack 0
where
unpack :: Int -> String
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
= ((unpackInt2Z s off) bitxor 0x8000) - 0x8000
// = ((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