* Long symbol names support

compiler/i386/ag386att.pas

@@ -35,6 +35,10 @@ interface
 
     type
       T386ATTAssembler=class(TGNUassembler)
+      private
+        procedure WriteReference(var ref : treference);
+        procedure WriteOper(const o:toper);
+        procedure WriteOper_jmp(const o:toper);
       public
         procedure WriteInstruction(hp: tai);override;
       end;
@@ -72,176 +76,161 @@ interface
       verbose;
 
 
+{****************************************************************************
+                            TI386ATTASMOUTPUT
+ ****************************************************************************}
 
-    function getreferencestring(var ref : treference) : string;
-    var
-      s : string;
-    begin
-      with ref do
-       begin
-         inc(offset,offsetfixup);
-         offsetfixup:=0;
-       { have we a segment prefix ? }
-       { These are probably not correctly handled under GAS }
-       { should be replaced by coding the segment override  }
-       { directly! - DJGPP FAQ                              }
-         if segment<>R_NO then
-          s:=gas_reg2str[segment]+':'
-         else
-          s:='';
-         if assigned(symbol) then
-          s:=s+symbol.name;
-         if offset<0 then
-          s:=s+tostr(offset)
-         else
-          if (offset>0) then
-           begin
-             if assigned(symbol) then
-              s:=s+'+'+tostr(offset)
-             else
-              s:=s+tostr(offset);
-           end
-         else if (index=R_NO) and (base=R_NO) and not assigned(symbol) then
-           s:=s+'0';
-         if (index<>R_NO) and (base=R_NO) then
-          begin
-            s:=s+'(,'+gas_reg2str[index];
-            if scalefactor<>0 then
-             s:=s+','+tostr(scalefactor)+')'
-            else
-             s:=s+')';
-          end
-         else
-          if (index=R_NO) and (base<>R_NO) then
-           s:=s+'('+gas_reg2str[base]+')'
-          else
-           if (index<>R_NO) and (base<>R_NO) then
+    procedure T386AttAssembler.WriteReference(var ref : treference);
+      begin
+        with ref do
+         begin
+           inc(offset,offsetfixup);
+           offsetfixup:=0;
+         { have we a segment prefix ? }
+         { These are probably not correctly handled under GAS }
+         { should be replaced by coding the segment override  }
+         { directly! - DJGPP FAQ                              }
+           if segment<>R_NO then
+            AsmWrite(gas_reg2str[segment]+':');
+           if assigned(symbol) then
+             AsmWrite(symbol.name);
+           if offset<0 then
+            AsmWrite(tostr(offset))
+           else
+            if (offset>0) then
+             begin
+               if assigned(symbol) then
+                AsmWrite('+'+tostr(offset))
+               else
+                AsmWrite(tostr(offset));
+             end
+           else if (index=R_NO) and (base=R_NO) and not assigned(symbol) then
+             AsmWrite('0');
+           if (index<>R_NO) and (base=R_NO) then
             begin
-              s:=s+'('+gas_reg2str[base]+','+gas_reg2str[index];
+              AsmWrite('(,'+gas_reg2str[index]);
               if scalefactor<>0 then
-               s:=s+','+tostr(scalefactor)+')'
+               AsmWrite(','+tostr(scalefactor)+')')
               else
-               s := s+')';
-            end;
-       end;
-      getreferencestring:=s;
-    end;
-
-    function getopstr(const o:toper) : string;
-    var
-      hs : string;
-    begin
-      case o.typ of
-        top_reg :
-          getopstr:=gas_reg2str[o.reg];
-        top_ref :
-          getopstr:=getreferencestring(o.ref^);
-        top_const :
-          getopstr:='$'+tostr(longint(o.val));
-        top_symbol :
-          begin
-            if assigned(o.sym) then
-              hs:='$'+o.sym.name
+               AsmWrite(')');
+            end
+           else
+            if (index=R_NO) and (base<>R_NO) then
+             AsmWrite('('+gas_reg2str[base]+')')
             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;
-
-    function getopstr_jmp(const o:toper) : string;
-    var
-      hs : string;
-    begin
-      case o.typ of
-        top_reg :
-          getopstr_jmp:='*'+gas_reg2str[o.reg];
-        top_ref :
-          getopstr_jmp:='*'+getreferencestring(o.ref^);
-        top_const :
-          getopstr_jmp:=tostr(longint(o.val));
-        top_symbol :
-          begin
-            hs:=o.sym.name;
-            if o.symofs>0 then
-             hs:=hs+'+'+tostr(o.symofs)
-            else
-             if o.symofs<0 then
-              hs:=hs+tostr(o.symofs);
-            getopstr_jmp:=hs;
-          end;
-        else
-          internalerror(10001);
+             if (index<>R_NO) and (base<>R_NO) then
+              begin
+                AsmWrite('('+gas_reg2str[base]+','+gas_reg2str[index]);
+                if scalefactor<>0 then
+                 AsmWrite(','+tostr(scalefactor));
+                AsmWrite(')');
+              end;
+         end;
       end;
