+ farpointer type

  * absolutesym now also stores if its far

compiler/cg386mem.pas

@@ -307,6 +307,8 @@ implementation
                  p^.location.reference.base:=hr;
               end;
          end;
+         if p^.left^.resulttype^.deftype=farpointerdef then
+          p^.location.reference.segment:=R_FS;
       end;
 
 
@@ -744,7 +746,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.22  1998-12-11 00:02:55  peter
+  Revision 1.23  1998-12-30 22:15:45  peter
+    + farpointer type
+    * absolutesym now also stores if its far
+
+  Revision 1.22  1998/12/11 00:02:55  peter
     + globtype,tokens,version unit splitted from globals
 
   Revision 1.21  1998/12/10 09:47:18  florian

compiler/pdecl.pas

@@ -328,11 +328,9 @@ unit pdecl;
                    { we should check the result type of srsym }
                    if not (srsym^.typ in [varsym,typedconstsym]) then
                      Message(parser_e_absolute_only_to_var_or_const);
-
                    storetokenpos:=tokenpos;
                    tokenpos:=declarepos;
                    abssym:=new(pabsolutesym,init(s,p));
-                   abssym^.typ:=absolutesym;
                    abssym^.abstyp:=tovar;
                    abssym^.ref:=srsym;
                    tokenpos:=storetokenpos;
@@ -346,7 +344,6 @@ unit pdecl;
                     abssym:=new(pabsolutesym,init(s,p));
                     s:=pattern;
                     consume(token);
-                    abssym^.typ:=absolutesym;
                     abssym^.abstyp:=toasm;
                     abssym^.asmname:=stringdup(s);
                     tokenpos:=storetokenpos;
@@ -361,7 +358,6 @@ unit pdecl;
                        storetokenpos:=tokenpos;
                        tokenpos:=declarepos;
                        abssym:=new(pabsolutesym,init(s,p));
-                       abssym^.typ:=absolutesym;
                        abssym^.abstyp:=toaddr;
                        abssym^.absseg:=false;
                        tokenpos:=storetokenpos;
