Skip to content

Commit

Permalink
store only unique constants
Browse files Browse the repository at this point in the history
  • Loading branch information
SPY committed May 23, 2018
1 parent 9009e63 commit d887870
Show file tree
Hide file tree
Showing 2 changed files with 228 additions and 29 deletions.
184 changes: 165 additions & 19 deletions rts/index.html
Original file line number Diff line number Diff line change
@@ -1,5 +1,6 @@
<script>
let mem = null
let alloc = null

const ValType = {
Con: 0,
Expand All @@ -18,67 +19,212 @@
case ValType.Con:
return { type: 'con', size, tag: mem.getUint32(addr + 8, true), addr }
case ValType.Int:
return { type: 'int', val: mem.getUint32(addr + 8, true), addr }
return { type: 'int', size, val: mem.getInt32(addr + 8, true), addr }
case ValType.Bit32:
return { type: 'bit32', size, val: mem.getInt32(addr + 8, true), addr }
case ValType.Bit64:
return {
type: 'bit64',
size,
val: [mem.getInt32(addr + 8, true), mem.getInt32(addr + 12, true)],
addr
}
case ValType.BigInt:
return {
type: 'big',
size,
val: [mem.getInt32(addr + 8, true), mem.getInt32(addr + 12, true)],
addr
}
case ValType.Float:
return { type: 'float', val: mem.getFloat64(addr + 8, true), addr }
return { type: 'float', size, val: mem.getFloat64(addr + 8, true), addr }
case ValType.String:
const len = mem.getUint32(addr + 8, true)
return {
type: 'string',
size,
len: mem.getUint32(addr + 8, true),
val: mem.buffer.slice(addr + 12, size - 12),
len,
val: readString(addr + 12, len),
addr
}
default:
throw new Error('Unknown value')
throw new Error('Unknown value. Type tag: ' + mem.getUint8(addr))
}
}

function loadString(addr) {
const len = mem.getUint32(addr + 8, true)
return readString(addr + 12, len)
}

function aligned(size) {
return (size + 3) & 0xFFFFFFFC
}

function gc(requestedSize) {
console.log('gc', requestedSize)
}

function strEq(a, b) {
console.log('str eq', loadValue(a), loadValue(b))
return 0
if (a === b) {
return makeInt(1)
}
const strA = loadString(a)
const strB = loadString(b)
const res = makeInt(strA === strB ? 1 : 0)
console.log('str eq', loadValue(a), loadValue(b), loadValue(res))
return res
}

function strHead(strAddr) {
console.log('str head', loadValue(strAddr))
return 0
const head = readString(strAddr + 12, 1)
const res = makeString(head)
console.log('str head', loadValue(strAddr), head, loadValue(res))
return res
}

function strConcat(a, b) {
console.log('str concat', loadValue(a), loadValue(b))
return 0
const va = loadValue(a)
const vb = loadValue(b)
const res = makeString(va.val + vb.val)
console.log('str concat', va, vb, loadValue(res))
return res
}

function strWrite(strAddr) {
console.log('str write', loadValue(strAddr))
console.log(strAddr)
return 0
console.log(loadString(strAddr))
return makeInt(0)
}

function getCharWidth(code) {
if (code < 0x80) {
return 1
}
if (code >= 0x80 && code < 0x800) {
return 2
}
if (code >= 0x800 && code < 0x8000) {
return 3
}
return 4
}

