PmCleanSystem.icl 50.4 KB
Newer Older
Diederik van Arkel's avatar
Diederik van Arkel committed
1
2
3
4
5
6
7
implementation module PmCleanSystem

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

//import StdEnv
import StdArray, StdBool, StdChar, StdFunc, StdInt, StdList
Diederik van Arkel's avatar
Diederik van Arkel committed
8
import StdSystem, StdPStClass, StdMisc
Diederik van Arkel's avatar
Diederik van Arkel committed
9
10
import Directory

11
12
import PmCompilerOptions, PmPath, PmProject
from UtilStrictLists import :: List(..), RemoveDup, StrictListToList
Diederik van Arkel's avatar
Diederik van Arkel committed
13
14
15
16
import UtilNewlinesFile
import WriteOptionsFile

from PmParse import IsTypeSpec, IsImportError13, IsImportError20
Diederik van Arkel's avatar
Diederik van Arkel committed
17
from linkargs import ReadLinkErrors,WriteLinkOpts,:: LinkInfo`(..),:: LPathname
Diederik van Arkel's avatar
Diederik van Arkel committed
18
19

import xcoff_linker
20
import mach_o_linker
Diederik van Arkel's avatar
Diederik van Arkel committed
21
22

import ostoolbox
Diederik van Arkel's avatar
Diederik van Arkel committed
23
from files import LaunchApplicationFSSpec, FSMakeFSSpec
Diederik van Arkel's avatar
Diederik van Arkel committed
24
import memory,appleevents
Diederik van Arkel's avatar
Diederik van Arkel committed
25
import Platform
Diederik van Arkel's avatar
Diederik van Arkel committed
26

27
28
from IdeState import getCurrentMeth,::General,::CompileMethod

Diederik van Arkel's avatar
Diederik van Arkel committed
29
30
KAEQueueReply :== 2

Diederik van Arkel's avatar
Diederik van Arkel committed
31
//import StdDebug,dodebug
Diederik van Arkel's avatar
Diederik van Arkel committed
32
//import nodebug
33
//import dodebug
Diederik van Arkel's avatar
Diederik van Arkel committed
34
trace_n _ f :== f
35
trace_n` _ f :== f
Diederik van Arkel's avatar
Diederik van Arkel committed
36
37
38
39
40
41
42
43
44
45
46
47

// For testing update speed...
send_command_to_clean_compiler_cc a b c
	:== send_command_to_clean_compiler a b c
//	= (0,1,"")
send_command_to_clean_compiler_cg a b c
	:== send_command_to_clean_compiler a b c
//	= (0,1,"")
send_command_to_clean_compiler_ca a b c
	:== send_command_to_clean_compiler a b c
//	= (0,0,"")

Diederik van Arkel's avatar
Diederik van Arkel committed
48
49
50
51
standardStaticLibraries :: !Processor !LinkMethod -> List String
standardStaticLibraries processor method
	| ProcessorSuffix processor == ".cxo"	// PowerPC Classic
		= case method of
52
53
54
55
56
57
58
59
60
			LM_Static	-> ("Interface_library" :! "StdC_library" :! "Math_library" :! Nil)
			LM_Dynamic	-> ("Interface_library" :! "StdC_library" :! "Math_library" :! Nil)
	| ProcessorSuffix processor == ".xo"	// PowerPC CFM/PEF
		= case method of
			LM_Static	-> ("Carbon_library" :! "StdC_library" :! Nil)
			LM_Dynamic	-> ("Carbon_library" :! "StdC_library" :! Nil)
	= case method of						// PowerPC dyld/MachO
		LM_Static		-> (Nil)
		LM_Dynamic		-> (Nil)
Diederik van Arkel's avatar
Diederik van Arkel committed
61

Diederik van Arkel's avatar
Diederik van Arkel committed
62
63
standardObjectFiles :: !Bool !Bool !Processor -> List String
standardObjectFiles stack_traces profiling processor
Diederik van Arkel's avatar
Diederik van Arkel committed
64
	| stack_traces
Diederik van Arkel's avatar
Diederik van Arkel committed
65
		= (  MakeObjPathname processor "_startupTrace" :! rest)
Diederik van Arkel's avatar
Diederik van Arkel committed
66
	| profiling
Diederik van Arkel's avatar
Diederik van Arkel committed
67
		= (  MakeObjPathname processor "_startupProfile" :! rest)
68
	// otherwise
Diederik van Arkel's avatar
Diederik van Arkel committed
69
70
71
72
73
74
75
76
77
		= (  MakeObjPathname processor "_startup" :! rest)
where
	rest
		| ProcessorSuffix processor == ".o"	// PowerPC Mach-O
			=  MakeObjPathname processor "_startup2"
			:! MakeObjPathname processor "_startup3" 
			:! MakeObjPathname processor "_system" 
			:! MakeObjPathname processor "_library" 
			:! Nil
78
		// otherwise
Diederik van Arkel's avatar
Diederik van Arkel committed
79
80
81
			=  MakeObjPathname processor "_system" 
			:! MakeObjPathname processor "_library" 
			:! Nil
Diederik van Arkel's avatar
Diederik van Arkel committed
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149

//-- interface to static libraries...

getLibs :: ![String] !*Files -> (!(![String],![String]),!*Files)
getLibs [] files = (([],[]),files)
getLibs [lib:libs] files
	# (errs,slibs,files)		= getLib lib files
	# ((errs`,slibs`),files)	= getLibs libs files
	= ((errs++errs`,slibs++slibs`),files)
getLib lib files
	= ([],[],files)
/* nog niet op mac
	# (errs,slibs,files)	=  OpenArchive lib files
	# slibs					= map RemoveSuffix slibs
	= (errs,slibs,files)
*/

//--

::	CodeGenerateAsmOrCode	= AsmGeneration	| CodeGeneration

instance == CodeGenerateAsmOrCode
where
	(==) :: CodeGenerateAsmOrCode CodeGenerateAsmOrCode -> Bool
	(==) AsmGeneration AsmGeneration
		=	True
	(==) CodeGeneration CodeGeneration
		=	True
	(==) _ _
		=	False

::	CompileOrCheckSyntax	= SyntaxCheck | Compilation

instance == CompileOrCheckSyntax
where
	(==) :: CompileOrCheckSyntax CompileOrCheckSyntax -> Bool
	(==) SyntaxCheck SyntaxCheck
		=	True
	(==) Compilation Compilation
		=	True
	(==) _ _
		=	False

::	CompileClearCache	= ClearCache | Don`tClearCache

instance == CompileClearCache
where
	(==) :: CompileClearCache CompileClearCache -> Bool
	(==) ClearCache ClearCache
		=	True
	(==) Don`tClearCache Don`tClearCache
		=	True
	(==) _ _
		=	False


::	CompilerMsg
	= 	CompilerOK
	| 	SyntaxError
	| 	Patherror Pathname

instance == CompilerMsg
where
	(==) CompilerOK CompilerOK = True
	(==) SyntaxError SyntaxError = True
	(==) (Patherror _) (Patherror _) = True
	(==) _ _ = False
	
Diederik van Arkel's avatar
Diederik van Arkel committed
150
::	WindowFun env :== ([String]) -> env -> env
Diederik van Arkel's avatar
Diederik van Arkel committed
151
152
153

out_file_path :: String Int -> String
out_file_path startupdir slot
154
155
//	=	file_path startupdir "out" slot
	=	file_path TempDir "out" slot
Diederik van Arkel's avatar
Diederik van Arkel committed
156
157
158

errors_file_path :: String Int -> String
errors_file_path startupdir slot
159
160
//	=	file_path startupdir "errors" slot
	=	file_path TempDir "errors" slot
Diederik van Arkel's avatar
Diederik van Arkel committed
161
162
163
164
165
166
167

file_path :: String String Int -> String
file_path startupdir base_name slot
	| slot==0
		=	startupdir +++ toString dirseparator +++ base_name
		=	startupdir +++ toString dirseparator +++ base_name+++toString slot

168
/* Compiles the given file: */	
Diederik van Arkel's avatar
Diederik van Arkel committed
169

170
171
172
173
Compile :: !String !Bool !Bool !(WindowFun *env) !(WindowFun *env) !CompileOrCheckSyntax !Pathname !(List Pathname) !Bool !Bool !Bool
					!CompilerOptions !Pathname !CompilerProcessIds !*env
					-> (!Pathname,!CompilerMsg,!CompilerProcessIds,!*env) | FileEnv env
Compile cocl` use_compiler_process_psn write_module_times errwin typewin compileOrCheckSyntax path paths projectMemoryProfiling
Diederik van Arkel's avatar
Diederik van Arkel committed
174
					projectTimeProfiling projectEagerOrDynamic
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
					co=:{CompilerOptions | listTypes} startupdir compiler_psns ps
	# (cocl,name,signature)	= mangleCompiler cocl` startupdir	// platform dependant mangling...
	# command
		= cocl +++ clear_cache_option +++ write_module_times_string
			+++ MakeCompilerOptionsString
					compileOrCheckSyntax
					projectMemoryProfiling
					projectTimeProfiling
					projectEagerOrDynamic
					co
        	+++ " -sl"
        	+++ " -P " +++ quoted_string (ConcatenatePath paths)
			+++ " " +++ quoted_string path
			+++ " > "+++ quoted_string out_file_name
			+++ " \xb3 "+++ quoted_string errors_file_name	// \xb3 == >= ligature

	# (error_code,error_n,ss,compiler_psns,ps) =
		if use_compiler_process_psn
			(send_command_to_clean_compiler_using_slot name command 0 compiler_psns ps)
			(let (error_code,error_n,ss) = send_command_to_clean_compiler_cc signature name command Wait
			 in (error_code,error_n,ss,compiler_psns,ps)
			)
