2
0

globals.pas 51 KB

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