Ideas:
ByteArray2BF: Convert anything to BF programs. Maybe binary code you can call as a function pointer if you load it into memory or execute as files.
ScrambleBF: BF Polymorphic Engine
Cycle Limit on interpreter
Interactive interpreter option
Performance improvements - Lots of low hanging fruit
Why the hell did I do the optimizations on the PB side and not the BF side
BrainFuck Tools
String2BrainFuck: Converts a string to a BF program whos output is the string
Textstr : String to convert to BF program
numBins : 1->16 good values with 6-7 usally giving the smallest program
RETURN : Resulting BF Program
BrainFuck2PureBasic: Converts a BF program into semi-optimized PureBasic Code
TextProgram : String of BF Program
ProgramName : Name of the resulting procedure
FixedInput : 1 If InputData is a constant / 0 If you wish the procedure to have InputData passed in
InputData : Data For fixed Input otherwise pass ""
RETURN : String of the PureBasic Source
BrainFuck: BrainFuck Intinterpreter
TextProgram : String containing BF program
InputData : Data for input into the BF program if needed
RETURN : String of the BF program output
ObscureString: Converts your string into a BF program then into a Purebasic
procedure you can use in place of the orginal string
String : String to Obscure
RETURN : Purebasic Procedure
ObscureStringInsane: Converts your string into a BF program then into a
BF program again. Next it is converted into a Purebasic program and
inlined as input for the next program. A BF self-interpreter is converted
into a Purebasic procedure with the previous code used for input.
*The self-interpreter needs obscured randomly
String : String to Obscure
RETURN : Purebasic Procedure
Code: Select all
; Title : Pure BrainFuck Tools
; Created: 24/12/2017,
; Author : CopperD
; Credits: http://esolangs.org/wiki/Brainfuck https://marsipulami0815.net/cryptomx/bf.html http://calmerthanyouare.org/2015/01/07/optimizing-brainfuck.html Wilbert's Bigint Module
; Info :
; v1.1 : Tiny Improvements
; Added: ---- 18/12/2019---------------------
; String2BrainFuck Numbins defaults to 6
; Wrapped everything up in a module
; Inputdata for Brainfuck & BrainFuck2PureBasic defauled to ""
; Added a test case to check that future changes don't booger everything up
; --------------------------------------------
; Added: ---- 24/12/2017---------------------
; Inital Release
; --------------------------------------------
;-----------------------------------------------------------------------------
;- Internal - String to BF
;-----------------------------------------------------------------------------
DeclareModule BFT
;Declare.s strTimes(string.s,times.i)
;Declare.s printDifference(diff.i,poschar.s,negchar.s)
;Declare.s writeBins(numBins.i,diff.i)
;Declare.i findClosestBin(value.i,Array bins.i(1),currbin.i, lenght.i)
;Declare.s AddReduce(BFPBProgram.s)
;Declare.s SubReduce(BFPBProgram.s)
;Declare.s RightReduce(BFPBProgram.s)
;Declare.s LeftReduce(BFPBProgram.s)
;Declare.s ClearLoop(BFPBProgram.s)
;Declare.s CopyLoop(BFPBProgram.s)
;Declare.s BF2PBOptimize(BFPBProgram.s)
Declare.s String2BrainFuck(textstr.s, numBins.i = 6)
Declare.s BrainFuck2PureBasic(TextProgram.s, ProgramName.s ,FixedInput.i, InputData.s = "")
Declare.s BrainFuck(TextProgram.s, InputData.s="")
Declare.s ObscureString(String.s)
Declare.s ObscureStringInsane(String.s)
Declare.i SelfTest()
EndDeclareModule
Module BFT
Procedure.s strTimes(string.s,times.i)
endstr.s = "";
For i = 0 To times - 1
endstr = endstr + string
Next
ProcedureReturn endstr
EndProcedure
Procedure.s printDifference(diff.i,poschar.s,negchar.s)
string.s = ""
If diff > 0
For b = 0 To diff - 1
string = string + poschar
Next
Else
For b = 0 To Abs(diff) - 1
string = string + negchar
Next
EndIf
ProcedureReturn string
EndProcedure
Procedure.s writeBins(numBins.i,diff.i)
string.s = strTimes("+",diff) + "["
For i = 0 To numBins - 2
string + ">" + strTimes("+",i+2)
Next
string + strTimes("<",numBins-1) + "-]"
string + strTimes("+",diff)
ProcedureReturn string
EndProcedure
Procedure.i findClosestBin(value.i,Array bins.i(1),currbin.i, lenght.i)
minBin.i = 0;
For b = 1 To lenght
If Abs(value - bins(b)) < Abs(value - bins(minBin))
minBin = b
EndIf
Next
If Abs(value - bins(minBin)) > Abs(value - bins(currbin))
ProcedureReturn currbin
EndIf
ProcedureReturn minBin
EndProcedure
;-----------------------------------------------------------------------------
;- Internal - BF to PureBasic
;-----------------------------------------------------------------------------
Procedure.s AddReduce(BFPBProgram.s)
Index.i = 0
First.i = 0
Last.i = 0
Temp.i = 0
Diff.i = 0
NumberTimes.i = 0
While Index < Len(BFPBProgram)
If Index = 0
Temp = FindString(BFPBProgram, " mem(p)+ 1"+Chr(10), Index)
EndIf
If Temp ; We found a match
Index = Temp+1
If NumberTimes = 0
First = Temp
EndIf
Last = Temp
Temp = FindString(BFPBProgram, " mem(p)+ 1"+Chr(10), Index)
If Temp ; We found a second match
diff = Temp - Last
Index = Temp
Last = Temp
If diff = 12 ; Spaced correctly?
NumberTimes.i + 1
Index + 1
;Keep searching
Else
;End of matches found
If NumberTimes > 0
BFPBProgram = RemoveString(BFPBProgram, " mem(p)+ 1"+Chr(10), #PB_String_CaseSensitive, First, NumberTimes+1)
BFPBProgram = InsertString(BFPBProgram, " mem(p)+ " + Str(NumberTimes+1) + ~"\n", First)
Index = 0
NumberTimes = 0
Else
Index + 1
EndIf
EndIf
Else
If NumberTimes > 0
BFPBProgram = RemoveString(BFPBProgram, " mem(p)+ 1"+Chr(10), #PB_String_CaseSensitive, First, NumberTimes+1)
BFPBProgram = InsertString(BFPBProgram, " mem(p)+ " + Str(NumberTimes+1) + ~"\n", First)
EndIf
Index = Len(BFPBProgram) + 1
EndIf
Else
Index = Len(BFPBProgram) + 1
EndIf
Wend
ProcedureReturn BFPBProgram
EndProcedure
Procedure.s SubReduce(BFPBProgram.s)
Index.i = 0
First.i = 0
Last.i = 0
Temp.i = 0
Diff.i = 0
NumberTimes.i = 0
While Index < Len(BFPBProgram)
If Index = 0
Temp = FindString(BFPBProgram, " mem(p)- 1"+Chr(10), Index)
EndIf
If Temp ; We found a match
Index = Temp+1
If NumberTimes = 0
First = Temp
EndIf
Last = Temp
Temp = FindString(BFPBProgram, " mem(p)- 1"+Chr(10), Index)
If Temp ; We found a second match
diff = Temp - Last
Index = Temp
Last = Temp
If diff = 12 ; Spaced correctly?
NumberTimes.i + 1
Index + 1
;Keep searching
Else
;End of matches found
If NumberTimes > 0
BFPBProgram = RemoveString(BFPBProgram, " mem(p)- 1"+Chr(10), #PB_String_CaseSensitive, First, NumberTimes+1)
BFPBProgram = InsertString(BFPBProgram, " mem(p)- " + Str(NumberTimes+1) + ~"\n", First)
Index = 0
NumberTimes = 0
Else
Index + 1
EndIf
EndIf
Else
If NumberTimes > 0
BFPBProgram = RemoveString(BFPBProgram, " mem(p)- 1"+Chr(10), #PB_String_CaseSensitive, First, NumberTimes+1)
BFPBProgram = InsertString(BFPBProgram, " mem(p)- " + Str(NumberTimes+1) + ~"\n", First)
EndIf
Index = Len(BFPBProgram) + 1
EndIf
Else
Index = Len(BFPBProgram) + 1
EndIf
Wend
ProcedureReturn BFPBProgram
EndProcedure
Procedure.s RightReduce(BFPBProgram.s)
Index.i = 0
First.i = 0
Last.i = 0
Temp.i = 0
Diff.i = 0
NumberTimes.i = 0
While Index < Len(BFPBProgram)
If Index = 0
Temp = FindString(BFPBProgram, " p + 1"+Chr(10), Index)
EndIf
If Temp ; We found a match
Index = Temp+1
If NumberTimes = 0
First = Temp
EndIf
Last = Temp
Temp = FindString(BFPBProgram, " p + 1"+Chr(10), Index)
If Temp ; We found a second match
diff = Temp - Last
Index = Temp
Last = Temp
If diff = 8 ; Spaced correctly?
NumberTimes.i + 1
Index + 1
;Keep searching
Else
;End of matches found
If NumberTimes > 0
BFPBProgram = RemoveString(BFPBProgram, " p + 1"+Chr(10), #PB_String_CaseSensitive, First, NumberTimes+1)
BFPBProgram = InsertString(BFPBProgram, " p + " + Str(NumberTimes+1) + ~"\n", First)
Index = 0
NumberTimes = 0
Else
Index + 1
EndIf
EndIf
Else
If NumberTimes > 0
BFPBProgram = RemoveString(BFPBProgram, " p + 1"+Chr(10), #PB_String_CaseSensitive, First, NumberTimes+1)
BFPBProgram = InsertString(BFPBProgram, " p + " + Str(NumberTimes+1) + ~"\n", First)
EndIf
Index = Len(BFPBProgram) + 1
EndIf
Else
Index = Len(BFPBProgram) + 1
EndIf
Wend
ProcedureReturn BFPBProgram
EndProcedure
Procedure.s LeftReduce(BFPBProgram.s)
Index.i = 0
First.i = 0
Last.i = 0
Temp.i = 0
Diff.i = 0
NumberTimes.i = 0
While Index < Len(BFPBProgram)
If Index = 0
Temp = FindString(BFPBProgram, " p - 1"+Chr(10), Index)
EndIf
If Temp ; We found a match
Index = Temp+1
If NumberTimes = 0
First = Temp
EndIf
Last = Temp
Temp = FindString(BFPBProgram, " p - 1"+Chr(10), Index)
If Temp ; We found a second match
diff = Temp - Last
Index = Temp
Last = Temp
If diff = 8 ; Spaced correctly?
NumberTimes.i + 1
Index + 1
;Keep searching
Else
;End of matches found
If NumberTimes > 0
BFPBProgram = RemoveString(BFPBProgram, " p - 1"+Chr(10), #PB_String_CaseSensitive, First, NumberTimes+1)
BFPBProgram = InsertString(BFPBProgram, " p - " + Str(NumberTimes+1) + ~"\n", First)
Index = 0
NumberTimes = 0
Else
Index + 1
EndIf
EndIf
Else
If NumberTimes > 0
BFPBProgram = RemoveString(BFPBProgram, " p - 1"+Chr(10), #PB_String_CaseSensitive, First, NumberTimes+1)
BFPBProgram = InsertString(BFPBProgram, " p - " + Str(NumberTimes+1) + ~"\n", First)
EndIf
Index = Len(BFPBProgram) + 1
EndIf
Else
Index = Len(BFPBProgram) + 1
EndIf
Wend
ProcedureReturn BFPBProgram
EndProcedure
Procedure.s ClearLoop(BFPBProgram.s)
search.s = ~" While mem(p)\n mem(p)- 1\n Wend\n"
BFPBProgram = ReplaceString(BFPBProgram, search, ~" mem(p) = 0\n")
ProcedureReturn BFPBProgram
EndProcedure
Procedure.s CopyLoop(BFPBProgram.s)
search.s = ~" While mem(p)\n mem(p)- 1\n p + 1\n mem(p)+ 1\n p + 1\n mem(p)+ 1\n p - 1\n p - 1\n Wend\n"
BFPBProgram = ReplaceString(BFPBProgram, search, ~" mem(p+1) + mem(p)\n mem(p+2) + mem(p)\n mem(p) = 0\n")
ProcedureReturn BFPBProgram
EndProcedure
Procedure.s BF2PBOptimize(BFPBProgram.s)
BFPBProgram = ClearLoop(BFPBProgram)
BFPBProgram = CopyLoop(BFPBProgram)
;Mul Goes here
BFPBProgram = AddReduce(BFPBProgram)
BFPBProgram = SubReduce(BFPBProgram)
BFPBProgram = RightReduce(BFPBProgram)
BFPBProgram = LeftReduce(BFPBProgram)
ProcedureReturn BFPBProgram
EndProcedure
;-----------------------------------------------------------------------------
;- BrainFuck Tools
;
; String2BrainFuck: Converts a string to a BF program whos output is the string
; Textstr : String to convert to BF program
; numBins : 1->16 good values with 6-7 usally giving the smallest program
; RETURN : Resulting BF Program
;
;
; BrainFuck2PureBasic: Converts a BF program into semi-optimized PureBasic Code
; TextProgram : String of BF Program
; ProgramName : Name of the resulting procedure
; FixedInput :
; 1 If InputData is a constant
; 0 If you wish the procedure to have InputData passed in
; InputData : Data For fixed Input otherwise pass ""
; RETURN : String of the PureBasic Source
;
;
; BrainFuck: BrainFuck Intinterpreter
; TextProgram : String containing BF program
; InputData : Data for input into the BF program if needed
; RETURN : String of the BF program output
;
;
; ObscureString: Converts your string into a BF program then into a Purebasic
; procedure you can use in place of the orginal string
;
; String : String to Obscure
; RETURN : Purebasic Procedure
;
;
; ObscureStringInsane: Converts your string into a BF program then into a
; BF program again. Next it is converted into a Purebasic program and
; inlined as input for the next program. A BF self-interpreter is converted
; into a Purebasic procedure with the previous code used for input.
; *The self-interpreter needs obscured randomly
;
; String : String to Obscure
; RETURN : Purebasic Procedure
;
;
;-----------------------------------------------------------------------------
Procedure.s String2BrainFuck(textstr.s, numBins.i = 6)
; Set up the first x number of memory cells (bins) to be evenly spaced values between 0 and 127
If numBins <= 0
numBins = 1
EndIf
Dim bins.i(numBins)
diff.i = Round(127/numBins, #PB_Round_Down)
For i = 0 To numBins - 1
bins(i) = (i + 1) * diff
Next
codestr.s = writeBins(numBins,diff)
;For each char
; find the closest bin in value
; Move pointer to that bin
; add or subtract remaining value to get to char value
; current location is now equal to char value
i = 0
currbin.i = 0
newbin.i = 0
While i < Len(textstr)
c.i = Asc(Mid(textstr, i + 1, 1))
newbin = findClosestBin(c,bins(),currbin, ArraySize(bins())) ; Which memory cell has closest value?
codestr = codestr + printDifference(newbin-currbin,">","<") ; Memory cell to bin with closest value
codestr = codestr + printDifference(c-bins(newbin),"+","-") ; Add or subtract remaining value
codestr = codestr + "."
currbin = newbin
bins(newbin) = c
i + 1
Wend
ProcedureReturn codestr;
EndProcedure
Procedure.s BrainFuck2PureBasic(TextProgram.s, ProgramName.s ,FixedInput.i, InputData.s="")
ProcedureCode.s = ""
Tab.s = " "
If FixedInput = 1
ProcedureCode = "Procedure.s " + ProgramName + "()" + ~"\n\n"
ProcedureCode + ~" InputData.s = \"" + InputData + ~"\"\n"
Else
ProcedureCode = "Procedure.s " + ProgramName + ~"(InputData.s)\n\n"
EndIf
ProcedureCode + ~" Dim Mem.a(65535)\n"
ProcedureCode + ~" p.u = 0\n"
ProcedureCode + ~" OutputData.s = \"\"\n"
ProcedureCode + ~" \n"
For x = 0 To Len(TextProgram) - 1 ; String not zero indexed
Select Mid(TextProgram, x + 1, 1)
Case ">"
ProcedureCode + ~" p + 1\n"
Case "<"
ProcedureCode + ~" p - 1\n"
Case "+"
ProcedureCode + ~" mem(p)+ 1\n"
Case "-"
ProcedureCode + ~" mem(p)- 1\n"
Case "."
ProcedureCode + ~" OutputData + chr(mem(p))\n"
Case ","
ProcedureCode + ~" mem(p) = Asc(InputData)\n"
ProcedureCode + ~" InputData = Mid(InputData, 2)\n"
Case "["
ProcedureCode + ~" While mem(p)\n"
Case "]"
ProcedureCode + ~" Wend\n"
Default
EndSelect
Next
ProcedureCode + ~" \n"
ProcedureCode + ~" ProcedureReturn OutputData\n"
ProcedureCode + ~"EndProcedure\n"
ProcedureCode = BF2PBOptimize(ProcedureCode)
ProcedureReturn ProcedureCode
EndProcedure
Procedure.s BrainFuck(TextProgram.s, InputData.s="")
NewList Stack.u()
Dim Memory.u(65535)
Dim Jumpmap.u(Len(TextProgram) - 1)
Dim Program.u(Len(TextProgram) - 1)
Pointer.u = 0
PC.u = 0
MaxPC.u = Len(TextProgram)
Output.s = ""
; Load Program into Array
; Create a jump map and Load Program into Array
For x = 0 To Len(TextProgram) - 1 ; String not zero indexed
Program(x) = Asc(Mid(TextProgram, x + 1, 1))
Select Mid(TextProgram, x + 1, 1)
Case "["
AddElement(Stack())
Stack() = x
Case "]"
Jumpmap(x) = Stack()
Jumpmap(Stack()) = x
DeleteElement(Stack())
Default
Jumpmap(x) = 0
EndSelect
Next
If ListSize = 0 ;BF does not contain broken loops
While PC < MaxPC
Select Program(PC)
Case 62 ;">"
Pointer + 1
PC + 1
Case 60 ;"<"
Pointer - 1
PC + 1
Case 43 ;"+"
Memory(Pointer) + 1
PC + 1
Case 45 ;"-"
Memory(Pointer) - 1
PC + 1
Case 46 ;"."
Output + Chr(Memory(Pointer))
PC + 1
Case 44 ;","
Memory(Pointer) = Asc(InputData)
InputData = Mid(InputData, 2)
PC + 1
Case 91 ;"["
If Memory(Pointer) = 0
PC = Jumpmap(PC)
Else
PC + 1
EndIf
Case 93 ;"]"
If Memory(Pointer) <> 0
PC = Jumpmap(PC)
Else
PC + 1
EndIf
Default
PC + 1
EndSelect
Wend
EndIf
ProcedureReturn Output
EndProcedure
Procedure.s ObscureString(String.s)
RandomSeed(ElapsedMilliseconds())
String = String2BrainFuck(String, Random(10,3))
String = BrainFuck2PureBasic(String, "Hidden", 1, "")
ProcedureReturn String
EndProcedure
Procedure.s ObscureStringInsane(String.s)
RandomSeed(ElapsedMilliseconds())
Output.s = ""
BFBF.s = ">>>+[[-]>>[-]++>+>+++++++[<++++>>++<-]++>>+>+>+++++[>++>++++++<<-]+>>>,<++[[>[->>]<[>>]<<-]<[<]<+>>[>]>[<+>-[[<+>-]>]<[[[-]<]++<-[<+++++++++>[<->-]>>]>>]]<<]<]<[[<]>[[>]>>[>>]+[<<]<[<]<+>>-]>[>]+[->>]<<<<[[<<]<[<]+<<[+>+<<-[>-->+<<-[>+<[>>+<<-]]]>[<+>-]<]++>>-->[>]>>[>>]]<<[>>+<[[<]<]>[[<<]<[<]+[-<+>>-[<<+>++>-[<->[<<+>>-]]]<[>+<-]>]>[>]>]>[>>]>>]<<[>>+>>+>>]<<[->>>>>>>>]<<[>.>>>>>>>]<<[>->>>>>]<<[>,>>>]<<[>+>]<<[+<<]<]"
String = String2BrainFuck(String, Random(10,3))
String + "!"
String = String2BrainFuck(String, Random(10,3))
String = BrainFuck2PureBasic(String, "Hidden", 1, "")
String = RemoveString(String, "Procedure.s Hidden()")
String = RemoveString(String, ~" InputData.s = \"\"")
String = RemoveString(String, " ProcedureReturn OutputData")
String = RemoveString(String, "EndProcedure")
String = ReplaceString(String, "OutputData", "InputData")
Output = BrainFuck2PureBasic(BFBF, "Hidden", 1, "")
Output = ReplaceString(Output, ~" InputData.s = \"\"", String)
ProcedureReturn Output
EndProcedure
;-----------------------------------------------------------------------------
;- Self Testing
;
;
; SelfTest: Runs some basic tests against the procedures above
; Automaticly ran if module is executated inside IDE
;
; RETURN : 0 if good
;
;
;-----------------------------------------------------------------------------
Procedure.i SelfTest()
Test.s = BrainFuck("++++++++[>++++++++<-]>[<++++>-]+<[>-<[>++++<-]>[<++++++++>-]<[>++++++++<-]+>[>++++++++++[>+++++<-]>+.-.[-]<<[-]<->]<[>>+++++++[>+++++++<-]>.+++++.[-]<<<-]] >[>++++++++[>+++++++<-]>.[-]<<-]<+++++++++++[>+++>+++++++++>+++++++++>+<<<<-]>-.>-.+++++++.+++++++++++.<.>>.++.+++++++..<-.>>-[[-]<]")
Result.i = 0
If Test = "16 bit cells"
Debug "Cell Size Test: [PASS] " + Test
Else
Debug "Cell Size Test: [FAIL] " + Test
Result + 1
EndIf
Test = BrainFuck("->++>+++>+>+>++>>+>+>+++>>+>+>++>+++>+++>+>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>+>+>++>>>+++>>>>>+++>+>>>>>>>>>>>>>>>>>>>>>>+++>>>>>>>++>+++>+++>+>>+++>+++>+>+++>+>+++>+>++>+++>>>+>+>+>+>++>+++>+>+>>+++>>>>>>>+>+>>>+>+>++>+++>+++>+>>+++>+++>+>+++>+>++>+++>++>>+>+>++>+++>+>+>>+++>>>+++>+>>>++>+++>+++>+>>+++>>>+++>+>+++>+>>+++>>+++>>+[[>>+[>]+>+[<]<-]>>[>]<+<+++[<]<<+]>>>[>]+++[++++++++++>++[-<++++++++++++++++>]<.<-<]")
If Test = "->++>+++>+>+>++>>+>+>+++>>+>+>++>+++>+++>+>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>+>+>++>>>+++>>>>>+++>+>>>>>>>>>>>>>>>>>>>>>>+++>>>>>>>++>+++>+++>+>>+++>+++>+>+++>+>+++>+>++>+++>>>+>+>+>+>++>+++>+>+>>+++>>>>>>>+>+>>>+>+>++>+++>+++>+>>+++>+++>+>+++>+>++>+++>++>>+>+>++>+++>+>+>>+++>>>+++>+>>>++>+++>+++>+>>+++>>>+++>+>+++>+>>+++>>+++>>+[[>>+[>]+>+[<]<-]>>[>]<+<+++[<]<<+]>>>[>]+++[++++++++++>++[-<++++++++++++++++>]<.<-<]"
Debug "Quine Test: [PASS]"
Else
Debug "Quine Test: [FAIL]"
Result + 1
EndIf
Test = BrainFuck(String2BrainFuck("Hello World!"))
If Test = "Hello World!"
Debug "String2BF Test: [PASS] " + Test
Else
Debug "String2BF Test: [FAIL] " + Test
Result + 1
EndIf
ProcedureReturn Result
EndProcedure
CompilerIf #PB_Compiler_IsMainFile
Debug "Return Value: " + Str(SelfTest())
CompilerEndIf
EndModule