Diederik van Arkel's avatar
Diederik van Arkel committed
197
	| error_code <> 0 =
198
199
		("",SyntaxError,compiler_psns
		,errwin (	[ "Error: Unable to run compiler: "+++cocl
Diederik van Arkel's avatar
Diederik van Arkel committed
200
201
202
203
204
205
206
207
208
					+++ "; "+++ toString error_code
					+++ "; "+++ toString error_n
					+++ "; "+++ ss
					]) ps
		)
	#	((type_text_not_empty,type_text),ps)
						= accFiles (ReadTypesInfo (listTypes<>NoTypes) out_file_name) ps
		((errors,errors_and_messages_not_empty,errors_and_messages),ps)
						= accFiles (ReadErrorsAndWarnings errors_file_name) ps
Diederik van Arkel's avatar
Diederik van Arkel committed
209
210
//		(abcpath,ps)	= accFiles (MakeABCSystemPathname path) ps
		abcpath			= MakeABCSystemPathname path
Diederik van Arkel's avatar
Diederik van Arkel committed
211
212
213
214
215
216
		ps				= case errors_and_messages_not_empty of
							True	-> trace_n "errwin" errwin (StrictListToList errors_and_messages) ps
							False	-> trace_n "ok" ps
		ps				= case type_text_not_empty of
							True	-> typewin (StrictListToList type_text) ps
							False	-> ps
217
     = (abcpath,if (error_n==1) CompilerOK errors,compiler_psns,ps)
Diederik van Arkel's avatar
Diederik van Arkel committed
218
219
220
221
where

	clearCache = Don`tClearCache	// needs to be arg to compile command???
	write_module_times_string = if write_module_times " -wmt " " "
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
	out_file_name
		= out_file_path startupdir 0
	errors_file_name
		= errors_file_path startupdir 0
	clear_cache_option
		| clearCache == Don`tClearCache
			= ""
		= " -clear_cache"

CompileStartCommand :: !String !Bool !(WindowFun *env) !CompileOrCheckSyntax !Pathname !(List Pathname) !Int !Bool !Bool !Bool
				!CompilerOptions !Pathname !CompilerProcessIds !*env
								-> (!Bool, !CompilerProcessIds,!*env) | FileEnv env
CompileStartCommand cocl write_module_times errwin compileOrCheckSyntax path paths slot projectMemoryProfiling projectTimeProfiling projectEagerOrDynamic
					co=:{CompilerOptions | listTypes} startupdir compiler_psns ps
					
	# (cocl,compiler_full_path,signature) = mangleCompiler cocl startupdir
	# (error_code,error_n,compiler_psns,ps) = send_command_to_clean_compiler_without_waiting_for_reply_using_psn compiler_full_path command slot compiler_psns ps
	| error_code <> 0
		= ( False, compiler_psns,
			errwin ([ "Error: Unable to run compiler: "+++cocl
					+++ "; "+++ toString error_code
					+++ "; "+++ toString error_n
					]) ps
		)
     = (True,compiler_psns,ps)
where
	write_module_times_string = if write_module_times " -wmt " " "
	clearCache = Don`tClearCache	// needs to be arg to compile command???
Diederik van Arkel's avatar
Diederik van Arkel committed
250
	command
251
252
253
		= "cocl"
			+++" -id "+++toString slot
			+++clear_cache_option +++ write_module_times_string
Diederik van Arkel's avatar
Diederik van Arkel committed
254
255
256
257
258
259
260
261
262
263
264
265
			+++ MakeCompilerOptionsString
					compileOrCheckSyntax
					projectMemoryProfiling
					projectTimeProfiling
					projectEagerOrDynamic
					co
        	+++ " -sl"
        	+++ " -P " +++ quoted_string (ConcatenatePath paths)
			+++ " " +++ quoted_string path
			+++ " > "+++ quoted_string out_file_name
			+++ " \xb3 "+++ quoted_string errors_file_name	// \xb3 == >= ligature
	out_file_name
266
		= out_file_path startupdir slot
Diederik van Arkel's avatar
Diederik van Arkel committed
267
	errors_file_name
268
		= errors_file_path startupdir slot
Diederik van Arkel's avatar
Diederik van Arkel committed
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
	clear_cache_option
		| clearCache == Don`tClearCache
			= ""
		= " -clear_cache"

ConcatenatePath :: (List Pathname) -> String
/* old version
ConcatenatePath Nil             = ""
ConcatenatePath (path :! rest ) = path +++ ";" +++ ConcatenatePath rest
*/
ConcatenatePath ss
	# s = createArray (sSize ss) ','
	= sUpdate 0 s ss
where
	sSize Nil = 0
	sSize (string :! Nil) = size string
	sSize (string :! rest) = size string + 1 + sSize rest
	
	sUpdate i s Nil = s
	sUpdate i s (string :! Nil)
		# (_,s) = sU (size string) i 0 s string
		= s
	sUpdate i s (string :! rest)
		# (i,s) = sU (size string) i 0 s string
		# i = inc i
		= sUpdate i s rest
	
	sU l i j s h
		| j >= l = (i,s)
		# s = update s i h.[j]
		= sU l (inc i) (inc j) s h

ReadTypesInfo :: !Bool !Pathname !*Files -> ((!Bool,!(List String)),!*Files)
ReadTypesInfo readtypes	path env
	| not readtypes
		= ((False,Nil),env)
305
	#	(opened,file,env)			= fopen path FReadText env
Diederik van Arkel's avatar
Diederik van Arkel committed
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
	| not opened
		= ((False,Nil),env)
	#	(typelist,types_read,file`)	= ReadTypeMsg file
		(_,env)						= fclose file` env
	= ((types_read,typelist),env)
	

ReadTypeMsg :: !*File -> (!List String,!Bool,!*File)
ReadTypeMsg file
	#	(string,file)					= freadline file
		(eof,file)						= fend file
	| eof && IsTypeSpec string
		= (Strip string :! Nil,True,file) // DvA (LastStrings string,True,file)
	| eof
		= (Nil,False,file)
	#	(typeslist,types_read,file)	= ReadTypeMsg file
	= (Strip string :! typeslist,types_read,file) // DvA (ReplaceLastChar string :! typeslist,types_read,file)

Strip "" = ""
Strip s
	#! last = dec (size s)
	#! char = s.[last]
	| char == '\n' || char == '\r'
		= Strip (s % (0,dec last))
	= s

ReadErrorsAndWarnings :: !Pathname !*Files -> ((!CompilerMsg, !Bool, !(List String)), !*Files)
ReadErrorsAndWarnings path env
334
	#	(opened,file,env)	= fopen path FReadText env
Diederik van Arkel's avatar
Diederik van Arkel committed
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
	| not opened
		= ((SyntaxError,False,Nil),env)
	#	(errors,errors_and_warnings_read,errlist,file`) = ReadErrorAndWarningMessages file
		(_,env) = fclose file` env
	= ((errors,errors_and_warnings_read,errlist),env)
	

ReadErrorAndWarningMessages :: !*File -> (!CompilerMsg,!Bool,!List String,!*File)
ReadErrorAndWarningMessages file
	#!	(string, file1)					= freadline file
		(eof,file2)						= fend file1
		(is_import_error13,path13)		= IsImportError13 string
		(is_import_error20,path20)		= IsImportError20 string
	# (is_import_error,path) = case is_import_error13 of
			True	-> (is_import_error13,path13)
			_		-> (is_import_error20,path20)
	| eof
		#!	not_empty_or_newline 		= (size string)<>0 && string.[0]<>'\n'
		= (if is_import_error (Patherror path) SyntaxError,not_empty_or_newline,Strip string :! Nil,file2)
	#	(path_error,_/*errors_and_warnings_read*/,errlist,file3) = ReadErrorAndWarningMessages file2
	= (if is_import_error (Patherror path) path_error,True,Strip string:!errlist,file3)


MakeCompilerOptionsString :: !CompileOrCheckSyntax !Bool !Bool !Bool !CompilerOptions -> String
MakeCompilerOptionsString compileOrCheckSyntax projectMemoryProfiling projectTimeProfiling projectEagerOrDynamic
			{neverMemoryProfile, neverTimeProfile,sa,gw,gc,listTypes,attr,reuseUniqueNodes}
	= options
where 
	memoryProfileSwitch
		| (not neverMemoryProfile && projectMemoryProfiling)
		|| projectEagerOrDynamic
			= " -desc"		// of " -pm" vroeger???
			= ""
	timeProfileSwitch
		| not neverTimeProfile && projectTimeProfiling
			= " -pt"
			= ""
	dynamicLinkSwitch
		| projectEagerOrDynamic
			= " -exl"
			= ""
	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"
			= ""
	reuse
		| reuseUniqueNodes
			= " -ou"
			= ""

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

/* Generates code for the given file:
*/	
415
416
417
SwitchDebugMachO tp symbolic_machO normal :== case toString tp of
//	"PowerPC_MachO"	-> symbolic_machO
	_				-> normal
Diederik van Arkel's avatar
Diederik van Arkel committed
418

419
420
421
422
CodeGen	::	!String !Bool !(WindowFun *(PSt .l)) !CodeGenerateAsmOrCode !Pathname !Bool !CodeGenOptions !Processor !ApplicationOptions !Pathname
								!CompilerProcessIds !*(PSt .l)
			-> (!Pathname,!Bool,!CompilerProcessIds,!*(PSt .l))
CodeGen cgen` use_compiler_process_psn wf genAsmOrCode path timeprofile cgo tp ao startupdir compiler_psns ps
423
	# genAsmOrCode` = SwitchDebugMachO tp AsmGeneration genAsmOrCode
