瀏覽代碼

* moved bitmask constants to sets
* some other type/const renamings

peter 26 年之前
父節點
當前提交
ed8eb13d59
共有 50 個文件被更改,包括 2502 次插入1480 次删除
  1. 364 50
      compiler/browcol.pas
  2. 9 5
      compiler/browlog.pas
  3. 8 4
      compiler/cg386add.pas
  4. 78 64
      compiler/cg386cal.pas
  5. 10 6
      compiler/cg386cnv.pas
  6. 6 2
      compiler/cg386con.pas
  7. 7 3
      compiler/cg386flw.pas
  8. 11 7
      compiler/cg386inl.pas
  9. 13 9
      compiler/cg386ld.pas
  10. 6 2
      compiler/cg386mat.pas
  11. 9 5
      compiler/cg386mem.pas
  12. 7 3
      compiler/cg386set.pas
  13. 33 29
      compiler/cgai386.pas
  14. 40 31
      compiler/hcgdata.pas
  15. 21 12
      compiler/htypechk.pas
  16. 11 2
      compiler/lin_targ.pas
  17. 13 9
      compiler/pass_2.pas
  18. 203 112
      compiler/pdecl.pas
  19. 9 5
      compiler/pexports.pas
  20. 51 44
      compiler/pexpr.pas
  21. 11 7
      compiler/pmodules.pas
  22. 40 34
      compiler/pstatmnt.pas
  23. 336 203
      compiler/psub.pas
  24. 12 8
      compiler/psystem.pas
  25. 17 31
      compiler/ptconst.pas
  26. 6 2
      compiler/ra386att.pas
  27. 10 6
      compiler/ra386dir.pas
  28. 19 14
      compiler/rautils.pas
  29. 116 90
      compiler/symconst.inc
  30. 187 0
      compiler/symconst.pas
  31. 251 221
      compiler/symdef.inc
  32. 125 137
      compiler/symdefh.inc
  33. 20 24
      compiler/symppu.inc
  34. 107 53
      compiler/symsym.inc
  35. 43 46
      compiler/symsymh.inc
  36. 35 36
      compiler/symtable.pas
  37. 37 31
      compiler/systems.pas
  38. 18 14
      compiler/tcadd.pas
  39. 33 17
      compiler/tccal.pas
  40. 13 9
      compiler/tccnv.pas
  41. 6 2
      compiler/tccon.pas
  42. 11 8
      compiler/tcflw.pas
  43. 9 5
      compiler/tcinl.pas
  44. 35 20
      compiler/tcld.pas
  45. 11 7
      compiler/tcmat.pas
  46. 18 9
      compiler/tcmem.pas
  47. 6 2
      compiler/tcset.pas
  48. 7 1
      compiler/tokens.pas
  49. 7 2
      compiler/tree.pas
  50. 47 37
      compiler/types.pas

+ 364 - 50
compiler/browcol.pas

@@ -37,6 +37,7 @@ const
     sfRecord        = $00000001;
     sfObject        = $00000002;
     sfClass         = $00000004;
+    sfHasMemInfo    = $80000000;
 
 type
     TStoreCollection = object(TStringCollection)
@@ -62,6 +63,8 @@ type
       constructor Init(AFileName: PString; ALine, AColumn: Sw_integer);
       function    GetFileName: string;
       destructor  Done; virtual;
+      constructor Load(var S: TStream);
+      procedure   Store(var S: TStream);
     end;
 
     PSymbolMemInfo = ^TSymbolMemInfo;
@@ -96,6 +99,8 @@ type
       function    GetText: string;
       function    GetTypeName: string;
       destructor  Done; virtual;
+      constructor Load(var S: TStream);
+      procedure   Store(var S: TStream);
     end;
 
     PObjectSymbolCollection = ^TObjectSymbolCollection;
@@ -112,6 +117,8 @@ type
       function    GetDescendant(Index: sw_integer): PObjectSymbol;
       procedure   AddDescendant(P: PObjectSymbol);
       destructor  Done; virtual;
+      constructor Load(var S: TStream);
+      procedure   Store(S: TStream);
     private
       Name: PString;
       Descendants: PObjectSymbolCollection;
@@ -159,16 +166,83 @@ procedure CreateBrowserCol;
 procedure InitBrowserCol;
 procedure DoneBrowserCol;
 
+function  LoadBrowserCol(S: PStream): boolean;
+procedure StoreBrowserCol(S: PStream);
+
 procedure BuildObjectInfo;
 
 function SearchObjectForSymbol(O: PSymbol): PObjectSymbol;
 
+procedure RegisterSymbols;
+
 implementation
 
 uses
-  Verbose,
+  Drivers,Views,App,
   aasm,globtype,globals,files,comphook;
 
+const
+  RModuleNameCollection: TStreamRec = (
+     ObjType: 3001;
+     VmtLink: Ofs(TypeOf(TModuleNameCollection)^);
+     Load:    @TModuleNameCollection.Load;
+     Store:   @TModuleNameCollection.Store
+  );
+  RTypeNameCollection: TStreamRec = (
+     ObjType: 3002;
+     VmtLink: Ofs(TypeOf(TTypeNameCollection)^);
+     Load:    @TTypeNameCollection.Load;
+     Store:   @TTypeNameCollection.Store
+  );
+  RReference: TStreamRec = (
+     ObjType: 3003;
+     VmtLink: Ofs(TypeOf(TReference)^);
+     Load:    @TReference.Load;
+     Store:   @TReference.Store
+  );
+  RSymbol: TStreamRec = (
+     ObjType: 3004;
+     VmtLink: Ofs(TypeOf(TSymbol)^);
+     Load:    @TSymbol.Load;
+     Store:   @TSymbol.Store
+  );
+  RObjectSymbol: TStreamRec = (
+     ObjType: 3005;
+     VmtLink: Ofs(TypeOf(TObjectSymbol)^);
+     Load:    @TObjectSymbol.Load;
+     Store:   @TObjectSymbol.Store
+  );
+  RSymbolCollection: TStreamRec = (
+     ObjType: 3006;
+     VmtLink: Ofs(TypeOf(TSymbolCollection)^);
+     Load:    @TSymbolCollection.Load;
+     Store:   @TSymbolCollection.Store
+  );
+  RSortedSymbolCollection: TStreamRec = (
+     ObjType: 3007;
+     VmtLink: Ofs(TypeOf(TSortedSymbolCollection)^);
+     Load:    @TSortedSymbolCollection.Load;
+     Store:   @TSortedSymbolCollection.Store
+  );
+  RIDSortedSymbolCollection: TStreamRec = (
+     ObjType: 3008;
+     VmtLink: Ofs(TypeOf(TIDSortedSymbolCollection)^);
+     Load:    @TIDSortedSymbolCollection.Load;
+     Store:   @TIDSortedSymbolCollection.Store
+  );
+  RObjectSymbolCollection: TStreamRec = (
+     ObjType: 3009;
+     VmtLink: Ofs(TypeOf(TObjectSymbolCollection)^);
+     Load:    @TObjectSymbolCollection.Load;
+     Store:   @TObjectSymbolCollection.Store
+  );
+  RReferenceCollection: TStreamRec = (
+     ObjType: 3010;
+     VmtLink: Ofs(TypeOf(TReferenceCollection)^);
+     Load:    @TReferenceCollection.Load;
+     Store:   @TReferenceCollection.Store
+  );
+
 {****************************************************************************
                                    Helpers
 ****************************************************************************}
@@ -273,13 +347,7 @@ begin
   S2:=Upper(K2^.GetName);
   if S1<S2 then R:=-1 else
   if S1>S2 then R:=1 else
-    begin
-      S1:=K1^.GetName;
-      S2:=K2^.GetName;
-      if S1<S2 then R:=-1 else
-      if S1>S2 then R:=1 else
-       R:=0;
-    end;
+  R:=0;
   Compare:=R;
 end;
 
@@ -306,12 +374,11 @@ begin
       OLI:=Left; ORI:=Right;
       Mid:=Left+(Right-Left) div 2;
       LeftP:=At(Left); RightP:=At(Right); MidP:=At(Mid);
-      LeftS:=Upper(LeftP^.GetName);
-      MidS:=Upper(MidP^.GetName);
+      LeftS:=Upper(LeftP^.GetName); MidS:=Upper(MidP^.GetName);
       RightS:=Upper(RightP^.GetName);
       if copy(MidS,1,length(UpS))=UpS then
         begin
-          Idx:=Mid; FoundS:=UpS{copy(MidS,1,length(S)) same and easier };
+          Idx:=Mid; FoundS:=copy(MidS,1,length(S));
         end;
 {      else}
         if UpS<MidS then
@@ -375,13 +442,7 @@ begin
   S2:=Upper(K2^.GetName);
   if S1<S2 then R:=-1 else
   if S1>S2 then R:=1 else
-    begin
-      S1:=K1^.GetName;
-      S2:=K2^.GetName;
-      if S1<S2 then R:=-1 else
-      if S1>S2 then R:=1 else
-       R:=0;
-    end;
+  R:=0;
   Compare:=R;
 end;
 
@@ -403,12 +464,11 @@ begin
       OLI:=Left; ORI:=Right;
       Mid:=Left+(Right-Left) div 2;
       LeftP:=At(Left); RightP:=At(Right); MidP:=At(Mid);
-      LeftS:=Upper(LeftP^.GetName);
-      MidS:=Upper(MidP^.GetName);
+      LeftS:=Upper(LeftP^.GetName); MidS:=Upper(MidP^.GetName);
       RightS:=Upper(RightP^.GetName);
       if copy(MidS,1,length(UpS))=UpS then
         begin
-          Idx:=Mid; FoundS:=UpS;
+          Idx:=Mid; FoundS:=copy(MidS,1,length(S));
         end;
 {      else}
         if UpS<MidS then
@@ -444,6 +504,21 @@ begin
   inherited Done;
 end;
 
+constructor TReference.Load(var S: TStream);
+begin
+  S.Read(Position, SizeOf(Position));
+
+  { --- items needing fixup --- }
+  S.Read(FileName, SizeOf(FileName)); { ->ModulesNames^.Item }
+end;
+
+procedure TReference.Store(var S: TStream);
+begin
+  S.Write(Position, SizeOf(Position));
+
+  { --- items needing fixup --- }
+  S.Write(FileName, SizeOf(FileName));
+end;
 
 {****************************************************************************
                                    TSymbol
@@ -466,6 +541,7 @@ procedure TSymbol.SetMemInfo(const AMemInfo: TSymbolMemInfo);
 begin
   if MemInfo=nil then New(MemInfo);
   Move(AMemInfo,MemInfo^,SizeOf(MemInfo^));
+  Flags:=Flags or sfHasMemInfo;
 end;
 
 function TSymbol.GetReferenceCount: Sw_integer;
@@ -586,6 +662,63 @@ begin
     DisposeStr(Ancestor);}
 end;
 
+constructor TSymbol.Load(var S: TStream);
+var MI: TSymbolMemInfo;
+    W: word;
+begin
+  TObject.Init;
+
+  S.Read(Typ,SizeOf(Typ));
+  S.Read(ObjectID, SizeOf(ObjectID));
+  S.Read(AncestorID, SizeOf(AncestorID));
+  S.Read(Flags, SizeOf(Flags));
+  Name:=S.ReadStr;
+  Params:=S.ReadStr;
+  if (Flags and sfHasMemInfo)<>0 then
+    begin
+      S.Read(MI,SizeOf(MI));
+      SetMemInfo(MI);
+    end;
+
+  W:=0;
+  S.Read(W,SizeOf(W));
+  if (W and 1)<>0 then
+    New(References, Load(S));
+  if (W and 2)<>0 then
+    New(Items, Load(S));
+
+  { --- items needing fixup --- }
+  S.Read(DType, SizeOf(DType));
+  S.Read(VType, SizeOf(VType));
+  S.Read(Ancestor, SizeOf(Ancestor));
+end;
+
+procedure TSymbol.Store(var S: TStream);
+var W: word;
+begin
+  S.Write(Typ,SizeOf(Typ));
+  S.Write(ObjectID, SizeOf(ObjectID));
+  S.Write(AncestorID, SizeOf(AncestorID));
+  S.Write(Flags, SizeOf(Flags));
+  S.WriteStr(Name);
+  S.WriteStr(Params);
+
+  if (Flags and sfHasMemInfo)<>0 then
+    S.Write(MemInfo^,SizeOf(MemInfo^));
+
+  W:=0;
+  if Assigned(References) then W:=W or 1;
+  if Assigned(Items) then W:=W or 2;
+  S.Write(W,SizeOf(W));
+  if Assigned(References) then References^.Store(S);
+  if Assigned(Items) then Items^.Store(S);
+
+  { --- items needing fixup --- }
+  S.Write(DType, SizeOf(DType));
+  S.Write(VType, SizeOf(VType));
+  S.Write(Ancestor, SizeOf(Ancestor));
+end;
+
 
 constructor TObjectSymbol.Init(AParent: PObjectSymbol; ASymbol: PSymbol);
 begin
@@ -635,6 +768,15 @@ begin
   inherited Done;
 end;
 
+constructor TObjectSymbol.Load(var S: TStream);
+begin
+end;
+
+procedure TObjectSymbol.Store(S: TStream);
+begin
+end;
+
+
 {*****************************************************************************
                               Main Routines
 *****************************************************************************}
@@ -990,12 +1132,6 @@ procedure CreateBrowserCol;
             begin
               with pprocsym(sym)^ do
               if assigned(definition) then
-               if assigned(definition^.nextoverloaded) then
-                begin
-                  { Several overloaded functions } 
-                  Symbol^.Params:=TypeNames^.Add('...');
-                end
-               else
               begin
                 if cs_local_browser in aktmoduleswitches then
                   ProcessSymTable(Symbol,Symbol^.Items,definition^.parast);
@@ -1067,15 +1203,7 @@ procedure CreateBrowserCol;
             Ref:=Ref^.nextref;
           end;
         if Assigned(Symbol) then
-          begin
-             If Not Owner^.Search(Symbol,i) then
-               Owner^.Insert(Symbol)
-             else
-               begin
-                 Comment(V_Warning,sym^.name+' already in SymbolCollection '+sym^.owner^.name^);
-                 dispose(Symbol,Done);
-               end;
-          end;
+          Owner^.Insert(Symbol);
         sym:=psym(sym^.next);
       end;
   end;
@@ -1249,8 +1377,205 @@ end;
 procedure DoneBrowserCol;
 begin
   { nothing, the collections are freed in the exitproc }
+  { nothing? then why do we've this routine? IMHO, either we should remove this,
+    or it should destroy the browser info when it's called. - Gabor }
+end;
+
+type
+     PPointerXRef = ^TPointerXRef;
+     TPointerXRef = record
+       PtrValue : pointer;
+       DataPtr  : pointer;
+     end;
+
+     PPointerDictionary = ^TPointerDictionary;
+     TPointerDictionary = object(TSortedCollection)
+       function  At(Index: sw_Integer): PPointerXRef;
+       function  Compare(Key1, Key2: Pointer): sw_Integer; virtual;
+       procedure FreeItem(Item: Pointer); virtual;
+       function  SearchXRef(PtrValue: pointer): PPointerXRef;
+       function  AddPtr(PtrValue, DataPtr: pointer): PPointerXRef;
+       procedure Resolve(var P);
+     end;
+
+function NewPointerXRef(APtrValue, ADataPtr: pointer): PPointerXRef;
+var P: PPointerXRef;
+begin
+  New(P); FillChar(P^,SizeOf(P^),0);
+  with P^ do begin PtrValue:=APtrValue; DataPtr:=ADataPtr; end;
+  NewPointerXRef:=P;
+end;
+
+procedure DisposePointerXRef(P: PPointerXRef);
+begin
+  if Assigned(P) then Dispose(P);
+end;
+
+function TPointerDictionary.At(Index: sw_Integer): PPointerXRef;
+begin
+  At:=inherited At(Index);
+end;
+
+function TPointerDictionary.Compare(Key1, Key2: Pointer): sw_Integer;
+var K1: PPointerXRef absolute Key1;
+    K2: PPointerXRef absolute Key2;
+    R: integer;
+begin
+  if longint(K1^.PtrValue)<longint(K2^.PtrValue) then R:=-1 else
+  if longint(K1^.PtrValue)>longint(K2^.PtrValue) then R:= 1 else
+  R:=0;
+  Compare:=R;
+end;
+
+procedure TPointerDictionary.FreeItem(Item: Pointer);
+begin
+  if Assigned(Item) then DisposePointerXRef(Item);
+end;
+
+function TPointerDictionary.SearchXRef(PtrValue: pointer): PPointerXRef;
+var P: PPointerXRef;
+    T: TPointerXRef;
+    Index: sw_integer;
+begin
+  T.PtrValue:=PtrValue;
+  if Search(@T,Index)=false then P:=nil else
+    P:=At(Index);
+  SearchXRef:=P;
+end;
+
+function TPointerDictionary.AddPtr(PtrValue, DataPtr: pointer): PPointerXRef;
+var P: PPointerXRef;
+begin
+  P:=NewPointerXRef(PtrValue,DataPtr);
+  Insert(P);
+  AddPtr:=P;
 end;
 
+procedure TPointerDictionary.Resolve(var P);
+var X: PPointerXRef;
+    V: pointer;
+begin
+  Move(P,V,SizeOf(V));
+  X:=SearchXRef(V);
+  if X=nil then V:=nil else
+    V:=X^.DataPtr;
+  Move(V,P,SizeOf(V));
+end;
+
+procedure ReadPointers(S: PStream; C: PCollection; D: PPointerDictionary);
+var W,I: sw_integer;
+    P: pointer;
+begin
+  S^.Read(W,SizeOf(W));
+  for I:=0 to W-1 do
+  begin
+    S^.Read(P,SizeOf(P));
+    D^.AddPtr(P,C^.At(I));
+  end;
+end;
+
+function LoadBrowserCol(S: PStream): boolean;
+var PD: PPointerDictionary;
+procedure FixupPointers;
+procedure FixupReference(P: PReference); {$ifndef FPC}far;{$endif}
+begin
+  PD^.Resolve(P^.FileName);
+end;
+procedure FixupSymbol(P: PSymbol); {$ifndef FPC}far;{$endif}
+var I: sw_integer;
+begin
+  PD^.Resolve(P^.DType);
+  PD^.Resolve(P^.VType);
+  PD^.Resolve(P^.Ancestor);
+  if Assigned(P^.References) then
+    with P^.References^ do
+     for I:=0 to Count-1 do
+       FixupReference(At(I));
+  if Assigned(P^.Items) then
+    with P^.Items^ do
+     for I:=0 to Count-1 do
+       FixupSymbol(At(I));
+end;
+begin
+  Modules^.ForEach(@FixupSymbol);
+end;
+procedure ReadSymbolPointers(P: PSymbol); {$ifndef FPC}far;{$endif}
+var I: sw_integer;
+    PV: pointer;
+begin
+  S^.Read(PV, SizeOf(PV));
+  PD^.AddPtr(PV,P);
+  if Assigned(P^.Items) then
+    with P^.Items^ do
+     for I:=0 to Count-1 do
+       ReadSymbolPointers(At(I));
+end;
+begin
+  DisposeBrowserCol;
+
+  New(ModuleNames, Load(S^));
+  New(TypeNames, Load(S^));
+  New(Modules, Load(S^));
+
+  New(PD, Init(4000,1000));
+  ReadPointers(S,ModuleNames,PD);
+  ReadPointers(S,TypeNames,PD);
+  ReadPointers(S,Modules,PD);
+  Modules^.ForEach(@ReadSymbolPointers);
+  FixupPointers;
+  Dispose(PD, Done);
+
+  BuildObjectInfo;
+end;
+
+procedure StorePointers(S: PStream; C: PCollection);
+var W,I: sw_integer;
+    P: pointer;
+begin
+  W:=C^.Count;
+  S^.Write(W,SizeOf(W));
+  for I:=0 to W-1 do
+  begin
+    P:=C^.At(I);
+    S^.Write(P,SizeOf(P));
+  end;
+end;
+
+procedure StoreBrowserCol(S: PStream);
+procedure WriteSymbolPointers(P: PSymbol); {$ifndef FPC}far;{$endif}
+var I: sw_integer;
+begin
+  S^.Write(P, SizeOf(P));
+  if Assigned(P^.Items) then
+    with P^.Items^ do
+     for I:=0 to Count-1 do
+       WriteSymbolPointers(At(I));
+end;
+var W: sw_integer;
+begin
+  ModuleNames^.Store(S^);
+  TypeNames^.Store(S^);
+  Modules^.Store(S^);
+
+  StorePointers(S,ModuleNames);
+  StorePointers(S,TypeNames);
+  StorePointers(S,Modules);
+  Modules^.ForEach(@WriteSymbolPointers);
+end;
+
+procedure RegisterSymbols;
+begin
+  RegisterType(RModuleNameCollection);
+  RegisterType(RTypeNameCollection);
+  RegisterType(RReference);
+  RegisterType(RSymbol);
+  RegisterType(RObjectSymbol);
+  RegisterType(RSymbolCollection);
+  RegisterType(RSortedSymbolCollection);
+  RegisterType(RIDSortedSymbolCollection);
+  RegisterType(RObjectSymbolCollection);
+  RegisterType(RReferenceCollection);
+end;
 
 begin
   oldexit:=exitproc;
@@ -1258,20 +1583,9 @@ begin
 end.
 {
   $Log$
-  Revision 1.19  1999-07-15 08:42:22  michael
-  + Removed TV stuff from brwosercol
-
-  Revision 1.18  1999/06/25 00:27:41  pierre
-   merged from fixes-0_99_12
-
-  Revision 1.16.2.1  1999/06/25 00:22:23  pierre
-    * avoid problem with lowercase symbols
-      (compare returns zero only if excat match,
-       ordering is first done case unsensitive
-       for a correct browser order)
-      this solves memory leaks :
-      TV and FV do not delete not inserted items in
-      a sorted collection without duplicates (is this a bug or a feature ?)
+  Revision 1.20  1999-08-03 22:02:29  peter
+    * moved bitmask constants to sets
+    * some other type/const renamings
 
   Revision 1.17  1999/06/22 16:24:39  pierre
    * local browser stuff corrected

+ 9 - 5
compiler/browlog.pas

@@ -346,9 +346,9 @@ implementation
                      if ptypesym(sym)^.definition^.deftype in [recorddef,objectdef] then
                        begin
                           if ptypesym(sym)^.definition^.deftype=recorddef then
-                            symt:=precdef(ptypesym(sym)^.definition)^.symtable
+                            symt:=precorddef(ptypesym(sym)^.definition)^.symtable
                           else
-                            symt:=pobjectdef(ptypesym(sym)^.definition)^.publicsyms;
+                            symt:=pobjectdef(ptypesym(sym)^.definition)^.symtable;
                           sym:=symt^.search(ss);
                           if sym=nil then
                             sym:=symt^.search(upper(ss));
@@ -359,9 +359,9 @@ implementation
                      if pvarsym(sym)^.definition^.deftype in [recorddef,objectdef] then
                        begin
                           if pvarsym(sym)^.definition^.deftype=recorddef then
-                            symt:=precdef(pvarsym(sym)^.definition)^.symtable
+                            symt:=precorddef(pvarsym(sym)^.definition)^.symtable
                           else
-                            symt:=pobjectdef(pvarsym(sym)^.definition)^.publicsyms;
+                            symt:=pobjectdef(pvarsym(sym)^.definition)^.symtable;
                           sym:=symt^.search(ss);
                           if sym=nil then
                             sym:=symt^.search(upper(ss));
@@ -448,7 +448,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.1  1999-01-12 14:25:24  peter
+  Revision 1.2  1999-08-03 22:02:30  peter
+    * moved bitmask constants to sets
+    * some other type/const renamings
+
+  Revision 1.1  1999/01/12 14:25:24  peter
     + BrowserLog for browser.log generation
     + BrowserCol for browser info in TCollections
     * released all other UseBrowser

+ 8 - 4
compiler/cg386add.pas

@@ -35,7 +35,7 @@ implementation
     uses
       globtype,systems,
       cobjects,verbose,globals,
-      symtable,aasm,types,
+      symconst,symtable,aasm,types,
       hcodegen,temp_gen,pass_2,
       i386base,i386asm,
       cgai386,tgeni386;
@@ -815,9 +815,9 @@ implementation
                  (p^.right^.resulttype^.deftype=pointerdef) or
 
                  ((p^.right^.resulttype^.deftype=objectdef) and
-                  pobjectdef(p^.right^.resulttype)^.isclass and
+                  pobjectdef(p^.right^.resulttype)^.is_class and
                  (p^.left^.resulttype^.deftype=objectdef) and
-                  pobjectdef(p^.left^.resulttype)^.isclass
+                  pobjectdef(p^.left^.resulttype)^.is_class
                  ) or
 
                  (p^.left^.resulttype^.deftype=classrefdef) or
@@ -2091,7 +2091,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.69  1999-07-05 20:13:06  peter
+  Revision 1.70  1999-08-03 22:02:31  peter
+    * moved bitmask constants to sets
+    * some other type/const renamings
+
+  Revision 1.69  1999/07/05 20:13:06  peter
     * removed temp defines
 
   Revision 1.68  1999/07/02 12:18:46  jonas

+ 78 - 64
compiler/cg386cal.pas

@@ -39,7 +39,7 @@ implementation
     uses
       globtype,systems,
       cobjects,verbose,globals,
-      aasm,types,
+      symconst,aasm,types,
 {$ifdef GDB}
       gdb,
 {$endif GDB}
@@ -244,7 +244,7 @@ implementation
 
          if not assigned(p^.procdefinition) then
           exit;
-         if (p^.procdefinition^.options and poinline)<>0 then
+         if (pocall_inline in p^.procdefinition^.proccalloptions) then
            begin
               inlined:=true;
               inlinecode:=p^.right;
@@ -265,20 +265,23 @@ implementation
               p^.right:=nil;
               { disable further inlining of the same proc
                 in the args }
-              p^.procdefinition^.options:=p^.procdefinition^.options and (not poinline);
+{$ifdef INCLUDEOK}
+              exclude(p^.procdefinition^.proccalloptions,pocall_inline);
+{$else}
+              p^.procdefinition^.proccalloptions:=p^.procdefinition^.proccalloptions-[pocall_inline];
+{$endif}
            end;
          { only if no proc var }
          if not(assigned(p^.right)) then
-           is_con_or_destructor:=((p^.procdefinition^.options and poconstructor)<>0)
-             or ((p^.procdefinition^.options and podestructor)<>0);
+           is_con_or_destructor:=(p^.procdefinition^.proctypeoption in [potype_constructor,potype_destructor]);
          { proc variables destroy all registers }
          if (p^.right=nil) and
             { virtual methods too }
-            ((p^.procdefinition^.options and povirtualmethod)=0) then
+            not(po_virtualmethod in p^.procdefinition^.procoptions) then
            begin
-              if ((p^.procdefinition^.options and poiocheck)<>0) and
-                 ((aktprocsym^.definition^.options and poiocheck)=0) and
-                 (cs_check_io in aktlocalswitches) then
+              if (cs_check_io in aktlocalswitches) and
+                 (po_iocheck in p^.procdefinition^.procoptions) and
+                 not(po_iocheck in aktprocsym^.definition^.procoptions) then
                 begin
                    getlabel(iolabel);
                    emitlab(iolabel);
@@ -361,12 +364,18 @@ implementation
                 para_offset:=0;
               if assigned(p^.right) then
                 secondcallparan(p^.left,pabstractprocdef(p^.right^.resulttype)^.para1,
-                  (p^.procdefinition^.options and poleftright)<>0,
-                  inlined,(p^.procdefinition^.options and (pocdecl or postdcall))<>0,para_offset)
+                  (pocall_leftright in p^.procdefinition^.proccalloptions),
+                  inlined,
+                  (pocall_cdecl in p^.procdefinition^.proccalloptions) or
+                   (pocall_stdcall in p^.procdefinition^.proccalloptions),
+                  para_offset)
               else
                 secondcallparan(p^.left,p^.procdefinition^.para1,
-                  (p^.procdefinition^.options and poleftright)<>0,
-                  inlined,(p^.procdefinition^.options and (pocdecl or postdcall))<>0,para_offset);
+                  (pocall_leftright in p^.procdefinition^.proccalloptions),
+                  inlined,
+                  (pocall_cdecl in p^.procdefinition^.proccalloptions) or
+                   (pocall_stdcall in p^.procdefinition^.proccalloptions),
+                  para_offset);
            end;
          params:=p^.left;
          p^.left:=nil;
@@ -420,7 +429,7 @@ implementation
                      end; }
                    r^:=ptree(pwithsymtable(p^.symtable)^.withnode)^.withreference^;
                    if (not pwithsymtable(p^.symtable)^.direct_with) or
-                      pobjectdef(p^.methodpointer^.resulttype)^.isclass then
+                      pobjectdef(p^.methodpointer^.resulttype)^.is_class then
                      exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,r,R_ESI)))
                    else
                      exprasmlist^.concat(new(pai386,op_ref_reg(A_LEA,S_L,r,R_ESI)));
@@ -447,7 +456,7 @@ implementation
                                typen:
                                  begin
                                     { direct call to inherited method }
-                                    if (p^.procdefinition^.options and poabstractmethod)<>0 then
+                                    if (po_abstractmethod in p^.procdefinition^.procoptions) then
                                       begin
                                          CGMessage(cg_e_cant_call_abstract_method);
                                          goto dont_call;
@@ -455,20 +464,20 @@ implementation
                                     { generate no virtual call }
                                     no_virtual_call:=true;
 
-                                    if (p^.symtableprocentry^.properties and sp_static)<>0 then
+                                    if (sp_static in p^.symtableprocentry^.symoptions) then
                                       begin
                                          { well lets put the VMT address directly into ESI }
                                          { it is kind of dirty but that is the simplest    }
                                          { way to accept virtual static functions (PM)     }
                                          loadesi:=true;
                                          { if no VMT just use $0 bug0214 PM }
-                                         if (pobjectdef(p^.methodpointer^.resulttype)^.options and oo_hasvmt)=0 then
+                                         if not(oo_has_vmt in pobjectdef(p^.methodpointer^.resulttype)^.objectoptions) then
                                            exprasmlist^.concat(new(pai386,op_const_reg(A_MOV,S_L,0,R_ESI)))
                                          else
                                            begin
                                              exprasmlist^.concat(new(pai386,op_sym_ofs_reg(A_MOV,S_L,
-                                               newasmsymbol(pobjectdef(
-                                               p^.methodpointer^.resulttype)^.vmt_mangledname),0,R_ESI)));
+                                               newasmsymbol(pobjectdef(p^.methodpointer^.resulttype)^.vmt_mangledname),
+                                               0,R_ESI)));
                                            end;
                                          { exprasmlist^.concat(new(pai386,op_reg(A_PUSH,S_L,R_ESI)));
                                            this is done below !! }
@@ -478,19 +487,18 @@ implementation
                                       loadesi:=false;
 
                                     { a class destructor needs a flag }
-                                    if pobjectdef(p^.methodpointer^.resulttype)^.isclass and
-                                        assigned(aktprocsym) and
-                                        ((aktprocsym^.definition^.options and
-                                        (podestructor))<>0) then
-                                        begin
-                                           push_int(0);
-                                           exprasmlist^.concat(new(pai386,op_reg(A_PUSH,S_L,R_ESI)));
-                                        end;
+                                    if pobjectdef(p^.methodpointer^.resulttype)^.is_class and
+                                       assigned(aktprocsym) and
+                                       (aktprocsym^.definition^.proctypeoption=potype_destructor) then
+                                      begin
+                                        push_int(0);
+                                        exprasmlist^.concat(new(pai386,op_reg(A_PUSH,S_L,R_ESI)));
+                                      end;
 
                                     if not(is_con_or_destructor and
-                                           pobjectdef(p^.methodpointer^.resulttype)^.isclass and
+                                           pobjectdef(p^.methodpointer^.resulttype)^.is_class and
                                            assigned(aktprocsym) and
-                                           ((aktprocsym^.definition^.options and (poconstructor or podestructor))<>0)
+                                           (aktprocsym^.definition^.proctypeoption in [potype_constructor,potype_destructor])
                                           ) then
                                       exprasmlist^.concat(new(pai386,op_reg(A_PUSH,S_L,R_ESI)));
                                     { if an inherited con- or destructor should be  }
@@ -498,20 +506,18 @@ implementation
                                     { will be made                                }
                                     { con- and destructors need a pointer to the vmt }
                                     if is_con_or_destructor and
-                                    not(pobjectdef(p^.methodpointer^.resulttype)^.isclass) and
+                                    not(pobjectdef(p^.methodpointer^.resulttype)^.is_class) and
                                     assigned(aktprocsym) then
                                       begin
-                                         if not ((aktprocsym^.definition^.options
-                                           and (poconstructor or podestructor))<>0) then
-
+                                         if not(aktprocsym^.definition^.proctypeoption in
+                                                [potype_constructor,potype_destructor]) then
                                           CGMessage(cg_w_member_cd_call_from_method);
                                       end;
                                     { class destructors get there flag below }
                                     if is_con_or_destructor and
-                                        not(pobjectdef(p^.methodpointer^.resulttype)^.isclass and
+                                        not(pobjectdef(p^.methodpointer^.resulttype)^.is_class and
                                         assigned(aktprocsym) and
-                                        ((aktprocsym^.definition^.options and
-                                        (podestructor))<>0)) then
+                                        (aktprocsym^.definition^.proctypeoption=potype_destructor)) then
                                       push_int(0);
                                  end;
                                hnewn:
@@ -555,7 +561,7 @@ implementation
                                               begin
                                                  if (p^.methodpointer^.resulttype^.deftype=classrefdef) or
                                                     ((p^.methodpointer^.resulttype^.deftype=objectdef) and
-                                                   pobjectdef(p^.methodpointer^.resulttype)^.isclass) then
+                                                   pobjectdef(p^.methodpointer^.resulttype)^.is_class) then
                                                    exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,
                                                      newreference(p^.methodpointer^.location.reference),R_ESI)))
                                                  else
@@ -567,10 +573,10 @@ implementation
                                       end;
                                     { when calling a class method, we have to load ESI with the VMT !
                                       But, not for a class method via self }
-                                    if ((p^.procdefinition^.options and pocontainsself)=0) then
+                                    if not(po_containsself in p^.procdefinition^.procoptions) then
                                       begin
-                                        if ((p^.procdefinition^.options and poclassmethod)<>0)
-                                           and not(p^.methodpointer^.resulttype^.deftype=classrefdef) then
+                                        if (po_classmethod in p^.procdefinition^.procoptions) and
+                                           not(p^.methodpointer^.resulttype^.deftype=classrefdef) then
                                           begin
                                              { class method needs current VMT }
                                              new(r);
