aboutsummaryrefslogtreecommitdiff
path: root/new-luxc/source/luxc/generator/host/jvm
diff options
context:
space:
mode:
Diffstat (limited to 'new-luxc/source/luxc/generator/host/jvm')
-rw-r--r--new-luxc/source/luxc/generator/host/jvm/def.lux26
-rw-r--r--new-luxc/source/luxc/generator/host/jvm/inst.lux256
2 files changed, 144 insertions, 138 deletions
diff --git a/new-luxc/source/luxc/generator/host/jvm/def.lux b/new-luxc/source/luxc/generator/host/jvm/def.lux
index 6f0f97d9b..42cfa2d68 100644
--- a/new-luxc/source/luxc/generator/host/jvm/def.lux
+++ b/new-luxc/source/luxc/generator/host/jvm/def.lux
@@ -2,6 +2,7 @@
lux
(lux (data [text]
text/format
+ [product]
(coll ["a" array]
[list "L/" Functor<List>]))
[host #+ jvm-import do-to])
@@ -154,11 +155,11 @@
<flag>
(visibility-flag visibility)
(class-flag config))
- name
+ ($t;binary-name name)
(parameters-signature parameters super interfaces)
- (|> super class-to-type $t;descriptor)
+ (|> super product;left $t;binary-name)
(|> interfaces
- (L/map (|>. class-to-type $t;descriptor))
+ (L/map (|>. product;left $t;binary-name))
string-array)]))
definitions)
_ (ClassWriter.visitEnd [] writer)]
@@ -181,11 +182,11 @@
Opcodes.ACC_INTERFACE
(visibility-flag visibility)
(class-flag config))
- name
+ ($t;binary-name name)
(parameters-signature parameters $Object interfaces)
- (|> $Object class-to-type $t;descriptor)
+ (|> $Object product;left $t;binary-name)
(|> interfaces
- (L/map (|>. class-to-type $t;descriptor))
+ (L/map (|>. product;left $t;binary-name))
string-array)]))
definitions)
_ (ClassWriter.visitEnd [] writer)]
@@ -198,7 +199,7 @@
(let [=method (ClassWriter.visitMethod [($_ i.+
(visibility-flag visibility)
(method-flag config))
- name
+ ($t;binary-name name)
($t;method-descriptor type)
($t;method-signature type)
(exceptions-array type)]
@@ -217,7 +218,7 @@
(visibility-flag visibility)
(method-flag config)
Opcodes.ACC_ABSTRACT)
- name
+ ($t;binary-name name)
($t;method-descriptor type)
($t;method-signature type)
(exceptions-array type)]
@@ -231,7 +232,10 @@
(let [=field (do-to (ClassWriter.visitField [($_ i.+
(visibility-flag visibility)
(field-flag config))
- name ($t;descriptor type) ($t;signature type) (host;null)] writer)
+ ($t;binary-name name)
+ ($t;descriptor type)
+ ($t;signature type)
+ (host;null)] writer)
(FieldVisitor.visitEnd []))]
writer)))
@@ -242,7 +246,9 @@
(let [=field (do-to (ClassWriter.visitField [($_ i.+
(visibility-flag visibility)
(field-flag config))
- name ($t;descriptor <jvm-type>) ($t;signature <jvm-type>)
+ ($t;binary-name name)
+ ($t;descriptor <jvm-type>)
+ ($t;signature <jvm-type>)
(<prepare> value)]
writer)
(FieldVisitor.visitEnd []))]
diff --git a/new-luxc/source/luxc/generator/host/jvm/inst.lux b/new-luxc/source/luxc/generator/host/jvm/inst.lux
index 824598ab8..30148c4e5 100644
--- a/new-luxc/source/luxc/generator/host/jvm/inst.lux
+++ b/new-luxc/source/luxc/generator/host/jvm/inst.lux
@@ -1,6 +1,13 @@
(;module:
[lux #- char]
- (lux [host #+ jvm-import do-to])
+ (lux (control monad
+ ["p" parser])
+ (data text/format
+ (coll [list "L/" Functor<List>]))
+ [host #+ jvm-import do-to]
+ [macro]
+ (macro [code]
+ ["s" syntax #+ syntax:]))
["$" ..]
(.. ["$t" type]))
@@ -8,83 +15,85 @@
(jvm-import #long java.lang.Object)
(jvm-import #long java.lang.String)
-(jvm-import org.objectweb.asm.Opcodes
- (#static T_BOOLEAN int)
- (#static T_CHAR int)
- (#static T_FLOAT int)
- (#static T_DOUBLE int)
- (#static T_BYTE int)
- (#static T_SHORT int)
- (#static T_INT int)
- (#static T_LONG int)
-
- (#static CHECKCAST int)
- (#static NEW int)
- (#static NEWARRAY int)
- (#static ANEWARRAY int)
-
- (#static DUP int)
- (#static DUP2_X1 int)
- (#static POP int)
- (#static POP2 int)
-
- (#static IF_ICMPEQ int)
- (#static IF_ACMPEQ int)
- (#static IFNULL int)
- (#static GOTO int)
-
- (#static ACONST_NULL int)
-
- (#static ILOAD int)
- (#static ALOAD int)
-
- (#static IADD int)
-
- (#static LAND int)
- (#static LOR int)
- (#static LXOR int)
- (#static LSHL int)
- (#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)
- (#static L2D int)
- (#static D2L int)
- (#static I2C int)
-
- (#static AALOAD int)
- (#static AASTORE int)
- (#static ARRAYLENGTH int)
-
- (#static GETSTATIC int)
- (#static PUTSTATIC int)
- (#static GETFIELD int)
- (#static PUTFIELD int)
-
- (#static INVOKESTATIC int)
- (#static INVOKESPECIAL int)
- (#static INVOKEVIRTUAL int)
-
- (#static ATHROW int)
-
- (#static RETURN int)
- (#static ARETURN int)
- )
+(syntax: (declare [codes (p;many s;local-symbol)])
+ (|> codes
+ (L/map (function [code] (` ((~' #static) (~ (code;local-symbol code)) (~' int)))))
+ wrap))
+
+(with-expansions [<primitive> (declare T_BOOLEAN T_CHAR T_FLOAT T_DOUBLE
+ T_BYTE T_SHORT T_INT T_LONG)
+ <stack> (declare DUP DUP2_X1
+ POP POP2
+ SWAP)
+ <jump> (declare IF_ICMPEQ IF_ACMPEQ IFNULL
+ IFLT IFLE IFGT IFGE
+ GOTO)]
+ (jvm-import org.objectweb.asm.Opcodes
+ <primitive>
+
+ (#static CHECKCAST int)
+ (#static NEW int)
+ (#static NEWARRAY int)
+ (#static ANEWARRAY int)
+
+ <stack>
+ <jump>
+
+ (#static ACONST_NULL int)
+
+ (#static ILOAD int)
+ (#static LLOAD int)
+ (#static ALOAD int)
+
+ (#static IADD int)
+
+ (#static LAND int)
+ (#static LOR int)
+ (#static LXOR int)
+ (#static LSHL int)
+ (#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)
+ (#static L2D int)
+ (#static D2L int)
+ (#static I2C int)
+
+ (#static AALOAD int)
+ (#static AASTORE int)
+ (#static ARRAYLENGTH int)
+
+ (#static GETSTATIC int)
+ (#static PUTSTATIC int)
+ (#static GETFIELD int)
+ (#static PUTFIELD int)
+
+ (#static INVOKESTATIC int)
+ (#static INVOKESPECIAL int)
+ (#static INVOKEVIRTUAL int)
+
+ (#static ATHROW int)
+
+ (#static RETURN int)
+ (#static IRETURN int)
+ (#static LRETURN int)
+ (#static ARETURN int)
+ ))
(jvm-import org.objectweb.asm.FieldVisitor
(visitEnd [] void))
@@ -126,57 +135,48 @@
[string Text id]
)
-(do-template [<name> <inst>]
+(syntax: (prefix [base s;local-symbol])
+ (wrap (list (code;local-symbol (format "Opcodes." base)))))
+
+(def: #export NULL
+ $;Inst
+ (function [visitor]
+ (do-to visitor
+ (MethodVisitor.visitInsn [(prefix ACONST_NULL)]))))
+
+(do-template [<name>]
[(def: #export <name>
$;Inst
(function [visitor]
(do-to visitor
- (MethodVisitor.visitInsn [<inst>]))))]
+ (MethodVisitor.visitInsn [(prefix <name>)]))))]
- [DUP Opcodes.DUP]
- [DUP2_X1 Opcodes.DUP2_X1]
- [POP Opcodes.POP]
- [POP2 Opcodes.POP2]
+ ## Stack
+ [DUP] [DUP2_X1] [POP] [POP2] [SWAP]
- [NULL Opcodes.ACONST_NULL]
-
- [IADD Opcodes.IADD]
-
- [LAND Opcodes.LAND]
- [LOR Opcodes.LOR]
- [LXOR Opcodes.LXOR]
- [LSHL Opcodes.LSHL]
- [LSHR Opcodes.LSHR]
- [LUSHR Opcodes.LUSHR]
-
- [LADD Opcodes.LADD]
- [LSUB Opcodes.LSUB]
- [LMUL Opcodes.LMUL]
- [LDIV Opcodes.LDIV]
- [LREM Opcodes.LREM]
- [LCMP Opcodes.LCMP]
-
- [DADD Opcodes.DADD]
- [DSUB Opcodes.DSUB]
- [DMUL Opcodes.DMUL]
- [DDIV Opcodes.DDIV]
- [DREM Opcodes.DREM]
- [DCMPG Opcodes.DCMPG]
-
- [I2L Opcodes.I2L]
- [L2I Opcodes.L2I]
- [L2D Opcodes.L2D]
- [D2L Opcodes.D2L]
- [I2C Opcodes.I2C]
-
- [AALOAD Opcodes.AALOAD]
- [AASTORE Opcodes.AASTORE]
- [ARRAYLENGTH Opcodes.ARRAYLENGTH]
+ ## Integer arithmetic
+ [IADD]
+
+ ## Long bitwise
+ [LAND] [LOR] [LXOR] [LSHL] [LSHR] [LUSHR]
- [ATHROW Opcodes.ATHROW]
+ ## Long arithmethic
+ [LADD] [LSUB] [LMUL] [LDIV] [LREM] [LCMP]
- [RETURN Opcodes.RETURN]
- [ARETURN Opcodes.ARETURN]
+ ## Double arithmetic
+ [DADD] [DSUB] [DMUL] [DDIV] [DREM] [DCMPG]
+
+ ## Conversions
+ [I2L] [L2I] [L2D] [D2L] [I2C]
+
+ ## Array
+ [AALOAD] [AASTORE] [ARRAYLENGTH]
+
+ ## Exceptions
+ [ATHROW]
+
+ ## Return
+ [RETURN] [IRETURN] [LRETURN] [ARETURN]
)
(do-template [<name> <inst>]
@@ -186,8 +186,9 @@
(do-to visitor
(MethodVisitor.visitVarInsn [<inst> (nat-to-int register)]))))]
- [ALOAD Opcodes.ALOAD]
[ILOAD Opcodes.ILOAD]
+ [LLOAD Opcodes.LLOAD]
+ [ALOAD Opcodes.ALOAD]
)
(do-template [<name> <inst>]
@@ -242,17 +243,16 @@
[INVOKESPECIAL Opcodes.INVOKESPECIAL]
)
-(do-template [<name> <inst>]
+(do-template [<name>]
[(def: #export (<name> @where)
(-> $;Label $;Inst)
(function [visitor]
(do-to visitor
- (MethodVisitor.visitJumpInsn [<inst> @where]))))]
+ (MethodVisitor.visitJumpInsn [(prefix <name>) @where]))))]
- [IF_ICMPEQ Opcodes.IF_ICMPEQ]
- [IF_ACMPEQ Opcodes.IF_ACMPEQ]
- [IFNULL Opcodes.IFNULL]
- [GOTO Opcodes.GOTO]
+ [IF_ICMPEQ] [IF_ACMPEQ] [IFNULL]
+ [IFLT] [IFLE] [IFGT] [IFGE]
+ [GOTO]
)
(def: #export (label @label)