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

* better checks for procvar and methodpointer

Browse Source
This commit is contained in:
peter 1999-06-01 19:27:47 +00:00
parent f711d885f6
commit 94c276ce8d
8 changed files with 338 additions and 291 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

317
compiler/htypechk.pas
View File

@ -135,71 +135,77 @@ implementation
stringdef :
begin
case def_from^.deftype of
stringdef : begin
doconv:=tc_string_2_string;
b:=1;
end;
orddef : begin
{ char to string}
if is_char(def_from) then
begin
doconv:=tc_char_2_string;
b:=1;
end;
end;
arraydef : begin
{ array of char to string, the length check is done by the firstpass of this node }
if is_chararray(def_from) then
begin
doconv:=tc_chararray_2_string;
if (not(cs_ansistrings in aktlocalswitches) and
is_shortstring(def_to)) or
((cs_ansistrings in aktlocalswitches) and
is_ansistring(def_to)) then
b:=1
else
b:=2;
end;
end;
pointerdef : begin
{ pchar can be assigned to short/ansistrings }
if is_pchar(def_from) and not(m_tp in aktmodeswitches) then
begin
doconv:=tc_pchar_2_string;
b:=1;
end;
end;
stringdef :
begin
doconv:=tc_string_2_string;
b:=1;
end;
orddef :
begin
{ char to string}
if is_char(def_from) then
begin
doconv:=tc_char_2_string;
b:=1;
end;
end;
arraydef :
begin
{ array of char to string, the length check is done by the firstpass of this node }
if is_chararray(def_from) then
begin
doconv:=tc_chararray_2_string;
if (not(cs_ansistrings in aktlocalswitches) and
is_shortstring(def_to)) or
((cs_ansistrings in aktlocalswitches) and
is_ansistring(def_to)) then
b:=1
else
b:=2;
end;
end;
pointerdef :
begin
{ pchar can be assigned to short/ansistrings }
if is_pchar(def_from) and not(m_tp in aktmodeswitches) then
begin
doconv:=tc_pchar_2_string;
b:=1;
end;
end;
end;
end;
floatdef :
begin
case def_from^.deftype of
orddef : begin { ordinal to real }
if is_integer(def_from) then
begin
if pfloatdef(def_to)^.typ=f32bit then
doconv:=tc_int_2_fix
else
doconv:=tc_int_2_real;
b:=1;
end;
end;
floatdef : begin { 2 float types ? }
if pfloatdef(def_from)^.typ=pfloatdef(def_to)^.typ then
doconv:=tc_equal
else
begin
if pfloatdef(def_from)^.typ=f32bit then
doconv:=tc_fix_2_real
else
if pfloatdef(def_to)^.typ=f32bit then
doconv:=tc_real_2_fix
else
doconv:=tc_real_2_real;
end;
b:=1;
end;
orddef :
begin { ordinal to real }
if is_integer(def_from) then
begin
if pfloatdef(def_to)^.typ=f32bit then
doconv:=tc_int_2_fix
else
doconv:=tc_int_2_real;
b:=1;
end;
end;
floatdef :
begin { 2 float types ? }
if pfloatdef(def_from)^.typ=pfloatdef(def_to)^.typ then
doconv:=tc_equal
else
begin
if pfloatdef(def_from)^.typ=f32bit then
doconv:=tc_fix_2_real
else
if pfloatdef(def_to)^.typ=f32bit then
doconv:=tc_real_2_fix
else
doconv:=tc_real_2_real;
end;
b:=1;
end;
end;
end;
@ -232,23 +238,25 @@ implementation
else
begin
case def_from^.deftype of
pointerdef : begin
if is_zero_based_array(def_to) and
is_equal(ppointerdef(def_from)^.definition,parraydef(def_to)^.definition) then
begin
doconv:=tc_pointer_2_array;
b:=1;
end;
end;
stringdef : begin
{ string to array of char}
if (not(is_special_array(def_to)) or is_open_array(def_to)) and
is_equal(parraydef(def_to)^.definition,cchardef) then
begin
doconv:=tc_string_2_chararray;
b:=1;
end;
end;
pointerdef :
begin
if is_zero_based_array(def_to) and
is_equal(ppointerdef(def_from)^.definition,parraydef(def_to)^.definition) then
begin
doconv:=tc_pointer_2_array;
b:=1;
end;
end;
stringdef :
begin
{ string to array of char}
if (not(is_special_array(def_to)) or is_open_array(def_to)) and
is_equal(parraydef(def_to)^.definition,cchardef) then
begin
doconv:=tc_string_2_chararray;
b:=1;
end;
end;
end;
end;
end;
@ -256,77 +264,83 @@ implementation
pointerdef :
begin
case def_from^.deftype of
stringdef : begin
{ string constant to zero terminated string constant }
if (fromtreetype=stringconstn) and
is_pchar(def_to) then
begin
doconv:=tc_cstring_2_pchar;
b:=1;
end;
end;
orddef : begin
{ char constant to zero terminated string constant }
if (fromtreetype=ordconstn) and is_equal(def_from,cchardef) and
is_pchar(def_to) then
begin
doconv:=tc_cchar_2_pchar;
b:=1;
end;
end;
arraydef : begin
{ chararray to pointer }
if is_zero_based_array(def_from) and
is_equal(parraydef(def_from)^.definition,ppointerdef(def_to)^.definition) then
begin
doconv:=tc_array_2_pointer;
b:=1;
end;
end;
pointerdef : begin
{ child class pointer can be assigned to anchestor pointers }
if (
(ppointerdef(def_from)^.definition^.deftype=objectdef) and
(ppointerdef(def_to)^.definition^.deftype=objectdef) and
pobjectdef(ppointerdef(def_from)^.definition)^.isrelated(
pobjectdef(ppointerdef(def_to)^.definition))
) or
{ all pointers can be assigned to void-pointer }
is_equal(ppointerdef(def_to)^.definition,voiddef) or
{ in my opnion, is this not clean pascal }
{ well, but it's handy to use, it isn't ? (FK) }
is_equal(ppointerdef(def_from)^.definition,voiddef) then
begin
doconv:=tc_equal;
b:=1;
end;
end;
procvardef : begin
{ procedure variable can be assigned to an void pointer }
{ Not anymore. Use the @ operator now.}
if not(m_tp_procvar in aktmodeswitches) and
(ppointerdef(def_to)^.definition^.deftype=orddef) and
(porddef(ppointerdef(def_to)^.definition)^.typ=uvoid) then
begin
doconv:=tc_equal;
b:=1;
end;
end;
classrefdef,
objectdef : begin
{ class types and class reference type
can be assigned to void pointers }
if (
((def_from^.deftype=objectdef) and pobjectdef(def_from)^.isclass) or
(def_from^.deftype=classrefdef)
) and
(ppointerdef(def_to)^.definition^.deftype=orddef) and
(porddef(ppointerdef(def_to)^.definition)^.typ=uvoid) then
begin
doconv:=tc_equal;
b:=1;
end;
end;
stringdef :
begin
{ string constant to zero terminated string constant }
if (fromtreetype=stringconstn) and
is_pchar(def_to) then
begin
doconv:=tc_cstring_2_pchar;
b:=1;
end;
end;
orddef :
begin
{ char constant to zero terminated string constant }
if (fromtreetype=ordconstn) and is_equal(def_from,cchardef) and
is_pchar(def_to) then
begin
doconv:=tc_cchar_2_pchar;
b:=1;
end;
end;
arraydef :
begin
{ chararray to pointer }
if is_zero_based_array(def_from) and
is_equal(parraydef(def_from)^.definition,ppointerdef(def_to)^.definition) then
begin
doconv:=tc_array_2_pointer;
b:=1;
end;
end;
pointerdef :
begin
{ child class pointer can be assigned to anchestor pointers }
if (
(ppointerdef(def_from)^.definition^.deftype=objectdef) and
(ppointerdef(def_to)^.definition^.deftype=objectdef) and
pobjectdef(ppointerdef(def_from)^.definition)^.isrelated(
pobjectdef(ppointerdef(def_to)^.definition))
) or
{ all pointers can be assigned to void-pointer }
is_equal(ppointerdef(def_to)^.definition,voiddef) or
{ in my opnion, is this not clean pascal }
{ well, but it's handy to use, it isn't ? (FK) }
is_equal(ppointerdef(def_from)^.definition,voiddef) then
begin
doconv:=tc_equal;
b:=1;
end;
end;
procvardef :
begin
{ procedure variable can be assigned to an void pointer }
{ Not anymore. Use the @ operator now.}
if not(m_tp_procvar in aktmodeswitches) and
(ppointerdef(def_to)^.definition^.deftype=orddef) and
(porddef(ppointerdef(def_to)^.definition)^.typ=uvoid) then
begin
doconv:=tc_equal;
b:=1;
end;
end;
classrefdef,
objectdef :
begin
{ class types and class reference type
can be assigned to void pointers }
if (
((def_from^.deftype=objectdef) and pobjectdef(def_from)^.isclass) or
(def_from^.deftype=classrefdef)
) and
(ppointerdef(def_to)^.definition^.deftype=orddef) and
(porddef(ppointerdef(def_to)^.definition)^.typ=uvoid) then
begin
doconv:=tc_equal;
b:=1;
end;
end;
end;
end;
@ -345,11 +359,9 @@ implementation
{ proc -> procvar }
if (def_from^.deftype=procdef) then
begin
def_from^.deftype:=procvardef;
doconv:=tc_proc_2_procvar;
if is_equal(def_from,def_to) then
if proc_to_procvar_equal(pprocdef(def_from),pprocvardef(def_to)) then
b:=1;
def_from^.deftype:=procdef;
end
else
{ for example delphi allows the assignement from pointers }
@ -649,7 +661,10 @@ implementation
end.
{
$Log$
Revision 1.26 1999-05-20 14:58:26 peter
Revision 1.27 1999-06-01 19:27:47 peter
* better checks for procvar and methodpointer
Revision 1.26 1999/05/20 14:58:26 peter
* fixed arrayconstruct->set conversion which didn't work for enum sets
Revision 1.25 1999/05/19 20:40:12 florian

1
compiler/msgidx.inc
View File

@ -223,6 +223,7 @@ type tmsgconst=(
type_e_integer_or_real_expr_expected,
type_e_wrong_type_in_array_constructor,
type_e_wrong_parameter_type,
type_e_no_method_and_procedure_not_compatible,
sym_e_id_not_found,
sym_f_internal_error_in_symtablestack,
sym_e_duplicate_id,

239
compiler/msgtxt.inc
View File

@ -237,194 +237,195 @@ const msgtxt : array[0..000095,1..240] of char=(
'E_Integer or real expression expected'#000+
'E_Wrong type in array constructor'#000+
'E_Incompatible type for arg #$1: Got $2, expected $3'#000+
'E_Method (variable) and Procedure (variable) are not compatible'#000+
'E_Identifier not found $1'#000+
'F_Internal Error in SymTableStack()'#000+
'F_','Internal Error in SymTableStack()'#000+
'E_Duplicate identifier $1'#000+
'H_Id','entifier already defined in $1 at line $2'#000+
'H_Identifier already defined in $1 at line $2'#000+
'E_Unknown identifier $1'#000+
'E_Forward declaration not solved $1'#000+
'F_Identifier type already defined as type'#000+
'E_Error in type definition'#000+
'E_Type identifier not defined'#000+
'E_Typ','e identifier not defined'#000+
'E_Forward type not resolved $1'#000+
'E_Only s','tatic variables can be used in static methods or outside met'+
'hods'#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 abstract method are not allo'+
'wed'#000+
'E_Instances of classes or objects with ','an abstract method are not al'+
'lowed'#000+
'W_Label not defined $1'#000+
'E_Ille','gal label declaration'#000+
'E_Illegal label declaration'#000+
'E_GOTO und LABEL are not supported (use switch -Sg)'#000+
'E_Label not found'#000+
'E_identifier isn'#039't a label'#000+
'E_label already defined'#000+
'E_illegal type declaration of set elements'#000+
'E_illegal type declaration of set',' elements'#000+
'E_Forward class definition not resolved $1'#000+
'H_Parameter',' not used $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 initialized'#000+
'W_Local variable $1 does not seem t','o be initialized'#000+
'W_Variable $1 does not seem to be initialized'#000+
'E','_identifier idents no member $1'#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_Invalid integer expression'#000+
'E_Inva','lid integer expression'#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 ','there'#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+
'N_Inefficient code'#000+
'N_','Inefficient code'#000+
'W_unreachable code'#000+
'E_procedure call with stackf','rame 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 m','ode'#000+
'F_Extended ','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 omitted'#000+
'E_Object or class methods can'#039't be inline.'#000+
'E_Procvar calls can'#039't be inline.'#000+
'E_No code for inline procedure st','ored'#000+
'E_','Procvar calls can'#039't be inline.'#000+
'E_No code for inline procedure stored'#000+
'E_Element zero of an ansi/wide- or longstring can'#039't be accessed, u'+
'se (set)length instead'#000+
'E_Include and exclude not implemented in this case'#000+
'W_Probably illegal constant passed to internal math function'#000+
'E_Constructors or destructors can ','not be called inside a '#039'with'#039+
'W_Probably illegal constant pas','sed to internal math function'#000+
'E_Constructors or destructors can not be called inside a '#039'with'#039+
' clause'#000+
'E_Cannot call message handler method directly'#000+
'D_Starting $1 styled assembler parsing'#000+
'D_Finished $1 styled assembler parsing'#000+
'E_Non-label pattern contains @'#000+
'E_Non-label pat','tern contains @'#000+
'W_Override operator not supported'#000+
'E_Error buildi','ng record offset'#000+
'E_Error building record offset'#000+
'E_OFFSET used without identifier'#000+
'E_Cannot use local variable or parameters here'#000+
'E_need to use OFFSET here'#000+
'E_Cannot use multiple relocatable symbols'#000+
'E_Relocatable symbol can only be added'#000+
'E_Relocatab','le symbol can only be added'#000+
'E_Invalid constant expression'#000+
'E_Relo','catable symbol is not allowed'#000+
'E_Relocatable symbol is not allowed'#000+
'E_Invalid reference syntax'#000+
'E_Local symbols not allowed as references'#000+
'E_Invalid base and index register usage'#000+
'E_Wrong scale factor specified'#000+
'E_Multiple index register usage'#000+
'E_Mult','iple index register usage'#000+
'E_Invalid operand type'#000+
'E_Invalid strin','g as opcode operand: $1'#000+
'E_Invalid string as opcode operand: $1'#000+
'W_@CODE and @DATA not supported'#000+
'E_Null label references are not allowed'#000+
'F_Divide by zero in asm evaluator'#000+
'F_Evaluator stack overflow'#000+
'F_Evaluator stack underflow'#000+
'F_Evaluator stack u','nderflow'#000+
'F_Invalid numeric format in asm evaluator'#000+
'F_Invalid Ope','rator in asm evaluator'#000+
'F_Invalid Operator in asm evaluator'#000+
'E_escape sequence ignored: $1'#000+
'E_Invalid symbol reference'#000+
'W_Fwait can cause emulation problems with emu387'#000+
'W_Calling an overload function in assembler'#000+
'E_Unsupported symbol type for operand'#000+
'E_Constant value out of bound','s'#000+
'E_U','nsupported symbol type for operand'#000+
'E_Constant value out of bounds'#000+
'E_Error converting decimal $1'#000+
'E_Error converting octal $1'#000+
'E_Error converting binary $1'#000+
'E_Error converting hexadecimal $1'#000+
'H_$1 translated to $2'#000+
'W_$1 is associated to an overloaded function'#000+
'W_$1 is associated to an overlo','aded function'#000+
'E_Cannot use SELF outside a method'#000+
'E_Cannot use OL','DEBP outside a nested procedure'#000+
'E_Cannot use OLDEBP outside a nested procedure'#000+
'W_Functions with void return value can'#039't return any value in asm c'+
'ode'#000+
'E_SEG not supported'#000+
'E_Size suffix and destination or source size do not match'#000+
'E_Size suffix and destination or source size do not ma','tch'#000+
'W_Size suffix and destination or source size do not match'#000+
'E_','Assembler syntax error'#000+
'E_Assembler syntax error'#000+
'E_Invalid combination of opcode and operands'#000+
'E_Assemler syntax error in operand'#000+
'E_Assemler syntax error in constant'#000+
'E_Invalid String expression'#000+
'32bit constant created for address'#000+
'32bit con','stant created for address'#000+
'E_Invalid or missing opcode'#000+
'E_Invalid ','combination of prefix and opcode: $1'#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+
'W_NEAR ignored'#000+
'W_FAR ignored'#000+
'E_Duplicate local symbol $1'#000+
'E_Undefined local symbol $1'#000+
'E_Und','efined local symbol $1'#000+
'E_Unknown label identifier $1'#000+
'E_Invalid f','loating point register name'#000+
'E_Invalid floating point register name'#000+
'E_NOR not supported'#000+
'W_Modulo not supported'#000+
'E_Invalid floating point constant $1'#000+
'E_Invalid floating point expression'#000+
'E_Wrong symbol type'#000+
'E_Cannot index a local var or parameter with a register'#000+
'E_Invalid segment ov','erride expression'#000+
'E_Cannot ind','ex a local var or parameter with a register'#000+
'E_Invalid segment override expression'#000+
'W_Identifier $1 supposed external'#000+
'E_Strings not allowed as constants'#000+
'No type of variable specified'#000+
'E_assembler code not returned to text section'#000+
'E_Not a directive or local symbol $1'#000+
'E_Using a defined name as a local label'#000,
'E_Not a direc','tive or local symbol $1'#000+
'E_Using a defined name as a local label'#000+
'F_Too many assembler files'#000+
'F_Selected assembler output not supported'#000+
'F_Comp not supported'#000+
'F_Direct not support for binary writers'#000+
'E_Allocating of data is only allowed in bss section'#000+
'E_Allocating of data is only allowed in bss se','ction'#000+
'F_No binary writer selected'#000+
'E_Asm: Opcode $1 not in table'#000,
'E_Asm: Opcode $1 not in table'#000+
'E_Asm: $1 invalid combination of opcode and operands'#000+
'E_Asm: 16 Bit references not supported'#000+
'E_Asm: Invalid effective address'#000+
'E_Asm: Immediate or reference expected'#000+
'E_Asm: $1 value exceeds bounds $2'#000+
'E_Asm: $1 va','lue exceeds bounds $2'#000+
'E_Asm: Short jump is out of range $1'#000+
'W_Sou','rce operating 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 to external assem'+
'bling'#000+
'W_Error w','hile 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',' not found, Linking may fail !'#000+
'W_Error while linking'#000+
'W_Can'#039't cal','l 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 supp','orted'#000+
'I_Closing script $1'#000+
'W_resource compiler not found, switchi','ng to external 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_Stack space reserved: $1 bytes'#000,
'X_Size o','f uninitialized data: $1 bytes'#000+
'X_Stack space reserved: $1 bytes'#000+
'X_Stack space commited: $1 bytes'#000+
'T_Unitsearch: $1'#000+
'T_PPU Loading $1'#000+
@ -433,201 +434,201 @@ const msgtxt : array[0..000095,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',' at the begin)'#000+
'U_PPU Invalid Version $1'#000+
'U_PPU is compiled for an',' other processor'#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 e','ntry: $1'#000+
'F_PPU Dbx count problem'#000+
'E_Illegal unit name: $1'#000+
'F_Too m','uch units'#000+
'F_Too much units'#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 c','ompiling module, stopping'#000+
'U_Load from $1 ($2) unit $3'#000+
'U_Recompil','ing $1, checksum 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_Recompili','ng unit, obj is older than asm'#000+
'U_','Recompiling 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+
'$1 [options] <inputfile> [options]',#000+
'W_Only one source file supported'#000+
'W_DEF file can be created only',' for OS/2'#000+
'W_DEF file can be created only for OS/2'#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',' to open file $1'#000+
'N_Reading further options from $1'#000+
'W_Target is a','lready set to: $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 rec','ompiling with -dGDB'#000+
'W_Debug info','rmation generation is not supported by this executable'#000+
'H_Try recompiling with -dGDB'#000+
'E_You are using the obsolete switch $1'#000+
'E_You are using the obsolete switch $1, please use $2'#000+
'N_Switching assembler to default source writing assembler'#000+
'Free Pascal Compiler version $FPCVER [$FPCDATE] for $FPCTARGET'#000+
'Copyri','ght (c) 1993-98 by Florian Klaempfl'#000+
'Free ','Pascal Compiler version $FPCVER [$FPCDATE] for $FPCTARGET'#000+
'Copyright (c) 1993-98 by Florian Klaempfl'#000+
'Free Pascal Compiler version $FPCVER'#000+
#000+
'Compiler Date : $FPCDATE'#000+
'Compiler Target: $FPCTARGET'#000+
#000+
'This program comes under the GNU General Public Licence'#000+
'This program comes under the GNU General Public',' Licence'#000+
'For more information read COPYING.FPC'#000+
#000+
'Report bugs,sugg','estions etc to:'#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+
'**1a_the compiler doesn'#039't delete the generated assembler file'#000+
'**2al_list sourcecode lines in assembler',' file'#000+
'**1a_the compiler doesn'#039't delete the g','enerated assembler file'#000+
'**2al_list sourcecode lines in assembler file'#000+
'**2ar_list register allocation/release info in assembler file'#000+
'**2at_list temp allocation/release info in assembler file'#000+
'**1b_generate browser info'#000+
'**2bl_generate local symbol info'#000+
'**2bl_generate local sy','mbol info'#000+
'**1B_build all modules'#000+
'**1C<x>_code generation options',':'#000+
'**1C<x>_code generation options:'#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_r','ange checking'#000+
'**2Cs<n>_set stack size to <n>'#000+
'**2Ct_stack checkin','g'#000+
'**2Ct_stack checking'#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 pa','th to executable'#000+
'**1E_same as -Cn'#000+
'**1F<x>_set file names and pat','hs:'#000+
'**1F<x>_set file names and paths:'#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+
'**2Fi<x>_adds <x> to include path'#000+
'**2Fi<x>_adds <x> to inclu','de path'#000+
'**2Fl<x>_adds <x> to library path'#000+
'*L2FL<x>_uses <x> as d','ynamic 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+
'*g1g<x>_generate debugger information:'#000+
'*g1g<x>_g','enerate debugger information:'#000+
'*g2gg_use gsym'#000+
'*g2gd_use dbx'#000+
'*g2gh','_use heap trace unit'#000+
'*g2gh_use heap trace unit'#000+
'**1i_information'#000+
'**2iD_return compiler date'#000+
'**2iV_return compiler version'#000+
'**2iSO_return compiler OS'#000+
'**2iSP_return compiler processor'#000+
'**2iTO_return target OS'#000+
'**2iTO_return target O','S'#000+
'**2iTP_return target processor'#000+
'**1I<x>_adds <x> to include pat','h'#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 profile code f','or gprof'#000+
'*L1P_use pipes instead of creating temporary assembler files'#000+
'**1S<x>_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_compiler stop','s after the first error'#000+
'**2Sg_allow LABEL and GOTO'#000+
'**2Sh_Use ans','istrings'#000+
'**2Sh_Use ansistrings'#000+
'**2Si_support C++ styled 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 i','n objects'#000+
'**2Ss_constructor name mus','t 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+
'**2Us_compile a system unit'#000+
'**1v<x>_Be verbose. <x> is a combination of the 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*_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*_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 procedure r : Rhide/','GCC compatibility mod'+
'e'#000+
'**2*_a : Show everything 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_DYNAMIC)'#000+
'**2Xs_strip all',' symbols from executable'#000+
'**2XD_link w','ith 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*2Anasmcoff_coff file using Nasm'#000+
'3*2Anasmelf_elf32 (Linux) file using ','Nasm'#000+
'3*2Anas','mcoff_coff file using Nasm'#000+
'3*2Anasmelf_elf32 (Linux) file using Nasm'#000+
'3*2Anasmobj_obj file using Nasm'#000+
'3*2Amasm_obj file using Masm (Microsoft)'#000+
'3*2Atasm_obj file 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 as','sembler'#000+
'3*2Rintel_read Intel style assembler'#000+
'3*2Rdirect_copy ass','embler 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*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*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<x>_target processor:'#000+
'3*3Op1_set target processor to 386/486'#000+
'3*3Op2_set target processor to',' Pentium/PentiumMMX (tm)'#000+
'3*3Op','1_set target processor to 386/486'#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*2TGO32V2_versi','on 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*1O_optimizations:'#000+
'6','*1O_optimizations:'#000+
'6*2Oa_turn on the optimizer'#000+
'6*2Og_generate sm','aller 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*2RMOT_read m','otorola style assembler'#000+
'6*1T<x>_Target operating system:'#000+
'6*2TAMI','GA_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+

12
compiler/pdecl.pas
View File

@ -1040,11 +1040,14 @@ unit pdecl;
assigned(propertyparas)
) then
Message(parser_e_property_cant_have_a_default_value);
{ Get the result of the default, the firstpass is
needed to support values like -1 }
pt:=comp_expr(true);
do_firstpass(pt);
if p^.proptype^.deftype=setdef then
begin
do_firstpass(pt);
arrayconstructor_to_set(pt);
arrayconstructor_to_set(pt);
do_firstpass(pt);
end;
pt:=gentypeconvnode(pt,p^.proptype);
do_firstpass(pt);
@ -2216,7 +2219,10 @@ unit pdecl;
end.
{
$Log$
Revision 1.124 1999-06-01 14:45:51 peter
Revision 1.125 1999-06-01 19:27:53 peter
* better checks for procvar and methodpointer
Revision 1.124 1999/06/01 14:45:51 peter
* @procvar is now always needed for FPC
Revision 1.123 1999/05/27 19:44:45 peter

15
compiler/pexpr.pas
View File

@ -545,12 +545,12 @@ unit pexpr;
if assigned(t^.methodpointer) and
(t^.methodpointer^.resulttype^.deftype=objectdef) and
(pobjectdef(t^.methodpointer^.resulttype)^.isclass) and
(proc_to_procvar_equal(procvar,pprocsym(t^.symtableentry)^.definition)) then
(proc_to_procvar_equal(pprocsym(t^.symtableentry)^.definition,procvar)) then
hp:=genloadmethodcallnode(pprocsym(t^.symtableprocentry),t^.symtable,getcopy(t^.methodpointer))
else
Message(type_e_mismatch);
end
else if (proc_to_procvar_equal(getprocvardef,pprocsym(t^.symtableentry)^.definition)) then
else if (proc_to_procvar_equal(pprocsym(t^.symtableentry)^.definition,getprocvardef)) then
begin
hp:=genloadcallnode(pprocsym(t^.symtableprocentry),t^.symtable);
end;
@ -732,7 +732,7 @@ unit pexpr;
p1:=genmethodcallnode(pprocsym(sym),srsymtable,p1);
do_proc_call(getaddr or
(getprocvar and
proc_to_procvar_equal(getprocvardef,pprocsym(sym)^.definition))
proc_to_procvar_equal(pprocsym(sym)^.definition,getprocvardef))
,again,p1,pd);
{ now we know the real method e.g. we can check for }
{ a class method }
@ -1083,7 +1083,7 @@ unit pexpr;
p1^.unit_specific:=unit_specific;
do_proc_call(getaddr or
(getprocvar and
proc_to_procvar_equal(getprocvardef,pprocsym(srsym)^.definition)),
proc_to_procvar_equal(pprocsym(srsym)^.definition,getprocvardef)),
again,p1,pd);
if possible_error and
((p1^.procdefinition^.options and poclassmethod)=0) then
@ -1410,7 +1410,7 @@ unit pexpr;
begin
if (pd^.deftype=procvardef) then
begin
if getprocvar and proc_to_procvar_equal(pprocvardef(pd),getprocvardef) then
if getprocvar and is_equal(pd,getprocvardef) then
again:=false
else
if (token=LKLAMMER) or
@ -1985,7 +1985,10 @@ unit pexpr;
end.
{
$Log$
Revision 1.109 1999-05-27 19:44:46 peter
Revision 1.110 1999-06-01 19:27:55 peter
* better checks for procvar and methodpointer
Revision 1.109 1999/05/27 19:44:46 peter
* removed oldasm
* plabel -> pasmlabel
* -a switches to source writing automaticly

11
compiler/symconst.inc
View File

@ -71,10 +71,12 @@
pomsgint = $10000000; { method for int message handling }
posavestdregs = $20000000; { save std regs cdecl and stdcall need that ! }
pocontainsself = $40000000; { self is passed explicit to the compiler }
{ relevant options for assigning a proc or a procvar to a procvar }
posafecall = $80000000; { safe call calling conventions }
{ relevant options for assigning a proc or a procvar to a procvar }
po_compatibility_options = $7FFFFFFF-
(pomethodpointer+povirtualmethod+pooverridingmethod);
(poassembler+pomsgstr+pomsgint+
povirtualmethod+pooverridingmethod+pomethodpointer);
{ options for objects and classes }
oo_is_abstract = $1; { true, if the object/class has an abstract }
@ -109,7 +111,10 @@
{
$Log$
Revision 1.9 1999-05-24 08:55:29 florian
Revision 1.10 1999-06-01 19:27:56 peter
* better checks for procvar and methodpointer
Revision 1.9 1999/05/24 08:55:29 florian
* non working safecall directiv implemented, I don't know if we
need it

7
compiler/tccal.pas
View File

@ -391,7 +391,7 @@ implementation
(
(m_tp_procvar in aktmodeswitches) and
(def^.deftype=procvardef) and (p^.left^.treetype=calln) and
(proc_to_procvar_equal(p^.left^.procdefinition,pprocvardef(def)))
(proc_to_procvar_equal(pprocdef(p^.left^.procdefinition),pprocvardef(def)))
)
;
end;
@ -1172,7 +1172,10 @@ implementation
end.
{
$Log$
Revision 1.50 1999-06-01 14:46:00 peter
Revision 1.51 1999-06-01 19:27:57 peter
* better checks for procvar and methodpointer
Revision 1.50 1999/06/01 14:46:00 peter
* @procvar is now always needed for FPC
Revision 1.49 1999/05/31 20:34:51 peter

27
compiler/types.pas
View File

@ -143,7 +143,7 @@ interface
function equal_paras(def1,def2 : pdefcoll;value_equal_const : boolean) : boolean;
{ true if a function can be assigned to a procvar }
function proc_to_procvar_equal(def1,def2 : pabstractprocdef) : boolean;
function proc_to_procvar_equal(def1:pprocdef;def2:pprocvardef) : boolean;
{ if l isn't in the range of def a range check error is generated and
the value is placed within the range }
@ -203,8 +203,20 @@ implementation
{ true if a function can be assigned to a procvar }
function proc_to_procvar_equal(def1,def2 : pabstractprocdef) : boolean;
function proc_to_procvar_equal(def1:pprocdef;def2:pprocvardef) : boolean;
var
ismethod : boolean;
begin
proc_to_procvar_equal:=false;
{ check for method pointer }
ismethod:=(def1^.owner^.symtabletype=objectsymtable) and
(pobjectdef(def1^.owner^.defowner)^.isclass);
if ismethod<>((def2^.options and pomethodpointer)<>0) then
begin
Message(type_e_no_method_and_procedure_not_compatible);
exit;
end;
{ check the other things }
if is_equal(def1^.retdef,def2^.retdef) and
equal_paras(def1^.para1,def2^.para1,false) and
((def1^.options and po_compatibility_options)=
@ -668,9 +680,6 @@ implementation
function is_equal(def1,def2 : pdef) : boolean;
const
procvarmask = not(poassembler or pomethodpointer or povirtualmethod or
pooverridingmethod or pomsgint or pomsgstr);
var
b : boolean;
hd : pdef;
@ -771,7 +780,8 @@ implementation
{ poassembler isn't important for compatibility }
{ if a method is assigned to a methodpointer }
{ is checked before }
b:=((pprocvardef(def1)^.options and procvarmask)=(pprocvardef(def2)^.options and procvarmask)) and
b:=((pprocvardef(def1)^.options and po_compatibility_options)=
(pprocvardef(def2)^.options and po_compatibility_options)) and
is_equal(pprocvardef(def1)^.retdef,pprocvardef(def2)^.retdef);
{ now evalute the parameters }
if b then
@ -876,7 +886,10 @@ implementation
end.
{
$Log$
Revision 1.67 1999-05-31 22:54:19 peter
Revision 1.68 1999-06-01 19:27:58 peter
* better checks for procvar and methodpointer
Revision 1.67 1999/05/31 22:54:19 peter
* when range check error is found then fix the value to be within the
range