1 {
2     Copyright (c) 2003 by Florian Klaempfl
3 
4     ARM specific calling conventions
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 { ARM specific calling conventions are handled by this unit
22 }
23 unit cpupara;
24 
25 {$i fpcdefs.inc}
26 
27   interface
28 
29     uses
30        globtype,globals,
31        aasmdata,
32        cpuinfo,cpubase,cgbase,cgutils,
33        symconst,symtype,symdef,parabase,paramgr;
34 
35     type
36        tcpuparamanager = class(tparamanager)
get_volatile_registers_intnull37           function get_volatile_registers_int(calloption : tproccalloption):tcpuregisterset;override;
get_volatile_registers_fpunull38           function get_volatile_registers_fpu(calloption : tproccalloption):tcpuregisterset;override;
get_volatile_registers_mmnull39           function get_volatile_registers_mm(calloption : tproccalloption):tcpuregisterset;override;
get_saved_registers_intnull40           function get_saved_registers_int(calloption : tproccalloption):tcpuregisterarray;override;
push_addr_paramnull41           function push_addr_param(varspez:tvarspez;def : tdef;calloption : tproccalloption) : boolean;override;
ret_in_paramnull42           function ret_in_param(def:tdef;pd:tabstractprocdef):boolean;override;
43           procedure getintparaloc(list: TAsmList; pd : tabstractprocdef; nr : longint; var cgpara : tcgpara);override;
create_paraloc_infonull44           function create_paraloc_info(p : tabstractprocdef; side: tcallercallee):longint;override;
create_varargs_paraloc_infonull45           function create_varargs_paraloc_info(p : tabstractprocdef; varargspara:tvarargsparalist):longint;override;
get_funcretlocnull46           function get_funcretloc(p : tabstractprocdef; side: tcallercallee; forcetempdef: tdef): tcgpara;override;
47          private
48           procedure init_values(p: tabstractprocdef; side: tcallercallee; var curintreg,
49             curfloatreg, curmmreg: tsuperregister; var cur_stack_offset: aword;
50             var sparesinglereg: tregister);
create_paraloc_info_internnull51           function create_paraloc_info_intern(p : tabstractprocdef; side: tcallercallee; paras: tparalist;
52             var curintreg, curfloatreg, curmmreg: tsuperregister; var cur_stack_offset: aword; var sparesinglereg: tregister; isvariadic: boolean):longint;
53        end;
54 
55   implementation
56 
57     uses
58        verbose,systems,cutils,
59        defutil,symsym,symcpu,symtable,
60        { PowerPC uses procinfo as well in cpupara, so this should not hurt }
61        procinfo;
62 
63 
tcpuparamanager.get_volatile_registers_intnull64     function tcpuparamanager.get_volatile_registers_int(calloption : tproccalloption):tcpuregisterset;
65       begin
66         if (target_info.system<>system_arm_ios) then
67           result:=VOLATILE_INTREGISTERS
68         else
69           result:=VOLATILE_INTREGISTERS_DARWIN;
70       end;
71 
72 
tcpuparamanager.get_volatile_registers_fpunull73     function tcpuparamanager.get_volatile_registers_fpu(calloption : tproccalloption):tcpuregisterset;
74       begin
75         result:=VOLATILE_FPUREGISTERS;
76       end;
77 
78 
tcpuparamanager.get_volatile_registers_mmnull79     function tcpuparamanager.get_volatile_registers_mm(calloption: tproccalloption): tcpuregisterset;
80       begin
81         result:=VOLATILE_MMREGISTERS;
82       end;
83 
84 
tcpuparamanager.get_saved_registers_intnull85     function tcpuparamanager.get_saved_registers_int(calloption : tproccalloption):tcpuregisterarray;
86       const
87         saved_regs : array[0..6] of tsuperregister =
88           (RS_R4,RS_R5,RS_R6,RS_R7,RS_R8,RS_R9,RS_R10);
89       begin
90         result:=saved_regs;
91       end;
92 
93 
94     procedure tcpuparamanager.getintparaloc(list: TAsmList; pd : tabstractprocdef; nr : longint; var cgpara : tcgpara);
95       var
96         paraloc : pcgparalocation;
97         psym : tparavarsym;
98         pdef : tdef;
99       begin
100         if nr<1 then
101           internalerror(2002070801);
102         psym:=tparavarsym(pd.paras[nr-1]);
103         pdef:=psym.vardef;
104         if push_addr_param(psym.varspez,pdef,pd.proccalloption) then
105           pdef:=cpointerdef.getreusable_no_free(pdef);
106         cgpara.reset;
107         cgpara.size:=def_cgsize(pdef);
108         cgpara.intsize:=tcgsize2size[cgpara.size];
109         cgpara.alignment:=std_param_align;
110         cgpara.def:=pdef;
111         paraloc:=cgpara.add_location;
112         with paraloc^ do
113           begin
114             def:=pdef;
115             size:=def_cgsize(pdef);
116             { the four first parameters are passed into registers }
117             if nr<=4 then
118               begin
119                 loc:=LOC_REGISTER;
120                 register:=newreg(R_INTREGISTER,RS_R0+nr-1,R_SUBWHOLE);
121               end
122             else
123               begin
124                 { the other parameters are passed on the stack }
125                 loc:=LOC_REFERENCE;
126                 reference.index:=NR_STACK_POINTER_REG;
127                 reference.offset:=(nr-5)*4;
128               end;
129           end;
130       end;
131 
132 
getparalocnull133     function getparaloc(calloption : tproccalloption; p : tdef; isvariadic: boolean) : tcgloc;
134       begin
135          { Later, the LOC_REFERENCE is in most cases changed into LOC_REGISTER
136            if push_addr_param for the def is true
137          }
138          case p.typ of
139             orddef:
140               getparaloc:=LOC_REGISTER;
141             floatdef:
142               if ((target_info.abi=abi_eabihf) or (calloption=pocall_hardfloat)) and
143                  (not isvariadic) then
144                 getparaloc:=LOC_MMREGISTER
145               else if (calloption in cdecl_pocalls) or
146                  (cs_fp_emulation in current_settings.moduleswitches) or
147                  (current_settings.fputype in [fpu_vfpv2,fpu_vfpv3,fpu_vfpv4,fpu_vfpv3_d16,fpu_fpv4_s16]) then
148                 { the ARM eabi also allows passing VFP values via VFP registers,
149                   but Mac OS X doesn't seem to do that and linux only does it if
150                   built with the "-mfloat-abi=hard" option }
151                 getparaloc:=LOC_REGISTER
152               else
153                 getparaloc:=LOC_FPUREGISTER;
154             enumdef:
155               getparaloc:=LOC_REGISTER;
156             pointerdef:
157               getparaloc:=LOC_REGISTER;
158             formaldef:
159               getparaloc:=LOC_REGISTER;
160             classrefdef:
161               getparaloc:=LOC_REGISTER;
162             recorddef:
163               getparaloc:=LOC_REGISTER;
164             objectdef:
165               getparaloc:=LOC_REGISTER;
166             stringdef:
167               if is_shortstring(p) or is_longstring(p) then
168                 getparaloc:=LOC_REFERENCE
169               else
170                 getparaloc:=LOC_REGISTER;
171             procvardef:
172               getparaloc:=LOC_REGISTER;
173             filedef:
174               getparaloc:=LOC_REGISTER;
175             arraydef:
176               if is_dynamic_array(p) then
177                 getparaloc:=LOC_REGISTER
178               else
179                 getparaloc:=LOC_REFERENCE;
180             setdef:
181               if is_smallset(p) then
182                 getparaloc:=LOC_REGISTER
183               else
184                 getparaloc:=LOC_REFERENCE;
185             variantdef:
186               getparaloc:=LOC_REGISTER;
187             { avoid problems with errornous definitions }
188             errordef:
189               getparaloc:=LOC_REGISTER;
190             else
191               internalerror(2002071001);
192          end;
193       end;
194 
195 
tcpuparamanager.push_addr_paramnull196     function tcpuparamanager.push_addr_param(varspez:tvarspez;def : tdef;calloption : tproccalloption) : boolean;
197       begin
198         result:=false;
199         if varspez in [vs_var,vs_out,vs_constref] then
200           begin
201             result:=true;
202             exit;
203           end;
204         case def.typ of
205           objectdef:
206             result:=is_object(def) and ((varspez=vs_const) or (def.size=0));
207           recorddef:
208             { note: should this ever be changed, make sure that const records
209                 are always passed by reference for calloption=pocall_mwpascal }
210             result:=(varspez=vs_const) or (def.size=0);
211           variantdef,
212           formaldef:
213             result:=true;
214           arraydef:
215             result:=(tarraydef(def).highrange>=tarraydef(def).lowrange) or
216                              is_open_array(def) or
217                              is_array_of_const(def) or
218                              is_array_constructor(def);
219           setdef :
220             result:=not is_smallset(def);
221           stringdef :
222             result:=tstringdef(def).stringtype in [st_shortstring,st_longstring];
223         end;
224       end;
225 
226 
tcpuparamanager.ret_in_paramnull227     function tcpuparamanager.ret_in_param(def:tdef;pd:tabstractprocdef):boolean;
228       var
229         i: longint;
230         sym: tsym;
231       begin
232         if handle_common_ret_in_param(def,pd,result) then
233           exit;
234         case def.typ of
235           recorddef:
236             begin
237               result:=def.size>4;
238               if not result and
239                  (target_info.abi in [abi_default,abi_armeb]) then
240                 begin
241                   { in case of the old ARM abi (APCS), a struct is returned in
242                     a register only if it is simple. And what is a (non-)simple
243                     struct:
244 
245                     "A non-simple type is any non-floating-point type of size
246                      greater than one word (including structures containing only
247                      floating-point fields), and certain single-word structured
248                      types."
249                        (-- ARM APCS documentation)
250 
251                     So only floating point types or more than one word ->
252                     definitely non-simple (more than one word is already
253                     checked above). This includes unions/variant records with
254                     overlaid floating point and integer fields.
255 
256                     Smaller than one word struct types are simple if they are
257                     "integer-like", and:
258 
259                     "A structure is termed integer-like if its size is less than
260                     or equal to one word, and the offset of each of its
261                     addressable subfields is zero."
262                       (-- ARM APCS documentation)
263 
264                     An "addressable subfield" is a field of which you can take
265                     the address, which in practive means any non-bitfield.
266                     In Pascal, there is no way to express the difference that
267                     you can have in C between "char" and "int :8". In this
268                     context, we use the fake distinction that a type defined
269                     inside the record itself (such as "a: 0..255;") indicates
270                     a bitpacked field while a field using a different type
271                     (such as "a: byte;") is not.
272                   }
273                   for i:=0 to trecorddef(def).symtable.SymList.count-1 do
274                     begin
275                       sym:=tsym(trecorddef(def).symtable.SymList[i]);
276                       if sym.typ<>fieldvarsym then
277                         continue;
278                       { bitfield -> ignore }
279                       if (trecordsymtable(trecorddef(def).symtable).usefieldalignment=bit_alignment) and
280                          (tfieldvarsym(sym).vardef.typ in [orddef,enumdef]) and
281                          (tfieldvarsym(sym).vardef.owner.defowner=def) then
282                         continue;
283                       { all other fields must be at offset zero }
284                       if tfieldvarsym(sym).fieldoffset<>0 then
285                         begin
286                           result:=true;
287                           exit;
288                         end;
289                       { floating point field -> also by reference }
290                       if tfieldvarsym(sym).vardef.typ=floatdef then
291                         begin
292                           result:=true;
293                           exit;
294                         end;
295                     end;
296                 end;
297             end;
298           procvardef:
299             if not tprocvardef(def).is_addressonly then
300               result:=true
301             else
302               result:=false
303           else
304             result:=inherited ret_in_param(def,pd);
305         end;
306       end;
307 
308 
309     procedure tcpuparamanager.init_values(p : tabstractprocdef; side: tcallercallee;
310       var curintreg, curfloatreg, curmmreg: tsuperregister; var cur_stack_offset: aword; var sparesinglereg: tregister);
311       begin
312         curintreg:=RS_R0;
313         curfloatreg:=RS_F0;
314         curmmreg:=RS_D0;
315 
316         if (side=calleeside) and (GenerateThumbCode or (pi_estimatestacksize in current_procinfo.flags)) then
317           cur_stack_offset:=(p as tcpuprocdef).total_stackframe_size
318         else
319           cur_stack_offset:=0;
320         sparesinglereg := NR_NO;
321       end;
322 
323 
tcpuparamanager.create_paraloc_info_internnull324     function tcpuparamanager.create_paraloc_info_intern(p : tabstractprocdef; side: tcallercallee; paras: tparalist;
325         var curintreg, curfloatreg, curmmreg: tsuperregister; var cur_stack_offset: aword; var sparesinglereg: tregister; isvariadic: boolean):longint;
326 
327       var
328         nextintreg,nextfloatreg,nextmmreg : tsuperregister;
329         paradef : tdef;
330         paraloc : pcgparalocation;
331         stack_offset : aword;
332         hp : tparavarsym;
333         loc : tcgloc;
334         paracgsize   : tcgsize;
335         paralen : longint;
336         i : integer;
337         firstparaloc: boolean;
338 
339       procedure assignintreg;
340         begin
341           { In case of po_delphi_nested_cc, the parent frame pointer
342             is always passed on the stack. }
343            if (nextintreg<=RS_R3) and
344               (not(vo_is_parentfp in hp.varoptions) or
345                not(po_delphi_nested_cc in p.procoptions)) then
346              begin
347                paraloc^.loc:=LOC_REGISTER;
348                paraloc^.register:=newreg(R_INTREGISTER,nextintreg,R_SUBWHOLE);
349                inc(nextintreg);
350              end
351            else
352              begin
353                paraloc^.loc:=LOC_REFERENCE;
354                paraloc^.reference.index:=NR_STACK_POINTER_REG;
355                paraloc^.reference.offset:=stack_offset;
356                inc(stack_offset,4);
357             end;
358         end;
359 
360 
361       begin
362         result:=0;
363         nextintreg:=curintreg;
364         nextfloatreg:=curfloatreg;
365         nextmmreg:=curmmreg;
366         stack_offset:=cur_stack_offset;
367 
368         for i:=0 to paras.count-1 do
369           begin
370             hp:=tparavarsym(paras[i]);
371             paradef:=hp.vardef;
372 
373             hp.paraloc[side].reset;
374 
375             { currently only support C-style array of const,
376               there should be no location assigned to the vararg array itself }
377             if (p.proccalloption in cstylearrayofconst) and
378                is_array_of_const(paradef) then
379               begin
380                 paraloc:=hp.paraloc[side].add_location;
381                 { hack: the paraloc must be valid, but is not actually used }
382                 paraloc^.loc:=LOC_REGISTER;
383                 paraloc^.register:=NR_R0;
384                 paraloc^.size:=OS_ADDR;
385                 paraloc^.def:=voidpointertype;
386                 break;
387               end;
388 
389             if push_addr_param(hp.varspez,paradef,p.proccalloption) then
390               begin
391                 paradef:=cpointerdef.getreusable_no_free(paradef);
392                 loc:=LOC_REGISTER;
393                 paracgsize := OS_ADDR;
394                 paralen := tcgsize2size[OS_ADDR];
395               end
396             else
397               begin
398                 if not is_special_array(paradef) then
399                   paralen := paradef.size
400                 else
401                   paralen := tcgsize2size[def_cgsize(paradef)];
402                 loc := getparaloc(p.proccalloption,paradef,isvariadic);
403                 if (paradef.typ in [objectdef,arraydef,recorddef]) and
404                   not is_special_array(paradef) and
405                   (hp.varspez in [vs_value,vs_const]) then
406                   paracgsize := int_cgsize(paralen)
407                 else
408                   begin
409                     paracgsize:=def_cgsize(paradef);
410                     { for things like formaldef }
411                     if (paracgsize=OS_NO) then
412                       begin
413                         paracgsize:=OS_ADDR;
414                         paralen:=tcgsize2size[OS_ADDR];
415                         paradef:=voidpointertype;
416                       end;
417                   end
418               end;
419 
420              hp.paraloc[side].size:=paracgsize;
421              hp.paraloc[side].Alignment:=std_param_align;
422              hp.paraloc[side].intsize:=paralen;
423              hp.paraloc[side].def:=paradef;
424              firstparaloc:=true;
425 
426 {$ifdef EXTDEBUG}
427              if paralen=0 then
428                internalerror(200410311);
429 {$endif EXTDEBUG}
430              while paralen>0 do
431                begin
432                  paraloc:=hp.paraloc[side].add_location;
433 
434                  if (loc=LOC_REGISTER) and (paracgsize in [OS_F32,OS_F64,OS_F80]) then
435                    case paracgsize of
436                      OS_F32:
437                        begin
438                          paraloc^.size:=OS_32;
439                          paraloc^.def:=u32inttype;
440                        end;
441                      OS_F64:
442                        begin
443                          paraloc^.size:=OS_32;
444                          paraloc^.def:=u32inttype;
445                        end;
446                      else
447                        internalerror(2005082901);
448                    end
449                  else if (paracgsize in [OS_NO,OS_64,OS_S64]) then
450                    begin
451                      paraloc^.size:=OS_32;
452                      paraloc^.def:=u32inttype;
453                    end
454                  else
455                    begin
456                      paraloc^.size:=paracgsize;
457                      paraloc^.def:=get_paraloc_def(paradef,paralen,firstparaloc);
458                    end;
459                  case loc of
460                     LOC_REGISTER:
461                       begin
462                         { align registers for eabi }
463                         if (target_info.abi in [abi_eabi,abi_eabihf]) and
464                            firstparaloc and
465                            (paradef.alignment=8) then
466                           begin
467                             if (nextintreg in [RS_R1,RS_R3]) then
468                               inc(nextintreg)
469                             else if nextintreg>RS_R3 then
470                               stack_offset:=align(stack_offset,8);
471                           end;
472                         { this is not abi compliant
473                           why? (FK) }
474                         if nextintreg<=RS_R3 then
475                           begin
476                             paraloc^.loc:=LOC_REGISTER;
477                             paraloc^.register:=newreg(R_INTREGISTER,nextintreg,R_SUBWHOLE);
478                             inc(nextintreg);
479                           end
480                         else
481                           begin
482                             { LOC_REFERENCE always contains everything that's left }
483                             paraloc^.loc:=LOC_REFERENCE;
484                             paraloc^.size:=int_cgsize(paralen);
485                             paraloc^.def:=carraydef.getreusable_no_free(u8inttype,paralen);
486                             if (side=callerside) then
487                               paraloc^.reference.index:=NR_STACK_POINTER_REG;
488                             paraloc^.reference.offset:=stack_offset;
489                             inc(stack_offset,align(paralen,4));
490                             paralen:=0;
491                          end;
492                       end;
493                     LOC_FPUREGISTER:
494                       begin
495                         if nextfloatreg<=RS_F3 then
496                           begin
497                             paraloc^.loc:=LOC_FPUREGISTER;
498                             paraloc^.register:=newreg(R_FPUREGISTER,nextfloatreg,R_SUBWHOLE);
499                             inc(nextfloatreg);
500                           end
501                         else
502                           begin
503                             paraloc^.loc:=LOC_REFERENCE;
504                             paraloc^.reference.index:=NR_STACK_POINTER_REG;
505                             paraloc^.reference.offset:=stack_offset;
506                             case paraloc^.size of
507                               OS_F32:
508                                 inc(stack_offset,4);
509                               OS_F64:
510                                 inc(stack_offset,8);
511                               OS_F80:
512                                 inc(stack_offset,10);
513                               OS_F128:
514                                 inc(stack_offset,16);
515                               else
516                                 internalerror(200403201);
517                             end;
518                           end;
519                       end;
520                     LOC_MMREGISTER:
521                       begin
522                         if (nextmmreg<=RS_D7) or
523                            ((paraloc^.size = OS_F32) and
524                             (sparesinglereg<>NR_NO)) then
525                           begin
526                             paraloc^.loc:=LOC_MMREGISTER;
527                             case paraloc^.size of
528                               OS_F32:
529                                 if sparesinglereg = NR_NO then
530                                   begin
531                                     paraloc^.register:=newreg(R_MMREGISTER,nextmmreg,R_SUBFS);
532                                     sparesinglereg:=newreg(R_MMREGISTER,nextmmreg-RS_S0+RS_S1,R_SUBFS);
533                                     inc(nextmmreg);
534                                   end
535                                 else
536                                   begin
537                                     paraloc^.register:=sparesinglereg;
538                                     sparesinglereg := NR_NO;
539                                   end;
540                               OS_F64:
541                                 begin
542                                   paraloc^.register:=newreg(R_MMREGISTER,nextmmreg,R_SUBFD);
543                                   inc(nextmmreg);
544                                 end;
545                               else
546                                 internalerror(2012031601);
547                             end;
548                           end
549                         else
550                           begin
551                             { once a floating point parameters has been placed
552                             on the stack we must not pass any more in vfp regs
553                             even if there is a single precision register still
554                             free}
555                             sparesinglereg := NR_NO;
556                             { LOC_REFERENCE always contains everything that's left }
557                             paraloc^.loc:=LOC_REFERENCE;
558                             paraloc^.size:=int_cgsize(paralen);
559                             paraloc^.def:=carraydef.getreusable_no_free(u8inttype,paralen);
560                             if (side=callerside) then
561                               paraloc^.reference.index:=NR_STACK_POINTER_REG;
562                             paraloc^.reference.offset:=stack_offset;
563                             inc(stack_offset,align(paralen,4));
564                             paralen:=0;
565                          end;
566                       end;
567                     LOC_REFERENCE:
568                       begin
569                         if push_addr_param(hp.varspez,paradef,p.proccalloption) then
570                           begin
571                             paraloc^.size:=OS_ADDR;
572                             paraloc^.def:=cpointerdef.getreusable_no_free(paradef);
573                             assignintreg
574                           end
575                         else
576                           begin
577                             { align stack for eabi }
578                             if (target_info.abi in [abi_eabi,abi_eabihf]) and
579                                firstparaloc and
580                                (paradef.alignment=8) then
581                               stack_offset:=align(stack_offset,8);
582 
583                              paraloc^.size:=paracgsize;
584                              paraloc^.def:=paradef;
585                              paraloc^.loc:=LOC_REFERENCE;
586                              paraloc^.reference.index:=NR_STACK_POINTER_REG;
587                              paraloc^.reference.offset:=stack_offset;
588                              inc(stack_offset,align(paralen,4));
589                              paralen:=0
590                           end;
591                       end;
592                     else
593                       internalerror(2002071002);
594                  end;
595                  if side=calleeside then
596                    begin
597                      if paraloc^.loc=LOC_REFERENCE then
598                        begin
599                          paraloc^.reference.index:=current_procinfo.framepointer;
600                          if current_procinfo.framepointer=NR_FRAME_POINTER_REG then
601                            begin
602                              { on non-Darwin, the framepointer contains the value
603                                of the stack pointer on entry. On Darwin, the
604                                framepointer points to the previously saved
605                                framepointer (which is followed only by the saved
606                                return address -> framepointer + 4 = stack pointer
607                                on entry }
608                              if not(target_info.system in systems_darwin) then
609                                inc(paraloc^.reference.offset,4)
610                              else
611                                inc(paraloc^.reference.offset,8);
612                            end;
613                        end;
614                    end;
615                  dec(paralen,tcgsize2size[paraloc^.size]);
616                  firstparaloc:=false
617                end;
618           end;
619         curintreg:=nextintreg;
620         curfloatreg:=nextfloatreg;
621         curmmreg:=nextmmreg;
622         cur_stack_offset:=stack_offset;
623         result:=cur_stack_offset;
624       end;
625 
626 
tcpuparamanager.get_funcretlocnull627     function  tcpuparamanager.get_funcretloc(p : tabstractprocdef; side: tcallercallee; forcetempdef: tdef): tcgpara;
628       var
629         paraloc : pcgparalocation;
630         retcgsize  : tcgsize;
631       begin
632          if set_common_funcretloc_info(p,forcetempdef,retcgsize,result) then
633            exit;
634 
635         paraloc:=result.add_location;
636         { Return in FPU register? }
637         if result.def.typ=floatdef then
638           begin
639             if (target_info.abi=abi_eabihf) or (p.proccalloption=pocall_hardfloat) then
640               begin
641                 paraloc^.loc:=LOC_MMREGISTER;
642                 case retcgsize of
643                   OS_64,
644                   OS_F64:
645                     begin
646                       paraloc^.register:=NR_MM_RESULT_REG;
647                     end;
648                   OS_32,
649                   OS_F32:
650                     begin
651                       paraloc^.register:=NR_S0;
652                     end;
653                   else
654                     internalerror(2012032501);
655                 end;
656                 paraloc^.size:=retcgsize;
657                 paraloc^.def:=result.def;
658               end
659             else if (p.proccalloption in [pocall_softfloat]) or
660                (cs_fp_emulation in current_settings.moduleswitches) or
661                (current_settings.fputype in [fpu_vfpv2,fpu_vfpv3,fpu_vfpv4,fpu_vfpv3_d16,fpu_fpv4_s16]) then
662               begin
663                 case retcgsize of
664                   OS_64,
665                   OS_F64:
666                     begin
667                       paraloc^.loc:=LOC_REGISTER;
668                       if target_info.endian = endian_big then
669                         paraloc^.register:=NR_FUNCTION_RESULT64_HIGH_REG
670                       else
671                         paraloc^.register:=NR_FUNCTION_RESULT64_LOW_REG;
672                       paraloc^.size:=OS_32;
673                       paraloc^.def:=u32inttype;
674                       paraloc:=result.add_location;
675                       paraloc^.loc:=LOC_REGISTER;
676                       if target_info.endian = endian_big then
677                         paraloc^.register:=NR_FUNCTION_RESULT64_LOW_REG
678                       else
679                         paraloc^.register:=NR_FUNCTION_RESULT64_HIGH_REG;
680                       paraloc^.size:=OS_32;
681                       paraloc^.def:=u32inttype;
682                     end;
683                   OS_32,
684                   OS_F32:
685                     begin
686                       paraloc^.loc:=LOC_REGISTER;
687                       paraloc^.register:=NR_FUNCTION_RETURN_REG;
688                       paraloc^.size:=OS_32;
689                       paraloc^.def:=u32inttype;
690                     end;
691                   else
692                     internalerror(2005082603);
693                 end;
694               end
695             else
696               begin
697                 paraloc^.loc:=LOC_FPUREGISTER;
698                 paraloc^.register:=NR_FPU_RESULT_REG;
699                 paraloc^.size:=retcgsize;
700                 paraloc^.def:=result.def;
701               end;
702           end
703           { Return in register }
704         else
705           begin
706             if retcgsize in [OS_64,OS_S64] then
707               begin
708                 paraloc^.loc:=LOC_REGISTER;
709                 if target_info.endian = endian_big then
710                   paraloc^.register:=NR_FUNCTION_RESULT64_HIGH_REG
711                 else
712                   paraloc^.register:=NR_FUNCTION_RESULT64_LOW_REG;
713                 paraloc^.size:=OS_32;
714                 paraloc^.def:=u32inttype;
715                 paraloc:=result.add_location;
716                 paraloc^.loc:=LOC_REGISTER;
717                 if target_info.endian = endian_big then
718                   paraloc^.register:=NR_FUNCTION_RESULT64_LOW_REG
719                 else
720                   paraloc^.register:=NR_FUNCTION_RESULT64_HIGH_REG;
721                 paraloc^.size:=OS_32;
722                 paraloc^.def:=u32inttype;
723               end
724             else
725               begin
726                 paraloc^.loc:=LOC_REGISTER;
727                 paraloc^.register:=NR_FUNCTION_RETURN_REG;
728                 case result.IntSize of
729                   0:
730                     begin
731                       paraloc^.loc:=LOC_VOID;
732                       paraloc^.register:=NR_NO;
733                       paraloc^.size:=OS_NO;
734                       paraloc^.def:=voidpointertype;
735                     end;
736                   3:
737                     begin
738                       paraloc^.size:=OS_32;
739                       paraloc^.def:=u32inttype;
740                     end;
741                   else
742                     begin
743                       paraloc^.size:=retcgsize;
744                       paraloc^.def:=result.def;
745                     end;
746                 end;
747               end;
748           end;
749       end;
750 
751 
tcpuparamanager.create_paraloc_infonull752     function tcpuparamanager.create_paraloc_info(p : tabstractprocdef; side: tcallercallee):longint;
753       var
754         cur_stack_offset: aword;
755         curintreg, curfloatreg, curmmreg: tsuperregister;
756         sparesinglereg:tregister;
757       begin
758         init_values(p,side,curintreg,curfloatreg,curmmreg,cur_stack_offset,sparesinglereg);
759 
760         result:=create_paraloc_info_intern(p,side,p.paras,curintreg,curfloatreg,curmmreg,cur_stack_offset,sparesinglereg,false);
761 
762         create_funcretloc_info(p,side);
763      end;
764 
765 
tcpuparamanager.create_varargs_paraloc_infonull766     function tcpuparamanager.create_varargs_paraloc_info(p : tabstractprocdef; varargspara:tvarargsparalist):longint;
767       var
768         cur_stack_offset: aword;
769         curintreg, curfloatreg, curmmreg: tsuperregister;
770         sparesinglereg:tregister;
771       begin
772         init_values(p,callerside,curintreg,curfloatreg,curmmreg,cur_stack_offset,sparesinglereg);
773 
774         result:=create_paraloc_info_intern(p,callerside,p.paras,curintreg,curfloatreg,curmmreg,cur_stack_offset,sparesinglereg,true);
775         if (p.proccalloption in cstylearrayofconst) then
776           { just continue loading the parameters in the registers }
777           result:=create_paraloc_info_intern(p,callerside,varargspara,curintreg,curfloatreg,curmmreg,cur_stack_offset,sparesinglereg,true)
778         else
779           internalerror(200410231);
780       end;
781 
782 begin
783    paramanager:=tcpuparamanager.create;
784 end.
785