implementation module EdCleanSystem;

/* OS dependent module for win95 */

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

import EdTypes, EdText, EdProgramState, EdPath, EdParse;
from EdLists import StrictListToList;
import xcoff_linker;
import intrface, clCrossCall,ioTypes;
from EdProjectMenu import OpenFileOrProjectFile;
import ArgEnv, expand_8_3_names_in_path;
import deltaDialog, deltaIOState;

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

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

::	CompilerMsg
	= 	CompilerOK
	| 	SyntaxError
	| 	Patherror Pathname;

::	VerboseFun
	:== !String -> !ProgState -> * (!IO -> ProgIO);
	
::	WindowFun
	:== !Text -> !ProgState -> * (!IO -> ProgIO);
	

/* Compiles the given file:
	1st arg.	function to show verbose messages of the compiler.
	2nd arg.	function to show error and warning messages of the compiler.
	3rd arg.	function to show type info listed by the compiler.
	4th arg.	check syntax only?
	5th arg.	file name of the module to be compiled (must be a full .icl file name).
	6th arg.	list of paths where the compiler can find imported .dcl files.
	7th arg.	compiler options.
	8th arg.	program state.
	9th arg.	io state.
	1st result	new program and io state.
	2nd result	path name of the generated .abc file.
					Note: on the macintosh the .abc file is generated in the standard Clean System
					Files Folder. On Unix, however, the location of the .abc depends on the user
					settings.
	3rd result	indication whether compilation was successfull.
*/	

int_to_hex v
	= {hex_char i \\ i<-[0..7]};
{
		hex_char i
			# h=(v>>((7-i)<<2)) bitand 15;
			= toChar (if (h<10) (toInt '0'+h) ((toInt 'A'-10)+h));
}

import code from "thread_message.obj";
import thread_message;

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_id=get_current_thread_id;
	# begin_arguments="-ide "+++int_to_hex thread_id;
	# (r,compiler_thread_id,compiler_thread_handle,compiler_process_handle) = start_compiler_process (path+++"\0") (directory+++"\0") (path+++" "+++begin_arguments+++"\0");
	| r==0
		= abort "compile_with_cache 1";
	# (ok,s) = compile_with_cache2 path directory arguments compiler_thread_id compiler_thread_handle compiler_process_handle;
	| ok
		# prog = {prog & editor.compiling_info=CompilingInfo call_back (CompilerProcess compiler_thread_id compiler_thread_handle compiler_process_handle)};
		= (ok,s,prog);
		= (ok,s,prog);
compile_with_cache path directory arguments prog=:{editor={compiling_info=CompilingInfo call_back (CompilerProcess compiler_thread_id compiler_thread_handle compiler_process_handle)}}
	# (ok,s) = compile_with_cache2 path directory arguments compiler_thread_id compiler_thread_handle compiler_process_handle;
	| 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}}
    # command = quoted_string path +++ " " +++ arguments;
	# (ok,exitcode, os4) = CallProcess command [] "" "" "" "" 99;
	= (ok,exitcode,prog);
/*
	# thread_id=get_current_thread_id;
	# begin_arguments="-ide "+++int_to_hex thread_id;
	# (r,compiler_thread_id,compiler_thread_handle,compiler_process_handle) = start_compiler_process (path+++"\0") (directory+++"\0") (path+++" "+++begin_arguments+++"\0");
	| r==0
		= abort "compile_with_cache 1";
	# (ok,s) = compile_with_cache3 path directory arguments compiler_thread_id compiler_thread_handle compiler_process_handle;
	= (ok,s,prog);

compile_with_cache3 :: {#.Char} {#.Char} {#.Char} Int Int Int -> (!Bool,!Int);
compile_with_cache3 path directory arguments compiler_thread_id compiler_thread_handle compiler_process_handle
	# wm_number=get_message_number;
	# r=send_string_to_thread compiler_thread_id compiler_process_handle wm_number ("cocl "+++arguments+++"\0")
	| r==0
		= abort "compile_with_cache 2";
	# (r,a,s) =get_integers_from_thread_message wm_number compiler_thread_handle;
	| r==0
		= (False,s);
	# r=send_string_to_thread compiler_thread_id compiler_process_handle wm_number ("exit\0")
	| r==0
		= abort "compile_with_cache 4";
	= (True,s);
*/

