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 Env D.RegVal Word8 ->23 QBE.FuncDef ->24 [D.RegVal] ->25 IO (Either EvalError (Maybe D.RegVal))26parseAndExec'' env func params = do27 try $ run env (execFunc func params)2829parseAndExec' ::30 QBE.GlobalIdent ->31 [D.RegVal] ->32 String ->33 IO (Either EvalError (Maybe D.RegVal))34parseAndExec' funcName params input = do35 (prog, entry) <- parseAndFind funcName input36 env <- mkEnv prog 0 128 False :: IO (Env D.RegVal Word8)37 parseAndExec'' env entry params3839parseAndExec :: QBE.GlobalIdent -> [D.RegVal] -> String -> IO (Maybe D.RegVal)40parseAndExec funcName params input = do41 evalRes <- parseAndExec' funcName params input42 case evalRes of43 Left e -> fail $ "Unexpected evaluation error: " ++ show e44 Right r -> pure r4546readTestFile :: FilePath -> IO String47readTestFile fileName = do48 let filePath = "test" </> "testdata" </> fileName49 readFile filePath5051parseAndExecFile :: QBE.GlobalIdent -> [D.RegVal] -> FilePath -> IO (Maybe D.RegVal)52parseAndExecFile funcName params fileName = do53 input <- readTestFile fileName54 parseAndExec funcName params input5556------------------------------------------------------------------------5758blockTests :: TestTree59blockTests =60 testGroup61 "Evaluation of Basic Blocks"62 [ testCase "Evaluate single basic block with single instruction" $63 do64 res <-65 parseAndExec66 (QBE.GlobalIdent "addNumbers")67 []68 "function w $addNumbers() {\n\69 \@start\n\70 \%c =w add 1, 2\n\71 \ret %c\n\72 \}"7374 res @?= Just (D.VWord 3),75 testCase "Evaluate single basic block with multiple instructions" $76 do77 res <-78 parseAndExec79 (QBE.GlobalIdent "addMultiple")80 []81 "function w $addMultiple() {\n\82 \@begin\n\83 \%val =w add 1, 2\n\84 \%foo =w add %val, 2\n\85 \ret %foo\n\86 \}"8788 res @?= Just (D.VWord 5),89 testCase "Evaluate expression with subtyping" $90 do91 res <-92 -- 16045690984835251117 == 0xdeadbeefdecafbad93 parseAndExec94 (QBE.GlobalIdent "subtyping")95 []96 "function w $subtyping() {\n\97 \@go\n\98 \%val =l add 16045690984835251117, 0\n\99 \%foo =w add %val, 0\n\100 \ret %foo\n\101 \}"102103 res @?= Just (D.VWord 0xdecafbad),104 testCase "Subtyping in function return value" $105 do106 res <-107 -- 16045690984835251117 == 0xdeadbeefdecafbad108 parseAndExec109 (QBE.GlobalIdent "subtyp")110 []111 "function w $subtyp() {\n\112 \@start\n\113 \%v =l add 0, 16045690984835251117\n\114 \ret %v\n\115 \}"116117 res @?= Just (D.VWord 0xdecafbad),118 testCase "Evaluate function without return value" $119 do120 res <-121 parseAndExec122 (QBE.GlobalIdent "noRet")123 []124 "function $noRet() {\n\125 \@start\n\126 \ret\n\127 \}"128129 res @?= Nothing,130 testCase "Evaluate two basic blocks with unconditional jump" $131 do132 res <-133 parseAndExec134 (QBE.GlobalIdent "unconditionalJump")135 []136 "function w $unconditionalJump() {\n\137 \@start\n\138 \%val =w add 0, 1\n\139 \jmp @next\n\140 \@next\n\141 \%val =w add %val, 1\n\142 \ret %val\n\143 \}"144145 res @?= Just (D.VWord 2),146 testCase "Evalute basic blocks with fallthrough jump" $147 do148 res <-149 parseAndExec150 (QBE.GlobalIdent "unconditionalJump")151 []152 "function w $unconditionalJump() {\n\153 \@start\n\154 \%val =w add 0, 1\n\155 \@next\n\156 \%val =w add %val, 1\n\157 \ret %val\n\158 \}"159160 res @?= Just (D.VWord 2),161 testCase "Conditional jump with zero value" $162 do163 res <-164 parseAndExec165 (QBE.GlobalIdent "conditionalJumpTaken")166 []167 "function l $conditionalJumpTaken() {\n\168 \@start\n\169 \%zero =w add 0, 0\n\170 \jnz %zero, @nonZero, @zero\n\171 \@nonZero\n\172 \%val =l add 0, 42\n\173 \ret %val\n\174 \@zero\n\175 \%val =l add 0, 23\n\176 \ret %val\n\177 \}"178179 res @?= Just (D.VLong 23),180 testCase "Conditional jump with non-zero value" $181 do182 res <-183 parseAndExec184 (QBE.GlobalIdent "conditionalJumpTaken")185 []186 "function l $conditionalJumpTaken() {\n\187 \@start\n\188 \%zero =w add 1, 0\n\189 \jnz %zero, @nonZero, @zero\n\190 \@nonZero\n\191 \%val =l add 0, 42\n\192 \ret %val\n\193 \@zero\n\194 \%val =l add 0, 23\n\195 \ret %val\n\196 \}"197198 res @?= Just (D.VLong 42),199 testCase "Execute a function with parameters" $200 do201 res <-202 parseAndExec203 (QBE.GlobalIdent "funcWithParam")204 [D.VWord 41]205 "function w $funcWithParam(w %x) {\n\206 \@go\n\207 \%y =w add 1, %x\n\208 \ret %y\n\209 \}"210211 res @?= Just (D.VWord 42),212 testCase "Function call instruction without return value" $213 do214 res <-215 parseAndExec216 (QBE.GlobalIdent "main")217 []218 "function $foo(w %x) {\n\219 \@start\n\220 \%y =w sub 42, 0\n\221 \ret\n\222 \}\n\223 \function w $main() {\n\224 \@start\n\225 \%y =w sub 0, 0\n\226 \call $foo(w %y)\n\227 \ret %y\n\228 \}"229230 res @?= Just (D.VWord 0),231 testCase "Function call with return value" $232 do233 res <-234 parseAndExec235 (QBE.GlobalIdent "main")236 []237 "function w $foo(w %x) {\n\238 \@start\n\239 \%y =w sub %x, 19\n\240 \ret %y\n\241 \}\n\242 \function w $main() {\n\243 \@start\n\244 \%x =w add 0, 42\n\245 \%ret =w call $foo(w %x)\n\246 \ret %ret\n\247 \}"248249 res @?= Just (D.VWord 23),250 testCase "Allocate, store and load value in memory" $251 do252 res <-253 parseAndExec254 (QBE.GlobalIdent "allocate")255 []256 "function w $allocate() {\n\257 \@start\n\258 \%addr =l alloc4 4\n\259 \storew 2342, %addr\n\260 \%v =w loadw %addr\n\261 \ret %v\n\262 \}"263264 res @?= Just (D.VWord 2342),265 testCase "Load with sub word type" $266 do267 res <-268 parseAndExec269 (QBE.GlobalIdent "allocate")270 []271 "function w $allocate() {\n\272 \@start\n\273 \%addr =l alloc4 4\n\274 \storeb 249, %addr\n\275 \%v =w loadsb %addr\n\276 \ret %v\n\277 \}"278279 -- 249 (0xf9) sign extended to 32-bit.280 res @?= Just (D.VWord 0xfffffff9),281 testCase "Store subword in memory" $282 do283 res <-284 -- 2863311530 == 0xaaaaaaaa285 parseAndExec286 (QBE.GlobalIdent "storeByte")287 []288 "function w $storeByte() {\n\289 \@start\n\290 \%addr =l alloc4 4\n\291 \storew 2863311530, %addr\n\292 \storeb 255, %addr\n\293 \%v =w loadw %addr\n\294 \ret %v\n\295 \}"296297 res @?= Just (D.VWord 0xaaaaaaff),298 testCase "Function with user-defined type as function parameter" $299 do300 res <-301 parseAndExec302 (QBE.GlobalIdent "main")303 []304 "type :one = { w }\n\305 \function w $getone(:one %ptr) {\n\306 \@start\n\307 \%val =w loadw %ptr\n\308 \ret %val\n\309 \}\n\310 \function w $main() {\n\311 \@entry\n\312 \%addr =l alloc4 4\n\313 \storew 3735928559, %addr\n\314 \%ret =w call $getone(l %addr)\n\315 \ret %ret\n\316 \}"317318 res @?= Just (D.VWord 0xdeadbeef),319 testCase "Pointer arithmetic on user-defined type" $320 do321 res <-322 parseAndExec323 (QBE.GlobalIdent "main")324 []325 "type :abyteandmanywords = { w, b 100 }\n\326 \function w $main() {\n\327 \@start.1\n\328 \%addr.0 =l alloc4 104\n\329 \%addr.1 =l add %addr.0, 4\n\330 \storeb 255, %addr.1\n\331 \%addr.2 =l sub %addr.1, 4\n\332 \storew 3735928304, %addr.2\n\333 \%word =w loaduw %addr.0\n\334 \%byte =w loadub %addr.1\n\335 \%res =w add %word, %byte\n\336 \ret %res\n\337 \}"338339 res @?= Just (D.VWord 0xdeadbeef),340 testCase "Subtyping with subword function parameters" $341 do342 res <-343 parseAndExec'344 (QBE.GlobalIdent "subword")345 [D.VWord 0xff]346 "function $subword(ub %val) {\n\347 \@start\n\348 \%val =w add %val, 1\n\349 \ret\n\350 \}"351352 res @?= Right Nothing,353 testCase "Jump to unknown block within function" $354 do355 res <-356 parseAndExec'357 (QBE.GlobalIdent "main")358 []359 "function $main() {\n\360 \@start\n\361 \jmp @foo\n\362 \@bar\n\363 \ret\n\364 \}"365366 res @?= Left (UnknownBlock $ QBE.BlockIdent "foo"),367 testCase "Call undefined function" $368 do369 res <-370 parseAndExec'371 (QBE.GlobalIdent "main")372 []373 "function $main() {\n\374 \@start\n\375 \call $bar()\n\376 \ret\n\377 \}"378379 res @?= Left (UnknownFunction $ QBE.GlobalIdent "bar"),380 testCase "Arithmetic with single-precision float" $381 do382 res <-383 parseAndExec384 (QBE.GlobalIdent "addFloats")385 [D.VSingle 2.0, D.VSingle 0.3]386 "function s $addFloats(s %f1, s %f2) {\n\387 \@start\n\388 \%val =s add %f1, %f2\n\389 \ret %val\n\390 \}"391392 res @?= Just (D.VSingle 2.3),393 testCase "Arithmetic with double-precision float" $394 do395 res <-396 parseAndExec397 (QBE.GlobalIdent "addFloats")398 [D.VDouble 2.0, D.VDouble 0.3]399 "function d $addFloats(d %f1, d %f2) {\n\400 \@start\n\401 \%val =d add %f1, %f2\n\402 \ret %val\n\403 \}"404405 res @?= Just (D.VDouble 2.3),406 testCase "Arithmetic with float literal" $407 do408 res1 <-409 parseAndExec410 (QBE.GlobalIdent "addFloatAndLit")411 [D.VSingle 4.2]412 "function s $addFloatAndLit(s %f) {\n\413 \@start\n\414 \%v =s add %f, 1\n\415 \ret %v\n\416 \}"417418 -- This returns 4.2, not 5.2 because the 1 is interpreted419 -- as a bitwise representation of an IEEE floating point.420 --421 -- QBE itself also treats it in this way.422 res1 @?= Just (D.VSingle 4.2)423424 -- The following works because it uses the single literal.425 res2 <-426 parseAndExec427 (QBE.GlobalIdent "addFloatAndLit")428 [D.VSingle 4.2]429 "function s $addFloatAndLit(s %f) {\n\430 \@start\n\431 \%v =s add %f, s_1.0\n\432 \ret %v\n\433 \}"434435 res2 @?= Just (D.VSingle 5.2),436 testCase "Invalid mixed float arithmetic" $437 do438 res <-439 parseAndExec'440 (QBE.GlobalIdent "addFloatAndLong")441 [D.VSingle 4.2, D.VLong 42]442 "function s $addFloatAndLong(s %f, l %l) {\n\443 \@start\n\444 \%v =s add %f, %l\n\445 \ret %v\n\446 \}"447448 res @?= Left TypingError,449 testCase "Store float in memory and load it again" $450 do451 res <-452 parseAndExec453 (QBE.GlobalIdent "storeAndLoadFloat")454 [D.VSingle 0.333333333]455 "function s $storeAndLoadFloat(s %f) {\n\456 \@start.1\n\457 \%addr =l alloc4 4\n\458 \stores %f, %addr\n\459 \%loaded =s loads %addr\n\460 \ret %loaded\n\461 \}"462463 res @?= Just (D.VSingle 0.333333333),464 testCase "Store double in memory and load it again" $465 do466 res <-467 parseAndExec468 (QBE.GlobalIdent "storeAndLoadDouble")469 [D.VDouble 0.3333333331111]470 "function d $storeAndLoadDouble(d %f) {\n\471 \@start.1\n\472 \%addr =l alloc4 8\n\473 \stored %f, %addr\n\474 \%loaded =d loadd %addr\n\475 \ret %loaded\n\476 \}"477478 res @?= Just (D.VDouble 0.3333333331111),479 testCase "Load data object from memory" $480 do481 res <-482 parseAndExec483 (QBE.GlobalIdent "main")484 []485 "data $a = { b \"ABCD\" }\n\486 \function w $main() {\n\487 \@start\n\488 \%w =w loadw $a\n\489 \ret %w\n\490 \}"491492 res @?= Just (D.VWord 0x44434241),493 testCase "Data definition with symbol reference" $494 do495 res <-496 parseAndExec497 (QBE.GlobalIdent "main")498 []499 "data $a = { b \"ABCD\" }\n\500 \data $p = { l $a }\n\501 \function w $main() {\n\502 \@start\n\503 \%ptr =l loadl $p\n\504 \%res =w loadw %ptr\n\505 \ret %res\n\506 \}"507508 res @?= Just (D.VWord 0x44434241),509 testCase "Data definition with symbol offset" $510 do511 res <-512 parseAndExec513 (QBE.GlobalIdent "main")514 []515 "data $a = align 1 { b \"ABCDE\" }\n\516 \data $p = align 8 { l $a + 1 }\n\517 \function w $main() {\n\518 \@start\n\519 \%ptr =l loadl $p\n\520 \%res =w loadw %ptr\n\521 \ret %res\n\522 \}"523524 res @?= Just (D.VWord 0x45444342),525 testCase "Data definition with constant number" $526 do527 res <-528 parseAndExec529 (QBE.GlobalIdent "main")530 []531 "data $a = align 4 { l 42 }\n\532 \function l $main() {\n\533 \@start\n\534 \%l =l loadl $a\n\535 \ret %l\n\536 \}"537538 res @?= Just (D.VLong 42),539 testCase "Data definition with multiple fields" $540 do541 res <-542 parseAndExec543 (QBE.GlobalIdent "main")544 []545 "data $a = align 1 { b \"ABCD\", w 42 }\n\546 \data $p = align 8 { l $a + 4 }\n\547 \function w $main() {\n\548 \@start\n\549 \%ptr =l loadl $p\n\550 \%res =w loadw %ptr\n\551 \ret %res\n\552 \}"553554 res @?= Just (D.VWord 42),555 testCase "Data definition with zero fill" $556 do557 res <-558 parseAndExec559 (QBE.GlobalIdent "main")560 []561 "data $a = align 1 { w 4294967295, z 4, w 4294967295 }\n\562 \data $p = align 8 { l $a }\n\563 \function w $main() {\n\564 \@start\n\565 \%ptr =l loadl $p\n\566 \%ptr =l add %ptr, 4\n\567 \%res =w loadw %ptr\n\568 \ret %res\n\569 \}"570571 res @?= Just (D.VWord 0),572 testCase "Data definition with single" $573 do574 res <-575 parseAndExec576 (QBE.GlobalIdent "main")577 []578 "data $a = align 1 { s s_2.3, s s_4.2 }\n\579 \data $p = align 8 { l $a }\n\580 \function s $main() {\n\581 \@start\n\582 \%ptr.1 =l loadl $p\n\583 \%ptr.2 =l add %ptr.1, 4\n\584 \%val.1 =s loads %ptr.1\n\585 \%val.2 =s loads %ptr.2\n\586 \%res =s add %val.1, %val.2\n\587 \ret %res\n\588 \}"589 res @?= Just (D.VSingle $ 2.3 + 4.2),590 testCase "Recursive data definition" $591 do592 res <-593 parseAndExec594 (QBE.GlobalIdent "main")595 []596 "data $c = { l -1, l $c }\n\597 \function w $main() {\n\598 \@start\n\599 \%ptr.1 =l add $c, 0\n\600 \%ptr.2 =l add $c, 8\n\601 \%field =l loadl %ptr.2\n\602 \%ptrEq =w ceql %field, %ptr.1\n\603 \ret %ptrEq\n\604 \}"605606 res @?= Just (D.VWord 1),607 testCase "Data definition with maximum struct member alignment" $608 do609 res <-610 -- The maximum alignment of a struct member for the struct611 -- referenced by `$ptr` is 8 (the long member). Therefore,612 -- the struct must be allocated on a 8-Byte-aligned address.613 parseAndExec614 (QBE.GlobalIdent "main")615 []616 "data $fill = { w 0 }\n\617 \data $ptr = { b 255, w 2342, l 1337, b 255 }\n\618 \function w $main() {\n\619 \@start\n\620 \%p =l urem $ptr, 8\n\621 \%correctAlign =w ceql %p, 0\n\622 \ret %correctAlign\n\623 \}"624625 res @?= Just (D.VWord 1),626 testCase "Data definition with forward reference to other definition" $627 do628 res <-629 parseAndExec630 (QBE.GlobalIdent "main")631 []632 "data $a = { l $b }\n\633 \data $b = { b 0 }\n\634 \function w $main() {\n\635 \@start\n\636 \%isGt =w cugtl $a, $b\n\637 \%ptrB =l loadl $a\n\638 \%isEq =w ceql %ptrB, $b\n\639 \%ret =w and %isEq, %isGt\n\640 \ret %ret\n\641 \}"642643 res @?= Just (D.VWord 1),644 testCase "Access memory of data definition with forward reference" $645 do646 res <-647 parseAndExec648 (QBE.GlobalIdent "main")649 []650 "data $a = { l $b }\n\651 \data $b = { b 99 }\n\652 \function w $main() {\n\653 \@start\n\654 \%pb =l loadl $a\n\655 \%vb =w loadub %pb\n\656 \%rt =w extub %vb\n\657 \ret %rt\n\658 \}"659660 res @?= Just (D.VWord 99),661 testCase "Subtyping with load instruction" $662 do663 res <-664 -- 16045690984835251117 == 0xdeadbeefdecafbad665 parseAndExec666 (QBE.GlobalIdent "allocate")667 []668 "function w $allocate() {\n\669 \@start\n\670 \%addr =l alloc4 4\n\671 \storel 16045690984835251117, %addr\n\672 \%v =w loadl %addr\n\673 \ret %v\n\674 \}"675676 res @?= Just (D.VWord 0xdecafbad),677 testCase "Subtyped branch condition" $678 do679 res <-680 parseAndExec681 (QBE.GlobalIdent "condJump")682 []683 "function w $condJump() {\n\684 \@start\n\685 \%zero =l add 0, 0\n\686 \jnz %zero, @nonZero, @zero\n\687 \@nonZero\n\688 \%val =w add 0, 42\n\689 \ret %val\n\690 \@zero\n\691 \%val =w add 0, 23\n\692 \ret %val\n\693 \}"694695 res @?= Just (D.VWord 23),696 testCase "Multiple jumps" $697 do698 res <-699 parseAndExec700 (QBE.GlobalIdent "branchOnInput")701 [D.VWord 0, D.VWord 0]702 "function w $branchOnInput(w %cond1, w %cond2) {\n\703 \@jump.1\n\704 \jnz %cond1, @branch.1, @branch.2\n\705 \@branch.1\n\706 \jmp @jump.2\n\707 \@branch.2\n\708 \jmp @jump.2\n\709 \@jump.2\n\710 \jnz %cond2, @branch.3, @branch.4\n\711 \@branch.3\n\712 \ret 3\n\713 \@branch.4\n\714 \ret 4\n\715 \}"716717 res @?= Just (D.VWord 4),718 testCase "Blit instruction w/o overlaps" $719 do720 res <-721 parseAndExec722 (QBE.GlobalIdent "main")723 [D.VWord 0xdeadbeef]724 "function w $main(w %word) {\n\725 \@start\n\726 \%src =l alloc4 4\n\727 \%dst =l alloc4 4\n\728 \storew %word, %src\n\729 \blit %src, %dst, 4\n\730 \%ret =w loadw %dst\n\731 \ret %ret\n\732 \}"733734 res @?= Just (D.VWord 0xdeadbeef),735 testCase "Blit instruction with no bytes to copy" $736 do737 res <-738 parseAndExec739 (QBE.GlobalIdent "main")740 [D.VWord 0xdeadbeef]741 "function w $main(w %word) {\n\742 \@start\n\743 \%src =l alloc4 4\n\744 \%dst =l alloc4 4\n\745 \storew %word, %src\n\746 \storew 42, %dst\n\747 \blit %src, %dst, 0\n\748 \%ret =w loadw %dst\n\749 \ret %ret\n\750 \}"751752 res @?= Just (D.VWord 42),753 testCase "Comparision instruction" $754 do755 let prog =756 "function w $main(w %lhs, w %rhs) {\n\757 \@start\n\758 \%r =w csltw %lhs, %rhs\n\759 \ret %r\n\760 \}"761762 resLarger <-763 parseAndExec764 (QBE.GlobalIdent "main")765 [D.VWord 0, D.VWord 1]766 prog767 resLarger @?= Just (D.VWord 1)768769 resSmaller <-770 parseAndExec771 (QBE.GlobalIdent "main")772 [D.VWord 1, D.VWord 0]773 prog774 resSmaller @?= Just (D.VWord 0),775 testCase "Compare with subtyping" $776 do777 res <-778 parseAndExec779 (QBE.GlobalIdent "main")780 [D.VWord 1, D.VLong 0]781 "function w $main(w %lhs, l %rhs) {\n\782 \@start\n\783 \%r =w csltw %lhs, %rhs\n\784 \ret %r\n\785 \}"786787 res @?= Just (D.VWord 0),788 testCase "Compare with long exceeding 32-bit" $789 do790 res <-791 parseAndExec792 (QBE.GlobalIdent "main")793 []794 "function w $main() {\n\795 \@start\n\796 \%r =w cultl 4294967296, 20\n\797 \ret %r\n\798 \}"799800 res @?= Just (D.VWord 0),801 testCase "Phi instruction" $802 do803 res <-804 parseAndExec805 (QBE.GlobalIdent "f")806 []807 "function w $f() {\n\808 \@begin\n\809 \jmp @start2\n\810 \@start1\n\811 \jmp @phi\n\812 \@start2\n\813 \jmp @phi\n\814 \@phi\n\815 \%v =w phi @start1 23, @start2 42\n\816 \ret %v\n\817 \}"818819 res @?= Just (D.VWord 42),820 testCase "Sign extend subword" $821 do822 res <-823 parseAndExec824 (QBE.GlobalIdent "ext")825 [D.VWord 128]826 "function w $ext(w %word) {\n\827 \@start\n\828 \%r =w extsb %word\n\829 \ret %r\n\830 \}"831832 res @?= Just (D.VWord 0xffffff80),833 testCase "Zero extend subword" $834 do835 res <-836 parseAndExec837 (QBE.GlobalIdent "ext")838 [D.VWord 128]839 "function w $ext(w %word) {\n\840 \@start\n\841 \%r =w extub %word\n\842 \ret %r\n\843 \}"844845 res @?= Just (D.VWord 0x00000080),846 testCase "Shift instructions" $847 do848 res <-849 parseAndExec850 (QBE.GlobalIdent "shift")851 [D.VWord 0xdeadbeef]852 "function w $shift(w %word) {\n\853 \@start\n\854 \%r =w shr 3735928559, 4\n\855 \%r =w shl %r, 4\n\856 \ret %r\n\857 \}"858859 res @?= Just (D.VWord 0xdeadbee0),860 testCase "Shift with long amount" $861 do862 res <-863 parseAndExec864 (QBE.GlobalIdent "shift")865 []866 "function l $shift() {\n\867 \@start\n\868 \%r =l shl 2, 4294967300\n\869 \ret %r\n\870 \}"871872 -- 4294967300 overflows to 4 so this is: 2 << 4.873 res @?= Just (D.VLong 32),874 testCase "Div instruction with single" $875 do876 res <-877 parseAndExec878 (QBE.GlobalIdent "div")879 []880 "function s $div() {\n\881 \@start\n\882 \%r =s div s_5.0, s_2.0\n\883 \ret %r\n\884 \}"885886 res @?= Just (D.VSingle 2.5),887 testCase "Div instruction with double" $888 do889 res <-890 parseAndExec891 (QBE.GlobalIdent "div")892 []893 "function d $div() {\n\894 \@start\n\895 \%r =d div d_5.0, d_2.0\n\896 \ret %r\n\897 \}"898899 res @?= Just (D.VDouble 2.5),900 testCase "Div instruction with word" $901 do902 res <-903 parseAndExec904 (QBE.GlobalIdent "div")905 []906 "function w $div() {\n\907 \@start\n\908 \%r =w div 5, 2\n\909 \ret %r\n\910 \}"911912 res @?= Just (D.VWord 2),913 testCase "Copy instruction with subtyping" $914 do915 res <-916 parseAndExec917 (QBE.GlobalIdent "main")918 []919 "function w $main() {\n\920 \@start\n\921 \%l =l copy 42\n\922 \%w =w copy %l\n\923 \ret %w\n\924 \}"925926 res @?= Just (D.VWord 42),927 testCase "Cast from single to word" $928 do929 res <-930 parseAndExec931 (QBE.GlobalIdent "main")932 []933 "function w $main() {\n\934 \@start\n\935 \%s =s add s_0.0, s_4.2\n\936 \%w =w cast %s\n\937 \ret %w\n\938 \}"939940 let ftow = castFloatToWord32 4.2941 res @?= Just (D.VWord ftow),942 testCase "Cast from double to long" $943 do944 res <-945 parseAndExec946 (QBE.GlobalIdent "main")947 []948 "function l $main() {\n\949 \@start\n\950 \%d =d add d_0.0, d_4.2\n\951 \%l =l cast %d\n\952 \ret %l\n\953 \}"954955 let dtol = castDoubleToWord64 4.2956 res @?= Just (D.VLong dtol),957 testCase "Cast from word to single" $958 do959 let ftow = castFloatToWord32 4.2960 res <-961 parseAndExec962 (QBE.GlobalIdent "cast")963 [D.VWord ftow]964 "function s $cast(w %w) {\n\965 \@start\n\966 \%s =s cast %w\n\967 \ret %s\n\968 \}"969970 res @?= Just (D.VSingle 4.2),971 testCase "Cast from long to double" $972 do973 let dtol = castDoubleToWord64 4.2342974 res <-975 parseAndExec976 (QBE.GlobalIdent "cast")977 [D.VLong dtol]978 "function d $cast(l %l) {\n\979 \@start\n\980 \%d =d cast %l\n\981 \ret %d\n\982 \}"983984 res @?= Just (D.VDouble 4.2342),985 testCase "Trunc double to single" $986 do987 let f = 4.293170199018932489308403284024098032988 res <-989 parseAndExec990 (QBE.GlobalIdent "trunc")991 [D.VDouble f]992 "function s $trunc(d %d) {\n\993 \@start\n\994 \%s =s truncd %d\n\995 \ret %s\n\996 \}"997998 let d2f = D.VSingle $ double2Float f999 res @?= Just d2f,1000 testCase "Extend float to double" $1001 do1002 let f = 23.421003 res <-1004 parseAndExec1005 (QBE.GlobalIdent "ext")1006 [D.VSingle f]1007 "function d $ext(s %s) {\n\1008 \@start\n\1009 \%d =d exts %s\n\1010 \ret %d\n\1011 \}"10121013 let f2d = D.VDouble $ float2Double f1014 res @?= Just f2d,1015 testCase "Invalid exts" $1016 do1017 res <-1018 parseAndExec'1019 (QBE.GlobalIdent "ext")1020 [D.VSingle 23.42]1021 "function s $ext(s %s) {\n\1022 \@start\n\1023 \%s =s exts %s\n\1024 \ret %s\n\1025 \}"10261027 res @?= Left TypingError,1028 testCase "Convert single to unsigned long" $1029 do1030 let f = 4.21031 res <-1032 parseAndExec1033 (QBE.GlobalIdent "fcon")1034 [D.VSingle f]1035 "function l $fcon(s %s) {\n\1036 \@start\n\1037 \%ret =l stoui %s\n\1038 \ret %ret\n\1039 \}"10401041 res @?= Just (D.VLong 4),1042 testCase "Convert single to signed word" $1043 do1044 let f = -3.991045 res <-1046 parseAndExec1047 (QBE.GlobalIdent "fcon")1048 [D.VSingle f]1049 "function w $fcon(s %s) {\n\1050 \@start\n\1051 \%ret =w stosi %s\n\1052 \ret %ret\n\1053 \}"10541055 res @?= Just (D.VWord $ fromIntegral (-3 :: Int32)),1056 testCase "Convert double to unsigned int" $1057 do1058 let f = 4.91059 res <-1060 parseAndExec1061 (QBE.GlobalIdent "fcon")1062 [D.VDouble f]1063 "function l $fcon(d %d) {\n\1064 \@start\n\1065 \%ret =l dtoui %d\n\1066 \ret %ret\n\1067 \}"10681069 res @?= Just (D.VLong 4),1070 testCase "Compare double to NaN" $1071 do1072 let exec lhs rhs =1073 parseAndExec1074 (QBE.GlobalIdent "isNaN")1075 [D.VDouble lhs, D.VDouble rhs]1076 "function w $isNaN(d %lhs, d %rhs) {\n\1077 \@start\n\1078 \%ret =w cod %lhs, %rhs\n\1079 \ret %ret\n\1080 \}"10811082 res0 <- exec 0 01083 res0 @?= Just (D.VWord 1)10841085 res1 <- exec 0 (read "NaN")1086 res1 @?= Just (D.VWord 0)10871088 res2 <- exec (read "NaN") 01089 res2 @?= Just (D.VWord 0),1090 testCase "Compare single equality" $1091 do1092 let exec lhs rhs =1093 parseAndExec1094 (QBE.GlobalIdent "eq")1095 [D.VSingle lhs, D.VSingle rhs]1096 "function w $eq(s %lhs, s %rhs) {\n\1097 \@start\n\1098 \%ret =w ceqs %lhs, %rhs\n\1099 \ret %ret\n\1100 \}"11011102 res0 <- exec 0 01103 res0 @?= Just (D.VWord 1)11041105 res1 <- exec 0 23.421106 res1 @?= Just (D.VWord 0)11071108 res2 <- exec 42.1 01109 res2 @?= Just (D.VWord 0)11101111 res3 <- exec 42.2323 42.23231112 res3 @?= Just (D.VWord 1),1113 testCase "phi instruction in second block" $1114 do1115 res <-1116 parseAndExec1117 (QBE.GlobalIdent "main")1118 []1119 "function w $main() {\n\1120 \@start.1\n\1121 \%.0 =w copy 42\n\1122 \@body.2\n\1123 \%.1 =w phi @start.1 1, @body.2 2\n\1124 \ret %.1\n\1125 \}"11261127 res @?= Just (D.VWord 1),1128 testCase "variable argument list with single argument" $1129 do1130 res <-1131 parseAndExec1132 (QBE.GlobalIdent "varAdd1")1133 [D.VWord 1, D.VWord 2]1134 "function w $varAdd1(w %a, ...) {\n\1135 \@start\n\1136 \%ap =l alloc8 24\n\1137 \vastart %ap\n\1138 \%b =w vaarg %ap\n\1139 \%c =w add %a, %b\n\1140 \ret %c\n\1141 \}"11421143 res @?= Just (D.VWord 3),1144 testCase "variable argument list with no variable argument" $1145 do1146 res <-1147 parseAndExec1148 (QBE.GlobalIdent "varAdd1")1149 [D.VWord 1, D.VWord 2, D.VWord 2342]1150 "function w $varAdd1(w %a, ...) {\n\1151 \@start\n\1152 \%ap =l alloc8 24\n\1153 \vastart %ap\n\1154 \ret 0\n\1155 \}"11561157 res @?= Just (D.VWord 0),1158 testCase "passing pointer to variable argument list" $1159 do1160 -- Example from https://c9x.me/compile/doc/il-v1.2.html#Variadic1161 res <-1162 parseAndExec1163 (QBE.GlobalIdent "main")1164 []1165 "function w $add3(w %a, ...) {\n\1166 \@start\n\1167 \%ap =l alloc8 32\n\1168 \vastart %ap\n\1169 \%r =w call $vadd(w %a, l %ap)\n\1170 \ret %r\n\1171 \}\n\1172 \function w $vadd(w %a, l %ap) {\n\1173 \@start\n\1174 \%b =w vaarg %ap\n\1175 \%c =w vaarg %ap\n\1176 \%d =w add %a, %b\n\1177 \%e =w add %d, %c\n\1178 \ret %e\n\1179 \}\n\1180 \function w $main() {\n\1181 \@start\n\1182 \%.1 =w copy 23\n\1183 \%.2 =w copy 42\n\1184 \%.3 =w copy 5\n\1185 \%.4 =w call $add3(w %.1, ..., w %.2, w %.3)\n\1186 \ret %.4\n\1187 \}"11881189 res @?= Just (D.VWord 70),1190 testCase "variable argument list with different argument alignment" $1191 do1192 res <-1193 parseAndExec1194 (QBE.GlobalIdent "varAdd")1195 [D.VWord 0xdeadbeef, D.VLong 0xdecafbaddecafbad, D.VWord 0xffffffff, D.VDouble 23.1337]1196 "function w $varAdd(...) {\n\1197 \@start\n\1198 \%ap =l alloc8 24\n\1199 \vastart %ap\n\1200 \%v.1 =w vaarg %ap\n\1201 \%v.2 =l vaarg %ap\n\1202 \%v.3 =w vaarg %ap\n\1203 \%v.4 =d vaarg %ap\n\1204 \%e.1 =w ceqw %v.1, 3735928559\n\1205 \%e.2 =w ceql %v.2, 16053920545901312941\n\1206 \%e.3 =w ceqw %v.3, 4294967295\n\1207 \%e.4 =w ceqd %v.4, d_23.1337\n\1208 \%r.1 =w and %e.1, %e.2\n\1209 \%r.2 =w and %r.1, %e.3\n\1210 \%r.3 =w and %r.2, %e.4\n\1211 \ret %r.3\n\1212 \}"12131214 res @?= Just (D.VWord 1),1215 testCase "execute vastart twice" $1216 do1217 res <-1218 parseAndExec1219 (QBE.GlobalIdent "varAdd")1220 [D.VWord 0xdeadbeef, D.VLong 0xdecafbaddecafbad, D.VWord 0xffffffff, D.VDouble 23.1337]1221 "function w $varAdd(...) {\n\1222 \@start\n\1223 \%ap =l alloc8 24\n\1224 \vastart %ap\n\1225 \%t.1 =l add %ap, 8\n\1226 \%p.1 =l loadl %t.1\n\1227 \vastart %ap\n\1228 \%t.2 =l add %ap, 8\n\1229 \%p.2 =l loadl %t.2\n\1230 \%r.p =w cnel %p.1, %p.2\n\1231 \@vaarg\n\1232 \%v.1 =w vaarg %ap\n\1233 \%v.2 =l vaarg %ap\n\1234 \%v.3 =w vaarg %ap\n\1235 \%v.4 =d vaarg %ap\n\1236 \%e.1 =w ceqw %v.1, 3735928559\n\1237 \%e.2 =w ceql %v.2, 16053920545901312941\n\1238 \%e.3 =w ceqw %v.3, 4294967295\n\1239 \%e.4 =w ceqd %v.4, d_23.1337\n\1240 \%r.1 =w and %e.1, %e.2\n\1241 \%r.2 =w and %r.1, %e.3\n\1242 \%r.3 =w and %r.2, %e.4\n\1243 \%r.4 =w and %r.3, %r.p\n\1244 \ret %r.4\n\1245 \}"12461247 res @?= Just (D.VWord 1),1248 testCase "va_copy" $1249 do1250 res <-1251 parseAndExecFile1252 (QBE.GlobalIdent "main")1253 []1254 "va-copy.qbe"12551256 res @?= Just (D.VWord 100),1257 testCase "va_copy with no vaargs" $1258 do1259 res <-1260 parseAndExecFile1261 (QBE.GlobalIdent "main")1262 []1263 "va-copy-empty.qbe"12641265 res @?= Just (D.VWord 0),1266 testCase "invoke function via function pointer" $1267 do1268 res <-1269 parseAndExec1270 (QBE.GlobalIdent "main")1271 []1272 "function w $add(w %lhs, w %rhs) {\n\1273 \@start\n\1274 \%r =w add %lhs, %rhs\n\1275 \ret %r\n\1276 \}\n\1277 \function w $main() {\n\1278 \@body\n\1279 \%ptr =l copy $add\n\1280 \%res =w call %ptr(w 23, w 42)\n\1281 \ret %res\n\1282 \}"12831284 res @?= Just (D.VWord 65),1285 testCase "__builtin_va from cproc code base" $1286 do1287 res <-1288 parseAndExecFile1289 (QBE.GlobalIdent "main")1290 []1291 "builtin-vaarg-vm.qbe"12921293 res @?= Just (D.VWord 127),1294 testCase "use extern for representing globals" $1295 do1296 res <-1297 parseAndExec1298 (QBE.GlobalIdent "main")1299 []1300 "function w $main() {\n\1301 \@body\n\1302 \%.1 =w loadw extern $x\n\1303 \%.2 =w add %.1, 23\n\1304 \ret %.2\n\1305 \}\n\1306 \export data $x = align 4 { z 4 }\n"13071308 res @?= Just (D.VWord 23),1309 testCase "copy struct with padding bytes" $1310 do1311 qbeInput <- readTestFile "blit-padded-struct.qbe"1312 (prog, entry) <- parseAndFind (QBE.GlobalIdent "main") qbeInput13131314 -- For this test to pass, we need to zero-initialize the memory.1315 env <- mkEnv prog 0 128 True :: IO (Env D.RegVal Word8)1316 res <- parseAndExec'' env entry []13171318 res @?= Right (Just (D.VWord 23))1319 ]13201321simTests :: TestTree1322simTests = testGroup "Tests for the Simulator" [blockTests]