globals.pas 42 KB

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