+ lots of fixes to the Z80 internal asm writer

git-svn-id: trunk@45272 -

compiler/ogbase.pas

@@ -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 }

compiler/ogrel.pas

@@ -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);

compiler/z80/aasmcpu.pas

@@ -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;