Преглед изворни кода

* Changed the default packset setting to 1 and disabled the padding of 3-byte
sets to 4 bytes on 16 and 8-bit CPUs. This is compatible with Turbo Pascal 7
and Delphi 1.

git-svn-id: trunk@27140 -

nickysn пре 11 година
родитељ
комит
015c7e951a

+ 11 - 3
compiler/symdef.pas

@@ -3179,11 +3179,17 @@ implementation
       var
       var
         setallocbits: aint;
         setallocbits: aint;
         packedsavesize: aint;
         packedsavesize: aint;
+        actual_setalloc: ShortInt;
       begin
       begin
          inherited create(setdef);
          inherited create(setdef);
          elementdef:=def;
          elementdef:=def;
          setmax:=high;
          setmax:=high;
-         if (current_settings.setalloc=0) then
+         actual_setalloc:=current_settings.setalloc;
+{$if defined(cpu8bitalu) or defined(cpu16bitalu)}
+         if actual_setalloc=0 then
+           actual_setalloc:=1;
+{$endif}
+         if (actual_setalloc=0) then
            begin
            begin
              setbase:=0;
              setbase:=0;
              if (high<32) then
              if (high<32) then
@@ -3195,12 +3201,14 @@ implementation
            end
            end
          else
          else
            begin
            begin
-             setallocbits:=current_settings.setalloc*8;
+             setallocbits:=actual_setalloc*8;
              setbase:=low and not(setallocbits-1);
              setbase:=low and not(setallocbits-1);
-             packedsavesize:=current_settings.setalloc*((((high+setallocbits)-setbase)) DIV setallocbits);
+             packedsavesize:=actual_setalloc*((((high+setallocbits)-setbase)) DIV setallocbits);
              savesize:=packedsavesize;
              savesize:=packedsavesize;
+{$if not defined(cpu8bitalu) and not defined(cpu16bitalu)}
              if savesize=3 then
              if savesize=3 then
                savesize:=4;
                savesize:=4;
+{$endif}
            end;
            end;
       end;
       end;
 
 

+ 4 - 4
rtl/i8086/mathu.inc

@@ -175,7 +175,7 @@ end;
 
 
 function GetExceptionMask: TFPUExceptionMask;
 function GetExceptionMask: TFPUExceptionMask;
 begin
 begin
-  Result := TFPUExceptionMask(Longint(Get8087CW and $3F));
+  Result := TFPUExceptionMask(Byte(Get8087CW and $3F));
 end;
 end;
 
 
 function SetExceptionMask(const Mask: TFPUExceptionMask): TFPUExceptionMask;
 function SetExceptionMask(const Mask: TFPUExceptionMask): TFPUExceptionMask;
@@ -183,11 +183,11 @@ var
   CtlWord: Word;
   CtlWord: Word;
 begin
 begin
   CtlWord := Get8087CW;
   CtlWord := Get8087CW;
-  Set8087CW( (CtlWord and $FFC0) or Byte(Longint(Mask)) );
+  Set8087CW( (CtlWord and $FFC0) or Byte(Mask) );
 {  if has_sse_support then
 {  if has_sse_support then
     SetSSECSR((GetSSECSR and $ffffe07f) or (dword(Mask) shl 7));}
     SetSSECSR((GetSSECSR and $ffffe07f) or (dword(Mask) shl 7));}
-  softfloat_exception_mask:=dword(Mask);
-  Result := TFPUExceptionMask(Longint(CtlWord and $3F));
+  softfloat_exception_mask:=byte(Mask);
+  Result := TFPUExceptionMask(Byte(CtlWord and $3F));
 end;
 end;
 
 
 procedure ClearExceptions(RaisePending: Boolean);assembler;
 procedure ClearExceptions(RaisePending: Boolean);assembler;

+ 7 - 0
rtl/objpas/classes/classes.inc

@@ -15,6 +15,13 @@
  *       Class implementations are in separate files.                 *
  *       Class implementations are in separate files.                 *
  **********************************************************************}
  **********************************************************************}
 
 
