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