diff --git a/compiler/README b/compiler/README index 4c63f1a985..5f145cc002 100644 --- a/compiler/README +++ b/compiler/README @@ -51,5 +51,7 @@ Changes in the syntax or semantic of FPC: because the new temporary ansistring handling support exceptions and exceptions need the class OOP model 18/05/99 The compiler will stop directly if there are errors in the - commandline parameters + commandline parameters + 01/06/99 You now need really always a @ to get the address of a procedure, + or you need to use the -So switch for tp7 style procvar diff --git a/compiler/aasm.pas b/compiler/aasm.pas index c60a49fafb..f1a852543f 100644 --- a/compiler/aasm.pas +++ b/compiler/aasm.pas @@ -846,11 +846,7 @@ uses procedure ResetAsmsymbolList; begin - {$ifdef tp} - asmsymbollist^.foreach(resetasmsym); - {$else} - asmsymbollist^.foreach(@resetasmsym); - {$endif} + asmsymbollist^.foreach({$ifdef fpc}@{$endif}resetasmsym); end; @@ -900,7 +896,10 @@ uses end. { $Log$ - Revision 1.48 1999-05-28 09:11:39 peter + Revision 1.49 1999-06-01 14:45:41 peter + * @procvar is now always needed for FPC + + Revision 1.48 1999/05/28 09:11:39 peter * also count ref when asmlabel^.name is used Revision 1.47 1999/05/27 19:43:55 peter diff --git a/compiler/ag386int.pas b/compiler/ag386int.pas index c2ac90adf9..c39332de59 100644 --- a/compiler/ag386int.pas +++ b/compiler/ag386int.pas @@ -584,7 +584,7 @@ ait_stab_function_name : ; procedure ti386intasmlist.WriteExternals; begin currentasmlist:=@self; - AsmSymbolList^.foreach(writeexternal); + AsmSymbolList^.foreach({$ifdef fpc}@{$endif}writeexternal); end; @@ -627,7 +627,10 @@ ait_stab_function_name : ; end. { $Log$ - Revision 1.44 1999-05-27 19:44:00 peter + Revision 1.45 1999-06-01 14:45:43 peter + * @procvar is now always needed for FPC + + Revision 1.44 1999/05/27 19:44:00 peter * removed oldasm * plabel -> pasmlabel * -a switches to source writing automaticly diff --git a/compiler/ag386nsm.pas b/compiler/ag386nsm.pas index b38f69c186..c0c25b0c4d 100644 --- a/compiler/ag386nsm.pas +++ b/compiler/ag386nsm.pas @@ -559,7 +559,7 @@ ait_stab_function_name : ; procedure ti386nasmasmlist.WriteExternals; begin currentasmlist:=@self; - AsmSymbolList^.foreach(writeexternal); + AsmSymbolList^.foreach({$ifdef fpc}@{$endif}writeexternal); end; @@ -597,7 +597,10 @@ ait_stab_function_name : ; end. { $Log$ - Revision 1.40 1999-05-27 19:44:02 peter + Revision 1.41 1999-06-01 14:45:44 peter + * @procvar is now always needed for FPC + + Revision 1.40 1999/05/27 19:44:02 peter * removed oldasm * plabel -> pasmlabel * -a switches to source writing automaticly diff --git a/compiler/hcgdata.pas b/compiler/hcgdata.pas index b8d0df95cd..22a954bcaf 100644 --- a/compiler/hcgdata.pas +++ b/compiler/hcgdata.pas @@ -203,7 +203,7 @@ implementation root:=nil; count:=0; { insert all message handlers into a tree, sorted by name } - _class^.publicsyms^.foreach(insertmsgstr); + _class^.publicsyms^.foreach({$ifdef fpc}@{$endif}insertmsgstr); { write all names } if assigned(root) then @@ -245,7 +245,7 @@ implementation root:=nil; count:=0; { insert all message handlers into a tree, sorted by name } - _class^.publicsyms^.foreach(insertmsgint); + _class^.publicsyms^.foreach({$ifdef fpc}@{$endif}insertmsgint); { now start writing of the message string table } getdatalabel(r); @@ -471,11 +471,7 @@ implementation { walk through all public syms } _c:=_class; -{$ifdef tp} - p^.publicsyms^.foreach(eachsym); -{$else} - p^.publicsyms^.foreach(@eachsym); -{$endif} + p^.publicsyms^.foreach({$ifdef fpc}@{$endif}eachsym); end; var @@ -562,7 +558,10 @@ implementation end. { $Log$ - Revision 1.7 1999-05-27 19:44:30 peter + Revision 1.8 1999-06-01 14:45:49 peter + * @procvar is now always needed for FPC + + Revision 1.7 1999/05/27 19:44:30 peter * removed oldasm * plabel -> pasmlabel * -a switches to source writing automaticly diff --git a/compiler/pass_2.pas b/compiler/pass_2.pas index b78273d3cd..f02a2bf5eb 100644 --- a/compiler/pass_2.pas +++ b/compiler/pass_2.pas @@ -410,18 +410,10 @@ implementation for i:=1 to maxvarregs do regvars[i]:=nil; parasym:=false; - {$ifdef tp} - symtablestack^.foreach(searchregvars); - {$else} - symtablestack^.foreach(@searchregvars); - {$endif} + symtablestack^.foreach({$ifdef fpc}@{$endif}searchregvars); { copy parameter into a register ? } parasym:=true; - {$ifdef tp} - symtablestack^.next^.foreach(searchregvars); - {$else} - symtablestack^.next^.foreach(@searchregvars); - {$endif} + symtablestack^.next^.foreach({$ifdef fpc}@{$endif}searchregvars); { hold needed registers free } for i:=maxvarregs downto maxvarregs-p^.registers32+1 do regvars[i]:=nil; @@ -547,7 +539,10 @@ implementation end. { $Log$ - Revision 1.23 1999-05-27 19:44:43 peter + Revision 1.24 1999-06-01 14:45:50 peter + * @procvar is now always needed for FPC + + Revision 1.23 1999/05/27 19:44:43 peter * removed oldasm * plabel -> pasmlabel * -a switches to source writing automaticly diff --git a/compiler/pdecl.pas b/compiler/pdecl.pas index f2c15b37eb..b010275086 100644 --- a/compiler/pdecl.pas +++ b/compiler/pdecl.pas @@ -100,11 +100,7 @@ unit pdecl; reaktvarsymtable:=precdef(ptypesym(p)^.definition)^.symtable else reaktvarsymtable:=pobjectdef(ptypesym(p)^.definition)^.publicsyms; - {$ifdef tp} - reaktvarsymtable^.foreach(testforward_type); - {$else} - reaktvarsymtable^.foreach(@testforward_type); - {$endif} + reaktvarsymtable^.foreach({$ifdef fpc}@{$endif}testforward_type); end; end; @@ -2109,11 +2105,7 @@ unit pdecl; parse_var_proc_directives(newtype); until token<>ID; typecanbeforward:=false; - {$ifdef tp} - symtablestack^.foreach(testforward_type); - {$else} - symtablestack^.foreach(@testforward_type); - {$endif} + symtablestack^.foreach({$ifdef fpc}@{$endif}testforward_type); resolve_forwards; block_type:=bt_general; end; @@ -2224,7 +2216,10 @@ unit pdecl; end. { $Log$ - Revision 1.123 1999-05-27 19:44:45 peter + Revision 1.124 1999-06-01 14:45:51 peter + * @procvar is now always needed for FPC + + Revision 1.123 1999/05/27 19:44:45 peter * removed oldasm * plabel -> pasmlabel * -a switches to source writing automaticly diff --git a/compiler/symdef.inc b/compiler/symdef.inc index 69d39eaa2a..3dd315692b 100644 --- a/compiler/symdef.inc +++ b/compiler/symdef.inc @@ -1878,7 +1878,7 @@ { procedure of needs_rtti ! } oldb:=binittable; binittable:=false; - symtable^.foreach(check_rec_inittable); + symtable^.foreach({$ifdef fpc}@{$endif}check_rec_inittable); needs_inittable:=binittable; binittable:=oldb; end; @@ -2037,13 +2037,13 @@ procedure trecdef.write_child_rtti_data; begin - symtable^.foreach(generate_child_rtti); + symtable^.foreach({$ifdef fpc}@{$endif}generate_child_rtti); end; procedure trecdef.write_child_init_data; begin - symtable^.foreach(generate_child_inittable); + symtable^.foreach({$ifdef fpc}@{$endif}generate_child_inittable); end; @@ -2053,9 +2053,9 @@ write_rtti_name; rttilist^.concat(new(pai_const,init_32bit(size))); count:=0; - symtable^.foreach(count_fields); + symtable^.foreach({$ifdef fpc}@{$endif}count_fields); rttilist^.concat(new(pai_const,init_32bit(count))); - symtable^.foreach(write_field_rtti); + symtable^.foreach({$ifdef fpc}@{$endif}write_field_rtti); end; @@ -2065,9 +2065,9 @@ write_rtti_name; rttilist^.concat(new(pai_const,init_32bit(size))); count:=0; - symtable^.foreach(count_inittable_fields); + symtable^.foreach({$ifdef fpc}@{$endif}count_inittable_fields); rttilist^.concat(new(pai_const,init_32bit(count))); - symtable^.foreach(write_field_inittable); + symtable^.foreach({$ifdef fpc}@{$endif}write_field_inittable); end; function trecdef.gettypename : string; @@ -2637,11 +2637,7 @@ Const local_symtable_index : longint = $8001; strpcopy(strend(StabRecString),','+tostr(i)+';'); (* confuse gdb !! PM if assigned(parast) then - {$IfDef TP} - parast^.foreach(addparaname) - {$Else} - parast^.foreach(@addparaname) - {$EndIf} + parast^.foreach({$ifdef fpc}@{$endif}addparaname) else begin param := para1; @@ -3214,22 +3210,14 @@ Const local_symtable_index : longint = $8001; strpcopy(strend(stabrecstring),'!1,020,'+childof^.numberstring+';'); {virtual table to implement yet} RecOffset := 0; - {$ifdef tp} - publicsyms^.foreach(addname); - {$else} - publicsyms^.foreach(@addname); - {$endif} + publicsyms^.foreach({$ifdef fpc}@{$endif}addname); if (options and oo_hasvmt) <> 0 then if not assigned(childof) or ((childof^.options and oo_hasvmt) = 0) then begin strpcopy(strend(stabrecstring),'$vf'+numberstring+':'+typeglobalnumber('vtblarray') +','+tostr(vmt_offset*8)+';'); end; - {$ifdef tp} - publicsyms^.foreach(addprocname); - {$else} - publicsyms^.foreach(@addprocname); - {$endif tp } + publicsyms^.foreach({$ifdef fpc}@{$endif}addprocname); if (options and oo_hasvmt) <> 0 then begin anc := @self; @@ -3266,9 +3254,9 @@ Const local_symtable_index : longint = $8001; rttilist^.concat(new(pai_const,init_32bit(size))); count:=0; - publicsyms^.foreach(count_inittable_fields); + publicsyms^.foreach({$ifdef fpc}@{$endif}count_inittable_fields); rttilist^.concat(new(pai_const,init_32bit(count))); - publicsyms^.foreach(write_field_inittable); + publicsyms^.foreach({$ifdef fpc}@{$endif}write_field_inittable); end; @@ -3282,7 +3270,7 @@ Const local_symtable_index : longint = $8001; { procedure of needs_rtti ! } oldb:=binittable; binittable:=false; - publicsyms^.foreach(check_rec_inittable); + publicsyms^.foreach({$ifdef fpc}@{$endif}check_rec_inittable); needs_inittable:=binittable; binittable:=oldb; end; @@ -3375,7 +3363,7 @@ Const local_symtable_index : longint = $8001; procedure tobjectdef.write_child_rtti_data; begin - publicsyms^.foreach(generate_published_child_rtti); + publicsyms^.foreach({$ifdef fpc}@{$endif}generate_published_child_rtti); end; @@ -3399,7 +3387,7 @@ Const local_symtable_index : longint = $8001; else i:=0; count:=0; - publicsyms^.foreach(count_published_properties); + publicsyms^.foreach({$ifdef fpc}@{$endif}count_published_properties); next_free_name_index:=i+count; end; @@ -3431,7 +3419,7 @@ Const local_symtable_index : longint = $8001; count:=0; { write it } - publicsyms^.foreach(count_published_properties); + publicsyms^.foreach({$ifdef fpc}@{$endif}count_published_properties); rttilist^.concat(new(pai_const,init_16bit(count))); { write unit name } @@ -3445,7 +3433,7 @@ Const local_symtable_index : longint = $8001; { write published properties count } count:=0; - publicsyms^.foreach(count_published_properties); + publicsyms^.foreach({$ifdef fpc}@{$endif}count_published_properties); rttilist^.concat(new(pai_const,init_16bit(count))); { count is used to write nameindex } @@ -3456,7 +3444,7 @@ Const local_symtable_index : longint = $8001; else count:=0; - publicsyms^.foreach(write_property_info); + publicsyms^.foreach({$ifdef fpc}@{$endif}write_property_info); end; @@ -3497,7 +3485,10 @@ Const local_symtable_index : longint = $8001; { $Log$ - Revision 1.124 1999-05-31 16:42:33 peter + Revision 1.125 1999-06-01 14:45:56 peter + * @procvar is now always needed for FPC + + Revision 1.124 1999/05/31 16:42:33 peter * interfacedef flag for procdef if it's defined in the interface, to make a difference with 'forward;' directive forwarddef. Fixes 253 diff --git a/compiler/symtable.pas b/compiler/symtable.pas index da64e29c2d..6833e04d9c 100644 --- a/compiler/symtable.pas +++ b/compiler/symtable.pas @@ -1614,11 +1614,7 @@ const localsymtablestack : psymtable = nil; aktrecordsymtable:=@self; end; current_ppu^.writeentry(ibbeginsymtablebrowser); - {$ifdef tp} - foreach(write_refs); - {$else} - foreach(@write_refs); - {$endif} + foreach({$ifdef fpc}@{$endif}write_refs); current_ppu^.writeentry(ibendsymtablebrowser); if symtabletype in [recordsymtable,objectsymtable, parasymtable,localsymtable] then @@ -1642,11 +1638,7 @@ const localsymtablestack : psymtable = nil; Browserlog.AddLog('---Symtable with no name'); end; Browserlog.Ident; - {$ifdef tp} - foreach(add_to_browserlog); - {$else} - foreach(@add_to_browserlog); - {$endif} + foreach({$ifdef fpc}@{$endif}add_to_browserlog); browserlog.Unident; end; end; @@ -1660,20 +1652,12 @@ const localsymtablestack : psymtable = nil; { checks, if all procsyms and methods are defined } procedure tsymtable.check_forwards; begin - {$ifdef tp} - foreach(check_procsym_forward); - {$else} - foreach(@check_procsym_forward); - {$endif} + foreach({$ifdef fpc}@{$endif}check_procsym_forward); end; procedure tsymtable.checklabels; begin - {$ifdef tp} - foreach(labeldefined); - {$else} - foreach(@labeldefined); - {$endif} + foreach({$ifdef fpc}@{$endif}labeldefined); end; procedure tsymtable.set_alignment(_alignment : byte); @@ -1721,30 +1705,18 @@ const localsymtablestack : psymtable = nil; procedure tsymtable.allunitsused; begin - {$ifdef tp} - foreach(unitsymbolused); - {$else} - foreach(@unitsymbolused); - {$endif} + foreach({$ifdef fpc}@{$endif}unitsymbolused); end; procedure tsymtable.allsymbolsused; begin - {$ifdef tp} - foreach(varsymbolused); - {$else} - foreach(@varsymbolused); - {$endif} + foreach({$ifdef fpc}@{$endif}varsymbolused); end; {$ifdef CHAINPROCSYMS} procedure tsymtable.chainprocsyms; begin - {$ifdef tp} - foreach(chainprocsym); - {$else} - foreach(@chainprocsym); - {$endif} + foreach({$ifdef fpc}@{$endif}chainprocsym); end; {$endif CHAINPROCSYMS} @@ -1752,11 +1724,7 @@ const localsymtablestack : psymtable = nil; procedure tsymtable.concatstabto(asmlist : paasmoutput); begin asmoutput:=asmlist; - {$ifdef tp} - foreach(concatstab); - {$else} - foreach(@concatstab); - {$endif} + foreach({$ifdef fpc}@{$endif}concatstab); end; {$endif} @@ -2004,11 +1972,7 @@ const localsymtablestack : psymtable = nil; dbx_counter := @dbx_count; end; asmoutput:=asmlist; - {$ifdef tp} - foreach(concattypestab); - {$else} - foreach(@concattypestab); - {$endif} + foreach({$ifdef fpc}@{$endif}concattypestab); if cs_gdb_dbx in aktglobalswitches then begin dbx_counter := prev_dbx_count; @@ -2163,11 +2127,7 @@ const localsymtablestack : psymtable = nil; _defaultprop:=nil; while assigned(pd) do begin - {$ifdef tp} - pd^.publicsyms^.foreach(testfordefaultproperty); - {$else} - pd^.publicsyms^.foreach(@testfordefaultproperty); - {$endif} + pd^.publicsyms^.foreach({$ifdef fpc}@{$endif}testfordefaultproperty); if assigned(_defaultprop) then break; pd:=pd^.childof; @@ -2341,7 +2301,10 @@ const localsymtablestack : psymtable = nil; end. { $Log$ - Revision 1.17 1999-05-27 19:45:08 peter + Revision 1.18 1999-06-01 14:45:58 peter + * @procvar is now always needed for FPC + + Revision 1.17 1999/05/27 19:45:08 peter * removed oldasm * plabel -> pasmlabel * -a switches to source writing automaticly diff --git a/compiler/tccal.pas b/compiler/tccal.pas index 73d9d3cd41..a87724ec8b 100644 --- a/compiler/tccal.pas +++ b/compiler/tccal.pas @@ -690,10 +690,11 @@ implementation begin { there is an error, must be wrong type, because wrong size is already checked (PFV) } - if ((parsing_para_level=0) or (p^.left<>nil)) and - (nextprocsym=nil) then + {if ((parsing_para_level=0) or (p^.left<>nil)) and + (nextprocsym=nil) then } + if parsing_para_level=0 then begin - if (not assigned(lastparatype)) and (not assigned(pt^.resulttype)) then + if (not assigned(lastparatype)) or (not assigned(pt^.resulttype)) then internalerror(39393) else CGMessage3(type_e_wrong_parameter_type,tostr(lastpara), @@ -703,13 +704,22 @@ implementation end else begin - { try to convert to procvar } - p^.treetype:=loadn; - p^.resulttype:=pprocsym(p^.symtableprocentry)^.definition; - p^.symtableentry:=p^.symtableprocentry; - p^.is_first:=false; - p^.disposetyp:=dt_nothing; - firstpass(p); + if (m_tp_procvar in aktmodeswitches) then + begin + { try to convert to procvar } + p^.treetype:=loadn; + p^.resulttype:=pprocsym(p^.symtableprocentry)^.definition; + p^.symtableentry:=p^.symtableprocentry; + p^.is_first:=false; + p^.disposetyp:=dt_nothing; + firstpass(p); + end + else + begin + { only return the resulttype, the check for equal will be done + in the para parsing of the previous function } + p^.resulttype:=pprocsym(p^.symtableprocentry)^.definition^.retdef; + end; goto errorexit; end; end; @@ -1162,7 +1172,10 @@ implementation end. { $Log$ - Revision 1.49 1999-05-31 20:34:51 peter + Revision 1.50 1999-06-01 14:46:00 peter + * @procvar is now always needed for FPC + + Revision 1.49 1999/05/31 20:34:51 peter * fixed hightree generation when loading highSYM Revision 1.48 1999/05/27 19:45:13 peter