* registration of targets and assemblers

compiler/assemble.pas

@@ -26,593 +26,1502 @@ unit assemble;
 
 interface
 
-uses
+{ Use multiple passes in the internal assembler to optimize jumps }
+{$define MULTIPASS}
+
+
+    uses
 {$ifdef Delphi}
-  sysutils,
-  dmisc,
+      sysutils,
+      dmisc,
 {$else Delphi}
-  strings,
-  dos,
+      strings,
+      dos,
 {$endif Delphi}
-  globtype,globals,aasm;
-
-const
-  AsmOutSize=32768;
-
-type
-  TAssembler=class
-  public
-  {filenames}
-    path     : pathstr;
-    name     : namestr;
-    asmfile,         { current .s and .o file }
-    objfile  : string;
-    SmartAsm : boolean;
-    SmartFilesCount,
-    SmartHeaderCount : longint;
-    Constructor Create(smart:boolean);
-    Destructor Destroy;override;
-    procedure WriteTree(p:TAAsmoutput);virtual;
-    procedure WriteAsmList;virtual;
-    procedure NextSmartName(place:tcutplace);
-  end;
-
-  TExternalAssembler=class(TAssembler)
-  private
-    procedure CreateSmartLinkPath(const s:string);
-  protected
-  {outfile}
-    AsmSize,
-    AsmStartSize,
-    outcnt   : longint;
-    outbuf   : array[0..AsmOutSize-1] of char;
-    outfile  : file;
-  public
-    Function  FindAssembler:string;
-    Function  CallAssembler(const command,para:string):Boolean;
-    Function  DoAssemble:boolean;
-    Procedure RemoveAsm;
-    Procedure AsmFlush;
-    Procedure AsmClear;
-    Procedure AsmWrite(const s:string);
-    Procedure AsmWritePChar(p:pchar);
-    Procedure AsmWriteLn(const s:string);
-    Procedure AsmLn;
-    procedure AsmCreate(Aplace:tcutplace);
-    procedure AsmClose;
-    procedure Synchronize;
-  public
-    Constructor Create(smart:boolean);
-  end;
-
-
-Procedure GenerateAsm(smart:boolean);
-Procedure OnlyAsm;
+      systems,globtype,globals,aasm,ogbase;
+
+    const
+       AsmOutSize=32768;
+
+    type
+      TAssembler=class
+      public
+      {filenames}
+        path     : pathstr;
+        name     : namestr;
+        asmfile,         { current .s and .o file }
+        objfile  : string;
+        SmartAsm : boolean;
+        SmartFilesCount,
+        SmartHeaderCount : longint;
+        Constructor Create(smart:boolean);virtual;
+        Destructor Destroy;override;
+        procedure NextSmartName(place:tcutplace);
+        procedure MakeObject;virtual;abstract;
+      end;
+
+      TExternalAssembler=class(TAssembler)
+      private
+        procedure CreateSmartLinkPath(const s:string);
+      protected
+      {outfile}
+        AsmSize,
+        AsmStartSize,
+        outcnt   : longint;
+        outbuf   : array[0..AsmOutSize-1] of char;
+        outfile  : file;
+      public
+        Function  FindAssembler:string;
+        Function  CallAssembler(const command,para:string):Boolean;
+        Function  DoAssemble:boolean;
+        Procedure RemoveAsm;
+        Procedure AsmFlush;
+        Procedure AsmClear;
+        Procedure AsmWrite(const s:string);
+        Procedure AsmWritePChar(p:pchar);
+        Procedure AsmWriteLn(const s:string);
+        Procedure AsmLn;
+        procedure AsmCreate(Aplace:tcutplace);
+        procedure AsmClose;
+        procedure WriteTree(p:TAAsmoutput);virtual;
+        procedure WriteAsmList;virtual;
+      public
+        Constructor Create(smart:boolean);override;
+        procedure MakeObject;override;
+      end;
+
+      TInternalAssembler=class(TAssembler)
+      public
+        constructor create(smart:boolean);override;
+        destructor  destroy;override;
+        procedure MakeObject;override;
+      protected
+        { object alloc and output }
+        objectalloc  : tobjectalloc;
+        objectoutput : tobjectoutput;
+      private
+        { the aasmoutput lists that need to be processed }
+        lists        : byte;
+        list         : array[1..maxoutputlists] of TAAsmoutput;
+        { current processing }
+        currlistidx  : byte;
+        currlist     : TAAsmoutput;
+        currpass     : byte;
+{$ifdef GDB}
+        n_line       : byte;     { different types of source lines }
+        linecount,
+        includecount : longint;
+        funcname     : tasmsymbol;
+        stabslastfileinfo : tfileposinfo;
+        procedure convertstabs(p:pchar);
+        procedure emitlineinfostabs(nidx,line : longint);
+        procedure emitstabs(s:string);
+        procedure WriteFileLineInfo(var fileinfo : tfileposinfo);
+        procedure StartFileLineInfo;
+        procedure EndFileLineInfo;
+{$endif}
+        function  MaybeNextList(var hp:Tai):boolean;
+        function  TreePass0(hp:Tai):Tai;
+        function  TreePass1(hp:Tai):Tai;
+        function  TreePass2(hp:Tai):Tai;
+        procedure writetree;
+        procedure writetreesmart;
+      end;
+
+    TAssemblerClass = class of TAssembler;
+
+    Procedure GenerateAsm(smart:boolean);
+    Procedure OnlyAsm;
+
+    procedure RegisterAssembler(const r:tasminfo;c:TAssemblerClass);
+    procedure InitAssembler;
+    procedure DoneAssembler;
 
 
 Implementation
 
-uses
-  cutils,script,fmodule,systems,verbose
+    uses
 {$ifdef unix}
   {$ifdef ver1_0}
-    ,linux
+      linux,
   {$else}
-    ,unix
-  {$endif}
-{$endif}
-{$ifdef i386}
-  {$ifndef NoAg386Bin}
-    ,ag386bin
+      unix,
   {$endif}
-  {$ifndef NoAg386Att}
-    ,ag386att
-  {$endif NoAg386Att}
-  {$ifndef NoAg386Nsm}
-    ,ag386nsm
-  {$endif NoAg386Nsm}
-  {$ifndef NoAg386Int}
-    ,ag386int
-  {$endif NoAg386Int}
-  {$ifdef Ag386Cof}
-    ,ag386cof
-  {$endif Ag386Cof}
-{$endif}
-{$ifdef m68k}
-  {$ifndef NoAg68kGas}
-    ,ag68kgas
-  {$endif NoAg68kGas}
-  {$ifndef NoAg68kMot}
-    ,ag68kmot
-  {$endif NoAg68kMot}
-  {$ifndef NoAg68kMit}
-    ,ag68kmit
-  {$endif NoAg68kMit}
-  {$ifndef NoAg68kMpw}
-    ,ag68kmpw
-  {$endif NoAg68kMpw}
 {$endif}
-  ;
+      cutils,script,finput,fmodule,verbose,
+{$ifdef GDB}
+      gdb,
+{$endif GDB}
+      cpubase,cpuasm
+      ;
+
+    var
+      CAssembler : array[tasm] of TAssemblerClass;
 
 
 {*****************************************************************************
                                    TAssembler
 *****************************************************************************}
 
-Constructor TAssembler.Create(smart:boolean);
-begin
-{ load start values }
-  asmfile:=current_module.asmfilename^;
-  objfile:=current_module.objfilename^;
-  name:=Lower(current_module.modulename^);
-  path:=current_module.outputpath^;
-  SmartAsm:=smart;
-  SmartFilesCount:=0;
-  SmartHeaderCount:=0;
-  SmartLinkOFiles.Clear;
-end;
-
-
-Destructor TAssembler.Destroy;
-begin
-end;
-
-
-procedure TAssembler.WriteTree(p:TAAsmoutput);
-begin
-end;
+    Constructor TAssembler.Create(smart:boolean);
+      begin
+      { load start values }
+        asmfile:=current_module.asmfilename^;
+        objfile:=current_module.objfilename^;
+        name:=Lower(current_module.modulename^);
+        path:=current_module.outputpath^;
+        SmartAsm:=smart;
+        SmartFilesCount:=0;
+        SmartHeaderCount:=0;
+        SmartLinkOFiles.Clear;
+      end;
 
 
-procedure TAssembler.WriteAsmList;
-begin
-end;
+    Destructor TAssembler.Destroy;
+      begin
+      end;
 
 
-procedure TAssembler.NextSmartName(place:tcutplace);
-var
-  s : string;
-begin
-  inc(SmartFilesCount);
-  if SmartFilesCount>999999 then
-   Message(asmw_f_too_many_asm_files);
-  case place of
-    cut_begin :
+    procedure TAssembler.NextSmartName(place:tcutplace);
+      var
+        s : string;
       begin
-        inc(SmartHeaderCount);
-        s:=current_module.asmprefix^+tostr(SmartHeaderCount)+'h';
+        inc(SmartFilesCount);
+        if SmartFilesCount>999999 then
+         Message(asmw_f_too_many_asm_files);
+        case place of
+          cut_begin :
+            begin
+              inc(SmartHeaderCount);
+              s:=current_module.asmprefix^+tostr(SmartHeaderCount)+'h';
+            end;
+          cut_normal :
+            s:=current_module.asmprefix^+tostr(SmartHeaderCount)+'s';
+          cut_end :
+            s:=current_module.asmprefix^+tostr(SmartHeaderCount)+'t';
+        end;
+        AsmFile:=Path+FixFileName(s+tostr(SmartFilesCount)+target_info.asmext);
+        ObjFile:=Path+FixFileName(s+tostr(SmartFilesCount)+target_info.objext);
+        { insert in container so it can be cleared after the linking }
+        SmartLinkOFiles.Insert(Objfile);
       end;
-    cut_normal :
-      s:=current_module.asmprefix^+tostr(SmartHeaderCount)+'s';
-    cut_end :
-      s:=current_module.asmprefix^+tostr(SmartHeaderCount)+'t';
-  end;
-  AsmFile:=Path+FixFileName(s+tostr(SmartFilesCount)+target_info.asmext);
-  ObjFile:=Path+FixFileName(s+tostr(SmartFilesCount)+target_info.objext);
-  { insert in container so it can be cleared after the linking }
-  SmartLinkOFiles.Insert(Objfile);
-end;
 
 
 {*****************************************************************************
-                                  TExternalAssembler
+                                 TExternalAssembler
 *****************************************************************************}
 
-Function DoPipe:boolean;
-begin
-  DoPipe:=(cs_asm_pipe in aktglobalswitches) and
-          not(cs_asm_leave in aktglobalswitches)
+    Function DoPipe:boolean;
+      begin
+        DoPipe:=(cs_asm_pipe in aktglobalswitches) and
+                not(cs_asm_leave in aktglobalswitches)
 {$ifdef i386}
-          and (aktoutputformat=as_i386_as)
+                and (aktoutputformat=as_i386_as)
 {$endif i386}
 {$ifdef m68k}
-          and (aktoutputformat=as_m68k_as);
+                and (aktoutputformat=as_m68k_as);
 {$endif m68k}
