globals.pas 48 KB

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