+ added support for special versions of near data pointers associated with a x86 segment register. They are supported on all x86 platforms: i8086, i386 and x86_64

git-svn-id: trunk@24453 -

compiler/defcmp.pas

@@ -1261,12 +1261,14 @@ implementation
                    end;
                  pointerdef :
                    begin
+{$ifdef x86}
                      { check for far pointers }
-                     if (tpointerdef(def_from).is_far<>tpointerdef(def_to).is_far) then
+                     if (tpointerdef(def_from).x86pointertyp<>tpointerdef(def_to).x86pointertyp) then
                        begin
                          eq:=te_incompatible;
                        end
                      else
+{$endif x86}
                       { the types can be forward type, handle before normal type check !! }
                       if assigned(def_to.typesym) and
                          ((tpointerdef(def_to).pointeddef.typ=forwarddef) or

compiler/i386/n386mem.pas

@@ -35,10 +35,6 @@ interface
           procedure pass_generate_code;override;
        end;
 
-       ti386derefnode = class(tcgderefnode)
-          procedure pass_generate_code;override;
-       end;
-
        ti386vecnode = class(tx86vecnode)
           procedure pass_generate_code;override;
        end;
@@ -67,18 +63,6 @@ implementation
       end;
 
 
-{*****************************************************************************
-                           TI386DEREFNODE
-*****************************************************************************}
-
-    procedure ti386derefnode.pass_generate_code;
-      begin
-         inherited pass_generate_code;
-         if tpointerdef(left.resultdef).is_far then
-           location.reference.segment:=NR_FS;
-      end;
-
-
 {*****************************************************************************
                              TI386VECNODE
 *****************************************************************************}
@@ -93,6 +77,5 @@ implementation
 
 begin
    caddrnode:=ti386addrnode;
-   cderefnode:=ti386derefnode;
    cvecnode:=ti386vecnode;
 end.

compiler/i8086/cpunode.pas

@@ -48,6 +48,7 @@ unit cpunode;
        nx86set,
        nx86con,
        nx86cnv,
+       nx86mem,
 
        n8086add,
        n8086cal{,

compiler/ncgmem.pas

@@ -260,7 +260,9 @@ implementation
          if (cs_use_heaptrc in current_settings.globalswitches) and
             (cs_checkpointer in current_settings.localswitches) and
             not(cs_compilesystem in current_settings.moduleswitches) and
-            not(tpointerdef(left.resultdef).is_far) and
+{$ifdef x86}
+            (tpointerdef(left.resultdef).x86pointertyp = default_x86_data_pointer_type) and
+{$endif x86}
             not(nf_no_checkpointer in flags) and
             { can be NR_NO in case of LOC_CONSTANT }
             (location.reference.base<>NR_NO) then

compiler/ninl.pas

@@ -2052,7 +2052,7 @@ implementation
                      {Don't construct pointers from negative values.}
                      if (vl.signed and (vl.svalue<0)) or (vl2.signed and (vl2.svalue<0)) then
                        cgmessage(parser_e_range_check_error);
-                     hp:=cpointerconstnode.create((vl2.uvalue shl 4)+vl.uvalue,voidfarpointertype);
+                     hp:=cpointerconstnode.create((vl2.uvalue shl 4)+vl.uvalue,{$ifdef i386}voidnearfspointertype{$else}voidpointertype{$endif});
                    end
                  else
                    internalerror(88);

compiler/nmem.pas

@@ -572,9 +572,9 @@ implementation
                tabsolutevarsym(tloadnode(hp).symtableentry).absseg) then
               begin
                 if not(nf_typedaddr in flags) then
-                  resultdef:=voidfarpointertype
+                  resultdef:=voidnearfspointertype
                 else
-                  resultdef:=tpointerdef.createfar(left.resultdef);
+                  resultdef:=tpointerdef.createx86(left.resultdef,x86pt_near_fs);
               end
             else
 {$endif i386}

compiler/pdecl.pas

@@ -391,6 +391,9 @@ implementation
          s : shortstring;
          pd: tprocdef;
          hashedid : thashedidstring;
+{$ifdef x86}
+         segment_register: string;
+{$endif x86}
       begin
          old_block_type:=block_type;
          { save unit container of forward declarations -
@@ -692,11 +695,50 @@ implementation
                   begin
                     try_consume_hintdirective(newtype.symoptions,newtype.deprecatedmsg);
                     consume(_SEMICOLON);
+{$ifdef x86}
+                    if try_to_consume(_FAR) then
+                     begin
+  {$if defined(i8086)}
+                       tpointerdef(hdef).x86pointertyp:=x86pt_far;
+  {$elseif defined(i386)}
+                       tpointerdef(hdef).x86pointertyp:=x86pt_near_fs;
+  {$elseif defined(x86_64)}
+                       { for compatibility with previous versions of fpc,
+                         far pointer = regular pointer on x86_64 }
+                       { TODO: decide if we still want to keep this }
+  {$endif}
+                       consume(_SEMICOLON);
+                     end
+                    else
+                      if try_to_consume(_NEAR) then
+                       begin
+                         if token <> _SEMICOLON then
+                           begin
+                             segment_register:=get_stringconst;
+                             case UpCase(segment_register) of
+                               'CS': tpointerdef(hdef).x86pointertyp:=x86pt_near_cs;
+                               'DS': tpointerdef(hdef).x86pointertyp:=x86pt_near_ds;
+                               'SS': tpointerdef(hdef).x86pointertyp:=x86pt_near_ss;
+                               'ES': tpointerdef(hdef).x86pointertyp:=x86pt_near_es;
+                               'FS': tpointerdef(hdef).x86pointertyp:=x86pt_near_fs;
+                               'GS': tpointerdef(hdef).x86pointertyp:=x86pt_near_gs;
+                               else
+                                 Message(asmr_e_invalid_register);
+                             end;
+                           end
+                         else
+                           tpointerdef(hdef).x86pointertyp:=x86pt_near;
+                         consume(_SEMICOLON);
+                       end;
+{$else x86}
+                    { Previous versions of FPC support declaring a pointer as
+                      far even on non-x86 platforms.
+                      TODO: decide if we still want to keep this }
                     if try_to_consume(_FAR) then
                      begin
-                       tpointerdef(hdef).is_far:=true;
                        consume(_SEMICOLON);
                      end;
+{$endif x86}
                   end;
                 procvardef :
                   begin

compiler/psystem.pas

@@ -271,7 +271,19 @@ implementation
         voidpointertype:=tpointerdef.create(voidtype);
         charpointertype:=tpointerdef.create(cansichartype);
         widecharpointertype:=tpointerdef.create(cwidechartype);
-        voidfarpointertype:=tpointerdef.createfar(voidtype);
+{$ifdef x86}
+        voidnearpointertype:=tpointerdef.createx86(voidtype,x86pt_near);
+        voidnearcspointertype:=tpointerdef.createx86(voidtype,x86pt_near_cs);
+        voidneardspointertype:=tpointerdef.createx86(voidtype,x86pt_near_ds);
+        voidnearsspointertype:=tpointerdef.createx86(voidtype,x86pt_near_ss);
+        voidnearespointertype:=tpointerdef.createx86(voidtype,x86pt_near_es);
+        voidnearfspointertype:=tpointerdef.createx86(voidtype,x86pt_near_fs);
+        voidneargspointertype:=tpointerdef.createx86(voidtype,x86pt_near_gs);
+  {$ifdef i8086}
+        voidfarpointertype:=tpointerdef.createx86(voidtype,x86pt_far);
+        voidhugepointertype:=tpointerdef.createx86(voidtype,x86pt_huge);
+  {$endif i8086}
+{$endif x86}
         cfiletype:=tfiledef.createuntyped;
         cvarianttype:=tvariantdef.create(vt_normalvariant);
         colevarianttype:=tvariantdef.create(vt_olevariant);
@@ -318,7 +330,17 @@ implementation
         addtype('Currency',s64currencytype);
         addtype('Pointer',voidpointertype);
 {$ifdef x86}
+        addtype('NearPointer',voidnearpointertype);
+        addtype('NearCsPointer',voidnearcspointertype);
+        addtype('NearDsPointer',voidneardspointertype);
+        addtype('NearSsPointer',voidnearsspointertype);
+        addtype('NearEsPointer',voidnearespointertype);
+        addtype('NearFsPointer',voidnearfspointertype);
+        addtype('NearGsPointer',voidneargspointertype);
+  {$ifdef i8086}
         addtype('FarPointer',voidfarpointertype);
+        addtype('HugePointer',voidhugepointertype);
+  {$endif i8086}
 {$endif x86}
         addtype('ShortString',cshortstringtype);
 {$ifdef support_longstring}
@@ -383,7 +405,19 @@ implementation
         addtype('$void_pointer',voidpointertype);
         addtype('$char_pointer',charpointertype);
         addtype('$widechar_pointer',widecharpointertype);
+{$ifdef x86}
+        addtype('$void_nearpointer',voidnearpointertype);
+        addtype('$void_nearcspointer',voidnearcspointertype);
+        addtype('$void_neardspointer',voidneardspointertype);
+        addtype('$void_nearsspointer',voidnearsspointertype);
+        addtype('$void_nearespointer',voidnearespointertype);
+        addtype('$void_nearfspointer',voidnearfspointertype);
+        addtype('$void_neargspointer',voidneargspointertype);
+  {$ifdef i8086}
         addtype('$void_farpointer',voidfarpointertype);
+        addtype('$void_hugepointer',voidhugepointertype);
+  {$endif i8086}
+{$endif x86}
         addtype('$openchararray',openchararraytype);
         addtype('$file',cfiletype);
         addtype('$variant',cvarianttype);
@@ -496,7 +530,19 @@ implementation
         loadtype('void_pointer',voidpointertype);
         loadtype('char_pointer',charpointertype);
         loadtype('widechar_pointer',widecharpointertype);
+{$ifdef x86}
+        loadtype('void_nearpointer',voidnearpointertype);
+        loadtype('void_nearcspointer',voidnearcspointertype);
+        loadtype('void_neardspointer',voidneardspointertype);
+        loadtype('void_nearsspointer',voidnearsspointertype);
+        loadtype('void_nearespointer',voidnearespointertype);
+        loadtype('void_nearfspointer',voidnearfspointertype);
+        loadtype('void_neargspointer',voidneargspointertype);
+  {$ifdef i8086}
         loadtype('void_farpointer',voidfarpointertype);
+        loadtype('void_hugepointer',voidhugepointertype);
+  {$endif i8086}
+{$endif x86}
         loadtype('file',cfiletype);
         if not(target_info.system in systems_managed_vm) then
           begin

compiler/symdef.pas

@@ -174,11 +174,28 @@ interface
           procedure deref;override;
        end;
 
+{$ifdef x86}
+       tx86pointertyp = (x86pt_near, x86pt_near_cs, x86pt_near_ds, x86pt_near_ss,
+         x86pt_near_es, x86pt_near_fs, x86pt_near_gs, x86pt_far, x86pt_huge);
+
+    const
+       { TODO: make this depend on the memory model, when other memory models are supported }
+       default_x86_data_pointer_type = x86pt_near;
+
+    type
+{$endif x86}
+
+       { tpointerdef }
+
        tpointerdef = class(tabstractpointerdef)
-          is_far : boolean;
+{$ifdef x86}
+          x86pointertyp : tx86pointertyp;
+{$endif x86}
           has_pointer_math : boolean;
           constructor create(def:tdef);
-          constructor createfar(def:tdef);
+{$ifdef x86}
+          constructor createx86(def:tdef;x86typ:tx86pointertyp);
+{$endif x86}
           function getcopy:tstoreddef;override;
           constructor ppuload(ppufile:tcompilerppufile);
           procedure ppuwrite(ppufile:tcompilerppufile);override;
@@ -806,7 +823,19 @@ interface
        voidpointertype,           { pointer for Void-pointeddef }
        charpointertype,           { pointer for Char-pointeddef }
        widecharpointertype,       { pointer for WideChar-pointeddef }
+{$ifdef x86}
+       voidnearpointertype,
+       voidnearcspointertype,
+       voidneardspointertype,
+       voidnearsspointertype,
+       voidnearespointertype,
+       voidnearfspointertype,
+       voidneargspointertype,
+  {$ifdef i8086}
        voidfarpointertype,
+       voidhugepointertype,
+  {$endif i8086}
+{$endif x86}
        cundefinedtype,
        cformaltype,               { unique formal definition }
        ctypedformaltype,          { unique typed formal definition }
@@ -2697,23 +2726,37 @@ implementation
     constructor tpointerdef.create(def:tdef);
       begin
         inherited create(pointerdef,def);
-        is_far:=false;
+{$ifdef x86}
+        x86pointertyp := default_x86_data_pointer_type;
+{$endif x86}
         has_pointer_math:=cs_pointermath in current_settings.localswitches;
       end;
 
 
-    constructor tpointerdef.createfar(def:tdef);
+{$ifdef x86}
+    constructor tpointerdef.createx86(def: tdef; x86typ: tx86pointertyp);
       begin
         inherited create(pointerdef,def);
-        is_far:=true;
+        x86pointertyp := x86typ;
         has_pointer_math:=cs_pointermath in current_settings.localswitches;
       end;
+{$endif x86}
+
+
+{    constructor tpointerdef.createfar(def:tdef);
+      begin
+        inherited create(pointerdef,def);
+        is_far:=true;
+        has_pointer_math:=cs_pointermath in current_settings.localswitches;
+      end;}
 
 
     constructor tpointerdef.ppuload(ppufile:tcompilerppufile);
       begin
          inherited ppuload(pointerdef,ppufile);
-         is_far:=(ppufile.getbyte<>0);
+{$ifdef x86}
+         x86pointertyp:=tx86pointertyp(ppufile.getbyte);
+{$endif x86}
          has_pointer_math:=(ppufile.getbyte<>0);
       end;
 
@@ -2727,7 +2770,9 @@ implementation
           result:=tpointerdef.create(tforwarddef(pointeddef).getcopy)
         else
           result:=tpointerdef.create(pointeddef);
-        tpointerdef(result).is_far:=is_far;
+{$ifdef x86}
+        tpointerdef(result).x86pointertyp:=x86pointertyp;
+{$endif x86}
         tpointerdef(result).has_pointer_math:=has_pointer_math;
         tpointerdef(result).savesize:=savesize;
       end;
@@ -2736,7 +2781,9 @@ implementation
     procedure tpointerdef.ppuwrite(ppufile:tcompilerppufile);
       begin
          inherited ppuwrite(ppufile);
-         ppufile.putbyte(byte(is_far));
+{$ifdef x86}
+         ppufile.putbyte(byte(x86pointertyp));
+{$endif x86}
          ppufile.putbyte(byte(has_pointer_math));
          ppufile.writeentry(ibpointerdef);
       end;
@@ -2744,10 +2791,26 @@ implementation
 
     function tpointerdef.GetTypeName : string;
       begin
-         if is_far then
-          GetTypeName:='^'+pointeddef.typename+';far'
+{$ifdef x86}
+         if x86pointertyp = default_x86_data_pointer_type then
+           GetTypeName:='^'+pointeddef.typename
          else
-          GetTypeName:='^'+pointeddef.typename;
+           case x86pointertyp of
+             x86pt_near: GetTypeName:='^'+pointeddef.typename+';near';
+             x86pt_near_cs: GetTypeName:='^'+pointeddef.typename+';near ''CS''';
+             x86pt_near_ds: GetTypeName:='^'+pointeddef.typename+';near ''DS''';
+             x86pt_near_ss: GetTypeName:='^'+pointeddef.typename+';near ''SS''';
+             x86pt_near_es: GetTypeName:='^'+pointeddef.typename+';near ''ES''';
+             x86pt_near_fs: GetTypeName:='^'+pointeddef.typename+';near ''FS''';
+             x86pt_near_gs: GetTypeName:='^'+pointeddef.typename+';near ''GS''';
+             x86pt_far: GetTypeName:='^'+pointeddef.typename+';far';
+             x86pt_huge: GetTypeName:='^'+pointeddef.typename+';huge';
+             else
+               internalerror(2013050301);
+           end;
+{$else x86}
+         GetTypeName:='^'+pointeddef.typename;
+{$endif x86}
       end;
 
 

compiler/x86/nx86mem.pas

@@ -30,8 +30,14 @@ interface
       node,nmem,ncgmem;
 
     type
+      tx86derefnode = class(tcgderefnode)
+        procedure pass_generate_code;override;
+      end;
+
       tx86vecnode = class(tcgvecnode)
+{$ifndef i8086}
         procedure update_reference_reg_mul(maybe_const_reg:tregister;l:aint);override;
+{$endif not i8086}
       end;
 
 implementation
@@ -39,12 +45,37 @@ implementation
     uses
       cutils,verbose,
       aasmtai,aasmdata,
-      cgutils,cgobj;
+      cgutils,cgobj,
+      symdef;
+
+{*****************************************************************************
+                           TX86DEREFNODE
+*****************************************************************************}
+
+     procedure tx86derefnode.pass_generate_code;
+       begin
+         inherited pass_generate_code;
+         case tpointerdef(left.resultdef).x86pointertyp of
+           x86pt_near: ;
+           x86pt_near_cs: location.reference.segment:=NR_CS;
+           x86pt_near_ds: location.reference.segment:=NR_DS;
+           x86pt_near_ss: location.reference.segment:=NR_SS;
+           x86pt_near_es: location.reference.segment:=NR_ES;
+           x86pt_near_fs: location.reference.segment:=NR_FS;
+           x86pt_near_gs: location.reference.segment:=NR_GS;
+           x86pt_far: internalerror(2013050401);
+           x86pt_huge: internalerror(2013050402);
+           else
+             internalerror(2013050403);
+         end;
+       end;
+
 
 {*****************************************************************************
                              TX86VECNODE
 *****************************************************************************}
 
+{$ifndef i8086}
      { this routine must, like any other routine, not change the contents }
      { of base/index registers of references, as these may be regvars.    }
      { The register allocator can coalesce one LOC_REGISTER being moved   }
@@ -102,7 +133,9 @@ implementation
          end;
          location.reference.index:=hreg;
        end;
+{$endif not i8086}
 
 begin
+   cderefnode:=tx86derefnode;
    cvecnode:=tx86vecnode;
 end.

rtl/inc/systemh.inc

@@ -112,6 +112,10 @@ Type
   {$ifndef FPUNONE}
     ValReal = Extended;
   {$endif}
+
+  {$ifndef VER2_6}
+  FarPointer = NearFsPointer;
+  {$endif}
 {$endif CPUI386}
 
 {$ifdef CPUI8086}
@@ -152,6 +156,9 @@ Type
   {$define SUPPORT_SINGLE}
   {$define SUPPORT_DOUBLE}
 
+  {$ifndef VER2_6}
+  FarPointer = Pointer;
+  {$endif}
 {$endif CPUX86_64}
 
 {$ifdef CPUM68K}