@@ -244,7 +244,7 @@ codegenJS_all target definitions includes libs filename outputType = do
244244 , JSApp (JSIdent "i$SCHED") [JSIdent "vm"]
245245 , JSApp (
246246 JSIdent (translateName (sMN 0 "runMain"))
247− ) [JSNum (JSInt 0)]
247+ ) [JSNew "i$POINTER" [JSNum (JSInt 0)]]
248248 , JSWhile (JSProj jsCALLSTACK "length") (
249249 JSSeq [ JSAlloc "func" (Just jsPOP)
250250 , JSAlloc "args" (Just jsPOP)
@@ -328,24 +328,33 @@ splitFunction (JSAlloc name (Just (JSFunction args body@(JSSeq _)))) = do
328328
329329 splitSequence :: JS -> RWS () [(Int, JS)] Int JS
330330 splitSequence js@(JSSeq seq) =
331− let (pre,post) = break isCall seq in
331+ let (pre,post) = break isBranch seq in
332332 case post of
333− [] -> JSSeq <$> traverse splitCondition seq
334− [js@(JSCond _)] -> splitCondition js
335− [js@(JSSwitch {})] -> splitCondition js
336− [_] -> return js
333+ [_] -> JSSeq <$> traverse splitCondition seq
334+ [call@(JSCond _),rest@(JSApp _ _)] -> do
335+ rest' <- splitCondition rest
336+ call' <- splitCondition call
337+ return $ JSSeq (pre ++ [rest', call'])
338+ [call@(JSSwitch _ _ _),rest@(JSApp _ _)] -> do
339+ rest' <- splitCondition rest
340+ call' <- splitCondition call
341+ return $ JSSeq (pre ++ [rest', call'])
337342 (call:rest) -> do
338343 depth <- get
339344 put (depth + 1)
340345 new <- splitFunction (newFun rest)
341346 tell [(depth, new)]
342− return $ JSSeq (pre ++ (newCall depth : [call]))
347+ call' <- splitCondition call
348+ return $ JSSeq (pre ++ (newCall depth : [call']))
349+ _ -> JSSeq <$> traverse splitCondition seq
343350
344351 splitSequence js = return js
345352
346− isCall :: JS -> Bool
347− isCall (JSApp (JSIdent "i$CALL") _) = True
348− isCall _ = False
353+ isBranch :: JS -> Bool
354+ isBranch (JSApp (JSIdent "i$CALL") _) = True
355+ isBranch (JSCond _) = True
356+ isBranch (JSSwitch _ _ _) = True
357+ isBranch _ = False
349358
350359 newCall :: Int -> JS
351360 newCall depth =
@@ -366,7 +375,7 @@ translateDecl info (name@(MN 0 fun), bc)
366375 ++ [ JSAlloc (
367376 translateName name
368377 ) (Just $ JSFunction ["oldbase"] (
369− JSSeq $ JSAlloc "myoldbase" Nothing : map (translateBC info) (fst body) ++ [
378+ JSSeq $ jsFUNPRELUDE ++ map (translateBC info) (fst body) ++ [
370379 JSCond [ ( (translateReg $ caseReg (snd body)) `jsInstanceOf` "i$CON" `jsAnd` (JSProj (translateReg $ caseReg (snd body)) "app")
371380 , JSApp (JSProj (translateReg $ caseReg (snd body)) "app") [jsOLDBASE, jsMYOLDBASE]
372381 )
@@ -384,7 +393,7 @@ translateDecl info (name@(MN 0 fun), bc)
384393 ++ [ JSAlloc (
385394 translateName name
386395 ) (Just $ JSFunction ["oldbase"] (
387− JSSeq $ JSAlloc "myoldbase" Nothing : map (translateBC info) (fst body) ++ [
396+ JSSeq $ jsFUNPRELUDE ++ map (translateBC info) (fst body) ++ [
388397 JSCond [ ( (translateReg $ caseReg (snd body)) `jsInstanceOf` "i$CON" `jsAnd` (JSProj (translateReg $ caseReg (snd body)) "ev")
389398 , JSApp (JSProj (translateReg $ caseReg (snd body)) "ev") [jsOLDBASE, jsMYOLDBASE]
390399 )
@@ -431,11 +440,16 @@ translateDecl info (name, bc) =
431440 [ JSAlloc (
432441 translateName name
433442 ) (Just $ JSFunction ["oldbase"] (
434− JSSeq $ JSAlloc "myoldbase" Nothing : map (translateBC info)bc
443+ JSSeq $ jsFUNPRELUDE ++ map (translateBC info)bc
435444 )
436445 )
437446 ]
438447
448+jsFUNPRELUDE :: [JS]
449+jsFUNPRELUDE = [jsALLOCMYOLDBASE]
450+
451+jsALLOCMYOLDBASE :: JS
452+jsALLOCMYOLDBASE = JSAlloc "myoldbase" (Just $ JSNew "i$POINTER" [])
439453
440454translateReg :: Reg -> JS
441455translateReg reg
@@ -567,10 +581,10 @@ jsFOREIGN _ reg n args
567581 translateReg reg
568582
569583jsREBASE :: CompileInfo -> JS
570−jsREBASE _ = JSAssign jsSTACKBASE jsOLDBASE
584+jsREBASE _ = JSAssign jsSTACKBASE (JSProj jsOLDBASE "addr")
571585
572586jsSTOREOLD :: CompileInfo ->JS
573−jsSTOREOLD _ = JSAssign jsMYOLDBASE jsSTACKBASE
587+jsSTOREOLD _ = JSAssign (JSProj jsMYOLDBASE "addr") jsSTACKBASE
574588
575589jsADDTOP :: CompileInfo -> Int -> JS
576590jsADDTOP info n