← Back to branch summary

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

« back to all changes in this revision

Viewing changes to compiler/arm/cgcpu.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:
compiler/arm/cgcpu.pas
1
 
{
2
 
    $Id: cgcpu.pas,v 1.51 2004/03/31 19:13:04 florian Exp $
3
 
 
4
 
    Copyright (c) 2003 by Florian Klaempfl
5
 
    Member of the Free Pascal development team
6
 
 
7
 
    This unit implements the code generator for the ARM
8
 
 
9
 
    This program is free software; you can redistribute it and/or modify
10
 
    it under the terms of the GNU General Public License as published by
11
 
    the Free Software Foundation; either version 2 of the License, or
12
 
    (at your option) any later version.
13
 
 
14
 
    This program is distributed in the hope that it will be useful,
15
 
    but WITHOUT ANY WARRANTY; without even the implied warranty of
16
 
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
17
 
    GNU General Public License for more details.
18
 
 
19
 
    You should have received a copy of the GNU General Public License
20
 
    along with this program; if not, write to the Free Software
21
 
    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
22
 
 
23
 
 ****************************************************************************
24
 
}
25
 
unit cgcpu;
26
 
 
27
 
{$i fpcdefs.inc}
28
 
 
29
 
  interface
30
 
 
31
 
    uses
32
 
       symtype,
33
 
       cgbase,cgobj,
34
 
       aasmbase,aasmcpu,aasmtai,
35
 
       cpubase,cpuinfo,node,cg64f32,rgcpu;
36
 
 
37
 
 
38
 
    type
39
 
      tcgarm = class(tcg)
40
 
        { true, if the next arithmetic operation should modify the flags }
41
 
        setflags : boolean;
42
 
        procedure init_register_allocators;override;
43
 
        procedure done_register_allocators;override;
44
 
 
45
 
        procedure a_param_const(list : taasmoutput;size : tcgsize;a : aword;const locpara : tparalocation);override;
46
 
        procedure a_param_ref(list : taasmoutput;size : tcgsize;const r : treference;const locpara : tparalocation);override;
47
 
        procedure a_paramaddr_ref(list : taasmoutput;const r : treference;const locpara : tparalocation);override;
48
 
 
49
 
        procedure a_call_name(list : taasmoutput;const s : string);override;
50
 
        procedure a_call_reg(list : taasmoutput;reg: tregister); override;
51
 
 
52
 
        procedure a_op_const_reg(list : taasmoutput; Op: TOpCG; size: TCGSize; a: AWord; reg: TRegister); override;
53
 
        procedure a_op_reg_reg(list : taasmoutput; Op: TOpCG; size: TCGSize; src, dst: TRegister); override;
54
 
 
55
 
        procedure a_op_const_reg_reg(list: taasmoutput; op: TOpCg;
56
 
          size: tcgsize; a: aword; src, dst: tregister); override;
57
 
        procedure a_op_reg_reg_reg(list: taasmoutput; op: TOpCg;
58
 
          size: tcgsize; src1, src2, dst: tregister); override;
59
 
 
60
 
        { move instructions }
61
 
        procedure a_load_const_reg(list : taasmoutput; size: tcgsize; a : aword;reg : tregister);override;
62
 
        procedure a_load_reg_ref(list : taasmoutput; fromsize, tosize: tcgsize; reg : tregister;const ref : treference);override;
63
 
        procedure a_load_ref_reg(list : taasmoutput; fromsize, tosize : tcgsize;const Ref : treference;reg : tregister);override;
64
 
        procedure a_load_reg_reg(list : taasmoutput; fromsize, tosize : tcgsize;reg1,reg2 : tregister);override;
65
 
 
66
 
        { fpu move instructions }
67
 
        procedure a_loadfpu_reg_reg(list: taasmoutput; size: tcgsize; reg1, reg2: tregister); override;
68
 
        procedure a_loadfpu_ref_reg(list: taasmoutput; size: tcgsize; const ref: treference; reg: tregister); override;
69
 
        procedure a_loadfpu_reg_ref(list: taasmoutput; size: tcgsize; reg: tregister; const ref: treference); override;
70
 
 
71
 
        {  comparison operations }
72
 
        procedure a_cmp_const_reg_label(list : taasmoutput;size : tcgsize;cmp_op : topcmp;a : aword;reg : tregister;
73
 
          l : tasmlabel);override;
74
 
        procedure a_cmp_reg_reg_label(list : taasmoutput;size : tcgsize;cmp_op : topcmp;reg1,reg2 : tregister;l : tasmlabel); override;
75
 
 
76
 
        procedure a_jmp_name(list : taasmoutput;const s : string); override;
77
 
        procedure a_jmp_always(list : taasmoutput;l: tasmlabel); override;
78
 
        procedure a_jmp_flags(list : taasmoutput;const f : TResFlags;l: tasmlabel); override;
79
 
 
80
 
        procedure g_flags2reg(list: taasmoutput; size: TCgSize; const f: TResFlags; reg: TRegister); override;
81
 
 
82
 
        procedure g_copyvaluepara_openarray(list : taasmoutput;const ref, lenref:treference;elesize:aword);override;
83
 
        procedure g_stackframe_entry(list : taasmoutput;localsize : longint);override;
84
 
        procedure g_return_from_proc(list : taasmoutput;parasize : aword); override;
85
 
        procedure g_restore_frame_pointer(list : taasmoutput);override;
86
 
 
87
 
        procedure a_loadaddr_ref_reg(list : taasmoutput;const ref : treference;r : tregister);override;
88
 
 
89
 
        procedure g_concatcopy(list : taasmoutput;const source,dest : treference;len : aword; delsource,loadref : boolean);override;
90
 
 
91
 
        procedure g_overflowcheck(list: taasmoutput; const l: tlocation; def: tdef); override;
92
 
 
93
 
        procedure g_save_standard_registers(list : taasmoutput);override;
94
 
        procedure g_restore_standard_registers(list : taasmoutput);override;
95
 
        procedure g_save_all_registers(list : taasmoutput);override;
96
 
        procedure g_restore_all_registers(list : taasmoutput;const funcretparaloc:tparalocation);override;
97
 
 
98
 
        procedure a_jmp_cond(list : taasmoutput;cond : TOpCmp;l: tasmlabel);
99
 
        procedure fixref(list : taasmoutput;var ref : treference);
100
 
        procedure handle_load_store(list:taasmoutput;op: tasmop;oppostfix : toppostfix;reg:tregister;ref: treference);
101
 
      end;
102
 
 
103
 
      tcg64farm = class(tcg64f32)
104
 
        procedure a_op64_reg_reg(list : taasmoutput;op:TOpCG;regsrc,regdst : tregister64);override;
105
 
        procedure a_op64_const_reg(list : taasmoutput;op:TOpCG;value : qword;reg : tregister64);override;
106
 
        procedure a_op64_const_reg_reg(list: taasmoutput;op:TOpCG;value : qword;regsrc,regdst : tregister64);override;
107
 
        procedure a_op64_reg_reg_reg(list: taasmoutput;op:TOpCG;regsrc1,regsrc2,regdst : tregister64);override;
108
 
      end;
109
 
 
110
 
    const
111
 
      OpCmp2AsmCond : Array[topcmp] of TAsmCond = (C_NONE,C_EQ,C_GT,
112
 
                           C_LT,C_GE,C_LE,C_NE,C_LS,C_CC,C_CS,C_HI);
113
 
 
114
 
    function is_shifter_const(d : dword;var imm_shift : byte) : boolean;
115
 
 
116
 
    function get_fpu_postfix(def : tdef) : toppostfix;
117
 
 
118
 
  implementation
119
 
 
120
 
 
121
 
    uses
122
 
       globtype,globals,verbose,systems,cutils,
123
 
       symconst,symdef,symsym,
124
 
       tgobj,
125
 
       procinfo,cpupi,
126
 
       cgutils,
127
 
       paramgr;
128
 
 
129
 
 
130
 
    function get_fpu_postfix(def : tdef) : toppostfix;
131
 
      begin
132
 
        if def.deftype=floatdef then
133
 
          begin
134
 
            case tfloatdef(def).typ of
135
 
              s32real:
136
 
                result:=PF_S;
137
 
              s64real:
138
 
                result:=PF_D;
139
 
              s80real:
140
 
                result:=PF_E;
141
 
              else
142
 
                internalerror(200401272);
143
 
            end;
144
 
          end
145
 
        else
146
 
          internalerror(200401271);
147
 
      end;
148
 
 
149
 
 
150
 
    procedure tcgarm.init_register_allocators;
151
 
      begin
152
 
        inherited init_register_allocators;
153
 
        { currently, we save R14 always, so we can use it }
154
 
        rg[R_INTREGISTER]:=trgcpu.create(R_INTREGISTER,R_SUBWHOLE,
155
 
            [RS_R0,RS_R1,RS_R2,RS_R3,RS_R4,RS_R5,RS_R6,RS_R7,RS_R8,
156
 
             RS_R9,RS_R10,RS_R12,RS_R14],first_int_imreg,[]);
157
 
        rg[R_FPUREGISTER]:=trgcpu.create(R_FPUREGISTER,R_SUBNONE,
158
 
            [RS_F0,RS_F1,RS_F2,RS_F3,RS_F4,RS_F5,RS_F6,RS_F7],first_fpu_imreg,[]);
