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