+ {$VARPARACOPYOUTCHECK+/-} / -Cv switch to enable checking

var-parameters on the JVM target for changes to the value passed
    as var-parameter during the function call (because they are handled
    via copy-in/copy-out, this may indicate unexpected bahviour later on).

    out-parameters are checked in the same way, except if the out-parameter
    is a local variable because then reading it before the call may result
    in a bytecode verification error (since the variable may not yet be
    initialized)

git-svn-id: branches/jvmbackend@19153 -
This commit is contained in:
Jonas Maebe 2011-09-19 19:59:26 +00:00
parent 6cb32de339
commit f96f5f9e94
10 changed files with 199 additions and 100 deletions

View File

@ -133,7 +133,9 @@ interface
cs_typed_addresses,cs_strict_var_strings,cs_refcountedstrings, cs_typed_addresses,cs_strict_var_strings,cs_refcountedstrings,
cs_bitpacking,cs_varpropsetter,cs_scopedenums,cs_pointermath, cs_bitpacking,cs_varpropsetter,cs_scopedenums,cs_pointermath,
{ macpas specific} { macpas specific}
cs_external_var, cs_externally_visible cs_external_var, cs_externally_visible,
{ jvm specific }
cs_check_var_copyout
); );
tlocalswitches = set of tlocalswitch; tlocalswitches = set of tlocalswitch;

View File

