paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-20 16:09:31 +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);
MathPi : tdoublearray = (24,45,68,84,251,33,9,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);
MathInf : tdoublearray = (127,240,0,0,0,0,0,0);
MathNegInf : tdoublearray = (255,240,0,0,0,0,0,0);
@ -230,7 +230,7 @@ interface
aktsetalloc,
{$ENDIF}
aktpackrecords,
aktpackenum : longint;
aktpackenum : shortint;
{$ifdef ansistring_bits}
aktansistring_bits : Tstringbits;
{$endif}
@ -356,7 +356,7 @@ interface
{$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.}
{$DEFINE MACOS_USE_FAKE_SYSUTILS}
@ -2218,7 +2218,10 @@ end;
end.
{
$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.
Revision 1.163 2005/01/23 22:13:50 florian

8
compiler/parser.pas
View File

@ -346,7 +346,8 @@ implementation
oldaktmoduleswitches : tmoduleswitches;
oldaktfilepos : tfileposinfo;
oldaktpackrecords,
oldaktpackenum,oldaktmaxfpuregisters : longint;
oldaktpackenum : shortint;
oldaktmaxfpuregisters : longint;
oldaktalignment : talignmentinfo;
oldaktoutputformat : tasm;
oldaktspecificoptprocessor,
@ -660,7 +661,10 @@ implementation
end.
{
$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
Revision 1.71 2005/01/26 16:23:28 peter

12
compiler/pdecobj.pas
View File

@ -138,7 +138,6 @@ implementation
end;
var
hs : string;
pcrd : tclassrefdef;
tt : ttype;
old_object_option : tsymoptions;
@ -272,7 +271,7 @@ implementation
{ a hack, but it's easy to handle }
{ class reference type }
consume(_OF);
single_type(tt,hs,typecanbeforward);
single_type(tt,typecanbeforward);
{ accept hp1, if is a forward def or a class }
if (tt.def.deftype=forwarddef) or
@ -346,7 +345,7 @@ implementation
begin
while try_to_consume(_COMMA) do
begin
id_type(tt,pattern,false);
id_type(tt,false);
if (tt.def.deftype<>objectdef) then
begin
Message1(type_e_interface_type_expected,tt.def.typename);
@ -387,7 +386,7 @@ implementation
{ reads the parent class }
if try_to_consume(_LKLAMMER) then
begin
id_type(tt,pattern,false);
id_type(tt,false);
childof:=tobjectdef(tt.def);
if (not assigned(childof)) or
(childof.deftype<>objectdef) then
@ -730,7 +729,10 @@ implementation
end.
{
$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
Revision 1.83 2004/11/16 20:32:40 peter

35
compiler/pdecsub.pas
View File

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

13
compiler/pdecvar.pas
View File

@ -204,9 +204,7 @@ implementation
sym : tsym;
p : tpropertysym;
overriden : tsym;
hs : string;
varspez : tvarspez;
s : string;
tt : ttype;
arraytype : ttype;
def : tdef;
@ -300,11 +298,11 @@ implementation
{ define range and type of range }
tt.setdef(tarraydef.create(0,-1,s32inttype));
{ define field type }
single_type(arraytype,s,false);
single_type(arraytype,false);
tarraydef(tt.def).setelementtype(arraytype);
end
else
single_type(tt,s,false);
single_type(tt,false);
symtablestack:=oldsymtablestack;
end
else
@ -339,7 +337,7 @@ implementation
oldsymtablestack:=symtablestack;
while not(symtablestack.symtabletype in [globalsymtable,staticsymtable]) do
symtablestack:=symtablestack.next;
single_type(p.proptype,hs,false);
single_type(p.proptype,false);
symtablestack:=oldsymtablestack;
if (idtoken=_INDEX) then
begin
@ -1314,7 +1312,10 @@ implementation
end.
{
$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
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 }
{ 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);
{ reads a type definition }
{ to a appropriating tdef, s gets the name of }
{ 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
@ -72,7 +72,7 @@ implementation
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 }
{ to a appropriating tdef, s gets the name of }
{ the type to allow name mangling }
@ -81,7 +81,7 @@ implementation
pos : tfileposinfo;
srsym : tsym;
srsymtable : tsymtable;
sorg : stringid;
s,sorg : stringid;
begin
s:=pattern;
sorg:=orgpattern;
@ -182,43 +182,30 @@ implementation
end;
procedure single_type(var tt:ttype;var s : string;isforwarddef:boolean);
{ reads a string, file type or a type id and returns a name and }
{ tdef }
procedure single_type(var tt:ttype;isforwarddef:boolean);
var
hs : string;
t2 : ttype;
t2 : ttype;
begin
case token of
_STRING:
begin
string_dec(tt);
s:='STRING';
end;
string_dec(tt);
_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
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;
_ID:
id_type(tt,isforwarddef);
else
begin
message(type_e_type_id_expected);
s:='<unknown>';
tt:=generrortype;
end;
end;
@ -489,7 +476,7 @@ implementation
case token of
_STRING,_FILE:
begin
single_type(tt,hs,false);
single_type(tt,false);
end;
_LKLAMMER:
begin
@ -591,7 +578,7 @@ implementation
_CARET:
begin
consume(_CARET);
single_type(tt2,hs,typecanbeforward);
single_type(tt2,typecanbeforward);
tt.setdef(tpointerdef.create(tt2));
end;
_RECORD:
@ -632,7 +619,7 @@ implementation
if is_func then
begin
consume(_COLON);
single_type(pd.rettype,hs,false);
single_type(pd.rettype,false);
end;
if token=_OF then
begin
@ -666,7 +653,10 @@ implementation
end.
{
$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
* new derefmap added

12
compiler/symdef.pas
View File

@ -498,6 +498,7 @@ interface
function is_publishable : boolean;override;
function is_methodpointer:boolean;override;
function is_addressonly:boolean;override;
function getmangledparaname:string;override;
{ debug }
{$ifdef GDB}
function stabstring : pchar;override;
@ -4708,6 +4709,12 @@ implementation
end;
function tprocvardef.getmangledparaname:string;
begin
result:='procvar';
end;
{$ifdef GDB}
function tprocvardef.stabstring : pchar;
var
@ -6371,7 +6378,10 @@ implementation
end.
{
$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
Revision 1.291 2005/01/24 22:08:32 peter