1 {
2     Copyright (c) 1998-2006 by the Free Pascal development team
3 
4     This unit implements an asmoutput class for m68k GAS syntax
5 
6     This program is free software; you can redistribute it and/or modify
7     it under the terms of the GNU General Public License as published by
8     the Free Software Foundation; either version 2 of the License, or
9     (at your option) any later version.
10 
11     This program is distributed in the hope that it will be useful,
12     but WITHOUT ANY WARRANTY; without even the implied warranty of
13     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
14     GNU General Public License for more details.
15 
16     You should have received a copy of the GNU General Public License
17     along with this program; if not, write to the Free Software
18     Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
19 
20  ****************************************************************************
21 }
22 unit ag68kgas;
23 
24 {$i fpcdefs.inc}
25 
26 interface
27 
28     uses
29       cclasses,cpubase,systems,
30       globals,globtype,
31       aasmbase,aasmtai,aasmdata,aasmcpu,assemble,aggas;
32 
33     type
34       Tm68kGNUAssembler=class(TGNUassembler)
35         constructor CreateWithWriter(info: pasminfo; wr: TExternalAssemblerOutputFile; freewriter, smart: boolean); override;
MakeCmdLinenull36         function MakeCmdLine : TCmdStr; override;
37       end;
38 
39     type
40       Tm68kAoutGNUAssembler=class(TAoutGNUAssembler)
41         constructor CreateWithWriter(info: pasminfo; wr: TExternalAssemblerOutputFile; freewriter, smart: boolean); override;
MakeCmdLinenull42         function MakeCmdLine : TCmdStr; override;
43       end;
44 
45 
46     type
47       Tm68kInstrWriter=class(TCPUInstrWriter)
48         procedure WriteInstruction(hp: tai);override;
49       end;
50 
51     const
52       gas_opsize2str : array[topsize] of string[2] =
53         ('','.b','.w','.l','.s','.d','.x','');
54 
55 
56   implementation
57 
58     uses
59       cutils,
60       cgbase,cgutils,cpuinfo,
61       verbose,itcpugas;
62 
63 
GasMachineArgnull64     function GasMachineArg: string;
65       const
66         MachineArgNewOld: array[boolean] of string = ('-march=','-m');
67       begin
68         result:=MachineArgNewOld[target_info.system in [system_m68k_amiga,system_m68k_palmos]]+GasCpuTypeStr[current_settings.cputype];
69       end;
70 
71  {****************************************************************************}
72  {                         GNU m68k Assembler writer                          }
73  {****************************************************************************}
74 
75  constructor Tm68kGNUAssembler.CreateWithWriter(info: pasminfo; wr: TExternalAssemblerOutputFile; freewriter, smart: boolean);
76    begin
77      inherited;
78      InstrWriter := Tm68kInstrWriter.create(self);
79    end;
80 
Tm68kGNUAssembler.MakeCmdLinenull81  function Tm68kGNUAssembler.MakeCmdLine: TCmdStr;
82    begin
83      result:=inherited MakeCmdLine;
84      Replace(result,'$ARCH',GasMachineArg);
85    end;
86 
87 
88  {****************************************************************************}
89  {                         GNU m68k Aout Assembler writer                     }
90  {****************************************************************************}
91 
92  constructor Tm68kAoutGNUAssembler.CreateWithWriter(info: pasminfo; wr: TExternalAssemblerOutputFile; freewriter, smart: boolean);
93    begin
94      inherited;
95      InstrWriter := Tm68kInstrWriter.create(self);
96    end;
97 
Tm68kAoutGNUAssembler.MakeCmdLinenull98  function Tm68kAoutGNUAssembler.MakeCmdLine: TCmdStr;
99    begin
100      result:=inherited MakeCmdLine;
101      Replace(result,'$ARCH',GasMachineArg);
102    end;
103 
104 
getreferencestringnull105     function getreferencestring(var ref : treference) : string;
106       var
107         s: string absolute getreferencestring; { shortcut name to result }
108         basestr, indexstr : string;
109       begin
110         s:='';
111         with ref do
112           begin
113             basestr:=gas_regname(base);
114             indexstr:=gas_regname(index);
115 
116             if assigned(symbol) then
117               begin
118                 s:=s+symbol.name;
119                 if (offset <> 0) then
120                   s:=s+tostr_with_plus(offset);
121                 if (target_info.system = system_m68k_palmos) and (symbol.typ = AT_DATA) then
122                   s:=s+'@END';
123               end
124             else
125               if (offset <> 0) or ((index=NR_NO) and (base=NR_NO)) then
126                 s:=s+tostr(offset);
127 
128             case direction of
129               dir_none:
130                 begin
131                   if (base<>NR_NO) and (index=NR_NO) then
132                     begin
133                       if not (scalefactor in [0,1]) then
134                         internalerror(2017011303);
135                       s:=s+'('+basestr+')';
136                       exit;
137                     end;
138                   if (base<>NR_NO) and (index<>NR_NO) then
139                     begin
140                       if scalefactor in [0,1] then
141                         s:=s+'('+basestr+','+indexstr+'.l)'
142                       else
143                         s:=s+'('+basestr+','+indexstr+'.l*'+tostr(scalefactor)+')';
144                       exit;
145                     end;
146                   if (base=NR_NO) and (index<>NR_NO) then
147                     begin
148                       if scalefactor in [0,1] then
149                         s:=s+'('+indexstr+'.l)'
150                       else
151                         s:=s+'('+indexstr+'.l*'+tostr(scalefactor)+')';
152                       exit;
153                     end;
154                 end;
155               dir_inc:
156                 begin
157                   if (base=NR_NO) or (index<>NR_NO) or not (scalefactor in [0,1]) then
158                     internalerror(2017011301);
159                   s:=s+'('+basestr+')+';
160                 end;
161               dir_dec:
162                 begin
163                   if (base=NR_NO) or (index<>NR_NO) or not (scalefactor in [0,1]) then
164                     internalerror(2017011302);
165                   s:=s+'-('+basestr+')';
166                 end;
167             end;
168         end;
169       end;
170 
171 
getopstrnull172     function getopstr(size: topsize; var o:toper) : string;
173       var
174         i : tsuperregister;
175       begin
176         case o.typ of
177           top_reg:
178             getopstr:=gas_regname(o.reg);
179           top_ref:
180             if o.ref^.refaddr=addr_full then
181               begin
182                 if assigned(o.ref^.symbol) then
183                   getopstr:=o.ref^.symbol.name
184                 else
185                   getopstr:='#';
186                 if o.ref^.offset>0 then
187                   getopstr:=getopstr+'+'+tostr(o.ref^.offset)
188                 else
189                   if o.ref^.offset<0 then
190                     getopstr:=getopstr+tostr(o.ref^.offset)
191                   else
192                     if not(assigned(o.ref^.symbol)) then
193                       getopstr:=getopstr+'0';
194               end
195             else
196               getopstr:=getreferencestring(o.ref^);
197           top_regset:
198             begin
199               getopstr:='';
200               for i:=RS_D0 to RS_D7 do
201                 begin
202                   if i in o.dataregset then
203                    getopstr:=getopstr+gas_regname(newreg(R_INTREGISTER,i,R_SUBWHOLE))+'/';
204                 end;
205               for i:=RS_A0 to RS_SP do
206                 begin
207                   if i in o.addrregset then
208                    getopstr:=getopstr+gas_regname(newreg(R_ADDRESSREGISTER,i,R_SUBWHOLE))+'/';
209                 end;
210               for i:=RS_FP0 to RS_FP7 do
211                 begin
212                   if i in o.fpuregset then
213                    getopstr:=getopstr+gas_regname(newreg(R_FPUREGISTER,i,R_SUBNONE))+'/';
214                 end;
215               delete(getopstr,length(getopstr),1);
216             end;
217           top_regpair:
218             getopstr:=gas_regname(o.reghi)+':'+gas_regname(o.reglo);
219           top_const:
220             getopstr:='#'+tostr(longint(o.val));
221           top_realconst:
222             begin
223               case size of
224                 S_FS:
225                   getopstr:='#0x'+hexstr(longint(single(o.val_real)),sizeof(single)*2);
226                 S_FD:
227                   getopstr:='#0x'+hexstr(BestRealRec(o.val_real).Data,sizeof(bestreal)*2);
228               else
229                 internalerror(2021020801);
230               end;
231             end;
232           else internalerror(200405021);
233         end;
234       end;
235 
236 
getopstr_jmpnull237     function getopstr_jmp(var o:toper) : string;
238       begin
239         case o.typ of
240           top_reg:
241             getopstr_jmp:=gas_regname(o.reg);
242           top_ref:
243             if o.ref^.refaddr=addr_no then
244               getopstr_jmp:=getreferencestring(o.ref^)
245             else
246               begin
247                 if assigned(o.ref^.symbol) then
248                   getopstr_jmp:=o.ref^.symbol.name
249                 else
250                   getopstr_jmp:='';
251                 if o.ref^.offset>0 then
252                   getopstr_jmp:=getopstr_jmp+'+'+tostr(o.ref^.offset)
253                 else
254                   if o.ref^.offset<0 then
255                     getopstr_jmp:=getopstr_jmp+tostr(o.ref^.offset)
256                   else
257                     if not(assigned(o.ref^.symbol)) then
258                       getopstr_jmp:=getopstr_jmp+'0';
259               end;
260           top_const:
261             getopstr_jmp:=tostr(o.val);
262           else
263             internalerror(200405022);
264         end;
265       end;
266 
267 {****************************************************************************
268                             TM68kASMOUTPUT
269  ****************************************************************************}
270 
271     { returns the opcode string }
getopcodestringnull272     function getopcodestring(hp : tai) : string;
273       var
274         op : tasmop;
275       begin
276         op:=taicpu(hp).opcode;
277         { old versions of GAS don't like PEA.L and LEA.L }
278         if (op in [
279           A_LEA,A_PEA,A_ABCD,A_BCHG,A_BCLR,A_BSET,A_BTST,
280           A_EXG,A_NBCD,A_SBCD,A_SWAP,A_TAS,A_SCC,A_SCS,
281           A_SEQ,A_SGE,A_SGT,A_SHI,A_SLE,A_SLS,A_SLT,A_SMI,
282           A_SNE,A_SPL,A_ST,A_SVC,A_SVS,A_SF]) then
283           result:=gas_op2str[op]
284         else
285         { Scc/FScc is always BYTE, DBRA/DBcc is always WORD, doesn't need opsize (KB) }
286         if op in [A_SXX, A_FSXX, A_DBXX, A_DBRA] then
287           result:=gas_op2str[op]+cond2str[taicpu(hp).condition]
288         else
289         { fix me: a fugly hack to utilize GNU AS pseudo instructions for more optimal branching }
290         if op in [A_JSR] then
291           result:='jbsr'
292         else
293         if op in [A_JMP] then
294           result:='jra'
295         else
296         if op in [A_BXX] then
297           result:='j'+cond2str[taicpu(hp).condition]+gas_opsize2str[taicpu(hp).opsize]
298         else
299         if op in [A_FBXX] then
300           result:='fj'+{gas_op2str[op]+}cond2str[taicpu(hp).condition]+gas_opsize2str[taicpu(hp).opsize]
301         else
302           result:=gas_op2str[op]+gas_opsize2str[taicpu(hp).opsize];
303       end;
304 
305 
306     procedure Tm68kInstrWriter.WriteInstruction(hp: tai);
307       var
308         op       : tasmop;
309         s        : string;
310         sep      : char;
311         i        : integer;
312        begin
313          if hp.typ <> ait_instruction then exit;
314          op:=taicpu(hp).opcode;
315          { call maybe not translated to call }
316          s:=#9+getopcodestring(hp);
317          { process operands }
318          if taicpu(hp).ops<>0 then
319            begin
320              { call and jmp need an extra handling                          }
321              { this code is only called if jmp isn't a labeled instruction  }
322              { quick hack to overcome a problem with manglednames=255 chars }
323              if is_calljmp(op) then
324                 begin
325                   s:=s+#9+getopstr_jmp(taicpu(hp).oper[0]^);
326                   { dbcc dx,<sym> has two operands! (KB) }
327                   if (taicpu(hp).ops>1) then
328                     s:=s+','+getopstr_jmp(taicpu(hp).oper[1]^);
329                   if (taicpu(hp).ops>2) then
330                     internalerror(2006120501);
331                 end
332               else
333                 begin
334                   for i:=0 to taicpu(hp).ops-1 do
335                     begin
336                       if i=0 then
337                         sep:=#9
338                       else
339                       if (i=2) and
340                          (op in [A_DIVSL,A_DIVUL,A_MULS,A_MULU,A_DIVS,A_DIVU,A_REMS,A_REMU]) then
341                         sep:=':'
342                       else
343                         sep:=',';
344                       s:=s+sep+getopstr(taicpu(hp).opsize,taicpu(hp).oper[i]^);
345                     end;
346                 end;
347            end;
348            owner.writer.AsmWriteLn(s);
349        end;
350 
351 
352 {*****************************************************************************
353                                   Initialize
354 *****************************************************************************}
355 
356     const
357        as_m68k_as_info : tasminfo =
358           (
359             id     : as_gas;
360             idtxt  : 'AS';
361             asmbin : 'as';
362             asmcmd : '$ARCH -o $OBJ $EXTRAOPT $ASM';
363             supported_targets : [system_m68k_macosclassic,system_m68k_linux,system_m68k_PalmOS,system_m68k_netbsd,system_m68k_embedded];
364             flags : [af_needar,af_smartlink_sections];
365             labelprefix : '.L';
366             comment : '# ';
367             dollarsign: '$';
368           );
369 
370        as_m68k_as_aout_info : tasminfo =
371           (
372             id     : as_m68k_as_aout;
373             idtxt  : 'AS-AOUT';
374             asmbin : 'as';
375             asmcmd : '$ARCH -o $OBJ $EXTRAOPT $ASM';
376             supported_targets : [system_m68k_Amiga,system_m68k_Atari];
377             flags : [af_needar];
378             labelprefix : '.L';
379             comment : '# ';
380             dollarsign: '$';
381           );
382 
383 
384 
385 initialization
386   RegisterAssembler(as_m68k_as_info,Tm68kGNUAssembler);
387   RegisterAssembler(as_m68k_as_aout_info,Tm68kAoutGNUAssembler);
388 end.
389