paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-12 22:14:25 +02:00
Code Issues Packages Projects Releases Wiki Activity

* Patch from peter: fix macpas anonymous function procvar

Browse Source
This commit is contained in:
michael 2005-02-01 08:46:13 +00:00
parent c45d628646
commit ac1642de89
7 changed files with 73 additions and 78 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
compiler/globals.pas
View File

@ -90,7 +90,7 @@ interface
MathNegInf : tdoublearray = (0,0,0,0,0,0,240,255); MathNegInf : tdoublearray = (0,0,0,0,0,0,240,255);
MathPi : tdoublearray = (24,45,68,84,251,33,9,64); MathPi : tdoublearray = (24,45,68,84,251,33,9,64);
MathPiExtended : textendedarray = (53,194,104,33,162,218,15,201,0,64); MathPiExtended : textendedarray = (53,194,104,33,162,218,15,201,0,64);
{$else CPU_LITTLE_ENDIAN} {$else CPU_LITTLE_ENDIAN}
MathQNaN : tdoublearray = (255,252,0,0,0,0,0,0); MathQNaN : tdoublearray = (255,252,0,0,0,0,0,0);
MathInf : tdoublearray = (127,240,0,0,0,0,0,0); MathInf : tdoublearray = (127,240,0,0,0,0,0,0);
MathNegInf : tdoublearray = (255,240,0,0,0,0,0,0); MathNegInf : tdoublearray = (255,240,0,0,0,0,0,0);
@ -230,7 +230,7 @@ interface
aktsetalloc, aktsetalloc,
{$ENDIF} {$ENDIF}
aktpackrecords, aktpackrecords,
aktpackenum : longint; aktpackenum : shortint;
{$ifdef ansistring_bits} {$ifdef ansistring_bits}
aktansistring_bits : Tstringbits; aktansistring_bits : Tstringbits;
{$endif} {$endif}
@ -356,7 +356,7 @@ interface
{$IFDEF MACOS} {$IFDEF MACOS}
{Since SysUtils is not yet available for MacOS, fake {Since SysUtils is not yet available for MacOS, fake
Exceptions classes are included here.} Exceptions classes are included here.}
{$DEFINE MACOS_USE_FAKE_SYSUTILS} {$DEFINE MACOS_USE_FAKE_SYSUTILS}
@ -2218,7 +2218,10 @@ end;
end. end.
{ {
$Log$ $Log$
Revision 1.164 2005-01-31 21:30:56 olle Revision 1.165 2005-02-01 08:46:13 michael
* Patch from peter: fix macpas anonymous function procvar
Revision 1.164 2005/01/31 21:30:56 olle
+ Added fake Exception classes, only for MACOS. + Added fake Exception classes, only for MACOS.
Revision 1.163 2005/01/23 22:13:50 florian Revision 1.163 2005/01/23 22:13:50 florian

8
compiler/parser.pas
View File

@ -346,7 +346,8 @@ implementation
oldaktmoduleswitches : tmoduleswitches; oldaktmoduleswitches : tmoduleswitches;
oldaktfilepos : tfileposinfo; oldaktfilepos : tfileposinfo;
oldaktpackrecords, oldaktpackrecords,
oldaktpackenum,oldaktmaxfpuregisters : longint; oldaktpackenum : shortint;
oldaktmaxfpuregisters : longint;
oldaktalignment : talignmentinfo; oldaktalignment : talignmentinfo;
oldaktoutputformat : tasm; oldaktoutputformat : tasm;
oldaktspecificoptprocessor, oldaktspecificoptprocessor,
@ -660,7 +661,10 @@ implementation
end. end.
{ {
$Log$ $Log$
Revision 1.72 2005-01-29 11:36:52 peter Revision 1.73 2005-02-01 08:46:13 michael
* Patch from peter: fix macpas anonymous function procvar
Revision 1.72 2005/01/29 11:36:52 peter
* update x86_64 with new cpupara * update x86_64 with new cpupara
Revision 1.71 2005/01/26 16:23:28 peter Revision 1.71 2005/01/26 16:23:28 peter

12
compiler/pdecobj.pas
View File

@ -138,7 +138,6 @@ implementation
end; end;
var var
hs : string;
pcrd : tclassrefdef; pcrd : tclassrefdef;
tt : ttype; tt : ttype;
old_object_option : tsymoptions; old_object_option : tsymoptions;
@ -272,7 +271,7 @@ implementation
{ a hack, but it's easy to handle } { a hack, but it's easy to handle }
{ class reference type } { class reference type }
consume(_OF); consume(_OF);
single_type(tt,hs,typecanbeforward); single_type(tt,typecanbeforward);
{ accept hp1, if is a forward def or a class } { accept hp1, if is a forward def or a class }
if (tt.def.deftype=forwarddef) or if (tt.def.deftype=forwarddef) or
@ -346,7 +345,7 @@ implementation
begin begin
while try_to_consume(_COMMA) do while try_to_consume(_COMMA) do
begin begin
id_type(tt,pattern,false); id_type(tt,false);
if (tt.def.deftype<>objectdef) then if (tt.def.deftype<>objectdef) then
begin begin
Message1(type_e_interface_type_expected,tt.def.typename); Message1(type_e_interface_type_expected,tt.def.typename);
@ -387,7 +386,7 @@ implementation
{ reads the parent class } { reads the parent class }
if try_to_consume(_LKLAMMER) then if try_to_consume(_LKLAMMER) then
begin begin
id_type(tt,pattern,false); id_type(tt,false);
childof:=tobjectdef(tt.def); childof:=tobjectdef(tt.def);
if (not assigned(childof)) or if (not assigned(childof)) or
(childof.deftype<>objectdef) then (childof.deftype<>objectdef) then
@ -730,7 +729,10 @@ implementation
end. end.
{ {
$Log$ $Log$
Revision 1.84 2004-12-26 20:11:39 peter Revision 1.85 2005-02-01 08:46:13 michael
* Patch from peter: fix macpas anonymous function procvar
Revision 1.84 2004/12/26 20:11:39 peter
* fix invalid typecast * fix invalid typecast
Revision 1.83 2004/11/16 20:32:40 peter Revision 1.83 2004/11/16 20:32:40 peter

35
compiler/pdecsub.pas
View File

@ -388,8 +388,6 @@ implementation
vs : tparavarsym; vs : tparavarsym;
srsym : tsym; srsym : tsym;
pv : tprocvardef; pv : tprocvardef;
hs,
hs1 : string;
varspez : Tvarspez; varspez : Tvarspez;
defaultvalue : tconstsym; defaultvalue : tconstsym;
defaultrequired : boolean; defaultrequired : boolean;
@ -476,14 +474,8 @@ implementation
if parseprocvar=pv_func then if parseprocvar=pv_func then
begin begin
consume(_COLON); consume(_COLON);
single_type(pd.rettype,hs,false); single_type(pv.rettype,false);
end; end;
if token=_OF then
begin
consume(_OF);
consume(_OBJECT);
include(pd.procoptions,po_methodpointer);
end;
tt.def:=pv; tt.def:=pv;
{ possible proc directives } { possible proc directives }
if check_proc_directive(true) then if check_proc_directive(true) then
@ -496,7 +488,6 @@ implementation
end; end;
{ Add implicit hidden parameters and function result } { Add implicit hidden parameters and function result }
handle_calling_convention(pv); handle_calling_convention(pv);
hs1:='procvar';
end end
else else
{ read type declaration, force reading for value and const paras } { read type declaration, force reading for value and const paras }
@ -523,7 +514,7 @@ implementation
else else
begin begin
{ define field type } { define field type }
single_type(arrayelementtype,hs1,false); single_type(arrayelementtype,false);
tarraydef(tt.def).setelementtype(arrayelementtype); tarraydef(tt.def).setelementtype(arrayelementtype);
end; end;
end end
@ -541,14 +532,13 @@ implementation
begin begin
consume(token); consume(token);
tt:=openshortstringtype; tt:=openshortstringtype;
hs1:='openstring';
end end
else else
begin begin
{ everything else } { everything else }
if (m_mac in aktmodeswitches) then if (m_mac in aktmodeswitches) then
try_to_consume(_UNIV); {currently does nothing} try_to_consume(_UNIV); {currently does nothing}
single_type(tt,hs1,false); single_type(tt,false);
end; end;
if (target_info.system in [system_powerpc_morphos,system_m68k_amiga]) then if (target_info.system in [system_powerpc_morphos,system_m68k_amiga]) then
@ -595,14 +585,7 @@ implementation
end; end;
end end
else else
begin tt:=cformaltype;
{$ifndef UseNiceNames}
hs1:='$$$';
{$else UseNiceNames}
hs1:='var';
{$endif UseNiceNames}
tt:=cformaltype;
end;
{ File types are only allowed for var parameters } { File types are only allowed for var parameters }
if (tt.def.deftype=filedef) and if (tt.def.deftype=filedef) and
@ -876,7 +859,6 @@ implementation
function parse_proc_dec(aclass:tobjectdef):tprocdef; function parse_proc_dec(aclass:tobjectdef):tprocdef;
var var
pd : tprocdef; pd : tprocdef;
hs : string;
isclassmethod : boolean; isclassmethod : boolean;
begin begin
pd:=nil; pd:=nil;
@ -905,7 +887,7 @@ implementation
if try_to_consume(_COLON) then if try_to_consume(_COLON) then
begin begin
inc(testcurobject); inc(testcurobject);
single_type(pd.rettype,hs,false); single_type(pd.rettype,false);
pd.test_if_fpu_result; pd.test_if_fpu_result;
dec(testcurobject); dec(testcurobject);
end end
@ -1010,7 +992,7 @@ implementation
end end
else else
begin begin
single_type(pd.rettype,hs,false); single_type(pd.rettype,false);
pd.test_if_fpu_result; pd.test_if_fpu_result;
if (optoken in [_EQUAL,_GT,_LT,_GTE,_LTE]) and if (optoken in [_EQUAL,_GT,_LT,_GTE,_LTE]) and
((pd.rettype.def.deftype<>orddef) or ((pd.rettype.def.deftype<>orddef) or
@ -2459,7 +2441,10 @@ const
end. end.
{ {
$Log$ $Log$
Revision 1.227 2005-01-31 21:27:51 peter Revision 1.228 2005-02-01 08:46:13 michael
* Patch from peter: fix macpas anonymous function procvar
Revision 1.227 2005/01/31 21:27:51 peter
* macpas procvars in parameters * macpas procvars in parameters
Revision 1.226 2005/01/19 22:19:41 peter Revision 1.226 2005/01/19 22:19:41 peter

13
compiler/pdecvar.pas
View File

@ -204,9 +204,7 @@ implementation
sym : tsym; sym : tsym;
p : tpropertysym; p : tpropertysym;
overriden : tsym; overriden : tsym;
hs : string;
varspez : tvarspez; varspez : tvarspez;
s : string;
tt : ttype; tt : ttype;
arraytype : ttype; arraytype : ttype;
def : tdef; def : tdef;
@ -300,11 +298,11 @@ implementation
{ define range and type of range } { define range and type of range }
tt.setdef(tarraydef.create(0,-1,s32inttype)); tt.setdef(tarraydef.create(0,-1,s32inttype));
{ define field type } { define field type }
single_type(arraytype,s,false); single_type(arraytype,false);
tarraydef(tt.def).setelementtype(arraytype); tarraydef(tt.def).setelementtype(arraytype);
end end
else else
single_type(tt,s,false); single_type(tt,false);
symtablestack:=oldsymtablestack; symtablestack:=oldsymtablestack;
end end
else else
@ -339,7 +337,7 @@ implementation
oldsymtablestack:=symtablestack; oldsymtablestack:=symtablestack;
while not(symtablestack.symtabletype in [globalsymtable,staticsymtable]) do while not(symtablestack.symtabletype in [globalsymtable,staticsymtable]) do
symtablestack:=symtablestack.next; symtablestack:=symtablestack.next;
single_type(p.proptype,hs,false); single_type(p.proptype,false);
symtablestack:=oldsymtablestack; symtablestack:=oldsymtablestack;
if (idtoken=_INDEX) then if (idtoken=_INDEX) then
begin begin
@ -1314,7 +1312,10 @@ implementation
end. end.
{ {
$Log$ $Log$
Revision 1.92 2005-01-30 17:17:19 florian Revision 1.93 2005-02-01 08:46:13 michael
* Patch from peter: fix macpas anonymous function procvar
Revision 1.92 2005/01/30 17:17:19 florian
* variables exported by $J/$Z in macpas mode are never regable * variables exported by $J/$Z in macpas mode are never regable
Revision 1.91 2005/01/06 13:30:41 florian Revision 1.91 2005/01/06 13:30:41 florian

60
compiler/ptype.pas
View File

@ -41,14 +41,14 @@ interface
{ reads a string, file type or a type id and returns a name and } { reads a string, file type or a type id and returns a name and }
{ tdef } { tdef }
procedure single_type(var tt:ttype;var s : string;isforwarddef:boolean); procedure single_type(var tt:ttype;isforwarddef:boolean);
procedure read_type(var tt:ttype;const name : stringid;parseprocvardir:boolean); procedure read_type(var tt:ttype;const name : stringid;parseprocvardir:boolean);
{ reads a type definition } { reads a type definition }
{ to a appropriating tdef, s gets the name of } { to a appropriating tdef, s gets the name of }
{ the type to allow name mangling } { the type to allow name mangling }
procedure id_type(var tt : ttype;var s : string;isforwarddef:boolean); procedure id_type(var tt : ttype;isforwarddef:boolean);
implementation implementation
@ -72,7 +72,7 @@ implementation
pbase,pexpr,pdecsub,pdecvar,pdecobj; pbase,pexpr,pdecsub,pdecvar,pdecobj;
procedure id_type(var tt : ttype;var s : string;isforwarddef:boolean); procedure id_type(var tt : ttype;isforwarddef:boolean);
{ reads a type definition } { reads a type definition }
{ to a appropriating tdef, s gets the name of } { to a appropriating tdef, s gets the name of }
{ the type to allow name mangling } { the type to allow name mangling }
@ -81,7 +81,7 @@ implementation
pos : tfileposinfo; pos : tfileposinfo;
srsym : tsym; srsym : tsym;
srsymtable : tsymtable; srsymtable : tsymtable;
sorg : stringid; s,sorg : stringid;
begin begin
s:=pattern; s:=pattern;
sorg:=orgpattern; sorg:=orgpattern;
@ -182,43 +182,30 @@ implementation
end; end;
procedure single_type(var tt:ttype;var s : string;isforwarddef:boolean); procedure single_type(var tt:ttype;isforwarddef:boolean);
{ reads a string, file type or a type id and returns a name and }
{ tdef }
var var
hs : string; t2 : ttype;
t2 : ttype;
begin begin
case token of case token of
_STRING: _STRING:
begin string_dec(tt);
string_dec(tt);
s:='STRING';
end;
_FILE: _FILE:
begin
consume(_FILE);
if token=_OF then
begin
consume(_OF);
single_type(t2,hs,false);
tt.setdef(tfiledef.createtyped(t2));
s:='FILE$OF$'+hs;
end
else
begin
tt:=cfiletype;
s:='FILE';
end;
end;
_ID:
begin begin
id_type(tt,s,isforwarddef); consume(_FILE);
if token=_OF then
begin
consume(_OF);
single_type(t2,false);
tt.setdef(tfiledef.createtyped(t2));
end
else
tt:=cfiletype;
end; end;
_ID:
id_type(tt,isforwarddef);
else else
begin begin
message(type_e_type_id_expected); message(type_e_type_id_expected);
s:='<unknown>';
tt:=generrortype; tt:=generrortype;
end; end;
end; end;
@ -489,7 +476,7 @@ implementation
case token of case token of
_STRING,_FILE: _STRING,_FILE:
begin begin
single_type(tt,hs,false); single_type(tt,false);
end; end;
_LKLAMMER: _LKLAMMER:
begin begin
@ -591,7 +578,7 @@ implementation
_CARET: _CARET:
begin begin
consume(_CARET); consume(_CARET);
single_type(tt2,hs,typecanbeforward); single_type(tt2,typecanbeforward);
tt.setdef(tpointerdef.create(tt2)); tt.setdef(tpointerdef.create(tt2));
end; end;
_RECORD: _RECORD:
@ -632,7 +619,7 @@ implementation
if is_func then if is_func then
begin begin
consume(_COLON); consume(_COLON);
single_type(pd.rettype,hs,false); single_type(pd.rettype,false);
end; end;
if token=_OF then if token=_OF then
begin begin
@ -666,7 +653,10 @@ implementation
end. end.
{ {
$Log$ $Log$
Revision 1.73 2005-01-19 22:19:41 peter Revision 1.74 2005-02-01 08:46:13 michael
* Patch from peter: fix macpas anonymous function procvar
Revision 1.73 2005/01/19 22:19:41 peter
* unit mapping rewrite * unit mapping rewrite
* new derefmap added * new derefmap added

12
compiler/symdef.pas
View File

@ -498,6 +498,7 @@ interface
function is_publishable : boolean;override; function is_publishable : boolean;override;
function is_methodpointer:boolean;override; function is_methodpointer:boolean;override;
function is_addressonly:boolean;override; function is_addressonly:boolean;override;
function getmangledparaname:string;override;
{ debug } { debug }
{$ifdef GDB} {$ifdef GDB}
function stabstring : pchar;override; function stabstring : pchar;override;
@ -4708,6 +4709,12 @@ implementation
end; end;
function tprocvardef.getmangledparaname:string;
begin
result:='procvar';
end;
{$ifdef GDB} {$ifdef GDB}
function tprocvardef.stabstring : pchar; function tprocvardef.stabstring : pchar;
var var
@ -6371,7 +6378,10 @@ implementation
end. end.
{ {
$Log$ $Log$
Revision 1.292 2005-01-30 11:26:40 peter Revision 1.293 2005-02-01 08:46:13 michael
* Patch from peter: fix macpas anonymous function procvar
Revision 1.292 2005/01/30 11:26:40 peter
* add info that a procedure is local in error messages * add info that a procedure is local in error messages
Revision 1.291 2005/01/24 22:08:32 peter Revision 1.291 2005/01/24 22:08:32 peter