vaikutti sen verran paremmalta, että tunsin suurta tarvetta tehdä sille melkein toimivan tulkin.
Code: Select all
// BoneGrinder-Tulkki ~ MetalRain
// Katso Grandin kehittelemästä BoneGrinderistä enemmän:
// http://grandi.jouluserver.com/?/bonegrinder
// Lisäsin erikoispinot = < > jotka palauttavat 1 jos totta
// Esimerkkejä uusista pinoista:
// koodilla [641>]a A-pinon ensimmäinen arvo on 1, koska 6>4>1
// koodilla 5b[[23+]B=]a A-pinon ensimmäinen arvo on 1, koska B saa arvokseen 5 ja 2+3=5 ja B=5
// koodilla [[23+][23*]8<]a A-pinon ensimmäinen arvo on 1, koska 2+3=5, 2*3=6 ja 5<6<8
// Arvon voi tulostaa numeerisena pinolla @ mikä on kätevää arvojen tarkastukseen
// koodilla 5bb [B2+]a [AB+]c C@ tulostuu numero 12 koska B-pinoon tulee arvot 5 ja 5 B-pinon ylin arvo (5)
// lisätään arvoon 2 jolloin A-pinon arvo on 7 B-pinon toinen arvo 5 ja A-pinon arvo 7 lasketaan yhteen ja
// laitetaan pinoon C. C-pinon arvo tulostetaan.
// Debug-pino & tulostaa erikoisrekisterien 0 ja 1 arvot ruudulle, näitä voi hyödyntää uusien ominaisuuksien
// lisäämisessä ja ohjelman suorituksen tarkkailussa
SCREEN 1024,768
Const MAINREG = 0
Const CHARREG = 1
Const CTRLREG = 2
Const CTRLAMOUNTREG = 3
Const MOVEREG = 4
Dim REGISTER(256) As integer
Dim SUB(256) As integer
AddRegister(0,MAINREG) // MAIN REGISTER FOR ALL BYTECRUNCHING
AddRegister(1,CTRLREG) // CONSIST ALL UNUSED VALUES WHILE IN [ ] CYCLES
AddRegister(2,CTRLAMOUNTREG) // TELLS HOW MANY VALUES WAS PUSHED IN CTRLREG LAST [
// ALSO USED WITH # and @
AddRegister(3,MOVEREG)
For i=97 To 122
AddRegister(i,CHARREG)
Next i
//Helloworld three times!
code= LoadCode("A:[2525*]sssssss[S8+]lll[89*][S1+]LL[S56+][48*][S355-][S56+][S77+]LS[[56*]3+]#[C1+]cc!A[C2<]")
//Hello World!
// [2525*]sssSsss[S8+]lll[89*][S1+]LL[S56+][48*][S355-][S56+][S77+]LS[[56*]3+]#
RunCode(code)
//uncomment to see values in registers
//PrintRegisters()
WaitKey
Function LoadCode(code$)
l=Len(code$)
mem=MakeMEMBlock(l)
For i=0 To l-1
value=Asc(Mid(code$,i+1,1))
If value=58 Then
identifier=PeekByte(mem,i-1)
If Not (identifier<=90)(identifier=>65) Then
MakeError "Subprogram identifier '"+Chr(identifier)+"' @ "+Int(i-1)+" is not valid. Must be uppercase A-Z"
ElseIf SUB(identifier) Then
MakeError "Subprogram "+Chr(identifier)+" in two places: "+SUB(identifier)+"&"+Int(i-1)
Else
SUB(identifier)=i
EndIf
EndIf
PokeByte mem,i,value
Next i
Return mem
End Function
Function RunCode(codemem)
l=MEMBlockSize(codemem)
i=0
while i<=l
v = PeekByte(codemem,i)
isUpperCase=(v<=90)(v=>65)
isLowerCase=(v<=122)(v=>97)
isNumber = (v>=48)(v<=57)
isChar=(isUpperCase<>isLowerCase)
isValue=(isUpperCase<>isNumber)
isOperator=(v=42)+(v=43)+(v=45)+(v=47)+(v=61)+(v=62)+(v=60)
isControl=(v=93)+(v=91)
debug=(v=38)
openconsole=(v=63)
willPrint=(v=35)<>(v=64)
isSub = (v=33)
isLabel = (v=58)
If isLabel Then pop(0)
If debug Then
Printregister(0)
Printregister(1)
EndIf
If isSub Then
identifier=PeekByte(codemem,i+1)
If SUB(identifier) Then
'If wasassigned Then PokeInt REGISTER(0),1,0 : wasassigned=0
subinbrackets=openbracket
considersub=identifier
i=i+1
EndIf
ElseIf openconsole Then
txt$=""
While Len(txt$)<1
txt$=Input("")
If KeyHit(cbkeyreturn) Then txt$=Chr(12)
DrawScreen
Wend
CloseInput
ClearKeys
push(0,Asc(Left(txt$,1)),1)
txt$=""
ElseIf willPrint Then
printable=PeekInt(REGISTER(0),1)
Move(0,1,printable,1)
txt$=""
For o=0 To printable-1
value#=pop(0)
If v=64 Then //@ numeral only
txt$=txt$+value#+" "
Else //# show in ascii
If value#=10.0 Or value#=12.0 Or value#=13.0 Then
Print txt$
txt$=""
ElseIf value=9 Then
txt$=txt$+" "
Else
txt$=txt$+Chr(Int(value#))
EndIf
EndIf
Next o
Move(1,0,printable)
wasassigned=wasassigned+1
Print txt$
ElseIf isOperator Then
operable=PeekInt(REGISTER(0),1)
If operable Then
value#=pop(0)
If (v=60) then // <
eq=1
For o=1 To operable-1
value2#=pop(0)
If value2#<value# Then eq=0 Else value#=value2#
Next o
value#=eq
ElseIf (v=61) Then // =
eq=1
For o=1 To operable-1
If Not (value#=pop(0)) Then eq=0
Next o
value#=eq
ElseIf (v=62) then // >
eq=1
For o=1 To operable-1
value2#=pop(0)
If value2#>value# Then eq=0 Else value#=value2#
Next o
value#=eq
Else
For o=1 To operable-1
Select v
Case 43 // +
value#=value#+pop(0)
Case 42 // *
value#=value#*pop(0)
Case 45 // -
value#=value#-pop(0)
Case 47 // /
value#=value#/pop(0)
End Select
Next o
EndIf
PokeInt REGISTER(0),1,0
If value# Then push(0,value#,1)
EndIf
ElseIf isChar Then
If isUpperCase Then
If wasassigned Then PokeInt REGISTER(0),1,0 : wasassigned=0
push(0,pop(v+32),1)
EndIf
If isLowerCase Then
If openbracket Then
push(3,v)
EndIf
move(0,v,-1,1)
wasassigned=wasassigned+1
EndIf
ElseIf isNumber Then
If wasassigned Then PokeInt REGISTER(0),1,0 : wasassigned=0
push(0,(48<>v)*(v-48),1)
'PrintRegister(0)
ElseIf v=91 Then //[
If wasassigned Then PokeInt REGISTER(0),1,0 : wasassigned=0
//moves TEMPREG TO CTRLREG
amount=PeekInt(REGISTER(0),1)
Move(0,1,amount)
push(2,amount)
PokeInt REGISTER(0),1,0
openbracket=openbracket+1
ElseIf v=93 Then //]
If wasassigned Then
PokeInt REGISTER(0),1,0
For o=1 To wasassigned
push(0,pop(pop(3)))
Next o
wasassigned=0
EndIf
openbracket=openbracket-1
If considersub And subinbrackets=openbracket Then
If pop(0) Then i=SUB(considersub)
considersub=0
EndIf
amount=pop(2)
If amount Then Move(1,0,amount)
EndIf
i=i+1
Wend
End Function
Function PrintRegisters()
Print ""
Print "--Printing Unempty Registers--"
Print ""
For i=0 To 255
reg = REGISTER(i)
If reg Then
If PeekInt(reg,1) Then PrintRegister(i)
EndIf
Next i
End Function
Function PrintRegister(regnum)
reg = REGISTER(regnum)
If reg Then
Print "Register("+regnum+") ='"+Chr(regnum)+"' is Type: "+PeekByte(reg,0)
values=PeekInt(reg,1)
If values Then
If values>1 Then
txt$=""
For i=0 To values-1
txt$=txt$+PeekFloat(reg,5+i*4)+" "
Next i
Print "Contains "+values+" values:"+ txt$
Else
Print "Contains a value:"+ PeekFloat(reg,5+i*4)
EndIf
Else
Print "Doesn't contain any value."
EndIf
Print ""
EndIf
End Function
Function AddRegister(name,rt)
m = MakeMEMBlock(9)
PokeByte m,0,rt
PokeInt m,1,0
REGISTER(name) = m
End Function
Function Push(regnum,value#,back=0)
reg = REGISTER(regnum)
If reg Then
values=PeekInt(reg,1)
PokeInt reg,1,values+1
ms=MEMBlockSize(reg)
If ms<5+values*4+4 Then ResizeMEMBlock reg,5+values*4+8+1
If Not back Then
PokeFloat reg,5+values*4,value#
Else
If values=>1 Then MemCopy reg,5,reg,5+4,values*4
PokeFloat reg,5,value#
EndIf
REGISTER(regnum)=reg
Return value
EndIf
End Function
Function Move(fromregnum,toregnum,amount=1,copy=0)
If amount Then
freg = REGISTER(fromregnum)
treg = REGISTER(toregnum)
If freg*treg Then
fvalues=PeekInt(freg,1)
If fvalues Then
If amount=-1 Then amount=fvalues
ms=MEMBlockSize(treg)
tvalues=PeekInt(treg,1)
If ms<5+(tvalues+amount)*4 Then ResizeMEMBlock treg,5+(tvalues+amount)*4+4
MemCopy freg,5+(fvalues-amount)*4,treg,5+tvalues*4,amount*4
PokeInt treg,1,tvalues+amount
REGISTER(toregnum)=treg
If Not copy Then
PokeInt freg,1,fvalues-amount
EndIf
EndIf
EndIf
EndIf
End Function
Function Pop(regnum,remove=1)
reg = REGISTER(regnum)
If reg Then
values=PeekInt(reg,1)
If values>0 Then
If remove Then PokeInt reg,1,values-1
Return PeekFloat(reg,5+(values-1)*4)
Else
Return 0
EndIf
EndIf
End Function
Parannelkaa jos näette tarpeelliseksi. Tuo nykyinen input-output on ainakin kamala.
Mutta en tiedä onko noissa grandin esimerkkikoodeissa virheitä vai ajaako tämä ne väärin. Jokatapauksessa itse tekemäni koodit ovat toimineet. Ja jos katsot noita grandin tekemiä toimintatapaselityksiä niin kyllä sielläkin mennään metsään, mm.. 81+9=100 ja 8*4+1=65
EDIT: Korjattu A#a sekä [Bde]a ominaisuudet. Mutta ei tue pinoon panoa sulkeiden sisällä, mikäli myös laskutoimitus on samojen sulkeiden sisällä: !T[?57-a] ei toimi, mutta [?57-]aa!T[A] toimii.
Mutta en tiedä onko noissa grandin esimerkkikoodeissa virheitä vai ajaako tämä ne väärin. Jokatapauksessa itse tekemäni koodit ovat toimineet. Ja jos katsot noita grandin tekemiä toimintatapaselityksiä niin kyllä sielläkin mennään metsään, mm.. 81+9=100 ja 8*4+1=65