diff --git a/compiler/aasm.pas b/compiler/aasm.pas index 6563cc1b05..354e752225 100644 --- a/compiler/aasm.pas +++ b/compiler/aasm.pas @@ -83,7 +83,7 @@ unit aasm; TAsmsymtype=(AS_EXTERNAL,AS_LOCAL,AS_GLOBAL); pasmsymbol = ^tasmsymbol; - tasmsymbol = object(tdictionaryobject) + tasmsymbol = object(tnamedindexobject) idx : longint; section : tsection; address, @@ -806,7 +806,7 @@ uses constructor tasmsymbol.init(const s:string); begin; - inherited init(s); + inherited initname(s); reset; end; @@ -880,7 +880,7 @@ uses end; - procedure ResetAsmSym(p:Pdictionaryobject);{$ifndef FPC}far;{$endif} + procedure ResetAsmSym(p:Pnamedindexobject);{$ifndef FPC}far;{$endif} begin pasmsymbol(p)^.reset; end; @@ -1013,7 +1013,12 @@ uses end. { $Log$ - Revision 1.39 1999-04-16 11:49:36 peter + Revision 1.40 1999-04-21 09:43:28 peter + * storenumber works + * fixed some typos in double_checksum + + incompatible types type1 and type2 message (with storenumber) + + Revision 1.39 1999/04/16 11:49:36 peter + tempalloc + -at to show temp alloc info in .s file diff --git a/compiler/cg386flw.pas b/compiler/cg386flw.pas index 7e19c0375c..290a1c430d 100644 --- a/compiler/cg386flw.pas +++ b/compiler/cg386flw.pas @@ -710,7 +710,11 @@ do_jmp: { what a hack ! } if assigned(p^.exceptsymtable) then +{$ifdef STORENUMBER} + pvarsym(p^.exceptsymtable^.symindex^.first)^.address:=ref.offset; +{$else} pvarsym(p^.exceptsymtable^.searchroot)^.address:=ref.offset; +{$endif} exprasmlist^.concat(new(pai386,op_reg_ref(A_MOV,S_L, R_EAX,newreference(ref)))); @@ -798,7 +802,12 @@ do_jmp: end. { $Log$ - Revision 1.32 1999-04-17 13:10:58 peter + Revision 1.33 1999-04-21 09:43:29 peter + * storenumber works + * fixed some typos in double_checksum + + incompatible types type1 and type2 message (with storenumber) + + Revision 1.32 1999/04/17 13:10:58 peter * fixed exit() Revision 1.31 1999/04/14 09:14:46 peter diff --git a/compiler/cobjects.pas b/compiler/cobjects.pas index 033c27841e..204723fd18 100644 --- a/compiler/cobjects.pas +++ b/compiler/cobjects.pas @@ -163,43 +163,47 @@ unit cobjects; end; - Pdictionary=^Tdictionary; - - Pdictionaryobject=^Tdictionaryobject; - Tdictionaryobject=object + Pnamedindexobject=^Tnamedindexobject; + Tnamedindexobject=object + indexnr : longint; _name : Pstring; + next, + left,right : Pnamedindexobject; speedvalue : longint; - left,right : Pdictionaryobject; - owner : Pdictionary; - constructor init(const n:string); + constructor init; + constructor initname(const n:string); destructor done;virtual; - function name:string; + procedure setname(const n:string); + function name:string; end; Pdictionaryhasharray=^Tdictionaryhasharray; - Tdictionaryhasharray=array[0..hasharraysize-1] of Pdictionaryobject; + Tdictionaryhasharray=array[0..hasharraysize-1] of Pnamedindexobject; - Tdictionarycallback = procedure(p:Pdictionaryobject); + Tnamedindexcallback = procedure(p:Pnamedindexobject); + Pdictionary=^Tdictionary; Tdictionary=object noclear : boolean; replace_existing : boolean; - constructor init(usehash:boolean); - procedure clear;virtual; - procedure foreach(proc2call:Tdictionarycallback); - function insert(obj:Pdictionaryobject):Pdictionaryobject;virtual; - function rename(const olds,news : string):pdictionaryobject; - function search(const s:string):Pdictionaryobject; - function speedsearch(const s:string;speedvalue:longint):Pdictionaryobject;virtual; - destructor done;virtual; + constructor init; + destructor done;virtual; + procedure usehash; + procedure clear; + function empty:boolean; + procedure foreach(proc2call:Tnamedindexcallback); + function insert(obj:Pnamedindexobject):Pnamedindexobject; + function rename(const olds,news : string):Pnamedindexobject; + function search(const s:string):Pnamedindexobject; + function speedsearch(const s:string;speedvalue:longint):Pnamedindexobject; private - root : Pdictionaryobject; + root : Pnamedindexobject; hasharray : Pdictionaryhasharray; - function insertnode(newnode:pdictionaryobject;var currnode:pdictionaryobject):pdictionaryobject; - procedure inserttree(currtree,currroot:pdictionaryobject); + procedure cleartree(obj:Pnamedindexobject); + function insertnode(newnode:Pnamedindexobject;var currnode:Pnamedindexobject):Pnamedindexobject; + procedure inserttree(currtree,currroot:Pnamedindexobject); end; - pdynamicarray = ^tdynamicarray; tdynamicarray = object posn, @@ -221,35 +225,25 @@ unit cobjects; procedure readpos(pos:longint;var d;len:longint); end; - pindexobject=^tindexobject; - tindexobject=object - indexnr : longint; - next : pindexobject; - constructor init; - destructor done;virtual; - end; - - tindexcallback=procedure(p:pindexobject); - - tindexobjectarray=array[1..16000] of pindexobject; - pindexobjectarray=^tindexobjectarray; + tindexobjectarray=array[1..16000] of Pnamedindexobject; + Pnamedindexobjectarray=^tindexobjectarray; pindexarray=^tindexarray; tindexarray=object - first : pindexobject; + first : Pnamedindexobject; count : longint; constructor init(Agrowsize:longint); destructor done; - procedure clear1; - procedure foreach(proc2call : tindexcallback); - procedure deleteindex(p:pindexobject); - procedure delete(p:pindexobject); - procedure insert(p:pindexobject); - function search(nr:longint):pindexobject; + procedure clear; + procedure foreach(proc2call : Tnamedindexcallback); + procedure deleteindex(p:Pnamedindexobject); + procedure delete(p:Pnamedindexobject); + procedure insert(p:Pnamedindexobject); + function search(nr:longint):Pnamedindexobject; private growsize, size : longint; - data : pindexobjectarray; + data : Pnamedindexobjectarray; procedure grow(gsize:longint); end; @@ -943,30 +937,56 @@ end; empty:=(first=nil); end; + {**************************************************************************** - Tdictionaryobject + Tnamedindexobject ****************************************************************************} -constructor Tdictionaryobject.init(const n:string); +constructor Tnamedindexobject.init; begin + { index } + indexnr:=-1; + next:=nil; + { dictionary } left:=nil; right:=nil; - _name:=stringdup(n); - speedvalue:=getspeedvalue(n); + _name:=nil; + speedvalue:=-1; end; -destructor Tdictionaryobject.done; +constructor Tnamedindexobject.initname(const n:string); +begin + { index } + indexnr:=-1; + next:=nil; + { dictionary } + left:=nil; + right:=nil; + speedvalue:=-1; + _name:=stringdup(n); +end; + +destructor Tnamedindexobject.done; begin stringdispose(_name); - if assigned(left) then - dispose(left,done); - if assigned(right) then - dispose(right,done); end; -function Tdictionaryobject.name:string; +procedure Tnamedindexobject.setname(const n:string); begin - name:=_name^; + if speedvalue=-1 then + begin + if assigned(_name) then + stringdispose(_name); + _name:=stringdup(n); + end; +end; + +function Tnamedindexobject.name:string; +begin + if assigned(_name) then + name:=_name^ + else + name:=''; end; @@ -974,13 +994,19 @@ end; TDICTIONARY ****************************************************************************} - constructor Tdictionary.init(usehash:boolean); + constructor Tdictionary.init; begin root:=nil; hasharray:=nil; noclear:=false; replace_existing:=false; - if usehash then + end; + + + procedure Tdictionary.usehash; + begin + if not(assigned(root)) and + not(assigned(hasharray)) then begin new(hasharray); fillchar(hasharray^,sizeof(hasharray^),0); @@ -990,31 +1016,57 @@ end; destructor Tdictionary.done; begin - clear; + if not noclear then + clear; if assigned(hasharray) then dispose(hasharray); end; + procedure Tdictionary.cleartree(obj:Pnamedindexobject); + begin + if assigned(obj^.left) then + cleartree(obj^.left); + if assigned(obj^.right) then + cleartree(obj^.right); + dispose(obj,done); + obj:=nil; + end; + + procedure Tdictionary.clear; var w : longint; begin if assigned(root) then - dispose(root,done); + cleartree(root); if assigned(hasharray) then for w:=0 to hasharraysize-1 do if assigned(hasharray^[w]) then - begin - dispose(hasharray^[w],done); - hasharray^[w]:=nil; - end; + cleartree(hasharray^[w]); end; - procedure Tdictionary.foreach(proc2call:Tdictionarycallback); + function Tdictionary.empty:boolean; + var + w : longint; + begin + if assigned(hasharray) then + begin + empty:=false; + for w:=0 to hasharraysize-1 do + if assigned(hasharray^[w]) then + exit; + empty:=true; + end + else + empty:=(root=nil); + end; - procedure a(p:Pdictionaryobject); + + procedure Tdictionary.foreach(proc2call:Tnamedindexcallback); + + procedure a(p:Pnamedindexobject); begin proc2call(p); if assigned(p^.left) then @@ -1038,9 +1090,8 @@ end; end; - function Tdictionary.insert(obj:Pdictionaryobject):Pdictionaryobject; + function Tdictionary.insert(obj:Pnamedindexobject):Pnamedindexobject; begin - obj^.owner:=@self; obj^.speedvalue:=getspeedvalue(obj^._name^); if assigned(hasharray) then insert:=insertnode(obj,hasharray^[obj^.speedvalue mod hasharraysize]) @@ -1049,7 +1100,7 @@ end; end; - function tdictionary.insertnode(newnode:pdictionaryobject;var currnode:pdictionaryobject):pdictionaryobject; + function tdictionary.insertnode(newnode:Pnamedindexobject;var currnode:Pnamedindexobject):Pnamedindexobject; var s1,s2:^string; begin @@ -1103,7 +1154,7 @@ end; end; - procedure tdictionary.inserttree(currtree,currroot:pdictionaryobject); + procedure tdictionary.inserttree(currtree,currroot:Pnamedindexobject); begin if assigned(currtree) then begin @@ -1114,11 +1165,11 @@ end; end; - function tdictionary.rename(const olds,news : string):pdictionaryobject; + function tdictionary.rename(const olds,news : string):Pnamedindexobject; var spdval : longint; lasthp, - hp,hp2,hp3 : pdictionaryobject; + hp,hp2,hp3 : Pnamedindexobject; begin spdval:=getspeedvalue(olds); if assigned(hasharray) then @@ -1194,15 +1245,15 @@ end; end; - function Tdictionary.search(const s:string):Pdictionaryobject; + function Tdictionary.search(const s:string):Pnamedindexobject; begin search:=speedsearch(s,getspeedvalue(s)); end; - function Tdictionary.speedsearch(const s:string;speedvalue:longint):Pdictionaryobject; + function Tdictionary.speedsearch(const s:string;speedvalue:longint):Pnamedindexobject; var - newnode:Pdictionaryobject; + newnode:Pnamedindexobject; begin if assigned(hasharray) then newnode:=hasharray^[speedvalue mod hasharraysize] @@ -1251,7 +1302,7 @@ end; destructor tindexarray.done; begin -{ clear1; } + clear; if assigned(data) then freemem(data,size*4); end; @@ -1354,21 +1405,6 @@ end; end; -{**************************************************************************** - tindexobject - ****************************************************************************} - - constructor tindexobject.init; - begin - indexnr:=-1; - next:=nil; - end; - - destructor tindexobject.done; - begin - end; - - {**************************************************************************** tindexarray ****************************************************************************} @@ -1384,7 +1420,7 @@ end; end; - function tindexarray.search(nr:longint):pindexobject; + function tindexarray.search(nr:longint):Pnamedindexobject; begin if nr<=count then search:=data^[nr] @@ -1393,7 +1429,7 @@ end; end; - procedure tindexarray.clear1; + procedure tindexarray.clear; var i : longint; begin @@ -1407,7 +1443,7 @@ end; end; - procedure tindexarray.foreach(proc2call : tindexcallback); + procedure tindexarray.foreach(proc2call : Tnamedindexcallback); var i : longint; begin @@ -1420,7 +1456,7 @@ end; procedure tindexarray.grow(gsize:longint); var osize : longint; - odata : pindexobjectarray; + odata : Pnamedindexobjectarray; begin osize:=size; odata:=data; @@ -1435,7 +1471,7 @@ end; end; - procedure tindexarray.deleteindex(p:pindexobject); + procedure tindexarray.deleteindex(p:Pnamedindexobject); var i : longint; begin @@ -1458,14 +1494,14 @@ end; end; - procedure tindexarray.delete(p:pindexobject); + procedure tindexarray.delete(p:Pnamedindexobject); begin deleteindex(p); dispose(p,done); end; - procedure tindexarray.insert(p:pindexobject); + procedure tindexarray.insert(p:Pnamedindexobject); var i : longint; begin @@ -1896,7 +1932,12 @@ end; end. { $Log$ - Revision 1.25 1999-04-15 10:01:44 peter + Revision 1.26 1999-04-21 09:43:31 peter + * storenumber works + * fixed some typos in double_checksum + + incompatible types type1 and type2 message (with storenumber) + + Revision 1.25 1999/04/15 10:01:44 peter * small update for storenumber Revision 1.24 1999/04/14 09:14:47 peter @@ -1912,7 +1953,7 @@ end. * assembler inlining working for ag386bin Revision 1.21 1999/03/19 16:35:29 pierre - * Tdictionaryobject done also removed left and right + * Tnamedindexobject done also removed left and right Revision 1.20 1999/03/18 20:30:45 peter + .a writer diff --git a/compiler/compiler.pas b/compiler/compiler.pas index 3ac9900153..44b81bea2a 100644 --- a/compiler/compiler.pas +++ b/compiler/compiler.pas @@ -77,7 +77,7 @@ uses {$ifdef fpc} {$ifdef GO32V2} emu387, - dpmiexcp, +{ dpmiexcp, } {$endif GO32V2} {$ifdef LINUX} catch, @@ -266,7 +266,12 @@ end; end. { $Log$ - Revision 1.19 1999-03-09 11:52:06 pierre + Revision 1.20 1999-04-21 09:43:33 peter + * storenumber works + * fixed some typos in double_checksum + + incompatible types type1 and type2 message (with storenumber) + + Revision 1.19 1999/03/09 11:52:06 pierre * compilation after a failure longjumped directly to end Revision 1.18 1999/02/26 00:48:16 peter diff --git a/compiler/files.pas b/compiler/files.pas index 31cb84fb49..e6dc9ab403 100644 --- a/compiler/files.pas +++ b/compiler/files.pas @@ -202,7 +202,7 @@ unit files; is_stab_written : boolean; u : pmodule; constructor init(_u : pmodule;intface:boolean); - constructor init_to_load(const n:string;c:longint;intface:boolean); + constructor init_to_load(const n:string;c,intfc:longint;intface:boolean); destructor done;virtual; end; @@ -763,6 +763,9 @@ uses Message1(unit_u_ppu_time,filetimestring(ppufiletime)); Message1(unit_u_ppu_flags,tostr(flags)); Message1(unit_u_ppu_crc,tostr(ppufile^.header.checksum)); +{$ifdef Double_checksum} + Message1(unit_u_ppu_crc,tostr(ppufile^.header.interface_checksum)+' (intfc)'); +{$endif} { check the object and assembler file to see if we need only to assemble, only if it's not in a library } do_compile:=false; @@ -1156,7 +1159,7 @@ uses end; - constructor tused_unit.init_to_load(const n:string;c:longint;intface:boolean); + constructor tused_unit.init_to_load(const n:string;c,intfc:longint;intface:boolean); begin u:=nil; in_interface:=intface; @@ -1166,11 +1169,7 @@ uses name:=stringdup(n); checksum:=c; {$ifdef Double_checksum} - if not in_interface then - begin - interface_checksum:=c; - checksum:=0; - end; + interface_checksum:=intfc; {$endif def Double_checksum} unitid:=0; end; @@ -1194,7 +1193,12 @@ uses end. { $Log$ - Revision 1.90 1999-04-14 09:14:48 peter + Revision 1.91 1999-04-21 09:43:36 peter + * storenumber works + * fixed some typos in double_checksum + + incompatible types type1 and type2 message (with storenumber) + + Revision 1.90 1999/04/14 09:14:48 peter * first things to store the symbol/def number in the ppu Revision 1.89 1999/04/07 15:39:29 pierre diff --git a/compiler/hcgdata.pas b/compiler/hcgdata.pas index 07aa1cb5e2..6df5fc27ec 100644 --- a/compiler/hcgdata.pas +++ b/compiler/hcgdata.pas @@ -93,14 +93,14 @@ implementation dispose(p); end; - procedure insertmsgstr(p : psym);{$ifndef FPC}far;{$endif FPC} + procedure insertmsgstr(p : {$ifdef STORENUMBER}pnamedindexobject{$else}psym{$endif});{$ifndef FPC}far;{$endif FPC} var hp : pprocdef; pt : pprocdeftree; begin - if p^.typ=procsym then + if psym(p)^.typ=procsym then begin hp:=pprocsym(p)^.definition; while assigned(hp) do @@ -141,14 +141,14 @@ implementation end; end; - procedure insertmsgint(p : psym);{$ifndef FPC}far;{$endif FPC} + procedure insertmsgint(p : {$ifdef STORENUMBER}pnamedindexobject{$else}psym{$endif});{$ifndef FPC}far;{$endif FPC} var hp : pprocdef; pt : pprocdeftree; begin - if p^.typ=procsym then + if psym(p)^.typ=procsym then begin hp:=pprocsym(p)^.definition; while assigned(hp) do @@ -288,7 +288,7 @@ implementation _c : pobjectdef; has_constructor,has_virtual_method : boolean; - procedure eachsym(sym : psym);{$ifndef FPC}far;{$endif FPC} + procedure eachsym(sym : {$ifdef STORENUMBER}pnamedindexobject{$else}psym{$endif});{$ifndef FPC}far;{$endif FPC} var procdefcoll : pprocdefcoll; @@ -332,7 +332,7 @@ implementation { check, if a method should be overridden } if (hp^.options and pooverridingmethod)<>0 then - Message1(parser_e_nothing_to_be_overridden,_c^.name^+'.'+_name); + Message1(parser_e_nothing_to_be_overridden,_c^.objname^+'.'+_name); { next overloaded method } hp:=hp^.nextoverloaded; end; @@ -340,7 +340,7 @@ implementation begin { put only sub routines into the VMT } - if sym^.typ=procsym then + if psym(sym)^.typ=procsym then begin _name:=sym^.name; symcoll:=wurzel; @@ -377,7 +377,7 @@ implementation { warn only if it is the first time, we hide the method } if _c=hp^._class then - Message1(parser_w_should_use_override,_c^.name^+'.'+_name); + Message1(parser_w_should_use_override,_c^.objname^+'.'+_name); newentry; exit; end @@ -385,10 +385,10 @@ implementation if _c=hp^._class then begin if (procdefcoll^.data^.options and povirtualmethod)<>0 then - Message1(parser_w_overloaded_are_not_both_virtual,_c^.name^+'.'+_name) + Message1(parser_w_overloaded_are_not_both_virtual,_c^.objname^+'.'+_name) else Message1(parser_w_overloaded_are_not_both_non_virtual, - _c^.name^+'.'+_name); + _c^.objname^+'.'+_name); newentry; exit; end; @@ -404,7 +404,7 @@ implementation { warn only if it is the first time, we hide the method } if _c=hp^._class then - Message1(parser_w_should_use_override,_c^.name^+'.'+_name); + Message1(parser_w_should_use_override,_c^.objname^+'.'+_name); newentry; exit; end; @@ -416,14 +416,14 @@ implementation (pobjectdef(procdefcoll^.data^.retdef)^.isclass) and (pobjectdef(hp^.retdef)^.isclass) and (pobjectdef(hp^.retdef)^.isrelated(pobjectdef(procdefcoll^.data^.retdef)))) then - Message1(parser_e_overloaded_methodes_not_same_ret,_c^.name^+'.'+_name); + Message1(parser_e_overloaded_methodes_not_same_ret,_c^.objname^+'.'+_name); { the flags have to match } { except abstract and override } if (procdefcoll^.data^.options and not(poabstractmethod or pooverridingmethod))<> (hp^.options and not(poabstractmethod or pooverridingmethod)) then - Message1(parser_e_header_dont_match_forward,_c^.name^+'.'+_name); + Message1(parser_e_header_dont_match_forward,_c^.objname^+'.'+_name); { now set the number } hp^.extnumber:=procdefcoll^.data^.extnumber; @@ -450,7 +450,7 @@ implementation end; { check, if a method should be overridden } if (hp^.options and pooverridingmethod)<>0 then - Message1(parser_e_nothing_to_be_overridden,_c^.name^+'.'+_name); + Message1(parser_e_nothing_to_be_overridden,_c^.objname^+'.'+_name); end; hp:=hp^.nextoverloaded; end; @@ -496,7 +496,7 @@ implementation do_genvmt(_class); if has_virtual_method and not(has_constructor) then - Message1(parser_w_virtual_without_constructor,_class^.name^); + Message1(parser_w_virtual_without_constructor,_class^.objname^); { generates the VMT } @@ -566,7 +566,12 @@ implementation end. { $Log$ - Revision 1.1 1999-03-24 23:17:00 peter + Revision 1.2 1999-04-21 09:43:37 peter + * storenumber works + * fixed some typos in double_checksum + + incompatible types type1 and type2 message (with storenumber) + + Revision 1.1 1999/03/24 23:17:00 peter * fixed bugs 212,222,225,227,229,231,233 } diff --git a/compiler/hcodegen.pas b/compiler/hcodegen.pas index bdd85a1e3d..d0ef92accd 100644 --- a/compiler/hcodegen.pas +++ b/compiler/hcodegen.pas @@ -279,7 +279,8 @@ implementation importssection:=nil; exportssection:=nil; resourcesection:=nil; - asmsymbollist:=new(pasmsymbollist,init(true)); + asmsymbollist:=new(pasmsymbollist,init); + asmsymbollist^.usehash; end; @@ -320,7 +321,12 @@ end. { $Log$ - Revision 1.28 1999-03-24 23:17:00 peter + Revision 1.29 1999-04-21 09:43:38 peter + * storenumber works + * fixed some typos in double_checksum + + incompatible types type1 and type2 message (with storenumber) + + Revision 1.28 1999/03/24 23:17:00 peter * fixed bugs 212,222,225,227,229,231,233 Revision 1.27 1999/02/25 21:02:37 peter diff --git a/compiler/msgidx.inc b/compiler/msgidx.inc index 0932885f2c..8760760c76 100644 --- a/compiler/msgidx.inc +++ b/compiler/msgidx.inc @@ -195,6 +195,7 @@ type tmsgconst=( parser_e_ill_msg_param, parser_e_duplicate_message_label, type_e_mismatch, + type_e_incompatible_types, type_e_integer_expr_expected, type_e_ordinal_expr_expected, type_e_type_id_expected, @@ -214,6 +215,7 @@ type tmsgconst=( type_w_maybe_wrong_hi_lo, type_e_integer_or_real_expr_expected, type_e_wrong_type_in_array_constructor, + type_e_wrong_parameter_type, sym_e_id_not_found, sym_f_internal_error_in_symtablestack, sym_e_duplicate_id, diff --git a/compiler/msgtxt.inc b/compiler/msgtxt.inc index ce2f5d0d15..4226378701 100644 --- a/compiler/msgtxt.inc +++ b/compiler/msgtxt.inc @@ -203,271 +203,273 @@ const msgtxt : array[0..00101,1..240] of char=( 'E_Message handlers can take only one call by ref. parameter'#000+ 'E_Duplicate message label: %1'#000+ 'E_Type mismatch'#000+ + 'E_Incompatible types $1 and $2'#000,+ 'E_Integer expression expected'#000+ - 'E','_Ordinal expression expected'#000+ + 'E_Ordinal expression expected'#000+ 'E_Type identifier expected'#000+ 'E_Variable identifier expected'#000+ 'E_pointer type expected'#000+ 'E_class type expected'#000+ 'E_Variable or type indentifier expected'#000+ - 'E_Can'#039't evaluate constant expression'#000+ - 'E_Set elements are not compati','ble'#000+ + 'E_Can'#039't evaluate constant expression',#000+ + 'E_Set elements are not compatible'#000+ 'E_Operation not implemented for sets'#000+ 'W_Automatic type conversion from floating type to COMP which is an int'+ 'eger type'#000+ 'H_use DIV instead to get an integer result'#000+ - 'E_string types doesn'#039't match, because of $V+ mode'#000+ - 'E_succ or pred on enums wi','th assignments not possible'#000+ + 'E_string types doesn'#039't match, because of $V+ ','mode'#000+ + 'E_succ or pred on enums with assignments not possible'#000+ 'E_Can'#039't read or write variables of this type'#000+ 'E_Type conflict between set elements'#000+ 'W_lo/hi(longint/dword) returns the upper/lower word'#000+ 'E_Integer or real expression expected'#000+ - 'E_Wrong type in array constructor'#000+ - 'E_Iden','tifier not found $1'#000+ + 'E_Wrong t','ype in array constructor'#000+ + 'E_Incompatible type for arg #$1, $2 and $3'#000+ + 'E_Identifier not found $1'#000+ 'F_Internal Error in SymTableStack()'#000+ 'E_Duplicate identifier $1'#000+ 'E_Unknown identifier $1'#000+ 'E_Forward declaration not solved $1'#000+ - 'F_Identifier type already defined as type'#000+ + 'F_Identifier type alread','y defined as type'#000+ 'E_Error in type definition'#000+ - 'E_Type identifier not defined',#000+ + 'E_Type identifier not defined'#000+ 'E_Forward type not resolved $1'#000+ 'E_Only static variables can be used in static methods or outside metho'+ 'ds'#000+ 'E_Invalid call to tvarsym.mangledname()'#000+ - 'F_record or class type expected'#000+ - 'E_Instances of classes or objects with an abtsract method are n','ot al'+ - 'lowed'#000+ + 'F_record or class typ','e expected'#000+ + 'E_Instances of classes or objects with an abtsract method are not allo'+ + 'wed'#000+ 'W_Label not defined $1'#000+ 'E_Illegal label declaration'#000+ 'E_GOTO und LABEL are not supported (use command line switch -Sg)'#000+ 'E_Label not found'#000+ - 'E_identifier isn'#039't a label'#000+ + 'E_identifier isn'#039't a ','label'#000+ 'E_label already defined'#000+ 'E_illegal type declaration of set elements'#000+ - 'E','_Forward class definition not resolved $1'#000+ + 'E_Forward class definition not resolved $1'#000+ 'H_Parameter not used $1'#000+ 'N_Local variable not used $1'#000+ 'E_Set type expected'#000+ 'W_Function result does not seem to be set'#000+ - 'E_Unknown record field identifier $1'#000+ - 'W_Local variable $1 does not seem to be initia','lized'#000+ + 'E_Unknown',' record field identifier $1'#000+ + 'W_Local variable $1 does not seem to be initialized'#000+ 'E_identifier idents no member $1'#000+ 'B_Found declaration: $1'#000+ 'E_BREAK not allowed'#000+ 'E_CONTINUE not allowed'#000+ 'E_Expression too complicated - FPU stack overflow'#000+ - 'E_Illegal expression'#000+ + 'E_Illegal ','expression'#000+ 'E_Invalid integer'#000+ 'E_Illegal qualifier'#000+ - 'E_High range limit < low ','range limit'#000+ + 'E_High range limit < low range limit'#000+ 'E_Illegal counter variable'#000+ 'E_Can'#039't determine which overloaded function to call'#000+ 'E_Parameter list size exceeds 65535 bytes'#000+ 'E_Illegal type conversion'#000+ - 'E_File types must be var parameters'#000+ - 'E_The use of a far pointer isn'#039't allowed ther','e'#000+ + 'E_File ','types must be var parameters'#000+ + 'E_The use of a far pointer isn'#039't allowed there'#000+ 'E_illegal call by reference parameters'#000+ 'E_EXPORT declared functions can'#039't be called'#000+ 'W_Possible illegal call of constructor or destructor (doesn'#039't matc'+ - 'h to this context)'#000+ + 'h to this conte','xt)'#000+ 'N_Inefficient code'#000+ 'W_unreachable code'#000+ - 'E_procedure call with stackframe',' ESP/SP'#000+ + 'E_procedure call with stackframe ESP/SP'#000+ 'E_Abstract methods can'#039't be called directly'#000+ 'F_Internal Error in getfloatreg(), allocation failure'#000+ 'F_Unknown float type'#000+ 'F_SecondVecn() base defined twice'#000+ - 'F_Extended cg68k not supported'#000+ - 'F_32-bit unsigned not supported in MC68000 mode'#000,+ + 'F_Ext','ended cg68k not supported'#000+ + 'F_32-bit unsigned not supported in MC68000 mode'#000+ 'F_Internal Error in secondinline()'#000+ 'D_Register $1 weight $2 $3'#000+ 'E_Stack limit excedeed in local routine'#000+ 'D_Stack frame is omited'#000+ 'E_Unable to inline object methods'#000+ - 'E_Unable to inline procvar calls'#000+ + 'E_Unab','le to inline procvar calls'#000+ 'E_No code for inline procedure stored'#000+ - 'E_Element',' zero of an ansi/wide- or longstring can'#039't be accessed,'+ - ' use (set)length instead'#000+ + 'E_Element zero of an ansi/wide- or longstring can'#039't be accessed, u'+ + 'se (set)length instead'#000+ 'E_Include or exclude not implemented in this case'#000+ - 'Constructors or destructors can not be called inside with here'#000+ + 'Constructors or destructors can not ','be called inside with here'#000+ 'F_Divide by zero in asm evaluator'#000+ - 'F_Evaluator s','tack overflow'#000+ + 'F_Evaluator stack overflow'#000+ 'F_Evaluator stack underflow'#000+ 'F_Invalid numeric format in asm evaluator'#000+ 'F_Invalid Operator in asm evaluator'#000+ 'F_Unknown error in asm evaluator'#000+ - 'W_Invalid numeric value'#000+ + 'W_Invalid num','eric value'#000+ 'E_escape sequence ignored: $1'#000+ - 'E_Asm syntax error - Prefix not f','ound'#000+ + 'E_Asm syntax error - Prefix not found'#000+ 'E_Asm syntax error - Trying to add more than one prefix'#000+ 'E_Asm syntax error - Opcode not found'#000+ 'E_Invalid symbol reference'#000+ - 'W_Calling an overload function in an asm'#000+ + 'W_Calling an overload function in an asm',#000+ 'E_Constant value out of bounds'#000+ 'E_Non-label pattern contains @'#000+ - 'E_Invalid O','perand: $1'#000+ + 'E_Invalid Operand: $1'#000+ 'W_Override operator not supported'#000+ 'E_Error in binary constant: $1'#000+ 'E_Error in octal constant: $1'#000+ 'E_Error in hexadecimal constant: $1'#000+ - 'E_Error in integer constant: $1'#000+ + 'E_Error in integer const','ant: $1'#000+ 'E_Invalid labeled opcode'#000+ 'F_Internal error in Findtype()'#000+ - 'E_Invalid ','size for MOVSX/MOVZX'#000+ + 'E_Invalid size for MOVSX/MOVZX'#000+ 'E_16-bit base in 32-bit segment'#000+ 'E_16-bit index in 32-bit segment'#000+ 'E_Invalid Opcode'#000+ 'E_Constant reference not allowed'#000+ - 'W_Fwait can cause emulation problems with emu387'#000+ + 'W_Fwait can cause emulation pr','oblems with emu387'#000+ 'E_Invalid combination of opcode and operands'#000+ - 'E_Unsuppor','ted combination of opcode and operands'#000+ + 'E_Unsupported combination of opcode and operands'#000+ 'W_Opcode $1 not in table, operands not checked'#000+ 'F_Internal Error in ConcatOpcode()'#000+ 'E_Invalid size in reference'#000+ - 'E_Invalid middle sized operand'#000+ + 'E_Invalid middle ','sized operand'#000+ 'E_Invalid three operand opcode'#000+ 'E_Assembler syntax error'#000+ - 'E_In','valid operand type'#000+ + 'E_Invalid operand type'#000+ 'E_Segment overrides not supported'#000+ 'E_Invalid constant symbol $1'#000+ 'F_Internal Errror converting binary'#000+ 'F_Internal Errror converting hexadecimal'#000+ - 'F_Internal Errror converting octal'#000+ + 'F_Inter','nal Errror converting octal'#000+ 'E_Invalid constant expression'#000+ - 'E_Unknown identi','fier: $1'#000+ + 'E_Unknown identifier: $1'#000+ 'E_Trying to define an index register more than once'#000+ 'E_Invalid field specifier'#000+ 'F_Internal Error in BuildScaling()'#000+ 'E_Invalid scaling factor'#000+ - 'E_Invalid scaling value'#000+ + 'E_Invalid scaling v','alue'#000+ 'E_Scaling value only allowed with index'#000+ - 'E_Invalid assembler syntax. N','o ref with brackets)'#000+ + 'E_Invalid assembler syntax. No ref with brackets)'#000+ 'E_Expressions of the form [sreg:reg...] are currently not supported'#000+ 'E_Trying to define a segment register twice'#000+ - 'E_Trying to define a base register twice'#000+ + 'E_Trying to define a base registe','r twice'#000+ 'E_Trying to use a negative index register'#000+ - 'E_Asm syntax error - err','or in reference'#000+ + 'E_Asm syntax error - error in reference'#000+ 'E_Local symbols not allowed as references'#000+ 'E_Invalid operand in bracket expression'#000+ 'E_Invalid symbol name: $1'#000+ 'E_Invalid Reference syntax'#000+ - 'E_Invalid string as opcode operand: $1'#000+ + 'E_Invalid strin','g as opcode operand: $1'#000+ 'W_@CODE and @DATA not supported'#000+ - 'E_Null label refer','ences are not allowed'#000+ + 'E_Null label references are not allowed'#000+ 'W_Calling of an overloaded function in direct assembler'#000+ 'E_Cannot use SELF outside a method'#000+ 'E_Asm syntax error - Should start with bracket'#000+ - 'E_Asm syntax error - register: $1'#000+ + 'E_Asm ','syntax error - register: $1'#000+ 'E_SEG and OFFSET not supported'#000+ - 'E_Asm syntax er','ror - in opcode operand'#000+ + 'E_Asm syntax error - in opcode operand'#000+ 'E_Invalid String expression'#000+ 'E_Constant expression out of bounds'#000+ 'F_Internal Error in BuildConstant()'#000+ - 'W_A repeat prefix and a segment override on <= i386 may result in erro'+ - 'rs if an interrupt occurs'#000+ - 'E_Invalid or missing',' opcode'#000+ + 'W_A repeat prefix and a segment override o','n <= i386 may result in er'+ + 'rors if an interrupt occurs'#000+ + 'E_Invalid or missing opcode'#000+ 'E_Invalid combination of prefix and opcode: $1'#000+ 'E_Invalid combination of override and opcode: $1'#000+ 'E_Too many operands on line'#000+ 'E_Duplicate local symbol: $1'#000+ - 'E_Unknown label identifer: $1'#000+ + 'E_Unk','nown label identifer: $1'#000+ 'E_Assemble node syntax error'#000+ - 'E_Undefined local sy','mbol: $1'#000+ + 'E_Undefined local symbol: $1'#000+ 'D_Starting intel styled assembler parsing...'#000+ 'D_Finished intel styled assembler parsing...'#000+ 'E_Not a directive or local symbol: $1'#000+ - 'E_/ at beginning of line not allowed'#000+ + 'E_/ at beginning of line not ','allowed'#000+ 'E_NOR not supported'#000+ 'E_Invalid floating point register name'#000+ - 'W_Modul','o not supported'#000+ + 'W_Modulo not supported'#000+ 'E_Invalid floating point constant: $1'#000+ 'E_Size suffix and destination register do not match'#000+ 'E_Size suffix and destination or source size do not match'#000+ - 'W_Size suffix and destination or source size do not match'#000+ - 'E_Internal error i','n ConcatLabeledInstr()'#000+ + 'W_','Size suffix and destination or source size do not match'#000+ + 'E_Internal error in ConcatLabeledInstr()'#000+ 'W_Floating point binary representation ignored'#000+ 'W_Floating point hexadecimal representation ignored'#000+ - 'W_Floating point octal representation ignored'#000+ + 'W_Floating point octal representation ignore','d'#000+ 'E_Invalid real constant expression'#000+ 'E_Parenthesis are not allowed'#000+ - 'E_Inval','id Reference'#000+ + 'E_Invalid Reference'#000+ 'E_Cannot use __SELF outside a method'#000+ 'E_Cannot use __OLDEBP outside a nested procedure'#000+ 'W_Identifier $1 supposed external'#000+ - 'E_Invalid segment override expression'#000+ + 'E_Invalid segment override expres','sion'#000+ 'E_Strings not allowed as constants'#000+ - 'D_Starting AT&T styled assembler p','arsing...'#000+ + 'D_Starting AT&T styled assembler parsing...'#000+ 'D_Finished AT&T styled assembler parsing...'#000+ 'E_Switching sections is not allowed in an assembler block'#000+ 'E_Invalid global definition'#000+ - 'E_Line separator expected'#000+ + 'E_Line separator expected'#000,+ 'W_globl not supported'#000+ 'W_align not supported'#000+ 'W_lcomm not supported'#000+ - 'W_comm n','ot supported'#000+ + 'W_comm not supported'#000+ 'E_Invalid local common definition'#000+ 'E_Invalid global common definition'#000+ 'E_local symbol: $1 not found inside asm statement'#000+ - 'E_assembler code not returned to text'#000+ + 'E_assembler code not returned to t','ext'#000+ 'F_internal error in BuildReference()'#000+ 'E_invalid opcode size'#000+ - 'W_NEAR igno','red'#000+ + 'W_NEAR ignored'#000+ 'W_FAR ignored'#000+ 'D_Creating inline asm lookup tables'#000+ 'E_Using a defined name as a local label'#000+ 'F_internal error in HandleExtend()'#000+ 'E_Invalid character: <'#000+ - 'E_Invalid character: >'#000+ + 'E_Invalid char','acter: >'#000+ 'E_Unsupported opcode'#000+ - 'E_Increment and Decrement mode not allowed t','ogether'#000+ + 'E_Increment and Decrement mode not allowed together'#000+ 'E_Invalid Register list in movem/fmovem'#000+ 'E_Invalid Register list for opcode'#000+ 'E_68020+ mode required to assemble'#000+ - 'D_Starting Motorola styled assembler parsing...'#000+ + 'D_Starting Motorola styled assembler parsing...'#000,+ 'D_Finished Motorola styled assembler parsing...'#000+ 'W_XDEF not supported'#000+ - 'W_Fun','ctions with void return value can'#039't return any value in asm'+ - ' code'#000+ + 'W_Functions with void return value can'#039't return any value in asm c'+ + 'ode'#000+ 'E_Invalid suffix for intel assembler'#000+ 'E_Extended not supported in this mode'#000+ - 'E_Comp not supported in this mode'#000+ + 'E_Comp not supported in th','is mode'#000+ 'W_You need GNU as version >= 2.81 to compile this MMX code'#000+ - 'F_Too m','any assembler files'#000+ + 'F_Too many assembler files'#000+ 'F_Selected assembler output not supported'#000+ 'E_Unsupported symbol type for operand'#000+ 'E_Cannot index a local var or parameter with a register'#000+ - 'H_$1 translated to $2'#000+ + 'H_$1 trans','lated to $2'#000+ 'W_$1 is associated to an overloaded function'#000+ - 'W_Source operatin','g system redefined'#000+ + 'W_Source operating system redefined'#000+ 'I_Assembling (pipe) $1'#000+ 'E_Can'#039't create assember file $1'#000+ 'W_Assembler $1 not found, switching to external assembling'#000+ 'T_Using assembler: $1'#000+ - 'W_Error while assembling exitcode $1'#000+ - 'W_Can'#039't call the assembler, error $1 switching t','o external assem'+ - 'bling'#000+ + 'W_Error whi','le assembling exitcode $1'#000+ + 'W_Can'#039't call the assembler, error $1 switching to external assembl'+ + 'ing'#000+ 'I_Assembling $1'#000+ 'W_Linker $1 not found, switching to external linking'#000+ 'T_Using linker: $1'#000+ 'W_Object $1 not found, Linking may fail !'#000+ - 'W_Library $1 not found, Linking may fail !'#000+ + 'W_Library $1 n','ot found, Linking may fail !'#000+ 'W_Error while linking'#000+ - 'W_Can'#039't call the linker',', switching to external linking'#000+ + 'W_Can'#039't call the linker, switching to external linking'#000+ 'I_Linking $1'#000+ 'W_binder not found, switching to external binding'#000+ 'W_ar not found, switching to external ar'#000+ - 'E_Dynamic Libraries not supported'#000+ + 'E_Dynamic Libraries not suppor','ted'#000+ 'I_Closing script $1'#000+ - 'W_resource compiler not found, switching to extern','al mode'#000+ + 'W_resource compiler not found, switching to external mode'#000+ 'I_Compiling resource $1'#000+ 'F_Can'#039't post process executable $1'#000+ 'F_Can'#039't open executable $1'#000+ 'X_Size of Code: $1 bytes'#000+ 'X_Size of initialized data: $1 bytes'#000+ - 'X_Size of uninitialized data: $1 bytes'#000+ + 'X_Size of ','uninitialized data: $1 bytes'#000+ 'X_Stack space reserved: $1 bytes'#000+ - 'X_Stack spac','e commited: $1 bytes'#000+ + 'X_Stack space commited: $1 bytes'#000+ 'T_Unitsearch: $1'#000+ 'T_PPU Loading $1'#000+ 'U_PPU Name: $1'#000+ @@ -475,199 +477,199 @@ const msgtxt : array[0..00101,1..240] of char=( 'U_PPU Crc: $1'#000+ 'U_PPU Time: $1'#000+ 'U_PPU File too short'#000+ - 'U_PPU Invalid Header (no PPU at the begin)'#000+ + 'U_PPU Invalid Header (no PPU a','t the begin)'#000+ 'U_PPU Invalid Version $1'#000+ - 'U_PPU is compiled for an other proce','ssor'#000+ + 'U_PPU is compiled for an other processor'#000+ 'U_PPU is compiled for an other target'#000+ 'U_PPU Source: $1'#000+ 'U_Writing $1'#000+ 'F_Can'#039't Write PPU-File'#000+ 'F_reading PPU-File'#000+ 'F_unexpected end of PPU-File'#000+ - 'F_Invalid PPU-File entry: $1'#000+ + 'F_Invalid PPU-File ent','ry: $1'#000+ 'F_PPU Dbx count problem'#000+ 'E_Illegal unit name: $1'#000+ 'F_Too much units'#000+ - 'F_','Circular unit reference between $1 and $2'#000+ + 'F_Circular unit reference between $1 and $2'#000+ 'F_Can'#039't compile unit $1, no sources available'#000+ 'W_Compiling the system unit requires the -Us switch'#000+ - 'F_There were $1 errors compiling module, stopping'#000+ + 'F_There were $1 errors com','piling module, stopping'#000+ 'U_Load from $1 ($2) unit $3'#000+ - 'U_Recompiling $1, chec','ksum changed for $2'#000+ + 'U_Recompiling $1, checksum changed for $2'#000+ 'U_Recompiling $1, source found only'#000+ 'U_Recompiling unit, static lib is older than ppufile'#000+ 'U_Recompiling unit, shared lib is older than ppufile'#000+ - 'U_Recompiling unit, obj and asm are older than ppufile'#000+ - 'U_Recompiling unit, obj',' is older than asm'#000+ + 'U_Re','compiling unit, obj and asm are older than ppufile'#000+ + 'U_Recompiling unit, obj is older than asm'#000+ 'U_Parsing interface of $1'#000+ 'U_Parsing implementation of $1'#000+ 'U_Second load for unit $1'#000+ 'U_PPU Check file $1 time $2'#000+ '$1 [options] [options]'#000+ - 'W_Only one source file supported'#000+ + 'W','_Only one source file supported'#000+ 'W_DEF file can be created only for OS/2'#000+ - 'E_','nested response files are not supported'#000+ + 'E_nested response files are not supported'#000+ 'F_No source file name in command line'#000+ 'E_Illegal parameter: $1'#000+ 'H_-? writes help pages'#000+ 'F_Too many config files nested'#000+ - 'F_Unable to open file $1'#000+ + 'F_Unable t','o open file $1'#000+ 'N_Reading further options from $1'#000+ - 'W_Target is already set t','o: $1'#000+ + 'W_Target is already set to: $1'#000+ 'W_Shared libs not supported on DOS platform, reverting to static'#000+ 'F_too many IF(N)DEFs'#000+ 'F_too many ENDIFs'#000+ 'F_open conditional at the end of the file'#000+ - 'W_Debug information generation is not supported by this executable'#000+ - 'H_Try recompiling wit','h -dGDB'#000+ + 'W_Debug inform','ation generation is not supported by this executable'#000+ + 'H_Try recompiling with -dGDB'#000+ 'W_You are using the obsolete switch $1'#000+ 'Free Pascal Compiler version $FPCVER [$FPCDATE] for $FPCTARGET'#000+ 'Copyright (c) 1993-98 by Florian Klaempfl'#000+ - 'Free Pascal Compiler version $FPCVER'#000+ + 'Free Pascal Co','mpiler version $FPCVER'#000+ #000+ 'Compiler Date : $FPCDATE'#000+ - 'Compiler Target: $FPCTAR','GET'#000+ + 'Compiler Target: $FPCTARGET'#000+ #000+ 'This program comes under the GNU General Public Licence'#000+ 'For more information read COPYING.FPC'#000+ #000+ 'Report bugs,suggestions etc to:'#000+ - ' fpc-devel@vekoll.saturnus.vein.hu'#000+ - '**0*_put + after a boolean switch option to enable it, - ','to disable '+ - 'it'#000+ + ' fpc-devel@vekoll.','saturnus.vein.hu'#000+ + '**0*_put + after a boolean switch option to enable it, - to disable it'+ + #000+ '**1a_the compiler doesn'#039't delete the generated assembler file'#000+ '**2al_list sourcecode lines in assembler file'#000+ '**1b_generate browser info'#000+ - '**2bl_generate local symbol info'#000+ + '**2bl_generate lo','cal symbol info'#000+ '**1B_build all modules'#000+ '**1C_code generation options'#000+ - '3*2CD_','create dynamic library'#000+ + '3*2CD_create dynamic library'#000+ '**2Ch_ bytes heap (between 1023 and 67107840)'#000+ '**2Ci_IO-checking'#000+ '**2Cn_omit linking stage'#000+ '**2Co_check overflow of integer operations'#000+ - '**2Cr_range checking'#000+ + '**2Cr','_range checking'#000+ '**2Cs_set stack size to '#000+ '**2Ct_stack checking'#000+ - '3*2CS_','create static library'#000+ + '3*2CS_create static library'#000+ '3*2Cx_use smartlinking'#000+ '**1d_defines the symbol '#000+ '*O1D_generate a DEF file'#000+ '*O2Dd_set description to '#000+ '*O2Dw_PM application'#000+ - '**1e_set path to executable'#000+ + '**1e_set ','path to executable'#000+ '**1E_same as -Cn'#000+ '**1F_set file names and paths'#000+ - '**2FD','_sets the directory where to search for compiler utilities'#000+ + '**2FD_sets the directory where to search for compiler utilities'#000+ '**2Fe_redirect error output to '#000+ '**2FE_set exe/unit output path to '#000+ '*L2Fg_same as -Fl'#000+ - '**2Fi_adds to include path'#000+ + '**2Fi_adds to include path'#000+ '**2Fl_adds to library path'#000+ - '*L2FL_uses',' as dynamic linker'#000+ + '*L2FL_uses as dynamic linker'#000+ '**2Fo_adds to object path'#000+ '**2Fr_load error message file '#000+ '**2Fu_adds to unit path'#000+ - '**2FU_set unit output path to , overrides -FE'#000+ + '**2FU_set unit output path to , over','rides -FE'#000+ '*g1g_generate debugger information'#000+ '*g2gg_use gsym'#000+ - '*g2gd_use dbx'#000,+ + '*g2gd_use dbx'#000+ '*g2gh_use heap trace unit'#000+ '**1i_information'#000+ '**2iD_return compiler date'#000+ '**2iV_return compiler version'#000+ '**2iSO_return source OS'#000+ '**2iSP_return source processor'#000+ - '**2iTO_return target OS'#000+ + '**2iTO_retu','rn target OS'#000+ '**2iTP_return target processor'#000+ - '**1I_adds to include pa','th'#000+ + '**1I_adds to include path'#000+ '**1k_Pass to the linker'#000+ '**1l_write logo'#000+ '**1n_don'#039't read the default config file'#000+ '**1o_change the name of the executable produced to '#000+ - '**1pg_generate profile code for gprof'#000+ - '*L1P_use pipes instead of creating temporary assembler',' files'#000+ + '**1pg_generate pro','file code for gprof'#000+ + '*L1P_use pipes instead of creating temporary assembler files'#000+ '**1S_syntax options'#000+ '**2S2_switch some Delphi 2 extensions on'#000+ '**2Sc_supports operators like C (*=,+=,/= and -=)'#000+ '**2Sd_tries to be Delphi compatible'#000+ - '**2Se_compiler stops after the first error'#000+ + '**2Se_compil','er stops after the first error'#000+ '**2Sg_allow LABEL and GOTO'#000+ - '**2Sh_Use ansist','rings'#000+ + '**2Sh_Use ansistrings'#000+ '**2Si_support C++ stlyed INLINE'#000+ '**2Sm_support macros like C (global)'#000+ '**2So_tries to be TP/BP 7.0 compatible'#000+ '**2Sp_tries to be gpc compatible'#000+ - '**2Ss_constructor name must be init (destructor must be done)'#000+ - '**2St_allow static keyword in o','bjects'#000+ + '**2Ss_constructor n','ame must be init (destructor must be done)'#000+ + '**2St_allow static keyword in objects'#000+ '**1s_don'#039't call assembler and linker (only with -a)'#000+ '**1u_undefines the symbol '#000+ '**1U_unit options'#000+ '**2Un_don'#039't check the unit name'#000+ - '**2Up_same as -Fu'#000+ + '**2Up_same as -Fu'#000,+ '**2Us_compile a system unit'#000+ - '**1v_Be verbose. is a combination of th','e following letters :'#000+ + '**1v_Be verbose. is a combination of the following letters :'#000+ '**2*_e : Show errors (default) d : Show debug info'#000+ '**2*_w : Show warnings u : Show unit info'#000+ - '**2*_n : Show notes t : Show tried/used files'#000+ - '**2*_h : Show hints m : S','how defined macros'#000+ + '**2*_n : Show notes ',' t : Show tried/used files'#000+ + '**2*_h : Show hints m : Show defined macros'#000+ '**2*_i : Show general info p : Show compiled procedures'#000+ '**2*_l : Show linenumbers c : Show conditionals'#000+ - '**2*_a : Show everything 0 : Show nothing (except errors)'#000+ - '**2*_b : Show all procedur','e r : Rhide/GCC compatibility mod'+ - 'e'#000+ + '**2*_a : Show everythi','ng 0 : Show nothing (except errors'+ + ')'#000+ + '**2*_b : Show all procedure r : Rhide/GCC compatibility mode'#000+ '**2*_ declarations if an error x : Executable info (Win32 only)'#000+ '**2*_ occurs'#000+ '**1X_executable options'#000+ - '*L2Xc_link with the c library'#000+ - '**2XD_link with dynamic libraries (defines FPC_LINK_DYNA','MIC)'#000+ + '*L2Xc_link w','ith the c library'#000+ + '**2XD_link with dynamic libraries (defines FPC_LINK_DYNAMIC)'#000+ '**2Xs_strip all symbols from executable'#000+ '**2XS_link with static libraries (defines FPC_LINK_STATIC)'#000+ '**0*_Processor specific options:'#000+ '3*1A_output format'#000+ - '3*2Ao_coff file using GNU AS'#000+ + '3*2Ao_c','off file using GNU AS'#000+ '3*2Anasmcoff_coff file using Nasm'#000+ - '3*2Anasmelf_elf32 ','(linux) file using Nasm'#000+ + '3*2Anasmelf_elf32 (linux) file using Nasm'#000+ '3*2Anasmobj_obj file using Nasm'#000+ '3*2Amasm_obj using Masm (Mircosoft)'#000+ '3*2Atasm_obj using Tasm (Borland)'#000+ '3*1R_assembler reading style'#000+ - '3*2Ratt_read AT&T style assembler'#000+ + '3*2Ratt_','read AT&T style assembler'#000+ '3*2Rintel_read Intel style assembler'#000+ - '3*2Rdirect_','copy assembler text directly to assembler file'#000+ + '3*2Rdirect_copy assembler text directly to assembler file'#000+ '3*1O_optimizations'#000+ '3*2Og_generate smaller code'#000+ '3*2OG_generate faster code (default)'#000+ - '3*2Or_keep certain variables in registers (still BUGGY!!!)'#000+ - '3*2Ou_enable uncertain optimizations (see docs)',#000+ + '3*2Or_keep certain variables in ','registers (still BUGGY!!!)'#000+ + '3*2Ou_enable uncertain optimizations (see docs)'#000+ '3*2O1_level 1 optimizations (quick optimizations)'#000+ '3*2O2_level 2 optimizations (-O1 + slower optimizations)'#000+ '3*2O3_level 3 optimizations (same as -O2u)'#000+ - '3*2Op_target processor'#000+ + '3*2Op_target pr','ocessor'#000+ '3*3Op1_set target processor to 386/486'#000+ - '3*3Op2_set target processor',' to Pentium/PentiumMMX (tm)'#000+ + '3*3Op2_set target processor to Pentium/PentiumMMX (tm)'#000+ '3*3Op3_set target processor to PPro/PII/c6x86/K6 (tm)'#000+ '3*1T_Target operating system'#000+ '3*2TGO32V1_version 1 of DJ Delorie DOS extender'#000+ - '3*2TGO32V2_version 2 of DJ Delorie DOS extender'#000+ + '3*2T','GO32V2_version 2 of DJ Delorie DOS extender'#000+ '3*2TLINUX_Linux'#000+ - '3*2TOS2_OS/2 2','.x'#000+ + '3*2TOS2_OS/2 2.x'#000+ '3*2TWin32_Windows 32 Bit'#000+ '6*1A_output format'#000+ '6*2Ao_Unix o-file using GNU AS'#000+ '6*2Agas_GNU Motorola assembler'#000+ '6*2Amit_MIT Syntax (old GAS)'#000+ - '6*2Amot_Standard Motorola assembler'#000+ + '6*2Amot_Standard Motorola',' assembler'#000+ '6*1O_optimizations'#000+ '6*2Oa_turn on the optimizer'#000+ - '6*2Og_generate s','maller code'#000+ + '6*2Og_generate smaller code'#000+ '6*2OG_generate faster code (default)'#000+ '6*2Ox_optimize maximum (still BUGGY!!!)'#000+ '6*2O2_set target processor to a MC68020+'#000+ '6*1R_assembler reading style'#000+ - '6*2RMOT_read motorola style assembler'#000+ + '6*2R','MOT_read motorola style assembler'#000+ '6*1T_Target operating system'#000+ - '6*2TAMIG','A_Commodore Amiga'#000+ + '6*2TAMIGA_Commodore Amiga'#000+ '6*2TATARI_Atari ST/STe/TT'#000+ '6*2TMACOS_Macintosh m68k'#000+ '6*2TLINUX_Linux-68k'#000+ diff --git a/compiler/pdecl.pas b/compiler/pdecl.pas index 62fbfa2b89..10359f8256 100644 --- a/compiler/pdecl.pas +++ b/compiler/pdecl.pas @@ -80,22 +80,22 @@ unit pdecl; function read_type(const name : stringid) : pdef;forward; { search in symtablestack used, but not defined type } - procedure testforward_type(p : psym);{$ifndef FPC}far;{$endif} + procedure testforward_type(p : {$ifdef STORENUMBER}pnamedindexobject{$else}psym{$endif});{$ifndef FPC}far;{$endif} var reaktvarsymtable : psymtable; oldaktfilepos : tfileposinfo; begin - if not(p^.typ=typesym) then + if not(psym(p)^.typ=typesym) then exit; - if ((p^.properties and sp_forwarddef)<>0) then + if ((psym(p)^.properties and sp_forwarddef)<>0) then begin oldaktfilepos:=aktfilepos; - aktfilepos:=p^.fileinfo; + aktfilepos:=psym(p)^.fileinfo; Message1(sym_e_forward_type_not_resolved,p^.name); aktfilepos:=oldaktfilepos; { try to recover } ptypesym(p)^.definition:=generrordef; - p^.properties:=p^.properties and (not sp_forwarddef); + psym(p)^.properties:=psym(p)^.properties and (not sp_forwarddef); end else if (ptypesym(p)^.definition^.deftype in [recorddef,objectdef]) then @@ -1047,7 +1047,7 @@ unit pdecl; p2:=search_default_property(aktclass); if assigned(p2) then message1(parser_e_only_one_default_property, - pobjectdef(p2^.owner^.defowner)^.name^) + pobjectdef(p2^.owner^.defowner)^.objname^) else begin p^.options:=p^.options or ppo_defaultproperty; @@ -1215,7 +1215,7 @@ unit pdecl; correct field addresses } if (childof^.options and oo_isforward)<>0 then - Message1(parser_e_forward_declaration_must_be_resolved,childof^.name^); + Message1(parser_e_forward_declaration_must_be_resolved,childof^.objname^); aktclass:=fd; { we must inherit several options !! this was missing !! @@ -1249,7 +1249,7 @@ unit pdecl; correct field addresses } if (childof^.options and oo_isforward)<>0 then - Message1(parser_e_forward_declaration_must_be_resolved,childof^.name^); + Message1(parser_e_forward_declaration_must_be_resolved,childof^.objname^); aktclass:=fd; aktclass^.set_parent(childof); end @@ -1498,8 +1498,8 @@ unit pdecl; { write class name } getlabel(classnamelabel); datasegment^.concat(new(pai_label,init(classnamelabel))); - datasegment^.concat(new(pai_const,init_8bit(length(aktclass^.name^)))); - datasegment^.concat(new(pai_string,init(aktclass^.name^))); + datasegment^.concat(new(pai_const,init_8bit(length(aktclass^.objname^)))); + datasegment^.concat(new(pai_string,init(aktclass^.objname^))); { generate message and dynamic tables } { why generate those if empty ??? } @@ -2222,7 +2222,12 @@ unit pdecl; end. { $Log$ - Revision 1.108 1999-04-17 13:16:19 peter + Revision 1.109 1999-04-21 09:43:45 peter + * storenumber works + * fixed some typos in double_checksum + + incompatible types type1 and type2 message (with storenumber) + + Revision 1.108 1999/04/17 13:16:19 peter * fixes for storenumber Revision 1.107 1999/04/14 09:14:50 peter diff --git a/compiler/pmodules.pas b/compiler/pmodules.pas index fa09549a63..11b3c2055a 100644 --- a/compiler/pmodules.pas +++ b/compiler/pmodules.pas @@ -307,6 +307,7 @@ unit pmodules; begin Message2(unit_u_recompile_crc_change,current_module^.modulename^,pu^.name^); current_module^.do_compile:=true; +{$ifdef STRANGERECOMPILE} { if the checksum was known but has changed then we should also recompile the loaded unit ! } if (pu^.checksum<>0) and (loaded_unit^.sources_avail) then @@ -314,6 +315,7 @@ unit pmodules; Message2(unit_u_recompile_crc_change,loaded_unit^.modulename^,current_module^.modulename^); loaded_unit^.do_compile:=true; end; +{$endif} dispose(current_module^.map); current_module^.map:=nil; exit; @@ -361,6 +363,7 @@ unit pmodules; { checksum change whereas it was already known loade_unit was changed so we need to recompile this unit } begin +{$ifdef STRANGERECOMPILE} {if (loaded_unit^.sources_avail) then begin loaded_unit^.do_compile:=true; @@ -369,7 +372,15 @@ unit pmodules; loaded_unit^.do_compile:=true; if(pu^.interface_checksum<>0) then load_refs:=false; - end; +{$else} +writeln('loaded intfc: ',loaded_unit^.interface_crc,' pu intfc ',pu^.interface_checksum); + Message2(unit_u_recompile_crc_change,current_module^.modulename^,pu^.name^); + current_module^.do_compile:=true; + dispose(current_module^.map); + current_module^.map:=nil; + exit; +{$endif} + end; {$endif def Double_checksum} { setup the map entry for deref } {$ifndef NEWMAP} @@ -1386,7 +1397,12 @@ unit pmodules; end. { $Log$ - Revision 1.110 1999-04-17 13:14:52 peter + Revision 1.111 1999-04-21 09:43:46 peter + * storenumber works + * fixed some typos in double_checksum + + incompatible types type1 and type2 message (with storenumber) + + Revision 1.110 1999/04/17 13:14:52 peter * concat_external added for new init/final Revision 1.109 1999/04/15 12:19:59 peter diff --git a/compiler/pstatmnt.pas b/compiler/pstatmnt.pas index 34d1c58a3c..052523ce82 100644 --- a/compiler/pstatmnt.pas +++ b/compiler/pstatmnt.pas @@ -373,7 +373,11 @@ unit pstatmnt; objectdef : begin obj:=pobjectdef(p^.resulttype); withsymtable:=new(pwithsymtable,init); +{$ifdef STORENUMBER} + withsymtable^.symsearch:=obj^.publicsyms^.symsearch; +{$else} withsymtable^.searchroot:=obj^.publicsyms^.searchroot; +{$endif} withsymtable^.defowner:=obj; symtab:=withsymtable; {$ifndef NODIRECTWITH} @@ -389,7 +393,11 @@ unit pstatmnt; begin symtab^.next:=new(pwithsymtable,init); symtab:=symtab^.next; +{$ifdef STORENUMBER} + symtab^.symsearch:=obj^.publicsyms^.symsearch; +{$else} symtab^.searchroot:=obj^.publicsyms^.searchroot; +{$endif} {$ifndef NODIRECTWITH} if (p^.treetype=loadn) and (p^.symtable=aktprocsym^.definition^.localst) then @@ -408,7 +416,11 @@ unit pstatmnt; symtab:=precdef(p^.resulttype)^.symtable; levelcount:=1; withsymtable:=new(pwithsymtable,init); +{$ifdef STORENUMBER} + withsymtable^.symsearch:=symtab^.symsearch; +{$else} withsymtable^.searchroot:=symtab^.searchroot; +{$endif} withsymtable^.next:=symtablestack; {$ifndef NODIRECTWITH} if (p^.treetype=loadn) and @@ -1271,7 +1283,12 @@ unit pstatmnt; end. { $Log$ - Revision 1.79 1999-04-16 12:14:49 pierre + Revision 1.80 1999-04-21 09:43:48 peter + * storenumber works + * fixed some typos in double_checksum + + incompatible types type1 and type2 message (with storenumber) + + Revision 1.79 1999/04/16 12:14:49 pierre * void pointer accepted with warning in tp and delphi mode Revision 1.78 1999/04/15 12:58:14 pierre diff --git a/compiler/symdef.inc b/compiler/symdef.inc index db672bfe59..a38f13773e 100644 --- a/compiler/symdef.inc +++ b/compiler/symdef.inc @@ -188,7 +188,7 @@ function tdef.typename:string; begin if assigned(sym) then - typename:=sym^.name + typename:=Upper(sym^.name) else typename:='unknown'; end; @@ -315,7 +315,7 @@ function tdef.allstabstring : pchar; var stabchar : string[2]; ss,st : pchar; - name : string; + sname : string; sym_line_no : longint; begin ss := stabstring; @@ -325,15 +325,15 @@ stabchar := 'Tt'; if assigned(sym) then begin - name := sym^.name; + sname := sym^.name; sym_line_no:=sym^.fileinfo.line; end else begin - name := ' '; + sname := ' '; sym_line_no:=0; end; - strpcopy(st,'"'+name+':'+stabchar+numberstring+'='); + strpcopy(st,'"'+sname+':'+stabchar+numberstring+'='); strpcopy(strecopy(strend(st),ss),'",'+tostr(N_LSYM)+',0,'+tostr(sym_line_no)+',0'); allstabstring := strnew(st); freemem(st,strlen(ss)+512); @@ -1636,8 +1636,8 @@ rangenr:=0; end; - function tarraydef.getrangecheckstring : string; + function tarraydef.getrangecheckstring : string; begin if (cs_smartlink in aktmoduleswitches) then getrangecheckstring:='R_'+current_module^.modulename^+tostr(rangenr) @@ -1781,12 +1781,12 @@ var binittable : boolean; - procedure check_rec_inittable(s : psym); + procedure check_rec_inittable(s : {$ifdef STORENUMBER}pnamedindexobject{$else}psym{$endif}); begin - if (s^.typ=varsym) and - ((pvarsym(s)^.definition^.deftype<>objectdef) - or not(pobjectdef(pvarsym(s)^.definition)^.isclass)) then + if (psym(s)^.typ=varsym) and + ((pvarsym(s)^.definition^.deftype<>objectdef) or + not(pobjectdef(pvarsym(s)^.definition)^.isclass)) then binittable:=pvarsym(s)^.definition^.needs_inittable; end; @@ -1809,17 +1809,18 @@ procedure trecdef.deref; var +{$ifndef STORENUMBER} hp : pdef; +{$endif} oldrecsyms : psymtable; begin oldrecsyms:=aktrecordsymtable; aktrecordsymtable:=symtable; { now dereference the definitions } {$ifdef STORENUMBER} - hp:=pdef(symtable^.defindex^.first); + symtable^.deref; {$else} hp:=symtable^.rootdef; -{$endif} while assigned(hp) do begin hp^.deref; @@ -1827,11 +1828,9 @@ hp^.owner:=symtable; hp:=pdef(hp^.next); end; - {$ifdef tp} - symtable^.foreach(derefsym); - {$else} - symtable^.foreach(@derefsym); - {$endif} + + symtable^.foreach({$ifdef fpc}@{$endif}derefsym); +{$endif} aktrecordsymtable:=oldrecsyms; end; @@ -1855,23 +1854,23 @@ StabRecSize : longint = 0; RecOffset : Longint = 0; - procedure addname(p : psym); + procedure addname(p : {$ifdef STORENUMBER}pnamedindexobject{$else}psym{$endif}); var news, newrec : pchar; spec : string[2]; size : longint; begin { static variables from objects are like global objects } - if ((p^.properties and sp_static)<>0) then + if ((psym(p)^.properties and sp_static)<>0) then exit; - if ((p^.properties and sp_protected)<>0) then + if ((psym(p)^.properties and sp_protected)<>0) then spec:='/1' - else if ((p^.properties and sp_private)<>0) then + else if ((psym(p)^.properties and sp_private)<>0) then spec:='/0' else spec:=''; - If p^.typ = varsym then + If psym(p)^.typ = varsym then begin size:=pvarsym(p)^.definition^.size; { open arrays made overflows !! } @@ -1899,7 +1898,9 @@ function trecdef.stabstring : pchar; Var oldrec : pchar; oldsize : longint; +{$ifndef STORENUMBER} cur : psym; +{$endif} begin oldrec := stabrecstring; oldsize:=stabrecsize; @@ -1908,11 +1909,7 @@ strpcopy(stabRecString,'s'+tostr(savesize)); RecOffset := 0; {$ifdef nonextfield} - {$ifdef tp} - symtable^.foreach(addname); - {$else} - symtable^.foreach(@addname); - {$endif} + symtable^.foreach({$ifdef fpc}@{$endif}addname); {$else nonextfield} cur:=symtable^.searchroot; while assigned(cur) do @@ -1942,22 +1939,24 @@ var count : longint; - procedure count_inittable_fields(sym : psym);{$ifndef fpc}far;{$endif} + procedure count_inittable_fields(sym : {$ifdef STORENUMBER}pnamedindexobject{$else}psym{$endif});{$ifndef fpc}far;{$endif} begin - if (sym^.typ=varsym) and (pvarsym(sym)^.definition^.needs_inittable) then + if (psym(sym)^.typ=varsym) and + (pvarsym(sym)^.definition^.needs_inittable) then inc(count); end; - procedure count_fields(sym : psym);{$ifndef fpc}far;{$endif} + procedure count_fields(sym : {$ifdef STORENUMBER}pnamedindexobject{$else}psym{$endif});{$ifndef fpc}far;{$endif} begin inc(count); end; - procedure write_field_inittable(sym : psym);{$ifndef fpc}far;{$endif} + procedure write_field_inittable(sym : {$ifdef STORENUMBER}pnamedindexobject{$else}psym{$endif});{$ifndef fpc}far;{$endif} begin - if (sym^.typ=varsym) and pvarsym(sym)^.definition^.needs_inittable then + if (psym(sym)^.typ=varsym) and + pvarsym(sym)^.definition^.needs_inittable then begin rttilist^.concat(new(pai_const_symbol,init(lab2str(pvarsym(sym)^.definition^.get_inittable_label)))); rttilist^.concat(new(pai_const,init_32bit(pvarsym(sym)^.address))); @@ -1965,22 +1964,23 @@ end; - procedure write_field_rtti(sym : psym);{$ifndef fpc}far;{$endif} + procedure write_field_rtti(sym : {$ifdef STORENUMBER}pnamedindexobject{$else}psym{$endif});{$ifndef fpc}far;{$endif} begin rttilist^.concat(new(pai_const_symbol,init(pvarsym(sym)^.definition^.get_rtti_label))); rttilist^.concat(new(pai_const,init_32bit(pvarsym(sym)^.address))); end; - procedure generate_child_inittable(sym : psym);{$ifndef fpc}far;{$endif} + procedure generate_child_inittable(sym:{$ifdef STORENUMBER}pnamedindexobject{$else}psym{$endif});{$ifndef fpc}far;{$endif} begin - if (sym^.typ=varsym) and pvarsym(sym)^.definition^.needs_inittable then + if (psym(sym)^.typ=varsym) and + pvarsym(sym)^.definition^.needs_inittable then { force inittable generation } pvarsym(sym)^.definition^.get_inittable_label; end; - procedure generate_child_rtti(sym : psym);{$ifndef fpc}far;{$endif} + procedure generate_child_rtti(sym : {$ifdef STORENUMBER}pnamedindexobject{$else}psym{$endif});{$ifndef fpc}far;{$endif} begin pvarsym(sym)^.definition^.get_rtti_label; end; @@ -2658,7 +2658,7 @@ Const local_symtable_index : longint = $8001; s := sym^.name; if _class <> nil then begin - s2 := _class^.name^; + s2 := _class^.objname^; s := s+'__'+tostr(length(s2))+s2; end else s := s + '_'; param := para1; @@ -2834,7 +2834,7 @@ Const local_symtable_index : longint = $8001; {$endif } publicsyms^.defowner:=@self; set_parent(c); - name:=stringdup(n); + objname:=stringdup(n); end; @@ -2877,7 +2877,7 @@ Const local_symtable_index : longint = $8001; deftype:=objectdef; savesize:=readlong; vmt_offset:=readlong; - name:=stringdup(readstring); + objname:=stringdup(readstring); childof:=pobjectdef(readdefref); options:=readlong; oldread_member:=read_member; @@ -2888,12 +2888,12 @@ Const local_symtable_index : longint = $8001; read_member:=oldread_member; publicsyms^.defowner:=@self; { publicsyms^.datasize:=savesize; } - publicsyms^.name := stringdup(name^); + publicsyms^.name := stringdup(objname^); { handles the predefined class tobject } { the last TOBJECT which is loaded gets } { it ! } - if (name^='TOBJECT') and not(cs_compilesystem in aktmoduleswitches) and + if (objname^='TOBJECT') and not(cs_compilesystem in aktmoduleswitches) and isclass and (childof=pointer($ffffffff)) then class_tobject:=@self; has_rtti:=true; @@ -2929,7 +2929,7 @@ Const local_symtable_index : longint = $8001; if (options and oo_isforward)<>0 then begin { ok, in future, the forward can be resolved } - Message1(sym_e_class_forward_not_resolved,name^); + Message1(sym_e_class_forward_not_resolved,objname^); options:=options and not(oo_isforward); end; end; @@ -2945,8 +2945,8 @@ Const local_symtable_index : longint = $8001; if assigned(publicsyms) then dispose(publicsyms,done); if (options and oo_isforward)<>0 then - Message1(sym_e_class_forward_not_resolved,name^); - stringdispose(name); + Message1(sym_e_class_forward_not_resolved,objname^); + stringdispose(objname); tdef.done; end; @@ -2982,18 +2982,19 @@ Const local_symtable_index : longint = $8001; procedure tobjectdef.deref; var +{$ifndef STORENUMBER} hp : pdef; +{$endif} oldrecsyms : psymtable; begin resolvedef(pdef(childof)); oldrecsyms:=aktrecordsymtable; aktrecordsymtable:=publicsyms; - { nun die Definitionen dereferenzieren } + {$ifdef STORENUMBER} - hp:=pdef(publicsyms^.defindex^.first); + publicsyms^.deref; {$else} hp:=publicsyms^.rootdef; -{$endif} while assigned(hp) do begin hp^.deref; @@ -3001,10 +3002,7 @@ Const local_symtable_index : longint = $8001; hp^.owner:=publicsyms; hp:=pdef(hp^.next); end; -{$ifdef tp} - publicsyms^.foreach(derefsym); -{$else} - publicsyms^.foreach(@derefsym); + publicsyms^.foreach({$ifdef fpc}@{$endif}derefsym); {$endif} aktrecordsymtable:=oldrecsyms; end; @@ -3019,15 +3017,15 @@ Const local_symtable_index : longint = $8001; begin if (options and oo_hasvmt)=0 then {internalerror(12346);} - Message1(parser_object_has_no_vmt,name^); + Message1(parser_object_has_no_vmt,objname^); if owner^.name=nil then s1:='' else s1:=owner^.name^; - if name=nil then + if objname=nil then s2:='' else - s2:=name^; + s2:=objname^; vmt_mangledname:='VMT_'+s1+'$_'+s2; end; @@ -3040,10 +3038,10 @@ Const local_symtable_index : longint = $8001; s1:='' else s1:=owner^.name^; - if name=nil then + if objname=nil then s2:='' else - s2:=name^; + s2:=objname^; rtti_name:='RTTI_'+s1+'$_'+s2; end; @@ -3061,7 +3059,7 @@ Const local_symtable_index : longint = $8001; tdef.write; writelong(size); writelong(vmt_offset); - writestring(name^); + writestring(objname^); writedefref(childof); writelong(options); current_ppu^.writeentry(ibobjectdef); @@ -3076,7 +3074,7 @@ Const local_symtable_index : longint = $8001; {$ifdef GDB} - procedure addprocname(p :psym); + procedure addprocname(p :{$ifdef STORENUMBER}pnamedindexobject{$else}psym{$endif}); var virtualind,argnames : string; news, newrec : pchar; pd,ipd : pprocdef; @@ -3086,7 +3084,7 @@ Const local_symtable_index : longint = $8001; sp : char; begin - If p^.typ = procsym then + If psym(p)^.typ = procsym then begin pd := pprocsym(p)^.definition; { this will be used for full implementation of object stabs @@ -3139,8 +3137,8 @@ Const local_symtable_index : longint = $8001; ipd^.is_def_stab_written := true; { here 2A must be changed for private and protected } { 0 is private 1 protected and 2 public } - if (p^.properties and sp_private)<>0 then sp:='0' - else if (p^.properties and sp_protected)<>0 then sp:='1' + if (psym(p)^.properties and sp_private)<>0 then sp:='0' + else if (psym(p)^.properties and sp_protected)<>0 then sp:='1' else sp:='2'; newrec := strpnew(p^.name+'::'+ipd^.numberstring +'=##'+pd^.retdef^.numberstring+';:'+argnames+';'+sp+'A' @@ -3194,7 +3192,7 @@ Const local_symtable_index : longint = $8001; while assigned(cur) do begin addname(cur); - cur:=cur^.nextsym; + cur:=psym(cur)^.nextsym; end; {$endif nonextfield} if (options and oo_hasvmt) <> 0 then @@ -3214,7 +3212,7 @@ Const local_symtable_index : longint = $8001; while assigned(cur) do begin addprocname(cur); - cur:=cur^.nextsym; + cur:=psym(cur)^.nextsym; end; {$endif nonextfield} if (options and oo_hasvmt) <> 0 then @@ -3248,8 +3246,8 @@ Const local_symtable_index : longint = $8001; rttilist^.concat(new(pai_const,init_8bit(tkobject))); { generate the name } - rttilist^.concat(new(pai_const,init_8bit(length(name^)))); - rttilist^.concat(new(pai_string,init(name^))); + rttilist^.concat(new(pai_const,init_8bit(length(objname^)))); + rttilist^.concat(new(pai_string,init(objname^))); rttilist^.concat(new(pai_const,init_32bit(size))); count:=0; @@ -3275,14 +3273,15 @@ Const local_symtable_index : longint = $8001; end; - procedure count_published_properties(sym : psym);{$ifndef fpc}far;{$endif} + procedure count_published_properties(sym:{$ifdef STORENUMBER}pnamedindexobject{$else}psym{$endif}); + {$ifndef fpc}far;{$endif} begin - if (sym^.typ=propertysym) and ((sym^.properties and sp_published)<>0) then + if (psym(sym)^.typ=propertysym) and ((psym(sym)^.properties and sp_published)<>0) then inc(count); end; - procedure write_property_info(sym : psym);{$ifndef fpc}far;{$endif} + procedure write_property_info(sym : {$ifdef STORENUMBER}pnamedindexobject{$else}psym{$endif});{$ifndef fpc}far;{$endif} var proctypesinfo : byte; @@ -3320,11 +3319,13 @@ Const local_symtable_index : longint = $8001; begin - if (ppropertysym(sym)^.options and ppo_indexed)<>0 then + if (psym(sym)^.typ=propertysym) and + ((ppropertysym(sym)^.options and ppo_indexed)<>0) then proctypesinfo:=$40 else proctypesinfo:=0; - if (sym^.typ=propertysym) and ((sym^.properties and sp_published)<>0) then + if (psym(sym)^.typ=propertysym) and + ((psym(sym)^.properties and sp_published)<>0) then begin rttilist^.concat(new(pai_const_symbol,init(ppropertysym(sym)^.proptype^.get_rtti_label))); writeproc(ppropertysym(sym)^.readaccesssym,ppropertysym(sym)^.readaccessdef,0); @@ -3348,9 +3349,11 @@ Const local_symtable_index : longint = $8001; end; - procedure generate_published_child_rtti(sym : psym);{$ifndef fpc}far;{$endif} + procedure generate_published_child_rtti(sym : {$ifdef STORENUMBER}pnamedindexobject{$else}psym{$endif}); + {$ifndef fpc}far;{$endif} begin - if (sym^.typ=propertysym) and ((sym^.properties and sp_published)<>0) then + if (psym(sym)^.typ=propertysym) and + ((psym(sym)^.properties and sp_published)<>0) then ppropertysym(sym)^.proptype^.get_rtti_label; end; @@ -3394,8 +3397,8 @@ Const local_symtable_index : longint = $8001; rttilist^.concat(new(pai_const,init_8bit(tkobject))); { generate the name } - rttilist^.concat(new(pai_const,init_8bit(length(name^)))); - rttilist^.concat(new(pai_string,init(name^))); + rttilist^.concat(new(pai_const,init_8bit(length(objname^)))); + rttilist^.concat(new(pai_string,init(objname^))); { write class type } rttilist^.concat(new(pai_const_symbol,init(vmt_mangledname))); @@ -3473,7 +3476,12 @@ Const local_symtable_index : longint = $8001; { $Log$ - Revision 1.103 1999-04-19 09:28:20 peter + Revision 1.104 1999-04-21 09:43:50 peter + * storenumber works + * fixed some typos in double_checksum + + incompatible types type1 and type2 message (with storenumber) + + Revision 1.103 1999/04/19 09:28:20 peter * fixed crash when writing overload operator to ppu Revision 1.102 1999/04/17 22:01:28 pierre diff --git a/compiler/symdefh.inc b/compiler/symdefh.inc index 2055dcfa3d..387105f22f 100644 --- a/compiler/symdefh.inc +++ b/compiler/symdefh.inc @@ -32,7 +32,7 @@ pdef = ^tdef; {$ifdef STORENUMBER} - tdef = object(tindexobject) + tdef = object(tnamedindexobject) {$else} tdef = object indexnb : longint; @@ -179,7 +179,7 @@ pobjectdef = ^tobjectdef; tobjectdef = object(tdef) childof : pobjectdef; - name : pstring; + objname : pstring; { privatesyms : psymtable; protectedsyms : psymtable; } publicsyms : psymtable; @@ -512,7 +512,12 @@ { $Log$ - Revision 1.20 1999-04-14 09:15:00 peter + Revision 1.21 1999-04-21 09:43:52 peter + * storenumber works + * fixed some typos in double_checksum + + incompatible types type1 and type2 message (with storenumber) + + Revision 1.20 1999/04/14 09:15:00 peter * first things to store the symbol/def number in the ppu Revision 1.19 1999/04/08 15:57:52 peter diff --git a/compiler/symppu.inc b/compiler/symppu.inc index d07ac6e101..ee8ce90905 100644 --- a/compiler/symppu.inc +++ b/compiler/symppu.inc @@ -179,15 +179,11 @@ current_ppu^.do_interface_crc:=hp^.in_interface; {$endif Double_checksum} current_ppu^.putstring(hp^.name^); - current_ppu^.do_crc:=false; -{$ifndef Double_checksum} { the checksum should not affect the crc of this unit ! (PFV) } + current_ppu^.do_crc:=false; current_ppu^.putlongint(hp^.checksum); -{$else Double_checksum} - if hp^.in_interface then - current_ppu^.putlongint(hp^.checksum) - else - current_ppu^.putlongint(hp^.interface_checksum); +{$ifdef Double_checksum} + current_ppu^.putlongint(hp^.interface_checksum); {$endif def Double_checksum} current_ppu^.do_crc:=true; current_ppu^.putbyte(byte(hp^.in_interface)); @@ -265,7 +261,7 @@ current_ppu^.header.size:=current_ppu^.size; current_ppu^.header.checksum:=current_ppu^.crc; {$ifdef Double_checksum} - current_module^.interface_crc:=current_ppu^.interface_crc; + current_ppu^.header.interface_checksum:=current_ppu^.interface_crc; {$endif def Double_checksum} current_ppu^.header.compiler:=wordversion; current_ppu^.header.cpu:=word(target_cpu); @@ -275,7 +271,7 @@ { save crc in current_module also } current_module^.crc:=current_ppu^.crc; {$ifdef Double_checksum} - current_module^.interface_crc:=current_ppu^.interface_crc; + current_module^.interface_crc:=current_ppu^.interface_crc; if only_crc then begin {$ifdef Test_Double_checksum} @@ -476,6 +472,7 @@ procedure readloadunit; var hs : string; + intfchecksum, checksum : longint; in_interface : boolean; begin @@ -483,8 +480,13 @@ begin hs:=current_ppu^.getstring; checksum:=current_ppu^.getlongint; +{$ifdef DOUBLE_CHECKSUM} + intfchecksum:=current_ppu^.getlongint; +{$else} + intfchecksum:=0; +{$endif} in_interface:=(current_ppu^.getbyte<>0); - current_module^.used_units.concat(new(pused_unit,init_to_load(hs,checksum,in_interface))); + current_module^.used_units.concat(new(pused_unit,init_to_load(hs,checksum,intfchecksum,in_interface))); end; end; @@ -516,7 +518,12 @@ { $Log$ - Revision 1.36 1999-04-14 09:15:01 peter + Revision 1.37 1999-04-21 09:43:53 peter + * storenumber works + * fixed some typos in double_checksum + + incompatible types type1 and type2 message (with storenumber) + + Revision 1.36 1999/04/14 09:15:01 peter * first things to store the symbol/def number in the ppu Revision 1.35 1999/04/07 15:39:35 pierre diff --git a/compiler/symsym.inc b/compiler/symsym.inc index 19d234b472..315de31367 100644 --- a/compiler/symsym.inc +++ b/compiler/symsym.inc @@ -161,13 +161,15 @@ destructor tsym.done; begin + if assigned(defref) then + dispose(defref,done); +{$ifdef STORENUMBER} + inherited done; +{$else} {$ifdef tp} if not(use_big) then {$endif tp} strdispose(_name); - if assigned(defref) then - dispose(defref,done); -{$ifndef STORENUMBER} if assigned(left) then dispose(left,done); if assigned(right) then @@ -192,6 +194,7 @@ end; +{$ifndef STORENUMBER} function tsym.name : string; {$ifdef tp} var @@ -215,16 +218,20 @@ else name:=''; end; +{$endif} function tsym.mangledname : string; begin mangledname:=name; end; +{$ifndef STORENUMBER} procedure tsym.setname(const s : string); begin setstring(_name,s); end; +{$endif} + { for most symbol types there is nothing to do at all } procedure tsym.insert_in_data; @@ -433,7 +440,7 @@ oldaktfilepos:=aktfilepos; aktfilepos:=fileinfo; if assigned(pd^._class) then - Message1(sym_e_forward_not_resolved,pd^._class^.name^+'.'+name+demangledparas(pd^.demangled_paras)) + Message1(sym_e_forward_not_resolved,pd^._class^.objname^+'.'+name+demangledparas(pd^.demangled_paras)) else Message1(sym_e_forward_not_resolved,name+pd^.demangled_paras); aktfilepos:=oldaktfilepos; @@ -1936,7 +1943,12 @@ { $Log$ - Revision 1.79 1999-04-17 13:16:21 peter + Revision 1.80 1999-04-21 09:43:54 peter + * storenumber works + * fixed some typos in double_checksum + + incompatible types type1 and type2 message (with storenumber) + + Revision 1.79 1999/04/17 13:16:21 peter * fixes for storenumber Revision 1.78 1999/04/14 09:15:02 peter diff --git a/compiler/symsymh.inc b/compiler/symsymh.inc index 8389d2b2f0..4df23e934a 100644 --- a/compiler/symsymh.inc +++ b/compiler/symsymh.inc @@ -35,18 +35,18 @@ { this object is the base for all symbol objects } psym = ^tsym; {$ifdef STORENUMBER} - tsym = object(tindexobject) + tsym = object(tnamedindexobject) {$else} tsym = object indexnb : longint; -{$endif} - typ : tsymtyp; _name : pchar; left,right : psym; + speedvalue : longint; {$ifndef nonextfield} nextsym : psym; {$endif nextfield} - speedvalue : longint; +{$endif} + typ : tsymtyp; properties : symprop; owner : psymtable; fileinfo : tfileposinfo; @@ -62,9 +62,11 @@ destructor done;virtual; procedure write;virtual; procedure deref;virtual; +{$ifndef STORENUMBER} function name : string; - function mangledname : string;virtual; procedure setname(const s : string); +{$endif} + function mangledname : string;virtual; procedure insert_in_data;virtual; {$ifdef GDB} function stabstring : pchar;virtual; @@ -343,7 +345,12 @@ { $Log$ - Revision 1.19 1999-04-17 13:16:23 peter + Revision 1.20 1999-04-21 09:43:56 peter + * storenumber works + * fixed some typos in double_checksum + + incompatible types type1 and type2 message (with storenumber) + + Revision 1.19 1999/04/17 13:16:23 peter * fixes for storenumber Revision 1.18 1999/04/14 09:15:03 peter diff --git a/compiler/tccal.pas b/compiler/tccal.pas index a40bffd0fd..3fbf47a2bb 100644 --- a/compiler/tccal.pas +++ b/compiler/tccal.pas @@ -318,7 +318,8 @@ implementation def_from,def_to,conv_to : pdef; pt,inlinecode : ptree; exactmatch,inlined : boolean; - paralength,l : longint; + paralength,l,lastpara : longint; + lastparatype : pdef; pdc : pdefcoll; {$ifdef TEST_PROCSYMS} symt : psymtable; @@ -563,10 +564,11 @@ implementation { now we can compare parameter after parameter } pt:=p^.left; { we start with the last parameter } - l:=paralength+1; + lastpara:=paralength+1; + lastparatype:=nil; while assigned(pt) do begin - dec(l); + dec(lastpara); { walk all procedures and determine how this parameter matches and set: 1. pt^.exact_match_found if one parameter has an exact match 2. exactmatch if an equal or exact match is found @@ -640,7 +642,11 @@ implementation procs:=hp; end else - dispose(hp); + begin + { save the type for nice error message } + lastparatype:=hp^.nextpara^.data; + dispose(hp); + end; hp:=hp2; end; end; @@ -651,11 +657,11 @@ implementation hp^.nextpara:=hp^.nextpara^.next; hp:=hp^.next; end; - { load next parameter } + { load next parameter or quit loop if no procs left } if assigned(procs) then pt:=pt^.right else - pt:=nil; + break; end; { All parameters are checked, check if there are any @@ -667,7 +673,15 @@ implementation if ((parsing_para_level=0) or (p^.left<>nil)) and (nextprocsym=nil) then begin - CGMessage1(parser_e_wrong_parameter_type,tostr(l)); +{$ifdef STORENUMBER} + if (not assigned(lastparatype)) and (not assigned(pt^.resulttype)) then + internalerror(39393) + else + CGMessage3(type_e_wrong_parameter_type,tostr(lastpara), + lastparatype^.typename,pt^.resulttype^.typename); +{$else} + CGMessage1(parser_e_wrong_parameter_type,tostr(lastpara)); +{$endif} aktcallprocsym^.write_parameter_lists; goto errorexit; end @@ -1125,7 +1139,12 @@ implementation end. { $Log$ - Revision 1.32 1999-04-14 09:11:22 peter + Revision 1.33 1999-04-21 09:44:00 peter + * storenumber works + * fixed some typos in double_checksum + + incompatible types type1 and type2 message (with storenumber) + + Revision 1.32 1999/04/14 09:11:22 peter * fixed tp proc -> procvar Revision 1.31 1999/04/01 21:59:56 peter diff --git a/compiler/tccnv.pas b/compiler/tccnv.pas index fce4513057..7814b2a5fb 100644 --- a/compiler/tccnv.pas +++ b/compiler/tccnv.pas @@ -839,7 +839,11 @@ implementation CGMessage(cg_e_illegal_type_conversion); end else +{$ifdef STORENUMBER} + CGMessage2(type_e_incompatible_types,p^.resulttype^.typename,p^.left^.resulttype^.typename); +{$else} CGMessage(type_e_mismatch); +{$endif} end end; { ordinal contants can be directly converted } @@ -936,7 +940,12 @@ implementation end. { $Log$ - Revision 1.23 1999-04-15 08:56:24 peter + Revision 1.24 1999-04-21 09:44:01 peter + * storenumber works + * fixed some typos in double_checksum + + incompatible types type1 and type2 message (with storenumber) + + Revision 1.23 1999/04/15 08:56:24 peter * fixed bool-bool conversion Revision 1.22 1999/04/08 09:47:31 pierre