home *** CD-ROM | disk | FTP | other *** search
/ AmigActive 2 / AACD 2.iso / AACD / Programming / fpc / compiler / ag386int.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1998-09-24  |  29.9 KB  |  797 lines
  1. {
  2.     $Id: ag386int.pas,v 1.1.1.1.2.2 1998/05/25 23:00:22 carl Exp $
  3.     Copyright (c) 1996,97 by Florian Klaempfl
  4.  
  5.     This unit implements an asmoutput class for Intel syntax with Intel i386+
  6.  
  7.     This program is free software; you can redistribute it and/or modify
  8.     it under the terms of the GNU General Public License as published by
  9.     the Free Software Foundation; either version 2 of the License, or
  10.     (at your option) any later version.
  11.  
  12.     This program is distributed in the hope that it will be useful,
  13.     but WITHOUT ANY WARRANTY; without even the implied warranty of
  14.     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  15.     GNU General Public License for more details.
  16.  
  17.     You should have received a copy of the GNU General Public License
  18.     along with this program; if not, write to the Free Software
  19.     Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  20.  
  21.  ****************************************************************************
  22. }
  23. {$R-}
  24. unit ag386int;
  25.  
  26.     interface
  27.  
  28.     uses aasm,assemble;
  29.  
  30.     type
  31.       pi386intasmlist=^ti386intasmlist;
  32.       ti386intasmlist = object(tasmlist)
  33.         procedure WriteTree(p:paasmoutput);virtual;
  34.         procedure WriteAsmList;virtual;
  35.       end;
  36.  
  37.   implementation
  38.  
  39.     uses
  40.       dos,globals,systems,cobjects,i386,
  41.       strings,files,verbose
  42. {$ifdef GDB}
  43.       ,gdb
  44. {$endif GDB}
  45.       ;
  46.  
  47.     const
  48.       line_length = 70;
  49.  
  50.       extstr : array[EXT_NEAR..EXT_ABS] of String[8] =
  51.              ('NEAR','FAR','PROC','BYTE','WORD','DWORD',
  52.               'CODEPTR','DATAPTR','FWORD','PWORD','QWORD','TBYTE','ABS');
  53.  
  54.     function getreferencestring(const ref : treference) : string;
  55.     var
  56.       s     : string;
  57.       first : boolean;
  58.     begin
  59.       if ref.isintvalue then
  60.        s:= tostr(ref.offset)
  61.       else
  62. {$ifdef ver0_6}
  63.        begin
  64.       first:=true;
  65.       { have we a segment prefix ? }
  66.       if ref.segment<>R_DEFAULT_SEG then
  67.       begin
  68.         if current_module^.output_format in [of_nasm,of_obj] then
  69.           s:='['+_reg2str[ref.segment]+':'
  70.         else
  71.           s:=_reg2str[ref.segment]+':[';
  72.       end
  73.       else s:='[';
  74.  
  75.       if assigned(ref.symbol) then
  76.         begin
  77.            s:=s+ref.symbol^;
  78.            first:=false;
  79.         end;
  80.       if (ref.base<>R_NO) then
  81.         begin
  82.            if not(first) then
  83.              s:=s+'+'
  84.            else
  85.              first:=false;
  86.            s:=s+_reg2str[ref.base];
  87.         end;
  88.       if (ref.index<>R_NO) then
  89.         begin
  90.            if not(first) then
  91.              s:=s+'+'
  92.            else
  93.              first:=false;
  94.            s:=s+_reg2str[ref.index];
  95.            if ref.scalefactor<>0 then
  96.              s:=s+'*'+tostr(ref.scalefactor);
  97.         end;
  98.       if ref.offset<0 then
  99.         s:=s+tostr(ref.offset)
  100.       else if (ref.offset>0) then
  101.         s:=s+'+'+tostr(ref.offset);
  102.       s:=s+']';
  103.         end;
  104. {$else}
  105.       with ref do
  106.         begin
  107.           first:=true;
  108.           if ref.segment<>R_DEFAULT_SEG then
  109.            begin
  110.              if current_module^.output_format in [of_nasm,of_obj] then
  111.               s:='['+int_reg2str[segment]+':'
  112.              else
  113.               s:=int_reg2str[segment]+':[';
  114.            end
  115.           else
  116.            s:='[';
  117.  
  118.          if assigned(symbol) then
  119.           begin
  120.             s:=s+symbol^;
  121.             first:=false;
  122.           end;
  123.          if (base<>R_NO) then
  124.           begin
  125.             if not(first) then
  126.              s:=s+'+'
  127.             else
  128.              first:=false;
  129.              s:=s+int_reg2str[base];
  130.           end;
  131.          if (index<>R_NO) then
  132.            begin
  133.              if not(first) then
  134.                s:=s+'+'
  135.              else
  136.                first:=false;
  137.              s:=s+int_reg2str[index];
  138.              if scalefactor<>0 then
  139.                s:=s+'*'+tostr(scalefactor);
  140.            end;
  141.          if offset<0 then
  142.            s:=s+tostr(offset)
  143.          else if (offset>0) then
  144.            s:=s+'+'+tostr(offset);
  145.          s:=s+']';
  146.         end;
  147. {$endif}
  148.        getreferencestring:=s;
  149.      end;
  150.  
  151.     function getopstr(t : byte;o : pointer;s : topsize; _operator: tasmop;dest : boolean) : string;
  152.  
  153.       var
  154.     hs : string;
  155.  
  156.       begin
  157.     case t of
  158.        top_reg : { a floating point register can be only a register operand }
  159.             if current_module^.output_format in [of_nasm,of_obj] then
  160.                getopstr:=int_nasmreg2str[tregister(o)]
  161.             else
  162.                getopstr:=int_reg2str[tregister(o)];
  163.        top_const,
  164.        top_ref : begin
  165.                   if t=top_const then
  166.                     hs := tostr(longint(o))
  167.                   else
  168.                     hs:=getreferencestring(preference(o)^);
  169.                   if current_module^.output_format in [of_nasm,of_obj] then
  170.                     if (_operator = A_LEA) or (_operator = A_LGS)
  171.                     or (_operator = A_LSS) or (_operator = A_LFS)
  172.                     or (_operator = A_LES) or (_operator = A_LDS)
  173.                     or (_operator = A_SHR) or (_operator = A_SHL)
  174.                     or (_operator = A_SAR) or (_operator = A_SAL)
  175.                     or (_operator = A_OUT) or (_operator = A_IN) then
  176.                     begin
  177.                     end
  178.                     else
  179.                       case s of
  180.                          S_B : hs:='byte '+hs;
  181.                          S_W : hs:='word '+hs;
  182.                          S_L : hs:='dword '+hs;
  183.                          S_S : hs:='dword '+hs;
  184.                          S_Q : hs:='qword '+hs;
  185.                          S_X : if current_module^.output_format in [of_nasm,of_obj] then
  186.                                  hs:='tword '+hs
  187.                                else
  188.                                  hs:='tbyte '+hs;
  189.                          S_BW : if dest then
  190.                              hs:='word '+hs
  191.                            else
  192.                              hs:='byte '+hs;
  193.                          S_BL : if dest then
  194.                              hs:='dword '+hs
  195.                            else
  196.                              hs:='byte '+hs;
  197.                          S_WL : if dest then
  198.                              hs:='dword '+hs
  199.                            else
  200.                              hs:='word '+hs;
  201.                       end
  202.           else
  203.           Begin
  204.             { can possibly give a range check error under tp }
  205.             { if using in...                                 }
  206.             if ((_operator <> A_LGS) and (_operator <> A_LSS) and
  207.                (_operator <> A_LFS) and (_operator <> A_LDS) and
  208.                (_operator <> A_LES)) then
  209.             Begin
  210.             case s of
  211.                S_B : hs:='byte ptr '+hs;
  212.                S_W : hs:='word ptr '+hs;
  213.                S_L : hs:='dword ptr '+hs;
  214.                S_BW : if dest then
  215.                    hs:='word ptr '+hs
  216.                  else
  217.                    hs:='byte ptr '+hs;
  218.                S_BL : if dest then
  219.                    hs:='dword ptr '+hs
  220.                  else
  221.                    hs:='byte ptr '+hs;
  222.                S_WL : if dest then
  223.                    hs:='dword ptr '+hs
  224.                  else
  225.                    hs:='word ptr '+hs;
  226.             end;
  227.             end;
  228.           end;
  229.               getopstr:=hs;
  230.             end;
  231.        top_symbol : begin
  232.              hs[0]:=chr(strlen(pchar(pcsymbol(o)^.symbol)));
  233.              move(pchar(pcsymbol(o)^.symbol)^,hs[1],byte(hs[0]));
  234.              if current_module^.output_format=of_masm then
  235.                hs:='offset '+hs
  236.              else
  237.                hs:='dword '+hs;
  238.  
  239.              if pcsymbol(o)^.offset>0 then
  240.                hs:=hs+'+'+tostr(pcsymbol(o)^.offset)
  241.              else if pcsymbol(o)^.offset<0 then
  242.                hs:=hs+tostr(pcsymbol(o)^.offset);
  243.              getopstr:=hs;
  244.           end;
  245.        else internalerror(10001);
  246.     end;
  247.       end;
  248.  
  249.     function getopstr_jmp(t : byte;o : pointer) : string;
  250.  
  251.       var
  252.     hs : string;
  253.  
  254.       begin
  255.     case t of
  256.        top_reg : getopstr_jmp:=int_reg2str[tregister(o)];
  257.        top_ref : getopstr_jmp:=getreferencestring(preference(o)^);
  258.        top_const : getopstr_jmp:=tostr(longint(o));
  259.        top_symbol : begin
  260.              hs[0]:=chr(strlen(pchar(pcsymbol(o)^.symbol)));
  261.              move(pchar(pcsymbol(o)^.symbol)^,hs[1],byte(hs[0]));
  262.              if pcsymbol(o)^.offset>0 then
  263.                hs:=hs+'+'+tostr(pcsymbol(o)^.offset)
  264.              else if pcsymbol(o)^.offset<0 then
  265.                hs:=hs+tostr(pcsymbol(o)^.offset);
  266.              getopstr_jmp:=hs;
  267.           end;
  268.        else internalerror(10001);
  269.     end;
  270.       end;
  271.  
  272. {****************************************************************************
  273.                                TI386INTASMLIST
  274.  ****************************************************************************}
  275.  
  276.     const
  277.       ait_const2str:array[ait_const_32bit..ait_const_8bit] of string[8]=
  278.         (#9'DD'#9,'',#9'DW'#9,#9'DB'#9);
  279.  
  280.     Function PadTabs(p:pchar;addch:char):string;
  281.     var
  282.       s : string;
  283.       i : longint;
  284.     begin
  285.       i:=strlen(p);
  286.       if addch<>#0 then
  287.        begin
  288.          inc(i);
  289.          s:=StrPas(p)+addch;
  290.        end
  291.       else
  292.        s:=StrPas(p);
  293.       if i<8 then
  294.        PadTabs:=s+#9#9
  295.       else
  296.        PadTabs:=s+#9;
  297.     end;
  298.  
  299.     procedure ti386intasmlist.WriteTree(p:paasmoutput);
  300.     type
  301.       twowords=record
  302.         word1,word2:word;
  303.       end;
  304.     var
  305.       s,
  306.       prefix,
  307.       suffix   : string;
  308.       hp       : pai;
  309.       counter,
  310.       lines,
  311.       i,j,l    : longint;
  312.       consttyp : tait;
  313.       found,
  314.       quoted   : boolean;
  315.     begin
  316.       hp:=pai(p^.first);
  317.       while assigned(hp) do
  318.        begin
  319.          case hp^.typ of
  320.        ait_comment : ;
  321.          ait_align : begin
  322.                      { align not supported at all with nasm v095  }
  323.                      { align with specific value not supported by }
  324.                      { turbo assembler.                           }
  325.                      { CAUSES PROBLEMS WITH THE SEGMENT DEFINITION   }
  326.                      { SEGMENT DEFINITION SHOULD MATCH TYPE OF ALIGN }
  327.                      { HERE UNDER TASM!                              }
  328. {                      if current_module^.output_format<>of_nasm then
  329.                         AsmWriteLn(#9'ALIGN '+tostr(pai_align(hp)^.aligntype));}
  330.                      end;
  331.       ait_external : begin
  332.                        if current_module^.output_format in [of_nasm,of_obj] then
  333.                         AsmWriteLn('EXTERN '+StrPas(pai_external(hp)^.name))
  334.                        else
  335.                         AsmWriteLn(#9#9'EXTRN'#9+StrPas(pai_external(hp)^.name)+
  336.                                    ' :'+extstr[pai_external(hp)^.exttyp]);
  337.                      end;
  338.      ait_datablock : begin
  339.                        if current_module^.output_format in [of_nasm,of_obj] then
  340.                         begin
  341.                           if pai_datablock(hp)^.is_global then
  342.                            AsmWriteLn('GLOBAL '+StrPas(pai_datablock(hp)^.name));
  343.                           AsmWriteLn(PadTabs(pai_datablock(hp)^.name,':')+'RESB'#9+tostr(pai_datablock(hp)^.size));
  344.                         end
  345.                        else
  346.                         begin
  347.                           if pai_datablock(hp)^.is_global then
  348.                            AsmWriteLn(#9#9'PUBLIC'#9+StrPas(pai_datablock(hp)^.name));
  349.                           AsmWriteLn(PadTabs(pai_datablock(hp)^.name,#0)+'DB'#9+tostr(pai_datablock(hp)^.size)+' DUP(?)');
  350.                         end;
  351.                      end;
  352.    ait_const_32bit,
  353.     ait_const_8bit,
  354.    ait_const_16bit : begin
  355.                        AsmWrite(ait_const2str[hp^.typ]+tostr(pai_const(hp)^.value));
  356.                        consttyp:=hp^.typ;
  357.                        l:=0;
  358.                        repeat
  359.                          found:=(not (Pai(hp^.next)=nil)) and (Pai(hp^.next)^.typ=consttyp);
  360.                          if found then
  361.                           begin
  362.                             hp:=Pai(hp^.next);
  363.                             s:=','+tostr(pai_const(hp)^.value);
  364.                             AsmWrite(s);
  365.                             inc(l,length(s));
  366.                           end;
  367.                        until (not found) or (l>line_length);
  368.                        AsmLn;
  369.                      end;
  370.   ait_const_symbol : begin
  371.                        if current_module^.output_format<>of_nasm then
  372.                         AsmWrite(#9#9+'DD '#9'offset ')
  373.                        else
  374.                         AsmWrite(#9#9+'DD '#9);
  375.                        AsmWriteLn(StrPas(pchar(pai_const(hp)^.value)));
  376.                      end;
  377.     ait_real_32bit : AsmWriteLn(#9#9'DD'#9+double2str(pai_single(hp)^.value));
  378.     ait_real_64bit : AsmWriteLn(#9#9'DQ'#9+double2str(pai_double(hp)^.value));
  379.  ait_real_extended : begin
  380.                      { nasm v095 does not like DT with real constants }
  381.                      { therefore write as double.                     }
  382.                      { other possible solution: decode directly to hex}
  383.                      { value.                                         }
  384.                        if current_module^.output_format<>of_nasm then
  385.                         AsmWriteLn(#9#9'DT'#9+double2str(pai_extended(hp)^.value))
  386.                        else
  387.                         begin
  388. {$ifdef EXTDEBUG}
  389.                           AsmLn;
  390.                           AsmWriteLn('; NASM bug work around for extended real');
  391. {$endif}
  392.                           AsmWriteLn(#9#9'DD'#9+double2str(pai_extended(hp)^.value))
  393.                         end;
  394.                      end;
  395.           ait_comp : AsmWriteLn(#9#9'DQ'#9+comp2str(pai_extended(hp)^.value));
  396.         ait_string : begin
  397.                        counter := 0;
  398.                        lines := pai_string(hp)^.len div line_length;
  399.                      { separate lines in different parts }
  400.                        if pai_string(hp)^.len > 0 then
  401.                         Begin
  402.                           for j := 0 to lines-1 do
  403.                            begin
  404.                              AsmWrite(#9#9'DB'#9);
  405.                              quoted:=false;
  406.                              for i:=counter to counter+line_length do
  407.                                 begin
  408.                                   { it is an ascii character. }
  409.                                   if (ord(pai_string(hp)^.str[i])>31) and
  410.                                      (ord(pai_string(hp)^.str[i])<128) and
  411.                                      (pai_string(hp)^.str[i]<>'"') then
  412.                                       begin
  413.                                         if not(quoted) then
  414.                                             begin
  415.                                               if i>counter then
  416.                                                 AsmWrite(',');
  417.                                               AsmWrite('"');
  418.                                             end;
  419.                                         AsmWrite(pai_string(hp)^.str[i]);
  420.                                         quoted:=true;
  421.                                       end { if > 31 and < 128 and ord('"') }
  422.                                   else
  423.                                       begin
  424.                                           if quoted then
  425.                                               AsmWrite('"');
  426.                                           if i>counter then
  427.                                               AsmWrite(',');
  428.                                           quoted:=false;
  429.                                           AsmWrite(tostr(ord(pai_string(hp)^.str[i])));
  430.                                       end;
  431.                                end; { end for i:=0 to... }
  432.                              if quoted then AsmWrite('"');
  433.                                AsmWrite(target_info.newline);
  434.                              counter := counter+line_length;
  435.                           end; { end for j:=0 ... }
  436.                         { do last line of lines }
  437.                         AsmWrite(#9#9'DB'#9);
  438.                         quoted:=false;
  439.                         for i:=counter to pai_string(hp)^.len-1 do
  440.                           begin
  441.                             { it is an ascii character. }
  442.                             if (ord(pai_string(hp)^.str[i])>31) and
  443.                                (ord(pai_string(hp)^.str[i])<128) and
  444.                                (pai_string(hp)^.str[i]<>'"') then
  445.                                 begin
  446.                                   if not(quoted) then
  447.                                       begin
  448.                                         if i>counter then
  449.                                           AsmWrite(',');
  450.                                         AsmWrite('"');
  451.                                       end;
  452.                                   AsmWrite(pai_string(hp)^.str[i]);
  453.                                   quoted:=true;
  454.                                 end { if > 31 and < 128 and " }
  455.                             else
  456.                                 begin
  457.                                   if quoted then
  458.                                     AsmWrite('"');
  459.                                   if i>counter then
  460.                                       AsmWrite(',');
  461.                                   quoted:=false;
  462.                                   AsmWrite(tostr(ord(pai_string(hp)^.str[i])));
  463.                                 end;
  464.                           end; { end for i:=0 to... }
  465.                         if quoted then
  466.                           AsmWrite('"');
  467.                         end;
  468.                        AsmLn;
  469.                      end;
  470.          ait_label : begin
  471.                        AsmWrite(lab2str(pai_label(hp)^.l));
  472.                        if (current_module^.output_format in [of_obj,of_nasm]) or
  473.                           (assigned(hp^.next) and not(pai(hp^.next)^.typ in
  474.                            [ait_const_32bit,ait_const_16bit,ait_const_8bit,ait_const_symbol,
  475.                             ait_real_32bit,ait_real_64bit,ait_real_extended,ait_string])) then
  476.                         AsmWriteLn(':');
  477.                      end;
  478.         ait_direct : begin
  479.                        AsmWritePChar(pai_direct(hp)^.str);
  480.                        AsmLn;
  481.                      end;
  482. ait_labeled_instruction :
  483.                      begin
  484.                        if (current_module^.output_format in [of_nasm,of_obj]) and
  485.                           not (pai_labeled(hp)^._operator in [A_JMP,A_LOOP,A_LOOPZ,A_LOOPE,
  486.                           A_LOOPNZ,A_LOOPNE,A_JCXZ,A_JECXZ]) then
  487.                         AsmWriteLn(#9#9+int_op2str[pai_labeled(hp)^._operator]+#9+'near '+lab2str(pai_labeled(hp)^.lab))
  488.                        else
  489.                         AsmWriteLn(#9#9+int_op2str[pai_labeled(hp)^._operator]+#9+lab2str(pai_labeled(hp)^.lab));
  490.                      end;
  491.         ait_symbol : begin
  492.                        if pai_symbol(hp)^.is_global then
  493.                         begin
  494.                           if current_module^.output_format in [of_nasm,of_obj] then
  495.                            AsmWriteLn('GLOBAL '+StrPas(pai_symbol(hp)^.name))
  496.                           else
  497.                            AsmWriteLn(#9#9'PUBLIC'#9+StrPas(pai_symbol(hp)^.name));
  498.                         end;
  499.                        AsmWritePChar(pai_symbol(hp)^.name);
  500.                        if assigned(hp^.next) and not(pai(hp^.next)^.typ in
  501.                         [ait_const_32bit,ait_const_16bit,ait_const_8bit,ait_const_symbol,
  502.                          ait_real_64bit,ait_string]) then
  503.                         AsmWriteLn(':')
  504.                      end;
  505.    ait_instruction : begin
  506.                        suffix:='';
  507.                        prefix:= '';
  508.                      { added prefix instructions, must be on same line as opcode }
  509.                        if (pai386(hp)^.op1t = top_none) and
  510.                           ((pai386(hp)^._operator = A_REP) or
  511.                            (pai386(hp)^._operator = A_LOCK) or
  512.                            (pai386(hp)^._operator =  A_REPE) or
  513.                            (pai386(hp)^._operator = A_REPNE)) then
  514.                         Begin
  515.                           prefix:=int_op2str[pai386(hp)^._operator]+#9;
  516.                           hp:=Pai(hp^.next);
  517.                         { this is theorically impossible... }
  518.                           if hp=nil then
  519.                            begin
  520.                              s:=#9#9+prefix;
  521.                              AsmWriteLn(s);
  522.                              break;
  523.                            end;
  524.                         end;
  525.                        if pai386(hp)^.op1t<>top_none then
  526.                         begin
  527.                           if pai386(hp)^._operator in [A_CALL] then
  528.                            begin
  529.                              if output_format=of_nasm then
  530.                               s:=getopstr_jmp(pai386(hp)^.op1t,pai386(hp)^.op1)
  531.                              else
  532.                               Begin
  533.                                 if (pai386(hp)^.op1t = top_ref) then
  534.                                    s:=getopstr_jmp(pai386(hp)^.op1t,pai386(hp)^.op1)
  535.                                 else
  536.                                    s:='near ptr '+getopstr_jmp(pai386(hp)^.op1t,pai386(hp)^.op1);
  537.                               end;
  538.                            end
  539.                           else
  540.                            begin
  541.                              s:=getopstr(pai386(hp)^.op1t,pai386(hp)^.op1,pai386(hp)^.size,pai386(hp)^._operator,false);
  542.                              if pai386(hp)^.op3t<>top_none then
  543.                               begin
  544.                                 if pai386(hp)^.op2t<>top_none then
  545.                                  s:=getopstr(pai386(hp)^.op2t,pointer(longint(twowords(pai386(hp)^.op2).word1)),
  546.                                              pai386(hp)^.size,pai386(hp)^._operator,true)+','+s;
  547.                                           s:=getopstr(pai386(hp)^.op3t,pointer(longint(twowords(pai386(hp)^.op2).word2)),
  548.                                            pai386(hp)^.size,pai386(hp)^._operator,false)+','+s;
  549.                               end
  550.                              else
  551.                               if pai386(hp)^.op2t<>top_none then
  552.                                s:=getopstr(pai386(hp)^.op2t,pai386(hp)^.op2,pai386(hp)^.size,
  553.                                            pai386(hp)^._operator,true)+','+s;
  554.                            end;
  555.                           s:=#9+s;
  556.                         end
  557.                        else
  558.                         begin
  559.                           { check if string instruction }
  560.                           { long form, otherwise may give range check errors }
  561.                           { in turbo pascal...                               }
  562.                           if ((pai386(hp)^._operator = A_CMPS) or
  563.                              (pai386(hp)^._operator = A_INS) or
  564.                              (pai386(hp)^._operator = A_OUTS) or
  565.                              (pai386(hp)^._operator = A_SCAS) or
  566.                              (pai386(hp)^._operator = A_STOS) or
  567.                              (pai386(hp)^._operator = A_MOVS) or
  568.                              (pai386(hp)^._operator = A_LODS) or
  569.                              (pai386(hp)^._operator = A_XLAT)) then
  570.                            Begin
  571.                              case pai386(hp)^.size of
  572.                               S_B: suffix:='b';
  573.                               S_W: suffix:='w';
  574.                               S_L: suffix:='d';
  575.                              else
  576.                               Message(assem_f_invalid_suffix_intel);
  577.                              end;
  578.                            end;
  579.                           s:='';
  580.                         end;
  581.                        AsmWriteLn(#9#9+prefix+int_op2str[pai386(hp)^._operator]+suffix+s);
  582.                      end;
  583. {$ifdef GDB}
  584.              ait_stabn,
  585.              ait_stabs,
  586. ait_stab_function_name : ;
  587. {$endif GDB}
  588.          else
  589.           internalerror(10000);
  590.          end;
  591.          hp:=pai(hp^.next);
  592.        end;
  593.     end;
  594.  
  595.  
  596.     procedure ti386intasmlist.WriteAsmList;
  597.     begin
  598. {$ifdef EXTDEBUG}
  599.       if assigned(current_module^.mainsource) then
  600.        comment(v_info,'Start writing intel-styled assembler output for '+current_module^.mainsource^);
  601. {$endif}
  602.       if current_module^.output_format in [of_nasm,of_obj] then
  603.        begin
  604.          WriteTree(externals);
  605.          { INTEL ASM doesn't support stabs
  606.          WriteTree(debuglist);}
  607.  
  608.          AsmWriteLn('BITS 32');
  609.          AsmWriteLn('SECTION .text');
  610.          {
  611.          AsmWriteLn(#9#9'ASSUME'#9'CS:_TEXT,ES:DGROUP,DS:DGROUP,SS:DGROUP');
  612.          }
  613.          WriteTree(codesegment);
  614.  
  615.          AsmLn;
  616.          AsmWriteLn('SECTION .data');
  617. {$ifdef EXTDEBUG}
  618.          AsmWriteLn(#9#9'DB'#9'"compiled by FPC '+version_string+'\0"');
  619.          AsmWriteLn(#9#9'DB'#9'"target: '+target_info.target_name+'\0"');
  620. {$endif EXTDEBUG}
  621.          WriteTree(datasegment);
  622.          WriteTree(consts);
  623.  
  624.          AsmLn;
  625.          AsmWriteLn('SECTION .bss');
  626.          WriteTree(bsssegment);
  627.        end
  628.       else
  629.        begin
  630.          AsmWriteLn('.386p');
  631.  
  632.          WriteTree(externals);
  633.          { INTEL ASM doesn't support stabs
  634.          WriteTree(debuglist);}
  635.  
  636.          AsmWriteLn('DGROUP'#9#9'GROUP'#9'_BSS,_DATA');
  637.          AsmWriteLn('_TEXT'#9#9'SEGMENT'#9'BYTE PUBLIC USE32 ''CODE''');
  638.          AsmWriteLn(#9#9'ASSUME'#9'CS:_TEXT,ES:DGROUP,DS:DGROUP,SS:DGROUP');
  639.          AsmLn;
  640.          WriteTree(codesegment);
  641.          AsmWriteLn('_TEXT'#9#9'ENDS');
  642.  
  643.          AsmLn;
  644.          AsmWriteLn('_DATA'#9#9'SEGMENT'#9'DWORD PUBLIC USE32 ''DATA''');
  645. {$ifdef EXTDEBUG}
  646.          AsmWriteLn(#9#9'DB'#9'"compiled by FPC '+version_string+'\0"');
  647.          AsmWriteLn(#9#9'DB'#9'"target: '+target_info.target_name+'\0"');
  648. {$endif EXTDEBUG}
  649.          WriteTree(datasegment);
  650.          WriteTree(consts);
  651.          AsmWriteLn('_DATA'#9#9'ENDS');
  652.  
  653.          AsmLn;
  654.          AsmWriteLn('_BSS'#9#9'SEGMENT'#9'DWORD PUBLIC USE32 ''BSS''');
  655.          WriteTree(bsssegment);
  656.          AsmWriteLn('_BSS'#9#9'ENDS');
  657.  
  658.          AsmLn;
  659.          AsmWriteLn(#9#9'END');
  660.       end;
  661. {$ifdef EXTDEBUG}
  662.       if assigned(current_module^.mainsource) then
  663.        comment(v_info,'Done writing intel-styled assembler output for '+current_module^.mainsource^);
  664. {$endif EXTDEBUG}
  665.    end;
  666.  
  667. end.
  668. {
  669.   $Log: ag386int.pas,v $
  670.   Revision 1.1.1.1.2.2  1998/05/25 23:00:22  carl
  671.     * call with ref bugfix with tasm target
  672.  
  673.   Revision 1.1.1.1.2.1  1998/04/08 11:38:43  peter
  674.     * nasm patches, pierres symtable patch
  675.  
  676.   Revision 1.1.1.1  1998/03/25 11:18:16  root
  677.   * Restored version
  678.  
  679.   Revision 1.1  1998/03/10 01:26:09  peter
  680.     + new uniform names
  681.  
  682.   Revision 1.18  1998/03/09 12:58:11  peter
  683.     * FWait warning is only showed for Go32V2 and $E+
  684.     * opcode tables moved to i386.pas/m68k.pas to reduce circular uses (and
  685.       for m68k the same tables are removed)
  686.     + $E for i386
  687.  
  688.   Revision 1.17  1998/03/06 00:52:23  peter
  689.     * replaced all old messages from errore.msg, only ExtDebug and some
  690.       Comment() calls are left
  691.     * fixed options.pas
  692.  
  693.   Revision 1.16  1998/03/02 01:48:41  peter
  694.     * renamed target_DOS to target_GO32V1
  695.     + new verbose system, merged old errors and verbose units into one new
  696.       verbose.pas, so errors.pas is obsolete
  697.  
  698.   Revision 1.15  1998/02/23 02:57:41  carl
  699.     * small bugfix when compiling $extdebug
  700.  
  701.   Revision 1.14  1998/02/15 21:16:20  peter
  702.     * all assembler outputs supported by assemblerobject
  703.     * cleanup with assembleroutputs, better .ascii generation
  704.     * help_constructor/destructor are now added to the externals
  705.     - generation of asmresponse is not outputformat depended
  706.  
  707.   Revision 1.13  1998/02/13 10:35:07  daniel
  708.   * Made Motorola version compilable.
  709.   * Fixed optimizer
  710.  
  711.   Revision 1.12  1998/02/12 17:19:07  florian
  712.     * fixed to get remake3 work, but needs additional fixes (output, I don't like
  713.       also that aktswitches isn't a pointer)
  714.  
  715.   Revision 1.11  1998/02/12 11:50:11  daniel
  716.   Yes! Finally! After three retries, my patch!
  717.  
  718.   Changes:
  719.  
  720.   Complete rewrite of psub.pas.
  721.   Added support for DLL's.
  722.   Compiler requires less memory.
  723.   Platform units for each platform.
  724.  
  725.   Revision 1.10  1997/12/13 18:59:48  florian
  726.   + I/O streams are now also declared as external, if neccessary
  727.   * -Aobj generates now a correct obj file via nasm
  728.  
  729.   Revision 1.9  1997/12/12 13:28:26  florian
  730.   + version 0.99.0
  731.   * all WASM options changed into MASM
  732.   + -O2 for Pentium II optimizations
  733.  
  734.   Revision 1.8  1997/12/09 13:45:10  carl
  735.   * bugfix of DT under nasm (not allowed if non integral - nasm v095)
  736.   + added pai_align --> useless here see file for more info
  737.   * bugfix of problems with in,out instructions under nasm
  738.   * bugfix of call under nasm (not fully tested though -- not sure)
  739.   * some range check errors removed (probably a few left though)
  740.   * bugfix of checking for extended type when emitting ':'
  741.  
  742.   Revision 1.7  1997/12/04 15:20:47  carl
  743.   * esthetic bugfix with extdebug on.
  744.  
  745.   Revision 1.6  1997/12/03 13:46:40  carl
  746.   * bugfix of my bug with near, now near in nasm mode for all non-rel8
  747.   instructions. (jcxz,jecxz still does not work thoug - assumed short now).
  748.  
  749.   Revision 1.5  1997/12/02 15:52:26  carl
  750.   * bugfix of string (again...) - would be sometimes invalid.
  751.   * bugfix of segment overrides under nasm.
  752.   - removed near in labeled instructions (would cause errors).
  753.  
  754.   Revision 1.4  1997/12/01 17:42:51  pierre
  755.      + added some more functionnality to the assembler parser
  756.  
  757.   Revision 1.3  1997/11/28 18:14:36  pierre
  758.    working version with several bug fixes
  759.  
  760.   Revision 1.2  1997/11/28 14:54:50  carl
  761.   + added popfd instruction.
  762.  
  763.   Revision 1.1.1.1  1997/11/27 08:32:57  michael
  764.   FPC Compiler CVS start
  765.  
  766.  
  767.   Pre-CVS log:
  768.  
  769.   CEC   Carl-Eric Codere
  770.   FK    Florian Klaempfl
  771.   PM    Pierre Muller
  772.   +     feature added
  773.   -     removed
  774.   *     bug fixed or changed
  775.  
  776.   History:
  777.  
  778.      9th october 1997:
  779.       * bugfix of string write, closing quotes would never be written. (CEC)
  780.     23 october 1997:
  781.       * fixed problem with writing strings of length = 0 (CEC).
  782.       + added line separation of long string chains. (CEC).
  783.     31st october 1997:
  784.       + completed the table of opcodes. (CEC)
  785.      3rd november 1997:
  786.       + MMX instructions added (FK)
  787.      9th november 1997:
  788.       * movsb represented the AT&T movsx - fixed, absolute values
  789.         in getreferencestring would be preceded by $ - fixed (CEC).
  790.  
  791.   What's to do:
  792.     o Fix problems regarding the segment names under NASM
  793.     o generate extern entries for typed constants and variables
  794.     o write lines numbers and file names to output file
  795.     o comments
  796. }
  797.