compile_with_cache2 :: {#.Char} {#.Char} {#.Char} Int Int Int -> (!Bool,!Int);
compile_with_cache2 path directory arguments compiler_thread_id compiler_thread_handle compiler_process_handle
	# wm_number=get_message_number;
	# r=send_string_to_thread compiler_thread_id compiler_process_handle wm_number ("cocl "+++arguments+++"\0")
	| r==0
		= abort "compile_with_cache2";
	# (r,a,s) =get_integers_from_thread_message wm_number compiler_thread_handle;
	| r==0
		= (False,s);
	= (True,s);

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
/*
	| not (if (os4 == 99) didit didit)
		= (errwin (Text_StringsToText (("Cannot run compiler!\n"):!Nil)) prog_ io,"",SyntaxError);
		= (prio2 prog_,abcpath,if (exitcode==0) CompilerOK errors);
*/
	# cocl = startupdir+++toString DirSeparator +++"cocl.exe";
	# (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 +++"cocl.exe");
	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 +++ "\"";

LastStrings	:: !String -> List String;
LastStrings "" = Nil;
LastStrings str
	# string_size=size str;
	| string_size>0 && NewlChar==str.[dec string_size]
		=  str :! Nil;
		=  (str +++ NewlStr) :! Nil;

ReplaceLastChar	:: !String -> String;
ReplaceLastChar str
	| size str>0
		= str := (dec (size str), NewlChar);
		= str;

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


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,_/*errors_and_warnings_read*/,errlist,file3) = ReadErrorAndWarningMessages file2;
		}
	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+++" ";
	};

/* Generates code for the given file:
	1st arg.	function to show error and warning messages of the code generator.
	2nd arg.	generate assembly only?
	3rd arg.	file name of the module to be compiled (must be a full .abc file name).
	4th arg.	code generator options.
	5th arg.	application options.
	6th arg.	program state.
	7th arg.	io state.
	1st result	new program and io state.
	2nd result	path name of the generated .o file.
					Note: on the macintosh the .o file is generated in the standard Clean System
					Files Folder. On Unix, however, the location of the .o depends on the user
					settings.
	3rd result	indication whether code generation was successfull.
*/	

CodeGen	::	!WindowFun !CodeGenerateAsmOrCode !Pathname !CodeGenOptions !ApplicationOptions !ProgState !IO
			-> (!ProgIO, !Pathname, !Bool);
CodeGen wf genAsmOrCode path cgo=:{tp} ao prog=:{editor=editor=:{startupinfo={startupdir}}} io
	# (objpath,io) = accFiles (MakeObjSystemPathname tp path) io;
	  path_without_suffix  =  RemoveSuffix path;
	  command              =  "cg.exe" +++ MakeCodeGenOptionsString genAsmOrCode cgo 
	                                   +++ " " +++ (quoted_string path_without_suffix);
  	  errorsfilename  =  startupdir +++ toString DirSeparator +++ "errors";
	  (didit,exit_code,_)  =  CallProcess command [] "" "" "" errorsfilename 99;
	  
	| not didit
		# (_, prog, io)
			=	OpenNotice (Notice ["Cannot cg.exe\n"] (NoticeButton 0 "OK") []) {editor=editor} io
		=	((prog, io), objpath, False);
//		=  ((prog,io),objpath,False);
	// otherwise
	    =  (prio,objpath,exit_code==0);
			with {
				    ((_, errors_not_empty, error_text), io2)
						            =  accFiles (ReadErrorsAndWarnings errorsfilename) io;
					prio  
					   |  errors_not_empty  =  wf error_text prog io2;   
					                        =  (prog, io2);
				 } 

MakeCodeGenOptionsString genAsmOrCode {ci,cs}
	= checkindex+++checkstack+++genasm;
	{
		checkindex	| ci = " -ci"; = "";
		checkstack	| cs = " -os"; = "";
		genasm		| genAsmOrCode == AsmGeneration
											= " -a";
											= "";
	}

