* Add external linker possibility for windows x86_64 compiler

git-svn-id: trunk@15761 -

compiler/aasmtai.pas

@@ -388,7 +388,6 @@ interface
           destructor Destroy;override;
           constructor ppuload(t:taitype;ppufile:tcompilerppufile);override;
           procedure ppuwrite(ppufile:tcompilerppufile);override;
-         private
           { sections should be created via new_section() }
           constructor Create(Asectype:TAsmSectiontype;Aname:string;Aalign:byte;Asecorder:TasmSectionorder=secorder_default);
        end;

compiler/dbgdwarf.pas

@@ -209,7 +209,8 @@ interface
         { force the sym to be emitted as a local variable regardless of its
           type; used for "absolute" local variables referring to parameters.
         }
-        (dvf_force_local_var
+        (dvf_force_local_var,
+         dvf_use_variable_parameter
         );
       tdwarfvarsymflags = set of tdwarfvarsymflag;
 
@@ -307,7 +308,7 @@ interface
         procedure appendprocdef(list:TAsmList;def:tprocdef);override;
 
         function  get_symlist_sym_offset(symlist: ppropaccesslistitem; out sym: tabstractvarsym; out offset: pint): boolean;
-        procedure appendsym_var(list:TAsmList;sym:tabstractnormalvarsym);
+        procedure appendsym_var(list:TAsmList;sym:tabstractnormalvarsym); virtual;
         procedure appendsym_var_with_name_type_offset(list:TAsmList; sym:tabstractnormalvarsym; const name: string; def: tdef; offset: pint; const flags: tdwarfvarsymflags);
         { used for fields and properties mapped to fields }
         procedure appendsym_fieldvar_with_name_offset(list:TAsmList;sym: tfieldvarsym;const name: string; def: tdef; offset: pint);
@@ -372,6 +373,7 @@ interface
         procedure appenddef_set(list:TAsmList;def: tsetdef); override;
         procedure appenddef_undefined(list:TAsmList;def:tundefineddef); override;
         procedure appenddef_variant(list:TAsmList;def:tvariantdef); override;
+        procedure appendsym_var(list:TAsmList;sym:tabstractnormalvarsym); override;
 
         function symname(sym:tsym): String; override;
       public
@@ -2309,11 +2311,11 @@ implementation
             { data continues below }
             DW_AT_location,DW_FORM_block1,blocksize
             ])
-{$ifdef gdb_supports_DW_AT_variable_parameter}
         else if (sym.typ=paravarsym) and
             paramanager.push_addr_param(sym.varspez,sym.vardef,tprocdef(sym.owner.defowner).proccalloption) and
             not(vo_has_local_copy in sym.varoptions) and
-            not is_open_string(sym.vardef) then
+            not is_open_string(sym.vardef) and
+            (dvf_use_variable_parameter in flags) then
           append_entry(tag,false,[
             DW_AT_name,DW_FORM_string,name+#0,
             DW_AT_variable_parameter,DW_FORM_flag,true,
@@ -2324,7 +2326,6 @@ implementation
             { data continues below }
             DW_AT_location,DW_FORM_block1,blocksize
             ])
-{$endif gdb_supports_DW_AT_variable_parameter}
         else
           append_entry(tag,false,[
             DW_AT_name,DW_FORM_string,name+#0,
@@ -2344,14 +2345,13 @@ implementation
           that).  }
         if (vo_is_self in sym.varoptions) then
           append_attribute(DW_AT_artificial,DW_FORM_flag,[true]);
-{$ifndef gdb_supports_DW_AT_variable_parameter}
-        if (sym.typ=paravarsym) and
+        if  not (dvf_use_variable_parameter in flags) and
+            (sym.typ=paravarsym) and
             paramanager.push_addr_param(sym.varspez,sym.vardef,tprocdef(sym.owner.defowner).proccalloption) and
             not(vo_has_local_copy in sym.varoptions) and
             not is_open_string(sym.vardef) then
           append_labelentry_ref(DW_AT_type,def_dwarf_ref_lab(def))
         else
-{$endif not gdb_supports_DW_AT_variable_parameter}
           append_labelentry_ref(DW_AT_type,def_dwarf_lab(def));
 
         templist.free;
@@ -3944,6 +3944,13 @@ implementation
         finish_children; { struct }
       end;
 
+    procedure TDebugInfoDwarf3.appendsym_var(list:TAsmList;sym:tabstractnormalvarsym);
+      begin
+        appendsym_var_with_name_type_offset(list,sym,symname(sym),
+          sym.vardef,0,[dvf_use_variable_parameter]);
+      end;
+
+
     function TDebugInfoDwarf3.dwarf_version: Word;
       begin
         Result:=3;

