home *** CD-ROM | disk | FTP | other *** search
- {
- $Id: ag68kmit.pas,v 1.1.1.1.2.4 1998/09/14 18:55:48 carl Exp $
- Copyright (c) 1998 by the FPC development team
-
- This unit implements an asmoutput class for MIT syntax with
- Motorola 68000 (for MIT syntax TEST WITH GAS v1.34)
-
- 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.
-
- ****************************************************************************
-
- What's to do:
- o Verify if this actually work as indirect mode with name of variables
- o write lines numbers and file names to output file
- o generate debugging informations
- }
-
- unit ag68kmit;
-
- interface
-
- uses aasm,assemble;
-
- type
- pm68kmitasmlist=^tm68kmitasmlist;
- tm68kmitasmlist = 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;
-
- var
- infile : pextfile;
- includecount,lastline : longint;
-
- function getreferencestring(const ref : treference) : string;
- var
- s : string;
- begin
- s:='';
- if ref.isintvalue then
- s:='#'+tostr(ref.offset)
- else
- with ref do
- begin
- { symbol and offset }
- if (assigned(symbol)) and (offset<>0) then
- Begin
- s:=s+'('+tostr(offset)+symbol^;
- end
- else
- { symbol only }
- if (assigned(symbol)) and (offset=0) then
- Begin
- s:=s+'('+symbol^;
- end
- else
- { offset only }
- if (symbol=nil) and (offset<>0) then
- Begin
- s:=s+'('+tostr(offset);
- end
- else
- { NOTHING - put zero as offset }
- if (symbol=nil) and (offset=0) then
- Begin
- s:=s+'('+'0';
- end
- else
- InternalError(10004);
- if (index<>R_NO) and (base=R_NO) and (direction=dir_none) then
- InternalError(10004)
- else if (index=R_NO) and (base<>R_NO) and (direction=dir_inc) then
- begin
- if (scalefactor = 1) or (scalefactor = 0) then
- Begin
- if offset<>0 then
- s:=mit_reg2str[base]+'@+'+s+')'
- else
- s:=mit_reg2str[base]+'@+';
- end
- 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
- Begin
- if offset<>0 then
- s:=mit_reg2str[base]+'@-'+s+')'
- else
- s:=mit_reg2str[base]+'@-';
- end
- else
- InternalError(10003);
- end
- else if (index=R_NO) and (base<>R_NO) and (direction=dir_none) then
- begin
- if (offset=0) and (symbol=nil) then
- s:=mit_reg2str[base]+'@'
- else
- s:=mit_reg2str[base]+'@'+s+')';
- end
- else if (index<>R_NO) and (base<>R_NO) and (direction=dir_none) then
- begin
- s:=mit_reg2str[base]+'@'+s+','+mit_reg2str[index]+':L';
- if (scalefactor = 1) or (scalefactor = 0) then
- s:=s+')'
- else
- s:=s+':'+tostr(scalefactor)+')';
- end
- else
- if assigned(symbol) then
- Begin
- s:=symbol^;
- if offset<>0 then
- s:=s+'+'+tostr(offset);
- end
- { this must be a physical address }
- else
- s:=s+')';
- { else if NOT assigned(symbol) then
- InternalError(10004);}
- 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:=mit_reg2str[tregister(o)];
- top_ref : getopstr:=getreferencestring(preference(o)^);
- top_reglist: begin
- hs:='';
- for i:=R_NO to R_FPSR do
- begin
- if i in tregisterlist(o^) then
- hs:=hs+mit_reg2str[i]+'/';
- end;
- delete(hs,length(hs),1);
- getopstr := hs;
- end;
- top_const : getopstr:='#'+tostr(longint(o));
- top_symbol :
- { compare with i386, where a symbol is considered }
- { a constant. }
- begin
- hs[0]:=chr(strlen(pchar(pcsymbol(o)^.symbol)));
- move(pchar(pcsymbol(o)^.symbol)^,hs[1],byte(hs[0]));
- { inc(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:=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:=mit_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;
-
-
- {****************************************************************************
- T68kGASASMOUTPUT
- ****************************************************************************}
-
- var
- { different types of source lines }
- n_line : byte;
-
- const
- ait_const2str:array[ait_const_32bit..ait_const_8bit] of string[8]=
- (#9'.long'#9,'',#9'.short'#9,#9'.byte'#9);
-
- procedure tm68kmitasmlist.WriteTree(p:paasmoutput);
- var
- hp : pai;
- ch : char;
- consttyp : tait;
- s : string;
- pos,l,i : longint;
- found : boolean;
- {$ifdef GDB}
- funcname : pchar;
- linecount : longint;
- {$endif GDB}
- begin
- {$ifdef GDB}
- funcname:=nil;
- linecount:=1;
- {$endif GDB}
- hp:=pai(p^.first);
- while assigned(hp) do
- begin
- { write debugger informations }
- {$ifdef GDB}
- if cs_debuginfo in aktswitches then
- begin
- if not (hp^.typ in [ait_external,ait_stabn,ait_stabs,ait_stab_function_name]) then
- begin
- if assigned(hp^.infile) and (pextfile(hp^.infile)<>infile) then
- begin
- infile:=hp^.infile;
- inc(includecount);
- if (hp^.infile^.path^<>'') then
- begin
- AsmWriteLn(#9'.stabs "'+FixPath(hp^.infile^.path^)+'",'+tostr(n_includefile)+
- ',0,0,Ltext'+ToStr(IncludeCount));
- end;
- AsmWriteLn(#9'.stabs "'+FixFileName(hp^.infile^.name^+hp^.infile^.ext^)+'",'+tostr(n_includefile)+
- ',0,0,Ltext'+ToStr(IncludeCount));
- AsmWriteLn('Ltext'+ToStr(IncludeCount)+':');
- end;
- { file name must be there before line number ! }
- if (hp^.line<>lastline) and (hp^.line<>0) then
- begin
- if (n_line = n_textline) and assigned(funcname) and
- (target_info.use_function_relative_addresses) then
- begin
- AsmWriteLn(target_info.labelprefix+'l'+tostr(linecount)+':');
- AsmWriteLn(#9'.stabn '+tostr(n_line)+',0,'+tostr(hp^.line)+','+
- target_info.labelprefix+'l'+tostr(linecount)+' - '+StrPas(FuncName));
- inc(linecount);
- end
- else
- AsmWriteLn(#9'.stabd'#9+tostr(n_line)+',0,'+tostr(hp^.line));
- lastline:=hp^.line;
- end;
- end;
- end;
- {$endif GDB}
- case hp^.typ of
- ait_comment,
- ait_external : ; { external is ignored }
- ait_align : AsmWriteLn(#9'.align '+tostr(pai_align(hp)^.aligntype));
- 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#9'.align 4')
- else
- AsmWriteLn(#9#9'.align 2');
- end;
- if pai_datablock(hp)^.is_global then
- AsmWrite(#9'.comm'#9)
- else
- AsmWrite(#9'.lcomm'#9);
- AsmWriteLn(StrPas(pai_datablock(hp)^.name)+','+tostr(pai_datablock(hp)^.size));
- end;
- ait_const_32bit, { alignment is required for 16/32 bit data! }
- ait_const_16bit: begin
- AsmWrite(ait_const2str[hp^.typ]+tostr(pai_const(hp)^.value));
- consttyp:=hp^.typ;
- l:=0;
- repeat
- found:=(not (Pai(hp^.next)=nil)) and (Pai(hp^.next)^.typ=consttyp);
- if found then
- begin
- hp:=Pai(hp^.next);
- s:=','+tostr(pai_const(hp)^.value);
- AsmWrite(s);
- inc(l,length(s));
- end;
- until (not found) or (l>line_length);
- AsmLn;
- end;
- ait_const_8bit : begin
- AsmWrite(ait_const2str[hp^.typ]+tostr(pai_const(hp)^.value));
- consttyp:=hp^.typ;
- l:=0;
- repeat
- found:=(not (Pai(hp^.next)=nil)) and (Pai(hp^.next)^.typ=consttyp);
- if found then
- begin
- hp:=Pai(hp^.next);
- s:=','+tostr(pai_const(hp)^.value);
- AsmWrite(s);
- inc(l,length(s));
- end;
- until (not found) or (l>line_length);
- AsmLn;
- end;
- ait_const_symbol : Begin
- AsmWriteLn(#9'.long'#9+StrPas(pchar(pai_const(hp)^.value)));
- end;
- ait_real_64bit : Begin
- AsmWriteLn(#9'.double'#9+double2str(pai_double(hp)^.value));
- end;
- ait_real_32bit : Begin
- AsmWriteLn(#9'.single'#9+double2str(pai_single(hp)^.value));
- end;
- ait_real_extended : Begin
- AsmWriteLn(#9'.extend'#9+double2str(pai_extended(hp)^.value));
- { comp type is difficult to write so use double }
- end;
- ait_comp : Begin
- AsmWriteLn(#9'.double'#9+comp2str(pai_extended(hp)^.value));
- end;
- ait_direct : begin
- AsmWritePChar(pai_direct(hp)^.str);
- AsmLn;
- {$IfDef GDB}
- if strpos(pai_direct(hp)^.str,'.data')<>nil then
- n_line:=n_dataline
- else if strpos(pai_direct(hp)^.str,'.text')<>nil then
- n_line:=n_textline
- else if strpos(pai_direct(hp)^.str,'.bss')<>nil then
- n_line:=n_bssline;
- {$endif GDB}
- end;
- ait_string : begin
- pos:=0;
- for i:=1 to pai_string(hp)^.len do
- begin
- if pos=0 then
- begin
- AsmWrite(#9'.ascii'#9'"');
- pos:=20;
- end;
- ch:=pai_string(hp)^.str[i-1];
- case ch of
- #0, {This can't be done by range, because a bug in FPC}
- #1..#31,
- #48..#57,{ Bug with gas < 2.00 with reading octals followed by digits }
- #128..#255 : s:='\'+tostr(ord(ch) shr 6)+tostr((ord(ch) and 63) shr 3)+tostr(ord(ch) and 7);
- '"' : s:='\"';
- '\' : s:='\\';
- else
- s:=ch;
- end;
- AsmWrite(s);
- inc(pos,length(s));
- if (pos>line_length) or (i=pai_string(hp)^.len) then
- begin
- AsmWriteLn('"');
- pos:=0;
- end;
- end;
- end;
- ait_label : begin
- if assigned(hp^.next) and (pai(hp^.next)^.typ in
- [ait_const_32bit,ait_const_16bit,ait_const_8bit,ait_const_symbol,
- ait_real_64bit,ait_real_32bit,ait_string]) then
- begin
- if not(cs_littlesize in aktswitches) then
- AsmWriteLn(#9#9'.align 4')
- else
- AsmWriteLn(#9#9'.align 2');
- end;
- if (pai_label(hp)^.l^.is_used) then
- AsmWriteLn(lab2str(pai_label(hp)^.l)+':');
- 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_8bit,ait_const_symbol,
- ait_real_64bit,ait_real_32bit,ait_string]) then
- begin
- if not(cs_littlesize in aktswitches) then
- AsmWriteLn(#9#9'.align 4')
- else
- AsmWriteLn(#9#9'.align 2');
- end;
- if pai_symbol(hp)^.is_global then
- AsmWriteLn('.globl '+StrPas(pai_symbol(hp)^.name));
- AsmWriteLn(StrPas(pai_symbol(hp)^.name)+':');
- end;
- ait_instruction : begin
- { old versions of GAS don't like PEA.L and LEA.L }
- if (pai68k(hp)^._operator in [
- A_LEA,A_PEA,A_ABCD,A_BCHG,A_BCLR,A_BSET,A_BTST,
- A_EXG,A_NBCD,A_SBCD,A_SWAP,A_TAS,A_SCC,A_SCS,
- A_SEQ,A_SGE,A_SGT,A_SHI,A_SLE,A_SLS,A_SLT,A_SMI,
- A_SNE,A_SPL,A_ST,A_SVC,A_SVS,A_SF]) then
- s:=#9+mot_op2str[pai68k(hp)^._operator]
- else
- s:=#9+mot_op2str[pai68k(hp)^._operator]+mit_opsize2str[pai68k(hp)^.size];
- if pai68k(hp)^.op1t<>top_none then
- begin
- { call and jmp need an extra handling }
- { this code is only callded 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
- 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;
- AsmWriteLn(s);
- end;
- {$ifdef GDB}
- ait_stabs : begin
- AsmWrite(#9'.stabs ');
- AsmWritePChar(pai_stabs(hp)^.str);
- AsmLn;
- end;
- ait_stabn : begin
- AsmWrite(#9'.stabn ');
- AsmWritePChar(pai_stabn(hp)^.str);
- AsmLn;
- end;
- ait_stab_function_name : funcname:=pai_stab_function_name(hp)^.str;
- {$endif GDB}
- else
- internalerror(10000);
- end;
- hp:=pai(hp^.next);
- end;
- end;
-
- procedure tm68kmitasmlist.WriteAsmList;
- {$ifdef GDB}
- var
- p,n,e : string;
- {$endif}
- begin
- {$ifdef EXTDEBUG}
- if assigned(current_module^.mainsource) then
- comment(v_info,'Start writing gas-styled assembler output for '+current_module^.mainsource^);
- {$endif}
- infile:=nil;
- includecount:=0;
- {$ifdef GDB}
- if assigned(current_module^.mainsource) then
- fsplit(current_module^.mainsource^,p,n,e)
- else
- begin
- p:=inputdir;
- n:=inputfile;
- e:=inputextension;
- end;
- { to get symify to work }
- AsmWriteLn(#9'.file "'+FixFileName(n+e)+'"');
- { stabs }
- n_line:=n_bssline;
- if (cs_debuginfo in aktswitches) then
- begin
- if (p<>'') then
- AsmWriteLn(#9'.stabs "'+FixPath(p)+'",'+tostr(n_sourcefile)+',0,0,Ltext0');
- AsmWriteLn(#9'.stabs "'+FixFileName(n+e)+'",'+tostr(n_sourcefile)+',0,0,Ltext0');
- AsmWriteLn('Ltext0:');
- end;
- infile:=current_module^.sourcefiles.files;
- {$endif GDB}
-
- { main source file is last in list }
- while assigned(infile^._next) do
- infile:=infile^._next;
- lastline:=0;
- { there should be nothing but externals so we don't need to process
- WriteTree(externals); }
- WriteTree(debuglist);
-
- { code segment }
- AsmWriteln('.text');
- {$ifdef GDB}
- n_line:=n_textline;
- {$endif GDB}
- WriteTree(codesegment);
-
- AsmWriteLn('.data');
- {$ifdef EXTDEBUG}
- AsmWriteLn(#9'.ascii'#9'"compiled by FPC '+version_string+'\0"');
- AsmWriteLn(#9'.ascii'#9'"target: '+target_info.target_name+'\0"');
- {$endif EXTDEBUG}
- {$ifdef GDB}
- n_line:=n_dataline;
- {$endif GDB}
- DataSegment^.insert(new(pai_align,init(4)));
- WriteTree(datasegment);
- WriteTree(consts);
-
- { makes problems with old GNU ASes
- AsmWriteLn('.bss');
- bssSegment^.insert(new(pai_align,init(4))); }
- {$ifdef GDB}
- n_line:=n_bssline;
- {$endif GDB}
- WriteTree(bsssegment);
-
- AsmLn;
- {$ifdef EXTDEBUG}
- if assigned(current_module^.mainsource) then
- comment(v_info,'Done writing gas-styled assembler output for '+current_module^.mainsource^);
- {$endif EXTDEBUG}
- end;
-
- end.
- {
- $Log: ag68kmit.pas,v $
- Revision 1.1.1.1.2.4 1998/09/14 18:55:48 carl
- * alignment bugfix for bytes
-
- Revision 1.1.1.1.2.3 1998/07/21 12:10:12 carl
- * old MIT syntax does not like octal values by numeric digit strings
-
- Revision 1.1.1.1 1998/03/25 11:18:16 root
- * Restored version
-
- 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:22:45 carl
- - removed in because can cause range check errors in BP
-
- Revision 1.1 1998/03/10 01:26:10 peter
- + new uniform names
-
- Revision 1.8 1998/03/09 12:58:11 peter
- * FWait warning is only showed for Go32V2 and $E+
- * opcode tables moved to i386.pas/m68k.pas to reduce circular uses (and
- for m68k the same tables are removed)
- + $E for i386
-
- Revision 1.7 1998/03/06 00:52:25 peter
- * replaced all old messages from errore.msg, only ExtDebug and some
- Comment() calls are left
- * fixed options.pas
-
- Revision 1.6 1998/03/02 01:48:44 peter
- * renamed target_DOS to target_GO32V1
- + new verbose system, merged old errors and verbose units into one new
- verbose.pas, so errors.pas is obsolete
-
- Revision 1.5 1998/02/23 02:53:52 carl
- * some bugfix with $extdebug
-
- Revision 1.4 1998/02/22 23:03:19 peter
- * renamed msource->mainsource and name->unitname
- * optimized filename handling, filename is not seperate anymore with
- path+name+ext, this saves stackspace and a lot of fsplit()'s
- * recompiling of some units in libraries fixed
- * shared libraries are working again
- + $LINKLIB <lib> to support automatic linking to libraries
- + libraries are saved/read from the ppufile, also allows more libraries
- per ppufile
-
- Revision 1.3 1998/02/22 21:56:29 carl
- * bugfix of offset with index
-
- Revision 1.2 1998/02/21 20:20:01 carl
- * make it work under older versions of GAS
-
- }
-