globals.pas 41 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469
  1. {
  2. Copyright (c) 1998-2002 by Florian Klaempfl
  3. This unit implements some support functions and global variables
  4. This program is free software; you can redistribute it and/or modify
  5. it under the terms of the GNU General Public License as published by
  6. the Free Software Foundation; either version 2 of the License, or
  7. (at your option) any later version.
  8. This program is distributed in the hope that it will be useful,
  9. but WITHOUT ANY WARRANTY; without even the implied warranty of
  10. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  11. GNU General Public License for more details.
  12. You should have received a copy of the GNU General Public License
  13. along with this program; if not, write to the Free Software
  14. Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  15. ****************************************************************************
  16. }
  17. unit globals;
  18. {$i fpcdefs.inc}
  19. interface
  20. uses
  21. {$ifdef win32}
  22. windows,
  23. {$endif}
  24. {$ifdef os2}
  25. dos,
  26. {$endif os2}
  27. {$ifdef hasunix}
  28. Baseunix,unix,
  29. {$endif}
  30. {$IFNDEF USE_FAKE_SYSUTILS}
  31. sysutils,
  32. {$ELSE}
  33. fksysutl,
  34. {$ENDIF}
  35. { comphook pulls in sysutils anyways }
  36. cutils,cclasses,cfileutl,
  37. cpuinfo,
  38. globtype,version,systems;
  39. const
  40. delphimodeswitches =
  41. [m_delphi,m_all,m_class,m_objpas,m_result,m_string_pchar,
  42. m_pointer_2_procedure,m_autoderef,m_tp_procvar,m_initfinal,m_default_ansistring,
  43. m_out,m_default_para,m_duplicate_names,m_hintdirective,m_add_pointer,
  44. m_property,m_default_inline,m_except];
  45. fpcmodeswitches =
  46. [m_fpc,m_all,m_string_pchar,m_nested_comment,m_repeat_forward,
  47. m_cvar_support,m_initfinal,m_add_pointer,m_hintdirective,
  48. m_property,m_default_inline];
  49. objfpcmodeswitches =
  50. [m_objfpc,m_fpc,m_all,m_class,m_objpas,m_result,m_string_pchar,m_nested_comment,
  51. m_repeat_forward,m_cvar_support,m_initfinal,m_add_pointer,m_out,m_default_para,m_hintdirective,
  52. m_property,m_default_inline,m_except];
  53. tpmodeswitches =
  54. [m_tp7,m_all,m_tp_procvar,m_duplicate_names];
  55. {$ifdef gpc_mode}
  56. gpcmodeswitches =
  57. [m_gpc,m_all,m_tp_procvar];
  58. {$endif}
  59. macmodeswitches =
  60. [m_mac,m_all,m_result,m_cvar_support,m_mac_procvar];
  61. { maximum nesting of routines }
  62. maxnesting = 32;
  63. { Filenames and extensions }
  64. sourceext = '.pp';
  65. pasext = '.pas';
  66. pext = '.p';
  67. treelogfilename = 'tree.log';
  68. {$if defined(CPUARM) and defined(FPUFPA)}
  69. MathQNaN : tdoublerec = (bytes : (0,0,252,255,0,0,0,0));
  70. MathInf : tdoublerec = (bytes : (0,0,240,127,0,0,0,0));
  71. MathNegInf : tdoublerec = (bytes : (0,0,240,255,0,0,0,0));
  72. MathPi : tdoublerec = (bytes : (251,33,9,64,24,45,68,84));
  73. {$else}
  74. {$ifdef FPC_LITTLE_ENDIAN}
  75. MathQNaN : tdoublerec = (bytes : (0,0,0,0,0,0,252,255));
  76. MathInf : tdoublerec = (bytes : (0,0,0,0,0,0,240,127));
  77. MathNegInf : tdoublerec = (bytes : (0,0,0,0,0,0,240,255));
  78. MathPi : tdoublerec = (bytes : (24,45,68,84,251,33,9,64));
  79. MathPiExtended : textendedrec = (bytes : (53,194,104,33,162,218,15,201,0,64));
  80. {$else FPC_LITTLE_ENDIAN}
  81. MathQNaN : tdoublerec = (bytes : (255,252,0,0,0,0,0,0));
  82. MathInf : tdoublerec = (bytes : (127,240,0,0,0,0,0,0));
  83. MathNegInf : tdoublerec = (bytes : (255,240,0,0,0,0,0,0));
  84. MathPi : tdoublerec = (bytes : (64,9,33,251,84,68,45,24));
  85. MathPiExtended : textendedrec = (bytes : (64,0,201,15,218,162,33,104,194,53));
  86. {$endif FPC_LITTLE_ENDIAN}
  87. {$endif}
  88. type
  89. tcodepagestring = string[20];
  90. { this is written to ppus during token recording for generics so it must be packed }
  91. tsettings = packed record
  92. alignment : talignmentinfo;
  93. globalswitches : tglobalswitches;
  94. moduleswitches : tmoduleswitches;
  95. localswitches : tlocalswitches;
  96. modeswitches : tmodeswitches;
  97. optimizerswitches : toptimizerswitches;
  98. { generate information necessary to perform these wpo's during a subsequent compilation }
  99. genwpoptimizerswitches: twpoptimizerswitches;
  100. { perform these wpo's using information generated during a previous compilation }
  101. dowpoptimizerswitches: twpoptimizerswitches;
  102. debugswitches : tdebugswitches;
  103. { 0: old behaviour for sets <=256 elements
  104. >0: round to this size }
  105. setalloc,
  106. packenum : shortint;
  107. packrecords : shortint;
  108. maxfpuregisters : shortint;
  109. cputype,
  110. optimizecputype : tcputype;
  111. fputype : tfputype;
  112. asmmode : tasmmode;
  113. interfacetype : tinterfacetypes;
  114. defproccall : tproccalloption;
  115. sourcecodepage : tcodepagestring;
  116. minfpconstprec : tfloattype;
  117. disabledircache : boolean;
  118. { CPU targets with microcontroller support can add a controller specific unit }
  119. {$if defined(ARM) or defined(AVR)}
  120. controllertype : tcontrollertype;
  121. {$endif defined(ARM) or defined(AVR)}
  122. end;
  123. const
  124. LinkMapWeightDefault = 1000;
  125. type
  126. TLinkRec = record
  127. Key : AnsiString;
  128. Value : AnsiString; // key expands to valuelist "value"
  129. Weight: longint;
  130. end;
  131. TLinkStrMap = class
  132. private
  133. itemcnt : longint;
  134. fmap : Array Of TLinkRec;
  135. function Lookup(key:Ansistring):longint;
  136. function getlinkrec(i:longint):TLinkRec;
  137. public
  138. procedure Add(key:ansistring;value:AnsiString='';weight:longint=LinkMapWeightDefault);
  139. procedure addseries(keys:AnsiString;weight:longint=LinkMapWeightDefault);
  140. function AddDep(keyvalue:String):boolean;
  141. function AddWeight(keyvalue:String):boolean;
  142. procedure SetValue(key:AnsiString;Weight:Integer);
  143. procedure SortonWeight;
  144. function Find(key:AnsiString):AnsiString;
  145. procedure Expand(src:TCmdStrList;dest: TLinkStrMap);
  146. procedure UpdateWeights(Weightmap:TLinkStrMap);
  147. constructor Create;
  148. property count : longint read itemcnt;
  149. property items[I:longint]:TLinkRec read getlinkrec; default;
  150. end;
  151. tpendingstate = record
  152. nextverbositystr : shortstring;
  153. nextlocalswitches : tlocalswitches;
  154. nextverbosityfullswitch: longint;
  155. nextcallingstr : shortstring;
  156. verbosityfullswitched,
  157. localswitcheschanged : boolean;
  158. end;
  159. var
  160. { specified inputfile }
  161. inputfilepath : string;
  162. inputfilename : string;
  163. { specified outputfile with -o parameter }
  164. outputfilename : string;
  165. outputprefix : pshortstring;
  166. outputsuffix : pshortstring;
  167. { specified with -FE or -FU }
  168. outputexedir : TPathStr;
  169. outputunitdir : TPathStr;
  170. { specified with -FW and -Fw }
  171. wpofeedbackinput,
  172. wpofeedbackoutput : TPathStr;
  173. { things specified with parameters }
  174. paratarget : tsystem;
  175. paratargetdbg : tdbg;
  176. paratargetasm : tasm;
  177. paralinkoptions : TCmdStr;
  178. paradynamiclinker : string;
  179. paraprintnodetree : byte;
  180. parapreprocess : boolean;
  181. printnodefile : text;
  182. { typical cross compiling params}
  183. { directory where the utils can be found (options -FD) }
  184. utilsdirectory : TPathStr;
  185. { targetname specific prefix used by these utils (options -XP<path>) }
  186. utilsprefix : TCmdStr;
  187. cshared : boolean; { pass --shared to ld to link C libs shared}
  188. Dontlinkstdlibpath: Boolean; { Don't add std paths to linkpath}
  189. rlinkpath : TCmdStr; { rpath-link linkdir override}
  190. sysrootpath : TCmdStr; { target system root to search dyn linker }
  191. { some flags for global compiler switches }
  192. do_build,
  193. do_release,
  194. do_make : boolean;
  195. { path for searching units, different paths can be seperated by ; }
  196. exepath : TPathStr; { Path to ppc }
  197. librarysearchpath,
  198. unitsearchpath,
  199. objectsearchpath,
  200. includesearchpath,
  201. frameworksearchpath : TSearchPathList;
  202. autoloadunits : string;
  203. { linking }
  204. usewindowapi : boolean;
  205. description : string;
  206. SetPEFlagsSetExplicity,
  207. ImageBaseSetExplicity,
  208. MinStackSizeSetExplicity,
  209. MaxStackSizeSetExplicity,
  210. DescriptionSetExplicity : boolean;
  211. dllversion : string;
  212. dllmajor,
  213. dllminor,
  214. dllrevision : word; { revision only for netware }
  215. { win pe }
  216. peflags : longint;
  217. minstacksize,
  218. maxstacksize,
  219. imagebase : puint;
  220. UseDeffileForExports : boolean;
  221. UseDeffileForExportsSetExplicitly : boolean;
  222. GenerateImportSection,
  223. GenerateImportSectionSetExplicitly,
  224. RelocSection : boolean;
  225. RelocSectionSetExplicitly : boolean;
  226. LinkTypeSetExplicitly : boolean;
  227. current_tokenpos, { position of the last token }
  228. current_filepos : tfileposinfo; { current position }
  229. nwscreenname : string;
  230. nwthreadname : string;
  231. nwcopyright : string;
  232. codegenerror : boolean; { true if there is an error reported }
  233. block_type : tblock_type; { type of currently parsed block }
  234. compile_level : word;
  235. exceptblockcounter : integer; { each except block gets a unique number check gotos }
  236. current_exceptblock : integer; { the exceptblock number of the current block (0 if none) }
  237. LinkLibraryAliases : TLinkStrMap;
  238. LinkLibraryOrder : TLinkStrMap;
  239. init_settings,
  240. current_settings : tsettings;
  241. pendingstate : tpendingstate;
  242. { Memory sizes }
  243. heapsize,
  244. stacksize,
  245. jmp_buf_size,
  246. jmp_buf_align : longint;
  247. {$Ifdef EXTDEBUG}
  248. { parameter switches }
  249. debugstop : boolean;
  250. {$EndIf EXTDEBUG}
  251. { windows / OS/2 application type }
  252. apptype : tapptype;
  253. features : tfeatures;
  254. const
  255. DLLsource : boolean = false;
  256. { used to set all registers used for each global function
  257. this should dramatically decrease the number of
  258. recompilations needed PM }
  259. simplify_ppu : boolean = true;
  260. Inside_asm_statement : boolean = false;
  261. global_unit_count : word = 0;
  262. { for error info in pp.pas }
  263. parser_current_file : string = '';
  264. {$if defined(m68k) or defined(arm)}
  265. { PalmOS resources }
  266. palmos_applicationname : string = 'FPC Application';
  267. palmos_applicationid : string[4] = 'FPCA';
  268. {$endif defined(m68k) or defined(arm)}
  269. {$ifdef powerpc}
  270. { default calling convention used on MorphOS }
  271. syscall_convention : string = 'LEGACY';
  272. {$endif powerpc}
  273. { default name of the C-style "main" procedure of the library/program }
  274. { (this will be prefixed with the target_info.cprefix) }
  275. defaultmainaliasname = 'main';
  276. mainaliasname : string = defaultmainaliasname;
  277. { by default no local variable trashing }
  278. localvartrashing: longint = -1;
  279. { actual values are defined in ncgutil.pas }
  280. nroftrashvalues = 4;
  281. const
  282. default_settings : TSettings = (
  283. alignment : (
  284. procalign : 0;
  285. loopalign : 0;
  286. jumpalign : 0;
  287. constalignmin : 0;
  288. constalignmax : 0;
  289. varalignmin : 0;
  290. varalignmax : 0;
  291. localalignmin : 0;
  292. localalignmax : 0;
  293. recordalignmin : 0;
  294. recordalignmax : 0;
  295. maxCrecordalign : 0;
  296. );
  297. globalswitches : [cs_check_unit_name,cs_link_static];
  298. moduleswitches : [cs_extsyntax,cs_implicit_exceptions];
  299. localswitches : [cs_check_io,cs_typed_const_writable];
  300. modeswitches : fpcmodeswitches;
  301. optimizerswitches : [];
  302. genwpoptimizerswitches : [];
  303. dowpoptimizerswitches : [];
  304. debugswitches : [];
  305. setalloc : 0;
  306. packenum : 4;
  307. packrecords : 0;
  308. maxfpuregisters : 0;
  309. {$ifdef i386}
  310. cputype : cpu_Pentium;
  311. optimizecputype : cpu_Pentium3;
  312. fputype : fpu_x87;
  313. {$endif i386}
  314. {$ifdef m68k}
  315. cputype : cpu_MC68020;
  316. optimizecputype : cpu_MC68020;
  317. fputype : fpu_soft;
  318. {$endif m68k}
  319. {$ifdef powerpc}
  320. cputype : cpu_PPC604;
  321. optimizecputype : cpu_ppc7400;
  322. fputype : fpu_standard;
  323. {$endif powerpc}
  324. {$ifdef POWERPC64}
  325. cputype : cpu_PPC970;
  326. optimizecputype : cpu_ppc970;
  327. fputype : fpu_standard;
  328. {$endif POWERPC64}
  329. {$ifdef sparc}
  330. cputype : cpu_SPARC_V8;
  331. optimizecputype : cpu_SPARC_V8;
  332. fputype : fpu_hard;
  333. {$endif sparc}
  334. {$ifdef arm}
  335. cputype : cpu_armv3;
  336. optimizecputype : cpu_armv3;
  337. fputype : fpu_fpa;
  338. {$endif arm}
  339. {$ifdef x86_64}
  340. cputype : cpu_athlon64;
  341. optimizecputype : cpu_athlon64;
  342. fputype : fpu_sse64;
  343. {$endif x86_64}
  344. {$ifdef avr}
  345. cputype : cpuinfo.cpu_avr;
  346. optimizecputype : cpuinfo.cpu_avr;
  347. fputype : fpu_none;
  348. {$endif avr}
  349. {$ifdef mips}
  350. cputype : cpu_mips32;
  351. optimizecputype : cpu_mips32;
  352. fputype : fpu_mips2;
  353. {$endif mips}
  354. asmmode : asmmode_standard;
  355. interfacetype : it_interfacecom;
  356. defproccall : pocall_default;
  357. sourcecodepage : '8859-1';
  358. minfpconstprec : s32real;
  359. disabledircache : false;
  360. {$if defined(ARM)}
  361. controllertype : ct_none;
  362. {$endif defined(ARM)}
  363. );
  364. var
  365. starttime : real;
  366. function getdatestr:string;
  367. function gettimestr:string;
  368. function filetimestring( t : longint) : string;
  369. function getrealtime : real;
  370. procedure DefaultReplacements(var s:ansistring);
  371. function Shell(const command:ansistring): longint;
  372. function GetEnvPChar(const envname:string):pchar;
  373. procedure FreeEnvPChar(p:pchar);
  374. function is_number_float(d : double) : boolean;
  375. { discern +0.0 and -0.0 }
  376. function get_real_sign(r: bestreal): longint;
  377. procedure InitGlobals;
  378. procedure DoneGlobals;
  379. function string2guid(const s: string; var GUID: TGUID): boolean;
  380. function guid2string(const GUID: TGUID): string;
  381. function SetAktProcCall(const s:string; var a:tproccalloption):boolean;
  382. function Setabitype(const s:string;var a:tabi):boolean;
  383. function Setcputype(const s:string;var a:tcputype):boolean;
  384. function SetFpuType(const s:string;var a:tfputype):boolean;
  385. {$if defined(arm) or defined(avr)}
  386. function SetControllerType(const s:string;var a:tcontrollertype):boolean;
  387. {$endif defined(arm) or defined(avr)}
  388. function UpdateAlignmentStr(s:string;var a:talignmentinfo):boolean;
  389. function UpdateOptimizerStr(s:string;var a:toptimizerswitches):boolean;
  390. function UpdateWpoStr(s: string; var a: twpoptimizerswitches): boolean;
  391. function UpdateDebugStr(s:string;var a:tdebugswitches):boolean;
  392. function IncludeFeature(const s : string) : boolean;
  393. function SetMinFPConstPrec(const s: string; var a: tfloattype) : boolean;
  394. {# Routine to get the required alignment for size of data, which will
  395. be placed in bss segment, according to the current alignment requirements }
  396. function var_align(want_align: longint): shortint;
  397. function var_align_size(siz: longint): shortint;
  398. {# Routine to get the required alignment for size of data, which will
  399. be placed in data/const segment, according to the current alignment requirements }
  400. function const_align(want_align: longint): shortint;
  401. function const_align_size(siz: longint): shortint;
  402. {$ifdef ARM}
  403. function is_double_hilo_swapped: boolean;{$ifdef USEINLINE}inline;{$endif}
  404. {$endif ARM}
  405. function floating_point_range_check_error : boolean;
  406. implementation
  407. uses
  408. {$ifdef macos}
  409. macutils,
  410. {$endif}
  411. comphook;
  412. {****************************************************************************
  413. TLinkStrMap
  414. ****************************************************************************}
  415. Constructor TLinkStrMap.create;
  416. begin
  417. inherited;
  418. itemcnt:=0;
  419. end;
  420. procedure TLinkStrMap.Add(key:ansistring;value:AnsiString='';weight:longint=LinkMapWeightDefault);
  421. begin
  422. if lookup(key)<>-1 Then
  423. exit;
  424. if itemcnt<=length(fmap) Then
  425. setlength(fmap,itemcnt+10);
  426. fmap[itemcnt].key:=key;
  427. fmap[itemcnt].value:=value;
  428. fmap[itemcnt].weight:=weight;
  429. inc(itemcnt);
  430. end;
  431. function TLinkStrMap.AddDep(keyvalue:String):boolean;
  432. var
  433. i : Longint;
  434. begin
  435. AddDep:=false;
  436. i:=pos('=',keyvalue);
  437. if i=0 then
  438. exit;
  439. Add(Copy(KeyValue,1,i-1),Copy(KeyValue,i+1,length(KeyValue)-i));
  440. AddDep:=True;
  441. end;
  442. function TLinkStrMap.AddWeight(keyvalue:String):boolean;
  443. var
  444. i,j : Longint;
  445. Code : Word;
  446. s : AnsiString;
  447. begin
  448. AddWeight:=false;
  449. i:=pos('=',keyvalue);
  450. if i=0 then
  451. exit;
  452. s:=Copy(KeyValue,i+1,length(KeyValue)-i);
  453. val(s,j,code);
  454. if code=0 Then
  455. begin
  456. Add(Copy(KeyValue,1,i-1),'',j);
  457. AddWeight:=True;
  458. end;
  459. end;
  460. procedure TLinkStrMap.addseries(keys:AnsiString;weight:longint);
  461. var
  462. i,j,k : longint;
  463. begin
  464. k:=length(keys);
  465. i:=1;
  466. while i<=k do
  467. begin
  468. j:=i;
  469. while (i<=k) and (keys[i]<>',') do
  470. inc(i);
  471. add(copy(keys,j,i-j),'',weight);
  472. inc(i);
  473. end;
  474. end;
  475. procedure TLinkStrMap.SetValue(Key:Ansistring;weight:Integer);
  476. var
  477. j : longint;
  478. begin
  479. j:=lookup(key);
  480. if j<>-1 then
  481. fmap[j].weight:=weight;
  482. end;
  483. function TLinkStrMap.find(key:Ansistring):Ansistring;
  484. var
  485. j : longint;
  486. begin
  487. find:='';
  488. j:=lookup(key);
  489. if j<>-1 then
  490. find:=fmap[j].value;
  491. end;
  492. function TLinkStrMap.lookup(key:Ansistring):longint;
  493. var
  494. i : longint;
  495. begin
  496. lookup:=-1;
  497. i:=0;
  498. while (i<itemcnt) and (fmap[i].key<>key) do
  499. inc(i);
  500. if i<>itemcnt then
  501. lookup:=i;
  502. end;
  503. procedure TLinkStrMap.SortOnWeight;
  504. var
  505. i, j : longint;
  506. m : TLinkRec;
  507. begin
  508. if itemcnt <2 then exit;
  509. for i:=0 to itemcnt-1 do
  510. for j:=i+1 to itemcnt-1 do
  511. begin
  512. if fmap[i].weight>fmap[j].weight Then
  513. begin
  514. m:=fmap[i];
  515. fmap[i]:=fmap[j];
  516. fmap[j]:=m;
  517. end;
  518. end;
  519. end;
  520. function TLinkStrMap.getlinkrec(i:longint):TLinkRec;
  521. begin
  522. result:=fmap[i];
  523. end;
  524. procedure TLinkStrMap.Expand(Src:TCmdStrList;Dest:TLinkStrMap);
  525. // expands every thing in Src to Dest for linkorder purposes.
  526. var
  527. r : longint;
  528. LibN : TCmdStr;
  529. begin
  530. while not src.empty do
  531. begin
  532. LibN:=src.getfirst;
  533. r:=lookup (LibN);
  534. if r=-1 then
  535. dest.add(LibN)
  536. else
  537. dest.addseries(fmap[r].value);
  538. end;
  539. end;
  540. procedure TLinkStrMap.UpdateWeights(Weightmap:TLinkStrMap);
  541. var
  542. l,r : longint;
  543. begin
  544. for l := 0 to itemcnt-1 do
  545. begin
  546. r:=weightmap.lookup (fmap[l].key);
  547. if r<>-1 then
  548. fmap[l].weight:=weightmap[r].weight;
  549. end;
  550. end;
  551. {****************************************************************************
  552. Time Handling
  553. ****************************************************************************}
  554. Function L0(l:longint):string;
  555. {
  556. return the string of value l, if l<10 then insert a zero, so
  557. the string is always at least 2 chars '01','02',etc
  558. }
  559. var
  560. s : string;
  561. begin
  562. Str(l,s);
  563. if l<10 then
  564. s:='0'+s;
  565. L0:=s;
  566. end;
  567. function gettimestr:string;
  568. {
  569. get the current time in a string HH:MM:SS
  570. }
  571. var
  572. hour,min,sec,hsec : word;
  573. begin
  574. DecodeTime(Time,hour,min,sec,hsec);
  575. gettimestr:=L0(Hour)+':'+L0(min)+':'+L0(sec);
  576. end;
  577. function getdatestr:string;
  578. {
  579. get the current date in a string YY/MM/DD
  580. }
  581. var
  582. Year,Month,Day: Word;
  583. begin
  584. DecodeDate(Date,year,month,day);
  585. getdatestr:=L0(Year)+'/'+L0(Month)+'/'+L0(Day);
  586. end;
  587. function filetimestring( t : longint) : string;
  588. {
  589. convert dos datetime t to a string YY/MM/DD HH:MM:SS
  590. }
  591. var
  592. DT : TDateTime;
  593. hsec : word;
  594. Year,Month,Day: Word;
  595. hour,min,sec : word;
  596. begin
  597. if t=-1 then
  598. begin
  599. Result := 'Not Found';
  600. exit;
  601. end;
  602. DT := FileDateToDateTime(t);
  603. DecodeTime(DT,hour,min,sec,hsec);
  604. DecodeDate(DT,year,month,day);
  605. Result := L0(Year)+'/'+L0(Month)+'/'+L0(Day)+' '+L0(Hour)+':'+L0(min)+':'+L0(sec);
  606. end;
  607. function getrealtime : real;
  608. var
  609. h,m,s,s1000 : word;
  610. begin
  611. DecodeTime(Time,h,m,s,s1000);
  612. result:=h*3600.0+m*60.0+s+s1000/1000.0;
  613. end;
  614. {****************************************************************************
  615. Default Macro Handling
  616. ****************************************************************************}
  617. procedure DefaultReplacements(var s:ansistring);
  618. begin
  619. { Replace some macros }
  620. Replace(s,'$FPCVERSION',version_string);
  621. Replace(s,'$FPCFULLVERSION',full_version_string);
  622. Replace(s,'$FPCDATE',date_string);
  623. Replace(s,'$FPCCPU',target_cpu_string);
  624. Replace(s,'$FPCOS',target_os_string);
  625. if tf_use_8_3 in Source_Info.Flags then
  626. Replace(s,'$FPCTARGET',target_os_string)
  627. else
  628. Replace(s,'$FPCTARGET',target_full_string);
  629. end;
  630. {****************************************************************************
  631. OS Dependent things
  632. ****************************************************************************}
  633. function GetEnvPChar(const envname:string):pchar;
  634. {$ifdef win32}
  635. var
  636. s : string;
  637. i,len : longint;
  638. hp,p,p2 : pchar;
  639. {$endif}
  640. begin
  641. {$ifdef hasunix}
  642. GetEnvPchar:=BaseUnix.fpGetEnv(envname);
  643. {$define GETENVOK}
  644. {$endif}
  645. {$ifdef win32}
  646. GetEnvPchar:=nil;
  647. p:=GetEnvironmentStrings;
  648. hp:=p;
  649. while hp^<>#0 do
  650. begin
  651. s:=strpas(hp);
  652. i:=pos('=',s);
  653. len:=strlen(hp);
  654. if upper(copy(s,1,i-1))=upper(envname) then
  655. begin
  656. GetMem(p2,len-length(envname));
  657. Move(hp[i],p2^,len-length(envname));
  658. GetEnvPchar:=p2;
  659. break;
  660. end;
  661. { next string entry}
  662. hp:=hp+len+1;
  663. end;
  664. FreeEnvironmentStrings(p);
  665. {$define GETENVOK}
  666. {$endif}
  667. {$ifdef os2}
  668. GetEnvPChar := Dos.GetEnvPChar (EnvName);
  669. {$define GETENVOK}
  670. {$endif}
  671. {$ifdef GETENVOK}
  672. {$undef GETENVOK}
  673. {$else}
  674. GetEnvPchar:=StrPNew(GetEnvironmentVariable(envname));
  675. {$endif}
  676. end;
  677. procedure FreeEnvPChar(p:pchar);
  678. begin
  679. {$ifndef hasunix}
  680. {$ifndef os2}
  681. freemem(p);
  682. {$endif}
  683. {$endif}
  684. end;
  685. {$if defined(MORPHOS) or defined(AMIGA)}
  686. {$define AMIGASHELL}
  687. {$endif}
  688. function Shell(const command:ansistring): longint;
  689. { This is already defined in the linux.ppu for linux, need for the *
  690. expansion under linux }
  691. {$ifdef hasunix}
  692. begin
  693. result := Unix.fpsystem(command);
  694. end;
  695. {$else hasunix}
  696. {$ifdef amigashell}
  697. begin
  698. result := ExecuteProcess('',command);
  699. end;
  700. {$else amigashell}
  701. var
  702. comspec : string;
  703. begin
  704. comspec:=GetEnvironmentVariable('COMSPEC');
  705. result := ExecuteProcess(comspec,' /C '+command);
  706. end;
  707. {$endif amigashell}
  708. {$endif hasunix}
  709. {$UNDEF AMIGASHELL}
  710. function is_number_float(d : double) : boolean;
  711. var
  712. bytearray : array[0..7] of byte;
  713. begin
  714. move(d,bytearray,8);
  715. { only 1.1 save, 1.0.x will use always little endian }
  716. {$ifdef FPC_BIG_ENDIAN}
  717. result:=((bytearray[0] and $7f)<>$7f) or ((bytearray[1] and $f0)<>$f0);
  718. {$else FPC_BIG_ENDIAN}
  719. result:=((bytearray[7] and $7f)<>$7f) or ((bytearray[6] and $f0)<>$f0);
  720. {$endif FPC_BIG_ENDIAN}
  721. end;
  722. function get_real_sign(r: bestreal): longint;
  723. var
  724. p: pbyte;
  725. begin
  726. p := pbyte(@r);
  727. {$ifdef CPU_ARM}
  728. inc(p,4);
  729. {$else}
  730. {$ifdef FPC_LITTLE_ENDIAN}
  731. inc(p,sizeof(r)-1);
  732. {$endif}
  733. {$endif}
  734. if (p^ and $80) = 0 then
  735. result := 1
  736. else
  737. result := -1;
  738. end;
  739. function convertdoublerec(d : tdoublerec) : tdoublerec;{$ifdef USEINLINE}inline;{$endif}
  740. {$ifdef CPUARM}
  741. var
  742. i : longint;
  743. begin
  744. for i:=0 to 3 do
  745. begin
  746. result.bytes[i+4]:=d.bytes[i];
  747. result.bytes[i]:=d.bytes[i+4];
  748. end;
  749. {$else CPUARM}
  750. begin
  751. result:=d;
  752. {$endif CPUARM}
  753. end;
  754. { '('D1:'00000000-'D2:'0000-'D3:'0000-'D4:'0000-000000000000)' }
  755. function string2guid(const s: string; var GUID: TGUID): boolean;
  756. function ishexstr(const hs: string): boolean;
  757. var
  758. i: integer;
  759. begin
  760. ishexstr:=false;
  761. for i:=1 to Length(hs) do begin
  762. if not (hs[i] in ['0'..'9','A'..'F','a'..'f']) then
  763. exit;
  764. end;
  765. ishexstr:=true;
  766. end;
  767. function hexstr2longint(const hexs: string): longint;
  768. var
  769. i: integer;
  770. rl: longint;
  771. begin
  772. rl:=0;
  773. for i:=1 to length(hexs) do begin
  774. rl:=rl shl 4;
  775. case hexs[i] of
  776. '0'..'9' : inc(rl,ord(hexs[i])-ord('0'));
  777. 'A'..'F' : inc(rl,ord(hexs[i])-ord('A')+10);
  778. 'a'..'f' : inc(rl,ord(hexs[i])-ord('a')+10);
  779. end
  780. end;
  781. hexstr2longint:=rl;
  782. end;
  783. var
  784. i: integer;
  785. begin
  786. if (Length(s)=38) and (s[1]='{') and (s[38]='}') and
  787. (s[10]='-') and (s[15]='-') and (s[20]='-') and (s[25]='-') and
  788. ishexstr(copy(s,2,8)) and ishexstr(copy(s,11,4)) and
  789. ishexstr(copy(s,16,4)) and ishexstr(copy(s,21,4)) and
  790. ishexstr(copy(s,26,12)) then begin
  791. GUID.D1:=dword(hexstr2longint(copy(s,2,8)));
  792. { these values are arealdy in the correct range (4 chars = word) }
  793. GUID.D2:=word(hexstr2longint(copy(s,11,4)));
  794. GUID.D3:=word(hexstr2longint(copy(s,16,4)));
  795. for i:=0 to 1 do
  796. GUID.D4[i]:=byte(hexstr2longint(copy(s,21+i*2,2)));
  797. for i:=2 to 7 do
  798. GUID.D4[i]:=byte(hexstr2longint(copy(s,22+i*2,2)));
  799. string2guid:=true;
  800. end
  801. else if (length(s)=0) then
  802. begin
  803. FillChar(GUID,SizeOf(GUID),0);
  804. string2guid:=true;
  805. end
  806. else
  807. string2guid:=false;
  808. end;
  809. function guid2string(const GUID: TGUID): string;
  810. begin
  811. guid2string:=
  812. '{'+hexstr(GUID.D1,8)+
  813. '-'+hexstr(GUID.D2,4)+
  814. '-'+hexstr(GUID.D3,4)+
  815. '-'+hexstr(GUID.D4[0],2)+hexstr(GUID.D4[1],2)+
  816. '-'+hexstr(GUID.D4[2],2)+hexstr(GUID.D4[3],2)+
  817. hexstr(GUID.D4[4],2)+hexstr(GUID.D4[5],2)+
  818. hexstr(GUID.D4[6],2)+hexstr(GUID.D4[7],2)+
  819. '}';
  820. end;
  821. function SetAktProcCall(const s:string; var a:tproccalloption):boolean;
  822. const
  823. DefProcCallName : array[tproccalloption] of string[12] = ('',
  824. 'CDECL',
  825. 'CPPDECL',
  826. 'FAR16',
  827. 'OLDFPCCALL',
  828. '', { internproc }
  829. '', { syscall }
  830. 'PASCAL',
  831. 'REGISTER',
  832. 'SAFECALL',
  833. 'STDCALL',
  834. 'SOFTFLOAT',
  835. 'MWPASCAL'
  836. );
  837. var
  838. t : tproccalloption;
  839. hs : string;
  840. begin
  841. result:=false;
  842. if (s = '') then
  843. exit;
  844. hs:=upper(s);
  845. if (hs = 'DEFAULT') then
  846. begin
  847. a := pocall_default;
  848. result := true;
  849. exit;
  850. end;
  851. for t:=low(tproccalloption) to high(tproccalloption) do
  852. if DefProcCallName[t]=hs then
  853. begin
  854. a:=t;
  855. result:=true;
  856. break;
  857. end;
  858. end;
  859. function Setabitype(const s:string;var a:tabi):boolean;
  860. var
  861. t : tabi;
  862. hs : string;
  863. begin
  864. result:=false;
  865. hs:=Upper(s);
  866. for t:=low(t) to high(t) do
  867. if abi2str[t]=hs then
  868. begin
  869. a:=t;
  870. result:=true;
  871. break;
  872. end;
  873. end;
  874. function Setcputype(const s:string;var a:tcputype):boolean;
  875. var
  876. t : tcputype;
  877. hs : string;
  878. begin
  879. result:=false;
  880. hs:=Upper(s);
  881. for t:=low(tcputype) to high(tcputype) do
  882. if cputypestr[t]=hs then
  883. begin
  884. a:=t;
  885. result:=true;
  886. break;
  887. end;
  888. end;
  889. function SetFpuType(const s:string;var a:tfputype):boolean;
  890. var
  891. t : tfputype;
  892. begin
  893. result:=false;
  894. for t:=low(tfputype) to high(tfputype) do
  895. if fputypestr[t]=s then
  896. begin
  897. a:=t;
  898. result:=true;
  899. break;
  900. end;
  901. end;
  902. {$if defined(arm) or defined(avr)}
  903. function SetControllerType(const s:string;var a:tcontrollertype):boolean;
  904. var
  905. t : tcontrollertype;
  906. hs : string;
  907. begin
  908. result:=false;
  909. hs:=Upper(s);
  910. for t:=low(tcontrollertype) to high(tcontrollertype) do
  911. if controllertypestr[t]=hs then
  912. begin
  913. a:=t;
  914. result:=true;
  915. break;
  916. end;
  917. end;
  918. {$endif defined(arm) or defined(avr)}
  919. function UpdateAlignmentStr(s:string;var a:talignmentinfo):boolean;
  920. var
  921. tok : string;
  922. vstr : string;
  923. l : longint;
  924. code : integer;
  925. b : talignmentinfo;
  926. begin
  927. UpdateAlignmentStr:=true;
  928. uppervar(s);
  929. fillchar(b,sizeof(b),0);
  930. repeat
  931. tok:=GetToken(s,'=');
  932. if tok='' then
  933. break;
  934. vstr:=GetToken(s,',');
  935. val(vstr,l,code);
  936. if tok='PROC' then
  937. b.procalign:=l
  938. else if tok='JUMP' then
  939. b.jumpalign:=l
  940. else if tok='LOOP' then
  941. b.loopalign:=l
  942. else if tok='CONSTMIN' then
  943. begin
  944. b.constalignmin:=l;
  945. if l>b.constalignmax then
  946. b.constalignmax:=l;
  947. end
  948. else if tok='CONSTMAX' then
  949. b.constalignmax:=l
  950. else if tok='VARMIN' then
  951. begin
  952. b.varalignmin:=l;
  953. if l>b.varalignmax then
  954. b.varalignmax:=l;
  955. end
  956. else if tok='VARMAX' then
  957. b.varalignmax:=l
  958. else if tok='LOCALMIN' then
  959. begin
  960. b.localalignmin:=l;
  961. if l>b.localalignmax then
  962. b.localalignmax:=l;
  963. end
  964. else if tok='LOCALMAX' then
  965. b.localalignmax:=l
  966. else if tok='RECORDMIN' then
  967. begin
  968. b.recordalignmin:=l;
  969. if l>b.recordalignmax then
  970. b.recordalignmax:=l;
  971. end
  972. else if tok='RECORDMAX' then
  973. b.recordalignmax:=l
  974. else { Error }
  975. UpdateAlignmentStr:=false;
  976. until false;
  977. UpdateAlignment(a,b);
  978. end;
  979. function UpdateOptimizerStr(s:string;var a:toptimizerswitches):boolean;
  980. var
  981. tok : string;
  982. doset,
  983. found : boolean;
  984. opt : toptimizerswitch;
  985. begin
  986. result:=true;
  987. uppervar(s);
  988. repeat
  989. tok:=GetToken(s,',');
  990. if tok='' then
  991. break;
  992. if Copy(tok,1,2)='NO' then
  993. begin
  994. delete(tok,1,2);
  995. doset:=false;
  996. end
  997. else
  998. doset:=true;
  999. found:=false;
  1000. for opt:=low(toptimizerswitch) to high(toptimizerswitch) do
  1001. begin
  1002. if OptimizerSwitchStr[opt]=tok then
  1003. begin
  1004. found:=true;
  1005. break;
  1006. end;
  1007. end;
  1008. if found then
  1009. begin
  1010. if doset then
  1011. include(a,opt)
  1012. else
  1013. exclude(a,opt);
  1014. end
  1015. else
  1016. result:=false;
  1017. until false;
  1018. end;
  1019. function UpdateWpoStr(s: string; var a: twpoptimizerswitches): boolean;
  1020. var
  1021. tok : string;
  1022. doset,
  1023. found : boolean;
  1024. opt : twpoptimizerswitch;
  1025. begin
  1026. result:=true;
  1027. uppervar(s);
  1028. repeat
  1029. tok:=GetToken(s,',');
  1030. if tok='' then
  1031. break;
  1032. if Copy(tok,1,2)='NO' then
  1033. begin
  1034. delete(tok,1,2);
  1035. doset:=false;
  1036. end
  1037. else
  1038. doset:=true;
  1039. found:=false;
  1040. if (tok = 'ALL') then
  1041. begin
  1042. for opt:=low(twpoptimizerswitch) to high(twpoptimizerswitch) do
  1043. if doset then
  1044. include(a,opt)
  1045. else
  1046. exclude(a,opt);
  1047. end
  1048. else
  1049. begin
  1050. for opt:=low(twpoptimizerswitch) to high(twpoptimizerswitch) do
  1051. begin
  1052. if WPOptimizerSwitchStr[opt]=tok then
  1053. begin
  1054. found:=true;
  1055. break;
  1056. end;
  1057. end;
  1058. if found then
  1059. begin
  1060. if doset then
  1061. include(a,opt)
  1062. else
  1063. exclude(a,opt);
  1064. end
  1065. else
  1066. result:=false;
  1067. end;
  1068. until false;
  1069. end;
  1070. function UpdateDebugStr(s:string;var a:tdebugswitches):boolean;
  1071. var
  1072. tok : string;
  1073. doset,
  1074. found : boolean;
  1075. opt : tdebugswitch;
  1076. begin
  1077. result:=true;
  1078. uppervar(s);
  1079. repeat
  1080. tok:=GetToken(s,',');
  1081. if tok='' then
  1082. break;
  1083. if Copy(tok,1,2)='NO' then
  1084. begin
  1085. delete(tok,1,2);
  1086. doset:=false;
  1087. end
  1088. else
  1089. doset:=true;
  1090. found:=false;
  1091. for opt:=low(tdebugswitch) to high(tdebugswitch) do
  1092. begin
  1093. if DebugSwitchStr[opt]=tok then
  1094. begin
  1095. found:=true;
  1096. break;
  1097. end;
  1098. end;
  1099. if found then
  1100. begin
  1101. if doset then
  1102. include(a,opt)
  1103. else
  1104. exclude(a,opt);
  1105. end
  1106. else
  1107. result:=false;
  1108. until false;
  1109. end;
  1110. function IncludeFeature(const s : string) : boolean;
  1111. var
  1112. i : tfeature;
  1113. begin
  1114. result:=true;
  1115. for i:=low(tfeature) to high(tfeature) do
  1116. if s=featurestr[i] then
  1117. begin
  1118. include(features,i);
  1119. exit;
  1120. end;
  1121. result:=false;
  1122. end;
  1123. function SetMinFPConstPrec(const s: string; var a: tfloattype) : boolean;
  1124. var
  1125. value, error: longint;
  1126. begin
  1127. if (upper(s)='DEFAULT') then
  1128. begin
  1129. a:=s32real;
  1130. result:=true;
  1131. exit;
  1132. end;
  1133. result:=false;
  1134. val(s,value,error);
  1135. if (error<>0) then
  1136. exit;
  1137. case value of
  1138. 32: a:=s32real;
  1139. 64: a:=s64real;
  1140. { adding support for 80 bit here is tricky, since we can't really }
  1141. { check whether the target cpu+OS actually supports it }
  1142. else
  1143. exit;
  1144. end;
  1145. result:=true;
  1146. end;
  1147. function var_align(want_align: longint): shortint;
  1148. begin
  1149. var_align := used_align(want_align,current_settings.alignment.varalignmin,current_settings.alignment.varalignmax);
  1150. end;
  1151. function var_align_size(siz: longint): shortint;
  1152. begin
  1153. siz := size_2_align(siz);
  1154. var_align_size := var_align(siz);
  1155. end;
  1156. function const_align(want_align: longint): shortint;
  1157. begin
  1158. const_align := used_align(want_align,current_settings.alignment.constalignmin,current_settings.alignment.constalignmax);
  1159. end;
  1160. function const_align_size(siz: longint): shortint;
  1161. begin
  1162. siz := size_2_align(siz);
  1163. const_align_size := const_align(siz);
  1164. end;
  1165. {$ifdef ARM}
  1166. function is_double_hilo_swapped: boolean;{$ifdef USEINLINE}inline;{$endif}
  1167. begin
  1168. result := (current_settings.fputype in [fpu_fpa,fpu_fpa10,fpu_fpa11]) and
  1169. not(cs_fp_emulation in current_settings.moduleswitches);
  1170. {$ifdef FPC_DOUBLE_HILO_SWAPPED}
  1171. { inverse result if compiler was compiled with swapped hilo already }
  1172. result := not result;
  1173. {$endif FPC_DOUBLE_HILO_SWAPPED}
  1174. end;
  1175. {$endif ARM}
  1176. function floating_point_range_check_error : boolean;
  1177. begin
  1178. result:=((([cs_check_range,cs_check_overflow]*current_settings.localswitches)<>[]) and not
  1179. (m_delphi in current_settings.modeswitches)
  1180. ); // or (cs_ieee_errors in current_settings.localswitches);
  1181. end;
  1182. {****************************************************************************
  1183. Init
  1184. ****************************************************************************}
  1185. {$ifdef unix}
  1186. {$define need_path_search}
  1187. {$endif unix}
  1188. {$ifdef os2}
  1189. {$define need_path_search}
  1190. {$endif os2}
  1191. {$ifdef macos}
  1192. {$define need_path_search}
  1193. {$endif macos}
  1194. procedure get_exepath;
  1195. var
  1196. localExepath : TCmdStr;
  1197. exeName:TCmdStr;
  1198. {$ifdef need_path_search}
  1199. hs1 : TPathStr;
  1200. {$endif need_path_search}
  1201. begin
  1202. localexepath:=GetEnvironmentVariable('PPC_EXEC_PATH');
  1203. if localexepath='' then
  1204. begin
  1205. exeName := FixFileName(system.paramstr(0));
  1206. localexepath := ExtractFilePath(exeName);
  1207. end;
  1208. {$ifdef need_path_search}
  1209. if localexepath='' then
  1210. begin
  1211. hs1 := ExtractFileName(exeName);
  1212. ChangeFileExt(hs1,source_info.exeext);
  1213. {$ifdef macos}
  1214. FindFile(hs1,GetEnvironmentVariable('Commands'),false,localExepath);
  1215. {$else macos}
  1216. FindFile(hs1,GetEnvironmentVariable('PATH'),false,localExepath);
  1217. {$endif macos}
  1218. localExepath:=ExtractFilePath(localExepath);
  1219. end;
  1220. {$endif need_path_search}
  1221. exepath:=FixPath(localExepath,false);
  1222. end;
  1223. procedure DoneGlobals;
  1224. begin
  1225. librarysearchpath.Free;
  1226. unitsearchpath.Free;
  1227. objectsearchpath.Free;
  1228. includesearchpath.Free;
  1229. frameworksearchpath.Free;
  1230. LinkLibraryAliases.Free;
  1231. LinkLibraryOrder.Free;
  1232. end;
  1233. procedure InitGlobals;
  1234. begin
  1235. get_exepath;
  1236. { reset globals }
  1237. do_build:=false;
  1238. do_release:=false;
  1239. do_make:=true;
  1240. compile_level:=0;
  1241. codegenerror:=false;
  1242. DLLsource:=false;
  1243. paratarget:=system_none;
  1244. paratargetasm:=as_none;
  1245. paratargetdbg:=dbg_none;
  1246. { Output }
  1247. OutputFileName:='';
  1248. OutputPrefix:=Nil;
  1249. OutputSuffix:=Nil;
  1250. OutputExeDir:='';
  1251. OutputUnitDir:='';
  1252. { Utils directory }
  1253. utilsdirectory:='';
  1254. utilsprefix:='';
  1255. cshared:=false;
  1256. rlinkpath:='';
  1257. sysrootpath:='';
  1258. { Search Paths }
  1259. librarysearchpath:=TSearchPathList.Create;
  1260. unitsearchpath:=TSearchPathList.Create;
  1261. includesearchpath:=TSearchPathList.Create;
  1262. objectsearchpath:=TSearchPathList.Create;
  1263. frameworksearchpath:=TSearchPathList.Create;
  1264. { Def file }
  1265. usewindowapi:=false;
  1266. description:='Compiled by FPC '+version_string+' - '+target_cpu_string;
  1267. DescriptionSetExplicity:=false;
  1268. SetPEFlagsSetExplicity:=false;
  1269. ImageBaseSetExplicity:=false;
  1270. MinStackSizeSetExplicity:=false;
  1271. MaxStackSizeSetExplicity:=false;
  1272. dllversion:='';
  1273. dllmajor:=1;
  1274. dllminor:=0;
  1275. dllrevision:=0;
  1276. nwscreenname := '';
  1277. nwthreadname := '';
  1278. nwcopyright := '';
  1279. UseDeffileForExports:=false;
  1280. UseDeffileForExportsSetExplicitly:=false;
  1281. GenerateImportSection:=false;
  1282. RelocSection:=false;
  1283. RelocSectionSetExplicitly:=false;
  1284. LinkTypeSetExplicitly:=false;
  1285. { memory sizes, will be overriden by parameter or default for target
  1286. in options or init_parser }
  1287. stacksize:=0;
  1288. { not initialized yet }
  1289. jmp_buf_size:=-1;
  1290. apptype:=app_cui;
  1291. { Init values }
  1292. init_settings:=default_settings;
  1293. if init_settings.optimizecputype=cpu_none then
  1294. init_settings.optimizecputype:=init_settings.cputype;
  1295. LinkLibraryAliases :=TLinkStrMap.Create;
  1296. LinkLibraryOrder :=TLinkStrMap.Create;
  1297. { enable all features by default }
  1298. features:=[low(Tfeature)..high(Tfeature)];
  1299. end;
  1300. end.