-end;
-
-
-Constructor TExternalAssembler.Create(smart:boolean);
-begin
-  inherited Create(smart);
-  if SmartAsm then
-   begin
-     path:=FixPath(current_module.outputpath^+FixFileName(current_module.modulename^)+target_info.smartext,false);
-     CreateSmartLinkPath(path);
-   end;
-  Outcnt:=0;
-end;
-
-
-procedure TExternalAssembler.CreateSmartLinkPath(const s:string);
-var
-  dir : searchrec;
-  hs  : string;
-begin
-  if PathExists(s) then
-   begin
-     { the path exists, now we clean only all the .o and .s files }
-     { .o files }
-     findfirst(s+dirsep+'*'+target_info.objext,anyfile,dir);
-     while (doserror=0) do
-      begin
-        RemoveFile(s+dirsep+dir.name);
-        findnext(dir);
-      end;
-     findclose(dir);
-     { .s files }
-     findfirst(s+dirsep+'*'+target_info.asmext,anyfile,dir);
-     while (doserror=0) do
-      begin
-        RemoveFile(s+dirsep+dir.name);
-        findnext(dir);
-      end;
-     findclose(dir);
-   end
-  else
-   begin
-     hs:=s;
-     if hs[length(hs)] in ['/','\'] then
-      delete(hs,length(hs),1);
-     {$I-}
-      mkdir(hs);
-     {$I+}
-     if ioresult<>0 then;
-   end;
-end;
-
-
-const
-  lastas  : byte=255;
-var
-  LastASBin : pathstr;
-Function TExternalAssembler.FindAssembler:string;
-var
-  asfound : boolean;
-  UtilExe  : string;
-begin
-  asfound:=false;
-  UtilExe:=AddExtension(target_asm.asmbin,source_os.exeext);
-  if lastas<>ord(target_asm.id) then
-   begin
-     lastas:=ord(target_asm.id);
-     { is an assembler passed ? }
-     if utilsdirectory<>'' then
-       asfound:=FindFile(UtilExe,utilsdirectory,LastASBin);
-     if not AsFound then
-       asfound:=FindExe(UtilExe,LastASBin);
-     if (not asfound) and not(cs_asm_extern in aktglobalswitches) then
-      begin
-        Message1(exec_w_assembler_not_found,LastASBin);
-        aktglobalswitches:=aktglobalswitches+[cs_asm_extern];
-      end;
-     if asfound then
-      Message1(exec_t_using_assembler,LastASBin);
-   end;
-  FindAssembler:=LastASBin;
-end;
-
-
-Function TExternalAssembler.CallAssembler(const command,para:string):Boolean;
-begin
-  callassembler:=true;
-  if not(cs_asm_extern in aktglobalswitches) then
-   begin
-     swapvectors;
-     exec(command,para);
-     swapvectors;
-     if (doserror<>0) then
-      begin
-        Message1(exec_w_cant_call_assembler,tostr(doserror));
-        aktglobalswitches:=aktglobalswitches+[cs_asm_extern];
-        callassembler:=false;
-      end
-     else
-      if (dosexitcode<>0) then
-       begin
-        Message1(exec_w_error_while_assembling,tostr(dosexitcode));
-        callassembler:=false;
-       end;
-   end
-  else
-   AsmRes.AddAsmCommand(command,para,name);
-end;
-
-
-procedure TExternalAssembler.RemoveAsm;
-var
-  g : file;
-begin
-  if cs_asm_leave in aktglobalswitches then
-   exit;
-  if cs_asm_extern in aktglobalswitches then
-   AsmRes.AddDeleteCommand(AsmFile)
-  else
-   begin
-     assign(g,AsmFile);
-     {$I-}
-      erase(g);
-     {$I+}
-     if ioresult<>0 then;
-   end;
-end;
-
-
-Function TExternalAssembler.DoAssemble:boolean;
-var
-  s : string;
-begin
-  DoAssemble:=true;
-  if DoPipe then
-   exit;
-  if not(cs_asm_extern in aktglobalswitches) then
-   begin
-     if SmartAsm then
-      begin
-        if (SmartFilesCount<=1) then
-         Message1(exec_i_assembling_smart,name);
-      end
-     else
-     Message1(exec_i_assembling,name);
-   end;
-  s:=target_asm.asmcmd;
-  Replace(s,'$ASM',AsmFile);
-  Replace(s,'$OBJ',ObjFile);
-  if CallAssembler(FindAssembler,s) then
-   RemoveAsm
-  else
-   begin
-      DoAssemble:=false;
-      GenerateError;
-   end;
-end;
-
-
-Procedure TExternalAssembler.AsmFlush;
-begin
-  if outcnt>0 then
-   begin
-     BlockWrite(outfile,outbuf,outcnt);
-     outcnt:=0;
-   end;
-end;
-
-
-Procedure TExternalAssembler.AsmClear;
-begin
-  outcnt:=0;
-end;
-
-
-Procedure TExternalAssembler.AsmWrite(const s:string);
-begin
-  if OutCnt+length(s)>=AsmOutSize then
-   AsmFlush;
-  Move(s[1],OutBuf[OutCnt],length(s));
-  inc(OutCnt,length(s));
-  inc(AsmSize,length(s));
-end;
-
-
-Procedure TExternalAssembler.AsmWriteLn(const s:string);
-begin
-  AsmWrite(s);
-  AsmLn;
-end;
-
-
-Procedure TExternalAssembler.AsmWritePChar(p:pchar);
-var
-  i,j : longint;
-begin
-  i:=StrLen(p);
-  j:=i;
-  while j>0 do
-   begin
-     i:=min(j,AsmOutSize);
-     if OutCnt+i>=AsmOutSize then
-      AsmFlush;
-     Move(p[0],OutBuf[OutCnt],i);
-     inc(OutCnt,i);
-     inc(AsmSize,i);
-     dec(j,i);
-     p:=pchar(@p[i]);
-   end;
-end;
-
-
-Procedure TExternalAssembler.AsmLn;
-begin
-  if OutCnt>=AsmOutSize-2 then
-   AsmFlush;
-  OutBuf[OutCnt]:=target_os.newline[1];
-  inc(OutCnt);
-  inc(AsmSize);
-  if length(target_os.newline)>1 then
-   begin
-     OutBuf[OutCnt]:=target_os.newline[2];
-     inc(OutCnt);
-     inc(AsmSize);
-   end;
-end;
-
-
-procedure TExternalAssembler.AsmCreate(Aplace:tcutplace);
-begin
-  if SmartAsm then
-   NextSmartName(Aplace);
-{$ifdef unix}
-  if DoPipe then
-   begin
-     Message1(exec_i_assembling_pipe,asmfile);
-     POpen(outfile,'as -o '+objfile,'W');
-   end
-  else
-{$endif}
-   begin
-     Assign(outfile,asmfile);
-     {$I-}
-      Rewrite(outfile,1);
-     {$I+}
-     if ioresult<>0 then
-      Message1(exec_d_cant_create_asmfile,asmfile);
-   end;
-  outcnt:=0;
-  AsmSize:=0;
-  AsmStartSize:=0;
-end;
-
-
-procedure TExternalAssembler.AsmClose;
-var
-  f : file;
-  l : longint;
-begin
-  AsmFlush;
-{$ifdef unix}
-  if DoPipe then
-   PClose(outfile)
-  else
-{$endif}
-   begin
-   {Touch Assembler time to ppu time is there is a ppufilename}
-     if Assigned(current_module.ppufilename) then
-      begin
-        Assign(f,current_module.ppufilename^);
-        {$I-}
-         reset(f,1);
-        {$I+}
-        if ioresult=0 then
+      end;
+
+
+    Constructor TExternalAssembler.Create(smart:boolean);
+      begin
+        inherited Create(smart);
+        if SmartAsm then
+         begin
+           path:=FixPath(current_module.outputpath^+FixFileName(current_module.modulename^)+target_info.smartext,false);
+           CreateSmartLinkPath(path);
+         end;
+        Outcnt:=0;
+      end;
+
+
+    procedure TExternalAssembler.CreateSmartLinkPath(const s:string);
+      var
+        dir : searchrec;
+        hs  : string;
+      begin
+        if PathExists(s) then
+         begin
+           { the path exists, now we clean only all the .o and .s files }
+           { .o files }
+           findfirst(s+dirsep+'*'+target_info.objext,anyfile,dir);
+           while (doserror=0) do
+            begin
+              RemoveFile(s+dirsep+dir.name);
+              findnext(dir);
+            end;
+           findclose(dir);
+           { .s files }
+           findfirst(s+dirsep+'*'+target_info.asmext,anyfile,dir);
+           while (doserror=0) do
+            begin
+              RemoveFile(s+dirsep+dir.name);
+              findnext(dir);
+            end;
+           findclose(dir);
+         end
+        else
+         begin
+           hs:=s;
+           if hs[length(hs)] in ['/','\'] then
+            delete(hs,length(hs),1);
+           {$I-}
+            mkdir(hs);
+           {$I+}
+           if ioresult<>0 then;
+         end;
+      end;
+
+
+    const
+      lastas  : byte=255;
+    var
+      LastASBin : pathstr;
+    Function TExternalAssembler.FindAssembler:string;
+      var
+        asfound : boolean;
+        UtilExe  : string;
+      begin
+        asfound:=false;
+        UtilExe:=AddExtension(target_asm.asmbin,source_info.exeext);
+        if lastas<>ord(target_asm.id) then
+         begin
+           lastas:=ord(target_asm.id);
+           { is an assembler passed ? }
+           if utilsdirectory<>'' then
+             asfound:=FindFile(UtilExe,utilsdirectory,LastASBin);
+           if not AsFound then
+             asfound:=FindExe(UtilExe,LastASBin);
+           if (not asfound) and not(cs_asm_extern in aktglobalswitches) then
+            begin
+              Message1(exec_w_assembler_not_found,LastASBin);
+              aktglobalswitches:=aktglobalswitches+[cs_asm_extern];
+            end;
+           if asfound then
+            Message1(exec_t_using_assembler,LastASBin);
+         end;
+        FindAssembler:=LastASBin;
+      end;
+
+
+    Function TExternalAssembler.CallAssembler(const command,para:string):Boolean;
+      begin
+        callassembler:=true;
+        if not(cs_asm_extern in aktglobalswitches) then
+         begin
+           swapvectors;
+           exec(command,para);
+           swapvectors;
+           if (doserror<>0) then
+            begin
+              Message1(exec_w_cant_call_assembler,tostr(doserror));
+              aktglobalswitches:=aktglobalswitches+[cs_asm_extern];
+              callassembler:=false;
+            end
+           else
+            if (dosexitcode<>0) then
+             begin
+              Message1(exec_w_error_while_assembling,tostr(dosexitcode));
+              callassembler:=false;
+             end;
+         end
+        else
+         AsmRes.AddAsmCommand(command,para,name);
+      end;
+
+
+    procedure TExternalAssembler.RemoveAsm;
+      var
+        g : file;
+      begin
+        if cs_asm_leave in aktglobalswitches then
+         exit;
+        if cs_asm_extern in aktglobalswitches then
+         AsmRes.AddDeleteCommand(AsmFile)
+        else
+         begin
+           assign(g,AsmFile);
+           {$I-}
+            erase(g);
+           {$I+}
+           if ioresult<>0 then;
+         end;
+      end;
+
+
+    Function TExternalAssembler.DoAssemble:boolean;
+      var
+        s : string;
+      begin
+        DoAssemble:=true;
+        if DoPipe then
+         exit;
+        if not(cs_asm_extern in aktglobalswitches) then
+         begin
+           if SmartAsm then
+            begin
+              if (SmartFilesCount<=1) then
+               Message1(exec_i_assembling_smart,name);
+            end
+           else
+           Message1(exec_i_assembling,name);
+         end;
+        s:=target_asm.asmcmd;
+        Replace(s,'$ASM',AsmFile);
+        Replace(s,'$OBJ',ObjFile);
+        if CallAssembler(FindAssembler,s) then
+         RemoveAsm
+        else
+         begin
+            DoAssemble:=false;
+            GenerateError;
+         end;
+      end;
+
+
+    Procedure TExternalAssembler.AsmFlush;
+      begin
+        if outcnt>0 then
          begin
-           getftime(f,l);
-           close(f);
-           reset(outfile,1);
-           setftime(outfile,l);
+           BlockWrite(outfile,outbuf,outcnt);
+           outcnt:=0;
          end;
       end;
-     close(outfile);
-   end;
-end;
 
 
-{Touch Assembler and object time to ppu time is there is a ppufilename}
-procedure TExternalAssembler.Synchronize;
-begin
-{Touch Assembler time to ppu time is there is a ppufilename}
-  if Assigned(current_module.ppufilename) then
-   begin
-     SynchronizeFileTime(current_module.ppufilename^,asmfile);
-     if not(cs_asm_extern in aktglobalswitches) then
-       SynchronizeFileTime(current_module.ppufilename^,objfile);
-   end;
-end;
+    Procedure TExternalAssembler.AsmClear;
+      begin
+        outcnt:=0;
+      end;
+
+
+    Procedure TExternalAssembler.AsmWrite(const s:string);
+      begin
+        if OutCnt+length(s)>=AsmOutSize then
+         AsmFlush;
+        Move(s[1],OutBuf[OutCnt],length(s));
+        inc(OutCnt,length(s));
+        inc(AsmSize,length(s));
+      end;
+
+
+    Procedure TExternalAssembler.AsmWriteLn(const s:string);
+      begin
+        AsmWrite(s);
+        AsmLn;
+      end;
+
+
+    Procedure TExternalAssembler.AsmWritePChar(p:pchar);
+      var
+        i,j : longint;
+      begin
+        i:=StrLen(p);
+        j:=i;
+        while j>0 do
+         begin
+           i:=min(j,AsmOutSize);
+           if OutCnt+i>=AsmOutSize then
+            AsmFlush;
+           Move(p[0],OutBuf[OutCnt],i);
+           inc(OutCnt,i);
+           inc(AsmSize,i);
+           dec(j,i);
+           p:=pchar(@p[i]);
+         end;
+      end;
+
+
+    Procedure TExternalAssembler.AsmLn;
+      begin
+        if OutCnt>=AsmOutSize-2 then
+         AsmFlush;
+        OutBuf[OutCnt]:=target_info.newline[1];
+        inc(OutCnt);
+        inc(AsmSize);
+        if length(target_info.newline)>1 then
+         begin
+           OutBuf[OutCnt]:=target_info.newline[2];
+           inc(OutCnt);
+           inc(AsmSize);
+         end;
+      end;
+
+
+    procedure TExternalAssembler.AsmCreate(Aplace:tcutplace);
+      begin
+        if SmartAsm then
+         NextSmartName(Aplace);
+      {$ifdef unix}
+        if DoPipe then
+         begin
+           Message1(exec_i_assembling_pipe,asmfile);
+           POpen(outfile,'as -o '+objfile,'W');
+         end
+        else
+      {$endif}
+         begin
+           Assign(outfile,asmfile);
+           {$I-}
+            Rewrite(outfile,1);
+           {$I+}
+           if ioresult<>0 then
+            Message1(exec_d_cant_create_asmfile,asmfile);
+         end;
+        outcnt:=0;
+        AsmSize:=0;
+        AsmStartSize:=0;
+      end;
+
+
+    procedure TExternalAssembler.AsmClose;
+      var
+        f : file;
+        l : longint;
+      begin
+        AsmFlush;
+      {$ifdef unix}
+        if DoPipe then
+         PClose(outfile)
+        else
+      {$endif}
+         begin
+         {Touch Assembler time to ppu time is there is a ppufilename}
+           if Assigned(current_module.ppufilename) then
+            begin
+              Assign(f,current_module.ppufilename^);
+              {$I-}
+               reset(f,1);
+              {$I+}
+              if ioresult=0 then
+               begin
+                 getftime(f,l);
+                 close(f);
+                 reset(outfile,1);
+                 setftime(outfile,l);
+               end;
+            end;
+           close(outfile);
+         end;
+      end;
+
+
+    procedure TExternalAssembler.WriteTree(p:TAAsmoutput);
+      begin
+      end;
+
+
+    procedure TExternalAssembler.WriteAsmList;
+      begin
+      end;
+
+
+    procedure TExternalAssembler.MakeObject;
+      begin
+        AsmCreate(cut_normal);
+        WriteAsmList;
+        AsmClose;
+        DoAssemble;
+      end;
 
 
 {*****************************************************************************
-                     Generate Assembler Files Main Procedure
+                                  TInternalAssembler
 *****************************************************************************}
 
-Procedure GenerateAsm(smart:boolean);
-var
-  a : TExternalAssembler;
-{$ifdef i386}
-  {$ifndef NoAg386Bin}
-    b : TInternalAssembler;
-  {$endif}
+    constructor TInternalAssembler.create(smart:boolean);
+      begin
+        inherited create(smart);
+        objectoutput:=nil;
+        objectalloc:=tobjectalloc.create;
+        SmartAsm:=smart;
+        currpass:=0;
+      end;
+
+
+   destructor TInternalAssembler.destroy;
+{$ifdef MEMDEBUG}
+      var
+        d : tmemdebug;
 {$endif}
-begin
-  case aktoutputformat of
-     as_none : ;
-{$ifdef i386}
-  {$ifndef NoAg386Bin}
-     as_i386_dbg,
-     as_i386_coff,
-     as_i386_pecoff,
-     as_i386_elf :
-       begin
-         case aktoutputformat of
-           as_i386_dbg :
-             b:=TInternalAssembler.Create(og_dbg,smart);
-           as_i386_coff :
-             b:=TInternalAssembler.Create(og_coff,smart);
-           as_i386_pecoff :
-             b:=TInternalAssembler.Create(og_pecoff,smart);
-           as_i386_elf :
-             b:=TInternalAssembler.Create(og_elf,smart);
+      begin
+{$ifdef MEMDEBUG}
+         d.init('agbin');
+{$endif}
+        objectoutput.free;
+        objectalloc.free;
+{$ifdef MEMDEBUG}
+         d.free;
+{$endif}
+      end;
+
+
+{$ifdef GDB}
+    procedure TInternalAssembler.convertstabs(p:pchar);
+      var
+        ofs,
+        nidx,nother,ii,i,line,j : longint;
+        code : integer;
+        hp : pchar;
+        reloc : boolean;
+        sec : tsection;
+        ps : tasmsymbol;
+        s : string;
+      begin
+        ofs:=0;
+        reloc:=true;
+        ps:=nil;
+        sec:=sec_none;
+        if p[0]='"' then
+         begin
+           i:=1;
+           { we can have \" inside the string !! PM }
+           while not ((p[i]='"') and (p[i-1]<>'\')) do
+            inc(i);
+           p[i]:=#0;
+           ii:=i;
+           hp:=@p[1];
+           s:=StrPas(@P[i+2]);
+         end
+        else
+         begin
+           hp:=nil;
+           s:=StrPas(P);
+           i:=-2; {needed below (PM) }
+         end;
+      { When in pass 1 then only alloc and leave }
+        if currpass=1 then
+         begin
+           objectalloc.staballoc(hp);
+           if assigned(hp) then
+            p[i]:='"';
+           exit;
+         end;
+      { Parse the rest of the stabs }
+        if s='' then
+         internalerror(33000);
+        j:=pos(',',s);
+        if j=0 then
+         internalerror(33001);
+        Val(Copy(s,1,j-1),nidx,code);
+        if code<>0 then
+         internalerror(33002);
+        i:=i+2+j;
+        Delete(s,1,j);
+        j:=pos(',',s);
+        if (j=0) then
+         internalerror(33003);
+        Val(Copy(s,1,j-1),nother,code);
+        if code<>0 then
+         internalerror(33004);
+        i:=i+j;
+        Delete(s,1,j);
+        j:=pos(',',s);
+        if j=0 then
+         begin
+           j:=256;
+           ofs:=-1;
          end;
-         b.WriteBin;
-         b.Free;
-         if assigned(current_module.ppufilename) then
+        Val(Copy(s,1,j-1),line,code);
+        if code<>0 then
+          internalerror(33005);
+        if ofs=0 then
           begin
-            if smart then
-              SynchronizeFileTime(current_module.ppufilename^,current_module.staticlibfilename^)
+            Delete(s,1,j);
+            i:=i+j;
+            Val(s,ofs,code);
+            if code=0 then
+              reloc:=false
             else
-              SynchronizeFileTime(current_module.ppufilename^,current_module.objfilename^);
+              begin
+                ofs:=0;
+                s:=strpas(@p[i]);
+                { handle asmsymbol or
+                    asmsymbol - asmsymbol }
+                j:=pos(' ',s);
+                if j=0 then
+                  j:=pos('-',s);
+                { single asmsymbol }
+                if j=0 then
+                  j:=256;
+                { the symbol can be external
+                  so we must use newasmsymbol and
+                  not getasmsymbol !! PM }
+                ps:=newasmsymbol(copy(s,1,j-1));
+                if not assigned(ps) then
+                  internalerror(33006)
+                else
+                  begin
+                    sec:=ps.section;
+                    ofs:=ps.address;
+                    reloc:=true;
+                    UsedAsmSymbolListInsert(ps);
+                  end;
+                if j<256 then
+                  begin
+                    i:=i+j;
+                    s:=strpas(@p[i]);
+                    if (s<>'') and (s[1]=' ') then
+                      begin
+                         j:=0;
+                         while (s[j+1]=' ') do
+                           inc(j);
+                         i:=i+j;
+                         s:=strpas(@p[i]);
+                      end;
+                    ps:=getasmsymbol(s);
+                    if not assigned(ps) then
+                      internalerror(33007)
+                    else
+                      begin
+                        if ps.section<>sec then
+                          internalerror(33008);
+                        ofs:=ofs-ps.address;
+                        reloc:=false;
+                        UsedAsmSymbolListInsert(ps);
+                      end;
+                  end;
+              end;
           end;
+        { external bss need speical handling (PM) }
+        if assigned(ps) and (ps.section=sec_none) then
+          begin
+            if currpass=2 then
+              begin
+                objectdata.writesymbol(ps);
+                objectoutput.exportsymbol(ps);
+              end;
+            objectdata.WriteSymStabs(sec,ofs,hp,ps,nidx,nother,line,reloc)
+          end
+        else
+          objectdata.WriteStabs(sec,ofs,hp,nidx,nother,line,reloc);
+        if assigned(hp) then
+         p[ii]:='"';
+      end;
+
+
+    procedure TInternalAssembler.emitlineinfostabs(nidx,line : longint);
+      var
+         sec : tsection;
+      begin
+        if currpass=1 then
+          begin
+            objectalloc.staballoc(nil);
+            exit;
+          end;
+
+        if (nidx=n_textline) and assigned(funcname) and
+           (target_info.use_function_relative_addresses) then
+          objectdata.WriteStabs(sec_code,objectdata.sectionsize(sec_code)-funcname.address,
+              nil,nidx,0,line,false)
+        else
+          begin
+            if nidx=n_textline then
+              sec:=sec_code
+            else if nidx=n_dataline then
+              sec:=sec_data
+            else
+              sec:=sec_bss;
+            objectdata.WriteStabs(sec,objectdata.sectionsize(sec),
+              nil,nidx,0,line,true);
+          end;
+      end;
+
+
+    procedure TInternalAssembler.emitstabs(s:string);
+      begin
+        s:=s+#0;
+        ConvertStabs(@s[1]);
+      end;
+
+
+    procedure TInternalAssembler.WriteFileLineInfo(var fileinfo : tfileposinfo);
+      var
+        curr_n : byte;
+        hp : tasmsymbol;
+        infile : tinputfile;
+      begin
+        if not ((cs_debuginfo in aktmoduleswitches) or
+           (cs_gdb_lineinfo in aktglobalswitches)) then
          exit;
-       end;
-  {$endif NoAg386Bin}
-  {$ifndef NoAg386Att}
-     as_i386_as,
-     as_i386_as_aout,
-     as_i386_asw :
-       a:=T386ATTAssembler.create(smart);
-  {$endif NoAg386Att}
-  {$ifndef NoAg386Nsm}
-     as_i386_nasmcoff,
-     as_i386_nasmwin32,
-     as_i386_nasmelf,
-     as_i386_nasmobj :
-       a:=T386NasmAssembler.Create(smart);
-  {$endif NoAg386Nsm}
-  {$ifndef NoAg386Int}
-     as_i386_masm,
-     as_i386_tasm :
-       a:=T386IntelAssembler.Create(smart);
-  {$endif NoAg386Int}
+      { file changed ? (must be before line info) }
+        if (fileinfo.fileindex<>0) and
+           (stabslastfileinfo.fileindex<>fileinfo.fileindex) then
+         begin
+           infile:=current_module.sourcefiles.get_file(fileinfo.fileindex);
+           if includecount=0 then
+            curr_n:=n_sourcefile
+           else
+            curr_n:=n_includefile;
+           { get symbol for this includefile }
+           hp:=newasmsymboltype('Ltext'+ToStr(IncludeCount),AB_LOCAL,AT_FUNCTION);
+           if currpass=1 then
+             begin
+                hp.setaddress(objectalloc.currsec,objectalloc.sectionsize,0);
+                UsedAsmSymbolListInsert(hp);
+             end
+           else
+             objectdata.writesymbol(hp);
+           { emit stabs }
+           if (infile.path^<>'') then
+             EmitStabs('"'+lower(BsToSlash(FixPath(infile.path^,false)))+'",'+tostr(curr_n)+
+               ',0,0,Ltext'+ToStr(IncludeCount));
+           EmitStabs('"'+lower(FixFileName(infile.name^))+'",'+tostr(curr_n)+
+             ',0,0,Ltext'+ToStr(IncludeCount));
+           inc(includecount);
+         end;
+      { line changed ? }
+        if (stabslastfileinfo.line<>fileinfo.line) and (fileinfo.line<>0) then
+          emitlineinfostabs(n_line,fileinfo.line);
+        stabslastfileinfo:=fileinfo;
+      end;
+
+
+    procedure TInternalAssembler.StartFileLineInfo;
+      var
+        fileinfo : tfileposinfo;
+      begin
+        FillChar(stabslastfileinfo,sizeof(stabslastfileinfo),0);
+        n_line:=n_textline;
+        funcname:=nil;
+        linecount:=1;
+        includecount:=0;
+        fileinfo.fileindex:=1;
+        fileinfo.line:=1;
+        WriteFileLineInfo(fileinfo);
+      end;
+
+
+    procedure TInternalAssembler.EndFileLineInfo;
+      var
+        hp : tasmsymbol;
+        store_sec : tsection;
+      begin
+          if not ((cs_debuginfo in aktmoduleswitches) or
+             (cs_gdb_lineinfo in aktglobalswitches)) then
+           exit;
+        store_sec:=objectalloc.currsec;
+        objectalloc.setsection(sec_code);
+        hp:=newasmsymboltype('Letext',AB_LOCAL,AT_FUNCTION);
+        if currpass=1 then
+          begin
+            hp.setaddress(objectalloc.currsec,objectalloc.sectionsize,0);
+            UsedAsmSymbolListInsert(hp);
+          end
+        else
+          objectdata.writesymbol(hp);
+        EmitStabs('"",'+tostr(n_sourcefile)+',0,0,Letext');
+        objectalloc.setsection(store_sec);
+      end;
+{$endif GDB}
+
+
+    function TInternalAssembler.MaybeNextList(var hp:Tai):boolean;
+      begin
+        { maybe end of list }
+        while not assigned(hp) do
+         begin
+           if currlistidx<lists then
+            begin
+              inc(currlistidx);
+              currlist:=list[currlistidx];
+              hp:=Tai(currList.first);
+            end
+           else
+            begin
+              MaybeNextList:=false;
+              exit;
+            end;
+         end;
+        MaybeNextList:=true;
+      end;
+
+
+    function TInternalAssembler.TreePass0(hp:Tai):Tai;
+      var
+        l : longint;
+      begin
+        while assigned(hp) do
+         begin
+           case hp.typ of
+             ait_align :
+               begin
+                 { always use the maximum fillsize in this pass to avoid possible
+                   short jumps to become out of range }
+                 Tai_align(hp).fillsize:=Tai_align(hp).aligntype;
+                 objectalloc.sectionalloc(Tai_align(hp).fillsize);
+               end;
+             ait_datablock :
+               begin
+                 if not SmartAsm then
+                  begin
+                    if not Tai_datablock(hp).is_global then
+                     begin
+                        l:=Tai_datablock(hp).size;
+                        if l>2 then
+                          objectalloc.sectionalign(4)
+                        else if l>1 then
+                          objectalloc.sectionalign(2);
+                        objectalloc.sectionalloc(Tai_datablock(hp).size);
+                     end;
+                  end
+                 else
+                  begin
+                    l:=Tai_datablock(hp).size;
+                    if l>2 then
+                      objectalloc.sectionalign(4)
+                    else if l>1 then
+                      objectalloc.sectionalign(2);
+                    objectalloc.sectionalloc(Tai_datablock(hp).size);
+                  end;
+               end;
+             ait_const_32bit :
+               objectalloc.sectionalloc(4);
+             ait_const_16bit :
+               objectalloc.sectionalloc(2);
+             ait_const_8bit :
+               objectalloc.sectionalloc(1);
+             ait_real_80bit :
+               objectalloc.sectionalloc(10);
+             ait_real_64bit :
+               objectalloc.sectionalloc(8);
+             ait_real_32bit :
+               objectalloc.sectionalloc(4);
+             ait_comp_64bit :
+               objectalloc.sectionalloc(8);
+             ait_const_rva,
+             ait_const_symbol :
+               objectalloc.sectionalloc(4);
+             ait_section:
+               objectalloc.setsection(Tai_section(hp).sec);
+             ait_symbol :
+               Tai_symbol(hp).sym.setaddress(objectalloc.currsec,objectalloc.sectionsize,0);
+             ait_label :
+               Tai_label(hp).l.setaddress(objectalloc.currsec,objectalloc.sectionsize,0);
+             ait_string :
+               objectalloc.sectionalloc(Tai_string(hp).len);
+             ait_instruction :
+               begin
+                 { reset instructions which could change in pass 2 }
+                 Taicpu(hp).resetpass2;
+                 objectalloc.sectionalloc(Taicpu(hp).Pass1(objectalloc.sectionsize));
+               end;
+             ait_cut :
+               if SmartAsm then
+                break;
+           end;
+           hp:=Tai(hp.next);
+         end;
+        TreePass0:=hp;
+      end;
+
+
+    function TInternalAssembler.TreePass1(hp:Tai):Tai;
+      var
+        i,l : longint;
+      begin
+        while assigned(hp) do
+         begin
+{$ifdef GDB}
+           { write stabs }
+          if ((cs_debuginfo in aktmoduleswitches) or
+             (cs_gdb_lineinfo in aktglobalswitches)) then
+            begin
+              if (objectalloc.currsec<>sec_none) and
+                 not(hp.typ in  [
+                     ait_label,
+                     ait_regalloc,ait_tempalloc,
+                     ait_stabn,ait_stabs,ait_section,
+                     ait_cut,ait_marker,ait_align,ait_stab_function_name]) then
+               WriteFileLineInfo(hp.fileinfo);
+            end;
+{$endif GDB}
+           case hp.typ of
+             ait_align :
+               begin
+                 { here we must determine the fillsize which is used in pass2 }
+                 Tai_align(hp).fillsize:=align(objectalloc.sectionsize,Tai_align(hp).aligntype)-
+                   objectalloc.sectionsize;
+                 objectalloc.sectionalloc(Tai_align(hp).fillsize);
+               end;
+             ait_datablock :
+               begin
+                 if objectalloc.currsec<>sec_bss then
+                  Message(asmw_e_alloc_data_only_in_bss);
+                 if not SmartAsm then
+                  begin
+                    if Tai_datablock(hp).is_global then
+                     begin
+                       Tai_datablock(hp).sym.setaddress(sec_none,Tai_datablock(hp).size,Tai_datablock(hp).size);
+                       { force to be common/external, must be after setaddress as that would
+                         set it to AS_GLOBAL }
+                       Tai_datablock(hp).sym.bind:=AB_COMMON;
+                     end
+                    else
+                     begin
+                       l:=Tai_datablock(hp).size;
+                       if l>2 then
+                         objectalloc.sectionalign(4)
+                       else if l>1 then
+                         objectalloc.sectionalign(2);
+                       Tai_datablock(hp).sym.setaddress(objectalloc.currsec,objectalloc.sectionsize,
+                         Tai_datablock(hp).size);
+                       objectalloc.sectionalloc(Tai_datablock(hp).size);
+                     end;
+                   end
+                  else
+                   begin
+                     l:=Tai_datablock(hp).size;
+                     if l>2 then
+                       objectalloc.sectionalign(4)
+                     else if l>1 then
+                       objectalloc.sectionalign(2);
+                     Tai_datablock(hp).sym.setaddress(objectalloc.currsec,objectalloc.sectionsize,Tai_datablock(hp).size);
+                     objectalloc.sectionalloc(Tai_datablock(hp).size);
+                   end;
+                 UsedAsmSymbolListInsert(Tai_datablock(hp).sym);
+               end;
+             ait_const_32bit :
+               objectalloc.sectionalloc(4);
+             ait_const_16bit :
+               objectalloc.sectionalloc(2);
+             ait_const_8bit :
+               objectalloc.sectionalloc(1);
+             ait_real_80bit :
+               objectalloc.sectionalloc(10);
+             ait_real_64bit :
+               objectalloc.sectionalloc(8);
+             ait_real_32bit :
+               objectalloc.sectionalloc(4);
+             ait_comp_64bit :
+               objectalloc.sectionalloc(8);
+             ait_const_rva,
+             ait_const_symbol :
+               begin
+                 objectalloc.sectionalloc(4);
+                 UsedAsmSymbolListInsert(Tai_const_symbol(hp).sym);
+               end;
+             ait_section:
+               begin
+                 objectalloc.setsection(Tai_section(hp).sec);
+{$ifdef GDB}
+                 case Tai_section(hp).sec of
+                  sec_code : n_line:=n_textline;
+                  sec_data : n_line:=n_dataline;
+                   sec_bss : n_line:=n_bssline;
+                 else
+                  n_line:=n_dataline;
+                 end;
+                 stabslastfileinfo.line:=-1;
+{$endif GDB}
+               end;
+{$ifdef GDB}
+             ait_stabn :
+               convertstabs(Tai_stabn(hp).str);
+             ait_stabs :
+               convertstabs(Tai_stabs(hp).str);
+             ait_stab_function_name :
+               begin
+                 if assigned(Tai_stab_function_name(hp).str) then
+                  begin
+                    funcname:=getasmsymbol(strpas(Tai_stab_function_name(hp).str));
+                    UsedAsmSymbolListInsert(funcname);
+                  end
+                 else
+                  funcname:=nil;
+               end;
+             ait_force_line :
+               stabslastfileinfo.line:=0;
 {$endif}
-{$ifdef m68k}
-  {$ifndef NoAg68kGas}
-     as_m68k_as,
-     as_m68k_gas :
-       a:=new(pm68kgasasmlist,Init(smart));
-  {$endif NoAg86KGas}
-  {$ifndef NoAg68kMot}
-     as_m68k_mot :
-       a:=new(pm68kmoTExternalAssembler,Init(smart));
-  {$endif NoAg86kMot}
-  {$ifndef NoAg68kMit}
-     as_m68k_mit :
-       a:=new(pm68kmiTExternalAssembler,Init(smart));
-  {$endif NoAg86KMot}
-  {$ifndef NoAg68kMpw}
-     as_m68k_mpw :
-       a:=new(pm68kmpwasmlist,Init(smart));
-  {$endif NoAg68kMpw}
+             ait_symbol :
+               begin
+                 Tai_symbol(hp).sym.setaddress(objectalloc.currsec,objectalloc.sectionsize,0);
+                 UsedAsmSymbolListInsert(Tai_symbol(hp).sym);
+               end;
+             ait_symbol_end :
+               begin
+                 if target_info.target=target_i386_linux then
+                  begin
+                    Tai_symbol(hp).sym.size:=objectalloc.sectionsize-Tai_symbol(hp).sym.address;
+                    UsedAsmSymbolListInsert(Tai_symbol(hp).sym);
+                  end;
+                end;
+             ait_label :
+               begin
+                 Tai_label(hp).l.setaddress(objectalloc.currsec,objectalloc.sectionsize,0);
+                 UsedAsmSymbolListInsert(Tai_label(hp).l);
+               end;
+             ait_string :
+               objectalloc.sectionalloc(Tai_string(hp).len);
+             ait_instruction :
+               begin
+                 objectalloc.sectionalloc(Taicpu(hp).Pass1(objectalloc.sectionsize));
+                 { fixup the references }
+                 for i:=1 to Taicpu(hp).ops do
+                  begin
+                    with Taicpu(hp).oper[i-1] do
+                     begin
+                       case typ of
+                         top_ref :
+                           begin
+                             if assigned(ref^.symbol) then
+                              UsedAsmSymbolListInsert(ref^.symbol);
+                           end;
+                         top_symbol :
+                           begin
+                             if sym=nil then
+                              sym:=sym;
+                             UsedAsmSymbolListInsert(sym);
+                           end;
+                       end;
+                     end;
+                  end;
+               end;
+             ait_direct :
+               Message(asmw_f_direct_not_supported);
+             ait_cut :
+               if SmartAsm then
+                break;
+           end;
+           hp:=Tai(hp.next);
+         end;
+        TreePass1:=hp;
+      end;
+
+
+    function TInternalAssembler.TreePass2(hp:Tai):Tai;
+      var
+        l  : longint;
+{$ifdef I386}
+        co : comp;
+{$endif I386}
+      begin
+        { main loop }
+        while assigned(hp) do
+         begin
+{$ifdef GDB}
+           { write stabs }
+          if ((cs_debuginfo in aktmoduleswitches) or
+             (cs_gdb_lineinfo in aktglobalswitches)) then
+            begin
+              if (objectdata.currsec<>sec_none) and
+                 not(hp.typ in [
+                     ait_label,
+                     ait_regalloc,ait_tempalloc,
+                     ait_stabn,ait_stabs,ait_section,
+                     ait_cut,ait_marker,ait_align,ait_stab_function_name]) then
+               WriteFileLineInfo(hp.fileinfo);
+            end;
+{$endif GDB}
+           case hp.typ of
+             ait_align :
+               objectdata.writebytes(Tai_align(hp).getfillbuf^,Tai_align(hp).fillsize);
+             ait_section :
+               begin
+                 objectdata.defaultsection(Tai_section(hp).sec);
+{$ifdef GDB}
+                 case Tai_section(hp).sec of
+                  sec_code : n_line:=n_textline;
+                  sec_data : n_line:=n_dataline;
+                   sec_bss : n_line:=n_bssline;
+                 else
+                  n_line:=n_dataline;
+                 end;
+                 stabslastfileinfo.line:=-1;
+{$endif GDB}
+               end;
+             ait_symbol :
+               begin
+                 objectdata.writesymbol(Tai_symbol(hp).sym);
+                 objectoutput.exportsymbol(Tai_symbol(hp).sym);
+               end;
+             ait_datablock :
+               begin
+                 objectdata.writesymbol(Tai_datablock(hp).sym);
+                 objectoutput.exportsymbol(Tai_datablock(hp).sym);
+                 if SmartAsm or (not Tai_datablock(hp).is_global) then
+                   begin
+                     l:=Tai_datablock(hp).size;
+                     if l>2 then
+                       objectdata.allocalign(4)
+                     else if l>1 then
+                       objectdata.allocalign(2);
+                     objectdata.alloc(Tai_datablock(hp).size);
+                   end;
+               end;
+             ait_const_32bit :
+               objectdata.writebytes(Tai_const(hp).value,4);
+             ait_const_16bit :
+               objectdata.writebytes(Tai_const(hp).value,2);
+             ait_const_8bit :
+               objectdata.writebytes(Tai_const(hp).value,1);
+             ait_real_80bit :
+               objectdata.writebytes(Tai_real_80bit(hp).value,10);
+             ait_real_64bit :
+               objectdata.writebytes(Tai_real_64bit(hp).value,8);
+             ait_real_32bit :
+               objectdata.writebytes(Tai_real_32bit(hp).value,4);
+             ait_comp_64bit :
+               begin
+{$ifdef FPC}
+                 co:=comp(Tai_comp_64bit(hp).value);
+{$else}
+                 co:=Tai_comp_64bit(hp).value;
+{$endif}
+                 objectdata.writebytes(co,8);
+               end;
+             ait_string :
+               objectdata.writebytes(Tai_string(hp).str^,Tai_string(hp).len);
+             ait_const_rva :
+               objectdata.writereloc(Tai_const_symbol(hp).offset,4,
+                 Tai_const_symbol(hp).sym,relative_rva);
+             ait_const_symbol :
+               objectdata.writereloc(Tai_const_symbol(hp).offset,4,
+                 Tai_const_symbol(hp).sym,relative_false);
+             ait_label :
+               begin
+                 objectdata.writesymbol(Tai_label(hp).l);
+                 { exporting shouldn't be necessary as labels are local,
+                   but it's better to be on the safe side (PFV) }
+                 objectoutput.exportsymbol(Tai_label(hp).l);
+               end;
+             ait_instruction :
+               Taicpu(hp).Pass2;
+{$ifdef GDB}
+             ait_stabn :
+               convertstabs(Tai_stabn(hp).str);
+             ait_stabs :
+               convertstabs(Tai_stabs(hp).str);
+             ait_stab_function_name :
+               if assigned(Tai_stab_function_name(hp).str) then
+                 funcname:=getasmsymbol(strpas(Tai_stab_function_name(hp).str))
+               else
+                 funcname:=nil;
+             ait_force_line :
+               stabslastfileinfo.line:=0;
+{$endif}
+             ait_cut :
+               if SmartAsm then
+                break;
+           end;
+           hp:=Tai(hp.next);
+         end;
+        TreePass2:=hp;
+      end;
+
+
+    procedure TInternalAssembler.writetree;
+      var
+        hp : Tai;
+      label
+        doexit;
+      begin
+        objectalloc.resetsections;
+        objectalloc.setsection(sec_code);
+
+        objectoutput.initwriting(ObjFile);
+        objectdata:=objectoutput.data;
+        objectdata.defaultsection(sec_code);
+      { reset the asmsymbol list }
+        CreateUsedAsmsymbolList;
+
+{$ifdef MULTIPASS}
+      { Pass 0 }
+        currpass:=0;
+        objectalloc.setsection(sec_code);
+        { start with list 1 }
+        currlistidx:=1;
+        currlist:=list[currlistidx];
+        hp:=Tai(currList.first);
+        while assigned(hp) do
+         begin
+           hp:=TreePass0(hp);
+           MaybeNextList(hp);
+         end;
+        { leave if errors have occured }
+        if errorcount>0 then
+         goto doexit;
 {$endif}
-  else
-    Message(asmw_f_assembler_output_not_supported);
-  end;
-  a.AsmCreate(cut_normal);
-  a.WriteAsmList;
-  a.AsmClose;
-  a.DoAssemble;
-  a.synchronize;
-  a.Free;
-end;
-
-
-Procedure OnlyAsm;
-var
-  a : TExternalAssembler;
-begin
-  a:=TExternalAssembler.Create(false);
-  a.DoAssemble;
-  a.Free;
-end;
+
+      { Pass 1 }
+        currpass:=1;
+        objectalloc.resetsections;
+        objectalloc.setsection(sec_code);
+{$ifdef GDB}
+        StartFileLineInfo;
+{$endif GDB}
+        { start with list 1 }
+        currlistidx:=1;
+        currlist:=list[currlistidx];
+        hp:=Tai(currList.first);
+        while assigned(hp) do
+         begin
+           hp:=TreePass1(hp);
+           MaybeNextList(hp);
+         end;
+{$ifdef GDB}
+        EndFileLineInfo;
+{$endif GDB}
+        { check for undefined labels and reset }
+        UsedAsmSymbolListCheckUndefined;
+
+        { set section sizes }
+        objectdata.setsectionsizes(objectalloc.secsize);
+        { leave if errors have occured }
+        if errorcount>0 then
+         goto doexit;
+
+      { Pass 2 }
+        currpass:=2;
+{$ifdef GDB}
+        StartFileLineInfo;
+{$endif GDB}
+        { start with list 1 }
+        currlistidx:=1;
+        currlist:=list[currlistidx];
+        hp:=Tai(currList.first);
+        while assigned(hp) do
+         begin
+           hp:=TreePass2(hp);
+           MaybeNextList(hp);
+         end;
+{$ifdef GDB}
+        EndFileLineInfo;
+{$endif GDB}
+
+        { leave if errors have occured }
+        if errorcount>0 then
+         goto doexit;
+
+        { write last objectfile }
+        objectoutput.donewriting;
+        objectdata:=nil;
+
+      doexit:
+        { reset the used symbols back, must be after the .o has been
+          written }
+        UsedAsmsymbolListReset;
+        DestroyUsedAsmsymbolList;
+      end;
+
+
+    procedure TInternalAssembler.writetreesmart;
+      var
+        hp : Tai;
+        startsec : tsection;
+        place: tcutplace;
+      begin
+        objectalloc.resetsections;
+        objectalloc.setsection(sec_code);
+
+        NextSmartName(cut_normal);
+        objectoutput.initwriting(ObjFile);
+        objectdata:=objectoutput.data;
+        objectdata.defaultsection(sec_code);
+        startsec:=sec_code;
+
+        { start with list 1 }
+        currlistidx:=1;
+        currlist:=list[currlistidx];
+        hp:=Tai(currList.first);
+        while assigned(hp) do
+         begin
+         { reset the asmsymbol list }
+           CreateUsedAsmSymbolList;
+
+{$ifdef MULTIPASS}
+         { Pass 0 }
+           currpass:=0;
+           objectalloc.resetsections;
+           objectalloc.setsection(startsec);
+           TreePass0(hp);
+           { leave if errors have occured }
+           if errorcount>0 then
+            exit;
+{$endif MULTIPASS}
+
+         { Pass 1 }
+           currpass:=1;
+           objectalloc.resetsections;
+           objectalloc.setsection(startsec);
+{$ifdef GDB}
+           StartFileLineInfo;
+{$endif GDB}
+           TreePass1(hp);
+{$ifdef GDB}
+           EndFileLineInfo;
+{$endif GDB}
+           { check for undefined labels }
+           UsedAsmSymbolListCheckUndefined;
+
+           { set section sizes }
+           objectdata.setsectionsizes(objectalloc.secsize);
+           { leave if errors have occured }
+           if errorcount>0 then
+            exit;
+
+         { Pass 2 }
+           currpass:=2;
+           objectdata.defaultsection(startsec);
+{$ifdef GDB}
+           StartFileLineInfo;
+{$endif GDB}
+           hp:=TreePass2(hp);
+{$ifdef GDB}
+           EndFileLineInfo;
+{$endif GDB}
+           { leave if errors have occured }
+           if errorcount>0 then
+            exit;
+
+           { if not end then write the current objectfile }
+           objectoutput.donewriting;
+           objectdata:=nil;
+
+           { reset the used symbols back, must be after the .o has been
+             written }
+           UsedAsmsymbolListReset;
+           DestroyUsedAsmsymbolList;
+
+           { end of lists? }
+           if not MaybeNextList(hp) then
+            break;
+           { save section for next loop }
+           { this leads to a problem if startsec is sec_none !! PM }
+           startsec:=objectalloc.currsec;
+
+           { we will start a new objectfile so reset everything }
+           { The place can still change in the next while loop, so don't init }
+           { the writer yet (JM)                                              }
+           if (hp.typ=ait_cut) then
+            place := Tai_cut(hp).place
+           else
+            place := cut_normal;
+
+           { avoid empty files }
+           while assigned(hp.next) and
+                 (Tai(hp.next).typ in [ait_marker,ait_comment,ait_section,ait_cut]) do
+            begin
+              if Tai(hp.next).typ=ait_section then
+               startsec:=Tai_section(hp.next).sec
+              else if (Tai(hp.next).typ=ait_cut) then
+               place := Tai_cut(hp).place;
+              hp:=Tai(hp.next);
+            end;
+
+           NextSmartName(place);
+           objectoutput.initwriting(ObjFile);
+           objectdata:=objectoutput.data;
+
+           hp:=Tai(hp.next);
+
+           { there is a problem if startsec is sec_none !! PM }
+           if startsec=sec_none then
+             startsec:=sec_code;
+
+           if not MaybeNextList(hp) then
+             break;
+         end;
+      end;
+
+
+    procedure TInternalAssembler.MakeObject;
+
+        procedure addlist(p:TAAsmoutput);
+        begin
+          inc(lists);
+          list[lists]:=p;
+        end;
+
+      begin
+        if cs_debuginfo in aktmoduleswitches then
+          addlist(debuglist);
+        addlist(codesegment);
+        addlist(datasegment);
+        addlist(consts);
+        addlist(rttilist);
+        if assigned(resourcestringlist) then
+          addlist(resourcestringlist);
+        addlist(bsssegment);
+        if assigned(importssection) then
+          addlist(importssection);
+        if assigned(exportssection) and not UseDeffileForExport then
+          addlist(exportssection);
+        if assigned(resourcesection) then
+          addlist(resourcesection);
+
+        if SmartAsm then
+          writetreesmart
+        else
+          writetree;
+      end;
+
+
+{*****************************************************************************
+                     Generate Assembler Files Main Procedure
+*****************************************************************************}
+
+    Procedure GenerateAsm(smart:boolean);
+      var
+        a : TAssembler;
+      begin
+        if assigned(CAssembler[target_info.assem]) then
+          a:=CAssembler[target_info.assem].Create(smart)
+        else
+          Message(asmw_f_assembler_output_not_supported);
+        a.MakeObject;
+        a.Free;
+      end;
+
+
+    Procedure OnlyAsm;
+      var
+        a : TExternalAssembler;
+      begin
+        a:=TExternalAssembler.Create(false);
+        a.DoAssemble;
+        a.Free;
+      end;
+
+
+{*****************************************************************************
+                                 Init/Done
+*****************************************************************************}
+
+    procedure RegisterAssembler(const r:tasminfo;c:TAssemblerClass);
+      var
+        t : tasm;
+      begin
+        t:=r.id;
+        if assigned(asminfos[t]) then
+          writeln('Warning: Assembler is already registered!')
+        else
+          Getmem(asminfos[t],sizeof(tasminfo));
+        asminfos[t]^:=r;
+        CAssembler[t]:=c;
+      end;
+
+
+    procedure InitAssembler;
+      begin
+        initoutputformat:=target_info.assem;
+        aktoutputformat:=target_info.assem;
+        set_target_asm(target_info.assem);
+      end;
+
+
+    procedure DoneAssembler;
+      begin
+      end;
 
 end.
 {
   $Log$
-  Revision 1.17  2001-04-13 01:22:06  peter
+  Revision 1.18  2001-04-18 22:01:53  peter
+    * registration of targets and assemblers
+
+  Revision 1.17  2001/04/13 01:22:06  peter
     * symtable change to classes
     * range check generation and errors fixed, make cycle DEBUG=1 works
     * memory leaks fixed

compiler/browlog.pas

@@ -233,11 +233,11 @@ implementation
         move(s[1],buf[bufidx],length(s));
         inc(bufidx,length(s));
       { add crlf }
-        buf[bufidx]:=target_os.newline[1];
+        buf[bufidx]:=target_info.newline[1];
         inc(bufidx);
-        if length(target_os.newline)=2 then
+        if length(target_info.newline)=2 then
          begin
-           buf[bufidx]:=target_os.newline[2];
+           buf[bufidx]:=target_info.newline[2];
            inc(bufidx);
          end;
       end;
@@ -519,7 +519,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.7  2001-04-13 01:22:06  peter
+  Revision 1.8  2001-04-18 22:01:53  peter
+    * registration of targets and assemblers
+
+  Revision 1.7  2001/04/13 01:22:06  peter
     * symtable change to classes
     * range check generation and errors fixed, make cycle DEBUG=1 works
     * memory leaks fixed

compiler/compiler.pas

@@ -97,9 +97,12 @@ uses
 {$endif Delphi}
   verbose,comphook,systems,
   cutils,cclasses,globals,options,fmodule,parser,symtable,
-  link,import,export,tokens,pass_1,
+  assemble,link,import,export,tokens,pass_1
   { cpu overrides }
-  cpuswtch
+  ,cpuswtch
+  { cpu targets }
+  ,cputarg
+  { cpu codegenerator }
 {$ifndef NOPASS2}
   ,cpunode
 {$endif}
@@ -166,6 +169,7 @@ begin
      DoneImport;
      DoneExport;
      DoneLinker;
+     DoneAssembler;
      DoneCpu;
    end;
 { Free memory for the others }
@@ -208,6 +212,7 @@ begin
   InitImport;
   InitExport;
   InitLinker;
+  InitAssembler;
   InitCpu;
   CompilerInitedAfterArgs:=true;
 end;
@@ -258,8 +263,8 @@ begin
 
 { show some info }
   Message1(general_t_compilername,FixFileName(system.paramstr(0)));
-  Message1(general_d_sourceos,source_os.name);
-  Message1(general_i_targetos,target_os.name);
+  Message1(general_d_sourceos,source_info.name);
+  Message1(general_i_targetos,target_info.name);
   Message1(general_t_exepath,exepath);
   WritePathList(general_t_unitpath,unitsearchpath);
   WritePathList(general_t_includepath,includesearchpath);
@@ -323,7 +328,10 @@ end;
 end.
 {
   $Log$
-  Revision 1.18  2001-04-13 18:08:36  peter
+  Revision 1.19  2001-04-18 22:01:53  peter
+    * registration of targets and assemblers
+
+  Revision 1.18  2001/04/13 18:08:36  peter
     * scanner object to class
 
   Revision 1.17  2001/04/13 01:22:06  peter

compiler/comprsrc.pas

@@ -78,7 +78,7 @@ var
 begin
   resbin:='';
   if utilsdirectory<>'' then
-   resfound:=FindFile(target_res.resbin+source_os.exeext,utilsdirectory,resbin);
+   resfound:=FindFile(target_res.resbin+source_info.exeext,utilsdirectory,resbin);
   if not resfound then
    resfound:=FindExe(target_res.resbin,resbin);
   { get also the path to be searched for the windres.h }
@@ -142,7 +142,10 @@ end;
 end.
 {
   $Log$
-  Revision 1.8  2001-03-13 21:01:14  peter
+  Revision 1.9  2001-04-18 22:01:53  peter
+    * registration of targets and assemblers
+
+  Revision 1.8  2001/03/13 21:01:14  peter
     * string fixes
 
   Revision 1.7  2001/02/20 21:41:17  peter

compiler/export.pas

@@ -28,6 +28,7 @@ interface
 
 uses
   cutils,cclasses,
+  systems,
   symtype;
 
 const
@@ -60,58 +61,23 @@ type
       procedure generatelib;virtual;
    end;
 
+   TExportLibClass=class of TExportLib;
+
 var
-   exportlib : texportlib;
+  CExportLib : array[ttarget] of TExportLibClass;
+  ExportLib  : TExportLib;
 
+procedure RegisterExport(t:ttarget;c:TExportLibClass);
 procedure InitExport;
 procedure DoneExport;
 
 implementation
 
 uses
-  systems,verbose,globals
-{$ifdef i386}
-  {$ifndef NOTARGETLINUX}
-    ,t_linux
-  {$endif}
-  {$ifndef NOTARGETFREEBSD}
-    ,t_fbsd
-  {$endif}
-  {$ifndef NOTARGETOS2}
-    ,t_os2
-  {$endif}
-  {$ifndef NOTARGETSUNOS}
-    ,t_sunos
-  {$endif}
-  {$ifndef NOTARGETWIN32}
-    ,t_win32
-  {$endif}
-  {$ifndef NOTARGETNETWARE}
-    ,t_nwm
-  {$endif}
-  {$ifndef NOTARGETGO32V2}
-    ,t_go32v2
-  {$endif}
-{$endif}
-{$ifdef m68k}
-  {$ifndef NOTARGETLINUX}
-    ,t_linux
-  {$endif}
-{$endif}
-{$ifdef powerpc}
-  {$ifndef NOTARGETLINUX}
-    ,t_linux
-  {$endif}
-{$endif}
-{$ifdef alpha}
-  {$ifndef NOTARGETLINUX}
-    ,t_linux
-  {$endif}
-{$endif}
-  ;
+  verbose,globals;
 
 {****************************************************************************
-                           TImported_procedure
+                           TExported_procedure
 ****************************************************************************}
 
 constructor texported_item.Create;
@@ -133,7 +99,7 @@ end;
 
 
 {****************************************************************************
-                              TImportLib
+                              TExportLib
 ****************************************************************************}
 
 constructor texportlib.Create;
@@ -182,64 +148,39 @@ begin
 end;
 
 
-procedure DoneExport;
+{*****************************************************************************
+                                 Init/Done
+*****************************************************************************}
+
+procedure RegisterExport(t:ttarget;c:TExportLibClass);
 begin
-  if assigned(exportlib) then
-    exportlib.free;
+  CExportLib[t]:=c;
 end;
 
 
 procedure InitExport;
 begin
-  case target_info.target of
-{$ifdef i386}
-  {$ifndef NOTARGETLINUX}
-    target_i386_Linux :
-      exportlib:=Texportliblinux.Create;
-  {$endif NOTARGETLINUX}
-  {$ifndef NOTARGETFREEBSD}
-    target_i386_freebsd:
-      exportlib:=Texportlibfreebsd.Create;
-  {$endif NOTARGETFREEBSD}
-  {$ifndef NOTARGETSUNOS}
-    target_i386_SUNOS:
-      exportlib:=Texportlibsunos.Create;
-  {$endif NOTARGETSUNOS}
-  {$ifndef NOTARGETWIN32}
-    target_i386_Win32 :
-      exportlib:=Texportlibwin32.Create;
-  {$endif NOTARGETWIN32}
-  {$ifndef NOTARGETNETWARE}
-    target_i386_netware :
-      exportlib:=Texportlibnetware.Create;
-  {$endif NOTARGETNETWARE}
-{
-    target_i386_OS2 :
-      exportlib:=Texportlibos2.Create;
-}
-{$endif i386}
-{$ifdef m68k}
-    target_m68k_Linux :
-      exportlib:=Texportliblinux.Create;
-{$endif m68k}
-{$ifdef alpha}
-    target_alpha_Linux :
-      exportlib:=Texportliblinux.Create;
-{$endif alpha}
-{$ifdef powerpc}
-    target_alpha_Linux :
-      exportlib:=Texportliblinux.Create;
-{$endif powerpc}
-    else
-      exportlib:=Texportlib.Create;
-  end;
+  if assigned(CExportLib[target_info.target]) then
+   exportlib:=CExportLib[target_info.target].Create
+  else
+   exportlib:=TExportLib.Create;
+end;
+
+
+procedure DoneExport;
+begin
+  if assigned(Exportlib) then
+    Exportlib.free;
 end;
 
 
 end.
 {
   $Log$
-  Revision 1.13  2001-04-13 01:22:07  peter
+  Revision 1.14  2001-04-18 22:01:53  peter
+    * registration of targets and assemblers
+
+  Revision 1.13  2001/04/13 01:22:07  peter
     * symtable change to classes
     * range check generation and errors fixed, make cycle DEBUG=1 works
     * memory leaks fixed

compiler/finput.pas

@@ -626,11 +626,11 @@ uses
          { lib and exe could be loaded with a file specified with -o }
          if AllowOutput and (OutputFile<>'') and (compile_level=1) then
           n:=OutputFile;
-         staticlibfilename:=stringdup(p+target_os.libprefix+n+target_os.staticlibext);
+         staticlibfilename:=stringdup(p+target_info.libprefix+n+target_info.staticlibext);
          if target_info.target=target_i386_WIN32 then
-           sharedlibfilename:=stringdup(p+n+target_os.sharedlibext)
+           sharedlibfilename:=stringdup(p+n+target_info.sharedlibext)
          else
-           sharedlibfilename:=stringdup(p+target_os.libprefix+n+target_os.sharedlibext);
+           sharedlibfilename:=stringdup(p+target_info.libprefix+n+target_info.sharedlibext);
          { output dir of exe can be specified separatly }
          if AllowOutput and (OutputExeDir<>'') then
           p:=OutputExeDir
@@ -683,7 +683,10 @@ uses
 end.
 {
   $Log$
-  Revision 1.8  2001-04-13 01:22:07  peter
+  Revision 1.9  2001-04-18 22:01:53  peter
+    * registration of targets and assemblers
+
+  Revision 1.8  2001/04/13 01:22:07  peter
     * symtable change to classes
     * range check generation and errors fixed, make cycle DEBUG=1 works
     * memory leaks fixed

compiler/fmodule.pas

@@ -49,8 +49,7 @@ interface
 
     type
        trecompile_reason = (rr_unknown,
-         rr_noppu,rr_sourcenewer,rr_build,rr_libolder,rr_objolder,
-         rr_asmolder,rr_crcchanged
+         rr_noppu,rr_sourcenewer,rr_build,rr_crcchanged
        );
 
        TExternalsItem=class(TLinkedListItem)
@@ -92,7 +91,6 @@ interface
 
           compiled,                 { unit is already compiled }
           do_reload,                { force reloading of the unit }
-          do_assemble,              { only assemble the object, don't recompile }
           do_compile,               { need to compile the sources }
           sources_avail,            { if all sources are reachable }
           sources_checked,          { if there is already done a check for the sources }
@@ -353,11 +351,11 @@ uses
          { lib and exe could be loaded with a file specified with -o }
          if AllowOutput and (OutputFile<>'') and (compile_level=1) then
           n:=OutputFile;
-         staticlibfilename:=stringdup(p+target_os.libprefix+n+target_os.staticlibext);
+         staticlibfilename:=stringdup(p+target_info.libprefix+n+target_info.staticlibext);
          if target_info.target=target_i386_WIN32 then
-           sharedlibfilename:=stringdup(p+n+target_os.sharedlibext)
+           sharedlibfilename:=stringdup(p+n+target_info.sharedlibext)
          else
-           sharedlibfilename:=stringdup(p+target_os.libprefix+n+target_os.sharedlibext);
+           sharedlibfilename:=stringdup(p+target_info.libprefix+n+target_info.sharedlibext);
          { output dir of exe can be specified separatly }
          if AllowOutput and (OutputExeDir<>'') then
           p:=OutputExeDir
@@ -369,9 +367,7 @@ uses
 
     function tmodule.openppu:boolean;
       var
-        objfiletime,
-        ppufiletime,
-        asmfiletime : longint;
+        ppufiletime : longint;
       begin
         openppu:=false;
         Message1(unit_t_ppu_loading,ppufilename^);
@@ -382,7 +378,7 @@ uses
       { Open the ppufile }
         Message1(unit_u_ppu_name,ppufilename^);
         ppufile:=new(pppufile,init(ppufilename^));
-        ppufile^.change_endian:=source_os.endian<>target_os.endian;
+        ppufile^.change_endian:=source_info.endian<>target_info.endian;
         if not ppufile^.open then
          begin
            dispose(ppufile,done);
@@ -426,53 +422,7 @@ uses
         Message1(unit_u_ppu_flags,tostr(flags));
         Message1(unit_u_ppu_crc,tostr(ppufile^.header.checksum));
         Message1(unit_u_ppu_crc,tostr(ppufile^.header.interface_checksum)+' (intfc)');
-      { check the object and assembler file to see if we need only to
-        assemble, only if it's not in a library }
         do_compile:=false;
-        if (flags and uf_in_library)=0 then
-         begin
-           if (flags and uf_smart_linked)<>0 then
-            begin
-              objfiletime:=getnamedfiletime(staticlibfilename^);
-              Message2(unit_u_check_time,staticlibfilename^,filetimestring(objfiletime));
-              if (ppufiletime<0) or (objfiletime<0) or (ppufiletime>objfiletime) then
-                begin
-                  recompile_reason:=rr_libolder;
-                  Message(unit_u_recompile_staticlib_is_older);
-                  do_compile:=true;
-                  exit;
-                end;
-            end;
-           if (flags and uf_static_linked)<>0 then
-            begin
-              { the objectfile should be newer than the ppu file }
-              objfiletime:=getnamedfiletime(objfilename^);
-              Message2(unit_u_check_time,objfilename^,filetimestring(objfiletime));
-              if (ppufiletime<0) or (objfiletime<0) or (ppufiletime>objfiletime) then
-               begin
-                 { check if assembler file is older than ppu file }
-                 asmfileTime:=GetNamedFileTime(asmfilename^);
-                 Message2(unit_u_check_time,asmfilename^,filetimestring(asmfiletime));
-                 if (asmfiletime<0) or (ppufiletime>asmfiletime) then
-                  begin
-                    Message(unit_u_recompile_obj_and_asm_older);
-                    recompile_reason:=rr_objolder;
-                    do_compile:=true;
-                    exit;
-                  end
-                 else
-                  begin
-                    Message(unit_u_recompile_obj_older_than_asm);
-                    if not(cs_asm_extern in aktglobalswitches) then
-                     begin
-                       do_compile:=true;
-                       recompile_reason:=rr_asmolder;
-                       exit;
-                     end;
-                  end;
-               end;
-            end;
-         end;
         openppu:=true;
       end;
 
@@ -517,11 +467,11 @@ uses
            do_compile:=true;
            recompile_reason:=rr_noppu;
          {Check for .pp file}
-           Found:=UnitExists(target_os.sourceext,hs);
+           Found:=UnitExists(target_info.sourceext,hs);
            if not Found then
             begin
               { Check for .pas }
-              Found:=UnitExists(target_os.pasext,hs);
+              Found:=UnitExists(target_info.pasext,hs);
             end;
            stringdispose(mainsource);
            if Found then
@@ -672,7 +622,6 @@ uses
         linkothersharedlibs.Free;
         linkothersharedlibs:=TLinkContainer.Create;
         uses_imports:=false;
-        do_assemble:=false;
         do_compile:=false;
         { sources_avail:=true;
         should not be changed PM }
@@ -733,7 +682,6 @@ uses
         interface_crc:=0;
         do_reload:=false;
         unitcount:=1;
-        do_assemble:=false;
         do_compile:=false;
         sources_avail:=true;
         sources_checked:=false;
@@ -878,7 +826,10 @@ uses
 end.
 {
   $Log$
-  Revision 1.12  2001-04-13 18:08:37  peter
+  Revision 1.13  2001-04-18 22:01:53  peter
+    * registration of targets and assemblers
+
+  Revision 1.12  2001/04/13 18:08:37  peter
     * scanner object to class
 
   Revision 1.11  2001/04/13 01:22:07  peter

compiler/globals.pas

@@ -159,29 +159,29 @@ interface
        {$ENDIF}
        initpackenum       : longint;
        initpackrecords    : tpackrecords;
-       initoutputformat   : tasm;
        initoptprocessor,
        initspecificoptprocessor : tprocessors;
        initasmmode        : tasmmode;
        initinterfacetype  : tinterfacetypes;
+       initoutputformat   : tasm;
      { current state values }
-       aktglobalswitches : tglobalswitches;
-       aktmoduleswitches : tmoduleswitches;
-       aktlocalswitches  : tlocalswitches;
+       aktglobalswitches  : tglobalswitches;
+       aktmoduleswitches  : tmoduleswitches;
+       aktlocalswitches   : tlocalswitches;
        nextaktlocalswitches : tlocalswitches;
        localswitcheschanged : boolean;
-       aktmodeswitches   : tmodeswitches;
+       aktmodeswitches    : tmodeswitches;
        {$IFDEF testvarsets}
         aktsetalloc,
        {$ENDIF}
-       aktpackenum       : longint;
-       aktmaxfpuregisters: longint;
-       aktpackrecords    : tpackrecords;
-       aktoutputformat   : tasm;
+       aktpackenum        : longint;
+       aktmaxfpuregisters : longint;
+       aktpackrecords     : tpackrecords;
        aktoptprocessor,
        aktspecificoptprocessor : tprocessors;
-       aktasmmode        : tasmmode;
-       aktinterfacetype  : tinterfacetypes;
+       aktasmmode         : tasmmode;
+       aktinterfacetype   : tinterfacetypes;
+       aktoutputformat    : tasm;
 
      { Memory sizes }
        heapsize,
@@ -253,7 +253,6 @@ interface
     Function  FixPath(s:string;allowdot:boolean):string;
     function  FixFileName(const s:string):string;
     procedure SplitBinCmd(const s:string;var bstr,cstr:string);
-    procedure SynchronizeFileTime(const fn1,fn2:string);
     function  FindFile(const f : string;path : string;var foundfile:string):boolean;
     function  FindExe(const bin:string;var foundfile:string):boolean;
     function  GetShortName(const n:string):string;
@@ -809,55 +808,26 @@ implementation
 
 
    Function GetFileTime ( Var F : File) : Longint;
-   Var
-   {$ifdef unix}
-     Info : Stat;
-   {$endif}
-     L : longint;
-   begin
-   {$ifdef unix}
-     FStat (F,Info);
-     L:=Info.Mtime;
-   {$else}
-     GetFTime(f,l);
-   {$endif}
-     GetFileTime:=L;
-   end;
+     Var
+     {$ifdef unix}
+       Info : Stat;
+     {$endif}
+       L : longint;
+     begin
+     {$ifdef unix}
+       FStat (F,Info);
+       L:=Info.Mtime;
+     {$else}
+       GetFTime(f,l);
+     {$endif}
+       GetFileTime:=L;
+     end;
 
 
    Function GetNamedFileTime (Const F : String) : Longint;
-   begin
-     GetNamedFileTime:=do_getnamedfiletime(F);
-   end;
-
-
-   {Touch Assembler and object time to ppu time is there is a ppufilename}
-   procedure SynchronizeFileTime(const fn1,fn2:string);
-   var
-     f : file;
-     l : longint;
-   begin
-     Assign(f,fn1);
-     {$I-}
-      reset(f,1);
-     {$I+}
-     if ioresult=0 then
-      begin
-        getftime(f,l);
-        { just to be sure in case there are rounding errors }
-        setftime(f,l);
-        close(f);
-        assign(f,fn2);
-        {$I-}
-         reset(f,1);
-        {$I+}
-        if ioresult=0 then
-         begin
-           setftime(f,l);
-           close(f);
-         end;
-      end;
-   end;
+     begin
+       GetNamedFileTime:=do_getnamedfiletime(F);
+     end;
 
 
    function FindFile(const f : string;path : string;var foundfile:string):boolean;
@@ -910,13 +880,13 @@ implementation
 
 
    function  FindExe(const bin:string;var foundfile:string):boolean;
-   begin
+     begin
 {$ifdef delphi}
-     FindExe:=FindFile(FixFileName(AddExtension(bin,source_os.exeext)),'.;'+exepath+';'+dmisc.getenv('PATH'),foundfile);
+       FindExe:=FindFile(FixFileName(AddExtension(bin,source_info.exeext)),'.;'+exepath+';'+dmisc.getenv('PATH'),foundfile);
 {$else delphi}
-     FindExe:=FindFile(FixFileName(AddExtension(bin,source_os.exeext)),'.;'+exepath+';'+dos.getenv('PATH'),foundfile);
+       FindExe:=FindFile(FixFileName(AddExtension(bin,source_info.exeext)),'.;'+exepath+';'+dos.getenv('PATH'),foundfile);
 {$endif delphi}
-   end;
+     end;
 
 
     function GetShortName(const n:string):string;
@@ -1197,9 +1167,9 @@ implementation
 {$ifdef need_path_search}
        if exepath='' then
         begin
-          if pos(source_os.exeext,hs1) <>
-               (length(hs1) - length(source_os.exeext)+1) then
-            hs1 := hs1 + source_os.exeext;
+          if pos(source_info.exeext,hs1) <>
+               (length(hs1) - length(source_info.exeext)+1) then
+            hs1 := hs1 + source_info.exeext;
       {$ifdef delphi}
           findfile(hs1,dmisc.getenv('PATH'),exepath);
       {$else delphi}
@@ -1262,6 +1232,7 @@ implementation
         initlocalswitches:=[cs_check_io];
         initmoduleswitches:=[cs_extsyntax,cs_browser];
         initglobalswitches:=[cs_check_unit_name,cs_link_static];
+        initoutputformat:=as_none;
 {$ifdef i386}
         initoptprocessor:=Class386;
         initspecificoptprocessor:=Class386;
@@ -1270,7 +1241,6 @@ implementation
         initsetalloc:=0;
         {$ENDIF}
         initpackrecords:=packrecord_2;
-        initoutputformat:=target_asm.id;
         initasmmode:=asmmode_i386_att;
 {$else not i386}
   {$ifdef m68k}
@@ -1312,7 +1282,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.31  2001-04-15 09:48:29  peter
+  Revision 1.32  2001-04-18 22:01:53  peter
+    * registration of targets and assemblers
+
+  Revision 1.31  2001/04/15 09:48:29  peter
     * fixed crash in labelnode
     * easier detection of goto and label in try blocks
 

compiler/hcgdata.pas

@@ -981,12 +981,12 @@ implementation
                 { allocate a pointer in the object memory }
                 with tstoredsymtable(_class.symtable) do
                   begin
-                    if (dataalignment>=target_os.size_of_pointer) then
+                    if (dataalignment>=target_info.size_of_pointer) then
                       datasize:=align(datasize,dataalignment)
                     else
-                      datasize:=align(datasize,target_os.size_of_pointer);
+                      datasize:=align(datasize,target_info.size_of_pointer);
                     _class.implementedinterfaces.ioffsets(i)^:=datasize;
-                    datasize:=datasize+target_os.size_of_pointer;
+                    datasize:=datasize+target_info.size_of_pointer;
                   end;
                 { write vtbl }
                 gintfcreatevtbl(i,rawdata,rawcode);
@@ -1266,7 +1266,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.19  2001-04-13 01:22:07  peter
+  Revision 1.20  2001-04-18 22:01:54  peter
+    * registration of targets and assemblers
+
+  Revision 1.19  2001/04/13 01:22:07  peter
     * symtable change to classes
     * range check generation and errors fixed, make cycle DEBUG=1 works
     * memory leaks fixed

compiler/i386/ag386att.pas

@@ -323,7 +323,7 @@ interface
           if (stabslastfileinfo.line<>fileinfo.line) and (fileinfo.line<>0) then
            begin
              if (n_line=n_textline) and assigned(funcname) and
-                (target_os.use_function_relative_addresses) then
+                (target_info.use_function_relative_addresses) then
               begin
                 AsmWriteLn(target_asm.labelprefix+'l'+tostr(linecount)+':');
                 AsmWrite(#9'.stabn '+tostr(n_line)+',0,'+tostr(fileinfo.line)+','+
@@ -889,10 +889,78 @@ interface
     end;
 
 
+{*****************************************************************************
+                                  Initialize
+*****************************************************************************}
+
+    const
+       as_i386_as_info : tasminfo =
+          (
+            id           : as_i386_as;
+            idtxt  : 'AS';
+            asmbin : 'as';
+            asmcmd : '-o $OBJ $ASM';
+            supported_target : target_any;
+            allowdirect : true;
+            externals : false;
+            needar : true;
+            labelprefix : '.L';
+            comment : '# ';
+            secnames : ('',
+              '.text','.data','.bss',
+              '','','','','','',
+              '.stab','.stabstr')
+          );
+
+       as_i386_as_aout_info : tasminfo =
+          (
+            id           : as_i386_as_aout;
+            idtxt  : 'AS_AOUT';
+            asmbin : 'as';
+            asmcmd : '-o $OBJ $ASM';
+            supported_target : target_i386_os2;
+            allowdirect : true;
+            externals : false;
+            needar : true;
+            labelprefix : 'L';
+            comment : '# ';
+            secnames : ('',
+              '.text','.data','.bss',
+              '','','','','','',
+              '.stab','.stabstr')
+          );
+
+       as_i386_asw_info : tasminfo =
+          (
+            id           : as_i386_asw;
+            idtxt  : 'ASW';
+            asmbin : 'asw';
+            asmcmd : '-o $OBJ $ASM';
+            supported_target : target_i386_win32;
+            allowdirect : true;
+            externals : false;
+            needar : true;
+            labelprefix : '.L';
+            comment : '# ';
+            secnames : ('',
+              '.text','.data','.section .bss',
+              '.section .idata$2','.section .idata$4','.section .idata$5',
+                '.section .idata$6','.section .idata$7','.section .edata',
+              '.stab','.stabstr')
+          );
+
+
+finalization
+  RegisterAssembler(as_i386_as_info,T386ATTAssembler);
+  RegisterAssembler(as_i386_as_aout_info,T386ATTAssembler);
+  RegisterAssembler(as_i386_asw_info,T386ATTAssembler);
 end.
 {
   $Log$
-  Revision 1.5  2001-04-13 01:22:17  peter
+  Revision 1.6  2001-04-18 22:02:00  peter
+    * registration of targets and assemblers
+
+  Revision 1.5  2001/04/13 01:22:17  peter
     * symtable change to classes
     * range check generation and errors fixed, make cycle DEBUG=1 works
     * memory leaks fixed

compiler/i386/ag386int.pas

@@ -498,7 +498,7 @@ interface
                                       end;
                                end; { end for i:=0 to... }
                              if quoted then AsmWrite('"');
-                               AsmWrite(target_os.newline);
+                               AsmWrite(target_info.newline);
                              counter := counter+line_length;
                           end; { end for j:=0 ... }
                         { do last line of lines }
@@ -745,10 +745,58 @@ ait_stab_function_name : ;
 {$endif EXTDEBUG}
    end;
 
+{*****************************************************************************
+                                  Initialize
+*****************************************************************************}
+
+    const
+       as_i386_tasm_info : tasminfo =
+          (
+            id           : as_i386_tasm;
+            idtxt  : 'TASM';
+            asmbin : 'tasm';
+            asmcmd : '/m2 /ml $ASM $OBJ';
+            supported_target : target_any; { what should I write here ?? }
+            allowdirect : true;
+            externals : true;
+            needar : true;
+            labelprefix_only_inside_procedure : true;
+            labelprefix : '@@';
+            comment : '; ';
+            secnames : ('',
+              'CODE','DATA','BSS',
+              '','','','','','',
+              '','')
+          );
+
+       as_i386_masm_info : tasminfo =
+          (
+            id           : as_i386_masm;
+            idtxt  : 'MASM';
+            asmbin : 'masm';
+            asmcmd : '/c $ASM /Fo$OBJ';
+            supported_target : target_any; { what should I write here ?? }
+            allowdirect : true;
+            externals : true;
+            needar : true;
+            labelprefix : '@@';
+            comment : '; ';
+            secnames : ('',
+              'CODE','DATA','BSS',
+              '','','','','','',
+              '','')
+          );
+
+finalization
+  RegisterAssembler(as_i386_tasm_info,T386IntelAssembler);
+  RegisterAssembler(as_i386_masm_info,T386IntelAssembler);
 end.
 {
   $Log$
-  Revision 1.9  2001-04-13 01:22:17  peter
+  Revision 1.10  2001-04-18 22:02:00  peter
+    * registration of targets and assemblers
+
+  Revision 1.9  2001/04/13 01:22:17  peter
     * symtable change to classes
     * range check generation and errors fixed, make cycle DEBUG=1 works
     * memory leaks fixed

compiler/i386/ag386nsm.pas

@@ -547,7 +547,7 @@ interface
                               end;
                        end; { end for i:=0 to... }
                      if quoted then AsmWrite('"');
-                       AsmWrite(target_os.newline);
+                       AsmWrite(target_info.newline);
                      inc(counter,line_length);
                   end; { end for j:=0 ... }
                 { do last line of lines }
@@ -770,10 +770,97 @@ interface
 {$endif EXTDEBUG}
    end;
 
+
+{*****************************************************************************
+                                  Initialize
+*****************************************************************************}
+
+    const
+       as_i386_nasmcoff_info : tasminfo =
+          (
+            id           : as_i386_nasmcoff;
+            idtxt  : 'NASMCOFF';
+            asmbin : 'nasm';
+            asmcmd : '-f coff -o $OBJ $ASM';
+            supported_target : target_i386_go32v2;
+            allowdirect : true;
+            externals : true;
+            needar : true;
+            labelprefix : '..@';
+            comment : '; ';
+            secnames : ('',
+              '.text','.data','.bss',
+              '.idata2','.idata4','.idata5','.idata6','.idata7','.edata',
+              '.stab','.stabstr')
+          );
+
+       as_i386_nasmwin32_info : tasminfo =
+          (
+            id           : as_i386_nasmwin32;
+            idtxt  : 'NASMWIN32';
+            asmbin : 'nasm';
+            asmcmd : '-f win32 -o $OBJ $ASM';
+            supported_target : target_i386_win32;
+            allowdirect : true;
+            externals : true;
+            needar : true;
+            labelprefix : '..@';
+            comment : '; ';
+            secnames : ('',
+              '.text','.data','.bss',
+              '.idata2','.idata4','.idata5','.idata6','.idata7','.edata',
+              '.stab','.stabstr')
+          );
+
+       as_i386_nasmobj_info : tasminfo =
+          (
+            id           : as_i386_nasmobj;
+            idtxt  : 'NASMOBJ';
+            asmbin : 'nasm';
+            asmcmd : '-f obj -o $OBJ $ASM';
+            supported_target : target_any; { what should I write here ?? }
+            allowdirect : true;
+            externals : true;
+            needar : true;
+            labelprefix : '..@';
+            comment : '; ';
+            secnames : ('',
+              '.text','.data','.bss',
+              '.idata2','.idata4','.idata5','.idata6','.idata7','.edata',
+              '.stab','.stabstr')
+          );
+
+       as_i386_nasmelf_info : tasminfo =
+          (
+            id           : as_i386_nasmelf;
+            idtxt  : 'NASMELF';
+            asmbin : 'nasm';
+            asmcmd : '-f elf -o $OBJ $ASM';
+            supported_target : target_i386_linux;
+            allowdirect : true;
+            externals : true;
+            needar : true;
+            labelprefix : '..@';
+            comment : '; ';
+            secnames : ('',
+              '.text','.data','.bss',
+              '.idata2','.idata4','.idata5','.idata6','.idata7','.edata',
+              '.stab','.stabstr')
+          );
+
+
+finalization
+  RegisterAssembler(as_i386_nasmcoff_info,T386NasmAssembler);
+  RegisterAssembler(as_i386_nasmwin32_info,T386NasmAssembler);
+  RegisterAssembler(as_i386_nasmobj_info,T386NasmAssembler);
+  RegisterAssembler(as_i386_nasmelf_info,T386NasmAssembler);
 end.
 {
   $Log$
-  Revision 1.7  2001-04-13 01:22:17  peter
+  Revision 1.8  2001-04-18 22:02:00  peter
+    * registration of targets and assemblers
+
+  Revision 1.7  2001/04/13 01:22:17  peter
     * symtable change to classes
     * range check generation and errors fixed, make cycle DEBUG=1 works
     * memory leaks fixed

compiler/i386/cgai386.pas

@@ -737,7 +737,7 @@ implementation
         case t.loc of
           LOC_REGISTER,
          LOC_CREGISTER : begin
-                           if target_os.stackalignment=4 then
+                           if target_info.stackalignment=4 then
                              exprasmList.concat(Taicpu.Op_reg(A_PUSH,S_L,makereg32(t.register)))
                            else
                              exprasmList.concat(Taicpu.Op_reg(A_PUSH,S_W,makereg16(t.register)));
@@ -745,7 +745,7 @@ implementation
                          end;
                LOC_MEM,
          LOC_REFERENCE : begin
-                           if target_os.stackalignment=4 then
+                           if target_info.stackalignment=4 then
                             opsize:=S_L
                            else
                             opsize:=S_W;
@@ -821,7 +821,7 @@ implementation
         if t.is_immediate then
           begin
             if (size=4) or
-               (target_os.stackalignment=4) then
+               (target_info.stackalignment=4) then
               exprasmList.concat(Taicpu.Op_const(A_PUSH,S_L,t.offset))
             else
               exprasmList.concat(Taicpu.Op_const(A_PUSH,S_W,t.offset));
@@ -837,7 +837,7 @@ implementation
               end;
               exprasmList.concat(Taicpu.Op_ref_reg(A_MOVZX,s,
                 newreference(t),R_EDI));
-              if target_os.stackalignment=4 then
+              if target_info.stackalignment=4 then
                 exprasmList.concat(Taicpu.Op_reg(A_PUSH,S_L,R_EDI))
               else
                 exprasmList.concat(Taicpu.Op_reg(A_PUSH,S_W,R_DI));
@@ -1869,7 +1869,7 @@ implementation
 {$ifndef NOTARGETWIN32}
               { windows guards only a few pages for stack growing, }
               { so we have to access every page first              }
-              if target_os.id=os_i386_win32 then
+              if target_info.target=target_i386_win32 then
                 begin
                    getlabel(again);
                    getlabel(ok);
@@ -2224,7 +2224,7 @@ implementation
 {$ifndef NOTARGETWIN32}
                             { windows guards only a few pages for stack growing, }
                             { so we have to access every page first              }
-                            if (target_os.id=os_i386_win32) and
+                            if (target_info.target=target_i386_win32) and
                               (stackframe>=winstackpagesize) then
                               begin
                                   if stackframe div winstackpagesize<=5 then
@@ -2359,7 +2359,7 @@ implementation
          hs:=aktprocsym.definition.aliasnames.getfirst;
 
 {$ifdef GDB}
-         if (cs_debuginfo in aktmoduleswitches) and target_os.use_function_relative_addresses then
+         if (cs_debuginfo in aktmoduleswitches) and target_info.use_function_relative_addresses then
            stab_function_name := Tai_stab_function_name.Create(strpnew(hs));
 {$EndIf GDB}
 
@@ -2372,7 +2372,7 @@ implementation
 
 {$ifdef GDB}
             if (cs_debuginfo in aktmoduleswitches) and
-               target_os.use_function_relative_addresses then
+               target_info.use_function_relative_addresses then
               exprasmList.insert(Tai_stab_function_name.Create(strpnew(hs)));
 {$endif GDB}
 
@@ -2385,7 +2385,7 @@ implementation
 {$ifdef GDB}
          if (cs_debuginfo in aktmoduleswitches) then
           begin
-            if target_os.use_function_relative_addresses then
+            if target_info.use_function_relative_addresses then
              exprasmList.insert(stab_function_name);
             exprasmList.insert(Tai_stabs.Create(aktprocsym.stabstring));
             aktprocsym.isstabwritten:=true;
@@ -2893,7 +2893,7 @@ implementation
               getmem(p,2*mangled_length+50);
               strpcopy(p,'192,0,0,');
               strpcopy(strend(p),aktprocsym.definition.mangledname);
-              if (target_os.use_function_relative_addresses) then
+              if (target_info.use_function_relative_addresses) then
                 begin
                   strpcopy(strend(p),'-');
                   strpcopy(strend(p),aktprocsym.definition.mangledname);
@@ -2904,7 +2904,7 @@ implementation
               p[0]:='2';p[1]:='2';p[2]:='4';
               strpcopy(strend(p),'_end');}
               strpcopy(p,'224,0,0,'+stabsendlabel.name);
-              if (target_os.use_function_relative_addresses) then
+              if (target_info.use_function_relative_addresses) then
                 begin
                   strpcopy(strend(p),'-');
                   strpcopy(strend(p),aktprocsym.definition.mangledname);
@@ -2929,10 +2929,10 @@ implementation
          tsymtable(current_module.globalsymtable).foreach_static({$ifndef TP}@{$endif}finalize_data);
          tsymtable(current_module.localsymtable).foreach_static({$ifndef TP}@{$endif}finalize_data);
          exprasmList.insert(Tai_symbol.Createname_global('FINALIZE$$'+current_module.modulename^,0));
-         exprasmList.insert(Tai_symbol.Createname_global(target_os.cprefix+current_module.modulename^+'_finalize',0));
+         exprasmList.insert(Tai_symbol.Createname_global(target_info.cprefix+current_module.modulename^+'_finalize',0));
 {$ifdef GDB}
          if (cs_debuginfo in aktmoduleswitches) and
-           target_os.use_function_relative_addresses then
+           target_info.use_function_relative_addresses then
            exprasmList.insert(Tai_stab_function_name.Create(strpnew('FINALIZE$$'+current_module.modulename^)));
 {$endif GDB}
          exprasmList.concat(Taicpu.Op_none(A_RET,S_NO));
@@ -2947,10 +2947,10 @@ implementation
          tsymtable(current_module.globalsymtable).foreach_static({$ifndef TP}@{$endif}finalize_data);
          tsymtable(current_module.localsymtable).foreach_static({$ifndef TP}@{$endif}finalize_data);
          exprasmList.insert(Tai_symbol.Createname_global('INIT$$'+current_module.modulename^,0));
-         exprasmList.insert(Tai_symbol.Createname_global(target_os.cprefix+current_module.modulename^+'_init',0));
+         exprasmList.insert(Tai_symbol.Createname_global(target_info.cprefix+current_module.modulename^+'_init',0));
 {$ifdef GDB}
          if (cs_debuginfo in aktmoduleswitches) and
-           target_os.use_function_relative_addresses then
+           target_info.use_function_relative_addresses then
            exprasmList.insert(Tai_stab_function_name.Create(strpnew('INIT$$'+current_module.modulename^)));
 {$endif GDB}
          exprasmList.concat(Taicpu.Op_none(A_RET,S_NO));
@@ -2983,7 +2983,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.20  2001-04-13 01:22:17  peter
+  Revision 1.21  2001-04-18 22:02:00  peter
+    * registration of targets and assemblers
+
+  Revision 1.20  2001/04/13 01:22:17  peter
     * symtable change to classes
     * range check generation and errors fixed, make cycle DEBUG=1 works
     * memory leaks fixed

compiler/i386/cputarg.pas

@@ -0,0 +1,88 @@
+{
+    $Id$
+    Copyright (c) 2001 by Peter Vreman
+
+    Includes the i386 dependent target units
+
+    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 cputarg;
+
+{$i defines.inc}
+
+interface
+
+
+implementation
+
+    uses
+      systems { prevent a syntax error when nothing is included }
+
+{**************************************
+             Targets
+**************************************}
+
+    {$ifndef NOTARGETLINUX}
+      ,t_linux
+    {$endif}
+    {$ifndef NOTARGETFREEBSD}
+      ,t_fbsd
+    {$endif}
+    {$ifndef NOTARGETSUNOS}
+      ,t_sunos
+    {$endif}
+    {$ifndef NOTARGETOS2}
+      ,t_os2
+    {$endif}
+    {$ifndef NOTARGETWIN32}
+      ,t_win32
+    {$endif}
+    {$ifndef NOTARGETNETWARE}
+      ,t_nwm
+    {$endif}
+    {$ifndef NOTARGETGO32V1}
+      ,t_go32v1
+    {$endif}
+    {$ifndef NOTARGETGO32V2}
+      ,t_go32v2
+    {$endif}
+
+{**************************************
+             Assemblers
+**************************************}
+
+    {$ifndef NOAG386ATT}
+      ,ag386att
+    {$endif}
+    {$ifndef NOAG386NSM}
+      ,ag386nsm
+    {$endif}
+    {$ifndef NOAG386INT}
+      ,ag386int
+    {$endif}
+
+      ,ogcoff
+      ,ogelf
+      ;
+
+end.
+{
+  $Log$
+  Revision 1.1  2001-04-18 22:02:01  peter
+    * registration of targets and assemblers
+
+}

compiler/i386/n386cal.pas

@@ -92,9 +92,9 @@ implementation
          r : preference;
 
       begin
-         { set default para_alignment to target_os.stackalignment }
+         { set default para_alignment to target_info.stackalignment }
          if para_alignment=0 then
-          para_alignment:=target_os.stackalignment;
+          para_alignment:=target_info.stackalignment;
 
          { push from left to right if specified }
          if push_from_left_to_right and assigned(right) then
@@ -286,7 +286,7 @@ implementation
          if ([pocall_cdecl,pocall_cppdecl,pocall_stdcall]*procdefinition.proccalloptions)<>[] then
           para_alignment:=4
          else
-          para_alignment:=target_os.stackalignment;
+          para_alignment:=target_info.stackalignment;
 
          if not assigned(procdefinition) then
           exit;
@@ -1463,7 +1463,7 @@ implementation
               mangled_length:=length(oldprocsym.definition.mangledname);
               getmem(pp,mangled_length+50);
               strpcopy(pp,'192,0,0,'+startlabel.name);
-              if (target_os.use_function_relative_addresses) then
+              if (target_info.use_function_relative_addresses) then
                 begin
                   strpcopy(strend(pp),'-');
                   strpcopy(strend(pp),oldprocsym.definition.mangledname);
@@ -1507,7 +1507,7 @@ implementation
             begin
               emitlab(endlabel);
               strpcopy(pp,'224,0,0,'+endlabel.name);
-             if (target_os.use_function_relative_addresses) then
+             if (target_info.use_function_relative_addresses) then
                begin
                  strpcopy(strend(pp),'-');
                  strpcopy(strend(pp),oldprocsym.definition.mangledname);
@@ -1549,7 +1549,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.21  2001-04-13 01:22:18  peter
+  Revision 1.22  2001-04-18 22:02:01  peter
+    * registration of targets and assemblers
+
+  Revision 1.21  2001/04/13 01:22:18  peter
     * symtable change to classes
     * range check generation and errors fixed, make cycle DEBUG=1 works
     * memory leaks fixed

compiler/i386/n386mem.pas

@@ -137,7 +137,7 @@ implementation
            begin
               pushusedregisters(pushed,$ff);
 
-              gettempofsizereference(target_os.size_of_pointer,location.reference);
+              gettempofsizereference(target_info.size_of_pointer,location.reference);
 
               { determines the size of the mem block }
               push_int(tpointerdef(resulttype.def).pointertype.def.size);
@@ -997,7 +997,7 @@ implementation
                       mangled_length:=length(aktprocsym.definition.mangledname);
                       getmem(pp,mangled_length+50);
                       strpcopy(pp,'192,0,0,'+withstartlabel.name);
-                      if (target_os.use_function_relative_addresses) then
+                      if (target_info.use_function_relative_addresses) then
                         begin
                           strpcopy(strend(pp),'-');
                           strpcopy(strend(pp),aktprocsym.definition.mangledname);
@@ -1019,7 +1019,7 @@ implementation
                      begin
                        emitlab(withendlabel);
                        strpcopy(pp,'224,0,0,'+withendlabel.name);
-                      if (target_os.use_function_relative_addresses) then
+                      if (target_info.use_function_relative_addresses) then
                         begin
                           strpcopy(strend(pp),'-');
                           strpcopy(strend(pp),aktprocsym.definition.mangledname);
@@ -1055,7 +1055,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.12  2001-04-13 01:22:19  peter
+  Revision 1.13  2001-04-18 22:02:03  peter
+    * registration of targets and assemblers
+
+  Revision 1.12  2001/04/13 01:22:19  peter
     * symtable change to classes
     * range check generation and errors fixed, make cycle DEBUG=1 works
     * memory leaks fixed

compiler/i386/n386util.pas

@@ -291,7 +291,7 @@ implementation
       { copy the element on the stack, slightly complicated }
         if p.nodetype=ordconstn then
          begin
-           if target_os.stackalignment=4 then
+           if target_info.stackalignment=4 then
              exprasmList.concat(Taicpu.Op_const(A_PUSH,S_L,tordconstnode(p).value))
            else
              exprasmList.concat(Taicpu.Op_const(A_PUSH,S_W,tordconstnode(p).value));
@@ -320,7 +320,7 @@ implementation
                        hr32:=reg8toreg32(hr);
                      end;
                  end;
-                 if target_os.stackalignment=4 then
+                 if target_info.stackalignment=4 then
                    exprasmList.concat(Taicpu.Op_reg(A_PUSH,S_L,hr32))
                  else
                    exprasmList.concat(Taicpu.Op_reg(A_PUSH,S_W,hr16));
@@ -1472,7 +1472,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.15  2001-04-13 01:22:19  peter
+  Revision 1.16  2001-04-18 22:02:03  peter
+    * registration of targets and assemblers
+
+  Revision 1.15  2001/04/13 01:22:19  peter
     * symtable change to classes
     * range check generation and errors fixed, make cycle DEBUG=1 works
     * memory leaks fixed

compiler/i386/ra386att.pas

@@ -2120,26 +2120,29 @@ end;
                                      Initialize
 *****************************************************************************}
 
-var
-  old_exit : pointer;
+const
+  asmmode_i386_att_info : tasmmodeinfo =
+          (
+            id    : asmmode_i386_att;
+            idtxt : 'ATT'
+          );
 
-procedure ra386att_exit;
-begin
-  exitproc:=old_exit;
+initialization
+  RegisterAsmMode(asmmode_i386_att_info);
+
+finalization
   if assigned(iasmops) then
     iasmops.Free;
   if assigned(iasmregs) then
     dispose(iasmregs);
-end;
-
 
-begin
-   old_exit:=exitproc;
-   exitproc:=@ra386att_exit;
 end.
 {
   $Log$
-  Revision 1.11  2001-04-13 20:06:05  peter
+  Revision 1.12  2001-04-18 22:02:03  peter
+    * registration of targets and assemblers
+
+  Revision 1.11  2001/04/13 20:06:05  peter
     * allow unit.identifier in asm readers
 
   Revision 1.10  2001/04/13 18:20:21  peter

compiler/i386/ra386dir.pas

@@ -284,10 +284,27 @@ interface
        assemble:=casmnode.create(code);
      end;
 
+{*****************************************************************************
+                                     Initialize
+*****************************************************************************}
+
+const
+  asmmode_i386_direct_info : tasmmodeinfo =
+          (
+            id    : asmmode_i386_direct;
+            idtxt : 'DIRECT'
+          );
+
+initialization
+  RegisterAsmMode(asmmode_i386_direct_info);
+
 end.
 {
   $Log$
-  Revision 1.8  2001-04-13 18:20:21  peter
+  Revision 1.9  2001-04-18 22:02:03  peter
+    * registration of targets and assemblers
+
+  Revision 1.8  2001/04/13 18:20:21  peter
     * scanner object to class
 
   Revision 1.7  2001/04/13 01:22:21  peter

compiler/i386/ra386int.pas

@@ -1949,26 +1949,29 @@ end;
                                      Initialize
 *****************************************************************************}
 
-var
-  old_exit : pointer;
+const
+  asmmode_i386_intel_info : tasmmodeinfo =
+          (
+            id    : asmmode_i386_intel;
+            idtxt : 'INTEL'
+          );
 
-procedure ra386int_exit;
-begin
-  exitproc:=old_exit;
+initialization
+  RegisterAsmMode(asmmode_i386_intel_info);
+
+finalization
   if assigned(iasmops) then
     iasmops.Free;
   if assigned(iasmregs) then
     dispose(iasmregs);
-end;
-
 
-begin
-   old_exit:=exitproc;
-   exitproc:=@ra386int_exit;
 end.
 {
   $Log$
-  Revision 1.14  2001-04-13 20:06:05  peter
+  Revision 1.15  2001-04-18 22:02:03  peter
+    * registration of targets and assemblers
+
+  Revision 1.14  2001/04/13 20:06:05  peter
     * allow unit.identifier in asm readers
 
   Revision 1.13  2001/04/13 18:20:21  peter

compiler/import.pas

@@ -27,6 +27,7 @@ interface
 
 uses
   cutils,cclasses,
+  systems,
   aasm;
 
 type
@@ -34,7 +35,7 @@ type
       ordnr  : word;
       name,
       func   : pstring;
-      lab    : tasmlabel; { should be plabel, but this gaves problems with circular units }
+      lab    : tasmlabel;
       is_var : boolean;
       constructor Create(const n,s : string;o : word);
       constructor Create_var(const n,s : string);
@@ -74,56 +75,24 @@ type
      function Scan(const binname:string):longbool;virtual;abstract;
    end;
 
+   TImportLibClass=class of TImportLib;
+   TDLLScannerClass=class of TDLLScanner;
 
 var
-  importlib : timportlib;
+  CImportLib  : array[ttarget] of TImportLibClass;
+  CDLLScanner : array[ttarget] of TDLLScannerClass;
+  ImportLib   : TImportLib;
 
+procedure RegisterImport(t:ttarget;c:TImportLibClass);
+procedure RegisterDLLScanner(t:ttarget;c:TDLLScannerClass);
 procedure InitImport;
 procedure DoneImport;
 
+
 implementation
 
 uses
-  systems,verbose,globals
-{$ifdef i386}
-  {$ifndef NOTARGETLINUX}
-    ,t_linux
-  {$endif}
-  {$ifndef NOTARGETFREEBSD}
-   ,t_fbsd
-  {$endif}
-  {$ifndef NOTARGETSUNOS}
-   ,t_sunos
-  {$endif}
-  {$ifndef NOTARGETOS2}
-    ,t_os2
-  {$endif}
-  {$ifndef NOTARGETWIN32}
-    ,t_win32
-  {$endif}
-  {$ifndef NOTARGETNETWARE}
-    ,t_nwm
-  {$endif}
-  {$ifndef NOTARGETGO32V2}
-    ,t_go32v2
-  {$endif}
-{$endif}
-{$ifdef m68k}
-  {$ifndef NOTARGETLINUX}
-    ,t_linux
-  {$endif}
-{$endif}
-{$ifdef powerpc}
-  {$ifndef NOTARGETLINUX}
-    ,t_linux
-  {$endif}
-{$endif}
-{$ifdef alpha}
-  {$ifndef NOTARGETLINUX}
-    ,t_linux
-  {$endif}
-{$endif}
-  ;
+  verbose,globals;
 
 {****************************************************************************
                            Timported_item
@@ -234,64 +203,44 @@ begin
 end;
 
 
-procedure DoneImport;
+{*****************************************************************************
+                                 Init/Done
+*****************************************************************************}
+
+procedure RegisterImport(t:ttarget;c:TImportLibClass);
 begin
-  if assigned(importlib) then
-    importlib.free;
+  CImportLib[t]:=c;
+end;
+
+
+procedure RegisterDLLScanner(t:ttarget;c:TDLLScannerClass);
+begin
+  CDLLScanner[t]:=c;
 end;
 
 
 procedure InitImport;
 begin
-  case target_info.target of
-{$ifdef i386}
-  {$ifndef NOTARGETLINUX}
-    target_i386_Linux :
-      importlib:=Timportliblinux.Create;
-  {$endif}
-  {$ifndef NOTARGETFREEBSD}
-    target_i386_freebsd:
-      importlib:=Timportlibfreebsd.Create;
-  {$endif}
-  {$ifndef NOTARGETSUNOS}
-    target_i386_sunos:
-      importlib:=Timportlibsunos.Create;
-  {$endif}
-  {$ifndef NOTARGETWIN32}
-    target_i386_Win32 :
-      importlib:=Timportlibwin32.Create;
-  {$endif}
-  {$ifndef NOTARGETOS2}
-    target_i386_OS2 :
-      importlib:=Timportlibos2.Create;
-  {$endif}
-  {$ifndef NOTARGETNETWARE}
-    target_i386_netware :
-      importlib:=Timportlibnetware.Create;
-  {$endif}
-{$endif i386}
-{$ifdef m68k}
-    target_m68k_Linux :
-      importlib:=Timportliblinux.Create;
-{$endif m68k}
-{$ifdef alpha}
-    target_alpha_Linux :
-      importlib:=Timportliblinux.Create;
-{$endif alpha}
-{$ifdef powerpc}
-    target_alpha_Linux :
-      importlib:=Timportliblinux.Create;
-{$endif powerpc}
-    else
-      importlib:=Timportlib.Create;
-  end;
+  if assigned(CImportLib[target_info.target]) then
+   importlib:=CImportLib[target_info.target].Create
+  else
+   importlib:=TImportLib.Create;
 end;
 
 
+procedure DoneImport;
+begin
+  if assigned(importlib) then
+    importlib.free;
+end;
+
 end.
 {
   $Log$
-  Revision 1.12  2001-04-13 01:22:08  peter
+  Revision 1.13  2001-04-18 22:01:54  peter
+    * registration of targets and assemblers
+
+  Revision 1.12  2001/04/13 01:22:08  peter
     * symtable change to classes
     * range check generation and errors fixed, make cycle DEBUG=1 works
     * memory leaks fixed

compiler/link.pas

@@ -72,9 +72,10 @@ Type
      TLinkerClass = class of TLinker;
 
 var
-  CLinker : array[ttarget] of TLinkerClass;
+  CLinker : array[tld] of TLinkerClass;
   Linker  : TLinker;
 
+procedure RegisterLinker(t:tld;c:TLinkerClass);
 procedure InitLinker;
 procedure DoneLinker;
 
@@ -88,49 +89,8 @@ uses
   dos,
 {$endif Delphi}
   cutils,globtype,
-  script,globals,verbose,ppu
-{$ifdef i386}
-  {$ifndef NOTARGETLINUX}
-    ,t_linux
-  {$endif}
-  {$ifndef NOTARGETFREEBSD}
-    ,t_fbsd
-  {$endif}
-  {$ifndef NOTARGETSUNOS}
-    ,t_sunos
-  {$endif}
-  {$ifndef NOTARGETOS2}
-    ,t_os2
-  {$endif}
-  {$ifndef NOTARGETWIN32}
-    ,t_win32
-  {$endif}
-  {$ifndef NOTARGETNETWARE}
-    ,t_nwm
-  {$endif}
-  {$ifndef NOTARGETGO32V1}
-    ,t_go32v1
-  {$endif}
-  {$ifndef NOTARGETGO32V2}
-    ,t_go32v2
-  {$endif}
-{$endif}
-{$ifdef m68k}
-  {$ifndef NOTARGETLINUX}
-    ,t_linux
-  {$endif}
-{$endif}
-{$ifdef powerpc}
-  {$ifndef NOTARGETLINUX}
-    ,t_linux
-  {$endif}
-{$endif}
-{$ifdef alpha}
-  {$ifndef NOTARGETLINUX}
-    ,t_linux
-  {$endif}
-{$endif}
-  ;
+  script,globals,verbose,ppu;
+
 
 {*****************************************************************************
                                    TLINKER
@@ -258,7 +218,7 @@ var
   FoundBin : string;
   UtilExe  : string;
 begin
-  UtilExe:=AddExtension(s,source_os.exeext);
+  UtilExe:=AddExtension(s,source_info.exeext);
   FoundBin:='';
   Found:=false;
   if utilsdirectory<>'' then
@@ -363,11 +323,11 @@ begin
   if s='' then
    exit;
 { remove prefix 'lib' }
-  if Copy(s,1,length(target_os.libprefix))=target_os.libprefix then
-   Delete(s,1,length(target_os.libprefix));
+  if Copy(s,1,length(target_info.libprefix))=target_info.libprefix then
+   Delete(s,1,length(target_info.libprefix));
 { remove extension if any }
-  if Copy(s,length(s)-length(target_os.sharedlibext)+1,length(target_os.sharedlibext))=target_os.sharedlibext then
-   Delete(s,length(s)-length(target_os.sharedlibext)+1,length(target_os.sharedlibext)+1);
+  if Copy(s,length(s)-length(target_info.sharedlibext)+1,length(target_info.sharedlibext))=target_info.sharedlibext then
+   Delete(s,length(s)-length(target_info.sharedlibext)+1,length(target_info.sharedlibext)+1);
 { ready to be inserted }
   SharedLibFiles.Insert (S);
 end;
@@ -380,7 +340,7 @@ var
 begin
   if s='' then
    exit;
-  ns:=FindLibraryFile(s,target_os.staticlibext,found);
+  ns:=FindLibraryFile(s,target_info.staticlibext,found);
   if not(cs_link_extern in aktglobalswitches) and (not found) then
    Message1(exec_w_libfile_not_found,s);
   StaticLibFiles.Insert(ns);
@@ -483,68 +443,18 @@ end;
                                  Init/Done
 *****************************************************************************}
 
+procedure RegisterLinker(t:tld;c:TLinkerClass);
+begin
+  CLinker[t]:=c;
+end;
+
+
 procedure InitLinker;
 begin
-  case target_info.target of
-{$ifdef i386}
-  {$ifndef NOTARGETLINUX}
-    target_i386_linux :
-      linker:=Tlinkerlinux.Create;
-  {$endif}
-  {$ifndef NOTARGETFreeBSD}
-    target_i386_FreeBSD :
-      linker:=TlinkerFreeBSD.Create;
-  {$endif}
-  {$ifndef NOTARGETSUNOS}
-    target_i386_sunos :
-      linker:=Tlinkersunos.Create;
-  {$endif}
-  {$ifndef NOTARGETWIN32}
-    target_i386_Win32 :
-      linker:=Tlinkerwin32.Create;
-  {$endif}
-  {$ifndef NOTARGETNETWARE}
-    target_i386_Netware :
-      linker:=Tlinkernetware.Create;
-  {$endif}
-  {$ifndef NOTARGETGO32V1}
-    target_i386_Go32v1 :
-      linker:=TLinkergo32v1.Create;
-  {$endif}
-  {$ifndef NOTARGETGO32V2}
-    target_i386_Go32v2 :
-      linker:=TLinkergo32v2.Create;
-  {$endif}
-  {$ifndef NOTARGETOS2}
-    target_i386_os2 :
-      linker:=TLinkeros2.Create;
-  {$endif}
-{$endif i386}
-{$ifdef m68k}
-  {$ifndef NOTARGETPALMOS}
-    target_m68k_palmos:
-      linker:=Tlinker.Create;
-  {$endif}
-  {$ifndef NOTARGETLINUX}
-    target_m68k_linux :
-      linker:=Tlinkerlinux.Create;
-  {$endif}
-{$endif m68k}
-{$ifdef alpha}
-  {$ifndef NOTARGETLINUX}
-    target_alpha_linux :
-      linker:=Tlinkerlinux.Create;
-  {$endif}
-{$endif alpha}
-{$ifdef powerpc}
-  {$ifndef NOTARGETLINUX}
-    target_powerpc_linux :
-      linker:=Tlinkerlinux.Create;
-  {$endif}
-{$endif powerpc}
-    else
-      linker:=Tlinker.Create;
-  end;
+  if assigned(CLinker[target_info.link]) then
+   linker:=CLinker[target_info.link].Create
+  else
+   linker:=Tlinker.Create;
 end;
 
 
@@ -554,10 +464,28 @@ begin
    Linker.Free;
 end;
 
+
+{*****************************************************************************
+                                   Initialize
+*****************************************************************************}
+
+    const
+      ar_gnu_ar_info : tarinfo =
+          (
+            id    : ar_gnu_ar;
+            arcmd : 'ar rs $LIB $FILES'
+          );
+
+initialization
+  RegisterAr(ar_gnu_ar_info);
+
 end.
 {
   $Log$
-  Revision 1.15  2001-04-13 01:22:08  peter
+  Revision 1.16  2001-04-18 22:01:54  peter
+    * registration of targets and assemblers
+
+  Revision 1.15  2001/04/13 01:22:08  peter
     * symtable change to classes
     * range check generation and errors fixed, make cycle DEBUG=1 works
     * memory leaks fixed

compiler/ncal.pas

@@ -1546,11 +1546,11 @@ implementation
       begin
          inherited create(procinlinen);
          inlineprocsym:=tcallnode(callp).symtableprocentry;
-         retoffset:=-target_os.size_of_pointer; { less dangerous as zero (PM) }
+         retoffset:=-target_info.size_of_pointer; { less dangerous as zero (PM) }
          para_offset:=0;
-         para_size:=inlineprocsym.definition.para_size(target_os.stackalignment);
+         para_size:=inlineprocsym.definition.para_size(target_info.stackalignment);
          if ret_in_param(inlineprocsym.definition.rettype.def) then
-           para_size:=para_size+target_os.size_of_pointer;
+           para_size:=para_size+target_info.size_of_pointer;
          { copy args }
          if assigned(code) then
            inlinetree:=code.getcopy
@@ -1617,7 +1617,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.29  2001-04-13 23:52:29  peter
+  Revision 1.30  2001-04-18 22:01:54  peter
+    * registration of targets and assemblers
+
+  Revision 1.29  2001/04/13 23:52:29  peter
     * don't allow passing signed-unsigned ords to var parameter, this
       forbids smallint-word, shortint-byte, longint-cardinal mixtures.
       It's still allowed in tp7 -So mode.

compiler/ogcoff.pas

@@ -36,7 +36,7 @@ interface
        { target }
        systems,
        { assembler }
-       cpubase,aasm,
+       cpubase,aasm,assemble,
        { output }
        ogbase;
 
@@ -100,6 +100,14 @@ interface
          procedure readfromdisk;override;
        end;
 
+       tcoffassembler = class(tinternalassembler)
+         constructor create(smart:boolean);override;
+       end;
+
+       tpecoffassembler = class(tinternalassembler)
+         constructor create(smart:boolean);override;
+       end;
+
 
 implementation
 
@@ -1084,11 +1092,81 @@ implementation
       end;
 
 
+{****************************************************************************
+                                 TCoffAssembler
+****************************************************************************}
+
+    constructor TCoffAssembler.Create(smart:boolean);
+      begin
+        inherited Create(smart);
+        objectoutput:=tcoffobjectoutput.createdjgpp(smart);
+      end;
+
+
+{****************************************************************************
+                               TPECoffAssembler
+****************************************************************************}
+
+    constructor TPECoffAssembler.Create(smart:boolean);
+      begin
+        inherited Create(smart);
+        objectoutput:=tcoffobjectoutput.createwin32(smart);
+      end;
+
 
+{*****************************************************************************
+                                  Initialize
+*****************************************************************************}
+
+    const
+       as_i386_coff_info : tasminfo =
+          (
+            id     : as_i386_coff;
+            idtxt  : 'COFF';
+            asmbin : '';
+            asmcmd : '';
+            supported_target : target_i386_go32v2;
+            allowdirect : false;
+            externals : true;
+            needar : false;
+            labelprefix : '.L';
+            comment : '';
+            secnames : ('',
+              '.text','.data','.bss',
+              '.idata$2','.idata$4','.idata$5','.idata$6','.idata$7','.edata',
+              '.stab','.stabstr')
+          );
+
+    const
+       as_i386_pecoff_info : tasminfo =
+          (
+            id     : as_i386_pecoff;
+            idtxt  : 'PECOFF';
+            asmbin : '';
+            asmcmd : '';
+            supported_target : target_i386_win32;
+            allowdirect : false;
+            externals : true;
+            needar : false;
+            labelprefix : '.L';
+            comment : '';
+            secnames : ('',
+              '.text','.data','.bss',
+              '.idata$2','.idata$4','.idata$5','.idata$6','.idata$7','.edata',
+              '.stab','.stabstr')
+          );
+
+
+initialization
+  RegisterAssembler(as_i386_coff_info,TCoffAssembler);
+  RegisterAssembler(as_i386_pecoff_info,TPECoffAssembler);
 end.
 {
   $Log$
-  Revision 1.12  2001-04-13 01:22:10  peter
+  Revision 1.13  2001-04-18 22:01:54  peter
+    * registration of targets and assemblers
+
+  Revision 1.12  2001/04/13 01:22:10  peter
     * symtable change to classes
     * range check generation and errors fixed, make cycle DEBUG=1 works
     * memory leaks fixed

compiler/ogelf.pas

@@ -36,7 +36,7 @@ interface
        { target }
        systems,
        { assembler }
-       cpubase,aasm,
+       cpubase,aasm,assemble,
        { output }
        ogbase;
 
@@ -92,6 +92,10 @@ interface
          function  initwriting(const fn:string):boolean;override;
        end;
 
+       telf32assembler = class(tinternalassembler)
+         constructor create(smart:boolean);override;
+       end;
+
 
 implementation
 
@@ -843,10 +847,51 @@ implementation
          end;
       end;
 
+
+{****************************************************************************
+                               TELFAssembler
+****************************************************************************}
+
+    constructor TELF32Assembler.Create(smart:boolean);
+      begin
+        inherited Create(smart);
+        objectoutput:=telf32objectoutput.create(smart);
+      end;
+
+
+{*****************************************************************************
+                                  Initialize
+*****************************************************************************}
+
+    const
+       as_i386_elf32_info : tasminfo =
+          (
+            id     : as_i386_elf32;
+            idtxt  : 'ELF';
+            asmbin : '';
+            asmcmd : '';
+            supported_target : target_any;  //target_i386_linux;
+            allowdirect : false;
+            externals : true;
+            needar : false;
+            labelprefix : '.L';
+            comment : '';
+            secnames : ('',
+              '.text','.data','.bss',
+              '.idata$2','.idata$4','.idata$5','.idata$6','.idata$7','.edata',
+              '.stab','.stabstr')
+          );
+
+
+initialization
+  RegisterAssembler(as_i386_elf32_info,TElf32Assembler);
 end.
 {
   $Log$
-  Revision 1.7  2001-04-13 01:22:10  peter
+  Revision 1.8  2001-04-18 22:01:54  peter
+    * registration of targets and assemblers
+
+  Revision 1.7  2001/04/13 01:22:10  peter
     * symtable change to classes
     * range check generation and errors fixed, make cycle DEBUG=1 works
     * memory leaks fixed

compiler/options.pas

@@ -120,7 +120,7 @@ end;
 
 procedure set_default_link_type;
 begin
-  if (target_os.id=os_i386_win32) then
+  if (target_info.target=target_i386_win32) then
     begin
       def_symbol('FPC_LINK_SMART');
       undef_symbol('FPC_LINK_STATIC');
@@ -328,6 +328,7 @@ var
   j,l  : longint;
   d    : DirStr;
   e    : ExtStr;
+  forceasm : tasm;
 begin
   if opt='' then
    exit;
@@ -358,11 +359,8 @@ begin
                        end;
                     end;
               'A' : begin
-                      if set_string_asm(More) then
-                       begin
-                         initoutputformat:=target_asm.id;
-                         asm_is_set:=true;
-                       end
+                      if set_target_asm_by_string(More) then
+                       asm_is_set:=true
                       else
                        IllegalPara(opt);
                     end;
@@ -726,19 +724,23 @@ begin
                             end;
                          end;
                          { remove old target define }
-                         undef_symbol(target_info.short_name);
-                       { load new target }
-                         if not(set_string_target(More)) then
+                         undef_symbol(upper(target_info.shortname));
+                         { Save assembler if set }
+                         if asm_is_set then
+                          forceasm:=target_asm.id;
+                         { load new target }
+                         if not(set_target_by_string(More)) then
                            IllegalPara(opt);
-                       { set new define }
-                         def_symbol(target_info.short_name);
-                         if not asm_is_set then
-                           initoutputformat:=target_asm.id;
+                         { also initialize assembler if not explicitly set }
+                         if asm_is_set then
+                          set_target_asm(forceasm);
+                         { set new define }
+                         def_symbol(upper(target_info.shortname));
                          target_is_set:=true;
                        end
                       else
-                       if More<>target_info.short_name then
-                        Message1(option_target_is_already_set,target_info.short_name);
+                       if More<>upper(target_info.shortname) then
+                        Message1(option_target_is_already_set,target_info.shortname);
                     end;
               'u' : undef_symbol(upper(More));
               'U' : begin
@@ -1183,7 +1185,7 @@ begin
           inc(i);
           case quickinfo[i] of
            'O' :
-             addinfo(source_os.shortname);
+             addinfo(lower(source_info.shortname));
 {$ifdef Delphi}
            'P' :
              addinfo('i386');
@@ -1200,7 +1202,7 @@ begin
           inc(i);
           case quickinfo[i] of
            'O' :
-             addinfo(target_os.shortname);
+             addinfo(lower(target_info.shortname));
            'P' :
              AddInfo(target_cpu_string);
            else
@@ -1260,7 +1262,7 @@ begin
   disable_configfile:=false;
 
 { default defines }
-  def_symbol(target_info.short_name);
+  def_symbol(upper(target_info.shortname));
   def_symbol('FPC');
   def_symbol('VER'+version_nr);
   def_symbol('VER'+version_nr+'_'+release_nr);
@@ -1454,11 +1456,11 @@ begin
   fsplit(param_file,inputdir,inputfile,inputextension);
   if inputextension='' then
    begin
-     if FileExists(inputdir+inputfile+target_os.sourceext) then
-      inputextension:=target_os.sourceext
+     if FileExists(inputdir+inputfile+target_info.sourceext) then
+      inputextension:=target_info.sourceext
      else
-      if FileExists(inputdir+inputfile+target_os.pasext) then
-       inputextension:=target_os.pasext;
+      if FileExists(inputdir+inputfile+target_info.pasext) then
+       inputextension:=target_info.pasext;
    end;
 
 { Add paths specified with parameters to the searchpaths }
@@ -1498,12 +1500,12 @@ begin
   { first try development RTL, else use the default installation path }
   if not disable_configfile then
     begin
-      if PathExists(FpcDir+'rtl/'+lower(target_info.short_name)) then
-       UnitSearchPath.AddPath(FpcDir+'rtl/'+lower(target_info.short_name),false)
+      if PathExists(FpcDir+'rtl/'+lower(target_info.shortname)) then
+       UnitSearchPath.AddPath(FpcDir+'rtl/'+lower(target_info.shortname),false)
       else
        begin
-         UnitSearchPath.AddPath(FpcDir+'units/'+lower(target_info.short_name),false);
-         UnitSearchPath.AddPath(FpcDir+'units/'+lower(target_info.short_name)+'/rtl',false);
+         UnitSearchPath.AddPath(FpcDir+'units/'+lower(target_info.shortname),false);
+         UnitSearchPath.AddPath(FpcDir+'units/'+lower(target_info.shortname)+'/rtl',false);
        end;
     end;
   { Add exepath if the exe is not in the current dir, because that is always searched already }
@@ -1515,21 +1517,18 @@ begin
 
 { switch assembler if it's binary and we got -a on the cmdline }
   if (cs_asm_leave in initglobalswitches) and
-     (target_asm.id in binassem) then
+     (target_asm.outputbinary) then
    begin
      Message(option_switch_bin_to_src_assembler);
-     set_target_asm(target_info.assemsrc);
-     initoutputformat:=target_asm.id;
+     set_target_asm(target_info.assemextern);
    end;
 
   if (target_asm.supported_target <> target_any) and
      (target_asm.supported_target <> target_info.target) then
    begin
-     Message2(option_incompatible_asm,target_asm.idtxt,target_os.name);
-     { Should we reset to default ??? }
-     set_target_asm(target_info.assemsrc);
+     Message2(option_incompatible_asm,target_asm.idtxt,target_info.name);
+     set_target_asm(target_info.assemextern);
      Message1(option_asm_forced,target_asm.idtxt);
-     initoutputformat:=target_asm.id;
    end;
 
 { turn off stripping if compiling with debuginfo or profile }
@@ -1557,7 +1556,10 @@ finalization
 end.
 {
   $Log$
-  Revision 1.39  2001-04-13 01:22:10  peter
+  Revision 1.40  2001-04-18 22:01:54  peter
+    * registration of targets and assemblers
+
+  Revision 1.39  2001/04/13 01:22:10  peter
     * symtable change to classes
     * range check generation and errors fixed, make cycle DEBUG=1 works
     * memory leaks fixed

compiler/parser.pas

@@ -101,7 +101,7 @@ implementation
          AsmRes:=TAsmScript.Create(outputexedir+'ppas');
 
          { open deffile }
-         DefFile:=TDefFile.Create(outputexedir+inputfile+target_os.defext);
+         DefFile:=TDefFile.Create(outputexedir+inputfile+target_info.defext);
 
          { list of generated .o files, so the linker can remove them }
          SmartLinkOFiles:=TStringList.Create;
@@ -620,7 +620,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.16  2001-04-15 09:48:30  peter
+  Revision 1.17  2001-04-18 22:01:54  peter
+    * registration of targets and assemblers
+
+  Revision 1.16  2001/04/15 09:48:30  peter
     * fixed crash in labelnode
     * easier detection of goto and label in try blocks
 

compiler/pdecobj.pas

@@ -816,7 +816,7 @@ implementation
              begin
                 include(aktprocsym.definition.proccalloptions,pocall_cppdecl);
                 aktprocsym.definition.setmangledname(
-                  target_os.Cprefix+aktprocsym.definition.cplusplusmangledname);
+                  target_info.Cprefix+aktprocsym.definition.cplusplusmangledname);
              end;
         end;
 
@@ -1032,7 +1032,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.21  2001-04-13 01:22:11  peter
+  Revision 1.22  2001-04-18 22:01:54  peter
+    * registration of targets and assemblers
+
+  Revision 1.21  2001/04/13 01:22:11  peter
     * symtable change to classes
     * range check generation and errors fixed, make cycle DEBUG=1 works
     * memory leaks fixed

compiler/pdecsub.pas

@@ -553,7 +553,7 @@ begin
   if lexlevel>normal_function_level then
     begin
       procinfo^.framepointer_offset:=paramoffset;
-      inc(paramoffset,target_os.size_of_pointer);
+      inc(paramoffset,target_info.size_of_pointer);
       { this is needed to get correct framepointer push for local
         forward functions !! }
       pd.parast.symtablelevel:=lexlevel;
@@ -562,7 +562,7 @@ begin
   if assigned (procinfo^._Class)  and
      is_object(procinfo^._Class) and
      (pd.proctypeoption in [potype_constructor,potype_destructor]) then
-    inc(paramoffset,target_os.size_of_pointer);
+    inc(paramoffset,target_info.size_of_pointer);
 
   { self pointer offset                       }
   { self isn't pushed in nested procedure of methods }
@@ -571,14 +571,14 @@ begin
       procinfo^.selfpointer_offset:=paramoffset;
       if assigned(aktprocsym.definition) and
          not(po_containsself in aktprocsym.definition.procoptions) then
-        inc(paramoffset,target_os.size_of_pointer);
+        inc(paramoffset,target_info.size_of_pointer);
     end;
 
   { con/-destructor flag ? }
   if assigned (procinfo^._Class) and
      is_class(procinfo^._class) and
      (pd.proctypeoption in [potype_destructor,potype_constructor]) then
-    inc(paramoffset,target_os.size_of_pointer);
+    inc(paramoffset,target_info.size_of_pointer);
 
   procinfo^.para_offset:=paramoffset;
 
@@ -813,7 +813,7 @@ end;
 
 procedure pd_asmname;
 begin
-  aktprocsym.definition.setmangledname(target_os.Cprefix+pattern);
+  aktprocsym.definition.setmangledname(target_info.Cprefix+pattern);
   if token=_CCHAR then
     consume(_CCHAR)
   else
@@ -939,7 +939,7 @@ end;
 procedure pd_cdecl;
 begin
   if aktprocsym.definition.deftype<>procvardef then
-    aktprocsym.definition.setmangledname(target_os.Cprefix+aktprocsym.realname);
+    aktprocsym.definition.setmangledname(target_info.Cprefix+aktprocsym.realname);
   { do not copy on local !! }
   if (aktprocsym.definition.deftype=procdef) and
      assigned(aktprocsym.definition.parast) then
@@ -950,7 +950,7 @@ procedure pd_cppdecl;
 begin
   if aktprocsym.definition.deftype<>procvardef then
     aktprocsym.definition.setmangledname(
-      target_os.Cprefix+aktprocsym.definition.cplusplusmangledname);
+      target_info.Cprefix+aktprocsym.definition.cplusplusmangledname);
   { do not copy on local !! }
   if (aktprocsym.definition.deftype=procdef) and
      assigned(aktprocsym.definition.parast) then
@@ -1516,7 +1516,7 @@ const
        { Adjust positions of args for cdecl or stdcall }
          if (aktprocsym.definition.deftype=procdef) and
             (([pocall_cdecl,pocall_cppdecl,pocall_stdcall]*aktprocsym.definition.proccalloptions)<>[]) then
-           tstoredsymtable(aktprocsym.definition.parast).set_alignment(target_os.size_of_longint);
+           tstoredsymtable(aktprocsym.definition.parast).set_alignment(target_info.size_of_longint);
 
       { Call the handler }
         if pointer({$ifndef FPCPROCVAR}@{$endif}proc_direcdata[p].handler)<>nil then
@@ -1847,7 +1847,10 @@ const
 end.
 {
   $Log$
-  Revision 1.20  2001-04-13 20:05:16  peter
+  Revision 1.21  2001-04-18 22:01:57  peter
+    * registration of targets and assemblers
+
+  Revision 1.20  2001/04/13 20:05:16  peter
     * better check for globalsymtable
 
   Revision 1.19  2001/04/13 18:03:16  peter

compiler/pdecvar.pas

@@ -187,7 +187,7 @@ implementation
                      writeln('problem with strContStack in pdecl (3)');
 {$endif fixLeaksOnError}
                   sc.free;
-                  aktvarsym:=tvarsym.create_C(s,target_os.Cprefix+C_name,tt);
+                  aktvarsym:=tvarsym.create_C(s,target_info.Cprefix+C_name,tt);
                   include(aktvarsym.varoptions,vo_is_external);
                   symtablestack.insert(aktvarsym);
                   akttokenpos:=storetokenpos;
@@ -331,7 +331,7 @@ implementation
                       consume(_CVAR);
                       consume(_SEMICOLON);
                       is_cdecl:=true;
-                      C_name:=target_os.Cprefix+C_name;
+                      C_name:=target_info.Cprefix+C_name;
                     end;
                    { external }
                    if idtoken=_EXTERNAL then
@@ -529,7 +529,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.15  2001-04-13 01:22:12  peter
+  Revision 1.16  2001-04-18 22:01:57  peter
+    * registration of targets and assemblers
+
+  Revision 1.15  2001/04/13 01:22:12  peter
     * symtable change to classes
     * range check generation and errors fixed, make cycle DEBUG=1 works
     * memory leaks fixed

compiler/pexports.pas

@@ -86,7 +86,7 @@ implementation
                         an underline }
                       if InternalProcName[1]='_' then
                         delete(InternalProcName,1,1)
-                      else if (target_os.id=os_i386_win32) and UseDeffileForExport then
+                      else if (target_info.target=target_i386_win32) and UseDeffileForExport then
                         begin
                           Message(parser_e_dlltool_unit_var_problem);
                           Message(parser_e_dlltool_unit_var_problem2);
@@ -108,7 +108,7 @@ implementation
                        end;
                       hp.options:=hp.options or eo_index;
                       pt.free;
-                      if target_os.id=os_i386_win32 then
+                      if target_info.target=target_i386_win32 then
                        DefString:=srsym.realname+'='+InternalProcName+' @ '+tostr(hp.index)
                       else
                        DefString:=srsym.realname+'='+InternalProcName; {Index ignored!}
@@ -163,7 +163,10 @@ end.
 
 {
   $Log$
-  Revision 1.14  2001-04-13 01:22:12  peter
+  Revision 1.15  2001-04-18 22:01:57  peter
+    * registration of targets and assemblers
+
+  Revision 1.14  2001/04/13 01:22:12  peter
     * symtable change to classes
     * range check generation and errors fixed, make cycle DEBUG=1 works
     * memory leaks fixed

compiler/pmodules.pas

@@ -54,9 +54,6 @@ implementation
        hcodegen,
 {$ifdef i386}
        cgai386,
-  {$ifndef NOTARGETWIN32}
-       t_win32,
-  {$endif}
 {$endif i386}
 {$endif newcg}
        link,assemble,import,export,gendef,ppu,comprsrc,
@@ -76,18 +73,9 @@ implementation
            (not current_module.linkOtherSharedLibs.Empty) then
          begin
            { Init DLLScanner }
-           DLLScanner:=nil;
-           case target_info.target of
-             target_none :
-               ;
-{$ifdef i386}
-  {$ifndef NOTARGETWIN32}
-             target_i386_win32 :
-               DLLScanner:=tDLLscannerWin32.create;
-  {$endif NOTARGETWIN32}
-{$endif}
-           end;
-           if DLLScanner=nil then
+           if assigned(CDLLScanner[target_info.target]) then
+            DLLScanner:=CDLLScanner[target_info.target].Create
+           else
             internalerror(200104121);
            { Walk all shared libs }
            While not current_module.linkOtherSharedLibs.Empty do
@@ -165,7 +153,7 @@ implementation
          begin
            dataSegment.insert(Tai_align.Create(4));
            dataSegment.insert(Tai_string.Create('FPC '+full_version_string+
-             ' ['+date_string+'] for '+target_cpu_string+' - '+target_info.short_name));
+             ' ['+date_string+'] for '+target_cpu_string+' - '+target_info.shortname));
          end;
       { finish codesegment }
         codeSegment.concat(Tai_align.Create(16));
@@ -517,12 +505,6 @@ implementation
                 if (not current_scanner.invalid) then
                   current_scanner.tempopeninputfile;
               end;
-           end
-          else
-           begin
-           { only reassemble ? }
-             if (current_module.do_assemble) then
-              OnlyAsm;
            end;
          if assigned(current_module.ppufile) then
            begin
@@ -952,7 +934,7 @@ implementation
         aktprocsym.definition:=tprocdef.create;
         symtablestack:=stt;
         aktprocsym.definition.proctypeoption:=options;
-        aktprocsym.definition.setmangledname(target_os.cprefix+name);
+        aktprocsym.definition.setmangledname(target_info.cprefix+name);
         aktprocsym.definition.forwarddef:=false;
         make_ref:=true;
         { The localst is a local symtable. Change it into the static
@@ -1212,7 +1194,7 @@ implementation
          codegen_newprocedure;
          gen_main_procsym(current_module.modulename^+'_init',potype_unitinit,st);
          aktprocsym.definition.aliasnames.insert('INIT$$'+current_module.modulename^);
-         aktprocsym.definition.aliasnames.insert(target_os.cprefix+current_module.modulename^+'_init');
+         aktprocsym.definition.aliasnames.insert(target_info.cprefix+current_module.modulename^+'_init');
          compile_proc_body(true,false);
          codegen_doneprocedure;
 
@@ -1244,7 +1226,7 @@ implementation
               codegen_newprocedure;
               gen_main_procsym(current_module.modulename^+'_finalize',potype_unitfinalize,st);
               aktprocsym.definition.aliasnames.insert('FINALIZE$$'+current_module.modulename^);
-              aktprocsym.definition.aliasnames.insert(target_os.cprefix+current_module.modulename^+'_finalize');
+              aktprocsym.definition.aliasnames.insert(target_info.cprefix+current_module.modulename^+'_finalize');
               compile_proc_body(true,false);
               codegen_doneprocedure;
            end
@@ -1342,7 +1324,25 @@ implementation
 
          if cs_local_browser in aktmoduleswitches then
            current_module.localsymtable:=refsymtable;
-         { Write out the ppufile }
+{$ifdef GDB}
+         pu:=tused_unit(usedunits.first);
+         while assigned(pu) do
+           begin
+              if assigned(pu.u.globalsymtable) then
+                tglobalsymtable(pu.u.globalsymtable).is_stab_written:=false;
+              pu:=tused_unit(pu.next);
+           end;
+{$endif GDB}
+
+         if is_assembler_generated then
+          begin
+          { finish asmlist by adding segment starts }
+            insertsegment;
+          { assemble }
+            create_objectfile;
+          end;
+
+         { Write out the ppufile after the object file has been created }
          store_interface_crc:=current_module.interface_crc;
          store_crc:=current_module.crc;
          if (Errorcount=0) then
@@ -1358,17 +1358,9 @@ implementation
              Comment(V_Warning,current_module.ppufilename^+' implementation CRC changed '+
                tostr(store_crc)+'<>'+tostr(current_module.interface_crc));
 {$endif EXTDEBUG}
+
          { must be done only after local symtable ref stores !! }
          closecurrentppu;
-{$ifdef GDB}
-         pu:=tused_unit(usedunits.first);
-         while assigned(pu) do
-           begin
-              if assigned(pu.u.globalsymtable) then
-                tglobalsymtable(pu.u.globalsymtable).is_stab_written:=false;
-              pu:=tused_unit(pu.next);
-           end;
-{$endif GDB}
 
          { remove static symtable (=refsymtable) here to save some mem }
          if not (cs_local_browser in aktmoduleswitches) then
@@ -1379,14 +1371,6 @@ implementation
 
          RestoreUnitSyms;
 
-         if is_assembler_generated then
-          begin
-          { finish asmlist by adding segment starts }
-            insertsegment;
-          { assemble }
-            create_objectfile;
-          end;
-
          { leave when we got an error }
          if (Errorcount>0) and not status.skip_error then
           begin
@@ -1515,7 +1499,7 @@ implementation
          gen_main_procsym('main',potype_proginit,st);
          aktprocsym.definition.aliasnames.insert('program_init');
          aktprocsym.definition.aliasnames.insert('PASCALMAIN');
-         aktprocsym.definition.aliasnames.insert(target_os.cprefix+'main');
+         aktprocsym.definition.aliasnames.insert(target_info.cprefix+'main');
 {$ifdef m68k}
          if target_info.target=target_m68k_PalmOS then
            aktprocsym.definition.aliasnames.insert('PilotMain');
@@ -1551,7 +1535,7 @@ implementation
               codegen_newprocedure;
               gen_main_procsym(current_module.modulename^+'_finalize',potype_unitfinalize,st);
               aktprocsym.definition.aliasnames.insert('FINALIZE$$'+current_module.modulename^);
-              aktprocsym.definition.aliasnames.insert(target_os.cprefix+current_module.modulename^+'_finalize');
+              aktprocsym.definition.aliasnames.insert(target_info.cprefix+current_module.modulename^+'_finalize');
               compile_proc_body(true,false);
               codegen_doneprocedure;
            end;
@@ -1639,7 +1623,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.28  2001-04-13 18:08:37  peter
+  Revision 1.29  2001-04-18 22:01:57  peter
+    * registration of targets and assemblers
+
+  Revision 1.28  2001/04/13 18:08:37  peter
     * scanner object to class
 
   Revision 1.27  2001/04/13 01:22:12  peter

compiler/pstatmnt.pas

@@ -1201,8 +1201,8 @@ implementation
              begin
                procinfo^.framepointer:=stack_pointer;
                { set the right value for parameters }
-               dec(aktprocsym.definition.parast.address_fixup,target_os.size_of_pointer);
-               dec(procinfo^.para_offset,target_os.size_of_pointer);
+               dec(aktprocsym.definition.parast.address_fixup,target_info.size_of_pointer);
+               dec(procinfo^.para_offset,target_info.size_of_pointer);
              end;
           { force the asm statement }
             if token<>_ASM then
@@ -1217,7 +1217,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.26  2001-04-15 09:48:30  peter
+  Revision 1.27  2001-04-18 22:01:57  peter
+    * registration of targets and assemblers
+
+  Revision 1.26  2001/04/15 09:48:30  peter
     * fixed crash in labelnode
     * easier detection of goto and label in try blocks
 

compiler/psub.pas

@@ -648,7 +648,7 @@ implementation
          if ret_in_param(procinfo^.returntype.def) then
           begin
             procinfo^.return_offset:=procinfo^.para_offset;
-            inc(procinfo^.para_offset,target_os.size_of_pointer);
+            inc(procinfo^.para_offset,target_info.size_of_pointer);
           end;
          { allows to access the parameters of main functions in nested functions }
          aktprocsym.definition.parast.address_fixup:=procinfo^.para_offset;
@@ -803,7 +803,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.30  2001-04-14 14:05:47  peter
+  Revision 1.31  2001-04-18 22:01:57  peter
+    * registration of targets and assemblers
+
+  Revision 1.30  2001/04/14 14:05:47  peter
     * better skipping of secondpass if error
 
   Revision 1.29  2001/04/13 23:49:24  peter

compiler/ptconst.pas

@@ -795,7 +795,7 @@ implementation
                                    curconstsegment.concat(tai_const.create_8bit(0));
                                  curconstsegment.concat(tai_const_symbol.createname(tobjectdef(t.def).vmt_mangledname));
                                  { this is more general }
-                                 aktpos:=tobjectdef(t.def).vmt_offset + target_os.size_of_pointer;
+                                 aktpos:=tobjectdef(t.def).vmt_offset + target_info.size_of_pointer;
                                end;
 
                              { if needed fill }
@@ -822,7 +822,7 @@ implementation
                          curconstsegment.concat(tai_const.create_8bit(0));
                        curconstsegment.concat(tai_const_symbol.createname(tobjectdef(t.def).vmt_mangledname));
                        { this is more general }
-                       aktpos:=tobjectdef(t.def).vmt_offset + target_os.size_of_pointer;
+                       aktpos:=tobjectdef(t.def).vmt_offset + target_info.size_of_pointer;
                      end;
                    for i:=1 to t.def.size-aktpos do
                      curconstSegment.concat(Tai_const.Create_8bit(0));
@@ -847,7 +847,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.21  2001-04-13 01:22:13  peter
+  Revision 1.22  2001-04-18 22:01:57  peter
+    * registration of targets and assemblers
+
+  Revision 1.21  2001/04/13 01:22:13  peter
     * symtable change to classes
     * range check generation and errors fixed, make cycle DEBUG=1 works
     * memory leaks fixed

compiler/rautils.pas

@@ -868,7 +868,7 @@ Begin
               if (tvarsym(sym).varspez=vs_var) or
                  ((tvarsym(sym).varspez=vs_const) and
                  push_addr_param(tvarsym(sym).vartype.def)) then
-                SetSize(target_os.size_of_pointer,false);
+                SetSize(target_info.size_of_pointer,false);
             end;
           localsymtable :
             begin
@@ -908,7 +908,7 @@ Begin
               if (tvarsym(sym).varspez in [vs_var,vs_out]) or
                  ((tvarsym(sym).varspez=vs_const) and
                   push_addr_param(tvarsym(sym).vartype.def)) then
-                SetSize(target_os.size_of_pointer,false);
+                SetSize(target_info.size_of_pointer,false);
             end;
         end;
         case tvarsym(sym).vartype.def.deftype of
@@ -1583,7 +1583,10 @@ end;
 end.
 {
   $Log$
-  Revision 1.19  2001-04-13 20:06:05  peter
+  Revision 1.20  2001-04-18 22:01:58  peter
+    * registration of targets and assemblers
+
+  Revision 1.19  2001/04/13 20:06:05  peter
     * allow unit.identifier in asm readers
 
   Revision 1.18  2001/04/13 01:22:13  peter

compiler/scandir.pas

@@ -90,9 +90,9 @@ implementation
            if not localswitcheschanged then
              nextaktlocalswitches:=aktlocalswitches;
            if state='-' then
-            nextaktlocalswitches:=nextaktlocalswitches-[sw]
+            exclude(nextaktlocalswitches,sw)
            else
-            nextaktlocalswitches:=nextaktlocalswitches+[sw];
+            include(nextaktlocalswitches,sw);
            localswitcheschanged:=true;
          end;
       end;
@@ -104,6 +104,7 @@ implementation
         Message1(w,current_scanner.readcomment);
       end;
 
+
 {*****************************************************************************
                               Directive Callbacks
 *****************************************************************************}
@@ -124,7 +125,7 @@ implementation
         if s='DEFAULT' then
          aktasmmode:=initasmmode
         else
-         if not set_string_asmmode(s,aktasmmode) then
+         if not set_asmmode_by_string(s,aktasmmode) then
           Message1(scan_w_unsupported_asmmode_specifier,s);
       end;
 
@@ -446,7 +447,7 @@ implementation
         else
           begin
             current_scanner.skipspace;
-            if set_string_asm(current_scanner.readid) then
+            if set_target_asm_by_string(current_scanner.readid) then
              aktoutputformat:=target_asm.id
             else
              Message1(scan_w_illegal_switch,pattern);
@@ -567,7 +568,7 @@ implementation
             end;
         s:=AddExtension(FixFileName(s),target_info.resext);
         if target_info.res<>res_none then
-          if (target_info.res = res_i386_emx) and
+          if (target_info.res = res_emxbind) and
                                  not (Current_module.ResourceFiles.Empty) then
             Message(scan_w_only_one_resourcefile_supported)
           else
@@ -808,7 +809,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.1  2001-04-13 18:00:36  peter
+  Revision 1.2  2001-04-18 22:01:58  peter
+    * registration of targets and assemblers
+
+  Revision 1.1  2001/04/13 18:00:36  peter
     * easier registration of directives
 
   Revision 1.20  2001/04/13 01:22:13  peter

compiler/script.pas

@@ -88,7 +88,7 @@ end;
 
 constructor TScript.CreateExec(const s:string);
 begin
-  fn:=FixFileName(s)+source_os.scriptext;
+  fn:=FixFileName(s)+source_info.scriptext;
   executable:=true;
   data:=TStringList.Create;
 end;
@@ -238,7 +238,10 @@ end;
 end.
 {
   $Log$
-  Revision 1.8  2001-04-13 01:22:14  peter
+  Revision 1.9  2001-04-18 22:01:58  peter
+    * registration of targets and assemblers
+
+  Revision 1.8  2001/04/13 01:22:14  peter
     * symtable change to classes
     * range check generation and errors fixed, make cycle DEBUG=1 works
     * memory leaks fixed

compiler/symdef.pas

@@ -1191,7 +1191,7 @@ implementation
          string_typ:=st_longstring;
          deftype:=stringdef;
          len:=l;
-         savesize:=target_os.size_of_pointer;
+         savesize:=target_info.size_of_pointer;
       end;
 
 
@@ -1201,7 +1201,7 @@ implementation
          deftype:=stringdef;
          string_typ:=st_longstring;
          len:=readlong;
-         savesize:=target_os.size_of_pointer;
+         savesize:=target_info.size_of_pointer;
       end;
 
 
@@ -1211,7 +1211,7 @@ implementation
          string_typ:=st_ansistring;
          deftype:=stringdef;
          len:=l;
-         savesize:=target_os.size_of_pointer;
+         savesize:=target_info.size_of_pointer;
       end;
 
 
@@ -1221,7 +1221,7 @@ implementation
          deftype:=stringdef;
          string_typ:=st_ansistring;
          len:=readlong;
-         savesize:=target_os.size_of_pointer;
+         savesize:=target_info.size_of_pointer;
       end;
 
 
@@ -1231,7 +1231,7 @@ implementation
          string_typ:=st_widestring;
          deftype:=stringdef;
          len:=l;
-         savesize:=target_os.size_of_pointer;
+         savesize:=target_info.size_of_pointer;
       end;
 
 
@@ -1241,7 +1241,7 @@ implementation
          deftype:=stringdef;
          string_typ:=st_widestring;
          len:=readlong;
-         savesize:=target_os.size_of_pointer;
+         savesize:=target_info.size_of_pointer;
       end;
 
 
@@ -1546,7 +1546,7 @@ implementation
         memsize := memsizeinc;
         getmem(st,memsize);
         { we can specify the size with @s<size>; prefix PM }
-        if savesize <> target_os.size_of_longint then
+        if savesize <> target_info.size_of_longint then
           strpcopy(st,'@s'+tostr(savesize*8)+';e')
         else
           strpcopy(st,'e');
@@ -2159,7 +2159,7 @@ implementation
         deftype:=pointerdef;
         pointertype:=tt;
         is_far:=false;
-        savesize:=target_os.size_of_pointer;
+        savesize:=target_info.size_of_pointer;
       end;
 
 
@@ -2169,7 +2169,7 @@ implementation
         deftype:=pointerdef;
         pointertype:=tt;
         is_far:=true;
-        savesize:=target_os.size_of_pointer;
+        savesize:=target_info.size_of_pointer;
       end;
 
 
@@ -2179,7 +2179,7 @@ implementation
          deftype:=pointerdef;
          pointertype.load;
          is_far:=(readbyte<>0);
-         savesize:=target_os.size_of_pointer;
+         savesize:=target_info.size_of_pointer;
       end;
 
 
@@ -2287,7 +2287,7 @@ implementation
          deftype:=classrefdef;
          pointertype.load;
          is_far:=false;
-         savesize:=target_os.size_of_pointer;
+         savesize:=target_info.size_of_pointer;
       end;
 
 
@@ -2485,7 +2485,7 @@ implementation
               tsymtable(current_module.localsymtable).registerdef(self)
             else if assigned(current_module.globalsymtable) then
               tsymtable(current_module.globalsymtable).registerdef(self);
-         savesize:=target_os.size_of_pointer;
+         savesize:=target_info.size_of_pointer;
       end;
 
 
@@ -2493,7 +2493,7 @@ implementation
       begin
          inherited loaddef;
          deftype:=formaldef;
-         savesize:=target_os.size_of_pointer;
+         savesize:=target_info.size_of_pointer;
       end;
 
 
@@ -3053,7 +3053,7 @@ implementation
          procoptions:=[];
          rettype:=voidtype;
          symtablelevel:=0;
-         savesize:=target_os.size_of_pointer;
+         savesize:=target_info.size_of_pointer;
       end;
 
 
@@ -3123,7 +3123,7 @@ implementation
          readsmallset(proccalloptions);
          readsmallset(procoptions);
          count:=readword;
-         savesize:=target_os.size_of_pointer;
+         savesize:=target_info.size_of_pointer;
          for i:=1 to count do
           begin
             hp:=TParaItem.Create;
@@ -3178,10 +3178,10 @@ implementation
           begin
             case pdc.paratyp of
               vs_out,
-              vs_var   : inc(l,target_os.size_of_pointer);
+              vs_var   : inc(l,target_info.size_of_pointer);
               vs_value,
               vs_const : if push_addr_param(pdc.paratype.def) then
-                          inc(l,target_os.size_of_pointer)
+                          inc(l,target_info.size_of_pointer)
                          else
                           inc(l,pdc.paratype.def.size);
             end;
@@ -3915,9 +3915,9 @@ Const local_symtable_index : longint = $8001;
     function tprocvardef.size : longint;
       begin
          if (po_methodpointer in procoptions) then
-           size:=2*target_os.size_of_pointer
+           size:=2*target_info.size_of_pointer
          else
-           size:=target_os.size_of_pointer;
+           size:=target_info.size_of_pointer;
       end;
 
 
@@ -4244,7 +4244,7 @@ Const local_symtable_index : longint = $8001;
                   inc(symtable.datasize,c.symtable.datasize);
                   if (oo_has_vmt in objectoptions) and
                      (oo_has_vmt in c.objectoptions) then
-                    dec(symtable.datasize,target_os.size_of_pointer);
+                    dec(symtable.datasize,target_info.size_of_pointer);
                   { if parent has a vmt field then
                     the offset is the same for the child PM }
                   if (oo_has_vmt in c.objectoptions) or is_class(self) then
@@ -4278,7 +4278,7 @@ Const local_symtable_index : longint = $8001;
                    inc(symtable.datasize,4-(symtable.datasize mod 4));
                end;
              vmt_offset:=symtable.datasize;
-             inc(symtable.datasize,target_os.size_of_pointer);
+             inc(symtable.datasize,target_info.size_of_pointer);
              include(objectoptions,oo_has_vmt);
           end;
      end;
@@ -4364,7 +4364,7 @@ Const local_symtable_index : longint = $8001;
     function tobjectdef.size : longint;
       begin
         if objecttype in [odt_class,odt_interfacecom,odt_interfacecorba] then
-          size:=target_os.size_of_pointer
+          size:=target_info.size_of_pointer
         else
           size:=symtable.datasize;
       end;
@@ -4381,14 +4381,14 @@ Const local_symtable_index : longint = $8001;
         { for offset of methods for classes, see rtl/inc/objpash.inc }
         case objecttype of
         odt_class:
-          vmtmethodoffset:=(index+12)*target_os.size_of_pointer;
+          vmtmethodoffset:=(index+12)*target_info.size_of_pointer;
         odt_interfacecom,odt_interfacecorba:
-          vmtmethodoffset:=index*target_os.size_of_pointer;
+          vmtmethodoffset:=index*target_info.size_of_pointer;
         else
 {$ifdef WITHDMT}
-          vmtmethodoffset:=(index+4)*target_os.size_of_pointer;
+          vmtmethodoffset:=(index+4)*target_info.size_of_pointer;
 {$else WITHDMT}
-          vmtmethodoffset:=(index+3)*target_os.size_of_pointer;
+          vmtmethodoffset:=(index+3)*target_info.size_of_pointer;
 {$endif WITHDMT}
         end;
       end;
@@ -5515,7 +5515,10 @@ Const local_symtable_index : longint = $8001;
 end.
 {
   $Log$
-  Revision 1.27  2001-04-13 01:22:15  peter
+  Revision 1.28  2001-04-18 22:01:58  peter
+    * registration of targets and assemblers
+
+  Revision 1.27  2001/04/13 01:22:15  peter
     * symtable change to classes
     * range check generation and errors fixed, make cycle DEBUG=1 works
     * memory leaks fixed

compiler/symsym.pas

@@ -1376,12 +1376,12 @@ implementation
               case varspez of
                 vs_out,
                 vs_var :
-                  getpushsize:=target_os.size_of_pointer;
+                  getpushsize:=target_info.size_of_pointer;
                 vs_value,
                 vs_const :
                   begin
                       if push_addr_param(vartype.def) then
-                        getpushsize:=target_os.size_of_pointer
+                        getpushsize:=target_info.size_of_pointer
                       else
                         getpushsize:=vartype.def.size;
                   end;
@@ -1545,7 +1545,7 @@ implementation
                         end;
                       if varalign=0 then
                         varalign:=l;
-                      if (owner.dataalignment<target_os.maxCrecordalignment) then
+                      if (owner.dataalignment<target_info.maxCrecordalignment) then
                        begin
                          if (varalign>16) and (owner.dataalignment<32) then
                           owner.dataalignment:=32
@@ -1561,8 +1561,8 @@ implementation
                          else if (varalign>1) and (owner.dataalignment<2) then
                           owner.dataalignment:=2;
                        end;
-                      if owner.dataalignment>target_os.maxCrecordalignment then
-                        owner.dataalignment:=target_os.maxCrecordalignment;
+                      if owner.dataalignment>target_info.maxCrecordalignment then
+                        owner.dataalignment:=target_info.maxCrecordalignment;
                     end
                    else
                     varalign:=vartype.def.alignment;
@@ -1621,7 +1621,7 @@ implementation
                    l:=getpushsize;
                    varstate:=vs_assigned;
                    address:=owner.datasize;
-                   owner.datasize:=align(owner.datasize+l,target_os.stackalignment);
+                   owner.datasize:=align(owner.datasize+l,target_info.stackalignment);
                  end
                else
                  begin
@@ -2328,7 +2328,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.10  2001-04-13 01:22:16  peter
+  Revision 1.11  2001-04-18 22:01:59  peter
+    * registration of targets and assemblers
+
+  Revision 1.10  2001/04/13 01:22:16  peter
     * symtable change to classes
     * range check generation and errors fixed, make cycle DEBUG=1 works
     * memory leaks fixed

compiler/symtable.pas

@@ -1095,7 +1095,7 @@ implementation
             if cs_gdb_dbx in aktglobalswitches then
              flags:=flags or uf_has_dbx;
 {$endif GDB}
-            if target_os.endian=endian_big then
+            if target_info.endian=endian_big then
              flags:=flags or uf_big_endian;
             if cs_browser in aktmoduleswitches then
              flags:=flags or uf_has_browser;
@@ -1131,7 +1131,7 @@ implementation
            end;
 {$endif def Test_Double_checksum}
 
-         current_ppu^.change_endian:=source_os.endian<>target_os.endian;
+         current_ppu^.change_endian:=source_info.endian<>target_info.endian;
        { write symbols and definitions }
          unittable.write;
 
@@ -2567,7 +2567,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.33  2001-04-13 20:05:15  peter
+  Revision 1.34  2001-04-18 22:01:59  peter
+    * registration of targets and assemblers
+
+  Revision 1.33  2001/04/13 20:05:15  peter
     * better check for globalsymtable
 
   Revision 1.32  2001/04/13 18:08:37  peter

compiler/targets/t_amiga.pas

@@ -0,0 +1,97 @@
+{
+    $Id$
+    Copyright (c) 2001 by Peter Vreman
+
+    This unit implements support import,export,link routines
+    for the (i386) Amiga target
+
+    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 t_amiga;
+
+{$i defines.inc}
+
+interface
+
+
+implementation
+
+    uses
+       link,
+       cutils,cclasses,
+       globtype,globals,systems,verbose,script,fmodule;
+
+{*****************************************************************************
+                                     Initialize
+*****************************************************************************}
+
+    const
+       target_m68k_amiga_info : ttargetinfo =
+          (
+            target       : target_m68k_Amiga;
+            name         : 'Commodore Amiga';
+            shortname    : 'amiga';
+            flags        : [];
+            cpu          : m68k;
+            short_name   : 'AMIGA';
+            unit_env     : '';
+            sharedlibext : '.library';
+            staticlibext : '.a';
+            sourceext    : '.pp';
+            pasext       : '.pas';
+            exeext       : '';
+            defext       : '';
+            scriptext    : '';
+            smartext     : '.sl';
+            unitext      : '.ppa';
+            unitlibext   : '.ppl';
+            asmext       : '.asm';
+            objext       : '.o';
+            resext       : '.res';
+            resobjext    : '.or';
+            libprefix    : '';
+            Cprefix      : '_';
+            newline      : #10;
+            assem        : as_m68k_as;
+            assemextern  : as_m68k_as;
+            link         : ld_m68k_amiga;
+            linkextern   : ld_m68k_amiga;
+            ar           : ar_m68k_ar;
+            res          : res_none;
+            endian       : endian_big;
+            stackalignment : 2;
+            maxCrecordalignment : 4;
+            size_of_pointer : 4;
+            size_of_longint : 4;
+            heapsize     : 128*1024;
+            maxheapsize  : 32768*1024;
+            stacksize    : 8192;
+            DllScanSupported:false;
+            use_bound_instruction : false;
+            use_function_relative_addresses : false
+          );
+
+
+initialization
+  RegisterTarget(target_m68k_amiga_info);
+end.
+{
+  $Log$
+  Revision 1.1  2001-04-18 22:02:04  peter
+    * registration of targets and assemblers
+
+}

compiler/targets/t_atari.pas

@@ -0,0 +1,97 @@
+{
+    $Id$
+    Copyright (c) 2001 by Peter Vreman
+
+    This unit implements support import,export,link routines
+    for the (i386) Amiga target
+
+    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 t_atari;
+
+{$i defines.inc}
+
+interface
+
+
+implementation
+
+    uses
+       link,
+       cutils,cclasses,
+       globtype,globals,systems,verbose,script,fmodule;
+
+{*****************************************************************************
+                                     Initialize
+*****************************************************************************}
+
+    const
+       target_m68k_atari_info : ttargetinfo =
+          (
+            target       : target_m68k_Atari;
+            name         : 'Atari ST/STE';
+            shortname    : 'atari';
+            flags        : [];
+            cpu          : m68k;
+            short_name   : 'ATARI';
+            unit_env     : '';
+            sharedlibext : '.dll';
+            staticlibext : '.a';
+            sourceext    : '.pp';
+            pasext       : '.pas';
+            exeext       : '.tpp';
+            defext       : '';
+            scriptext    : '';
+            smartext     : '.sl';
+            unitext      : '.ppt';
+            unitlibext   : '.ppl';
+            asmext       : '.s';
+            objext       : '.o';
+            resext       : '.res';
+            resobjext    : '.or';
+            libprefix    : '';
+            Cprefix      : '_';
+            newline      : #10;
+            assem        : as_m68k_as;
+            assemextern  : as_m68k_as;
+            link         : ld_m68k_atari;
+            linkextern   : ld_m68k_atari;
+            ar           : ar_m68k_ar;
+            res          : res_none;
+            endian       : endian_big;
+            stackalignment : 2;
+            maxCrecordalignment : 4;
+            size_of_pointer : 4;
+            size_of_longint : 4;
+            heapsize     : 16*1024;
+            maxheapsize  : 32768*1024;
+            stacksize    : 8192;
+            DllScanSupported:false;
+            use_bound_instruction : false;
+            use_function_relative_addresses : false
+          );
+
+
+initialization
+  RegisterTarget(target_m68k_atari_info);
+end.
+{
+  $Log$
+  Revision 1.1  2001-04-18 22:02:04  peter
+    * registration of targets and assemblers
+
+}

compiler/targets/t_fbsd.pas

@@ -28,7 +28,14 @@ unit t_fbsd;
 
 interface
 
+
+implementation
+
   uses
+    cutils,cclasses,
+    verbose,systems,globtype,globals,
+    symconst,script,
+    fmodule,aasm,cpuasm,cpubase,symsym,
     import,export,link;
 
   type
@@ -59,14 +66,6 @@ interface
     end;
 
 
-implementation
-
-  uses
-    cutils,cclasses,
-    verbose,systems,globtype,globals,
-    symconst,script,
-    fmodule,aasm,cpuasm,cpubase,symsym;
-
 {*****************************************************************************
                                TIMPORTLIBLINUX
 *****************************************************************************}
@@ -332,7 +331,7 @@ begin
         S:=SharedLibFiles.GetFirst;
         if s<>'c' then
          begin
-           i:=Pos(target_os.sharedlibext,S);
+           i:=Pos(target_info.sharedlibext,S);
            if i>0 then
             Delete(S,i,255);
            LinkRes.Add('-l'+s);
@@ -441,10 +440,69 @@ begin
   MakeSharedLibrary:=success;   { otherwise a recursive call to link method }
 end;
 
+
+{*****************************************************************************
+                                     Initialize
+*****************************************************************************}
+
+    const
+       target_i386_freebsd_info : ttargetinfo =
+          (
+            target       : target_i386_FreeBSD;
+            name         : 'FreeBSD/ELF for i386';
+            shortname    : 'FreeBSD';
+            flags        : [];
+            cpu          : i386;
+            unit_env     : 'BSDUNITS';
+            sharedlibext : '.so';
+            staticlibext : '.a';
+            sourceext    : '.pp';
+            pasext       : '.pas';
+            exeext       : '';
+            defext       : '.def';
+            scriptext    : '.sh';
+            smartext     : '.sl';
+            unitext      : '.ppu';
+            unitlibext   : '.ppl';
+            asmext       : '.s';
+            objext       : '.o';
+            resext       : '.res';
+            resobjext    : '.or';
+            libprefix    : 'libp';
+            Cprefix      : '';
+            newline      : #10;
+            assem        : as_i386_elf32;
+            assemextern  : as_i386_as;
+            link         : ld_i386_freebsd;
+            linkextern   : ld_i386_freebsd;
+            ar           : ar_gnu_ar;
+            res          : res_none;
+            endian       : endian_little;
+            stackalignment : 4;
+            maxCrecordalignment : 4;
+            size_of_pointer : 4;
+            size_of_longint : 4;
+            heapsize    : 256*1024;
+            maxheapsize : 32768*1024;
+            stacksize   : 8192;
+            DllScanSupported:false;
+            use_bound_instruction : false;
+            use_function_relative_addresses : true
+          );
+
+
+initialization
+  RegisterLinker(ld_i386_freebsd,TLinkerFreeBSD);
+  RegisterImport(target_i386_freebsd,timportlibfreebsd);
+  RegisterExport(target_i386_freebsd,texportlibfreebsd);
+  RegisterTarget(target_i386_freebsd_info);
 end.
 {
   $Log$
-  Revision 1.2  2001-04-13 01:22:21  peter
+  Revision 1.3  2001-04-18 22:02:04  peter
+    * registration of targets and assemblers
+
+  Revision 1.2  2001/04/13 01:22:21  peter
     * symtable change to classes
     * range check generation and errors fixed, make cycle DEBUG=1 works
     * memory leaks fixed

compiler/targets/t_go32v1.pas

@@ -127,7 +127,7 @@ begin
      S:=SharedLibFiles.GetFirst;
      if s<>'c' then
       begin
-        i:=Pos(target_os.sharedlibext,S);
+        i:=Pos(target_info.sharedlibext,S);
         if i>0 then
          Delete(S,i,255);
         LinkRes.Add('-l'+s);
@@ -186,10 +186,67 @@ begin
   MakeExecutable:=success;   { otherwise a recursive call to link method }
 end;
 
+
+{*****************************************************************************
+                                     Initialize
+*****************************************************************************}
+
+    const
+       target_i386_go32v1_info : ttargetinfo =
+          (
+            target       : target_i386_GO32V1;
+            name         : 'GO32 V1 DOS extender';
+            shortname    : 'Go32v1';
+            flags        : [];
+            cpu          : i386;
+            unit_env     : 'GO32V1UNITS';
+            sharedlibext : '.dll';
+            staticlibext : '.a';
+            sourceext    : '.pp';
+            pasext       : '.pas';
+            exeext       : '';      { No .exe, the linker only output a.out ! }
+            defext       : '.def';
+            scriptext    : '.bat';
+            smartext     : '.sl';
+            unitext      : '.pp1';
+            unitlibext   : '.ppl';
+            asmext       : '.s1';
+            objext       : '.o1';
+            resext       : '.res';
+            resobjext    : '.o1r';
+            libprefix    : '';
+            Cprefix      : '_';
+            newline      : #13#10;
+            assem        : as_i386_as;
+            assemextern  : as_i386_as;
+            link         : ld_i386_go32v1;
+            linkextern   : ld_i386_go32v1;
+            ar           : ar_gnu_ar;
+            res          : res_none;
+            endian       : endian_little;
+            stackalignment : 2;
+            maxCrecordalignment : 4;
+            size_of_pointer : 4;
+            size_of_longint : 4;
+            heapsize     : 2048*1024;
+            maxheapsize  : 32768*1024;
+            stacksize    : 16384;
+            DllScanSupported:false;
+            use_bound_instruction : false;
+            use_function_relative_addresses : true
+          );
+
+
+initialization
+  RegisterLinker(ld_i386_go32v1,TLinkerGo32v1);
+  RegisterTarget(target_i386_go32v1_info);
 end.
 {
   $Log$
-  Revision 1.2  2001-04-13 01:22:21  peter
+  Revision 1.3  2001-04-18 22:02:04  peter
+    * registration of targets and assemblers
+
+  Revision 1.2  2001/04/13 01:22:21  peter
     * symtable change to classes
     * range check generation and errors fixed, make cycle DEBUG=1 works
     * memory leaks fixed

compiler/targets/t_go32v2.pas

@@ -27,8 +27,13 @@ unit t_go32v2;
 
 interface
 
-  uses
-    link;
+
+implementation
+
+    uses
+       link,
+       cutils,cclasses,
+       globtype,globals,systems,verbose,script,fmodule;
 
   type
     tlinkergo32v2=class(tlinker)
@@ -42,13 +47,6 @@ interface
     end;
 
 
-  implementation
-
-    uses
-       cutils,cclasses,
-       globtype,globals,systems,verbose,script,fmodule;
-
-
 {****************************************************************************
                                TLinkerGo32v2
 ****************************************************************************}
@@ -130,7 +128,7 @@ begin
      S:=SharedLibFiles.GetFirst;
      if s<>'c' then
       begin
-        i:=Pos(target_os.sharedlibext,S);
+        i:=Pos(target_info.sharedlibext,S);
         if i>0 then
          Delete(S,i,255);
         LinkRes.Add('-l'+s);
@@ -251,7 +249,7 @@ begin
      S:=SharedLibFiles.GetFirst;
      if s<>'c' then
       begin
-        i:=Pos(target_os.sharedlibext,S);
+        i:=Pos(target_info.sharedlibext,S);
         if i>0 then
          Delete(S,i,255);
         ScriptRes.Add('-l'+s);
@@ -416,10 +414,67 @@ begin
 end;
 {$endif}
 
+
+{*****************************************************************************
+                                     Initialize
+*****************************************************************************}
+
+    const
+       target_i386_go32v2_info : ttargetinfo =
+          (
+            target       : target_i386_GO32V2;
+            name         : 'GO32 V2 DOS extender';
+            shortname    : 'Go32v2';
+            flags        : [];
+            cpu          : i386;
+            unit_env     : 'GO32V2UNITS';
+            sharedlibext : '.dll';
+            staticlibext : '.a';
+            sourceext    : '.pp';
+            pasext       : '.pas';
+            exeext       : '.exe';
+            defext       : '.def';
+            scriptext    : '.bat';
+            smartext     : '.sl';
+            unitext      : '.ppu';
+            unitlibext   : '.ppl';
+            asmext       : '.s';
+            objext       : '.o';
+            resext       : '.res';
+            resobjext    : '.or';
+            libprefix    : '';
+            Cprefix      : '_';
+            newline      : #13#10;
+            assem        : as_i386_coff;
+            assemextern  : as_i386_as;
+            link         : ld_i386_go32v2;
+            linkextern   : ld_i386_go32v2;
+            ar           : ar_gnu_ar;
+            res          : res_none;
+            endian       : endian_little;
+            stackalignment : 2;
+            maxCrecordalignment : 4;
+            size_of_pointer : 4;
+            size_of_longint : 4;
+            heapsize     : 2048*1024;
+            maxheapsize  : 32768*1024;
+            stacksize    : 16384;
+            DllScanSupported : false;
+            use_bound_instruction : false;
+            use_function_relative_addresses : true
+          );
+
+
+initialization
+  RegisterLinker(ld_i386_go32v2,TLinkerGo32v2);
+  RegisterTarget(target_i386_go32v2_info);
 end.
 {
   $Log$
-  Revision 1.2  2001-04-13 01:22:21  peter
+  Revision 1.3  2001-04-18 22:02:04  peter
+    * registration of targets and assemblers
+
+  Revision 1.2  2001/04/13 01:22:21  peter
     * symtable change to classes
     * range check generation and errors fixed, make cycle DEBUG=1 works
     * memory leaks fixed

compiler/targets/t_linux.pas

@@ -321,7 +321,7 @@ begin
         S:=SharedLibFiles.GetFirst;
         if s<>'c' then
          begin
-           i:=Pos(target_os.sharedlibext,S);
+           i:=Pos(target_info.sharedlibext,S);
            if i>0 then
             Delete(S,i,255);
            LinkRes.Add('-l'+s);
@@ -442,10 +442,229 @@ begin
 end;
 
 
+{*****************************************************************************
+                                  Initialize
+*****************************************************************************}
+
+{$ifdef i386}
+    const
+       target_i386_linux_info : ttargetinfo =
+          (
+            target       : target_i386_LINUX;
+            name         : 'Linux for i386';
+            shortname    : 'Linux';
+            flags        : [];
+            cpu          : i386;
+            unit_env     : 'LINUXUNITS';
+            sharedlibext : '.so';
+            staticlibext : '.a';
+            sourceext    : '.pp';
+            pasext       : '.pas';
+            exeext       : '';
+            defext       : '.def';
+            scriptext    : '.sh';
+            smartext     : '.sl';
+            unitext      : '.ppu';
+            unitlibext   : '.ppl';
+            asmext       : '.s';
+            objext       : '.o';
+            resext       : '.res';
+            resobjext    : '.or';
+            libprefix    : 'libp';
+            Cprefix      : '';
+            newline      : #10;
+            assem        : as_i386_elf32;
+            assemextern  : as_i386_as;
+            link         : ld_i386_linux;
+            linkextern   : ld_i386_linux;
+            ar           : ar_gnu_ar;
+            res          : res_none;
+            endian       : endian_little;
+            stackalignment : 4;
+            maxCrecordalignment : 4;
+            size_of_pointer : 4;
+            size_of_longint : 4;
+            heapsize     : 256*1024;
+            maxheapsize  : 32768*1024;
+            stacksize    : 8192;
+            DllScanSupported:false;
+            use_bound_instruction : false;
+            use_function_relative_addresses : true
+          );
+{$endif i386}
+{$ifdef m68k}
+    const
+       target_m68k_linux_info : ttargetinfo =
+          (
+            target       : target_m68k_linux;
+            name         : 'Linux for m68k';
+            shortname    : 'linux';
+            flags        : [];
+            cpu          : m68k;
+            short_name   : 'LINUX';
+            unit_env     : 'LINUXUNITS';
+            sharedlibext : '.so';
+            staticlibext : '.a';
+            sourceext    : '.pp';
+            pasext       : '.pas';
+            exeext       : '';
+            defext       : '';
+            scriptext    : '.sh';
+            smartext     : '.sl';
+            unitext      : '.ppu';
+            unitlibext   : '.ppl';
+            asmext       : '.s';
+            objext       : '.o';
+            resext       : '.res';
+            resobjext    : '.or';
+            libprefix    : 'libp';
+            Cprefix      : '';
+            newline      : #10;
+            assem        : as_m68k_as;
+            assemextern  : as_m68k_as;
+            link         : ld_m68k_linux;
+            linkextern   : ld_m68k_linux;
+            ar           : ar_m68k_ar;
+            res          : res_none;
+            endian       : endian_big;
+            stackalignment : 2;
+            maxCrecordalignment : 32;
+            size_of_pointer : 4;
+            size_of_longint : 4;
+            heapsize     : 128*1024;
+            maxheapsize  : 32768*1024;
+            stacksize    : 8192;
+            DllScanSupported:false;
+            use_bound_instruction : false;
+            use_function_relative_addresses : true
+          );
+{$endif m68k}
+{$ifdef powerpc}
+    const
+       target_powerpc_linux_info : ttargetinfo =
+          (
+            target       : target_powerpc_LINUX;
+            name         : 'Linux for PowerPC';
+            shortname    : 'linuxppc';
+            flags        : [];
+            cpu          : powerpc;
+            short_name   : 'LINUX';
+            unit_env     : '';
+            sharedlibext : '.so';
+            staticlibext : '.s';
+            sourceext    : '.pp';
+            pasext       : '.pas';
+            exeext       : '';
+            defext       : '.def';
+            scriptext    : '.sh';
+            smartext     : '.sl';
+            unitext      : '.ppu';
+            unitlibext   : '.ppl';
+            asmext       : '.s';
+            objext       : '.o';
+            resext       : '.res';
+            resobjext    : '.or';
+            libprefix    : 'libp';
+            Cprefix      : '';
+            newline      : #10;
+            assem        : as_powerpc_as;
+            assemsrc     : as_powerpc_as;
+            ar           : ar_powerpc_ar;
+            res          : res_none;
+            endian       : endian_big;
+            stackalignment : 8;
+            maxCrecordalignment : 32;
+            size_of_pointer : 4;
+            size_of_longint : 4;
+            heapsize     : 256*1024;
+            maxheapsize  : 32768*1024;
+            stacksize    : 8192;
+            DllScanSupported:false;
+            use_bound_instruction : false;
+            use_function_relative_addresses : true
+          );
+{$endif powerpc}
+{$ifdef alpha}
+    const
+       target_alpha_linux_info : ttargetinfo =
+          (
+            target       : target_alpha_LINUX;
+            name         : 'Linux for Alpha';
+            shortname    : 'axplinux';
+            flags        : [];
+            cpu          : alpha;
+            short_name   : 'LINUX';
+            unit_env     : 'LINUXUNITS';
+            sharedlibext : '.so';
+            staticlibext : '.a';
+            sourceext    : '.pp';
+            pasext       : '.pas';
+            exeext       : '';
+            defext       : '.def';
+            scriptext    : '.sh';
+            smartext     : '.sl';
+            unitext      : '.ppu';
+            unitlibext   : '.ppl';
+            asmext       : '.s';
+            objext       : '.o';
+            resext       : '.res';
+            resobjext    : '.or';
+            libprefix    : 'libp';
+            Cprefix      : '';
+            newline      : #10;
+            assem        : as_alpha_as;
+            assemextern  : as_alpha_as;
+            link         : ld_alpha_linux;
+            linkextern   : ld_alpha_linux;
+            ar           : ar_alpha_ar;
+            res          : res_none;
+            endian       : endian_little;
+            stackalignment : 8;
+            maxCrecordalignment : 32;
+            size_of_pointer : 8;
+            size_of_longint : 4;
+            heapsize     : 256*1024;
+            maxheapsize  : 32768*1024;
+            stacksize    : 8192;
+            DllScanSupported:false;
+            use_bound_instruction : false;
+            use_function_relative_addresses : true
+          );
+{$endif alpha}
+
+
+initialization
+{$ifdef i386}
+  RegisterLinker(ld_i386_linux,TLinkerLinux);
+  RegisterImport(target_i386_linux,timportliblinux);
+  RegisterExport(target_i386_linux,texportliblinux);
+  RegisterTarget(target_i386_linux_info);
+{$endif i386}
+{$ifdef m68k}
+  RegisterLinker(ld_m68k_linux,TLinkerLinux);
+  RegisterImport(target_m68k_linux,timportliblinux);
+  RegisterExport(target_m68k_linux,texportliblinux);
+  RegisterTarget(target_m68k_linux_info);
+{$endif m68k}
+{$ifdef powerpc}
+  RegisterLinker(ld_powerpc_linux,TLinkerLinux);
+  RegisterImport(target_powerpc_linux,timportliblinux);
+  RegisterExport(target_powerpc_linux,texportliblinux);
+  RegisterTarget(target_powerpc_linux_info);
+{$endif powerpc}
+{$ifdef alpha}
+  RegisterLinker(ld_alpha_linux,TLinkerLinux);
+  RegisterImport(target_alpha_linux,timportliblinux);
+  RegisterExport(target_alpha_linux,texportliblinux);
+  RegisterTarget(target_alpha_linux_info);
+{$endif alpha}
 end.
 {
   $Log$
-  Revision 1.3  2001-04-13 01:22:21  peter
+  Revision 1.4  2001-04-18 22:02:04  peter
+    * registration of targets and assemblers
+
+  Revision 1.3  2001/04/13 01:22:21  peter
     * symtable change to classes
     * range check generation and errors fixed, make cycle DEBUG=1 works
     * memory leaks fixed

compiler/targets/t_macos.pas

@@ -0,0 +1,152 @@
+{
+    $Id$
+    Copyright (c) 2001 by Peter Vreman
+
+    This unit implements support import,export,link routines
+    for the (i386) Amiga target
+
+    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 t_macos;
+
+{$i defines.inc}
+
+interface
+
+
+implementation
+
+    uses
+       link,
+       cutils,cclasses,
+       globtype,globals,systems,verbose,script,fmodule;
+
+{*****************************************************************************
+                                  Initialize
+*****************************************************************************}
+
+{$ifdef m68k}
+    const
+       target_m68k_macos_info : ttargetinfo =
+          (
+            target       : target_m68k_Mac;
+            name         : 'Macintosh m68k';
+            shortname    : 'mac';
+            flags        : [];
+            cpu          : m68k;
+            short_name   : 'MACOS';
+            unit_env     : '';
+            sharedlibext : 'Lib';
+            staticlibext : 'Lib';
+            sourceext    : '.pp';
+            pasext       : '.pas';
+            exeext       : '';
+            defext       : '';
+            scriptext    : '';
+            smartext     : '.sl';
+            unitext      : '.ppt';
+            unitlibext   : '.ppl';
+            asmext       : '.a';
+            objext       : '.o';
+            resext       : '.res';
+            resobjext    : '.or';
+            libprefix    : '';
+            Cprefix      : '_';
+            newline      : #13;
+            assem        : as_m68k_mpw;
+            assemextern  : as_m68k_mpw;
+            link         : ld_m68k_mac;
+            linkextern   : ld_m68k_mac;
+            ar           : ar_m68k_ar;
+            res          : res_none;
+            endian       : endian_big;
+            stackalignment : 2;
+            maxCrecordalignment : 4;
+            size_of_pointer : 4;
+            size_of_longint : 4;
+            heapsize     : 128*1024;
+            maxheapsize  : 32768*1024;
+            stacksize    : 8192;
+            DllScanSupported:false;
+            use_bound_instruction : false;
+            use_function_relative_addresses : false
+          );
+{$endif m68k}
+
+{$ifdef powerpc}
+     const
+       target_powerpc_macos_info : ttargetinfo =
+          (
+            target       : target_powerpc_MACOS;
+            name         : 'MacOs (PowerPC)';
+            shortname    : 'MacOs/PPC';
+            flags        : [];
+            cpu          : powerpc;
+            short_name   : 'MACOS';
+            unit_env     : '';
+            sharedlibext : 'Lib';
+            staticlibext : 'Lib';
+            sourceext    : '.pp';
+            pasext       : '.pas';
+            exeext       : '';
+            defext       : '';
+            scriptext    : '';
+            smartext     : '.sl';
+            unitext      : '.ppt';
+            unitlibext   : '.ppl';
+            asmext       : '.a';
+            objext       : '.o';
+            resext       : '.res';
+            resobjext    : '.or';
+            libprefix    : '';
+            Cprefix      : '';
+            newline      : #13;
+            assem        : as_powerpc_mpw;
+            assemextern  : as_powerpc_mpw;
+            link         : ld_powerpc_macos;
+            linkextern   : ld_powerpc_macos;
+            ar           : ar_powerpc_ar;
+            res          : res_powerpc_mpw;
+            endian       : endian_big;
+            stackalignment : 8;
+            maxCrecordalignment : 32;
+            size_of_pointer : 4;
+            size_of_longint : 4;
+            heapsize     : 256*1024;
+            maxheapsize  : 32768*1024;
+            stacksize    : 8192;
+            DllScanSupported:false;
+            use_bound_instruction : false;
+            use_function_relative_addresses : true
+          );
+{$endif powerpc}
+
+
+initialization
+{$ifdef m68k}
+  RegisterTarget(target_m68k_macos_info);
+{$endif m68k}
+{$ifdef powerpc}
+  RegisterTarget(target_powerpc_macos_info);
+{$endif powerpc}
+end.
+{
+  $Log$
+  Revision 1.1  2001-04-18 22:02:04  peter
+    * registration of targets and assemblers
+
+}

compiler/targets/t_nwm.pas

@@ -83,7 +83,14 @@ unit t_nwm;
 
 interface
 
+
+implementation
+
   uses
+    cutils,
+    verbose,systems,globtype,globals,
+    symconst,script,
+    fmodule,aasm,cpuasm,cpubase,symsym,
     import,export,link;
 
   type
@@ -111,14 +118,6 @@ interface
     end;
 
 
-implementation
-
-  uses
-    cutils,
-    verbose,systems,globtype,globals,
-    symconst,script,
-    fmodule,aasm,cpuasm,cpubase,symsym;
-
 {*****************************************************************************
                                TIMPORTLIBNETWARE
 *****************************************************************************}
@@ -271,10 +270,10 @@ begin
   WriteResponseFile:=False;
 
   ProgNam := current_module.exefilename^;
-  i:=Pos(target_os.exeext,ProgNam);
+  i:=Pos(target_info.exeext,ProgNam);
   if i>0 then
     Delete(ProgNam,i,255);
-  NlmNam := ProgNam + target_os.exeext;
+  NlmNam := ProgNam + target_info.exeext;
 
   { Open link.res file }
   LinkRes:=TLinkRes.Create(outputexedir+Info.ResName);
@@ -320,7 +319,7 @@ begin
         S:=lower (StaticLibFiles.GetFirst);
         if s<>'' then
          begin
-           i:=Pos(target_os.staticlibext,S);
+           i:=Pos(target_info.staticlibext,S);
            if i>0 then
             Delete(S,i,255);
            S := S + '.imp';
@@ -344,7 +343,7 @@ begin
         if s<>'' then
          begin
            s2:=s;
-           i:=Pos(target_os.sharedlibext,S);
+           i:=Pos(target_info.sharedlibext,S);
            if i>0 then
             Delete(S,i,255);
            S := S + '.imp';
@@ -418,10 +417,69 @@ begin
   MakeExecutable:=success;   { otherwise a recursive call to link method }
 end;
 
+
+{*****************************************************************************
+                                     Initialize
+*****************************************************************************}
+
+    const
+       target_i386_netware_info : ttargetinfo =
+          (
+            target       : target_i386_NETWARE;
+            name         : 'Netware for i386';
+            shortname    : 'Netware';
+            flags        : [];
+            cpu          : i386;
+            unit_env     : 'NETWAREUNITS';
+            sharedlibext : '.nlm';
+            staticlibext : '.a';
+            sourceext    : '.pp';
+            pasext       : '.pas';
+            exeext       : '.nlm';
+            defext       : '.def';
+            scriptext    : '.sh';
+            smartext     : '.sl';
+            unitext      : '.ppn';
+            unitlibext   : '.ppl';
+            asmext       : '.s';
+            objext       : '.on';
+            resext       : '.res';
+            resobjext    : '.or';
+            libprefix    : '';
+            Cprefix      : '';
+            newline      : #13#10;
+            assem        : as_i386_elf32;
+            assemextern  : as_i386_as;
+            link         : ld_i386_netware;
+            linkextern   : ld_i386_netware;
+            ar           : ar_gnu_ar;
+            res          : res_none;
+            endian       : endian_little;
+            stackalignment : 4;
+            maxCrecordalignment : 4;
+            size_of_pointer : 4;
+            size_of_longint : 4;
+            heapsize     : 256*1024;
+            maxheapsize  : 32768*1024;
+            stacksize    : 8192;
+            DllScanSupported:false;
+            use_bound_instruction : false;
+            use_function_relative_addresses : true
+          );
+
+
+initialization
+  RegisterLinker(ld_i386_netware,TLinkerNetware);
+  RegisterImport(target_i386_netware,TImportLibNetware);
+  RegisterExport(target_i386_netware,TExportLibNetware);
+  RegisterTarget(target_i386_netware_info);
 end.
 {
   $Log$
-  Revision 1.2  2001-04-13 01:22:21  peter
+  Revision 1.3  2001-04-18 22:02:04  peter
+    * registration of targets and assemblers
+
+  Revision 1.2  2001/04/13 01:22:21  peter
     * symtable change to classes
     * range check generation and errors fixed, make cycle DEBUG=1 works
     * memory leaks fixed

compiler/targets/t_os2.pas

@@ -33,29 +33,7 @@ unit t_os2;
 {$i defines.inc}
 
 interface
-uses
-  import,link,comprsrc;
 
-type
-  timportlibos2=class(timportlib)
-    procedure preparelib(const s:string);override;
-    procedure importprocedure(const func,module:string;index:longint;const name:string);override;
-    procedure generatelib;override;
-  end;
-
-    tlinkeros2=class(tlinker)
-    private
-       Function  WriteResponseFile(isdll:boolean) : Boolean;
-    public
-       constructor Create;
-       procedure SetDefaultInfo;override;
-       function  MakeExecutable:boolean;override;
-    end;
-
-
-{***************************************************************************}
-
-{***************************************************************************}
 
 implementation
 
@@ -69,7 +47,25 @@ implementation
 {$endif Delphi}
      cutils,cclasses,
      globtype,comphook,systems,
-     globals,verbose,fmodule,script;
+     globals,verbose,fmodule,script,
+     import,link,comprsrc;
+
+  type
+    timportlibos2=class(timportlib)
+      procedure preparelib(const s:string);override;
+      procedure importprocedure(const func,module:string;index:longint;const name:string);override;
+      procedure generatelib;override;
+    end;
+
+    tlinkeros2=class(tlinker)
+    private
+       Function  WriteResponseFile(isdll:boolean) : Boolean;
+    public
+       constructor Create;
+       procedure SetDefaultInfo;override;
+       function  MakeExecutable:boolean;override;
+    end;
+
 
 const   profile_flag:boolean=false;
 
@@ -419,7 +415,7 @@ begin
   While not SharedLibFiles.Empty do
    begin
      S:=SharedLibFiles.GetFirst;
-     i:=Pos(target_os.sharedlibext,S);
+     i:=Pos(target_info.sharedlibext,S);
      if i>0 then
       Delete(S,i,255);
      LinkRes.Add('-l'+s);
@@ -504,10 +500,77 @@ begin
 end;
 
 
+{*****************************************************************************
+                                     Initialize
+*****************************************************************************}
+
+    const
+       res_emxbind_info : tresinfo =
+          (
+            id     : res_emxbind;
+            resbin : 'emxbind';
+            rescmd : '-b -r $RES $OBJ'
+(* Not really used - see TLinkeros2.SetDefaultInfo in t_os2.pas. *)
+          );
+
+    const
+       target_i386_os2_info : ttargetinfo =
+          (
+            target       : target_i386_OS2;
+            name         : 'OS/2 via EMX';
+            shortname    : 'OS2';
+            flags        : [tf_need_export];
+            cpu          : i386;
+            unit_env     : 'OS2UNITS';
+            sharedlibext : '.ao2';
+            staticlibext : '.ao2';
+            sourceext    : '.pas';
+            pasext       : '.pp';
+            exeext       : '.exe';
+            defext       : '.def';
+            scriptext    : '.cmd';
+            smartext     : '.sl';
+            unitext      : '.ppo';
+            unitlibext   : '.ppl';
+            asmext       : '.so2';
+            objext       : '.oo2';
+            resext       : '.res';
+            resobjext    : '.oor';
+            libprefix    : '';
+            Cprefix      : '_';
+            newline      : #13#10;
+            assem        : as_i386_as_aout;
+            assemextern  : as_i386_as_aout;
+            link         : ld_i386_os2;
+            linkextern   : ld_i386_os2;
+            ar           : ar_gnu_ar;
+            res          : res_emxbind;
+            endian       : endian_little;
+            stackalignment : 4;
+            maxCrecordalignment : 4;
+            size_of_pointer : 4;
+            size_of_longint : 4;
+            heapsize     : 256*1024;
+            maxheapsize  : 32768*1024;
+            stacksize    : 256*1024;
+            DllScanSupported:true;
+            use_bound_instruction : false;
+            use_function_relative_addresses : false
+          );
+
+
+initialization
+  RegisterLinker(ld_i386_os2,TLinkerOS2);
+  RegisterImport(target_i386_os2,TImportLibOS2);
+  RegisterRes(res_emxbind_info);
+  RegisterTarget(target_i386_os2_info);
 end.
 {
   $Log$
-  Revision 1.3  2001-04-13 01:22:22  peter
+  Revision 1.4  2001-04-18 22:02:04  peter
+    * registration of targets and assemblers
+
+  Revision 1.3  2001/04/13 01:22:22  peter
     * symtable change to classes
     * range check generation and errors fixed, make cycle DEBUG=1 works
     * memory leaks fixed

compiler/targets/t_palmos.pas

@@ -0,0 +1,100 @@
+{
+    $Id$
+    Copyright (c) 2001 by Peter Vreman
+
+    This unit implements support import,export,link routines
+    for the (i386) Amiga target
+
+    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 t_palmos;
+
+{$i defines.inc}
+
+interface
+
+
+implementation
+
+    uses
+       link,
+       cutils,cclasses,
+       globtype,globals,systems,verbose,script,fmodule;
+
+{*****************************************************************************
+                                     Initialize
+*****************************************************************************}
+
+{$ifdef m68k}
+    const
+       target_m68k_palmos_info : ttargetinfo =
+          (
+            target       : target_m68k_PalmOS;
+            name         : 'PalmOS';
+            shortname    : 'palmos';
+            flags        : [];
+            cpu          : m68k;
+            short_name   : 'PALMOS';
+            unit_env     : 'PALMUNITS';
+            sharedlibext : '.so';
+            staticlibext : '.a';
+            sourceext    : '.pp';
+            pasext       : '.pas';
+            exeext       : '';
+            defext       : '';
+            scriptext    : '.sh';
+            smartext     : '.sl';
+            unitext      : '.ppu';
+            unitlibext   : '.ppl';
+            asmext       : '.s';
+            objext       : '.o';
+            resext       : '.res';
+            resobjext    : '.or';
+            libprefix    : 'libp';
+            Cprefix      : '_';
+            newline      : #10;
+            assem        : as_m68k_as;
+            assemextern  : as_m68k_as;
+            link         : ld_m68k_palmos;
+            linkextern   : ld_m68k_palmos;
+            ar           : ar_m68k_ar;
+            res          : res_none;
+            endian       : endian_big;
+            stackalignment : 2;
+            maxCrecordalignment : 32;
+            size_of_pointer : 4;
+            size_of_longint : 4;
+            heapsize     : 128*1024;
+            maxheapsize  : 32768*1024;
+            stacksize    : 8192;
+            DllScanSupported:false;
+            use_bound_instruction : false;
+            use_function_relative_addresses : false
+          );
+{$endif m68k}
+
+initialization
+{$ifdef m68k}
+  RegisterTarget(target_m68k_palmos_info);
+{$endif m68k}
+end.
+{
+  $Log$
+  Revision 1.1  2001-04-18 22:02:04  peter
+    * registration of targets and assemblers
+
+}

compiler/targets/t_sunos.pas

@@ -31,7 +31,14 @@ interface
 // Up to now we use gld since the solaris ld seems not support .res-files}
 {-$DEFINE LinkTest} { DON't del link.res and write Info }
 {$DEFINE GnuLd} {The other is not implemented }
+
+implementation
+
   uses
+    cutils,cclasses,
+    verbose,systems,globtype,globals,
+    symconst,script,
+    fmodule,aasm,cpuasm,cpubase,symsym,
     import,export,link;
 
   type
@@ -62,14 +69,6 @@ interface
     end;
 
 
-implementation
-
-  uses
-    cutils,cclasses,
-    verbose,systems,globtype,globals,
-    symconst,script,
-    fmodule,aasm,cpuasm,cpubase,symsym;
-
 {*****************************************************************************
                                TIMPORTLIBsunos
 *****************************************************************************}
@@ -358,7 +357,7 @@ begin
         S:=SharedLibFiles.GetFirst;
         if s<>'c' then
          begin
-           i:=Pos(target_os.sharedlibext,S);
+           i:=Pos(target_info.sharedlibext,S);
            if i>0 then
             Delete(S,i,255);
            LinkRes.Add('-l'+s);
@@ -471,15 +470,72 @@ begin
 end;
 
 
+{*****************************************************************************
+                                     Initialize
+*****************************************************************************}
+
+    const
+       target_i386_sunos_info : ttargetinfo =
+          (
+            target       : target_i386_sunos;
+            name         : 'SunOS/ELF for i386';
+            shortname    : 'SunOS';
+            flags        : [];
+            cpu          : i386;
+            unit_env     : 'SUNOSUNITS';
+            sharedlibext : '.so';
+            staticlibext : '.a';
+            sourceext    : '.pp';
+            pasext       : '.pas';
+            exeext       : '';
+            defext       : '.def';
+            scriptext    : '.sh';
+            smartext     : '.sl';
+            unitext      : '.ppu';
+            unitlibext   : '.ppl';
+            asmext       : '.s';
+            objext       : '.o';
+            resext       : '.res';
+            resobjext    : '.or';
+            libprefix    : 'lib';
+            Cprefix      : '';
+            newline      : #10;
+            assem        : as_i386_as;
+            assemextern  : as_i386_as;
+            link         : ld_i386_sunos;
+            linkextern   : ld_i386_sunos;
+            ar           : ar_gnu_ar;
+            res          : res_none;
+            endian       : endian_little;
+            stackalignment : 4;
+            maxCrecordalignment : 4;
+            size_of_pointer : 4;
+            size_of_longint : 4;
+            heapsize     : 256*1024;
+            maxheapsize  : 32768*1024;
+            stacksize    : 8192;
+            DllScanSupported:false;
+            use_bound_instruction : false;
+            use_function_relative_addresses : true
+          );
+
+
+initialization
+  RegisterLinker(ld_i386_sunos,TLinkerSunos);
+  RegisterImport(target_i386_sunos,TImportLibSunos);
+  RegisterExport(target_i386_sunos,TExportLibSunos);
+  RegisterTarget(target_i386_sunos_info);
 end.
 {
   $Log$
-  Revision 1.2  2001-04-13 01:22:22  peter
+  Revision 1.3  2001-04-18 22:02:04  peter
+    * registration of targets and assemblers
+
+  Revision 1.2  2001/04/13 01:22:22  peter
     * symtable change to classes
     * range check generation and errors fixed, make cycle DEBUG=1 works
     * memory leaks fixed
 
   Revision 1.1  2001/02/26 19:43:11  peter
     * moved target units to subdir
-
 }

compiler/targets/t_win32.pas

@@ -26,12 +26,26 @@ unit t_win32;
 
 interface
 
-  uses
-    import,export,link;
-
   const
      winstackpagesize = 4096;
 
+implementation
+
+    uses
+{$ifdef Delphi}
+       dmisc,
+{$else Delphi}
+       dos,
+{$endif Delphi}
+       cutils,cclasses,
+       aasm,fmodule,globtype,globals,systems,verbose,
+       script,gendef,
+       cpubase,cpuasm,
+{$ifdef GDB}
+       gdb,
+{$endif}
+       import,export,link;
+
   type
     timportlibwin32=class(timportlib)
       procedure preparelib(const s:string);override;
@@ -76,23 +90,6 @@ interface
     end;
 
 
-implementation
-
-    uses
-{$ifdef Delphi}
-       dmisc,
-{$else Delphi}
-       dos,
-{$endif Delphi}
-       cutils,cclasses,
-       aasm,fmodule,globtype,globals,systems,verbose,
-       script,gendef,
-       cpubase,cpuasm
-{$ifdef GDB}
-       ,gdb
-{$endif}
-       ;
-
     function DllName(Const Name : string) : string;
       var n : string;
       begin
@@ -100,7 +97,7 @@ implementation
          if (n='.DLL') or (n='.DRV') or (n='.EXE') then
            DllName:=Name
          else
-           DllName:=Name+target_os.sharedlibext;
+           DllName:=Name+target_info.sharedlibext;
       end;
 
 
@@ -580,9 +577,9 @@ implementation
          { the name }
          exportsSection.concat(Tai_label.Create(dll_name_label));
          if st='' then
-           exportsSection.concat(Tai_string.Create(current_module.modulename^+target_os.sharedlibext+#0))
+           exportsSection.concat(Tai_string.Create(current_module.modulename^+target_info.sharedlibext+#0))
          else
-           exportsSection.concat(Tai_string.Create(st+target_os.sharedlibext+#0));
+           exportsSection.concat(Tai_string.Create(st+target_info.sharedlibext+#0));
 
          {  export address table }
          address_table:=TAAsmoutput.create;
@@ -1157,7 +1154,7 @@ end;
            DOSstubOK:=(TheWord='MZ');
            seek(f,$3C);
            blockread(f,x,4,loaded);
-           if(loaded<>4)or(x>filesize(f))then
+           if(loaded<>4)or(longint(x)>filesize(f))then
             DOSstubOK:=false;
          end;
       end;
@@ -1196,7 +1193,7 @@ end;
          if (n='.DLL') or (n='.DRV') or (n='.EXE') then
            DllName:=Name
          else
-           DllName:=Name+target_os.sharedlibext;
+           DllName:=Name+target_info.sharedlibext;
       end;
 
 
@@ -1378,10 +1375,87 @@ function tDLLScannerWin32.scan(const binname:string):longbool;
   close(f);
  end;
 
+
+{*****************************************************************************
+                                     Initialize
+*****************************************************************************}
+
+    const
+      ar_gnu_arw_info : tarinfo =
+          (
+            id    : ar_gnu_arw;
+            arcmd : 'arw rs $LIB $FILES'
+          );
+
+    const
+      res_gnu_windres_info : tresinfo =
+          (
+            id     : res_gnu_windres;
+            resbin : 'windres';
+            rescmd : '--include $INC -O coff -o $OBJ $RES'
+          );
+
+    const
+       target_i386_win32_info : ttargetinfo =
+          (
+            target       : target_i386_WIN32;
+            name         : 'Win32 for i386';
+            shortname    : 'Win32';
+            flags        : [];
+            cpu          : i386;
+            unit_env     : 'WIN32UNITS';
+            sharedlibext : '.dll';
+            staticlibext : '.aw';
+            sourceext    : '.pp';
+            pasext       : '.pas';
+            exeext       : '.exe';
+            defext       : '.def';
+            scriptext    : '.bat';
+            smartext     : '.slw';
+            unitext      : '.ppw';
+            unitlibext   : '.ppl';
+            asmext       : '.sw';
+            objext       : '.ow';
+            resext       : '.rc';
+            resobjext    : '.owr';
+            libprefix    : 'libp';
+            Cprefix      : '_';
+            newline      : #13#10;
+            assem        : as_i386_pecoff;
+            assemextern  : as_i386_asw;
+            link         : ld_i386_win32;
+            linkextern   : ld_i386_win32;
+            ar           : ar_gnu_arw;
+            res          : res_gnu_windres;
+            endian       : endian_little;
+            stackalignment : 4;
+            maxCrecordalignment : 16;
+            size_of_pointer : 4;
+            size_of_longint : 4;
+            heapsize     : 256*1024;
+            maxheapsize  : 32*1024*1024;
+            stacksize    : 32*1024*1024;
+            DllScanSupported:true;
+            use_bound_instruction : false;
+            use_function_relative_addresses : true
+          );
+
+
+initialization
+  RegisterLinker(ld_i386_win32,TLinkerWin32);
+  RegisterImport(target_i386_win32,TImportLibWin32);
+  RegisterExport(target_i386_win32,TExportLibWin32);
+  RegisterDLLScanner(target_i386_win32,TDLLScannerWin32);
+  RegisterAr(ar_gnu_arw_info);
+  RegisterRes(res_gnu_windres_info);
+  RegisterTarget(target_i386_win32_info);
 end.
 {
   $Log$
-  Revision 1.5  2001-04-13 23:51:02  peter
+  Revision 1.6  2001-04-18 22:02:04  peter
+    * registration of targets and assemblers
+
+  Revision 1.5  2001/04/13 23:51:02  peter
     * fix for the stricter compilemode
 
   Revision 1.4  2001/04/13 01:22:22  peter

compiler/temp_gen.pas

@@ -287,7 +287,7 @@ const
       begin
         { align to 4 bytes at least
           otherwise all those subl $2,%esp are meaningless PM }
-        _align:=target_os.stackalignment;
+        _align:=target_info.stackalignment;
         if _align<4 then
           _align:=4;
         gettempsize:=Align(-lasttemp,_align);
@@ -340,13 +340,13 @@ const
           end
          else
           begin
-            ref.offset:=newtempofsize(target_os.size_of_pointer);
+            ref.offset:=newtempofsize(target_info.size_of_pointer);
 {$ifdef EXTDEBUG}
             templist^.posinfo:=aktfilepos;
 {$endif}
             templist^.temptype:=usedtype;
           end;
-         exprasmList.concat(Taitempalloc.alloc(ref.offset,target_os.size_of_pointer));
+         exprasmList.concat(Taitempalloc.alloc(ref.offset,target_info.size_of_pointer));
       end;
 
     function ungettemppointeriftype(const ref : treference; const usedtype, freetype: ttemptype) : boolean;
@@ -591,7 +591,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.12  2001-04-13 01:22:17  peter
+  Revision 1.13  2001-04-18 22:02:00  peter
+    * registration of targets and assemblers
+
+  Revision 1.12  2001/04/13 01:22:17  peter
     * symtable change to classes
     * range check generation and errors fixed, make cycle DEBUG=1 works
     * memory leaks fixed

compiler/types.pas

@@ -743,9 +743,9 @@ implementation
              formaldef :
                push_addr_param:=true;
              recorddef :
-               push_addr_param:=(def.size>target_os.size_of_pointer);
+               push_addr_param:=(def.size>target_info.size_of_pointer);
              arraydef :
-               push_addr_param:=((tarraydef(def).highrange>=tarraydef(def).lowrange) and (def.size>target_os.size_of_pointer)) or
+               push_addr_param:=((tarraydef(def).highrange>=tarraydef(def).lowrange) and (def.size>target_info.size_of_pointer)) or
                                 is_open_array(def) or
                                 is_array_of_const(def) or
                                 is_array_constructor(def);
@@ -1732,7 +1732,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.39  2001-04-13 01:22:17  peter
+  Revision 1.40  2001-04-18 22:02:00  peter
+    * registration of targets and assemblers
+
+  Revision 1.39  2001/04/13 01:22:17  peter
     * symtable change to classes
     * range check generation and errors fixed, make cycle DEBUG=1 works
     * memory leaks fixed