1 {
2 This unit is the interface of the compiler which can be used by
3 external programs to link in the compiler
4
5 Copyright (c) 1998-2005 by Florian Klaempfl
6
7 This program is free software; you can redistribute it and/or modify
8 it under the terms of the GNU General Public License as published by
9 the Free Software Foundation; either version 2 of the License, or
10 (at your option) any later version.
11
12 This program is distributed in the hope that it will be useful,
13 but WITHOUT ANY WARRANTY; without even the implied warranty of
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 GNU General Public License for more details.
16
17 You should have received a copy of the GNU General Public License
18 along with this program; if not, write to the Free Software
19 Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
20
21 ****************************************************************************}
22
23 unit compiler;
24
25 {$i fpcdefs.inc}
26
27 { some units are implicitly needed by the compiler }
28 {$WARN 5023 off : Unit "$1" not used in $2}
29
30 interface
31
32 uses
33 {$ifdef GO32V2}
34 emu387,
35 {$endif GO32V2}
36 {$ifdef WATCOM}
37 emu387,
38 {$endif WATCOM}
39 {$if defined(unix) and (FPC_FULLVERSION>20700)}
40 { system code page stuff for unix }
41 unixcp,
42 fpwidestring,
43 {$endif}
44 {$IFNDEF USE_FAKE_SYSUTILS}
45 sysutils,math,
46 {$ELSE}
47 fksysutl,
48 {$ENDIF}
49 verbose,comphook,systems,
50 cutils,cfileutl,cclasses,globals,options,fmodule,parser,symtable,
51 assemble,link,dbgbase,import,export,tokens,wpo
52 { cpu parameter handling }
53 ,cpupara
54 { procinfo stuff }
55 ,cpupi
56 { cpu codegenerator }
57 ,cgcpu
58 {$ifndef NOPASS2}
59 ,cpunode
60 {$endif}
61 { cpu targets }
62 ,cputarg
63 {$ifdef llvm}
64 ,llvmtarg
65 {$endif llvm}
66 { system information for source system }
67 { the information about the target os }
68 { are pulled in by the t_* units }
69 {$ifdef amiga}
70 ,i_amiga
71 {$endif amiga}
72 {$ifdef android}
73 ,i_android
74 {$endif android}
75 {$ifdef aros}
76 ,i_aros
77 {$endif}
78 {$ifdef atari}
79 ,i_atari
80 {$endif atari}
81 {$ifdef beos}
82 ,i_beos
83 {$endif beos}
84 {$ifdef bsd}
85 {$ifdef darwin}
86 ,i_darwin
87 {$else darwin}
88 ,i_bsd
89 {$endif darwin}
90 {$endif bsd}
91 {$ifdef gba}
92 ,i_gba
93 {$endif gba}
94 {$ifdef go32v2}
95 ,i_go32v2
96 {$endif go32v2}
97 {$ifdef haiku}
98 ,i_haiku
99 {$endif haiku}
100 {$ifdef linux}
101 ,i_linux
102 {$endif linux}
103 {$ifdef macos}
104 ,i_macos
105 {$endif macos}
106 {$ifdef morphos}
107 ,i_morph
108 {$endif morphos}
109 {$ifdef nds}
110 ,i_nds
111 {$endif nds}
112 {$ifdef nwm}
113 ,i_nwm
114 {$endif nwm}
115 {$ifdef nwl}
116 ,i_nwl
117 {$endif nwm}
118 {$ifdef os2}
119 {$ifdef emx}
120 ,i_emx
121 {$else emx}
122 ,i_os2
123 {$endif emx}
124 {$endif os2}
125 {$ifdef palmos}
126 ,i_palmos
127 {$endif palmos}
128 {$ifdef solaris}
129 ,i_sunos
130 {$endif solaris}
131 {$ifdef wdosx}
132 ,i_wdosx
133 {$endif wdosx}
134 {$ifdef wii}
135 ,i_wii
136 {$endif wii}
137 {$ifdef windows}
138 ,i_win
139 {$endif windows}
140 {$ifdef symbian}
141 ,i_symbian
142 {$endif symbian}
143 {$ifdef nativent}
144 ,i_nativent
145 {$endif nativent}
146 {$ifdef aix}
147 ,i_aix
148 {$endif aix}
149 ,globtype;
150
Compilenull151 function Compile(const cmd:TCmdStr):longint;
152
153 implementation
154
155 uses
156 aasmcpu;
157
158 {$if defined(MEMDEBUG)}
159 {$define SHOWUSEDMEM}
160 {$endif}
161
162 var
163 CompilerInitedAfterArgs,
164 CompilerInited : boolean;
165
166
167 {****************************************************************************
168 Compiler
169 ****************************************************************************}
170
171 procedure DoneCompiler;
172 begin
173 if not CompilerInited then
174 exit;
175 { Free compiler if args are read }
176 if CompilerInitedAfterArgs then
177 begin
178 CompilerInitedAfterArgs:=false;
179 DoneParser;
180 DoneImport;
181 DoneExport;
182 DoneLinker;
183 DoneAsm;
184 DoneWpo;
185 end;
186 { Free memory for the others }
187 CompilerInited:=false;
188 do_doneSymbolInfo;
189 DoneSymtable;
190 DoneGlobals;
191 DoneFileUtils;
192 donetokens;
193 end;
194
195
196 procedure InitCompiler(const cmd:TCmdStr);
197 begin
198 if CompilerInited then
199 DoneCompiler;
200 {$if defined(unix) and (FPC_FULLVERSION>20700)}
201 { Set default code page for ansistrings on unix-like systems }
202 DefaultSystemCodePage:=GetSystemCodePage;
203 {$endif}
204 { inits which need to be done before the arguments are parsed }
205 InitSystems;
206 { fileutils depends on source_info so it must be after systems }
207 InitFileUtils;
208 { globals depends on source_info so it must be after systems }
209 InitGlobals;
210 { verbose depends on exe_path and must be after globals }
211 InitVerbose;
212 inittokens;
213 IniTSymtable; {Must come before read_arguments, to enable macrosymstack}
214 do_initSymbolInfo;
215 CompilerInited:=true;
216 { this is needed here for the IDE
217 in case of compilation failure
218 at the previous compile }
219 set_current_module(nil);
220 { read the arguments }
221 read_arguments(cmd);
222 { inits which depend on arguments }
223 InitParser;
224 InitImport;
225 InitExport;
226 InitLinker;
227 InitAsm;
228 InitWpo;
229
230 CompilerInitedAfterArgs:=true;
231 end;
232
233
Compilenull234 function Compile(const cmd:TCmdStr):longint;
235
236 {$maxfpuregisters 0}
237
238 procedure writecmdstrlist(w:longint;l:TCmdStrList);
239 var
240 hp : TCmdStrListItem;
241 begin
242 hp:=TCmdStrListItem(l.first);
243 while assigned(hp) do
244 begin
245 Message1(w,hp.str);
246 hp:=TCmdStrListItem(hp.next);
247 end;
248 end;
249
250 var
251 timestr : string[20];
252 linkstr : string[64];
253 {$ifdef SHOWUSEDMEM}
254 hstatus : TFPCHeapStatus;
255 {$endif SHOWUSEDMEM}
256 ExceptionMask : TFPUExceptionMask;
257 totaltime : real;
258 begin
259 try
260 try
261 ExceptionMask:=GetExceptionMask;
262 SetExceptionMask([exInvalidOp, exDenormalized, exZeroDivide,
263 exOverflow, exUnderflow, exPrecision]);
264
265 GetLocalTime(startsystime);
266 starttime := getrealtime(startsystime);
267
268 { Initialize the compiler }
269 InitCompiler(cmd);
270
271 { show some info }
272 Message1(general_t_compilername,FixFileName(system.paramstr(0)));
273 Message1(general_d_sourceos,source_info.name);
274 Message1(general_i_targetos,target_info.name);
275 Message1(general_t_exepath,exepath);
276 WriteCmdStrList(general_t_unitpath,unitsearchpath);
277 WriteCmdStrList(general_t_includepath,includesearchpath);
278 WriteCmdStrList(general_t_librarypath,librarysearchpath);
279 WriteCmdStrList(general_t_objectpath,objectsearchpath);
280 WriteCmdStrList(general_t_unitscope,namespacelist);
281
282 { Compile the program }
283 {$ifdef PREPROCWRITE}
284 if parapreprocess then
285 parser.preprocess(inputfilepath+inputfilename)
286 else
287 {$endif PREPROCWRITE}
288 parser.compile(inputfilepath+inputfilename);
289
290 { Show statistics }
291 if status.errorcount=0 then
292 begin
293 totaltime:=getrealtime-starttime;
294 if totaltime<0 then
295 totaltime:=totaltime+3600.0*24.0;
296 if round(frac(totaltime)*10) >= 10 then
297 totaltime:=trunc(totaltime) + 1;
298 timestr:=tostr(trunc(totaltime))+'.'+tostr(round(frac(totaltime)*10));
299 if status.codesize<>aword(-1) then
300 linkstr:=', '+tostr(status.codesize)+' ' +MessageStr(general_text_bytes_code)+', '+tostr(status.datasize)+' '+MessageStr(general_text_bytes_data)
301 else
302 linkstr:='';
303 Message3(general_i_abslines_compiled,tostr(status.compiledlines),timestr,linkstr);
304 if (Status.Verbosity and V_Warning = V_Warning) and
305 (Status.CountWarnings <> 0) then
306 Message1 (general_i_number_of_warnings, tostr (Status.CountWarnings));
307 if (Status.Verbosity and V_Hint = V_Hint) and
308 (Status.CountHints <> 0) then
309 Message1 (general_i_number_of_hints, tostr (Status.CountHints));
310 if (Status.Verbosity and V_Note = V_Note) and
311 (Status.CountNotes <> 0) then
312 Message1 (general_i_number_of_notes, tostr (Status.CountNotes));
313 end;
314 finally
315 { no message possible after this !! }
316 DoneCompiler;
317
318 SetExceptionMask(ExceptionMask);
319 end;
320 DoneVerbose;
321 except
322 on EControlCAbort do
323 begin
324 try
325 { in case of 50 errors, this could cause another exception,
326 suppress this exception
327 }
328 Message(general_f_compilation_aborted);
329 except
330 on ECompilerAbort do
331 ;
332 end;
333 DoneVerbose;
334 end;
335 on ECompilerAbort do
336 begin
337 try
338 { in case of 50 errors, this could cause another exception,
339 suppress this exception
340 }
341 Message(general_f_compilation_aborted);
342 except
343 on ECompilerAbort do
344 ;
345 end;
346 DoneVerbose;
347 end;
348 on ECompilerAbortSilent do
349 begin
350 DoneVerbose;
351 end;
352 on EOutOfMemory do
353 begin
354 try
355 Message(general_f_no_memory_left);
356 except
357 on ECompilerAbort do
358 ;
359 end;
360 DoneVerbose;
361 end;
362 on e : EInOutError do
363 begin
364 try
365 Message1(general_f_ioerror,e.message);
366 except
367 on ECompilerAbort do
368 ;
369 end;
370 DoneVerbose;
371 end;
372 on e : EOSError do
373 begin
374 try
375 Message1(general_f_oserror,e.message);
376 except
377 on ECompilerAbort do
378 ;
379 end;
380 DoneVerbose;
381 end;
382 on Exception do
383 begin
384 { General catchall, normally not used }
385 try
386 { in case of 50 errors, this could cause another exception,
387 suppress this exception
388 }
389 if not exception_raised then
390 begin
391 exception_raised:=true;
392 Message(general_e_exception_raised);
393 end
394 else
395 Message(general_f_compilation_aborted);
396 except
397 on ECompilerAbort do
398 ;
399 end;
400 DoneVerbose;
401 Raise;
402 end;
403 end;
404 {$ifdef SHOWUSEDMEM}
405 hstatus:=GetFPCHeapStatus;
406 Writeln('Max Memory used/heapsize: ',DStr(hstatus.MaxHeapUsed shr 10),'/',DStr(hstatus.MaxHeapSize shr 10),' Kb');
407 {$endif SHOWUSEDMEM}
408
409 { Set the return value if an error has occurred }
410 if status.errorcount=0 then
411 result:=0
412 else
413 result:=1;
414 end;
415
416 end.
417