{ $Id$ Copyright (c) 1998 by the FPC development team This unit implements an asmoutput class for MOTOROLA syntax with Motorola 68000 (recognized by the Amiga Assembler and Charlie Gibbs's A68k) This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. **************************************************************************** } unit ag68kmot; interface uses aasm,assemble; type pm68kmotasmlist=^tm68kmotasmlist; tm68kmotasmlist = object(tasmlist) procedure WriteTree(p:paasmoutput);virtual; procedure WriteAsmList;virtual; end; implementation uses dos,globals,systems,cobjects,m68k, strings,files,verbose {$ifdef GDB} ,gdb {$endif GDB} ; const line_length = 70; function getreferencestring(const ref : treference) : string; var s : string; begin s:=''; if ref.isintvalue then s:='#'+tostr(ref.offset) else with ref do begin if (index=R_NO) and (base=R_NO) and (direction=dir_none) then begin if assigned(symbol) then begin s:=s+symbol^; if offset<0 then s:=s+tostr(offset) else if (offset>0) then s:=s+'+'+tostr(offset); end else begin { direct memory addressing } s:=s+'('+tostr(offset)+').l'; end; end else begin if assigned(symbol) then s:=s+symbol^; if offset<0 then s:=s+tostr(offset) else if (offset>0) then begin if (symbol=nil) then s:=tostr(offset) else s:=s+'+'+tostr(offset); end; if (index<>R_NO) and (base=R_NO) and (direction=dir_none) then begin if (scalefactor = 1) or (scalefactor = 0) then begin if offset = 0 then s:=s+'0(,'+mot_reg2str[index]+'.l)' else s:=s+'(,'+mot_reg2str[index]+'.l)'; end else begin if offset = 0 then s:=s+'0(,'+mot_reg2str[index]+'.l*'+tostr(scalefactor)+')' else s:=s+'(,'+mot_reg2str[index]+'.l*'+tostr(scalefactor)+')'; end end else if (index=R_NO) and (base<>R_NO) and (direction=dir_inc) then begin if (scalefactor = 1) or (scalefactor = 0) then s:=s+'('+mot_reg2str[base]+')+' else InternalError(10002); end else if (index=R_NO) and (base<>R_NO) and (direction=dir_dec) then begin if (scalefactor = 1) or (scalefactor = 0) then s:=s+'-('+mot_reg2str[base]+')' else InternalError(10003); end else if (index=R_NO) and (base<>R_NO) and (direction=dir_none) then begin s:=s+'('+mot_reg2str[base]+')'; end else if (index<>R_NO) and (base<>R_NO) and (direction=dir_none) then begin if (scalefactor = 1) or (scalefactor = 0) then begin if offset = 0 then s:=s+'0('+mot_reg2str[base]+','+mot_reg2str[index]+'.l)' else s:=s+'('+mot_reg2str[base]+','+mot_reg2str[index]+'.l)'; end else begin if offset = 0 then s:=s+'0('+mot_reg2str[base]+','+mot_reg2str[index]+'.l*'+tostr(scalefactor)+')' else s:=s+'('+mot_reg2str[base]+','+mot_reg2str[index]+'.l*'+tostr(scalefactor)+')'; end end { if this is not a symbol, and is not in the above, then there is an error } else if NOT assigned(symbol) then InternalError(10004); end; { endif } end; { end with } getreferencestring:=s; end; function getopstr(t : byte;o : pointer) : string; var hs : string; i: tregister; begin case t of top_reg : getopstr:=mot_reg2str[tregister(o)]; top_reglist: begin hs:=''; for i:=R_NO to R_FPSR do begin if i in tregisterlist(o^) then hs:=hs+mot_reg2str[i]+'/'; end; delete(hs,length(hs),1); getopstr := hs; end; top_ref : getopstr:=getreferencestring(preference(o)^); top_const : getopstr:='#'+tostr(longint(o)); top_symbol : begin { compare with i386 version, where this is a constant. } hs[0]:=chr(strlen(pchar(pcsymbol(o)^.symbol))); move(pchar(pcsymbol(o)^.symbol)^,hs[1],byte(hs[0])); { inc(byte(hs[0]));} { hs[1]:='#';} if pcsymbol(o)^.offset>0 then hs:=hs+'+'+tostr(pcsymbol(o)^.offset) else if pcsymbol(o)^.offset<0 then hs:=hs+tostr(pcsymbol(o)^.offset); getopstr:=hs; end; else internalerror(10001); end; end; function getopstr_jmp(t : byte;o : pointer) : string; var hs : string; begin case t of top_reg : getopstr_jmp:=mot_reg2str[tregister(o)]; top_ref : getopstr_jmp:=getreferencestring(preference(o)^); top_const : getopstr_jmp:=tostr(longint(o)); top_symbol : begin hs[0]:=chr(strlen(pchar(pcsymbol(o)^.symbol))); move(pchar(pcsymbol(o)^.symbol)^,hs[1],byte(hs[0])); if pcsymbol(o)^.offset>0 then hs:=hs+'+'+tostr(pcsymbol(o)^.offset) else if pcsymbol(o)^.offset<0 then hs:=hs+tostr(pcsymbol(o)^.offset); getopstr_jmp:=hs; end; else internalerror(10001); end; end; {**************************************************************************** TM68KMOTASMLIST ****************************************************************************} procedure tm68kmotasmlist.WriteTree(p:paasmoutput); var hp : pai; s : string; counter, i,j,lines : longint; quoted : boolean; begin hp:=pai(p^.first); while assigned(hp) do begin case hp^.typ of ait_comment : ; ait_align : AsmWriteLn(#9'CNOP 0,'+tostr(pai_align(hp)^.aligntype)); ait_external : AsmWriteLn(#9'XREF'#9+StrPas(pai_external(hp)^.name)); ait_real_extended : Message(assem_e_extended_not_supported); ait_comp : Message(assem_e_comp_not_supported); ait_datablock : begin { ------------------------------------------------------- } { ----------- ALIGNMENT FOR ANY NON-BYTE VALUE ---------- } { ------------- REQUIREMENT FOR 680x0 ------------------- } { ------------------------------------------------------- } if pai_datablock(hp)^.size <> 1 then begin if not(cs_littlesize in aktswitches) then AsmWriteLn(#9'CNOP 0,4') else AsmWriteLn(#9'CNOP 0,2'); end; if pai_datablock(hp)^.is_global then AsmWriteLn(#9'XDEF'#9+StrPas(pai_datablock(hp)^.name)); AsmWriteLn(StrPas(pai_datablock(hp)^.name)+#9#9'DS.B '+tostr(pai_datablock(hp)^.size)); end; ait_const_32bit : Begin if not(cs_littlesize in aktswitches) then AsmWriteLn(#9'CNOP 0,4') else AsmWriteLn(#9'CNOP 0,2'); AsmWriteLn(#9#9'DC.L'#9+tostr(pai_const(hp)^.value)); end; ait_const_16bit : Begin if not(cs_littlesize in aktswitches) then AsmWriteLn(#9'CNOP 0,4') else AsmWriteLn(#9'CNOP 0,2'); AsmWriteLn(#9#9'DC.W'#9+tostr(pai_const(hp)^.value)); end; ait_const_8bit : AsmWriteLn(#9#9'DC.B'#9+tostr(pai_const(hp)^.value)); ait_const_symbol : Begin if not(cs_littlesize in aktswitches) then AsmWriteLn(#9'CNOP 0,4') else AsmWriteLn(#9'CNOP 0,2'); AsmWriteLn(#9#9+'DC.L '#9+StrPas(pchar(pai_const(hp)^.value))); end; ait_real_64bit : Begin if not(cs_littlesize in aktswitches) then AsmWriteLn(#9'CNOP 0,4') else AsmWriteLn(#9'CNOP 0,2'); AsmWriteLn(#9#9'DC.D'#9+double2str(pai_double(hp)^.value)); end; ait_real_32bit : Begin if not(cs_littlesize in aktswitches) then AsmWriteLn(#9'CNOP 0,4') else AsmWriteLn(#9'CNOP 0,2'); AsmWriteLn(#9#9'DC.S'#9+double2str(pai_single(hp)^.value)); end; { TO SUPPORT SOONER OR LATER!!! ait_comp : AsmWriteLn(#9#9'DC.D'#9+comp2str(pai_extended(hp)^.value));} ait_string : begin counter := 0; lines := pai_string(hp)^.len div line_length; { separate lines in different parts } if pai_string(hp)^.len > 0 then Begin for j := 0 to lines-1 do begin AsmWrite(#9#9'DC.B'#9); quoted:=false; for i:=counter to counter+line_length do begin { it is an ascii character. } if (ord(pai_string(hp)^.str[i])>31) and (ord(pai_string(hp)^.str[i])<128) and (pai_string(hp)^.str[i]<>'"') then begin if not(quoted) then begin if i>counter then AsmWrite(','); AsmWrite('"'); end; AsmWrite(pai_string(hp)^.str[i]); quoted:=true; end { if > 31 and < 128 and ord('"') } else begin if quoted then AsmWrite('"'); if i>counter then AsmWrite(','); quoted:=false; AsmWrite(tostr(ord(pai_string(hp)^.str[i]))); end; end; { end for i:=0 to... } if quoted then AsmWrite('"'); AsmWrite(target_info.newline); counter := counter+line_length; end; { end for j:=0 ... } { do last line of lines } AsmWrite(#9#9'DC.B'#9); quoted:=false; for i:=counter to pai_string(hp)^.len-1 do begin { it is an ascii character. } if (ord(pai_string(hp)^.str[i])>31) and (ord(pai_string(hp)^.str[i])<128) and (pai_string(hp)^.str[i]<>'"') then begin if not(quoted) then begin if i>counter then AsmWrite(','); AsmWrite('"'); end; AsmWrite(pai_string(hp)^.str[i]); quoted:=true; end { if > 31 and < 128 and " } else begin if quoted then AsmWrite('"'); if i>counter then AsmWrite(','); quoted:=false; AsmWrite(tostr(ord(pai_string(hp)^.str[i]))); end; end; { end for i:=0 to... } if quoted then AsmWrite('"'); end; { endif } AsmLn; end; ait_label : begin AsmWrite(lab2str(pai_label(hp)^.l)); if assigned(hp^.next) and not(pai(hp^.next)^.typ in [ait_const_32bit,ait_const_16bit,ait_const_8bit,ait_const_symbol, ait_real_64bit,ait_string]) then AsmWriteLn(':'); end; ait_direct : begin AsmWritePChar(pai_direct(hp)^.str); AsmLn; end; ait_labeled_instruction : Begin { labeled operand } if pai_labeled(hp)^._op1 = R_NO then AsmWriteLn(#9+mot_op2str[pai_labeled(hp)^._operator]+#9+lab2str(pai_labeled(hp)^.lab)) else { labeled operand with register } AsmWriteLn(#9+mot_op2str[pai_labeled(hp)^._operator]+#9+ reg2str(pai_labeled(hp)^._op1)+','+lab2str(pai_labeled(hp)^.lab)) end; ait_symbol : begin { ------------------------------------------------------- } { ----------- ALIGNMENT FOR ANY NON-BYTE VALUE ---------- } { ------------- REQUIREMENT FOR 680x0 ------------------- } { ------------------------------------------------------- } if assigned(hp^.next) and (pai(hp^.next)^.typ in [ait_const_32bit,ait_const_16bit,ait_const_symbol, ait_real_64bit,ait_real_32bit,ait_string]) then begin if not(cs_littlesize in aktswitches) then AsmWriteLn(#9'CNOP 0,4') else AsmWriteLn(#9'CNOP 0,2'); end; if pai_symbol(hp)^.is_global then AsmWriteLn(#9'XDEF '+StrPas(pai_symbol(hp)^.name)); AsmWritePChar(pai_symbol(hp)^.name); if assigned(hp^.next) and not(pai(hp^.next)^.typ in [ait_const_32bit,ait_const_16bit,ait_const_8bit,ait_const_symbol, ait_real_64bit,ait_string,ait_real_32bit]) then AsmWriteLn(':'); end; ait_instruction : begin s:=#9+mot_op2str[pai68k(hp)^._operator]+mot_opsize2str[pai68k(hp)^.size]; if pai68k(hp)^.op1t<>top_none then begin { call and jmp need an extra handling } { this code is only called if jmp isn't a labeled instruction } if pai68k(hp)^._operator in [A_JSR,A_JMP] then s:=s+#9+getopstr_jmp(pai68k(hp)^.op1t,pai68k(hp)^.op1) else begin if pai68k(hp)^.op1t = top_reglist then s:=s+#9+getopstr(pai68k(hp)^.op1t,@(pai68k(hp)^.reglist)) else s:=s+#9+getopstr(pai68k(hp)^.op1t,pai68k(hp)^.op1); if pai68k(hp)^.op2t<>top_none then begin if pai68k(hp)^.op2t = top_reglist then s:=s+','+getopstr(pai68k(hp)^.op2t,@pai68k(hp)^.reglist) else s:=s+','+getopstr(pai68k(hp)^.op2t,pai68k(hp)^.op2); { three operands } if pai68k(hp)^.op3t<>top_none then begin if (pai68k(hp)^._operator = A_DIVSL) or (pai68k(hp)^._operator = A_DIVUL) or (pai68k(hp)^._operator = A_MULU) or (pai68k(hp)^._operator = A_MULS) or (pai68k(hp)^._operator = A_DIVS) or (pai68k(hp)^._operator = A_DIVU) then s:=s+':'+getopstr(pai68k(hp)^.op3t,pai68k(hp)^.op3) else s:=s+','+getopstr(pai68k(hp)^.op3t,pai68k(hp)^.op3); end; end; end; end; AsmWriteLn(s); end; {$ifdef GDB} ait_stabn, ait_stabs, ait_stab_function_name : ; {$endif GDB} else internalerror(10000); end; { if ((hp^.typ<>ait_label) and (hp^.typ<>ait_symbol)) or (assigned(hp^.next) and not(pai(hp^.next)^.typ in [ait_const_32bit,ait_const_16bit,ait_const_8bit,ait_const_symbol, ait_real_64bit,ait_string])) then AsmLn} hp:=pai(hp^.next); end; end; procedure tm68kmotasmlist.WriteAsmList; begin {$ifdef EXTDEBUG} if assigned(current_module^.mainsource) then comment(v_info,'Start writing motorola-styled assembler output for '+current_module^.mainsource^); {$endif} WriteTree(externals); AsmLn; AsmWriteLn(#9'SECTION _CODE,CODE'); WriteTree(codesegment); AsmLn; AsmWriteLn(#9'SECTION _DATA,DATA'); { write a signature to the file } AsmWriteLn(#9'CNOP 0,4'); {$ifdef EXTDEBUG} AsmWriteLn(#9'DC.B'#9'"compiled by FPC '+version_string+'\0"'); AsmWriteLn(#9'DC.B'#9'"target: '+target_info.target_name+'\0"'); {$endif EXTDEBUG} WriteTree(datasegment); WriteTree(consts); AsmLn; AsmWriteLn(#9'SECTION _BSS,BSS'); WriteTree(bsssegment); AsmLn; AsmWriteLn(#9'END'); {$ifdef EXTDEBUG} if assigned(current_module^.mainsource) then comment(v_info,'Done writing motorola-styled assembler output for '+current_module^.mainsource^); {$endif} end; end. { $Log$ Revision 1.1 1998-03-25 11:18:16 root Initial revision Revision 1.3 1998/03/22 12:45:37 florian * changes of Carl-Eric to m68k target commit: - wrong nodes because of the new string cg in intel, I had to create this under m68k also ... had to work it out to fix potential alignment problems --> this removes the crash of the m68k compiler. - added absolute addressing in m68k assembler (required for Amiga startup) - fixed alignment problems (because of byte return values, alignment would not be always valid) -- is this ok if i change the offset if odd in setfirsttemp ?? -- it seems ok... Revision 1.2 1998/03/10 04:23:33 carl - removed in because can cause range check errors under BP Revision 1.1 1998/03/10 01:26:10 peter + new uniform names }