Verfasst: 06.01.2005 18:09
Sag mal, ist das nciht so ne art Assambler?
.PureBoard
Das deutsche PureBasic-Forum
https://www.purebasic.fr/german/
Easy - Compiler / Interpreter
Seite 2 von 3
Verfasst: 06.01.2005 18:44
Verdammt entfernt aber hat schon eine gewisse ähnlichkeit. Ich arbeite aber an einer neuen und hofentlich finalen Version .
.Verfasst: 06.01.2005 18:55
Dein Z ist kaputt!LittleFurz hat geschrieben:Ich hatte keine Lust mehr an der Referen noch die Befehle zu ändern. Achtung, ein paar funktionieren nicht mehr so wie in der Referen angegeben !
Verfasst: 06.01.2005 18:57
muss nur meine Tastatur mal wieder sauber machen, da sind verdammt viele Keks krümmel. Kann ich neue Kekse aus denen pressen.
Verfasst: 12.01.2005 18:55
Ehm, ich kündige mal so n release an 
.
In der Version habe ich das Speichermanagment etwas erweitert. Man kann nun echte Longs speichern was eine ernorme Hilfe für das Aufrufen von APIs ist. Zusätzlich kann man mit ein paar Schritten Strucuturen in einer Speicheradresse erstellen. Wieder hilfreich um eine API aufzurufen. Zudem wurden Befehle wie das Ansprechen der Windows console entfernt da diese nun über ein Script augerufen werden können. Zudem kommen neue Funktionen hinzu wie z.b. das Linken von 2 Speicheradressen. So wirkt sich z.b. eine Änderung in dem einem Speicher auch in dem Andrem aus. Was es noch gibt ist nun ein SideMemory. Dank dieser 'neuen' technologie kann man nun, wenn man eine Funktion startet den alten Speicher zwischen speichern und dann wird der Speichergeleert. Beim wiederholten Aufruf wird dann der Speicher gelöscht und der Alte restauriert. Zudem kommt noch eine Funktion, die den Stack nun in den Speicher schreibt. So kann man z.b. an Easy Interne Funktionen Parameter übergeben.
Der Compiler wurde eigentlich nur geringfügig geändert, damit er nun auch Speicher Pointer erkennen kann.
In dieser Version wird der Sourcecode nicht beigelegt sein. Der Grund ist einfach, dass, wenn jemand Interesse an dem Projekt zeigt, ich dann noch etwas an Easy arbeiten möchte/will. Kleine Frage nun, arbeitet noch irgendjemand mit der Sprache o_O ?
Release dürften sich aber etwas verspäten, da ich einfach im Praktikum bin -_-. Das raubt mächtig viel Zeit
.
. In der Version habe ich das Speichermanagment etwas erweitert. Man kann nun echte Longs speichern was eine ernorme Hilfe für das Aufrufen von APIs ist. Zusätzlich kann man mit ein paar Schritten Strucuturen in einer Speicheradresse erstellen. Wieder hilfreich um eine API aufzurufen. Zudem wurden Befehle wie das Ansprechen der Windows console entfernt da diese nun über ein Script augerufen werden können. Zudem kommen neue Funktionen hinzu wie z.b. das Linken von 2 Speicheradressen. So wirkt sich z.b. eine Änderung in dem einem Speicher auch in dem Andrem aus. Was es noch gibt ist nun ein SideMemory. Dank dieser 'neuen' technologie kann man nun, wenn man eine Funktion startet den alten Speicher zwischen speichern und dann wird der Speichergeleert. Beim wiederholten Aufruf wird dann der Speicher gelöscht und der Alte restauriert. Zudem kommt noch eine Funktion, die den Stack nun in den Speicher schreibt. So kann man z.b. an Easy Interne Funktionen Parameter übergeben.
Der Compiler wurde eigentlich nur geringfügig geändert, damit er nun auch Speicher Pointer erkennen kann.
In dieser Version wird der Sourcecode nicht beigelegt sein. Der Grund ist einfach, dass, wenn jemand Interesse an dem Projekt zeigt, ich dann noch etwas an Easy arbeiten möchte/will. Kleine Frage nun, arbeitet noch irgendjemand mit der Sprache o_O ?
Release dürften sich aber etwas verspäten, da ich einfach im Praktikum bin -_-. Das raubt mächtig viel Zeit
.Verfasst: 14.01.2005 14:36
Wie ich das sehe wird Easy an diesem Wochenende fertig gestellt werden. Was dazu kommt ist, dass ich Easy nun umbennen werde und zwar in Enigmar. Lacht, mir doch scheiß egal -_-. Zu der 1. Enigmar Version kommt auch eine vollständige Hilfe plus ein paar Beispielen. Im Archiv wird ebenfalls auch eine Include Datei (Für Enigma) Dabei sein um die Konsole benutzen zu können.
Ich habe ja gefragt ob jemand mit dieser Sprache arbeitet, wie ich das sehe macht dies keiner 
. Dies wird dann höhst wahrscheinlich meine lezte Version werden und ich arbeite dann weiter an meinem anderem Projekt. Ob ich den Sourcecode beilege überleg ich mir noch 
.
Ich habe ja gefragt ob jemand mit dieser Sprache arbeitet, wie ich das sehe macht dies keiner
. Dies wird dann höhst wahrscheinlich meine lezte Version werden und ich arbeite dann weiter an meinem anderem Projekt. Ob ich den Sourcecode beilege überleg ich mir noch .Verfasst: 14.01.2005 15:01
> und zwar in Enigmar.
Du meinst die Verschlüsselungsmaschine, die im 2. Weltkrieg zum Einsatz
kam? Falls ja: Die heisst Enigma.
> Ich habe ja gefragt ob jemand mit dieser Sprache arbeitet, wie ich das
> sehe macht dies keiner
dann hast Du wohl an den Interessen anderer vorbeiprogrammiert.
Grüße ... Kiffi
Du meinst die Verschlüsselungsmaschine, die im 2. Weltkrieg zum Einsatz
kam? Falls ja: Die heisst Enigma.
> Ich habe ja gefragt ob jemand mit dieser Sprache arbeitet, wie ich das
> sehe macht dies keiner
dann hast Du wohl an den Interessen anderer vorbeiprogrammiert.
Grüße ... Kiffi
Verfasst: 14.01.2005 16:01
Enigmar weil Engima schon die Technick heißt (kenn die) und ich find Easy ähnlich kryptisch. Außerdem kenne ich das Interesse anderer nicht o_O.
Verfasst: 16.01.2005 00:53
So, keine Lust mehr dran weiter zu arbeiten. Andere Projekte rufen. In den Dateien wurde nix mehr geändert. Auch die Namensänderung wurde nicht durchgeführt. Was noch zu machen wäre ist es die Strukturen wärend der Laufzeit zu kompilieren. Da habe ich nur etwas rum experementiert. Keine lust gehabt noch was zu machen. wer will kanns gern weiter entwickeln hab nu echt keine lust mehr auf das ding. kann schon alles was ich wollte.
Interpreter:
Compiler:
Interpreter:
Code: Alles auswählen
Structure sMemory
MemPointer.l
MemType.l
MemSize.l
EndStructure
Structure sPointer
potName.s
potZeile.l
EndStructure
Structure sStore
stoDataS.s
stoDataL.l
stoType.l
EndStructure
Structure sToken
tokBefehl.s
tokData1.s
tokType1.l
tokData2.s
tokType2.l
EndStructure
Structure AllTypes
StructureUnion
b.b
w.w
l.l
f.f
s.s
EndStructureUnion
EndStructure
Enumeration
#TYPString
#TYPLong
#TYPMemory
#TYPPointer
EndEnumeration
Enumeration
#STCByte
#STCWord
#STCDWord
#STCString
EndEnumeration
Enumeration
#CMPLower
#CMPEqual
#CMPHigher
#CMPNotEqual
#CMPWrong
EndEnumeration
#Version = "0.1.2"
#CodePage = "code.OBJ"
#PtrsPage = "Ptr.OBJ"
Global CMPResult.l
Global lngFunkPtr.l
Global lngResult.l
Global lngDataPush.l
Global StartExecution.l
Global StoppExecution.l
Global lngMemorySize.l
Global strCommand.s
NewList Memory.l()
NewList Source.sToken()
NewList Points.sPointer()
NewList Stack.sStore()
NewList JMPStack.l()
NewList StructStack.l()
Dim Speicher.sMemory(0)
Dim SideMemy.sMemory(0)
IncludeFile "Easy3.pb.declare"
cMain()
End
;- Hauptprogramm
Procedure cMain()
DefType.s tmpZeile, strFileName
DefType.l FileProc, lngFilehWnd
strFileName = ProgramParameter()
strCommand = AssembleParameter()
Debug "File : " + strFileName
Debug "Param: " + strCommand
If FileSize(strFileName) > 0
Debug "Pointer File: " + Str(VBinSize(strFileName, #PtrsPage))
Debug "Code File: " + Str(VBinSize(strFileName, #CodePage))
Debug "------ Read Resources ------"
lngFilehWnd = VBin(strFileName, #PtrsPage, "")
Debug "Reading Pointers..."
While FileProc < VBinSize(strFileName, #PtrsPage)
AddElement(Points())
FileProc + ReadStructure(Points(), lngFilehWnd+FileProc, @"sl")
Debug ">> Jumpmark " + Points()\potName + " at " + Str(Points()\potZeile)
Wend: FileProc = 0
Debug "Reading Source..."
lngFilehWnd = VBin(strFileName, #CodePage, "")
While FileProc < VBinSize(strFileName, #CodePage)
AddElement(Source())
FileProc + ReadStructure(Source(), lngFilehWnd+FileProc, @"sslsl")
Wend: FileProc = 0
Debug "Source Lines: " + Str(CountList(Source()))
Debug "------ Start Programm ------"
StartExecution = GetTickCount_()
ForEach Source()
Debug RSet(Str(ListIndex(Source())),3,"0")+": "+Source()\tokBefehl+"("+Source()\tokData1+"["+Str(Source()\tokType1)+"]"+"-"+Source()\tokData2+"["+Str(Source()\tokType2)+"]"+")"
Select Source()\tokBefehl
Case "siz": Easy_SIZ(Source()): Case "mov": Easy_MOV(Source())
Case "int": Easy_INT(Source()): Case "add": Easy_ADD(Source())
Case "inc": Easy_INC(Source()): Case "dec": Easy_DEC(Source())
Case "cnv": Easy_CNV(Source()): Case "jmp": Easy_JMP(Source())
Case "ret": Easy_RET(Source()): Case "got": Easy_GOT(Source())
Case "cmp": Easy_CMP(Source()): Case "jl" : Easy_JL (Source())
Case "jnl": Easy_JNL(Source()): Case "je" : Easy_JE (Source())
Case "jne": Easy_JNE(Source()): Case "jg" : Easy_JG (Source())
Case "jng": Easy_JNG(Source()): Case "opn": Easy_OPN(Source())
Case "sto": Easy_STO(Source()): Case "cls": Easy_CLS(Source())
Case "cal": Easy_CAL(Source()): Case "flp": Easy_FLP(Source())
Case "lad": Easy_LAD(Source()): Case "byt": Easy_BYT(Source())
Case "and": Easy_AND(Source()): Case "or" : Easy_OR (Source())
Case "xor": Easy_XOR(Source())
EndSelect
Next
StoppExecution = GetTickCount_()
Debug "Execution finished in: " + Str(StoppExecution-StartExecution)
EndIf
EndProcedure
;- Standart Befehle
Procedure Easy_SIZ(*Token.sToken)
DefType.l lngI
Debug "> Allocate Memory"
If *Token\tokType1 = #TYPLong
lngMemorySize = Val(*Token\tokData1)
Dim Speicher.sMemory(lngMemorySize)
For lngI = 0 To lngMemorySize
Speicher(lngI)\MemPointer = AllocateMemory(4)
Speicher(lngI)\MemSize = 4
Speicher(lngI)\MemType = #TYPLong
PokeL(Speicher(lngI)\MemPointer, 0000)
Debug ">> Alocated Mem: " + Str(Speicher(lngI)\MemPointer)
Next
Else
Debug ">> Can't allocate memory !"
EndIf
EndProcedure
Procedure Easy_MOV(*Token.sToken)
DefType.l lngSize, lngMemA, lngMemB
Select *Token\tokType2
Case #TYPString
SetString(*Token\tokData2 , Speicher(Val(*Token\tokData1)))
Case #TYPLong
SetLong(Val(*Token\tokData2), Speicher(Val(*Token\tokData1)))
Case #TYPMemory
MemCopy(Speicher(Val(*Token\tokData2)), Speicher(Val(*Token\tokData1)) )
Case #TYPPointer
lngMemA = Speicher(Val(*Token\tokData1))\MemPointer
SetLong(lngMemA, Speicher(Val(*Token\tokData1)))
Speicher(Val(*Token\tokData1))\MemType = #TYPPointer
EndSelect
EndProcedure
Procedure Easy_INT(*Token.sToken)
DefType.s SpeicherA
Select *Token\tokType2
Case #TYPLong : SpeicherA = *Token\tokData2
Case #TYPString: SpeicherA = *Token\tokData2
Case #TYPMemory
If Speicher(Val(*Token\tokData2))\MemType = #TYPString
SpeicherA = GetString(Speicher(Val(*Token\tokData2)))
ElseIf Speicher(Val(*Token\tokData2))\MemType = #TYPLong
SpeicherA = Str(GetLong(Speicher(Val(*Token\tokData2))))
EndIf
EndSelect
Select *Token\tokData1
Case "0" ; Debug
Debug "------ Debug Message ------"
Debug "Msg (" + *Token\tokData2 + "): " + SpeicherA
Case "1" ; Ende
SelectElement(Source(), CountList(Source()))
Case "2" ; Delay
Delay(Val(SpeicherA))
Case "3" ; Runing Since
SetLong(StartExecution, Speicher(Val(SpeicherA)))
Case "4" ; Runing
StoppExecution = GetTickCount_()
SetLong(StoppExecution-StartExecution, Speicher(Val(SpeicherA)))
Case "5" ; Get Easy Version
SetString(#Version, Speicher(Val(SpeicherA)))
Case "6" ; Get Command prompt
SetString(strCommand, Speicher(Val(SpeicherA)))
EndSelect
EndProcedure
Procedure Easy_ADD(*Token.sToken)
DefType.l CalcResult, lngDestMemType, lngSourceMemType
DefType.s AssmResult
lngDestMemType = Speicher(Val(*Token\tokData1))\MemType
Select *Token\tokType2
Case #TYPLong
If lngDestMemType = #TYPLong
CalcResult = GetLong(Speicher(Val(*Token\tokData1)))
CalcResult + Val(*Token\tokData2)
SetLong(CalcResult, Speicher(Val(*Token\tokData1)))
EndIf
Case #TYPString
If lngDestMemType = #TYPString
AssmResult = GetString(Speicher(Val(*Token\tokData1)))
AssmResult = AssmResult + *Token\tokData2
SetString(AssmResult ,Speicher(Val(*Token\tokData1)))
EndIf
Case #TYPMemory
lngSourceMemType = Speicher(Val(*Token\tokData2))\MemType
If lngDestMemType = lngSourceMemType
Select lngDestMemType
Case #TYPLong
CalcResult = GetLong(Speicher(Val(*Token\tokData1)))
CalcResult + GetLong(Speicher(Val(*Token\tokData2)))
SetLong(CalcResult, Speicher(Val(*Token\tokData1)))
Case #TYPString
AssmResult = GetString(Speicher(Val(*Token\tokData1)))
AssmResult + GetString(Speicher(Val(*Token\tokData2)))
SetString(AssmResult ,Speicher(Val(*Token\tokData1)))
EndSelect
EndIf
EndSelect
EndProcedure
Procedure Easy_INC(*Token.sToken)
DefType.l CalcResult
If *Token\tokType1 = #TYPMemory And Speicher(Val(*Token\tokData1))\MemType = #TYPLong
CalcResult = GetLong(Speicher(Val(*Token\tokData1))) + 1
SetLong(CalcResult, Speicher(Val(*Token\tokData1)))
EndIf
EndProcedure
Procedure Easy_DEC(*Token.sToken)
DefType.l CalcResult
If *Token\tokType1 = #TYPMemory And Speicher(Val(*Token\tokData1))\MemType = #TYPLong
CalcResult = GetLong(Speicher(Val(*Token\tokData1))) - 1
SetLong(CalcResult, Speicher(Val(*Token\tokData1)))
EndIf
EndProcedure
Procedure Easy_CNV(*Token.sToken)
DefType.s strTemp
If *Token\tokType1 = #TYPMemory
Select *Token\tokData2
Case "0" ; Long to String
strTemp = Str(GetLong(Speicher(Val(*Token\tokData1))))
SetString(strTemp, Speicher(Val(*Token\tokData1)))
Case "1" ; String to Long
strTemp = GetString(Speicher(Val(*Token\tokData1)))
SetLong(Val(strTemp), Speicher(Val(*Token\tokData1)))
EndSelect
EndIf
EndProcedure
Procedure Easy_LNK(*Token.sToken)
DefType.l lngMemA, lngMemB
If *Token\tokType1 = #TYPMemory And *Token\tokType2 = #TYPMemory
lngMemA = @Speicher(Val(*Token\tokData1))
lngMemB = @Speicher(Val(*Token\tokData2))
CopyMemory(lngMemB, lngMemA, SizeOf(sMemory))
EndIf
EndProcedure
Procedure Easy_FLP(*Token.sToken)
DefType.l lngI, *lngMemA, *lngMemB
Debug "> Fliping Memory"
If *Token\tokType1 = #TYPLong
If *Token\tokData1 = "0": Dim SideMemy.sMemory(lngMemorySize): EndIf
For lngI = 0 To lngMemorySize
If *Token\tokData1 = "0" ; Save Memory
CopyMemory(@Speicher(lngI), SideMemy(lngI), SizeOf(sMemory))
Speicher(lngI)\MemPointer = AllocateMemory(4)
Speicher(lngI)\MemSize = 4
Speicher(lngI)\MemType = #TYPLong
If NextElement(Stack())
EndIf
Else ; Restore Memory
CopyMemory(@SideMemy(lngI), @Speicher(lngI), SizeOf(sMemory))
SideMemy(lngI)\MemPointer = AllocateMemory(4)
SideMemy(lngI)\MemSize = 4
SideMemy(lngI)\MemType = #TYPLong
EndIf
Next
EndIf
EndProcedure
Procedure Easy_LAD(*Token.sToken)
DefType.l lngI
Debug "> Move Stack"
For lngI = 0 To CountList(Stack())-1
SelectElement(Stack(), lngI)
If Stack()\stoType = #TYPString
SetString(Stack()\stoDataS, Speicher(lngI))
ElseIf Stack()\stoType = #TYPLong
SetLong(Stack()\stoDataL, Speicher(lngI))
EndIf
Debug ">> Move " + Str(lngI) + ": " + Str(Stack()\stoDataL) + " / " + Stack()\stoDataS
Next
ClearList(Stack())
EndProcedure
Procedure Easy_BYT(*Token.sToken)
DefType.s AssmResult
If *Token\tokType1 = #TYPMemory And *Token\tokType2 = #TYPLong
AssmResult = GetString(Speicher(Val(*Token\tokData1)))
AssmResult + Chr(Val(*Token\tokData2))
SetString(AssmResult ,Speicher(Val(*Token\tokData1)))
EndIf
EndProcedure
;- Sprung anweisungen
Procedure Easy_JMP(*Token.sToken)
DefType.l lngZeile, JMPPointer
lngZeile = ResolvePointer(*Token\tokData1)
If lngZeile <> -1
JMPPointer = ListIndex(Source())
SelectElement(Source(), lngZeile)
Debug "> Jump Command"
Debug ">> Jump to: " + Str(lngZeile)
Debug ">> Saved Point: " + Str(JMPPointer)
AddElement(JMPStack())
JMPStack() = JMPPointer
EndIf
EndProcedure
Procedure Easy_RET(*Token.sToken)
DefType.l JMPPointer
LastElement(JMPStack())
JMPPointer = JMPStack()
DeleteElement(JMPStack())
Debug "> Return Command"
Debug ">> Return to: " + Str(JMPPointer)
SelectElement(Source(), JMPPointer)
JMPPointer = 0
EndProcedure
Procedure Easy_GOT(*Token.sToken)
DefType.l lngZeile
lngZeile = ResolvePointer(*Token\tokData1)
If lngZeile <> -1
Debug "> Goto Command"
Debug ">> Goto: " + Str(lngZeile)
SelectElement(Source(), lngZeile)
EndIf
EndProcedure
;- AND,OR,XOR Operant
Procedure Easy_AND(*Token.sToken)
DefType.l SpeicherA, SpeicherB
Select *Token\tokType1
Case #TYPLong: SpeicherA = Val(*Token\tokData1)
Case #TYPMemory
If Speicher(Val(*Token\tokData1))\MemType = #TYPLong
SpeicherA = GetLong(Speicher(Val(*Token\tokData1)))
EndIf
EndSelect
Select *Token\tokType2
Case #TYPLong: SpeicherB = Val(*Token\tokData2)
Case #TYPMemory
If Speicher(Val(*Token\tokData2))\MemType = #TYPLong
SpeicherA = GetLong(Speicher(Val(*Token\tokData2)))
EndIf
EndSelect
SpeicherA = SpeicherA & SpeicherB
SetLong(SpeicherA, Speicher(0))
EndProcedure
Procedure Easy_OR(*Token.sToken)
DefType.l SpeicherA, SpeicherB
Select *Token\tokType1
Case #TYPLong: SpeicherA = Val(*Token\tokData1)
Case #TYPMemory
If Speicher(Val(*Token\tokData1))\MemType = #TYPLong
SpeicherA = GetLong(Speicher(Val(*Token\tokData1)))
EndIf
EndSelect
Select *Token\tokType2
Case #TYPLong: SpeicherB = Val(*Token\tokData2)
Case #TYPMemory
If Speicher(Val(*Token\tokData2))\MemType = #TYPLong
SpeicherA = GetLong(Speicher(Val(*Token\tokData2)))
EndIf
EndSelect
SpeicherA = SpeicherA | SpeicherB
SetLong(SpeicherA, Speicher(0))
EndProcedure
Procedure Easy_XOR(*Token.sToken)
DefType.l SpeicherA, SpeicherB
Select *Token\tokType1
Case #TYPLong: SpeicherA = Val(*Token\tokData1)
Case #TYPMemory
If Speicher(Val(*Token\tokData1))\MemType = #TYPLong
SpeicherA = GetLong(Speicher(Val(*Token\tokData1)))
EndIf
EndSelect
Select *Token\tokType2
Case #TYPLong: SpeicherB = Val(*Token\tokData2)
Case #TYPMemory
If Speicher(Val(*Token\tokData2))\MemType = #TYPLong
SpeicherA = GetLong(Speicher(Val(*Token\tokData2)))
EndIf
EndSelect
SpeicherA = SpeicherA ! SpeicherB
SetLong(SpeicherA, Speicher(0))
EndProcedure
;- Structure Construct
Procedure Easy_STC(*Token.sToken)
DefType.l NeedMem, CurrentMem
ForEach StructStack()
Select StructStack()
Case "0" NeedMem + 1: Case "1" NeedMem + 2
Case "2" NeedMem + 4: Case "3" NeedMem + 4
EndSelect
Next
If *Token\tokData1 = #TYPMemory And NeedMem > 0
FreeMemory(Speicher(*Token\tokData1)\MemPointer)
Speicher(*Token\tokData1)\MemPointer = AllocateMemory(NeedMem)
Speicher(*Token\tokData1)\MemSize = 0
Speicher(*Token\tokData1)\MemType = #TYPPointer
ForEach StructStack()
If StructStack() = #STCString
PokeL(Speicher(*Token\tokData1)\MemPointer+CurrentMem, AllocateMemory(0))
EndIf
Select StructStack()
Case "0" CurrentMem + 1: Case "1" CurrentMem + 2
Case "2" CurrentMem + 4: Case "3" CurrentMem + 4
EndSelect
Next
EndIf
EndProcedure
Procedure Easy_STB(*Token.sToken)
DefType.l lngNewMem
If *Token\tokData1 = #TYPLong
AddElement(StructStack())
Select *Token\tokData2
Case "0": StructStack() = #STCByte
Case "1": StructStack() = #STCWord
Case "2": StructStack() = #STCDWord
Case "3": StructStack() = #STCString
EndSelect
EndIf
EndProcedure
;- Vergleich Funktionen
Procedure Easy_CMP(*Token.sToken)
DefType.sMemory CMPMemberA, CMPMemberB
DefType.l lngMemberA, lngMemberB
DefType.s strMemberA, strMemberB
Select *Token\tokType1
Case #TYPLong
CMPMemberA\MemPointer = AllocateMemory(4)
CMPMemberA\MemType = #TYPLong
CMPMemberA\MemSize = 4
PokeL(CMPMemberA\MemPointer, Val(*Token\tokData1))
Case #TYPString
CMPMemberA\MemPointer = AllocateMemory(Len(*Token\tokData1)+1)
CMPMemberA\MemType = #TYPString
CMPMemberA\MemSize = Len(*Token\tokData1)
PokeS(CMPMemberA\MemPointer, *Token\tokData1, Len(*Token\tokData1))
Case #TYPMemory
CopyMemory(Speicher(Val(*Token\tokData1)), CMPMemberA, SizeOf(sMemory))
EndSelect
Select *Token\tokType2
Case #TYPLong
CMPMemberB\MemPointer = AllocateMemory(4)
CMPMemberB\MemType = #TYPLong
CMPMemberB\MemSize = 4
PokeL(CMPMemberB\MemPointer, Val(*Token\tokData2))
Case #TYPString
CMPMemberB\MemPointer = AllocateMemory(Len(*Token\tokData2)+1)
CMPMemberB\MemType = #TYPString
CMPMemberB\MemSize = Len(*Token\tokData2)
PokeS(CMPMemberB\MemPointer, *Token\tokData2, Len(*Token\tokData2))
Case #TYPMemory
CopyMemory(Speicher(Val(*Token\tokData2)), CMPMemberB, SizeOf(sMemory))
EndSelect
Debug "> Compare Command:"
If CMPMemberA\MemType = CMPMemberB\MemType
Debug ">> Compare Members:"
Select CMPMemberA\MemType
Case #TYPLong
lngMemberA = PeekL(CMPMemberA\MemPointer)
lngMemberB = PeekL(CMPMemberB\MemPointer)
Debug ">> MemberA: " + Str(lngMemberA)
Debug ">> MemberB: " + Str(lngMemberB)
If lngMemberA = lngMemberB
CMPResult = #CMPEqual
Debug ">> Compare: Equal"
ElseIf lngMemberA < lngMemberB
CMPResult = #CMPLower
Debug ">> Compare: Lower"
ElseIf lngMemberA > lngMemberB
CMPResult = #CMPHigher
Debug ">> Compare: Higher"
EndIf
Case #TYPString
strMemberA = PeekS(CMPMemberA\MemPointer, CMPMemberA\MemSize)
strMemberB = PeekS(CMPMemberB\MemPointer, CMPMemberB\MemSize)
Debug ">> MemberA: " + strMemberA
Debug ">> MemberB: " + strMemberB
If strMemberA = strMemberB
CMPResult = #CMPEqual
Debug ">> Compare: Equal"
ElseIf Len(strMemberA) < Len(strMemberB)
CMPResult = #CMPLower
Debug ">> Compare: Lower"
ElseIf Len(strMemberA) > Len(strMemberB)
CMPResult = #CMPHigher
Debug ">> Compare: Higher"
Else
CMPResult = #CMPNotEqual
Debug ">> Compare: Not Equal"
EndIf
EndSelect
Else
Debug ">> Compare failed !"
Debug ">> Members are diffrent !"
Debug ">> MemberA: " + Str(CMPMemberA\MemType)
Debug ">> MemberB: " + Str(CMPMemberB\MemType)
EndIf
EndProcedure
Procedure Easy_JL(*Token.sToken)
DefType.l lngZeile
If CMPResult = #CMPLower
lngZeile = ResolvePointer(*Token\tokData1)
If lngZeile <> -1
Debug "> Jump on lower"
Debug ">> Goto: " + Str(lngZeile)
SelectElement(Source(), lngZeile)
EndIf
EndIf
EndProcedure
Procedure Easy_JNL(*Token.sToken)
DefType.l lngZeile
If CMPResult <> #CMPLower And CMPResult <> #CMPWrong
lngZeile = ResolvePointer(*Token\tokData1)
If lngZeile <> -1
Debug "> Jump not lower"
Debug ">> Goto: " + Str(lngZeile)
SelectElement(Source(), lngZeile)
EndIf
EndIf
EndProcedure
Procedure Easy_JE(*Token.sToken)
DefType.l lngZeile
If CMPResult = #CMPEqual
lngZeile = ResolvePointer(*Token\tokData1)
If lngZeile <> -1
Debug "> Jump equals"
Debug ">> Goto: " + Str(lngZeile)
SelectElement(Source(), lngZeile)
EndIf
EndIf
EndProcedure
Procedure Easy_JNE(*Token.sToken)
DefType.l lngZeile
If CMPResult <> #CMPEqual And CMPResult <> #CMPWrong
lngZeile = ResolvePointer(*Token\tokData1)
If lngZeile <> -1
Debug "> jump not equals"
Debug ">> Goto: " + Str(lngZeile)
SelectElement(Source(), lngZeile)
EndIf
EndIf
EndProcedure
Procedure Easy_JG(*Token.sToken)
DefType.l lngZeile
If CMPResult = #CMPHigher
lngZeile = ResolvePointer(*Token\tokData1)
If lngZeile <> -1
Debug "> jump greater"
Debug ">> Goto: " + Str(lngZeile)
SelectElement(Source(), lngZeile)
EndIf
EndIf
EndProcedure
Procedure Easy_JNG(*Token.sToken)
DefType.l lngZeile
If CMPResult <> #CMPHigher And CMPResult <> #CMPWrong
lngZeile = ResolvePointer(*Token\tokData1)
If lngZeile <> -1
Debug "> jump not greater"
Debug ">> Goto: " + Str(lngZeile)
SelectElement(Source(), lngZeile)
EndIf
EndIf
EndProcedure
;- Lib Call Befehle
Procedure Easy_STO(*Token.sToken)
DefType.l lngPointer, lngMemSize
Debug "> Store Data"
Select *Token\tokType1
Case #TYPLong
AddElement(Stack())
Stack()\stoDataL = Val(*Token\tokData1)
Stack()\stoType = #TYPLong
Debug ">> Store Long"
Case #TYPString
AddElement(Stack())
Stack()\stoDataS = *Token\tokData1
Stack()\stoType = #TYPString
Debug ">> Store String"
Case #TYPMemory
AddElement(Stack())
lngPointer = Speicher(Val(*Token\tokData1))\MemPointer
lngMemSize = Speicher(Val(*Token\tokData1))\MemSize
Select Speicher(Val(*Token\tokData1))\MemType
Case #TYPLong
If Speicher(Val(*Token\tokData1))\MemType = #TYPLong
Stack()\stoDataL = PeekL(lngPointer)
Stack()\stoType = #TYPLong
EndIf
Debug ">> Store Long (from Memory)"
Case #TYPString
If Speicher(Val(*Token\tokData1))\MemType = #TYPString
Stack()\stoDataS = PeekS(lngPointer, lngMemSize)
Stack()\stoType = #TYPString
EndIf
Debug ">> Store String (from Memory)"
Case #TYPPointer
If Speicher(Val(*Token\tokData1))\MemType = #TYPString
Stack()\stoDataL = PeekL(lngPointer)
Stack()\stoType = #TYPPointer
EndIf
Debug ">> Store Pointer (from Memory)"
EndSelect
Case #TYPPointer
AddElement(Stack())
Stack()\stoDataL = Speicher(Val(*Token\tokData1))\MemPointer
Stack()\stoType = #TYPPointer
Debug ">> Store Pointer"
EndSelect
Debug "------ END STO CMD ------"
EndProcedure
Procedure Easy_OPN(*Token.sToken)
DefType.s strLibName
Select *Token\tokType1
Case #TYPString
strLibName = *Token\tokData1
Case #TYPMemory
If Speicher(Val(*Token\tokData1))\MemType = #TYPString
strLibName = GetString(Speicher(Val(*Token\tokData1)))
EndIf
EndSelect
SetLong(OpenLibrary(#PB_Any, strLibName), Speicher(Val(*Token\tokData2)))
EndProcedure
Procedure Easy_CLS(*Token.sToken)
DefType.l lngLibPtr
Select *Token\tokType1
Case #TYPLong
lngLibPtr = Val(*Token\tokData1)
Case #TYPMemory
If Speicher(Val(*Token\tokData1))
lngLibPtr = GetLong(Speicher(Val(*Token\tokData1)))
EndIf
EndSelect
If lngLibPtr <> 0
CloseLibrary(lngLibPtr)
EndIf
EndProcedure
Procedure Easy_CAL(*Token.sToken)
DefType.s FunkName
DefType.l lngLibPtr
; LibraryPointer
Select *Token\tokType1
Case #TYPLong : lngLibPtr = Val(*Token\tokData1)
Case #TYPMemory: lngLibPtr = GetLong(Speicher(Val(*Token\tokData1)))
EndSelect
; FunkName
Select *Token\tokType2
Case #TYPString: FunkName = *Token\tokData2
Case #TYPMemory: FunkName = GetString(Speicher(Val(*Token\tokData2)))
EndSelect
lngFunkPtr = IsFunction(lngLibPtr, FunkName)
Debug "> Lib CALL"
Debug ">> FunkName: " + FunkName
Debug ">> LibPtr: " + Str(lngLibPtr)
Debug ">> CalPtr: " + Str(lngFunkPtr)
If lngFunkPtr <> 0
ForEach Stack()
If Stack()\stoType = #TYPString
lngDataPush = @Stack()\stoDataS
Else
lngDataPush = Stack()\stoDataL
EndIf
!PUSH dword [v_lngDataPush]
Next
!CALL [v_lngFunkPtr]
!MOV dword [v_lngResult], Eax
SetLong(lngResult, Speicher(0))
Debug ">> Lib CALL Result: " + Str(GetLong(Speicher(0)))
ClearList(Stack())
EndIf
EndProcedure
;- Sonstige Funktionen
Procedure SetString(strString.s, *MemPoint.sMemory)
If *MemPoint\MemSize < Len(strString)
*MemPoint\MemPointer = ReAllocateMemory(*MemPoint\MemPointer, Len(strString))
EndIf
PokeS(*MemPoint\MemPointer, strString);, Len(strString))
*MemPoint\MemSize = Len(strString)
*MemPoint\MemType = #TYPString
EndProcedure
Procedure.s GetString(*MemPoint.sMemory)
If *MemPoint\MemType = #TYPString
ProcedureReturn PeekS(*MemPoint\MemPointer, *MemPoint\MemSize)
Else
ProcedureReturn ""
EndIf
EndProcedure
Procedure SetLong(lngLong.l, *MemPoint.sMemory)
If *MemPoint\MemSize > 4
*MemPoint\MemPointer = ReAllocateMemory(*MemPoint\MemPointer, 4)
EndIf
PokeL(*MemPoint\MemPointer, lngLong)
*MemPoint\MemSize = 4
*MemPoint\MemType = #TYPLong
EndProcedure
Procedure.l GetLong(*MemPoint.sMemory)
If *MemPoint\MemType = #TYPLong
ProcedureReturn PeekL(*MemPoint\MemPointer)
Else
ProcedureReturn 0
EndIf
EndProcedure
Procedure.s AssembleParameter()
DefType.s tmpParameter, strResult
Repeat
tmpParameter = ProgramParameter()
If tmpParameter <> "": strResult + tmpParameter + " ": EndIf
Until tmpParameter = ""
ProcedureReturn Trim(strResult)
EndProcedure
Procedure.l ReadStructure(*Var.AllTypes, *Source.l, *Struc.BYTE)
DefType.l Length
DefType.l Differenz
Differenz = *Source
While *Struc\b
Select *Struc\b
Case 'b': CopyMemory(*Source, *Var, 1): *Var + 1: *Source + 1
Case 'w': CopyMemory(*Source, *Var, 2): *Var + 2: *Source + 2
Case 'l': CopyMemory(*Source, *Var, 4): *Var + 4: *Source + 4
Case 'f': CopyMemory(*Source, *Var, 4): *Var + 4: *Source + 4
Case 's'
Length = PeekL(*Source) : *Source + 4
*Var\s = PeekS(*Source, Length): *Source + Length
*Var + 4
EndSelect
*Struc + 1
Wend
ProcedureReturn *Source-Differenz
EndProcedure
Procedure.l ResolvePointer(strPtrName.s)
ForEach Points()
If Points()\potName = strPtrName
ProcedureReturn Points()\potZeile
EndIf
Next
ProcedureReturn -1
EndProcedure
Procedure.l MemCopy(*SorcMem.sMemory, *DestMem.sMemory)
DefType.l NewMem
If *DestMem\MemSize < *SorcMem\MemSize
NewMem = ReAllocateMemory(*DestMem\MemPointer, *SorcMem\MemSize)
If NewMem <> 0: *DestMem\MemPointer = NewMem: EndIf
EndIf
CopyMemory(*SorcMem\MemPointer, *DestMem\MemPointer, *SorcMem\MemSize)
*DestMem\MemSize = *SorcMem\MemSize
*DestMem\MemType = *SorcMem\MemType
EndProcedureCode: Alles auswählen
Structure sToken
tokBefehl.s
tokData1.s
tokType1.l
tokData2.s
tokType2.l
EndStructure
Structure sPointer
potName.s
potZeile.l
EndStructure
Structure AllTypes
StructureUnion
b.b
w.w
l.l
f.f
s.s
EndStructureUnion
EndStructure
Enumeration
#TYPString
#TYPLong
#TYPMemory
#TYPPointer
EndEnumeration
IncludeFile "EasyCompiler.pb.declare"
Global DateiOuthWnd1.l ; Code
Global DateiOuthWnd2.l ; Pointer
NewList SourceCode.sToken()
NewList StdPointer.sPointer()
NewList Includes.s()
cMain()
End
;- HauptProgramm
Procedure cMain()
DefType.s DateiName
OpenConsole()
DateiName = ReplaceString(ProgramParameter(), Chr(34), "")
DateiOuthWnd1 = CreateFile(#PB_Any, "Code.OBJ")
DateiOuthWnd2 = CreateFile(#PB_Any, "Ptr.OBJ")
CPrint("****************************************************" + #STX$, #False)
CPrint("Easy Compiler V.: 0.2 " + #STX$, #False)
CPrint("****************************************************" + #STX$, #False)
CPrint(#STX$, #False)
SetCurrentDirectory_(GetPathPart(DateiName))
If FileSize(DateiName) > 0
LoadFile(DateiName)
CPrint("Verarbeitete Zeilen Code: ", #True)
CPrint(Str(ListIndex(StdPointer()) + ListIndex(SourceCode()) + 2) + #STX$, #False)
CPrint("Starte Compileren..." + #STX$, #True)
UseFile(DateiOuthWnd1)
ForEach SourceCode(): WriteStructure(SourceCode(), @"sslsl"): Next
UseFile(DateiOuthWnd2)
ForEach StdPointer(): WriteStructure(StdPointer(), @"sl") : Next
CloseFile(DateiOuthWnd1)
CloseFile(DateiOuthWnd2)
CPrint("Fuehre Dateien zusammen..." + #STX$, #True)
DateiName = Left(DateiName, FindString(DateiName, ".", 1)-1) + ".ezb"
DeleteFile(DateiName)
VBinAdd(DateiName, "Code.OBJ", "", 9)
VBinAdd(DateiName, "Ptr.OBJ" , "", 9)
ForEach Includes(): VBinAdd(DateiName, Includes(), "", 9): Next
CPrint("Programm erfolgreich compiliert !" + #STX$, #True)
Else
If DateiName = ""
CPrint("Bitte geben Sie eine Datei an !" + #STX$, #True)
Else
If FileSize(DateiName) = -1
CPrint("^CFehler^7: Die Datei wurde nicht gefunden !" + #STX$, #True)
ElseIf FileSize(DateiName) = -2
CPrint("^CFehler^7: Die Datei ist ein Verzeichniss !" + #STX$, #True)
EndIf
EndIf
EndIf
EndProcedure
;- Sonstige Funktionen
Procedure WriteStructure(*Var.AllTypes, *Struc.BYTE)
DefType.l lngLength
While *Struc\b
Select *Struc\b
Case 'b': WriteData(*Var, 1) : *Var + 1
Case 'w': WriteData(*Var, 2) : *Var + 2
Case 'l': WriteData(*Var, 4) : *Var + 4
Case 'f': WriteData(*Var, 4) : *Var + 4
Case 's'
Length = Len(*Var\s)
WriteData(@Length, 4)
If Length
WriteData(*Var\l, Length)
EndIf
*Var + 4
EndSelect
*Struc + 1
Wend
EndProcedure
Procedure LoadFile(strDateiname.s)
DefType.l FilehWnd
DefType.s tmpZeile
If FileSize(strDateiname) > 0
CPrint("Verarbeite Datei ^8" + GetFilePart(strDateiname) + "^7..." + #STX$, #True)
FilehWnd = ReadFile(#PB_Any, strDateiname)
UseFile(FilehWnd)
While Eof(FilehWnd) = #False
UseFile(FilehWnd)
tmpZeile = ReplaceString(LTrim(ReadString()), Chr(9),"")
Select Left(tmpZeile, 1)
Case ";"
Case "%" ; Include Binärdatei
AddElement(Includes())
Includes() = Mid(tmpZeile, 2, Len(tmpZeile))
Case "$" ; Include Datei
LoadFile(Mid(tmpZeile, 2, Len(tmpZeile)))
Case "." ; Pointer
If ListIndex(SourceCode()) <> -1
AddElement(StdPointer())
StdPointer()\potName = Mid(tmpZeile, 2, Len(tmpZeile))
StdPointer()\potZeile = ListIndex(SourceCode())
Debug "Jumpmark " + StdPointer()\potName + " at " + Str(StdPointer()\potZeile)
EndIf
Default
If tmpZeile <> ""
AddElement(SourceCode())
SourceCode()\tokBefehl = LCase(Trim(StringField(tmpZeile, 1, ";")))
SourceCode()\tokData1 = StringField(StringField(tmpZeile, 2, ";"), 1, ",")
SourceCode()\tokData2 = StringField(StringField(tmpZeile, 2, ";"), 2, ",")
Select Left(SourceCode()\tokData1, 1)
Case "#" ; Zahl
SourceCode()\tokType1 = #TYPLong
SourceCode()\tokData1 = Mid(SourceCode()\tokData1, 2, Len(SourceCode()\tokData1))
Case "*" ; String
SourceCode()\tokType1 = #TYPString
SourceCode()\tokData1 = Mid(SourceCode()\tokData1, 2, Len(SourceCode()\tokData1))
Case "@" ; Pointer
SourceCode()\tokType1 = #TYPPointer
SourceCode()\tokData1 = Mid(SourceCode()\tokData1, 2, Len(SourceCode()\tokData1))
Default ; Speicher
SourceCode()\tokType1 = #TYPMemory
EndSelect
Select Left(SourceCode()\tokData2, 1)
Case "#" ; Zahl
SourceCode()\tokType2 = #TYPLong
SourceCode()\tokData2 = Mid(SourceCode()\tokData2, 2, Len(SourceCode()\tokData2))
If isNumeric(SourceCode()\tokData1) = #False
CPrint("^CERROR^7: In Zeile " + Str(ListIndex(SourceCode())) + ", Longzuweisung enthält keine Long Variable !"+#STX$, #True)
EndIf
Case "*" ; String
SourceCode()\tokType2 = #TYPString
SourceCode()\tokData2 = Mid(SourceCode()\tokData2, 2, Len(SourceCode()\tokData2))
Case "@" ; Pointer
SourceCode()\tokType2 = #TYPPointer
SourceCode()\tokData2 = Mid(SourceCode()\tokData2, 2, Len(SourceCode()\tokData2))
Default ; Speicher
SourceCode()\tokType2 = #TYPMemory
EndSelect
EndIf
EndSelect
Wend
CloseFile(FilehWnd)
EndIf
EndProcedure
Procedure CPrint(pText.s, Head.b)
DefType.l i
DefType.s Color, tmpStr
CharToOEM_(@pText, @pText)
If Head = #True
CPrint("^8> ", #False)
ConsoleColor(7, 0)
EndIf
For i = 1 To Len(pText)
If Mid(pText, i, 1) = "^"
Color = UCase(Mid(pText, i + 1, 1))
Select Color
Case "0": Color = "0" ; 0 Schwarz -_-
Case "1": Color = "1" ; 1 Blau
Case "2": Color = "2" ; 2 Grün
Case "3": Color = "3" ; 3 Türkis
Case "4": Color = "4" ; 4 Rot
Case "5": Color = "5" ; 5 Magenta
Case "6": Color = "6" ; 6 Braun
Case "7": Color = "7" ; 7 Hellgrau (Std.)
Case "8": Color = "8" ; 8 Dunkelgrau
Case "9": Color = "9" ; 9 Hellblau
Case "A": Color = "10" ; 10 Hellgrün
Case "B": Color = "11" ; 11 Cyan
Case "C": Color = "12" ; 12 Hellrot
Case "D": Color = "13" ; 13 Helles Magenta
Case "E": Color = "14" ; 14 Gelb
Case "F": Color = "15" ; 15 Weiß
Default:Print(Mid(pText, i, 2))
EndSelect
ConsoleColor(Val(Color), 0)
i + 1
ElseIf Mid(pText, i, 1) = Chr(2)
PrintN("")
Else
Print(Mid(pText, i, 1))
EndIf
Next
ConsoleColor(7, 0)
EndProcedure
Procedure.b isNumeric(strZahl.s)
DefType.b bytResult
DefType.l lngCount
DefType.s strTmpChar
bytResult = #True
For lngCount = 1 To Len(strZahl)
strTmpChar = Mid(strZahl, lngCount, 1)
If Asc(strTmpChar) < '0' Or Asc(strTmpChar) > '9'
bytResult = #False
Break
EndIf
Next
ProcedureReturn bytResult
EndProcedureVerfasst: 22.01.2005 01:11
Bau mal eine Funktion ein in der man DLL/LIB Funktionen ausführen kann. Dann könnte ich dafür Librarys Programmieren. Voila, wir hätten eine Programmiersprachen.
Verschiedene Typen und Mind. Linkedlists müssten aber zuvor auch noch gehen. *g*
cu
Verschiedene Typen und Mind. Linkedlists müssten aber zuvor auch noch gehen. *g*
cu