소스 검색

* set vs_initialised for typed consts
* delete old symbol when absolute is used

git-svn-id: trunk@5351 -

peter 18 년 전
부모
커밋
45621c892e
4개의 변경된 파일62개의 추가작업 그리고 31개의 파일을 삭제
  1. 36 21
      compiler/cclasses.pas
  2. 6 8
      compiler/pdecvar.pas
  3. 2 2
      compiler/ptconst.pas
  4. 18 0
      compiler/symbase.pas

+ 36 - 21
compiler/cclasses.pas

@@ -518,10 +518,6 @@ implementation
                TFPObjectList (Copied from rtl/objpas/classes/lists.inc)
 *****************************************************************************}
 
-Const
-  // Ratio of Pointer and Word Size.
-  WordRatio = SizeOf(Pointer) Div SizeOf(Word);
-
 procedure TFPList.RaiseIndexError(Index : Integer);
 begin
   Error(SListIndexError, Index);
@@ -574,7 +570,7 @@ begin
     If NewCount > FCapacity then
       SetCapacity(NewCount);
     If FCount < NewCount then
-      FillWord(Flist^[FCount], (NewCount-FCount) *  WordRatio, 0);
+      FillChar(Flist^[FCount], (NewCount-FCount) *  sizeof(Pointer), 0);
     end;
   FCount := Newcount;
 end;
@@ -591,7 +587,7 @@ begin
     Self.Expand;
   FList^[FCount] := Item;
   Result := FCount;
-  FCount := FCount + 1;
+  inc(FCount);
 end;
 
 procedure TFPList.Clear;
@@ -608,9 +604,9 @@ procedure TFPList.Delete(Index: Integer);
 begin
   If (Index<0) or (Index>=FCount) then
     Error (SListIndexError, Index);
-  FCount := FCount-1;
+  dec(FCount);
   System.Move (FList^[Index+1], FList^[Index], (FCount - Index) * SizeOf(Pointer));
-  // Shrink the list if appropriate
+  { Shrink the list if appropriate }
   if (FCapacity > 256) and (FCount < FCapacity shr 2) then
   begin
     FCapacity := FCapacity shr 1;
@@ -744,10 +740,8 @@ begin
   FCount:=NewCount;
 end;
 
-// Needed by Sort method.
 
-Procedure QuickSort(FList: PPointerList; L, R : Longint;
-                     Compare: TListSortCompare);
+Procedure QuickSort(FList: PPointerList; L, R : Longint;Compare: TListSortCompare);
 var
   I, J : Longint;
   P, Q : Pointer;
@@ -1236,16 +1230,44 @@ begin
 end;
 
 procedure TFPHashList.Delete(Index: Integer);
+var
+  HashIndex,
+  PrevIndex  : integer;
 begin
   If (Index<0) or (Index>=FCount) then
     Error (SListIndexError, Index);
-  with FHashList^[Index] do
+  { Remove from current Hash }
+  HashIndex:=FHashTable^[FHashList^[Index].HashValue mod LongWord(FHashCapacity)];
+  PrevIndex:=-1;
+  while Index<>-1 do
     begin
-      Data:=nil;
-      StrIndex:=-1;
+      if HashIndex=Index then
+        break;
+      PrevIndex:=HashIndex;
+      HashIndex:=FHashList^[HashIndex].NextIndex;
+    end;
+  if PrevIndex<>-1 then
+    FHashList^[PrevIndex].NextIndex:=FHashList^[Index].NextIndex
+  else
+    FHashTable^[FHashList^[Index].HashValue mod LongWord(FHashCapacity)]:=FHashList^[Index].NextIndex;
+  { Remove from HashList }
+  dec(FCount);
+  System.Move (FHashList^[Index+1], FHashList^[Index], (FCount - Index) * Sizeof(THashItem));
+  { Shrink the list if appropriate }
+  if (FCapacity > 256) and (FCount < FCapacity shr 2) then
+    begin
+      FCapacity := FCapacity shr 1;
+      ReallocMem(FHashList, Sizeof(THashItem) * FCapacity);
     end;
 end;
 
+function TFPHashList.Remove(Item: Pointer): Integer;
+begin
+  Result := IndexOf(Item);
+  If Result <> -1 then
+    Self.Delete(Result);
+end;
+
 class procedure TFPHashList.Error(const Msg: string; Data: PtrInt);
 begin
   Raise EListError.CreateFmt(Msg,[Data]) at get_caller_addr(get_frame);
