paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-13 13:59:07 +02:00
Code Issues Packages Projects Releases Wiki Activity

* continued to fix m68k compiler compilation

Browse Source
This commit is contained in:
florian 2004-05-01 23:29:01 +00:00
parent 5a510e7438
commit 71f80e8bef
4 changed files with 110 additions and 168 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

188
compiler/m68k/agcpugas.pas
View File

@ -120,39 +120,43 @@ interface
top_reg: top_reg:
getopstr:=gas_regname(o.reg); getopstr:=gas_regname(o.reg);
top_ref: top_ref:
getopstr:=getreferencestring(o.ref^); if o.ref^.refaddr=addr_full then
begin
if assigned(o.ref^.symbol) then
hs:='#'+o.ref^.symbol.name
else
hs:='#';
if o.ref^.offset>0 then
hs:=hs+'+'+tostr(o.ref^.offset)
else
if o.ref^.offset<0 then
hs:=hs+tostr(o.ref^.offset)
else
if not(assigned(o.ref^.symbol)) then
hs:=hs+'0';
getopstr:=hs;
end
else
getopstr:=getreferencestring(o.ref^);
top_reglist: top_reglist:
begin begin
hs:=''; hs:='';
for i:=first_supreg to last_supreg do for i:=RS_D0 to RS_D7 do
begin begin
if i in o.registerlist then if i in o.regset^ then
hs:=hs+supreg_name(i)+'/'; hs:=hs+gas_regname(newreg(R_INTREGISTER,i,R_SUBWHOLE))+'/';
end;
for i:=RS_A0 to RS_SP do
begin
if i in o.regset^ then
hs:=hs+gas_regname(newreg(R_INTREGISTER,i,R_SUBWHOLE))+'/';
end; end;
delete(hs,length(hs),1); delete(hs,length(hs),1);
getopstr := hs; getopstr := hs;
end; end;
top_const: top_const:
getopstr:='#'+tostr(longint(o.val)); getopstr:='#'+tostr(longint(o.val));
top_symbol: else internalerror(200405021);
{ compare with i386, where a symbol is considered
a constant. }
begin
if assigned(o.sym) then
hs:='#'+o.sym.name
else
hs:='#';
if o.symofs>0 then
hs:=hs+'+'+tostr(o.symofs)
else
if o.symofs<0 then
hs:=hs+tostr(o.symofs)
else
if not(assigned(o.sym)) then
hs:=hs+'0';
getopstr:=hs;
end;
else internalerror(10001);
end; end;
end; end;
@ -162,25 +166,30 @@ interface
hs : string; hs : string;
begin begin
case o.typ of case o.typ of
top_reg : getopstr_jmp:=gas_regname(o.reg); top_reg:
top_ref : getopstr_jmp:=getreferencestring(o.ref^); getopstr_jmp:=gas_regname(o.reg);
top_const : getopstr_jmp:=tostr(o.val); top_ref:
top_symbol : begin if o.ref^.refaddr=addr_no then
if assigned(o.sym) then getopstr_jmp:=getreferencestring(o.ref^)
hs:=o.sym.name else
else begin
hs:=''; if assigned(o.ref^.symbol) then
if o.symofs>0 then hs:=o.ref^.symbol.name
hs:=hs+'+'+tostr(o.symofs) else
else hs:='';
if o.symofs<0 then if o.ref^.offset>0 then
hs:=hs+tostr(o.symofs) hs:=hs+'+'+tostr(o.ref^.offset)
else else
if not(assigned(o.sym)) then if o.ref^.offset<0 then
hs:=hs+'0'; hs:=hs+tostr(o.ref^.offset)
getopstr_jmp:=hs; else
end; if not(assigned(o.ref^.symbol)) then
else internalerror(10001); hs:=hs+'0';
getopstr_jmp:=hs;
end;
top_const:
getopstr_jmp:=tostr(o.val);
else internalerror(200405022);
end; end;
end; end;
@ -215,51 +224,51 @@ interface
procedure TM68kAssembler.WriteInstruction(hp: tai); procedure TM68kAssembler.WriteInstruction(hp: tai);
var var
op : tasmop; op : tasmop;
s : string; s : string;
sep : char; sep : char;
calljmp : boolean; calljmp : boolean;
i : integer; i : integer;
begin begin
if hp.typ <> ait_instruction then exit; if hp.typ <> ait_instruction then exit;
op:=taicpu(hp).opcode; op:=taicpu(hp).opcode;
calljmp:=is_calljmp(op); calljmp:=is_calljmp(op);
{ call maybe not translated to call } { call maybe not translated to call }
s:=#9+getopcodestring(hp); s:=#9+getopcodestring(hp);
{ process operands } { process operands }
if taicpu(hp).ops<>0 then if taicpu(hp).ops<>0 then
begin begin
{ call and jmp need an extra handling } { call and jmp need an extra handling }
{ this code is only called if jmp isn't a labeled instruction } { this code is only called if jmp isn't a labeled instruction }
{ quick hack to overcome a problem with manglednames=255 chars } { quick hack to overcome a problem with manglednames=255 chars }
if calljmp then if calljmp then
begin begin
AsmWrite(s+#9); AsmWrite(s+#9);
s:=getopstr_jmp(taicpu(hp).oper[0]); s:=getopstr_jmp(taicpu(hp).oper[0]^);
end end
else else
begin begin
for i:=0 to taicpu(hp).ops-1 do for i:=0 to taicpu(hp).ops-1 do
begin begin
if i=0 then if i=0 then
sep:=#9 sep:=#9
else else
if ((op = A_DIVSL) or if ((op = A_DIVSL) or
(op = A_DIVUL) or (op = A_DIVUL) or
(op = A_MULU) or (op = A_MULU) or
(op = A_MULS) or (op = A_MULS) or
(op = A_DIVS) or (op = A_DIVS) or
(op = A_DIVU)) and (i=1) then (op = A_DIVU)) and (i=1) then
sep:=':' sep:=':'
else else
sep:=','; sep:=',';
s:=s+sep+getopstr(taicpu(hp).oper[i]) s:=s+sep+getopstr(taicpu(hp).oper[i]^)
end; end;
end; end;
end; end;
AsmWriteLn(s); AsmWriteLn(s);
end; end;
{***************************************************************************** {*****************************************************************************
@ -291,7 +300,10 @@ initialization
end. end.
{ {
$Log$ $Log$
Revision 1.10 2004-04-27 15:46:01 florian Revision 1.11 2004-05-01 23:29:01 florian
* continued to fix m68k compiler compilation
Revision 1.10 2004/04/27 15:46:01 florian
* several updates for compilation * several updates for compilation
Revision 1.9 2004/04/27 15:00:37 florian Revision 1.9 2004/04/27 15:00:37 florian

7
compiler/m68k/cpuinfo.pas
View File

@ -85,7 +85,7 @@ Const
{ the difference to stdcall is only the name mangling } { the difference to stdcall is only the name mangling }
pocall_cppdecl, pocall_cppdecl,
{ this used by the PalmOS port only } { this used by the PalmOS port only }
pocall_palmossyscall pocall_syscall
]; ];
processorsstr : array[tprocessors] of string[5] = ('', processorsstr : array[tprocessors] of string[5] = ('',
@ -105,7 +105,10 @@ Implementation
end. end.
{ {
$Log$ $Log$
Revision 1.10 2004-04-28 15:19:03 florian Revision 1.11 2004-05-01 23:29:01 florian
* continued to fix m68k compiler compilation
Revision 1.10 2004/04/28 15:19:03 florian
+ syscall directive support for MorphOS added + syscall directive support for MorphOS added
Revision 1.9 2004/04/18 21:13:59 florian Revision 1.9 2004/04/18 21:13:59 florian

18
compiler/m68k/cpupi.pas
View File

@ -29,11 +29,10 @@ unit cpupi;
interface interface
uses uses
cgbase; procinfo,cgbase;
type type
tm68kprocinfo = class(tprocinfo) tm68kprocinfo = class(tprocinfo)
procedure allocate_interrupt_stackframe;override;
end; end;
implementation implementation
@ -41,22 +40,15 @@ unit cpupi;
uses uses
verbose; verbose;
procedure tm68kprocinfo.allocate_interrupt_stackframe;
begin
{ we push Flags and CS as long
to cope with the IRETD
and we save 6 register + 4 selectors }
{ i386 code: inc(procinfo.para_offset,8+6*4+4*2); }
internalerror(2002081601);
end;
begin begin
cprocinfo:=tm68kprocinfo; cprocinfo:=tm68kprocinfo;
end. end.
{ {
$Log$ $Log$
Revision 1.2 2002-08-18 09:02:12 florian Revision 1.3 2004-05-01 23:29:01 florian
* continued to fix m68k compiler compilation
Revision 1.2 2002/08/18 09:02:12 florian
* fixed compilation problems * fixed compilation problems
Revision 1.1 2002/08/17 09:23:48 florian Revision 1.1 2002/08/17 09:23:48 florian

65
compiler/m68k/radirect.pas
View File

@ -1,65 +0,0 @@
{
$Id$
Copyright (c) 1998-2002 by Florian Klaempfl
Reads inline assembler and writes the lines direct to the output
This is not supported for the m68k
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 radirect;
{$i fpcdefs.inc}
interface
uses
node;
function assemble : tnode;
implementation
uses
verbose;
function assemble : tnode;
begin
internalerror(20020813);
end;
{*****************************************************************************
Initialize
*****************************************************************************}
end.
{
$Log$
Revision 1.2 2002-09-07 15:25:13 peter
* old logs removed and tabs fixed
Revision 1.1 2002/08/13 18:01:52 carl
* rename swatoperands to swapoperands
+ m68k first compilable version (still needs a lot of testing):
assembler generator, system information , inline
assembler reader.
}