1 { 2 Copyright (c) 2002 by Florian Klaempfl 3 4 Generic calling convention handling 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 unit parabase; 22 23 {$i fpcdefs.inc} 24 25 interface 26 27 uses 28 cclasses,globtype, 29 {$ifdef llvm} 30 aasmbase, 31 {$endif} 32 cgbase,cgutils, 33 symtype; 34 35 type 36 TCGParaReference = record 37 index : tregister; 38 offset : asizeint; 39 end; 40 41 PCGParaLocation = ^TCGParaLocation; 42 TCGParaLocation = record 43 Next : PCGParaLocation; 44 Size : TCGSize; { size of this location } 45 Def : tdef; 46 Loc : TCGLoc; 47 {$ifdef llvm} 48 { The following fields are used to determine the name and handling of 49 the location by the llvm code generator. They exist in parallel with 50 the regular information, because that original information is still 51 required for handling inline assembler routines } 52 53 { true if the llvmloc symbol is the value itself, rather than a 54 pointer to the value (~ named register) } 55 llvmvalueloc, 56 retvalloc: boolean; 57 llvmloc: record 58 case loc: TCGLoc of 59 { nil if none corresponding to this particular paraloc } 60 LOC_REFERENCE: (sym: tasmsymbol); 61 { if llvmvalueloc=true: the value is stored in the "register" 62 (anonymous temp, can be any register type and can also be e.g. 63 a struct) 64 if llvmvalueloc=false: must be a tempreg. Means that the value is 65 stored in a temp with this register as base address } 66 LOC_REGISTER: (reg: tregister); 67 LOC_CONSTANT: (value: tcgint); 68 end; 69 {$endif llvm} 70 case TCGLoc of 71 LOC_REFERENCE : (reference : TCGParaReference); 72 LOC_FPUREGISTER, 73 LOC_CFPUREGISTER, 74 LOC_MMREGISTER, 75 LOC_CMMREGISTER, 76 LOC_REGISTER, 77 LOC_CREGISTER : ( 78 { 79 80 * If shiftval > 0: 81 82 The number of bits the value in the register must be shifted to the left before 83 it can be stored to memory in the function prolog. 84 This is used for passing OS_NO memory blocks less than register size and of "odd" 85 (3, 5, 6, 7) size on big endian machines, so that small memory blocks passed via 86 registers are properly aligned. 87 88 E.g. the value $5544433 is passed in bits 40-63 of the register (others are zero), 89 but they should actually be stored in the first bits of the stack location reserved 90 for this value. So they have to be shifted left by this amount of bits before. 91 92 * if shiftval < 0: 93 94 Similar as above, but the shifting must always be done and 95 1) for all parameter sizes < regsize 96 2) on the caller side 97 } 98 shiftval : shortint; 99 register : tregister); 100 end; 101 102 { TCGPara } 103 104 TCGPara = object 105 Def : tdef; { Type of the parameter } 106 Location : PCGParalocation; 107 IntSize : tcgint; { size of the total location in bytes } 108 DefDeref : tderef; 109 Alignment : ShortInt; 110 Size : TCGSize; { Size of the parameter included in all locations } 111 Temporary : boolean; { created on the fly, no permanent references exist to this somewhere that will cause it to be disposed } 112 constructor init; 113 destructor done; 114 procedure reset; 115 procedure resetiftemp; { reset if Temporary } getcopynull116 function getcopy:tcgpara; 117 procedure check_simple_location; add_locationnull118 function add_location:pcgparalocation; 119 procedure get_location(var newloc:tlocation); locations_countnull120 function locations_count:integer; 121 122 procedure buildderef; 123 procedure deref; 124 procedure ppuwrite(ppufile:tcompilerppufile); 125 procedure ppuload(ppufile:tcompilerppufile); 126 end; 127 PCGPara = ^TCGPara; 128 129 tvarargsinfo = ( 130 va_uses_float_reg 131 ); 132 133 tparalist = class(TFPObjectList) 134 procedure SortParas; 135 end; 136 137 tvarargsparalist = class(tparalist) 138 varargsinfo : set of tvarargsinfo; 139 {$ifdef x86_64} 140 { x86_64 requires %al to contain the no. SSE regs passed } 141 mmregsused : longint; 142 {$endif x86_64} 143 end; 144 145 146 trttiparaloc = record 147 { contains the regtype in bits 0-6 and whether it's reference or not 148 in bit 7 } 149 loctype : byte; 150 regsub : byte; 151 regindex : word; 152 { either stack offset or shiftval } 153 offset : aint; 154 end; 155 156 157 trttiparalocs = array of trttiparaloc; 158 159 160 implementation 161 162 uses 163 systems,verbose, 164 symsym; 165 166 167 {**************************************************************************** 168 TCGPara 169 ****************************************************************************} 170 171 constructor tcgpara.init; 172 begin 173 alignment:=0; 174 size:=OS_NO; 175 intsize:=0; 176 location:=nil; 177 def:=nil; 178 temporary:=false; 179 end; 180 181 182 destructor tcgpara.done; 183 begin 184 reset; 185 end; 186 187 188 procedure tcgpara.reset; 189 var 190 hlocation : pcgparalocation; 191 begin 192 while assigned(location) do 193 begin 194 hlocation:=location^.next; 195 dispose(location); 196 location:=hlocation; 197 end; 198 alignment:=0; 199 size:=OS_NO; 200 intsize:=0; 201 end; 202 203 procedure TCGPara.resetiftemp; 204 begin 205 if temporary then 206 reset; 207 end; 208 209 tcgpara.getcopynull210 function tcgpara.getcopy:tcgpara; 211 var 212 srcloc,hlocation : pcgparalocation; 213 begin 214 result.init; 215 srcloc:=location; 216 while assigned(srcloc) do 217 begin 218 hlocation:=result.add_location; 219 hlocation^:=srcloc^; 220 hlocation^.next:=nil; 221 srcloc:=srcloc^.next; 222 end; 223 result.alignment:=alignment; 224 result.size:=size; 225 result.intsize:=intsize; 226 result.def:=def; 227 end; 228 229 tcgpara.add_locationnull230 function tcgpara.add_location:pcgparalocation; 231 var 232 prevlocation, 233 hlocation : pcgparalocation; 234 begin 235 prevlocation:=nil; 236 hlocation:=location; 237 while assigned(hlocation) do 238 begin 239 prevlocation:=hlocation; 240 hlocation:=hlocation^.next; 241 end; 242 new(hlocation); 243 Fillchar(hlocation^,sizeof(tcgparalocation),0); 244 if assigned(prevlocation) then 245 prevlocation^.next:=hlocation 246 else 247 location:=hlocation; 248 result:=hlocation; 249 end; 250 251 252 procedure tcgpara.check_simple_location; 253 begin 254 if not assigned(location) then 255 internalerror(200408161); 256 if assigned(location^.next) then 257 internalerror(200408162); 258 end; 259 260 261 procedure tcgpara.get_location(var newloc:tlocation); 262 begin 263 if not assigned(location) then 264 internalerror(200408205); 265 fillchar(newloc,sizeof(newloc),0); 266 newloc.loc:=location^.loc; 267 newloc.size:=size; 268 case location^.loc of 269 LOC_REGISTER : 270 begin 271 {$ifndef cpu64bitalu} 272 if size in [OS_64,OS_S64] then 273 begin 274 if not assigned(location^.next) then 275 internalerror(200408206); 276 if (location^.next^.loc<>LOC_REGISTER) then 277 internalerror(200408207); 278 if (target_info.endian = ENDIAN_BIG) then 279 begin 280 newloc.register64.reghi:=location^.register; 281 newloc.register64.reglo:=location^.next^.register; 282 end 283 else 284 begin 285 newloc.register64.reglo:=location^.register; 286 newloc.register64.reghi:=location^.next^.register; 287 end; 288 end 289 else 290 {$endif} 291 newloc.register:=location^.register; 292 end; 293 LOC_FPUREGISTER, 294 LOC_MMREGISTER : 295 newloc.register:=location^.register; 296 LOC_REFERENCE : 297 begin 298 newloc.reference.base:=location^.reference.index; 299 newloc.reference.offset:=location^.reference.offset; 300 newloc.reference.alignment:=alignment; 301 end; 302 end; 303 end; 304 305 TCGPara.locations_countnull306 function TCGPara.locations_count: integer; 307 var 308 hlocation: pcgparalocation; 309 begin 310 result:=0; 311 hlocation:=location; 312 while assigned(hlocation) do 313 begin 314 inc(result); 315 hlocation:=hlocation^.next; 316 end; 317 end; 318 319 320 procedure TCGPara.buildderef; 321 begin 322 defderef.build(def); 323 end; 324 325 326 procedure TCGPara.deref; 327 begin 328 def:=tdef(defderef.resolve); 329 end; 330 331 332 procedure TCGPara.ppuwrite(ppufile: tcompilerppufile); 333 var 334 hparaloc: PCGParaLocation; 335 nparaloc: byte; 336 begin 337 ppufile.putbyte(byte(Alignment)); 338 ppufile.putbyte(ord(Size)); 339 ppufile.putaint(IntSize); 340 ppufile.putderef(defderef); 341 nparaloc:=0; 342 hparaloc:=location; 343 while assigned(hparaloc) do 344 begin 345 inc(nparaloc); 346 hparaloc:=hparaloc^.Next; 347 end; 348 ppufile.putbyte(nparaloc); 349 hparaloc:=location; 350 while assigned(hparaloc) do 351 begin 352 ppufile.putbyte(byte(hparaloc^.Size)); 353 ppufile.putbyte(byte(hparaloc^.loc)); 354 case hparaloc^.loc of 355 LOC_REFERENCE: 356 begin 357 ppufile.putlongint(longint(hparaloc^.reference.index)); 358 ppufile.putaint(hparaloc^.reference.offset); 359 end; 360 LOC_FPUREGISTER, 361 LOC_CFPUREGISTER, 362 LOC_MMREGISTER, 363 LOC_CMMREGISTER, 364 LOC_REGISTER, 365 LOC_CREGISTER : 366 begin 367 ppufile.putbyte(hparaloc^.shiftval); 368 ppufile.putlongint(longint(hparaloc^.register)); 369 end; 370 { This seems to be required for systems using explicitparaloc (eg. MorphOS) 371 or otherwise it hits the internalerror below. I don't know if this is 372 the proper way to fix this, someone else with clue might want to take a 373 look. The compiler cycles on the affected systems with this enabled. (KB) } 374 LOC_VOID: 375 begin end 376 else 377 internalerror(2010053115); 378 end; 379 hparaloc:=hparaloc^.next; 380 end; 381 end; 382 383 384 procedure TCGPara.ppuload(ppufile: tcompilerppufile); 385 var 386 hparaloc: PCGParaLocation; 387 nparaloc: byte; 388 begin 389 reset; 390 Alignment:=shortint(ppufile.getbyte); 391 Size:=TCgSize(ppufile.getbyte); 392 IntSize:=ppufile.getaint; 393 ppufile.getderef(defderef); 394 nparaloc:=ppufile.getbyte; 395 while nparaloc>0 do 396 begin 397 hparaloc:=add_location; 398 hparaloc^.size:=TCGSize(ppufile.getbyte); 399 hparaloc^.loc:=TCGLoc(ppufile.getbyte); 400 case hparaloc^.loc of 401 LOC_REFERENCE: 402 begin 403 hparaloc^.reference.index:=tregister(ppufile.getlongint); 404 hparaloc^.reference.offset:=ppufile.getaint; 405 end; 406 LOC_FPUREGISTER, 407 LOC_CFPUREGISTER, 408 LOC_MMREGISTER, 409 LOC_CMMREGISTER, 410 LOC_REGISTER, 411 LOC_CREGISTER : 412 begin 413 hparaloc^.shiftval:=ppufile.getbyte; 414 hparaloc^.register:=tregister(ppufile.getlongint); 415 end; 416 { This seems to be required for systems using explicitparaloc (eg. MorphOS) 417 or otherwise it hits the internalerror below. I don't know if this is 418 the proper way to fix this, someone else with clue might want to take a 419 look. The compiler cycles on the affected systems with this enabled. (KB) } 420 LOC_VOID: 421 begin end 422 else 423 internalerror(2010051301); 424 end; 425 dec(nparaloc); 426 end; 427 end; 428 429 430 {**************************************************************************** 431 TParaList 432 ****************************************************************************} 433 ParaNrComparenull434 function ParaNrCompare(Item1, Item2: Pointer): Integer; 435 var 436 I1 : tparavarsym absolute Item1; 437 I2 : tparavarsym absolute Item2; 438 begin 439 Result:=longint(I1.paranr)-longint(I2.paranr); 440 end; 441 442 443 procedure TParaList.SortParas; 444 begin 445 Sort(@ParaNrCompare); 446 end; 447 448 449 end. 450