aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorEduardo Julian2016-11-13 09:17:22 -0400
committerEduardo Julian2016-11-13 09:17:22 -0400
commit472eab9dcc1f72c806129928b0d0791a0ccdcc09 (patch)
treefa865879a26e755dbb22a3813167997ed3bb6867
parent8e25b93a1ce46bfa46b322540d4732b36cbd7f02 (diff)
- Added a new way to handle synchronized blocks.
- Implemented Nat division, remainder, comparison, encode and decode on byte-code.
Diffstat (limited to '')
-rw-r--r--src/lux/analyser/host.clj10
-rw-r--r--src/lux/compiler/host.clj354
2 files changed, 315 insertions, 49 deletions
diff --git a/src/lux/analyser/host.clj b/src/lux/analyser/host.clj
index 98baad662..180e3ef54 100644
--- a/src/lux/analyser/host.clj
+++ b/src/lux/analyser/host.clj
@@ -676,6 +676,15 @@
(return (&/|list (&&/|meta exo-type _cursor
(&&/$proc (&/T ["jvm" "null"]) (&/|list) (&/|list)))))))
+(defn analyse-jvm-synchronized [analyse exo-type ?values]
+ (|do [:let [(&/$Cons ?monitor (&/$Cons ?expr (&/$Nil))) ?values]
+ =monitor (&&/analyse-1+ analyse ?monitor)
+ _ (ensure-object (&&/expr-type* =monitor))
+ =expr (&&/analyse-1 analyse exo-type ?expr)
+ _cursor &/cursor]
+ (return (&/|list (&&/|meta exo-type _cursor
+ (&&/$proc (&/T ["jvm" "synchronized"]) (&/|list =monitor =expr) (&/|list)))))))
+
(do-template [<name> <tag>]
(defn <name> [analyse exo-type ?values]
(|do [:let [(&/$Cons ?monitor (&/$Nil)) ?values]
@@ -1228,6 +1237,7 @@
"jvm"
(case proc
+ "synchronized" (analyse-jvm-synchronized analyse exo-type ?values)
"load-class" (analyse-jvm-load-class analyse exo-type ?values)
"try" (analyse-jvm-try analyse exo-type ?values)
"throw" (analyse-jvm-throw analyse exo-type ?values)
diff --git a/src/lux/compiler/host.clj b/src/lux/compiler/host.clj
index 4990fbf87..d987076c1 100644
--- a/src/lux/compiler/host.clj
+++ b/src/lux/compiler/host.clj
@@ -1088,56 +1088,272 @@
(let [+wrapper-class+ (&host-generics/->bytecode-class-name "java.lang.Long")]
(defn ^:private compile-LuxRT-nat-methods [^ClassWriter =class]
- (|let [_ (let [$end (new Label)
- ;; $then (new Label)
- $else (new Label)
- $from (new Label)
+ (|let [;; http://grepcode.com/file/repository.grepcode.com/java/root/jdk/openjdk/8u40-b25/java/lang/Long.java#677
+ _ (let [$from (new Label)
$to (new Label)
- $handler (new Label)]
+ $handler (new Label)
+
+ $good-start (new Label)
+ $short-enough (new Label)
+ $bad-digit (new Label)
+ $out-of-bounds (new Label)]
(doto (.visitMethod =class (+ Opcodes/ACC_PUBLIC Opcodes/ACC_STATIC) "decode_nat" "(Ljava/lang/String;)Ljava/lang/Object;" nil nil)
(.visitCode)
+ (.visitTryCatchBlock $from $to $handler "java/lang/Exception")
+ (.visitLabel $from)
+ ;; Remove the + at the beginning...
(.visitVarInsn Opcodes/ALOAD 0)
+ (.visitLdcInsn (int 0))
+ (.visitLdcInsn (int 0))
+ (.visitMethodInsn Opcodes/INVOKEVIRTUAL "java/lang/String" "substring" "(II)Ljava/lang/String;")
(.visitLdcInsn "+")
- (.visitMethodInsn Opcodes/INVOKEVIRTUAL "java/lang/String" "startsWith" "(Ljava/lang/String;)Z")
- (.visitJumpInsn Opcodes/IFEQ $else)
+ (.visitMethodInsn Opcodes/INVOKEVIRTUAL "java/lang/Object" "equals" "(Ljava/lang/Object;)Z")
+ (.visitJumpInsn Opcodes/IFNE $good-start)
+ ;; Doesn't start with +
+ (.visitMethodInsn Opcodes/INVOKESTATIC "lux/LuxRT" "make_none" "()Ljava/lang/Object;")
+ (.visitInsn Opcodes/ARETURN)
+ ;; Starts with +
+ (.visitLabel $good-start)
(.visitVarInsn Opcodes/ALOAD 0)
(.visitLdcInsn (int 1))
- (.visitMethodInsn Opcodes/INVOKEVIRTUAL "java/lang/String" "substring" "(I)Ljava/lang/String;")
- (.visitTryCatchBlock $from $to $handler "java/lang/Exception")
- (.visitLabel $from)
- (.visitMethodInsn Opcodes/INVOKESTATIC "lux/LuxRT" "clean_separators" "(Ljava/lang/String;)Ljava/lang/String;")
- (.visitMethodInsn Opcodes/INVOKESTATIC "java/lang/Long" "parseUnsignedLong" "(Ljava/lang/String;)J")
- (.visitLabel $to)
- ;; (.visitJumpInsn Opcodes/GOTO $then)
- ;; (.visitLabel $then)
- (&&/wrap-long)
+ (.visitVarInsn Opcodes/ALOAD 0)
+ (.visitMethodInsn Opcodes/INVOKEVIRTUAL "java/lang/String" "length" "()I")
+ (.visitMethodInsn Opcodes/INVOKEVIRTUAL "java/lang/String" "substring" "(II)Ljava/lang/String;")
+ (.visitVarInsn Opcodes/ASTORE 0) ;; Removed the + prefix...
+ ;; Begin parsing processs
+ (.visitVarInsn Opcodes/ALOAD 0)
+ (.visitMethodInsn Opcodes/INVOKEVIRTUAL "java/lang/String" "length" "()I")
+ (.visitLdcInsn (int 18))
+ (.visitJumpInsn Opcodes/IF_ICMPLE $short-enough)
+ ;; Too long
+ ;; Get prefix...
+ (.visitVarInsn Opcodes/ALOAD 0)
+ (.visitLdcInsn (int 0))
+ (.visitVarInsn Opcodes/ALOAD 0)
+ (.visitMethodInsn Opcodes/INVOKEVIRTUAL "java/lang/String" "length" "()I")
+ (.visitLdcInsn (int 1))
+ (.visitInsn Opcodes/ISUB)
+ (.visitMethodInsn Opcodes/INVOKEVIRTUAL "java/lang/String" "substring" "(II)Ljava/lang/String;")
+ (.visitMethodInsn Opcodes/INVOKESTATIC "java/lang/Long" "parseLong" "(Ljava/lang/String;)J")
+ (.visitInsn Opcodes/DUP2) ;; Clone prefix, for later...
+ ;; Get last digit...
+ (.visitVarInsn Opcodes/ALOAD 0)
+ (.visitVarInsn Opcodes/ALOAD 0)
+ (.visitMethodInsn Opcodes/INVOKEVIRTUAL "java/lang/String" "length" "()I")
+ (.visitLdcInsn (int 1))
+ (.visitInsn Opcodes/ISUB)
+ (.visitMethodInsn Opcodes/INVOKEVIRTUAL "java/lang/String" "charAt" "(I)C")
+ (.visitLdcInsn (int 10))
+ (.visitMethodInsn Opcodes/INVOKESTATIC "java/lang/Character" "digit" "(CI)I")
+ ;; Test last digit...
+ (.visitInsn Opcodes/DUP)
+ (.visitJumpInsn Opcodes/IFLT $bad-digit)
+ ;; Good digit...
+ ;; Stack: prefix::L, prefix::L, last-digit::I
+ (.visitInsn Opcodes/I2L)
+ ;; Build the result...
+ swap2
+ (.visitLdcInsn (long 10))
+ (.visitInsn Opcodes/LMUL)
+ (.visitInsn Opcodes/LADD) ;; Stack: prefix::L, result::L
+ (.visitInsn Opcodes/DUP2_X2) ;; Stack: result::L, prefix::L, result::L
+ swap2 ;; Stack: result::L, result::L, prefix::L
+ (.visitMethodInsn Opcodes/INVOKESTATIC "lux/LuxRT" "_compareUnsigned" "(JJ)I")
+ (.visitJumpInsn Opcodes/IFLT $out-of-bounds)
+ ;; Within bounds
+ ;; Stack: result::L
+ &&/wrap-long
+ (.visitMethodInsn Opcodes/INVOKESTATIC "lux/LuxRT" "make_some" "(Ljava/lang/Object;)Ljava/lang/Object;")
+ (.visitInsn Opcodes/ARETURN)
+ ;; Out of bounds
+ (.visitLabel $out-of-bounds)
+ (.visitMethodInsn Opcodes/INVOKESTATIC "lux/LuxRT" "make_none" "()Ljava/lang/Object;")
+ (.visitInsn Opcodes/ARETURN)
+ ;; Bad digit...
+ (.visitLabel $bad-digit)
+ (.visitMethodInsn Opcodes/INVOKESTATIC "lux/LuxRT" "make_none" "()Ljava/lang/Object;")
+ (.visitInsn Opcodes/ARETURN)
+ ;; 18 chars or less
+ (.visitLabel $short-enough)
+ (.visitVarInsn Opcodes/ALOAD 0)
+ (.visitMethodInsn Opcodes/INVOKESTATIC "java/lang/Long" "parseLong" "(Ljava/lang/String;)J")
+ &&/wrap-long
(.visitMethodInsn Opcodes/INVOKESTATIC "lux/LuxRT" "make_some" "(Ljava/lang/Object;)Ljava/lang/Object;")
- (.visitFrame Opcodes/F_NEW 1 (to-array ["java/lang/String"]) 1 (to-array ["java/lang/Object"]))
- (.visitJumpInsn Opcodes/GOTO $end)
+ (.visitInsn Opcodes/ARETURN)
+ (.visitLabel $to)
(.visitLabel $handler)
- (.visitFrame Opcodes/F_NEW 1 (to-array ["java/lang/String"]) 1 (to-array ["java/lang/Exception"]))
- (.visitInsn Opcodes/POP)
(.visitMethodInsn Opcodes/INVOKESTATIC "lux/LuxRT" "make_none" "()Ljava/lang/Object;")
- (.visitFrame Opcodes/F_NEW 1 (to-array ["java/lang/String"]) 1 (to-array ["java/lang/Object"]))
- (.visitJumpInsn Opcodes/GOTO $end)
+ (.visitInsn Opcodes/ARETURN)
+ (.visitMaxs 0 0)
+ (.visitEnd)))
+ ;; http://grepcode.com/file/repository.grepcode.com/java/root/jdk/openjdk/8u40-b25/java/lang/Long.java#172
+ _ (let [$else (new Label)]
+ (doto (.visitMethod =class (+ Opcodes/ACC_PUBLIC Opcodes/ACC_STATIC) "encode_nat" "(J)Ljava/lang/String;" nil nil)
+ (.visitCode)
+ (.visitLdcInsn "+")
+ (.visitVarInsn Opcodes/LLOAD 0)
+ (.visitLdcInsn (long 0))
+ (.visitInsn Opcodes/LCMP)
+ (.visitJumpInsn Opcodes/IFLT $else)
+ ;; then
+ (.visitVarInsn Opcodes/LLOAD 0)
+ (.visitMethodInsn Opcodes/INVOKESTATIC "java/lang/Long" "toString" "(J)Ljava/lang/String;")
+ (.visitMethodInsn Opcodes/INVOKEVIRTUAL "java/lang/String" "concat" "(Ljava/lang/String;)Ljava/lang/String;")
+ (.visitInsn Opcodes/ARETURN)
+ ;; else
(.visitLabel $else)
- (.visitFrame Opcodes/F_NEW 1 (to-array ["java/lang/String"]) 0 (to-array []))
- (.visitMethodInsn Opcodes/INVOKESTATIC "lux/LuxRT" "make_none" "()Ljava/lang/Object;")
- (.visitLabel $end)
- (.visitFrame Opcodes/F_NEW 1 (to-array ["java/lang/String"]) 1 (to-array ["java/lang/Object"]))
+ ;; Set up parts of the number string...
+ ;; First digits
+ (.visitVarInsn Opcodes/LLOAD 0)
+ (.visitLdcInsn (int 1))
+ (.visitInsn Opcodes/LUSHR)
+ (.visitLdcInsn (long 5))
+ (.visitInsn Opcodes/LDIV) ;; quot
+ ;; Last digit
+ (.visitInsn Opcodes/DUP2)
+ (.visitVarInsn Opcodes/LLOAD 0)
+ swap2
+ (.visitInsn Opcodes/LSUB)
+ (.visitLdcInsn (long 10))
+ (.visitInsn Opcodes/LMUL) ;; quot, rem
+ ;; Conversion to string...
+ (.visitMethodInsn Opcodes/INVOKESTATIC "java/lang/Long" "toString" "(J)Ljava/lang/String;") ;; quot, rem*
+ (.visitInsn Opcodes/DUP_X2);; rem*, quot, rem*
+ (.visitInsn Opcodes/POP) ;; rem*, quot
+ (.visitMethodInsn Opcodes/INVOKESTATIC "java/lang/Long" "toString" "(J)Ljava/lang/String;") ;; rem*, quot*
+ (.visitInsn Opcodes/SWAP) ;; quot*, rem*
+ (.visitMethodInsn Opcodes/INVOKEVIRTUAL "java/lang/String" "concat" "(Ljava/lang/String;)Ljava/lang/String;")
+ (.visitMethodInsn Opcodes/INVOKEVIRTUAL "java/lang/String" "concat" "(Ljava/lang/String;)Ljava/lang/String;")
(.visitInsn Opcodes/ARETURN)
(.visitMaxs 0 0)
(.visitEnd)))
- _ (doto (.visitMethod =class (+ Opcodes/ACC_PUBLIC Opcodes/ACC_STATIC) "encode_nat" "(J)Ljava/lang/String;" nil nil)
+ ;; http://grepcode.com/file/repository.grepcode.com/java/root/jdk/openjdk/8u40-b25/java/lang/Long.java#215
+ _ (let [$else (new Label)]
+ (doto (.visitMethod =class (+ Opcodes/ACC_PUBLIC Opcodes/ACC_STATIC) "_toUnsignedBigInteger" "(J)Ljava/math/BigInteger;" nil nil)
+ (.visitCode)
+ (.visitVarInsn Opcodes/LLOAD 0)
+ (.visitLdcInsn (long 0))
+ (.visitInsn Opcodes/LCMP)
+ (.visitJumpInsn Opcodes/IFLT $else)
+ ;; then
+ (.visitVarInsn Opcodes/LLOAD 0)
+ (.visitMethodInsn Opcodes/INVOKESTATIC "java/math/BigInteger" "valueOf" "(J)Ljava/math/BigInteger;")
+ (.visitInsn Opcodes/ARETURN)
+ ;; else
+ (.visitLabel $else)
+ (.visitVarInsn Opcodes/LLOAD 0)
+ (.visitLdcInsn (int 32))
+ (.visitInsn Opcodes/LUSHR)
+ (.visitMethodInsn Opcodes/INVOKESTATIC "java/math/BigInteger" "valueOf" "(J)Ljava/math/BigInteger;")
+ (.visitLdcInsn (int 32))
+ (.visitMethodInsn Opcodes/INVOKEVIRTUAL "java/math/BigInteger" "shiftLeft" "(I)Ljava/math/BigInteger;")
+ (.visitVarInsn Opcodes/LLOAD 0)
+ (.visitLdcInsn (int 32))
+ (.visitInsn Opcodes/LSHL)
+ (.visitLdcInsn (int 32))
+ (.visitInsn Opcodes/LUSHR)
+ (.visitMethodInsn Opcodes/INVOKESTATIC "java/math/BigInteger" "valueOf" "(J)Ljava/math/BigInteger;")
+ (.visitMethodInsn Opcodes/INVOKEVIRTUAL "java/math/BigInteger" "add" "(Ljava/math/BigInteger;)Ljava/math/BigInteger;")
+ (.visitInsn Opcodes/ARETURN)
+ (.visitMaxs 0 0)
+ (.visitEnd)))
+ ;; http://grepcode.com/file/repository.grepcode.com/java/root/jdk/openjdk/8u40-b25/java/lang/Long.java?av=f#1267
+ _ (doto (.visitMethod =class (+ Opcodes/ACC_PUBLIC Opcodes/ACC_STATIC) "_compareUnsigned" "(JJ)I" nil nil)
(.visitCode)
(.visitVarInsn Opcodes/LLOAD 0)
- (.visitMethodInsn Opcodes/INVOKESTATIC +wrapper-class+ "toUnsignedString" "(J)Ljava/lang/String;")
- (.visitLdcInsn "+")
- (.visitInsn Opcodes/SWAP)
- (.visitMethodInsn Opcodes/INVOKEVIRTUAL "java/lang/String" "concat" "(Ljava/lang/String;)Ljava/lang/String;")
- (.visitInsn Opcodes/ARETURN)
+ (.visitFieldInsn Opcodes/GETSTATIC "java/lang/Long" "MIN_VALUE" "J")
+ (.visitInsn Opcodes/LADD)
+ (.visitVarInsn Opcodes/LLOAD 2)
+ (.visitFieldInsn Opcodes/GETSTATIC "java/lang/Long" "MIN_VALUE" "J")
+ (.visitInsn Opcodes/LADD)
+ (.visitInsn Opcodes/LCMP)
+ (.visitInsn Opcodes/IRETURN)
(.visitMaxs 0 0)
- (.visitEnd))]
+ (.visitEnd))
+ ;; http://grepcode.com/file/repository.grepcode.com/java/root/jdk/openjdk/8u40-b25/java/lang/Long.java#1290
+ _ (let [$case-1 (new Label)
+ $0 (new Label)
+ $case-2 (new Label)]
+ (doto (.visitMethod =class (+ Opcodes/ACC_PUBLIC Opcodes/ACC_STATIC) "div_nat" "(JJ)J" nil nil)
+ (.visitCode)
+ ;; Test #1
+ (.visitVarInsn Opcodes/LLOAD 2)
+ (.visitLdcInsn (long 0))
+ (.visitInsn Opcodes/LCMP)
+ (.visitJumpInsn Opcodes/IFLT $case-1)
+ ;; Test #2
+ (.visitVarInsn Opcodes/LLOAD 0)
+ (.visitLdcInsn (long 0))
+ (.visitInsn Opcodes/LCMP)
+ (.visitJumpInsn Opcodes/IFGT $case-2)
+ ;; Case #3
+ (.visitVarInsn Opcodes/LLOAD 0)
+ (.visitMethodInsn Opcodes/INVOKESTATIC "lux/LuxRT" "_toUnsignedBigInteger" "(J)Ljava/math/BigInteger;")
+ (.visitVarInsn Opcodes/LLOAD 2)
+ (.visitMethodInsn Opcodes/INVOKESTATIC "lux/LuxRT" "_toUnsignedBigInteger" "(J)Ljava/math/BigInteger;")
+ (.visitMethodInsn Opcodes/INVOKEVIRTUAL "java/math/BigInteger" "divide" "(Ljava/math/BigInteger;)Ljava/math/BigInteger;")
+ (.visitMethodInsn Opcodes/INVOKEVIRTUAL "java/math/BigInteger" "longValue" "()J")
+ (.visitInsn Opcodes/LRETURN)
+ ;; Case #2
+ (.visitLabel $case-2)
+ (.visitVarInsn Opcodes/LLOAD 0)
+ (.visitVarInsn Opcodes/LLOAD 2)
+ (.visitInsn Opcodes/LDIV)
+ (.visitInsn Opcodes/LRETURN)
+ ;; Case #1
+ (.visitLabel $case-1)
+ (.visitVarInsn Opcodes/LLOAD 0)
+ (.visitVarInsn Opcodes/LLOAD 2)
+ (.visitMethodInsn Opcodes/INVOKESTATIC "lux/LuxRT" "_compareUnsigned" "(JJ)I")
+ (.visitJumpInsn Opcodes/IFLT $0)
+ ;; 1
+ (.visitLdcInsn (long 1))
+ (.visitInsn Opcodes/LRETURN)
+ ;; 0
+ (.visitLabel $0)
+ (.visitLdcInsn (long 0))
+ (.visitInsn Opcodes/LRETURN)
+ (.visitMaxs 0 0)
+ (.visitEnd)))
+ ;; http://grepcode.com/file/repository.grepcode.com/java/root/jdk/openjdk/8u40-b25/java/lang/Long.java#1323
+ _ (let [$case-1 (new Label)
+ $case-2 (new Label)]
+ (doto (.visitMethod =class (+ Opcodes/ACC_PUBLIC Opcodes/ACC_STATIC) "rem_nat" "(JJ)J" nil nil)
+ (.visitCode)
+ ;; Test #1
+ (.visitVarInsn Opcodes/LLOAD 0)
+ (.visitLdcInsn (long 0))
+ (.visitInsn Opcodes/LCMP)
+ (.visitVarInsn Opcodes/LLOAD 2)
+ (.visitLdcInsn (long 0))
+ (.visitInsn Opcodes/LCMP)
+ (.visitInsn Opcodes/IAND)
+ (.visitJumpInsn Opcodes/IFGT $case-1)
+ ;; Test #2
+ (.visitVarInsn Opcodes/LLOAD 0)
+ (.visitVarInsn Opcodes/LLOAD 2)
+ (.visitMethodInsn Opcodes/INVOKESTATIC "lux/LuxRT" "_compareUnsigned" "(JJ)I")
+ (.visitJumpInsn Opcodes/IFLT $case-2)
+ ;; Case #3
+ (.visitVarInsn Opcodes/LLOAD 0)
+ (.visitMethodInsn Opcodes/INVOKESTATIC "lux/LuxRT" "_toUnsignedBigInteger" "(J)Ljava/math/BigInteger;")
+ (.visitVarInsn Opcodes/LLOAD 2)
+ (.visitMethodInsn Opcodes/INVOKESTATIC "lux/LuxRT" "_toUnsignedBigInteger" "(J)Ljava/math/BigInteger;")
+ (.visitMethodInsn Opcodes/INVOKEVIRTUAL "java/math/BigInteger" "remainder" "(Ljava/math/BigInteger;)Ljava/math/BigInteger;")
+ (.visitMethodInsn Opcodes/INVOKEVIRTUAL "java/math/BigInteger" "longValue" "()J")
+ (.visitInsn Opcodes/LRETURN)
+ ;; Case #2
+ (.visitLabel $case-2)
+ (.visitVarInsn Opcodes/LLOAD 0)
+ (.visitInsn Opcodes/LRETURN)
+ ;; Case #1
+ (.visitLabel $case-1)
+ (.visitVarInsn Opcodes/LLOAD 0)
+ (.visitVarInsn Opcodes/LLOAD 2)
+ (.visitInsn Opcodes/LREM)
+ (.visitInsn Opcodes/LRETURN)
+ (.visitMaxs 0 0)
+ (.visitEnd)))]
nil)))
(defn ^:private compile-LuxRT-pm-methods [^ClassWriter =class]
@@ -1608,6 +1824,21 @@
(.visitLabel $end))]]
(return nil)))
+(defn compile-jvm-synchronized [compile ?values special-args]
+ (|do [:let [(&/$Cons ?monitor (&/$Cons ?expr (&/$Nil))) ?values
+ ;; (&/$Nil) special-args
+ ]
+ ^MethodVisitor *writer* &/get-writer
+ _ (compile ?monitor)
+ :let [_ (doto *writer*
+ (.visitInsn Opcodes/DUP)
+ (.visitInsn Opcodes/MONITORENTER))]
+ _ (compile ?expr)
+ :let [_ (doto *writer*
+ (.visitInsn Opcodes/SWAP)
+ (.visitInsn Opcodes/MONITOREXIT))]]
+ (return nil)))
+
(do-template [<name> <op>]
(defn <name> [compile ?values special-args]
(|do [:let [(&/$Cons ?monitor (&/$Nil)) ?values
@@ -1914,41 +2145,41 @@
^:private compile-frac-scale Opcodes/LMUL "java.lang.Long" "longValue" "()J" &&/wrap-long
)
-(do-template [<name> <wrapper-class> <value-method> <value-method-sig> <wrap> <comp-method> <comp-sig>]
+(do-template [<name> <comp-method>]
(defn <name> [compile ?values special-args]
(|do [:let [(&/$Cons ?x (&/$Cons ?y (&/$Nil))) ?values]
- :let [+wrapper-class+ (&host-generics/->bytecode-class-name <wrapper-class>)]
+ :let [+wrapper-class+ (&host-generics/->bytecode-class-name "java.lang.Long")]
^MethodVisitor *writer* &/get-writer
_ (compile ?x)
:let [_ (doto *writer*
(.visitTypeInsn Opcodes/CHECKCAST +wrapper-class+)
- (.visitMethodInsn Opcodes/INVOKEVIRTUAL +wrapper-class+ <value-method> <value-method-sig>))]
+ (.visitMethodInsn Opcodes/INVOKEVIRTUAL +wrapper-class+ "longValue" "()J"))]
_ (compile ?y)
:let [_ (doto *writer*
(.visitTypeInsn Opcodes/CHECKCAST +wrapper-class+)
- (.visitMethodInsn Opcodes/INVOKEVIRTUAL +wrapper-class+ <value-method> <value-method-sig>))
+ (.visitMethodInsn Opcodes/INVOKEVIRTUAL +wrapper-class+ "longValue" "()J"))
_ (doto *writer*
- (.visitMethodInsn Opcodes/INVOKESTATIC +wrapper-class+ <comp-method> <comp-sig>)
+ (.visitMethodInsn Opcodes/INVOKESTATIC "lux/LuxRT" <comp-method> "(JJ)J")
(&&/wrap-long))]]
(return nil)))
- ^:private compile-nat-div "java.lang.Long" "longValue" "()J" &&/wrap-long "divideUnsigned" "(JJ)J"
- ^:private compile-nat-rem "java.lang.Long" "longValue" "()J" &&/wrap-long "remainderUnsigned" "(JJ)J"
+ ^:private compile-nat-div "div_nat"
+ ^:private compile-nat-rem "rem_nat"
)
-(do-template [<name> <cmpcode> <cmp-output> <wrapper-class> <value-method> <value-method-sig> <comp-method> <comp-sig>]
+(do-template [<name> <cmp-output>]
(defn <name> [compile ?values special-args]
(|do [:let [(&/$Cons ?x (&/$Cons ?y (&/$Nil))) ?values]
- :let [+wrapper-class+ (&host-generics/->bytecode-class-name <wrapper-class>)]
+ :let [+wrapper-class+ (&host-generics/->bytecode-class-name "java.lang.Long")]
^MethodVisitor *writer* &/get-writer
_ (compile ?x)
:let [_ (doto *writer*
(.visitTypeInsn Opcodes/CHECKCAST +wrapper-class+)
- (.visitMethodInsn Opcodes/INVOKEVIRTUAL +wrapper-class+ <value-method> <value-method-sig>))]
+ (.visitMethodInsn Opcodes/INVOKEVIRTUAL +wrapper-class+ "longValue" "()J"))]
_ (compile ?y)
:let [_ (doto *writer*
(.visitTypeInsn Opcodes/CHECKCAST +wrapper-class+)
- (.visitMethodInsn Opcodes/INVOKEVIRTUAL +wrapper-class+ <value-method> <value-method-sig>))
+ (.visitMethodInsn Opcodes/INVOKEVIRTUAL +wrapper-class+ "longValue" "()J"))
$then (new Label)
$end (new Label)
_ (doto *writer*
@@ -1962,13 +2193,37 @@
(.visitLabel $end))]]
(return nil)))
- ^:private compile-nat-eq Opcodes/LCMP 0 "java.lang.Long" "longValue" "()J" "compareUnsigned" "(JJ)I"
- ^:private compile-nat-lt Opcodes/LCMP -1 "java.lang.Long" "longValue" "()J" "compareUnsigned" "(JJ)I"
-
- ^:private compile-frac-eq Opcodes/LCMP 0 "java.lang.Long" "longValue" "()J" "compareUnsigned" "(JJ)I"
- ^:private compile-frac-lt Opcodes/LCMP -1 "java.lang.Long" "longValue" "()J" "compareUnsigned" "(JJ)I"
+ ^:private compile-nat-eq 0
+
+ ^:private compile-frac-eq 0
+ ^:private compile-frac-lt -1
)
+(let [+wrapper-class+ (&host-generics/->bytecode-class-name "java.lang.Long")]
+ (defn ^:private compile-nat-lt [compile ?values special-args]
+ (|do [:let [(&/$Cons ?x (&/$Cons ?y (&/$Nil))) ?values]
+ ^MethodVisitor *writer* &/get-writer
+ _ (compile ?x)
+ :let [_ (doto *writer*
+ (.visitTypeInsn Opcodes/CHECKCAST +wrapper-class+)
+ (.visitMethodInsn Opcodes/INVOKEVIRTUAL +wrapper-class+ "longValue" "()J"))]
+ _ (compile ?y)
+ :let [_ (doto *writer*
+ (.visitTypeInsn Opcodes/CHECKCAST +wrapper-class+)
+ (.visitMethodInsn Opcodes/INVOKEVIRTUAL +wrapper-class+ "longValue" "()J"))
+ $then (new Label)
+ $end (new Label)
+ _ (doto *writer*
+ (.visitMethodInsn Opcodes/INVOKESTATIC "lux/LuxRT" "_compareUnsigned" "(JJ)I")
+ (.visitLdcInsn (int -1))
+ (.visitJumpInsn Opcodes/IF_ICMPEQ $then)
+ (.visitFieldInsn Opcodes/GETSTATIC (&host-generics/->bytecode-class-name "java.lang.Boolean") "FALSE" (&host-generics/->type-signature "java.lang.Boolean"))
+ (.visitJumpInsn Opcodes/GOTO $end)
+ (.visitLabel $then)
+ (.visitFieldInsn Opcodes/GETSTATIC (&host-generics/->bytecode-class-name "java.lang.Boolean") "TRUE" (&host-generics/->type-signature "java.lang.Boolean"))
+ (.visitLabel $end))]]
+ (return nil))))
+
(do-template [<name> <instr> <wrapper>]
(defn <name> [compile ?values special-args]
(|do [:let [(&/$Nil) ?values]
@@ -2131,6 +2386,7 @@
"jvm"
(case proc-name
+ "synchronized" (compile-jvm-synchronized compile ?values special-args)
"load-class" (compile-jvm-load-class compile ?values special-args)
"instanceof" (compile-jvm-instanceof compile ?values special-args)
"try" (compile-jvm-try compile ?values special-args)