From 50cc5fbe7cc8abde05085944393fcec4c791402f Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Tue, 5 Sep 2017 18:36:09 -0400 Subject: - Updated new compiler's code to the recent changes in the language. - WIP: Some other changes/additions to the new compiler. --- new-luxc/source/luxc/generator/host/jvm/def.lux | 6 +- new-luxc/source/luxc/generator/host/jvm/inst.lux | 133 ++++++++++++----------- 2 files changed, 74 insertions(+), 65 deletions(-) (limited to 'new-luxc/source/luxc/generator/host') diff --git a/new-luxc/source/luxc/generator/host/jvm/def.lux b/new-luxc/source/luxc/generator/host/jvm/def.lux index 8931db940..8b961b29a 100644 --- a/new-luxc/source/luxc/generator/host/jvm/def.lux +++ b/new-luxc/source/luxc/generator/host/jvm/def.lux @@ -62,7 +62,7 @@ (-> (List Text) (a;Array Text)) (let [output (host;array String (list;size values))] (exec (L/map (function [[idx value]] - (host;array-store idx value output)) + (host;array-write idx value output)) (list;enumerate values)) output))) @@ -261,8 +261,8 @@ [short-field Int $t;short host;l2s] [int-field Int $t;int host;l2i] [long-field Int $t;long id] - [float-field Real $t;float host;d2f] - [double-field Real $t;double id] + [float-field Frac $t;float host;d2f] + [double-field Frac $t;double id] [char-field Nat $t;char (|>. nat-to-int host;l2i host;i2c)] [string-field Text ($t;class "java.lang.String" (list)) id] ) diff --git a/new-luxc/source/luxc/generator/host/jvm/inst.lux b/new-luxc/source/luxc/generator/host/jvm/inst.lux index 30148c4e5..af5f6f6d8 100644 --- a/new-luxc/source/luxc/generator/host/jvm/inst.lux +++ b/new-luxc/source/luxc/generator/host/jvm/inst.lux @@ -22,12 +22,18 @@ (with-expansions [ (declare T_BOOLEAN T_CHAR T_FLOAT T_DOUBLE T_BYTE T_SHORT T_INT T_LONG) - (declare DUP DUP2_X1 + (declare DUP DUP2 DUP2_X1 DUP2_X2 POP POP2 SWAP) (declare IF_ICMPEQ IF_ACMPEQ IFNULL - IFLT IFLE IFGT IFGE - GOTO)] + IFEQ IFLT IFLE IFGT IFGE + GOTO) + (declare ILOAD LLOAD DLOAD ALOAD + ISTORE LSTORE) + (declare IADD ISUB + LADD LSUB LMUL LDIV LREM LCMP + DADD DSUB DMUL DDIV DREM DCMPG) + (declare RETURN IRETURN LRETURN DRETURN ARETURN)] (jvm-import org.objectweb.asm.Opcodes @@ -41,11 +47,7 @@ (#static ACONST_NULL int) - (#static ILOAD int) - (#static LLOAD int) - (#static ALOAD int) - - (#static IADD int) + (#static LAND int) (#static LOR int) @@ -54,19 +56,7 @@ (#static LSHR int) (#static LUSHR int) - (#static LADD int) - (#static LSUB int) - (#static LMUL int) - (#static LDIV int) - (#static LREM int) - (#static LCMP int) - - (#static DADD int) - (#static DSUB int) - (#static DMUL int) - (#static DDIV int) - (#static DREM int) - (#static DCMPG int) + (#static I2L int) (#static L2I int) @@ -89,10 +79,7 @@ (#static ATHROW int) - (#static RETURN int) - (#static IRETURN int) - (#static LRETURN int) - (#static ARETURN int) + )) (jvm-import org.objectweb.asm.FieldVisitor @@ -113,7 +100,8 @@ (visitIntInsn [int int] void) (visitMethodInsn [int String String String boolean] void) (visitLabel [Label] void) - (visitJumpInsn [int Label] void)) + (visitJumpInsn [int Label] void) + (visitTryCatchBlock [Label Label Label String] void)) ## [Insts] (def: #export (with-label action) @@ -130,7 +118,7 @@ [boolean Bool id] [int Int host;l2i] [long Int id] - [double Real id] + [double Frac id] [char Nat (|>. nat-to-int host;l2i host;i2c)] [string Text id] ) @@ -152,14 +140,14 @@ (MethodVisitor.visitInsn [(prefix )]))))] ## Stack - [DUP] [DUP2_X1] [POP] [POP2] [SWAP] - - ## Integer arithmetic - [IADD] + [DUP] [DUP2] [DUP2_X1] [DUP2_X2] [POP] [POP2] [SWAP] ## Long bitwise [LAND] [LOR] [LXOR] [LSHL] [LSHR] [LUSHR] + ## Integer arithmetic + [IADD] [ISUB] + ## Long arithmethic [LADD] [LSUB] [LMUL] [LDIV] [LREM] [LCMP] @@ -176,19 +164,18 @@ [ATHROW] ## Return - [RETURN] [IRETURN] [LRETURN] [ARETURN] + [RETURN] [IRETURN] [LRETURN] [DRETURN] [ARETURN] ) -(do-template [ ] +(do-template [] [(def: #export ( register) (-> Nat $;Inst) (function [visitor] (do-to visitor - (MethodVisitor.visitVarInsn [ (nat-to-int register)]))))] + (MethodVisitor.visitVarInsn [(prefix ) (nat-to-int register)]))))] - [ILOAD Opcodes.ILOAD] - [LLOAD Opcodes.LLOAD] - [ALOAD Opcodes.ALOAD] + [ILOAD] [LLOAD] [DLOAD] [ALOAD] + [ISTORE] [LSTORE] ) (do-template [ ] @@ -251,10 +238,16 @@ (MethodVisitor.visitJumpInsn [(prefix ) @where]))))] [IF_ICMPEQ] [IF_ACMPEQ] [IFNULL] - [IFLT] [IFLE] [IFGT] [IFGE] + [IFEQ] [IFLT] [IFLE] [IFGT] [IFGE] [GOTO] ) +(def: #export (try @from @to @handler exception) + (-> $;Label $;Label $;Label Text $;Inst) + (function [visitor] + (do-to visitor + (MethodVisitor.visitTryCatchBlock [@from @to @handler ($t;binary-name exception)])))) + (def: #export (label @label) (-> $;Label $;Inst) (function [visitor] @@ -282,30 +275,46 @@ (|>. (int (nat-to-int size)) (ANEWARRAY ($t;descriptor type))))) -(do-template [ ] - [(def: #export - $;Inst - (|>. (INVOKESTATIC "valueOf" - ($t;method (list ) - (#;Some ($t;class (list))) - (list)) - false))) - (def: #export - $;Inst - (|>. (CHECKCAST ) - (INVOKEVIRTUAL - ($t;method (list) (#;Some ) (list)) - false)))] - - [wrap-boolean unwrap-boolean "java.lang.Boolean" "booleanValue" $t;boolean] - [wrap-byte unwrap-byte "java.lang.Byte" "byteValue" $t;byte] - [wrap-short unwrap-short "java.lang.Short" "shortValue" $t;short] - [wrap-int unwrap-int "java.lang.Integer" "intValue" $t;int] - [wrap-long unwrap-long "java.lang.Long" "longValue" $t;long] - [wrap-float unwrap-float "java.lang.Float" "floatValue" $t;float] - [wrap-double unwrap-double "java.lang.Double" "doubleValue" $t;double] - [wrap-char unwrap-char "java.lang.Character" "charValue" $t;char] - ) +(def: (primitive-wrapper type) + (-> $;Primitive Text) + (case type + #$;Boolean "java.lang.Boolean" + #$;Byte "java.lang.Byte" + #$;Short "java.lang.Short" + #$;Int "java.lang.Integer" + #$;Long "java.lang.Long" + #$;Float "java.lang.Float" + #$;Double "java.lang.Double" + #$;Char "java.lang.Character")) + +(def: (primitive-unwrap type) + (-> $;Primitive Text) + (case type + #$;Boolean "booleanValue" + #$;Byte "byteValue" + #$;Short "shortValue" + #$;Int "intValue" + #$;Long "longValue" + #$;Float "floatValue" + #$;Double "doubleValue" + #$;Char "charValue")) + +(def: #export (wrap type) + (-> $;Primitive $;Inst) + (let [class (primitive-wrapper type)] + (|>. (INVOKESTATIC class "valueOf" + ($t;method (list (#$;Primitive type)) + (#;Some ($t;class class (list))) + (list)) + false)))) + +(def: #export (unwrap type) + (-> $;Primitive $;Inst) + (let [class (primitive-wrapper type)] + (|>. (CHECKCAST class) + (INVOKEVIRTUAL class (primitive-unwrap type) + ($t;method (list) (#;Some (#$;Primitive type)) (list)) + false)))) (def: #export (fuse insts) (-> (List $;Inst) $;Inst) -- cgit v1.2.3