function intStr(i) {
console.log('int to str', loadValue(i))
return 0
function getStringSizeInBytes(str) {
let size = 0
for (let i = 0; i < str.length; i++) {
size += getCharWidth(str.charCodeAt(i))
}
return size
}

function writeChar(dst, code) {
const width = getCharWidth(code)
switch (width) {
case 1:
mem.setUint8(dst, code)
break
case 2:
mem.setUint8(dst, (code >> 6) | 0xC0)
mem.setUint8(dst + 1, (code & 0x3F) | 0x80)
break
case 3:
mem.setUint8(dst, (code >> 12) | 0xE0)
mem.setUint8(dst + 1, ((code >> 6) & 0x3F) | 0x80)
mem.setUint8(dst + 2, (code & 0x3F) | 0x80)
break
default:
mem.setUint8(dst, (code >> 18) | 0xF0)
mem.setUint8(dst + 1, ((code >> 12) & 0x3F) | 0x80)
mem.setUint8(dst + 2, ((code >> 6) & 0x3F) | 0x80)
mem.setUint8(dst + 3, (code & 0x3F) | 0x80)
}
return width
}

function readString(addr, len) {
const codes = new Array(len)
for (let i = 0, next = addr; i < len; i++) {
const byte = mem.getUint8(next)
if ((byte & 0x80) == 0) { // one byte width
codes[i] = byte
next += 1
}
else if ((byte & 0xE0) == 0xC0) { // two bytes width
codes[i] = byte & 0x1F << 6
| (mem.getUint8(addr + 1) & 0x3F)
next += 2
}
else if ((byte & 0xF0) == 0xE0) { // three bytes width
codes[i] = byte & 0x0F << 12
| ((mem.getUint8(addr + 1) & 0x3F) << 6)
| (mem.getUint8(addr + 2) & 0x3F)
next += 3
}
else { // four bytes width
codes[i] = byte & 0x07 << 18
| ((mem.getUint8(addr + 1) & 0x3F) << 12)
| ((mem.getUint8(addr + 2) & 0x3F) << 6)
| (mem.getUint8(addr + 3) & 0x3F)
next += 4
}
}
return String.fromCharCode.apply(String, codes)
}

function makeString(str) {
const size = 12 + getStringSizeInBytes(str)
const addr = alloc(size)
mem.setUint8(addr, ValType.String)
mem.setUint8(addr + 1, !str ? 1 : 0)
mem.setUint32(addr + 8, str.length, true)
for (let i = 0, cur = addr + 12; i <= str.length; i++) {
cur += writeChar(cur, str.charCodeAt(i))
}
return addr
}

function makeInt(val) {
const addr = alloc(12)
mem.setUint8(addr, ValType.Int)
mem.setInt32(addr + 8, val, true)
return addr
}

function intStr(intAddr) {
const val = mem.getUint32(intAddr + 8, true) | 0
const res = makeString(val.toString())
console.log('int to str', loadValue(intAddr), loadValue(res))
return res
}

function raiseError(strAddr) {
console.log('raise error', strAddr)
throw new Error('Idris Error')
}

function printConstSection(end) {
const vals = []
let i = 0
while (i < end) {
const val = loadValue(i)
vals.push(val)
i += aligned(val.size)
}
console.log('CONST SECTION', vals)
}

fetch('fact.wasm').then(response =>
response.arrayBuffer()
).then(bytes => {
return WebAssembly.instantiate(bytes, {
rts: { raiseError, gc, strEq, strHead, strConcat, strWrite, intStr }
})
}).then(results => {
console.log('result', results)
const {alloc, mem: m, main, stackStart} = results.instance.exports
const {alloc: a, mem: m, main, stackStart} = results.instance.exports
mem = new DataView(m.buffer)
alloc = a
printConstSection(stackStart)
main(stackStart)
}).catch(err => console.log('wasm error', err));
})
</script>
73 changes: 63 additions & 10 deletions src/IRTS/CodegenWasm.hs
Original file line number Diff line number Diff line change
Expand Up @@ -45,7 +45,6 @@ mkWasm defs stackSize heapSize =
raiseError <- importFunction "rts" "raiseError" (FuncType [I32] [])
strEq <- importFunction "rts" "strEq" (FuncType [I32, I32] [I32])
strHead <- importFunction "rts" "strHead" (FuncType [I32] [I32])
strConcat <- importFunction "rts" "strConcat" (FuncType [I32, I32] [I32])
strWrite <- importFunction "rts" "strWrite" (FuncType [I32] [I32])
intStr <- importFunction "rts" "intStr" (FuncType [I32] [I32])
exportMemory "mem" =<< memory 20 Nothing
Expand Down Expand Up @@ -120,6 +119,28 @@ mkWasm defs stackSize heapSize =
(const $ for (i .= stackTop) (i `lt_u` newStackTop) (i .= (i `add` i32c 4)) $ const $ do
store i (i32c 0) 0 2
)
memcpy <- fun $ do
dst <- param i32
src <- param i32
len <- param i32
i <- local i32
for (i .= i32c 0) (i `lt_u` len) (i .= (i `add` i32c 1)) $ const $ do
store8 (dst `add` i) (load8u i32 (src `add` i) 0 0) 0 0
strConcat <- fun $ do
a <- param i32
b <- param i32
result i32
aSize <- local i32
bSize <- local i32
addr <- local i32
aSize .= load i32 a 4 2
bSize .= load i32 b 4 2
addr .= call i32 alloc [aSize `add` bSize `sub` i32c 12]
store8 addr (i32c $ fromEnum String) 0 0
store addr (load i32 a 8 2 `add` load i32 b 8 2) 8 2
invoke memcpy [arg (addr `add` i32c 12), arg (a `add` i32c 12), arg (aSize `sub` i32c 12)]
invoke memcpy [arg (addr `add` aSize), arg (b `add` i32c 12), arg (bSize `sub` i32c 12)]
ret addr
defsStartFrom <- nextFuncIndex
let bindings = GB {
stackStartIdx = stackStart,
Expand Down Expand Up @@ -158,11 +179,14 @@ mkWasm defs stackSize heapSize =
data GenState = GS {
constSectionEnd :: Word32,
constSection :: BSBuilder.Builder,
strCache :: Map.Map String Word32
strCache :: Map.Map String Word32,
intCache :: Map.Map Int Word32,
bigCache :: Map.Map Integer Word32,
doubleCache :: Map.Map Double Word32
}

emptyState :: GenState
emptyState = GS 0 mempty mempty
emptyState = GS 0 mempty mempty mempty mempty mempty

data GlobalBindings = GB {
stackBaseIdx :: Glob I32,
Expand Down Expand Up @@ -576,23 +600,51 @@ asAddr expr = do
return $ i32c addr

makeConst :: Const -> WasmGen (GenFun (Proxy I32))
makeConst (I i) = asAddr $ addToConstSection (mkInt i)
makeConst (BI i) = asAddr $ addToConstSection (mkBigInt i)
makeConst (Fl f) = asAddr $ addToConstSection (mkFloat f)
makeConst (Ch c) = asAddr $ addToConstSection (mkInt $ Char.ord c)
makeConst (I i) = makeIntConst i
makeConst (BI i) = do
cache <- gets bigCache
case Map.lookup i cache of
Just addr -> return $ i32c addr
Nothing -> do
addr <- addToConstSection (mkBigInt i)
modify $ \st -> st { bigCache = Map.insert i addr cache }
return $ i32c addr
makeConst (Fl f) = do
cache <- gets doubleCache
case Map.lookup f cache of
Just addr -> return $ i32c addr
Nothing -> do
addr <- addToConstSection (mkFloat f)
modify $ \st -> st { doubleCache = Map.insert f addr cache }
return $ i32c addr
makeConst (Ch c) = makeIntConst $ Char.ord c
makeConst (Str s) = do
cache <- gets strCache
case Map.lookup s cache of
Just addr -> return $ i32c addr
Nothing -> asAddr $ addToConstSection (mkStr s)
makeConst (B8 w) = asAddr $ addToConstSection (mkInt w)
makeConst (B16 w) = asAddr $ addToConstSection (mkInt w)
Nothing -> do
addr <- addToConstSection (mkStr s)
modify $ \st -> st { strCache = Map.insert s addr cache }
return $ i32c addr
makeConst (B8 w) = makeIntConst w
makeConst (B16 w) = makeIntConst w
makeConst (B32 w) = asAddr $ addToConstSection (mkBit32 w)
makeConst (B64 w) = asAddr $ addToConstSection (mkBit64 w)
makeConst c
| isTypeConst c = asAddr $ addToConstSection (mkInt 42424242)
| otherwise = error $ "mkConst of (" ++ show c ++ ") not implemented"

makeIntConst :: (Integral i) => i -> WasmGen (GenFun (Proxy I32))
makeIntConst val = do
let i = fromIntegral val
cache <- gets intCache
case Map.lookup i cache of
Just addr -> return $ i32c addr
Nothing -> do
addr <- addToConstSection (mkInt i)
modify $ \st -> st { intCache = Map.insert i addr cache }
return $ i32c addr

aligned :: (Integral i) => i -> Word32
aligned sz = (fromIntegral sz + 3) .&. 0xFFFFFFFC

Expand Down Expand Up @@ -701,6 +753,7 @@ instance Serialize.Serialize StrVal where
put SV { hdr, len, val } = do
Serialize.put hdr
Serialize.putWord32le len
Serialize.putLazyByteString val
get = do
hdr <- Serialize.get
len <- Serialize.getWord32le
Expand Down

0 comments on commit d887870

Please sign in to comment.