Aktuelle Zeit: 26.05.2017 20:59

Alle Zeiten sind UTC + 1 Stunde [ Sommerzeit ]




Ein neues Thema erstellen Auf das Thema antworten  [ 28 Beiträge ]  Gehe zu Seite Vorherige  1, 2, 3
Autor Nachricht
 Betreff des Beitrags: Re: Tutorial - Compiler und Virtual Machine (nicht beschreib
BeitragVerfasst: 27.10.2013 19:59 
Offline
Benutzeravatar

Registriert: 06.09.2013 22:02
Code:
; XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
; X                                                                 X
; X   TTC COMPILER 0.5: TinyToyC (TTCC) (TEIL ZWEI)                 X
; X                                                                 X
; X   HAUPTDATEI                                                    X
; X                                                                 X
; XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX


XIncludeFile "Scanner05.pbi"
XIncludeFile "Parser05.pbi"
XIncludeFile "Assembler05.pbi"
XIncludeFile "VirtualMachine05.pbi"


; *******************************************************************
; * Compiler Version TTCC                                           *
; *******************************************************************
DeclareModule TTCCompiler05
; =
; = Public Declarations =============================================
; = 
    ; --- Start-Prozedur --- 
      Declare Start(file_name.s)

EndDeclareModule
Module TTCCompiler05

  Procedure Start(file_name.s)
 
    ; Schritte zum fertigen TTC-Executable
      TTCParser05::Start(file_name)
      TTCAssembler05::Start(file_name)
      TTCVirtualMachine05::Start(file_name)
     
  EndProcedure
 
EndModule


; *******************************************************************
; * Debug-Prozeduren (außerhalb der Module)                         *
; *******************************************************************
Procedure Debug_GetChar()
   
  ; --> wir laden Start_GetChar() aus Debug-Zwecken
  ; --> später heißt die Prozedur nur mehr Start()   
 
    Scanner::Start_GetChar("source-code.ttcs")

    While ( Scanner::Look <> 0 )
        Debug " | "+Chr(Scanner::Look)+       ; CHAR des ASCII-Codes
              " | "+Scanner::Look             ; CHAR-Code in Look
        Scanner::GetChar()
    Wend
    Debug "0-Byte: außerhalb der While-Schleife"

EndProcedure
Procedure Debug_GetToken() 
   
  Scanner::Start("source-code.ttcs")

  While ( Scanner::Token <> 0 )
        Debug " | "+Chr(Scanner::Token)+              ; CHAR des Token-Codes
              " | "+RSet(Str(Scanner::Token),3," ")+  ; Code-Nr des Tokens
              " | "+Scanner::Lexem                    ; Lexem
        Scanner::GetToken() 
  Wend   
  Debug "0-Token: außerhalb der While-Schleife"

EndProcedure


; Aufruf je nach Ziel:

; Debug_GetChar()
; Debug_GetToken()
TTCCompiler05::Start("source-code.ttcs") ; .ttcs = Tiny Toy C Source

_________________
Windows 7 und Windows 10 (Laptop), PB 5.60 | Projekt: Tutorial - Compiler und Virtual Machine | vielleicht einmal ein Old School Text-Adventure Tutorial | Neu: Spielereien, Üben rund um OOP in PB


Zuletzt geändert von puretom am 15.11.2013 23:55, insgesamt 7-mal geändert.

Nach oben
 Profil  
Mit Zitat antworten  
 Betreff des Beitrags: Re: Tutorial - Compiler und Virtual Machine (nicht beschreib
BeitragVerfasst: 28.10.2013 19:10 
Offline
Benutzeravatar

Registriert: 06.09.2013 22:02
Code:
; *******************************************************************
; * Scanner Version TTCS 0.5                                        *
; *                                                                 *
; *   ist das Include-File: Scanner05.pbi                           *
; *                         ^^^^^^^^^^^^^                           *
; *******************************************************************
DeclareModule Scanner   
; -
; - Public Declarations ---------------------------------------------
; - 

    ; --- public globale Variablen ---

      Global Look      ; Look Ahead Character
      Global Token     ; Token-Typ als Zahl
      Global Lexem.s   ; Lexem = Token als String
   
    ; --- Start- & Stop-Prozedur --- 
   
      Declare Start(file_name.s="") ; Filename des Source-Files
      Declare Stop()

    ; --- Look Ahead Character holen mit dieser Prozedur ---
   
      Declare GetChar()   ; holt nächsten Character von *Source_Code                                   

    ; --- Token-Lexem-Paare holen mit diesen Prozeduren ---
   
      Declare GetToken()             ; holt nächstes Token-Lexem-Paar
      Declare GetName()              ; holt nächsten Name
      Declare GetNumber()            ; holt nächste Zahl                                     
      Declare GetString()            ; holt nächsten String   
      Declare GetOther()             ; holt Rest                     

    ; --- Fehlermeldung ausgeben ---
   
      Declare Error(error_message.s)      ; zeigt Meldung, Scanende
      Declare Expected(expected_object.s) ; zeigt, was erwartet
                                          ; wurde, dann Scanende                             
    ; --- Is?-Erkennungs-Macros ---
     
      Macro IsNumber(c)    ; Zeichen gehört zu einer Zahl?
        (c>='0' And c<='9')
      EndMacro          
      Macro IsName1(c)     ; Zeichen ist Start eines Namens?
        ((c>='a' And c<='z') Or (c>='A' And c<='Z'))
      EndMacro          
      Macro IsName(c)      ; Zeichen gehört zu einem Namen?
        (IsNumber(c) Or IsName1(c) Or c='_')
      EndMacro          
      Macro IsString(c)    ; Zeichen ist der Start eines Strings?
        c='"'
      EndMacro          
      Macro IsWhite(c)     ; Zeichen ist ein White-Character?
        (c=' ' Or c=#TAB Or c='/' Or c=';' Or c='¶')
      EndMacro          
 
    ; --- Debug-Prozeduren (Im Release löschen) ---
   
      Declare Start_GetChar(file_name.s)   

    ; Anmerkung: / startet einen Zeilenkommentar mit '//' (wie in C)
    ;            / startet einen Blockkommentar mit  '/*' (wie in C) 
                                         
EndDeclareModule
Module Scanner
; -
; - Private Declarations --------------------------------------------
; -
   
  ; --- globale Variablen ---

    Global *Source_Code        ; Source Code im Speicher
    Global *Source_Pos.ASCII   ; nächste Zeichen-Lese-Position
     
  ; --- Lade Source-File ---
 
    Declare Load(file_name.s)  ; lädt das Text-Zeichen-Source-File         

  ; --- Skip - Prozeduren ---
 
    Declare SkipWhite()        ; überspringt  White-Zeichen
    Declare SkipLineComment()  ; überspringt ab Comment-Start bis #eol
    Declare SkipBlockComment() ; überspringt von Block-Start bis -Ende

; -
; - Start- & Stop-Prozedur ------------------------------------------
; -
  Procedure Start(file_name.s="")
 
    ; laden des Source-Files in Memory-Bereich *Source_Code
    ; Wenn Argument leer, dann kein neues Laden! 
      If file_name<>"":Load(file_name.s):EndIf
     
    ; '*Source_Pos' auf 1. Zeichen stellen
      *Source_Pos = *Source_Code     
     
    ; das erste aktuelle Token-Lexem-Paar holen 
      Lexem = ""   ; falls kein Neuladen erfolgt ist
      GetChar()    ; 1. Zeichen in Zeichen-Strom
      SkipWhite()  ; alle White bis zum 1. gültigen Look
      GetToken()   ; anhand dieses Look erstes Token-Lexem-Paar holen     
     
    ; --> ab hier ist alles zum Parser-Start vorbereitet
    ; --> ein gültiges Token-Lexem-Paar liegt bereit
    ; --> der Parser kann übernehmen und weitermachen   
 
  EndProcedure 
  Procedure Stop()
      FreeMemory(*Source_Code) 
  EndProcedure
  ;
  Procedure Start_GetChar(file_name.s)
 
    ; --> Die Prozedur heißt aus Debug-Gründen Start_GetChar()
    ; --> Die echte Start-Prozedur wird nur mehr Start() heißen
 
    ; laden des Source-Files   
      Load(file_name.s)     
     
    ; '*Source_Pos' auf 1. Zeichen stellen
      *Source_Pos = *Source_Code
           
    ; das erste aktuelle Zeichen (Look) holen 
      GetChar()   
     
    ; --> ab hier ist alles zum Character-Stream-Test bereit
    ; --> ein gültiger Look liegt im Stream
 
  EndProcedure 

; - Lade Source-File ------------------------------------------------
; -
  Procedure Load(file_name.s)
     
    ; lade Source-File mit Filename   
      file = ReadFile(#PB_Any,file_name)   
      If Not file
          Error("Scanner: Das Source-File "+#DQUOTE$+file_name+#DQUOTE$+
                " konnte nicht geöffnet werden.")
      EndIf     
     
    ; speichere Source-File in Memory-Bereich                               
      size = Lof(file)
      *Source_Code = AllocateMemory(size+1) ; damit am Ende 0-Byte 
      ReadData(file, *Source_Code, size)     
      CloseFile(file)
   
  EndProcedure
 
; - Get - Prozeduren ------------------------------------------------
; -
  Procedure GetChar()   
           
    ; Look aus dem Source-Code-Stream holen
      Look = *Source_Pos\a 
      *Source_Pos+1               

    ; alle möglichen Zeilenenden zu '¶' umwandeln
    ; in '¶'=182: End of Line, Zeilenende   
      If Look=#CR Or Look=#LF: Look='¶': EndIf   
         
  EndProcedure     
  Procedure GetToken()

    ; --> in Look ist das 1. Zeichen dieses Token-Lexems
       
    ; Entscheide, welcher Token-Typ vorliegt und verzweige entsprechend   
      If      IsNumber(Look): GetNumber()
      ElseIf  IsName1 (Look): GetName()
      ElseIf  IsString(Look): GetString()
      Else                  : GetOther()   
      EndIf       
   
    ; ueberspringe alle White Characters und Comments (zur Sicherheit)
      SkipWhite()
         
    ; --> in Look ist jetzt das 1. Zeichen des nächsten Token-Lexems         
         
  EndProcedure   
  Procedure GetName()

    ; --> in Look ist das 1. Zeichen dieses Token-Lexems
       
    ; 1. Zeichen korrekt fuer Name?
      If Not IsName1(Look):Expected("Ein Variablen- oder Prozedurname"+
                                    " oder ein Toy-C-Befehlswort")
      EndIf 
   
    ; Token mit Token-Code (=78) für Name füllen
      Token = 'N'

    ; Lexem mit Name füllen
      Lexem = ""       
      Repeat
          Lexem = Lexem + Chr(Look)
          GetChar()
      Until Not IsName(Look)

    ; Name-Identifier sind nicht Case sensitiv     
      Lexem = LCase(Lexem)         
     
    ; am Ende ueberspringe alle White Characters und Comments
      SkipWhite()       
 
    ; --> in Look ist jetzt das 1. Zeichen des nächsten Token-Lexems
 
  EndProcedure
  Procedure GetNumber()
 
    ; --> in Look ist jetzt das 1. Zeichen dieses Token-Lexems
 
    ; 1. Zeichen korrekt fuer Number?
      If Not IsNumber(Look):Expected("Integer"):EndIf 
     
    ; Token mit Token-Code (=73) für Integer füllen
      Token = 'I'
     
    ; Lexem mit Integer füllen
      Lexem = ""       
      Repeat
          Lexem = Lexem + Chr(Look)
          GetChar()
      Until Not IsNumber(Look) 
       
    ; ueberspringe alle White Characters und Comments
      SkipWhite() 
 
    ; --> in Look ist jetzt das 1. Zeichen des nächsten Token-Lexems

  EndProcedure
  Procedure GetString()
 
    ; --> in Look ist jetzt das 1. Zeichen dieses Token-Lexems
 
    ; 1. Zeichen korrekt fuer String?
      If Not IsString(Look):Expected("String"):EndIf 
     
    ; Token mit Token-Code (=83) für String füllen
      Token = 'S'
     
    ; '"' String-Start-Zeichen überspringen
      GetChar() 
     
    ; Lexem mit String füllen
    ; bis Ende-Zeichen '"'
      Lexem = ""       
      While Not IsString(Look)
          Lexem = Lexem + Chr(Look)
          GetChar()
      Wend
     
    ; String-Ende-Zeichen überspringen '"'
      GetChar()
           
    ; ueberspringe alle White Characters und Comments
      SkipWhite() 
 
    ; --> in Look ist jetzt das 1. Zeichen des nächsten Token-Lexems

  EndProcedure   
  Procedure GetOther()

    ; --> in Look ist jetzt das 1. Zeichen dieses Token-Lexems
     
     ; Look sichern
       look1 = Look
     
     ; nächsten nicht-White-Character holen (siehe SkipWhite())
       GetChar()
       
     ; ueberspringe alle White Characters und Comments     
       SkipWhite()           
     
     ; ** mehrteilige Operatoren testen und abschicken **
       If     look1='<' And Look='>' : Token='u' ; 'u'ngleich       
                                       GetChar() ;   Token-Code 117
       
       ElseIf look1='<' And Look='=' : Token='k' ; 'k'leinergleich
                                       GetChar() ;   Token-Code 107           
       
       ElseIf look1='>' And Look='=' : Token='g' ; 'g'rößergleich     
                                       GetChar() ;   Token-Code 103 
       
       Else                          : Token = look1
                                       Lexem = Chr(look1) 
                         
       EndIf                   
   
   
    ; ueberspringe alle White Characters und Comments     
      SkipWhite()     

    ; --> in Look ist jetzt das 1. Zeichen des nächsten Token-Lexems     
     
  EndProcedure
   
; - Skip - Prozeduren -----------------------------------------------
; -
  Procedure SkipWhite()

    ; solange in Look ein White
      While IsWhite(Look)
         
          ; Zeichen hinter Look holen
          ; *Source_Pos steht nach letztem
          ; GetChar() schon richtig darauf
            next_Look = *Source_Pos\a 

          ; Zeilenkommentar '// ... #eol/0-Byte'
            If Look='/' And next_Look='/'
                SkipLineComment()
                   
          ; Blockkommentar '/* ... */'
            ElseIf Look='/' And next_Look='*'
                SkipBlockComment()

          ; einfaches '/' als nicht-White im Stream belassen
            ElseIf Look='/'
                ProcedureReturn

          ; sonstige White-Zeichen überspringen
            Else
                GetChar()
            EndIf

      Wend
      
  EndProcedure
  Procedure SkipLineComment()

    ; bis Zeilenende oder Ende des Source-Files (0-Byte)
      While ( Look<>'¶' And Look<>0 )
          GetChar()
      Wend
       
    ; --> Look steht auf #eol oder 0-Byte
    ; --> v.a. beim 0-Byte ist wichtig, dass es als
    ; --> Token weitergegeben wird, was beim nächsten
    ; --> GetToken() auch passiert, weil Look ja
    ; --> auf dem 0-Byte oder #eol steht 
       
  EndProcedure
  Procedure SkipBlockComment()

    ; '/' überspringen
      GetChar()
   
    ; solange bis '*/' 
      Repeat     
           
          ; Zeichen holen, bei Ersteintritt '*' überspringen
            GetChar()
         
          ; Zeichen hinter Look holen
          ; *Source_Pos steht nach letztem
          ; GetChar() schon richtig darauf
            next_Look = *Source_Pos\a 

          ; verschachtelte Block-Kommentare ermöglichen
            If Look='/' And next_Look='*'
                SkipBlockComment()
            EndIf
           
          ; auf 0-Byte achten -> sofort raus
            If Look=0: ProcedureReturn: EndIf
       
      Until Look='*' And next_Look='/'
     
    ; '*/' 2-mal überspringen 
      GetChar()
      GetChar()
     
    ; --> Look steht auf 1. Zeichen nach '*/'   
 
  EndProcedure

; - Error - Prozeduren ----------------------------------------------
; -
  Procedure Error(error_message.s)
      MessageRequester("Fehler",error_message)
      End
  EndProcedure      
  Procedure Expected(expected_object.s)
      Error(expected_object+" wird erwartet.") 
  EndProcedure

EndModule

_________________
Windows 7 und Windows 10 (Laptop), PB 5.60 | Projekt: Tutorial - Compiler und Virtual Machine | vielleicht einmal ein Old School Text-Adventure Tutorial | Neu: Spielereien, Üben rund um OOP in PB


Zuletzt geändert von puretom am 15.11.2013 23:53, insgesamt 6-mal geändert.

Nach oben
 Profil  
Mit Zitat antworten  
 Betreff des Beitrags: Re: Tutorial - Compiler und Virtual Machine (nicht beschreib
BeitragVerfasst: 28.10.2013 19:14 
Offline
Benutzeravatar

Registriert: 06.09.2013 22:02
Code:
; *******************************************************************
; * Parser Version TTCP 0.5                                         *
; *                                                                 *
; *   ist das Include-File: Parser05.pbi                            *
; *                         ^^^^^^^^^^^^                            *
; *******************************************************************
DeclareModule TTCParser05
; =
; = Public Declarations =============================================
; = 
    ; --- Start-Prozedur --- 
      Declare Start(file_name.s)

EndDeclareModule

Module TTCParser05
; =
; = Private Declarations ============================================
; =       
  ; --- globale Variablen ---
   
    Global AssemblerFile            ; Handle des Assembler-Files
   
    Structure gv                    ; Struktur einer globalen
        Typ.i                       ; Variable
        Index.i
    EndStructure
    Global  NewMap GlobalVar.gv()   ; enthält Variablenname + Typ
                                    ; + Index                                   
    Global  GlobalStringIndex       ; die jeweiligen Index-Nummern
    Global  GlobalIntegerIndex

  ; --- notwendige Declares (eine Halde) ---
  ;{
    Declare SimpleExpression(expr_typ)
    Declare ValueFactor(expr_typ)
    Declare StringValueFactor(expr_typ)   
    Declare Input_Function(expr_typ=0)
    Declare Parantheses(expr_typ)
    Declare StringExpression(expr_typ)
    Declare Negation(expr_typ)
    Declare Assignment_Statement()   
    Declare StringParantheses(expr_typ)     
    Declare StrCmp_Function(expr_typ=0)
    Declare Expression(expr_typ)
  ;}

; =
; = PROGRAMM  =======================================================
; =       
; - Versionskontrolle -----------------------------------------------
; -
; Es gibt: TTC 0.5, 1.0 zur Auswahl
  #Version = 0.5

; - Token-Stream-Kontrolle ------------------------------------------
; -
  Procedure TestToken(token)
   
      If Scanner::Token<>token
          Scanner::Expected(#DQUOTE$+Chr(token)+#DQUOTE$+
           " statt "+#DQUOTE$+Chr(Scanner::Token)+#DQUOTE$)
      EndIf
   
  EndProcedure

; - Code-Ausgabe-Prozeduren ins ASM-File ----------------------------
; -
  Procedure Emit(typ='',code.s="",x.s="") ; Spaces+Typ+Opcode+(cut)+Kommentar
        WriteStringN(AssemblerFile,Space(8)+LSet(Chr(typ)+code,35," ")+x)
  EndProcedure
  Procedure EmitS(typ,code.s)             ; Spaces + Typ + Opcode (re. unbeschnitten)
        WriteStringN(AssemblerFile,Space(8)+Chr(typ)+code)
  EndProcedure
  Procedure EmitC(code.s)                 ; Spaces + (kein Typ) + Opcode (re. unbeschnitten)
        WriteStringN(AssemblerFile,Space(8)+code)
  EndProcedure
  Procedure EmitL(label.s)                ; [ + LABEL + ]
      WriteStringN(AssemblerFile,"["+UCase(label)+"]")
  EndProcedure
  Procedure EmitX(x.s="")                 ; ohne Spaces, einfache Ausgabe
      WriteStringN(AssemblerFile,x)
  EndProcedure

; - Verzweigungen ---------------------------------------------------
; -
  Procedure Goto_Statement()   ; springt zu Sprungmarke

    ; Sprungmarken-Name holen und als ASM-Code ausgeben
      Scanner::GetName()   
      EmitC("j      UL_"+UCase(Scanner::Lexem))   
   
    ; Leere Zeile im ASM-File ausgeben zur Übersichtlichkeit
      EmitX()
     
    ; Nächstes Token-Lexem-Paar laden 
      Scanner::GetToken()

  EndProcedure
  Procedure GoSub_Statement()  ; -"-, aber merkt sich Return-Adressse
   
    ; Sprungmarken-Name holen und als ASM-Code ausgeben
      Scanner::GetName()   
      EmitC("call   UL_"+UCase(Scanner::Lexem))   
   
    ; Leere Zeile im ASM-File ausgeben zur Übersichtlichkeit
      EmitX()
     
    ; Nächstes Token-Lexem-Paar laden 
      Scanner::GetToken()
     
  EndProcedure
  Procedure Return_Statement() ; Return von GoSub
   
    ; ASM-Code ausgeben
      EmitC("ret")   
   
    ; Leere Zeile im ASM-File ausgeben zur Übersichtlichkeit
      EmitX()
     
    ; Nächstes Token-Lexem-Paar laden 
      Scanner::GetToken()
     
  EndProcedure
  Procedure End_Statement()    ; Rücksprung aus dem Script in die VM
   
    ; ASM-Code ausgeben
      EmitC("end")   
   
    ; Leere Zeile im ASM-File ausgeben zur Übersichtlichkeit
      EmitX()
     
    ; Nächstes Token-Lexem-Paar laden 
      Scanner::GetToken()
     
  EndProcedure

; - bedingte Anweisungen, Verzweigungen und Schleifen ---------------
; -
  Procedure If_Statement()
   
    ; Klammer holen
      Scanner::GetToken()
      TestToken('(')
      Scanner::GetToken()

    ; Condition ermitteln
     
      Debug Scanner::Lexem
      End
 
  EndProcedure
     
; - Globale Variablen verwalten -------------------------------------
; -
  Procedure NewGlobalVar(var_name.s,var_typ) ; legt neue Variable an
   
    ; Variable bereits vorhanden? -> Fehler!
      If FindMapElement(GlobalVar(),var_name)                   
          Scanner::Error("Die globale Variable "+#DQUOTE$+
                          var_name+#DQUOTE$+
                          " ist bereits deklariert.")                         
      EndIf
     
    ; lege neue Variable an und trage Typ und Index in Map ein
    ; erhöhe nach Eintrag den Index für das nächste Mal
      GlobalVar(var_name)\Typ=var_typ
     
      If     var_typ='i': GlobalVar(var_name)\Index=GlobalIntegerIndex
                          GlobalIntegerIndex+1
      ElseIf var_typ='s': GlobalVar(var_name)\Index=GlobalStringIndex
                          GlobalStringIndex+1                           
      EndIf
       
  EndProcedure
  Procedure IsGlobalVar(var_name.s)          ; Var. deklariert?
 
    ; falls Variable nicht deklariert wurde --> Fehler
      If Not FindMapElement(GlobalVar(),var_name)     
         
          Scanner::Error("Die globale Variable "+#DQUOTE$+var_name+
                         #DQUOTE$+"' wird verwendet, ohne zuvor"+
                         " deklariert worden zu sein.")     
                         
      EndIf 
       
  EndProcedure
                                             ; Nein -> Fehler
; - String - Funktionen ---------------------------------------------
  Procedure StrCmp_Function(expr_typ=0)
 
    ; '(' testen und überspringen
      Scanner::GetOther(): TestToken('('): Scanner::GetToken()
     
    ; StringExpression() aufrufen 
      StringExpression('s')

    ; ')' testen, NICHT überspringen (macht ValueFactor)
      TestToken(')')   

  EndProcedure

; - Typ-Umwandlungs - Funktionen ------------------------------------
  Procedure Str_Function(expr_typ=0)
 
    ; '(' testen und überspringen
      Scanner::GetOther(): TestToken('('): Scanner::GetToken()
     
    ; Expression() aufrufen 
      Expression(expr_typ)

    ; Umwandlungs-Opcode
      EmitC("i2s")

    ; ')' testen, NICHT überspringen (macht ValueFactor)
      TestToken(')')   

  EndProcedure
  Procedure Val_Function(expr_typ=0)
 
    ; '(' testen und überspringen
      Scanner::GetOther(): TestToken('('): Scanner::GetToken()
     
    ; Expression() aufrufen 
      StringExpression('s')

    ; Umwandlungs-Opcode
      EmitC("s2i")

    ; ')' testen, NICHT überspringen (macht ValueFactor)
      TestToken(')')   

  EndProcedure
 
; - IO-Prozeduren/Functions -----------------------------------------
; -
  Procedure Print_Statement(nl)
 
    ; "print" überspringen
      Scanner::GetToken()
 
    ; String Expression holen
      StringExpression('s')     
     
    ; Top of Stack printen, Parameter nl: 'l'ine, 'n'ewline
      Emit(nl,"print")
     
    ; Leere Zeile im ASM-File ausgeben zur Übersichtlichkeit
      EmitX()

  EndProcedure
  Procedure Input_Function(expr_typ=0)
 
    ; --> Der Typ-Parameter steuert das Pullen vom Stack
   
    ; '(' testen und überspringen
      Scanner::GetOther(): TestToken('('): Scanner::GetToken()
           
    ; Ausgabe des ASM-Codes
      EmitC("input") 
     
    ; ')' testen, NICHT überspringen (macht StringValueFactor)
      TestToken(')')   
   
    ; testet, ob Zuweisung vorliegt
    ; keine String-Zuweisung (expr_typ=0) -> Stack durch pull bereinigen 
      If expr_typ=0         
     
          ; unspezifisches "pull"
            EmitC("pull")           
           
          ; neues Token-Lexem laden, weil Input_Function() wurde nicht
          ; aus einer String-Expression heraus aufgerufen
            Scanner::GetToken()
     
          ; Leere Zeile im ASM-File ausgeben zur Übersichtlichkeit
            EmitX() 

      EndIf         
 
  EndProcedure

; - mathematischer Parser -------------------------------------------
; -
; ** Version 0.5 **
  CompilerIf #Version = 0.5 Or #Version= 1.0
 
  Procedure Expression(expr_typ)

    ; Abstieg zu SimpleExpression()   
      SimpleExpression(expr_typ) 

  EndProcedure
  Procedure SimpleExpression(expr_typ)
 
    ; --> Token/Lexem steht auf Value
     
    ; Abstieg zu Negation()   
      Negation(expr_typ)   
   
    ; Ist irgendein Operator in Token/Lexem?
      While Scanner::Token='+' Or Scanner::Token='-' Or
            Scanner::Token='*' Or Scanner::Token='/' Or
            Scanner::Token='%' Or
            Scanner::Token='=' Or Scanner::Token='u' Or
            Scanner::Token='<' Or Scanner::Token='>' Or
            Scanner::Token='k' Or Scanner::Token='g' Or
            Scanner::Lexem="and" Or
            Scanner::Lexem="or"  Or
            Scanner::Lexem="xor"
         
          ; 'and', 'or', 'xor' hier vor Ort zu einem Token machen
            If     Scanner::Lexem="and" : Scanner::Token='a'
            ElseIf Scanner::Lexem="or"  : Scanner::Token='o'       
            ElseIf Scanner::Lexem="xor" : Scanner::Token='x' 
            EndIf     
       
          ; Operator merken
            operator = Scanner::Token
         
          ; vor Abstieg nächstes Token (=Value) holen
            Scanner::GetToken()
         
          ; Abstieg zu Negation()   
            Negation(expr_typ)
         
          ; Ausgabe des ASM-Codes des Operators
          ; mit gemerktem Operator               
            Select operator
           
            Case '+'  : Emit(expr_typ,"add")
            Case '-'  : Emit(expr_typ,"sub")
            Case '*'  : Emit(expr_typ,"mul")
            Case '/'  : Emit(expr_typ,"div")
            Case '%'  : Emit(expr_typ,"mod")
            Case 'a'  : Emit(expr_typ,"and") ; boolesches and:  "and"
            Case 'o'  : Emit(expr_typ,"or" ) ; boolesches or:   "or"
            Case 'x'  : Emit(expr_typ,"xor") ; boolesches xor : "xor"
            Case '='  : Emit(expr_typ,"eq" ) ; equal, gleich:   "="
            Case 'u'  : Emit(expr_typ,"ne" ) ; not equal:       "<>"
            Case '<'  : Emit(expr_typ,"lt" ) ; lower than:      "<="
            Case '>'  : Emit(expr_typ,"gt" ) ; greater than:    ">"
            Case 'k'  : Emit(expr_typ,"le" ) ; lower or equal   "<="
            Case 'g'  : Emit(expr_typ,"ge" ) ; greater or equal ">=" 
           
            EndSelect
                 
      Wend           
         
    ; --> in Token/Lexem ist Token/Lexem nach dem Value 
    ; --> Aufstieg zu Expression() 
     
  EndProcedure
  Procedure Negation(expr_typ)
     
    ; --> Token-Lexem steht auf Value ODER
    ; --> auf unary + | unary -
   
      Select Scanner::Token
     
    ; Ist ein 'unary -' vor ValueFactor?
      Case '-':
          Scanner::GetToken()    ; '-' überspringen
          Parantheses(expr_typ)  ; Abstieg zu Parantheses()     
          Emit(expr_typ,"neg")   ; bei Rückkehr negieren   
             
    ; Ist ein 'unary +' vor ValueFactor?
      Case '+':
          Scanner::GetToken()   ; '+' überspringen
          Parantheses(expr_typ) ; Abstieg zu Parantheses()   
                                ; bei Rückkehr nichts tun

    ; 'normaler' ValueFactor
      Default                   
          Parantheses(expr_typ) ; Abstieg zu Parantheses()                 
     
      EndSelect   
         
    ; --> in Token/Lexem ist Token-Lexem nach Value
    ; --> wenn die Expression weitergeht, ist das ein Operator   
    ; --> Aufstieg zu SimpleExpression()
   
  EndProcedure   
  Procedure Parantheses(expr_typ)
 
    ; --> Token-Lexem steht auf Value ODER
    ; --> auf '('
   
    ; Klammerausdruck beginnt mit "("
      If Scanner::Token ='('
     
            Scanner::GetToken()   ; '(' überspringen und
                                  ;     nächstes Token-Lexem laden
           
            Expression(expr_typ)  ; ------> Expression() ineinander
                                  ;         verschachtelt
           
            TestToken(')')        ; ')' überspringen, dann                                   
            Scanner::GetToken()   ;     Aufstieg zu Negation 
                                                 
     
    ; keine Klammer
      Else
     
            ValueFactor(expr_typ) ; weiterer Abstieg zu ValueFactor()
     
      EndIf
     
   ; --> Aufstieg zu Negation()
   
  EndProcedure
  Macro     ValueFactor_N()
   
    ; Ist Name-Token eine Variable?
      If FindMapElement(GlobalVar(),Scanner::Lexem)     
       
        ; Fehler, wenn die Variable keine 'i'-Variable ist
          If GlobalVar(Scanner::Lexem)\typ<>'i'
              Scanner::Error("Die Variable "+#DQUOTE$+Scanner::Lexem+
                             #DQUOTE$+" ist keine Integer-Variable.")
          EndIf
     
        ; alles In Ordnung, pushe Index der Variable auf den Stack
          Emit(expr_typ,"pushg "+GlobalVar(Scanner::Lexem)\index,"// "+Scanner::Lexem)
   
   
    ; Ist Name-Token eine Interne Funktion? 
      ElseIf Scanner::Lexem="strcmp": StrCmp_Function(expr_typ)
      ElseIf Scanner::Lexem="val"   : Val_Function(expr_typ)
     
    ; Sonst Fehler
      Else
        Scanner::Error("Compiler: "+#DQUOTE$+Scanner::Lexem+#DQUOTE$+
         Scanner::Lexem+#DQUOTE$+" ist kein Integervariablen- oder Funktionsname"+
         " und darf in einem mathemat. Ausdruck nicht verwendet werden")
     
      EndIf     
     
  EndMacro
  Procedure ValueFactor(expr_typ)
   
    ; je Token-Art: Ausgabe des Values als ASM-Code
      Select Scanner::Token     
     
      Case 'I':
        Emit(expr_typ,"pushc "+Scanner::Lexem)
             
      Case 'N':
        ValueFactor_N()
         
      Default:
        Scanner::Expected("Korrekter Operand (Konstante Zahl"+
                          ", Variablen- oder Funktionsname)")
                               
      EndSelect

    ; holt nächstes Token
      Scanner::GetToken()
   
    ; --> in Token/Lexem ist Token/Lexem nach Value
    ; --> wenn die Expression weitergeht, ist das ein Operator   
    ; --> Aufstieg zu Negation()     
     
  EndProcedure

  CompilerEndIf

; ** Version 1.0 **
   
; - Stringausdrucks-Parser ------------------------------------------
; -
; ** Version 0.5 **
  CompilerIf #Version = 0.5 Or #Version= 1.0
 
  Procedure StringExpression(expr_typ)   
 
    ; --> Token/Lexem steht auf Value

    ; Abstieg zu StringParantheses()
      StringParantheses(expr_typ)     
 
    ; Ist '+'-Operator in Token/Lexem?
      While Scanner::Token='+' Or
            Scanner::Token='=' Or
            Scanner::Token='u'                     
     
        ; Operator merken
          operator = Scanner::Token
               
        ; vor Abstieg nächstes Token (=Value) holen
          Scanner::GetToken()
       
        ; Abstieg zu StringParantheses()   
          StringParantheses(expr_typ)
       
        ; Ausgabe des ASM-Codes des Operators
        ; mit gemerktem Operator               
          Select operator           
              Case '+'  : EmitC("sadd")
              Case '='  : EmitC("seq")
              Case 'u'  : EmitC("sne")
          EndSelect
     
      Wend     
         
    ; --> in Token/Lexem ist Token/Lexem nach dem Value 
    ; --> Aufstieg zu Expression() 
     
  EndProcedure
  Procedure StringParantheses(expr_typ)
 
    ; --> Token-Lexem steht auf Value ODER
    ; --> auf '('
   
    ; Klammerausdruck beginnt mit "("
      If Scanner::Token ='('
     
            Scanner::GetToken()   ; '(' überspringen und
                                  ;     nächstes Token-Lexem laden
           
            StringExpression(expr_typ)  ; ------> StringExpression() ineinander
                                  ;         verschachtelt
           
            TestToken(')')        ; ')' überspringen, dann                                   
            Scanner::GetToken()   ;     Aufstieg zu Negation 
                                                 
     
    ; keine Klammer
      Else
     
            StringValueFactor(expr_typ) ; weiterer Abstieg zu ValueFactor()
     
      EndIf
     
   ; --> Aufstieg zu Negation()
   
  EndProcedure
  Macro     StringValueFactor_N()
   
    ; Ist Name-Token eine Variable?
      If FindMapElement(GlobalVar(),Scanner::Lexem)     
       
        ; Fehler, wenn die Variable keine 's'-Variable ist
          If GlobalVar(Scanner::Lexem)\typ<>'s'
              Scanner::Error("Die Variable "+#DQUOTE$+Scanner::Lexem+
                             #DQUOTE$+" ist keine String-Variable.")
          EndIf
             
        ; alles In Ordnung, pushe Index der Variable auf den Stack
          Emit(expr_typ,"pushg "+GlobalVar(Scanner::Lexem)\index,
               "// "+Scanner::Lexem)                           
   
    ; Ist Name-Token eine Interne Funktion? 
      ElseIf Scanner::Lexem="input": Input_Function(expr_typ)
      ElseIf Scanner::Lexem="str"  : Str_Function(expr_typ)
     
     
    ; Sonst Fehler
      Else
        Scanner::Error("Compiler: "+#DQUOTE$+Scanner::Lexem+#DQUOTE$+
          " ist kein Stringvariablen- oder Funktionsname"+
          " und darf in einem Stringausdruck nicht verwendet werden")
     
      EndIf
     
  EndMacro
  Procedure StringValueFactor(expr_typ)
   
    ; je Token-Art: Ausgabe des Values als ASM-Code
      Select Scanner::Token     
           
      Case 'S':
        EmitC("spushc "+#DQUOTE$+Scanner::Lexem+#DQUOTE$)                       
                                                                   
      Case 'N':
        StringValueFactor_N()           
                 
      Default:
        Scanner::Expected("Korrekter Operand (String in "+#DQUOTE$+
                 "..."+#DQUOTE$+", Stringvariablen- oder Funktionsname)")

      EndSelect

    ; holt nächstes Token, überspringe eventuell ")"
      Scanner::GetToken()
   
    ; --> in Token/Lexem ist Token/Lexem nach Value
    ; --> wenn die StringExpression weitergeht, ist das ein Operator   
    ; --> Aufstieg zu StringExpression()     
     
  EndProcedure 

  CompilerEndIf

; ** Version 1.0 ** 

; - Variablen anlegen & Werte zuweisen ------------------------------
; -
; ** Version 0.5 **
  CompilerIf #Version = 0.5
 
  Procedure Declare_Statement(var_typ) ; deklariert Variable mit typ
   
    ; 'int' oder 'string' überspringen
      Scanner::GetToken()
       
    ; Variable anlegen, Variablen-Name ist in Lexem
    ; Variablen-Typ wird weitergereicht
;       If FindMapElement(GlobalVar(),Scanner::Lexem)
;         Scanner::Error("Die globale Variable "+#DQUOTE$+Scanner::Lexem+
;                        #DQUOTE$+" ist bereits deklariert.")
;       EndIf
      NewGlobalVar(Scanner::Lexem,var_typ)
     
    ; am Ende nächstes Token-Lexem-Paar holen   
      Scanner::GetToken() 

  EndProcedure
  Procedure Assignment_Statement()     ; weist Var eine Expression zu
 
    ; --> Variablenname in Lexem   
   
    ; Variablenname merken, testen
      var_name.s = Scanner::Lexem
      IsGlobalVar(var_name)
     
    ; Den Typ der Expression herausfinden,
    ; d.i. der Typ der Variablen, dem das Ergebnis zugewiesen wird 
      expr_typ = GlobalVar(var_name)\typ
     
    ; '=' überspringen
      Scanner::GetOther(): TestToken('='): Scanner::GetToken()
     
    ; Passende Expression aufrufen und Typ übergeben
    ; In Token-Lexem ist das erste Element der Expression
      If     expr_typ='i': Expression(expr_typ)       
      ElseIf expr_typ='s': StringExpression(expr_typ)
      EndIf
     
    ; Wert der Expression (liegt am Stack) der Variable zuweisen
    ; für Variable (Name oben gemerkt) wird Index verwendet
      Emit(expr_typ,"pullg "+GlobalVar(var_name)\index,"// "+var_name)     
   
    ; Leere Zeile im ASM-File ausgeben zur Übersichtlichkeit
      EmitX()
     
    ; --> Token-Lexem ist bereits von Expression
    ; --> richtig auf das nächste vorbereitet

  EndProcedure 
 
  CompilerEndIf

; ** Version 1.0 ** 
  CompilerIf #Version = 1.0 
 
  Procedure Declare_Statement(var_typ) ; deklariert Variable mit typ 

    ; 'int' oder 'string' überspringen, Variablen-Name ist in Lexem
      Scanner::GetToken()
     
     
    ; Schleife, die z.B. ein "int a,b=23,c=40+21+x" usw. ermöglicht
      Repeat     
     
          ; Wenn Look=',' -> überspringen
            If Scanner::Token=','
                Scanner::GetName()  ; Variablen-Name holen
            EndIf
           
          ; Variable anlegen, Variablen-Name ist in Lexem
          ; Variablen-Typ wird weitergereicht
            NewGlobalVar(Scanner::Lexem,var_typ)
         
          ; Wenn Look = '=', dann Declare + Assignment (zB int a=3)
            If Scanner::Look='='   
                               
                Assignment_Statement();  Variablenname ist in Lexem     
           
          ; Sonst am Ende nächstes Token-Lexem-Paar holen
          ; UNTIL überprüft, ob es ein ',' ist   
            Else
                Scanner::GetToken()
                   
            EndIf       
   
      Until Scanner::Token<>','

  EndProcedure
  Procedure Assignment_Statement()     ; weist Var eine Expression zu
 
    ; --> Variablenname in Lexem   
   
    ; Variablenname merken, testen
    ; ( scheint unnötig, aber eine Assignment muss
    ;   nicht von Declare_Statement() kommen )
      var_name.s = Scanner::Lexem
      IsGlobalVar(var_name)
     
    ; den Typ der Expression herausfinden
    ; d.i. der Typ der Variablen, dem das Ergebnis zugewiesen wird 
      expr_typ = GlobalVar(var_name)\typ
     
    ; '=' überspringen
      Scanner::GetOther(): TestToken('='): Scanner::GetToken()
     
    ; Passende Expression aufrufen und Typ übergeben
    ; In Token-Lexem ist das erste Element der Expression
      If     expr_typ='i': Expression(expr_typ)       
      ElseIf expr_typ='s': StringExpression(expr_typ)
      EndIf
     
    ; Wert der Expression (liegt am Stack) der Variable zuweisen
    ; für Variable (Name oben gemerkt) wird Index verwendet
      Emit(expr_typ,"pullg "+GlobalVar(var_name)\index,"// "+var_name)     
   
    ; Leere Zeile im ASM-File ausgeben zur Übersichtlichkeit
      EmitX()
     
    ; --> Token-Lexem ist bereits von Expression
    ; --> richtig auf das nächste vorbereitet

  EndProcedure 
 
  CompilerEndIf

; - Statement, Block ------------------------------------------------
; -

; ** Version 0.5 **
  CompilerIf #Version = 0.5
 
  Procedure Statement()     ; erkennt Statement -> Statement-Prozedur
 
    ; DEBUG
      Debug " | "+Chr(Scanner::Token)+              ; CHAR des Token-Codes
            " | "+RSet(Str(Scanner::Token),3," ")+  ; Code-Nr des Tokens
            " | "+Scanner::Lexem                    ; Lexem

    ; je nach Statement Aktionen setzen
      Select Scanner::Lexem
         
        ; Statements 
          Case "int"    : Declare_Statement('i')
          Case "string" : Declare_Statement('s')         
          Case "print"  : Print_Statement('l')
          Case "printn" : Print_Statement('n')   
          Case "if"     : If_Statement()
          Case "goto"   : Goto_Statement()
          Case "gosub"  : GoSub_Statement()
          Case "return" : Return_Statement()
          Case "end"    : End_Statement()
         
        ; interne Funktionen
          Case "input"  : Input_Function()          ; ohne Parameter
        ; ...
          Default       : Assignment_Statement()
         
      EndSelect       
 
  EndProcedure 
 
  CompilerEndIf
 
; ** Version 1.0 **
  CompilerIf #Version = 1.0
 
  Macro     Default_Statement()
     
   ; Sprungmarke (Label)
     If Scanner::Look=':'     
          EmitL("UL_"+Scanner::Lexem)       
          Scanner::GetOther() ; ':' überspringen
          Scanner::GetToken()
     
   ; Assignment 
     Else     
          Assignment_Statement()
             
     EndIf

  EndMacro
  Procedure Statement()     ; erkennt Statement -> Statement-Prozedur
 
    ; DEBUG
      Debug " | "+Chr(Scanner::Token)+              ; CHAR des Token-Codes
            " | "+RSet(Str(Scanner::Token),3," ")+  ; Code-Nr des Tokens
            " | "+Scanner::Lexem                    ; Lexem

    ; je nach Statement Aktionen setzen
      Select Scanner::Lexem
         
        ; Statements 
          Case "int"    : Declare_Statement('i')
          Case "string" : Declare_Statement('s')         
          Case "print"  : Print_Statement('l')
          Case "printn" : Print_Statement('n')   
          Case "if"     : If_Statement()
          Case "goto"   : Goto_Statement()
          Case "gosub"  : GoSub_Statement()
          Case "return" : Return_Statement()
          Case "end"    : End_Statement()
         
        ; interne Funktionen
          Case "input"  : Input_Function()          ; ohne Parameter
        ; ...
          Default       : Default_Statement()
         
      EndSelect       
 
  EndProcedure 

  CompilerEndIf

; =================================================================== 
;   START (~MAIN) PROZEDUR
; =================================================================== 
  Procedure Start(file_name.s)

    ; Open .ttca-File
      AssemblerFile = CreateFile(#PB_Any,GetFilePart(file_name,
                                 #PB_FileSystem_NoExtension)+".ttca")
      If Not AssemblerFile
         Scanner::Error("Parser: Assembler-File konnte nicht erstellt werden.")
      EndIf     

    ; Starte Scanner-Modul (1. Token-Lexem liegt danach im Stream)
      Scanner::Start(file_name)           
     
    ; Inits 
      ClearMap(GlobalVar())       
      GlobalStringIndex  = 0     
      GlobalIntegerIndex = 0     
   
    ; Prolog vorbereiten
      EmitX(Space(100))  ; reserviert für setGlobalIntSize usw.   
      EmitX("// Beginn des Programms")   
      EmitX()       
     
    ; so lange, bis Token = 0-Byte
      Debug "========================================"
      Debug " PARSER - START"
     
      While ( Scanner::Token<>0 )
        Statement()
      Wend
     
      Debug " PARSER - STOP"
      Debug "----------------------------------------"                       
             
    ; Prolog schreiben
      FileSeek(AssemblerFile,0)
      EmitC("setGlobalIntSize    "+GlobalIntegerIndex)
      EmitC("setGlobalStringSize "+GlobalStringIndex)
     
    ; Stoppe Scanner-Modul (free Memory-Bereich im Scanner)
      Scanner::Stop()

    ; Close .ttca-File
      CloseFile(AssemblerFile)           
     
    ; DEBUG
      Debug "----------------------------------------"
      Debug " GLOBALE VARIABLEN IN 'GLOBALVAR()'"
      Debug "----------------------------------------"     
      Debug "Typ | Index | Name"
      Debug "----------------------------------------"
      ForEach GlobalVar()     
          Debug RSet("'"+Chr(GlobalVar()\typ)+"'",3," ")+
                " | "+RSet(Str(GlobalVar()\index),5," ")+
                " | "+MapKey(GlobalVar()) 
      Next 
     
  EndProcedure

EndModule

_________________
Windows 7 und Windows 10 (Laptop), PB 5.60 | Projekt: Tutorial - Compiler und Virtual Machine | vielleicht einmal ein Old School Text-Adventure Tutorial | Neu: Spielereien, Üben rund um OOP in PB


Zuletzt geändert von puretom am 15.11.2013 23:53, insgesamt 2-mal geändert.

Nach oben
 Profil  
Mit Zitat antworten  
 Betreff des Beitrags: Re: Tutorial - Compiler und Virtual Machine (nicht beschreib
BeitragVerfasst: 28.10.2013 19:15 
Offline
Benutzeravatar

Registriert: 06.09.2013 22:02
Code:
; *******************************************************************
; * Assembler Version TTCA 0.5                                      *
; *                                                                 *
; *   ist das Include-File: Assembler05.pbi                         *
; *                         ^^^^^^^^^^^^^^^                         *
; *******************************************************************
DeclareModule TTCAssembler05
; -
; - Public Declarations ---------------------------------------------
; - 

    ; --- Start-Prozedur --- 

      Declare Start(file_name.s)

EndDeclareModule

Module TTCAssembler05
; -
; - Private Declarations --------------------------------------------
; -     

  ; --- globale Variablen ---
   
    Global ExeFile ; Handle des Exe-Binär-Files
   
    Global PC      ; Program Counter = Position im Code   
   
    Global  NewMap Labels() ; Label-Namen (Key), Wert=index
   
 ; --- Die 2 Passes des Assemblers --- 
   
    Declare Assembler_Pass(pass,file_name.s="")
   
  ; --- Opcodes ---     

    IncludeFile "Enumerated_Opcodes05.pbi"

; -
; - Assemble --------------------------------------------------------
; -
  Macro NewLabel(label_name)   
   
    ; Teste, ob schon vorhanden -> Fehler!
      If FindMapElement(Labels(),label_name)
        Scanner::Error("Assembler: Das Label "+#DQUOTE$+
                       UCase(label_name)+#DQUOTE$+
                       " wurde bereits verwendet.")
      EndIf
     
    ; lege neues Label an, trage PC (Program Counter) in Map ein
      Labels(label_name)=PC
 
  EndMacro
  Macro Assemble_Label() 
     
    ; Label-Namen holen   
      Scanner::GetName()
   
    ; nur in Pass 1 in Map speichern
      If pass = 1
        NewLabel(Scanner::Lexem)           
      EndIf
   
    ; ']' holen und testen
      Scanner::GetOther()
      If Scanner::Token<>']': Scanner::Expected(")"): EndIf         
   
    ; --> keine Vorrückung des PC!
     
  EndMacro
 
; - Assemble Opcodes ------------------------------------------------
; - 

; -- End-Opcode --
  Macro Assemble_end()   
     
    ; Wenn 2. Pass: Code erzeugen
      If pass=2
          WriteUnicodeCharacter(ExeFile,#end)   
      EndIf
   
    ; Sonst: nur PC richtig weiterstellen
      PC+#lenOpc           
 
  EndMacro

; -- Push-Opcodes --
  Macro Assemble_spushc()
   
    ; String-Konstante holen und seine Länge ermitteln
      Scanner::GetString()
      stringLen = Len(Scanner::Lexem)       
     
    ; Wenn 2. Pass: Code erzeugen
      If pass=2
          WriteUnicodeCharacter(ExeFile,#spushc) ; Opcode                   
          WriteLong(ExeFile,stringLen+1)         ; +1 (=0-Byte)
          WriteString(ExeFile,Scanner::Lexem)    ; String selbst
          WriteByte(ExeFile,0)                   ; String 0-Terminus 
      EndIf
   
    ; Sonst: nur PC richtig weiterstellen
    ;        (in der Reihenfolge, wie Code erzeugt wird) 
      PC+#lenNum+#lenOpc+stringLen+1               
 
  EndMacro
  Macro Assemble_ipushc()   
   
    ; long Integer-Konstante holen 
      Scanner::GetNumber()
     
    ; Wenn 2. Pass: Code erzeugen
      If pass=2
          WriteUnicodeCharacter(ExeFile,#ipushc)
          WriteLong(ExeFile,Val(Scanner::Lexem))           
      EndIf
   
    ; Sonst: nur PC richtig weiterstellen
      PC+#lenOpc+#lenNum           
 
  EndMacro
  Macro Assemble_spushg()   
   
    ; Index-Zahl der String-Variable holen
      Scanner::GetNumber()
     
    ; Wenn 2. Pass: Code erzeugen
      If pass=2       
          WriteUnicodeCharacter(ExeFile,#spushg)
          WriteLong(ExeFile,Val(Scanner::Lexem)) ; Index-Zahl schreiben
      EndIf
   
    ; Sonst: nur PC richtig weiterstellen
      PC+#lenOpc+#lenNum
 
  EndMacro 
  Macro Assemble_ipushg()   
   
    ; Index-Zahl der Integer-Variable holen
      Scanner::GetNumber()
     
    ; Wenn 2. Pass: Code erzeugen
      If pass=2       
          WriteUnicodeCharacter(ExeFile,#ipushg)
          WriteLong(ExeFile,Val(Scanner::Lexem)) ; Index-Zahl schreiben
      EndIf
   
    ; Sonst: nur PC richtig weiterstellen
      PC+#lenOpc+#lenNum
 
  EndMacro 

; -- Pull-Opcodes --
  Macro Assemble_spullg()

    ; Index-Zahl der String-Variable holen
      Scanner::GetNumber()
 
    ; Wenn 2. Pass: Code erzeugen
      If pass=2
          WriteUnicodeCharacter(ExeFile,#spullg)
          WriteLong(ExeFile,Val(Scanner::Lexem)) ; Index-Zahl schreiben
      EndIf
   
    ; Sonst: nur PC richtig weiterstellen
      PC+#lenOpc+#lenNum
 
  EndMacro
  Macro Assemble_ipullg()
   
    ; Index-Zahl der Integer-Variable holen
      Scanner::GetNumber()
 
    ; Wenn 2. Pass: Code erzeugen
      If pass=2
          WriteUnicodeCharacter(ExeFile,#ipullg)
          WriteLong(ExeFile,Val(Scanner::Lexem)) ; Index-Zahl schreiben
      EndIf
   
    ; Sonst: nur PC richtig weiterstellen
      PC+#lenOpc+#lenNum
     
  EndMacro
  Macro Assemble_pull()
   
    ; Wenn 2. Pass: Code erzeugen
      If pass=2
          WriteUnicodeCharacter(ExeFile,#pull)   
      EndIf
   
    ; Sonst: nur PC richtig weiterstellen
      PC+#lenOpc   
             
  EndMacro
   
; -- I/O-Opcodes --
  Macro Assemble_lprint()   
     
    ; Wenn 2. Pass: Code erzeugen
      If pass=2
          WriteUnicodeCharacter(ExeFile,#lprint)   
      EndIf
   
    ; Sonst: nur PC richtig weiterstellen
      PC+#lenOpc           
 
  EndMacro
  Macro Assemble_nprint()   
     
    ; Wenn 2. Pass: Code erzeugen
      If pass=2
          WriteUnicodeCharacter(ExeFile,#nprint)   
      EndIf
   
    ; Sonst: nur PC richtig weiterstellen
      PC+#lenOpc           
 
  EndMacro
  Macro Assemble_input()
   
    ; Wenn 2. Pass: Code erzeugen
      If pass=2
          WriteUnicodeCharacter(ExeFile,#input)   
      EndIf
   
    ; Sonst: nur PC richtig weiterstellen
      PC+#lenOpc   
             
  EndMacro

; -- String-Manipulation-Opcodes --
  Macro Assemble_sadd()
 
    ; Wenn 2. Pass: Code erzeugen
      If pass=2
          WriteUnicodeCharacter(ExeFile,#sadd)   
      EndIf
   
    ; Sonst: nur PC richtig weiterstellen
      PC+#lenOpc           
     
  EndMacro
  Macro Assemble_seq()
 
    ; Wenn 2. Pass: Code erzeugen
      If pass=2
          WriteUnicodeCharacter(ExeFile,#seq)   
      EndIf
   
    ; Sonst: nur PC richtig weiterstellen
      PC+#lenOpc           
     
  EndMacro
  Macro Assemble_sne()
 
    ; Wenn 2. Pass: Code erzeugen
      If pass=2
          WriteUnicodeCharacter(ExeFile,#sne)   
      EndIf
   
    ; Sonst: nur PC richtig weiterstellen
      PC+#lenOpc           
     
  EndMacro

; -- Verzweigungs-Opcpdes --
  Macro Assemble_j()
 
    ; Label-Name holen 
      Scanner::GetName()         

    ; Wenn 2. Pass: Code erzeugen
      If pass=2                     
        WriteUnicodeCharacter(ExeFile,#j)   
        la = Labels(Scanner::Lexem)      ; 'l'abel 'a'dress     
        WriteLong(ExeFile,la-PC-#lenOpc) ; Sprung mit Offset PC-relativ     
      EndIf   
   
    ; Sonst: nur PC richtig weiterstellen
      PC+#lenOpc+#lenNum                   
       
  EndMacro
  Macro Assemble_call()
   
    ; Label-Name holen 
      Scanner::GetName()         

    ; Wenn 2. Pass: Code erzeugen
      If pass=2                     
        WriteUnicodeCharacter(ExeFile,#call)   
        la = Labels(Scanner::Lexem)      ; 'l'abel 'a'dress     
        WriteLong(ExeFile,la-PC-#lenOpc) ; Sprung mit Offset PC-relativ     
      EndIf   
   
    ; Sonst: nur PC richtig weiterstellen
      PC+#lenOpc+#lenNum   
                     
  EndMacro
  Macro Assemble_ret()
   
    ; Wenn 2. Pass: Code erzeugen
      If pass=2
          WriteUnicodeCharacter(ExeFile,#ret)   
      EndIf
   
    ; Sonst: nur PC richtig weiterstellen
      PC+#lenOpc           
     
  EndMacro

; -- Typumwandlungs-Opcodes -- 
  Macro Assemble_i2s()
 
    ; Wenn 2. Pass: Code erzeugen
      If pass=2
          WriteUnicodeCharacter(ExeFile,#i2s)   
      EndIf
   
    ; Sonst: nur PC richtig weiterstellen
      PC+#lenOpc           
     
  EndMacro

; -- Frame-Opcodes --
  Macro Assemble_setGlobalIntSize()
 
    ; long Integer-Konstante (=Anzahl der Integer-Variablen) holen 
      Scanner::GetNumber()
     
    ; Wenn 2. Pass: Code erzeugen
      If pass=2
          WriteUnicodeCharacter(ExeFile,#setGlobalIntSize)
          WriteLong(ExeFile,Val(Scanner::Lexem))           
      EndIf
   
    ; Sonst: nur PC richtig weiterstellen
      PC+#lenOpc+#lenNum           
     
  EndMacro
  Macro Assemble_setGlobalStringSize()
 
    ; long Integer-Konstante (=Anzahl der Integer-Variablen) holen 
      Scanner::GetNumber()
     
    ; Wenn 2. Pass: Code erzeugen
      If pass=2
          WriteUnicodeCharacter(ExeFile,#setGlobalStringSize)
          WriteLong(ExeFile,Val(Scanner::Lexem))           
      EndIf
   
    ; Sonst: nur PC richtig weiterstellen
      PC+#lenOpc+#lenNum           
     
  EndMacro


; - Select to Assemble Opcodes --------------------------------------
; -
  Macro Assemble_Opcodes()   
     
    ; Debug-Anzeige
      Debug " | "+RSet(Str(PC),10," ")+       ; PC
            " | "+Scanner::Lexem              ; Opcode-Lexem
   
    ; je nach Opcode Assemblierungs-Aktionen setzen     
      Select Scanner::Lexem
         
            Case "["     : Assemble_Label()

            Case "end"   : Assemble_end()       
           
            Case "spushc": Assemble_spushc()
            Case "ipushc": Assemble_ipushc()
            Case "spushg": Assemble_spushg()           
            Case "ipushg": Assemble_ipushg()
           
            Case "spullg": Assemble_spullg()           
            Case "ipullg": Assemble_ipullg()           
            Case "pull"  : Assemble_pull()
           
            Case "lprint": Assemble_lprint()
            Case "nprint": Assemble_nprint()
            Case "input" : Assemble_input()
           
            Case "sadd"  : Assemble_sadd()     
            Case "seq"   : Assemble_seq()
            Case "sne"   : Assemble_sne()
           
            Case "j"     : Assemble_j()
            Case "call"  : Assemble_call()
            Case "ret"   : Assemble_ret()
           
            Case "i2s"   : Assemble_i2s()
           
            Case "setglobalintsize"    : Assemble_setGlobalIntSize()
            Case "setglobalstringsize" : Assemble_setGlobalStringSize()
           
            Default 
           
                 Scanner::Error("Assembler: Unbekannter Opcode: "+
                                #DQUOTE$+Scanner::Lexem+#DQUOTE$)                               
         
      EndSelect 
     
    ; nächstes Token-Lexem-Paar holen
      Scanner::GetToken()
     
  EndMacro

; - Start - Prozedur ------------------------------------------------
; -
  Procedure Start(file_name.s)
 
    ; Open .ttca-File
      ExeFile = CreateFile(#PB_Any,GetFilePart(file_name,
                            #PB_FileSystem_NoExtension)+".ttce")
      If Not ExeFile
         Scanner::Error("Exe-File "+#DQUOTE$+file_name+#DQUOTE$+
                        " konnte nicht erstellt werden.")
      EndIf                 
     
    ; 2 Assembler-Durchläufe (=Passes)
      Assembler_Pass(1, file_name)
      Assembler_Pass(2)

    ; Debug-Anzeige der Labels
      Debug "----------------------------------------"
      Debug " SYMBOLTABELLE: LABELS & IHRE ADRESSEN  "
      Debug "----------------------------------------"     
      Debug " PC            | Name"
      Debug "----------------------------------------"
      ForEach Labels()     
        Debug RSet(" "+Labels()+" ",14," ")+
              " | "+MapKey(Labels())
      Next               
                       
  EndProcedure
  Procedure Assembler_Pass(pass,file_name.s="")
   
    ; Debug-Anzeige
      Debug ""   
      Debug "========================================"
      Debug " ASSEMBLER - START - PASS "+Str(pass)         
     
    ; Initialisiere Programmzähler
      PC = 0 
     
    ; Starte Scanner-Modul (1. Token-Lexem liegt danach im Stream)
      If file_name=""
          Scanner::Start() ; ohne Neuladen
      Else
          Scanner::Start(GetFilePart(file_name, #PB_FileSystem_NoExtension)+".ttca")
      EndIf
     
    ; solange kein 0-Token
      While ( Scanner::Token<>0 )
            Assemble_Opcodes()
      Wend

    ; Nach 2. pass
      If pass=2 
         
          ; Stoppe Scanner (free Memory-Bereich im Scanner)
            Scanner::Stop()   

          ; Close .ttce-File
            CloseFile(ExeFile)     
     
      EndIf
     
    ; Debug-Anzeige
      Debug " ASSEMBLER - STOP - PASS "+Str(pass)     
      Debug "----------------------------------------" 
 
  EndProcedure


EndModule



_________________
Windows 7 und Windows 10 (Laptop), PB 5.60 | Projekt: Tutorial - Compiler und Virtual Machine | vielleicht einmal ein Old School Text-Adventure Tutorial | Neu: Spielereien, Üben rund um OOP in PB


Zuletzt geändert von puretom am 15.11.2013 23:52, insgesamt 4-mal geändert.

Nach oben
 Profil  
Mit Zitat antworten  
 Betreff des Beitrags: Re: Tutorial - Compiler und Virtual Machine (nicht beschreib
BeitragVerfasst: 28.10.2013 19:15 
Offline
Benutzeravatar

Registriert: 06.09.2013 22:02
Code:
; *******************************************************************
; * Virtual Machine Version TTCVM 0.5                               *
; *                                                                 *
; *   ist das Include-File: VirtualMachine05.pbi                    *
; *                         ^^^^^^^^^^^^^^^^^^^^                    *
; *******************************************************************
DeclareModule TTCVirtualMachine05
; -
; - Public Declarations ---------------------------------------------
; - 

    ; --- Start-Prozedur --- 
   
      Declare Start(file_name.s)

EndDeclareModule

Module TTCVirtualMachine05
; -
; - Private Declarations --------------------------------------------
; -

  ; --- Code Segment ---
 
    Global *Executable_Code   ; Start-Adresse des Exe-Code-Bereichs
    Global *PC.Unicode        ; Programm-Counter
    Global  Opcode            ; aktueller Opcode (=Befehlsregister)

  ; --- Operanden-Stack ---
   
    Structure st                    ; Struktur "st" (='st'acks)
        Integer.l                   ; auch für LocalStack
        String.s
    EndStructure
    Global MaxOSP=10000             ; Maximalwert von OSP
    Global Dim OpStack.st(MaxOSP)   ; 10000 ist OVERKILL !!
    Global OSP                      ; Operanden Stack Pointer

  ; --- Local-Stack ---
   
    Global MaxLSP=10000             ; Maximalwert von LSP
    Global Dim LocalStack.st(MaxLSP); 10000 ist nicht schlecht
    Global LSP                      ; Local Stack Pointer

  ; --- Return-Stack ---

    Global MaxRSP=10000             ; Maximalwert von RSP
    Global Dim RetStack.i(MaxRSP)   ; 10000 ist OVERKILL !!
    Global RSP                      ; Return Stack Pointer       
   
  ; --- Speicher-Strukturen für globale Variablen --- 
     
    Global Dim GlobalString.s(10000); fürs Erste genug, kein Overkill
    Global Dim GlobalInt.i(10000)   ; fürs Erste genug, kein Overkill

  ; --- Opcodes: Enumerations ---     

    IncludeFile "Enumerated_Opcodes05.pbi"
   
  ; --- Instruction Cycle ---
    Declare InstructionCycle() ; Von-Neumann-Befehls-Zyklus 
   
  ; --- Debug-Prozeduren ---
    Declare Debug_Opcode(pc,opc.s,para.s="",l=0) ; Opcode in Debug
   
; -
; - Start - Prozedur ------------------------------------------------
; -   
  Procedure Start(file_name.s)

    ; Debug-Ausgabe
      Debug ""
      Debug "========================================"
      Debug " VIRTUAL MACHINE - START"

    ; öffne .ttce-Exe-File mit file_name
      file = ReadFile(#PB_Any,GetFilePart(file_name,
                          #PB_FileSystem_NoExtension)+".ttce")     
      If Not file
          Scanner::Error("Das Exe-File "+#DQUOTE$+file_name+#DQUOTE$+
                         " konnte nicht geöffnet werden.")
      EndIf           
     
    ; lade .ttce-Exe-File in Memory-Bereich *Executable_Code                               
      size = Lof(file)
      *Executable_Code = AllocateMemory(size+#lenOpc) ; am Ende 0,0 
      ReadData(file, *Executable_Code, size)     
      CloseFile(file)

    ; öffne Console
      OpenConsole()     
     
    ; *** Von-Neumann-Instruction-Cycle ablaufen lassen ***
      InstructionCycle()
     
    ; warte auf Enter, dann
    ; schließe Konsole
      PrintN(""):PrintN("")
      PrintN("---------------------------------------------------"+
             "--------------------------")
      PrintN("Virtuelle Maschine beendet! Druecken Sie Enter, um "+
             "die Konsole zu schliessen!")   
      PrintN("---------------------------------------------------"+
             "--------------------------")               
      Input()
      CloseConsole()

    ; gibt Memory des Executable frei 
      FreeMemory(*Executable_Code)
   
    ; Debug-Ausgabe
      Debug " VIRTUAL MACHINE - STOP"
      Debug "========================================"     
                     
  EndProcedure
 
; - Operanden-Stack: Push/Pull-Macros -------------------------------
; -
  Macro sOperandPush(s)
   
    ; String s auf den Operanden-Stack pushen
      OpStack(OSP)\String = s
     
    ; inc Operanden-Stack-Pointer (= postincrement) 
      OSP+1     
     
    ; OSP Überschreitung des Maximums? -> erhöhen
;       If OSP > MaxOSP
;           MaxOSP = MaxOSP+MaxOSP
;           ReDim OpStack(MaxOSP)     
;       EndIf
     
  EndMacro 
  Macro sOperandPull(s)
 
    ; dec Operanden-Stack-Pointer (= predecrement)   
      OSP-1     
     
    ; Operandenstack in String s pullen 
      s = OpStack(OSP)\String 
         
  EndMacro
  Macro iOperandPush(i)
   
    ; String s auf den Operanden-Stack pushen
      OpStack(OSP)\Integer = i
     
    ; inc Operanden-Stack-Pointer (= postincrement) 
      OSP+1     
     
  EndMacro 
  Macro iOperandPull(i)
 
    ; dec Operanden-Stack-Pointer (= predecrement)   
      OSP-1     
     
    ; Operandenstack in String s pullen 
      i = OpStack(OSP)\Integer 
         
  EndMacro
 
; - Opcodes: Execute-Macros -----------------------------------------
; -

; -- Push-Opcodes --
  Macro spushc()
 
    ; --> PC steht direkt NACH OPCODE
 
    ; String-Länge (+1 Byte => 0-Byte) laden
      *ptr.Long= *PC
      lenString = *ptr\l   
      *PC+#lenNum

    ; String laden (entspricht: PeekS(*PC))
      *string.String = @*PC
     
    ; String auf Operanden-Stack pushen
      sOperandPush(*string\s)
     
    ; PC auf nächsten Opcode 
      *PC+lenString
     
    ; --> PC steht AUF nächstem OPCODE
 
  EndMacro
  Macro ipushc() 
 
    ; Integer-Konstante laden
      *ptr.Long= *PC
      constant = *ptr\l   
     
    ; Integer auf Operanden-Stack pushen
      iOperandPush(constant)
     
    ; PC auf nächsten Opcode 
      *PC+#lenNum
     
  EndMacro
  Macro spushg()
 
    ; Index-Nr der globalen String-Variable laden
      *ptr.Long= *PC
      index = *ptr\l   
     
    ; Wert der Variable auf Operanden-Stack pushen
      string.s = GlobalString(index)
      sOperandPush(string)
     
    ; PC auf nächsten Opcode 
      *PC+#lenNum
   
  EndMacro
  Macro ipushg()
   
    ; Index-Nr der globalen String-Variable laden
      *ptr.Long= *PC
      index = *ptr\l   
     
    ; Wert der Variable auf Operanden-Stack pushen
      int = GlobalInt(index)
      iOperandPush(int)
     
    ; PC auf nächsten Opcode 
      *PC+#lenNum

  EndMacro

; -- Pull-Opcodes --
  Macro spullg()
   
    ; Index-Nr der globalen String-Variable laden
      *ptr.Long= *PC
      index = *ptr\l   
     
    ; Wert vom Operanden-Stack in Variable speichern
      sOperandPull(string.s)
      GlobalString(index) = string

    ; PC auf nächsten Opcode 
      *PC+#lenNum
     
  EndMacro 
  Macro ipullg()
     
    ; Index-Nr der globalen Integer-Variable laden
      *ptr.Long= *PC
      index = *ptr\l   
     
    ; Wert vom Stack in Variable speichern
      iOperandPull(integer_value)
      GlobalInt(index)=integer_value
     
    ; PC auf nächsten Opcode 
      *PC+#lenNum

  EndMacro
  Macro pull()
 
    ; entferne Element vom Operanden-Stack
      OSP-1
   
  EndMacro

; -- I/O-Opcodes --
  Macro lprint()
 
    ; String von Operanden-Stack pullen
      sOperandPull(string.s)

    ; Gib String auf Console aus
      Print(string)
     
  EndMacro
  Macro nprint()
 
    ; String von Operanden-Stack pullen
      sOperandPull(string.s)

    ; Gib String auf Console aus
      PrintN(string)
     
  EndMacro
  Macro input_()

    ; lies String von Konsole ein
      input_string.s = Input()

    ; Pushe String auf Operandenstack
      sOperandPush(input_string)       
     
  EndMacro
 
; -- String-Manipulation-Opcodes --
  Macro sadd()
   
    ; Addiere: 2-Operanden-Stack + 1-Operanden-Stack   
      sOperandPull(string1.s)
      sOperandPull(string2.s)
      sOperandPush(string2 + string1)
 
  EndMacro
  Macro seq()
   
    ; Vergleiche: 2-Operanden-Stack + 1-Operanden-Stack       
      sOperandPull(string1.s)
      sOperandPull(string2.s)

    ; wenn gleich, pushe 1 auf Operandenstack
      If string2=string1
          iOperandpush(1)
         
    ; wenn ungleich, pushe 0 auf Operandenstack
      Else
          iOperandpush(0)
               
      EndIf
     
  EndMacro
  Macro sne()
   
    ; Vergleiche: 2-Operanden-Stack + 1-Operanden-Stack       
      sOperandPull(string1.s)
      sOperandPull(string2.s)

    ; wenn ungleich, pushe 1 auf Operandenstack
      If string2<>string1
          iOperandpush(1)
         
    ; wenn gleich, pushe 0 auf Operandenstack
      Else
          iOperandpush(0)
               
      EndIf
     
  EndMacro

; -- Verzweigungs-Opcpdes --
  Macro j()

    ; Offset für Sprung laden
      *ptr.Long= *PC
      Offset = *ptr\l   

    ; PC auf nächsten Opcode 
      *PC+Offset
 
  EndMacro
  Macro call()
 
    ; Offset für Sprung laden
      *ptr.Long= *PC
      Offset = *ptr\l   

    ; Return-Adresse speichern (nach call-Befehl)
      RetStack(RSP)=*PC+#lenNum ; #lenNum = Operandenbreite
      RSP+1                     ; postincrement

    ; PC auf nächsten Opcode 
      *PC+Offset
 
  EndMacro
  Macro ret()
 
    ; Returnadresse vom Return-Stack holen
      RSP-1                         ; predecrement
      return_adress = RetStack(RSP)
     
    ; PC auf nächsten Opcode 
      *PC = return_adress
 
  EndMacro

; -- Typumwandlungs-Befehle -- 
  Macro i2s()
 
    ; wandle um: 1-Operanden-Stack von i nach s   
      iOperandPull(i)
      sOperandPush(Str(i))

  EndMacro

; -- Frame-Opcodes --
  Macro setGlobalIntSize()
 
    ; Anzahl der globalen Integer-Variablen holen
      *ptr.Long= *PC
      globalIntVars = *ptr\l   
     
    ; Speicherframe (=Array) für globale Int-Vars anpassen   
      ReDim GlobalInt(globalIntVars)     
     
    ; PC auf nächsten Opcode 
      *PC+#lenNum
   
  EndMacro
  Macro setGlobalStringSize()
 
    ; Anzahl der globalen Integer-Variablen holen
      *ptr.Long= *PC
      globalStringVars = *ptr\l   
     
    ; Speicherframe (=Array) für globale Int-Vars anpassen   
      ReDim GlobalString(globalStringVars)     
     
    ; PC auf nächsten Opcode 
      *PC+#lenNum
   
  EndMacro
 
; - Von-Neumann-Befehlszyklus ---------------------------------------
; -
  Procedure InstructionCycle()
 
    ; Initialisiere Programmzähler
      *PC = *Executable_Code   

    ; 1. FETCH: hole das 1. Mal einen Opcode
       Opcode = *PC\u
       
    ; 1. FETCH: erhöhe PC                 
      *PC+#lenOpc           
       
    ; **************************   
    ; *   VON-NEUMANN-ZYKLUS   *
    ; **************************

    ; so lange, bis Opcode = #end-Opcode (0-Byte)
      While ( Opcode <> #end )                   
         
        ; 2. DECODE  (Case - Abfrage)
          Select Opcode
           
              ; 3. FETCH OPERANDS (im Case - Macro)
              ; 4. EXECUTE (im Case - Macro)
              ; 5. WRITE BACK (im Case - Macro)
             
              Case #spushc : spushc()
              Case #spushg : spushg()
              Case #ipushc : ipushc()
              Case #ipushg : ipushg()
             
              Case #spullg : spullg()
              Case #ipullg : ipullg()
              Case #pull   : pull()
             
              Case #nprint : nprint()         
              Case #lprint : lprint()
              Case #input  : input_()
             
              Case #sadd   : sadd()
              Case #seq    : seq()
              Case #sne    : sne()
             
              Case #j      : j()
              Case #call   : call()
              Case #ret    : ret()
             
              Case #i2s    : i2s()
             
              Case #setGlobalIntSize    : setGlobalIntSize()
              Case #setGlobalStringSize : setGlobalStringSize()
             
             
            Default     : Scanner::Error("Virtual Machine: "+
                               "Unbekannter Opcode: #"+Str(Opcode))
             
            EndSelect                 
           
        ; 1.FETCH: hole nächsten Opcode   
          Opcode = *PC\u
       
        ; 1.FETCH: erhöhe PC
        ; --> *PC steht auf 1. Byte nach Opcode   
          *PC+#lenOpc             
         
      Wend                 
 
  EndProcedure

; - Debug-Prozeduren ------------------------------------------------
; -
  Procedure Debug_Opcode(pc,opc.s,para.s="",l=0)
 
      If l=0 : stringlen.s=""
      Else   : stringlen.s="("+l+")"
      EndIf
 
      Debug " | "+RSet(Str(pc-*Executable_Code),10," ")+    ; PC
            " | "+RSet(Str(Opcode),3," ")+  ; Opcode
            " | "+RSet(opc,8," ")+          ; Opcode-Lexem
            " | "+para+stringlen
 
  EndProcedure

EndModule

_________________
Windows 7 und Windows 10 (Laptop), PB 5.60 | Projekt: Tutorial - Compiler und Virtual Machine | vielleicht einmal ein Old School Text-Adventure Tutorial | Neu: Spielereien, Üben rund um OOP in PB


Zuletzt geändert von puretom am 15.11.2013 23:52, insgesamt 3-mal geändert.

Nach oben
 Profil  
Mit Zitat antworten  
 Betreff des Beitrags: Re: Tutorial - Compiler und Virtual Machine (nicht beschreib
BeitragVerfasst: 28.10.2013 19:16 
Offline
Benutzeravatar

Registriert: 06.09.2013 22:02
Code:
; *******************************************************************
; * Enumerated Opcodes Version TTCP 0.5                             *
; *                                                                 *
; *   ist das Include-File: Enumerated_Opcodes05.pbi                *
; *                         ^^^^^^^^^^^^^^^^^^^^^^^^                *
; *******************************************************************
  Enumeration 0
   
    #end = 0    ; beendet sofort die Scriptausführung
   
  ; --- push ---------------------------------------------------------- 
   
    #spushc     ; pusht folgende String-Konstante auf den 1-Operandenstack
    #ipushc     ; pusht folgende Int-Konstante auf den 1-Operandenstack
    #spushg     ; pusht globale String-Variable (Index folgt) auf den 1-Operandenstack
    #ipushg     ; pusht globale Int-Variable (Index folgt) auf den 1-Operandenstack
   
  ; --- pull ---------------------------------------------------------- 
   
    #spullg     ; pullt in die globale String-Variable (Index folgt) String vom 1-Operandenstack
    #ipullg     ; pullt in die globale Int-Variable (Index folgt) Int-Wert vom 1-Operandenstack
    #pull       ; pullt Wert vom 1-Operandenstack weg - entfernt ihn, also einfach OSP-1
 
  ; --- I/O-Befehle ---------------------------------------------------
   
    #lprint     ; druckt in Console String am 1-Operandenstack
    #nprint     ; druckt in Console String am 1-Operandenstack + 'Enter'
    #input      ; wartet auf Eingabe und pusht Eingabe-String auf 1-Operandenstack
 
  ; --- String-Befehle ------------------------------------------------
   
    #sadd       ; addiert Strings am 2-Operandenstack + 1-Operandenstack 
    #seq        ; pusht 1 auf Stack, wenn Strings auf 1- und 2-Operandenstack gleich, sonst 0
    #sne        ; pusht 1 auf Stack, wenn Strings auf 1- und 2-Operandenstack gleich, sonst 0
   
  ; --- Typumwandlungs-Befehle ----------------------------------------
 
    #i2s        ; Integer to String -> 1-Operandenstack: Umwandlung von Integer in String
   
  ; --- Sprung-Befehle ------------------------------------------------
   
    #j          ; springt (jump) ohne Bedinungen zu PC + Wert (Wert folgt)   
    #call       ; springt ohne Bedinungen zu PC + Wert (Wert folgt)
                ; speichert Rücksprungwert auf Return-Stack
    #ret        ; Rücksprung von call
   
  ; --- Frame-Befehle -------------------------------------------------
   
    #setGlobalIntSize
    #setGlobalStringSize
     
  EndEnumeration
 
    ; --- Opcode-Länge = 2 Bytes (0-65535) ---
      #lenOpc = 2
   
    ; --- Länge einer Standard-Zahl (4 Bytes: Long) ---
      #lenNum = 4
 
    ; --- sonstige Konstanten ---

_________________
Windows 7 und Windows 10 (Laptop), PB 5.60 | Projekt: Tutorial - Compiler und Virtual Machine | vielleicht einmal ein Old School Text-Adventure Tutorial | Neu: Spielereien, Üben rund um OOP in PB


Nach oben
 Profil  
Mit Zitat antworten  
 Betreff des Beitrags: Re: Tutorial - Compiler und Virtual Machine (nicht beschreib
BeitragVerfasst: 16.11.2013 00:12 
Offline
Benutzeravatar

Registriert: 06.09.2013 22:02
und bitte nicht vergessen, hier nichts reinschreiben, Danke!

_________________
Windows 7 und Windows 10 (Laptop), PB 5.60 | Projekt: Tutorial - Compiler und Virtual Machine | vielleicht einmal ein Old School Text-Adventure Tutorial | Neu: Spielereien, Üben rund um OOP in PB


Nach oben
 Profil  
Mit Zitat antworten  
 Betreff des Beitrags: Re: Tutorial - Compiler und Virtual Machine (nicht beschreib
BeitragVerfasst: 25.01.2017 13:53 
Offline
Benutzeravatar

Registriert: 06.09.2013 22:02
Hallo :-)

Nach langer Zeit der schweren persönlichen und familiären Krisen melde ich mich wieder mal. Es lief im Leben eben so, wie es bei den meisten läuft, selten vorhersehbar und geradlinig.

Ob ich jemals dieses Tutorial weitermache, kann ich nicht versprechen, sicher nicht in dieser Form oder an dieser Stelle.
Ich habe in der Zwischenzeit eine Menge Toy-Scriptsprachen geschrieben und bin zu dem Schluss gekommen, dass man das alles noch viel einfacher und naiver implementieren und erklären kann.
Das Ziel war ja, so ziemlich am Anfang für die blutigsten Einsteiger - ich selbst zähle mich mal selbst maximal zu den fortgeschrittenen blutigen Einsteigern - in diese Thematik zu starten und auch nur bis zum Punkt einer brauchbaren virtuellen Maschine, die die Scriptsprache ausführt, zu kommen, mehr nicht.

Aber das hätte ich mir als nicht fortgeschrittener blutiger Einsteiger schon gewünscht, wenn es das auf Deutsch gegeben hätte.

Liebe Grüße, puretom :-)

P.S. Ich habe 2 Threads gestartet und wäre recht dankbar, wenn mir jemand Feeback bzw. helfen könnte, danke.

_________________
Windows 7 und Windows 10 (Laptop), PB 5.60 | Projekt: Tutorial - Compiler und Virtual Machine | vielleicht einmal ein Old School Text-Adventure Tutorial | Neu: Spielereien, Üben rund um OOP in PB


Nach oben
 Profil  
Mit Zitat antworten  
Beiträge der letzten Zeit anzeigen:  Sortiere nach  
Ein neues Thema erstellen Auf das Thema antworten  [ 28 Beiträge ]  Gehe zu Seite Vorherige  1, 2, 3

Alle Zeiten sind UTC + 1 Stunde [ Sommerzeit ]


Wer ist online?

Mitglieder in diesem Forum: 0 Mitglieder und 2 Gäste


Sie dürfen keine neuen Themen in diesem Forum erstellen.
Sie dürfen keine Antworten zu Themen in diesem Forum erstellen.
Sie dürfen Ihre Beiträge in diesem Forum nicht ändern.
Sie dürfen Ihre Beiträge in diesem Forum nicht löschen.

Suche nach:
Gehe zu:  

 


Powered by phpBB © 2008 phpBB Group | Deutsche Übersetzung durch phpBB.de
subSilver+ theme by Canver Software, sponsor Sanal Modifiye