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

* storenumber works

Browse Source 
* fixed some typos in double_checksum
  + incompatible types type1 and type2 message (with storenumber)
This commit is contained in:
peter 1999-04-21 09:43:28 +00:00
parent ba2b93ebb3
commit cb70b62a82
19 changed files with 581 additions and 397 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
compiler/aasm.pas
View File

@ -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

11
compiler/cg386flw.pas
View File

@ -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

235
compiler/cobjects.pas
View File

@ -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

9
compiler/compiler.pas
View File

@ -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

20
compiler/files.pas
View File

@ -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

37
compiler/hcgdata.pas
View File

@ -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
}

10
compiler/hcodegen.pas
View File

@ -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

2
compiler/msgidx.inc
View File

@ -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,

290
compiler/msgtxt.inc
View File

@ -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] <inputfile> [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<n>_<n> 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<n>_set stack size to <n>'#000+
'**2Ct_stack checking'#000+
'3*2CS_','create static library'#000+
'3*2CS_create static library'#000+
'3*2Cx_use smartlinking'#000+
'**1d<x>_defines the symbol <x>'#000+
'*O1D_generate a DEF file'#000+
'*O2Dd<x>_set description to <x>'#000+
'*O2Dw_PM application'#000+
'**1e<x>_set path to executable'#000+
'**1e<x>_set ','path to executable'#000+
'**1E_same as -Cn'#000+
'**1F_set file names and paths'#000+
'**2FD<x>','_sets the directory where to search for compiler utilities'#000+
'**2FD<x>_sets the directory where to search for compiler utilities'#000+
'**2Fe<x>_redirect error output to <x>'#000+
'**2FE<x>_set exe/unit output path to <x>'#000+
'*L2Fg<x>_same as -Fl'#000+
'**2Fi<x>_adds <x> to include path'#000+
'**2Fi<x','>_adds <x> to include path'#000+
'**2Fl<x>_adds <x> to library path'#000+
'*L2FL<x>_uses',' <x> as dynamic linker'#000+
'*L2FL<x>_uses <x> as dynamic linker'#000+
'**2Fo<x>_adds <x> to object path'#000+
'**2Fr<x>_load error message file <x>'#000+
'**2Fu<x>_adds <x> to unit path'#000+
'**2FU<x>_set unit output path to <x>, overrides -FE'#000+
'**2FU<x>_set unit output path to <x>, 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<x>_adds <x> to include pa','th'#000+
'**1I<x>_adds <x> to include path'#000+
'**1k<x>_Pass <x> to the linker'#000+
'**1l_write logo'#000+
'**1n_don'#039't read the default config file'#000+
'**1o<x>_change the name of the executable produced to <x>'#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<x>_undefines the symbol <x>'#000+
'**1U_unit options'#000+
'**2Un_don'#039't check the unit name'#000+
'**2Up<x>_same as -Fu<x>'#000+
'**2Up<x>_same as -Fu<x>'#000,+
'**2Us_compile a system unit'#000+
'**1v<x>_Be verbose. <x> is a combination of th','e following letters :'#000+
'**1v<x>_Be verbose. <x> 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<x>_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<x>_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<x>_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<x>_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<x>_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<x>_assembler reading style'#000+
'6*2RMOT_read motorola style assembler'#000+
'6*2R','MOT_read motorola style assembler'#000+
'6*1T<x>_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+

27
compiler/pdecl.pas
View File

@ -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

20
compiler/pmodules.pas
View File

@ -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

19
compiler/pstatmnt.pas
View File

@ -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

158
compiler/symdef.inc
View File

@ -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

11
compiler/symdefh.inc
View File

@ -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

29
compiler/symppu.inc
View File

@ -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

22
compiler/symsym.inc
View File

@ -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

19
compiler/symsymh.inc
View File

@ -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

35
compiler/tccal.pas
View File

@ -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

11
compiler/tccnv.pas
View File

@ -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