From 50cc5fbe7cc8abde05085944393fcec4c791402f Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Tue, 5 Sep 2017 18:36:09 -0400 Subject: - Updated new compiler's code to the recent changes in the language. - WIP: Some other changes/additions to the new compiler. --- new-luxc/source/luxc/generator/runtime.jvm.lux | 147 ++++++++++++++++++++++++- 1 file changed, 144 insertions(+), 3 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 e6a12d6fa..fe7a4b2cb 100644 --- a/new-luxc/source/luxc/generator/runtime.jvm.lux +++ b/new-luxc/source/luxc/generator/runtime.jvm.lux @@ -3,6 +3,7 @@ (lux (control monad) (data ["R" result] text/format) + [math] [macro #+ Monad "Lux/" Monad] [host #+ jvm-import do-to]) (luxc ["&" base] @@ -44,6 +45,8 @@ (def: #export unit Text "\u0000") (def: $Object $;Type ($t;class "java.lang.Object" (list))) +(def: $Object-Array $;Type ($t;array +1 $Object)) +(def: $String $;Type ($t;class "java.lang.String" (list))) (def: logI $;Inst @@ -52,9 +55,28 @@ (|>. outI ($i;string "LOG: ") (printI "print") outI $i;SWAP (printI "println")))) +(def: sum-method + $;Method + ($t;method (list $t;int $Object $Object) (#;Some $Object-Array) (list))) + +(def: #export someI + $;Inst + (|>. ($i;int 1) + ($i;string "") + $i;DUP2_X1 + $i;POP2 + ($i;INVOKESTATIC runtime-name "sum_make" sum-method false))) + +(def: #export noneI + $;Inst + (|>. ($i;int 0) + $i;NULL + ($i;string unit) + ($i;INVOKESTATIC runtime-name "sum_make" sum-method false))) + (def: add-adt-methods $;Def - (let [store-tag (|>. $i;DUP ($i;int 0) ($i;ILOAD +0) $i;wrap-int $i;AASTORE) + (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 "sum_make" @@ -159,7 +181,125 @@ $i;LRETURN)))) ))) -(def: init-method $;Method ($t;method (list) #;None (list))) +(def: frac-shiftI $;Inst ($i;double (math;pow 32.0 2.0))) + +(def: add-frac-methods + $;Def + (|>. ($d;method #$;Public $;staticM "decode_frac" ($t;method (list $String) (#;Some $Object-Array) (list)) + (<| $i;with-label (function [@from]) + $i;with-label (function [@to]) + $i;with-label (function [@handler]) + (|>. ($i;try @from @to @handler "java.lang.Exception") + ($i;label @from) + ($i;ALOAD +0) + ($i;INVOKESTATIC "java.lang.Double" "parseDouble" ($t;method (list $String) (#;Some $t;double) (list)) false) + ($i;wrap #$;Double) + someI + $i;ARETURN + ($i;label @to) + ($i;label @handler) + noneI + $i;ARETURN))) + ($d;method #$;Public $;staticM "frac_to_deg" ($t;method (list $t;double) (#;Some $t;long) (list)) + (let [swap2 (|>. $i;DUP2_X2 $i;POP2) + drop-excessI (|>. ($i;double 1.0) $i;DREM) + shiftI (|>. frac-shiftI $i;DMUL)] + (|>. ($i;DLOAD +0) + ## Get upper half + drop-excessI + shiftI + ## Make a copy, so the lower half can be extracted + $i;DUP2 + ## Get lower half + drop-excessI + shiftI + ## Turn it into a deg + $i;D2L + ## Turn the upper half into deg too + swap2 + $i;D2L + ## Combine both pieces + $i;LADD + ## FINISH + $i;LRETURN + ))) + )) + +(def: deg-bits Nat +64) +(def: deg-method $;Method ($t;method (list $t;long $t;long) (#;Some $t;long) (list))) +(def: clz-method $;Method ($t;method (list $t;long) (#;Some $t;int) (list))) + +(def: add-deg-methods + $;Def + (let [## "And" mask corresponding to -1 (FFFF...), on the low 32 bits. + low-half (|>. ($i;int -1) $i;I2L $i;LAND) + high-half (|>. ($i;int 32) $i;LUSHR)] + (|>. ($d;method #$;Public $;staticM "mul_deg" deg-method + ## Based on: http://stackoverflow.com/a/31629280/6823464 + (let [shift-downI (|>. ($i;int 32) $i;LUSHR) + low-leftI (|>. ($i;LLOAD +0) low-half) + high-leftI (|>. ($i;LLOAD +0) high-half) + low-rightI (|>. ($i;LLOAD +2) low-half) + high-rightI (|>. ($i;LLOAD +2) high-half) + bottomI (|>. low-leftI low-rightI $i;LMUL) + middleLI (|>. high-leftI low-rightI $i;LMUL) + middleRI (|>. low-leftI high-rightI $i;LMUL) + middleI (|>. middleLI middleRI $i;LADD) + topI (|>. high-leftI high-rightI $i;LMUL)] + (|>. bottomI shift-downI + middleI $i;LADD shift-downI + topI $i;LADD + $i;LRETURN))) + ($d;method #$;Public $;staticM "count_leading_zeros" clz-method + (let [when-zeroI (function [@where] (|>. ($i;long 0) $i;LCMP ($i;IFEQ @where))) + shift-rightI (function [amount] (|>. ($i;int amount) $i;LUSHR)) + decI (|>. ($i;int 1) $i;ISUB)] + (<| $i;with-label (function [@start]) + $i;with-label (function [@done]) + (|>. ($i;int 64) + ($i;label @start) + ($i;LLOAD +0) (when-zeroI @done) + ($i;LLOAD +0) (shift-rightI 1) ($i;LSTORE +0) + decI + ($i;GOTO @start) + ($i;label @done) + $i;IRETURN)))) + ($d;method #$;Public $;staticM "div_deg" deg-method + (<| $i;with-label (function [@same]) + (let [subjectI ($i;LLOAD +0) + paramI ($i;LLOAD +2) + equal?I (function [@where] (|>. $i;LCMP ($i;IFEQ @where))) + count-leading-zerosI ($i;INVOKESTATIC runtime-name "count_leading_zeros" clz-method false) + calc-max-shiftI (|>. subjectI count-leading-zerosI + paramI count-leading-zerosI + ($i;INVOKESTATIC "java.lang.Math" "min" ($t;method (list $t;int $t;int) (#;Some $t;int) (list)) false) + ($i;ISTORE +4)) + shiftI (|>. ($i;ILOAD +4) $i;LSHL) + imprecise-divisionI (|>. subjectI shiftI + paramI shiftI high-half + $i;LDIV) + scale-downI (|>. ($i;int 32) $i;LSHL)] + (|>. subjectI paramI + (equal?I @same) + ## Based on: http://stackoverflow.com/a/8510587/6823464 + ## Shifting the operands as much as possible can help + ## avoid some loss of precision later. + calc-max-shiftI + imprecise-divisionI + scale-downI + $i;LRETURN + ($i;label @same) + ($i;long -1) ## ~= 1.0 Degrees + $i;LRETURN)))) + ($d;method #$;Public $;staticM "deg_to_frac" ($t;method (list $t;long) (#;Some $t;double) (list)) + (let [highI (|>. ($i;LLOAD +0) high-half $i;L2D) + lowI (|>. ($i;LLOAD +0) low-half $i;L2D) + scaleI (|>. frac-shiftI $i;DDIV)] + (|>. highI scaleI + lowI scaleI scaleI + $i;DADD + $i;DRETURN))) + ))) (def: #export generate (Lux &common;Bytecode) @@ -168,6 +308,7 @@ #let [bytecode ($d;class #$;V1.6 #$;Public $;finalC runtime-name (list) ["java.lang.Object" (list)] (list) (|>. add-adt-methods add-nat-methods - ))] + add-frac-methods + add-deg-methods))] _ (&common;store-class runtime-name bytecode)] (wrap bytecode))) -- cgit v1.2.3