Przeglądaj źródła

* Notes/Hints for local syms changed to
Set_varstate function

pierre 26 lat temu
rodzic
commit
b528749138

+ 8 - 4
compiler/cg386mat.pas

@@ -28,7 +28,7 @@ interface
 
     procedure secondmoddiv(var p : ptree);
     procedure secondshlshr(var p : ptree);
-    procedure secondumminus(var p : ptree);
+    procedure secondunaryminus(var p : ptree);
     procedure secondnot(var p : ptree);
 
 
@@ -594,10 +594,10 @@ implementation
 
 
 {*****************************************************************************
-                             SecondUmMinus
+                             SecondUnaryMinus
 *****************************************************************************}
 
-    procedure secondumminus(var p : ptree);
+    procedure secondunaryminus(var p : ptree);
 
 {$ifdef SUPPORT_MMX}
       procedure do_mmx_neg;
@@ -940,7 +940,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.35  1999-11-06 14:34:18  peter
+  Revision 1.36  1999-11-18 15:34:44  pierre
+    * Notes/Hints for local syms changed to
+      Set_varstate function
+
+  Revision 1.35  1999/11/06 14:34:18  peter
     * truncated log to 20 revs
 
   Revision 1.34  1999/09/28 19:43:47  florian

+ 8 - 4
compiler/cg68kmat.pas

@@ -28,7 +28,7 @@ interface
 
     procedure secondmoddiv(var p : ptree);
     procedure secondshlshr(var p : ptree);
-    procedure secondumminus(var p : ptree);
+    procedure secondunaryminus(var p : ptree);
     procedure secondnot(var p : ptree);
 
 
@@ -279,10 +279,10 @@ implementation
       end;
 
 {*****************************************************************************
-                             SecondUmMinus
+                             Secondunaryminus
 *****************************************************************************}
 
-    procedure secondumminus(var p : ptree);
+    procedure secondunaryminus(var p : ptree);
 
       begin
          secondpass(p^.left);
@@ -449,7 +449,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.5  1999-09-16 23:05:51  florian
+  Revision 1.6  1999-11-18 15:34:44  pierre
+    * Notes/Hints for local syms changed to
+      Set_varstate function
+
+  Revision 1.5  1999/09/16 23:05:51  florian
     * m68k compiler is again compilable (only gas writer, no assembler reader)
 
   Revision 1.4  1998/12/11 00:03:05  peter

+ 26 - 2
compiler/comphook.pas

@@ -78,7 +78,13 @@ procedure def_halt(i : longint);
 Function  def_status:boolean;
 Function  def_comment(Level:Longint;const s:string):boolean;
 function  def_internalerror(i:longint):boolean;
-
+{$ifdef DEBUG}
+{ allow easy stopping in GDB
+  using
+  b DEF_GDB_STOP
+  cond 1 LEVEL <= 8 }
+procedure def_gdb_stop(level : longint);
+{$endif DEBUG}
 { Function redirecting for IDE support }
 type
   tstopprocedure         = procedure;
@@ -153,6 +159,17 @@ begin
 {$endif USEEXCEPT}
 end;
 
+{$ifdef DEBUG}
+{ allow easy stopping in GDB
+  using
+  b DEF_GDB_STOP
+  cond 1 LEVEL <= 8 }
+procedure def_gdb_stop(level : longint);
+begin
+  { Its only a dummy for GDB }
+end;
+{$endif DEBUG}
+
 procedure def_halt(i : longint);
 begin
   halt(i);
@@ -261,6 +278,9 @@ begin
         else
          writeln(hs);
       end;
+{$ifdef DEBUG}
+     def_gdb_stop(level);
+{$endif DEBUG}
    end;
 end;
 
