implementation module EdCleanSystem;

/* OS dependent module for unix */

/* Interface module for calling the CLEAN compiler, code generator and linker */

import StdClass,StdArray,StdBool,StdInt,StdList,StdEnum,StdMisc;
import EdText, EdProgramState, EdPath, EdSupport, EdDialogs, EdParse, EdTextWindow, EdDrawWindow;
import deltaDialog, deltaIOSystem, deltaWindow, deltaIOState, StdString, StdChar, EdMyIO, EdFiles;

from EdFileMenu import Quit;
from EdFileMenu import OpenFile;
from EdProjectMenu import OpenFileOrProjectFile;

import elf_linker,pointer;

/*  Macros used to select platform specific code.
    Make sure only one of these macros is True.
*/
IfMacintoshSystem m o :== o;
IfMsWindowsSystem w o :== o;
IfUnixSystem u o :== u;

from UtilNewlinesFile import
	:: NewlineConvention (
	NewlineConventionNone,
	NewlineConventionMac, NewlineConventionUnix, NewlineConventionDos);
HostNativeNewlineConvention
	:== NewlineConventionUnix;

/* Interface module for calling the CLEAN compiler, code generator and linker */

::	CompilerMsg
	= 	CompilerOK
	| 	SyntaxError
	| 	Patherror Pathname;
	
::	VerboseFun :== String -> ProgState -> * (IO -> ProgIO);
	
::	WindowFun :== Text -> ProgState -> * (IO -> ProgIO);

ClearCompilerCache :: !IO -> (!Int,!IO);
ClearCompilerCache io
	= (0,io);

import cachingcompiler;

