implementation module EdCleanSystem;

// import code from "call_system_framework.o","pointer_glue.o";

/* OS dependent module for the powermacintosh */

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

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

import memory, appleevents;
from files import LaunchApplication,FSMakeFSSpec,LaunchApplicationFSSpec;
from EdFileMenu import Quit;
from EdFileMenu import OpenFile;
from EdProjectMenu import OpenFileOrProjectFile;
import xcoff_linker;

/*  Macros used to select platform specific code.
    Make sure only one of these macros returns its first argument.
*/
IfMacintoshSystem m o :== m;
IfMsWindowsSystem w o :== o;
IfUnixSystem u o :== o;
IsMsWindowsSystem :== False;

IF_MACH_O mach_o pef :== pef;

from UtilNewlinesFile import
	::NewlineConvention (NewlineConventionNone,NewlineConventionMac, NewlineConventionUnix, NewlineConventionDos);
HostNativeNewlineConvention
	:== IfMacintoshSystem
			NewlineConventionMac
		(IfUnixSystem
			NewlineConventionUnix
		(IfMsWindowsSystem
			NewlineConventionDos
			("unknown" "os")));

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

SELECT_COMPILER clean13 clean20 :== clean20;

PatchableCleanCompilerSignature1 :== "#$@CLCOSIGNAT%*&ClCo\0";
PatchableCleanCompilerSignature2 :== "#$@CLCOSIGNAT%*&ClC2\0";

PatchableCleanCompilerSignature = SELECT_COMPILER PatchableCleanCompilerSignature1 PatchableCleanCompilerSignature2;
CleanCompilerSignature =: PatchableValue "CLCOSIGNAT" PatchableCleanCompilerSignature;

PatchableCleanCompilerName1 :== "#$@CLCONAME  %*&Clean Compiler\0............................some extra space for long names (total 128 chars).......................";
PatchableCleanCompilerName2 :== "#$@CLCONAME  %*&Clean Compiler 2\0..........................some extra space for long names (total 128 chars).......................";
//PatchableCleanCompilerName2 :== "#$@CLCONAME  %*&CleanCocl\0.................................some extra space for long names (total 128 chars).......................";

PatchableCleanCompilerName :== SELECT_COMPILER PatchableCleanCompilerName1 PatchableCleanCompilerName2;
CleanCompilerName =: PatchableValue "CLCONAME  " PatchableCleanCompilerName;

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

