paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-09-02 23:30:26 +02:00
Code Issues Packages Projects Releases Wiki Activity

* Changed the default packset setting to 1 and disabled the padding of 3-byte

Browse Source 
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 -
This commit is contained in:
nickysn 2014-03-14 23:51:14 +00:00
parent 29cb3a19c2
commit 015c7e951a
7 changed files with 55 additions and 17 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

14
compiler/symdef.pas
View File

@ -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;

8
rtl/i8086/mathu.inc
View File

@ -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;

7
rtl/objpas/classes/classes.inc
View File

@ -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;

2
rtl/objpas/classes/reader.inc
View File

@ -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;

2
rtl/objpas/classes/writer.inc
View File

@ -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);

2
tests/test/cg/taddset4.pp
View File

@ -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))

37
tests/test/tsetsize.pp
View File

@ -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));