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.lux146
-rw-r--r--new-luxc/source/luxc/generator/host/jvm/inst.lux151
2 files changed, 276 insertions, 21 deletions
diff --git a/new-luxc/source/luxc/generator/host/jvm/def.lux b/new-luxc/source/luxc/generator/host/jvm/def.lux
index 1fd87caea..39fab2f2a 100644
--- a/new-luxc/source/luxc/generator/host/jvm/def.lux
+++ b/new-luxc/source/luxc/generator/host/jvm/def.lux
@@ -1,6 +1,8 @@
(;module:
lux
- (lux (data (coll ["a" array]
+ (lux (data [text]
+ text/format
+ (coll ["a" array]
[list "L/" Functor<List>]))
[host #+ jvm-import do-to])
["$" ..]
@@ -15,13 +17,26 @@
(#static ACC_PROTECTED int)
(#static ACC_PRIVATE int)
+ (#static ACC_TRANSIENT int)
+ (#static ACC_VOLATILE int)
+
(#static ACC_ABSTRACT int)
(#static ACC_FINAL int)
(#static ACC_STATIC int)
(#static ACC_SYNCHRONIZED int)
- (#static ACC_TRANSIENT int)
- (#static ACC_VOLATILE int))
+ (#static ACC_SUPER int)
+ (#static ACC_INTERFACE int)
+
+ (#static V1_1 int)
+ (#static V1_2 int)
+ (#static V1_3 int)
+ (#static V1_4 int)
+ (#static V1_5 int)
+ (#static V1_6 int)
+ (#static V1_7 int)
+ (#static V1_8 int)
+ )
(jvm-import org.objectweb.asm.FieldVisitor
(visitEnd [] void))
@@ -41,15 +56,32 @@
(toByteArray [] Byte-Array))
## [Defs]
-(def: (exceptions-array type)
- (-> $;Method (a;Array Text))
- (let [exs (|> type (get@ #$;exceptions) (L/map (|>. #$;Generic $t;descriptor)))
- output (host;array String (list;size exs))]
+(def: (string-array values)
+ (-> (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))
- (list;enumerate exs))
+ (list;enumerate values))
output)))
+(def: exceptions-array
+ (-> $;Method (a;Array Text))
+ (|>. (get@ #$;exceptions)
+ (L/map (|>. #$;Generic $t;descriptor))
+ string-array))
+
+(def: (version-flag version)
+ (-> $;Version Int)
+ (case version
+ #$;V1.1 Opcodes.V1_1
+ #$;V1.2 Opcodes.V1_2
+ #$;V1.3 Opcodes.V1_3
+ #$;V1.4 Opcodes.V1_4
+ #$;V1.5 Opcodes.V1_5
+ #$;V1.6 Opcodes.V1_6
+ #$;V1.7 Opcodes.V1_7
+ #$;V1.8 Opcodes.V1_8))
+
(def: (visibility-flag visibility)
(-> $;Visibility Int)
(case visibility
@@ -58,6 +90,11 @@
#$;Private Opcodes.ACC_PRIVATE
#$;Default 0))
+(def: (class-flag config)
+ (-> $;Class-Config Int)
+ ($_ i.+
+ (if (get@ #$;finalC config) Opcodes.ACC_FINAL 0)))
+
(def: (method-flag config)
(-> $;Method-Config Int)
($_ i.+
@@ -73,6 +110,87 @@
(if (get@ #$;transientF config) Opcodes.ACC_TRANSIENT 0)
(if (get@ #$;volatileF config) Opcodes.ACC_VOLATILE 0)))
+(def: class-to-type
+ (-> $;Class $;Type)
+ (|>. #$;Class #$;Generic))
+
+(def: param-signature
+ (-> $;Class Text)
+ (|>. class-to-type $t;signature (format ":")))
+
+(def: (formal-param [name super interfaces])
+ (-> $;Parameter Text)
+ (format name
+ (param-signature super)
+ (|> interfaces
+ (L/map param-signature)
+ (text;join-with ""))))
+
+(def: (parameters-signature parameters super interfaces)
+ (-> (List $;Parameter) $;Class (List $;Class)
+ Text)
+ (let [formal-params (if (list;empty? parameters)
+ ""
+ (format "<"
+ (|> parameters
+ (L/map formal-param)
+ (text;join-with ""))
+ ">"))]
+ (format formal-params
+ (|> super class-to-type $t;signature)
+ (|> interfaces
+ (L/map (|>. class-to-type $t;signature))
+ (text;join-with "")))))
+
+(do-template [<name> <flag>]
+ [(def: #export (<name> version visibility config name parameters super interfaces
+ definitions)
+ (-> $;Version $;Visibility $;Class-Config Text (List $;Parameter) $;Class (List $;Class) $;Def
+ host;Byte-Array)
+ (let [writer (|> (do-to (ClassWriter.new ClassWriter.COMPUTE_MAXS)
+ (ClassWriter.visit [(version-flag version)
+ ($_ i.+
+ Opcodes.ACC_SUPER
+ <flag>
+ (visibility-flag visibility)
+ (class-flag config))
+ name
+ (parameters-signature parameters super interfaces)
+ (|> super class-to-type $t;descriptor)
+ (|> interfaces
+ (L/map (|>. class-to-type $t;descriptor))
+ string-array)]))
+ definitions)
+ _ (ClassWriter.visitEnd [] writer)]
+ (ClassWriter.toByteArray [] writer)))]
+
+ [class 0]
+ [abstract Opcodes.ACC_ABSTRACT]
+ )
+
+(def: $Object $;Class ["java.lang.Object" (list)])
+
+(def: #export (interface version visibility config name parameters interfaces
+ definitions)
+ (-> $;Version $;Visibility $;Class-Config Text (List $;Parameter) (List $;Class) $;Def
+ host;Byte-Array)
+ (let [writer (|> (do-to (ClassWriter.new ClassWriter.COMPUTE_MAXS)
+ (ClassWriter.visit [(version-flag version)
+ ($_ i.+
+ Opcodes.ACC_SUPER
+ Opcodes.ACC_INTERFACE
+ (visibility-flag visibility)
+ (class-flag config))
+ name
+ (parameters-signature parameters $Object interfaces)
+ (|> $Object class-to-type $t;descriptor)
+ (|> interfaces
+ (L/map (|>. class-to-type $t;descriptor))
+ string-array)]))
+ definitions)
+ _ (ClassWriter.visitEnd [] writer)]
+ (ClassWriter.toByteArray [] writer)))
+
(def: #export (method visibility config name type then)
(-> $;Visibility $;Method-Config Text $;Method $;Inst
$;Def)
@@ -140,3 +258,15 @@
[char-field Char $t;char id]
[string-field Text ($t;class "java.lang.String" (list)) id]
)
+
+(def: #export (fuse defs)
+ (-> (List $;Def) $;Def)
+ (case defs
+ #;Nil
+ id
+
+ (#;Cons singleton #;Nil)
+ singleton
+
+ (#;Cons head tail)
+ (. head (fuse tail))))
diff --git a/new-luxc/source/luxc/generator/host/jvm/inst.lux b/new-luxc/source/luxc/generator/host/jvm/inst.lux
index f340be055..82b360883 100644
--- a/new-luxc/source/luxc/generator/host/jvm/inst.lux
+++ b/new-luxc/source/luxc/generator/host/jvm/inst.lux
@@ -18,25 +18,80 @@
(#static T_INT int)
(#static T_LONG int)
+ (#static CHECKCAST int)
+ (#static NEW int)
+ (#static NEWARRAY int)
+ (#static ANEWARRAY int)
+
(#static DUP int)
- (#static RETURN int)
- (#static ARETURN 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 NEWARRAY int)
- (#static ANEWARRAY 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 INVOKEVIRTUAL int)
(#static INVOKESPECIAL int)
- (#static CHECKCAST int))
+ (#static INVOKEVIRTUAL int)
+
+ (#static ATHROW int)
+
+ (#static RETURN int)
+ (#static ARETURN int)
+ )
(jvm-import org.objectweb.asm.FieldVisitor
(visitEnd [] void))
+(jvm-import org.objectweb.asm.Label
+ (new []))
+
(jvm-import org.objectweb.asm.MethodVisitor
(visitCode [] void)
(visitMaxs [int int] void)
@@ -47,9 +102,15 @@
(visitTypeInsn [int String] void)
(visitVarInsn [int int] void)
(visitIntInsn [int int] void)
- (visitMethodInsn [int String String String boolean] void))
+ (visitMethodInsn [int String String String boolean] void)
+ (visitLabel [Label] void)
+ (visitJumpInsn [int Label] void))
## [Insts]
+(def: #export (with-label action)
+ (-> (-> Label $;Inst) $;Inst)
+ (action (Label.new [])))
+
(do-template [<name> <type> <prepare>]
[(def: #export (<name> value)
(-> <type> $;Inst)
@@ -72,11 +133,50 @@
(do-to visitor
(MethodVisitor.visitInsn [<inst>]))))]
- [RETURN Opcodes.RETURN]
- [ARETURN Opcodes.ARETURN]
- [NULL Opcodes.ACONST_NULL]
- [DUP Opcodes.DUP]
- [AASTORE Opcodes.AASTORE]
+ [DUP Opcodes.DUP]
+ [DUP2_X1 Opcodes.DUP2_X1]
+ [POP Opcodes.POP]
+ [POP2 Opcodes.POP2]
+
+ [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]
+
+ [ATHROW Opcodes.ATHROW]
+
+ [RETURN Opcodes.RETURN]
+ [ARETURN Opcodes.ARETURN]
)
(do-template [<name> <inst>]
@@ -97,7 +197,11 @@
(do-to visitor
(MethodVisitor.visitFieldInsn [<inst> ($t;binary-name class) field ($t;descriptor type)]))))]
+ [GETSTATIC Opcodes.GETSTATIC]
[PUTSTATIC Opcodes.PUTSTATIC]
+
+ [PUTFIELD Opcodes.PUTFIELD]
+ [GETFIELD Opcodes.GETFIELD]
)
(do-template [<name> <inst>]
@@ -107,8 +211,9 @@
(do-to visitor
(MethodVisitor.visitTypeInsn [<inst> ($t;binary-name class)]))))]
- [ANEWARRAY Opcodes.ANEWARRAY]
[CHECKCAST Opcodes.CHECKCAST]
+ [NEW Opcodes.NEW]
+ [ANEWARRAY Opcodes.ANEWARRAY]
)
(def: #export (NEWARRAY type)
@@ -134,8 +239,28 @@
[INVOKESTATIC Opcodes.INVOKESTATIC]
[INVOKEVIRTUAL Opcodes.INVOKEVIRTUAL]
+ [INVOKESPECIAL Opcodes.INVOKESPECIAL]
)
+(do-template [<name> <inst>]
+ [(def: #export (<name> @where)
+ (-> $;Label $;Inst)
+ (function [visitor]
+ (do-to visitor
+ (MethodVisitor.visitJumpInsn [<inst> @where]))))]
+
+ [IF_ICMPEQ Opcodes.IF_ICMPEQ]
+ [IF_ACMPEQ Opcodes.IF_ACMPEQ]
+ [IFNULL Opcodes.IFNULL]
+ [GOTO Opcodes.GOTO]
+ )
+
+(def: #export (label @label)
+ (-> $;Label $;Inst)
+ (function [visitor]
+ (do-to visitor
+ (MethodVisitor.visitLabel [@label]))))
+
(def: #export (array type size)
(-> $;Type Nat $;Inst)
(case type
generated by cgit v1.2.3 (git 2.25.1) at 2024-09-17 23:22:21 +0000