compiler/nflw.pas

@@ -1314,6 +1314,7 @@ implementation
       begin
         result:=nil;
         { optimize constant expressions }
+        firstpass(left);
         if (left.nodetype=ordconstn) then
           begin
              if tordconstnode(left).value.uvalue=1 then
@@ -1830,7 +1831,7 @@ implementation
 
         include(current_procinfo.flags,pi_has_label);
 
-        if assigned(labsym) and labsym.nonlocal then        
+        if assigned(labsym) and labsym.nonlocal then
           include(current_procinfo.flags,pi_has_interproclabel);
 
         if assigned(left) then

compiler/nutils.pas

@@ -46,7 +46,7 @@ interface
       fen_norecurse_true
     );
 
-    tforeachprocmethod = (pm_preprocess,pm_postprocess);
+    tforeachprocmethod = (pm_preprocess,pm_postprocess,pm_simplify);
 
     foreachnodefunction = function(var n: tnode; arg: pointer): foreachnoderesult of object;
     staticforeachnodefunction = function(var n: tnode; arg: pointer): foreachnoderesult;
@@ -167,7 +167,7 @@ implementation
       result := false;
       if not assigned(n) then
         exit;
-      if procmethod=pm_preprocess then
+      if (procmethod=pm_preprocess) then
         result:=process_children(result);
       case f(n,arg) of
         fen_norecurse_false:
@@ -250,7 +250,11 @@ implementation
       result := false;
       if not assigned(n) then
         exit;
-      if procmethod=pm_preprocess then
+      // simplify needs an extra previous call to
+      // allow for cutting some branches of loop type nodes
+      if procmethod=pm_simplify then
+        f(n,pointer(puint(pm_simplify)));
+      if (procmethod=pm_preprocess) or (procmethod=pm_simplify) then
         result:=process_children(result);
       case f(n,arg) of
         fen_norecurse_false:
@@ -941,6 +945,15 @@ implementation
         hn : tnode;
       begin
         result:=fen_false;
+        if arg = pointer(puint(pm_simplify)) then
+          begin
+            if n.inheritsfrom (tloopnode) then
+              begin
+                dosimplify (tloopnode(n).left);
+                callsimplify (n, nil);
+              end;
+            exit;
+          end;
 
 //        do_typecheckpass(n);
 
@@ -958,9 +971,11 @@ implementation
     { tries to simplify the given node calling the simplify method recursively }
     procedure dosimplify(var n : tnode);
       begin
+        // Optimize if code first
+
         repeat
           treechanged:=false;
-          foreachnodestatic(pm_preprocess,n,@callsimplify,nil);
+          foreachnodestatic(pm_simplify,n,@callsimplify,nil);
         until not(treechanged);
       end;
 

compiler/optcse.pas

@@ -165,7 +165,7 @@ unit optcse;
                 if tnode(plists(arg)^.nodelist[i]).isequal(n) and DFASetIn(plists(arg)^.avail,i) then
                   begin
                     { use always the first occurence }
-                    if ptrint(plists(arg)^.equalto[i])<>-1 then
+                    if plists(arg)^.equalto[i]<>pointer(-1) then
                       plists(arg)^.equalto[plists(arg)^.nodelist.count-1]:=plists(arg)^.equalto[i]
                     else
                       plists(arg)^.equalto[plists(arg)^.nodelist.count-1]:=pointer(i);
@@ -231,7 +231,7 @@ unit optcse;
                 for i:=0 to lists.nodelist.count-1 do
                   begin
                     { current node used more than once? }
-                    if ptrint(lists.refs[i])<>0 then
+                    if assigned(lists.refs[i]) then
                       begin
                         if not(assigned(statements)) then
                           begin
@@ -263,7 +263,7 @@ unit optcse;
 {$endif csedebug}
                       end
                     { current node reference to another node? }
-                    else if ptrint(lists.equalto[i])<>-1 then
+                    else if lists.equalto[i]<>pointer(-1) then
                       begin
 {$if defined(csedebug) or defined(csestats)}
                         printnode(output,tnode(lists.nodelist[i]));
@@ -281,7 +281,7 @@ unit optcse;
                   end;
                 { clean up unused trees }
                 for i:=0 to lists.nodelist.count-1 do
-                  if ptrint(lists.equalto[i])<>-1 then
+                  if lists.equalto[i]<>pointer(-1) then
                     tnode(lists.nodelist[i]).free;
 {$ifdef csedebug}
                 writeln('nodes: ',lists.nodelist.count);

compiler/pmodules.pas