+type
+{$ifdef CPU16}
+  TFilerFlagsInt = Byte;
+{$else CPU16}
+  TFilerFlagsInt = LongInt;
+{$endif CPU16}
+
 var
 var
   ClassList : TThreadlist;
   ClassList : TThreadlist;
   ClassAliasList : TStringList;
   ClassAliasList : TStringList;

+ 1 - 1
rtl/objpas/classes/reader.inc

@@ -165,7 +165,7 @@ begin
   if (Byte(NextValue) and $f0) = $f0 then
   if (Byte(NextValue) and $f0) = $f0 then
   begin
   begin
     Prefix := Byte(ReadValue);
     Prefix := Byte(ReadValue);
-    Flags := TFilerFlags(longint(Prefix and $0f));
+    Flags := TFilerFlags(TFilerFlagsInt(Prefix and $0f));
     if ffChildPos in Flags then
     if ffChildPos in Flags then
     begin
     begin
       ValueType := ReadValue;
       ValueType := ReadValue;

+ 1 - 1
rtl/objpas/classes/writer.inc

@@ -132,7 +132,7 @@ begin
   { Only write the flags if they are needed! }
   { Only write the flags if they are needed! }
   if Flags <> [] then
   if Flags <> [] then
   begin
   begin
-    Prefix := Longint(Flags) or $f0;
+    Prefix := TFilerFlagsInt(Flags) or $f0;
     Write(Prefix, 1);
     Write(Prefix, 1);
     if ffChildPos in Flags then
     if ffChildPos in Flags then
       WriteInteger(ChildPos);
       WriteInteger(ChildPos);

+ 1 - 1
tests/test/cg/taddset4.pp

@@ -21,7 +21,7 @@ var
   b:boolean;
   b:boolean;
 begin
 begin
   b:=true;
   b:=true;
