mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-21 20:09:25 +02:00
* Prevent writing pointer types twice
This commit is contained in:
Michael VAN CANNEYT
Pierre Muller
parent
4cd2cb914f
commit
d5f9dd7212
@ -33,7 +33,6 @@ type
|
||||
|
||||
|
||||
var
|
||||
IsExtern : boolean;
|
||||
s,TN,PN : String;
|
||||
|
||||
|
||||
@ -84,7 +83,7 @@ function HandleDefine(dname : presobject) : presobject;
|
||||
Function CheckWideString(S : String) : presobject;
|
||||
function CheckUnderScore(pdecl : presobject) : presobject;
|
||||
|
||||
Function NewCType(aID,aIntID : String) : PresObject;
|
||||
Function NewCType(aCType,aPascalType : String) : PresObject;
|
||||
|
||||
Implementation
|
||||
|
||||
@ -98,13 +97,13 @@ begin
|
||||
end;
|
||||
|
||||
|
||||
Function NewCType(aID,aIntID : String) : PresObject;
|
||||
Function NewCType(aCType,aPascalType : String) : PresObject;
|
||||
|
||||
begin
|
||||
if UseCTypesUnit then
|
||||
Result:=NewID(aID)
|
||||
Result:=NewID(aCType)
|
||||
else
|
||||
result:=NewIntID(aIntID);
|
||||
result:=NewIntID(aPascalType);
|
||||
end;
|
||||
|
||||
function HandleUnaryDefExpr(aExpr : presobject) : presobject;
|
||||
@ -164,53 +163,41 @@ function handleSpecialUnSignedType(aType : presobject) : presobject;
|
||||
|
||||
var
|
||||
hp : presobject;
|
||||
tc,tp : string;
|
||||
|
||||
begin
|
||||
hp:=aType;
|
||||
Result:=hp;
|
||||
if Not assigned(hp) then
|
||||
exit;
|
||||
s:=strpas(hp^.p);
|
||||
tp:='';
|
||||
tc:=strpas(hp^.p);
|
||||
if UseCTypesUnit then
|
||||
begin
|
||||
if s=cint_STR then
|
||||
s:=cuint_STR
|
||||
else if s=cshort_STR then
|
||||
s:=cushort_STR
|
||||
else if s=cchar_STR then
|
||||
s:=cuchar_STR
|
||||
else if s=clong_STR then
|
||||
s:=culong_STR
|
||||
else if s=clonglong_STR then
|
||||
s:=culonglong_STR
|
||||
else if s=cint8_STR then
|
||||
s:=cuint8_STR
|
||||
else if s=cint16_STR then
|
||||
s:=cuint16_STR
|
||||
else if s=cint32_STR then
|
||||
s:=cuint32_STR
|
||||
else if s=cint64_STR then
|
||||
s:=cuint64_STR
|
||||
case tc of
|
||||
cint_STR: tp:=cuint_STR;
|
||||
cshort_STR: tp:=cushort_STR;
|
||||
cchar_STR : tp:=cuchar_STR;
|
||||
clong_STR : tp:=culong_STR;
|
||||
clonglong_STR : tp:=culonglong_STR;
|
||||
cint8_STR : tp:=cuint8_STR;
|
||||
cint16_STR : tp:=cuint16_STR;
|
||||
cint32_STR : tp:=cuint32_STR;
|
||||
cint64_STR : tp:=cuint64_STR;
|
||||
else
|
||||
s:='';
|
||||
tp:='';
|
||||
end
|
||||
else
|
||||
begin
|
||||
if s=INT_STR then
|
||||
s:=UINT_STR
|
||||
else if s=SHORT_STR then
|
||||
s:=USHORT_STR
|
||||
else if s=SMALL_STR then
|
||||
s:=USMALL_STR
|
||||
else if s=CHAR_STR then
|
||||
s:=UCHAR_STR
|
||||
else if s=INT64_STR then
|
||||
s:=QWORD_STR
|
||||
case tc of
|
||||
INT_STR : tp:=UINT_STR;
|
||||
SHORT_STR : tp:=USHORT_STR;
|
||||
SMALL_STR : tp:=USMALL_STR;
|
||||
CHAR_STR : tp:=UCHAR_STR;
|
||||
INT64_STR : tp:=QWORD_STR;
|
||||
else
|
||||
s:='';
|
||||
tp:='';
|
||||
end;
|
||||
if s<>'' then
|
||||
hp^.setstr(s);
|
||||
if tp<>'' then
|
||||
hp^.setstr(tp);
|
||||
end;
|
||||
|
||||
function handleSizedArrayDecl(aType,aSizeExpr: presobject): presobject;
|
||||
@ -452,6 +439,7 @@ function HandleDeclarationStatement(decl, type_spec, modifier_spec,
|
||||
decllist_spec, block_spec: presobject): presobject;
|
||||
var
|
||||
hp : presobject;
|
||||
IsExtern : boolean;
|
||||
|
||||
begin
|
||||
HandleDeclarationStatement:=Nil;
|
||||
@ -650,6 +638,7 @@ function HandleDeclarationSysTrap(decl, type_spec, modifier_spec,
|
||||
|
||||
var
|
||||
hp : presobject;
|
||||
IsExtern : boolean;
|
||||
|
||||
begin
|
||||
HandleDeclarationSysTrap:=Nil;
|
||||
@ -942,6 +931,8 @@ end;
|
||||
|
||||
function HandleTypedefList(type_spec,dec_modifier,declarator_list: presobject) : presobject;
|
||||
|
||||
(* TYPEDEF type_specifier dec_modifier declarator_list SEMICOLON *)
|
||||
|
||||
var
|
||||
hp,ph : presobject;
|
||||
|
||||
@ -949,7 +940,6 @@ var
|
||||
begin
|
||||
HandleTypedefList:=Nil;
|
||||
ph:=nil;
|
||||
(* TYPEDEF type_specifier dec_modifier declarator_list SEMICOLON *)
|
||||
if block_type<>bt_type then
|
||||
begin
|
||||
if not(compactmode) then
|
||||
@ -983,7 +973,7 @@ begin
|
||||
PN:=PointerName(ph^.p);
|
||||
if UsePPointers and (Uppercase(tn)<>Uppercase(pn)) and
|
||||
assigned(type_spec) and (type_spec^.typ<>t_procdef) then
|
||||
writeln(outfile,aktspace,PN,' = ^',TN,';');
|
||||
WritePointerTypeDef(outfile,PN,TN);
|
||||
(* write new type name *)
|
||||
write(outfile,aktspace,TN,' = ');
|
||||
shift(2);
|
||||
|
||||
@ -1,5 +1,7 @@
|
||||
unit h2pout;
|
||||
|
||||
{$modeswitch result}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
@ -12,6 +14,9 @@ procedure CloseTempFiles;
|
||||
procedure WriteFileHeader(var headerfile: Text);
|
||||
procedure WriteLibraryInitialization;
|
||||
|
||||
// This will write each pointer type only once.
|
||||
function WritePointerTypeDef(var aFile : text; const PN,TN : AnsiString) : Boolean;
|
||||
|
||||
procedure write_statement_block(var outfile:text; p : presobject);
|
||||
procedure write_type_specifier(var outfile:text; p : presobject);
|
||||
procedure write_p_a_def(var outfile:text; p,simple_type : presobject);
|
||||
@ -55,7 +60,8 @@ Var
|
||||
implementation
|
||||
|
||||
var
|
||||
tempfile : text;
|
||||
WrittenPointers : TStringList;
|
||||
tempfile : text;
|
||||
space_array : array [0..255] of integer;
|
||||
space_index : integer;
|
||||
_NeedEllipsisOverload : boolean;
|
||||
@ -209,7 +215,7 @@ the correct syntax.
|
||||
function FixId(const s:string):string;
|
||||
|
||||
const
|
||||
maxtokens = 16;
|
||||
maxtokens = 17;
|
||||
reservedid: array[1..maxtokens] of string[14] = (
|
||||
'CLASS',
|
||||
'DISPOSE',
|
||||
@ -226,7 +232,8 @@ const
|
||||
'TYPE',
|
||||
'TRUE',
|
||||
'UNTIL',
|
||||
'VAR'
|
||||
'VAR',
|
||||
'OBJECT'
|
||||
);
|
||||
|
||||
var
|
||||
@ -310,7 +317,7 @@ begin
|
||||
else
|
||||
PointerName:=Copy(s,i,255);
|
||||
if PointerPrefix then
|
||||
PTypeList.Add('P'+s);
|
||||
PTypeList.Add('P'+s);
|
||||
end;
|
||||
|
||||
|
||||
@ -715,11 +722,6 @@ begin
|
||||
else
|
||||
begin
|
||||
(* generate a call by reference parameter ? *)
|
||||
// varpara:=usevarparas and
|
||||
// assigned(p^.p1^.p2^.p1) and
|
||||
// (p^.p1^.p2^.p1^.typ in [t_addrdef,t_pointerdef]) and
|
||||
// assigned(p^.p1^.p2^.p1^.p1) and
|
||||
// (p^.p1^.p2^.p1^.p1^.typ<>t_procdef);
|
||||
varpara:=IsVarPara(p);
|
||||
if varpara then
|
||||
begin
|
||||
@ -776,6 +778,7 @@ begin
|
||||
end;
|
||||
|
||||
|
||||
|
||||
Procedure write_pointerdef(var outfile:text; p,simple_type : presobject);
|
||||
|
||||
var
|
||||
@ -928,7 +931,7 @@ begin
|
||||
begin
|
||||
PTypeList.Add('P'+p^.str);
|
||||
end;
|
||||
if p^.intname then
|
||||
if p^.skiptprefix then
|
||||
write(outfile,p^.p)
|
||||
else
|
||||
write(outfile,TypeName(p^.p));
|
||||
@ -1332,6 +1335,22 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
function MayWritePointerTypeDef(const PN: AnsiString): Boolean;
|
||||
|
||||
begin
|
||||
Result:=WrittenPointers.IndexOf(PN)=-1;
|
||||
end;
|
||||
|
||||
function WritePointerTypeDef(var aFile : text; const PN, TN: AnsiString): Boolean;
|
||||
|
||||
begin
|
||||
Result:=MayWritePointerTypeDef(PN);;
|
||||
if Result then
|
||||
begin
|
||||
WrittenPointers.Add(PN);
|
||||
Writeln(aFile,aktspace,PN,' = ^',TN,';');
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure write_statement_block(var outfile:text; p : presobject);
|
||||
|
||||
@ -1362,7 +1381,32 @@ begin
|
||||
writeln(outfile,aktspace,'end;');
|
||||
end;
|
||||
|
||||
procedure WritePointerList(var headerfile: Text);
|
||||
|
||||
var
|
||||
I : Integer;
|
||||
MustWritePointers : Boolean;
|
||||
originalstr : String;
|
||||
|
||||
begin
|
||||
I:=PTypeList.count-1;
|
||||
MustWritePointers:=False;
|
||||
While (Not MustWritePointers) and (I>=0) do
|
||||
begin
|
||||
MustWritePointers:=MayWritePointerTypeDef(PTypelist[i]);
|
||||
Dec(I);
|
||||
end;
|
||||
if not MustWritePointers then
|
||||
exit;
|
||||
Writeln(headerfile,'Type');
|
||||
for i:=0 to (PTypeList.Count-1) do
|
||||
begin
|
||||
originalstr:=copy(PTypelist[i],2,length(PTypeList[i]));
|
||||
if PrependTypes then
|
||||
originalstr:='T'+originalstr;
|
||||
WritePointerTypeDef(HeaderFile,PTypeList[i],OriginalStr);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure WriteFileHeader(var headerfile: Text);
|
||||
var
|
||||
@ -1393,31 +1437,13 @@ begin
|
||||
end;
|
||||
if UseName then
|
||||
begin
|
||||
writeln(headerfile,aktspace,'const');
|
||||
writeln(headerfile,aktspace,' External_library=''',libfilename,'''; {Setup as you need}');
|
||||
writeln(headerfile,'const');
|
||||
writeln(headerfile,' External_library=''',libfilename,'''; {Setup as you need}');
|
||||
writeln(headerfile);
|
||||
end;
|
||||
if UsePPointers then
|
||||
begin
|
||||
Writeln(headerfile,aktspace,'{ Pointers to basic pascal types, inserted by h2pas conversion program.}');
|
||||
Writeln(headerfile,aktspace,'Type');
|
||||
Writeln(headerfile,aktspace,' PLongint = ^Longint;');
|
||||
Writeln(headerfile,aktspace,' PSmallInt = ^SmallInt;');
|
||||
Writeln(headerfile,aktspace,' PByte = ^Byte;');
|
||||
Writeln(headerfile,aktspace,' PWord = ^Word;');
|
||||
Writeln(headerfile,aktspace,' PDWord = ^DWord;');
|
||||
Writeln(headerfile,aktspace,' PDouble = ^Double;');
|
||||
Writeln(headerfile);
|
||||
end;
|
||||
if PTypeList.count <> 0 then
|
||||
Writeln(headerfile,aktspace,'Type');
|
||||
for i:=0 to (PTypeList.Count-1) do
|
||||
begin
|
||||
originalstr:=copy(PTypelist[i],2,length(PTypeList[i]));
|
||||
if PrependTypes then
|
||||
originalstr:='T'+originalstr;
|
||||
Writeln(headerfile,aktspace,' '+PTypeList[i],' = ^',originalstr,';');
|
||||
end;
|
||||
WritePointerList(headerfile);
|
||||
writeln(headerfile);
|
||||
if not packrecords then
|
||||
begin
|
||||
writeln(headerfile,'{$IFDEF FPC}');
|
||||
@ -1501,5 +1527,21 @@ begin
|
||||
writeln(outfile,' Free',unitname,';');
|
||||
end;
|
||||
|
||||
initialization
|
||||
WrittenPointers:=TStringList.Create;
|
||||
WrittenPointers.Sorted:=true;
|
||||
// We must never write these, they are defined in the system unit
|
||||
WrittenPointers.Add('pansichar');
|
||||
WrittenPointers.Add('pchar');
|
||||
WrittenPointers.Add('pdouble');
|
||||
WrittenPointers.Add('plongint');
|
||||
WrittenPointers.Add('psmallint');
|
||||
WrittenPointers.Add('pshortint');
|
||||
WrittenPointers.Add('pbyte');
|
||||
WrittenPointers.Add('pint64');
|
||||
WrittenPointers.Add('pword');
|
||||
WrittenPointers.Add('pqword');
|
||||
|
||||
finalization
|
||||
WrittenPointers.Free;
|
||||
end.
|
||||
|
||||
Loading…
Reference in New Issue
Block a user