From 015c7e951a053fedc270573a1ce1bca388d58d81 Mon Sep 17 00:00:00 2001 From: nickysn Date: Fri, 14 Mar 2014 23:51:14 +0000 Subject: [PATCH] * 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 - --- compiler/symdef.pas | 14 ++++++++++--- rtl/i8086/mathu.inc | 8 ++++---- rtl/objpas/classes/classes.inc | 7 +++++++ rtl/objpas/classes/reader.inc | 2 +- rtl/objpas/classes/writer.inc | 2 +- tests/test/cg/taddset4.pp | 2 +- tests/test/tsetsize.pp | 37 +++++++++++++++++++++++++++------- 7 files changed, 55 insertions(+), 17 deletions(-) diff --git a/compiler/symdef.pas b/compiler/symdef.pas index 2c106e211e..b725d7996e 100644 --- a/compiler/symdef.pas +++ b/compiler/symdef.pas @@ -3179,11 +3179,17 @@ implementation var setallocbits: aint; packedsavesize: aint; + actual_setalloc: ShortInt; begin inherited create(setdef); elementdef:=def; 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 setbase:=0; if (high<32) then @@ -3195,12 +3201,14 @@ implementation end else begin - setallocbits:=current_settings.setalloc*8; + setallocbits:=actual_setalloc*8; 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; +{$if not defined(cpu8bitalu) and not defined(cpu16bitalu)} if savesize=3 then savesize:=4; +{$endif} end; end; diff --git a/rtl/i8086/mathu.inc b/rtl/i8086/mathu.inc index b05820c1d0..04f368f55d 100644 --- a/rtl/i8086/mathu.inc +++ b/rtl/i8086/mathu.inc @@ -175,7 +175,7 @@ end; function GetExceptionMask: TFPUExceptionMask; begin - Result := TFPUExceptionMask(Longint(Get8087CW and $3F)); + Result := TFPUExceptionMask(Byte(Get8087CW and $3F)); end; function SetExceptionMask(const Mask: TFPUExceptionMask): TFPUExceptionMask; @@ -183,11 +183,11 @@ var CtlWord: Word; begin CtlWord := Get8087CW; - Set8087CW( (CtlWord and $FFC0) or Byte(Longint(Mask)) ); + Set8087CW( (CtlWord and $FFC0) or Byte(Mask) ); { if has_sse_support then 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; procedure ClearExceptions(RaisePending: Boolean);assembler; diff --git a/rtl/objpas/classes/classes.inc b/rtl/objpas/classes/classes.inc index d561096635..c12728dbf5 100644 --- a/rtl/objpas/classes/classes.inc +++ b/rtl/objpas/classes/classes.inc @@ -15,6 +15,13 @@ * Class implementations are in separate files. * **********************************************************************} +type +{$ifdef CPU16} + TFilerFlagsInt = Byte; +{$else CPU16} + TFilerFlagsInt = LongInt; +{$endif CPU16} + var ClassList : TThreadlist; ClassAliasList : TStringList; diff --git a/rtl/objpas/classes/reader.inc b/rtl/objpas/classes/reader.inc index 48dcd432d4..9bd66c4e1d 100644 --- a/rtl/objpas/classes/reader.inc +++ b/rtl/objpas/classes/reader.inc @@ -165,7 +165,7 @@ begin if (Byte(NextValue) and $f0) = $f0 then begin Prefix := Byte(ReadValue); - Flags := TFilerFlags(longint(Prefix and $0f)); + Flags := TFilerFlags(TFilerFlagsInt(Prefix and $0f)); if ffChildPos in Flags then begin ValueType := ReadValue; diff --git a/rtl/objpas/classes/writer.inc b/rtl/objpas/classes/writer.inc index 0af646f5fe..4a14decef0 100644 --- a/rtl/objpas/classes/writer.inc +++ b/rtl/objpas/classes/writer.inc @@ -132,7 +132,7 @@ begin { Only write the flags if they are needed! } if Flags <> [] then begin - Prefix := Longint(Flags) or $f0; + Prefix := TFilerFlagsInt(Flags) or $f0; Write(Prefix, 1); if ffChildPos in Flags then WriteInteger(ChildPos); diff --git a/tests/test/cg/taddset4.pp b/tests/test/cg/taddset4.pp index 47d515db1e..460ad42787 100644 --- a/tests/test/cg/taddset4.pp +++ b/tests/test/cg/taddset4.pp @@ -21,7 +21,7 @@ var b:boolean; begin b:=true; - t(longint([ + t({$ifdef CPU16}byte{$else}longint{$endif}([ TCompilerIntfFlag(ord(ifHasGuid)*ord(b)), TCompilerIntfFlag(ord(ifHasStrGUID)*ord(b)), TCompilerIntfFlag(ord(ifDispInterface)*ord(b)) diff --git a/tests/test/tsetsize.pp b/tests/test/tsetsize.pp index 288bdc1b36..4279b38e24 100644 --- a/tests/test/tsetsize.pp +++ b/tests/test/tsetsize.pp @@ -1,14 +1,37 @@ program SetSizes; -{$APPTYPE CONSOLE} - {$ifdef fpc} + {$APPTYPE CONSOLE} {$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 _a= 0; +{$ifdef _16BITCOMPILER} + three_or_four = 3; +{$else} + three_or_four = 4; +{$endif} type TIntRange1_a = 0 + _a.. Pred( 1 * 8) + _a; @@ -134,7 +157,7 @@ begin WriteLn(Low(TIntRange2_a),'..',High(TIntRange2_a),' -> ', SizeOf(TSet2_a)); test(SizeOf(TSet2_a),2); 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)); test(SizeOf(TSet4_a),4); 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)); test(SizeOf(TSet1_b),2); 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)); test(SizeOf(TSet3_b),4); 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)); test(SizeOf(TSet1_c),2); 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)); test(SizeOf(TSet3_c),4); WriteLn(Low(TIntRange4_c),'..',High(TIntRange4_c),' -> ', SizeOf(TSet4_c));