1-- SPDX-FileCopyrightText: 2025 Sören Tempel <soeren+git@soeren-tempel.net>2--3-- SPDX-License-Identifier: GPL-3.0-only45module Simulator (simTests) where67import Control.Monad.Catch (try)8import Data.Int (Int32)9import Data.Word (Word8)10import GHC.Float (castDoubleToWord64, castFloatToWord32, double2Float, float2Double)11import Language.QBE (parseAndFind)12import Language.QBE.Simulator13import Language.QBE.Simulator.Default.Expression qualified as D14import Language.QBE.Simulator.Default.State (Env, mkEnv, run)15import Language.QBE.Simulator.Error16import Language.QBE.Types qualified as QBE17import System.FilePath ((</>))18import Test.Tasty19import Test.Tasty.HUnit2021parseAndExec' ::22 QBE.GlobalIdent ->23 [D.RegVal] ->24 String ->25 IO (Either EvalError (Maybe D.RegVal))26parseAndExec' funcName params input = do27 (prog, entry) <- parseAndFind funcName input2829 env <- mkEnv prog 0 128 :: IO (Env D.RegVal Word8)30 try $ run env (execFunc entry params)3132parseAndExec :: QBE.GlobalIdent -> [D.RegVal] -> String -> IO (Maybe D.RegVal)33parseAndExec funcName params input = do34 evalRes <- parseAndExec' funcName params input35 case evalRes of36 Left e -> fail $ "Unexpected evaluation error: " ++ show e37 Right r -> pure r3839parseAndExecFile :: QBE.GlobalIdent -> [D.RegVal] -> FilePath -> IO (Maybe D.RegVal)40parseAndExecFile funcName params fileName = do41 let filePath = "test" </> "testdata" </> fileName42 input <- readFile filePath43 parseAndExec funcName params input4445------------------------------------------------------------------------4647blockTests :: TestTree48blockTests =49 testGroup50 "Evaluation of Basic Blocks"51 [ testCase "Evaluate single basic block with single instruction" $52 do53 res <-54 parseAndExec55 (QBE.GlobalIdent "addNumbers")56 []57 "function w $addNumbers() {\n\58 \@start\n\59 \%c =w add 1, 2\n\60 \ret %c\n\61 \}"6263 res @?= Just (D.VWord 3),64 testCase "Evaluate single basic block with multiple instructions" $65 do66 res <-67 parseAndExec68 (QBE.GlobalIdent "addMultiple")69 []70 "function w $addMultiple() {\n\71 \@begin\n\72 \%val =w add 1, 2\n\73 \%foo =w add %val, 2\n\74 \ret %foo\n\75 \}"7677 res @?= Just (D.VWord 5),78 testCase "Evaluate expression with subtyping" $79 do80 res <-81 -- 16045690984835251117 == 0xdeadbeefdecafbad82 parseAndExec83 (QBE.GlobalIdent "subtyping")84 []85 "function w $subtyping() {\n\86 \@go\n\87 \%val =l add 16045690984835251117, 0\n\88 \%foo =w add %val, 0\n\89 \ret %foo\n\90 \}"9192 res @?= Just (D.VWord 0xdecafbad),93 testCase "Subtyping in function return value" $94 do95 res <-96 -- 16045690984835251117 == 0xdeadbeefdecafbad97 parseAndExec98 (QBE.GlobalIdent "subtyp")99 []100 "function w $subtyp() {\n\101 \@start\n\102 \%v =l add 0, 16045690984835251117\n\103 \ret %v\n\104 \}"105106 res @?= Just (D.VWord 0xdecafbad),107 testCase "Evaluate function without return value" $108 do109 res <-110 parseAndExec111 (QBE.GlobalIdent "noRet")112 []113 "function $noRet() {\n\114 \@start\n\115 \ret\n\116 \}"117118 res @?= Nothing,119 testCase "Evaluate two basic blocks with unconditional jump" $120 do121 res <-122 parseAndExec123 (QBE.GlobalIdent "unconditionalJump")124 []125 "function w $unconditionalJump() {\n\126 \@start\n\127 \%val =w add 0, 1\n\128 \jmp @next\n\129 \@next\n\130 \%val =w add %val, 1\n\131 \ret %val\n\132 \}"133134 res @?= Just (D.VWord 2),135 testCase "Evalute basic blocks with fallthrough jump" $136 do137 res <-138 parseAndExec139 (QBE.GlobalIdent "unconditionalJump")140 []141 "function w $unconditionalJump() {\n\142 \@start\n\143 \%val =w add 0, 1\n\144 \@next\n\145 \%val =w add %val, 1\n\146 \ret %val\n\147 \}"148149 res @?= Just (D.VWord 2),150 testCase "Conditional jump with zero value" $151 do152 res <-153 parseAndExec154 (QBE.GlobalIdent "conditionalJumpTaken")155 []156 "function l $conditionalJumpTaken() {\n\157 \@start\n\158 \%zero =w add 0, 0\n\159 \jnz %zero, @nonZero, @zero\n\160 \@nonZero\n\161 \%val =l add 0, 42\n\162 \ret %val\n\163 \@zero\n\164 \%val =l add 0, 23\n\165 \ret %val\n\166 \}"167168 res @?= Just (D.VLong 23),169 testCase "Conditional jump with non-zero value" $170 do171 res <-172 parseAndExec173 (QBE.GlobalIdent "conditionalJumpTaken")174 []175 "function l $conditionalJumpTaken() {\n\176 \@start\n\177 \%zero =w add 1, 0\n\178 \jnz %zero, @nonZero, @zero\n\179 \@nonZero\n\180 \%val =l add 0, 42\n\181 \ret %val\n\182 \@zero\n\183 \%val =l add 0, 23\n\184 \ret %val\n\185 \}"186187 res @?= Just (D.VLong 42),188 testCase "Execute a function with parameters" $189 do190 res <-191 parseAndExec192 (QBE.GlobalIdent "funcWithParam")193 [D.VWord 41]194 "function w $funcWithParam(w %x) {\n\195 \@go\n\196 \%y =w add 1, %x\n\197 \ret %y\n\198 \}"199200 res @?= Just (D.VWord 42),201 testCase "Function call instruction without return value" $202 do203 res <-204 parseAndExec205 (QBE.GlobalIdent "main")206 []207 "function $foo(w %x) {\n\208 \@start\n\209 \%y =w sub 42, 0\n\210 \ret\n\211 \}\n\212 \function w $main() {\n\213 \@start\n\214 \%y =w sub 0, 0\n\215 \call $foo(w %y)\n\216 \ret %y\n\217 \}"218219 res @?= Just (D.VWord 0),220 testCase "Function call with return value" $221 do222 res <-223 parseAndExec224 (QBE.GlobalIdent "main")225 []226 "function w $foo(w %x) {\n\227 \@start\n\228 \%y =w sub %x, 19\n\229 \ret %y\n\230 \}\n\231 \function w $main() {\n\232 \@start\n\233 \%x =w add 0, 42\n\234 \%ret =w call $foo(w %x)\n\235 \ret %ret\n\236 \}"237238 res @?= Just (D.VWord 23),239 testCase "Allocate, store and load value in memory" $240 do241 res <-242 parseAndExec243 (QBE.GlobalIdent "allocate")244 []245 "function w $allocate() {\n\246 \@start\n\247 \%addr =l alloc4 4\n\248 \storew 2342, %addr\n\249 \%v =w loadw %addr\n\250 \ret %v\n\251 \}"252253 res @?= Just (D.VWord 2342),254 testCase "Load with sub word type" $255 do256 res <-257 parseAndExec258 (QBE.GlobalIdent "allocate")259 []260 "function w $allocate() {\n\261 \@start\n\262 \%addr =l alloc4 4\n\263 \storeb 249, %addr\n\264 \%v =w loadsb %addr\n\265 \ret %v\n\266 \}"267268 -- 249 (0xf9) sign extended to 32-bit.269 res @?= Just (D.VWord 0xfffffff9),270 testCase "Store subword in memory" $271 do272 res <-273 -- 2863311530 == 0xaaaaaaaa274 parseAndExec275 (QBE.GlobalIdent "storeByte")276 []277 "function w $storeByte() {\n\278 \@start\n\279 \%addr =l alloc4 4\n\280 \storew 2863311530, %addr\n\281 \storeb 255, %addr\n\282 \%v =w loadw %addr\n\283 \ret %v\n\284 \}"285286 res @?= Just (D.VWord 0xaaaaaaff),287 testCase "Function with user-defined type as function parameter" $288 do289 res <-290 parseAndExec291 (QBE.GlobalIdent "main")292 []293 "type :one = { w }\n\294 \function w $getone(:one %ptr) {\n\295 \@start\n\296 \%val =w loadw %ptr\n\297 \ret %val\n\298 \}\n\299 \function w $main() {\n\300 \@entry\n\301 \%addr =l alloc4 4\n\302 \storew 3735928559, %addr\n\303 \%ret =w call $getone(l %addr)\n\304 \ret %ret\n\305 \}"306307 res @?= Just (D.VWord 0xdeadbeef),308 testCase "Pointer arithmetic on user-defined type" $309 do310 res <-311 parseAndExec312 (QBE.GlobalIdent "main")313 []314 "type :abyteandmanywords = { w, b 100 }\n\315 \function w $main() {\n\316 \@start.1\n\317 \%addr.0 =l alloc4 104\n\318 \%addr.1 =l add %addr.0, 4\n\319 \storeb 255, %addr.1\n\320 \%addr.2 =l sub %addr.1, 4\n\321 \storew 3735928304, %addr.2\n\322 \%word =w loaduw %addr.0\n\323 \%byte =w loadub %addr.1\n\324 \%res =w add %word, %byte\n\325 \ret %res\n\326 \}"327328 res @?= Just (D.VWord 0xdeadbeef),329 testCase "Subtyping with subword function parameters" $330 do331 res <-332 parseAndExec'333 (QBE.GlobalIdent "subword")334 [D.VWord 0xff]335 "function $subword(ub %val) {\n\336 \@start\n\337 \%val =w add %val, 1\n\338 \ret\n\339 \}"340341 res @?= Right Nothing,342 testCase "Jump to unknown block within function" $343 do344 res <-345 parseAndExec'346 (QBE.GlobalIdent "main")347 []348 "function $main() {\n\349 \@start\n\350 \jmp @foo\n\351 \@bar\n\352 \ret\n\353 \}"354355 res @?= Left (UnknownBlock $ QBE.BlockIdent "foo"),356 testCase "Call undefined function" $357 do358 res <-359 parseAndExec'360 (QBE.GlobalIdent "main")361 []362 "function $main() {\n\363 \@start\n\364 \call $bar()\n\365 \ret\n\366 \}"367368 res @?= Left (UnknownFunction $ QBE.GlobalIdent "bar"),369 testCase "Arithmetic with single-precision float" $370 do371 res <-372 parseAndExec373 (QBE.GlobalIdent "addFloats")374 [D.VSingle 2.0, D.VSingle 0.3]375 "function s $addFloats(s %f1, s %f2) {\n\376 \@start\n\377 \%val =s add %f1, %f2\n\378 \ret %val\n\379 \}"380381 res @?= Just (D.VSingle 2.3),382 testCase "Arithmetic with double-precision float" $383 do384 res <-385 parseAndExec386 (QBE.GlobalIdent "addFloats")387 [D.VDouble 2.0, D.VDouble 0.3]388 "function d $addFloats(d %f1, d %f2) {\n\389 \@start\n\390 \%val =d add %f1, %f2\n\391 \ret %val\n\392 \}"393394 res @?= Just (D.VDouble 2.3),395 testCase "Arithmetic with float literal" $396 do397 res1 <-398 parseAndExec399 (QBE.GlobalIdent "addFloatAndLit")400 [D.VSingle 4.2]401 "function s $addFloatAndLit(s %f) {\n\402 \@start\n\403 \%v =s add %f, 1\n\404 \ret %v\n\405 \}"406407 -- This returns 4.2, not 5.2 because the 1 is interpreted408 -- as a bitwise representation of an IEEE floating point.409 --410 -- QBE itself also treats it in this way.411 res1 @?= Just (D.VSingle 4.2)412413 -- The following works because it uses the single literal.414 res2 <-415 parseAndExec416 (QBE.GlobalIdent "addFloatAndLit")417 [D.VSingle 4.2]418 "function s $addFloatAndLit(s %f) {\n\419 \@start\n\420 \%v =s add %f, s_1.0\n\421 \ret %v\n\422 \}"423424 res2 @?= Just (D.VSingle 5.2),425 testCase "Invalid mixed float arithmetic" $426 do427 res <-428 parseAndExec'429 (QBE.GlobalIdent "addFloatAndLong")430 [D.VSingle 4.2, D.VLong 42]431 "function s $addFloatAndLong(s %f, l %l) {\n\432 \@start\n\433 \%v =s add %f, %l\n\434 \ret %v\n\435 \}"436437 res @?= Left TypingError,438 testCase "Store float in memory and load it again" $439 do440 res <-441 parseAndExec442 (QBE.GlobalIdent "storeAndLoadFloat")443 [D.VSingle 0.333333333]444 "function s $storeAndLoadFloat(s %f) {\n\445 \@start.1\n\446 \%addr =l alloc4 4\n\447 \stores %f, %addr\n\448 \%loaded =s loads %addr\n\449 \ret %loaded\n\450 \}"451452 res @?= Just (D.VSingle 0.333333333),453 testCase "Store double in memory and load it again" $454 do455 res <-456 parseAndExec457 (QBE.GlobalIdent "storeAndLoadDouble")458 [D.VDouble 0.3333333331111]459 "function d $storeAndLoadDouble(d %f) {\n\460 \@start.1\n\461 \%addr =l alloc4 8\n\462 \stored %f, %addr\n\463 \%loaded =d loadd %addr\n\464 \ret %loaded\n\465 \}"466467 res @?= Just (D.VDouble 0.3333333331111),468 testCase "Load data object from memory" $469 do470 res <-471 parseAndExec472 (QBE.GlobalIdent "main")473 []474 "data $a = { b \"ABCD\" }\n\475 \function w $main() {\n\476 \@start\n\477 \%w =w loadw $a\n\478 \ret %w\n\479 \}"480481 res @?= Just (D.VWord 0x44434241),482 testCase "Data definition with symbol reference" $483 do484 res <-485 parseAndExec486 (QBE.GlobalIdent "main")487 []488 "data $a = { b \"ABCD\" }\n\489 \data $p = { l $a }\n\490 \function w $main() {\n\491 \@start\n\492 \%ptr =l loadl $p\n\493 \%res =w loadw %ptr\n\494 \ret %res\n\495 \}"496497 res @?= Just (D.VWord 0x44434241),498 testCase "Data definition with symbol offset" $499 do500 res <-501 parseAndExec502 (QBE.GlobalIdent "main")503 []504 "data $a = align 1 { b \"ABCDE\" }\n\505 \data $p = align 8 { l $a + 1 }\n\506 \function w $main() {\n\507 \@start\n\508 \%ptr =l loadl $p\n\509 \%res =w loadw %ptr\n\510 \ret %res\n\511 \}"512513 res @?= Just (D.VWord 0x45444342),514 testCase "Data definition with constant number" $515 do516 res <-517 parseAndExec518 (QBE.GlobalIdent "main")519 []520 "data $a = align 4 { l 42 }\n\521 \function l $main() {\n\522 \@start\n\523 \%l =l loadl $a\n\524 \ret %l\n\525 \}"526527 res @?= Just (D.VLong 42),528 testCase "Data definition with multiple fields" $529 do530 res <-531 parseAndExec532 (QBE.GlobalIdent "main")533 []534 "data $a = align 1 { b \"ABCD\", w 42 }\n\535 \data $p = align 8 { l $a + 4 }\n\536 \function w $main() {\n\537 \@start\n\538 \%ptr =l loadl $p\n\539 \%res =w loadw %ptr\n\540 \ret %res\n\541 \}"542543 res @?= Just (D.VWord 42),544 testCase "Data definition with zero fill" $545 do546 res <-547 parseAndExec548 (QBE.GlobalIdent "main")549 []550 "data $a = align 1 { w 4294967295, z 4, w 4294967295 }\n\551 \data $p = align 8 { l $a }\n\552 \function w $main() {\n\553 \@start\n\554 \%ptr =l loadl $p\n\555 \%ptr =l add %ptr, 4\n\556 \%res =w loadw %ptr\n\557 \ret %res\n\558 \}"559560 res @?= Just (D.VWord 0),561 testCase "Data definition with single" $562 do563 res <-564 parseAndExec565 (QBE.GlobalIdent "main")566 []567 "data $a = align 1 { s s_2.3, s s_4.2 }\n\568 \data $p = align 8 { l $a }\n\569 \function s $main() {\n\570 \@start\n\571 \%ptr.1 =l loadl $p\n\572 \%ptr.2 =l add %ptr.1, 4\n\573 \%val.1 =s loads %ptr.1\n\574 \%val.2 =s loads %ptr.2\n\575 \%res =s add %val.1, %val.2\n\576 \ret %res\n\577 \}"578 res @?= Just (D.VSingle $ 2.3 + 4.2),579 testCase "Recursive data definition" $580 do581 res <-582 parseAndExec583 (QBE.GlobalIdent "main")584 []585 "data $c = { l -1, l $c }\n\586 \function w $main() {\n\587 \@start\n\588 \%ptr.1 =l add $c, 0\n\589 \%ptr.2 =l add $c, 8\n\590 \%field =l loadl %ptr.2\n\591 \%ptrEq =w ceql %field, %ptr.1\n\592 \ret %ptrEq\n\593 \}"594595 res @?= Just (D.VWord 1),596 testCase "Data definition with maximum struct member alignment" $597 do598 res <-599 -- The maximum alignment of a struct member for the struct600 -- referenced by `$ptr` is 8 (the long member). Therefore,601 -- the struct must be allocated on a 8-Byte-aligned address.602 parseAndExec603 (QBE.GlobalIdent "main")604 []605 "data $fill = { w 0 }\n\606 \data $ptr = { b 255, w 2342, l 1337, b 255 }\n\607 \function w $main() {\n\608 \@start\n\609 \%p =l urem $ptr, 8\n\610 \%correctAlign =w ceql %p, 0\n\611 \ret %correctAlign\n\612 \}"613614 res @?= Just (D.VWord 1),615 testCase "Data definition with forward reference to other definition" $616 do617 res <-618 parseAndExec619 (QBE.GlobalIdent "main")620 []621 "data $a = { l $b }\n\622 \data $b = { b 0 }\n\623 \function w $main() {\n\624 \@start\n\625 \%isGt =w cugtl $a, $b\n\626 \%ptrB =l loadl $a\n\627 \%isEq =w ceql %ptrB, $b\n\628 \%ret =w and %isEq, %isGt\n\629 \ret %ret\n\630 \}"631632 res @?= Just (D.VWord 1),633 testCase "Access memory of data definition with forward reference" $634 do635 res <-636 parseAndExec637 (QBE.GlobalIdent "main")638 []639 "data $a = { l $b }\n\640 \data $b = { b 99 }\n\641 \function w $main() {\n\642 \@start\n\643 \%pb =l loadl $a\n\644 \%vb =w loadub %pb\n\645 \%rt =w extub %vb\n\646 \ret %rt\n\647 \}"648649 res @?= Just (D.VWord 99),650 testCase "Subtyping with load instruction" $651 do652 res <-653 -- 16045690984835251117 == 0xdeadbeefdecafbad654 parseAndExec655 (QBE.GlobalIdent "allocate")656 []657 "function w $allocate() {\n\658 \@start\n\659 \%addr =l alloc4 4\n\660 \storel 16045690984835251117, %addr\n\661 \%v =w loadl %addr\n\662 \ret %v\n\663 \}"664665 res @?= Just (D.VWord 0xdecafbad),666 testCase "Subtyped branch condition" $667 do668 res <-669 parseAndExec670 (QBE.GlobalIdent "condJump")671 []672 "function w $condJump() {\n\673 \@start\n\674 \%zero =l add 0, 0\n\675 \jnz %zero, @nonZero, @zero\n\676 \@nonZero\n\677 \%val =w add 0, 42\n\678 \ret %val\n\679 \@zero\n\680 \%val =w add 0, 23\n\681 \ret %val\n\682 \}"683684 res @?= Just (D.VWord 23),685 testCase "Multiple jumps" $686 do687 res <-688 parseAndExec689 (QBE.GlobalIdent "branchOnInput")690 [D.VWord 0, D.VWord 0]691 "function w $branchOnInput(w %cond1, w %cond2) {\n\692 \@jump.1\n\693 \jnz %cond1, @branch.1, @branch.2\n\694 \@branch.1\n\695 \jmp @jump.2\n\696 \@branch.2\n\697 \jmp @jump.2\n\698 \@jump.2\n\699 \jnz %cond2, @branch.3, @branch.4\n\700 \@branch.3\n\701 \ret 3\n\702 \@branch.4\n\703 \ret 4\n\704 \}"705706 res @?= Just (D.VWord 4),707 testCase "Blit instruction w/o overlaps" $708 do709 res <-710 parseAndExec711 (QBE.GlobalIdent "main")712 [D.VWord 0xdeadbeef]713 "function w $main(w %word) {\n\714 \@start\n\715 \%src =l alloc4 4\n\716 \%dst =l alloc4 4\n\717 \storew %word, %src\n\718 \blit %src, %dst, 4\n\719 \%ret =w loadw %dst\n\720 \ret %ret\n\721 \}"722723 res @?= Just (D.VWord 0xdeadbeef),724 testCase "Blit instruction with no bytes to copy" $725 do726 res <-727 parseAndExec728 (QBE.GlobalIdent "main")729 [D.VWord 0xdeadbeef]730 "function w $main(w %word) {\n\731 \@start\n\732 \%src =l alloc4 4\n\733 \%dst =l alloc4 4\n\734 \storew %word, %src\n\735 \storew 42, %dst\n\736 \blit %src, %dst, 0\n\737 \%ret =w loadw %dst\n\738 \ret %ret\n\739 \}"740741 res @?= Just (D.VWord 42),742 testCase "Comparision instruction" $743 do744 let prog =745 "function w $main(w %lhs, w %rhs) {\n\746 \@start\n\747 \%r =w csltw %lhs, %rhs\n\748 \ret %r\n\749 \}"750751 resLarger <-752 parseAndExec753 (QBE.GlobalIdent "main")754 [D.VWord 0, D.VWord 1]755 prog756 resLarger @?= Just (D.VWord 1)757758 resSmaller <-759 parseAndExec760 (QBE.GlobalIdent "main")761 [D.VWord 1, D.VWord 0]762 prog763 resSmaller @?= Just (D.VWord 0),764 testCase "Compare with subtyping" $765 do766 res <-767 parseAndExec768 (QBE.GlobalIdent "main")769 [D.VWord 1, D.VLong 0]770 "function w $main(w %lhs, l %rhs) {\n\771 \@start\n\772 \%r =w csltw %lhs, %rhs\n\773 \ret %r\n\774 \}"775776 res @?= Just (D.VWord 0),777 testCase "Compare with long exceeding 32-bit" $778 do779 res <-780 parseAndExec781 (QBE.GlobalIdent "main")782 []783 "function w $main() {\n\784 \@start\n\785 \%r =w cultl 4294967296, 20\n\786 \ret %r\n\787 \}"788789 res @?= Just (D.VWord 0),790 testCase "Phi instruction" $791 do792 res <-793 parseAndExec794 (QBE.GlobalIdent "f")795 []796 "function w $f() {\n\797 \@begin\n\798 \jmp @start2\n\799 \@start1\n\800 \jmp @phi\n\801 \@start2\n\802 \jmp @phi\n\803 \@phi\n\804 \%v =w phi @start1 23, @start2 42\n\805 \ret %v\n\806 \}"807808 res @?= Just (D.VWord 42),809 testCase "Sign extend subword" $810 do811 res <-812 parseAndExec813 (QBE.GlobalIdent "ext")814 [D.VWord 128]815 "function w $ext(w %word) {\n\816 \@start\n\817 \%r =w extsb %word\n\818 \ret %r\n\819 \}"820821 res @?= Just (D.VWord 0xffffff80),822 testCase "Zero extend subword" $823 do824 res <-825 parseAndExec826 (QBE.GlobalIdent "ext")827 [D.VWord 128]828 "function w $ext(w %word) {\n\829 \@start\n\830 \%r =w extub %word\n\831 \ret %r\n\832 \}"833834 res @?= Just (D.VWord 0x00000080),835 testCase "Shift instructions" $836 do837 res <-838 parseAndExec839 (QBE.GlobalIdent "shift")840 [D.VWord 0xdeadbeef]841 "function w $shift(w %word) {\n\842 \@start\n\843 \%r =w shr 3735928559, 4\n\844 \%r =w shl %r, 4\n\845 \ret %r\n\846 \}"847848 res @?= Just (D.VWord 0xdeadbee0),849 testCase "Shift with long amount" $850 do851 res <-852 parseAndExec853 (QBE.GlobalIdent "shift")854 []855 "function l $shift() {\n\856 \@start\n\857 \%r =l shl 2, 4294967300\n\858 \ret %r\n\859 \}"860861 -- 4294967300 overflows to 4 so this is: 2 << 4.862 res @?= Just (D.VLong 32),863 testCase "Div instruction with single" $864 do865 res <-866 parseAndExec867 (QBE.GlobalIdent "div")868 []869 "function s $div() {\n\870 \@start\n\871 \%r =s div s_5.0, s_2.0\n\872 \ret %r\n\873 \}"874875 res @?= Just (D.VSingle 2.5),876 testCase "Div instruction with double" $877 do878 res <-879 parseAndExec880 (QBE.GlobalIdent "div")881 []882 "function d $div() {\n\883 \@start\n\884 \%r =d div d_5.0, d_2.0\n\885 \ret %r\n\886 \}"887888 res @?= Just (D.VDouble 2.5),889 testCase "Div instruction with word" $890 do891 res <-892 parseAndExec893 (QBE.GlobalIdent "div")894 []895 "function w $div() {\n\896 \@start\n\897 \%r =w div 5, 2\n\898 \ret %r\n\899 \}"900901 res @?= Just (D.VWord 2),902 testCase "Copy instruction with subtyping" $903 do904 res <-905 parseAndExec906 (QBE.GlobalIdent "main")907 []908 "function w $main() {\n\909 \@start\n\910 \%l =l copy 42\n\911 \%w =w copy %l\n\912 \ret %w\n\913 \}"914915 res @?= Just (D.VWord 42),916 testCase "Cast from single to word" $917 do918 res <-919 parseAndExec920 (QBE.GlobalIdent "main")921 []922 "function w $main() {\n\923 \@start\n\924 \%s =s add s_0.0, s_4.2\n\925 \%w =w cast %s\n\926 \ret %w\n\927 \}"928929 let ftow = castFloatToWord32 4.2930 res @?= Just (D.VWord ftow),931 testCase "Cast from double to long" $932 do933 res <-934 parseAndExec935 (QBE.GlobalIdent "main")936 []937 "function l $main() {\n\938 \@start\n\939 \%d =d add d_0.0, d_4.2\n\940 \%l =l cast %d\n\941 \ret %l\n\942 \}"943944 let dtol = castDoubleToWord64 4.2945 res @?= Just (D.VLong dtol),946 testCase "Cast from word to single" $947 do948 let ftow = castFloatToWord32 4.2949 res <-950 parseAndExec951 (QBE.GlobalIdent "cast")952 [D.VWord ftow]953 "function s $cast(w %w) {\n\954 \@start\n\955 \%s =s cast %w\n\956 \ret %s\n\957 \}"958959 res @?= Just (D.VSingle 4.2),960 testCase "Cast from long to double" $961 do962 let dtol = castDoubleToWord64 4.2342963 res <-964 parseAndExec965 (QBE.GlobalIdent "cast")966 [D.VLong dtol]967 "function d $cast(l %l) {\n\968 \@start\n\969 \%d =d cast %l\n\970 \ret %d\n\971 \}"972973 res @?= Just (D.VDouble 4.2342),974 testCase "Trunc double to single" $975 do976 let f = 4.293170199018932489308403284024098032977 res <-978 parseAndExec979 (QBE.GlobalIdent "trunc")980 [D.VDouble f]981 "function s $trunc(d %d) {\n\982 \@start\n\983 \%s =s truncd %d\n\984 \ret %s\n\985 \}"986987 let d2f = D.VSingle $ double2Float f988 res @?= Just d2f,989 testCase "Extend float to double" $990 do991 let f = 23.42992 res <-993 parseAndExec994 (QBE.GlobalIdent "ext")995 [D.VSingle f]996 "function d $ext(s %s) {\n\997 \@start\n\998 \%d =d exts %s\n\999 \ret %d\n\1000 \}"10011002 let f2d = D.VDouble $ float2Double f1003 res @?= Just f2d,1004 testCase "Invalid exts" $1005 do1006 res <-1007 parseAndExec'1008 (QBE.GlobalIdent "ext")1009 [D.VSingle 23.42]1010 "function s $ext(s %s) {\n\1011 \@start\n\1012 \%s =s exts %s\n\1013 \ret %s\n\1014 \}"10151016 res @?= Left TypingError,1017 testCase "Convert single to unsigned long" $1018 do1019 let f = 4.21020 res <-1021 parseAndExec1022 (QBE.GlobalIdent "fcon")1023 [D.VSingle f]1024 "function l $fcon(s %s) {\n\1025 \@start\n\1026 \%ret =l stoui %s\n\1027 \ret %ret\n\1028 \}"10291030 res @?= Just (D.VLong 4),1031 testCase "Convert single to signed word" $1032 do1033 let f = -3.991034 res <-1035 parseAndExec1036 (QBE.GlobalIdent "fcon")1037 [D.VSingle f]1038 "function w $fcon(s %s) {\n\1039 \@start\n\1040 \%ret =w stosi %s\n\1041 \ret %ret\n\1042 \}"10431044 res @?= Just (D.VWord $ fromIntegral (-3 :: Int32)),1045 testCase "Convert double to unsigned int" $1046 do1047 let f = 4.91048 res <-1049 parseAndExec1050 (QBE.GlobalIdent "fcon")1051 [D.VDouble f]1052 "function l $fcon(d %d) {\n\1053 \@start\n\1054 \%ret =l dtoui %d\n\1055 \ret %ret\n\1056 \}"10571058 res @?= Just (D.VLong 4),1059 testCase "Compare double to NaN" $1060 do1061 let exec lhs rhs =1062 parseAndExec1063 (QBE.GlobalIdent "isNaN")1064 [D.VDouble lhs, D.VDouble rhs]1065 "function w $isNaN(d %lhs, d %rhs) {\n\1066 \@start\n\1067 \%ret =w cod %lhs, %rhs\n\1068 \ret %ret\n\1069 \}"10701071 res0 <- exec 0 01072 res0 @?= Just (D.VWord 1)10731074 res1 <- exec 0 (read "NaN")1075 res1 @?= Just (D.VWord 0)10761077 res2 <- exec (read "NaN") 01078 res2 @?= Just (D.VWord 0),1079 testCase "Compare single equality" $1080 do1081 let exec lhs rhs =1082 parseAndExec1083 (QBE.GlobalIdent "eq")1084 [D.VSingle lhs, D.VSingle rhs]1085 "function w $eq(s %lhs, s %rhs) {\n\1086 \@start\n\1087 \%ret =w ceqs %lhs, %rhs\n\1088 \ret %ret\n\1089 \}"10901091 res0 <- exec 0 01092 res0 @?= Just (D.VWord 1)10931094 res1 <- exec 0 23.421095 res1 @?= Just (D.VWord 0)10961097 res2 <- exec 42.1 01098 res2 @?= Just (D.VWord 0)10991100 res3 <- exec 42.2323 42.23231101 res3 @?= Just (D.VWord 1),1102 testCase "phi instruction in second block" $1103 do1104 res <-1105 parseAndExec1106 (QBE.GlobalIdent "main")1107 []1108 "function w $main() {\n\1109 \@start.1\n\1110 \%.0 =w copy 42\n\1111 \@body.2\n\1112 \%.1 =w phi @start.1 1, @body.2 2\n\1113 \ret %.1\n\1114 \}"11151116 res @?= Just (D.VWord 1),1117 testCase "variable argument list with single argument" $1118 do1119 res <-1120 parseAndExec1121 (QBE.GlobalIdent "varAdd1")1122 [D.VWord 1, D.VWord 2]1123 "function w $varAdd1(w %a, ...) {\n\1124 \@start\n\1125 \%ap =l alloc8 8\n\1126 \vastart %ap\n\1127 \%b =w vaarg %ap\n\1128 \%c =w add %a, %b\n\1129 \ret %c\n\1130 \}"11311132 res @?= Just (D.VWord 3),1133 testCase "variable argument list with no variable argument" $1134 do1135 res <-1136 parseAndExec1137 (QBE.GlobalIdent "varAdd1")1138 [D.VWord 1, D.VWord 2, D.VWord 2342]1139 "function w $varAdd1(w %a, ...) {\n\1140 \@start\n\1141 \%ap =l alloc8 8\n\1142 \vastart %ap\n\1143 \ret 0\n\1144 \}"11451146 res @?= Just (D.VWord 0),1147 testCase "passing pointer to variable argument list" $1148 do1149 -- Example from https://c9x.me/compile/doc/il-v1.2.html#Variadic1150 res <-1151 parseAndExec1152 (QBE.GlobalIdent "main")1153 []1154 "function w $add3(w %a, ...) {\n\1155 \@start\n\1156 \%ap =l alloc8 32\n\1157 \vastart %ap\n\1158 \%r =w call $vadd(w %a, l %ap)\n\1159 \ret %r\n\1160 \}\n\1161 \function w $vadd(w %a, l %ap) {\n\1162 \@start\n\1163 \%b =w vaarg %ap\n\1164 \%c =w vaarg %ap\n\1165 \%d =w add %a, %b\n\1166 \%e =w add %d, %c\n\1167 \ret %e\n\1168 \}\n\1169 \function w $main() {\n\1170 \@start\n\1171 \%.1 =w copy 23\n\1172 \%.2 =w copy 42\n\1173 \%.3 =w copy 5\n\1174 \%.4 =w call $add3(w %.1, ..., w %.2, w %.3)\n\1175 \ret %.4\n\1176 \}"11771178 res @?= Just (D.VWord 70),1179 testCase "variable argument list with different argument alignment" $1180 do1181 res <-1182 parseAndExec1183 (QBE.GlobalIdent "varAdd")1184 [D.VWord 0xdeadbeef, D.VLong 0xdecafbaddecafbad, D.VWord 0xffffffff, D.VDouble 23.1337]1185 "function w $varAdd(...) {\n\1186 \@start\n\1187 \%ap =l alloc8 8\n\1188 \vastart %ap\n\1189 \%v.1 =w vaarg %ap\n\1190 \%v.2 =l vaarg %ap\n\1191 \%v.3 =w vaarg %ap\n\1192 \%v.4 =d vaarg %ap\n\1193 \%e.1 =w ceqw %v.1, 3735928559\n\1194 \%e.2 =w ceql %v.2, 16053920545901312941\n\1195 \%e.3 =w ceqw %v.3, 4294967295\n\1196 \%e.4 =w ceqd %v.4, d_23.1337\n\1197 \%r.1 =w and %e.1, %e.2\n\1198 \%r.2 =w and %r.1, %e.3\n\1199 \%r.3 =w and %r.2, %e.4\n\1200 \ret %r.3\n\1201 \}"12021203 res @?= Just (D.VWord 1),1204 testCase "execute vastart twice" $1205 do1206 res <-1207 parseAndExec1208 (QBE.GlobalIdent "varAdd")1209 [D.VWord 0xdeadbeef, D.VLong 0xdecafbaddecafbad, D.VWord 0xffffffff, D.VDouble 23.1337]1210 "function w $varAdd(...) {\n\1211 \@start\n\1212 \%ap =l alloc8 8\n\1213 \vastart %ap\n\1214 \%p.1 =l loadl %ap\n\1215 \vastart %ap\n\1216 \%p.2 =l loadl %ap\n\1217 \%r.p =w cnel %p.1, %p.2\n\1218 \@vaarg\n\1219 \%v.1 =w vaarg %ap\n\1220 \%v.2 =l vaarg %ap\n\1221 \%v.3 =w vaarg %ap\n\1222 \%v.4 =d vaarg %ap\n\1223 \%e.1 =w ceqw %v.1, 3735928559\n\1224 \%e.2 =w ceql %v.2, 16053920545901312941\n\1225 \%e.3 =w ceqw %v.3, 4294967295\n\1226 \%e.4 =w ceqd %v.4, d_23.1337\n\1227 \%r.1 =w and %e.1, %e.2\n\1228 \%r.2 =w and %r.1, %e.3\n\1229 \%r.3 =w and %r.2, %e.4\n\1230 \%r.4 =w and %r.3, %r.p\n\1231 \ret %r.4\n\1232 \}"12331234 res @?= Just (D.VWord 1),1235 testCase "invoke function via function pointer" $1236 do1237 res <-1238 parseAndExec1239 (QBE.GlobalIdent "main")1240 []1241 "function w $add(w %lhs, w %rhs) {\n\1242 \@start\n\1243 \%r =w add %lhs, %rhs\n\1244 \ret %r\n\1245 \}\n\1246 \function w $main() {\n\1247 \@body\n\1248 \%ptr =l copy $add\n\1249 \%res =w call %ptr(w 23, w 42)\n\1250 \ret %res\n\1251 \}"12521253 res @?= Just (D.VWord 65),1254 testCase "__builtin_va from cproc code base" $1255 do1256 res <-1257 parseAndExecFile1258 (QBE.GlobalIdent "main")1259 []1260 "builtin-vaarg-vm.qbe"12611262 res @?= Just (D.VWord 127),1263 testCase "use extern for representing globals" $1264 do1265 res <-1266 parseAndExec1267 (QBE.GlobalIdent "main")1268 []1269 "function w $main() {\n\1270 \@body\n\1271 \%.1 =w loadw extern $x\n\1272 \%.2 =w add %.1, 23\n\1273 \ret %.2\n\1274 \}\n\1275 \export data $x = align 4 { z 4 }\n"12761277 res @?= Just (D.VWord 23)1278 ]12791280simTests :: TestTree1281simTests = testGroup "Tests for the Simulator" [blockTests]