← Back to branch summary

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

« back to all changes in this revision

Viewing changes to fpcsrc/compiler/cg64f32.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/cg64f32.pas
 
1
{
 
2
    Copyright (c) 1998-2002 by Florian Klaempfl
 
3
    Member of the Free Pascal development team
 
4
 
 
5
    This unit implements the code generation for 64 bit int
 
6
    arithmethics on 32 bit processors
 
7
 
 
8
    This program is free software; you can redistribute it and/or modify
 
9
    it under the terms of the GNU General Public License as published by
 
10
    the Free Software Foundation; either version 2 of the License, or
 
11
    (at your option) any later version.
 
12
 
 
13
    This program is distributed in the hope that it will be useful,
 
14
    but WITHOUT ANY WARRANTY; without even the implied warranty of
 
15
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 
16
    GNU General Public License for more details.
 
17
 
 
18
    You should have received a copy of the GNU General Public License
 
19
    along with this program; if not, write to the Free Software
 
20
    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
 
21
 
 
22
 ****************************************************************************
 
23
}
 
24
{# This unit implements the code generation for 64 bit int arithmethics on
 
25
   32 bit processors.
 
26
}
 
27
unit cg64f32;
 
28
 
 
29
  {$i fpcdefs.inc}
 
30
 
 
31
  interface
 
32
 
 
33
    uses
 
34
       aasmbase,aasmtai,aasmdata,aasmcpu,
 
35
       cpubase,cpupara,
 
36
       cgbase,cgobj,parabase,cgutils,
 
37
       symtype
 
38
       ;
 
39
 
 
40
    type
 
41
      {# Defines all the methods required on 32-bit processors
 
42
         to handle 64-bit integers.
 
43
      }
 
44
      tcg64f32 = class(tcg64)
 
45
        procedure a_load64_const_ref(list : TAsmList;value : int64;const ref : treference);override;
 
46
        procedure a_load64_reg_ref(list : TAsmList;reg : tregister64;const ref : treference);override;
 
47
        procedure a_load64_ref_reg(list : TAsmList;const ref : treference;reg : tregister64);override;
 
48
        procedure a_load64_reg_reg(list : TAsmList;regsrc,regdst : tregister64);override;
 
49
        procedure a_load64_const_reg(list : TAsmList;value: int64;reg : tregister64);override;
 
50
 
 
51
        procedure a_load64_subsetref_reg(list : TAsmList; const sref: tsubsetreference; destreg: tregister64);override;
 
52
        procedure a_load64_reg_subsetref(list : TAsmList; fromreg: tregister64; const sref: tsubsetreference);override;
 
53
        procedure a_load64_const_subsetref(list: TAsmlist; a: int64; const sref: tsubsetreference);override;
 
54
        procedure a_load64_ref_subsetref(list : TAsmList; const fromref: treference; const sref: tsubsetreference);override;
 
55
        procedure a_load64_subsetref_subsetref(list: TAsmlist; const fromsref, tosref: tsubsetreference);override;
 
56
        procedure a_load64_subsetref_ref(list : TAsmList; const sref: tsubsetreference; const destref: treference);override;
 
57
 
 
58
        procedure a_load64_loc_reg(list : TAsmList;const l : tlocation;reg : tregister64);override;
 
59
        procedure a_load64_loc_ref(list : TAsmList;const l : tlocation;const ref : treference);override;
 
60
        procedure a_load64_const_loc(list : TAsmList;value : int64;const l : tlocation);override;
 
61
        procedure a_load64_reg_loc(list : TAsmList;reg : tregister64;const l : tlocation);override;
 
62
 
 
63
 
 
64
 
 
65
        procedure a_load64high_reg_ref(list : TAsmList;reg : tregister;const ref : treference);override;
 
66
        procedure a_load64low_reg_ref(list : TAsmList;reg : tregister;const ref : treference);override;
 
67
        procedure a_load64high_ref_reg(list : TAsmList;const ref : treference;reg : tregister);override;
 
68
        procedure a_load64low_ref_reg(list : TAsmList;const ref : treference;reg : tregister);override;
 
69
        procedure a_load64high_loc_reg(list : TAsmList;const l : tlocation;reg : tregister);override;
 
70
        procedure a_load64low_loc_reg(list : TAsmList;const l : tlocation;reg : tregister);override;
 
71
 
 
72
        procedure a_op64_ref_reg(list : TAsmList;op:TOpCG;size : tcgsize;const ref : treference;reg : tregister64);override;
 
73
        procedure a_op64_reg_ref(list : TAsmList;op:TOpCG;size : tcgsize;reg : tregister64; const ref: treference);override;
 
74
        procedure a_op64_const_loc(list : TAsmList;op:TOpCG;size : tcgsize;value : int64;const l: tlocation);override;
 
75
        procedure a_op64_reg_loc(list : TAsmList;op:TOpCG;size : tcgsize;reg : tregister64;const l : tlocation);override;
 
76
        procedure a_op64_loc_reg(list : TAsmList;op:TOpCG;size : tcgsize;const l : tlocation;reg : tregister64);override;
 
77
        procedure a_op64_const_ref(list : TAsmList;op:TOpCG;size : tcgsize;value : int64;const ref : treference);override;
 
78
 
 
79
        procedure a_param64_reg(list : TAsmList;reg : tregister64;const paraloc : tcgpara);override;
 
80
        procedure a_param64_const(list : TAsmList;value : int64;const paraloc : tcgpara);override;
 
81
        procedure a_param64_ref(list : TAsmList;const r : treference;const paraloc : tcgpara);override;
 
82
        procedure a_param64_loc(list : TAsmList;const l : tlocation;const paraloc : tcgpara);override;
 
83
 
 
84
        {# This routine tries to optimize the a_op64_const_reg operation, by
 
85
           removing superfluous opcodes. Returns TRUE if normal processing
 
86
           must continue in op64_const_reg, otherwise, everything is processed
 
87
           entirely in this routine, by emitting the appropriate 32-bit opcodes.
 
88
        }
 
89
        function optimize64_op_const_reg(list: TAsmList; var op: topcg; var a : int64; var reg: tregister64): boolean;override;
 
90
 
 
91
        procedure g_rangecheck64(list: TAsmList; const l:tlocation;fromdef,todef: tdef); override;
 
92
      end;
 
93
 
 
94
    {# Creates a tregister64 record from 2 32 Bit registers. }
 
95
    function joinreg64(reglo,reghi : tregister) : tregister64;
 
96
 
 
97
  implementation
 
98
 
 
99
    uses
 
100
       globtype,systems,
 
101
       verbose,
 
102
       symbase,symconst,symdef,symtable,defutil,paramgr;
 
103
 
 
104
{****************************************************************************
 
105
                                     Helpers
 
106
****************************************************************************}
 
107
 
 
108
    function joinreg64(reglo,reghi : tregister) : tregister64;
 
109
      begin
 
110
         result.reglo:=reglo;
 
111
         result.reghi:=reghi;
 
112
      end;
 
113
 
 
114
 
 
115
    procedure swap64(var q : int64);
 
116
      begin
 
117
         q:=(int64(lo(q)) shl 32) or hi(q);
 
118
      end;
 
119
 
 
120
 
 
121
    procedure splitparaloc64(const cgpara:tcgpara;var cgparalo,cgparahi:tcgpara);
 
122
      var
 
123
        paraloclo,
 
124
        paralochi : pcgparalocation;
 
125
      begin
 
126
        if not(cgpara.size in [OS_64,OS_S64]) then
 
127
          internalerror(200408231);
 
128
        if not assigned(cgpara.location) then
 
129
          internalerror(200408201);
 
130
        { init lo/hi para }
 
131
        cgparahi.reset;
 
132
        if cgpara.size=OS_S64 then
 
133
          cgparahi.size:=OS_S32
 
134
        else
 
135
          cgparahi.size:=OS_32;
 
136
        cgparahi.intsize:=4;
 
137
        cgparahi.alignment:=cgpara.alignment;
 
138
        paralochi:=cgparahi.add_location;
 
139
        cgparalo.reset;
 
140
        cgparalo.size:=OS_32;
 
141
        cgparalo.intsize:=4;
 
142
        cgparalo.alignment:=cgpara.alignment;
 
143
        paraloclo:=cgparalo.add_location;
 
144
        { 2 parameter fields? }
 
145
        if assigned(cgpara.location^.next) then
 
146
          begin
 
147
            { Order for multiple locations is always
 
148
                paraloc^ -> high
 
149
                paraloc^.next -> low }
 
150
            if (target_info.endian=ENDIAN_BIG) then
 
151
              begin
 
152
                { paraloc^ -> high
 
153
                  paraloc^.next -> low }
 
154
                move(cgpara.location^,paralochi^,sizeof(paralochi^));
 
155
                move(cgpara.location^.next^,paraloclo^,sizeof(paraloclo^));
 
156
              end
 
157
            else
 
158
              begin
 
159
                { paraloc^ -> low
 
160
                  paraloc^.next -> high }
 
161
                move(cgpara.location^,paraloclo^,sizeof(paraloclo^));
 
162
                move(cgpara.location^.next^,paralochi^,sizeof(paralochi^));
 
163
              end;
 
164
          end
 
165
        else
 
166
          begin
 
167
            { single parameter, this can only be in memory }
 
168
            if cgpara.location^.loc<>LOC_REFERENCE then
 
169
              internalerror(200408282);
 
170
            move(cgpara.location^,paraloclo^,sizeof(paraloclo^));
 
171
            move(cgpara.location^,paralochi^,sizeof(paralochi^));
 
172
            { for big endian low is at +4, for little endian high }
 
173
            if target_info.endian = endian_big then
 
174
              inc(cgparalo.location^.reference.offset,4)
 
175
            else
 
176
              inc(cgparahi.location^.reference.offset,4);
 
177
          end;
 
178
        { fix size }
 
179
        paraloclo^.size:=cgparalo.size;
 
180
        paraloclo^.next:=nil;
 
181
        paralochi^.size:=cgparahi.size;
 
182
        paralochi^.next:=nil;
 
183
      end;
 
184
 
 
185
 
 
186
{****************************************************************************
 
187
                                   TCG64F32
 
188
****************************************************************************}
 
189
 
 
190
    procedure tcg64f32.a_load64_reg_ref(list : TAsmList;reg : tregister64;const ref : treference);
 
191
      var
 
192
        tmpreg: tregister;
 
193
        tmpref: treference;
 
194
      begin
 
195
        if target_info.endian = endian_big then
 
196
          begin
 
197
            tmpreg:=reg.reglo;
 
198
            reg.reglo:=reg.reghi;
 
199
            reg.reghi:=tmpreg;
 
200
          end;
 
201
        cg.a_load_reg_ref(list,OS_32,OS_32,reg.reglo,ref);
 
202
        tmpref := ref;
 
203
        inc(tmpref.offset,4);
 
204
        cg.a_load_reg_ref(list,OS_32,OS_32,reg.reghi,tmpref);
 
205
      end;
 
206
 
 
207
 
 
208
    procedure tcg64f32.a_load64_const_ref(list : TAsmList;value : int64;const ref : treference);
 
209
      var
 
210
        tmpref: treference;
 
211
      begin
 
212
        if target_info.endian = endian_big then
 
213
          swap64(value);
 
214
        cg.a_load_const_ref(list,OS_32,aint(lo(value)),ref);
 
215
        tmpref := ref;
 
216
        inc(tmpref.offset,4);
 
217
        cg.a_load_const_ref(list,OS_32,aint(hi(value)),tmpref);
 
218
      end;
 
219
 
 
220
 
 
221
    procedure tcg64f32.a_load64_ref_reg(list : TAsmList;const ref : treference;reg : tregister64);
 
222
      var
 
223
        tmpreg: tregister;
 
224
        tmpref: treference;
 
225
      begin
 
226
        if target_info.endian = endian_big then
 
227
          begin
 
228
            tmpreg := reg.reglo;
 
229
            reg.reglo := reg.reghi;
 
230
            reg.reghi := tmpreg;
 
231
          end;
 
232
        tmpref := ref;
 
233
        if (tmpref.base=reg.reglo) then
 
234
         begin
 
235
           tmpreg:=cg.getaddressregister(list);
 
236
           cg.a_load_reg_reg(list,OS_ADDR,OS_ADDR,tmpref.base,tmpreg);
 
237
           tmpref.base:=tmpreg;
 
238
         end
 
239
        else
 
240
         { this works only for the i386, thus the i386 needs to override  }
 
241
         { this method and this method must be replaced by a more generic }
 
242
         { implementation FK                                              }
 
243
         if (tmpref.index=reg.reglo) then
 
244
          begin
 
245
            tmpreg:=cg.getaddressregister(list);
 
246
            cg.a_load_reg_reg(list,OS_ADDR,OS_ADDR,tmpref.index,tmpreg);
 
247
            tmpref.index:=tmpreg;
 
248
          end;
 
249
        cg.a_load_ref_reg(list,OS_32,OS_32,tmpref,reg.reglo);
 
250
        inc(tmpref.offset,4);
 
251
        cg.a_load_ref_reg(list,OS_32,OS_32,tmpref,reg.reghi);
 
252
      end;
 
253
 
 
254
 
 
255
    procedure tcg64f32.a_load64_reg_reg(list : TAsmList;regsrc,regdst : tregister64);
 
256
 
 
257
      begin
 
258
        cg.a_load_reg_reg(list,OS_32,OS_32,regsrc.reglo,regdst.reglo);
 
259
        cg.a_load_reg_reg(list,OS_32,OS_32,regsrc.reghi,regdst.reghi);
 
260
      end;
 
261
 
 
262
 
 
263
    procedure tcg64f32.a_load64_const_reg(list : TAsmList;value : int64;reg : tregister64);
 
264
 
 
265
      begin
 
266
        cg.a_load_const_reg(list,OS_32,aint(lo(value)),reg.reglo);
 
267
        cg.a_load_const_reg(list,OS_32,aint(hi(value)),reg.reghi);
 
268
      end;
 
269
 
 
270
 
 
271
    procedure tcg64f32.a_load64_subsetref_reg(list : TAsmList; const sref: tsubsetreference; destreg: tregister64);
 
272
 
 
273
      var
 
274
        tmpreg: tregister;
 
275
        tmpsref: tsubsetreference;
 
276
      begin
 
277
        if (sref.bitindexreg <> NR_NO) or
 
278
           (sref.bitlen <> 64) then
 
279
          internalerror(2006082310);
 
280
        if (sref.startbit = 0) then
 
281
          begin
 
282
            a_load64_ref_reg(list,sref.ref,destreg);
 
283
            exit;
 
284
          end;
 
285
 
 
286
        if target_info.endian = endian_big then
 
287
          begin
 
288
            tmpreg := destreg.reglo;
 
289
            destreg.reglo := destreg.reghi;
 
290
            destreg.reghi := tmpreg;
 
291
          end;
 
292
        tmpsref:=sref;
 
293
        if (tmpsref.ref.base=destreg.reglo) then
 
294
         begin
 
295
           tmpreg:=cg.getaddressregister(list);
 
296
           cg.a_load_reg_reg(list,OS_ADDR,OS_ADDR,tmpsref.ref.base,tmpreg);
 
297
           tmpsref.ref.base:=tmpreg;
 
298
         end
 
299
        else
 
300
         if (tmpsref.ref.index=destreg.reglo) then
 
301
          begin
 
302
            tmpreg:=cg.getaddressregister(list);
 
303
            cg.a_load_reg_reg(list,OS_ADDR,OS_ADDR,tmpsref.ref.index,tmpreg);
 
304
            tmpsref.ref.index:=tmpreg;
 
305
          end;
 
306
        tmpsref.bitlen:=32;
 
307
        cg.a_load_subsetref_reg(list,OS_32,OS_32,tmpsref,destreg.reglo);
 
308
        inc(tmpsref.ref.offset,4);
 
309
        cg.a_load_subsetref_reg(list,OS_32,OS_32,tmpsref,destreg.reghi);
 
310
      end;
 
311
 
 
312
 
 
313
    procedure tcg64f32.a_load64_reg_subsetref(list : TAsmList; fromreg: tregister64; const sref: tsubsetreference);
 
314
 
 
315
      var
 
316
        tmpreg: tregister;
 
317
        tmpsref: tsubsetreference;
 
318
      begin
 
319
        if (sref.bitindexreg <> NR_NO) or
 
320
           (sref.bitlen <> 64) then
 
321
          internalerror(2006082311);
 
322
        if (sref.startbit = 0) then
 
323
          begin
 
324
            a_load64_reg_ref(list,fromreg,sref.ref);
 
325
            exit;
 
326
          end;
 
327
 
 
328
        if target_info.endian = endian_big then
 
329
          begin
 
330
            tmpreg:=fromreg.reglo;
 
331
            fromreg.reglo:=fromreg.reghi;
 
332
            fromreg.reghi:=tmpreg;
 
333
          end;
 
334
        tmpsref:=sref;
 
335
        tmpsref.bitlen:=32;
 
336
        cg.a_load_reg_subsetref(list,OS_32,OS_32,fromreg.reglo,tmpsref);
 
337
        inc(tmpsref.ref.offset,4);
 
338
        cg.a_load_reg_subsetref(list,OS_32,OS_32,fromreg.reghi,tmpsref);
 
339
      end;
 
340
 
 
341
 
 
342
    procedure tcg64f32.a_load64_const_subsetref(list: TAsmlist; a: int64; const sref: tsubsetreference);
 
343
 
 
344
      var
 
345
        tmpsref: tsubsetreference;
 
346
      begin
 
347
        if (sref.bitindexreg <> NR_NO) or
 
348
           (sref.bitlen <> 64) then
 
349
          internalerror(2006082312);
 
350
        if target_info.endian = endian_big then
 
351
          swap64(a);
 
352
        tmpsref := sref;
 
353
        tmpsref.bitlen := 32;
 
354
        cg.a_load_const_subsetref(list,OS_32,aint(lo(a)),tmpsref);
 
355
        inc(tmpsref.ref.offset,4);
 
356
        cg.a_load_const_subsetref(list,OS_32,aint(hi(a)),tmpsref);
 
357
      end;
 
358
 
 
359
 
 
360
 
 
361
 
 
362
    procedure tcg64f32.a_load64_subsetref_subsetref(list: TAsmlist; const fromsref, tosref: tsubsetreference);
 
363
 
 
364
      var
 
365
        tmpreg64 : tregister64;
 
366
      begin
 
367
        tmpreg64.reglo:=cg.getintregister(list,OS_32);
 
368
        tmpreg64.reghi:=cg.getintregister(list,OS_32);
 
369
        a_load64_subsetref_reg(list,fromsref,tmpreg64);
 
370
        a_load64_reg_subsetref(list,tmpreg64,tosref);
 
371
      end;
 
372
 
 
373
 
 
374
    procedure tcg64f32.a_load64_subsetref_ref(list : TAsmList; const sref: tsubsetreference; const destref: treference);
 
375
 
 
376
      var
 
377
        tmpreg64 : tregister64;
 
378
      begin
 
379
        tmpreg64.reglo:=cg.getintregister(list,OS_32);
 
380
        tmpreg64.reghi:=cg.getintregister(list,OS_32);
 
381
        a_load64_subsetref_reg(list,sref,tmpreg64);
 
382
        a_load64_reg_ref(list,tmpreg64,destref);
 
383
      end;
 
384
 
 
385
 
 
386
    procedure tcg64f32.a_load64_ref_subsetref(list : TAsmList; const fromref: treference; const sref: tsubsetreference);
 
387
 
 
388
      var
 
389
        tmpreg64 : tregister64;
 
390
      begin
 
391
        tmpreg64.reglo:=cg.getintregister(list,OS_32);
 
392
        tmpreg64.reghi:=cg.getintregister(list,OS_32);
 
393
        a_load64_ref_reg(list,fromref,tmpreg64);
 
394
        a_load64_reg_subsetref(list,tmpreg64,sref);
 
395
      end;
 
396
 
 
397
 
 
398
    procedure tcg64f32.a_load64_loc_reg(list : TAsmList;const l : tlocation;reg : tregister64);
 
399
 
 
400
      begin
 
401
        case l.loc of
 
402
          LOC_REFERENCE, LOC_CREFERENCE:
 
403
            a_load64_ref_reg(list,l.reference,reg);
 
404
          LOC_REGISTER,LOC_CREGISTER:
 
405
            a_load64_reg_reg(list,l.register64,reg);
 
406
          LOC_CONSTANT :
 
407
            a_load64_const_reg(list,l.value64,reg);
 
408
          LOC_SUBSETREF, LOC_CSUBSETREF:
 
409
            a_load64_subsetref_reg(list,l.sref,reg);
 
410
          else
 
411
            internalerror(200112292);
 
412
        end;
 
413
      end;
 
414
 
 
415
 
 
416
    procedure tcg64f32.a_load64_loc_ref(list : TAsmList;const l : tlocation;const ref : treference);
 
417
      begin
 
418
        case l.loc of
 
419
          LOC_REGISTER,LOC_CREGISTER:
 
420
            a_load64_reg_ref(list,l.register64,ref);
 
421
          LOC_CONSTANT :
 
422
            a_load64_const_ref(list,l.value64,ref);
 
423
          LOC_SUBSETREF, LOC_CSUBSETREF:
 
424
            a_load64_subsetref_ref(list,l.sref,ref);
 
425
          else
 
426
            internalerror(200203288);
 
427
        end;
 
428
      end;
 
429
 
 
430
 
 
431
    procedure tcg64f32.a_load64_const_loc(list : TAsmList;value : int64;const l : tlocation);
 
432
 
 
433
      begin
 
434
        case l.loc of
 
435
          LOC_REFERENCE, LOC_CREFERENCE:
 
436
            a_load64_const_ref(list,value,l.reference);
 
437
          LOC_REGISTER,LOC_CREGISTER:
 
438
            a_load64_const_reg(list,value,l.register64);
 
439
          LOC_SUBSETREF, LOC_CSUBSETREF:
 
440
            a_load64_const_subsetref(list,value,l.sref);
 
441
          else
 
442
            internalerror(200112293);
 
443
        end;
 
444
      end;
 
445
 
 
446
 
 
447
    procedure tcg64f32.a_load64_reg_loc(list : TAsmList;reg : tregister64;const l : tlocation);
 
448
 
 
449
      begin
 
450
        case l.loc of
 
451
          LOC_REFERENCE, LOC_CREFERENCE:
 
452
            a_load64_reg_ref(list,reg,l.reference);
 
453
          LOC_REGISTER,LOC_CREGISTER:
 
454
            a_load64_reg_reg(list,reg,l.register64);
 
455
          LOC_SUBSETREF, LOC_CSUBSETREF:
 
456
            a_load64_reg_subsetref(list,reg,l.sref);
 
457
          else
 
458
            internalerror(200112293);
 
459
        end;
 
460
      end;
 
461
 
 
462
 
 
463
    procedure tcg64f32.a_load64high_reg_ref(list : TAsmList;reg : tregister;const ref : treference);
 
464
      var
 
465
        tmpref: treference;
 
466
      begin
 
467
        if target_info.endian = endian_big then
 
468
          cg.a_load_reg_ref(list,OS_32,OS_32,reg,ref)
 
469
        else
 
470
          begin
 
471
            tmpref := ref;
 
472
            inc(tmpref.offset,4);
 
473
            cg.a_load_reg_ref(list,OS_32,OS_32,reg,tmpref)
 
474
          end;
 
475
      end;
 
476
 
 
477
    procedure tcg64f32.a_load64low_reg_ref(list : TAsmList;reg : tregister;const ref : treference);
 
478
      var
 
479
        tmpref: treference;
 
480
      begin
 
481
        if target_info.endian = endian_little then
 
482
          cg.a_load_reg_ref(list,OS_32,OS_32,reg,ref)
 
483
        else
 
484
          begin
 
485
            tmpref := ref;
 
486
            inc(tmpref.offset,4);
 
487
            cg.a_load_reg_ref(list,OS_32,OS_32,reg,tmpref)
 
488
          end;
 
489
      end;
 
490
 
 
491
 
 
492
    procedure tcg64f32.a_load64high_ref_reg(list : TAsmList;const ref : treference;reg : tregister);
 
493
      var
 
494
        tmpref: treference;
 
495
      begin
 
496
        if target_info.endian = endian_big then
 
497
          cg.a_load_ref_reg(list,OS_32,OS_32,ref,reg)
 
498
        else
 
499
          begin
 
500
            tmpref := ref;
 
501
            inc(tmpref.offset,4);
 
502
            cg.a_load_ref_reg(list,OS_32,OS_32,tmpref,reg)
 
503
          end;
 
504
      end;
 
505
 
 
506
 
 
507
    procedure tcg64f32.a_load64low_ref_reg(list : TAsmList;const ref : treference;reg : tregister);
 
508
      var
 
509
        tmpref: treference;
 
510
      begin
 
511
        if target_info.endian = endian_little then
 
512
          cg.a_load_ref_reg(list,OS_32,OS_32,ref,reg)
 
513
        else
 
514
          begin
 
515
            tmpref := ref;
 
516
            inc(tmpref.offset,4);
 
517
            cg.a_load_ref_reg(list,OS_32,OS_32,tmpref,reg)
 
518
          end;
 
519
      end;
 
520
 
 
521
 
 
522
    procedure tcg64f32.a_load64low_loc_reg(list : TAsmList;const l : tlocation;reg : tregister);
 
523
      begin
 
524
        case l.loc of
 
525
          LOC_REFERENCE,
 
526
          LOC_CREFERENCE :
 
527
            a_load64low_ref_reg(list,l.reference,reg);
 
528
          LOC_REGISTER,
 
529
          LOC_CREGISTER :
 
530
            cg.a_load_reg_reg(list,OS_32,OS_32,l.register64.reglo,reg);
 
531
          LOC_CONSTANT :
 
532
            cg.a_load_const_reg(list,OS_32,aint(lo(l.value64)),reg);
 
533
          else
 
534
            internalerror(200203244);
 
535
        end;
 
536
      end;
 
537
 
 
538
 
 
539
    procedure tcg64f32.a_load64high_loc_reg(list : TAsmList;const l : tlocation;reg : tregister);
 
540
      begin
 
541
        case l.loc of
 
542
          LOC_REFERENCE,
 
543
          LOC_CREFERENCE :
 
544
            a_load64high_ref_reg(list,l.reference,reg);
 
545
          LOC_REGISTER,
 
546
          LOC_CREGISTER :
 
547
            cg.a_load_reg_reg(list,OS_32,OS_32,l.register64.reghi,reg);
 
548
          LOC_CONSTANT :
 
549
            cg.a_load_const_reg(list,OS_32,aint(hi(l.value64)),reg);
 
550
          else
 
551
            internalerror(200203244);
 
552
        end;
 
553
      end;
 
554
 
 
555
 
 
556
    procedure tcg64f32.a_op64_const_loc(list : TAsmList;op:TOpCG;size : tcgsize;value : int64;const l: tlocation);
 
557
      begin
 
558
        case l.loc of
 
559
          LOC_REFERENCE, LOC_CREFERENCE:
 
560
            a_op64_const_ref(list,op,size,value,l.reference);
 
561
          LOC_REGISTER,LOC_CREGISTER:
 
562
            a_op64_const_reg(list,op,size,value,l.register64);
 
563
          else
 
564
            internalerror(200203292);
 
565
        end;
 
566
      end;
 
567
 
 
568
 
 
569
    procedure tcg64f32.a_op64_reg_loc(list : TAsmList;op:TOpCG;size : tcgsize;reg : tregister64;const l : tlocation);
 
570
      begin
 
571
        case l.loc of
 
572
          LOC_REFERENCE, LOC_CREFERENCE:
 
573
            a_op64_reg_ref(list,op,size,reg,l.reference);
 
574
          LOC_REGISTER,LOC_CREGISTER:
 
575
            a_op64_reg_reg(list,op,size,reg,l.register64);
 
576
          else
 
577
            internalerror(2002032422);
 
578
        end;
 
579
      end;
 
580
 
 
581
 
 
582
 
 
583
    procedure tcg64f32.a_op64_loc_reg(list : TAsmList;op:TOpCG;size : tcgsize;const l : tlocation;reg : tregister64);
 
584
      begin
 
585
        case l.loc of
 
586
          LOC_REFERENCE, LOC_CREFERENCE:
 
587
            a_op64_ref_reg(list,op,size,l.reference,reg);
 
588
          LOC_REGISTER,LOC_CREGISTER:
 
589
            a_op64_reg_reg(list,op,size,l.register64,reg);
 
590
          LOC_CONSTANT :
 
591
            a_op64_const_reg(list,op,size,l.value64,reg);
 
592
          else
 
593
            internalerror(200203242);
 
594
        end;
 
595
      end;
 
596
 
 
597
 
 
598
    procedure tcg64f32.a_op64_ref_reg(list : TAsmList;op:TOpCG;size : tcgsize;const ref : treference;reg : tregister64);
 
599
      var
 
600
        tempreg: tregister64;
 
601
      begin
 
602
        tempreg.reghi:=cg.getintregister(list,OS_32);
 
603
        tempreg.reglo:=cg.getintregister(list,OS_32);
 
604
        a_load64_ref_reg(list,ref,tempreg);
 
605
        a_op64_reg_reg(list,op,size,tempreg,reg);
 
606
      end;
 
607
 
 
608
 
 
609
    procedure tcg64f32.a_op64_reg_ref(list : TAsmList;op:TOpCG;size : tcgsize;reg : tregister64; const ref: treference);
 
610
      var
 
611
        tempreg: tregister64;
 
612
      begin
 
613
        tempreg.reghi:=cg.getintregister(list,OS_32);
 
614
        tempreg.reglo:=cg.getintregister(list,OS_32);
 
615
        a_load64_ref_reg(list,ref,tempreg);
 
616
        a_op64_reg_reg(list,op,size,reg,tempreg);
 
617
        a_load64_reg_ref(list,tempreg,ref);
 
618
      end;
 
619
 
 
620
 
 
621
    procedure tcg64f32.a_op64_const_ref(list : TAsmList;op:TOpCG;size : tcgsize;value : int64;const ref : treference);
 
622
      var
 
623
        tempreg: tregister64;
 
624
      begin
 
625
        tempreg.reghi:=cg.getintregister(list,OS_32);
 
626
        tempreg.reglo:=cg.getintregister(list,OS_32);
 
627
        a_load64_ref_reg(list,ref,tempreg);
 
628
        a_op64_const_reg(list,op,size,value,tempreg);
 
629
        a_load64_reg_ref(list,tempreg,ref);
 
630
      end;
 
631
 
 
632
 
 
633
    procedure tcg64f32.a_param64_reg(list : TAsmList;reg : tregister64;const paraloc : tcgpara);
 
634
      var
 
635
        tmplochi,tmploclo: tcgpara;
 
636
      begin
 
637
        tmploclo.init;
 
638
        tmplochi.init;
 
639
        splitparaloc64(paraloc,tmploclo,tmplochi);
 
640
        { Keep this order of first hi before lo to have
 
641
          the correct push order for i386 }
 
642
        cg.a_param_reg(list,OS_32,reg.reghi,tmplochi);
 
643
        cg.a_param_reg(list,OS_32,reg.reglo,tmploclo);
 
644
        tmploclo.done;
 
645
        tmplochi.done;
 
646
      end;
 
647
 
 
648
 
 
649
    procedure tcg64f32.a_param64_const(list : TAsmList;value : int64;const paraloc : tcgpara);
 
650
      var
 
651
        tmplochi,tmploclo: tcgpara;
 
652
      begin
 
653
        tmploclo.init;
 
654
        tmplochi.init;
 
655
        splitparaloc64(paraloc,tmploclo,tmplochi);
 
656
        { Keep this order of first hi before lo to have
 
657
          the correct push order for i386 }
 
658
        cg.a_param_const(list,OS_32,aint(hi(value)),tmplochi);
 
659
        cg.a_param_const(list,OS_32,aint(lo(value)),tmploclo);
 
660
        tmploclo.done;
 
661
        tmplochi.done;
 
662
      end;
 
663
 
 
664
 
 
665
    procedure tcg64f32.a_param64_ref(list : TAsmList;const r : treference;const paraloc : tcgpara);
 
666
      var
 
667
        tmprefhi,tmpreflo : treference;
 
668
        tmploclo,tmplochi : tcgpara;
 
669
      begin
 
670
        tmploclo.init;
 
671
        tmplochi.init;
 
672
        splitparaloc64(paraloc,tmploclo,tmplochi);
 
673
        tmprefhi:=r;
 
674
        tmpreflo:=r;
 
675
        if target_info.endian=endian_big then
 
676
          inc(tmpreflo.offset,4)
 
677
        else
 
678
          inc(tmprefhi.offset,4);
 
679
        { Keep this order of first hi before lo to have
 
680
          the correct push order for i386 }
 
681
        cg.a_param_ref(list,OS_32,tmprefhi,tmplochi);
 
682
        cg.a_param_ref(list,OS_32,tmpreflo,tmploclo);
 
683
        tmploclo.done;
 
684
        tmplochi.done;
 
685
      end;
 
686
 
 
687
 
 
688
    procedure tcg64f32.a_param64_loc(list : TAsmList;const l:tlocation;const paraloc : tcgpara);
 
689
      begin
 
690
        case l.loc of
 
691
          LOC_REGISTER,
 
692
          LOC_CREGISTER :
 
693
            a_param64_reg(list,l.register64,paraloc);
 
694
          LOC_CONSTANT :
 
695
            a_param64_const(list,l.value64,paraloc);
 
696
          LOC_CREFERENCE,
 
697
          LOC_REFERENCE :
 
698
            a_param64_ref(list,l.reference,paraloc);
 
699
          else
 
700
            internalerror(200203287);
 
701
        end;
 
702
      end;
 
703
 
 
704
 
 
705
    procedure tcg64f32.g_rangecheck64(list : TAsmList;const l:tlocation;fromdef,todef:tdef);
 
706
 
 
707
      var
 
708
        neglabel,
 
709
        poslabel,
 
710
        endlabel: tasmlabel;
 
711
        hreg   : tregister;
 
712
        hdef   :  torddef;
 
713
        opsize   : tcgsize;
 
714
        from_signed,to_signed: boolean;
 
715
        temploc : tlocation;
 
716
 
 
717
      begin
 
718
         from_signed := is_signed(fromdef);
 
719
         to_signed := is_signed(todef);
 
720
 
 
721
         if not is_64bit(todef) then
 
722
           begin
 
723
             { get the high dword in a register }
 
724
             if l.loc in [LOC_REGISTER,LOC_CREGISTER] then
 
725
               begin
 
726
                 hreg := l.register64.reghi;
 
727
               end
 
728
             else
 
729
               begin
 
730
                 hreg:=cg.getintregister(list,OS_32);
 
731
                 a_load64high_ref_reg(list,l.reference,hreg);
 
732
               end;
 
733
             current_asmdata.getjumplabel(poslabel);
 
734
 
 
735
             { check high dword, must be 0 (for positive numbers) }
 
736
             cg.a_cmp_const_reg_label(list,OS_32,OC_EQ,0,hreg,poslabel);
 
737
 
 
738
             { It can also be $ffffffff, but only for negative numbers }
 
739
             if from_signed and to_signed then
 
740
               begin
 
741
                 current_asmdata.getjumplabel(neglabel);
 
742
                 cg.a_cmp_const_reg_label(list,OS_32,OC_EQ,-1,hreg,neglabel);
 
743
               end;
 
744
             { For all other values we have a range check error }
 
745
             cg.a_call_name(list,'FPC_RANGEERROR');
 
746
 
 
747
             { if the high dword = 0, the low dword can be considered a }
 
748
             { simple cardinal                                          }
 
749
             cg.a_label(list,poslabel);
 
750
             hdef:=torddef.create(u32bit,0,$ffffffff);
 
751
 
 
752
             location_copy(temploc,l);
 
753
             temploc.size:=OS_32;
 
754
 
 
755
             if (temploc.loc in [LOC_REFERENCE,LOC_CREFERENCE]) and
 
756
                (target_info.endian = endian_big) then
 
757
               inc(temploc.reference.offset,4);
 
758
 
 
759
             cg.g_rangecheck(list,temploc,hdef,todef);
 
760
             hdef.owner.deletedef(hdef);
 
761
 
 
762
             if from_signed and to_signed then
 
763
               begin
 
764
                 current_asmdata.getjumplabel(endlabel);
 
765
                 cg.a_jmp_always(list,endlabel);
 
766
                 { if the high dword = $ffffffff, then the low dword (when }
 
767
                 { considered as a longint) must be < 0                    }
 
768
                 cg.a_label(list,neglabel);
 
769
                 if l.loc in [LOC_REGISTER,LOC_CREGISTER] then
 
770
                   begin
 
771
                     hreg := l.register64.reglo;
 
772
                   end
 
773
                 else
 
774
                   begin
 
775
                     hreg:=cg.getintregister(list,OS_32);
 
776
                     a_load64low_ref_reg(list,l.reference,hreg);
 
777
                   end;
 
778
                 { get a new neglabel (JM) }
 
779
                 current_asmdata.getjumplabel(neglabel);
 
780
                 cg.a_cmp_const_reg_label(list,OS_32,OC_LT,0,hreg,neglabel);
 
781
 
 
782
                 cg.a_call_name(list,'FPC_RANGEERROR');
 
783
 
 
784
                 { if we get here, the 64bit value lies between }
 
785
                 { longint($80000000) and -1 (JM)               }
 
786
                 cg.a_label(list,neglabel);
 
787
                 hdef:=torddef.create(s32bit,longint($80000000),-1);
 
788
                 location_copy(temploc,l);
 
789
                 temploc.size:=OS_32;
 
790
                 cg.g_rangecheck(list,temploc,hdef,todef);
 
791
                 hdef.owner.deletedef(hdef);
 
792
                 cg.a_label(list,endlabel);
 
793
               end;
 
794
           end
 
795
         else
 
796
           { todef = 64bit int }
 
797
           { no 64bit subranges supported, so only a small check is necessary }
 
798
 
 
799
           { if both are signed or both are unsigned, no problem! }
 
800
           if (from_signed xor to_signed) and
 
801
              { also not if the fromdef is unsigned and < 64bit, since that will }
 
802
              { always fit in a 64bit int (todef is 64bit)                       }
 
803
              (from_signed or
 
804
               (torddef(fromdef).ordtype = u64bit)) then
 
805
             begin
 
806
               { in all cases, there is only a problem if the higest bit is set }
 
807
               if l.loc in [LOC_REGISTER,LOC_CREGISTER] then
 
808
                 begin
 
809
                   if is_64bit(fromdef) then
 
810
                     begin
 
811
                       hreg := l.register64.reghi;
 
812
                       opsize := OS_32;
 
813
                     end
 
814
                   else
 
815
                     begin
 
816
                       hreg := l.register;
 
817
                       opsize := def_cgsize(fromdef);
 
818
                     end;
 
819
                 end
 
820
               else
 
821
                 begin
 
822
                   hreg:=cg.getintregister(list,OS_32);
 
823
                   opsize:=OS_32;
 
824
 
 
825
                   if l.size in [OS_64,OS_S64] then
 
826
                     a_load64high_ref_reg(list,l.reference,hreg)
 
827
                   else
 
828
                     cg.a_load_ref_reg(list,l.size,OS_32,l.reference,hreg);
 
829
                 end;
 
830
               current_asmdata.getjumplabel(poslabel);
 
831
               cg.a_cmp_const_reg_label(list,opsize,OC_GTE,0,hreg,poslabel);
 
832
 
 
833
               cg.a_call_name(list,'FPC_RANGEERROR');
 
834
               cg.a_label(list,poslabel);
 
835
             end;
 
836
      end;
 
837
 
 
838
 
 
839
    function tcg64f32.optimize64_op_const_reg(list: TAsmList; var op: topcg; var a : int64; var reg: tregister64): boolean;
 
840
      var
 
841
        lowvalue, highvalue : longint;
 
842
        hreg: tregister;
 
843
      begin
 
844
        lowvalue := longint(a);
 
845
        highvalue:= longint(a shr 32);
 
846
        { assume it will be optimized out }
 
847
        optimize64_op_const_reg := true;
 
848
        case op of
 
849
        OP_ADD:
 
850
           begin
 
851
             if a = 0 then
 
852
                exit;
 
853
           end;
 
854
        OP_AND:
 
855
           begin
 
856
              if lowvalue <> -1 then
 
857
                cg.a_op_const_reg(list,op,OS_32,lowvalue,reg.reglo);
 
858
              if highvalue <> -1 then
 
859
                cg.a_op_const_reg(list,op,OS_32,highvalue,reg.reghi);
 
860
              { already emitted correctly }
 
861
              exit;
 
862
           end;
 
863
        OP_OR:
 
864
           begin
 
865
              if lowvalue <> 0 then
 
866
                cg.a_op_const_reg(list,op,OS_32,lowvalue,reg.reglo);
 
867
              if highvalue <> 0 then
 
868
                cg.a_op_const_reg(list,op,OS_32,highvalue,reg.reghi);
 
869
              { already emitted correctly }
 
870
              exit;
 
871
           end;
 
872
        OP_SUB:
 
873
           begin
 
874
             if a = 0 then
 
875
                exit;
 
876
           end;
 
877
        OP_XOR:
 
878
           begin
 
879
           end;
 
880
        OP_SHL:
 
881
           begin
 
882
             if a = 0 then
 
883
                 exit;
 
884
             { simply clear low-register
 
885
               and shift the rest and swap
 
886
               registers.
 
887
             }
 
888
             if (a > 31) then
 
889
               begin
 
890
                 cg.a_load_const_reg(list,OS_32,0,reg.reglo);
 
891
                 cg.a_op_const_reg(list,OP_SHL,OS_32,a mod 32,reg.reghi);
 
892
                 { swap the registers }
 
893
                 hreg := reg.reghi;
 
894
                 reg.reghi := reg.reglo;
 
895
                 reg.reglo := hreg;
 
896
                 exit;
 
897
               end;
 
898
           end;
 
899
        OP_SHR:
 
900
           begin
 
901
             if a = 0 then exit;
 
902
             { simply clear high-register
 
903
               and shift the rest and swap
 
904
               registers.
 
905
             }
 
906
             if (a > 31) then
 
907
               begin
 
908
                 cg.a_load_const_reg(list,OS_32,0,reg.reghi);
 
909
                 cg.a_op_const_reg(list,OP_SHL,OS_32,a mod 32,reg.reglo);
 
910
                 { swap the registers }
 
911
                 hreg := reg.reghi;
 
912
                 reg.reghi := reg.reglo;
 
913
                 reg.reglo := hreg;
 
914
                 exit;
 
915
               end;
 
916
           end;
 
917
        OP_IMUL,OP_MUL:
 
918
           begin
 
919
             if a = 1 then exit;
 
920
           end;
 
921
        OP_IDIV,OP_DIV:
 
922
            begin
 
923
             if a = 1 then exit;
 
924
            end;
 
925
        else
 
926
           internalerror(20020817);
 
927
        end;
 
928
        optimize64_op_const_reg := false;
 
929
      end;
 
930
 
 
931
end.