paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-10-27 16:11:29 +01:00
Code Issues Packages Projects Releases Wiki Activity

* better support for object fields and more error checks for

Browse Source 
field accesses which create buggy code
This commit is contained in:
peter 1999-09-08 16:04:01 +00:00
parent 91962591f3
commit 05f2be0455
7 changed files with 219 additions and 138 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
compiler/cpubase.pas
View File

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

7
compiler/errore.msg
View File

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

2
compiler/msgidx.inc
View File

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

158
compiler/msgtxt.inc
View File

@ -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+
' fpc-devel@vekoll.saturnus.vein.hu'#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+

63
compiler/ra386att.pas
View File

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

22
compiler/ra386int.pas
View File

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

95
compiler/rautils.pas
View File

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