* better support for object fields and more error checks for

    field accesses which create buggy code

compiler/cpubase.pas

@@ -679,7 +679,7 @@ const
 *****************************************************************************}
 
 type
-  trefoptions=(ref_none,ref_parafixup,ref_localfixup);
+  trefoptions=(ref_none,ref_parafixup,ref_localfixup,ref_selffixup);
 
   { immediate/reference record }
   preference = ^treference;
@@ -824,7 +824,7 @@ var
 
   procedure InitCpu;
   procedure DoneCpu;
-  
+
 {*****************************************************************************
                                   Helpers
 *****************************************************************************}
@@ -1086,7 +1086,11 @@ end;
 end.
 {
   $Log$
-  Revision 1.10  1999-08-28 15:34:19  florian
+  Revision 1.11  1999-09-08 16:04:05  peter
+    * better support for object fields and more error checks for
+      field accesses which create buggy code
+
+  Revision 1.10  1999/08/28 15:34:19  florian
     * bug 519 fixed
 
   Revision 1.9  1999/08/19 20:05:09  michael

compiler/errore.msg

@@ -1219,6 +1219,13 @@ asmr_w_using_defined_as_local=E_Using a defined name as a local label
 asmr_e_dollar_without_identifier=E_Dollar token is used without an identifier
 asmr_w_32bit_const_for_address=W_32bit constant created for address
 asmr_n_align_is_target_specific=N_.align is target specific, use .balign or .p2align
+asmr_e_cannot_access_field_directly_for_parameters=E_Can't access fields directly for parameters
+% You should load the parameter first into a register and then access the
+% fields using that register.
+asmr_e_cannot_access_object_field_directly=E_Can't access fields of objects/classes directly
+% You should load the self pointer first into a register and then access the
+% fields using the register as base. By default the self pointer is available
+% in the esi register on i386.
 #
 # Assembler/binary writers
 #

compiler/msgidx.inc

@@ -383,6 +383,8 @@ type tmsgconst=(
   asmr_e_dollar_without_identifier,
   asmr_w_32bit_const_for_address,
   asmr_n_align_is_target_specific,
+  asmr_e_cannot_access_field_directly_for_parameters,
+  asmr_e_cannot_access_object_field_directly,
   asmw_f_too_many_asm_files,
   asmw_f_assembler_output_not_supported,
   asmw_f_comp_not_supported,

compiler/msgtxt.inc

@@ -405,256 +405,258 @@ const msgtxt : array[0..000100,1..240] of char=(
   'E_Dollar token is used without an identifier'#000+
   'W_32bit constant created for address'#000+
   'N_.align is target specific, use .balign or .p2align'#000+
+  'E_Can'#039't access fields directl','y for parameters'#000+
+  'E_Can'#039't access fields of objects/classes directly'#000+
   'F_Too many assembler files'#000+
-  'F_','Selected assembler output not supported'#000+
+  'F_Selected assembler output not supported'#000+
   'F_Comp not supported'#000+
   'F_Direct not support for binary writers'#000+
-  'E_Allocating of data is only allowed in bss section'#000+
+  'E_Allocating of data is only allowed in bss',' 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: Immediate or reference expected'#000+
-  'E_Asm: $1 value exceeds bounds $2'#000+
+  'E_Asm: $1',' value exceeds bounds $2'#000+
   'E_Asm: Short jump is out of range $1'#000+
-  'W_Source operating system redefine','d'#000+
+  'W_Source operating system redefined'#000+
   'I_Assembling (pipe) $1'#000+
   'E_Can'#039't create assember file $1'#000+
   'W_Assembler $1 not found, switching to external assembling'#000+
   'T_Using assembler: $1'#000+
-  'W_Error while assembling exitcode $1'#000+
-  'W_Can'#039't call the assembler, error $1 switching to external assemb',
-  'ling'#000+
+  'W_Erro','r while assembling exitcode $1'#000+
+  'W_Can'#039't call the assembler, error $1 switching to external assembl'+
+  'ing'#000+
   'I_Assembling $1'#000+
   'I_Assembling smartlink $1'#000+
   'W_Linker $1 not found, switching to external linking'#000+
   'T_Using linker: $1'#000+
-  'W_Object $1 not found, Linking may fail !'#000+
+  'W_Object $1 not found, Li','nking may fail !'#000+
   'W_Library $1 not found, Linking may fail !'#000+
   'W_Error while linking'#000+
-  'W_Can'#039't call t','he linker, switching to external linking'#000+
+  'W_Can'#039't call the linker, switching to external linking'#000+
   'I_Linking $1'#000+
   'W_binder not found, switching to external binding'#000+
-  'W_ar not found, switching to external ar'#000+
+  'W_ar not found, switching to external ar',#000+
   'E_Dynamic 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 initialized data: $1 bytes'#000+
+  'X_Size of initia','lized data: $1 bytes'#000+
   'X_Size of uninitialized data: $1 bytes'#000+
   'X_Stack space reserved: $1 bytes'#000+
-  'X_S','tack space commited: $1 bytes'#000+
+  'X_Stack space commited: $1 bytes'#000+
   'T_Unitsearch: $1'#000+
   'T_PPU Loading $1'#000+
   'U_PPU Name: $1'#000+
   'U_PPU Flags: $1'#000+
   'U_PPU Crc: $1'#000+
   'U_PPU Time: $1'#000+
-  'U_PPU File too short'#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 ot','her processor'#000+
+  'U_PPU is compiled for an other processor'#000+
   'U_PPU is compiled for an other target'#000+
   'U_PPU Source: $1'#000+
   'U_Writing $1'#000+
   'F_Can'#039't Write PPU-File'#000+
   'F_reading PPU-File'#000+
-  'F_unexpected end of PPU-File'#000+
+  'F_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_Too much units'#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_Compiling the system unit requires the -Us switch'#000+
+  'W_Compiling the system uni','t requires the -Us switch'#000+
   'F_There were $1 errors compiling module, stopping'#000+
-  'U_Load from $1 ($2) ','unit $3'#000+
+  'U_Load from $1 ($2) unit $3'#000+
   'U_Recompiling $1, checksum changed for $2'#000+
   'U_Recompiling $1, source found only'#000+
   'U_Recompiling unit, static lib is older than ppufile'#000+
-  'U_Recompiling unit, shared lib is older than ppufile'#000+
-  'U_Recompiling unit, obj and asm are older than p','pufile'#000+
+  'U_Rec','ompiling unit, shared lib is older than ppufile'#000+
+  'U_Recompiling unit, obj and asm are older than ppufile'#000+
   'U_Recompiling unit, obj is older than asm'#000+
   'U_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+
+  'U_PPU Check ','file $1 time $2'#000+
   '$1 [options] <inputfile> [options]'#000+
   'W_Only one source file supported'#000+
-  'W_DEF file c','an be created only for OS/2'#000+
+  'W_DEF file can be created only for OS/2'#000+
   'E_nested response files are not supported'#000+
   'F_No source file name in command line'#000+
   'E_Illegal parameter: $1'#000+
-  'H_-? writes help pages'#000+
+  'H_-? writes ','help pages'#000+
   'F_Too many config files nested'#000+
   'F_Unable to open file $1'#000+
-  'N_Reading further options fro','m $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+
   '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 ex','ecutable'#000+
+  'F_op','en conditional at the end of the file'#000+
+  'W_Debug information generation is not supported by this executable'#000+
   'H_Try recompiling with -dGDB'#000+
   'E_You are using the obsolete switch $1'#000+
   'E_You are using the obsolete switch $1, please use $2'#000+
-  'N_Switching assembler to default source writing assembler'#000+
-  'Free Pascal Compiler version $FPCVER [$FPCDATE] for',' $FPCTARGET'#000+
+  'N_Switching a','ssembler to default source writing assembler'#000+
+  'Free Pascal Compiler version $FPCVER [$FPCDATE] for $FPCTARGET'#000+
   'Copyright (c) 1993-98 by Florian Klaempfl'#000+
   'Free Pascal Compiler version $FPCVER'#000+
   #000+
   'Compiler Date  : $FPCDATE'#000+
-  'Compiler Target: $FPCTARGET'#000+
+  'Compiler Target: $FPCTARGE','T'#000+
   #000+
   'This program comes under the GNU General Public Licence'#000+
-  'For more information read COPYING.FPC',#000+
+  'For more information read COPYING.FPC'#000+
   #000+
   'Report bugs,suggestions etc to:'#000+
   '                 [email protected]'#000+
-  '**0*_put + after a boolean switch option to enable it, - to disable it'+
-  #000+
+  '**0*_put + after a boolean switch option to enable it, - to',' disable '+
+  'it'#000+
   '**1a_the compiler doesn'#039't delete the generated assembler file'#000+
-  '**2al_list sourcecode ','lines in assembler file'#000+
+  '**2al_list sourcecode lines in assembler file'#000+
   '**2ar_list register allocation/release info in assembler file'#000+
-  '**2at_list temp allocation/release info in assembler file'#000+
+  '**2at_list temp allocation/release info in assembler file'#000,
   '**1b_generate browser info'#000+
   '**2bl_generate local symbol info'#000+
   '**1B_build all modules'#000+
-  '**1C<x>_code ','generation options:'#000+
+  '**1C<x>_code generation options:'#000+
   '3*2CD_create dynamic library'#000+
   '**2Ch<n>_<n> bytes heap (between 1023 and 67107840)'#000+
   '**2Ci_IO-checking'#000+
-  '**2Cn_omit linking stage'#000+
+  '**2Cn_omit linking stage'#000,
   '**2Co_check overflow of integer operations'#000+
   '**2Cr_range checking'#000+
   '**2Cs<n>_set stack size to <n>'#000+
-  '*','*2Ct_stack checking'#000+
+  '**2Ct_stack checking'#000+
   '3*2CS_create static library'#000+
   '3*2Cx_use smartlinking'#000+
   '**1d<x>_defines the symbol <x>'#000+
   '*O1D_generate a DEF file'#000+
-  '*O2Dd<x>_set description to <x>'#000+
+  '*O2Dd<x>_set desc','ription 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+
+  '**1F<x>_set file names and paths:'#000+
   '**2FD<x>_sets the directory where to search for compiler utilities'#000+
   '**2Fe<x>_redirect error output to <x>'#000+
-  '**2FE<x>_set exe/unit output path to <x>'#000+
+  '**2FE<x>_set exe/','unit output path to <x>'#000+
   '**2Fi<x>_adds <x> to include path'#000+
   '**2Fl<x>_adds <x> to library path'#000+
-  '*L2F','L<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>_se','t unit output path to <x>, overrides -FE'#000+
   '*g1g<x>_generate debugger information:'#000+
   '*g2gg_use gsym'#000+
-  '*','g2gd_use dbx'#000+
+  '*g2gd_use dbx'#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 vers','ion'#000+
   '**2iSO_return compiler OS'#000+
   '**2iSP_return compiler processor'#000+
   '**2iTO_return target OS'#000+
-  '**2iTP_re','turn target processor'#000+
+  '**2iTP_return target processor'#000+
   '**1I<x>_adds <x> to include path'#000+
   '**1k<x>_Pass <x> to the linker'#000+
   '**1l_write logo'#000+
   '**1n_don'#039't read the default config file'#000+
-  '**1o<x>_change the name of the executable produced to <x>'#000+
+  '**','1o<x>_change the name of the executable produced to <x>'#000+
   '**1pg_generate profile code for gprof'#000+
-  '*L','1P_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+
-  '**2Sc_supports operators like C (*=,+=,/= and -=)'#000+
+  '**2Sc_supports opera','tors 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_support macros like C (glob','al)'#000+
   '**2So_tries to be TP/BP 7.0 compatible'#000+
   '**2Sp_tries to be gpc compatible'#000+
-  '**2Ss_constructor na','me 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+
-  '**1u<x>_undefines the symbol <x>'#000+
+  '**1u<x>_unde','fines the symbol <x>'#000+
   '**1U_unit options:'#000+
   '**2Un_don'#039't check the unit name'#000+
-  '**2Us_compile a system u','nit'#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*_w : Show warnings               u : Show unit info'#000+
-  '**2*_n : Show notes                  t : Show tried/used',' files'#000+
+  '**2*_w : Show wa','rnings               u : Show unit info'#000+
+  '**2*_n : Show notes                  t : Show tried/used files'#000+
   '**2*_h : Show hints                  m : Show defined macros'#000+
   '**2*_i : Show general info           p : Show compiled procedures'#000+
-  '**2*_l : Show linenumbers            c : Show conditionals'#000+
-  '**2*_a : Show everything             0 : Show n','othing (except errors'+
-  ')'#000+
+  '**2*_l : S','how linenumbers            c : Show conditionals'#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 an error    x : Executable',' info (Win32 only'+
+  ')'#000+
   '**2*_    occurs'#000+
   '**1X_executable options:'#000+
   '*L2Xc_link with the c library'#000+
-  '**2XD_','link with dynamic libraries (defines FPC_LINK_DYNAMIC)'#000+
+  '**2XD_link with dynamic libraries (defines FPC_LINK_DYNAMIC)'#000+
   '**2Xs_strip all symbols from executable'#000+
-  '**2XS_link with static libraries (defines FPC_LINK_STATIC)'#000+
+  '**2XS_link with static libraries (defines FPC_LIN','K_STATIC)'#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*2Aasaout_assemble using GNU AS for aout (Go32v1)'#000+
   '3*2Anasmcoff_coff (Go32v2) file using Nasm'#000+
   '3*2Anasmelf_elf32 (Linux) file using Nasm'#000+
-  '3*2Anasmobj_obj file using Nasm'#000+
+  '3*2Anasmo','bj_obj file using Nasm'#000+
   '3*2Amasm_obj file using Masm (Microsoft)'#000+
-  '3*2Atasm_obj file using Tasm (Bo','rland)'#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*1R<x>_assembler reading style:'#000+
-  '3*2Ratt_read AT&T style assembler'#000+
+  '3*2Ratt_rea','d AT&T style assembler'#000+
   '3*2Rintel_read Intel style assembler'#000+
-  '3*2Rdirect_copy assembler text direc','tly to assembler file'#000+
+  '3*2Rdirect_copy assembler text directly to assembler file'#000+
   '3*1O<x>_optimizations:'#000+
   '3*2Og_generate smaller code'#000+
   '3*2OG_generate faster code (default)'#000+
-  '3*2Or_keep certain variables in registers (still BUGGY!!!)'#000+
+  '3*2Or_keep certain variables in re','gisters (still BUGGY!!!)'#000+
   '3*2Ou_enable uncertain optimizations (see docs)'#000+
-  '3*2O1_level 1 optimizat','ions (quick optimizations)'#000+
+  '3*2O1_level 1 optimizations (quick optimizations)'#000+
   '3*2O2_level 2 optimizations (-O1 + slower optimizations)'#000+
   '3*2O3_level 3 optimizations (same as -O2u)'#000+
-  '3*2Op<x>_target processor:'#000+
+  '3*2Op<x>_target p','rocessor:'#000+
   '3*3Op1_set target processor to 386/486'#000+
-  '3*3Op2_set target processor to Pentium/PentiumM','MX (tm)'#000+
+  '3*3Op2_set target processor to Pentium/PentiumMMX (tm)'#000+
   '3*3Op3_set target processor to PPro/PII/c6x86/K6 (tm)'#000+
   '3*1T<x>_Target operating system:'#000+
   '3*2TGO32V1_version 1 of DJ Delorie DOS extender'#000+
-  '3*2TGO32V2_version 2 of DJ Delorie DOS extender'#000+
+  '3','*2TGO32V2_version 2 of DJ Delorie DOS extender'#000+
   '3*2TLINUX_Linux'#000+
   '3*2TOS2_OS/2 2.x'#000+
-  '3*2TWin32_Window','s 32 Bit'#000+
+  '3*2TWin32_Windows 32 Bit'#000+
   '6*1A<x>_output format'#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*2Amot_Standard Moto','rola assembler'#000+
   '6*1O_optimizations:'#000+
   '6*2Oa_turn on the optimizer'#000+
   '6*2Og_generate smaller code'#000+
-  '6*2OG','_generate faster code (default)'#000+
+  '6*2OG_generate faster code (default)'#000+
   '6*2Ox_optimize maximum (still BUGGY!!!)'#000+
   '6*2O2_set target processor to a MC68020+'#000+
-  '6*1R<x>_assembler reading style:'#000+
+  '6*1R<x>_assembler reading style',':'#000+
   '6*2RMOT_read motorola style assembler'#000+
   '6*1T<x>_Target operating system:'#000+
-  '6*2TAMIGA_Commodore Ami','ga'#000+
+  '6*2TAMIGA_Commodore Amiga'#000+
   '6*2TATARI_Atari ST/STe/TT'#000+
   '6*2TMACOS_Macintosh m68k'#000+
   '6*2TLINUX_Linux-68k'#000+

compiler/ra386att.pas

@@ -1180,6 +1180,8 @@ end;
 
 
 Procedure T386ATTOperand.BuildOperand;
+var
+  expr : string;
 
   procedure AddLabelOperand(hl:pasmlabel);
   begin
@@ -1196,6 +1198,36 @@ Procedure T386ATTOperand.BuildOperand;
      end;
   end;
 
+  procedure MaybeRecordOffset;
+  var
+    l,
+    toffset,
+    tsize   : longint;
+  begin
+    if not(actasmtoken in [AS_DOT,AS_PLUS,AS_MINUS]) then
+     exit;
+    l:=0;
+    if actasmtoken=AS_DOT then
+     begin
+       if expr<>'' then
+         begin
+           BuildRecordOffsetSize(expr,toffset,tsize);
+           inc(l,toffset);
+           SetSize(tsize);
+         end;
+     end;
+    if actasmtoken in [AS_PLUS,AS_MINUS] then
+     inc(l,BuildConstExpression(true,false));
+    if opr.typ=OPR_REFERENCE then
+     begin
+       if opr.ref.options=ref_parafixup then
+        Message(asmr_e_cannot_access_field_directly_for_parameters);
+       inc(opr.ref.offset,l)
+     end
+    else
+     inc(opr.val,l);
+  end;
+
   function MaybeBuildReference:boolean;
   { Try to create a reference, if not a reference is found then false
     is returned }
@@ -1218,7 +1250,7 @@ Procedure T386ATTOperand.BuildOperand;
         Begin
           if not SetupVar(actasmpattern) then
             Message(asmr_e_invalid_reference_syntax);
-          Consume(actasmtoken);
+          Consume(AS_ID);
           case actasmtoken of
             AS_END,
             AS_SEPARATOR,
@@ -1237,12 +1269,10 @@ Procedure T386ATTOperand.BuildOperand;
   end;
 
 var
-  expr,
   tempstr : string;
   tempreg : tregister;
   hl      : PAsmLabel;
-  tsize,l,
-  toffset : longint;
+  l       : longint;
 Begin
   tempstr:='';
   expr:='';
@@ -1360,23 +1390,12 @@ Begin
             begin
               expr:=actasmpattern;
               Consume(AS_ID);
-              if actasmtoken=AS_DOT then
-               begin
-                 BuildRecordOffsetSize(expr,toffset,tsize);
-                 inc(opr.ref.offset,toffset);
-                 SetSize(tsize);
-               end;
+              MaybeRecordOffset;
             end;
          end;
-        if opr.typ=OPR_REFERENCE then
-         begin
-           { Do we have a +[constant] ? }
-           if actasmtoken in [AS_PLUS,AS_MINUS] then
-            inc(opr.ref.offset,BuildConstExpression(true,false));
-           { Do we have a indexing reference, then parse it also }
-           if actasmtoken=AS_LPAREN then
-             BuildReference;
-         end;
+        { Do we have a indexing reference, then parse it also }
+        if actasmtoken=AS_LPAREN then
+         BuildReference;
       end;
 
     AS_REGISTER: { Register, a variable reference or a constant reference  }
@@ -1954,7 +1973,11 @@ begin
 end.
 {
   $Log$
-  Revision 1.57  1999-08-05 16:53:08  peter
+  Revision 1.58  1999-09-08 16:04:01  peter
+    * better support for object fields and more error checks for
+      field accesses which create buggy code
+
+  Revision 1.57  1999/08/05 16:53:08  peter
     * V_Fatal=1, all other V_ are also increased
     * Check for local procedure when assigning procvar
     * fixed comment parsing because directives

compiler/ra386int.pas

@@ -1205,6 +1205,8 @@ var
     toffset,
     tsize   : longint;
   begin
+    if not(actasmtoken in [AS_DOT,AS_PLUS,AS_MINUS]) then
+     exit;
     l:=0;
     if actasmtoken=AS_DOT then
      begin
@@ -1237,7 +1239,17 @@ var
     if actasmtoken in [AS_PLUS,AS_MINUS] then
      inc(l,BuildConstExpression);
     if opr.typ=OPR_REFERENCE then
-     inc(opr.ref.offset,l)
+     begin
+       { don't allow direct access to fields of parameters, becuase that
+         will generate buggy code }
+       case opr.ref.options of
+         ref_parafixup :
+           Message(asmr_e_cannot_access_field_directly_for_parameters);
+         ref_selffixup :
+           Message(asmr_e_cannot_access_object_field_directly);
+       end;
+       inc(opr.ref.offset,l)
+     end
     else
      inc(opr.val,l);
   end;
@@ -1339,8 +1351,8 @@ Begin
                      reset_reference(opr.Ref);
                    end;
                   BuildReference;
+                  MaybeRecordOffset;
                 end;
-               MaybeRecordOffset;
              end;
          end;
       end;
@@ -1740,7 +1752,11 @@ begin
 end.
 {
   $Log$
-  Revision 1.45  1999-09-07 13:03:10  peter
+  Revision 1.46  1999-09-08 16:04:03  peter
+    * better support for object fields and more error checks for
+      field accesses which create buggy code
+
+  Revision 1.45  1999/09/07 13:03:10  peter
     * better OFFSET support for reference reading
 
   Revision 1.44  1999/09/07 07:45:41  peter

compiler/rautils.pas

@@ -691,8 +691,10 @@ Begin
   SetupSelf:=false;
   if assigned(procinfo._class) then
    Begin
+     opr.typ:=OPR_REFERENCE;
      opr.ref.offset:=procinfo.ESI_offset;
      opr.ref.base:=procinfo.framepointer;
+     opr.ref.options:=ref_selffixup;
      SetupSelf:=true;
    end
   else
@@ -737,6 +739,17 @@ Begin
         pvarsym(sym)^.varstate:=vs_used;
         inc(pvarsym(sym)^.refs);
         case pvarsym(sym)^.owner^.symtabletype of
+          objectsymtable :
+            begin
+              { this is not allowed, because we don't know if the self
+                register is still free, and loading it first is also
+                not possible, because this could break code }
+              opr.typ:=OPR_CONSTANT;
+              opr.val:=pvarsym(sym)^.address;
+              hasvar:=true;
+              SetupVar:=true;
+              Exit;
+            end;
           unitsymtable,
           globalsymtable,
           staticsymtable :
@@ -1146,39 +1159,44 @@ Begin
    i:=255;
   base:=Copy(s,1,i-1);
   delete(s,1,i);
-  getsym(base,false);
-  sym:=srsym;
-  st:=nil;
-  { we can start with a var,type,typedconst }
-  case sym^.typ of
-    varsym :
-      begin
-        case pvarsym(sym)^.definition^.deftype of
-          recorddef :
-            st:=precorddef(pvarsym(sym)^.definition)^.symtable;
-          objectdef :
-            st:=pobjectdef(pvarsym(sym)^.definition)^.symtable;
-        end;
-      end;
-    typesym :
-      begin
-        case ptypesym(sym)^.definition^.deftype of
-          recorddef :
-            st:=precorddef(ptypesym(sym)^.definition)^.symtable;
-          objectdef :
-            st:=pobjectdef(ptypesym(sym)^.definition)^.symtable;
-        end;
-      end;
-    typedconstsym :
-      begin
-        case pvarsym(sym)^.definition^.deftype of
-          recorddef :
-            st:=precorddef(ptypedconstsym(sym)^.definition)^.symtable;
-          objectdef :
-            st:=pobjectdef(ptypedconstsym(sym)^.definition)^.symtable;
-        end;
-      end;
-  end;
+  if base='SELF' then
+   st:=procinfo._class^.symtable
+  else
+   begin
+     getsym(base,false);
+     sym:=srsym;
+     st:=nil;
+     { we can start with a var,type,typedconst }
+     case sym^.typ of
+       varsym :
+         begin
+           case pvarsym(sym)^.definition^.deftype of
+             recorddef :
+               st:=precorddef(pvarsym(sym)^.definition)^.symtable;
+             objectdef :
+               st:=pobjectdef(pvarsym(sym)^.definition)^.symtable;
+           end;
+         end;
+       typesym :
+         begin
+           case ptypesym(sym)^.definition^.deftype of
+             recorddef :
+               st:=precorddef(ptypesym(sym)^.definition)^.symtable;
+             objectdef :
+               st:=pobjectdef(ptypesym(sym)^.definition)^.symtable;
+           end;
+         end;
+       typedconstsym :
+         begin
+           case pvarsym(sym)^.definition^.deftype of
+             recorddef :
+               st:=precorddef(ptypedconstsym(sym)^.definition)^.symtable;
+             objectdef :
+               st:=pobjectdef(ptypedconstsym(sym)^.definition)^.symtable;
+           end;
+         end;
+     end;
+   end;
   { now walk all recordsymtables }
   while assigned(st) and (s<>'') do
    begin
@@ -1189,6 +1207,11 @@ Begin
      base:=Copy(s,1,i-1);
      delete(s,1,i);
      sym:=st^.search(base);
+     if not assigned(sym) then
+      begin
+        GetRecordOffsetSize:=false;
+        exit;
+      end;
      st:=nil;
      case sym^.typ of
        varsym :
@@ -1410,7 +1433,11 @@ end;
 end.
 {
   $Log$
-  Revision 1.25  1999-09-04 20:29:11  florian
+  Revision 1.26  1999-09-08 16:04:04  peter
+    * better support for object fields and more error checks for
+      field accesses which create buggy code
+
+  Revision 1.25  1999/09/04 20:29:11  florian
     * bug 577 fixed
 
   Revision 1.24  1999/08/27 14:37:50  peter