Browse Source

+ Fix from Dave Strodtman to properly support packed

michael 20 years ago
parent
commit
c2c2131784
3 changed files with 41 additions and 4 deletions
  1. 9 1
      fcl/passrc/pastree.pp
  2. 6 1
      fcl/passrc/paswrite.pp
  3. 26 2
      fcl/passrc/pparser.pp

+ 9 - 1
fcl/passrc/pastree.pp

@@ -175,6 +175,7 @@ type
     function ElementTypeName: String; override;
     function GetDeclaration(full : boolean) : String; override;
     IndexRange : String;
+    IsPacked : Boolean;          // 12/04/04 - Dave - Added
     ElType: TPasType;
   end;
 
@@ -223,6 +224,7 @@ type
     function ElementTypeName: String; override;
     ObjKind: TPasObjKind;
     AncestorType: TPasType;	// TPasClassType or TPasUnresolvedTypeRef
+    IsPacked: Boolean;        // 12/04/04 - Dave - Added
     Members: TList;	// array of TPasElement objects
   end;
 
@@ -715,6 +717,7 @@ end;
 constructor TPasClassType.Create(const AName: String; AParent: TPasElement);
 begin
   inherited Create(AName, AParent);
+  IsPacked := False;                     // 12/04/04 - Dave - Added
   Members := TList.Create;
 end;
 
@@ -1048,6 +1051,8 @@ end;
 function TPasArrayType.GetDeclaration (full : boolean) : string;
 begin
   Result:='Array['+IndexRange+'] of ';
+  If IsPacked then
+     Result := 'packed '+Result;      // 12/04/04 Dave - Added
   If Assigned(Eltype) then
     Result:=Result+ElType.Name
   else
@@ -1397,7 +1402,10 @@ end.
 
 {
   $Log$
-  Revision 1.5  2004-07-24 00:03:13  michael
+  Revision 1.6  2004-12-06 08:53:48  michael
+  + Fix from Dave Strodtman to properly support packed
+
+  Revision 1.5  2004/07/24 00:03:13  michael
   + Fixed getdeclaration of TPasRecordType (semicolons not/wrongly placed)
 
   Revision 1.4  2004/07/23 23:42:02  michael

+ 6 - 1
fcl/passrc/paswrite.pp

@@ -208,6 +208,8 @@ var
 begin
   PrepareDeclSection('type');
   wrt(AClass.Name + ' = ');
+  if AClass.IsPacked then
+     wrt('packed ');                      // 12/04/04 - Dave - Added
   case AClass.ObjKind of
     okObject: wrt('object');
     okClass: wrt('class');
@@ -616,7 +618,10 @@ end.
 
 {
   $Log$
-  Revision 1.1  2003-03-13 21:47:42  sg
+  Revision 1.2  2004-12-06 08:53:47  michael
+  + Fix from Dave Strodtman to properly support packed
+
+  Revision 1.1  2003/03/13 21:47:42  sg
   * First version as part of FCL
 
 }

+ 26 - 2
fcl/passrc/pparser.pp

@@ -858,11 +858,23 @@ var
 var
   EnumValue: TPasEnumValue;
   Prefix : String;
+  HadPackedModifier : Boolean;           // 12/04/04 - Dave - Added 
    
 begin
   TypeName := CurTokenString;
   ExpectToken(tkEqual);
   NextToken;
+  // 12/04/04 - Dave - allow PACKED for ARRAYs, OBJECTs, CLASSes and RECORDs 
+  HadPackedModifier := False;     { Assume not present }
+  if CurToken = tkPacked then     { If PACKED modifier }
+     begin                        { Handle PACKED modifier for all situations }
+     NextToken;                   { Move to next token for rest of parse }
+     if CurToken in [tkArray, tkRecord, tkObject, tkClass] then  { If allowed }
+       HadPackedModifier := True  { rememeber for later }
+     else                         { otherwise, syntax error }
+       ParseExc(Format(SParserExpectTokenError,['ARRAY, RECORD, OBJECT or CLASS']))
+     end;
+  // 12/04/04 - Dave - End of added code
   case CurToken of
     tkRecord:
       begin
@@ -870,11 +882,13 @@ begin
 	  Parent));
         try
           ParseRecordDecl(TPasRecordType(Result));
+          TPasRecordType(Result).IsPacked := HadPackedModifier;
         except
           Result.Free;
           raise;
         end;
       end;
+    { 12/04/04 - Dave - cannot happen. Handled above. Unnecessary code removed by commenting
     tkPacked:
       begin
         Result := TPasRecordType(CreateElement(TPasRecordType, TypeName,
@@ -887,11 +901,17 @@ begin
           Result.Free;
           raise;
         end;
-      end;
+      end;                   End of removed code  - Dave - 12/04/04 }
     tkObject:
+      begin                                                 // 12/04/04 - Dave - Added
       Result := ParseClassDecl(Parent, TypeName, okObject);
+      TPasClassType(Result).IsPacked := HadPackedModifier;  // 12/04/04 - Dave - Added
+      end;                                                  // 12/04/04 - Dave - Added
     tkClass:
+      begin                                                 // 12/04/04 - Dave - Added 
       Result := ParseClassDecl(Parent, TypeName, okClass);
+      TPasClassType(Result).IsPacked := HadPackedModifier;  // 12/04/04 - Dave - Added
+      end;                                                  // 12/04/04 - Dave - Added
     tkInterface:
       Result := ParseClassDecl(Parent, TypeName, okInterface);
     tkCaret:
@@ -964,6 +984,7 @@ begin
         Result := TPasArrayType(CreateElement(TPasArrayType, TypeName, Parent));
         try
           ParseArrayType(TPasArrayType(Result));
+          TPasArrayType(Result).IsPacked := HadPackedModifier;   // 12/04/04 - Dave - Added
           ExpectToken(tkSemicolon);
         except
           Result.Free;
@@ -1834,7 +1855,10 @@ end.
 
 {
   $Log$
-  Revision 1.9  2004-10-16 18:55:31  michael
+  Revision 1.10  2004-12-06 08:53:47  michael
+  + Fix from Dave Strodtman to properly support packed
+
+  Revision 1.9  2004/10/16 18:55:31  michael
   + Support for cross-unit aliases
 
   Revision 1.8  2004/09/13 16:02:36  peter