424
	# (cgen,name,signature)	= mangleGenerator cgen` startupdir
Diederik van Arkel's avatar
Diederik van Arkel committed
425
	#	objpath				= MakeObjSystemPathname tp path
Diederik van Arkel's avatar
Diederik van Arkel committed
426
		path_without_suffix	= RemoveSuffix path
427
428
429
430
		out_file_name
			= out_file_path startupdir 0
		errors_file_name
			= errors_file_path startupdir 0
431
		command				= cgen +++ MakeCodeGenOptionsString genAsmOrCode` timeprofile cgo 
Diederik van Arkel's avatar
Diederik van Arkel committed
432
								+++ " " +++ (quoted_string path_without_suffix)
433
434
								+++ " > " +++ quoted_string out_file_name 
								+++ " \xb3 " +++ quoted_string errors_file_name
435
436
437
438
439
440
441
  	# (error_code,error_n,output_string,compiler_psns,ps) =
  		if use_compiler_process_psn
			(send_command_to_clean_compiler_using_slot name command 0 compiler_psns ps)
			(let (error_code,error_n,ss) = send_command_to_clean_compiler_cg signature name command Wait
			 in (error_code,error_n,ss,compiler_psns,ps)
			)
  			
Diederik van Arkel's avatar
Diederik van Arkel committed
442
  	| error_code <> 0
443
		= (objpath, False,compiler_psns,wf ["Error: Unable to run code generator: "+++toString error_code] ps)
Diederik van Arkel's avatar
Diederik van Arkel committed
444

445
446
447
	| size output_string <> 0
		= (objpath, error_n == 0,compiler_psns,wf [ output_string, "Code generator called as: '" +++ command +++ "'"] ps)
		
Diederik van Arkel's avatar
Diederik van Arkel committed
448
	| error_n <> 0
449
		= (objpath, False,compiler_psns,wf [ "Error: Code generator: "+++toString error_n] ps)
Diederik van Arkel's avatar
Diederik van Arkel committed
450
	
451
452
453
454
455
456
	= SwitchDebugMachO tp
		(case genAsmOrCode of
			AsmGeneration	-> (ps,objpath,True)
			_
				# assembly_file_name = to_unix_path (RemoveSuffix objpath+++".a");
				# object_file_name = to_unix_path objpath;
457
				# (r1,r2,ps) = send_command_to_application False "EXEC"
458
459
460
461
462
463
					(	"/usr/bin/as '"
					+++	assembly_file_name
					+++	"' -o '"
					+++	object_file_name
					+++	"'"
					+++ " -g"	// for symbolic debugging info...
464
					) out_file_name ps
465
				-> (objpath,r1==r1,ps)
466
		)
467
		(objpath,True,compiler_psns,ps)
Diederik van Arkel's avatar
Diederik van Arkel committed
468

469
470
471
472
473
StartCodeGenerator	::	!String !(WindowFun *(PSt .l)) !CodeGenerateAsmOrCode !Pathname !Int !Bool !CodeGenOptions !Processor !ApplicationOptions !Pathname
						!CompilerProcessIds !*(PSt .l)
	-> (!Bool,!Pathname,!CompilerProcessIds,!*(PSt .l))
StartCodeGenerator cgen` wf genAsmOrCode path slot timeprofile cgo tp ao startupdir compiler_psns ps
	# (cgen,code_generator_full_path,signature) = mangleGenerator cgen` startupdir
Diederik van Arkel's avatar
Diederik van Arkel committed
474
	# objpath			= MakeObjSystemPathname tp path
Diederik van Arkel's avatar
Diederik van Arkel committed
475
	  path_without_suffix	= RemoveSuffix path
476
477
478
479
480
481
482
483
	  out_file_name = out_file_path startupdir slot
	  errors_file_name = errors_file_path startupdir slot
	  command		= cgen
						+++" -id "+++toString slot
						+++ MakeCodeGenOptionsString genAsmOrCode /*False*/timeprofile cgo
						+++ " " +++ (quoted_string path_without_suffix)
						+++ " > " +++ quoted_string out_file_name
						+++ " \xb3 " +++ quoted_string errors_file_name
484
	# (error_code,error_n,compiler_psns,ps) = send_command_to_clean_compiler_without_waiting_for_reply_using_psn code_generator_full_path command slot compiler_psns ps
Diederik van Arkel's avatar
Diederik van Arkel committed
485
  	| error_code<>0
486
		# ps = wf ["Error: Unable to run code generator: "+++toString error_code] ps
487
488
489
490
491
		= (False,objpath,compiler_psns,ps)
//	| size output_string <> 0
//		# ps = wf [output_string] ps
//		= (error_n == 0,objpath,compiler_psns,ps)
	= (error_n==0,objpath,compiler_psns,ps)
Diederik van Arkel's avatar
Diederik van Arkel committed
492
493

MakeCodeGenOptionsString genAsmOrCode timeprofile {ci,cs}
Diederik van Arkel's avatar
Diederik van Arkel committed
494
	= checkindex+++checkstack+++genasm	//+++timeProfileSwitch
Diederik van Arkel's avatar
Diederik van Arkel committed
495
496
497
498
499
500
501
where
	checkindex	| ci = " -ci"; = ""
	checkstack	| cs = " -os"; = ""
	timeProfileSwitch | timeprofile= " -pt"; = ""
	genasm		= case genAsmOrCode of
						AsmGeneration -> " -a"
						_ -> ""
502

Diederik van Arkel's avatar
Diederik van Arkel committed
503
504
505
506
507
/* Links the given file:
*/

Link ::	!String !(WindowFun *(PSt .l)) !Pathname !ApplicationOptions
		!Pathname !(List Pathname) !(List Pathname) !(List Pathname) !Bool 
508
		!Bool !Bool !Bool !String !Bool !String !Pathname !String !Processor !Bool !*(PSt .l)
Diederik van Arkel's avatar
Diederik van Arkel committed
509
510
511
512
513
		 -> (!*(PSt .l),!Bool)
Link linker` winfun path
		applicationOptions=:{fs,fn,em,ss,hs,initial_heap_size,profiling,heap_size_multiple,o,memoryProfilingMinimumHeapSize=minheap}
		optionspathname library_file_names object_file_names
		static_libraries static gen_relocs gen_linkmap
514
		link_resources resource_path gen_dll dll_names startupdir dynlinker processor use_64_bit_processor /*add_carb_resource*/ ps
Diederik van Arkel's avatar
Diederik van Arkel committed
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
	# (ok,linker)				= mangleLinker linker` startupdir
	| not ok
		# ps					= winfun [linker] ps
		= (ps,False)
	# flags						= ApplicationOptionsToFlags applicationOptions
	# optdirpath				= RemoveFilename optionspathname
	# ((ok,pd_optdirpath),ps)	= pd_StringToPath optdirpath ps
	| not ok
		= (winfun ["Linker error: Unable to understand path: "+++optdirpath] ps,False)
	# ((err,_),ps)				= getDirectoryContents pd_optdirpath ps
	# (err,ps)					= case err of
									DoesntExist -> createDirectory pd_optdirpath ps
									err  -> (err,ps)
	| err <> NoDirError
		= (winfun ["Linker error: Unable to access or create: "+++optdirpath] ps,False)
	# (options_file_ok,ps)		= accFiles (write_options_file optionspathname flags hs ss initial_heap_size heap_size_multiple minheap) ps
	| not options_file_ok
		= (winfun ["Linker error: Could not write the options object file: "+++optionspathname] ps,False)
	# linkopts =
		{ exe_path				= path
		, res_path				= ""
		, open_console			= o <> NoConsole
		, static_link			= static
		, gen_relocs			= gen_relocs
		, gen_linkmap			= gen_linkmap
		, link_resources		= False
		, object_paths			= /*optionspathname :!*/ (RemoveDup object_file_names)
	  	, dynamic_libs			= RemoveDup library_file_names
	  	, static_libs			= RemoveDup static_libraries
	  	, stack_size			= ss
	  	, gen_dll				= gen_dll
	  	, dll_names				= dll_names
Diederik van Arkel's avatar
Diederik van Arkel committed
547
	  	, dynamics_path			= ""
Diederik van Arkel's avatar
Diederik van Arkel committed
548
549
	  	}
	# linkerpath				= RemoveFilename linker
