I forgot about ., operators

src/Lib.hs

@@ -95,9 +95,11 @@ ubcOpcodeReg2Mem  = 0x05000000
 
 ubcOpcodeJumpRel :: Word.Word32
 ubcOpcodeJumpRel  = 0x09000000
+ubcOpcodeRelJumpi :: Word.Word32
+ubcOpcodeRelJumpi  = 0x19000000
 
-ubcOpcodeForeignCall :: Word.Word32
+ubcOpcodeForeignCalli :: Word.Word32
-ubcOpcodeForeignCall  = 0x0F000000
+ubcOpcodeForeignCalli  = 0x1F000000
 
 ubcOpcodeAddU :: Word.Word32
 ubcOpcodeAddU  = 0x80000000
@@ -111,8 +113,13 @@ ubcConditionNone = 0x00000000
 ubcConditionEq   :: Word.Word32
 ubcConditionEq   = 0x00800000
 
-ubcForeignCall :: Int32 -> Word.Word32
+maxPayload20 :: Int32
-ubcForeignCall r = ubcOpcodeForeignCall .|. ubcInstructionRegArg1 r
+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
+        containedLength  = fromIntegral (length contained) :: Int32
-        forwardDistance  = containedLength + 4 -- plus one to land after the skip Block
+        forwardDistance  = containedLength + 2 :: Int32 -- plus one to land after the skip Block
-        continueDistance = negate (containedLength + 10)
+        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 (PutChar             :os) = ubcForeignCalli 0 : compile' state os
-compile' state (ReadChar            :os) = ubcLoadIntWords 1 2 ++ [ubcForeignCall 2] ++ compile' state os
+compile' state (ReadChar            :os) = ubcForeignCalli 1 : compile' state os