Browse Source

- remove some unused files in m68k directory

carl 23 years ago
parent
commit
63ed5b6f99
3 changed files with 0 additions and 1820 deletions
  1. 0 679
      compiler/m68k/ag68kmit.pas
  2. 0 551
      compiler/m68k/ag68kmot.pas
  3. 0 590
      compiler/m68k/ag68kmpw.pas

+ 0 - 679
compiler/m68k/ag68kmit.pas

@@ -1,679 +0,0 @@
-{
-    $Id$
-    Copyright (c) 1998-2000 by Florian Klaempfl
-
-    This unit implements an asmoutput class for MIT syntax with
-    Motorola 68000 (for MIT syntax TEST WITH GAS v1.34)
-
-    This program is free software; you can redistribute it and/or modify
-    it under the terms of the GNU General Public License as published by
-    the Free Software Foundation; either version 2 of the License, or
-    (at your option) any later version.
-
-    This program is distributed in the hope that it will be useful,
-    but WITHOUT ANY WARRANTY; without even the implied warranty of
-    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-    GNU General Public License for more details.
-
-    You should have received a copy of the GNU General Public License
-    along with this program; if not, write to the Free Software
-    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
-
- ****************************************************************************
-
-  What's to do:
-    o Verify if this actually work as indirect mode with name of variables
-    o write lines numbers and file names to output file
-    o generate debugging informations
-}
-
-unit ag68kmit;
-
-    interface
-
-    uses aasm,assemble;
-
-    type
-      pm68kmitasmlist=^tm68kmitasmlist;
-      tm68kmitasmlist = object(tasmlist)
-        procedure WriteTree(p:paasmoutput);virtual;
-        procedure WriteAsmList;virtual;
-      end;
-
-   implementation
-
-    uses
-      globtype,systems,
-      dos,globals,cobjects,cpubase,
-      strings,files,verbose
-{$ifdef GDB}
-      ,gdb
-{$endif GDB}
-      ;
-
-    const
-      line_length = 70;
-
-    var
-{$ifdef GDB}
-      n_line       : byte;     { different types of source lines }
-      linecount,
-      includecount : longint;
-      funcname     : pchar;
-      stabslastfileinfo : tfileposinfo;
-{$endif}
-      lastsec    : tsection; { last section type written }
-      lastsecidx,
-      lastfileindex,
-      lastline   : longint;
-
-
-    function double2str(d : double) : string;
-      var
-         hs : string;
-      begin
-         str(d,hs);
-      { replace space with + }
-         if hs[1]=' ' then
-          hs[1]:='+';
-         double2str:=hs;
-      end;
-
-
-(* TO SUPPORT SOONER OR LATER!!!
-    function comp2str(d : bestreal) : string;
-      type
-        pdouble = ^double;
-      var
-        c  : comp;
-        dd : pdouble;
-      begin
-      {$ifdef TP}
-         c:=d;
-      {$else}
-         c:=comp(d);
-      {$endif}
-         dd:=pdouble(@c); { this makes a bitwise copy of c into a double }
-         comp2str:=double2str(dd^);
-      end; *)
-
-
-    function getreferencestring(const ref : treference) : string;
-      var
-         s : string;
-      begin
-         s:='';
-         if ref.isintvalue then
-             s:='#'+tostr(ref.offset)
-         else
-           with ref do
-             begin
-                  { symbol and offset }
-                  if (assigned(symbol)) and (offset<>0) then
-                    Begin
-                      s:=s+'('+tostr(offset)+symbol^;
-                    end
-                  else
-                  { symbol only }
-                  if (assigned(symbol)) and (offset=0) then
-                    Begin
-                      s:=s+'('+symbol^;
-                    end
-                  else
-                  { offset only }
-                  if (symbol=nil) and (offset<>0) then
-                    Begin
-                      s:=s+'('+tostr(offset);
-                    end
-                  else
-                  { NOTHING - put zero as offset }
-                  if (symbol=nil) and (offset=0) then
-                    Begin
-                      s:=s+'('+'0';
-                    end
-                  else
-                   InternalError(10004);
-                  if (index<>R_NO) and (base=R_NO) and (direction=dir_none) then
-                   InternalError(10004)
-                else if (index=R_NO) and (base<>R_NO) and (direction=dir_inc) then
-                begin
-                  if (scalefactor = 1) or (scalefactor = 0) then
-                    Begin
-                      if offset<>0 then
-                        s:=mit_reg2str[base]+'@+'+s+')'
-                      else
-                        s:=mit_reg2str[base]+'@+';
-                    end
-                  else
-                   InternalError(10002);
-                end
-                else if (index=R_NO) and (base<>R_NO) and (direction=dir_dec) then
-                begin
-                  if (scalefactor = 1) or (scalefactor = 0) then
-                    Begin
-                      if offset<>0 then
-                         s:=mit_reg2str[base]+'@-'+s+')'
-                      else
-                         s:=mit_reg2str[base]+'@-';
-                    end
-                  else
-                   InternalError(10003);
-                end
-              else if (index=R_NO) and (base<>R_NO) and (direction=dir_none) then
-                begin
-                  if (offset=0) and (symbol=nil) then
-                     s:=mit_reg2str[base]+'@'
-                  else
-                     s:=mit_reg2str[base]+'@'+s+')';
-                end
-              else if (index<>R_NO) and (base<>R_NO) and (direction=dir_none) then
-                begin
-                  s:=mit_reg2str[base]+'@'+s+','+mit_reg2str[index]+':L';
-                  if (scalefactor = 1) or (scalefactor = 0) then
-                      s:=s+')'
-                  else
-                     s:=s+':'+tostr(scalefactor)+')';
-                end
-                else
-                if assigned(symbol) then
-                Begin
-                   s:=symbol^;
-                   if offset<>0 then
-                     s:=s+'+'+tostr(offset);
-                end
-                { this must be a physical address }
-                else
-                  s:=s+')';
-{                else if NOT assigned(symbol) then
-                  InternalError(10004);}
-            end; { end with }
-         getreferencestring:=s;
-      end;
-
-
-    function getopstr(t : byte;o : pointer) : string;
-      var
-         hs : string;
-         i: tregister;
-      begin
-         case t of
-            top_reg : getopstr:=mit_reg2str[tregister(o)];
-               top_ref : getopstr:=getreferencestring(preference(o)^);
-         top_reglist: begin
-                      hs:='';
-                      for i:=R_NO to R_FPSR do
-                      begin
-                        if i in tregisterlist(o^) then
-                         hs:=hs+mit_reg2str[i]+'/';
-                      end;
-                      delete(hs,length(hs),1);
-                      getopstr := hs;
-                    end;
-             top_const : getopstr:='#'+tostr(longint(o));
-            top_symbol :
-                    { compare with i386, where a symbol is considered }
-                    { a constant.                                     }
-                    begin
-                     hs[0]:=chr(strlen(pchar(pcsymbol(o)^.symbol)));
-                            move(pchar(pcsymbol(o)^.symbol)^,hs[1],byte(hs[0]));
-{                           inc(byte(hs[0]));}
-                            if pcsymbol(o)^.offset>0 then
-                              hs:=hs+'+'+tostr(pcsymbol(o)^.offset)
-                            else if pcsymbol(o)^.offset<0 then
-                              hs:=hs+tostr(pcsymbol(o)^.offset);
-                            getopstr:=hs;
-                         end;
-            else internalerror(10001);
-         end;
-      end;
-
-
-    function getopstr_jmp(t : byte;o : pointer) : string;
-      var
-         hs : string;
-      begin
-         case t of
-            top_reg : getopstr_jmp:=mit_reg2str[tregister(o)];
-            top_ref : getopstr_jmp:=getreferencestring(preference(o)^);
-            top_const : getopstr_jmp:=tostr(longint(o));
-            top_symbol : begin
-                            hs[0]:=chr(strlen(pchar(pcsymbol(o)^.symbol)));
-                            move(pchar(pcsymbol(o)^.symbol)^,hs[1],byte(hs[0]));
-                            if pcsymbol(o)^.offset>0 then
-                              hs:=hs+'+'+tostr(pcsymbol(o)^.offset)
-                            else if pcsymbol(o)^.offset<0 then
-                              hs:=hs+tostr(pcsymbol(o)^.offset);
-                            getopstr_jmp:=hs;
-                         end;
-            else internalerror(10001);
-         end;
-      end;
-
-
-{****************************************************************************
-                             T68kGASASMOUTPUT
- ****************************************************************************}
-
-    const
-      ait_const2str:array[ait_const_32bit..ait_const_8bit] of string[8]=
-        (#9'.long'#9,#9'.short'#9,#9'.byte'#9);
-
-      ait_section2str : array[tsection] of string[8]=
-       ('','.text','.data','.bss',
-        '.stab','.stabstr',
-        '.idata2','.idata4','.idata5','.idata6','.idata7',
-        '.edata','');
-
-    procedure tm68kmitasmlist.WriteTree(p:paasmoutput);
-    var
-      hp        : pai;
-      ch        : char;
-      consttyp  : tait;
-      s         : string;
-      pos,l,i   : longint;
-      found     : boolean;
-{$ifdef GDB}
-      curr_n    : byte;
-      infile    : pinputfile;
-      funcname  : pchar;
-      linecount : longint;
-{$endif GDB}
-    begin
-      if not assigned(p) then
-       exit;
-{$ifdef GDB}
-      funcname:=nil;
-      linecount:=1;
-{$endif GDB}
-      hp:=pai(p^.first);
-      while assigned(hp) do
-       begin
-       { write debugger informations }
-{$ifdef GDB}
-         if ((cs_debuginfo in aktmoduleswitches) or
-            (cs_gdb_lineinfo in aktglobalswitches)) then
-          begin
-            if not (hp^.typ in  [ait_external,ait_regalloc, ait_regdealloc,ait_stabn,ait_stabs,
-                    ait_label,ait_cut,ait_marker,ait_align,ait_stab_function_name]) then
-             begin
-             { file changed ? (must be before line info) }
-               if lastfileindex<>hp^.fileinfo.fileindex then
-                begin
-                  infile:=current_module^.sourcefiles^.get_file(hp^.fileinfo.fileindex);
-                  if includecount=0 then
-                   curr_n:=n_sourcefile
-                  else
-                   curr_n:=n_includefile;
-                  if (infile^.path^<>'') then
-                   begin
-                     AsmWriteLn(#9'.stabs "'+lower(BsToSlash(FixPath(infile^.path^,false)))+'",'+
-                       tostr(curr_n)+',0,0,'+'Ltext'+ToStr(IncludeCount));
-                   end;
-                  AsmWriteLn(#9'.stabs "'+lower(FixFileName(infile^.name^))+'",'+
-                    tostr(curr_n)+',0,0,'+'Ltext'+ToStr(IncludeCount));
-                  AsmWriteLn('Ltext'+ToStr(IncludeCount)+':');
-                  inc(includecount);
-                  lastfileindex:=hp^.fileinfo.fileindex;
-                end;
-             { line changed ? }
-               if (hp^.fileinfo.line<>lastline) and (hp^.fileinfo.line<>0) then
-                begin
-                  if (n_line=n_textline) and assigned(funcname) and
-                     (target_os.use_function_relative_addresses) then
-                   begin
-                     AsmWriteLn(target_asm.labelprefix+'l'+tostr(linecount)+':');
-                     AsmWrite(#9'.stabn '+tostr(n_line)+',0,'+tostr(hp^.fileinfo.line)+','+
-                                target_asm.labelprefix+'l'+tostr(linecount)+' - ');
-                     AsmWritePChar(FuncName);
-                     AsmLn;
-                     inc(linecount);
-                   end
-                  else
-                   AsmWriteLn(#9'.stabd'#9+tostr(n_line)+',0,'+tostr(hp^.fileinfo.line));
-                  lastline:=hp^.fileinfo.line;
-                end;
-             end;
-          end;
-{$endif GDB}
-         case hp^.typ of
-      ait_external : ; { external is ignored }
-       ait_comment : Begin
-                       AsmWrite(target_asm.comment);
-                       AsmWritePChar(pai_asm_comment(hp)^.str);
-                       AsmLn;
-                     End;
-{$ifdef DREGALLOC}
-      ait_regalloc : AsmWriteLn(target_asm.comment+'Register '+att_reg2str[pairegalloc(hp)^.reg]+' allocated');
-    ait_regdealloc : AsmWriteLn(target_asm.comment+'Register '+att_reg2str[pairegalloc(hp)^.reg]+' released');
-{$endif DREGALLOC}
-         ait_align : AsmWriteLn(#9'.align '+tostr(pai_align(hp)^.aligntype));
-       ait_section : begin
-                       if pai_section(hp)^.sec<>sec_none then
-                        begin
-                          AsmLn;
-                          AsmWrite(ait_section2str[pai_section(hp)^.sec]);
-                          if pai_section(hp)^.idataidx>0 then
-                           AsmWrite('$'+tostr(pai_section(hp)^.idataidx));
-                          AsmLn;
-{$ifdef GDB}
-                          case pai_section(hp)^.sec of
-                           sec_code : n_line:=n_textline;
-                           sec_data : n_line:=n_dataline;
-                            sec_bss : n_line:=n_bssline;
-                          end;
-{$endif GDB}
-                        end;
-                       LastSec:=pai_section(hp)^.sec;
-                     end;
-     ait_datablock : begin
-                       { ------------------------------------------------------- }
-                       { ----------- ALIGNMENT FOR ANY NON-BYTE VALUE ---------- }
-                       { ------------- REQUIREMENT FOR 680x0 ------------------- }
-                       { ------------------------------------------------------- }
-                       if pai_datablock(hp)^.size <> 1 then
-                        begin
-                          if not(cs_littlesize in aktglobalswitches) then
-                           AsmWriteLn(#9#9'.align 4')
-                          else
-                           AsmWriteLn(#9#9'.align 2');
-                        end;
-                       if pai_datablock(hp)^.is_global then
-                        AsmWrite(#9'.comm'#9)
-                       else
-                        AsmWrite(#9'.lcomm'#9);
-                       AsmWriteLn(StrPas(pai_datablock(hp)^.name)+','+tostr(pai_datablock(hp)^.size));
-                     end;
-   ait_const_32bit, { alignment is required for 16/32 bit data! }
-   ait_const_16bit:  begin
-                       AsmWrite(ait_const2str[hp^.typ]+tostr(pai_const(hp)^.value));
-                       consttyp:=hp^.typ;
-                       l:=0;
-                       repeat
-                         found:=(not (Pai(hp^.next)=nil)) and (Pai(hp^.next)^.typ=consttyp);
-                         if found then
-                          begin
-                            hp:=Pai(hp^.next);
-                            s:=','+tostr(pai_const(hp)^.value);
-                            AsmWrite(s);
-                            inc(l,length(s));
-                          end;
-                       until (not found) or (l>line_length);
-                       AsmLn;
-                     end;
-    ait_const_8bit : begin
-                       AsmWrite(ait_const2str[hp^.typ]+tostr(pai_const(hp)^.value));
-                       consttyp:=hp^.typ;
-                       l:=0;
-                       repeat
-                         found:=(not (Pai(hp^.next)=nil)) and (Pai(hp^.next)^.typ=consttyp);
-                         if found then
-                          begin
-                            hp:=Pai(hp^.next);
-                            s:=','+tostr(pai_const(hp)^.value);
-                            AsmWrite(s);
-                            inc(l,length(s));
-                          end;
-                       until (not found) or (l>line_length);
-                       AsmLn;
-                     end;
-  ait_const_symbol : Begin
-                       AsmWriteLn(#9'.long'#9+StrPas(pchar(pai_const(hp)^.value)));
-                     end;
-  ait_const_symbol_offset :
-                     Begin
-                       AsmWrite(#9'.long'#9);
-                       AsmWritePChar(pai_const_symbol_offset(hp)^.name);
-                       if pai_const_symbol_offset(hp)^.offset>0 then
-                         AsmWrite('+'+tostr(pai_const_symbol_offset(hp)^.offset))
-                       else if pai_const_symbol_offset(hp)^.offset<0 then
-                         AsmWrite(tostr(pai_const_symbol_offset(hp)^.offset));
-                       AsmLn;
-                     end;
-    ait_real_64bit : Begin
-                       AsmWriteLn(#9'.double'#9+double2str(pai_double(hp)^.value));
-                     end;
-    ait_real_32bit : Begin
-                       AsmWriteLn(#9'.single'#9+double2str(pai_single(hp)^.value));
-                     end;
- ait_real_extended : Begin
-                       AsmWriteLn(#9'.extend'#9+double2str(pai_extended(hp)^.value));
-                     { comp type is difficult to write so use double }
-                     end;
-{ TO SUPPORT SOONER OR LATER!!!
-          ait_comp : Begin
-                       AsmWriteLn(#9'.double'#9+comp2str(pai_extended(hp)^.value));
-                     end; }
-        ait_direct : begin
-                       AsmWritePChar(pai_direct(hp)^.str);
-                       AsmLn;
-{$IfDef GDB}
-                       if strpos(pai_direct(hp)^.str,'.data')<>nil then
-                         n_line:=n_dataline
-                       else if strpos(pai_direct(hp)^.str,'.text')<>nil then
-                         n_line:=n_textline
-                       else if strpos(pai_direct(hp)^.str,'.bss')<>nil then
-                         n_line:=n_bssline;
-{$endif GDB}
-                     end;
-        ait_string : begin
-                       pos:=0;
-                       for i:=1 to pai_string(hp)^.len do
-                        begin
-                          if pos=0 then
-                           begin
-                             AsmWrite(#9'.ascii'#9'"');
-                             pos:=20;
-                           end;
-                          ch:=pai_string(hp)^.str[i-1];
-                          case ch of
-                             #0, {This can't be done by range, because a bug in FPC}
-                        #1..#31,
-                     #128..#255 : s:='\'+tostr(ord(ch) shr 6)+tostr((ord(ch) and 63) shr 3)+tostr(ord(ch) and 7);
-                            '"' : s:='\"';
-                            '\' : s:='\\';
-                          else
-                           s:=ch;
-                          end;
-                          AsmWrite(s);
-                          inc(pos,length(s));
-                          if (pos>line_length) or (i=pai_string(hp)^.len) then
-                           begin
-                             AsmWriteLn('"');
-                             pos:=0;
-                           end;
-                        end;
-                     end;
-         ait_label : begin
-                       if assigned(hp^.next) and (pai(hp^.next)^.typ in
-                          [ait_const_32bit,ait_const_16bit,ait_const_8bit,
-                           ait_const_symbol,ait_const_symbol_offset,
-                           ait_real_64bit,ait_real_32bit,ait_string]) then
-                        begin
-                          if not(cs_littlesize in aktglobalswitches) then
-                           AsmWriteLn(#9#9'.align 4')
-                          else
-                           AsmWriteLn(#9#9'.align 2');
-                        end;
-                       if (pai_label(hp)^.l^.is_used) then
-                        AsmWriteLn(lab2str(pai_label(hp)^.l)+':');
-                     end;
-ait_labeled_instruction : begin
-                     { labeled operand }
-                       if pai_labeled(hp)^._op1 = R_NO then
-                        AsmWriteLn(#9+mot_op2str[pai_labeled(hp)^._operator]+#9+lab2str(pai_labeled(hp)^.lab))
-                       else
-                     { labeled operand with register }
-                        AsmWriteLn(#9+mot_op2str[pai_labeled(hp)^._operator]+#9+
-                                 mit_reg2str[pai_labeled(hp)^._op1]+','+lab2str(pai_labeled(hp)^.lab))
-                     end;
-        ait_symbol : begin
-                       { ------------------------------------------------------- }
-                       { ----------- ALIGNMENT FOR ANY NON-BYTE VALUE ---------- }
-                       { ------------- REQUIREMENT FOR 680x0 ------------------- }
-                       { ------------------------------------------------------- }
-                       if assigned(hp^.next) and (pai(hp^.next)^.typ in
-                          [ait_const_32bit,ait_const_16bit,ait_const_8bit,
-                           ait_const_symbol,ait_const_symbol_offset,
-                           ait_real_64bit,ait_real_32bit,ait_string]) then
-                        begin
-                          if not(cs_littlesize in aktglobalswitches) then
-                           AsmWriteLn(#9#9'.align 4')
-                          else
-                           AsmWriteLn(#9#9'.align 2');
-                        end;
-                       if pai_symbol(hp)^.is_global then
-                        AsmWriteLn('.globl '+StrPas(pai_symbol(hp)^.name));
-                       AsmWriteLn(StrPas(pai_symbol(hp)^.name)+':');
-                     end;
-   ait_instruction : begin
-                       { old versions of GAS don't like PEA.L and LEA.L }
-                       if (pai68k(hp)^._operator in [
-                            A_LEA,A_PEA,A_ABCD,A_BCHG,A_BCLR,A_BSET,A_BTST,
-                            A_EXG,A_NBCD,A_SBCD,A_SWAP,A_TAS,A_SCC,A_SCS,
-                            A_SEQ,A_SGE,A_SGT,A_SHI,A_SLE,A_SLS,A_SLT,A_SMI,
-                            A_SNE,A_SPL,A_ST,A_SVC,A_SVS,A_SF]) then
-                        s:=#9+mot_op2str[pai68k(hp)^._operator]
-                       else
-                        s:=#9+mot_op2str[pai68k(hp)^._operator]+mit_opsize2str[pai68k(hp)^.size];
-                       if pai68k(hp)^.op1t<>top_none then
-                        begin
-                        { call and jmp need an extra handling                          }
-                        { this code is only callded if jmp isn't a labeled instruction }
-                          if pai68k(hp)^._operator in [A_JSR,A_JMP] then
-                           s:=s+#9+getopstr_jmp(pai68k(hp)^.op1t,pai68k(hp)^.op1)
-                          else
-                           if pai68k(hp)^.op1t = top_reglist then
-                            s:=s+#9+getopstr(pai68k(hp)^.op1t,@(pai68k(hp)^.reglist))
-                           else
-                            s:=s+#9+getopstr(pai68k(hp)^.op1t,pai68k(hp)^.op1);
-                           if pai68k(hp)^.op2t<>top_none then
-                            begin
-                              if pai68k(hp)^.op2t = top_reglist then
-                               s:=s+','+getopstr(pai68k(hp)^.op2t,@pai68k(hp)^.reglist)
-                              else
-                               s:=s+','+getopstr(pai68k(hp)^.op2t,pai68k(hp)^.op2);
-                            { three operands }
-                              if pai68k(hp)^.op3t<>top_none then
-                               begin
-                                   if (pai68k(hp)^._operator = A_DIVSL) or
-                                      (pai68k(hp)^._operator = A_DIVUL) or
-                                      (pai68k(hp)^._operator = A_MULU) or
-                                      (pai68k(hp)^._operator = A_MULS) or
-                                      (pai68k(hp)^._operator = A_DIVS) or
-                                      (pai68k(hp)^._operator = A_DIVU) then
-                                    s:=s+':'+getopstr(pai68k(hp)^.op3t,pai68k(hp)^.op3)
-                                   else
-                                    s:=s+','+getopstr(pai68k(hp)^.op3t,pai68k(hp)^.op3);
-                               end;
-                            end;
-                        end;
-                       AsmWriteLn(s);
-                     end;
-{$ifdef GDB}
-         ait_stabs : begin
-                       AsmWrite(#9'.stabs ');
-                       AsmWritePChar(pai_stabs(hp)^.str);
-                       AsmLn;
-                     end;
-         ait_stabn : begin
-                       AsmWrite(#9'.stabn ');
-                       AsmWritePChar(pai_stabn(hp)^.str);
-                       AsmLn;
-                     end;
-    ait_force_line : begin
-                        stabslastfileinfo.line:=0;
-                     end;
-ait_stab_function_name : funcname:=pai_stab_function_name(hp)^.str;
-{$endif GDB}
-           ait_cut : begin
-                     { create only a new file when the last is not empty }
-                       if AsmSize>0 then
-                        begin
-                          AsmClose;
-                          DoAssemble;
-                          AsmCreate;
-                        end;
-                     { avoid empty files }
-                       while assigned(hp^.next) and (pai(hp^.next)^.typ in [ait_cut,ait_section,ait_comment]) do
-                        begin
-                          if pai(hp^.next)^.typ=ait_section then
-                           begin
-                             lastsec:=pai_section(hp^.next)^.sec;
-                             lastsecidx:=pai_section(hp^.next)^.idataidx;
-                           end;
-                          hp:=pai(hp^.next);
-                        end;
-                       if lastsec<>sec_none then
-                         AsmWriteLn(ait_section2str[lastsec,lastsecidx]);
-                     end;
-        ait_marker : ;
-         else
-          internalerror(10000);
-         end;
-         hp:=pai(hp^.next);
-       end;
-    end;
-
-    procedure tm68kmitasmlist.WriteAsmList;
-    var
-      p:dirstr;
-      n:namestr;
-      e:extstr;
-    begin
-{$ifdef EXTDEBUG}
-      if assigned(current_module^.mainsource) then
-       comment(v_info,'Start writing gas-styled assembler output for '+current_module^.mainsource^);
-{$endif}
-
-      lastline:=0;
-      lastfileindex:=0;
-      LastSec:=sec_none;
-{$ifdef GDB}
-      includecount:=0;
-      n_line:=n_bssline;
-{$endif GDB}
-
-      if assigned(current_module^.mainsource) then
-       fsplit(current_module^.mainsource^,p,n,e)
-      else
-       begin
-         p:=inputdir;
-         n:=inputfile;
-         e:=inputextension;
-       end;
-    { to get symify to work }
-      AsmWriteLn(#9'.file "'+FixFileName(n+e)+'"');
-
-      countlabelref:=false;
-      { there should be nothing but externals so we don't need to process
-      WriteTree(externals); }
-
-      If (cs_debuginfo in aktmoduleswitches) then
-        WriteTree(debuglist);
-      WriteTree(codesegment);
-      WriteTree(datasegment);
-      WriteTree(consts);
-      WriteTree(rttilist);
-      WriteTree(bsssegment);
-      Writetree(importssection);
-      Writetree(exportssection);
-      Writetree(resourcesection);
-      countlabelref:=true;
-
-      AsmLn;
-{$ifdef EXTDEBUG}
-      if assigned(current_module^.mainsource) then
-       comment(v_info,'Done writing gas-styled assembler output for '+current_module^.mainsource^);
-{$endif EXTDEBUG}
-    end;
-
-end.
-{
-  $Log$
-  Revision 1.1  2000-11-30 20:30:34  peter
-    * moved into m68k subdir
-
-  Revision 1.2  2000/07/13 11:32:31  michael
-  + removed logs
-
-}

+ 0 - 551
compiler/m68k/ag68kmot.pas

@@ -1,551 +0,0 @@
-{
-    $Id$
-    Copyright (c) 1998-2000 by Florian Klaempfl
-
-    This unit implements an asmoutput class for MOTOROLA syntax with
-    Motorola 68000 (recognized by the Amiga Assembler and Charlie Gibbs's
-    A68k)
-
-    This program is free software; you can redistribute it and/or modify
-    it under the terms of the GNU General Public License as published by
-    the Free Software Foundation; either version 2 of the License, or
-    (at your option) any later version.
-
-    This program is distributed in the hope that it will be useful,
-    but WITHOUT ANY WARRANTY; without even the implied warranty of
-    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-    GNU General Public License for more details.
-
-    You should have received a copy of the GNU General Public License
-    along with this program; if not, write to the Free Software
-    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
-
- ****************************************************************************
-}
-unit ag68kmot;
-
-    interface
-
-    uses aasm,assemble;
-
-    type
-      pm68kmotasmlist=^tm68kmotasmlist;
-      tm68kmotasmlist = object(tasmlist)
-        procedure WriteTree(p:paasmoutput);virtual;
-        procedure WriteAsmList;virtual;
-      end;
-
-  implementation
-
-    uses
-      globtype,systems,
-      dos,globals,cobjects,cpubase,
-      strings,files,verbose
-{$ifdef GDB}
-      ,gdb
-{$endif GDB}
-      ;
-
-    const
-      line_length = 70;
-
-    function double2str(d : double) : string;
-      var
-         hs : string;
-      begin
-         str(d,hs);
-         double2str:=hs;
-      end;
-
-
-(* TO SUPPORT SOONER OR LATER!!!
-    function comp2str(d : bestreal) : string;
-      type
-        pdouble = ^double;
-      var
-        c  : comp;
-        dd : pdouble;
-      begin
-      {$ifdef TP}
-         c:=d;
-      {$else}
-         c:=comp(d);
-      {$endif}
-         dd:=pdouble(@c); { this makes a bitwise copy of c into a double }
-         comp2str:=double2str(dd^);
-      end; *)
-
-
-    function getreferencestring(const ref : treference) : string;
-      var
-         s : string;
-      begin
-         s:='';
-         if ref.isintvalue then
-             s:='#'+tostr(ref.offset)
-         else
-           with ref do
-             begin
-                 if (index=R_NO) and (base=R_NO) and (direction=dir_none) then
-                   begin
-                     if assigned(symbol) then
-                       begin
-                         s:=s+symbol^;
-                         if offset<0 then
-                           s:=s+tostr(offset)
-                         else
-                         if (offset>0) then
-                           s:=s+'+'+tostr(offset);
-                       end
-                     else
-                       begin
-                       { direct memory addressing }
-                         s:=s+'('+tostr(offset)+').l';
-                       end;
-                   end
-                 else
-                   begin
-                     if assigned(symbol) then
-                       s:=s+symbol^;
-                     if offset<0 then
-                       s:=s+tostr(offset)
-                     else
-                     if (offset>0) then
-                       begin
-                         if (symbol=nil) then s:=tostr(offset)
-                         else s:=s+'+'+tostr(offset);
-                       end;
-                     if (index<>R_NO) and (base=R_NO) and (direction=dir_none) then
-                       begin
-                         if (scalefactor = 1) or (scalefactor = 0) then
-                           begin
-                             if offset = 0 then
-                               s:=s+'0(,'+mot_reg2str[index]+'.l)'
-                             else
-                               s:=s+'(,'+mot_reg2str[index]+'.l)';
-                           end
-                         else
-                           begin
-                             if offset = 0 then
-                               s:=s+'0(,'+mot_reg2str[index]+'.l*'+tostr(scalefactor)+')'
-                             else
-                               s:=s+'(,'+mot_reg2str[index]+'.l*'+tostr(scalefactor)+')';
-                           end
-                       end
-                     else
-                     if (index=R_NO) and (base<>R_NO) and (direction=dir_inc) then
-                       begin
-                         if (scalefactor = 1) or (scalefactor = 0) then
-                           s:=s+'('+mot_reg2str[base]+')+'
-                         else
-                           InternalError(10002);
-                       end
-                     else
-                     if (index=R_NO) and (base<>R_NO) and (direction=dir_dec) then
-                       begin
-                         if (scalefactor = 1) or (scalefactor = 0) then
-                           s:=s+'-('+mot_reg2str[base]+')'
-                         else
-                           InternalError(10003);
-                       end
-                     else
-                     if (index=R_NO) and (base<>R_NO) and (direction=dir_none) then
-                       begin
-                         s:=s+'('+mot_reg2str[base]+')';
-                       end
-                     else
-                     if (index<>R_NO) and (base<>R_NO) and (direction=dir_none) then
-                       begin
-                         if (scalefactor = 1) or (scalefactor = 0) then
-                           begin
-                             if offset = 0 then
-                               s:=s+'0('+mot_reg2str[base]+','+mot_reg2str[index]+'.l)'
-                             else
-                               s:=s+'('+mot_reg2str[base]+','+mot_reg2str[index]+'.l)';
-                           end
-                         else
-                          begin
-                            if offset = 0 then
-                              s:=s+'0('+mot_reg2str[base]+','+mot_reg2str[index]+'.l*'+tostr(scalefactor)+')'
-                            else
-                              s:=s+'('+mot_reg2str[base]+','+mot_reg2str[index]+'.l*'+tostr(scalefactor)+')';
-                          end
-                       end
-      { if this is not a symbol, and is not in the above, then there is an error }
-                     else
-                     if NOT assigned(symbol) then
-                       InternalError(10004);
-                   end; { endif }
-            end; { end with }
-         getreferencestring:=s;
-      end;
-
-
-    function getopstr(t : byte;o : pointer) : string;
-     var
-      hs : string;
-      i: tregister;
-    begin
-      case t of
-       top_reg : getopstr:=mot_reg2str[tregister(o)];
-         top_reglist: begin
-                      hs:='';
-                      for i:=R_NO to R_FPSR do
-                      begin
-                        if i in tregisterlist(o^) then
-                         hs:=hs+mot_reg2str[i]+'/';
-                      end;
-                      delete(hs,length(hs),1);
-                      getopstr := hs;
-                    end;
-       top_ref : getopstr:=getreferencestring(preference(o)^);
-       top_const : getopstr:='#'+tostr(longint(o));
-       top_symbol : begin
-             { compare with i386 version, where this is a constant. }
-             hs[0]:=chr(strlen(pchar(pcsymbol(o)^.symbol)));
-                     move(pchar(pcsymbol(o)^.symbol)^,hs[1],byte(hs[0]));
-{                     inc(byte(hs[0]));}
-{                     hs[1]:='#';}
-                     if pcsymbol(o)^.offset>0 then
-                       hs:=hs+'+'+tostr(pcsymbol(o)^.offset)
-                     else if pcsymbol(o)^.offset<0 then
-                       hs:=hs+tostr(pcsymbol(o)^.offset);
-                     getopstr:=hs;
-                   end;
-         else internalerror(10001);
-       end;
-     end;
-
-
-   function getopstr_jmp(t : byte;o : pointer) : string;
-     var
-       hs : string;
-     begin
-       case t of
-         top_reg : getopstr_jmp:=mot_reg2str[tregister(o)];
-         top_ref : getopstr_jmp:=getreferencestring(preference(o)^);
-         top_const : getopstr_jmp:=tostr(longint(o));
-         top_symbol : begin
-                     hs[0]:=chr(strlen(pchar(pcsymbol(o)^.symbol)));
-                     move(pchar(pcsymbol(o)^.symbol)^,hs[1],byte(hs[0]));
-                     if pcsymbol(o)^.offset>0 then
-                       hs:=hs+'+'+tostr(pcsymbol(o)^.offset)
-                     else if pcsymbol(o)^.offset<0 then
-                       hs:=hs+tostr(pcsymbol(o)^.offset);
-                     getopstr_jmp:=hs;
-                   end;
-         else internalerror(10001);
-       end;
-     end;
-
-{****************************************************************************
-                              TM68KMOTASMLIST
- ****************************************************************************}
-
-    var
-      LastSec : tsection;
-
-    const
-      section2str : array[tsection] of string[6]=
-       ('','CODE','DATA','BSS','','','','','','','','');
-
-    procedure tm68kmotasmlist.WriteTree(p:paasmoutput);
-    var
-      hp        : pai;
-      s         : string;
-      counter,
-      i,j,lines : longint;
-      quoted    : boolean;
-    begin
-      if not assigned(p) then
-       exit;
-      hp:=pai(p^.first);
-      while assigned(hp) do
-       begin
-         case hp^.typ of
-       ait_comment : Begin
-                       AsmWrite(target_asm.comment);
-                       AsmWritePChar(pai_asm_comment(hp)^.str);
-                       AsmLn;
-                     End;
-       ait_section : begin
-                       if pai_section(hp)^.sec<>sec_none then
-                        begin
-
-                          AsmLn;
-                          AsmWriteLn('SECTION _'+section2str[pai_section(hp)^.sec]+','+section2str[pai_section(hp)^.sec]);
-                        end;
-                       LastSec:=pai_section(hp)^.sec;
-                     end;
-{$ifdef DREGALLOC}
-      ait_regalloc : AsmWriteLn(target_asm.comment+'Register '+att_reg2str[pairegalloc(hp)^.reg]+' allocated');
-    ait_regdealloc : AsmWriteLn(target_asm.comment+'Register '+att_reg2str[pairegalloc(hp)^.reg]+' released');
-{$endif DREGALLOC}
-         ait_align : AsmWriteLn(#9'CNOP 0,'+tostr(pai_align(hp)^.aligntype));
-      ait_external : AsmWriteLn(#9'XREF'#9+StrPas(pai_external(hp)^.name));
- ait_real_extended : Message(assem_e_extended_not_supported);
-          ait_comp : Message(assem_e_comp_not_supported);
-     ait_datablock : begin
-                       { ------------------------------------------------------- }
-                       { ----------- ALIGNMENT FOR ANY NON-BYTE VALUE ---------- }
-                       { ------------- REQUIREMENT FOR 680x0 ------------------- }
-                       { ------------------------------------------------------- }
-                       if pai_datablock(hp)^.size <> 1 then
-                        begin
-                          if not(cs_littlesize in aktglobalswitches) then
-                           AsmWriteLn(#9'CNOP 0,4')
-                          else
-                           AsmWriteLn(#9'CNOP 0,2');
-                         end;
-                       if pai_datablock(hp)^.is_global then
-                        AsmWriteLn(#9'XDEF'#9+StrPas(pai_datablock(hp)^.name));
-                       AsmWriteLn(StrPas(pai_datablock(hp)^.name)+#9#9'DS.B '+tostr(pai_datablock(hp)^.size));
-                     end;
-   ait_const_32bit : Begin
-                       AsmWriteLn(#9#9'DC.L'#9+tostr(pai_const(hp)^.value));
-                     end;
-   ait_const_16bit : Begin
-                       AsmWriteLn(#9#9'DC.W'#9+tostr(pai_const(hp)^.value));
-                     end;
-    ait_const_8bit : AsmWriteLn(#9#9'DC.B'#9+tostr(pai_const(hp)^.value));
-  ait_const_symbol : Begin
-                       AsmWriteLn(#9#9+'DC.L '#9+StrPas(pchar(pai_const(hp)^.value)));
-                     end;
-  ait_const_symbol_offset :
-                     Begin
-                       AsmWrite(#9#9+'DC.L '#9);
-                       AsmWritePChar(pai_const_symbol_offset(hp)^.name);
-                       if pai_const_symbol_offset(hp)^.offset>0 then
-                         AsmWrite('+'+tostr(pai_const_symbol_offset(hp)^.offset))
-                       else if pai_const_symbol_offset(hp)^.offset<0 then
-                         AsmWrite(tostr(pai_const_symbol_offset(hp)^.offset));
-                       AsmLn;
-                     end;
-    ait_real_64bit : Begin
-                       AsmWriteLn(#9#9'DC.D'#9+double2str(pai_double(hp)^.value));
-                     end;
-    ait_real_32bit : Begin
-                       AsmWriteLn(#9#9'DC.S'#9+double2str(pai_single(hp)^.value));
-                     end;
-{ TO SUPPORT SOONER OR LATER!!!
-          ait_comp : AsmWriteLn(#9#9'DC.D'#9+comp2str(pai_extended(hp)^.value));}
-        ait_string : begin
-                       counter := 0;
-                       lines := pai_string(hp)^.len div line_length;
-                       { separate lines in different parts }
-                       if pai_string(hp)^.len > 0 then
-                       Begin
-                         for j := 0 to lines-1 do
-                           begin
-                              AsmWrite(#9#9'DC.B'#9);
-                              quoted:=false;
-                              for i:=counter to counter+line_length do
-                                 begin
-                                   { it is an ascii character. }
-                                   if (ord(pai_string(hp)^.str[i])>31) and
-                                      (ord(pai_string(hp)^.str[i])<128) and
-                                      (pai_string(hp)^.str[i]<>'"') then
-                                   begin
-                                     if not(quoted) then
-                                     begin
-                                       if i>counter then
-                                         AsmWrite(',');
-                                       AsmWrite('"');
-                                     end;
-                                     AsmWrite(pai_string(hp)^.str[i]);
-                                     quoted:=true;
-                                   end { if > 31 and < 128 and ord('"') }
-                                   else
-                                   begin
-                                     if quoted then
-                                       AsmWrite('"');
-                                     if i>counter then
-                                       AsmWrite(',');
-                                     quoted:=false;
-                                     AsmWrite(tostr(ord(pai_string(hp)^.str[i])));
-                                   end;
-                                end; { end for i:=0 to... }
-                                if quoted then AsmWrite('"');
-                                AsmLn;
-                                counter := counter+line_length;
-                               end; { end for j:=0 ... }
-                               { do last line of lines }
-                               AsmWrite(#9#9'DC.B'#9);
-                               quoted:=false;
-                               for i:=counter to pai_string(hp)^.len-1 do
-                               begin
-                                 { it is an ascii character. }
-                                 if (ord(pai_string(hp)^.str[i])>31) and
-                                    (ord(pai_string(hp)^.str[i])<128) and
-                                    (pai_string(hp)^.str[i]<>'"') then
-                                 begin
-                                   if not(quoted) then
-                                   begin
-                                     if i>counter then
-                                       AsmWrite(',');
-                                     AsmWrite('"');
-                                   end;
-                                 AsmWrite(pai_string(hp)^.str[i]);
-                                   quoted:=true;
-                                 end { if > 31 and < 128 and " }
-                                 else
-                                 begin
-                                   if quoted then
-                                     AsmWrite('"');
-                                     if i>counter then
-                                       AsmWrite(',');
-                                     quoted:=false;
-                                     AsmWrite(tostr(ord(pai_string(hp)^.str[i])));
-                                 end;
-                               end; { end for i:=0 to... }
-                             if quoted then AsmWrite('"');
-                          end; { endif }
-                        AsmLn;
-                      end;
-          ait_label : begin
-                       if assigned(hp^.next) and (pai(hp^.next)^.typ in
-                          [ait_const_32bit,ait_const_16bit,ait_const_8bit,
-                            ait_const_symbol,ait_const_symbol_offset,
-                           ait_real_64bit,ait_real_32bit,ait_string]) then
-                        begin
-                          if not(cs_littlesize in aktglobalswitches) then
-                           AsmWriteLn(#9'CNOP 0,4')
-                          else
-                           AsmWriteLn(#9'CNOP 0,2');
-                        end;
-                        AsmWrite(lab2str(pai_label(hp)^.l));
-                        if assigned(hp^.next) and not(pai(hp^.next)^.typ in
-                           [ait_const_32bit,ait_const_16bit,ait_const_8bit,ait_const_symbol,
-                            ait_real_64bit,ait_string]) then
-                         AsmWriteLn(':');
-                      end;
-         ait_direct : begin
-                        AsmWritePChar(pai_direct(hp)^.str);
-                        AsmLn;
-                      end;
-ait_labeled_instruction :
-                      Begin
-                      { labeled operand }
-                        if pai_labeled(hp)^._op1 = R_NO then
-                         AsmWriteLn(#9+mot_op2str[pai_labeled(hp)^._operator]+#9+lab2str(pai_labeled(hp)^.lab))
-                        else
-                      { labeled operand with register }
-                         AsmWriteLn(#9+mot_op2str[pai_labeled(hp)^._operator]+#9+
-                                    mot_reg2str[pai_labeled(hp)^._op1]+','+lab2str(pai_labeled(hp)^.lab))
-                     end;
-        ait_symbol : begin
-                       { ------------------------------------------------------- }
-                       { ----------- ALIGNMENT FOR ANY NON-BYTE VALUE ---------- }
-                       { ------------- REQUIREMENT FOR 680x0 ------------------- }
-                       { ------------------------------------------------------- }
-                       if assigned(hp^.next) and (pai(hp^.next)^.typ in
-                          [ait_const_32bit,ait_const_16bit,
-                           ait_const_symbol,ait_const_symbol_offset,ait_const_8bit,
-                           ait_real_64bit,ait_real_32bit,ait_string]) then
-                        begin
-                          if not(cs_littlesize in aktglobalswitches) then
-                           AsmWriteLn(#9'CNOP 0,4')
-                          else
-                           AsmWriteLn(#9'CNOP 0,2');
-                        end;
-                       if pai_symbol(hp)^.is_global then
-                        AsmWriteLn(#9'XDEF '+StrPas(pai_symbol(hp)^.name));
-                       AsmWritePChar(pai_symbol(hp)^.name);
-                       if assigned(hp^.next) and not(pai(hp^.next)^.typ in
-                          [ait_const_32bit,ait_const_16bit,ait_const_8bit,
-                           ait_const_symbol,ait_const_symbol_offset,
-                           ait_real_64bit,ait_string,ait_real_32bit]) then
-                        AsmWriteLn(':');
-                     end;
-   ait_instruction : begin
-                       s:=#9+mot_op2str[pai68k(hp)^._operator]+mot_opsize2str[pai68k(hp)^.size];
-                       if pai68k(hp)^.op1t<>top_none then
-                        begin
-                        { call and jmp need an extra handling                          }
-                        { this code is only called if jmp isn't a labeled instruction }
-                          if pai68k(hp)^._operator in [A_JSR,A_JMP] then
-                           s:=s+#9+getopstr_jmp(pai68k(hp)^.op1t,pai68k(hp)^.op1)
-                          else
-                           begin
-                             if pai68k(hp)^.op1t = top_reglist then
-                              s:=s+#9+getopstr(pai68k(hp)^.op1t,@(pai68k(hp)^.reglist))
-                             else
-                              s:=s+#9+getopstr(pai68k(hp)^.op1t,pai68k(hp)^.op1);
-                             if pai68k(hp)^.op2t<>top_none then
-                              begin
-                                if pai68k(hp)^.op2t = top_reglist then
-                                 s:=s+','+getopstr(pai68k(hp)^.op2t,@pai68k(hp)^.reglist)
-                                else
-                                 s:=s+','+getopstr(pai68k(hp)^.op2t,pai68k(hp)^.op2);
-                             { three operands }
-                                if pai68k(hp)^.op3t<>top_none then
-                                 begin
-                                   if (pai68k(hp)^._operator = A_DIVSL) or
-                                      (pai68k(hp)^._operator = A_DIVUL) or
-                                      (pai68k(hp)^._operator = A_MULU) or
-                                      (pai68k(hp)^._operator = A_MULS) or
-                                      (pai68k(hp)^._operator = A_DIVS) or
-                                      (pai68k(hp)^._operator = A_DIVU) then
-                                    s:=s+':'+getopstr(pai68k(hp)^.op3t,pai68k(hp)^.op3)
-                                   else
-                                    s:=s+','+getopstr(pai68k(hp)^.op3t,pai68k(hp)^.op3);
-                                 end;
-                              end;
-                           end;
-                        end;
-                       AsmWriteLn(s);
-                     end;
-{$ifdef GDB}
-              ait_stabn,
-              ait_stabs,
-         ait_force_line,
- ait_stab_function_name : ;
-{$endif GDB}
-        ait_marker : ;
-         else
-          internalerror(10000);
-         end;
-         hp:=pai(hp^.next);
-       end;
-    end;
-
-    procedure tm68kmotasmlist.WriteAsmList;
-    begin
-{$ifdef EXTDEBUG}
-      if assigned(current_module^.mainsource) then
-       comment(v_info,'Start writing motorola-styled assembler output for '+current_module^.mainsource^);
-{$endif}
-
-      countlabelref:=false;
-      WriteTree(externals);
-    { WriteTree(debuglist);}
-      WriteTree(codesegment);
-      WriteTree(datasegment);
-      WriteTree(consts);
-      WriteTree(rttilist);
-      WriteTree(bsssegment);
-      Writetree(importssection);
-      Writetree(exportssection);
-      Writetree(resourcesection);
-      countlabelref:=true;
-
-      AsmLn;
-      AsmWriteLn(#9'END');
-      AsmLn;
-
-{$ifdef EXTDEBUG}
-      if assigned(current_module^.mainsource) then
-       comment(v_info,'Done writing motorola-styled assembler output for '+current_module^.mainsource^);
-{$endif}
-    end;
-
-end.
-{
-  $Log$
-  Revision 1.1  2000-11-30 20:30:34  peter
-    * moved into m68k subdir
-
-  Revision 1.2  2000/07/13 11:32:31  michael
-  + removed logs
-
-}

+ 0 - 590
compiler/m68k/ag68kmpw.pas

@@ -1,590 +0,0 @@
-{
-    $Id$
-    Copyright (c) 1998-2000 by Florian Klaempfl
-
-    This unit implements an asmoutput class for Macintosh MPW syntax
-
-    This program is free software; you can redistribute it and/or modify
-    it under the terms of the GNU General Public License as published by
-    the Free Software Foundation; either version 2 of the License, or
-    (at your option) any later version.
-
-    This program is distributed in the hope that it will be useful,
-    but WITHOUT ANY WARRANTY; without even the implied warranty of
-    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-    GNU General Public License for more details.
-
-    You should have received a copy of the GNU General Public License
-    along with this program; if not, write to the Free Software
-    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
-
- ****************************************************************************
-}
-unit ag68kmpw;
-
-    interface
-
-    uses aasm,assemble;
-
-    type
-      pm68kmpwasmlist=^tm68kmpwasmlist;
-      tm68kmpwasmlist = object(tasmlist)
-        procedure WriteTree(p:paasmoutput);virtual;
-        procedure WriteAsmList;virtual;
-      end;
-
-  implementation
-
-    uses
-      globtype,systems,
-      dos,globals,cobjects,cpubase,
-      strings,files,verbose
-{$ifdef GDB}
-      ,gdb
-{$endif GDB}
-      ;
-
-
-    function double2str(d : double) : string;
-      var
-         hs : string;
-      begin
-         str(d,hs);
-         double2str:=hs;
-      end;
-
-
-(* TO SUPPORT SOONER OR LATER!!!
-    function comp2str(d : bestreal) : string;
-      type
-        pdouble = ^double;
-      var
-        c  : comp;
-        dd : pdouble;
-      begin
-      {$ifdef TP}
-         c:=d;
-      {$else}
-         c:=comp(d);
-      {$endif}
-         dd:=pdouble(@c); { this makes a bitwise copy of c into a double }
-         comp2str:=double2str(dd^);
-      end; *)
-
-    const
-      line_length = 70;
-
-    function getreferencestring(const ref : treference; var importstring: string) : string;
-      var
-         s : string;
-      begin
-         s:='';
-         importstring:='';
-         if ref.isintvalue then
-             s:='#'+tostr(ref.offset)
-         else
-           with ref do
-             begin
-                 if (index=R_NO) and (base=R_NO) and (direction=dir_none) then
-                   begin
-                     if assigned(symbol) then
-                       begin
-                         s:=s+symbol^;
-                         importstring:=symbol^;
-                         if offset<0 then
-                           s:=s+tostr(offset)
-                         else
-                         if (offset>0) then
-                           s:=s+'+'+tostr(offset);
-                           s:='('+s+').L';
-                       end
-                     else
-                       begin
-                       { direct memory addressing }
-                         s:=s+'('+tostr(offset)+').L';
-                       end;
-                   end
-                 { index<>R_NO or base<>R_NO }
-                 else
-                   begin
-                     if assigned(symbol) then
-                       s:=s+symbol^;
-                     if offset<0 then
-                       s:=s+tostr(offset)
-                     else
-                     if (offset>0) then
-                       begin
-                         if (symbol=nil) then s:=tostr(offset)
-                         else s:=s+'+'+tostr(offset);
-                       end;
-                     if (index<>R_NO) and (base=R_NO) and (direction=dir_none) then
-                       begin
-                         if (scalefactor = 1) or (scalefactor = 0) then
-                           begin
-                             if offset = 0 then
-                               s:=s+'0(,'+mot_reg2str[index]+'.l)'
-                             else
-                               s:=s+'(,'+mot_reg2str[index]+'.l)';
-                           end
-                         else
-                           begin
-                             if offset = 0 then
-                               s:=s+'0(,'+mot_reg2str[index]+'.l*'+tostr(scalefactor)+')'
-                             else
-                               s:=s+'(,'+mot_reg2str[index]+'.l*'+tostr(scalefactor)+')';
-                           end
-                       end
-                     else
-                     if (index=R_NO) and (base<>R_NO) and (direction=dir_inc) then
-                       begin
-                         if (scalefactor = 1) or (scalefactor = 0) then
-                           s:=s+'('+mot_reg2str[base]+')+'
-                         else
-                           InternalError(10002);
-                       end
-                     else
-                     if (index=R_NO) and (base<>R_NO) and (direction=dir_dec) then
-                       begin
-                         if (scalefactor = 1) or (scalefactor = 0) then
-                           s:=s+'-('+mot_reg2str[base]+')'
-                         else
-                           InternalError(10003);
-                       end
-                     else
-                     if (index=R_NO) and (base<>R_NO) and (direction=dir_none) then
-                       begin
-                         s:=s+'('+mot_reg2str[base]+')';
-                       end
-                     else
-                     if (index<>R_NO) and (base<>R_NO) and (direction=dir_none) then
-                       begin
-                         if (scalefactor = 1) or (scalefactor = 0) then
-                           begin
-                             if offset = 0 then
-                               s:=s+'0('+mot_reg2str[base]+','+mot_reg2str[index]+'.l)'
-                             else
-                               s:=s+'('+mot_reg2str[base]+','+mot_reg2str[index]+'.l)';
-                           end
-                         else
-                          begin
-                            if offset = 0 then
-                              s:=s+'0('+mot_reg2str[base]+','+mot_reg2str[index]+'.l*'+tostr(scalefactor)+')'
-                            else
-                              s:=s+'('+mot_reg2str[base]+','+mot_reg2str[index]+'.l*'+tostr(scalefactor)+')';
-                          end
-                       end
-      { if this is not a symbol, and is not in the above, then there is an error }
-                     else
-                     if NOT assigned(symbol) then
-                       InternalError(10004);
-                   end; { endif }
-            end; { end with }
-         getreferencestring:=s;
-      end;
-
-
-    function getopstr(t : byte;o : pointer) : string;
-     var
-      hs : string;
-      i: tregister;
-      importstring: string;
-    begin
-      case t of
-       top_reg : getopstr:=mot_reg2str[tregister(o)];
-         top_reglist: begin
-                      hs:='';
-                      for i:=R_NO to R_FPSR do
-                      begin
-                        if i in tregisterlist(o^) then
-                         hs:=hs+mot_reg2str[i]+'/';
-                      end;
-                      delete(hs,length(hs),1);
-                      getopstr := hs;
-                    end;
-       top_ref : getopstr:=getreferencestring(preference(o)^,importstring);
-       top_const : getopstr:='#'+tostr(longint(o));
-       top_symbol : begin
-                     hs[0]:=chr(strlen(pchar(pcsymbol(o)^.symbol)));
-                     move(pchar(pcsymbol(o)^.symbol)^,hs[1],byte(hs[0]));
-                     if pcsymbol(o)^.offset>0 then
-                       hs:=hs+'+'+tostr(pcsymbol(o)^.offset)
-                     else if pcsymbol(o)^.offset<0 then
-                       hs:=hs+tostr(pcsymbol(o)^.offset);
-                     getopstr:=hs;
-                   end;
-         else internalerror(10001);
-       end;
-     end;
-
-
-   function getopstr_jmp(t : byte;o : pointer; var importname: string) : string;
-     var
-       hs : string;
-     begin
-       importname:='';
-       case t of
-         top_reg : getopstr_jmp:=mot_reg2str[tregister(o)];
-         top_ref : getopstr_jmp:=getreferencestring(preference(o)^,importname);
-         top_const : getopstr_jmp:=tostr(longint(o));
-         top_symbol : begin
-                        hs[0]:=chr(strlen(pchar(pcsymbol(o)^.symbol)));
-                        move(pchar(pcsymbol(o)^.symbol)^,hs[1],byte(hs[0]));
-                        if pcsymbol(o)^.offset>0 then
-                           hs:=hs+'+'+tostr(pcsymbol(o)^.offset)
-                        else if pcsymbol(o)^.offset<0 then
-                        hs:=hs+tostr(pcsymbol(o)^.offset);
-                        importname:=hs;
-                        hs:='('+hs+').L';
-                        getopstr_jmp:=hs;
-                   end;
-         else internalerror(10001);
-       end;
-     end;
-
-{****************************************************************************
-                              TM68KMOTASMLIST
- ****************************************************************************}
-    var
-      LastSec : tsection;
-
-    procedure tm68kmpwasmlist.WriteTree(p:paasmoutput);
-    var
-      hp        : pai;
-      s         : string;
-      counter,
-      i,j,lines : longint;
-      quoted    : boolean;
-      importname: string;
-    begin
-      hp:=pai(p^.first);
-      while assigned(hp) do
-       begin
-         case hp^.typ of
-       ait_comment : Begin
-                       AsmWrite(target_asm.comment);
-                       AsmWritePChar(pai_asm_comment(hp)^.str);
-                       AsmLn;
-                     End;
-       ait_section : begin
-                       if pai_section(hp)^.sec<>sec_none then
-                        begin
-                          AsmLn;
-                        end;
-                       LastSec:=pai_section(hp)^.sec;
-                     end;
-{$ifdef DREGALLOC}
-      ait_regalloc : AsmWriteLn(target_asm.comment+'Register '+att_reg2str[pairegalloc(hp)^.reg]+' allocated');
-    ait_regdealloc : AsmWriteLn(target_asm.comment+'Register '+att_reg2str[pairegalloc(hp)^.reg]+' released');
-{$endif DREGALLOC}
-         ait_align : AsmWriteLn(#9'ALIGN '+tostr(pai_align(hp)^.aligntype));
-      ait_external : AsmWriteLn(#9'IMPORT'#9+StrPas(pai_external(hp)^.name));
- ait_real_extended : Message(assem_e_extended_not_supported);
-          ait_comp : Message(assem_e_comp_not_supported);
-     ait_datablock : begin
-                       { ------------------------------------------------------- }
-                       { ----------- ALIGNMENT FOR ANY NON-BYTE VALUE ---------- }
-                       { ------------- REQUIREMENT FOR 680x0 ------------------- }
-                       { ------------------------------------------------------- }
-                       if pai_datablock(hp)^.size <> 1 then
-                        begin
-                          if not(cs_littlesize in aktglobalswitches) then
-                           AsmWriteLn(#9'ALIGN 4')
-                          else
-                           AsmWriteLn(#9'ALIGN 2');
-                         end;
-                       if pai_datablock(hp)^.is_global then
-                        AsmWriteLn(#9'EXPORT'#9+StrPas(pai_datablock(hp)^.name));
-                       AsmWriteLn(#9#9+StrPas(pai_datablock(hp)^.name)+#9#9'DS.B '+tostr(pai_datablock(hp)^.size));
-                     end;
-   ait_const_32bit : Begin
-                       AsmWriteLn(#9#9'DC.L'#9+tostr(pai_const(hp)^.value));
-                     end;
-   ait_const_16bit : Begin
-                       AsmWriteLn(#9#9'DC.W'#9+tostr(pai_const(hp)^.value));
-                     end;
-    ait_const_8bit : AsmWriteLn(#9#9'DC.B'#9+tostr(pai_const(hp)^.value));
-  ait_const_symbol : Begin
-                       AsmWriteLn(#9#9+'DC.L '#9+StrPas(pchar(pai_const(hp)^.value)));
-                     end;
-  ait_const_symbol_offset :
-                     Begin
-                       AsmWrite(#9#9+'DC.L '#9);
-                       AsmWritePChar(pai_const_symbol_offset(hp)^.name);
-                       if pai_const_symbol_offset(hp)^.offset>0 then
-                         AsmWrite('+'+tostr(pai_const_symbol_offset(hp)^.offset))
-                       else if pai_const_symbol_offset(hp)^.offset<0 then
-                         AsmWrite(tostr(pai_const_symbol_offset(hp)^.offset));
-                       AsmLn;
-                     end;
-    ait_real_64bit : Begin
-                       AsmWriteLn(#9#9'DC.D'#9+double2str(pai_double(hp)^.value));
-                     end;
-    ait_real_32bit : Begin
-                       AsmWriteLn(#9#9'DC.S'#9+double2str(pai_single(hp)^.value));
-                     end;
-{ TO SUPPORT SOONER OR LATER!!!
-    ait_comp       : AsmWriteLn(#9#9'DC.D'#9+comp2str(pai_extended(hp)^.value));}
-        ait_string : begin
-                       counter := 0;
-                       lines := pai_string(hp)^.len div line_length;
-                       { separate lines in different parts }
-                       if pai_string(hp)^.len > 0 then
-                       Begin
-                         for j := 0 to lines-1 do
-                           begin
-                              AsmWrite(#9#9'DC.B'#9);
-                              quoted:=false;
-                              for i:=counter to counter+line_length do
-                                 begin
-                                   { it is an ascii character. }
-                                   if (ord(pai_string(hp)^.str[i])>31) and
-                                      (ord(pai_string(hp)^.str[i])<128) and
-                                      (pai_string(hp)^.str[i]<>'''') then
-                                   begin
-                                     if not(quoted) then
-                                     begin
-                                       if i>counter then
-                                         AsmWrite(',');
-                                       AsmWrite('''');
-                                     end;
-                                     AsmWrite(pai_string(hp)^.str[i]);
-                                     quoted:=true;
-                                   end { if > 31 and < 128 and ord('"') }
-                                   else
-                                   begin
-                                     if quoted then
-                                       AsmWrite('''');
-                                     if i>counter then
-                                       AsmWrite(',');
-                                     quoted:=false;
-                                     AsmWrite(tostr(ord(pai_string(hp)^.str[i])));
-                                   end;
-                                end; { end for i:=0 to... }
-                                if quoted then AsmWrite('''');
-                                AsmLn;
-                                counter := counter+line_length;
-                               end; { end for j:=0 ... }
-                               { do last line of lines }
-                               AsmWrite(#9#9'DC.B'#9);
-                               quoted:=false;
-                               for i:=counter to pai_string(hp)^.len-1 do
-                               begin
-                                 { it is an ascii character. }
-                                 if (ord(pai_string(hp)^.str[i])>31) and
-                                    (ord(pai_string(hp)^.str[i])<128) and
-                                    (pai_string(hp)^.str[i]<>'''') then
-                                 begin
-                                   if not(quoted) then
-                                   begin
-                                     if i>counter then
-                                       AsmWrite(',');
-                                     AsmWrite('''');
-                                   end;
-                                 AsmWrite(pai_string(hp)^.str[i]);
-                                   quoted:=true;
-                                 end { if > 31 and < 128 and " }
-                                 else
-                                 begin
-                                   if quoted then
-                                     AsmWrite('''');
-                                     if i>counter then
-                                       AsmWrite(',');
-                                     quoted:=false;
-                                     AsmWrite(tostr(ord(pai_string(hp)^.str[i])));
-                                 end;
-                               end; { end for i:=0 to... }
-                             if quoted then AsmWrite('''');
-                          end; { endif }
-                        AsmLn;
-                      end;
-          ait_label : begin
-                       if assigned(hp^.next) and (pai(hp^.next)^.typ in
-                          [ait_const_32bit,ait_const_16bit,ait_const_8bit,
-                           ait_const_symbol,ait_const_symbol_offset,
-                           ait_real_64bit,ait_real_32bit,ait_string]) then
-                        begin
-                          if not(cs_littlesize in aktglobalswitches) then
-                           AsmWriteLn(#9'ALIGN 4')
-                          else
-                           AsmWriteLn(#9'ALIGN 2');
-                        end;
-                        AsmWrite(lab2str(pai_label(hp)^.l));
-                        if assigned(hp^.next) and not(pai(hp^.next)^.typ in
-                           [ait_const_32bit,ait_const_16bit,ait_const_8bit,
-                            ait_const_symbol,ait_const_symbol_offset,
-                            ait_real_64bit,ait_string]) then
-                         AsmWriteLn(':');
-                      end;
-         ait_direct : begin
-                        AsmWritePChar(pai_direct(hp)^.str);
-                        AsmLn;
-                      end;
-ait_labeled_instruction :
-                      { Labeled instructions are those which don't require an }
-                      { intersegment jump -- jmp/bra/bcc to local labels.     }
-                      Begin
-                      { labeled operand }
-                        if pai_labeled(hp)^._op1 = R_NO then
-                         AsmWriteLn(#9+mot_op2str[pai_labeled(hp)^._operator]+#9+lab2str(pai_labeled(hp)^.lab))
-                        else
-                      { labeled operand with register }
-                         AsmWriteLn(#9+mot_op2str[pai_labeled(hp)^._operator]+#9+
-                                    mot_reg2str[pai_labeled(hp)^._op1]+','+lab2str(pai_labeled(hp)^.lab))
-                     end;
-        ait_symbol : begin
-                       { ------------------------------------------------------- }
-                       { ----------- ALIGNMENT FOR ANY NON-BYTE VALUE ---------- }
-                       { ------------- REQUIREMENT FOR 680x0 ------------------- }
-                       { ------------------------------------------------------- }
-                       if assigned(hp^.next) and (pai(hp^.next)^.typ in
-                          [ait_const_32bit,ait_const_16bit,ait_const_8bit,
-                           ait_const_symbol,ait_const_symbol_offset,
-                           ait_real_64bit,ait_real_32bit,ait_string]) then
-                        begin
-                          if not(cs_littlesize in aktglobalswitches) then
-                           AsmWriteLn(#9'ALIGN 4')
-                          else
-                           AsmWriteLn(#9'ALIGN 2');
-                        end;
-                       if assigned(hp^.next) and not(pai(hp^.next)^.typ in
-                          [ait_const_32bit,ait_const_16bit,ait_const_8bit,
-                           ait_const_symbol,ait_const_symbol_offset,
-                           ait_real_64bit,ait_string,ait_real_32bit]) then
-                        { this is a subroutine }
-                        Begin
-                          if pai_symbol(hp)^.is_global then
-                            AsmWriteLn(#9+StrPas(pai_symbol(hp)^.name)+' PROC EXPORT')
-                          else
-                            AsmWriteLn(#9+StrPas(pai_symbol(hp)^.name)+' PROC');
-                          AsmWriteLn(#9'WITH _DATA');
-                        end
-                       else
-                       Begin
-                        if pai_symbol(hp)^.is_global then
-                           AsmWriteLn(#9'EXPORT'#9+StrPas(pai_symbol(hp)^.name))
-                        else
-                           AsmWriteLn(#9'ENTRY'#9+StrPas(pai_symbol(hp)^.name));
-                          AsmWritePChar(pai_symbol(hp)^.name);
-                       end;
-                     end;
-   ait_instruction : begin
-                       s:=#9+mot_op2str[pai68k(hp)^._operator]+mot_opsize2str[pai68k(hp)^.size];
-                       if pai68k(hp)^.op1t<>top_none then
-                        begin
-                        { call and jmp need an extra handling                          }
-                        { this code is only called if jmp isn't a labeled instruction }
-                          if pai68k(hp)^._operator in [A_JSR,A_JMP] then
-                          begin
-                           s:=s+#9+getopstr_jmp(pai68k(hp)^.op1t,pai68k(hp)^.op1,importname);
-                           if importname <> '' then
-                            AsmWriteLn(#9+'IMPORT '+importname);
-                          end
-                          else
-                           begin
-                             if pai68k(hp)^.op1t = top_reglist then
-                              s:=s+#9+getopstr(pai68k(hp)^.op1t,@(pai68k(hp)^.reglist))
-                             else
-                              s:=s+#9+getopstr(pai68k(hp)^.op1t,pai68k(hp)^.op1);
-                             if pai68k(hp)^.op2t<>top_none then
-                              begin
-                                if pai68k(hp)^.op2t = top_reglist then
-                                 s:=s+','+getopstr(pai68k(hp)^.op2t,@pai68k(hp)^.reglist)
-                                else
-                                 s:=s+','+getopstr(pai68k(hp)^.op2t,pai68k(hp)^.op2);
-                             { three operands }
-                                if pai68k(hp)^.op3t<>top_none then
-                                 begin
-                                   if (pai68k(hp)^._operator = A_DIVSL) or
-                                      (pai68k(hp)^._operator = A_DIVUL) or
-                                      (pai68k(hp)^._operator = A_MULU) or
-                                      (pai68k(hp)^._operator = A_MULS) or
-                                      (pai68k(hp)^._operator = A_DIVS) or
-                                      (pai68k(hp)^._operator = A_DIVU) then
-                                    s:=s+':'+getopstr(pai68k(hp)^.op3t,pai68k(hp)^.op3)
-                                   else
-                                    s:=s+','+getopstr(pai68k(hp)^.op3t,pai68k(hp)^.op3);
-                                 end;
-                              end;
-                           end;
-                        end;
-                       AsmWriteLn(s);
-                       { if this instruction is the last before     }
-                       { returning it MIGHT be the end of a         }
-                       { pascal subroutine, if this is so, then     }
-                       if (pai68k(hp)^._operator = A_RTS) or
-                          (pai68k(hp)^._operator = A_RTD) then
-                         Begin
-                           { if next is not an instruction nor a label }
-                           { this is the end of a procedure probably   }
-                           { and not an inline assembler instruction   }
-                           if assigned(hp^.next) and (
-                              (pai(hp^.next)^.typ = ait_label) or
-                              (pai(hp^.next)^.typ = ait_instruction) or
-                              (pai(hp^.next)^.typ = ait_labeled_instruction)) then
-                           begin
-                           end
-                           else
-                           begin
-                             AsmWriteLn(#9'ENDWITH');
-                             AsmWriteLn(#9'ENDPROC');
-                             AsmLn;
-                           end;
-                         end;
-                     end;
-{$ifdef GDB}
-              ait_stabn,
-              ait_stabs,
-         ait_force_line,
- ait_stab_function_name : ;
-{$endif GDB}
-        ait_marker : ;
-         else
-          internalerror(10000);
-         end;
-         hp:=pai(hp^.next);
-       end;
-    end;
-
-    procedure tm68kmpwasmlist.WriteAsmList;
-    begin
-{$ifdef EXTDEBUG}
-      if assigned(current_module^.mainsource) then
-       comment(v_info,'Start writing MPW-styled assembler output for '+current_module^.mainsource^);
-{$endif}
-      WriteTree(externals);
-      AsmLn;
-      AsmWriteLn(#9'_DATA'#9'RECORD');
-    { write a signature to the file }
-      AsmWriteLn(#9'ALIGN 4');
-(* now in pmodules
-{$ifdef EXTDEBUG}
-      AsmWriteLn(#9'DC.B'#9'''compiled by FPC '+version_string+'\0''');
-      AsmWriteLn(#9'DC.B'#9'''target: '+target_info.short_name+'\0''');
-{$endif EXTDEBUG} *)
-      WriteTree(datasegment);
-      WriteTree(consts);
-      WriteTree(bsssegment);
-      AsmWriteLn(#9'ENDR');
-
-      AsmLn;
-      WriteTree(codesegment);
-
-
-      AsmLn;
-      AsmWriteLn(#9'END');
-{$ifdef EXTDEBUG}
-      if assigned(current_module^.mainsource) then
-       comment(v_info,'Done writing MPW-styled assembler output for '+current_module^.mainsource^);
-{$endif}
-    end;
-
-end.
-{
-  $Log$
-  Revision 1.1  2000-11-30 20:30:34  peter
-    * moved into m68k subdir
-
-  Revision 1.2  2000/07/13 11:32:31  michael
-  + removed logs
-
-}