From 65c182755954f64fd112284a5336ba05547a4283 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Mon, 3 Jul 2017 18:15:24 -0400 Subject: - Tested the compilation for "nat" procedures. - Expanded the runtime. - Some bug-fixes and refactorings. --- new-luxc/source/luxc/generator/runtime.jvm.lux | 118 ++++++++++++++++++++++--- 1 file changed, 107 insertions(+), 11 deletions(-) (limited to 'new-luxc/source/luxc/generator/runtime.jvm.lux') 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 [_ (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))) -- cgit v1.2.3