Re: Tutorial - Compiler und Virtual Machine (nicht beschreib
Code: Alles auswählen
; *******************************************************************
; * Scanner Version TTCS 1.0 *
; * *
; * 'N'ame, 'I'nteger, 'F'loat, ".." -> 'S'string *
; * <> -> 'u', >= -> 'g', <= -> 'k' *
; * Other char -> Token = char, Lexem = chr(char) *
; * *
; * ist das Include-File: Scanner10.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
Global LineNr ; aktuelle Zeilennummer
; --- 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 IsNumber1(c) ; Zeichen gehört zu Start einer Zahl?
(c>='0' And c<='9')
EndMacro
Macro IsNumber(c) ; Zeichen gehört zu einer Zahl?
((c>='0' And c<='9') Or c='.')
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
;Anmerkung: / startet einen Zeilenkommentar mit '//' (wie in C)
; / startet einen Blockkommentar mit '/*' (wie in C)
; --- 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
; LineNr auf 1. Zeile stellen
LineNr=1
; 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
; Zeilenummer hochzählen
If (Look=#CR And *Source_Pos\a=#LF) Or
(Look=#LF And *Source_Pos\a=#CR)
Look='¶': LineNr+1
*Source_Pos+1 ; überspringe 2. Zeichen
ElseIf Look=#CR Or Look=#LF
Look='¶': LineNr+1
EndIf
EndProcedure
Procedure GetToken()
; --> in Look ist das 1. Zeichen dieses Token-Lexems
; Entscheide, welcher Token-Typ vorliegt und verzweige entsprechend
If IsNumber1(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-, Prozedurname oder TTC-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 IsNumber1(Look):Expected("Eine Zahl"):EndIf
; Lexem mit Number füllen
Lexem = ""
Repeat
Lexem = Lexem + Chr(Look)
GetChar()
If Look='.':point+1:EndIf
Until Not IsNumber(Look)
; Float-Number, Fehler oder Integer?
If point=0:
Token='I'
ElseIf point=1:
Token='F'
; Testen, ob zu kurz?
If Len(Lexem)<3:
Error("Die Fließkommazahl ist unvollständig.")
EndIf
Else
Error("In einer Fließkommazahl darf nur maximal "+
"ein Kommapunkt vorkommen und nicht "+Str(Point)+".")
EndIf
; 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("Ein konstanter String in "+#DQUOTE$+#DQUOTE$)
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(fehlertext.s)
; Fehlertext in Message Requester ausgeben.
MessageRequester("Scanner Error",
fehlertext+#CRLF$+#CRLF$+
"Token-Zeichen: "+Chr(Token)+#CRLF$+
"Token-Code: "+Token+#CRLF$+
"Lexem: "+Lexem+#CRLF$+
"Zeile: "+LineNr)
; Scan- und somit Compilevorgang brutal abbrechen
End
EndProcedure
Procedure Expected(expected_object.s)
Error(expected_object+" wird erwartet.")
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()