Diederik van Arkel's avatar
Diederik van Arkel committed
550
551
	# linkoptspath				= MakeFullPathname TempDir "linkopts"
	# linkerrspath				= MakeFullPathname TempDir "linkerrs"
552
	# linker_out_o_path			= MakeFullPathname TempDir "linker_out.o"
Diederik van Arkel's avatar
Diederik van Arkel committed
553
554
555
556
	# (err,ps)					= accFiles (WriteLinkOpts linkoptspath linkopts) ps
	| isJust err
		= (winfun (fromJust err) ps,False)

557
558
559
	# objectFileNames			= StrictListToList (RemoveDup object_file_names)
	# libraryFileNames			= StrictListToList (RemoveDup library_file_names)
	# staticFileNames			= StrictListToList (RemoveDup static_libraries)
Diederik van Arkel's avatar
Diederik van Arkel committed
560
	
Diederik van Arkel's avatar
Diederik van Arkel committed
561
562
	| isEmpty objectFileNames
		= (winfun ["Linker error: No objects to link."] ps,False)
Diederik van Arkel's avatar
Diederik van Arkel committed
563
564
//	| isMachOObject (hd objectFileNames)
	| ProcessorSuffix processor == ".o"
565
		# ((ok,errs),ps)	= accFiles (link_mach_o_files` (objectFileNames ++ staticFileNames) linker_out_o_path) ps
566
		# command	=
Diederik van Arkel's avatar
Diederik van Arkel committed
567
			(	"/usr/bin/cc "
568
/*
Diederik van Arkel's avatar
Diederik van Arkel committed
569
			+++	concat_object_file_names objectFileNames
570
571
			+++	concat_object_file_names staticFileNames
*/
572
			+++	"'" +++ to_unix_path linker_out_o_path +++ "'"
Diederik van Arkel's avatar
Diederik van Arkel committed
573
			+++	" -framework Carbon"
574
			+++	" -o '"+++ to_unix_path path +++ "'"
575
//			+++ " -g"	// for debugging syms
576
577
			+++ "-Xlinker -stack_addr -Xlinker 0xc0000000 -Xlinker -stack_size -Xlinker 0x"+++stack_size_aligned_4k_hex_string
//			+++ if (ss > standard_mosx_stack) (" -stack-size " +++ stack_size_aligned_4k_hex_string) ""		
578
			+++ if (size linker`<>0) (" "+++linker`) ""
579
580
581
582
583
584
		//	+++ " -L/sw/lib -lgtk-x11-2.0 -lgdk-x11-2.0 -latk-1.0 -lgdk_pixbuf-2.0"	// 
		//	+++ " -lm -lpangoxft-1.0 -lpangox-1.0 -lpango-1.0 -lgobject-2.0 -lgmodule-2.0 -lglib-2.0 -lintl -liconv "
		//	+++ " -lpangoft2-1.0 "
			)
		# (r1,r2,ps) = send_command_to_application False "EXEC"
			command (to_unix_path linkerrspath/*startupdir +++ "/linker_out"*/) ps;
Diederik van Arkel's avatar
Diederik van Arkel committed
585
	
586
587
588
589
		| r1==(-1)
			= (winfun ["Linker error: Could not start the linker (/usr/bin/cc)."] ps,False)
		| r2<>0
			# ((errtext_not_empty,errtext),ps) = accFiles (ReadLinkInfo linkerrspath) ps;
590
591
592
593
594
			= (winfun
				[ "Linker error: Linker returned with error code: " +++toString r2
				, command
				: StrictListToList errtext
				] ps, False)
595
596
597
598
599
600
		// otherwise
		# application_existed = False;
		# (resources_ok,ps) = accFiles (create_application_resource path MachO application_existed (fs,fn) hs heap_size_multiple ss flags
										0 initial_heap_size minheap) ps
		# ((errtext_not_empty,errtext),ps) = accFiles (ReadLinkInfo linkerrspath) ps;
		= (winfun (StrictListToList errtext) ps, True)
Diederik van Arkel's avatar
Diederik van Arkel committed
601
602
	# ((link_ok,link_errors),ps)
		=	accFiles (link_xcoff_files objectFileNames libraryFileNames path
Diederik van Arkel's avatar
Diederik van Arkel committed
603
				(fs,fn) hs heap_size_multiple ss flags em initial_heap_size minheap False (if (ProcessorSuffix processor == ".xo") True False)/*add_carb_resource*/) ps
Diederik van Arkel's avatar
Diederik van Arkel committed
604
605
606
607
608
	# (errtext,errlines)	= (link_errors, length link_errors);

	| errlines<>0
		= (winfun errtext ps,link_ok)
	=  (ps,link_ok)
609
where
610
	stack_size_aligned_4k_hex_string = hex_int (roundup_to_multiple ss 4096)
611
612
	standard_mosx_stack = 0x080000	// 512K

