Add bytecode support to IDE

BatchBuild/IdeState.dcl

@@ -20,6 +20,8 @@ from PmCleanSystem import ::CompilerProcessIds,NoCompilerProcessIds
 
 app_world_instead_of_ps f gst :== {gst & gst_world=f gst.gst_world}
 
+acc_world_instead_of_ps f gst :== (x,{gst & gst_world=w}) where (x,w) = f gst.gst_world
+
 instance FileSystem GeneralSt
 instance FileEnv GeneralSt
 

Ide/IdeState.dcl

@@ -23,6 +23,14 @@ where
 		# w = f w
 		= ioStSetWorld w io
 
+acc_world_instead_of_ps f ps
+	:== accPIO acc_world_instead_of_io ps
+where
+	acc_world_instead_of_io io
+		# (w,io) = ioStGetWorld io
+		# (x,w) = f w
+		= (x,ioStSetWorld w io)
+
 :: *General
 
 instance Editor		General		// Editor

Ide/PmDialogues.icl

@@ -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" []

Pm/PmDriver.icl

@@ -20,7 +20,9 @@ import PmAbcMagic,PmFileInfo,PmDirCache
 import Platform
 from StdLibMisc import :: Date{..}, :: Time{..}
 
-import System.Process
+import Data.Error
+import System.FilePath
+from System.Process import :: ProcessHandle, runProcess, waitForProcess
 
 verboseInfo verbose info ps :== verbi verbose info ps
 where
@@ -815,7 +817,9 @@ 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)
 
-	# ps						= if (PR_GetByteCodePath project <> "") (ByteCodeLink fileinfo project ps) 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)
 
 	# execpath					= PR_GetExecPath project
 	# prj_path` = PR_GetRootDir project
@@ -1466,9 +1470,11 @@ GenCodeTheProjectModule outofdate sys genAsmOrCode mdn abc_path abccache fileinf
 	# module_name = mdn.mdn_name
 	# (proc,ps) = getCurrentProc ps
 	# cgo = PR_GetCodeGenOptions project
-	# ps = if cgo.optimise_abc (OptimiseABC mdn abc_path ps) ps
-	# ps = if cgo.generate_bytecode (ByteCodeGen cgo.optimise_abc mdn abc_path ps) ps
 	# ((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
@@ -1661,7 +1667,7 @@ where
 
 //-- Bytecode generation and linking
 
-OptimiseABC :: !ModuleDirAndName !Pathname !*GeneralSt -> *GeneralSt
+OptimiseABC :: !ModuleDirAndName !Pathname !*GeneralSt -> *(!Bool, !*GeneralSt)
 OptimiseABC mdn abc_path ps
 	# (startupdir,ps) = getStup ps
 	  (abcopt,ps) = getCurrentAbcOpt ps
@@ -1669,15 +1675,14 @@ 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,w) = runProcess abcopt [abc_path,"-o",abcopt_path] Nothing ps.gst_world
-	| isError h = abort "failed to execute the ABC optimiser\n"
-	# (r,w) = waitForProcess (fromOk h) w
-	| isError r = abort "failed to wait for the ABC optimiser\n"
-	| fromOk r <> 0 = abort ("ABC optimiser failed with non-zero exit code " +++ toString (fromOk r) +++ "\n")
-	# ps & gst_world = w
-	= ps
-
-ByteCodeGen :: !Bool !ModuleDirAndName !Pathname !*GeneralSt -> *GeneralSt
+	# (h,ps) = acc_world_instead_of_ps (runProcess abcopt [abc_path,"-o",abcopt_path] Nothing) ps
+	| isError h = (False, updateErrorWindow ["failed to execute the ABC optimiser"] ps)
+	# (r,ps) = acc_world_instead_of_ps (waitForProcess (fromOk h)) ps
+	| isError r = (False, updateErrorWindow ["failed to wait for the ABC optimiser"] 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 use_optimised_abc mdn abc_path ps
 	# (startupdir,ps) = getStup ps
 	  (bcgen,ps) = getCurrentBCgen ps
@@ -1686,16 +1691,14 @@ 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,w) = runProcess bcgen [if use_optimised_abc abcopt_path abc_path,"-o",bc_path] Nothing ps.gst_world
-	| isError h = abort "failed to execute the bytecode generator\n"
-	# (r,w) = waitForProcess (fromOk h) w
-	| isError r = abort "failed to wait for the bytecode generator\n"
-	| fromOk r <> 0 = abort ("bytecode generator failed with non-zero exit code " +++ toString (fromOk r) +++ "\n")
-
-	# ps & gst_world = w
-	= ps
-
-ByteCodeLink :: !FileInfoCache !Project !*GeneralSt -> *GeneralSt
+	# (h,ps) = acc_world_instead_of_ps (runProcess bcgen [if use_optimised_abc abcopt_path abc_path,"-o",bc_path] Nothing) ps
+	| isError h = (False, updateErrorWindow ["failed to execute the bytecode generator"] ps)
+	# (r,ps) = acc_world_instead_of_ps (waitForProcess (fromOk h)) ps
+	| isError r = (False, updateErrorWindow ["failed to wait for the bytecode generator"] 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 fileinfo project ps
 	# (startupdir,ps) = getStup ps
 	  (bclink,ps) = getCurrentBClink ps
@@ -1709,11 +1712,9 @@ ByteCodeLink fileinfo project ps
 	  abcpaths = [root:removeMember root abcpaths]
 
 	# ps = showInfo (Level2 ("Linking bytecode for '" +++ RemovePath bcpath +++ "'")) ps
-	# (h,w) = runProcess bclink (abcpaths ++ ["-o",bcpath]) Nothing ps.gst_world
-	| isError h = abort "failed to execute the bytecode linker\n"
-	# (r,w) = waitForProcess (fromOk h) w
-	| isError r = abort "failed to wait for the bytecode linker\n"
-	| fromOk r <> 0 = abort ("bytecode linker failed with non-zero exit code " +++ toString (fromOk r) +++ "\n")
-	# ps & gst_world = w
-
-	= ps
+	# (h,ps) = acc_world_instead_of_ps (runProcess bclink (abcpaths ++ ["-o",bcpath]) Nothing) ps
+	| isError h = (False, updateErrorWindow ["failed to execute the bytecode linker"] ps)
+	# (r,ps) = acc_world_instead_of_ps (waitForProcess (fromOk h)) ps
+	| isError r = (False, updateErrorWindow ["failed to wait for the bytecode linker"] ps)
+	| fromOk r <> 0 = (False, updateErrorWindow ["bytecode linker failed with non-zero exit code " +++ toString (fromOk r)] ps)
+	= (True, ps)

Pm/PmProject.dcl

@@ -108,6 +108,7 @@ 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

Pm/PmProject.icl

@@ -89,6 +89,9 @@ 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