From 74510f90698cd1a56e03da3891cccff8d9eaed76 Mon Sep 17 00:00:00 2001 From: Jonas Maebe Date: Mon, 14 Nov 2011 22:57:41 +0000 Subject: [PATCH] + generic infrastructure for target-specific switches + -CTcompactintarrayinit command line option to change the code generation for typed array of some kind of integer-type initialization so that it takes up less space in the bytecode (because the bytecode for all routines, including the class initialization code that contains the typed constant init code, is limited 64kb, large array or multiple array constants could fairly easily bump into that limit) git-svn-id: branches/jvmbackend@19638 - --- .gitattributes | 2 + compiler/globals.pas | 45 +++++++++ compiler/globtype.pas | 12 +++ compiler/jvm/njvmtcon.pas | 154 +++++++++++++++++++++++++++- compiler/msg/errore.msg | 2 + compiler/msgidx.inc | 2 +- compiler/msgtxt.inc | 207 +++++++++++++++++++------------------- compiler/options.pas | 6 ++ rtl/java/jtcon.inc | 104 +++++++++++++++++++ rtl/java/jtconh.inc | 29 ++++++ rtl/java/system.pp | 2 + 11 files changed, 460 insertions(+), 105 deletions(-) create mode 100644 rtl/java/jtcon.inc create mode 100644 rtl/java/jtconh.inc diff --git a/.gitattributes b/.gitattributes index 474e5014d1..0bb354a57f 100644 --- a/.gitattributes +++ b/.gitattributes @@ -7375,6 +7375,8 @@ rtl/java/jsstrings.inc svneol=native#text/plain rtl/java/jsystem.inc svneol=native#text/plain rtl/java/jsystemh.inc svneol=native#text/plain rtl/java/jsystemh_types.inc svneol=native#text/plain +rtl/java/jtcon.inc svneol=native#text/plain +rtl/java/jtconh.inc svneol=native#text/plain rtl/java/jtvar.inc svneol=native#text/plain rtl/java/jtvarh.inc svneol=native#text/plain rtl/java/justringh.inc svneol=native#text/plain diff --git a/compiler/globals.pas b/compiler/globals.pas index a7def6f922..cc207093aa 100644 --- a/compiler/globals.pas +++ b/compiler/globals.pas @@ -110,6 +110,7 @@ interface tsettings = packed record alignment : talignmentinfo; globalswitches : tglobalswitches; + targetswitches : ttargetswitches; moduleswitches : tmoduleswitches; localswitches : tlocalswitches; modeswitches : tmodeswitches; @@ -354,6 +355,7 @@ interface maxCrecordalign : 0; ); globalswitches : [cs_check_unit_name,cs_link_static]; + targetswitches : []; moduleswitches : [cs_extsyntax,cs_implicit_exceptions]; localswitches : [cs_check_io,cs_typed_const_writable,cs_pointermath]; modeswitches : fpcmodeswitches; @@ -479,6 +481,7 @@ interface function UpdateOptimizerStr(s:string;var a:toptimizerswitches):boolean; function UpdateWpoStr(s: string; var a: twpoptimizerswitches): boolean; function UpdateDebugStr(s:string;var a:tdebugswitches):boolean; + function UpdateTargetSwitchStr(s: string; var a: ttargetswitches): boolean; function IncludeFeature(const s : string) : boolean; function SetMinFPConstPrec(const s: string; var a: tfloattype) : boolean; @@ -1326,6 +1329,48 @@ implementation end; + function UpdateTargetSwitchStr(s: string; var a: ttargetswitches): boolean; + var + tok : string; + doset, + found : boolean; + opt : ttargetswitch; + begin + result:=true; + uppervar(s); + repeat + tok:=GetToken(s,','); + if tok='' then + break; + if Copy(tok,1,2)='NO' then + begin + delete(tok,1,2); + doset:=false; + end + else + doset:=true; + found:=false; + for opt:=low(ttargetswitch) to high(ttargetswitch) do + begin + if TargetSwitchStr[opt]=tok then + begin + found:=true; + break; + end; + end; + if found then + begin + if doset then + include(a,opt) + else + exclude(a,opt); + end + else + result:=false; + until false; + end; + + function IncludeFeature(const s : string) : boolean; var i : tfeature; diff --git a/compiler/globtype.pas b/compiler/globtype.pas index 537db7d5a4..75840f539e 100644 --- a/compiler/globtype.pas +++ b/compiler/globtype.pas @@ -204,6 +204,15 @@ interface ); tdebugswitches = set of tdebugswitch; + { global target-specific switches } + ttargetswitch = (ts_none, + { for the JVM target: generate integer array initializations via string + constants in order to reduce the generated code size (Java routines + are limited to 64kb of bytecode) } + ts_compact_int_array_init + ); + ttargetswitches = set of ttargetswitch; + { adding a new entry here requires also adding the appropriate define in systemh.inc (FK) @@ -247,6 +256,9 @@ interface DebugSwitchStr : array[tdebugswitch] of string[22] = ('', 'DWARFSETS','STABSABSINCLUDES','DWARFMETHODCLASSPREFIX'); + TargetSwitchStr : array[ttargetswitch] of string[19] = ('', + 'COMPACTINTARRAYINIT'); + { switches being applied to all CPUs at the given level } genericlevel1optimizerswitches = [cs_opt_level1]; genericlevel2optimizerswitches = [cs_opt_level2]; diff --git a/compiler/jvm/njvmtcon.pas b/compiler/jvm/njvmtcon.pas index ea616b5952..c6e30b3aaf 100644 --- a/compiler/jvm/njvmtcon.pas +++ b/compiler/jvm/njvmtcon.pas @@ -26,21 +26,125 @@ unit njvmtcon; interface uses + globtype, node, - symdef, + symtype,symdef, ngtcon; type + tarrstringdata = record + arrstring: ansistring; + arrdatastart, arrdatalen: asizeint; + arraybase: tnode; + end; + tjvmtypedconstbuilder = class(tnodetreetypedconstbuilder) + private + procedure tc_flush_arr_strconst(def: tdef); protected + arrstringdata: tarrstringdata; + parsingordarray: boolean; + + procedure parse_arraydef(def: tarraydef); override; procedure tc_emit_setdef(def: tsetdef; var node: tnode);override; + procedure tc_emit_orddef(def: torddef; var node: tnode); override; end; implementation uses - njvmcon; + globals,widestr,verbose,constexp, + defutil, + nbas,ncal,ncon,njvmcon; + + + procedure init_arrstringdata(out data: tarrstringdata); + begin + data.arrstring:=''; + data.arrdatastart:=0; + data.arrdatalen:=0; + data.arraybase:=nil; + end; + + + procedure tjvmtypedconstbuilder.tc_flush_arr_strconst(def: tdef); + var + wstr: pcompilerwidestring; + wc: tcompilerwidechar; + i: longint; + procvariant: string[8]; + begin + // convert ansistring to packed unicodestring + initwidestring(wstr); + for i:=1 to length(arrstringdata.arrstring) div 2 do + begin + wc:=tcompilerwidechar(ord(arrstringdata.arrstring[i*2-1]) shl 8 or + ord(arrstringdata.arrstring[i*2])); + concatwidestringchar(wstr,wc); + end; + if odd(length(arrstringdata.arrstring)) then + concatwidestringchar(wstr, + tcompilerwidechar(ord(arrstringdata.arrstring[length(arrstringdata.arrstring)]) shl 8)); + + + if is_signed(def) then + case def.size of + 1: procvariant:='shortint'; + 2: procvariant:='smallint'; + 4: procvariant:='longint'; + 8: procvariant:='int64'; + else + internalerror(2011111301); + end + else + case def.size of + 1: procvariant:='byte'; + 2: procvariant:='word'; + 4: procvariant:='cardinal'; + 8: procvariant:='qword'; + else + internalerror(2011111302); + end; + // (const s: unicodestring; var arr: array of shortint; startintdex, len: longint); + addstatement(statmnt,ccallnode.createintern('fpc_tcon_'+procvariant+'_array_from_string', + ccallparanode.create(genintconstnode(arrstringdata.arrdatalen), + ccallparanode.create(genintconstnode(arrstringdata.arrdatastart), + ccallparanode.create(arrstringdata.arraybase.getcopy, + ccallparanode.create(cstringconstnode.createwstr(wstr),nil)))))); + + inc(arrstringdata.arrdatastart,arrstringdata.arrdatalen); + arrstringdata.arrstring:=''; + arrstringdata.arrdatalen:=0; + + donewidestring(wstr); + end; + + + procedure tjvmtypedconstbuilder.parse_arraydef(def: tarraydef); + var + old_arrstringdata: tarrstringdata; + old_parsingordarray: boolean; + begin + if is_dynamic_array(def) or + not is_integer(def.elementdef) or + not(ts_compact_int_array_init in current_settings.targetswitches) then + begin + inherited; + exit; + end; + old_arrstringdata:=arrstringdata; + init_arrstringdata(arrstringdata); + arrstringdata.arraybase:=basenode.getcopy; + old_parsingordarray:=parsingordarray; + parsingordarray:=true; + inherited; + if length(arrstringdata.arrstring)<>0 then + tc_flush_arr_strconst(def.elementdef); + arrstringdata.arraybase.free; + parsingordarray:=old_parsingordarray; + arrstringdata:=old_arrstringdata; + end; procedure tjvmtypedconstbuilder.tc_emit_setdef(def: tsetdef; var node: tnode); @@ -52,6 +156,52 @@ implementation inherited tc_emit_setdef(def,node); end; + + procedure tjvmtypedconstbuilder.tc_emit_orddef(def: torddef; var node: tnode); + var + elesize: longint; + begin + if not parsingordarray then + begin + inherited; + exit; + end; + if node.nodetype<>ordconstn then + internalerror(2011111101); + elesize:=def.size; + inc(arrstringdata.arrdatalen); + case elesize of + 1: + arrstringdata.arrstring:=arrstringdata.arrstring+char(tordconstnode(node).value.svalue); + 2: + arrstringdata.arrstring:=arrstringdata.arrstring+char(tordconstnode(node).value.svalue shr 8)+char(tordconstnode(node).value.svalue and $ff); + 4: + arrstringdata.arrstring:=arrstringdata.arrstring+char((tordconstnode(node).value.svalue shr 24))+ + char((tordconstnode(node).value.svalue shr 16) and $ff)+ + char((tordconstnode(node).value.svalue shr 8) and $ff)+ + char(tordconstnode(node).value.svalue and $ff); + 8: + arrstringdata.arrstring:=arrstringdata.arrstring+char((tordconstnode(node).value.svalue shr 56))+ + char((tordconstnode(node).value.svalue shr 48) and $ff)+ + char((tordconstnode(node).value.svalue shr 40) and $ff)+ + char((tordconstnode(node).value.svalue shr 32) and $ff)+ + char((tordconstnode(node).value.svalue shr 24) and $ff)+ + char((tordconstnode(node).value.svalue shr 16) and $ff)+ + char((tordconstnode(node).value.svalue shr 8) and $ff)+ + char(tordconstnode(node).value.svalue and $ff); + end; + { we can't use the full 64kb, because inside the Java class file the + string constant is actually encoded using UTF-8 and it's this UTF-8 + encoding that has to fit inside 64kb (and utf-8 encoding of random + data can easily blow up its size by about a third) } + if length(arrstringdata.arrstring)>40000 then + tc_flush_arr_strconst(def); + basenode.free; + basenode:=nil; + node.free; + node:=nil; + end; + begin ctypedconstbuilder:=tjvmtypedconstbuilder; end. diff --git a/compiler/msg/errore.msg b/compiler/msg/errore.msg index b7f8285d2f..9e75e38adf 100644 --- a/compiler/msg/errore.msg +++ b/compiler/msg/errore.msg @@ -3220,6 +3220,8 @@ S*2Aas_Assemble using GNU AS **2CR_Verify object method call validity **2Cs_Set stack checking size to **2Ct_Stack checking (for testing only, see manual) +J*2CT_Target-specific code generation options +J*3CTcompactintarrayinit_ Generate smaller (but potentially slower) code for initializing integer array constants J*2Cv_Var/out parameter copy-out checking **2CX_Create also smartlinked library **1d_Defines the symbol diff --git a/compiler/msgidx.inc b/compiler/msgidx.inc index 29a88aa66b..f39f5239a8 100644 --- a/compiler/msgidx.inc +++ b/compiler/msgidx.inc @@ -916,7 +916,7 @@ const option_info=11024; option_help_pages=11025; - MsgTxtSize = 62479; + MsgTxtSize = 62642; MsgIdxMax : array[1..20] of longint=( 26,90,321,109,87,54,111,23,202,63, diff --git a/compiler/msgtxt.inc b/compiler/msgtxt.inc index 1ff5543d34..2fddcf82c4 100644 --- a/compiler/msgtxt.inc +++ b/compiler/msgtxt.inc @@ -1,7 +1,7 @@ {$ifdef Delphi} -const msgtxt : array[0..000260] of string[240]=( +const msgtxt : array[0..000261] of string[240]=( {$else Delphi} -const msgtxt : array[0..000260,1..240] of char=( +const msgtxt : array[0..000261,1..240] of char=( {$endif Delphi} '01000_T_Compiler: $1'#000+ '01001_D_Compiler OS: $1'#000+ @@ -1197,157 +1197,160 @@ const msgtxt : array[0..000260,1..240] of char=( '**2CR_Verify object method call validity'#010+ '**2Cs_Set stack checking size to '#010+ '**2Ct_Stack checking (for testing only, see manual)'#010+ + 'J*2CT_Target-specific code generation options'#010+ + 'J*3CTcompactin','tarrayinit_ Generate smaller (but potentially slower) '+ + 'code for initializing integer array constants'#010+ 'J*2Cv_Var/out parameter copy-out checking'#010+ - '**2CX_Create also sma','rtlinked library'#010+ + '**2CX_Create also smartlinked library'#010+ '**1d_Defines the symbol '#010+ '**1D_Generate a DEF file'#010+ - '**2Dd_Set description to '#010+ + '**2D','d_Set description to '#010+ '**2Dv_Set DLL version to '#010+ '*O2Dw_PM application'#010+ '**1e_Set path to executable'#010+ '**1E_Same as -Cn'#010+ '**1fPIC_Same as -Cg'#010+ - '**1F_Set fi','le names and paths:'#010+ - '**2Fa[,y]_(for a program) load units and [y] before uses is par'+ - 'sed'#010+ + '**1F_Set file names and paths:'#010+ + '**2Fa[,y]_(for a program) load units and [y] befor','e uses is p'+ + 'arsed'#010+ '**2Fc_Set input codepage to '#010+ '**2FC_Set RC compiler binary name to '#010+ '**2Fd_Disable the compiler'#039's internal directory cache'#010+ - '**2FD_Set ','the directory where to search for compiler utilities'#010+ - '**2Fe_Redirect error output to '#010+ + '**2FD_Set the directory where to search for compiler utilities'#010+ + '**2Fe_Redirect error ','output to '#010+ '**2Ff_Add to framework path (Darwin only)'#010+ '**2FE_Set exe/unit output path to '#010+ '**2Fi_Add to include path'#010+ - '**2Fl_Add to librar','y path'#010+ + '**2Fl_Add to library path'#010+ '**2FL_Use as dynamic linker'#010+ - '**2Fm_Load unicode conversion table from .txt in the compiler di'+ - 'r'#010+ + '**2Fm_Load unicode conversion ta','ble from .txt in the compiler '+ + 'dir'#010+ '**2Fo_Add to object path'#010+ '**2Fr_Load error message file '#010+ '**2FR_Set resource (.res) linker to '#010+ - '**2Fu_Add <','x> to unit path'#010+ + '**2Fu_Add to unit path'#010+ '**2FU_Set unit output path to , overrides -FE'#010+ - '**2FW_Store generated whole-program optimization feedback in '#010+ + '**2FW_','Store generated whole-program optimization feedback in '#010+ '**2Fw_Load previously stored whole-program optimization feedback fr'+ 'om '#010+ - '*g1g_Generate debug informa','tion (default format for target)'#010+ + '*g1g_Generate debug information (default format for target)'#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+ '*g2go_Set debug information options'#010+ - '*g3godwarfs','ets_ Enable DWARF '#039'set'#039' type debug information (b'+ - 'reaks gdb < 6.5)'#010+ - '*g3gostabsabsincludes_ Store absolute/full include file paths in Stabs'+ - #010+ + '*g3godwarfsets_ Enable DWARF '#039'set'#039' type debug information (bre'+ + 'aks gdb < 6.5)'#010+ + '*g3gostabsa','bsincludes_ Store absolute/full include file paths in Sta'+ + 'bs'#010+ '*g3godwarfmethodclassprefix_ Prefix method names in DWARF with class n'+ 'ame'#010+ - '*g2gp_Preserve case in stabs ','symbol names'#010+ + '*g2gp_Preserve case in stabs symbol names'#010+ '*g2gs_Generate Stabs debug information'#010+ - '*g2gt_Trash local variables (to detect uninitialized uses)'#010+ + '*g2gt_Trash local variabl','es (to detect uninitialized uses)'#010+ '*g2gv_Generates programs traceable with Valgrind'#010+ '*g2gw_Generate DWARFv2 debug information (same as -gw2)'#010+ - '*g2gw2_Generate DWARFv2 ','debug information'#010+ + '*g2gw2_Generate DWARFv2 debug information'#010+ '*g2gw3_Generate DWARFv3 debug information'#010+ - '*g2gw4_Generate DWARFv4 debug information (experimental)'#010+ + '*g2gw4_Generate D','WARFv4 debug information (experimental)'#010+ '**1i_Information'#010+ '**2iD_Return compiler date'#010+ '**2iV_Return short compiler version'#010+ '**2iW_Return full compiler version'#010+ - '**2iSO_R','eturn compiler OS'#010+ + '**2iSO_Return compiler OS'#010+ '**2iSP_Return compiler host processor'#010+ - '**2iTO_Return target OS'#010+ + '**2iTO_Return target ','OS'#010+ '**2iTP_Return target processor'#010+ '**1I_Add to include path'#010+ '**1k_Pass to the linker'#010+ '**1l_Write logo'#010+ '**1M_Set language mode to '#010+ - '**2Mfpc_Free Pasc','al dialect (default)'#010+ + '**2Mfpc_Free Pascal dialect (default)'#010+ '**2Mobjfpc_FPC mode with Object Pascal support'#010+ - '**2Mdelphi_Delphi 7 compatibility mode'#010+ + '**2Mdelph','i_Delphi 7 compatibility mode'#010+ '**2Mtp_TP/BP 7.0 compatibility mode'#010+ '**2Mmacpas_Macintosh Pascal dialects compatibility mode'#010+ - '**1n_Do not read the default config files',#010+ + '**1n_Do not read the default config files'#010+ '**1N_Node tree optimizations'#010+ '**2Nu_Unroll loops'#010+ - '**1o_Change the name of the executable produced to '#010+ + '**1o_Change the name o','f the executable produced to '#010+ '**1O_Optimizations:'#010+ '**2O-_Disable optimizations'#010+ '**2O1_Level 1 optimizations (quick and debugger friendly)'#010+ - '**2O2_Level 2 optimiz','ations (-O1 + quick optimizations)'#010+ - '**2O3_Level 3 optimizations (-O2 + slow optimizations)'#010+ + '**2O2_Level 2 optimizations (-O1 + quick optimizations)'#010+ + '**2O3_Level 3 optimizations (-O2 + slow op','timizations)'#010+ '**2Oa=_Set alignment'#010+ '**2Oo[NO]_Enable or disable optimizations, see fpc -i for possible '+ 'values'#010+ - '**2Op_Set target cpu for optimizing, see fp','c -i for possible valu'+ - 'es'#010+ - '**2OW_Generate whole-program optimization feedback for optimization'+ - ' , see fpc -i for possible values'#010+ + '**2Op_Set target cpu for optimizing, see fpc -i for possible values'+ + #010+ + '**2OW_Generate whole-program optimization feedbac','k for optimizati'+ + 'on , see fpc -i for possible values'#010+ '**2Ow_Perform whole-program optimization , see fpc -i for possib'+ 'le values'#010+ - '**2Os_Optimize for size rath','er than speed'#010+ + '**2Os_Optimize for size rather than speed'#010+ '**1pg_Generate profile code for gprof (defines FPC_PROFILE)'#010+ - '**1R_Assembler reading style:'#010+ + '**1','R_Assembler reading style:'#010+ '**2Rdefault_Use default assembler for target'#010+ '3*2Ratt_Read AT&T style assembler'#010+ '3*2Rintel_Read Intel style assembler'#010+ - '6*2RMOT_Read moto','rola style assembler'#010+ + '6*2RMOT_Read motorola style assembler'#010+ '**1S_Syntax options:'#010+ '**2S2_Same as -Mobjfpc'#010+ - '**2Sc_Support operators like C (*=,+=,/= and -=)'#010+ + '**2Sc_Sup','port operators like C (*=,+=,/= and -=)'#010+ '**2Sa_Turn on assertions'#010+ '**2Sd_Same as -Mdelphi'#010+ '**2Se_Error options. is a combination of the following:'#010+ - '**3*_ : C','ompiler halts after the errors (default is 1)'#010+ - '**3*_w : Compiler also halts after warnings'#010+ + '**3*_ : Compiler halts after the errors (default is 1)'#010+ + '**3*_w : Compiler also halt','s after warnings'#010+ '**3*_n : Compiler also halts after notes'#010+ '**3*_h : Compiler also halts after hints'#010+ '**2Sg_Enable LABEL and GOTO (default in -Mtp and -Mdelphi)'#010+ - '**2Sh','_Use reference counted strings (ansistring by default) instead '+ - 'of shortstrings'#010+ + '**2Sh_Use reference counted strings (ansistring by default) instead of'+ + ' shortstring','s'#010+ '**2Si_Turn on inlining of procedures/functions declared as "inline"'#010+ '**2Sk_Load fpcylix unit'#010+ '**2SI_Set interface style to '#010+ - '**3SIcom_COM compatible interface',' (default)'#010+ + '**3SIcom_COM compatible interface (default)'#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+ '**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+ - '**1s_Do not call assembler and linker'#010+ + '**2Sy_@ returns a typed pointer, same as $T+'#010+ + '**1s_Do not call assembler and ','linker'#010+ '**2sh_Generate script to link on host'#010+ '**2st_Generate script to link on target'#010+ '**2sr_Skip register allocation phase (use with -alr)'#010+ - '**1T_Target operating ','system:'#010+ + '**1T_Target operating system:'#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 ex','tender)'#010+ '3*2Tfreebsd_FreeBSD'#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*2Tlinux_L','inux'#010+ + '3*2Tlinux_Linux'#010+ '3*2Tnetbsd_NetBSD'#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*2Tos2_OS/2 / eComStation'#010+ '3*2Tsunos_SunOS/Solaris'#010+ '3*2Tsymbian_Symbian OS'#010+ '3*2Tsolaris_Solaris'#010+ - '3*2Twatcom_Watcom co','mpatible DOS extender'#010+ + '3*2Twatcom_Watcom compatible DOS extender'#010+ '3*2Twdosx_WDOSX DOS extender'#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*2Tlinux_Linux'#010+ '4*2Twin64_Win64 (64 bit Windows systems)'#010+ '6*2Tamiga_Commodore Amiga'#010+ '6*2Tatari_Atari ST/STe/TT'#010+ - '6*2Tlin','ux_Linux'#010+ + '6*2Tlinux_Linux'#010+ '6*2Tpalmos_PalmOS'#010+ 'A*2Tdarwin_Darwin/iPhoneOS/iOS'#010+ 'A*2Tlinux_Linux'#010+ - 'A*2Twince_Windows CE'#010+ + 'A*2','Twince_Windows CE'#010+ 'P*2Tamiga_AmigaOS'#010+ 'P*2Tdarwin_Darwin/Mac OS X'#010+ 'P*2Tlinux_Linux'#010+ @@ -1355,101 +1358,101 @@ const msgtxt : array[0..000260,1..240] of char=( 'P*2Tmorphos_MorphOS'#010+ 'S*2Tsolaris_Solaris'#010+ 'S*2Tlinux_Linux'#010+ - '*','*1u_Undefines the symbol '#010+ + '**1u_Undefines the symbol '#010+ '**1U_Unit options:'#010+ - '**2Un_Do not check where the unit name matches the file name'#010+ + '**2Un_Do not check where t','he unit name matches the file name'#010+ '**2Ur_Generate release unit files (never automatically recompiled)'#010+ '**2Us_Compile a system unit'#010+ - '**1v_Be verbose. is a comb','ination of the following letters:'#010+ - '**2*_e : Show errors (default) 0 : Show nothing (except errors)'#010+ + '**1v_Be verbose. is a combination of the following letters:'#010+ + '**2*_e : Show errors (default) 0 : Sh','ow nothing (except errors'+ + ')'#010+ '**2*_w : Show warnings u : Show unit info'#010+ '**2*_n : Show notes t : Show tried/used files'#010+ - '**2*_h : Show hin','ts c : Show conditionals'#010+ - '**2*_i : Show general info d : Show debug info'#010+ + '**2*_h : Show hints c : Show conditionals'#010+ + '**2*_i : Show general info ',' d : Show debug info'#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*_b : Write file names messages p : Write tree.log with parse tre'+ - 'e'#010+ + '**2*_a : Show everything x : Executable info (Win32 only)'#010+ + '**2*_b : Write f','ile names messages p : Write tree.log with parse t'+ + 'ree'#010+ '**2*_ with full path v : Write fpcdebug.txt with'#010+ - '**2*_ l','ots of debugging info'#010+ - '**2*_m, : Don'#039't show messages numbered and '#010+ + '**2*_ lots of debugging info'#010+ + '**2*_m, : Don'#039't show messages numbered and '#010+ '**1W_Target-specific options (targets)'#010+ '3*2WA_Specify native type application (Windows)'#010+ '4*2WA_Specify native type application (Windows)'#010+ - 'A*2WA_Specify native ty','pe application (Windows)'#010+ - '3*2Wb_Create a bundle instead of a library (Darwin)'#010+ + 'A*2WA_Specify native type application (Windows)'#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+ 'A*2Wb_Create a bundle instead of a library (Darwin)'#010+ - '4*2Wb_C','reate a bundle instead of a library (Darwin)'#010+ - '3*2WB_Create a relocatable image (Windows, Symbian)'#010+ + '4*2Wb_Create a bundle instead of a library (Darwin)'#010+ + '3*2WB_Create a relocatable image',' (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+ - 'A*2WB','_Create a relocatable image (Windows, Symbian)'#010+ - 'A*2WBxxxx_Set image base to xxxx (Windows, Symbian)'#010+ + 'A*2WB_Create a relocatable image (Windows, Symbian)'#010+ + 'A*2WBxxxx_Set image base to xx','xx (Windows, Symbian)'#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+ - 'P*2WC_Specify console type application (Classic Mac OS)'#010+ + 'A*2WC_Specify console type application (Windows)'#010+ + 'P*2WC_Specify console type application (Classic M','ac OS)'#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 export func','tions 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+ - '4*2We_Use external resources (Darwin)'#010+ + '4*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+ - '3*2WF_Specify full-s','creen type application (EMX, OS/2)'#010+ - '3*2WG_Specify graphic type application (EMX, OS/2, Windows)'#010+ + '3*2WF_Specify full-screen type application (EMX, OS/2)'#010+ + '3*2WG_Specify graphic type application (EM','X, 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 applicati','on (Classic Mac OS)'#010+ + 'P*2WG_Specify graphic type application (Classic Mac OS)'#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+ 'P*2Wi_Use internal resources (Darwin)'#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+ + '3*2WI_Turn on/off the usage of import sections (Windows)'#010+ + '4*2WI_Turn on/off the usage of import sections (Wi','ndows)'#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 relocat','ion code, needed for debugging (Windows'+ + '4*2WN_Do not generate relocation code, needed for debugging (Windows)'#010+ + 'A*2WN_Do not generate relocation cod','e, 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+ - 'V*2Wpxxxx_Specify the controller type, see fpc -i for possi','ble value'+ - 's'#010+ + 'V*2Wpxxxx_Specify the controller type, see fpc -i for possible values'#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+ 'P*2WT_Specify MPW tool type application (Classic Mac OS)'#010+ '**2WX_Enable executable stack (Linux)'#010+ - '**1X_Execut','able options:'#010+ - '**2Xc_Pass --shared/-dynamic to the linker (BeOS, Darwin, FreeBSD, Lin'+ - 'ux)'#010+ + '**1X_Executable options:'#010+ + '**2Xc_Pass --shared/-dynamic to the linker (BeOS, Darwin, FreeB','SD, L'+ + 'inux)'#010+ '**2Xd_Do not use standard library search path (needed for cross compil'+ 'e)'#010+ '**2Xe_Use external linker'#010+ - '**2Xg_Create debuginfo in a separate file and add a d','ebuglink sectio'+ - 'n to executable'#010+ - '**2XD_Try to link units dynamically (defines FPC_LINK_DYNAMIC)'#010+ + '**2Xg_Create debuginfo in a separate file and add a debuglink section '+ + 'to executable'#010+ + '**2XD_Try to link units dynamically (defi','nes FPC_LINK_DYNAMIC)'#010+ '**2Xi_Use internal linker'#010+ '**2Xm_Generate link map'#010+ '**2XM_Set the name of the '#039'main'#039' program routine (default i'+ 's '#039'main'#039')'#010+ - '**2XP_Prepend th','e binutils names with the prefix '#010+ - '**2Xr_Set the linker'#039's rlink-path to (needed for cross comp'+ - 'ile, see the ld manual for more information) (BeOS, Linux)'#010+ + '**2XP_Prepend the binutils names with the prefix '#010+ + '**2Xr_Set the linker'#039's rlink-path to ',' (needed for cross co'+ + 'mpile, see the ld manual for more information) (BeOS, Linux)'#010+ '**2XR_Prepend to all linker search paths (BeOS, Darwin, FreeBSD'+ - ', Linux,',' Mac OS, Solaris)'#010+ + ', Linux, Mac OS, Solaris)'#010+ '**2Xs_Strip all symbols from executable'#010+ - '**2XS_Try to link units statically (default, defines FPC_LINK_STATIC)'#010+ + '**2XS_Try to link u','nits 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+ + '**2XX_Try to smartlink units (defines FPC_LINK_SMART)'#010+ '**1*_'#010+ '**1?_Show this help'#010+ - '**1h_Shows this help without waiting' + '**1h_Shows this help without waiti','ng' ); diff --git a/compiler/options.pas b/compiler/options.pas index 585894a883..b317070f14 100644 --- a/compiler/options.pas +++ b/compiler/options.pas @@ -761,6 +761,12 @@ begin exclude(init_settings.moduleswitches,cs_create_smart) Else include(init_settings.moduleswitches,cs_create_smart); + 'T' : + begin + if not UpdateTargetSwitchStr(copy(more,j+1,length(more)),init_settings.targetswitches) then + IllegalPara(opt); + break; + end; 'v' : If target_info.system=system_jvm_java32 then If UnsetBool(More, j) then diff --git a/rtl/java/jtcon.inc b/rtl/java/jtcon.inc new file mode 100644 index 0000000000..a342f3ea0b --- /dev/null +++ b/rtl/java/jtcon.inc @@ -0,0 +1,104 @@ +{ + This file is part of the Free Pascal run time library. + Copyright (c) 2011 by Jonas Maebe, + member of the Free Pascal development team. + + This file implements support routines for typed constants for the JVM + platform + + See the file COPYING.FPC, included in this distribution, + for details about the copyright. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. + + **********************************************************************} + +procedure fpc_tcon_shortint_array_from_string(const s: unicodestring; var arr: array of shortint; startindex, len: longint); compilerproc; + var + i: longint; + c: widechar; + begin + for i:=0 to (len div 2)-1 do + begin + c:=s[i+1]; + arr[startindex+i*2]:=shortint(ord(c) shr 8); + arr[startindex+i*2+1]:=shortint(ord(c)); + end; + if odd(len) then + arr[startindex+len-1]:=ord(s[len div 2]) shr 8; + end; + + +procedure fpc_tcon_smallint_array_from_string(const s: unicodestring; var arr: array of smallint; startindex, len: longint); compilerproc; + var + i: longint; + begin + for i:=0 to len-1 do + arr[startindex+i]:=ord(s[i+1]); + end; + + +procedure fpc_tcon_longint_array_from_string(const s: unicodestring; var arr: array of longint; startindex, len: longint); compilerproc; + var + i, l: longint; + begin + { TODO: maybe optimize encoding via uleb/sleb } + for i:=0 to len-1 do + begin + l:=ord(s[i*2+1]) shl 16; + l:=l or ord(s[i*2+2]); + arr[startindex+i]:=l; + end; + end; + + +procedure fpc_tcon_int64_array_from_string(const s: unicodestring; var arr: array of int64; startindex, len: longint); compilerproc; + var + i: longint; + l: int64; + begin + { TODO: maybe optimize encoding via uleb/sleb } + for i:=0 to len-1 do + begin + l:=int64(ord(s[i*4+1])) shl 48; + l:=l or (int64(ord(s[i*4+2])) shl 32); + l:=l or (ord(s[i*4+3]) shl 16); + l:=l or ord(s[i*4+4]); + arr[startindex+i]:=l; + end; + end; + +{ specifying compilerprocs using an external name doesn't work yet } + +procedure fpc_tcon_shortint_array_from_string_intern_as_byte(const s: unicodestring; var arr: array of byte; startindex, len: longint); external name 'fpc_tcon_shortint_array_from_string'; +procedure fpc_tcon_smallint_array_from_string_intern_as_word(const s: unicodestring; var arr: array of word; startindex, len: longint); external name 'fpc_tcon_smallint_array_from_string'; +procedure fpc_tcon_longint_array_from_string_intern_as_cardinal(const s: unicodestring; var arr: array of cardinal; startindex, len: longint); external name 'fpc_tcon_longint_array_from_string'; +procedure fpc_tcon_int64_array_from_string_intern_as_int64(const s: unicodestring; var arr: array of qword; startindex, len: longint); external name 'fpc_tcon_int64_array_from_string'; + + +procedure fpc_tcon_byte_array_from_string(const s: unicodestring; var arr: array of byte; startindex, len: longint); compilerproc; + begin + fpc_tcon_shortint_array_from_string_intern_as_byte(s,arr,startindex,len); + end; + + +procedure fpc_tcon_word_array_from_string(const s: unicodestring; var arr: array of word; startindex, len: longint); compilerproc; + begin + fpc_tcon_smallint_array_from_string_intern_as_word(s,arr,startindex,len); + end; + + +procedure fpc_tcon_cardinal_array_from_string(const s: unicodestring; var arr: array of cardinal; startindex, len: longint); compilerproc; + begin + fpc_tcon_longint_array_from_string_intern_as_cardinal(s,arr,startindex,len); + end; + + +procedure fpc_tcon_qword_array_from_string(const s: unicodestring; var arr: array of qword; startindex, len: longint); compilerproc; + begin + fpc_tcon_int64_array_from_string_intern_as_int64(s,arr,startindex,len); + end; + + diff --git a/rtl/java/jtconh.inc b/rtl/java/jtconh.inc new file mode 100644 index 0000000000..0eb9069cbc --- /dev/null +++ b/rtl/java/jtconh.inc @@ -0,0 +1,29 @@ +{ + This file is part of the Free Pascal run time library. + Copyright (c) 2011 by Jonas Maebe, + member of the Free Pascal development team. + + This file implements support routines for typed constants for the JVM + platform + + See the file COPYING.FPC, included in this distribution, + for details about the copyright. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. + + **********************************************************************} + +procedure fpc_tcon_shortint_array_from_string(const s: unicodestring; var arr: array of shortint; startindex, len: longint); compilerproc; +procedure fpc_tcon_byte_array_from_string(const s: unicodestring; var arr: array of byte; startindex, len: longint); compilerproc; + +procedure fpc_tcon_smallint_array_from_string(const s: unicodestring; var arr: array of smallint; startindex, len: longint); compilerproc; +procedure fpc_tcon_word_array_from_string(const s: unicodestring; var arr: array of word; startindex, len: longint); compilerproc; + +procedure fpc_tcon_longint_array_from_string(const s: unicodestring; var arr: array of longint; startindex, len: longint); compilerproc; +procedure fpc_tcon_cardinal_array_from_string(const s: unicodestring; var arr: array of cardinal; startindex, len: longint); compilerproc; + +procedure fpc_tcon_int64_array_from_string(const s: unicodestring; var arr: array of int64; startindex, len: longint); compilerproc; +procedure fpc_tcon_qword_array_from_string(const s: unicodestring; var arr: array of qword; startindex, len: longint); compilerproc; + diff --git a/rtl/java/system.pp b/rtl/java/system.pp index 76cb57d701..19459fd648 100644 --- a/rtl/java/system.pp +++ b/rtl/java/system.pp @@ -96,6 +96,7 @@ const {$i justringh.inc} {$i jsystemh.inc} +{$i jtconh.inc} {*****************************************************************************} @@ -110,6 +111,7 @@ function min(a,b : longint) : longint; min:=b; end; +{$i jtcon.inc} {$i jtvar.inc} {$i jsstrings.inc} {$i jastrings.inc}