ClearCompilerCache :: !IO -> (!Int,!IO);
ClearCompilerCache io = (os_error_code,io);
{
	(os_error_code,_,_) = send_command_to_clean_compiler "clear_cache";
}

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
	| error_code<>0
		= (errwin (Text_StringsToText (("Cannot run compiler: "+++toString error_code+++"\n"):!Nil)) prog io,"",SyntaxError);
		= (prio2,abcpath,if (error_n==1) CompilerOK errors);
	where {
		(error_code,error_n,_) = send_command_to_clean_compiler command;
		command = "cocl"+++clear_cache_option+++MakeCompilerOptionsString compileOrCheckSyntax projectMemoryProfiling projectProfiling  co+++"-sl -P "+++
					quoted_string (MakePathListString paths)+++" "+++quoted_string path+++
					" > " +++ quoted_string out_file_name +++ " \xb3 " +++ quoted_string errors_file_name; /* \xb3 == >= ligature */
		prio2
			| type_text_not_empty
				= typewin type_text prog1 io1; { (prog1,io1) = prio1; }
				= prio1;
		prio1 	= show_errors prog io3;
		show_errors prog io
			| errors_and_messages_not_empty
				= errwin errors_and_messages prog io;
				= (prog,io);

		(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 +++ ":out";
		errors_file_name = startupdir +++ ":errors";
		clear_cache_option
			| clearCache == Don`tClearCache
				=	"";
			// otherwise
				=	" -clear_cache";
	};

NewlineChar	:== '\n';

quoted_string string = "\'" +++ double_quotes 0 string +++ "\'";
{
	double_quotes i string
		| i>=size string
			= string;
		| string.[i]=='\''
			= double_quotes (i+2) (string % (0,i)+++"\'"+++string % (i+1,dec (size string)));
			= double_quotes (inc i) string;
}
	
ReadErrorsAndWarnings :: !Pathname !*Files -> ((!CompilerMsg, !Bool, !Text), !*Files);
ReadErrorsAndWarnings path 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;
		}
	where {
		(opened,file,disk1)	= fopen path FReadText disk;
	};

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';
		}
		= (if is_import_error (Patherror path) path_error,True,string`:!errlist,file3);
		{
			(path_error,_,errlist,file3) = ReadErrorAndWarningMessages file2;
		}
	where {
		(string, file1)					= freadline file;
		(eof,file2)						= fend file1;
		string`							= ReplaceLastChar string;
		(is_import_error,path)			= IsImportError string;
	};
	
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 && NewlineChar==str.[dec string_size]
		=  str :! Nil;
		=  (str +++ NewlStr) :! Nil;

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

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+++" ";
	};

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=:{tp} ao prog io
	| error_code<>0
		= (winfun (Text_StringsToText (("Cannot run code generator: "+++toString error_code+++"\n"):!Nil)) prog io1,objpath,False);
	| size output_string==0
		= ((prog,io1),objpath,error_n==0);
		= (winfun (Text_StringsToText ((output_string+++"\n"):!Nil)) prog io1,objpath,error_n==0);
	where {
		(objpath,io1) = accFiles (MakeObjSystemPathname tp path) io;
		(error_code,error_n,output_string) = send_command_to_clean_compiler command;
		command = (if (tp==CurrentProcessor) "cg " "cg68 ") +++ 
					MakeCodeGenOptionsString genAsmOrCode cgo +++ " " +++ quoted_string (RemoveSuffix path) +++ " > out \xb3  errors"; /* \xb3 == >= ligature */
	};

MakeCodeGenOptionsString :: !CodeGenerateAsmOrCode !CodeGenOptions -> String;
MakeCodeGenOptionsString genAsmOrCode {ci,cs,tp}
	= checkindex +++ checkstack +++ genasm +++ processor +++ " ";
	where {
		checkindex	| ci					= " -ci";
											= "";
		checkstack	| cs					= " -os";
											= "";
		genasm		| genAsmOrCode == AsmGeneration
											= " -a";
											= "";
		processor	| tp==MC68020			= " -sane";
					| tp==MC68000			= " -mc68000";
											= "";
	};

to_unix_path p = "/Volumes/"+++ to_unix_path 0 p;
{
	to_unix_path i p
		| i==size p
			= p
		| p.[i]==':'
			= to_unix_path (inc i) (p % (0,i-1)+++"/"+++p % (i+1,size p-1));
			= to_unix_path (inc i) p;
}

import linker_resources;

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 ao processor linkOptions abcLinkObjFilePaths abcLinkLibraryPaths ps io
	| processor==CurrentProcessor
		= Link_ppc winfun path u_system_file_name paths defs ao linkOptions abcLinkObjFilePaths abcLinkLibraryPaths ps io;
		= Link68k winfun path u_system_file_name paths defs ao processor linkOptions abcLinkObjFilePaths ps io;

Link_ppc ::	!WindowFun !Pathname !Pathname !(List Pathname) !(List Pathname) !ApplicationOptions !LinkOptions !(List Pathname) !(List Pathname) !ProgState !IO
		 -> (!ProgIO,!Bool);
Link_ppc winfun path u_system_file_name paths defs
	applicationOptions=:{ss,fs,fn,hs,em,heap_size_multiple,initial_heap_size,profiling,profiling601,memoryProfilingMinimumHeapSize}
							linkOptions abcLinkObjFilePaths abcLinkLibraryPaths 
							prog=:{editor={startupinfo={startupdir},project}} io
	| errlines<>0
		= (winfun errtext prog io5,link_ok);
		= ((prog,io5),link_ok);
	{}{
		((link_ok,link_errors),io5)
			=	accFiles (/*IF_MACH_O link_mach_o*/ link) io3;
/* for Mach-O
		link_mach_o files
			# application_file_name = MakeExecPathname path;
			# (r1,r2) = send_command_to_application False "EXEC" ("/usr/bin/cc "+++concat_object_file_names objectFileNames
				+++" -framework Carbon"+++" -o '"+++to_unix_path application_file_name+++"'");

			| r1==r1
				# application_existed = False;
				# (resources_ok,files) = create_application_resource application_file_name application_existed (fs,fn) hs heap_size_multiple ss flags
												(0/*pef_application_size+extra_application_memory*/) initial_heap_size memoryProfilingMinimumHeapSize
												True False files;
				= ((True, []), files)
				= ((True, []), files)
			where {
				concat_object_file_names [file_name:file_names]
					= " '"+++to_unix_path file_name+++"'"+++concat_object_file_names file_names;
				concat_object_file_names []
					= "";
			}
 */

		link_mach_o files
			= files;

		link f = ((result, message), files)
			where
			{
				(result, message, files)
					= link_xcoff_files objectFileNames libraryFileNames (MakeExecPathname path)
						(fs,fn) hs heap_size_multiple ss flags em initial_heap_size memoryProfilingMinimumHeapSize False f;
			};

		(errtext,errlines)	= ClipboardToText (ListToStrictList link_errors);

		objectFileNames = defaultObjects ++ StrictListToList paths ++ (removeDup (StrictListToList linkOptions.extraObjectModules))++ (StrictListToList abcLinkObjFilePaths);

		(u_library_object_file_name,io2_1)
			=	accFiles (MakeObjSystemPathname CurrentProcessor (MakeFullPathname system_directory_name "_library")) io2;

		(u_startup2_object_file_name,io2_2)
			=	accFiles (MakeObjSystemPathname CurrentProcessor (MakeFullPathname system_directory_name "_startup2")) io2_1;
		(u_startup3_object_file_name,io2_3)
			=	accFiles (MakeObjSystemPathname CurrentProcessor (MakeFullPathname system_directory_name "_startup3")) io2_2;

		io3 = /*IF_MACH_O io2_3*/ io2_1;
		
		startupModuleName
			| not profiling
				=	"_startup";
			| profiling601
				=	"_startupProfile601";
			| otherwise
				=	"_startupProfile";
		(u_startup_file_name,io2)
			= accFiles (MakeObjSystemPathname CurrentProcessor (MakeFullPathname system_directory_name startupModuleName)) io;

		defaultObjects
			| linkOptions.useDefaultSystemObjects
				=	/*IF_MACH_O
					[u_startup_file_name, u_startup2_object_file_name, u_startup3_object_file_name, u_system_file_name, u_library_object_file_name]
					*/
					[u_startup_file_name, u_system_file_name, u_library_object_file_name];
			// otherwise
				=	[];

		libraryFileNames
			=	defaultLibraries ++ (removeDup (StrictListToList linkOptions.libraries)) ++ (StrictListToList abcLinkLibraryPaths);
		defaultLibraries
			| linkOptions.useDefaultLibraries
				= [	system_directory_name +++ ":library0",
								system_directory_name +++ ":library1",
								system_directory_name +++ ":library2"];		
			// otherwise
				=	[];
		flags					= ApplicationOptionsToFlags applicationOptions;

		system_directory_name = RemoveFilename u_system_file_name;
	};


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;
	}

Link68k :: !WindowFun !Pathname !Pathname !(List Pathname) !(List Pathname) !ApplicationOptions !Processor !LinkOptions !(List Pathname) !ProgState !IO
		-> (!ProgIO,!Bool);
Link68k winfun path systm paths defs ao processor linkOptions abcLinkObjFilePaths prog=:{editor={startupinfo={startupdir}}} io
	| error_code<>0
		= (winfun (Text_StringsToText (("Cannot run linker: "+++toString error_code+++", "+++toString error_n+++"\n"):!Nil)) prog io`,False);
		= (prio`,error_n == 0);
	where {
		prio`	| errors	= winfun errtext prog io`;
							= (prog,io`);
//		prog0				= {prog & world=world`};
		(error_code,error_n,_) =  send_command_to_clean_compiler
									(make_link68_command prefix (Concat paths (Concat (RemoveDup linkOptions.extraObjectModules) abcLinkObjFilePaths)) suffix);
		prefix				= "linker" +++ MakeLinkOptionsString ao +++ " \'" +++ MakeExecPathname path +++ "\'"
									+++ standardPaths;
		suffix				= " > out \xb3 errors";  /* \xb3 == >= ligature */

		(standardPaths, io1)
			=	accFiles buildStandardPaths io;
		buildStandardPaths disk
			| not linkOptions.useDefaultSystemObjects
				=	("", disk);
			// otherwise
				=	(StandardPaths systm startup lib, disk1);
				where {
					(startup,lib,disk1)
						=	FindStandardFiles processor systm disk;
				}

		errorsfile
			=	startupdir +++ ":out";
		((errors, errtext), io`)
			=	accFiles (ReadLinkInfo errorsfile) io1;
	};

RemoveDup strictList = ListToStrictList (removeDup (StrictListToList strictList)); // MW ++ (!!!!!)

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];
	};

StandardPaths :: !String String String -> String;
StandardPaths systm startup lib
	= " \'" +++ startup +++ "\' \'" +++ systm +++ "\' \'" +++ lib +++ "\'";

make_link68_command :: !String !(List Pathname) !String -> String;
make_link68_command prefix Nil suffix
	= prefix +++ suffix;
make_link68_command prefix (path:!rest) suffix
	= make_link68_command (prefix +++ " \'" +++ path +++ "\'") rest suffix;
	
FindStandardFiles :: !Processor !Pathname !*Files -> (!Pathname,!Pathname,!*Files);
FindStandardFiles processor systm disk
	= (startup`,library`,disk`);
	where {
		(startup`,disk1)	= MakeObjSystemPathname processor (MakeFullPathname path "_startup") disk;
		(library`,disk`)	= MakeObjSystemPathname processor (MakeFullPathname path "_library") disk1;
		path				= RemoveFilename systm;
	};

// RWS: implement use applications options
Execute	:: !WindowFun !Pathname !ApplicationOptions !ProgState !IO -> (!ProgIO,!Bool);
Execute winfun path _ prog io
	#t=NewToolbox;
//	# (error_n,_) = LaunchApplication path 0xC8000000 NewToolbox;
	# (error_n,fs_spec,t) = FSMakeFSSpec path t;
	| error_n<>0
		= (winfun (error error_n) prog io,False);
	# (error_n,_) = LaunchApplicationFSSpec fs_spec 0xC800 t;
	| error_n>=0
		= ((prog,io),True);
		= (winfun (error error_n) prog io,False);
	{}{
		error error_n = Text_StringsToText (("Could not launch the application, MacOS error: "+++toString error_n+++"\n"):!Nil);
	}
QuitCleanCompiler :: !IO -> IO;
QuitCleanCompiler io
	| send_quit_event_to_clean_compiler==0
		= io;
		= io;

//import StdDebug;
		
send_command_to_clean_compiler :: !String -> (!Int,!Int,!String);
send_command_to_clean_compiler command
	# (os_error_code,error_n,output_string)=send_command_to_clean_compiler0 False command;		
	| error_n<>(-2)
		= (os_error_code,error_n,output_string);
	# t=NewToolbox;
//	# (launch_error_n,t) = LaunchApplication CleanCompilerName 0xCA000000 t;
	# (r,fs_spec,t) = FSMakeFSSpec CleanCompilerName t;
	| r<>0
		= (r,-1,"");
	# (launch_error_n,t) = LaunchApplicationFSSpec fs_spec 0xCA00 t;
	| launch_error_n>=0	
		= send_command_to_clean_compiler0 True command;
		= (launch_error_n,-1,"");

/*
OldAEDisposeDesc a
	:== let {
			(r,_) = AEDisposeDesc a 0;
		} in r;
*/
OldAEDisposeDesc a
	:==  AEDisposeDesc a;

send_command_to_clean_compiler0 :: !Bool !String-> (!Int,!Int,!String);
send_command_to_clean_compiler0 repeat_send command
	| error_code1<>0
		= (error_code1,-1,"");
	| error_code2<>0
		= (free_memory error_code2,-1,"");
	| error_code3<>0
		= (free_descriptor_and_memory error_code3,-1,"");
	| error_code4<>0
		= (free_apple_event_and_desciptor_and_memory error_code4,-1,"");
	| error_code5==(-609) || error_code5==(-600)
		= (free_apple_event_and_desciptor_and_memory error_code5,-2,"");
	| error_code5<>0
		= (free_apple_event_and_desciptor_and_memory error_code5,-1,"");
		= (free_result_apple_event_and_apple_event_and_desciptor_and_memory error_code6 error_code7,
			if (error_code6<0) 0 v1,
			if (error_code7<>0) "" (string % (0,s2-1)));
	where {
		(memory,error_code1,_) = NewPtr (SizeOfAEDesc+SizeOfAppleEvent+SizeOfAppleEvent) 0;

		descriptor=memory;
		apple_event=memory+SizeOfAEDesc;
		result_apple_event=memory+SizeOfAEDesc+SizeOfAppleEvent;

		// error_code2 = AECreateDesc TypeApplSignature "MPSX" descriptor; // Tool Server
		error_code2 = AECreateDesc TypeApplSignature CleanCompilerSignature descriptor;
		error_code3 = AECreateAppleEvent KAEMiscStandards KAEDoScript descriptor KAutoGenerateReturnID KAnyTransactionID apple_event;
		error_code4 = AEPutParamPtr apple_event KeyDirectObject TypeChar command;

		error_code5 = repeat_ae_send;

		repeat_ae_send
			# error_code5 = AESend apple_event result_apple_event KAEWaitReply KAENormalPriority KNoTimeOut 0 0;

			| repeat_send && (error_code5==(-600) || error_code5==(-609))
				= repeat_ae_send;

				= error_code5;

		(error_code6,_,v1,_) = AEGetIntParamPtr result_apple_event KeyErrorNumber TypeLongInteger;
		(error_code7,_,s2) = AEGetStringParamPtr result_apple_event KeyErrorString TypeChar string;

		string = createArray 5120 '@';
		
		free_result_apple_event_and_apple_event_and_desciptor_and_memory error_code6 error_code7
			| error_code6==error_code6 && error_code7==error_code7
				= free_apple_event_and_desciptor_and_memory free_error_code;
			{}{
				free_error_code = OldAEDisposeDesc result_apple_event;
			}

		free_apple_event_and_desciptor_and_memory error_code
			| error_code==0
				= free_descriptor_and_memory free_error_code;
			| free_error_code==0
				= free_descriptor_and_memory error_code;
				= free_descriptor_and_memory error_code;
			where {
				free_error_code = OldAEDisposeDesc apple_event;
			}

		free_descriptor_and_memory error_code
			| error_code==0
				= free_memory free_error_code;
			| free_error_code==0
				= free_memory error_code;
				= free_memory error_code;
			where {
				free_error_code = OldAEDisposeDesc descriptor;
			}

		free_memory error_code
			| error_code==0
				= if (tb==tb) 0 0;
			| tb==tb
				= error_code;
				= error_code;
			where {
//				 tb = DisposePtr memory 0;
				 (_,tb) = DisposPtr memory 0;
			}
	};

send_quit_event_to_clean_compiler :: Int;
send_quit_event_to_clean_compiler
	| error_code1<>0
		= error_code1;
	| error_code2<>0
		= free_memory error_code2;
	| error_code3<>0
		= free_descriptor_and_memory error_code3;
	| error_code4<>0
		= free_apple_event_and_desciptor_and_memory error_code4;
		= free_apple_event_and_desciptor_and_memory error_code4;
	where {
		(memory,error_code1,_) = NewPtr (SizeOfAEDesc+SizeOfAppleEvent+SizeOfAppleEvent) 0;

		descriptor=memory;
		apple_event=memory+SizeOfAEDesc;
		result_apple_event=memory+SizeOfAEDesc+SizeOfAppleEvent;

		error_code2 = AECreateDesc TypeApplSignature CleanCompilerSignature descriptor;
		error_code3 = AECreateAppleEvent KCoreEventClass KAEQuitApplication descriptor KAutoGenerateReturnID KAnyTransactionID apple_event;
		error_code4 = AESend apple_event result_apple_event KAENoReply KAENormalPriority KNoTimeOut 0 0;

		free_apple_event_and_desciptor_and_memory error_code
			| error_code==0
				= free_descriptor_and_memory free_error_code;
			| free_error_code==0
				= free_descriptor_and_memory error_code;
				= free_descriptor_and_memory error_code;
			where {
				free_error_code = OldAEDisposeDesc apple_event;
			}

		free_descriptor_and_memory error_code
			| error_code==0
				= free_memory free_error_code;
			| free_error_code==0
				= free_memory error_code;
				= free_memory error_code;
			where {
				free_error_code = OldAEDisposeDesc descriptor;
			}

		free_memory error_code
			| error_code==0
				= if (tb==tb) 0 0;
			| tb==tb
				= error_code;
				= error_code;
			where {
//				tb	= DisposePtr memory 0;
				(_,tb) = DisposPtr memory 0;
			}
	};

import scrapuse;

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

from EdEditMenu import GetClipboardFromScrap;
from EdMenuItems import Edit_UpdateMenuItems;
from EdWindows import UpdateClipboardAndItsWindow;

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 *s;
SystemDependentInitialIO
		=	[];
	
NoOp :: *p (IOState *p) -> (*p, IOState *p);
NoOp p io
	=	(p, io);

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

ReadStartupInfo :: !{#Char} !*Files -> (!StartupInfo,!*Files);
ReadStartupInfo startupdir files =
	(	{	startupdir	= startupdir
		,	linker_file_name = ""
		,	linker_begin_object_files = []
		,	linker_libraries = []
		,	linker_end_object_files = []
		,	assembler_file_name = ""
		}
	,	files
	);

/* for Mach-O */

fork_execv_waitpid :: !String -> Int;
fork_execv_waitpid s = code (s=CD0)(r=D0){
	call .fork_execv_waitpid
};

send_command_to_application :: !Bool !String !String -> (!Int,!Int);
send_command_to_application _ _ s
	# r=fork_execv_waitpid (s+++"\0");
	| r==(-1)
		= (-1,-1);
		= (0,0);

/*
send_command_to_application :: !Bool !String !String -> (!Int,!Int);
send_command_to_application repeat_send application_signature command
	| error_code1<>0
		= (error_code1,-1);
	| error_code2<>0
		= (free_memory error_code2,-1);
	| error_code3<>0
		= (free_descriptor_and_memory error_code3,-1);
	| error_code4<>0
		= (free_apple_event_and_desciptor_and_memory error_code4,-1);
	| error_code5==(-609) || error_code5==(-600)
		= (free_apple_event_and_desciptor_and_memory error_code5,-2);
	| error_code5<>0
		= (free_apple_event_and_desciptor_and_memory error_code5,-1);
		= (free_result_apple_event_and_apple_event_and_desciptor_and_memory error_code6,
			if (error_code6<0) 0 v1);
	where {
		(memory,error_code1,_) = NewPtr (SizeOfAEDesc+SizeOfAppleEvent+SizeOfAppleEvent) 0;

		descriptor=memory;
		apple_event=memory+SizeOfAEDesc;
		result_apple_event=memory+SizeOfAEDesc+SizeOfAppleEvent;

		error_code2 = AECreateDesc TypeApplSignature application_signature descriptor;
		error_code3 = AECreateAppleEvent KAEMiscStandards KAEDoScript descriptor KAutoGenerateReturnID KAnyTransactionID apple_event;
		error_code4 = AEPutParamPtr apple_event KeyDirectObject TypeChar command;

		error_code5 = repeat_ae_send;

		repeat_ae_send
			# error_code5 = AESend apple_event result_apple_event KAEWaitReply KAENormalPriority KNoTimeOut 0 0;
//			| repeat_send && error_code5==(-600)
//				= repeat_ae_send;
				= error_code5;

		(error_code6,_,v1,_) = AEGetIntParamPtr result_apple_event KeyErrorNumber TypeLongInteger;
		
		free_result_apple_event_and_apple_event_and_desciptor_and_memory error_code6
			| error_code6==error_code6
				= free_apple_event_and_desciptor_and_memory free_error_code;
			{}{
				free_error_code = OldAEDisposeDesc result_apple_event;
			}

		free_apple_event_and_desciptor_and_memory error_code
			| error_code==0
				= free_descriptor_and_memory free_error_code;
			| free_error_code==0
				= free_descriptor_and_memory error_code;
				= free_descriptor_and_memory error_code;
			where {
				free_error_code = OldAEDisposeDesc apple_event;
			}

		free_descriptor_and_memory error_code
			| error_code==0
				= free_memory free_error_code;
			| free_error_code==0
				= free_memory error_code;
				= free_memory error_code;
			where {
				free_error_code = OldAEDisposeDesc descriptor;
			}

		free_memory error_code
			| error_code==0
				= if (tb==tb) 0 0;
			| tb==tb
				= error_code;
				= error_code;
			where {
				 tb = DisposePtr memory 0;
			}
	};
*/

/* */