home *** CD-ROM | disk | FTP | other *** search
/ AmigActive 2 / AACD 2.iso / AACD / Programming / fpc / compiler / ag68kmot.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1998-09-24  |  21.8 KB  |  510 lines
  1. {
  2.     $Id: ag68kmot.pas,v 1.1.1.1.2.3 1998/09/14 18:56:26 carl Exp $
  3.     Copyright (c) 1998 by the FPC development team
  4.  
  5.     This unit implements an asmoutput class for MOTOROLA syntax with
  6.     Motorola 68000 (recognized by the Amiga Assembler and Charlie Gibbs's
  7.     A68k)
  8.  
  9.     This program is free software; you can redistribute it and/or modify
  10.     it under the terms of the GNU General Public License as published by
  11.     the Free Software Foundation; either version 2 of the License, or
  12.     (at your option) any later version.
  13.  
  14.     This program is distributed in the hope that it will be useful,
  15.     but WITHOUT ANY WARRANTY; without even the implied warranty of
  16.     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  17.     GNU General Public License for more details.
  18.  
  19.     You should have received a copy of the GNU General Public License
  20.     along with this program; if not, write to the Free Software
  21.     Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  22.  
  23.  ****************************************************************************
  24. }
  25. unit ag68kmot;
  26.  
  27.     interface
  28.  
  29.     uses aasm,assemble;
  30.  
  31.     type
  32.       pm68kmotasmlist=^tm68kmotasmlist;
  33.       tm68kmotasmlist = object(tasmlist)
  34.         procedure WriteTree(p:paasmoutput);virtual;
  35.         procedure WriteAsmList;virtual;
  36.       end;
  37.  
  38.   implementation
  39.  
  40.     uses
  41.       dos,globals,systems,cobjects,m68k,
  42.       strings,files,verbose
  43. {$ifdef GDB}
  44.       ,gdb
  45. {$endif GDB}
  46.       ;
  47.  
  48.     const
  49.       line_length = 70;
  50.  
  51.     function getreferencestring(const ref : treference) : string;
  52.       var
  53.          s : string;
  54.       begin
  55.          s:='';
  56.          if ref.isintvalue then
  57.              s:='#'+tostr(ref.offset)
  58.          else
  59.            with ref do
  60.              begin
  61.                  if (index=R_NO) and (base=R_NO) and (direction=dir_none) then
  62.                    begin
  63.                      if assigned(symbol) then
  64.                        begin
  65.                          s:=s+symbol^;
  66.                          if offset<0 then
  67.                            s:=s+tostr(offset)
  68.                          else
  69.                          if (offset>0) then
  70.                            s:=s+'+'+tostr(offset);
  71.                        end
  72.                      else
  73.                        begin
  74.                        { direct memory addressing }
  75.                          s:=s+'('+tostr(offset)+').l';
  76.                        end;
  77.                    end
  78.                  else
  79.                    begin
  80.                      if assigned(symbol) then
  81.                        s:=s+symbol^;
  82.                      if offset<0 then
  83.                        s:=s+tostr(offset)
  84.                      else
  85.                      if (offset>0) then
  86.                        begin
  87.                          if (symbol=nil) then s:=tostr(offset)
  88.                          else s:=s+'+'+tostr(offset);
  89.                        end;
  90.                      if (index<>R_NO) and (base=R_NO) and (direction=dir_none) then
  91.                        begin
  92.                          if (scalefactor = 1) or (scalefactor = 0) then
  93.                            begin
  94.                              if offset = 0 then
  95.                                s:=s+'0(,'+mot_reg2str[index]+'.l)'
  96.                              else
  97.                                s:=s+'(,'+mot_reg2str[index]+'.l)';
  98.                            end
  99.                          else
  100.                            begin
  101.                              if offset = 0 then
  102.                                s:=s+'0(,'+mot_reg2str[index]+'.l*'+tostr(scalefactor)+')'
  103.                              else
  104.                                s:=s+'(,'+mot_reg2str[index]+'.l*'+tostr(scalefactor)+')';
  105.                            end
  106.                        end
  107.                      else
  108.                      if (index=R_NO) and (base<>R_NO) and (direction=dir_inc) then
  109.                        begin
  110.                          if (scalefactor = 1) or (scalefactor = 0) then
  111.                            s:=s+'('+mot_reg2str[base]+')+'
  112.                          else
  113.                            InternalError(10002);
  114.                        end
  115.                      else
  116.                      if (index=R_NO) and (base<>R_NO) and (direction=dir_dec) then
  117.                        begin
  118.                          if (scalefactor = 1) or (scalefactor = 0) then
  119.                            s:=s+'-('+mot_reg2str[base]+')'
  120.                          else
  121.                            InternalError(10003);
  122.                        end
  123.                      else
  124.                      if (index=R_NO) and (base<>R_NO) and (direction=dir_none) then
  125.                        begin
  126.                          s:=s+'('+mot_reg2str[base]+')';
  127.                        end
  128.                      else
  129.                      if (index<>R_NO) and (base<>R_NO) and (direction=dir_none) then
  130.                        begin
  131.                          if (scalefactor = 1) or (scalefactor = 0) then
  132.                            begin
  133.                              if offset = 0 then
  134.                                s:=s+'0('+mot_reg2str[base]+','+mot_reg2str[index]+'.l)'
  135.                              else
  136.                                s:=s+'('+mot_reg2str[base]+','+mot_reg2str[index]+'.l)';
  137.                            end
  138.                          else
  139.                           begin
  140.                             if offset = 0 then
  141.                               s:=s+'0('+mot_reg2str[base]+','+mot_reg2str[index]+'.l*'+tostr(scalefactor)+')'
  142.                             else
  143.                               s:=s+'('+mot_reg2str[base]+','+mot_reg2str[index]+'.l*'+tostr(scalefactor)+')';
  144.                           end
  145.                        end
  146.       { if this is not a symbol, and is not in the above, then there is an error }
  147.                      else
  148.                      if NOT assigned(symbol) then
  149.                        InternalError(10004);
  150.                    end; { endif }
  151.             end; { end with }
  152.          getreferencestring:=s;
  153.       end;
  154.  
  155.  
  156.     function getopstr(t : byte;o : pointer) : string;
  157.      var
  158.       hs : string;
  159.       i: tregister;
  160.     begin
  161.       case t of
  162.        top_reg : getopstr:=mot_reg2str[tregister(o)];
  163.          top_reglist: begin
  164.                       hs:='';
  165.                       for i:=R_NO to R_FPSR do
  166.                       begin
  167.                         if i in tregisterlist(o^) then
  168.                          hs:=hs+mot_reg2str[i]+'/';
  169.                       end;
  170.                       delete(hs,length(hs),1);
  171.                       getopstr := hs;
  172.                     end;
  173.        top_ref : getopstr:=getreferencestring(preference(o)^);
  174.        top_const : getopstr:='#'+tostr(longint(o));
  175.        top_symbol : begin
  176.              { compare with i386 version, where this is a constant. }
  177.              hs[0]:=chr(strlen(pchar(pcsymbol(o)^.symbol)));
  178.                      move(pchar(pcsymbol(o)^.symbol)^,hs[1],byte(hs[0]));
  179. {                     inc(byte(hs[0]));}
  180. {                     hs[1]:='#';}
  181.                      if pcsymbol(o)^.offset>0 then
  182.                        hs:=hs+'+'+tostr(pcsymbol(o)^.offset)
  183.                      else if pcsymbol(o)^.offset<0 then
  184.                        hs:=hs+tostr(pcsymbol(o)^.offset);
  185.                      getopstr:=hs;
  186.                    end;
  187.          else internalerror(10001);
  188.        end;
  189.      end;
  190.  
  191.  
  192.    function getopstr_jmp(t : byte;o : pointer) : string;
  193.      var
  194.        hs : string;
  195.      begin
  196.        case t of
  197.          top_reg : getopstr_jmp:=mot_reg2str[tregister(o)];
  198.          top_ref : getopstr_jmp:=getreferencestring(preference(o)^);
  199.          top_const : getopstr_jmp:=tostr(longint(o));
  200.          top_symbol : begin
  201.                      hs[0]:=chr(strlen(pchar(pcsymbol(o)^.symbol)));
  202.                      move(pchar(pcsymbol(o)^.symbol)^,hs[1],byte(hs[0]));
  203.                      if pcsymbol(o)^.offset>0 then
  204.                        hs:=hs+'+'+tostr(pcsymbol(o)^.offset)
  205.                      else if pcsymbol(o)^.offset<0 then
  206.                        hs:=hs+tostr(pcsymbol(o)^.offset);
  207.                      getopstr_jmp:=hs;
  208.                    end;
  209.          else internalerror(10001);
  210.        end;
  211.      end;
  212.  
  213. {****************************************************************************
  214.                               TM68KMOTASMLIST
  215.  ****************************************************************************}
  216.  
  217.     procedure tm68kmotasmlist.WriteTree(p:paasmoutput);
  218.     var
  219.       hp        : pai;
  220.       s         : string;
  221.       counter,
  222.       i,j,lines : longint;
  223.       quoted    : boolean;
  224.     begin
  225.       hp:=pai(p^.first);
  226.       while assigned(hp) do
  227.        begin
  228.          case hp^.typ of
  229.        ait_comment : ;
  230.          ait_align : AsmWriteLn(#9'CNOP 0,'+tostr(pai_align(hp)^.aligntype));
  231.       ait_external : AsmWriteLn(#9'XREF'#9+StrPas(pai_external(hp)^.name));
  232.  ait_real_extended : Message(assem_e_extended_not_supported);
  233.           ait_comp : Message(assem_e_comp_not_supported);
  234.      ait_datablock : begin
  235.                        { ------------------------------------------------------- }
  236.                        { ----------- ALIGNMENT FOR ANY NON-BYTE VALUE ---------- }
  237.                        { ------------- REQUIREMENT FOR 680x0 ------------------- }
  238.                        { ------------------------------------------------------- }
  239.                        if pai_datablock(hp)^.size <> 1 then
  240.                         begin
  241.                           if not(cs_littlesize in aktswitches) then
  242.                            AsmWriteLn(#9'CNOP 0,4')
  243.                           else
  244.                            AsmWriteLn(#9'CNOP 0,2');
  245.                          end;
  246.                        if pai_datablock(hp)^.is_global then
  247.                         AsmWriteLn(#9'XDEF'#9+StrPas(pai_datablock(hp)^.name));
  248.                        AsmWriteLn(StrPas(pai_datablock(hp)^.name)+#9#9'DS.B '+tostr(pai_datablock(hp)^.size));
  249.                      end;
  250.    ait_const_32bit : Begin
  251.                        AsmWriteLn(#9#9'DC.L'#9+tostr(pai_const(hp)^.value));
  252.                      end;
  253.    ait_const_16bit : Begin
  254.                        AsmWriteLn(#9#9'DC.W'#9+tostr(pai_const(hp)^.value));
  255.                      end;
  256.     ait_const_8bit : AsmWriteLn(#9#9'DC.B'#9+tostr(pai_const(hp)^.value));
  257.   ait_const_symbol : Begin
  258.                        AsmWriteLn(#9#9+'DC.L '#9+StrPas(pchar(pai_const(hp)^.value)));
  259.                      end;
  260.     ait_real_64bit : Begin
  261.                        AsmWriteLn(#9#9'DC.D'#9+double2str(pai_double(hp)^.value));
  262.                      end;
  263.     ait_real_32bit : Begin
  264.                        AsmWriteLn(#9#9'DC.S'#9+double2str(pai_single(hp)^.value));
  265.                      end;
  266. { TO SUPPORT SOONER OR LATER!!!
  267.     ait_comp       : AsmWriteLn(#9#9'DC.D'#9+comp2str(pai_extended(hp)^.value));}
  268.         ait_string : begin
  269.                        counter := 0;
  270.                        lines := pai_string(hp)^.len div line_length;
  271.                        { separate lines in different parts }
  272.                        if pai_string(hp)^.len > 0 then
  273.                        Begin
  274.                          for j := 0 to lines-1 do
  275.                            begin
  276.                               AsmWrite(#9#9'DC.B'#9);
  277.                               quoted:=false;
  278.                               for i:=counter to counter+line_length do
  279.                                  begin
  280.                                    { it is an ascii character. }
  281.                                    if (ord(pai_string(hp)^.str[i])>31) and
  282.                                       (ord(pai_string(hp)^.str[i])<128) and
  283.                                       (pai_string(hp)^.str[i]<>'"') then
  284.                                    begin
  285.                                      if not(quoted) then
  286.                                      begin
  287.                                        if i>counter then
  288.                                          AsmWrite(',');
  289.                                        AsmWrite('"');
  290.                                      end;
  291.                                      AsmWrite(pai_string(hp)^.str[i]);
  292.                                      quoted:=true;
  293.                                    end { if > 31 and < 128 and ord('"') }
  294.                                    else
  295.                                    begin
  296.                                      if quoted then
  297.                                        AsmWrite('"');
  298.                                      if i>counter then
  299.                                        AsmWrite(',');
  300.                                      quoted:=false;
  301.                                      AsmWrite(tostr(ord(pai_string(hp)^.str[i])));
  302.                                    end;
  303.                                 end; { end for i:=0 to... }
  304.                                 if quoted then AsmWrite('"');
  305.                                 AsmWrite(target_info.newline);
  306.                                 counter := counter+line_length;
  307.                                end; { end for j:=0 ... }
  308.                                { do last line of lines }
  309.                                AsmWrite(#9#9'DC.B'#9);
  310.                                quoted:=false;
  311.                                for i:=counter to pai_string(hp)^.len-1 do
  312.                                begin
  313.                                  { it is an ascii character. }
  314.                                  if (ord(pai_string(hp)^.str[i])>31) and
  315.                                     (ord(pai_string(hp)^.str[i])<128) and
  316.                                     (pai_string(hp)^.str[i]<>'"') then
  317.                                  begin
  318.                                    if not(quoted) then
  319.                                    begin
  320.                                      if i>counter then
  321.                                        AsmWrite(',');
  322.                                      AsmWrite('"');
  323.                                    end;
  324.                                  AsmWrite(pai_string(hp)^.str[i]);
  325.                                    quoted:=true;
  326.                                  end { if > 31 and < 128 and " }
  327.                                  else
  328.                                  begin
  329.                                    if quoted then
  330.                                      AsmWrite('"');
  331.                                      if i>counter then
  332.                                        AsmWrite(',');
  333.                                      quoted:=false;
  334.                                      AsmWrite(tostr(ord(pai_string(hp)^.str[i])));
  335.                                  end;
  336.                                end; { end for i:=0 to... }
  337.                              if quoted then AsmWrite('"');
  338.                           end; { endif }
  339.                         AsmLn;
  340.                       end;
  341.           ait_label : begin
  342.                        if assigned(hp^.next) and (pai(hp^.next)^.typ in
  343.                           [ait_const_32bit,ait_const_16bit,ait_const_8bit,ait_const_symbol,
  344.                            ait_real_64bit,ait_real_32bit,ait_string]) then
  345.                         begin
  346.                           if not(cs_littlesize in aktswitches) then
  347.                            AsmWriteLn(#9'CNOP 0,4')
  348.                           else
  349.                            AsmWriteLn(#9'CNOP 0,2');
  350.                         end;
  351.                         AsmWrite(lab2str(pai_label(hp)^.l));
  352.                         if assigned(hp^.next) and not(pai(hp^.next)^.typ in
  353.                            [ait_const_32bit,ait_const_16bit,ait_const_8bit,ait_const_symbol,
  354.                             ait_real_64bit,ait_string]) then
  355.                          AsmWriteLn(':');
  356.                       end;
  357.          ait_direct : begin
  358.                         AsmWritePChar(pai_direct(hp)^.str);
  359.                         AsmLn;
  360.                       end;
  361. ait_labeled_instruction :
  362.                       Begin
  363.                       { labeled operand }
  364.                         if pai_labeled(hp)^._op1 = R_NO then
  365.                          AsmWriteLn(#9+mot_op2str[pai_labeled(hp)^._operator]+#9+lab2str(pai_labeled(hp)^.lab))
  366.                         else
  367.                       { labeled operand with register }
  368.                          AsmWriteLn(#9+mot_op2str[pai_labeled(hp)^._operator]+#9+
  369.                                     reg2str(pai_labeled(hp)^._op1)+','+lab2str(pai_labeled(hp)^.lab))
  370.                      end;
  371.         ait_symbol : begin
  372.                        { ------------------------------------------------------- }
  373.                        { ----------- ALIGNMENT FOR ANY NON-BYTE VALUE ---------- }
  374.                        { ------------- REQUIREMENT FOR 680x0 ------------------- }
  375.                        { ------------------------------------------------------- }
  376.                        if assigned(hp^.next) and (pai(hp^.next)^.typ in
  377.                           [ait_const_32bit,ait_const_16bit,ait_const_8bit,ait_const_symbol,
  378.                            ait_real_64bit,ait_real_32bit,ait_string]) then
  379.                         begin
  380.                           if not(cs_littlesize in aktswitches) then
  381.                            AsmWriteLn(#9'CNOP 0,4')
  382.                           else
  383.                            AsmWriteLn(#9'CNOP 0,2');
  384.                         end;
  385.                        if pai_symbol(hp)^.is_global then
  386.                         AsmWriteLn(#9'XDEF '+StrPas(pai_symbol(hp)^.name));
  387.                        AsmWritePChar(pai_symbol(hp)^.name);
  388.                        if assigned(hp^.next) and not(pai(hp^.next)^.typ in
  389.                           [ait_const_32bit,ait_const_16bit,ait_const_8bit,ait_const_symbol,
  390.                            ait_real_64bit,ait_string,ait_real_32bit]) then
  391.                         AsmWriteLn(':');
  392.                      end;
  393.    ait_instruction : begin
  394.                        s:=#9+mot_op2str[pai68k(hp)^._operator]+mot_opsize2str[pai68k(hp)^.size];
  395.                        if pai68k(hp)^.op1t<>top_none then
  396.                         begin
  397.                         { call and jmp need an extra handling                          }
  398.                         { this code is only called if jmp isn't a labeled instruction }
  399.                           if pai68k(hp)^._operator in [A_JSR,A_JMP] then
  400.                            s:=s+#9+getopstr_jmp(pai68k(hp)^.op1t,pai68k(hp)^.op1)
  401.                           else
  402.                            begin
  403.                              if pai68k(hp)^.op1t = top_reglist then
  404.                               s:=s+#9+getopstr(pai68k(hp)^.op1t,@(pai68k(hp)^.reglist))
  405.                              else
  406.                               s:=s+#9+getopstr(pai68k(hp)^.op1t,pai68k(hp)^.op1);
  407.                              if pai68k(hp)^.op2t<>top_none then
  408.                               begin
  409.                                 if pai68k(hp)^.op2t = top_reglist then
  410.                                  s:=s+','+getopstr(pai68k(hp)^.op2t,@pai68k(hp)^.reglist)
  411.                                 else
  412.                                  s:=s+','+getopstr(pai68k(hp)^.op2t,pai68k(hp)^.op2);
  413.                              { three operands }
  414.                                 if pai68k(hp)^.op3t<>top_none then
  415.                                  begin
  416.                                    if (pai68k(hp)^._operator = A_DIVSL) or
  417.                                       (pai68k(hp)^._operator = A_DIVUL) or
  418.                                       (pai68k(hp)^._operator = A_MULU) or
  419.                                       (pai68k(hp)^._operator = A_MULS) or
  420.                                       (pai68k(hp)^._operator = A_DIVS) or
  421.                                       (pai68k(hp)^._operator = A_DIVU) then
  422.                                     s:=s+':'+getopstr(pai68k(hp)^.op3t,pai68k(hp)^.op3)
  423.                                    else
  424.                                     s:=s+','+getopstr(pai68k(hp)^.op3t,pai68k(hp)^.op3);
  425.                                  end;
  426.                               end;
  427.                            end;
  428.                         end;
  429.                        AsmWriteLn(s);
  430.                      end;
  431. {$ifdef GDB}
  432.               ait_stabn,
  433.               ait_stabs,
  434.  ait_stab_function_name : ;
  435. {$endif GDB}
  436.          else
  437.           internalerror(10000);
  438.          end;
  439. {         if ((hp^.typ<>ait_label) and (hp^.typ<>ait_symbol)) or (assigned(hp^.next) and not(pai(hp^.next)^.typ in
  440.       [ait_const_32bit,ait_const_16bit,ait_const_8bit,ait_const_symbol,
  441.        ait_real_64bit,ait_string])) then
  442.          AsmLn}
  443.          hp:=pai(hp^.next);
  444.        end;
  445.     end;
  446.  
  447.     procedure tm68kmotasmlist.WriteAsmList;
  448.     begin
  449. {$ifdef EXTDEBUG}
  450.       if assigned(current_module^.mainsource) then
  451.        comment(v_info,'Start writing motorola-styled assembler output for '+current_module^.mainsource^);
  452. {$endif}
  453.       WriteTree(externals);
  454.  
  455.       AsmLn;
  456.       AsmWriteLn(#9'SECTION _CODE,CODE');
  457.       WriteTree(codesegment);
  458.  
  459.       AsmLn;
  460.       AsmWriteLn(#9'SECTION _DATA,DATA');
  461.     { write a signature to the file }
  462.       AsmWriteLn(#9'CNOP 0,4');
  463. {$ifdef EXTDEBUG}
  464.       AsmWriteLn(#9'DC.B'#9'"compiled by FPC '+version_string+'\0"');
  465.       AsmWriteLn(#9'DC.B'#9'"target: '+target_info.target_name+'\0"');
  466. {$endif EXTDEBUG}
  467.       WriteTree(datasegment);
  468.       WriteTree(consts);
  469.  
  470.       AsmLn;
  471.       AsmWriteLn(#9'SECTION _BSS,BSS');
  472.       WriteTree(bsssegment);
  473.  
  474.       AsmLn;
  475.       AsmWriteLn(#9'END');
  476. {$ifdef EXTDEBUG}
  477.       if assigned(current_module^.mainsource) then
  478.        comment(v_info,'Done writing motorola-styled assembler output for '+current_module^.mainsource^);
  479. {$endif}
  480.     end;
  481.  
  482. end.
  483. {
  484.   $Log: ag68kmot.pas,v $
  485.   Revision 1.1.1.1.2.3  1998/09/14 18:56:26  carl
  486.     * alignment bugfix for bytes
  487.  
  488.   Revision 1.1.1.1.2.2  1998/07/01 13:58:25  carl
  489.    ?
  490.  
  491.   Revision 1.1.1.1  1998/03/25 11:18:16  root
  492.   * Restored version
  493.  
  494.   Revision 1.3  1998/03/22 12:45:37  florian
  495.     * changes of Carl-Eric to m68k target commit:
  496.       - wrong nodes because of the new string cg in intel, I had to create
  497.         this under m68k also ... had to work it out to fix potential alignment
  498.         problems --> this removes the crash of the m68k compiler.
  499.       - added absolute addressing in m68k assembler (required for Amiga startup)
  500.       - fixed alignment problems (because of byte return values, alignment
  501.         would not be always valid) -- is this ok if i change the offset if odd in
  502.         setfirsttemp ?? -- it seems ok...
  503.  
  504.   Revision 1.2  1998/03/10 04:23:33  carl
  505.     - removed in because can cause range check errors under BP
  506.  
  507.   Revision 1.1  1998/03/10 01:26:10  peter
  508.     + new uniform names
  509.  
  510. }