@@ -1225,6 +1225,8 @@ implementation
              { avoid unnecessary warnings }
              gotvarsym.varstate:=vs_read;
              gotvarsym.refs:=1;
+             { _GLOBAL_OFFSET_TABLE_ is in libc }
+             current_module.linkOtherSharedLibs.add('c',link_always);
            end;
 {$endif i386}
 

compiler/systems/t_win.pas

@@ -1093,10 +1093,14 @@ implementation
       begin
         with Info do
          begin
+{$ifdef x86_64}
+           targetopts:='-b pe-x86_64';
+{$else x86_64}
            if target_info.system=system_arm_wince then
              targetopts:='-m arm_wince_pe'
            else
              targetopts:='-b pe-i386 -m i386pe';
+{$endif not x86_64}
            ExeCmd[1]:='ld '+targetopts+' $OPT $GCSECTIONS $MAP $STRIP $APPTYPE $ENTRY  $IMAGEBASE $RELOC -o $EXE $RES';
            DllCmd[1]:='ld '+targetopts+' $OPT $GCSECTIONS $MAP $STRIP --dll $APPTYPE $ENTRY  $IMAGEBASE $RELOC -o $EXE $RES';
            { ExeCmd[2]:='dlltool --as $ASBIN --dllname $EXE --output-exp exp.$$$ $RELOC $DEF';
@@ -1195,7 +1199,11 @@ implementation
              end;
 
             Add('SEARCH_DIR("/usr/i686-pc-cygwin/lib"); SEARCH_DIR("/usr/lib"); SEARCH_DIR("/usr/lib/w32api");');
+{$ifdef x86_64}
+            Add('OUTPUT_FORMAT(pei-x86-64)');
+{$else not 86_64}
             Add('OUTPUT_FORMAT(pei-i386)');
+{$endif not x86_64}
             Add('ENTRY(_mainCRTStartup)');
             Add('SECTIONS');
             Add('{');
@@ -1206,6 +1214,9 @@ implementation
             Add('    *(.init)');
             add('    *(.text .stub .text.* .gnu.linkonce.t.*)');
             Add('    *(SORT(.text$*))');
+            Add('    *(.glue_7t)');
+            Add('    *(.glue_7)');
+            Add('    . = ALIGN(8);');
             Add('     ___CTOR_LIST__ = .; __CTOR_LIST__ = . ;');
             Add('			LONG (-1);*(.ctors); *(.ctor); *(SORT(.ctors.*));  LONG (0);');
             Add('     ___DTOR_LIST__ = .; __DTOR_LIST__ = . ;');
@@ -1220,6 +1231,7 @@ implementation
             add('    *(.data .data.* .gnu.linkonce.d.* .fpc*)');
             Add('    *(.data2)');
             Add('    *(SORT(.data$*))');
+            Add('    *(.jcr)');
             Add('    __data_end__ = . ;');
             Add('    *(.data_cygwin_nocopy)');
             Add('  }');
@@ -1773,6 +1785,7 @@ initialization
   RegisterTarget(system_i386_wince_info);
 {$endif i386}
 {$ifdef x86_64}
+  RegisterExternalLinker(system_x64_win64_info,TExternalLinkerWin);
   RegisterInternalLinker(system_x64_win64_info,TInternalLinkerWin);
   RegisterImport(system_x86_64_win64,TImportLibWin);
   RegisterExport(system_x86_64_win64,TExportLibWin);

compiler/utils/gppc386.pp

@@ -44,10 +44,12 @@ const
   GDBExeName = 'gdbpas';
   GDBIniName = '.gdbinit';
   DefaultCompilerName = 'ppc386';
+  PathSep=':';
 {$else}
   GDBExeName = 'gdbpas.exe';
   GDBIniName = 'gdb.ini';
   DefaultCompilerName = 'ppc386.exe';
+  PathSep=';';
 {$endif not linux}
 
   { If you add a gdb.fpc file in a given directory }
@@ -72,7 +74,7 @@ begin
   { support for info functions directly : used in makefiles }
   if (paramcount=1) and (pos('-i',Paramstr(1))=1) then
     begin
-      Exec(fsearch(CompilerName,GetEnv('PATH')),Paramstr(1));
+      Exec(fsearch(CompilerName,Dir+PathSep+GetEnv('PATH')),Paramstr(1));
       exit;
     end;
 
@@ -114,7 +116,7 @@ begin
   Writeln(fpcgdbini,'end');
   Close(fpcgdbini);
 
-  Exec(fsearch(GDBExeName,GetEnv('PATH')),
+  Exec(fsearch(GDBExeName,Dir+PathSep+GetEnv('PATH')),
 {$ifdef win32}
     '--nw '+
 {$endif win32}