Commit 97ed2178 authored by John van Groningen's avatar John van Groningen

Merge branch 'master' into 'master'

Add support for bytecode generation to cpm and IDE

See merge request !9
parents ee702065 936b9ba7
Pipeline #18420 passed with stage
in 47 seconds
......@@ -63,6 +63,10 @@ getCurrentSlibs :: !*GeneralSt -> (!(List String),!*GeneralSt)
getCurrentObjts :: !*GeneralSt -> (!(List String),!*GeneralSt)
getCurrentComp :: !*GeneralSt -> (!String,!*GeneralSt)
getCurrentCgen :: !*GeneralSt -> (!String,!*GeneralSt)
getCurrentAbcOpt :: !*GeneralSt -> (!String,!*GeneralSt)
getCurrentBCgen :: !*GeneralSt -> (!String,!*GeneralSt)
getCurrentBClink :: !*GeneralSt -> (!String,!*GeneralSt)
getCurrentBCstrip :: !*GeneralSt -> (!String,!*GeneralSt)
getCurrentLink :: !*GeneralSt -> (!String,!*GeneralSt)
getCurrentDynl :: !*GeneralSt -> (!String,!*GeneralSt)
getCurrentVers :: !*GeneralSt -> (!Int,!*GeneralSt)
......
......@@ -178,6 +178,26 @@ getCurrentCgen ps
# (ct,ps) = accPLoc (\p=:{pm_targets,pm_curtarg}->(pm_targets!!pm_curtarg,p)) ps
= (ct.target_cgen,ps)
getCurrentAbcOpt :: !*GeneralSt -> (!String,!*GeneralSt)
getCurrentAbcOpt ps
# (ct,ps) = accPLoc (\p=:{pm_targets,pm_curtarg}->(pm_targets!!pm_curtarg,p)) ps
= (ct.target_abcopt,ps)
getCurrentBCgen :: !*GeneralSt -> (!String,!*GeneralSt)
getCurrentBCgen ps
# (ct,ps) = accPLoc (\p=:{pm_targets,pm_curtarg}->(pm_targets!!pm_curtarg,p)) ps
= (ct.target_bcgen,ps)
getCurrentBClink :: !*GeneralSt -> (!String,!*GeneralSt)
getCurrentBClink ps
# (ct,ps) = accPLoc (\p=:{pm_targets,pm_curtarg}->(pm_targets!!pm_curtarg,p)) ps
= (ct.target_bclink,ps)
getCurrentBCstrip :: !*GeneralSt -> (!String,!*GeneralSt)
getCurrentBCstrip ps
# (ct,ps) = accPLoc (\p=:{pm_targets,pm_curtarg}->(pm_targets!!pm_curtarg,p)) ps
= (ct.target_bcstrip,ps)
getCurrentLink :: !*GeneralSt -> (!String,!*GeneralSt)
getCurrentLink ps
# (ct,ps) = accPLoc (\p=:{pm_targets,pm_curtarg}->(pm_targets!!pm_curtarg,p)) ps
......
......@@ -179,6 +179,10 @@ getCurrentObjts :: !*(PSt *General) -> (!(List String),!*PSt *General)
getCurrentComp :: !*(PSt *General) -> (!String,!*PSt *General)
getCurrentCgen :: !*(PSt *General) -> (!String,!*PSt *General)
getCurrentAbcOpt :: !*(PSt *General) -> (!String,!*PSt *General)
getCurrentBCgen :: !*(PSt *General) -> (!String,!*PSt *General)
getCurrentBClink :: !*(PSt *General) -> (!String,!*PSt *General)
getCurrentBCstrip :: !*(PSt *General) -> (!String,!*PSt *General)
getCurrentLink :: !*(PSt *General) -> (!String,!*PSt *General)
getCurrentDynl :: !*(PSt *General) -> (!String,!*PSt *General)
getCurrentVers :: !*(PSt *General) -> (!Int,!*PSt *General)
......
......@@ -440,6 +440,26 @@ getCurrentCgen ps
# (ct,ps) = accPLoc (\p=:{pm_targets,pm_curtarg}->(pm_targets!!pm_curtarg,p)) ps
= (ct.target_cgen,ps)
getCurrentAbcOpt :: !*(PSt *General) -> (!String,!*PSt *General)
getCurrentAbcOpt ps
# (ct,ps) = accPLoc (\p=:{pm_targets,pm_curtarg}->(pm_targets!!pm_curtarg,p)) ps
= (ct.target_abcopt,ps)
getCurrentBCgen :: !*(PSt *General) -> (!String,!*PSt *General)
getCurrentBCgen ps
# (ct,ps) = accPLoc (\p=:{pm_targets,pm_curtarg}->(pm_targets!!pm_curtarg,p)) ps
= (ct.target_bcgen,ps)
getCurrentBClink :: !*(PSt *General) -> (!String,!*PSt *General)
getCurrentBClink ps
# (ct,ps) = accPLoc (\p=:{pm_targets,pm_curtarg}->(pm_targets!!pm_curtarg,p)) ps
= (ct.target_bclink,ps)
getCurrentBCstrip :: !*(PSt *General) -> (!String,!*PSt *General)
getCurrentBCstrip ps
# (ct,ps) = accPLoc (\p=:{pm_targets,pm_curtarg}->(pm_targets!!pm_curtarg,p)) ps
= (ct.target_bcstrip,ps)
getCurrentLink :: !*(PSt *General) -> (!String,!*PSt *General)
getCurrentLink ps
# (ct,ps) = accPLoc (\p=:{pm_targets,pm_curtarg}->(pm_targets!!pm_curtarg,p)) ps
......
......@@ -14,6 +14,7 @@ from projwin import pm_update_project_window
, paths :: !List String
, lo :: !LinkOptions
, xp :: !String // exepath
, bytecodepath :: !String
, sl :: !StaticLibInfo
, post_link :: !Maybe String
}
......@@ -42,6 +43,7 @@ projectDialog actualProject ps`
# (appPath,ps) = getStup ps
# prjPath = PR_GetRootDir prj
# prj = PR_SetExecPath ret.xp prj
# prj = PR_SetByteCodePath ret.bytecodepath prj
# prj = PR_SetStaticLibsInfo ret.sl prj
# (xxId,ps) = getPWX ps
# ps = setFlexTexts [(xxId,ret.xp)] ps
......@@ -75,8 +77,8 @@ where
]) ps
// actualProject
(project,ps0) = getProject ps`
([okId,cancelId,dlogId,hsId,ssId,emId,hmId,ihId,mhId,c1id,r1id,c2id,c3id,c4id,xpId,rsrcsId,symbolsId,post_link_id:_],ps1)
= openIds 18 ps0
([okId,cancelId,dlogId,hsId,ssId,emId,hmId,ihId,mhId,c1id,r1id,c2id,c3id,c4id,xpId,bytecodepathId,rsrcsId,symbolsId,post_link_id:_],ps1)
= openIds 19 ps0
(lbpadId,ps2) = openExtListBoxId ps1
(lbobjId,ps3) = openExtListBoxId ps2
(lbdlibId,ps4) = openExtListBoxId ps3
......@@ -110,7 +112,7 @@ where
sl = PR_GetStaticLibsInfo project
root_path = PR_GetRootModuleDir project
(post_link,_) = PR_GetPostlink project
inils = {ao=ao,cgo=cgo,paths=paths,lo=lo,xp=fulexepath,sl=sl,post_link=post_link}
inils = {ao=ao,cgo=cgo,paths=paths,lo=lo,xp=fulexepath,bytecodepath=fulbcpath,sl=sl,post_link=post_link}
// generic...
panesOptions = TabControl
......@@ -164,8 +166,10 @@ where
cancelfun (ls,ps) = (inils,closeWindow dlogId ps)
fulexepath = PR_GetExecPath project
symexepath = symPath ap pp fulexepath
fulexepath = PR_GetExecPath project
symexepath = symPath ap pp fulexepath
fulbcpath = PR_GetByteCodePath project
bytecodepath = symPath ap pp fulbcpath
setexe (ls,ps)
# (prjPath,ps) = getProjectFilePath ps
......@@ -183,6 +187,22 @@ where
# ps = appPIO (setControlText xpId ("Executable produced as: "+++exename)) ps
= (ls,ps)
setbytecodepath (ls,ps)
# (prjPath,ps) = getProjectFilePath ps
# prjName = RemoveSuffix (RemovePath prjPath)
# prjPath = pp
# (bcname,ps) = PlatformDependant
(selectOutputFile` "Bytecode" "*.bc" "Set" ps) // win
(selectOutputFile "Bytecode" prjName ps) // mac
| isNothing bcname
= (ls,ps)
# bcname = fromJust bcname
# (appPath,ps) = getStup ps
# bcname = symPath appPath prjPath bcname
# ls = {ls & bytecodepath = bcname}
# ps = appPIO (setControlText bytecodepathId ("Bytecode produced as: "+++bcname)) ps
= (ls,ps)
applicationPane = Pane "Application"
// heap size
( TextControl "Application Options" []
......@@ -300,6 +320,14 @@ where
:+: CheckControl
[("Generate descriptors and export labels",Nothing,toMark ao.desc_exl,noPS (\l->{l & ao.desc_exl = not l.ao.desc_exl}))]
(Columns 1) [ControlPos (Left,zero)]
:+: CheckControl
[("Optimise ABC",Nothing,toMark cgo.optimise_abc,noPS (\l->{l & cgo.optimise_abc = not l.cgo.optimise_abc}))]
(Columns 1) [ControlPos (Left,zero)]
:+: CheckControl
[("Generate bytecode",Nothing,toMark cgo.generate_bytecode,noPS (\l->{l & cgo.generate_bytecode = not l.cgo.generate_bytecode}))]
(Columns 1) [ControlPos (Left,zero)]
:+: TextControl ("Bytecode produced as: "+++bytecodepath) [ControlId bytecodepathId,ControlPos (Left,zero):if actualProject [] [ControlHide]]
:+: ButtonControl "Set bytecode file..." [ControlFunction setbytecodepath,ControlPos (Left,zero):if actualProject [] [ControlHide]]
)
diagnosticsPane = Pane "Diagnostics"
( TextControl "Diagnostics Options" []
......
......@@ -413,6 +413,20 @@ editTargets getTs setTs ps
, lbpadId :: !ExtListBoxId ps
}
:: EnvironmentSettingsIds =
{ compId :: !Id // compiler
, cgenId :: !Id // code generator
, linkId :: !Id // linker
, dynlId :: !Id // dynamic linker
, versId :: !Id // ABC version
, methId :: !Id // compilation method
, abcOptId :: !Id // ABC optimiser
, bcGenId :: !Id // bytecode generator
, bcLinkId :: !Id // bytecode linker
, bcStripId :: !Id // bytecode stripper
}
envDialog ap pp ts ct getTs setTs ps
# (wid,ps) = openId ps
# (okId,ps) = openId ps
......@@ -469,12 +483,19 @@ envDialog ap pp ts ct getTs setTs ps
) // selection update function
lbsllId
[ControlViewSize {h=siz.Size.h,w=300}]
# (compId,ps) = openId ps
# (cgenId,ps) = openId ps
# (linkId,ps) = openId ps
# (dynlId,ps) = openId ps
# (versId,ps) = openId ps
# (methId,ps) = openId ps
# ([compId,cgenId,linkId,dynlId,versId,methId,abcOptId,bcGenId,bcLinkId,bcStripId:_],ps) = openIds 10 ps
# environmentSettingsIds =
{ compId = compId
, cgenId = cgenId
, linkId = linkId
, dynlId = dynlId
, versId = versId
, methId = methId
, abcOptId = abcOptId
, bcGenId = bcGenId
, bcLinkId = bcLinkId
, bcStripId = bcStripId
}
# (c1id,ps) = openId ps
# (c2id,ps) = openId ps
# (c3id,ps) = openId ps
......@@ -495,7 +516,7 @@ envDialog ap pp ts ct getTs setTs ps
}
# (_,ps) = openModalDialog iniLS
(ddef wid okId cancelId lbobj lbobjId lblib lblibId (path_size.Size.h) lbpadId lbsll
lbsllId siz compId cgenId linkId dynlId versId methId c1id c2id c3id c4id
lbsllId siz environmentSettingsIds c1id c2id c3id c4id
r1id r2id r3id r4id
) ps
= ps
......@@ -503,22 +524,22 @@ where
tg = ts!!ct
inifull = False
ddef wid okId cancelId lbobj lbobjId lblib lblibId height lbpadId lbsll lbsllId siz compId cgenId linkId dynlId
versId methId c1id c2id c3id c4id r1id r2id r3id r4id
ddef wid okId cancelId lbobj lbobjId lblib lblibId height lbpadId lbsll lbsllId siz environmentSettingsIds
c1id c2id c3id c4id r1id r2id r3id r4id
= Dialog ("Environment: "+++tg.target_name)
(title :+: panes :+: buttons`)
[WindowId wid, WindowOk okId, WindowClose (noLS (closeWindow wid)), WindowCancel cancelId]
where
buttons` = buttons wid okId cancelId getTs setTs ct ts compId cgenId linkId dynlId versId methId
buttons` = buttons wid okId cancelId getTs setTs ct ts environmentSettingsIds
panes = TabControl
( Pane "Tools" (toolpane tg compId cgenId linkId dynlId versId methId)
( Pane "Tools" (toolpane tg environmentSettingsIds)
:+: Pane "Paths" (pathpane ap pp tg.target_path inifull height lbpadId c1id r1id)
:+: Pane "Dynamic Libraries" (dlibpane inifull lblib c2id r2id)
:+: Pane "Static Libraries" (slibpane inifull lbsll c3id r3id)
:+: Pane "Object Modules" (objmpane inifull lbobj c4id r4id)
) [ControlPos (Left,zero)]
buttons wid okId cancelId getTs setTs ct ts compId cgenId linkId dynlId versId methId
buttons wid okId cancelId getTs setTs ct ts {compId,cgenId,linkId,dynlId,versId,methId,abcOptId,bcGenId,bcLinkId,bcStripId}
= ButtonControl "Done"
[ ControlFunction savefun
, ControlId okId, ControlPos (Right,zero)
......@@ -568,12 +589,14 @@ where
| isNothing wdef
= abort "Fatal error in environment dialog: window has disappeared."
# wdef = fromJust wdef
# [(ok1,comp),(ok2,cgen),(ok3,link),(ok4,dynl),(ok5,vers),(ok6,mnum):_]
= getControlTexts [compId,cgenId,linkId,dynlId,versId,methId] wdef
| not (ok1 && ok2 && ok3 && ok4 && ok5 && ok6)
# [(ok1,comp),(ok2,cgen),(ok3,link),(ok4,dynl),(ok5,vers),(ok6,mnum),
(ok7,abcopt),(ok8,bcgen),(ok9,bclink),(ok10,bcstrip):_]
= getControlTexts [compId,cgenId,linkId,dynlId,versId,methId,abcOptId,bcGenId,bcLinkId,bcStripId] wdef
| not (ok1 && ok2 && ok3 && ok4 && ok5 && ok6 && ok7 && ok8 && ok9 && ok10)
= abort "Fatal error in environment dialog: controls have disappeared."
| (isNothing comp) || (isNothing cgen) || (isNothing link) || (isNothing dynl)
|| (isNothing vers) || (isNothing mnum)
|| isNothing abcopt || isNothing bcgen || isNothing bclink || isNothing bcstrip
= abort "Fatal error in environment dialog: controls are empty."
# comp = fromJust comp
# cgen = fromJust cgen
......@@ -581,6 +604,10 @@ where
# dynl = fromJust dynl
# vers = fromJust vers
# mnum = fromJust mnum
# abcopt = fromJust abcopt
# bcgen = fromJust bcgen
# bclink = fromJust bclink
# bcstrip = fromJust bcstrip
# ls =
{ ls
& tg.target_comp = comp
......@@ -588,6 +615,10 @@ where
, tg.target_link = link
, tg.target_dynl = dynl
, tg.target_vers = toInt vers
, tg.target_abcopt = abcopt
, tg.target_bcgen = bcgen
, tg.target_bclink = bclink
, tg.target_bcstrip = bcstrip
}
# ls = case ls.tg.target_meth of
(CompileAsync _) -> {ls & tg.target_meth = CompileAsync (toInt mnum)}
......@@ -600,7 +631,7 @@ where
title
= TextControl "Environment Options" [ControlPos (Center,zero)]
toolpane tg compId cgenId linkId dynlId versId methId
toolpane tg {compId,cgenId,linkId,dynlId,versId,methId,abcOptId,bcGenId,bcLinkId,bcStripId}
= TextControl "Compiler: " [ControlWidth textWidth]
:+: EditControl tg.target_comp (PixelWidth 250) 1
[ ControlId compId
......@@ -621,6 +652,26 @@ toolpane tg compId cgenId linkId dynlId versId methId
[ ControlId dynlId
, ControlActivate (noLS (appPIO (setEditControlSelection dynlId 1 0)))
]
:+: TextControl "ABC Optimiser: " [ControlPos (Left,zero),ControlWidth textWidth]
:+: EditControl tg.target_abcopt (PixelWidth 250) 1
[ ControlId abcOptId
, ControlActivate (noLS (appPIO (setEditControlSelection abcOptId 1 0)))
]
:+: TextControl "Bytecode Generator: " [ControlPos (Left,zero),ControlWidth textWidth]
:+: EditControl tg.target_bcgen (PixelWidth 250) 1
[ ControlId bcGenId
, ControlActivate (noLS (appPIO (setEditControlSelection bcGenId 1 0)))
]
:+: TextControl "Bytecode Linker: " [ControlPos (Left,zero),ControlWidth textWidth]
:+: EditControl tg.target_bclink (PixelWidth 250) 1
[ ControlId bcLinkId
, ControlActivate (noLS (appPIO (setEditControlSelection bcLinkId 1 0)))
]
:+: TextControl "Bytecode Stripper: " [ControlPos (Left,zero),ControlWidth textWidth]
:+: EditControl tg.target_bcstrip (PixelWidth 250) 1
[ ControlId bcStripId
, ControlActivate (noLS (appPIO (setEditControlSelection bcStripId 1 0)))
]
:+: TextControl "ABC version: " [ControlPos (Left,zero),ControlWidth textWidth]
:+: EditControl (toString tg.target_vers) (PixelWidth 250) 1
[ ControlId versId
......@@ -658,7 +709,7 @@ toolpane tg compId cgenId linkId dynlId versId methId
, ControlActivate (noLS (appPIO (setEditControlSelection methId 1 0)))
]
where
textWidth = ContentWidth "Dynamic Linker: "
textWidth = ContentWidth "Bytecode Generator: "
redcfun (ls,ps)
# ls = {ls & tg.target_redc = not ls.tg.target_redc}
......
......@@ -92,3 +92,5 @@ ClearCompilerCaches :: .a
SendRepeatResult :: .a
StartCodeGenerator :: .a
Execute` :: .a
RunExternalCommand :: !String ![String] !String !*GeneralSt -> *(!Int, ![String], !*GeneralSt)
......@@ -981,6 +981,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
......
implementation module PmDriver
import StdArray,StdBool,StdList,StdMisc,StdEnum,StdStrictLists
import StdArray,StdBool,StdList,StdMisc,StdEnum,StdStrictLists,StdTuple
from StdOverloadedList import Foldr,++|,Hd,Any
import UtilNewlinesFile, UtilIO
......@@ -813,6 +813,13 @@ step intr (DLink ds=:{ok, newpaths, fileinfo, libsinfo, modpaths, abccache, proj
# ps = showInfo line ps
= continue False newpaths False fileinfo libsinfo modpaths project intr (abccache, ps)
# (ok,ps) = if (PR_GetByteCodePath project <> "") (ByteCodeLink fileinfo project ps) (True, ps)
| not ok
= continue False newpaths False fileinfo libsinfo modpaths project intr (abccache, ps)
# (ok,ps) = if (lo.strip_bytecode && PR_GetByteCodePath project <> "") (ByteCodeStrip fileinfo project ps) (True, ps)
| not ok
= continue False newpaths False fileinfo libsinfo modpaths project intr (abccache, ps)
# execpath = PR_GetExecPath project
# prj_path` = PR_GetRootDir project
# execpath = fulPath app_path prj_path` execpath
......@@ -1461,7 +1468,12 @@ GenCodeTheProjectModule :: !Bool !Bool !CodeGenerateAsmOrCode !ModuleDirAndName
GenCodeTheProjectModule outofdate sys genAsmOrCode mdn abc_path abccache fileinfo project ps
# module_name = mdn.mdn_name
# (proc,ps) = getCurrentProc ps
# cgo = PR_GetCodeGenOptions project
# ((info,abccache,fileinfo), ps) = FI_GetFileInfo proc mdn abccache fileinfo ps
# (ok,ps) = if cgo.optimise_abc (OptimiseABC mdn abc_path ps) (True,ps)
| not ok = (ps, abccache, fileinfo, project, ok, info.objpath)
# (ok,ps) = if cgo.generate_bytecode (ByteCodeGen cgo.optimise_abc mdn abc_path ps) (True,ps)
| not ok = (ps, abccache, fileinfo, project, ok, info.objpath)
| not outofdate
= (ps,abccache,fileinfo,project,True,info.objpath)
# ps = showInfo (Level2 ("Generating code for '" +++ module_name +++ "'.")) ps
......@@ -1472,7 +1484,6 @@ GenCodeTheProjectModule outofdate sys genAsmOrCode mdn abc_path abccache fileinf
ao = PR_GetApplicationOptions project
timeprofile = ao.profiling && (not neverTimeProfile)
obj_path = ModuleDirAndNameToObjSystemPathname proc mdn
cgo = PR_GetCodeGenOptions project
# (obj_path,res,compiler_process_ids,ps) = CodeGen cgen use_compiler_process_ids updateErrorWindow genAsmOrCode abc_path obj_path timeprofile cgo proc ao startupdir compiler_process_ids ps
# ps = setCompilerProcessIds compiler_process_ids ps
| genAsmOrCode == CodeGeneration && res
......@@ -1652,3 +1663,72 @@ where
# (startupdir,ps) = getStup ps
# (_,ps) = ClearCompilerCache ccstring startupdir ps
-> ps
//-- Bytecode generation and linking
OptimiseABC :: !ModuleDirAndName !Pathname !*GeneralSt -> *(!Bool, !*GeneralSt)
OptimiseABC mdn abc_path ps
# (startupdir,ps) = getStup ps
(abcopt,ps) = getCurrentAbcOpt ps
abcopt = startupdir +++ DirSeparatorString +++ abcopt
# abcopt_path = abc_path % (0,size abc_path-4) +++ "opt.abc"
# ps = showInfo (Level2 ("Optimising ABC for '" +++ mdn.mdn_name +++ "'.")) 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
# (startupdir,ps) = getStup ps
(bcgen,ps) = getCurrentBCgen ps
bcgen = startupdir +++ DirSeparatorString +++ bcgen
# abcopt_path = abc_path % (0,size abc_path-4) +++ "opt.abc"
bc_path = abc_path % (0,size abc_path-4) +++ "bc"
# ps = showInfo (Level2 ("Generating bytecode for '" +++ mdn.mdn_name +++ "'.")) 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
# (startupdir,ps) = getStup ps
(bclink,ps) = getCurrentBClink ps
bclink = startupdir +++ DirSeparatorString +++ bclink
# bcpath = fulPath startupdir (PR_GetRootDir project) (PR_GetByteCodePath project)
(abcpaths,fileinfo) = FI_GetAbcFiles fileinfo
abcpaths = [p % (0,size p-4) +++ "bc" \\ p <|- abcpaths]
# (root_mdn,project) = PR_GetRootModuleDirAndName project
root = ModuleDirAndNameToABCSystemPathname root_mdn
root = root % (0,size root-4) +++ "bc"
abcpaths = [root:removeMember root abcpaths]
# ps = showInfo (Level2 ("Linking bytecode for '" +++ RemovePath bcpath +++ "'")) 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
# (startupdir,ps) = getStup ps
(bcstrip,ps) = getCurrentBCstrip ps
bcstrip = startupdir +++ DirSeparatorString +++ bcstrip
# bcpath = fulPath startupdir (PR_GetRootDir project) (PR_GetByteCodePath project)
# ps = showInfo (Level2 ("Stripping bytecode for '" +++ RemovePath bcpath +++ "'")) 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)
......@@ -14,6 +14,10 @@ EnvsFileName :== "IDEEnvs"
, target_stat :: !List String // static libraries
, target_comp :: !String // compiler
, target_cgen :: !String // code generator
, target_abcopt :: !String // abc optimiser
, target_bcgen :: !String // bytecode generator
, target_bclink :: !String // bytecode linker
, target_bcstrip :: !String // bytecode stripper
, target_link :: !String // static/eager linker
, target_dynl :: !String // dynamic linker
, target_vers :: !Int // abc version
......
......@@ -27,6 +27,10 @@ t_StdEnv
, target_stat :: !List String // static libraries
, target_comp :: !String // compiler
, target_cgen :: !String // code generator
, target_abcopt :: !String // abc optimiser
, target_bcgen :: !String // bytecode generator
, target_bclink :: !String // bytecode linker
, target_bcstrip :: !String // bytecode stripper
, target_link :: !String // static/eager linker
, target_dynl :: !String // dynamic linker
, target_vers :: !Int // abc version
......@@ -129,6 +133,10 @@ emptyTarget =
, target_stat = Nil
, target_comp = ""
, target_cgen = ""
, target_abcopt = ""
, target_bcgen = ""
, target_bclink = ""
, target_bcstrip = ""
, target_link = ""
, target_dynl = ""
, target_vers = 42
......@@ -159,6 +167,10 @@ TargetTable =
, ListOption "EnvironmentStaticLibs" (PathOption) "" (\a-> a.target_stat) (\v a->{a & target_stat= v})
, SimpleOption "EnvironmentCompiler" (\a->a.target_comp) (\v a->{a & target_comp=v})
, SimpleOption "EnvironmentCodeGen" (\a->a.target_cgen) (\v a->{a & target_cgen=v})
, SimpleOption "EnvironmentABCOptimise" (\a->a.target_abcopt) (\v a->{a & target_abcopt=v})
, SimpleOption "EnvironmentByteCodeGen" (\a->a.target_bcgen) (\v a->{a & target_bcgen=v})
, SimpleOption "EnvironmentByteCodeLink" (\a->a.target_bclink) (\v a->{a & target_bclink=v})
, SimpleOption "EnvironmentByteCodeStrip" (\a->a.target_bcstrip) (\v a->{a & target_bcstrip=v})
, SimpleOption "EnvironmentLinker" (\a->a.target_link) (\v a->{a & target_link=v})
, SimpleOption "EnvironmentDynLink" (\a->a.target_dynl) (\v a->{a & target_dynl=v})
, SimpleOption "EnvironmentVersion" (\a->toString a.target_vers) (\v a->{a & target_vers=toInt v})
......@@ -196,6 +208,10 @@ t_StdEnv20
, target_stat = Nil
, target_comp = compiler_and_linker_directory+++DirSeparatorString+++IF_WINDOWS "CleanCompiler.exe" "cocl"
, target_cgen = compiler_and_linker_directory+++DirSeparatorString+++IF_WINDOWS "CodeGenerator.exe" "cg"
, target_abcopt = compiler_and_linker_directory+++DirSeparatorString+++IF_WINDOWS "ABCOptimiser.exe" "abcopt"
, target_bcgen = compiler_and_linker_directory+++DirSeparatorString+++IF_WINDOWS "ByteCodeGenerator.exe" "bcgen"
, target_bclink = compiler_and_linker_directory+++DirSeparatorString+++IF_WINDOWS "ByteCodeLinker.exe" "bclink"
, target_bcstrip = compiler_and_linker_directory+++DirSeparatorString+++IF_WINDOWS "ByteCodeStripper.exe" "bcstrip"
, target_link = IF_MACOSX "/usr/bin/gcc" (compiler_and_linker_directory+++DirSeparatorString+++IF_WINDOWS "StaticLinker.exe" "linker")
, target_dynl = "Tools"+++DirSeparatorString+++"Dynamics"+++DirSeparatorString+++"DynamicLinker.exe"
, target_vers = 920
......@@ -234,4 +250,4 @@ where
libs` = symAppPaths stup libs
objs` = symAppPaths stup objs
stat` = symAppPaths stup stat
\ No newline at end of file
......@@ -25,6 +25,7 @@ FI_GetFileInfo :: !Processor !ModuleDirAndName !ABCCache !FileInfoCache !*env -
FI_UpdateAbcDate :: !Modulename !Pathname !Bool !FileInfoCache !*Files -> ((!DATE,!FileInfoCache), !*Files)
FI_UpdateObjDate :: !Modulename !Pathname !FileInfoCache !*Files -> (!FileInfoCache, !*Files)
FI_UpdateFileInfo :: !Modulename !(FileInfo -> FileInfo) !FileInfoCache -> FileInfoCache
FI_GetAbcFiles :: !FileInfoCache -> (!List Pathname, !FileInfoCache)
FI_GetCleanModules :: !Pathname !StaticLibInfo !FileInfoCache -> (!List Pathname, !FileInfoCache)
YoungestObj :: !DATE !FileInfoCache -> DATE
......@@ -88,6 +88,11 @@ FI_UpdateObjDate module_name objPath fileInfo files
fileInfo = FI_UpdateFileInfo module_name update fileInfo
= (fileInfo,files)
FI_GetAbcFiles :: !FileInfoCache -> (!List Pathname, !FileInfoCache)
FI_GetAbcFiles fileinfo
# abcpaths = Map (\{abcpath}->abcpath) fileinfo
= (abcpaths,fileinfo)
FI_GetCleanModules :: !Pathname !StaticLibInfo !FileInfoCache -> (!List Pathname, !FileInfoCache)
FI_GetCleanModules system_obj_path libsinfo fileinfo
# clmodpaths = Map (\{objpath}->objpath) fileinfo
......
......@@ -28,6 +28,7 @@ ProjectFileVersion :== "1.4"
, pg_staticLibInfo :: StaticLibInfo
, pg_target :: String // specify used environment
, pg_execpath :: String // move to ApplicationOptions
, pg_bytecode_path :: String
, pg_dynamic :: !ProjectDynamicInfo
, pg_root_directory :: !String
, pg_precompile :: !Maybe String // experiment: move to LinkOptions
......
......@@ -20,6 +20,7 @@ ProjectFileVersion :== "1.4"
, pg_staticLibInfo :: StaticLibInfo
, pg_target :: String
, pg_execpath :: String
, pg_bytecode_path :: String
, pg_dynamic :: !ProjectDynamicInfo
, pg_root_directory :: !String
, pg_precompile :: !Maybe String
......@@ -104,6 +105,7 @@ ProjectGlobalOptionsTable =
{ project_root_option
, target_option
, SimpleWithStringConversionOption convert_exec_path_separators_and_extension "Exec" (\a->a.pg_execpath) (\v a->{a & pg_execpath=v})
, SimpleWithStringConversionOption convert_path_separators "ByteCode" (\a->a.pg_bytecode_path) (\v a->{a & pg_bytecode_path=v})
, code_gen_option
, application_option
, link_option
......@@ -296,10 +298,12 @@ CompilerOptionsTable =
CodeGenOptionsTable :: OptionsTable CodeGenOptions
CodeGenOptionsTable =
{
SimpleOption "CheckStacks" (\a->a.cs) (\v a->{a & cs=v}),
SimpleOption "CheckIndexes" (\a->a.ci) (\v a->{a & ci=v})
// SimpleOption "KeepABC" (\a->a.kaf) (\v a->{a & kaf=v}),
// SimpleOption "TargetProcessor" (\a->a.tp) (\v a->{a & tp=v})
SimpleOption "CheckStacks" (\a->a.cs) (\v a->{a & cs=v}),
SimpleOption "CheckIndexes" (\a->a.ci) (\v a->{a & ci=v}),
// SimpleOption "KeepABC" (\a->a.kaf) (\v a->{a & kaf=v}),
// SimpleOption "TargetProcessor" (\a->a.tp) (\v a->{a & tp=v})
SimpleOption "OptimiseABC" (\a->a.optimise_abc) (\v a->{a & optimise_abc=v}),
SimpleOption "GenerateByteCode" (\a->a.generate_bytecode) (\v a->{a & generate_bytecode=v})
}
instance fromString Int
......@@ -382,6 +386,7 @@ LinkOptionsTable =
, SimpleOption "GenerateDLL" (\a->a.generate_dll) (\v a->{a & generate_dll = v})
, SimpleOption "ExportedNames" (\a->a.dll_export_list_name) (\v a->{a & dll_export_list_name = v})
// , SimpleOption "AddCarbResource" (\a->a.add_carb_resource) (\v a->{a & add_carb_resource = v})
, SimpleOption "StripByteCode" (\a->a.strip_bytecode) (\v a->{a & strip_bytecode=v})
}
EditWdOptionsTable :: OptionsTable EditWdOptions
......
......@@ -107,6 +107,9 @@ PR_SetTarget :: !String !Project -> Project
PR_GetExecPath :: !Project -> String
PR_SetExecPath :: !String !Project -> Project
PR_GetByteCodePath :: !Project -> String
PR_SetByteCodePath :: !String !Project -> Project
SL_Add :: !String !StaticLibInfo -> StaticLibInfo
SL_Rem :: ![String] !String !String !StaticLibInfo -> StaticLibInfo
SL_Libs :: !StaticLibInfo -> List String
......
......@@ -41,6 +41,7 @@ Unmodified :== False;
, relative_root_directory :: !String // string of '.'s, relative to .prj file
, root_directory :: !String
, execpath :: !String // move to app_opts
, bytecode_path :: !String
, prec :: !Maybe String // " (precompile command)
, posl :: !Maybe String // " (postlink command)
}
......@@ -76,6 +77,7 @@ PR_InitProject =
, root_directory = ""
, prec = Nothing
, posl = Nothing
, bytecode_path = EmptyPathname
}
PR_GetExecPath :: !Project -> String
......@@ -84,6 +86,12 @@ PR_GetExecPath {execpath} = execpath
PR_SetExecPath :: !String !Project -> Project
PR_SetExecPath pth prj = {prj & execpath = pth}
PR_GetByteCodePath :: !Project -> String
PR_GetByteCodePath {bytecode_path} = bytecode_path
PR_SetByteCodePath :: !String !Project -> Project
PR_SetByteCodePath pth prj = {prj & bytecode_path=pth}
DefStaticLibInfo =
{ sLibs = Nil
, sDcls = Nil
......@@ -589,7 +597,7 @@ SetProject applicationDir project_file_dir
{ pg_codegen, pg_application
, pg_projectPaths, pg_link, pg_mainModuleInfo={name, info}, pg_otherModules
, pg_target, pg_staticLibInfo, pg_execpath, pg_dynamic
, pg_root_directory, pg_precompile, pg_postlink
, pg_root_directory, pg_precompile, pg_postlink, pg_bytecode_path
}
# project_dir = make_project_dir (size pg_root_directory) project_file_dir
# paths = ExpandPaths applicationDir project_dir pg_projectPaths
......@@ -600,13 +608,14 @@ SetProject applicationDir project_file_dir
# project = PR_SetStaticLibsInfo staticLibInfo project
# project = PR_SetTarget pg_target project
# exepath = ExpandPath applicationDir project_dir pg_execpath
# bytecode_path = if (pg_bytecode_path=="") "" (ExpandPath applicationDir project_dir pg_bytecode_path)
# project = PR_SetExecPath exepath project
// default of used appopts in exe are ok isn't right :-(
# pg_postlink = case pg_postlink of
Just post_link -> Just (ExpandPath applicationDir project_dir post_link)
Nothing -> Nothing
= {project & relative_root_directory = pg_root_directory, root_directory = project_dir, dynamic_info = pg_dynamic,
prec = pg_precompile, posl = pg_postlink}
prec = pg_precompile, posl = pg_postlink, bytecode_path = bytecode_path}
where
addModules Nil project_dir project
= project
......@@ -636,6 +645,7 @@ GetProject applicationDir project
, pg_staticLibInfo = staticLibInfo
, pg_target = target
, pg_execpath = exepath project_dir
, pg_bytecode_path = bytecodepath project_dir
, pg_dynamic = project.dynamic_info
, pg_root_directory = project.relative_root_directory
, pg_precompile = project.prec
......@@ -645,6 +655,9 @@ where
exepath project_dir
# xp = PR_GetExecPath project
= symPath applicationDir project_dir xp
bytecodepath project_dir
# bcp = PR_GetByteCodePath project
= if (bcp=="") "" (symPath applicationDir project_dir bcp)
getModule project_dir name
# info = PR_GetModuleInfo name project
......
......@@ -38,6 +38,8 @@ instance fromString Processor
, dll_export_list_name :: !String
// , add_carb_resource :: !Bool // Mac-only!
, strip_bytecode :: !Bool // strip ABC bytecode
}
DefaultLinkOptions :: LinkOptions
......@@ -95,10 +97,12 @@ instance == EditOptions
// The Code Generator Options: default settings for the code generator
:: CodeGenOptions =
{ cs :: !Bool // generate stack checks
, ci :: !Bool // generate index checks
// , kaf :: !Bool // keep abc-files
// , tp :: !Processor
{ cs :: !Bool // generate stack checks
, ci :: !Bool // generate index checks
// , kaf :: !Bool // keep abc-files
// , tp :: !Processor
, optimise_abc :: !Bool // optimise ABC
, generate_bytecode :: !Bool // generate ABC bytecode
}
instance == CodeGenOptions
......
......@@ -139,6 +139,8 @@ where
, dll_export_list_name :: !String
// , add_carb_resource :: !Bool // Mac-only!
, strip_bytecode :: !Bool // strip ABC bytecode
}
/*
instance == LinkOptions // do we need to check resource linking flags???
......@@ -169,6 +171,7 @@ DefaultLinkOptions =
, generate_dll = False
, dll_export_list_name = ""
// , add_carb_resource = False // Clean2 ide targets Carbon?!
, strip_bytecode = False
}
:: LinkMethod
......@@ -278,11 +281,13 @@ where
// edit options, window pos&size
// The Code Generator Options: default settings for the code generator
:: CodeGenOptions =
{ cs :: !Bool
, ci :: !Bool
// , kaf :: !Bool
// , tp :: !Processor
:: CodeGenOptions =
{ cs :: !Bool
, ci :: !Bool
// , kaf :: !Bool
// , tp :: !Processor
, optimise_abc :: !Bool
, generate_bytecode :: !Bool
}
instance == CodeGenOptions
......@@ -290,12 +295,15 @@ where
(==) :: !CodeGenOptions !CodeGenOptions -> Bool
(==) cg1 cg2