@@ -581,15 +587,15 @@ implementation
                                           end;
 
                                         { direct call to destructor: don't remove data! }
-                                        if ((p^.procdefinition^.options and podestructor)<>0) and
-                                          (p^.methodpointer^.resulttype^.deftype=objectdef) and
-                                          (pobjectdef(p^.methodpointer^.resulttype)^.isclass) then
+                                        if (p^.procdefinition^.proctypeoption=potype_destructor) and
+                                           (p^.methodpointer^.resulttype^.deftype=objectdef) and
+                                           (pobjectdef(p^.methodpointer^.resulttype)^.is_class) then
                                           exprasmlist^.concat(new(pai386,op_const(A_PUSH,S_L,1)));
 
                                         { direct call to class constructor, don't allocate memory }
-                                        if ((p^.procdefinition^.options and poconstructor)<>0) and
-                                          (p^.methodpointer^.resulttype^.deftype=objectdef) and
-                                          (pobjectdef(p^.methodpointer^.resulttype)^.isclass) then
+                                        if (p^.procdefinition^.proctypeoption=potype_constructor) and
+                                           (p^.methodpointer^.resulttype^.deftype=objectdef) and
+                                           (pobjectdef(p^.methodpointer^.resulttype)^.is_class) then
                                           exprasmlist^.concat(new(pai386,op_const(A_PUSH,S_L,0)))
                                         else
                                           exprasmlist^.concat(new(pai386,op_reg(A_PUSH,S_L,R_ESI)));
@@ -599,9 +605,9 @@ implementation
                                       begin
                                          { classes don't get a VMT pointer pushed }
                                          if (p^.methodpointer^.resulttype^.deftype=objectdef) and
-                                           not(pobjectdef(p^.methodpointer^.resulttype)^.isclass) then
+                                           not(pobjectdef(p^.methodpointer^.resulttype)^.is_class) then
                                            begin
-                                              if ((p^.procdefinition^.options and poconstructor)<>0) then
+                                              if (p^.procdefinition^.proctypeoption=potype_constructor) then
                                                 begin
                                                    { it's no bad idea, to insert the VMT }
                                                    exprasmlist^.concat(new(pai386,op_sym(A_PUSH,S_L,newasmsymbol(
@@ -619,10 +625,10 @@ implementation
                      end
                    else
                      begin
-                        if ((p^.procdefinition^.options and poclassmethod)<>0) and
+                        if (po_classmethod in p^.procdefinition^.procoptions) and
                           not(
                             assigned(aktprocsym) and
-                            ((aktprocsym^.definition^.options and poclassmethod)<>0)
+                            (po_classmethod in aktprocsym^.definition^.procoptions)
                           ) then
                           begin
                              { class method needs current VMT }
@@ -701,7 +707,7 @@ implementation
                      internalerror(25000);
                 end;
 
-              if ((p^.procdefinition^.options and povirtualmethod)<>0) and
+              if (po_virtualmethod in p^.procdefinition^.procoptions) and
                  not(no_virtual_call) then
                 begin
                    { static functions contain the vmt_address in ESI }
@@ -710,14 +716,14 @@ implementation
                    { on the methodpointer                        PM }
                    if assigned(aktprocsym) then
                      begin
-                       if ((((aktprocsym^.properties and sp_static)<>0) or
-                        ((aktprocsym^.definition^.options and poclassmethod)<>0)) and
+                       if (((sp_static in aktprocsym^.symoptions) or
+                        (po_classmethod in aktprocsym^.definition^.procoptions)) and
                         ((p^.methodpointer=nil) or (p^.methodpointer^.treetype=typen)))
                         or
-                        ((p^.procdefinition^.options and postaticmethod)<>0) or
-                        ((p^.procdefinition^.options and poconstructor)<>0) or
+                        (po_staticmethod in p^.procdefinition^.procoptions) or
+                        (p^.procdefinition^.proctypeoption=potype_constructor) or
                         { ESI is loaded earlier }
-                        ((p^.procdefinition^.options and poclassmethod)<>0)then
+                        (po_classmethod in p^.procdefinition^.procoptions) then
                          begin
                             new(r);
                             reset_reference(r^);
@@ -751,7 +757,7 @@ implementation
                      end;
                    }
                    if pprocdef(p^.procdefinition)^.extnumber=-1 then
-                        internalerror($Da);
+                     internalerror(44584);
                    r^.offset:=pprocdef(p^.procdefinition)^.extnumber*4+12;
 {$ifndef TESTOBJEXT}
                    if (cs_check_range in aktlocalswitches) then
@@ -776,7 +782,11 @@ implementation
                 { inlined code is in inlinecode }
                 begin
                    { set poinline again }
-                   p^.procdefinition^.options:=p^.procdefinition^.options or poinline;
+{$ifdef INCLUDEOK}
+                   include(p^.procdefinition^.proccalloptions,pocall_inline);
+{$else}
+                   p^.procdefinition^.proccalloptions:=p^.procdefinition^.proccalloptions+[pocall_inline];
+{$endif}
                    { process the inlinecode }
                    secondpass(inlinecode);
                    { free the args }
@@ -788,7 +798,7 @@ implementation
            begin
               secondpass(p^.right);
               { method pointer ? }
-              if (p^.procdefinition^.options and pomethodpointer)<>0 then
+              if (po_methodpointer in p^.procdefinition^.procoptions) then
                 begin
                    { method pointer can't be in a register }
                    hregister:=R_NO;
@@ -806,7 +816,7 @@ implementation
                      end;
 
 
-                   if ((p^.procdefinition^.options and pocontainsself)=0) then
+                   if (po_containsself in p^.procdefinition^.procoptions) then
                      begin
                        { load ESI }
                        inc(p^.right^.location.reference.offset,4);
@@ -842,7 +852,7 @@ implementation
            { this was only for normal functions
              displaced here so we also get
              it to work for procvars PM }
-           if (not inlined) and ((p^.procdefinition^.options and poclearstack)<>0) then
+           if (not inlined) and (pocall_clearstack in p^.procdefinition^.proccalloptions) then
              begin
                 { consider the alignment with the rest (PM) }
                 inc(pushedparasize,pop_size);
@@ -883,7 +893,7 @@ implementation
            begin
               { a contructor could be a function with boolean result }
               if (p^.right=nil) and
-                 ((p^.procdefinition^.options and poconstructor)<>0) and
+                 (p^.procdefinition^.proctypeoption=potype_constructor) and
                  { quick'n'dirty check if it is a class or an object }
                  (p^.resulttype^.deftype=orddef) then
                 begin
@@ -1077,7 +1087,7 @@ implementation
                    { data which must be finalized ? }
                    if (p^.resulttype^.needs_inittable) and
                      ( (p^.resulttype^.deftype<>objectdef) or
-                       not(pobjectdef(p^.resulttype)^.isclass)) then
+                       not(pobjectdef(p^.resulttype)^.is_class)) then
                       finalize(p^.resulttype,p^.location.reference,ret_in_param(p^.resulttype));
                    { release unused temp }
                    ungetiftemp(p^.location.reference)
@@ -1166,7 +1176,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.94  1999-07-06 21:48:09  florian
+  Revision 1.95  1999-08-03 22:02:34  peter
+    * moved bitmask constants to sets
+    * some other type/const renamings
+
+  Revision 1.94  1999/07/06 21:48:09  florian
     * a lot bug fixes:
        - po_external isn't any longer necessary for procedure compatibility
        - m_tp_procvar is in -Sd now available

+ 10 - 6
compiler/cg386cnv.pas

@@ -42,7 +42,7 @@ implementation
 
    uses
       cobjects,verbose,globtype,globals,systems,
-      symtable,aasm,types,
+      symconst,symtable,aasm,types,
       hcodegen,temp_gen,pass_2,pass_1,
       i386base,i386asm,
       cgai386,tgeni386;
@@ -339,7 +339,7 @@ implementation
               begin
                  exprasmlist^.concat(new(pai386,op_reg_reg(A_XOR,S_L,
                    hregister2,hregister2)));
-                 if (porddef(pto^.resulttype)^.typ=s64bitint) and
+                 if (porddef(pto^.resulttype)^.typ=s64bit) and
                    is_signed(pfrom^.resulttype) then
                    begin
                       getlabel(l);
@@ -683,7 +683,7 @@ implementation
                  u16bit : exprasmlist^.concat(new(pai386,op_reg_reg(A_MOVZX,S_WL,pfrom^.location.register,R_EDI)));
                  u32bit,s32bit:
                    hregister:=pfrom^.location.register;
-                 u64bit,s64bitint:
+                 u64bit,s64bit:
                    begin
                       exprasmlist^.concat(new(pai386,op_reg(A_PUSH,S_L,pfrom^.location.registerhigh)));
                       hregister:=pfrom^.location.registerlow;
@@ -705,7 +705,7 @@ implementation
                    exprasmlist^.concat(new(pai386,op_ref_reg(A_MOVZX,S_WL,r,R_EDI)));
                  u32bit,s32bit:
                    exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,r,R_EDI)));
-                 u64bit,s64bitint:
+                 u64bit,s64bit:
                    begin
                       inc(r^.offset,4);
                       exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,r,R_EDI)));
@@ -726,7 +726,7 @@ implementation
                 exprasmlist^.concat(new(pai386,op_ref(A_FILD,S_IQ,r)));
                 exprasmlist^.concat(new(pai386,op_const_reg(A_ADD,S_L,8,R_ESP)));
              end;
-           s64bitint:
+           s64bit:
              begin
                 exprasmlist^.concat(new(pai386,op_ref(A_FILD,S_IQ,r)));
                 exprasmlist^.concat(new(pai386,op_const_reg(A_ADD,S_L,8,R_ESP)));
@@ -1463,7 +1463,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.80  1999-08-01 23:36:38  florian
+  Revision 1.81  1999-08-03 22:02:36  peter
+    * moved bitmask constants to sets
+    * some other type/const renamings
+
+  Revision 1.80  1999/08/01 23:36:38  florian
     * some changes to compile the new code generator
 
   Revision 1.79  1999/07/22 09:37:34  florian

+ 6 - 2
compiler/cg386con.pas

@@ -39,7 +39,7 @@ implementation
     uses
       globtype,systems,
       cobjects,verbose,globals,
-      symtable,aasm,types,
+      symconst,symtable,aasm,types,
       hcodegen,temp_gen,pass_2,
       i386base,i386asm,
       cgai386,tgeni386;
@@ -401,7 +401,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.37  1999-07-05 20:13:08  peter
+  Revision 1.38  1999-08-03 22:02:38  peter
+    * moved bitmask constants to sets
+    * some other type/const renamings
+
+  Revision 1.37  1999/07/05 20:13:08  peter
     * removed temp defines
 
   Revision 1.36  1999/05/27 19:44:10  peter

+ 7 - 3
compiler/cg386flw.pas

@@ -45,7 +45,7 @@ implementation
 
     uses
       cobjects,verbose,globals,systems,
-      symtable,aasm,types,
+      symconst,symtable,aasm,types,
       hcodegen,temp_gen,pass_2,
       i386base,i386asm,
       cgai386,tgeni386;
@@ -233,7 +233,7 @@ implementation
                  concatcopy(p^.right^.location.reference,temp1,hs,false,false);
            end
          else
-	   temptovalue:=false;
+           temptovalue:=false;
 
          { produce start assignment }
          cleartempgen;
@@ -772,7 +772,11 @@ do_jmp:
 end.
 {
   $Log$
-  Revision 1.43  1999-07-26 12:13:45  florian
+  Revision 1.44  1999-08-03 22:02:39  peter
+    * moved bitmask constants to sets
+    * some other type/const renamings
+
+  Revision 1.43  1999/07/26 12:13:45  florian
     * exit in try..finally blocks needed a second fix
     * a raise in a try..finally lead into a endless loop, fixed
 

+ 11 - 7
compiler/cg386inl.pas

@@ -34,7 +34,7 @@ implementation
     uses
       globtype,systems,
       cobjects,verbose,globals,files,
-      symtable,aasm,types,
+      symconst,symtable,aasm,types,
       hcodegen,temp_gen,pass_1,pass_2,
       i386base,i386asm,
       cgai386,tgeni386,cg386cal;
@@ -93,7 +93,7 @@ implementation
             floatstore(PFloatDef(dest^.resulttype)^.typ,dest^.location.reference);
           orddef:
             begin
-              if porddef(dest^.resulttype)^.typ in [u64bit,s64bitint] then
+              if porddef(dest^.resulttype)^.typ in [u64bit,s64bit] then
                 begin
                    emit_movq_reg_loc(R_EDX,R_EAX,dest^.location);
                 end
@@ -207,7 +207,7 @@ implementation
            dummycoll.register:=R_NO;
            { I/O check }
            if (cs_check_io in aktlocalswitches) and
-              ((aktprocsym^.definition^.options and poiocheck)=0) then
+              not(po_iocheck in aktprocsym^.definition^.procoptions) then
              begin
                 getlabel(iolabel);
                 emitlab(iolabel);
@@ -426,7 +426,7 @@ implementation
                                     emitcall(rdwrprefix[doread]+'UINT');
                                   uchar :
                                     emitcall(rdwrprefix[doread]+'CHAR');
-                                  s64bitint:
+                                  s64bit :
                                     emitcall(rdwrprefix[doread]+'INT64');
                                   u64bit :
                                     emitcall(rdwrprefix[doread]+'QWORD');
@@ -609,7 +609,7 @@ implementation
                 u64bit:
                   emitcall(procedureprefix+'QWORD');
 
-                s64bitint:
+                s64bit:
                   emitcall(procedureprefix+'INT64');
 
                 else
@@ -784,7 +784,7 @@ implementation
                  u32bit,s32bit:
                    exprasmlist^.concat(new(pai386,op_reg_ref(A_MOV, S_L,
                      hreg,newreference(hr2))));
-                 u64bit,s64bitint:
+                 u64bit,s64bit:
                    begin
                       exprasmlist^.concat(new(pai386,op_reg_ref(A_MOV, S_L,
                         hreg,newreference(hr2))));
@@ -1313,7 +1313,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.63  1999-07-23 16:05:18  peter
+  Revision 1.64  1999-08-03 22:02:42  peter
+    * moved bitmask constants to sets
+    * some other type/const renamings
+
+  Revision 1.63  1999/07/23 16:05:18  peter
     * alignment is now saved in the symtable
     * C alignment added for records
     * PPU version increased to solve .12 <-> .13 probs

+ 13 - 9
compiler/cg386ld.pas

@@ -37,7 +37,7 @@ implementation
     uses
       globtype,systems,
       cobjects,verbose,globals,
-      symtable,aasm,types,
+      symconst,symtable,aasm,types,
       hcodegen,temp_gen,pass_2,
       i386base,i386asm,
       cgai386,tgeni386,cg386cnv,cresstr;
@@ -102,12 +102,12 @@ implementation
                  begin
                     hregister:=R_NO;
                     { C variable }
-                    if (pvarsym(p^.symtableentry)^.var_options and vo_is_C_var)<>0 then
+                    if (vo_is_C_var in pvarsym(p^.symtableentry)^.varoptions) then
                       begin
                          p^.location.reference.symbol:=newasmsymbol(p^.symtableentry^.mangledname);
                       end
                     { DLL variable }
-                    else if (pvarsym(p^.symtableentry)^.var_options and vo_is_dll_var)<>0 then
+                    else if (vo_is_dll_var in pvarsym(p^.symtableentry)^.varoptions) then
                       begin
                          hregister:=getregister32;
                          p^.location.reference.symbol:=newasmsymbol(p^.symtableentry^.mangledname);
@@ -116,12 +116,12 @@ implementation
                          p^.location.reference.base:=hregister;
                       end
                     { external variable }
-                    else if (pvarsym(p^.symtableentry)^.var_options and vo_is_external)<>0 then
+                    else if (vo_is_external in pvarsym(p^.symtableentry)^.varoptions) then
                       begin
                          p^.location.reference.symbol:=newasmsymbol(p^.symtableentry^.mangledname);
                       end
                     { thread variable }
-                    else if (pvarsym(p^.symtableentry)^.var_options and vo_is_thread_var)<>0 then
+                    else if (vo_is_thread_var in pvarsym(p^.symtableentry)^.varoptions) then
                       begin
                          popeax:=not(R_EAX in unused);
                          if popeax then
@@ -196,7 +196,7 @@ implementation
                                      end;
                                    objectsymtable:
                                      begin
-                                        if (pvarsym(p^.symtableentry)^.properties and sp_static)<>0 then
+                                        if (sp_static in pvarsym(p^.symtableentry)^.symoptions) then
                                           begin
                                              p^.location.reference.symbol:=newasmsymbol(p^.symtableentry^.mangledname);
                                           end
@@ -301,7 +301,7 @@ implementation
                            hregister,hp)));
 
                          { virtual method ? }
-                         if (pprocsym(p^.symtableentry)^.definition^.options and povirtualmethod)<>0 then
+                         if (po_virtualmethod in pprocsym(p^.symtableentry)^.definition^.procoptions) then
                            begin
                               new(hp);
                               reset_reference(hp^);
@@ -530,7 +530,7 @@ implementation
                            begin
                               if (p^.right^.resulttype^.needs_inittable) and
                                 ( (p^.right^.resulttype^.deftype<>objectdef) or
-                                  not(pobjectdef(p^.right^.resulttype)^.isclass)) then
+                                  not(pobjectdef(p^.right^.resulttype)^.is_class)) then
                                 begin
                                    { this would be a problem }
                                    if not(p^.left^.resulttype^.needs_inittable) then
@@ -875,7 +875,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.67  1999-07-27 23:36:36  peter
+  Revision 1.68  1999-08-03 22:02:43  peter
+    * moved bitmask constants to sets
+    * some other type/const renamings
+
+  Revision 1.67  1999/07/27 23:36:36  peter
     * try to determine the fpu type needed in assignment
 
   Revision 1.66  1999/07/24 15:12:56  michael

+ 6 - 2
compiler/cg386mat.pas

@@ -37,7 +37,7 @@ implementation
     uses
       globtype,systems,
       cobjects,verbose,globals,
-      symtable,aasm,types,
+      symconst,symtable,aasm,types,
       hcodegen,temp_gen,pass_2,
       i386base,i386asm,
 {$ifdef dummy}
@@ -930,7 +930,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.27  1999-06-28 22:29:14  florian
+  Revision 1.28  1999-08-03 22:02:45  peter
+    * moved bitmask constants to sets
+    * some other type/const renamings
+
+  Revision 1.27  1999/06/28 22:29:14  florian
     * qword division fixed
     + code for qword/int64 type casting added:
       range checking isn't implemented yet

+ 9 - 5
compiler/cg386mem.pas

@@ -45,7 +45,7 @@ implementation
     uses
       globtype,systems,
       cobjects,verbose,globals,
-      symtable,aasm,types,
+      symconst,symtable,aasm,types,
       hcodegen,temp_gen,pass_2,pass_1,
       i386base,i386asm,
       cgai386,tgeni386;
@@ -332,7 +332,7 @@ implementation
            exit;
          { classes must be dereferenced implicit }
          if (p^.left^.resulttype^.deftype=objectdef) and
-           pobjectdef(p^.left^.resulttype)^.isclass then
+           pobjectdef(p^.left^.resulttype)^.is_class then
            begin
              reset_reference(p^.location.reference);
              case p^.left^.location.loc of
@@ -775,7 +775,7 @@ implementation
          reset_reference(p^.location.reference);
          if (p^.resulttype^.deftype=classrefdef) or
            ((p^.resulttype^.deftype=objectdef)
-             and pobjectdef(p^.resulttype)^.isclass
+             and pobjectdef(p^.resulttype)^.is_class
            ) then
            p^.location.register:=R_ESI
          else
@@ -809,7 +809,7 @@ implementation
                  end
                else
                 if (p^.left^.resulttype^.deftype=objectdef) and
-                   pobjectdef(p^.left^.resulttype)^.isclass then
+                   pobjectdef(p^.left^.resulttype)^.is_class then
                  begin
                     exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,
                       newreference(p^.left^.location.reference),R_EDI)));
@@ -849,7 +849,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.47  1999-06-02 10:11:45  florian
+  Revision 1.48  1999-08-03 22:02:47  peter
+    * moved bitmask constants to sets
+    * some other type/const renamings
+
+  Revision 1.47  1999/06/02 10:11:45  florian
     * make cycle fixed i.e. compilation with 0.99.10
     * some fixes for qword
     * start of register calling conventions

+ 7 - 3
compiler/cg386set.pas

@@ -36,7 +36,7 @@ implementation
     uses
       globtype,systems,
       cobjects,verbose,globals,
-      symtable,aasm,types,
+      symconst,symtable,aasm,types,
       hcodegen,temp_gen,pass_2,
       i386base,i386asm,
       cgai386,tgeni386;
@@ -411,7 +411,7 @@ implementation
                   p^.location.resflags:=F_C;
                   getlabel(l);
                   getlabel(l2);
-                  
+
                   { Is this treated in firstpass ?? }
                   if p^.left^.treetype=ordconstn then
                     begin
@@ -918,7 +918,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.35  1999-07-18 14:01:16  florian
+  Revision 1.36  1999-08-03 22:02:48  peter
+    * moved bitmask constants to sets
+    * some other type/const renamings
+
+  Revision 1.35  1999/07/18 14:01:16  florian
     * handling of integer and shortint in case was wrong, if a case
       label was negative and a jump table was generated
 

+ 33 - 29
compiler/cgai386.pas

@@ -30,7 +30,7 @@ unit cgai386;
 {$ifdef dummy}
        end { to get correct syntax highlighting }
 {$endif dummy}
-       aasm,symtable,win_targ;
+       symconst,symtable,aasm,win_targ;
 
 {$define TESTGETTEMP to store const that
  are written into temps for later release PM }
@@ -1401,7 +1401,7 @@ procedure mov_reg_to_dest(p : ptree; s : topsize; reg : tregister);
                                is_open_array(p^.resulttype)))
                             ) or
                             ((p^.resulttype^.deftype=objectdef) and
-                             pobjectdef(p^.resulttype)^.isclass) then
+                             pobjectdef(p^.resulttype)^.is_class) then
                            begin
                               inc(pushedparasize,4);
                               if inlined then
@@ -2132,7 +2132,7 @@ procedure mov_reg_to_dest(p : ptree; s : topsize; reg : tregister);
     var
       pl : pasmlabel;
     begin
-      if (aktprocsym^.definition^.options and poassembler)<>0 then
+      if (po_assembler in aktprocsym^.definition^.procoptions) then
        exit;
       case target_info.target of
          target_i386_linux:
@@ -2203,7 +2203,7 @@ procedure mov_reg_to_dest(p : ptree; s : topsize; reg : tregister);
 
     begin
        if (psym(p)^.typ=varsym) and
-         ((pvarsym(p)^.var_options and vo_is_thread_var)<>0) then
+          (vo_is_thread_var in pvarsym(p)^.varoptions) then
          begin
             exprasmlist^.concat(new(pai386,op_const(A_PUSH,S_L,pvarsym(p)^.getsize)));
             reset_reference(hr);
@@ -2283,7 +2283,7 @@ procedure mov_reg_to_dest(p : ptree; s : topsize; reg : tregister);
        if (psym(p)^.typ=varsym) and
           assigned(pvarsym(p)^.definition) and
           not((pvarsym(p)^.definition^.deftype=objectdef) and
-            pobjectdef(pvarsym(p)^.definition)^.isclass) and
+            pobjectdef(pvarsym(p)^.definition)^.is_class) and
           pvarsym(p)^.definition^.needs_inittable then
          begin
             procinfo.flags:=procinfo.flags or pi_needs_implicit_finally;
@@ -2310,7 +2310,7 @@ procedure mov_reg_to_dest(p : ptree; s : topsize; reg : tregister);
     begin
        if (psym(p)^.typ=varsym) and
           not((pvarsym(p)^.definition^.deftype=objectdef) and
-            pobjectdef(pvarsym(p)^.definition)^.isclass) and
+            pobjectdef(pvarsym(p)^.definition)^.is_class) and
           pvarsym(p)^.definition^.needs_inittable and
           ((pvarsym(p)^.varspez=vs_value) {or
            (pvarsym(p)^.varspez=vs_const) and
@@ -2342,7 +2342,7 @@ procedure mov_reg_to_dest(p : ptree; s : topsize; reg : tregister);
        if (psym(p)^.typ=varsym) and
           assigned(pvarsym(p)^.definition) and
           not((pvarsym(p)^.definition^.deftype=objectdef) and
-          pobjectdef(pvarsym(p)^.definition)^.isclass) and
+          pobjectdef(pvarsym(p)^.definition)^.is_class) and
           pvarsym(p)^.definition^.needs_inittable then
          begin
             { not all kind of parameters need to be finalized  }
@@ -2603,7 +2603,7 @@ procedure mov_reg_to_dest(p : ptree; s : topsize; reg : tregister);
     begin
        oldexprasmlist:=exprasmlist;
        exprasmlist:=alist;
-       if (not inlined) and ((aktprocsym^.definition^.options and poproginit)<>0) then
+       if (not inlined) and (aktprocsym^.definition^.proctypeoption=potype_proginit) then
            begin
               exprasmlist^.insert(new(pai386,
                 op_sym(A_CALL,S_NO,newasmsymbol('FPC_INITIALIZEUNITS'))));
@@ -2634,9 +2634,9 @@ procedure mov_reg_to_dest(p : ptree; s : topsize; reg : tregister);
            end;
 
       { a constructor needs a help procedure }
-      if (aktprocsym^.definition^.options and poconstructor)<>0 then
+      if (aktprocsym^.definition^.proctypeoption=potype_constructor) then
         begin
-          if procinfo._class^.isclass then
+          if procinfo._class^.is_class then
             begin
               exprasmlist^.insert(new(pai386,op_cond_sym(A_Jcc,C_Z,S_NO,quickexitlabel)));
               exprasmlist^.insert(new(pai386,op_sym(A_CALL,S_NO,newasmsymbol('FPC_NEW_CLASS'))));
@@ -2653,7 +2653,7 @@ procedure mov_reg_to_dest(p : ptree; s : topsize; reg : tregister);
 
       { When message method contains self as a parameter,
         we must load it into ESI }
-      If ((aktprocsym^.definition^.options and pocontainsself)<>0) then
+      If (po_containsself in aktprocsym^.definition^.procoptions) then
         begin
            new(hr);
            reset_reference(hr^);
@@ -2661,8 +2661,8 @@ procedure mov_reg_to_dest(p : ptree; s : topsize; reg : tregister);
            hr^.base:=procinfo.framepointer;
            exprasmlist^.insert(new(pai386,op_ref_reg(A_MOV,S_L,hr,R_ESI)));
         end;
-      { should we save edi ? }
-      if ((aktprocsym^.definition^.options and posavestdregs)<>0) then
+      { should we save edi,esi,ebx like C ? }
+      if (po_savestdregs in aktprocsym^.definition^.procoptions) then
        begin
          if (aktprocsym^.definition^.usedregisters and ($80 shr byte(R_EBX)))<>0 then
            exprasmlist^.insert(new(pai386,op_reg(A_PUSH,S_L,R_EBX)));
@@ -2677,14 +2677,14 @@ procedure mov_reg_to_dest(p : ptree; s : topsize; reg : tregister);
           begin
               CGMessage(cg_d_stackframe_omited);
               nostackframe:=true;
-              if (aktprocsym^.definition^.options and (pounitinit or poproginit or pounitfinalize)<>0) then
+              if (aktprocsym^.definition^.proctypeoption in [potype_unitinit,potype_proginit,potype_unitfinalize]) then
                 parasize:=0
               else
                 parasize:=aktprocsym^.definition^.parast^.datasize+procinfo.call_offset-4;
           end
       else
           begin
-              if (aktprocsym^.definition^.options and (pounitinit or poproginit or pounitfinalize)<>0) then
+              if (aktprocsym^.definition^.proctypeoption in [potype_unitinit,potype_proginit,potype_unitfinalize]) then
                 parasize:=0
               else
                 parasize:=aktprocsym^.definition^.parast^.datasize+procinfo.call_offset-8;
@@ -2771,14 +2771,14 @@ procedure mov_reg_to_dest(p : ptree; s : topsize; reg : tregister);
                  end;
           end;
 
-      if (aktprocsym^.definition^.options and pointerrupt)<>0 then
+      if (po_interrupt in aktprocsym^.definition^.procoptions) then
           generate_interrupt_stackframe_entry;
 
       { initialize return value }
       if (procinfo.retdef<>pdef(voiddef)) and
         (procinfo.retdef^.needs_inittable) and
         ((procinfo.retdef^.deftype<>objectdef) or
-        not(pobjectdef(procinfo.retdef)^.isclass)) then
+        not(pobjectdef(procinfo.retdef)^.is_class)) then
         begin
            procinfo.flags:=procinfo.flags or pi_needs_implicit_finally;
            reset_reference(r);
@@ -2788,7 +2788,7 @@ procedure mov_reg_to_dest(p : ptree; s : topsize; reg : tregister);
         end;
 
       { generate copies of call by value parameters }
-      if (aktprocsym^.definition^.options and poassembler=0) then
+      if not(po_assembler in aktprocsym^.definition^.procoptions) then
         aktprocsym^.definition^.parast^.foreach({$ifndef TP}@{$endif}copyvalueparas);
 
       { initialisizes local data }
@@ -2947,9 +2947,9 @@ procedure mov_reg_to_dest(p : ptree; s : topsize; reg : tregister);
         exprasmlist^.insert(new(pai_label,init(aktexitlabel)));
 
       { call the destructor help procedure }
-      if (aktprocsym^.definition^.options and podestructor)<>0 then
+      if (aktprocsym^.definition^.proctypeoption=potype_destructor) then
         begin
-          if procinfo._class^.isclass then
+          if procinfo._class^.is_class then
             begin
               exprasmlist^.insert(new(pai386,op_sym(A_CALL,S_NO,
                 newasmsymbol('FPC_DISPOSE_CLASS'))));
@@ -2987,7 +2987,7 @@ procedure mov_reg_to_dest(p : ptree; s : topsize; reg : tregister);
            if (procinfo.retdef<>pdef(voiddef)) and
              (procinfo.retdef^.needs_inittable) and
              ((procinfo.retdef^.deftype<>objectdef) or
-             not(pobjectdef(procinfo.retdef)^.isclass)) then
+             not(pobjectdef(procinfo.retdef)^.is_class)) then
              begin
                 reset_reference(hr);
                 hr.offset:=procinfo.retoffset;
@@ -3001,14 +3001,14 @@ procedure mov_reg_to_dest(p : ptree; s : topsize; reg : tregister);
         end;
 
       { call __EXIT for main program }
-      if (not DLLsource) and (not inlined) and ((aktprocsym^.definition^.options and poproginit)<>0) then
+      if (not DLLsource) and (not inlined) and (aktprocsym^.definition^.proctypeoption=potype_proginit) then
        begin
          exprasmlist^.concat(new(pai386,op_sym(A_CALL,S_NO,newasmsymbol('FPC_DO_EXIT'))));
        end;
 
       { handle return value }
-      if (aktprocsym^.definition^.options and poassembler)=0 then
-          if (aktprocsym^.definition^.options and poconstructor)=0 then
+      if not(po_assembler in aktprocsym^.definition^.procoptions) then
+          if (aktprocsym^.definition^.proctypeoption<>potype_constructor) then
             handle_return_value(inlined)
           else
               begin
@@ -3029,7 +3029,7 @@ procedure mov_reg_to_dest(p : ptree; s : topsize; reg : tregister);
 
       { should we restore edi ? }
       { for all i386 gcc implementations }
-      if ((aktprocsym^.definition^.options and posavestdregs)<>0) then
+      if (po_savestdregs in aktprocsym^.definition^.procoptions) then
         begin
           if (aktprocsym^.definition^.usedregisters and ($80 shr byte(R_EBX)))<>0 then
            exprasmlist^.concat(new(pai386,op_reg(A_POP,S_L,R_EBX)));
@@ -3048,19 +3048,19 @@ procedure mov_reg_to_dest(p : ptree; s : topsize; reg : tregister);
           exprasmlist^.concat(new(pai386,op_none(A_LEAVE,S_NO)));
       { parameters are limited to 65535 bytes because }
       { ret allows only imm16                    }
-      if (parasize>65535) and not(aktprocsym^.definition^.options and poclearstack<>0) then
+      if (parasize>65535) and not(pocall_clearstack in aktprocsym^.definition^.proccalloptions) then
        CGMessage(cg_e_parasize_too_big);
 
       { at last, the return is generated }
 
       if not inlined then
-      if (aktprocsym^.definition^.options and pointerrupt)<>0 then
+      if (po_interrupt in aktprocsym^.definition^.procoptions) then
           generate_interrupt_stackframe_exit
       else
        begin
        {Routines with the poclearstack flag set use only a ret.}
        { also routines with parasize=0     }
-         if (parasize=0) or (aktprocsym^.definition^.options and poclearstack<>0) then
+         if (parasize=0) or (pocall_clearstack in aktprocsym^.definition^.proccalloptions) then
           exprasmlist^.concat(new(pai386,op_none(A_RET,S_NO)))
          else
           exprasmlist^.concat(new(pai386,op_const(A_RET,S_NO,parasize)));
