Verified Commit 6be0ace3 authored by Camil Staps's avatar Camil Staps 🚀

Remove dependency on Platform

parent fcb5add5
......@@ -49,8 +49,7 @@ Global
Path: {Project}*BatchBuild
Path: {Project}*Interfaces*LinkerInterface
Path: {Application}*lib*ArgEnv
Path: {Application}*lib*Platform
Path: {Application}*lib*Platform*Deprecated*StdLib
Path: {Application}*lib*StdLib
Path: {Application}*lib*Directory
OtherPaths
Path: {Application}*lib*StdEnv
......
......@@ -20,12 +20,6 @@ import PmAbcMagic,PmFileInfo,PmDirCache
import Platform
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
where
verbi verbose info ps
......@@ -1680,14 +1674,12 @@ OptimiseABC mdn abc_path ps
# abcopt_path = abc_path % (0,size abc_path-4) +++ "opt.abc"
# 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
| isError h = (False, updateErrorWindow ["failed to execute the ABC optimiser: " +++ snd (fromError h)] ps)
# (h,io) = fromOk h
# (r,ps) = acc_world_instead_of_ps (waitForProcess h) ps
| isError r = (False, updateErrorWindow ["failed to wait for the ABC optimiser: " +++ snd (fromError r)] ps)
# ps = processIOToErrorWindow io ps
| fromOk r <> 0 = (False, updateErrorWindow ["ABC optimiser failed with non-zero exit code " +++ toString (fromOk r) +++ " for " +++ mdn.mdn_name] ps)
= (True, ps)
# (exitcode,err,ps) = RunExternalCommand abcopt [abc_path,"-o",abcopt_path] startupdir ps
# err = if (exitcode == 0)
err
(err ++ ["ABC optimiser failed for " +++ mdn.mdn_name +++ " (exit code: " +++ toString exitcode +++ ")"])
# ps = updateErrorWindow err ps
= (exitcode == 0, ps)
ByteCodeGen :: !Bool !ModuleDirAndName !Pathname !*GeneralSt -> *(!Bool, !*GeneralSt)
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"
# 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
| isError h = (False, updateErrorWindow ["failed to execute the bytecode generator: " +++ snd (fromError h)] ps)
# (h,io) = fromOk h
# (r,ps) = acc_world_instead_of_ps (waitForProcess h) ps
| isError r = (False, updateErrorWindow ["failed to wait for the bytecode generator: " +++ snd (fromError r)] ps)
# ps = processIOToErrorWindow io ps
| fromOk r <> 0 = (False, updateErrorWindow ["bytecode generator failed with non-zero exit code " +++ toString (fromOk r) +++ " for " +++ mdn.mdn_name] ps)
= (True, ps)
# (exitcode,err,ps) = RunExternalCommand bcgen [if use_optimised_abc abcopt_path abc_path,"-o",bc_path] startupdir ps
# err = if (exitcode == 0)
err
(err ++ ["Bytecode generator failed for " +++ mdn.mdn_name +++ " (exit code: " +++ toString exitcode +++ ")"])
# ps = updateErrorWindow err ps
= (exitcode == 0, ps)
ByteCodeLink :: !FileInfoCache !Project !*GeneralSt -> *(!Bool, !*GeneralSt)
ByteCodeLink fileinfo project ps
......@@ -1721,14 +1711,12 @@ ByteCodeLink fileinfo project ps
abcpaths = [root:removeMember root abcpaths]
# ps = showInfo (Level2 ("Linking bytecode for '" +++ RemovePath bcpath +++ "'")) ps
# (h,ps) = acc_world_instead_of_ps (runProcessIO bclink (abcpaths ++ ["-o",bcpath]) Nothing) ps
| isError h = (False, updateErrorWindow ["failed to execute the bytecode linker: " +++ snd (fromError h)] ps)
# (h,io) = fromOk h
# (r,ps) = acc_world_instead_of_ps (waitForProcess h) ps
| isError r = (False, updateErrorWindow ["failed to wait for the bytecode linker: " +++ snd (fromError r)] ps)
# ps = processIOToErrorWindow io ps
| fromOk r <> 0 = (False, updateErrorWindow ["bytecode linker failed with non-zero exit code " +++ toString (fromOk r)] ps)
= (True, ps)
# (exitcode,err,ps) = RunExternalCommand bclink (abcpaths ++ ["-o",bcpath]) startupdir ps
# err = if (exitcode == 0)
err
(err ++ ["Bytecode linker failed (exit code: " +++ toString exitcode +++ ")"])
# ps = updateErrorWindow err ps
= (exitcode == 0, ps)
ByteCodeStrip :: !FileInfoCache !Project !*GeneralSt -> *(!Bool, !*GeneralSt)
ByteCodeStrip fileinfo project ps
......@@ -1738,23 +1726,9 @@ ByteCodeStrip fileinfo project ps
# bcpath = fulPath startupdir (PR_GetRootDir project) (PR_GetByteCodePath project)
# ps = showInfo (Level2 ("Stripping bytecode for '" +++ RemovePath bcpath +++ "'")) ps
# (h,ps) = acc_world_instead_of_ps (runProcessIO bcstrip [bcpath,"-o",bcpath] Nothing) ps
| isError h = (False, updateErrorWindow ["failed to execute the bytecode stripper: " +++ snd (fromError h)] ps)
# (h,io) = fromOk h
# (r,ps) = acc_world_instead_of_ps (waitForProcess h) ps
| isError r = (False, updateErrorWindow ["failed to wait for the bytecode stripper: " +++ snd (fromError r)] ps)
# ps = processIOToErrorWindow io 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
# (exitcode,err,ps) = RunExternalCommand bcstrip [bcpath,"-o",bcpath] startupdir ps
# err = if (exitcode == 0)
err
(err ++ ["Bytecode stripper failed (exit code: " +++ toString exitcode +++ ")"])
# ps = updateErrorWindow err ps
= (exitcode == 0, ps)
......@@ -93,3 +93,5 @@ ClearCompilerCaches :: .a
SendRepeatResult :: .a
StartCodeGenerator :: .a
Execute` :: .a
RunExternalCommand :: !String ![String] !String !*GeneralSt -> *(!Int, ![String], !*GeneralSt)
......@@ -1096,6 +1096,61 @@ StartCodeGenerator = abort "StartCodeGenerator\n"
Execute` :: .a
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 pid options
# status_a = createArray 1 0
......
......@@ -187,3 +187,5 @@ start_code_generator :: !String !(WindowFun *GeneralSt) !Pathname !Int !Bool !Co
-> (!Bool,!Int/*HANDLE*/,!StartedCodeGenerator,!*GeneralSt)
finish_code_generator :: !Int/*HANDLE*/ !StartedCodeGenerator !Int !(WindowFun *GeneralSt) !*GeneralSt -> (!Bool,!*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
import StdArray, StdBool, StdChar, StdFunc, StdInt, StdList, StdEnum
import StdMaybe
from StdMisc import undef
from StdMisc import abort, undef
from Platform import DirSeparator,DirSeparatorString
......@@ -896,6 +896,42 @@ compile_with_cache2 path directory arguments compiler_thread_id compiler_thread_
= (False,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 _ _ _ _ _ _ _ _ _ _ _ _ = 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