2
0

compiler.pas 11 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431
  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. cpubase;
  112. var
  113. CompilerInitedAfterArgs,
  114. CompilerInited : boolean;
  115. {$ifdef USEEXCEPT}
  116. procedure RecoverStop;{$ifndef FPC}far;{$endif}
  117. begin
  118. if recoverpospointer<>nil then
  119. LongJmp(recoverpospointer^,1)
  120. else
  121. Do_Halt(1);
  122. end;
  123. {$endif USEEXCEPT}
  124. {****************************************************************************
  125. Compiler
  126. ****************************************************************************}
  127. procedure DoneCompiler;
  128. begin
  129. if not CompilerInited then
  130. exit;
  131. { Free compiler if args are read }
  132. {$ifdef BrowserLog}
  133. DoneBrowserLog;
  134. {$endif BrowserLog}
  135. {$ifdef BrowserCol}
  136. DoneBrowserCol;
  137. {$endif BrowserCol}
  138. if CompilerInitedAfterArgs then
  139. begin
  140. CompilerInitedAfterArgs:=false;
  141. doneparser;
  142. DoneImport;
  143. DoneExport;
  144. DoneLinker;
  145. DoneCpu;
  146. end;
  147. { Free memory for the others }
  148. CompilerInited:=false;
  149. DoneSymtable;
  150. DoneGlobals;
  151. donetokens;
  152. {$ifdef USEEXCEPT}
  153. recoverpospointer:=nil;
  154. longjump_used:=false;
  155. {$endif USEEXCEPT}
  156. end;
  157. procedure InitCompiler(const cmd:string);
  158. begin
  159. if CompilerInited then
  160. DoneCompiler;
  161. { inits which need to be done before the arguments are parsed }
  162. InitSystems;
  163. InitVerbose;
  164. {$ifdef BrowserLog}
  165. InitBrowserLog;
  166. {$endif BrowserLog}
  167. {$ifdef BrowserCol}
  168. InitBrowserCol;
  169. {$endif BrowserCol}
  170. InitGlobals;
  171. inittokens;
  172. InitSymtable;
  173. CompilerInited:=true;
  174. { read the arguments }
  175. read_arguments(cmd);
  176. { inits which depend on arguments }
  177. initparser;
  178. InitImport;
  179. InitExport;
  180. InitLinker;
  181. InitCpu;
  182. CompilerInitedAfterArgs:=true;
  183. end;
  184. function Compile(const cmd:string):longint;
  185. function getrealtime : real;
  186. var
  187. h,m,s,s100 : word;
  188. begin
  189. gettime(h,m,s,s100);
  190. getrealtime:=h*3600.0+m*60.0+s+s100/100.0;
  191. end;
  192. var
  193. starttime : real;
  194. {$ifdef USEEXCEPT}
  195. recoverpos : jmp_buf;
  196. olddo_stop : tstopprocedure;
  197. {$endif}
  198. begin
  199. { Initialize the compiler }
  200. InitCompiler(cmd);
  201. { show some info }
  202. Message1(general_t_compilername,FixFileName(paramstr(0)));
  203. Message1(general_d_sourceos,source_os.name);
  204. Message1(general_i_targetos,target_os.name);
  205. Message1(general_t_exepath,exepath);
  206. Message1(general_t_unitpath,unitsearchpath);
  207. Message1(general_t_includepath,includesearchpath);
  208. Message1(general_t_librarypath,librarysearchpath);
  209. Message1(general_t_objectpath,objectsearchpath);
  210. {$ifdef TP}
  211. {$ifndef Delphi}
  212. Comment(V_Info,'Memory: '+tostr(MemAvail)+' Bytes Free');
  213. {$endif Delphi}
  214. {$endif}
  215. {$ifdef USEEXCEPT}
  216. if setjmp(recoverpos)=0 then
  217. begin
  218. olddo_stop:=do_stop;
  219. recoverpospointer:=@recoverpos;
  220. {$ifdef TP}
  221. do_stop:=recoverstop;
  222. {$else TP}
  223. do_stop:=@recoverstop;
  224. {$endif TP}
  225. {$endif USEEXCEPT}
  226. starttime:=getrealtime;
  227. parser.compile(inputdir+inputfile+inputextension,false);
  228. if status.errorcount=0 then
  229. begin
  230. starttime:=getrealtime-starttime;
  231. if starttime<0 then
  232. starttime:=starttime+3600.0*24.0;
  233. Message2(general_i_abslines_compiled,tostr(status.compiledlines),tostr(trunc(starttime))+
  234. '.'+tostr(trunc(frac(starttime)*10)));
  235. end;
  236. {$ifdef USEEXCEPT}
  237. end;
  238. { Stop is always called, so we come here when a program is compiled or not }
  239. do_stop:=olddo_stop;
  240. {$endif USEEXCEPT}
  241. { Stop the compiler, frees also memory }
  242. { no message possible after this !! }
  243. DoneCompiler;
  244. { Set the return value if an error has occurred }
  245. if status.errorcount=0 then
  246. Compile:=0
  247. else
  248. Compile:=1;
  249. DoneVerbose;
  250. {$ifdef EXTDEBUG}
  251. {$ifdef FPC}
  252. Writeln('Memory Lost = '+tostr(system.HeapSize-MemAvail-EntryMemUsed));
  253. {$endif FPC}
  254. Writeln('Repetitive firstpass = '+tostr(firstpass_several)+'/'+tostr(total_of_firstpass));
  255. {$endif EXTDEBUG}
  256. end;
  257. end.
  258. {
  259. $Log$
  260. Revision 1.35 1999-09-28 19:48:45 florian
  261. * bug 617 fixed
  262. Revision 1.34 1999/09/16 23:05:52 florian
  263. * m68k compiler is again compilable (only gas writer, no assembler reader)
  264. Revision 1.33 1999/09/07 15:10:04 pierre
  265. * use do_halt instead of halt
  266. Revision 1.32 1999/09/02 18:47:44 daniel
  267. * Could not compile with TP, some arrays moved to heap
  268. * NOAG386BIN default for TP
  269. * AG386* files were not compatible with TP, fixed.
  270. Revision 1.31 1999/08/20 10:17:01 michael
  271. + Patch from pierre
  272. Revision 1.30 1999/08/11 17:26:31 peter
  273. * tlinker object is now inherited for win32 and dos
  274. * postprocessexecutable is now a method of tlinker
  275. Revision 1.29 1999/08/09 22:13:43 peter
  276. * fixed writing of lost memory which should be after donecompiler
  277. Revision 1.28 1999/08/04 13:02:40 jonas
  278. * all tokens now start with an underscore
  279. * PowerPC compiles!!
  280. Revision 1.27 1999/08/02 21:28:56 florian
  281. * the main branch psub.pas is now used for
  282. newcg compiler
  283. Revision 1.26 1999/08/02 20:46:57 michael
  284. * Alpha aware switch detection
  285. Revision 1.25 1999/07/18 14:47:22 florian
  286. * bug 487 fixed, (inc(<property>) isn't allowed)
  287. * more fixes to compile with Delphi
  288. Revision 1.24 1999/07/18 10:19:48 florian
  289. * made it compilable with Dlephi 4 again
  290. + fixed problem with large stack allocations on win32
  291. Revision 1.23 1999/06/22 16:24:41 pierre
  292. * local browser stuff corrected
  293. Revision 1.22 1999/05/17 14:24:32 pierre
  294. * DoneCompiler called later to prevent accessing invalid data
  295. Revision 1.21 1999/05/04 21:44:39 florian
  296. * changes to compile it with Delphi 4.0
  297. Revision 1.20 1999/04/21 09:43:33 peter
  298. * storenumber works
  299. * fixed some typos in double_checksum
  300. + incompatible types type1 and type2 message (with storenumber)
  301. Revision 1.19 1999/03/09 11:52:06 pierre
  302. * compilation after a failure longjumped directly to end
  303. Revision 1.18 1999/02/26 00:48:16 peter
  304. * assembler writers fixed for ag386bin
  305. Revision 1.17 1999/01/12 14:25:25 peter
  306. + BrowserLog for browser.log generation
  307. + BrowserCol for browser info in TCollections
  308. * released all other UseBrowser
  309. Revision 1.16 1998/12/15 10:23:23 peter
  310. + -iSO, -iSP, -iTO, -iTP
  311. Revision 1.15 1998/10/29 11:35:40 florian
  312. * some dll support for win32
  313. * fixed assembler writing for PalmOS
  314. Revision 1.14 1998/10/26 22:58:17 florian
  315. * new introduded problem with classes fix, the parent class wasn't set
  316. correct, if the class was defined forward before
  317. Revision 1.13 1998/10/26 17:15:17 pierre
  318. + added two level of longjump to
  319. allow clean freeing of used memory on errors
  320. Revision 1.12 1998/10/09 16:36:02 pierre
  321. * some memory leaks specific to usebrowser define fixed
  322. * removed tmodule.implsymtable (was like tmodule.localsymtable)
  323. Revision 1.11 1998/10/08 23:28:51 peter
  324. * -vu shows unit info, -vt shows tried/used files
  325. Revision 1.10 1998/10/08 17:17:18 pierre
  326. * current_module old scanner tagged as invalid if unit is recompiled
  327. + added ppheap for better info on tracegetmem of heaptrc
  328. (adds line column and file index)
  329. * several memory leaks removed ith help of heaptrc !!
  330. Revision 1.9 1998/10/06 17:16:46 pierre
  331. * some memory leaks fixed (thanks to Peter for heaptrc !)
  332. Revision 1.8 1998/09/01 09:00:27 peter
  333. - removed tempheap creation/restore
  334. Revision 1.7 1998/09/01 07:54:17 pierre
  335. * UseBrowser a little updated (might still be buggy !!)
  336. * bug in psub.pas in function specifier removed
  337. * stdcall allowed in interface and in implementation
  338. (FPC will not yet complain if it is missing in either part
  339. because stdcall is only a dummy !!)
  340. Revision 1.6 1998/08/29 13:51:10 peter
  341. * moved get_exepath to globals
  342. + date_string const with the current date for 0.99.7+
  343. Revision 1.5 1998/08/11 21:38:24 peter
  344. + createheap/restoreheap procedures (only tp7 rm currently) and support
  345. for tp7 dpmi
  346. Revision 1.4 1998/08/11 14:09:06 peter
  347. * fixed some messages and smaller msgtxt.inc
  348. Revision 1.3 1998/08/11 00:01:20 peter
  349. * -vu displays now all searchpaths
  350. Revision 1.2 1998/08/10 14:49:56 peter
  351. + localswitches, moduleswitches, globalswitches splitting
  352. Revision 1.1 1998/08/10 10:18:24 peter
  353. + Compiler,Comphook unit which are the new interface units to the
  354. compiler
  355. }