globals.pas 42 KB

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