@@ -1301,13 +1323,6 @@ begin
     end;
 end;
 
-function TFPHashList.Remove(Item: Pointer): Integer;
-begin
-  Result := IndexOf(Item);
-  If Result <> -1 then
-    Self.Delete(Result);
-end;
-
 function TFPHashList.InternalFind(AHash:LongWord;const AName:string;out PrevIndex:Integer):Integer;
 var
   HashIndex : Integer;

+ 6 - 8
compiler/pdecvar.pas

@@ -690,8 +690,6 @@ implementation
                 vs.defaultconstsym:=tcsym;
                 symtablestack.top.insert(tcsym);
                 read_typed_const(current_asmdata.asmlists[al_typedconsts],tcsym);
-                { The variable has a value assigned }
-                vs.varstate:=vs_initialised;
               end;
             staticvarsym :
               begin
@@ -714,7 +712,7 @@ implementation
             Message(parser_e_absolute_only_one_var);
           if vs.typ=staticvarsym then
             begin
-              tstaticvarsym(vs).set_mangledname(target_info.Cprefix+vs.realname);
+              tstaticvarsym(vs).set_mangledname(C_Name);
               include(vs.varoptions,vo_is_external);
             end
           else
@@ -726,6 +724,7 @@ implementation
           vs     : tabstractvarsym;
           abssym : tabsolutevarsym;
           pt,hp  : tnode;
+          st     : tsymtable;
         begin
           abssym:=nil;
           { only allowed for one var }
@@ -795,8 +794,9 @@ implementation
           { replace old varsym with the new absolutevarsym }
           if assigned(abssym) then
             begin
-              Hidesym(vs);
-              vs.owner.insert(abssym);
+              st:=vs.owner;
+              vs.owner.Delete(vs);
+              st.insert(abssym);
               sc[0]:=abssym;
             end;
         end;
@@ -804,7 +804,6 @@ implementation
         procedure read_public_and_external(sc:TFPObjectList);
         var
           vs          : tabstractvarsym;
-          semicolonatend,
           is_dll,
           is_cdecl,
           is_external_var,
@@ -822,13 +821,12 @@ implementation
               Message(parser_e_no_local_var_external);
               exit;
             end;
-            
+
           { defaults }
           is_dll:=false;
           is_cdecl:=false;
           is_external_var:=false;
           is_public_var:=false;
-          semicolonatend:= false;
           C_name:=vs.realname;
 
           { macpas specific handling due to some switches}

+ 2 - 2
compiler/ptconst.pas

@@ -1065,8 +1065,8 @@ implementation
       begin
         { mark the staticvarsym as typedconst }
         include(sym.varoptions,vo_is_typed_const);
-        { the variable is declared }
-        sym.varstate:=vs_declared;
+        { The variable has a value assigned }
+        sym.varstate:=vs_initialised;
         { the variable can't be placed in a register }
         sym.varregable:=vr_none;
 

+ 18 - 0
compiler/symbase.pas

@@ -106,9 +106,11 @@ interface
           procedure clear;virtual;
           function  checkduplicate(var s:THashedIDString;sym:TSymEntry):boolean;virtual;
           procedure insert(sym:TSymEntry;checkdup:boolean=true);
+          procedure Delete(sym:TSymEntry);
           function  Find(const s:TIDString) : TSymEntry;
           function  FindWithHash(const s:THashedIDString) : TSymEntry;virtual;
           procedure insertdef(def:TDefEntry);virtual;
+          procedure deletedef(def:TDefEntry);
           function  iscurrentunit:boolean;virtual;
        end;
 
@@ -297,6 +299,14 @@ implementation
       end;
 
 
+    procedure TSymtable.Delete(sym:TSymEntry);
+      begin
+        if sym.Owner<>self then
+          internalerror(200611121);
+        SymList.Remove(sym);
+      end;
+
+
     procedure TSymtable.insertdef(def:TDefEntry);
       begin
          DefList.Add(def);
@@ -304,6 +314,14 @@ implementation
       end;
 
 
+    procedure TSymtable.deletedef(def:TDefEntry);
+      begin
+        if def.Owner<>self then
+          internalerror(200611122);
+         DefList.Remove(def);
+      end;
+
+
     function TSymtable.Find(const s : TIDString) : TSymEntry;
       begin
         result:=TSymEntry(SymList.Find(s));