← Back to branch summary

~ubuntu-branches/debian/lenny/fpc/lenny

« back to all changes in this revision

Viewing changes to fpcsrc/compiler/ppcgen/cgppc.pas

  • Committer: Bazaar Package Importer
  • Author(s): Mazen Neifer, Torsten Werner, Mazen Neifer
  • Date: 2008-05-17 17:12:11 UTC
  • mfrom: (3.1.9 intrepid)
  • Revision ID: james.westby@ubuntu.com-20080517171211-9qi33xhd9evfa0kg
Tags: 2.2.0-dfsg1-9
http://bugs.debian.org/477743
[ Torsten Werner ]
* Add Mazen Neifer to Uploaders field.

[ Mazen Neifer ]
* Moved FPC sources into a version dependent directory from /usr/share/fpcsrc
  to /usr/share/fpcsrc/${FPCVERSION}. This allow installing more than on FPC
  release.
* Fixed far call issue in compiler preventing building huge binearies.
  (closes: #477743)
* Updated building dependencies, recomennded and suggested packages.
* Moved fppkg to fp-utils as it is just a helper tool and is not required by
  compiler.

Show diffs side-by-side

added added

removed removed

Lines of Context:
fpcsrc/compiler/ppcgen/cgppc.pas
 
1
{
 
2
    Copyright (c) 2006 by Florian Klaempfl
 
3
 
 
4
    This unit implements the common part of the code generator for the PowerPC
 
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 cgppc;
 
23
 
 
24
{$i fpcdefs.inc}
 
25
 
 
26
  interface
 
27
 
 
28
    uses
 
29
       globtype,symtype,symdef,
 
30
       cgbase,cgobj,
 
31
       aasmbase,aasmcpu,aasmtai,aasmdata,
 
32
       cpubase,cpuinfo,cgutils,rgcpu,
 
33
       parabase;
 
34
 
 
35
    type
 
36
      tcgppcgen = class(tcg)
 
37
        procedure a_param_const(list: TAsmList; size: tcgsize; a: aint; const paraloc : tcgpara); override;
 
38
        procedure a_paramaddr_ref(list : TAsmList;const r : treference;const paraloc : tcgpara); override;
 
39
 
 
40
        procedure a_call_reg(list : TAsmList;reg: tregister); override;
 
41
        procedure a_call_ref(list : TAsmList;ref: treference); override;
 
42
 
 
43
        { stores the contents of register reg to the memory location described by
 
44
        ref }
 
45
        procedure a_load_reg_ref(list: TAsmList; fromsize, tosize: TCGSize;
 
46
          reg: tregister; const ref: treference); override;
 
47
 
 
48
        { fpu move instructions }
 
49
        procedure a_loadfpu_reg_reg(list: TAsmList; fromsize, tosize: tcgsize; reg1, reg2: tregister); override;
 
50
        procedure a_loadfpu_ref_reg(list: TAsmList; fromsize, tosize: tcgsize; const ref: treference; reg: tregister); override;
 
51
        procedure a_loadfpu_reg_ref(list: TAsmList; fromsize, tosize: tcgsize; reg: tregister; const ref: treference); override;
 
52
 
 
53
        { overflow checking }
 
54
        procedure g_overflowcheck(list: TAsmList; const l: tlocation; def: tdef);override;
 
55
 
 
56
        { entry code }
 
57
        procedure g_profilecode(list: TAsmList); override;
 
58
 
 
59
        procedure a_jmp_cond(list : TAsmList;cond : TOpCmp;l: tasmlabel);
 
60
       protected
 
61
        function  get_darwin_call_stub(const s: string): tasmsymbol;
 
62
        procedure a_load_subsetref_regs_noindex(list: TAsmList; subsetsize: tcgsize; loadbitsize: byte; const sref: tsubsetreference; valuereg, extra_value_reg: tregister); override;
 
63
        function  fixref(list: TAsmList; var ref: treference): boolean; virtual; abstract;
 
64
        procedure a_load_store(list:TAsmList;op: tasmop;reg:tregister;ref: treference);virtual;abstract;
 
65
 
 
66
        { creates the correct branch instruction for a given combination }
 
67
        { of asmcondflags and destination addressing mode                }
 
68
        procedure a_jmp(list: TAsmList; op: tasmop;
 
69
                        c: tasmcondflag; crval: longint; l: tasmlabel);
 
70
     end;
 
71
 
 
72
  const
 
73
    TOpCmp2AsmCond: Array[topcmp] of TAsmCondFlag = (C_NONE,C_EQ,C_GT,
 
74
                         C_LT,C_GE,C_LE,C_NE,C_LE,C_LT,C_GE,C_GT);  
 
75
 
 
76
 
 
77
  implementation
 
78
 
 
79
    uses
 
80
       globals,verbose,systems,cutils,
 
81
       symconst,symsym,fmodule,
 
82
       rgobj,tgobj,cpupi,procinfo,paramgr;
 
83
 
 
84
 
 
85
    procedure tcgppcgen.a_param_const(list: TAsmList; size: tcgsize; a: aint; const
 
86
      paraloc: tcgpara);
 
87
    var
 
88
      ref: treference;
 
89
    begin
 
90
      paraloc.check_simple_location;
 
91
      case paraloc.location^.loc of
 
92
        LOC_REGISTER, LOC_CREGISTER:
 
93
          a_load_const_reg(list, size, a, paraloc.location^.register);
 
94
        LOC_REFERENCE:
 
95
          begin
 
96
            reference_reset(ref);
 
97
            ref.base := paraloc.location^.reference.index;
 
98
            ref.offset := paraloc.location^.reference.offset;
 
99
            a_load_const_ref(list, size, a, ref);
 
100
          end;
 
101
      else
 
102
        internalerror(2002081101);
 
103
      end;
 
104
    end;
 
105
 
 
106
 
 
107
    procedure tcgppcgen.a_paramaddr_ref(list : TAsmList;const r : treference;const paraloc : tcgpara);
 
108
      var
 
109
        ref: treference;
 
110
        tmpreg: tregister;
 
111
 
 
112
      begin
 
113
        paraloc.check_simple_location;
 
114
        case paraloc.location^.loc of
 
115
           LOC_REGISTER,LOC_CREGISTER:
 
116
             a_loadaddr_ref_reg(list,r,paraloc.location^.register);
 
117
           LOC_REFERENCE:
 
118
             begin
 
119
               reference_reset(ref);
 
120
               ref.base := paraloc.location^.reference.index;
 
121
               ref.offset := paraloc.location^.reference.offset;
 
122
               tmpreg := rg[R_INTREGISTER].getregister(list,R_SUBWHOLE);
 
123
               a_loadaddr_ref_reg(list,r,tmpreg);
 
124
               a_load_reg_ref(list,OS_ADDR,OS_ADDR,tmpreg,ref);
 
125
             end;
 
126
           else
 
127
             internalerror(2002080701);
 
128
        end;
 
129
      end;
 
130
 
 
131
 
 
132
    function tcgppcgen.get_darwin_call_stub(const s: string): tasmsymbol;
 
133
      var
 
134
        stubname: string;
 
135
        href: treference;
 
136
        l1: tasmsymbol;
 
137
      begin
 
138
        { function declared in the current unit? }
 
139
        { doesn't work correctly, because this will also return a hit if we }
 
140
        { previously took the address of an external procedure. It doesn't  }
 
141
        { really matter, the linker will remove all unnecessary stubs.      }
 
142
        stubname := 'L'+s+'$stub';
 
143
        result := current_asmdata.getasmsymbol(stubname);
 
144
        if assigned(result) then
 
145
          exit;
 
146
 
 
147
        if current_asmdata.asmlists[al_imports]=nil then
 
148
          current_asmdata.asmlists[al_imports]:=TAsmList.create;
 
149
 
 
150
        current_asmdata.asmlists[al_imports].concat(Tai_section.create(sec_stub,'',0));
 
151
        current_asmdata.asmlists[al_imports].concat(Tai_align.Create(16));
 
152
        result := current_asmdata.RefAsmSymbol(stubname);
 
153
        current_asmdata.asmlists[al_imports].concat(Tai_symbol.Create(result,0));
 
154
        current_asmdata.asmlists[al_imports].concat(tai_directive.create(asd_indirect_symbol,s));
 
155
        l1 := current_asmdata.RefAsmSymbol('L'+s+'$lazy_ptr');
 
156
        reference_reset_symbol(href,l1,0);
 
157
        href.refaddr := addr_hi;
 
158
        current_asmdata.asmlists[al_imports].concat(taicpu.op_reg_ref(A_LIS,NR_R11,href));
 
159
        href.refaddr := addr_lo;
 
160
        href.base := NR_R11;
 
161
{$ifndef cpu64bit}
 
162
        current_asmdata.asmlists[al_imports].concat(taicpu.op_reg_ref(A_LWZU,NR_R12,href));
 
163
{$else cpu64bit}
 
164
        { darwin/ppc64 uses a 32 bit absolute address here, strange... }
 
165
        current_asmdata.asmlists[al_imports].concat(taicpu.op_reg_ref(A_LDU,NR_R12,href));
 
166
{$endif cpu64bit}
 
167
        current_asmdata.asmlists[al_imports].concat(taicpu.op_reg(A_MTCTR,NR_R12));
 
168
        current_asmdata.asmlists[al_imports].concat(taicpu.op_none(A_BCTR));
 
169
        current_asmdata.asmlists[al_imports].concat(tai_directive.create(asd_lazy_symbol_pointer,''));
 
170
        current_asmdata.asmlists[al_imports].concat(Tai_symbol.Create(l1,0));
 
171
        current_asmdata.asmlists[al_imports].concat(tai_directive.create(asd_indirect_symbol,s));
 
172
        current_asmdata.asmlists[al_imports].concat(tai_const.createname('dyld_stub_binding_helper',0));
 
173
      end;
 
174
 
 
175
 
 
176
    { calling a procedure by address }
 
177
    procedure tcgppcgen.a_call_reg(list : TAsmList;reg: tregister);
 
178
      begin
 
179
        list.concat(taicpu.op_reg(A_MTCTR,reg));
 
180
        list.concat(taicpu.op_none(A_BCTRL));
 
181
        include(current_procinfo.flags,pi_do_call);
 
182
      end;
 
183
 
 
184
 
 
185
    procedure tcgppcgen.a_call_ref(list : TAsmList;ref: treference);
 
186
      var
 
187
        tempreg : TRegister;
 
188
      begin
 
189
        tempreg := getintregister(list, OS_ADDR);
 
190
        a_load_ref_reg(list,OS_ADDR,OS_ADDR,ref,tempreg);
 
191
        a_call_reg(list,tempreg);
 
192
      end;
 
193
 
 
194
 
 
195
    procedure tcgppcgen.a_load_reg_ref(list: TAsmList; fromsize, tosize: TCGSize;
 
196
      reg: tregister; const ref: treference);
 
197
    
 
198
    const
 
199
      StoreInstr: array[OS_8..OS_INT, boolean, boolean] of TAsmOp =
 
200
      { indexed? updating?}
 
201
      (((A_STB, A_STBU), (A_STBX, A_STBUX)),
 
202
        ((A_STH, A_STHU), (A_STHX, A_STHUX)),
 
203
        ((A_STW, A_STWU), (A_STWX, A_STWUX))
 
204
{$ifdef cpu64bit}
 
205
        ,
 
206
        ((A_STD, A_STDU), (A_STDX, A_STDUX))
 
207
{$endif cpu64bit}
 
208
        );
 
209
    var
 
210
      op: TAsmOp;
 
211
      ref2: TReference;
 
212
    begin
 
213
      if not (fromsize in [OS_8..OS_INT,OS_S8..OS_SINT]) then
 
214
        internalerror(2002090903);
 
215
      if not (tosize in [OS_8..OS_INT,OS_S8..OS_SINT]) then
 
216
        internalerror(2002090905);
 
217
    
 
218
      ref2 := ref;
 
219
      fixref(list, ref2);
 
220
      if tosize in [OS_S8..OS_SINT] then
 
221
        { storing is the same for signed and unsigned values }
 
222
        tosize := tcgsize(ord(tosize) - (ord(OS_S8) - ord(OS_8)));
 
223
      op := storeinstr[tcgsize2unsigned[tosize], ref2.index <> NR_NO, false];
 
224
      a_load_store(list, op, reg, ref2);
 
225
    end;
 
226
 
 
227
 
 
228
 
 
229
     procedure tcgppcgen.a_loadfpu_reg_reg(list: TAsmList; fromsize, tosize: tcgsize; reg1, reg2: tregister);
 
230
 
 
231
       var
 
232
         op: tasmop;
 
233
         instr: taicpu;
 
234
       begin
 
235
         if not(fromsize in [OS_F32,OS_F64]) or
 
236
            not(tosize in [OS_F32,OS_F64]) then
 
237
           internalerror(2006123110);
 
238
         if (tosize < fromsize) then
 
239
           op:=A_FRSP
 
240
         else
 
241
           op:=A_FMR;
 
242
         instr := taicpu.op_reg_reg(op,reg2,reg1);
 
243
         list.concat(instr);
 
244
         if (op = A_FMR) then
 
245
           rg[R_FPUREGISTER].add_move_instruction(instr);
 
246
       end;
 
247
 
 
248
 
 
249
     procedure tcgppcgen.a_loadfpu_ref_reg(list: TAsmList; fromsize, tosize: tcgsize; const ref: treference; reg: tregister);
 
250
 
 
251
       const
 
252
         FpuLoadInstr: Array[OS_F32..OS_F64,boolean, boolean] of TAsmOp =
 
253
                          { indexed? updating?}
 
254
                    (((A_LFS,A_LFSU),(A_LFSX,A_LFSUX)),
 
255
                     ((A_LFD,A_LFDU),(A_LFDX,A_LFDUX)));
 
256
       var
 
257
         op: tasmop;
 
258
         ref2: treference;
 
259
 
 
260
       begin
 
261
         if not(fromsize in [OS_F32,OS_F64]) or
 
262
            not(tosize in [OS_F32,OS_F64]) then
 
263
           internalerror(200201121);
 
264
         ref2 := ref;
 
265
         fixref(list,ref2);
 
266
         op := fpuloadinstr[fromsize,ref2.index <> NR_NO,false];
 
267
         a_load_store(list,op,reg,ref2);
 
268
         if (fromsize > tosize) then
 
269
           a_loadfpu_reg_reg(list,fromsize,tosize,reg,reg);
 
270
       end;
 
271
 
 
272
 
 
273
     procedure tcgppcgen.a_loadfpu_reg_ref(list: TAsmList; fromsize, tosize: tcgsize; reg: tregister; const ref: treference);
 
274
 
 
275
       const
 
276
         FpuStoreInstr: Array[OS_F32..OS_F64,boolean, boolean] of TAsmOp =
 
277
                            { indexed? updating?}
 
278
                    (((A_STFS,A_STFSU),(A_STFSX,A_STFSUX)),
 
279
                     ((A_STFD,A_STFDU),(A_STFDX,A_STFDUX)));
 
280
       var
 
281
         op: tasmop;
 
282
         ref2: treference;
 
283
{$ifndef cpu64bit}
 
284
         reg2: tregister;
 
285
{$endif cpu64bit}
 
286
 
 
287
       begin
 
288
         if not(fromsize in [OS_F32,OS_F64]) or
 
289
            not(tosize in [OS_F32,OS_F64]) then
 
290
           internalerror(200201122);
 
291
         ref2 := ref;
 
292
         fixref(list,ref2);
 
293
         op := fpustoreinstr[tosize,ref2.index <> NR_NO,false];
 
294
{$ifndef cpu64bit}
 
295
         { some ppc's have a bug whereby storing a double to memory }
 
296
         { as single corrupts the value -> convert double to single }
 
297
         { first                                                    }
 
298
         if (tosize < fromsize) then
 
299
           begin
 
300
             reg2:=getfpuregister(list,tosize);
 
301
             a_loadfpu_reg_reg(list,fromsize,tosize,reg,reg2);
 
302
             reg:=reg2;
 
303
           end;
 
304
{$endif not cpu64bit}
 
305
         a_load_store(list,op,reg,ref2);
 
306
       end;
 
307
 
 
308
 
 
309
  procedure tcgppcgen.a_load_subsetref_regs_noindex(list: TAsmList; subsetsize: tcgsize; loadbitsize: byte; const sref: tsubsetreference; valuereg, extra_value_reg: tregister);
 
310
    var
 
311
      fromsreg, tosreg: tsubsetregister;
 
312
      restbits: byte;
 
313
    begin
 
314
      restbits := (sref.bitlen - (loadbitsize - sref.startbit));
 
315
      if (subsetsize in [OS_S8..OS_S128]) then
 
316
        begin
 
317
         { sign extend }
 
318
         a_op_const_reg(list,OP_SHL,OS_INT,AIntBits-loadbitsize+sref.startbit,valuereg);
 
319
         a_op_const_reg(list,OP_SAR,OS_INT,AIntBits-sref.bitlen,valuereg);
 
320
        end
 
321
      else
 
322
        begin
 
323
          a_op_const_reg(list,OP_SHL,OS_INT,restbits,valuereg);
 
324
          { mask other bits }
 
325
          if (sref.bitlen <> AIntBits) then
 
326
            a_op_const_reg(list,OP_AND,OS_INT,(aword(1) shl sref.bitlen)-1,valuereg);
 
327
        end;
 
328
      { use subsetreg routine, it may have been overridden with an optimized version }
 
329
      fromsreg.subsetreg := extra_value_reg;
 
330
      fromsreg.subsetregsize := OS_INT;
 
331
      { subsetregs always count bits from right to left }
 
332
      fromsreg.startbit := loadbitsize-restbits;
 
333
      fromsreg.bitlen := restbits;
 
334
  
 
335
      tosreg.subsetreg := valuereg;
 
336
      tosreg.subsetregsize := OS_INT;
 
337
      tosreg.startbit := 0;
 
338
      tosreg.bitlen := restbits;
 
339
  
 
340
      a_load_subsetreg_subsetreg(list,subsetsize,subsetsize,fromsreg,tosreg);
 
341
    end;
 
342
 
 
343
 
 
344
  procedure tcgppcgen.g_overflowcheck(list: TAsmList; const l: tlocation; def: tdef);
 
345
    var
 
346
      hl : tasmlabel;
 
347
      flags : TResFlags;
 
348
    begin
 
349
      if not(cs_check_overflow in current_settings.localswitches) then
 
350
        exit;
 
351
      current_asmdata.getjumplabel(hl);
 
352
      if not ((def.typ=pointerdef) or
 
353
             ((def.typ=orddef) and
 
354
              (torddef(def).ordtype in [u64bit,u16bit,u32bit,u8bit,uchar,
 
355
                                        bool8bit,bool16bit,bool32bit,bool64bit]))) then
 
356
        begin
 
357
          if (current_settings.optimizecputype >= cpu_ppc970) or
 
358
             (current_settings.cputype >= cpu_ppc970) then
 
359
            begin
 
360
              { ... instructions setting overflow flag ...
 
361
              mfxerf R0
 
362
              mtcrf 128, R0
 
363
              ble cr0, label }
 
364
              list.concat(taicpu.op_reg(A_MFXER, NR_R0));
 
365
              list.concat(taicpu.op_const_reg(A_MTCRF, 128, NR_R0));
 
366
              flags.cr := RS_CR0;
 
367
              flags.flag := F_LE;
 
368
              a_jmp_flags(list, flags, hl);
 
369
            end
 
370
          else
 
371
            begin
 
372
              list.concat(taicpu.op_reg(A_MCRXR,NR_CR7));
 
373
              a_jmp(list,A_BC,C_NO,7,hl)
 
374
            end;
 
375
        end
 
376
      else
 
377
        a_jmp_cond(list,OC_AE,hl);
 
378
      a_call_name(list,'FPC_OVERFLOW');
 
379
      a_label(list,hl);
 
380
    end;
 
381
 
 
382
 
 
383
  procedure tcgppcgen.g_profilecode(list: TAsmList);
 
384
    var
 
385
      paraloc1 : tcgpara;
 
386
      reg: tregister;
 
387
    begin
 
388
      if (target_info.system in [system_powerpc_darwin]) then
 
389
        begin
 
390
          paraloc1.init;
 
391
          paramanager.getintparaloc(pocall_cdecl,1,paraloc1);
 
392
          a_param_reg(list,OS_ADDR,NR_R0,paraloc1);
 
393
          paramanager.freeparaloc(list,paraloc1);
 
394
          paraloc1.done;
 
395
          allocallcpuregisters(list);
 
396
          a_call_name(list,'mcount');
 
397
          deallocallcpuregisters(list);
 
398
          a_reg_dealloc(list,NR_R0);
 
399
        end;
 
400
    end;
 
401
 
 
402
 
 
403
  procedure tcgppcgen.a_jmp_cond(list : TAsmList;cond : TOpCmp; l: tasmlabel);
 
404
    begin
 
405
      a_jmp(list,A_BC,TOpCmp2AsmCond[cond],0,l);
 
406
    end;
 
407
 
 
408
 
 
409
 procedure tcgppcgen.a_jmp(list: TAsmList; op: tasmop; c: tasmcondflag;
 
410
             crval: longint; l: tasmlabel);
 
411
   var
 
412
     p: taicpu;
 
413
 
 
414
   begin
 
415
     p := taicpu.op_sym(op,l);
 
416
     if op <> A_B then
 
417
       create_cond_norm(c,crval,p.condition);
 
418
     p.is_jmp := true;
 
419
     list.concat(p)
 
420
   end;
 
421
 
 
422
 
 
423
 
 
424
 
 
425
end.
 
426