paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-11 04:01:37 +02:00
Code Issues Packages Projects Releases Wiki Activity

+ lots of fixes to the Z80 internal asm writer

Browse Source 
git-svn-id: trunk@45272 -
This commit is contained in:
nickysn 2020-05-05 22:18:44 +00:00
parent 7dc6049de9
commit 4fed57adc1
3 changed files with 161 additions and 19 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
compiler/ogbase.pas
View File

@ -106,6 +106,10 @@ interface
RELOC_ADD_ABS_LO12,
RELOC_LDST8_ABS_LO12,
{$endif aarch64}
{$ifdef z80}
RELOC_ABSOLUTE_HI8,
RELOC_ABSOLUTE_LO8,
{$endif z80}
{ Relative relocation }
RELOC_RELATIVE,
{ PECoff (Windows) RVA relocation }

97
compiler/ogrel.pas
View File

@ -60,6 +60,7 @@ interface
function GetSecOrSymIdx: longint;
public
RelFlags: TRelRelocationFlags;
HiByte: Byte;
constructor CreateSymbol(ADataOffset:TObjSectionOfs;s:TObjSymbol;Atyp:TObjRelocationType);
constructor CreateSection(ADataOffset:TObjSectionOfs;aobjsec:TObjSection;Atyp:TObjRelocationType);
@ -128,15 +129,49 @@ implementation
constructor TRelRelocation.CreateSymbol(ADataOffset: TObjSectionOfs; s: TObjSymbol; Atyp: TObjRelocationType);
begin
inherited;
size:=2;
RelFlags:=[rrfSymbol];
case Atyp of
RELOC_ABSOLUTE_HI8:
begin
size:=1;
RelFlags:=[rrfSymbol,rrfByte,rrfTwoByteObjectFormatForByteData,rrfMSBWith2ByteMode];
end;
RELOC_ABSOLUTE_LO8:
begin
size:=1;
RelFlags:=[rrfSymbol,rrfByte,rrfTwoByteObjectFormatForByteData];
end;
RELOC_ABSOLUTE:
begin
size:=2;
RelFlags:=[rrfSymbol];
end;
else
internalerror(2020050601);
end;
end;
constructor TRelRelocation.CreateSection(ADataOffset: TObjSectionOfs; aobjsec: TObjSection; Atyp: TObjRelocationType);
begin
inherited;
size:=2;
RelFlags:=[];
case Atyp of
RELOC_ABSOLUTE_HI8:
begin
size:=1;
RelFlags:=[rrfByte,rrfTwoByteObjectFormatForByteData,rrfMSBWith2ByteMode];
end;
RELOC_ABSOLUTE_LO8:
begin
size:=1;
RelFlags:=[rrfByte,rrfTwoByteObjectFormatForByteData];
end;
RELOC_ABSOLUTE:
begin
size:=2;
RelFlags:=[];
end;
else
internalerror(2020050601);
end;
end;
function TRelRelocation.EncodeFlags: string;
@ -263,6 +298,8 @@ implementation
if p.bind=AB_EXTERNAL then
begin
objreloc:=TRelRelocation.CreateSymbol(CurrObjSec.Size,p,Reloctype);
if Reloctype in [RELOC_ABSOLUTE_HI8,RELOC_ABSOLUTE_LO8] then
objreloc.HiByte:=Byte(Data shr 8);
CurrObjSec.ObjRelocations.Add(objreloc);
end
{ relative relocations within the same section can be calculated directly,
@ -276,6 +313,8 @@ implementation
else
begin
objreloc:=TRelRelocation.CreateSection(CurrObjSec.Size,p.objsection,Reloctype);
if Reloctype in [RELOC_ABSOLUTE_HI8,RELOC_ABSOLUTE_LO8] then
objreloc.HiByte:=Byte(Data shr 8);
CurrObjSec.ObjRelocations.Add(objreloc);
end;
end;
@ -312,11 +351,11 @@ implementation
procedure TRelObjOutput.WriteAreaContentAndRelocations(sec: TObjSection);
const
MaxChunkSize=14;
MaxChunkSize={14}7;
var
ChunkStart,ChunkLen, i: LongWord;
ChunkFixupStart,ChunkFixupEnd: Integer;
s: ansistring;
ChunkFixupStart,ChunkFixupEnd, j, st_ofs: Integer;
st,sr: ansistring;
buf: array [0..MaxChunkSize-1] of Byte;
reloc: TRelRelocation;
begin
@ -343,23 +382,49 @@ implementation
ChunkLen:=TRelRelocation(sec.ObjRelocations[ChunkFixupEnd]).DataOffset-ChunkStart;
Dec(ChunkFixupEnd);
end;
s:='T '+HexStr(Byte(ChunkStart),2)+' '+HexStr(Byte(ChunkStart shr 8),2);
if ChunkLen>SizeOf(buf) then
internalerror(2020050501);
st:='T '+HexStr(Byte(ChunkStart),2)+' '+HexStr(Byte(ChunkStart shr 8),2);
sr:='R 00 00 '+HexStr(Byte(sec.SecSymIdx),2)+' '+HexStr(Byte(sec.SecSymIdx shr 8),2);
sec.Data.read(buf,ChunkLen);
for i:=0 to ChunkLen-1 do
s:=s+' '+HexStr(buf[i],2);
writeLine(s);
s:='R 00 00 '+HexStr(Byte(sec.SecSymIdx),2)+' '+HexStr(Byte(sec.SecSymIdx shr 8),2);
st_ofs:=1;
{ relocations present in the current chunk? }
if ChunkFixupEnd>=ChunkFixupStart then
begin
for i:=ChunkFixupStart to ChunkFixupEnd do
j:=ChunkFixupStart;
reloc:=TRelRelocation(sec.ObjRelocations[j]);
end
else
begin
j:=-1;
reloc:=nil;
end;
for i:=0 to ChunkLen-1 do
begin
st:=st+' '+HexStr(buf[i],2);
Inc(st_ofs);
if assigned(reloc) then
begin
reloc:=TRelRelocation(sec.ObjRelocations[i]);
s:=s+' '+reloc.EncodeFlags+' '+HexStr(reloc.DataOffset-ChunkStart+2,2)+' '+HexStr(Byte(reloc.SecOrSymIdx),2)+' '+HexStr(Byte(reloc.SecOrSymIdx shr 8),2);
{ advance to the current relocation }
while (reloc.DataOffset<(ChunkStart+i)) and (j<ChunkFixupEnd) do
begin
Inc(j);
reloc:=TRelRelocation(sec.ObjRelocations[j]);
end;
{ is there a relocation at the current position? }
if reloc.DataOffset=(ChunkStart+i) then
begin
sr:=sr+' '+reloc.EncodeFlags+' '+HexStr(st_ofs,2)+' '+HexStr(Byte(reloc.SecOrSymIdx),2)+' '+HexStr(Byte(reloc.SecOrSymIdx shr 8),2);
if reloc.typ in [RELOC_ABSOLUTE_HI8,RELOC_ABSOLUTE_LO8] then
begin
st:=st+' '+HexStr(reloc.HiByte,2);
Inc(st_ofs);
end;
end;
end;
end;
writeLine(s);
writeLine(st);
writeLine(sr);
{ prepare next chunk }
Inc(ChunkStart, ChunkLen);
ChunkLen:=Min(MaxChunkSize, sec.Data.size-ChunkStart);

79
compiler/z80/aasmcpu.pas
View File

@ -429,10 +429,12 @@ implementation
begin
if token='' then
internalerror(2020050402);
if (token[1]='$') or (token[1]='%') then
if (token[1]='$') or (token[1]='%') or (token='n') or (token='d') then
Inc(result)
else if token='nn' then
Inc(result,2);
Inc(result,2)
else
internalerror(2020050504);
token:='';
end;
end;
@ -496,6 +498,71 @@ implementation
InternalError(2020050403);
end;
procedure WriteN;
var
i: Integer;
begin
for i:=0 to insentry^.ops-1 do
begin
if insentry^.optypes[i]=OT_IMM8 then
begin
case oper[i]^.typ of
top_const:
begin
WriteByte(Byte(oper[i]^.val));
exit;
end;
top_ref:
begin
if (oper[i]^.ref^.base<>NR_NO) or (oper[i]^.ref^.index<>NR_NO) then
internalerror(2020050507);
if Assigned(oper[i]^.ref^.symbol) then
begin
case oper[i]^.ref^.refaddr of
addr_hi8:
objdata.writeReloc(oper[i]^.ref^.offset,1,ObjData.symbolref(oper[i]^.ref^.symbol),RELOC_ABSOLUTE_HI8);
addr_lo8:
objdata.writeReloc(oper[i]^.ref^.offset,1,ObjData.symbolref(oper[i]^.ref^.symbol),RELOC_ABSOLUTE_LO8);
else
internalerror(2020050408);
end;
exit;
end
else
internalerror(2020050409);
end;
else
InternalError(2020050506);
end;
end;
end;
InternalError(2020050505);
end;
procedure WriteD;
var
i: Integer;
begin
for i:=0 to insentry^.ops-1 do
begin
if insentry^.optypes[i] in [OT_REF_IX_d,OT_REF_IY_d] then
begin
case oper[i]^.typ of
top_ref:
begin
if not is_ref_opertype(oper[i]^.ref^,insentry^.optypes[i]) then
internalerror(2020050510);
WriteByte(Byte(oper[i]^.ref^.offset));
exit;
end;
else
InternalError(2020050511);
end;
end;
end;
InternalError(2020050512);
end;
function EvalMaskCode(const maskcode: string): byte;
var
i: Integer;
@ -738,7 +805,13 @@ implementation
HandlePercent(token);
end
else if token='nn' then
WriteNN;
WriteNN
else if token='n' then
WriteN
else if token='d' then
WriteD
else
internalerror(2020050503);
token:='';
end;
end;