development/compilers/freepascal/compiler/compiler.pas

   1 {
   2     $Id$
   3     Copyright (c) 1998-2000 by Florian Klaempfl
   4
   5     This unit is the interface of the compiler which can be used by
   6      external programs to link in the compiler
   7
   8     This program is free software; you can redistribute it and/or modify
   9     it under the terms of the GNU General Public License as published by
  10     the Free Software Foundation; either version 2 of the License, or
  11     (at your option) any later version.
  12
  13     This program is distributed in the hope that it will be useful,
  14     but WITHOUT ANY WARRANTY; without even the implied warranty of
  15     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  16     GNU General Public License for more details.
  17
  18     You should have received a copy of the GNU General Public License
  19     along with this program; if not, write to the Free Software
  20     Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  21
  22  ****************************************************************************}
  23
  24 {
  25   possible compiler switches:
  26   -----------------------------------------------------------------
  27   TP                  to compile the compiler with Turbo or Borland Pascal
  28   I386                generate a compiler for the Intel i386+
  29   M68K                generate a compiler for the M68000
  30   GDB                 support of the GNU Debugger
  31   EXTDEBUG            some extra debug code is executed
  32   SUPPORT_MMX         only i386: releases the compiler switch
  33                       MMX which allows the compiler to generate
  34                       MMX instructions
  35   EXTERN_MSG          Don't compile the msgfiles in the compiler, always
  36                       use external messagefiles
  37   NOAG386INT          no Intel Assembler output
  38   NOAG386NSM          no NASM output
  39   -----------------------------------------------------------------
  40 }
  41
  42 {$ifdef FPC}
  43    { One of Alpha, I386 or M68K must be defined }
  44    {$UNDEF CPUOK}
  45
  46    {$ifdef I386}
  47    {$define CPUOK}
  48    {$endif}
  49
  50    {$ifdef M68K}
  51    {$ifndef CPUOK}
  52    {$DEFINE CPUOK}
  53    {$else}
  54      {$fatal cannot define two CPU switches}
  55    {$endif}
  56    {$endif}
  57
  58    {$ifdef alpha}
  59    {$ifndef CPUOK}
  60    {$DEFINE CPUOK}
  61    {$else}
  62      {$fatal cannot define two CPU switches}
  63    {$endif}
  64    {$endif}
  65
  66    {$ifdef powerpc}
  67    {$ifndef CPUOK}
  68    {$DEFINE CPUOK}
  69    {$else}
  70      {$fatal cannot define two CPU switches}
  71    {$endif}
  72    {$endif}
  73
  74    {$ifndef CPUOK}
  75    {$fatal One of the switches I386, Alpha, PowerPC or M68K must be defined}
  76    {$endif}
  77
  78    {$ifdef support_mmx}
  79      {$ifndef i386}
  80        {$fatal I386 switch must be on for MMX support}
  81      {$endif i386}
  82    {$endif support_mmx}
  83 {$endif}
  84
  85 unit compiler;
  86 interface
  87
  88 { Use exception catching so the compiler goes futher after a Stop }
  89 {$ifndef NOUSEEXCEPT}
  90 {$ifdef i386}
  91   {$define USEEXCEPT}
  92 {$endif}
  93
  94 {$ifdef TP}
  95   {$ifdef DPMI}
  96     {$undef USEEXCEPT}
  97   {$endif}
  98 {$endif}
  99 {$endif ndef NOUSEEXCEPT}
 100
 101 uses
 102 {$ifdef fpc}
 103   {$ifdef GO32V2}
 104     emu387,
 105 {    dpmiexcp, }
 106   {$endif GO32V2}
 107 {$endif}
 108 {$ifdef USEEXCEPT}
 109   tpexcept,
 110 {$endif USEEXCEPT}
 111 {$ifdef BrowserLog}
 112   browlog,
 113 {$endif BrowserLog}
 114 {$ifdef Delphi}
 115   dmisc,
 116 {$else Delphi}
 117   dos,
 118 {$endif Delphi}
 119   verbose,comphook,systems,
 120   cobjects,files,globals,options,parser,symtable,link,import,export,tokens;
 121
 122 function Compile(const cmd:string):longint;
 123
 124 Const
 125        { do we need to link }
 126        IsExe : boolean = false;
 127        IsLibrary : boolean = false;
 128
 129 implementation
 130
 131 uses
 132   cpubase;
 133
 134 var
 135   CompilerInitedAfterArgs,
 136   CompilerInited : boolean;
 137   olddo_stop : tstopprocedure;
 138
 139 {$ifdef USEEXCEPT}
 140
 141 procedure RecoverStop;{$ifndef FPC}far;{$endif}
 142 begin
 143   if recoverpospointer<>nil then
 144     LongJmp(recoverpospointer^,1)
 145   else
 146     Do_Halt(1);
 147 end;
 148 {$endif USEEXCEPT}
 149
 150 {$ifdef EXTDEBUG}
 151 {$ifdef FPC}
 152   Var
 153     LostMemory : longint;
 154   Procedure CheckMemory(LostMemory : longint);
 155   begin
 156     if LostMemory<>0 then
 157       begin
 158         Writeln('Memory Lost = '+tostr(LostMemory));
 159 {$ifdef DEBUG}
 160         def_gdb_stop(V_Warning);
 161 {$endif DEBUG}
 162       end;
 163   end;
 164 {$endif FPC}
 165 {$endif EXTDEBUG}
 166 {****************************************************************************
 167                                 Compiler
 168 ****************************************************************************}
 169
 170 procedure DoneCompiler;
 171 begin
 172   if not CompilerInited then
 173    exit;
 174 { Free compiler if args are read }
 175 {$ifdef BrowserLog}
 176   DoneBrowserLog;
 177 {$endif BrowserLog}
 178 {$ifdef BrowserCol}
 179   do_doneSymbolInfo;
 180 {$endif BrowserCol}
 181   if CompilerInitedAfterArgs then
 182    begin
 183      CompilerInitedAfterArgs:=false;
 184      doneparser;
 185      DoneImport;
 186      DoneExport;
 187      DoneLinker;
 188      DoneCpu;
 189    end;
 190 { Free memory for the others }
 191   CompilerInited:=false;
 192   DoneSymtable;
 193   DoneGlobals;
 194   donetokens;
 195 {$ifdef USEEXCEPT}
 196   recoverpospointer:=nil;
 197   longjump_used:=false;
 198 {$endif USEEXCEPT}
 199 end;
 200
 201
 202 procedure InitCompiler(const cmd:string);
 203 begin
 204   if CompilerInited then
 205    DoneCompiler;
 206 { inits which need to be done before the arguments are parsed }
 207   InitSystems;
 208   InitVerbose;
 209 {$ifdef BrowserLog}
 210   InitBrowserLog;
 211 {$endif BrowserLog}
 212 {$ifdef BrowserCol}
 213   do_initSymbolInfo;
 214 {$endif BrowserCol}
 215   InitGlobals;
 216   inittokens;
 217   InitSymtable;
 218   CompilerInited:=true;
 219 { this is needed here for the IDE
 220   in case of compilation failure
 221   at the previous compile }
 222   current_module:=nil;
 223 { read the arguments }
 224   read_arguments(cmd);
 225 { inits which depend on arguments }
 226   initparser;
 227   InitImport;
 228   InitExport;
 229   InitLinker;
 230   InitCpu;
 231   CompilerInitedAfterArgs:=true;
 232 end;
 233
 234 procedure minimal_stop;{$ifndef fpc}far;{$endif}
 235 begin
 236   DoneCompiler;
 237   olddo_stop;
 238 end;
 239
 240
 241 function Compile(const cmd:string):longint;
 242
 243 {$ifdef fpc}
 244 {$maxfpuregisters 0}
 245 {$endif fpc}
 246
 247   procedure writepathlist(w:longint;l:TSearchPathList);
 248   var
 249     hp : pstringqueueitem;
 250   begin
 251     hp:=l.first;
 252     while assigned(hp) do
 253      begin
 254        Message1(w,hp^.data^);
 255        hp:=hp^.next;
 256      end;
 257   end;
 258
 259   function getrealtime : real;
 260   var
 261     h,m,s,s100 : word;
 262   begin
 263     gettime(h,m,s,s100);
 264     getrealtime:=h*3600.0+m*60.0+s+s100/100.0;
 265   end;
 266
 267 var
 268   starttime  : real;
 269 {$ifdef USEEXCEPT}
 270   recoverpos : jmp_buf;
 271 {$endif}
 272 begin
 273
 274   olddo_stop:=do_stop;
 275 {$ifdef TP}
 276   do_stop:=minimal_stop;
 277 {$else TP}
 278   do_stop:=@minimal_stop;
 279 {$endif TP}
 280 { Initialize the compiler }
 281   InitCompiler(cmd);
 282
 283 { show some info }
 284   Message1(general_t_compilername,FixFileName(paramstr(0)));
 285   Message1(general_d_sourceos,source_os.name);
 286   Message1(general_i_targetos,target_os.name);
 287   Message1(general_t_exepath,exepath);
 288   WritePathList(general_t_unitpath,unitsearchpath);
 289   WritePathList(general_t_includepath,includesearchpath);
 290   WritePathList(general_t_librarypath,librarysearchpath);
 291   WritePathList(general_t_objectpath,objectsearchpath);
 292 {$ifdef TP}
 293 {$ifndef Delphi}
 294   Comment(V_Info,'Memory: '+tostr(MemAvail)+' Bytes Free');
 295 {$endif Delphi}
 296 {$endif}
 297
 298 {$ifdef USEEXCEPT}
 299   if setjmp(recoverpos)=0 then
 300    begin
 301      recoverpospointer:=@recoverpos;
 302 {$ifdef TP}
 303      do_stop:=recoverstop;
 304 {$else TP}
 305      do_stop:=@recoverstop;
 306 {$endif TP}
 307 {$endif USEEXCEPT}
 308      starttime:=getrealtime;
 309      if parapreprocess then
 310       parser.preprocess(inputdir+inputfile+inputextension)
 311      else
 312       parser.compile(inputdir+inputfile+inputextension,false);
 313      if status.errorcount=0 then
 314       begin
 315         starttime:=getrealtime-starttime;
 316         if starttime<0 then
 317           starttime:=starttime+3600.0*24.0;
 318         Message2(general_i_abslines_compiled,tostr(status.compiledlines),tostr(trunc(starttime))+
 319           '.'+tostr(trunc(frac(starttime)*10)));
 320       end;
 321 {$ifdef USEEXCEPT}
 322     end;
 323 {$endif USEEXCEPT}
 324
 325 { Stop is always called, so we come here when a program is compiled or not }
 326   do_stop:=olddo_stop;
 327 { Stop the compiler, frees also memory }
 328 { no message possible after this !!    }
 329   DoneCompiler;
 330
 331 { Set the return value if an error has occurred }
 332   if status.errorcount=0 then
 333    Compile:=0
 334   else
 335    Compile:=1;
 336
 337   DoneVerbose;
 338 {$ifdef EXTDEBUG}
 339 {$ifdef FPC}
 340   LostMemory:=system.HeapSize-MemAvail-EntryMemUsed;
 341   CheckMemory(LostMemory);
 342 {$endif FPC}
 343 {$ifndef newcg}
 344   Writeln('Repetitive firstpass = '+tostr(firstpass_several)+'/'+tostr(total_of_firstpass));
 345 {$endif newcg}
 346 {$endif EXTDEBUG}
 347 {$ifdef MEMDEBUG}
 348   Writeln('Memory used: ',system.Heapsize);
 349 {$endif}
 350 {$ifdef fixLeaksOnError}
 351  {$ifdef tp}
 352   do_stop;
 353  {$else tp}
 354   do_stop();
 355  {$endif tp}
 356 {$endif fixLeaksOnError}
 357 end;
 358
 359
 360 end.
 361 {
 362   $Log$
 363   Revision 1.1  2002/02/19 08:21:58  sasu
 364   Initial revision
 365
 366   Revision 1.1.2.4  2000/11/19 00:18:06  pierre
 367    + IsLibrary boolean for IDE
 368
 369   Revision 1.1.2.3  2000/10/06 23:51:58  pierre
 370    * avoid IDE crash after compilation failure
 371
 372   Revision 1.1.2.2  2000/08/21 09:09:08  jonas
 373     - removed catch unit from uses clause for Linux (clashed with fpcatch
 374      from IDE and is already in pp.pas for command line compiler)
 375
 376   Revision 1.1.2.1  2000/08/02 19:36:33  peter
 377     * memdebug additions
 378
 379   Revision 1.1  2000/07/13 06:29:48  michael
 380   + Initial import
 381
 382   Revision 1.51  2000/06/30 20:23:33  peter
 383     * new message files layout with msg numbers (but still no code to
 384       show the number on the screen)
 385
 386   Revision 1.50  2000/05/29 10:04:40  pierre
 387     * New bunch of Gabor changes
 388
 389   Revision 1.49  2000/05/03 16:31:22  pierre
 390    + easier debug when memory is lost
 391
 392   Revision 1.48  2000/04/05 21:18:04  pierre
 393    * set NOUSEEXCEPT to remove use of setjump/longjump
 394
 395   Revision 1.47  2000/03/18 15:05:33  jonas
 396     + added $maxfpuregisters 0 for compile() procedure
 397
 398   Revision 1.46  2000/02/09 13:22:50  peter
 399     * log truncated
 400
 401   Revision 1.45  2000/01/11 17:16:04  jonas
 402     * removed a lot of memory leaks when an error is encountered (caused by
 403       procinfo and pstringcontainers). There are still plenty left though :)
 404
 405   Revision 1.44  2000/01/11 16:56:22  jonas
 406     - removed call to do_stop at the end of compile() since it obviously breaks the
 407       automatic compiling of units. Make cycle worked though! 8)
 408
 409   Revision 1.43  2000/01/11 16:53:24  jonas
 410     + call do_stop at the end of compile()
 411
 412   Revision 1.42  2000/01/07 01:14:23  peter
 413     * updated copyright to 2000
 414
 415   Revision 1.41  1999/12/02 17:34:34  peter
 416     * preprocessor support. But it fails on the caret in type blocks
 417
 418   Revision 1.40  1999/11/18 13:43:48  pierre
 419    + IsExe global var needed for IDE
 420
 421   Revision 1.39  1999/11/12 11:03:50  peter
 422     * searchpaths changed to stringqueue object
 423
 424   Revision 1.38  1999/11/09 23:47:53  pierre
 425    + minimal_stop to avoid memory loss with -iTO switch
 426
 427   Revision 1.37  1999/11/06 14:34:20  peter
 428     * truncated log to 20 revs
 429
 430   Revision 1.36  1999/10/12 21:20:41  florian
 431     * new codegenerator compiles again
 432
 433   Revision 1.35  1999/09/28 19:48:45  florian
 434     * bug 617 fixed
 435
 436   Revision 1.34  1999/09/16 23:05:52  florian
 437     * m68k compiler is again compilable (only gas writer, no assembler reader)
 438
 439   Revision 1.33  1999/09/07 15:10:04  pierre
 440    * use do_halt instead of halt
 441
 442   Revision 1.32  1999/09/02 18:47:44  daniel
 443     * Could not compile with TP, some arrays moved to heap
 444     * NOAG386BIN default for TP
 445     * AG386* files were not compatible with TP, fixed.
 446
 447   Revision 1.31  1999/08/20 10:17:01  michael
 448   + Patch from pierre
 449
 450   Revision 1.30  1999/08/11 17:26:31  peter
 451     * tlinker object is now inherited for win32 and dos
 452     * postprocessexecutable is now a method of tlinker
 453
 454   Revision 1.29  1999/08/09 22:13:43  peter
 455     * fixed writing of lost memory which should be after donecompiler
 456
 457   Revision 1.28  1999/08/04 13:02:40  jonas
 458     * all tokens now start with an underscore
 459     * PowerPC compiles!!
 460
 461   Revision 1.27  1999/08/02 21:28:56  florian
 462     * the main branch psub.pas is now used for
 463       newcg compiler
 464
 465   Revision 1.26  1999/08/02 20:46:57  michael
 466   * Alpha aware switch detection
 467
 468 }