/* Links the given file:
	1st arg.	function to show error and warning messages of the code generator.
	2nd arg.	full path name of the executable.
	3rd arg.	full path name of the '_system' object file.
	4th	arg.	full path names of all the object files.
	5th arg.	default paths.
	6th arg.	application settings.
	7th arg.	full pathnames of object files whose names are retrieved from ".importobj" statements
	8th arg.	full pathnames of libraries whose names are retrieved from ".library" statements
	9th arg.	program state.
	10th arg.	io state.
	1st	result	new program and io state.
	2nd result	indication whether linking was successfull.
*/

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,hs,initial_heap_size,profiling,heap_size_multiple,o,memoryProfilingMinimumHeapSize}
		processor linkOptions
		abcLinkObjFilePaths abcLinkLibraryPaths
		prog=:{editor=editor=:{startupinfo={startupdir}}} io
	# u_options_file_name = startupdir +++ "\\_options.o";
	  flags = ApplicationOptionsToFlags applicationOptions;
	  (options_file_ok,io) = accFiles (write_options_file u_options_file_name flags hs ss initial_heap_size heap_size_multiple memoryProfilingMinimumHeapSize) io;
	| not options_file_ok
		= (winfun (Text_StringsToText ("Could not write the options object file":!Nil)) prog io,False);

	# ((link_ok,link_errors),io) = accFiles link io;
		with
		{
			link files
				=	((link_ok,link_errors),files1);
			{
			  (link_ok,link_errors,files1) = link_xcoff_files [u_options_file_name : object_file_names]
			  													library_file_names path ss (o<>NoConsole) files;
			}
		}
	  (errtext,errlines) = ClipboardToText (list_to_strict_list link_errors);
	| errlines<>0
		= (winfun errtext prog io,link_ok);
		= ((prog,io),link_ok);
	where
	{
	  system_directory_name = RemoveFilename u_system_file_name;
	  defaultLibraries
		| linkOptions.useDefaultLibraries
			= [ system_directory_name +++ "\\kernel_library",
	  			 system_directory_name +++ "\\user_library",
				 system_directory_name +++ "\\gdi_library",
				 system_directory_name +++ "\\comdlg_library"];
		// otherwise
			= [];
	  library_file_names
			=	defaultLibraries
				++ (removeDup (StrictListToList linkOptions.libraries))
				++ (StrictListToList abcLinkLibraryPaths);

	  u_startup0_file_name = system_directory_name +++ "\\_startup0.o";
	  u_startup1_file_name
		| not profiling
	  		= system_directory_name +++ "\\_startup1.o";
		// otherwise
			= system_directory_name +++ "\\_startup1Profile.o";
	  u_startup2_file_name = system_directory_name +++ "\\_startup2.o";
//	  u_library0_file_name = system_directory_name +++ "\\util.obj";
//	  u_library1_file_name = system_directory_name +++ "\\cpicture.obj";
//	  u_library2_file_name = system_directory_name +++ "\\ccrosscall.obj";
//	  u_library3_file_name = system_directory_name +++ "\\cdebug.obj";
	  defaultObjects
			| linkOptions.useDefaultSystemObjects
			  	= u_startup0_file_name:!u_startup1_file_name:!u_startup2_file_name:!u_system_file_name:!
// MW:removed		u_library0_file_name:!u_library1_file_name:!u_library2_file_name:!u_library3_file_name:!
						Nil;
			// otherwise
				= Nil;
	  
	  object_file_names
			=	StrictListToList defaultObjects
				++ StrictListToList paths
				++ (removeDup (StrictListToList linkOptions.extraObjectModules))
				++ (StrictListToList abcLinkObjFilePaths);
	}

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

list_to_strict_list [] = Nil;
list_to_strict_list [e:l] = e:! list_to_strict_list l;

object_paths_to_file_names Nil
	= [];
object_paths_to_file_names (path:!rest)
	= [path : object_paths_to_file_names rest];

Execute	::	!WindowFun !Pathname !ApplicationOptions !ProgState !IO
			-> (!ProgIO, !Bool);
