compiler.pas 11 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426
  1. {
  2. $Id$
  3. Copyright (c) 1993-98 by Florian Klaempfl
  4. This unit is the interface of the compiler which can be used by
  5. external programs to link in the compiler
  6. This program is free software; you can redistribute it and/or modify
  7. it under the terms of the GNU General Public License as published by
  8. the Free Software Foundation; either version 2 of the License, or
  9. (at your option) any later version.
  10. This program is distributed in the hope that it will be useful,
  11. but WITHOUT ANY WARRANTY; without even the implied warranty of
  12. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  13. GNU General Public License for more details.
  14. You should have received a copy of the GNU General Public License
  15. along with this program; if not, write to the Free Software
  16. Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  17. ****************************************************************************}
  18. {
  19. possible compiler switches:
  20. -----------------------------------------------------------------
  21. TP to compile the compiler with Turbo or Borland Pascal
  22. I386 generate a compiler for the Intel i386+
  23. M68K generate a compiler for the M68000
  24. GDB support of the GNU Debugger
  25. EXTDEBUG some extra debug code is executed
  26. SUPPORT_MMX only i386: releases the compiler switch
  27. MMX which allows the compiler to generate
  28. MMX instructions
  29. EXTERN_MSG Don't compile the msgfiles in the compiler, always
  30. use external messagefiles
  31. NOAG386INT no Intel Assembler output
  32. NOAG386NSM no NASM output
  33. -----------------------------------------------------------------
  34. }
  35. {$ifdef FPC}
  36. { One of Alpha, I386 or M68K must be defined }
  37. {$UNDEF CPUOK}
  38. {$ifdef I386}
  39. {$define CPUOK}
  40. {$endif}
  41. {$ifdef M68K}
  42. {$ifndef CPUOK}
  43. {$DEFINE CPUOK}
  44. {$else}
  45. {$fatal cannot define two CPU switches}
  46. {$endif}
  47. {$endif}
  48. {$ifdef alpha}
  49. {$ifndef CPUOK}
  50. {$DEFINE CPUOK}
  51. {$else}
  52. {$fatal cannot define two CPU switches}
  53. {$endif}
  54. {$endif}
  55. {$ifdef powerpc}
  56. {$ifndef CPUOK}
  57. {$DEFINE CPUOK}
  58. {$else}
  59. {$fatal cannot define two CPU switches}
  60. {$endif}
  61. {$endif}
  62. {$ifndef CPUOK}
  63. {$fatal One of the switches I386, Alpha, PowerPC or M68K must be defined}
  64. {$endif}
  65. {$ifdef support_mmx}
  66. {$ifndef i386}
  67. {$fatal I386 switch must be on for MMX support}
  68. {$endif i386}
  69. {$endif support_mmx}
  70. {$endif}
  71. unit compiler;
  72. interface
  73. { Use exception catching so the compiler goes futher after a Stop }
  74. {$ifdef i386}
  75. {$define USEEXCEPT}
  76. {$endif}
  77. {$ifdef TP}
  78. {$ifdef DPMI}
  79. {$undef USEEXCEPT}
  80. {$endif}
  81. {$endif}
  82. uses
  83. {$ifdef fpc}
  84. {$ifdef GO32V2}
  85. emu387,
  86. { dpmiexcp, }
  87. {$endif GO32V2}
  88. {$ifdef LINUX}
  89. catch,
  90. {$endif LINUX}
  91. {$endif}
  92. {$ifdef USEEXCEPT}
  93. tpexcept,
  94. {$endif USEEXCEPT}
  95. {$ifdef BrowserLog}
  96. browlog,
  97. {$endif BrowserLog}
  98. {$ifdef BrowserCol}
  99. browcol,
  100. {$endif BrowserCol}
  101. {$ifdef Delphi}
  102. dmisc,
  103. {$else Delphi}
  104. dos,
  105. {$endif Delphi}
  106. verbose,comphook,systems,
  107. globals,options,parser,symtable,link,import,export,tokens;
  108. function Compile(const cmd:string):longint;
  109. implementation
  110. uses
  111. {$ifdef m68k}
  112. m68k;
  113. {$else}
  114. cpubase;
  115. {$endif}
  116. var
  117. CompilerInitedAfterArgs,
  118. CompilerInited : boolean;
  119. {$ifdef USEEXCEPT}
  120. procedure RecoverStop;{$ifndef FPC}far;{$endif}
  121. begin
  122. if recoverpospointer<>nil then
  123. LongJmp(recoverpospointer^,1)
  124. else
  125. Do_Halt(1);
  126. end;
  127. {$endif USEEXCEPT}
  128. {****************************************************************************
  129. Compiler
  130. ****************************************************************************}
  131. procedure DoneCompiler;
  132. begin
  133. if not CompilerInited then
  134. exit;
  135. { Free compiler if args are read }
  136. {$ifdef BrowserLog}
  137. DoneBrowserLog;
  138. {$endif BrowserLog}
  139. {$ifdef BrowserCol}
  140. DoneBrowserCol;
  141. {$endif BrowserCol}
  142. if CompilerInitedAfterArgs then
  143. begin
  144. CompilerInitedAfterArgs:=false;
  145. doneparser;
  146. DoneImport;
  147. DoneExport;
  148. DoneLinker;
  149. DoneCpu;
  150. end;
  151. { Free memory for the others }
  152. CompilerInited:=false;
  153. DoneSymtable;
  154. DoneGlobals;
  155. donetokens;
  156. {$ifdef USEEXCEPT}
  157. recoverpospointer:=nil;
  158. longjump_used:=false;
  159. {$endif USEEXCEPT}
  160. end;
  161. procedure InitCompiler(const cmd:string);
  162. begin
  163. if CompilerInited then
  164. DoneCompiler;
  165. { inits which need to be done before the arguments are parsed }
  166. InitSystems;
  167. InitVerbose;
  168. {$ifdef BrowserLog}
  169. InitBrowserLog;
  170. {$endif BrowserLog}
  171. {$ifdef BrowserCol}
  172. InitBrowserCol;
  173. {$endif BrowserCol}
  174. InitGlobals;
  175. inittokens;
  176. InitSymtable;
  177. CompilerInited:=true;
  178. { read the arguments }
  179. read_arguments(cmd);
  180. { inits which depend on arguments }
  181. initparser;
  182. InitImport;
  183. InitExport;
  184. InitLinker;
  185. InitCpu;
  186. CompilerInitedAfterArgs:=true;
  187. end;
  188. function Compile(const cmd:string):longint;
  189. function getrealtime : real;
  190. var
  191. h,m,s,s100 : word;
  192. begin
  193. gettime(h,m,s,s100);
  194. getrealtime:=h*3600.0+m*60.0+s+s100/100.0;
  195. end;
  196. var
  197. starttime : real;
  198. {$ifdef USEEXCEPT}
  199. recoverpos : jmp_buf;
  200. olddo_stop : tstopprocedure;
  201. {$endif}
  202. begin
  203. { Initialize the compiler }
  204. InitCompiler(cmd);
  205. { show some info }
  206. Message1(general_t_compilername,FixFileName(paramstr(0)));
  207. Message1(general_d_sourceos,source_os.name);
  208. Message1(general_i_targetos,target_os.name);
  209. Message1(general_t_exepath,exepath);
  210. Message1(general_t_unitpath,unitsearchpath);
  211. Message1(general_t_includepath,includesearchpath);
  212. Message1(general_t_librarypath,librarysearchpath);
  213. Message1(general_t_objectpath,objectsearchpath);
  214. {$ifdef TP}
  215. {$ifndef Delphi}
  216. Comment(V_Info,'Memory: '+tostr(MemAvail)+' Bytes Free');
  217. {$endif Delphi}
  218. {$endif}
  219. {$ifdef USEEXCEPT}
  220. if setjmp(recoverpos)=0 then
  221. begin
  222. olddo_stop:=do_stop;
  223. recoverpospointer:=@recoverpos;
  224. {$ifdef TP}
  225. do_stop:=recoverstop;
  226. {$else TP}
  227. do_stop:=@recoverstop;
  228. {$endif TP}
  229. {$endif USEEXCEPT}
  230. starttime:=getrealtime;
  231. parser.compile(inputdir+inputfile+inputextension,false);
  232. if status.errorcount=0 then
  233. begin
  234. starttime:=getrealtime-starttime;
  235. Message2(general_i_abslines_compiled,tostr(status.compiledlines),tostr(trunc(starttime))+
  236. '.'+tostr(trunc(frac(starttime)*10)));
  237. end;
  238. {$ifdef USEEXCEPT}
  239. end;
  240. { Stop is always called, so we come here when a program is compiled or not }
  241. do_stop:=olddo_stop;
  242. {$endif USEEXCEPT}
  243. { Stop the compiler, frees also memory }
  244. { no message possible after this !! }
  245. DoneCompiler;
  246. { Set the return value if an error has occurred }
  247. if status.errorcount=0 then
  248. Compile:=0
  249. else
  250. Compile:=1;
  251. DoneVerbose;
  252. {$ifdef EXTDEBUG}
  253. {$ifdef FPC}
  254. Writeln('Memory Lost = '+tostr(system.HeapSize-MemAvail-EntryMemUsed));
  255. {$endif FPC}
  256. Writeln('Repetitive firstpass = '+tostr(firstpass_several)+'/'+tostr(total_of_firstpass));
  257. {$endif EXTDEBUG}
  258. end;
  259. end.
  260. {
  261. $Log$
  262. Revision 1.33 1999-09-07 15:10:04 pierre
  263. * use do_halt instead of halt
  264. Revision 1.32 1999/09/02 18:47:44 daniel
  265. * Could not compile with TP, some arrays moved to heap
  266. * NOAG386BIN default for TP
  267. * AG386* files were not compatible with TP, fixed.
  268. Revision 1.31 1999/08/20 10:17:01 michael
  269. + Patch from pierre
  270. Revision 1.30 1999/08/11 17:26:31 peter
  271. * tlinker object is now inherited for win32 and dos
  272. * postprocessexecutable is now a method of tlinker
  273. Revision 1.29 1999/08/09 22:13:43 peter
  274. * fixed writing of lost memory which should be after donecompiler
  275. Revision 1.28 1999/08/04 13:02:40 jonas
  276. * all tokens now start with an underscore
  277. * PowerPC compiles!!
  278. Revision 1.27 1999/08/02 21:28:56 florian
  279. * the main branch psub.pas is now used for
  280. newcg compiler
  281. Revision 1.26 1999/08/02 20:46:57 michael
  282. * Alpha aware switch detection
  283. Revision 1.25 1999/07/18 14:47:22 florian
  284. * bug 487 fixed, (inc(<property>) isn't allowed)
  285. * more fixes to compile with Delphi
  286. Revision 1.24 1999/07/18 10:19:48 florian
  287. * made it compilable with Dlephi 4 again
  288. + fixed problem with large stack allocations on win32
  289. Revision 1.23 1999/06/22 16:24:41 pierre
  290. * local browser stuff corrected
  291. Revision 1.22 1999/05/17 14:24:32 pierre
  292. * DoneCompiler called later to prevent accessing invalid data
  293. Revision 1.21 1999/05/04 21:44:39 florian
  294. * changes to compile it with Delphi 4.0
  295. Revision 1.20 1999/04/21 09:43:33 peter
  296. * storenumber works
  297. * fixed some typos in double_checksum
  298. + incompatible types type1 and type2 message (with storenumber)
  299. Revision 1.19 1999/03/09 11:52:06 pierre
  300. * compilation after a failure longjumped directly to end
  301. Revision 1.18 1999/02/26 00:48:16 peter
  302. * assembler writers fixed for ag386bin
  303. Revision 1.17 1999/01/12 14:25:25 peter
  304. + BrowserLog for browser.log generation
  305. + BrowserCol for browser info in TCollections
  306. * released all other UseBrowser
  307. Revision 1.16 1998/12/15 10:23:23 peter
  308. + -iSO, -iSP, -iTO, -iTP
  309. Revision 1.15 1998/10/29 11:35:40 florian
  310. * some dll support for win32
  311. * fixed assembler writing for PalmOS
  312. Revision 1.14 1998/10/26 22:58:17 florian
  313. * new introduded problem with classes fix, the parent class wasn't set
  314. correct, if the class was defined forward before
  315. Revision 1.13 1998/10/26 17:15:17 pierre
  316. + added two level of longjump to
  317. allow clean freeing of used memory on errors
  318. Revision 1.12 1998/10/09 16:36:02 pierre
  319. * some memory leaks specific to usebrowser define fixed
  320. * removed tmodule.implsymtable (was like tmodule.localsymtable)
  321. Revision 1.11 1998/10/08 23:28:51 peter
  322. * -vu shows unit info, -vt shows tried/used files
  323. Revision 1.10 1998/10/08 17:17:18 pierre
  324. * current_module old scanner tagged as invalid if unit is recompiled
  325. + added ppheap for better info on tracegetmem of heaptrc
  326. (adds line column and file index)
  327. * several memory leaks removed ith help of heaptrc !!
  328. Revision 1.9 1998/10/06 17:16:46 pierre
  329. * some memory leaks fixed (thanks to Peter for heaptrc !)
  330. Revision 1.8 1998/09/01 09:00:27 peter
  331. - removed tempheap creation/restore
  332. Revision 1.7 1998/09/01 07:54:17 pierre
  333. * UseBrowser a little updated (might still be buggy !!)
  334. * bug in psub.pas in function specifier removed
  335. * stdcall allowed in interface and in implementation
  336. (FPC will not yet complain if it is missing in either part
  337. because stdcall is only a dummy !!)
  338. Revision 1.6 1998/08/29 13:51:10 peter
  339. * moved get_exepath to globals
  340. + date_string const with the current date for 0.99.7+
  341. Revision 1.5 1998/08/11 21:38:24 peter
  342. + createheap/restoreheap procedures (only tp7 rm currently) and support
  343. for tp7 dpmi
  344. Revision 1.4 1998/08/11 14:09:06 peter
  345. * fixed some messages and smaller msgtxt.inc
  346. Revision 1.3 1998/08/11 00:01:20 peter
  347. * -vu displays now all searchpaths
  348. Revision 1.2 1998/08/10 14:49:56 peter
  349. + localswitches, moduleswitches, globalswitches splitting
  350. Revision 1.1 1998/08/10 10:18:24 peter
  351. + Compiler,Comphook unit which are the new interface units to the
  352. compiler
  353. }