← Back to branch summary

~ubuntu-branches/ubuntu/dapper/fpc/dapper

« back to all changes in this revision

Viewing changes to compiler/m68k/agcpugas.pas

  • Committer: Bazaar Package Importer
  • Author(s): Carlos Laviola
  • Date: 2004-08-12 16:29:37 UTC
  • mfrom: (1.2.1 upstream) (2.1.1 warty)
  • Revision ID: james.westby@ubuntu.com-20040812162937-moo8ulvysp1ln771
Tags: 1.9.4-5
http://bugs.debian.org/265265
fp-compiler: needs ld, adding dependency on binutils.  (Closes: #265265)

Show diffs side-by-side

added added

removed removed

Lines of Context:
compiler/m68k/agcpugas.pas
 
1
{
 
2
    $Id: agcpugas.pas,v 1.11 2004/05/01 23:29:01 florian Exp $
 
3
    Copyright (c) 1998-2002 by Florian Klaempfl
 
4
 
 
5
    This unit implements an asmoutput class for m68k GAS syntax
 
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
{ This unit implements an asmoutput class for i386 AT&T syntax
 
24
}
 
25
unit agcpugas;
 
26
 
 
27
{$i fpcdefs.inc}
 
28
 
 
29
interface
 
30
 
 
31
    uses
 
32
      cclasses,cpubase,
 
33
      globals,
 
34
      aasmbase,aasmtai,aasmcpu,assemble,aggas;
 
35
 
 
36
    type
 
37
      TM68kAssembler=class(TGNUassembler)
 
38
      public
 
39
        procedure WriteInstruction(hp: tai);override;
 
40
      end;
 
41
 
 
42
    const
 
43
      gas_opsize2str : array[topsize] of string[2] =
 
44
      ('','.b','.w','.l','.s','.d','.x',''
 
45
      );
 
46
 
 
47
  implementation
 
48
 
 
49
    uses
 
50
      cutils,systems,
 
51
      cgbase,
 
52
      verbose,itcpugas;
 
53
 
 
54
 
 
55
    function getreferencestring(var ref : treference) : string;
 
56
      var
 
57
         s,basestr,indexstr : string;
 
58
 
 
59
      begin
 
60
         s:='';
 
61
         with ref do
 
62
           begin
 
63
             basestr:=gas_regname(base);
 
64
             indexstr:=gas_regname(index);
 
65
             if assigned(symbol) then
 
66
               s:=s+symbol.name;
 
67
 
 
68
             if offset<0 then s:=s+tostr(offset)
 
69
              else if (offset>0) then
 
70
                begin
 
71
                  if (symbol=nil) then s:=tostr(offset)
 
72
                       else s:=s+'+'+tostr(offset);
 
73
                    end
 
74
                  else if (index=NR_NO) and (base=NR_NO) and not assigned(symbol) then
 
75
                    s:=s+'0';
 
76
 
 
77
               if (index<>NR_NO) and (base=NR_NO) and (direction=dir_none) then
 
78
                begin
 
79
                  if (scalefactor = 1) or (scalefactor = 0) then
 
80
                    s:=s+'(,'+indexstr+'.l)'
 
81
                  else
 
82
                    s:=s+'(,'+indexstr+'.l*'+tostr(scalefactor)+')'
 
83
                end
 
84
                else if (index=NR_NO) and (base<>NR_NO) and (direction=dir_inc) then
 
85
                begin
 
86
                  if (scalefactor = 1) or (scalefactor = 0) then
 
87
                      s:=s+'('+basestr+')+'
 
88
                  else
 
89
                   InternalError(10002);
 
90
                end
 
91
                else if (index=NR_NO) and (base<>NR_NO) and (direction=dir_dec) then
 
92
                begin
 
93
                  if (scalefactor = 1) or (scalefactor = 0) then
 
94
                      s:=s+'-('+basestr+')'
 
95
                  else
 
96
                   InternalError(10003);
 
97
                end
 
98
                  else if (index=NR_NO) and (base<>NR_NO) and (direction=dir_none) then
 
99
                begin
 
100
                  s:=s+'('+basestr+')'
 
101
                end
 
102
                  else if (index<>NR_NO) and (base<>NR_NO) and (direction=dir_none) then
 
103
                begin
 
104
                  if (scalefactor = 1) or (scalefactor = 0) then
 
105
                    s:=s+'('+basestr+','+indexstr+'.l)'
 
106
                  else
 
107
                    s:=s+'('+basestr+','+indexstr+'.l*'+tostr(scalefactor)+')';
 
108
                end;
 
109
          end;
 
110
         getreferencestring:=s;
 
111
      end;
 
112
 
 
113
 
 
114
    function getopstr(const o:toper) : string;
 
115
      var
 
116
        hs : string;
 
117
        i : tsuperregister;
 
118
      begin
 
119
        case o.typ of
 
120
          top_reg:
 
121
            getopstr:=gas_regname(o.reg);
 
122
          top_ref:
 
123
            if o.ref^.refaddr=addr_full then
 
124
              begin
 
125
             if assigned(o.ref^.symbol) then
 
126
               hs:='#'+o.ref^.symbol.name
 
127
             else
 
128
               hs:='#';
 
129
               if o.ref^.offset>0 then
 
130
                hs:=hs+'+'+tostr(o.ref^.offset)
 
131
               else
 
132
                if o.ref^.offset<0 then
 
133
                 hs:=hs+tostr(o.ref^.offset)
 
134
               else
 
135
                if not(assigned(o.ref^.symbol)) then
 
136
                  hs:=hs+'0';
 
137
               getopstr:=hs;
 
138
              end
 
139
            else
 
140
              getopstr:=getreferencestring(o.ref^);
 
141
          top_reglist:
 
142
            begin
 
143
              hs:='';
 
144
              for i:=RS_D0 to RS_D7 do
 
145
                begin
 
146
                  if i in o.regset^ then
 
147
                   hs:=hs+gas_regname(newreg(R_INTREGISTER,i,R_SUBWHOLE))+'/';
 
148
                end;
 
149
              for i:=RS_A0 to RS_SP do
 
150
                begin
 
151
                  if i in o.regset^ then
 
152
                   hs:=hs+gas_regname(newreg(R_INTREGISTER,i,R_SUBWHOLE))+'/';
 
153
                end;
 
154
              delete(hs,length(hs),1);
 
155
              getopstr := hs;
 
156
            end;
 
157
          top_const:
 
158
            getopstr:='#'+tostr(longint(o.val));
 
159
          else internalerror(200405021);
 
160
        end;
 
161
      end;
 
162
 
 
163
 
 
164
    function getopstr_jmp(const o:toper) : string;
 
165
      var
 
166
        hs : string;
 
167
      begin
 
168
        case o.typ of
 
169
          top_reg:
 
170
            getopstr_jmp:=gas_regname(o.reg);
 
171
          top_ref:
 
172
            if o.ref^.refaddr=addr_no then
 
173
              getopstr_jmp:=getreferencestring(o.ref^)
 
174
            else
 
175
              begin
 
176
                if assigned(o.ref^.symbol) then
 
177
                  hs:=o.ref^.symbol.name
 
178
                else
 
179
                  hs:='';
 
180
                  if o.ref^.offset>0 then
 
181
                   hs:=hs+'+'+tostr(o.ref^.offset)
 
182
                  else
 
183
                   if o.ref^.offset<0 then
 
184
                    hs:=hs+tostr(o.ref^.offset)
 
185
                  else
 
186
                   if not(assigned(o.ref^.symbol)) then
 
187
                     hs:=hs+'0';
 
188
                getopstr_jmp:=hs;
 
189
              end;
 
190
          top_const:
 
191
            getopstr_jmp:=tostr(o.val);
 
192
          else internalerror(200405022);
 
193
        end;
 
194
      end;
 
195
 
 
196
{****************************************************************************
 
197
                            TM68kASMOUTPUT
 
198
 ****************************************************************************}
 
199
 
 
200
    { returns the opcode string }
 
201
    function getopcodestring(hp : tai) : string;
 
202
      var
 
203
        op : tasmop;
 
204
        s : string;
 
205
      begin
 
206
        op:=taicpu(hp).opcode;
 
207
        { old versions of GAS don't like PEA.L and LEA.L }
 
208
        if (op in [
 
209
         A_LEA,A_PEA,A_ABCD,A_BCHG,A_BCLR,A_BSET,A_BTST,
 
210
         A_EXG,A_NBCD,A_SBCD,A_SWAP,A_TAS,A_SCC,A_SCS,
 
211
         A_SEQ,A_SGE,A_SGT,A_SHI,A_SLE,A_SLS,A_SLT,A_SMI,
 
212
         A_SNE,A_SPL,A_ST,A_SVC,A_SVS,A_SF]) then
 
213
         s:=gas_op2str[op]
 
214
        else
 
215
        if op = A_SXX then
 
216
         s:=gas_op2str[op]+cond2str[taicpu(hp).condition]
 
217
        else
 
218
        if op in [a_dbxx,a_bxx,a_fbxx] then
 
219
         s:=gas_op2str[op]+cond2str[taicpu(hp).condition]+gas_opsize2str[taicpu(hp).opsize]
 
220
        else
 
221
         s:=gas_op2str[op]+gas_opsize2str[taicpu(hp).opsize];
 
222
        getopcodestring:=s;
 
223
      end;
 
224
 
 
225
 
 
226
    procedure TM68kAssembler.WriteInstruction(hp: tai);
 
227
      var
 
228
        op       : tasmop;
 
229
        s        : string;
 
230
        sep      : char;
 
231
        calljmp  : boolean;
 
232
        i        : integer;
 
233
       begin
 
234
         if hp.typ <> ait_instruction then exit;
 
235
         op:=taicpu(hp).opcode;
 
236
         calljmp:=is_calljmp(op);
 
237
         { call maybe not translated to call }
 
238
         s:=#9+getopcodestring(hp);
 
239
         { process operands }
 
240
         if taicpu(hp).ops<>0 then
 
241
           begin
 
242
             { call and jmp need an extra handling                          }
 
243
             { this code is only called if jmp isn't a labeled instruction  }
 
244
             { quick hack to overcome a problem with manglednames=255 chars }
 
245
             if calljmp then
 
246
                begin
 
247
                  AsmWrite(s+#9);
 
248
                  s:=getopstr_jmp(taicpu(hp).oper[0]^);
 
249
                end
 
250
              else
 
251
                begin
 
252
                  for i:=0 to taicpu(hp).ops-1 do
 
253
                    begin
 
254
                      if i=0 then
 
255
                        sep:=#9
 
256
                      else
 
257
                      if ((op = A_DIVSL) or
 
258
                         (op = A_DIVUL) or
 
259
                         (op = A_MULU) or
 
260
                         (op = A_MULS) or
 
261
                         (op = A_DIVS) or
 
262
                         (op = A_DIVU)) and (i=1) then
 
263
                        sep:=':'
 
264
                      else
 
265
                        sep:=',';
 
266
                      s:=s+sep+getopstr(taicpu(hp).oper[i]^)
 
267
                    end;
 
268
                end;
 
269
           end;
 
270
           AsmWriteLn(s);
 
271
       end;
 
272
 
 
273
 
 
274
{*****************************************************************************
 
275
                                  Initialize
 
276
*****************************************************************************}
 
277
 
 
278
    const
 
279
       as_m68k_as_info : tasminfo =
 
280
          (
 
281
            id     : as_gas;
 
282
            idtxt  : 'AS';
 
283
            asmbin : 'as';
 
284
            asmcmd : '-o $OBJ $ASM';
 
285
            supported_target : system_any;
 
286
            outputbinary: false;
 
287
            allowdirect : true;
 
288
            needar : true;
 
289
            labelprefix_only_inside_procedure : false;
 
290
            labelprefix : '.L';
 
291
            comment : '# ';
 
292
            secnames : ('',
 
293
              '.text','.data','.bss',
 
294
              '','','','','','',
 
295
              '.stab','.stabstr','COMMON')
 
296
          );
 
297
 
 
298
initialization
 
299
  RegisterAssembler(as_m68k_as_info,TM68kAssembler);
 
300
end.
 
301
{
 
302
  $Log: agcpugas.pas,v $
 
303
  Revision 1.11  2004/05/01 23:29:01  florian
 
304
    * continued to fix m68k compiler compilation
 
305
 
 
306
  Revision 1.10  2004/04/27 15:46:01  florian
 
307
    * several updates for compilation
 
308
 
 
309
  Revision 1.9  2004/04/27 15:00:37  florian
 
310
    - removed offsetfixup reference
 
311
 
 
312
  Revision 1.8  2004/04/25 21:26:16  florian
 
313
    * some m68k stuff fixed
 
314
 
 
315
  Revision 1.7  2003/02/19 22:00:16  daniel
 
316
    * Code generator converted to new register notation
 
317
    - Horribily outdated todo.txt removed
 
318
 
 
319
  Revision 1.6  2003/02/15 22:19:40  carl
 
320
   * bugfix of emissions of jmp instructions
 
321
 
 
322
  Revision 1.5  2003/01/08 18:43:57  daniel
 
323
   * Tregister changed into a record
 
324
 
 
325
  Revision 1.4  2002/11/30 23:33:02  carl
 
326
    * merges from Pierre's fixes in m68k fixes branch
 
327
 
 
328
  Revision 1.3  2002/09/07 15:25:11  peter
 
329
    * old logs removed and tabs fixed
 
330
 
 
331
  Revision 1.2  2002/08/13 18:58:54  carl
 
332
    + m68k problems with cvs fixed?()!
 
333
 
 
334
}