159
 
        rg[R_MMREGISTER]:=trgcpu.create(R_MMREGISTER,R_SUBNONE,
160
 
            [RS_S0,RS_S1,RS_R2,RS_R3,RS_R4,RS_S31],first_mm_imreg,[]);
161
 
      end;
162
 
 
163
 
 
164
 
    procedure tcgarm.done_register_allocators;
165
 
      begin
166
 
        rg[R_INTREGISTER].free;
167
 
        rg[R_FPUREGISTER].free;
168
 
        rg[R_MMREGISTER].free;
169
 
        inherited done_register_allocators;
170
 
      end;
171
 
 
172
 
 
173
 
    procedure tcgarm.a_param_const(list : taasmoutput;size : tcgsize;a : aword;const locpara : tparalocation);
174
 
      var
175
 
        ref: treference;
176
 
      begin
177
 
        case locpara.loc of
178
 
          LOC_REGISTER,LOC_CREGISTER:
179
 
            a_load_const_reg(list,size,a,locpara.register);
180
 
          LOC_REFERENCE:
181
 
            begin
182
 
               reference_reset(ref);
183
 
               ref.base:=locpara.reference.index;
184
 
               ref.offset:=locpara.reference.offset;
185
 
               a_load_const_ref(list,size,a,ref);
186
 
            end;
187
 
          else
188
 
            internalerror(2002081101);
189
 
        end;
190
 
        if locpara.alignment<>0 then
191
 
          internalerror(2002081102);
192
 
      end;
193
 
 
194
 
 
195
 
    procedure tcgarm.a_param_ref(list : taasmoutput;size : tcgsize;const r : treference;const locpara : tparalocation);
196
 
      var
197
 
        ref: treference;
198
 
        tmpreg: tregister;
199
 
      begin
200
 
        case locpara.loc of
201
 
          LOC_REGISTER,LOC_CREGISTER:
202
 
            a_load_ref_reg(list,size,size,r,locpara.register);
203
 
          LOC_REFERENCE:
204
 
            begin
205
 
               reference_reset(ref);
206
 
               ref.base:=locpara.reference.index;
207
 
               ref.offset:=locpara.reference.offset;
208
 
               tmpreg := getintregister(list,size);
209
 
               a_load_ref_reg(list,size,size,r,tmpreg);
210
 
               a_load_reg_ref(list,size,size,tmpreg,ref);
211
 
               ungetregister(list,tmpreg);
212
 
            end;
213
 
          LOC_FPUREGISTER,LOC_CFPUREGISTER:
214
 
            case size of
215
 
               OS_F32, OS_F64:
216
 
                 a_loadfpu_ref_reg(list,size,r,locpara.register);
217
 
               else
218
 
                 internalerror(2002072801);
219
 
            end;
220
 
          else
221
 
            internalerror(2002081103);
222
 
        end;
223
 
        if locpara.alignment<>0 then
224
 
          internalerror(2002081104);
225
 
      end;
226
 
 
227
 
 
228
 
    procedure tcgarm.a_paramaddr_ref(list : taasmoutput;const r : treference;const locpara : tparalocation);
229
 
      var
230
 
        ref: treference;
231
 
        tmpreg: tregister;
232
 
      begin
233
 
         case locpara.loc of
234
 
            LOC_REGISTER,LOC_CREGISTER:
235
 
              a_loadaddr_ref_reg(list,r,locpara.register);
236
 
            LOC_REFERENCE:
237
 
              begin
238
 
                reference_reset(ref);
239
 
                ref.base := locpara.reference.index;
240
 
                ref.offset := locpara.reference.offset;
241
 
                tmpreg := getintregister(list,OS_ADDR);
242
 
                a_loadaddr_ref_reg(list,r,tmpreg);
243
 
                a_load_reg_ref(list,OS_ADDR,OS_ADDR,tmpreg,ref);
244
 
                ungetregister(list,tmpreg);
245
 
              end;
246
 
            else
247
 
              internalerror(2002080701);
248
 
         end;
249
 
      end;
250
 
 
251
 
 
252
 
    procedure tcgarm.a_call_name(list : taasmoutput;const s : string);
253
 
      begin
254
 
         list.concat(taicpu.op_sym(A_BL,objectlibrary.newasmsymbol(s,AB_EXTERNAL,AT_FUNCTION)));
255
 
         if not(pi_do_call in current_procinfo.flags) then
256
 
           internalerror(2003060703);
257
 
      end;
258
 
 
259
 
 
260
 
    procedure tcgarm.a_call_reg(list : taasmoutput;reg: tregister);
261
 
      var
262
 
         r : tregister;
263
 
      begin
264
 
        list.concat(taicpu.op_reg_reg(A_MOV,NR_R14,NR_PC));
265
 
        list.concat(taicpu.op_reg_reg(A_MOV,NR_PC,reg));
266
 
        if not(pi_do_call in current_procinfo.flags) then
267
 
          internalerror(2003060704);
268
 
      end;
269
 
 
270
 
 
271
 
     procedure tcgarm.a_op_const_reg(list : taasmoutput; Op: TOpCG; size: TCGSize; a: AWord; reg: TRegister);
272
 
       begin
273
 
          a_op_const_reg_reg(list,op,size,a,reg,reg);
274
 
       end;
275
 
 
276
 
 
277
 
     procedure tcgarm.a_op_reg_reg(list : taasmoutput; Op: TOpCG; size: TCGSize; src, dst: TRegister);
278
 
       begin
279
 
         case op of
280
 
           OP_NEG:
281
 
             list.concat(taicpu.op_reg_reg_const(A_RSB,dst,src,0));
282
 
           OP_NOT:
283
 
             list.concat(taicpu.op_reg_reg(A_MVN,dst,src));
284
 
           else
285
 
             a_op_reg_reg_reg(list,op,OS_32,src,dst,dst);
286
 
         end;
287
 
       end;
288
 
 
289
 
 
290
 
     const
291
 
       op_reg_reg_opcg2asmop: array[TOpCG] of tasmop =
292
 
         (A_NONE,A_ADD,A_AND,A_NONE,A_NONE,A_MUL,A_MUL,A_NONE,A_NONE,A_ORR,
293
 
          A_NONE,A_NONE,A_NONE,A_SUB,A_EOR);
294
 
 
295
 
 
296
 
     procedure tcgarm.a_op_const_reg_reg(list: taasmoutput; op: TOpCg;
297
 
       size: tcgsize; a: aword; src, dst: tregister);
298
 
       var
299
 
         shift : byte;
300
 
         tmpreg : tregister;
301
 
         so : tshifterop;
302
 
         l1 : longint;
303
 
       begin
304
 
          if is_shifter_const(dword(-a),shift) then
305
 
            case op of
306
 
              OP_ADD:
307
 
                begin
308
 
                  op:=OP_SUB;
309
 
                  a:=dword(-a);
310
 
                end;
311
 
              OP_SUB:
312
 
                begin
313
 
                  op:=OP_SUB;
314
 
                  a:=dword(-a);
315
 
                end
316
 
            end;
317
 
 
318
 
          if is_shifter_const(a,shift) and not(op in [OP_IMUL,OP_MUL]) then
319
 
            case op of
320
 
              OP_NEG,OP_NOT,
321
 
              OP_DIV,OP_IDIV:
322
 
                internalerror(200308281);
323
 
              OP_SHL:
324
 
                begin
325
 
                  if a>32 then
326
 
                    internalerror(200308291);
327
 
                  if a<>0 then
328
 
                    begin
329
 
                      shifterop_reset(so);
330
 
                      so.shiftmode:=SM_LSL;
331
 
                      so.shiftimm:=a;
332
 
                      list.concat(taicpu.op_reg_reg_shifterop(A_MOV,dst,src,so));
333
 
                    end
334
 
                  else
335
 
                   list.concat(taicpu.op_reg_reg(A_MOV,dst,src));
336
 
                end;
337
 
              OP_SHR:
338
 
                begin
339
 
                  if a>32 then
340
 
                    internalerror(200308292);
341
 
                  shifterop_reset(so);
342
 
                  if a<>0 then
343
 
                    begin
344
 
                      so.shiftmode:=SM_LSR;
345
 
                      so.shiftimm:=a;
346
 
                      list.concat(taicpu.op_reg_reg_shifterop(A_MOV,dst,src,so));
347
 
                    end
348
 
                  else
349
 
                   list.concat(taicpu.op_reg_reg(A_MOV,dst,src));
350
 
                end;
351
 
              OP_SAR:
352
 
                begin
353
 
                  if a>32 then
354
 
                    internalerror(200308291);
355
 
                  if a<>0 then
356
 
                    begin
357
 
                      shifterop_reset(so);
358
 
                      so.shiftmode:=SM_ASR;
359
 
                      so.shiftimm:=a;
360
 
                      list.concat(taicpu.op_reg_reg_shifterop(A_MOV,dst,src,so));
361
 
                    end
362
 
                  else
363
 
                   list.concat(taicpu.op_reg_reg(A_MOV,dst,src));
364
 
                end;
365
 
              else
366
 
                list.concat(taicpu.op_reg_reg_const(op_reg_reg_opcg2asmop[op],dst,src,a));
367
 
            end