-    end;
 
 
-{****************************************************************************
-                            TI386ATTASMOUTPUT
- ****************************************************************************}
+    procedure T386AttAssembler.WriteOper(const o:toper);
+      begin
+        case o.typ of
+          top_reg :
+            AsmWrite(gas_reg2str[o.reg]);
+          top_ref :
+            WriteReference(o.ref^);
+          top_const :
+            AsmWrite('$'+tostr(longint(o.val)));
+          top_symbol :
+            begin
+              AsmWrite('$');
+              if assigned(o.sym) then
+               AsmWrite(o.sym.name);
+              if o.symofs>0 then
+               AsmWrite('+'+tostr(o.symofs))
+              else
+               if o.symofs<0 then
+                AsmWrite(tostr(o.symofs))
+              else
+               if not(assigned(o.sym)) then
+                 AsmWrite('0');
+            end;
+          else
+            internalerror(10001);
+        end;
+      end;
+
 
+    procedure T386AttAssembler.WriteOper_jmp(const o:toper);
+      begin
+        case o.typ of
+          top_reg :
+            AsmWrite('*'+gas_reg2str[o.reg]);
+          top_ref :
+            begin
+              AsmWrite('*');
+              WriteReference(o.ref^);
+            end;
+          top_const :
+            AsmWrite(tostr(longint(o.val)));
+          top_symbol :
+            begin
+              AsmWrite(o.sym.name);
+              if o.symofs>0 then
+               AsmWrite('+'+tostr(o.symofs))
+              else
+               if o.symofs<0 then
+                AsmWrite(tostr(o.symofs));
+            end;
+          else
+            internalerror(10001);
+        end;
+      end;
 
 
-    procedure T386AttAssembler. WriteInstruction(hp: tai);
-    var
-      op       : tasmop;
-      s        : string;
-      sep      : char;
-      calljmp  : boolean;
-      i        : integer;
-     begin
-       if hp.typ <> ait_instruction then exit;
-       taicpu(hp).SetOperandOrder(op_att);
-       op:=taicpu(hp).opcode;
-       calljmp:=is_calljmp(op);
-       { call maybe not translated to call }
-       s:=#9+gas_op2str[op]+cond2str[taicpu(hp).condition];
-       { suffix needed ?  fnstsw,fldcw don't support suffixes
-         with binutils 2.9.5 under linux }
-       if (not calljmp) and
-           (gas_needsuffix[op]<>AttSufNONE) and
-           (op<>A_FNSTSW) and (op<>A_FSTSW) and
-           (op<>A_FNSTCW) and (op<>A_FSTCW) and
-           (op<>A_FLDCW) and not(
-           (taicpu(hp).oper[0].typ=top_reg) and
-           (taicpu(hp).oper[0].reg in [R_ST..R_ST7])
-          ) then
-              s:=s+gas_opsize2str[taicpu(hp).opsize];
-       { process operands }
-       if taicpu(hp).ops<>0 then
-         begin
-           { call and jmp need an extra handling                          }
-           { this code is only called if jmp isn't a labeled instruction  }
-           { quick hack to overcome a problem with manglednames=255 chars }
-           if calljmp then
-              begin
-                AsmWrite(s+#9);
-                s:=getopstr_jmp(taicpu(hp).oper[0]);
-              end
+    procedure T386AttAssembler.WriteInstruction(hp: tai);
+      var
+       op       : tasmop;
+       calljmp  : boolean;
+       i        : integer;
+      begin
+        if hp.typ <> ait_instruction then
+          exit;
+        taicpu(hp).SetOperandOrder(op_att);
+        op:=taicpu(hp).opcode;
+        calljmp:=is_calljmp(op);
+        { call maybe not translated to call }
+        AsmWrite(#9+gas_op2str[op]+cond2str[taicpu(hp).condition]);
+        { suffix needed ?  fnstsw,fldcw don't support suffixes
+          with binutils 2.9.5 under linux }
+        if (not calljmp) and
+            (gas_needsuffix[op]<>AttSufNONE) and
+            (op<>A_FNSTSW) and (op<>A_FSTSW) and
+            (op<>A_FNSTCW) and (op<>A_FSTCW) and
+            (op<>A_FLDCW) and not(
+            (taicpu(hp).oper[0].typ=top_reg) and
+            (taicpu(hp).oper[0].reg in [R_ST..R_ST7])
+           ) then
+          AsmWrite(gas_opsize2str[taicpu(hp).opsize]);
+        { process operands }
+        if taicpu(hp).ops<>0 then
+          begin
+            if calljmp then
+             begin
+               AsmWrite(#9);
+               WriteOper_jmp(taicpu(hp).oper[0]);
+             end
             else
-              begin
-                for i:=0 to taicpu(hp).ops-1 do
-                  begin
-                    if i=0 then
-                      sep:=#9
-                    else
-                      sep:=',';
-                    s:=s+sep+getopstr(taicpu(hp).oper[i])
-                  end;
-              end;
-         end;
-         AsmWriteLn(s);
-     end;
+             begin
+               for i:=0 to taicpu(hp).ops-1 do
+                 begin
+                   if i=0 then
+                     AsmWrite(#9)
+                   else
+                     AsmWrite(',');
+                   WriteOper(taicpu(hp).oper[i]);
+                 end;
+             end;
+          end;
+        AsmLn;
+      end;
 
 
 {*****************************************************************************
@@ -314,7 +303,10 @@ initialization
 end.
 {
   $Log$
-  Revision 1.26  2002-08-12 15:08:40  carl
+  Revision 1.27  2002-12-24 18:10:34  peter
+    * Long symbol names support
+
+  Revision 1.26  2002/08/12 15:08:40  carl
     + stab register indexes for powerpc (moved from gdb to cpubase)
     + tprocessor enumeration moved to cpuinfo
     + linker in target_info is now a class

compiler/i386/ag386int.pas

@@ -29,10 +29,17 @@ unit ag386int;
 
 interface
 
-    uses aasmbase,aasmtai,aasmcpu,assemble;
+    uses
+      cpubase,
+      aasmbase,aasmtai,aasmcpu,assemble;
 
     type
       T386IntelAssembler = class(TExternalAssembler)
+      private
+        procedure WriteReference(var ref : treference);
+        procedure WriteOper(const o:toper;s : topsize; opcode: tasmop;dest : boolean);
+        procedure WriteOper_jmp(const o:toper;s : topsize);
+      public
         procedure WriteTree(p:TAAsmoutput);override;
         procedure WriteAsmList;override;
         Function  DoAssemble:boolean;override;
@@ -49,7 +56,7 @@ interface
       sysutils,
 {$endif}
       cutils,globtype,globals,systems,cclasses,
-      verbose,cpubase,finput,fmodule,script,cpuinfo
+      verbose,finput,fmodule,script,cpuinfo
       ;
 
     const
@@ -120,181 +127,178 @@ interface
          comp2str:=double2str(dd^);
       end;
 
-    function getreferencestring(var ref : treference) : string;
-    var
-      s     : string;
-      first : boolean;
-    begin
-      with ref do
-        begin
-          first:=true;
-          inc(offset,offsetfixup);
-          offsetfixup:=0;
-          if ref.segment<>R_NO then
-           s:=std_reg2str[segment]+':['
-          else
-           s:='[';
-         if assigned(symbol) then
-          begin
-            if (aktoutputformat = as_i386_tasm) then
-              s:=s+'dword ptr ';
-            s:=s+symbol.name;
-            first:=false;
-          end;
-         if (base<>R_NO) then
-          begin
-            if not(first) then
-             s:=s+'+'
-            else
-             first:=false;
-             s:=s+std_reg2str[base];
-          end;
-         if (index<>R_NO) then
-           begin
-             if not(first) then
-               s:=s+'+'
-             else
-               first:=false;
-             s:=s+std_reg2str[index];
-             if scalefactor<>0 then
-               s:=s+'*'+tostr(scalefactor);
-           end;
-         if offset<0 then
-           s:=s+tostr(offset)
-         else if (offset>0) then
-           s:=s+'+'+tostr(offset);
-         if s[length(s)]='[' then
-           s:=s+'0';
-         s:=s+']';
-        end;
-       getreferencestring:=s;
+
+   function fixline(s:string):string;
+   {
+     return s with all leading and ending spaces and tabs removed
+   }
+     var
+       i,j,k : longint;
+     begin
+       i:=length(s);
+       while (i>0) and (s[i] in [#9,' ']) do
+        dec(i);
+       j:=1;
+       while (j<i) and (s[j] in [#9,' ']) do
+        inc(j);
+       for k:=j to i do
+        if s[k] in [#0..#31,#127..#255] then
+         s[k]:='.';
+       fixline:=Copy(s,j,i-j+1);
      end;
 
 
-    function getopstr(const o:toper;s : topsize; opcode: tasmop;dest : boolean) : string;
-    var
-      hs : string;
-    begin
-      case o.typ of
-        top_reg :
-          getopstr:=std_reg2str[o.reg];
-        top_const :
-          getopstr:=tostr(longint(o.val));
-        top_symbol :
-          begin
-            if assigned(o.sym) then
-              hs:='offset '+o.sym.name
-            else
-              hs:='offset ';
-            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;
-        top_ref :
-          begin
-            hs:=getreferencestring(o.ref^);
-            if ((opcode <> A_LGS) and (opcode <> A_LSS) and
-                (opcode <> A_LFS) and (opcode <> A_LDS) and
-                (opcode <> A_LES)) then
-             Begin
-               case s of
-                S_B : hs:='byte ptr '+hs;
-                S_W : hs:='word ptr '+hs;
-                S_L : hs:='dword ptr '+hs;
-               S_IS : hs:='word ptr '+hs;
-               S_IL : hs:='dword ptr '+hs;
-               S_IQ : hs:='qword ptr '+hs;
-               S_FS : hs:='dword ptr '+hs;
-               S_FL : hs:='qword ptr '+hs;
-               S_FX : hs:='tbyte ptr '+hs;
-               S_BW : if dest then
-                       hs:='word ptr '+hs
-                      else
-                       hs:='byte ptr '+hs;
-               S_BL : if dest then
-                       hs:='dword ptr '+hs
-                      else
-                       hs:='byte ptr '+hs;
-               S_WL : if dest then
-                       hs:='dword ptr '+hs
-                      else
-                       hs:='word ptr '+hs;
+{****************************************************************************
+                               T386IntelAssembler
+ ****************************************************************************}
+
+    procedure T386IntelAssembler.WriteReference(var ref : treference);
+      var
+        first : boolean;
+      begin
+        with ref do
+         begin
+           first:=true;
+           inc(offset,offsetfixup);
+           offsetfixup:=0;
+           if ref.segment<>R_NO then
+            AsmWrite(std_reg2str[segment]+':[')
+           else
+            AsmWrite('[');
+           if assigned(symbol) then
+            begin
+              if (aktoutputformat = as_i386_tasm) then
+                AsmWrite('dword ptr ');
+              AsmWrite(symbol.name);
+              first:=false;
+            end;
+           if (base<>R_NO) then
+            begin
+              if not(first) then
+               AsmWrite('+')
+              else
+               first:=false;
+               AsmWrite(std_reg2str[base]);
+            end;
+           if (index<>R_NO) then
+            begin
+              if not(first) then
+               AsmWrite('+')
+              else
+               first:=false;
+              AsmWrite(std_reg2str[index]);
+              if scalefactor<>0 then
+               AsmWrite('*'+tostr(scalefactor));
+            end;
+           if offset<0 then
+            begin
+              AsmWrite(tostr(offset));
+              first:=false;
+            end
+           else if (offset>0) then
+            begin
+              AsmWrite('+'+tostr(offset));
+              first:=false;
+            end;
+           if first then
+             AsmWrite('0');
+           AsmWrite(']');
+         end;
+      end;
+
+
+    procedure T386IntelAssembler.WriteOper(const o:toper;s : topsize; opcode: tasmop;dest : boolean);
+      begin
+        case o.typ of
+          top_reg :
+            AsmWrite(std_reg2str[o.reg]);
+          top_const :
+            AsmWrite(tostr(longint(o.val)));
+          top_symbol :
+            begin
+              AsmWrite('offset ');
+              if assigned(o.sym) then
+                AsmWrite(o.sym.name);
+              if o.symofs>0 then
+               AsmWrite('+'+tostr(o.symofs))
+              else
+               if o.symofs<0 then
+                AsmWrite(tostr(o.symofs))
+              else
+               if not(assigned(o.sym)) then
+                 AsmWrite('0');
+            end;
+          top_ref :
+            begin
+              if ((opcode <> A_LGS) and (opcode <> A_LSS) and
+                  (opcode <> A_LFS) and (opcode <> A_LDS) and
+                  (opcode <> A_LES)) then
+               Begin
+                 case s of
+                  S_B : AsmWrite('byte ptr ');
+                  S_W : AsmWrite('word ptr ');
+                  S_L : AsmWrite('dword ptr ');
+                 S_IS : AsmWrite('word ptr ');
+                 S_IL : AsmWrite('dword ptr ');
+                 S_IQ : AsmWrite('qword ptr ');
+                 S_FS : AsmWrite('dword ptr ');
+                 S_FL : AsmWrite('qword ptr ');
+                 S_FX : AsmWrite('tbyte ptr ');
+                 S_BW : if dest then
+                         AsmWrite('word ptr ')
+                        else
+                         AsmWrite('byte ptr ');
+                 S_BL : if dest then
+                         AsmWrite('dword ptr ')
+                        else
+                         AsmWrite('byte ptr ');
+                 S_WL : if dest then
+                         AsmWrite('dword ptr ')
+                        else
+                         AsmWrite('word ptr ');
+                 end;
                end;
-             end;
-            getopstr:=hs;
-          end;
-        else
-          internalerror(10001);
+              WriteReference(o.ref^);
+            end;
+          else
+            internalerror(10001);
+        end;
       end;
-    end;
 
-    function getopstr_jmp(const o:toper;s : topsize) : string;
-    var
-      hs : string;
+
+    procedure T386IntelAssembler.WriteOper_jmp(const o:toper;s : topsize);
     begin
       case o.typ of
         top_reg :
-          getopstr_jmp:=std_reg2str[o.reg];
+          AsmWrite(std_reg2str[o.reg]);
         top_const :
-          getopstr_jmp:=tostr(longint(o.val));
+          AsmWrite(tostr(longint(o.val)));
         top_symbol :
           begin
-            hs:=o.sym.name;
+            AsmWrite(o.sym.name);
             if o.symofs>0 then
-             hs:=hs+'+'+tostr(o.symofs)
+             AsmWrite('+'+tostr(o.symofs))
             else
              if o.symofs<0 then
-              hs:=hs+tostr(o.symofs);
-            getopstr_jmp:=hs;
+              AsmWrite(tostr(o.symofs));
           end;
         top_ref :
           { what about lcall or ljmp ??? }
           begin
-            if (aktoutputformat = as_i386_tasm) then
-              hs:=''
-            else
+            if (aktoutputformat <> as_i386_tasm) then
               begin
                 if s=S_FAR then
-                  hs:='far ptr '
+                  AsmWrite('far ptr ')
                 else
-                  hs:='dword ptr ';
+                  AsmWrite('dword ptr ');
               end;
-            getopstr_jmp:=hs+getreferencestring(o.ref^);
+            WriteReference(o.ref^);
           end;
         else
           internalerror(10001);
       end;
     end;
 
-   function fixline(s:string):string;
-   {
-     return s with all leading and ending spaces and tabs removed
-   }
-     var
-       i,j,k : longint;
-     begin
-       i:=length(s);
-       while (i>0) and (s[i] in [#9,' ']) do
-        dec(i);
-       j:=1;
-       while (j<i) and (s[j] in [#9,' ']) do
-        inc(j);
-       for k:=j to i do
-        if s[k] in [#0..#31,#127..#255] then
-         s[k]:='.';
-       fixline:=Copy(s,j,i-j+1);
-     end;
-
-
-{****************************************************************************
-                               T386IntelAssembler
- ****************************************************************************}
 
     var
       LasTSec : TSection;
@@ -342,7 +346,6 @@ interface
       found,
       do_line,DoNotSplitLine,
       quoted   : boolean;
-      sep      : char;
     begin
       if not assigned(p) then
        exit;
@@ -591,23 +594,21 @@ interface
                      end;
    ait_instruction : begin
                        taicpu(hp).CheckNonCommutativeOpcodes;
-                     { We need intel order, no At&t }
                        taicpu(hp).SetOperandOrder(op_intel);
-                     { Reset }
+                       { Reset }
                        suffix:='';
                        prefix:= '';
-                       s:='';
-                      { We need to explicitely set
-                        word prefix to get selectors
-                        to be pushed in 2 bytes  PM }
-                      if (taicpu(hp).opsize=S_W) and
-                         ((taicpu(hp).opcode=A_PUSH) or
-                          (taicpu(hp).opcode=A_POP)) and
-                          (taicpu(hp).oper[0].typ=top_reg) and
-                          ((taicpu(hp).oper[0].reg>=firstsreg) and
-                           (taicpu(hp).oper[0].reg<=lastsreg)) then
-                        AsmWriteln(#9#9'DB'#9'066h');
-                     { added prefix instructions, must be on same line as opcode }
+                       { We need to explicitely set
+                         word prefix to get selectors
+                         to be pushed in 2 bytes  PM }
+                       if (taicpu(hp).opsize=S_W) and
+                          ((taicpu(hp).opcode=A_PUSH) or
+                           (taicpu(hp).opcode=A_POP)) and
+                           (taicpu(hp).oper[0].typ=top_reg) and
+                           ((taicpu(hp).oper[0].reg>=firstsreg) and
+                            (taicpu(hp).oper[0].reg<=lastsreg)) then
+                         AsmWriteln(#9#9'DB'#9'066h');
+                       { added prefix instructions, must be on same line as opcode }
                        if (taicpu(hp).ops = 0) and
                           ((taicpu(hp).opcode = A_REP) or
                            (taicpu(hp).opcode = A_LOCK) or
@@ -621,8 +622,7 @@ interface
                         { this is theorically impossible... }
                           if hp=nil then
                            begin
-                             s:=#9#9+prefix;
-                             AsmWriteLn(s);
+                             AsmWriteLn(#9#9+prefix);
                              break;
                            end;
                           { nasm prefers prefix on a line alone
@@ -636,23 +636,27 @@ interface
                         end
                        else
                         prefix:= '';
+                       AsmWrite(#9#9+prefix+std_op2str[taicpu(hp).opcode]+cond2str[taicpu(hp).condition]+suffix);
                        if taicpu(hp).ops<>0 then
                         begin
                           if is_calljmp(taicpu(hp).opcode) then
-                           s:=#9+getopstr_jmp(taicpu(hp).oper[0],taicpu(hp).opsize)
+                           begin
+                             AsmWrite(#9);
+                             WriteOper_jmp(taicpu(hp).oper[0],taicpu(hp).opsize);
+                           end
                           else
                            begin
                              for i:=0to taicpu(hp).ops-1 do
                               begin
                                 if i=0 then
-                                 sep:=#9
+                                 AsmWrite(#9)
                                 else
-                                 sep:=',';
-                                s:=s+sep+getopstr(taicpu(hp).oper[i],taicpu(hp).opsize,taicpu(hp).opcode,(i=2));
+                                 AsmWrite(',');
+                                WriteOper(taicpu(hp).oper[i],taicpu(hp).opsize,taicpu(hp).opcode,(i=2));
                               end;
                            end;
                         end;
-                       AsmWriteLn(#9#9+prefix+std_op2str[taicpu(hp).opcode]+cond2str[taicpu(hp).condition]+suffix+s);
+                       AsmLn;
                      end;
 {$ifdef GDB}
              ait_stabn,
@@ -840,7 +844,10 @@ initialization
 end.
 {
   $Log$
-  Revision 1.30  2002-11-17 16:31:58  carl
+  Revision 1.31  2002-12-24 18:10:34  peter
+    * Long symbol names support
+
+  Revision 1.30  2002/11/17 16:31:58  carl
     * memory optimization (3-4%) : cleanup of tai fields,
        cleanup of tdef and tsym fields.
     * make it work for m68k

compiler/i386/ag386nsm.pas

@@ -27,10 +27,17 @@ unit ag386nsm;
 
 interface
 
-    uses aasmbase,aasmtai,aasmcpu,assemble;
+    uses
+      cpubase,
+      aasmbase,aasmtai,aasmcpu,assemble;
 
     type
       T386NasmAssembler = class(texternalassembler)
+      private
+        procedure WriteReference(var ref : treference);
+        procedure WriteOper(const o:toper;s : topsize; opcode: tasmop;ops:longint;dest : boolean);
+        procedure WriteOper_jmp(const o:toper; op : tasmop);
+      public
         procedure WriteTree(p:taasmoutput);override;
         procedure WriteAsmList;override;
         procedure WriteExternals;
@@ -45,7 +52,7 @@ interface
       sysutils,
 {$endif}
       cutils,globtype,globals,systems,cclasses,
-      fmodule,finput,verbose,cpubase,cpuinfo
+      fmodule,finput,verbose,cpuinfo
       ;
 
     const
@@ -154,54 +161,6 @@ interface
       end;
 
 
-    function getreferencestring(var ref : treference) : string;
-    var
-      s     : string;
-      first : boolean;
-    begin
-      with ref do
-        begin
-          first:=true;
-          inc(offset,offsetfixup);
-          offsetfixup:=0;
-          if ref.segment<>R_NO then
-           s:='['+std_reg2str[segment]+':'
-          else
-           s:='[';
-         if assigned(symbol) then
-          begin
-            s:=s+symbol.name;
-            first:=false;
-          end;
-         if (base<>R_NO) then
-          begin
-            if not(first) then
-             s:=s+'+'
-            else
-             first:=false;
-             s:=s+std_reg2str[base];
-          end;
-         if (index<>R_NO) then
-           begin
-             if not(first) then
-               s:=s+'+'
-             else
-               first:=false;
-             s:=s+std_reg2str[index];
-             if scalefactor<>0 then
-               s:=s+'*'+tostr(scalefactor);
-           end;
-         if offset<0 then
-           s:=s+tostr(offset)
-         else if (offset>0) then
-           s:=s+'+'+tostr(offset);
-         if s[length(s)]='[' then
-           s:=s+'0';
-         s:=s+']';
-        end;
-       getreferencestring:=s;
-     end;
-
     function sizestr(s:topsize;dest:boolean):string;
       begin
         case s of
@@ -232,81 +191,148 @@ interface
       end;
 
 
-    function getopstr(const o:toper;s : topsize; opcode: tasmop;ops:longint;dest : boolean) : string;
+    Function PadTabs(const p:string;addch:char):string;
       var
-        hs : string;
+        s : string;
+        i : longint;
+      begin
+        i:=length(p);
+        if addch<>#0 then
+         begin
+           inc(i);
+           s:=p+addch;
+         end
+        else
+         s:=p;
+        if i<8 then
+         PadTabs:=s+#9#9
+        else
+         PadTabs:=s+#9;
+      end;
+
+
+{****************************************************************************
+                               T386NasmAssembler
+ ****************************************************************************}
+
+    procedure T386NasmAssembler.WriteReference(var ref : treference);
+      var
+        first : boolean;
+      begin
+        with ref do
+         begin
+           AsmWrite('[');
+           first:=true;
+           inc(offset,offsetfixup);
+           offsetfixup:=0;
+           if ref.segment<>R_NO then
+            AsmWrite(std_reg2str[segment]+':');
+           if assigned(symbol) then
+            begin
+              AsmWrite(symbol.name);
+              first:=false;
+            end;
+           if (base<>R_NO) then
+            begin
+              if not(first) then
+               AsmWrite('+')
+              else
+               first:=false;
+              AsmWrite(int_nasmreg2str[base]);
+            end;
+           if (index<>R_NO) then
+             begin
+               if not(first) then
+                 AsmWrite('+')
+               else
+                 first:=false;
+               AsmWrite(int_nasmreg2str[index]);
+               if scalefactor<>0 then
+                 AsmWrite('*'+tostr(scalefactor));
+             end;
+           if offset<0 then
+             begin
+               AsmWrite(tostr(offset));
+               first:=false;
+             end
+           else if (offset>0) then
+             begin
+               AsmWrite('+'+tostr(offset));
+               first:=false;
+             end;
+           if first then
+             AsmWrite('0');
+           AsmWrite(']');
+         end;
+       end;
+
+
+    procedure T386NasmAssembler.WriteOper(const o:toper;s : topsize; opcode: tasmop;ops:longint;dest : boolean);
       begin
         case o.typ of
           top_reg :
-            getopstr:=int_nasmreg2str[o.reg];
+            AsmWrite(int_nasmreg2str[o.reg]);
           top_const :
             begin
               if (ops=1) and (opcode<>A_RET) then
-               getopstr:=sizestr(s,dest)+tostr(longint(o.val))
-              else
-               getopstr:=tostr(longint(o.val));
+               AsmWrite(sizestr(s,dest));
+              AsmWrite(tostr(longint(o.val)));
             end;
           top_symbol :
             begin
+              AsmWrite('dword ');
               if assigned(o.sym) then
-               hs:='dword '+o.sym.name
-              else
-               hs:='dword ';
+               AsmWrite(o.sym.name);
               if o.symofs>0 then
-               hs:=hs+'+'+tostr(o.symofs)
+               AsmWrite('+'+tostr(o.symofs))
               else
                if o.symofs<0 then
-                hs:=hs+tostr(o.symofs)
+                AsmWrite(tostr(o.symofs))
                else
                 if not(assigned(o.sym)) then
-                 hs:=hs+'0';
-              getopstr:=hs;
+                 AsmWrite('0');
             end;
           top_ref :
             begin
-              hs:=getreferencestring(o.ref^);
               if not ((opcode = A_LEA) or (opcode = A_LGS) or
                       (opcode = A_LSS) or (opcode = A_LFS) or
                       (opcode = A_LES) or (opcode = A_LDS) or
                       (opcode = A_SHR) or (opcode = A_SHL) or
                       (opcode = A_SAR) or (opcode = A_SAL) or
                       (opcode = A_OUT) or (opcode = A_IN)) then
-               begin
-                 hs:=sizestr(s,dest)+hs;
-               end;
-              getopstr:=hs;
+                AsmWrite(sizestr(s,dest));
+              WriteReference(o.ref^);
             end;
           else
             internalerror(10001);
         end;
       end;
 
-    function getopstr_jmp(const o:toper; op : tasmop) : string;
-      var
-        hs : string;
+
+    procedure T386NasmAssembler.WriteOper_jmp(const o:toper; op : tasmop);
       begin
         case o.typ of
           top_reg :
-            getopstr_jmp:=int_nasmreg2str[o.reg];
+            AsmWrite(int_nasmreg2str[o.reg]);
           top_ref :
-            getopstr_jmp:=getreferencestring(o.ref^);
+            WriteReference(o.ref^);
           top_const :
-            getopstr_jmp:=tostr(longint(o.val));
+            AsmWrite(tostr(longint(o.val)));
           top_symbol :
             begin
-              hs:=o.sym.name;
+              if not(
+                     (op=A_JCXZ) or (op=A_JECXZ) or
+                     (op=A_LOOP) or (op=A_LOOPE) or
+                     (op=A_LOOPNE) or (op=A_LOOPNZ) or
+                     (op=A_LOOPZ)
+                    ) then
+                AsmWrite('NEAR ');
+              AsmWrite(o.sym.name);
               if o.symofs>0 then
-               hs:=hs+'+'+tostr(o.symofs)
+               AsmWrite('+'+tostr(o.symofs))
               else
                if o.symofs<0 then
-                hs:=hs+tostr(o.symofs);
-              if (op=A_JCXZ) or (op=A_JECXZ) or
-                 (op=A_LOOP) or (op=A_LOOPE) or
-                 (op=A_LOOPNE) or (op=A_LOOPNZ) or
-                 (op=A_LOOPZ) then
-                getopstr_jmp:=hs
-              else
-                getopstr_jmp:='NEAR '+hs;
+                AsmWrite(tostr(o.symofs));
             end;
           else
             internalerror(10001);
@@ -314,10 +340,6 @@ interface
       end;
 
 
-{****************************************************************************
-                               T386NasmAssembler
- ****************************************************************************}
-
     var
       LasTSec : TSection;
 
@@ -325,26 +347,6 @@ interface
       ait_const2str:array[ait_const_32bit..ait_const_8bit] of string[8]=
         (#9'DD'#9,#9'DW'#9,#9'DB'#9);
 
-    Function PadTabs(const p:string;addch:char):string;
-    var
-      s : string;
-      i : longint;
-    begin
-      i:=length(p);
-      if addch<>#0 then
-       begin
-         inc(i);
-         s:=p+addch;
-       end
-      else
-       s:=p;
-      if i<8 then
-       PadTabs:=s+#9#9
-      else
-       PadTabs:=s+#9;
-    end;
-
-
     procedure T386NasmAssembler.WriteTree(p:taasmoutput);
     const
       allocstr : array[boolean] of string[10]=(' released',' allocated');
@@ -360,7 +362,6 @@ interface
       found,
       do_line,
       quoted   : boolean;
-      sep      : char;
     begin
       if not assigned(p) then
        exit;
@@ -375,7 +376,7 @@ interface
 
          if not(hp.typ in SkipLineInfo) then
            begin
-             hp1:=hp as tailineinfo; 
+             hp1:=hp as tailineinfo;
              aktfilepos:=hp1.fileinfo;
              if do_line then
               begin
@@ -633,11 +634,8 @@ interface
            ait_instruction :
              begin
                taicpu(hp).CheckNonCommutativeOpcodes;
-             { We need intel order, no At&t }
+               { We need intel order, no At&t }
                taicpu(hp).SetOperandOrder(op_intel);
-             { Reset
-               suffix:='';
-               prefix:='';}
                s:='';
                if ((taicpu(hp).opcode=A_FADDP) or
                    (taicpu(hp).opcode=A_FMULP))
@@ -649,38 +647,42 @@ interface
                    taicpu(hp).oper[1].typ:=top_reg;
                    taicpu(hp).oper[1].reg:=R_ST;
                  end;
-               if taicpu(hp).ops<>0 then
+               if taicpu(hp).opcode=A_FWAIT then
+                AsmWriteln(#9#9'DB'#9'09bh')
+               else
                 begin
-                  if is_calljmp(taicpu(hp).opcode) then
-                   s:=#9+getopstr_jmp(taicpu(hp).oper[0],taicpu(hp).opcode)
-                  else
+                  { We need to explicitely set
+                    word prefix to get selectors
+                    to be pushed in 2 bytes  PM }
+                  if (taicpu(hp).opsize=S_W) and
+                     ((taicpu(hp).opcode=A_PUSH) or
+                      (taicpu(hp).opcode=A_POP)) and
+                      (taicpu(hp).oper[0].typ=top_reg) and
+                      ((taicpu(hp).oper[0].reg>=firstsreg) and
+                       (taicpu(hp).oper[0].reg<=lastsreg)) then
+                    AsmWriteln(#9#9'DB'#9'066h');
+                  AsmWrite(#9#9+std_op2str[taicpu(hp).opcode]+cond2str[taicpu(hp).condition]);
+                  if taicpu(hp).ops<>0 then
                    begin
-                      { We need to explicitely set
-                        word prefix to get selectors
-                        to be pushed in 2 bytes  PM }
-                      if (taicpu(hp).opsize=S_W) and
-                         ((taicpu(hp).opcode=A_PUSH) or
-                          (taicpu(hp).opcode=A_POP)) and
-                          (taicpu(hp).oper[0].typ=top_reg) and
-                          ((taicpu(hp).oper[0].reg>=firstsreg) and
-                           (taicpu(hp).oper[0].reg<=lastsreg)) then
-                        AsmWriteln(#9#9'DB'#9'066h');
-                     for i:=0 to taicpu(hp).ops-1 do
+                     if is_calljmp(taicpu(hp).opcode) then
                       begin
-                        if i=0 then
-                         sep:=#9
-                        else
-                         sep:=',';
-                        s:=s+sep+getopstr(taicpu(hp).oper[i],taicpu(hp).opsize,taicpu(hp).opcode,
-                          taicpu(hp).ops,(i=2));
+                        AsmWrite(#9);
+                        WriteOper_jmp(taicpu(hp).oper[0],taicpu(hp).opcode);
+                      end
+                     else
+                      begin
+                        for i:=0 to taicpu(hp).ops-1 do
+                         begin
+                           if i=0 then
+                            AsmWrite(#9)
+                           else
+                            AsmWrite(',');
+                           WriteOper(taicpu(hp).oper[i],taicpu(hp).opsize,taicpu(hp).opcode,taicpu(hp).ops,(i=2));
+                         end;
                       end;
                    end;
+                  AsmLn;
                 end;
-               if taicpu(hp).opcode=A_FWAIT then
-                AsmWriteln(#9#9'DB'#9'09bh')
-               else
-                AsmWriteLn(#9#9+{prefix+}std_op2str[taicpu(hp).opcode]+
-                  cond2str[taicpu(hp).condition]+{suffix+}s);
              end;
 {$ifdef GDB}
            ait_stabn,
@@ -893,7 +895,10 @@ initialization
 end.
 {
   $Log$
-  Revision 1.28  2002-11-17 16:31:59  carl
+  Revision 1.29  2002-12-24 18:10:34  peter
+    * Long symbol names support
+
+  Revision 1.28  2002/11/17 16:31:59  carl
     * memory optimization (3-4%) : cleanup of tai fields,
        cleanup of tdef and tsym fields.
     * make it work for m68k