@@ -275,7 +295,11 @@ end;
 end.
 {
   $Log$
-  Revision 1.18  1999-09-07 14:03:48  pierre
+  Revision 1.19  1999-11-18 15:34:45  pierre
+    * Notes/Hints for local syms changed to
+      Set_varstate function
+
+  Revision 1.18  1999/09/07 14:03:48  pierre
    + added do_halt procedure
 
   Revision 1.17  1999/08/05 16:52:53  peter

+ 6 - 2
compiler/errore.msg

@@ -1019,14 +1019,18 @@ sym_h_para_identifier_not_used=H_Parameter $1 not used
 sym_n_local_identifier_not_used=N_Local variable $1 not used
 % You have declared, but not used a variable in a procedure or function
 % implementation.
-sym_h_para_identifier_only_set=H_Const or value parameter $1 is set but not used
+sym_h_para_identifier_only_set=H_Value parameter $1 is assigned but never used
 % This is a warning. The identifier was declared (locally or globally)
 % set but not used (locally or globally).
-sym_n_local_identifier_only_set=N_Local variable $1 is set but not used
+sym_n_local_identifier_only_set=N_Local variable $1 is assigned but never used
 % The variable in a procedure or function
 % implementation is declared, set but never used.
 sym_h_local_symbol_not_used=H_Local $1 $2 is not used
 % A local symbol is never used.
+sym_n_private_identifier_not_used=N_Private field $1.$2 is never used
+sym_n_private_identifier_only_set=N_Private field $1.$2 is assigned but never used
+sym_n_private_method_not_used=N_Private method $1.$2 never used
+
 sym_e_set_expected=E_Set type expected
 % The variable or expression isn't of type \var{set}. This happens in an
 % \var{in} statement.

+ 9 - 3
compiler/globals.pas

@@ -126,7 +126,8 @@ unit globals;
        in_args : boolean;                { arguments must be checked especially }
        parsing_para_level : longint;     { parameter level, used to convert
                                              proc calls to proc loads in firstcalln }
-       Must_be_valid : boolean;          { should the variable already have a value }
+       { Must_be_valid : boolean;           should the variable already have a value
+        obsolete replace by set_varstate function }
        compile_level : word;
        make_ref : boolean;
        resolving_forward : boolean;      { used to add forward reference as second ref }
@@ -1289,6 +1290,7 @@ end;
 {$ifdef tp}
         use_big:=false;
 {$endif tp}
+       compile_level:=0;
 
       { Output }
         OutputFile:='';
@@ -1339,7 +1341,7 @@ end;
 
       { compile state }
         in_args:=false;
-        must_be_valid:=true;
+        { must_be_valid:=true; obsolete PM }
         not_unit_proc:=true;
 
         apptype:=at_cui;
@@ -1355,7 +1357,11 @@ begin
 end.
 {
   $Log$
-  Revision 1.35  1999-11-17 17:04:59  pierre
+  Revision 1.36  1999-11-18 15:34:45  pierre
+    * Notes/Hints for local syms changed to
+      Set_varstate function
+
+  Revision 1.35  1999/11/17 17:04:59  pierre
    * Notes/hints changes
 
   Revision 1.34  1999/11/15 17:42:41  pierre

+ 7 - 1
compiler/htypechk.pas

@@ -28,7 +28,9 @@ interface
 
     const
     { firstcallparan without varspez we don't count the ref }
+{$ifdef extdebug}
        count_ref : boolean = true;
+{$endif def extdebug}
        get_para_resulttype : boolean = false;
        allow_array_constructor : boolean = false;
 
@@ -840,7 +842,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.48  1999-11-09 14:47:03  peter
+  Revision 1.49  1999-11-18 15:34:45  pierre
+    * Notes/Hints for local syms changed to
+      Set_varstate function
+
+  Revision 1.48  1999/11/09 14:47:03  peter
     * pointer->array is allowed for all pointer types in FPC, fixed assign
       check for it.
 

+ 3 - 0
compiler/msgidx.inc

@@ -275,6 +275,9 @@ type tmsgconst=(
   sym_h_para_identifier_only_set,
   sym_n_local_identifier_only_set,
   sym_h_local_symbol_not_used,
+  sym_n_private_identifier_not_used,
+  sym_n_private_identifier_only_set,
+  sym_n_private_method_not_used,
   sym_e_set_expected,
   sym_w_function_result_not_set,
   sym_e_illegal_field,

+ 125 - 122
compiler/msgtxt.inc

@@ -1,7 +1,7 @@
 {$ifdef Delphi}
-const msgtxt : array[0..000104] of string[240]=(
+const msgtxt : array[0..000105] of string[240]=(
 {$else Delphi}
-const msgtxt : array[0..000104,1..240] of char=(
+const msgtxt : array[0..000105,1..240] of char=(
 {$endif Delphi}
   'T_Compiler: $1'#000+
   'D_Compiler OS: $1'#000+
@@ -290,394 +290,397 @@ const msgtxt : array[0..000104,1..240] of char=(
   'E_Forward class definition not resolved $1'#000+
   'H_Parameter $1 not used'#000+
   'N_Local variable $1 not used'#000+
-  'H_Const or value parameter $1 is set but not used'#000+
-  'N_Local variable $1 is set but not used'#000+
-  'H_Local $1 $2 is',' not used'#000+
+  'H_Value parameter $1 is assigned but never used'#000+
+  'N_Local variable $1 is assigned but never used'#000+
+  'H_Local $1 ','$2 is not used'#000+
+  'N_Private field $1.$2 is never used'#000+
+  'N_Private field $1.$2 is assigned but never used'#000+
+  'N_Private method $1.$2 never used'#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 to 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_Data segment too large (max. 2GB)'#000+
   'E_BREAK not allowed'#000+
   'E_CONTINUE not allowed'#000+
-  'E_Expression too complicated - FPU stack overflow'#000+
+  'E_Expression ','too complicated - FPU stack overflow'#000+
   'E_Illegal expression'#000+
   'E_Invalid integer expression'#000+
   'E_Illegal qualifier'#000+
-  'E_High range limi','t < 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_Parameter list ','size exceeds 65535 bytes'#000+
   'E_Illegal type conversion'#000+
   'D_Conversion between ordinals and pointers is not portable across plat'+
-  'for','ms'#000+
+  'forms'#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_illegal call by reference pa','rameters'#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 context)'#000+
   'N_Inefficient code'#000+
   'W_unreachable code'#000+
   'E_procedure call with stackframe ESP/SP'#000+
-  'E_Abstract methods can'#039't be called directly'#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 t','wice'#000+
+  'F_SecondVecn() base defined twice'#000+
   'F_Extended cg68k not supported'#000+
   'F_32-bit unsigned not supported in MC68000 mode'#000+
-  'F_Internal Error in secondinline()'#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_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 stored'#000+
-  'E_Direct call of interrupt procedure $1 is not possible'#000+
+  'E_Direct call of interrupt proc','edure $1 is not possible'#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+
+  'E_Include and exclude not implemented in this case'#000+
   'E_Constructors or destructors can not be called inside a '#039'with'#039+
   ' clause'#000+
-  'E_Cannot call message handler method directly'#000+
+  'E_Ca','nnot call message handler method directly'#000+
   'D_Starting $1 styled assembler parsing'#000+
   'D_Finished $1 styled assembler parsing'#000+
-  'E_No','n-label pattern contains @'#000+
+  'E_Non-label pattern contains @'#000+
   'W_Override operator not supported'#000+
   'E_Error building record offset'#000+
-  'E_OFFSET used without identifier'#000+
+  'E_OFFSET used without id','entifier'#000+
   'E_TYPE used without identifier'#000+
   'E_Cannot use local variable or parameters here'#000+
   'E_need to use OFFSET here'#000+
-  'E_Cannot us','e multiple relocatable symbols'#000+
+  'E_Cannot use multiple relocatable symbols'#000+
   'E_Relocatable symbol can only be added'#000+
   'E_Invalid constant expression'#000+
-  'E_Relocatable symbol is not allowed'#000+
+  'E_Relocatable sy','mbol is not allowed'#000+
   'E_Invalid reference syntax'#000+
   'E_Local symbols/labels aren'#039't allowed as references'#000+
-  'E_Invalid base and index ','register usage'#000+
+  'E_Invalid base and index register usage'#000+
   'E_Wrong scale factor specified'#000+
   'E_Multiple index register usage'#000+
   'E_Invalid operand type'#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 references are not allowed'#000+
-  'F_Divide by zero in asm eval','uator'#000+
+  'F_Divide by zero in asm evaluator'#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_Invalid Ope','rator in asm evaluator'#000+
   'E_escape sequence ignored: $1'#000+
   'E_Invalid symbol reference'#000+
-  'W_Fwait can cause emulation problems with em','u387'#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 bounds'#000+
+  'E_Constant value out of bound','s'#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+
+  'H_$1 translated to $2'#000+
   'W_$1 is associated to an overloaded function'#000+
   'E_Cannot use SELF outside a method'#000+
-  'E_Cannot use OLDEBP outside a nested procedure'#000+
+  'E_Cannot use OL','DEBP 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 match'#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 err','or in constant'#000+
+  'E_Assemler syntax error in constant'#000+
   'E_Invalid String expression'#000+
   '32bit constant 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 ign','ored'#000+
+  'W_NEAR ignored'#000+
   'W_FAR ignored'#000+
   'E_Duplicate local symbol $1'#000+
   'E_Undefined local symbol $1'#000+
   'E_Unknown label identifier $1'#000+
-  'E_Invalid floating point register name'#000+
+  'E_Invalid f','loating point register name'#000+
   'E_NOR not supported'#000+
   'W_Modulo not supported'#000+
   'E_Invalid floating point constant $1'#000+
-  'E_Invalid floati','ng point expression'#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 override expression'#000+
+  'E_Invalid segment ov','erride expression'#000+
   'W_Identifier $1 supposed external'#000+
   'E_Strings not allowed as constants'#000+
   'No type of variable specified'#000+
-  'E_assem','bler code not returned to text section'#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_Using a defined name as a local label'#000,
   'E_Dollar token is used without an identifier'#000+
   'W_32bit constant created for address'#000+
-  'N_.align is target specific, use .balign o','r .p2align'#000+
+  'N_.align is target specific, use .balign or .p2align'#000+
   'E_Can'#039't access fields directly for parameters'#000+
   'E_Can'#039't access fields of objects/classes directly'#000+
-  'F_Too many assembler files'#000+
+  'F_Too man','y assembler files'#000+
   'F_Selected assembler output not supported'#000+
   'F_Comp not supported'#000+
   'F_Direct not support for binary writers'#000+
-  'E_A','llocating of data is only allowed in bss section'#000+
+  'E_Allocating of data is only allowed in bss section'#000+
   'F_No binary writer selected'#000+
   'E_Asm: Opcode $1 not in table'#000+
-  'E_Asm: $1 invalid combination of opcode and operands'#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: I','mmediate or reference expected'#000+
+  'E_Asm: Immediate or reference expected'#000+
   'E_Asm: $1 value exceeds bounds $2'#000+
   'E_Asm: Short jump is out of range $1'#000+
-  'W_Source operating system redefined'#000+
+  'W_Source opera','ting 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+
+  '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 assembl'+
-  'ing'#000+
+  'W_Can'#039't call the assembler, error $1 switchin','g to external assem'+
+  'bling'#000+
   'I_Assembling $1'#000+
   'I_Assembling smartlink $1'#000+
   'W_Object $1 not found, Linking may fail !'#000+
-  'W_Library $1 no','t found, Linking may fail !'#000+
+  'W_Library $1 not found, Linking may fail !'#000+
   'W_Error while linking'#000+
   'W_Can'#039't call the linker, switching to external linking'#000+
-  'I_Linking $1'#000+
+  'I_Linking $','1'#000+
   'W_Util $1 not found, switching to external linking'#000+
   'T_Using util $1'#000+
   'E_Creation of Executables not supported'#000+
-  'E_Creation of D','ynamic/Shared Libraries not supported'#000+
+  'E_Creation of Dynamic/Shared Libraries not supported'#000+
   'I_Closing script $1'#000+
-  'W_resource compiler not found, switching 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 ini','tialized data: $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_Stack space commited: $1 bytes'#000+
+  'X_Stack space commit','ed: $1 bytes'#000+
   'T_Unitsearch: $1'#000+
   'T_PPU Loading $1'#000+
   'U_PPU Name: $1'#000+
   'U_PPU Flags: $1'#000+
   'U_PPU Crc: $1'#000+
   'U_PPU Time: $1'#000+
-  'U_PPU File too sh','ort'#000+
+  'U_PPU File too short'#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 target'#000+
+  'U_P','PU 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_unexpected end of PPU-File'#000+
   'F_Invalid PPU-File entry: $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+
   'F_Can'#039't find unit $1'#000+
-  'W_Unit $1 was not found',' but $2 exists'#000+
+  'W_Unit $1 was not found but $2 exists'#000+
   'F_Unit $1 searched but $2 found'#000+
   'W_Compiling the system unit requires the -Us switch'#000+
-  'F_There were $1 errors compiling module, stopping'#000+
+  'F_There were $1 e','rrors compiling module, stopping'#000+
   'U_Load from $1 ($2) unit $3'#000+
   'U_Recompiling $1, checksum changed for $2'#000+
-  'U_Recompiling $1, sou','rce found only'#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, shared lib is older than ppu','file'#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 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> [o','ptions]'#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+
-  'F','_No source file name in command line'#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 already set to: $1'#000+
-  'W_Shared libs not supported on DOS ','platform, reverting to static'#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+
+  'W_Deb','ug information generation is not supported by this executable'#000+
   'H_Try recompiling with -dGDB'#000+
-  'E_You are using the obsolete swit','ch $1'#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+
+  'N_Switching assembler to default source writing assemble','r'#000+
   'Free Pascal Compiler version $FPCVER [$FPCDATE] for $FPCTARGET'#000+
   'Copyright (c) 1993-1999 by Florian Klaempfl'#000+
-  'Free Pascal Com','piler version $FPCVER'#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 Gener','al Public Licence'#000+
   'For more information read COPYING.FPC'#000+
   #000+
   'Report bugs,suggestions etc to:'#000+
-  '                 [email protected]','aturnus.vein.hu'#000+
+  '                 [email protected]'#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+
+  '**1a_the compiler doesn'#039't del','ete the generated assembler file'#000+
   '**2al_list sourcecode lines in assembler file'#000+
-  '**2ar_list register allocation/release info i','n 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 symbol info'#000+
   '**1B_build all modules'#000+
   '**1C<x>_code generation options:'#000+
   '3*2CD_create dynamic library'#000+
-  '**2Ch<n>_<n> bytes h','eap (between 1023 and 67107840)'#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+
+  '**2Co_check overflow of integer operation','s'#000+
   '**2Cr_range checking'#000+
   '**2Cs<n>_set stack size to <n>'#000+
   '**2Ct_stack checking'#000+
-  '**2CD_create also dynamic library (* doesn'#039't work',' yet *)'#000+
+  '**2CD_create also dynamic library (* doesn'#039't work yet *)'#000+
   '**2CX_create also smartlinked library'#000+
   '**1d<x>_defines the symbol <x>'#000+
   '*O1D_generate a DEF file'#000+
-  '*O2Dd<x>_set description to <x>'#000+
+  '*O2Dd<x>_set d','escription to <x>'#000+
   '*O2Dw_PM application'#000+
   '**1e<x>_set path to executable'#000+
   '**1E_same as -Cn'#000+
   '**1F<x>_set file names and paths:'#000+
-  '**2','FD<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+
+  '**2FE<x>_set e','xe/unit output path to <x>'#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>, overrides -FE'#000+
   '*g1g<x>_generate debugger information:'#000+
   '*g2gg_use gsym'#000+
   '*g2gd_use dbx'#000+
-  '*g2gh_use he','ap trace unit'#000+
+  '*g2gh_use heap trace unit'#000+
   '*g2gc_generate checks for pointers'#000+
   '**1i_information'#000+
   '**2iD_return compiler date'#000+
-  '**2iV_return compiler version'#000+
+  '**2iV_return compiler v','ersion'#000+
   '**2iSO_return compiler OS'#000+
   '**2iSP_return compiler processor'#000+
   '**2iTO_return target OS'#000+
   '**2iTP_return target processor'#000+
-  '**1','I<x>_adds <x> to include path'#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+
+  '**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 (defines FPC_PROFILE)'#000+
-  '*L1P_','use pipes instead of creating temporary assembler files'#000+
+  '*L1P_use pipes instead of creating temporary assembler files'#000+
   '**1S<x>_syntax options:'#000+
-  '**2S2_switch some Delphi 2 extensions on'#000+
+  '**2S2_switch some Delphi 2 extension','s on'#000+
   '**2Sc_supports operators like C (*=,+=,/= and -=)'#000+
   '**2Sd_tries to be Delphi compatible'#000+
-  '**2Se<x>_compiler stops after the',' <x> errors (default is 1)'#000+
+  '**2Se<x>_compiler stops after the <x> errors (default is 1)'#000+
   '**2Sg_allow LABEL and GOTO'#000+
   '**2Sh_Use ansistrings'#000+
   '**2Si_support C++ styled INLINE'#000+
-  '**2Sm_support macros like C (global)'#000+
+  '**2Sm_su','pport 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+
+  '**2Ss_constructor name 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+
+  '**1s_don'#039't call assembler and linker (o','nly 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+
+  '**2Us_compile a system unit'#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*_e : Show errors (default)       d : Show de','bug info'#000+
   '**2*_w : Show warnings               u : Show unit info'#000+
-  '**2*_n : Show notes                  t : Show tried/used fi','les'#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 compi','led procedures'#000+
   '**2*_l : Show linenumbers            c : Show conditionals'#000+
-  '**2*_a : Show everything             0 : Show noth','ing (except errors'+
-  ')'#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*_    declarations if a','n error    x : Executable info (Win32 only'+
+  ')'#000+
   '**2*_    occurs'#000+
   '**1X_executable options:'#000+
   '*L2Xc_link with the c library'#000+
-  '**2Xs_str','ip all symbols from executable'#000+
+  '**2Xs_strip all symbols from executable'#000+
   '**2XD_try to link dynamic          (defines FPC_LINK_DYNAMIC)'#000+
-  '**2XS_try to link static (default) (defines FPC_LINK_STATIC)'#000+
+  '**2XS_try to link stati','c (default) (defines FPC_LINK_STATIC)'#000+
   '**2XX_try to link smart            (defines FPC_LINK_SMART)'#000+
-  '**0*_Processor specific op','tions:'#000+
+  '**0*_Processor specific options:'#000+
   '3*1A<x>_output format:'#000+
   '3*2Aas_assemble using GNU AS'#000+
   '3*2Aasaout_assemble using GNU AS for aout (Go32v1)'#000+
-  '3*2Anasmcoff_coff (Go32v2) file using Nasm'#000+
+  '3*2Ana','smcoff_coff (Go32v2) 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*2Amasm_obj file using Masm (Microsoft)'#000+
   '3*2Atasm_obj file using Tasm (Borland)'#000+
   '3*2Acoff_coff (Go32v2) using internal writer'#000+
-  '3*2Apecoff_pecoff (Win32) using internal writer'#000+
+  '3*2A','pecoff_pecoff (Win32) using internal writer'#000+
   '3*1R<x>_assembler reading style:'#000+
   '3*2Ratt_read AT&T style assembler'#000+
-  '3*2Rintel_rea','d Intel style assembler'#000+
+  '3*2Rintel_read Intel style assembler'#000+
   '3*2Rdirect_copy assembler text directly to assembler file'#000+
   '3*1O<x>_optimizations:'#000+
-  '3*2Og_generate smaller code'#000+
+  '3*2Og_gener','ate smaller code'#000+
   '3*2OG_generate faster code (default)'#000+
   '3*2Or_keep certain variables in registers (still BUGGY!!!)'#000+
-  '3*2Ou_enabl','e uncertain optimizations (see docs)'#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*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 processo','r to 386/486'#000+
+  '3*3Op1_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*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 DO','S extender'#000+
+  '3*2TGO32V2_version 2 of DJ Delorie DOS extender'#000+
   '3*2TLINUX_Linux'#000+
   '3*2TOS2_OS/2 2.x'#000+
   '3*2TWin32_Windows 32 Bit'#000+
   '6*1A<x>_output format'#000+
-  '6*2Aas_Unix o-file using GNU AS'#000+
+  '6*2Aas_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','*2Oa_turn on the optimizer'#000+
+  '6*2Oa_turn on the optimizer'#000+
   '6*2Og_generate smaller code'#000+
   '6*2OG_generate faster code (default)'#000+
-  '6*2Ox_optimize maximum (still BUGGY!!!)'#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 assemb','ler'#000+
+  '6*2RMOT_read motorola style assembler'#000+
   '6*1T<x>_Target operating system:'#000+
   '6*2TAMIGA_Commodore Amiga'#000+
   '6*2TATARI_Atari ST/STe/TT'#000+
   '6*2TMACOS_Macintosh m68k'#000+
-  '6*2TLINUX_Linux-68k'#000+
+  '6*','2TLINUX_Linux-68k'#000+
   '**1*_'#000+
   '**1?_shows this help'#000+
   '**1h_shows this help without waiting'#000

+ 6 - 1
compiler/parser.pas

@@ -329,6 +329,7 @@ unit parser;
             oldrecoverpos:=recoverpospointer;
             recoverpospointer:=@recoverpos;
 {$endif USEEXCEPT}
+
             if (token=_UNIT) or (compile_level>1) then
               begin
                 current_module^.is_unit:=true;
@@ -500,7 +501,11 @@ unit parser;
 end.
 {
   $Log$
-  Revision 1.91  1999-11-09 23:48:47  pierre
+  Revision 1.92  1999-11-18 15:34:46  pierre
+    * Notes/Hints for local syms changed to
+      Set_varstate function
+
+  Revision 1.91  1999/11/09 23:48:47  pierre
    * some DBX work, still does not work
 
   Revision 1.90  1999/11/06 14:34:21  peter

+ 10 - 6
compiler/pass_1.pas

@@ -78,7 +78,7 @@ implementation
          { no temps over several statements }
          cleartempgen;
          { right is the statement itself calln assignn or a complex one }
-         must_be_valid:=true;
+         {must_be_valid:=true; obsolete PM }
          firstpass(p^.right);
          if (not (cs_extsyntax in aktmoduleswitches)) and
             assigned(p^.right^.resulttype) and
@@ -230,10 +230,10 @@ implementation
              firstnothing,     {callparan}
              firstrealconst,   {realconstn}
              firstfixconst,    {fixconstn}
-             firstumminus,     {umminusn}
-             firstasm,   {asmn}
-             firstvec,   {vecn}
-             firstpointerconst, {pointerconstn}
+             firstunaryminus,  {unaryminusn}
+             firstasm,         {asmn}
+             firstvec,         {vecn}
+             firstpointerconst,{pointerconstn}
              firststringconst, {stringconstn}
              firstfuncret,     {funcretn}
              firstself, {selfn}
@@ -371,7 +371,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.108  1999-11-17 17:05:01  pierre
+  Revision 1.109  1999-11-18 15:34:47  pierre
+    * Notes/Hints for local syms changed to
+      Set_varstate function
+
+  Revision 1.108  1999/11/17 17:05:01  pierre
    * Notes/hints changes
 
   Revision 1.107  1999/10/26 12:30:43  peter

+ 7 - 3
compiler/pass_2.pas

@@ -211,8 +211,8 @@ implementation
              secondnothing,     {callparan}
              secondrealconst,   {realconstn}
              secondfixconst,    {fixconstn}
-             secondumminus,     {umminusn}
-             secondasm,  {asmn}
+             secondunaryminus,  {unaryminusn}
+             secondasm,         {asmn}
              secondvecn,        {vecn}
              secondpointerconst, {pointerconstn}
              secondstringconst, {stringconstn}
@@ -697,7 +697,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.42  1999-11-09 23:06:45  peter
+  Revision 1.43  1999-11-18 15:34:47  pierre
+    * Notes/Hints for local syms changed to
+      Set_varstate function
+
+  Revision 1.42  1999/11/09 23:06:45  peter
     * esi_offset -> selfpointer_offset to be newcg compatible
     * hcogegen -> cgbase fixes for newcg
 

+ 13 - 29
compiler/pexpr.pas

@@ -118,7 +118,6 @@ unit pexpr;
     procedure check_tp_procvar(var p : ptree);
       var
          p1 : ptree;
-         Store_valid : boolean;
 
       begin
          if (m_tp_procvar in aktmodeswitches) and
@@ -127,10 +126,8 @@ unit pexpr;
             (p^.treetype=loadn) then
             begin
                { support if procvar then for tp7 and many other expression like this }
-               Store_valid:=Must_be_valid;
-               Must_be_valid:=false;
                do_firstpass(p);
-               Must_be_valid:=Store_valid;
+               set_varstate(p,false);
                if not(getprocvar) and (p^.resulttype^.deftype=procvardef) then
                  begin
                     p1:=gencallnode(nil,nil);
@@ -147,16 +144,13 @@ unit pexpr;
       var
         p1,p2,paras  : ptree;
         prev_in_args : boolean;
-        Store_valid  : boolean;
       begin
         prev_in_args:=in_args;
-        Store_valid:=Must_be_valid;
         case l of
           in_ord_x :
             begin
               consume(_LKLAMMER);
               in_args:=true;
-              Must_be_valid:=true;
               p1:=comp_expr(true);
               consume(_RKLAMMER);
               do_firstpass(p1);
@@ -210,8 +204,8 @@ unit pexpr;
                end
               else { not a type node }
                begin
-                 Must_be_valid:=false;
                  do_firstpass(p1);
+                 set_varstate(p1,false);
                  if (p1^.resulttype=nil) then
                   begin
                     Message(type_e_mismatch);
@@ -247,7 +241,6 @@ unit pexpr;
                end
               else
                begin
-                 Must_be_valid:=false;
                  do_firstpass(p1);
                  if ((p1^.resulttype^.deftype=objectdef) and
                      (oo_has_constructor in pobjectdef(p1^.resulttype)^.objectoptions)) or
@@ -268,7 +261,6 @@ unit pexpr;
               consume(_LKLAMMER);
               in_args:=true;
               p1:=comp_expr(true);
-              Must_be_valid:=true;
               do_firstpass(p1);
               if not codegenerror then
                begin
@@ -296,8 +288,8 @@ unit pexpr;
               in_args:=true;
               p1:=comp_expr(true);
               p1:=gensinglenode(addrn,p1);
-              Must_be_valid:=false;
               do_firstpass(p1);
+
               { Ofs() returns a longint, not a pointer }
               p1^.resulttype:=u32bitdef;
               pd:=p1^.resulttype;
@@ -311,7 +303,6 @@ unit pexpr;
               in_args:=true;
               p1:=comp_expr(true);
               p1:=gensinglenode(addrn,p1);
-              Must_be_valid:=false;
               do_firstpass(p1);
               pd:=p1^.resulttype;
               consume(_RKLAMMER);
@@ -324,10 +315,10 @@ unit pexpr;
               in_args:=true;
               p1:=comp_expr(true);
               do_firstpass(p1);
+              set_varstate(p1,false);
               if p1^.location.loc<>LOC_REFERENCE then
                 Message(cg_e_illegal_expression);
               p1:=genordinalconstnode(0,s32bitdef);
-              Must_be_valid:=false;
               pd:=s32bitdef;
               consume(_RKLAMMER);
               statement_syssym:=p1;
@@ -344,7 +335,6 @@ unit pexpr;
               do_firstpass(p1);
               if p1^.treetype=typen then
                 p1^.resulttype:=p1^.typenodetype;
-              Must_be_valid:=false;
               p2:=geninlinenode(l,false,p1);
               consume(_RKLAMMER);
               pd:=s32bitdef;
@@ -358,7 +348,6 @@ unit pexpr;
               in_args:=true;
               p1:=comp_expr(true);
               do_firstpass(p1);
-              Must_be_valid:=false;
               p2:=geninlinenode(l,false,p1);
               consume(_RKLAMMER);
               pd:=p1^.resulttype;
@@ -371,7 +360,6 @@ unit pexpr;
               consume(_LKLAMMER);
               in_args:=true;
               p1:=comp_expr(true);
-              Must_be_valid:=false;
               if token=_COMMA then
                begin
                  consume(_COMMA);
@@ -393,8 +381,8 @@ unit pexpr;
               while true do
                begin
                  p1:=comp_expr(true);
-                 Must_be_valid:=true;
                  do_firstpass(p1);
+                 set_varstate(p1,true);
                  if not((p1^.resulttype^.deftype=stringdef) or
                         ((p1^.resulttype^.deftype=orddef) and
                          (porddef(p1^.resulttype)^.typ=uchar))) then
@@ -420,7 +408,6 @@ unit pexpr;
                begin
                  consume(_LKLAMMER);
                  in_args:=true;
-                 Must_be_valid:=false;
                  paras:=parse_paras(false,false);
                  consume(_RKLAMMER);
                end
@@ -439,7 +426,6 @@ unit pexpr;
                begin
                  consume(_LKLAMMER);
                  in_args:=true;
-                 Must_be_valid:=true;
                  paras:=parse_paras(true,false);
                  consume(_RKLAMMER);
                end
@@ -468,7 +454,6 @@ unit pexpr;
               consume(_LKLAMMER);
               in_args := true;
               p1:= gencallparanode(comp_expr(true), nil);
-              Must_be_valid := False;
               consume(_COMMA);
               p2 := gencallparanode(comp_expr(true),p1);
               if (token = _COMMA) then
@@ -489,7 +474,6 @@ unit pexpr;
               consume(_LKLAMMER);
               in_args:=true;
               p1:=comp_expr(true);
-              Must_be_valid:=false;
               consume(_COMMA);
               p2:=comp_expr(true);
               statement_syssym:=geninlinenode(l,false,gencallparanode(p1,gencallparanode(p2,nil)));
@@ -522,7 +506,6 @@ unit pexpr;
 
         end;
         in_args:=prev_in_args;
-        Must_be_valid:=Store_valid;
       end;
 
 
@@ -531,7 +514,6 @@ unit pexpr;
       var
          prev_in_args : boolean;
          prevafterassn : boolean;
-         Store_valid : boolean;
       begin
          prev_in_args:=in_args;
          prevafterassn:=afterassignment;
@@ -550,12 +532,10 @@ unit pexpr;
               else p1^.left:=nil;
               { do firstpass because we need the  }
               { result type                       }
-              Store_valid:=Must_be_valid;
-              Must_be_valid:=false;
               do_firstpass(p1);
-              Must_be_valid:=Store_valid;
+              {set_var_state is handled inside firstcalln }
            end
-         else
+        else
            begin
               { address operator @: }
               p1^.left:=nil;
@@ -1854,7 +1834,7 @@ _LECKKLAMMER : begin
       _MINUS : begin
                  consume(_MINUS);
                  p1:=factor(false);
-                 p1:=gensinglenode(umminusn,p1);
+                 p1:=gensinglenode(unaryminusn,p1);
                end;
         _NOT : begin
                  consume(_NOT);
@@ -2118,7 +2098,11 @@ _LECKKLAMMER : begin
 end.
 {
   $Log$
-  Revision 1.160  1999-11-17 17:05:01  pierre
+  Revision 1.161  1999-11-18 15:34:47  pierre
+    * Notes/Hints for local syms changed to
+      Set_varstate function
+
+  Revision 1.160  1999/11/17 17:05:01  pierre
    * Notes/hints changes
 
   Revision 1.159  1999/11/15 17:52:59  pierre

+ 26 - 4
compiler/pmodules.pas

@@ -42,7 +42,8 @@ unit pmodules;
 
     uses
        globtype,version,systems,tokens,
-       cobjects,comphook,globals,verbose,files,
+       cobjects,comphook,compiler,
+       globals,verbose,files,
        symconst,symtable,aasm,
 {$ifdef newcg}
        cgbase,
@@ -938,6 +939,9 @@ unit pmodules;
          s1,s2  : ^string; {Saves stack space}
       begin
          consume(_UNIT);
+         if Compile_Level=1 then
+           IsExe:=false;
+
          if token=_ID then
           begin
           { create filenames and unit name }
@@ -1188,7 +1192,10 @@ unit pmodules;
          aktprocsym^.definition^.forwarddef:=false;
          { test static symtable }
          if (Errorcount=0) then
-           st^.allsymbolsused;
+           begin
+             st^.allsymbolsused;
+             st^.allprivatesused;
+           end;
 
          { size of the static data }
          datasize:=st^.datasize;
@@ -1219,7 +1226,10 @@ unit pmodules;
 
          { tests, if all (interface) forwards are resolved }
          if (Errorcount=0) then
-           symtablestack^.check_forwards;
+           begin
+             symtablestack^.check_forwards;
+             symtablestack^.allprivatesused;
+           end;
 
          { now we have a correct unit, change the symtable type }
          current_module^.in_implementation:=false;
@@ -1313,6 +1323,7 @@ unit pmodules;
          names : Tstringcontainer;
       begin
          DLLsource:=islibrary;
+         IsExe:=true;
          parse_only:=false;
          { relocation works only without stabs !! PM }
          if RelocSection then
@@ -1447,6 +1458,13 @@ unit pmodules;
             exit;
           end;
 
+         { test static symtable }
+         if (Errorcount=0) then
+           begin
+             st^.allsymbolsused;
+             st^.allprivatesused;
+           end;
+
          { generate imports }
          if current_module^.uses_imports then
           importlib^.generatelib;
@@ -1507,7 +1525,11 @@ unit pmodules;
 end.
 {
   $Log$
-  Revision 1.166  1999-11-17 17:05:02  pierre
+  Revision 1.167  1999-11-18 15:34:47  pierre
+    * Notes/Hints for local syms changed to
+      Set_varstate function
+
+  Revision 1.166  1999/11/17 17:05:02  pierre
    * Notes/hints changes
 
   Revision 1.165  1999/11/15 15:03:47  pierre

+ 6 - 2
compiler/ppu.pas

@@ -313,7 +313,7 @@ begin
   if Crc32Tbl[1]=0 then
    MakeCrc32Tbl;
   p:=@InBuf;
-  for i:=1to InLen do
+  for i:=1 to InLen do
    begin
      InitCrc:=Crc32Tbl[byte(InitCrc) xor byte(p^)] xor (InitCrc shr 8);
      inc(longint(p));
@@ -1000,7 +1000,11 @@ end;
 end.
 {
   $Log$
-  Revision 1.48  1999-11-17 17:05:02  pierre
+  Revision 1.49  1999-11-18 15:34:48  pierre
+    * Notes/Hints for local syms changed to
+      Set_varstate function
+
+  Revision 1.48  1999/11/17 17:05:02  pierre
    * Notes/hints changes
 
   Revision 1.47  1999/11/06 14:34:23  peter

+ 7 - 13
compiler/pstatmnt.pas

@@ -372,15 +372,13 @@ unit pstatmnt;
       var
          right,hp,p : ptree;
          i,levelcount : longint;
-         store_valid : boolean;
          withsymtable,symtab : psymtable;
          obj : pobjectdef;
 
       begin
-         Store_valid := Must_be_valid;
-         Must_be_valid:=false;
          p:=comp_expr(true);
          do_firstpass(p);
+         set_varstate(p,false);
          right:=nil;
          if (not codegenerror) and
             (p^.resulttype^.deftype in [objectdef,recorddef]) then
@@ -474,7 +472,6 @@ unit pstatmnt;
              end;
             _with_statement:=nil;
           end;
-         Must_be_valid:=Store_valid;
       end;
 
 
@@ -829,7 +826,6 @@ unit pstatmnt;
           sym : psym;
           classh : pobjectdef;
           pd,pd2 : pdef;
-          store_valid : boolean;
           destructorpos,storepos : tfileposinfo;
           tt : ttreetyp;
         begin
@@ -843,19 +839,13 @@ unit pstatmnt;
             end;
           consume(_LKLAMMER);
 
-          { displaced here to avoid warnings in BP mode (PM) }
-          Store_valid := Must_be_valid;
-          if tt=hnewn then
-            Must_be_valid := False
-          else
-            Must_be_valid:=true;
 
           p:=comp_expr(true);
 
           { calc return type }
           cleartempgen;
           do_firstpass(p);
-          Must_be_valid := Store_valid;
+          set_varstate(p,tt=hdisposen);
 
   {var o:Pobject;
            begin
@@ -1328,7 +1318,11 @@ unit pstatmnt;
 end.
 {
   $Log$
-  Revision 1.110  1999-11-17 17:05:02  pierre
+  Revision 1.111  1999-11-18 15:34:48  pierre
+    * Notes/Hints for local syms changed to
+      Set_varstate function
+
+  Revision 1.110  1999/11/17 17:05:02  pierre
    * Notes/hints changes
 
   Revision 1.109  1999/11/15 22:00:48  peter

+ 36 - 4
compiler/symtable.pas

@@ -173,6 +173,7 @@ unit symtable;
           function  speedsearch(const s : stringid;speedvalue : longint) : psym;
           procedure registerdef(p : pdef);
           procedure allsymbolsused;
+          procedure allprivatesused;
           procedure allunitsused;
           procedure check_forwards;
           procedure checklabels;
@@ -871,7 +872,8 @@ implementation
     procedure varsymbolused(p : pnamedindexobject);
       begin
          if (psym(p)^.typ=varsym) and
-            ((psym(p)^.owner^.symtabletype in [parasymtable,localsymtable,staticsymtable])) then
+            ((psym(p)^.owner^.symtabletype in
+             [parasymtable,localsymtable,objectsymtable,staticsymtable])) then
           begin
            { unused symbol should be reported only if no }
            { error is reported                     }
@@ -888,6 +890,8 @@ implementation
                   begin
                     MessagePos1(psym(p)^.fileinfo,sym_h_para_identifier_not_used,p^.name);
                   end
+                else if (psym(p)^.owner^.symtabletype=objectsymtable) then
+                  MessagePos2(psym(p)^.fileinfo,sym_n_private_identifier_not_used,psym(p)^.owner^.name^,p^.name)
                 else
                   MessagePos1(psym(p)^.fileinfo,sym_n_local_identifier_not_used,p^.name);
              end
@@ -903,20 +907,39 @@ implementation
                     if (pvarsym(p)^.varspez<>vs_var) then
                       MessagePos1(psym(p)^.fileinfo,sym_h_para_identifier_only_set,p^.name);
                   end
+                else if (psym(p)^.owner^.symtabletype=objectsymtable) then
+                  MessagePos2(psym(p)^.fileinfo,sym_n_private_identifier_only_set,psym(p)^.owner^.name^,p^.name)
                 else if (psym(p)^.owner^.symtabletype<>parasymtable) then
                   MessagePos1(psym(p)^.fileinfo,sym_n_local_identifier_only_set,p^.name);
              end;
          end
-      else if ((psym(p)^.owner^.symtabletype in [parasymtable,localsymtable,staticsymtable])) then
+      else if ((psym(p)^.owner^.symtabletype in
+              [objectsymtable,parasymtable,localsymtable,staticsymtable])) then
           begin
            if (Errorcount<>0) then
              exit;
+           if (psym(p)^.refs=0) and (psym(p)^.owner^.symtabletype=objectsymtable) then
+             MessagePos2(psym(p)^.fileinfo,sym_n_private_method_not_used,psym(p)^.owner^.name^,p^.name)
            { units references are problematic }
-           if (psym(p)^.refs=0) and not(psym(p)^.typ in [funcretsym,enumsym,unitsym]) then
+           else if (psym(p)^.refs=0) and not(psym(p)^.typ in [funcretsym,enumsym,unitsym]) then
              MessagePos2(psym(p)^.fileinfo,sym_h_local_symbol_not_used,SymTypeName[psym(p)^.typ],p^.name);
           end;
       end;
 
+    procedure TestPrivate(p : pnamedindexobject);
+      begin
+        if sp_private in psym(p)^.symoptions then
+          varsymbolused(p);
+      end;
+
+    procedure objectprivatesymbolused(p : pnamedindexobject);
+      begin
+         if (psym(p)^.typ=typesym) and
+            (ptypesym(p)^.definition^.deftype=objectdef) then
+           pobjectdef(ptypesym(p)^.definition)^.symtable^.foreach(
+             {$ifndef TP}@{$endif}TestPrivate);
+      end;
+
 {$ifdef GDB}
     procedure concatstab(p : pnamedindexobject);
       begin
@@ -1862,6 +1885,11 @@ implementation
          foreach({$ifndef TP}@{$endif}varsymbolused);
       end;
 
+    procedure tsymtable.allprivatesused;
+      begin
+         foreach({$ifndef TP}@{$endif}objectprivatesymbolused);
+      end;
+
 {$ifdef CHAINPROCSYMS}
     procedure tsymtable.chainprocsyms;
       begin
@@ -2533,7 +2561,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.63  1999-11-17 17:05:06  pierre
+  Revision 1.64  1999-11-18 15:34:48  pierre
+    * Notes/Hints for local syms changed to
+      Set_varstate function
+
+  Revision 1.63  1999/11/17 17:05:06  pierre
    * Notes/hints changes
 
   Revision 1.62  1999/11/15 22:00:48  peter

+ 23 - 3
compiler/tcadd.pas

@@ -102,6 +102,10 @@ implementation
          if is_array_constructor(p^.right^.resulttype) then
            arrayconstructor_to_set(p^.right);
 
+         { both left and right need to be valid }
+         set_varstate(p^.left,true);
+         set_varstate(p^.right,true);
+
          { load easier access variables }
          lt:=p^.left^.treetype;
          rt:=p^.right^.treetype;
@@ -277,8 +281,20 @@ implementation
                  addn : t:=genrealconstnode(lvd+rvd,bestrealdef^);
                  subn : t:=genrealconstnode(lvd-rvd,bestrealdef^);
                  muln : t:=genrealconstnode(lvd*rvd,bestrealdef^);
-               caretn : t:=genrealconstnode(exp(ln(lvd)*rvd),bestrealdef^);
-               slashn : begin
+               starstarn,
+               caretn : begin
+                          if lvd<0 then
+                           begin
+                             Message(parser_e_invalid_float_operation);
+                             t:=genrealconstnode(0,bestrealdef^);
+                           end
+                          else if lvd=0 then
+                            t:=genrealconstnode(1.0,bestrealdef^)
+                          else
+                            t:=genrealconstnode(exp(ln(lvd)*rvd),bestrealdef^);
+                        end;
+               slashn :
+                        begin
                           if rvd=0 then
                            begin
                              Message(parser_e_invalid_float_operation);
@@ -1159,7 +1175,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.55  1999-11-17 17:05:06  pierre
+  Revision 1.56  1999-11-18 15:34:48  pierre
+    * Notes/Hints for local syms changed to
+      Set_varstate function
+
+  Revision 1.55  1999/11/17 17:05:06  pierre
    * Notes/hints changes
 
   Revision 1.54  1999/11/16 23:45:28  pierre

+ 55 - 57
compiler/tccal.pas

@@ -29,7 +29,7 @@ interface
 
     procedure gen_high_tree(p:ptree;openstring:boolean);
 
-    procedure firstcallparan(var p : ptree;defcoll : pparaitem);
+    procedure firstcallparan(var p : ptree;defcoll : pparaitem;do_count : boolean);
     procedure firstcalln(var p : ptree);
     procedure firstprocinline(var p : ptree);
 
@@ -123,21 +123,30 @@ implementation
       end;
 
 
-    procedure firstcallparan(var p : ptree;defcoll : pparaitem);
+    procedure firstcallparan(var p : ptree;defcoll : pparaitem;do_count : boolean);
       var
         old_get_para_resulttype : boolean;
         old_array_constructor : boolean;
-        store_valid : boolean;
         oldtype     : pdef;
+{$ifdef extdebug}
+        store_count_ref : boolean;
+{$endif def extdebug}
         {convtyp     : tconverttype;}
       begin
          inc(parsing_para_level);
+{$ifdef extdebug}
+         if do_count then
+           begin
+             store_count_ref:=count_ref;
+             count_ref:=true;
+           end;
+{$endif def extdebug}
          if assigned(p^.right) then
            begin
               if defcoll=nil then
-                firstcallparan(p^.right,nil)
+                firstcallparan(p^.right,nil,do_count)
               else
-                firstcallparan(p^.right,pparaitem(defcoll^.next));
+                firstcallparan(p^.right,pparaitem(defcoll^.next),do_count);
               p^.registers32:=p^.right^.registers32;
               p^.registersfpu:=p^.right^.registersfpu;
 {$ifdef SUPPORT_MMX}
@@ -150,9 +159,7 @@ implementation
               old_get_para_resulttype:=get_para_resulttype;
               get_para_resulttype:=true;
               allow_array_constructor:=true;
-              if not(assigned(p^.resulttype)) or
-                 (p^.left^.treetype=typeconvn) then
-                firstpass(p^.left);
+              firstpass(p^.left);
               get_para_resulttype:=old_get_para_resulttype;
               allow_array_constructor:=old_array_constructor;
               if codegenerror then
@@ -173,18 +180,17 @@ implementation
                  (defcoll^.data^.deftype=setdef) then
                 p^.left:=gentypeconvnode(p^.left,defcoll^.data);
 
-              if count_ref then
+              if do_count then
                begin
                  { not completly proper, but avoids some warnings }
                  if (defcoll^.paratyp=vs_var) then
                    set_funcret_is_valid(p^.left);
 
-                 store_valid:=must_be_valid;
                  { protected has nothing to do with read/write
                  if (defcoll^.paratyp=vs_var) then
                    test_protected(p^.left);
                  }
-                 must_be_valid:=(defcoll^.paratyp<>vs_var);
+                 set_varstate(p^.left,defcoll^.paratyp<>vs_var);
                  { only process typeconvn and arrayconstructn, else it will
                    break other trees }
                  { But this is need to get correct varstate !! PM }
@@ -192,14 +198,12 @@ implementation
                  old_get_para_resulttype:=get_para_resulttype;
                  allow_array_constructor:=true;
                  get_para_resulttype:=false;
-                 { if (p^.left^.treetype in [arrayconstructn,typeconvn]) or
-                    not assigned(p^.resulttype) then  }
+                  if (p^.left^.treetype in [arrayconstructn,typeconvn]) then
                    firstpass(p^.left);
                  if not assigned(p^.resulttype) then
                    p^.resulttype:=p^.left^.resulttype;
                  get_para_resulttype:=old_get_para_resulttype;
                  allow_array_constructor:=old_array_constructor;
-                 must_be_valid:=store_valid;
                end;
               { check if local proc/func is assigned to procvar }
               if p^.left^.resulttype^.deftype=procvardef then
@@ -313,17 +317,21 @@ implementation
               if (defcoll^.data=pdef(cformaldef)) then
                 begin
                   if defcoll^.paratyp=vs_var then
-                    if not valid_for_formal_var(p^.left) then
-                      begin
-                         aktfilepos:=p^.left^.fileinfo;
-                         CGMessage(parser_e_illegal_parameter_list);
-                      end;
+                    begin
+                      if not valid_for_formal_var(p^.left) then
+                        begin
+                           aktfilepos:=p^.left^.fileinfo;
+                           CGMessage(parser_e_illegal_parameter_list);
+                        end;
+                    end;
                   if defcoll^.paratyp=vs_const then
-                    if not valid_for_formal_const(p^.left) then
-                      begin
-                         aktfilepos:=p^.left^.fileinfo;
-                         CGMessage(parser_e_illegal_parameter_list);
-                      end;
+                    begin
+                      if not valid_for_formal_const(p^.left) then
+                        begin
+                           aktfilepos:=p^.left^.fileinfo;
+                           CGMessage(parser_e_illegal_parameter_list);
+                        end;
+                    end;
                 end;
 
               if defcoll^.paratyp=vs_var then
@@ -343,6 +351,10 @@ implementation
            p^.registersmmx:=p^.left^.registersmmx;
 {$endif SUPPORT_MMX}
          dec(parsing_para_level);
+{$ifdef extdebug}
+         if do_count then
+           count_ref:=store_count_ref;
+{$endif def extdebug}
       end;
 
 
@@ -377,7 +389,7 @@ implementation
          { only Dummy }
          hcvt : tconverttype;
          regi : tregister;
-         store_valid, old_count_ref : boolean;
+         method_must_be_valid : boolean;
       label
         errorexit;
 
@@ -447,8 +459,6 @@ implementation
          { at least we can avoid the overloaded search !! }
          procs:=nil;
          { made this global for disposing !! }
-         store_valid:=must_be_valid;
-         must_be_valid:=false;
 
          oldcallprocsym:=aktcallprocsym;
          aktcallprocsym:=nil;
@@ -491,16 +501,12 @@ implementation
               { calculate the type of the parameters }
               if assigned(p^.left) then
                 begin
-                   old_count_ref:=count_ref;
-                   count_ref:=false;
-                   firstcallparan(p^.left,nil);
-                   count_ref:=old_count_ref;
+                   firstcallparan(p^.left,nil,false);
                    if codegenerror then
                      goto errorexit;
                 end;
-              must_be_valid:=true;
               firstpass(p^.right);
-              must_be_valid:=false;
+              set_varstate(p^.right,true);
 
               { check the parameters }
               pdc:=pparaitem(pprocvardef(p^.right^.resulttype)^.para^.first);
@@ -519,10 +525,7 @@ implementation
               { insert type conversions }
               if assigned(p^.left) then
                 begin
-                   old_count_ref:=count_ref;
-                   count_ref:=true;
-                   firstcallparan(p^.left,pparaitem(pprocvardef(p^.right^.resulttype)^.para^.first));
-                   count_ref:=old_count_ref;
+                   firstcallparan(p^.left,pparaitem(pprocvardef(p^.right^.resulttype)^.para^.first),true);
                    if codegenerror then
                      goto errorexit;
                 end;
@@ -538,16 +541,7 @@ implementation
               { determine the type of the parameters }
               if assigned(p^.left) then
                 begin
-                   old_count_ref:=count_ref;
-                   count_ref:=false;
-                   { must be valid is already false!
-                   store_valid:=must_be_valid;
-                   must_be_valid:=false; }
-                   firstcallparan(p^.left,nil);
-                   count_ref:=old_count_ref;
-                   {
-                   must_be_valid:=store_valid;
-                   }
+                   firstcallparan(p^.left,nil,false);
                    if codegenerror then
                      goto errorexit;
                 end;
@@ -1054,10 +1048,7 @@ implementation
               { !!! done now after internproc !! (PM) }
               if assigned(p^.left) then
                 begin
-                   old_count_ref:=count_ref;
-                   count_ref:=true;
-                   firstcallparan(p^.left,pparaitem(p^.procdefinition^.para^.first));
-                   count_ref:=old_count_ref;
+                   firstcallparan(p^.left,pparaitem(p^.procdefinition^.para^.first),true);
                 end;
 {$ifdef i386}
               for regi:=R_EAX to R_EDI do
@@ -1134,7 +1125,6 @@ implementation
                      p^.location.loc:=LOC_MEM;
                 end;
            end;
-         must_be_valid:=store_valid;
          { a fpu can be used in any procedure !! }
          p^.registersfpu:=p^.procdefinition^.fpu_used;
          { if this is a call to a method calc the registers }
@@ -1162,12 +1152,16 @@ implementation
                      if (p^.procdefinition^.proctypeoption=potype_constructor) or
                         ((p^.methodpointer^.treetype=loadn) and
                         (not(oo_has_virtual in pobjectdef(p^.methodpointer^.resulttype)^.objectoptions))) then
-                       must_be_valid:=false
+                       method_must_be_valid:=false
                      else
-                       must_be_valid:=true;
-                     count_ref:=true;
+                       method_must_be_valid:=true;
                      firstpass(p^.methodpointer);
-                     must_be_valid:=store_valid;
+                     set_varstate(p^.methodpointer,method_must_be_valid);
+                     { The object is already used ven if it is called once }
+                     if (p^.methodpointer^.treetype=loadn) and
+                        (p^.methodpointer^.symtableentry^.typ=varsym) then
+                       pvarsym(p^.methodpointer^.symtableentry)^.varstate:=vs_used;
+
                      p^.registersfpu:=max(p^.methodpointer^.registersfpu,p^.registersfpu);
                      p^.registers32:=max(p^.methodpointer^.registers32,p^.registers32);
 {$ifdef SUPPORT_MMX}
@@ -1227,7 +1221,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.72  1999-11-17 17:05:07  pierre
+  Revision 1.73  1999-11-18 15:34:49  pierre
+    * Notes/Hints for local syms changed to
+      Set_varstate function
+
+  Revision 1.72  1999/11/17 17:05:07  pierre
    * Notes/hints changes
 
   Revision 1.71  1999/11/06 14:34:29  peter

+ 10 - 12
compiler/tccnv.pas

@@ -593,7 +593,7 @@ implementation
      begin
        aprocdef:=nil;
        { if explicite type cast, then run firstpass }
-       if p^.explizit then
+       if (p^.explizit) or not assigned(p^.left^.resulttype) then
          firstpass(p^.left);
        if (p^.left^.treetype=typen) and (p^.left^.resulttype=generrordef) then
          begin
@@ -893,14 +893,11 @@ implementation
 *****************************************************************************}
 
     procedure firstis(var p : ptree);
-      var
-         Store_valid : boolean;
       begin
-         Store_valid:=Must_be_valid;
-         Must_be_valid:=true;
          firstpass(p^.left);
+         set_varstate(p^.left,true);
          firstpass(p^.right);
-         Must_be_valid:=Store_valid;
+         set_varstate(p^.right,true);
          if codegenerror then
            exit;
 
@@ -931,14 +928,11 @@ implementation
 *****************************************************************************}
 
     procedure firstas(var p : ptree);
-      var
-         Store_valid : boolean;
       begin
-         Store_valid:=Must_be_valid;
-         Must_be_valid:=true;
          firstpass(p^.right);
+         set_varstate(p^.right,true);
          firstpass(p^.left);
-         Must_be_valid:=Store_valid;
+         set_varstate(p^.left,true);
          if codegenerror then
            exit;
 
@@ -967,7 +961,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.52  1999-11-06 14:34:29  peter
+  Revision 1.53  1999-11-18 15:34:49  pierre
+    * Notes/Hints for local syms changed to
+      Set_varstate function
+
+  Revision 1.52  1999/11/06 14:34:29  peter
     * truncated log to 20 revs
 
   Revision 1.51  1999/11/05 13:15:00  florian

+ 13 - 7
compiler/tcflw.pas

@@ -69,8 +69,8 @@ implementation
            t_times:=t_times*8;
 
          cleartempgen;
-         must_be_valid:=true;
          firstpass(p^.left);
+         set_varstate(p^.left,true);
          if codegenerror then
            exit;
          if not is_boolean(p^.left^.resulttype) then
@@ -118,8 +118,9 @@ implementation
       begin
          old_t_times:=t_times;
          cleartempgen;
-         must_be_valid:=true;
          firstpass(p^.left);
+         set_varstate(p^.left,true);
+
          { Only check type if no error, we can't leave here because
            the p^.right also needs to be firstpassed }
          if not codegenerror then
@@ -243,8 +244,8 @@ implementation
            CGMessage(cg_e_illegal_expression);
 
          cleartempgen;
-         must_be_valid:=false;
          firstpass(p^.left);
+         set_varstate(p^.left,false);
 
          cleartempgen;
          if assigned(p^.t1) then
@@ -269,9 +270,9 @@ implementation
 {$endif SUPPORT_MMX}
 
          { process count var }
-         must_be_valid:=true;
          cleartempgen;
          firstpass(p^.t2);
+         set_varstate(p^.t2,true);
          if codegenerror then
           exit;
 
@@ -300,6 +301,7 @@ implementation
 
          cleartempgen;
          firstpass(p^.right);
+         set_varstate(p^.right,true);
          if p^.right^.treetype<>ordconstn then
            begin
               p^.right:=gentypeconvnode(p^.right,p^.t2^.resulttype);
@@ -460,12 +462,12 @@ implementation
       begin
          p^.resulttype:=voiddef;
          cleartempgen;
-         must_be_valid:=true;
          firstpass(p^.left);
+         set_varstate(p^.left,true);
 
          cleartempgen;
-         must_be_valid:=true;
          firstpass(p^.right);
+         set_varstate(p^.right,true);
          if codegenerror then
            exit;
          left_right_max(p);
@@ -512,7 +514,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.25  1999-11-17 17:05:07  pierre
+  Revision 1.26  1999-11-18 15:34:49  pierre
+    * Notes/Hints for local syms changed to
+      Set_varstate function
+
+  Revision 1.25  1999/11/17 17:05:07  pierre
    * Notes/hints changes
 
   Revision 1.24  1999/11/06 14:34:30  peter

+ 54 - 58
compiler/tcinl.pas

@@ -54,11 +54,9 @@ implementation
 {$ifndef NOCOLONCHECK}
          frac_para,length_para : ptree;
 {$endif ndef NOCOLONCHECK}
-         store_count_ref,
          extra_register,
          isreal,
          dowrite,
-         store_valid,
          file_is_typed : boolean;
 
       procedure do_lowhigh(adef : pdef);
@@ -125,13 +123,14 @@ implementation
         begin
            p^.location.loc:=LOC_FPU;
            p^.resulttype:=s80floatdef;
+           { redo firstpass for varstate status PM }
+           set_varstate(p^.left,true);
            if (p^.left^.resulttype^.deftype<>floatdef) or
              (pfloatdef(p^.left^.resulttype)^.typ<>s80real) then
              begin
                 p^.left:=gentypeconvnode(p^.left,s80floatdef);
+                firstpass(p^.left);
              end;
-           { redo firstpass for varstate status PM }
-           firstpass(p^.left);
            p^.registers32:=p^.left^.registers32;
            p^.registersfpu:=p^.left^.registersfpu;
 {$ifdef SUPPORT_MMX}
@@ -140,26 +139,17 @@ implementation
         end;
 
       begin
-         store_valid:=must_be_valid;
-         store_count_ref:=count_ref;
-         count_ref:=false;
-         if not (p^.inlinenumber in [in_read_x,in_readln_x,in_sizeof_x,
-            in_typeof_x,in_ord_x,in_str_x_string,in_val_x,
-            in_reset_typedfile,in_rewrite_typedfile]) then
-           must_be_valid:=true
-         else
-           must_be_valid:=false;
          { if we handle writeln; p^.left contains no valid address }
          if assigned(p^.left) then
            begin
               if p^.left^.treetype=callparan then
-                firstcallparan(p^.left,nil)
+                firstcallparan(p^.left,nil,false)
               else
                 firstpass(p^.left);
               left_right_max(p);
               set_location(p^.location,p^.left^.location);
            end;
-         count_ref:=true;
+         inc(parsing_para_level);
          { handle intern constant functions in separate case }
          if p^.inlineconst then
           begin
@@ -368,6 +358,7 @@ implementation
              in_hi_word:
 
                begin
+                  set_varstate(p^.left,true);
                   if p^.registers32<1 then
                     p^.registers32:=1;
                   if p^.inlinenumber in [in_lo_word,in_hi_word] then
@@ -410,6 +401,7 @@ implementation
 
              in_sizeof_x:
                begin
+                 set_varstate(p^.left,false);
                  if push_high_param(p^.left^.resulttype) then
                   begin
                     getsymonlyin(p^.left^.symtable,'high'+pvarsym(p^.left^.symtableentry)^.name);
@@ -430,6 +422,7 @@ implementation
 
              in_typeof_x:
                begin
+                  set_varstate(p^.left,false);
                   if p^.registers32<1 then
                     p^.registers32:=1;
                   p^.location.loc:=LOC_REGISTER;
@@ -438,6 +431,7 @@ implementation
 
              in_ord_x:
                begin
+                  set_varstate(p^.left,true);
                   if (p^.left^.treetype=ordconstn) then
                     begin
                        hp:=genordinalconstnode(p^.left^.value,s32bitdef);
@@ -496,6 +490,7 @@ implementation
 
              in_chr_byte:
                begin
+                  set_varstate(p^.left,true);
                   hp:=gentypeconvnode(p^.left,cchardef);
                   putnode(p);
                   p:=hp;
@@ -505,6 +500,7 @@ implementation
 
              in_length_string:
                begin
+                  set_varstate(p^.left,true);
                   if is_ansistring(p^.left^.resulttype) then
                     p^.resulttype:=s32bitdef
                   else
@@ -543,16 +539,21 @@ implementation
 
              in_assigned_x:
                begin
+                  set_varstate(p^.left,true);
                   p^.resulttype:=booldef;
                   p^.location.loc:=LOC_FLAGS;
                end;
 
+             in_ofs_x,
+             in_seg_x :
+               set_varstate(p^.left,false);
              in_pred_x,
              in_succ_x:
                begin
                   inc(p^.registers32);
                   p^.resulttype:=p^.left^.resulttype;
                   p^.location.loc:=LOC_REGISTER;
+                  set_varstate(p^.left,true);
                   if not is_ordinal(p^.resulttype) then
                     CGMessage(type_e_ordinal_expr_expected)
                   else
@@ -580,8 +581,8 @@ implementation
                  p^.resulttype:=voiddef;
                  if assigned(p^.left) then
                    begin
-                      p^.left^.resulttype:=nil;
-                      firstcallparan(p^.left,nil);
+                      firstcallparan(p^.left,nil,true);
+                      set_varstate(p^.left,true);
                       if codegenerror then
                        exit;
                       { first param must be var }
@@ -636,8 +637,8 @@ implementation
                   if assigned(p^.left) then
                     begin
                        dowrite:=(p^.inlinenumber in [in_write_x,in_writeln_x]);
-                       p^.left^.resulttype:=nil;
-                       firstcallparan(p^.left,nil);
+                       firstcallparan(p^.left,nil,true);
+                       set_varstate(p^.left,dowrite);
                        { now we can check }
                        hp:=p^.left;
                        while assigned(hp^.right) do
@@ -789,9 +790,8 @@ implementation
                        { pass all parameters again for the typeconversions }
                        if codegenerror then
                          exit;
-                       must_be_valid:=true;
-                       p^.left^.resulttype:=nil;
-                       firstcallparan(p^.left,nil);
+                       firstcallparan(p^.left,nil,true);
+                       set_varstate(p^.left,true);
                        { calc registers }
                        left_right_max(p);
                        if extra_register then
@@ -822,9 +822,8 @@ implementation
              in_rewrite_typedfile :
                begin
                   procinfo^.flags:=procinfo^.flags or pi_do_call;
-                  { to be sure the right definition is loaded }
-                  p^.left^.resulttype:=nil;
                   firstpass(p^.left);
+                  set_varstate(p^.left,true);
                   p^.resulttype:=voiddef;
                end;
 
@@ -841,18 +840,14 @@ implementation
                    end;
                   { first pass just the string for first local use }
                   hp:=p^.left^.right;
-                  must_be_valid:=false;
-                  count_ref:=true;
                   p^.left^.right:=nil;
-                  p^.left^.resulttype:=nil;
-                  firstcallparan(p^.left,nil);
+                  firstcallparan(p^.left,nil,true);
+                  set_varstate(p^.left,false);
                   { remove warning when result is passed }
                   set_funcret_is_valid(p^.left^.left);
-                  must_be_valid:=true;
                   p^.left^.right:=hp;
-                  { force second parsing }
-                  hp^.resulttype:=nil;
-                  firstcallparan(p^.left^.right,nil);
+                  firstcallparan(p^.left^.right,nil,true);
+                  set_varstate(p^.left^.right,true);
                   hp:=p^.left;
                   { valid string ? }
                   if not assigned(hp) or
@@ -900,6 +895,8 @@ implementation
                   hpp:=p^.left^.right;
                   if assigned(hpp) and hpp^.is_colon_para then
                     begin
+                      firstpass(hpp^.left);
+                      set_varstate(hpp^.left,true);
                       if (not is_integer(hpp^.resulttype)) then
                         CGMessage1(type_e_integer_expr_expected,hpp^.resulttype^.typename)
                       else
@@ -912,22 +909,22 @@ implementation
                              if (not is_integer(hpp^.resulttype)) then
                                CGMessage1(type_e_integer_expr_expected,hpp^.resulttype^.typename)
                              else
-                               hpp^.left:=gentypeconvnode(hpp^.left,s32bitdef);
+                               begin
+                                 firstpass(hpp^.left);
+                                 set_varstate(hpp^.left,true);
+
+                                 hpp^.left:=gentypeconvnode(hpp^.left,s32bitdef);
+                               end;
                            end
                           else
                            CGMessage(parser_e_illegal_colon_qualifier);
                         end;
                     end;
 
-                  { for first local use }
-                  must_be_valid:=false;
-                  count_ref:=true;
                   { pass all parameters again for the typeconversions }
                   if codegenerror then
                     exit;
-                  must_be_valid:=true;
-                  p^.left^.resulttype:=nil;
-                  firstcallparan(p^.left,nil);
+                  firstcallparan(p^.left,nil,true);
                   { calc registers }
                   left_right_max(p);
                end;
@@ -949,11 +946,9 @@ implementation
                   { first pass just the code parameter for first local use}
                        hp := p^.left^.right;
                        p^.left^.right := nil;
-                       must_be_valid := false;
-                       count_ref := true;
                        make_not_regable(p^.left^.left);
-                       p^.left^.resulttype:=nil;
-                       firstcallparan(p^.left, nil);
+                       firstcallparan(p^.left, nil,true);
+                       set_varstate(p^.left,false);
                        if codegenerror then exit;
                        p^.left^.right := hp;
                      {code has to be a var parameter}
@@ -970,13 +965,12 @@ implementation
                   {now hpp = the destination value tree}
                   { first pass just the destination parameter for first local use}
                   hp:=hpp^.right;
-                  must_be_valid:=false;
-                  count_ref:=true;
                   hpp^.right:=nil;
                   {hpp = destination}
                   make_not_regable(hpp^.left);
-                  hpp^.resulttype:=nil;
-                  firstcallparan(hpp,nil);
+                  firstcallparan(hpp,nil,true);
+                  set_varstate(hpp,false);
+
                   if codegenerror then
                     exit;
                   { remove warning when result is passed }
@@ -991,12 +985,10 @@ implementation
                                u8bit,s8bit,u16bit,s16bit,s64bit,u64bit]))) Then
                        CGMessage(type_e_mismatch);
                    end;
-                  must_be_valid:=true;
                  {hp = source (String)}
                   { count_ref := false; WHY ?? }
-                  must_be_valid := true;
-                  hp^.resulttype:=nil;
-                  firstcallparan(hp,nil);
+                  firstcallparan(hp,nil,true);
+                  set_varstate(hp,true);
                   if codegenerror then
                     exit;
                   { if not a stringdef then insert a type conv which
@@ -1023,8 +1015,8 @@ implementation
                  p^.resulttype:=voiddef;
                  if assigned(p^.left) then
                    begin
-                      p^.left^.resulttype:=nil;
-                      firstcallparan(p^.left,nil);
+                      firstcallparan(p^.left,nil,true);
+                      set_varstate(p^.left,true);
                       p^.registers32:=p^.left^.registers32;
                       p^.registersfpu:=p^.left^.registersfpu;
 {$ifdef SUPPORT_MMX}
@@ -1062,6 +1054,7 @@ implementation
              in_low_x,
              in_high_x:
                begin
+                  set_varstate(p^.left,false);
                   if p^.left^.treetype in [typen,loadn,subscriptn] then
                     begin
                        case p^.left^.resulttype^.deftype of
@@ -1235,8 +1228,8 @@ implementation
                  p^.resulttype:=voiddef;
                  if assigned(p^.left) then
                    begin
-                      p^.left^.resulttype:=nil;
-                      firstcallparan(p^.left,nil);
+                      firstcallparan(p^.left,nil,true);
+                      set_varstate(p^.left,true);
                       p^.registers32:=p^.left^.registers32;
                       p^.registersfpu:=p^.left^.registersfpu;
 {$ifdef SUPPORT_MMX}
@@ -1272,15 +1265,18 @@ implementation
            { generate an error if no resulttype is set }
            if not assigned(p^.resulttype) then
              p^.resulttype:=generrordef;
-           must_be_valid:=store_valid;
-           count_ref:=store_count_ref;
+         dec(parsing_para_level);
        end;
 
 
 end.
 {
   $Log$
-  Revision 1.59  1999-11-17 17:05:07  pierre
+  Revision 1.60  1999-11-18 15:34:49  pierre
+    * Notes/Hints for local syms changed to
+      Set_varstate function
+
+  Revision 1.59  1999/11/17 17:05:07  pierre
    * Notes/hints changes
 
   Revision 1.58  1999/11/06 14:34:30  peter

+ 7 - 57
compiler/tcld.pas

@@ -148,46 +148,6 @@ implementation
 
                    { count variable references }
 
-                   if must_be_valid and p^.is_first then
-                     begin
-                       if (pvarsym(p^.symtableentry)^.varstate=vs_declared_and_first_found) or
-                          (pvarsym(p^.symtableentry)^.varstate=vs_set_but_first_not_passed) then
-                        if (assigned(pvarsym(p^.symtableentry)^.owner) and
-                           assigned(aktprocsym) and
-                           (pvarsym(p^.symtableentry)^.owner = aktprocsym^.definition^.localst)) then
-                         begin
-                           if p^.symtable^.symtabletype=localsymtable then
-                            CGMessage1(sym_n_uninitialized_local_variable,pvarsym(p^.symtableentry)^.name)
-                           else
-                            CGMessage1(sym_n_uninitialized_variable,pvarsym(p^.symtableentry)^.name);
-                         end;
-                     end;
-                   if count_ref then
-                     begin
-                        if (p^.is_first) then
-                          begin
-                            if pvarsym(p^.symtableentry)^.varstate=vs_declared_and_first_found then
-                            { this can only happen at left of an assignment, no ? PM }
-                             if (parsing_para_level=0) and not must_be_valid then
-                              pvarsym(p^.symtableentry)^.varstate:=vs_assigned
-                             else
-                              pvarsym(p^.symtableentry)^.varstate:=vs_used;
-                            if pvarsym(p^.symtableentry)^.varstate=vs_set_but_first_not_passed then
-                              pvarsym(p^.symtableentry)^.varstate:=vs_used;
-                            p^.is_first:=false;
-                          end
-                        else
-                          begin
-                            if (pvarsym(p^.symtableentry)^.varstate=vs_assigned) and
-                               (must_be_valid or (parsing_para_level>0) or
-                                (p^.resulttype^.deftype=procvardef)) then
-                              pvarsym(p^.symtableentry)^.varstate:=vs_used;
-                            if (pvarsym(p^.symtableentry)^.varstate=vs_declared_and_first_found) and
-                               (must_be_valid or (parsing_para_level>0) or
-                               (p^.resulttype^.deftype=procvardef)) then
-                              pvarsym(p^.symtableentry)^.varstate:=vs_set_but_first_not_passed;
-                          end;
-                     end;
                      { this will create problem with local var set by
                      under_procedures
                      if (assigned(pvarsym(p^.symtableentry)^.owner) and assigned(aktprocsym)
@@ -236,12 +196,8 @@ implementation
 
     procedure firstassignment(var p : ptree);
       var
-         store_valid : boolean;
          hp : ptree;
       begin
-         store_valid:=must_be_valid;
-         must_be_valid:=false;
-
          { must be made unique }
          set_unique(p^.left);
 
@@ -249,6 +205,7 @@ implementation
          set_funcret_is_valid(p^.left);
 
          firstpass(p^.left);
+         set_varstate(p^.left,false);
          if codegenerror then
            exit;
 
@@ -285,9 +242,8 @@ implementation
                 end;
            end;
 {$endif i386}
-         must_be_valid:=true;
          firstpass(p^.right);
-         must_be_valid:=store_valid;
+         set_varstate(p^.right,true);
          if codegenerror then
            exit;
 
@@ -361,16 +317,6 @@ implementation
          if ret_in_param(p^.retdef) or
             (procinfo<>pprocinfo(p^.funcretprocinfo)) then
            p^.registers32:=1;
-         { no claim if setting higher return value_str }
-         if must_be_valid and
-            (procinfo=pprocinfo(p^.funcretprocinfo)) and
-            ((procinfo^.funcret_state=vs_declared) or
-            (p^.is_first_funcret)) then
-           begin
-             CGMessage(sym_w_function_result_not_set);
-             { avoid multiple warnings }
-             procinfo^.funcret_state:=vs_assigned;
-           end;
       end;
 
 
@@ -521,7 +467,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.50  1999-11-17 17:05:07  pierre
+  Revision 1.51  1999-11-18 15:34:50  pierre
+    * Notes/Hints for local syms changed to
+      Set_varstate function
+
+  Revision 1.50  1999/11/17 17:05:07  pierre
    * Notes/hints changes
 
   Revision 1.49  1999/11/06 14:34:30  peter

+ 14 - 4
compiler/tcmat.pas

@@ -28,7 +28,7 @@ interface
 
     procedure firstmoddiv(var p : ptree);
     procedure firstshlshr(var p : ptree);
-    procedure firstumminus(var p : ptree);
+    procedure firstunaryminus(var p : ptree);
     procedure firstnot(var p : ptree);
 
 
@@ -52,7 +52,9 @@ implementation
 
       begin
          firstpass(p^.left);
+         set_varstate(p^.left,true);
          firstpass(p^.right);
+         set_varstate(p^.right,true);
          if codegenerror then
            exit;
 
@@ -150,7 +152,9 @@ implementation
          regs : longint;
       begin
          firstpass(p^.left);
+         set_varstate(p^.left,true);
          firstpass(p^.right);
+         set_varstate(p^.right,true);
          if codegenerror then
            exit;
 
@@ -194,15 +198,16 @@ implementation
 
 
 {*****************************************************************************
-                             FirstUmMinus
+                             FirstUnaryMinus
 *****************************************************************************}
 
-    procedure firstumminus(var p : ptree);
+    procedure firstunaryminus(var p : ptree);
       var
          t : ptree;
          minusdef : pprocdef;
       begin
          firstpass(p^.left);
+         set_varstate(p^.left,true);
          p^.registers32:=p^.left^.registers32;
          p^.registersfpu:=p^.left^.registersfpu;
 {$ifdef SUPPORT_MMX}
@@ -327,6 +332,7 @@ implementation
          t : ptree;
       begin
          firstpass(p^.left);
+         set_varstate(p^.left,true);
          if codegenerror then
            exit;
 
@@ -408,7 +414,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.22  1999-11-06 14:34:30  peter
+  Revision 1.23  1999-11-18 15:34:50  pierre
+    * Notes/Hints for local syms changed to
+      Set_varstate function
+
+  Revision 1.22  1999/11/06 14:34:30  peter
     * truncated log to 20 revs
 
   Revision 1.21  1999/10/26 12:30:46  peter

+ 21 - 15
compiler/tcmem.pas

@@ -167,7 +167,6 @@ implementation
       var
          hp  : ptree;
          hp2 : pparaitem;
-         store_valid : boolean;
          hp3 : pabstractprocdef;
       begin
          make_not_regable(p^.left);
@@ -305,10 +304,11 @@ implementation
                    end;
                 end;
            end;
-         store_valid:=must_be_valid;
-         must_be_valid:=false;
          firstpass(p^.left);
-         must_be_valid:=store_valid;
+         { this is like the function addr }
+         inc(parsing_para_level);
+         set_varstate(p^.left,false);
+         dec(parsing_para_level);
          if codegenerror then
            exit;
 
@@ -348,6 +348,9 @@ implementation
       begin
          make_not_regable(p^.left);
          firstpass(p^.left);
+         inc(parsing_para_level);
+         set_varstate(p^.left,false);
+         dec(parsing_para_level);
          if p^.resulttype=nil then
            p^.resulttype:=voidpointerdef;
          if codegenerror then
@@ -375,12 +378,9 @@ implementation
 *****************************************************************************}
 
     procedure firstderef(var p : ptree);
-      var store_valid : boolean;
       begin
-         store_valid:=must_be_valid;
-         must_be_valid:=true;
          firstpass(p^.left);
-         must_be_valid:=store_valid;
+         set_varstate(p^.left,true);
          if codegenerror then
            begin
              p^.resulttype:=generrordef;
@@ -446,7 +446,6 @@ implementation
       var
          harr : pdef;
          ct : tconverttype;
-         store_valid : boolean;
 {$ifdef consteval}
          tcsym : ptypedconstsym;
 {$endif}
@@ -486,13 +485,13 @@ implementation
                 harr:=new(parraydef,init(0,$7fffffff,s32bitdef));
                 parraydef(harr)^.definition:=ppointerdef(p^.left^.resulttype)^.definition;
                 p^.left:=gentypeconvnode(p^.left,harr);
-                store_valid:=must_be_valid;
-                must_be_valid:=true;
+
                 firstpass(p^.left);
-                must_be_valid:=store_valid;
 
                 if codegenerror then
-                  exit;
+                  begin
+                    exit;
+                  end;
                 p^.resulttype:=parraydef(harr)^.definition
              end
            else if p^.left^.resulttype^.deftype=stringdef then
@@ -572,7 +571,6 @@ implementation
            p^.location.loc:=LOC_REFERENCE
          else
            p^.location.loc:=LOC_MEM;
-
       end;
 
 
@@ -604,6 +602,10 @@ implementation
          if assigned(p^.left) and assigned(p^.right) then
             begin
                firstpass(p^.left);
+               { is this correct ?  At least after is like if used }
+               inc(parsing_para_level);
+               set_varstate(p^.left,false);
+               dec(parsing_para_level);
                if codegenerror then
                  exit;
                symtable:=p^.withsymtable;
@@ -634,7 +636,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.33  1999-11-17 17:05:07  pierre
+  Revision 1.34  1999-11-18 15:34:51  pierre
+    * Notes/Hints for local syms changed to
+      Set_varstate function
+
+  Revision 1.33  1999/11/17 17:05:07  pierre
    * Notes/hints changes
 
   Revision 1.32  1999/11/06 14:34:30  peter

+ 11 - 2
compiler/tcset.pas

@@ -55,6 +55,7 @@ implementation
     procedure firstsetelement(var p : ptree);
       begin
          firstpass(p^.left);
+         set_varstate(p^.left,true);
          if codegenerror then
           exit;
 
@@ -115,6 +116,7 @@ implementation
          p^.resulttype:=booldef;
 
          firstpass(p^.right);
+         set_varstate(p^.right,true);
          if codegenerror then
           exit;
 
@@ -148,6 +150,7 @@ implementation
            end;
 
          firstpass(p^.left);
+         set_varstate(p^.left,true);
          if codegenerror then
            exit;
 
@@ -202,7 +205,9 @@ implementation
          ct : tconverttype;
       begin
          firstpass(p^.left);
+         set_varstate(p^.left,true);
          firstpass(p^.right);
+         set_varstate(p^.right,true);
          if codegenerror then
            exit;
          { both types must be compatible }
@@ -235,8 +240,8 @@ implementation
       begin
          { evalutes the case expression }
          cleartempgen;
-         must_be_valid:=true;
          firstpass(p^.left);
+         set_varstate(p^.left,true);
          if codegenerror then
            exit;
          p^.registers32:=p^.left^.registers32;
@@ -301,7 +306,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.14  1999-09-27 23:45:02  peter
+  Revision 1.15  1999-11-18 15:34:51  pierre
+    * Notes/Hints for local syms changed to
+      Set_varstate function
+
+  Revision 1.14  1999/09/27 23:45:02  peter
     * procinfo is now a pointer
     * support for result setting in sub procedure
 

+ 110 - 4
compiler/tree.pas

@@ -68,7 +68,7 @@ unit tree;
           callparan,       {Represents a parameter.}
           realconstn,      {Represents a real value.}
           fixconstn,       {Represents a fixed value.}
-          umminusn,     {Represents a sign change (i.e. -2).}
+          unaryminusn,     {Represents a sign change (i.e. -2).}
           asmn,     {Represents an assembler node }
           vecn,     {Represents array indexing.}
           pointerconstn,
@@ -183,7 +183,8 @@ unit tree;
           disposetyp : tdisposetyp;
           { is true, if the right and left operand are swaped }
           swaped : boolean;
-
+          { do we need to parse childs to set var state }
+          varstateset : boolean;
           { the location of the result of this node }
           location : tlocation;
 
@@ -306,6 +307,14 @@ unit tree;
     { sets funcret_is_valid to true, if p contains a funcref node }
     procedure set_funcret_is_valid(p : ptree);
 
+    {
+    type
+    tvarstaterequire = (vsr_can_be_undefined,vsr_must_be_valid,
+      vsr_is_used_after,vsr_must_be_valid_and_is_used_after); }
+
+    { sets varsym varstate field correctly }
+    procedure set_varstate(p : ptree;must_be_valid : boolean);
+
     { gibt den ordinalen Werten der Node zurueck oder falls sie }
     { keinen ordinalen Wert hat, wird ein Fehler erzeugt        }
     function get_ordinal_value(p : ptree) : longint;
@@ -1595,7 +1604,7 @@ unit tree;
                       equal_trees:=(equal_trees(t1^.left,t2^.left) and
                                     equal_trees(t1^.right,t2^.right));
                    end;
-                 umminusn,
+                 unaryminusn,
                  notn,
                  derefn,
                  addrn:
@@ -1656,6 +1665,99 @@ unit tree;
            end;
       end;
 
+    procedure set_varstate(p : ptree;must_be_valid : boolean);
+
+      begin
+         if not assigned(p) then
+           exit
+         else
+           begin
+             if p^.varstateset then
+               exit;
+              case p^.treetype of
+           typeconvn,subscriptn :
+             set_varstate(p^.left,must_be_valid);
+           vecn:
+             begin
+               if (p^.left^.resulttype^.deftype in [stringdef,arraydef]) then
+                 set_varstate(p^.left,must_be_valid)
+               else
+                 set_varstate(p^.left,true);
+               set_varstate(p^.right,true);
+             end;
+           { do not parse calln }
+           calln : ;
+           callparan:
+             begin
+               set_varstate(p^.left,must_be_valid);
+               set_varstate(p^.right,must_be_valid);
+             end;
+           loadn :
+         if (p^.symtableentry^.typ=varsym) then
+          begin
+            if must_be_valid and p^.is_first then
+              begin
+                if (pvarsym(p^.symtableentry)^.varstate=vs_declared_and_first_found) or
+                   (pvarsym(p^.symtableentry)^.varstate=vs_set_but_first_not_passed) then
+                 if (assigned(pvarsym(p^.symtableentry)^.owner) and
+                    assigned(aktprocsym) and
+                    (pvarsym(p^.symtableentry)^.owner = aktprocsym^.definition^.localst)) then
+                  begin
+                    if p^.symtable^.symtabletype=localsymtable then
+                     CGMessage1(sym_n_uninitialized_local_variable,pvarsym(p^.symtableentry)^.name)
+                    else
+                     CGMessage1(sym_n_uninitialized_variable,pvarsym(p^.symtableentry)^.name);
+                  end;
+              end;
+          if (p^.is_first) then
+           begin
+             if pvarsym(p^.symtableentry)^.varstate=vs_declared_and_first_found then
+             { this can only happen at left of an assignment, no ? PM }
+              if (parsing_para_level=0) and not must_be_valid then
+               pvarsym(p^.symtableentry)^.varstate:=vs_assigned
+              else
+               pvarsym(p^.symtableentry)^.varstate:=vs_used;
+             if pvarsym(p^.symtableentry)^.varstate=vs_set_but_first_not_passed then
+               pvarsym(p^.symtableentry)^.varstate:=vs_used;
+             p^.is_first:=false;
+           end
+         else
+           begin
+             if (pvarsym(p^.symtableentry)^.varstate=vs_assigned) and
+                (must_be_valid or (parsing_para_level>0) or
+                 (p^.resulttype^.deftype=procvardef)) then
+               pvarsym(p^.symtableentry)^.varstate:=vs_used;
+             if (pvarsym(p^.symtableentry)^.varstate=vs_declared_and_first_found) and
+                (must_be_valid or (parsing_para_level>0) or
+                (p^.resulttype^.deftype=procvardef)) then
+               pvarsym(p^.symtableentry)^.varstate:=vs_set_but_first_not_passed;
+           end;
+         end;
+         funcretn:
+         begin
+         { no claim if setting higher return value_str }
+         if must_be_valid and
+            (procinfo=pprocinfo(p^.funcretprocinfo)) and
+            ((procinfo^.funcret_state=vs_declared) or
+            ((p^.is_first_funcret) and
+             (procinfo^.funcret_state=vs_declared_and_first_found))) then
+           begin
+             CGMessage(sym_w_function_result_not_set);
+             { avoid multiple warnings }
+             procinfo^.funcret_state:=vs_assigned;
+           end;
+         if p^.is_first_funcret and not must_be_valid then
+           pprocinfo(p^.funcretprocinfo)^.funcret_state:=vs_assigned;
+         end;
+         else
+           begin
+             {internalerror(565656);}
+           end;
+         end;{case }
+         p^.varstateset:=true;
+      end;
+    end;
+
     procedure clear_location(var loc : tlocation);
 
       begin
@@ -1795,7 +1897,11 @@ unit tree;
 end.
 {
   $Log$
-  Revision 1.102  1999-11-17 17:05:07  pierre
+  Revision 1.103  1999-11-18 15:34:51  pierre
+    * Notes/Hints for local syms changed to
+      Set_varstate function
+
+  Revision 1.102  1999/11/17 17:05:07  pierre
    * Notes/hints changes
 
   Revision 1.101  1999/11/06 14:34:31  peter