compile_with_cache :: {#.Char} {#.Char} {#.Char} *ProgState -> (!Bool,!Int,!*ProgState);
compile_with_cache path directory arguments prog=:{editor={compiling_info=CompilingInfo call_back NoCompiler}}
	# thread=0;
	# (r,thread) = start_caching_compiler (path+++"\0") thread;
	| r<0
		= abort "compile_with_cache 1";
	# (ok,s,thread) = compile_with_cache2 path directory arguments thread;
	| ok
		# prog = {prog & editor.compiling_info=CompilingInfo call_back (CompilerProcess 0 0 0)};
		= (ok,s,prog);
		= (ok,s,prog);

compile_with_cache path directory arguments prog=:{editor={compiling_info=CompilingInfo call_back (CompilerProcess thread _ _)}}
	# thread=0;
	# (ok,s,thread) = compile_with_cache2 path directory arguments thread;
	| ok
		= (ok,s,prog);
		= (ok,s,{prog & editor.compiling_info=CompilingInfo call_back NoCompiler});
compile_with_cache path directory arguments prog=:{editor={compiling_info=NotCompiling}}
	# thread=0;
	# (r,thread) = start_caching_compiler (path+++"\0") thread;
	| r<0
		= abort "compile_with_cache 2";
	# (ok,s,thread) = compile_with_cache2 path directory arguments thread;
	# (r,thread)=stop_caching_compiler thread;
	| r<0
		= abort "couldn't stop compiler\n";
		= (ok,s,prog);

compile_with_cache2 :: {#.Char} {#.Char} {#.Char} Thread -> (!Bool,!Int,!Thread);
compile_with_cache2 path directory arguments thread
	# (r,thread)=call_caching_compiler ("cocl " +++ arguments +++ "\0") thread;
	| r<0
		= (True,r,thread);
	= (True,r,thread);


Compile	::	!VerboseFun !WindowFun !WindowFun !CompileOrCheckSyntax !CompileClearCache !Pathname !(List Pathname) !Bool !Bool !CompilerOptions !ProgState !IO
			-> (!ProgIO, !Pathname, !CompilerMsg);
Compile verbfun errwin typewin compileOrCheckSyntax clearCache path paths projectMemoryProfiling projectProfiling
					co=:{CompilerOptions | listTypes} prog_=:{editor=editor=:{project,startupinfo={startupdir}}} io
	# cocl = startupdir+++toString DirSeparator +++"exe/cocl";
	# (compile_ok,exitcode,prog)=compile_with_cache cocl startupdir cocl_arguments prog_;
	| not compile_ok
  		= (errwin (Text_StringsToText (("Compilation of "+++RemovePath path+++" failed\n"):!Nil)) prog io,"",SyntaxError);
		= (prio2 prog,abcpath,if (exitcode==0) CompilerOK errors);

where
{	
	cocl		= quoted_string (startupdir+++toString DirSeparator +++"exe/cocl");
	cocl_arguments = MakeCompilerOptionsString compileOrCheckSyntax projectMemoryProfiling projectProfiling co
								+++ (quoted_string path)
	                            +++ " -P " +++ quoted_string (ConcatenatePath paths)
								+++ " -RE "+++ quoted_string errors_file_name
								+++ " -RO "+++ quoted_string out_file_name;

    command     = cocl +++ " " +++ cocl_arguments;
	/*(didit, exitcode, os4) = CallProcess command [] "" "" "" "" 99; */

	prio2 prog
		| type_text_not_empty
			= typewin type_text prog1 io1; { (prog1,io1) = prio1 prog; }
			= prio1 prog;

	prio1 prog
		| errors_and_messages_not_empty
			= errwin errors_and_messages prog io3;
			= (prog,io3);

	(abcpath,io3) = accFiles (MakeABCSystemPathname path) io2;
	((errors,errors_and_messages_not_empty,errors_and_messages),io2)
			= accFiles (ReadErrorsAndWarnings errors_file_name) io1;
	((type_text_not_empty,type_text),io1) = accFiles (ReadTypesInfo (listTypes<>NoTypes) out_file_name) io;

	out_file_name =  startupdir +++ toString DirSeparator +++ "out";
	errors_file_name =  startupdir +++ toString DirSeparator +++ "errors";

	ConcatenatePath :: (List Pathname) -> String;
	ConcatenatePath Nil             = "";
	ConcatenatePath (path :! rest ) = path +++ ":" +++ ConcatenatePath rest;
}
quoted_string string = "\"" +++ string +++ "\"";

CreateABCSystemPathname path files
	# (abc_path,files) = MakeABCSystemPathname path files;
	# directory = RemoveFilename abc_path;
	# (exists,files) = FExists directory files;
	| exists
		= (abc_path,files);
		| mkdir (directory+++"\0") 511==0
			= (abc_path,files);
			= (abc_path,files);

mkdir :: !String !Int -> Int;
mkdir string0 mask = code {
		ccall mkdir "sI:I"
	};

ReadFileAsText :: !Pathname !*Files -> ((!Bool, !Text), !*Files);
ReadFileAsText path disk
	# (opened,file,disk) = fopen path FReadText disk;
	| not opened
		= ((False,Nil),disk);
		# (errors_and_warnings_read,errlist,file`) = ReadLinesAsText file;
		# (_,disk) = fclose file` disk;
		= ((errors_and_warnings_read,Text_StringsToText errlist),disk);

ReadLinesAsText :: !*File -> (!Bool,!List String,!*File);
ReadLinesAsText file
	| eof
		= (not_empty_or_newline string,LastStrings string,file2);
		{
			not_empty_or_newline string = size string<>0 && string.[0]<>'\n';
		}
		# (_,errlist,file3) = ReadLinesAsText file2;
		= (True,string`:!errlist,file3);
	where {
		(string, file1)					= freadline file;
		(eof,file2)						= fend file1;
		string`							= ReplaceLastChar string;
	};

ReadErrorsAndWarnings :: !Pathname !*Files -> ((!CompilerMsg, !Bool, !Text), !*Files);
ReadErrorsAndWarnings path disk
	# (opened,file,disk1)	= fopen path FReadText disk;
	| not opened
		= ((SyntaxError,False,Nil),disk1);
		= ((errors,errors_and_warnings_read,Text_StringsToText errlist),disk2);
		{
			(errors,errors_and_warnings_read,errlist,file`) = ReadErrorAndWarningMessages file;
			(_,disk2) = fclose file` disk1;
		}

ReadErrorAndWarningMessages :: !*File -> (!CompilerMsg,!Bool,!List String,!*File);
ReadErrorAndWarningMessages file
	| eof
		= (if is_import_error (Patherror path) SyntaxError,not_empty_or_newline string,LastStrings string,file2);
		{
			not_empty_or_newline string = size string<>0 && string.[0]<>'\n';
		}
		# (path_error,_,errlist,file3) = ReadErrorAndWarningMessages file2;
		= (if is_import_error (Patherror path) path_error,True,string`:!errlist,file3);
	where {
		(string, file1)					= freadline file;
		(eof,file2)						= fend file1;
		string`							= ReplaceLastChar string;
		(is_import_error,path)			= IsImportError string;
	};


MakeCompilerOptionsString :: !CompileOrCheckSyntax !Bool !Bool !CompilerOptions -> String;
MakeCompilerOptionsString compileOrCheckSyntax projectMemoryProfiling projectProfile {neverMemoryProfile, neverTimeProfile,sa,gw,gc,listTypes,attr,reuseUniqueNodes}
	= options;
	where {
	memoryProfileSwitch	| not neverMemoryProfile && projectMemoryProfiling
											= " -desc";
//											= " -pm";
											= "";
	timeProfileSwitch	| not neverTimeProfile && projectProfile
											= " -pt";
											= "";
	strictness	| sa						= "";
											= " -sa";
	warnings	| gw						= "";
											= " -w";
	comments	| gc						= " -d";
											= "";
	listtypes	| listTypes == InferredTypes	= " -lt";
				| listTypes == AllTypes			= " -lat";
				| listTypes == StrictExportTypes= " -lset";
											= "";
	show_attr	| attr						= "";
											= " -lattr";
	checksyntax
		| compileOrCheckSyntax == SyntaxCheck
				= " -c";
		// otherwise
				= "";
	reuse		| reuseUniqueNodes			= " -ou";
											= "";

	options		= checksyntax +++ timeProfileSwitch +++ memoryProfileSwitch +++ strictness +++
						warnings +++ comments +++listtypes+++show_attr+++reuse+++" ";
	};

ReadTypesInfo :: !Bool !Pathname !*Files -> ((!Bool,!Text),!*Files);
ReadTypesInfo readtypes	path disk
	| not readtypes
		= ((False,Nil),disk);
	| not opened
		= ((False,Nil),disk1);
		= ((types_read,typetext),disk2);
	where {
		(opened,file,disk1)		= fopen path FReadText disk;
		(typelist,types_read,file`)	= ReadTypeMsg file;
		typetext            		= Text_StringsToText typelist;
		(_,disk2)					= fclose file` disk1;
	};

ReadTypeMsg :: !*File -> (!List String,!Bool,!*File);
ReadTypeMsg file
	| eof && IsTypeSpec string
		= (LastStrings string,True,file2);
	| eof
		= (Nil,False,file2);
		= (ReplaceLastChar string:!typeslist,types_read,file3);
		{
			(typeslist,types_read,file3)	= ReadTypeMsg file2;
		}
	where {
		(string,file1)					= freadline file;
		(eof,file2)						= fend file1;
	};
	
LastStrings	:: !String -> List String;
LastStrings "" = Nil;
LastStrings str
	# string_size=size str;
	| string_size>0 && '\n'==str.[dec string_size]
		=  str :! Nil;
		=  (str +++ NewlStr) :! Nil;

ReplaceLastChar	:: !String -> String;
ReplaceLastChar str
	| size str>0
		= str := (dec (size str), NewlStr.[0]);
		= str;

MakeCompilerOptionsList :: !CompileOrCheckSyntax !Bool !Bool !CompilerOptions ![String] -> [String];
MakeCompilerOptionsList compileOrCheckSyntax projectMemoryProfiling projectProfile {neverMemoryProfile, neverTimeProfile,sa,gw,gc,listTypes,attr,reuseUniqueNodes} t
	= options;
	where {
	memoryProfileSwitch	t | not neverMemoryProfile && projectMemoryProfiling
											= ["-pm":t];
											= t;
	timeProfileSwitch t | not neverTimeProfile && projectProfile
											= ["-pt":t];
											= t;
	strictness t	| sa					= t;
											= ["-sa":t];
	warnings t 	| gw						= t;
											= ["-w":t];
	comments t	| gc						= ["-d":t];
											= t;
	listtypes t
		| listTypes == InferredTypes		= ["-lt":t];
		| listTypes == AllTypes				= ["-lat":t];
		| listTypes == StrictExportTypes	= ["-lset":t];
											= t;

	show_attr t	| attr						= t;
											= ["-lattr":t];
	checksyntax t
		| compileOrCheckSyntax == SyntaxCheck
			= ["-c":t];
			= t;
	reuse t		| reuseUniqueNodes			= ["-ou":t];
											= t;

	options		= checksyntax (timeProfileSwitch (memoryProfileSwitch (strictness
						(warnings (comments (listtypes (show_attr (reuse t))))))));
	};

MakePathListString :: !(List Pathname) -> String;
MakePathListString Nil			= "";
MakePathListString (path:!rest)	= MakePathStringList2 path rest;
{
	MakePathStringList2 :: !String !(List String) -> String;
	MakePathStringList2 acc	Nil			= acc;
	MakePathStringList2 acc (path:!rest)= MakePathStringList2 (acc +++ ":" +++ path) rest;
}

CodeGen	::	!WindowFun !CodeGenerateAsmOrCode !Pathname !CodeGenOptions !ApplicationOptions !ProgState !IO
			-> (!ProgIO,!Pathname,!Bool);

CodeGen winfun genAsmOrCode path cgo ao prog io
	= // IF_SOLARIS (CodeGenAssemble winfun genAsmOrCode path cgo ao prog io)
	  (CodeGenObject winfun genAsmOrCode path cgo ao prog io);

CodeGenObject :: !WindowFun !CodeGenerateAsmOrCode !Pathname !CodeGenOptions !ApplicationOptions !ProgState !IO
			-> (!ProgIO,!Pathname,!Bool);
CodeGenObject winfun genAsmOrCode path cgo ao prog io
	# (clean_ide_path,io) = accFiles GetFullApplicationPath io;
	# (objpath,io) = accFiles (MakeObjSystemPathname cgo.tp path) io;
	# path_without_suffix = RemoveSuffix path;
	# assembly_file_name = path_without_suffix+++".s";
	# (error_code,error_n)
		= exec (clean_ide_path+++"/exe/cg") (MakeCodeGenOptionsString genAsmOrCode cgo 
											(if (genAsmOrCode==AsmGeneration) [path_without_suffix,"-s",assembly_file_name] [path_without_suffix]))
											True;
	# output_string="";
	| error_code<>0
		= (winfun (Text_StringsToText (("Cannot run code generator: "+++toString error_code+++"\n"):!Nil)) prog io,objpath,False);
	| size output_string<>0
		= (winfun (Text_StringsToText ((output_string+++"\n"):!Nil)) prog io,objpath,error_n==0);
		= ((prog,io),objpath,error_n==0);

CodeGenAssemble :: !WindowFun !CodeGenerateAsmOrCode !Pathname !CodeGenOptions !ApplicationOptions !ProgState !IO
			-> (!ProgIO,!Pathname,!Bool);
CodeGenAssemble winfun genAsmOrCode path cgo ao prog=:{editor={startupinfo={assembler_file_name}}} io
	# (clean_ide_path,io) = accFiles GetFullApplicationPath io;
	# (objpath,io) = accFiles (MakeObjSystemPathname cgo.tp path) io;
	# path_without_suffix = RemoveSuffix path;
	# assembly_file_name = path_without_suffix+++".s";
	# (error_code,error_n)
		= exec (clean_ide_path+++"/exe/cg") (MakeCodeGenOptionsString genAsmOrCode cgo 
											[path_without_suffix,"-s",assembly_file_name])
											True;
	# output_string="";
	| error_code<>0
		# io = remove_file assembly_file_name io;
		= (winfun (Text_StringsToText (("Cannot run code generator: "+++toString error_code+++"\n"):!Nil)) prog io,objpath,False);
	| genAsmOrCode==AsmGeneration
		= ((prog,io),objpath,error_n==0);
	# (as_error_code,as_error_n) = exec assembler_file_name [assembly_file_name,"-o",objpath] True;
	| as_error_code<>0 || as_error_n<>0
		# io = remove_file assembly_file_name io;
		= (winfun (Text_StringsToText (("Error while assembling: "+++assembly_file_name+++"\n"):!Nil)) prog io,objpath,False);
	# io = remove_file assembly_file_name io;
	| size output_string<>0
		= (winfun (Text_StringsToText ((output_string+++"\n"):!Nil)) prog io,objpath,error_n==0);
		= ((prog,io),objpath,error_n==0);
	where {
		remove_file assembly_file_name io
			# (_,io) = accFiles (FRemove assembly_file_name) io;
			= io;
	}

MakeCodeGenOptionsString :: !CodeGenerateAsmOrCode !CodeGenOptions ![String] -> [String];
MakeCodeGenOptionsString genAsmOrCode {ci,cs,tp} t
	= checkindex (checkstack t);
	where {
		checkindex t	| ci				= ["-ci":t];
											= t;
		checkstack t	| cs				= ["-os":t];
											= t;
	};

accFiles3 f io0
	:== let {
			((r1,r2,r3),io2) = accFiles (\ io0 -> let { (r1,r2,r3,io1) = f io0 } in ((r1,r2,r3),io1) ) io0;
		} in (r1,r2,r3,io2);

Link ::	!WindowFun !Pathname !Pathname !(List Pathname) !(List Pathname) !ApplicationOptions !Processor !LinkOptions !(List Pathname) !(List Pathname) !ProgState !IO -> (!ProgIO,!Bool);
Link winfun path u_system_file_name paths defs
		applicationOptions=:{ss,fs,fn,hs,em,heap_size_multiple,initial_heap_size,profiling,profiling601,memoryProfilingMinimumHeapSize}
		processor linkOptions 
		/* RWS FIXME: use abc... options */
		abcLinkObjFilePaths abcLinkLibraryPaths
		prog=:{editor={startupinfo={startupdir,linker_file_name,linker_begin_object_files,linker_libraries,linker_end_object_files},project}} io
	#	(u_startup_file_name,io1) = accFiles (MakeObjSystemPathname CurrentProcessor (MakeFullPathname system_directory_name startupModuleName)) io;
	#	(u_reals_file_name,io2) =
			IF_SOLARIS
				(accFiles (MakeObjSystemPathname CurrentProcessor (MakeFullPathname system_directory_name "_reals")) io1)
				("", io1);
	#	defaultObjects
			= if linkOptions.useDefaultSystemObjects
				((IF_SOLARIS
					[u_startup_file_name, u_reals_file_name, u_system_file_name]
					[u_startup_file_name, u_system_file_name]
				) ++
					[ MakeFullPathname system_directory_name file_name \\ file_name 
					<- ["cdialog.o","cfileselect.o","ckernel.o","cmenu.o","cpath.o","cpicture.o","ctimer.o","cwindow.o"]
				    ]
				)
				[];
	#	(linker_ok,ld_ok,linker_errors,io3) = accFiles3 (link defaultObjects) io2;
	| not linker_ok
		# linker_error_list = list_to_List linker_errors;
			with {
				list_to_List [] = Nil;
				list_to_List [s:l] = s+++"\n" :! list_to_List l;
			}
		= (winfun (Text_StringsToText linker_error_list) prog io3,ld_ok);
	#	((std_error_not_empty,std_error_text),io4) = accFiles (ReadFileAsText errors_file_name) io3;
	#	((std_out_not_empty,  std_out_text),io5) = accFiles (ReadFileAsText out_file_name) io4;
	| std_error_not_empty
		= (winfun std_error_text prog io5,ld_ok);
	| std_out_not_empty
		= (winfun std_out_text prog io5,ld_ok);
		= ((prog,io5),ld_ok);
	{}{
		out_file_name = startupdir +++ "/out";
		errors_file_name = startupdir +++ "/errors";

		link :: [String] *Files -> (!Bool,!Bool,![String],!*Files);
		link defaultObjects files
			# options_file_name = startupdir +++ "/_options.o";
			# flags = ApplicationOptionsToFlags applicationOptions;
			# option_file_contents = options_object_file_code flags hs ss heap_size_multiple initial_heap_size;
			# (ok,files) = write_array_to_file option_file_contents options_file_name files;
			| ok
				# objectFileNames = defaultObjects ++ [options_file_name : StrictListToList paths ++ (StrictListToList linkOptions.extraObjectModules)];
				# linker_tmp_object_file_name = startupdir +++ "/linker_tmp.o";
				# (ok,linker_errors,files) = link_elf_files objectFileNames linker_tmp_object_file_name files;
				| not ok
					= (False,False,linker_errors,files);
				# (error_code,error_n) = exec_with_redirect linker_file_name ["-s","-o",MakeExecPathname path :
					linker_begin_object_files++[linker_tmp_object_file_name]++libraryFileNames++linker_end_object_files] out_file_name errors_file_name;
//					linker_begin_object_files++objectFileNames++libraryFileNames++linker_end_object_files] out_file_name errors_file_name;
				| error_code==0 && error_n==0
					= (True,True,[],files);
					= (True,False,[],files);
				= (True,False,[],files);

		startupModuleName
			| not profiling
				=	"_startup";
			| profiling601
				=	"_startupProfile601";
				=	"_startupProfile";
	
		system_directory_name = RemoveFilename u_system_file_name;

//		libCleanxv_a_path = MakeFullPathname system_directory_name "libCleanxv.a";

		libraryFileNames
			=	defaultLibraries ++ (StrictListToList linkOptions.libraries);
		defaultLibraries
			| linkOptions.useDefaultLibraries
//				= [libCleanxv_a_path : linker_libraries]
				= linker_libraries;
				= [];
	};

ApplicationOptionsToFlags :: !ApplicationOptions -> Int;
ApplicationOptionsToFlags {sgc,pss,marking_collection,set,o,memoryProfiling,write_stderr_to_file}
	= flags;
	where
	{
		flags					= showgc+printstacksize+showexectime+cons+marking_collection_mask+memory_profiling_mask+write_stderr_to_file_mask;
		showgc					| sgc = 2; = 0;
		printstacksize			| pss = 4; = 0;
		showexectime 			| set = 8; = 0;
		write_stderr_to_file_mask
								| write_stderr_to_file = 128; = 0;
		marking_collection_mask | marking_collection = 64 ; = 0;
		memory_profiling_mask	| memoryProfiling = 32 ; = 0;
		cons					| o == BasicValuesOnly	= 1; | o == ShowConstructors = 0; = 16;
	};

FlagsToApplicationOptions :: !Int !ApplicationOptions -> ApplicationOptions;
FlagsToApplicationOptions flags applicationOptions
	=	{applicationOptions & sgc=showgc,pss=printstacksize,marking_collection=marking_collection,set=showexectime,
				o=output, memoryProfiling=memoryProfiling, write_stderr_to_file=write_stderr_to_file};
	where
	{
		showgc
			= (flags bitand 2) <> 0;
		printstacksize
			= (flags bitand 4) <> 0;
		showexectime
			= (flags bitand 8) <> 0;
		memoryProfiling
			= (flags bitand 32) <> 0;
		marking_collection
			= (flags bitand 64) <> 0;
		write_stderr_to_file
			= (flags bitand 128) <> 0;
		output
			| (flags bitand 16) <> 0
				= NoConsole;
			|  (flags bitand 1) <> 0
				= BasicValuesOnly;
			// otherwise
				= ShowConstructors;
	}

MakeLinkOptionsString :: !ApplicationOptions -> String;
MakeLinkOptionsString {ss,hs,em,sgc,pss,set,o,write_stderr_to_file}
	= stacksize +++ heapsize +++ extramemory +++ flags;
	where {
		stacksize						= " -s" +++ toString ss;
		heapsize						= " -h" +++ toString hs;
		extramemory						= " -a" +++ toString em;
		flags							= " -f" +++ toString (showgc + printstacksize + showexectime + cons
																	+ write_stderr_to_file_mask);
		showgc	| sgc					= 2;
										= 0;
		printstacksize	| pss			= 4;
										= 0;
		showexectime | set				= 8;
										= 0;
		cons	| o == BasicValuesOnly	= 1;
				| o == ShowConstructors	= 0;
										= 16;
		write_stderr_to_file_mask
				| write_stderr_to_file	= 128; = 0;

	};
	
ReadLinkInfo :: !Pathname !*Files -> ((!Bool, !Text), !*Files);
ReadLinkInfo path disk
	| opened	=  ((errors, errtext), disk`);
				=  ((False, EmptyText),disk1);
	where {
	(opened,file,disk1)		= fopen path FReadText disk;
	(errlist,errors,file`)	= ReadLinkMsg file;
	errtext					= Text_StringsToText errlist;
	(_,disk`)				= fclose file` disk1;
	};
	
ReadLinkMsg :: !*File -> (!List String, !Bool,!*File);
ReadLinkMsg file
	| eof && error	= (last,error,fil2);
	| eof			= (Nil,False,fil2);
					= (errormsg`,True,fil`);
	where {
	(string,fil1)	= freadline file;
	(eof,fil2)		= fend fil1;
	(errmsg,_,fil`)	= ReadLinkMsg fil2;
	last			= LastStrings string;
	string`			= ReplaceLastChar string;
	error			= IsLinkerErrorMsg string;
	errormsg`		= string` :! errmsg;
	};
	
// IsLinkerErrorMsg :: !String -> Bool;
IsLinkerErrorMsg str :== not (LayOut 0 (size str) str);

LayOut :: !Int !Int !String -> Bool;
LayOut pos len str
	| pos >= len	= True;
	| layout		= LayOut (inc pos) len str;
					= False;
	where {
		layout	= curchar == ' ' || curchar == '\t';
		curchar	= str.[pos];
	};

Execute	:: !WindowFun !Pathname !ApplicationOptions !ProgState !IO -> (!ProgIO,!Bool);
Execute winfun path _ prog io
	# (error_code,_) = exec path [] False;
	| error_code==0
		= ((prog,io),True);
		= (winfun (Text_StringsToText (("Could not launch the application, error: "+++toString error_code+++"\n"):!Nil)) prog io,False);

QuitCleanCompiler :: !IO -> IO;
QuitCleanCompiler io
	= io;

ExitCleanCompiler :: !ProgState !IO -> ProgIO;
ExitCleanCompiler st io
	# thread=0;
	# (r,thread)=stop_caching_compiler thread;
	| r<0
		= abort "couldn't stop compiler\n";
		= (st, io);

import scrapuse;
SetClipboardText :: String (IOState s) -> (IOState s);
SetClipboardText clipboard iostate
	=	IOPutScrap clipboard iostate;
GetClipboardText :: (IOState s)        -> (String, IOState s);
GetClipboardText iostate
	=	IOGetScrap iostate;

/* RWS: Copied from PowerMac version, I'm to lazy to change that now */
from EdMenuItems import Edit_UpdateMenuItems;
from EdWindows import UpdateClipboardAndItsWindow;
from EdEditMenu import GetClipboardFromScrap;
ClipboardChanged :: !ProgState !IO -> ProgIO;
ClipboardChanged programState ioState
	#	(clipboard, ioState)
		=	GetClipboardFromScrap ioState;
		programState
			=	{ programState & editor.Editor.clipboard = clipboard};
	#	(programState, ioState)
		=	UpdateClipboardAndItsWindow clipboard programState ioState;
	#	(programState, ioState)
		=	Edit_UpdateMenuItems programState ioState;

	=	(programState, ioState);

SystemDependentDevices :: [DeviceSystem ProgState IO];
SystemDependentDevices
	=	[
//		AppleEventSystem {openHandler = OpenFileOrProjectFile, quitHandler = Quit, clipboardChangedHandler = ClipboardChanged, scriptHandler = \_ s io -> (s, io)}
		];

SystemDependentInitialIO :: InitialIO ProgState;
SystemDependentInitialIO
	= [OpenFileOrProjectFile (make_full_path (GetArgvN n)) \\ n<-[1..GetArgC-1]];

GetArgC :: Int;
GetArgC = code {
		ccall get_argc ":I"
	}

GetArgvN :: !Int -> String;
GetArgvN n = code {
		ccall get_argv_n "I:S"
	}

make_full_path :: !String -> String;
make_full_path path
	# s=size path;
	| (s>0 && path.[0]=='/')
	||(s>1 && path.[0]=='.' && path.[1]=='/')
	||(s>2 && path.[0]=='.' && path.[1]=='.' && path.[2]=='/')
		= RealPath path;
		= RealPath ("./"+++path);

RealPath :: !String -> String;
RealPath path
	# l=256;
	# real_path=createArray l '\0';
	# r= RealPath path real_path;
	| r==0
		= path;
		= real_path % (0,first_occurence real_path '\0'-1);
	{}{
		RealPath :: !String !String -> Int;
		RealPath s1 s2 = code {
			ccall realpath "ss:I"
		}
	}

first_occurence s c = first_occurence 0 (size s);
{
	first_occurence i l
		| i>=l || s.[i]==c
			= i;
		  	= first_occurence (i+1) l;
}

EditorDefaultFontsToTry :: [(!FontName, ![FontStyle], !FontSize)];
EditorDefaultFontsToTry
	=	[(fontName, [], 9) \\ fontName <- ["Monaco", "Courier", "Geneva"]];

malloc :: !Int -> Int;
malloc n = code {
		ccall malloc "I:I"
	}

free :: !Int !Int -> Int;
free p r = code { 
		ccall free "I:V:I" 
	}

execv :: !{#Char} !Int -> Int;
execv file_name argv = code { 
		ccall execv "sI:I" 
	}

fork :: Int;
fork = code { 
		ccall fork ":I" 
	}

wait :: (!Int,!Int);
wait = code { 
		ccall wait ":II" 
	}

dup2 :: !Int !Int -> Int;
dup2 oldfd newfd = code {
		ccall dup2 "II:I"
	}

creat :: !String !Int -> Int;
creat string0 mode = code {
		ccall creat "sI:I"
	}

close :: !Int -> Int;
close fd = code {
		ccall close "I:I"
	}

errno = load_long (errno_address);

EINTR:==4;

exec :: !{#Char} ![{#Char}] !Bool -> (!Int,!Int);
exec file_name args wait_after_exec
	# args=[file_name:args];
	# n_args = length args;
	# argv_size = 6+5*n_args+sum (map size args);
	# argv = malloc argv_size;
	| argv==0
		= abort "malloc failed";
	# argv = fill_arguments args argv (argv+((n_args+1)<<2)) argv;
	# (r,s) = fork_exec_wait (file_name+++"\0") argv;
	  with {
		fork_exec_wait :: !{#Char} !Int -> (!Int,!Int);
		fork_exec_wait file_name0 argv
			# pid=fork;
			| pid==(-1)
				= (-1,0);
			| pid==0
				# r = execv file_name0 argv;
				= (1,r);
			| wait_after_exec
				# r = wait_for_child_to_finish pid;
				with {
					wait_for_child_to_finish pid
						# (wpid,r) = wait;
						| wpid==pid || wpid==0 || (wpid==(-1) && errno<>EINTR)
							= r;
							= wait_for_child_to_finish pid;
				}
				= (0,r);
				= (0,0);
	  }
	| free argv s==s
		= (r,s);

fill_arguments [] argp argsp argv
	|  store_long argp 0==0 && store_byte argsp 0==0 && store_byte (argsp+1) 0==0
		= argv;
	// otherwise
		=	abort "fill_arguments []\n";
fill_arguments [arg:args] argp argsp argv
	|  store_long argp argsp==argsp && store_zstring 0==0
		= fill_arguments args (argp+4) (argsp+size arg+1) argv;
		= fill_arguments args (argp+4) (argsp+size arg+1) argv;
	{}{
		store_zstring i
			| i==size arg
				= store_byte (argsp+i) 0;
			# v=toInt arg.[i];
			| store_byte (argsp+i) v==v
				= store_zstring (i+1);
	}

exec_with_redirect :: !{#Char} ![{#Char}] !{#Char} !{#Char} -> (!Int,!Int);
exec_with_redirect file_name args stdout_file_name stderr_file_name
	# args=[file_name:args];
	# n_args = length args;
	# argv_size = 6+5*n_args+sum (map size args);
	# argv = malloc argv_size;
	| argv==0
		= abort "malloc failed";
	# argv = fill_arguments args argv (argv+((n_args+1)<<2)) argv;
	# stdout_fd = creat (stdout_file_name+++"\0") 0777;
	| stdout_fd== (-1)
		= error 1;		
	# stderr_fd = creat (stderr_file_name+++"\0") 0777;
	| stderr_fd== (-1)
		= error 2;
	# (r_fork_exec_wait,s) = fork_exec_wait (file_name+++"\0") argv;
	  with {
		fork_exec_wait :: !{#Char} !Int -> (!Int,!Int);
		fork_exec_wait file_name0 argv
			# pid=fork;
			| pid==(-1)
				= (-1,0);
			| pid==0
				# r=dup2 stdout_fd 1;
				| r== (-1)
					= error 3;
				# r=dup2 stderr_fd 2;
				| r== (-1)
					= error 4;
				# r = execv file_name0 argv;
				= (1,r);
				# r = wait_for_child_to_finish pid;
				with {
					wait_for_child_to_finish pid
						# (wpid,r) = wait;
						| wpid==pid || wpid==0 || (wpid==(-1) && errno<>EINTR)
							= r;
							= wait_for_child_to_finish pid;
				}
				= (0,r);
	  }
	| r_fork_exec_wait<>r_fork_exec_wait
		= error 0;
	# r=close stderr_fd;
	| r==(-1)
		= error 5;
	# r=close stdout_fd;
	| r==(-1)
		= error 6;
	| free argv s==s
		= (r_fork_exec_wait,s);
	where {
		error n => abort ("Error in exec_with_redirect "+++toString n);
	}

/*
calloc :: !Int !Int -> Int;
calloc s n = code {
		ccall calloc "II:I"
	}

sigaddset :: !Int !Int -> Int;
sigaddset sigset_p signal = code {
		ccall sigaddset "II:I"
	}

sigprocmask :: !Int !Int !Int -> Int;
sigprocmask how set old_set = code { 
		ccall sigprocmask "III:I"
	}

exec_ file_name args
	# sigset=calloc 4 1;
	| sigset<>0 && sigaddset sigset 14==0 && sigprocmask 0 sigset 0==0
		#! (r,s) = exec file_name args True;
		| sigprocmask 1 sigset 0==0 && free sigset 0==0
			= (r,s);
			= abort "exec_";
*/
	
ReadStartupInfo :: !{#Char} !*Files -> (!StartupInfo,!*Files);
ReadStartupInfo fullApplicationPath files
	# clean_ide_config_file_name = MakeFullPathname fullApplicationPath "CleanIDEConfig";
	# (ok,file,files) = fopen clean_ide_config_file_name FReadText files;
	| not ok
		= abort ("Could not open "+++clean_ide_config_file_name+++"\n");
	# (line_number,file) = read_comment_line 1 file;
	# (linker_file_name,line_number,file) = read_config_line line_number file;
	# (line,file) = freadline file;
	# (linker_begin_object_files,line_number,line,file) = read_config_lines line_number line file;
	# (linker_libraries,line_number,line,file) = read_config_lines line_number line file;
	# (linker_end_object_files,line_number,line,file) = read_config_lines line_number line file;
	# (line_number,file) = check_comment_line line_number line file;
	# (assembler_file_name,line_number,file) = read_config_line line_number file;
	# (ok,files) = fclose file files;
	| not ok
		= abort ("Error while reading "+++clean_ide_config_file_name+++"\n");
		= ({	startupdir	= fullApplicationPath,
				linker_file_name=linker_file_name,
				linker_begin_object_files=linker_begin_object_files,
				linker_libraries=linker_libraries,
				linker_end_object_files=linker_end_object_files,
				assembler_file_name=assembler_file_name
			  },files);
	where {
		read_config_line :: !Int !*File -> (!String,!Int,!*File);
		read_config_line line_number file
			# (line,file) = freadline file;
			| size line>0
				| line.[0]<>'#'
					= (remove_newline_at_end line,line_number+1,file);
					= abort ("Unexpected line starting with # in CleanIDEConfig line "+++toString line_number+++"\n");
				= abort ("Unexpected end of file in CleanIDEConfig line "+++toString line_number+++"\n");

		read_config_lines :: !Int !String !*File -> (![String],!Int,!String,!*File);
		read_config_lines line_number line file
			# (line_number,file) = check_comment_line line_number line file;
			= read_config_lines_ line_number file;
		{
			read_config_lines_ line_number file
				# (line,file) = freadline file;
				| size line>0 && line.[0]<>'#'
					# (lines,line_number,next_line,file) = read_config_lines_ (line_number+1) file;
					= ([remove_newline_at_end line:lines],line_number,next_line,file);
					= ([],line_number,line,file);
		}
		
		read_comment_line line_number file
			# (line,file) = freadline file;
			= check_comment_line line_number line file;
		
		check_comment_line line_number line file
			| size line>0 && line.[0]=='#'
				= (line_number+1,file);
				= abort ("Expected line starting with # in CleanIDEConfig line "+++toString line_number+++"\n");
		
		remove_newline_at_end s
			| size s>0 && s.[size s-1]=='\n'
				= s % (0,size s-2);
				= s;
	}

write_array_to_file a file_name files
	# (ok,file,files) = fopen file_name FWriteData files;
	| ok
		# file = write_data 0 file;
		  with {
		  	write_data i files
		  		| i>=size a
		  			= files;
		  			= write_data (inc i) (fwritei a.[i] files);
		  }
		= fclose file files;
		= (False,files);

options_object_file_code :: Int Int Int Int Int -> {#Int};
options_object_file_code flags heap_size ab_stack_size heap_size_multiple initial_heap_size
	= IF_SOLARIS
{
		0x7f454c46,0x01020100,0x00000000,0x00000000,
		0x00010002,0x00000001,0x00000000,0x00000000,
		0x00000074,0x00000000,0x00340000,0x00000028,
		0x00070004,flags,heap_size,ab_stack_size,
		heap_size_multiple,initial_heap_size,0x002e7379,0x6d746162,
		0x002e7374,0x72746162,0x002e7368,0x73747274,
		0x6162002e,0x74657874,0x002e6461,0x7461002e,
		0x62737300,0x00000000,0x00000000,0x00000000,
		0x00000000,0x00000000,0x00000000,0x00000000,
		0x00000000,0x00000000,0x00000000,0x0000001b,
		0x00000001,0x00000006,0x00000000,0x00000034,
		0x00000000,0x00000000,0x00000000,0x00000001,
		0x00000000,0x00000021,0x00000001,0x00000003,
		0x00000000,0x00000034,0x00000014,0x00000000,
		0x00000000,0x00000001,0x00000000,0x00000027,
		0x00000008,0x00000003,0x00000000,0x00000048,
		0x00000000,0x00000000,0x00000000,0x00000001,
		0x00000000,0x00000011,0x00000003,0x00000000,
		0x00000000,0x00000048,0x0000002c,0x00000000,
		0x00000000,0x00000001,0x00000000,0x00000001,
		0x00000002,0x00000000,0x00000000,0x0000018c,
		0x00000090,0x00000006,0x00000004,0x00000004,
		0x00000010,0x00000009,0x00000003,0x00000000,
		0x00000000,0x0000021c,0x00000044,0x00000000,
		0x00000000,0x00000001,0x00000000,0x00000000,
		0x00000000,0x00000000,0x00000000,0x00000000,
		0x00000000,0x00000000,0x03000001,0x00000000,
		0x00000000,0x00000000,0x03000002,0x00000000,
		0x00000000,0x00000000,0x03000003,0x00000001,
		0x00000000,0x00000000,0x11000002,0x00000007,
		0x00000004,0x00000000,0x11000002,0x00000011,
		0x00000008,0x00000000,0x11000002,0x0000001f,
		0x0000000c,0x00000000,0x11000002,0x00000032,
		0x00000010,0x00000000,0x11000002,0x00666c61,
		0x67730068,0x6561705f,0x73697a65,0x0061625f,
		0x73746163,0x6b5f7369,0x7a650068,0x6561705f,
		0x73697a65,0x5f6d756c,0x7469706c,0x6500696e,
		0x69746961,0x6c5f6865,0x61705f73,0x697a6500
	}
	(IF_INTEL
	{
		0x464c457f,0x00010101,0x00000000,0x00000000,
		0x00030001,0x00000001,0x00000000,0x00000000,
		0x00000074,0x00000000,0x00000034,0x00280000,
		0x00040007,heap_size,ab_stack_size,flags,
		heap_size_multiple,initial_heap_size,0x79732e00,0x6261746d,
		0x74732e00,0x62617472,0x68732e00,0x74727473,
		0x2e006261,0x74786574,0x61642e00,0x2e006174,
		0x00737362,0x00000000,0x00000000,0x00000000,
		0x00000000,0x00000000,0x00000000,0x00000000,
		0x00000000,0x00000000,0x00000000,0x0000001b,
		0x00000001,0x00000006,0x00000000,0x00000034,
		0x00000000,0x00000000,0x00000000,0x00000004,
		0x00000000,0x00000021,0x00000001,0x00000003,
		0x00000000,0x00000034,0x00000014,0x00000000,
		0x00000000,0x00000004,0x00000000,0x00000027,
		0x00000008,0x00000003,0x00000000,0x00000048,
		0x00000000,0x00000000,0x00000000,0x00000004,
		0x00000000,0x00000011,0x00000003,0x00000000,
		0x00000000,0x00000048,0x0000002c,0x00000000,
		0x00000000,0x00000001,0x00000000,0x00000001,
		0x00000002,0x00000000,0x00000000,0x0000018c,
		0x00000090,0x00000006,0x00000004,0x00000004,
		0x00000010,0x00000009,0x00000003,0x00000000,
		0x00000000,0x0000021c,0x00000044,0x00000000,
		0x00000000,0x00000001,0x00000000,0x00000000,
		0x00000000,0x00000000,0x00000000,0x00000000,
		0x00000000,0x00000000,0x00010003,0x00000000,
		0x00000000,0x00000000,0x00020003,0x00000000,
		0x00000000,0x00000000,0x00030003,0x00000001,
		0x00000000,0x00000000,0x00020011,0x0000000b,
		0x00000004,0x00000000,0x00020011,0x00000019,
		0x00000008,0x00000000,0x00020011,0x0000001f,
		0x0000000c,0x00000000,0x00020011,0x00000032,
		0x00000010,0x00000000,0x00020011,0x61656800,
		0x69735f70,0x6100657a,0x74735f62,0x5f6b6361,
		0x657a6973,0x616c6600,0x68007367,0x5f706165,
		0x657a6973,0x6c756d5f,0x6c706974,0x6e690065,
		0x61697469,0x65685f6c,0x735f7061,0x00657a69
	}
	{
		0x7f454c46,0x01020100,0x00000000,0x00000000,
		0x00010014,0x00000001,0x00000000,0x00000000,
		0x00000074,0x00000000,0x00340000,0x00000028,
		0x00070004,flags,heap_size,ab_stack_size,
		heap_size_multiple,initial_heap_size,0x002e7379,0x6d746162,
		0x002e7374,0x72746162,0x002e7368,0x73747274,
		0x6162002e,0x74657874,0x002e6461,0x7461002e,
		0x62737300,0x00000000,0x00000000,0x00000000,
		0x00000000,0x00000000,0x00000000,0x00000000,
		0x00000000,0x00000000,0x00000000,0x0000001b,
		0x00000001,0x00000006,0x00000000,0x00000034,
		0x00000000,0x00000000,0x00000000,0x00000001,
		0x00000000,0x00000021,0x00000001,0x00000003,
		0x00000000,0x00000034,0x00000014,0x00000000,
		0x00000000,0x00000001,0x00000000,0x00000027,
		0x00000008,0x00000003,0x00000000,0x00000048,
		0x00000000,0x00000000,0x00000000,0x00000001,
		0x00000000,0x00000011,0x00000003,0x00000000,
		0x00000000,0x00000048,0x0000002c,0x00000000,
		0x00000000,0x00000001,0x00000000,0x00000001,
		0x00000002,0x00000000,0x00000000,0x0000018c,
		0x00000090,0x00000006,0x00000004,0x00000004,
		0x00000010,0x00000009,0x00000003,0x00000000,
		0x00000000,0x0000021c,0x00000041,0x00000000,
		0x00000000,0x00000001,0x00000000,0x00000000,
		0x00000000,0x00000000,0x00000000,0x00000000,
		0x00000000,0x00000000,0x03000001,0x00000000,
		0x00000000,0x00000000,0x03000002,0x00000000,
		0x00000000,0x00000000,0x03000003,0x00000001,
		0x00000000,0x00000000,0x11000002,0x00000007,
		0x00000004,0x00000000,0x11000002,0x00000011,
		0x00000008,0x00000000,0x11000002,0x0000001c,
		0x0000000c,0x00000000,0x11000002,0x0000002f,
		0x00000010,0x00000000,0x11000002,0x00666c61,
		0x67730068,0x6561705f,0x73697a65,0x00737461,
		0x636b5f73,0x697a6500,0x68656170,0x5f73697a,
		0x655f6d75,0x6c746970,0x6c650069,0x6e697469,
		0x616c5f68,0x6561705f,0x73697a65,0x00
	});