@ -64,7 +64,7 @@ implementation
cgutils,tgobj,procinfo,htypechk, cgutils,tgobj,procinfo,htypechk,
cpubase,aasmdata,aasmcpu, cpubase,aasmdata,aasmcpu,
hlcgobj,hlcgcpu, hlcgobj,hlcgcpu,
pass_1,nutils,nbas,ncnv,ncon,ninl,nld,nmem, pass_1,nutils,nadd,nbas,ncnv,ncon,nflw,ninl,nld,nmem,
jvmdef; jvmdef;
{***************************************************************************** {*****************************************************************************
@ -163,11 +163,12 @@ implementation
copybackstat, copybackstat,
finistat: tstatementnode; finistat: tstatementnode;
finiblock: tblocknode; finiblock: tblocknode;
realpara, tempn: tnode; realpara, tempn, unwrappedele0, unwrappedele1: tnode;
realparaparent: tunarynode; realparaparent: tunarynode;
realparatemp, arraytemp: ttempcreatenode; realparatemp, arraytemp: ttempcreatenode;
leftcopy: tnode; leftcopy: tnode;
implicitptrpara: boolean; implicitptrpara,
verifyout: boolean;
begin begin
{ implicit pointer types are already pointers -> no need to stuff them { implicit pointer types are already pointers -> no need to stuff them
in an array to pass them by reference (except in case of a formal in an array to pass them by reference (except in case of a formal
@ -226,16 +227,26 @@ implementation
arreledef:=getpointerdef(orgparadef) arreledef:=getpointerdef(orgparadef)
else else
arreledef:=parasym.vardef; arreledef:=parasym.vardef;
arrdef:=getsingletonarraydef(arreledef); arrdef:=getarraydef(arreledef,1+ord(cs_check_var_copyout in current_settings.localswitches));
{ the -1 means "use the array's element count to determine the number { the -1 means "use the array's element count to determine the number
of elements" in the JVM temp generator } of elements" in the JVM temp generator }
arraytemp:=ctempcreatenode.create(arrdef,-1,tt_persistent,true); arraytemp:=ctempcreatenode.create(arrdef,-1,tt_persistent,true);
addstatement(initstat,arraytemp); addstatement(initstat,arraytemp);
addstatement(finistat,ctempdeletenode.create(arraytemp)); addstatement(finistat,ctempdeletenode.create(arraytemp));
{ we can also check out-parameters if we are certain that they'll be
valid according to the JVM. That's basically everything except for
local variables (fields, arrays etc are all initialized on creation) }
verifyout:=
(cs_check_var_copyout in current_settings.localswitches) and
((left.actualtargetnode.nodetype<>loadn) or
(tloadnode(left.actualtargetnode).symtableentry.typ<>localvarsym));
{ in case of a non-out parameter, pass in the original value (also { in case of a non-out parameter, pass in the original value (also
always in case of implicitpointer type, since that pointer points to always in case of implicitpointer type, since that pointer points to
the data that will be changed by the callee) } the data that will be changed by the callee) }
if (parasym.varspez<>vs_out) or if (parasym.varspez<>vs_out) or
verifyout or
((parasym.vardef.typ<>formaldef) and ((parasym.vardef.typ<>formaldef) and
implicitptrpara) then implicitptrpara) then
begin begin
@ -261,6 +272,11 @@ implementation
addstatement(initstat,cassignmentnode.create( addstatement(initstat,cassignmentnode.create(
cvecnode.create(ctemprefnode.create(arraytemp),genintconstnode(0)), cvecnode.create(ctemprefnode.create(arraytemp),genintconstnode(0)),
left)); left));
{ and the copy for checking }
if (cs_check_var_copyout in current_settings.localswitches) then
addstatement(initstat,cassignmentnode.create(
cvecnode.create(ctemprefnode.create(arraytemp),genintconstnode(1)),
cvecnode.create(ctemprefnode.create(arraytemp),genintconstnode(0))));
end end
else else
left.free; left.free;
@ -295,7 +311,37 @@ implementation
tempn:=ctypeconvnode.create_explicit(tempn,getpointerdef(orgparadef)) tempn:=ctypeconvnode.create_explicit(tempn,getpointerdef(orgparadef))
end; end;
if implicitptrpara then if implicitptrpara then
tempn:=cderefnode.create(tempn); tempn:=cderefnode.create(tempn)
else
begin
{ add check to determine whether the location passed as
var-parameter hasn't been modified directly to a different
value than the returned var-parameter in the mean time }
if ((parasym.varspez=vs_var) or
verifyout) and
(cs_check_var_copyout in current_settings.localswitches) then
begin
unwrappedele0:=cvecnode.create(ctemprefnode.create(arraytemp),genintconstnode(0));
unwrappedele1:=cvecnode.create(ctemprefnode.create(arraytemp),genintconstnode(1));
if (parasym.vardef.typ=formaldef) and
(orgparadef.typ in [orddef,floatdef]) then
begin
unwrappedele0:=cinlinenode.create(in_unbox_x_y,false,ccallparanode.create(
ctypenode.create(orgparadef),ccallparanode.create(unwrappedele0,nil)));
unwrappedele1:=cinlinenode.create(in_unbox_x_y,false,ccallparanode.create(
ctypenode.create(orgparadef),ccallparanode.create(unwrappedele1,nil)))
end;
addstatement(copybackstat,cifnode.create(
caddnode.create(andn,
caddnode.create(unequaln,leftcopy.getcopy,ctypeconvnode.create_explicit(unwrappedele0,orgparadef)),
caddnode.create(unequaln,leftcopy.getcopy,ctypeconvnode.create_explicit(unwrappedele1,orgparadef))),
ccallnode.createintern('fpc_var_copyout_mismatch',
ccallparanode.create(genintconstnode(fileinfo.column),
ccallparanode.create(genintconstnode(fileinfo.line),nil))
),nil
));
end;
end;
addstatement(copybackstat,cassignmentnode.create(leftcopy, addstatement(copybackstat,cassignmentnode.create(leftcopy,
ctypeconvnode.create_explicit(tempn,orgparadef))); ctypeconvnode.create_explicit(tempn,orgparadef)));
end end

View File

@ -3143,6 +3143,7 @@ or
# P = PowerPC targets # P = PowerPC targets
# S = Sparc targets # S = Sparc targets
# V = Virtual machine targets # V = Virtual machine targets
# J = JVM
# The second character also indicates who will display this line, # The second character also indicates who will display this line,
# (if the above character was TRUE) the current possibilities are : # (if the above character was TRUE) the current possibilities are :
# * = everyone # * = everyone
@ -3212,6 +3213,7 @@ S*2Aas_Assemble using GNU AS
**2CR_Verify object method call validity **2CR_Verify object method call validity
**2Cs<n>_Set stack checking size to <n> **2Cs<n>_Set stack checking size to <n>
**2Ct_Stack checking (for testing only, see manual) **2Ct_Stack checking (for testing only, see manual)
J*2Cv_Var/out parameter copy-out checking
**2CX_Create also smartlinked library **2CX_Create also smartlinked library
**1d<x>_Defines the symbol <x> **1d<x>_Defines the symbol <x>
**1D_Generate a DEF file **1D_Generate a DEF file

View File

@ -914,7 +914,7 @@ const
option_info=11024; option_info=11024;
option_help_pages=11025; option_help_pages=11025;
MsgTxtSize = 62246; MsgTxtSize = 62288;
MsgIdxMax : array[1..20] of longint=( MsgIdxMax : array[1..20] of longint=(
26,90,321,107,87,54,111,23,202,63, 26,90,321,107,87,54,111,23,202,63,

View File

@ -1194,151 +1194,152 @@ const msgtxt : array[0..000259,1..240] of char=(
'**2CR_Verify object method call validity'#010+ '**2CR_Verify object method call validity'#010+
'**2Cs<n>_Set stack checking size to <n>'#010+ '**2Cs<n>_Set stack checking size to <n>'#010+
'**2Ct_Stack checking (for testing only, see manual)'#010+ '**2Ct_Stack checking (for testing only, see manual)'#010+
'**2CX_Create a','lso smartlinked library'#010+ 'J*2Cv_Var/out ','parameter copy-out checking'#010+
'**2CX_Create also smartlinked library'#010+
'**1d<x>_Defines the symbol <x>'#010+ '**1d<x>_Defines the symbol <x>'#010+
'**1D_Generate a DEF file'#010+ '**1D_Generate a DEF file'#010+
'**2Dd<x>_Set description to <x>'#010+ '**2Dd<x>_Set description to <x>'#010+
'**2Dv<x>_Set DLL version to <x>'#010+ '**2Dv<x>_Set DLL version to <x>'#010+
'*O2Dw_PM application'#010+ '*O2Dw_PM application'#010+
'**1e<x>_Set path to executable'#010+ '**1e<x>_Set path to executable'#010+
'**1E_Same as -Cn'#010+ '**','1E_Same as -Cn'#010+
'**1fPIC_Same as -Cg'#010+ '**1fPIC_Same as -Cg'#010+
'**1F<x>','_Set file names and paths:'#010+ '**1F<x>_Set file names and paths:'#010+
'**2Fa<x>[,y]_(for a program) load units <x> and [y] before uses is par'+ '**2Fa<x>[,y]_(for a program) load units <x> and [y] before uses is par'+
'sed'#010+ 'sed'#010+
'**2Fc<x>_Set input codepage to <x>'#010+ '**2Fc<x>_Set input codepage to <x>'#010+
'**2FC<x>_Set RC compiler binary name to <x>'#010+ '**2FC<x>_Set RC compiler binary name to <x>'#010+
'**2Fd_Disable the compiler'#039's internal directory cache'#010+ '**2Fd_Disable the ','compiler'#039's internal directory cache'#010+
'**2FD<','x>_Set the directory where to search for compiler utilities'#010+ '**2FD<x>_Set the directory where to search for compiler utilities'#010+
'**2Fe<x>_Redirect error output to <x>'#010+ '**2Fe<x>_Redirect error output to <x>'#010+
'**2Ff<x>_Add <x> to framework path (Darwin only)'#010+ '**2Ff<x>_Add <x> to framework path (Darwin only)'#010+
'**2FE<x>_Set exe/unit output path to <x>'#010+ '**2FE<x>_Set exe/unit output path to <x>'#010+
'**2Fi<x>_Add <x> to include path'#010+ '**2Fi<x>_A','dd <x> to include path'#010+
'**2Fl<x>_Add <x> to',' library path'#010+ '**2Fl<x>_Add <x> to library path'#010+
'**2FL<x>_Use <x> as dynamic linker'#010+ '**2FL<x>_Use <x> as dynamic linker'#010+
'**2Fm<x>_Load unicode conversion table from <x>.txt in the compiler di'+ '**2Fm<x>_Load unicode conversion table from <x>.txt in the compiler di'+
'r'#010+ 'r'#010+
'**2Fo<x>_Add <x> to object path'#010+ '**2Fo<x>_Add <x> to object path'#010+
'**2Fr<x>_Load error message file <x>'#010+ '**2Fr<x>_Load error message file <x>'#010+
'**2FR<x>_Set resource (.res) linker to <x>'#010+ '**2FR<x>','_Set resource (.res) linker to <x>'#010+
'**2Fu<x','>_Add <x> to unit path'#010+ '**2Fu<x>_Add <x> to unit path'#010+
'**2FU<x>_Set unit output path to <x>, overrides -FE'#010+ '**2FU<x>_Set unit output path to <x>, overrides -FE'#010+
'**2FW<x>_Store generated whole-program optimization feedback in <x>'#010+ '**2FW<x>_Store generated whole-program optimization feedback in <x>'#010+
'**2Fw<x>_Load previously stored whole-program optimization feedback fr'+ '**2Fw<x>_Load previously stored whole-program optimizat','ion feedback '+
'om <x>'#010+ 'from <x>'#010+
'*g1g_Generate debug ','information (default format for target)'#010+ '*g1g_Generate debug information (default format for target)'#010+
'*g2gc_Generate checks for pointers'#010+ '*g2gc_Generate checks for pointers'#010+
'*g2gh_Use heaptrace unit (for memory leak/corruption debugging)'#010+ '*g2gh_Use heaptrace unit (for memory leak/corruption debugging)'#010+
'*g2gl_Use line info unit (show more info with backtraces)'#010+ '*g2gl_Use line info unit (show more info with backtraces)'#010+
'*g2go<x>_Set debug information options'#010+ '*','g2go<x>_Set debug information options'#010+
'*g3g','odwarfsets_ Enable DWARF '#039'set'#039' type debug information (b'+ '*g3godwarfsets_ Enable DWARF '#039'set'#039' type debug information (bre'+
'reaks gdb < 6.5)'#010+ 'aks gdb < 6.5)'#010+
'*g3gostabsabsincludes_ Store absolute/full include file paths in Stabs'+ '*g3gostabsabsincludes_ Store absolute/full include file paths in Stabs'+
#010+ #010+
'*g3godwarfmethodclassprefix_ Prefix method names in DWARF with class n'+ '*g3godwarfmethodclassprefix_ Prefix method names in DW','ARF with class'+
'ame'#010+ ' name'#010+
'*g2gp_Preserve case in',' stabs symbol names'#010+ '*g2gp_Preserve case in stabs symbol names'#010+
'*g2gs_Generate Stabs debug information'#010+ '*g2gs_Generate Stabs debug information'#010+
'*g2gt_Trash local variables (to detect uninitialized uses)'#010+ '*g2gt_Trash local variables (to detect uninitialized uses)'#010+
'*g2gv_Generates programs traceable with Valgrind'#010+ '*g2gv_Generates programs traceable with Valgrind'#010+
'*g2gw_Generate DWARFv2 debug information (same as -gw2)'#010+ '*g2gw_Generate DWARFv2 debug in','formation (same as -gw2)'#010+
'*g2gw2_Generate D','WARFv2 debug information'#010+ '*g2gw2_Generate DWARFv2 debug information'#010+
'*g2gw3_Generate DWARFv3 debug information'#010+ '*g2gw3_Generate DWARFv3 debug information'#010+
'*g2gw4_Generate DWARFv4 debug information (experimental)'#010+ '*g2gw4_Generate DWARFv4 debug information (experimental)'#010+
'**1i_Information'#010+ '**1i_Information'#010+
'**2iD_Return compiler date'#010+ '**2iD_Return compiler date'#010+
'**2iV_Return short compiler version'#010+ '**2iV_Return short compiler ve','rsion'#010+
'**2iW_Return full compiler version'#010+ '**2iW_Return full compiler version'#010+
'*','*2iSO_Return compiler OS'#010+ '**2iSO_Return compiler OS'#010+
'**2iSP_Return compiler host processor'#010+ '**2iSP_Return compiler host processor'#010+
'**2iTO_Return target OS'#010+ '**2iTO_Return target OS'#010+
'**2iTP_Return target processor'#010+ '**2iTP_Return target processor'#010+
'**1I<x>_Add <x> to include path'#010+ '**1I<x>_Add <x> to include path'#010+
'**1k<x>_Pass <x> to the linker'#010+ '**1k<x>_Pass <x> to the linker'#010+
'**1l_Write logo'#010+ '**1l_Write logo'#010+
'**1M<x>_Set language mode to <x>'#010+ '*','*1M<x>_Set language mode to <x>'#010+
'**2Mfpc_Fr','ee Pascal dialect (default)'#010+ '**2Mfpc_Free Pascal dialect (default)'#010+
'**2Mobjfpc_FPC mode with Object Pascal support'#010+ '**2Mobjfpc_FPC mode with Object Pascal support'#010+
'**2Mdelphi_Delphi 7 compatibility mode'#010+ '**2Mdelphi_Delphi 7 compatibility mode'#010+
'**2Mtp_TP/BP 7.0 compatibility mode'#010+ '**2Mtp_TP/BP 7.0 compatibility mode'#010+
'**2Mmacpas_Macintosh Pascal dialects compatibility mode'#010+ '**2Mmacpas_Macintosh Pascal dialects compatibili','ty mode'#010+
'**1n_Do not read the default confi','g files'#010+ '**1n_Do not read the default config files'#010+
'**1N<x>_Node tree optimizations'#010+ '**1N<x>_Node tree optimizations'#010+
'**2Nu_Unroll loops'#010+ '**2Nu_Unroll loops'#010+
'**1o<x>_Change the name of the executable produced to <x>'#010+ '**1o<x>_Change the name of the executable produced to <x>'#010+
'**1O<x>_Optimizations:'#010+ '**1O<x>_Optimizations:'#010+
'**2O-_Disable optimizations'#010+ '**2O-_Disable optimizations'#010+
'**2O1_Level 1 optimizations (quick and debugger friendly)'#010+ '**2O1_Level 1 optimizations (q','uick and debugger friendly)'#010+
'**2O2_Level 2 ','optimizations (-O1 + quick optimizations)'#010+ '**2O2_Level 2 optimizations (-O1 + quick optimizations)'#010+
'**2O3_Level 3 optimizations (-O2 + slow optimizations)'#010+ '**2O3_Level 3 optimizations (-O2 + slow optimizations)'#010+
'**2Oa<x>=<y>_Set alignment'#010+ '**2Oa<x>=<y>_Set alignment'#010+
'**2Oo[NO]<x>_Enable or disable optimizations, see fpc -i for possible '+ '**2Oo[NO]<x>_Enable or disable optimizations, see fpc -i for possible '+
'values'#010+ 'valu','es'#010+
'**2Op<x>_Set target cpu for optimizing,',' see fpc -i for possible valu'+ '**2Op<x>_Set target cpu for optimizing, see fpc -i for possible values'+
'es'#010+ #010+
'**2OW<x>_Generate whole-program optimization feedback for optimization'+ '**2OW<x>_Generate whole-program optimization feedback for optimization'+
' <x>, see fpc -i for possible values'#010+ ' <x>, see fpc -i for possible values'#010+
'**2Ow<x>_Perform whole-program optimization <x>, see fpc -i for possib'+ '**2Ow<x>_Perform whole-program optimization <x>, see fpc -i',' for poss'+
'le values'#010+ 'ible values'#010+
'**2Os_Optimize for si','ze rather than speed'#010+ '**2Os_Optimize for size rather than speed'#010+
'**1pg_Generate profile code for gprof (defines FPC_PROFILE)'#010+ '**1pg_Generate profile code for gprof (defines FPC_PROFILE)'#010+
'**1R<x>_Assembler reading style:'#010+ '**1R<x>_Assembler reading style:'#010+
'**2Rdefault_Use default assembler for target'#010+ '**2Rdefault_Use default assembler for target'#010+
'3*2Ratt_Read AT&T style assembler'#010+ '3*2Ratt_Read AT&T style assembler'#010+
'3*2Rintel_Read Intel style assembler'#010+ '3*2Ri','ntel_Read Intel style assembler'#010+
'6*2RMOT_Re','ad motorola style assembler'#010+ '6*2RMOT_Read motorola style assembler'#010+
'**1S<x>_Syntax options:'#010+ '**1S<x>_Syntax options:'#010+
'**2S2_Same as -Mobjfpc'#010+ '**2S2_Same as -Mobjfpc'#010+
'**2Sc_Support operators like C (*=,+=,/= and -=)'#010+ '**2Sc_Support operators like C (*=,+=,/= and -=)'#010+
'**2Sa_Turn on assertions'#010+ '**2Sa_Turn on assertions'#010+
'**2Sd_Same as -Mdelphi'#010+ '**2Sd_Same as -Mdelphi'#010+
'**2Se<x>_Error options. <x> is a combination of the following:'#010+ '**2Se<x>_Error options. <x','> is a combination of the following:'#010+
'**3*_','<n> : Compiler halts after the <n> errors (default is 1)'#010+ '**3*_<n> : Compiler halts after the <n> errors (default is 1)'#010+
'**3*_w : Compiler also halts after warnings'#010+ '**3*_w : Compiler also halts after warnings'#010+
'**3*_n : Compiler also halts after notes'#010+ '**3*_n : Compiler also halts after notes'#010+
'**3*_h : Compiler also halts after hints'#010+ '**3*_h : Compiler also halts after hints'#010+
'**2Sg_Enable LABEL and GOTO (default in -Mtp and -Mdelphi',')'#010+ '**2Sg_Enable LA','BEL and GOTO (default in -Mtp and -Mdelphi)'#010+
'**2Sh_Use reference counted strings (ansistring by default) instead of'+ '**2Sh_Use reference counted strings (ansistring by default) instead of'+
' shortstrings'#010+ ' shortstrings'#010+
'**2Si_Turn on inlining of procedures/functions declared as "inline"'#010+ '**2Si_Turn on inlining of procedures/functions declared as "inline"'#010+
'**2Sk_Load fpcylix unit'#010+ '**2Sk_Load fpcylix unit'#010+
'**2SI<x>_Set interface style to <x>'#010+ '**2SI<x>_Set interfa','ce style to <x>'#010+
'**3SIcom_COM compatible in','terface (default)'#010+ '**3SIcom_COM compatible interface (default)'#010+
'**3SIcorba_CORBA compatible interface'#010+ '**3SIcorba_CORBA compatible interface'#010+
'**2Sm_Support macros like C (global)'#010+ '**2Sm_Support macros like C (global)'#010+
'**2So_Same as -Mtp'#010+ '**2So_Same as -Mtp'#010+
'**2Ss_Constructor name must be init (destructor must be done)'#010+ '**2Ss_Constructor name must be init (destructor must be done)'#010+
'**2Sx_Enable exception keywords (default in Delphi/ObjFPC modes)'#010+ '**2Sx_Enable exception k','eywords (default in Delphi/ObjFPC modes)'#010+
'*','*2Sy_@<pointer> returns a typed pointer, same as $T+'#010+ '**2Sy_@<pointer> returns a typed pointer, same as $T+'#010+
'**1s_Do not call assembler and linker'#010+ '**1s_Do not call assembler and linker'#010+
'**2sh_Generate script to link on host'#010+ '**2sh_Generate script to link on host'#010+
'**2st_Generate script to link on target'#010+ '**2st_Generate script to link on target'#010+
'**2sr_Skip register allocation phase (use with -alr)'#010+ '**2sr_Skip register allocatio','n phase (use with -alr)'#010+
'**1T<x>_Target ope','rating system:'#010+ '**1T<x>_Target operating system:'#010+
'3*2Tdarwin_Darwin/Mac OS X'#010+ '3*2Tdarwin_Darwin/Mac OS X'#010+
'3*2Temx_OS/2 via EMX (including EMX/RSX extender)'#010+ '3*2Temx_OS/2 via EMX (including EMX/RSX extender)'#010+
'3*2Tfreebsd_FreeBSD'#010+ '3*2Tfreebsd_FreeBSD'#010+
'3*2Tgo32v2_Version 2 of DJ Delorie DOS extender'#010+ '3*2Tgo32v2_Version 2 of DJ Delorie DOS extender'#010+
'3*2Tiphonesim_ iPhoneSimulator from iOS SDK 3.2+ (older versions: -Tda'+ '3*2Tiphonesim_ iPhoneSimulator from iO','S SDK 3.2+ (older versions: -T'+
'rwin)'#010+ 'darwin)'#010+
'3*2T','linux_Linux'#010+ '3*2Tlinux_Linux'#010+
'3*2Tnetbsd_NetBSD'#010+ '3*2Tnetbsd_NetBSD'#010+
'3*2Tnetware_Novell Netware Module (clib)'#010+ '3*2Tnetware_Novell Netware Module (clib)'#010+
'3*2Tnetwlibc_Novell Netware Module (libc)'#010+ '3*2Tnetwlibc_Novell Netware Module (libc)'#010+
'3*2Topenbsd_OpenBSD'#010+ '3*2Topenbsd_OpenBSD'#010+
'3*2Tos2_OS/2 / eComStation'#010+ '3*2Tos2_OS/2 / eComStation'#010+
'3*2Tsunos_SunOS/Solaris'#010+ '3*2Tsunos_SunOS/Solaris'#010+
'3*2Tsymbian_Symbian OS'#010+ '3*2Tsymbian_Sy','mbian OS'#010+
'3*2Tsolaris_Solaris'#010+ '3*2Tsolaris_Solaris'#010+
'3*2Twatcom_Wa','tcom compatible DOS extender'#010+ '3*2Twatcom_Watcom compatible DOS extender'#010+
'3*2Twdosx_WDOSX DOS extender'#010+ '3*2Twdosx_WDOSX DOS extender'#010+
'3*2Twin32_Windows 32 Bit'#010+ '3*2Twin32_Windows 32 Bit'#010+
'3*2Twince_Windows CE'#010+ '3*2Twince_Windows CE'#010+
'4*2Tdarwin_Darwin/Mac OS X'#010+ '4*2Tdarwin_Darwin/Mac OS X'#010+
'4*2Tlinux_Linux'#010+ '4*2Tlinux_Linux'#010+
'4*2Twin64_Win64 (64 bit Windows systems)'#010+ '4*2Twin64_Win64 (64 bit Windows systems)'#010+
'6*2Tamiga_Commodore Amiga'#010+ '6*2Tamiga_','Commodore Amiga'#010+
'6*2Tatari_Atari ST/STe/TT'#010, '6*2Tatari_Atari ST/STe/TT'#010+
'6*2Tlinux_Linux'#010+ '6*2Tlinux_Linux'#010+
'6*2Tpalmos_PalmOS'#010+ '6*2Tpalmos_PalmOS'#010+
'A*2Tdarwin_Darwin/iPhoneOS/iOS'#010+ 'A*2Tdarwin_Darwin/iPhoneOS/iOS'#010+
@ -1348,103 +1349,102 @@ const msgtxt : array[0..000259,1..240] of char=(
'P*2Tdarwin_Darwin/Mac OS X'#010+ 'P*2Tdarwin_Darwin/Mac OS X'#010+
'P*2Tlinux_Linux'#010+ 'P*2Tlinux_Linux'#010+
'P*2Tmacos_Mac OS (classic)'#010+ 'P*2Tmacos_Mac OS (classic)'#010+
'P*2Tmorphos_MorphOS'#010+ 'P*2Tmorp','hos_MorphOS'#010+
'S*2Tsolaris_Solaris'#010+ 'S*2Tsolaris_Solaris'#010+
'S*2Tlinux_','Linux'#010+ 'S*2Tlinux_Linux'#010+
'**1u<x>_Undefines the symbol <x>'#010+ '**1u<x>_Undefines the symbol <x>'#010+
'**1U_Unit options:'#010+ '**1U_Unit options:'#010+
'**2Un_Do not check where the unit name matches the file name'#010+ '**2Un_Do not check where the unit name matches the file name'#010+
'**2Ur_Generate release unit files (never automatically recompiled)'#010+ '**2Ur_Generate release unit files (never automatically recompiled)'#010+
'**2Us_Compile a system unit'#010+ '**2Us_Compil','e a system unit'#010+
'**1v<x>_Be verbose. <x> is',' a combination of the following letters:'#010+ '**1v<x>_Be verbose. <x> is a combination of the following letters:'#010+
'**2*_e : Show errors (default) 0 : Show nothing (except errors)'#010+ '**2*_e : Show errors (default) 0 : Show nothing (except errors)'#010+
'**2*_w : Show warnings u : Show unit info'#010+ '**2*_w : Show warnings u : Show unit info'#010+
'**2*_n : Show notes t : Show tried/used files'#010+ '**2*_n : Show notes ',' t : Show tried/used files'#010+
'**2*_h : S','how hints c : Show conditionals'#010+ '**2*_h : Show hints c : Show conditionals'#010+
'**2*_i : Show general info d : Show debug info'#010+ '**2*_i : Show general info d : Show debug info'#010+
'**2*_l : Show linenumbers r : Rhide/GCC compatibility mode'#010+ '**2*_l : Show linenumbers r : Rhide/GCC compatibility mode'#010+
'**2*_s : Show time stamps q : Show message numbers'#010+ '**2*_s : Show time sta','mps q : Show message numbers'#010+
'**','2*_a : Show everything x : Executable info (Win32 only'+ '**2*_a : Show everything x : Executable info (Win32 only)'#010+
')'#010+
'**2*_b : Write file names messages p : Write tree.log with parse tre'+ '**2*_b : Write file names messages p : Write tree.log with parse tre'+
'e'#010+ 'e'#010+
'**2*_ with full path v : Write fpcdebug.txt with'#010+ '**2*_ with full path v : Write fpcdebug.tx','t with'#010+
'**2*_ ',' lots of debugging info'#010+ '**2*_ lots of debugging info'#010+
'**2*_m<x>,<y> : Don'#039't show messages numbered <x> and <y>'#010+ '**2*_m<x>,<y> : Don'#039't show messages numbered <x> and <y>'#010+
'**1W<x>_Target-specific options (targets)'#010+ '**1W<x>_Target-specific options (targets)'#010+
'3*2WA_Specify native type application (Windows)'#010+ '3*2WA_Specify native type application (Windows)'#010+
'4*2WA_Specify native type application (Windows)'#010+ '4*2WA_Specify native t','ype application (Windows)'#010+
'A*2WA_Specify na','tive type application (Windows)'#010+ 'A*2WA_Specify native type application (Windows)'#010+
'3*2Wb_Create a bundle instead of a library (Darwin)'#010+ '3*2Wb_Create a bundle instead of a library (Darwin)'#010+
'P*2Wb_Create a bundle instead of a library (Darwin)'#010+ 'P*2Wb_Create a bundle instead of a library (Darwin)'#010+
'p*2Wb_Create a bundle instead of a library (Darwin)'#010+ 'p*2Wb_Create a bundle instead of a library (Darwin)'#010+
'A*2Wb_Create a bundle instead of a library (Darwin)'#010, 'A*2Wb_Crea','te a bundle instead of a library (Darwin)'#010+
'4*2Wb_Create a bundle instead of a library (Darwin)'#010+ '4*2Wb_Create a bundle instead of a library (Darwin)'#010+
'3*2WB_Create a relocatable image (Windows, Symbian)'#010+ '3*2WB_Create a relocatable image (Windows, Symbian)'#010+
'3*2WBxxxx_Set image base to xxxx (Windows, Symbian)'#010+ '3*2WBxxxx_Set image base to xxxx (Windows, Symbian)'#010+
'4*2WB_Create a relocatable image (Windows)'#010+ '4*2WB_Create a relocatable image (Windows)',#010+
'4*2WBxxxx_Set image base to xxxx (Windows',')'#010+ '4*2WBxxxx_Set image base to xxxx (Windows)'#010+
'A*2WB_Create a relocatable image (Windows, Symbian)'#010+ 'A*2WB_Create a relocatable image (Windows, Symbian)'#010+
'A*2WBxxxx_Set image base to xxxx (Windows, Symbian)'#010+ 'A*2WBxxxx_Set image base to xxxx (Windows, Symbian)'#010+
'3*2WC_Specify console type application (EMX, OS/2, Windows)'#010+ '3*2WC_Specify console type application (EMX, OS/2, Windows)'#010+
'4*2WC_Specify console type application (EMX, OS/2, Windows)'#010+ '4*2WC_Specify console type appli','cation (EMX, OS/2, Windows)'#010+
'A*2WC_Specify ','console type application (Windows)'#010+ 'A*2WC_Specify console type application (Windows)'#010+
'P*2WC_Specify console type application (Classic Mac OS)'#010+ 'P*2WC_Specify console type application (Classic Mac OS)'#010+
'3*2WD_Use DEFFILE to export functions of DLL or EXE (Windows)'#010+ '3*2WD_Use DEFFILE to export functions of DLL or EXE (Windows)'#010+
'4*2WD_Use DEFFILE to export functions of DLL or EXE (Windows)'#010+ '4*2WD_Use DEFFILE to export functions of DLL ','or EXE (Windows)'#010+
'A*2WD_Use DEFFILE to expo','rt functions of DLL or EXE (Windows)'#010+ 'A*2WD_Use DEFFILE to export functions of DLL or EXE (Windows)'#010+
'3*2We_Use external resources (Darwin)'#010+ '3*2We_Use external resources (Darwin)'#010+
'4*2We_Use external resources (Darwin)'#010+ '4*2We_Use external resources (Darwin)'#010+
'A*2We_Use external resources (Darwin)'#010+ 'A*2We_Use external resources (Darwin)'#010+
'P*2We_Use external resources (Darwin)'#010+ 'P*2We_Use external resources (Darwin)'#010+
'p*2We_Use external resources (Darwin)'#010+ 'p*2We_Use',' external resources (Darwin)'#010+
'3*2WF_Specify',' full-screen type application (EMX, OS/2)'#010+ '3*2WF_Specify full-screen type application (EMX, OS/2)'#010+
'3*2WG_Specify graphic type application (EMX, OS/2, Windows)'#010+ '3*2WG_Specify graphic type application (EMX, OS/2, Windows)'#010+
'4*2WG_Specify graphic type application (EMX, OS/2, Windows)'#010+ '4*2WG_Specify graphic type application (EMX, OS/2, Windows)'#010+
'A*2WG_Specify graphic type application (Windows)'#010+ 'A*2WG_Specify graphic type applicati','on (Windows)'#010+
'P*2WG_Specify graphic type ap','plication (Classic Mac OS)'#010+ 'P*2WG_Specify graphic type application (Classic Mac OS)'#010+
'3*2Wi_Use internal resources (Darwin)'#010+ '3*2Wi_Use internal resources (Darwin)'#010+
'4*2Wi_Use internal resources (Darwin)'#010+ '4*2Wi_Use internal resources (Darwin)'#010+
'A*2Wi_Use internal resources (Darwin)'#010+ 'A*2Wi_Use internal resources (Darwin)'#010+
'P*2Wi_Use internal resources (Darwin)'#010+ 'P*2Wi_Use internal resources (Darwin)'#010+
'p*2Wi_Use internal resources (Darwin)'#010+ 'p*2Wi_Use internal ','resources (Darwin)'#010+
'3*2WI_Turn on/off the u','sage of import sections (Windows)'#010+ '3*2WI_Turn on/off the usage of import sections (Windows)'#010+
'4*2WI_Turn on/off the usage of import sections (Windows)'#010+ '4*2WI_Turn on/off the usage of import sections (Windows)'#010+
'A*2WI_Turn on/off the usage of import sections (Windows)'#010+ 'A*2WI_Turn on/off the usage of import sections (Windows)'#010+
'3*2WN_Do not generate relocation code, needed for debugging (Windows)'#010+ '3*2WN_Do not generate relocation code, needed for ','debugging (Windows'+
'4*2WN_Do not generate ','relocation code, needed for debugging (Windows'+
')'#010+ ')'#010+
'4*2WN_Do not generate relocation code, needed for debugging (Windows)'#010+
'A*2WN_Do not generate relocation code, needed for debugging (Windows)'#010+ 'A*2WN_Do not generate relocation code, needed for debugging (Windows)'#010+
'A*2Wpxxxx_Specify the controller type, see fpc -i for possible values'#010+ 'A*2Wpxxxx_Specify the controller type, see fpc -i for possible values'#010+
'V*2Wpxxxx_Specify the controller type, see fpc -i fo','r possible value'+ 'V*2Wpxxxx_','Specify the controller type, see fpc -i for possible value'+
's'#010+ 's'#010+
'3*2WR_Generate relocation code (Windows)'#010+ '3*2WR_Generate relocation code (Windows)'#010+
'4*2WR_Generate relocation code (Windows)'#010+ '4*2WR_Generate relocation code (Windows)'#010+
'A*2WR_Generate relocation code (Windows)'#010+ 'A*2WR_Generate relocation code (Windows)'#010+
'P*2WT_Specify MPW tool type application (Classic Mac OS)'#010+ 'P*2WT_Specify MPW tool type application (Classic Mac OS)'#010,
'**2WX_Enable executable stack (Linux)'#010+ '**2WX_Enable executable stack (Linux)'#010+
'**1X','_Executable options:'#010+ '**1X_Executable options:'#010+
'**2Xc_Pass --shared/-dynamic to the linker (BeOS, Darwin, FreeBSD, Lin'+ '**2Xc_Pass --shared/-dynamic to the linker (BeOS, Darwin, FreeBSD, Lin'+
'ux)'#010+ 'ux)'#010+
'**2Xd_Do not use standard library search path (needed for cross compil'+ '**2Xd_Do not use standard library search path (needed for cross compil'+
'e)'#010+ 'e)'#010+
'**2Xe_Use external linker'#010+ '**2Xe_Use external linker'#010+
'**2Xg_Create debuginfo in a separate file and ','add a debuglink sectio'+ '**2X','g_Create debuginfo in a separate file and add a debuglink sectio'+
'n to executable'#010+ 'n to executable'#010+
'**2XD_Try to link units dynamically (defines FPC_LINK_DYNAMIC)'#010+ '**2XD_Try to link units dynamically (defines FPC_LINK_DYNAMIC)'#010+
'**2Xi_Use internal linker'#010+ '**2Xi_Use internal linker'#010+
'**2Xm_Generate link map'#010+ '**2Xm_Generate link map'#010+
'**2XM<x>_Set the name of the '#039'main'#039' program routine (default i'+ '**2XM<x>_Set the name of the '#039'main'#039' progra','m routine (default'+
's '#039'main'#039')'#010+ ' is '#039'main'#039')'#010+
'**2XP<x>_Pre','pend the binutils names with the prefix <x>'#010+ '**2XP<x>_Prepend the binutils names with the prefix <x>'#010+
'**2Xr<x>_Set the linker'#039's rlink-path to <x> (needed for cross comp'+ '**2Xr<x>_Set the linker'#039's rlink-path to <x> (needed for cross comp'+
'ile, see the ld manual for more information) (BeOS, Linux)'#010+ 'ile, see the ld manual for more information) (BeOS, Linux)'#010+
'**2XR<x>_Prepend <x> to all linker search paths (BeOS, Darwin, FreeBSD'+ '**2XR<x>_Prepend <x> to all l','inker search paths (BeOS, Darwin, FreeB'+
',',' Linux, Mac OS, Solaris)'#010+ 'SD, Linux, Mac OS, Solaris)'#010+
'**2Xs_Strip all symbols from executable'#010+ '**2Xs_Strip all symbols from executable'#010+
'**2XS_Try to link units statically (default, defines FPC_LINK_STATIC)'#010+ '**2XS_Try to link units statically (default, defines FPC_LINK_STATIC)'#010+
'**2Xt_Link with static libraries (-static is passed to linker)'#010+ '**2Xt_Link with static libraries (-static is passed to linker)'#010,
'**2XX_Try to smartlink units (','defines FPC_LINK_SMART)'#010+ '**2XX_Try to smartlink units (defines FPC_LINK_SMART)'#010+
'**1*_'#010+ '**1*_'#010+
'**1?_Show this help'#010+ '**1?_Show this help'#010+
'**1h_Shows this help without waiting' '**1h_Shows this help without waiting'

View File

@ -761,6 +761,14 @@ begin
exclude(init_settings.moduleswitches,cs_create_smart) exclude(init_settings.moduleswitches,cs_create_smart)
Else Else
include(init_settings.moduleswitches,cs_create_smart); include(init_settings.moduleswitches,cs_create_smart);
'v' :
If target_info.system=system_jvm_java32 then
If UnsetBool(More, j) then
exclude(init_settings.localswitches,cs_check_var_copyout)
Else
include(init_settings.localswitches,cs_check_var_copyout)
else
IllegalPara(opt)
else else
IllegalPara(opt); IllegalPara(opt);
end; end;

View File

@ -1142,6 +1142,16 @@ unit scandir;
end; end;
end; end;
procedure dir_varparacopyoutcheck;
begin
if target_info.system<>system_jvm_java32 then
begin
Message1(scan_w_illegal_switch,pattern);
exit;
end;
do_localswitch(cs_check_var_copyout);
end;
procedure dir_varpropsetter; procedure dir_varpropsetter;
begin begin
do_localswitch(cs_varpropsetter); do_localswitch(cs_varpropsetter);
@ -1525,6 +1535,7 @@ unit scandir;
AddDirective('TYPEDADDRESS',directive_all, @dir_typedaddress); AddDirective('TYPEDADDRESS',directive_all, @dir_typedaddress);
AddDirective('TYPEINFO',directive_all, @dir_typeinfo); AddDirective('TYPEINFO',directive_all, @dir_typeinfo);
AddDirective('UNITPATH',directive_all, @dir_unitpath); AddDirective('UNITPATH',directive_all, @dir_unitpath);
AddDirective('VARPARACOPYOUTCHECK',directive_all, @dir_varparacopyoutcheck);
AddDirective('VARPROPSETTER',directive_all, @dir_varpropsetter); AddDirective('VARPROPSETTER',directive_all, @dir_varpropsetter);
AddDirective('VARSTRINGCHECKS',directive_all, @dir_varstringchecks); AddDirective('VARSTRINGCHECKS',directive_all, @dir_varstringchecks);
AddDirective('VERSION',directive_all, @dir_version); AddDirective('VERSION',directive_all, @dir_version);

View File

@ -966,6 +966,7 @@ interface
{ returns an arraydef for an array containing a single array of def, resuing { returns an arraydef for an array containing a single array of def, resuing
an existing one in case it exists in the current module } an existing one in case it exists in the current module }
function getsingletonarraydef(def: tdef): tarraydef; function getsingletonarraydef(def: tdef): tarraydef;
function getarraydef(def: tdef; elecount: asizeint): tarraydef;
implementation implementation
@ -6653,18 +6654,30 @@ implementation
function getsingletonarraydef(def: tdef): tarraydef; function getsingletonarraydef(def: tdef): tarraydef;
begin
result:=getarraydef(def,1);
end;
function getarraydef(def: tdef; elecount: asizeint): tarraydef;
var var
res: PHashSetItem; res: PHashSetItem;
arrdesc: packed record
def: tdef;
elecount: asizeint;
end;
begin begin
if not assigned(current_module) then if not assigned(current_module) then
internalerror(2011081301); internalerror(2011081301);
res:=current_module.arraydefs.FindOrAdd(@def,sizeof(def)); arrdesc.def:=def;
arrdesc.elecount:=elecount;
res:=current_module.arraydefs.FindOrAdd(@arrdesc,sizeof(arrdesc));
if not assigned(res^.Data) then if not assigned(res^.Data) then
begin begin
{ since these arraydef can be reused anywhere in the current { since these arraydef can be reused anywhere in the current
unit, add them to the global/staticsymtable } unit, add them to the global/staticsymtable }
symtablestack.push(current_module.localsymtable); symtablestack.push(current_module.localsymtable);
res^.Data:=tarraydef.create(0,0,s32inttype); res^.Data:=tarraydef.create(0,elecount-1,ptrsinttype);
tarraydef(res^.Data).elementdef:=def; tarraydef(res^.Data).elementdef:=def;
symtablestack.pop(current_module.localsymtable); symtablestack.pop(current_module.localsymtable);
end; end;

View File

@ -674,6 +674,9 @@ function fpc_long_to_bitset(const val: jint; setbase, setsize: jint): FpcBitSet;
function fpc_enumset_to_bitset(const val: JUEnumSet; fromsetbase, tosetbase: jint): FpcBitSet; compilerproc; function fpc_enumset_to_bitset(const val: JUEnumSet; fromsetbase, tosetbase: jint): FpcBitSet; compilerproc;
function fpc_bitset_to_bitset(const s: FpcBitSet; fromsetbase, tosetbase: jint): FpcBitSet; compilerproc; function fpc_bitset_to_bitset(const s: FpcBitSet; fromsetbase, tosetbase: jint): FpcBitSet; compilerproc;
procedure fpc_var_copyout_mismatch(line,column: longint); compilerproc;
(* (*
{$ifdef FPC_SETBASE_USED} {$ifdef FPC_SETBASE_USED}
procedure fpc_varset_load(const l;sourcesize : longint;var dest;size,srcminusdstbase : ptrint); compilerproc; procedure fpc_varset_load(const l;sourcesize : longint;var dest;size,srcminusdstbase : ptrint); compilerproc;

View File

@ -135,6 +135,20 @@ procedure randomize;
randseed:=JUCalendar.getInstance.getTimeInMillis; randseed:=JUCalendar.getInstance.getTimeInMillis;
end; end;
type
CopyOutVarModifiedException = class(JLException)
end;
procedure fpc_var_copyout_mismatch(line,column: longint); compilerproc;
var
linestr,columnstr: unicodestring;
begin
str(line,linestr);
str(column,columnstr);
raise CopyOutVarModifiedException.create('Var parameter ending at line '+linestr+' column '+columnstr+' in the previous stack frame has been modified to a different value than the returned copyback value');
end;
{***************************************************************************** {*****************************************************************************
SystemUnit Initialization SystemUnit Initialization
*****************************************************************************} *****************************************************************************}