소스 검색

+ {$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 -

Jonas Maebe 14 년 전
부모
커밋
f96f5f9e94
10개의 변경된 파일199개의 추가작업 그리고 100개의 파일을 삭제
  1. 3 1
      compiler/globtype.pas
  2. 51 5
      compiler/jvm/njvmcal.pas
  3. 2 0
      compiler/msg/errore.msg
  4. 1 1
      compiler/msgidx.inc
  5. 91 91
      compiler/msgtxt.inc
  6. 8 0
      compiler/options.pas
  7. 11 0
      compiler/scandir.pas
  8. 15 2
      compiler/symdef.pas
  9. 3 0
      rtl/java/compproc.inc
  10. 14 0
      rtl/java/system.pp

+ 3 - 1
compiler/globtype.pas

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

+ 51 - 5
compiler/jvm/njvmcal.pas

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

+ 2 - 0
compiler/msg/errore.msg

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

+ 1 - 1
compiler/msgidx.inc

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

+ 91 - 91
compiler/msgtxt.inc

@@ -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<','x>_Set the directory where to search for compiler utilities'#010+
+  '**2Fd_Disable the ','compiler'#039's internal directory cache'#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+
-  '**2Fl<x>_Add <x> to',' library path'#010+
+  '**2Fi<x>_A','dd <x> to include 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+
-  '**2Fu<x','>_Add <x> to unit path'#010+
+  '**2FR<x>','_Set resource (.res) linker to <x>'#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'+
-  'om <x>'#010+
-  '*g1g_Generate debug ','information (default format for target)'#010+
+  '**2Fw<x>_Load previously stored whole-program optimizat','ion feedback '+
+  'from <x>'#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+
-  '*g3g','odwarfsets_ Enable DWARF '#039'set'#039' type debug information (b'+
-  'reaks gdb < 6.5)'#010+
+  '*','g2go<x>_Set debug information options'#010+
+  '*g3godwarfsets_ Enable DWARF '#039'set'#039' type debug information (bre'+
+  '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'+
-  'ame'#010+
-  '*g2gp_Preserve case in',' stabs symbol names'#010+
+  '*g3godwarfmethodclassprefix_ Prefix method names in DW','ARF with class'+
+  ' name'#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+
-  '*g2gw2_Generate D','WARFv2 debug information'#010+
+  '*g2gw_Generate DWARFv2 debug in','formation (same as -gw2)'#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+
-  '**2Mfpc_Fr','ee Pascal dialect (default)'#010+
+  '*','*1M<x>_Set language mode to <x>'#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+
-  '**1n_Do not read the default confi','g files'#010+
+  '**2Mmacpas_Macintosh Pascal dialects compatibili','ty mode'#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+
-  '**2O2_Level 2 ','optimizations (-O1 + quick optimizations)'#010+
+  '**2O1_Level 1 optimizations (q','uick and debugger friendly)'#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+
-  '**2Op<x>_Set target cpu for optimizing,',' see fpc -i for possible valu'+
-  'es'#010+
+  'valu','es'#010+
+  '**2Op<x>_Set target cpu for optimizing, see fpc -i for possible values'+
+  #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'+
-  'le values'#010+
-  '**2Os_Optimize for si','ze rather than speed'#010+
+  '**2Ow<x>_Perform whole-program optimization <x>, see fpc -i',' for poss'+
+  'ible values'#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+
-  '6*2RMOT_Re','ad motorola style assembler'#010+
+  '3*2Ri','ntel_Read Intel 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+
-  '**3*_','<n> : Compiler halts after the <n> errors (default is 1)'#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*_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+
-  '**3SIcom_COM compatible in','terface (default)'#010+
+  '**2SI<x>_Set interfa','ce style to <x>'#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+
-  '*','*2Sy_@<pointer> returns a typed pointer, same as $T+'#010+
+  '**2Sx_Enable exception k','eywords (default in Delphi/ObjFPC modes)'#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+
-  '**1T<x>_Target ope','rating system:'#010+
+  '**2sr_Skip register allocatio','n phase (use with -alr)'#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'+
-  'rwin)'#010+
-  '3*2T','linux_Linux'#010+
+  '3*2Tiphonesim_ iPhoneSimulator from iO','S SDK 3.2+ (older versions: -T'+
+  'darwin)'#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*2Tatari_Atari ST/STe/TT'#010,
+  '6*2Tamiga_','Commodore Amiga'#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+
-  '**1v<x>_Be verbose. <x> is',' a combination of the following letters:'#010+
+  '**2Us_Compil','e a system unit'#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*_h : S','how hints                  c : Show conditionals'#010+
+  '**2*_n : Show notes            ','      t : Show tried/used files'#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*_a : Show everything             x : Executable info (Win32 only'+
-  ')'#010+
+  '**2*_s : Show time sta','mps            q : Show message numbers'#010+
+  '**2*_a : Show everything             x : Executable info (Win32 only)'#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*_                              ','      lots of debugging info'#010+
+  '**2*_    with full path              v : Write fpcdebug.tx','t with'#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+
-  'A*2WA_Specify na','tive type application (Windows)'#010+
+  '4*2WA_Specify native t','ype 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*2WBxxxx_Set image base to xxxx (Windows',')'#010+
+  '4*2WB_Create a relocatable image (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+
-  'A*2WC_Specify ','console type application (Windows)'#010+
+  '4*2WC_Specify console type appli','cation (EMX, OS/2, 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+
-  'A*2WD_Use DEFFILE to expo','rt 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 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+
-  '3*2WF_Specify',' full-screen type application (EMX, OS/2)'#010+
+  'p*2We_Use',' external resources (Darwin)'#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+
-  'P*2WG_Specify graphic type ap','plication (Classic Mac OS)'#010+
+  'A*2WG_Specify graphic type applicati','on (Windows)'#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+
-  '3*2WI_Turn on/off the u','sage of import sections (Windows)'#010+
+  'p*2Wi_Use internal ','resources (Darwin)'#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+
-  '4*2WN_Do not generate ','relocation code, needed for debugging (Windows'+
+  '3*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'+
-  's '#039'main'#039')'#010+
-  '**2XP<x>_Pre','pend the binutils names with the prefix <x>'#010+
+  '**2XM<x>_Set the name of the '#039'main'#039' progra','m routine (default'+
+  ' is '#039'main'#039')'#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'+
-  ',',' Linux, Mac OS, Solaris)'#010+
+  '**2XR<x>_Prepend <x> to all l','inker search paths (BeOS, Darwin, FreeB'+
+  '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+
-  '**2XX_Try to smartlink units             (','defines FPC_LINK_SMART)'#010+
+  '**2Xt_Link with static libraries (-static is passed to linker)'#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'

+ 8 - 0
compiler/options.pas

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

+ 11 - 0
compiler/scandir.pas

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

+ 15 - 2
compiler/symdef.pas

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

+ 3 - 0
rtl/java/compproc.inc

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

+ 14 - 0
rtl/java/system.pp

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