* leb128 support for binary writers

git-svn-id: trunk@3049 -

compiler/aasmbase.pas

@@ -109,6 +109,8 @@ interface
 
     function LengthUleb128(a: aword) : byte;
     function LengthSleb128(a: aint) : byte;
+    function EncodeUleb128(a: aword;out buf) : byte;
+    function EncodeSleb128(a: aint;out buf) : byte;
 
 
 implementation
@@ -133,15 +135,63 @@ implementation
 
 
     function LengthUleb128(a: aword) : byte;
+      begin
+        result:=0;
+        repeat
+          a := a shr 7;
+          inc(result);
+          if a=0 then
+            break;
+        until false;
+      end;
+
+
+    function LengthSleb128(a: aint) : byte;
+      var
+        b, size: byte;
+        asign : aint;
+        neg, more: boolean;
+      begin
+        more := true;
+        neg := a < 0;
+        size := sizeof(a)*8;
+        result:=0;
+        repeat
+          b := a and $7f;
+          a := a shr 7;
+          if neg then
+            begin
+              { Use a variable to be sure that the correct or mask is generated }
+              asign:=1;
+              asign:=asign shl (size - 7);
+              a := a or -asign;
+            end;
+          if (((a = 0) and
+               (b and $40 = 0)) or
+              ((a = -1) and
+               (b and $40 <> 0))) then
+            more := false;
+          inc(result);
+          if not(more) then
+            break;
+        until false;
+      end;
+
+
+    function EncodeUleb128(a: aword;out buf) : byte;
       var
         b: byte;
+        pbuf : pbyte;
       begin
         result:=0;
+        pbuf:=@buf;
         repeat
           b := a and $7f;
           a := a shr 7;
           if a<>0 then
             b := b or $80;
+          pbuf^:=b;
+          inc(pbuf);
           inc(result);
           if a=0 then
             break;
@@ -149,20 +199,28 @@ implementation
       end;
 
 
-    function LengthSleb128(a: aint) : byte;
+    function EncodeSleb128(a: aint;out buf) : byte;
       var
         b, size: byte;
+        asign : aint;
         neg, more: boolean;
+        pbuf : pbyte;
       begin
         more := true;
         neg := a < 0;
         size := sizeof(a)*8;
         result:=0;
+        pbuf:=@buf;
         repeat
           b := a and $7f;
           a := a shr 7;
           if neg then
-            a := a or -(1 shl (size - 7));
+            begin
+              { Use a variable to be sure that the correct or mask is generated }
+              asign:=1;
+              asign:=asign shl (size - 7);
+              a := a or -asign;
+            end;
           if (((a = 0) and
                (b and $40 = 0)) or
               ((a = -1) and
@@ -170,6 +228,7 @@ implementation
             more := false
           else
             b := b or $80;
+          pbuf^:=b;
           inc(result);
           if not(more) then
             break;

compiler/aasmtai.pas

@@ -1306,6 +1306,12 @@ implementation
           aitconst_indirect_symbol,
           aitconst_rva_symbol :
             result:=sizeof(aint);
+          aitconst_uleb128bit :
+            result:=LengthUleb128(value);
+          aitconst_sleb128bit :
+            result:=LengthSleb128(value);
+          else
+            internalerror(200603253);
         end;
       end;
 

compiler/aggas.pas

@@ -328,48 +328,31 @@ implementation
 
     procedure TGNUAssembler.WriteDecodedUleb128(a: aword);
       var
-        b: byte;
+        i,len : longint;
+        buf   : array[0..63] of byte;
       begin
-        repeat
-          b := a and $7f;
-          a := a shr 7;
-          if (a <> 0) then
-            b := b or $80;
-          AsmWrite(tostr(b));
-          if (a <> 0) then
-            AsmWrite(',')
-          else
-            break;
-        until false;
+        len:=EncodeUleb128(a,buf);
+        for i:=0 to len-1 do
+          begin
+            if (i > 0) then
+              AsmWrite(',');
+            AsmWrite(tostr(buf[i]));
+          end;
       end;
 
 
     procedure TGNUAssembler.WriteDecodedSleb128(a: aint);
       var
-        b, size: byte;
-        neg, more: boolean;
+        i,len : longint;
+        buf   : array[0..255] of byte;
       begin
-        more := true;
-        neg := a < 0;
-        size := sizeof(a)*8;
-        repeat
-          b := a and $7f;
-          a := a shr 7;
-          if (neg) then
-            a := a or -(1 shl (size - 7));
-          if (((a = 0) and
-               (b and $40 = 0)) or
-              ((a = -1) and
-               (b and $40 <> 0))) then
-            more := false
-          else
-            b := b or $80;
-          AsmWrite(tostr(b));
-          if (more) then
-            AsmWrite(',')
-          else
-            break;
-        until false;
+        len:=EncodeSleb128(a,buf);
+        for i:=0 to len-1 do
+          begin
+            if (i > 0) then
+              AsmWrite(',');
+            AsmWrite(tostr(buf[i]));
+          end;
       end;
 
 

compiler/assemble.pas

@@ -1053,6 +1053,8 @@ Implementation
 {$endif x86}
         objsym,
         objsymend : TObjSymbol;
+        leblen : byte;
+        lebbuf : array[0..63] of byte;
       begin
         inlinelevel:=0;
         { main loop }
@@ -1123,6 +1125,18 @@ Implementation
                      end;
                    aitconst_rva_symbol :
                      ObjData.writereloc(Tai_const(hp).value,sizeof(aint),Objdata.SymbolRef(tai_const(hp).sym),RELOC_RVA);
+                   aitconst_uleb128bit :
+                     begin
+                       leblen:=EncodeUleb128(Tai_const(hp).value,lebbuf);
+                       ObjData.writebytes(lebbuf,leblen);
+                     end;
+                   aitconst_sleb128bit :
+                     begin
+                       leblen:=EncodeSleb128(Tai_const(hp).value,lebbuf);
+                       ObjData.writebytes(lebbuf,leblen);
+                     end;
+                   else
+                     internalerror(200603254);
                  end;
                end;
              ait_label :
@@ -1354,8 +1368,6 @@ Implementation
         to_do:=[low(Tasmlisttype)..high(Tasmlisttype)];
         if usedeffileforexports then
           exclude(to_do,al_exports);
-        {$warning TODO internal writer support for dwarf}
-        exclude(to_do,al_dwarf);
         if not(tf_section_threadvars in target_info.flags) then
           exclude(to_do,al_threadvars);
         for i:=low(TasmlistType) to high(TasmlistType) do

compiler/ogelf.pas

@@ -1181,7 +1181,7 @@ implementation
             asmbin : '';
             asmcmd : '';
             supported_target : system_any;  //target_i386_linux;
-            flags : [af_outputbinary,af_smartlink_sections];
+            flags : [af_outputbinary,af_smartlink_sections,af_supports_dwarf];
             labelprefix : '.L';
             comment : '';
           );
@@ -1195,7 +1195,7 @@ implementation
             asmbin : '';
             asmcmd : '';
             supported_target : system_any;  //target_i386_linux;
-            flags : [af_outputbinary,af_smartlink_sections];
+            flags : [af_outputbinary,af_smartlink_sections,af_supports_dwarf];
             labelprefix : '.L';
             comment : '';
           );
@@ -1210,7 +1210,7 @@ implementation
             asmcmd : '';
             supported_target : system_any;  //target_i386_linux;
 //            flags : [af_outputbinary,af_smartlink_sections];
-            flags : [af_outputbinary];
+            flags : [af_outputbinary,af_supports_dwarf];
             labelprefix : '.L';
             comment : '';
           );