368
 
          else
369
 
            begin
370
 
              { there could be added some more sophisticated optimizations }
371
 
              if (op in [OP_MUL,OP_IMUL]) and (a=1) then
372
 
                a_load_reg_reg(list,size,size,src,dst)
373
 
              else if (op in [OP_MUL,OP_IMUL]) and (a=0) then
374
 
                a_load_const_reg(list,size,0,dst)
375
 
              else if (op in [OP_IMUL]) and (a=-1) then
376
 
                a_op_reg_reg(list,OP_NEG,size,src,dst)
377
 
              { we do this here instead in the peephole optimizer because
378
 
                it saves us a register }
379
 
              else if (op in [OP_MUL,OP_IMUL]) and ispowerof2(a,l1) then
380
 
                a_op_const_reg_reg(list,OP_SHL,size,l1,src,dst)
381
 
              else
382
 
                begin
383
 
                  tmpreg:=getintregister(list,size);
384
 
                  a_load_const_reg(list,size,a,tmpreg);
385
 
                  a_op_reg_reg_reg(list,op,size,tmpreg,src,dst);
386
 
                  ungetregister(list,tmpreg);
387
 
                end;
388
 
            end;
389
 
       end;
390
 
 
391
 
 
392
 
     procedure tcgarm.a_op_reg_reg_reg(list: taasmoutput; op: TOpCg;
393
 
       size: tcgsize; src1, src2, dst: tregister);
394
 
       var
395
 
         so : tshifterop;
396
 
         tmpreg : tregister;
397
 
       begin
398
 
         case op of
399
 
           OP_NEG,OP_NOT,
400
 
           OP_DIV,OP_IDIV:
401
 
             internalerror(200308281);
402
 
           OP_SHL:
403
 
             begin
404
 
               shifterop_reset(so);
405
 
               so.rs:=src1;
406
 
               so.shiftmode:=SM_LSL;
407
 
               list.concat(taicpu.op_reg_reg_shifterop(A_MOV,dst,src2,so));
408
 
             end;
409
 
           OP_SHR:
410
 
             begin
411
 
               shifterop_reset(so);
412
 
               so.rs:=src1;
413
 
               so.shiftmode:=SM_LSR;
414
 
               list.concat(taicpu.op_reg_reg_shifterop(A_MOV,dst,src2,so));
415
 
             end;
416
 
           OP_SAR:
417
 
             begin
418
 
               shifterop_reset(so);
419
 
               so.rs:=src1;
420
 
               so.shiftmode:=SM_ASR;
421
 
               list.concat(taicpu.op_reg_reg_shifterop(A_MOV,dst,src2,so));
422
 
             end;
423
 
           OP_IMUL,
424
 
           OP_MUL:
425
 
             begin
