Browse Source

* m68k compiles
+ .def file creation moved to gendef.pas so it could also be used
for win32

peter 27 năm trước cách đây
mục cha
commit
f66f837fc8

+ 18 - 2
compiler/aasm.pas

@@ -27,8 +27,15 @@ unit aasm;
     uses
     uses
        cobjects,files,globals;
        cobjects,files,globals;
 
 
-{$I version.inc}
     type
     type
+{$ifdef i386}
+       bestreal = extended;
+{$endif}
+{$ifdef m68k}
+       bestreal = real;
+{$endif}
+
+
        tait = (
        tait = (
           ait_string,
           ait_string,
           ait_label,
           ait_label,
@@ -257,6 +264,10 @@ type
        taasmoutput = tlinkedlist;
        taasmoutput = tlinkedlist;
 
 
     var
     var
+    { temporary lists }
+      exprasmlist,
+    { default lists }
+
       datasegment,codesegment,bsssegment,
       datasegment,codesegment,bsssegment,
       internals,externals,debuglist,consts,
       internals,externals,debuglist,consts,
       importssection,exportssection,
       importssection,exportssection,
@@ -806,7 +817,12 @@ uses
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.8  1998-05-23 01:20:53  peter
+  Revision 1.9  1998-06-04 23:51:26  peter
+    * m68k compiles
+    + .def file creation moved to gendef.pas so it could also be used
+      for win32
+
+  Revision 1.8  1998/05/23 01:20:53  peter
     + aktasmmode, aktoptprocessor, aktoutputformat
     + aktasmmode, aktoptprocessor, aktoutputformat
     + smartlink per module $SMARTLINK-/+ (like MMX) and moved to aktswitches
     + smartlink per module $SMARTLINK-/+ (like MMX) and moved to aktswitches
     + $LIBNAME to set the library name where the unit will be put in
     + $LIBNAME to set the library name where the unit will be put in

+ 73 - 185
compiler/ag68kgas.pas

@@ -59,7 +59,6 @@ unit ag68kgas;
     function double2str(d : double) : string;
     function double2str(d : double) : string;
       var
       var
          hs : string;
          hs : string;
-         p : byte;
       begin
       begin
          str(d,hs);
          str(d,hs);
        { replace space with + }
        { replace space with + }
@@ -76,14 +75,12 @@ unit ag68kgas;
         c  : comp;
         c  : comp;
         dd : pdouble;
         dd : pdouble;
       begin
       begin
-         c:=d;
-      {$ifndef TP}
-         {$warning The following warning can be ignored}
-      {$endif TP}
+         c:=comp(d);
          dd:=pdouble(@c); { this makes a bitwise copy of c into a double }
          dd:=pdouble(@c); { this makes a bitwise copy of c into a double }
          comp2str:=double2str(dd^);
          comp2str:=double2str(dd^);
       end;
       end;
 
 
+
     function getreferencestring(const ref : treference) : string;
     function getreferencestring(const ref : treference) : string;
       var
       var
          s : string;
          s : string;
@@ -205,13 +202,20 @@ unit ag68kgas;
  ****************************************************************************}
  ****************************************************************************}
 
 
     var
     var
-       { different types of source lines }
+{$ifdef GDB}
+
        n_line : byte;
        n_line : byte;
+{$endif}
+       lastsec : tsection;
+
 
 
     const
     const
       ait_const2str:array[ait_const_32bit..ait_const_8bit] of string[8]=
       ait_const2str:array[ait_const_32bit..ait_const_8bit] of string[8]=
         (#9'.long'#9,'',#9'.short'#9,#9'.byte'#9);
         (#9'.long'#9,'',#9'.short'#9,#9'.byte'#9);
 
 
+      ait_section2str : array[tsection] of string[6]=
+       ('','.text','.data','.bss','.idata');
+
     procedure tm68kgasasmlist.WriteTree(p:paasmoutput);
     procedure tm68kgasasmlist.WriteTree(p:paasmoutput);
     var
     var
       hp        : pai;
       hp        : pai;
@@ -225,6 +229,8 @@ unit ag68kgas;
       linecount : longint;
       linecount : longint;
 {$endif GDB}
 {$endif GDB}
     begin
     begin
+      if not assigned(p) then
+       exit;
 {$ifdef GDB}
 {$ifdef GDB}
       funcname:=nil;
       funcname:=nil;
       linecount:=1;
       linecount:=1;
@@ -255,11 +261,11 @@ unit ag68kgas;
                if (hp^.line<>lastline) and (hp^.line<>0) then
                if (hp^.line<>lastline) and (hp^.line<>0) then
                 begin
                 begin
                   if (n_line = n_textline) and assigned(funcname) and
                   if (n_line = n_textline) and assigned(funcname) and
-                     (target_info.use_function_relative_addresses) then
+                     (target_os.use_function_relative_addresses) then
                    begin
                    begin
-                     AsmWriteLn(target_info.labelprefix+'l'+tostr(linecount)+':');
+                     AsmWriteLn(target_asm.labelprefix+'l'+tostr(linecount)+':');
                      AsmWriteLn(#9'.stabn '+tostr(n_line)+',0,'+tostr(hp^.line)+','+
                      AsmWriteLn(#9'.stabn '+tostr(n_line)+',0,'+tostr(hp^.line)+','+
-                                target_info.labelprefix+'l'+tostr(linecount)+' - '+StrPas(FuncName));
+                                target_asm.labelprefix+'l'+tostr(linecount)+' - '+StrPas(FuncName));
                      inc(linecount);
                      inc(linecount);
                    end
                    end
                   else
                   else
@@ -271,14 +277,36 @@ unit ag68kgas;
 {$endif GDB}
 {$endif GDB}
 
 
          case hp^.typ of
          case hp^.typ of
-           ait_comment :
-             Begin
-                AsmWrite(As_comment);
-                AsmWritePChar(pai_asm_comment(hp)^.str);
-                AsmLn;
-             End;
       ait_external : ; { external is ignored }
       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_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
      ait_datablock : begin
                        { ------------------------------------------------------- }
                        { ------------------------------------------------------- }
                        { ----------- ALIGNMENT FOR ANY NON-BYTE VALUE ---------- }
                        { ----------- ALIGNMENT FOR ANY NON-BYTE VALUE ---------- }
@@ -494,6 +522,21 @@ ait_labeled_instruction : begin
                      end;
                      end;
 ait_stab_function_name : funcname:=pai_stab_function_name(hp)^.str;
 ait_stab_function_name : funcname:=pai_stab_function_name(hp)^.str;
 {$endif GDB}
 {$endif GDB}
+{$ifdef SMARTLINK}
+           ait_cut : begin { used to split into tiny assembler files }
+                       if (cs_smartlink in aktswitches) then
+                        begin
+                          AsmClose;
+                          DoAssemble;
+                          AsmCreate;
+                          AsmWriteLn(ait_section2str[lastsec]);
+                        { avoid empty files }
+                          while assigned(hp^.next) and (pai(hp^.next)^.typ=ait_cut) do
+                           hp:=pai(hp^.next);
+                        end;
+                     end;
+{$endif SMARTLINK}              
+
          else
          else
           internalerror(10000);
           internalerror(10000);
          end;
          end;
@@ -504,7 +547,9 @@ ait_stab_function_name : funcname:=pai_stab_function_name(hp)^.str;
     procedure tm68kgasasmlist.WriteAsmList;
     procedure tm68kgasasmlist.WriteAsmList;
 {$ifdef GDB}
 {$ifdef GDB}
     var
     var
-      p,n,e : string;
+      p:dirstr;
+      n:namestr;
+      e:extstr;
 {$endif}
 {$endif}
     begin
     begin
 {$ifdef EXTDEBUG}
 {$ifdef EXTDEBUG}
@@ -534,42 +579,24 @@ ait_stab_function_name : funcname:=pai_stab_function_name(hp)^.str;
          AsmWriteLn('Ltext0:');
          AsmWriteLn('Ltext0:');
        end;
        end;
       infile:=current_module^.sourcefiles.files;
       infile:=current_module^.sourcefiles.files;
-{$endif GDB}
-
     { main source file is last in list }
     { main source file is last in list }
       while assigned(infile^._next) do
       while assigned(infile^._next) do
        infile:=infile^._next;
        infile:=infile^._next;
       lastline:=0;
       lastline:=0;
+{$endif GDB}
+
       { there should be nothing but externals so we don't need to process
       { there should be nothing but externals so we don't need to process
       WriteTree(externals); }
       WriteTree(externals); }
-      WriteTree(debuglist);
 
 
-    { code segment }
-      AsmWriteln('.text');
-{$ifdef GDB}
-      n_line:=n_textline;
-{$endif GDB}
+      WriteTree(debuglist);
       WriteTree(codesegment);
       WriteTree(codesegment);
-
-      AsmWriteLn('.data');
-{$ifdef EXTDEBUG}
-      AsmWriteLn(#9'.ascii'#9'"compiled by FPC '+version_string+'\0"');
-      AsmWriteLn(#9'.ascii'#9'"target: '+target_info.target_name+'\0"');
-{$endif EXTDEBUG}
-{$ifdef GDB}
-      n_line:=n_dataline;
-{$endif GDB}
-      DataSegment^.insert(new(pai_align,init(4)));
       WriteTree(datasegment);
       WriteTree(datasegment);
       WriteTree(consts);
       WriteTree(consts);
-
-    { makes problems with old GNU ASes
-      AsmWriteLn('.bss');
-      bssSegment^.insert(new(pai_align,init(4))); }
-{$ifdef GDB}
-      n_line:=n_bssline;
-{$endif GDB}
+      WriteTree(rttilist);
       WriteTree(bsssegment);
       WriteTree(bsssegment);
+      Writetree(importssection);
+      Writetree(exportssection);
+      Writetree(resourcesection);
 
 
       AsmLn;
       AsmLn;
 {$ifdef EXTDEBUG}
 {$ifdef EXTDEBUG}
@@ -581,148 +608,9 @@ ait_stab_function_name : funcname:=pai_stab_function_name(hp)^.str;
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.3  1998-05-23 01:20:56  peter
-    + aktasmmode, aktoptprocessor, aktoutputformat
-    + smartlink per module $SMARTLINK-/+ (like MMX) and moved to aktswitches
-    + $LIBNAME to set the library name where the unit will be put in
-    * splitted cgi386 a bit (codeseg to large for bp7)
-    * nasm, tasm works again. nasm moved to ag386nsm.pas
-
-  Revision 1.2  1998/04/29 10:33:41  pierre
-    + added some code for ansistring (not complete nor working yet)
-    * corrected operator overloading
-    * corrected nasm output
-    + started inline procedures
-    + added starstarn : use ** for exponentiation (^ gave problems)
-    + started UseTokenInfo cond to get accurate positions
-
-  Revision 1.1.1.1  1998/03/25 11:18:16  root
-  * Restored version
-
-  Revision 1.3  1998/03/22 12:45:37  florian
-    * changes of Carl-Eric to m68k target commit:
-      - wrong nodes because of the new string cg in intel, I had to create
-        this under m68k also ... had to work it out to fix potential alignment
-        problems --> this removes the crash of the m68k compiler.
-      - added absolute addressing in m68k assembler (required for Amiga startup)
-      - fixed alignment problems (because of byte return values, alignment
-        would not be always valid) -- is this ok if i change the offset if odd in
-        setfirsttemp ?? -- it seems ok...
-
-  Revision 1.2  1998/03/10 04:22:08  carl
-    - removed in as it can cause range check errors under BP
-
-  Revision 1.1  1998/03/10 01:26:10  peter
-    + new uniform names
-
-  Revision 1.18  1998/03/09 12:58:10  peter
-    * FWait warning is only showed for Go32V2 and $E+
-    * opcode tables moved to i386.pas/m68k.pas to reduce circular uses (and
-      for m68k the same tables are removed)
-    + $E for i386
-
-  Revision 1.17  1998/03/06 00:52:18  peter
-    * replaced all old messages from errore.msg, only ExtDebug and some
-      Comment() calls are left
-    * fixed options.pas
-
-  Revision 1.16  1998/03/02 01:48:33  peter
-    * renamed target_DOS to target_GO32V1
-    + new verbose system, merged old errors and verbose units into one new
-      verbose.pas, so errors.pas is obsolete
-
-  Revision 1.15  1998/02/23 03:00:00  carl
-    * bugfix when compiling with extdebug defined
-
-  Revision 1.14  1998/02/22 23:03:18  peter
-    * renamed msource->mainsource and name->unitname
-    * optimized filename handling, filename is not seperate anymore with
-      path+name+ext, this saves stackspace and a lot of fsplit()'s
-    * recompiling of some units in libraries fixed
-    * shared libraries are working again
-    + $LINKLIB <lib> to support automatic linking to libraries
-    + libraries are saved/read from the ppufile, also allows more libraries
-      per ppufile
-
-  Revision 1.13  1998/02/21 20:20:52  carl
-     * make it work under older versions of GAS
-
-  Revision 1.10  1998/02/15 21:16:19  peter
-    * all assembler outputs supported by assemblerobject
-    * cleanup with assembleroutputs, better .ascii generation
-    * help_constructor/destructor are now added to the externals
-    - generation of asmresponse is not outputformat depended
-
-  Revision 1.9  1998/02/13 10:34:59  daniel
-  * Made Motorola version compilable.
-  * Fixed optimizer
-
-  Revision 1.8  1998/02/12 11:50:04  daniel
-  Yes! Finally! After three retries, my patch!
-
-  Changes:
-
-  Complete rewrite of psub.pas.
-  Added support for DLL's.
-  Compiler requires less memory.
-  Platform units for each platform.
-
-  Revision 1.7  1998/01/09 19:20:49  carl
-  + added support for mul/div 68020 syntax
-  * bugfix of getreferencestring
-
-  Revision 1.4  1997/12/09 13:37:50  carl
-  + ait_align added
-  * now all non byte values are aligned correctly
-
-  Revision 1.3  1997/12/05 14:40:49  carl
-  * bugfix of scaling, was incorrect under gas.
-
-  Revision 1.2  1997/12/04 15:30:14  carl
-  * forgot to change name of unit! ugh...
-
-  Revision 1.1  1997/12/03 14:04:19  carl
-  + renamed from gasasm6.pas to ag68kgas.pas
-
-  Revision 1.3  1997/12/01 17:42:51  pierre
-     + added some more functionnality to the assembler parser
-
-  Revision 1.2  1997/11/28 18:14:32  pierre
-   working version with several bug fixes
-
-  Revision 1.1.1.1  1997/11/27 08:32:56  michael
-  FPC Compiler CVS start
-
-
-  Pre-CVS log:
-
-  CEC   Carl-Eric Codere
-  FK    Florian Klaempfl
-  PM    Pierre Muller
-  +     feature added
-  -     removed
-  *     bug fixed or changed
-
-  History:
-      30th september 1996:
-         + unit started (FK)
-      15th october 1996:
-         + ti386attasmoutput class started (FK)
-      28th november 1996:
-         ! debugging for simple programs (FK)
-      26th february 1997:
-         + op2str array completed with work of Daniel Manitone (FK)
-      25th september 1997:
-         * compiled by comment ifdef'ed (FK)
-      4th october 1997:
-         + converted to motorola 68000 (same sytnax as gas) (CEC)
-     9th october 1997:
-       * fixed constant bug. (CEC)
-       + converted from %reg to reg (untested) (CEC)
-     (according to gas docs, they are accepted).
-    28th october 1997:
-       * bugfix on increment/decrement mode (was never checked). (CEC)
-    2nd november 1997:
-       + added all opcodes , and they are now in correct order of
-         processor types. (CEC).
+  Revision 1.4  1998-06-04 23:51:28  peter
+    * m68k compiles
+    + .def file creation moved to gendef.pas so it could also be used
+      for win32
+
 }
 }

+ 90 - 136
compiler/ag68kmit.pas

@@ -53,15 +53,21 @@ unit ag68kmit;
     const
     const
       line_length = 70;
       line_length = 70;
 
 
+{$ifdef GDB}
     var
     var
       infile : pextfile;
       infile : pextfile;
-      includecount,lastline : longint;
+      includecount,
+      lastline : longint;
+{$endif GDB}
 
 
     function double2str(d : double) : string;
     function double2str(d : double) : string;
       var
       var
          hs : string;
          hs : string;
       begin
       begin
          str(d,hs);
          str(d,hs);
+      { replace space with + }
+         if hs[1]=' ' then
+          hs[1]:='+';
          double2str:=hs;
          double2str:=hs;
       end;
       end;
 
 
@@ -73,14 +79,12 @@ unit ag68kmit;
         c  : comp;
         c  : comp;
         dd : pdouble;
         dd : pdouble;
       begin
       begin
-         c:=d;{ this generates a warning but this is not important }
-      {$ifndef TP}
-         {$warning The following warning can be ignored}
-      {$endif TP}
+         c:=comp(d);
          dd:=pdouble(@c); { this makes a bitwise copy of c into a double }
          dd:=pdouble(@c); { this makes a bitwise copy of c into a double }
          comp2str:=double2str(dd^);
          comp2str:=double2str(dd^);
       end;
       end;
 
 
+
     function getreferencestring(const ref : treference) : string;
     function getreferencestring(const ref : treference) : string;
       var
       var
          s : string;
          s : string;
@@ -238,13 +242,18 @@ unit ag68kmit;
  ****************************************************************************}
  ****************************************************************************}
 
 
     var
     var