-  t(longint([
+  t({$ifdef CPU16}byte{$else}longint{$endif}([
       TCompilerIntfFlag(ord(ifHasGuid)*ord(b)),
       TCompilerIntfFlag(ord(ifHasGuid)*ord(b)),
       TCompilerIntfFlag(ord(ifHasStrGUID)*ord(b)),
       TCompilerIntfFlag(ord(ifHasStrGUID)*ord(b)),
       TCompilerIntfFlag(ord(ifDispInterface)*ord(b))
       TCompilerIntfFlag(ord(ifDispInterface)*ord(b))

+ 30 - 7
tests/test/tsetsize.pp

@@ -1,14 +1,37 @@
 program SetSizes;
 program SetSizes;
 
 
-{$APPTYPE CONSOLE}
-
 {$ifdef fpc}
 {$ifdef fpc}
+  {$APPTYPE CONSOLE}
   {$mode delphi}
   {$mode delphi}
-  {$packset 1}
-{$endif}
+  {$ifdef CPU16}
+    {$define _16BITCOMPILER}
+  {$else}
+    {$packset 1}
+  {$endif}
+{$else fpc}
+  {$ifdef VER70} { Turbo Pascal 7 }
+    {$define _16BITCOMPILER}
+  {$endif}
+  {$ifdef VER80} { Delphi 1 }
+    {$define _16BITCOMPILER}
+    uses
+      WinCrt;
+  {$endif}
+  {$ifdef WIN32}
+    {$APPTYPE CONSOLE}
+  {$endif}
+  {$ifdef WIN64}
+    {$APPTYPE CONSOLE}
+  {$endif}
+{$endif fpc}
 
 
 const
 const
   _a= 0;
   _a= 0;
+{$ifdef _16BITCOMPILER}
+  three_or_four = 3;
+{$else}
+  three_or_four = 4;
+{$endif}
 
 
 type
 type
   TIntRange1_a =  0 + _a.. Pred( 1 * 8) + _a;
   TIntRange1_a =  0 + _a.. Pred( 1 * 8) + _a;
@@ -134,7 +157,7 @@ begin
   WriteLn(Low(TIntRange2_a),'..',High(TIntRange2_a),' -> ', SizeOf(TSet2_a));
   WriteLn(Low(TIntRange2_a),'..',High(TIntRange2_a),' -> ', SizeOf(TSet2_a));
   test(SizeOf(TSet2_a),2);
   test(SizeOf(TSet2_a),2);
   WriteLn(Low(TIntRange3_a),'..',High(TIntRange3_a),' -> ', SizeOf(TSet3_a));
   WriteLn(Low(TIntRange3_a),'..',High(TIntRange3_a),' -> ', SizeOf(TSet3_a));
-  test(SizeOf(TSet3_a),4);
+  test(SizeOf(TSet3_a),three_or_four);
   WriteLn(Low(TIntRange4_a),'..',High(TIntRange4_a),' -> ', SizeOf(TSet4_a));
   WriteLn(Low(TIntRange4_a),'..',High(TIntRange4_a),' -> ', SizeOf(TSet4_a));
   test(SizeOf(TSet4_a),4);
   test(SizeOf(TSet4_a),4);
   WriteLn(Low(TIntRange5_a),'..',High(TIntRange5_a),' -> ', SizeOf(TSet5_a));
   WriteLn(Low(TIntRange5_a),'..',High(TIntRange5_a),' -> ', SizeOf(TSet5_a));
@@ -167,7 +190,7 @@ begin
   WriteLn(Low(TIntRange1_b),'..',High(TIntRange1_b),' -> ', SizeOf(TSet1_b));
   WriteLn(Low(TIntRange1_b),'..',High(TIntRange1_b),' -> ', SizeOf(TSet1_b));
   test(SizeOf(TSet1_b),2);
   test(SizeOf(TSet1_b),2);
   WriteLn(Low(TIntRange2_b),'..',High(TIntRange2_b),' -> ', SizeOf(TSet2_b));
   WriteLn(Low(TIntRange2_b),'..',High(TIntRange2_b),' -> ', SizeOf(TSet2_b));
-  test(SizeOf(TSet2_b),4);
+  test(SizeOf(TSet2_b),three_or_four);
   WriteLn(Low(TIntRange3_b),'..',High(TIntRange3_b),' -> ', SizeOf(TSet3_b));
   WriteLn(Low(TIntRange3_b),'..',High(TIntRange3_b),' -> ', SizeOf(TSet3_b));
   test(SizeOf(TSet3_b),4);
   test(SizeOf(TSet3_b),4);
   WriteLn(Low(TIntRange4_b),'..',High(TIntRange4_b),' -> ', SizeOf(TSet4_b));
   WriteLn(Low(TIntRange4_b),'..',High(TIntRange4_b),' -> ', SizeOf(TSet4_b));
@@ -202,7 +225,7 @@ begin
   WriteLn(Low(TIntRange1_c),'..',High(TIntRange1_c),' -> ', SizeOf(TSet1_c));
   WriteLn(Low(TIntRange1_c),'..',High(TIntRange1_c),' -> ', SizeOf(TSet1_c));
   test(SizeOf(TSet1_c),2);
   test(SizeOf(TSet1_c),2);
   WriteLn(Low(TIntRange2_c),'..',High(TIntRange2_c),' -> ', SizeOf(TSet2_c));
   WriteLn(Low(TIntRange2_c),'..',High(TIntRange2_c),' -> ', SizeOf(TSet2_c));
-  test(SizeOf(TSet2_c),4);
+  test(SizeOf(TSet2_c),three_or_four);
   WriteLn(Low(TIntRange3_c),'..',High(TIntRange3_c),' -> ', SizeOf(TSet3_c));
   WriteLn(Low(TIntRange3_c),'..',High(TIntRange3_c),' -> ', SizeOf(TSet3_c));
   test(SizeOf(TSet3_c),4);
   test(SizeOf(TSet3_c),4);
   WriteLn(Low(TIntRange4_c),'..',High(TIntRange4_c),' -> ', SizeOf(TSet4_c));
   WriteLn(Low(TIntRange4_c),'..',High(TIntRange4_c),' -> ', SizeOf(TSet4_c));