psystem.pas 31 KB

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