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