-       { different types of source lines }
-       n_line : byte;
+{$ifdef GDB}
+      n_line  : byte;     { different types of source lines }
+{$endif}
+      lastsec : tsection; { last section type written }
 
 
     const
     const
       ait_const2str:array[ait_const_32bit..ait_const_8bit] of string[8]=
       ait_const2str:array[ait_const_32bit..ait_const_8bit] of string[8]=
         (#9'.long'#9,'',#9'.short'#9,#9'.byte'#9);
         (#9'.long'#9,'',#9'.short'#9,#9'.byte'#9);
 
 
+      ait_section2str : array[tsection] of string[6]=
+       ('','.text','.data','.bss','.idata');
+
     procedure tm68kmitasmlist.WriteTree(p:paasmoutput);
     procedure tm68kmitasmlist.WriteTree(p:paasmoutput);
     var
     var
       hp        : pai;
       hp        : pai;
@@ -258,6 +267,8 @@ unit ag68kmit;
       linecount : longint;
       linecount : longint;
 {$endif GDB}
 {$endif GDB}
     begin
     begin
+      if not assigned(p) then
+       exit;
 {$ifdef GDB}
 {$ifdef GDB}
       funcname:=nil;
       funcname:=nil;
       linecount:=1;
       linecount:=1;
@@ -288,11 +299,11 @@ unit ag68kmit;
                if (hp^.line<>lastline) and (hp^.line<>0) then
                if (hp^.line<>lastline) and (hp^.line<>0) then
                 begin
                 begin
                   if (n_line = n_textline) and assigned(funcname) and
                   if (n_line = n_textline) and assigned(funcname) and
-                     (target_info.use_function_relative_addresses) then
+                     (target_os.use_function_relative_addresses) then
                    begin
                    begin
-                     AsmWriteLn(target_info.labelprefix+'l'+tostr(linecount)+':');
+                     AsmWriteLn(target_asm.labelprefix+'l'+tostr(linecount)+':');
                      AsmWriteLn(#9'.stabn '+tostr(n_line)+',0,'+tostr(hp^.line)+','+
                      AsmWriteLn(#9'.stabn '+tostr(n_line)+',0,'+tostr(hp^.line)+','+
-                                target_info.labelprefix+'l'+tostr(linecount)+' - '+StrPas(FuncName));
+                                target_asm.labelprefix+'l'+tostr(linecount)+' - '+StrPas(FuncName));
                      inc(linecount);
                      inc(linecount);
                    end
                    end
                   else
                   else
@@ -303,14 +314,35 @@ unit ag68kmit;
           end;
           end;
 {$endif GDB}
 {$endif GDB}
          case hp^.typ of
          case hp^.typ of
-           ait_comment :
-             Begin
-                AsmWrite(As_comment);
-                AsmWritePChar(pai_asm_comment(hp)^.str);
-                AsmLn;
-             End;
       ait_external : ; { external is ignored }
       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_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
      ait_datablock : begin
                        { ------------------------------------------------------- }
                        { ------------------------------------------------------- }
                        { ----------- ALIGNMENT FOR ANY NON-BYTE VALUE ---------- }
                        { ----------- ALIGNMENT FOR ANY NON-BYTE VALUE ---------- }
@@ -366,40 +398,42 @@ unit ag68kmit;
                        until (not found) or (l>line_length);
                        until (not found) or (l>line_length);
                        AsmLn;
                        AsmLn;
                      end;
                      end;
-  ait_const_symbol : Begin
-                      if not(cs_littlesize in aktswitches) then
-                           AsmWriteLn(#9#9'.align 4')
-                      else
-                          AsmWriteLn(#9#9'.align 2');
-                       AsmWriteLn(#9'.long'#9+StrPas(pchar(pai_const(hp)^.value)));
+  ait_const_symbol : begin
+                       if not(cs_littlesize in aktswitches) then
+                         AsmWriteLn(#9#9'.align 4')
+                       else
+                         AsmWriteLn(#9#9'.align 2');
+                       AsmWrite(#9'.long'#9);
+                       AsmWritePChar(pchar(pai_const(hp)^.value));
+                       AsmLn;
                      end;
                      end;
     ait_real_64bit : Begin
     ait_real_64bit : Begin
-                      if not(cs_littlesize in aktswitches) then
-                           AsmWriteLn(#9#9'.align 4')
-                      else
-                          AsmWriteLn(#9#9'.align 2');
-                      AsmWriteLn(#9'.double'#9+double2str(pai_double(hp)^.value));
+                       if not(cs_littlesize in aktswitches) then
+                         AsmWriteLn(#9#9'.align 4')
+                       else
+                         AsmWriteLn(#9#9'.align 2');
+                       AsmWriteLn(#9'.double'#9+double2str(pai_double(hp)^.value));
                      end;
                      end;
     ait_real_32bit : Begin
     ait_real_32bit : Begin
-                      if not(cs_littlesize in aktswitches) then
-                           AsmWriteLn(#9#9'.align 4')
-                      else
-                          AsmWriteLn(#9#9'.align 2');
-                      AsmWriteLn(#9'.single'#9+double2str(pai_single(hp)^.value));
+                       if not(cs_littlesize in aktswitches) then
+                         AsmWriteLn(#9#9'.align 4')
+                       else
+                         AsmWriteLn(#9#9'.align 2');
+                       AsmWriteLn(#9'.single'#9+double2str(pai_single(hp)^.value));
                      end;
                      end;
  ait_real_extended : Begin
  ait_real_extended : Begin
-                      if not(cs_littlesize in aktswitches) then
-                           AsmWriteLn(#9#9'.align 4')
-                      else
-                          AsmWriteLn(#9#9'.align 2');
-                      AsmWriteLn(#9'.extend'#9+double2str(pai_extended(hp)^.value));
+                       if not(cs_littlesize in aktswitches) then
+                         AsmWriteLn(#9#9'.align 4')
+                       else
+                         AsmWriteLn(#9#9'.align 2');
+                       AsmWriteLn(#9'.extend'#9+double2str(pai_extended(hp)^.value));
                      { comp type is difficult to write so use double }
                      { comp type is difficult to write so use double }
                      end;
                      end;
           ait_comp : Begin
           ait_comp : Begin
-                      if not(cs_littlesize in aktswitches) then
-                           AsmWriteLn(#9#9'.align 4')
-                      else
-                          AsmWriteLn(#9#9'.align 2');
+                       if not(cs_littlesize in aktswitches) then
+                         AsmWriteLn(#9#9'.align 4')
+                       else
+                         AsmWriteLn(#9#9'.align 2');
                        AsmWriteLn(#9'.double'#9+comp2str(pai_extended(hp)^.value));
                        AsmWriteLn(#9'.double'#9+comp2str(pai_extended(hp)^.value));
                      end;
                      end;
         ait_direct : begin
         ait_direct : begin
@@ -540,16 +574,18 @@ ait_stab_function_name : funcname:=pai_stab_function_name(hp)^.str;
     procedure tm68kmitasmlist.WriteAsmList;
     procedure tm68kmitasmlist.WriteAsmList;
 {$ifdef GDB}
 {$ifdef GDB}
     var
     var
-      p,n,e : string;
+      p:dirstr;
+      n:namestr;
+      e:extstr;
 {$endif}
 {$endif}
     begin
     begin
 {$ifdef EXTDEBUG}
 {$ifdef EXTDEBUG}
       if assigned(current_module^.mainsource) then
       if assigned(current_module^.mainsource) then
        comment(v_info,'Start writing gas-styled assembler output for '+current_module^.mainsource^);
        comment(v_info,'Start writing gas-styled assembler output for '+current_module^.mainsource^);
 {$endif}
 {$endif}
+{$ifdef GDB}
       infile:=nil;
       infile:=nil;
       includecount:=0;
       includecount:=0;
-{$ifdef GDB}
       if assigned(current_module^.mainsource) then
       if assigned(current_module^.mainsource) then
        fsplit(current_module^.mainsource^,p,n,e)
        fsplit(current_module^.mainsource^,p,n,e)
       else
       else
@@ -570,42 +606,24 @@ ait_stab_function_name : funcname:=pai_stab_function_name(hp)^.str;
          AsmWriteLn('Ltext0:');
          AsmWriteLn('Ltext0:');
        end;
        end;
       infile:=current_module^.sourcefiles.files;
       infile:=current_module^.sourcefiles.files;
-{$endif GDB}
-
     { main source file is last in list }
     { main source file is last in list }
       while assigned(infile^._next) do
       while assigned(infile^._next) do
        infile:=infile^._next;
        infile:=infile^._next;
       lastline:=0;
       lastline:=0;
+{$endif GDB}
+
       { there should be nothing but externals so we don't need to process
       { there should be nothing but externals so we don't need to process
       WriteTree(externals); }
       WriteTree(externals); }
-      WriteTree(debuglist);
 
 
-    { code segment }
-      AsmWriteln('.text');
-{$ifdef GDB}
-      n_line:=n_textline;
-{$endif GDB}
+      WriteTree(debuglist);
       WriteTree(codesegment);
       WriteTree(codesegment);
-
-      AsmWriteLn('.data');
-{$ifdef EXTDEBUG}
-      AsmWriteLn(#9'.ascii'#9'"compiled by FPC '+version_string+'\0"');
-      AsmWriteLn(#9'.ascii'#9'"target: '+target_info.target_name+'\0"');
-{$endif EXTDEBUG}
-{$ifdef GDB}
-      n_line:=n_dataline;
-{$endif GDB}
-      DataSegment^.insert(new(pai_align,init(4)));
       WriteTree(datasegment);
       WriteTree(datasegment);
       WriteTree(consts);
       WriteTree(consts);
-
-    { makes problems with old GNU ASes
-      AsmWriteLn('.bss');
-      bssSegment^.insert(new(pai_align,init(4))); }
-{$ifdef GDB}
-      n_line:=n_bssline;
-{$endif GDB}
+      WriteTree(rttilist);
       WriteTree(bsssegment);
       WriteTree(bsssegment);
+      Writetree(importssection);
+      Writetree(exportssection);
+      Writetree(resourcesection);
 
 
       AsmLn;
       AsmLn;
 {$ifdef EXTDEBUG}
 {$ifdef EXTDEBUG}
@@ -617,73 +635,9 @@ ait_stab_function_name : funcname:=pai_stab_function_name(hp)^.str;
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.3  1998-05-23 01:20:57  peter
-    + aktasmmode, aktoptprocessor, aktoutputformat
-    + smartlink per module $SMARTLINK-/+ (like MMX) and moved to aktswitches
-    + $LIBNAME to set the library name where the unit will be put in
-    * splitted cgi386 a bit (codeseg to large for bp7)
-    * nasm, tasm works again. nasm moved to ag386nsm.pas
-
-  Revision 1.2  1998/04/29 10:33:42  pierre
-    + added some code for ansistring (not complete nor working yet)
-    * corrected operator overloading
-    * corrected nasm output
-    + started inline procedures
-    + added starstarn : use ** for exponentiation (^ gave problems)
-    + started UseTokenInfo cond to get accurate positions
-
-  Revision 1.1.1.1  1998/03/25 11:18:16  root
-  * Restored version
-
-  Revision 1.3  1998/03/22 12:45:37  florian
-    * changes of Carl-Eric to m68k target commit:
-      - wrong nodes because of the new string cg in intel, I had to create
-        this under m68k also ... had to work it out to fix potential alignment
-        problems --> this removes the crash of the m68k compiler.
-      - added absolute addressing in m68k assembler (required for Amiga startup)
-      - fixed alignment problems (because of byte return values, alignment
-        would not be always valid) -- is this ok if i change the offset if odd in
-        setfirsttemp ?? -- it seems ok...
-
-  Revision 1.2  1998/03/10 04:22:45  carl
-    - removed in because can cause range check errors in BP
-
-  Revision 1.1  1998/03/10 01:26:10  peter
-    + new uniform names
-
-  Revision 1.8  1998/03/09 12:58:11  peter
-    * FWait warning is only showed for Go32V2 and $E+
-    * opcode tables moved to i386.pas/m68k.pas to reduce circular uses (and
-      for m68k the same tables are removed)
-    + $E for i386
-
-  Revision 1.7  1998/03/06 00:52:25  peter
-    * replaced all old messages from errore.msg, only ExtDebug and some
-      Comment() calls are left
-    * fixed options.pas
-
-  Revision 1.6  1998/03/02 01:48:44  peter
-    * renamed target_DOS to target_GO32V1
-    + new verbose system, merged old errors and verbose units into one new
-      verbose.pas, so errors.pas is obsolete
-
-  Revision 1.5  1998/02/23 02:53:52  carl
-    * some bugfix with $extdebug
-
-  Revision 1.4  1998/02/22 23:03:19  peter
-    * renamed msource->mainsource and name->unitname
-    * optimized filename handling, filename is not seperate anymore with
-      path+name+ext, this saves stackspace and a lot of fsplit()'s
-    * recompiling of some units in libraries fixed
-    * shared libraries are working again
-    + $LINKLIB <lib> to support automatic linking to libraries
-    + libraries are saved/read from the ppufile, also allows more libraries
-      per ppufile
-
-  Revision 1.3  1998/02/22 21:56:29  carl
-    * bugfix of offset with index
-
-  Revision 1.2  1998/02/21 20:20:01  carl
-    * make it work under older versions of GAS
+  Revision 1.4  1998-06-04 23:51:29  peter
+    * m68k compiles
+    + .def file creation moved to gendef.pas so it could also be used
+      for win32
 
 
 }
 }

+ 47 - 66
compiler/ag68kmot.pas

@@ -64,14 +64,12 @@ unit ag68kmot;
         c  : comp;
         c  : comp;
         dd : pdouble;
         dd : pdouble;
       begin
       begin
-         c:=d;{ this generates a warning but this is not important }
-      {$ifndef TP}
-         {$warning The following warning can be ignored}
-      {$endif TP}
+         c:=comp(d);
          dd:=pdouble(@c); { this makes a bitwise copy of c into a double }
          dd:=pdouble(@c); { this makes a bitwise copy of c into a double }
          comp2str:=double2str(dd^);
          comp2str:=double2str(dd^);
       end;
       end;
 
 
+
     function getreferencestring(const ref : treference) : string;
     function getreferencestring(const ref : treference) : string;
       var
       var
          s : string;
          s : string;
@@ -238,6 +236,13 @@ unit ag68kmot;
                               TM68KMOTASMLIST
                               TM68KMOTASMLIST
  ****************************************************************************}
  ****************************************************************************}
 
 
+    var
+      LastSec : tsection;
+
+    const
+      section2str : array[tsection] of string[6]=
+       ('','CODE','DATA','BSS','');
+
     procedure tm68kmotasmlist.WriteTree(p:paasmoutput);
     procedure tm68kmotasmlist.WriteTree(p:paasmoutput);
     var
     var
       hp        : pai;
       hp        : pai;
@@ -246,16 +251,30 @@ unit ag68kmot;
       i,j,lines : longint;
       i,j,lines : longint;
       quoted    : boolean;
       quoted    : boolean;
     begin
     begin
+      if not assigned(p) then
+       exit;
       hp:=pai(p^.first);
       hp:=pai(p^.first);
       while assigned(hp) do
       while assigned(hp) do
        begin
        begin
          case hp^.typ of
          case hp^.typ of
-           ait_comment :
-             Begin
-                AsmWrite(As_comment);
-                AsmWritePChar(pai_asm_comment(hp)^.str);
-                AsmLn;
-             End;
+       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_align : AsmWriteLn(#9'CNOP 0,'+tostr(pai_align(hp)^.aligntype));
       ait_external : AsmWriteLn(#9'XREF'#9+StrPas(pai_external(hp)^.name));
       ait_external : AsmWriteLn(#9'XREF'#9+StrPas(pai_external(hp)^.name));
  ait_real_extended : Message(assem_e_extended_not_supported);
  ait_real_extended : Message(assem_e_extended_not_supported);
@@ -313,7 +332,7 @@ unit ag68kmot;
                        AsmWriteLn(#9#9'DC.S'#9+double2str(pai_single(hp)^.value));
                        AsmWriteLn(#9#9'DC.S'#9+double2str(pai_single(hp)^.value));
                      end;
                      end;
 { TO SUPPORT SOONER OR LATER!!!
 { TO SUPPORT SOONER OR LATER!!!
-    ait_comp       : AsmWriteLn(#9#9'DC.D'#9+comp2str(pai_extended(hp)^.value));}
+          ait_comp : AsmWriteLn(#9#9'DC.D'#9+comp2str(pai_extended(hp)^.value));}
         ait_string : begin
         ait_string : begin
                        counter := 0;
                        counter := 0;
                        lines := pai_string(hp)^.len div line_length;
                        lines := pai_string(hp)^.len div line_length;
@@ -351,7 +370,7 @@ unit ag68kmot;
                                    end;
                                    end;
                                 end; { end for i:=0 to... }
                                 end; { end for i:=0 to... }
                                 if quoted then AsmWrite('"');
                                 if quoted then AsmWrite('"');
-                                AsmWrite(target_info.newline);
+                                AsmLn;
                                 counter := counter+line_length;
                                 counter := counter+line_length;
                                end; { end for j:=0 ... }
                                end; { end for j:=0 ... }
                                { do last line of lines }
                                { do last line of lines }
@@ -476,10 +495,6 @@ ait_labeled_instruction :
          else
          else
           internalerror(10000);
           internalerror(10000);
          end;
          end;
-{         if ((hp^.typ<>ait_label) and (hp^.typ<>ait_symbol)) or (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
-         AsmLn}
          hp:=pai(hp^.next);
          hp:=pai(hp^.next);
        end;
        end;
     end;
     end;
@@ -490,29 +505,24 @@ ait_labeled_instruction :
       if assigned(current_module^.mainsource) then
       if assigned(current_module^.mainsource) then
        comment(v_info,'Start writing motorola-styled assembler output for '+current_module^.mainsource^);
        comment(v_info,'Start writing motorola-styled assembler output for '+current_module^.mainsource^);
 {$endif}
 {$endif}
-      WriteTree(externals);
 
 
-      AsmLn;
-      AsmWriteLn(#9'SECTION _CODE,CODE');
+      WriteTree(externals);
+    { WriteTree(debuglist);}
       WriteTree(codesegment);
       WriteTree(codesegment);
-
-      AsmLn;
-      AsmWriteLn(#9'SECTION _DATA,DATA');
-    { write a signature to the file }
-      AsmWriteLn(#9'CNOP 0,4');
-{$ifdef EXTDEBUG}
-      AsmWriteLn(#9'DC.B'#9'"compiled by FPC '+version_string+'\0"');
-      AsmWriteLn(#9'DC.B'#9'"target: '+target_info.target_name+'\0"');
-{$endif EXTDEBUG}
       WriteTree(datasegment);
       WriteTree(datasegment);
       WriteTree(consts);
       WriteTree(consts);
-
-      AsmLn;
-      AsmWriteLn(#9'SECTION _BSS,BSS');
+      WriteTree(rttilist);
       WriteTree(bsssegment);
       WriteTree(bsssegment);
+      Writetree(importssection);
+      Writetree(exportssection);
+      Writetree(resourcesection);
+
 
 
       AsmLn;
       AsmLn;
       AsmWriteLn(#9'END');
       AsmWriteLn(#9'END');
+      AsmLn;
+
+
 {$ifdef EXTDEBUG}
 {$ifdef EXTDEBUG}
       if assigned(current_module^.mainsource) then
       if assigned(current_module^.mainsource) then
        comment(v_info,'Done writing motorola-styled assembler output for '+current_module^.mainsource^);
        comment(v_info,'Done writing motorola-styled assembler output for '+current_module^.mainsource^);
@@ -522,38 +532,9 @@ ait_labeled_instruction :
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.3  1998-05-23 01:20:58  peter
-    + aktasmmode, aktoptprocessor, aktoutputformat
-    + smartlink per module $SMARTLINK-/+ (like MMX) and moved to aktswitches
-    + $LIBNAME to set the library name where the unit will be put in
-    * splitted cgi386 a bit (codeseg to large for bp7)
-    * nasm, tasm works again. nasm moved to ag386nsm.pas
-
-  Revision 1.2  1998/04/29 10:33:42  pierre
-    + added some code for ansistring (not complete nor working yet)
-    * corrected operator overloading
-    * corrected nasm output
-    + started inline procedures
-    + added starstarn : use ** for exponentiation (^ gave problems)
-    + started UseTokenInfo cond to get accurate positions
-
-  Revision 1.1.1.1  1998/03/25 11:18:16  root
-  * Restored version
-
-  Revision 1.3  1998/03/22 12:45:37  florian
-    * changes of Carl-Eric to m68k target commit:
-      - wrong nodes because of the new string cg in intel, I had to create
-        this under m68k also ... had to work it out to fix potential alignment
-        problems --> this removes the crash of the m68k compiler.
-      - added absolute addressing in m68k assembler (required for Amiga startup)
-      - fixed alignment problems (because of byte return values, alignment
-        would not be always valid) -- is this ok if i change the offset if odd in
-        setfirsttemp ?? -- it seems ok...
-
-  Revision 1.2  1998/03/10 04:23:33  carl
-    - removed in because can cause range check errors under BP
-
-  Revision 1.1  1998/03/10 01:26:10  peter
-    + new uniform names
-
-}
+  Revision 1.4  1998-06-04 23:51:30  peter
+    * m68k compiles
+    + .def file creation moved to gendef.pas so it could also be used
+      for win32
+
+}

+ 13 - 1
compiler/asmutils.pas

@@ -286,7 +286,10 @@ Type
   {*********************************************************************}
   {*********************************************************************}
   Function newpasstr(s: string): Pointer;
   Function newpasstr(s: string): Pointer;
   Procedure SetupResult(Var Instr:TInstruction; operandnum: byte);
   Procedure SetupResult(Var Instr:TInstruction; operandnum: byte);
+{$ifdef i386}
+
   Procedure FWaitWarning;
   Procedure FWaitWarning;
+{$endif}
 
 
   {---------------------------------------------------------------------}
   {---------------------------------------------------------------------}
   {                  Instruction generation routines                    }
   {                  Instruction generation routines                    }
@@ -1012,11 +1015,15 @@ end;
   end;
   end;
 
 
 
 
+{$ifdef i386}
+
   Procedure FWaitWarning;
   Procedure FWaitWarning;
   begin
   begin
     if (target_info.target=target_GO32V2) and (cs_fp_emulation in aktswitches) then
     if (target_info.target=target_GO32V2) and (cs_fp_emulation in aktswitches) then
      Message(assem_w_fwait_emu_prob);
      Message(assem_w_fwait_emu_prob);
   end;
   end;
+{$endif i386}
+
 
 
 
 
 
 
@@ -1621,7 +1628,12 @@ end;
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.3  1998-05-31 14:13:30  peter
+  Revision 1.4  1998-06-04 23:51:31  peter
+    * m68k compiles
+    + .def file creation moved to gendef.pas so it could also be used
+      for win32
+
+  Revision 1.3  1998/05/31 14:13:30  peter
     * fixed call bugs with assembler readers
     * fixed call bugs with assembler readers
     + OPR_SYMBOL to hold a symbol in the asm parser
     + OPR_SYMBOL to hold a symbol in the asm parser
     * fixed staticsymtable vars which were acessed through %ebp instead of
     * fixed staticsymtable vars which were acessed through %ebp instead of

+ 7 - 2
compiler/assemble.pas

@@ -159,7 +159,7 @@ begin
        end;
        end;
    end;
    end;
   if externasm then
   if externasm then
-   AsmRes.AddAsmCommand(command,para,asmfile);
+   AsmRes.AddAsmCommand(command,para,name);
   callassembler:=true;
   callassembler:=true;
 end;
 end;
 
 
@@ -416,7 +416,12 @@ end;
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.9  1998-05-23 01:21:01  peter
+  Revision 1.10  1998-06-04 23:51:33  peter
+    * m68k compiles
+    + .def file creation moved to gendef.pas so it could also be used
+      for win32
+
+  Revision 1.9  1998/05/23 01:21:01  peter
     + aktasmmode, aktoptprocessor, aktoutputformat
     + aktasmmode, aktoptprocessor, aktoutputformat
     + smartlink per module $SMARTLINK-/+ (like MMX) and moved to aktswitches
     + smartlink per module $SMARTLINK-/+ (like MMX) and moved to aktswitches
     + $LIBNAME to set the library name where the unit will be put in
     + $LIBNAME to set the library name where the unit will be put in

+ 69 - 26
compiler/cg68k.pas

@@ -40,8 +40,11 @@ interface
 
 
 uses    objects,verbose,cobjects,systems,globals,tree,
 uses    objects,verbose,cobjects,systems,globals,tree,
         symtable,types,strings,pass_1,hcodegen,
         symtable,types,strings,pass_1,hcodegen,
-        aasm,m68k,tgen68k,files,cga68k,cg68k2,gdb,link;
-
+        aasm,m68k,tgen68k,files,cga68k,cg68k2,link
+{$ifdef GDB}
+        ,gdb
+{$endif}
+        ;       
 { produces assembler for the expression in variable p }
 { produces assembler for the expression in variable p }
 { and produces an assembler node at the end           }
 { and produces an assembler node at the end           }
 procedure generatecode(var p : ptree);
 procedure generatecode(var p : ptree);
@@ -133,6 +136,24 @@ implementation
          codegenerror:=true;
          codegenerror:=true;
       end;
       end;
 
 
+    procedure secondstatement(var p : ptree);
+      var
+         hp : ptree;
+
+      begin
+         hp:=p;
+         while assigned(hp) do
+           begin
+              { assignments could be distance optimized }
+              if assigned(hp^.right) then
+                begin
+                   cleartempgen;
+                   secondpass(hp^.right);
+                end;
+              hp:=hp^.left;
+           end;
+      end;
+
     procedure secondload(var p : ptree);
     procedure secondload(var p : ptree);
 
 
       var
       var
@@ -390,7 +411,8 @@ implementation
 
 
               { on entering this section D1 should contain the divisor }
               { on entering this section D1 should contain the divisor }
 
 
-              if (opt_processors = MC68020) then
+              if (aktoptprocessor
+                = MC68020) then
               begin
               begin
                  if (p^.treetype = modn) then
                  if (p^.treetype = modn) then
                  Begin
                  Begin
@@ -1157,7 +1179,8 @@ implementation
                      exprasmlist^.concat(new(pai68k,op_const_reg(A_MULS,S_W,l1,ind)))
                      exprasmlist^.concat(new(pai68k,op_const_reg(A_MULS,S_W,l1,ind)))
                    else
                    else
                    { use long MC68020 long multiply }
                    { use long MC68020 long multiply }
-                   if (opt_processors = MC68020) then
+                   if (aktoptprocessor
+                    = MC68020) then
                      exprasmlist^.concat(new(pai68k,op_const_reg(A_MULS,S_L,l1,ind)))
                      exprasmlist^.concat(new(pai68k,op_const_reg(A_MULS,S_L,l1,ind)))
                    else
                    else
                    { MC68000 long multiply }
                    { MC68000 long multiply }
@@ -1433,8 +1456,8 @@ implementation
            if (cs_rangechecking in aktswitches)  and
            if (cs_rangechecking in aktswitches)  and
              { with $R+ explicit type conversations in TP aren't range checked! }
              { with $R+ explicit type conversations in TP aren't range checked! }
              (not(p^.explizit) or not(cs_tp_compatible in aktswitches)) and
              (not(p^.explizit) or not(cs_tp_compatible in aktswitches)) and
-             ((porddef(p1)^.von>porddef(p2)^.von) or
-             (porddef(p1)^.bis<porddef(p2)^.bis) or
+             ((porddef(p1)^.low>porddef(p2)^.low) or
+             (porddef(p1)^.high<porddef(p2)^.high) or
              (porddef(p1)^.typ=u32bit) or
              (porddef(p1)^.typ=u32bit) or
              (porddef(p2)^.typ=u32bit)) then
              (porddef(p2)^.typ=u32bit)) then
            begin
            begin
@@ -1461,7 +1484,7 @@ implementation
                      begin
                      begin
                          exprasmlist^.concat(new(pai68k,op_reg_reg(A_MOVE,S_B,p^.location.register,R_D6)));
                          exprasmlist^.concat(new(pai68k,op_reg_reg(A_MOVE,S_B,p^.location.register,R_D6)));
                          { byte to long }
                          { byte to long }
-                         if opt_processors = MC68020 then
+                         if aktoptprocessor = MC68020 then
                              exprasmlist^.concat(new(pai68k,op_reg(A_EXTB,S_L,R_D6)))
                              exprasmlist^.concat(new(pai68k,op_reg(A_EXTB,S_L,R_D6)))
                          else
                          else
                            begin
                            begin
@@ -1473,7 +1496,7 @@ implementation
                      begin
                      begin
                          exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_B,newreference(p^.location.reference),R_D6)));
                          exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_B,newreference(p^.location.reference),R_D6)));
                          { byte to long }
                          { byte to long }
-                         if opt_processors = MC68020 then
+                         if aktoptprocessor = MC68020 then
                              exprasmlist^.concat(new(pai68k,op_reg(A_EXTB,S_L,R_D6)))
                              exprasmlist^.concat(new(pai68k,op_reg(A_EXTB,S_L,R_D6)))
                          else
                          else
                            begin
                            begin
@@ -1523,7 +1546,7 @@ implementation
               new(hp);
               new(hp);
               reset_reference(hp^);
               reset_reference(hp^);
               hp^.symbol:=stringdup('R_'+tostr(porddef(p1)^.rangenr));
               hp^.symbol:=stringdup('R_'+tostr(porddef(p1)^.rangenr));
-              if porddef(p1)^.von>porddef(p1)^.bis then
+              if porddef(p1)^.low>porddef(p1)^.high then
                 begin
                 begin
                    getlabel(neglabel);
                    getlabel(neglabel);
                    getlabel(poslabel);
                    getlabel(poslabel);
@@ -1531,7 +1554,7 @@ implementation
                    emitl(A_BLT,neglabel);
                    emitl(A_BLT,neglabel);
                 end;
                 end;
               emit_bounds_check(hp^,hregister);
               emit_bounds_check(hp^,hregister);
-              if porddef(p1)^.von>porddef(p1)^.bis then
+              if porddef(p1)^.low>porddef(p1)^.high then
                 begin
                 begin
                    new(hp);
                    new(hp);
                    reset_reference(hp^);
                    reset_reference(hp^);
@@ -1614,10 +1637,10 @@ implementation
                                       tc_s8bit_2_u32bit,
                                       tc_s8bit_2_u32bit,
                                       tc_s8bit_2_s32bit:
                                       tc_s8bit_2_s32bit:
                                                   begin
                                                   begin
-                                                    if opt_processors = MC68020 then
+                                                    if aktoptprocessor = MC68020 then
                                                       exprasmlist^.concat(new(pai68k,op_reg
                                                       exprasmlist^.concat(new(pai68k,op_reg
                                                         (A_EXTB,S_L,hregister)))
                                                         (A_EXTB,S_L,hregister)))
-                                                    else { else if opt_processors }
+                                                    else { else if aktoptprocessor }
                                                     begin
                                                     begin
                                                     { byte to word }
                                                     { byte to word }
                                                       exprasmlist^.concat(new(pai68k,op_reg
                                                       exprasmlist^.concat(new(pai68k,op_reg
@@ -1871,7 +1894,7 @@ implementation
                    exprasmlist^.concat(new(pai68k, op_const_reg(A_AND, S_W, $FF, R_D6)));
                    exprasmlist^.concat(new(pai68k, op_const_reg(A_AND, S_W, $FF, R_D6)));
                    del_reference(p^.left^.location.reference);
                    del_reference(p^.left^.location.reference);
                 end;
                 end;
-              if (opt_processors = MC68020) then
+              if (aktoptprocessor = MC68020) then
               { alignment is not a problem on the 68020 and higher processors }
               { alignment is not a problem on the 68020 and higher processors }
                 Begin
                 Begin
                   { add length of string to word }
                   { add length of string to word }
@@ -2183,7 +2206,7 @@ implementation
                 s8bit : begin
                 s8bit : begin
                            exprasmlist^.concat(new(pai68k, op_ref_reg(A_MOVE,S_B,
                            exprasmlist^.concat(new(pai68k, op_ref_reg(A_MOVE,S_B,
                               newreference(p^.left^.location.reference),hregister)));
                               newreference(p^.left^.location.reference),hregister)));
-                           if opt_processors = MC68020 then
+                           if aktoptprocessor = MC68020 then
                               exprasmlist^.concat(new(pai68k, op_reg(A_EXTB,S_L,hregister)))
                               exprasmlist^.concat(new(pai68k, op_reg(A_EXTB,S_L,hregister)))
                            else
                            else
                             begin
                             begin
@@ -2235,8 +2258,8 @@ implementation
            (not(p^.explizit) or not(cs_tp_compatible in aktswitches)) and
            (not(p^.explizit) or not(cs_tp_compatible in aktswitches)) and
            (p^.resulttype^.deftype=orddef) and
            (p^.resulttype^.deftype=orddef) and
            (hp^.resulttype^.deftype=orddef) and
            (hp^.resulttype^.deftype=orddef) and
-           ((porddef(p^.resulttype)^.von>porddef(hp^.resulttype)^.von) or
-           (porddef(p^.resulttype)^.bis<porddef(hp^.resulttype)^.bis)) then
+           ((porddef(p^.resulttype)^.low>porddef(hp^.resulttype)^.low) or
+           (porddef(p^.resulttype)^.high<porddef(hp^.resulttype)^.high)) then
            begin
            begin
               porddef(p^.resulttype)^.genrangecheck;
               porddef(p^.resulttype)^.genrangecheck;
               if porddef(hp^.resulttype)^.typ=s32bit then
               if porddef(hp^.resulttype)^.typ=s32bit then
@@ -2309,7 +2332,7 @@ implementation
         emit_reg_reg(A_MOVE, S_L, R_A0, P^.location.register);
         emit_reg_reg(A_MOVE, S_L, R_A0, P^.location.register);
     end;
     end;
 
 
-   procedure second_bool_to_byte(p,hp : ptree;convtyp : tconverttype);
+   procedure second_bool_to_int(p,hp : ptree;convtyp : tconverttype);
 
 
       var
       var
          oldtruelabel,oldfalselabel,hlabel : plabel;
          oldtruelabel,oldfalselabel,hlabel : plabel;
@@ -2353,6 +2376,12 @@ implementation
          falselabel:=oldfalselabel;
          falselabel:=oldfalselabel;
      end;
      end;
 
 
+   procedure second_int_to_bool(p,hp : ptree;convtyp : tconverttype);
+     begin
+      { !!!!!!!!!!!!!!! }
+     end;
+
+
     procedure secondtypeconv(var p : ptree);
     procedure secondtypeconv(var p : ptree);
 
 
       const
       const
@@ -2375,7 +2404,8 @@ implementation
                               second_smaller,second_smaller,
                               second_smaller,second_smaller,
                               second_int_real,second_real_fix,
                               second_int_real,second_real_fix,
                               second_fix_real,second_int_fix,second_float_float,
                               second_fix_real,second_int_fix,second_float_float,
-                              second_chararray_to_string,second_bool_to_byte,
+                              second_bool_to_int,second_int_to_bool,
+                              second_chararray_to_string,
                               second_proc_to_procvar,
                               second_proc_to_procvar,
                               { is constant char to pchar, is done by firstpass }
                               { is constant char to pchar, is done by firstpass }
                               second_nothing);
                               second_nothing);
@@ -2386,7 +2416,7 @@ implementation
 
 
          { this is necessary, because second_bool_byte, have to change   }
          { this is necessary, because second_bool_byte, have to change   }
          { true- and false label before calling secondpass               }
          { true- and false label before calling secondpass               }
-         if p^.convtyp<>tc_bool_2_u8bit then
+         if p^.convtyp<>tc_bool_2_int then
          begin
          begin
            secondpass(p^.left);
            secondpass(p^.left);
            set_location(p^.location,p^.left^.location);
            set_location(p^.location,p^.left^.location);
@@ -3332,7 +3362,7 @@ implementation
               new(r);
               new(r);
               reset_reference(r^);
               reset_reference(r^);
               r^.symbol:=stringdup('U_'+upper(target_info.system_unit)+io[byte(doread)]);
               r^.symbol:=stringdup('U_'+upper(target_info.system_unit)+io[byte(doread)]);
-           if assem_need_external_list and not (cs_compilesystem in aktswitches) then
+           if not (cs_compilesystem in aktswitches) then
                  concat_external(r^.symbol^,EXT_NEAR);
                  concat_external(r^.symbol^,EXT_NEAR);
 
 
               exprasmlist^.concat(new(pai68k,op_ref_reg(A_LEA,S_L,r,R_A0)))
               exprasmlist^.concat(new(pai68k,op_ref_reg(A_LEA,S_L,r,R_A0)))
@@ -4798,6 +4828,10 @@ do_jmp:
             end;
             end;
        end;
        end;
 
 
+procedure secondprocinline(var p:ptree);
+begin
+end;
+
     procedure secondpass(var p : ptree);
     procedure secondpass(var p : ptree);
       const
       const
            procedures : array[ttreetyp] of secondpassproc =
            procedures : array[ttreetyp] of secondpassproc =
@@ -4815,12 +4849,12 @@ do_jmp:
              secondnot,secondinline,secondniln,seconderror,
              secondnot,secondinline,secondniln,seconderror,
              secondnothing,secondhnewn,secondhdisposen,secondnewn,
              secondnothing,secondhnewn,secondhdisposen,secondnewn,
              secondsimplenewdispose,secondnothing,secondsetcons,secondblockn,
              secondsimplenewdispose,secondnothing,secondsetcons,secondblockn,
-             secondnothing,secondnothing,secondifn,secondbreakn,
+             secondstatement,secondnothing,secondifn,secondbreakn,
              secondcontinuen,second_while_repeatn,second_while_repeatn,secondfor,
              secondcontinuen,second_while_repeatn,second_while_repeatn,secondfor,
              secondexitn,secondwith,secondcase,secondlabel,
              secondexitn,secondwith,secondcase,secondlabel,
              secondgoto,secondsimplenewdispose,secondtryexcept,secondraise,
              secondgoto,secondsimplenewdispose,secondtryexcept,secondraise,
              secondnothing,secondtryfinally,secondis,secondas,seconderror,
              secondnothing,secondtryfinally,secondis,secondas,seconderror,
-             secondfail,
+             secondfail,secondadd,secondprocinline,
              secondnothing,secondloadvmt);
              secondnothing,secondloadvmt);
       var
       var
          oldcodegenerror : boolean;
          oldcodegenerror : boolean;
@@ -4835,8 +4869,9 @@ do_jmp:
          oldnr:=current_module^.current_inputfile^.line_no;
          oldnr:=current_module^.current_inputfile^.line_no;
 
 
          codegenerror:=false;
          codegenerror:=false;
-         current_module^.current_inputfile:=p^.inputfile;
-         current_module^.current_inputfile^.line_no:=p^.line;
+         current_module^.current_inputfile:=
+           pinputfile(current_module^.sourcefiles.get_file(p^.fileinfo.fileindex));
+         current_module^.current_inputfile^.line_no:=p^.fileinfo.line;
          aktswitches:=p^.pragmas;
          aktswitches:=p^.pragmas;
          if not(p^.error) then
          if not(p^.error) then
            begin
            begin
@@ -4844,12 +4879,15 @@ do_jmp:
               p^.error:=codegenerror;
               p^.error:=codegenerror;
               codegenerror:=codegenerror or oldcodegenerror;
               codegenerror:=codegenerror or oldcodegenerror;
            end
            end
-         else codegenerror:=true;
+         else
+           codegenerror:=true;
          aktswitches:=oldswitches;
          aktswitches:=oldswitches;
          current_module^.current_inputfile:=oldis;
          current_module^.current_inputfile:=oldis;
          current_module^.current_inputfile^.line_no:=oldnr;
          current_module^.current_inputfile^.line_no:=oldnr;
       end;
       end;
 
 
+
+
     function do_secondpass(var p : ptree) : boolean;
     function do_secondpass(var p : ptree) : boolean;
 
 
       begin
       begin
@@ -5099,7 +5137,12 @@ end.
 
 
 {
 {
   $Log$
   $Log$
-  Revision 1.4  1998-04-29 10:33:44  pierre
+  Revision 1.5  1998-06-04 23:51:34  peter
+    * m68k compiles
+    + .def file creation moved to gendef.pas so it could also be used
+      for win32
+
+  Revision 1.4  1998/04/29 10:33:44  pierre
     + added some code for ansistring (not complete nor working yet)
     + added some code for ansistring (not complete nor working yet)
     * corrected operator overloading
     * corrected operator overloading
     * corrected nasm output
     * corrected nasm output

+ 12 - 7
compiler/cg68k2.pas

@@ -501,7 +501,7 @@ Implementation
                                          end
                                          end
                                        else
                                        else
                                          begin
                                          begin
-                                            if (op=A_MULS) and (opsize = S_L) and (opt_processors=MC68000) then
+                                            if (op=A_MULS) and (opsize = S_L) and (aktoptprocessor=MC68000) then
                                             { Emulation for MC68000 }
                                             { Emulation for MC68000 }
                                             begin
                                             begin
                                               emit_reg_reg(A_MOVE,opsize,p^.right^.location.register,
                                               emit_reg_reg(A_MOVE,opsize,p^.right^.location.register,
@@ -511,7 +511,7 @@ Implementation
                                               emit_reg_reg(A_MOVE,opsize,R_D0,p^.location.register);
                                               emit_reg_reg(A_MOVE,opsize,R_D0,p^.location.register);
                                             end
                                             end
                                             else
                                             else
-                                            if (op=A_MULU) and (opsize = S_L) and (opt_processors=MC68000) then
+                                            if (op=A_MULU) and (opsize = S_L) and (aktoptprocessor=MC68000) then
                                              Message(cg_f_32bit_not_supported_in_68000)
                                              Message(cg_f_32bit_not_supported_in_68000)
                                             else
                                             else
                                               emit_reg_reg(op,opsize,p^.right^.location.register,
                                               emit_reg_reg(op,opsize,p^.right^.location.register,
@@ -530,7 +530,7 @@ Implementation
                                          end
                                          end
                                        else
                                        else
                                          begin
                                          begin
-                                            if (op=A_MULS) and (opsize = S_L) and (opt_processors=MC68000) then
+                                            if (op=A_MULS) and (opsize = S_L) and (aktoptprocessor=MC68000) then
                                             { Emulation for MC68000 }
                                             { Emulation for MC68000 }
                                             begin
                                             begin
                                               exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE, opsize,
                                               exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE, opsize,
@@ -540,7 +540,7 @@ Implementation
                                               emit_reg_reg(A_MOVE,opsize,R_D0,p^.location.register);
                                               emit_reg_reg(A_MOVE,opsize,R_D0,p^.location.register);
                                             end
                                             end
                                             else
                                             else
-                                            if (op=A_MULU) and (opsize = S_L) and (opt_processors=MC68000) then
+                                            if (op=A_MULU) and (opsize = S_L) and (aktoptprocessor=MC68000) then
                                              Message(cg_f_32bit_not_supported_in_68000)
                                              Message(cg_f_32bit_not_supported_in_68000)
                                             else
                                             else
                                               exprasmlist^.concat(new(pai68k,op_ref_reg(op,opsize,newreference(
                                               exprasmlist^.concat(new(pai68k,op_ref_reg(op,opsize,newreference(
@@ -571,7 +571,7 @@ Implementation
                              if extra_not then
                              if extra_not then
                                    exprasmlist^.concat(new(pai68k,op_reg(A_NOT,S_L,p^.right^.location.register)));
                                    exprasmlist^.concat(new(pai68k,op_reg(A_NOT,S_L,p^.right^.location.register)));
 
 
-                             if (op=A_MULS) and (opsize = S_L) and (opt_processors=MC68000) then
+                             if (op=A_MULS) and (opsize = S_L) and (aktoptprocessor=MC68000) then
                              { Emulation for MC68000 }
                              { Emulation for MC68000 }
                              begin
                              begin
                                emit_reg_reg(A_MOVE,opsize,p^.right^.location.register,
                                emit_reg_reg(A_MOVE,opsize,p^.right^.location.register,
@@ -581,7 +581,7 @@ Implementation
                                emit_reg_reg(A_MOVE,opsize,R_D0,p^.location.register);
                                emit_reg_reg(A_MOVE,opsize,R_D0,p^.location.register);
                              end
                              end
                              else
                              else
-                             if (op=A_MULU) and (opsize = S_L) and (opt_processors=MC68000) then
+                             if (op=A_MULU) and (opsize = S_L) and (aktoptprocessor=MC68000) then
                               Message(cg_f_32bit_not_supported_in_68000)
                               Message(cg_f_32bit_not_supported_in_68000)
                              else
                              else
 
 
@@ -1921,7 +1921,12 @@ Implementation
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.3  1998-04-29 10:33:45  pierre
+  Revision 1.4  1998-06-04 23:51:35  peter
+    * m68k compiles
+    + .def file creation moved to gendef.pas so it could also be used
+      for win32
+
+  Revision 1.3  1998/04/29 10:33:45  pierre
     + added some code for ansistring (not complete nor working yet)
     + added some code for ansistring (not complete nor working yet)
     * corrected operator overloading
     * corrected operator overloading
     * corrected nasm output
     * corrected nasm output

+ 29 - 25
compiler/cga68k.pas

@@ -62,18 +62,20 @@ unit cga68k;
     procedure generate_interrupt_stackframe_entry;
     procedure generate_interrupt_stackframe_entry;
     procedure generate_interrupt_stackframe_exit;
     procedure generate_interrupt_stackframe_exit;
     { generate entry code for a procedure.}
     { generate entry code for a procedure.}
-    procedure genentrycode(const proc_names:Tstringcontainer;make_global:boolean;
+    procedure genentrycode(list : paasmoutput;const proc_names:Tstringcontainer;make_global:boolean;
                            stackframe:longint;
                            stackframe:longint;
-                           var parasize:longint;var nostackframe:boolean);
+                           var parasize:longint;var nostackframe:boolean;
+                           inlined : boolean);
     { generate the exit code for a procedure. }
     { generate the exit code for a procedure. }
-    procedure genexitcode(parasize:longint;nostackframe:boolean);
+    procedure genexitcode(list : paasmoutput;parasize:longint;
+                          nostackframe,inlined:boolean);
 
 
 
 
   implementation
   implementation
 
 
     uses
     uses
        systems,globals,verbose,files,types,pbase,
        systems,globals,verbose,files,types,pbase,
-       tgenm68k,hcodegen
+       tgen68k,hcodegen
 {$ifdef GDB}
 {$ifdef GDB}
        ,gdb
        ,gdb
 {$endif}
 {$endif}
@@ -147,7 +149,7 @@ unit cga68k;
                                     A_MOVE,S_L,newreference(p^.right^.location.reference),R_D0)));
                                     A_MOVE,S_L,newreference(p^.right^.location.reference),R_D0)));
                                  del_reference(p^.right^.location.reference);
                                  del_reference(p^.right^.location.reference);
                               end;
                               end;
-                            if (opt_processors = MC68020) then
+                            if (aktoptprocessor = MC68020) then
                              { alignment is not a problem on the 68020 and higher processors }
                              { alignment is not a problem on the 68020 and higher processors }
                               Begin
                               Begin
                                { add length of string to word }
                                { add length of string to word }
@@ -212,8 +214,6 @@ unit cga68k;
 
 
       var
       var
          pushed : boolean;
          pushed : boolean;
-         {hregister : tregister; }
-         reg: tregister;
       begin
       begin
          if needed>usablereg32 then
          if needed>usablereg32 then
            begin
            begin
@@ -251,7 +251,7 @@ unit cga68k;
      var
      var
       hl : plabel;
       hl : plabel;
      begin
      begin
-        if (opt_processors = MC68020) then
+        if (aktoptprocessor = MC68020) then
           begin
           begin
              exprasmlist^.concat(new(pai68k, op_ref_reg(A_CMP2,S_L,newreference(hp),index)));
              exprasmlist^.concat(new(pai68k, op_ref_reg(A_CMP2,S_L,newreference(hp),index)));
              getlabel(hl);
              getlabel(hl);
@@ -307,7 +307,7 @@ unit cga68k;
 
 
      begin
      begin
         exprasmlist^.concat(new(pai68k,op_csymbol(A_JSR,S_NO,newcsymbol(routine,0))));
         exprasmlist^.concat(new(pai68k,op_csymbol(A_JSR,S_NO,newcsymbol(routine,0))));
-        if assem_need_external_list and add_to_externals and
+        if add_to_externals and
            not (cs_compilesystem in aktswitches) then
            not (cs_compilesystem in aktswitches) then
           concat_external(routine,EXT_NEAR);
           concat_external(routine,EXT_NEAR);
      end;
      end;
@@ -378,7 +378,7 @@ unit cga68k;
     procedure push_int(l : longint);
     procedure push_int(l : longint);
 
 
       begin
       begin
-         if (l = 0) and (opt_processors = MC68020) then
+         if (l = 0) and (aktoptprocessor = MC68020) then
            begin
            begin
           exprasmlist^.concat(new(pai68k,op_reg(A_CLR,S_L,R_D6)));
           exprasmlist^.concat(new(pai68k,op_reg(A_CLR,S_L,R_D6)));
               exprasmlist^.concat(new(pai68k,op_reg_reg(A_MOVE,S_L,
               exprasmlist^.concat(new(pai68k,op_reg_reg(A_MOVE,S_L,
@@ -443,10 +443,11 @@ unit cga68k;
          { restore the registers of an interrupt procedure }
          { restore the registers of an interrupt procedure }
       end;
       end;
 
 
-procedure genentrycode(const proc_names:Tstringcontainer;make_global:boolean;
-                       stackframe:longint;
-                       var parasize:longint;var nostackframe:boolean);
 
 
+    procedure genentrycode(list : paasmoutput;const proc_names:Tstringcontainer;make_global:boolean;
+                           stackframe:longint;
+                           var parasize:longint;var nostackframe:boolean;
+                           inlined : boolean);
 {Generates the entry code for a procedure.}
 {Generates the entry code for a procedure.}
 
 
 var hs:string;
 var hs:string;
@@ -476,8 +477,8 @@ begin
                     { call the unit init code and make it external }
                     { call the unit init code and make it external }
                     if (hp^.u^.flags and uf_init)<>0 then
                     if (hp^.u^.flags and uf_init)<>0 then
                         begin
                         begin
-                           unitinits.concat(new(pai68k,op_csymbol(A_JSR,S_NO,newcsymbol('INIT$$'+hp^.u^.unitname^,0))));
-                           externals^.concat(new(pai_external,init('INIT$$'+hp^.u^.unitname^,EXT_NEAR)));
+                           unitinits.concat(new(pai68k,op_csymbol(A_JSR,S_NO,newcsymbol('INIT$$'+hp^.u^.modulename^,0))));
+                           concat_external('INIT$$'+hp^.u^.modulename^,EXT_NEAR);
                         end;
                         end;
                    hp:=pused_unit(hp^.next);
                    hp:=pused_unit(hp^.next);
                 end;
                 end;
@@ -583,8 +584,7 @@ begin
     hs:=proc_names.get;
     hs:=proc_names.get;
 
 
 {$IfDef GDB}
 {$IfDef GDB}
-    if (cs_debuginfo in aktswitches) and
-     target_info.use_function_relative_addresses then
+    if (cs_debuginfo in aktswitches) and target_os.use_function_relative_addresses then
         stab_function_name := new(pai_stab_function_name,init(strpnew(hs)));
         stab_function_name := new(pai_stab_function_name,init(strpnew(hs)));
       oldaktprocname:=aktprocsym^.name;
       oldaktprocname:=aktprocsym^.name;
 {$EndIf GDB}
 {$EndIf GDB}
@@ -598,7 +598,7 @@ begin
                 procinfo.aktentrycode^.insert(new(pai_symbol,init(hs)));
                 procinfo.aktentrycode^.insert(new(pai_symbol,init(hs)));
 {$ifdef GDB}
 {$ifdef GDB}
             if (cs_debuginfo in aktswitches) and
             if (cs_debuginfo in aktswitches) and
-             target_info.use_function_relative_addresses then
+               target_os.use_function_relative_addresses then
             begin
             begin
             procinfo.aktentrycode^.insert(new(pai_stab_function_name,init(strpnew(hs))));
             procinfo.aktentrycode^.insert(new(pai_stab_function_name,init(strpnew(hs))));
               { This is not a nice solution to save the name, change it and restore when done }
               { This is not a nice solution to save the name, change it and restore when done }
@@ -613,7 +613,7 @@ begin
 
 
     if (cs_debuginfo in aktswitches) then
     if (cs_debuginfo in aktswitches) then
         begin
         begin
-            if target_info.use_function_relative_addresses then
+            if target_os.use_function_relative_addresses then
                 procinfo.aktentrycode^.insert(stab_function_name);
                 procinfo.aktentrycode^.insert(stab_function_name);
             if make_global or ((procinfo.flags and pi_is_global) <> 0) then
             if make_global or ((procinfo.flags and pi_is_global) <> 0) then
                 aktprocsym^.is_global := True;
                 aktprocsym^.is_global := True;
@@ -632,8 +632,7 @@ begin
 end;
 end;
 
 
 {Generate the exit code for a procedure.}
 {Generate the exit code for a procedure.}
-procedure genexitcode(parasize:longint;nostackframe:boolean);
-
+procedure genexitcode(list : paasmoutput;parasize:longint; nostackframe,inlined:boolean);
 var hr:Preference;          {This is for function results.}
 var hr:Preference;          {This is for function results.}
     op:Tasmop;
     op:Tasmop;
     s:Topsize;
     s:Topsize;
@@ -756,7 +755,7 @@ begin
         else
         else
             { return with immediate size possible here }
             { return with immediate size possible here }
             { signed!                                  }
             { signed!                                  }
-            if (opt_processors = MC68020) and (parasize < $7FFF) then
+            if (aktoptprocessor = MC68020) and (parasize < $7FFF) then
                 procinfo.aktexitcode^.concat(new(pai68k,op_const(
                 procinfo.aktexitcode^.concat(new(pai68k,op_const(
                  A_RTD,S_NO,parasize)))
                  A_RTD,S_NO,parasize)))
             { manually restore the stack }
             { manually restore the stack }
@@ -941,7 +940,7 @@ end;
                                end;
                                end;
                         s8bit: begin
                         s8bit: begin
                                  exprasmlist^.concat(new(pai68k,op_reg_reg(A_MOVE,S_B,location.register,destreg)));
                                  exprasmlist^.concat(new(pai68k,op_reg_reg(A_MOVE,S_B,location.register,destreg)));
-                                 if (opt_processors <> MC68020) then
+                                 if (aktoptprocessor <> MC68020) then
                                   begin
                                   begin
                                  { byte to word }
                                  { byte to word }
                                      exprasmlist^.concat(new(pai68k,op_reg(A_EXT,S_W,destreg)));
                                      exprasmlist^.concat(new(pai68k,op_reg(A_EXT,S_W,destreg)));
@@ -978,7 +977,7 @@ end;
                                end;
                                end;
                         s8bit:  begin
                         s8bit:  begin
                                  exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_B,r,destreg)));
                                  exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_B,r,destreg)));
-                                 if (opt_processors <> MC68020) then
+                                 if (aktoptprocessor <> MC68020) then
                                   begin
                                   begin
                                  { byte to word }
                                  { byte to word }
                                      exprasmlist^.concat(new(pai68k,op_reg(A_EXT,S_W,destreg)));
                                      exprasmlist^.concat(new(pai68k,op_reg(A_EXT,S_W,destreg)));
@@ -1217,7 +1216,12 @@ end;
   end.
   end.
 {
 {
   $Log$
   $Log$
-  Revision 1.4  1998-05-07 00:17:00  peter
+  Revision 1.5  1998-06-04 23:51:36  peter
+    * m68k compiles
+    + .def file creation moved to gendef.pas so it could also be used
+      for win32
+
+  Revision 1.4  1998/05/07 00:17:00  peter
     * smartlinking for sets
     * smartlinking for sets
     + consts labels are now concated/generated in hcodegen
     + consts labels are now concated/generated in hcodegen
     * moved some cpu code to cga and some none cpu depended code from cga
     * moved some cpu code to cga and some none cpu depended code from cga

+ 6 - 9
compiler/cgi386.pas

@@ -3746,14 +3746,6 @@ implementation
                 begin
                 begin
                    cleartempgen;
                    cleartempgen;
                    secondpass(hp^.right);
                    secondpass(hp^.right);
-                   (* if (hp^.right^.resulttype<>pdef(voiddef)) then
-                     if hp^.right^.location.loc in [LOC_MEM,LOC_REFERENCE] then
-                     { release unused temp }
-                       ungetiftemp(hp^.right^.location.reference)
-                     else if hp^.right^.location.loc=LOC_FPU then
-                     { release FPU stack }
-                       exprasmlist^.concat(new(pai386,op_none(A_FDECSTP,S_NO)));
-                     All done in secondcalln now (PM) *)
                 end;
                 end;
               hp:=hp^.left;
               hp:=hp^.left;
            end;
            end;
@@ -5061,7 +5053,12 @@ do_jmp:
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.32  1998-06-04 09:55:35  pierre
+  Revision 1.33  1998-06-04 23:51:37  peter
+    * m68k compiles
+    + .def file creation moved to gendef.pas so it could also be used
+      for win32
+
+  Revision 1.32  1998/06/04 09:55:35  pierre
     * demangled name of procsym reworked to become independant of the mangling scheme
     * demangled name of procsym reworked to become independant of the mangling scheme
 
 
   Come test_funcret improvements (not yet working)S: ----------------------------------------------------------------------
   Come test_funcret improvements (not yet working)S: ----------------------------------------------------------------------

+ 86 - 4
compiler/cws.txt

@@ -1,11 +1,93 @@
 Compiler Writer's Guide
 Compiler Writer's Guide
 -----------------------
 -----------------------
 Here are a few tips for changing things in the compiler:
 Here are a few tips for changing things in the compiler:
-(by FK mostly)
 
 
-  - Assigned should be used instead of checking for nil directly, as 
-it can help solving pointer problems when in real mode.
+  - Assigned should be used instead of checking for nil directly, as
+
+    it can help solving pointer problems when in real mode.
   - All compiler files should be saved in UNIX format
   - All compiler files should be saved in UNIX format
- 
 
 
 
 
+
+
+Location of the codegenerator functions
+---------------------------------------
+
+The names are given for the i386, for the m68k rename the 386 to 68k
+
+cg386con - Constant generation
+ - secondordconst
+ - secondrealconst
+ - secondstringconst
+ - secondfixconst
+ - secondsetconst
+ - secondniln
+
+
+cg386mat - Mathematic functions
+ - secondmoddiv
+ - secondshlshr
+ - secondumminus
+ - secondnot
+
+cg386cnv - Type conversion functions
+ - secondtypeconv
+
+
+cg386add - Add/concat functions
+ - secondadd
+
+
+cg386mem - Memory functions
+  - secondvecn
+  - secondaddr
+  - seconddoubleaddr
+  - secondsimplenewdispose
+  - secondhnewn
+  - secondhdisposen
+  - secondselfn
+  - secondwith
+  - secondloadvmt
+  - secondsubscriptn
+  - secondderef
+  - secondis
+  - secondas
+
+
+cg386flw - Flow functions
+  - secondifn
+  - second_while_repeatn
+  - secondfor
+  - secondcontinuen
+  - secondbreakn
+  - secondexitn
+  - secondlabel
+  - secondgoto
+  - secondtryfinally
+  - secondtryexcept
+  - secondraise
+  - secondfail
+
+cg386ld - Load/Store functions
+  - secondload
+  - secondassignment
+  - secondfuncret
+
+
+cg386set - Set functions
+  - secondcase
+  - secondin
+
+cg386cal - Call/inline functions
+  - secondparacall
+  - secondcall
+  - secondprocinline
+  - secondinline
+
+cgi386 - Main secondpass handling
+  - secondnothing
+  - seconderror
+  - secondasm,
+  - secondblockn,
+  - secondstatement,
+       

+ 144 - 0
compiler/gendef.pas

@@ -0,0 +1,144 @@
+{
+    $Id$
+    Copyright (c) 1996-98 by Florian Klaempfl
+
+    Generation of a .def file for needed for Os2/Win32
+
+    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 gendef;
+interface
+uses cobjects;
+
+type
+  pdeffile=^tdeffile;
+  tdeffile=object
+    fname       : string;
+    exportlist,
+    importlist  : tstringcontainer;
+    constructor init(const fn:string);
+    destructor  done;
+    procedure addexport(const s:string);
+    procedure addimport(const s:string);
+    procedure writefile;
+  end;
+var
+  deffile : tdeffile;
+
+
+implementation
+
+uses
+  systems,globals;
+
+{******************************************************************************
+                               TDefFile
+******************************************************************************}
+
+constructor tdeffile.init(const fn:string);
+begin
+  fname:=fn;
+  importlist.init;
+  exportlist.init;
+end;
+
+
+destructor tdeffile.done;
+begin
+  importlist.done;
+  exportlist.done;
+end;
+
+
+
+procedure tdeffile.addexport(const s:string);
+begin
+  exportlist.insert(s);
+end;
+
+
+procedure tdeffile.addimport(const s:string);
+begin
+  importlist.insert(s);
+end;
+
+
+procedure tdeffile.writefile;
+var
+  t : text;
+begin
+  assign(t,fname);
+  {$I+}
+   rewrite(t);
+  {$I-}
+  if ioresult<>0 then
+   exit;
+{$ifdef i386}
+
+  case target_info.target of
+   target_Os2 : begin
+
+                  write(t,'NAME '+inputfile);
+                  if usewindowapi then
+                   write(t,' WINDOWAPI');
+                  writeln(t,'');
+
+                  writeln(t,'PROTMODE');
+                  writeln(t,'DESCRIPTION '+''''+description+'''');
+                  writeln(t,'DATA'#9'MULTIPLE');
+                  writeln(t,'STACKSIZE'#9+tostr(stacksize));
+                  writeln(t,'HEAPSIZE'#9+tostr(heapsize));
+                end;
+
+  end;
+{$endif}
+
+{write imports}
+
+  if not importlist.empty then
+   begin
+     writeln(t,'');
+
+     writeln(t,'IMPORTS');
+     while not importlist.empty do
+      writeln(t,#9+importlist.get);
+   end;
+
+{write exports}
+
+  if not exportlist.empty then
+   begin
+     writeln(t,'');
+
+     writeln(t,'EXPORTS');
+     while not exportlist.empty do
+      writeln(t,#9+exportlist.get);
+   end;
+
+  close(t);
+end;
+
+end.
+{
+  $Log$
+  Revision 1.1  1998-06-04 23:51:39  peter
+    * m68k compiles
+    + .def file creation moved to gendef.pas so it could also be used
+      for win32
+
+}
+  

+ 9 - 4
compiler/hcodegen.pas

@@ -356,7 +356,7 @@ implementation
       { we must use the number directly !!! (PM) }
       { we must use the number directly !!! (PM) }
     function constlabel2str(l : plabel;ctype:tconsttype):string;
     function constlabel2str(l : plabel;ctype:tconsttype):string;
       begin
       begin
-        if (cs_smartlink in aktswitches) or (aktoutputformat in [as_tasm]) then
+        if (cs_smartlink in aktswitches) {or (aktoutputformat in [as_tasm])} then
          constlabel2str:='_$'+current_module^.modulename^+'$'+consttypestr[ctype]+'_const_'+tostr(l^.nb)
          constlabel2str:='_$'+current_module^.modulename^+'$'+consttypestr[ctype]+'_const_'+tostr(l^.nb)
         else
         else
          constlabel2str:=lab2str(l);
          constlabel2str:=lab2str(l);
@@ -364,7 +364,7 @@ implementation
 
 
     function constlabelnb2str(pnb : longint;ctype:tconsttype):string;
     function constlabelnb2str(pnb : longint;ctype:tconsttype):string;
       begin
       begin
-        if (cs_smartlink in aktswitches) or (aktoutputformat in [as_tasm]) then
+        if (cs_smartlink in aktswitches) {or (aktoutputformat in [as_tasm])} then
          constlabelnb2str:='_$'+current_module^.modulename^+'$'+consttypestr[ctype]+'_const_'+tostr(pnb)
          constlabelnb2str:='_$'+current_module^.modulename^+'$'+consttypestr[ctype]+'_const_'+tostr(pnb)
         else
         else
          constlabelnb2str:=target_asm.labelprefix+tostr(pnb);
          constlabelnb2str:=target_asm.labelprefix+tostr(pnb);
@@ -375,7 +375,7 @@ implementation
       var
       var
         s : string;
         s : string;
       begin
       begin
-        if (cs_smartlink in aktswitches) or (aktoutputformat in [as_tasm]) then
+        if (cs_smartlink in aktswitches) {or (aktoutputformat in [as_tasm])} then
          begin
          begin
            s:='_$'+current_module^.modulename^+'$'+consttypestr[ctype]+'_const_'+tostr(p^.nb);
            s:='_$'+current_module^.modulename^+'$'+consttypestr[ctype]+'_const_'+tostr(p^.nb);
            if (cs_smartlink in aktswitches) then
            if (cs_smartlink in aktswitches) then
@@ -394,7 +394,12 @@ end.
 
 
 {
 {
   $Log$
   $Log$
-  Revision 1.7  1998-06-04 09:55:38  pierre
+  Revision 1.8  1998-06-04 23:51:40  peter
+    * m68k compiles
+    + .def file creation moved to gendef.pas so it could also be used
+      for win32
+
+  Revision 1.7  1998/06/04 09:55:38  pierre
     * demangled name of procsym reworked to become independant of the mangling scheme
     * demangled name of procsym reworked to become independant of the mangling scheme
 
 
   Come test_funcret improvements (not yet working)S: ----------------------------------------------------------------------
   Come test_funcret improvements (not yet working)S: ----------------------------------------------------------------------

+ 6 - 2
compiler/i386.pas

@@ -444,7 +444,6 @@ unit i386;
 
 
     var
     var
        ins_cache : tins_cache;
        ins_cache : tins_cache;
-       exprasmlist : paasmoutput;
 
 
     const
     const
        it : array[0..440] of ttemplate = (
        it : array[0..440] of ttemplate = (
@@ -1714,7 +1713,12 @@ unit i386;
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.8  1998-05-23 01:21:09  peter
+  Revision 1.9  1998-06-04 23:51:41  peter
+    * m68k compiles
+    + .def file creation moved to gendef.pas so it could also be used
+      for win32
+
+  Revision 1.8  1998/05/23 01:21:09  peter
     + aktasmmode, aktoptprocessor, aktoutputformat
     + aktasmmode, aktoptprocessor, aktoutputformat
     + smartlink per module $SMARTLINK-/+ (like MMX) and moved to aktswitches
     + smartlink per module $SMARTLINK-/+ (like MMX) and moved to aktswitches
     + $LIBNAME to set the library name where the unit will be put in
     + $LIBNAME to set the library name where the unit will be put in

+ 20 - 3
compiler/import.pas

@@ -60,8 +60,14 @@ procedure InitImport;
 implementation
 implementation
 
 
 uses
 uses
-  systems,verbose,
-  os2_targ,win_targ;
+  systems,verbose
+{$ifdef i386}
+
+  ,os2_targ
+  ,win_targ
+{$endif}
+
+  ;
 
 
 {****************************************************************************
 {****************************************************************************
                            TImported_procedure
                            TImported_procedure
@@ -135,18 +141,29 @@ end;
 
 
 procedure InitImport;
 procedure InitImport;
 begin
 begin
+{$ifdef i386}
+
   case target_info.target of
   case target_info.target of
  target_Win32 : importlib:=new(pimportlibwin32,Init);
  target_Win32 : importlib:=new(pimportlibwin32,Init);
    target_OS2 : importlib:=new(pimportlibos2,Init);
    target_OS2 : importlib:=new(pimportlibos2,Init);
   else
   else
    importlib:=new(pimportlib,Init);
    importlib:=new(pimportlib,Init);
   end;
   end;
+{$endif i386}
+{$ifdef m68k}
+  importlib:=new(pimportlib,Init);
+{$endif m68k}
 end;
 end;
 
 
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.2  1998-04-27 23:10:28  peter
+  Revision 1.3  1998-06-04 23:51:43  peter
+    * m68k compiles
+    + .def file creation moved to gendef.pas so it could also be used
+      for win32
+
+  Revision 1.2  1998/04/27 23:10:28  peter
     + new scanner
     + new scanner
     * $makelib -> if smartlink
     * $makelib -> if smartlink
     * small filename fixes pmodule.setfilename
     * small filename fixes pmodule.setfilename

+ 48 - 7
compiler/link.pas

@@ -34,6 +34,7 @@ Type
        ObjectFiles,
        ObjectFiles,
        SharedLibFiles,
        SharedLibFiles,
        StaticLibFiles    : TStringContainer;
        StaticLibFiles    : TStringContainer;
+       OutputName,
        LibrarySearchPath,                 { Search path for libraries }
        LibrarySearchPath,                 { Search path for libraries }
        ExeName,                           { FileName of the exe to be created }
        ExeName,                           { FileName of the exe to be created }
        SharedLibName,
        SharedLibName,
@@ -44,6 +45,7 @@ Type
      { Methods }
      { Methods }
        Constructor Init;
        Constructor Init;
        Destructor Done;
        Destructor Done;
+       Procedure SetOutputName(const s:string);
        Procedure SetExeName(const s:string);
        Procedure SetExeName(const s:string);
        Procedure SetLibName(const s:string);
        Procedure SetLibName(const s:string);
        function  FindObjectFile(s : string) : string;
        function  FindObjectFile(s : string) : string;
@@ -99,6 +101,7 @@ begin
   Strip:=false;
   Strip:=false;
   LinkOptions:='';
   LinkOptions:='';
   ExeName:='';
   ExeName:='';
+  OutputName:='';
   SharedLibName:='';
   SharedLibName:='';
   StaticLibName:='';
   StaticLibName:='';
   ObjectSearchPath:='';
   ObjectSearchPath:='';
@@ -117,14 +120,25 @@ begin
 end;
 end;
 
 
 
 
+Procedure TLinker.SetOutputName(const s:string);
+begin
+  OutputName:=s;
+end;
+
+
 Procedure TLinker.SetExeName(const s:string);
 Procedure TLinker.SetExeName(const s:string);
 var
 var
   path : dirstr;
   path : dirstr;
   name : namestr;
   name : namestr;
   ext  : extstr;
   ext  : extstr;
 begin
 begin
-  FSplit(s,path,name,ext);
-  ExeName:=Path+Name+target_info.ExeExt;
+  if OutputName='' then
+   begin
+     FSplit(s,path,name,ext);
+     ExeName:=Path+Name+target_info.ExeExt;
+   end
+  else
+   ExeName:=OutputName;
 end;
 end;
 
 
 
 
@@ -134,9 +148,17 @@ var
   name : namestr;
   name : namestr;
   ext  : extstr;
   ext  : extstr;
 begin
 begin
-  FSplit(s,path,name,ext);
-  SharedLibName:=Path+Name+target_os.SharedLibExt;
-  StaticLibName:=Path+Name+target_os.StaticLibExt;
+  if OutputName='' then
+   begin
+     FSplit(s,path,name,ext);
+     SharedLibName:=Path+Name+target_os.SharedLibExt;
+     StaticLibName:=Path+Name+target_os.StaticLibExt;
+   end
+  else
+   begin
+     SharedLibName:=OutputName;
+     StaticLibName:=OutputName;
+   end;
 end;
 end;
 
 
 
 
@@ -261,6 +283,8 @@ begin
 { set special options for some targets }
 { set special options for some targets }
   prtobj:='prt0';
   prtobj:='prt0';
   case target_info.target of
   case target_info.target of
+{$ifdef i386}
+
    target_Win32 : prtobj:='';
    target_Win32 : prtobj:='';
    target_linux : begin
    target_linux : begin
                     if cs_profile in aktswitches then
                     if cs_profile in aktswitches then
@@ -270,6 +294,18 @@ begin
                        AddSharedLibrary('c');
                        AddSharedLibrary('c');
                      end;
                      end;
                   end;
                   end;
+{$endif i386}
+{$ifdef m68k}
+   target_linux : begin
+                    if cs_profile in aktswitches then
+                     begin
+                       prtobj:='gprt0';
+                       AddSharedLibrary('gmon');
+                       AddSharedLibrary('c');
+                     end;
+                  end;
+{$endif}                
+
   end;
   end;
 
 
 { Fix command line options }
 { Fix command line options }
@@ -338,7 +374,7 @@ begin
 end;
 end;
 
 
 
 
-Function TLinker.MakeExecutable:boolean;
+function TLinker.MakeExecutable:boolean;
 var
 var
   bindbin    : string[80];
   bindbin    : string[80];
   bindfound  : boolean;
   bindfound  : boolean;
@@ -439,7 +475,12 @@ end;
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.11  1998-05-27 00:20:31  peter
+  Revision 1.12  1998-06-04 23:51:44  peter
+    * m68k compiles
+    + .def file creation moved to gendef.pas so it could also be used
+      for win32
+
+  Revision 1.11  1998/05/27 00:20:31  peter
     * some scanner optimizes
     * some scanner optimizes
     * automaticly aout2exe for go32v1
     * automaticly aout2exe for go32v1
     * fixed dynamiclinker option which was added at the wrong place
     * fixed dynamiclinker option which was added at the wrong place

+ 6 - 2
compiler/m68k.pas

@@ -498,7 +498,6 @@ type
 
 
     var
     var
        ins_cache : tins_cache;
        ins_cache : tins_cache;
-       exprasmlist : paasmoutput;
 
 
     const
     const
        it : array[0..188] of ttemplate = (
        it : array[0..188] of ttemplate = (
@@ -1566,7 +1565,12 @@ type
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.4  1998-05-23 01:21:10  peter
+  Revision 1.5  1998-06-04 23:51:45  peter
+    * m68k compiles
+    + .def file creation moved to gendef.pas so it could also be used
+      for win32
+
+  Revision 1.4  1998/05/23 01:21:10  peter
     + aktasmmode, aktoptprocessor, aktoutputformat
     + aktasmmode, aktoptprocessor, aktoutputformat
     + smartlink per module $SMARTLINK-/+ (like MMX) and moved to aktswitches
     + smartlink per module $SMARTLINK-/+ (like MMX) and moved to aktswitches
     + $LIBNAME to set the library name where the unit will be put in
     + $LIBNAME to set the library name where the unit will be put in

+ 18 - 110
compiler/opts68k.pas

@@ -34,37 +34,18 @@ type
 implementation
 implementation
 
 
 uses
 uses
-  globals;
+  systems,globals;
 
 
 procedure toption68k.interpret_proc_specific_options(const opt:string);
 procedure toption68k.interpret_proc_specific_options(const opt:string);
 var
 var
   j : longint;
   j : longint;
+  More : string;
 begin
 begin
+  More:=Upper(copy(opt,3,length(opt)-2));
   case opt[2] of
   case opt[2] of
    'A' : begin
    'A' : begin
-           if copy(opt,3,length(opt)-2)='o' then
-            begin
-              output_format:=of_o;
-              assem_need_external_list := false;
-            end
-           else
-            if copy(opt,3,length(opt)-2)='m' then
-             begin
-               output_format:=of_mot;
-               assem_need_external_list := true;
-             end
-           else
-            if copy(opt,3,length(opt)-2)='i' then
-             begin
-               output_format:=of_mit;
-               assem_need_external_list := false;
-             end
-           else
-            if copy(opt,3,length(opt)-2)='gas' then
-             begin
-               output_format:=of_gas;
-               assem_need_external_list := false;
-             end
+           if set_string_asm(More) then
+            initoutputformat:=target_asm.id
            else
            else
             IllegalPara(opt);
             IllegalPara(opt);
          end;
          end;
@@ -75,102 +56,29 @@ begin
              'a' : initswitches:=initswitches+[cs_optimize];
              'a' : initswitches:=initswitches+[cs_optimize];
              'g' : initswitches:=initswitches+[cs_littlesize];
              'g' : initswitches:=initswitches+[cs_littlesize];
              'G' : initswitches:=initswitches-[cs_littlesize];
              'G' : initswitches:=initswitches-[cs_littlesize];
-             'x' : initswitches:=initswitches+[cs_optimize,
-                    cs_maxoptimieren];
-             '2' : opt_processors := MC68020;
+             'x' : initswitches:=initswitches+[cs_optimize,cs_maxoptimieren];
+             '2' : initoptprocessor:=MC68020;
              else
              else
               IllegalPara(opt);
               IllegalPara(opt);
              end;
              end;
          end;
          end;
-  else IllegalPara(opt);
+   'R' : begin
+           if More='MOT' then
+            initasmmode:=M68K_MOT;
+         end;
+
+  else
+    IllegalPara(opt);
   end;
   end;
 end;
 end;
 
 
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.1  1998-03-25 11:18:16  root
-  Initial revision
-
-  Revision 1.13  1998/03/13 22:45:58  florian
-    * small bug fixes applied
-
-  Revision 1.12  1998/03/10 16:27:39  pierre
-    * better line info in stabs debug
-    * symtabletype and lexlevel separated into two fields of tsymtable
-    + ifdef MAKELIB for direct library output, not complete
-    + ifdef CHAINPROCSYMS for overloaded seach across units, not fully
-      working
-    + ifdef TESTFUNCRET for setting func result in underfunction, not
-      working
-
-  Revision 1.11  1998/03/10 01:17:21  peter
-    * all files have the same header
-    * messages are fully implemented, EXTDEBUG uses Comment()
-    + AG... files for the Assembler generation
-
-  Revision 1.10  1998/03/06 00:52:31  peter
-    * replaced all old messages from errore.msg, only ExtDebug and some
-      Comment() calls are left
-    * fixed options.pas
-
-  Revision 1.9  1998/03/05 02:44:15  peter
-    * options cleanup and use of .msg file
-
-  Revision 1.8  1998/03/04 17:33:48  michael
-  + Changed ifdef FPK to ifdef FPC
-
-  Revision 1.7  1998/03/02 01:48:47  peter
-    * renamed target_DOS to target_GO32V1
-    + new verbose system, merged old errors and verbose units into one new
-      verbose.pas, so errors.pas is obsolete
-
-  Revision 1.6  1998/02/22 23:03:20  peter
-    * renamed msource->mainsource and name->unitname
-    * optimized filename handling, filename is not seperate anymore with
-      path+name+ext, this saves stackspace and a lot of fsplit()'s
-    * recompiling of some units in libraries fixed
-    * shared libraries are working again
-    + $LINKLIB <lib> to support automatic linking to libraries
-    + libraries are saved/read from the ppufile, also allows more libraries
-      per ppufile
-
-  Revision 1.5  1998/02/21 03:34:27  carl
-    + mit asm syntax support
-
-  Revision 1.4  1998/02/13 10:35:12  daniel
-  * Made Motorola version compilable.
-  * Fixed optimizer
-
-  Revision 1.3  1998/02/12 11:50:15  daniel
-  Yes! Finally! After three retries, my patch!
-
-  Changes:
-
-  Complete rewrite of psub.pas.
-  Added support for DLL's.
-  Compiler requires less memory.
-  Platform units for each platform.
-
-  Revision 1.2  1998/01/09 19:22:03  carl
-  * externals are now generated as appropriate
-
-  Revision 1.1.1.1  1997/11/27 08:32:57  michael
-  FPC Compiler CVS start
-
-  Pre-CVS log:
-
-  CEC   Carl-Eric Codere
-  FK    Florian Klaempfl
-  PM    Pierre Muller
-  +     feature added
-  -     removed
-  *     bug fixed or changed
+  Revision 1.2  1998-06-04 23:51:47  peter
+    * m68k compiles
+    + .def file creation moved to gendef.pas so it could also be used
+      for win32
 
 
-  History:
-      4th cotober 1997:
-         + copied stuff from opts386.pas and started unit (CEC)
-      8th cotober 1997:
-         * new command line options management (FK)
 }
 }
 
 

+ 6 - 25
compiler/os2_targ.pas

@@ -31,7 +31,6 @@
 unit os2_targ;
 unit os2_targ;
 
 
 interface
 interface
-
 uses import;
 uses import;
 
 
 type
 type
@@ -42,8 +41,6 @@ type
     procedure generatelib;virtual;
     procedure generatelib;virtual;
   end;
   end;
 
 
-procedure write_def_file;
-
 {***************************************************************************}
 {***************************************************************************}
 
 
 {***************************************************************************}
 {***************************************************************************}
@@ -327,33 +324,17 @@ begin
 end;
 end;
 
 
 
 
-procedure write_def_file;
-begin
-   assign(deffile,inputdir+inputfile+'.DEF');
-   {$I+}
-    rewrite(deffile);
-   {$I-}
-   if ioresult=0 then
-    begin
-      write(deffile,'NAME '+inputfile);
-      if genpm then
-        write(deffile,' WINDOWAPI');
-      writeln(deffile,#13#10#13#10'PROTMODE'#13#10);
-      writeln(deffile,'DESCRIPTION '+''''+description+''''#13#10);
-      writeln(deffile,'DATA'#9'MULTIPLE'#13#10);
-      writeln(deffile,'STACKSIZE'#9+tostr(stacksize));
-      writeln(deffile,'HEAPSIZE'#9+tostr(heapsize)+#13#10);
-      write(deffile,'EXPORTS');
-    end
-   else
-    gendeffile:=false;
-end;
 
 
 end.
 end.
 
 
 {
 {
   $Log$
   $Log$
-  Revision 1.2  1998-05-04 17:54:27  peter
+  Revision 1.3  1998-06-04 23:51:48  peter
+    * m68k compiles
+    + .def file creation moved to gendef.pas so it could also be used
+      for win32
+
+  Revision 1.2  1998/05/04 17:54:27  peter
     + smartlinking works (only case jumptable left todo)
     + smartlinking works (only case jumptable left todo)
     * redesign of systems.pas to support assemblers and linkers
     * redesign of systems.pas to support assemblers and linkers
     + Unitname is now also in the PPU-file, increased version to 14
     + Unitname is now also in the PPU-file, increased version to 14

+ 23 - 12
compiler/parser.pas

@@ -34,13 +34,13 @@ unit parser;
 
 
     uses
     uses
        dos,cobjects,globals,scanner,systems,symtable,tree,aasm,
        dos,cobjects,globals,scanner,systems,symtable,tree,aasm,
-       types,strings,pass_1,hcodegen,files,verbose,script,import
+       types,strings,pass_1,hcodegen,files,verbose,script,import,gendef
 {$ifdef i386}
 {$ifdef i386}
-       ,i386
+{       ,i386
        ,cgi386
        ,cgi386
        ,cgai386
        ,cgai386
        ,tgeni386
        ,tgeni386
-       ,aopt386
+       ,aopt386}
 {$endif i386}
 {$endif i386}
 {$ifdef m68k}
 {$ifdef m68k}
         ,m68k
         ,m68k
@@ -345,14 +345,20 @@ unit parser;
              addlinkerfiles(current_module);
              addlinkerfiles(current_module);
 
 
            { Check linking  => we are at first level in compile }
            { Check linking  => we are at first level in compile }
-             if (compile_level=1) and (not current_module^.is_unit) then
-               begin
-                 if (cs_no_linking in initswitches) then
-                   externlink:=true;
-                 if Linker.ExeName='' then
-                   Linker.SetExeName(FileName);
-                 Linker.MakeExecutable;
-               end;
+             if (compile_level=1) then
+              begin
+                if gendeffile then
+                 deffile.writefile;
+                if (not current_module^.is_unit) then
+                 begin
+                   if (cs_no_linking in initswitches) then
+                     externlink:=true;
+                   if Linker.ExeName='' then
+                     Linker.SetExeName(FileName);
+                   Linker.MakeExecutable;
+                 end;
+              end;      
+
            end
            end
          else
          else
            Message1(unit_f_errors_in_unit,tostr(status.errorcount));
            Message1(unit_f_errors_in_unit,tostr(status.errorcount));
@@ -452,7 +458,12 @@ done:
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.20  1998-06-03 22:48:55  peter
+  Revision 1.21  1998-06-04 23:51:49  peter
+    * m68k compiles
+    + .def file creation moved to gendef.pas so it could also be used
+      for win32
+
+  Revision 1.20  1998/06/03 22:48:55  peter
     + wordbool,longbool
     + wordbool,longbool
     * rename bis,von -> high,low
     * rename bis,von -> high,low
     * moved some systemunit loading/creating to psystem.pas
     * moved some systemunit loading/creating to psystem.pas

+ 10 - 1
compiler/pdecl.pas

@@ -1621,6 +1621,8 @@ unit pdecl;
                    { absolute address ?!? }
                    { absolute address ?!? }
                    if token=INTCONST then
                    if token=INTCONST then
                      begin
                      begin
+{$ifdef i386}           
+
                        if (target_info.target=target_GO32V2) then
                        if (target_info.target=target_GO32V2) then
                         begin
                         begin
                           abssym:=new(pabsolutesym,init(s,p));
                           abssym:=new(pabsolutesym,init(s,p));
@@ -1643,6 +1645,8 @@ unit pdecl;
                           symtablestack^.insert(abssym);
                           symtablestack^.insert(abssym);
                         end
                         end
                        else
                        else
+{$endif i386}
+
                         Message(parser_e_absolute_only_to_var_or_const);
                         Message(parser_e_absolute_only_to_var_or_const);
                      end
                      end
                    else
                    else
@@ -1797,7 +1801,12 @@ unit pdecl;
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.22  1998-06-03 22:48:59  peter
+  Revision 1.23  1998-06-04 23:51:50  peter
+    * m68k compiles
+    + .def file creation moved to gendef.pas so it could also be used
+      for win32
+
+  Revision 1.22  1998/06/03 22:48:59  peter
     + wordbool,longbool
     + wordbool,longbool
     * rename bis,von -> high,low
     * rename bis,von -> high,low
     * moved some systemunit loading/creating to psystem.pas
     * moved some systemunit loading/creating to psystem.pas

+ 14 - 17
compiler/pexpr.pas

@@ -743,6 +743,8 @@ unit pexpr;
                                else
                                else
                                  begin
                                  begin
                                     p2:=comp_expr(true);
                                     p2:=comp_expr(true);
+{$ifdef i386}                           
+
                                   { support SEG:OFS for go32v2 Mem[] }
                                   { support SEG:OFS for go32v2 Mem[] }
                                     if (target_info.target=target_GO32V2) and
                                     if (target_info.target=target_GO32V2) and
                                        (p1^.treetype=loadn) and
                                        (p1^.treetype=loadn) and
@@ -769,21 +771,9 @@ unit pexpr;
                                            p1^.memindex:=true;
                                            p1^.memindex:=true;
                                          end;
                                          end;
                                       end
                                       end
-                                    { else
-                                    if (target_info.target=target_GO32V2) and
-                                       assigned(p1^.symtableentry) and
-                                       assigned(p1^.symtableentry^.owner^.name) and
-                                       (p1^.symtableentry^.owner^.name^='SYSTEM') and
-                                       ((p1^.symtableentry^.name='PORT') or
-                                        (p1^.symtableentry^.name='PORTW') or
-                                        (p1^.symtableentry^.name='PORTL')) then
-                                         begin
-                                           p1:=gennode(vecn,p1,p2);
-                                           p1^.portindex:=true;
-                                           p
-                                         end;
-                                      end      }
                                     else
                                     else
+{$endif}                                
+
                                       p1:=gennode(vecn,p1,p2);
                                       p1:=gennode(vecn,p1,p2);
                                     if pd^.deftype=stringdef then
                                     if pd^.deftype=stringdef then
                                       pd:=cchardef
                                       pd:=cchardef
@@ -929,7 +919,8 @@ unit pexpr;
     function is_func_ret(sym : psym) : boolean;
     function is_func_ret(sym : psym) : boolean;
     var
     var
        p : pprocinfo;
        p : pprocinfo;
-       
+
+
       begin
       begin
          p:=@procinfo;
          p:=@procinfo;
          is_func_ret:=false;
          is_func_ret:=false;
@@ -956,7 +947,8 @@ unit pexpr;
            end;
            end;
       end;
       end;
 {$endif TEST_FUNCRET}
 {$endif TEST_FUNCRET}
-           
+
+
 
 
       var
       var
          possible_error : boolean;
          possible_error : boolean;
@@ -1792,7 +1784,12 @@ unit pexpr;
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.23  1998-06-04 09:55:40  pierre
+  Revision 1.24  1998-06-04 23:51:52  peter
+    * m68k compiles
+    + .def file creation moved to gendef.pas so it could also be used
+      for win32
+
+  Revision 1.23  1998/06/04 09:55:40  pierre
     * demangled name of procsym reworked to become independant of the mangling scheme
     * demangled name of procsym reworked to become independant of the mangling scheme
 
 
   Come test_funcret improvements (not yet working)S: ----------------------------------------------------------------------
   Come test_funcret improvements (not yet working)S: ----------------------------------------------------------------------

+ 16 - 1
compiler/pmodules.pas

@@ -113,8 +113,15 @@ unit pmodules;
           On OS/2 the heap is also intialized by the RTL. We do
           On OS/2 the heap is also intialized by the RTL. We do
           not output a pointer }
           not output a pointer }
          case target_info.target of
          case target_info.target of
+{$ifdef i386}   
+
           target_OS2 : ;
           target_OS2 : ;
+{$endif i386}
+{$ifdef m68k}   
+
        target_Mac68K : bsssegment^.concat(new(pai_datablock,init_global('HEAP',4)));
        target_Mac68K : bsssegment^.concat(new(pai_datablock,init_global('HEAP',4)));
+{$endif m68k}
+
          else
          else
            bsssegment^.concat(new(pai_datablock,init_global('HEAP',heapsize)));
            bsssegment^.concat(new(pai_datablock,init_global('HEAP',heapsize)));
          end;
          end;
@@ -127,6 +134,8 @@ unit pmodules;
       var
       var
         i : longint;
         i : longint;
       begin
       begin
+{$ifdef i386}
+
         case target_info.target of
         case target_info.target of
        target_GO32V2 : begin
        target_GO32V2 : begin
                        { stacksize can be specified }
                        { stacksize can be specified }
@@ -144,6 +153,7 @@ unit pmodules;
                            importssection^.concat(new(pai_const,init_32bit(0)));
                            importssection^.concat(new(pai_const,init_32bit(0)));
                        end;
                        end;
         end;
         end;
+{$endif i386}   
       end;
       end;
 
 
 
 
@@ -982,7 +992,12 @@ unit pmodules;
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.20  1998-06-04 09:55:42  pierre
+  Revision 1.21  1998-06-04 23:51:53  peter
+    * m68k compiles
+    + .def file creation moved to gendef.pas so it could also be used
+      for win32
+
+  Revision 1.20  1998/06/04 09:55:42  pierre
     * demangled name of procsym reworked to become independant of the mangling scheme
     * demangled name of procsym reworked to become independant of the mangling scheme
 
 
   Come test_funcret improvements (not yet working)S: ----------------------------------------------------------------------
   Come test_funcret improvements (not yet working)S: ----------------------------------------------------------------------

+ 7 - 2
compiler/psystem.pas

@@ -32,7 +32,7 @@ procedure createconstdefs;
 
 
 implementation
 implementation
 
 
-uses tree;
+uses globals,tree;
 
 
 procedure insertinternsyms(p : psymtable);
 procedure insertinternsyms(p : psymtable);
 {
 {
@@ -231,7 +231,12 @@ end;
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.2  1998-06-04 08:23:57  pierre
+  Revision 1.3  1998-06-04 23:51:55  peter
+    * m68k compiles
+    + .def file creation moved to gendef.pas so it could also be used
+      for win32
+
+  Revision 1.2  1998/06/04 08:23:57  pierre
     * boolean again intern declared (needed to be able to compile
     * boolean again intern declared (needed to be able to compile
       older RTL's)
       older RTL's)
 
 

+ 8 - 3
compiler/ra68k.pas

@@ -73,7 +73,7 @@ var
 Implementation
 Implementation
 
 
 uses
 uses
-  files,globals,AsmUtils,strings,hcodegen,scanner,aasm,
+  files,globals,systems,AsmUtils,strings,hcodegen,scanner,aasm,
   cobjects,verbose,symtable;
   cobjects,verbose,symtable;
 
 
 
 
@@ -1786,7 +1786,7 @@ var
                    { DIVSL/DIVS/MULS/MULU with long for MC68020 only }
                    { DIVSL/DIVS/MULS/MULU with long for MC68020 only }
                    if (actasmtoken = AS_COLON) then
                    if (actasmtoken = AS_COLON) then
                    Begin
                    Begin
-                     if (opt_processors = MC68020) or (cs_compilesystem in aktswitches) then
+                     if (aktoptprocessor = MC68020) or (cs_compilesystem in aktswitches) then
                      Begin
                      Begin
                        Consume(AS_COLON);
                        Consume(AS_COLON);
                        if (actasmtoken = AS_REGISTER) then
                        if (actasmtoken = AS_REGISTER) then
@@ -2172,7 +2172,12 @@ Begin
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.3  1998-05-20 09:42:36  pierre
+  Revision 1.4  1998-06-04 23:51:56  peter
+    * m68k compiles
+    + .def file creation moved to gendef.pas so it could also be used
+      for win32
+
+  Revision 1.3  1998/05/20 09:42:36  pierre
     + UseTokenInfo now default
     + UseTokenInfo now default
     * unit in interface uses and implementation uses gives error now
     * unit in interface uses and implementation uses gives error now
     * only one error for unknown symbol (uses lastsymknown boolean)
     * only one error for unknown symbol (uses lastsymknown boolean)

+ 4 - 84
compiler/radi386.pas

@@ -239,89 +239,9 @@ unit radi386;
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.3  1998-05-20 09:42:36  pierre
-    + UseTokenInfo now default
-    * unit in interface uses and implementation uses gives error now
-    * only one error for unknown symbol (uses lastsymknown boolean)
-      the problem came from the label code !
-    + first inlined procedures and function work
-      (warning there might be allowed cases were the result is still wrong !!)
-    * UseBrower updated gives a global list of all position of all used symbols
-      with switch -gb
+  Revision 1.4  1998-06-04 23:51:58  peter
+    * m68k compiles
+    + .def file creation moved to gendef.pas so it could also be used
+      for win32
 
 
-  Revision 1.2  1998/04/08 16:58:06  pierre
-    * several bugfixes
-      ADD ADC and AND are also sign extended
-      nasm output OK (program still crashes at end
-      and creates wrong assembler files !!)
-      procsym types sym in tdef removed !!
-
-  Revision 1.1.1.1  1998/03/25 11:18:15  root
-  * Restored version
-
-  Revision 1.13  1998/03/24 21:48:33  florian
-    * just a couple of fixes applied:
-         - problem with fixed16 solved
-         - internalerror 10005 problem fixed
-         - patch for assembler reading
-         - small optimizer fix
-         - mem is now supported
-
-  Revision 1.12  1998/03/10 16:27:43  pierre
-    * better line info in stabs debug
-    * symtabletype and lexlevel separated into two fields of tsymtable
-    + ifdef MAKELIB for direct library output, not complete
-    + ifdef CHAINPROCSYMS for overloaded seach across units, not fully
-      working
-    + ifdef TESTFUNCRET for setting func result in underfunction, not
-      working
-
-  Revision 1.11  1998/03/10 01:17:26  peter
-    * all files have the same header
-    * messages are fully implemented, EXTDEBUG uses Comment()
-    + AG... files for the Assembler generation
-
-  Revision 1.10  1998/03/09 12:58:12  peter
-    * FWait warning is only showed for Go32V2 and $E+
-    * opcode tables moved to i386.pas/m68k.pas to reduce circular uses (and
-      for m68k the same tables are removed)
-    + $E for i386
-
-  Revision 1.9  1998/03/06 00:52:51  peter
-    * replaced all old messages from errore.msg, only ExtDebug and some
-      Comment() calls are left
-    * fixed options.pas
-
-  Revision 1.8  1998/03/03 16:45:23  peter
-    + message support for assembler parsers
-
-  Revision 1.7  1998/03/02 01:49:14  peter
-    * renamed target_DOS to target_GO32V1
-    + new verbose system, merged old errors and verbose units into one new
-      verbose.pas, so errors.pas is obsolete
-
-  Revision 1.6  1998/02/13 10:35:35  daniel
-  * Made Motorola version compilable.
-  * Fixed optimizer
-
-  Revision 1.5  1998/02/07 18:01:27  carl
-    + fwait warning for emulation
-
-  Revision 1.3  1997/11/30 18:12:17  carl
-  * bugfix of line numbering.
-
-  Revision 1.2  1997/11/28 18:14:44  pierre
-   working version with several bug fixes
-
-  Revision 1.1.1.1  1997/11/27 08:33:00  michael
-  FPC Compiler CVS start
-
-
-  Pre-CVS log:
-
-  History:
-      19th october 1996:
-         + created from old asmbl.pas
-      13th october 1996:
-         + renamed to radi386
 }
 }

+ 10 - 13
compiler/scandir.inc

@@ -32,7 +32,7 @@ type
      _DIR_FATAL,
      _DIR_FATAL,
      _DIR_I,_DIR_I386_ATT,_DIR_I386_DIRECT,_DIR_I386_INTEL,_DIR_IOCHECKS,
      _DIR_I,_DIR_I386_ATT,_DIR_I386_DIRECT,_DIR_I386_INTEL,_DIR_IOCHECKS,
        _DIR_IF,_DIR_IFDEF,_DIR_IFNDEF,_DIR_IFOPT,_DIR_INFO,
        _DIR_IF,_DIR_IFDEF,_DIR_IFNDEF,_DIR_IFOPT,_DIR_INFO,
-     _DIR_L,_DIR_LIBNAME,_DIR_LINKLIB,
+     _DIR_L,_DIR_LINKLIB,
      _DIR_MESSAGE,_DIR_MMX,
      _DIR_MESSAGE,_DIR_MMX,
      _DIR_NOTE,
      _DIR_NOTE,
      _DIR_OUTPUT_FORMAT,
      _DIR_OUTPUT_FORMAT,
@@ -52,7 +52,7 @@ const
      'FATAL',
      'FATAL',
      'I','I386_ATT','I386_DIRECT','I386_INTEL','IOCHECKS',
      'I','I386_ATT','I386_DIRECT','I386_INTEL','IOCHECKS',
        'IF','IFDEF','IFNDEF','IFOPT','INFO',
        'IF','IFDEF','IFNDEF','IFOPT','INFO',
-     'L','LIBNAME','LINKLIB',
+     'L','LINKLIB',
      'MESSAGE','MMX',
      'MESSAGE','MMX',
      'NOTE',
      'NOTE',
      'OUTPUT_FORMAT',
      'OUTPUT_FORMAT',
@@ -639,14 +639,6 @@ const
       end;
       end;
 
 
 
 
-    procedure dir_libname(t:tdirectivetoken);
-      begin
-        skipspace;
-        stringdispose(current_module^.libfilename);
-        current_module^.libfilename:=stringdup(readstring);
-      end;
-
-
     procedure dir_outputformat(t:tdirectivetoken);
     procedure dir_outputformat(t:tdirectivetoken);
       var
       var
         hs : string;
         hs : string;
@@ -706,7 +698,8 @@ const
          aktasmmode:=initasmmode
          aktasmmode:=initasmmode
         else
         else
          if not set_string_asmmode(s,aktasmmode) then
          if not set_string_asmmode(s,aktasmmode) then
-          Comment(V_Warning,'Unsupported asm mode specified '+s);     
+          Comment(V_Warning,'Unsupported asm mode specified '+s);
+
       end;
       end;
 
 
     procedure dir_oldasmmode(t:tdirectivetoken);
     procedure dir_oldasmmode(t:tdirectivetoken);
@@ -762,7 +755,6 @@ const
          {_DIR_IFOPT} dir_conditional,
          {_DIR_IFOPT} dir_conditional,
          {_DIR_INFO} dir_message,
          {_DIR_INFO} dir_message,
          {_DIR_L} dir_linkobject,
          {_DIR_L} dir_linkobject,
-         {_DIR_LIBNAME} dir_libname,
          {_DIR_LINKLIB} dir_linklib,
          {_DIR_LINKLIB} dir_linklib,
          {_DIR_MESSAGE} dir_message,
          {_DIR_MESSAGE} dir_message,
          {_DIR_MMX} dir_switch,
          {_DIR_MMX} dir_switch,
@@ -830,7 +822,12 @@ const
 
 
 {
 {
   $Log$
   $Log$
-  Revision 1.10  1998-05-30 14:31:10  peter
+  Revision 1.11  1998-06-04 23:51:59  peter
+    * m68k compiles
+    + .def file creation moved to gendef.pas so it could also be used
+      for win32
+
+  Revision 1.10  1998/05/30 14:31:10  peter
     + $ASMMODE
     + $ASMMODE
 
 
   Revision 1.9  1998/05/23 01:21:28  peter
   Revision 1.9  1998/05/23 01:21:28  peter

+ 9 - 1
compiler/switches.pas

@@ -40,8 +40,11 @@ uses globals,verbose,files,systems;
 
 
 procedure sw_stackcheck;
 procedure sw_stackcheck;
 begin
 begin
+{$ifdef i386}
   if target_info.target=target_Linux then
   if target_info.target=target_Linux then
    Message(scan_n_stack_check_global_under_linux);
    Message(scan_n_stack_check_global_under_linux);
+{$endif}
+
 end;
 end;
 
 
 {$ifndef FPC}
 {$ifndef FPC}
@@ -158,7 +161,12 @@ end;
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.4  1998-05-21 19:33:36  peter
+  Revision 1.5  1998-06-04 23:52:00  peter
+    * m68k compiles
+    + .def file creation moved to gendef.pas so it could also be used
+      for win32
+
+  Revision 1.4  1998/05/21 19:33:36  peter
     + better procedure directive handling and only one table
     + better procedure directive handling and only one table
 
 
   Revision 1.3  1998/05/01 07:43:56  florian
   Revision 1.3  1998/05/01 07:43:56  florian

+ 29 - 3
compiler/symdef.inc

@@ -777,6 +777,8 @@
 
 
     procedure tfiledef.setsize;
     procedure tfiledef.setsize;
       begin
       begin
+{$ifdef i386}
+
          case target_info.target of
          case target_info.target of
             target_LINUX:
             target_LINUX:
            begin
            begin
@@ -800,8 +802,19 @@
               end;
               end;
            end;
            end;
       end;
       end;
+{$endif}
+{$ifdef m68k}
+        case filetype of
+          ft_text : savesize:=256;
+         ft_typed,
+       ft_untyped : savesize:=128;
+        end;
+{$endif}
+
       end;
       end;
 
 
+
+
     procedure tfiledef.write;
     procedure tfiledef.write;
       begin
       begin
 {$ifndef NEWPPU}
 {$ifndef NEWPPU}
@@ -836,6 +849,8 @@
           _private : array[1..26] of byte;
           _private : array[1..26] of byte;
           userdata : array[1..16] of byte;
           userdata : array[1..16] of byte;
           name : string[79 or 255 for linux]; }
           name : string[79 or 255 for linux]; }
+{$ifdef i386}   
+
       if (target_info.target=target_GO32V1) or
       if (target_info.target=target_GO32V1) or
          (target_info.target=target_GO32V2) then
          (target_info.target=target_GO32V2) then
         namesize:=79
         namesize:=79
@@ -852,6 +867,12 @@
            Handledef:='word';
            Handledef:='word';
            HandleBitSize:=16;
            HandleBitSize:=16;
         end;
         end;
+{$endif}
+{$ifdef m68k}
+      namesize:=79;
+      Handledef:='word';
+      HandleBitSize:=16;
+{$endif}
 
 
       { the buffer part is still missing !! (PM) }
       { the buffer part is still missing !! (PM) }
       { but the string could become too long !! }
       { but the string could become too long !! }
@@ -1669,8 +1690,8 @@
          nextoverloaded:=pprocdef(readdefref);
          nextoverloaded:=pprocdef(readdefref);
          _class := pobjectdef(readdefref);
          _class := pobjectdef(readdefref);
 
 
-        if gendeffile and ((options and poexports)<>0) then
-           writeln(deffile,#9+mangledname);
+         if gendeffile and ((options and poexports)<>0) then
+           deffile.AddExport(mangledname);
 
 
          parast:=nil;
          parast:=nil;
          localst:=nil;
          localst:=nil;
@@ -2407,7 +2428,12 @@
 
 
 {
 {
   $Log$
   $Log$
-  Revision 1.4  1998-06-04 09:55:45  pierre
+  Revision 1.5  1998-06-04 23:52:01  peter
+    * m68k compiles
+    + .def file creation moved to gendef.pas so it could also be used
+      for win32
+
+  Revision 1.4  1998/06/04 09:55:45  pierre
     * demangled name of procsym reworked to become independant of the mangling scheme
     * demangled name of procsym reworked to become independant of the mangling scheme
 
 
   Come test_funcret improvements (not yet working)S: ----------------------------------------------------------------------
   Come test_funcret improvements (not yet working)S: ----------------------------------------------------------------------

+ 8 - 1
compiler/symsym.inc

@@ -1182,7 +1182,9 @@
   end;
   end;
 
 
     procedure tvarsym.concatstabto(asmlist : paasmoutput);
     procedure tvarsym.concatstabto(asmlist : paasmoutput);
+{$ifdef i386}
       var stab_str : pchar;
       var stab_str : pchar;
+{$endif i386}
       begin
       begin
          inherited concatstabto(asmlist);
          inherited concatstabto(asmlist);
 {$ifdef i386}
 {$ifdef i386}
@@ -1690,7 +1692,12 @@
 
 
 {
 {
   $Log$
   $Log$
-  Revision 1.4  1998-06-04 09:55:46  pierre
+  Revision 1.5  1998-06-04 23:52:02  peter
+    * m68k compiles
+    + .def file creation moved to gendef.pas so it could also be used
+      for win32
+
+  Revision 1.4  1998/06/04 09:55:46  pierre
     * demangled name of procsym reworked to become independant of the mangling scheme
     * demangled name of procsym reworked to become independant of the mangling scheme
 
 
   Come test_funcret improvements (not yet working)S: ----------------------------------------------------------------------
   Come test_funcret improvements (not yet working)S: ----------------------------------------------------------------------

+ 170 - 68
compiler/systems.pas

@@ -29,48 +29,65 @@ unit systems;
        tendian = (endian_little,en_big_endian);
        tendian = (endian_little,en_big_endian);
 
 
        tprocessors = (
        tprocessors = (
-{$ifdef i386}
+       {$ifdef i386}
               i386,i486,pentium,pentiumpro,cx6x86,pentium2,amdk6
               i386,i486,pentium,pentiumpro,cx6x86,pentium2,amdk6
-{$endif}
-{$ifdef m68k}
+       {$endif}
+       {$ifdef m68k}
               MC68000,MC68020
               MC68000,MC68020
-{$endif}
+       {$endif}
        );
        );
 
 
 
 
        tasmmode = (
        tasmmode = (
-{$ifdef i386}
+       {$ifdef i386}
               I386_ATT,I386_INTEL,I386_DIRECT
               I386_ATT,I386_INTEL,I386_DIRECT
-{$endif}
-{$ifdef m68k}
+       {$endif}
+       {$ifdef m68k}
               M68K_MOT
               M68K_MOT
-{$endif}
+       {$endif}
        );
        );
 
 
-       ttarget = (target_GO32V1,target_GO32V2,target_LINUX,target_OS2,
-                  target_WIN32,target_Amiga,target_Atari,target_Mac68k);
 
 
-       tos = (os_GO32V1, os_GO32V2, os_Linux, os_OS2,
-              os_WIN32, os_Amiga, os_Atari, os_Mac68k);
+       ttarget = (
+       {$ifdef i386}
+              target_GO32V1,target_GO32V2,target_LINUX,target_OS2,target_WIN32
+       {$endif i386}
+       {$ifdef m68k}
+              target_Amiga,target_Atari,target_Mac68k,target_Linux
+       {$endif}
+       );
+
 
 
-       tasm = (as_o
+       tasm = (
        {$ifdef i386}
        {$ifdef i386}
-              ,as_asw,as_nasmcoff, as_nasmelf, as_nasmobj, as_tasm, as_masm
+              as_o,as_asw,as_nasmcoff, as_nasmelf, as_nasmobj, as_tasm, as_masm
        {$endif}
        {$endif}
        {$ifdef m68k}
        {$ifdef m68k}
-              ,as_gas,as_mit,as_mot
+              as_o,as_gas,as_mit,as_mot
        {$endif}
        {$endif}
        );
        );
 
 
-       tlink = (link_ld
+       tlink = (
        {$ifdef i386}
        {$ifdef i386}
-              ,link_ldgo32v1, link_ldgo32v2, link_ldw, link_ldos2
+              link_ld,link_ldgo32v1, link_ldgo32v2, link_ldw, link_ldos2
        {$endif i386}
        {$endif i386}
        {$ifdef m68k}
        {$ifdef m68k}
+              link_ld
        {$endif}
        {$endif}
        );
        );
 
 
 
 
+       tos = (
+       {$ifdef i386}
+              os_GO32V1, os_GO32V2, os_Linux, os_OS2, os_WIN32
+       {$endif i386}
+       {$ifdef m68k}
+              os_Amiga, os_Atari, os_Mac68k, os_Linux
+       {$endif}
+       );
+
+
+
        tosinfo = record
        tosinfo = record
           name      : string[30];
           name      : string[30];
           sharedlibext,
           sharedlibext,
@@ -150,6 +167,8 @@ implementation
                                  OS Info
                                  OS Info
 ****************************************************************************}
 ****************************************************************************}
        os_infos : array[tos] of tosinfo = (
        os_infos : array[tos] of tosinfo = (
+{$ifdef i386}
+
           (
           (
             name         : 'GO32 V1 DOS extender';
             name         : 'GO32 V1 DOS extender';
             sharedlibext : '.DLL';
             sharedlibext : '.DLL';
@@ -177,7 +196,7 @@ implementation
             use_function_relative_addresses : true
             use_function_relative_addresses : true
           ),
           ),
           (
           (
-            name         : 'Linux';
+            name         : 'Linux-i386';
             sharedlibext : '.so';
             sharedlibext : '.so';
             staticlibext : '.a';
             staticlibext : '.a';
             sourceext    : '.pp';
             sourceext    : '.pp';
@@ -214,7 +233,10 @@ implementation
             newline      : #13#10;
             newline      : #13#10;
             endian       : endian_little;
             endian       : endian_little;
             use_function_relative_addresses : true
             use_function_relative_addresses : true
-          ),
+          )
+{$endif i386}   
+
+{$ifdef m68k}
           (
           (
             name         : 'Commodore Amiga';
             name         : 'Commodore Amiga';
             sharedlibext : '.library';
             sharedlibext : '.library';
@@ -250,16 +272,32 @@ implementation
             exeext       : '.tpp';
             exeext       : '.tpp';
             scriptext    : '';
             scriptext    : '';
             Cprefix      : '';
             Cprefix      : '';
-            newline      : #10;
+            newline      : #13;
             endian       : en_big_endian;
             endian       : en_big_endian;
             use_function_relative_addresses : false
             use_function_relative_addresses : false
+          ),
+          (
+            name         : 'Linux-m68k';
+            sharedlibext : '.so';
+            staticlibext : '.a';
+            sourceext    : '.pp';
+            pasext       : '.pas';
+            exeext       : '';
+            scriptext    : '.sh';
+            Cprefix      : '';
+            newline      : #10;
+            endian       : en_big_endian;
+            use_function_relative_addresses : true
           )
           )
+{$endif m68k}
           );
           );
+        
 
 
 {****************************************************************************
 {****************************************************************************
                              Assembler Info
                              Assembler Info
 ****************************************************************************}
 ****************************************************************************}
        as_infos : array[tasm] of tasminfo = (
        as_infos : array[tasm] of tasminfo = (
+{$ifdef i386}
           (
           (
             id     : as_o;
             id     : as_o;
             idtxt  : 'O';
             idtxt  : 'O';
@@ -269,7 +307,6 @@ implementation
             labelprefix : '.L';
             labelprefix : '.L';
             comment : '# '
             comment : '# '
           )
           )
-{$ifdef i386}
           ,(
           ,(
             id     : as_asw;
             id     : as_asw;
             idtxt  : 'ASW';
             idtxt  : 'ASW';
@@ -324,8 +361,17 @@ implementation
             labelprefix : '.L';
             labelprefix : '.L';
             comment : '; '
             comment : '; '
           )
           )
-{$endif}
+{$endif i386}
 {$ifdef m68k}
 {$ifdef m68k}
+          (
+            id     : as_o;
+            idtxt  : 'O';
+            asmbin : 'as';
+            asmcmd : '-D -o $OBJ $ASM';
+            externals : false;
+            labelprefix : '.L';
+            comment : '# '
+          )
           ,(
           ,(
             id     : as_gas;
             id     : as_gas;
             idtxt  : 'GAS';
             idtxt  : 'GAS';
@@ -353,13 +399,14 @@ implementation
             labelprefix : '__L';
             labelprefix : '__L';
             comment : '| '
             comment : '| '
           )
           )
-{$endif}
+{$endif m68k}
           );
           );
 
 
 {****************************************************************************
 {****************************************************************************
                                 Linker Info
                                 Linker Info
 ****************************************************************************}
 ****************************************************************************}
        link_infos : array[tlink] of tlinkinfo = (
        link_infos : array[tlink] of tlinkinfo = (
+{$ifdef i386}
           (
           (
             linkbin : 'ld';
             linkbin : 'ld';
             linkcmd : '$OPT -o $EXE $RES';
             linkcmd : '$OPT -o $EXE $RES';
@@ -374,7 +421,6 @@ implementation
             inputend   : ')';
             inputend   : ')';
             libprefix  : '-l'
             libprefix  : '-l'
           )
           )
-{$ifdef i386}
           ,(
           ,(
             linkbin : 'ld';
             linkbin : 'ld';
             linkcmd : '-oformat coff-go32 $OPT -o $EXE @$RES';
             linkcmd : '-oformat coff-go32 $OPT -o $EXE @$RES';
@@ -432,12 +478,31 @@ implementation
             libprefix  : ''
             libprefix  : ''
           )
           )
 {$endif i386}
 {$endif i386}
+{$ifdef m68k}
+          (
+            linkbin : 'ld';
+            linkcmd : '$OPT -o $EXE $RES';
+            bindbin : '';
+            bindcmd : '';
+            stripopt   : '-s';
+            libpathprefix : 'SEARCH_DIR(';
+            libpathsuffix : ')';
+            groupstart : 'GROUP(';
+            groupend   : ')';
+            inputstart : 'INPUT(';
+            inputend   : ')';
+            libprefix  : '-l'
+          )
+{$endif m68k}   
+
           );
           );
 
 
 {****************************************************************************
 {****************************************************************************
                              Targets Info
                              Targets Info
 ****************************************************************************}
 ****************************************************************************}
        target_infos : array[ttarget] of ttargetinfo = (
        target_infos : array[ttarget] of ttargetinfo = (
+{$ifdef i386}
+
           (
           (
             target      : target_GO32V1;
             target      : target_GO32V1;
             short_name  : 'GO32V1';
             short_name  : 'GO32V1';
@@ -458,21 +523,21 @@ implementation
             short_name  : 'GO32V2';
             short_name  : 'GO32V2';
             unit_env    : 'GO32V2UNITS';
             unit_env    : 'GO32V2UNITS';
             system_unit : 'SYSTEM';
             system_unit : 'SYSTEM';
-{$ifndef UseAnsiString}
+      {$ifndef UseAnsiString}
             smartext    : '.SL';
             smartext    : '.SL';
             unitext     : '.PPU';
             unitext     : '.PPU';
             unitlibext  : '.PPL';
             unitlibext  : '.PPL';
             asmext      : '.S';
             asmext      : '.S';
             objext      : '.O';
             objext      : '.O';
             exeext      : '.EXE';
             exeext      : '.EXE';
-{$else UseAnsiString}
+      {$else UseAnsiString}
             smartext    : '.SL';
             smartext    : '.SL';
             unitext     : '.PAU';
             unitext     : '.PAU';
             unitlibext  : '.PPL';
             unitlibext  : '.PPL';
             asmext      : '.SA';
             asmext      : '.SA';
             objext      : '.OA';
             objext      : '.OA';
             exeext      : '.EXE';
             exeext      : '.EXE';
-{$endif UseAnsiString}
+      {$endif UseAnsiString}
             os          : os_GO32V2;
             os          : os_GO32V2;
             link        : link_ldgo32v2;
             link        : link_ldgo32v2;
             assem       : as_o
             assem       : as_o
@@ -521,7 +586,10 @@ implementation
             os          : os_Win32;
             os          : os_Win32;
             link        : link_ldw;
             link        : link_ldw;
             assem       : as_asw
             assem       : as_asw
-          ),
+          )
+{$endif i386}
+
+{$ifdef m68k}
           (
           (
             target      : target_Amiga;
             target      : target_Amiga;
             short_name  : 'AMIGA';
             short_name  : 'AMIGA';
@@ -566,7 +634,23 @@ implementation
             os          : os_Mac68k;
             os          : os_Mac68k;
             link        : link_ld;
             link        : link_ld;
             assem       : as_o
             assem       : as_o
+          ),
+          (
+            target      : target_Linux;
+            short_name  : 'LINUX';
+            unit_env    : 'LINUXUNITS';
+            system_unit : 'syslinux';
+            smartext    : '.sl';
+            unitext     : '.ppu';
+            unitlibext  : '.ppl';
+            asmext      : '.s';
+            objext      : '.o';
+            exeext      : '';
+            os          : os_Linux;
+            link        : link_ld;
+            assem       : as_o
           )
           )
+{$endif m68k}
           );
           );
 
 
 {****************************************************************************
 {****************************************************************************
@@ -586,13 +670,13 @@ implementation
             id    : I386_ATT;
             id    : I386_ATT;
             idtxt : 'ATT'
             idtxt : 'ATT'
           )
           )
-{$endif}
+{$endif i386}
 {$ifdef m68k}
 {$ifdef m68k}
           (
           (
             id    : M68K_MOT;
             id    : M68K_MOT;
             idtxt : 'MOT'
             idtxt : 'MOT'
           )
           )
-{$endif}
+{$endif m68k}
           );
           );
 
 
 {****************************************************************************
 {****************************************************************************
@@ -614,27 +698,27 @@ end;
 
 
 function set_string_target(const s : string) : boolean;
 function set_string_target(const s : string) : boolean;
 var
 var
-  t : ttarget;
+  i : longint;
 begin
 begin
   set_string_target:=false;
   set_string_target:=false;
-  for t:=target_GO32V1 to target_mac68k do
-   if target_infos[t].short_name=s then
+  for i:=0 to (sizeof(target_infos) div sizeof(ttargetinfo))-1 do
+   if target_infos[ttarget(i)].short_name=s then
     begin
     begin
+      set_target(ttarget(i));
       set_string_target:=true;
       set_string_target:=true;
-      set_target(t);
     end;
     end;
 end;
 end;
 
 
 
 
 function set_string_asm(const s : string) : boolean;
 function set_string_asm(const s : string) : boolean;
 var
 var
-  j : longint;
+  i : longint;
 begin
 begin
   set_string_asm:=false;
   set_string_asm:=false;
-  for j:=0 to (sizeof(as_infos) div sizeof(tasminfo))-1 do
-   if as_infos[tasm(j)].idtxt=s then
+  for i:=0 to (sizeof(as_infos) div sizeof(tasminfo))-1 do
+   if as_infos[tasm(i)].idtxt=s then
     begin
     begin
-      target_asm:=as_infos[tasm(j)];
+      target_asm:=as_infos[tasm(i)];
       set_string_asm:=true;
       set_string_asm:=true;
     end;
     end;
 end;
 end;
@@ -666,41 +750,59 @@ end;
 
 
 
 
 begin
 begin
-{$ifdef tp}
-  default_os(target_GO32V2);
-{$else}
-  {$ifdef DOS}
-    default_os(target_GO32V1);
-  {$endif}
+{$ifdef i386}
   {$ifdef GO32V1}
   {$ifdef GO32V1}
-    default_os(target_GO32V1);
-  {$endif}
-  {$ifdef GO32V2}
-    default_os(target_GO32V2);
-  {$endif}
-  {$ifdef OS2}
-    default_os(target_OS2);
-  {$endif}
-  {$ifdef LINUX}
-    default_os(target_LINUX);
-  {$endif}
-  {$ifdef WIN32}
-    default_os(target_WIN32);
-  {$endif}
+     default_os(target_GO32V1);
+  {$else}
+    {$ifdef GO32V2}
+      default_os(target_GO32V2);
+    {$else}
+
+      {$ifdef OS2}
+        default_os(target_OS2);
+      {$else}
+
+        {$ifdef LINUX}
+          default_os(target_LINUX);
+        {$else}
+
+           {$ifdef WIN32}
+             default_os(target_WIN32);
+           {$else}
+
+              default_os(target_GO32V2);
+           {$endif win32}
+        {$endif linux}
+      {$endif os2}
+    {$endif go32v2}
+  {$endif go32v1}
+{$endif i386}
+{$ifdef m68k}
   {$ifdef AMIGA}
   {$ifdef AMIGA}
-    default_os(target_AMIGA);
-  {$endif}
-  {$ifdef ATARI}
-    default_os(target_ATARI);
-  {$endif}
-  {$ifdef MACOS}
-    default_os(target_MAC68k);
-  {$endif}
-{$endif}
+    default_os(target_Amiga);
+  {$else}
+
+    {$ifdef ATARI}
+      default_os(target_Atari);
+    {$else}
+      {$ifdef MACOS}
+        default_os(target_MAC68k);
+      {$else}
+
+        default_os(target_Amiga);
+      {$endif macos}
+    {$endif atari}
+  {$endif amiga}
+{$endif m68k}
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.16  1998-06-01 16:50:22  peter
+  Revision 1.17  1998-06-04 23:52:04  peter
+    * m68k compiles
+    + .def file creation moved to gendef.pas so it could also be used
+      for win32
+
+  Revision 1.16  1998/06/01 16:50:22  peter
     + boolean -> ord conversion
     + boolean -> ord conversion
     * fixed ord -> boolean conversion
     * fixed ord -> boolean conversion
 
 

+ 6 - 4
compiler/win_targ.pas

@@ -41,9 +41,6 @@ unit win_targ;
        aasm,files,strings,globals,cobjects
        aasm,files,strings,globals,cobjects
 {$ifdef i386}
 {$ifdef i386}
        ,i386
        ,i386
-{$endif}
-{$ifdef m68k}
-       ,m68k
 {$endif}
 {$endif}
        ;
        ;
 
 
@@ -175,7 +172,12 @@ unit win_targ;
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.2  1998-05-06 18:36:55  peter
+  Revision 1.3  1998-06-04 23:52:06  peter
+    * m68k compiles
+    + .def file creation moved to gendef.pas so it could also be used
+      for win32
+
+  Revision 1.2  1998/05/06 18:36:55  peter
     * tai_section extended with code,data,bss sections and enumerated type
     * tai_section extended with code,data,bss sections and enumerated type
     * ident 'compiled by FPC' moved to pmodules
     * ident 'compiled by FPC' moved to pmodules
     * small fix for smartlink
     * small fix for smartlink