diff --git a/src/Lib.hs b/src/Lib.hs index d21d954..d6a68be 100644 --- a/src/Lib.hs +++ b/src/Lib.hs @@ -95,9 +95,11 @@ ubcOpcodeReg2Mem = 0x05000000 ubcOpcodeJumpRel :: Word.Word32 ubcOpcodeJumpRel = 0x09000000 +ubcOpcodeRelJumpi :: Word.Word32 +ubcOpcodeRelJumpi = 0x19000000 -ubcOpcodeForeignCall :: Word.Word32 -ubcOpcodeForeignCall = 0x0F000000 +ubcOpcodeForeignCalli :: Word.Word32 +ubcOpcodeForeignCalli = 0x1F000000 ubcOpcodeAddU :: Word.Word32 ubcOpcodeAddU = 0x80000000 @@ -111,8 +113,13 @@ ubcConditionNone = 0x00000000 ubcConditionEq :: Word.Word32 ubcConditionEq = 0x00800000 -ubcForeignCall :: Int32 -> Word.Word32 -ubcForeignCall r = ubcOpcodeForeignCall .|. ubcInstructionRegArg1 r +maxPayload20 :: Int32 +maxPayload20 = 2^(19 :: Int32) + +ubcForeignCalli :: Int32 -> Word.Word32 +ubcForeignCalli i + | i > maxPayload20 = error "Foreign call index too big" + | otherwise = ubcOpcodeForeignCalli .|. (fromIntegral i) ubcInstructionRegArg1 :: Int32 -> Word.Word32 ubcInstructionRegArg1 r @@ -148,8 +155,15 @@ ubcLoadIntWords i r = [ubcLoadUpper (fromIntegral u) r, ubcLoadLower (fromIntegr ubcCmpU :: Int32 -> Int32 -> Word.Word32 ubcCmpU a b = ubcOpcodeCmpU .|. ubcInstructionRegArg1 a .|. ubcInstructionRegArg2 b +signedPayLoad20 :: Int32 -> Word.Word32 +signedPayLoad20 i = (iw .&. 0x7FFFF) .|. (if (i < 0) then 0x80000 else 0) + where + iw = fromIntegral (abs i) :: Word.Word32 + ubcJumpRel :: Int32 -> Int32 -> Word.Word32 -> [Word.Word32] -ubcJumpRel d r c = ubcLoadIntWords d r ++ [ubcOpcodeJumpRel .|. ubcInstructionRegArg1 r .|. c] +ubcJumpRel d r c + | d < maxPayload20 = [ubcOpcodeRelJumpi .|. (signedPayLoad20 d) .|. c] + | otherwise = ubcLoadIntWords d r ++ [ubcOpcodeJumpRel .|. ubcInstructionRegArg1 r .|. c] ubcLoadCellWord :: Int32 -> Word.Word32 ubcLoadCellWord r = ubcOpcodeMem2Reg .|. ubcConditionNone .|. ubcInstructionRegArg1 r .|. ubcInstructionRegArg2 0 @@ -179,17 +193,17 @@ compileIncrement state i os compileDecrement :: CompileState -> Int32 -> [BrainFuckOperation] -> [Word.Word32] compileDecrement state i os | isCellLoaded state = ubcDecrementRegisterWords i 2 1 ++ compile' (state{isCellModified=True}) os - | otherwise = ubcLoadCellWord 1 : compileIncrement (state{isCellLoaded=True}) i os + | otherwise = ubcLoadCellWord 1 : compileDecrement (state{isCellLoaded=True}) i os compileMoveLeft :: CompileState -> Int32 -> [BrainFuckOperation] -> [Word.Word32] compileMoveLeft state d os | isCellModified state = ubcStoreCellWord 1 : compileMoveLeft (state{isCellModified=False}) d os - | otherwise = ubcDecrementRegisterWords d 2 0 ++ compile' (state{isCellLoaded=False}) os + | otherwise = ubcDecrementRegisterWords (d*4) 2 0 ++ compile' (state{isCellLoaded=False}) os compileMoveRight :: CompileState -> Int32 -> [BrainFuckOperation] -> [Word.Word32] compileMoveRight state d os | isCellModified state = ubcStoreCellWord 1 : compileMoveLeft (state{isCellModified=False}) d os - | otherwise = ubcIncrementRegisterWords d 2 0 ++ compile' (state{isCellLoaded=False}) os + | otherwise = ubcIncrementRegisterWords (d*4) 2 0 ++ compile' (state{isCellLoaded=False}) os compileConditionally :: CompileState -> [BrainFuckOperation] -> [BrainFuckOperation] -> [Word.Word32] compileConditionally s cs os @@ -197,13 +211,13 @@ compileConditionally s cs os | otherwise = ubcLoadCellWord 1 : compileConditionally (s{isCellLoaded=True}) cs os where contained = compile cs - containedLength = length contained - forwardDistance = containedLength + 4 -- plus one to land after the skip Block - continueDistance = negate (containedLength + 10) + containedLength = fromIntegral (length contained) :: Int32 + forwardDistance = containedLength + 2 :: Int32 -- plus one to land after the skip Block + continueDistance = negate (if (forwardDistance > maxPayload20) then (containedLength + 10) else (containedLength + 6)) -- continueBlock has length 1 + 3 = 4 - continueBlock = ubcStoreCellWord 1 : ubcJumpRel (fromIntegral continueDistance) 2 ubcConditionNone + continueBlock = ubcStoreCellWord 1 : ubcJumpRel continueDistance 2 ubcConditionNone -- skipBlock has length 2 + 1 + 3 = 6 - skipBlock = ubcLoadIntWords 0 2 ++ [ubcCmpU 1 2] ++ (ubcJumpRel (fromIntegral forwardDistance) 2 ubcConditionEq) + skipBlock = ubcLoadIntWords 0 2 ++ [ubcCmpU 1 2] ++ (ubcJumpRel forwardDistance 2 ubcConditionEq) compile :: [BrainFuckOperation] -> [Word.Word32] compile = compile' CompileState{isCellLoaded=False, isCellModified=False} @@ -218,5 +232,5 @@ compile' state (DecrementCell amount:os) = compileDecrement state (fromInteg compile' state (MoveRight distance:os) = compileMoveRight state (fromIntegral distance) os compile' state (MoveLeft distance:os) = compileMoveLeft state (fromIntegral distance) os compile' state (Conditionally ops:os) = compileConditionally state ops os -compile' state (PutChar :os) = ubcLoadIntWords 0 2 ++ [ubcForeignCall 2] ++ compile' state os -compile' state (ReadChar :os) = ubcLoadIntWords 1 2 ++ [ubcForeignCall 2] ++ compile' state os +compile' state (PutChar :os) = ubcForeignCalli 0 : compile' state os +compile' state (ReadChar :os) = ubcForeignCalli 1 : compile' state os