- Tested the compilation for "nat" procedures.

- Expanded the runtime.
- Some bug-fixes and refactorings.

1 files changed, 107 insertions, 11 deletions

diff --git a/new-luxc/source/luxc/generator/runtime.jvm.lux b/new-luxc/source/luxc/generator/runtime.jvm.lux
index 8c0b294c1..e6a12d6fa 100644
--- a/new-luxc/source/luxc/generator/runtime.jvm.lux
+++ b/new-luxc/source/luxc/generator/runtime.jvm.lux
@@ -39,20 +39,25 @@
   (visitEnd [] void)
   (toByteArray [] Byte-Array))
 
-(def: #export runtime-name Text "LuxRT")
+(def: #export runtime-name Text "LuxRuntime")
 (def: #export function-name Text "LuxFunction")
 (def: #export unit Text "\u0000")
 
 (def: $Object $;Type ($t;class "java.lang.Object" (list)))
 
+(def: logI
+  $;Inst
+  (let [outI ($i;GETSTATIC "java.lang.System" "out" ($t;class "java.io.PrintStream" (list)))
+        printI (function [method] ($i;INVOKEVIRTUAL "java.io.PrintStream" method ($t;method (list $Object) #;None (list)) false))]
+    (|>. outI ($i;string "LOG: ") (printI "print")
+         outI $i;SWAP (printI "println"))))
+
 (def: add-adt-methods
   $;Def
   (let [store-tag (|>. $i;DUP ($i;int 0) ($i;ILOAD +0) $i;wrap-int $i;AASTORE)
         store-flag (|>. $i;DUP ($i;int 1) ($i;ALOAD +1) $i;AASTORE)
         store-value (|>. $i;DUP ($i;int 2) ($i;ALOAD +2) $i;AASTORE)]
-    (|>. ($d;method #$;Public
-                    {#$;staticM true #$;finalM false #$;synchronizedM false}
-                    "sum_make"
+    (|>. ($d;method #$;Public $;staticM "sum_make"
                     ($t;method (list $t;int $Object $Object)
                                (#;Some ($t;array +1 $Object))
                                (list))
@@ -62,16 +67,107 @@
                          store-value
                          $i;ARETURN)))))
 
+(def: add-nat-methods
+  $;Def
+  (let [compare-nat-method ($t;method (list $t;long $t;long) (#;Some $t;int) (list))
+        less-thanI (function [@where] (|>. ($i;INVOKESTATIC runtime-name "compare_nat" compare-nat-method false) ($i;IFLT @where)))
+        $BigInteger ($t;class "java.math.BigInteger" (list))
+        upcast-method ($t;method (list $t;long) (#;Some $BigInteger) (list))
+        div-method ($t;method (list $t;long $t;long) (#;Some $t;long) (list))
+        upcastI ($i;INVOKESTATIC runtime-name "_toUnsignedBigInteger" upcast-method false)
+        downcastI ($i;INVOKEVIRTUAL "java.math.BigInteger" "longValue" ($t;method (list) (#;Some $t;long) (list)) false)]
+    ## http://grepcode.com/file/repository.grepcode.com/java/root/jdk/openjdk/8u40-b25/java/lang/Long.java#215
+    (|>. ($d;method #$;Public $;staticM "_toUnsignedBigInteger" upcast-method
+                    (let [upcastI ($i;INVOKESTATIC "java.math.BigInteger" "valueOf" upcast-method false)
+                          discernI (function [@where] (|>. ($i;LLOAD +0) ($i;long 0) $i;LCMP ($i;IFGE @where)))
+                          prepare-upperI (|>. ($i;LLOAD +0) ($i;int 32) $i;LUSHR
+                                              upcastI
+                                              ($i;int 32) ($i;INVOKEVIRTUAL "java.math.BigInteger" "shiftLeft" ($t;method (list $t;int) (#;Some $BigInteger) (list)) false))
+                          prepare-lowerI (|>. ($i;LLOAD +0) ($i;int 32) $i;LSHL
+                                              ($i;int 32)   $i;LUSHR
+                                              upcastI)]
+                      (<| $i;with-label (function [@simple])
+                          (|>. (discernI @simple)
+                               ## else
+                               prepare-upperI
+                               prepare-lowerI
+                               ($i;INVOKEVIRTUAL "java.math.BigInteger" "add" ($t;method (list $BigInteger) (#;Some $BigInteger) (list)) false)
+                               $i;ARETURN
+                               ## then
+                               ($i;label @simple)
+                               ($i;LLOAD +0)
+                               upcastI
+                               $i;ARETURN))))
+         ## http://grepcode.com/file/repository.grepcode.com/java/root/jdk/openjdk/8u40-b25/java/lang/Long.java?av=f#1267
+         ($d;method #$;Public $;staticM "compare_nat" compare-nat-method
+                    (let [shiftI (|>. ($i;GETSTATIC "java.lang.Long" "MIN_VALUE" $t;long) $i;LADD)]
+                      (|>. ($i;LLOAD +0) shiftI
+                           ($i;LLOAD +2) shiftI
+                           $i;LCMP
+                           $i;IRETURN)))
+         ## http://grepcode.com/file/repository.grepcode.com/java/root/jdk/openjdk/8u40-b25/java/lang/Long.java#1290
+         ($d;method #$;Public $;staticM "div_nat" div-method
+                    (let [is-param-largeI (function [@where] (|>. ($i;LLOAD +2) ($i;long 0) $i;LCMP ($i;IFLT @where)))
+                          is-subject-smallI (function [@where] (|>. ($i;LLOAD +0) ($i;long 0) $i;LCMP ($i;IFGT @where)))
+                          small-division (|>. ($i;LLOAD +0) ($i;LLOAD +2) $i;LDIV $i;LRETURN)
+                          big-divisionI ($i;INVOKEVIRTUAL "java.math.BigInteger" "divide" ($t;method (list $BigInteger) (#;Some $BigInteger) (list)) false)]
+                      (<| $i;with-label (function [@is-zero])
+                          $i;with-label (function [@param-is-large])
+                          $i;with-label (function [@subject-is-small])
+                          (|>. (is-param-largeI @param-is-large)
+                               ## Param is not too large
+                               (is-subject-smallI @subject-is-small)
+                               ## Param is small, but subject is large
+                               ($i;LLOAD +0) upcastI
+                               ($i;LLOAD +2) upcastI
+                               big-divisionI downcastI $i;LRETURN
+                               ## Both param and subject are small,
+                               ## and can thus be divided normally.
+                               ($i;label @subject-is-small)
+                               small-division
+                               ## Param is too large. Cannot simply divide.
+                               ## Depending on the result of the
+                               ## comparison, a result will be determined.
+                               ($i;label @param-is-large)
+                               ($i;LLOAD +0) ($i;LLOAD +2) (less-thanI @is-zero)
+                               ## Greater-than or equals
+                               ($i;long 1) $i;LRETURN
+                               ## Less than
+                               ($i;label @is-zero)
+                               ($i;long 0) $i;LRETURN))))
+         ## http://grepcode.com/file/repository.grepcode.com/java/root/jdk/openjdk/8u40-b25/java/lang/Long.java#1323
+         ($d;method #$;Public $;staticM "rem_nat" div-method
+                    (let [is-subject-largeI (function [@where] (|>. ($i;LLOAD +0) ($i;long 0) $i;LCMP ($i;IFLE @where)))
+                          is-param-largeI (function [@where] (|>. ($i;LLOAD +2) ($i;long 0) $i;LCMP ($i;IFLE @where)))
+                          small-remainderI (|>. ($i;LLOAD +0) ($i;LLOAD +2) $i;LREM $i;LRETURN)
+                          big-remainderI ($i;INVOKEVIRTUAL "java.math.BigInteger" "remainder" ($t;method (list $BigInteger) (#;Some $BigInteger) (list)) false)]
+                      (<| $i;with-label (function [@large-number])
+                          $i;with-label (function [@subject-is-smaller-than-param])
+                          (|>. (is-subject-largeI @large-number)
+                               (is-param-largeI @large-number)
+                               small-remainderI
+
+                               ($i;label @large-number)
+                               ($i;LLOAD +0) ($i;LLOAD +2) (less-thanI @subject-is-smaller-than-param)
+                               
+                               ($i;LLOAD +0) upcastI
+                               ($i;LLOAD +2) upcastI
+                               big-remainderI downcastI $i;LRETURN
+                               
+                               ($i;label @subject-is-smaller-than-param)
+                               ($i;LLOAD +0)
+                               $i;LRETURN))))
+         )))
+
+(def: init-method $;Method ($t;method (list) #;None (list)))
+
 (def: #export generate
   (Lux &common;Bytecode)
   (do Monad<Lux>
     [_ (wrap [])
-     #let [writer (|> (do-to (ClassWriter.new ClassWriter.COMPUTE_MAXS)
-                        (ClassWriter.visit [&common;bytecode-version
-                                            ($_ i.+ Opcodes.ACC_PUBLIC Opcodes.ACC_FINAL Opcodes.ACC_SUPER)
-                                            runtime-name (host;null)
-                                            "java/lang/Object" (host;null)]))
-                      add-adt-methods)
-           bytecode (ClassWriter.toByteArray [] (do-to writer (ClassWriter.visitEnd [])))]
+     #let [bytecode ($d;class #$;V1.6 #$;Public $;finalC runtime-name (list) ["java.lang.Object" (list)] (list)
+                              (|>. add-adt-methods
+                                   add-nat-methods
+                                   ))]
      _ (&common;store-class runtime-name bytecode)]
     (wrap bytecode)))