git.iko.soy/Idris-dev
on master help sign in
javascript: quicker register access
3bcf23fraichoo
jsrts/Runtime-common.js+23−7
compare with master
unifiedsplit
@@ -10,6 +10,13 @@ var i$VM = function() {
10 this.callstack = [];
10 this.callstack = [];
11}
11}
12
12
13+var i$vm;
14+var i$valstack;
15+var i$valstack_top;
16+var i$valstack_base;
17+var i$ret;
18+var i$callstack;
19+
13/** @constructor */
20/** @constructor */
14var i$CON = function(tag,args,app,ev) {
21var i$CON = function(tag,args,app,ev) {
15 this.tag = tag;
22 this.tag = tag;
@@ -18,19 +25,28 @@ var i$CON = function(tag,args,app,ev) {
18 this.ev = ev;
25 this.ev = ev;
19}
26}
20
27
28+var i$SCHED = function(vm) {
29+ i$vm = vm;
30+ i$valstack = vm.valstack;
31+ i$valstack_top = vm.valstack_top;
32+ i$valstack_base = vm.valstack_base;
33+ i$ret = vm.ret;
34+ i$callstack = vm.callstack;
35+}
36+
21−var i$SLIDE = function(vm,args) {
37+var i$SLIDE = function(args) {
22 for (var i = 0; i < args; ++i)
38 for (var i = 0; i < args; ++i)
23− vm.valstack[vm.valstack_base + i] = vm.valstack[vm.valstack_top + i];
39+ i$valstack[i$valstack_base + i] = i$valstack[i$valstack_top + i];
24}
40}
25
41
26−var i$PROJECT = function(vm,val,loc,arity) {
42+var i$PROJECT = function(val,loc,arity) {
27 for (var i = 0; i < arity; ++i)
43 for (var i = 0; i < arity; ++i)
28− vm.valstack[vm.valstack_base + i + loc] = val.args[i];
44+ i$valstack[i$valstack_base + i + loc] = val.args[i];
29}
45}
30
46
31−var i$CALL = function(vm,fun,args) {
47+var i$CALL = function(fun,args) {
32− vm.callstack.push(args);
48+ i$callstack.push(args);
33− vm.callstack.push(fun);
49+ i$callstack.push(fun);
34}
50}
35
51
36var __IDRRT__charCode = function(str) {
52var __IDRRT__charCode = function(str) {
src/IRTS/CodegenJavaScript.hs+58−96
@@ -338,14 +338,13 @@ codegenJS_all target definitions includes filename outputType = do
338 main = compileJS $
338 main = compileJS $
339 JSAlloc "main" $ Just $ JSFunction [] (
339 JSAlloc "main" $ Just $ JSFunction [] (
340 JSSeq [ JSAlloc "vm" (Just $ JSNew "i$VM" [])
340 JSSeq [ JSAlloc "vm" (Just $ JSNew "i$VM" [])
341+ , JSApp (JSIdent "i$SCHED") [JSIdent "vm"]
341 , JSApp (
342 , JSApp (
342 JSIdent (translateName (sMN 0 "runMain"))
343 JSIdent (translateName (sMN 0 "runMain"))
343− ) [ JSIdent "vm"
344− , JSNum (JSInt 0)
344+ ) [JSNum (JSInt 0)]
345− ]
346− , JSWhile (JSProj (JSProj (JSIdent ("vm")) "callstack") "length") (
345+ , JSWhile (JSProj jsCALLSTACK "length") (
347− JSSeq [ JSAlloc "func" (Just (JSApp (JSProj (JSProj (JSIdent ("vm")) "callstack") "pop") []))
346+ JSSeq [ JSAlloc "func" (Just (JSApp (JSProj jsCALLSTACK "pop") []))
348− , JSAlloc "args" (Just (JSApp (JSProj (JSProj (JSIdent ("vm")) "callstack") "pop") []))
347+ , JSAlloc "args" (Just (JSApp (JSProj jsCALLSTACK "pop") []))
349 , JSApp (JSProj (JSIdent "func") "apply") [JSThis, JSIdent "args"]
348 , JSApp (JSProj (JSIdent "func") "apply") [JSThis, JSIdent "args"]
350 ]
349 ]
351 )
350 )
@@ -404,17 +403,13 @@ splitFunction (JSAlloc name (Just (JSFunction args body@(JSSeq _)))) = do
404
403
405 newCall :: Int -> JS
404 newCall :: Int -> JS
406 newCall depth =
405 newCall depth =
407− JSApp (JSIdent "i$CALL") [ JSIdent "vm"
406+ JSApp (JSIdent "i$CALL") [ JSIdent $ name ++ "$" ++ show depth
408− , JSIdent $ name ++ "$" ++ show depth
407+ , JSArray [jsOLDBASE, jsMYOLDBASE]
409− , JSArray [JSIdent "vm"
410− , JSIdent "oldbase"
411− , JSIdent "myoldbase"
412− ]
413 ]
408 ]
414
409
415 newFun :: [JS] -> JS
410 newFun :: [JS] -> JS
416 newFun seq =
411 newFun seq =
417− JSAlloc name (Just $ JSFunction ["vm", "oldbase", "myoldbase"] (JSSeq seq))
412+ JSAlloc name (Just $ JSFunction ["oldbase", "myoldbase"] (JSSeq seq))
418
413
419splitFunction js = return js
414splitFunction js = return js
420
415
@@ -424,13 +419,10 @@ translateDecl info (name@(MN 0 fun), bc)
424 allocCaseFunctions (snd body)
419 allocCaseFunctions (snd body)
425 ++ [ JSAlloc (
420 ++ [ JSAlloc (
426 translateName name
421 translateName name
427− ) (Just $ JSFunction ["vm", "oldbase"] (
422+ ) (Just $ JSFunction ["oldbase"] (
428 JSSeq $ JSAlloc "myoldbase" Nothing : map (translateBC info) (fst body) ++ [
423 JSSeq $ JSAlloc "myoldbase" Nothing : map (translateBC info) (fst body) ++ [
429 JSCond [ ( (translateReg $ caseReg (snd body)) `jsInstanceOf` "i$CON" `jsAnd` (JSProj (translateReg $ caseReg (snd body)) "app")
424 JSCond [ ( (translateReg $ caseReg (snd body)) `jsInstanceOf` "i$CON" `jsAnd` (JSProj (translateReg $ caseReg (snd body)) "app")
430− , JSApp (JSProj (translateReg $ caseReg (snd body)) "app") [ JSIdent "vm"
425+ , JSApp (JSProj (translateReg $ caseReg (snd body)) "app") [jsOLDBASE, jsMYOLDBASE]
431− , JSIdent "oldbase"
432− , JSIdent "myoldbase"
433− ]
434 )
426 )
435 , ( JSNoop
427 , ( JSNoop
436 , JSSeq $ map (translateBC info) (defaultCase (snd body))
428 , JSSeq $ map (translateBC info) (defaultCase (snd body))
@@ -445,13 +437,10 @@ translateDecl info (name@(MN 0 fun), bc)
445 allocCaseFunctions (snd body)
437 allocCaseFunctions (snd body)
446 ++ [ JSAlloc (
438 ++ [ JSAlloc (
447 translateName name
439 translateName name
448− ) (Just $ JSFunction ["vm", "oldbase"] (
440+ ) (Just $ JSFunction ["oldbase"] (
449 JSSeq $ JSAlloc "myoldbase" Nothing : map (translateBC info) (fst body) ++ [
441 JSSeq $ JSAlloc "myoldbase" Nothing : map (translateBC info) (fst body) ++ [
450 JSCond [ ( (translateReg $ caseReg (snd body)) `jsInstanceOf` "i$CON" `jsAnd` (JSProj (translateReg $ caseReg (snd body)) "ev")
442 JSCond [ ( (translateReg $ caseReg (snd body)) `jsInstanceOf` "i$CON" `jsAnd` (JSProj (translateReg $ caseReg (snd body)) "ev")
451− , JSApp (JSProj (translateReg $ caseReg (snd body)) "ev") [ JSIdent "vm"
443+ , JSApp (JSProj (translateReg $ caseReg (snd body)) "ev") [jsOLDBASE, jsMYOLDBASE]
452− , JSIdent "oldbase"
453− , JSIdent "myoldbase"
454− ]
455 )
444 )
456 , ( JSNoop
445 , ( JSNoop
457 , JSSeq $ map (translateBC info) (defaultCase (snd body))
446 , JSSeq $ map (translateBC info) (defaultCase (snd body))
@@ -487,7 +476,7 @@ translateDecl info (name@(MN 0 fun), bc)
487 prepBranch (tag, code) =
476 prepBranch (tag, code) =
488 JSAlloc (
477 JSAlloc (
489 translateName name ++ "$" ++ show tag
478 translateName name ++ "$" ++ show tag
490− ) (Just $ JSFunction ["vm", "oldbase", "myoldbase"] (
479+ ) (Just $ JSFunction ["oldbase", "myoldbase"] (
491 JSSeq $ map (translateBC info) code
480 JSSeq $ map (translateBC info) code
492 )
481 )
493 )
482 )
@@ -495,7 +484,7 @@ translateDecl info (name@(MN 0 fun), bc)
495translateDecl info (name, bc) =
484translateDecl info (name, bc) =
496 [ JSAlloc (
485 [ JSAlloc (
497 translateName name
486 translateName name
498− ) (Just $ JSFunction ["vm", "oldbase"] (
487+ ) (Just $ JSFunction ["oldbase"] (
499 JSSeq $ JSAlloc "myoldbase" Nothing : map (translateBC info)bc
488 JSSeq $ JSAlloc "myoldbase" Nothing : map (translateBC info)bc
500 )
489 )
501 )
490 )
@@ -504,28 +493,10 @@ translateDecl info (name, bc) =
504
493
505translateReg :: Reg -> JS
494translateReg :: Reg -> JS
506translateReg reg
495translateReg reg
507− | RVal <- reg = JSProj (JSIdent "vm") "ret"
496+ | RVal <- reg = jsRET
508 | Tmp <- reg = JSProj (JSIdent "vm") "reg1"
497 | Tmp <- reg = JSProj (JSIdent "vm") "reg1"
509− | L 0 <- reg =
510− JSIndex (
511− JSProj (JSIdent "vm") "valstack"
512− ) (JSProj (JSIdent "vm") "valstack_base")
513− | L n <- reg =
498+ | L n <- reg = jsLOC n
514− JSIndex (
515− JSProj (JSIdent "vm") "valstack"
516− ) (
517− JSBinOp "+" (JSProj (JSIdent "vm") "valstack_base") (JSNum (JSInt n))
518− )
519− | T 0 <- reg =
520− JSIndex (
521− JSProj (JSIdent "vm") "valstack"
522− ) (JSProj (JSIdent "vm") "valstack_top")
523− | T n <- reg =
499+ | T n <- reg = jsTOP n
524− JSIndex (
525− JSProj (JSIdent "vm") "valstack"
526− ) (
527− JSBinOp "+" (JSProj (JSIdent "vm") "valstack_top") (JSNum (JSInt n))
528− )
529
500
530translateConstant :: Const -> JS
501translateConstant :: Const -> JS
531translateConstant (I i) = JSNum (JSInt i)
502translateConstant (I i) = JSNum (JSInt i)
@@ -593,19 +564,13 @@ jsCALL :: CompileInfo -> Name -> JS
593jsCALL _ n =
564jsCALL _ n =
594 JSApp (
565 JSApp (
595 JSIdent "i$CALL"
566 JSIdent "i$CALL"
596− ) [ JSIdent "vm", JSIdent (translateName n), JSArray [ JSIdent "vm"
567+ ) [JSIdent (translateName n), JSArray [jsMYOLDBASE]]
597− , JSIdent "myoldbase"
598− ]
599− ]
600
568
601jsTAILCALL :: CompileInfo -> Name -> JS
569jsTAILCALL :: CompileInfo -> Name -> JS
602jsTAILCALL _ n =
570jsTAILCALL _ n =
603 JSApp (
571 JSApp (
604 JSIdent "i$CALL"
572 JSIdent "i$CALL"
605− ) [ JSIdent "vm", JSIdent (translateName n), JSArray [ JSIdent "vm"
573+ ) [JSIdent (translateName n), JSArray [jsOLDBASE]]
606− , JSIdent "oldbase"
607− ]
608− ]
609
574
610jsFOREIGN :: CompileInfo -> Reg -> String -> [(FType, Reg)] -> JS
575jsFOREIGN :: CompileInfo -> Reg -> String -> [(FType, Reg)] -> JS
611jsFOREIGN _ reg n args =
576jsFOREIGN _ reg n args =
@@ -616,56 +581,25 @@ jsFOREIGN _ reg n args =
616 )
581 )
617
582
618jsREBASE :: CompileInfo -> JS
583jsREBASE :: CompileInfo -> JS
619−jsREBASE _ =
584+jsREBASE _ = JSAssign jsSTACKBASE jsOLDBASE
620− JSAssign (
621− JSProj (JSIdent "vm") "valstack_base"
622− ) (
623− JSIdent "oldbase"
624− )
625
585
626jsSTOREOLD :: CompileInfo ->JS
586jsSTOREOLD :: CompileInfo ->JS
627−jsSTOREOLD _ =
587+jsSTOREOLD _ = JSAssign jsMYOLDBASE jsSTACKBASE
628− JSAssign (
629− JSIdent "myoldbase"
630− ) (
631− JSProj (JSIdent "vm") "valstack_base"
632− )
633
588
634jsADDTOP :: CompileInfo -> Int -> JS
589jsADDTOP :: CompileInfo -> Int -> JS
635jsADDTOP info n
590jsADDTOP info n
636 | 0 <- n = JSNoop
591 | 0 <- n = JSNoop
637 | otherwise =
592 | otherwise =
638− JSBinOp "+=" (JSProj (JSIdent "vm") "valstack_top") (JSNum (JSInt n))
593+ JSBinOp "+=" jsSTACKTOP (JSNum (JSInt n))
639
594
640jsTOPBASE :: CompileInfo -> Int -> JS
595jsTOPBASE :: CompileInfo -> Int -> JS
641−jsTOPBASE info n
596+jsTOPBASE _ 0 = JSAssign jsSTACKTOP jsSTACKBASE
642− | 0 <- n =
597+jsTOPBASE _ n = JSAssign jsSTACKTOP (JSBinOp "+" jsSTACKBASE (JSNum (JSInt n)))
643− JSAssign (
598+
644− JSProj (JSIdent "vm") "valstack_top"
645− ) (
646− JSProj (JSIdent "vm") "valstack_base"
647− )
648− | otherwise =
649− JSAssign (
650− JSProj (JSIdent "vm") "valstack_top"
651− ) (
652− JSBinOp "+" (JSProj (JSIdent "vm") "valstack_base") (JSNum (JSInt n))
653− )
654
599
655jsBASETOP :: CompileInfo -> Int -> JS
600jsBASETOP :: CompileInfo -> Int -> JS
656−jsBASETOP info n
601+jsBASETOP _ 0 = JSAssign jsSTACKBASE jsSTACKTOP
657− | 0 <- n =
602+jsBASETOP _ n = JSAssign jsSTACKBASE (JSBinOp "+" jsSTACKTOP (JSNum (JSInt n)))
658− JSAssign (
659− JSProj (JSIdent "vm") "valstack_base"
660− ) (
661− JSProj (JSIdent "vm") "valstack_top"
662− )
663− | otherwise =
664− JSAssign (
665− JSProj (JSIdent "vm") "valstack_base"
666− ) (
667− JSBinOp "+" (JSProj (JSIdent "vm") "valstack_top") (JSNum (JSInt n))
668− )
669
603
670jsNULL :: CompileInfo -> Reg -> JS
604jsNULL :: CompileInfo -> Reg -> JS
671jsNULL _ r = JSAssign (translateReg r) JSNull
605jsNULL _ r = JSAssign (translateReg r) JSNull
@@ -674,7 +608,7 @@ jsERROR :: CompileInfo -> String -> JS
674jsERROR _ = JSError
608jsERROR _ = JSError
675
609
676jsSLIDE :: CompileInfo -> Int -> JS
610jsSLIDE :: CompileInfo -> Int -> JS
677−jsSLIDE _ n = JSApp (JSIdent "i$SLIDE") [JSIdent "vm", JSNum (JSInt n)]
611+jsSLIDE _ n = JSApp (JSIdent "i$SLIDE") [JSNum (JSInt n)]
678
612
679jsMKCON :: CompileInfo -> Reg -> Int -> [Reg] -> JS
613jsMKCON :: CompileInfo -> Reg -> Int -> [Reg] -> JS
680jsMKCON info r t rs =
614jsMKCON info r t rs =
@@ -776,8 +710,7 @@ jsCONSTCASE info reg cases def =
776
710
777jsPROJECT :: CompileInfo -> Reg -> Int -> Int -> JS
711jsPROJECT :: CompileInfo -> Reg -> Int -> Int -> JS
778jsPROJECT _ reg loc ar =
712jsPROJECT _ reg loc ar =
779− JSApp (JSIdent "i$PROJECT") [ JSIdent "vm"
713+ JSApp (JSIdent "i$PROJECT") [ translateReg reg
780− , translateReg reg
781 , JSNum (JSInt loc)
714 , JSNum (JSInt loc)
782 , JSNum (JSInt ar)
715 , JSNum (JSInt ar)
783 ]
716 ]
@@ -1392,6 +1325,35 @@ jsOP _ reg op args = JSAssign (translateReg reg) jsOP'
1392jsRESERVE :: CompileInfo -> Int -> JS
1325jsRESERVE :: CompileInfo -> Int -> JS
1393jsRESERVE _ _ = JSNoop
1326jsRESERVE _ _ = JSNoop
1394
1327
1328+jsSTACK :: JS
1329+jsSTACK = JSIdent "i$valstack"
1330+
1331+jsCALLSTACK :: JS
1332+jsCALLSTACK = JSIdent "i$callstack"
1333+
1334+jsSTACKBASE :: JS
1335+jsSTACKBASE = JSIdent "i$valstack_base"
1336+
1337+jsSTACKTOP :: JS
1338+jsSTACKTOP = JSIdent "i$valstack_top"
1339+
1340+jsOLDBASE :: JS
1341+jsOLDBASE = JSIdent "oldbase"
1342+
1343+jsMYOLDBASE :: JS
1344+jsMYOLDBASE = JSIdent "myoldbase"
1345+
1346+jsRET :: JS
1347+jsRET = JSIdent "i$ret"
1348+
1349+jsLOC :: Int -> JS
1350+jsLOC 0 = JSIndex jsSTACK jsSTACKBASE
1351+jsLOC n = JSIndex jsSTACK (JSBinOp "+" jsSTACKBASE (JSNum (JSInt n)))
1352+
1353+jsTOP :: Int -> JS
1354+jsTOP 0 = JSIndex jsSTACK jsSTACKTOP
1355+jsTOP n = JSIndex jsSTACK (JSBinOp "+" jsSTACKTOP (JSNum (JSInt n)))
1356+
1395translateBC :: CompileInfo -> BC -> JS
1357translateBC :: CompileInfo -> BC -> JS
1396translateBC info bc
1358translateBC info bc
1397 | ASSIGN r1 r2 <- bc = jsASSIGN info r1 r2
1359 | ASSIGN r1 r2 <- bc = jsASSIGN info r1 r2