Easy - Compiler / Interpreter

Kyoko12 · Beitrag von **Kyoko12** » 06.01.2005 18:09

Sag mal, ist das nciht so ne art Assambler?

MVXA · Beitrag von **MVXA** » 06.01.2005 18:44

Verdammt entfernt aber hat schon eine gewisse ähnlichkeit. Ich arbeite aber an einer neuen und hofentlich finalen Version

.

freedimension · Beitrag von **freedimension** » 06.01.2005 18:55

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 !

Dein Z ist kaputt!

MVXA · Beitrag von **MVXA** » 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.

MVXA · Beitrag von **MVXA** » 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

.

MVXA · Beitrag von **MVXA** » 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

.

Beitrag von **Kiffi** » 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

MVXA · Beitrag von **MVXA** » 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.

MVXA · Beitrag von **MVXA** » 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:

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
EndProcedure

Compiler:

Code: 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
EndProcedure

ShadowTurtle · Beitrag von **ShadowTurtle** » 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