Commit 6be0ace3 authored by Camil Staps's avatar Camil Staps 🐧

Remove dependency on Platform

parent fcb5add5
...@@ -49,8 +49,7 @@ Global ...@@ -49,8 +49,7 @@ Global
Path: {Project}*BatchBuild Path: {Project}*BatchBuild
Path: {Project}*Interfaces*LinkerInterface Path: {Project}*Interfaces*LinkerInterface
Path: {Application}*lib*ArgEnv Path: {Application}*lib*ArgEnv
Path: {Application}*lib*Platform Path: {Application}*lib*StdLib
Path: {Application}*lib*Platform*Deprecated*StdLib
Path: {Application}*lib*Directory Path: {Application}*lib*Directory
OtherPaths OtherPaths
Path: {Application}*lib*StdEnv Path: {Application}*lib*StdEnv
......
...@@ -20,12 +20,6 @@ import PmAbcMagic,PmFileInfo,PmDirCache ...@@ -20,12 +20,6 @@ import PmAbcMagic,PmFileInfo,PmDirCache
import Platform import Platform
from StdLibMisc import :: Date{..}, :: Time{..} from StdLibMisc import :: Date{..}, :: Time{..}
import Data.Error
import System.FilePath
from System.OS import IF_WINDOWS64
import System.Process
from Text import class Text(split), instance Text String
verboseInfo verbose info ps :== verbi verbose info ps verboseInfo verbose info ps :== verbi verbose info ps
where where
verbi verbose info ps verbi verbose info ps
...@@ -1680,14 +1674,12 @@ OptimiseABC mdn abc_path ps ...@@ -1680,14 +1674,12 @@ OptimiseABC mdn abc_path ps
# abcopt_path = abc_path % (0,size abc_path-4) +++ "opt.abc" # abcopt_path = abc_path % (0,size abc_path-4) +++ "opt.abc"
# ps = showInfo (Level2 ("Optimising ABC for '" +++ mdn.mdn_name +++ "'.")) ps # ps = showInfo (Level2 ("Optimising ABC for '" +++ mdn.mdn_name +++ "'.")) ps
# (h,ps) = acc_world_instead_of_ps (runProcessIO abcopt [abc_path,"-o",abcopt_path] Nothing) ps # (exitcode,err,ps) = RunExternalCommand abcopt [abc_path,"-o",abcopt_path] startupdir ps
| isError h = (False, updateErrorWindow ["failed to execute the ABC optimiser: " +++ snd (fromError h)] ps) # err = if (exitcode == 0)
# (h,io) = fromOk h err
# (r,ps) = acc_world_instead_of_ps (waitForProcess h) ps (err ++ ["ABC optimiser failed for " +++ mdn.mdn_name +++ " (exit code: " +++ toString exitcode +++ ")"])
| isError r = (False, updateErrorWindow ["failed to wait for the ABC optimiser: " +++ snd (fromError r)] ps) # ps = updateErrorWindow err ps
# ps = processIOToErrorWindow io ps = (exitcode == 0, ps)
| fromOk r <> 0 = (False, updateErrorWindow ["ABC optimiser failed with non-zero exit code " +++ toString (fromOk r) +++ " for " +++ mdn.mdn_name] ps)
= (True, ps)
ByteCodeGen :: !Bool !ModuleDirAndName !Pathname !*GeneralSt -> *(!Bool, !*GeneralSt) ByteCodeGen :: !Bool !ModuleDirAndName !Pathname !*GeneralSt -> *(!Bool, !*GeneralSt)
ByteCodeGen use_optimised_abc mdn abc_path ps ByteCodeGen use_optimised_abc mdn abc_path ps
...@@ -1698,14 +1690,12 @@ ByteCodeGen use_optimised_abc mdn abc_path ps ...@@ -1698,14 +1690,12 @@ ByteCodeGen use_optimised_abc mdn abc_path ps
bc_path = abc_path % (0,size abc_path-4) +++ "bc" bc_path = abc_path % (0,size abc_path-4) +++ "bc"
# ps = showInfo (Level2 ("Generating bytecode for '" +++ mdn.mdn_name +++ "'.")) ps # ps = showInfo (Level2 ("Generating bytecode for '" +++ mdn.mdn_name +++ "'.")) ps
# (h,ps) = acc_world_instead_of_ps (runProcessIO bcgen [if use_optimised_abc abcopt_path abc_path,"-o",bc_path] Nothing) ps # (exitcode,err,ps) = RunExternalCommand bcgen [if use_optimised_abc abcopt_path abc_path,"-o",bc_path] startupdir ps
| isError h = (False, updateErrorWindow ["failed to execute the bytecode generator: " +++ snd (fromError h)] ps) # err = if (exitcode == 0)
# (h,io) = fromOk h err
# (r,ps) = acc_world_instead_of_ps (waitForProcess h) ps (err ++ ["Bytecode generator failed for " +++ mdn.mdn_name +++ " (exit code: " +++ toString exitcode +++ ")"])
| isError r = (False, updateErrorWindow ["failed to wait for the bytecode generator: " +++ snd (fromError r)] ps) # ps = updateErrorWindow err ps
# ps = processIOToErrorWindow io ps = (exitcode == 0, ps)
| fromOk r <> 0 = (False, updateErrorWindow ["bytecode generator failed with non-zero exit code " +++ toString (fromOk r) +++ " for " +++ mdn.mdn_name] ps)
= (True, ps)
ByteCodeLink :: !FileInfoCache !Project !*GeneralSt -> *(!Bool, !*GeneralSt) ByteCodeLink :: !FileInfoCache !Project !*GeneralSt -> *(!Bool, !*GeneralSt)
ByteCodeLink fileinfo project ps ByteCodeLink fileinfo project ps
...@@ -1721,14 +1711,12 @@ ByteCodeLink fileinfo project ps ...@@ -1721,14 +1711,12 @@ ByteCodeLink fileinfo project ps
abcpaths = [root:removeMember root abcpaths] abcpaths = [root:removeMember root abcpaths]
# ps = showInfo (Level2 ("Linking bytecode for '" +++ RemovePath bcpath +++ "'")) ps # ps = showInfo (Level2 ("Linking bytecode for '" +++ RemovePath bcpath +++ "'")) ps
# (h,ps) = acc_world_instead_of_ps (runProcessIO bclink (abcpaths ++ ["-o",bcpath]) Nothing) ps # (exitcode,err,ps) = RunExternalCommand bclink (abcpaths ++ ["-o",bcpath]) startupdir ps
| isError h = (False, updateErrorWindow ["failed to execute the bytecode linker: " +++ snd (fromError h)] ps) # err = if (exitcode == 0)
# (h,io) = fromOk h err
# (r,ps) = acc_world_instead_of_ps (waitForProcess h) ps (err ++ ["Bytecode linker failed (exit code: " +++ toString exitcode +++ ")"])
| isError r = (False, updateErrorWindow ["failed to wait for the bytecode linker: " +++ snd (fromError r)] ps) # ps = updateErrorWindow err ps
# ps = processIOToErrorWindow io ps = (exitcode == 0, ps)
| fromOk r <> 0 = (False, updateErrorWindow ["bytecode linker failed with non-zero exit code " +++ toString (fromOk r)] ps)
= (True, ps)
ByteCodeStrip :: !FileInfoCache !Project !*GeneralSt -> *(!Bool, !*GeneralSt) ByteCodeStrip :: !FileInfoCache !Project !*GeneralSt -> *(!Bool, !*GeneralSt)
ByteCodeStrip fileinfo project ps ByteCodeStrip fileinfo project ps
...@@ -1738,23 +1726,9 @@ ByteCodeStrip fileinfo project ps ...@@ -1738,23 +1726,9 @@ ByteCodeStrip fileinfo project ps
# bcpath = fulPath startupdir (PR_GetRootDir project) (PR_GetByteCodePath project) # bcpath = fulPath startupdir (PR_GetRootDir project) (PR_GetByteCodePath project)
# ps = showInfo (Level2 ("Stripping bytecode for '" +++ RemovePath bcpath +++ "'")) ps # ps = showInfo (Level2 ("Stripping bytecode for '" +++ RemovePath bcpath +++ "'")) ps
# (h,ps) = acc_world_instead_of_ps (runProcessIO bcstrip [bcpath,"-o",bcpath] Nothing) ps # (exitcode,err,ps) = RunExternalCommand bcstrip [bcpath,"-o",bcpath] startupdir ps
| isError h = (False, updateErrorWindow ["failed to execute the bytecode stripper: " +++ snd (fromError h)] ps) # err = if (exitcode == 0)
# (h,io) = fromOk h err
# (r,ps) = acc_world_instead_of_ps (waitForProcess h) ps (err ++ ["Bytecode stripper failed (exit code: " +++ toString exitcode +++ ")"])
| isError r = (False, updateErrorWindow ["failed to wait for the bytecode stripper: " +++ snd (fromError r)] ps) # ps = updateErrorWindow err ps
# ps = processIOToErrorWindow io ps = (exitcode == 0, ps)
| fromOk r <> 0 = (False, updateErrorWindow ["bytecode stripper failed with non-zero exit code " +++ toString (fromOk r)] ps)
= (True, ps)
processIOToErrorWindow :: !ProcessIO !*GeneralSt -> *GeneralSt
processIOToErrorWindow io ps
| IF_WINDOWS64 True False = ps // FIXME: System.Process is broken on 64-bit windows (see Platform#65)
# (out,ps) = acc_world_instead_of_ps (readPipeBlocking io.stdOut) ps
# (err,ps) = acc_world_instead_of_ps (readPipeBlocking io.stdErr) ps
| isError out || isError err
= updateErrorWindow ["failed to get process output"] ps
# ps = updateErrorWindow [s \\ s <- split "\n" (fromOk err) | size s > 1] ps // 1, to also strip \r
# ps = updateErrorWindow [s \\ s <- split "\n" (fromOk out) | size s > 1] ps
# (_,ps) = acc_world_instead_of_ps (closeProcessIO io) ps
= ps
...@@ -93,3 +93,5 @@ ClearCompilerCaches :: .a ...@@ -93,3 +93,5 @@ ClearCompilerCaches :: .a
SendRepeatResult :: .a SendRepeatResult :: .a
StartCodeGenerator :: .a StartCodeGenerator :: .a
Execute` :: .a Execute` :: .a
RunExternalCommand :: !String ![String] !String !*GeneralSt -> *(!Int, ![String], !*GeneralSt)
...@@ -1096,6 +1096,61 @@ StartCodeGenerator = abort "StartCodeGenerator\n" ...@@ -1096,6 +1096,61 @@ StartCodeGenerator = abort "StartCodeGenerator\n"
Execute` :: .a Execute` :: .a
Execute` = abort "Execute`\n" Execute` = abort "Execute`\n"
RunExternalCommand :: !String ![String] !String !*GeneralSt -> *(!Int, ![String], !*GeneralSt)
RunExternalCommand cmd args startupdir ps
# temp_dir = temp_dir_path startupdir
errors_file_name = errors_file_path temp_dir 0
# stderr_fd = creat (errors_file_name+++"\0") 0644
| stderr_fd== (-1)
= abort "creat failed\n"
# (argv,args_memory) = make_argv [cmd : args]
# pid = fork
| pid<0
= abort "fork failed\n"
| pid==0
# r=dup2 stderr_fd 2
| r== (-1)
= abort "dup2 failed\n"
| execv (cmd+++"\0") argv<0
= abort "execv failed\n"
= abort "execution continued after execv\n"
| free args_memory<0
= abort "free failed\n"
# (w_pid,status) = wait_pid pid 0
| w_pid <> -1 && w_pid<>pid
= abort "waitpid failed\n"
# result = (status bitand 0xff00) >> 8
# wtermsig = status bitand 0x7f
| wtermsig<>0
= abort "external command exited abnormally\n"
# r=close stderr_fd
| r==(-1)
= abort "close failed\n"
# (out,ps) = accFiles (readFileLines errors_file_name) ps
= (result,out,ps)
where
readFileLines :: !String !*Files -> *(![String], !*Files)
readFileLines path env
# (ok,f,env) = fopen path FReadText env
| not ok = ([], env)
# (out,f) = read [] f
# (_,env) = fclose f env
= (out,env)
where
read :: ![String] !*File -> *(![String], !*File)
read acc f
# (e,f) = fend f
| e = (reverse acc,f)
# (line,f) = freadline f
#! line = strip_newlines line
= read [line:acc] f
wait_pid :: !Int !Int -> (!Int,!Int) wait_pid :: !Int !Int -> (!Int,!Int)
wait_pid pid options wait_pid pid options
# status_a = createArray 1 0 # status_a = createArray 1 0
......
...@@ -187,3 +187,5 @@ start_code_generator :: !String !(WindowFun *GeneralSt) !Pathname !Int !Bool !Co ...@@ -187,3 +187,5 @@ start_code_generator :: !String !(WindowFun *GeneralSt) !Pathname !Int !Bool !Co
-> (!Bool,!Int/*HANDLE*/,!StartedCodeGenerator,!*GeneralSt) -> (!Bool,!Int/*HANDLE*/,!StartedCodeGenerator,!*GeneralSt)
finish_code_generator :: !Int/*HANDLE*/ !StartedCodeGenerator !Int !(WindowFun *GeneralSt) !*GeneralSt -> (!Bool,!*GeneralSt) finish_code_generator :: !Int/*HANDLE*/ !StartedCodeGenerator !Int !(WindowFun *GeneralSt) !*GeneralSt -> (!Bool,!*GeneralSt)
wait_for_finished_code_generator :: !{#Int} !*GeneralSt -> (!Int,!Int,!*GeneralSt); wait_for_finished_code_generator :: !{#Int} !*GeneralSt -> (!Int,!Int,!*GeneralSt);
RunExternalCommand :: !String ![String] !String !*GeneralSt -> *(!Int, ![String], !*GeneralSt)
...@@ -2,7 +2,7 @@ implementation module PmCleanSystem ...@@ -2,7 +2,7 @@ implementation module PmCleanSystem
import StdArray, StdBool, StdChar, StdFunc, StdInt, StdList, StdEnum import StdArray, StdBool, StdChar, StdFunc, StdInt, StdList, StdEnum
import StdMaybe import StdMaybe
from StdMisc import undef from StdMisc import abort, undef
from Platform import DirSeparator,DirSeparatorString from Platform import DirSeparator,DirSeparatorString
...@@ -896,6 +896,42 @@ compile_with_cache2 path directory arguments compiler_thread_id compiler_thread_ ...@@ -896,6 +896,42 @@ compile_with_cache2 path directory arguments compiler_thread_id compiler_thread_
= (False,s) = (False,s)
= (True,s) = (True,s)
RunExternalCommand :: !String ![String] !String !*GeneralSt -> *(!Int, ![String], !*GeneralSt)
RunExternalCommand cmd args startupdir ps
# command = foldl (\cmd arg -> cmd +++ " " +++ arg) cmd [quoted_string arg \\ arg <- args]
dir = RemoveFilename cmd
errorsfilename = tooltempdir +++ DirSeparatorString +++ "errors"
(didit,exit_code,_) = call_process_with_directory_and_redirected_std_error command dir errorsfilename 99
| not didit = abort ("Could not run external command '" +++ command +++ "'\n")
# (out,ps) = accFiles (readFileLines errorsfilename) ps
= (exit_code,out,ps)
where
readFileLines :: !String !*Files -> *(![String], !*Files)
readFileLines path env
# (ok,f,env) = fopen path FReadText env
| not ok = ([], env)
# (out,f) = read [] f
# (_,env) = fclose f env
= (out,env)
where
read :: ![String] !*File -> *(![String], !*File)
read acc f
# (e,f) = fend f
| e = (reverse acc,f)
# (line,f) = freadline f
#! line = strip_newlines line
= read [line:acc] f
strip_newlines :: !{#Char} -> {#Char}
strip_newlines s
| size s==0
= s
# last = dec (size s)
char = s.[last]
| char == '\n' || char == '\r'
= strip_newlines (s % (0,dec last))
= s
StartCodeGenerator :: !String !(WindowFun *GeneralSt) !CodeGenerateAsmOrCode !Pathname !Int !Bool !CodeGenOptions !Processor !ApplicationOptions !Pathname !CompilerProcessIds !*GeneralSt -> (!Bool,!Pathname,!CompilerProcessIds,!*GeneralSt) StartCodeGenerator :: !String !(WindowFun *GeneralSt) !CodeGenerateAsmOrCode !Pathname !Int !Bool !CodeGenOptions !Processor !ApplicationOptions !Pathname !CompilerProcessIds !*GeneralSt -> (!Bool,!Pathname,!CompilerProcessIds,!*GeneralSt)
StartCodeGenerator _ _ _ _ _ _ _ _ _ _ _ _ = undef StartCodeGenerator _ _ _ _ _ _ _ _ _ _ _ _ = undef
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment