← Back to branch summary

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

« back to all changes in this revision

Viewing changes to compiler/m68k/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/m68k/cgcpu.pas
1
 
{
2
 
    $Id: cgcpu.pas,v 1.27 2004/05/20 21:54:33 florian Exp $
3
 
    Copyright (c) 1998-2002 by the FPC team
4
 
 
5
 
    This unit implements the code generator for the 680x0
6
 
 
7
 
    This program is free software; you can redistribute it and/or modify
8
 
    it under the terms of the GNU General Public License as published by
9
 
    the Free Software Foundation; either version 2 of the License, or
10
 
    (at your option) any later version.
11
 
 
12
 
    This program is distributed in the hope that it will be useful,
13
 
    but WITHOUT ANY WARRANTY; without even the implied warranty of
14
 
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
15
 
    GNU General Public License for more details.
16
 
 
17
 
    You should have received a copy of the GNU General Public License
18
 
    along with this program; if not, write to the Free Software
19
 
    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
20
 
 
21
 
 ****************************************************************************
22
 
}
23
 
unit cgcpu;
24
 
 
25
 
{$i fpcdefs.inc}
26
 
 
27
 
  interface
28
 
 
29
 
    uses
30
 
       cgbase,cgobj,
31
 
       aasmbase,aasmtai,aasmcpu,
32
 
       cpubase,cpuinfo,cpupara,
33
 
       node,symconst,symtype,
34
 
       cg64f32;
35
 
 
36
 
    type
37
 
      tcg68k = class(tcg)
38
 
          procedure init_register_allocators;override;
39
 
          procedure done_register_allocators;override;
40
 
          procedure a_call_name(list : taasmoutput;const s : string);override;
41
 
          procedure a_call_reg(list : taasmoutput;reg : tregister);override;
42
 
          procedure a_load_const_reg(list : taasmoutput;size : tcgsize;a : aword;register : tregister);override;
43
 
          procedure a_load_reg_ref(list : taasmoutput;fromsize,tosize : tcgsize;register : tregister;const ref : treference);override;
44
 
          procedure a_load_reg_reg(list : taasmoutput;fromsize,tosize : tcgsize;reg1,reg2 : tregister);override;
45
 
          procedure a_load_ref_reg(list : taasmoutput;fromsize,tosize : tcgsize;const ref : treference;register : tregister);override;
46
 
          procedure a_loadaddr_ref_reg(list : taasmoutput;const ref : treference;r : tregister);override;
47
 
          procedure a_loadfpu_reg_reg(list: taasmoutput; size: tcgsize; reg1, reg2: tregister); override;
48
 
          procedure a_loadfpu_ref_reg(list: taasmoutput; size: tcgsize; const ref: treference; reg: tregister); override;
49
 
          procedure a_loadfpu_reg_ref(list: taasmoutput; size: tcgsize; reg: tregister; const ref: treference); override;
50
 
          procedure a_loadmm_reg_reg(list: taasmoutput;fromsize,tosize : tcgsize; reg1, reg2: tregister;shuffle : pmmshuffle); override;
51
 
          procedure a_loadmm_ref_reg(list: taasmoutput;fromsize,tosize : tcgsize; const ref: treference; reg: tregister;shuffle : pmmshuffle); override;
52
 
          procedure a_loadmm_reg_ref(list: taasmoutput;fromsize,tosize : tcgsize; reg: tregister; const ref: treference;shuffle : pmmshuffle); override;
53
 
          procedure a_parammm_reg(list: taasmoutput; size: tcgsize; reg: tregister;const locpara : tparalocation;shuffle : pmmshuffle); override;
54
 
          procedure a_op_const_reg(list : taasmoutput; Op: TOpCG; size: tcgsize; a: AWord; reg: TRegister); override;
55
 
          procedure a_op_reg_reg(list : taasmoutput; Op: TOpCG; size: TCGSize; reg1, reg2: TRegister); override;
56
 
          procedure a_cmp_const_reg_label(list : taasmoutput;size : tcgsize;cmp_op : topcmp;a : aword;reg : tregister;
57
 
            l : tasmlabel);override;
58
 
          procedure a_cmp_reg_reg_label(list : taasmoutput;size : tcgsize;cmp_op : topcmp;reg1,reg2 : tregister;l : tasmlabel); override;
59
 
          procedure a_jmp_always(list : taasmoutput;l: tasmlabel); override;
60
 
          procedure a_jmp_flags(list : taasmoutput;const f : TResFlags;l: tasmlabel); override;
61
 
          procedure g_flags2reg(list: taasmoutput; size: TCgSize; const f: tresflags; reg: TRegister); override;
62
 
 
63
 
          procedure g_concatcopy(list : taasmoutput;const source,dest : treference;len : aword;delsource,loadref : boolean);override;
64
 
          { generates overflow checking code for a node }
65
 
          procedure g_overflowcheck(list: taasmoutput; const l:tlocation; def:tdef); override;
66
 
          procedure g_copyvaluepara_openarray(list : taasmoutput;const ref, lenref:treference;elesize:aword); override;
67
 
          procedure g_stackframe_entry(list : taasmoutput;localsize : longint);override;
68
 
          procedure g_restore_frame_pointer(list : taasmoutput);override;
69
 
          procedure g_return_from_proc(list : taasmoutput;parasize : aword);override;
70
 
          procedure g_restore_standard_registers(list:Taasmoutput);override;
71
 
          procedure g_save_standard_registers(list:Taasmoutput);override;
72
 
          procedure g_save_all_registers(list : taasmoutput);override;
73
 
          procedure g_restore_all_registers(list : taasmoutput;const funcretparaloc:tparalocation);override;
74
 
     protected
75
 
         function fixref(list: taasmoutput; var ref: treference): boolean;
76
 
     private
77
 
          { # Sign or zero extend the register to a full 32-bit value.
78
 
              The new value is left in the same register.
79
 
          }
80
 
          procedure sign_extend(list: taasmoutput;_oldsize : tcgsize; reg: tregister);
81
 
          procedure a_jmp_cond(list : taasmoutput;cond : TOpCmp;l: tasmlabel);
82
 
 
83
 
     end;
84
 
 
85
 
     tcg64f68k = class(tcg64f32)
86
 
       procedure a_op64_reg_reg(list : taasmoutput;op:TOpCG;regsrc,regdst : tregister64);override;
87
 
       procedure a_op64_const_reg(list : taasmoutput;op:TOpCG;value : qword;reg : tregister64);override;
88
 
     end;
89
 
 
90
 
     { This function returns true if the reference+offset is valid.
91
 
       Otherwise extra code must be generated to solve the reference.
92
 
 
93
 
       On the m68k, this verifies that the reference is valid
94
 
       (e.g : if index register is used, then the max displacement
95
 
        is 256 bytes, if only base is used, then max displacement
96
 
        is 32K
97
 
     }
98
 
     function isvalidrefoffset(const ref: treference): boolean;
99
 
 
100
 
    const
101
 
      TCGSize2OpSize: Array[tcgsize] of topsize =
102
 
        (S_NO,S_B,S_W,S_L,S_L,S_NO,S_B,S_W,S_L,S_L,S_NO,
103
 
         S_FS,S_FD,S_FX,S_NO,S_NO,
104
 
         S_NO,S_NO,S_NO,S_NO,S_NO,S_NO,S_NO,S_NO,S_NO,S_NO);
105
 
 
106
 
 
107
 
  implementation
108
 
 
109
 
    uses
110
 
       globtype,globals,verbose,systems,cutils,
111
 
       symdef,symsym,defutil,paramgr,procinfo,
112
 
       rgobj,tgobj,rgcpu,
113
 
       cgutils;
114
 
 
115
 
 
116
 
    const
117
 
      { opcode table lookup }
118
 
      topcg2tasmop: Array[topcg] of tasmop =
119
 
      (
120
 
       A_NONE,
121
 
       A_ADD,
122
 
       A_AND,
123
 
       A_DIVU,
124
 
       A_DIVS,
125
 
       A_MULS,
126
 
       A_MULU,
127
 
       A_NEG,
128
 
       A_NOT,
129
 
       A_OR,
130
 
       A_ASR,
131
 
       A_LSL,
132
 
       A_LSR,
133
 
       A_SUB,
134
 
       A_EOR
135
 
      );
136
 
 
137
 
 
138
 
      TOpCmp2AsmCond: Array[topcmp] of TAsmCond =
139
 
      (
140
 
       C_NONE,
141
 
       C_EQ,
142
 
       C_GT,
143
 
       C_LT,
144
 
       C_GE,
145
 
       C_LE,
146
 
       C_NE,
147
 
       C_LS,
148
 
       C_CS,
149
 
       C_CC,
150
 
       C_HI
151
 
      );
152
 
 
153
 
 
154
 
     function isvalidrefoffset(const ref: treference): boolean;
155
 
      begin
156
 
         isvalidrefoffset := true;
157
 
         if ref.index <> NR_NO then
158
 
           begin
159
 
             if ref.base <> NR_NO then
160
 
                internalerror(20020814);
161
 
             if (ref.offset < low(shortint)) or (ref.offset > high(shortint)) then
162
 
                isvalidrefoffset := false
163
 
           end
164
 
         else
165
 
           begin
166
 
             if (ref.offset < low(smallint)) or (ref.offset > high(smallint)) then
167
 
                isvalidrefoffset := false;
168
 
           end;
169
 
      end;
170
 
 
171
 
 
172
 
{****************************************************************************}
173
 
{                               TCG68K                                       }
174
 
{****************************************************************************}
175
 
    procedure tcg68k.init_register_allocators;
176
 
      begin
177
 
        inherited init_register_allocators;
178
 
        rg[R_INTREGISTER]:=trgcpu.create(R_INTREGISTER,R_SUBWHOLE,
179
 
          [RS_D0,RS_D1,RS_D2,RS_D3,RS_D4,RS_D5,RS_D6,RS_D7],
180
 
          first_int_imreg,[]);
181
 
        rg[R_ADDRESSREGISTER]:=trgcpu.create(R_ADDRESSREGISTER,R_SUBWHOLE,
182
 
          [RS_A0,RS_A1,RS_A2,RS_A3,RS_A4,RS_A5,RS_A6],
183
 
          first_addr_imreg,[]);
184
 
        rg[R_FPUREGISTER]:=trgcpu.create(R_FPUREGISTER,R_SUBNONE,
185
 
          [RS_FP0,RS_FP1,RS_FP2,RS_FP3,RS_FP4,RS_FP5,RS_FP6,RS_FP7],
186
 
          first_fpu_imreg,[]);
187
 
      end;
188
 
 
189
 
 
190
 
    procedure tcg68k.done_register_allocators;
191
 
      begin
192
 
        rg[R_INTREGISTER].free;
193
 
        rg[R_FPUREGISTER].free;
194
 
        rg[R_ADDRESSREGISTER].free;
195
 
        inherited done_register_allocators;
196
 
      end;
197
 
 
198
 
 
199
 
    function tcg68k.fixref(list: taasmoutput; var ref: treference): boolean;
200
 
 
201
 
       begin
202
 
         result:=false;
203
 
         { The Coldfire and MC68020+ have extended
204
 
           addressing capabilities with a 32-bit
205
 
           displacement.
206
 
         }
207
 
         if (aktoptprocessor<>MC68000) then
208
 
           exit;
209
 
         if (ref.base<>NR_NO) then
210
 
           begin
211
 
             if (ref.index <> NR_NO) and assigned(ref.symbol) then
212
 
                internalerror(20020814);
213
 
             { base + reg }
214
 
             if ref.index <> NR_NO then
215
 
                begin
216
 
                   { base + reg + offset }
217
 
                   if (ref.offset < low(shortint)) or (ref.offset > high(shortint)) then
218
 
                     begin
219
 
                        list.concat(taicpu.op_const_reg(A_ADD,S_L,ref.offset,ref.base));
220
 
                        fixref := true;
221
 
                        ref.offset := 0;
222
 
                        exit;
223
 
                     end;
224
 
                end
225
 
             else
226
 
             { base + offset }
227
 
             if (ref.offset < low(smallint)) or (ref.offset > high(smallint)) then
228
 
               begin
229
 
                 list.concat(taicpu.op_const_reg(A_ADD,S_L,ref.offset,ref.base));
230
 
                 fixref := true;
231
 
                 ref.offset := 0;
232
 
                 exit;
233
 
               end;
234
 
           end;
235
 
       end;
236
 
 
237
 
 
238
 
 
239
 
    procedure tcg68k.a_call_name(list : taasmoutput;const s : string);
240
 
 
241
 
      begin
242
 
        list.concat(taicpu.op_sym(A_JSR,S_NO,objectlibrary.newasmsymbol(s,AB_EXTERNAL,AT_FUNCTION)));
243
 
      end;
244
 
 
245
 
 
246
 
    procedure tcg68k.a_call_reg(list : taasmoutput;reg : tregister);
247
 
     var
248
 
       href : treference;
249
 
     begin
250
 
       reference_reset_base(href, reg, 0);
251
 
       //!!! a_call_ref(list,href);
252
 
     end;
253
 
 
254
 
 
255
 
 
256
 
    procedure tcg68k.a_load_const_reg(list : taasmoutput;size : tcgsize;a : aword;register : tregister);
257
 
      begin
258
 
        if getregtype(register)=R_ADDRESSREGISTER then
259
 
         begin
260
 
           list.concat(taicpu.op_const_reg(A_MOVE,S_L,longint(a),register))
261
 
         end
262
 
        else
263
 
        if a = 0 then
264
 
           list.concat(taicpu.op_reg(A_CLR,S_L,register))
265
 
        else
266
 
         begin
267
 
           if (longint(a) >= low(shortint)) and (longint(a) <= high(shortint)) then
268
 
              list.concat(taicpu.op_const_reg(A_MOVEQ,S_L,longint(a),register))
269
 
           else
270
 
              list.concat(taicpu.op_const_reg(A_MOVE,S_L,longint(a),register))
271
 
         end;
272
 
      end;
273
 
 
274
 
 
275
 
    procedure tcg68k.a_load_reg_ref(list : taasmoutput;fromsize,tosize : tcgsize;register : tregister;const ref : treference);
276
 
      var
277
 
       href : treference;
278
 
      begin
279
 
         href := ref;
280
 
         fixref(list,href);
281
 
         { move to destination reference }
282
 
         list.concat(taicpu.op_reg_ref(A_MOVE,TCGSize2OpSize[fromsize],register,href));
283
 
      end;
284
 
 
285
 
 
286
 
    procedure tcg68k.a_load_reg_reg(list : taasmoutput;fromsize,tosize : tcgsize;reg1,reg2 : tregister);
287
 
      begin
288
 
         { move to destination register }
289
 
         list.concat(taicpu.op_reg_reg(A_MOVE,S_L,reg1,reg2));
290
 
         { zero/sign extend register to 32-bit }
291
 
         sign_extend(list, fromsize, reg2);
292
 
      end;
293
 
 
294
 
 
295
 
    procedure tcg68k.a_load_ref_reg(list : taasmoutput;fromsize,tosize : tcgsize;const ref : treference;register : tregister);
296
 
      var
297
 
       href : treference;
298
 
      begin
299
 
         href := ref;
300
 
         fixref(list,href);
301
 
         list.concat(taicpu.op_ref_reg(A_MOVE,TCGSize2OpSize[fromsize],href,register));
302
 
         { extend the value in the register }
303
 
         sign_extend(list, tosize, register);
304
 
      end;
305
 
 
306
 
 
307
 
    procedure tcg68k.a_loadaddr_ref_reg(list : taasmoutput;const ref : treference;r : tregister);
308
 
     var
309
 
       href : treference;
310
 
      begin
311
 
        if getregtype(r)=R_ADDRESSREGISTER then
312
 
          begin
313
 
            internalerror(2002072901);
314
 
          end;
315
 
        href:=ref;
316
 
        fixref(list, href);
317
 
        list.concat(taicpu.op_ref_reg(A_LEA,S_L,href,r));
318
 
      end;
319
 
 
320
 
 
321
 
    procedure tcg68k.a_loadfpu_reg_reg(list: taasmoutput; size: tcgsize; reg1, reg2: tregister);
322
 
      begin
323
 
        { in emulation mode, only 32-bit single is supported }
324
 
        if cs_fp_emulation in aktmoduleswitches then
325
 
          list.concat(taicpu.op_reg_reg(A_MOVE,S_L,reg1,reg2))
326
 
        else
327
 
          list.concat(taicpu.op_reg_reg(A_FMOVE,S_FD,reg1,reg2));
328
 
      end;
329
 
 
330
 
 
331
 
    procedure tcg68k.a_loadfpu_ref_reg(list: taasmoutput; size: tcgsize; const ref: treference; reg: tregister);
332
 
     var
333
 
      opsize : topsize;
334
 
      href : treference;
335
 
      begin
336
 
        opsize := tcgsize2opsize[size];
337
 
        { extended is not supported, since it is not available on Coldfire }
338
 
        if opsize = S_FX then
339
 
          internalerror(20020729);
340
 
        href := ref;
341
 
        fixref(list,href);
342
 
        { in emulation mode, only 32-bit single is supported }
343
 
        if cs_fp_emulation in aktmoduleswitches then
344
 
           list.concat(taicpu.op_ref_reg(A_MOVE,S_L,href,reg))
345
 
        else
346
 
           list.concat(taicpu.op_ref_reg(A_FMOVE,opsize,href,reg));
347
 
      end;
348
 
 
349
 
    procedure tcg68k.a_loadfpu_reg_ref(list: taasmoutput; size: tcgsize; reg: tregister; const ref: treference);
350
 
      var
351
 
       opsize : topsize;
352
 
      begin
353
 
        opsize := tcgsize2opsize[size];
354
 
        { extended is not supported, since it is not available on Coldfire }
355
 
        if opsize = S_FX then
356
 
          internalerror(20020729);
357
 
        { in emulation mode, only 32-bit single is supported }
358
 
        if cs_fp_emulation in aktmoduleswitches then
359
 
          list.concat(taicpu.op_reg_ref(A_MOVE,S_L,reg, ref))
360
 
        else
361
 
          list.concat(taicpu.op_reg_ref(A_FMOVE,opsize,reg, ref));
362
 
      end;
363
 
 
364
 
 
365
 
    procedure tcg68k.a_loadmm_reg_reg(list: taasmoutput;fromsize,tosize : tcgsize; reg1, reg2: tregister;shuffle : pmmshuffle);
366
 
      begin
367
 
        internalerror(20020729);
368
 
      end;
369
 
 
370
 
 
371
 
    procedure tcg68k.a_loadmm_ref_reg(list: taasmoutput;fromsize,tosize : tcgsize; const ref: treference; reg: tregister;shuffle : pmmshuffle);
372
 
      begin
373
 
        internalerror(20020729);
374
 
      end;
375
 
 
376
 
 
377
 
    procedure tcg68k.a_loadmm_reg_ref(list: taasmoutput;fromsize,tosize : tcgsize; reg: tregister; const ref: treference;shuffle : pmmshuffle);
378
 
      begin
379
 
        internalerror(20020729);
380
 
      end;
381
 
 
382
 
 
383
 
    procedure tcg68k.a_parammm_reg(list: taasmoutput; size: tcgsize; reg: tregister;const locpara : tparalocation;shuffle : pmmshuffle);
384
 
      begin
385
 
        internalerror(20020729);
386
 
      end;
387
 
 
388
 
 
389
 
    procedure tcg68k.a_op_const_reg(list : taasmoutput; Op: TOpCG; size: tcgsize; a: AWord; reg: TRegister);
390
 
      var
391
 
       scratch_reg : tregister;
392
 
       scratch_reg2: tregister;
393
 
       opcode : tasmop;
394
 
       r,r2 : Tregister;
395
 
      begin
396
 
        { need to emit opcode? }
397
 
        if optimize_op_const_reg(list, op, a, reg) then
398
 
           exit;
399
 
        opcode := topcg2tasmop[op];
400
 
        case op of
401
 
          OP_ADD :
402
 
              Begin
403
 
                if (a >= 1) and (a <= 8) then
404
 
                    list.concat(taicpu.op_const_reg(A_ADDQ,S_L,a, reg))
405
 
                else
406
 
                  begin
407
 
                    { all others, including coldfire }
408
 
                    list.concat(taicpu.op_const_reg(A_ADD,S_L,a, reg));
409
 
                  end;
410
 
              end;
411
 
          OP_AND,
412
 
          OP_OR:
413
 
              Begin
414
 
                 list.concat(taicpu.op_const_reg(topcg2tasmop[op],S_L,longint(a), reg));
415
 
              end;
416
 
          OP_DIV :
417
 
              Begin
418
 
                 internalerror(20020816);
419
 
              end;
420
 
          OP_IDIV :
421
 
              Begin
422
 
                 internalerror(20020816);
423
 
              end;
424
 
          OP_IMUL :
425
 
              Begin
426
 
             if aktoptprocessor = MC68000 then
427
 
                   begin
428
 
                     r:=NR_D0;
429
 
                     r2:=NR_D1;
430
 
                     getexplicitregister(list,NR_D0);
431
 
                     getexplicitregister(list,NR_D1);
432
 
                     list.concat(taicpu.op_const_reg(A_MOVE,S_L,a, r));
433
 
                     list.concat(taicpu.op_reg_reg(A_MOVE,S_L,reg, r2));
434
 
                     cg.a_call_name(list,'FPC_MUL_LONGINT');
435
 
                     list.concat(taicpu.op_reg_reg(A_MOVE,S_L,r, reg));
436
 
                     ungetregister(list,r);
437
 
                     ungetregister(list,r2);
438
 
                   end
439
 
                  else
440
 
                    begin
441
 
                      if (isaddressregister(reg)) then
442
 
                       begin
443
 
                         scratch_reg := cg.getintregister(list,OS_INT);
444
 
                         list.concat(taicpu.op_reg_reg(A_MOVE,S_L,reg, scratch_reg));
445
 
                         list.concat(taicpu.op_const_reg(A_MULS,S_L,a,scratch_reg));
446
 
                         list.concat(taicpu.op_reg_reg(A_MOVE,S_L,scratch_reg,reg));
447
 
                         cg.ungetregister(list,scratch_reg);
448
 
                       end
449
 
                      else
450
 
                         list.concat(taicpu.op_const_reg(A_MULS,S_L,a,reg));
451
 
                    end;
452
 
              end;
453
 
          OP_MUL :
454
 
              Begin
455
 
                 if aktoptprocessor = MC68000 then
456
 
                   begin
457
 
                     r:=NR_D0;
458
 
                     r2:=NR_D1;
459
 
                     getexplicitregister(list,NR_D0);
460
 
                     getexplicitregister(list,NR_D1);
461
 
                     list.concat(taicpu.op_const_reg(A_MOVE,S_L,a, r));
462
 
                     list.concat(taicpu.op_reg_reg(A_MOVE,S_L,reg, r2));
463
 
                     cg.a_call_name(list,'FPC_MUL_LONGWORD');
464
 
                     list.concat(taicpu.op_reg_reg(A_MOVE,S_L,r, reg));
465
 
                     ungetregister(list,r);
466
 
                     ungetregister(list,r2);
467
 
                   end
468
 
                  else
469
 
                    begin
470
 
                      if (isaddressregister(reg)) then
471
 
                       begin
472
 
                         scratch_reg := cg.getintregister(list,OS_INT);
473
 
                         list.concat(taicpu.op_reg_reg(A_MOVE,S_L,reg, scratch_reg));
474
 
                         list.concat(taicpu.op_const_reg(A_MULU,S_L,a,scratch_reg));
475
 
                         list.concat(taicpu.op_reg_reg(A_MOVE,S_L,scratch_reg,reg));
476
 
                         cg.ungetregister(list,scratch_reg);
477
 
                       end
478
 
                      else
479
 
                         list.concat(taicpu.op_const_reg(A_MULU,S_L,a,reg));
480
 
                    end;
481
 
              end;
482
 
          OP_SAR,
483
 
          OP_SHL,
484
 
          OP_SHR :
485
 
              Begin
486
 
                if (a >= 1) and (a <= 8) then
487
 
                 begin
488
 
                   { now allowed to shift an address register }
489
 
                   if (isaddressregister(reg)) then
490
 
                     begin
491
 
                       scratch_reg := cg.getintregister(list,OS_INT);
492
 
                       list.concat(taicpu.op_reg_reg(A_MOVE,S_L,reg, scratch_reg));
493
 
                       list.concat(taicpu.op_const_reg(opcode,S_L,a, scratch_reg));
494
 
                       list.concat(taicpu.op_reg_reg(A_MOVE,S_L,scratch_reg,reg));
495
 
                       cg.ungetregister(list,scratch_reg);
496
 
                     end
497
 
                   else
498
 
                     list.concat(taicpu.op_const_reg(opcode,S_L,a, reg));
499
 
                 end
500
 
                else
501
 
                 begin
502
 
                   { we must load the data into a register ... :() }
503
 
                   scratch_reg := cg.getintregister(list,OS_INT);
504
 
                   list.concat(taicpu.op_const_reg(A_MOVE,S_L,a, scratch_reg));
505
 
                   { again... since shifting with address register is not allowed }
506
 
                   if (isaddressregister(reg)) then
507
 
                     begin
508
 
                       scratch_reg2 := cg.getintregister(list,OS_INT);
509
 
                       list.concat(taicpu.op_reg_reg(A_MOVE,S_L,reg, scratch_reg2));
510
 
                       list.concat(taicpu.op_reg_reg(opcode,S_L,scratch_reg, scratch_reg2));
511
 
                       list.concat(taicpu.op_reg_reg(A_MOVE,S_L,scratch_reg2,reg));
512
 
                       cg.ungetregister(list,scratch_reg2);
513
 
                     end
514
 
                   else
515
 
                     list.concat(taicpu.op_reg_reg(opcode,S_L,scratch_reg, reg));
516
 
                   cg.ungetregister(list,scratch_reg);
517
 
                 end;
518
 
              end;
519
 
          OP_SUB :
520
 
              Begin
521
 
                if (a >= 1) and (a <= 8) then
522
 
                    list.concat(taicpu.op_const_reg(A_SUBQ,S_L,a,reg))
523
 
                else
524
 
                  begin
525
 
                    { all others, including coldfire }
526
 
                    list.concat(taicpu.op_const_reg(A_SUB,S_L,a, reg));
527
 
                  end;
528
 
              end;
529
 
          OP_XOR :
530
 
              Begin
531
 
                 list.concat(taicpu.op_const_reg(A_EORI,S_L,a, reg));
532
 
              end;
533
 
        else
534
 
            internalerror(20020729);
535
 
         end;
536
 
      end;
537
 
 
538
 
 
539
 
    procedure tcg68k.a_op_reg_reg(list : taasmoutput; Op: TOpCG; size: TCGSize; reg1, reg2: TRegister);
540
 
      var
541
 
       hreg1,hreg2,r,r2: tregister;
542
 
      begin
543
 
        case op of
544
 
          OP_ADD :
545
 
              Begin
546
 
                 if aktoptprocessor = ColdFire then
547
 
                  begin
548
 
                    { operation only allowed only a longword }
549
 
                    sign_extend(list, size, reg1);
550
 
                    sign_extend(list, size, reg2);
551
 
                    list.concat(taicpu.op_reg_reg(A_ADD,S_L,reg1, reg2));
552
 
                  end
553
 
                 else
554
 
                  begin
555
 
                    list.concat(taicpu.op_reg_reg(A_ADD,TCGSize2OpSize[size],reg1, reg2));
556
 
                  end;
557
 
              end;
558
 
          OP_AND,OP_OR,
559
 
          OP_SAR,OP_SHL,
560
 
          OP_SHR,OP_SUB,OP_XOR :
561
 
              Begin
562
 
                 { load to data registers }
563
 
                 if (isaddressregister(reg1)) then
564
 
                   begin
565
 
                     hreg1 := cg.getintregister(list,OS_INT);
566
 
                     list.concat(taicpu.op_reg_reg(A_MOVE,S_L,reg1,hreg1));
567
 
                   end
568
 
                 else
569
 
                   hreg1 := reg1;
570
 
 
571
 
                 if (isaddressregister(reg2))  then
572
 
                   begin
573
 
                      hreg2:= cg.getintregister(list,OS_INT);
574
 
                      list.concat(taicpu.op_reg_reg(A_MOVE,S_L,reg2,hreg2));
575
 
                   end
576
 
                 else
577
 
                   hreg2 := reg2;
578
 
 
579
 
                 if aktoptprocessor = ColdFire then
580
 
                  begin
581
 
                    { operation only allowed only a longword }
582
 
                    {!***************************************
583
 
                      in the case of shifts, the value to
584
 
                      shift by, should already be valid, so
585
 
                      no need to sign extend the value
586
 
                     !
587
 
                    }
588
 
                    if op in [OP_AND,OP_OR,OP_SUB,OP_XOR] then
589
 
                       sign_extend(list, size, hreg1);
590
 
                    sign_extend(list, size, hreg2);
591
 
                    list.concat(taicpu.op_reg_reg(topcg2tasmop[op],S_L,hreg1, hreg2));
592
 
                  end
593
 
                 else
594
 
                  begin
595
 
                    list.concat(taicpu.op_reg_reg(topcg2tasmop[op],TCGSize2OpSize[size],hreg1, hreg2));
596
 
                  end;
597
 
 
598
 
                 if reg1 <> hreg1 then
599
 
                    cg.ungetregister(list,hreg1);
600
 
                 { move back result into destination register }
601
 
                 if reg2 <> hreg2 then
602
 
                   begin
603
 
                      list.concat(taicpu.op_reg_reg(A_MOVE,S_L,hreg2,reg2));
604
 
                      cg.ungetregister(list,hreg2);
605
 
                   end;
606
 
              end;
607
 
          OP_DIV :
608
 
              Begin
609
 
                 internalerror(20020816);
610
 
              end;
611
 
          OP_IDIV :
612
 
              Begin
613
 
                 internalerror(20020816);
614
 
              end;
615
 
          OP_IMUL :
616
 
              Begin
617
 
                 sign_extend(list, size,reg1);
618
 
                 sign_extend(list, size,reg2);
619
 
                 if aktoptprocessor = MC68000 then
620
 
                   begin
621
 
                     r:=NR_D0;
622
 
                     r2:=NR_D1;
623
 
                     getexplicitregister(list,NR_D0);
624
 
                     getexplicitregister(list,NR_D1);
625
 
                     list.concat(taicpu.op_reg_reg(A_MOVE,S_L,reg1, r));
626
 
                     list.concat(taicpu.op_reg_reg(A_MOVE,S_L,reg2, r2));
627
 
                     cg.a_call_name(list,'FPC_MUL_LONGINT');
628
 
                     list.concat(taicpu.op_reg_reg(A_MOVE,S_L,r, reg2));
629
 
                     ungetregister(list,r);
630
 
                     ungetregister(list,r2);
631
 
                   end
632
 
                  else
633
 
                    begin
634
 
                     if (isaddressregister(reg1)) then
635
 
                       hreg1 := cg.getintregister(list,OS_INT)
636
 
                     else
637
 
                       hreg1 := reg1;
638
 
                     if (isaddressregister(reg2))  then
639
 
                       hreg2:= cg.getintregister(list,OS_INT)
640
 
                     else
641
 
                       hreg2 := reg2;
642
 
 
643
 
                     list.concat(taicpu.op_reg_reg(A_MOVE,S_L,reg1,hreg1));
644
 
                     list.concat(taicpu.op_reg_reg(A_MOVE,S_L,reg2,hreg2));
645
 
 
646
 
                     list.concat(taicpu.op_reg_reg(A_MULS,S_L,reg1,reg2));
647
 
 
648
 
                     if reg1 <> hreg1 then
649
 
                       cg.ungetregister(list,hreg1);
650
 
                     { move back result into destination register }
651
 
                     if reg2 <> hreg2 then
652
 
                       begin
653
 
                          list.concat(taicpu.op_reg_reg(A_MOVE,S_L,hreg2,reg2));
654
 
                          cg.ungetregister(list,hreg2);
655
 
                       end;
656
 
                    end;
657
 
              end;
658
 
          OP_MUL :
659
 
              Begin
660
 
                 sign_extend(list, size,reg1);
661
 
                 sign_extend(list, size,reg2);
662
 
                 if aktoptprocessor = MC68000 then
663
 
                   begin
664
 
                     r:=NR_D0;
665
 
                     r2:=NR_D1;
666
 
                     getexplicitregister(list,NR_D0);
667
 
                     getexplicitregister(list,NR_D1);
668
 
                     list.concat(taicpu.op_reg_reg(A_MOVE,S_L,reg1, r));
669
 
                     list.concat(taicpu.op_reg_reg(A_MOVE,S_L,reg2, r2));
670
 
                     cg.a_call_name(list,'FPC_MUL_LONGWORD');
671
 
                     list.concat(taicpu.op_reg_reg(A_MOVE,S_L,r, reg2));
672
 
                     ungetregister(list,r);
673
 
                     ungetregister(list,r2);
674
 
                   end
675
 
                  else
676
 
                    begin
677
 
                     if (isaddressregister(reg1)) then
678
 
                      begin
679
 
                       hreg1 := cg.getintregister(list,OS_INT);
680
 
                       list.concat(taicpu.op_reg_reg(A_MOVE,S_L,reg1,hreg1));
681
 
                      end
682
 
                     else
683
 
                       hreg1 := reg1;
684
 
 
685
 
                     if (isaddressregister(reg2))  then
686
 
                      begin
687
 
                       hreg2:= cg.getintregister(list,OS_INT);
688
 
                       list.concat(taicpu.op_reg_reg(A_MOVE,S_L,reg2,hreg2));
689
 
                      end
690
 
                     else
691
 
                       hreg2 := reg2;
692
 
 
693
 
 
694
 
                     list.concat(taicpu.op_reg_reg(A_MULU,S_L,reg1,reg2));
695
 
 
696
 
                     if reg1<>hreg1 then
697
 
                       cg.ungetregister(list,hreg1);
698
 
                     { move back result into destination register }
699
 
                     if reg2<>hreg2 then
700
 
                       begin
701
 
                          list.concat(taicpu.op_reg_reg(A_MOVE,S_L,hreg2,reg2));
702
 
                          cg.ungetregister(list,hreg2);
703
 
                       end;
704
 
                    end;
705
 
              end;
706
 
          OP_NEG,
707
 
          OP_NOT :
708
 
              Begin
709
 
                { if there are two operands, move the register,
710
 
                  since the operation will only be done on the result
711
 
                  register.
712
 
                }
713
 
                if reg1 <> NR_NO then
714
 
                  cg.a_load_reg_reg(exprasmlist,OS_INT,OS_INT,reg1,reg2);
715
 
 
716
 
                if (isaddressregister(reg2)) then
717
 
                  begin
718
 
                     hreg2 := cg.getintregister(list,OS_INT);
719
 
                     list.concat(taicpu.op_reg_reg(A_MOVE,S_L,reg2,hreg2));
720
 
                   end
721
 
                  else
722
 
                    hreg2 := reg2;
723
 
 
724
 
                { coldfire only supports long version }
725
 
                if aktoptprocessor = ColdFire then
726
 
                  begin
727
 
                    sign_extend(list, size,hreg2);
728
 
                    list.concat(taicpu.op_reg(topcg2tasmop[op],S_L,hreg2));
729
 
                  end
730
 
                else
731
 
                  begin
732
 
                    list.concat(taicpu.op_reg(topcg2tasmop[op],TCGSize2OpSize[size],hreg2));
733
 
                  end;
734
 
 
735
 
                if reg2 <> hreg2 then
736
 
                  begin
737
 
                    list.concat(taicpu.op_reg_reg(A_MOVE,S_L,hreg2,reg2));
738
 
                    cg.ungetregister(list,hreg2);
739
 
                  end;
740
 
 
741
 
              end;
742
 
        else
743
 
            internalerror(20020729);
744
 
         end;
745
 
      end;
746
 
 
747
 
 
748
 
 
749
 
    procedure tcg68k.a_cmp_const_reg_label(list : taasmoutput;size : tcgsize;cmp_op : topcmp;a : aword;reg : tregister;
750
 
            l : tasmlabel);
751
 
      var
752
 
       hregister : tregister;
753
 
      begin
754
 
       if a = 0 then
755
 
         begin
756
 
           list.concat(taicpu.op_reg(A_TST,TCGSize2OpSize[size],reg));
757
 
         end
758
 
       else
759
 
         begin
760
 
           if (aktoptprocessor = ColdFire) then
761
 
             begin
762
 
               {
763
 
                 only longword comparison is supported,
764
 
                 and only on data registers.
765
 
               }
766
 
               hregister := cg.getintregister(list,OS_INT);
767
 
               { always move to a data register }
768
 
               list.concat(taicpu.op_reg_reg(A_MOVE,S_L,reg,hregister));
769
 
               { sign/zero extend the register }
770
 
               sign_extend(list, size,hregister);
771
 
               list.concat(taicpu.op_const_reg(A_CMPI,S_L,a,hregister));
772
 
               cg.ungetregister(list,hregister);
773
 
             end
774
 
           else
775
 
             begin
776
 
               list.concat(taicpu.op_const_reg(A_CMPI,TCGSize2OpSize[size],a,reg));
777
 
             end;
778
 
         end;
779
 
         { emit the actual jump to the label }
780
 
         a_jmp_cond(list,cmp_op,l);
781
 
      end;
782
 
 
783
 
    procedure tcg68k.a_cmp_reg_reg_label(list : taasmoutput;size : tcgsize;cmp_op : topcmp;reg1,reg2 : tregister;l : tasmlabel);
784
 
      begin
785
 
         list.concat(taicpu.op_reg_reg(A_CMP,tcgsize2opsize[size],reg1,reg2));
786
 
         { emit the actual jump to the label }
787
 
         a_jmp_cond(list,cmp_op,l);
788
 
      end;
789
 
 
790
 
    procedure tcg68k.a_jmp_always(list : taasmoutput;l: tasmlabel);
791
 
      var
792
 
       ai: taicpu;
793
 
      begin
794
 
         ai := Taicpu.op_sym(A_JMP,S_NO,l);
795
 
         ai.is_jmp := true;
796
 
         list.concat(ai);
797
 
      end;
798
 
 
799
 
    procedure tcg68k.a_jmp_flags(list : taasmoutput;const f : TResFlags;l: tasmlabel);
800
 
       var
801
 
         ai : taicpu;
802
 
       begin
803
 
         ai := Taicpu.op_sym(A_BXX,S_NO,l);
804
 
         ai.SetCondition(flags_to_cond(f));
805
 
         ai.is_jmp := true;
806
 
         list.concat(ai);
807
 
       end;
808
 
 
809
 
    procedure tcg68k.g_flags2reg(list: taasmoutput; size: TCgSize; const f: tresflags; reg: TRegister);
810
 
       var
811
 
         ai : taicpu;
812
 
         hreg : tregister;
813
 
       begin
814
 
          { move to a Dx register? }
815
 
          if (isaddressregister(reg)) then
816
 
            begin
817
 
              hreg := getintregister(list,OS_INT);
818
 
              a_load_const_reg(list,size,0,hreg);
819
 
              ai:=Taicpu.Op_reg(A_Sxx,S_B,hreg);
820
 
              ai.SetCondition(flags_to_cond(f));
821
 
              list.concat(ai);
822
 
 
823
 
              if (aktoptprocessor = ColdFire) then
824
 
                begin
825
 
                 { neg.b does not exist on the Coldfire
826
 
                   so we need to sign extend the value
827
 
                   before doing a neg.l
828
 
                 }
829
 
                 list.concat(taicpu.op_reg(A_EXTB,S_L,hreg));
830
 
                 list.concat(taicpu.op_reg(A_NEG,S_L,hreg));
831
 
                end
832
 
              else
833
 
                begin
834
 
                  list.concat(taicpu.op_reg(A_NEG,S_B,hreg));
835
 
                end;
836
 
             list.concat(taicpu.op_reg_reg(A_MOVE,S_L,hreg,reg));
837
 
             ungetregister(list,hreg);
838
 
            end
839
 
          else
840
 
          begin
841
 
            a_load_const_reg(list,size,0,reg);
842
 
            ai:=Taicpu.Op_reg(A_Sxx,S_B,reg);
843
 
            ai.SetCondition(flags_to_cond(f));
844
 
            list.concat(ai);
845
 
 
846
 
            if (aktoptprocessor = ColdFire) then
847
 
              begin
848
 
                 { neg.b does not exist on the Coldfire
849
 
                   so we need to sign extend the value
850
 
                   before doing a neg.l
851
 
                 }
852
 
                 list.concat(taicpu.op_reg(A_EXTB,S_L,reg));
853
 
                 list.concat(taicpu.op_reg(A_NEG,S_L,reg));
854
 
              end
855
 
            else
856
 
              begin
857
 
               list.concat(taicpu.op_reg(A_NEG,S_B,reg));
858
 
              end;
859
 
          end;
860
 
       end;
861
 
 
862
 
 
863
 
 
864
 
    procedure tcg68k.g_concatcopy(list : taasmoutput;const source,dest : treference;len : aword;delsource,loadref : boolean);
865
 
     var
866
 
         helpsize : longint;
867
 
         i : byte;
868
 
         reg8,reg32 : tregister;
869
 
         swap : boolean;
870
 
         hregister : tregister;
871
 
         iregister : tregister;
872
 
         jregister : tregister;
873
 
         hp1 : treference;
874
 
         hp2 : treference;
875
 
         hl : tasmlabel;
876
 
         hl2: tasmlabel;
877
 
         popaddress : boolean;
878
 
         srcref,dstref : treference;
879
 
 
880
 
      begin
881
 
         popaddress := false;
882
 
 
883
 
         { this should never occur }
884
 
         if len > 65535 then
885
 
           internalerror(0);
886
 
         hregister := getintregister(list,OS_INT);
887
 
         if delsource then
888
 
            reference_release(list,source);
889
 
 
890
 
 
891
 
         { from 12 bytes movs is being used }
892
 
         if (not loadref) and ((len<=8) or (not(cs_littlesize in aktglobalswitches) and (len<=12))) then
893
 
           begin
894
 
              srcref := source;
895
 
              dstref := dest;
896
 
              helpsize:=len div 4;
897
 
              { move a dword x times }
898
 
              for i:=1 to helpsize do
899
 
                begin
900
 
                   a_load_ref_reg(list,OS_INT,OS_INT,srcref,hregister);
901
 
                   a_load_reg_ref(list,OS_INT,OS_INT,hregister,dstref);
902
 
                   inc(srcref.offset,4);
903
 
                   inc(dstref.offset,4);
904
 
                   dec(len,4);
905
 
                end;
906
 
              { move a word }
907
 
              if len>1 then
908
 
                begin
909
 
                   a_load_ref_reg(list,OS_16,OS_16,srcref,hregister);
910
 
                   a_load_reg_ref(list,OS_16,OS_16,hregister,dstref);
911
 
                   inc(srcref.offset,2);
912
 
                   inc(dstref.offset,2);
913
 
                   dec(len,2);
914
 
                end;
915
 
              { move a single byte }
916
 
              if len>0 then
917
 
                begin
918
 
                   a_load_ref_reg(list,OS_8,OS_8,srcref,hregister);
919
 
                   a_load_reg_ref(list,OS_8,OS_8,hregister,dstref);
920
 
                end
921
 
           end
922
 
         else
923
 
           begin
924
 
              iregister:=getaddressregister(list);
925
 
              jregister:=getaddressregister(list);
926
 
              { reference for move (An)+,(An)+ }
927
 
              reference_reset(hp1);
928
 
              hp1.base := iregister;   { source register }
929
 
              hp1.direction := dir_inc;
930
 
              reference_reset(hp2);
931
 
              hp2.base := jregister;
932
 
              hp2.direction := dir_inc;
933
 
              { iregister = source }
934
 
              { jregister = destination }
935
 
 
936
 
              if loadref then
937
 
                 a_load_ref_reg(list,OS_INT,OS_INT,source,iregister)
938
 
              else
939
 
                 a_loadaddr_ref_reg(list,source,iregister);
940
 
 
941
 
              a_loadaddr_ref_reg(list,dest,jregister);
942
 
 
943
 
              { double word move only on 68020+ machines }
944
 
              { because of possible alignment problems   }
945
 
              { use fast loop mode }
946
 
              if (aktoptprocessor=MC68020) then
947
 
                begin
948
 
                   helpsize := len - len mod 4;
949
 
                   len := len mod 4;
950
 
                   list.concat(taicpu.op_const_reg(A_MOVE,S_L,helpsize div 4,hregister));
951
 
                   objectlibrary.getlabel(hl2);
952
 
                   a_jmp_always(list,hl2);
953
 
                   objectlibrary.getlabel(hl);
954
 
                   a_label(list,hl);
955
 
                   list.concat(taicpu.op_ref_ref(A_MOVE,S_L,hp1,hp2));
956
 
                   cg.a_label(list,hl2);
957
 
                   list.concat(taicpu.op_reg_sym(A_DBRA,S_L,hregister,hl));
958
 
                   if len > 1 then
959
 
                     begin
960
 
                        dec(len,2);
961
 
                        list.concat(taicpu.op_ref_ref(A_MOVE,S_W,hp1,hp2));
962
 
                     end;
963
 
                   if len = 1 then
964
 
                     list.concat(taicpu.op_ref_ref(A_MOVE,S_B,hp1,hp2));
965
 
                end
966
 
              else
967
 
                begin
968
 
                   { Fast 68010 loop mode with no possible alignment problems }
969
 
                   helpsize := len;
970
 
                   list.concat(taicpu.op_const_reg(A_MOVE,S_L,helpsize,hregister));
971
 
                   objectlibrary.getlabel(hl2);
972
 
                   a_jmp_always(list,hl2);
973
 
                   objectlibrary.getlabel(hl);
974
 
                   a_label(list,hl);
975
 
                   list.concat(taicpu.op_ref_ref(A_MOVE,S_B,hp1,hp2));
976
 
                   a_label(list,hl2);
977
 
                   list.concat(taicpu.op_reg_sym(A_DBRA,S_L,hregister,hl));
978
 
                end;
979
 
 
980
 
              { restore the registers that we have just used olny if they are used! }
981
 
              ungetregister(list, iregister);
982
 
              ungetregister(list, jregister);
983
 
              if jregister = NR_A1 then
984
 
                hp2.base := NR_NO;
985
 
              if iregister = NR_A0 then
986
 
                hp1.base := NR_NO;
987
 
              reference_release(list,hp1);
988
 
              reference_release(list,hp2);
989
 
           end;
990
 
 
991
 
           if delsource then
992
 
               tg.ungetiftemp(list,source);
993
 
 
994
 
           ungetregister(list,hregister);
995
 
    end;
996
 
 
997
 
    procedure tcg68k.g_overflowcheck(list: taasmoutput; const l:tlocation; def:tdef);
998
 
      begin
999
 
      end;
1000
 
 
1001
 
    procedure tcg68k.g_copyvaluepara_openarray(list : taasmoutput;const ref, lenref:treference;elesize:aword);
1002
 
      begin
1003
 
      end;
1004
 
 
1005
 
 
1006
 
    procedure tcg68k.g_stackframe_entry(list : taasmoutput;localsize : longint);
1007
 
      var
1008
 
        r,rsp:Tregister;
1009
 
        ref : treference;
1010
 
      begin
1011
 
        r:=NR_FRAME_POINTER_REG;
1012
 
        rsp:=NR_STACK_POINTER_REG;
1013
 
        if localsize<>0 then
1014
 
           begin
1015
 
             { Not to complicate the code generator too much, and since some  }
1016
 
             { of the systems only support this format, the localsize cannot }
1017
 
             { exceed 32K in size.                                            }
1018
 
             if (localsize < low(smallint)) or (localsize > high(smallint)) then
1019
 
                CGMessage(cg_e_localsize_too_big);
1020
 
             list.concat(taicpu.op_reg_const(A_LINK,S_W,r,-localsize));
1021
 
           end { endif localsize <> 0 }
1022
 
          else
1023
 
           begin
1024
 
             reference_reset_base(ref,NR_STACK_POINTER_REG,0);
1025
 
             ref.direction:=dir_dec;
1026
 
             list.concat(taicpu.op_reg_ref(A_MOVE,S_L,r,ref));
1027
 
             list.concat(taicpu.op_reg_reg(A_MOVE,S_L,rsp,r));
1028
 
           end;
1029
 
      end;
1030
 
 
1031
 
 
1032
 
    procedure tcg68k.g_restore_frame_pointer(list : taasmoutput);
1033
 
      var
1034
 
        r:Tregister;
1035
 
      begin
1036
 
        r:=NR_FRAME_POINTER_REG;
1037
 
        list.concat(taicpu.op_reg(A_UNLK,S_NO,r));
1038
 
      end;
1039
 
 
1040
 
 
1041
 
    procedure tcg68k.g_return_from_proc(list : taasmoutput;parasize : aword);
1042
 
      var
1043
 
        r,hregister : tregister;
1044
 
        ref : treference;
1045
 
      begin
1046
 
         { Routines with the poclearstack flag set use only a ret.
1047
 
           also routines with parasize=0     }
1048
 
         if current_procinfo.procdef.proccalloption in clearstack_pocalls then
1049
 
           begin
1050
 
             { complex return values are removed from stack in C code PM }
1051
 
             if paramanager.ret_in_param(current_procinfo.procdef.rettype.def,current_procinfo.procdef.proccalloption) then
1052
 
               list.concat(taicpu.op_const(A_RTD,S_NO,4))
1053
 
             else
1054
 
               list.concat(taicpu.op_none(A_RTS,S_NO));
1055
 
           end
1056
 
         else if (parasize=0) then
1057
 
           begin
1058
 
             list.concat(taicpu.op_none(A_RTS,S_NO));
1059
 
           end
1060
 
         else
1061
 
           begin
1062
 
            { return with immediate size possible here
1063
 
              signed!
1064
 
              RTD is not supported on the coldfire     }
1065
 
            if (aktoptprocessor=MC68020) and (parasize<$7FFF) then
1066
 
                list.concat(taicpu.op_const(A_RTD,S_NO,parasize))
1067
 
            { manually restore the stack }
1068
 
            else
1069
 
              begin
1070
 
                { We must pull the PC Counter from the stack, before  }
1071
 
                { restoring the stack pointer, otherwise the PC would }
1072
 
                { point to nowhere!                                   }
1073
 
 
1074
 
                { save the PC counter (pop it from the stack)         }
1075
 
                hregister:=NR_A3;
1076
 
                a_reg_alloc(list,hregister);
1077
 
                reference_reset_base(ref,NR_STACK_POINTER_REG,0);
1078
 
                ref.direction:=dir_inc;
1079
 
                list.concat(taicpu.op_ref_reg(A_MOVE,S_L,ref,hregister));
1080
 
                { can we do a quick addition ... }
1081
 
                r:=NR_SP;
1082
 
                if (parasize > 0) and (parasize < 9) then
1083
 
                   list.concat(taicpu.op_const_reg(A_ADDQ,S_L,parasize,r))
1084
 
                else { nope ... }
1085
 
                   list.concat(taicpu.op_const_reg(A_ADD,S_L,parasize,r));
1086
 
 
1087
 
                { restore the PC counter (push it on the stack)       }
1088
 
                reference_reset_base(ref,NR_STACK_POINTER_REG,0);
1089
 
                ref.direction:=dir_dec;
1090
 
                list.concat(taicpu.op_reg_ref(A_MOVE,S_L,hregister,ref));
1091
 
                a_reg_alloc(list,hregister);
1092
 
                list.concat(taicpu.op_none(A_RTS,S_NO));
1093
 
               end;
1094
 
           end;
1095
 
      end;
1096
 
 
1097
 
 
1098
 
    procedure Tcg68k.g_save_standard_registers(list:Taasmoutput);
1099
 
      var
1100
 
        tosave : tcpuregisterset;
1101
 
        ref : treference;
1102
 
      begin
1103
 
      {!!!!!
1104
 
        tosave:=std_saved_registers;
1105
 
        { only save the registers which are not used and must be saved }
1106
 
        tosave:=tosave*(rg[R_INTREGISTER].used_in_proc+rg[R_ADDRESSREGISTER].used_in_proc);
1107
 
        reference_reset_base(ref,NR_STACK_POINTER_REG,0);
1108
 
        ref.direction:=dir_dec;
1109
 
        if tosave<>[] then
1110
 
          list.concat(taicpu.op_regset_ref(A_MOVEM,S_L,tosave,ref));
1111
 
      }
1112
 
      end;
1113
 
 
1114
 
 
1115
 
    procedure Tcg68k.g_restore_standard_registers(list:Taasmoutput);
1116
 
      var
1117
 
        torestore : tcpuregisterset;
1118
 
        r:Tregister;
1119
 
        ref : treference;
1120
 
      begin
1121
 
      {!!!!!!!!
1122
 
        torestore:=std_saved_registers;
1123
 
        { should be intersected with used regs, no ? }
1124
 
        torestore:=torestore*(rg[R_INTREGISTER].used_in_proc+rg[R_ADDRESSREGISTER].used_in_proc);
1125
 
        reference_reset_base(ref,NR_STACK_POINTER_REG,0);
1126
 
        ref.direction:=dir_inc;
1127
 
        if torestore<>[] then
1128
 
          list.concat(taicpu.op_ref_regset(A_MOVEM,S_L,ref,torestore));
1129
 
      }
1130
 
      end;
1131
 
 
1132
 
 
1133
 
    procedure tcg68k.g_save_all_registers(list : taasmoutput);
1134
 
      begin
1135
 
      end;
1136
 
 
1137
 
    procedure tcg68k.g_restore_all_registers(list : taasmoutput;const funcretparaloc:tparalocation);
1138
 
      begin
1139
 
      end;
1140
 
 
1141
 
    procedure tcg68k.sign_extend(list: taasmoutput;_oldsize : tcgsize; reg: tregister);
1142
 
      begin
1143
 
        case _oldsize of
1144
 
         { sign extend }
1145
 
         OS_S8:
1146
 
              begin
1147
 
                if (isaddressregister(reg)) then
1148
 
                   internalerror(20020729);
1149
 
                if (aktoptprocessor = MC68000) then
1150
 
                  begin
1151
 
                    list.concat(taicpu.op_reg(A_EXT,S_W,reg));
1152
 
                    list.concat(taicpu.op_reg(A_EXT,S_L,reg));
1153
 
                  end
1154
 
                else
1155
 
                  begin
1156
 
                    list.concat(taicpu.op_reg(A_EXTB,S_L,reg));
1157
 
                  end;
1158
 
              end;
1159
 
         OS_S16:
1160
 
              begin
1161
 
                if (isaddressregister(reg)) then
1162
 
                   internalerror(20020729);
1163
 
                list.concat(taicpu.op_reg(A_EXT,S_L,reg));
1164
 
              end;
1165
 
         { zero extend }
1166
 
         OS_8:
1167
 
              begin
1168
 
                list.concat(taicpu.op_const_reg(A_AND,S_L,$FF,reg));
1169
 
              end;
1170
 
         OS_16:
1171
 
              begin
1172
 
                list.concat(taicpu.op_const_reg(A_AND,S_L,$FFFF,reg));
1173
 
              end;
1174
 
        end; { otherwise the size is already correct }
1175
 
      end;
1176
 
 
1177
 
     procedure tcg68k.a_jmp_cond(list : taasmoutput;cond : TOpCmp;l: tasmlabel);
1178
 
 
1179
 
       var
1180
 
         ai : taicpu;
1181
 
 
1182
 
       begin
1183
 
         if cond=OC_None then
1184
 
           ai := Taicpu.Op_sym(A_JMP,S_NO,l)
1185
 
         else
1186
 
           begin
1187
 
             ai:=Taicpu.Op_sym(A_Bxx,S_NO,l);
1188
 
             ai.SetCondition(TOpCmp2AsmCond[cond]);
1189
 
           end;
1190
 
         ai.is_jmp:=true;
1191
 
         list.concat(ai);
1192
 
       end;
1193
 
 
1194
 
{****************************************************************************}
1195
 
{                               TCG64F68K                                    }
1196
 
{****************************************************************************}
1197
 
 procedure tcg64f68k.a_op64_reg_reg(list : taasmoutput;op:TOpCG;regsrc,regdst : tregister64);
1198
 
  var
1199
 
   hreg1, hreg2 : tregister;
1200
 
   opcode : tasmop;
1201
 
  begin
1202
 
    opcode := topcg2tasmop[op];
1203
 
    case op of
1204
 
      OP_ADD :
1205
 
         begin
1206
 
            { if one of these three registers is an address
1207
 
              register, we'll really get into problems!
1208
 
            }
1209
 
            if isaddressregister(regdst.reglo) or
1210
 
               isaddressregister(regdst.reghi) or
1211
 
               isaddressregister(regsrc.reghi) then
1212
 
                 internalerror(20020817);
1213
 
            list.concat(taicpu.op_reg_reg(A_ADD,S_L,regsrc.reglo,regdst.reglo));
1214
 
            list.concat(taicpu.op_reg_reg(A_ADDX,S_L,regsrc.reghi,regdst.reghi));
1215
 
         end;
1216
 
      OP_AND,OP_OR :
1217
 
          begin
1218
 
            { at least one of the registers must be a data register }
1219
 
            if (isaddressregister(regdst.reglo) and
1220
 
                isaddressregister(regsrc.reglo)) or
1221
 
               (isaddressregister(regsrc.reghi) and
1222
 
                isaddressregister(regdst.reghi))
1223
 
               then
1224
 
                 internalerror(20020817);
1225
 
            cg.a_op_reg_reg(list,op,OS_32,regsrc.reglo,regdst.reglo);
1226
 
            cg.a_op_reg_reg(list,op,OS_32,regsrc.reghi,regdst.reghi);
1227
 
          end;
1228
 
      { this is handled in 1st pass for 32-bit cpu's (helper call) }
1229
 
      OP_IDIV,OP_DIV,
1230
 
      OP_IMUL,OP_MUL: internalerror(2002081701);
1231
 
      { this is also handled in 1st pass for 32-bit cpu's (helper call) }
1232
 
      OP_SAR,OP_SHL,OP_SHR: internalerror(2002081702);
1233
 
      OP_SUB:
1234
 
         begin
1235
 
            { if one of these three registers is an address
1236
 
              register, we'll really get into problems!
1237
 
            }
1238
 
            if isaddressregister(regdst.reglo) or
1239
 
               isaddressregister(regdst.reghi) or
1240
 
               isaddressregister(regsrc.reghi) then
1241
 
                 internalerror(20020817);
1242
 
            list.concat(taicpu.op_reg_reg(A_SUB,S_L,regsrc.reglo,regdst.reglo));
1243
 
            list.concat(taicpu.op_reg_reg(A_SUBX,S_L,regsrc.reghi,regdst.reghi));
1244
 
         end;
1245
 
      OP_XOR:
1246
 
        begin
1247
 
            if isaddressregister(regdst.reglo) or
1248
 
               isaddressregister(regsrc.reglo) or
1249
 
               isaddressregister(regsrc.reghi) or
1250
 
               isaddressregister(regdst.reghi) then
1251
 
                 internalerror(20020817);
1252
 
            list.concat(taicpu.op_reg_reg(A_EOR,S_L,regsrc.reglo,regdst.reglo));
1253
 
            list.concat(taicpu.op_reg_reg(A_EOR,S_L,regsrc.reghi,regdst.reghi));
1254
 
        end;
1255
 
    end; { end case }
1256
 
  end;
1257
 
 
1258
 
 
1259
 
 procedure tcg64f68k.a_op64_const_reg(list : taasmoutput;op:TOpCG;value : qword;reg : tregister64);
1260
 
  var
1261
 
   lowvalue : cardinal;
1262
 
   highvalue : cardinal;
1263
 
  begin
1264
 
    { is it optimized out ? }
1265
 
    if optimize64_op_const_reg(list,op,value,reg) then
1266
 
       exit;
1267
 
 
1268
 
    lowvalue := cardinal(value);
1269
 
    highvalue:= value shr 32;
1270
 
 
1271
 
   { the destination registers must be data registers }
1272
 
   if  isaddressregister(reg.reglo) or
1273
 
       isaddressregister(reg.reghi) then
1274
 
         internalerror(20020817);
1275
 
   case op of
1276
 
      OP_ADD :
1277
 
         begin
1278
 
            list.concat(taicpu.op_const_reg(A_ADD,S_L,lowvalue,reg.reglo));
1279
 
            list.concat(taicpu.op_const_reg(A_ADDX,S_L,highvalue,reg.reglo));
1280
 
         end;
1281
 
      OP_AND :
1282
 
          begin
1283
 
            { should already be optimized out }
1284
 
            internalerror(2002081801);
1285
 
          end;
1286
 
      OP_OR :
1287
 
          begin
1288
 
            { should already be optimized out }
1289
 
            internalerror(2002081802);
1290
 
          end;
1291
 
      { this is handled in 1st pass for 32-bit cpu's (helper call) }
1292
 
      OP_IDIV,OP_DIV,
1293
 
      OP_IMUL,OP_MUL: internalerror(2002081701);
1294
 
      { this is also handled in 1st pass for 32-bit cpu's (helper call) }
1295
 
      OP_SAR,OP_SHL,OP_SHR: internalerror(2002081702);
1296
 
      OP_SUB:
1297
 
         begin
1298
 
            list.concat(taicpu.op_const_reg(A_SUB,S_L,lowvalue,reg.reglo));
1299
 
            list.concat(taicpu.op_const_reg(A_SUBX,S_L,highvalue,reg.reglo));
1300
 
         end;
1301
 
      OP_XOR:
1302
 
        begin
1303
 
            list.concat(taicpu.op_const_reg(A_EOR,S_L,lowvalue,reg.reglo));
1304
 
            list.concat(taicpu.op_const_reg(A_EOR,S_L,highvalue,reg.reglo));
1305
 
        end;
1306
 
    end; { end case }
1307
 
  end;
1308
 
 
1309
 
begin
1310
 
  cg := tcg68k.create;
1311
 
  cg64 :=tcg64f68k.create;
1312
 
end.
1313
 
 
1314
 
{
1315
 
  $Log: cgcpu.pas,v $
1316
 
  Revision 1.27  2004/05/20 21:54:33  florian
1317
 
    + <pointer> - <pointer> result is divided by the pointer element size now
1318
 
      this is delphi compatible as well as resulting in the expected result for p1+(p2-p1)
1319
 
 
1320
 
  Revision 1.26  2004/05/06 22:01:54  florian
1321
 
    * register numbers for address registers fixed
1322
 
 
1323
 
  Revision 1.25  2004/05/06 20:30:51  florian
1324
 
    * m68k compiler compilation fixed
1325
 
 
1326
 
  Revision 1.24  2004/04/19 21:15:12  florian
1327
 
    * fixed compilation
1328
 
 
1329
 
  Revision 1.23  2004/04/18 21:13:59  florian
1330
 
    * more adaptions for m68k
1331
 
 
1332
 
  Revision 1.22  2004/03/02 00:36:33  olle
1333
 
    * big transformation of Tai_[const_]Symbol.Create[data]name*
1334
 
 
1335
 
  Revision 1.21  2004/01/30 12:17:18  florian
1336
 
    * fixed some m68k compilation problems
1337
 
 
1338
 
  Revision 1.20  2003/04/27 11:21:36  peter
1339
 
    * aktprocdef renamed to current_procdef
1340
 
    * procinfo renamed to current_procinfo
1341
 
    * procinfo will now be stored in current_module so it can be
1342
 
      cleaned up properly
1343
 
    * gen_main_procsym changed to create_main_proc and release_main_proc
1344
 
      to also generate a tprocinfo structure
1345
 
    * fixed unit implicit initfinal
1346
 
 
1347
 
  Revision 1.19  2003/04/23 13:40:33  peter
1348
 
    * fix m68k compile
1349
 
 
1350
 
  Revision 1.18  2003/02/19 22:00:16  daniel
1351
 
    * Code generator converted to new register notation
1352
 
    - Horribily outdated todo.txt removed
1353
 
 
1354
 
  Revision 1.17  2003/02/12 22:11:13  carl
1355
 
    * some small m68k bugfixes
1356
 
 
1357
 
  Revision 1.16  2003/02/02 19:25:54  carl
1358
 
    * Several bugfixes for m68k target (register alloc., opcode emission)
1359
 
    + VIS target
1360
 
    + Generic add more complete (still not verified)
1361
 
 
1362
 
  Revision 1.15  2003/01/08 18:43:57  daniel
1363
 
   * Tregister changed into a record
1364
 
 
1365
 
  Revision 1.14  2003/01/05 13:36:53  florian
1366
 
    * x86-64 compiles
1367
 
    + very basic support for float128 type (x86-64 only)
1368
 
 
1369
 
  Revision 1.13  2002/12/01 22:12:36  carl
1370
 
    * rename an error message
1371
 
 
1372
 
  Revision 1.12  2002/11/25 17:43:27  peter
1373
 
    * splitted defbase in defutil,symutil,defcmp
1374
 
    * merged isconvertable and is_equal into compare_defs(_ext)
1375
 
    * made operator search faster by walking the list only once
1376
 
 
1377
 
  Revision 1.11  2002/11/18 17:32:00  peter
1378
 
    * pass proccalloption to ret_in_xxx and push_xxx functions
1379
 
 
1380
 
  Revision 1.10  2002/09/22 14:15:31  carl
1381
 
    + a_call_reg
1382
 
 
1383
 
  Revision 1.9  2002/09/17 18:54:05  jonas
1384
 
    * a_load_reg_reg() now has two size parameters: source and dest. This
1385
 
      allows some optimizations on architectures that don't encode the
1386
 
      register size in the register name.
1387
 
 
1388
 
  Revision 1.8  2002/09/08 15:12:45  carl
1389
 
    + a_call_reg
1390
 
 
1391
 
  Revision 1.7  2002/09/07 20:53:28  carl
1392
 
    * cardinal -> longword
1393
 
 
1394
 
  Revision 1.6  2002/09/07 15:25:12  peter
1395
 
    * old logs removed and tabs fixed
1396
 
 
1397
 
  Revision 1.5  2002/08/19 18:17:48  carl
1398
 
    + optimize64_op_const_reg implemented (optimizes 64-bit constant opcodes)
1399
 
    * more fixes to m68k for 64-bit operations
1400
 
 
1401
 
  Revision 1.4  2002/08/16 14:24:59  carl
1402
 
    * issameref() to test if two references are the same (then emit no opcodes)
1403
 
    + ret_in_reg to replace ret_in_acc
1404
 
      (fix some register allocation bugs at the same time)
1405
 
    + save_std_register now has an extra parameter which is the
1406
 
      usedinproc registers
1407
 
 
1408
 
  Revision 1.3  2002/08/15 08:13:54  carl
1409
 
    - a_load_sym_ofs_reg removed
1410
 
    * loadvmt now calls loadaddr_ref_reg instead
1411
 
 
1412
 
  Revision 1.2  2002/08/14 19:16:34  carl
1413
 
    + m68k type conversion nodes
1414
 
    + started some mathematical nodes
1415
 
    * out of bound references should now be handled correctly
1416
 
 
1417
 
  Revision 1.1  2002/08/13 18:30:22  carl
1418
 
    * rename swatoperands to swapoperands
1419
 
    + m68k first compilable version (still needs a lot of testing):
1420
 
        assembler generator, system information , inline
1421
 
        assembler reader.
1422
 
 
1423
 
  Revision 1.5  2002/08/12 15:08:43  carl
1424
 
    + stab register indexes for powerpc (moved from gdb to cpubase)
1425
 
    + tprocessor enumeration moved to cpuinfo
1426
 
    + linker in target_info is now a class
1427
 
    * many many updates for m68k (will soon start to compile)
1428
 
    - removed some ifdef or correct them for correct cpu
1429
 
 
1430
 
  Revision 1.2  2002/08/05 17:27:52  carl
1431
 
    + updated m68k
1432
 
 
1433
 
  Revision 1.1  2002/07/29 17:51:32  carl
1434
 
    + restart m68k support
1435
 
 
1436
 
}
1437
 
 
1438