Execute winfun path {o} ps io
	# (didit,_) = WinLaunchApp (quoted_string path) (o<>NoConsole) 99;
	| didit
		= ((ps,io),True);
		= (winfun (Text_StringsToText ("Could not launch the application":!Nil)) ps io,False);

(FWI) infixl;
(FWI) f i :== fwritei i f;

(FWS) infixl;
(FWS) f s :== fwrites s f;

/*
	write_options_file options_file_name flags heap_size stack_size initial_heap_size heap_size_multiple files
		# (opened,file,files) = fopen options_file_name FWriteData files;
		| not opened
			= (False,files);
		# file = file
	// header offset 0
	     FWI     196940 FWI   817729185 FWI         160 FWI          13	FWI   17039360 
	// text section header offset 20
	     FWI 2019914798 FWI         116 FWI           0 FWI           0 FWI          0
	     FWI          0 FWI           0 FWI           0 FWI           0 FWI 1610612768
	 // data section header offset 60
	     FWI 1952539694 FWI          97 FWI           0 FWI           0 FWI          20
	     FWI        140 FWI           0 FWI           0 FWI           0 FWI (-1073741760)
	// bss section header offset 100
	     FWI 1936941614 FWI           0 FWI           0 FWI          20 FWI           0
	     FWI          0 FWI           0 FWI           0 FWI           0 FWI (-1073741696)
	// data section offset 140
	     FWI heap_size  FWI  stack_size FWI       flags FWI initial_heap_size FWI heap_size_multiple
	// symbol table offset 160
	     FWI 1818846766 FWI         101 FWI           0 FWI       65534
	     FWI 1634074983 FWI       25963 FWI           0 FWI           0 FWI           0
	// text symbol
	     FWI 2019914798 FWI         116 FWI           0 FWI           1
	     FWI        259 FWI           0 FWI           0 FWI           0 FWI           0
	// data symbol
	     FWI 1952539694 FWI          97 FWI           0 FWI           2 
	     FWI 0x00140103 FWI           0 FWI           0 FWI           0 FWI           0
	// bss symbol
	     FWI 1936941614 FWI           0 FWI          20 FWI           3
	     FWI        259 FWI           0 FWI           0 FWI           0 FWI           0
	
	     FWI          0 FWI           4 FWI           0 FWI           2
	     FWI          2 FWI  0x000f0000 FWI  0x00040000 FWI      131072 FWI      131072
	     FWI 1634494047 FWI       29543 FWI           8 FWI           2
		 FWI 0x00000002 FWI  0x001e0000 FWI  0x000c0000 FWI      131072 FWI      131072
	     FWI          0 FWI          49 FWI          16 FWI           2
	     FWI 0x00460002
	
	     FWI 0x685f0000 FWI  1601200485 FWI  1702521203 FWI  0x62615f00
	     FWI 1635021663 FWI  1935633251 FWI  0x00657a69
	     FWS "_initial_heap_size\0_heap_size_multiple\0\0";
	 	# (close_ok,files) = fclose file files;
		= (close_ok,files);
*/

IMAGE_SYM_DEBUG 	:== 65534;
IMAGE_SYM_UNDEFINED	:== 0;

// Storage class
IMAGE_SYM_CLASS_NULL		:== 0;
IMAGE_SYM_CLASS_EXTERNAL	:== 2;
IMAGE_SYM_CLASS_STATIC		:== 3;
IMAGE_SYM_CLASS_FILE 		:== 103; 

(FWB) infixl;
(FWB) f c :== fwritec (toChar c) f;

(FWW) infixl;
(FWW) f w :== fwritec (toChar (w >> 8)) (fwritec (toChar w) f);

