summaryrefslogtreecommitdiff
path: root/compiler/js
diff options
context:
space:
mode:
Diffstat (limited to 'compiler/js')
-rw-r--r--compiler/js/aasmcpu.pas304
-rw-r--r--compiler/js/cgcpu.pas129
-rw-r--r--compiler/js/cpubase.pas338
-rw-r--r--compiler/js/cpuinfo.pas75
-rw-r--r--compiler/js/cpunode.pas38
-rw-r--r--compiler/js/cpupara.pas306
-rw-r--r--compiler/js/cpupi.pas65
-rw-r--r--compiler/js/cputarg.pas58
-rw-r--r--compiler/js/hlcgcpu.pas64
-rw-r--r--compiler/js/rgcpu.pas358
-rw-r--r--compiler/js/rjscon.inc5
-rw-r--r--compiler/js/rjsnor.inc2
-rw-r--r--compiler/js/rjsnum.inc5
-rw-r--r--compiler/js/rjsrni.inc5
-rw-r--r--compiler/js/rjssri.inc5
-rw-r--r--compiler/js/rjsstd.inc5
-rw-r--r--compiler/js/rjssup.inc5
-rw-r--r--compiler/js/symcpu.pas211
-rw-r--r--compiler/js/tgcpu.pas261
19 files changed, 2239 insertions, 0 deletions
diff --git a/compiler/js/aasmcpu.pas b/compiler/js/aasmcpu.pas
new file mode 100644
index 0000000000..034391ea89
--- /dev/null
+++ b/compiler/js/aasmcpu.pas
@@ -0,0 +1,304 @@
+{
+ Copyright (c) 1999-2002 by Mazen Neifer
+
+ Contains the assembler object for the JVM
+
+ This program is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation; either version 2 of the License, or
+ (at your option) any later version.
+
+ 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. See the
+ GNU General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+
+ ****************************************************************************
+}
+unit aasmcpu;
+
+{$i fpcdefs.inc}
+
+interface
+
+uses
+ cclasses,
+ globtype,globals,verbose,
+ aasmbase,aasmtai,aasmdata,aasmsym,
+ cgbase,cgutils,cpubase,cpuinfo,
+ widestr;
+
+ { fake, there are no "mov reg,reg" instructions here }
+ const
+ { "mov reg,reg" source operand number }
+ O_MOV_SOURCE = 0;
+ { "mov reg,reg" source operand number }
+ O_MOV_DEST = 0;
+
+ type
+
+ { taicpu }
+
+ taicpu = class(tai_cpu_abstract_sym)
+ constructor op_none(op : tasmop);
+
+ constructor op_reg(op : tasmop;_op1 : tregister);
+ constructor op_const(op : tasmop;_op1 : aint);
+ constructor op_ref(op : tasmop;const _op1 : treference);
+ constructor op_sym(op : tasmop;_op1 : tasmsymbol);
+
+ constructor op_sym_const(op : tasmop;_op1 : tasmsymbol;_op2 : aint);
+
+ constructor op_single(op : tasmop;_op1 : single);
+ constructor op_double(op : tasmop;_op1 : double);
+ constructor op_string(op : tasmop;_op1len : aint;_op1 : pchar);
+ constructor op_wstring(op : tasmop;_op1 : pcompilerwidestring);
+
+ procedure loadsingle(opidx:longint;f:single);
+ procedure loaddouble(opidx:longint;d:double);
+ procedure loadstr(opidx:longint;vallen: aint;pc: pchar);
+ procedure loadpwstr(opidx:longint;pwstr:pcompilerwidestring);
+
+
+ { register allocation }
+ function is_same_reg_move(regtype: Tregistertype):boolean; override;
+
+ { register spilling code }
+ function spilling_get_operation_type(opnr: longint): topertype;override;
+ end;
+
+ tai_align = class(tai_align_abstract)
+ { nothing to add }
+ end;
+
+ procedure InitAsm;
+ procedure DoneAsm;
+
+ function spilling_create_load(const ref:treference;r:tregister):Taicpu;
+ function spilling_create_store(r:tregister; const ref:treference):Taicpu;
+
+implementation
+
+{*****************************************************************************
+ taicpu Constructors
+*****************************************************************************}
+
+ constructor taicpu.op_none(op : tasmop);
+ begin
+ inherited create(op);
+ end;
+
+
+ constructor taicpu.op_reg(op : tasmop;_op1 : tregister);
+ begin
+ inherited create(op);
+ ops:=1;
+ loadreg(0,_op1);
+ end;
+
+
+ constructor taicpu.op_ref(op : tasmop;const _op1 : treference);
+ begin
+ inherited create(op);
+ ops:=1;
+ loadref(0,_op1);
+ end;
+
+
+ constructor taicpu.op_const(op : tasmop;_op1 : aint);
+ begin
+ inherited create(op);
+ ops:=1;
+ loadconst(0,_op1);
+ end;
+
+
+ constructor taicpu.op_sym(op : tasmop;_op1 : tasmsymbol);
+ begin
+ inherited create(op);
+ ops:=1;
+ is_jmp:=op in [a_if_acmpeq, a_if_acmpne, a_if_icmpeq, a_if_icmpge, a_if_icmpgt,
+ a_if_icmple, a_if_icmplt, a_if_icmpne,
+ a_ifeq, a_ifge, a_ifgt, a_ifle, a_iflt, a_ifne, a_ifnonnull, a_ifnull];
+ loadsymbol(0,_op1,0);
+ end;
+
+
+ constructor taicpu.op_sym_const(op: tasmop; _op1: tasmsymbol; _op2: aint);
+ begin
+ inherited create(op);
+ ops:=2;
+ loadsymbol(0,_op1,0);
+ loadconst(1,_op2);
+ end;
+
+
+ constructor taicpu.op_single(op: tasmop; _op1: single);
+ begin
+ inherited create(op);
+ ops:=1;
+ loadsingle(0,_op1);
+ end;
+
+
+ constructor taicpu.op_double(op: tasmop; _op1: double);
+ begin
+ inherited create(op);
+ ops:=1;
+ loaddouble(0,_op1);
+ end;
+
+ constructor taicpu.op_string(op: tasmop; _op1len: aint; _op1: pchar);
+ begin
+ inherited create(op);
+ ops:=1;
+ loadstr(0,_op1len,_op1);
+ end;
+
+ constructor taicpu.op_wstring(op: tasmop; _op1: pcompilerwidestring);
+ begin
+ inherited create(op);
+ ops:=1;
+ loadpwstr(0,_op1);
+ end;
+
+
+ procedure taicpu.loadsingle(opidx:longint;f:single);
+ begin
+ //allocate_oper(opidx+1);
+ //with oper[opidx]^ do
+ // begin
+ // if typ<>top_single then
+ // clearop(opidx);
+ // sval:=f;
+ // typ:=top_single;
+ // end;
+ internalerror(2014031401);
+ end;
+
+
+ procedure taicpu.loaddouble(opidx: longint; d: double);
+ begin
+ //allocate_oper(opidx+1);
+ //with oper[opidx]^ do
+ // begin
+ // if typ<>top_double then
+ // clearop(opidx);
+ // dval:=d;
+ // typ:=top_double;
+ // end;
+ internalerror(2014031402);
+ end;
+
+
+ procedure taicpu.loadstr(opidx: longint; vallen: aint; pc: pchar);
+ begin
+ //allocate_oper(opidx+1);
+ //with oper[opidx]^ do
+ // begin
+ // clearop(opidx);
+ // pcvallen:=vallen;
+ // getmem(pcval,vallen);
+ // move(pc^,pcval^,vallen);
+ // typ:=top_string;
+ // end;
+ internalerror(2014031403);
+ end;
+
+
+ procedure taicpu.loadpwstr(opidx:longint;pwstr:pcompilerwidestring);
+ begin
+ //allocate_oper(opidx+1);
+ //with oper[opidx]^ do
+ // begin
+ // clearop(opidx);
+ // initwidestring(pwstrval);
+ // copywidestring(pwstr,pwstrval);
+ // typ:=top_wstring;
+ // end;
+ internalerror(2014031404);
+ end;
+
+
+ function taicpu.is_same_reg_move(regtype: Tregistertype):boolean;
+ begin
+ result:=false;
+ end;
+
+
+ function taicpu.spilling_get_operation_type(opnr: longint): topertype;
+ begin
+ case opcode of
+ a_iinc:
+ result:=operand_readwrite;
+ a_aastore,
+ a_astore,
+ a_astore_0,
+ a_astore_1,
+ a_astore_2,
+ a_astore_3,
+ a_bastore,
+ a_castore,
+ a_dastore,
+ a_dstore,
+ a_dstore_0,
+ a_dstore_1,
+ a_dstore_2,
+ a_dstore_3,
+ a_fastore,
+ a_fstore,
+ a_fstore_0,
+ a_fstore_1,
+ a_fstore_2,
+ a_fstore_3,
+ a_iastore,
+ a_istore,
+ a_istore_0,
+ a_istore_1,
+ a_istore_2,
+ a_istore_3,
+ a_lastore,
+ a_lstore,
+ a_lstore_0,
+ a_lstore_1,
+ a_lstore_2,
+ a_lstore_3,
+ a_sastore:
+ result:=operand_write;
+ else
+ result:=operand_read;
+ end;
+ end;
+
+
+ function spilling_create_load(const ref:treference;r:tregister):Taicpu;
+ begin
+ internalerror(2010122614);
+ result:=nil;
+ end;
+
+
+ function spilling_create_store(r:tregister; const ref:treference):Taicpu;
+ begin
+ internalerror(2010122615);
+ result:=nil;
+ end;
+
+
+ procedure InitAsm;
+ begin
+ end;
+
+
+ procedure DoneAsm;
+ begin
+ end;
+
+begin
+ cai_cpu:=taicpu;
+ cai_align:=tai_align;
+end.
diff --git a/compiler/js/cgcpu.pas b/compiler/js/cgcpu.pas
new file mode 100644
index 0000000000..893a924e36
--- /dev/null
+++ b/compiler/js/cgcpu.pas
@@ -0,0 +1,129 @@
+{
+ Copyright (c) 2010 by Jonas Maebe
+
+ This unit implements the code generator for JS
+
+ This program is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation; either version 2 of the License, or
+ (at your option) any later version.
+
+ 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. See the
+ GNU General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+
+ ****************************************************************************
+}
+unit cgcpu;
+
+{$i fpcdefs.inc}
+
+interface
+
+ uses
+ globtype,parabase,
+ cgbase,cgutils,cgobj,cghlcpu,
+ aasmbase,aasmtai,aasmdata,aasmcpu,
+ cpubase,cpuinfo,
+ node,symconst,SymType,symdef,
+ rgcpu;
+
+ type
+ TCgJS=class(thlbasecgcpu)
+ public
+ procedure init_register_allocators;override;
+ procedure done_register_allocators;override;
+ function getintregister(list:TAsmList;size:Tcgsize):Tregister;override;
+ function getfpuregister(list:TAsmList;size:Tcgsize):Tregister;override;
+ function getaddressregister(list:TAsmList):Tregister;override;
+ procedure do_register_allocation(list:TAsmList;headertai:tai);override;
+ end;
+
+ procedure create_codegen;
+
+implementation
+
+ uses
+ globals,verbose,systems,cutils,
+ paramgr,fmodule,
+ tgobj,
+ procinfo,cpupi;
+
+
+{****************************************************************************
+ Assembler code
+****************************************************************************}
+
+ procedure TCgJS.init_register_allocators;
+ begin
+ inherited init_register_allocators;
+{$ifndef cpu64bitaddr}
+ rg[R_INTREGISTER]:=Trgcpu.create(R_INTREGISTER,R_SUBD,
+ [RS_R0],first_int_imreg,[]);
+{$else not cpu64bitaddr}
+ rg[R_INTREGISTER]:=Trgcpu.create(R_INTREGISTER,R_SUBQ,
+ [RS_R0],first_int_imreg,[]);
+{$endif not cpu64bitaddr}
+ rg[R_FPUREGISTER]:=trgcpu.create(R_FPUREGISTER,R_SUBFS,
+ [RS_R0],first_fpu_imreg,[]);
+ rg[R_MMREGISTER]:=trgcpu.create(R_MMREGISTER,R_SUBNONE,
+ [RS_R0],first_mm_imreg,[]);
+ end;
+
+
+ procedure TCgJS.done_register_allocators;
+ begin
+ rg[R_INTREGISTER].free;
+ rg[R_FPUREGISTER].free;
+ rg[R_MMREGISTER].free;
+ inherited done_register_allocators;
+ end;
+
+
+ function TCgJS.getintregister(list:TAsmList;size:Tcgsize):Tregister;
+ begin
+ if not(size in [OS_64,OS_S64]) then
+ result:=rg[R_INTREGISTER].getregister(list,R_SUBD)
+ else
+ result:=rg[R_INTREGISTER].getregister(list,R_SUBQ);
+ end;
+
+
+ function TCgJS.getfpuregister(list:TAsmList;size:Tcgsize):Tregister;
+ begin
+ if size=OS_F64 then
+ result:=rg[R_FPUREGISTER].getregister(list,R_SUBFD)
+ else
+ result:=rg[R_FPUREGISTER].getregister(list,R_SUBFS);
+ end;
+
+
+ function TCgJS.getaddressregister(list:TAsmList):Tregister;
+ begin
+ { avoid problems in the compiler where int and addr registers are
+ mixed for now; we currently don't have to differentiate between the
+ two as far as the jvm backend is concerned }
+ result:=rg[R_INTREGISTER].getregister(list,R_SUBD)
+ end;
+
+
+ procedure TCgJS.do_register_allocation(list:TAsmList;headertai:tai);
+ begin
+ { We only run the "register allocation" once for an arbitrary allocator,
+ which will perform the register->temp mapping for all register types.
+ This allows us to easily reuse temps. }
+ trgcpu(rg[R_INTREGISTER]).do_all_register_allocation(list,headertai);
+ end;
+
+
+ procedure create_codegen;
+ begin
+ cg:=TCgJS.Create;
+ end;
+
+end.
diff --git a/compiler/js/cpubase.pas b/compiler/js/cpubase.pas
new file mode 100644
index 0000000000..32294a4ba6
--- /dev/null
+++ b/compiler/js/cpubase.pas
@@ -0,0 +1,338 @@
+{
+ Copyright (c) 2010 by Jonas Maebe
+
+ Contains the base types for the Java VM
+
+ This program is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation; either version 2 of the License, or
+ (at your option) any later version.
+
+ 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. See the
+ GNU General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+
+ ****************************************************************************
+}
+{ This Unit contains the base types for the Java Virtual Machine
+}
+unit cpubase;
+
+{$i fpcdefs.inc}
+
+interface
+
+uses
+ globtype,
+ aasmbase,cpuinfo,cgbase;
+
+
+{*****************************************************************************
+ Assembler Opcodes
+*****************************************************************************}
+
+ type
+ TAsmOp=(A_None,
+ a_aaload, a_aastore, a_aconst_null,
+ a_aload, a_aload_0, a_aload_1, a_aload_2, a_aload_3,
+ a_anewarray, a_areturn, a_arraylength,
+ a_astore, a_astore_0, a_astore_1, a_astore_2, a_astore_3,
+ a_athrow, a_baload, a_bastore, a_bipush, a_breakpoint,
+ a_caload, a_castore, a_checkcast,
+ a_d2f, a_d2i, a_d2l, a_dadd, a_daload, a_dastore, a_dcmpg, a_dcmpl,
+ a_dconst_0, a_dconst_1, a_ddiv,
+ a_dload, a_dload_0, a_dload_1, a_dload_2, a_dload_3,
+ a_dmul, a_dneg, a_drem, a_dreturn,
+ a_dstore, a_dstore_0, a_dstore_1, a_dstore_2, a_dstore_3,
+ a_dsub,
+ a_dup, a_dup2, a_dup2_x1, a_dup2_x2, a_dup_x1, a_dup_x2,
+ a_f2d, a_f2i, a_f2l, a_fadd, a_faload, a_fastore, a_fcmpg, a_fcmpl,
+ a_fconst_0, a_fconst_1, a_fconst_2, a_fdiv,
+ a_fload, a_fload_0, a_fload_1, a_fload_2, a_fload_3,
+ a_fmul, a_fneg, a_frem, a_freturn,
+ a_fstore, a_fstore_0, a_fstore_1, a_fstore_2, a_fstore_3,
+ a_fsub,
+ a_getfield, a_getstatic,
+ a_goto, a_goto_w,
+ a_i2b, a_i2c, a_i2d, a_i2f, a_i2l, a_i2s,
+ a_iadd, a_iaload, a_iand, a_iastore,
+ a_iconst_m1, a_iconst_0, a_iconst_1, a_iconst_2, a_iconst_3,
+ a_iconst_4, a_iconst_5,
+ a_idiv,
+ a_if_acmpeq, a_if_acmpne, a_if_icmpeq, a_if_icmpge, a_if_icmpgt,
+ a_if_icmple, a_if_icmplt, a_if_icmpne,
+ a_ifeq, a_ifge, a_ifgt, a_ifle, a_iflt, a_ifne, a_ifnonnull, a_ifnull,
+ a_iinc,
+ a_iload, a_iload_0, a_iload_1, a_iload_2, a_iload_3,
+ a_imul, a_ineg,
+ a_instanceof,
+ a_invokeinterface, a_invokespecial, a_invokestatic, a_invokevirtual,
+ a_ior, a_irem, a_ireturn, a_ishl, a_ishr,
+ a_istore, a_istore_0, a_istore_1, a_istore_2, a_istore_3,
+ a_isub, a_iushr, a_ixor,
+ a_jsr, a_jsr_w,
+ a_l2d, a_l2f, a_l2i, a_ladd, a_laload, a_land, a_lastore, a_lcmp,
+ a_lconst_0, a_lconst_1,
+ a_ldc, a_ldc2_w, a_ldc_w, a_ldiv,
+ a_lload, a_lload_0, a_lload_1, a_lload_2, a_lload_3,
+ a_lmul, a_lneg,
+ a_lookupswitch,
+ a_lor, a_lrem,
+ a_lreturn,
+ a_lshl, a_lshr,
+ a_lstore, a_lstore_0, a_lstore_1, a_lstore_2, a_lstore_3,
+ a_lsub, a_lushr, a_lxor,
+ a_monitorenter,
+ a_monitorexit,
+ a_multianewarray,
+ a_new,
+ a_newarray,
+ a_nop,
+ a_pop, a_pop2,
+ a_putfield, a_putstatic,
+ a_ret, a_return,
+ a_saload, a_sastore, a_sipush,
+ a_swap,
+ a_tableswitch,
+ a_wide
+ );
+
+ {# This should define the array of instructions as string }
+ op2strtable=array[tasmop] of string[8];
+
+ Const
+ {# First value of opcode enumeration }
+ firstop = low(tasmop);
+ {# Last value of opcode enumeration }
+ lastop = high(tasmop);
+
+
+{*****************************************************************************
+ Registers
+*****************************************************************************}
+
+ type
+ { Number of registers used for indexing in tables }
+ tregisterindex=0..{$i rjsnor.inc}-1;
+ totherregisterset = set of tregisterindex;
+
+ const
+ { Available Superregisters }
+ {$i rjssup.inc}
+
+ { No Subregisters }
+ R_SUBWHOLE = R_SUBNONE;
+
+ { Available Registers }
+ {$i rjscon.inc}
+
+ { aliases }
+ { used as base register in references for parameters passed to
+ subroutines: these are passed on the evaluation stack, but this way we
+ can use the offset field to indicate the order, which is used by ncal
+ to sort the parameters }
+ NR_EVAL_STACK_BASE = NR_R0;
+
+ maxvarregs = 1;
+ maxfpuvarregs = 1;
+
+ { Integer Super registers first and last }
+ first_int_imreg = 10;
+
+ { Float Super register first and last }
+ first_fpu_imreg = 10;
+
+ { MM Super register first and last }
+ first_mm_imreg = 10;
+
+ regnumber_table : array[tregisterindex] of tregister = (
+ {$i rjsnum.inc}
+ );
+
+ EVALSTACKLOCS = [LOC_REGISTER,LOC_CREGISTER,LOC_FPUREGISTER,LOC_CFPUREGISTER,
+ LOC_MMREGISTER,LOC_CMMREGISTER,LOC_SUBSETREG,LOC_CSUBSETREG];
+
+{*****************************************************************************
+ Conditions
+*****************************************************************************}
+
+ type
+ // not used by jvm target
+ TAsmCond=(C_None);
+
+{*****************************************************************************
+ Constants
+*****************************************************************************}
+
+ const
+ max_operands = 2;
+
+
+{*****************************************************************************
+ Default generic sizes
+*****************************************************************************}
+
+{$ifdef cpu64bitaddr}
+ {# Defines the default address size for a processor,
+ -- fake for JVM, only influences default width of
+ arithmetic calculations }
+ OS_ADDR = OS_64;
+ {# the natural int size for a processor,
+ has to match osuinttype/ossinttype as initialized in psystem }
+ OS_INT = OS_64;
+ OS_SINT = OS_S64;
+{$else}
+ {# Defines the default address size for a processor,
+ -- fake for JVM, only influences default width of
+ arithmetic calculations }
+ OS_ADDR = OS_32;
+ {# the natural int size for a processor,
+ has to match osuinttype/ossinttype as initialized in psystem }
+ OS_INT = OS_32;
+ OS_SINT = OS_S32;
+{$endif}
+ {# the maximum float size for a processor, }
+ OS_FLOAT = OS_F64;
+ {# the size of a vector register for a processor }
+ OS_VECTOR = OS_M128;
+
+{*****************************************************************************
+ Generic Register names
+*****************************************************************************}
+
+ { dummies, not used for JVM }
+
+ {# Stack pointer register }
+ { used as base register in references to indicate that it's a local }
+ NR_STACK_POINTER_REG = NR_R1;
+ RS_STACK_POINTER_REG = RS_R1;
+ {# Frame pointer register }
+ NR_FRAME_POINTER_REG = NR_STACK_POINTER_REG;
+ RS_FRAME_POINTER_REG = RS_STACK_POINTER_REG;
+
+ { Java results are returned on the evaluation stack, not via a register }
+
+ { Results are returned in this register (32-bit values) }
+ NR_FUNCTION_RETURN_REG = NR_NO;
+ RS_FUNCTION_RETURN_REG = RS_NO;
+ { Low part of 64bit return value }
+ NR_FUNCTION_RETURN64_LOW_REG = NR_NO;
+ RS_FUNCTION_RETURN64_LOW_REG = RS_NO;
+ { High part of 64bit return value }
+ NR_FUNCTION_RETURN64_HIGH_REG = NR_NO;
+ RS_FUNCTION_RETURN64_HIGH_REG = RS_NO;
+ { The value returned from a function is available in this register }
+ NR_FUNCTION_RESULT_REG = NR_FUNCTION_RETURN_REG;
+ RS_FUNCTION_RESULT_REG = RS_FUNCTION_RETURN_REG;
+ { The lowh part of 64bit value returned from a function }
+ NR_FUNCTION_RESULT64_LOW_REG = NR_FUNCTION_RETURN64_LOW_REG;
+ RS_FUNCTION_RESULT64_LOW_REG = RS_FUNCTION_RETURN64_LOW_REG;
+ { The high part of 64bit value returned from a function }
+ NR_FUNCTION_RESULT64_HIGH_REG = NR_FUNCTION_RETURN64_HIGH_REG;
+ RS_FUNCTION_RESULT64_HIGH_REG = RS_FUNCTION_RETURN64_HIGH_REG;
+
+ NR_FPU_RESULT_REG = NR_NO;
+ NR_MM_RESULT_REG = NR_NO;
+
+
+{*****************************************************************************
+ GCC /ABI linking information
+*****************************************************************************}
+
+ { dummies, not used for JVM }
+
+ {# Registers which must be saved when calling a routine
+
+ }
+ saved_standard_registers : array[0..0] of tsuperregister = (
+ RS_NO
+ );
+
+ { this is only for the generic code which is not used for this architecture }
+ saved_address_registers : array[0..0] of tsuperregister = (RS_INVALID);
+ saved_mm_registers : array[0..0] of tsuperregister = (RS_INVALID);
+
+ { Required parameter alignment when calling a routine }
+ std_param_align = 1;
+
+
+{*****************************************************************************
+ CPU Dependent Constants
+*****************************************************************************}
+
+ maxfpuregs = 0;
+
+{*****************************************************************************
+ Helpers
+*****************************************************************************}
+
+ function cgsize2subreg(regtype: tregistertype; s:Tcgsize):Tsubregister;
+ function reg_cgsize(const reg: tregister) : tcgsize;
+
+ function std_regnum_search(const s:string):Tregister;
+ function std_regname(r:Tregister):string;
+ function findreg_by_number(r:Tregister):tregisterindex;
+
+implementation
+
+uses
+ rgbase;
+
+{*****************************************************************************
+ Helpers
+*****************************************************************************}
+
+ const
+ std_regname_table : array[tregisterindex] of string[15] = (
+ {$i rjsstd.inc}
+ );
+
+ regnumber_index : array[tregisterindex] of tregisterindex = (
+ {$i rjsrni.inc}
+ );
+
+ std_regname_index : array[tregisterindex] of tregisterindex = (
+ {$i rjssri.inc}
+ );
+
+ function reg_cgsize(const reg: tregister): tcgsize;
+ begin
+ result:=OS_NO;
+ end;
+
+
+ function cgsize2subreg(regtype: tregistertype; s:Tcgsize):Tsubregister;
+ begin
+ cgsize2subreg:=R_SUBNONE;
+ end;
+
+
+ function std_regnum_search(const s:string):Tregister;
+ begin
+ result:=NR_NO;
+ end;
+
+
+ function findreg_by_number(r:Tregister):tregisterindex;
+ begin
+ result:=findreg_by_number_table(r,regnumber_index);
+ end;
+
+ function std_regname(r:Tregister):string;
+ var
+ p : tregisterindex;
+ begin
+ p:=findreg_by_number_table(r,regnumber_index);
+ if p<>0 then
+ result:=std_regname_table[p]
+ else
+ result:=generic_regname(r);
+ end;
+
+
+end.
diff --git a/compiler/js/cpuinfo.pas b/compiler/js/cpuinfo.pas
new file mode 100644
index 0000000000..d4927066c3
--- /dev/null
+++ b/compiler/js/cpuinfo.pas
@@ -0,0 +1,75 @@
+{
+ Copyright (c) 2010 by the Free Pascal development team
+
+ Basic Processor information for the Java VM
+
+ 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.
+
+ **********************************************************************}
+
+Unit cpuinfo;
+
+Interface
+
+ uses
+ globtype;
+
+Type
+ bestreal = double;
+ ts32real = single;
+ ts64real = double;
+ ts80real = extended;
+ ts128real = extended;
+ ts64comp = comp;
+
+ pbestreal=^bestreal;
+
+ { possible supported processors for this target }
+ tcputype =
+ (cpu_none,
+ { JS for asm.js }
+ cpu_asmjs
+ );
+
+ tfputype =
+ (fpu_none,
+ fpu_standard
+ );
+
+
+Const
+ { calling conventions supported by the code generator }
+ supported_calling_conventions : tproccalloptions = [
+ pocall_internproc
+ ];
+
+ cputypestr : array[tcputype] of string[9] = ('',
+ 'ASMJS'
+ );
+
+ fputypestr : array[tfputype] of string[8] = (
+ 'NONE',
+ 'STANDARD'
+ );
+
+ { Supported optimizations, only used for information }
+ supported_optimizerswitches = genericlevel1optimizerswitches+
+ genericlevel2optimizerswitches+
+ genericlevel3optimizerswitches-
+ { no need to write info about those }
+ [cs_opt_level1,cs_opt_level2,cs_opt_level3]+
+ [cs_opt_loopunroll,cs_opt_nodecse];
+
+ level1optimizerswitches = genericlevel1optimizerswitches;
+ level2optimizerswitches = genericlevel2optimizerswitches + level1optimizerswitches + [cs_opt_nodecse];
+ level3optimizerswitches = genericlevel3optimizerswitches + level2optimizerswitches + [{,cs_opt_loopunroll}];
+ level4optimizerswitches = genericlevel4optimizerswitches + level3optimizerswitches + [];
+
+Implementation
+
+end.
diff --git a/compiler/js/cpunode.pas b/compiler/js/cpunode.pas
new file mode 100644
index 0000000000..515ec81e8c
--- /dev/null
+++ b/compiler/js/cpunode.pas
@@ -0,0 +1,38 @@
+{******************************************************************************
+ Copyright (c) 2000-2010 by Florian Klaempfl and Jonas Maebe
+
+ Includes the JS code generator
+
+ This program is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation; either version 2 of the License, or
+ (at your option) any later version.
+
+ 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. See the
+ GNU General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+
+ *****************************************************************************}
+unit cpunode;
+
+{$I fpcdefs.inc}
+
+interface
+{ This unit is used to define the specific CPU implementations. All needed
+actions are included in the INITALIZATION part of these units. This explains
+the behaviour of such a unit having just a USES clause! }
+
+implementation
+
+ uses
+ ncgbas,ncgflw,ncgcnv,ncgld,ncgmem,ncgcon,ncgset,
+ ncgadd, ncgcal,ncgmat,ncginl,
+ { these are not really nodes }
+ rgcpu,tgcpu;
+
+end.
diff --git a/compiler/js/cpupara.pas b/compiler/js/cpupara.pas
new file mode 100644
index 0000000000..fb2d330e1a
--- /dev/null
+++ b/compiler/js/cpupara.pas
@@ -0,0 +1,306 @@
+{
+ Copyright (c) 1998-2010 by Florian Klaempfl, Jonas Maebe
+
+ Calling conventions for the JVM
+
+ This program is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation; either version 2 of the License, or
+ (at your option) any later version.
+
+ 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. See the
+ GNU General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+ *****************************************************************************}
+unit cpupara;
+
+{$i fpcdefs.inc}
+
+interface
+
+ uses
+ globtype,
+ cclasses,
+ aasmtai,aasmdata,
+ cpubase,cpuinfo,
+ symconst,symbase,symsym,symtype,symdef,paramgr,parabase,cgbase,cgutils;
+
+ type
+
+ { TJSParaManager }
+
+ TJSParaManager=class(TParaManager)
+ function push_high_param(varspez:tvarspez;def : tdef;calloption : tproccalloption) : boolean;override;
+ function keep_para_array_range(varspez: tvarspez; def: tdef; calloption: tproccalloption): boolean; override;
+ function push_addr_param(varspez:tvarspez;def : tdef;calloption : tproccalloption) : boolean;override;
+ function push_copyout_param(varspez: tvarspez; def: tdef; calloption: tproccalloption): boolean; override;
+ function push_size(varspez: tvarspez; def: tdef; calloption: tproccalloption): longint;override;
+ {Returns a structure giving the information on the storage of the parameter
+ (which must be an integer parameter)
+ @param(nr Parameter number of routine, starting from 1)}
+ procedure getintparaloc(pd : tabstractprocdef; nr : longint; var cgpara : tcgpara);override;
+ function create_paraloc_info(p : TAbstractProcDef; side: tcallercallee):longint;override;
+ function create_varargs_paraloc_info(p : tabstractprocdef; varargspara:tvarargsparalist):longint;override;
+ function get_funcretloc(p : tabstractprocdef; side: tcallercallee; forcetempdef: tdef): tcgpara;override;
+ function param_use_paraloc(const cgpara: tcgpara): boolean; override;
+ function ret_in_param(def:tdef;pd:tabstractprocdef):boolean;override;
+ function is_stack_paraloc(paraloc: pcgparalocation): boolean;override;
+ private
+ procedure create_paraloc_info_intern(p : tabstractprocdef; side: tcallercallee; paras: tparalist;
+ var parasize:longint);
+ end;
+
+implementation
+
+ uses
+ cutils,verbose,systems,
+ defutil,
+ aasmcpu,
+ hlcgobj;
+
+
+ procedure TJSParaManager.GetIntParaLoc(pd : tabstractprocdef; nr : longint; var cgpara : tcgpara);
+ begin
+ { not yet implemented/used }
+ internalerror(2010121001);
+ end;
+
+ function TJSParaManager.push_high_param(varspez: tvarspez; def: tdef; calloption: tproccalloption): boolean;
+ begin
+ { we don't need a separate high parameter, since all arrays in Java
+ have an implicit associated length }
+ if not is_open_array(def) and
+ not is_array_of_const(def) then
+ result:=inherited
+ else
+ result:=false;
+ end;
+
+
+ function TJSParaManager.keep_para_array_range(varspez: tvarspez; def: tdef; calloption: tproccalloption): boolean;
+ begin
+ { even though these don't need a high parameter (see push_high_param),
+ we do have to keep the original parameter's array length because it's
+ used by the compiler (to determine the size of the array to construct
+ to pass to an array of const parameter) }
+ if not is_array_of_const(def) then
+ result:=inherited
+ else
+ result:=true;
+ end;
+
+
+ { true if a parameter is too large to copy and only the address is pushed }
+ function TJSParaManager.push_addr_param(varspez:tvarspez;def : tdef;calloption : tproccalloption) : boolean;
+ begin
+ result:=
+ // jvmimplicitpointertype(def) or
+ ((def.typ=formaldef) and
+ not(varspez in [vs_var,vs_out]));
+ end;
+
+
+ function TJSParaManager.push_copyout_param(varspez: tvarspez; def: tdef; calloption: tproccalloption): boolean;
+ begin
+ { in principle also for vs_constref, but since we can't have real
+ references, that won't make a difference }
+ result:=
+ (varspez in [vs_var,vs_out,vs_constref]) { and
+ not jvmimplicitpointertype(def) };
+ end;
+
+
+ function TJSParaManager.push_size(varspez: tvarspez; def: tdef; calloption: tproccalloption): longint;
+ begin
+ { all aggregate types are emulated using indirect pointer types }
+ if def.typ in [arraydef,recorddef,setdef,stringdef] then
+ result:=4
+ else
+ result:=inherited;
+ end;
+
+
+ function TJSParaManager.get_funcretloc(p : tabstractprocdef; side: tcallercallee; forcetempdef: tdef): tcgpara;
+ var
+ paraloc : pcgparalocation;
+ retcgsize : tcgsize;
+ begin
+ result.init;
+ result.alignment:=get_para_align(p.proccalloption);
+ if not assigned(forcetempdef) then
+ result.def:=p.returndef
+ else
+ begin
+ result.def:=forcetempdef;
+ result.temporary:=true;
+ end;
+ //!!!! result.def:=get_para_push_size(result.def);
+ { void has no location }
+ if is_void(result.def) then
+ begin
+ paraloc:=result.add_location;
+ result.size:=OS_NO;
+ result.intsize:=0;
+ paraloc^.size:=OS_NO;
+ paraloc^.def:=voidtype;
+ paraloc^.loc:=LOC_VOID;
+ exit;
+ end;
+ { Constructors return self instead of a boolean }
+ if (p.proctypeoption=potype_constructor) then
+ begin
+ retcgsize:=OS_INT;
+ result.intsize:=sizeof(pint);
+ end
+{!!!! else if jvmimplicitpointertype(result.def) then
+ begin
+ retcgsize:=OS_ADDR;
+ result.def:=getpointerdef(result.def);
+ end }
+ else
+ begin
+ retcgsize:=def_cgsize(result.def);
+ result.intsize:=result.def.size;
+ end;
+ result.size:=retcgsize;
+
+ paraloc:=result.add_location;
+ { all values are returned on the evaluation stack }
+ paraloc^.loc:=LOC_REFERENCE;
+ paraloc^.reference.index:=NR_EVAL_STACK_BASE;
+ paraloc^.reference.offset:=0;
+ paraloc^.size:=result.size;
+ paraloc^.def:=result.def;
+ end;
+
+ function TJSParaManager.param_use_paraloc(const cgpara: tcgpara): boolean;
+ begin
+ { all parameters are copied by the VM to local variable locations }
+ result:=true;
+ end;
+
+ function TJSParaManager.ret_in_param(def:tdef;pd:tabstractprocdef):boolean;
+ begin
+ { not as efficient as returning in param for jvmimplicitpointertypes,
+ but in the latter case the routines are harder to use from Java
+ (especially for arrays), because the caller then manually has to
+ allocate the instance/array of the right size }
+ Result:=false;
+ end;
+
+ function TJSParaManager.is_stack_paraloc(paraloc: pcgparalocation): boolean;
+ begin
+ { all parameters are passed on the evaluation stack }
+ result:=true;
+ end;
+
+
+ function TJSParaManager.create_varargs_paraloc_info(p : tabstractprocdef; varargspara:tvarargsparalist):longint;
+ var
+ parasize : longint;
+ begin
+ parasize:=0;
+ { calculate the registers for the normal parameters }
+ create_paraloc_info_intern(p,callerside,p.paras,parasize);
+ { append the varargs }
+ create_paraloc_info_intern(p,callerside,varargspara,parasize);
+ result:=parasize;
+ end;
+
+
+ procedure TJSParaManager.create_paraloc_info_intern(p : tabstractprocdef; side: tcallercallee;paras:tparalist;
+ var parasize:longint);
+ var
+ paraloc : pcgparalocation;
+ i : integer;
+ hp : tparavarsym;
+ paracgsize : tcgsize;
+ paraofs : longint;
+ paradef : tdef;
+ begin
+ paraofs:=0;
+ for i:=0 to paras.count-1 do
+ begin
+ hp:=tparavarsym(paras[i]);
+ if push_copyout_param(hp.varspez,hp.vardef,p.proccalloption) then
+ begin
+ { passed via array reference (instead of creating a new array
+ type for every single parameter, use java_jlobject) }
+ paracgsize:=OS_ADDR;
+ paradef:=java_jlobject;
+ end
+{!!!! else if jvmimplicitpointertype(hp.vardef) then
+ begin
+ paracgsize:=OS_ADDR;
+ paradef:=getpointerdef(hp.vardef);
+ end }
+ else
+ begin
+ paracgsize:=def_cgsize(hp.vardef);
+ if paracgsize=OS_NO then
+ paracgsize:=OS_ADDR;
+ paradef:=hp.vardef;
+ end;
+//!!!!! paradef:=get_para_push_size(paradef);
+ hp.paraloc[side].reset;
+ hp.paraloc[side].size:=paracgsize;
+ hp.paraloc[side].def:=paradef;
+ hp.paraloc[side].alignment:=std_param_align;
+ hp.paraloc[side].intsize:=tcgsize2size[paracgsize];
+ paraloc:=hp.paraloc[side].add_location;
+ { All parameters are passed on the evaluation stack, pushed from
+ left to right (including self, if applicable). At the callee side,
+ they're available as local variables 0..n-1 (with 64 bit values
+ taking up two slots) }
+ paraloc^.loc:=LOC_REFERENCE;;
+ paraloc^.reference.offset:=paraofs;
+ paraloc^.size:=paracgsize;
+ paraloc^.def:=paradef;
+ case side of
+ callerside:
+ begin
+ paraloc^.loc:=LOC_REFERENCE;
+ { we use a fake loc_reference to indicate the stack location;
+ the offset (set above) will be used by ncal to order the
+ parameters so they will be pushed in the right order }
+ paraloc^.reference.index:=NR_EVAL_STACK_BASE;
+ end;
+ calleeside:
+ begin
+ paraloc^.loc:=LOC_REFERENCE;
+ paraloc^.reference.index:=NR_STACK_POINTER_REG;
+ end;
+ end;
+ { 2 slots for 64 bit integers and floats, 1 slot for the rest }
+ if not(is_64bit(paradef) or
+ ((paradef.typ=floatdef) and
+ (tfloatdef(paradef).floattype=s64real))) then
+ inc(paraofs)
+ else
+ inc(paraofs,2);
+ end;
+ parasize:=paraofs;
+ end;
+
+
+ function TJSParaManager.create_paraloc_info(p : tabstractprocdef; side: tcallercallee):longint;
+ var
+ parasize : longint;
+ begin
+ parasize:=0;
+ create_paraloc_info_intern(p,side,p.paras,parasize);
+ { Create Function result paraloc }
+ create_funcretloc_info(p,side);
+ { We need to return the size allocated on the stack }
+ result:=parasize;
+ end;
+
+
+begin
+ ParaManager:=TJSParaManager.create;
+end.
diff --git a/compiler/js/cpupi.pas b/compiler/js/cpupi.pas
new file mode 100644
index 0000000000..5bb4c7b8a0
--- /dev/null
+++ b/compiler/js/cpupi.pas
@@ -0,0 +1,65 @@
+{
+ Copyright (c) 2002-2010 by Florian Klaempfl and Jonas Maebe
+
+ This unit contains the CPU specific part of tprocinfo
+
+ This program is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation; either version 2 of the License, or
+ (at your option) any later version.
+
+ 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. See the
+ GNU General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+
+ ****************************************************************************
+}
+unit cpupi;
+
+{$i fpcdefs.inc}
+
+interface
+
+ uses
+ cutils,
+ procinfo,cpuinfo,
+ psub;
+
+ type
+
+ { TSparcProcInfo }
+
+ TJSProcInfo=class(tcgprocinfo)
+ public
+ procedure set_first_temp_offset;override;
+ end;
+
+implementation
+
+ uses
+ systems,globals,
+ tgobj,paramgr,symconst;
+
+ procedure TJSProcInfo.set_first_temp_offset;
+ begin
+ {
+ Stackframe layout:
+ sp:
+ <incoming parameters>
+ sp+first_temp_offset:
+ <locals>
+ <temp>
+ }
+ procdef.init_paraloc_info(calleeside);
+ tg.setfirsttemp(procdef.calleeargareasize);
+ end;
+
+
+begin
+ cprocinfo:=TJSProcInfo;
+end.
diff --git a/compiler/js/cputarg.pas b/compiler/js/cputarg.pas
new file mode 100644
index 0000000000..186ff8cf3c
--- /dev/null
+++ b/compiler/js/cputarg.pas
@@ -0,0 +1,58 @@
+{
+ Copyright (c) 2001-2010 by Peter Vreman and Jonas Maebe
+
+ Includes the JS dependent target units
+
+ This program is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation; either version 2 of the License, or
+ (at your option) any later version.
+
+ 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. See the
+ GNU General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+
+ ****************************************************************************
+}
+unit cputarg;
+
+{$i fpcdefs.inc}
+
+interface
+
+
+implementation
+
+ uses
+ systems { prevent a syntax error when nothing is included }
+
+{$ifndef NOOPT}
+// ,aoptcpu
+{$endif NOOPT}
+
+{**************************************
+ Targets
+**************************************}
+ ,t_jvm
+
+{**************************************
+ Assemblers
+**************************************}
+ ,agjs
+
+{**************************************
+ Assembler Readers
+**************************************}
+
+{**************************************
+ Debuginfo
+**************************************}
+ //,dbgjasm
+ ;
+
+end.
diff --git a/compiler/js/hlcgcpu.pas b/compiler/js/hlcgcpu.pas
new file mode 100644
index 0000000000..9e55cb6f35
--- /dev/null
+++ b/compiler/js/hlcgcpu.pas
@@ -0,0 +1,64 @@
+{
+ Copyright (c) 1998-2010 by Florian Klaempfl and Jonas Maebe
+ Member of the Free Pascal development team
+
+ This unit implements the js high level code generator
+
+ This program is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation; either version 2 of the License, or
+ (at your option) any later version.
+
+ 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. See the
+ GNU General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+
+ ****************************************************************************
+}
+unit hlcgcpu;
+
+{$i fpcdefs.inc}
+
+interface
+
+uses
+ globtype,
+ aasmbase,aasmdata,
+ symbase,symconst,symtype,symdef,symsym,
+ cpubase, hlcgobj, cgbase, cgutils, parabase;
+
+ type
+ thlcgjs = class(thlcgobj)
+ public
+ constructor create;
+ end;
+
+ procedure create_hlcodegen;
+
+implementation
+
+ uses
+ verbose,cutils,globals,fmodule,constexp,
+ defutil,
+ aasmtai,aasmcpu,
+ symtable,
+ procinfo,cpuinfo,cgcpu,tgobj;
+
+
+ constructor thlcgjs.create;
+ begin
+ end;
+
+
+ procedure create_hlcodegen;
+ begin
+ hlcg:=thlcgjs.create;
+ create_codegen;
+ end;
+
+end.
diff --git a/compiler/js/rgcpu.pas b/compiler/js/rgcpu.pas
new file mode 100644
index 0000000000..879a752bc1
--- /dev/null
+++ b/compiler/js/rgcpu.pas
@@ -0,0 +1,358 @@
+{
+ Copyright (c) 2010 by Jonas Maebe
+
+ This unit implements the JVM specific class for the register
+ allocator
+
+ This program is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation; either version 2 of the License, or
+ (at your option) any later version.
+
+ 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. See the
+ GNU General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+
+ ****************************************************************************}
+unit rgcpu;
+
+{$i fpcdefs.inc}
+
+ interface
+
+ uses
+ aasmbase,aasmcpu,aasmtai,aasmdata,
+ cgbase,cgutils,
+ cpubase,
+ rgobj;
+
+ type
+ tspilltemps = array[tregistertype] of ^Tspill_temp_list;
+
+ { trgcpu }
+
+ trgcpu=class(trgobj)
+ protected
+ class procedure do_spill_replace_all(list:TAsmList;instr:taicpu;const spilltemps: tspilltemps);
+ class procedure remove_dummy_load_stores(list: TAsmList; headertai: tai);
+ public
+ { performs the register allocation for *all* register types }
+ class procedure do_all_register_allocation(list: TAsmList; headertai: tai);
+ end;
+
+
+implementation
+
+ uses
+ verbose,cutils,
+ globtype,globals,
+ cgobj,
+ tgobj;
+
+ { trgcpu }
+
+ class procedure trgcpu.do_spill_replace_all(list:TAsmList;instr:taicpu;const spilltemps: tspilltemps);
+ var
+ l: longint;
+ reg: tregister;
+ begin
+ { jvm instructions never have more than one memory (virtual register)
+ operand, so there is no danger of superregister conflicts }
+ for l:=0 to instr.ops-1 do
+ if instr.oper[l]^.typ=top_reg then
+ begin
+ reg:=instr.oper[l]^.reg;
+ instr.loadref(l,spilltemps[getregtype(reg)]^[getsupreg(reg)]);
+ end;
+ end;
+
+
+ class procedure trgcpu.remove_dummy_load_stores(list: TAsmList; headertai: tai);
+
+ type
+ taitypeset = set of taitype;
+
+ function nextskipping(p: tai; const skip: taitypeset): tai;
+ begin
+ result:=p;
+ if not assigned(result) then
+ exit;
+ repeat
+ result:=tai(result.next);
+ until not assigned(result) or
+ not(result.typ in skip);
+ end;
+
+ function issimpleregstore(p: tai; var reg: tregister; doubleprecisionok: boolean): boolean;
+ const
+ simplestoressp = [a_astore,a_fstore,a_istore];
+ simplestoresdp = [a_dstore,a_lstore];
+ begin
+ result:=
+ assigned(p) and
+ (p.typ=ait_instruction) and
+ ((taicpu(p).opcode in simplestoressp) or
+ (doubleprecisionok and
+ (taicpu(p).opcode in simplestoresdp))) and
+ ((reg=NR_NO) or
+ (taicpu(p).oper[0]^.typ=top_reg) and
+ (taicpu(p).oper[0]^.reg=reg));
+ if result and
+ (reg=NR_NO) then
+ reg:=taicpu(p).oper[0]^.reg;
+ end;
+
+ function issimpleregload(p: tai; var reg: tregister; doubleprecisionok: boolean): boolean;
+ const
+ simpleloadssp = [a_aload,a_fload,a_iload];
+ simpleloadsdp = [a_dload,a_lload];
+ begin
+ result:=
+ assigned(p) and
+ (p.typ=ait_instruction) and
+ ((taicpu(p).opcode in simpleloadssp) or
+ (doubleprecisionok and
+ (taicpu(p).opcode in simpleloadsdp))) and
+ ((reg=NR_NO) or
+ (taicpu(p).oper[0]^.typ=top_reg) and
+ (taicpu(p).oper[0]^.reg=reg));
+ if result and
+ (reg=NR_NO) then
+ reg:=taicpu(p).oper[0]^.reg;
+ end;
+
+ function isregallocoftyp(p: tai; typ: TRegAllocType;var reg: tregister): boolean;
+ begin
+ result:=
+ assigned(p) and
+ (p.typ=ait_regalloc) and
+ (tai_regalloc(p).ratype=typ);
+ if result then
+ if reg=NR_NO then
+ reg:=tai_regalloc(p).reg
+ else
+ result:=tai_regalloc(p).reg=reg;
+ end;
+
+ function regininstruction(p: tai; reg: tregister): boolean;
+ var
+ sr: tsuperregister;
+ i: longint;
+ begin
+ result:=false;
+ if p.typ<>ait_instruction then
+ exit;
+ sr:=getsupreg(reg);
+ for i:=0 to taicpu(p).ops-1 do
+ case taicpu(p).oper[0]^.typ of
+ top_reg:
+ if (getsupreg(taicpu(p).oper[0]^.reg)=sr) then
+ exit(true);
+ top_ref:
+ begin
+ if (getsupreg(taicpu(p).oper[0]^.ref^.base)=sr) then
+ exit(true);
+ if (getsupreg(taicpu(p).oper[0]^.ref^.index)=sr) then
+ exit(true);
+{ if (getsupreg(taicpu(p).oper[0]^.ref^.indexbase)=sr) then
+ exit(true);
+ if (getsupreg(taicpu(p).oper[0]^.ref^.indexbase)=sr) then
+ exit(true); }
+ end;
+ end;
+ end;
+
+ function try_remove_store_dealloc_load(var p: tai): boolean;
+ var
+ dealloc,
+ load: tai;
+ reg: tregister;
+ begin
+ result:=false;
+ { check for:
+ store regx
+ dealloc regx
+ load regx
+ and remove. We don't have to check that the load/store
+ types match, because they have to for this to be
+ valid JVM code }
+ dealloc:=nextskipping(p,[ait_comment]);
+ load:=nextskipping(dealloc,[ait_comment]);
+ reg:=NR_NO;
+ if issimpleregstore(p,reg,true) and
+ isregallocoftyp(dealloc,ra_dealloc,reg) and
+ issimpleregload(load,reg,true) then
+ begin
+ { remove the whole sequence: the store }
+ list.remove(p);
+ p.free;
+ p:=Tai(load.next);
+ { the load }
+ list.remove(load);
+ load.free;
+
+ result:=true;
+ end;
+ end;
+
+
+ var
+ p,next,nextnext: tai;
+ reg: tregister;
+ removedsomething: boolean;
+ begin
+ repeat
+ removedsomething:=false;
+ p:=headertai;
+ while assigned(p) do
+ begin
+ case p.typ of
+ ait_regalloc:
+ begin
+ reg:=NR_NO;
+ next:=nextskipping(p,[ait_comment]);
+ nextnext:=nextskipping(next,[ait_comment,ait_regalloc]);
+ if assigned(nextnext) then
+ begin
+ { remove
+ alloc reg
+ dealloc reg
+
+ (can appear after optimisations, necessary to prevent
+ useless stack slot allocations) }
+ if isregallocoftyp(p,ra_alloc,reg) and
+ isregallocoftyp(next,ra_dealloc,reg) and
+ not regininstruction(nextnext,reg) then
+ begin
+ list.remove(p);
+ p.free;
+ p:=tai(next.next);
+ list.remove(next);
+ next.free;
+ removedsomething:=true;
+ continue;
+ end;
+ end;
+ end;
+ ait_instruction:
+ begin
+ if try_remove_store_dealloc_load(p) then
+ begin
+ removedsomething:=true;
+ continue;
+ end;
+ { todo in peephole optimizer:
+ alloc regx // not double precision
+ store regx // not double precision
+ load regy or memy
+ dealloc regx
+ load regx
+ -> change into
+ load regy or memy
+ swap // can only handle single precision
+
+ and then
+ swap
+ <commutative op>
+ -> remove swap
+ }
+ end;
+ end;
+ p:=tai(p.next);
+ end;
+ until not removedsomething;
+ end;
+
+
+ class procedure trgcpu.do_all_register_allocation(list: TAsmList; headertai: tai);
+ var
+ spill_temps : tspilltemps;
+ templist : TAsmList;
+ intrg,
+ fprg : trgcpu;
+ p,q : tai;
+ size : longint;
+ begin
+ { Since there are no actual registers, we simply spill everything. We
+ use tt_regallocator temps, which are not used by the temp allocator
+ during code generation, so that we cannot accidentally overwrite
+ any temporary values }
+
+ { get references to all register allocators }
+ intrg:=trgcpu(cg.rg[R_INTREGISTER]);
+ fprg:=trgcpu(cg.rg[R_FPUREGISTER]);
+ { determine the live ranges of all registers }
+ intrg.insert_regalloc_info_all(list);
+ fprg.insert_regalloc_info_all(list);
+ { Don't do the actual allocation when -sr is passed }
+ if (cs_no_regalloc in current_settings.globalswitches) then
+ exit;
+ { remove some simple useless store/load sequences }
+ remove_dummy_load_stores(list,headertai);
+ { allocate room to store the virtual register -> temp mapping }
+ spill_temps[R_INTREGISTER]:=allocmem(sizeof(treference)*intrg.maxreg);
+ spill_temps[R_FPUREGISTER]:=allocmem(sizeof(treference)*fprg.maxreg);
+ { List to insert temp allocations into }
+ templist:=TAsmList.create;
+ { allocate/replace all registers }
+ p:=headertai;
+ while assigned(p) do
+ begin
+ case p.typ of
+ ait_regalloc:
+ with Tai_regalloc(p) do
+ begin
+ case getregtype(reg) of
+ R_INTREGISTER:
+ if getsubreg(reg)=R_SUBD then
+ size:=4
+ else
+ size:=8;
+ R_ADDRESSREGISTER:
+ size:=4;
+ R_FPUREGISTER:
+ if getsubreg(reg)=R_SUBFS then
+ size:=4
+ else
+ size:=8;
+ else
+ internalerror(2010122912);
+ end;
+ case ratype of
+ ra_alloc :
+ tg.gettemp(templist,
+ size,1,
+ tt_regallocator,spill_temps[getregtype(reg)]^[getsupreg(reg)]);
+ ra_dealloc :
+ begin
+ tg.ungettemp(templist,spill_temps[getregtype(reg)]^[getsupreg(reg)]);
+ { don't invalidate the temp reference, may still be used one instruction
+ later }
+ end;
+ end;
+ { insert the tempallocation/free at the right place }
+ list.insertlistbefore(p,templist);
+ { remove the register allocation info for the register
+ (p.previous is valid because we just inserted the temp
+ allocation/free before p) }
+ q:=Tai(p.previous);
+ list.remove(p);
+ p.free;
+ p:=q;
+ end;
+ ait_instruction:
+ do_spill_replace_all(list,taicpu(p),spill_temps);
+ end;
+ p:=Tai(p.next);
+ end;
+ freemem(spill_temps[R_INTREGISTER]);
+ freemem(spill_temps[R_FPUREGISTER]);
+ templist.free;
+ end;
+
+end.
diff --git a/compiler/js/rjscon.inc b/compiler/js/rjscon.inc
new file mode 100644
index 0000000000..913141e2e5
--- /dev/null
+++ b/compiler/js/rjscon.inc
@@ -0,0 +1,5 @@
+{ don't edit, this file is generated from jsreg.dat }
+NR_NO = tregister($00000000);
+NR_R0 = tregister($01000000);
+NR_R1 = tregister($01000001);
+NR_R2 = tregister($01000002);
diff --git a/compiler/js/rjsnor.inc b/compiler/js/rjsnor.inc
new file mode 100644
index 0000000000..9fb50d2944
--- /dev/null
+++ b/compiler/js/rjsnor.inc
@@ -0,0 +1,2 @@
+{ don't edit, this file is generated from jsreg.dat }
+4
diff --git a/compiler/js/rjsnum.inc b/compiler/js/rjsnum.inc
new file mode 100644
index 0000000000..1721d28fdf
--- /dev/null
+++ b/compiler/js/rjsnum.inc
@@ -0,0 +1,5 @@
+{ don't edit, this file is generated from jsreg.dat }
+tregister($00000000),
+tregister($01000000),
+tregister($01000001),
+tregister($01000002)
diff --git a/compiler/js/rjsrni.inc b/compiler/js/rjsrni.inc
new file mode 100644
index 0000000000..81cdaeaae1
--- /dev/null
+++ b/compiler/js/rjsrni.inc
@@ -0,0 +1,5 @@
+{ don't edit, this file is generated from jsreg.dat }
+0,
+1,
+2,
+3
diff --git a/compiler/js/rjssri.inc b/compiler/js/rjssri.inc
new file mode 100644
index 0000000000..bcd835f76a
--- /dev/null
+++ b/compiler/js/rjssri.inc
@@ -0,0 +1,5 @@
+{ don't edit, this file is generated from jsreg.dat }
+0,
+3,
+1,
+2
diff --git a/compiler/js/rjsstd.inc b/compiler/js/rjsstd.inc
new file mode 100644
index 0000000000..3f7acf5779
--- /dev/null
+++ b/compiler/js/rjsstd.inc
@@ -0,0 +1,5 @@
+{ don't edit, this file is generated from jsreg.dat }
+'INVALID',
+'evalstacktopptr',
+'localsstackptr',
+'evalstacktop'
diff --git a/compiler/js/rjssup.inc b/compiler/js/rjssup.inc
new file mode 100644
index 0000000000..3640d74e8b
--- /dev/null
+++ b/compiler/js/rjssup.inc
@@ -0,0 +1,5 @@
+{ don't edit, this file is generated from jsreg.dat }
+RS_NO = $00;
+RS_R0 = $00;
+RS_R1 = $01;
+RS_R2 = $02;
diff --git a/compiler/js/symcpu.pas b/compiler/js/symcpu.pas
new file mode 100644
index 0000000000..23a03112de
--- /dev/null
+++ b/compiler/js/symcpu.pas
@@ -0,0 +1,211 @@
+{
+ Copyright (c) 2014 by the FPC development team and Florian Klaempfl
+
+ Symbol table overrides for JS
+
+ This program is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation; either version 2 of the License, or
+ (at your option) any later version.
+
+ 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. See the
+ GNU General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+
+ ****************************************************************************
+}
+unit symcpu;
+
+{$i fpcdefs.inc}
+
+interface
+
+uses
+ symtype,symdef,symsym,globtype;
+
+type
+ { defs }
+ tcpufiledef = class(tfiledef)
+ end;
+ tcpufiledefclass = class of tcpufiledef;
+
+ tcpuvariantdef = class(tvariantdef)
+ end;
+ tcpuvariantdefclass = class of tcpuvariantdef;
+
+ tcpuformaldef = class(tformaldef)
+ end;
+ tcpuformaldefclass = class of tcpuformaldef;
+
+ tcpuforwarddef = class(tforwarddef)
+ end;
+ tcpuforwarddefclass = class of tcpuforwarddef;
+
+ tcpuundefineddef = class(tundefineddef)
+ end;
+ tcpuundefineddefclass = class of tcpuundefineddef;
+
+ tcpuerrordef = class(terrordef)
+ end;
+ tcpuerrordefclass = class of tcpuerrordef;
+
+ tcpupointerdef = class(tpointerdef)
+ end;
+ tcpupointerdefclass = class of tcpupointerdef;
+
+ tcpurecorddef = class(trecorddef)
+ end;
+ tcpurecorddefclass = class of tcpurecorddef;
+
+ tcpuimplementedinterface = class(timplementedinterface)
+ end;
+ tcpuimplementedinterfaceclass = class of tcpuimplementedinterface;
+
+ tcpuobjectdef = class(tobjectdef)
+ end;
+ tcpuobjectdefclass = class of tcpuobjectdef;
+
+ tcpuclassrefdef = class(tclassrefdef)
+ end;
+ tcpuclassrefdefclass = class of tcpuclassrefdef;
+
+ tcpuarraydef = class(tarraydef)
+ end;
+ tcpuarraydefclass = class of tcpuarraydef;
+
+ tcpuorddef = class(torddef)
+ end;
+ tcpuorddefclass = class of tcpuorddef;
+
+ tcpufloatdef = class(tfloatdef)
+ end;
+ tcpufloatdefclass = class of tcpufloatdef;
+
+ tcpuprocvardef = class(tprocvardef)
+ end;
+ tcpuprocvardefclass = class of tcpuprocvardef;
+
+ tcpuprocdef = class(tprocdef)
+ end;
+ tcpuprocdefclass = class of tcpuprocdef;
+
+ tcpustringdef = class(tstringdef)
+ end;
+ tcpustringdefclass = class of tcpustringdef;
+
+ tcpuenumdef = class(tenumdef)
+ end;
+ tcpuenumdefclass = class of tcpuenumdef;
+
+ tcpusetdef = class(tsetdef)
+ end;
+ tcpusetdefclass = class of tcpusetdef;
+
+ { syms }
+ tcpulabelsym = class(tlabelsym)
+ end;
+ tcpulabelsymclass = class of tcpulabelsym;
+
+ tcpuunitsym = class(tunitsym)
+ end;
+ tcpuunitsymclass = class of tcpuunitsym;
+
+ tcpunamespacesym = class(tnamespacesym)
+ end;
+ tcpunamespacesymclass = class of tcpunamespacesym;
+
+ tcpuprocsym = class(tprocsym)
+ end;
+ tcpuprocsymclass = class of tcpuprocsym;
+
+ tcpuypesym = class(ttypesym)
+ end;
+ tcpuypesymclass = class of tcpuypesym;
+
+ tcpufieldvarsym = class(tfieldvarsym)
+ end;
+ tcpufieldvarsymclass = class of tcpufieldvarsym;
+
+ tcpulocalvarsym = class(tlocalvarsym)
+ end;
+ tcpulocalvarsymclass = class of tcpulocalvarsym;
+
+ tcpuparavarsym = class(tparavarsym)
+ end;
+ tcpuparavarsymclass = class of tcpuparavarsym;
+
+ tcpustaticvarsym = class(tstaticvarsym)
+ end;
+ tcpustaticvarsymclass = class of tcpustaticvarsym;
+
+ tcpuabsolutevarsym = class(tabsolutevarsym)
+ end;
+ tcpuabsolutevarsymclass = class of tcpuabsolutevarsym;
+
+ tcpupropertysym = class(tpropertysym)
+ end;
+ tcpupropertysymclass = class of tcpupropertysym;
+
+ tcpuconstsym = class(tconstsym)
+ end;
+ tcpuconstsymclass = class of tcpuconstsym;
+
+ tcpuenumsym = class(tenumsym)
+ end;
+ tcpuenumsymclass = class of tcpuenumsym;
+
+ tcpusyssym = class(tsyssym)
+ end;
+ tcpusyssymclass = class of tcpusyssym;
+
+
+const
+ pbestrealtype : ^tdef = @s64floattype;
+
+
+implementation
+
+begin
+ { used tdef classes }
+ cfiledef:=tcpufiledef;
+ cvariantdef:=tcpuvariantdef;
+ cformaldef:=tcpuformaldef;
+ cforwarddef:=tcpuforwarddef;
+ cundefineddef:=tcpuundefineddef;
+ cerrordef:=tcpuerrordef;
+ cpointerdef:=tcpupointerdef;
+ crecorddef:=tcpurecorddef;
+ cimplementedinterface:=tcpuimplementedinterface;
+ cobjectdef:=tcpuobjectdef;
+ cclassrefdef:=tcpuclassrefdef;
+ carraydef:=tcpuarraydef;
+ corddef:=tcpuorddef;
+ cfloatdef:=tcpufloatdef;
+ cprocvardef:=tcpuprocvardef;
+ cprocdef:=tcpuprocdef;
+ cstringdef:=tcpustringdef;
+ cenumdef:=tcpuenumdef;
+ csetdef:=tcpusetdef;
+
+ { used tsym classes }
+ clabelsym:=tcpulabelsym;
+ cunitsym:=tcpuunitsym;
+ cnamespacesym:=tcpunamespacesym;
+ cprocsym:=tcpuprocsym;
+ ctypesym:=tcpuypesym;
+ cfieldvarsym:=tcpufieldvarsym;
+ clocalvarsym:=tcpulocalvarsym;
+ cparavarsym:=tcpuparavarsym;
+ cstaticvarsym:=tcpustaticvarsym;
+ cabsolutevarsym:=tcpuabsolutevarsym;
+ cpropertysym:=tcpupropertysym;
+ cconstsym:=tcpuconstsym;
+ cenumsym:=tcpuenumsym;
+ csyssym:=tcpusyssym;
+end.
+
diff --git a/compiler/js/tgcpu.pas b/compiler/js/tgcpu.pas
new file mode 100644
index 0000000000..b34384f90b
--- /dev/null
+++ b/compiler/js/tgcpu.pas
@@ -0,0 +1,261 @@
+{
+ Copyright (C) 2010 by Jonas Maebe
+
+ This unit handles the temporary variables for the JVM
+
+ This program is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation; either version 2 of the License, or
+ (at your option) any later version.
+
+ 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. See the
+ GNU General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+
+ ****************************************************************************
+}
+{
+ This unit handles the temporary variables for the JVM.
+}
+unit tgcpu;
+
+{$i fpcdefs.inc}
+
+ interface
+
+ uses
+ globtype,
+ aasmdata,
+ cgutils,
+ symtype,tgobj;
+
+ type
+ ttgjs = class(ttgobj)
+ protected
+ procedure getimplicitobjtemp(list: TAsmList; def: tdef; temptype: ttemptype; out ref: treference);
+ function getifspecialtemp(list: TAsmList; def: tdef; forcesize: aint; temptype: ttemptype; out ref: treference): boolean;
+ procedure alloctemp(list: TAsmList; size, alignment: longint; temptype: ttemptype; def: tdef; out ref: treference); override;
+ public
+ procedure setfirsttemp(l : longint); override;
+ procedure getlocal(list: TAsmList; size: longint; alignment: shortint; def: tdef; var ref: treference); override;
+ procedure gethltemp(list: TAsmList; def: tdef; forcesize: aint; temptype: ttemptype; out ref: treference); override;
+ procedure gethltemptyped(list: TAsmList; def: tdef; temptype: ttemptype; out ref: treference); override;
+ end;
+
+ implementation
+
+ uses
+ verbose,
+ cgbase,
+ symconst,symdef,symsym,defutil,
+ cpubase,aasmcpu,
+ hlcgobj,hlcgcpu;
+
+
+ procedure ttgjs.getimplicitobjtemp(list: TAsmList; def: tdef; temptype: ttemptype; out ref: treference);
+ var
+ sym: tsym;
+ pd: tprocdef;
+ begin
+ gettemp(list,java_jlobject.size,java_jlobject.alignment,temptype,ref);
+ list.concat(taicpu.op_sym(a_new,current_asmdata.RefAsmSymbol(tabstractrecorddef(def).jvm_full_typename(true))));
+ { the constructor doesn't return anything, so put a duplicate of the
+ self pointer on the evaluation stack for use as function result
+ after the constructor has run }
+ list.concat(taicpu.op_none(a_dup));
+
+ //!!!!!!!!!!!! thlcgjvm(hlcg).incstack(list,2);
+
+ { call the constructor }
+ sym:=tsym(tabstractrecorddef(def).symtable.find('CREATE'));
+ if assigned(sym) and
+ (sym.typ=procsym) then
+ begin
+ pd:=tprocsym(sym).find_bytype_parameterless(potype_constructor);
+ if not assigned(pd) then
+ internalerror(2011032701);
+ end
+ else
+ internalerror(2011060301);
+ hlcg.a_call_name(list,pd,pd.mangledname,nil,false);
+
+ //!!!!!!!!!!!!!! thlcgjvm(hlcg).decstack(list,1);
+
+ { store reference to instance }
+ //!!!!!!!!!!!!!!! thlcgjvm(hlcg).a_load_stack_ref(list,java_jlobject,ref,0);
+ end;
+
+
+ function ttgjs.getifspecialtemp(list: TAsmList; def: tdef; forcesize: aint; temptype: ttemptype; out ref: treference): boolean;
+ var
+ eledef: tdef;
+ ndim: longint;
+ sym: tsym;
+ pd: tprocdef;
+ begin
+ result:=false;
+ case def.typ of
+ arraydef:
+ begin
+ if not is_dynamic_array(def) then
+ begin
+ { allocate an array of the right size }
+ gettemp(list,java_jlobject.size,java_jlobject.alignment,temptype,ref);
+ ndim:=0;
+ eledef:=def;
+ repeat
+ //!!!!!!!!!!!!!!!! if forcesize<>-1 then
+ //!!!!!!!!!!!!!!!! thlcgjvm(hlcg).a_load_const_stack(list,s32inttype,forcesize div tarraydef(eledef).elesize,R_INTREGISTER)
+ //!!!!!!!!!!!!!!!! else
+ //!!!!!!!!!!!!!!!! thlcgjvm(hlcg).a_load_const_stack(list,s32inttype,tarraydef(eledef).elecount,R_INTREGISTER);
+ eledef:=tarraydef(eledef).elementdef;
+ inc(ndim);
+ forcesize:=-1;
+ until (eledef.typ<>arraydef) or
+ is_dynamic_array(eledef);
+ eledef:=tarraydef(def).elementdef;
+ //!!!!!!!!!!!!!!!! thlcgjvm(hlcg).g_newarray(list,def,ndim);
+ //!!!!!!!!!!!!!!!! thlcgjvm(hlcg).a_load_stack_ref(list,java_jlobject,ref,0);
+ result:=true;
+ end;
+ end;
+ recorddef:
+ begin
+ getimplicitobjtemp(list,def,temptype,ref);
+ result:=true;
+ end;
+ setdef:
+ begin
+ if tsetdef(def).elementdef.typ=enumdef then
+ begin
+ { load enum class type }
+ //!!!!!!!!!!!!!!!! list.concat(taicpu.op_sym(a_ldc,current_asmdata.RefAsmSymbol(tenumdef(tsetdef(def).elementdef).getbasedef.classdef.jvm_full_typename(true))));
+ //!!!!!!!!!!!!!!!! thlcgjvm(hlcg).incstack(current_asmdata.CurrAsmList,1);
+ { call tenumset.noneOf() class method }
+ sym:=tsym(tobjectdef(java_juenumset).symtable.find('NONEOF'));
+ if assigned(sym) and
+ (sym.typ=procsym) then
+ begin
+ if tprocsym(sym).procdeflist.Count<>1 then
+ internalerror(2011062801);
+ pd:=tprocdef(tprocsym(sym).procdeflist[0]);
+ end;
+ hlcg.a_call_name(list,pd,pd.mangledname,nil,false);
+ { static calls method replaces parameter with set instance
+ -> no change in stack height }
+ end
+ else
+ begin
+ list.concat(taicpu.op_sym(a_new,current_asmdata.RefAsmSymbol(java_jubitset.jvm_full_typename(true))));
+ { the constructor doesn't return anything, so put a duplicate of the
+ self pointer on the evaluation stack for use as function result
+ after the constructor has run }
+ list.concat(taicpu.op_none(a_dup));
+ //!!!!!!!!!!!!!!!! thlcgjvm(hlcg).incstack(list,2);
+ { call the constructor }
+ sym:=tsym(java_jubitset.symtable.find('CREATE'));
+ if assigned(sym) and
+ (sym.typ=procsym) then
+ begin
+ pd:=tprocsym(sym).find_bytype_parameterless(potype_constructor);
+ if not assigned(pd) then
+ internalerror(2011062802);
+ end
+ else
+ internalerror(2011062803);
+ hlcg.a_call_name(list,pd,pd.mangledname,nil,false);
+ { duplicate self pointer is removed }
+ //!!!!!!!!!!!!!!!! thlcgjvm(hlcg).decstack(list,1);
+ end;
+ { store reference to instance }
+ gettemp(list,java_jlobject.size,java_jlobject.alignment,temptype,ref);
+ //!!!!!!!!!!!!!!!! thlcgjvm(hlcg).a_load_stack_ref(list,java_jlobject,ref,0);
+ result:=true;
+ end;
+ procvardef:
+ begin
+ if not tprocvardef(def).is_addressonly then
+ begin
+ //!!!!!!!!!!!!!!!! getimplicitobjtemp(list,tprocvardef(def).classdef,temptype,ref);
+ result:=true;
+ end;
+ end;
+ stringdef:
+ begin
+ if is_shortstring(def) then
+ begin
+ gettemp(list,java_jlobject.size,java_jlobject.alignment,temptype,ref);
+ { add the maxlen parameter (s8inttype because parameters must
+ be sign extended) }
+ //!!!!!!!!!!!!!!!! thlcgjvm(hlcg).a_load_const_stack(list,s8inttype,shortint(tstringdef(def).len),R_INTREGISTER);
+ { call the constructor }
+ sym:=tsym(tobjectdef(java_shortstring).symtable.find('CREATEEMPTY'));
+ if assigned(sym) and
+ (sym.typ=procsym) then
+ begin
+ if tprocsym(sym).procdeflist.Count<>1 then
+ internalerror(2011052404);
+ pd:=tprocdef(tprocsym(sym).procdeflist[0]);
+ end;
+ hlcg.a_call_name(list,pd,pd.mangledname,nil,false);
+ { static calls method replaces parameter with string instance
+ -> no change in stack height }
+ { store reference to instance }
+ //!!!!!!!!!!!!!!!! thlcgjvm(hlcg).a_load_stack_ref(list,java_jlobject,ref,0);
+ result:=true;
+ end;
+ end;
+ end;
+ end;
+
+
+ procedure ttgjs.alloctemp(list: TAsmList; size, alignment: longint; temptype: ttemptype; def: tdef; out ref: treference);
+ begin
+ { the JVM only supports 1 slot (= 4 bytes in FPC) and 2 slot (= 8 bytes in
+ FPC) temps on the stack. double and int64 are 2 slots, the rest is one slot.
+ There are no problems with reusing the same slot for a value of a different
+ type. There are no alignment requirements either. }
+ if size<4 then
+ size:=4;
+ if not(size in [4,8]) then
+ internalerror(2010121401);
+ { don't pass on "def", since we don't care if a slot is used again for a
+ different type }
+ inherited alloctemp(list, size shr 2, 1, temptype, nil,ref);
+ end;
+
+
+ procedure ttgjs.setfirsttemp(l: longint);
+ begin
+ firsttemp:=l;
+ lasttemp:=l;
+ end;
+
+
+ procedure ttgjs.getlocal(list: TAsmList; size: longint; alignment: shortint; def: tdef; var ref: treference);
+ begin
+ if not getifspecialtemp(list,def,size,tt_persistent,ref) then
+ inherited;
+ end;
+
+
+ procedure ttgjs.gethltemp(list: TAsmList; def: tdef; forcesize: aint; temptype: ttemptype; out ref: treference);
+ begin
+ if not getifspecialtemp(list,def,forcesize,temptype,ref) then
+ inherited;
+ end;
+
+ procedure ttgjs.gethltemptyped(list: TAsmList; def: tdef; temptype: ttemptype; out ref: treference);
+ begin
+ gethltemp(list,def,def.size,temptype,ref);
+ end;
+
+
+begin
+ tgobjclass:=ttgjs;
+end.
View Lorry Controller Status