@@ -2123,7 +2119,11 @@ unit pdecl;
 end.
 {
   $Log$
-  Revision 1.90  1998-12-15 17:16:00  peter
+  Revision 1.91  1998-12-30 22:15:46  peter
+    + farpointer type
+    * absolutesym now also stores if its far
+
+  Revision 1.90  1998/12/15 17:16:00  peter
     * fixed const s : ^string
     * first things for const pchar : @string[1]
 

compiler/pexpr.pas

@@ -1165,7 +1165,7 @@ unit pexpr;
                 CARET:
                   begin
                     consume(CARET);
-                    if pd^.deftype<>pointerdef then
+                    if not(pd^.deftype in [pointerdef,farpointerdef]) then
                       begin
                          { ^ as binary operator is a problem!!!! (FK) }
                          again:=false;
@@ -1928,7 +1928,11 @@ unit pexpr;
 end.
 {
   $Log$
-  Revision 1.78  1998-12-11 00:03:32  peter
+  Revision 1.79  1998-12-30 22:15:48  peter
+    + farpointer type
+    * absolutesym now also stores if its far
+
+  Revision 1.78  1998/12/11 00:03:32  peter
     + globtype,tokens,version unit splitted from globals
 
   Revision 1.77  1998/12/04 10:18:09  florian

compiler/ppu.pas

@@ -92,6 +92,7 @@ const
   iblongstringdef = 54;
   ibansistringdef = 55;
   ibwidestringdef = 56;
+  ibfarpointerdef = 57;
 
 { unit flags }
   uf_init          = $1;
@@ -792,7 +793,11 @@ end;
 end.
 {
   $Log$
-  Revision 1.20  1998-11-30 16:34:45  pierre
+  Revision 1.21  1998-12-30 22:15:50  peter
+    + farpointer type
+    * absolutesym now also stores if its far
+
+  Revision 1.20  1998/11/30 16:34:45  pierre
     * corrected problems with rangecheck
     + added needed code for no rangecheck  in CRC32 functions in ppu unit
     * enumdef lso need its rangenr reset to zero

compiler/psystem.pas

@@ -103,6 +103,7 @@ begin
   p^.insert(new(ptypesym,init('boolean',booldef)));
   p^.insert(new(ptypesym,init('void_pointer',voidpointerdef)));
   p^.insert(new(ptypesym,init('char_pointer',charpointerdef)));
+  p^.insert(new(ptypesym,init('void_farpointer',voidfarpointerdef)));
   p^.insert(new(ptypesym,init('file',cfiledef)));
 {$ifdef i386}
   p^.insert(new(ptypesym,init('REAL',c64floatdef)));
@@ -126,6 +127,7 @@ begin
 {$endif}
   p^.insert(new(ptypesym,init('SINGLE',new(pfloatdef,init(s32real)))));
   p^.insert(new(ptypesym,init('POINTER',voidpointerdef)));
+  p^.insert(new(ptypesym,init('FARPOINTER',voidfarpointerdef)));
   p^.insert(new(ptypesym,init('STRING',cshortstringdef)));
   p^.insert(new(ptypesym,init('SHORTSTRING',cshortstringdef)));
   p^.insert(new(ptypesym,init('LONGSTRING',clongstringdef)));
@@ -198,6 +200,7 @@ begin
   booldef:=porddef(globaldef('boolean'));
   voidpointerdef:=ppointerdef(globaldef('void_pointer'));
   charpointerdef:=ppointerdef(globaldef('char_pointer'));
+  voidfarpointerdef:=pfarpointerdef(globaldef('void_farpointer'));
   cfiledef:=pfiledef(globaldef('file'));
 end;
 
@@ -245,6 +248,7 @@ begin
   { some other definitions }
   voidpointerdef:=new(ppointerdef,init(voiddef));
   charpointerdef:=new(ppointerdef,init(cchardef));
+  voidfarpointerdef:=new(pfarpointerdef,init(voiddef));
   cfiledef:=new(pfiledef,init(ft_untyped,nil));
   registerdef:=oldregisterdef;
 end;
@@ -253,7 +257,11 @@ end;
 end.
 {
   $Log$
-  Revision 1.14  1998-12-11 00:03:40  peter
+  Revision 1.15  1998-12-30 22:15:51  peter
+    + farpointer type
+    * absolutesym now also stores if its far
+
+  Revision 1.14  1998/12/11 00:03:40  peter
     + globtype,tokens,version unit splitted from globals
 
   Revision 1.13  1998/12/10 09:47:25  florian

compiler/symdef.inc

@@ -1290,6 +1290,34 @@
 {$endif GDB}
 
 
+{****************************************************************************
+                             TFARPOINTERDEF
+****************************************************************************}
+
+    constructor tfarpointerdef.init(def : pdef);
+      begin
+         inherited init(def);
+         deftype:=farpointerdef;
+         savesize:=target_os.size_of_pointer;
+      end;
+
+
+    constructor tfarpointerdef.load;
+      begin
+         inherited load;
+         deftype:=farpointerdef;
+         savesize:=target_os.size_of_pointer;
+      end;
+
+
+    procedure tfarpointerdef.write;
+      begin
+         tdef.write;
+         writedefref(definition);
+         current_ppu^.writeentry(ibfarpointerdef);
+      end;
+
+
 {****************************************************************************
                               TCLASSREFDEF
 ****************************************************************************}
@@ -3254,7 +3282,11 @@
 
 {
   $Log$
-  Revision 1.84  1998-12-30 13:41:12  peter
+  Revision 1.85  1998-12-30 22:15:52  peter
+    + farpointer type
+    * absolutesym now also stores if its far
+
+  Revision 1.84  1998/12/30 13:41:12  peter
     * released valuepara
 
   Revision 1.83  1998/12/21 14:03:08  pierre

compiler/symdefh.inc

@@ -28,7 +28,7 @@
        tdeftype = (abstractdef,arraydef,recorddef,pointerdef,orddef,
                    stringdef,enumdef,procdef,objectdef,errordef,
                    filedef,formaldef,setdef,procvardef,floatdef,
-                   classrefdef);
+                   classrefdef,farpointerdef);
 
        pdef = ^tdef;
        tdef = object
@@ -159,6 +159,15 @@
           procedure deref;virtual;
        end;
 
+
+       pfarpointerdef = ^tfarpointerdef;
+       tfarpointerdef = object(tpointerdef)
+          constructor init(def : pdef);
+          constructor load;
+          procedure write;virtual;
+       end;
+
+
        pobjectdef = ^tobjectdef;
        tobjectdef = object(tdef)
           childof : pobjectdef;
@@ -485,7 +494,11 @@
 
 {
   $Log$
-  Revision 1.12  1998-12-10 09:47:28  florian
+  Revision 1.13  1998-12-30 22:15:53  peter
+    + farpointer type
+    * absolutesym now also stores if its far
+
+  Revision 1.12  1998/12/10 09:47:28  florian
     + basic operations with int64/qord (compiler with -dint64)
     + rtti of enumerations extended: names are now written
 

compiler/symsym.inc

@@ -735,15 +735,14 @@
                                   TABSOLUTESYM
 ****************************************************************************}
 
-{   constructor tabsolutesym.init(const s : string;p : pdef;newref : psym);
-     begin
-        inherited init(s,p);
-        ref:=newref;
+    constructor tabsolutesym.init(const n : string;p : pdef);
+      begin
+        inherited init(n,p);
         typ:=absolutesym;
-     end; }
+      end;
 
-    constructor tabsolutesym.load;
 
+    constructor tabsolutesym.load;
       begin
          tvarsym.load;
          typ:=absolutesym;
@@ -758,12 +757,15 @@
                  ref:=srsym;
                end;
        toasm : asmname:=stringdup(readstring);
-      toaddr : address:=readlong;
+      toaddr : begin
+                 address:=readlong;
+                 absseg:=boolean(readbyte);
+               end;
          end;
       end;
 
-    procedure tabsolutesym.write;
 
+    procedure tabsolutesym.write;
       begin
          tsym.write;
          writebyte(byte(varspez));
@@ -775,11 +777,15 @@
          case abstyp of
            tovar : writestring(ref^.name);
            toasm : writestring(asmname^);
-          toaddr : writelong(address);
+          toaddr : begin
+                     writelong(address);
+                     writebyte(byte(absseg));
+                   end;
          end;
         current_ppu^.writeentry(ibabsolutesym);
       end;
 
+
     procedure tabsolutesym.deref;
       begin
          resolvedef(definition);
@@ -796,6 +802,7 @@
            end;
       end;
 
+
     function tabsolutesym.mangledname : string;
       begin
          case abstyp of
@@ -807,10 +814,10 @@
          end;
       end;
 
-      procedure tabsolutesym.insert_in_data;
 
-        begin
-        end;
+    procedure tabsolutesym.insert_in_data;
+      begin
+      end;
 
 
 {$ifdef GDB}
@@ -820,6 +827,7 @@
       end;
 {$endif GDB}
 
+
 {****************************************************************************
                                   TVARSYM
 ****************************************************************************}
@@ -1747,7 +1755,11 @@
 
 {
   $Log$
-  Revision 1.66  1998-12-30 13:41:14  peter
+  Revision 1.67  1998-12-30 22:15:54  peter
+    + farpointer type
+    * absolutesym now also stores if its far
+
+  Revision 1.66  1998/12/30 13:41:14  peter
     * released valuepara
 
   Revision 1.65  1998/12/26 15:35:44  peter

compiler/symsymh.inc

@@ -240,6 +240,7 @@
           absseg : boolean;
           ref : psym;
           asmname : pstring;
+          constructor init(const n : string;p : pdef);
           constructor load;
           procedure deref;virtual;
           function mangledname : string;virtual;
@@ -323,7 +324,11 @@
 
 {
   $Log$
-  Revision 1.10  1998-12-30 13:41:15  peter
+  Revision 1.11  1998-12-30 22:15:55  peter
+    + farpointer type
+    * absolutesym now also stores if its far
+
+  Revision 1.10  1998/12/30 13:41:15  peter
     * released valuepara
 
   Revision 1.9  1998/11/28 16:20:57  peter

compiler/tcmem.pas

@@ -214,9 +214,26 @@ implementation
                 end
               else
                 begin
-                  if not(cs_typed_addresses in aktlocalswitches) then
-                    p^.resulttype:=voidpointerdef
-                  else p^.resulttype:=new(ppointerdef,init(p^.left^.resulttype));
+                  { what are we getting the address from an absolute sym? }
+                  hp:=p^.left;
+                  while assigned(hp) and (hp^.treetype in [vecn,subscriptn]) do
+                   hp:=hp^.left;
+                  if assigned(hp) and (hp^.treetype=loadn) and
+                     ((hp^.symtableentry^.typ=absolutesym) and
+                      pabsolutesym(hp^.symtableentry)^.absseg) then
+                   begin
+                     if not(cs_typed_addresses in aktlocalswitches) then
+                       p^.resulttype:=voidfarpointerdef
+                     else
+                       p^.resulttype:=new(pfarpointerdef,init(p^.left^.resulttype));
+                   end
+                  else
+                   begin
+                     if not(cs_typed_addresses in aktlocalswitches) then
+                       p^.resulttype:=voidpointerdef
+                     else
+                       p^.resulttype:=new(ppointerdef,init(p^.left^.resulttype));
+                   end;
                 end;
            end;
          store_valid:=must_be_valid;
@@ -227,8 +244,7 @@ implementation
            exit;
 
          { we should allow loc_mem for @string }
-         if (p^.left^.location.loc<>LOC_REFERENCE) and
-            (p^.left^.location.loc<>LOC_MEM) then
+         if not(p^.left^.location.loc in [LOC_MEM,LOC_REFERENCE]) then
            CGMessage(cg_e_illegal_expression);
 
          p^.registers32:=p^.left^.registers32;
@@ -291,7 +307,7 @@ implementation
          p^.registersmmx:=p^.left^.registersmmx;
 {$endif SUPPORT_MMX}
 
-         if p^.left^.resulttype^.deftype<>pointerdef then
+         if not(p^.left^.resulttype^.deftype in [pointerdef,farpointerdef]) then
           CGMessage(cg_e_invalid_qualifier);
 
          p^.resulttype:=ppointerdef(p^.left^.resulttype)^.definition;
@@ -349,9 +365,9 @@ implementation
       var
          harr : pdef;
          ct : tconverttype;
-{$ifdef consteval}	 
+{$ifdef consteval}
          tcsym : ptypedconstsym;
-{$endif}	 
+{$endif}
       begin
          firstpass(p^.left);
          firstpass(p^.right);
@@ -520,7 +536,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.6  1998-12-15 17:16:02  peter
+  Revision 1.7  1998-12-30 22:15:59  peter
+    + farpointer type
+    * absolutesym now also stores if its far
+
+  Revision 1.6  1998/12/15 17:16:02  peter
     * fixed const s : ^string
     * first things for const pchar : @string[1]