426
 
               { the arm doesn't allow that rd and rm are the same }
427
 
               if dst=src2 then
428
 
                 begin
429
 
                   if dst<>src1 then
430
 
                     list.concat(taicpu.op_reg_reg_reg(A_MUL,dst,src1,src2))
431
 
                   else
432
 
                     begin
433
 
                       tmpreg:=getintregister(list,size);
434
 
                       a_load_reg_reg(list,size,size,src2,dst);
435
 
                       ungetregister(list,tmpreg);
436
 
                       list.concat(taicpu.op_reg_reg_reg(A_MUL,dst,tmpreg,src1));
437
 
                     end;
438
 
                 end
439
 
               else
440
 
                 list.concat(taicpu.op_reg_reg_reg(A_MUL,dst,src2,src1));
441
 
             end;
442
 
           else
443
 
             list.concat(setoppostfix(taicpu.op_reg_reg_reg(op_reg_reg_opcg2asmop[op],dst,src2,src1),toppostfix(ord(setflags)*ord(PF_S))));
444
 
         end;
445
 
       end;
446
 
 
447
 
 
448
 
     function rotl(d : dword;b : byte) : dword;
449
 
       begin
450
 
          result:=(d shr (32-b)) or (d shl b);
451
 
       end;
452
 
 
453
 
 
454
 
     function is_shifter_const(d : dword;var imm_shift : byte) : boolean;
455
 
       var
456
 
          i : longint;
457
 
       begin
458
 
          for i:=0 to 15 do
459
 
            begin
460
 
               if (d and not(rotl($ff,i*2)))=0 then
461
 
                 begin
462
 
                    imm_shift:=i*2;
463
 
                    result:=true;
464
 
                    exit;
465
 
                 end;
466
 
            end;
467
 
          result:=false;
468
 
       end;
469
 
 
470
 
 
471
 
     procedure tcgarm.a_load_const_reg(list : taasmoutput; size: tcgsize; a : aword;reg : tregister);
472
 
       var
473
 
          imm_shift : byte;
474
 
          l : tasmlabel;
475
 
          hr : treference;
476
 
       begin
477
 
          if not(size in [OS_8,OS_S8,OS_16,OS_S16,OS_32,OS_S32]) then
478
 
            internalerror(2002090902);
479
 
          if is_shifter_const(dword(a),imm_shift) then
480
 
            list.concat(taicpu.op_reg_const(A_MOV,reg,a))
481
 
          else if is_shifter_const(dword(not(a)),imm_shift) then
482
 
            list.concat(taicpu.op_reg_const(A_MVN,reg,not(a)))
483
 
          else
484
 
            begin
485
 
               reference_reset(hr);
486
 
 
487
 
               objectlibrary.getlabel(l);
488
 
               cg.a_label(current_procinfo.aktlocaldata,l);
489
 
               hr.symboldata:=current_procinfo.aktlocaldata.last;
490
 
               current_procinfo.aktlocaldata.concat(tai_const.Create_32bit(longint(a)));
491
 
 
492
 
               hr.symbol:=l;
493
 
               list.concat(taicpu.op_reg_ref(A_LDR,reg,hr));
494
 
            end;
495
 
       end;
496
 
 
497
 
 
498
 
    procedure tcgarm.handle_load_store(list:taasmoutput;op: tasmop;oppostfix : toppostfix;reg:tregister;ref: treference);
499
 
      var
500
 
        tmpreg : tregister;
501
 
        tmpref : treference;
502
 
        l : tasmlabel;
503
 
      begin
504
 
        tmpreg:=NR_NO;
505
 
 
506
 
        { Be sure to have a base register }
507
 
        if (ref.base=NR_NO) then
508
 
          begin
509
 
            if ref.shiftmode<>SM_None then
510
 
              internalerror(200308294);
511
 
            ref.base:=ref.index;
512
 
            ref.index:=NR_NO;
513
 
          end;
514
 
 
515
 
        { absolute symbols can't be handled directly, we've to store the symbol reference
516
 
          in the text segment and access it pc relative
517
 
 
518
 
          For now, we assume that references where base or index equals to PC are already
519
 
          relative, all other references are assumed to be absolute and thus they need
520
 
          to be handled extra.
521
 
 
522
 
          A proper solution would be to change refoptions to a set and store the information
523
 
          if the symbol is absolute or relative there.
524
 
        }
525
 
 
526
 
        if (assigned(ref.symbol) and
527
 
            not(is_pc(ref.base)) and
528
 
            not(is_pc(ref.index))
529
 
           ) or
530
 
           (ref.offset<-4095) or
531
 
           (ref.offset>4095) or
532
 
           ((oppostfix in [PF_SB,PF_H,PF_SH]) and
533
 
            ((ref.offset<-255) or
534
 
             (ref.offset>255)
535
 
            )
536
 
           ) or
537
 
           ((op in [A_LDF,A_STF]) and
538
 
            ((ref.offset<-1020) or
539
 
             (ref.offset>1020)
540
 
            )
541
 
           ) then
542
 
          begin
543
 
            reference_reset(tmpref);
544
 
            { create consts entry }
545
 
            objectlibrary.getlabel(l);
546
 
            cg.a_label(current_procinfo.aktlocaldata,l);
547
 
            tmpref.symboldata:=current_procinfo.aktlocaldata.last;
548
 
 
549
 
            if assigned(ref.symbol) then
550
 
              current_procinfo.aktlocaldata.concat(tai_const_symbol.Create_offset(ref.symbol,ref.offset))
551
 
            else
552
 
              current_procinfo.aktlocaldata.concat(tai_const.Create_32bit(ref.offset));
553
 
 
554
 
            { load consts entry }
555
 
            tmpreg:=getintregister(list,OS_INT);
556
 
            tmpref.symbol:=l;
557
 
            tmpref.base:=NR_R15;
558
 
            list.concat(taicpu.op_reg_ref(A_LDR,tmpreg,tmpref));
559
 
 
560
 
            if (ref.base<>NR_NO) then
561
 
              begin
562
 
                if ref.index<>NR_NO then
563
 
                  begin
564
 
                    list.concat(taicpu.op_reg_reg_reg(A_ADD,tmpreg,ref.base,tmpreg));
565
 
                    ref.base:=tmpreg;
566
 
                  end
567
 
                else
568
 
                  begin
569
 
                    ref.index:=tmpreg;
570
 
                    ref.shiftimm:=0;
571
 
                    ref.signindex:=1;
572
 
                    ref.shiftmode:=SM_None;
573
 
                  end;
574
 
              end
575
 
            else
576
 
              ref.base:=tmpreg;
577
 
            ref.offset:=0;
578
 
            ref.symbol:=nil;
579
 
          end;
580
 
 
581
 
        if (ref.base<>NR_NO) and (ref.index<>NR_NO) and (ref.offset<>0) then
582
 
          begin
583
 
            if tmpreg<>NR_NO then
584
 
              a_op_const_reg_reg(list,OP_ADD,OS_ADDR,ref.offset,tmpreg,tmpreg)
585
 
            else
586
 
              begin
587
 
                tmpreg:=getintregister(list,OS_ADDR);
588
 
                a_op_const_reg_reg(list,OP_ADD,OS_ADDR,ref.offset,ref.base,tmpreg);
589
 
                ref.base:=tmpreg;
590
 
              end;
591
 
            ref.offset:=0;
592
 
          end;
593
 
 
594
 
        { floating point operations have only limited references
595
 
          we expect here, that a base is already set }
596
 
        if (op in [A_LDF,A_STF]) and (ref.index<>NR_NO) then
597
 
          begin
598
 
            if ref.shiftmode<>SM_none then
599
 
              internalerror(200309121);
600
 
            if tmpreg<>NR_NO then
601
 
              begin
602
 
                if ref.base=tmpreg then
603
 
                  begin
604
 
                    if ref.signindex<0 then
605
 
                      list.concat(taicpu.op_reg_reg_reg(A_SUB,tmpreg,tmpreg,ref.index))
606
 
                    else
607
 
                      list.concat(taicpu.op_reg_reg_reg(A_ADD,tmpreg,tmpreg,ref.index));
608
 
                    ref.index:=NR_NO;
609
 
                  end
610
 
                else
611
 
                  begin
612
 
                    if ref.index<>tmpreg then
613
 
                      internalerror(200403161);
614
 
                    if ref.signindex<0 then
615
 
                      list.concat(taicpu.op_reg_reg_reg(A_SUB,tmpreg,ref.base,tmpreg))
616
 
                    else
617
 
                      list.concat(taicpu.op_reg_reg_reg(A_ADD,tmpreg,ref.base,tmpreg));
618
 
                    ref.base:=tmpreg;
619
 
                    ref.index:=NR_NO;
620
 
                  end;
621
 
              end
622
 
            else
623
 
              begin
624
 
                tmpreg:=getintregister(list,OS_ADDR);
625
 
                list.concat(taicpu.op_reg_reg_reg(A_ADD,tmpreg,ref.base,ref.index));
626
 
                ref.base:=tmpreg;
627
 
                ref.index:=NR_NO;
628
 
              end;
629
 
          end;
630
 
        list.concat(setoppostfix(taicpu.op_reg_ref(op,reg,ref),oppostfix));
631
 
        if (tmpreg<>NR_NO) then
632
 
          ungetregister(list,tmpreg);
633
 
      end;
634
 
 
635
 
 
636
 
     procedure tcgarm.a_load_reg_ref(list : taasmoutput; fromsize, tosize: tcgsize; reg : tregister;const ref : treference);
637
 
       var
638
 
         oppostfix:toppostfix;
639
 
       begin
640
 
         case ToSize of
641
 
           { signed integer registers }
642
 
           OS_8,
643
 
           OS_S8:
644
 
             oppostfix:=PF_B;
645
 
           OS_16,
646
 
           OS_S16:
647
 
             oppostfix:=PF_H;
648
 
           OS_32,
649
 
           OS_S32:
650
 
             oppostfix:=PF_None;
651
 
           else
652
 
             InternalError(200308295);
653
 
         end;
654
 
         handle_load_store(list,A_STR,oppostfix,reg,ref);
655
 
       end;
656
 
 
657
 
 
658
 
     procedure tcgarm.a_load_ref_reg(list : taasmoutput; fromsize, tosize : tcgsize;const Ref : treference;reg : tregister);
659
 
       var
660
 
         oppostfix:toppostfix;
661
 
       begin
662
 
         case FromSize of
663
 
           { signed integer registers }
664
 
           OS_8:
665
 
             oppostfix:=PF_B;
666
 
           OS_S8:
667
 
             oppostfix:=PF_SB;
668
 
           OS_16:
669
 
             oppostfix:=PF_H;
670
 
           OS_S16:
671
 
             oppostfix:=PF_SH;
672
 
           OS_32,
673
 
           OS_S32:
674
 
             oppostfix:=PF_None;
675
 
           else
676
 
             InternalError(200308291);
677
 
         end;
678
 
         handle_load_store(list,A_LDR,oppostfix,reg,ref);
679
 
       end;
680
 
 
681
 
 
682
 
     procedure tcgarm.a_load_reg_reg(list : taasmoutput; fromsize, tosize : tcgsize;reg1,reg2 : tregister);
683
 
       var
684
 
         instr: taicpu;
685
 
         so : tshifterop;
686
 
       begin
687
 
         shifterop_reset(so);
688
 
         if (reg1<>reg2) or
689
 
            (tcgsize2size[tosize] < tcgsize2size[fromsize]) or
690
 
            ((tcgsize2size[tosize] = tcgsize2size[fromsize]) and
691
 
             (tosize <> fromsize) and
692
 
             not(fromsize in [OS_32,OS_S32])) then
693
 
           begin
694
 
             case tosize of
695
 
               OS_8:
696
 
                 list.concat(taicpu.op_reg_reg_const(A_AND,
697
 
                   reg2,reg1,$ff));
698
 
               OS_S8:
699
 
                 begin
700
 
                   so.shiftmode:=SM_LSL;
701
 
                   so.shiftimm:=24;
702
 
                   list.concat(taicpu.op_reg_reg_shifterop(A_MOV,reg2,reg1,so));
703
 
                   so.shiftmode:=SM_ASR;
704
 
                   so.shiftimm:=24;
705
 
                   list.concat(taicpu.op_reg_reg_shifterop(A_MOV,reg2,reg2,so));
706
 
                 end;
707
 
               OS_16:
708
 
                 begin
709
 
                   so.shiftmode:=SM_LSL;
710
 
                   so.shiftimm:=16;
711
 
                   list.concat(taicpu.op_reg_reg_shifterop(A_MOV,reg2,reg1,so));
712
 
                   so.shiftmode:=SM_LSR;
713
 
                   so.shiftimm:=16;
714
 
                   list.concat(taicpu.op_reg_reg_shifterop(A_MOV,reg2,reg2,so));
715
 
                 end;
716
 
               OS_S16:
717
 
                 begin
718
 
                   so.shiftmode:=SM_LSL;
719
 
                   so.shiftimm:=16;
720
 
                   list.concat(taicpu.op_reg_reg_shifterop(A_MOV,reg2,reg1,so));
721
 
                   so.shiftmode:=SM_ASR;
722
 
                   so.shiftimm:=16;
723
 
                   list.concat(taicpu.op_reg_reg_shifterop(A_MOV,reg2,reg2,so));
724
 
                 end;
725
 
               OS_32,OS_S32:
726
 
                 begin
727
 
                   instr:=taicpu.op_reg_reg(A_MOV,reg2,reg1);
728
 
                   list.concat(instr);
729
 
                   add_move_instruction(instr);
730
 
                 end;
731
 
               else internalerror(2002090901);
732
 
             end;
733
 
           end;
734
 
       end;
735
 
 
736
 
 
737
 
     procedure tcgarm.a_loadfpu_reg_reg(list: taasmoutput; size: tcgsize; reg1, reg2: tregister);
738
 
       begin
739
 
         list.concat(setoppostfix(taicpu.op_reg_reg(A_MVF,reg2,reg1),cgsize2fpuoppostfix[size]));
740
 
       end;
741
 
 
742
 
 
743
 
     procedure tcgarm.a_loadfpu_ref_reg(list: taasmoutput; size: tcgsize; const ref: treference; reg: tregister);
744
 
       var
745
 
         oppostfix:toppostfix;
746
 
       begin
747
 
         case size of
748
 
           OS_F32:
749
 
             oppostfix:=PF_S;
750
 
           OS_F64:
751
 
             oppostfix:=PF_D;
752
 
           OS_F80:
753
 
             oppostfix:=PF_E;
754
 
           else
755
 
             InternalError(200309021);
756
 
         end;
757
 
         handle_load_store(list,A_LDF,oppostfix,reg,ref);
758
 
       end;
759
 
 
760
 
 
761
 
     procedure tcgarm.a_loadfpu_reg_ref(list: taasmoutput; size: tcgsize; reg: tregister; const ref: treference);
762
 
       var
763
 
         oppostfix:toppostfix;
764
 
       begin
765
 
         case size of
766
 
           OS_F32:
767
 
             oppostfix:=PF_S;
768
 
           OS_F64:
769
 
             oppostfix:=PF_D;
770
 
           OS_F80:
771
 
             oppostfix:=PF_E;
772
 
           else
773
 
             InternalError(200309021);
774
 
         end;
775
 
         handle_load_store(list,A_STF,oppostfix,reg,ref);
776
 
       end;
777
 
 
778
 
 
779
 
    {  comparison operations }
780
 
    procedure tcgarm.a_cmp_const_reg_label(list : taasmoutput;size : tcgsize;cmp_op : topcmp;a : aword;reg : tregister;
781
 
      l : tasmlabel);
782
 
      var
783
 
        tmpreg : tregister;
784
 
        b : byte;
785
 
      begin
786
 
        if is_shifter_const(a,b) then
787
 
          list.concat(taicpu.op_reg_const(A_CMP,reg,a))
788
 
        { CMN reg,0 and CMN reg,$80000000 are different from CMP reg,$ffffffff
789
 
          and CMP reg,$7fffffff regarding the flags according to the ARM manual }
790
 
        else if is_shifter_const(-a,b) and (a<>$7fffffff) and (a<>$ffffffff) then
791
 
          list.concat(taicpu.op_reg_const(A_CMN,reg,-a))
792
 
        else
793
 
          begin
794
 
            tmpreg:=getintregister(list,size);
795
 
            a_load_const_reg(list,size,a,tmpreg);
796
 
            list.concat(taicpu.op_reg_reg(A_CMP,reg,tmpreg));
797
 
            ungetregister(list,tmpreg);
798
 
          end;
799
 
        a_jmp_cond(list,cmp_op,l);
800
 
      end;
801
 
 
802
 
 
803
 
    procedure tcgarm.a_cmp_reg_reg_label(list : taasmoutput;size : tcgsize;cmp_op : topcmp;reg1,reg2 : tregister;l : tasmlabel);
804
 
      begin
805
 
        list.concat(taicpu.op_reg_reg(A_CMP,reg2,reg1));
806
 
        a_jmp_cond(list,cmp_op,l);
807
 
      end;
808
 
 
809
 
 
810
 
    procedure tcgarm.a_jmp_name(list : taasmoutput;const s : string);
811
 
      begin
812
 
        list.concat(taicpu.op_sym(A_B,objectlibrary.newasmsymbol(s,AB_EXTERNAL,AT_FUNCTION)));
813
 
      end;
814
 
 
815
 
 
816
 
    procedure tcgarm.a_jmp_always(list : taasmoutput;l: tasmlabel);
817
 
      begin
818
 
        list.concat(taicpu.op_sym(A_B,objectlibrary.newasmsymbol(l.name,AB_EXTERNAL,AT_FUNCTION)));
819
 
      end;
820
 
 
821
 
 
822
 
    procedure tcgarm.a_jmp_flags(list : taasmoutput;const f : TResFlags;l: tasmlabel);
823
 
      var
824
 
        ai : taicpu;
825
 
      begin
826
 
        ai:=setcondition(taicpu.op_sym(A_B,l),flags_to_cond(f));
827
 
        ai.is_jmp:=true;
828
 
        list.concat(ai);
829
 
      end;
830
 
 
831
 
 
832
 
    procedure tcgarm.g_flags2reg(list: taasmoutput; size: TCgSize; const f: TResFlags; reg: TRegister);
833
 
      var
834
 
        ai : taicpu;
835
 
      begin
836
 
        list.concat(setcondition(taicpu.op_reg_const(A_MOV,reg,1),flags_to_cond(f)));
837
 
        list.concat(setcondition(taicpu.op_reg_const(A_MOV,reg,0),inverse_cond[flags_to_cond(f)]));
838
 
      end;
839
 
 
840
 
 
841
 
    procedure tcgarm.g_copyvaluepara_openarray(list : taasmoutput;const ref, lenref:treference;elesize:aword);
842
 
      begin
843
 
      end;
844
 
 
845
 
 
846
 
    procedure tcgarm.g_stackframe_entry(list : taasmoutput;localsize : longint);
847
 
      var
848
 
         ref : treference;
849
 
         shift : byte;
850
 
         firstfloatreg,lastfloatreg,
851
 
         r : byte;
852
 
      begin
853
 
        LocalSize:=align(LocalSize,4);
854
 
        firstfloatreg:=RS_NO;
855
 
        { save floating point registers? }
856
 
        for r:=RS_F0 to RS_F7 do
857
 
          if r in rg[R_FPUREGISTER].used_in_proc-paramanager.get_volatile_registers_fpu(pocall_stdcall) then
858
 
            begin
859
 
              if firstfloatreg=RS_NO then
860
 
                firstfloatreg:=r;
861
 
              lastfloatreg:=r;
862
 
            end;
863
 
        a_reg_alloc(list,NR_STACK_POINTER_REG);
864
 
        a_reg_alloc(list,NR_FRAME_POINTER_REG);
865
 
        a_reg_alloc(list,NR_R12);
866
 
 
867
 
        list.concat(taicpu.op_reg_reg(A_MOV,NR_R12,NR_STACK_POINTER_REG));
868
 
        { save int registers }
869
 
        reference_reset(ref);
870
 
        ref.index:=NR_STACK_POINTER_REG;
871
 
        ref.addressmode:=AM_PREINDEXED;
872
 
        list.concat(setoppostfix(taicpu.op_ref_regset(A_STM,ref,
873
 
          rg[R_INTREGISTER].used_in_proc-paramanager.get_volatile_registers_int(pocall_stdcall)+[RS_R11,RS_R12,RS_R14,RS_R15]),
874
 
          PF_FD));
875
 
 
876
 
        list.concat(taicpu.op_reg_reg_const(A_SUB,NR_FRAME_POINTER_REG,NR_R12,4));
877
 
 
878
 
        { allocate necessary stack size }
879
 
        { don't use  a_op_const_reg_reg here because we don't allow register allocations
880
 
          in the entry/exit code }
881
 
        if not(is_shifter_const(localsize,shift)) then
882
 
          begin
883
 
            a_load_const_reg(list,OS_ADDR,LocalSize,NR_R12);
884
 
            list.concat(taicpu.op_reg_reg_reg(A_SUB,NR_STACK_POINTER_REG,NR_STACK_POINTER_REG,NR_R12));
885
 
            a_reg_dealloc(list,NR_R12);
886
 
          end
887
 
        else
888
 
          begin
889
 
            a_reg_dealloc(list,NR_R12);
890
 
            list.concat(taicpu.op_reg_reg_const(A_SUB,NR_STACK_POINTER_REG,NR_STACK_POINTER_REG,LocalSize));
891
 
          end;
892
 
        if firstfloatreg<>RS_NO then
893
 
          begin
894
 
            reference_reset(ref);
895
 
            ref.base:=NR_FRAME_POINTER_REG;
896
 
            ref.offset:=tarmprocinfo(current_procinfo).floatregstart;
897
 
            list.concat(taicpu.op_reg_const_ref(A_SFM,newreg(R_FPUREGISTER,firstfloatreg,R_SUBWHOLE),
898
 
              lastfloatreg-firstfloatreg+1,ref));
899
 
          end;
900
 
      end;
901
 
 
902
 
 
903
 
    procedure tcgarm.g_return_from_proc(list : taasmoutput;parasize : aword);
904
 
      var
905
 
         ref : treference;
906
 
         firstfloatreg,lastfloatreg,
907
 
         r : byte;
908
 
      begin
909
 
        { restore floating point register }
910
 
        firstfloatreg:=RS_NO;
911
 
        { save floating point registers? }
912
 
        for r:=RS_F0 to RS_F7 do
913
 
          if r in rg[R_FPUREGISTER].used_in_proc-paramanager.get_volatile_registers_fpu(pocall_stdcall) then
914
 
            begin
915
 
              if firstfloatreg=RS_NO then
916
 
                firstfloatreg:=r;
917
 
              lastfloatreg:=r;
918
 
            end;
919
 
        if firstfloatreg<>RS_NO then
920
 
          begin
921
 
            reference_reset(ref);
922
 
            ref.base:=NR_FRAME_POINTER_REG;
923
 
            ref.offset:=tarmprocinfo(current_procinfo).floatregstart;
924
 
            list.concat(taicpu.op_reg_const_ref(A_LFM,newreg(R_FPUREGISTER,firstfloatreg,R_SUBWHOLE),
925
 
              lastfloatreg-firstfloatreg+1,ref));
926
 
          end;
927
 
 
928
 
        if (current_procinfo.framepointer=NR_STACK_POINTER_REG) then
929
 
          list.concat(taicpu.op_reg_reg(A_MOV,NR_R15,NR_R14))
930
 
        else
931
 
          begin
932
 
            { restore int registers and return }
933
 
            reference_reset(ref);
934
 
            ref.index:=NR_FRAME_POINTER_REG;
935
 
            list.concat(setoppostfix(taicpu.op_ref_regset(A_LDM,ref,rg[R_INTREGISTER].used_in_proc-paramanager.get_volatile_registers_int(pocall_stdcall)+[RS_R11,RS_R13,RS_R15]),PF_EA));
936
 
          end;
937
 
      end;
938
 
 
939
 
 
940
 
    procedure tcgarm.g_restore_frame_pointer(list : taasmoutput);
941
 
      begin
942
 
         { the frame pointer on the ARM is restored while the ret is executed }
943
 
      end;
944
 
 
945
 
 
946
 
    procedure tcgarm.a_loadaddr_ref_reg(list : taasmoutput;const ref : treference;r : tregister);
947
 
      var
948
 
        b : byte;
949
 
        tmpref : treference;
950
 
        instr : taicpu;
951
 
      begin
952
 
        if ref.addressmode<>AM_OFFSET then
953
 
          internalerror(200309071);
954
 
        tmpref:=ref;
955
 
        { Be sure to have a base register }
956
 
        if (tmpref.base=NR_NO) then
957
 
          begin
958
 
            if tmpref.shiftmode<>SM_None then
959
 
              internalerror(200308294);
960
 
            if tmpref.signindex<0 then
961
 
              internalerror(200312023);
962
 
            tmpref.base:=tmpref.index;
963
 
            tmpref.index:=NR_NO;
964
 
          end;
965
 
 
966
 
        if assigned(tmpref.symbol) or
967
 
           not((is_shifter_const(dword(tmpref.offset),b)) or
968
 
               (is_shifter_const(dword(-tmpref.offset),b))
969
 
              ) then
970
 
          fixref(list,tmpref);
971
 
 
972
 
        { expect a base here }
973
 
        if tmpref.base=NR_NO then
974
 
          internalerror(200312022);
975
 
 
976
 
        if tmpref.index<>NR_NO then
977
 
          begin
978
 
            if tmpref.shiftmode<>SM_None then
979
 
              internalerror(200312021);
980
 
            if tmpref.signindex<0 then
981
 
              a_op_reg_reg_reg(list,OP_SUB,OS_ADDR,tmpref.base,tmpref.index,r)
982
 
            else
983
 
              a_op_reg_reg_reg(list,OP_ADD,OS_ADDR,tmpref.base,tmpref.index,r);
984
 
            if tmpref.offset<>0 then
985
 
              a_op_const_reg_reg(list,OP_ADD,OS_ADDR,tmpref.offset,r,r);
986
 
          end
987
 
        else
988
 
          begin
989
 
            if tmpref.offset<>0 then
990
 
              a_op_const_reg_reg(list,OP_ADD,OS_ADDR,tmpref.offset,tmpref.base,r)
991
 
            else
992
 
              begin
993
 
                instr:=taicpu.op_reg_reg(A_MOV,r,tmpref.base);
994
 
                list.concat(instr);
995
 
                add_move_instruction(instr);
996
 
              end;
997
 
          end;
998
 
        reference_release(list,tmpref);
999
 
      end;
1000
 
 
1001
 
 
1002
 
    procedure tcgarm.fixref(list : taasmoutput;var ref : treference);
1003
 
      var
1004
 
        tmpreg : tregister;
1005
 
        tmpref : treference;
1006
 
        l : tasmlabel;
1007
 
      begin
1008
 
        { absolute symbols can't be handled directly, we've to store the symbol reference
1009
 
          in the text segment and access it pc relative
1010
 
 
1011
 
          For now, we assume that references where base or index equals to PC are already
1012
 
          relative, all other references are assumed to be absolute and thus they need
1013
 
          to be handled extra.
1014
 
 
1015
 
          A proper solution would be to change refoptions to a set and store the information
1016
 
          if the symbol is absolute or relative there.
1017
 
        }
1018
 
        { create consts entry }
1019
 
        reference_reset(tmpref);
1020
 
        objectlibrary.getlabel(l);
1021
 
        cg.a_label(current_procinfo.aktlocaldata,l);
1022
 
        tmpref.symboldata:=current_procinfo.aktlocaldata.last;
1023
 
 
1024
 
        if assigned(ref.symbol) then
1025
 
          current_procinfo.aktlocaldata.concat(tai_const_symbol.Create_offset(ref.symbol,ref.offset))
1026
 
        else
1027
 
          current_procinfo.aktlocaldata.concat(tai_const.Create_32bit(ref.offset));
1028
 
 
1029
 
        { load consts entry }
1030
 
        tmpreg:=getintregister(list,OS_INT);
1031
 
        tmpref.symbol:=l;
1032
 
        tmpref.base:=NR_PC;
1033
 
        list.concat(taicpu.op_reg_ref(A_LDR,tmpreg,tmpref));
1034
 
 
1035
 
        if (ref.base<>NR_NO) then
1036
 
          begin
1037
 
            if ref.index<>NR_NO then
1038
 
              begin
1039
 
                list.concat(taicpu.op_reg_reg_reg(A_ADD,tmpreg,ref.base,tmpreg));
1040
 
                ref.base:=tmpreg;
1041
 
              end
1042
 
            else
1043
 
              begin
1044
 
                ref.index:=tmpreg;
1045
 
                ref.shiftimm:=0;
1046
 
                ref.signindex:=1;
1047
 
                ref.shiftmode:=SM_None;
1048
 
              end;
1049
 
          end
1050
 
        else
1051
 
          ref.base:=tmpreg;
1052
 
 
1053
 
        ref.offset:=0;
1054
 
        ref.symbol:=nil;
1055
 
      end;
1056
 
 
1057
 
 
1058
 
    procedure tcgarm.g_concatcopy(list : taasmoutput;const source,dest : treference;len : aword; delsource,loadref : boolean);
1059
 
      var
1060
 
        srcref,dstref:treference;
1061
 
        srcreg,destreg,countreg,r:tregister;
1062
 
        helpsize:aword;
1063
 
        copysize:byte;
1064
 
        cgsize:Tcgsize;
1065
 
 
1066
 
      procedure genloop(count : aword;size : byte);
1067
 
        const
1068
 
          size2opsize : array[1..4] of tcgsize = (OS_8,OS_16,OS_NO,OS_32);
1069
 
        var
1070
 
          l : tasmlabel;
1071
 
        begin
1072
 
          objectlibrary.getlabel(l);
1073
 
          a_load_const_reg(list,OS_INT,count,countreg);
1074
 
          cg.a_label(list,l);
1075
 
          srcref.addressmode:=AM_POSTINDEXED;
1076
 
          dstref.addressmode:=AM_POSTINDEXED;
1077
 
          srcref.offset:=size;
1078
 
          dstref.offset:=size;
1079
 
          r:=getintregister(list,size2opsize[size]);
1080
 
          a_load_ref_reg(list,size2opsize[size],size2opsize[size],srcref,r);
1081
 
          a_load_reg_ref(list,size2opsize[size],size2opsize[size],r,dstref);
1082
 
          ungetregister(list,r);
1083
 
          list.concat(setoppostfix(taicpu.op_reg_reg_const(A_SUB,countreg,countreg,1),PF_S));
1084
 
          list.concat(setcondition(taicpu.op_sym(A_B,l),C_NE));
1085
 
          { keep the registers alive }
1086
 
          list.concat(taicpu.op_reg_reg(A_MOV,countreg,countreg));
1087
 
          list.concat(taicpu.op_reg_reg(A_MOV,srcreg,srcreg));
1088
 
          list.concat(taicpu.op_reg_reg(A_MOV,destreg,destreg));
1089
 
        end;
1090
 
 
1091
 
      begin
1092
 
        if len=0 then
1093
 
          exit;
1094
 
        helpsize:=12;
1095
 
        dstref:=dest;
1096
 
        srcref:=source;
1097
 
        if cs_littlesize in aktglobalswitches then
1098
 
          helpsize:=8;
1099
 
        if not loadref and (len<=helpsize) then
1100
 
          begin
1101
 
            copysize:=4;
1102
 
            cgsize:=OS_32;
1103
 
            while len<>0 do
1104
 
              begin
1105
 
                if len<2 then
1106
 
                  begin
1107
 
                    copysize:=1;
1108
 
                    cgsize:=OS_8;
1109
 
                  end
1110
 
                else if len<4 then
1111
 
                  begin
1112
 
                    copysize:=2;
1113
 
                    cgsize:=OS_16;
1114
 
                  end;
1115
 
                dec(len,copysize);
1116
 
                r:=getintregister(list,cgsize);
1117
 
                a_load_ref_reg(list,cgsize,cgsize,srcref,r);
1118
 
                if (len=0) and delsource then
1119
 
                  reference_release(list,source);
1120
 
                a_load_reg_ref(list,cgsize,cgsize,r,dstref);
1121
 
                inc(srcref.offset,copysize);
1122
 
                inc(dstref.offset,copysize);
1123
 
                ungetregister(list,r);
1124
 
              end;
1125
 
          end
1126
 
        else
1127
 
          begin
1128
 
            destreg:=getintregister(list,OS_ADDR);
1129
 
            a_loadaddr_ref_reg(list,dest,destreg);
1130
 
            reference_reset_base(dstref,destreg,0);
1131
 
 
1132
 
            srcreg:=getintregister(list,OS_ADDR);
1133
 
            if loadref then
1134
 
              a_load_ref_reg(list,OS_ADDR,OS_ADDR,source,srcreg)
1135
 
            else
1136
 
              a_loadaddr_ref_reg(list,source,srcreg);
1137
 
            reference_reset_base(srcref,srcreg,0);
1138
 
 
1139
 
            if delsource then
1140
 
              reference_release(list,source);
1141
 
 
1142
 
            countreg:=getintregister(list,OS_32);
1143
 
 
1144
 
//            if cs_littlesize in aktglobalswitches  then
1145
 
              genloop(len,1);
1146
 
{
1147
 
            else
1148
 
              begin
1149
 
                helpsize:=len shr 2;
1150
 
                len:=len and 3;
1151
 
                if helpsize>1 then
1152
 
                  begin
1153
 
                    a_load_const_reg(list,OS_INT,helpsize,countreg);
1154
 
                    list.concat(Taicpu.op_none(A_REP,S_NO));
1155
 
                  end;
1156
 
                if helpsize>0 then
1157
 
                  list.concat(Taicpu.op_none(A_MOVSD,S_NO));
1158
 
                if len>1 then
1159
 
                  begin
1160
 
                    dec(len,2);
1161
 
                    list.concat(Taicpu.op_none(A_MOVSW,S_NO));
1162
 
                  end;
1163
 
                if len=1 then
1164
 
                  list.concat(Taicpu.op_none(A_MOVSB,S_NO));
1165
 
                end;
1166
 
}
1167
 
            ungetregister(list,countreg);
1168
 
            ungetregister(list,srcreg);
1169
 
            ungetregister(list,destreg);
1170
 
          end;
1171
 
        if delsource then
1172
 
          tg.ungetiftemp(list,source);
1173
 
      end;
1174
 
 
1175
 
 
1176
 
    procedure tcgarm.g_overflowcheck(list: taasmoutput; const l: tlocation; def: tdef);
1177
 
      begin
1178
 
      end;
1179
 
 
1180
 
 
1181
 
    procedure tcgarm.g_save_standard_registers(list : taasmoutput);
1182
 
      begin
1183
 
        { we support only ARM standard calling conventions so this procedure has no use on the ARM }
1184
 
      end;
1185
 
 
1186
 
 
1187
 
    procedure tcgarm.g_restore_standard_registers(list : taasmoutput);
1188
 
      begin
1189
 
        { we support only ARM standard calling conventions so this procedure has no use on the ARM }
1190
 
      end;
1191
 
 
1192
 
 
1193
 
    procedure tcgarm.g_save_all_registers(list : taasmoutput);
1194
 
      begin
1195
 
        { we support only ARM standard calling conventions so this procedure has no use on the ARM }
1196
 
      end;
1197
 
 
1198
 
 
1199
 
    procedure tcgarm.g_restore_all_registers(list : taasmoutput;const funcretparaloc:tparalocation);
1200
 
      begin
1201
 
        { we support only ARM standard calling conventions so this procedure has no use on the ARM }
1202
 
      end;
1203
 
 
1204
 
 
1205
 
    procedure tcgarm.a_jmp_cond(list : taasmoutput;cond : TOpCmp;l: tasmlabel);
1206
 
      var
1207
 
        ai : taicpu;
1208
 
      begin
1209
 
        ai:=Taicpu.Op_sym(A_B,l);
1210
 
        ai.SetCondition(OpCmp2AsmCond[cond]);
1211
 
        ai.is_jmp:=true;
1212
 
        list.concat(ai);
1213
 
      end;
1214
 
 
1215
 
 
1216
 
    procedure tcg64farm.a_op64_reg_reg(list : taasmoutput;op:TOpCG;regsrc,regdst : tregister64);
1217
 
      var
1218
 
        tmpreg : tregister;
1219
 
      begin
1220
 
        case op of
1221
 
          OP_NEG:
1222
 
            begin
1223
 
              list.concat(setoppostfix(taicpu.op_reg_reg_const(A_RSB,regdst.reglo,regsrc.reglo,0),PF_S));
1224
 
              list.concat(taicpu.op_reg_reg_const(A_RSC,regdst.reghi,regsrc.reghi,0));
1225
 
            end;
1226
 
          OP_NOT:
1227
 
            begin
1228
 
              cg.a_op_reg_reg(list,OP_NOT,OS_INT,regsrc.reglo,regdst.reglo);
1229
 
              cg.a_op_reg_reg(list,OP_NOT,OS_INT,regsrc.reghi,regdst.reghi);
1230
 
            end;
1231
 
          else
1232
 
            a_op64_reg_reg_reg(list,op,regsrc,regdst,regdst);
1233
 
        end;
1234
 
      end;
1235
 
 
1236
 
 
1237
 
    procedure tcg64farm.a_op64_const_reg(list : taasmoutput;op:TOpCG;value : qword;reg : tregister64);
1238
 
      begin
1239
 
        a_op64_const_reg_reg(list,op,value,reg,reg);
1240
 
      end;
1241
 
 
1242
 
 
1243
 
    procedure tcg64farm.a_op64_const_reg_reg(list: taasmoutput;op:TOpCG;value : qword;regsrc,regdst : tregister64);
1244
 
      var
1245
 
        tmpreg : tregister;
1246
 
        b : byte;
1247
 
      begin
1248
 
        case op of
1249
 
          OP_AND,OP_OR,OP_XOR:
1250
 
            begin
1251
 
              cg.a_op_const_reg_reg(list,op,OS_32,lo(value),regsrc.reglo,regdst.reglo);
1252
 
              cg.a_op_const_reg_reg(list,op,OS_32,hi(value),regsrc.reghi,regdst.reghi);
1253
 
            end;
1254
 
          OP_ADD:
1255
 
            begin
1256
 
              if is_shifter_const(lo(value),b) then
1257
 
                list.concat(setoppostfix(taicpu.op_reg_reg_const(A_ADD,regdst.reglo,regsrc.reglo,lo(value)),PF_S))
1258
 
              else
1259
 
                begin
1260
 
                  tmpreg:=cg.getintregister(list,OS_32);
1261
 
                  cg.a_load_const_reg(list,OS_32,lo(value),tmpreg);
1262
 
                  list.concat(setoppostfix(taicpu.op_reg_reg_reg(A_ADD,regdst.reglo,regsrc.reglo,tmpreg),PF_S));
1263
 
                  cg.ungetregister(list,tmpreg);
1264
 
                end;
1265
 
 
1266
 
              if is_shifter_const(hi(value),b) then
1267
 
                list.concat(taicpu.op_reg_reg_const(A_ADC,regdst.reghi,regsrc.reghi,hi(value)))
1268
 
              else
1269
 
                begin
1270
 
                  tmpreg:=cg.getintregister(list,OS_32);
1271
 
                  cg.a_load_const_reg(list,OS_32,hi(value),tmpreg);
1272
 
                  list.concat(taicpu.op_reg_reg_reg(A_ADC,regdst.reghi,regsrc.reghi,tmpreg));
1273
 
                  cg.ungetregister(list,tmpreg);
1274
 
                end;
1275
 
            end;
1276
 
          OP_SUB:
1277
 
            begin
1278
 
              if is_shifter_const(lo(value),b) then
1279
 
                list.concat(setoppostfix(taicpu.op_reg_reg_const(A_SUB,regdst.reglo,regsrc.reglo,lo(value)),PF_S))
1280
 
              else
1281
 
                begin
1282
 
                  tmpreg:=cg.getintregister(list,OS_32);
1283
 
                  cg.a_load_const_reg(list,OS_32,lo(value),tmpreg);
1284
 
                  list.concat(setoppostfix(taicpu.op_reg_reg_reg(A_SUB,regdst.reglo,regsrc.reglo,tmpreg),PF_S));
1285
 
                  cg.ungetregister(list,tmpreg);
1286
 
                end;
1287
 
 
1288
 
              if is_shifter_const(hi(value),b) then
1289
 
                list.concat(taicpu.op_reg_reg_const(A_SBC,regdst.reghi,regsrc.reghi,hi(value)))
1290
 
              else
1291
 
                begin
1292
 
                  tmpreg:=cg.getintregister(list,OS_32);
1293
 
                  cg.a_load_const_reg(list,OS_32,hi(value),tmpreg);
1294
 
                  list.concat(taicpu.op_reg_reg_reg(A_SBC,regdst.reghi,regsrc.reghi,tmpreg));
1295
 
                  cg.ungetregister(list,tmpreg);
1296
 
                end;
1297
 
            end;
1298
 
          else
1299
 
            internalerror(2003083101);
1300
 
        end;
1301
 
      end;
1302
 
 
1303
 
 
1304
 
    procedure tcg64farm.a_op64_reg_reg_reg(list: taasmoutput;op:TOpCG;regsrc1,regsrc2,regdst : tregister64);
1305
 
      begin
1306
 
        case op of
1307
 
          OP_AND,OP_OR,OP_XOR:
1308
 
            begin
1309
 
              cg.a_op_reg_reg_reg(list,op,OS_32,regsrc1.reglo,regsrc2.reglo,regdst.reglo);
1310
 
              cg.a_op_reg_reg_reg(list,op,OS_32,regsrc1.reghi,regsrc2.reghi,regdst.reghi);
1311
 
            end;
1312
 
          OP_ADD:
1313
 
            begin
1314
 
              list.concat(setoppostfix(taicpu.op_reg_reg_reg(A_ADD,regdst.reglo,regsrc1.reglo,regsrc2.reglo),PF_S));
1315
 
              list.concat(taicpu.op_reg_reg_reg(A_ADC,regdst.reghi,regsrc1.reghi,regsrc2.reghi));
1316
 
            end;
1317
 
          OP_SUB:
1318
 
            begin
1319
 
              list.concat(setoppostfix(taicpu.op_reg_reg_reg(A_SUB,regdst.reglo,regsrc2.reglo,regsrc1.reglo),PF_S));
1320
 
              list.concat(taicpu.op_reg_reg_reg(A_SBC,regdst.reghi,regsrc2.reghi,regsrc1.reghi));
1321
 
            end;
1322
 
          else
1323
 
            internalerror(2003083101);
1324
 
        end;
1325
 
      end;
1326
 
 
1327
 
 
1328
 
begin
1329
 
  cg:=tcgarm.create;
1330
 
  cg64:=tcg64farm.create;
1331
 
end.
1332
 
{
1333
 
  $Log: cgcpu.pas,v $
1334
 
  Revision 1.51  2004/03/31 19:13:04  florian
1335
 
    * concatcopy with len=0 exits now immediatly
1336
 
 
1337
 
  Revision 1.50  2004/03/29 19:19:35  florian
1338
 
    + arm floating point register saving implemented
1339
 
    * hopefully stabs generation for MacOSX fixed
1340
 
    + some defines for arm added
1341
 
 
1342
 
  Revision 1.49  2004/03/14 21:42:24  florian
1343
 
    * optimized mul code generation
1344
 
 
1345
 
  Revision 1.48  2004/03/14 16:15:40  florian
1346
 
    * spilling problem fixed
1347
 
    * handling of floating point memory references fixed
1348
 
 
1349
 
  Revision 1.47  2004/03/10 22:35:40  florian
1350
 
    + fixed code generation for cmn
1351
 
 
1352
 
  Revision 1.46  2004/03/06 20:35:19  florian
1353
 
    * fixed arm compilation
1354
 
    * cleaned up code generation for exported linux procedures
1355
 
 
1356
 
  Revision 1.45  2004/03/02 00:36:33  olle
1357
 
    * big transformation of Tai_[const_]Symbol.Create[data]name*
1358
 
 
1359
 
  Revision 1.44  2004/02/04 22:01:13  peter
1360
 
    * first try to get cpupara working for x86_64
1361
 
 
1362
 
  Revision 1.43  2004/01/29 17:09:32  florian
1363
 
    * handling of floating point references fixed
1364
 
 
1365
 
  Revision 1.42  2004/01/28 15:36:47  florian
1366
 
    * fixed another couple of arm bugs
1367
 
 
1368
 
  Revision 1.41  2004/01/27 15:04:06  florian
1369
 
    * fixed code generation for math inl. nodes
1370
 
    * more code generator improvements
1371
 
 
1372
 
  Revision 1.40  2004/01/26 19:05:56  florian
1373
 
    * fixed several arm issues
1374
 
 
1375
 
  Revision 1.39  2004/01/24 20:19:46  florian
1376
 
    * fixed some spilling stuff
1377
 
    + not(<int64>) implemented
1378
 
    + small set comparisations implemented
1379
 
 
1380
 
  Revision 1.38  2004/01/24 01:33:20  florian
1381
 
    * fixref fixed if index, base and offset were given
1382
 
 
1383
 
  Revision 1.37  2004/01/22 20:13:18  florian
1384
 
    * fixed several issues with flags
1385
 
 
1386
 
  Revision 1.36  2004/01/22 02:22:47  florian
1387
 
    * op_const_reg_reg with OP_SAR fixed
1388
 
 
1389
 
  Revision 1.35  2004/01/22 01:47:15  florian
1390
 
    * improved register usage
1391
 
    + implemented second_cmp64bit
1392
 
 
1393
 
  Revision 1.34  2004/01/21 19:01:03  florian
1394
 
    * fixed handling of max. distance of pc relative symbols
1395
 
 
1396
 
  Revision 1.33  2004/01/21 15:41:56  florian
1397
 
    * fixed register allocator problems with concatcopy
1398
 
 
1399
 
  Revision 1.32  2004/01/21 14:22:00  florian
1400
 
    + reintroduce implemented
1401
 
 
1402
 
  Revision 1.31  2004/01/21 01:22:35  florian
1403
 
    * fixed a_cmp_const_reg_label
1404
 
    * fixed volatile register handling which was broken by my last patch
1405
 
 
1406
 
  Revision 1.30  2004/01/20 23:18:00  florian
1407
 
    * fixed a_call_reg
1408
 
    + implemented paramgr.get_volative_registers
1409
 
 
1410
 
  Revision 1.29  2003/12/26 14:02:30  peter
1411
 
    * sparc updates
1412
 
    * use registertype in spill_register
1413
 
 
1414
 
  Revision 1.28  2003/12/18 17:06:21  florian
1415
 
    * arm compiler compilation fixed
1416
 
 
1417
 
  Revision 1.27  2003/12/08 17:43:57  florian
1418
 
    * fixed ldm/stm arm assembler reading
1419
 
    * fixed a_load_reg_reg with OS_8 on ARM
1420
 
    * non supported calling conventions cause only a warning now
1421
 
 
1422
 
  Revision 1.26  2003/12/03 17:39:05  florian
1423
 
    * fixed several arm calling conventions issues
1424
 
    * fixed reference reading in the assembler reader
1425
 
    * fixed a_loadaddr_ref_reg
1426
 
 
1427
 
  Revision 1.25  2003/11/30 19:35:29  florian
1428
 
    * fixed several arm related problems
1429
 
 
1430
 
  Revision 1.24  2003/11/24 15:17:37  florian
1431
 
    * changed some types to prevend range check errors
1432
 
 
1433
 
  Revision 1.23  2003/11/21 16:29:26  florian
1434
 
    * fixed reading of reg. sets in the arm assembler reader
1435
 
 
1436
 
  Revision 1.22  2003/11/07 15:58:32  florian
1437
 
    * Florian's culmutative nr. 1; contains:
1438
 
      - invalid calling conventions for a certain cpu are rejected
1439
 
      - arm softfloat calling conventions
1440
 
      - -Sp for cpu dependend code generation
1441
 
      - several arm fixes
1442
 
      - remaining code for value open array paras on heap
1443
 
 
1444
 
  Revision 1.21  2003/11/02 14:30:03  florian
1445
 
    * fixed ARM for new reg. allocation scheme
1446
 
 
1447
 
  Revision 1.20  2003/10/11 16:06:42  florian
1448
 
    * fixed some MMX<->SSE
1449
 
    * started to fix ppc, needs an overhaul
1450
 
    + stabs info improve for spilling, not sure if it works correctly/completly
1451
 
    - MMX_SUPPORT removed from Makefile.fpc
1452
 
 
1453
 
  Revision 1.19  2003/09/11 11:55:00  florian
1454
 
    * improved arm code generation
1455
 
    * move some protected and private field around
1456
 
    * the temp. register for register parameters/arguments are now released
1457
 
      before the move to the parameter register is done. This improves
1458
 
      the code in a lot of cases.
1459
 
 
1460
 
  Revision 1.18  2003/09/09 12:53:40  florian
1461
 
    * some assembling problems fixed
1462
 
    * improved loadaddr_ref_reg
1463
 
 
1464
 
  Revision 1.17  2003/09/06 16:45:51  florian
1465
 
    * fixed exit code (no preindexed addressing mode in LDM)
1466
 
 
1467
 
  Revision 1.16  2003/09/06 11:21:50  florian
1468
 
    * fixed stm and ldm to be usable with preindex operand
1469
 
 
1470
 
  Revision 1.15  2003/09/05 23:57:01  florian
1471
 
    * arm is working again as before the new register naming scheme was implemented
1472
 
 
1473
 
  Revision 1.14  2003/09/04 21:07:03  florian
1474
 
    * ARM compiler compiles again
1475
 
 
1476
 
  Revision 1.13  2003/09/04 00:15:29  florian
1477
 
    * first bunch of adaptions of arm compiler for new register type
1478
 
 
1479
 
  Revision 1.12  2003/09/03 19:10:30  florian
1480
 
    * initial revision of new register naming
1481
 
 
1482
 
  Revision 1.11  2003/09/03 11:18:37  florian
1483
 
    * fixed arm concatcopy
1484
 
    + arm support in the common compiler sources added
1485
 
    * moved some generic cg code around
1486
 
    + tfputype added
1487
 
    * ...
1488
 
 
1489
 
  Revision 1.10  2003/09/01 15:11:16  florian
1490
 
    * fixed reference handling
1491
 
    * fixed operand postfix for floating point instructions
1492
 
    * fixed wrong shifter constant handling
1493
 
 
1494
 
  Revision 1.9  2003/09/01 09:54:57  florian
1495
 
    *  results of work on arm port last weekend
1496
 
 
1497
 
  Revision 1.8  2003/08/29 21:36:28  florian
1498
 
    * fixed procedure entry/exit code
1499
 
    * started to fix reference handling
1500
 
 
1501
 
  Revision 1.7  2003/08/28 13:26:10  florian
1502
 
    * another couple of arm fixes
1503
 
 
1504
 
  Revision 1.6  2003/08/28 00:05:29  florian
1505
 
    * today's arm patches
1506
 
 
1507
 
  Revision 1.5  2003/08/25 23:20:38  florian
1508
 
    + started to implement FPU support for the ARM
1509
 
    * fixed a lot of other things
1510
 
 
1511
 
  Revision 1.4  2003/08/24 12:27:26  florian
1512
 
    * continued to work on the arm port
1513
 
 
1514
 
  Revision 1.3  2003/08/21 03:14:00  florian
1515
 
    * arm compiler can be compiled; far from being working
1516
 
 
1517
 
  Revision 1.2  2003/08/20 15:50:12  florian
1518
 
    * more arm stuff
1519
 
 
1520
 
  Revision 1.1  2003/07/21 16:35:30  florian
1521
 
    * very basic stuff for the arm
1522
 
}