psystem.pas 37 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908
  1. {
  2. Copyright (c) 1998-2002 by Florian Klaempfl
  3. Load the system unit, create required defs for systemunit
  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 psystem;
  18. {$i fpcdefs.inc}
  19. interface
  20. uses
  21. symbase;
  22. procedure create_intern_symbols;
  23. procedure create_intern_types;
  24. procedure load_intern_types;
  25. procedure registernodes;
  26. procedure registertais;
  27. implementation
  28. uses
  29. globals,globtype,verbose,constexp,cpuinfo,compinnr,
  30. systems,
  31. symconst,symtype,symsym,symdef,symcpu,symtable,
  32. aasmtai,aasmcpu,
  33. fmodule,
  34. node,nbas,nflw,nset,ncon,ncnv,nld,nmem,ncal,nmat,nadd,ninl;
  35. procedure create_intern_symbols;
  36. {
  37. all intern procedures for the system unit
  38. }
  39. begin
  40. systemunit.insert(csyssym.create('Concat',in_concat_x));
  41. systemunit.insert(csyssym.create('Write',in_write_x));
  42. systemunit.insert(csyssym.create('WriteLn',in_writeln_x));
  43. systemunit.insert(csyssym.create('WriteStr',in_writestr_x));
  44. systemunit.insert(csyssym.create('Assigned',in_assigned_x));
  45. systemunit.insert(csyssym.create('Read',in_read_x));
  46. systemunit.insert(csyssym.create('ReadLn',in_readln_x));
  47. systemunit.insert(csyssym.create('ReadStr',in_readstr_x));
  48. systemunit.insert(csyssym.create('Ofs',in_ofs_x));
  49. systemunit.insert(csyssym.create('SizeOf',in_sizeof_x));
  50. systemunit.insert(csyssym.create('BitSizeOf',in_bitsizeof_x));
  51. systemunit.insert(csyssym.create('TypeOf',in_typeof_x));
  52. systemunit.insert(csyssym.create('Low',in_low_x));
  53. systemunit.insert(csyssym.create('High',in_high_x));
  54. systemunit.insert(csyssym.create('Slice',in_slice_x));
  55. systemunit.insert(csyssym.create('Seg',in_seg_x));
  56. systemunit.insert(csyssym.create('Ord',in_ord_x));
  57. systemunit.insert(csyssym.create('Pred',in_pred_x));
  58. systemunit.insert(csyssym.create('Succ',in_succ_x));
  59. systemunit.insert(csyssym.create('Exclude',in_exclude_x_y));
  60. systemunit.insert(csyssym.create('Include',in_include_x_y));
  61. systemunit.insert(csyssym.create('Pack',in_pack_x_y_z));
  62. systemunit.insert(csyssym.create('Unpack',in_unpack_x_y_z));
  63. systemunit.insert(csyssym.create('Break',in_break));
  64. systemunit.insert(csyssym.create('Exit',in_exit));
  65. systemunit.insert(csyssym.create('Continue',in_continue));
  66. systemunit.insert(csyssym.create('Leave',in_leave)); {macpas only}
  67. systemunit.insert(csyssym.create('Cycle',in_cycle)); {macpas only}
  68. systemunit.insert(csyssym.create('Dec',in_dec_x));
  69. systemunit.insert(csyssym.create('Inc',in_inc_x));
  70. systemunit.insert(csyssym.create('Str',in_str_x_string));
  71. systemunit.insert(csyssym.create('Assert',in_assert_x_y));
  72. systemunit.insert(csyssym.create('Val',in_val_x));
  73. systemunit.insert(csyssym.create('Addr',in_addr_x));
  74. {$ifdef i8086}
  75. systemunit.insert(csyssym.create('FarAddr',in_faraddr_x));
  76. {$endif i8086}
  77. systemunit.insert(csyssym.create('TypeInfo',in_typeinfo_x));
  78. systemunit.insert(csyssym.create('SetLength',in_setlength_x));
  79. systemunit.insert(csyssym.create('Copy',in_copy_x));
  80. systemunit.insert(csyssym.create('Initialize',in_initialize_x));
  81. systemunit.insert(csyssym.create('Finalize',in_finalize_x));
  82. systemunit.insert(csyssym.create('Length',in_length_x));
  83. systemunit.insert(csyssym.create('New',in_new_x));
  84. systemunit.insert(csyssym.create('Dispose',in_dispose_x));
  85. {$ifdef SUPPORT_GET_FRAME}
  86. systemunit.insert(csyssym.create('Get_Frame',in_get_frame));
  87. {$endif SUPPORT_GET_FRAME}
  88. systemunit.insert(csyssym.create('Unaligned',in_unaligned_x));
  89. systemunit.insert(csyssym.create('Aligned',in_aligned_x));
  90. systemunit.insert(csyssym.create('Volatile',in_volatile_x));
  91. systemunit.insert(csyssym.create('ObjCSelector',in_objc_selector_x)); { objc only }
  92. systemunit.insert(csyssym.create('ObjCEncode',in_objc_encode_x)); { objc only }
  93. systemunit.insert(csyssym.create('Default',in_default_x));
  94. systemunit.insert(csyssym.create('SetString',in_setstring_x_y_z));
  95. systemunit.insert(csyssym.create('Insert',in_insert_x_y_z));
  96. systemunit.insert(csyssym.create('Delete',in_delete_x_y_z));
  97. systemunit.insert(csyssym.create('GetTypeKind',in_gettypekind_x));
  98. systemunit.insert(csyssym.create('IsManagedType',in_ismanagedtype_x));
  99. systemunit.insert(csyssym.create('fpc_eh_return_data_regno', in_const_eh_return_data_regno));
  100. systemunit.insert(cconstsym.create_ord('False',constord,0,pasbool1type));
  101. systemunit.insert(cconstsym.create_ord('True',constord,1,pasbool1type));
  102. end;
  103. procedure set_default_int_types;
  104. begin
  105. {$ifdef cpu64bitalu}
  106. aluuinttype:=u64inttype;
  107. alusinttype:=s64inttype;
  108. {$endif cpu64bitalu}
  109. {$ifdef cpu64bitaddr}
  110. sizeuinttype:=u64inttype;
  111. sizesinttype:=s64inttype;
  112. uinttype:=u64inttype;
  113. sinttype:=s64inttype;
  114. {$endif cpu64bitaddr}
  115. {$ifdef cpu32bitaddr}
  116. sizeuinttype:=u32inttype;
  117. sizesinttype:=s32inttype;
  118. uinttype:=u32inttype;
  119. sinttype:=s32inttype;
  120. {$endif cpu32bitaddr}
  121. {$ifdef cpu32bitalu}
  122. uinttype:=u32inttype;
  123. sinttype:=s32inttype;
  124. aluuinttype:=u32inttype;
  125. alusinttype:=s32inttype;
  126. {$endif cpu32bitalu}
  127. {$ifdef cpu16bitaddr}
  128. sizeuinttype:=u16inttype;
  129. sizesinttype:=s16inttype;
  130. {$endif cpu16bitaddr}
  131. {$ifdef cpu16bitalu}
  132. uinttype:=u16inttype;
  133. sinttype:=s16inttype;
  134. aluuinttype:=u16inttype;
  135. alusinttype:=s16inttype;
  136. {$endif cpu16bitalu}
  137. {$ifdef cpu8bitalu}
  138. uinttype:=u8inttype;
  139. sinttype:=s8inttype;
  140. aluuinttype:=u8inttype;
  141. alusinttype:=s8inttype;
  142. {$endif cpu8bitalu}
  143. osuinttype:=uinttype;
  144. ossinttype:=sinttype;
  145. end;
  146. procedure set_default_ptr_types;
  147. begin
  148. {$ifdef i8086}
  149. if current_settings.x86memorymodel in x86_far_code_models then
  150. voidcodepointertype:=voidfarpointertype
  151. else if current_settings.x86memorymodel=mm_tiny then
  152. voidcodepointertype:=voidnearpointertype
  153. else
  154. voidcodepointertype:=voidnearcspointertype;
  155. voidstackpointertype:=voidnearsspointertype;
  156. {$else i8086}
  157. voidcodepointertype:=voidpointertype;
  158. voidstackpointertype:=voidpointertype;
  159. {$endif i8086}
  160. case voidcodepointertype.size of
  161. 2:
  162. begin
  163. codeptruinttype:=u16inttype;
  164. codeptrsinttype:=s16inttype;
  165. end;
  166. 4:
  167. begin
  168. codeptruinttype:=u32inttype;
  169. codeptrsinttype:=s32inttype;
  170. end;
  171. 8:
  172. begin
  173. codeptruinttype:=u64inttype;
  174. codeptrsinttype:=s64inttype;
  175. end;
  176. else
  177. Internalerror(2015112106);
  178. end;
  179. case voidpointertype.size of
  180. 2:
  181. begin
  182. ptruinttype:=u16inttype;
  183. ptrsinttype:=s16inttype;
  184. end;
  185. 4:
  186. begin
  187. ptruinttype:=u32inttype;
  188. ptrsinttype:=s32inttype;
  189. end;
  190. 8:
  191. begin
  192. ptruinttype:=u64inttype;
  193. ptrsinttype:=s64inttype;
  194. end;
  195. else
  196. Internalerror(2016100301);
  197. end;
  198. end;
  199. procedure create_intern_types;
  200. {
  201. all the types inserted into the system unit
  202. }
  203. function addtype(const s:string;def:tdef):ttypesym;
  204. begin
  205. result:=ctypesym.create(s,def);
  206. systemunit.insert(result);
  207. end;
  208. procedure addfield(recst:tabstractrecordsymtable;sym:tfieldvarsym);
  209. begin
  210. recst.insert(sym);
  211. recst.addfield(sym,vis_hidden);
  212. end;
  213. procedure create_fpu_types;
  214. begin
  215. if init_settings.fputype<>fpu_none then
  216. begin
  217. s32floattype:=cfloatdef.create(s32real,true);
  218. s64floattype:=cfloatdef.create(s64real,true);
  219. s80floattype:=cfloatdef.create(s80real,true);
  220. sc80floattype:=cfloatdef.create(sc80real,true);
  221. end
  222. else
  223. begin
  224. s32floattype:=nil;
  225. s64floattype:=nil;
  226. s80floattype:=nil;
  227. sc80floattype:=nil;
  228. end;
  229. end;
  230. var
  231. hrecst : trecordsymtable;
  232. begin
  233. symtablestack.push(systemunit);
  234. cundefinedtype:=cundefineddef.create(true);
  235. cformaltype:=cformaldef.create(false);
  236. ctypedformaltype:=cformaldef.create(true);
  237. voidtype:=corddef.create(uvoid,0,0,true);
  238. voidpointertype:=cpointerdef.create(voidtype);
  239. u8inttype:=corddef.create(u8bit,0,255,true);
  240. s8inttype:=corddef.create(s8bit,int64(-128),127,true);
  241. u16inttype:=corddef.create(u16bit,0,65535,true);
  242. s16inttype:=corddef.create(s16bit,int64(-32768),32767,true);
  243. s24inttype:=corddef.create(customint,-(int64(1) shl 23),1 shl 23 - 1,true);
  244. u24inttype:=corddef.create(customint,0,1 shl 24 - 1,true);
  245. u32inttype:=corddef.create(u32bit,0,high(longword),true);
  246. s32inttype:=corddef.create(s32bit,int64(low(longint)),int64(high(longint)),true);
  247. s40inttype:=corddef.create(customint,-(int64(1) shl 39),int64(1) shl 39 - 1,true);
  248. u40inttype:=corddef.create(customint,0,int64(1) shl 40 - 1,true);
  249. s48inttype:=corddef.create(customint,-(int64(1) shl 47),int64(1) shl 47 - 1,true);
  250. u48inttype:=corddef.create(customint,0,int64(1) shl 48 - 1,true);
  251. s56inttype:=corddef.create(customint,-(int64(1) shl 55),int64(1) shl 55 - 1,true);
  252. u56inttype:=corddef.create(customint,0,int64(1) shl 56 - 1,true);
  253. u64inttype:=corddef.create(u64bit,low(qword),high(qword),true);
  254. s64inttype:=corddef.create(s64bit,low(int64),high(int64),true);
  255. { upper/lower bound not yet properly set for 128 bit types, as we don't
  256. support them yet at the Pascal level (nor for tconstexprint); they're
  257. only used internally by the high level code generator for LLVM to
  258. implement overflow checking }
  259. u128inttype:=corddef.create(u128bit,0,0,true);
  260. s128inttype:=corddef.create(s128bit,0,0,true);
  261. pasbool1type:=corddef.create(pasbool1,0,1,true);
  262. pasbool8type:=corddef.create(pasbool8,0,1,true);
  263. pasbool16type:=corddef.create(pasbool16,0,1,true);
  264. pasbool32type:=corddef.create(pasbool32,0,1,true);
  265. pasbool64type:=corddef.create(pasbool64,0,1,true);
  266. bool8type:=corddef.create(bool8bit,low(int64),high(int64),true);
  267. bool16type:=corddef.create(bool16bit,low(int64),high(int64),true);
  268. bool32type:=corddef.create(bool32bit,low(int64),high(int64),true);
  269. bool64type:=corddef.create(bool64bit,low(int64),high(int64),true);
  270. {$ifdef llvm}
  271. llvmbool1type:=corddef.create(pasbool1,0,1,true);
  272. {$endif llvm}
  273. cansichartype:=corddef.create(uchar,0,255,true);
  274. cwidechartype:=corddef.create(uwidechar,0,65535,true);
  275. cshortstringtype:=cstringdef.createshort(255,true);
  276. { should we give a length to the default long and ansi string definition ?? }
  277. clongstringtype:=cstringdef.createlong(-1,true);
  278. cansistringtype:=cstringdef.createansi(0,true);
  279. if target_info.system in systems_windows then
  280. cwidestringtype:=cstringdef.createwide(true)
  281. else
  282. cwidestringtype:=cstringdef.createunicode(true);
  283. cunicodestringtype:=cstringdef.createunicode(true);
  284. { length=0 for shortstring is open string (needed for readln(string) }
  285. openshortstringtype:=cstringdef.createshort(0,true);
  286. {$ifdef x86}
  287. create_fpu_types;
  288. {$ifndef FPC_SUPPORT_X87_TYPES_ON_WIN64}
  289. if target_info.system=system_x86_64_win64 then
  290. begin
  291. s64currencytype:=corddef.create(scurrency,low(int64),high(int64),true);
  292. pbestrealtype:=@s64floattype;
  293. end
  294. else
  295. {$endif FPC_SUPPORT_X87_TYPES_ON_WIN64}
  296. s64currencytype:=cfloatdef.create(s64currency,true);
  297. {$endif x86}
  298. {$ifdef powerpc}
  299. create_fpu_types;
  300. s64currencytype:=corddef.create(scurrency,low(int64),high(int64),true);
  301. {$endif powerpc}
  302. {$ifdef POWERPC64}
  303. create_fpu_types;
  304. s64currencytype:=corddef.create(scurrency,low(int64),high(int64),true);
  305. {$endif POWERPC64}
  306. {$ifdef sparc}
  307. create_fpu_types;
  308. s64currencytype:=corddef.create(scurrency,low(int64),high(int64),true);
  309. {$endif sparc}
  310. {$ifdef sparc64}
  311. create_fpu_types;
  312. s64currencytype:=corddef.create(scurrency,low(int64),high(int64),true);
  313. {$endif sparc64}
  314. {$ifdef m68k}
  315. create_fpu_types;
  316. s64currencytype:=corddef.create(scurrency,low(int64),high(int64),true);
  317. {$endif}
  318. {$ifdef arm}
  319. create_fpu_types;
  320. s64currencytype:=corddef.create(scurrency,low(int64),high(int64),true);
  321. {$endif arm}
  322. {$ifdef aarch64}
  323. create_fpu_types;
  324. s64currencytype:=corddef.create(scurrency,low(int64),high(int64),true);
  325. {$endif aarch64}
  326. {$ifdef avr}
  327. s32floattype:=cfloatdef.create(s32real,true);
  328. s64floattype:=cfloatdef.create(s64real,true);
  329. s80floattype:=cfloatdef.create(s80real,true);
  330. sc80floattype:=cfloatdef.create(sc80real,true);
  331. s64currencytype:=corddef.create(scurrency,low(int64),high(int64),true);
  332. {$endif avr}
  333. {$ifdef mips}
  334. create_fpu_types;
  335. s64currencytype:=corddef.create(scurrency,low(int64),high(int64),true);
  336. {$endif mips}
  337. {$ifdef riscv32}
  338. create_fpu_types;
  339. s64currencytype:=corddef.create(scurrency,low(int64),high(int64),true);
  340. {$endif riscv32}
  341. {$ifdef riscv64}
  342. create_fpu_types;
  343. s64currencytype:=corddef.create(scurrency,low(int64),high(int64),true);
  344. {$endif riscv64}
  345. {$ifdef jvm}
  346. create_fpu_types;
  347. s64currencytype:=corddef.create(scurrency,low(int64),high(int64),true);
  348. {$endif jvm}
  349. {$ifdef xtensa}
  350. create_fpu_types;
  351. s64currencytype:=corddef.create(scurrency,low(int64),high(int64),true);
  352. {$endif xtensa}
  353. set_default_int_types;
  354. { some other definitions }
  355. charpointertype:=cpointerdef.create(cansichartype);
  356. widecharpointertype:=cpointerdef.create(cwidechartype);
  357. {$ifdef i8086}
  358. parentfpvoidpointertype:=tcpupointerdefclass(cpointerdef).createx86(voidtype,x86pt_near_ss);
  359. {$else i8086}
  360. parentfpvoidpointertype:=cpointerdef.create(voidtype);
  361. {$endif i8086}
  362. {$ifdef x86}
  363. voidnearpointertype:=tcpupointerdefclass(cpointerdef).createx86(voidtype,x86pt_near);
  364. voidnearcspointertype:=tcpupointerdefclass(cpointerdef).createx86(voidtype,x86pt_near_cs);
  365. voidneardspointertype:=tcpupointerdefclass(cpointerdef).createx86(voidtype,x86pt_near_ds);
  366. voidnearsspointertype:=tcpupointerdefclass(cpointerdef).createx86(voidtype,x86pt_near_ss);
  367. voidnearespointertype:=tcpupointerdefclass(cpointerdef).createx86(voidtype,x86pt_near_es);
  368. voidnearfspointertype:=tcpupointerdefclass(cpointerdef).createx86(voidtype,x86pt_near_fs);
  369. voidneargspointertype:=tcpupointerdefclass(cpointerdef).createx86(voidtype,x86pt_near_gs);
  370. {$ifdef i8086}
  371. voidfarpointertype:=tcpupointerdefclass(cpointerdef).createx86(voidtype,x86pt_far);
  372. voidhugepointertype:=tcpupointerdefclass(cpointerdef).createx86(voidtype,x86pt_huge);
  373. charnearpointertype:=tcpupointerdefclass(cpointerdef).createx86(cansichartype,x86pt_near);
  374. charfarpointertype:=tcpupointerdefclass(cpointerdef).createx86(cansichartype,x86pt_far);
  375. charhugepointertype:=tcpupointerdefclass(cpointerdef).createx86(cansichartype,x86pt_huge);
  376. bytefarpointertype:=tcpupointerdefclass(cpointerdef).createx86(u8inttype,x86pt_far);
  377. wordfarpointertype:=tcpupointerdefclass(cpointerdef).createx86(u16inttype,x86pt_far);
  378. longintfarpointertype:=tcpupointerdefclass(cpointerdef).createx86(s32inttype,x86pt_far);
  379. {$endif i8086}
  380. x86_m64type:=carraydef.create(0,1,s32inttype);
  381. x86_m128type:=carraydef.create(0,3,s32inttype);
  382. x86_m128dtype:=carraydef.create(0,1,s32inttype);
  383. x86_m128itype:=carraydef.create(0,3,s32inttype);
  384. x86_m256type:=carraydef.create(0,7,s32inttype);
  385. x86_m256dtype:=carraydef.create(0,3,s32inttype);
  386. x86_m256itype:=carraydef.create(0,7,s32inttype);
  387. tarraydef(x86_m64type).elementdef:=s32floattype;
  388. tarraydef(x86_m128type).elementdef:=s32floattype;
  389. tarraydef(x86_m128dtype).elementdef:=s64floattype;
  390. tarraydef(x86_m128itype).elementdef:=s32floattype;
  391. tarraydef(x86_m256type).elementdef:=s32floattype;
  392. tarraydef(x86_m256dtype).elementdef:=s64floattype;
  393. tarraydef(x86_m256itype).elementdef:=s32floattype;
  394. {$endif x86}
  395. set_default_ptr_types;
  396. openchararraytype:=carraydef.create_openarray;
  397. tarraydef(openchararraytype).elementdef:=cansichartype;
  398. cfiletype:=cfiledef.createuntyped;
  399. if f_variants in features then
  400. begin
  401. cvarianttype:=cvariantdef.create(vt_normalvariant);
  402. colevarianttype:=cvariantdef.create(vt_olevariant);
  403. end;
  404. {$ifdef cpufpemu}
  405. { Normal types }
  406. (* we use the same types as without emulator, the only
  407. difference is that direct calls to the emulator are generated
  408. if (cs_fp_emulation in current_settings.moduleswitches) then
  409. begin
  410. addtype('Single',s32floattype);
  411. { extended size is the best real type for the target }
  412. addtype('Real',s32floattype);
  413. pbestrealtype:=@s32floattype;
  414. { extended size is the best real type for the target }
  415. addtype('Extended',pbestrealtype^);
  416. end
  417. else
  418. *)
  419. {$endif cpufpemu}
  420. if init_settings.fputype<>fpu_none then
  421. begin
  422. addtype('Single',s32floattype);
  423. addtype('Double',s64floattype);
  424. { extended size is the best real type for the target }
  425. addtype('Extended',pbestrealtype^);
  426. { CExtended corresponds to the C version of the Extended type
  427. (either "long double" or "double") }
  428. if target_info.system in systems_android then
  429. { Android has "long double"="double" even for x86 }
  430. addtype('CExtended',s64floattype)
  431. else
  432. if tfloatdef(pbestrealtype^).floattype=s80real then
  433. addtype('CExtended',sc80floattype)
  434. else
  435. addtype('CExtended',pbestrealtype^);
  436. end;
  437. {$ifdef x86}
  438. {$ifndef FPC_SUPPORT_X87_TYPES_ON_WIN64}
  439. if target_info.system<>system_x86_64_win64 then
  440. {$endif FPC_SUPPORT_X87_TYPES_ON_WIN64}
  441. addtype('Comp',cfloatdef.create(s64comp,true));
  442. {$endif x86}
  443. addtype('Currency',s64currencytype);
  444. addtype('Pointer',voidpointertype);
  445. {$ifdef x86}
  446. addtype('NearPointer',voidnearpointertype);
  447. addtype('NearCsPointer',voidnearcspointertype);
  448. addtype('NearDsPointer',voidneardspointertype);
  449. addtype('NearSsPointer',voidnearsspointertype);
  450. addtype('NearEsPointer',voidnearespointertype);
  451. addtype('NearFsPointer',voidnearfspointertype);
  452. addtype('NearGsPointer',voidneargspointertype);
  453. {$ifdef i8086}
  454. addtype('FarPointer',voidfarpointertype);
  455. addtype('HugePointer',voidhugepointertype);
  456. {$endif i8086}
  457. addtype('__m64',x86_m64type);
  458. addtype('__m128', x86_m128type);
  459. addtype('__m128d',x86_m128dtype);
  460. addtype('__m128i',x86_m128itype);
  461. addtype('__m256', x86_m256type);
  462. addtype('__m256d',x86_m256dtype);
  463. addtype('__m256i',x86_m256itype);
  464. {$endif x86}
  465. addtype('ShortString',cshortstringtype);
  466. {$ifdef support_longstring}
  467. addtype('LongString',clongstringtype);
  468. {$endif support_longstring}
  469. addtype('AnsiString',cansistringtype);
  470. addtype('WideString',cwidestringtype);
  471. addtype('UnicodeString',cunicodestringtype);
  472. addtype('OpenString',openshortstringtype);
  473. addtype('Boolean',pasbool1type);
  474. addtype('Boolean8',pasbool8type);
  475. addtype('Boolean16',pasbool16type);
  476. addtype('Boolean32',pasbool32type);
  477. addtype('Boolean64',pasbool64type);
  478. addtype('ByteBool',bool8type);
  479. addtype('WordBool',bool16type);
  480. addtype('LongBool',bool32type);
  481. addtype('QWordBool',bool64type);
  482. {$ifdef llvm}
  483. addtype('LLVMBool1',llvmbool1type);
  484. {$endif llvm}
  485. addtype('Byte',u8inttype);
  486. addtype('ShortInt',s8inttype);
  487. addtype('Word',u16inttype);
  488. addtype('SmallInt',s16inttype);
  489. addtype('LongWord',u32inttype);
  490. addtype('LongInt',s32inttype);
  491. addtype('QWord',u64inttype);
  492. addtype('Int64',s64inttype);
  493. addtype('Char',cansichartype);
  494. addtype('WideChar',cwidechartype);
  495. addtype('Text',cfiledef.createtext);
  496. addtype('TypedFile',cfiledef.createtyped(voidtype));
  497. if f_variants in features then
  498. begin
  499. addtype('Variant',cvarianttype);
  500. addtype('OleVariant',colevarianttype);
  501. end;
  502. { Internal types }
  503. addtype('$undefined',cundefinedtype);
  504. addtype('$formal',cformaltype);
  505. addtype('$typedformal',ctypedformaltype);
  506. addtype('$void',voidtype);
  507. addtype('$void_pointer',voidpointertype);
  508. addtype('$byte',u8inttype);
  509. addtype('$shortint',s8inttype);
  510. addtype('$word',u16inttype);
  511. addtype('$smallint',s16inttype);
  512. addtype('$sint24',s24inttype);
  513. addtype('$uint24',u24inttype);
  514. addtype('$ulong',u32inttype);
  515. addtype('$longint',s32inttype);
  516. addtype('$sint40',s40inttype);
  517. addtype('$uint40',u40inttype);
  518. addtype('$sint48',s48inttype);
  519. addtype('$uint48',u48inttype);
  520. addtype('$sint56',s56inttype);
  521. addtype('$uint56',u56inttype);
  522. addtype('$qword',u64inttype);
  523. addtype('$int64',s64inttype);
  524. addtype('$uint128',u128inttype);
  525. addtype('$int128',s128inttype);
  526. addtype('$char',cansichartype);
  527. addtype('$widechar',cwidechartype);
  528. addtype('$shortstring',cshortstringtype);
  529. addtype('$longstring',clongstringtype);
  530. addtype('$ansistring',cansistringtype);
  531. addtype('$widestring',cwidestringtype);
  532. addtype('$unicodestring',cunicodestringtype);
  533. addtype('$openshortstring',openshortstringtype);
  534. addtype('$boolean',pasbool1type);
  535. addtype('$boolean8',pasbool8type);
  536. addtype('$boolean16',pasbool16type);
  537. addtype('$boolean32',pasbool32type);
  538. addtype('$boolean64',pasbool64type);
  539. addtype('$bytebool',bool8type);
  540. addtype('$wordbool',bool16type);
  541. addtype('$longbool',bool32type);
  542. addtype('$qwordbool',bool64type);
  543. {$ifdef llvm}
  544. addtype('$llvmbool1',llvmbool1type);
  545. llvm_metadatatype:=cpointerdef.create(voidtype);
  546. { if this gets renamed, also adjust agllvm so it still writes the identifier of this type as "metadata" }
  547. addtype('$metadata',llvm_metadatatype);
  548. addtype('LLVMMetadata',llvm_metadatatype);
  549. {$endif llvm}
  550. addtype('$char_pointer',charpointertype);
  551. addtype('$widechar_pointer',widecharpointertype);
  552. addtype('$parentfp_void_pointer',parentfpvoidpointertype);
  553. {$ifdef x86}
  554. addtype('$void_nearpointer',voidnearpointertype);
  555. addtype('$void_nearcspointer',voidnearcspointertype);
  556. addtype('$void_neardspointer',voidneardspointertype);
  557. addtype('$void_nearsspointer',voidnearsspointertype);
  558. addtype('$void_nearespointer',voidnearespointertype);
  559. addtype('$void_nearfspointer',voidnearfspointertype);
  560. addtype('$void_neargspointer',voidneargspointertype);
  561. {$ifdef i8086}
  562. addtype('$void_farpointer',voidfarpointertype);
  563. addtype('$void_hugepointer',voidhugepointertype);
  564. addtype('$char_nearpointer',charnearpointertype);
  565. addtype('$char_farpointer',charfarpointertype);
  566. addtype('$char_hugepointer',charhugepointertype);
  567. addtype('$byte_farpointer',bytefarpointertype);
  568. addtype('$word_farpointer',wordfarpointertype);
  569. addtype('$longint_farpointer',longintfarpointertype);
  570. {$endif i8086}
  571. addtype('$__m64', x86_m64type);
  572. addtype('$__m128', x86_m128type);
  573. addtype('$__m128d',x86_m128dtype);
  574. addtype('$__m128i',x86_m128itype);
  575. addtype('$__m256', x86_m256type);
  576. addtype('$__m256d',x86_m256dtype);
  577. addtype('$__m256i',x86_m256itype);
  578. {$endif x86}
  579. addtype('$openchararray',openchararraytype);
  580. addtype('$file',cfiletype);
  581. if f_variants in features then
  582. begin
  583. addtype('$variant',cvarianttype);
  584. addtype('$olevariant',colevarianttype);
  585. end;
  586. if init_settings.fputype<>fpu_none then
  587. begin
  588. addtype('$s32real',s32floattype);
  589. addtype('$s64real',s64floattype);
  590. addtype('$s80real',s80floattype);
  591. addtype('$sc80real',sc80floattype);
  592. end;
  593. addtype('$s64currency',s64currencytype);
  594. if not(target_info.system in systems_managed_vm) then
  595. begin
  596. { Add a type for virtual method tables }
  597. hrecst:=trecordsymtable.create('',current_settings.packrecords,current_settings.alignment.recordalignmin);
  598. vmttype:=crecorddef.create('',hrecst);
  599. pvmttype:=cpointerdef.create(vmttype);
  600. { can't use addtype for pvmt because the rtti of the pointed
  601. type is not available. The rtti for pvmt will be written implicitly
  602. by thev tblarray below }
  603. systemunit.insert(ctypesym.create('$pvmt',pvmttype));
  604. addfield(hrecst,cfieldvarsym.create('$length',vs_value,sizesinttype,[]));
  605. addfield(hrecst,cfieldvarsym.create('$mlength',vs_value,sizesinttype,[]));
  606. addfield(hrecst,cfieldvarsym.create('$parent',vs_value,pvmttype,[]));
  607. { it seems vmttype is used both for TP objects and Delphi classes,
  608. so the next entry could either be the first virtual method (vm1)
  609. (object) or the class name (class). We can't easily create separate
  610. vtable formats for both, as gdb is hard coded to search for
  611. __vtbl_ptr_type in all cases (JM) }
  612. addfield(hrecst,cfieldvarsym.create('$vm1_or_classname',vs_value,cpointerdef.create(cshortstringtype),[]));
  613. vmtarraytype:=carraydef.create(0,0,s32inttype);
  614. tarraydef(vmtarraytype).elementdef:=voidpointertype;
  615. addfield(hrecst,cfieldvarsym.create('$__pfn',vs_value,vmtarraytype,[]));
  616. addtype('$__vtbl_ptr_type',vmttype);
  617. vmtarraytype:=carraydef.create(0,1,s32inttype);
  618. tarraydef(vmtarraytype).elementdef:=pvmttype;
  619. addtype('$vtblarray',vmtarraytype);
  620. end;
  621. { Add a type for methodpointers }
  622. hrecst:=trecordsymtable.create('',1,current_settings.alignment.recordalignmin);
  623. addfield(hrecst,cfieldvarsym.create('$proc',vs_value,voidcodepointertype,[]));
  624. addfield(hrecst,cfieldvarsym.create('$self',vs_value,voidpointertype,[]));
  625. methodpointertype:=crecorddef.create('',hrecst);
  626. addtype('$methodpointer',methodpointertype);
  627. { Add a type for nested proc pointers }
  628. hrecst:=trecordsymtable.create('',1,current_settings.alignment.recordalignmin);
  629. addfield(hrecst,cfieldvarsym.create('$proc',vs_value,voidcodepointertype,[]));
  630. addfield(hrecst,cfieldvarsym.create('$parentfp',vs_value,parentfpvoidpointertype,[]));
  631. nestedprocpointertype:=crecorddef.create('',hrecst);
  632. addtype('$nestedprocpointer',nestedprocpointertype);
  633. symtablestack.pop(systemunit);
  634. end;
  635. procedure load_intern_types;
  636. {
  637. Load all default definitions for consts from the system unit
  638. }
  639. procedure loadtype(const s:string;var def:tdef);
  640. var
  641. srsym : ttypesym;
  642. begin
  643. srsym:=search_system_type(s);
  644. def:=srsym.typedef;
  645. end;
  646. var
  647. oldcurrentmodule : tmodule;
  648. begin
  649. {$ifndef FPC_SUPPORT_X87_TYPES_ON_WIN64}
  650. if target_info.system=system_x86_64_win64 then
  651. pbestrealtype:=@s64floattype;
  652. {$endif FPC_SUPPORT_X87_TYPES_ON_WIN64}
  653. oldcurrentmodule:=current_module;
  654. set_current_module(nil);
  655. loadtype('byte',u8inttype);
  656. loadtype('shortint',s8inttype);
  657. loadtype('word',u16inttype);
  658. loadtype('smallint',s16inttype);
  659. loadtype('uint24',u24inttype);
  660. loadtype('sint24',s24inttype);
  661. loadtype('ulong',u32inttype);
  662. loadtype('longint',s32inttype);
  663. loadtype('uint40',u40inttype);
  664. loadtype('sint40',s40inttype);
  665. loadtype('uint48',u48inttype);
  666. loadtype('sint48',s48inttype);
  667. loadtype('uint56',u56inttype);
  668. loadtype('sint56',s56inttype);
  669. loadtype('qword',u64inttype);
  670. loadtype('int64',s64inttype);
  671. loadtype('uint128',u128inttype);
  672. loadtype('int128',s128inttype);
  673. loadtype('undefined',cundefinedtype);
  674. loadtype('formal',cformaltype);
  675. loadtype('typedformal',ctypedformaltype);
  676. loadtype('void',voidtype);
  677. loadtype('void_pointer',voidpointertype);
  678. loadtype('char',cansichartype);
  679. loadtype('widechar',cwidechartype);
  680. loadtype('shortstring',cshortstringtype);
  681. loadtype('longstring',clongstringtype);
  682. loadtype('ansistring',cansistringtype);
  683. loadtype('widestring',cwidestringtype);
  684. loadtype('unicodestring',cunicodestringtype);
  685. loadtype('openshortstring',openshortstringtype);
  686. loadtype('openchararray',openchararraytype);
  687. if init_settings.fputype <> fpu_none then
  688. begin
  689. loadtype('s32real',s32floattype);
  690. loadtype('s64real',s64floattype);
  691. loadtype('s80real',s80floattype);
  692. loadtype('sc80real',sc80floattype);
  693. end;
  694. loadtype('s64currency',s64currencytype);
  695. loadtype('boolean',pasbool1type);
  696. loadtype('boolean8',pasbool8type);
  697. loadtype('boolean16',pasbool16type);
  698. loadtype('boolean32',pasbool32type);
  699. loadtype('boolean64',pasbool64type);
  700. loadtype('bytebool',bool8type);
  701. loadtype('wordbool',bool16type);
  702. loadtype('longbool',bool32type);
  703. loadtype('qwordbool',bool64type);
  704. loadtype('char_pointer',charpointertype);
  705. loadtype('widechar_pointer',widecharpointertype);
  706. loadtype('parentfp_void_pointer',parentfpvoidpointertype);
  707. {$ifdef x86}
  708. loadtype('void_nearpointer',voidnearpointertype);
  709. loadtype('void_nearcspointer',voidnearcspointertype);
  710. loadtype('void_neardspointer',voidneardspointertype);
  711. loadtype('void_nearsspointer',voidnearsspointertype);
  712. loadtype('void_nearespointer',voidnearespointertype);
  713. loadtype('void_nearfspointer',voidnearfspointertype);
  714. loadtype('void_neargspointer',voidneargspointertype);
  715. {$ifdef i8086}
  716. loadtype('void_farpointer',voidfarpointertype);
  717. loadtype('void_hugepointer',voidhugepointertype);
  718. loadtype('char_nearpointer',charnearpointertype);
  719. loadtype('char_farpointer',charfarpointertype);
  720. loadtype('char_hugepointer',charhugepointertype);
  721. loadtype('byte_farpointer',bytefarpointertype);
  722. loadtype('word_farpointer',wordfarpointertype);
  723. loadtype('longint_farpointer',longintfarpointertype);
  724. {$endif i8086}
  725. loadtype('__m64', x86_m64type);
  726. loadtype('__m128', x86_m128type);
  727. loadtype('__m128d',x86_m128dtype);
  728. loadtype('__m128i',x86_m128itype);
  729. loadtype('__m256', x86_m256type);
  730. loadtype('__m256d',x86_m256dtype);
  731. loadtype('__m256i',x86_m256itype);
  732. {$endif x86}
  733. {$ifdef llvm}
  734. loadtype('llvmbool1',llvmbool1type);
  735. loadtype('metadata',llvm_metadatatype);
  736. {$endif llvm}
  737. loadtype('file',cfiletype);
  738. if not(target_info.system in systems_managed_vm) then
  739. begin
  740. loadtype('pvmt',pvmttype);
  741. loadtype('vtblarray',vmtarraytype);
  742. loadtype('__vtbl_ptr_type',vmttype);
  743. end;
  744. if f_variants in features then
  745. begin
  746. loadtype('variant',cvarianttype);
  747. loadtype('olevariant',colevarianttype);
  748. end;
  749. loadtype('methodpointer',methodpointertype);
  750. loadtype('nestedprocpointer',nestedprocpointertype);
  751. loadtype('HRESULT',hresultdef);
  752. loadtype('TTYPEKIND',typekindtype);
  753. set_default_int_types;
  754. set_default_ptr_types;
  755. set_current_module(oldcurrentmodule);
  756. end;
  757. procedure registernodes;
  758. {
  759. Register all possible nodes in the nodeclass array that
  760. will be used for loading the nodes from a ppu
  761. }
  762. begin
  763. nodeclass[addn]:=caddnode;
  764. nodeclass[muln]:=caddnode;
  765. nodeclass[subn]:=caddnode;
  766. nodeclass[divn]:=cmoddivnode;
  767. nodeclass[symdifn]:=caddnode;
  768. nodeclass[modn]:=cmoddivnode;
  769. nodeclass[assignn]:=cassignmentnode;
  770. nodeclass[loadn]:=cloadnode;
  771. nodeclass[rangen]:=crangenode;
  772. nodeclass[ltn]:=caddnode;
  773. nodeclass[lten]:=caddnode;
  774. nodeclass[gtn]:=caddnode;
  775. nodeclass[gten]:=caddnode;
  776. nodeclass[equaln]:=caddnode;
  777. nodeclass[unequaln]:=caddnode;
  778. nodeclass[inn]:=cinnode;
  779. nodeclass[orn]:=caddnode;
  780. nodeclass[xorn]:=caddnode;
  781. nodeclass[shrn]:=cshlshrnode;
  782. nodeclass[shln]:=cshlshrnode;
  783. nodeclass[slashn]:=caddnode;
  784. nodeclass[andn]:=caddnode;
  785. nodeclass[subscriptn]:=csubscriptnode;
  786. nodeclass[derefn]:=cderefnode;
  787. nodeclass[addrn]:=caddrnode;
  788. nodeclass[ordconstn]:=cordconstnode;
  789. nodeclass[typeconvn]:=ctypeconvnode;
  790. nodeclass[calln]:=ccallnode;
  791. nodeclass[callparan]:=ccallparanode;
  792. nodeclass[realconstn]:=crealconstnode;
  793. nodeclass[unaryminusn]:=cunaryminusnode;
  794. nodeclass[unaryplusn]:=cunaryplusnode;
  795. nodeclass[asmn]:=casmnode;
  796. nodeclass[vecn]:=cvecnode;
  797. nodeclass[pointerconstn]:=cpointerconstnode;
  798. nodeclass[stringconstn]:=cstringconstnode;
  799. nodeclass[notn]:=cnotnode;
  800. nodeclass[inlinen]:=cinlinenode;
  801. nodeclass[niln]:=cnilnode;
  802. nodeclass[errorn]:=cerrornode;
  803. nodeclass[typen]:=ctypenode;
  804. nodeclass[setelementn]:=csetelementnode;
  805. nodeclass[setconstn]:=csetconstnode;
  806. nodeclass[blockn]:=cblocknode;
  807. nodeclass[statementn]:=cstatementnode;
  808. nodeclass[ifn]:=cifnode;
  809. nodeclass[breakn]:=cbreaknode;
  810. nodeclass[continuen]:=ccontinuenode;
  811. nodeclass[whilerepeatn]:=cwhilerepeatnode;
  812. nodeclass[forn]:=cfornode;
  813. nodeclass[exitn]:=cexitnode;
  814. nodeclass[casen]:=ccasenode;
  815. nodeclass[labeln]:=clabelnode;
  816. nodeclass[goton]:=cgotonode;
  817. nodeclass[tryexceptn]:=ctryexceptnode;
  818. nodeclass[raisen]:=craisenode;
  819. nodeclass[tryfinallyn]:=ctryfinallynode;
  820. nodeclass[onn]:=connode;
  821. nodeclass[isn]:=cisnode;
  822. nodeclass[asn]:=casnode;
  823. nodeclass[starstarn]:=caddnode;
  824. nodeclass[arrayconstructorn]:=carrayconstructornode;
  825. nodeclass[arrayconstructorrangen]:=carrayconstructorrangenode;
  826. nodeclass[tempcreaten]:=ctempcreatenode;
  827. nodeclass[temprefn]:=ctemprefnode;
  828. nodeclass[tempdeleten]:=ctempdeletenode;
  829. nodeclass[addoptn]:=caddnode;
  830. nodeclass[nothingn]:=cnothingnode;
  831. nodeclass[loadvmtaddrn]:=cloadvmtaddrnode;
  832. nodeclass[guidconstn]:=cguidconstnode;
  833. nodeclass[rttin]:=crttinode;
  834. nodeclass[loadparentfpn]:=cloadparentfpnode;
  835. end;
  836. procedure registertais;
  837. {
  838. Register all possible tais in the taiclass array that
  839. will be used for loading the tais from a ppu
  840. }
  841. begin
  842. aiclass[ait_none]:=nil;
  843. aiclass[ait_align]:=tai_align;
  844. aiclass[ait_section]:=tai_section;
  845. aiclass[ait_comment]:=tai_comment;
  846. aiclass[ait_string]:=tai_string;
  847. aiclass[ait_instruction]:=taicpu;
  848. aiclass[ait_datablock]:=tai_datablock;
  849. aiclass[ait_symbol]:=tai_symbol;
  850. aiclass[ait_symbol_end]:=tai_symbol_end;
  851. aiclass[ait_directive]:=tai_directive;
  852. aiclass[ait_label]:=tai_label;
  853. aiclass[ait_const]:=tai_const;
  854. aiclass[ait_realconst]:=tai_realconst;
  855. aiclass[ait_stab]:=tai_stab;
  856. aiclass[ait_force_line]:=tai_force_line;
  857. aiclass[ait_function_name]:=tai_function_name;
  858. aiclass[ait_symbolpair]:=tai_symbolpair;
  859. aiclass[ait_cutobject]:=tai_cutobject;
  860. aiclass[ait_regalloc]:=tai_regalloc;
  861. aiclass[ait_tempalloc]:=tai_tempalloc;
  862. aiclass[ait_marker]:=tai_marker;
  863. aiclass[ait_seh_directive]:=tai_seh_directive;
  864. {$ifdef JVM}
  865. aiclass[ait_jvar]:=tai_jvar;
  866. aiclass[ait_jcatch]:=tai_jcatch;
  867. {$endif JVM}
  868. end;
  869. end.