@@ -3140,7 +3140,11 @@ procedure mov_reg_to_dest(p : ptree; s : topsize; reg : tregister);
 end.
 {
   $Log$
-  Revision 1.22  1999-08-01 23:36:39  florian
+  Revision 1.23  1999-08-03 22:02:49  peter
+    * moved bitmask constants to sets
+    * some other type/const renamings
+
+  Revision 1.22  1999/08/01 23:36:39  florian
     * some changes to compile the new code generator
 
   Revision 1.21  1999/08/01 17:32:31  florian

+ 40 - 31
compiler/hcgdata.pas

@@ -40,7 +40,7 @@ implementation
     uses
        strings,cobjects,
        globtype,globals,verbose,
-       types,
+       symconst,types,
        hcodegen;
 
 
@@ -105,7 +105,7 @@ implementation
               hp:=pprocsym(p)^.definition;
               while assigned(hp) do
                 begin
-                   if (hp^.options and pomsgstr)<>0 then
+                   if (po_msgstr in hp^.procoptions) then
                      begin
                         new(pt);
                         pt^.p:=hp;
@@ -149,7 +149,7 @@ implementation
               hp:=pprocsym(p)^.definition;
               while assigned(hp) do
                 begin
-                   if (hp^.options and pomsgint)<>0 then
+                   if (po_msgint in hp^.procoptions) then
                      begin
                         new(pt);
                         pt^.p:=hp;
@@ -199,7 +199,7 @@ implementation
          root:=nil;
          count:=0;
          { insert all message handlers into a tree, sorted by name }
-         _class^.publicsyms^.foreach({$ifndef TP}@{$endif}insertmsgstr);
+         _class^.symtable^.foreach({$ifndef TP}@{$endif}insertmsgstr);
 
          { write all names }
          if assigned(root) then
@@ -241,7 +241,7 @@ implementation
          root:=nil;
          count:=0;
          { insert all message handlers into a tree, sorted by name }
-         _class^.publicsyms^.foreach({$ifndef TP}@{$endif}insertmsgint);
+         _class^.symtable^.foreach({$ifndef TP}@{$endif}insertmsgint);
 
          { now start writing of the message string table }
          getdatalabel(r);
@@ -312,7 +312,7 @@ implementation
                 symcoll^.data:=procdefcoll;
 
                 { if it's a virtual method }
-                if (hp^.options and povirtualmethod)<>0 then
+                if (po_virtualmethod in hp^.procoptions) then
                   begin
                      { then it gets a number ... }
                      hp^.extnumber:=nextvirtnumber;
@@ -321,11 +321,11 @@ implementation
                      has_virtual_method:=true;
                   end;
 
-                if (hp^.options and poconstructor)<>0 then
+                if (hp^.proctypeoption=potype_constructor) then
                   has_constructor:=true;
 
                 { check, if a method should be overridden }
-                if (hp^.options and pooverridingmethod)<>0 then
+                if (po_overridingmethod in hp^.procoptions) then
                   Message1(parser_e_nothing_to_be_overridden,_c^.objname^+'.'+_name);
                 { next overloaded method }
                 hp:=hp^.nextoverloaded;
@@ -355,18 +355,18 @@ implementation
                                   { compare parameters }
                                   if equal_paras(procdefcoll^.data^.para1,hp^.para1,false) and
                                      (
-                                       ((procdefcoll^.data^.options and povirtualmethod)<>0) or
-                                       ((hp^.options and povirtualmethod)<>0)
+                                       (po_virtualmethod in procdefcoll^.data^.procoptions) or
+                                       (po_virtualmethod in hp^.procoptions)
                                      ) then
                                     begin { same parameters }
                                        { wenn sie gleich sind }
                                        { und eine davon virtual deklariert ist }
                                        { Fehler falls nur eine VIRTUAL }
-                                       if (procdefcoll^.data^.options and povirtualmethod)<>
-                                          (hp^.options and povirtualmethod) then
+                                       if (po_virtualmethod in procdefcoll^.data^.procoptions)<>
+                                          (po_virtualmethod in hp^.procoptions) then
                                          begin
                                             { in classes, we hide the old method }
-                                            if _c^.isclass then
+                                            if _c^.is_class then
                                               begin
                                                  { warn only if it is the first time,
                                                    we hide the method }
@@ -378,7 +378,7 @@ implementation
                                             else
                                               if _c=hp^._class then
                                                 begin
-                                                   if (procdefcoll^.data^.options and povirtualmethod)<>0 then
+                                                   if (po_virtualmethod in procdefcoll^.data^.procoptions) then
                                                      Message1(parser_w_overloaded_are_not_both_virtual,_c^.objname^+'.'+_name)
                                                    else
                                                      Message1(parser_w_overloaded_are_not_both_non_virtual,
@@ -391,16 +391,18 @@ implementation
                                        { the flags have to match      }
                                        { except abstract and override }
                                        { only if both are virtual !!  }
-                                       if (procdefcoll^.data^.options and not(poabstractmethod or pooverridingmethod))<>
-                                         (hp^.options and not(poabstractmethod or pooverridingmethod)) then
-                                            Message1(parser_e_header_dont_match_forward,_c^.objname^+'.'+_name);
+                                       if (procdefcoll^.data^.proccalloptions<>hp^.proccalloptions) or
+                                          (procdefcoll^.data^.proctypeoption<>hp^.proctypeoption) or
+                                          ((procdefcoll^.data^.procoptions-[po_abstractmethod,po_overridingmethod])<>
+                                           (hp^.procoptions-[po_abstractmethod,po_overridingmethod])) then
+                                         Message1(parser_e_header_dont_match_forward,_c^.objname^+'.'+_name);
 
                                        { check, if the overridden directive is set }
                                        { (povirtualmethod is set! }
 
                                        { class ? }
-                                       if _c^.isclass and
-                                         ((hp^.options and pooverridingmethod)=0) then
+                                       if _c^.is_class and
+                                          not(po_overridingmethod in hp^.procoptions) then
                                          begin
                                             { warn only if it is the first time,
                                               we hide the method }
@@ -414,9 +416,9 @@ implementation
                                        if not(is_equal(procdefcoll^.data^.retdef,hp^.retdef)) and
                                          not((procdefcoll^.data^.retdef^.deftype=objectdef) and
                                            (hp^.retdef^.deftype=objectdef) and
-                                           (pobjectdef(procdefcoll^.data^.retdef)^.isclass) and
-                                           (pobjectdef(hp^.retdef)^.isclass) and
-                                           (pobjectdef(hp^.retdef)^.isrelated(pobjectdef(procdefcoll^.data^.retdef)))) then
+                                           (pobjectdef(procdefcoll^.data^.retdef)^.is_class) and
+                                           (pobjectdef(hp^.retdef)^.is_class) and
+                                           (pobjectdef(hp^.retdef)^.is_related(pobjectdef(procdefcoll^.data^.retdef)))) then
                                          Message1(parser_e_overloaded_methodes_not_same_ret,_c^.objname^+'.'+_name);
 
 
@@ -437,14 +439,14 @@ implementation
                                   procdefcoll^.next:=symcoll^.data;
                                   symcoll^.data:=procdefcoll;
                                   { if the method is virtual ... }
-                                  if (hp^.options and povirtualmethod)<>0 then
+                                  if (po_virtualmethod in hp^.procoptions) then
                                     begin
                                        { ... it will get a number }
                                        hp^.extnumber:=nextvirtnumber;
                                        inc(nextvirtnumber);
                                     end;
                                   { check, if a method should be overridden }
-                                  if (hp^.options and pooverridingmethod)<>0 then
+                                  if (po_overridingmethod in hp^.procoptions) then
                                    Message1(parser_e_nothing_to_be_overridden,_c^.objname^+'.'+_name);
                                end;
                              hp:=hp^.nextoverloaded;
@@ -471,7 +473,7 @@ implementation
            {_c:=_class;}
            _c:=p;
            { Florian, please check if you agree (PM) }
-           p^.publicsyms^.foreach({$ifndef TP}@{$endif}eachsym);
+           p^.symtable^.foreach({$ifndef TP}@{$endif}eachsym);
         end;
 
       var
@@ -513,16 +515,19 @@ implementation
                         { but only this which are declared as virtual }
                         if procdefcoll^.data^.extnumber=i then
                           begin
-                             if (procdefcoll^.data^.options and povirtualmethod)<>0 then
+                             if (po_virtualmethod in procdefcoll^.data^.procoptions) then
                                begin
                                   { if a method is abstract, then is also the }
                                   { class abstract and it's not allow to      }
                                   { generates an instance                     }
-                                  if (procdefcoll^.data^.options and poabstractmethod)<>0 then
+                                  if (po_abstractmethod in procdefcoll^.data^.procoptions) then
                                     begin
-                                       _class^.options:=_class^.options or oo_is_abstract;
-                                       datasegment^.concat(new(pai_const_symbol,
-                                         initname('FPC_ABSTRACTERROR')));
+{$ifdef INCLUDEOK}
+                                       include(_class^.objectoptions,oo_has_abstract);
+{$else}
+                                       _class^.objectoptions:=_class^.objectoptions+[oo_has_abstract];
+{$endif}
+                                       datasegment^.concat(new(pai_const_symbol,initname('FPC_ABSTRACTERROR')));
                                     end
                                   else
                                     begin
@@ -558,7 +563,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.13  1999-07-11 20:10:23  peter
+  Revision 1.14  1999-08-03 22:02:52  peter
+    * moved bitmask constants to sets
+    * some other type/const renamings
+
+  Revision 1.13  1999/07/11 20:10:23  peter
     * merged
 
   Revision 1.12  1999/07/08 10:40:37  peter

+ 21 - 12
compiler/htypechk.pas

@@ -58,6 +58,7 @@ implementation
     uses
        globtype,systems,tokens,
        cobjects,verbose,globals,
+       symconst,
        types,
        hcodegen;
 
@@ -304,7 +305,7 @@ implementation
                      if (
                          (ppointerdef(def_from)^.definition^.deftype=objectdef) and
                          (ppointerdef(def_to)^.definition^.deftype=objectdef) and
-                         pobjectdef(ppointerdef(def_from)^.definition)^.isrelated(
+                         pobjectdef(ppointerdef(def_from)^.definition)^.is_related(
                            pobjectdef(ppointerdef(def_to)^.definition))
                         ) or
                         { all pointers can be assigned to void-pointer }
@@ -335,7 +336,7 @@ implementation
                      { class types and class reference type
                        can be assigned to void pointers      }
                      if (
-                         ((def_from^.deftype=objectdef) and pobjectdef(def_from)^.isclass) or
+                         ((def_from^.deftype=objectdef) and pobjectdef(def_from)^.is_class) or
                          (def_from^.deftype=classrefdef)
                         ) and
                         (ppointerdef(def_to)^.definition^.deftype=orddef) and
@@ -394,12 +395,12 @@ implementation
                   pobjectdef(def_from)^.isclass and pobjectdef(def_to)^.isclass }then
                 begin
                   doconv:=tc_equal;
-                  if pobjectdef(def_from)^.isrelated(pobjectdef(def_to)) then
+                  if pobjectdef(def_from)^.is_related(pobjectdef(def_to)) then
                    b:=1;
                 end
                else
                 { nil is compatible with class instances }
-                if (fromtreetype=niln) and (pobjectdef(def_to)^.isclass) then
+                if (fromtreetype=niln) and (pobjectdef(def_to)^.is_class) then
                  begin
                    doconv:=tc_equal;
                    b:=1;
@@ -412,7 +413,7 @@ implementation
                if (def_from^.deftype=classrefdef) then
                 begin
                   doconv:=tc_equal;
-                  if pobjectdef(pclassrefdef(def_from)^.definition)^.isrelated(
+                  if pobjectdef(pclassrefdef(def_from)^.definition)^.is_related(
                        pobjectdef(pclassrefdef(def_to)^.definition)) then
                    b:=1;
                 end
@@ -484,8 +485,11 @@ implementation
               make_not_regable(p^.left);
             loadn :
               if p^.symtableentry^.typ=varsym then
-                pvarsym(p^.symtableentry)^.var_options :=
-                  pvarsym(p^.symtableentry)^.var_options and not vo_regable;
+{$ifdef INCLUDEOK}
+                exclude(pvarsym(p^.symtableentry)^.varoptions,vo_regable);
+{$else}
+                pvarsym(p^.symtableentry)^.varoptions:=pvarsym(p^.symtableentry)^.varoptions-[vo_regable];
+{$endif}
          end;
       end;
 
@@ -567,10 +571,11 @@ implementation
 
     procedure test_protected_sym(sym : psym);
       begin
-         if ((sym^.properties and sp_protected)<>0) and
-           ((sym^.owner^.symtabletype=unitsymtable) or
-            ((sym^.owner^.symtabletype=objectsymtable) and
-           (pobjectdef(sym^.owner^.defowner)^.owner^.symtabletype=unitsymtable))) then
+         if (sp_protected in sym^.symoptions) and
+            ((sym^.owner^.symtabletype=unitsymtable) or
+             ((sym^.owner^.symtabletype=objectsymtable) and
+             (pobjectdef(sym^.owner^.defowner)^.owner^.symtabletype=unitsymtable))
+            ) then
           CGMessage(parser_e_cant_access_protected_member);
       end;
 
@@ -666,7 +671,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.31  1999-07-16 10:04:32  peter
+  Revision 1.32  1999-08-03 22:02:53  peter
+    * moved bitmask constants to sets
+    * some other type/const renamings
+
+  Revision 1.31  1999/07/16 10:04:32  peter
     * merged
 
   Revision 1.30  1999/06/28 16:02:30  peter

+ 11 - 2
compiler/lin_targ.pas

@@ -40,6 +40,7 @@ implementation
 
   uses
     verbose,strings,cobjects,systems,globtype,globals,
+    symconst,
     files,aasm,symtable;
 
 
@@ -66,7 +67,11 @@ implementation
         current_module^.linkothersharedlibs.insert(SplitName(module),link_allways);
         { reset the mangledname and turn off the dll_var option }
         aktvarsym^.setmangledname(name);
-        aktvarsym^.var_options:=aktvarsym^.var_options and (not vo_is_dll_var);
+{$ifdef INCLUDEOK}
+        exclude(aktvarsym^.varoptions,vo_is_dll_var);
+{$else}
+        aktvarsym^.varoptions:=aktvarsym^.varoptions-[vo_is_dll_var];
+{$endif}
       end;
 
 
@@ -78,7 +83,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.4  1999-07-03 00:29:50  peter
+  Revision 1.5  1999-08-03 22:02:54  peter
+    * moved bitmask constants to sets
+    * some other type/const renamings
+
+  Revision 1.4  1999/07/03 00:29:50  peter
     * new link writing to the ppu, one .ppu is needed for all link types,
       static (.o) is now always created also when smartlinking is used
 

+ 13 - 9
compiler/pass_2.pas

@@ -43,7 +43,7 @@ implementation
    uses
      globtype,systems,
      cobjects,comphook,verbose,globals,files,
-     symtable,types,aasm,scanner,
+     symconst,symtable,types,aasm,scanner,
      pass_1,hcodegen,temp_gen
 {$ifdef GDB}
      ,gdb
@@ -124,7 +124,7 @@ implementation
         i : longint;
         r : preference;
       begin
-         if (aktprocsym^.definition^.options and poinline)<>0 then
+         if (pocall_inline in aktprocsym^.definition^.proccalloptions) then
            begin
              localfixup:=aktprocsym^.definition^.localst^.address_fixup;
              parafixup:=aktprocsym^.definition^.parast^.address_fixup;
@@ -304,7 +304,7 @@ implementation
       var
          i,j,k : longint;
       begin
-         if (psym(p)^.typ=varsym) and ((pvarsym(p)^.var_options and vo_regable)<>0) then
+         if (psym(p)^.typ=varsym) and (vo_regable in pvarsym(p)^.varoptions) then
            begin
               { walk through all momentary register variables }
               for i:=1 to maxvarregs do
@@ -382,10 +382,10 @@ implementation
                    }
                    if assigned(aktprocsym) then
                      begin
-                       if (aktprocsym^.definition^.options and
-                        (poconstructor+podestructor{+poinline}+pointerrupt)=0) and
-                        ((procinfo.flags and pi_do_call)=0) and
-                        (lexlevel>=normal_function_level) then
+                       if not(aktprocsym^.definition^.proctypeoption in [potype_constructor,potype_destructor]) and
+                          not(po_interrupt in aktprocsym^.definition^.procoptions) and
+                          ((procinfo.flags and pi_do_call)=0) and
+                          (lexlevel>=normal_function_level) then
                        begin
                          { use ESP as frame pointer }
                          procinfo.framepointer:=stack_pointer;
@@ -522,7 +522,7 @@ implementation
                      end;
                 end;
               if assigned(aktprocsym) and
-                 ((aktprocsym^.definition^.options and poinline)<>0) then
+                 (pocall_inline in aktprocsym^.definition^.proccalloptions) then
                 make_const_global:=true;
               do_secondpass(p);
 
@@ -539,7 +539,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.26  1999-06-02 22:44:08  pierre
+  Revision 1.27  1999-08-03 22:02:55  peter
+    * moved bitmask constants to sets
+    * some other type/const renamings
+
+  Revision 1.26  1999/06/02 22:44:08  pierre
    * previous wrong log corrected
 
   Revision 1.25  1999/06/02 22:25:41  pierre

+ 203 - 112
compiler/pdecl.pas

@@ -56,7 +56,8 @@ unit pdecl;
   implementation
 
     uses
-       cobjects,scanner,aasm,tree,pass_1,strings,
+       cobjects,scanner,
+       symconst,aasm,tree,pass_1,strings,
        files,types,verbose,systems,import
 {$ifndef newcg}
        ,tccnv
@@ -87,7 +88,7 @@ unit pdecl;
       begin
          if not(psym(p)^.typ=typesym) then
           exit;
-         if ((psym(p)^.properties and sp_forwarddef)<>0) then
+         if (sp_forwarddef in psym(p)^.symoptions) then
            begin
              oldaktfilepos:=aktfilepos;
              aktfilepos:=psym(p)^.fileinfo;
@@ -95,15 +96,19 @@ unit pdecl;
              aktfilepos:=oldaktfilepos;
              { try to recover }
              ptypesym(p)^.definition:=generrordef;
-             psym(p)^.properties:=psym(p)^.properties and (not sp_forwarddef);
+{$ifdef INCLUDEOK}
+             exclude(psym(p)^.symoptions,sp_forwarddef);
+{$else}
+             psym(p)^.symoptions:=psym(p)^.symoptions-[sp_forwarddef];
+{$endif}
            end
          else
           if (ptypesym(p)^.definition^.deftype in [recorddef,objectdef]) then
            begin
              if (ptypesym(p)^.definition^.deftype=recorddef) then
-               reaktvarsymtable:=precdef(ptypesym(p)^.definition)^.symtable
+               reaktvarsymtable:=precorddef(ptypesym(p)^.definition)^.symtable
              else
-               reaktvarsymtable:=pobjectdef(ptypesym(p)^.definition)^.publicsyms;
+               reaktvarsymtable:=pobjectdef(ptypesym(p)^.definition)^.symtable;
              reaktvarsymtable^.foreach({$ifndef TP}@{$endif}testforward_type);
            end;
       end;
@@ -281,11 +286,15 @@ unit pdecl;
                 else
                  ss:=new(pvarsym,init(s,def));
                 if is_threadvar then
-                  ss^.var_options:=ss^.var_options or vo_is_thread_var;
+{$ifdef INCLUDEOK}
+                  include(ss^.varoptions,vo_is_thread_var);
+{$else}
+                  ss^.varoptions:=ss^.varoptions+[vo_is_thread_var];
+{$endif}
                 st^.insert(ss);
                 { static data fields are inserted in the globalsymtable }
                 if (st^.symtabletype=objectsymtable) and
-                   ((current_object_option and sp_static)<>0) then
+                   (sp_static in current_object_option) then
                   begin
                      s:=lower(st^.name^)+'_'+s;
                      st^.defowner^.owner^.insert(new(pvarsym,init(s,def)));
@@ -361,7 +370,11 @@ unit pdecl;
                    Message(parser_e_absolute_only_one_var);
                   dispose(sc,done);
                   aktvarsym:=new(pvarsym,init_C(s,target_os.Cprefix+C_name,p));
-                  aktvarsym^.var_options:=aktvarsym^.var_options or vo_is_external;
+{$ifdef INCLUDEOK}
+                  include(aktvarsym^.varoptions,vo_is_external);
+{$else}
+                  aktvarsym^.varoptions:=aktvarsym^.varoptions+[vo_is_external];
+{$endif}
                   symtablestack^.insert(aktvarsym);
                   tokenpos:=storetokenpos;
                   symdone:=true;
@@ -550,7 +563,11 @@ unit pdecl;
                    if export_aktvarsym then
                     inc(aktvarsym^.refs);
                    if extern_aktvarsym then
-                    aktvarsym^.var_options:=aktvarsym^.var_options or vo_is_external;
+{$ifdef INCLUDEOK}
+                    include(aktvarsym^.varoptions,vo_is_external);
+{$else}
+                    aktvarsym^.varoptions:=aktvarsym^.varoptions+[vo_is_external];
+{$endif}
                    { insert in the stack/datasegment }
                    symtablestack^.insert(aktvarsym);
                    tokenpos:=storetokenpos;
@@ -573,12 +590,20 @@ unit pdecl;
                 else
                  if (is_object) and (cs_static_keyword in aktmoduleswitches) and (idtoken=_STATIC) then
                   begin
-                    current_object_option:=current_object_option or sp_static;
+{$ifdef INCLUDEOK}
+                    include(current_object_option,sp_static);
+{$else}
+                    current_object_option:=current_object_option+[sp_static];
+{$endif}
                     if assigned(readtypesym) then
                      insert_syms(symtablestack,sc,nil,readtypesym,false)
                     else
                      insert_syms(symtablestack,sc,p,nil,false);
-                    current_object_option:=current_object_option - sp_static;
+{$ifdef INCLUDEOK}
+                    exclude(current_object_option,sp_static);
+{$else}
+                    current_object_option:=current_object_option-[sp_static];
+{$endif}
                     consume(_STATIC);
                     consume(SEMICOLON);
                     symdone:=true;
@@ -587,8 +612,8 @@ unit pdecl;
              { insert it in the symtable, if not done yet }
              if not symdone then
                begin
-                  if (current_object_option=sp_published) and
-                    (not((p^.deftype=objectdef) and (pobjectdef(p)^.isclass))) then
+                  if (sp_published in current_object_option) and
+                    (not((p^.deftype=objectdef) and (pobjectdef(p)^.is_class))) then
                     Message(parser_e_cant_publish_that);
                   if assigned(readtypesym) then
                    insert_syms(symtablestack,sc,nil,readtypesym,is_threadvar)
@@ -703,7 +728,7 @@ unit pdecl;
          s:=pattern;
          consume(ID);
          { classes can be used also in classes }
-         if (curobjectname=pattern) and aktobjectdef^.isclass then
+         if (curobjectname=pattern) and aktobjectdef^.is_class then
            begin
               id_type:=aktobjectdef;
               exit;
@@ -789,7 +814,7 @@ unit pdecl;
     function object_dec(const n : stringid;fd : pobjectdef) : pdef;
     { this function parses an object or class declaration }
       var
-         actmembertype : symprop;
+         actmembertype : tsymoptions;
          there_is_a_destructor : boolean;
          is_a_class : boolean;
          childof : pobjectdef;
@@ -801,16 +826,20 @@ unit pdecl;
            consume(_CONSTRUCTOR);
            { must be at same level as in implementation }
            inc(lexlevel);
-           parse_proc_head(poconstructor);
+           parse_proc_head(potype_constructor);
            dec(lexlevel);
 
            if (cs_constructor_name in aktglobalswitches) and (aktprocsym^.name<>'INIT') then
             Message(parser_e_constructorname_must_be_init);
 
-           aktclass^.options:=aktclass^.options or oo_hasconstructor;
+{$ifdef INCLUDEOK}
+           include(aktclass^.objectoptions,oo_has_constructor);
+{$else}
+           aktclass^.objectoptions:=aktclass^.objectoptions+[oo_has_constructor];
+{$endif}
            consume(SEMICOLON);
              begin
-                if (aktclass^.options and oo_is_class)<>0 then
+                if (aktclass^.is_class) then
                   begin
                      { CLASS constructors return the created instance }
                      aktprocsym^.definition^.retdef:=aktclass;
@@ -872,7 +901,7 @@ unit pdecl;
 
         begin
            { check for a class }
-           if (aktclass^.options and oo_is_class=0) then
+           if not(aktclass^.is_class) then
             Message(parser_e_syntax_error);
            consume(_PROPERTY);
            propertyparas:=nil;
@@ -885,7 +914,7 @@ unit pdecl;
                 { property parameters ? }
                 if token=LECKKLAMMER then
                   begin
-                     if current_object_option=sp_published then
+                     if (sp_published in current_object_option) then
                        Message(parser_e_cant_publish_that_property);
 
                      { create a list of the parameters in propertyparas }
@@ -955,7 +984,11 @@ unit pdecl;
                      if (idtoken=_INDEX) then
                        begin
                           consume(_INDEX);
-                          p^.options:=p^.options or ppo_indexed;
+{$ifdef INCLUDEOK}
+                          include(p^.propoptions,ppo_indexed);
+{$else}
+                          p^.propoptions:=p^.propoptions+[ppo_indexed];
+{$endif}
                           if token=INTCONST then
                             val(pattern,p^.index,code);
                           consume(INTCONST);
@@ -974,7 +1007,7 @@ unit pdecl;
                      if assigned(overriden) and (overriden^.typ=propertysym) then
                        begin
                           { take the whole info: }
-                          p^.options:=ppropertysym(overriden)^.options;
+                          p^.propoptions:=ppropertysym(overriden)^.propoptions;
                           p^.index:=ppropertysym(overriden)^.index;
                           p^.proptype:=ppropertysym(overriden)^.proptype;
                           p^.writeaccesssym:=ppropertysym(overriden)^.writeaccesssym;
@@ -992,8 +1025,8 @@ unit pdecl;
                        end;
                   end;
 
-                if (current_object_option=sp_published) and
-                  not(p^.proptype^.is_publishable) then
+                if (sp_published in current_object_option) and
+                   not(p^.proptype^.is_publishable) then
                   Message(parser_e_cant_publish_that_property);
 
                 { create data defcoll to allow correct parameter checks }
@@ -1018,7 +1051,7 @@ unit pdecl;
                              ((sym^.typ=varsym) and (pvarsym(sym)^.definition^.deftype=recorddef)) then
                            begin
                              consume(POINT);
-                             getsymonlyin(precdef(pvarsym(sym)^.definition)^.symtable,pattern);
+                             getsymonlyin(precorddef(pvarsym(sym)^.definition)^.symtable,pattern);
                              if not assigned(srsym) then
                                Message1(sym_e_illegal_field,pattern);
                              sym:=srsym;
@@ -1072,7 +1105,7 @@ unit pdecl;
                              ((sym^.typ=varsym) and (pvarsym(sym)^.definition^.deftype=recorddef)) then
                            begin
                              consume(POINT);
-                             getsymonlyin(precdef(pvarsym(sym)^.definition)^.symtable,pattern);
+                             getsymonlyin(precorddef(pvarsym(sym)^.definition)^.symtable,pattern);
                              if not assigned(srsym) then
                                Message1(sym_e_illegal_field,pattern);
                              sym:=srsym;
@@ -1166,7 +1199,11 @@ unit pdecl;
                          pobjectdef(p2^.owner^.defowner)^.objname^)
                      else
                        begin
-                          p^.options:=p^.options or ppo_defaultproperty;
+{$ifdef INCLUDEOK}
+                          include(p^.propoptions,ppo_defaultproperty);
+{$else}
+                          p^.propoptions:=p^.propoptions+[ppo_defaultproperty];
+{$endif}
                           if not(assigned(propertyparas)) then
                             message(parser_e_property_need_paras);
                        end;
@@ -1189,11 +1226,15 @@ unit pdecl;
         begin
            consume(_DESTRUCTOR);
            inc(lexlevel);
-           parse_proc_head(podestructor);
+           parse_proc_head(potype_destructor);
            dec(lexlevel);
            if (cs_constructor_name in aktglobalswitches) and (aktprocsym^.name<>'DONE') then
             Message(parser_e_destructorname_must_be_done);
-           aktclass^.options:=aktclass^.options or oo_hasdestructor;
+{$ifdef INCLUDEOK}
+           include(aktclass^.objectoptions,oo_has_destructor);
+{$else}
+           aktclass^.objectoptions:=aktclass^.objectoptions+[oo_has_destructor];
+{$endif}
            consume(SEMICOLON);
            if assigned(aktprocsym^.definition^.para1) then
             Message(parser_e_no_paras_for_destructor);
@@ -1216,10 +1257,13 @@ unit pdecl;
          oldprocsym:=aktprocsym;
          { forward is resolved }
          if assigned(fd) then
-           fd^.options:=fd^.options and not(oo_isforward);
-
+{$ifdef INCLUDEOK}
+           exclude(fd^.objectoptions,oo_is_forward);
+{$else}
+           fd^.objectoptions:=fd^.objectoptions-[oo_is_forward];
+{$endif}
          there_is_a_destructor:=false;
-         actmembertype:=sp_public;
+         actmembertype:=[sp_public];
 
          { objects and class types can't be declared local }
          if (symtablestack^.symtabletype<>globalsymtable) and
@@ -1250,18 +1294,17 @@ unit pdecl;
                    hp1:=single_type(hs);
 
                    { accept hp1, if is a forward def ...}
-                   if ((lasttypesym<>nil)
-                       and ((lasttypesym^.properties and sp_forwarddef)<>0)) or
+                   if ((lasttypesym<>nil) and
+                       (sp_forwarddef in lasttypesym^.symoptions)) or
                    { or a class
                      (if the foward defined type is a class is checked, when
                       the forward is resolved)
                    }
-                     ((hp1^.deftype=objectdef) and (
-                     (pobjectdef(hp1)^.options and oo_is_class)<>0)) then
+                     ((hp1^.deftype=objectdef) and pobjectdef(hp1)^.is_class) then
                      begin
                         pcrd:=new(pclassrefdef,init(hp1));
                         object_dec:=pcrd;
-                        if assigned(lasttypesym) and ((lasttypesym^.properties and sp_forwarddef)<>0) then
+                        if assigned(lasttypesym) and (sp_forwarddef in lasttypesym^.symoptions) then
                          lasttypesym^.addforwardpointer(ppointerdef(pcrd));
                         forwardsallowed:=false;
                      end
@@ -1288,9 +1331,9 @@ unit pdecl;
                      end
                    else
                      aktclass:=new(pobjectdef,init(n,nil));
-                   aktclass^.options:=aktclass^.options or oo_is_class or oo_isforward;
+                   aktclass^.objectoptions:=aktclass^.objectoptions+[oo_is_class,oo_is_forward];
                    { all classes must have a vmt !!  at offset zero }
-                   if (aktclass^.options and oo_hasvmt)=0 then
+                   if not(oo_has_vmt in aktclass^.objectoptions) then
                      aktclass^.insertvmt;
 
                    object_dec:=aktclass;
@@ -1320,8 +1363,8 @@ unit pdecl;
               else
                begin
                  { a mix of class and object isn't allowed }
-                 if (((childof^.options and oo_is_class)<>0) and not is_a_class) or
-                    (((childof^.options and oo_is_class)=0) and is_a_class) then
+                 if (childof^.is_class and not is_a_class) or
+                    (not childof^.is_class and is_a_class) then
                   Message(parser_e_mix_of_classes_and_objects);
                end;
               if assigned(fd) then
@@ -1329,7 +1372,7 @@ unit pdecl;
                    { the forward of the child must be resolved to get
                      correct field addresses
                    }
-                   if (childof^.options and oo_isforward)<>0 then
+                   if (oo_is_forward in childof^.objectoptions) then
                      Message1(parser_e_forward_declaration_must_be_resolved,childof^.objname^);
                    aktclass:=fd;
                    { we must inherit several options !!
@@ -1363,7 +1406,7 @@ unit pdecl;
                         { the forward of the child must be resolved to get
                           correct field addresses
                         }
-                        if (childof^.options and oo_isforward)<>0 then
+                        if (oo_is_forward in childof^.objectoptions) then
                           Message1(parser_e_forward_declaration_must_be_resolved,childof^.objname^);
                         aktclass:=fd;
                         aktclass^.set_parent(childof);
@@ -1381,21 +1424,27 @@ unit pdecl;
          { set the class attribute }
          if is_a_class then
            begin
-              aktclass^.options:=aktclass^.options or oo_is_class;
-
+{$ifdef INCLUDEOK}
+              include(aktclass^.objectoptions,oo_is_class);
+{$else}
+              aktclass^.objectoptions:=aktclass^.objectoptions+[oo_is_class];
+{$endif}
               if (cs_generate_rtti in aktlocalswitches) or
                   (assigned(aktclass^.childof) and
-                   ((aktclass^.childof^.options and oo_can_have_published)<>0)
-                  ) then
-                aktclass^.options:=aktclass^.options or oo_can_have_published;
+                   (oo_can_have_published in aktclass^.childof^.objectoptions)) then
+{$ifdef INCLUDEOK}
+                include(aktclass^.objectoptions,oo_can_have_published);
+{$else}
+                aktclass^.objectoptions:=aktclass^.objectoptions+[oo_can_have_published];
+{$endif}
            end;
 
          aktobjectdef:=aktclass;
 
          { default access is public }
-         actmembertype:=sp_public;
-         aktclass^.publicsyms^.next:=symtablestack;
-         symtablestack:=aktclass^.publicsyms;
+         actmembertype:=[sp_public];
+         aktclass^.symtable^.next:=symtablestack;
+         symtablestack:=aktclass^.symtable;
          procinfo._class:=aktclass;
          testcurobject:=1;
          curobjectname:=n;
@@ -1405,34 +1454,42 @@ unit pdecl;
           begin
           { Parse componenten }
             repeat
-              if actmembertype=sp_private then
-                aktclass^.options:=aktclass^.options or oo_hasprivate;
-              if actmembertype=sp_protected then
-                aktclass^.options:=aktclass^.options or oo_hasprotected;
+              if (sp_private in actmembertype) then
+{$ifdef INCLUDEOK}
+                include(aktclass^.objectoptions,oo_has_private);
+{$else}
+                aktclass^.objectoptions:=aktclass^.objectoptions+[oo_has_private];
+{$endif}
+              if (sp_protected in actmembertype) then
+{$ifdef INCLUDEOK}
+                include(aktclass^.objectoptions,oo_has_protected);
+{$else}
+                aktclass^.objectoptions:=aktclass^.objectoptions+[oo_has_protected];
+{$endif}
               case token of
                ID : begin
                       case idtoken of
                        _PRIVATE : begin
                                     consume(_PRIVATE);
-                                    actmembertype:=sp_private;
-                                    current_object_option:=sp_private;
+                                    actmembertype:=[sp_private];
+                                    current_object_option:=[sp_private];
                                   end;
                      _PROTECTED : begin
                                     consume(_PROTECTED);
-                                    current_object_option:=sp_protected;
-                                    actmembertype:=sp_protected;
+                                    current_object_option:=[sp_protected];
+                                    actmembertype:=[sp_protected];
                                   end;
                         _PUBLIC : begin
                                     consume(_PUBLIC);
-                                    current_object_option:=sp_public;
-                                    actmembertype:=sp_public;
+                                    current_object_option:=[sp_public];
+                                    actmembertype:=[sp_public];
                                   end;
                      _PUBLISHED : begin
-                                    if (aktclass^.options and oo_can_have_published)=0 then
+                                    if not(oo_can_have_published in aktclass^.objectoptions) then
                                      Message(parser_e_cant_have_published);
                                     consume(_PUBLISHED);
-                                    current_object_option:=sp_published;
-                                    actmembertype:=sp_published;
+                                    current_object_option:=[sp_published];
+                                    actmembertype:=[sp_published];
                                   end;
                       else
                         read_var_decs(false,true,false);
@@ -1448,16 +1505,28 @@ unit pdecl;
 {$ifndef newcg}
                       parse_object_proc_directives(aktprocsym);
 {$endif newcg}
-                      if (aktprocsym^.definition^.options and pomsgint)<>0 then
-                                aktclass^.options:=aktclass^.options or oo_hasmsgint;
-                      if (aktprocsym^.definition^.options and pomsgstr)<>0 then
-                        aktclass^.options:=aktclass^.options or oo_hasmsgstr;
-                                if (aktprocsym^.definition^.options and povirtualmethod)<>0 then
-                        aktclass^.options:=aktclass^.options or oo_hasvirtual;
+                      if (po_msgint in aktprocsym^.definition^.procoptions) then
+{$ifdef INCLUDEOK}
+                        include(aktclass^.objectoptions,oo_has_msgint);
+{$else}
+                        aktclass^.objectoptions:=aktclass^.objectoptions+[oo_has_msgint];
+{$endif}
+                      if (po_msgstr in aktprocsym^.definition^.procoptions) then
+{$ifdef INCLUDEOK}
+                        include(aktclass^.objectoptions,oo_has_msgstr);
+{$else}
+                        aktclass^.objectoptions:=aktclass^.objectoptions+[oo_has_msgstr];
+{$endif}
+                      if (po_virtualmethod in aktprocsym^.definition^.procoptions) then
+{$ifdef INCLUDEOK}
+                        include(aktclass^.objectoptions,oo_has_virtual);
+{$else}
+                        aktclass^.objectoptions:=aktclass^.objectoptions+[oo_has_virtual];
+{$endif}
                       parse_only:=oldparse_only;
                     end;
      _CONSTRUCTOR : begin
-                      if actmembertype<>sp_public then
+                      if not(sp_public in actmembertype) then
                         Message(parser_w_constructor_should_be_public);
                       oldparse_only:=parse_only;
                       parse_only:=true;
@@ -1465,15 +1534,19 @@ unit pdecl;
 {$ifndef newcg}
                       parse_object_proc_directives(aktprocsym);
 {$endif newcg}
-                      if (aktprocsym^.definition^.options and povirtualmethod)<>0 then
-                        aktclass^.options:=aktclass^.options or oo_hasvirtual;
+                      if (po_virtualmethod in aktprocsym^.definition^.procoptions) then
+{$ifdef INCLUDEOK}
+                        include(aktclass^.objectoptions,oo_has_virtual);
+{$else}
+                        aktclass^.objectoptions:=aktclass^.objectoptions+[oo_has_virtual];
+{$endif}
                       parse_only:=oldparse_only;
                     end;
       _DESTRUCTOR : begin
                       if there_is_a_destructor then
                         Message(parser_n_only_one_destructor);
                       there_is_a_destructor:=true;
-                      if actmembertype<>sp_public then
+                      if not(sp_public in actmembertype) then
                         Message(parser_w_destructor_should_be_public);
                       oldparse_only:=parse_only;
                       parse_only:=true;
@@ -1481,8 +1554,12 @@ unit pdecl;
 {$ifndef newcg}
                       parse_object_proc_directives(aktprocsym);
 {$endif newcg}
-                      if (aktprocsym^.definition^.options and povirtualmethod)<>0 then
-                        aktclass^.options:=aktclass^.options or oo_hasvirtual;
+                      if (po_virtualmethod in aktprocsym^.definition^.procoptions) then
+{$ifdef INCLUDEOK}
+                        include(aktclass^.objectoptions,oo_has_virtual);
+{$else}
+                        aktclass^.objectoptions:=aktclass^.objectoptions+[oo_has_virtual];
+{$endif}
                       parse_only:=oldparse_only;
                     end;
              _END : begin
@@ -1493,25 +1570,22 @@ unit pdecl;
                consume(ID); { Give a ident expected message, like tp7 }
               end;
             until false;
-            current_object_option:=sp_public;
+            current_object_option:=[sp_public];
           end;
          testcurobject:=0;
          curobjectname:='';
          typecanbeforward:=storetypeforwardsallowed;
 
          { generate vmt space if needed }
-         if ((aktclass^.options and
-             (oo_hasvirtual or oo_hasconstructor or
-              oo_hasdestructor or oo_is_class))<>0) and
-            ((aktclass^.options and
-              oo_hasvmt)=0) then
-          aktclass^.insertvmt;
+         if not(oo_has_vmt in aktclass^.objectoptions) and
+            ([oo_has_virtual,oo_has_constructor,oo_has_destructor,oo_is_class]*aktclass^.objectoptions<>[]) then
+           aktclass^.insertvmt;
          if (cs_smartlink in aktmoduleswitches) then
            datasegment^.concat(new(pai_cut,init));
          { write extended info for classes }
          if is_a_class then
            begin
-              if (aktclass^.options and oo_can_have_published)<>0 then
+              if (oo_can_have_published in aktclass^.objectoptions) then
                 aktclass^.generate_rtti;
               { write class name }
               getdatalabel(classnamelabel);
@@ -1520,16 +1594,15 @@ unit pdecl;
               datasegment^.concat(new(pai_string,init(aktclass^.objname^)));
 
               { generate message and dynamic tables }
-              if (aktclass^.options and oo_hasmsgstr)<>0 then
+              if (oo_has_msgstr in aktclass^.objectoptions) then
                 strmessagetable:=genstrmsgtab(aktclass);
-              if (aktclass^.options and oo_hasmsgint)<>0 then
+              if (oo_has_msgint in aktclass^.objectoptions) then
                 intmessagetable:=genintmsgtab(aktclass)
               else
                 datasegment^.concat(new(pai_const,init_32bit(0)));
 
-
               { table for string messages }
-              if (aktclass^.options and oo_hasmsgstr)<>0 then
+              if (oo_has_msgstr in aktclass^.objectoptions) then
                 datasegment^.concat(new(pai_const_symbol,init(strmessagetable)))
               else
                 datasegment^.concat(new(pai_const,init_32bit(0)));
@@ -1547,7 +1620,7 @@ unit pdecl;
                 datasegment^.concat(new(pai_const,init_32bit(0)));
 
               { pointer to type info of published section }
-              if (aktclass^.options and oo_can_have_published)<>0 then
+              if (oo_can_have_published in aktclass^.objectoptions) then
                 datasegment^.concat(new(pai_const_symbol,initname(aktclass^.rtti_name)))
               else
                 datasegment^.concat(new(pai_const,init_32bit(0)));
@@ -1558,7 +1631,7 @@ unit pdecl;
               datasegment^.concat(new(pai_const,init_32bit(0)));
 
               { pointer to dynamic table }
-              if (aktclass^.options and oo_hasmsgint)<>0 then
+              if (oo_has_msgint in aktclass^.objectoptions) then
                 datasegment^.concat(new(pai_const_symbol,init(intmessagetable)))
               else
                 datasegment^.concat(new(pai_const,init_32bit(0)));
@@ -1571,7 +1644,7 @@ unit pdecl;
 {$ifdef GDB}
          { generate the VMT }
          if (cs_debuginfo in aktmoduleswitches) and
-            ((aktclass^.options and oo_hasvmt)<>0) then
+            (oo_has_vmt in aktclass^.objectoptions) then
            begin
               do_count_dbx:=true;
               if assigned(aktclass^.owner) and assigned(aktclass^.owner^.name) then
@@ -1579,24 +1652,22 @@ unit pdecl;
                 typeglobalnumber('__vtbl_ptr_type')+'",'+tostr(N_STSYM)+',0,0,'+aktclass^.vmt_mangledname))));
            end;
 {$endif GDB}
-         if ((aktclass^.options and oo_hasvmt)<>0) then
+         if (oo_has_vmt in aktclass^.objectoptions) then
            begin
               datasegment^.concat(new(pai_symbol,initname_global(aktclass^.vmt_mangledname,0)));
 
-              { determine the size with publicsyms^.datasize, because }
+              { determine the size with symtable^.datasize, because }
               { size gives back 4 for classes                    }
-              datasegment^.concat(new(pai_const,init_32bit(aktclass^.publicsyms^.datasize)));
-              datasegment^.concat(new(pai_const,init_32bit(-aktclass^.publicsyms^.datasize)));
+              datasegment^.concat(new(pai_const,init_32bit(aktclass^.symtable^.datasize)));
+              datasegment^.concat(new(pai_const,init_32bit(-aktclass^.symtable^.datasize)));
 
               { write pointer to parent VMT, this isn't implemented in TP }
               { but this is not used in FPC ? (PM) }
               { it's not used yet, but the delphi-operators as and is need it (FK) }
               { it is not written for parents that don't have any vmt !! }
               if assigned(aktclass^.childof) and
-                 ((aktclass^.childof^.options and oo_hasvmt)<>0) then
-                begin
-                   datasegment^.concat(new(pai_const_symbol,initname(aktclass^.childof^.vmt_mangledname)));
-                end
+                 (oo_has_vmt in aktclass^.childof^.objectoptions) then
+                datasegment^.concat(new(pai_const_symbol,initname(aktclass^.childof^.vmt_mangledname)))
               else
                 datasegment^.concat(new(pai_const,init_32bit(0)));
 
@@ -1627,7 +1698,7 @@ unit pdecl;
       begin
          { create recdef }
          symtable:=new(psymtable,init(recordsymtable));
-         record_dec:=new(precdef,init(symtable));
+         record_dec:=new(precorddef,init(symtable));
          { update symtable stack }
          symtable^.next:=symtablestack;
          symtablestack:=symtable;
@@ -1673,7 +1744,11 @@ unit pdecl;
                   { self method ? }
                   if idtoken=_SELF then
                    begin
-                     procvardef^.options:=procvardef^.options or pocontainsself;
+{$ifdef INCLUDEOK}
+                     include(procvardef^.procoptions,po_containsself);
+{$else}
+                     procvardef^.procoptions:=procvardef^.procoptions+[po_containsself];
+{$endif}
                      consume(idtoken);
                      consume(COLON);
                      p:=single_type(hs1);
@@ -1986,7 +2061,7 @@ unit pdecl;
                   forwardsallowed:=true;
                 hp1:=single_type(hs);
                 p:=new(ppointerdef,init(hp1));
-                if (lasttypesym<>nil) and ((lasttypesym^.properties and sp_forwarddef)<>0) then
+                if (lasttypesym<>nil) and (sp_forwarddef in lasttypesym^.symoptions) then
                   lasttypesym^.addforwardpointer(ppointerdef(p));
                 forwardsallowed:=false;
                 readtypesym:=nil;
@@ -2027,7 +2102,11 @@ unit pdecl;
                   begin
                     consume(_OF);
                     consume(_OBJECT);
-                    pprocvardef(p)^.options:=pprocvardef(p)^.options or pomethodpointer;
+{$ifdef INCLUDEOK}
+                    include(pprocvardef(p)^.procoptions,po_methodpointer);
+{$else}
+                    pprocvardef(p)^.procoptions:=pprocvardef(p)^.procoptions+[po_methodpointer];
+{$endif}
                   end;
                 readtypesym:=nil;
               end;
@@ -2039,9 +2118,13 @@ unit pdecl;
                 pprocvardef(p)^.retdef:=single_type(hs);
                 if token=_OF then
                   begin
-                     consume(_OF);
-                     consume(_OBJECT);
-                     pprocvardef(p)^.options:=pprocvardef(p)^.options or pomethodpointer;
+                    consume(_OF);
+                    consume(_OBJECT);
+{$ifdef INCLUDEOK}
+                    include(pprocvardef(p)^.procoptions,po_methodpointer);
+{$else}
+                    pprocvardef(p)^.procoptions:=pprocvardef(p)^.procoptions+[po_methodpointer];
+{$endif}
                   end;
                 readtypesym:=nil;
               end;
@@ -2101,8 +2184,8 @@ unit pdecl;
                       if (token=_CLASS) and
                          (assigned(ptypesym(sym)^.definition)) and
                          (ptypesym(sym)^.definition^.deftype=objectdef) and
-                         ((pobjectdef(ptypesym(sym)^.definition)^.options and oo_isforward)<>0) and
-                         ((pobjectdef(ptypesym(sym)^.definition)^.options and oo_is_class)<>0) then
+                         pobjectdef(ptypesym(sym)^.definition)^.is_class and
+                         (oo_is_forward in pobjectdef(ptypesym(sym)^.definition)^.objectoptions) then
                        begin
                          { we can ignore the result   }
                          { the definition is modified }
@@ -2110,7 +2193,7 @@ unit pdecl;
                          newtype:=ptypesym(sym);
                        end
                       else
-                       if sym^.properties=sp_forwarddef then
+                       if (sp_forwarddef in sym^.symoptions) then
                         begin
                           ptypesym(sym)^.updateforwarddef(read_type(typename));
                           newtype:=ptypesym(sym);
@@ -2217,11 +2300,15 @@ unit pdecl;
 
       begin
          if assigned(aktprocsym) and
-            ((aktprocsym^.definition^.options and poinline)<>0) then
+            (pocall_inline in aktprocsym^.definition^.proccalloptions) then
            Begin
               Message1(parser_w_not_supported_for_inline,tokenstring(t));
               Message(parser_w_inlining_disabled);
-              aktprocsym^.definition^.options:= aktprocsym^.definition^.options and not poinline;
+{$ifdef INCLUDEOK}
+              exclude(aktprocsym^.definition^.proccalloptions,pocall_inline);
+{$else}
+              aktprocsym^.definition^.proccalloptions:=aktprocsym^.definition^.proccalloptions-[pocall_inline];
+{$endif}
            End;
       end;
 
@@ -2303,7 +2390,11 @@ unit pdecl;
 end.
 {
   $Log$
-  Revision 1.138  1999-08-01 18:28:11  florian
+  Revision 1.139  1999-08-03 22:02:56  peter
+    * moved bitmask constants to sets
+    * some other type/const renamings
+
+  Revision 1.138  1999/08/01 18:28:11  florian
     * modifications for the new code generator
 
   Revision 1.137  1999/07/29 20:54:02  peter

+ 9 - 5
compiler/pexports.pas

@@ -32,7 +32,7 @@ unit pexports;
     uses
       globtype,systems,tokens,
       strings,cobjects,globals,verbose,
-      scanner,symtable,pbase,
+      scanner,symconst,symtable,pbase,
       export,GenDef;
 
     procedure read_exports;
@@ -64,9 +64,9 @@ unit pexports;
                      begin
                         hp^.sym:=srsym;
                         if ((srsym^.typ<>procsym) or
-                          ((pprocdef(pprocsym(srsym)^.definition)^.options and poexports)=0)) and
-                          (srsym^.typ<>varsym) and (srsym^.typ<>typedconstsym) then
-                          Message(parser_e_illegal_symbol_exported)
+                            not(po_exports in pprocdef(pprocsym(srsym)^.definition)^.procoptions)) and
+                           (srsym^.typ<>varsym) and (srsym^.typ<>typedconstsym) then
+                         Message(parser_e_illegal_symbol_exported)
                         else
                          begin
                           ProcName:=hp^.sym^.name;
@@ -120,7 +120,11 @@ end.
 
 {
   $Log$
-  Revision 1.9  1999-05-04 21:44:56  florian
+  Revision 1.10  1999-08-03 22:02:58  peter
+    * moved bitmask constants to sets
+    * some other type/const renamings
+
+  Revision 1.9  1999/05/04 21:44:56  florian
     * changes to compile it with Delphi 4.0
 
   Revision 1.8  1999/03/26 00:05:35  peter

+ 51 - 44
compiler/pexpr.pas

@@ -47,11 +47,13 @@ unit pexpr;
 
     uses
        globtype,systems,tokens,
-       cobjects,globals,scanner,aasm,pass_1,
-       hcodegen,types,verbose,strings
+       cobjects,globals,scanner,
+       symconst,aasm,
+       hcodegen,types,verbose,strings,
 {$ifndef newcg}
-       ,tccal
+       tccal,
 {$endif newcg}
+       pass_1
        { parser specific stuff }
        ,pbase,pdecl
        { processor specific stuff }
@@ -252,7 +254,7 @@ unit pexpr;
                  Must_be_valid:=false;
                  do_firstpass(p1);
                  if ((p1^.resulttype^.deftype=objectdef) and
-                     ((pobjectdef(p1^.resulttype)^.options and oo_hasconstructor)<>0)) or
+                     (oo_has_constructor in pobjectdef(p1^.resulttype)^.objectoptions)) or
                     is_open_array(p1^.resulttype) or
                     is_open_string(p1^.resulttype) then
                   statement_syssym:=geninlinenode(in_sizeof_x,false,p1)
@@ -276,7 +278,7 @@ unit pexpr;
            pointerdef,
            procvardef,
           classrefdef : ;
-            objectdef : if not(pobjectdef(p1^.resulttype)^.isclass) then
+            objectdef : if not(pobjectdef(p1^.resulttype)^.is_class) then
                          Message(parser_e_illegal_parameter_list);
               else
                 Message(parser_e_illegal_parameter_list);
@@ -583,7 +585,7 @@ unit pexpr;
         hp:=nil;
         if (proc_to_procvar_equal(pprocsym(t^.symtableentry)^.definition,procvar)) then
          begin
-           if ((procvar^.options and pomethodpointer)<>0) then
+           if (po_methodpointer in procvar^.procoptions) then
              hp:=genloadmethodcallnode(pprocsym(t^.symtableprocentry),t^.symtable,getcopy(t^.methodpointer))
            else
              hp:=genloadcallnode(pprocsym(t^.symtableprocentry),t^.symtable);
@@ -613,7 +615,7 @@ unit pexpr;
               consume(RECKKLAMMER);
            end;
          { indexed property }
-         if (ppropertysym(sym)^.options and ppo_indexed)<>0 then
+         if (ppo_indexed in ppropertysym(sym)^.propoptions) then
            begin
               p2:=genordinalconstnode(ppropertysym(sym)^.index,s32bitdef);
               paras:=gencallparanode(p2,paras);
@@ -744,20 +746,19 @@ unit pexpr;
            begin
               isclassref:=pd^.deftype=classrefdef;
 
-              { check protected and private members     }
+              { check protected and private members        }
               { please leave this code as it is,           }
               { it has now the same behaviaor as TP/Delphi }
-              if ((sym^.properties and sp_private)<>0) and
-                (pobjectdef(pd)^.owner^.symtabletype=unitsymtable) then
+              if (sp_private in sym^.symoptions) and
+                 (pobjectdef(pd)^.owner^.symtabletype=unitsymtable) then
                Message(parser_e_cant_access_private_member);
 
-              if ((sym^.properties and sp_protected)<>0) and
+              if (sp_protected in sym^.symoptions) and
                  (pobjectdef(pd)^.owner^.symtabletype=unitsymtable) then
                 begin
                   if assigned(aktprocsym^.definition^._class) then
                     begin
-                       if not aktprocsym^.definition^._class^.isrelated(
-                          pobjectdef(sym^.owner^.defowner)) then
+                       if not aktprocsym^.definition^._class^.is_related(pobjectdef(sym^.owner^.defowner)) then
                          Message(parser_e_cant_access_protected_member);
                     end
                   else
@@ -777,14 +778,16 @@ unit pexpr;
                         ,again,p1,pd);
                       { now we know the real method e.g. we can check for }
                       { a class method                              }
-                      if isclassref and ((p1^.procdefinition^.options and (poclassmethod or poconstructor))=0) then
+                      if isclassref and
+                         not(po_classmethod in p1^.procdefinition^.procoptions) and
+                         not(p1^.procdefinition^.proctypeoption=potype_constructor) then
                         Message(parser_e_only_class_methods_via_class_ref);
                    end;
                  varsym:
                    begin
                       if isclassref then
                         Message(parser_e_only_class_methods_via_class_ref);
-                      if (sym^.properties and sp_static)<>0 then
+                      if (sp_static in sym^.symoptions) then
                         begin
                            { static_name:=lower(srsymtable^.name^)+'_'+sym^.name;
                              this is wrong for static field in with symtable (PM) }
@@ -941,7 +944,7 @@ unit pexpr;
                      if (srsym^.typ in [propertysym,procsym,varsym]) and
                         (srsymtable^.symtabletype=objectsymtable) then
                       begin
-                         if ((srsym^.properties and sp_private)<>0) and
+                         if (sp_private in srsym^.symoptions) and
                             (pobjectdef(srsym^.owner^.defowner)^.owner^.symtabletype=unitsymtable) then
                             Message(parser_e_cant_access_private_member);
                       end;
@@ -954,19 +957,19 @@ unit pexpr;
                               { are we in a class method ? }
                               if (srsymtable^.symtabletype=objectsymtable) and
                                  assigned(aktprocsym) and
-                                 ((aktprocsym^.definition^.options and poclassmethod)<>0) then
+                                 (po_classmethod in aktprocsym^.definition^.procoptions) then
                                 Message(parser_e_only_class_methods);
-                              if (srsym^.properties and sp_static)<>0 then
+                              if (sp_static in srsym^.symoptions) then
                                begin
                                  static_name:=lower(srsym^.owner^.name^)+'_'+srsym^.name;
                                  getsym(static_name,true);
                                end;
                               p1:=genloadnode(pvarsym(srsym),srsymtable);
-                              if pvarsym(srsym)^.is_valid=0 then
+                              if pvarsym(srsym)^.varstate=vs_declared then
                                begin
                                  p1^.is_first := true;
                                  { set special between first loaded until checked in firstpass }
-                                 pvarsym(srsym)^.is_valid:=2;
+                                 pvarsym(srsym)^.varstate:=vs_declared2;
                                end;
                               pd:=pvarsym(srsym)^.definition;
                             end;
@@ -1014,22 +1017,22 @@ unit pexpr;
                                     else { not LKLAMMER}
                                      if (token=POINT) and
                                         (pd^.deftype=objectdef) and
-                                        not(pobjectdef(pd)^.isclass) then
+                                        not(pobjectdef(pd)^.is_class) then
                                        begin
                                          consume(POINT);
                                          if assigned(procinfo._class) then
                                           begin
-                                            if procinfo._class^.isrelated(pobjectdef(pd)) then
+                                            if procinfo._class^.is_related(pobjectdef(pd)) then
                                              begin
                                                p1:=gentypenode(pd,ptypesym(srsym));
                                                p1^.resulttype:=pd;
-                                               srsymtable:=pobjectdef(pd)^.publicsyms;
+                                               srsymtable:=pobjectdef(pd)^.symtable;
                                                sym:=pvarsym(srsymtable^.search(pattern));
                                                { search also in inherited methods }
                                                while sym=nil do
                                                 begin
                                                   pd:=pobjectdef(pd)^.childof;
-                                                  srsymtable:=pobjectdef(pd)^.publicsyms;
+                                                  srsymtable:=pobjectdef(pd)^.symtable;
                                                   sym:=pvarsym(srsymtable^.search(pattern));
                                                 end;
                                                consume(ID);
@@ -1048,7 +1051,7 @@ unit pexpr;
                                             { also allows static methods and variables }
                                             p1:=genzeronode(typen);
                                             p1^.resulttype:=pd;
-                                            { srsymtable:=pobjectdef(pd)^.publicsyms;
+                                            { srsymtable:=pobjectdef(pd)^.symtable;
                                               sym:=pvarsym(srsymtable^.search(pattern)); }
 
                                             { TP allows also @TMenu.Load if Load is only }
@@ -1056,7 +1059,7 @@ unit pexpr;
                                             sym:=pvarsym(search_class_member(pobjectdef(pd),pattern));
                                             if not assigned(sym) then
                                               Message1(sym_e_id_no_member,pattern)
-                                            else if not(getaddr) and ((sym^.properties and sp_static)=0) then
+                                            else if not(getaddr) and not(sp_static in sym^.symoptions) then
                                               Message(sym_e_only_static_in_static)
                                             else
                                              begin
@@ -1069,7 +1072,7 @@ unit pexpr;
                                        begin
                                           { class reference ? }
                                           if (pd^.deftype=objectdef)
-                                            and pobjectdef(pd)^.isclass then
+                                            and pobjectdef(pd)^.is_class then
                                             begin
                                                p1:=gentypenode(pd,nil);
                                                p1^.resulttype:=pd;
@@ -1139,7 +1142,7 @@ unit pexpr;
                               { are we in a class method ? }
                               possible_error:=(srsymtable^.symtabletype=objectsymtable) and
                                               assigned(aktprocsym) and
-                                              ((aktprocsym^.definition^.options and poclassmethod)<>0);
+                                              (po_classmethod in aktprocsym^.definition^.procoptions);
                               p1:=gencallnode(pprocsym(srsym),srsymtable);
                               p1^.unit_specific:=unit_specific;
                               do_proc_call(getaddr or
@@ -1148,7 +1151,7 @@ unit pexpr;
                                  proc_to_procvar_equal(pprocsym(srsym)^.definition,getprocvardef)),
                                 again,p1,pd);
                               if possible_error and
-                                 ((p1^.procdefinition^.options and poclassmethod)=0) then
+                                 not(po_classmethod in p1^.procdefinition^.procoptions) then
                                 Message(parser_e_only_class_methods);
                             end;
               propertysym : begin
@@ -1156,7 +1159,7 @@ unit pexpr;
                               { are we in a class method ? }
                               if (srsymtable^.symtabletype=objectsymtable) and
                                  assigned(aktprocsym) and
-                                 ((aktprocsym^.definition^.options and poclassmethod)<>0) then
+                                 (po_classmethod in aktprocsym^.definition^.procoptions) then
                                Message(parser_e_only_class_methods);
                               { no method pointer }
                               p1:=nil;
@@ -1312,7 +1315,7 @@ unit pexpr;
 
                 LECKKLAMMER:
                   begin
-                    if (pd^.deftype=objectdef) and pobjectdef(pd)^.isclass then
+                    if (pd^.deftype=objectdef) and pobjectdef(pd)^.is_class then
                       begin
                         { default property }
                         propsym:=search_default_property(pobjectdef(pd));
@@ -1402,7 +1405,7 @@ unit pexpr;
                     case pd^.deftype of
                        recorddef:
                          begin
-                            sym:=pvarsym(precdef(pd)^.symtable^.search(pattern));
+                            sym:=pvarsym(precorddef(pd)^.symtable^.search(pattern));
                             if sym=nil then
                               begin
                                 Message1(sym_e_illegal_field,pattern);
@@ -1423,8 +1426,8 @@ unit pexpr;
                              sym:=nil;
                              while assigned(classh) do
                               begin
-                                sym:=pvarsym(classh^.publicsyms^.search(pattern));
-                                srsymtable:=classh^.publicsyms;
+                                sym:=pvarsym(classh^.symtable^.search(pattern));
+                                srsymtable:=classh^.symtable;
                                 if assigned(sym) then
                                  break;
                                 classh:=classh^.childof;
@@ -1441,8 +1444,8 @@ unit pexpr;
                              allow_only_static:=false;
                              while assigned(classh) do
                               begin
-                                sym:=pvarsym(classh^.publicsyms^.search(pattern));
-                                srsymtable:=classh^.publicsyms;
+                                sym:=pvarsym(classh^.symtable^.search(pattern));
+                                srsymtable:=classh^.symtable;
                                 if assigned(sym) then
                                  break;
                                 classh:=classh^.childof;
@@ -1559,7 +1562,7 @@ unit pexpr;
                        token=RKLAMMER then
                   begin
                     if (ppointerdef(pd)^.definition^.deftype=objectdef) and
-                       ((pobjectdef(ppointerdef(pd)^.definition)^.options and oo_hasvmt) <> 0)  then
+                       (oo_has_vmt in pobjectdef(ppointerdef(pd)^.definition)^.objectoptions)  then
                      Message(parser_w_use_extended_syntax_for_objects);
                     p1:=gensinglenode(newn,nil);
                     p1^.resulttype:=pd2;
@@ -1590,7 +1593,7 @@ unit pexpr;
                     { determines the current object defintion }
                     classh:=pobjectdef(ppointerdef(pd)^.definition);
                     { check for an abstract class }
-                    if (classh^.options and oo_is_abstract)<>0 then
+                    if (oo_has_abstract in classh^.objectoptions) then
                       Message(sym_e_no_instance_of_abstract_object);
 
                     { search the constructor also in the symbol tables of
@@ -1600,8 +1603,8 @@ unit pexpr;
                     sym:=nil;
                     while assigned(classh) do
                      begin
-                       sym:=pvarsym(classh^.publicsyms^.search(pattern));
-                       srsymtable:=classh^.publicsyms;
+                       sym:=pvarsym(classh^.symtable^.search(pattern));
+                       srsymtable:=classh^.symtable;
                        if assigned(sym) then
                         break;
                        classh:=classh^.childof;
@@ -1611,7 +1614,7 @@ unit pexpr;
                     do_member_read(false,sym,p1,pd,again);
                     if (p1^.treetype<>calln) or
                        (assigned(p1^.procdefinition) and
-                       ((p1^.procdefinition^.options and poconstructor)=0)) then
+                       (p1^.procdefinition^.proctypeoption<>potype_constructor)) then
                       Message(parser_e_expr_have_to_be_constructor_call);
                     p1:=gensinglenode(newn,p1);
                     { set the resulttype }
@@ -1631,7 +1634,7 @@ unit pexpr;
                   end
                  else
                   begin
-                    if (aktprocsym^.definition^.options and poclassmethod)<>0 then
+                    if (po_classmethod in aktprocsym^.definition^.procoptions) then
                      begin
                        { self in class methods is a class reference type }
                        pd:=new(pclassrefdef,init(procinfo._class));
@@ -1655,7 +1658,7 @@ unit pexpr;
                     classh:=procinfo._class^.childof;
                     while assigned(classh) do
                      begin
-                       srsymtable:=pobjectdef(classh)^.publicsyms;
+                       srsymtable:=pobjectdef(classh)^.symtable;
                        sym:=pvarsym(srsymtable^.search(pattern));
                        if assigned(sym) then
                         begin
@@ -2067,7 +2070,11 @@ unit pexpr;
 end.
 {
   $Log$
-  Revision 1.128  1999-08-03 13:50:17  michael
+  Revision 1.129  1999-08-03 22:02:59  peter
+    * moved bitmask constants to sets
+    * some other type/const renamings
+
+  Revision 1.128  1999/08/03 13:50:17  michael
   + Changes for alpha
 
   Revision 1.127  1999/08/01 18:28:13  florian

+ 11 - 7
compiler/pmodules.pas

@@ -35,7 +35,7 @@ unit pmodules;
     uses
        globtype,version,systems,tokens,
        cobjects,comphook,globals,verbose,files,
-       symtable,aasm,hcodegen,
+       symconst,symtable,aasm,hcodegen,
        link,assemble,import,export,gendef,ppu,comprsrc,
        cresstr
 {$ifdef i386}
@@ -769,7 +769,7 @@ unit pmodules;
       end;
 
 
-    procedure gen_main_procsym(const name:string;options:longint;st:psymtable);
+    procedure gen_main_procsym(const name:string;options:tproctypeoption;st:psymtable);
       var
         stt : psymtable;
       begin
@@ -781,7 +781,7 @@ unit pmodules;
         symtablestack:=st;
         aktprocsym^.definition:=new(Pprocdef,init);
         symtablestack:=stt;
-        aktprocsym^.definition^.options:=aktprocsym^.definition^.options or options;
+        aktprocsym^.definition^.proctypeoption:=options;
         aktprocsym^.definition^.setmangledname(target_os.cprefix+name);
         aktprocsym^.definition^.forwarddef:=false;
         make_ref:=true;
@@ -1034,7 +1034,7 @@ unit pmodules;
 {$endif Splitheap}
 
          { Generate a procsym }
-         gen_main_procsym(current_module^.modulename^+'_init',pounitinit,st);
+         gen_main_procsym(current_module^.modulename^+'_init',potype_unitinit,st);
 
          { Compile the unit }
          codegen_newprocedure;
@@ -1055,7 +1055,7 @@ unit pmodules;
               current_module^.flags:=current_module^.flags or uf_finalize;
 
               { Generate a procsym }
-              gen_main_procsym(current_module^.modulename^+'_finalize',pounitfinalize,st);
+              gen_main_procsym(current_module^.modulename^+'_finalize',potype_unitfinalize,st);
 
               { Compile the finalize }
               codegen_newprocedure;
@@ -1267,7 +1267,7 @@ unit pmodules;
          constsymtable:=st;
 
          { Generate a procsym for main }
-         gen_main_procsym('main',poproginit,st);
+         gen_main_procsym('main',potype_proginit,st);
 
          { reset }
          procprefix:='';
@@ -1364,7 +1364,11 @@ unit pmodules;
 end.
 {
   $Log$
-  Revision 1.137  1999-08-03 17:09:38  florian
+  Revision 1.138  1999-08-03 22:03:02  peter
+    * moved bitmask constants to sets
+    * some other type/const renamings
+
+  Revision 1.137  1999/08/03 17:09:38  florian
     * the alpha compiler can be compiled now
 
   Revision 1.136  1999/08/02 17:17:10  florian

+ 40 - 34
compiler/pstatmnt.pas

@@ -41,7 +41,7 @@ unit pstatmnt;
     uses
        globtype,systems,tokens,
        strings,cobjects,globals,files,verbose,
-       symtable,aasm,pass_1,types,scanner,hcodegen,ppu
+       symconst,symtable,aasm,pass_1,types,scanner,hcodegen,ppu
        ,pbase,pexpr,pdecl
 {$ifdef i386}
        ,i386base,i386asm
@@ -373,7 +373,7 @@ unit pstatmnt;
              objectdef : begin
                            obj:=pobjectdef(p^.resulttype);
                            withsymtable:=new(pwithsymtable,init);
-                           withsymtable^.symsearch:=obj^.publicsyms^.symsearch;
+                           withsymtable^.symsearch:=obj^.symtable^.symsearch;
                            withsymtable^.defowner:=obj;
                            symtab:=withsymtable;
                            if (p^.treetype=loadn) and
@@ -387,7 +387,7 @@ unit pstatmnt;
                             begin
                               symtab^.next:=new(pwithsymtable,init);
                               symtab:=symtab^.next;
-                              symtab^.symsearch:=obj^.publicsyms^.symsearch;
+                              symtab^.symsearch:=obj^.symtable^.symsearch;
                               if (p^.treetype=loadn) and
                                  (p^.symtable=aktprocsym^.definition^.localst) then
                                 pwithsymtable(symtab)^.direct_with:=true;
@@ -401,7 +401,7 @@ unit pstatmnt;
                            symtablestack:=withsymtable;
                          end;
              recorddef : begin
-                           symtab:=precdef(p^.resulttype)^.symtable;
+                           symtab:=precorddef(p^.resulttype)^.symtable;
                            levelcount:=1;
                            withsymtable:=new(pwithsymtable,init);
                            withsymtable^.symsearch:=symtab^.symsearch;
@@ -572,7 +572,7 @@ unit pstatmnt;
                                  end;
                                if (srsym^.typ=typesym) and
                                  (ptypesym(srsym)^.definition^.deftype=objectdef) and
-                                 pobjectdef(ptypesym(srsym)^.definition)^.isclass then
+                                 pobjectdef(ptypesym(srsym)^.definition)^.is_class then
                                  ot:=pobjectdef(ptypesym(srsym)^.definition)
                                else
                                  begin
@@ -597,7 +597,7 @@ unit pstatmnt;
                                  end;
                                if (srsym^.typ=typesym) and
                                  (ptypesym(srsym)^.definition^.deftype=objectdef) and
-                                 pobjectdef(ptypesym(srsym)^.definition)^.isclass then
+                                 pobjectdef(ptypesym(srsym)^.definition)^.is_class then
                                  ot:=pobjectdef(ptypesym(srsym)^.definition)
                                else
                                  begin
@@ -708,11 +708,15 @@ unit pstatmnt;
              begin
                if not target_asm.allowdirect then
                  Message(parser_f_direct_assembler_not_allowed);
-               if (aktprocsym^.definition^.options and poinline)<>0 then
+               if (pocall_inline in aktprocsym^.definition^.proccalloptions) then
                  Begin
                     Message1(parser_w_not_supported_for_inline,'direct asm');
                     Message(parser_w_inlining_disabled);
-                    aktprocsym^.definition^.options:= aktprocsym^.definition^.options and not poinline;
+{$ifdef INCLUDEOK}
+                    exclude(aktprocsym^.definition^.proccalloptions,pocall_inline);
+{$else}
+                    aktprocsym^.definition^.proccalloptions:=aktprocsym^.definition^.proccalloptions-[pocall_inline];
+{$endif}
                  End;
                asmstat:=ra386dir.assemble;
              end;
@@ -865,16 +869,14 @@ unit pstatmnt;
                      end;
                    { check, if the first parameter is a pointer to a _class_ }
                    classh:=pobjectdef(ppointerdef(pd)^.definition);
-                   if (classh^.options and oo_is_class)<>0 then
-                         begin
-                            Message(parser_e_no_new_or_dispose_for_classes);
-                            new_dispose_statement:=factor(false);
-                            { while token<>RKLAMMER do
-                                  consume(token); }
-                            consume_all_until(RKLAMMER);
-                            consume(RKLAMMER);
-                            exit;
-                         end;
+                   if classh^.is_class then
+                     begin
+                        Message(parser_e_no_new_or_dispose_for_classes);
+                        new_dispose_statement:=factor(false);
+                        consume_all_until(RKLAMMER);
+                        consume(RKLAMMER);
+                        exit;
+                     end;
                    { search cons-/destructor, also in parent classes }
                    sym:=search_class_member(classh,pattern);
                    { the second parameter of new/dispose must be a call }
@@ -903,9 +905,9 @@ unit pstatmnt;
 
                            if not codegenerror then
                             begin
-                              if (ht=_NEW) and ((p2^.procdefinition^.options and poconstructor)=0) then
+                              if (ht=_NEW) and (p2^.procdefinition^.proctypeoption<>potype_constructor) then
                                 Message(parser_e_expr_have_to_be_constructor_call);
-                              if (ht=_DISPOSE) and ((p2^.procdefinition^.options and podestructor)=0) then
+                              if (ht=_DISPOSE) and (p2^.procdefinition^.proctypeoption<>potype_destructor) then
                                 Message(parser_e_expr_have_to_be_destructor_call);
 
                               if ht=_NEW then
@@ -927,7 +929,7 @@ unit pstatmnt;
                else
                  begin
                     if (ppointerdef(p^.resulttype)^.definition^.deftype=objectdef) and
-                       ((pobjectdef(ppointerdef(p^.resulttype)^.definition)^.options and oo_hasvmt) <> 0)  then
+                       (oo_has_vmt in pobjectdef(ppointerdef(p^.resulttype)^.definition)^.objectoptions) then
                       Message(parser_w_use_extended_syntax_for_objects);
                     if (ppointerdef(p^.resulttype)^.definition^.deftype=orddef) and
                        (porddef(ppointerdef(p^.resulttype)^.definition)^.typ=uvoid) then
@@ -1056,7 +1058,7 @@ unit pstatmnt;
               code:=genzeronode(niln);
             _FAIL : begin
                        { internalerror(100); }
-                       if (aktprocsym^.definition^.options and poconstructor)=0 then
+                       if (aktprocsym^.definition^.proctypeoption<>potype_constructor) then
                         Message(parser_e_fail_only_in_constructor);
                        consume(_FAIL);
                        code:=genzeronode(failn);
@@ -1127,7 +1129,7 @@ unit pstatmnt;
 
       var
          funcretsym : pfuncretsym;
-         storepos : tfileposinfo; 
+         storepos : tfileposinfo;
 
       begin
          if procinfo.retdef<>pdef(voiddef) then
@@ -1265,16 +1267,16 @@ unit pstatmnt;
            { set the framepointer to esp for assembler functions }
            { but only if the are no local variables           }
            { added no parameter also (PM)                       }
-           if ((aktprocsym^.definition^.options and poassembler)<>0) and
-               (aktprocsym^.definition^.localst^.datasize=0) and
-               (aktprocsym^.definition^.parast^.datasize=0) and
-               not(ret_in_param(aktprocsym^.definition^.retdef)) then
-               begin
-                  procinfo.framepointer:=stack_pointer;
-                  { set the right value for parameters }
-                  dec(aktprocsym^.definition^.parast^.address_fixup,target_os.size_of_pointer);
-                  dec(procinfo.call_offset,target_os.size_of_pointer);
-              end;
+           if (po_assembler in aktprocsym^.definition^.procoptions) and
+              (aktprocsym^.definition^.localst^.datasize=0) and
+              (aktprocsym^.definition^.parast^.datasize=0) and
+              not(ret_in_param(aktprocsym^.definition^.retdef)) then
+             begin
+               procinfo.framepointer:=stack_pointer;
+               { set the right value for parameters }
+               dec(aktprocsym^.definition^.parast^.address_fixup,target_os.size_of_pointer);
+               dec(procinfo.call_offset,target_os.size_of_pointer);
+             end;
           { force the asm statement }
             if token<>_ASM then
              consume(_ASM);
@@ -1288,7 +1290,11 @@ unit pstatmnt;
 end.
 {
   $Log$
-  Revision 1.94  1999-08-03 17:09:39  florian
+  Revision 1.95  1999-08-03 22:03:03  peter
+    * moved bitmask constants to sets
+    * some other type/const renamings
+
+  Revision 1.94  1999/08/03 17:09:39  florian
     * the alpha compiler can be compiled now
 
   Revision 1.93  1999/08/02 21:28:59  florian

File diff suppressed because it is too large
+ 336 - 203
compiler/psub.pas


+ 12 - 8
compiler/psystem.pas

@@ -33,7 +33,7 @@ procedure createconstdefs;
 implementation
 
 uses
-  globtype,globals,tree;
+  globtype,globals,symconst,tree;
 
 procedure insertinternsyms(p : psymtable);
 {
@@ -74,7 +74,7 @@ procedure insert_intern_types(p : psymtable);
 }
 var
   { several defs to simulate more or less C++ objects for GDB }
-  vmtdef      : precdef;
+  vmtdef      : precorddef;
   pvmtdef     : ppointerdef;
   vmtarraydef : parraydef;
   vmtsymtable : psymtable;
@@ -87,7 +87,7 @@ begin
   p^.insert(new(ptypesym,init('ulong',u32bitdef)));
   p^.insert(new(ptypesym,init('longint',s32bitdef)));
   p^.insert(new(ptypesym,init('qword',cu64bitdef)));
-  p^.insert(new(ptypesym,init('int64',cs64bitintdef)));
+  p^.insert(new(ptypesym,init('int64',cs64bitdef)));
   p^.insert(new(ptypesym,init('char',cchardef)));
   p^.insert(new(ptypesym,init('shortstring',cshortstringdef)));
   p^.insert(new(ptypesym,init('longstring',clongstringdef)));
@@ -107,7 +107,7 @@ begin
   { Add a type for virtual method tables in lowercase }
   { so it isn't reachable!                            }
   vmtsymtable:=new(psymtable,init(recordsymtable));
-  vmtdef:=new(precdef,init(vmtsymtable));
+  vmtdef:=new(precorddef,init(vmtsymtable));
   pvmtdef:=new(ppointerdef,init(vmtdef));
   vmtsymtable^.insert(new(pvarsym,init('parent',pvmtdef)));
   vmtsymtable^.insert(new(pvarsym,init('length',globaldef('longint'))));
@@ -146,7 +146,7 @@ begin
   p^.insert(new(ptypesym,init('FIXED',new(pfloatdef,init(f32bit)))));
   p^.insert(new(ptypesym,init('FIXED16',new(pfloatdef,init(f16bit)))));
   p^.insert(new(ptypesym,init('QWORD',cu64bitdef)));
-  p^.insert(new(ptypesym,init('INT64',cs64bitintdef)));
+  p^.insert(new(ptypesym,init('INT64',cs64bitdef)));
   p^.insert(new(ptypesym,init('TYPEDFILE',new(pfiledef,init(ft_typed,voiddef)))));
 end;
 
@@ -161,7 +161,7 @@ begin
   u32bitdef:=porddef(globaldef('ulong'));
   s32bitdef:=porddef(globaldef('longint'));
   cu64bitdef:=porddef(globaldef('qword'));
-  cs64bitintdef:=porddef(globaldef('int64'));
+  cs64bitdef:=porddef(globaldef('int64'));
   cformaldef:=pformaldef(globaldef('formal'));
   voiddef:=porddef(globaldef('void'));
   cchardef:=porddef(globaldef('char'));
@@ -200,7 +200,7 @@ begin
   u32bitdef:=new(porddef,init(u32bit,0,$ffffffff));
   s32bitdef:=new(porddef,init(s32bit,$80000000,$7fffffff));
   cu64bitdef:=new(porddef,init(u64bit,0,0));
-  cs64bitintdef:=new(porddef,init(s64bitint,0,0));
+  cs64bitdef:=new(porddef,init(s64bit,0,0));
   booldef:=new(porddef,init(bool8bit,0,1));
   cchardef:=new(porddef,init(uchar,0,255));
   cshortstringdef:=new(pstringdef,shortinit(255));
@@ -238,7 +238,11 @@ end;
 end.
 {
   $Log$
-  Revision 1.25  1999-07-05 20:13:17  peter
+  Revision 1.26  1999-08-03 22:03:07  peter
+    * moved bitmask constants to sets
+    * some other type/const renamings
+
+  Revision 1.25  1999/07/05 20:13:17  peter
     * removed temp defines
 
   Revision 1.24  1999/07/01 15:49:20  florian

+ 17 - 31
compiler/ptconst.pas

@@ -35,8 +35,9 @@ unit ptconst;
 
     uses
        globtype,systems,tokens,
-       cobjects,globals,scanner,aasm,tree,pass_1,
-       types,verbose
+       cobjects,globals,scanner,
+       symconst,aasm,types,verbose,
+       tree,pass_1
        { parser specific stuff }
        ,pbase,pexpr
        { processor specific stuff }
@@ -85,12 +86,12 @@ unit ptconst;
              end;
         end;
 
-      function is_po_equal(o1,o2:longint):boolean;
+(*      function is_po_equal(o1,o2:longint):boolean;
         begin
         { assembler does not affect }
           is_po_equal:=(o1 and not(poassembler))=
                        (o2 and not(poassembler));
-        end;
+        end; *)
 
 {$R-}  {Range check creates problem with init_8bit(-1) !!}
       begin
@@ -157,7 +158,7 @@ unit ptconst;
                                 curconstsegment^.concat(new(pai_const,init_16bit(p^.value)));
                                 check_range;
                             end;
-                    s64bitint,
+                    s64bit,
                     u64bit:
                       begin
                          if not is_constintnode(p) then
@@ -581,27 +582,8 @@ unit ptconst;
                    pd:=pprocsym(srsym)^.definition;
                    if assigned(pd^.nextoverloaded) then
                      Message(parser_e_no_overloaded_procvars);
-                   if is_po_equal(pprocvardef(def)^.options,pd^.options) and
-                      is_equal(pprocvardef(def)^.retdef,pd^.retdef) then
-                     begin
-                       hp1:=pprocvardef(def)^.para1;
-                       hp2:=pd^.para1;
-                       while assigned(hp1) and assigned(hp2) do
-                        begin
-                          if not(is_equal(hp1^.data,hp2^.data)) or
-                             not(hp1^.paratyp=hp2^.paratyp) then
-                            begin
-                              Message(type_e_mismatch);
-                              break;
-                            end;
-                           hp1:=hp1^.next;
-                           hp2:=hp2^.next;
-                         end;
-                        if not((hp1=nil) and (hp2=nil)) then
-                          Message(type_e_mismatch);
-                     end
-                   else
-                     Message(type_e_mismatch);
+                   if not proc_to_procvar_equal(pd,pprocvardef(def)) then
+                     Message2(type_e_incompatible_types,pd^.typename,pprocvardef(def)^.typename);
                    curconstsegment^.concat(new(pai_const_symbol,initname(pd^.mangledname)));
                 end;
            end;
@@ -615,7 +597,7 @@ unit ptconst;
                    s:=pattern;
                    consume(ID);
                    consume(COLON);
-                   srsym:=precdef(def)^.symtable^.search(s);
+                   srsym:=precorddef(def)^.symtable^.search(s);
                    if srsym=nil then
                      begin
                         Message1(sym_e_id_not_found,s);
@@ -650,7 +632,7 @@ unit ptconst;
          { reads a typed object }
          objectdef:
            begin
-              if (pobjectdef(def)^.options and (oo_hasvmt or oo_is_class))<>0 then
+              if ([oo_has_vmt,oo_is_class]*pobjectdef(def)^.objectoptions)<>[] then
                 begin
                    Message(parser_e_type_const_not_possible);
                    consume_all_until(RKLAMMER);
@@ -666,14 +648,14 @@ unit ptconst;
                         consume(COLON);
                         srsym:=nil;
                         obj:=pobjectdef(def);
-                        symt:=obj^.publicsyms;
+                        symt:=obj^.symtable;
                         while (srsym=nil) and assigned(symt) do
                           begin
                              srsym:=symt^.search(s);
                              if assigned(obj) then
                                obj:=obj^.childof;
                              if assigned(obj) then
-                               symt:=obj^.publicsyms
+                               symt:=obj^.symtable
                              else
                                symt:=nil;
                           end;
@@ -725,7 +707,11 @@ unit ptconst;
 end.
 {
   $Log$
-  Revision 1.48  1999-07-23 16:05:26  peter
+  Revision 1.49  1999-08-03 22:03:08  peter
+    * moved bitmask constants to sets
+    * some other type/const renamings
+
+  Revision 1.48  1999/07/23 16:05:26  peter
     * alignment is now saved in the symtable
     * C alignment added for records
     * PPU version increased to solve .12 <-> .13 probs

+ 6 - 2
compiler/ra386att.pas

@@ -37,7 +37,7 @@ Implementation
 Uses
   globtype,
   strings,cobjects,systems,verbose,globals,
-  files,aasm,types,symtable,scanner,hcodegen
+  files,aasm,types,symconst,symtable,scanner,hcodegen
   ,i386base
   ,rautils,ra386;
 
@@ -1955,7 +1955,11 @@ begin
 end.
 {
   $Log$
-  Revision 1.54  1999-07-24 11:17:12  peter
+  Revision 1.55  1999-08-03 22:03:09  peter
+    * moved bitmask constants to sets
+    * some other type/const renamings
+
+  Revision 1.54  1999/07/24 11:17:12  peter
     * suffix parsing for at&t fixed for things like movsbl
     * string constants are now handle correctly and also allowed in
       constant expressions

+ 10 - 6
compiler/ra386dir.pas

@@ -34,7 +34,7 @@ unit Ra386dir;
      uses
         files,hcodegen,globals,scanner,aasm
         ,i386base,i386asm
-        ,cobjects,symtable,types,verbose,
+        ,cobjects,symconst,symtable,types,verbose,
         rautils,ra386;
 
     function assemble : ptree;
@@ -161,11 +161,11 @@ unit Ra386dir;
                                              {variables set are after a comma }
                                              {like in movl %eax,I }
                                              if pos(',',s) > 0 then
-                                               pvarsym(sym)^.is_valid:=1
+                                               pvarsym(sym)^.varstate:=vs_used
                                              else
-                                             if (pos('MOV',upper(s)) > 0) and (pvarsym(sym)^.is_valid=0) then
+                                             if (pos('MOV',upper(s)) > 0) and (pvarsym(sym)^.varstate=vs_declared) then
                                               Message1(sym_n_uninitialized_local_variable,hs);
-                                             if ((pvarsym(sym)^.var_options and vo_is_external)<>0) then
+                                             if (vo_is_external in pvarsym(sym)^.varoptions) then
                                                hs:=pvarsym(sym)^.mangledname
                                              else
                                                hs:='-'+tostr(pvarsym(sym)^.address)+'('+att_reg2str[procinfo.framepointer]+')';
@@ -193,7 +193,7 @@ unit Ra386dir;
                                                      inc(l,aktprocsym^.definition^.parast^.address_fixup);
                                                      hs:=tostr(l)+'('+att_reg2str[procinfo.framepointer]+')';
                                                      if pos(',',s) > 0 then
-                                                       pvarsym(sym)^.is_valid:=1;
+                                                       pvarsym(sym)^.varstate:=vs_used;
                                                   end;
                                              end
                                       { I added that but it creates a problem in line.ppi
@@ -291,7 +291,11 @@ unit Ra386dir;
 end.
 {
   $Log$
-  Revision 1.21  1999-05-27 19:44:57  peter
+  Revision 1.22  1999-08-03 22:03:11  peter
+    * moved bitmask constants to sets
+    * some other type/const renamings
+
+  Revision 1.21  1999/05/27 19:44:57  peter
     * removed oldasm
     * plabel -> pasmlabel
     * -a switches to source writing automaticly

+ 19 - 14
compiler/rautils.pas

@@ -24,9 +24,10 @@ Unit RAUtils;
 Interface
 
 Uses
-  globtype,systems,
-  symtable,aasm,hcodegen,verbose,globals,files,strings,
-  cobjects
+  strings,
+  cobjects,
+  globtype,systems,verbose,globals,files,
+  symconst,symtable,aasm,hcodegen
 {$ifdef i386}
   ,i386base,i386asm
 {$endif}
@@ -737,7 +738,7 @@ Begin
       begin
         { we always assume in asm statements that     }
         { that the variable is valid.                 }
-        pvarsym(sym)^.is_valid:=1;
+        pvarsym(sym)^.varstate:=vs_used;
         inc(pvarsym(sym)^.refs);
         case pvarsym(sym)^.owner^.symtabletype of
           unitsymtable,
@@ -753,7 +754,7 @@ Begin
             end;
           localsymtable :
             begin
-              if (pvarsym(sym)^.var_options and vo_is_external)<>0 then
+              if (vo_is_external in pvarsym(sym)^.varoptions) then
                 opr.ref.symbol:=newasmsymbol(pvarsym(sym)^.mangledname)
               else
                 begin
@@ -1138,27 +1139,27 @@ Begin
       begin
         case pvarsym(sym)^.definition^.deftype of
           recorddef :
-            st:=precdef(pvarsym(sym)^.definition)^.symtable;
+            st:=precorddef(pvarsym(sym)^.definition)^.symtable;
           objectdef :
-            st:=pobjectdef(pvarsym(sym)^.definition)^.publicsyms;
+            st:=pobjectdef(pvarsym(sym)^.definition)^.symtable;
         end;
       end;
     typesym :
       begin
         case ptypesym(sym)^.definition^.deftype of
           recorddef :
-            st:=precdef(ptypesym(sym)^.definition)^.symtable;
+            st:=precorddef(ptypesym(sym)^.definition)^.symtable;
           objectdef :
-            st:=pobjectdef(ptypesym(sym)^.definition)^.publicsyms;
+            st:=pobjectdef(ptypesym(sym)^.definition)^.symtable;
         end;
       end;
     typedconstsym :
       begin
         case pvarsym(sym)^.definition^.deftype of
           recorddef :
-            st:=precdef(ptypedconstsym(sym)^.definition)^.symtable;
+            st:=precorddef(ptypedconstsym(sym)^.definition)^.symtable;
           objectdef :
-            st:=pobjectdef(ptypedconstsym(sym)^.definition)^.publicsyms;
+            st:=pobjectdef(ptypedconstsym(sym)^.definition)^.symtable;
         end;
       end;
   end;
@@ -1180,9 +1181,9 @@ Begin
            Size:=PVarsym(sym)^.getsize;
            case pvarsym(sym)^.definition^.deftype of
              recorddef :
-               st:=precdef(pvarsym(sym)^.definition)^.symtable;
+               st:=precorddef(pvarsym(sym)^.definition)^.symtable;
              objectdef :
-               st:=pobjectdef(pvarsym(sym)^.definition)^.publicsyms;
+               st:=pobjectdef(pvarsym(sym)^.definition)^.symtable;
            end;
          end;
      end;
@@ -1383,7 +1384,11 @@ end;
 end.
 {
   $Log$
-  Revision 1.20  1999-07-29 20:54:06  peter
+  Revision 1.21  1999-08-03 22:03:12  peter
+    * moved bitmask constants to sets
+    * some other type/const renamings
+
+  Revision 1.20  1999/07/29 20:54:06  peter
     * write .size also
 
   Revision 1.19  1999/06/02 22:44:17  pierre

+ 116 - 90
compiler/symconst.inc

@@ -19,99 +19,125 @@
     Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  ****************************************************************************
 }
-
-    const
-       def_alignment = 4;
-
-       { symbol options }
-       { this is only for object/class }
-       sp_public     = $1;
-       sp_private    = $2;
-       sp_published  = $4;
-       sp_protected  = $8;
-       sp_forwarddef = $10;
-       sp_static     = $20;
-       { this is for typesym }
-       { to know who is the primary symbol of a def }
-       sp_primary_typesym = $40;
-
-       { flags for a definition }
-       df_needsrtti = $1;           { the definitions needs rtti }
-       df_hasrtti   = $2;           { the rtti is generated      }
-
-       { options for tprocdef and tprocvardef }
-       poexceptions     = $1;        { unused }
-       povirtualmethod  = $2;        { Procedure is a virtual method }
-       poclearstack     = $4;        { Use IBM flat calling convention. (Used by GCC.) }
-       poconstructor    = $8;        { Procedure is a constructor }
-       podestructor     = $10;       { Procedure is a destructor }
-       pointernproc     = $20;       { Procedure has compiler magic}
-       poexports        = $40;       { Procedure is exported }
-       poiocheck        = $80;       { IO checking should be done after a call to the procedure }
-       poabstractmethod = $100;      { Procedure is an abstract method }
-       pointerrupt      = $200;      { Procedure is an interrupt handler }
-       poinline         = $400;      { Procedure is an assembler macro }
-       poassembler      = $800;      { Procedure is written in assembler }
-       pooperator       = $1000;     { Procedure defines an operator }
-       poexternal       = $2000;     { Procedure is external (in other object or lib)}
-       poleftright      = $4000;     { Push parameters from left to right }
-       poproginit       = $8000;     { Program initialization }
-       postaticmethod   = $10000;    { static method }
-       pooverridingmethod=$20000;    { method with override directive }
-       poclassmethod    = $40000;    { class method }
-       pounitinit       = $80000;    { unit initialization }
-       pomethodpointer  = $100000;   { method pointer, only in procvardef, also used for 'with object do' }
-       pocdecl          = $200000;   { procedure uses C styled calling }
-       popalmossyscall  = $400000;   { procedure is a PalmOS system call }
-       pointernconst    = $800000;   { procedure has constant evaluator intern }
-       poregister       = $1000000;  { procedure uses register (fastcall) calling }
-       pounitfinalize   = $2000000;  { unit finalization }
-       postdcall        = $4000000;  { procedure uses stdcall call }
-       pomsgstr         = $8000000;  { method for string message handling }
-       pomsgint         = $10000000; { method for int message handling }
-       posavestdregs    = $20000000; { save std regs cdecl and stdcall need that ! }
-       pocontainsself   = $40000000; { self is passed explicit to the compiler }
-       posafecall       = $80000000; { safe call calling conventions }
-
-       { relevant options for assigning a proc or a procvar to a procvar }
-       po_compatibility_options = $7FFFFFFF-
-         (poassembler+pomsgstr+pomsgint+
-          povirtualmethod+pooverridingmethod+poexternal);
-
-       { options for objects and classes }
-       oo_is_abstract  = $1;         { true, if the object/class has an abstract }
-                                     { method => no instances can be created     }
-       oo_is_class     = $2;
-       oo_hasvirtual   = $4;         { true, if the object/class has virtual methods }
-       oo_hasprivate   = $8;
-       oo_hasprotected = $10;
-       oo_isforward    = $20;        { true, if the class is only a forward declared yet }
-       oo_can_have_published = $40;  { true, if the class has rtti, i.e. you             }
-                                     { can publish properties                            }
-       oo_hasconstructor = $80;      { true, if the object/class has a constructor }
-       oo_hasdestructor = $100;      { true, if the object/class has a destructor }
-       oo_hasvmt        = $200;      { true, if the object/class has a vmt }
-       oo_hasmsgstr     = $400;
-       oo_hasmsgint     = $800;
-       oo_cppvmt        = $1000;     { true, if the object/class uses an C++ compatible }
-                                     { vmt, all members of the same class tree          }
-                                     { must use then a C++ compatible vmt               }
-
-       { options for properties }
-       ppo_indexed = $1;
-       ppo_defaultproperty = $2;
-       ppo_stored = $4;
-
-       { options for variables }
-       vo_regable     = $1;
-       vo_is_C_var    = $2;
-       vo_is_external = $4;
-       vo_is_dll_var  = $8;
-       vo_is_thread_var = $10;
+unit symconst;
+interface
+
+type
+  { calling convention for tprocdef and tprocvardef }
+  pocalloption=(pocall_none,
+    pocall_clearstack,    { Use IBM flat calling convention. (Used by GCC.) }
+    pocall_leftright,     { Push parameters from left to right }
+    pocall_cdecl,         { procedure uses C styled calling }
+    pocall_register,      { procedure uses register (fastcall) calling }
+    pocall_stdcall,       { procedure uses stdcall call }
+    pocall_safecall,      { safe call calling conventions }
+    pocall_palmossyscall  { procedure is a PalmOS system call }
+  );
+
+  { basic type for tprocdef and tprocvardef }
+  potypeoption=(potype_none,
+    potype_proginit,     { Program initialization }
+    potype_unitinit,     { unit initialization }
+    potype_unitfinalize, { unit finalization }
+    potype_constructor,  { Procedure is a constructor }
+    potype_destructor,   { Procedure is a destructor }
+    potype_internproc,   { Procedure has compiler magic}
+    potype_internconst,  { procedure has constant evaluator intern }
+    potype_operator      { Procedure defines an operator }
+  );
+
+  { other options for tprocdef and tprocvardef }
+  pooption=(po_none,
+    po_classmethod,       { class method }
+    po_virtualmethod,     { Procedure is a virtual method }
+    po_abstractmethod,    { Procedure is an abstract method }
+    po_staticmethod,      { static method }
+    po_overridingmethod,  { method with override directive }
+    po_inline,            { Procedure is an assembler macro }
+    po_methodpointer,     { method pointer, only in procvardef, also used for 'with object do' }
+    po_containsself,      { self is passed explicit to the compiler }
+    po_interrupt,         { Procedure is an interrupt handler }
+    po_iocheck,           { IO checking should be done after a call to the procedure }
+    po_assembler,         { Procedure is written in assembler }
+    po_msgstr,            { method for string message handling }
+    po_msgint,            { method for int message handling }
+    po_exports,           { Procedure has export directive (needed for OS/2) }
+    po_external,          { Procedure is external (in other object or lib)}
+    po_savestdregs,       { save std regs cdecl and stdcall need that ! }
+    po_saveregisters      { save all registers }
+  );
+  pooptions=set of pooption;
+
+  { symbol options }
+  spoption=(sp_none,
+    sp_public,
+    sp_private,
+    sp_published,
+    sp_protected,
+    sp_forwarddef,
+    sp_static
+    sp_primary_typesym; { this is for typesym, to know who is the primary symbol of a def }
+  );
+  spoptions=set of spoption;
+
+  { options for objects and classes }
+  oooption=(
+    oo_is_class,
+    oo_is_forward,         { the class is only a forward declared yet }
+    oo_has_virtual,        { the object/class has virtual methods }
+    oo_has_private,
+    oo_has_protected,
+    oo_has_constructor,    { the object/class has a constructor }
+    oo_has_destructor,     { the object/class has a destructor }
+    oo_has_vmt,            { the object/class has a vmt }
+    oo_has_msgstr,
+    oo_has_msgint,
+    oo_has_abstract,       { the object/class has an abstract method => no instances can be created }
+    oo_can_have_published, { the class has rtti, i.e. you can publish properties }
+    oo_cppvmt,             { the object/class uses an C++ compatible }
+                           { vmt, all members of the same class tree }
+                           { must use then a C++ compatible vmt      }
+  );
+  oooptions=set of oooption;
+
+const
+  def_alignment = 4;
+
+  { flags for a definition }
+  df_needsrtti = $1;           { the definitions needs rtti }
+  df_hasrtti   = $2;           { the rtti is generated      }
+
+  { relevant options for assigning a proc or a procvar to a procvar }
+  po_compatibility_options = [
+    po_classmethod,
+    po_staticmethod,
+    po_inline,
+    po_methodpointer,
+    po_containsself,
+    po_interrupt,
+    po_iocheck,
+    po_exports,
+  ];
+
+  { options for properties }
+  ppo_indexed = $1;
+  ppo_defaultproperty = $2;
+  ppo_stored = $4;
+
+  { options for variables }
+  vo_regable     = $1;
+  vo_is_C_var    = $2;
+  vo_is_external = $4;
+  vo_is_dll_var  = $8;
+  vo_is_thread_var = $10;
 
 {
   $Log$
-  Revision 1.12  1999-07-06 21:48:26  florian
+  Revision 1.13  1999-08-03 22:03:13  peter
+    * moved bitmask constants to sets
+    * some other type/const renamings
+
+  Revision 1.12  1999/07/06 21:48:26  florian
     * a lot bug fixes:
        - po_external isn't any longer necessary for procedure compatibility
        - m_tp_procvar is in -Sd now available

+ 187 - 0
compiler/symconst.pas

@@ -0,0 +1,187 @@
+{
+    $Id$
+    Copyright (c) 1993-98 by Florian Klaempfl, Pierre Muller
+
+    Symbol table constants
+
+    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 symconst;
+interface
+
+const
+  def_alignment = 4;
+
+type
+  { symbol options }
+  tsymoption=(sp_none,
+    sp_public,
+    sp_private,
+    sp_published,
+    sp_protected,
+    sp_forwarddef,
+    sp_static,
+    sp_primary_typesym    { this is for typesym, to know who is the primary symbol of a def }
+  );
+  tsymoptions=set of tsymoption;
+
+  { flags for a definition }
+  tdefoption=(df_none,
+    df_need_rtti,          { the definitions needs rtti }
+    df_has_rtti            { the rtti is generated      }
+  );
+  tdefoptions=set of tdefoption;
+
+  { base types for orddef }
+  tbasetype = (
+    uauto,uvoid,uchar,
+    u8bit,u16bit,u32bit,
+    s8bit,s16bit,s32bit,
+    bool8bit,bool16bit,bool32bit,
+    u64bit,s64bit
+  );
+
+  { float types }
+  tfloattype = (
+    s32real,s64real,s80real,
+    s64comp,
+    f16bit,f32bit
+  );
+
+  { string types }
+  tstringtype = (
+    st_shortstring, st_longstring, st_ansistring, st_widestring
+  );
+
+  { set types }
+  tsettype = (
+    normset,smallset,varset
+  );
+
+  { calling convention for tprocdef and tprocvardef }
+  tproccalloption=(pocall_none,
+    pocall_clearstack,    { Use IBM flat calling convention. (Used by GCC.) }
+    pocall_leftright,     { Push parameters from left to right }
+    pocall_cdecl,         { procedure uses C styled calling }
+    pocall_register,      { procedure uses register (fastcall) calling }
+    pocall_stdcall,       { procedure uses stdcall call }
+    pocall_safecall,      { safe call calling conventions }
+    pocall_palmossyscall, { procedure is a PalmOS system call }
+    pocall_system,
+    pocall_inline,        { Procedure is an assembler macro }
+    pocall_internproc,    { Procedure has compiler magic}
+    pocall_internconst    { procedure has constant evaluator intern }
+  );
+  tproccalloptions=set of tproccalloption;
+
+  { basic type for tprocdef and tprocvardef }
+  tproctypeoption=(potype_none,
+    potype_proginit,     { Program initialization }
+    potype_unitinit,     { unit initialization }
+    potype_unitfinalize, { unit finalization }
+    potype_constructor,  { Procedure is a constructor }
+    potype_destructor,   { Procedure is a destructor }
+    potype_operator      { Procedure defines an operator }
+  );
+  tproctypeoptions=set of tproctypeoption;
+
+  { other options for tprocdef and tprocvardef }
+  tprocoption=(po_none,
+    po_classmethod,       { class method }
+    po_virtualmethod,     { Procedure is a virtual method }
+    po_abstractmethod,    { Procedure is an abstract method }
+    po_staticmethod,      { static method }
+    po_overridingmethod,  { method with override directive }
+    po_methodpointer,     { method pointer, only in procvardef, also used for 'with object do' }
+    po_containsself,      { self is passed explicit to the compiler }
+    po_interrupt,         { Procedure is an interrupt handler }
+    po_iocheck,           { IO checking should be done after a call to the procedure }
+    po_assembler,         { Procedure is written in assembler }
+    po_msgstr,            { method for string message handling }
+    po_msgint,            { method for int message handling }
+    po_exports,           { Procedure has export directive (needed for OS/2) }
+    po_external,          { Procedure is external (in other object or lib)}
+    po_savestdregs,       { save std regs cdecl and stdcall need that ! }
+    po_saveregisters      { save all registers }
+  );
+  tprocoptions=set of tprocoption;
+
+  { options for objects and classes }
+  tobjectoption=(oo_none,
+    oo_is_class,
+    oo_is_forward,         { the class is only a forward declared yet }
+    oo_has_virtual,        { the object/class has virtual methods }
+    oo_has_private,
+    oo_has_protected,
+    oo_has_constructor,    { the object/class has a constructor }
+    oo_has_destructor,     { the object/class has a destructor }
+    oo_has_vmt,            { the object/class has a vmt }
+    oo_has_msgstr,
+    oo_has_msgint,
+    oo_has_abstract,       { the object/class has an abstract method => no instances can be created }
+    oo_can_have_published, { the class has rtti, i.e. you can publish properties }
+    oo_cppvmt              { the object/class uses an C++ compatible }
+                           { vmt, all members of the same class tree }
+                           { must use then a C++ compatible vmt      }
+  );
+  tobjectoptions=set of tobjectoption;
+
+  { options for properties }
+  tpropertyoption=(ppo_none,
+    ppo_indexed,
+    ppo_defaultproperty,
+    ppo_stored
+  );
+  tpropertyoptions=set of tpropertyoption;
+
+  { options for variables }
+  tvaroption=(vo_none,
+    vo_regable,
+    vo_is_C_var,
+    vo_is_external,
+    vo_is_dll_var,
+    vo_is_thread_var
+  );
+  tvaroptions=set of tvaroption;
+
+  { State of the variable, if it's declared, assigned or used }
+  tvarstate=(vs_none,
+    vs_declared,vs_declared2,vs_assigned,vs_used
+  );
+
+const
+  { relevant options for assigning a proc or a procvar to a procvar }
+  po_compatibility_options = [
+    po_classmethod,
+    po_staticmethod,
+    po_methodpointer,
+    po_containsself,
+    po_interrupt,
+    po_iocheck,
+    po_exports
+  ];
+
+implementation
+
+end.
+{
+  $Log$
+  Revision 1.1  1999-08-03 22:03:14  peter
+    * moved bitmask constants to sets
+    * some other type/const renamings
+
+}
+

+ 251 - 221
compiler/symdef.inc

@@ -995,7 +995,7 @@
                 bool32bit:
                   savesize:=4;
 
-                u64bit,s64bitint:
+                u64bit,s64bit:
                   savesize:=8;
              else
                savesize:=0;
@@ -1072,7 +1072,7 @@
         bool16bit : stabstring := strpnew('-22;');
         bool32bit : stabstring := strpnew('-23;');
         u64bit    : stabstring := strpnew('-32;');
-        s64bitint : stabstring := strpnew('-31;');
+        s64bit    : stabstring := strpnew('-31;');
 {$endif not Use_integer_types_for_boolean}
          { u32bit : stabstring := strpnew('r'+
               s32bitdef^.numberstring+';0;-1;'); }
@@ -1570,7 +1570,12 @@
 {$ifdef GDB}
     function tsetdef.stabstring : pchar;
       begin
-         stabstring := strpnew('S'+setof^.numberstring);
+         { For small sets write a longint, which can at least be seen
+           in the current GDB's (PFV) }
+         if settype=smallset then
+           stabstring := strpnew('r'+s32bitdef^.numberstring+';0;0xffffffff;')
+         else
+           stabstring := strpnew('S'+setof^.numberstring);
       end;
 
 
@@ -1842,10 +1847,10 @@
       end;
 
 {***************************************************************************
-                                  TRECDEF
+                                  trecorddef
 ***************************************************************************}
 
-    constructor trecdef.init(p : psymtable);
+    constructor trecorddef.init(p : psymtable);
       begin
          inherited init;
          deftype:=recorddef;
@@ -1855,7 +1860,7 @@
       end;
 
 
-    constructor trecdef.load;
+    constructor trecorddef.load;
       var
          oldread_member : boolean;
       begin
@@ -1870,7 +1875,7 @@
       end;
 
 
-    destructor trecdef.done;
+    destructor trecorddef.done;
       begin
          if assigned(symtable) then
            dispose(symtable,done);
@@ -1886,12 +1891,12 @@
       begin
          if (psym(s)^.typ=varsym) and
             ((pvarsym(s)^.definition^.deftype<>objectdef) or
-             not(pobjectdef(pvarsym(s)^.definition)^.isclass)) then
+             not(pobjectdef(pvarsym(s)^.definition)^.is_class)) then
             binittable:=pvarsym(s)^.definition^.needs_inittable;
       end;
 
 
-    function trecdef.needs_inittable : boolean;
+    function trecorddef.needs_inittable : boolean;
       var
          oldb : boolean;
       begin
@@ -1907,7 +1912,7 @@
       end;
 
 
-    procedure trecdef.deref;
+    procedure trecorddef.deref;
       var
          oldrecsyms : psymtable;
       begin
@@ -1919,7 +1924,7 @@
       end;
 
 
-    procedure trecdef.write;
+    procedure trecorddef.write;
       var
          oldread_member : boolean;
       begin
@@ -1932,13 +1937,13 @@
          read_member:=oldread_member;
       end;
 
-    function trecdef.size:longint;
+    function trecorddef.size:longint;
       begin
         size:=symtable^.datasize;
       end;
 
 
-    function trecdef.alignment:longint;
+    function trecorddef.alignment:longint;
       begin
         alignment:=symtable^.dataalignment;
       end;
@@ -1955,11 +1960,11 @@
       size : longint;
     begin
     { static variables from objects are like global objects }
-    if ((psym(p)^.properties and sp_static)<>0) then
+    if (sp_static in psym(p)^.symoptions) then
       exit;
-    if ((psym(p)^.properties and sp_protected)<>0) then
+    if (sp_protected in psym(p)^.symoptions) then
       spec:='/1'
-    else if ((psym(p)^.properties and sp_private)<>0) then
+    else if (sp_private in psym(p)^.symoptions) then
       spec:='/0'
     else
       spec:='';
@@ -1989,7 +1994,7 @@
     end;
 
 
-    function trecdef.stabstring : pchar;
+    function trecorddef.stabstring : pchar;
       Var oldrec : pchar;
           oldsize : longint;
       begin
@@ -2010,7 +2015,7 @@
       end;
 
 
-    procedure trecdef.concatstabto(asmlist : paasmoutput);
+    procedure trecorddef.concatstabto(asmlist : paasmoutput);
       begin
         if (not assigned(sym) or sym^.isusedinstab or (cs_gdb_dbx in aktglobalswitches)) and
            (not is_def_stab_written) then
@@ -2068,19 +2073,19 @@
       end;
 
 
-    procedure trecdef.write_child_rtti_data;
+    procedure trecorddef.write_child_rtti_data;
       begin
          symtable^.foreach({$ifndef TP}@{$endif}generate_child_rtti);
       end;
 
 
-    procedure trecdef.write_child_init_data;
+    procedure trecorddef.write_child_init_data;
       begin
          symtable^.foreach({$ifndef TP}@{$endif}generate_child_inittable);
       end;
 
 
-    procedure trecdef.write_rtti_data;
+    procedure trecorddef.write_rtti_data;
       begin
          rttilist^.concat(new(pai_const,init_8bit(tkrecord)));
          write_rtti_name;
@@ -2092,7 +2097,7 @@
       end;
 
 
-    procedure trecdef.write_init_data;
+    procedure trecorddef.write_init_data;
       begin
          rttilist^.concat(new(pai_const,init_8bit(14)));
          write_rtti_name;
@@ -2103,7 +2108,7 @@
          symtable^.foreach({$ifndef TP}@{$endif}write_field_inittable);
       end;
 
-    function trecdef.gettypename : string;
+    function trecorddef.gettypename : string;
 
       begin
          gettypename:='<record type>'
@@ -2114,17 +2119,6 @@
                        TABSTRACTPROCDEF
 ***************************************************************************}
 
-    constructor tabstractprocdef.init;
-      begin
-         inherited init;
-         para1:=nil;
-         fpu_used:=0;
-         options:=0;
-         retdef:=voiddef;
-         savesize:=target_os.size_of_pointer;
-      end;
-
-
     procedure disposepdefcoll(var para1 : pdefcoll);
       var
          hp : pdefcoll;
@@ -2138,6 +2132,20 @@
            end;
       end;
 
+
+    constructor tabstractprocdef.init;
+      begin
+         inherited init;
+         para1:=nil;
+         fpu_used:=0;
+         proctypeoption:=potype_none;
+         proccalloptions:=[];
+         procoptions:=[];
+         retdef:=voiddef;
+         savesize:=target_os.size_of_pointer;
+      end;
+
+
     destructor tabstractprocdef.done;
       begin
          disposepdefcoll(para1);
@@ -2158,6 +2166,7 @@
          para1:=hp;
       end;
 
+
     procedure tabstractprocdef.concattypesym(p : ptypesym;vsp : tvarspez);
       var
          hp : pdefcoll;
@@ -2171,6 +2180,7 @@
          para1:=hp;
       end;
 
+
     { all functions returning in FPU are
       assume to use 2 FPU registers
       until the function implementation
@@ -2211,7 +2221,9 @@
          inherited load;
          retdef:=readdefref;
          fpu_used:=readbyte;
-         options:=readlong;
+         proctypeoption:=tproctypeoption(readlong);
+         readsmallset(proccalloptions);
+         readsmallset(procoptions);
          count:=readword;
          para1:=nil;
          savesize:=target_os.size_of_pointer;
@@ -2233,29 +2245,6 @@
       end;
 
 
-    function tabstractprocdef.para_size : longint;
-      var
-         pdc : pdefcoll;
-         l : longint;
-      begin
-         l:=0;
-         pdc:=para1;
-         while assigned(pdc) do
-          begin
-            case pdc^.paratyp of
-              vs_var   : inc(l,target_os.size_of_pointer);
-              vs_value,
-              vs_const : if push_addr_param(pdc^.data) then
-                          inc(l,target_os.size_of_pointer)
-                         else
-                          inc(l,align(pdc^.data^.size,target_os.stackalignment));
-            end;
-            pdc:=pdc^.next;
-          end;
-         para_size:=l;
-      end;
-
-
     procedure tabstractprocdef.write;
       var
          count : word;
@@ -2265,7 +2254,9 @@
          writedefref(retdef);
          current_ppu^.do_interface_crc:=false;
          writebyte(fpu_used);
-         writelong(options);
+         writelong(ord(proctypeoption));
+         writesmallset(proccalloptions);
+         writesmallset(procoptions);
          hp:=para1;
          count:=0;
          while assigned(hp) do
@@ -2294,6 +2285,29 @@
       end;
 
 
+    function tabstractprocdef.para_size : longint;
+      var
+         pdc : pdefcoll;
+         l : longint;
+      begin
+         l:=0;
+         pdc:=para1;
+         while assigned(pdc) do
+          begin
+            case pdc^.paratyp of
+              vs_var   : inc(l,target_os.size_of_pointer);
+              vs_value,
+              vs_const : if push_addr_param(pdc^.data) then
+                          inc(l,target_os.size_of_pointer)
+                         else
+                          inc(l,align(pdc^.data^.size,target_os.stackalignment));
+            end;
+            pdc:=pdc^.next;
+          end;
+         para_size:=l;
+      end;
+
+
     function tabstractprocdef.demangled_paras : string;
 
       var s : string;
@@ -2428,7 +2442,9 @@
          _class := pobjectdef(readdefref);
          readposinfo(fileinfo);
 
-         if (cs_link_deffile in aktglobalswitches) and ((options and poexports)<>0) then
+         if (cs_link_deffile in aktglobalswitches) and
+            (tf_need_export in target_info.flags) and
+            (po_exports in procoptions) then
            deffile.AddExport(mangledname);
 
          parast:=nil;
@@ -2526,9 +2542,9 @@ Const local_symtable_index : longint = $8001;
              if (owner^.symtabletype<>localsymtable) then
                while assigned(pdo) do
                  begin
-                    if pdo^.publicsyms<>aktrecordsymtable then
+                    if pdo^.symtable<>aktrecordsymtable then
                       begin
-                         pdo^.publicsyms^.unitid:=local_symtable_index;
+                         pdo^.symtable^.unitid:=local_symtable_index;
                          inc(local_symtable_index);
                       end;
                     pdo:=pdo^.childof;
@@ -2554,7 +2570,7 @@ Const local_symtable_index : longint = $8001;
              if (owner^.symtabletype<>localsymtable) then
                while assigned(pdo) do
                  begin
-                    if pdo^.publicsyms<>aktrecordsymtable then
+                    if pdo^.symtable<>aktrecordsymtable then
                       dec(local_symtable_index);
                     pdo:=pdo^.childof;
                  end;
@@ -2590,9 +2606,9 @@ Const local_symtable_index : longint = $8001;
            dispose(parast,done);
          if assigned(localst) and (localst^.symtabletype<>staticsymtable) then
            dispose(localst,done);
-         if ((options and poinline) <> 0) and assigned(code) then
+         if (pocall_inline in proccalloptions) and assigned(code) then
            disposetree(ptree(code));
-         if (options and pomsgstr)<>0 then
+         if (po_msgstr in procoptions) then
            strdispose(messageinf.str);
          if
 {$ifdef tp}
@@ -2625,7 +2641,7 @@ Const local_symtable_index : longint = $8001;
          writestring(mangledname);
          current_ppu^.do_interface_crc:=true;
          writelong(extnumber);
-         if (options and pooperator) = 0 then
+         if (proctypeoption<>potype_operator) then
            writedefref(nextoverloaded)
          else
            begin
@@ -2638,7 +2654,7 @@ Const local_symtable_index : longint = $8001;
            end;
          writedefref(_class);
          writeposinfo(fileinfo);
-         if (options and poinline) <> 0 then
+         if (pocall_inline in proccalloptions) then
            begin
               { we need to save
                 - the para and the local symtable
@@ -2830,10 +2846,10 @@ Const local_symtable_index : longint = $8001;
 
     function tprocvardef.size : longint;
       begin
-         if (options and pomethodpointer)=0 then
-           size:=target_os.size_of_pointer
+         if (po_methodpointer in procoptions) then
+           size:=2*target_os.size_of_pointer
          else
-           size:=2*target_os.size_of_pointer;
+           size:=target_os.size_of_pointer;
       end;
 
 
@@ -2904,9 +2920,10 @@ Const local_symtable_index : longint = $8001;
 
     function tprocvardef.is_publishable : boolean;
       begin
-         is_publishable:=(options and pomethodpointer)<>0;
+         is_publishable:=(po_methodpointer in procoptions);
       end;
 
+
     function tprocvardef.gettypename : string;
 
       begin
@@ -2931,52 +2948,20 @@ Const local_symtable_index : longint = $8001;
      begin
         tdef.init;
         deftype:=objectdef;
-        options:=0;
+        objectoptions:=[];
         childof:=nil;
-        publicsyms:=new(psymtable,init(objectsymtable));
-        publicsyms^.name := stringdup(n);
+        symtable:=new(psymtable,init(objectsymtable));
+        symtable^.name := stringdup(n);
         { create space for vmt !! }
-        options:=0;
         vmt_offset:=0;
-        publicsyms^.datasize:=0;
-        publicsyms^.defowner:=@self;
-        publicsyms^.dataalignment:=packrecordalignment[aktpackrecords];
+        symtable^.datasize:=0;
+        symtable^.defowner:=@self;
+        symtable^.dataalignment:=packrecordalignment[aktpackrecords];
         set_parent(c);
         objname:=stringdup(n);
      end;
 
 
-    procedure tobjectdef.set_parent( c : pobjectdef);
-      begin
-        { nothing to do if the parent was not forward !}
-        if assigned(childof) then
-          exit;
-        childof:=c;
-        { some options are inherited !! }
-        if assigned(c) then
-          begin
-             options:= options or (c^.options and
-                    (oo_hasvirtual or oo_hasprivate or
-                     oo_hasprotected or
-                     oo_hasconstructor or oo_hasdestructor
-                     ));
-             { add the data of the anchestor class }
-             publicsyms^.datasize:=publicsyms^.datasize
-               +childof^.publicsyms^.datasize;
-             if ((options and oo_hasvmt)<>0) and
-                ((c^.options and oo_hasvmt)<>0) then
-               publicsyms^.datasize:=publicsyms^.datasize-target_os.size_of_pointer;
-             { if parent has a vmt field then
-               the offset is the same for the child PM }
-             if ((c^.options and oo_hasvmt)<>0) or isclass then
-               begin
-                  vmt_offset:=c^.vmt_offset;
-                  options:=options or oo_hasvmt;
-               end;
-          end;
-        savesize := publicsyms^.datasize;
-      end;
-
     constructor tobjectdef.load;
       var
          oldread_member : boolean;
@@ -2987,73 +2972,146 @@ Const local_symtable_index : longint = $8001;
          vmt_offset:=readlong;
          objname:=stringdup(readstring);
          childof:=pobjectdef(readdefref);
-         options:=readlong;
+         readsmallset(objectoptions);
          oldread_member:=read_member;
          read_member:=true;
-         publicsyms:=new(psymtable,loadas(objectsymtable));
+         symtable:=new(psymtable,loadas(objectsymtable));
          read_member:=oldread_member;
-         publicsyms^.defowner:=@self;
-         publicsyms^.name := stringdup(objname^);
+         symtable^.defowner:=@self;
+         symtable^.name := stringdup(objname^);
 
          { handles the predefined class tobject  }
          { the last TOBJECT which is loaded gets }
          { it !                                  }
-         if (objname^='TOBJECT') and
-           isclass and (childof=nil) then
+         if (childof=nil) and
+            is_class and
+            (objname^='TOBJECT') then
            class_tobject:=@self;
          has_rtti:=true;
        end;
 
 
+   destructor tobjectdef.done;
+     begin
+        if assigned(symtable) then
+          dispose(symtable,done);
+        if (oo_is_forward in objectoptions) then
+          Message1(sym_e_class_forward_not_resolved,objname^);
+        stringdispose(objname);
+        tdef.done;
+     end;
+
+
+    procedure tobjectdef.write;
+      var
+         oldread_member : boolean;
+      begin
+         tdef.write;
+         writelong(size);
+         writelong(vmt_offset);
+         writestring(objname^);
+         writedefref(childof);
+         writesmallset(objectoptions);
+         current_ppu^.writeentry(ibobjectdef);
+
+         oldread_member:=read_member;
+         read_member:=true;
+         symtable^.writeas;
+         read_member:=oldread_member;
+      end;
+
+
+    procedure tobjectdef.deref;
+      var
+         oldrecsyms : psymtable;
+      begin
+         resolvedef(pdef(childof));
+         oldrecsyms:=aktrecordsymtable;
+         aktrecordsymtable:=symtable;
+         symtable^.deref;
+         aktrecordsymtable:=oldrecsyms;
+      end;
+
+
+    procedure tobjectdef.set_parent( c : pobjectdef);
+      begin
+        { nothing to do if the parent was not forward !}
+        if assigned(childof) then
+          exit;
+        childof:=c;
+        { some options are inherited !! }
+        if assigned(c) then
+          begin
+             objectoptions:=objectoptions+(c^.objectoptions*
+               [oo_has_virtual,oo_has_private,oo_has_protected,oo_has_constructor,oo_has_destructor]);
+             { add the data of the anchestor class }
+             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);
+             { 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 then
+               begin
+                  vmt_offset:=c^.vmt_offset;
+{$ifdef INCLUDEOK}
+                  include(objectoptions,oo_has_vmt);
+{$else}
+                  objectoptions:=objectoptions+[oo_has_vmt];
+{$endif}
+               end;
+          end;
+        savesize := symtable^.datasize;
+      end;
+
+
    procedure tobjectdef.insertvmt;
      begin
-        if (options and oo_hasvmt)<>0 then
+        if (oo_has_vmt in objectoptions) then
           internalerror(12345)
         else
           begin
              { first round up to multiple of 4 }
-             if (publicsyms^.dataalignment=2) then
+             if (symtable^.dataalignment=2) then
                begin
-                 if (publicsyms^.datasize and 1)<>0 then
-                   inc(publicsyms^.datasize);
+                 if (symtable^.datasize and 1)<>0 then
+                   inc(symtable^.datasize);
                end
              else
-              if (publicsyms^.dataalignment>=4) then
+              if (symtable^.dataalignment>=4) then
                begin
-                 if (publicsyms^.datasize mod 4) <> 0 then
-                   publicsyms^.datasize:=publicsyms^.datasize+4-(publicsyms^.datasize mod 4);
+                 if (symtable^.datasize mod 4) <> 0 then
+                   inc(symtable^.datasize,4-(symtable^.datasize mod 4));
                end;
-             vmt_offset:=publicsyms^.datasize;
-             publicsyms^.datasize:=publicsyms^.datasize+target_os.size_of_pointer;
-             options:=options or oo_hasvmt;
+             vmt_offset:=symtable^.datasize;
+             inc(symtable^.datasize,target_os.size_of_pointer);
+{$ifdef INCLUDEOK}
+             include(objectoptions,oo_has_vmt);
+{$else}
+             objectoptions:=objectoptions+[oo_has_vmt];
+{$endif}
           end;
      end;
 
+
    procedure tobjectdef.check_forwards;
      begin
-        publicsyms^.check_forwards;
-        if (options and oo_isforward)<>0 then
+        symtable^.check_forwards;
+        if (oo_is_forward in objectoptions) then
           begin
              { ok, in future, the forward can be resolved }
              Message1(sym_e_class_forward_not_resolved,objname^);
-             options:=options and not(oo_isforward);
+{$ifdef INCLUDEOK}
+             exclude(objectoptions,oo_is_forward);
+{$else}
+             objectoptions:=objectoptions-[oo_is_forward];
+{$endif}
           end;
      end;
 
 
-   destructor tobjectdef.done;
-     begin
-        if assigned(publicsyms) then
-          dispose(publicsyms,done);
-        if (options and oo_isforward)<>0 then
-         Message1(sym_e_class_forward_not_resolved,objname^);
-        stringdispose(objname);
-        tdef.done;
-     end;
-
-
    { true, if self inherits from d (or if they are equal) }
-   function tobjectdef.isrelated(d : pobjectdef) : boolean;
+   function tobjectdef.is_related(d : pobjectdef) : boolean;
      var
         hp : pobjectdef;
      begin
@@ -3062,39 +3120,27 @@ Const local_symtable_index : longint = $8001;
           begin
              if hp=d then
                begin
-                  isrelated:=true;
+                  is_related:=true;
                   exit;
                end;
              hp:=hp^.childof;
           end;
-        isrelated:=false;
+        is_related:=false;
      end;
 
 
     function tobjectdef.size : longint;
       begin
-        if (options and oo_is_class)<>0 then
+        if (oo_is_class in objectoptions) then
           size:=target_os.size_of_pointer
         else
-          size:=publicsyms^.datasize;
+          size:=symtable^.datasize;
       end;
 
 
     function tobjectdef.alignment:longint;
       begin
-        alignment:=publicsyms^.dataalignment;
-      end;
-
-
-    procedure tobjectdef.deref;
-      var
-         oldrecsyms : psymtable;
-      begin
-         resolvedef(pdef(childof));
-         oldrecsyms:=aktrecordsymtable;
-         aktrecordsymtable:=publicsyms;
-         publicsyms^.deref;
-         aktrecordsymtable:=oldrecsyms;
+        alignment:=symtable^.dataalignment;
       end;
 
 
@@ -3105,17 +3151,16 @@ Const local_symtable_index : longint = $8001;
     var
       s1,s2:string;
     begin
-        if (options and oo_hasvmt)=0 then
-          {internalerror(12346);}
+        if not(oo_has_vmt in objectoptions) then
           Message1(parser_object_has_no_vmt,objname^);
         if owner^.name=nil then
-            s1:=''
+          s1:=''
         else
-            s1:=owner^.name^;
+          s1:=owner^.name^;
         if objname=nil then
-            s2:=''
+          s2:=''
         else
-            s2:=objname^;
+          s2:=objname^;
         vmt_mangledname:='VMT_'+s1+'$_'+s2;
     end;
 
@@ -3136,28 +3181,9 @@ Const local_symtable_index : longint = $8001;
     end;
 
 
-    function tobjectdef.isclass : boolean;
+    function tobjectdef.is_class : boolean;
       begin
-         isclass:=(options and oo_is_class)<>0;
-      end;
-
-
-    procedure tobjectdef.write;
-      var
-         oldread_member : boolean;
-      begin
-         tdef.write;
-         writelong(size);
-         writelong(vmt_offset);
-         writestring(objname^);
-         writedefref(childof);
-         writelong(options);
-         current_ppu^.writeentry(ibobjectdef);
-
-         oldread_member:=read_member;
-         read_member:=true;
-         publicsyms^.writeas;
-         read_member:=oldread_member;
+         is_class:=(oo_is_class in objectoptions);
       end;
 
 
@@ -3179,7 +3205,7 @@ Const local_symtable_index : longint = $8001;
                 not yet done }
                 ipd := pd;
                 while assigned(ipd^.nextoverloaded) do ipd := ipd^.nextoverloaded;
-                if (pd^.options and povirtualmethod) <> 0 then
+                if (po_virtualmethod in pd^.procoptions) then
                    begin
                    lindex := pd^.extnumber;
                    {doesnt seem to be necessary
@@ -3190,9 +3216,9 @@ Const local_symtable_index : longint = $8001;
                 {we don't need another definition}
                  para := pd^.para1;
                  { used by gdbpas to recognize constructor and destructors }
-                 if (pd^.options and poconstructor) <> 0 then
+                 if (pd^.proctypeoption=potype_constructor) then
                    argnames:='__ct__'
-                 else if (pd^.options and podestructor) <> 0 then
+                 else if (pd^.proctypeoption=potype_destructor) then
                    argnames:='__dt__'
                  else
                    argnames := '';
@@ -3225,8 +3251,8 @@ Const local_symtable_index : longint = $8001;
                 ipd^.is_def_stab_written := true;
                 { here 2A must be changed for private and protected }
                 { 0 is private 1 protected and 2 public }
-                if (psym(p)^.properties and sp_private)<>0 then sp:='0'
-                else if (psym(p)^.properties and sp_protected)<>0 then sp:='1'
+                if (sp_private in psym(p)^.symoptions) then sp:='0'
+                else if (sp_protected in psym(p)^.symoptions) then sp:='1'
                 else sp:='2';
                 newrec := strpnew(p^.name+'::'+ipd^.numberstring
                      +'=##'+pd^.retdef^.numberstring+';:'+argnames+';'+sp+'A'
@@ -3266,18 +3292,18 @@ Const local_symtable_index : longint = $8001;
           strpcopy(strend(stabrecstring),'!1,020,'+childof^.numberstring+';');
         {virtual table to implement yet}
         RecOffset := 0;
-        publicsyms^.foreach({$ifndef TP}@{$endif}addname);
-      if (options and oo_hasvmt) <> 0 then
-        if not assigned(childof) or ((childof^.options and oo_hasvmt) = 0) then
+        symtable^.foreach({$ifndef TP}@{$endif}addname);
+      if (oo_has_vmt in objectoptions) then
+        if not assigned(childof) or not(oo_has_vmt in childof^.objectoptions) then
            begin
               strpcopy(strend(stabrecstring),'$vf'+numberstring+':'+typeglobalnumber('vtblarray')
                 +','+tostr(vmt_offset*8)+';');
            end;
-        publicsyms^.foreach({$ifndef TP}@{$endif}addprocname);
-        if (options and oo_hasvmt) <> 0  then
+        symtable^.foreach({$ifndef TP}@{$endif}addprocname);
+        if (oo_has_vmt in objectoptions) then
           begin
              anc := @self;
-             while assigned(anc^.childof) and ((anc^.childof^.options and oo_hasvmt) <> 0) do
+             while assigned(anc^.childof) and (oo_has_vmt in anc^.childof^.objectoptions) do
                anc := anc^.childof;
              str_end:=';~%'+anc^.numberstring+';';
           end
@@ -3294,13 +3320,13 @@ Const local_symtable_index : longint = $8001;
 
     procedure tobjectdef.write_child_init_data;
       begin
-         publicsyms^.foreach({$ifndef TP}@{$endif}generate_child_inittable);
+         symtable^.foreach({$ifndef TP}@{$endif}generate_child_inittable);
       end;
 
 
     procedure tobjectdef.write_init_data;
       begin
-         if isclass then
+         if is_class then
            rttilist^.concat(new(pai_const,init_8bit(tkclass)))
          else
            rttilist^.concat(new(pai_const,init_8bit(tkobject)));
@@ -3311,9 +3337,9 @@ Const local_symtable_index : longint = $8001;
 
          rttilist^.concat(new(pai_const,init_32bit(size)));
          count:=0;
-         publicsyms^.foreach({$ifndef TP}@{$endif}count_inittable_fields);
+         symtable^.foreach({$ifndef TP}@{$endif}count_inittable_fields);
          rttilist^.concat(new(pai_const,init_32bit(count)));
-         publicsyms^.foreach({$ifndef TP}@{$endif}write_field_inittable);
+         symtable^.foreach({$ifndef TP}@{$endif}write_field_inittable);
       end;
 
 
@@ -3327,7 +3353,7 @@ Const local_symtable_index : longint = $8001;
          { procedure of needs_rtti !                              }
          oldb:=binittable;
          binittable:=false;
-         publicsyms^.foreach({$ifndef TP}@{$endif}check_rec_inittable);
+         symtable^.foreach({$ifndef TP}@{$endif}check_rec_inittable);
          needs_inittable:=binittable;
          binittable:=oldb;
       end;
@@ -3336,7 +3362,8 @@ Const local_symtable_index : longint = $8001;
     procedure count_published_properties(sym:pnamedindexobject);
       {$ifndef fpc}far;{$endif}
       begin
-         if (psym(sym)^.typ=propertysym) and ((psym(sym)^.properties and sp_published)<>0) then
+         if (psym(sym)^.typ=propertysym) and
+            (sp_published in psym(sym)^.symoptions) then
            inc(count);
       end;
 
@@ -3362,7 +3389,7 @@ Const local_symtable_index : longint = $8001;
              end
            else
              begin
-                if (pprocdef(def)^.options and povirtualmethod)=0 then
+                if not(po_virtualmethod in pprocdef(def)^.procoptions) then
                   begin
                      rttilist^.concat(new(pai_const_symbol,initname(pprocdef(def)^.mangledname)));
                      typvalue:=1;
@@ -3380,18 +3407,18 @@ Const local_symtable_index : longint = $8001;
       begin
 
          if (psym(sym)^.typ=propertysym) and
-            ((ppropertysym(sym)^.options and ppo_indexed)<>0) then
+            (ppo_indexed in ppropertysym(sym)^.propoptions) then
            proctypesinfo:=$40
          else
            proctypesinfo:=0;
          if (psym(sym)^.typ=propertysym) and
-            ((psym(sym)^.properties and sp_published)<>0) then
+            (sp_published in psym(sym)^.symoptions) then
            begin
               rttilist^.concat(new(pai_const_symbol,initname(ppropertysym(sym)^.proptype^.get_rtti_label)));
               writeproc(ppropertysym(sym)^.readaccesssym,ppropertysym(sym)^.readaccessdef,0);
               writeproc(ppropertysym(sym)^.writeaccesssym,ppropertysym(sym)^.writeaccessdef,2);
               { isn't it stored ? }
-              if (ppropertysym(sym)^.options and ppo_stored)=0 then
+              if not(ppo_stored in ppropertysym(sym)^.propoptions) then
                 begin
                    rttilist^.concat(new(pai_const,init_32bit(1)));
                    proctypesinfo:=proctypesinfo or (3 shl 4);
@@ -3409,18 +3436,17 @@ Const local_symtable_index : longint = $8001;
       end;
 
 
-    procedure generate_published_child_rtti(sym : pnamedindexobject);
-      {$ifndef fpc}far;{$endif}
+    procedure generate_published_child_rtti(sym : pnamedindexobject);{$ifndef fpc}far;{$endif}
       begin
          if (psym(sym)^.typ=propertysym) and
-            ((psym(sym)^.properties and sp_published)<>0) then
+            (sp_published in psym(sym)^.symoptions) then
            ppropertysym(sym)^.proptype^.get_rtti_label;
       end;
 
 
     procedure tobjectdef.write_child_rtti_data;
       begin
-         publicsyms^.foreach({$ifndef TP}@{$endif}generate_published_child_rtti);
+         symtable^.foreach({$ifndef TP}@{$endif}generate_published_child_rtti);
       end;
 
 
@@ -3440,19 +3466,19 @@ Const local_symtable_index : longint = $8001;
       var
          i : longint;
       begin
-         if assigned(childof) and ((childof^.options and oo_can_have_published)<>0) then
+         if assigned(childof) and (oo_can_have_published in childof^.objectoptions) then
            i:=childof^.next_free_name_index
          else
            i:=0;
          count:=0;
-         publicsyms^.foreach({$ifndef TP}@{$endif}count_published_properties);
+         symtable^.foreach({$ifndef TP}@{$endif}count_published_properties);
          next_free_name_index:=i+count;
       end;
 
 
     procedure tobjectdef.write_rtti_data;
       begin
-         if isclass then
+         if is_class then
            rttilist^.concat(new(pai_const,init_8bit(tkclass)))
          else
            rttilist^.concat(new(pai_const,init_8bit(tkobject)));
@@ -3465,19 +3491,19 @@ Const local_symtable_index : longint = $8001;
          rttilist^.concat(new(pai_const_symbol,initname(vmt_mangledname)));
 
          { write owner typeinfo }
-         if assigned(childof) and ((childof^.options and oo_can_have_published)<>0) then
+         if assigned(childof) and (oo_can_have_published in childof^.objectoptions) then
            rttilist^.concat(new(pai_const_symbol,initname(childof^.get_rtti_label)))
          else
            rttilist^.concat(new(pai_const,init_32bit(0)));
 
          { count total number of properties }
-         if assigned(childof) and ((childof^.options and oo_can_have_published)<>0) then
+         if assigned(childof) and (oo_can_have_published in childof^.objectoptions) then
            count:=childof^.next_free_name_index
          else
            count:=0;
 
          { write it }
-         publicsyms^.foreach({$ifndef TP}@{$endif}count_published_properties);
+         symtable^.foreach({$ifndef TP}@{$endif}count_published_properties);
          rttilist^.concat(new(pai_const,init_16bit(count)));
 
          { write unit name }
@@ -3491,24 +3517,24 @@ Const local_symtable_index : longint = $8001;
 
          { write published properties count }
          count:=0;
-         publicsyms^.foreach({$ifndef TP}@{$endif}count_published_properties);
+         symtable^.foreach({$ifndef TP}@{$endif}count_published_properties);
          rttilist^.concat(new(pai_const,init_16bit(count)));
 
          { count is used to write nameindex   }
          { but we need an offset of the owner }
          { to give each property an own slot  }
-         if assigned(childof) and ((childof^.options and oo_can_have_published)<>0) then
+         if assigned(childof) and (oo_can_have_published in childof^.objectoptions) then
            count:=childof^.next_free_name_index
          else
            count:=0;
 
-         publicsyms^.foreach({$ifndef TP}@{$endif}write_property_info);
+         symtable^.foreach({$ifndef TP}@{$endif}write_property_info);
       end;
 
 
     function tobjectdef.is_publishable : boolean;
       begin
-         is_publishable:=isclass;
+         is_publishable:=is_class;
       end;
 
     function  tobjectdef.get_rtti_label : string;
@@ -3543,7 +3569,11 @@ Const local_symtable_index : longint = $8001;
 
 {
   $Log$
-  Revision 1.138  1999-08-02 21:29:02  florian
+  Revision 1.139  1999-08-03 22:03:14  peter
+    * moved bitmask constants to sets
+    * some other type/const renamings
+
+  Revision 1.138  1999/08/02 21:29:02  florian
     * the main branch psub.pas is now used for
       newcg compiler
 
@@ -3886,7 +3916,7 @@ Const local_symtable_index : longint = $8001;
     * range checking in units doesn't work if the units are smartlinked, fixed
 
   Revision 1.51  1998/09/25 12:01:41  florian
-    * tobjectdef.publicsyms.datasize was set to savesize, this is wrong now
+    * tobjectdef.symtable.datasize was set to savesize, this is wrong now
       because the symtable size is read from the ppu file
 
   Revision 1.50  1998/09/23 15:46:40  florian

+ 125 - 137
compiler/symdefh.inc

@@ -52,23 +52,25 @@
           constructor init;
           constructor load;
           destructor  done;virtual;
-          { registers enumdef inside objects or
-            record directly in the owner symtable !! }
-          procedure correct_owner_symtable;
+          procedure deref;virtual;
+          procedure symderef;virtual;
           function  typename:string;
           procedure write;virtual;
           function  size:longint;virtual;
           function  alignment:longint;virtual;
+          function  gettypename:string;virtual;
+          function  is_publishable : boolean;virtual;
+          function  is_in_current : boolean;
+          procedure correct_owner_symtable; { registers enumdef inside objects or
+                                              record directly in the owner symtable !! }
+          { debug }
 {$ifdef GDB}
+          function  stabstring : pchar;virtual;
+          procedure concatstabto(asmlist : paasmoutput);virtual;
           function  NumberString:string;
           procedure set_globalnb;
-          function  stabstring : pchar;virtual;
           function  allstabstring : pchar;
-          procedure concatstabto(asmlist : paasmoutput);virtual;
 {$endif GDB}
-          procedure deref;virtual;
-          procedure symderef;virtual;
-
           { init. tables }
           function  needs_inittable : boolean;virtual;
           procedure generate_inittable;
@@ -77,20 +79,13 @@
           { if init and rtti data is different these procedures }
           { must be overloaded                                  }
           procedure write_init_data;virtual;
-          { writes rtti of child to avoid mixup of rtti }
           procedure write_child_init_data;virtual;
-
           { rtti }
           procedure write_rtti_name;
           function  get_rtti_label : string;virtual;
           procedure generate_rtti;virtual;
           procedure write_rtti_data;virtual;
           procedure write_child_rtti_data;virtual;
-
-          { returns true, if the definition can be published }
-          function is_publishable : boolean;virtual;
-          function is_in_current : boolean;
-          function gettypename:string;virtual;
        private
           savesize  : longint;
        end;
@@ -120,12 +115,13 @@
           constructor load;
           procedure write;virtual;
           procedure deref;virtual;
+          function  gettypename:string;virtual;
           procedure setsize;
+          { debug }
 {$ifdef GDB}
-          function stabstring : pchar;virtual;
+          function  stabstring : pchar;virtual;
           procedure concatstabto(asmlist : paasmoutput);virtual;
 {$endif GDB}
-          function gettypename:string;virtual;
        end;
 
        pformaldef = ^tformaldef;
@@ -133,20 +129,21 @@
           constructor init;
           constructor load;
           procedure write;virtual;
+          function  gettypename:string;virtual;
 {$ifdef GDB}
-          function stabstring : pchar;virtual;
+          function  stabstring : pchar;virtual;
           procedure concatstabto(asmlist : paasmoutput);virtual;
 {$endif GDB}
-          function gettypename:string;virtual;
        end;
 
        perrordef = ^terrordef;
        terrordef = object(tdef)
           constructor init;
+          function  gettypename:string;virtual;
+          { debug }
 {$ifdef GDB}
-          function stabstring : pchar;virtual;
+          function  stabstring : pchar;virtual;
 {$endif GDB}
-          function gettypename:string;virtual;
        end;
 
        { tpointerdef and tclassrefdef should get a common
@@ -163,66 +160,66 @@
           constructor initfar(def : pdef);
           constructor load;
           procedure write;virtual;
+          procedure deref;virtual;
+          function  gettypename:string;virtual;
+          { debug }
 {$ifdef GDB}
           function  stabstring : pchar;virtual;
           procedure concatstabto(asmlist : paasmoutput);virtual;
 {$endif GDB}
-          procedure deref;virtual;
-          function gettypename:string;virtual;
        end;
 
-
        pobjectdef = ^tobjectdef;
        tobjectdef = object(tdef)
-          childof : pobjectdef;
-          objname : pstring;
-          publicsyms : psymtable;
-          options : longint;
+          childof  : pobjectdef;
+          objname  : pstring;
+          symtable : psymtable;
+          objectoptions : tobjectoptions;
           { to be able to have a variable vmt position }
           { and no vmt field for objects without virtuals }
           vmt_offset : longint;
           constructor init(const n : string;c : pobjectdef);
-          destructor done;virtual;
-          procedure check_forwards;
-          function isrelated(d : pobjectdef) : boolean;
-          function size : longint;virtual;
-          function alignment:longint;virtual;
           constructor load;
+          destructor  done;virtual;
           procedure write;virtual;
-          function vmt_mangledname : string;
-          function rtti_name : string;
-          function isclass : boolean;
+          procedure deref;virtual;
+          function  size : longint;virtual;
+          function  alignment:longint;virtual;
+          function  is_publishable : boolean;virtual;
+          function  vmt_mangledname : string;
+          function  rtti_name : string;
+          procedure check_forwards;
+          function  is_related(d : pobjectdef) : boolean;
+          function  is_class : boolean;
+          function  next_free_name_index : longint;
           procedure insertvmt;
           procedure set_parent(c : pobjectdef);
+          { debug }
 {$ifdef GDB}
           function stabstring : pchar;virtual;
 {$endif GDB}
-          procedure deref;virtual;
-
+          { init/final }
           function  needs_inittable : boolean;virtual;
           procedure write_init_data;virtual;
           procedure write_child_init_data;virtual;
-
           { rtti }
           function  get_rtti_label : string;virtual;
           procedure generate_rtti;virtual;
           procedure write_rtti_data;virtual;
           procedure write_child_rtti_data;virtual;
-          function next_free_name_index : longint;
-          function is_publishable : boolean;virtual;
        end;
 
-
        pclassrefdef = ^tclassrefdef;
        tclassrefdef = object(tpointerdef)
           constructor init(def : pdef);
           constructor load;
           procedure write;virtual;
+          function gettypename:string;virtual;
+          { debug }
 {$ifdef GDB}
           function stabstring : pchar;virtual;
           procedure concatstabto(asmlist : paasmoutput);virtual;
 {$endif GDB}
-          function gettypename:string;virtual;
        end;
 
        parraydef = ^tarraydef;
@@ -260,108 +257,95 @@
           procedure write_child_rtti_data;virtual;
        end;
 
-       precdef = ^trecdef;
-       trecdef = object(tdef)
+       precorddef = ^trecorddef;
+       trecorddef = object(tdef)
           symtable : psymtable;
           constructor init(p : psymtable);
           constructor load;
           destructor done;virtual;
           procedure write;virtual;
-          function size:longint;virtual;
-          function alignment : longint;virtual;
+          procedure deref;virtual;
+          function  size:longint;virtual;
+          function  alignment : longint;virtual;
+          function  gettypename:string;virtual;
+          { debug }
 {$ifdef GDB}
-          function stabstring : pchar;virtual;
+          function  stabstring : pchar;virtual;
           procedure concatstabto(asmlist : paasmoutput);virtual;
 {$endif GDB}
-          procedure deref;virtual;
+          { init/final }
+          procedure write_init_data;virtual;
+          procedure write_child_init_data;virtual;
           function  needs_inittable : boolean;virtual;
+          { rtti }
           procedure write_rtti_data;virtual;
-          procedure write_init_data;virtual;
           procedure write_child_rtti_data;virtual;
-          procedure write_child_init_data;virtual;
-          function gettypename:string;virtual;
        end;
 
-       { base types }
-       tbasetype = (uauto,uvoid,uchar,
-                    u8bit,u16bit,u32bit,
-                    s8bit,s16bit,s32bit,
-                    bool8bit,bool16bit,bool32bit { uwchar,bool1bit,bitfield},
-                    u64bit,s64bitint);
-
        porddef = ^torddef;
        torddef = object(tdef)
           low,high : longint;
           rangenr  : longint;
           typ      : tbasetype;
-          {
-          bits     : byte;
-          }
           constructor init(t : tbasetype;v,b : longint);
           constructor load;
           procedure write;virtual;
-{$ifdef GDB}
-          function stabstring : pchar;virtual;
-{$endif GDB}
+          function  is_publishable : boolean;virtual;
+          function  gettypename:string;virtual;
           procedure setsize;
-
           { generates the ranges needed by the asm instruction BOUND }
           { or CMP2 (Motorola)                                       }
           procedure genrangecheck;
-          { returns the label of the range check string }
-          function getrangecheckstring : string;
+          function  getrangecheckstring : string;
+          { debug }
+{$ifdef GDB}
+          function  stabstring : pchar;virtual;
+{$endif GDB}
+          { rtti }
           procedure write_rtti_data;virtual;
-          function is_publishable : boolean;virtual;
-          function gettypename:string;virtual;
        end;
 
-       { sextreal is dependant on the cpu, s64bit is also }
-       { dependant on the size (tp = 80bit for both)      }
-       { The EXTENDED format exists on the motorola FPU   }
-       { but it uses 96 bits instead of 80, with some     }
-       { unused bits within the number itself! Pretty     }
-       { complicated to support, so no support for the    }
-       { moment.                                          }
-       { s64 bit is considered as a real because all      }
-       { calculations are done by the fpu.                }
-       tfloattype = (s32real,s64real,s80real,s64comp,f16bit,f32bit);
-
        pfloatdef = ^tfloatdef;
        tfloatdef = object(tdef)
           typ : tfloattype;
           constructor init(t : tfloattype);
           constructor load;
           procedure write;virtual;
+          function  gettypename:string;virtual;
+          function  is_publishable : boolean;virtual;
+          procedure setsize;
+          { debug }
 {$ifdef GDB}
           function stabstring : pchar;virtual;
 {$endif GDB}
-          procedure setsize;
-          function is_publishable : boolean;virtual;
+          { rtti }
           procedure write_rtti_data;virtual;
-          function gettypename:string;virtual;
        end;
 
        pabstractprocdef = ^tabstractprocdef;
        tabstractprocdef = object(tdef)
           { saves a definition to the return type }
-          retdef   : pdef;
-          fpu_used : byte;    { how many stack fpu must be empty }
-          options  : longint; { save the procedure options }
-          para1    : pdefcoll;
+          retdef          : pdef;
+          proctypeoption  : tproctypeoption;
+          proccalloptions : tproccalloptions;
+          procoptions     : tprocoptions;
+          para1           : pdefcoll;
+          fpu_used        : byte;    { how many stack fpu must be empty }
           constructor init;
           constructor load;
           destructor done;virtual;
+          procedure  write;virtual;
+          procedure deref;virtual;
           procedure concatdef(p : pdef;vsp : tvarspez);
           procedure concattypesym(p : ptypesym;vsp : tvarspez);
-          procedure deref;virtual;
-          function para_size : longint;
-          function demangled_paras : string;
+          function  para_size : longint;
+          function  demangled_paras : string;
+          procedure test_if_fpu_result;
+          { debug }
 {$ifdef GDB}
-          function stabstring : pchar;virtual;
+          function  stabstring : pchar;virtual;
           procedure concatstabto(asmlist : paasmoutput);virtual;
 {$endif GDB}
-          procedure test_if_fpu_result;
-          procedure write;virtual;
        end;
 
        pprocvardef = ^tprocvardef;
@@ -369,15 +353,17 @@
           constructor init;
           constructor load;
           procedure write;virtual;
-          function size : longint;virtual;
+          function  size : longint;virtual;
+          function gettypename:string;virtual;
+          function is_publishable : boolean;virtual;
+          { debug }
 {$ifdef GDB}
           function stabstring : pchar;virtual;
           procedure concatstabto(asmlist : paasmoutput); virtual;
 {$endif GDB}
+          { rtti }
           procedure write_child_rtti_data;virtual;
-          function is_publishable : boolean;virtual;
           procedure write_rtti_data;virtual;
-          function gettypename:string;virtual;
        end;
 
        tmessageinf = record
@@ -388,7 +374,10 @@
 
        pprocdef = ^tprocdef;
        tprocdef = object(tabstractprocdef)
-          extnumber : longint;
+       private
+          _mangledname : pchar;
+       public
+          extnumber  : longint;
           messageinf : tmessageinf;
           nextoverloaded : pprocdef;
           { where is this function defined, needed here because there
@@ -405,7 +394,6 @@
           lastwritten : pref;
           refcount : longint;
           _class : pobjectdef;
-          _mangledname : pchar;
           { it's a tree, but this not easy to handle }
           { used for inlined procs                   }
           code : pointer;
@@ -417,47 +405,38 @@
           { check the problems of manglednames }
           count      : boolean;
           is_used    : boolean;
-          { set which contains the modified registers }
+          { small set which contains the modified registers }
 {$ifdef newcg}
           usedregisters : tregisterset;
 {$else newcg}
-{$ifdef i386}
-          usedregisters : byte;
-{$endif}
-{$ifdef m68k}
-          usedregisters : word;
-{$endif}
-{$ifdef alpha}
-          usedregisters_int : longint;
-          usedregisters_fpu : longint;
-{$endif}
+          usedregisters : longint;
 {$endif newcg}
           constructor init;
-          destructor done;virtual;
           constructor load;
+          destructor  done;virtual;
           procedure write;virtual;
-{$ifdef GDB}
-          function cplusplusmangledname : string;
-          function stabstring : pchar;virtual;
-          procedure concatstabto(asmlist : paasmoutput);virtual;
-{$endif GDB}
           procedure deref;virtual;
-          function mangledname : string;
+          function  haspara:boolean;
+          function  mangledname : string;
           procedure setmangledname(const s : string);
           procedure load_references;
           function  write_references : boolean;
+          { debug }
+{$ifdef GDB}
+          function  cplusplusmangledname : string;
+          function  stabstring : pchar;virtual;
+          procedure concatstabto(asmlist : paasmoutput);virtual;
+{$endif GDB}
+          { browser }
 {$ifdef BrowserLog}
           procedure add_to_browserlog;
 {$endif BrowserLog}
-          function haspara:boolean;
        end;
 
-       tstringtype = (st_shortstring, st_longstring, st_ansistring, st_widestring);
-
        pstringdef = ^tstringdef;
        tstringdef = object(tdef)
           string_typ : tstringtype;
-          len : longint;
+          len        : longint;
           constructor shortinit(l : byte);
           constructor shortload;
           constructor longinit(l : longint);
@@ -466,17 +445,20 @@
           constructor ansiload;
           constructor wideinit(l : longint);
           constructor wideload;
-          function stringtypname:string;
-          function size : longint;virtual;
+          function  stringtypname:string;
+          function  size : longint;virtual;
           procedure write;virtual;
+          function  gettypename:string;virtual;
+          function  is_publishable : boolean;virtual;
+          { debug }
 {$ifdef GDB}
-          function stabstring : pchar;virtual;
+          function  stabstring : pchar;virtual;
           procedure concatstabto(asmlist : paasmoutput);virtual;
 {$endif GDB}
-          function needs_inittable : boolean;virtual;
+          { init/final }
+          function  needs_inittable : boolean;virtual;
+          { rtti }
           procedure write_rtti_data;virtual;
-          function is_publishable : boolean;virtual;
-          function gettypename:string;virtual;
        end;
 
        penumdef = ^tenumdef;
@@ -493,6 +475,8 @@
           destructor done;virtual;
           procedure write;virtual;
           procedure deref;virtual;
+          function  gettypename:string;virtual;
+          function  is_publishable : boolean;virtual;
           procedure calcsavesize;
           procedure setmax(_max:longint);
           procedure setmin(_min:longint);
@@ -500,38 +484,42 @@
           function  max:longint;
           function  getrangecheckstring:string;
           procedure genrangecheck;
+          { debug }
 {$ifdef GDB}
           function stabstring : pchar;virtual;
 {$endif GDB}
+          { rtti }
           procedure write_child_rtti_data;virtual;
           procedure write_rtti_data;virtual;
-          function is_publishable : boolean;virtual;
-          function  gettypename:string;virtual;
        end;
 
-       tsettype = (normset,smallset,varset);
-
        psetdef = ^tsetdef;
        tsetdef = object(tdef)
-          setof : pdef;
+          setof   : pdef;
           settype : tsettype;
           constructor init(s : pdef;high : longint);
           constructor load;
           procedure write;virtual;
+          procedure deref;virtual;
+          function  gettypename:string;virtual;
+          function  is_publishable : boolean;virtual;
+          { debug }
 {$ifdef GDB}
-          function stabstring : pchar;virtual;
+          function  stabstring : pchar;virtual;
           procedure concatstabto(asmlist : paasmoutput);virtual;
 {$endif GDB}
-          procedure deref;virtual;
-          function is_publishable : boolean;virtual;
+          { rtti }
           procedure write_rtti_data;virtual;
           procedure write_child_rtti_data;virtual;
-          function gettypename:string;virtual;
        end;
 
 {
   $Log$
-  Revision 1.36  1999-08-02 21:29:04  florian
+  Revision 1.37  1999-08-03 22:03:16  peter
+    * moved bitmask constants to sets
+    * some other type/const renamings
+
+  Revision 1.36  1999/08/02 21:29:04  florian
     * the main branch psub.pas is now used for
       newcg compiler
 

+ 20 - 24
compiler/symppu.inc

@@ -72,6 +72,12 @@
       end;
 
 
+    procedure writesmallset(var s);
+      begin
+        current_ppu^.putdata(s,4);
+      end;
+
+
     procedure writeposinfo(const p:tfileposinfo);
       begin
         current_ppu^.putword(p.fileindex);
@@ -99,8 +105,6 @@
               current_ppu^.putword(p^.indexnr);
             end
            else
-{           else if p^.owner^.unitid>$8000 then
-            current_ppu^.putword(p^.owner^.unitid) }
             begin
               current_ppu^.putbyte(ord(derefindex));
               current_ppu^.putword(p^.indexnr);
@@ -222,27 +226,6 @@
       end;
 
 
-{    procedure writelinkother(var p:tstringcontainer;id:byte;strippath:boolean);
-      var
-        hcontainer : tstringcontainer;
-        s : string;
-      begin
-        hcontainer.init;
-        while not p.empty do
-         begin
-           s:=p.get;
-           if strippath then
-            current_ppu^.putstring(SplitFileName(s))
-           else
-            current_ppu^.putstring(s);
-           hcontainer.insert(s);
-         end;
-        current_ppu^.writeentry(id);
-        p:=hcontainer;
-      end; }
-
-
-
     procedure writeunitas(const s : string;unittable : punitsymtable;only_crc : boolean);
       begin
          Message1(unit_u_ppu_write,s);
@@ -321,6 +304,7 @@
 {$endif Test_Double_checksum_write}
       end;
 
+
     procedure closecurrentppu;
       begin
 {$ifdef Test_Double_checksum}
@@ -386,6 +370,14 @@
       end;
 
 
+    procedure readsmallset(var s);
+      begin
+        current_ppu^.getdata(s,4);
+        if current_ppu^.error then
+         Message(unit_f_ppu_read_error);
+      end;
+
+
     procedure readposinfo(var p:tfileposinfo);
       begin
         p.fileindex:=current_ppu^.getword;
@@ -614,7 +606,11 @@
 
 {
   $Log$
-  Revision 1.44  1999-07-14 21:19:12  florian
+  Revision 1.45  1999-08-03 22:03:17  peter
+    * moved bitmask constants to sets
+    * some other type/const renamings
+
+  Revision 1.44  1999/07/14 21:19:12  florian
     + implemented a better error message if a PPU file isn't found as suggested
       by Lee John
 

+ 107 - 53
compiler/symsym.inc

@@ -28,7 +28,7 @@
       begin
          inherited initname(n);
          typ:=abstractsym;
-         properties:=current_object_option;
+         symoptions:=current_object_option;
 {$ifdef GDB}
          isstabwritten := false;
 {$endif GDB}
@@ -51,7 +51,7 @@
          indexnr:=readword;
          setname(readstring);
          typ:=abstractsym;
-         properties:=symprop(readbyte);
+         readsmallset(symoptions);
          readposinfo(fileinfo);
          lastref:=nil;
          defref:=nil;
@@ -154,7 +154,7 @@
       begin
          writeword(indexnr);
          writestring(name);
-         writebyte(byte(properties));
+         writesmallset(symoptions);
          writeposinfo(fileinfo);
       end;
 
@@ -412,7 +412,7 @@
         last : pprocdef;
       begin
          resolvedef(pdef(definition));
-         if (definition^.options and pooperator) <> 0 then
+         if (definition^.proctypeoption=potype_operator) then
            begin
               last:=definition;
               while assigned(last^.nextoverloaded) do
@@ -532,7 +532,7 @@
 
     procedure tprocsym.concatstabto(asmlist : paasmoutput);
     begin
-      if (definition^.options and pointernproc) <> 0 then exit;
+      if (pocall_internproc in definition^.proccalloptions) then exit;
       if not isstabwritten then
         asmlist^.concat(new(pai_stabs,init(stabstring)));
       isstabwritten := true;
@@ -573,7 +573,7 @@
       begin
          inherited init(n);
          typ:=propertysym;
-         options:=0;
+         propoptions:=[];
          proptype:=nil;
          readaccessdef:=nil;
          writeaccessdef:=nil;
@@ -598,7 +598,7 @@
          inherited load;
          typ:=propertysym;
          proptype:=readdefref;
-         options:=readlong;
+         readsmallset(propoptions);
          index:=readlong;
          default:=readlong;
          { it's hack ... }
@@ -634,7 +634,7 @@
       begin
          tsym.write;
          writedefref(proptype);
-         writelong(options);
+         writesmallset(propoptions);
          writelong(index);
          writelong(default);
          writesymref(readaccesssym);
@@ -772,6 +772,8 @@
 
 
     procedure tabsolutesym.write;
+      var
+        hvo : tvaroptions;
       begin
          { Note: This needs to write everything of tvarsym.write }
          tsym.write;
@@ -789,7 +791,8 @@
             writedefref(definition);
             writesymref(nil);
           end;
-         writebyte(var_options and (not vo_regable));
+         hvo:=varoptions-[vo_regable];
+         writesmallset(hvo);
          writebyte(byte(abstyp));
          case abstyp of
            tovar :
@@ -867,28 +870,48 @@
          islocalcopy:=false;
          localvarsym:=nil;
          refs:=0;
-         is_valid := 1;
-         var_options:=0;
+         varstate:=vs_used;
+         varoptions:=[];
          { can we load the value into a register ? }
          case p^.deftype of
            pointerdef,
            enumdef,
            procvardef :
-             var_options:=var_options or vo_regable;
+{$ifdef INCLUDEOK}
+             include(varoptions,vo_regable);
+{$else}
+             varoptions:=varoptions+[vo_regable];
+{$endif}
            orddef :
              case porddef(p)^.typ of
                bool8bit,bool16bit,bool32bit,
                u8bit,u16bit,u32bit,
                s8bit,s16bit,s32bit :
-                 var_options:=var_options or vo_regable;
+{$ifdef INCLUDEOK}
+                 include(varoptions,vo_regable);
+{$else}
+                 varoptions:=varoptions+[vo_regable];
+{$endif}
                else
-                 var_options:=var_options and not vo_regable;
+{$ifdef INCLUDEOK}
+                 exclude(varoptions,vo_regable);
+{$else}
+                 varoptions:=varoptions-[vo_regable];
+{$endif}
              end;
            setdef:
              if psetdef(p)^.settype=smallset then
-               var_options:=var_options or vo_regable;
-         else
-           var_options:=var_options and not vo_regable;
+{$ifdef INCLUDEOK}
+                 include(varoptions,vo_regable);
+{$else}
+                 varoptions:=varoptions+[vo_regable];
+{$endif}
+           else
+{$ifdef INCLUDEOK}
+             exclude(varoptions,vo_regable);
+{$else}
+             varoptions:=varoptions-[vo_regable];
+{$endif}
          end;
          reg:=R_NO;
       end;
@@ -898,7 +921,11 @@
       begin
       { The tvarsym is necessary for 0.99.5 (PFV) }
          tvarsym.init(n,p);
-         var_options:=var_options or vo_is_dll_var;
+{$ifdef INCLUDEOK}
+         include(varoptions,vo_is_dll_var);
+{$else}
+         varoptions:=varoptions+[vo_is_dll_var];
+{$endif}
       end;
 
 
@@ -906,7 +933,11 @@
       begin
       { The tvarsym is necessary for 0.99.5 (PFV) }
          tvarsym.init(n,p);
-         var_options:=var_options or vo_is_C_var;
+{$ifdef INCLUDEOK}
+         include(varoptions,vo_is_C_var);
+{$else}
+         varoptions:=varoptions+[vo_is_C_var];
+{$endif}
          setmangledname(mangled);
       end;
 
@@ -939,7 +970,7 @@
          _mangledname:=nil;
          reg:=R_NO;
          refs := 0;
-         is_valid := 1;
+         varstate:=vs_used;
          varspez:=tvarspez(readbyte);
          if read_member then
            address:=readlong
@@ -949,8 +980,8 @@
          localvarsym:=nil;
          definition:=readdefref;
          definitionsym:=ptypesym(readsymref);
-         var_options:=readbyte;
-         if (var_options and vo_is_C_var)<>0 then
+         readsmallset(varoptions);
+         if (vo_is_C_var in varoptions) then
            setmangledname(readstring);
       end;
 
@@ -975,6 +1006,8 @@
 
 
     procedure tvarsym.write;
+      var
+        hvo : tvaroptions;
       begin
          tsym.write;
          writebyte(byte(varspez));
@@ -993,9 +1026,10 @@
           end;
          { symbols which are load are never candidates for a register,
            turn off the regable }
-         writebyte(var_options and (not vo_regable));
-         if (var_options and vo_is_C_var)<>0 then
-            writestring(mangledname);
+         hvo:=varoptions-[vo_regable];
+         writesmallset(hvo);
+         if (vo_is_C_var in varoptions) then
+           writestring(mangledname);
          current_ppu^.writeentry(ibvarsym);
       end;
 
@@ -1087,16 +1121,20 @@
          l,ali,modulo : longint;
          storefilepos : tfileposinfo;
       begin
-        if (var_options and vo_is_external)<>0 then
+        if (vo_is_external in varoptions) then
           exit;
         { handle static variables of objects especially }
         if read_member and (owner^.symtabletype=objectsymtable) and
-           ((properties and sp_static)<>0) then
+           (sp_static in symoptions) then
          begin
             { the data filed is generated in parser.pas
               with a tobject_FIELDNAME variable }
             { this symbol can't be loaded to a register }
-            var_options:=var_options and not vo_regable;
+{$ifdef INCLUDEOK}
+            exclude(varoptions,vo_regable);
+{$else}
+            varoptions:=varoptions-[vo_regable];
+{$endif}
          end
         else
          if not(read_member) then
@@ -1110,7 +1148,7 @@
              }
              storefilepos:=aktfilepos;
              aktfilepos:=tokenpos;
-             if ((var_options and vo_is_thread_var)<>0) then
+             if (vo_is_thread_var in varoptions) then
                l:=4
              else
                l:=getsize;
@@ -1120,7 +1158,7 @@
                  ;
                localsymtable :
                  begin
-                   is_valid := 0;
+                   varstate:=vs_declared;
                    modulo:=owner^.datasize and 3;
 {$ifdef m68k}
                  { word alignment required for motorola }
@@ -1139,16 +1177,12 @@
                staticsymtable :
                  begin
                    { enable unitialized warning for local symbols }
-                   is_valid := 0;
+                   varstate:=vs_declared;
                    if (cs_smartlink in aktmoduleswitches) then
                      bsssegment^.concat(new(pai_cut,init));
                    ali:=data_align(l);
                    if ali>1 then
                      begin
-                        (* this is done
-                           either by the assembler or in ag386bin
-
-                        bsssegment^.concat(new(pai_align,init(ali))); *)
                         modulo:=owner^.datasize mod ali;
                         if modulo>0 then
                           inc(owner^.datasize,ali-modulo);
@@ -1159,14 +1193,18 @@
 {$endif GDB}
 
                    if (cs_smartlink in aktmoduleswitches) or
-                      ((var_options and vo_is_c_var)<>0) then
+                      (vo_is_C_var in varoptions) then
                      bsssegment^.concat(new(pai_datablock,init_global(mangledname,l)))
                    else
                      bsssegment^.concat(new(pai_datablock,init(mangledname,l)));
                    { increase datasize }
                    inc(owner^.datasize,l);
                    { this symbol can't be loaded to a register }
-                   var_options:=var_options and not vo_regable;
+{$ifdef INCLUDEOK}
+                   exclude(varoptions,vo_regable);
+{$else}
+                   varoptions:=varoptions-[vo_regable];
+{$endif}
                  end;
                globalsymtable :
                  begin
@@ -1186,13 +1224,21 @@
                    bsssegment^.concat(new(pai_datablock,init_global(mangledname,l)));
                    inc(owner^.datasize,l);
                    { this symbol can't be loaded to a register }
-                   var_options:=var_options and not vo_regable;
+{$ifdef INCLUDEOK}
+                   exclude(varoptions,vo_regable);
+{$else}
+                   varoptions:=varoptions-[vo_regable];
+{$endif}
                  end;
                recordsymtable,
                objectsymtable :
                  begin
                  { this symbol can't be loaded to a register }
-                   var_options:=var_options and not vo_regable;
+{$ifdef INCLUDEOK}
+                   exclude(varoptions,vo_regable);
+{$else}
+                   varoptions:=varoptions-[vo_regable];
+{$endif}
                  { get the alignment size }
                    if (aktpackrecords=packrecord_C) then
                     begin
@@ -1283,7 +1329,7 @@
        st : char;
      begin
        if (owner^.symtabletype = objectsymtable) and
-          ((properties and sp_static)<>0) then
+          (sp_static in symoptions) then
          begin
             if (cs_gdb_gsym in aktglobalswitches) then st := 'G' else st := 'S';
 {$ifndef Delphi}
@@ -1341,7 +1387,7 @@
          else
    {$endif i386}
            { I don't know if this will work (PM) }
-           if (var_options and vo_is_C_var)<>0 then
+           if (vo_is_C_var in varoptions) then
             stabstring := strpnew('"'+name+':S'
                   +definition^.numberstring+'",'+
                   tostr(N_LCSYM)+',0,'+tostr(fileinfo.line)+','+mangledname)
@@ -1809,7 +1855,11 @@
                begin
                   definition^.sym:=@self;
                   synonym:=nil;
-                  properties:=sp_primary_typesym;
+{$ifdef INCLUDEOK}
+                  include(symoptions,sp_primary_typesym);
+{$else}
+                  symoptions:=symoptions+[sp_primary_typesym];
+{$endif}
                end
              else
                begin
@@ -1863,7 +1913,7 @@
          resolvedef(definition);
          if assigned(definition) then
           begin
-            if properties=sp_primary_typesym then
+            if (sp_primary_typesym in symoptions) then
               begin
                  if definition^.sym<>@self then
                    synonym:=definition^.sym;
@@ -1880,9 +1930,9 @@
                  else
                    definition^.sym:=@self;
               end;
-            if (definition^.deftype=recorddef) and assigned(precdef(definition)^.symtable) and
+            if (definition^.deftype=recorddef) and assigned(precorddef(definition)^.symtable) and
                (definition^.sym=@self) then
-              precdef(definition)^.symtable^.name:=stringdup('record '+name);
+              precorddef(definition)^.symtable^.name:=stringdup('record '+name);
           end;
       end;
 
@@ -1900,9 +1950,9 @@
       begin
          inherited load_references;
          if (definition^.deftype=recorddef) then
-           precdef(definition)^.symtable^.load_browser;
+           precorddef(definition)^.symtable^.load_browser;
          if (definition^.deftype=objectdef) then
-           pobjectdef(definition)^.publicsyms^.load_browser;
+           pobjectdef(definition)^.symtable^.load_browser;
       end;
 
 
@@ -1920,9 +1970,9 @@
           end;
          write_references:=true;
          if (definition^.deftype=recorddef) then
-           precdef(definition)^.symtable^.write_browser;
+           precorddef(definition)^.symtable^.write_browser;
          if (definition^.deftype=objectdef) then
-           pobjectdef(definition)^.publicsyms^.write_browser;
+           pobjectdef(definition)^.symtable^.write_browser;
       end;
 
 
@@ -1942,7 +1992,7 @@
         lasthfp,hfp : pforwardpointer;
       begin
         definition:=p;
-        properties:=current_object_option;
+        symoptions:=current_object_option;
         fileinfo:=tokenpos;
         if assigned(definition) and not(assigned(definition^.sym)) then
           definition^.sym:=@self;
@@ -1963,9 +2013,9 @@
       begin
          inherited add_to_browserlog;
          if (definition^.deftype=recorddef) then
-            precdef(definition)^.symtable^.writebrowserlog;
+            precorddef(definition)^.symtable^.writebrowserlog;
          if (definition^.deftype=objectdef) then
-             pobjectdef(definition)^.publicsyms^.writebrowserlog;
+             pobjectdef(definition)^.symtable^.writebrowserlog;
       end;
 {$endif BrowserLog}
 
@@ -2056,7 +2106,11 @@
 
 {
   $Log$
-  Revision 1.105  1999-07-29 20:54:10  peter
+  Revision 1.106  1999-08-03 22:03:19  peter
+    * moved bitmask constants to sets
+    * some other type/const renamings
+
+  Revision 1.105  1999/07/29 20:54:10  peter
     * write .size also
 
   Revision 1.104  1999/07/27 23:42:21  peter

+ 43 - 46
compiler/symsymh.inc

@@ -24,8 +24,6 @@
                    TSym
 ************************************************}
 
-       symprop = byte;
-
        { possible types for symtable entries }
        tsymtyp = (abstractsym,varsym,typesym,procsym,unitsym,programsym,
                   constsym,enumsym,typedconstsym,errorsym,syssym,
@@ -36,7 +34,7 @@
        psym = ^tsym;
        tsym = object(tsymtableentry)
           typ        : tsymtyp;
-          properties : symprop;
+          symoptions : tsymoptions;
           fileinfo   : tfileposinfo;
 {$ifdef GDB}
           isstabwritten : boolean;
@@ -65,7 +63,7 @@
 
        plabelsym = ^tlabelsym;
        tlabelsym = object(tsym)
-          lab : pasmlabel;
+          lab     : pasmlabel;
           defined : boolean;
           constructor init(const n : string; l : pasmlabel);
           destructor done;virtual;
@@ -77,8 +75,8 @@
        punitsym = ^tunitsym;
        tunitsym = object(tsym)
           unitsymtable : punitsymtable;
-          prevsym : punitsym;
-          refs : longint;
+          prevsym      : punitsym;
+          refs         : longint;
           constructor init(const n : string;ref : punitsymtable);
           constructor load;
           destructor done;virtual;
@@ -92,7 +90,7 @@
        tmacrosym = object(tsym)
           defined : boolean;
           buftext : pchar;
-          buflen : longint;
+          buflen  : longint;
           { macros aren't written to PPU files ! }
           constructor init(const n : string);
           destructor done;virtual;
@@ -105,12 +103,12 @@
 
        pprocsym = ^tprocsym;
        tprocsym = object(tsym)
-          definition : pprocdef;
+          definition  : pprocdef;
 {$ifdef CHAINPROCSYMS}
           nextprocsym : pprocsym;
 {$endif CHAINPROCSYMS}
 {$ifdef GDB}
-          is_global : boolean;{necessary for stab}
+          is_global   : boolean; { necessary for stab }
 {$endif GDB}
           constructor init(const n : string);
           constructor load;
@@ -169,17 +167,16 @@
 
        pvarsym = ^tvarsym;
        tvarsym = object(tsym)
-          address      : longint;
-          localvarsym  : pvarsym;
-          islocalcopy  : boolean;
-          definition   : pdef;
+          address       : longint;
+          localvarsym   : pvarsym;
+          islocalcopy   : boolean;
+          definition    : pdef;
           definitionsym : ptypesym;
-          refs         : longint;
-          var_options  : byte;
-          _mangledname : pchar;
-          reg          : tregister; { if reg<>R_NO, then the variable is an register variable }
-          varspez      : tvarspez;  { sets the type of access }
-          is_valid     : byte;
+          refs          : longint;
+          varoptions    : tvaroptions;
+          reg           : tregister; { if reg<>R_NO, then the variable is an register variable }
+          varspez       : tvarspez;  { sets the type of access }
+          varstate      : tvarstate;
           constructor init(const n : string;p : pdef);
           constructor init_dll(const n : string;p : pdef);
           constructor init_C(const n,mangled : string;p : pdef);
@@ -187,7 +184,7 @@
           constructor initsym_dll(const n : string;p : ptypesym);
           constructor initsym_C(const n,mangled : string;p : ptypesym);
           constructor load;
-          destructor done;virtual;
+          destructor  done;virtual;
           procedure write;virtual;
           procedure deref;virtual;
           procedure setmangledname(const s : string);
@@ -196,28 +193,28 @@
           function  getsize : longint;
           function  getpushsize : longint;
 {$ifdef GDB}
-          function stabstring : pchar;virtual;
+          function  stabstring : pchar;virtual;
           procedure concatstabto(asmlist : paasmoutput);virtual;
 {$endif GDB}
+       private
+          _mangledname  : pchar;
        end;
 
        ppropertysym = ^tpropertysym;
        tpropertysym = object(tsym)
-          options : longint;
-          proptype : pdef;
-          { proppara : pdefcoll; }
+          propoptions : tpropertyoptions;
+          proptype    : pdef;
           readaccesssym,writeaccesssym,storedsym : psym;
           readaccessdef,writeaccessdef,storeddef : pdef;
           index,default : longint;
           constructor init(const n : string);
-          destructor done;virtual;
+          destructor  done;virtual;
           constructor load;
-          function getsize : longint;virtual;
+          function  getsize : longint;virtual;
           procedure write;virtual;
           procedure deref;virtual;
 {$ifdef GDB}
-          { I don't know how (FK) }
-          function stabstring : pchar;virtual;
+          function  stabstring : pchar;virtual;
           procedure concatstabto(asmlist : paasmoutput);virtual;
 {$endif GDB}
        end;
@@ -226,7 +223,7 @@
        tfuncretsym = object(tsym)
           funcretprocinfo : pointer{ should be pprocinfo};
           funcretdef : pdef;
-          address : longint;
+          address    : longint;
           constructor init(const n : string;approcinfo : pointer{pprocinfo});
           constructor load;
           procedure write;virtual;
@@ -241,20 +238,16 @@
 
        pabsolutesym = ^tabsolutesym;
        tabsolutesym = object(tvarsym)
-          abstyp : absolutetyp;
-          absseg : boolean;
-          ref : psym;
+          abstyp  : absolutetyp;
+          absseg  : boolean;
+          ref     : psym;
           asmname : pstring;
           constructor init(const n : string;p : pdef);
           constructor load;
           procedure deref;virtual;
-          function mangledname : string;virtual;
+          function  mangledname : string;virtual;
           procedure write;virtual;
           procedure insert_in_data;virtual;
-          { this creates a problem in gen_vmt !!!!!
-          because the pdef is not resolved yet !!
-          we should fix this
-          constructor init(const s : string;p : pdef;newref : psym);}
 {$ifdef GDB}
           procedure concatstabto(asmlist : paasmoutput);virtual;
 {$endif GDB}
@@ -262,9 +255,9 @@
 
        ptypedconstsym = ^ttypedconstsym;
        ttypedconstsym = object(tsym)
-          prefix : pstring;
-          definition : pdef;
-          definitionsym : ptypesym;
+          prefix          : pstring;
+          definition      : pdef;
+          definitionsym   : ptypesym;
           is_really_const : boolean;
           constructor init(const n : string;p : pdef;really_const : boolean);
           constructor initsym(const n : string;p : ptypesym;really_const : boolean);
@@ -276,7 +269,7 @@
           function  getsize:longint;
           procedure insert_in_data;virtual;
 {$ifdef GDB}
-          function stabstring : pchar;virtual;
+          function  stabstring : pchar;virtual;
 {$endif GDB}
        end;
 
@@ -300,15 +293,15 @@
           procedure deref;virtual;
           procedure write;virtual;
 {$ifdef GDB}
-          function stabstring : pchar;virtual;
+          function  stabstring : pchar;virtual;
           procedure concatstabto(asmlist : paasmoutput);virtual;
 {$endif GDB}
        end;
 
        tenumsym = object(tsym)
-          value : longint;
+          value      : longint;
           definition : penumdef;
-          nextenum : penumsym;
+          nextenum   : penumsym;
           constructor init(const n : string;def : penumdef;v : longint);
           constructor load;
           procedure write;virtual;
@@ -329,7 +322,7 @@
           number : longint;
           constructor init(const n : string;l : longint);
           constructor load;
-          destructor done;virtual;
+          destructor  done;virtual;
           procedure write;virtual;
 {$ifdef GDB}
           procedure concatstabto(asmlist : paasmoutput);virtual;
@@ -338,7 +331,11 @@
 
 {
   $Log$
-  Revision 1.29  1999-07-27 23:42:23  peter
+  Revision 1.30  1999-08-03 22:03:21  peter
+    * moved bitmask constants to sets
+    * some other type/const renamings
+
+  Revision 1.29  1999/07/27 23:42:23  peter
     * indirect type referencing is now allowed
 
   Revision 1.28  1999/07/24 15:13:01  michael

+ 35 - 36
compiler/symtable.pas

@@ -34,6 +34,7 @@ unit symtable;
 {$endif}
        strings,cobjects,
        globtype,globals,tokens,systems,verbose,
+       symconst,
        aasm
 {$ifdef i386}
        ,i386base
@@ -63,13 +64,6 @@ unit symtable;
   {$endif}
 
 
-{************************************************
-                Constants
-************************************************}
-
-{$i symconst.inc}
-
-
 {************************************************
             Needed forward pointers
 ************************************************}
@@ -247,7 +241,7 @@ unit symtable;
     const
        systemunit           : punitsymtable = nil; { pointer to the system unit }
        objpasunit           : punitsymtable = nil; { pointer to the objpas unit }
-       current_object_option : symprop = sp_public;
+       current_object_option : tsymoptions = [sp_public];
 
     var
        { for STAB debugging }
@@ -286,7 +280,7 @@ unit symtable;
        s32bitdef : porddef;     { Pointer to 32-Bit signed        }
 
        cu64bitdef : porddef;       { pointer to 64 bit unsigned def }
-       cs64bitintdef : porddef;    { pointer to 64 bit signed def, }
+       cs64bitdef : porddef;    { pointer to 64 bit signed def, }
                                    { calculated by the int unit on i386 }
 
        s32floatdef : pfloatdef;    { pointer for realconstn         }
@@ -701,9 +695,9 @@ implementation
                  pd:=st^.getdefnr(p^.index);
                  case pd^.deftype of
                    recorddef :
-                     st:=precdef(pd)^.symtable;
+                     st:=precorddef(pd)^.symtable;
                    objectdef :
-                     st:=pobjectdef(pd)^.publicsyms;
+                     st:=pobjectdef(pd)^.symtable;
                  else
                    internalerror(556658);
                  end;
@@ -967,7 +961,7 @@ implementation
               while (srsymtable^.symtabletype in [objectsymtable,recordsymtable]) do
                    srsymtable:=srsymtable^.next;
               srsym:=new(ptypesym,init(s,nil));
-              srsym^.properties:=sp_forwarddef;
+              srsym^.symoptions:=[sp_forwarddef];
               srsymtable^.insert(srsym);
            end
          else if notfounderror then
@@ -1133,7 +1127,7 @@ implementation
            iblongstringdef : hp:=new(pstringdef,longload);
            ibansistringdef : hp:=new(pstringdef,ansiload);
            ibwidestringdef : hp:=new(pstringdef,wideload);
-               ibrecorddef : hp:=new(precdef,load);
+               ibrecorddef : hp:=new(precorddef,load);
                ibobjectdef : hp:=new(pobjectdef,load);
                  ibenumdef : hp:=new(penumdef,load);
                   ibsetdef : hp:=new(psetdef,load);
@@ -1457,8 +1451,8 @@ implementation
                    if hp^.symtabletype in [staticsymtable,globalsymtable] then
                     begin
                        hsym:=hp^.search(sym^.name);
-                       if (assigned(hsym)) and
-                          (hsym^.properties and sp_forwarddef=0) then
+                       if assigned(hsym) and
+                          not(sp_forwarddef in hsym^.symoptions) then
                          DuplicateSym(hsym);
                     end;
                   hp:=hp^.next;
@@ -1491,7 +1485,7 @@ implementation
               hsym:=search_class_member(pobjectdef(next^.next^.defowner),sym^.name);
               { but private ids can be reused }
               if assigned(hsym) and
-                ((hsym^.properties<>sp_private) or
+                (not(sp_private in hsym^.symoptions) or
                  (hsym^.owner^.defowner^.owner^.symtabletype<>unitsymtable)) then
                 DuplicateSym(hsym);
            end;
@@ -1503,26 +1497,26 @@ implementation
               hsym:=search_class_member(pobjectdef(defowner),sym^.name);
               { but private ids can be reused }
               if assigned(hsym) and
-                ((hsym^.properties<>sp_private) or
+                (not(sp_private in hsym^.symoptions) or
                  (hsym^.owner^.defowner^.owner^.symtabletype<>unitsymtable)) then
                 DuplicateSym(hsym);
            end;
-
-         if sym^.typ = typesym then
-           if assigned(ptypesym(sym)^.definition) then
-             begin
-             if not assigned(ptypesym(sym)^.definition^.owner) and
-                (ptypesym(sym)^.definition^.deftype<>errordef) then
+         { register definition of typesym }
+         if (sym^.typ = typesym) and
+            assigned(ptypesym(sym)^.definition) then
+          begin
+            if not(assigned(ptypesym(sym)^.definition^.owner)) and
+               (ptypesym(sym)^.definition^.deftype<>errordef) then
               registerdef(ptypesym(sym)^.definition);
 {$ifdef GDB}
-             if (cs_debuginfo in aktmoduleswitches) and assigned(debuglist)
-                and (symtabletype in [globalsymtable,staticsymtable]) then
-                   begin
-                   ptypesym(sym)^.isusedinstab := true;
-                   sym^.concatstabto(debuglist);
-                   end;
+            if (cs_debuginfo in aktmoduleswitches) and assigned(debuglist) and
+               (symtabletype in [globalsymtable,staticsymtable]) then
+              begin
+                ptypesym(sym)^.isusedinstab := true;
+                sym^.concatstabto(debuglist);
+              end;
 {$endif GDB}
-             end;
+          end;
          { insert in index and search hash }
          symindex^.insert(sym);
          symsearch^.insert(sym);
@@ -1549,7 +1543,7 @@ implementation
              be carefull aktprocsym^.definition is not allways
              loaded already (PFV) }
            if (symtabletype=objectsymtable) and
-              ((hp^.properties and sp_static)=0) and
+              not(sp_static in hp^.symoptions) and
               allow_only_static
               {assigned(aktprocsym) and
               assigned(aktprocsym^.definition) and
@@ -2138,7 +2132,7 @@ implementation
          sym:=nil;
          while assigned(pd) do
            begin
-              sym:=pd^.publicsyms^.search(n);
+              sym:=pd^.symtable^.search(n);
               if assigned(sym) then
                 break;
               pd:=pd^.childof;
@@ -2147,7 +2141,7 @@ implementation
            caused bug0214 }
          if assigned(sym) then
            begin
-             srsymtable:=pd^.publicsyms;
+             srsymtable:=pd^.symtable;
            end;
          search_class_member:=sym;
       end;
@@ -2157,7 +2151,8 @@ implementation
 
    procedure testfordefaultproperty(p : pnamedindexobject);
      begin
-        if (psym(p)^.typ=propertysym) and ((ppropertysym(p)^.options and ppo_defaultproperty)<>0) then
+        if (psym(p)^.typ=propertysym) and
+           (ppo_defaultproperty in ppropertysym(p)^.propoptions) then
           _defaultprop:=ppropertysym(p);
      end;
 
@@ -2168,7 +2163,7 @@ implementation
         _defaultprop:=nil;
         while assigned(pd) do
           begin
-             pd^.publicsyms^.foreach({$ifndef TP}@{$endif}testfordefaultproperty);
+             pd^.symtable^.foreach({$ifndef TP}@{$endif}testfordefaultproperty);
              if assigned(_defaultprop) then
                break;
              pd:=pd^.childof;
@@ -2348,7 +2343,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.34  1999-08-03 17:51:45  florian
+  Revision 1.35  1999-08-03 22:03:22  peter
+    * moved bitmask constants to sets
+    * some other type/const renamings
+
+  Revision 1.34  1999/08/03 17:51:45  florian
     * reduced memory usage by factor 2-3 (it
       improved also the speed) by reducing the
       growsize of the symbol tables

+ 37 - 31
compiler/systems.pas

@@ -62,7 +62,9 @@ unit systems;
             target_m68k_linux,target_m68k_PalmOS,target_alpha_linux
        );
 
-       ttargetflags = (tf_needs_isconsole,tf_supports_stack_checking);
+       ttargetflags = (tf_none,
+            tf_supports_stack_checking,tf_need_export
+       );
 
      const
        {$ifdef i386} i386targetcnt=5; {$else} i386targetcnt=0; {$endif}
@@ -206,7 +208,7 @@ unit systems;
        ttargetinfo = packed record
           target      : ttarget;
           flags       : set of ttargetflags;
-          cpu    : ttargetcpu;
+          cpu         : ttargetcpu;
           short_name  : string[8];
           unit_env    : string[12];
           system_unit : string[8];
@@ -218,12 +220,12 @@ unit systems;
           resext,
           resobjext,
           exeext      : string[4];
-          os      : tos;
-          link  : tlink;
+          os          : tos;
+          link        : tlink;
           assem       : tasm;
           assemsrc    : tasm; { default source writing assembler }
-          ar      : tar;
-          res    : tres;
+          ar          : tar;
+          res         : tres;
           heapsize,
           maxheapsize,
           stacksize   : longint;
@@ -984,7 +986,7 @@ implementation
           ,(
             target      : target_i386_GO32V1;
             flags       : [];
-            cpu  : i386;
+            cpu         : i386;
             short_name  : 'GO32V1';
             unit_env    : 'GO32V1UNITS';
             system_unit : 'SYSTEM';
@@ -996,12 +998,12 @@ implementation
             resext      : '.res';
             resobjext   : '.o1r';
             exeext      : ''; { The linker produces a.out }
-            os    : os_i386_GO32V1;
+            os          : os_i386_GO32V1;
             link        : link_i386_ldgo32v1;
             assem       : as_i386_as;
             assemsrc    : as_i386_as;
-            ar    : ar_i386_ar;
-            res  : res_none;
+            ar          : ar_i386_ar;
+            res         : res_none;
             heapsize    : 2048*1024;
             maxheapsize : 32768*1024;
             stacksize   : 16384
@@ -1009,7 +1011,7 @@ implementation
           (
             target      : target_i386_GO32V2;
             flags       : [];
-            cpu  : i386;
+            cpu         : i386;
             short_name  : 'GO32V2';
             unit_env    : 'GO32V2UNITS';
             system_unit : 'SYSTEM';
@@ -1021,12 +1023,12 @@ implementation
             resext      : '.res';
             resobjext   : '.or';
             exeext      : '.exe';
-            os    : os_i386_GO32V2;
+            os          : os_i386_GO32V2;
             link        : link_i386_ldgo32v2;
             assem       : as_i386_coff;
             assemsrc    : as_i386_as;
-            ar    : ar_i386_ar;
-            res  : res_none;
+            ar          : ar_i386_ar;
+            res         : res_none;
             heapsize    : 2048*1024;
             maxheapsize : 32768*1024;
             stacksize   : 16384
@@ -1058,7 +1060,7 @@ implementation
           ),
           (
             target      : target_i386_OS2;
-            flags       : [];
+            flags       : [tf_need_export];
             cpu  : i386;
             short_name  : 'OS2';
             unit_env    : 'OS2UNITS';
@@ -1084,7 +1086,7 @@ implementation
           (
             target      : target_i386_WIN32;
             flags       : [];
-            cpu  : i386;
+            cpu         : i386;
             short_name  : 'WIN32';
             unit_env    : 'WIN32UNITS';
             system_unit : 'SYSWIN32';
@@ -1111,7 +1113,7 @@ implementation
           ,(
             target      : target_m68k_Amiga;
             flags       : [];
-            cpu  : m68k;
+            cpu         : m68k;
             short_name  : 'AMIGA';
             unit_env    : '';
             system_unit : 'sysamiga';
@@ -1136,7 +1138,7 @@ implementation
           (
             target      : target_m68k_Atari;
             flags       : [];
-            cpu  : m68k;
+            cpu         : m68k;
             short_name  : 'ATARI';
             unit_env    : '';
             system_unit : 'SYSATARI';
@@ -1161,7 +1163,7 @@ implementation
           (
             target      : target_m68k_Mac;
             flags       : [];
-            cpu  : m68k;
+            cpu         : m68k;
             short_name  : 'MACOS';
             unit_env    : '';
             system_unit : 'sysmac';
@@ -1173,12 +1175,12 @@ implementation
             resext      : '.res';
             resobjext   : '.or';
             exeext      : '';
-            os    : os_m68k_Mac;
+            os          : os_m68k_Mac;
             link        : link_m68k_ld;
             assem       : as_m68k_mpw;
             assemsrc    : as_m68k_mpw;
-            ar    : ar_m68k_ar;
-            res  : res_none;
+            ar          : ar_m68k_ar;
+            res         : res_none;
             heapsize    : 128*1024;
             maxheapsize : 32768*1024;
             stacksize   : 8192
@@ -1186,7 +1188,7 @@ implementation
           (
             target      : target_m68k_linux;
             flags       : [];
-            cpu  : m68k;
+            cpu         : m68k;
             short_name  : 'LINUX';
             unit_env    : 'LINUXUNITS';
             system_unit : 'syslinux';
@@ -1198,12 +1200,12 @@ implementation
             resext      : '.res';
             resobjext   : '.or';
             exeext      : '';
-            os    : os_m68k_Linux;
+            os          : os_m68k_Linux;
             link        : link_m68k_ld;
             assem       : as_m68k_as;
             assemsrc    : as_m68k_as;
-            ar    : ar_m68k_ar;
-            res  : res_none;
+            ar          : ar_m68k_ar;
+            res         : res_none;
             heapsize    : 128*1024;
             maxheapsize : 32768*1024;
             stacksize   : 8192
@@ -1211,7 +1213,7 @@ implementation
           (
             target      : target_m68k_PalmOS;
             flags       : [];
-            cpu  : m68k;
+            cpu         : m68k;
             short_name  : 'PALMOS';
             unit_env    : 'PALMUNITS';
             system_unit : 'syspalm';
@@ -1223,12 +1225,12 @@ implementation
             resext      : '.res';
             resobjext   : '.or';
             exeext      : '';
-            os    : os_m68k_PalmOS;
+            os          : os_m68k_PalmOS;
             link        : link_m68k_ld;
             assem       : as_m68k_as;
             assemsrc    : as_m68k_as;
-            ar    : ar_m68k_ar;
-            res  : res_none;
+            ar          : ar_m68k_ar;
+            res         : res_none;
             heapsize    : 128*1024;
             maxheapsize : 32768*1024;
             stacksize   : 8192
@@ -1624,7 +1626,11 @@ begin
 end.
 {
   $Log$
-  Revision 1.87  1999-08-03 17:09:43  florian
+  Revision 1.88  1999-08-03 22:03:23  peter
+    * moved bitmask constants to sets
+    * some other type/const renamings
+
+  Revision 1.87  1999/08/03 17:09:43  florian
     * the alpha compiler can be compiled now
 
   Revision 1.86  1999/08/03 15:52:00  michael

+ 18 - 14
compiler/tcadd.pas

@@ -34,7 +34,7 @@ implementation
     uses
       globtype,systems,tokens,
       cobjects,verbose,globals,
-      symtable,aasm,types,
+      symconst,symtable,aasm,types,
       hcodegen,htypechk,pass_1
 {$ifdef i386}
       ,i386base
@@ -115,7 +115,7 @@ implementation
               (porddef(parraydef(ld)^.definition)^.typ<>uchar))) or
             { <> and = are defined for classes }
             ((ld^.deftype=objectdef) and
-             (not(pobjectdef(ld)^.isclass) or
+             (not(pobjectdef(ld)^.is_class) or
               not(p^.treetype in [equaln,unequaln])
              )
             ) or
@@ -126,7 +126,7 @@ implementation
               (porddef(parraydef(rd)^.definition)^.typ<>uchar))) or
             { <> and = are defined for classes }
             ((rd^.deftype=objectdef) and
-             (not(pobjectdef(rd)^.isclass) or
+             (not(pobjectdef(rd)^.is_class) or
               not(p^.treetype in [equaln,unequaln])
              )
             ) then
@@ -456,16 +456,16 @@ implementation
                  convdone:=true;
                end
               { is there a 64 bit type ? }
-             else if (porddef(rd)^.typ=s64bitint) or (porddef(ld)^.typ=s64bitint) then
+             else if (porddef(rd)^.typ=s64bit) or (porddef(ld)^.typ=s64bit) then
                begin
-                  if (porddef(ld)^.typ<>s64bitint) then
+                  if (porddef(ld)^.typ<>s64bit) then
                     begin
-                      p^.left:=gentypeconvnode(p^.left,cs64bitintdef);
+                      p^.left:=gentypeconvnode(p^.left,cs64bitdef);
                       firstpass(p^.left);
                     end;
-                  if (porddef(rd)^.typ<>s64bitint) then
+                  if (porddef(rd)^.typ<>s64bit) then
                     begin
-                       p^.right:=gentypeconvnode(p^.right,cs64bitintdef);
+                       p^.right:=gentypeconvnode(p^.right,cs64bitdef);
                        firstpass(p^.right);
                     end;
                   calcregisters(p,2,0,0);
@@ -831,10 +831,10 @@ implementation
          else
 
            if (rd^.deftype=objectdef) and (ld^.deftype=objectdef) and
-              pobjectdef(rd)^.isclass and pobjectdef(ld)^.isclass then
+              pobjectdef(rd)^.is_class and pobjectdef(ld)^.is_class then
             begin
               p^.location.loc:=LOC_REGISTER;
-              if pobjectdef(rd)^.isrelated(pobjectdef(ld)) then
+              if pobjectdef(rd)^.is_related(pobjectdef(ld)) then
                 p^.right:=gentypeconvnode(p^.right,ld)
               else
                 p^.left:=gentypeconvnode(p^.left,rd);
@@ -852,7 +852,7 @@ implementation
            if (rd^.deftype=classrefdef) and (ld^.deftype=classrefdef) then
             begin
               p^.location.loc:=LOC_REGISTER;
-              if pobjectdef(pclassrefdef(rd)^.definition)^.isrelated(pobjectdef(
+              if pobjectdef(pclassrefdef(rd)^.definition)^.is_related(pobjectdef(
                 pclassrefdef(ld)^.definition)) then
                 p^.right:=gentypeconvnode(p^.right,ld)
               else
@@ -870,7 +870,7 @@ implementation
 
          { allows comperasion with nil pointer }
            if (rd^.deftype=objectdef) and
-              pobjectdef(rd)^.isclass then
+              pobjectdef(rd)^.is_class then
             begin
               p^.location.loc:=LOC_REGISTER;
               p^.left:=gentypeconvnode(p^.left,rd);
@@ -885,7 +885,7 @@ implementation
          else
 
            if (ld^.deftype=objectdef) and
-              pobjectdef(ld)^.isclass then
+              pobjectdef(ld)^.is_class then
             begin
               p^.location.loc:=LOC_REGISTER;
               p^.right:=gentypeconvnode(p^.right,ld);
@@ -1117,7 +1117,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.37  1999-07-16 10:04:37  peter
+  Revision 1.38  1999-08-03 22:03:24  peter
+    * moved bitmask constants to sets
+    * some other type/const renamings
+
+  Revision 1.37  1999/07/16 10:04:37  peter
     * merged
 
   Revision 1.36  1999/06/17 15:32:48  pierre

+ 33 - 17
compiler/tccal.pas

@@ -39,7 +39,7 @@ implementation
     uses
       globtype,systems,
       cobjects,verbose,globals,
-      aasm,types,
+      symconst,aasm,types,
       hcodegen,htypechk,pass_1
 {$ifdef i386}
       ,i386base,tgeni386
@@ -221,7 +221,7 @@ implementation
                      not(
                         (p^.left^.resulttype^.deftype=objectdef) and
                         (defcoll^.data^.deftype=objectdef) and
-                        pobjectdef(p^.left^.resulttype)^.isrelated(pobjectdef(defcoll^.data))
+                        pobjectdef(p^.left^.resulttype)^.is_related(pobjectdef(defcoll^.data))
                         ) and
                    { passing a single element to a openarray of the same type }
                      not(
@@ -244,8 +244,8 @@ implementation
                    { process cargs arrayconstructor }
                    if is_array_constructor(p^.left^.resulttype) and
                       assigned(aktcallprocsym) and
-                      (aktcallprocsym^.definition^.options and pocdecl<>0) and
-                      (aktcallprocsym^.definition^.options and poexternal<>0) then
+                      (pocall_cdecl in aktcallprocsym^.definition^.proccalloptions) and
+                      (po_external in aktcallprocsym^.definition^.procoptions) then
                     begin
                       p^.left^.cargs:=true;
                       old_array_constructor:=allow_array_constructor;
@@ -434,18 +434,22 @@ implementation
 
          inlined:=false;
          if assigned(p^.procdefinition) and
-            ((p^.procdefinition^.options and poinline)<>0) then
+            (pocall_inline in p^.procdefinition^.proccalloptions) then
            begin
               inlinecode:=p^.right;
               if assigned(inlinecode) then
                 begin
                    inlined:=true;
-                   p^.procdefinition^.options:=p^.procdefinition^.options and (not poinline);
+{$ifdef INCLUDEOK}
+                   exclude(p^.procdefinition^.proccalloptions,pocall_inline);
+{$else}
+                   p^.procdefinition^.proccalloptions:=p^.procdefinition^.proccalloptions-[pocall_inline];
+{$endif}
                 end;
               p^.right:=nil;
            end;
          if assigned(p^.procdefinition) and
-            ((p^.procdefinition^.options and pocontainsself)<>0) then
+            (po_containsself in p^.procdefinition^.procoptions) then
            message(cg_e_cannot_call_message_direct);
 
          { procedure variable ? }
@@ -962,11 +966,11 @@ implementation
 {$endif CHAINPROCSYMS}
                end; { end of procedure to call determination }
 
-              is_const:=((p^.procdefinition^.options and pointernconst)<>0) and
+              is_const:=(pocall_internconst in p^.procdefinition^.proccalloptions) and
                         ((block_type=bt_const) or
                          (assigned(p^.left) and (p^.left^.left^.treetype in [realconstn,ordconstn])));
               { handle predefined procedures }
-              if ((p^.procdefinition^.options and pointernproc)<>0) or is_const then
+              if (pocall_internproc in p^.procdefinition^.proccalloptions) or is_const then
                 begin
                    if assigned(p^.left) then
                      begin
@@ -992,7 +996,7 @@ implementation
                 { no intern procedure => we do a call }
               { calc the correture value for the register }
               { handle predefined procedures }
-              if (p^.procdefinition^.options and poinline)<>0 then
+              if (pocall_inline in p^.procdefinition^.proccalloptions) then
                 begin
                    if assigned(p^.methodpointer) then
                      CGMessage(cg_e_unable_inline_object_methods);
@@ -1009,7 +1013,11 @@ implementation
                           begin
                              { consider it has not inlined if called
                                again inside the args }
-                             p^.procdefinition^.options:=p^.procdefinition^.options and (not poinline);
+{$ifdef INCLUDEOK}
+                             exclude(p^.procdefinition^.proccalloptions,pocall_inline);
+{$else}
+                             p^.procdefinition^.proccalloptions:=p^.procdefinition^.proccalloptions-[pocall_inline];
+{$endif}
                              firstpass(inlinecode);
                              inlined:=true;
                           end;
@@ -1047,7 +1055,7 @@ implementation
          { get a register for the return value }
          if (p^.resulttype<>pdef(voiddef)) then
            begin
-              if (p^.procdefinition^.options and poconstructor)<>0 then
+              if (p^.procdefinition^.proctypeoption=potype_constructor) then
                 begin
                    { extra handling of classes }
                    { p^.methodpointer should be assigned! }
@@ -1109,7 +1117,7 @@ implementation
                 typen,hnewn : ;
                 else
                   begin
-                     if ((p^.procdefinition^.options and (poconstructor or podestructor)) <> 0) and
+                     if (p^.procdefinition^.proctypeoption in [potype_constructor,potype_destructor]) and
                         assigned(p^.symtable) and (p^.symtable^.symtabletype=withsymtable) and
                         not pwithsymtable(p^.symtable)^.direct_with then
                        begin
@@ -1120,9 +1128,9 @@ implementation
 
                      { R.Assign is not a constructor !!! }
                      { but for R^.Assign, R must be valid !! }
-                     if ((p^.procdefinition^.options and poconstructor) <> 0) or
+                     if (p^.procdefinition^.proctypeoption=potype_constructor) or
                         ((p^.methodpointer^.treetype=loadn) and
-                        ((pobjectdef(p^.methodpointer^.resulttype)^.options and oo_hasvirtual) = 0)) then
+                        (not(oo_has_virtual in pobjectdef(p^.methodpointer^.resulttype)^.objectoptions))) then
                        must_be_valid:=false
                      else
                        must_be_valid:=true;
@@ -1162,7 +1170,11 @@ implementation
          if assigned(procs) then
            dispose(procs);
          if inlined then
-           p^.procdefinition^.options:=p^.procdefinition^.options or poinline;
+{$ifdef INCLUDEOK}
+           include(p^.procdefinition^.proccalloptions,pocall_inline);
+{$else}
+           p^.procdefinition^.proccalloptions:=p^.procdefinition^.proccalloptions+[pocall_inline];
+{$endif}
          aktcallprocsym:=oldcallprocsym;
          must_be_valid:=store_valid;
       end;
@@ -1183,7 +1195,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.54  1999-07-01 21:33:58  peter
+  Revision 1.55  1999-08-03 22:03:27  peter
+    * moved bitmask constants to sets
+    * some other type/const renamings
+
+  Revision 1.54  1999/07/01 21:33:58  peter
     * merged
 
   Revision 1.53  1999/06/29 14:02:33  peter

+ 13 - 9
compiler/tccnv.pas

@@ -41,7 +41,7 @@ implementation
    uses
       globtype,systems,tokens,
       cobjects,verbose,globals,
-      symtable,aasm,types,
+      symconst,symtable,aasm,types,
       hcodegen,htypechk,pass_1
 {$ifdef i386}
       ,i386base
@@ -819,7 +819,7 @@ implementation
                { the conversion into a strutured type is only }
                { possible, if the source is no register    }
                if ((p^.resulttype^.deftype in [recorddef,stringdef,arraydef]) or
-                   ((p^.resulttype^.deftype=objectdef) and not(pobjectdef(p^.resulttype)^.isclass))
+                   ((p^.resulttype^.deftype=objectdef) and not(pobjectdef(p^.resulttype)^.is_class))
                   ) and (p^.left^.location.loc in [LOC_REGISTER,LOC_CREGISTER]) { and
                    it also works if the assignment is overloaded
                    YES but this code is not executed if assignment is overloaded (PM)
@@ -870,13 +870,13 @@ implementation
 
          { left must be a class }
          if (p^.left^.resulttype^.deftype<>objectdef) or
-            not(pobjectdef(p^.left^.resulttype)^.isclass) then
+            not(pobjectdef(p^.left^.resulttype)^.is_class) then
            CGMessage(type_e_mismatch);
 
          { the operands must be related }
-         if (not(pobjectdef(p^.left^.resulttype)^.isrelated(
+         if (not(pobjectdef(p^.left^.resulttype)^.is_related(
            pobjectdef(pclassrefdef(p^.right^.resulttype)^.definition)))) and
-           (not(pobjectdef(pclassrefdef(p^.right^.resulttype)^.definition)^.isrelated(
+           (not(pobjectdef(pclassrefdef(p^.right^.resulttype)^.definition)^.is_related(
            pobjectdef(p^.left^.resulttype)))) then
            CGMessage(type_e_mismatch);
 
@@ -908,13 +908,13 @@ implementation
 
          { left must be a class }
          if (p^.left^.resulttype^.deftype<>objectdef) or
-           not(pobjectdef(p^.left^.resulttype)^.isclass) then
+           not(pobjectdef(p^.left^.resulttype)^.is_class) then
            CGMessage(type_e_mismatch);
 
          { the operands must be related }
-         if (not(pobjectdef(p^.left^.resulttype)^.isrelated(
+         if (not(pobjectdef(p^.left^.resulttype)^.is_related(
            pobjectdef(pclassrefdef(p^.right^.resulttype)^.definition)))) and
-           (not(pobjectdef(pclassrefdef(p^.right^.resulttype)^.definition)^.isrelated(
+           (not(pobjectdef(pclassrefdef(p^.right^.resulttype)^.definition)^.is_related(
            pobjectdef(p^.left^.resulttype)))) then
            CGMessage(type_e_mismatch);
 
@@ -926,7 +926,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.41  1999-06-30 22:16:23  florian
+  Revision 1.42  1999-08-03 22:03:28  peter
+    * moved bitmask constants to sets
+    * some other type/const renamings
+
+  Revision 1.41  1999/06/30 22:16:23  florian
     * use of is_ordinal checked: often a qword/int64 isn't allowed (case/for ...)
     * small qword problems fixed
 

+ 6 - 2
compiler/tccon.pas

@@ -38,7 +38,7 @@ implementation
 
     uses
       cobjects,verbose,globals,systems,
-      symtable,aasm,types,
+      symconst,symtable,aasm,types,
       hcodegen,pass_1
 {$ifdef i386}
       ,i386base
@@ -126,7 +126,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.6  1999-05-27 19:45:16  peter
+  Revision 1.7  1999-08-03 22:03:29  peter
+    * moved bitmask constants to sets
+    * some other type/const renamings
+
+  Revision 1.6  1999/05/27 19:45:16  peter
     * removed oldasm
     * plabel -> pasmlabel
     * -a switches to source writing automaticly

+ 11 - 8
compiler/tcflw.pas

@@ -74,12 +74,11 @@ implementation
          firstpass(p^.left);
          if codegenerror then
            exit;
-         if not((p^.left^.resulttype^.deftype=orddef) and
-            (porddef(p^.left^.resulttype)^.typ in [bool8bit,bool16bit,bool32bit])) then
-            begin
-               CGMessage(type_e_mismatch);
-               exit;
-            end;
+         if not is_boolean(p^.left^.resulttype) then
+           begin
+             CGMessage(type_e_mismatch);
+             exit;
+           end;
 
          p^.registers32:=p^.left^.registers32;
          p^.registersfpu:=p^.left^.registersfpu;
@@ -381,7 +380,7 @@ implementation
 
               { this must be a _class_ }
               if (p^.left^.resulttype^.deftype<>objectdef) or
-                ((pobjectdef(p^.left^.resulttype)^.options and oo_is_class)=0) then
+                 not(pobjectdef(p^.left^.resulttype)^.is_class) then
                 CGMessage(type_e_mismatch);
 
               p^.registersfpu:=p^.left^.registersfpu;
@@ -493,7 +492,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.13  1999-08-01 18:28:15  florian
+  Revision 1.14  1999-08-03 22:03:30  peter
+    * moved bitmask constants to sets
+    * some other type/const renamings
+
+  Revision 1.13  1999/08/01 18:28:15  florian
     * modifications for the new code generator
 
   Revision 1.12  1999/06/30 22:16:25  florian

+ 9 - 5
compiler/tcinl.pas

@@ -34,7 +34,7 @@ implementation
     uses
       cobjects,verbose,globals,systems,
       globtype,
-      symtable,aasm,types,
+      symconst,symtable,aasm,types,
       hcodegen,htypechk,pass_1,
       tccal
 {$ifdef i386}
@@ -668,7 +668,7 @@ implementation
                                           case porddef(hp^.left^.resulttype)^.typ of
                                             uchar,
                                             u32bit,s32bit,
-                                            u64bit,s64bitint:
+                                            u64bit,s64bit:
                                               ;
                                             u8bit,s8bit,
                                             u16bit,s16bit :
@@ -823,7 +823,7 @@ implementation
                       begin
                         case porddef(hp^.left^.resulttype)^.typ of
                           u32bit,s32bit,
-                          s64bitint,u64bit:
+                          s64bit,u64bit:
                             ;
                           u8bit,s8bit,
                           u16bit,s16bit:
@@ -929,7 +929,7 @@ implementation
                            ((hpp^.left^.resulttype^.deftype = orddef) And
                             (POrdDef(hpp^.left^.resulttype)^.typ in
                               [u32bit,s32bit,
-                               u8bit,s8bit,u16bit,s16bit,s64bitint,u64bit])))
+                               u8bit,s8bit,u16bit,s16bit,s64bit,u64bit])))
                         Then CGMessage(type_e_mismatch);
                   must_be_valid:=true;
                  {hp = source (String)}
@@ -1123,7 +1123,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.43  1999-07-30 12:28:43  peter
+  Revision 1.44  1999-08-03 22:03:32  peter
+    * moved bitmask constants to sets
+    * some other type/const renamings
+
+  Revision 1.43  1999/07/30 12:28:43  peter
     * fixed crash with unknown id and colon parameter in write
 
   Revision 1.42  1999/07/18 14:47:35  florian

+ 35 - 20
compiler/tcld.pas

@@ -38,7 +38,7 @@ implementation
 
     uses
       cobjects,verbose,globals,systems,
-      symtable,aasm,types,
+      symconst,symtable,aasm,types,
       hcodegen,htypechk,pass_1,
       tccnv
 {$ifdef i386}
@@ -120,8 +120,11 @@ implementation
                         begin
                           p^.registers32:=1;
                           { further, the variable can't be put into a register }
-                          pvarsym(p^.symtableentry)^.var_options:=
-                            pvarsym(p^.symtableentry)^.var_options and not vo_regable;
+{$ifdef INCLUDEOK}
+                          exclude(pvarsym(p^.symtableentry)^.varoptions,vo_regable);
+{$else}
+                          pvarsym(p^.symtableentry)^.varoptions:=pvarsym(p^.symtableentry)^.varoptions-[vo_regable];
+{$endif}
                         end;
                      end;
                    if (pvarsym(p^.symtableentry)^.varspez=vs_const) then
@@ -136,7 +139,7 @@ implementation
                    if p^.symtable^.symtabletype=withsymtable then
                      inc(p^.registers32);
 
-                   if (pvarsym(p^.symtableentry)^.var_options and (vo_is_thread_var or vo_is_dll_var))<>0 then
+                   if ([vo_is_thread_var,vo_is_dll_var]*pvarsym(p^.symtableentry)^.varoptions)<>[] then
                      p^.registers32:=1;
                    { a class variable is a pointer !!!
                      yes, but we have to resolve the reference in an
@@ -151,24 +154,25 @@ implementation
 
                    if must_be_valid and p^.is_first then
                      begin
-                     if pvarsym(p^.symtableentry)^.is_valid=2 then
-                       if (assigned(pvarsym(p^.symtableentry)^.owner) and assigned(aktprocsym)
-                       and (pvarsym(p^.symtableentry)^.owner = aktprocsym^.definition^.localst)) then
-                       begin
-                          if p^.symtable^.symtabletype=localsymtable then
+                       if pvarsym(p^.symtableentry)^.varstate=vs_declared2 then
+                        if (assigned(pvarsym(p^.symtableentry)^.owner) and
+                           assigned(aktprocsym) and
+                           (pvarsym(p^.symtableentry)^.owner = aktprocsym^.definition^.localst)) then
+                         begin
+                           if p^.symtable^.symtabletype=localsymtable then
                             CGMessage1(sym_n_uninitialized_local_variable,pvarsym(p^.symtableentry)^.name)
-                          else
+                           else
                             CGMessage1(sym_n_uninitialized_variable,pvarsym(p^.symtableentry)^.name);
-                       end;
+                         end;
                      end;
                    if count_ref then
                      begin
                         if (p^.is_first) then
                           begin
-                             if (pvarsym(p^.symtableentry)^.is_valid=2) then
-                               pvarsym(p^.symtableentry)^.is_valid:=1;
-                              p^.is_first:=false;
-                           end;
+                            if pvarsym(p^.symtableentry)^.varstate=vs_declared2 then
+                             pvarsym(p^.symtableentry)^.varstate:=vs_used;
+                            p^.is_first:=false;
+                          end;
                      end;
                      { this will create problem with local var set by
                      under_procedures
@@ -181,8 +185,8 @@ implementation
                      inc(pvarsym(p^.symtableentry)^.refs,t_times);
                 end;
             typedconstsym :
-              if not p^.is_absolute then
-                     p^.resulttype:=ptypedconstsym(p^.symtableentry)^.definition;
+                if not p^.is_absolute then
+                  p^.resulttype:=ptypedconstsym(p^.symtableentry)^.definition;
             procsym :
                 begin
                    if assigned(pprocsym(p^.symtableentry)^.definition^.nextoverloaded) then
@@ -253,7 +257,7 @@ implementation
                   at_minus : p^.right:=gennode(subn,getcopy(p^.left),p^.right);
                   at_star  : p^.right:=gennode(muln,getcopy(p^.left),p^.right);
                   at_slash : p^.right:=gennode(slashn,getcopy(p^.left),p^.right);
-                  end;
+                end;
            end;
 {$endif i386}
          must_be_valid:=true;
@@ -263,7 +267,6 @@ implementation
            exit;
 
          { some string functions don't need conversion, so treat them separatly }
-
          if is_shortstring(p^.left^.resulttype) and (assigned(p^.right^.resulttype)) then
           begin
             if not (is_shortstring(p^.right^.resulttype) or
@@ -302,6 +305,14 @@ implementation
              exit;
           end;
 
+         { set assigned flag for varsyms }
+         if (p^.left^.treetype=loadn) and
+            (p^.left^.symtableentry^.typ=varsym) and
+            (pvarsym(p^.left^.symtableentry)^.varstate=vs_declared) then
+           pvarsym(p^.left^.symtableentry)^.varstate:=vs_assigned;
+
+
+
          p^.resulttype:=voiddef;
          {
            p^.registers32:=max(p^.left^.registers32,p^.right^.registers32);
@@ -470,7 +481,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.36  1999-07-22 09:38:00  florian
+  Revision 1.37  1999-08-03 22:03:33  peter
+    * moved bitmask constants to sets
+    * some other type/const renamings
+
+  Revision 1.36  1999/07/22 09:38:00  florian
     + resourcestring implemented
     + start of longstring support
 

+ 11 - 7
compiler/tcmat.pas

@@ -37,7 +37,7 @@ implementation
     uses
       globtype,systems,tokens,
       cobjects,verbose,globals,
-      symtable,aasm,types,
+      symconst,symtable,aasm,types,
       hcodegen,htypechk,pass_1
 {$ifdef i386}
       ,i386base
@@ -89,16 +89,16 @@ implementation
            begin
               rd:=p^.right^.resulttype;
               ld:=p^.left^.resulttype;
-              if (porddef(rd)^.typ=s64bitint) or (porddef(ld)^.typ=s64bitint) then
+              if (porddef(rd)^.typ=s64bit) or (porddef(ld)^.typ=s64bit) then
                 begin
-                   if (porddef(ld)^.typ<>s64bitint) then
+                   if (porddef(ld)^.typ<>s64bit) then
                      begin
-                       p^.left:=gentypeconvnode(p^.left,cs64bitintdef);
+                       p^.left:=gentypeconvnode(p^.left,cs64bitdef);
                        firstpass(p^.left);
                      end;
-                   if (porddef(rd)^.typ<>s64bitint) then
+                   if (porddef(rd)^.typ<>s64bit) then
                      begin
-                        p^.right:=gentypeconvnode(p^.right,cs64bitintdef);
+                        p^.right:=gentypeconvnode(p^.right,cs64bitdef);
                         firstpass(p^.right);
                      end;
                    calcregisters(p,2,0,0);
@@ -413,7 +413,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.16  1999-06-02 10:11:54  florian
+  Revision 1.17  1999-08-03 22:03:34  peter
+    * moved bitmask constants to sets
+    * some other type/const renamings
+
+  Revision 1.16  1999/06/02 10:11:54  florian
     * make cycle fixed i.e. compilation with 0.99.10
     * some fixes for qword
     * start of register calling conventions

+ 18 - 9
compiler/tcmem.pas

@@ -45,7 +45,7 @@ implementation
     uses
       globtype,systems,
       cobjects,verbose,globals,
-      symtable,aasm,types,
+      symconst,symtable,aasm,types,
       hcodegen,htypechk,pass_1
 {$ifdef i386}
       ,i386base
@@ -195,7 +195,7 @@ implementation
                         begin
                           { generate a methodcallnode or proccallnode }
                           if (p^.left^.symtableprocentry^.owner^.symtabletype=objectsymtable) and
-                             (pobjectdef(p^.left^.symtableprocentry^.owner^.defowner)^.isclass) then
+                             (pobjectdef(p^.left^.symtableprocentry^.owner^.defowner)^.is_class) then
                            begin
                              hp:=genloadmethodcallnode(pprocsym(p^.left^.symtableprocentry),p^.left^.symtableproc,
                                getcopy(p^.left^.methodpointer));
@@ -221,14 +221,19 @@ implementation
                         else
                          hp3:=pabstractprocdef(pprocsym(p^.left^.symtableprocentry)^.definition);
 
-                        pprocvardef(p^.resulttype)^.options:=hp3^.options;
+                        pprocvardef(p^.resulttype)^.proctypeoption:=hp3^.proctypeoption;
+                        pprocvardef(p^.resulttype)^.proccalloptions:=hp3^.proccalloptions;
+                        pprocvardef(p^.resulttype)^.procoptions:=hp3^.procoptions;
                         pprocvardef(p^.resulttype)^.retdef:=hp3^.retdef;
 
                       { method ? then set the methodpointer flag }
                         if (hp3^.owner^.symtabletype=objectsymtable) and
-                           (pobjectdef(hp3^.owner^.defowner)^.isclass) then
-                          pprocvardef(p^.resulttype)^.options:=pprocvardef(p^.resulttype)^.options or pomethodpointer;
-
+                           (pobjectdef(hp3^.owner^.defowner)^.is_class) then
+{$ifdef INCLUDEOK}
+                          include(pprocvardef(p^.resulttype)^.procoptions,po_methodpointer);
+{$else}
+                          pprocvardef(p^.resulttype)^.procoptions:=pprocvardef(p^.resulttype)^.procoptions+[po_methodpointer];
+{$endif}
                         hp2:=hp3^.para1;
                         while assigned(hp2) do
                           begin
@@ -383,7 +388,7 @@ implementation
 {$endif SUPPORT_MMX}
          { classes must be dereferenced implicit }
          if (p^.left^.resulttype^.deftype=objectdef) and
-           pobjectdef(p^.left^.resulttype)^.isclass then
+           pobjectdef(p^.left^.resulttype)^.is_class then
            begin
               if p^.registers32=0 then
                 p^.registers32:=1;
@@ -541,7 +546,7 @@ implementation
       begin
          if (p^.resulttype^.deftype=classrefdef) or
            ((p^.resulttype^.deftype=objectdef)
-             and pobjectdef(p^.resulttype)^.isclass
+             and pobjectdef(p^.resulttype)^.is_class
            ) then
            p^.location.loc:=LOC_CREGISTER
          else
@@ -591,7 +596,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.21  1999-07-16 10:04:39  peter
+  Revision 1.22  1999-08-03 22:03:35  peter
+    * moved bitmask constants to sets
+    * some other type/const renamings
+
+  Revision 1.21  1999/07/16 10:04:39  peter
     * merged
 
   Revision 1.20  1999/07/05 20:25:41  peter

+ 6 - 2
compiler/tcset.pas

@@ -37,7 +37,7 @@ implementation
     uses
       globtype,systems,
       cobjects,verbose,globals,
-      symtable,aasm,types,
+      symconst,symtable,aasm,types,
       hcodegen,htypechk,pass_1,
       tccnv
 {$ifdef i386}
@@ -255,7 +255,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.10  1999-05-27 19:45:25  peter
+  Revision 1.11  1999-08-03 22:03:38  peter
+    * moved bitmask constants to sets
+    * some other type/const renamings
+
+  Revision 1.10  1999/05/27 19:45:25  peter
     * removed oldasm
     * plabel -> pasmlabel
     * -a switches to source writing automaticly

+ 7 - 1
compiler/tokens.pas

@@ -195,6 +195,7 @@ type
     _INTERNCONST,
     _SHORTSTRING,
     _FINALIZATION,
+    _SAVEREGISTERS,
     _IMPLEMENTATION,
     _INITIALIZATION,
     _RESOURCESTRING
@@ -375,6 +376,7 @@ const
       (str:'INTERNCONST'   ;special:false;keyword:m_none),
       (str:'SHORTSTRING'   ;special:false;keyword:m_none),
       (str:'FINALIZATION'  ;special:false;keyword:m_initfinal),
+      (str:'SAVEREGISTERS' ;special:false;keyword:m_none),
       (str:'IMPLEMENTATION';special:false;keyword:m_all),
       (str:'INITIALIZATION';special:false;keyword:m_initfinal),
       (str:'RESOURCESTRING';special:false;keyword:m_class)
@@ -385,7 +387,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.9  1999-07-22 09:38:01  florian
+  Revision 1.10  1999-08-03 22:03:39  peter
+    * moved bitmask constants to sets
+    * some other type/const renamings
+
+  Revision 1.9  1999/07/22 09:38:01  florian
     + resourcestring implemented
     + start of longstring support
 

+ 7 - 2
compiler/tree.pas

@@ -29,7 +29,8 @@ unit tree;
   interface
 
     uses
-       globtype,cobjects,symtable,aasm
+       globtype,cobjects,
+       symconst,symtable,aasm
 {$ifdef i386}
        ,i386base
 {$endif}
@@ -1730,7 +1731,11 @@ unit tree;
 end.
 {
   $Log$
-  Revision 1.84  1999-07-27 23:42:24  peter
+  Revision 1.85  1999-08-03 22:03:40  peter
+    * moved bitmask constants to sets
+    * some other type/const renamings
+
+  Revision 1.84  1999/07/27 23:42:24  peter
     * indirect type referencing is now allowed
 
   Revision 1.83  1999/05/27 19:45:29  peter

+ 47 - 37
compiler/types.pas

@@ -168,7 +168,7 @@ implementation
 
     uses
        strings,globtype,globals,htypechk,
-       tree,verbose;
+       tree,verbose,symconst;
 
 
     function equal_paras(def1,def2 : pdefcoll;value_equal_const : boolean) : boolean;
@@ -245,6 +245,8 @@ implementation
 
     { true if a function can be assigned to a procvar }
     function proc_to_procvar_equal(def1:pprocdef;def2:pprocvardef) : boolean;
+      const
+        po_comp = po_compatibility_options-[po_methodpointer];
       var
         ismethod : boolean;
       begin
@@ -255,9 +257,9 @@ implementation
          ismethod:=assigned(def1^.owner) and
                    (def1^.owner^.symtabletype=objectsymtable) and
                    assigned(def1^.owner^.defowner) and
-                   (pobjectdef(def1^.owner^.defowner)^.isclass);
-         if (ismethod and not ((def2^.options and pomethodpointer)<>0)) or
-            (not(ismethod) and ((def2^.options and pomethodpointer)<>0)) then
+                   (pobjectdef(def1^.owner^.defowner)^.is_class);
+         if (ismethod and not (po_methodpointer in def2^.procoptions)) or
+            (not(ismethod) and (po_methodpointer in def2^.procoptions)) then
           begin
             Message(type_e_no_method_and_procedure_not_compatible);
             exit;
@@ -267,8 +269,7 @@ implementation
          if is_equal(def1^.retdef,def2^.retdef) and
             (equal_paras(def1^.para1,def2^.para1,false) or
              convertable_paras(def1^.para1,def2^.para1,false)) and
-            ((def1^.options and (po_compatibility_options-pomethodpointer))=
-             (def2^.options and (po_compatibility_options-pomethodpointer))) then
+            ((po_comp * def1^.procoptions)= (po_comp * def2^.procoptions)) then
            proc_to_procvar_equal:=true
          else
            proc_to_procvar_equal:=false;
@@ -288,14 +289,18 @@ implementation
          dt : tbasetype;
       begin
          case def^.deftype of
-          orddef : begin
-                     dt:=porddef(def)^.typ;
-                     is_ordinal:=dt in [uchar,u8bit,u16bit,u32bit,u64bit,s8bit,s16bit,s32bit,
-                       s64bitint,bool8bit,bool16bit,bool32bit];
-                   end;
-         enumdef : is_ordinal:=true;
-         else
-           is_ordinal:=false;
+           orddef :
+             begin
+               dt:=porddef(def)^.typ;
+               is_ordinal:=dt in [uchar,
+                                  u8bit,u16bit,u32bit,u64bit,
+                                  s8bit,s16bit,s32bit,s64bit,
+                                  bool8bit,bool16bit,bool32bit];
+             end;
+           enumdef :
+             is_ordinal:=true;
+           else
+             is_ordinal:=false;
          end;
       end;
 
@@ -304,12 +309,12 @@ implementation
     function get_min_value(def : pdef) : longint;
       begin
          case def^.deftype of
-            orddef:
-                get_min_value:=porddef(def)^.low;
-            enumdef:
-                get_min_value:=penumdef(def)^.min;
-         else
-            get_min_value:=0;
+           orddef:
+             get_min_value:=porddef(def)^.low;
+           enumdef:
+             get_min_value:=penumdef(def)^.min;
+           else
+             get_min_value:=0;
          end;
       end;
 
@@ -318,8 +323,8 @@ implementation
     function is_integer(def : pdef) : boolean;
       begin
         is_integer:=(def^.deftype=orddef) and
-                    (porddef(def)^.typ in [uauto,u8bit,u16bit,u32bit,s8bit,
-                                           s16bit,s32bit,u64bit,s64bitint]);
+                    (porddef(def)^.typ in [uauto,u8bit,u16bit,u32bit,u64bit,
+                                           s8bit,s16bit,s32bit,s64bit]);
       end;
 
 
@@ -348,7 +353,7 @@ implementation
            orddef :
              begin
                dt:=porddef(def)^.typ;
-               is_signed:=(dt in [s8bit,s16bit,s32bit,s64bitint]);
+               is_signed:=(dt in [s8bit,s16bit,s32bit,s64bit]);
              end;
            enumdef :
              is_signed:=false;
@@ -483,8 +488,8 @@ implementation
       begin
          ret_in_acc:=(def^.deftype in [orddef,pointerdef,enumdef,classrefdef]) or
                      ((def^.deftype=stringdef) and (pstringdef(def)^.string_typ in [st_ansistring,st_widestring])) or
-                     ((def^.deftype=procvardef) and ((pprocvardef(def)^.options and pomethodpointer)=0)) or
-                     ((def^.deftype=objectdef) and pobjectdef(def)^.isclass) or
+                     ((def^.deftype=procvardef) and not(po_methodpointer in pprocvardef(def)^.procoptions)) or
+                     ((def^.deftype=objectdef) and pobjectdef(def)^.is_class) or
                      ((def^.deftype=setdef) and (psetdef(def)^.settype=smallset)) or
                      ((def^.deftype=floatdef) and (pfloatdef(def)^.typ=f32bit));
       end;
@@ -493,7 +498,7 @@ implementation
     { true, if def is a 64 bit int type }
     function is_64bitint(def : pdef) : boolean;
       begin
-         is_64bitint:=(def^.deftype=orddef) and (porddef(def)^.typ in [u64bit,s64bitint])
+         is_64bitint:=(def^.deftype=orddef) and (porddef(def)^.typ in [u64bit,s64bit])
       end;
 
 
@@ -502,16 +507,17 @@ implementation
       begin
          ret_in_param:=(def^.deftype in [arraydef,recorddef]) or
            ((def^.deftype=stringdef) and (pstringdef(def)^.string_typ in [st_shortstring,st_longstring])) or
-           ((def^.deftype=procvardef) and ((pprocvardef(def)^.options and pomethodpointer)<>0)) or
-           ((def^.deftype=objectdef) and not(pobjectdef(def)^.isclass)) or
+           ((def^.deftype=procvardef) and (po_methodpointer in pprocvardef(def)^.procoptions)) or
+           ((def^.deftype=objectdef) and not(pobjectdef(def)^.is_class)) or
            ((def^.deftype=setdef) and (psetdef(def)^.settype<>smallset));
       end;
 
 
     function push_high_param(def : pdef) : boolean;
       begin
-         push_high_param:=is_open_array(def) or is_open_string(def) or
-           is_array_of_const(def);
+         push_high_param:=is_open_array(def) or
+                          is_open_string(def) or
+                          is_array_of_const(def);
       end;
 
 
@@ -531,9 +537,9 @@ implementation
              )
             )
            ) or
-           ((def^.deftype=objectdef) and not(pobjectdef(def)^.isclass)) or
+           ((def^.deftype=objectdef) and not(pobjectdef(def)^.is_class)) or
            ((def^.deftype=stringdef) and (pstringdef(def)^.string_typ in [st_shortstring,st_longstring])) or
-           ((def^.deftype=procvardef) and ((pprocvardef(def)^.options and pomethodpointer)<>0)) or
+           ((def^.deftype=procvardef) and (po_methodpointer in pprocvardef(def)^.procoptions)) or
            ((def^.deftype=setdef) and (psetdef(def)^.settype<>smallset));
       end;
 
@@ -781,7 +787,7 @@ implementation
              begin
                 { here a problem detected in tabsolutesym }
                 { the types can be forward type !!        }
-                if assigned(def1^.sym) and ((def1^.sym^.properties and sp_forwarddef)<>0) then
+                if assigned(def1^.sym) and (sp_forwarddef in def1^.sym^.symoptions) then
                   b:=(def1^.sym=def2^.sym)
                 else
                   b:=ppointerdef(def1)^.definition=ppointerdef(def2)^.definition;
@@ -851,8 +857,8 @@ implementation
                 { poassembler isn't important for compatibility }
                 { if a method is assigned to a methodpointer    }
                 { is checked before                             }
-                b:=((pprocvardef(def1)^.options and po_compatibility_options)=
-                    (pprocvardef(def2)^.options and po_compatibility_options)) and
+                b:=((pprocvardef(def1)^.procoptions * po_compatibility_options)=
+                    (pprocvardef(def2)^.procoptions * po_compatibility_options)) and
                    is_equal(pprocvardef(def1)^.retdef,pprocvardef(def2)^.retdef);
                 { now evalute the parameters }
                 if b then
@@ -898,7 +904,7 @@ implementation
            if (def1^.deftype=classrefdef) and (def2^.deftype=classrefdef) then
              begin
                 { similar to pointerdef: }
-                if assigned(def1^.sym) and ((def1^.sym^.properties and sp_forwarddef)<>0) then
+                if assigned(def1^.sym) and (sp_forwarddef in def1^.sym^.symoptions) then
                   b:=(def1^.sym=def2^.sym)
                 else
                   b:=is_equal(pclassrefdef(def1)^.definition,pclassrefdef(def2)^.definition);
@@ -968,7 +974,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.78  1999-07-30 12:26:42  peter
+  Revision 1.79  1999-08-03 22:03:41  peter
+    * moved bitmask constants to sets
+    * some other type/const renamings
+
+  Revision 1.78  1999/07/30 12:26:42  peter
     * array is_equal disabled for tp,delphi mode
 
   Revision 1.77  1999/07/29 11:41:51  peter

Some files were not shown because too many files changed in this diff