aboutsummaryrefslogtreecommitdiff
path: root/src/Commands.hs
blob: 1413c8780419d93bb950e0f13d12b3f428af0aed (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
module Commands where

import Control.Lens
import Machine

doNothing :: Machine -> Machine
doNothing m = Machine (Registers (pc r + 2) (sr r) (drs r)
                                 (ars r) (usp r) (ssp r))
                      (ram m) (rom m)
    where r = regs m

doUnlink :: Int -> Machine -> Machine
doUnlink 7 m = let r = regs m in if isSupervisor m
    then Machine (Registers (pc r + 2) (sr r) (drs r) (ars r)
                            (usp r) (getLong m (fromIntegral $ ssp r) + 4))
                 (ram m) (rom m)
    else Machine (Registers (pc r + 2) (sr r) (drs r) (ars r)
                            (getLong m (fromIntegral $ usp r) + 4) (ssp r))
                 (ram m) (rom m)
doUnlink a m = let
        r = regs m
        av = getLong m (fromIntegral (ars r !! a))
        newars = ars r & element (fromIntegral a) .~ av
    in if isSupervisor m
    then Machine (Registers (pc r + 2) (sr r) (drs r)
                            newars (usp r) (av + 4))
                 (ram m) (rom m)
    else Machine (Registers (pc r + 2) (sr r) (drs r)
                            newars (av + 4) (ssp r))
                 (ram m) (rom m)