globals.pas 54 KB

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