Tutorial - Compiler und Virtual Machine (nicht beschreiben)

Hier kannst du häufig gestellte Fragen/Antworten und Tutorials lesen und schreiben.
puretom
Beiträge: 109
Registriert: 06.09.2013 22:02

Re: Tutorial - Compiler und Virtual Machine (nicht beschreib

Beitrag von puretom »

Code: Alles auswählen

; 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
Zuletzt geändert von puretom am 15.11.2013 23:55, insgesamt 7-mal geändert.
Windows 7 und Windows 10 (Laptop), PB 5.62 | Projekt: Tutorial - Compiler und Virtual Machine | vielleicht einmal ein Old School Text-Adventure Tutorial | Neu: Spielereien, Üben rund um OOP in PB
puretom
Beiträge: 109
Registriert: 06.09.2013 22:02

Re: Tutorial - Compiler und Virtual Machine (nicht beschreib

Beitrag von puretom »

Code: Alles auswählen

; *******************************************************************
; * 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
Zuletzt geändert von puretom am 15.11.2013 23:53, insgesamt 6-mal geändert.
Windows 7 und Windows 10 (Laptop), PB 5.62 | Projekt: Tutorial - Compiler und Virtual Machine | vielleicht einmal ein Old School Text-Adventure Tutorial | Neu: Spielereien, Üben rund um OOP in PB
puretom
Beiträge: 109
Registriert: 06.09.2013 22:02

Re: Tutorial - Compiler und Virtual Machine (nicht beschreib

Beitrag von puretom »

Code: Alles auswählen

; *******************************************************************
; * 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
Zuletzt geändert von puretom am 15.11.2013 23:53, insgesamt 2-mal geändert.
Windows 7 und Windows 10 (Laptop), PB 5.62 | Projekt: Tutorial - Compiler und Virtual Machine | vielleicht einmal ein Old School Text-Adventure Tutorial | Neu: Spielereien, Üben rund um OOP in PB
puretom
Beiträge: 109
Registriert: 06.09.2013 22:02

Re: Tutorial - Compiler und Virtual Machine (nicht beschreib

Beitrag von puretom »

Code: Alles auswählen

; *******************************************************************
; * 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


Zuletzt geändert von puretom am 15.11.2013 23:52, insgesamt 4-mal geändert.
Windows 7 und Windows 10 (Laptop), PB 5.62 | Projekt: Tutorial - Compiler und Virtual Machine | vielleicht einmal ein Old School Text-Adventure Tutorial | Neu: Spielereien, Üben rund um OOP in PB
puretom
Beiträge: 109
Registriert: 06.09.2013 22:02

Re: Tutorial - Compiler und Virtual Machine (nicht beschreib

Beitrag von puretom »

Code: Alles auswählen

; *******************************************************************
; * 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
Zuletzt geändert von puretom am 15.11.2013 23:52, insgesamt 3-mal geändert.
Windows 7 und Windows 10 (Laptop), PB 5.62 | Projekt: Tutorial - Compiler und Virtual Machine | vielleicht einmal ein Old School Text-Adventure Tutorial | Neu: Spielereien, Üben rund um OOP in PB
puretom
Beiträge: 109
Registriert: 06.09.2013 22:02

Re: Tutorial - Compiler und Virtual Machine (nicht beschreib

Beitrag von puretom »

Code: Alles auswählen

; *******************************************************************
; * 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.62 | Projekt: Tutorial - Compiler und Virtual Machine | vielleicht einmal ein Old School Text-Adventure Tutorial | Neu: Spielereien, Üben rund um OOP in PB
puretom
Beiträge: 109
Registriert: 06.09.2013 22:02

Re: Tutorial - Compiler und Virtual Machine (nicht beschreib

Beitrag von puretom »

und bitte nicht vergessen, hier nichts reinschreiben, Danke!
Windows 7 und Windows 10 (Laptop), PB 5.62 | Projekt: Tutorial - Compiler und Virtual Machine | vielleicht einmal ein Old School Text-Adventure Tutorial | Neu: Spielereien, Üben rund um OOP in PB
puretom
Beiträge: 109
Registriert: 06.09.2013 22:02

Re: Tutorial - Compiler und Virtual Machine (nicht beschreib

Beitrag von puretom »

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.62 | Projekt: Tutorial - Compiler und Virtual Machine | vielleicht einmal ein Old School Text-Adventure Tutorial | Neu: Spielereien, Üben rund um OOP in PB
Antworten