VegOwOtenks/ubcf
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

I forgot about ., operators

Browse source
This commit is contained in:
VegOwOtenks 2024-10-01 09:57:25 +02:00
parent 835a457a81
commit 4cfe491e1e
1 changed files with 29 additions and 15 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

44
src/Lib.hs
View file

@ -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