Merge branch 'abc-interpreter-improvements' into 'master'

Abc interpreter improvements

See merge request !16

Pm/PmDriver.icl

@@ -117,6 +117,8 @@ GenAsmProjectModule imp_pathname project setproject ps
 	| DComp !Bool !*DirCache !DriverCompilingInfo ![!ModuleDirAndName] !DriverStateRecord
 	| DQuitCompilers ![!ModuleDirAndName] !DriverCompilingInfo !DriverStateRecord
 	| DGene ![!ModuleDirAndName] !DriverCodeGenerationInfo !DriverStateRecord
+	| DOptimiseABC ![!ModuleDirAndName] !DriverStateRecord
+	| DGenerateByteCode !Int ![!ModuleDirAndName] !DriverStateRecord
 	| DLink !DriverStateRecord
 	| DDone
 
@@ -550,27 +552,29 @@ step intr state=:(DQuitCompilers modpaths (AsyncWin current async_win_compiling_
 			-> cont (state, ps)	// -> doesn't occur on win
 
 step intr (DGene [!] SyncCodeGeneration ds) ps
-	#! ps	= showInfo (Level1 "Linking...") ps
-	= step intr (DLink ds) ps
+	# (paths,ds) = ds!modpaths
+	= step intr (DOptimiseABC paths ds) ps
 
 step intr (DGene [!] (ASyncCodeGeneration [] {unknown_finished_processors=NoUnknownFinishedProcessors,compiler_process_ids}) ds) ps
 	# ps = setCompilerProcessIds compiler_process_ids ps
-	#! ps	= showInfo (Level1 "Linking...") ps
-	= step intr (DLink ds) ps
+	# (paths,ds) = ds!modpaths
+	= step intr (DOptimiseABC paths ds) ps
 
 step intr (DGene [!] (ASyncCodeGenerationWin [] _) ds) ps
-	#! ps	= showInfo (Level1 "Linking...") ps
-	= step intr (DLink ds) ps
+	# (paths,ds) = ds!modpaths
+	= step intr (DOptimiseABC paths ds) ps
 
 step intr (DGene [!mdn:rest] SyncCodeGeneration ds) ps
 	| not ds.ok || intr
 		# ds = {ds & ok = False}
-		= step intr (DLink ds) ps
+		# (paths,ds) = ds!modpaths
+		= step intr (DOptimiseABC paths ds) ps
 	# (abccache,fileinfo,gen,abcpath,ps)	= check_object_file_out_of_date mdn False ds.abccache ds.fileinfo ds.project ps
 	# (ps,abccache,fileinfo,project,ok,_)	= GenCodeTheProjectModule gen False CodeGeneration mdn abcpath abccache fileinfo ds.project ps
 	# ds = {ds & abccache = abccache, fileinfo = fileinfo, project = project, ok = ok}
 	| not ok
-		= step intr (DLink ds) ps
+		# (paths,ds) = ds!modpaths
+		= step intr (DOptimiseABC paths ds) ps
 	= cont (DGene rest SyncCodeGeneration ds, ps)
 
 step intr (DGene paths (ASyncCodeGeneration busy_processes {max_n_processes,compiler_process_ids,unknown_finished_processors}) ds) ps
@@ -748,6 +752,51 @@ step intr (DGene paths (ASyncCodeGenerationWin busy_processes win_max_n_processe
 	# ds = {ds & fileinfo = fileinfo, abccache = abccache, ok = ok}
 	= cont (DGene paths (ASyncCodeGenerationWin busy_processes win_max_n_processes) ds, ps)
 
+step intr (DOptimiseABC [!mdn:rest] ds) ps
+	# cgo = PR_GetCodeGenOptions ds.project
+	| not cgo.optimise_abc
+		# (paths,ds) = ds!modpaths
+		= step intr (DGenerateByteCode -1 paths ds) ps
+	# (tp,ps) = getCurrentProc ps
+	# ((modinfo,abccache,fileinfo),ps) = FI_GetFileInfo tp mdn ds.abccache ds.fileinfo ps
+	# (ok,ps) = OptimiseABC mdn modinfo.abcpath modinfo.abcdate ps
+	# ds & abccache=abccache, fileinfo=fileinfo, ok=ok
+	= cont (DOptimiseABC rest ds, ps)
+step intr (DOptimiseABC [!] ds) ps
+	# (paths,ds) = ds!modpaths
+	= step intr (DGenerateByteCode -1 paths ds) ps
+
+step intr (DGenerateByteCode -1 paths ds) ps
+	# cgo = PR_GetCodeGenOptions ds.project
+	| not cgo.generate_bytecode
+		# ps = showInfo (Level1 "Linking...") ps
+		= step intr (DLink ds) ps
+	# (startupdir,ps) = getStup ps
+	  (bcgen,ps) = getCurrentBCgen ps
+	  bcgen = startupdir +++ DirSeparatorString +++ bcgen
+	# (exitcode,err,ps) = RunExternalCommand bcgen ["-V"] startupdir ps
+	# ok = exitcode == 0
+	# (ok,version) = case err of
+		[v] -> case toInt v of
+			0 -> (False,0)
+			v -> (ok,v)
+		_ -> (False,0)
+	# ps = if ok ps (updateErrorWindow ["Failed to get bytecode instruction set version"] ps)
+	| not ok
+		# ps = showInfo (Level1 "Linking...") ps
+		= step intr (DLink ds) ps
+	= step intr (DGenerateByteCode version paths ds) ps
+step intr (DGenerateByteCode version [!mdn:rest] ds) ps
+	# cgo = PR_GetCodeGenOptions ds.project
+	# (tp,ps) = getCurrentProc ps
+	# ((modinfo,abccache,fileinfo),ps) = FI_GetFileInfo tp mdn ds.abccache ds.fileinfo ps
+	# (ok,ps) = ByteCodeGen version cgo.optimise_abc mdn modinfo.abcpath ps
+	# ds & abccache=abccache, fileinfo=fileinfo, ok=ok
+	= cont (DGenerateByteCode version rest ds,ps)
+step intr (DGenerateByteCode _ [!] ds) ps
+	#! ps = showInfo (Level1 "Linking...") ps
+	= step intr (DLink ds) ps
+
 step intr (DLink ds=:{ok, newpaths, fileinfo, libsinfo, modpaths, abccache, project, continue}) ps
 	//	Check whether executable is out of date and relink it	if required.
 	| intr || not ok
@@ -1474,10 +1523,6 @@ GenCodeTheProjectModule outofdate sys genAsmOrCode mdn abc_path abccache fileinf
 	# (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 info.abcdate 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
@@ -1691,8 +1736,8 @@ OptimiseABC mdn abc_path abc_date ps
 	# ps = updateErrorWindow err ps
 	= (exitcode == 0, ps)
 
-ByteCodeGen :: !Bool !ModuleDirAndName !Pathname !*GeneralSt -> *(!Bool, !*GeneralSt)
-ByteCodeGen use_optimised_abc mdn abc_path ps
+ByteCodeGen :: !Int !Bool !ModuleDirAndName !Pathname !*GeneralSt -> *(!Bool, !*GeneralSt)
+ByteCodeGen bcgen_version use_optimised_abc mdn abc_path ps
 	# (startupdir,ps) = getStup ps
 	  (bcgen,ps) = getCurrentBCgen ps
 	  bcgen = startupdir +++ DirSeparatorString +++ bcgen
@@ -1701,8 +1746,9 @@ ByteCodeGen use_optimised_abc mdn abc_path ps
 
 	# (abc_date,ps) = accFiles (FModified abc_path) ps
 	  (bc_date,ps) = accFiles (FModified bc_path) ps
-	| bc_date.exists && Older_Date abc_date bc_date
-		= (True, ps)
+
+	# (must_run,ps) = requires_codegen bc_path abc_date bc_date ps
+	| not must_run = (True,ps)
 
 	# ps = showInfo (Level2 ("Generating bytecode for '" +++ mdn.mdn_name +++ "'.")) ps
 	# (exitcode,err,ps) = RunExternalCommand bcgen [abc_path,"-o",bc_path] startupdir ps
@@ -1711,6 +1757,19 @@ ByteCodeGen use_optimised_abc mdn abc_path ps
 		(err ++ ["Bytecode generator failed for " +++ mdn.mdn_name +++ " (exit code: " +++ toString exitcode +++ ")"])
 	# ps = updateErrorWindow err ps
 	= (exitcode == 0, ps)
+where
+	requires_codegen bc_path abc_date bc_date ps
+	| not bc_date.exists = (True,ps)
+	| not (Older_Date abc_date bc_date) = (True,ps)
+	# ((ok,bytecode),ps) = accFiles (\fs -> let (ok,f,fs`) = fopen bc_path FReadData fs in ((ok,f),fs`)) ps
+	| not ok = (True,ps)
+	# (ok,bytecode) = fseek bytecode 8 FSeekSet
+	| not ok = (True,ps)
+	# (ok,version,bytecode) = freadi bytecode
+	| not ok = (True,ps)
+	# (ok,ps) = accFiles (fclose bytecode) ps
+	| not ok = abort "fclose failed during ByteCodeGen\n"
+	= (version <> bcgen_version,ps)
 
 ByteCodeLink :: !FileInfoCache !Project !*GeneralSt -> *(!Bool, !*GeneralSt)
 ByteCodeLink fileinfo project ps