write_options_file :: !{#.Char} !.Int !.Int !.Int !.Int !.Int !.Int !*a -> !*(!Bool,!*a) | FileSystem a;
write_options_file options_file_name flags heap_size stack_size initial_heap_size heap_size_multiple min_write_heap_size files
	# (opened,file,files) = fopen options_file_name FWriteData files;
	| not opened
		= (False,files);
	# file = file
	
	// header offset 0
		FWW machine_type	
		FWW n_sections	
		FWI time_date_stamp   
		FWI symbol_table_pointer
		FWI n_symbols
		FWW optional_header_size
		FWW characteristics
		
	// text section header offset 20
		FWS ".text\0\0\0"
		FWI text_virtual_size
		FWI text_rva_offset
		FWI text_raw_data_size
		FWI text_raw_data_pointer
		FWI text_relocs_pointer
		FWI text_linenumbers_pointer
		FWW text_n_relocs
		FWW text_n_linenumbers
		FWI text_section_flags
		
	// data section header offset 60
		FWS ".data\0\0\0"
		FWI data_virtual_size
		FWI data_rva_offset
		FWI data_raw_data_size
		FWI data_raw_data_pointer
		FWI data_relocs_pointer
		FWI data_linenumbers_pointer
		FWW data_n_relocs
		FWW data_n_linenumbers
		FWI data_section_flags
		
	// bss section header offset 100
		FWS ".bss\0\0\0\0"
		FWI bss_virtual_size
		FWI bss_rva_offset
		FWI bss_raw_data_size
		FWI bss_raw_data_pointer
		FWI bss_relocs_pointer
		FWI bss_linenumbers_pointer
		FWW bss_n_relocs
		FWW bss_n_linenumbers
		FWI bss_section_flags
		
	// data section offset 140
		FWI heap_size  FWI  stack_size FWI flags FWI initial_heap_size FWI heap_size_multiple FWI min_write_heap_size
		
	// symbol table offset
		// .file at 164
		FWS file_name
		FWI file_value
		FWW file_section_n
		FWW file_type
		FWB file_storage_class
		FWB file_n_aux_sections
		
		// fake (aux to .file) at 182 
		FWS file_aux_name
		FWI	file_aux_value
		FWW file_aux_section_n
		FWW file_aux_type
		FWB file_aux_storage_class
		FWB file_aux_n_aux_sections
		
		// .text at 200
		FWS text_name
		FWI text_value
		FWW text_section_n
		FWW text_type
		FWB	text_storage_class
		FWB	text_n_aux_sections
		
		// null to .text at 214
		FWI text_raw_data_size FWS null_aux_entry
		
		// .data at 236
		FWS data_name
		FWI data_value
		FWW data_section_n
		FWW data_type
		FWB data_storage_class
		FWB data_n_aux_sections
		
		// null to .data at 254
		FWI data_raw_data_size FWS null_aux_entry
		
		// .bss at 272
		FWS bss_name
		FWI bss_value
		FWW bss_section_n
		FWW bss_type
		FWB bss_storage_class
		FWB bss_n_aux_sections
		
		// null to .bss at 290
		FWI bss_raw_data_size FWS null_aux_entry
		
		// _heap_size at 306
		FWI 0 FWI heap_size_offset
		FWI heap_size_value
		FWW heap_size_section_n		
		FWW heap_size_type
		FWB heap_size_class
		FWB heap_size_n_aux_sections
	
		
		// _ab_stack_size at 326
		FWI 0 FWI ab_stack_size_offset
		FWI ab_stack_size_value
		FWW ab_stack_size_section_n
		FWW ab_stack_size_type
		FWB ab_stack_size_class
		FWB ab_stack_size_n_aux_sections
	
				
		// _flags at 344
		FWS flags_name
		FWI flags_value
		FWW flags_section_n
		FWW flags_type
		FWB flags_class
		FWB flags_n_aux_sections
		
		// _initial_heap_size at 362
		FWI	0 FWI initial_heap_size_offset
		FWI initial_heap_size_value
		FWW initial_heap_size_section_n
		FWW initial_heap_size_type
		FWB initial_heap_size_class
		FWB initial_heap_size_n_aux_sections
		
		// _heap_size_multiple at 378
		FWI 0 FWI heap_size_multiple_offset
		FWI heap_size_multiple_value
		FWW heap_size_multiple_section_n
		FWW heap_size_multiple_type
		FWB heap_size_multiple_class
		FWB heap_size_multiple_n_aux_sections
		
		// _min_write_heap_size at 396
		FWI	0 FWI min_write_heap_size_offset
		FWI min_write_heap_size_value
		FWW min_write_heap_size_section_n
		FWW min_write_heap_size_type
		FWB min_write_heap_size_class
		FWB min_write_heap_size_n_aux_sections
		
	// string table at 414
		FWI (size string_table + 4)
		FWS string_table;
	= fclose file files;
where {
	// coff header
	n_sections					= 3;
	machine_type				= 0x14c;
	time_date_stamp				= 817729185;
	symbol_table_pointer		= 164; //160
	n_symbols					= 14;  //13
	optional_header_size		= 0;
	characteristics				= 0x0104;
	
	// .text section
	text_virtual_size			= 0;
	text_rva_offset				= 0;
	text_raw_data_size			= 0;
	text_raw_data_pointer		= 0;
	text_relocs_pointer			= 0;
	text_linenumbers_pointer	= 0;
	text_n_relocs				= 0;
	text_n_linenumbers			= 0;
	text_section_flags			= 0x60000020;
		
	// .data section
	data_virtual_size			= 0;
	data_rva_offset				= 0;
	data_raw_data_size			= 24; //20
	data_raw_data_pointer		= 140;
	data_relocs_pointer			= 0;
	data_linenumbers_pointer	= 0;
	data_n_relocs				= 0;
	data_n_linenumbers			= 0;
	data_section_flags			= 0xc0000040;

	//  .bss section
	bss_virtual_size			= 0;
	bss_rva_offset				= 20;
	bss_raw_data_size			= 0;
	bss_raw_data_pointer		= 0;
	bss_relocs_pointer			= 0;
	bss_linenumbers_pointer		= 0;
	bss_n_relocs				= 0;
	bss_n_linenumbers			= 0;
	bss_section_flags			= 0xc0000080;
	
	//	symbol table
	// entry #1
	file_name					= ".file\0\0\0";
	file_value					= 0;
	file_section_n				= IMAGE_SYM_DEBUG;
	file_type					= 0;
	file_storage_class			= IMAGE_SYM_CLASS_FILE;
	file_n_aux_sections			= 1;
	
	// entry #2
	file_aux_name				= "fake\0\0\0\0";
	file_aux_value				= 0;
	file_aux_section_n			= IMAGE_SYM_UNDEFINED;
	file_aux_type				= 0;
	file_aux_storage_class		= IMAGE_SYM_CLASS_NULL;
	file_aux_n_aux_sections		= 0;
	
	// entry #3: .text
	text_name				= ".text\0\0\0";
	text_value				= 0;
	text_section_n			= 1;
	text_type				= 0;
	text_storage_class		= IMAGE_SYM_CLASS_STATIC;
	text_n_aux_sections		= 1;
	
	// entry #5: .data
	data_name				= ".data\0\0\0";
	data_value				= 0;
	data_section_n			= 2;
	data_type				= 0;
	data_storage_class		= IMAGE_SYM_CLASS_STATIC;
	data_n_aux_sections		= 1;
	
	// entry #7: .bss
	bss_name				= ".bss\0\0\0\0";
	bss_value				= 20;
	bss_section_n			= 3;
	bss_type				= 0;
	bss_storage_class		= IMAGE_SYM_CLASS_STATIC;
	bss_n_aux_sections		= 1;
	
	// entry #9: _heap_size
	heap_size_value 		= 0;							// offset 0 in data section
	heap_size_section_n		= 2;
	heap_size_type			= 0;
	heap_size_class			= IMAGE_SYM_CLASS_EXTERNAL;
	heap_size_n_aux_sections = 0;
	
	// entry #10: _ab_stack_size
	ab_stack_size_value		= 4;							// offset 4 in data section
	ab_stack_size_section_n	= 2;
	ab_stack_size_type		= 0;
	ab_stack_size_class		= IMAGE_SYM_CLASS_EXTERNAL;
	ab_stack_size_n_aux_sections = 0;
	
	// entry #11: _flags
	flags_name				= "_flags\0\0";
	flags_value				= 8;							// offset 8 in data section
	flags_section_n		 	= 2;
	flags_type				= 0;
	flags_class				= IMAGE_SYM_CLASS_EXTERNAL;
	flags_n_aux_sections 	= 0;
	
	// entry #12: _initial_heap_size
	initial_heap_size_value	= 12;							// offset 12 in data section
	initial_heap_size_section_n	= 2;
	initial_heap_size_type	= 0;
	initial_heap_size_class	= IMAGE_SYM_CLASS_EXTERNAL;
	initial_heap_size_n_aux_sections = 0;
	
	// entry #13: _heap_size_multiple
	heap_size_multiple_value = 16;							// offset 16 in data section
	heap_size_multiple_section_n = 2;
	heap_size_multiple_type	= 0;
	heap_size_multiple_class = IMAGE_SYM_CLASS_EXTERNAL;
	heap_size_multiple_n_aux_sections = 0;
	
	// entry #14: _min_write_heap_size
	min_write_heap_size_value	= 20;						// offset 20 in data section
	min_write_heap_size_section_n = 2;
	min_write_heap_size_type	= 0;
	min_write_heap_size_class	= IMAGE_SYM_CLASS_EXTERNAL;
	min_write_heap_size_n_aux_sections = 0;
	
	null_aux_entry				= "\0\0\0\0\0\0\0\0\0\0\0\0\0\0";
	
	string_table
		//      10         20         30		40		   50		 60         70        80 
		// 45678901234 567890123456789 0123456789012345678 90123456789012345678 901234567890123456789 
		= "_heap_size\0_ab_stack_size\0_initial_heap_size\0_heap_size_multiple\0_min_write_heap_size\0";
	
	heap_size_offset			= 4;
	ab_stack_size_offset		= 15;
	initial_heap_size_offset	= 30;
	heap_size_multiple_offset	= 49;
	min_write_heap_size_offset	= 69;
	}		

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

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

ExitCleanCompiler :: !ProgState !IO -> ProgIO;
ExitCleanCompiler prog=:{editor={compiling_info=CompilingInfo call_back (CompilerProcess compiler_thread_id compiler_thread_handle compiler_process_handle)}} io
	# wm_number=get_message_number;
	# r=send_string_to_thread compiler_thread_id compiler_process_handle wm_number ("exit\0")
	| r==0
		= abort "ExitCleanCompiler";
		= ({prog & editor.compiling_info=CompilingInfo call_back NoCompiler},io);
ExitCleanCompiler prog io
	= (prog,io);

//-------------------------------------------------------------

CallProcess :: !String [(!String,!String)] !String !String !String !String !OS -> (!Bool, !Int, !OS);
CallProcess command environment directory stdin stdout stderr os 
  | size command > 0 = (success, exitcode, os`);
                     = (False, -1, os);
where
{
	(commandptr,os1) =  WinMakeCString command os;
    envstring        =  MakeEnvironmentString environment;
	(envptr,os2)     =  case (size envstring == 0) of
						{	True -> (0, os1);
							false -> (WinMakeCString envstring os1);
						}
    (dirptr, os3)    =  case (size directory == 0) of
						{	True -> (0, os2);
							false -> (WinMakeCString directory os2);
						}
	(inptr,  os4)    =  case (size stdin  == 0) of
						{	True -> (0, os3);
							false -> (WinMakeCString stdin  os3);
						}
	(outptr, os5)    =  case (size stdout == 0) of
						{	True -> (0, os4);
							false -> (WinMakeCString stdout os4);
					    }
	(errptr, os6)    =  case (size stderr == 0) of
						{	True -> (0, os5);
							false -> (WinMakeCString stderr os5);
						}
    (success, exitcode, os7) 
	                 =  WinCallProcess commandptr envptr dirptr inptr outptr errptr os6;
	os8              =  WinReleaseCString commandptr os7;
	os9              =  case (envptr == 0) of
						{	True -> os8;
							false ->  (WinReleaseCString envptr os8);
						}
	os10             =  case (dirptr == 0) of
						{	True -> os9;
							false ->  (WinReleaseCString dirptr os9);
						}
	os11             =  case (envptr == 0) of
						{	True -> os10;
							false -> (WinReleaseCString inptr os10);
						}
	os12             =  case (envptr == 0) of
						{	True -> os11;
							false -> (WinReleaseCString outptr os11);
						}
	os`              =  case (envptr == 0) of
						{	True -> os12;
							false -> (WinReleaseCString errptr os12);
						}


	MakeEnvironmentString [] = "";
    MakeEnvironmentString [ (name, value):rest ] = name +++ "=" +++ value +++ "\0" +++ MakeEnvironmentString rest;
  
}

CR :== '\015';
LF :== '\012';

GetClipboardText :: (IOState s) -> (String, IOState s);
GetClipboardText io  
  | i == o  = (text2, io);
            = (text2, io);
where {
  i = 99;
  (text, o) = WinGetClipboardText 99;
  text2     = removecrs text;
  
  removecrs s = remove s 0 d 0;
    where 
    {
      d = createArray (size s - countcrlfs 0 0 s) ' ';

      countcrlfs i c s
        | i >= size s -1               = c;
        | s.[i] == CR && s.[i+1] == LF = countcrlfs (i+2) (c+1) s;
                                       = countcrlfs (i+1) c     s;

      remove :: String Int *String Int -> *String;
      remove s i d j
       | j >= size d || i >= size s   = d;
       | s.[i] == CR && s.[i+1] == LF = remove s (i+1) d j;
                                      = remove s (i+1) { d & [j] = s.[i] } (j+1);
    }
                                                                                              
}

SetClipboardText :: String (IOState s) -> IOState s;
SetClipboardText s io 
 | i == o  = io;
           = io;
where {
  i = 99;
  o = WinSetClipboardText (insertcrs s) 99;

  insertcrs s = insert s 0 d 0;
  where
  {
      d = createArray (size s + countlfs 0 0 s) ' ';
    
      countlfs i c s
        | i>= size s   = c;
        | s.[i] == LF  = countlfs (i+1) (c+1) s;
                       = countlfs (i+1) c     s;
    
      insert :: String Int *String Int -> *String;
      insert s i d j
        | j >= size d && i >= size s  =  d;
        | s.[i] == LF                 =  insert s (i+1) { d & [j] = CR, [j+1] = LF } (j+2);
                                      =  insert s (i+1) { d & [j] = s.[i] } (j+1);
  }
}

InstallDDEHandler :: (String *s -> *((IOState *s) -> (*s, IOState *s))) *s (IOState *s)
                             -> (*s, IOState *s);
InstallDDEHandler funct s iostate = (s,iostate`);
where
{   (adm, os) = UnpackIOStateWithCheck iostate;
    adm`      = { adm & io_ddehandler = funct };
    iostate`  = PackIOState adm` os;
}

/* 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);

InstallClipboardChangedHandler :: (*s -> *((IOState *s) -> (*s, IOState *s))) *s (IOState *s)
                             -> (*s, IOState *s);
InstallClipboardChangedHandler funct s iostate = (s,iostate`);
where
{   (adm, os) = UnpackIOStateWithCheck iostate;
    adm`      = { adm & io_clipboardChange = funct };
    iostate`  = PackIOState adm` os;
}


SystemDependentDevices :: [DeviceSystem ProgState IO];
SystemDependentDevices
	=	[];

SystemDependentInitialIO :: InitialIO ProgState;
SystemDependentInitialIO
	=	[InstallDDEHandler openDDE, InstallClipboardChangedHandler ClipboardChanged, OpenArgVFiles];
	where{
		openDDE fileName
				= OpenFileOrProjectFile (expand_8_3_names_in_path fileName);
	}

OpenArgVFiles :: ProgState IO -> ProgIO;
OpenArgVFiles programState ioState
	=	openFiles commandArgs (programState, ioState);
	where {
		commandArgs
			 =	tl [arg \\ arg <-: getCommandLine];

		openFiles :: [{#Char}] ProgIO -> ProgIO;
		openFiles [] pio
			=	pio;
		openFiles [fileName : fileNames] (p, io)
			=	openFiles fileNames  (OpenFileOrProjectFile (expand_8_3_names_in_path fileName) p io);
	}


EditorDefaultFontsToTry :: [(!FontName, ![FontStyle], !FontSize)];
EditorDefaultFontsToTry
	=	[(fontName, [], 9) \\ fontName <- ["Monaco", "Courier", "Courier New"]];
	
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
	)