613
614
615
616
link_mach_o_files` o_files app_path files
	# (ok,errs,files)	= link_mach_o_files o_files app_path files
	= ((ok,errs),files)
	
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
// from ExtInt module in pc linker
roundup_to_multiple s m :== (s + (dec m)) bitand (~m);

hexdigit :: !Int -> Char;
hexdigit i
	| i<10
		= toChar (toInt '0'+i);
		= toChar (toInt 'A'+i-10);

hex :: !Int -> String;
hex i
	#! i1 
		=(i bitand 0xf0) >> 4;
	#! i2
		=i bitand 0xf;
	= toString (hexdigit i1)+++toString (hexdigit i2);
	
hex_int :: !Int -> String;
hex_int i
	#! b0 
		= hex (i bitand 0x000000ff);
	#! b1
		= hex ((i bitand 0x0000ff00) >> 8);
	#! b2 
		= hex ((i bitand 0x00ff0000) >> 16);
	#! b3
		= hex ((i bitand 0xff000000) >> 24);
	= /*"0x" +++ */ b3 +++ b2 +++ b1 +++ b0;

646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
ReadLinkInfo :: !Pathname !*Files -> ((!Bool, !List String), !*Files)
ReadLinkInfo path env
	#	(opened,file,env)			= fopen path FReadData env
	| not opened
		= ((False,Nil),env)
	#	(errlist,errors,file`)		= ReadLinkMsg file
		(_,env)						= fclose file` env
	= ((errors,errlist),env)
	
ReadLinkMsg :: !*File -> (!List String,!Bool,!*File)
ReadLinkMsg file
	#	(string,file)					= freadline file
		(eof,file)						= fend file
	| eof && IsLinkerErrorMsg string
		= (Strip string :! Nil,True,file)
	| eof
		= (Nil,False,file)
	#	(errmsg,_,file)	= ReadLinkMsg file
	= (Strip string :! errmsg,True,file)

// IsLinkerErrorMsg :: !String -> Bool;
IsLinkerErrorMsg str :== not (LayOut 0 (size str) str);
where
	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]

678
//
Diederik van Arkel's avatar
Diederik van Arkel committed
679
680
681
682
683
684
685
686
687
688
689

isMachOObject object = equal_suffix ".o" object

concat_object_file_names [file_name:file_names]
	= " '"+++to_unix_path file_name+++"'"+++concat_object_file_names file_names;
concat_object_file_names []
	= "";

import linker_resources;
import code from
//	"call_system_framework.o";
Diederik van Arkel's avatar
Diederik van Arkel committed
690
691
//	"call_system_framework.","pointer_glue."
	"cUtilSystem."
Diederik van Arkel's avatar
Diederik van Arkel committed
692
693
694
695
696
697
698
699

to_unix_path p
	# inpath	= p +++ "\0"
	# bsize		= 256
	# buffer	= createArray bsize '\0'
	# (res,_)	= hfs2posix inpath buffer bsize OSNewToolbox
	| res <> 0
		# posix	= toString (takeWhile ((<>) '\0') [c \\ c <-: buffer])
Diederik van Arkel's avatar
Diederik van Arkel committed
700
		= trace_n ("Path",posix) posix
701

702
703
704
705
706
707
fork_execv_waitpid :: !String !String -> (!Int,!Int);
fork_execv_waitpid s stdout_file_name
	= code {
		ccall fork_execv_waitpid "ss:II"
	};

708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
fork_execv_pid :: !String -> (!Int,!Int);
fork_execv_pid s
	= code {
		ccall fork_execv_pid "s:II"
	};

GetProcessForPID :: !Int -> (!Int,!PSN);
GetProcessForPID pid
	# psn_string = createArray 8 '\0';
	# result = GetProcessForPID_ pid psn_string;
	| result==0
		= (result,string_to_psn psn_string);
		= (result,{highLongOfPSN=0,lowLongOfPSN=0});
	where
		GetProcessForPID_ :: !Int !{#Char} -> Int;
		GetProcessForPID_ pid psn_string
			= code {
				ccall GetProcessForPID "Is:I"
			}

728
729
send_command_to_application :: !Bool !String !String !String !*env -> (!Int,!Int,!*env);
send_command_to_application _ _ s stdout_file_name env
730
731
	# (r,status)=fork_execv_waitpid (s+++"\0") (stdout_file_name+++"\0");
	| r==(-1)
732
		= (-1,-1,env);
733
	| status bitand 0177<>0
734
735
		= (-1,status,env);
		= (0,status>>8,env);
Diederik van Arkel's avatar
Diederik van Arkel committed
736

Diederik van Arkel's avatar
Diederik van Arkel committed
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
/*
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}} ps
	# (u_startup_file_name,ps)
		= accFiles (MakeObjSystemPathname CurrentProcessor (MakeFullPathname system_directory_name startupModuleName)) ps
	# (u_library_object_file_name,ps)
		=	accFiles (MakeObjSystemPathname CurrentProcessor (MakeFullPathname system_directory_name "_library")) ps

	# ((link_ok,link_errors),ps)
		=	accFiles link ps
	# (errtext,errlines)	= StringToText (ListToStrictList link_errors);
	| errlines<>0
		= (winfun errtext prog ps,link_ok);
		= ((prog,ps),link_ok);
where
	link f = ((result, message), file)
	where
		(result, message, file)
			= link_xcoff_files objectFileNames libraryFileNames (MakeExecPathname path)
				(fs,fn) hs heap_size_multiple ss flags em initial_heap_size memoryProfilingMinimumHeapSize False f;


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

	startupModuleName
		| not profiling
			=	"_startup";
		| profiling601
			=	"_startupProfile601";
		| otherwise
			=	"_startupProfile";

	defaultObjects
		| linkOptions.useDefaultSystemObjects
			=	[u_startup_file_name, u_system_file_name, u_library_object_file_name];
		// otherwise
			=	[];

	libraryFileNames
		=	removeDup (defaultLibraries ++ (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;
*/

DynLink :: !String !String !String !*(PSt .l) -> (Bool,*PSt .l)
DynLink linker prj_path startupdir ps
	= (False,ps)

//--- EXECUTE

802
Execute	::	!(WindowFun *env) !Pathname !ApplicationOptions !*env -> (!*env, !Bool)
Diederik van Arkel's avatar
Diederik van Arkel committed
803
Execute winfun path _ ps
Diederik van Arkel's avatar
Diederik van Arkel committed
804
	# (error_n,ps)	= Launch path ps
Diederik van Arkel's avatar
Diederik van Arkel committed
805
806
807
808
	| error_n >= 0
		= (ps,True)
		= (winfun ["Could not launch the application, MacOS error: "+++toString error_n] ps,False)

Diederik van Arkel's avatar
Diederik van Arkel committed
809
810
Launch :: !{#Char} !.a -> (!Int, !.a)
Launch execpath env
Diederik van Arkel's avatar
Diederik van Arkel committed
811
812
813
814
	# (error_n,fsspec,tb)	= FSMakeFSSpec execpath OSNewToolbox
	| error_n <> 0 = (error_n,env)
	# (error_n,tb)			= LaunchApplicationFSSpec fsspec 0xC800 tb
//	# (error_n,_) = LaunchApplication execpath 0xC8000000 OSNewToolbox
Diederik van Arkel's avatar
Diederik van Arkel committed
815
816
	= (error_n, env)

Diederik van Arkel's avatar
Diederik van Arkel committed
817
818
819
820
821
Execute` ::	!String !*env -> (!Bool,!Int,!*env)
Execute` execpath env
	# (ec,env)	= Launch execpath env
	= (ec==0,ec,env)

Diederik van Arkel's avatar
Diederik van Arkel committed
822
823
//--- OTHER STUFF

824
QuitCleanCompiler :: !Bool !CompilerProcessIds !*(IOSt .l) -> *(IOSt .l)
Diederik van Arkel's avatar
Diederik van Arkel committed
825
826
// want to quit all launched Compilers in any env...???
// means we need to keep track of these somehow.
827
QuitCleanCompiler False _ io
828
	# signature = "C2Co"//CleanCompilerSignature	// XOXOXOX
Diederik van Arkel's avatar
Diederik van Arkel committed
829
830
831
	| send_quit_event_to_clean_compiler signature == 0
		= io;
		= io;
832
833
834
835
836
837
838
839
840
841
QuitCleanCompiler True compile_psns io
	= quit_clean_compilers compile_psns io
	where
		quit_clean_compilers [compiler_psn:compiler_psns] io
			# os_error_code = send_quit_event_to_clean_compiler_using_psn compiler_psn
			| os_error_code==0
				= quit_clean_compilers compiler_psns io
				= quit_clean_compilers compiler_psns io
		quit_clean_compilers [] io
			= io
Diederik van Arkel's avatar
Diederik van Arkel committed
842
843

// necessary for Mac version?!
Diederik van Arkel's avatar
Diederik van Arkel committed
844
845
ClearCompilerCache :: !String !String !.a -> (!Int,!.a)
ClearCompilerCache cocl startupdir ps
846
	# (cocl,name,signature)	= mangleCompiler cocl startupdir	// platform dependant mangling...
Diederik van Arkel's avatar
Diederik van Arkel committed
847
//	# (os_error_code,_,_)	= send_command_to_clean_compiler_ca signature name "cocl -clear_cache" Wait
Diederik van Arkel's avatar
Diederik van Arkel committed
848
849
850
	# (os_error_code,_,_)	= send_command_to_clean_compiler_ca signature name "clear_cache" Wait
	= (os_error_code,ps)

851
852
853
854
855
856
857
858
859
860
:: PSN = {highLongOfPSN::!Int,lowLongOfPSN::!Int};

:: CompilerProcessIds :== [PSN];

NoCompilerProcessIds :: CompilerProcessIds
NoCompilerProcessIds = [];

ClearCompilerCaches :: !CompilerProcessIds !.a -> (!Int,!.a)
ClearCompilerCaches compiler_psns ps
	# os_error_code = clear_compiler_caches compiler_psns 0
Diederik van Arkel's avatar
Diederik van Arkel committed
861
		with
862
863
864
865
866
867
868
			clear_compiler_caches [compiler_psn:compiler_psns] previous_os_error_code
				# (os_error_code,_,_)	= send_command_to_clean_compiler_using_psn "clear_cache" compiler_psn
				| os_error_code==0 || previous_os_error_code<>0
					= clear_compiler_caches compiler_psns previous_os_error_code
					= clear_compiler_caches compiler_psns os_error_code
			clear_compiler_caches [] previous_os_error_code
				= previous_os_error_code
Diederik van Arkel's avatar
Diederik van Arkel committed
869
870
871
872
873
874
875
876
877
878
879
880
881
882
	= (os_error_code,ps)

SendRepeatResult :: !Int !.a -> (!Int,!.a)
SendRepeatResult compiler_n ps
  	#  name					= CleanCompilerName
  	#  signature				= clean_compiler_signature compiler_n
	# (os_error_code,_,_) = send_command_to_clean_compiler signature name "repeat_result" NoWait
	= (os_error_code,ps)

Wait :== True
NoWait :== False

send_command_to_clean_compiler :: !String !String !String !Bool -> (!Int,!Int,!String);
send_command_to_clean_compiler signature name command wait_for_reply
Diederik van Arkel's avatar
Diederik van Arkel committed
883
884
	# (os_error_code,error_n,output_string,tb)
		= send_command_to_clean_compiler0 signature command wait_for_reply OSNewToolbox
Diederik van Arkel's avatar
Diederik van Arkel committed
885
886
	| error_n<>(-2)
		= (os_error_code,error_n,output_string);
Diederik van Arkel's avatar
Diederik van Arkel committed
887
888
889
890
891
892
893

	# (error_n,fsspec,tb)	= FSMakeFSSpec name tb
	| error_n <> 0
		= (error_n,-2,output_string)
	# (launch_error_n,tb)	= LaunchApplicationFSSpec fsspec 0xCA00 tb
//	# (launch_error_n,_)
//		= LaunchApplication name 0xCA000000 OSNewToolbox;	// Hangs under OS X?
Diederik van Arkel's avatar
Diederik van Arkel committed
894
	| launch_error_n>=0	
Diederik van Arkel's avatar
Diederik van Arkel committed
895
896
897
898
		# (os_error_code,error_n,output_string,tb)
			= send_command_to_clean_compiler0 signature command wait_for_reply tb
		= (os_error_code,error_n,output_string)
	= (os_error_code,-2,output_string);
Diederik van Arkel's avatar
Diederik van Arkel committed
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920

//--

import UtilPatch
	
PatchableCleanCompilerSignature
	:== "#$@CLCOSIGNAT%*&ClCo\0";
CleanCompilerSignature
	=: PatchableValue "CLCOSIGNAT" PatchableCleanCompilerSignature;

PatchableCleanCompilerName
	:== "#$@CLCONAME  %*&Clean Compiler\0............................some extra space for long names (total 128 chars).......................";
CleanCompilerName
	=: PatchableValue "CLCONAME  " PatchableCleanCompilerName;

clean_compiler_signature slot
	| slot==0
		= CleanCompilerSignature
		# s=CleanCompilerSignature
		= {s.[0],s.[1],s.[2],toChar (slot+48)}

//--
Diederik van Arkel's avatar
Diederik van Arkel committed
921
922
import events
KAEApplicationDied	:== 0x6F626974; // 'obit'
Diederik van Arkel's avatar
Diederik van Arkel committed
923

Diederik van Arkel's avatar
Diederik van Arkel committed
924
925
send_command_to_clean_compiler0 :: !String !String !Bool !*OSToolbox -> (!Int,!Int,!String,!*OSToolbox);
send_command_to_clean_compiler0 signature command wait tb
Diederik van Arkel's avatar
Diederik van Arkel committed
926
	| error_code1<>0
Diederik van Arkel's avatar
Diederik van Arkel committed
927
		= (error_code1,-1,"NewPtr failed",tb);
Diederik van Arkel's avatar
Diederik van Arkel committed
928
929
//	# error_code2 = AECreateDesc TypeApplSignature "MPSX" descriptor; // Tool Server
	# error_code2
Diederik van Arkel's avatar
Diederik van Arkel committed
930
		= trace_n "AECreateDesc" AECreateDesc TypeApplSignature signature descriptor;
Diederik van Arkel's avatar
Diederik van Arkel committed
931
	| error_code2<>0
Diederik van Arkel's avatar
Diederik van Arkel committed
932
		= (free_memory error_code2,-1,"AECreateDesc failed",tb);
Diederik van Arkel's avatar
Diederik van Arkel committed
933
	# error_code3
Diederik van Arkel's avatar
Diederik van Arkel committed
934
		= trace_n "AECreateAppleEvent" AECreateAppleEvent KAEMiscStandards KAEDoScript descriptor KAutoGenerateReturnID KAnyTransactionID apple_event;
Diederik van Arkel's avatar
Diederik van Arkel committed
935
	| error_code3<>0
Diederik van Arkel's avatar
Diederik van Arkel committed
936
		= (free_descriptor_and_memory error_code3,-1,"AECreateAppleEvent failed",tb);
Diederik van Arkel's avatar
Diederik van Arkel committed
937
	# error_code4
Diederik van Arkel's avatar
Diederik van Arkel committed
938
		= trace_n "AEPutParamPtr" AEPutParamPtr apple_event KeyDirectObject TypeChar command;
Diederik van Arkel's avatar
Diederik van Arkel committed
939
	| error_code4<>0
Diederik van Arkel's avatar
Diederik van Arkel committed
940
		= (free_apple_event_and_desciptor_and_memory error_code4,-1,"AEPutParamPtr failed",tb);
Diederik van Arkel's avatar
Diederik van Arkel committed
941
942
	# error_code5
		= case wait of
Diederik van Arkel's avatar
Diederik van Arkel committed
943
			True -> trace_n "AESend wait" AESend apple_event result_apple_event KAEWaitReply KAENormalPriority KNoTimeOut 0 0;
Diederik van Arkel's avatar
Diederik van Arkel committed
944
//			True -> loop OSNewToolbox;
Diederik van Arkel's avatar
Diederik van Arkel committed
945
946
947
			_	 -> trace_n "AESend nowait" AESend apple_event 0 KAEQueueReply KAENormalPriority KNoTimeOut 0 0;
	| error_code5==(-600)
		= (free_apple_event_and_desciptor_and_memory error_code5,-2,"AESend failed",tb);
Diederik van Arkel's avatar
Diederik van Arkel committed
948
	| error_code5==(-609)
Diederik van Arkel's avatar
Diederik van Arkel committed
949
		= (free_apple_event_and_desciptor_and_memory error_code5,-2,"AESend failed",tb);
Diederik van Arkel's avatar
Diederik van Arkel committed
950
	| error_code5==(-903)
Diederik van Arkel's avatar
Diederik van Arkel committed
951
		= (free_apple_event_and_desciptor_and_memory error_code5,-2,"need to add HighLevel event aware to SIZE resource of IDE...",tb);
Diederik van Arkel's avatar
Diederik van Arkel committed
952
	| error_code5==(-1712)
Diederik van Arkel's avatar
Diederik van Arkel committed
953
		= (free_apple_event_and_desciptor_and_memory error_code5,-1,"AESend failed; Application died",tb);
Diederik van Arkel's avatar
Diederik van Arkel committed
954
	| error_code5<>0
Diederik van Arkel's avatar
Diederik van Arkel committed
955
		= (free_apple_event_and_desciptor_and_memory error_code5,-1,"AESend failed",tb);
Diederik van Arkel's avatar
Diederik van Arkel committed
956
	| not wait
Diederik van Arkel's avatar
Diederik van Arkel committed
957
		= (free_apple_event_and_desciptor_and_memory error_code5,0,"",tb);
Diederik van Arkel's avatar
Diederik van Arkel committed
958
	# (error_code6,_,v1,_)
Diederik van Arkel's avatar
Diederik van Arkel committed
959
		= trace_n "AEGetIntParamPtr" AEGetIntParamPtr result_apple_event KeyErrorNumber TypeLongInteger;
Diederik van Arkel's avatar
Diederik van Arkel committed
960
	# (error_code7,_,s2)
Diederik van Arkel's avatar
Diederik van Arkel committed
961
		= trace_n "AEGetStringParamPtr" AEGetStringParamPtr result_apple_event KeyErrorString TypeChar result_string;
Diederik van Arkel's avatar
Diederik van Arkel committed
962
	# os_error_code
Diederik van Arkel's avatar
Diederik van Arkel committed
963
		= trace_n "fraeaaeadam" free_result_apple_event_and_apple_event_and_desciptor_and_memory error_code6 error_code7
Diederik van Arkel's avatar
Diederik van Arkel committed
964
	# error_n
Diederik van Arkel's avatar
Diederik van Arkel committed
965
966
//		= if (error_code6<0) 0 v1
		= if (error_code6<>0) 0 v1
Diederik van Arkel's avatar
Diederik van Arkel committed
967
968
	# output_string
		= if (error_code7<>0) "" (result_string % (0,s2-1))
Diederik van Arkel's avatar
Diederik van Arkel committed
969
	# tb = trace_n ("CALL",error_code6,v1,error_code7,s2) tb
Diederik van Arkel's avatar
Diederik van Arkel committed
970
	= (os_error_code,error_n,output_string,tb)
Diederik van Arkel's avatar
Diederik van Arkel committed
971
where
Diederik van Arkel's avatar
Diederik van Arkel committed
972
	loop tb
Diederik van Arkel's avatar
Diederik van Arkel committed
973
		# err	= AESend apple_event result_apple_event KAEWaitReply KAENormalPriority (60) 0 0;
Diederik van Arkel's avatar
Diederik van Arkel committed
974
975
976
977
978
979
		| err==(-1712)
			# (avail,what,message,when,wherex,wherey,modifiers,tb) = EventAvail NetworkMask tb
			| avail && what == HighLevelEvent && message == KCoreEventClass && wherex == KAEApplicationDied
				= -1712
			= loop tb
		= err
Diederik van Arkel's avatar
Diederik van Arkel committed
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
	result_string = createArray 5120 '0';

	(memory,error_code1,_)
		= NewPtr (SizeOfAEDesc+SizeOfAppleEvent+SizeOfAppleEvent) 0;
	descriptor
		= memory;
	apple_event
		= memory+SizeOfAEDesc;
	result_apple_event
		= memory+SizeOfAEDesc+SizeOfAppleEvent;

	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;
	where
		free_error_code = AEDisposeDesc 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 = AEDisposeDesc 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 = AEDisposeDesc descriptor;

	free_memory error_code
		| error_code==0
			= if (free_error_code==255) 0 free_error_code;
		| free_error_code==0
			= error_code;
			= error_code;
	where
		(free_error_code,_)	= DisposPtr memory 0;

1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
send_command_to_clean_compiler_using_psn :: !String !PSN -> (!Int,!Int,!String);
send_command_to_clean_compiler_using_psn command psn
	# (memory,error_code1,_) = NewPtr (SizeOfAEDesc+SizeOfAppleEvent+SizeOfAppleEvent) 0;
	| error_code1<>0
		= (error_code1,-1,"");
	# descriptor=memory;
	# error_code2 = AECreateDesc TypeProcessSerialNumber (psn_to_string psn) descriptor;
	| error_code2<>0
		= (free_memory memory error_code2 0,-1,"");
	# apple_event=memory+SizeOfAEDesc;
	# error_code3 = AECreateAppleEvent KAEMiscStandards KAEDoScript descriptor KAutoGenerateReturnID KAnyTransactionID apple_event;
	| error_code3<>0
		= (free_descriptor_and_memory descriptor memory error_code3 0,-1,"");
	# error_code4 = AEPutParamPtr apple_event KeyDirectObject TypeChar command;
	| error_code4<>0
		= (free_apple_event_and_desciptor_and_memory apple_event descriptor memory error_code4 0,-1,"");
	# result_apple_event=memory+SizeOfAEDesc+SizeOfAppleEvent;
	# error_code5 = AESend apple_event result_apple_event KAEWaitReply KAENormalPriority KNoTimeOut 0 0;
	| error_code5==(-609)
		= (free_apple_event_and_desciptor_and_memory apple_event descriptor memory error_code5 0,-2,"");
	| error_code5==(-903)
		= (free_apple_event_and_desciptor_and_memory apple_event descriptor memory error_code5 0,-2,"need to add HighLevel event aware to SIZ resorce of IDE...");
	| error_code5<>0
		= (free_apple_event_and_desciptor_and_memory apple_event descriptor memory error_code5 0,-1,"");
		# (error_code6,_,v1,_) = AEGetIntParamPtr result_apple_event KeyErrorNumber TypeLongInteger;
		# result_string = createArray 5120 '0';
		# (error_code7,_,s2) = AEGetStringParamPtr result_apple_event KeyErrorString TypeChar result_string;
		= (free_result_apple_event_and_apple_event_and_desciptor_and_memory result_apple_event apple_event descriptor memory error_code6 error_code7,
			if (error_code6<0) 0 v1,
			if (error_code7<>0) "" (result_string % (0,s2-1)));

send_command_to_clean_compiler_using_slot :: !String !String !Int ![PSN] !*e -> (!Int,!Int,!String,![PSN],!*e) | FileEnv e;
send_command_to_clean_compiler_using_slot compiler_full_path command slot compiler_psns ps
	# (os_error_code,psn,compiler_psns,ps) = get_compiler_psn compiler_full_path slot compiler_psns ps
	| os_error_code<>0
		= (os_error_code,-1,"",compiler_psns,ps);
	# (os_error_code,error_n,result_string)=send_command_to_clean_compiler_using_psn command psn;
	| error_n<>(-2)
		= (os_error_code,error_n,result_string,compiler_psns,ps);
		= (os_error_code,-1,result_string,compiler_psns,ps);

from UtilIO import GetFullApplicationPath;

send_command_to_clean_compiler_without_waiting_for_reply_using_psn :: !String !String !Int ![PSN] !*e -> (!Int,!Int,![PSN],!*e) | FileEnv e;
send_command_to_clean_compiler_without_waiting_for_reply_using_psn compiler_full_path command slot compiler_psns ps
	# (os_error_code,psn,compiler_psns,ps) = get_compiler_psn compiler_full_path slot compiler_psns ps
	| os_error_code<>0
		= (os_error_code,-1,compiler_psns,ps);
	# (os_error_code,error_n)=send_command_to_clean_compiler_without_waiting_for_reply_using_psn0 command psn;
	| error_n<>(-2)
		= (os_error_code,error_n,compiler_psns,ps);
		= (os_error_code,-1,compiler_psns,ps);

get_compiler_psn :: !String !Int [.PSN] !*e -> (!Int,!PSN,![PSN],!*e) | FileEnv e;
get_compiler_psn compiler_full_path slot compiler_psns ps
	| slot<length compiler_psns
		= (0,compiler_psns !! slot,compiler_psns,ps);
	# (result,psn,ps) = start_compiler compiler_full_path ps;
	| result<>0
		= (result,{highLongOfPSN=0,lowLongOfPSN=0},compiler_psns,ps);
		= (0,psn,compiler_psns++[psn],ps);

start_compiler :: !String !*e -> (!Int,!PSN,!*e) | FileEnv e;
start_compiler compiler_full_path ps
	# clean_compiler_file_name = "'"+++to_unix_path compiler_full_path+++"'"
1089
	# (result,pid) = fork_execv_pid (clean_compiler_file_name+++" -stdwin"+++"\0")
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
1129
1130
1131
1132
1133
1134
1135
1136
1137
1138
1139
1140
1141
1142
1143
1144
1145
1146
1147
1148
1149
1150
1151
1152
1153
1154
1155
1156
1157
1158
1159
1160
1161
1162
1163
	| result<>0
		= (result,{highLongOfPSN=0,lowLongOfPSN=0},ps);
	= GetProcessForPID_ pid ps;
		with
			GetProcessForPID_ pid ps
				# (result,psn) = GetProcessForPID pid;
				| result== -600
					= GetProcessForPID_ pid ps
					= (result,psn,ps)

send_command_to_clean_compiler_without_waiting_for_reply_using_psn0 :: !String !PSN -> (!Int,!Int);
send_command_to_clean_compiler_without_waiting_for_reply_using_psn0 command psn
	# (memory,error_code1,_) = NewPtr (SizeOfAEDesc+SizeOfAppleEvent+SizeOfAppleEvent) 0;
	| error_code1<>0
		= (error_code1,-1);
	# descriptor=memory;
	# error_code2 = AECreateDesc TypeProcessSerialNumber (psn_to_string psn) descriptor;
	| error_code2<>0
		= (free_memory memory error_code2 0,-1);
	# apple_event=memory+SizeOfAEDesc;
	# error_code3 = AECreateAppleEvent KAEMiscStandards KAEDoScript descriptor KAutoGenerateReturnID KAnyTransactionID apple_event;
	| error_code3<>0
		= (free_descriptor_and_memory descriptor memory error_code3 0,-1);
	# error_code4 = AEPutParamPtr apple_event KeyDirectObject TypeChar command;
	| error_code4<>0
		= (free_apple_event_and_desciptor_and_memory apple_event descriptor memory error_code4 0,-1);
	# result_apple_event=memory+SizeOfAEDesc+SizeOfAppleEvent;
	# error_code5 = AESend apple_event 0/*result_apple_event*/ KAEQueueReply KAENormalPriority KNoTimeOut 0 0;
	| error_code5==(-609)
		= (free_apple_event_and_desciptor_and_memory apple_event descriptor memory error_code5 0,-2);
	| error_code5==(-903)
		= (free_apple_event_and_desciptor_and_memory apple_event descriptor memory error_code5 0,-2);
	| error_code5<>0
		= (free_apple_event_and_desciptor_and_memory apple_event descriptor memory error_code5 0,-1);
		= (free_apple_event_and_desciptor_and_memory apple_event descriptor memory error_code5 0,0);

free_result_apple_event_and_apple_event_and_desciptor_and_memory result_apple_event apple_event descriptor memory error_code6 error_code7
	# free_error_code = AEDisposeDesc result_apple_event;
	| error_code6==error_code6 && error_code7==error_code7
		= free_apple_event_and_desciptor_and_memory apple_event descriptor memory free_error_code 0;

free_apple_event_and_desciptor_and_memory apple_event descriptor memory error_code t
	# free_error_code = AEDisposeDesc apple_event;
	| error_code==0
		= free_descriptor_and_memory descriptor memory free_error_code t;
	| free_error_code==0
		= free_descriptor_and_memory descriptor memory error_code t;
		= free_descriptor_and_memory descriptor memory error_code t;

free_descriptor_and_memory descriptor memory error_code t
	# free_error_code = AEDisposeDesc descriptor;
	| error_code==0
		= free_memory memory free_error_code t;
	| free_error_code==0
		= free_memory memory error_code t;
		= free_memory memory error_code t;

free_memory memory error_code t
	# (free_error_code,_) = DisposPtr memory t;
	| error_code==0
		= if (free_error_code==255) 0 free_error_code;
	| free_error_code==0
		= error_code;
		= error_code;

psn_to_string {highLongOfPSN,lowLongOfPSN}
	= {	toChar (highLongOfPSN>>24),toChar (highLongOfPSN>>16),toChar (highLongOfPSN>>8),toChar highLongOfPSN,
		toChar (lowLongOfPSN>>24),toChar (lowLongOfPSN>>16),toChar (lowLongOfPSN>>8),toChar lowLongOfPSN };

string_to_psn psn_string
	= {	highLongOfPSN = (toInt psn_string.[0]<<24) bitor (toInt psn_string.[1]<<16) bitor (toInt psn_string.[2]<<8) bitor (toInt psn_string.[3]),
		lowLongOfPSN  = (toInt psn_string.[4]<<24) bitor (toInt psn_string.[5]<<16) bitor (toInt psn_string.[6]<<8) bitor (toInt psn_string.[7])
	  };

Diederik van Arkel's avatar
Diederik van Arkel committed
1164
1165
1166
1167
1168
1169
1170
1171
1172
DisposPtr p t
	# t = DisposePtr p t
	= MemError t
where
	MemError :: !*Toolbox -> (!Int,!*Toolbox)
	MemError _ = code {
		ccall MemError "P:I:I"
		}

Diederik van Arkel's avatar
Diederik van Arkel committed
1173
1174
send_quit_event_to_clean_compiler :: !String -> Int;
send_quit_event_to_clean_compiler signature
1175
1176
1177
1178
1179
1180
1181
1182
1183
1184
1185
1186
1187
1188
1189
	# (memory,error_code1,_) = NewPtr (SizeOfAEDesc+SizeOfAppleEvent+SizeOfAppleEvent) 0;
	  descriptor=memory;
	  apple_event=memory+SizeOfAEDesc;
	  result_apple_event=memory+SizeOfAEDesc+SizeOfAppleEvent;
	| error_code1<>0
		= error_code1;
	# error_code2 = AECreateDesc TypeApplSignature signature descriptor;
	= send_quit_event_to_clean_compiler_ error_code2 descriptor apple_event result_apple_event memory 

send_quit_event_to_clean_compiler_using_psn :: !PSN -> Int;
send_quit_event_to_clean_compiler_using_psn psn
	# (memory,error_code1,_) = NewPtr (SizeOfAEDesc+SizeOfAppleEvent+SizeOfAppleEvent) 0;
	  descriptor=memory;
	  apple_event=memory+SizeOfAEDesc;
	  result_apple_event=memory+SizeOfAEDesc+SizeOfAppleEvent;
Diederik van Arkel's avatar
Diederik van Arkel committed
1190
1191
	| error_code1<>0
		= error_code1;
1192
1193
1194
1195
	# error_code2 = AECreateDesc TypeProcessSerialNumber (psn_to_string psn) descriptor;
	= send_quit_event_to_clean_compiler_ error_code2 descriptor apple_event result_apple_event memory 

send_quit_event_to_clean_compiler_ error_code2 descriptor apple_event result_apple_event memory 
Diederik van Arkel's avatar
Diederik van Arkel committed
1196
	| error_code2<>0
1197
1198
		= free_memory memory error_code2 0;
	# error_code3 = AECreateAppleEvent KCoreEventClass KAEQuitApplication descriptor KAutoGenerateReturnID KAnyTransactionID apple_event;
Diederik van Arkel's avatar
Diederik van Arkel committed
1199
	| error_code3<>0
1200
1201
		= free_descriptor_and_memory descriptor memory error_code3 0;
	# error_code4 = AESend apple_event result_apple_event KAENoReply KAENormalPriority KNoTimeOut 0 0;
Diederik van Arkel's avatar
Diederik van Arkel committed
1202
	| error_code4<>0
1203
1204
		= free_apple_event_and_desciptor_and_memory apple_event descriptor memory error_code4 0;
		= free_apple_event_and_desciptor_and_memory apple_event descriptor memory error_code4 0;
Diederik van Arkel's avatar
Diederik van Arkel committed
1205
1206
1207
1208
1209
1210
1211
1212
1213

//--

import StdMaybe

:: ThreadId
	:==	Int

CompileHandleExitCode :: !Int !String !String !Int !(WindowFun *env) !(WindowFun *env) !Pathname
1214
				!ListTypes !*env -> (!Pathname,!CompilerMsg,!*env) | FileEnv env
Diederik van Arkel's avatar
Diederik van Arkel committed
1215
1216
1217
1218
1219
1220
1221
CompileHandleExitCode exitcode cocl startupdir slot errwin typewin path listTypes ps
	# out_file_name = out_file_path startupdir slot
	# errors_file_name = errors_file_path startupdir slot
	#	((type_text_not_empty,type_text),ps)
						= accFiles (ReadTypesInfo (listTypes<>NoTypes) out_file_name) ps
		((errors,errors_and_messages_not_empty,errors_and_messages),ps)
						= accFiles (ReadErrorsAndWarnings errors_file_name) ps
Diederik van Arkel's avatar
Diederik van Arkel committed
1222
1223
//		(abcpath,ps)	= accFiles (MakeABCSystemPathname path) ps
		abcpath			= MakeABCSystemPathname path
Diederik van Arkel's avatar
Diederik van Arkel committed
1224
1225
1226
1227
1228
1229
		ps				= case errors_and_messages_not_empty of
							True	-> trace_n "errwin" errwin (StrictListToList errors_and_messages) ps
							False	-> trace_n "ok" ps
		ps				= case type_text_not_empty of
							True	-> typewin (StrictListToList type_text) ps
							False	-> ps
1230
     = (abcpath,if (exitcode==1) CompilerOK errors,ps)
Diederik van Arkel's avatar
Diederik van Arkel committed
1231
1232
1233
1234
1235
1236
1237
1238
1239
1240
1241
1242
1243
1244
1245
1246
1247
1248
1249

:: CompilePollCompletedResult = NoFinishedCompiler | UnknownFinishedCompiler | FinishedCompiler !Int !Int

CompilePollCompleted :: !*env -> (!CompilePollCompletedResult, !*env) | FileEnv env
CompilePollCompleted env
	# (compiler_id,exit_code) = get_finished_compiler_id_and_exit_code
	| compiler_id<0
		| exit_code==1
			= (UnknownFinishedCompiler,env)
			= (NoFinishedCompiler,env)
		= (FinishedCompiler compiler_id exit_code,env);

get_finished_compiler_id_and_exit_code :: (!Int/*compiler_id*/,!Int/*exit_code*/);
get_finished_compiler_id_and_exit_code = code {
	ccall get_finished_compiler_id_and_exit_code ":II"
 }

:: CompilingInfo = CompilingInfo

Diederik van Arkel's avatar
Diederik van Arkel committed
1250
InitCompilingInfo :: *CompilingInfo
Diederik van Arkel's avatar
Diederik van Arkel committed
1251
1252
1253
1254
1255
1256
1257
1258
1259
1260
1261
1262
1263
1264
1265
1266
1267
1268
1269
1270
1271
1272
1273
1274
InitCompilingInfo = CompilingInfo

ExitCleanCompiler :: !*(!*CompilingInfo,*env) -> *(!*CompilingInfo,*env)
ExitCleanCompiler (i,e) = (i,e)

CompilePersistent ::
	!String					// cocl
	!Bool
	!(WindowFun *env)		// errwin
	!(WindowFun *env)		// typewin
	!CompileOrCheckSyntax	// compileOrCheckSyntax
	!Pathname				// path
	!(List Pathname)		// paths
	!Bool					// projectHeapProfiling
	!Bool					// projectTimeProfiling
	!Bool					// projectEagerOrDynamic
	!CompilerOptions		// compileroptions
	!Pathname				// startupdir
	!*CompilingInfo			// compiler state
	!*env					// env
	-> (!*CompilingInfo,!(!*env, !Pathname, !CompilerMsg))
	| FileEnv env
CompilePersistent cocl write_module_times errwin typewin compileOrCheckSyntax path paths projectHeapProfiling projectTimeProfiling
	projectEagerOrDynamic compileroptions startupdir state env
1275
	= (state,(errwin ["Error: Persistent not supported."] env,"",SyntaxError))
Diederik van Arkel's avatar
Diederik van Arkel committed
1276
1277
1278
1279
1280
1281
1282
1283
1284
1285

//--

from UtilIO import GetShortPathName
from DodoUtil import sSplit

mangleCompiler ccstring startupdir
	# (name,rest)			= sSplit ';' ccstring
	# (sign,cocl)			= sSplit ';' rest
	# name = case name of
1286
1287
				""	-> startupdir +++ toString dirseparator +++ "Clean Compiler"//\0"
				n	-> startupdir +++ toString dirseparator +++ n
Diederik van Arkel's avatar
Diederik van Arkel committed
1288
1289
1290
1291
1292
1293
	# sign = case sign of
				""	-> "ClCo"//\0"
				s	-> s
	# cocl = case cocl of
				""	-> "cocl"
				c	-> c
1294
1295
	= (cocl,name,sign)

Diederik van Arkel's avatar
Diederik van Arkel committed
1296
1297
1298
1299
mangleGenerator cgstring startupdir
	# (name,rest)			= sSplit ';' cgstring
	# (sign,cgen)			= sSplit ';' rest
	# name = case name of
1300
1301
				""	-> startupdir +++ toString dirseparator +++ "Clean Compiler"//\0"
				n	-> startupdir +++ toString dirseparator +++ n
Diederik van Arkel's avatar
Diederik van Arkel committed
1302
1303
1304
1305
1306
1307
	# sign = case sign of
				""	-> "ClCo"//\0"
				s	-> s
	# cgen = case cgen of
				""	-> "cg"
				c	-> c
1308
	= (cgen,name,sign)
Diederik van Arkel's avatar
Diederik van Arkel committed
1309
1310
1311
1312
1313
1314
1315
1316
1317
1318
1319
1320
1321
1322
1323
1324
1325
1326
1327
1328
1329
1330
1331
1332
1333
1334
1335
1336
1337
1338
1339
1340

mangleLinker linkstr` startupdir
	# (linkstr`,opts)		= splitOptions linkstr`
	# (shortOK,linkstr)		= GetShortPathName (startupdir +++ toString dirseparator +++ linkstr` +++ "\0")
	| not shortOK
		# line				= "Error: Unable to get short path name '" +++ (startupdir +++ toString dirseparator +++ linkstr`) +++ "'."
		= (False,line)
	# linkstr = linkstr % (0, size linkstr - 2) +++ opts
	= (True,linkstr)

splitOptions str
	| first_q >= len_str	= (str,"")
	| last_q >= len_str		= (first_str,"")
	= (first_str,last_str)
where
	first_str =  str%(0,dec first_q)
	last_str = str % (inc first_q, dec last_q)

	len_str = size str
	
	first_q			= FindQuoteChar str len_str 0
	last_q			= FindQuoteChar str len_str (inc first_q)
		
	//	FindQuoteChar	:: !String !Int !Int -> Int;
	FindQuoteChar str len pos	= FindChar '\"' str len pos;

	FindChar	:: !Char !.String !.Int !Int -> Int;
	FindChar c line linelen pos
		| pos >= linelen		=  pos;
		| c ==  line.[pos]		=  pos;
								=  FindChar c line linelen (inc pos);
	
Diederik van Arkel's avatar
Diederik van Arkel committed
1341
//////
Diederik van Arkel's avatar
Diederik van Arkel committed